PNDSD SOURCE ROOT SET VOLUME #1 1 NOV 78 22-2362 )P  92060-18001 1633 S 0122 RTE-III POWER FAIL DRIVER             H0101 *DVP43 USE 'ASMB,R,N' (RTE-II) OR 'ASMB,R,Z' (RTE-III) HED DVP43 - RTE POWER FAIL / AUTO RESTART * NAME: DVP43 * PGMR: G.A.A.,E.J.W. * SOURCE: 92060-18001 REV.1633 IFN * RELOC: 92001-16004 REV.1633 * XIF IFZ * RELOC: 92060-16001 REV.1633 * XIF * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * IFN NAM DVP43,0 92001-16004 REV.1633 760810 XIF IFZ NAM DVP43,0 92060-16001 REV.1633 760810 XIF ENT $POWR,IP43,CP43 EXT $CVEQ,$SCLK,$TIME,$XEQ,$UPIO,$LIST,$MESS EXT $CIC,$PWR5 SUP * * * * THIS IS THE RTE POWER FAIL AUTO RESTART ROUTINE. * * IT WORKS AS FOLLOWS: * * ON POWER FAILURE: * 1. BOTH DMA CHANNELS (PORT A AND B) ARE STOPPED * 2. ALL REGISTERS ARE SAVED, ALSO RETURN ADDRESS * 3. FOR RTE-III ALL FOUR MAPS ARE SAVED. * 4. TURN OFF POWER-FAIL INTERRUPTS UNTIL POWER RETURNS * * ON POWER UP: * 1. IN RTE-III ALL FOUR MAPS ARE RESTORED * 2. THE EQT ADDRESS FOR THIS ROUTINE IS FOUND, IT * IS SET TO TIME OUT IN ONE TICK, AND THE "I WILL * HANDLE TIME OUT" BIT IS SET. * 3. THE CURRENT SYSTEM TIME IS SAVED (THIS WILL BE THE * TIME OF POWER FAILURE). * 4. THE CLOCK IS RESTARTED BY CALLING $SCLK WHICH WILL * SET UP FOR AN IMMEDIATE INTERRUPT. * 5. A RETURN WITH ALL REGISTERS RESTORED IS MADE TO THE * POINT OF THE POWER FAIL INTERRUPT. * * * ON THE FOLLOWING TIME OUT ENTRY THE FOLLOWING ACTION IS * TAKEN: * * 1. EACH EQT ENTRY IpS CHECKED AND) * A) IF BUSY IT'S POWER FAIL FLAG IS SET (BIT 13 OF * THEN THE DRIVER IS ENTERED AT I.XX. THE FACT THAT * IT IS A POWER FAIL ENTRY MAY BE DETECTED BY * CHECKING THE BUSY BIT (ON NORMAL ENTRIES IT IS * NOT SET.) * * B) IF THE DEVICE IS BUSY AND IT'S POWER FAIL BIT * IS NOT SET THE DEVICE WILL BE SET DOWN, THE * POWER FAIL ROUTINE TIME OUT WILL BE SET BACK * TO ONE TICK AND THE CLOCK RESTARTED AND THE * SYSTEM "UP" PROCESSOR WILL BE CALLED TO UP * THE DEVICE. THIS CAUSES THE SYSTEM TO REISSUE * THE LAST REQUEST AND TO REENTER THE TIME OUT * SECTION OF THIS REOUTNE. * THE IMPLICATIONS OF THIS ARE THAT DISC TRANSFERS * WILL BE RETRIED, TTY, PUNCH, PHOTO READER * REQUESTS WILL BE RE-DONE RESULSTING IN DOUBLE * LINES IN SOME CASES. * * SOME DEVICES WILL BE REPORTED DOWN IS THEIR POWER * WAS ALSO CUT E.G. MAGTAPE, DISC. THESE * DEVICES MAY BE UPPED BY THEIR DRIVERS WHEN THEY * COME BACK ON LINE E.G. THE DISC. * * C) IF THE DEVICE IS DOWN THE SYSTEM UP PROCESSOR WILL * BE CALLED TO UP THE DEVICE. THIS WILL CAUSE * THE DOWNED DEVICES TO HAVE NEW MESSAGES POSTED * ON THE SYSTEM TTY. * * 2. THE PROGRAM "AUTOR" WILL BE ABORTED AND RESCHEDULED. * (THE ABORT IS TO ALLOW FOR MOMENTARY POWER UPS.) * AUTOR SHOULD TAKE WHAT EVER ACTION IS NEEDED TO * BRING UP THE SYSTEM IN TERMS OF ENABLING TERMINALS - * COMMUNICATION LINES ETC. IN ORDER TO ALLOW TIME * SYNC. THIS ROUTINE WILL PROVIDE THE THREE WORD SYSTEM * TIME AT POWER FAILURE ON THE FIRST READ REQUEST * AFTER POWER UP. THE SECOND READ REQUEST WILL * RETURN THE SAME TIME BUT CAUSES THE ROUTINE TO E* RESET TO HANDLE A TOTAL NEW POWER FAILURE HED POWER UP/DOWN ENTRY POINT/ DOWN CODE. $POWR NOP POWER UP/DOWN ENTRY SFC 4 UP? JMP UP YES GO DO UP THING. * JMP DOWN,I GO TO DOWN ROUTINE DOWN DEF DWN POINTS TO WAIT WHILE SENSITIVE * CODE IS EXECUTING. STF STF 0 TURN ON THE INTERRUPT SYSTEM SW2 NOP (CLF 0 IF NOT USER RETURN ELSE STC 5) IFN JMP PSAVE,I RETURN TO POINT OF POWER FAILURE. * XIF IFZ JRS MEMST PSAVE,I RETURN TO PT OF PWR FAIL. * XIF DOWNI DEF DOWN INDIRECT FOR EXIT TO AVOID INTERRUPT * EXIT2 LDA ASAVE RESTORE A REGISTER LDB BSAVE AND THE B REGISTER JSB DOWNI,I RESET DOWN SWITCH AND EXIT * * DOWN ROUTINE * DWN STF 6B STOP DMA! PREVENT LONG DMA STF 7B TRANSFER FROM JAMMING CPU STA ASAVE SAVE A-REG. STB BSAVE SAVE B-REG. ERA,ALS SOC SET LEAST A FOR INA "O-REG" SIGN FOR "E-REG" STA EOSAV SAVE E/O LDA $POWR SAVE INTERRUPT LOCATION STA PSAVE IFN LIB 6 CHECK IF MX CPU SZB,RSS JMP NOMX1 * XIF STX XSAVE SAVE X-REG STY YSAVE SAVE Y-REG NOMX1 LIA 5 SAVE ADDRESS WHERE WE LIB 5 LAST VIOLATED IN CASE OF MP IN CPB A PROGRESS - IF SO THEN ALSO STA $CIC RESET THE INTERRUPT LOCATION STA $PWR5 LIA 2 SAVE THE DMA STA SDMA1 WORD COUNTS LIA 3 STA SDMA2 LIA 1 SAVE THE SWITCH STA SSAVE REGISTER IFZ RSA SAVE STATUS OF STA MEMST WHAT WAS LAST MAP USED CLA (A) = STARTING REG # LDB SMAPA (B) = ADDR OF MAP SAVE AREA LDX MD128 (X) = -128 TO SAVE ALL MAPS XMM XIF LDA STC5 SE(JT UP THE EXIT SFS 0 SWITCH BASED ON INTERRUPT SYSTEM LDA CLF0 STA SW2 WAIT CLC 4 SET UP FOR MOMENTARY HLT 0 POWER FAILURE /WAIT FOR POWER HED POWER UP ROUTINE UP LDA DWAIT SET SWITCH FOR DOWN ROUTINE STA DOWN TO AVOID LOSS OF INFORMATION. LDA SW2 SSA,RSS IF HALTED AT POWER DOWN JMP HALT GO HALT AGAIN * CLC 0,C INIT THE WHOLE I/O SYSTEM. * STC 4 CAN NOW ALLOW A DOWN INTERRUPT. * IFZ CLA (A) = STARTING REG # LDB SMAPA (B) = ADDR OF MAP SAVE AREA LDX D128 (X) = +128 TO RESTORE ALL MAPS XMM * LDA MEMST GET MEU STATUS WORD AND B3777 SAVE FENCE ADDR AND PORTION BIT LFA LOAD FENCE * XIF LDB EQT# SET UP TO SEARCH FOR CMB,INB THE POWER FAIL STB EQTCO EQT LDB EQTA ADDRESS INB * NEXT LDA B,I GET WORD #2 CPA DEFI. IS IT THE LOCAL IP43? JMP FOUND YES GO DO IT * ADB D15 NO INDEX TO NEXT EQT ISZ EQTCO IF END THEN SKIP JMP NEXT TRY NEXT ENTRY * HALT HLT 4,C CPU HALTED OR NO JMP *-1 EQT ENTRY * FOUND ADB D2 INDEX TO WORD 4 LDA B,I FETCH IT IOR B10K SET THE "I WILL HANDLE TIME OUT" STA B,I BIT ADB D11 INDEX TO EQT15 CCA,CCE AND SET TIME OUT STA B,I FOR NEXT TICK. STB EQ15 SAVE EQT15 ADDRESS * LDA TIME+2 IF TIME IN HAND SZA THEN DO NOT JMP NIXTM SAVE IT AGAIN * DLD $TIME GET THE TIME OF DAY D$TM EQU *-1 DST TIME AND SAVE IT LDA D$TM GET ADDRESS RAL,CLE,SLA,ERA OF LDA A,I DAY/YEAR ADA D2 AND LDB A,I SAVE THE TIME OF YEAR STB TIME+2 TOO. * NIXTM CLA,CCE CLEAR THE EQT COUNT STA EQTCO FOR THE TIME OUT ROUTINE. LDA EQ5,I SET EQT IN PROCESS ALR,ERA BUSY STA EQ5,I SO WE UP IT AGAIN JSB $SCLK SET CLOCK FOR INTERRUPT LDA CLF0 SET EXIT SWITCH TO SYSTEM LDB MPTFL IF MP FLAG SZB SAYS WE STA SW2 WERE IN THE SYSTEM LDA DUMMY IF PRIV. SYS SZA,RSS MUST SET UP. WELL? JMP NOPRV OK SO DON'T. * IOR STF MAKE A STF DUMMY STA STFD PUT IT DOWN STFD NOP AND DO IT IOR STCD NOW MAKE A STC DUMMY STA STCD AND IOR CLCD A CLC DUMMY STA CLCD DO THE CLC CLCD CLC 0 NOW SZB IF IN SYSTEM ALSO STCD NOP DO THE STC. NOPRV LDA EOSAV RESTORE THE REGISTERS CLO SLA,ELA STO LDA SDMA1 STC 2 OTA 2 LDA SDMA2 STC 3 OTA 3 IFN LIB 6 IF MX CPU SZB,RSS JMP NOMX2 * XIF LDX XSAVE RESTORE X-REG LDY YSAVE RESTORE Y-REG NOMX2 LDA SSAVE OTA 1 LDA FENCE OTA 5 LDA STFTB CONFIGURE THE TBG STF IOR TBG AND STA STFTB RESTORE IT JMP EXIT2 GO RETURN TO POINT OF INTERRUPT * SPC 3 STC5 STC 5 CLF0 CLF 0 DWAIT DEF WAIT ASAVE NOP BSAVE NOP EOSAV NOP * XSAVE NOP YSAVE NOP * IFZ MEMST NOP SMAPA DEF SMAP SMAP BSS 32 DO NOT CHANGE ORDER - SYSTEM MAP BSS 32 -USER MAP BSS 32 -PORT-A MAP BSS 32 -PORT-B MAP MD128 DEC -128 D128 DEC 128 B3777 OCT 3777 XIF * SDMA1 NOP SDMA2 NOP SSAVE NOP EQ5 NOP EQT IN PROCESS FLAG EQ15 NOP EQTCO NOP PSAVE DEF HALT P-REG SAVE (HLT DEF IF HALTED) TIME BSS 3 TIME SAVE LOCATION A EQU 0 B EQU 1 SPC 3 DEFI. DEF IP43 D15 \ DEC 15 D3 DEC 3 B10K OCT 10004 D2 DEC 2 HED TIME OUT SECTION CP43 NOP ENTRY HERE FOR TIME OUT ONLY CLA CLEAR THE EQT IN PROCESS FLAG STA SW2 CLEAR SWITCH TO SHOW NO PFAIL STA EQ5 STFTB STF 0 SET CLOCK FOR ANOTHER TIME OUT CCB SET UP TO TIME OUT AGAIN STB EQ15,I SET IN EQT15 * NOTIM LDA EQTCO GET CURRENT EQT COUNT CPA EQT# IF DONE JMP AUTOR GO START AUTOR * SZA,RSS IF FIRST TIME STB BSAVE SET BSAVE FOR AUTOR COUNT SZA,RSS STB EOSAV SET EOSAV FOR TIME CALL * ISZ EQTCO STEP THE EQT NUMBER LDA EQTCO GO SET UP JSB $CVEQ THE EQT ADDRESSES LDA EQT5,I GET EQT5 RAL,CLE,SLA IF DMA WAIT, CCE,SSA,RSS THEN FORGET RSS RESTART. JMP NOTIM * LDA EQT1,I CHECK IF SYS IS CLEARING SSA WELL? JMP NOTIM YES LET TIME OUT CATCH IT. * LDA EQT4,I DEVICE(CONTROLLER)IS UP, DOWN OR BUSY. ALF,RAR CHECK HIS "I KNOW ABOUT PF" SEZ,CCE,SLA BIT JMP DVR SET AND BUSY GO DO IT * LDA EQT5 EITHER CONTROLLER IS UP OR DOWN OR BUSY. STA EQ5 POWER FAIL BIT SET, SAVE EQT ADDRESS LDA EQT5,I INCASE WE GO DOWN WHILE PROCESSING. ALR,RAL SET CONTROLLER DOWN. ERA,RAR AND STA EQT5,I AND JMP $UPIO GO RESTART CONTROLLER AND ANY DOWNED DEVICES. * DVR LDA EQT4,I SET SELECT AND B77 CODE IN LDB EQT2,I A-REG AND JSB B,I CALL AT I.XX JMP NOTIM GO DO NEXT EQT. * AUTOR ISZ BSAVE FIRST TIME HERE? JMP SAUTO NO - GO SCHEDULE AUTOR * LDA DOF YES - ABORT AUTOR LDB D11 BY CALLING SYSTEM JSB $MESS MESSAGE PROCESSOR SZA A RETURN INDICATES JMP NOAUT NO AUTOR * SAUTO JSB $LIST SECOND ENTRY OCT 201 SCHEDULE BY NAME DEF OF2 NOAUT CLA CLEAR THE TIME OUT STA EQ15,I FLAG IN EQT 15 JMP $XEQ START THE SYSTEM * DOF DEF *+1 ASC 2,OFF, OF2 ASC 4,AUTOR,1 D11 DEC 11 B77 OCT 77 N3 DEC -3 D4 DEC 4 HED TIME REQUEST SECTION IP43 NOP LDA EQT6,I GET THE REQUEST CODE RAR,SLA IF NOT READ GO COMPLETE JMP REJ * LDA EQT8,I MUST HAVE A ADA N3 THREE WORD SSA BUFFER JMP REJ ELSE IGNOR * LDA EQT7,I BUFFER ADDRESS TO A LDB TIME SET THREE WORD STB A,I TIME MESSAGE INA IN LDB TIME+1 USER STB A,I BUFFER INA LDB TIME+2 STB A,I CCA IF FIRST CALL AFTER TIME OUT CPA EOSAV AFTER POWER UP ISZ EOSAV SET FLAG TO ZERO AND SKIP JMP CLEAR NOT FIRST ENTRY JMP * I.EX LDB D3 SET TLOG = 3 REJ LDA D4 IMMEADIATE COMPLETION JMP IP43,I RETURN TO USER * CLEAR CLA SECOND OR LATER ENTRY STA TIME+2 CLEAR THE TIME IN HAND FLAG JMP I.EX AND EXIT * * * HED ** SYSTEM BASE PAGE COMMUNICATION AREA ** . EQU 1650B ESTABLISH ORIGIN OF AREA * * SYSTEM TABLE DEFINITION * * EQTA EQU .+0 FWA OF EQUIPMENT TABLE EQT# EQU .+1 # OF EQT ENTRIES DRT EQU .+2 FWA OF DEVICE REFERENCE TABLE LUMAX EQU .+3 # OF LOGICAL UNITS (IN DRT) INTBA EQU .+4 FWA OF INTERRUPT TABLE INTLG EQU .+5 # OF INTERRUPT TABLE ENTRIES TAT EQU .+6 FWA OF TRACK ASSIGNMENT TABLE KEYWD EQU .+7 FWA OF KEYWORD BLOCK * * I/O MODULE/DRIVER COMMUNICATION * EQT1 EQU .+8 ADDRESSES EQT2 EQU .+9 EQT3 EQU .+10 OF EQT4 EQU .+11 EQT5 EQU .+12 CURRENT EQT6 EQU .+13 EQT7 EQU .+14 15-WORD EQT8 EQU .+15 EQT9 EQU .+16 EQT EQT10 EQU .+17 EQT1)_1 EQU .+18 ENTRY EQT12 EQU .+81 EQT13 EQU .+82 EQT14 EQU .+83 EQT15 EQU .+84 CHAN EQU .+19 CURRENT DMA CHANNEL # TBG EQU .+20 I/O ADDRESS OF TIME-BASE CARD SYSTY EQU .+21 EQT ENTRY ADDRESS OF SYSTEM TTY * * SYSTEM REQUEST PROCESSOR /'EXEC' COMMUNICATION * * RQCNT EQU .+22 # OF REQUEST PARAMETERS -1 RQRTN EQU .+23 RETURN POINT ADDRESS RQP1 EQU .+24 ADDRESSES RQP2 EQU .+25 RQP3 EQU .+26 OF REQUEST RQP4 EQU .+27 RQP5 EQU .+28 PARAMETERS RQP6 EQU .+29 RQP7 EQU .+30 (SET FOR MAXIMUM OF RQP8 EQU .+31 9 PARAMETERS) RQP9 EQU .+32 * * DEFINITION OF SYSTEM LISTS (QUEUES) * * SKEDD EQU .+33 'SCHEDULE' LIST, SUSP2 EQU .+35 'WAIT' LIST, SUSP3 EQU .+36 'AVAILABLE MEMORY' LIST, SUSP4 EQU .+37 'DISC ALLOCATION' LIST, SUSP5 EQU .+38 'OPERATOR SUSPEND' LIST * * DEFINITION OF EXECUTING PROGRAM ID SEGMENT' * * XEQT EQU .+39 ID SEGMENT ADDR. OF CURRENT PROG. XLINK EQU .+40 'LINKAGE' XTEMP EQU .+41 'TEMPORARY (5-WORDS) XPRIO EQU .+46 'PRIORITY' WORD XPENT EQU .+47 'PRIMARY ENTRY POINT' XSUSP EQU .+48 'POINT OF SUSPENSION' XA EQU .+49 'A REGISTER' AT SUSPENSION XB EQU .+50 'B REGISTER' XEO EQU .+51 'E AND OVERFLOW * * SYSTEM MODULE COMMUNICATION FLAGS * * OPATN EQU .+52 OPERATOR/KEYBOARD ATTENTION FLAG OPFLG EQU .+53 OPERATOR COMMUNICATION FLAG SWAP EQU .+54 RT DISC RESIDENT SWAPPING FLAG DUMMY EQU .+55 I/O ADDRESS OF DUMMY INT. CARD IDSDA EQU .+56 DISC ADDR. OF FIRST ID SEGMENT IDSDP EQU .+57 -POSITION WITHIN SECTOR * * DEFINITION OF MEMORY ALLOCATION BASES * * BPA1 EQU .+58 FWA R/T DISC RES. BP LINK AREA BPA2 EQU .+59 LWA R/T DISC RES. BP LINK AREA BPA3 EQU .+60 FWA BKG DISC RES. BP LINK AREA LBORG EQU .+61 FWA OF RESIDENT LIBRARY AREA RTORG EQU .+62 FWA OF REAL-TIME AREA RTCOM EQU .+63 LENGTH OF REAL TIME COMMON AREA RTDRA EQU .+646640 FWA OF R/T DISC RESIDENT AREA AVMEM EQU .+65 FWA OF SYSTEM AVAILABLE MEMORY BKORG EQU .+66 FWA OF BACKGROUND AREA BKCOM EQU .+67 LENGTH OF BACKGROUND COMMON AREA BKDRA EQU .+68 FWA OF BKG DISC RESIDENT AREA * * UTILITY PARAMETERS * TATLG EQU .+69 LENGTH OF TRACK ASSIGNMENT TABLE TATSD EQU .+70 # OF TRACKS ON SYSTEM DISC SECT2 EQU .+71 # SECTORS/TRACK ON LU 2 (SYSTEM) SECT3 EQU .+72 # SECTORS/TRACK ON LU 3 (AUX.) DSCLB EQU .+73 DISC ADDR OF RES LIB ENTRY PTS DSCLN EQU .+74 # OF RES LIB ENTRY POINTS DSCUT EQU .+75 DISC ADDR OF RELOC UTILITY PROGS DSCUN EQU .+76 # OF RELOC UTILITY PROGS LGOTK EQU .+77 LOAD-N-GO: LU,STG TRACK,# OF TRKS LGOC EQU .+78 CURRENT LGO TRACK/SECTOR ADDRESS SFCUN EQU .+79 SOURCE FILE LU AND DISC ADDRESS MPTFL EQU .+80 MEMORY PROTECT ON/OFF FLAG (0/1) FENCE EQU .+85 MEM PROTECT FENCE ADDRESS BKLWA EQU .+87 LWA OF MEMORY IN BACKGROUND * ORG * LENGTH OF $POWR END $POWR 56   92060-18006 1726 S 0122 RTE III WHZAT PROGRAM              H0101 ,ASMB,R,L,C,Z * * **************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT * * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * **************************************************************** * IFZ HED WHZAT FOR RTE-III NAM WHZAT,1,1 92060-16006 REV.1726 770520 * * NAME: WHZAT * SOURCE: 92060-16006 * RELOC: 92060-18006 * PRGMR: J.F.B.,E.J.W.,D.L.S. * XIF IFN HED WHZAT FOR RTE-II NAM WHZAT,1,1 92001-16030 REV.1726 770520 * * NAME: WHZAT * RELOCATABLE: 92001-16030 * SOURCE: 92001-18030 * PRGM: J.F.B.,E.J.W.,D.L.S. * XIF SUP PRESS ALL EXTRANEOUS LISTING EXT EXEC,$TIME,$RNTB,$CLAS,TMVAL IFZ EXT $MATA XIF * A EQU 0 B EQU 1 * EQTA EQU 1650B EQT# EQU 1651B DRT EQU 1652B LUMAX EQU 1653B KEYWD EQU 1657B * * *THE FOLLOWING IS A SAMPLE OUTPUT OF THIS PROGRAM: * ON,WHZAT,LU * * 09:51:50:710 * ********************************************************************** * PT SZ PRGRM,T,PRIOR*DRMT*SCHD*I/O *WAIT*MEMY*DISC*OPER * NEXT TIME * * ********************************************************************** * 0 ** MEM *1*09000 ***** 1 * 2 ** R$PN$*1*00010 *************** 3, CL 032 * 3 ** PROGA*3*00097 ******************************* 6 * 4 ** PROGB*3*00097B*************** 3,LULK040,LKPRG=PROGA * 5 ** PROGC*3*00097*************** 3,RN 031,LKPRG=PROGD * 3 ** PROGD*3*00097 *************** 3,RESOURCE * 5 ** PROGE*3*00097 *************** 3,CLASS * 2 ** QUIKR*3*00099 0 *********************************00:00:00:000** * 6 ** FMGR *3*00090 *************** 3, EDITR'S QUEUE * 3 ** EDITR*3*00050 ************************* 5 * V 6 ** ASMB *3*00099 *************** 3, LU,EQ DN * 7 ** FMG07*3*00050 *************** 3, BL,EQT 7 * 2 ** WHZAT*3*00001 ***** 1 * 6 ** ED26 *3*00050 ********** 2, 16(2[00000010]) * ********************************************************************** * DOWN LU'S, 14 ************************************************************************ * DOWN EQT'S, 6 * ********************************************************************** * 09:51:50:710 * * * * BRIEF EXPLANATION OF SOME OF THE ABOVE. * * PT SZ COLUMN HEADING (PARTITION NUMBER AND PARTITION SIZE) * 0 ** IN RTE-III MEANS MEMORY RESIDENT PROGRAM * IN RTE-II ALL PROGRAMS ARE LISTED IN THIS FASHION * 5 8 IN RTE-III MEANS PARTITION #5 IS USED AND HAS 8 PAGES * * 'B' FOLLOWING THE PROGRAM'S PRIORITY MEANS RUNNING UNDER BATCH * WHEN A PROGRAM IS IN STATE 3[WAIT],THE REASON FOR BEING IN THAT * STATE WILL BE SPECIFIED ACCORDING TO THE FOLLOWING RULES : * IDSEG(2) ::= $RNTB => 'RN ALLOCATION' * ::= DRT(#[6:10])=RN# => 'LU # LOCKED' * ::= >$RNTB,<$RNTB+[$RNTB] => 'RN LOCKED' * ::= $CLAS => 'CLASS ALLOCATION' * ::= >$CLAS,<$CLAS+[$CLAS] => 'CLASS GET' * ::= 4 => 'DEVICE(LU OR EQT) DOWN' * ::= SON'S IDSEG ADDRESS => 'SON'S NAME' * ::= EQT ADDRESS => 'BL,EQT#NN' * * * * FORMAT IF THE PARTITION LIST OPTION IS CHOSEN IN RTE-III * ON,WHZAT,LU,1 * * 09:00:21:250 * ********************************************************************** * PTN# SIZE PAGES BG/RT PRGRM * ********************************************************************** * 1 7 19- 25 BG FMG11 * 2 7 26- 32 BG EDITR * 3 15 33- 47 BG * 4 4 48- 51 RT WHZAT * 5 5 52- 56 RT R$PN$ * 6 7 89- 95 BG GASP * 7 * 8 * 9 d* 10 * ********************************************************************** * 09:00:21:310 * * * SKP WHAT LDA B,I CLE,SZA,RSS SCHED W PRAM ? CLA,CCE,INA NO-DEFAULT TO LU 1 STA CRTLU SAVE LU FOR OUTPUT INB LDA B,I STA PARM2 SAVE SECOND PARAMETER INB LDA B,I GET SPECIAL LU PARAM SZA,RSS IN CASE OF PREV RUN LDA CRTLU SEZ DEFAULT NEEDED? STA CRTLU YES SPC 2 LDA .RNTB DEFINE RESOURCE TABLE JSB .IND. CHASE DOWN INDIRECT LINKS STA RNTBL SAVE ADDRESS OF RN TABLE LDA .CLAS DEFINE CLASS TABLE JSB .IND. CHASE DOWN INDIRECT LINKS STA CLASS SAVE ADDRESS OF CLASS TABLE SPC 2 LDA .HOMU HOME UP CRT LDB DM4 FOUR TIMES FOR 2400 BAUD JSB PRINT USE STD PRINT SUB JSB TOD PRINT TIME-OF-DAY AS NEXT LINE JSB STARS ERASE EOL + A LINE OF ASTERISKS * IFZ LDA PARM2 SZA WAS SECOND PARAMETER GIVEN? JMP WHATP YES, SHOW PARTITIONS XIF * SPC 2 LDA .HEAD ERASE EOL + COLUMN HEADER LDB DM74 JSB PRINT JSB STARS ERASE EOL + A LINE OF ASTERISKS CLA ZERO IDSEG # STA IDCNT AND AWAY WE GO ! SPC 2 SKP MAIN JSB SETPT BEGIN MAIN CODE. INIT STACK LDA KEYWD GET ADDRESS OF KEYWORD BLOCK ADA IDCNT ADD ON IDSEG # TO INDEX LDA A,I TO THIS LOOP'S WORK STA IDPNT IDSEG(1) * SZA,RSS IF ZERO, JMP FINIS THEN WE'RE THRU WITH ID SEG'S * LDB D15 ELSE VERIFY JSB IDWRD THAT THIS AND B17 IDSEG(16[4-0])=PROG STATUS STA STATS PROGRAM IS SZA NOT DORMANT ? JMP PROCS ACTIVE SO PROCESS IT ! * LDB D17 VERIFY JSB IDUWRD THAT THIS ALF,SLA IDSEG(18[12])=TIME LIST INDICATOR JMP PROCS PROG IS IN TIME LIST ! JMP BUMP0 ELSE NEXT INDEX(IDSEG #) * D2 DEC 2 D3 DEC 3 D5 DEC 5 D6 DEC 6 D12 DEC 12 D14 DEC 14 D15 DEC 15 D17 DEC 17 D21 DEC 21 B77 OCT 77 B17 EQU D15 CRTLU NOP PARM2 NOP IDCNT NOP IDPNT NOP STATS NOP STACK OCT 17036,17036 BSS 35 .STAK DEF STACK STKPT NOP .TM. DEF STACK+31 ASTER OCT 17036,17036 UNL REP 35 ASC 1,** LST .ASTE DEF ASTER .STAR DEF ASTER+2 DM4 DEC -4 D7 DEC 7 SPC 4 PROCS EQU * IFZ LDB D14 JSB IDWRD GET PROG TYPE AND D7 CPA D1 RESIDENT PROGRAM? RSS CPA D4 RSS JMP PRLNG NO, PROCESS DISC RESIDENT XIF * LDA .RSDT YES, RESIDENT PROGRAM JSB MVBYT PRINT IT IS IN PARTITION 0 DEF D6 * IFZ JMP NAME GO GET PROGRAM NAME * PRLNG LDB D21 GET CONTENTS JSB IDWRD OF WORD 22 STA NUM (PARTITION #) AND B77 INA CONVERT TO ASCII JSB .ASC2 AND ADD TO STACK LDA .SPAC JSB MVBYT PUT A SPACE IN DEF D1 OUTPUT LINE * LDA NUM ALF,RAL GET NUMBER OF PAGES RAL IN PARTITION AND B37 INA ADD 1 FOR BASE PAGE JSB .ASC2 CONVERT TO ASCII LDA .SPAC JSB MVBYT PUT A SPACE DEF D1 XIF * * NAME LDA IDPNT CALC 'FROM' ADA D12 BYTE ADDRESS JSB MVBYT MOVE NAME TO OUTPUT STACK DEF D5 SPEC 5 BYTES * JSB PSTAR PUSH AN ASTERISK SPC 2 TYPE LDB D14 GET PROGRAM TYPE JSB IDWRD ALF,ALF CHECK FOR SHORT ID ALF,SLA,ALF SHORT ? JMP FINIS YES,STOP ID CHECK AND D7 MASK OFF IDSEG(15[2-0]) a* JSB .ASC1 & STORE BYTE JSB PSTAR PUSH AN ASTERISK * PRIOR LDB D6 GET PROG PRIORITY JSB IDWRD IN 'A'REG JSB ZASC5 CONVERT TO ASCII & ADD TO STACK * LDB D20 JSB IDWRD LDB .SPAC SSA IF RUNNING UNDER BATCH, LDB .B PRINT 'B' LDA B ELSE PRINT SPACE JSB MVBYT DEF D1 SPC 2 LDA STATS CALC STATUS COLUMN SZA,RSS DORMANT ? JMP M NO ASTERISKS NECESSARY MPY D5 5 CHARS PER COLUMN STA NUM SET UP MOVE LDA .STAR 'A'REG=SOURCE JSB MVBYT MOVE BYTES,R/L DEF NUM BER OF BYTES * M LDA STATS CONVERT STATUS TO ASCII JSB .ASC2 & PUSH ONTO STACK * LDA STATS GET STATUS CPA D2 I O SUSPEND ? JMP EQT YES-PROCESS EQT# CPA D3 WAIT LIST ? JMP WAIT YES-PROCESS WAIT LDA .SPAC ADD ONE MORE SPACE JSB MVBYT DEF D1 JMP TLIST CHECK TLIST SPC 2 EQTPT NOP #EQTS NOP .RSDT DEF *+1 ASC 3, 0 ** .B DEF *+1 ASC 1,BB SKP EQT CLA PROG'S IN I/O SUSPEND STA #EQTS SET UP EQT INDEX * EQTLP LDA #EQTS GET EQT INDEX MPY D15 (15 WORDS EQT) ADA EQTA ADD ON EQT AREA BASE STA EQTPT SAVE THIS EQT'S ADDRESS IFZ XLA A,I GET CONTENTS OF EQT'S FIRST WORD XIF IFN LDA A,I XIF * IDSLP SZA,RSS SCAN SUSPEND LIST. NULL LIST? JMP NXTEQ YES-GO TO NEXT EQT CPA IDPNT NO-POINTS TO OUR ID SEG ? JMP FNDEQ YES-GO PROCESS. IFZ XLA A,I NO-NEXT LIST ELEMENT XIF IFN LDA A,I XIF JMP IDSLP & CONTINUE THE SEARCH * NXTEQ ISZ #EQTS STEP EQT CNTR FOR NEXT EQT ENTRY LDA #EQTS ARE WE THRU ? CPA EQT# COMPARE WITH BASE PAGE COUNT JMP OSCAR YES-MUST BE OSCAR JMP EQTLP NO- GOTO EQT LOOP * OSCAR LDA .EXEC MOVE " ,EXEC" ONTO STACK JSB MVBYT DEF D6 JMP TLIST & CHECK TIME LIST SPC 2 .EXEC DEF *+1 ASC 3,, EXEC .CMBL EQU .EXEC COMMA, BLANK B140K ABS 140000B .LPAR DEF *+1 ASC 1,( .LBRK DEF *+1 ASC 1,[ .IOBE DEF *+1 ASC 3,]) * SPC 2 FNDEQ EQU * PUSH ", EQ(L[DEV.STAT]) *" LDA .CMBL MOVE COMMA AND BLANK JSB MVBYT DEF D2 LDA #EQTS CALC EQT # INA JSB .ASC2 CONVERT TO ASCII LDA .LPAR PUSH "(" ONTO STACK JSB MVBYT DEF D1 * LDB EQTPT GET DEV.LOG.STATUS ADB D4 IFZ XLA B,I XIF IFN LDA B,I XIF ALF,ALF STA EQST SET UP FOR BINARY STATUS ALF,ALF AND B140K MASK OFF LOGICAL STATUS RAL,RAL RIGHT JUSTIFY IN WORD JSB .ASC1 CONV TO ASCII & STORE LDA .LBRK PUSH "[" ONTO STACK JSB MVBYT DEF D1 * LDA DM8 SET UP LOGICAL STATUS STA CNT COUNTER BINLP LDA EQST CONVERT STATUS WORD TO BINARY RAL ROTATE CCW STA EQST SAVE IT AND D1 MASK OFF LSB(IT) JSB .ASC1 CONV TO ASCII & STORE ISZ CNT DONE 8 ? JMP BINLP NO-LOOP * LDA .IOBE MOVE LAST PART OF MESSAGE JSB MVBYT PUSH DEF D5 JMP TLIST CHECK TLIST SPC 2 DM8 DEC -8 D20 DEC 20 REASN NOP TEST EQU REASN EQST NOP SKP WAIT LDA .EXEC PUSH ", "ONTO STACK JSB MVBYT FOR EXPLANATION DEF D2 * CLB,INB GET IDSEG(2) JSB IDWRD STA REASN CPA RNTBL RESOURCES LOCK ? JMP RESLK YES-PUSH "RN ?" ONTO STACK CPA CLASS NO-CLASS LOCK ? JMP CLSLK YES-PUSH "CLASS ?" ONTO STEACK CPA D4 NO-DEVICE DOWN ? JMP DEVDN YES-PUSH "DEVICE DOWN" ONTO STACK * JSB TSTWD RNTBL<=IDSEG(2)<=[RNTBL] ? .RNTB DEF $RNTB JMP RNLCK YES-PUSH "RN LOCK" ONTO STACK * JSB TSTWD CLASS<=IDSEG(2)<=[CLASS] ? .CLAS DEF $CLAS JMP CLGET YES-PUSH "CLASS GET" ONTO STACK * LDA 1650B EQT <= IDSEG(2) <= #EQTS CMA,INA - S.A. OF EQT ADA REASN + POINTER SSA IF -, THEN POINTER < EQT S.A. JMP SONID FORGET IT CLB RESULT IS ADD REL S.A.EQT DIV D15 MOD 15 INA + 1 STA TEMP = EQT # CMA,INA -EQT# ADA 1651B + # EQT'S SSA,RSS IF POS,THEN VALID EQT # JMP BL SO PROCESS IT * SONID LDA REASN GET SON'S IDSEG ADDRESS ADA D12 INDEX TO NAME JSB MVBYT MOVE SON'S NAME ONTO STACK DEF D5 LDB D15 JSB IDWRD ALF,SLA JMP TLIST BIT 12 SET, HAVE SON LDA .QUE BIT 12 CLEAR, SON YET TO BE JMP PUSH8 SPC 2 .BLIM DEF *+1 ASC 3,BL,EQT00 * BL LDA .BLIM SET UP BUFFER LIMIT MESSAGE JSB MVBYT DEF D6 LDA TEMP JSB .ASC2 CONVERT EQT# & PUSH JMP TLIST TEMP NOP SPC 2 .QUE DEF *+1 ASC 4,'S QUEUE .RN?? DEF *+1 ASC 4,RESOURCE RESLK LDA .RN?? PUSH "RN ??" ONTO STACK JMP PUSH8 SPC 2 .CL?? DEF *+1 ASC 4,CLASS # CLSLK LDA .CL?? PUSH "CL ??" ONTO STACK JMP PUSH8 SPC 2 .EQDN DEF *+1 ASC 5,LU/EQ DN DEVDN LDA .EQDN PUSH "LU,EQ DN" ONTO STACK * PUSH8 JSB MVBYT PUSH 8 CHARS ONTO STACK DEF D8 JMP TLIST SPC 2 B37 OCT 37 @DRT EQU 1652B @LUMX EQU 1653B .RNLK DEF *+1 ASC 2,RN 00,LKPRG=PROGA . .LKPR DEF *+1 ASC 4,,LKPRG= * RNLCK STA RN SAVE RN# TEMP LDA @DRT GET DRT ADDRESS STA PTR SET UP POINTER LDA @LUMX GET MAX # OF LU'S CMA,INA SET UP COUNTER STA CNT LLOOP EQU * SEARCH FOR LU LOCK LDA PTR,I GET DRT ENTRY RRR 6 POSITION LU LOCK RN AND B37 & MASK IT CPA RN LU LOCK ? JMP LULCK YES-PROCESS IT ISZ PTR NO LOOP ISZ CNT JMP LLOOP LDA .RNLK PUSH "RN LK" ONTO STACK JSB MVBYT DEF D4 LDA RN PROCESS RNLCK JSB ZASC3 JSB PLOCK PUT PROG NAME INTO MESSAGE JMP TLIST SPC 2 .LULK DEF *+1 ASC 3,LULK 00,LKPRG=PROGA . * LULCK LDA .LULK PUT "LULK" ONTO STACK JSB MVBYT DEF D5 LDA CNT PROCESS LU LOCK - FIND ADA @LUMX OWNER'S NAME INA JSB .ASC2 PUT LU# IN MESSAGE JSB PLOCK PUT PROG NAME IN MESSAGE JMP TLIST SPC 2 PLOCK NOP LDA .LKPR PUSH ",LKPRG=" ONTO STACK JSB MVBYT DEF D7 LDA RNTBL ADA RN LDA A,I AND B377 GET RESOURCE LOCKER'S ID SEG # CPA B377 IS IT GLOBAL? JMP PLCK9 YES. ADA M1 ADA KEYWD LDA A,I ADA D12 (A) = ADDR OF LOCKER'S PROG NAME PLCK5 JSB MVBYT MOVE NAME DEF D5 JMP PLOCK,I * PLCK9 LDA .GLBL JMP PLCK5 * .GLBL DEF *+1 ASC 3,GLOBL M1 DEC -1 RN NOP PTR NOP CNT NOP .CLGT DEF *+1 ASC 2,CL 000 .SPAC DEF .CLGT+2 CL# NOP * CLGET STA CL# LDA .CLGT PUSH "CL " ONTO STACK JSB MVBYT DEF D4 LDA CL# JSB ZASC3 JMP TLIST * * TLIST LDB D17 IDSEG(18[12])=TIME LIST INDICATOR JSB IDWRD ALF,SLA SET ? JMP NXTTM YES-CONV NEXT TIME JMP DUMP NO-PRINT WHAT WE'VE GOT. SPC 2 D8 DEC 8 SPC 2 NXTTM LDA .TM. CALC # OF STARS TO FILL LINE R CLE,ELA CMA,INA ADA STKPT CMA,INA PLUS 1 STA NUM & SAVE IT LDA .STAR SET UP FOR MOVE JSB MVBYT DEF NUM * LDA IDPNT ADA D18 JSB CNVTM * DUMP JSB OUTPT DISPLAY STACK BUMP0 ISZ IDCNT JMP MAIN SPC 2 FINIS JSB STARS EOL + 70 ASTERISKS * DNDEV JSB SETPT RESET STACK FOR DOWN LU'S. LDA .DNLU PRINT LINE HEAD. JSB MVBYT DEF D9 * LDA DRT GET LU TABLE AREA ADDRESS, ADA LUMAX POSITION TO WORD TWO STA EQTPT TABLE AND SAVE. CLA INITIALIZE STA #EQTS COUNTER. * DNLU1 LDA EQTPT,I GET LU'S STATUS. ISZ #EQTS SSA,RSS IS IT DOWN? JMP NXTLU NO--GET NEXT LU. LDA .CMBL YES--PROCESS IT. JSB MVBYT PUSH A ', '. DEF D2 LDA #EQTS CONVERT LU# JSB .ASC2 TO ASCII. NXTLU ISZ EQTPT INCREMENT DRT WORD 2 POINTER. LDA #EQTS IF LAST, CPA LUMAX THEN GO RSS DUMP LINE. JMP DNLU1 ELSE CONTINUE. * JSB OUTPT PRINT STACK. JSB STARS E0L + LINE OF ASERISKS. * JSB SETPT RESET STACK FOR DOWN EQTS LDA .DNEQ PRINT LINE HEAD JSB MVBYT DEF D10 * LDA EQTA GET EQT TABLE AREA ADDRESS ADA D4 INDEX TO STATUS STA EQTPT PUSH POINTER CLA INIT STA #EQTS EQT COUNTER DEVLP LDA EQTPT,I FIND EQT'S. GET STATUS ISZ #EQTS RAL,RAL POSITION AND D3 & MASK CPA D1 IS IT DOWN RSS YES-PROCESS JMP NXTDV NO-NEXT EQT LDA .CMBL PUSH ", " JSB MVBYT DEF D2 LDA #EQTS CONV EQT# TO ASCII JSB .ASC2 NXTDV LDA EQTPT BUMP ADA D15 TO NEXT STA EQTPT EQT STATUS WORD LDA #EQTS WAS THIS THE LAST CPA EQT#* RSS YES-DUMP IT JMP DEVLP NO-CONTINUE SPC 2 DONE JSB OUTPT PRINT STACK DONE1 JSB STARS EOL + LINE OF ASTERISKS EXIT JSB TOD FINALLY TIME OF DAY LDA .EOF BOTTOM OF PAGE FOR OPERATOR LDB DM10 JSB PRINT SPC 2 JSB EXEC I AM SERIALLY REUSABLE DEF RSTRT DEF D6 DEF ZERO DEF M1 DEF ZERO DEF PARM2 DEF CRTLU RSTRT JMP WHAT RESTART SPC 2 ZERO OCT 0 D18 DEC 18 DM10 DEC -10 RNTBL NOP CLASS NOP NUM NOP D4 DEC 4 .DNEQ DEF *+1 ASC 5,DOWN EQT'S .DNLU DEF *+1 ASC 5,DOWN LU'S D9 DEC 9 * @TIME DEF $TIME .HOMU DEF *+1 OCT 016435,016537 .EOF DEF *+1 OCT 017036,017036,16034,16034,16137 .HEAD DEF *+1 OCT 17036,17036 ASC 25,PT SZ PRGRM,T,PRIOR*DRMT*SCHD*I/O *WAIT*MEMY*DISC* ASC 10,OPER * NEXT TIME * SKP IFN *LOAD BYTE * ('B'REG = BYTE ADDRESS) * JSB LBT * ('A'REG = BYTE) * ('B'REG = UPDATED TO NEXT BYTE ADDRESS) LBT NOP CLE,ERB LDA B,I SEZ,RSS ALF,ALF AND B377 ELB INB JMP LBT,I SPC 2 *STORE BYTE * ('A'REG = BYTE) * ('B'REG = BYTE ADDRESS) * JSB SBT * ('B'REG = UPDATED TO NEXT BYTE ADDRESS) SBT NOP AND B377 STA CHAR CLE,ERB LDA B,I SEZ,RSS ALF,ALF AND BM377 IOR CHAR SEZ,RSS ALF,ALF STA B,I ELB INB JMP SBT,I * CHAR NOP BM377 OCT 177400 COUNT NOP SPC 2 SPC 2 *MOVE BYTES,R/L * ('A'REG = 'FROM' BYTE ADDRESS) * ('B'REG = 'TO' BYTE ADDRESS) * JSB MBT * DEF NUM BER OF BYTES TO MOVE * NOP * ('A'REG = UPDATED 'FROM' BYTE ADDRESS) * ('B'REG = UPDATED 'TO' BYTE ADDRESS) MBT NOP DST FROM LDA MBT,I ISZ MBT LDA A,I ISZ MBT CMA,INA,SZA,RSS JMP MBT,I STA COUNT MBTLP LDB FROM JSB LBT STB FROM JSB STBYT ISZ COUNT JMP MBTLP DLD FROM JMP MBT,I XIF SPC 2 FROM BSS 2 TO EQU FROM+1 B377 OCT 377 SPC 2 STBYT NOP LDB TO IFN JSB SBT XIF IFZ OCT 105764 JSB SBT XIF STB TO JMP STBYT,I SPC 2 * ('A'REG = WORD ADDRESS OF FROM) * JSB MVBYT * DEF COUNT * MVBYT NOP CLE,ELA LDB STKPT DST FROM LDA MVBYT,I ISZ MVBYT STA .MVBY DLD FROM IFN JSB MBT XIF IFZ OCT 105765 JSB MBT XIF .MVBY NOP NOP STB STKPT JMP MVBYT,I SPC 2 PSTAR NOP LDA .STAR JSB MVBYT DEF D1 JMP PSTAR,I SPC 2 SETPT NOP LDA .STAK ADA D2 CLE,ELA STA STKPT JMP SETPT,I SPC 2 OUTPT NOP LDA .STAK LDB .STAK CLE,ELB CONV TO BYTES CMB,INB ADB STKPT ADD ON CURRENT BYTE POSITION CMB,INB JSB PRINT JMP OUTPT,I SPC 2 STARS NOP LDA .ASTE LDB DM74 JSB PRINT JMP STARS,I * DM74 DEC -74 SPC 2 * 'A'REG = UPPER LIMIT * 'B'REG = LOWER LIMIT * TEST = ??????????? * JSB TESTR * RETURN -'A'REG : POS => FALSE NEG => TRUE . TESTR NOP CMB,CLE,INB ADB TEST LDB TEST CMB,SEZ,CLE,INB ADB A ERA SIGN = E. E=0 FALSE E=1 TRUE JMP TESTR,I SPC 2 TSTWD NOP LDA TSTWD,I JSB .IND. LDB A ISZ TSTWD ADA B,I STB SAVEB JSB TESTR SSA,RSS ISZ TSTWD LDA SAVEB CMA,INA ADA TEST JMP TSTWD,I SPC 2 .IND. NOP RSS N LDA A,I RAL,CLE,SLA,ERA JMP N JMP .IND.,I SPC 2 <PRINT NOP STA .BUFF STB CNT JSB EXEC DEF *+1+4 DEF D2 DEF CRTLU .BUFF DEF STACK DEF CNT JMP PRINT,I * TOD NOP JSB SETPT LDA @TIME JSB CNVTM JSB OUTPT JMP TOD,I SPC 2 MS NOP SEC NOP MIN NOP HOURS NOP DAY NOP .HOUR DEF HOURS .COLN DEF *+1 ASC 1,:: .ZERO DEF *+1 ASC 1,00 SPC 2 CNVTM NOP STA .. SAVE ADDRESS OF TIME VALUE JSB TMVAL CONVERT INTO COMPONENTS DEF *+1+2 .. DEF $TIME DEF MS LDA .HOUR STA PTR LDA DM4 STA CNT JMP TLOOR * TLOOP LDA .COLN PUSH A ":" OUT JSB MVBYT DEF D1 TLOOR LDA PTR,I JSB .ASC2 CONVERT TIME TO ASCII CCA ADA PTR STA PTR ISZ CNT JMP TLOOP * LDA .ZERO ADD "0" FOR LAST NUMBER JSB MVBYT TO MULTIPLY BY 10 FOR MS DEF D1 JMP CNVTM,I RETURN WITH ASCII VALUES IN ARRAY TIME SPC 2 IDWRD NOP ADB IDPNT LDA B,I JMP IDWRD,I SPC 2 * 'A'REG = BINARY VALUE * 'B'REG = DESTINATION BYTE ADDRESS * 'E'REG = 0 FOR NO ZEROES, 1 FOR LEADING ZEROES * JSB ASCII * 'A'REG = LAST BYTE * 'B'REG = BYTE ADDRESS UPDATED * ASCII NOP STA VAL CLA ELA STA FILL LDA STKPT STA TO LDA B (A)=(B)=DIGIT COUNT CODE ADB DM4 STB CCNTR SZB,RSS IF ONLY ONE DIGIT JMP LSTDG GO TO LAST DIGIT CODE ADA .N10K ADJUST POWERS OF TEN TO STA QPNTR NUMBER OF DIGITS DESIRED LOOP LDA VAL CLB DIV QPNTR,I DIVIDE BY POWER OF TEN STB VAL SAVE REMAINDER (LOWER DIGITS) SZA JMP ASCNV CPA FILL LEADING ZEROES WANTED? JMP LZERO NO, BLANK OUT IF E#0 ORIGINALLY ASCNV IOR B60 NOT 0 OR LEADING 0 WANTED STA FILL S5O INSURE NO 0 GETS LOST ASCST JSB STBYT ISZ QPNTR INCRE TO NEXT POWER OF TEN ISZ CCNTR BUMP DIGIT COUNTER JMP LOOP MORE THAN 1 DIGIT LEFT LSTDG LDA VAL IOR B60 DO LAST DIGIT EVEN IF ZERO JSB STBYT STB STKPT (B) IS STILL NEXT BYTE ADDR JMP ASCII,I * LZERO LDA B40 REPLACE LEADING ZEROES JMP ASCST WITH BLANKS SPC 2 .ASC1 NOP CONVERT 1 DIGIT TO ASCII CLE LDB D4 JSB ASCII JMP .ASC1,I SPC 2 .ASC2 NOP CONVERT BINARY TO ASCII CLE LDB D3 JSB ASCII JMP .ASC2,I SPC 2 ZASC3 NOP CONVERT 3 DIGITS, LEADING ZEROES CCE LDB D2 JSB ASCII JMP ZASC3,I SPC 2 .ASC4 NOP CONVERT 4 DIGITS, LEADING BLANKS CLB,CLE,INB JSB ASCII JMP .ASC4,I SPC 2 ZASC5 NOP CONVERT 5 DIGITS, LEADING ZEROES CLB,CCE JSB ASCII JMP ZASC5,I SPC 2 VAL NOP .N10K DEF N10K N10K DEC 10000,1000,100,10 D1 DEC 1 D10 EQU N10K+3 QPNTR NOP CCNTR NOP FILL NOP SAVEB EQU VAL B40 OCT 40 B60 OCT 60 SKP IFZ WHATP LDA .PHED LDB DM36 JSB PRINT PRINT HEADING FOR PARTITION STUFF JSB STARS '**********' * CLA,INA STA PTN# INIT PARTITION NUMBER LDA $MATA STA PTNAD INIT PARTITION ADDR ADA M1 LDA A,I GET # OF PARTITIONS SZA,RSS JMP DONE IN CASE BOO-BOO MPY D6 ADA $MATA CALCULATE ADDR OF STA LPTAD LAST PARTITION * NXPTN JSB SETPT LDA PTN# BEGIN PARTITION LINE JSB .ASC2 CONVERT # TO ASCII * LDA PTNAD,I GET LINK WORD SSA,RSS PARTITION DEFINED? JMP CKRES YES, CHECK STUFF * LDA .UNDF NO, PRINT 'NOT DEFINED' JSB MVBYT DEF D14 JMP DMPTN DUMP LINE, PROCEySS NEXT * CKRES LDB PTNAD ADB D4 CALC ADDR OF RES/SIZE LDA B,I CLE,ELA RAR KEEP ONLY 10 BITS AND B1777 (STATUS JUNK IN HIGH BITS) STA PTSIZ SAVE SIZE OF PART. LDA .SPAC OUTPUT SPACE IF NOT RESERVED SEZ ELSE LDA .RSPC USE 'R ' IF RESERVED JSB MVBYT DEF D2 * LDA .SPAC JSB MVBYT OUTPUT 2 SPACES DEF D2 * LDA PTSIZ GET PART. SIZE (MAX=32) INA ADD 1 FOR BASE PAGE JSB .ASC2 CONVERT TO ASCII + OUTPUT * LDA .SPAC JSB MVBYT 2 MORE SPACES DEF D2 * LDB PTNAD ADB D3 ADDR OF START PAGE # LDA B,I AND B1777 PAGE # IN LOW 10 BITS ONLY STA PAGE# JSB .ASC4 CONVERT + OUTPUT 4 DIGITS * LDA .DASH JSB MVBYT PUT "-" ON OUTPUT STACK DEF D1 * LDA PAGE# ADA PTSIZ CALCULATE LAST PAGE # JSB .ASC4 CONVERT + OUTPUT 4 DIGITS * LDB PTNAD ADB D5 LDB B,I LDA .BG 'BG " IF BACKGROUND SSB ELSE LDA .RT ' RT' IF REAL-TIME JSB MVBYT CLASS PARTITION DEF D7 * LDB PTNAD ADB D2 LDA B,I SZA,RSS EMPTY? JMP NOPRG YES, PRINT '' ADA D12 JSB MVBYT MOVE NAME TO OUTPUT DEF D5 * DMPTN JSB OUTPT DUMP OUTPUT STACK ISZ PTN# INCRE PARTITION # LDA PTNAD ADA D6 INCRE TO NEXT PARTITION ADDR STA PTNAD CPA LPTAD DONE YET? JMP DONE1 YES. PRINT TIME, EXIT JMP NXPTN NO. DO NEXT PARTITION * NOPRG LDA .NONE JSB MVBYT DEF D6 JMP DMPTN SPC 2 .PHED DEF *+1 OCT 17036,17036 ASC 16,PTN# SIZE PAGES BG/RT PRGRM * .UNDF DEF *+1 ASC 7, * .RSPC DEF *+1 ASC 1,R * kZXT.DASH DEF *+1 ASC 1,- * .BG DEF *+1 ASC 4, BG * .NONE DEF *+1 ASC 3, .RT DEF *+1 ASC 4, RT * B1777 OCT 1777 DM36 DEC -36 PTSIZ EQU STATS PTNAD EQU EQTPT PTN# EQU IDCNT LPTAD EQU IDPNT PAGE# EQU #EQTS XIF UNS END WHAT Z  92060-18011 1740 S C0122 SPOUT SOURCE              H0101 9ASMB,R,L,C,Z ASSEMBLE STATEMENT FOR RTE III *ASMB,R,L,C,N ASSEMBLE STATEMENT FOR RTE II IFN HED OUTSPOOL ROUTINE FOR RTE II XIF IFZ HED OUTSPOOL ROUTINE FOR RTE III XIF * NAME: SPOUT * SOURCE: 92002-18009 (RTE II) 92060-18011 (RTE III) * RELOC: 92002-16009 (RTE II) 92060-16011 (RTE III) * RELOC: 92067-16028 (RTE IV) * PGMR: A.M.G. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * IFN NAM SPOUT,1,11 92002-16009 REV. 1740 770810 XIF IFZ NAM SPOUT,17,11 92060-16011 REV.1740 780309 XIF * * *** THE GREAT SPOOL OUT ROUTINE *** * * * *** SMP REQUESTS TO SPOUT *** * * (1) NEW MENU TO SEARCH * STAT1 = 2 * STAT2 = 0 * IOBUF CONTAINS MENU * * (2) UNLOCK LU AND SEARCH NEW MENU * STAT1 = 3 * STAT2 = LU TO UNLOCK * IOBUF CONTAINS MENU * * (3) START UP A NEW SPOOL * STAT1 = 1 * STAT2 = NEW STAT2 CLASS PARAMETER * IOBUF CONTAINS NEW STAT1 * * * *** FORM OF CLASS PARAMETERS *** * * STAT1 SIGN BIT SET = STANDARD FILE * SIGN BIT CLEAR = OUTSPOOL WITH HEADERS * BIT 12 SET = CAME FROM DVS43 * BITS 11-8 = LINE COUNT * BITS 5-0 = LU # TO READ * * STAT2 SIGN BIT SET = CHECK OVERLAP CONDITION * SIGN BIT CLEAR = NO OVERLAP CHECK NEEDED * BITS 11-6 = FUNCTION BITS FOR STANDARD FILE * BITS 5-0 = OUTSPOOL LU # * * STD. I/O REQUEST: * * OPT. PRAM #1 STAT1 * OPT. PRAM #2 SET UP COUNT WORD (FLCNT) * * EQT 32/33  * 32 STAT1 * 33 STAT2 * 29 FLCNT * EXT $LIBR TURN OFF INTERRUPTS EXT $LIBX TURN ON INTERRUPTS EXT LURQ LU LOCK/UNLOCK REQUEST EXT $LUAV LU AVAILABILITY TABLE EXT EXEC SYSTEM CALLS EXT SP.CL SPOOL CLASS ID EXT .DRCT * * IOBUF BSS 69 * ORG IOBUF * * SPX CLA STA SPOUT LDA SP.CL IOR DONT JSB $LIBR NOP STA SP.CL JSB $LIBX DEF *+1 DEF SPT2 * ORR * SPOUT JMP SPX * SPT2 JSB EXEC CLASS GET LOOP STARTS HERE. DEF *+8 FLOW OF CONTROL DIRECTED DEF D21 FROM THIS POINT. DEF SP.CL BUFAD DEF IOBUF DEF D69 DEF STAT1 DEF STAT2 DEF ICNWD LDB ICNWD WHAT TYPE ORIGINAL REQUEST? CPB D2 JMP WRREQ ORDINARY WRITE. * CPB D3 JMP SPT2 CONTROL - BACK THROUGH LOOP. * LDA STAT1 WRITE-READ. CPA D2 HAVE AN SMP REQUEST JMP MENU * CPA D1 JMP FILAT * JSB LURQ MUST UNLOCK LU OF FILE DEF *+4 WHICH SMP FAILED TO OPEN DEF B40K DEF STAT2 DEF D1 NOP IGNORE ERROR JMP SPT2 GET THE NEXT CHORE * MENU LDA BUFAD HAVE A MENU TO SEARCH. STA TEMP1 MENU5 LDA TEMP1,I GO THROUGH LU'S IN MENU SZA,RSS TRYING TO LOCK EACH ONE. JMP MENU4 * * JSB LURQ TRY TO LOCK. DEF *+4 DEF NOABT WITHOUT ABORT. DEF TEMP1,I DEF D1 JMP MENU6 ERROR JUST IGNORE THIS ONE SZA,RSS JMP MENU3 SUCCESSFUL LOCK. * SSA UNSUCCESSFUL. JMP MENU4 NO RN'S AVAILABLE. QUIT. * MENU6 ISZ TEMP1 LU ALREADY LOCKED. TRY JMP MENU5 SEARCHING MORE OF MENU. * MENU4 CLB CPB STAT2 JMP MENU2 * STB STAT2 JMP MENU * MENU2 CPB IOBUF NULL MEN;U? JMP SPT2 YES - BACK TO GET. * LDA D10 TELL SMP ABOUT THE LOCK PROBLEM JMP SMPC * MENU3 LDA D11 SUCCESS TELL SMP LDB TEMP1,I FIRST MOVE UP THE PRAM STB TEMP1 JMP SMPC * FILAT LDA IOBUF HAVE A SET OF FILE STA STAT1 ATTRIBUTES. AND B77 STA ICNWD START UP THE SPOOL. JSB GETEQ GET EQT ADDRESS OF ADB M2 STARTING NEW FILE. LDA FILNO INCREMENT AND SET CCE,INA,SZA,RSS ERA FILE COUNTER INTO EQT29. STA FLCNT STA FILNO JSB PUT STUFF THE EQT. ADB D3 STB LCNT SAVE EQT32 ADDRESS. JSB SLCNT STAT2 IN EQT32 AND EQT33. CCA SET FLAG IN STA GETEQ GETEQ TO INDICATE SET UP JMP WRR10 * WRREQ LDA STAT2 STA FLCNT LDA STAT1 NORMAL READ-WRITE LOOP AND B77 STARTS HERE. STA ICNWD JSB GETEQ GET ADDRESS OF EQT32. ADB M2 BACK UP AND GET LDA B,I THE SET UP COUNT CPA FLCNT IS IT GOOD? INB,RSS YES SKIP JMP SPT2 NO OLD NEWS IGNOR IT * ADB D2 SET B TO EQT32 ADDRESS STB LCNT SAVE EQT32 ADDRESS. INB LDA B,I PICK UP STAT2 FROM THE EQT AND STA STAT2 SAVE IT LDB STAT1 PICK UP STORED STAT1 VALUE. LDA LCNT,I AND SAVE VERSION BLF,SLB IF FROM EXTEND RSS SKIP THE INCREMENT ADA B400 ELSE STEP THE COUNTER STA STAT1 SET STAT1 FOR LOCAL USE AND B7400 ISOLATE THE COUNTER SZA,RSS IF COUNT IS ALREADY TO ZERO JMP SPT2 IGNOR THE EXTEND WAKE UP. * JSB SLCNT UPDATE THE EQT WRR10 LDA STAT2 NEED WE CHECK THE SSA,RSS OVERLAP CONDITION? JMP WRR6 NO NEED. * JSB .DRCT WE MUST CHECK OVERLAP DEF $LUAV CONDITIONS BEFORE CONTINUING. LDB A,I STB TEMP1 INA STA TEMP2 SAVE ADDRESS OF TABLE. WRR LDB A,I SEARCH THE $LUAV TABLE INA FOR THE READ LU. BLR,BRS CPB ICNWD JMP WRR3 WE HAVE IT. * INA JMP WRR * B400 OCT 400 * WRR3 LDB A,I SAVE SPLCON RECORD # STB TEMP5 CORRESPONDING TO THIS LDA TEMP2 SPOOL LU. WILL FIND IF WRR5 INA WE HAVE A POTENTIAL OVERLAP LDB A,I CONDITION BY FINDING CPB TEMP5 ANOTHER ENTRY OF SAME JMP WRR4 RECORD #. * WRR7 INA ISZ TEMP1 JMP WRR5 * LDB STAT2 CLEAR OVERLAP CHECK BIT. BLR,BRS STB STAT2 WRR6 JSB EXEC READ THROUGH SMD. DEF *+5 DEF LOKOP WITH NO ABORT BIT SET. DEF ICNWD DEF IOBUF DEF D69 JMP SPT2 HOLD I.O. * ALF,ALF CHECK STATUS WORD. SSA JMP EOF END OF FILE. * STB TEMP2 SAVE THE TRANSMITTED LENGTH LDA STAT1 CCE,SSA,RSS WHAT TYPE OF FILE? CPB D1 FIRST REASONABLE NESS TEST ONE WORD JMP RSTAN STANDARD. * LDA IOBUF OUTSPOOL WITH HEADERS. XOR STAT2 FORM THE CON WORD AND B3700 XOR STAT2 UNDER THE RULES OF WOO STA TEMP5 SALT IT AWAY LDA IOBUF GET THE REQUEST CODE AND OKBIT (=B24077) ALL BUT LEAST 2 SHOULD BE 0 CCE,SZB FORCE ZERO LENGTH READS TO FAIL CPA D3 IF CONTROL JMP CNTST GO TRY IT * CPA D2 BETTER BE A WRITE RSS GOOD SHOW GO DO IT JMP RSTAN WRONGLY FLAGGED * LDA IOBUF+1 FIGURE FINAL LENGTH OF LINE CCE,SSA IF CHAR ARS CONVERT TO WORDS SSA CMA,INA ADA D2 SHOULD MATCH THE READ LENGTH IN B CPA B DOES IT?? JMP OK YES STILL OK * LDA D67 CPB D69 COULD BE TOO LONG A LINE IF SO JMP LONG USE IT * JMP RSTAN WRONGLY FLAGGED AS NON STANDARD FILE * OK LDA IOBUF+1 LONG STA TEMP2 SET THE LENGTH LDA TEMP5 SAVE THE CONFIGURED STAT WORD FOR EOF STA STAT2 LDB BUFR2 GET THE BUFFER ADDRESS JMP SEND1 * RSTAN LDA STAT1 REFLAG IT ELA,RAR SET THE STANDARD BIT STA STAT1 AND LDB BUFAD GET THE BUFFER ADDRESS LDA STAT2 AND THE CON WORD SEND1 ALR,ARS CLEAR THE SIGN BIT STA TEMP5 SET THE CON WORD STB BUFFR AND THE BUFFER ADDRESS * JSB DOWN? MAKE SURE NOT DOWN (NO RETN IF SO) JSB EXEC WRITE A LINE TO DEF *+8 A DEVICE. DEF D18 DEF TEMP5 BUFFR BSS 1 BUFFER ADDRESS DEF TEMP2 BUFFER LENGTH DEF STAT1 CLASS PARAMETER. DEF FLCNT CLASS PARAMETER. DEF SP.CL LDA STAT1 FIRST TIME THROUGH ADA C377 DECREASE COUNT OF LINES STA STAT1 SET IT BACK JSB SLCNT LDA STAT1 NEED TO DO ANOTHER AND B7400 ISZ GETEQ IF FIRST LINE WAIT FOR COME BACK SZA,RSS IF COUNT DOWN TO ZERO WAIT JMP SPT2 YES- BACK TO GET LOOP. * JMP WRR10 COUNT NOT ZERO AND NOT FIRST LINE * D67 DEC 67 C377 OCT 177400 OKBIT OCT 24077 B7400 OCT 7400 CNTST CPB D2 BETTER BE A TWO WORD RECORD RSS GOOD SHOW JMP RSTAN NO GOOD GO RETYPE IT * JSB DOWN? NO RETURN IF DOWN DEVICE JSB EXEC SEND CONTROL REQUEST. DEF *+5 DEF D19 DEF TEMP5 DEF IOBUF+1 DEF SP.CL JMP WRR10 * WRR4 ADA M1 LDB A,I FOUND A RECORD MATCH. BLR,BRS IS THIS THE SAME ENTRY INA CPB ICNWD WE PICKED UP BEFORE. JMP WRR7 YES. * LDA B GET THE LU TO A FOR GETEQ JSB GETEQ NO. CHECK FURTHER. CCA h GET CURRENT LINE COUNT ADA LCNT FROM THE READ EQT LDA A,I TO A CMA AND COMPARE ADA B,I WITH THE WRITE EQT SSA,RSS JMP WRR6 WE ARE OK. * INB SET UP WRITE EQT STB LCNT LDA STAT1 OVERLAP FAILED - SET EQT32 IOR DVCHK AND EQT33 IN LU OF FILE LDB FLCNT BEING WRITTEN SO THAT SMD STA STAT1 STB STAT2 JSB SLCNT WILL CALL US BACK WHEN IT JMP SPT2 HAS WRITTEN ANOTHER RECORD. * GETEQ NOP THIS ROUTINE FINDS US THE ADA M1 EQT ADDRESS CORRESPONDING ADA DRT TO A GIVEN LU #. LDA A,I AND B77 ADA M1 MPY D15 ADA EQTA ADA D12 LDB A,I ADB D15 JMP GETEQ,I * PUT NOP JSB $LIBR NOP STA B,I JSB $LIBX DEF PUT * EOF STB GETEQ SAVE THE EOF STATUS FLAG LDB LCNT ADB M3 CLA JSB PUT CLEAR THE FLAG SO WILL NOT BELIEVE FURTHER GETS LDA STAT2 END OF FILE. AND B77 ISOLATE OUTSPOOL LU. STA TEMP1 AND SAVE IT. LDB GETEQ GET THE EOF FLAG LDA STAT2 AND THE LAST USED MODE AND B100 ISOLATE THE MODE BIT SZB IF GOOD EOF SZA OR BINARY FILE JMP EOF0 SKIP MESSAGE * JSB DOWN? DO THE DOWN CHECK JSB EXEC SEND THE BAD EOF MESSAGE DEF *+8 DEF D18 DEF TEMP1 DEF EOFER DEF D4 DEF STAT1 DEF STAT2 DEF SP.CL JMP EOF1 NOW SEND ALL POSSIBLE EOFS * EOF0 SSB IF BAD EOF JMP EOF1 SEND ALL POSSIBLE EOF'S FOR ALL FILES * LDA STAT1 SSA,RSS STANDARD FILE? JMP EOF2 NO - HAVE HEADERS.. * EOF1 LDA B100 JSB CNTRL SEND EOF LDA B1000 JSB CNTRL SEND LEADER REQUEST LDA B1100 JSB r,CNTRL SEND TOP OF FORM REQUEST EOF2 JSB LURQ UNLOCK THE LU DEF *+4 OF THE OUTSPOOL DEF B40K JUST COMPLETED. DEF TEMP1 DEF D1 NOP IGNORE ERROR RETURN LDA STAT1 TELL SMP WE ARE GOOD AND B77 AND FINISHED WITH THIS FILE. STA TEMP1 LDA D12 SEND DEQUE TO SMP SMPC STA SLCNT SET CALL CODE JSB EXEC DEF *+6 DEF D24 DEF SMP DEF SLCNT RQ PRAM DEF TEMP1 CURRENT LU DEF GETEQ EOF STATUS JMP SPT2 * SLCNT NOP JSB $LIBR NOP LDA STAT1 LDB STAT2 DST LCNT,I LCNT EQU *-1 JSB $LIBX DEF SLCNT * CNTRL NOP IOR TEMP1 PICK UP STA ICNWD AND SET THE CON WORD JSB DOWN? CHECK IF DOWN JSB EXEC SEND CONTROL REQUEST. DEF *+5 DEF D19 DEF ICNWD DEF M1 DEF SP.CL JMP CNTRL,I * DOWN? NOP TEST FOR DOWN DEVICE CCA ADA STAT2 THAN THE LU AND B77 ISOLATE ADA DRT INDEX INTO THE DRT STA B SAVE FOR LU TEST CCA SET TO GET THE EQT JSB $LIBR GO PRIV TO STOP RACES NOP ADA B,I EQT NO-1 AND B77 ISOLATE THE EQ NO. CPA B77 IF NO EQT THEN JMP DWNEX GO SENT THE LINE * ADB LUMAX INDEX TO LU FLAG LDB B,I IF SIGN SET THEN DOWN SSB ELSE UP JMP DOWN * MPY D15 GET EQT ADDRESS ADA EQTA ADA D4 TO A LDA A,I GET THE WORD RAL,SLA IF DOWN JMP DWNEX NOT DOWN EXIT * SSA,RSS SKIP JMP DWNEX ELSE GO EXIT * DOWN JSB $LIBX DEVICE IS DOWN DEF *+1 DEF *+1 LDA ICNWD SET UP TO CALL SMP AND STA TEMP1 IOR B200 BACK SPACE ON RECORD STA TEMP2 JSB EXEC BACKT0.* SPACE IN FILE DEF *+3 DEF D3 DEF TEMP2 LDA D18 JMP SMPC GO NOTIFY SMP TO PUT IN HOLD * DWNEX JSB $LIBX UP SO DEF DOWN? GO DO THE CALL * * STORAGE * D4 DEC 4 B200 OCT 200 A EQU 0 B EQU 1 EQTA EQU 1650B DRT EQU 1652B LUMAX EQU 1653B SMP ASC 3,SMP EOFER ASC 4, BAD EOF TEMP1 BSS 1 TEMP2 BSS 1 TEMP3 BSS 1 TEMP5 BSS 1 FILNO OCT 100000 FLCNT BSS 1 STAT1 BSS 1 STAT2 BSS 1 LOKOP OCT 100001 NOABT OCT 140001 ICNWD BSS 1 BUFR2 DEF IOBUF+2 B40K OCT 40000 D1 DEC 1 D2 DEC 2 D3 DEC 3 D10 DEC 10 D11 DEC 11 D12 DEC 12 D15 DEC 15 D18 DEC 18 D19 DEC 19 D21 DEC 21 D24 DEC 24 D69 DEC 69 M1 DEC -1 M2 DEC -2 M3 DEC -3 B77 OCT 77 B100 OCT 100 B1000 OCT 1000 B1100 OCT 1100 B3700 OCT 3700 DVCHK OCT 10000 DONT OCT 20000 * END SPOUT 0   92060-18012 1840 S 0122 RTE-III CORE RES. OP. SYS. HEAD             H0101 ASMB,Q * * NAME: $OPSY * SOURCE: 92060-18012 * RELOC: 92060-16012 * PGMR: L.W.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM $OPSY,0 92060-12003 REV.1840 780810 END Q  92060-18013 1813 S 0322 RTE III DISPATCHER              H0103 `QASMB,R,L,C ** RT DISPATCHER MODULE ** HED REAL TIME DISPATCHER * DATE: 5/5/75 * NAME: DISPM * SOURCE: 92060-18013 * RELOC: 92060-16013 * PGMR: G.A.A.,L.W.A.,D.L.S. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM DISPM,0 92060-16013 REV.1813 780212 * SUP ******************************************************************** * * ***** AMD ***** JUL,73 * * ******************************************************************** * * DISPATCHER ENTRY POINT NAMES * ENT $RENT,$BRED,$ZZZZ,$XEQ ENT $MRMP,$ENDS,$MATA,$MPFT,$BGFR,$RTFR ENT $ALDM,$DMAL,$SMAP,$PRCN ENT $EMRP,$LPSA,$XDMP * * DISPATCHER EXTERNAL REFERENCE NAMES * EXT $RSRE,$ABRT,$XSIO,$DREQ EXT $WATR,$TIME,$DREL,$TRRN EXT $IOCL,$IRT EXT $ABRE,$LIST,$RTST,$SGAF * ************MEW INSTRUCTIONS********* * MIC USA,101711B,0 ************************************* * * * ******************************************************************** * * THE DISPA MODULE OF THE HP-2100 REAL TIME EXECUTIVE * * PERFORMS THE FOLLOWING FUNCTIONS: * * 1. IDLE LOOP WHEN NO PROGRAMS ARE SCHEDULED OR CANNOT BE * * EXECUTED. * * 2. SWITCHES PROGRAM EXECUTION SUCH THAT THE HIGHEST * * PRIORITY EXECUTABLE PROGRAM EXECUTES. * * 3. SETS THE FENCE REGISTER ACCORDING TO PROGRAM TYPE. * * 4. LOADS, SWAPS, AND EXECUTES DISC RESIDENT PROGRAMS * SPC 4 ABORT LDA B,I GET POSSIB[LE NEXT PGM STA $ZZZZ AND SET IT FOR ABORT CLA CLEAR THE XSUSP ADDRESS STA B,I FOR THE NEXT START ADB DM8 BACK UP TO ID-SEG ADDRESS STB A SAVE THE ID-SEG. ADDRESS STB TMP A FEW TIMES ADA D14 CHECK IF DISC RES. LDA A,I PROGRAM STA ATMP SAVE TYPE FOR LATER CHECK RAR,SLA IF TYPE 2 OR 3 JSB DREL RELEASE ANY SWAP TRACKS LDB TMP RELEASE ANY RE-ENTRENT JSB $ABRE MEMORY PROGRAM OWNS. LDB TMP RELEASE ANY STRING STORAGE JSB $RTST MEMORY THAT THE PROGRAM OWNS. * LDB TMP JSB $WATR SCHEDULE ANYONE WAITING LDB TMP LDA B ADA D20 STA TEMP SAVE ADDR OF FLAG WORD LDA A,I ALF,ALF GET FLAG WORD SLA ANY RESOURCES HELD? JSB $TRRN YES, RELEASE THEM * CLA IF CURRENTLY LDB TEMP,I STA TEMP,I (CLEAR FLAG WORD) SLB IS HE SERIALLY REUSABLE JMP $XEQ YES,LEAVE IN MEMORY LDA ATMP GET TYPE AND D15 CPA D1 IS IT MEM RES JMP $XEQ YES,DONT FOOL WITH PARTITION LDA TMP GET ID SEG ADR JSB MATEN GO SET UP POINTERS LDB MID,I GET PART RESIDENT CPB TMP IS PROG STELL RESIDENT RSS YES JMP $XEQ NO,DONT BOTHER WITH IT LDB MRDFL,I SSB IS IT REAL TIME PART JMP XN253 YES JMP XN153 NO SKP * CALLING SEQUENCE * JMP $XEQ * $XEQ LDB $ZZZZ CHECK IF PROGRAM TO BE ABORTED SZB JMP ABORT YES GO HANDLE IT LDB $LIST IF LIST NOT ENTERED SZB,RSS THEN NOTHING NEW SO JMP $IRT GO CONTINUE CURRENT PGM * X0005 LDA SKEDD LOAD TOP OF SCHEDULE LIST CLB STB $LIST PREVENT NEEDLESS LIST SCANS RSS SKIP FIRST TIM+E X0035 LDA ZWORK,I GET THE NEXT PGM IN THE LIST SZA,RSS IF ZERO,THEN NO PROG SCHED JMP ILOOP GO IDLE LOOP CPA SGSUP IS THIS PROG SEG LOAD SUSPENDED LDA A,I YES,TRY NEXT PROG SZA IF ZERO, THEN NO PROG SCHED JMP X0010 GO TO PROCESS SCHED LIST * * NO PROGRAM SCHEDULED--SETUP FOR IDLE LOOP * * * THE IDLE LOOP SECTION CONSISTS OF: * * CLEARING XEQT WORD TO SIGNIFY THAT NO PROGRAM * * CURRENTLY EXECUTING. * * STORE ADDRESS OF 4 DUMMY WORDS INTO XSUSP-XSUSP+3 * * DUE TO I/O PROCESSING. * * SET MEMORY PROTECT REGISTER TO ZERO. * * CALL INTERRUPT RESTORE ROUTINE, $IRT * JUMP TO * * * * ILOOP STA FENCE SET THE FENCE TO ZERO OTA 5 STA XEQT CLEAR XEQT ADDRESS VALUE LDB VSUSP SET XSUSP,XA,XB,XEO STB XSUSP TO POINT INB TO DUMMY STB XA LOCATION STB XB STB XEO STB XI JMP $IRT GO TO IDLE LOOP (JMP *) * IDLE JMP * IDLE LOOP SPC 1 XQDEF DEF XLINK XEQT TABLE ADDRESS VSUSP DEF *+1 ADDRESS OF IDLE DUMMY WORDS DEF IDLE DUMMY XEQT IDLE WORDS OCT -1 NOP SKP X0N35 LDA ZMPID,I IS LOAD FLAG SET SSA JMP X0035 CANT SWAP IS S=1,PART SPEC AT LOAD LDB LSTHD,I GETNEXT IN LIST SZB,RSS JMP X0035 END OF LIST, TOUGH LUCK XN351 CPB ALIST END OF DORMANT LIST LDB B,I YES,BUMP ONE MORE JMP SCHLA GO TRY NEXT ONE SKP * * THE SWITCHING SECTION USES THE SCHEDULE LIST TO DETERMINE * * WHICH PROGRAM TO EXECUTE-STARTING FROM TOP OF LIST. * * IF PROGRAM FROM LIST OF LOWER OR EQUAL PRIORITY, * * THEN EXECUTION OF CURRENT PROGRAM CONINUES. * * IF PROGRAM FROM LIST OF HIGHER PRIORITY AND * * TYPE EITHER REAL TIME RESIDENT OR BACKGROUND * * RESIDENT, EXECUTION SWITCHING TAKES PLACE.* * TYPE IS BACKGROUND DISC RESIDENT, * * GO TO BACKGROUND DISC PROCESSING. * * TYPE IS REAL TIME DISC RESIDENT, GO TO REAL * * TIME DISC RESIDENT PROCESSING * * X0010 STA ZWORK SCHED LIST PROG ID SEG ADDRESS ADA D6 STA ZPRIO PRIORITY ADDRESS ADA D8 STA ZTYPE TYPE ADDRESS ADA D7 STA ZMPID MAP WORD ADDRESS LDA A,I AND S1700 SET UP FENCE INDEX LSL 1 FOR PROGRAM TRYING ALF,ALF TO BE DISPATCHED. STA MPN * * CHECK IF CURRENT PGM IS STILL TOP. * LDA XEQT SEE IF PROGRAM CURRENTLY EXECUTING SZA,RSS YES SKIP JMP X0030 NO, SO GO XECUTE IT ADA D15 CHECK STATUS OF XEQT ID SEGMENT LDA A,I AND D15 MASK TO MAJOR STATUS CPA D1 RSS SCHEDULED-SO GO TO CHECK PRIORITY JMP X0030 NOT SCHEDULED -SO GO SWITCH LDA XPRIO,I LOAD TEST PROGRAM PR CMA,INA MAKE NEGATIVE ADA ZPRIO,I SUPTRACT FROM CURRENT PGM PR. SSA,RSS IF SIGN A=0 THEN PROG OF HIGHER PR JMP $RENT PROGRAM OF HIGHER PRIORITY * * CHECK PROGRAM TYPE * X0030 LDA ZTYPE,I PROGRAM TYPE AND D15 STA TMP CPA D1 CHECK IF REAL TIME RESIDENT JMP X0F40 YES LDB ZMPID,I SSB ASSIGNED TO A PARTITION JMP PCHK YES,GO SEE WHAT TYPE CPA D2 CHECK IF REAL TIME DISK RESIDENT JMP X0200 YES  CPA M3 CHECK IF BACKGROUND DISK RESIDENT PROGRAM JMP X0100 YES JMP X0035 NOT LEGAL TYPE, IGNOR PCHK LDA B ASSIGNED TO PART AT LOAD TIME AND B77 MPY D6 ADA MATA GET PART ADR ADA D5 GET FLAG WORD LDA A,I SSA IS IT RT JMP X0200 YES JMP X0100 NO,BACKGROUND D5 DEC 5 ATMP BSS 1 * DM8 DEC -8 DM12 DEC -12 D7 DEC 7 M40 OCT 40 SKP X0F40 LDA MRMP GET ADR MEM RES MAP USA LDA ZMPID,I GET MAP ID WORK AND S1700 ALF,ALF PICK OUT MPFT INDES RAL STA MPN STORE MPFT INDEX LDA ZWORK STA MEMID SET ID FOR MEM RES PROG ADA MI GET ADR FOR INDEX REGISTERS STA XI SET POINTER TO INDEX REGISTERS LDA $EMRP STA RTDRA STA AVMEM STA BKDRA STA BKLWA LDA ADMEM STA MID JMP X0N40 ADMEM DEF MEMID MEMID BSS 1 MPN BSS 1 INDEX TO MPFT, BP FLAG PGN BSS 1 PROG LENGTH $EMRP BSS 1 $LPSA BSS 1 MLNK BSS 1 LINKAGE WORD MPRIO BSS 1 PRIORITY RESIDENT MID BSS 1 ID SET ADR MADR BSS 1 MAP START,BITS 0-9 MLTH BSS 1 PART LENGTH, BITS 0-9 MRDFL BSS 1 READ FLG(0-2),RT FLAG(15) CNT BSS 1 PARTITION # B77 OCT 77 C77 OCT 177700 B76K OCT 76000 S1700 OCT 101700 SCREEN FOR LOAD FLAG &MP INDEX B1777 OCT 1777 D21 DEC 21 MFLGS BSS 1 UPPER BITS B7 OCT 7 PTNUM EQU B77 LTH BSS 1 MI OCT 177776 MINUS # INDEX REGS LSTHD BSS 1 NPGN BSS 1 SPRIO BSS 1 ABGFR DEF $BGFR ADR BG FREE LIST ABGPR DEF BGPR ADR BG ALC LIST HD ARTFR DEF $RTFR ARTPR DEF RTPR ALIST BSS 1 FLIST BSS 1 $MRMP BSS 1 ADDR MEM RES MAP $ENDS BSS 1 PAGES OCCUPIED BY SYSTEM ,LIBR $MATA BSS 1 ADR FIRST ENTRY MAT $MPFT BSS 1 ADR MEM PRT FRNCE TABLE MRMP EQU $MRMP MATA EQU $MATA MPFTA EQU $MPFT $BGFR BSS 1 LIST HEAD BG FREE PART BGPR BSS 1 $RTFR BSS 1 LIST HEAD RT FREE LIST RTPR BSS 1 LIST HEAD RT ALC LIST ABGDM DEF BGDM ARTDM DEF RTDM BGDM DEF BGPR RTDM DEF RTPR DLIST NOP D22 DEC 22 SPC 2 ******************************************* ************MAT ENTRY********************** *EACH MAT ENTRY WILL BE AS FOLLOWS: * * WORD PURPOSE * 0 LINKAGE (ADR NEXT ENTRY IN LIST) * 1 PRIORITY OF RESIDENT * 2 ID SEG ADR * 3 BEGINNING PAGE ADR OF PARTITION * BITS 0-9,BP FLAG BIT 15,DORMANT * FLAG BIT 13 * 4 NUMBER PAGES OCCUPIED BY PARTITION * BITS 0-9,RESERVED FLAG BIT 15 * 5 READ COMPLETION FLAG OF RESIDENT * BITS 0-2,REAL TIME FLAG BIT 15 * * *THE FOLLOWING ARE SET AT GENERATION TIME: * BEGINNING PAGE ADR (WORD 3) * NUMBER PAGES IN PART (WORD 4) * REAL TIME FLAG (WORD 5) * RESERVED FLAG (WORD 4) * *THE FOLLOWING ARE SET AT PARTITION ASSIGNMENT: * LINKAGE (WILL CHANGE IF PROG STATUS CHANGES * OR PRIORITY CHANGES) * PRIORITY (WILL CHANGE IF PROG CHANGES PRIO) * ID ADR (CLEARED WHEN PART BECOMES FREE) * BP FLAG (OBTAINED FROM MPID WORD IN ID SET) * DORMANT FLAG (SET ON SAVE RESOURCES COMPLE) ************************************************* HED LOAD PROGRAM ID SEG ADR IN XEQT AREA X0040 LDA MID,I GET ID SET ADR ADA D22 GET LOW MAIN LDB A,I STB XI LDA PGN GET LENGTH IN PAGES LDB MLNK GET PART ENT ADR JSB $SMAP GO SET UP USER MAP X0N40 LDB ZWORK IF SAME AS CURRENT PGM CPB XEQT THEN JMP $RENT SKIP BASE PAGE SET UP. LDA DM12 LOAD PROGRAM TO BE EXECUTED STA TMP INTO XEQT AREA LDA XQDEF STB XEQT X0041 STB A,I INA INB ISZ TMP JMP X0041 LDB XSUSP,I CHECK IF PROGRAM SUSPENDED CMB,3INB,SZB IF SO THEN JMP $RENT GO SET IT UP LDB XPENT,I GET PRIMARY ENTRY PT. STB XSUSP,I SET ENTRY ADDRESS LDA ZTYPE,I IF BACKGROUND SLA DISC RESIDENT IOR M40 SET THE STA ZTYPE,I ALL OF CORE BIT. * * CHECK IF PT OF SUSPENSION IN LIBRARY AREA * $RENT LDA XEQT GET PROG TRYING DISPATCH CPA MID,I HAS SETUP CHANGED RSS NO,GO TO IT JSB FIX GO SET BACK UP CPA ZWORK INSURE Z WORDS RSS MATCH CURRENTLY JSB FIX EXECUTING PROGRAM. LDB XTEMP+4 GET THE RENT BIT ADB D15 LDB B,I GET THE WORD BLF,RBL ROTATE TO PUT RENT BIT IN SIGN SSB,RSS IF RENT NOT IN CONTROL JMP X0028 GO SET FENCE SLB IF MEMORY MOVED JSB $RSRE GO RESTORE IT LDA FREG1 SET THE LIBRARY FENCE JMP X0029 GO SET IT UP SKP * * ****************************************************** ******************************************************* *******NOTE THAT FIX IS BEING CALLED****************** *******TO RESET MAT POINTERS--THUS******************* *******THE TEMP WORDS MUST BE RESET****************** ***************************************************** ****AREG MUST CONTAIN XEQT ON ENTRY************** * FIX NOP ROUTINE TO RESET MAT POINTERS FOR CURRENT PROG STA ZWORK RESET UP TEMP WORDS ADA D6 STA ZPRIO ADA D8 STA ZTYPE ADA D7 STA ZMPID LDA ZTYPE,I GET PROG TYEP AND D15 CPA D1 JMP X0F40 GO RESET MEM RES INFO LDA ZMPID,I AND S1700 LSL 1 ALF,ALF GET MP FENCE INDEX STA MPN JSB FND GO SET MAT POINTERS, BNDRY WORDS LDA XEQT RESET A-REG TO CURRENTLU XECUTING PROG. JMP FIX,I * * * SET MEMORY PROTECT ACCORDING TO PROG TYPE * * X0028 LDA MPN GET AMPFT INDEX ADA MPFTA LDA A,I GET FENCE X0029 STA FENCE OTA 5B * * RESTORE REGISTERS, MEMORY PROTECT, AND TURN ON INTERRUPT SYSTEM * X0031 JMP $IRT GO EXECUTE THE PROGRAM HED XEQ PROCESSOR--BUFFERS, CONSTANTS, POINTERS, ETC * ZMPID NOP * ZWORK NOP SCHED LIST ID SEGMENT ADDRESS ZPRIO NOP SCHED LIST PRIORITY LIST ZTYPE LDB SKEDD SCHED LIST PRIORITY ADDRESS SPC 1 TEMP ADB D6 TEMPORARY WORKING STORAGE AREA TEMP1 STB ZPRIO TEMP2 INA TEMP3 LDB B,I TEMP4 STB A,I TEMP5 CLB TEMP6 STB ZPRIO,I ZEXIT LDB BKRED JMP $ZZZZ,I TMP BSS 1 TEMPORARY WORKING STORAGE TMP1 BSS 1 TMP2 BSS 1 CN#SC NOP CURRENT # SECTORS/TRACK (-) * DM3 DEC -3 * D2 DEC 2 D4 DEC 4 D8 DEC 8 D6 DEC 6 D14 DEC 14 D15 DEC 15 D20 DEC 20 D27 DEC 27 * D1 OCT 1 M3 DEC 3 B177 OCT 177 B377 OCT 377 SKP ******************************************** *ROUTINE TO SET USER MAP *CALL: AREG=LENGTH IN PAGES * BREG=ADR MAT ENTRY ******************************************** * * $SMAP NOP STB XADR MAT ENTRY ADR STA XPGN JPROG LENGTH IN PAGES ADB D2 LDA B,I GET ID ADR ADA D22 LDA A,I GET LOW MAIN AND B76K GET START PAGE ALF RAL,RAL GET IN LOW 5 BITS LDB ENDSY GET RESITER USER STARTS ON STB STUSR START USER WITH NO COMMON CMB,INB ADB A SZB,RSS B=0,NO COMMON JMP MAPUS NO COMMON MAPCM STA STUSR SAVE START REG USER LDA ENDSY A REG START COMMON ADA D32 GET TO USER MAP CBX BREG HAS # REGISTERS LDB $ENDS ADR OF START REG VALUE CM1 XMS MAP COMMON MAPUS CLA,INA CAX SET TO MAP BASE PAGE REGISTER LDA D32 FIRST REG IN USER MAP LDB XADR ADB D3 GET TO START PARTITION WOR;D LDB B,I ELB,BRS GET TO START PARTITION WORD STB STVAL STORE START VALUE LDB STVAL GET ADR START VALUE XMS MAP BASE PAGE SEZ,RSS E=1,DONT INCREMENT START VALUE ISZ STVAL LDA D32 ADA STUSR START REG IN USER MAP LDX XPGN GET LENGTH PROG LDB STVAL XMS MAP MAPRM LDB STUSR PROTECT REST OF MAP ADB XPGN STB STUSR CMB,INB ADB D32 SZB,RSS IF B=0,FINISHED JMP $SMAP,I CBX GET # REGISTERS IN X LDA STUSR GET START REGISTER ADA D32 LDB PRTCT GET PROTECT VALUE XMS JMP $SMAP,I YES,RETURN PRTCT OCT 140000 READ & WRITE PROTECT ENDSY EQU $ENDS STVAL BSS 1 XADR BSS 1 XPGN BSS 1 STUSR BSS 1 D32 DEC 32 * * *************EXTERNAL ROUTINE TO SET USER MAP******** ***************************************************** **********CALL: LDA IDADR AREG HAS ID SEG ADR ********** JSB $PVMP ********** --RETURN ********** AREG=0 ON RETURN IS ERROR--SAYS PROGRAM ********** NOT IN PARTITION * * * $XDMP NOP STA XADR TEMP SAVE OF ID ADR LDB A ADB D14 LDA B,I AND D15 IS PROG MEM RES CPA D1 JMP MRPV YES,GO SET MEM RES MAP ADB D7 GET MPID WORD LDA B,I STA XPGN TEMP SAVE AND B77 MPY D6 ADA MATA GET PART ADR LDB A B HAS MAT ENTRY ADA D2 LDA A,I CPA XADR IS PROG STILL IN PARTITION JMP *+3 YES ,CONTINUE CLA NO,ERROR JMP $XDMP,I ERROR RETURN LDA XPGN AND B76K ALF RAL,RAL GET LENGTH JSB $SMAP GO SET MAP CCA MAKE SURE A NOT 0 JMP $XDMP,I RETURN MRPV LDA MRMP USA SET MEM RES MAP JMP $XDMP,I D3 DEC 3 SKP * ********************************************** ****ROUTINE TO SEARCH FOR A PARTITION** ********************************************** * FNDSG NOP LDA ZMPID,I GET ID SEG ADR AND B77 GET PART # STA CNT MPY D6 MULTIPLY BY MAT ENTRY LENGTH ADA MATA STA MLNK SAVE PART ADR ADA D2 STA MID SET POINTER TO PART RESIDENT LDA ZMPID,I AND B76K GET PROG LENGTH CCB ADA B STA LTH INA ALF RAL,RAL STA PGN SAVE LENGTH IN PAGES LDA ZMPID,I AND S1700 GET MPFT INDES CLE,ELA GET LOAD FLAG IN E ALF,ALF STA MPN MPN HAS MPFT INDEX AND BF FLAG(15) ****************************************** *AT THIS POINT THE FOLLOWING WORD ARE IN USE *CNT--PARTITION NUMBER PROG LAST IN *MID--MAT ENTRY ADR FOR PARTITION ID SEG *PGN--PROGRAM LENGTH IN PAGES *MPN--BITSD 0-3,MPFT INDES * BIT 15,BP LOAD FLAG(1,RECVER BP AREA *EREG--LOAD FLAG,E=1,CNT IS PARTITION SPEC * AT LOAD,E=0,CNT IS PART LAST IN ****************************************** LDB MID,I CPB ZWORK PROG STILL IN PARTITION JMP FNDNS YES SEZ,CLE NO,IS LOAD FLAG SET JMP FNDSW YES GO SEE IF CAN SWAP ****************************************** ***SEARCH FOR PARTITION********* ********** SRCH LDB PGN GET NEG LENGTH OF PROGRAM CMB,INB STB NPGN LDB FLIST GET POINTER TO FREE LIST HEADER JSB SCHFR GO SEARCH FOR FREE PARTITION LDA ZPRIO,I NO FREE PARTITION CMA,INA STA SPRIO SEARCH ALLOC LIST FOR PART LDB ABGPR LOAD BR ALLOCATED LIST POINTER LDA MID GET ADR PART RES ADA M3 GET RDFLG ADR LDA A,I SSA IS THIS RT PARTITION LDB ARTPR YES,LOAD RT ALLOCATED LIST POINTER AND B7 CPA M3 RESIDENT SWAPPED OUT RSS YES JMP SRCNT NO,CONTINUE SEARCH CLA CPA CNT IS THIS PARTITION ZERO JMP *+3 YES,CONTINUE PARTITION CHECK CNTSW JSB FND NO,GO USE THIS PARTITION JMP FNDSG,I CPB ALIST IS THIS RIGHT TYPE PARTITION RSS YES,CONTINUE JMP SRCNT NO,GO SEARCH ALLOCATED LIST LDA MID ADA D2 GET LENGTH WORD LDA A,I SSA IS THIS RESERVED PARTITION JMP SRCNT YES,DON'T USE AND B1777 NO,GET LENGTH ADA NPGN SSA,RSS S=0,PARTITION LONG ENOUGH JMP CNTSW LONG ENOUGH,GO USE IT SRCNT LDB DLIST,I LESS OR EAUAL PRIORITY CPB ALIST IS DORM LIST EMPTY LDB B,I YES,BUMP TO ALLOC LIST JSB SCHAL GO SEARCH JMP X0035 CANT SWAP, GO TRY SOMEONE ELSE SCHND NOP LDA MATA GET ADR OF MAT CMA,INA ADA LSTHD CLB DIV D6 CALCULATE PART # LDB A LDA ZMPID,I GET MAP ID WORD AND C77 IOR B STA ZMPID,I KJPUT NEW PART # IN JMP SCHND,I SKP * * *************************************** *ROUTINE TO SEARCH FOR A FREE PARTITION ****CALL: JSB SCHFR * --NO FIND RETURN * BREG--POINTER TO LIST HEADER * NPGN--NEG CURRENT LENGTH *************************************** * * ********************************************* **FREE LIST IS IN ORDER OF INCREASING SIZE ********************************************** SCHFR NOP FR1 LDA B,I GET ADR ENTRY(HAS LINK WORD) SZA,RSS END OF LIST JMP SCHFR,I YES,NO FREE PART STA LSTHD STRE CURRENT ENTRY ADR ADA D4 LDA A,I GET LENGTH PARTITION SSA PART RESERVED JMP FR2 YES,CANT USE AND B1777 SCREEN OUT FLAGS ADA NPGN SEE IF GRTR,EQUAL TO CURRENT PRG SSA,RSS IS S=0 PART BIG ENOUGH JMP FNDFR FOUND ONE FR2 LDA LSTHD jOHFB STA B JMP FR1 ********************************************* ******************************************** *UNLINK PART FROM FREE LIST *LIND PART INTO ALLOCATED LIST ******************************************** * * FNDFR LDA LSTHD,I GET ADR NEXT ENTRY STA B,I UNLINK CURRENT ENTRY JSB SCHND GO SET MAP ID WORD FNDF1 LDA ZWORK JSB MATEN GO SET UP MAT POINTERS LDA ZPRIO,I GET NEW PRIORTY STA MPRIO,I PUT IN PARTITION JSB ALINK GO LINK IN ALLOCATED LIST CLB SET TO CLEAR RESIDENT FLAG STB MID,I CLEAR PART ID WORD JMP FNDSG,I SKP 8H* ******************************************* ****ROUTINE SEARCHES FOR SUITABLE ALLOCATED * PARTITION. ALLOCATED LIST IS IN ORDER * OF INCREASING PRIORITIES(I.E. DECREASING * NUMBERS)--EXCEPTION:DORMANT PROGS WITH * SAVED RESOURCES AT FRONT OF LIST * (OF,SS,COMPLET)*********** ****CALL: NPGN--NEG LENGTH CURRENT * SPRIO--NEG PRIO CURRENT * JSB SCHAL * --NO PARTITION RETURN ******************************************** * * SCHAL NOP SCHLA SZB,RSS LIST EMPTY JMP SCHAL,I YES SCHL1 STB LSTHD STORE C URRENT LIST HEAD ADB D4 LDA B,I SSA PARTITION RESERVED JMP SCHL2 YES,CANT USE AND B1777 GET PARTITION LENGTH ADA NPGN SSA,RSS IS S=0,PART IS GRTR,EQUL IN LENGTH JMP SCHL3 LONG ENOUGH SCHL2 LDB LSTHD,I SZB END OF LIST JMP XN351 NO, KEEP LOOKING JMP SCHAL,I NO PARTITION SCHL3 LDB LSTHD ADB D2 LDB B,I GET PARTITION ID ADR ADB D14 LDA B,I AND D100 ISOLATE CORE LOCK BIT SZA IS IT SET JMP SCHL2 YES, KEEP LOKING LDA LSTHD NO INA LDA A,I GET PART PRIO ADA SPRIO SUBTRACT CURRENT PRIO SSA,RSS S=0,CURRENTGRTR,EQUAL PART PRIO SZA,RSS IF A=0,CURRENT=PART PRIO RSS JMP FNDAL CURRENT IS GRTR,GO DO IT INB CURRENT IS LESS,EQUAL PART PRIO LDA B,I GET STATUS AND D15 CPA D1 IS PART SCHEDULED JMP SCHL2 YES, GO TRY SOMEONE ELSE FNDAL JSB SCHND GO SET MAP ID WORD CLE JSB FND GO SET UP RES FLAGS AND MAT JMP FNDSG,I SKP *********************************************** ****FOUND A PARTITION AND DON'T NEED TO SWAP **** ********************************************** FNDNS JSB FND GO SET UP RESIDENT FLAGS AND MAT LDA ZPRIO,I GET PARTITION PRIORITY  CPA MPRIO,I IS IST THE SAME AS CURRENT JMP FNDSG,I YES,CONTINUE STA MPRIO,I NO,RELINK IN ALLOCATED LIST JSB RLNK CAUSE PROG WAS DORMANT LDA MPN GET BP FLAG ELA,ARS STA MPN RESTORE MPFT INDEX LDA MADR,I GET BP FLG IN MAT ENTRY ALS,ERA STA MADR,I JMP FNDSG,I CONTINUE * ******************************************* ****FOUND A PARTITION AND NEED TO SWAP **** ****************************************** FNDSW CLE LDA MID,I SZA IS PART EMPTY JMP FDSW1 NO LDA FLIST YES LDB MLNK GO UNLINK FREE JSB ULNK JMP FNDF1 FDSW1 JSB FND GO SET UP JMP FNDSG,I CONTINUE * * **************************************** *FOUND A PARTITION, SO SET IT UP **************************************** * FND NOP LDA ZWORK JSB MATEN GO SET UP MAT POINTERS LDB MID,I GET OWNER OF PART LDA B ADA D14 LDA A,I AND D15 CPA D2 IS THIS REAL TIME JMP FNDR GO SET FOR RT PROG FNDB ADB D21 LDA B,I GET PROG LENGTH AND B76K ADA M1 FILL OUT PAGE INB LDB B,I GET LOW MAIN STB BKDRA STB LOADD ADA B STA BKLWA SET END OF CORE CCA ADA BKDRA STA RTDRA SET RT POINTERS TO ONE LESS BK STA AVMEM FAKE FOR RTE PROCESSORS JMP FND,I FNDR ADB D21 LDA B,I GET PROG LENGTH AND B76K ADA M1 FILL OUT PAGE INB LDB B,I STB RTDRA STB LOADD ADA B STA AVMEM STA BKDRA STA BKLWA JMP FND,I M1 DEC -1 SKP ************************************** ***SET UP POINTERS TO ENTRY IN MAT ************************************** * * ************************************** *AREG HAS ID ADR ON ENTRY * * MATEN NOP ADA D291 GET MAP ID WORD LDA A,I AND B77 GET PARTITION # STA CNT MPY D6 MULTIPLY BY MAT ENTRY LENGTH ADA MATA STA MLNK SET MAT ENTRY POINTER INA STA MPRIO ID SET PRIORTY INA STA MID ID SEG ADR INA STA MADR MAP START ADR INA STA MLTH PART LENGTH IN PAGES INA STA MRDFL READ COMP FLAG LDA MRDFL,I AND B7 XOR MRDFL,I STA MFLGS FLAGS IN READ COMP WORK JMP MATEN,I SKP * ****************************************** *RELINK PART BY NEW PRIORITY ***************************************** * RLNK NOP RELINK BY NEW PRIORITY LDA MADR,I AND DMFLG SEE IF IN DORMANT PART ALLOC LIST SZA,RSS JMP RLN1 NO XOR MADR,I YES STA MADR,I CLEAR FLAG LDA DLIST RLN2 LDB MLNK GET ADR CURRENT ENTRY JSB ULNK GO UNLINK JSB ALINK GO RELINK IN ALLOC BY NEW PRIO JMP RLNK,I RLN1 LDA ALIST GO UNLINK ALLOC LIST JMP RLN2 * * ******UNLINK ROUTINE******************** ****CALL: AREG--POINTER TO LIST HEAD * BREG--ADR MAT ENTRY LOOKING FOR * JSB ULNK * --RETURN AFTER UNLINKING ***************************************** * * ULNK NOP ULNK1 STA ULST LDA ULST,I GET ADR CURRENT ENTRY CPB A SAME AS ONE SEARCHING FOR RSS YES,GO UNLINK JMP ULNK1 GO TRY NEXT ENTRY LDB B,I GET THIS ENTRY'S LINK STB ULST,I STORE IN PREVIOUS ENTRY LING JMP ULNK,I ULST BSS 1 DMBP OCT 120000 * ****LINK INTO FREE LIST******* * FLINK NOP LDA MADR,I AND B1777 CLEAR DORM & BP FLAGS STA MADR,I LDA MLTH,I GET CURRENT LENGTH AND B1777 SCREEN OUT FLAGS LDB A CMB,INB FLN1 LDA FLIST,I GET FIRST ENTRY IN LIST SZA,RSS JMP FL N2 ADA D4 BUMP TO LENGTH WORD LDA A,I AND B1777 SCREEN OUT FLAGS ADA B SSA,RSS S=1 NEXT PARTITION SMALLER JMP FLN2 S=0, GO LING LDA FLIST,I STA FLIST GO CHECK NEXT ENTRY IN LIST JMP FLN1 FLN2 LDA FLIST,I GET PREVIOUS POINTER STA MLNK,I PUT IN THIS ENTRY LINK WORD LDA MLNK GET ADR THIS ENTRY STA FLIST,I PUT IN LINK WORD PREVIOUS ENTRY JMP FLINK,I * *******LINK IN ALLOCATED LIST********** * ALINK NOP LDA MLNK SET PART LINK ADR STA XLNK LDA MLTH SET PART LENGTH ADR STA XLTH LDB MPRIO,I GET CURRENT PRIOITY CLA STA XEND SET END LIST LDA ALIST STA XLST SET UP LINK LIST JSB XXLNK GO LINK JMP ALINK,I XLTH BSS 1 XLNK BSS 1 XEND BSS 1 XLST BSS 1 SKP * * ****SETUP FOR DORMANT LINK******* ******CALL: AREG--ID SEG ADR * JSB DSET * --RETURN WITH ULST-ALLOC LIST * XLST-DORM LIST ******************************** * DSET NOP STA XLTH SAVE IN TEMP CELL ADA D14 LDA A,I GET TYPE WORD AND D15 CPA D1 JMP DSET,I MEM RES,DONT LINK LDA XLTH ADA D21 LDA A,I GET MAPID WORK AND B77 GET PART # MPY D6 CALCULATE ADR ADA MATA STA XLNK STORE ADR JPARTITIONS LIND ADA D2 LDB A,I GET PART RES CPB XLTH SAME AS THE PROGRAM RSS YES JMP DSET,I NO, DON'T LINK ADA D2 SET UP TO PUT TOP ALLOC STA XLTH STORE ADR PART LENGTH INA LDA A,I GET FLAG WORD SSA BG DISK RES JMP DLRT NO LDA ABGDM STA XLST SET UP TO INSERT LDA ABGPR DORM LIST DLN1 STA ULST SET UNLINK HEADER STA XEND SET END LIST ISZ DSET JMP DSET,I DLRT LDA ARTDM STA XLST SET DORM LIST LDA ARTPR JMP DLN1 DMFLG OCT 20000 BIT 13 OF MAT WORK 3 INDICATED DMLIST *** * *********LINK DORMANT PROGAM IN ALLC LIST**** * * DLINK NOP JSB DSET GO SETUP JMP DLINK,I NO LINK RETURN,NOT STILL IN PART LDB XLNK ADB D3 LDA B,I GET WORK 3 MAT ENTRY AND DMFLG SZA IS IT ALREADY IN DORMANT LIST JMP DLINK,I YES, DON'T LINK AGAIN LDA DMFLG NO IOR B,I SO SET FLAG AND LINK STA B,I LDB XLNK LDA ULST JSB ULNK GO UNLINK ALLOCATED LIST LDA XLNK INA LDB A,I GET PRIORITY JSB XXLNK GO LINK JMP DLINK,I SKP * * ****PERFORM LINK INTO ALLOCATED LIST**** ******ROUTINE WILL INSERT IN ALLOCATED * LIST IN ORDER OF INCREASING * PRIORITY(DECREASING NUMBER). PART * OF SAME PRIORITY WILL BE IN ORDER * OF INCREASING LENGTH.*************** *****CALL---XLST--HAS ADR LIST HEADER * JSB XLINK * --RETURN AFTER LINK *****TEMPS USED * ALST--POINTS IN BACK * ALST,I:--POINTS IN FRONT *************************************** * * XXLNK NOP ALN1 LDA XLST,I GET FIRST ENTRY IN LIST CPA XEND END OF LIST JMP ALN3 YES INA BUMP TO PRIORITY WORK LDA A,I CMA,INA SCREEN OUT FLAGS ADA B ADD TO CUTTENT PRIORITY SSA,RSS S=1,NEXT PARTITION LOWER PRIORITY JMP ALN2 S=0,GO LINK ALNXT LDA XLST,I GO CHECK NEXT ENTRY STA XLST JMP ALN1 ALN2 SZA,RSS ARE PRIORITIES THE SAME JMP ALN4 GO ARRANGE BY LENGTH ALN3 LDA XLST,I GET PREVIOUS POINTER STA XLNK,I PUT IN THIS ENTRY LINK WORD LDA XLNK GET ADR THIS ENTRY STA XLST,I PUT IN LINK WORK PREVIOUS JMP XXLNK,I ALN4 LDA XLTH,I GET LENGTH C_URRENT ENTRY AND B1777 SCREEN OUT FLAGS CMA,INA STA CLTH LDA XLST,I ADA D4 LDA A,I GET LENGTH NEXT ENTRY IN LIST AND B1777 SCREEN OUT FLAGS ADA CLTH SSA S=1,CURRENT LENGTH GREATER JMP ALNXT GO SEE IF NEXT ENTRY BIGGER JMP ALN3 CURRENT SMALLER,GO LINK CLTH BSS 1 SKP * *******UNLINK ALLOCATED,LINK DORMANT**** * $ALDM NOP JSB DLINK JMP $ALDM,I NOT STILL IN PART OR ALREADY IN DM * * ****UNLINK DORMANT,LINK ALLOCATED**** * ****CALL: AREG--ID SEG ADR * JSB DMAL * RETURN **NOTE--MUST MAKE SURE IN DORMANT LIST ** BEFORE GET HERE**** ************************************* $DMAL NOP JSB DSET GO SET UP JMP $DMAL,I NOT IN PART,DONT CHANGE LDB XLNK ADB D3 LDA B,I XOR DMFLG CLEAR DM LIST FLAG STA B,I LDA XLST GO UNLINK DORM LIST LDB ULST STB XLST SET TO INSERT ALLOC LIST LDB XLNK JSB ULNK CLA STA XEND LDA XLNK INA LDB A,I GET PRIORITY JSB XXLNK GO LINK IN ALLOC LIST JMP $DMAL,I SKP * * *****RELINK FOR PR COMMAND********* **RELINKS IN ALLOC LIST BY NEW PRIORITY** * * $PRCN NOP STB NEWPR JSB DSET GO SET UP JMP $PRCN,I NOT STILL IN PART,DONT RELING LDB XLNK ADB D3 LDA B,I AND DMFLG IS IT IN DORM LIST SZA,RSS JMP PRCG2 NO, MUST BE IN ALLOC LDA XLST YES, IN DORM PRCG1 LDB XLNK JSB ULNK GO UNLINK LDA XLNK INA LDB NEWPR PUT NEW PRIO IN PART STB A,I JSB XXLNK GO LINK BY NEW PRIO JMP $PRCN,I PRCG2 CLA SET UP FOR ALLOC LIST STA XEND LDA ULST STA XLST JMP PRCG1 NEWPR BSS 1 * HED XEQ PROCESSOR--BACKGROUND DISK PROGRAM LOADING * * BACKGR0OUND DISK RESIDENT PROGRAM SCHEDULED * * * IF PROGRAM IS NOT RESIDENT OR BEING LOADED, GO TO * * READ IN PROGRAM FROM DISC AND SET READ IN WAIT * * FLAG, AND I/O SUSPEND THE PROGRAM. * * IF A PROGRAM IS RESIDENT AND * * IT IS THE DESIRED PROGRAM, GO TO SWITCHING * * SECTION TO EXECUTE THE PROGRAM. * * IT IS NOT THE DESIRED PROGRAM, * * CALL SWPCK TO CHECK SWAPABILITY OF THE * * CURRENT RESIDENT PROGRAM AND TAKE * * THE INDICATED ACTION. * * * X0100 LDA ABGFR SET UP LIST HEADERS STA FLIST LDA ABGPR STA ALIST LDA ABGDM STA DLIST JSB FNDSG GO FIND PARTITION LDA MRDFL,I GET READ COMP FLG SSA IS PROG IN RT PART JMP XB200 YES,GO THERE XR100 LDB MID,I CHECK IF PROGRAM RESIDENT SZB,RSS YES, SO CHECK IF READ IN COMPLETE JMP XN120 NO, SO GO READ IT IN AND B7 SCREEN OFF FLAGS CPB ZWORK IF DESIRED PROGRAM JMP X0230 GO CHECK FOR READ COMPLETE * * SET UP TO CALL SWPCK * * LDA BGSWP IS BG SWP IN PROG SZA NO,SO GO TO IT CPA MID,I YES, IS IT SAME PART CCE,RSS OK,GOTO SWPCK(E=1 FOR BKGND FOR SWPCK). JMP X0035 LDA MRDFL,I GET READ FLG AND B7 SCREEN OUT FLAGS JSB SWPCK CHECK SWAPABILITY JMP X0152 GO CLEAR CURRENT LOAD JMP X101 GO SWP OUT CURRENT PRGM * * LOAD RETURN FROM SWPCK * XN120 CLA CPA BGSWP TRANSFRE IN ANOTHER PART RSS JMP X0B35 LDA ZPRIO,I ASSIGN NEW PRIORITY TO_I PART CPA MPRIO,I IS IT SAME AS PARTITION PRIOTY JMP *+3 YES,CONT RELINK STA MPRIO,I ASSIGN NEW PRIORITY JSB RLNK GO RELINK IN ALLOCATED LIST LDB ZWORK STB MID,I SET NEW PGM IN PART JSB BBND GO SET BOUNDARY WORDS LDB MID,I JSB $BRED GO READ PROG JMP X0005 BBND NOP ADB D14 GET TYPE LDA B,I AND D15 ADB D8 CPA D2 RT JMP BBNDR YES LDB B,I STB BKDRA SET UP START BG DSK RES LDA B AND B76K SET NEW END OF CORE ADA LTH STA BKLWA CCA ADA BKDRA STA RTDRA SET RT POINTERS TO ONE LESS BK STA AVMEM FAKE FOR RTE PROCESSORS JMP BBNDX BBNDR LDB B,I STB RTDRA LDA B AND B76K ADA LTH STA AVMEM STA BKDRA STA BKLWA BBNDX LDA MPN ELA,ARS GET BP FLAG IN E STA MPN LDA MADR,I ALS,ERA PUT BJP FLAG IN MAT STA MADR,I JMP BBND,I SKP * * BACKGROUND READ IN COMPLETION PROCESSOR * * * THE BACKGROUND DISC RESIDENT READ COMPLETION PROCESSOR, * * IF NO READ ERROR, IT CLEARS THE READ IN WAIT FLAG, * * ENTERS PROGRAM INTO SCHEDULE LIST VIA LIST * * SUCH THAT EXECUTION CAN BEGIN AT THE NEXT * * OPPORTUNITY THE PROGRAM BECOME THE TOP OF LIST.* * IF READ ERRORS OCCURRED, CALL $ABRT PROCESSOR . * X0122 STB TEMP SAVE READ IN STATUS OF DISC ISZ BRDFL,I STEP BF RD FLAG LDB BGSWP CLA STA BGSWP STA SGSUP CLEAR SG SUSPEND FLAG STB TEMP1 SAVE CURRENT SWP FLAG LDA BKRQ GET STATE FLAG X0125 ISZ $LIST SET LIST FLAG TO FORCE SCAN SLA,RSS A=1 IF READ,0 IF WRITE JMP $XEQ GO SCAN LIST LDA BFLGS SET RD COMP FLG INA CPB TEMP1 SET RD FLAG TO 1 IF BG READ STA BRDFL,I STB TEMP1 SAVE ID-SEG. ADDRESS JSB $LIST CALL $LIST OCT 401 LDB TEMP CHECK READ IN STATUS FLAG SZA,RSS IF LIST ERROR OR SSB DISC ERROR RSS GO ABORT JMP $XEQ ALL O-K SO GO SCAN THE LIST * LDA TEMP1 A CONTAINS ID SEG ADDR JSB $ABRT GO TO ABORT ROUTINE JMP $XEQ RETURN TO $XEQ HED XEQ PROCESSOR--BACKGROUND DISK RESIDENT PROGRAM SWAP OUT * * SETUP TO SWAP OUT BACKGROUND DISK RESIDENT * * * SWAP OUT RT DISC RESIDENT PROGRAM FUNCTIONS AS FOLLOWS: * * COMPUTE NUMBER OF TRACKS NEEDED FOR SWAPPING * * OUT PROGRAM BY COMPUTING NUMBER OF SECTORS * * NEEDED FOR MAIN AND BASE PORTION OF PROGRAM. * * REQUEST THE NECESSARY NUMBER OF CONTIGUOUS * * TRACKS FROM EXECUTIVE. IF NONE IS AVAILABLE, * * THEN CANNOT SWAP AND RETURN TO CHECK NEXT PROG.* * IF TRACKS AVAILABLE, THEN SAVE STARTING TRACK * * ADDRESS, DISC LOGICAL UNIT NUMBER, AND NUMBER * * OF TRACKS INTO ID SEGMENT SWAP WORD. GENERATE * * PARAMETERS FOR SWAP OUTOF PROGRAM AND CALL * * DISC I/O ROUTINE. * * X101 LDB MID,I ID SEGMENT ADDRESS LDA ZPRIO,I SET A TO PRIORITY JSB BKRED GO SET UP AND START SWAP ISZ BRDFL,I SET THE SWAP OUT FLAG JMP X0035 SPC 2 X0152 LDB MID,I RESCHEDULE THE JSB $LIST PROGRAM OCT 401 XN153 LDA ABGDM LDB MLNK JSB ULNK REMOVE LDA ABGFR STA FLIST STRING BY LENGTH JSB FLINK INSERT INTO FREE LIST X0154 CLB LDA MRN.DFL,I SLA IS SWP ON IN THIS PART JMP XX154 NO,GO $XEQ LDA MID,I GET RESIDENT PART STB MID,I CLEAR RESIDENT CPA BGSWP WAS I/O BG JMP XB154 YES LDA DX255 NO,RT STB FGSWP CLEAR RT FLAG JMP $IOCL GO CANCEL LOAD XB154 STB BGSWP CLEAR BG FLAG LDA DX166 JMP $IOCL GO CANCEL LOAD XX154 STB MID,I CLEAR RESIDENCY WORD JMP $XEQ SPC 1 DX166 DEF X0166 X0B35 LDA MID,I GET PART RESIDENT SZA IF EMPTY PUT BACK IN FREE LIST JMP X0035 OTHERWISE ,DONT BOTHER LDA ALIST GO REMOVE ALLOCATD LIST LDB MLNK JSB ULNK JSB FLINK JMP X0035 HED XEQ PROCESSOR--RT DISK RESIDENT LOAD TESTS * * REAL TIME DISC RESIDENT * * REAL TIME DISC RESIDENT PROGRAM EXECUTION * * IF PROGRAM IS NOT RESIDENT OR BEING LOADED, GO TO * * READ IN PROGRAM FROM DISC AND SET READ IN WAIT * * FLAG, AND I/O SUSPEND THE PROGRAM. * * IF A PROGRAM IS RESIDENT AND * * IT IS THE DESIRED PROGRAM, GO TO SWITCHING * * SECTION TO EXECUTE THE PROGRAM. * * IT IS NOT THE DESIRED PROGRAM, * * CALL SWPCK TO CHECK SWAPABILITY OF THE * * CURRENT RESIDENT PROGRAM AND TAKE * * THE INDICATED ACTION. * * * X0200 LDA ARTFR SET POINTERS TO LIST HEADERS STA FLIST LDA ARTPR STA ALIST LDA ARTDM STA DLIST JSB FNDSG GO FIND PARTITION LDA MRDFL,I GET READ COMP FLAG SSA,RSS IS PROG IN BG PART JMP XR100 YES,GO DO IT XB200 LDB MID,I CHECK IF PROGRAM RESIDENT SZB,RSS ĤB@< YES, SO CHECK IF READ IN COMPLETE JMP XN220 NO, SO GO READ IT IN AND B7 SCREEN OUT FLAGS CPB ZWORK IF DESIRED PROGRAM JMP X0230 GO CHECK FOR READ COMPLETE * * SET UP TO CALL SWPCK * LDA FGSWP IS FG SWP IN PROGRESS SZA NO,GO TO IT CPA MID,I YES,IS IT SAME PART CLE,RSS YES,GOTO SWPCK(E=0 FOR FGGND FOR SWPCK). JMP X0035 SWP BUSY,GO TRY SOMEONE ELSE LDA MRDFL,I GET THE READ IN FLAG TO A AND B7 SCREEN OUT FLAGS JSB SWPCK CHECK SWAPABILITY JMP X0252 GO CLEAR CURRENT LOAD JMP X201 GO SWAP OUT CURRENT PGM. * * LOAD RETURN FROM SWPCK HED XEQ PROCESSOR--RT DISK RESIDENT READ IN * * SETUP TO READ IN RT DISK PROGRAM * * READ IN OF REAL TIME DISC RESIDENT PROGRAM * * IF ID SEGMENT SWAP ADDRESS IS ZERO, THE SYSTEM * * GENERATED DISC ADDRESS IS USED TO COMPUTE THE * * PARAMETERS FOR DISC I/O CALL. * * IF THERE IS SWAP ADDRESS, THEN THIS DISC ADDRESS * * IS USED. * * * XN220 CLA CPA FGSWP TRANSFER IN ANOTHER AREA RSS JMP X0B35 LDA ZPRIO,I ASSIGN NEW PRIORITY TO PART CPA MPRIO,I IF SAME PRIO,DONT RELINK JMP *+3 STA MPRIO,I JSB RLNK GO RELINK IN ALLOCATED LIST LDB ZWORK STB MID,I JSB BBND GO SET BOUNDARIES LDB ZWORK JSB $LIST IO SUSPEND PROG OCT 402 UNTIL READ COMPLETED CCA,CCE SET FOR PREST STA MRDFL,I B HED XEQ PROCESSOR--RT DISK RESIDENT PROGRAM SWAP OUT * * SETUP TO SWAP OUT RT DISK RESIDENT * * * SWAP OUT RT DISC RESIDENT PROGRAM FUNCTIONS AS FOLLOWS: * * COMPUTE NUMBER OF TRACKS NEEDED FOR SWAPPING * * OUT PROGRAM BY COMPUTING NUMBER OF SECTORS * * NEEDED FOR MAIN AND BASE PORTION OF PROGRAM. * * REQUEST THE NECESSARY NUMBER OF CONTIGUOUS * * TRACKS FROM EXECUTIVE. IF NONE IS AVAILABLE, * * THEN CANNOT SWAP AND RETURN TO CHECK NEXT PROG.* * IF TRACKS AVAILABLE, THEN SAVE STARTING TRACK * * ADDRESS, DISC LOGICAL UNIT NUMBER, AND NUMBER * * OF TRACKS INTO ID SEGMENT SWAP WORD. GENERATE * * PARAMETERS FOR SWAP OUTOF PROGRAM AND CALL * * DISC I/O ROUTINE. * * X201 CLB,SEZ,INB,RSS SET UP THE REQUEST CODE INB AND SET STB FGRQ LDB MID,I ID SEGMENT ADDRESS LDA RREDS GET THE QUE ADDRESS JSB PREST GO SET UP THE SWAP STB X0250 SET THE LU STA RSWP SET THE TRIPLET QUE ADDRESS LDA MID,I STA FGSWP LDA MRDFL STA RRDFL LDA MFLGS SAVE FLAGS STA RFLGS LDA ZPRIO,I SET THE REQUEST PRIORITY STA FSPR IN THE CALL JSB $XSIO CALL FOR DISK I/O X0250 NOP LOGICAL UNIT DEF X0251 COMPLETION ADDRESS X0255 OCT 0 FGRQ NOP REQUEST CODE READ/WRITE RSWP DEF RTSWP ARRAY ADDRESS FSPR NOP FORGROUND SWAP PRIORITY FGSWP NOP EXTENDED XSIO CALL--ID ADR ISZ RRDFL,I JMP X0035 IF SWAP GO CONTINUE SEARCH LDA RFLGS IOR RRDFL,I PUT FLAGS BACK IN MAT WORD STA RRDFL,I JMP X0005 ELSE RESCAN THE LIST RFLGS BSS 1 r RRDFL BSS 1 SPC 2 * * * READ IN COMPLETION PROCESSOR * * THE REAL TIME DISC RESIDENT READ COMPLETION PROCESSOR, * * * IF NO ERRORS, IT CLEARS READ IN WAIT FLAG, AND * * SCHEDULES PROGRAM SUCH THAT PROGRAM EXECUTION * * CAN BEGIN AT THE NEXT OPPORTUNITY. * * IF READ ERRORS, CALL $ABRT PROCESSOR * * * X0251 STB TEMP SAVE READ IN STATUS OF DISK ISZ RRDFL,I STEP FG RD FLAG LDA RFLGS IOR RRDFL,I STA RRDFL,I LDB FGSWP GET ID SEG ADR CLA STA TEMP1 CLEAR SWAP IN PROGRESS STA FGSWP CLEAR SWAP IN PROGRESS LDA FGRQ GET REAUEST CODE JMP X0125 GO FINISH CHECKS SPC 2 X0252 LDB MID,I ABORT LOAD SO RESCHEDULE JSB $LIST THE PROGRAM FOR OCT 401 LATER XN253 LDA ARTDM LDB MLNK JSB ULNK REMOVE ALLOCATED LIST LDA ARTFR STA FLIST JSB FLINK JMP X0154 SPC 1 RREDS DEF RTSWP DX255 DEF X0255 SPC 1 X0230 LDB MFLGS INB CPA M3 IN CORE AFTER SWAP STB MRDFL,I YES RESET TO SAY IN CORE SPC 1 X0240 SLA,RSS READ IN COMPLETE? JMP X0035 NO GO TRY THE NEXT PGM * LDB ZWORK GET THE ID-SEG. ADDRESS JSB DREL RELEASE SWAP TRACKS IF ANY JMP X0040 GO EXECUTE THE PGM. SKP DREL NOP ROUTINE TO RELEASE DISC SWAP TRK ADB D27 COMPUTE ID SEGMENT SWAP ADDRESS LDA B,I CCE,SZA,RSS SWAPPED, SO GO TO RELEASE JMP DREL,I NOT, SWAPPED, SO RETURN STA TEMP SAVE LU/TRK/#TRK AND B177 STA TEMP2 ISOLATE # TRACKS TO RELEASE CLA CLEAR ID SEGMENT STA B,I SWAP VALUE LDA TEMP ALF,ALF RAL AND B377 LDB +TEMP SSB ADA TATSD L. U. 3 SO ADD # SYS TRACKS LDB TEMP2 (B) TO # OF TRACKS TO REL JSB $DREL CALL DISC TRACK RELEASE PROCESOR JMP DREL,I RETURN HED XEQ SWAP CHECK ROUTINE. CAN AND SHOULD WE SWAP? * SWAPCK CHECKS TO SEE IF AN AREA SHOULD BE SWAPED, * IT CHECKS: * 1. IF A SWAP OUT IS UNDER WAY (IF SO FORGET IT) * 2. IF THE BASE PAGE SWAP FLAG FOR THE AREA ALLOWS SWAPING. * 3. IF THE RESIDENT PROGRAM HAS INHIBITED SWAPING. * 4. IF THE RESIDENT PROGRAM IS SCHEDULED AND HAS HIGHER * OR EQUAL PRIORITY. * 5. IF THE RESIDENT IS DORMANT BUT HAS PRIORITY AND IS IN * THE TIME LIST AND ITS TIME IS "NEAR". * 6. IF THE RESIDENT IS I/O SUSPENDED * WITH THE BUFFER IN HIS AREA. * * ALL OF THE ABOVE CONDITIONS INHIBIT A SWAP. ( JMP X0035 ). * THE FOLLOWING CONDITIONS CAUSE THE INDICATED ACTIONS. * * 7. THE RESIDENT IS BEING READ IN BUT DOES NOT HAVE PRIORITY * CAUSES AN ABORT (I.E. STOP THE READ) RETURN. * 8. THE RESIDENT HAS NOT BEEN EXECUTED SINCE IT WAS LAST * LOADED FROM THE DISC CAUSES A READ RETURN (I.E. ASSUME * THE RESIDENT CAN BE RELOADED WHEN NEEDED) * * CALLING SEQUENCE: * * LOADD SET TO THE AREA LOW BOUNDRY * HIADD SET THE HIGH AREA BOUNDRY + 1. * A = THE READ IN FLAG 0=READING, 1 = INCORE, 2 =SWAPING OUT OR * SEGMENT LOAD, 3 = INCORE AND SWAPED OUT. * B = THE RESIDENTS ID-SEGMENT ADDRESS * E = 1 IF BACKGROUND * E = 0 IF FORGROUND * JSB SWPCK * JMP ABORT ABORT (I.E. STOP LOAD) RETURN (A=B=E=0). * JMP SWP SWAP OUT RETURN * --- LOAD RETURN * * THE FOLLOW TEMP AREAS ARE USED IN SWPCK: * RINF EQU TEMP READ IN FLAG SAVE LOCATION RBUFA EQU TEMP1 ADDRESS OF CONWRD THEN BUFFER ADDRESS RPRIO EQU TEMP2 ADDRESS OF RESIDENTS PRIORITY RSUSP EQU TEMP3 ADDRESS OF RESIDENTS SUSP RTIML EQU TEMP4 ADDRESS OF RESIDENTS T BIT. RTIME EQU TEMP5 ADDRESS OF RESIDENTS TIME. RSWTR EQU TEMP6 ADDRESS OF RESIDENTS SMAN. LOADD EQU TMP1 ADDRESS OF LOW BOUNDRY SKP SWPCK NOP CPA M3 IF CURRENT IS SWAPED OUT JMP SWPC4 GO MAKE LOAD RETURN STA RINF SAVE THE READ IN FLAG RAR,SLA IF SWAPING OR LOADING A SEGMENT JMP X0N35 FORGET THE SWAP INB INDEX TO THE I/O CONWRD ADDRESS STB RBUFA SAVE IT ADB D5 INDEX TO THE PRIORITY ADDRESS STB RPRIO SAVE IT ADB D2 INDEX TO THE SUSPENTION ADDRESS STB RSUSP SAVE IT ADB D6 INDEX TO THE TYPE/CORE LOCK BIT ADDRESS LDA B,I GET THE WORD AND D100 ISOLATE THE CORE LOCK BIT SZA IF SET JMP X0N35 FORGET THE WHOLE THING INB INDEX TO THE STATUS LDA B,I GET STATUS TO A AND D15 ISOLATE THE STATUS ADB D2 INDEX TO THE TIME LIST ADDRESS STB RTIML SAVE IT INB INDEX TO THE TIME ADDRESS STB RTIME SAVE IT ADB D9 INDEX TO THE SWAP TRACK ADDRESS STB RSWTR AND SAVE IT * LDB RPRIO,I GET THE PRIORITY CMB,CLE,INB SUBTRACT FROM ADB ZPRIO,I SET E IF RES. WINS PRIORITY TEST) LDB RINF GET THE READ FLAG CPA D2 IF I/O SUSPENDED JMP SWPC3 GO DO I/O SUSP. CHECKS * SEZ,RSS IF THE CONTENDER HAS PRIORITY JMP SWPC1 GO CHECK IF SWAP IS NEEDED CPA D1 IF RESIDENT IS SCHEDULED JMP X0N35 FORGET THE WHOLE THING LDB RTIML,I GET THE TIME LIST BIT BLF,SLB IF IN TIME LIST CLE,SZA AND DORMANT JMP SWPC1 NO SO GO CHECK IF SWAP IS NEEDED * DLD $TIME GET THE SYSTEM TIME DIV BREAD DIVIDE BY ZERO TO SET POS. BREDS EQU *-1 DEF TO BREAD! ADA RTIME,I SUBTRACT THE ID-SEG TIME VALUE SEZ,CLE IF OVERFLOW INB STEP B ISZ RTIME STEP TO NEXT TIME WORD ADB RTIME,I ADD THE HIGH WORD ADA SWPTM ADD THE NEG. OF # OF TICKS SYS WILL WAIT. SEZ,SZB,RSS IF HIGH VALUE IS ZERO SSA,RSS AND THE DIFF < LIMIT JMP SWPC1 CPB SWPTM AND LIMIT NOT= 0, RSS JMP X0N35 THEN FORGET SWAP. * SWPC1 LDA RSUSP,I SWAP IN ORDER TEST IF THE RESIDENT LDB RSWTR,I WAS RUN SINCE LAST LOAD CLE,SZB,RSS IF SWAP TRACKS STILL ASSIGNED OR SZA,RSS POINT OF SUSP IS ZERO SWPC4 ISZ SWPCK THEN JUST READ SWPC2 ISZ SWPCK ELSE SET TO SWAP RETURN JMP SWPCK,I EASY ISN'T IT? SPC 1 SWPC3 CLA E = 0 IF HE HAS PRIORITY SEZ,SZB,RSS IF READING IN AND PRIORITY JMP SWPCK,I RETURN P+1 WITH A = 0 (ABORT) * SZB,RSS IF READING IN BUT NOT PRIORITY JMP X0N35 FORGET THE WHOLE THING * * THE FOLLOWING CODE WILL ALLOW THE SWAPPING OF * PROGRAMS SUSPENDED FOR UNBUFFERED I/O REQUESTS. * * LDA RBUFA,I GET CONWRD. * RAR IF IT IS A * SSA,SLA CONTROL REQUEST * JMP SWPC2 THEN ALLOW SWAP. * ISZ RBUFA ELSE INCREMENT TO THE BUFFER ADDRESS. LDA RBUFA,I GET BUFFER ADR CLE,SSA IS IT A RE-ENT BUFFER JMP SWPC2 YES CAN SWAP LDA LOADD CMA,CLE,INA ADA RBUFA,I SEZ JMP X0N35 JMP SWPC2 SPC 1 D100 OCT 100 SWPTM DEC -15 MAX WAIT IS 150 MS. D9 DEC 9 HED XEQ PROCESSOR--PRELIMINARY SETUP FOR DISK CALL * PREST SETS UP FOR A DISC LOAD OR SWAP AS FOLLOWS: * * 1. SETS MEMORY BOUNDS FOR THE PROGRAM * TEMP = #WORDS IN MAIN * TEMP3 = FIRST WORD OF MAIN * TMP = #WORDS IN BASE PAGE * TMP1 = FIRST WORD OF BASE PAGE * * != 2. IF SWAP, GET SWAP TRACKS IF REQUIRED * AND SETS SMAN IN THE ID-SEGMENT. * * 3. SETS THE INITIAL DISC ADDRESS * TEMP1 = TRACK ADDRESS * TEMP2 = SECTOR ADDRESS * B = LU OF DISC * * 4. SETS THE NUMBER OF SECTORS: * CN#SC = -NUMBER OF SECTORS/TRACK * * 5. CALLS SETUP TO BUILD THE TRIPLET FOR THE LOAD * * PREST CHECKS THE FOLLOWING OPTIONS: * * 1. SHORT ID-SEGMENT (BG-SEGMENT LOAD) * 2. THE "ALL OF CORE" BIT CAUSES THE WHOLE AREA * TO BE SWAPED ALONG WITH ALL OF THE AREA * BASE PAGE. * 3. IF SWAP THEN THE FIRST WORD IS ALWAYS THE AREA * BOUNDRY. * 4. IF SWAP AND NO TRACK ASSIGNED THEN SWAP TRACKS * ARE ALLOCATED. * * CALLING SEQUENCE: * * B = ID-SEGMENT ADDRESS * E = 1 FOR LOAD * E = 0 FOR SWAP OUT * A = BOTTOM OF TRIPLET TABLE * JSB PREST * * ON RETURN: * * B = DISC LU * A = DEF OF TRIPLET TABLE FOR XSIO CALL * * ABNORMAL EXIT * * A JMP IS MADE TO X0035 IF NO DISC TRACKS ARE AVAILABLE * FOR SWAPING. * * INTERNAL TEMP AREA USAGE: * TEMP4 - TRIPLET QUE ADDRESS * TEMP5 - PROGRAM TYPE WORD * TEMP6 - MEMORY ADDRESS POINTER TO ID-SEGMENT. * TMP2 - DISC ADDRESS POINTER TO ID-SEGMENT. SKP PREST NOP STA TEMP4 SAVE THE TRIPLET QUE ADDRESS CLA SET THE START SECTOR STA TEMP2 ADDRESS FOR SWAP OPTION CPB XEQT IF CURRENT EXECUTING STA XEQT PROGRAM CLEAR THE FLAG ADB D14 INDEX TO TYPE WORD LDA B,I GET PROGRAM TYPE TO A STA TEMP5 SAVE IT ALF,ALF ROTATE THE SHORT ID-SEG. BIT ALF,SLA,RAR TO ZERO AND TEST - SET INB,RSS ALL OF CORE BIT TO LEAST A ADB D8 INDEX TO MEMORY ADDRESSES STB TEMP6 SAVE THE MEMORY ADDRESS ADB D4 INDEX TO THE DISC ADDRESS STB TMP2 AND SAVE IT SSA IF SHORT ID-SEG. JMP SEGCK SEE IF FIT IN PARTITION ******************************************* **E=0IF SWAP,B=0 IF FIRST LOAD******* ******************************************* * SEZ,INB STEP TO SWAP DISC ADDRESS LDB B,I GET SWAP ADDRESS (SKIPPED IF SWAP) CMB,CLE,INB,SZB IF SWAP TRACK OR SWAPING ISZ TMP2 STEP THE DISC ADDRESS TO SMAN. PRES1 LDB TEMP6,I GET THE ID-SEG LOW MAIN ADD. ISZ TEMP6 STEP THE MEMORY ADDRESS TO HIGH MAIN STB TEMP3 SEZ IF FIRST LOAD JMP PRES2 GO SET UP TRUE TO ID-SEG. * LDB TEMP5 GET THE TYPE WORD SLB,RSS IF FORGROUND JMP PRES3 GO SET FORGROUND BOUNDS * LDB TEMP3 AND SET FOR LOW MAIN. CMB,INB SUBTRACT FROM CCE,SLA,RSS IF NOT ALL OF AREA BIT THEN JMP PRES4 ID-SEG VALUE * ADB BKLWA ELSE LAST WORD OF MEM CLE,INB,RSS PLUS ONE. PRES4 ADB TEMP6,I ID-SEG HIGH MAIN PRES5 STB TEMP SET #WORDS IN MAIN ISZ TEMP6 STEP TO LOW BASE PAGE LDB TEMP6,I GET LOW BP STB TMP1 AND SET IT ISZ TEMP6 STEP TO HIGH BASE PAGE CMB,SEZ,INB SET NEG SKIP IF ALL OF AREA JMP PRES6 NOT ALL SO GO GET FROM ID-SEG. ADB BPA2 SET HIGH END OF BG-BP AREA RSS SKIP STANDARD DEF PRES6 ADB TEMP6,I CACULATE SIZE OF STD BP AREA STB TMP SET BASE PAGE SIZE CMA,CLE,INA SET E IF FIRST LOAD LDA TMP2,I GET THE DISC ADDRESS SZA IF NONE SKIP JMP PRES7 DISC DEFINED GO SET UP * * GET SWAP TRACKS * LDA B GET BASE PAGE SIZE ADA B177 FORCE SIZE UP TO NEXT SECTOR AND C177 TRUNCATE TO EVEN SECTOR STA TMP SAVE LDA TEMP WHILE CHECK MAIN SIZE :ADA B177 FORCE SIZE UP TO NEXT SECTOR AND C177 TRUNCATE TO EVEN SECTOR STA TEMP SAVE MAIN SIZE ADA TMP ADD IF ANY ROUNDED UP FROM BP CLB DIV #WDS DIVIDE BY MIN #WORDS/TRACK SZB IF REMAINDER INA BUMP STA SETUP SET #TRACKS IN SMAN CLB GO TO SYS TO GET TRACKS JSB $DREQ ERB,SLB SET LEAST LU BIT IN E SKIP IF NONE ALF,SLA,ALF ROTATE TRACK SKIP ALWAYS JMP X0035 NO TRACKS EXIT TO SWITCHER ERA,CLE SET LU BIT IN TRACK WORD IOR SETUP ADD THE # TRACKS STA TMP2,I AND SET BACK IN ID-SEG * * DECODE TRACK/SECTOR ADDRESS IN A * PRES7 AND B177 MASK OUT THE SECTOR/#TRACKS CLB,SEZ,INB SET B TO 1,SKIP IF SWAP STA TEMP2 SET SECTOR ADDRESS XOR TMP2,I GET THE TRACK/LU ASL 1 SET LU IN B/TRACK IN HIGH A ALF,ALF BRING DOWN THE TRACK STA TEMP1 SET THE TRACK ADDRESS LDA SECT2 GET THE SECTOR SIZE FOR LU 2 SLB IF LU IS 3 LDA SECT3 USE 3'S NUMBER CMA,INA SET NEGATIVE STA CN#SC NUMBER OF SECTORS/TRACK * * NOW CALL SETUP TO BUILD THE TRIPLETS * STB TEMP6 SET LU IN A SAFE PLACE LDA TEMP4 GET THE TRIPLET ADDRESS JSB SETUP SET UP THE MAIN LDB TMP STB TEMP SET UP FOR THE LDB TMP1 BASE PAGE STB TEMP3 AND JSB SETUP GO BUILD IT'S TRIPLETS LDB TEMP6 RESTORE THE LU TO B JMP PREST,I NOW THAT WASN'T HARD WAS IT? SPC 2 PRES2 CLA SET TO LOAD ACTUAL BOUNDS PRES3 LDB TEMP3 LOAD BOUNDRY CMB,INB CCE,SLA,RSS JMP PRES4 ELSE GO GET TRUE MEM. ADB AVMEM USE WHOLE AREA JMP PRES5 GO SET IN TEMP SPC 2 C177 OCT 177600 #WDS NOP SEGCK LDB TEMP6 INB LDB B,I GET HIGH MAIN CMB,INB  ADB BKLWA CCE,INB SSB,RSS JMP PRES1 WILL FIT IN PART BADSG LDA MID,I WON'T FIT, SO GET MAIN JSB $ABRT ID SEGMENT ADDRESS JMP $XEQ ABORT HIM AND RETURN. HED XEQ PROCESSOR--DISK CALLING SEQUENCE GENERATOR * * DISK READ/WRITE CALLING SEQUENCE GENERATOR ROUTINE * ON ENTRY * TEMP = NUMBER OF WORDS * TEMP1 = TRACK ADDRESS * TEMP2 = SECTOR ADDRESS * TEMP3 = STARTING MEMORY ADDRESS * A = PARAMETER TABLE ADDRESS * * THE DISC PARAMETER GENERATOR FUNCTION IS TO GENERATE * * PARAMETERS FOR DISC CALL GUARANTEEING THAT ALL * * TRACK CROSSING CALLS ARE BROKEN DOWN INTO SUB-CALLS * * SUCH THAT THE DISC DRIVER CAN HANDLE THE REQUEST. * * THE CALLS ARE BROKEN UP IN TRIPLETS OF * * STARTING CORE MEMORY ADDRESS * * NUMBER OF WORDS TO TRANSFER * * STARTING TRACK/SECTOR ADDRESS. * * THE END OF CALL IS INDICATED BY A ZERO FOLLOWING * * THE LAST TRIPLET. * * * SETUP NOP ENTRY/EXIT LDB TEMP COMPUTE NUMBER OF SECTORS SETU1 SZB,RSS ZERO, SO RETURN JMP SETUP,I ADA DM3 SET UP TRIPLET STA DSTAD ADDRESS ADB B177 ROUND UP NUMBER ASR 7 OF SECTORS BLS STB TEMP5 SAVE NUMBER OF SECTORS LDA TEMP2 INITIAL SECTOR ADDRESS ADA B ADA CN#SC SUB CURRENT # SECTORS/TRACK LDB TEMP3 STB DSTAD,I STORE STARTING MEMORY ADDRESS ISZ DSTAD INCREMENT ARRAY ADDRESS CMA,CLE,INA,SZA CLE,SSA,RSS CHECK IF TRACK OVERFLOW JMP SETI0 NO, SO LAST TRIPLET ADA TEMP5 YES, USE REST OF TRACK IF OVER. ASL 6 UPSET LDB TEMP1 FORM BLF,RBL TRACK RBL,RBL ADDRESS ADB TEMP2 AND SECTOR ADDRESS DST DSTAD,I STORE LAST TWO WORDS OF TRIPLET DSTAD EQU *-1 ADA TEMP3 UPDATE STARTING STA TEMP3 MEMORY ADDRESS LDB TEMP2 INCREMENT SECTOR ADDRESS ADB TEMP5 TO START SECTOR FOR SEZ CHECK IF NEW TRACK CLB,RSS RSS NOT NEW TRACK SO SKIP ISZ TEMP1 YES, SO INCREMENT TRACK ADDRESS STB TEMP2 RESET SECTOR LDB DSTAD,I UPDATE NUMBER CMB,INB OF ADB TEMP WORDS STB TEMP TO GO CCA SUB 1 FOR CORRECT NEXT TRIPLET ADA DSTAD ADDRESS CALC. JMP SETU1 GO TO NEXT LOOP SPC 1 SETI0 LDA TEMP SET FOR LAST JMP UPSET TRIPLET HED XEQ PROCESSOR--READ SETUP * * SETUP TO READ IN BACKGROUND DISK RESIDENT PROGRAM * OR BACKGROUND DISK RESIDENT SEGMENTS * $BRED NOP ENTRY/EXIT CPB MID,I IF SEGMENT LOAD SKIP CLA,CCE,RSS SET E FOR PRESET JSB BRCK SEGMENT LOAD SET SWAPING FLAG TO IOR MFLGS SET READ IN WAIT FLAG STA MRDFL,I LDA MPRIO,I GET PRIORITY JSB BKRED GO SET UP AND START READ LDB MID,I I/O SUSPEND BACKGROUND JSB $LIST SEGMENT UNTIL READ IN OCT 402 FROM DISC COMPLETE JMP $BRED,I EXIT * * * ***ROUTINE CHECKS TO SEE IF A LOAD IN PROGRESS*** *****BEFORE INITIATING SEGMENT LOAD************** * * BRCK NOP CLA CPA BGSWP IS A LOAD IN PROGRESS JMP SGLD NO,GO DO IT LDB XEQT CLEAR CURRENTLY EXECUTING PROG STA XEQT STB SGSUP SET SEGMENT LOAD SUSPEND FLAG JMP X0035 SGLD LDA D2 SET SEGMENT LOAD SWAPING FLAG JMP BRCK,I SGSUP NOP SKP SPC 2 * BACKGROUND READ/SWAP ROUTINE +;* CALL SEQUENCE: * * LDA PRIORITY FOR REQUEST * LDB ID-SEG ADDRESS * E = 1 FOR READ * E = 0 FOR WRITE * * JSB BKRED * ON RETURN REGISTERS ARE MEANINGLESS * BKRED NOP STA BKPR SET REQUEST PRIORITY CLA,SEZ,INA,RSS SET UP THE REQUEST CODE INA AND STA BKRQ STORE IT LDA BREDS GET TRIPLET ADDRESS JSB PREST STA BRED LDA MID,I STA BGSWP LDA MRDFL STA BRDFL LDA MFLGS STA BFLGS STB BRELU SET DISC LU JSB $XSIO BRELU NOP DEF X0122 COMPLETION ADDRESS X0166 OCT 0 LINK ADDRESS BKRQ OCT 1 READ/WRITE REQUEST CODE BRED DEF BREAD ARRAY ADDRESS BKPR NOP PRIORITY ADDRESS BGSWP NOP EXTENDED XSIO CALL--ID ADR JMP BKRED,I RETURN BRDFL BSS 1 BFLGS BSS 1 HED SYSTEM START UP ******************************************************************** * THE START SECTION: * * CLEARS INTERRUPT SYSTEM * * SETS FENCE REGISTER TO 0 * * CLEARS XEQT * * SCHEDULES 'FMGR' IF PRESENT * STARTS THE CLOCK BY CALLING $SCLK IN RTIME MODULE * THIS SECTION IS EXECUTED ONCE - IT IS OVERLAYED ******************************************************************** * $ZZZZ NOP * STB DFMG SET THE NAME ADDRESS CLC 0 CLEAR INTERRUPT SYSTEM JSB MPINT GO DO MAP STUFF LDA SWAP SET UP THE SWAP DELAY ALF,ALF AND B377 CMA,INA SET NEGATIVE STA SWPTM SET THE VALUE * LDA SECT2 FIND MINIMUM # SECTORS/TRACK LDB SECT3 SUBTRACT # FOR LU 3 CMB,INB,SZB FROM # FOR LU 2. ADB SECT2 IF POSITIVE RESULT, CMB,SSB,INB,SZB LU 3 IS SMALLER.  LDA SECT3 OTHERWISE, USE LU 3 LSL 6 STA #WDS LDA SKEDD SAVE THE CURRENT STA ZWORK SCHEDULE POINTER SPC 1 JSB $LIST SCHEDULE 'FMGR' PROGRAM OCT 201 IF IT IS IN THE SYSTEM. DFMG DEF * BREAD NOP SPC 1 SZA JMP ZEXIT NO - LDA SKEDD LDB A,I INSURE 'FMGR' IS CPB ZWORK FIRST IN THE SWP SCHEDULED LIST. STB SKEDD STA B,I CLB STB A,I LDA SKEDD GET THE FMGR ID-SEG ADDRESS INA AND LDB TATLG INHIBIT ALL TRACK STB A,I ALLOCATIONS UNTIL CCB 'FMGR' EXECUTES. STB TATLG 'FMGR' UNDOES THIS SPC 1 JMP ZTYPE NOP GO BACK TO SCHED RTSWP NOP FNMP OCT 2000 ******* ********MAP INITIALIZATION************** ******* MPINT NOP LDA $MPFT ADA D4 LDA A,I GET START OF SSGA ADA M1 STA $SGAF LDA MRMP GET ADDRESS MEM RES MAP USA LOAD USER MAP CLA XMA SET DMA1 FROM SYS MAP INA XMA SET DMA2 FROM SYS MAP LDA BPA2 GET LAST USER LINK INA INCREASE TO FIRST SYSTEM LINK IOR FNMP SET BIT 10 TO SHOW LOWER MAPPED LFA SET FENCE FOR BP CLA CPA $RTFR IS THERE A RT LIST RSS JMP MPT1 YES LDA ABGFR NO,SET UP TO SAME AS BG STA ARTFR LDA ABGPR STA ARTPR LDA ABGDM STA ARTDM JMP MPINT,I MPT1 CPA $BGFR IS THERE A BG LIST RSS JMP MPINT,I YES LDA ARTFR NO SET BG LIST POINTERS TO RT STA ABGFR LDA ARTPR STA ABGPR LDA ARTDM STA ABGDM JMP MPINT,I HED ** SYSTEM BASE PAGE COMMUNICATION AREA ** * * *** SYSTEM BASE PAGE COMMUNICATION AREA *** * XI EQU 1647B . EQU 1650B VESTABLISH ORIGIN OF AREA * * SYSTEM TABLE DEFINITION * * EQTA EQU .+0 FWA OF EQUIPMENT TABLE EQT# EQU .+1 # OF EQT ENTRIES * DRT EQU .+2 FWA OF DEVICE REFERENCE TABLE LUMAX EQU .+3 # OF LOGICAL UNITS (IN DRT) * INTBA EQU .+4 FWA OF INTERRUPT TABLE INTLG EQU .+5 # OF INTERRUPT TABLE ENTRIES * TAT EQU .+6 FWA OF TRACK ASSIGNMENT TABLE * KEYWD EQU .+7 FWA OF KEYWORD BLOCK * * I/O MODULE/DRIVER COMMUNICATION * EQT1 EQU .+8 ADDRESSES EQT2 EQU .+9 EQT3 EQU .+10 OF EQT4 EQU .+11 EQT5 EQU .+12 CURRENT EQT6 EQU .+13 EQT7 EQU .+14 15-WORD EQT8 EQU .+15 EQT9 EQU .+16 EQT EQT10 EQU .+17 EQT11 EQU .+18 ENTRY EQT12 EQU .+81 EQT13 EQU .+82 EQT14 EQU .+83 EQT15 EQU .+84 * CHAN EQU .+19 CURRENT DMA CHANNEL # TBG EQU .+20 I/O ADDRESS OF TIME-BASE CARD SYSTY EQU .+21 EQT ENTRY ADDRESS OF SYSTEM TTY * * SYSTEM REQUEST PROCESSOR /'EXEC' COMMUNICATION * * RQCNT EQU .+22 # OF REQUEST PARAMETERS -1 RQRTN EQU .+23 RETURN POINT ADDRESS RQP1 EQU .+24 ADDRESSES RQP2 EQU .+25 RQP3 EQU .+26 OF REQUEST RQP4 EQU .+27 RQP5 EQU .+28 PARAMETERS RQP6 EQU .+29 RQP7 EQU .+30 (SET FOR MAXIMUM OF RQP8 EQU .+31 8 PARAMETERS) * * DEFINITION OF SYSTEM LISTS (QUEUES) * * DORMT EQU .+32 ADDRESS OF 'DORMANT' LIST, SKEDD EQU .+33 'SCHEDULE' LIST, SUSP3 EQU .+36 'AVAILABLE MEMORY' LIST, SUSP4 EQU .+37 'DISC ALLOCATION' LIST, SUSP5 EQU .+38 'OPERATOR SUSPEND' LIST * * DEFINITION OF EXECUTING PROGRAM ID SEGMENT' * * XEQT EQU .+39 ID SEGMENT ADDR. OF CURRENT PROG. XLINK EQU .+40 'LINKAGE' XTEMP EQU .+41 'TEMPORARY (5-WORDS) XPRIO EQU .+46 'PRIORITY' WORD XPENT EQU .+47 'PRIMARY ENTRY POINT' XSUSP EQU .+48 'POINT OF SUSPENSION' XA EQU .+49 'A REGISTER' AT SUSPENSION XB EQU .+50 'B REGISTER' XEO EQU .+51 'E AND VOVERFLOW * * SYSTEM MODULE COMMUNICATION FLAGS * * OPATN EQU .+52 OPERATOR/KEYBOARD ATTENTION FLAG OPFLG EQU .+53 OPERATOR COMMUNICATION FLAG SWAP EQU .+54 RT DISC RESIDENT SWAPPING FLAG DUMMY EQU .+55 I/O ADDRESS OF DUMMY INT. CARD IDSDA EQU .+56 DISC ADDR. OF FIRST ID SEGMENT IDSDP EQU .+57 -POSITION WITHIN SECTOR * * DEFINITION OF MEMORY ALLOCATION BASES * * BPA1 EQU .+58 FWA R/T DISC RES. BP LINK AREA BPA2 EQU .+59 LWA R/T DISC RES. BP LINK AREA BPA3 EQU .+60 FWA BKG DISC RES. BP LINK AREA LBORG EQU .+61 FWA OF RESIDENT LIBRARY AREA RTORG EQU .+62 FWA OF REAL-TIME AREA RTCOM EQU .+63 LENGTH OF REAL TIME COMMON AREA RTDRA EQU .+64 FWA OF R/T DISC RESIDENT AREA AVMEM EQU .+65 FWA OF SYSTEM AVAILABLE MEMORY BKORG EQU .+66 FWA OF BACKGROUND AREA BKCOM EQU .+67 LENGTH OF BACKGROUND COMMON AREA BKDRA EQU .+68 FWA OF BKG DISC RESIDENT AREA * * UTILITY PARAMETERS * TATLG EQU .+69 LENGTH OF TRACK ASSIGNMENT TABLE TATSD EQU .+70 # OF TRACKS ON SYSTEM DISC SECT2 EQU .+71 # SECTORS/TRACK ON LU 2 (SYSTEM) SECT3 EQU .+72 # SECTORS/TRACK ON LU 3 (AUX.) * DSCLB EQU .+73 DISC ADDR OF RES LIB ENTRY PTS DSCLN EQU .+74 # OF RES LIB ENTRY POINTS DSCUT EQU .+75 DISC ADDR OF RELOC UTILITY PROGS DSCUN EQU .+76 # OF RELOC UTILITY PROGS LGOTK EQU .+77 LOAD-N-GO: LU,STG TRACK,# OF TRKS LGOC EQU .+78 CURRENT LGO TRACK/SECTOR ADDRESS SFCUN EQU .+79 SOURCE FILE LU AND DISC ADDRESS MPTFL EQU .+80 MEMORY PROTECT ON/OFF FLAG (0/1) FENCE EQU .+85 MEM PROTECT FENCE ADDRESS * BKLWA EQU .+87 LWA OF MEMORY IN BACKGROUND * * FREG1 EQU LBORG FREG2 EQU RTORG FREG3 EQU BKORG FLG EQU OPFLG * A EQU 0B LOCATION OF A REGISTER B EQU 1B LOCATION OF B REGISTER ORG * PROGRAM LENGTH END $ZZZZ "ZXTTZ ,4 92060-18014 1710 S 0122 RTE-III RTIME              H0101 ASMB,R,L,C ** RT TIME MODULE ** HED REAL TIME TIME MODULE * NAME: RTIME * SOURCE: 92060-18014 * RELOC: 92060-16014 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1975. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM RTIME,0 92060-16014 REV.1710 770131 * SUP ******************************************************************** * * ***** AMD ***** JUL,73 * * ******************************************************************** * * RTIME ENTRY POINT NAMES * ENT $TADD,$CLCK,$TREM,$TIME,$TIMV ENT $ETTM,$TIMR,$ONTM,$TMRQ,$SCLK ENT $BATM * * RTIME EXTERNAL REFERENCE NAMES * EXT $INER,$DEVT,$LIST,$XEQ EXT $ERMG,$MESS,$SYMG,$IDSM EXT $WORK * ******************************************************************** * * THE RTIME MODULE OF HP2100 REAL TIME EXECUTIVE CONSISTS OF * * * 1. TIME PROCESSOR ROUTINES * * 2. CLOCK START UP ROUTINE. * * ******************************************************************** HED REAL TIME CLOCK-TIME LIST PROCESSING ******************************************************************** * THE REAL TIME CLOCK PROCESSOR SECTION OF HP-2100 REAL TIME* * EXECUTIVE HANDLES ALL TIME DEPENDENT FUNCTIONS: * * 1. INCREMENT REAL TIME CLOCK VALUES EVERY 10 MILLISECOND. * * 2. SCHEDULE PROGRAMS AT THE REQUESTED TIME AND COMPUTE ITS* * NEXT START TIME. * * 3. ADD PROGRAMS TO THE TIME LIST. * * 4. REMOVE PROGRAMS FROM THE TIME LIST. * * 5. OUTPUT CURRENT SYSTEM TIME TO USER ARRAY. * * 6. SET ID SEGMENT VALUES AS REQUESTED BY USER. * ******************************************************************** SPC 1 * THE $CLCK ROUTINE FUNCTIONS AS FOLLOWS: * * THE ROUTINE IS ENTERED EVERY 10 MILLISECOND DUE * * TO TIME BASE GENERATOR INTERRUPTS. * * THE TIME VALUE IS INCREMENTED BY 10 MILLISECONDS. * * THE TIME VALUES OF EACH PROGRAM IN TIME LIST IS * * COMPARED TO THE CURRENT TIME. IF THE TIMES * * COMPARE AND THE PROGRAM IS DORMANT, A SCHEDULE * * REQUEST IS MADE VIA LIST PROCESSOR. REGARDLESS * * OF PROGRAM STATUS, THE NEXT START TIME IS * * COMPUTED UNLESS THE MULTIPLE VALUE IS ZERO- * * WHICH MEANS THAT THE PROGRAM IS TO BE REMOVED * * FROM TIME LIST. * * THE TIME-OUT CLOCKS FOR ALL ACTIVE DEVICES ARE * UPDATED. IF ANY DEVICE HAS TIMED-OUT, * RTIOC IS ENTERED TO PROCESS THE CONDITION. * * $CLCK ISZ $TIME STEP THE LOW ORDER TIME VALUE JMP CL010 GO TO PROCESS LISTS ISZ $TIME+1 STEP THE HIGH ORDER TIME VALUE JMP CL010 GO TO PROCESS LISTS LDA RS1 RESET THE COUNTER LDB RS2 TO THE FULL STA $TIME DAYS WORTH OF STB $TIME+1 OF TENS OF MS. ISZ $TIME+2 STEP THE DAYS/YEARS COUNTER * * CHECK IF TIME TO SCHEDULE PROGRAM * CL010 LDB TLIST TIME LIST CL011 CLE,SZB,RSS IF THRU PROCESSING IT, GO JMP TOBAT PROCESS BATCH TIME-OUT STB POINT SAVE TIME LINK ADB D2 B NOW PTS TO IDSEG TIME VAULE DLD B,I GET THE SCHEDULE TIME CPA $TIME IF BOTH WORDS MATCH CCE THEN CPB $TIME+1 THE SEZ,RSS TIME IS JMP CH010 JSB TMSCH NOW SO SCHEDULE THE PROG. * * INCREMENT TO NEXT PROGRAM IN LIST * CH010 LDB POINT,I GET ADDR OF NEXT PROG IN LIST JMP CL011 GO TO COMPARE NEXT PROG IN LIST * * IF CURRENT PGM IS BATCH THEN STEP THE TIMER * TOBAT LDB XEQT GET THE BATCH BIT SZB IF NO CURRENT PGM SKIP CPB DD.RT IF CURRENT PGM IS D.RTR DO NO TIME JMP IOTOP BUT GO DO DEVICE TIME OUTS * CPB $IDSM IF SMP JMP IOTOP ADB D20 TO LDA B,I GET THE BATCH FLAG SSA,RSS IF NOT BATCH JMP IOTOP SKIP TEST * ISZ $BATM STEP BATCH TIMER JMP IOTOP IF NO ROLL OVER EXIT * ISZ $BATM+1 ELSE STEP NEXT WORD JMP IOTOP IF NO ROLL OVER SKIP * RAL PUT FATHER BIT IN 15. SSA IF THIS IS A SON JMP ABOR THEN ABORT HIM * RAR RESTORE A IOR B10K SET THE BREAK FLAG STA B,I AND RESET THE WORD JMP IOTOP CONTINUE WITH TIME OUTS * ABOR LDA ATI GET THE TI ABORT MESSAGE LDB BLANK JSB $ERMG GO ABORT HIM * * PROCESS DEVICE TIME-OUT CLOCKS * IOTOP LDA EQT# SET NEGATIVE OF CMA,INA NUMBER OF EQT STA $TIMV ENTRIES FOR INDEX LDA EQTA POINT TO WORD 15 IOTO2 ADA D14 OF FIRST EQT ENTRY LDB A,I LOAD WORKING CLOCK- SZB IS IT ACTIVE? ISZ A,I YES: INCREMENT IT INA,RSS IT HAS NOT TIMED-OUT JMP $DEVT GO TO TIME-OUT PROCESSOR ISZ $TIMV THRU? JMP IOTO2 NO: GO DO NEXT ONE JMP $XEQ YES; NO TIME-OUTS-RETURN SPC 1 D20 DEC 20 M7777 OCT 7777 RS1 OCT 25000 RS2 OCT 177574 PRS1 OCT 153000 PRS2 OCT 203 BLANK ASC 1, HED REAL TIMxE CLOCK SCHEDULE ON TIME ROUTINE * * PROGRAM TO BE SCHEDULED * * THE TMSCH ROUTINE SCHEDULES THE PROGRAM IF DORMANT * THEN COMPUTES ITS NEXT SCHEDULE TIME FROM ITS * RES CODE AND MULT FACTOR IN ITS ID-SEGMENT. * IF THE RES CODE IS ZERO THE PROGRAM IS REMOVED FROM * THE TIME LIST. * * THE CALLING SEQUENCE IS: * SET POINT TO THE ADDRESS OF THE TIME LINK WORD * JSB TMSCH * TMSCH NOP CCB COMPUTE THE STATUS ADDRESS ADB POINT LDA B,I GET THE STATUS AND D15 GET THE LOW BITS SZA IF NOT DORMANT JMP CH026 FORGIT IT ADB DM15 ELSE SET B TO THE ID-SEG ADDRESS JSB $LIST CALL LIST PROCESSOR TO SCHED PROG OCT 401 THE PROGRAM * * CHECK IF NEXT SCHEDULE TIME TO BE COMPUTED * CH026 LDB POINT INB LDA B,I RES CODE/MULT FACTOR AND M7777 SZA,RSS IF ZERO, THEN NO NEW START TIME JMP CH040 GO REMOVE PROG FROM LIST STA TEMP SAVE MULTIPLICATION FACTOR JSB TUDAT GO UPDATE THE SCHEDULE TIME JMP TMSCH,I RETURN * * REMOVE PROGRAM FROM TIME LIST * CH040 LDA B10K CLEAR THE RESOLUTION TOO. STA B,I AND RESET IN THE ID-SEGMENT. LDB POINT VALUE OF TLINK JSB $TREM GO TO REMOVE PROGRAM JMP TMSCH,I GO TO PROCESS NEXT PROGRAM HED REAL TIME CLOCK PROCESSING ID-TIME UPDATE * TUDAT USES THE RES AND MULT FROM THE ID-SEGMENT TO * UPDATE THE EXECUTE TIME OF THE PROGRAM WHOES ID- * SEGMENT RESOLUTION CODE ADDRESS IS IN B. * * CALLING SEQUENCE: * * SET TEMP TO THE MULT FACTOR * SET B TO THE RES CODE ADDRESS * JSB TUDAT * TUDAT DEF SETMS ENTRY POINT LDA B,I GET THE RES CODE TO A INB SET STB TEMP1 TEMPS TO THE TIME INB ADDRESSES STB TEMP2 IN THE ID-SEGMENT RAL,CLE,SLA,RAL IF HOURS JMqP HR GO DO SPECIAL HOURS UPDATE RAL,CLE ELSE SET UP AND D7 FOR THE APPROPIATE ADA TTAB BASE LDA A,I AND MULTIPLY BY THE MULT. CH030 MPY TEMP CH031 ADA TEMP1,I ADD THE CURRENT VALUE SEZ IF OVERFLOW INB STEP B ADB TEMP2,I ADD THE HIGH BITS. STA TEMP1,I RESTORE THE NEW TIME STB TEMP2,I TO THE ID-SEG. CLE,SSB IF NEGATIVE RESULT THEN JMP TUDAT,I EXIT * LDA RS1 POSITIVE RESULT SO ADD NEG. OF LDB RS2 DAY TO MAKE NEGATIVE JMP CH031 * HR LDA TEMP FOR HOURS FIRST CLB INSURE LESS THAN DIV D24 ONE DAY LDA B RESULT IS MODULO 24 MPY D15 NOW SET UP TO MULTIPLY BY 60,000 STA TEMP IN TWO STEPS TO PREVENT OVERFLOW LDA D24K FIRST BY 15, JMP CH030 AND NEXT BY 24,000 * $BATM NOP NOP TLIST NOP TOP OF TIME SCHEDULE LIST $TIME OCT 16000 TIME OF DAT SET TO 8:00 AND OCT 177650 DAY AND YEAR TO APPROX. DAYS OCT 4552 RELEASE DATE. TTAB DEF * TTAB1 DEC 1 TTAB2 DEC 100 TTAB3 DEC 6000 D24K DEC 24000 D2 DEC 2 D7 DEC 7 D14 DEC 14 D15 DEC 15 D16 DEC 16 D24 DEC 24 DM15 DEC -15 SPC 4 * * SYSTEM START TBG ROUTINE * * THE $SCLK ROUTINE STARTS THE CLOCK PROVIDES * AN ENTRY POINT TO AID THE POWERFAIL ROUTINE. * * ON FIRST ENTRY THIS ROUTINE: * * 1. CONFIGURES IT SELF * 2. STARTS THE TBG. * 3. PRINTS "SET TIME" * 4. EXITS TO THE DISPATCHER. * * ON SUBSEQUENT ENTRIES IT IS A SUBROUTINE TO RESTART * TIME BASE GENERATOR. * $SCLK JMP CONFI GO CONFIGURE ON FIRST ENTRY LDA D2 PROGRAM THE TBG FOR 10'S OF MS. OTATB OTA 0 STCTB OCT 1100 CONFIGURED TO A STC TBG,C STFTB OCT 1600 CONFIGURED TO A STF TBG JMP $SCLK,I RETURN SPC 2 CONFI LDA TBG CONFIGURE THE TB G TEMP IOR OTATB MAKE AN OTA TBG TEMP1 STA OTATB SET IT TEMP2 IOR STCTB FORM AN STC TBG,C TCC STA STCTB SET THE STC XOR STFTB SET UP THE STF STA STFTB TLINC JSB $SCLK START THE TBG POINT LDA TUDAT SEND THE DD.RT STB DD.RT SAVE D.RTR ID-SEG. ADDRESS JSB $SYMG SET TIME JMP $XEQ MESSAGE AND GO TO THE DISPATCHER SPC 2 SETMS DEC -10 LENGTH OF SET TIME MESSAGE OCT 6412 PUT CR/LF OUT FIRST ASC 2,SET TIME ATI ASC 1,TI TI USED BY BATCH TIMER HED $TIMV ROUTINE TO GET CURRENT SYSTEM TIME * THE $TIMV ROUTINE CONVERTS THE CURRENT REAL TIME VALUES * * AND STORES THE VALUES INTO A USER SPECIFIED BUFFER. * * * * ROUTINE TO PROVIDE CURRENT TIME * CALLING SEQUENCE * DLD TIME PUT TIME IN A AND B REGS. * JSB $TIMV * RQP2 CONTAINS BEGIN ADDRESS OF 5 WORD BUFFER * RQP3 (OPTIONAL) CONTAINS ADDRESS OF YEAR BUFFER * ON RETURN, * ARRAY(1) = TENS OF MILLISECOND * ARRAY(2) = SECONDS * ARRAY(3) = MINUTES * ARRAY(4) = HOURS * ARRAY(5) = DAYS * RQP3,I = YEAR (197X) * * E IS SET * A IS THE YEAR * $TIMV ASC 1,ME ENTRY/EXIT (END OF SET TIME MSS.) CLE CLE FOR ADDITION ADA PRS1 ADD POSITIVE 24 HRS. SEZ TO GET A POSITIVE INB TIME ADB PRS2 DIV TTAB3 DIVIDE BY 6000 STA RQP4 SAVE MIN/HR ASR 16 POSITION B (SEC/10MS) FOR DIVIDE DIV TTAB2 DIVIDE BY 100 TO GET SEC/10MS STB RQP2,I SET 10MS VALUE ISZ RQP2 STEP ADDRESS POINTER STA RQP2,I SET SEC. VALUE ISZ RQP2 STEP TO MIN. ADDRESS. CLB SET UP FOR DIVIDE LDA RQP4 FETCH MIN/HR A DIV D60 SEPERATE STB RQP2,I SET MINUTES ISZ RQP2 STEP TO HR. ADDRESS STA RQP2,I SET HRS ISZ RQP2 STEP ADDRESS CLB SET B FOR DIVIDE LDA $TIME+2 GET DAYS FORM THE TIME DIV D365 SEPERATE DAYS AND YEARS CCE,INB STEP DAYS TO 1-365 FROM 0-364 STB RQP2,I SET DAYS ADA D1970 ADD THE BASE YEAR TO YEAR STA RQP3,I SET YEAR JMP $TIMV,I RETURN SPC 2 D60 DEC 60 D365 DEC 365 D1970 DEC 1970 BASE YEAR DM197 DEC -1970 NEG OF BASE YEAR HED REAL TIME ON REQUEST FOR TIME SCHED PROGRAM * ON REQUEST CONTINUATOR * * IF CURRENT TIME VALUES ARE ZERO OR NOW IS CODED THEN * THE CURRENT TIME IS PUT IN THE ID-SEG. AND R/M USED * TO COMPUTE THE NEXT TIME. * * IF CURRENT TIME VALUES ARE NOT ZERO THE PROGRAM IS * JUST PUT IN THE TIME LIST. * * CALLING SEQUENCE * * A=-1 IF NOW OPTION * A#-1 IF NOT NOW BUT PUT IN TIME LIST * B=ID-SEGMENT TIME ADDRESS. * * JMP $ONTM * $ONTM STB DLDAD SET LOAD ADDRESS STA TCC SET NOW FLAG FOR LATER INA,SZA,RSS IF NOW SKIP LOAD JMP NOW DLD DLDAD,I GET THE CURRENT TIME VALUES DLDAD EQU *-1 SZA,RSS IF TIME NOT ZERO SZB THEN JMP TIMIN THEN GO PUT IN TIME LIST NOW DLD $TIME GET CURRENT TIME DST DLDAD,I AND SET IN THE ID-SEG TIMIN LDB DM2 COMPUTE TIME LIST ADDRESS ADB DLDAD AND STB POINT AND SET FOR LIST ROUTINE JSB $TADD ADD PROG TO TIME LIST. ISZ TCC SKIP IF NOW RSS JSB TMSCH SCHEDULE THE PROG. AND UPDATE MESEX CLA SET A FOR NO ERROR LDB $MESS GET RETURN ADDRESS JMP B,I RETURN THRU $MESS ROUTINE HED $TIMR ROUTINE SETS UP ID SEGMENT TIME VALUES * THE $TIMR ROUTINE WHICH ALLOWS USER TO ENTER TIME VALUES * * INTO AN ID SEGMENT FUNCTII ONS AS FOLLOWS: * * IF PROG VALUE IS ZERO, THEN CURRENT EXECUTING PROG. * * AND IF NON-ZERO, THEN SEARCH FOR ID SEGMENT * * ADDRESS. * * IF RESOLUTION CODE IS NON-ZERO, THEN RES/MULT WORD * * STORED. THE NEXT VALUE IS CHECKED FOR + OR -. * * IF PLUS, THEN NEXT START TIME VALUES GIVEN AND * * ARE STORED AND PROGRAM ENTERED INTO TIME LIST. * * IF MINUS, THEN THE COMPLEMENT OF VALUE IS ADDED* * TO THE CURRENT TIME AND ENTERED INTO THE ID * * SEGMENT. IF PROG VALUE IS ZERO, THIS IS TO BE A* * TIME DELAY OF CURRENT PROGRAM AND THUS PROGRAM * * IS SET DORMANT VIA LINK PROCESSOR BUT POINT OF * * SUSPENSION IS NOT CLEARED. IF PROG VALUE IS NON* * ZERO, THEN PROGRAM IS ENTERED INTO TIME LIST. * * THIS IS METHOD FOR SPECIFYING AN INITIAL OFFSET* * TIME. * * * ROUTINE TO SET ID SEGMENT TIME VALUES * CALLING SEQUENCE * JSB EXEC * DEF *+6 OR DEF *+9 * DEF REQUEST CODE ADDRESS RQP1 * DEF PROG RQP2 * DEF RES RQP3 * DEF MULT RQP4 * DEF OFFSET OR DEF HRS RQP5 * DEF MINS RQP6 * DEF SECS RQP7 * DEF TENS OF MSEC RQP8 * WHERE * PROG = 0 IF CURRENTLY EXECUTING * = ADDRESS OF PROGRAM NAME * RES = 1 FOR 10 MILLISECOND RESOLUTION * = 2 FOR SECONDS RESOLUTION LkIST * = 3 FOR MINUTES RESOLUTION LIST * = 4 FOR HOURS RESOLUTION LIST * MULT = 0 FOR N0 MULTIPLE VALUE * = N A POSITIVE INTEGER FOR COMPUTING * NEXT SCHEDULE TIME * OFFSET= M A NEGATIVE INTEGER FOR COMPUTING INITIAL * OFFSET TIME * HRS= START TIME HOURS * MINS= START TIME MINUTES * SECS= START TIME SECONDS * TENS= START TIME TENS OF MILLISECONDS * * EXEC PRE-PROCESSOR CHECKS FOR RESOLUTION CODE * ERRORS AND FINDS THE ID-SEGMENT ADDRESS. * * CALLING SEQUENCE: * * LDB ID-SEGMENT ADDRESS * JMP $TIMR SKP $TIMR ADB D16 GET ADDRESS OF TIME LINK STB TCC AND SAVE IT INB STEP TO RESOLUTION ADDRESS STB TEMP1 AND SAVE LDA B,I GET RESOLUTION CODE/T/MULT INB STEP TO TIME LOCATION STB DSTAD SAVE THE ADDRESS * ALF,ERA SAVE BIT 12 SINCE PROGRAM MAY LDA RQP4,I ALREADY BE IN THE TIME LIST ALF,ERA COMBINE MULT AND SAVED T-BIT LDB RQP3,I RESOLUTION TO B LSR 3 SHIFT RESULT TO A STA TEMP1,I SET IT IN THE ID-SEG. LDA RQP5,I NEGATIVE IF OFFSET SSA,RSS POSITIVE IF START TIME JMP TI100 CMA,INA SET POSITIVE AND STA TEMP SAVE IN TEMP LDA RQP2,I CHECK IF CURRENT XEQ PROGRAM SZA JMP TI012 NO * LDB XEQT YES, SET THE SAVE- STB $WORK RESOURCES BIT IN STA XEQT THE PROGRAM'S STATUS ADB D15 WORD. LDA B,I (CLEAR XEQT SO THAT $LIST WILL IOR B200 SET THE NP BIT IF THE USER IS STA B,I MODIFING ITS ON TIME VALUES). JSB $LIST MAKE PROGRAM DORMANT OCT 300 TI012 LDA $TIME GET THE CURRENT TIME LDB $TIME+1 AND SET R DST DSTAD,I IT IN THE ID-SEG DSTAD EQU *-1 LDB TEMP1 GET THE RES. CODE ADDRESS TO B JSB TUDAT UPDATE THE TIME * TI015 LDB TCC JSB $TADD ENTER PROG INTO TIME LIST JMP $XEQ DONE - EXIT TO DISPATCHER * * GIVEN START TIME * TI100 LDB DSTAD SET B TO THE TIME ADDRESS AND JSB $ETTM GO TO STORE VALUES IN ID SEGMENT JMP TI015 GO PUT PROG IN TIME LIST * DM2 DEC -2 B200 OCT 200 HED REAL TIME CLOCK PROCESSOR SET TIME IN ID-SEG * $ETTM SETS A TIME IN THE REFERENCED ID-SEGMENT. * * CALLING SEQUENCE * * RQP5,I=HOURS * RQP6,I=MINUTES * RQP7,I=SECONDS * RQP8,I=TENS OF MS. * * B=TIME ADDRESS IN THE ID-SEG. * $ETTM NOP ENTRY POINT STB DSTA2 SAVE THE ID-SEG. ADDRESS LDA RQP7,I GET SECONDS MPY TTAB2 CONVERT TO MS (MPY D100) ADA RQP8,I ADD THE MS VALUE AND STA RQP8 AND SAVE LDA RQP5,I GET HOURS MPY D60 CONVERT TO MINUTES ADA RQP6,I ADD MINUTES MPY TTAB3 CONVERT MINUTES TO MS (MPY D6000) CLE PREPARE FOR ADD ADA RQP8 ADD MS VALUE SEZ IF OVERFLOW INB STEP HIGH PART SET01 CLE,SSB IF POSITIVE JMP SET02 ADA RS1 SUBTRACT 24 HRS SEZ,CLE UNTIL INB ADB RS2 IT IS JMP SET01 NEGATIVE SET02 DST DSTA2,I SET THE VALUE IN THE ID-SEG. DSTA2 EQU *-1 JMP $ETTM,I RETURN HED ADDITION OF PROGRAM TO TIME RESOLUTION CODE LIST * THE $TADD ROUTINE FUNCTIONS AS FOLLOWS: * * IF RESOLUTION CODE IS ZERO, THEN EXIT * * IF NON-ZERO RESOLUTION, AND PROGRAM NOT IN TIME LIST* * (BIT 12 OF RES/T/MULT 0), THEN SET BIT 12 OF * * MULT WORD TO SIGNIFY THAT IT IS IN TIME LIST. * * IF TIME LIST IS NULL, THEN SET IT TO POINT TO * * PROGRAM TIME LINK AND SET TLINK TO ZERO. * * IF PROGRAM NOT IN LIST, THEN IT IS ADDED TO * * TOP OF TIME LIST AND ITS TLINK VALUE MADE * * TO POINT TO THE PREVIOUS TOP OF LIST * * PROGRAM. * * * * * ADDING A PROGRAM TO A TIME RESOLUTION CODE LIST * CALLING SEQUENCE * LDB ADDRESS OF ID SEGMENT TLINK VALUE * JSB $TADD * $TADD NOP STB TLINC SAVE TLINK ADDRESS INB INCR TO RES CODE/MULT FACTOR ADD LDA B,I ALF,CLE,ERA AND D7 SZA,RSS JMP $TADD,I EXIT SEZ PROG IN TIME LIST? JMP $TADD,I YES, SO EXIT * LDA B,I IOR B10K SET T BIT STA B,I LDB TLIST LOAD VALUE OF TOP OF LIST LDA TLINC SET LINK OF NEW PROG TO PREVIOUS STB A,I OF TIME LIST STA TLIST SET TOP OF TIME LIST TO NEW PROG TLINK ADDRESS JMP $TADD,I RETURN HED REMOVE A PROGRAM FROM TIME LIST * * * THE $TREM ROUTINE FUNCTIONS AS FOLLOWS: * * IF PROGRAM NOT IN TIME LIST, THEN EXIT * * IF PROGRAM IN TIME LIST, THEN CLEAR BIT 12 OF * * RES/T/MULT TO INDICATE NOT IN TIME LIST. * * A SEARCH IS MADE OF THE TIME LIST PROGRAMS * * UNTIL PROGRAM FOUND OR END OF LIST. THE * * TLINK VALUES ARE CHANGED AS NECESSARY. * * * * * CALLING SEQUENCE * LDB TLINK ADDRESS OF ID SEGMENT * JSB $TREM * $TREM NOP ENTRY/EXIT STB TLINC COMPUTE LIST ADDRESS $ INB LDA B,I CHECK IF PROGRAM IS IN TIME LIST AND B10K SZA,RSS JMP $TREM,I NO, SO EXIT XOR B,I CLEAR T-BIT STA B,I LDA DTLST GET ADDR OF TOP OF LIST PNTR * TR010 LDB A,I GET CURRENT TOP OF LIST CPB TLINC IS THIS THE PROG? JMP TR030 YES SZB,RSS END OF LIST? JMP $TREM,I YES, RETURN STB A SAVE ADDR OF CURRENT LINKWORD JMP TR010 GO CHECK NEXT PROG * TR030 LDB B,I LINK NEXT PROG STB A,I TO PREV PROG TO REMOVE JMP $TREM,I RETURN SPC 1 DTLST DEF TLIST B10K OCT 10000 HED MESSAGE PROCESSOR TM REQUEST COMPLETION * THIS ROUTINE COMPLETES THE SET TIME REQUEST * * CALLING SEQUENCE: * * LDB DEFP1 SET B TO ADDRESS OF PRAM LIST * JMP $TMRQ * $TMRQ LDA DM6 SET UP PRAM ADDRESSES ON STA TEMP THE BASE PAGE LDA DRQP3 TM1 STB A,I ADB D4 PRAMS SEPERATED BY FOUR WORDS INA ISZ TEMP DONE? JMP TM1 NO * LDA RQP3,I GET YEAR ADA DM197 SUBTRACT THE BASE MPY D365 MULTIPLY BY DAYS PER YEAR ADA RQP4,I ADD THE DAY CMB SET B TO -1 IF LEGAL RESULT ADA B SUBRTACT ONE FROM DAY INB,SZB IF B WAS NOT ZERO AFTER MULT. THEN JMP $INER INPUT ERROR STA $TIME+2 SET DAY COUNTER * LDB DTIME GET TIME ADDRESS TO B JSB $ETTM SET THE TIME JMP MESEX EXIT TO MESSAGE PROCESSOR SPC 2 DM6 DEC -6 DRQP3 DEF RQP3 D4 DEC 4 DTIME DEF $TIME HED ** SYSTEM BASE PAGE COMMUNICATION AREA ** * * *** SYSTEM BASE PAGE COMMUNICATION AREA *** * . EQU 1650B ESTABLISH ORIGIN OF AREA * * SYSTEM TABLE DEFINITION * * EQTA EQU .+0 FWA OF EQUIPMENT TABLE EQT# EQU .+1 # OF EQT ENTRIES * DRT EQU .+2 FWA OF DEVICE REFERENCE TABLE LUMAX EQU .+3 # OF LOGICAL UNITS (IN DRT) * INTBA EQU .+4 FWA OF INTERRUPT TABLE INTLG EQU .+5 # OF INTERRUPT TABLE ENTRIES * TAT EQU .+6 FWA OF TRACK ASSIGNMENT TABLE * KEYWD EQU .+7 FWA OF KEYWORD BLOCK * * I/O MODULE/DRIVER COMMUNICATION * EQT1 EQU .+8 ADDRESSES EQT2 EQU .+9 EQT3 EQU .+10 OF EQT4 EQU .+11 EQT5 EQU .+12 CURRENT EQT6 EQU .+13 EQT7 EQU .+14 15-WORD EQT8 EQU .+15 EQT9 EQU .+16 EQT EQT10 EQU .+17 EQT11 EQU .+18 ENTRY EQT12 EQU .+81 EQT13 EQU .+82 EQT14 EQU .+83 EQT15 EQU .+84 * CHAN EQU .+19 CURRENT DMA CHANNEL # TBG EQU .+20 I/O ADDRESS OF TIME-BASE CARD SYSTY EQU .+21 EQT ENTRY ADDRESS OF SYSTEM TTY * * SYSTEM REQUEST PROCESSOR /'EXEC' COMMUNICATION * * RQCNT EQU .+22 # OF REQUEST PARAMETERS -1 RQRTN EQU .+23 RETURN POINT ADDRESS RQP1 EQU .+24 ADDRESSES RQP2 EQU .+25 RQP3 EQU .+26 OF REQUEST RQP4 EQU .+27 RQP5 EQU .+28 PARAMETERS RQP6 EQU .+29 RQP7 EQU .+30 (SET FOR MAXIMUM OF RQP8 EQU .+31 8 PARAMETERS) * * DEFINITION OF SYSTEM LISTS (QUEUES) * * DORMT EQU .+32 ADDRESS OF 'DORMANT' LIST, SKEDD EQU .+33 'SCHEDULE' LIST, SUSP3 EQU .+36 'AVAILABLE MEMORY' LIST, SUSP4 EQU .+37 'DISC ALLOCATION' LIST, SUSP5 EQU .+38 'OPERATOR SUSPEND' LIST * * DEFINITION OF EXECUTING PROGRAM ID SEGMENT' * * XEQT EQU .+39 ID SEGMENT ADDR. OF CURRENT PROG. XLINK EQU .+40 'LINKAGE' XTEMP EQU .+41 'TEMPORARY (5-WORDS) XPRIO EQU .+46 'PRIORITY' WORD XPENT EQU .+47 'PRIMARY ENTRY POINT' XSUSP EQU .+48 'POINT OF SUSPENSION' XA EQU .+49 'A REGISTER' AT SUSPENSION XB EQU .+50 'B REGISTER' XEO EQU .+51 'E AND OVERFLOW * * SYSTEM MODULE COMMUNICATION FLAGS * * OPATN EQU .+52 OPERATOR/KEYBOARD ATTENTION FLAG OPFLG EQU .+53 OPERATOR COMMUNICATION FLAG SWAP EQU .+54 RT DISC RESIDENT SWAPPING FLAG [,TRN DUMMY EQU .+55 I/O ADDRESS OF DUMMY INT. CARD IDSDA EQU .+56 DISC ADDR. OF FIRST ID SEGMENT IDSDP EQU .+57 -POSITION WITHIN SECTOR * * DEFINITION OF MEMORY ALLOCATION BASES * * BPA1 EQU .+58 FWA R/T DISC RES. BP LINK AREA BPA2 EQU .+59 LWA R/T DISC RES. BP LINK AREA BPA3 EQU .+60 FWA BKG DISC RES. BP LINK AREA LBORG EQU .+61 FWA OF RESIDENT LIBRARY AREA RTORG EQU .+62 FWA OF REAL-TIME AREA RTCOM EQU .+63 LENGTH OF REAL TIME COMMON AREA RTDRA EQU .+64 FWA OF R/T DISC RESIDENT AREA AVMEM EQU .+65 FWA OF SYSTEM AVAILABLE MEMORY BKORG EQU .+66 FWA OF BACKGROUND AREA BKCOM EQU .+67 LENGTH OF BACKGROUND COMMON AREA BKDRA EQU .+68 FWA OF BKG DISC RESIDENT AREA * * UTILITY PARAMETERS * TATLG EQU .+69 LENGTH OF TRACK ASSIGNMENT TABLE TATSD EQU .+70 # OF TRACKS ON SYSTEM DISC SECT2 EQU .+71 # SECTORS/TRACK ON LU 2 (SYSTEM) SECT3 EQU .+72 # SECTORS/TRACK ON LU 3 (AUX.) * DSCLB EQU .+73 DISC ADDR OF RES LIB ENTRY PTS DSCLN EQU .+74 # OF RES LIB ENTRY POINTS DSCUT EQU .+75 DISC ADDR OF RELOC UTILITY PROGS DSCUN EQU .+76 # OF RELOC UTILITY PROGS LGOTK EQU .+77 LOAD-N-GO: LU,STG TRACK,# OF TRKS LGOC EQU .+78 CURRENT LGO TRACK/SECTOR ADDRESS SFCUN EQU .+79 SOURCE FILE LU AND DISC ADDRESS MPTFL EQU .+80 MEMORY PROTECT ON/OFF FLAG (0/1) FENCE EQU .+85 MEM PROTECT FENCE ADDRESS * BKLWA EQU .+87 LWA OF MEMORY IN BACKGROUND * * FREG1 EQU LBORG FREG2 EQU RTORG FREG3 EQU BKORG FLG EQU OPFLG * A EQU 0B LOCATION OF A REGISTER B EQU 1B LOCATION OF B REGISTER ORG * PROGRAM LENGTH END $SCLK T  92060-18015 1631 S 0122 RTE III MESSAGE MODULE              H0101 lASMB,R,L ** RT MESSAGE MODULE ** HED RT MESSAGE MODULE * NAME: $ASCM * SOURCE: 92060-18015 * RELOC: 92060-16015 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM $ASCM,0 92060-16015 REV.1631 760622 * SUP * ENTRY REFERENCE NAMES * ENT $OPER,$ERIN,$NOPG,$ILST,$NOLG,$LGBS,$NMEM * ******************************************************************** * * THE RTE MESSAGE MODULE CONTAINS ALL THE FIXED MESSAGES THE * SYSTEM OUTPUTS TO THE USER. * * THESE MESSAGES CONSISTS OF A CHARACTER COUNT (NEGATIVE) * FOLLOWED BY THE ASCII MESSAGE. * * THE ENTRY POINT IS ON A DEF TO THE ABOVE MESSAGE. * ******************************************************************** * $ILST DEF *+1 ILLEGAL STATUS ERROR MESSAGE DEC -14 ASC 7,ILLEGAL STATUS * $NOLG DEF *+1 DM12 DEC -12 ASC 6,NO LGO SPACE * $LGBS DEF *+1 DM10 DEC -10 ASC 5,LGO IN USE * $OPER DEF *+1 OPERATION CODE ERROR MESSAGE DEC -12 ASC 6,OP CODE ERR * $NOPG DEF *+1 NO SUCH PROGRAM ERROR MESSAGE DEC -12 NO ASC 6,NO SUCH PROG * $ERIN DEF *+1 INPUT ERROR MESSAGE DEC -12 ASC 6,INPUT ERROR * $NMEM DEF *+1 DEC -18 ASC 9,CMD IGNORED-NO MEM * END $ERIN \   92060-18016 1840 S 0722 RTE-III INPUT OUTPUT CONTROL             H0107 b#ASMB,Q,C ** R/T INPUT/OUTPUT CONTROL MODULE ** HED ** R/T INPUT/OUTPUT CONTROL MODULE ** * DATE: 5/05/75 * NAME: RTIOCM * SOURCE: 92060-18016 * RELOC: 92060-16016 * PGMR: G.A.A.,L.W.A.,D.L.S. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM RTIOCM 92060-16016 REV.1840 780810 * ***** AMD-DAS ***** FEB,72 ***** REV.LWH ***** ***** AMD-DAS ***** AUG,72 ***** REV.GAA ***** * * * ***** AMD-DAS ***** APR,75 ***** REV.LWA ***** * * * * * ENT $CIC,$XSIO,$SYMG,$IORQ,$IOUP,$IODN ENT $ETEQ,$IRT,$XCIC,$DEVT ENT $GTIO,$UPIO,$CVEQ,$YCIC ENT $BITB,$UNLK,$XXUP,$DLAY,$DMEQ,$CKLO ENT $BLLO,$BLUP,$DVM,$RSM,$MEU ENT $OPSY * EXT $RQST,$CLCK,$XEQ,$TYPE,$LIST,$ALC,$RTN EXT $LUSW,$SCD3,$RNTB,$CVT3,$ERMG EXT $CVT1,$CLAS,$REIO,$ABRT,$INER,$ZZZZ EXT $PDSK SUP EXT $ERAB,$IDNO,$SMAP,$MATA EXT $MRMP,$MVBF * * ORB $BLLO DEC -100 $BLUP DEC -300 ORR * * MODULE OF THE R E A L - T I M E E X E C U T I V E * * * THIS INCLUDES THE FOLLOWING MAJOR SECTIONS: * * 1) CENTRAL INTERRUPT CONTROL * * 2) INPUT / OUTPUT CONTROL * - I/O REQUEST PROCESSING * - I/O COMPLETION PROCESSING * - GENERAL I/O ERROR PROCESSING * * 3) SYSTEM ERROR DIAGNOSTIC PRINT ROUITNE * * 4) PROCESSOR FOR OPERATOR I/O STATEMENTS * HED < CENTRAL INTERRUPT CONTROL > * *** C E N T R A L I N T E R R U P T C O N T R O L *** * * THE PROCESSING OF SYSTEM INTERRUPTS IS CONTROLLED * BY DIRECTING ALL SOURCES TO THE ENTRY POI0NT < $CIC>. * < $CIC> IS RESPONSIBLE FOR SAVING AND RESTORING * THE CURRENT STATE OF THE MACHINE, ANALYSING THE * SOURCE OF THE INTERRUPT, AND ACTIVATING THE * APPROPRIATE PROCESSOR. THIS ROUTINE IS TABLE-DRIVEN * BY THE *INTERRUPT TABLE*. * * SPECIAL PROCESSING FOR A "PRIVILEGED" CLASS OF * INTERRUPTS IS PROVIDED BY $CIC. THIS IS DESCRIBED * FULLY IN SECTION III BELOW. BRIEFLY, A SPECIAL * I/O CARD CAN BE USED TO SEPARATE SPECIAL INTERRUPTS * FROM NORMAL SYSTEM CONTROLLED INTERRUPTS. THE * PRESENCE AND LOCATION OF THE SPECIAL CARD IS * NOTED AT SYSTEM CONFIGURATION TIME. IF IT IS * PRESENT, THE EXEC OPERATIONS ARE NOT PERFORMED * WITH THE INTERRUPT SYSTEM DISABLED BUT RATHER * WITH THE CONTROL SET ON THE SPECIAL CARD TO * HOLD OFF SYSTEM I/O INTERRUPTS. * * I. INTERRUPT TABLE (INTBL) * * A TABLE, ORDERED BY HARDWARE INTERRUPT PRIORITY, * DESIGNATES THE ASSOCIATED SOFTWARE PROCESSOR AND * THE PROCEDURE FOR INITIATING THE PROCESSOR. THIS * TABLE IS CONSTRUCTED BY *RTGEN* ON INFORMATION * SUPPLIED BY THE USER IN CONFIGURING THE SYSTEM. * THE TABLE CONSISTS OF ONE ENTRY PER INTERRUPT * SOURCE: EACH ENTRY CONTAINS ONLY ONE WORD. THE * CONTENTS OF EACH VALID ENTRY IS THE IDENTIFIER * OF THE PROCESSOR. SYSTEM PROCESSORS ARE NOTED * BY POSITIVE VALUES, USER PROCESSORS BY NEGATIVE * VALUES: * * 1. SYSTEM - THE IDENTIFIER IS THE ADDRESS OF * THE EQT ENTRY IDENTIFYING THE I/O DEVICE. * * 2. USER - THE ADDRESS OF THE PROGRAM * IDENTIFICATION SEGMENT IS IN 2-S COMPLEMENT * FORM IN THE ENTRY. * * 3. ILLEGAL - AN ENTRY CORRESPONDING TO AN * ILLEGAL INTERRUPT SOURCE CONTAINS ZERO. * * A PROCESSOR IS CALLED DIRECTLY IF IT RESPONDS * TO STANDARD SYSTEM INTERRUPT (E.G., $CLCK, * MEMORY PROTECT, I/O DEVICE CONTROLLED BY A * SYSTEM DRIVER) OR IS SCHEDULED IN THE NORMAL * PRIORITY ORDER IF IT RESPONDS TO A USER * CONTROLLED DEVICE OR INTERRUPT SOURCE. SKP * II. INTERRUPT PROCESSING * * INTERRUPT ACKNOWLEDGEMENT BY THE CPU CAUSES * THE INSTRUCTION IN THE WORD CORRESPONDING * TO THE I/O CHANNEL ADDRESS TO BE EXECUTED. * FOR ALL ACTIVE I/O CHANNELS ( PLUS LOCATIONS * 5-7 ) CONTROLLED BY THE SYSTEM, THE INSTRUCTION * SET IN EACH INTERRUPT LOCATION IS A JUMP * SUBROUTINE INDIRECTLY TO < $CIC>. * SKP * <$CIC> PERFORMS THE FOLLOWING: * * 1. DISABLES THE INTERRUPT SYSTEM. * * 2. SAVES ALL REGISTERS PLUS THE INTERRUPT * RETURN POINT IN THE EXECUTING * ID SEGMENT. * * 3. CLEARS THE FLAG OF THE INTERRUPT SOURCE. * * 4. SETS 'MPTFL' = 1 TO MEAN MEMORY PROTECT * IS OFF - FLAG FOR PRIVILEGED PROCESSORS. * * 5. CHECKS FOR SPECIAL INTERRUPT PROCESSING. * IF 'DUMMY' IN BASE PAGE COMMUNICATION * AREA = 0, THEN LEAVE THE INTERRUPT SYSTEM * DISABLED AND GO TO STEP 6. * * 'DUMMY' > 0 - PRIVILEGED INTERRUPTS: * -THE CONTENTS OF 'DUMMY' IS THE I/O * ADDRESS OF THE CARD; THIS IS USED TO * SET THE CONTROL FF ON THE CARD (FLAG * IS ALREADY SET) TO HOLD OFF LOWER * PRIORITY INTERRUPTS (SYSTEM INTERRUPTS) * -CLEARS THE CONTROL FLIP-FLOP OF * EACH DMA CHANNEL TO PROHIBIT POSSIBLE * INTERRUPTS FROM OCCURRING. * -ENABLE THE INTERRUPT SYSTEM. * * 6. TRANSFERS DIRECTLY TO THE INTERRUPT * PROCESSOR FOR SOURCES OF: * * 5 - MEMORY PROTECT VIOLATION * 6 - TIME BASE GENERATOR(TBG)INTERRUPT * * FOR OTHER SOURCES, THE INTERRUPT SOURCE * CODE IS USED TO INDEX THE INTERRUPT TABLE. * THE CONTENTS OF THE INTBL ENTRY DETERMINES * THE MANNER IN INITIATING THE PROCESSOR: * * A. +, THE CONTENTS OF THE ENTRY IS * ASSUMED TO BE THE FWA OF AN EQT ENTRY. * THE ADDRESSES OF THE 15-WORD ENTRY * ARE SET IN AND CONTROL * TRANSFERRED DIRECTLY TO THE COMPLETION * SECTION ADDRESS (WORD 3 OF EQT ENTRY). * * B. -, THE VALUE IS SET POSITIVE AND IS * SET IN A CALL TO <$LIST> IN THE * SCHEDULING MODULE- THE CALL IS MADE IF * THE USER PROGRAM IS DORMANT- CONTROL IS * TRANSFERRED TO $XEQ. IF THE PROGRAM IS * NOT DORMANT, IT IS NOT SCHEDULED AND THE * DIAGNOSTIC "SC03 INT XXXXX" IS OUTPUT * TO THE SYSTEM TTY- XXXXX IS THE PROGRAM * NAME. CONTROL IS RETURNED TO THE INTER- * RUPTED SEQUENCE. * * C. 0, ILLEGAL OR UNDEFINED INTERRUPTS ARE * NOT PROCESSED BUT THE DIAGNOSTIC * "ILL INT XX" IS OUTPUT TO THE SYSTEM * TTY. XX IS THE INTERRUPT CODE. * * 7. I/O DRIVER RETURNS INDICATE CONTINUATION * OR COMPLETION OF THE OPERATION BY THE * DRIVER OR DEVICE: * * A. RETURN AT (P+1): COMPLETION OF THE * OPERATION. $CIC TRANS- * FERS DIRECTLY TO THE * IOC COMPLETION SECTION * AT < IOCOM >. CONTROL * IS NOT RETURNED TO * < $CIC>. * * B. RETURN AT (P+2): CONTINUATION OF THE * OPERATION. $CIC RETURNS * TO THE INTERRUPTED * SEQUENCE AS DESCRIBED * IN STEP 8 FOLLOWING. * * 8. RESTORING INTERRUPT CONDITIONS AND RETURN * TO POINT OF INTERRUPTION. AN ENTRY POINT * CALLED '$IRT' IS PROVIDED FOR USE BY * OTHER MODULES OF THE R/T EXEC TO RESET * FLAGS AND THE DMA CHANNELS AND RETURN TO * THE USER PROGRAM. * * THE CALLING SEQUENCE IS JUST: * o* - JMP $IRT - * * $IRT PERFORMS THE FOLLOWING: * 1 - DISABLES THE INTERRUPT SYSTEM * 2 - SETS 'MPTFL' = 0 TO MEAN THAT MEMORY * PROTECT IS ON (ENABLED). * 3 - SKIP TO 6 IF NOT A PRIVILEGED SYSTEM * 4 - ISSUES A CLC TO CLEAR THE CONTROL * FF ON THE SPECIAL CARD. * 5 - SETS THE CONTROL FF ON EITHER DMA * CHANNEL IF BIT 15 OF THE INTBL WORD * =1 TO MEAN IT IS ACTIVE. THIS * ENABLES DMA INTERRUPTS ONLY. * 6 - RESTORES THE REGISTERS AND * 7 - EXECUTES THE CURRENT PROGRAM AT XSUSP. SKP * III. SPECIAL (PRIVILEGED) INTERRUPTS * * THIS PROVISION ALLOWS INTERRUPTS FROM SPECIAL * DEVICES TO BE RECOGNIZED WITHIN 100 MICRO SECONDS * AND TO BE PROCESSED BY SPECIAL, COMPLETELY * INDEPENDENT ROUTINES CLASSIFIED AS SYSTEM TYPE * PROGRAMS. INTERRUPTS ARE CHANNELED DIRECTLY * TO THE ENTRY POINT OF A ROUTINE BY A JSB INDIRECT * IN THE CORRESPONDING CORE LOCATION. $CIC IS * NOT AWARE OF THESE SPECIAL INTERRUPTS OCCURRING; * IT ONLY ALLOWS THE INTERRUPT SYSTEM TO BE * ENABLED AND A SOFTWARE FLAG SET TO INDICATE * THE STATUS OF MEMORY PROTECT. THE JSB TO THE * ENTRY POINT FOR A ROUTINE IS SET BY USING THE * "ENT,XXXXX" STATEMENT IN RTGEN WHEN CONFIGURING * A REAL-TIME SYSTEM. * THE SPECIAL PROCESSING ROUTINES CANNOT USE * ANY FEATURES OR REQUESTS OF THE STANDARD * R/T EXEC. THESE ARE INDEPENDENT ROUTINES. * COMMUNICATION BETWEEN A NORMAL PROGRAM UNDER * THE CONTROL OF THE R/T EXEC AND A SPECIAL * INTERRUPT PROCESSOR CAN BE DONE THROUGH * THE APPROPRIATE COMMON REGION: I.E. FLAGS OR * INDICATORS CAN BE SET IN PRE-DEFINED WORDS * IN COMMON TO INITIATE PROCESSING. THE NORMAL * USER PROGRAM CAN BE SCHEDULED TO RUN AT A * PERIODIC TIME INTERVAL TO SCAN THE INDICATORS. * THIS FACILITY IhTS PROVIDED TO ACCOMODATE HIGH- * SPEED PROGRAM CONTROLED DATA TRANSMISSION * WHICH REQUIRES QUICK RESPONSE. * THE SPECIAL INTERRUPT PROCESSORS ARE * RESPONSIBLE FOR SAVING AND RESTORING ALL * REGISTERS USED AND FOR RESTORING MEMORY * PROTECT TO ITS STATE BEFORE THE SPECIAL * INTERRUPT OCCURRED. MEMORY PROTECT IS * AUTOMATICALLY DISABLED AT THE OCCURRENCE * OF ANY INTERRUPT. THE WORD 'MPTFL' IN THE * BASE PAGE COMMUNICATION AREA IS SET BY THE * R/T EXEC TO INDICATE THE STATUS OF THE * MEMORY PROTECT: * * 'MPTFL' = 0 MEANS MEMORY PROTECT IS 'ON'. * THE SPECIAL ROUTINE MUST ISSUE * A STC 5 IMMEDIATELY BEFORE * RETURNING TO THE INTERRUPTED * SEQUENCE BY A JMP -,I * * = 1 MEANS THAT THE R/T EXEC ITSELF * WAS EXECUTING WHEN THE INTERRUPT * OCCURRED AND THAT MEMORY * PROTECT IS 'OFF'. THE ROUTINE * MUST NOT ISSUE THE STC 5 IN * THIS CASE. * * IF A SPECIAL INTERRUPT ROUTINE MUST EXECUTE * WITH THE INTERRUPT SYSTEM DISABLED, THE * STC 0 TO RE-ENABLE INTERRUPTS JUST PRIOR TO * EXITING MUST BE IN THE FOLLOWING SEQUENCE IF * MEMORY PROTECT IS ALSO TO BE TURNED ON: * * - STF 0 - * - STC 5 - * - JMP -,I - SKP $CIC NOP * CLF CLF 0 DISABLE INTERRUPT SYSTEM * * PRESERVE CURRENT STATUS OF MACHINE * SSM $MEU SAVE MEU STATUS AT INTERRUPT FOR $MESS STA XA,I SAVE REGISTERS STB XB,I SAVE REGISTERS ERA,ALS A,B SOC E AND INA OVERFLOW STA XEO,I LIA 4 GET INTERRUPT SOURCE CODE. CPA .5 IF MP/PE JMP $YCIC SKIP CLF (CLEARS SIGN BIT IF PE) * IOR CLF CONSTRUCT A CLF XX INSTRUCTION STA *+1 AND CLEAR INTERRUPT FLAG TO * ALLOW SPECIAL USER INTERRUPTS NOP TO BE ACKNOWLEDGED. * $XCIC LIA 4 ### SPECIAL ENTRY TO SKIP CLF ### $YCIC STA INTCD SAVE INTERRUPT SOURCE CODE. * ISZ MPTFL SET 'MPTFL' = 1 TO MEAN MP IS OFF. * SW1 JMP CIC.0 (STC DUMMY IF PRIVILEDGED OPTION) * * PROVIDE FOR SPECIAL (PRIVILEGED) INTERRUPTS * * CLC 6 CLEAR DMA CHANNELS CLC 7 CONTROL FF. * STF 0 RE-ENABLE INTERRUPTS * * CIC.0 EQU * MX1 EQU * ADDRESS OF JMP NMX1 LDA XI SAVE INDEX REGISTERS CXB XSB A,I STORE X THROUGH USER MAP INA CYB XSB A,I STORE Y THROUGH USER MAP LDA INTCD RESTORE THE INT CODE NMX1 LDB $CIC SAVE P-REGISTER A POSSIBLE STB XSUSP,I POINT OF SUSPENSION. * * CHECK FOR TRANSFER TO NON-I/O SYSTEM PROCESSOR * CPA .5 IF MEMORY PROTECT VIOLATION, JMP $RQST GO TO EXAMINE MP VIOLATION. * CPA TBG IF TIME BASE GENERATOR, JMP $CLCK GO TO TBG PROCESSOR ROUTINE. * * CHECK LEGALITY OF INTERRUPT * ADA N6 CODE - 6. STA B (SAVE FOR TABLE INDEX) ADB INTBA INDEX TO PROPER ENTRY CMA,CLE,SSA - ERROR IF CODE ADA INTLG LESS THAN 6 OR BEYOND * * GET PROCESSOR IDENT FROM INTERRUPT TABLE * LDA B,I GET CONTENTS OF ENTRY SEZ SKIP IF OUT OF INTBL RANGE. CLE,SZA,RSS UNDEFINED INTERRUPT JMP CIC.4 IF VALUE = 0, ISSUE DIAG. * * LDB INTCD REMOVE ERB BIT 15 OF INTBL WORD CPB .3 IF DMA CHANNEL RAL,CLE,ERA INTERRUPT. * SSA,RSS SYSTEM PROCESSOR IS TO BE CALLED JMP CIC.2 IF VALUE IS POSITIVE. * ** INTERRUPT PROCESSOR IS USER ROUTINE TO BE ** SCHEDULED FOR PRIORITY EXECUTION * CMA,INA SET POSITIVE TO GET ID SEGMENT STA B ADDRESS, SET IN B TO <$LIST>. * ADA .15 CHECK STATUS OF PROGRAM. LDA A,I IF STATUS IS ZERO (DORMANT), SZA SCHEDULE PROGRAM, OTHERWISE JMP CIC.5 ISSUE DIAGNOSTIC. * JSB $LIST CALL SCHEDULER TO LINK PROGRAM OCT 401 INTO SCHEDULE LIST. JMP $XEQ SPC 1 N6 DEC -6 SKP * * * ASSUME PROCESSOR FOR CODE GT= 6 IS A * SYSTEM I/0 DRIVER. VALUE OF INTERRUPT * TABLE ENTRY IS THE STARTING ADDRESS * OF THE EQUIPMENT TABLE ENTRY CORRESPONDING * TO THE INTERRUPTING DEVICE. * CIC.2 JSB $ETEQ SET EQT ENTRY ADDRESSES. * CIC.6 JSB $DVM GO SET RIGHT MAP * LDA INTCD (A) = INTERRUPT SOURCE CODE * LDB EQT14,I SET DEVICE SZB TIME-OUT CLOCK IF STB EQT15,I USER SPECIFIED TIME-OUT. * * CALL I/O PROCESSOR, COMPLETION SECTION * LDB EQT3,I CALL DRIVER JSB B,I *COMPLETION* SECTION. * JMP IOCOM (P+1): *COMPLETION RETURN* * JSB $RSM GO RESTORE USER * CLA (P+2): *CONTINUATION RETURN* LDB OPATN CHECK FOR OPERATOR ATTENTION. STA OPATN -CLEAR OPERATOR FLAG- SZB IF FLAG SET, JMP $TYPE ACKNOWLEDGE. * LDA $LIST IF $LIST ENTERED SZA,RSS SKIP TO ENTER $XEQ JMP $IRT RETURN TO POINT OF INTERRUPT * JMP $XEQ GO DISPATCH POSSIBLE NEW PROGRAM * * ILLEGAL OR UNDEFINED INTERRUPT * CIC.4 LDA INTCD GET THE INTERRUPT CODE. JSB $CVT1 CONVERT. STA CICM1+6 STUFF IN THE MESSAGE LDA CICM1 PRINT JMP CIC.7 "ILL INT XX" * * ISSUE DIAGNOSTIC FOR BEING UNABLE TO * SCHEDULE USER PROGRAM ON INTERRUPT. * CIC.5 ADB .12 SET (B) TO ADDRESS OF NAME IN LDA B,I PROGRAM ID SEGMENT. STA CICM2+7 STORE INB PROGRAM DLD B,I NAME IN DST CICM2+8 DIAGNOSTIC AND PRINT A LDA CICM2 "SC03 INT XXXXX" CIC.7 JSB $SYMG * * RESET INTERRUPT CONDITIONS - RETURN TO SEQUENCE * * ROUTINE: '$IRT' * * THIS ROUTINE RETURNS TO THE CURRENT USER PROGRAM. * IT DOES THE PRIV. INTERRUPT SYSTEM EXIT THING AND * RESTORES THE PROGRAMS REGISTERS AND THE INTERRUPT * AND MEMORY PROTECT SYSTEM. * * CALLING SEQUENCE: * * SET UP XEQT AREA ON THE BASE PAGE FOR THE PROGRAM * * JMP $IRT * $IRT LDA XSUSP,I GET THE EXECUTE ADDRESS * STA RTN SAVE THE RETURN ADDRESS MX2 EQU * ADDRESS OF JMP MX2 SJP *+2 LDB XI RESTORE INDEX REGISTERS XLA B,I INB XLB B,I CAX CBY NMX2 LDA XEO,I RESTORE E AND CLO O REGS. SLA,ELA PRIOR TO INTERRUPT TURN OFF STF 1 TO KEEP TIME DOWN CLA CLEAR 'MPTFL' TO MEAN CLF 0 TURN OFF THE INTERRUPT SYSTEM STA MPTFL MEMORY PROTECT IS ON. * SW2 JMP IRT2 RETURN IF NOT PRIV. (ELSE CLC) * STF1 STF 12B BUFFER ON DUMMY I/O CARD * DLD INTBA,I CHECK CONDITION OF DMA CHANNELS SSA IF BIT = 1 FOR DMA #1 (ACTIVE) STC 6 THEN SET CONTROL TO ENABLE SSB INTERRUPTS. SAME FOR STC 7 DMA CHANNEL #2. * IRT2 LDA XA,I RESTORE THE A AND B REGS LDB XB,I STF 0 TURN ON THE INTERRUPT SYSTEM STC 5 AND MEMORY PROTECT UJP * ENABLE USER MAP AND RETURN RTN EQU *-1 SPC 4 CICM1 DEF *+1 DEC -10 ASC 5,ILL INT XX * CICM2 DEF *+1 DEC -15 ASC 8,SC03 INT XXXXX * INTCD NOP HOLDS INTERRUPT SOURCE CODE $MEU NOP MEU STATUS AT INTERRUPT D$LUT DEF $LUSW ADDRESS OF BATCH LU TABLE $OPSY DEC -1 FLAG INDICATING RTE-III SYSTEM. HED < RT EXECUTIVE INPUT/OUTPUT CONTROL > *** I N P U T / O U T P U T C O N T R O L *** * x* THE I/O SCHEDULING AND CONTROL MODULE < IOC > * IS RESPONSIBLE FOR ALLOCATING THE USE OF ALL * STANDARD I/O DEVICES AND THE TWO DMA CHANNELS. * I/O DRIVERS OPERATE UNDER CONTROL OF AND * <$CIC> FOR INITIATION AND COMPLETION OF SYSTEM * AND USER DIRECTED I/O OPERATIONS. I/O DRIVERS * ARE INDEPENDENT PROGRAMS IDENTIFIED TO * BY THE DEVICE ASSOCIATED EQUIPMENT TABLE. DRIVERS * ARE COMPOSED TO TWO SECTIONS: *INITIATION* AND * *COMPLETION*. THE *INITIATION* SECTION IS * CALLED BY TO EXAMINE AND INITIATE AN I/O * OPERATION. THE *COMPLETION* SECTION IS CALLED * BY <$CIC> TO CONTINUE OR COMPLETE THE OPERATION. * DRIVERS PROVIDE FOR SIMULTANEOUS MULTI-DEVICE * CONTROL BY USING THE DEVICE EQT ENTRY FOR * VARIABLE STORAGE. * * I. * EQUIPMENT TABLE * (EQT) * * EACH I/O DEVICE CONTROLLED BY THE IOC/DRIVER * RELATIONSHIP IS DEFINED BY STATIC AND DYNAMIC * INFORMATION IN THE EQUIPMENT TABLE. THE EQT * IS A SYSTEM RESIDENT TABLE WHICH IS CONSTRUCTED * FROM USER DIRECTIVES BY . EACH EQT * ENTRY IS COMPOSED OF 15-WORDS IN THE FOLLOWING FORMAT: * SKP * * WORD CONTENTS * ---- ---------------------------- * 1 * I/O LIST . LINK POINTER * * 2 *DRIVER *INITIATION ADDRESS* * 3 *DRIVER *COMPLETION ADDRESS* * 4 *DBPOT/----UNIT#--CHANNEL #* * 5 *AV-TYPE CODE- UNIT STATUS* * 6 *REQUEST CONTROL WORD * * 7 *REQUEST BUFFER ADDRESS * * 8 *REQUEST BUFFER LENGTH * * 9 *TEMPORARY OR DISC TRACK # * * 10 *TEMPORARY OR DISC SECTOR #* * 11 *DRIVER TEMPORARY STORAGE* * 12 * " " " * * 13 * " " " * * 14 * DEVICE CLOCK RESET VALUE * * 15 * " " WORKING " * * * D: =1 IF A DMA CHANNEL REQUIRED FOR TRANSFER * B: =1 IF AUTOMATIC OUPUT BUFFERING DESIRED * P: =1 IF DRIVER TO HANDEL POWER FAIL RECOVERY. * O: =1 IF DRIVER TO HANDEL TIME OUT. * T: DEVICE TIME-OUT BIT - CLEARED BE%FORE EACH * IO INITIATION; SET IF DEVICE TIMES-OUT. * UNIT#: LAST SUBCHANNEL REFERENCED ON THIS EQT. * CHANNEL#: I/O SELECT CODE (LOWER # IF * MULTI-BOARD INTERFACE) * AV (AVAILABILITY INDICATOR): * =0, UNIT AVAILABLE FOR OPERATION * =1, UNIT DISABLED * =2, UNIT CURRENTLY IN OPERATION * =3, UNIT WAITING FOR DMA CHANNEL * TYPE CODE: CODE IDENTIFYING TYPE OF I/O DEVICE * UNIT STATUS: ACTUAL OR SIMULATED UNIT STATUS * AT END OF OPERATION * * II. * DEVICE REFERENCE TABLE * (DRT) * * THE DEVICE REFERENCE TABLE PROVIDES FOR * LOGICAL DEVICE ADDRESSING OF PHYSICAL I-O * SLOTS DEFINED IN THE *EQT*. THE *DRT* CONSISTS * OF TWO SEQUENTIAL TABLES EACH TABLE CONSISTING * OF 1-WORD ENTRIES CORRESPONDING TO THE RANGE * OF USER-SPECIFIED "LOGICAL" UNITS, 1 TO N * WHERE N IS LT OR = TO 63(10). THE CONTENTS OF * EACH LOGICAL UNIT'S WORD ONE IS AS FOLLOWS: * BITS 5-0 DEVICE'S EQT NUMBER * BITS 6-10 THE LOCKING RESOURCE NUMBER * BITS 11-15 THE DEVICE'S SUBCHANNEL ON THE EQT. * THE CONTENTS OF EACH LOGICAL UNIT'S DEVICE * REFERENCE TABLE WORD TWO CONTAINS A * POINTER TO THE I/O QUEUE OF THE I/O REQUESTS * FOR THIS DEVICE WHEN THE DEVICE IS DOWN: * BIT 15=0 FOR AN UP LU. * =1 FOR A DOWN LU. * BITS 14-0=0 FOR AN UP LU. * #0 FOR A DOWN LU WHERE * = ADDRESS OF THE I/O QUEUE IF THIS * IS THE FIRST LU(MAJOR LU)POINTING * TO THE DEVICE. * = 1 TO 1777(8). THE LU NUMBER OF * DEVICE(MAJOR LU)ON WHICH THE I/O * IS QUEUED. * * CERTAIN LOGICAL UNIT #S ARE PERMANENTLY * ASSIGNED TO FACILITATE SYSTEM, USER AND * SYSTEM SUPPORT I/O OPERATIONS. THESE ARE: * * 0 - BIT BUCKET(DUMMY LU)(NO ENTRY IN DRT) * 1 - SYSTEM TELETYPEWRITER * 2 - SYSTEM DISC * 3 - AUXILIARY DISC * 4 - 'STANDARD' PUNCH UNIT * 5 - 'STANDARD' {INPUT UNIT * 6 - 'STANDARD' LIST UNIT * 7 - ASSIGNED * . BY * . USER * 63 - SKP * * III. INPUT/OUTPUT REQUESTS * * I/O REQUESTS INCLUDE COMMANDS FOR * READ, WRITE, CONTROL(FUNCTIONS) AND STATUS. * THE FORMAT OF THESE REQUESTS CONFORM TO * THE GENERAL SYSTEM REQUEST FORMAT. THE * NUMBER OF PARAMETERS VARIES DEPENDING * ON THE TYPE OF REQUEST AND THE CHARAC- * TERISTICS OF THE REFERENCED DEVICE. * * A USER I/O REQUEST IS DIRECTED TO * AT -$IORQ- BY THE EXECUTIVE REQUEST * PROCESSOR <$RQST>. SYSTEM I/O REQUESTS * ARE IN A DIFFERENT FORMAT AND ARE PROCESSED * AT THE SECTION -$XSIO- IN . REFER TO * THAT SECTION FOR DETAILED DESCRIPTION. * * A *STATUS* REQUEST IS PROVIDED * FOR USER AND SYSTEM SUPPORT PROGRAMS * WHICH REQUIRE KNOWLEDGE OF DEVICE * CONDITIONS OR TYPE BEFORE A READ/WRITE/ * CONTROL REQUEST IS MADE. THE PROGRAM * IS NOT SUSPENDED ON THIS CALL. * A PARAMETER WORD IS INCLUDED IN THE * REQUEST TO CONTAIN THE DEVICE STATUS ON * RETURN TO THE USER. THIS STATUS IS FROM WORD * 5 OF THE EQT ENTRY FOR THE DEVICE. * ALSO, AN ADDITIONAL PARAMETER WORD CAN BE * INCLUDED IN THE REQUEST- WORD 4 OF THE * EQT ENTRY IS RETURNED IF THE ADDITIONAL * PARAMETER WORD IS INCLUDED. * * A DYNAMIC STATUS REQUEST CAN BE MADE BY * MEANS OF A CONTROL REQUEST, THE FORMAT * OF WHICH IS DEFINED BELOW. IN THIS CASE, * THE REQUEST IS QUEUED, THE DRIVER IS ENTERED, * AND THE STATUS IS RETURNED TO THE CALLING * PROGRAM IN THE A REGISTER. * SKP * * A. READ/WRITE REQUEST FORMAT * * EXT EXEC * JSB EXEC * DEF EXIT (DEFINE EXIT POINT) * DEF RCODE (DEFINE READ (1) OR WRITE(2)) * DEF CONWD (DEFINE CONTROL WORD) * DEF BUFFR (DEFINE BUFFER LOCATION) * DEF BUFFL (DEFINE BUFFER LENGTH) * DEF DTRAK (OPTIONAL - DISC TRACK #) * 8NLHDEF DSECT (OPTIONAL - DISC SECTOR #) * EXIT --- * . * . * RCODE DEC 1 OR 2 * CONWD OCT NNNNN CONTROL INFO/LOGICAL UNIT # * BUFFL DEC N OR -N WORD OR CHARACTER LENGTH * DTRAK DEC N DISC TRACK # * DSECT DEC N STARTING SECTOR # * * BIT 12 OF THE CONTROL WORD SET ON NON-DISC REQUESTS * INDICATES A DOUBLE BUFFER FOR THIS OPERATION. * IN THIS CASE THE CONTROL BUFFER IS AT "DTRAK" AND IT'S * LENGTH IN WORDS-CHARACTERS IS AT "DSECT". * * * B. CONTROL REQUEST FORMAT * * EXT EXEC * JSB EXEC * DEF EXIT (DEFINE EXIT POINT) * DEF RCODE (DEFINE REQUEST CODE) * DEF CONWD (DEFINE CONTROL WORD) * DEF PARAM (DEFINE OPTIONAL PARAMETER) * EXIT --- * . * . * RCODE DEC 3 * CONWD OCT NNNNN CONTROL CODE/LOGICAL UNIT # * PARAM DEC N PARAMETER REQUIRED BY TYPE OF CODE ГN* * CONTROL CODES (FIELD 10-06 OF CONTROL WORD): * * 01 - WRITE END-OF-FILE --/ PRIMARILY * 02 - BACKSPACE 1 RECORD / FOR * 03 - FORWARD SPACE 1 RECORD / MAGNETIC * 04 - REWIND / TAPE * 05 - REWIND STANDBY / UNITS * 06 - DYNAMIC STATUS --/ * 07 - SET EOT STATUS (FOR PAPER TAPE INPUT) * 10 - GENERATE LEADER FOR PAPER TAPE * 11 - LIST OUTPUT LINE SPACING * 12 - WRITE FILE GAP --/ PRIMARILY * 13 - FORWARD SPACE FILE/ FOR MAGNETIC * 14 - BACKWARD SPACE FILE/ TAPE UNITS SKP * C. DEVICE STATUS REQUEST FORMAT * * EXT EXEC * JSB EXEC * DEF EXIT (DEFINE EXIT POINT) * DEF RCODE (DEFINE REQUEST CODE) * DEF CONWD (DEFINE CONTROL WORD) * DEF STAT1 (DEFINE STATUS WORD 1) * DEF STAT2 (DEFINE STATUS WORD 2 -- OPTIONAL) * DEF STAT3 (DEFINE STATUS WORD 3 -- OPTIONAL) * EXIT --- * . * . * RCODE DEC 13 STATUS REQUEST CODE = 13 * CONWD OCT NN LOGICAL UNIT # * STAT1 NOP WORD 5 OF EQT ENTRY FOR * DEVICE STORED IN THIS WORD. * STAT2 NOP WORD 4 OF EQT ENTRY FOR * DEVICE STORED IN THIS WORD * IF PRESENT IN REQUEST. * STAT3 NOP IF PRESENT, THEN BIT 15 INDICATES * THE LU IS UP(0) OR DOWN(1) AND BITS * 0-4 GIVE THE LU'S SUBCHANNEL. * * * IV. GENERAL OPERATION * * ALL INPUT/OUTPUT OPERATIONS ARE PERFORMED * CONCURRENTLY WITH PROGRAM COMPUTATION IN THE * OVERALL SYSTEM. AN I/O OPERATION IS CONSIDERED * TO BE NON-BUFFERED TO THE REQUESTING USER * PROGRAM AS THE PROGRAM IS SUSPENDED UNTIL * THE TRANSMISSION OR OPERATION IS COMPLETED. * THE EXCEPTION TO THIS IS IN PROVIDING FOR * AUTOMATIC BUFFERING OF OUTPUT TO USER- * DESIGNATED DEVICES. IN THIS CASE, THE USER * BUFFER IS MOVED TO SYSTEM AVAILABLE MEMORY * AND THE USER PROGRAM IS NOT SUSPENDED. * * V. CLASS I/O OPERATIONS * * CLASS I/O REFERS TO NO-WAIT I/O IN WHICH THE USER * DIRECTS THE COMPLETION INFORMATION TO A 'CLASS' BY * NUMBER. LEGAL CLASSES ARE DEFINED AT GENERATION TIME * AND QUEUES ARE KEPT FOR EACH CLASS IN A TABLE CALLED * THE CLASS TABLE. THIS TABLE IS LOCATED AT $CLAS * AND CONSISTS OF A LENGTH WORD (DEFINING THE NUMBER * OF WORDS (CLASSES) IN THE TABLE (SYSTEM)) FOLLOWED * BY ONE WORD FOR EACH DEFINED CLASS. * * IN OPERATION THE USER REQUESTS I/O ON A CLASS, * RTIOC REQUESTS BUFFER MEMORY FOR THE REQUEST * MOVES THE REQUEST TO THE BUFFER MEMORY * QUEUES THE REQUEST ON THE SPECIFIED EQT AND * NOTES IN THE CLASS QUEUE THAT A REQUEST IS * PENDING. * * ON COMPLETION THE COMPLETED REQUEST IS QUEUED IN THE CLASS * QUEUE AND ANY PROGRAM WAITING FOR THE CLASS * IS RESTARTED. * * A. READ/WRITE AND WRITE-READ REQUEST FORMAT * * EXT EXEC * JSB EXEC * DEF EXIT * DEF RCODE (DEFINE READ (17) WRITE (18) WRITE-READ (20) * DEF CONWD (SAME AS STANDARD READ/WRITE) * DEF IBUFR (SAME AS STANDARD (NOT USED ON READ) * DEF BUFFL (SAME AS STANDARD) * DEF OPT1 (SAME AS STANDARD (TRACK)) * DEF OPT2 (SAME AS STANDARD (SECTOR)) * DEF CLASS (CLASS TO QUEUE REQUEST ON ) * EXIT --- * . * . * RCODE DEC 17 OR 18 OR 20 (SEE NOTE BELOW) * CONWD OCT NNNNN CONTROL INFO/LOGICAL UNIT # * BUFFL DEC N OR -N WORD OR CHARACTER LENGTH * OPT1 DEC N (SEE GET CALL BELOW) * OPT2 DEC N (SEE GET CALL BELOW) * CLASS DEC N DEFINES CLASS TO BE USED IN GET CALL. * IBUFR BSS N DATA BUFFER * * * NOTES: * THE WRITE-READ CALL IS FOR DEVICES WHICH EXPECT DATA IN * THE READ BUFFER. THIS CAUSES THE SYSTEM TO MOVE THE BUFFER * TO SYSTEM MEMORY AND ALSO TO SAVE AND PASS TO THE USER * THE BUFFER ON THE GET CALL. THE REQUEST CODES RECEIVED * BY THE DRIVER ARE: * 1 FOR REQUEST 17 OR 20 * 2 FOR REQUEST 18 * 3 FOR REQUEST 19 * * THE CLASS WORD HAS THE FOLLOWING FORMAT * BITS 0-7 DEFINE THE CLASS. IF ZERO OR NOT SUPPLIED * THE SYSTEM WILL ASSIGN A CLASS FOR THE REQUEST. * BITS 8-12 CONTAIN THE SECURITY CODE ASSIGNED BY THE * SYSTEM UPON CLASS ALLOCATION. * BITS 13-14 ARE NOT USED BY READ/WRITE OR WRITE-READ * BUT WILL BE RETURNED TO CALLER IF A CLASS * IS ALLOCATED. * BIT 15 SHOULD BE SET TO INDICATE THAT THE PROGRAM IS TO * BE CONTINUED WITHOUT MAKING THE REQUEST IF THERE * IS NOT ENOUGH SYSTEM MEMORY AT THE CURRENT TIME. * * ON RETURN TO THE PROGRAM THE A REGISTER WILL BE SET AS * FOLLOWS (IF BIT 15 WAS SET): * * A = -1 DYNAMIC CLASS ASSIGNMENT FAILED (NO FREE CLASS NOW) * -2 NO MEMORY AVAILABLE FOR BUFFERING. * = >0 THE NEWLY ALLOCATED CLASS NUMBER AND SECURITY CODE. * * B. CLASS CONTROL REQUEST FORMAT * * EXT EXEC * JSB EXEC * DEF EXIT * DEF RCODE (DEFINES REQUEST CODE) * DEF CONWD (DEFINES CONTROL WORD) * DEF PRAMD (DEFINES PRAMETER WORD) * DEF CLASS (CLASS TO QUEUE REQUEST ON) * DEF OPT1 (OPTIONAL PARAMETER PASSED TO GET) * DEF OPT2 (OPTIONAL PARAMETER PASSED TO GET) * EXIT --- * . * . * RCODE DEC 19 CLASS CONTROL REQUEST CODE * CONWD OCT NNNN CONTROL INFO/LOGICAL UNIT # * PRAM DEC N PRAMETER AS REQUIRED BY TYPE OF CODE * CLASS DEC N DEFINES CLASS TO USED IN GET CALL. * O5PT1 DEC N (SEE GET CALL BELOW) * OPT2 DEC N (SEE GET CALL BELOW) * * THE CLASS CONTROL IS THE SAME AS THE STANDARD CONTROL EXCEPT * COMPLETION INFORMATION IS QUEUED ON THE DESIGNATED CLASS QUEUE. * * C. CLASS GET REQUEST FORMAT. * * EXT EXEC * JSB EXEC * DEF EXIT (DEFINE RETURN ADDRESS) * DEF RCODE (DEFINE REQUEST CODE ADDRESS) * DEF CLASS (DEFINE CLASS ADDRESS) * DEF IBUFR (DEFINE BUFFER ADDRESS) * DEF IBUFL (DEFINE BUFFER LENGTH) * DEF IRP1 ((RETURN PRAMETER 1 (OPTIONAL)) * DEF IRP2 ((RETURN PRAMETER 2 (OPTIONAL)) * DEF RCLAS (RETURN CLASS WORD ADDRESS)(OPTIONAL) * EXIT --- * . * . * RCODE DEC 21 REQUEST CODE FOR GET REQUEST * CLASS OCT NNN CLASS THE GET IS TO GET FROM. * IBUFR BSS N BUFFER TO HOLD THE READ DATA * IBUFL DEC N OR -N WORD OR CHARACTER LENGTH OF BUFFER * IRP1 BSS 1 OPTIONAL PRAMETER ONE RETURNED HERE * IRP2 BSS 1 OPTIONAL PRAMETER TWO RETURNED HERE * RCLAS BSS 1 CLASS RETURN WORD. * * NOTES: * THE CLASS WORD HAS THE FOLLOWING OPTIONS: * BITS 0 - 7 CLASS TO BE USED * BITS 8 -12 CLASS SECURITY CODE * BIT 13 DO NOT DEALLOCATE THE CLASS. IF THIS BIT * IS NOT SET AND THE CLASS IS EMPTY (NO * COMPLETED OR PENDING REQUESTS) IT IS * DEALLOCATED. * BIT 14 RETURN THE INFORMATION BUT DO NOT DEQUEUE * THE REQUEST (MUST MAKE ANOTHER REQUEST TO * DEQUEUE THE REQUEST). * BIT 15 IF NO ENTRIES IN QUEUE RETURN TO PROGRAM * (NORMAL ACTION IS TO SUSPEND UNTIL A * REQUEST IS PUT ON THE QUEUE). * * THE RETURNED CLASS WORD (RCLAS) IS AS FOLLOWS: * BITS 0 - 7 SET TO THE REQUEST CODE SENT TO THE DRIVER I.E. * 17 IS SET TO 1 * _18 IS SET TO 2 * 19 IS SET TO 3 * 20 IS SET TO 1 * * THE PARAMETERS IRP1/IRP2 ARE SET TO THE ORIGINAL REQUEST * PARAMETERS OPT1/OPT2. THEY ARE PROTECTED FROM DRIVER * MODIFICATION AND SO SHOULD BE AS SUPPLIED, EXCEPT IF * BIT 12 IN THE CONWORD IS SET "IRP1" POINTS TO * THE BUFFER AREA THE SYSTEM USED (I.E. IT IS NONSENSE). * * THE A REGISTER ON RETURN IS SET AS FOLLOWS: * A = -N N IS THE NUMBER OF REQUESTS PENDING ON THE CLASS * IN ONE'S COMPLEMENT [-(N+1)] = [-N-1] * (NO REQUEST HAS COMPLETED YET) * A = 10XXXX (WHERE 1 IS BIT 15, 0 IS BIT 14, * AND XXXX IS THE REST OF EQT5 WHEN THE * REQUEST EITHER WAS REJECTED BY THE DRIVER * OR WAS IMMEDIATELY COMPLETED BY THE DRIVER. * ON REJECT B = -1,ON IMMEDIATE COMPLETION * B = TLOG. * A = > 0 A IS THE STATUS (EQT5) OF THE DEVICE AT * COMPLETION OF THE REQUEST. (IF BIT 14 IS SET * THE REQUEST CAUSED THE DEVICE TO GO DOWN). * B = TLOG IN THIS CASE. * * ON COMPLETION OF AN 18 REQUEST THE DATA BUFFER IS RETURNED * TO SYSTEM MEMORY. * THE GET REQUEST WILL ALWAYS GET A BUFFER WHICH IS THE * MINIMUM OF THE ALLOTTED SIZE ON THE GET AND THE BUFFER * IN THE QUEUE. THE CONTROL BUFFER (BIT 12 OPTION) IS AT THE * END OF THE ALLOTED BUFFER AND MAY BE RETURNED ON A GET IF * THE BUFFER SUPPLIED WILL HOLD IT AND THE REQUEST WAS NOT A * CLASS WRITE (18) REQUEST. SKP * CLASS I/O QUEUE FORMAT AND ITS USE * * THE CLASS QUEUE CAN BE IN FOUR DIFFERENT STATES. * 15 14 13 12 11 10 09 08 07 06 05 04 03 02 01 00 * ------------------------------------------------------ * ! 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0! * -------------------------------------------l----------- * STATE 1: CLASS DEALLOCATED, AVAILABLE * * 15 14 13 12 11 10 09 08 07 06 05 04 03 02 01 00 * ------------------------------------------------------- * ! 0 ! A D D R E S S O F F I R S T E N T R Y ! * ------------------------------------------------------- * STATE 2: POINTER TO FIRST ENTRY IN CLASS QUEUE * * 15 14 13 12 11 10 09 08 07 06 05 04 03 02 01 00 * ------------------------------------------------------ * ! 1 0 X! SECURITY CODE ! NUMBER OF PENDING REQS. ! * ------------------------------------------------------ * STATE 3: CLASS ALLOCATED, NO ONE WAITING ON CLASS * NUMBER OF PENDING REQUESTS COUNTER MAY BE 0-255 * * 15 14 13 12 11 10 09 08 07 06 05 04 03 02 01 00 * ------------------------------------------------------ * ! 1 1 X! SECURITY CODE ! NUMBER OF PENDING REQS. ! * ------------------------------------------------------ * STATE 4: CLASS ALLOCATED, SOMEONE WAITING (SUSPENDED) * NUMBER OF PENDING REQUESTS COUNTER MAY BE 0-255 * * ACTIONS TO BE TAKEN WHEN HANDLING A CLASS I/O OR GET REQUEST * DEPEND ON THE CURRENT STATE OF THE CLASS QUEUE HEAD * GET REQUESTS: * STATE 1. ABORT THE PROGRAM IO00, NO CLASS. * STATE 2. RETURN THE DATA FROM CLASS BUFFER * STATE 3. SET THE SOMEONE WAITING BIT(BIT14), SUSPEND PROGRAM * STATE 4. ABORT THE PROGRAM IO00, ONLY ONE PROGRAM MAY BE * SUSPENDED PER CLASS. * CLASS I/O REQUESTS: * STATE 1. STATE 3 IS SET UP, SECURITY CODE IS LOW 5 BITS OF * PROGRAM ID NUMBER, COUNTER IS SET TO 1. * STATE 2. THE COUNTER AT END OF QUEUE IS INCREMENTED BY 1 * STATE 3. THE COUNTER IS INCREMENTED BY 1. * STATE 4. THE COUNTER IS INCREMENTED BY 1. * ON COMPLETION OF CLASS I/O REQUESTS: * STATE 1. ILLEGAL--SHOULD NEVER HAPPEN--BUFFER IS RETURNED * AND THE COMPLETION IS IGNORED. * STATE 2. THE NEW DATA IS ADDED AT THE END OF THE LISTW (FIFO) * AND THE COUNTER IS DECREMENTED BY 1. * STATE 3. THE NEW DATA IS ADDED AT THE END OF THE LIST (FIFO) * AND THE COUNTER IS DECREMENTED BY 1. * STATE 4. THE WAITING PROGRAM IS SCHEDULED AND THE COUNTER * IS DECREMENTED BY 1 AND THE SOMEONE WAITING BIT(BIT14) * IS CLEARED. SKP $IORQ EQU * CLA SET CONTROL FLAG=0 TO MEAN STA CONFL *REQUEST* SECTION ENTERED STA TEMPL AND 'DISC R/W USER REQ' FLAG STA CLASS CLEAR THE CLASS WORD STA TEMP5 CLEAR LU FLAG FOR LU 0 * CPA RQCNT INSURE AT LEAST ONE PRAMETER JMP ERR01 - NO, ISSUE DIAGNOSTIC. * * LOGICAL UNIT REFERENCE VALIDITY CHECK * CCA,CCE TRANSLATE BY -1 ADA RQP2,I EXTRACT LOGICAL UNIT # FROM AND B77 PARAMETER 1 STA TEMP1 SAVE LOGICAL UNIT #-1 FOR DISC TEST LDB XSUSP GET PROGRAM'S BATCH FLAG ADB .12 AND LDB B,I IF BATCH SSB,RSS FLAG JMP L.0 IS SET * LDB $LUSW CHECK FOR LU SWTCH CMB,INB NEGATE COUNT FOR LOOP. * STB TMP8 ELSE SET UP TO SCAN THE TABLE LDB D$LUT GET DEF TO TABLE L.00 INB STEP TABLE ADDRESS LDA B,I GET ENTRY AND B77 IF SAME CPA TEMP1 AS CURRENT LU JMP L.001 GO SWITCH * ISZ TMP8 STEP COUNT JMP L.00 AND LOOP * L.0 LDA TEMP1 NO SWITCH USE SUPPLIED LU L.0.1 LDB A CPB B77 IF 0 SPECIFIED JMP L.00X GO DO IMMEDIATE COMPLETION THING * CMA,CLE CHECK FOR ZERO AND ADA LUMAX FOR A VALUE GT THE LARGEST SEZ,RSS DEFINED #. JMP ERR02 - ERROR, OUTSIDE OF RANGE. ADB DRT INDEX INTO THE DRT. LDA B,I GET EQT ASSIGNMENT. STA TEMP5 SAVE FOR 'WORD2' ROUTINE. AND B77 CCE,SZA,RSS IF ZERO JMP L.00X THEN DO IDMMEADIATE COMPLETION THING * JSB $CVEQ CONVERT TO ABS.EQT ADD(WILL MASK SUBCH.). SKP * * REQUEST CODE ANALYSIS * L.000 LDA RQP1 GET REQUEST CODE (PARAMETER 1). AND .15 KEEP LOW PART STA RQPX SAVE IT CPA .13 TRANSFER IF JMP L.15 * STATUS * REQUEST. * LDA TEMP1 GET LU-1 AND DETERMINE JSB STADV IF THE LU OR EQT ARE DOWN. JMP L.014 IF DOWN, SUSPEND THE PROGRAM. * LDA RQPX UP, SO CONTINUE. LDB XPRIO,I SET THE PRIORITY STB TEMP2 FOR LINK AND STB TEMP6 FOR BUFFERING CPA .3 IF REQUEST IS JMP L.02 SKIP FURTHER ANALYSIS. * LDB RQCNT CHECK # OF ADB N3 PARAMETERS SUPPLIED SSB FOR READ OR WRITE. JMP ERR01 -ERROR, LT 3. * * BUFFER LEGALITY CHECK FOR INPUT. * BFCK LDB RQP4,I GET THE LENGTH CLE,SSB,RSS CONVERT TO JMP BFCK1 WORDS IF BRS CHARACTERS CMB,INB SET POSITIVE BFCK1 STB TMP8 AND SAVE. SZA DO BUFFER CHECK IF GET CPA RQP1 IF CLASS REQUEST CPA .2 OR IF WRITE REQUEST, JMP L.01 SKIP BUFFER CHECK. SPC 1 ADB RQP3 CHECK IF AREA EXTENDS ABOVE THE CMB,SEZ,CLE,INB,RSS LAST WORD ADB BKLWA OF MEMORY INB CLB,SEZ,RSS IF SO THEN JMP ERR04 ERROR 4 DIAGNOSTIC * CLE,SZA,RSS IF GET REQUEST JMP G.01 GO FINISH GET OPERATION * L.01 LDB RQCNT GET REQUEST COUNT ADB N5 AND SET 'E' FOR FIVE PRAM TEST LDA EQT5,I CHECK REFERENCED DEVICE AND B36K FOR BEING A CPA B14K DISC FILE (DVR30,31,32,33) RSS JMP L.02 NO, UNIT IS NOT DISC. STA TEMPL SET 'DISC R/W USER REQ' FLAG SKP * * DISC ACCESS VALIDITY CHECK. * LDA RQP1 CLASS REQUESTS ALF,ALk F TO THE DISC ALF,SLA ARE NOT JMP ERR02 ALLOWED. * SSB DISC REQUEST MUST HAVE 5 PRAMS. JMP ERR01 -ERROR-. * LDB TEMP1 GET (LU-1) CPB .1 IF LU # 2 OR 3, RSS SET INTO LOW CPB .2 BITS OF 'DISC INB,RSS R/W USER REQ' JMP DPOPT,I FLAG. IF USER DISC JUMP ON PROTECT OP. * L.10 IF NOT PROTECTED ELSE L.012 ADB TEMPL STB TEMPL * LDA RQP5,I GET TRACK ADDRESS FROM AND B377 STA TEMP0 REQUEST - SAVE. LDA TATLG COMPUTE POSITIVE ADA TATSD LENGTH OF CMA,INA AUXILIARY DISC IN *TAT*. SLB,RSS IF REF TO SYSTEM DISC (LU #2), LDA TATSD USE SYS DISC SIZE. CMA,INA SUBTRACT MAX SIZE ADA TEMP0 FROM USER TRACK #. SSA,RSS JMP ERR05 -ERROR, ILLEGAL TRACK #. * LDA SECT2 (A)= # SECTORS/TRACK FOR LU #2 SLB IF LU FOR REQUEST = 3, LDA SECT3 SET (A) = # SECTORS FOR LU #3 CMA,CLE,INA SET VALUE NEG. LDB RQP6,I GET SECTOR ADDRESS ADB A ERROR CCB,SEZ IF STARTING SECTOR LESS THAN 0 JMP ERR05 OR GREATER THAN TRACK SIZE. * ADB TMP8 CHECK FOR TRACK OVERFLOW BRS,BRS DIVIDE BUFFER LENGTH BRS,BRS (IN WORDS) BRS,CLE,BRS BY 64(10) ADB RQP6,I ADD STARTING SECTOR # STB TMP8 SAVE FOR L.G. UPDATE ADB A ERROR IF LAST SECTOR CLA,SEZ,INA GT= JMP ERR08 LIMIT (EXCEEDS TRACK BOUNDARY) * CPA RQP1 INPUT IS ALLOWED TO REFERENCE ANY JMP L.10 TRACK. * LDA TEMP0 (A) = TRACK #. LDB TEMP1 (LU-1) TO (B). SLB,RSS IF REF TO LU #3 ADD ADA TATSD SYS DISC SIZE TO TRACK #. ADA TAT INDEX TO TRACK ASSIGNMENT TABLE. LDA A,I GET REFERENCED TRACK ASSIGNMENT. CPA XEQT (ID SEGMENT ADDRESS). IF SAME AS JMP L.10 REQUESTOR, ALLOW ACCESS. * CPA C100K ALLOW ACCESS IF TRACK IS JMP L.10 GLOBALLY ASSIGNED. * INA IF FMP TRACK THEN CPA C100K GO CHECK JMP L.012 FOR LEGAL CALL. * * CHECK FOR LOAD-AND-GO ACCESS * ERB,ERB CONSTRUCT LDB TEMP0 L.G. WORD BLF,BLF FOR CURRENT RQ. ERB SET SIGN IF LU 3. ADB RQP6,I SET SECTOR IN LOW BITS CPB LGOC IF NOT = TO CURRENT LGO CLA,RSS ADDRESS, THEN JMP L.011 GO TO CHECK FOR "LOADR". * * UPDATE FOR NEXT LGO ACCESS - THIS ACCESS ALLOWED * ISZ TMP8 SAVE THE NEXT SECTOR ADDRESS IN TMP8 CPA LGOTK IS LGO AREA IS ASSIGNED. JMP L.011 -NO, CHECK LOADR. * LDA SECT2 SET (A) TO APPROPRIATE RBL,SLB,ERB # SECTORS (SET E IF LU 3) LDA SECT3 PER TRACK FOR LU #. CPA TMP8 IF NEW SECTOR EXCEEDS TRACK, CLA,RSS GO TO UPDATE TRACK #. JMP L.010 -NO OVERFLOW. * STA TMP8 SET SECTOR # TO 0. ISZ TEMP0 ADD 1 TO TRACK #. LDA LGOTK GET LGO TRACK ASSIGNMENT WORD. AND B177 -ADD # STA B OF TRACKS XOR LGOTK ASSIGNED CLE,ELA LU BIT TO E. ALF,ALF TO STARTING ADA B CHECK CPA TEMP0 FOR OVERFLOW. JMP ERR09 ---YES, '09' ERROR AND ABORT. * L.010 LDA TEMP0 RECONSTRUCT TRACK ALF,ALF THE CURRENT ERA LGO AREA IOR TMP8 DISC STA LGOC RESET. JMP L.10 SPC 1 L.014 LDB .4 4 TO B L.013 STB XTEMP,I SET 4 IN FIRST WORD OF TEMP AREA. L.015 JSB $LIST PUT PGM IN WAIT LIST OCT 503 UNTIL DEVICE COMES UP. JMP $XEQ EXIT TO DISPATCHER * ICOMX NOP DUMMY EQT FOR LU=0 B36K OCT 36000 .12 DEC 12 B14K OCT 14000 EQT4 OF DUMMY(BITS 0-5 = 0). .13 DEC 13 TEMP1 NOP EQT6 OF DUMMY N3 DEC -3 N5 DEC -5 C100K OCT 77777 $DMEQ DEF ICOMX ADDRESS OF DUMMY EQT DPOPT DEF L.10 DISC PROTECT OPTION (L.012 IF PROTECTED) SPC 2 L.00X LDA $DMEQ SET UP DUMMY EQT FOR LU=0 JSB $ETEQ ON BASE PAGE JMP L.000 CONTINUE PROCESSING SPC 2 L.001 LDA B,I SWITCH THE LU ALF,ALF USE HIGH HALF OF TABLE AND B77 MASK STA TEMP1 SET THE NEW (LU-1) JMP L.0.1 GO CONTINUE THE REQUEST SKP * ALLOW PRIVILEGED ACCESS TO "LOADR" TO PERMIT * UPDATING OF ID SEGMENTS AND PROGRAMS ON THE * SYSTEM AREA OF THE DISC. * L.011 LDB XEQT COMPARE ADB .12 NAME LDA B,I 3 CPA LDRNM WORD INB,RSS AREA JMP ERR06 IN * LDA B,I CURRENT CPA LDRNM+1 ID INB,RSS SEGMENT JMP ERR06 WITH * LDA B,I 'LOADR' AND C377 -IF CPA LDRNM+2 SO, JMP L.10 ALLOW FULL ACCESS * JMP ERR06 - ERROR - * LDRNM ASC 2,LOAD L O A D OCT 51000 R -ZERO- SPC 1 B177 OCT 177 B74K OCT 74000 B160K OCT 160000 KEEP BITS 13-15 SPC 2 L.012 LDA RQP2,I FMP TRACK LDB RQP1 AND B74K IF FLAG SET SLB,RSS OR IF READ CPA B74K THEN ALLOW JMP L.10 ACCESS. * JMP ERR06 ELSE ILLEGAL DISC WRITE. SKP L.02 CLA,SEZ,RSS IF BIT 12 OF CONWORD LDA RQP2,I SET AND ALF,SLA NOT FIVE PRAMS JMP ERR01 TAKE GAS! * LDA TEMP5 CHECK FOR LU LOCK RRR 6 GET LOCK BITS TO LOW A AND B37 ISOLATE THEM SZA,RSS IF NOT LOCKED JMP L.020 FOR GET CHECK * STA TEMP3 SAVE RN NUMBER FOR PASS TEST LDB C100K SET 77777 FOR LINK PRIORITY 2STB TEMP2 AND CLB,INB ONE FOR STB TEMP6 BUFFERING PRIORITY. ADA D$RN ELSE INDEX INTO STA XTEMP,I THE RN TABLE LDA A,I GET THE ENTRY AND B377 CHECK IF STA TEMPW SAVE OWNING PROGRAM NUMBER ADA KEYWD CURRENT PROGRAM ADA N1 IS THE LDA A,I ONE THAT OWNS THE LOCK CPA XEQT ? JMP L.020 YES CONTINUE THE REQUEST * CLA GET POSSIBLY PASSED RN NUMBER WHICH LDA RQP9,I WOULD BE IN RQP9. USE ZERO IF NONE XOR TEMP3 PASSED. CONSTRUCT AND ALF,ALF COMPARE WITH THE LOCKER'S XOR TEMPW RN NUMBER. SZA IF EQUAL, SKIP. JMP L.015 ELSE, GO SUSPEND CALLER 'TIL AVAILABLE. * L.020 LDB RQPX GET THE MASKED REQUEST CPB RQP1 IF STANDARD I/O JMP L.027 SKIP THE CLASS CODE SKP * * * CLASS I/O ALLOCATE CLASS FROM HIGH END OF TABLE * IF HE DID NOT SPECIFY A CLASS. * CLA,CLE E=0 IF USE OLD CLASS NUMBER STA XA,I A=0 FOR INIT.GOOD RETURN LDA RQP7 ADDR FROM THE REQUEST CPB .3 IF CONTROL REQUEST (19) LDA RQP4 USE THE CONTROL CLASS WORD SZA,RSS IF CLASS WORD ADDR = 0 JMP ERR01 FLUSH IT OUT. * STA TEMP3 SAVE ADDR OF CLASS WORD LDA B160K GET BITS 15,14, AND 13 FROM AND TEMP3,I USER'S CLASS WORD STA SECCD L.025 LDA TEMP3,I GET CLASS WORD STA CLASS SET THE CLASS WORD AND B377 MASK TO THE CLASS DEF. STA B SAVE CLASS NUMBER IN B CMA,INA,SZA IF SUPPLIED JMP L.021 SKIP ALLOCATION CODE * * * ALLOCATE A CLASS FROM THE HIGH END OF THE TABLE * LDB XEQT GET ID SEG ADDR JSB $IDNO CONVERT TO ID # LDA B37 FOR USE AS SECURITY CODE AND B ALF,ALF IOR SECCD FILL IN USER'SNLH BIT15,14,13 STA TEMP3,I FOR RETURN AS CLASS NUMBER * LDA $CLAS GET THE LENGTH OF THE TABLE ADA DCLAS ADD THE TABLE ADDRESS * L.022 LDB A,I GET THE ENTRY TO B CCE,SZB,RSS IF FREE (0) JMP L.023 GO USE IT * ADA N1 NO STEP TO NEXT ONE CPA DCLAS END OF TABLE? CCA,RSS YES SKIP (A = -1) JMP L.022 NO - GO TEST NEXT ONE. * L.026 STA XA,I SET REASON FOR REJECT IN A REG. LDB DCLAS SET B=CLASS TABLE ADDR LDA CLASS FOR L.013 IN CASE OF SUSPEND SSA NO-WAIT REQUESTED? JMP L.16 NO, GIVE NO CLASS STATUS * JMP L.013 YES, SUSPEND UNTIL CLASS AVAILABLE * L.023 LDB A SET B TO ADR OF CLASS QUEUE WORD ADA MCLAS SUBTRACT THE CLASS TABLE ADDRESS JkN IOR TEMP3,I ADD SECURITY CODE AND USER BIT STA TEMP3,I RETURN NEW CLASS WORD TO USER AND B174C GET SECURITY CODE FOR CLASS QUEUE-HEAD RAL,ERA SET THE ALLOCATED BIT STA B,I PUT INTO CLASS QUEUE CCE SET E=1 AGAIN FOR NEW ALLOC JMP L.025 GO SET UP * L.021 ADB DCLAS USE CLASS# (IN B) TO INDEX AND STB PTR SET POINTER TO TABLE STA B LDA CLASS GET CLASS WORD AND B174C SAVE REAL SECURITY CODE STA SECCD LDA PTR,I GET CONTENTS SEZ,CLE,RSS IF NOT NEW ALLOCATION SZA AND NOT ALLOCATED, FORCE ERROR ADB $CLAS IF OUTSIDE OF TABLE CLB,SEZ,RSS THEN JMP ERR00 SEND ERROR 'IO00' * LDA PTR L.13A STA B SET B TO ADDR OF QUEUE ENTRY XLA B,I GET CONTENTS SSA,RSS A POINTER? JMP L.13A YES, TRACE IT MORE * AND B174C GET SECURITY CODE FROM QUEUE CPA SECCD COMPARE IT WITH USER'S RSS DOES IT MATCH? JMP ERR00 NO, ERROR 'IO00' * STB SECCD SAVE QUEUE ENTRY ADDR IN SECCD LDB RQPX GET THE MASKED REQUEST CODE JMP L.028 AND GO DO THE BUFFER THING SKP * * CHECK FOR AUTOMATIC BUFFERING REQUIREMENT * L.027 CPB .1 SKIP CHECK IF REQUEST JMP L.10 IS INPUT. * LDA EQT4,I CHECK THE UNIT DESCRIPTOR RAL WORD IN ITS EQT ENTRY,BIT 14, SSA,RSS FOR BUFFERING. JMP L.10 -NO * LDA RQP2,I DYNAMIC STATUS AND B3700 REQUESTS ADA B ARE NEVER CPA B603 BUFFERED JMP L.10 DYNAMIC STATUS DO STD. USER RQ. * * * AUTOMATIC BUFFERING SECTION * L.028 CLA CLEAR 2ND BUFFER STA TMP6 SIZE INITIALLY. CPB RQP1 IF NOT CLASS REQUEST, THEN USE LDA N2 5 WORDS FOR CONTROL REQUEST. CPB .3 IF REQUEST IS FOR -CONTROL-, JMP L.03 SKIP BUFFER SIZE CHECK. * LDA TMP8 GET THE XFER LENGTH. STA TEMP3 -SET AS MOVE INDEX-. LDB RQP2,I IF DOUBLE BUFFER REQUEST, BLF,SLB RSS JMP L.03 NO, SKIP SECOND BUFFER SIZE. * CLA CLEAR REG-A FOR CASE RQP6=0. LDB RQP6,I YES, GET SECOND BUFFER SIZE. SSB,RSS NEGATIVE CHAR COUNT? JMP L.029 NO, SET WORD COUNT. * BRS YES, CONVERT TO + WORDS. CMB,INB L.029 LDA B GET SECOND BUFFER SIZE ADA TMP8 ADD TO FIRST BUFFER SIZE. STB TMP6 SAVE SECOND BUFFER SIZE. * L.03 ADA .8 ADD 8 FOR BLOCK CONTROL WORDS. LDB RQPX CPB RQP1 IF NOT CLASS REQUEST ADA N1 THEN SUBTRACT 1 STA L.04 AND SET UP IN CALL * LDA N41 IF PRIORITY ADA XPRIO,I LT 41 THEN SSA DO NOT DO BUFFER LIMIT JMP L.031 TEST * LDB $BLUP CHECK IF BEYOND THE LIMIT IN WORDS JSB QCHK ON THIS DEVICE JMP L.040 YES GO CHECK FOR CLASS RQ * * ALLOCATE BLOCK IN TEMPORARY STORAGE * L.031 JSB $ALC CALL AT SYSTEM ENTRY POINT L.04 NOP - REQUESTED LENGTH OF BLOCK - JMP L.041 NEVER ANY MEMORY, TRY NO BUFFER. JMP L.042 NO MEMORY NOW, SUSPEND. JMP L.06 ALLOCATION OK. * L.040 LDA CLASS IF CLASS AND NO SUSP. SSA,RSS ON BUFFER LIMIT SKIP TO EXIT JMP L.013 ELSE GO SUSPEND * * NO MEMORY AVAILABLE FOR BLOCK - CALLING USER * PROGRAM IS TO BE LINKED INTO MEMORY SUSPENSION * $LIST AND RE-SCHEDULED AT POINT OF REQUEST * WHEN A PREVIOUSLY ALLOCATED BLOCK IS RELEASED. * L.042 LDA N2 IF CLASS I/O CHECK LDB CLASS FOR NO SUSP OPTION SSB IF SET JMP L.026 GO SET FLAG AND EXIT * JSB $LIST CALL TO LINK PROGRAM INTO OCT 504 MEMORY SUSPENSION LIST. JMc;P $XEQ * L.041 LDA CLASS NEVER ENOUGH MEMORY SZA IF CLASS REQUEST JMP ERR04 ABORT PROGRAM IO04 * JMP L.10 ELSE GO UNBUFFERED. * SECCD NOP B603 OCT 603 N41 DEC -41 SKP * * * SET REQUEST PARAMETERS, PROGRAM PRIORITY AND * USER BUFFER INTO TEMPORARY BLOCK. * L.06 STB L.04 SET ACTUAL BLOCK LENGTH. STA TEMP1 SAVE BLOCK CLE,INA STA TEMPW SAVE ADDRESS JSB WORD2 ASSEMBLE CONTROL WORD LDB RQP1 IF A CLASS CPB RQPX REQUEST CLE THEN RAL,ERA SET THE FIELD TO 3 IOR B40K SET = 1 FOR BUFFERING. LDB TEMPW XSA B,I AND SET IN WORD 2 OF BLOCK. INB LDA TEMP6 SET REQUESTING PROGRAM PRIORITY XSA B,I IN WORD 3. INB LDA L.04 SET BLOCK LENGTH IN XSA B,I WORD 4. INB XLA TEMPW,I GET THE CONWORD SSA,RSS IF STANDARD REQUEST JMP L.061 SKIP * LDA CLASS ELSE SET THE CLASS XSA B,I WORD IN INB THE BUFFER L.061 LDA .3 IF REQUEST CPA RQP1 IS -STANDARD CONTROL-, SKIP JMP L.08 BUFFER MOVE * LDA RQP4,I SET USER BUFFER LENGTH XSA B,I IN WORD 5. CMA,CLE,INA,SZA SET E IF ZERO LENGTH BUFFER (SAVE A CYCLE IF SO) CLA USE ZERO IF NO OPTION WORD SUPPLIED LDA RQP5,I GET FIRST OPTIONAL WORD INB STEP TO STORE LOCATION STB TEMPW SAVE THE ADDRESS OF THE LOCATION XSA B,I SET IT INB SET FOR NEXT WORD CLA USE ZERO IF SECOND OPTION WORD NOT SUPPLIED LDA RQP6,I GET SECOND OPTIONAL WORD XSA B,I SET IT IN THE BUFFER LDA RQP1 CPA B23 IF CLASS CONTROL, GO JMP L.078 FINISH ITS SET-UP. CPA B21 IF CLASS READ ADB TMP8 ADJUST BUFFER ADDRESS )4FOR DOUBLE BUF. SEZ,CLE,INB,RSS IF LENGTH = 0, CPA B21 OR CLASS READ JMP L.075 SKIP BUFFER MOVE. * * MOVE USER BUFFER TO TEMPORARY BLOCK. * LDA RQP3 SET USER BUFFER L.065 EQU * ADDRESS FOR MOVE. LDX TEMP3 GET # WORDS TO MOVE MWI MOVE INTO SYSTEM MAP * L.075 LDA TMP6 GET LENGTH OF SECOND BUFFER STA TEMP3 SET FOR MOVE LDA RQP2,I GET THE REQUEST CONTROL WORD ALF,SLA IF FIRST TIME AND DOUBLE BUFFER SEZ,CCE SKIP JMP L.13 ELSE CONTINUE * XSB TEMPW,I SET BUFFER ADDRESS IN REQUEST LDA RQP5 GET USER BUFFER ADDRESS JMP L.065 GO MOVE THE BUFFER * L.078 ADB N2 CORRECT B-REG. L.08 CLA USE ZERO IF NO PRAM WORD LDA RQP3,I FOR CONTROL REQUEST, SET WORD 3 XSA B,I (PARAM) IN PLACE OF RECORD JMP L.13 LENGTH. * B21 OCT 21 B23 OCT 23 D$RN DEF $RNTB ADDRESS OF RN TABLE SKP SPC 2 * * REQUEST IS A NORMAL WRITE, CONTROL OR READ. * THE PARAMETERS OF THE REQUEST ARE MOVED * INTO THE ID SEGMENT OF THE REQUESTING * PROGRAM. THE ID SEGMENT IS THEN LINKED * INTO THE I/O LIST FOR THE REFERENCED DEVICE. * THE -SCHEDULER- IS THEN CALLED TO REMOVE * THE PROGRAM FROM THE SCHEDULED LIST AND TO * CHANGE THE PROGRAM STATUS TO I/O SUSPENSION. * * L.10 CLA,CLE PRESET TO USE ZERO FOR OPTION WORD LDB RQP3,I SET CONTROL WORD LDA RQP1 (A) = REQUEST CODE. CPA .3 IF CONTROL GO JMP L.101 SET IT UP * LDB XTEMP+4 GET THE ADDRESS OF THE RENT ADB .15 BIT IN THE ID-SEG. LDA B,I GET THE WORD TO A ALF,RAL PUT THE BIT IN SIGN OF A LDB RQP3 BUFFER ADDRESS TO B CLE,SSA IF BIT SET JSB $REIO GO MOVE THE TDB (IF NEEDED) * CLA,CCE CPA $MVBF WAS TDB MOVED RSS NO RBL,ERB ' YES,SET SIGN IN ID SEG BUFFER TMP STA $MVBF CLEAR TDB MOVED FLAG STB XTEMP+1,I SET BUFFER ADDRESS OR CONTROL WORD LDA RQP4,I BUFFER STA XTEMP+2,I LENGTH AND LDA RQP2,I GET THE CON WORD CMA,CME SET COMPLEMENT IOR TEMPL MIRGE WITH DISC FLAG LDB RQP5 GET SECOND BUFFER ADDRESS ALF,SLA IF NONE SZB,RSS IF NONE USE RSS ZERO LDB B,I GET THE OPTION WORD SEZ,SLA,RSS IF RENT AND DOUBLE BUFFER JSB $REIO GO CHECK OUT THE BUFFER ADDRESS STB XTEMP+3,I SET THE PRAMETER IN THE ID-SEGMENT * CLA USE ZERO IF FINAL OPTION WORD NOT SUPPLIED LDA RQP6,I SET THE FINAL OPTIONAL WORD STA XTEMP+4,I IN THE ID-SEGMENT * CLE,RSS SKIP CONTROL SET UP L.101 STB XTEMP+1,I SET CONTROL WORD JSB WORD2 ASSEMBLE CONTROL WORD STA XTEMP,I SAVE IN TEMPORARY #1 LDB XEQT SET ADDRESS OF LINK WORD STB TEMP1 IN TEMP1. * JSB $LIST CALL SCHEDULER TO SUSPEND PROG. OCT 402 - ID SEG. ADDR./I/O SUSPEND - * * CALL -LINK- TO PERFORM THE LINKING OF THE NEW * BLOCK INTO THE DEVICE QUEUE OF * WAITING OPERATIONS. * L.13 LDA RQP1 IF STANDARD I/O CPA RQPX THEN JMP L.131 GO UP DATE AND EXIT * * CLASS I/O SO SET THE CLASS QUEUE TO SHOW * ANOTHER REQUEST IS PENDING. * XLA SECCD,I INA INCREMENT CLASS QUEUE COUNT BY 1 XSA SECCD,I JMP L.132 SKIP XSUSP SET UP * * L.131 LDB XSUSP,I SET THE SUSP POINT STB XA,I IN XA FOR THE ABORT ROUTINE L.132 LDA RQRTN AND SET THE RETURN ADDRESS STA XSUSP,I IN THE ID-SEG. JSB LINK LINK SETS E=0 IF EMPTY QUEUE LDB EQT1 IF DUMMY EQT FOR LU=0 CPB $DMEQ THEN JMP L.135 GO TO COMPLETE * * SEZ,RSS IF QUEUE WAS EMPTY CALL DRIVR. * * EMPTY LIST, CALL TO INITIATE CURRENT REQUEST. * JSB DRIVR JMP $XEQ - OPERATION INITIATED - JMP NOTRD - OPERATION REJECTED OR COMPLETED - * L.135 LDB RQP4,I GET THE REQUEST LENGTH L.136 SSB AND SET UP CMB,INB THE TLOG LDA .2 SET A FOR IMMEDIATE COMPLETION SJP R00 AND GO TO COMPLETION SECTION * SKP * STATUS REQUEST SECTION * L.15 LDA RQCNT INSURE THAT AT LEAST 2 ADA N2 PARAMETERS PROVIDED - ONE SSA TO STORE STATUS WORD. JMP ERR01 -NO, ERROR '01'. * LDB EQT5,I STORE WORD 5 OF EQT ENTRY STB RQP3,I IN 'STAT1'. LDA EQT4,I STORE WORD 4 OF EQT ENTRY STA RQP4,I IN 'STAT2'. * LDB TEMP1 GET SUBCHANNEL ADB DRT FROM DRT LDA B,I WORD 1. AND B174K ALF,RAL PUT SUBCHANNEL IN ADB LUMAX LOWER 5 BITS. LDB B,I GET UP/DOWN BIT FROM CLE,ELB DRT WORD 2 AND OR RAL,ERA WITH SUBCHANNEL. STA RQP5,I STORE IN 'STAT3'. L.16 LDA RQRTN UPDATE THE STA XSUSP,I RETURN ADDRESS JMP $XEQ AND EXIT SPC 3 RQPX NOP CLASS NOP DCLAS DEF $CLAS CONFIGURED TO BE DIRECT. MCLAS NOP CONFIGURED TO BE NEGATIVE OF ABOVE. B174C OCT 17400 BITS 8-12 B37 OCT 37 N2 DEC -2 SKP * $GTIO IS THE ENTRY POINT THE EXEC CALLS FOR A 'GET' EXEC * CALL. * $GTIO LDA RQP2,I GET THE CLASS AND B377 MASK STA B SAVE AND CMA,CLE,INA,SZA,RSS IF CLASS=0 CLE,RSS SEND "IO00" * ADA $CLAS IF GREATER THAN MAX THEN CLA,SEZ,RSS SEND JMP ERR00 'IO00' ERROR * ADB DCLAS SET THE STB CLASS CLASS TABLE ADDRESS JMP BFCK GO CHECK THE BUFFER ADDRESS. * * BFCK RETURNS TO G.01 * G.01 LDA RQP2,I GET SECURITY CODE ܒ AND B174C BITS FROM CLASS WORD STA SECCD LDB CLASS,I GET QUEUE HEAD SSB IF A COUNTER JMP G.06 GO SUSPEND THE PROGRAM * SZB,RSS IF QUEUE-HEAD = 0 JMP ERR00 ERROR "IO00" * STB PTR SAVE THE ADDRESS INB GET THE CON WORD XLA B,I AND AND .3 ISOLATE THE REQUEST CODE STA RQP7,I RETURN IT TO USER'S IRCLS INB STEP TO STATUS WORD XLA B,I GET COMPLETION STATUS. STA XA,I AND SET IT IN THE A REG. INB GET THE BUFFER LENGTH XLA B,I AND SET IT STA CLTMP FOR RETURN INB STEP TO USER CLASS WORD XLA B,I GET IT AND B174C KEEP SECURITY CODE CPA SECCD MATCHES CALLER'S? RSS JMP ERR00 NO, ERROR IO00 * INB INDEX TO THE XLA B,I TLOG AND STA XB,I SET IT IN THE 'B' REG INB INDEX TO THE XLA B,I FIRST OPTIONAL WORD AND STA RQP5,I SET IT IN THE USERS BUFFER INB NOW DO THE SECOND OPTIONAL WORD XLA B,I STA RQP6,I * STB TEMP4 SAVE THE BUFFER ADDRESS LDA .8 GET THE BUFFER LENGTH CMA,INA SET NEGATIVE ADA CLTMP LOP OFF THE HEAD WORDS STA TEMP3 SET THE MOVE COUNT LDB TMP8 GET THE SUPPLIED LENGTH CMA,INA SET MOVE COUNT NEG ADA TMP8 USE LESSOR OF THE TWO SSA,RSS COUNTS LDB TEMP3 USE QUEUE COUNT IF SMALLER SSB IF COUNT LESS THAN ZERO THEN JMP G.05 THEN SKIP MOVE * LDA TEMP4 GET THE BUFFER ADDRESS. INA STEP TO THE PROPER WORD CBX GET MOVE COUNT LDB RQP3 GET DESTINATION MWF MOVE FROM SYSTM TO USER G.05 LDA RQP2,I IF SAVE RAL,RAL QUEUE OPTION SLA,ELA THEN JMP L.16 THEN EXIT * XLA PTR,I ELSE STA CLASS,I UPDATE THE LIST SSA IF POINTER, SKIP COUNT CHECK AND B37 GET # PENDING REQUESTS LEFT SEZ,SZA,RSS NO REQUESTS LEFT STA CLASS,I AND IF DEALLOCATE WANTED, DO IT. JSB $RTN RETURN THE MEMORY PTR NOP AND CLTMP NOP THEN JMP G.08 SCHEDULE WAITERS AND EXIT * G.06 LDA B174C GET SECURITY CODE AND B FROM QUEUE CPA SECCD MATCH? RSS JMP ERR00 NO, ERROR IO00 * RBL,CLE,ELB MOVE BIT14 (SOMEONE WAITING) TO E G.065 LDA CLASS,I GET CLASS WORD AND B377 CMA,SEZ ANYONE WAITING? (SET ONES COMP) JMP SCEDT YES,SORRY SOMEBODY BEAT YOU TO IT * STA XA,I SET A FOR POSSIBLE RETURN INA GET CORRECT 2'S COMPLEMENT STA B LDA RQP2,I GET THE OPTION FLAG ELA,RAL SET E=BIT15 NO-WAIT OPT. SZB,RSS IF QUEUE-HEAD = 0 SSA AND BIT14 SET, JMP G.07 DON'T DEQUEUE * STB CLASS,I IF Q-H=0 AND BIT14=0 DEQUEUE! G.08 LDA DCLAS NOW SCHEDULE ALL THOSE WAITING JSB $SCD3 FOR AN AVAILABLE CLASS NUMBER. JMP L.16 RETURN * G.07 SEZ,CCE JMP L.16 BIT15=1 FOR NO-WAIT. RETURN. * LDB CLASS GET CLASS ADDR IN B FOR L.013 LDA B,I SET "SOMEONE IS WAITING" FLAG RAL,RAL ERA,RAR STA B,I AND JMP L.013 PUT IT BACK INTO WAIT LIST SPC 1 C377 OCT 177400 COMPLEMENT OF 377 SKP **************************************************************** * *WORD2 ASSEMBLE CONTROL WORD * * CONTROL WORD IS BUILT AS FOLLOWS: * ******************************************************** * T * S * X * U * S FUN * SUB CHAN * REQUEST CODE * * 15/14*13 *12 *11 * 10----6* 5------2 * 1/0 * ************************************ ******************** * * WHERE: * T= 0 FOR STD USER REQUEST CODE = 1 FOR READ (CLASS OR NORMAL) * = 1 FOR BUFFERED RQ. = 2 FOR WRITE " * = 2 FOR SYSTEM = 3 FOR CONTROL " * = 3 FOR CLASS RQ. * * 'SUB CHAN' IS THE LOW 4 BITS AND 'S' IS THE 5'TH BIT OF THE * SUB CHANNEL. * 'X' IS THE DOUBLE BUFFER BIT * 'U' IS CURRENTLY UNUSED * 'S FUN' IS THE USER SUB FUNCTION * IF THE DEVICE IS A DISC THEN THE 'X' BIT IS CLEARED AND BITS * 8,9 IN 'S FUN' ARE SET TO THE LU IF 2 OR 3 ,ELSE THEY ARE * ZEROED. * THIS ROUTINE DOES NOT BUILD THE 'T' FIELD. *** CALL WITH E=0 *** * ***************************************************************** WORD2 NOP LDB RQPX IF CLASS WRITE-READ CPB .4 THEN CHANGE CLB,CLE,INB CHANGE TO READ REQUEST LDA RQP2,I COMBINE REQUEST CODE WITH AND B137C CONTROL INFORMATION ADB A TEMPORARILY STORE IT- LDA TEMP5 GET DRT ENTRY FOR THIS LU AND B174K GET SUBCHANNEL ELA,RAL SAVE HIGH BIT AND ALF,RAL POSITON REST ADA B ADD IT TO THE WORD SEZ IF HIGH BIT SET ADA B20K SET IT IN THE WORD LDB TEMPL IF NOT DISC CCE,SZB,RSS REQUEST, JMP WORD2,I EXIT - * AND C114C OTHERWISE, SWP SET BITS (9,8) AND .3 TO INDICATE ALF,ALF SYSTEM, AUXILIARY, IOR B OR PERIPHERAL TYPE JMP WORD2,I EXIT - * B137C OCT 13700 B3700 OCT 3700 C114C OCT 166377 * * SCEDT ERB,RBR CLEAR THE BIT AND STB CLASS,I RESET THE CLASS HEAD LDB $LIST SAVE STATUS OF STB STADV $LIST ENTRY POINT. LDA CLASS GET HEAD ADDRESS TO A AND JSB $SCD3 RESCHEDULE THE WAITER IF ANY CLE E=0 FOR G.065. IF $LIST ENTRY POINT LDA $LIST  IS UNCHANGED, THEN THERE WAS CPA STADV NO WAITER. JMP G.065 NO, SO MUST HAVE BEEN ABORTED. CONTINUE. JMP ERR10 YES. ERROR, SO GO ABORT. * * **************************************************************** * * SUBROUTINE STADV: * * STADV WILL RETURN AT THE UP EXIT IF LU=0. IT NEXT * CHECKS TO DETERMINE IF THE CURRENT EQT IS DOWN(BIT * 14 EQT WORD 5)OR IF THE LU IS DOWN(BIT 15 DRT WORD 2). IF * DOWN, RETURN IS MADE AT P+1. IF UP, RETURN IS MADE AT P+2. * * CALLING SEQUENCE: * :=ADDRESS OF STATUS WORD FOR THIS EQT. * :=LU#-1. * JSB STADV * * RETURN: * (P+1) EQT OR LU DOWN. * (P+2) EQT AND LU UP. * ALL REGISTERS ARE VIOLATED. * ****************************************************************** * STADV NOP CPA B77 IF LU=0(IE, 77B), THEN JMP STAD9 GOTO UP EXIT. * ADA DRT GET DRT WORD ADA LUMAX 2 AND CHECK LDA A,I IF THE LU IS SSA UP OR DOWN. JMP STADV,I LU IS DOWN. * LDB EQT5,I LU IS UP, SO RBL,SLB CHECK IF THE JMP STAD9 EQT IS UP OR SSB DOWN. JMP STADV,I EQT IS DOWN. * STAD9 ISZ STADV LU AND EQT JMP STADV,I ARE UP. SKP * THE QUEUE CHECK ROUTINE CHECKS TO SEE IF THE QUEUE ON * THE CURRENT EQT HAS MORE THEN THE 'LIMIT' NUMBER OF WORDS * OF BUFFER MEMORY ON IT AT THE CURRENT TIME. * THE LIMIT IS PASSED IN THE B REG. SO THE ROUTINE CAN * CAN BE USED FOR BOTH UPPER AND LOWER LIMIT CHECKS. * * CALLING SEQUENCE: * * LDB NEGATIVE OF LIMIT * JSB QCHK * --- MORE THAN LIMIT WORDS ON QUEUE * --- LESS THAN LIMIT WORDS ON QUEUE * EQT1 ADDRESS IS IN B ON EXIT * QCHK NOP RSA RAL,RAL SJP *+2 STA QCKST STB TEMP1 SET LIMIT LDA EQT1,I START ATY0 EQT HEAD RAL,CLE,ERA CLEAR POSSIBLE SIGN AND E CLE,SZB SET E FOR NOT EXCEEDED QCHK1 SZA,RSS END OF QUEUE? JMP QCHK3 YES GO EXIT * STA TEMPW SET CURRENT ELEMEMT INA GET THE CON WORD LDB A,I TO B RBL CHECK IF A BUFFERED SSB,RSS REQUEST? JMP QCHK2 NO TRY NEXT ONE * ADA .2 YES STEP TO THE COUNT LDB A,I GET COUNT TO B ADB TEMP1 ADD TO LIMIT STB TEMP1 AND RESET QCHK2 LDA TEMPW,I GET NEXT ELEMENT JMP QCHK1 GO CHECK THIS ELEMENT * QCHK3 LDB EQT1 GET SUSPEND POINTER SEZ,RSS OVERFLOW? ISZ QCHK NO STEP RETURN JRS QCKST QCHK,I RETURN * QCKST BSS 1 SKP * SUBROUTINE: -LINK- * * PURPOSE: THIS ROUTINE PROVIDES FOR ADDING * AN I/O REQUEST INTO THE SUSPENDED * LIST (QUEUE) CORRESPONDING TO THE * REFERENCED DEVICE. THE PROCEDURE * OF ADDING AN ENTRY INTO THE LIST * INVOLVES ONLY THE ALTERATION OF * THE LINKAGE VALUE IN THE NEW ENTRY * AND IN THE ENTRY PRECEDING THE * NEW ONE IN THE PRIORITY CHAIN. * THE NEW ENTRY IS LINKED ACCORDING * TO ITS PRIORITY AND ON A FIFO * BASIS WITHIN THE SAME PRIORITY * LEVEL. THE END OF A LIST IS MARKED * BY A LINKAGE VALUE OF ZERO. THE * FIRST ENTRY IN A LIST IS SKIPPED * BECAUSE IT IS ASSUMED TO BE THE * REQUESTOR FOR THE CURRENT I/O * OPERATION. IF THE LIST IS EMPTY, * THE LINK WORD IN THE EQT ENTRY * IS SET TO POINT TO THE NEW ENTRY * AND AN INDICATION IS GIVEN TO * THE CALLER OF -LINK- THAT THE * NEW REQUEST MAY BE INITIATED. * * CALL: THE FOLLOWING LOCATIONS MUST BE * SET TO THE INDICATED VALUES * BEFORE THE CALL IS MADE: * * TEMP1 = LOCATION OF NEW REQUEST * TO BE LINKEYQD INTO THE * I/O LIST DEFINED BY THE * CURRENT EQT ENTRY. THE * ADDRESS OF THE LINKAGE * WORD IN THE EQT ENTRY * IS IN -EQT1-. * * TEMP2 = PRIORITY OF THE NEW * REQUEST. * * TEMPL = DISC QUEUE FLAG (# 0 MEANS DISC) * * - JSB LINK * - (RETURN) (E) = 0 IF THE NEW * REQUEST IS THE ONLY ENTRY * IN THE I/O LIST, I.E. THE * DRIVER MAY BE CALLED TO * INITIATE THE NEW OPERATION. * * THERE ARE NO ERROR CONDITIONS * DETECTED OR DIAGNOSED BY THIS * ROUTINE. * * SKP LINK NOP RSA RAL,RAL STA QCKST SJP *+2 LDB EQT1 GET THE HEAD OF THE LIST CLE,RSS SET FIRST FLAG AND SKIP * * FIRST ENTRY IN LIST IS SKIPPED BECAUSE IT * IS THE CALLER FOR THE CURRENT OPERATION * ACTIVE ON THE I/O DEVICE. * ************************************************* **WILL ENTER IN EITHER MAP,BUT THIS IS OK BECAUSE **THE LINK WORD WILL BE IN THE ENABLED MAP AREA** ************************************************* LINK1 SEZ,CCE,RSS IF NOT FIRST SKIP JMP LINK7 GO START THE SCAN * STB TEMP3 TEMP3 = ADDRESS OF CURRENT ENTRY. CCE,INB EXAMINE THE LDA B,I TYPE FIELD IN WORD 2 OF BLOCK INB TO DETERMINE LOCATION RAL OF PRIORITY. SSA IF BUFFERED REQUEST JMP LINK8 B POINTS AT PRIORITY * SLA,RSS IF USER REQUEST JMP LINK5 GO BUMP BY 4 * LDA TEMPL SYSTEM IS IT A DISC SZA,RSS REQUEST ? JMP LINK2 NO USE ZERO PRIORITY * INB,RSS YES USE THE PROVIDED WORD LINK5 ADB .4 IS IN WORD 7 OF ID SEGMENT. LINK8 LDA B,I GET PRIORITY OF CURRENT ENTRY. LINK2 LDB TEMP3 CMA,INA SUBTRACT CURRENT PRIOm#NLHRITY FROM ADA TEMP2 PRIORITY OF NEW REQUEST. SSA IF CURRENT IS LOWER PRIORITY JMP LINK3 (HIGHER #), GO TO LINK NEW. * LINK7 STB TEMP5 SAVE PREVIOUS ENTRY POINTER LDB B,I GET NEXT ENTRY ELB,CLE,ERB CLEAR POSSIBLE SIGN (SAVES E) SZB IF END-OF-LIST, SKIP. JMP LINK1 -CONTINUE SCAN. * * PROPER POSITION (BY PRIORITY) IS FOUND IN LIST, * OR ELSE THE SCAN OF THE LIST IS FINISHED AND * THE NEW REQUEST IS ADDED AS THE LAST ENTRY. * LINK3 LDA TEMP1 SET ADDRESS OF NEW ENTRY IN STB TEMP1,I SET ADDRESS OF NEXT OR 0 IF LAST XOR TEMP5,I KEEP SIGN OF OLD WORD AND C100K IF IT WAS SET XOR TEMP5,I STA TEMP5,I SET THE POINTER TO THE NEW REQUEST JRS QCKST LINK,I - EXIT TO CALLER. * SPC 1 .1 DEC 1 .2 DEC 2 .4 DEC 4 .6 DEC 6 .7 DEC 7 .15 DEC 15 SKP ************************************************** *******THIS ROUTINE SETS UP THE APPROPRIATE MAP N*******FOR THE DRIVER WHICH IS BEING CALLED******* ****************************** ******************* * * CALLING SEQUENCE: * * SET UP EQT ADDRESSES * JSB $DVM * --- RETURN CORRECT MAP SET. * * ************************************************ ************************************************* ***********WARNING WARNING WARNING************* ***********NO EXTERNAL ROUTIN SHOULD CALL********** ************$DVM OR $RSM EXCEPT SPOOL DRIVER**** ************************************************** ************************************************* * * * $DVM NOP SJP *+2 CLA STA DVMPS LDB EQT1,I GET DRIVER LINK WORD SSB,RSS IF SIGN BIT SET EXIT IN SYTEM MAP SZB,RSS LEAVE IN SYS MAP JMP $DVM,I * LDA B INA LDA A,I CHECK T FIELD IN CONTROL WORD RAL SSA T=1 0R 3 IF S=1 JMP $DVM,I LEAVE SYSTEM MAP ENABLED * SLA,RSS JMP DVUSR T=0,GO SET USER MAP * ADB .4 T=2,GET ID WORD IN SYS CALL LDB B,I SZB,RSS IS IT 0 JMP $DVM,I YES,USE SYSTEM MAP * DVUSR LDA EQT1,I ADA .2 LDA A,I GET USER BUFFER ADR FROM ID TMP WORDS CCE,SSA WAS BUFFER MOVED TO SAM JMP $DVM,I YES,STAY IN SYS MAP * ISZ DVMPS SET THE 'MAPS SWITCHED FLAG' LDA ASVUI GET THE LOCAL SAVE ADDRESS USA AND SAVE THE CURRENT USER MAP STB TID SAVE ID SEG ADR. ADB .14 IS CURRENT USER LDA B,I CORE RESIDENT? AND .15 CPA .1 WELL? JMP MEMRS YES GO SET MEM RES MAP * ADB .7 STEP TO THE MAP ADDRESS LDA B,I GET MAPID WORD STB DTMP AND B77 GET PARTITION NUMVER STA B MULTIPLY BY 6 ADB B THE FAST WAY *2 ADB A *3 ADB B *6 AD $B $MATA GET MAT ENTRY ADR LDA B GET MAT ENTRY. ADA .2 LDA A,I GET ID ADR. CPA TID SAME? RSS YES, SO GO SET USER MAP. JMP MEMRS NO,GO UNDER MEM RES MAP FOR COMMON. LDA DTMP,I ALF RAL,RAL GET # PAGES AND B37 ISOLATE JSB $SMAP GO SET UP USER MAP UJP $DVM,I ENABLE USER MAP * MEMRS LDA $MRMP USA UJP $DVM,I MEM RES MAP ENABLED * DTMP NOP .14 DEC 14 *** * TID NOP ASVUI DEF SVUSR,I ADDRESS WITH SIGN SET FOR SAVE ASVUS DEF SVUSR SVUSR BSS 32 DVMPS BSS 1 DRIVER MAP FLAG * ********RESTORE USER MAP TO PRE-****** ********DRIVER STATE****************** * * $RSM NOP CLA CPA DVMPS WAS USER MAP CHANGED JMP RSEX NO,RETURN * STA DVMPS YES,CLEAR CHANGE MAP FLAG LDA ASVUS USA RESTORE ORIGINAL USER MAP RSEX SJP $RSM,I ENABLE SYSTEM MAP SKP * SUBROUTINE: -DRIVR- * * PURPOSE: THIS ROUTINE PROVIDES A CENTRAL POINT * FOR CALLING AN I/O DRIVER TO INITIATE * A NEW OPERATION. THIS ROUTINE, BEFORE * CALLING A DRIVER, SETS THE REQUEST * PARAMETERS INTO THE APPROPRIATE WORDS * IN THE EQT ENTRY CORRESPONDING TO THE * REFERENCED DEVICE AND ASSIGNS A DMA * CHANNEL IF REQUIRED. * IT ALSO SETS THE DEVICE TIME-OUT CLOCK. * * REQUIREMENTS: THE ADDRESSES OF THE EQUIPMENT * TABLE ENTRY (15 WORDS) MUST BE SET * IN EQT1 TO EQT15 BEFORE THE ROUTINE * IS CALLED. * * CALLING SEQUENCE: - PARAMETER SET UP AS ABOVE- * - (REGISTERS MEANINGLESS) - * * (R) JSB DRIVR * (P+1) -OPERATION INITIATED OR STACKED * (P+2) -OPERATION REJECTED- * * ERRORS/DIAGNOSTICS: A DRIVER IS CALLED ONLY * IF THE UNIT IS +AVAILABLE * AND NOT BUSY; OTHERWISE, * RETURN IS MADE TO THE * CALLER. IF THE DRIVER * FINDS THE UNIT UNAVAILABLE * OR THE REQUEST ILLEGAL FOR * THE UNIT, THE INDICATION IS * RETURNED TO THE CALLER FOR * FURTHER ACTION. * DRIVR NOP LDA EQT5,I CHECK AVAILABILITY RAL OF DEVICE SSA,SLA IF DMA WAIT JMP DVR00 GO DO DMA WAIT THING. * CMA,SSA,SLA,RSS IF DOWN OR BUSY JMP DRIVR,I EXIT * * * DEVICE IS AVAILABLE - CHECK FOR DMA REQUIREMENT * LDA EQT4,I SKIP DMA CHANNEL ASSIGNMENT IF SSA,RSS NOT REQUIRED ( D FIELD = 0 ) JMP DRV02 IN WORD 4 OF EQT ENTRY. SPC 1 * LDB EQT1,I SKIP DMA CHANNEL ASSIGNMENT IF * INB CONTROL REQUEST (CODE = 3) * TOA B,I * AND .3 * CPA .3 * JMP DRV02+2 * * DMA CHANNEL REQUIRED - ATTEMPT TO ASSIGN CHANNEL * DVR0 LDA DMACF IF DMA QUEUE IS NOT EMPTY B2002 SZA JMP DVR1 THEN JUST ADD THIS EQT TO QUE. * DVR00 LDA .6 INITIALIZE FOR STA CHAN CHANNEL 6 (DMA # 1 ) LDB INTBA ADDR. OF DMA 1 IN INTERRUPT TABLE CLA IF DMA CHANNEL # 1 CPA B,I AVAILABLE (INTBL ENTRY = 0), JMP DRV01 GO TO ASSIGN IT TO THIS UNIT. * INB SET FOR CHANNEL 7, ISZ CHAN DMA CHANNEL # 2. CPA B,I IF THIS CHANNEL AVAILABLE, JMP DRV01 GO TO ASSIGN IT. * * NO CHANNEL AVAILABLE - SET FLAGS AND RETURN * DVR1 LDA EQT5,I IF DEVICE SSA IS ALREADY WAITING FOR DMA, JMP DRIVR,I EXIT. * IOR B140K SET AVAIL TO SAY WAITING FOR STA EQT5,I DMA, ADD 1 TO ISZ DMACF # DEVICES WAITING.  JMP DRIVR,I - EXIT TO CALLER - * DRV03 SEZ,CLE,INB STEP OVER PRIORITY AND INB IF CLASS REQUEST OVER CLASS WORD AND .6 ISOLATE REQUEST (A IS SHIFTED REMEMBER) CPA .6 IF CONTROL REQUEST JMP DRV2 GO SET IT UP * STB A SET BUFFER ADDRESS ADA .4 IN A (SKIP LENGTH AND TWO OPTION WDS) JMP DRV3 GO FINISH SET UP. * * ASSIGN AVAILABLE CHANNEL * DRV01 LDA EQT1 SET EQT ENTRY ADDRESS IN INTER- STA B,I RUPT TABLE ENTRY FOR CHANNEL. LDB DMACF IF UNIT WAS LDA EQT5,I PREVIOUS WAITING SSA FOR A DMA ADB N1 CHANNEL, SUBTRACT 1 FROM # OF STB DMACF UNITS WAITING. ALR,RAR CLEAR STA EQT5,I FIELD. * JSB $DVM GO SET MAP LDA DVMPS SET DMA MAP RAR IOR CHAN XMA JMP DV02C CONTINUE * * * TRANSFER REQUEST PARAMETERS TO EQT ENTRY * DRV02 EQU * JSB $DVM GO SET MAP DV02C LDB EQT1,I GET CURRENT REQUEST ADDRESS INB FROM LINK WORD OF EQT ENTRY. LDA B,I GET REQUEST CONTROL WORD, AND NTSUB SET SUBCHANNEL BITS TO ZERO STA EQT6,I SET IN EQT 6. XOR B,I SET SUBCHANNEL RAL,RAL NUMBER INTO RAL,SLA,RAL BITS 10-6 OF WORD XOR B2002 SET HIGH BIT,CLEAR LOW. STA TEMPL SAVE FOR EQT4 LDA B,I CLE,ELA IF REQUEST IS DRV2 INB SSA HELD AS A TEMPORARY BLOCK FOR JMP DRV03 BUFFERING, JUMP. * AND .6 CPA .6 CCA,RSS THIS IS A CONTROL CALL LDA C100K NOT CONTROL SET TO MASK OUT SIGN * AND B,I * DRV3 STA EQT7,I ADDRESS. INB LDA B,I SET BUFFER STA EQT8,I LENGTH. INB DLD B,I SET ADDITIONAL 2 DST EQT9,I PARAMETERS IF SUPPLIED. * * CALL DRIVER -INITIATION- SECTION * LDڜA EQT14,I SET DEVICE LDB EQT15,I TIME OUT CLOCK ONLY SZB,RSS IF NOT CURRENTLY RUNNING STA EQT15,I LDA EQT4,I ZERO TIME-OUT AND C7700 BIT AND SET IOR TEMPL IN SUBCHANNEL STA EQT4,I SET (A) = CHANNEL AND B77 # OF I/O DEVICE. LDB EQT2,I CALL DRIVER *INITIATION* JSB B,I SECTION. SKP * * DRIVER RETURNS AN INDICATION OF THE ACCEPTANCE * OR REJECTION OF THE REQUESTED OPERATION: * (A) = 0, OPERATION SUCCESSFULLY INITIATED * (A) NOT = 0, OPERATION REJECTED AND (A) * CONTAINS A NUMERIC CODE * IDENTIFYING THE CAUSE OF * THE REJECT. * * = 1 READ OR WRITE REQUEST ILLEGAL FOR DEVICE * = 2 CONTROL REQUEST ILLEGAL OR NOT DEFINED * = 3 EQUIPMENT MALFUNCTION OR NOT READY * = 4 IMMEDIATE COMPLETION OF OPERATION * = 5 DRIVER REQUIRES DMA BUT FLAG IS NOT SET IN EQT * STA TEMP6 SAVE DRIVER CODE. JSB $RSM GO RESOTRE USER MAP LDA TEMP6 RESOTRE DRIVER CODE CCE,SZA IF REJECTED, JMP DRV06 EXAMINE REASON * * OPERATION INITIATED * LDB EQT5,I SET RBL,ERB = 2 TO SAY DEVICE LDA EQT1,I IF NO QUE SZA SKIP BUSY SET STB EQT5,I IN OPERATION. JMP DRIVR,I EXIT. * * OPERATION REJECTED * DRV06 STB TLOG SAVE (B) CLA CLEAR DEVICE STA EQT15,I TIME-OUT CLOCK JSB CLDMA CLEAR DMA IF ALLOCATED LDA TEMP6 (A) = REJECT CODE. CPA .5 IF DMA REQUIRED JMP DVR0 GO ATTEMPT ASSIGNMENT ISZ DRIVR SET RETURN TO (P+2). CPA .3 IF NOT READY THEN JMP DRIVR,I -EXIT. JMP ILLCD ELSE GO TO SEND THE MESSAGE SPC 1 C7700 OCT 170077 NTSUB OCT 153703 B174K OCT 174000 B20K OCT 20000 HED < I/O MODULE SUBSECTION - SYSTEM REQUEST PROCESSOR >M * SYSTEM I/O REQUEST PROCESSOR - $XSIO- * * A PRIVATE ENTRY IS PROVIDED AT ENTRY POINT * < $XSIO> TO ALLOW MODULES OF THE REAL TIME * EXECUTIVE TO CALL FOR I/O OPERATIONS WITHOUT * INCURRING THE OVERHEAD AND PROCEDURES * INVOLVED WITH USER I/O REQUESTS. NO ERROR * CHECKING IS PERFORMED, THE REQUEST IS LINKED * INTO THE APPROPRIATE I/O LIST AT A PRIORITY * LEVEL OF ZERO (HIGHEST PRIORITY), AND CONTROL * IS RETURNED TO THE FIRST WORD FOLLOWING THE * REQUEST CALL. * REQUEST FORMAT: A SYSTEM I/O REQUEST DIFFERS * FROM THE USER I/O REQUEST IN * FORMAT AND POWER. SPECIFICALLY, * A SYSTEM DISC CALL CAN SPECIFY A * SERIES OF TRANSFERS TO BE * PERFORMED BEFORE THE NEXT * OPERATION IS INITIATED. A * COMPLETION ADDRESS CAN BE * SPECIFIED FOR OPERATION OF * AN OPEN SUBROUTINE AT THE * END OF THE OPERATION. THIS * FACILITY IS ONLY AVAILABLE * TO SYSTEM ROUTINES AND IS * USED TO RESET FLAGS, ETC. * BECAUSE AN OPERATION IS * ALWAYS BUFFERED TO THE * SYSTEM. A ZERO COMPLETION * ADDRESS INDICATES ABSENCE * OF A COMPLETION ROUTINE. * WORD * ---- EXT $XSIO * 1 JSB $XSIO * 2 OCT * 3 DEF * 4 NOP * 5 OCT * 6 DEF * 7 DEC OR * 8 OCT <0> OR * * DISC VERSION OF REQUEST: * WORD 6 OF REQUEST POINTS TO AN ARRAY * CONTAINING -N- SETS OF TRIPLETS * DECLARING BUFFER ADDRESS, LENGTH AND * TRACK/SECTOR ADDRESS FOR EACH TRANSFER. * THE SET OF TRIPLETS IS OPEN-ENDED AND * TERMINATED BY A ZERO WORD: * * 1 DEF < BUFFER ADDRESS> * 2 DEC < BUFFER LENGTH > * 3 OCT < TRACK/SECTOR #> * . ETC * . . * N DEC 0 (END OF TRIPLETS) * FOR DISC REQUEST THE 7'TH WORD IS THE REQUEST PRIORITY. * * $XSIO NOP CCB ADB $XSIO,I GET LOGICAL UNIT #. STB $CKLO SAVE FOR *STADV*. ADB DRT INDEX INTO THE DRT. LDA B,I GET ASSIGNED EQT ENTRY #. STA TEMPL AND SAVE IT JSB $CVEQ CONVERT TO ABSOLUTE EQT ADDRESSES * LDB $XSIO SET ADDRESS ADB .2 OF LIST POINTER WORD IN STB TEMP1 REQUEST FOR . * LDA TEMPL GET THE SUBCHANNEL WORD AND B174K ISOLATE THE SUB CHANNEL CLE,INB SET ADDRESS OF HIS CON WORD ELA,ALF MOST BIT TO 'E', REST AROUND ELA,SLA,RAL TO BITS 2-5, SKIP IF MOST IS ZERO ADA B20K SET MOST IN BIT 13 IF REQUIRED ADA MSIGN ADD THE 'SYSTEM REQUEST' BIT XOR B,I ADD HIS INFORMATION AND SUBCH =B120074 THROW OUT THE EXCESS XOR B,I SET HIS BITS AGAIN STA B,I PUT THE RESULT BACK IN THE QUE CLA SET PRIORITY OF REQUEST = 0 STA TEMP2 FOR , STA CONFL SET CONTROL FLAG = 0 (REQUEST). STA TEMPL SET DISC FLAG TO ZERO (NON-DISC) LDA EQT5,I GET THE DRIVER TYPE AND B36K MASK TO TEST FOR DISC ADB .4 SET B TO THE RETURN ADDRESS STB $XSIO AND SAVE IT ADB N2 SET B TO DISC PRIORITY WORD LDB B,I GET PRIORITY WORD CPA B14K IF DISC STB TEMP2 SET PRIORITY CPA B14K AND STA TEMPL THE DISC FLAG FOR * JSB LINK CALL TO LINK REQUEST IN I/O LIST. SEZ IF DEVICE IS BUSY JMP $XSIO,I THEN EXf_IT. * LDA $CKLO ELSE, IF DEVICE IS JSB STADV DOWN, THEN RETURN RSS TO CALLER. * JSB DRIVR CALL DRIVER TO INITIATE OPERATION JMP $XSIO,I -GOOD REQUEST,EXIT * LDB $XSIO BAD NEWS SO TRANSFER THE STB XSIOE RETURN ADDRESS FOR NR ROUTINE * JMP NOTRD PRINT DIAGNOSTIC. SPC 1 XSIOE NOP SUBCH OCT 120074 SUBCHANNEL MASK, (PLUS SYSTEM RQ CODE) HED < I/O CONTROL MODULE - COMPLETION SUBSECTION > * * I/O COMPLETION SUBSECTION * * THIS SECTION IS RESPONSIBLE FOR THE INITIATION * OF STACKED I/O OPERATIONS, PLACING A USER * PROGRAM BACK IN A SCHEDULED STATE WHEN ITS * I/O OPERATION IS COMPLETED, DYNAMIC ALLOCATION * OF THE TWO DMA CHANNELS AMONG SYNCHRONOUS * DEVICES, AND CALLING FOR OPERATOR NOTIFICATION * OF EQUIPMENT MALFUNCTION. * * IS ENTERED DIRECTLY FROM INTERRUPT CONTROL * WHEN AN I/O OPERATION IS TERMINATED AND ALL * ERROR RECOVERY PROCEDURES HAVE BEEN ATTEMPTED. * ON ENTRY TO THIS SECTION, (B) CONTAINS THE * NUMBER OF WORDS TRANSFERRED. THE ADDRESSES OF * THE EQUIPMENT TABLE ENTRY ARE SET IN -EQT1- TO * - EQT 15-. * * REQUESTS ARE STACKED IN LISTS FOR EACH DEVICE * ACCORDING TO PRIORITY. THE REQUESTS ARE EITHER * USER (NORMAL), USER (AUTOMATIC OUTPUT BUFFERING) * OR SYSTEM - IDENTIFICATION OF REQUEST TYPE * THE CODE IN BITS 15-14 OF THE * IN EACH REQUEST CALL. THE FORMATS OF THE THREE * TYPES OF REQUESTS AS THEY APPEAR IN THE I/O * LISTS ARE: * * 1) USER (NORMAL OPERATION) * * THE PARAMETERS FROM THE REQUEST ARE STORED * IN THE TEMPORARY AREA OF THE PROGRAM ID * SEGMENT. THE LINK WORD OF THE SEGMENT IS * USED TO LINK INTO THE I/O LIST. * * WORD CONTENTS * ---- -------- * 1 < LINKAGE WORD > * 2 * 3 *  4 * 5 * 6 * 7 * . -REMAINDER OF ID SEGMENT . * * SKP * * 2) USER (AUTOMATIC OUTPUT BUFFERING) * * REQUESTS OF THIS TYPE ARE CONSTRUCTED * IN THE SECTION OF SYSTEM AVAILABLE MEMORY. * * WORD CONTENTS * ---- -------- * 1 < LINKAGE WORD > * 2 * 3 * 4 * 5 * 6 * 7 * 8 * . . . . * . . . . * N+7 * * 3) USER (CLASS INPUT/OUTPUT) * * REQUESTS OF THIS TYPE ARE CONSTRUCTED * IN THE SECTION OF SYSTEM AVAILABLE MEMORY. * * WORD CONTENTS * ---- -------- * 1 < LINKAGE WORD > * 2 * 3 (CHANGED TO STATUS AT COMP.) * 4 * 5 * 6 (CHANGED TO TLOG AT COMP.) * 7 * 8 * 9 * . . . . * . . . . * N+8 * SKP * * 4) SYSTEM REQUEST * * THE SYSTEM REQUEST IS LINKED INTO * THE I/O LIST BY USING WORD 4 OF THE * CALL AS A LINK WORD. A SYSTEM * REQUEST ASSUMES THE PRIORITY LEVEL * OF ZERO (HIGHEST PRIORITY). * * WORD CONTENTS * ---- -------- * 1 < JSB $XSIO > * O 2 < LOGICAL UNIT # > * 3 * 4 < LINKAGE WORD > * 5 * 6 * 7 * 8 * * THE FIELD (BITS 15-14 IN CONTROL WORD) * IDENTIFIES THE REQUEST TYPE AS: * * 00 USER (NORMAL OPERATION) * 01 USER (AUTOMATIC BUFFERING) * 10 SYSTEM * 11 CLASS I/O * * SKP IOCOM RAL,CLE,ERA CLEAR THE SIGN BIT AND SAVE IN E STA TEMP3 SAVE STATUS FROM DRIVER AND STB TLOG TRANSMISSION LOG STB XLOG SAVE TRANSMISSION LOG FOR RETURN. * JSB $RSM GO RESTORE USER MAP IF NECESSARY * CLA CLEAR STA EQT15,I TIME-OUT CLOCK. * LDA EQT4,I SET THE COMPLETION SECTION FLAG STA CONFL AND TEST FOR DMA RETURN SEZ,RSS SIGN OF A IS EXPLICID RETURN OF SSA DMA CHANNEL, CALL TO JSB CLDMA RELEASE ITS ASSIGNMENT. * L.49 LDB EQT1,I GET CONTROL WORD FROM CLE,SZB,RSS IF ILLEGAL ENTRY JMP CIC.4 SEND ERROR MESSAGE * SSB,INB REQUEST BLOCK TO JMP L.502 IF CLEAR COMPLETION GO CLEAN IT UP. STB IOE11 SAVE CONWD FOR *IOERR* USE. * LDA B,I EXTRACT FIELD. STA TEMP0 SAVE CONTROL WORD. LDB EQT1,I LDA TEMP3 IF ERROR, CPA .1 GO PROCESS. JMP NOTRD * LDA B,I UNLINK STA EQT1,I CURRENT I/O LDA TEMP0 REQUEST. RAL,SLA,ELA IF BIT 15 = 1 ( = 2 OR 3) JMP L.53 PROCESS AS SYSTEM REQUEST. * SEZ,RSS IF = 0, PROCESS JMP L.51 AS NORMAL USER REQUEST. * * RELEASE AUTOMATIC BUFFERING BLOCK * LDA TEMP3 IF MALFUNCTION OCCURRED, SZA THEN UNDO THE RELINKING STB EQT1,I AND BY PASS RELEASE OF SZA BUFFER. JMP L.70 STB L.50 * ADB .3 GET TOTAL LDB B,I BLOCK LENGTH AND STB L.50+1 SET IN RELEASE CALL. * JSB $RTN RELEASE BLOCK TO AVAILABLE MEM. L.50 NOP - BLOCK ADDRESS - NOP - BLOCK LENGTH - L.501 JSB $CKLO CHECK IF BELOW THE LIMIT. IF SO, JMP L.54 SCHED ANY WAITERS. START NEXT REQUEST. * L.502 ADB C100K SUBTRACT ONE AND SIGN BIT STB EQT1,I RESET IN THE EQT AND JMP L.55 GO START THE NEXT RQ. SKP * * NORMAL USER OPERATION COMPLETION * L.51 STB L.52 SET CURRENT ADDR. FOR SCHEDULER. ADB .9 SET (B) = ADDR. OF XA IN ID SEG. LDA TEMP3 GET COMPLETION STATUS CLE,SZA SET BIT 14 CCE IN STATUS WORD LDA EQT5,I IF THE STATUS RAL,RAL IS NON-ZERO ERA,CLE,ERA AND SAVE IN USER A-REG. STA B,I CONTENTS OF PROGRAM. INB STB TEMP9 SAVE TRANSMISSION LOG ADDRESS LDA TLOG SET TRANSMISSION LOG AS STA B,I SAVED B-REGISTER. ADB .5 INDEX TO THE STATUS WORD LDA B,I AND SAVE FOR STA TEMPX DISC ERROR ROUTINE * JSB $LIST CALL SCHEDULER MODULE TO PLACE OCT 101 USER PROGRAM INTO L.52 NOP LIST. JMP L.54 * * SYSTEM REQUEST COMPLETION * L.53 STB PTR SAVE THE QUEUE ADDRESS SEZ IF CLASS REQUEST JMP C.01 GO REQUEUE THE REQUEST * ADB N1 GET WORD 3 OF REQUEST LDA B,I . STA COMPL SAVE COMPLETION ADDR. OR ZERO. SKP * * < L.54 > : AT THIS POINT: * 1) A TEMPORARY BUFFER HAS BEEN RELEASED, * 2) A NORMAL OPERATION HAS CAUSED THE * REQUESTING PROGRAM TO BE LINKED * BACK INTO THE LIST, :OR * 3) A SYSTEM REQUEST COMPLETION ADDRESS * HAS BEEN SAVED. * L.54 LDA TEMP3 BY PASS INITIATING THE NEXT CMA,SSA,INA,SZA OPERATION IF A MALFUNCTION HAS JMP L.70 OCCURRED ON THIS DEVICE. * * L.55 LDA EQT5,I CHECK FIELD. RAL SSA IF AV SAYS DOWN JMP IOCX GO EXIT * * SECTION <60> PROVIDES FOR INITIATING THE NEXT * OPERATION WAITING FOR THE COMPLETED DEVICE. * L.60 LDA EQT5,I SET ALR,RAR FIELD STA EQT5,I = 0 TO SAY AVAILABLE. JMP L.68 GO START THE NEXT REQUEST * .11 DEC 11 N8 DEC -8 * * CHECK IF BELOW THE BUFFER LIMIT ON THE CURRENT EQT. * $CKLO NOP LDB $BLLO CHECK IF BELOW THE LIMIT. JSB QCHK JMP $CKLO,I NO, SO RETURN. * LDA B YES, SO SCHEDULE ANY WAITERS JSB $SCD3 AND JMP $CKLO,I RETURN. SKP * CLASS REQUEST COMPLETION * * CLASS COMPLETION IS HANDLED AS FOLLOWS: * * 1. THE EXCESS BUFFER IS RETURNED ON WRITE COMPLETION * 2. IF THE CLASS QUEUE IS NOT EXPECTING A REQUEST * THE WHOLE BUFFER IS RELEASED AND WE EXIT. * 3. IF A PROGRAM IS WAITING FOR THE REQUEST IT IS * RESCHEDULED. * 4. THE REQUEST IS MODIFIED TO PUT THE STATUS WORD * AND THE TRANSMISSION LOG (TLOG) IN WORDS * 3 (PRIORITY) AND 6 (USER LENGTH WORD) * 5. THE CLASS QUEUE IS UPDATED AND WE EXIT. * * SEE DESCRIPTION OF CLASS QUEUE IN COMMENTS AT BEGINNING * OF SECTION ON USER REQUESTS. * * C.01 LDB PTR GET THE QUEUE ADDRESS INB LDA B,I GET THE CON WORD ADB .2 STEP TO LENGTH WORD STB CLTMP SET LENGTH ADDRESS SLA IF READ JMP C.03 SKIP RETURN * LDA B,I GET BLOCK SIZE TO A. ADB .5 STEP TO RETURN BUFFER ADDRESS ADA N8 SUBTRACT SIZE OF OVERHEAD STA CLRTN ˌNLH SET RETURN SIZE ADA N2 IF LESS THAN TWO WORDS SSA THEN SKIP JMP C.03 THE RETURN * STB CARTN SET THE BUFFER ADDRESS JSB $RTN RETURN THE WRITE BUFFER CARTN NOP BUFFER ADDRESS CLRTN NOP BUFFER LENGTH * LDA CLRTN SET THE CMA,INA NEW BLOCK SIZE ADA CLTMP,I IN THE BLOCK STA CLTMP,I SET THE NEW SIZE * C.03 ISZ CLTMP STEP TO CLASS WORD LDA CLTMP,I GET THE CLASS AND B377 COMPUTE THE ADA DCLAS CLASS HEAD ADDRESS * C.04 LDB A,I GET THE CONTENTS OF CLASS HEAD. * CLE,SSB,RSS IF POSITIVE JMP C.08 GO TRACK DOWN THE QUE. * STA CLASS SAVE THE CLASS QUEUE ADDRESS RBL,CLE,ELB IF PROGRAM WAITING SEZ,CLE,RSS JMP C.05 SKIP,ELSE GO LINK IN THE RQ. * * PROGRAM IS WAITING, CLEAR THE WAIT FLAG * AND RESCHEDULE THE PROGRAM * ERB,RBR CLEAR THE WAIT FLAG lN STB A,I AND RESET IN THE QUEUE. * JSB $SCD3 SCHEDULE ANY PROGRAMS WAITING C.05 LDB CLASS,I GET CURRENT END OF LIST ADB N1 SUBTRACT ONE PENDING REQUEST STB PTR,I SET IN NEW END OF LIST LDB PTR SET NEW ELEMENT IN STB CLASS,I THE LIST. * ISZ PTR STEP TO ISZ PTR PRIORITY ADDRESS ISZ CLTMP STEP TO BUFFER LENGTH WORD LDA EQT5,I GET CURRENT STATUS ALR,RAL CLEAR DOWN/BUSY BITS. LDB TEMP3 GET COMPLETION STATUS CMB,CLE,INB IF FROM ILCODD * CME IF BAD COM CODE ERA,CLE,RAR SET BIT 14 LDB TLOG GET THE TRANSMISSION LOG. STA PTR,I SET THE STATUS WORD STB CLTMP,I AND THE TLOG * JMP L.501 ELSE STANDARD COM EXIT * C.08 LDA B TRACK DOWN JMP C.04 THE END OF THE LIST SPC 1 * * THIS DEVICE IS COMPETING WITH OTHER DEVICES FOR * THE USE OF THE AVAILABLE DMA CHANNEL. THE * FIELD IN THE CURRENT ENTRY IS SET = 3 TO MEAN * WAITING FOR DMA. THE EQT IS THEN SCANNED FROM * FIRST TO LAST ORDER (#1 TO N) TO FIND THE FIRST * UNIT WAITING FOR DMA. THEREFORE, THE ORDER OF * THE EQT DETERMINES PRIORITY FOR DYNAMIC ASSIGN- * MENT OF DMA CHANNELS - THE SYSTEM DISC SHOULD * BE THE FIRST ENTRY IN THE EQT. * L.63 LDA EQT# SET # OF CMA,INA EQT ENTRIES STA TEMP1 AS AN INDEX VALUE. LDB EQTA INITIALIZE TO FIRST EQT ENTRY. * L.64 STB TEMP2 SAVE CURRENT ENTRY ADDR. ADB .4 EXTRACT LDA B,I FIELD FROM RAL WORD 5. SSA,SLA IF A = 3, GO TO JMP L.66 ASSIGN DMA. * L.65 ADB .11 SET (B) FOR NEXT ENTRY. ISZ TEMP1 END OF EQT? JMP L.64 - NO, CONTINUE SCAN * CCA DECREMENT THE DMA COUNT ADA DMACF (MUST HAVE ABORTED A DMA STA DMACF WAIT WITH 'OF,XXX,1' REQUEST) s JMP IOCX EXIT * L.66 CLA,INA IF ONLY 1 DEVICE WAITING CPA DMACF FOR DMA, GO TO JMP L.67 ASSIGN TO THIS DEVICE. * LDA TEMP2 IF CURRENT UNIT IS CPA EQTA FIRST IN EQT (I.E SYSTEM DISC) JMP L.67 ASSIGN ANYWAY. * CPA EQT1 IF SAME DEVICE JUST COMPLETED, JMP L.65 ALLOW OTHER DEVICES DMA TIME. * L.67 LDA TEMP2 IF DEVICE TO BE INITIATED IS CPA EQT1 SAME AS INTERRUPTING DEVICE, RSS SKIP SETTING EQT ADDRESSES. JSB $ETEQ SET EQT ADDRESSES. * LDA EQT1,I IF NO I/O QUEUED ON THIS SZA,RSS DEVICE, THEN GO CLEAN OUT JMP L.60 ITS 'WAITING ON DMA ALLOC.' FLAG. * * CALL IF A REQUEST IS STACKED OR A * WAITING UNIT IS ASSIGNED A DMA CHANNEL. * L.68 LDA EQT1 GO CLEAN OUT ANY CPA $DMEQ I-O REQUESTS IF THIS JMP IOCX7 IS THE BIT BUCKET. * LDB EQT1,I IF NO REQUEST SZB,RSS IS WAITING, THEN JMP IOCX GO EXIT. * JSB DRIVR CALL RSS IF GOOD REQUEST THEN SKIP JMP NOTRD DIAGNOSTIC IF NOT AVAILABLE. SKP * **************************************************************** * * I/O COMPLETION - EXIT SECTION. * * THIS ROUTINE FIRST CHECKS FOR A DMA QUEUE AND IF ANY AND IF A * CHANNEL IS AVAILABLE, THEN THE CHANNEL ASSIGNMENT ROUTINE * IS ENTERED. IF THIS CONDITION DOES NOT EXIST, THEN * IF THE "BIT BUCKET FLAG" IS SET, THEN THE BIT BUCKET * I/O REQUEST ARE CLEANED OUT. IF THE FLAG IS NOT SET, THEN * IF THE REQUEST IS A SYSTEM REQUEST WITH A COMPLETION ADDRESS, * THEN CONTROL IS TRANSFERED TO THE COMPLETION ADDRESS. IF * NEITHER OF THESE CONDITIONS EXITS, THEN THE OPERATOR ATTENTION * FLAG IS CHECKED. IF SET, THEN THE OPERATOR ACKNOWLEDGEMENT * ROUTINE IS ENTERED. IF NOT SET, THEN CONTROL IS RETURNED * TO THE SYSTEM. * ***************************************************************** * IOCX LDA DMACF GET THE DMA QUEUE FLAG SZA,RSS IF EMPTY QUE THEN JMP IOCX1 GO EXIT * DLD INTBA,I ELSE GET THE DMA FLAGS SZA IF ANY SZB,RSS AVAILABLE JMP L.63 GO ALLOCATE IT. * IOCX1 LDB $BITB CHECK THE "BIT BUCKET FLAG" TO SEE SZB TO SEE IF THE BIT BUCKET MUST BE JMP IOCX0 CLEANED OUT. * LDA COMPL IF SYSTEM REQUEST STB COMPL CLEAR COMPLETION SPECIFICATION. LDB XLOG SZA COMPLETION ROUTINE SPECIFIED, JMP A,I OPERATE IT. * LDB OPATN GET OPERATOR ATTENTION FLAG STA OPATN - CLEAR FLAG - SZB IF OPERATOR DESIRES CONTROL, JMP $TYPE ACKNOWLEDGE. JMP $XEQ OTHERWIZE, RETURN TO THE DISPATCHER. * XLOG NOP SKP * * * CLEAN OUT BIT BUCKET REQUESTS. * * IOCX0 LDA $DMEQ SET UP THE BIT JSB $ETEQ BUCKET EQT ADDRESSES. IOCX7 LDB EQT1,I CHECK IF THERE IS ANY SZB,RSS I/O REQUEST TO BE JMP IOCX9 INITIATED ON THE BIT BUCKET. * LDB EQT1,I YES, SO GET THE REQUEST'S ADB .3 SIZE AND DO AN IMMEDIATE LDB B,I COMPLETION. JMP L.136 * IOCX9 STB $BITB NO, SO CLEAR BIT BUCKET FLAG AND JSB $CKLO CHECK BUFFER LIMITS AND SCHED.WAITERS. JMP IOCX1 * $BITB NOP BIT BUCKET FLAG. DO NOT TOUCH. SKP * * * I/O DEVICE COMPLETION ERROR FROM DRIVER * (A) = ERROR CODE * L.70 LDA TEMP3 CPA .3 IF PARITY ERROR, CCE,RSS CHECK FOR DISC. JMP IOERR - OTHER ERROR CONDITION - * LDA EQT5,I IF AND B36K DEVICE CPA B14K IS DISC, PUT JMP DISCE OUT SPECIAL MESSAGE. * LDA .3 PARITY ERROR ON JMP IOERR OTHER DEVICE, PRINT DIAG. * * DISC ERRORA PROCESSING (SYSTEM/USER) * DISCE LDA TLOG (A) = ERROR TRACK ADDRESS. JSB $CVT3 CONVERT TO DECIMAL ASCII. INA DLD A,I SET DECIMAL TRACK DST DMSG+1 IN ERROR MESSAGE. JSB CPEQT COMPUTE EQT ENTRY # (SETS E). JSB $CVT1 STA DMSG+5 SET IN ERROR MESSAGE. * LDA EQT4,I GET SUBCHANNEL ALF,ALF AND CONVERT RAL,RAL TO ASCII AND B37 JSB $CVT1 STA DMSG+7 * LDB TEMP0 (B)= REQUEST TYPE LDA BLS (A)= " S" SSB,RSS IF USER TYPE REQUEST, LDA BLU (A)= " U" STA DMSG+8 SET "S" OR "U" IN MESSAGE * LDA EQT1 SAVE DISC STA TEMP7 -EQT- ADDRESS LDA COMPL SAVE REQUEST (SYSTEM) STA TEMP8 COMPLETION ADDRESS LDA DMSGA PRINT DIAGNOSTIC: JSB $SYMG "TRNNNN EQTXX,UYY S(OR U)" * CCB LDA TEMP0 IF DISC ERROR SSA FROM SYSTEM REQUEST, JMP L.71 CONTINUE. * STB TEMP9,I SET TLOG IN ID-SEGMENT FOR ABORT ALF,ALF IF LU # 2 OR 3, AND .3 SET TRACK DOWN SZA,RSS IN TAT- JMP L.71 OTHERWISE, CONTINUE * SLA,RSS CLB,RSS LDB TATSD ADB TLOG INDEX TO ADB TAT TAT, SET ERROR LDA MSIGN TRACK STA B,I "DOWN" (ASSIGNED TO SYSTEM). * LDA L.52 (A)= ID SEGMENT ADDRESS LDB TEMPX GET THE SAVED STATUS AND IF NO-ABORT SET SSB,RSS SKIP THE ABORT JSB $ABRT -- ABORT PROGRAM -- * L.71 STB TLOG SET TLOG FOR SYSTEM EXIT LDA TEMP8 RESET "COMPLETION" STA COMPL ADDRESS. LDA TEMP7 RESET EQT STA CONFL SET FLAG FOR COMPLETION. JSB $ETEQ ADDRESSES JMP L.60 * DMSGA DEF *+1 DEC -18 DMSG ASC 9,TRNNNN EQTXX UYY S BLS ASC 1, S BLU ASC 1, U HED < I/O CONTROL MODULE - ERROR SECTION > q* * I/O REQUEST ERROR SECTION * * PART 1: ERRORS ENCOUNTED IN ANALYSING A * USER REQUEST CAUSE A DIAGNOSTIC * TO BE PRINTED ON THE SYSTEM * TELETYPEWRITER AND THE USER * PROGRAM ABORTED. THE FORMAT OF * THE DIAGNOSTIC IS: * * 'IONN PNAME RADDR' * * AS CONSTRUCTED AND SET * BY THE ROUTINE -$ERMG- IN * THE PROGRAM <$RQST>. -NN- IS A * CODE IDENTIFYING THE ERROR TYPE. * ERR00 CLB,RSS ILLEGAL CLASS NUMBER OR SECURITY CODE ERR01 CLB,INB INSUFFICIENT # OF PARAMETERS RSS ERR02 LDB .2 ILLEGAL LOGICAL UNIT REFERENCE, RSS = 0 OR UNDEFINED. ERR04 LDB .4 USER BUFFER VIOLATES SYSTEM RSS OR OTHER BOUNDARIES. ERR05 LDB .5 ILLEGAL DISC TRACK OR SECTOR RSS ADDRESS IN DISC REQUEST. ERR06 LDB .6 REFERENCE TO PROTECTED DISC TRACK RSS ERR08 LDB .8 DISC TRANSFER EXCEEDS TRACK BOUND RSS ERR09 LDB .9 LOAD-N-GO AREA OVERFLOW RSS ERR10 LDB B400 DOUBLE REQUEST ON SAME CLASS * LDA ERIO (A) = ASCII * IO *. JMP $ERAB WRITE DIAGONISTIC AND EXIT TO DISPATCHER * ERIO ASC 1,IO B400 OCT 400 SKP * PART 2: ILLEGAL REQUEST DETECTED BY * I/O DRIVER. THE REASON IS A READ OR * WRITE OPERATION IS ILLEGAL FOR THE * DEVICE OR A CONTROL REQUEST IS * MEANINGLESS FOR THE DEVICE. * AN ADDITIONAL REASON FOR TRANSFER TO THIS * SECTION IS AN "IMMEDIATE COMPLETION" (CODE 4) * RETURN FROM THE DRIVER; PROCESSED AS A * CONTROL REJECT. * * * ERROR PROCEDURE IS: * 1. IF THE REQUEST IS PROCESSED AS * BUFFERED OUTPUT, THE TEMPORARY * BLOCK IS RELEASED TO AVAILABLE * MEMORY. * * 2. THE REJECT IS IGNORED IF A SYSTEM * PROGRAM GENERATED THE REQUEST - * HOWEVER, A COMPLETIOİN ROUTINE, * IF SPECIFIED IN THE REQUEST, IS * OPERATED. (NOTE: THIS PHILOSOPHY * IS BASED ON THE ASSUMPTION THAT * THIS CONDITION SHOULD NEVER OCCUR.) * * 3. A USER CONTROL REQUEST WHICH IS * REJECTED IS TREATED AS IF IT * WAS PERFORMED. THE PROGRAM IS * LINKED BACK INTO THE SCHEDULE LIST. * * 4. A USER READ OR WRITE REQUEST REJECT * CAUSES A DIAGNOSTIC TO BE ISSUED * AND THE PROGRAM ABORTED. SKP ILLCD CLB CPA .4 IF CODE =4 FOR IMMEDIATE RAR,SLA COMPLETION, TREAT AS CONTROL R00 STB TLOG ELSE SET TLOG TO 0. STA TEMP4 REJECT, SAVE CODE. CPA .2 SET ERROR FLAG FOR CLA CLASS COMPLETION. CMA,INA NEGATE TO AVOID STA TEMP3 REPORT AT L.54. LDB EQT1,I GET LOCATION OF LDA B,I ILLEGAL REQUEST (LINK ADDR.) STA TEMP0 SAVE NEXT REQUEST ADDRESS. INB GET CONTROL WORD LDA B,I OF REQUEST BLOCK STA EQT6,I SAVE FOR REXIT RAL CHECK FIELD SSA,RSS FOR TYPE OF REQUEST BLOCK. JMP R02 -USER OR SYSTEM- * CCE,SLA IF CLASS REQUEST JMP L.49 GO DO CLASS COMPLETION. ADB .2 BUFFERED BLOCK. LDB B,I GET TOTAL BLOCK LENGTH. STB R01+1 SET IN RELEASE CALL. LDA EQT1,I SET FWA OF BLOCK STA R01 IN RELEASE CALL. JSB $RTN RELEASE BLOCK. R01 NOP - FWA - NOP - # WORDS - JMP REXIT * R02 SLA,RSS CHECK FIELD AGAIN. JMP R03 -USER PROGRAM REQUEST- * ADB N2 GET WORD IN SYSTEM REQUEST LDA B,I CONTAINING -COMPLETION ROUTINE- STA COMPL ADDRESS OR 0 AND SAVE IT. JMP REXIT * R03 LDA TEMP4 USER REQUEST- CPA .2 CONTINUE IF CONTROL REQUEST JMP R04 REJECTED. LDA EQT1,I SET ID SEGMENT ADDRESS OF PROGRAM STA XEQT CONTAINING ERROR. ADA .8 GET POINT OF SUSPENSION ADDRESS LDB A,I GET RETURN ADDRESS STB RQRTN AND SAVE ON BASE PAGE CCE,INA SET XSUSP(SET E FOR $CVT1 STA XSUSP TO POINT TO SAVED INITIAL CALL ADDRESS LDA EQT1 SAVE CURRENT STA TEMP9 EQT ENTRY ADDRESS. LDA CONFL SAVE CURRENT STA SCONF *CONTROL FLAG* LDA TEMP4 CPA .1 CHANGE ANY NOT READY REJECT LDA .7 CODE TO 7. JSB $CVT1 CONVERT TO ASCII AND LDB A STORE IN B REG. LDA ERIO (A) = ASCII * IO * JSB $ERMG PRINT DIAGNOSTIC CLA SET XEQT STA XEQT TO ZERO TO FOURCE RELOAD LDA SCONF RESTORE STA CONFL *CONTROL FLAG* LDA TEMP9 RESTORE UNIT JSB $ETEQ EQT ENTRY ADDRESSES. JMP REXIT * R04 LDA EQT1,I SET PROGRAM ID SEGMENT STA R05+2 ADDR. IN LIST CALL. ADA .9 (A) = ADDR. OF XA IN ID SEGMENT. LDB EQT5,I SET DEVICE STATUS STB A,I WORD IN XA. LDB TLOG STORE INA TRANSMISSION LOG STB A,I IN XB. R05 JSB $LIST CALL SCHEDULER OCT 101 TO LINK PROGRAM BACK NOP INTO SCHEDULE LIST. * REXIT LDA TEMP0 SET NEXT LIST STA EQT1,I ENTRY ADDRESS. LDA EQT6,I GET CONWORD CLB CLEAR ERROR STB TEMP3 FLAG. CPB CONFL IF $XSIO CALL SSA,RSS THEN SKIP, JMP L.501 ELSE DO NEXT REQUEST. JMP $XSIO,I $XSIO ERROR RETURN. SKP * ********************************************************************** * * I/O DEVICE ERROR SECTION * * THIS SECTION IS ENTERED WHEN A DEVICE IS UNAVAILABLE FOR * INITIATION OF AN OPERATION OR WHEN AN ERROR IS DETECTED AT THE * END OF AN OPERATIOvN. A DIAGNOSTIC MESSAGE IS PRINTED ON THE * SYSTEM CONSOLE IN THE FOLLOWING FORMAT: * * I/O MN LXX EYY SZZ * * WHERE: XX = THE LOGICAL UNIT NUMBER OF THE DEVICE * YY = THE EQT NUMBER OF THE DEVICE * ZZ = THE SUBCHANNEL NUMBER OF THE DEVICE * MN = A MNEMONIC DESCRIBING ONE OF THE FOLLOWING CONDITIONS: * 1. NR - DEVICE IS NOT READY * 2. ET - END-OF-TAPE OR TAPE SUPPLY LOW ON THE DEVICE * 3. PE - TRANSMISSION PARITY ERROR TO/FROM THE DEVICE * 4. TO - THE DEVICE TIMED OUT * -- NEW CODES MAY BE ADDED HERE -- * * GIVEN A BAD I/O REQUEST, IOERR WILL DOWN ALL LU'S ASSOCIATED WITH * THE DEVICE(DEFINED BY THE EQT AND SUBCHANNEL). ALL I/O CHANNELS * ASSOCIATED WITH THE EQT ARE CLEARED. ALL I/O REQUESTS ASSOCIATED * WITH THE DEVICE ARE UNSTACKED FROM THE EQT'S I/O REQUEST QUEUE AND * RELINKED IN THE LOWEST LU'S(MAJOR LU) I-O REQUEST QUEUE(DRT ENTRY * WORD 2)BY THE SUBROUTINE UNLNK. DRT ENTRY WORD 2 OF OTHER DOWNED * LU'S ARE SET TO THE LU NUMBER OF THE MAJOR LU. THE LU DOWN BIT(BIT * 15 OF DRT ENTRY WORD 2)FOR EACH DOWNED LU IS SET. THE EQT ENTRY IS * NOT SET DOWN. I/O ERROR MESSAGES ARE ISSUED FOR ALL LU'S SET DOWN. * * ON ENTRY, CONTAINS A NUMBER CORRESPONDING TO THE ASSOCIATED * MNEMONIC AND EQT1 CONTAINS THE ADDRESS OF WORD ONE OF THE ASSOCIATED * DEVICE'S EQT ENTRY. * * THE FOLLOWING TEMPORARY LOCATIONS ARE USED FOR TEMPORARY STORAGE BY * IOERR: * :=SUBCHANNEL-EQT WORD FOR THE BAD I-O REQUEST GIVING THE * SUBCHANNEL IN BITS 11-15 AND THE EQT IN BITS 0-5(USED BY * LUERR). * :=WORD 2 OF THE BAD I-O REQUEST. * ********************************************************************** * SKP NOTRD LDB EQT1,I LU NOT READY ENTRY. INB GET BAD I-O REQUEST CONWD SToB IOE11 AND SAVE FOR LATER. CLA,INA SET A=1 FOR NOT READY. * IOERR LDB EQT1 REMOVE ALL ENTRIES IN THE QUEUE STB HEAD RELATED TO THE BAD I-O REQUEST. ADA ERTBL INDEX TO ERROR CODE TABLE. LDA A,I GET MNEMONIC AND SET STA IOMSG+2 IN DIAGNOSTIC MESSAGE. * LDA BLL SET UP STA IOMSG+3 "L" AND LDA BLS "S" IN THE STA IOMSG+7 DIAGNOSTIC MESSAGE. * JSB CPEQT GET EQT NUMBER(SETS E=1). STA TEMP8 SAVE EQT NUMBER. JSB $CVT1 CONVERT TO ASCII STA IOMSG+6 AND SAVE(E MUST = 1). * LDA EQT4,I GET LAST USED SUBCHANNEL ALF,RAL FORM EQT4 AND POSITION AND B174K TO HIGH 5 BITS. IOR TEMP8 ADD IN EQT NUMBER STA TEMP8 AND SAVE AS SUBCHANNEL-EQT WORD. * ALF,RAL GET SUBCHANNEL AND B37 NUMBER. JSB $CVT1 CONVERT TO ASCII(ON ENTRY,E MUST=1) STA IOMSG+8 AND SAVE. * JSB LUERR DOWN THE LOGICAL UNITS(ENTRY A#0).WAIT UNTIL LDA EQT5,I AFTER LUERR CALL TO SET AVAIL FIELD TO 0 SO ALR,RAR WE WON'T ENTER DRIVER(VIA $XSIO)TO PRINT STA EQT5,I ERROR MESSAGE ON SAME EQT WE'RE DOWNING. * SEZ CHECK IF WE TRIED TO JMP IOER9 DOWN LU 1. IGNORE ATTEMPT. * LDA EQT1 LDB A,I CHECK IF WE MUST SZB INITIATE AN JSB $DLAY I/O REQUEST OF THIS EQT. * LDB IOE11,I GET SAVED WORD 2(CONWORD) LDA CONFL FOR THE BAD I/O REQUEST. SZA IF COMPLETION SECTION IS IN JMP IOCX CONTROL, THEN EXIT IOC. * RBL,SLB IF REQUEST SECTION IN CONTROL, SSB CHECK IF USER OR SYSTEM I/O REQUEST. JMP IOCX IF USER, GO TO EXECUTION SECTION. JMP XSIOE,I IF SYSTEM, RETURN TO SYSTEM CALLER. * IOER9 LDA CONFL SAVE CONTROL STA SCONF FLAG. CLA,INA @ SET JSB $CVT1 ASC11 1 STA IOMSG+4 INTO MESSAGE. LDA IOMSA JSB $SYMG ISSUE MESSAGE. LDA SCONF RESTORE FLAG. STA CONFL JMP L.60 * HEAD NOP IOE11 NOP * * IOMSA DEF *+1 DEC -18 IOMSG ASC 9,I/O MN LXX EYY SZZ * * * * I/O DEVICE ERROR MNEMONIC TABLE--ORDERED BY * ERROR CODE DESCRIBING CONDITION. * ERTBL DEF * ASC 1,NR - NOT READY - ASC 1,ET - END OF TAPE (INFORMATION) - ASC 1,PE - TRANSMISSION PARITY ERROR - ASC 1,TO - TIMED-OUT - * * NEW CODES MAY BE ADDED AT THIS POINT * SBMSK OCT 20074 BLL ASC 1, L * SKP * ***************************************************************** * * SUBROUTINE LUERR * * THIS SUBROUTINE IS USED TO DOWN ALL LU'S CORRESPONDING TO A * SPECIFIC EQT AND SUBCHANNEL. IT WILL OPTIONALLY PRINT AN * ERROR MESSAGE FOR EACH DOWNED LU. * * CALLING SEQUENCE: * :=0 DO NOT PRINT I/O ERROR MESSAGES * :#0 PRINT I/O ERROR MESSAGES(ASSUMES ASCII EQT AND * SUBCHANNEL ALREADY SET) * := POINTER TO I-O REQUEST LIST TO SCAN. * :=SUBCHANNEL-EQT WORD FROM THE BAD I-O REQUEST. * JSB LUERR * * RETURN: * :=1 TRIED TO DOWN LU 1 * :=0 DID NOT TRY TO DOWN LU 1 * NO REGISTERS ARE SAVED. * SUBROUTINE UNLNK USES TEMP0 AND OTHERS. * USES THE FOLLOWING REGISTERS: * :=FLAG AS TO WHETHER TO PRINT(#0) OR NOT PRINT(=0) * I/O ERROR MESSAGES. * :=USED TO STORE THE MAJOR LU. * :=COUNTER FOR SCAN THROUGH DRT. * :=USED TO SAVE POINTER INTO DRT. * :=USED TO SAVE EQT1. * :=USED TO STORE LU TEMPORARILY. * ****************************************************************** * LUERR NOP { STA TMP1 * LDA CONFL SAVE CURRENT STA SCONF CONTROL FLAG. * CLA SET MAJOR LU STA TMP2 TO ZERO. * LDA LUMAX SET CMA,INA UP STA TMP3 COUNTER. LDB DRT GET FIRST DRT ENTRY. * SKP D.00 LDA B,I GET DRT WORD 1 STB TMP4 SAVE POINTER IN DRT. AND C3700 COMPARE DRT WORD 1 TO THE SUBCHANNEL- CPA TEMP8 EQT WORD(LESS THE LOCK FLAG). RSS IF EQUAL,FOUND A LU,SO GO PROCESS. JMP D.04 OTHERWIZE,GO CONTINUE SCAN OF DRT. * LDA LUMAX FOUND A LU MATCH SO PROCESS IT. CCE,INA COMPUTE THE(SET E=1 FOR POSSIBLE LU=1) ADA TMP3 LU NUMBER. STA TMP8 SAVE LU NUMBER FOR LATER. CPA .1 CHECK TO SEE IF SYSTEM CONSOLE. IF SO, JMP D.06 DO NOT SET THE DEVICE DOWN. ADB LUMAX POSITION POINTER TO DRT WORD 2. LDA TMP2 CHECK TO SEE IF A MAJOR SZA LU HAS BEEN FOUND JMP D.02 IF SO,THEN STORE THE MAJOR LU # IN WORD * 2,SET THIS LU BUZY,ISSUE MESSAGE. * STB A SAVE DRT WORD 2 ADDRESS. LDB EQT1 SAVE EQT1 ADDRESS STB TMP6 FOR RESTORATION. LDB HEAD GO UNLINK ANY I-O REQUESTS FROM JSB $UNLK THE GIVEN I-O QUEUE. DEF TEMP8 LDA TMP8 SAVE THIS LU STA TMP2 AS MAJOR LU. LDB TMP4 RESTORE POINTER TO DRT WORD 2. ADB LUMAX LDA B,I D.02 CCE RAL,ERA SET THE(E MUST=1) STA B,I LU DOWN. LDB TMP1 CHECK IF WE ARE TO PRINT ERROR CCE,SZB,RSS MESSAGES(SET E=1 FOR $CVT1). JMP D.025 NO, SO SKIP. LDA TMP8 JSB $CVT1 CONVERT LU TO STA IOMSG+4 ASCII AND SAVE. LDA IOMSA GET LU I/O ERROR MESSAGE JSB $SYMG AND ISSUE TO USER. LDA TMP6 RESTORE JSB $ETEQ  EQT POINTERS. D.025 LDB TMP4 * D.04 INB INCREMENT POINTER TO NEXT DRT ENTRY. ISZ TMP3 JMP D.00 GO SCAN NEXT ENTRY. * JSB $CKLO CHECK BUFFER LIMITS AND SCHED WAITERS. CLE D.06 LDA SCONF RESTORE CONTROL STA CONFL FLAG. JMP LUERR,I IF NO MORE LU ENTRIES, RETURN. SKP * *********************************************************************** * * SUBROUTINE $UNLK * * THIS SUBROUTINE IS USED TO UNLINK I/O REQUESTS FROM THE EQT I/O * REQUEST QUEUE POINTED TO BY EQT1. IT MAY BE USED IN ONE OF TWO * MODES: * MODE I. IF ON ENTRY THE A REGISTER EQUALS ZERO, NORMAL USER * (UNBUFFERED)I-O REQUESTS ARE UNLINKED WITH THE CALLING * PROGRAMS SUSPENDED IN THE GENERAL WAIT LIST. IT IS * ASSUMED THAT THE EQT WILL BE SET DOWN BY THE CALLER. * MODE II. IF ON ENTRY THE A REGISTER IS NONZERO, THEN ONLY I/O * REQUESTS MATCHING THE SUBCHANNEL GIVEN IN SUEQT ARE * UNLINKED. UNBUFFERED I/O REQUESTS ON THIS SUBCHANNEL ARE * HANDLED AS IN MODE I. BUFFERED, CLASS AND SYSTEM * I/O REQUESTS ARE STACKED UPON AN LU I/O REQUEST QUEUE AFTER * THE I/O REQUEST POINTED TO BY THE A REGISTER IN THE ORDER * THAT THEY APPEARED IN THE EQT QUEUE. * * CALLING SEQUENCE: * :=THE SUBCHANNEL-EQT WORD DEFINING THE DEVICE(MODE II * ONLY, UNUSED WITH MODE I). * :=EQT1(HEAD OF THE I-O REQUEST QUEUE)OF THE DEVICE'S * EQT(USED WITH MODE I AND II). * :=0 INDICATES MODE I PROCESSING. * :#0 INDICATES MODE II PROCESSING. POSITION IN LU I/O REQUEST * QUEUE AFTER WHICH ALL UNLINKED I-O REQUESTS ARE * TO BE RELINKED. * JSB $UNLK * DEF SUEQT * * RETURN: * NO REGISTERS ARE SAVED. * USES UNLK3,UNLK8,TEMPX,TEMP0 +NLH* ************************************************************************ SKP $UNLK NOP STA UNLK8 SET UP POINTER TO THIS I/O REQUEST QUEUE. RSA SAVE MEU RAL,RAL STATUS. STA UNLKS LDA $UNLK,I LDA A,I SJP *+2 AND B174K GET SUBCHANNEL CLE,ELA AND SHIFT RAL,RAL UPPER BIT ALF TO BIT 13 SEZ ADD IN LOWER 4 BITS ADA B20K AT BITS 2-5 STA TEMP0 AND SAVE. RSS * UNLK0 LDB TEMPX,I GET NEXT ENTRY. UNLK1 STB TEMPX SAVE POINTER TO PREVIOUS REQUEST. UNLK2 LDB TEMPX,I GET POINTER TO THIS REQUEST. RBL,CLE,ERB STRIP OFF POSSIBLE SIGN BIT. SZB,RSS IF END, JMP UNLK6 THEN GO EXIT. * STB UNLK3 SAVE POINTER TO THIS REQUEST. INB STEP TO CONTROL WORD OF THIS REQUEST. N LDA UNLK8 CHECK IF MODE I OR II PROCESSING. SZA,RSS JMP UNL25 MODE I SO SKIP SUBCHANNEL CHECK. LDA B,I GET CONTROL WORD OF THIS REQUEST. AND SBMSK PICK OFF SUBCHANNEL INFORMATION AND CPA TEMP0 COMPARE TO THE SUBCHANNEL INFO OF RSS THE BAD I/O REQUEST. IF NOT EQUAL, JMP UNLK0 GO CHECK THE NEXT I/O REQUEST. * UNL25 LDA B,I GET CONTROL WORD OF THIS I/O RAL REQUEST AND ROTATE IT. CMA,SSA,SLA,RSS IF NOT STANDARD USER REQUEST, JMP UNLK4 GO PROCESS AS OTHER TYPES. * LDA .4 STANDARD USER, SO SUSPEND PROGRAM STA B,I IN GENERAL WAIT LIST. ADB .8 SET TEMP WORD #1 IN ID-SEG.TO 4. LDA B,I STEP TO SAVE A REG., GET SAVED ADB N1 POINT OF SUSPENSION, AND STORE STA B,I IT IN XSUSP FOR THIS PROGAM. LDA UNLK3,I UNLINK THIS STA TEMPX,I I/O REQUEST. JSB $LIST LINK THIS PROGRAM INTO THE OCT 103 GENERAL WAIT LIST. UNLK3 NOP JMP UNLK2 GO TRY NEXT ENTRY. * UNLK4 LDA UNLK8 CHECK IF MODE I OR II. SZA,RSS IF MODE I, DO NOT UNLINK JMP UNLK0 THIS REQUEST. GO TRY NEXT ONE. LDB UNLK8,I IF MODE II, CLEAR RBL,CLE,ERB POSSIBLE SIGN BIT LDA UNLK3,I AND LINK THIS I-O STA TEMPX,I STB UNLK3,I REQUEST TO THE LDB UNLK3 END OF THE DOWN STB UNLK8,I I/O REQUEST QUEUE. STB UNLK8 SET UNLK8 TO POINT TO THE LAST REQUEST. JMP UNLK2 GO TRY NEXT ENTRY. * UNLK6 ISZ $UNLK JRS UNLKS $UNLK,I RETURN. * UNLKS NOP * UNLK8 NOP TEMPX NOP * TMP1 CLE CLE FOR INIT CODE TMP2 DEF TEMP2 DEF FOR INIT CODE TMP3 CXA CXA FOR INIT CODE TMP4 NOP TMP5 NOP TMP6 NOP * TMP8 NOP SKP * ****************************************************************** * * SUBROUTINE $DLAY: * * $DLAY IS USED TO SET UP A SHORT TIMEOUT(10 MSEC)WHICH, WHEN IT * OCCURS, SIGNALS THAT AN I/O OPERATION MUST BE INITIATED ON THE * TIMED-OUT EQT(SEE $DEVT). * * CALLING SEQUENCE: * LDA * JSB $DLAY * * RETURN: * ALL REGISTERS ARE MODIFIED. * ***************************************************************** * $DLAY NOP CCE,INA SET THE SIGN BIT LDB A,I ON TO INDICATE RBL,ERB WE MUST INITIATE AN STB A,I OPERATION. ADA .3 CCE LDB A,I SET THE RBL,ERB EQT STB A,I BUZY. ADA .10 LDB N1 SET A STB A,I TIMEOUT JMP $DLAY,I OF 10 MSEC. HED < IO-DEVICE TIME-OUT PROCESSOR > * * * AFTER A DEVICE IS DISCOVERED TO HAVE TIMED-OUT * BY RTIME'S $CLCK PROCESSOR,THIS * ROUTINE IS ENTERED. ITS PURPOSE IS TO * CLEAR THE PENDING IO TRANSFER AND ENTER * IOCOM IN SUCH A WAY AS TO SIMULATE AN IO * COMPLETION RETURN FROM THE DRIVER ITSELF. * * IF THE TIMEOUT WAS DUE TO THE NEED TO INITIATE AN * I/O OPERATION(BIT 15 EQT2 SET)THEN THIS BIT * IS CLEARED AND IOCOM IS ENTERED(AT L.60) TO * INITIATE THE I/O OPERATION. * * * ENTER FROM SCHEDULER MODULE: * * (A)
* * $DEVT ADA N14 POINT TO EQT JSB $ETEQ SET EQT ADDRESSES LDA EQT1,I GET THE CLEAR BIT SSA IF CLEAR TIME OUT JMP CLTIM JUST CLEAR * LDA EQT2,I CHECK IF THE TIMEOUT SSA IS FOR INITIATING I/O JMP INTDL ON THIS EQT. * LDA EQT4,I IOR B4K SET TIME-OUT BIT STA EQT4,I STA B SAVE WORD IN B FOR TEST AND B77 SELECT CODE TO A STA INTCD BLF,SLB IF DRIVER TO HANDLE TIME JMP CIC.6 OUT GO CALL THE DRIVER. *  CLTIM JSB CLCHS CLEAR ALL CHANNELS LDA .4 SERVICED BY THIS ENTRY CLB SIMULATE COMPLETION JMP IOCOM RETURN FROM DRIVER * INTDL RAL,CLE,ERA CLEAR INITIATION STA EQT2,I BIT. ISZ CONFL SET CONTROL FLAG TO NONZERO. JMP L.60 GO INITIATE. * N14 DEC -14 HED < I/O CONTROL MODULE - DATA SECTION > * ***************************************************************** * * CONSTANT AND VARIABLE STORAGE AREA * ******************************************************************* * A EQU 0 DEFINE SYMBOLIC REFERENCES B EQU 1 FOR A AND B REGISTERS. .3 DEC 3 .5 DEC 5 .8 DEC 8 .9 DEC 9 .10 DEC 10 N1 DEC -1 * B77 OCT 77 B377 OCT 377 B140K OCT 140000 B40K OCT 40000 B4K OCT 4000 MSIGN OCT 100000 * TEMP2 LIB 6 GETS -1 IF MX MACHINE, ELSE 0 TEMP3 EQU * LABLE FOR TEMP3 NOP NO X,Y CONFIGURE ON RTEIII TEMP4 JMP TEMP9 ELSE JUST COMPLETE THE MESSAGE * TEMP5 LDB TMP3 'CAX' ENABLE THE SAVE X,Y CODE TEMP6 STB TLOG,I 'DMX1,I' TEMP7 LDB SCONF 'DLD' TEMP8 STB SYSCL,I 'DMX2,I' TEMP9 LDB IODNS PLANT A HLT TEMP0 STB 2 IN 2 TEMPL INB AND TEMPW STB 3 3 * CONFL JMP $SYMG+1 SCONF DLD MX1 TLOG EQU *-1 COMPL NOP DO NOT USE FOR ANY INIT CODE(MUST=0 BEGIN). DMACF NOP FLAGS USED IN ALLOCATING HED ** I/O CONTROL - OPERATOR COMMUNICATION ** * ***************************************************************** * * I/O MODULE // OPERATOR COMMUNICATION * * * THE SYSTEM USES COMMANDS FROM THE * OPERATOR TO CONTROL THE OVERALL STATUS OF * I/O EQUIPMENT, CHANGE ASSIGNMENT OF LOGICAL * UNITS AND TO INTERROGATE THE STATUS AND * PROPERITES OF THE DEVICES IN THE EQUIPMENT * TABLE. * * OPERATOR STATEMENTS ARE PROCESSED ONLY * FROM THE DESIGNATED SYSTEM TELETYPE. THE * ROUTINE IN THE SCHEDULING MODULE * IS RESPONSIBLE FOR SLTATEMENT DECODE AND * PARAMETER SEPARATION AND CONVERSION. THE * ASSOCIATED STATEMENT PROCESSOR IS CALLED * TO PERFORM THE REQUESTED ACTION. THE * STATEMENT PROCESSING IS ALL TABLE-DRIVEN * AS DESCRIBED IN THE LISTING AND DOCUMENTATION * OF THE SCHEDULING MODULE. * * * TWO OF THE I-O CONTROL STATEMENT PROCESSORS * MUST BE INCLUDED IN THE BASIC SYSTEM PACKAGE * AND ARE INCLUDED IN RTIOC. * THESE ARE THE 'UP' AND 'DOWN' STATEMENTS * CONCERNING THE OVERALL STATUS OF I/O DEVICES. * THE OTHER THREE STATEMENT PROCESSORS ( LOGICAL * UNIT ASSIGNMENT, TIME-OUT, AND EQT STATUS) * ARE OPTIONAL AND ARE CONTAINED IN THE USER PROGRAM * $$$CMD WHICH IS SCHEDULED BY SCHED. THESE COMMANDS * MAY BE REMOVED BY DELETING $$CMD. * ****************************************************************** * SKP * **************************************************************** * * 'DOWN' STATEMENT (REQUIRED) * * FORMAT: DN,N1 OR DN,,N2 * WHERE N1 IS THE EQT # OF THE I/O SLOT TO BE SET DOWN * OR N2 IS THE LU # OF THE I/O DEVICE TO BE SET DOWN. * * ACTION: WHEN SETTING THE EQT DOWN, THE AVAILABILITY FIELD OF THE * REFERENCED SLOT IS SET = 1(SLOT DISABLED). * WHEN SETTING THE LU DOWN, BIT 15 OF DRT WORD 2 IS SET AND * ANY I/O FOR THIS DEVICE IS REMOVED FROM THE EQT I/O * QUEUE AND ADDED TO THE LU I/O QUEUE HEADED AT DRT * WORD 2. * * CALL (FROM MESSAGE PROCESSOR): * * := N1 (EQT #) IN BINARY OR 0 * :=-1 OR N2 (LU #) IN BINARY * JMP $IODN * * RETURN IS TO <$XEQ> IF ACTION TAKEN OR TO -MESS.I- TO PRINT * * INPUT ERROR * IF N1 OR N2 ARE ILLEGAL OR IF BOTH ARE PRESENT. * **************************************************************** * $IODN SZA,RSS CHECK IF DOWN LU OR JMP DNLU DOWN EQT COMMAND. DNEQT INB,SZB DOWN EQT COMMAND. IF BOTH LU AND EQT ARE JMP $INER GIVEN, ISSUE INPUT ERROR MESSAGE. AD* JSB IODNS CHECK LEGALITY OF EQT & SET EQT ADDRESSES. LDA EQT1 IF ATTEMPT TO DOWN EQT OF SYSTEM CPA SYSTY CONSOLE, ISSUE INPUT ERROR MESSAGE. JMP $INER LDA EQT5,I SET AVAILABITY FIELD ALR,RAR TO 1 IOR B40K TO SET STA EQT5,I DOWN. * JSB XUPIO SET ANY DOWNED LU'S UP. * LDB EQT1,I GO PUT ALL WAITERS(UNBUFFERED RBL,CLE,ERB I/O)INTO THE BENERAL WAIT SZB,RSS LDB EQT1 CLA LIST. SKIP FIRST REQUEST. JSB $UNLK DEF A (DUMMY DEF FOR THIS MODE). JMP $XEQ RETURN. * DNLU STB A SAVE LU NUMBER. CMB,CLE,INB,SZB,RSS ISSUE AN ERROR MESAGE JMP $INER IF THE LU IS LESS THEN ADB LUMAX 1 OR IS GREATER THEN CCB,SEZ,RSS LUMAX. JMP $INER * ADB A USE LU NUMBER ADB DRT TO POSITION TO LDA B,I WORD 1 OF THE AND C3700 DRT ENTRY. STA TEMP8 SET UP SUBCHANNEL-EQT WORD. AND B77 INPUT SZA,RSS ERROR IF JMP $INER DOWNING BIT BUCKET DEVICE. * STB TEMP9 SAVE ADDRESS OF DRT WORD 1. JSB $CVEQ SET EQT ENTRY ADD(WILL MASK SUBCH.). * LDB EQT5,I CHECK IF RBL,SLB EQT IS JMP DNLU5 UP OR IS SSB DOWN. JMP DNLU9 EQT IS DOWN. * DNLU5 LDB EQT1,I SKIP FIRST EQT I-O REQUEST QUEUE SZB,RSS ENTRY UNLESS THE QUEUE IS EMPTY. LDB EQT1 STB HEAD SAVE THIS POINTER. CLA SET FOR NO ERROR MESSAGES. JSB LUERR GO DOWN ALL LU'S POINTING TO DEVICE. SEZ ERROR IF ATTEMPT JMP $INER TO DOWN LU 1. JMP $XEQ NO, RETURN TO SYSTEM. * DNLU9 LDB TEMP9 IF EQT IS DOWN, THEN ADB LUMAX GET DRT WORD 2 LDA B,I AND SET THE LU IOR MSIGN DOWN. STA B,,I JMP $XEQ RETURN. * C3700 OCT 174077 * * *IODNS* SUBROUTINE TO CHECK LEGALITY OF AN * EQT # (IN A-REGISTER) AND TO CALL * A SUBROUTINE TO CONSTRUCT THE EQT * ENTRY ADDRESSES. * IODNS HLT 2 HLT FOR INIT CODE STA B ERROR CMB,INB,SZB IF EQT NO. IS ZERO SSA OR NEGATIVE CCB,RSS SKIP ADB EQT# CHECK FOR LIMITS SSB IF ANY ERROR, JMP $INER GO TO $MESS ERROR EXIT. JSB $CVEQ SET EQT ENTRY ADDRESSES. STB CONFL SET ALL THE FLAGS TO ZERO. JMP IODNS,I SKP * **************************************************************** * * ' UP ' STATEMENT (REQUIRED) * * FORMAT: UP,NN WHERE NN IS THE EQT # * OF THE I/O DEVICE * * ACTION: THE AVAILABILITY FIELD OF THE REFERENCED SLOT(EQT ENTRY * #)IS SET = 0 (UNIT AVAILABLE). THE AVAILABILITY FIELD OF * ANY DEVICES(BIT 15 DRT WORD 2) REFERENCING THIS EQT ARE * SET = 0 AND THE LU'S' I/O QUEUES ARE ADDED TO THE EQT'S * I/O QUEUE. IF THE EQT WAS AVAILABLE OR DOWN, THEN THE * *IOCOM* SECTION(AT *L.68*)IS ENTERED TO INITIATE ANY * WAITING I/O REQUESTS. * * CALL (FROM MESSAGE PROCESSOR): * * := NN (EQT #) IN BINARY * JMP $IOUP * * RETURN IS MADE TO *IOCOM* OR TO *$XEQ* IF ANY ACTION * IS TAKEN. IF NN IS ILLEGAL, THEN RETURN IS MADE TO * *MESS,I* TO PRINT 'INPUT ERROR'. * ****************************************************************** * $IOUP JSB IODNS CHECK 'NN' AND SET EQT ADDRESSES. $UPIO EQU * JSB $RSM GO RESTORE USER MAP IN CASE DRIVER CALL JSB CPEQT GET EQT # STA TMP1 FROM EQT1. LDA .4 RESCHEDULE ALL WAITING PGMS. JSB $SCD3 (RETURN B=0). JSB CLDMA HELP POWER FAIL OUT WITH DMA. * JSB XUPIO SET ANY ASSOCIATED LU'S UP. * mLDA EQT5,I GET AVAILABILITY ISZ CONFL SET THE CONTROL FLAG SSA,RSS IF DOWN OR AVAIL. JMP L.60 GO TRY TO OPERATE JMP $XEQ ELSE JUST FORGIT IT. SKP * ************************************************************************* * * SUBROUTINE XUPIO: * * XUPIO IS USED TO UP ANY LU'S ASSOCIATED WITH THIS EQT. * * CALLING SEQUENCE: * :=THE ADDRESS OF THE FIRST WORD OF THIS EQT. * :=THE EQT NUMBER. * JSB XUPIO * * RETURN: * ALL REGISTERS ARE DISTROYED. * USES TMP2,TMP4,TMP6. * CALLS SUBROUTINE XXUP. * ************************************************************************* * XUPIO NOP LDA LUMAX SET CMA,INA UP STA TMP2 COUNTER. LDB DRT POSITION TO FIRST STB TMP6 DRT ENTRY. * UPIO1 LDA TMP6,I CHECK IF THIS AND B77 DRT ENTRY POINTS CPA TMP1 TO THE EQT. JMP UPIO5 YES. UPIO3 ISZ TMP6 NO. SO ISZ TMP2 GO CHECK JMP UPIO1 NEXT DRT ENTRY. JMP XUPIO,I RETURN. * UPIO5 LDB TMP6 POSITION TO DRT ADB LUMAX WORD2. STB TMP4 GO PLACE LDB B,I ENTRIES LDA EQT1 INTO EQT JSB $XXUP I/O QUEUE(RETURN B=0). STB TMP4,I SET THE LU 'UP'. JMP UPIO3 GO CHECK NEXT DRT ENTRY. SKP **************************************************************** * * SUBROUTINE $XXUP: * * $XXUP TAKES AN I/O QUEUE AND(USING LINK)POSITIONS THE I/O * REQUESTS IN THE CURRENT EQT QUEUE ACCORDING TO THEIR PRIORITY. * IT RETURNS A FLAG IF AN I/O OPERATION SHOULD BE INITIATED. * * CALLING SEQUENCE: * := EQT1 OF OLD DEVICE. * :=ADDRESS OF FIRST STACKED I/O REQUESTS TO BE LINKED ON * THE CURRENT EQT(SIGN BIT WILL BE STRIPPED). * JSB $XXUP * * RETU~RN: * :=0 * :#0 A NEW I/O OPERATION IS AT THE HEAD OF THE CURRENT * EQT I/O QUEUE SO IT MUST BE INITIATED. = * THE ADDRESS OF THE FIRST WORD OF THE EQT. * USES TEMP1,TEMP2,UNLK8,TEMP4,XXUP7 * ***************************************************************** * $XXUP NOP STA TEMP4 SAVE OLD DEVICE EQT1. RSA SAVE MEU RAL,RAL STATUS. STA UNLKS SJP *+2 CLA CLEAR STA XXUP7 INITIATION FLAG. RBL,CLE,ERB STRIP OFF POSSIBLE SIGN BIT. XXUP9 SZB,RSS RETURN WHEN END OF I/O JMP XXUP2 REQUEST QUEUE IS FOUND. * STB TEMP1 SET UP POINTER FOR LINK. ADB B176K IF POINTER IS < 2000, SSB THEN NO I-O STACKED ON JMP XXUP2 THIS LU SO EXIT B=0. * LDB TEMP1 OTHERWIZE, GET I-O REQUEST ADDRESS. LDA B,I UNLINK THIS STA UNLK8 I/O REQUEST. INB LDA B,I GET INB PRIORITY RAL OF THE SSA I-O REQUEST JMP XXUP8 SLA,RSS BUFFERED AND CLASS I-O REQUESTS. JMP XXUP5 NORMAL USER REQUEST. LDA TEMP4 SYSTEM REQUEST. ADA .4 LDA A,I AND B36K CHECK IF THE OLD DEVICE CPA B14K IS A DISK OR NOT. JMP XXUP1 CLA IF OLD DEVICE IS NOT A DISK, STA TEMPL SET TEMPL=0 AND USE JMP XXUP3 ZERO PRIORITY. XXUP1 STA TEMPL IF OLD DEVICE IS A DISK, THEN INB,RSS SET TEMPL#0 AND USE PRIORITY. XXUP5 ADB .4 XXUP8 LDA B,I XXUP3 STA TEMP2 SAVE PRIORITY FOR LINK. JSB LINK LINK THIS REQUEST ONTO THE EQT. LDA EQT1 SEZ,RSS IF ONLY REQUEST ON THE EQT, THEN STA XXUP7 STORE INTO THE INITIATION FLAG. LDB UNLK8 LOOP FOR NEXT JMP XXUP9 I/O REQUEST. * XXUPy2 CLB SET B=0. LDA XXUP7 GET INITIATION FLAG JRS UNLKS $XXUP,I AND RETURN. * XXUP7 NOP B176K OCT 176000 HED < I/O CONTROL MODULE - SUBROUTINE SECTION > * * SUBROUTINE: < $SYMG > (SYSTEM MESSAGE) * * PURPOSE: THIS ROUTINE PROVIDES FOR THE * OUTPUT OF SYSTEM MESSAGES AND * ERROR DIAGNOSTICS ON THE SYSTEM * TELETYPEWRITER. THE ROUTINE * MAINTAINS A 'ROTATING' BUFFER * AREA CONSISTING OF 5 10-WORD * BLOCKS - I.E., THE MAXIMUM * LENGTH OF A MESSAGE IS 18 * CHARACTERS (9-WORDS) PLUS 1 * WORD PRECEDING THE MESSAGE * WHICH CONTAINS THE CHARACTER * COUNT. * * CALL: (A) = ADDRESS OF FIRST WORD OF * MESSAGE BLOCK - THIS WORD * CONTAINS THE CHARACTER * LENGTH OF THE MESSAGE AS * A NEGATIVE VALUE. * * (P) JSB $SYMG * (P+1) -RETURN- * * ON RETURN: * (A) = 0 - MESSAGE ACCEPTED AND * MOVED TO BUFFER. * (A) NOT = 0 - BUFFER FILLED, * MESSAGE REJECTED * (E) = 0 * * $SYMG NOP JMP SBUF CHANGED TO CLE ON FIRST ENTRY * LDB SY# IF BUFFER CPB .5 IS FILLED, JMP $SYMG,I REJECT EXIT. * LDB SYC SET CURRENT STB SYT1 ENTRY ADDRESS FOR MOVE MVW .10 MOVE THE WORDS. * ISZ SY# INCREMENT COUNT ENTRY. LDB SYC (B) = CURRENT ENTRY ADDRESS. LDA SYT1 ADA .10 (A) = NEXT ENTRY ADDRESS. CPA SBL IF NEXT EXCEEDS BUFFER, LDA SBF RESET TO FWA BUFFER STA SYC AND SAVE. * LDA SY# IF ENTRY. CPA .1 COUNT = 1, JSB SYSCL INITIATE OUTPUT. * CLA,CLE (A) = 0 FOR EXIT WITH JMP $SYMG,I MESSAGE ACCEPTED. * * CALL <$XSIO>Ss TO INITIATE OUTPUT * SYSCL DEF MX2 ADDRESS FOR INIT CODE LDA B,I GET THE MESSAGE LENGTH STA SYS7 SET IN THE CALL INB STEP TO BUFFER ADDRESS STB SYS6 SET IN THE CALL JSB $XSIO OCT 1 - LOGICAL UNIT 1 - SYS TTY DEF SYS8 - COMPLETION ROUTINE ADDRESS NOP OCT 2 - ASCII WRITE - SYS6 NOP MESSAGE ADDRESS SYS7 NOP MESSAGE LENGTH NOP SAYS DO NOT NEED USER MAP JMP SYSCL,I * * COMPLETION ROUTINE FROM I/O CALL * SYS8 CCA SUBTRACT 1 FROM ADA SY# ENTRY COUNT FOR STA SY# MESSAGE JUST OUTPUT. SZA,RSS IF NO MORE IN BUFFER, JMP $XEQ EXIT. * LDB SYS6 SET ADB .9 NEXT ENTRY CPB SBL ADDRESS LDB SBF JSB SYSCL INITIATE OUTPUT JMP $XEQ -EXIT. * SY# NOP SYT1 NOP SYC DEF SBUF SBF DEF SBUF SKP * SUBROUTINE: <$CVEQ> * * PURPOSE: THIS ROUTINE CONVERTS AN EQT * ENTRY # TO AN EQT DISPLACEMENT * AND CALLS <$ETEQ> TO SET THE * ENTRY ADDRESSES. * * CALLING SEQUENCE: * * (A) = EQT ENTRY # IN LOWER 6 BITS. * * (P) JSB $CVEQ * (P+1) -RETURN- REGISTERS MEANINGLESS * * $CVEQ NOP AND B77 MASK TO LOW BITS ADA N1 SUBTRACT 1 AND MPY .15 MULTIPLY BY 15 ADA EQTA ABSOLUTE ADDRESS. * JSB $ETEQ SET ALL 15 ADDRESSES. * JMP $CVEQ,I -RETURN- * * SUBROUTINE: * * PURPOSE: THIS ROUTINE COMPUTES THE ENTRY # * OF THE ENTRY DESCRIBED BY -EQT1-. * * CALLING SEQUENCE: (P) JSB CPEQT * (P+1) - RETURN - * ON RETURN, (A) = EQT # * (E) = 1 * * CPEQT NOP LDA EQTA SUBTRACT DEVICE CMA,INA EQT ENTRY ADDRESS ADA EQT1 FROM: FWA OF EQT. CLB CLEAR B FOR DIVIDE DIV .15 DIVIDE BY 15 CCE,INA SET E FOR CONVERSION/ADJUST COUNT. JMP CPEQT,I SKP * SUBROUTINE: < $ETEQ > * * PURPOSE: THIS ROUTINE SETS THE ADDRESSES * OF THE 15 WORDS OF AN * EQUIPMENT TABLE ENTRY IN THE * 15 WORDS IN BASE PAGE COMMUNICATION * AREA LABELLED -EQT1- TO -EQT15-. * * CALLING SEQUENCE: * * (A) - STARTING ADDRESS OF THE EQT * ENTRY FOR THE REFERENCED * I/O UNIT. * * (P) JSB $ETEQ * (P+1) - RETURN - (A),(B) MEANINGLESS * * THERE ARE NO ERROR RETURNS OR * ERROR CONDITIONS DETECTED. * * $ETEQ NOP STA EQT1 INA STA EQT2 INA STA EQT3 INA STA EQT4 INA STA EQT5 INA STA EQT6 INA STA EQT7 INA STA EQT8 INA STA EQT9 INA STA EQT10 INA STA EQT11 INA STA EQT12 INA STA EQT13 INA STA EQT14 INA STA EQT15 JMP $ETEQ,I * * SKP * * SPECIAL SECTION "I/O CLEAR " * ENTRY POINT IS "$IOCL" * * PURPOSE: THE FUNCTION OF THIS ROUTINE * IS TO REMOVE A PROGRAM FROM AN * I/O HANG-UP CONDITION RESULTING * FROM AN INPUT REQUEST NOT BEING * COMPLETED BY THE DEVICE. * * THIS "CLEARING" PROCEDURE IS * INITIATED BY THE OPERATOR IN * USING THE I/O ABORT VERSION OF THE * "OF,XXXXX,1" COMMAND. THE "OF" * STATEMENT PROCESSOR IN 'SCHED' * CALLS THIS SECTION IF THE REF- * ERENCED PROGRAM IS SUSPENDED * FOR AN I/O INPUT REQUEST. * * PROCESS: THE LIST OF EACH EQT ENTRY * IS SEARCHED TO FIND THE QUEUED * REQUEST CORRESPONDING TO THE * ID SEGMENT OF THE REFERENCED * PROvGRAM. THE ENTRY IS REMOVED * FROM THE LIST AND THE LIST IS * APPROPRIATELY LINKED TO REFLECT * THE CHANGE. * * IF THE ENTRY WAS THE FIRST ONE * IN THE LIST (I.E. THE ACTIVE * REQUEST), THE DEVICE'S DRIVER IS * CALLED WITH A CLEAR REQUEST (CONTROL * WITH ZERO SUBFUNCTION. IF THE DRIVER * ACCEPTS THE REQUEST (A=0 ON RETURN) THEN * EQT1 SIGN BIT IS SET AND A 1 SEC. TIME OUT * IS SET UP. (THIS TIME OUT IS TRAPED BY THE * SYSTEM AND IS NEVER GIVEN TO THE DRIVER). * $ABRT IS CALLED TO ABORT THE PROGRAM AND * CONTROL IS TRANSFERRED TO "$XEQ" * IF THE DEVICE WAS NOT CLEARED * OR TO "IOCOM" TO INITIATE THE NEXT STACKED * REQUEST (OR TO ALLOCATE THE DMA CANNEL) * * CALLING SEQUENCE: * * (A)= ID SEGMENT ADDRESS OF PROGRAM * * (P) JMP $IOCL * * -NO RETURN - * * SKP ENT $IOCL * $IOCL STA TEMP1 SAVE ID SEGMENT ADDRESS. SJP *+2 LDA EQT# SET TEMP2 = NEGATIVE CMA,INA NUMBER OF EQT STA TEMP2 ENTRIES. LDA EQTA INITIALIZE FOR * IOCL STA IOCL5 EQT ENTRY WORD IOCL0 STA IOCL6 1 ADDRESS. * LDA A,I CLEAR SIGN ,SET E IF SIGN WAS SET RAL,CLE,ERA GET LINK ADDRESS. CPA TEMP1 JUMP IF A JMP IOCL2 MATCH TO PROGRAM. * SZA IF NOT END OF LIST, JMP IOCL0 CONTINUE SCAN. * LDA IOCL5 SET (A) = ADDRESS OF ADA .15 NEXT EQT ENTRY. ISZ TEMP2 IF NOT END OF EQT, GO JMP IOCL TO SCAN NEXT ENTRY LIST. * * SCAN ALL DRT WORD 2 I/O QUEUES * LDA LUMAX SET TEMP2 = NEGATIVE CMA,INA NUMBER OF DRT STA TEMP2 ENTRIES. LDA DRT INITIALIZE ADA LUMAX FOR FIRST STA IOC50 DRT WORD IOC41 STA IOC51 TWO. * LDA A,rNLHI CLEAR SIGN, SET E IF SIGN SET. RAL,CLE,ERA GET LINK. CPA TEMP1 JUMP IF A MATCH JMP IOC62 TO A PROGRAM. * SZA IF NOT END OF LIST, JMP IOC41 CONTINUE SCAN. * ISZ IOC50 SET = NEXT LDA IOC50 ADDRESS OF NEXT ISZ TEMP2 DRT WORD 2. JMP IOC41 IF NOT END OF DRT, CONTINUE SCAN. JMP IOC63 IF END,NOT FOUND.MUST BE PROGRAM SO ABORT. SKP * * PROGRAM REQUEST FOUND IN DRT, UNLINK REQUEST. * IOC62 LDB A,I GET NEXT LINK, PROPOGATE RBL,ERB SIGN IF SIGN WAS SET AND STB IOC51,I STORE IN PREVIOUS LINK. * IOC63 LDA TEMP1 CHECK IF THIS ISZ TEMP1 IS A SYSTEM LDB TEMP1,I REQUEST. SSB,RSS IF SO SKIP ABORT. JSB $ABRT 'ABORT PROGRAM' JMP $XEQ RETURN. * * PROGRAM REQUEST ENTRY FOUND IN EQT, UNLINK REQUEST. * IOCL2 LDB A,I GET NEXT LINK AND SET RBL,ERB PROPOGATE SIGN IF SIGN SET STB IOCL6,I IN PREVIOUS LINK. * LDA TEMP1 "ABORT ISZ TEMP1 CHECK IF THIS IS A N LDB TEMP1,I SYSTEM REQUEST SSB,RSS IF SO SKIP ABORT JSB $ABRT PROGRAM" * LDA IOCL5 IF PROGRAM REQUEST LDB IOCL6,I CPA IOCL6 WAS CURRENT ENTRY, SSB AND NOT NOW CLEARING SKIP TO CLEAR DEVICE. JMP $XEQ -EXIT TO $XEQ. SKP JSB $ETEQ JSB CLDMA CLEAR ANY DMA CHANNEL ASSIGNED LDA B3.I GET CLEAR REQUEST (100003B) STA EQT6,I SET IN EQT LDA EQT5,I GET CURRENT STATUS RAL,CLE IF DOWN OR IN DMA SSA WAIT JMP $XEQ JUST LEAVE IT ALONE * ERA ELSE SET NOT BUSY STA EQT5,I AND PLANT LDA EQT4,I GET THE SELECT CODE LDB EQT2,I AND THE I.XX ADDRESS AND B77 ISOLATE THE SELECT CODE AND JSB B,I RUN THE DRIVER * * IF REQUEST ACCEPTED THEN WE MUST SET UP FOR AN INTERRUPT BY * * A) SETTING THE DEVICE BUSY * B) SETTING A TIME OUT (1 SEC. IS ARBITRARILY USED) * * IF REQUEST IS NOT ACCEPTED OR IS COMPLETED THEN: * * A) ZAP TIME OUT AND * B) GO TO IOCOM TO GET THE NEXT REQUEST * CLB,CCE FIRST ZAP TIME OUT STB EQT15,I LDB EQT1,I SET THE SIGN BIT IN EQT1 RBL,ERB FOR IOCOM (NOW OR LATER) STB EQT1,I CCE,SZA INTERRUPT EXPECTED? JMP IOCOM NO SO JUST GO TO IOCOM * LDA EQT5,I YES SO SET RAL,ERA BUSY STA EQT5,I AND LDA N100 SET UP STA EQT15,I A REASONABLE TIME OUT JMP $XEQ GO TO THE DISPATCHER * SPC 1 IOCL5 NOP IOCL6 NOP IOC50 NOP IOC51 NOP SKP * * ROUTINE TO CLEAR DMA CHANNEL IF ASSIGNED TO DEVICE * CLDMA NOP LDB INTBA GET THE INTERRUPLE ADDRESS TO B LDA B,I AND DMA 6 ENTRY TO A RAL,CLE,ERA CLEAR THE SIGN BIT CPA EQT1 THIS CHANNEL ASSIGNED? CLA,RSS YES- SKIP JMP IOCL3 @NO TRY NEXT CHANNEL * CLC 6 CLEAR CHANNEL STF 6 6. STA B,I SET IT AVAILABLE IN INTBA SPC 1 IOCL3 INB STEP TO DMA 7 ENTRY LDA B,I GET TO A AND RAL,CLE,ERA CLEAR THE SIGN BIT CPA EQT1 THIS CHANNEL ASSIGNED? CLA,RSS YES - SKIP JMP CLDMA,I NO - EXIT CHANNELS CLEARED * CLC 7 CLEAR CHANNEL 7 STF 7 AND STA B,I MAKE IT AVAILABLE. JMP CLDMA,I * * ROUTINE TO CLEAR ALL CHANNELS SERVICED BY EQT ENTRY * CLCHS NOP JSB CLDMA CLEAR DMA CHANNEL IF ASSIGNED LDA INTLG STORE INTERRUPT CMA,INA TABLE LENGTH- ADA .2 RELATED INDEX STA TEMPW LDA CLR10 STORE INITIAL STA CLCSC CLC S.C. LDA INTBA INSTRUCTION ADA .2 CLRNX LDB A,I GET NEXT TABLE ENTRY- CPB EQT1 DOES IT REFERENCE THIS EQT? CLCSC CLC 00B YES-GO CLEAR IT ISZ TEMPW THRU TABLE? INA,RSS NO-INDEX TO NEXT ENTRY JMP CLCHS,I YES-EXIT * ISZ CLCSC JMP CLRNX * CLR10 CLC 10B B3.I DEF 3,I N100 DEC -100 HED * $SYMG BUFFER AND PRIVLEDGE I/O CONFIGURE SECTION * * SBUF BSS 50 ORG SBUF PUT IOC CONFIGURING ROUTINE IN BUFFER STA SBUF SAVE THE A REG. CLA STA $ZZZZ ZERO THE ABORT LIST STA DUMMY,I ZAP THE PRIV. TRAP CELL. LDA DUMMY GET THE DUMMY I/O ADDRESS SZA,RSS IF NONE JMP NOPRV GO EXIT * ADA CLCP CONFIGURE THE DUMMY ADDRESSES STA CLC2,I USE INDIRECTS TO AVOID LINKS XOR STCP MAKE STC STA STC2,I STC STA STCP SET IN LINE TOO XOR STFP STF STA STF2,I AND STF STA STFP NEED THIS IN LINE ALSO STCP OCT 4000 SET UP THE PRIV. CARD STFP OCT 600 NOW FOR DISC DRIVERS ETC. NOPRV LDA %4TMP1 REPLACE CALL TO HERE STA $SYMG+1 WITH A CLE JSB DIR TRACK DOWN ALL THE INDIRECTS DEF DCLAS CMA,INA SET NEGATIVE STA DDMCL,I AND SET AGAIN JSB DIR ALSO NEED DEF D$RN FOR RN TABLE JSB DIR AND FOR DEF D$LUT LU TABLE LDB DL.12 GET DEF TO L.012 FOR LDA PDSK DISC PROTECT OPTION SZA PROTECT?? STB DPOPI,I YES, SET IT UP LDA SBUF RESTORE A JMP TMP2,I GO TO TEMP BUFFER TO SET UP X,Y * DIR NOP SUBROUTINE TO TRACK DOWN DIRECT ADDRESS LDA DIR,I GET ADDRESS OF DEF STA B AND SAVE IT LDA A,I GET DEF THAT IS INDIRECT RAL,CLE,SLA,ERA CLEAR A LEVEL JMP *-2 IF MORE LOOP * STA B,I SET THE DIRECT ADDRESS ISZ DIR STEP OVER THE ADDRESS JMP DIR,I AND RETURN * SPC 2 PDSK DEF $PDSK DL.12 DEF L.012 CLCP CLC 0 DPOPI DEF DPOPT STC2 DEF SW1 STF2 DEF STF1 CLC2 DEF SW2 LOCAL DEFS TO AVOID LINKS DDMCL DEF MCLAS SPC 1 L EQU 50+SBUF-* ERROR HERE MEANS WE RAN OUT OF BUFFER ORR LEAVE THE BUFFER SBL DEF * HED ** SYSTEM BASE PAGE COMMUNICATION AREA ** XI EQU 1647B . EQU 1650B ESTABLISH ORIGIN OF AREA * * SYSTEM TABLE DEFINITION * * EQTA EQU .+0 FWA OF EQUIPMENT TABLE EQT# EQU .+1 # OF EQT ENTRIES DRT EQU .+2 FWA OF DEVICE REFERENCE TABLE LUMAX EQU .+3 # OF LOGICAL UNITS (IN DRT) INTBA EQU .+4 FWA OF INTERRUPT TABLE INTLG EQU .+5 # OF INTERRUPT TABLE ENTRIES TAT EQU .+6 FWA OF TRACK ASSIGNMENT TABLE KEYWD EQU .+7 FWA OF KEYWORD BLOCK * * I/O MODULE/DRIVER COMMUNICATION * EQT1 EQU .+8 ADDRESSES EQT2 EQU .+9 EQT3 EQU .+10 OF EQT4 EQU .+11 EQT5 EQU .+12 CURRENT EQT6 EQU .+13 EQT7 EQU .+14 15-WORD EQT8 EQU .+15 EQT9 EQU .+16 EQT EQT10 EQU .+17 EQT11 EQU .+18 ENTRY EQT12 EQU .+81 EQT13 EQU .+82 EQT14 EQU .+83 EQT15 EQU .+84 * CHAN EQU .+19 CURRENT DMA CHANNEL # TBG EQU .+20 I/O ADDRESS OF TIME-BASE CARD SYSTY EQU .+21 EQT ENTRY ADDRESS OF SYSTEM TTY * * SYSTEM REQUEST PROCESSOR /'EXEC' COMMUNICATION * * RQCNT EQU .+22 # OF REQUEST PARAMETERS -1 RQRTN EQU .+23 RETURN POINT ADDRESS RQP1 EQU .+24 ADDRESSES RQP2 EQU .+25 RQP3 EQU .+26 OF REQUEST RQP4 EQU .+27 RQP5 EQU .+28 PARAMETERS RQP6 EQU .+29 RQP7 EQU .+30 (SET FOR MAXIMUM OF RQP8 EQU .+31 RQP9 EQU .+32 9 PARAMETERS) * * DEFINITION OF SYSTEM LISTS (QUEUES) * * SKEDD EQU .+33 'SCHEDULE' LIST, SUSP2 EQU .+35 'WAIT' LIST, SUSP3 EQU .+36 'AVAILABLE MEMORY' LIST, SUSP4 EQU .+37 'DISC ALLOCATION' LIST, SUSP5 EQU .+38 'OPERATOR SUSPEND' LIST * * DEFINITION OF EXECUTING PROGRAM ID SEGMENT' * * XEQT EQU .+39 ID SEGMENT ADDR. OF CURRENT PROG. XLINK EQU .+40 'LINKAGE' XTEMP EQU .+41 'TEMPORARY (5-WORDS) XPRIO EQU .+46 'PRIORITY' WORD XPENT EQU .+47 'PRIMARY ENTRY POINT' XSUSP EQU .+48 'POINT OF SUSPENSION' XA EQU .+49 'A REGISTER' AT SUSPENSION XB EQU .+50 'B REGISTER' XEO EQU .+51 'E AND OVERFLOW * * SYSTEM MODULE COMMUNICATION FLAGS * * OPATN EQU .+52 OPERATOR/KEYBOARD ATTENTION FLAG OPFLG EQU .+53 OPERATOR COMMUNICATION FLAG SWAP EQU .+54 RT DISC RESIDENT SWAPPING FLAG DUMMY EQU .+55 I/O ADDRESS OF DUMMY INT. CARD IDSDA EQU .+56 DISC ADDR. OF FIRST ID SEGMENT IDSDP EQU .+57 -POSITION WITHIN SECTOR * * DEFINITION OF MEMORY ALLOCATION BASES * * BPA1 EQU .+58 FWA R/T DISC RES. BP LINK AREA BPA2 EQU .+59 LWA R/T DISC RES. BP LINK AREA BPA3 EQU .+60 FWA BKG DISC RES. BP LINK AREA LBORG EQU .+61 FWA OF RESIDENT LIBRARY AREA RTORG EQU .+62 FWA OF REAL-TIME AREA RTCOM EQU .+63 LENGTH OF REAL TIME COMMON AREA RTDRA EQU .+64 FWA OF R/T DISC RESIDENT AREA AVMEM EQU .+65 FWA OF SYSTEM AVAILABLE MEMORY BKORG EQU .+66 FWA OF BACKGROUND AREA BKCOM EQU .+67 LENGTH OF BACKGROUND COMMON AREA BKDRA EQU .+68 FWA OF BKG DISC RESIDENT AREA * * UTILITY PARAMETERS * TATLG EQU .+69 LENGTH OF TRACK ASSIGNMENT TABLE TATSD EQU .+70 # OF TRACKS ON SYSTEM DISC SECT2 EQU .+71 # SECTORS/TRACK ON LU 2 (SYSTEM) SECT3 EQU .+72 # SECTORS/TRACK ON LU 3 (AUX.) DSCLB EQU .+73 DISC ADDR OF RES LIB ENTRY PTS DSCLN EQU .+74 # OF RES LIB ENTRY POINTS DSCUT EQU .+75 DISC ADDR OF RELOC UTILITY PROGS DSCUN EQU .+76 # OF RELOC UTILITY PROGS LGOTK EQU .+77 LOAD-N-GO: LU,STG TRACK,# OF TRKS LGOC EQU .+78 CURRENT LGO TRACK/SECTOR ADDRESS SFCUN EQU .+79 SOURCE FILE LU AND DISC ADDRESS MPTFL EQU .+80 MEMORY PROTECT ON/OFF FLAG (0/1) FENCE EQU .+85 MEM PROTECT FENCE ADDRESS BKLWA EQU .+87 LWA OF MEMORY IN BACKGROUND * ORG * LENGTH OF RTIOC END $CIC  ]n 92060-18017 A S C0122 $ALCM              H0101 w$ASMBҬ̬ HDA-MŠUVŠMMYAAN DA:5055 NAM:$AM SU:9060-0 :9060-60 PGM:G.A.A...A. (éPYGHԠH-PAKADMPANY95.A̠GHS SVD.NϠPAԠƠHSPGAMMAYBŠPHPD PDUDҠANSADϠANHҠPGAMANGUAGŠHUԪ HŠPҠNNSNԠƠH-PAKADMPANY. NAM$Aì09060-60V.A50505 NԠ$Aì$N Ԡ$SԬ$K PGAMM:G.A.ANZNGҠHPAMDMAY0BS UN USSMAYBŠMADŠϠAAŠANDASŠBUS MHŠMMYAVAABŠAҠADNG. .AA:ANGSUNŠ- (PSB$A (P+(ƠDSNDD (P+-UNNϠMMYVҠ(A-(BMAؠV (P+3-UNNϠMMYNנ(A0(BMAؠN (P+-UNK(AADDҠ(BSZŠҠSZ+ .ASŠBUҠϠAVAABŠMMY (PSB$N (P+(AƠBUҩ (P+(ƠDSUND (P+3-UN-(A̠GSSDSYD ƠAUSԠҠABUҠƠNGHؠANNԠBŠD DUNGAGVNA̬UNSMADŠH: (A0 ƬHNBUҠUSD-(AVMM-SHSNSUNԠ AVAABŠϠNANABUҠƠHŠNGHUSD HNUNSMADŠH: (A- (BMAMUMNGHBUҠHAԠHŠPGAMMAYAA. ϠNDUԠHנAGŠABUҠMAYBŠAADUSŠHŠA SB$A Dà36 BKSƠMMYAVAABŠҠUPUԠBUNGy,AŠNKDHUGH HŠSԠϠDSƠAHBK- D-NGHƠBK D-ADDSSƠNԠBK(ҠƠHSSASԠBK HŠAAҠ'ANSS'HŠUPPҠNDƠABKϠàAND SHNSHŠNGHƠHŠBKBYHŠAMUNԠ'ANSD' GSSAŠNԠPSVD SKP SKP $AàMPANNԠ(M$SԬUNSϠ$K SASŠMUSAUSNMM A̬A SAAS SP+ DA$AìɠGԠHŠNGHƠHŠUS SAADؠANDSAVŠ SAMPɠSAVŠNDSGNASŠSUSPND DBA ADAAVMMNUGHMMYN SSAϠHNҠHŠUS? MP.AYSGϠAA. ADBMAV SSBSSHAԠABUԠA? MPNNV! SZ$AàMAYBŬBUԠNԠN. ʠAŬSSA0Ž0NԠN NAŠA-Ž0NԠV MPSBUN .ASZ$AàYANAAN ASԠŠAVA.NנϠ0 SAAN DBPNASAԠHŠSAHPH .ASBBADSԠASԠBUҠADDSS ŬNBSPϠHŠNԠADDSS DBBɠGԠHŠNԠSGMNԠADDSS PBMƠHNNDƠSԠANDN MPNMҠMMYSϠ DABɠHKϠSŠƠHSSH ADAANAGSԠNGHSϠA DABɠGԠHŠNGH MASZSԠNG(-AND SAANAGSԠSϠAҠSAV ADAADؠ̠ԠSASYHŠUS? MASSAƠZϠҠNGAVŠUSŠ MP.ASŠGϠYNԠN ADADMSBKAԠASԠDS ŬSSAAGҠHANUS? MP.AN-AAŠHŠBK ADAD(ANGH(ɩ-(ة SABɠSԠNנ(ɩ ADArB(ABUҠADDSS MPSAUNϠUS .ADABɠAAŠNŠBK. SAADؠSԠBUҠNGH SBABUҠADDSSϠA ŬNBSԠŠҠAPDUN DBBɠGԠHŠPNҠϠHŠNԠBK SZBADSPϠPNҠADDSSNAS SBBADɠBKANDSԠHŠPN SASZ$A SBDBMAVSԠBҠ SZASSƠUSԠҠNנSԠϠMA DBAVMMAVAABŠN MBSZSԠPSVŠANDƠUS DBADؠSASDSԠϠNGH SZ$AàSPUNADDSS SASԠ$AìɠUNSŠSAUSϠMU ASԠBSS NMҠDAANPKUPMAؠԠDUNGSAH SAAVMMUPDAŠMAؠAVAABŠN MPʠNנUN $NNPNYPNԠҠBUҠUN SASŠMUSAUS A̬A SAAS SP+ DA$Nɠ(AAUNBUҠ(ADة SAAD MANASԠNGAND SASAVASAV SZ$N DA$NɠƠDSUND(ة ADADM SSA PROGRAM DESCRIPTION ***** * * THE PRIMARY FUNCTION OF THIS PROGRAM IS * TO PROVIDE GENERAL CHECKING AND EXAMINATION * OF SYSTEM SERVICE REQUESTS AND TO CALL THE * APPROPRIATE PROCESSING ROUTINE IN OTHER * SECTIONS OF THE REAL-TIME EXECUTIVE. * * THIS PROGRAM IS CALLED DIRECTLY FROM THE * CENTRAL INTERRUPT CONTROL SECTION * WHEN A MEMORY PROTECT VIOLATION IS ACKNOWLEDGED. * ALL SYSTEM REQUESTS BY A USER PROGRAM CAUSE A * PROTECT VIOLATION. * * SYSTEM REQUEST FORMAT: * ---------------------- * * THE GENERAL FORMAT OF A SYSTEM REQUEST IS * A BLOCK CONTAINING AN EXECUTABLE INSTRUCTION * TO GAIN ENTRY TO THE EXECUTIVE AND AN ADDRESS * LIST OF PARAMETERS. THE FIRST PARAMETER IS * A NUMERIC CODE IDENTIFYING THE REQUEST TYPE. * THE LENGTH OF THE PARAMETER LIST VARIES * ACCORDING TO THE AMOUNT OF INFORMATION RE- * QUIRED FOR EAn}CH REQUEST (OR VARIATIONS WITHIN * A SINGLE REQUEST). THIS FORMAT ALLOWS SYSTEM * REQUESTS TO BE SPECIFIED IN A FORTRAN CALL * STATEMENT IN ADDITION TO ASSEMBLY LANGUAGE FORMAT. * * CALL EXEC (P1,P2,...PN) * * OR * * EXT EXEC * JSB EXEC (CAUSES MEMORY PROTECT VIOLATION) * DEF *+1+N DEFINE EXIT POINT, N= # PARAMETERS * DEF RCODE DEFINE REQUEST CODE * DEF P1 DEFINE PARAMETER LIST, 1 TO N * . * . (PARAMETERS MAY BE INDIRECTLY * . REFERENCED, E.G. DEF P3,I) * DEF PN * - EXIT POINT - * * RCODE DEC N * P1 DEC/OCT/DEF,ETC TO DEFINE A VLAUE * * * RE-ENTRANT LIBRARY REQUEST * -------------------------- * * THE SYSTEM LIBRARY (RESIDENT) CONTAINS * PROGRAMS STRUCTURED IN 'RE-ENTRANT' FORMAT * OR IN 'PRIVILEGED' EXECUTION FORMAT. * * - RE-ENTRANT FORMAT ALLOWS A LIBRARY * PROGRAM TO BE RE-ENTERED BY A CALL FROM * A HIGHER-PRIORITY PROGRAM DURING THE * PROCESSING OF A CALL FROM A LOWER-PRIORITY * PROGRAM. * * - PRIVILEGED EXECUTION FORMAT ALLOWS A * SHORT-RUNNING LIBRARY PROGRAM TO BE EXECUTED * WITH THE INTERRUPT SYSTEM DISABLED. * * * * MEMORY PROTECT ERROR: * --------------------- * * IF THE INSTRUCTION CAUSING THE PROTECT VIOLATION * IS NOT A JSB EXEC OR A JSB TO LIBRARY * PROGRAM, THEN A USER PROGRAM ERROR IS * ASSUMED. A DIAGNOSTIC IS OUTPUT TO THE SYSTEM * TELETYPE LISTING THE PROGRAM NAME AND ADDRESS * OF VIOLATING INSTRUCTION AND THE PROGRAM IS * SET DORMANT IN THE PROGRAM ABORT PROCEDURE. * SKP ************MEU INSTRUCTIONS***************** EXEC NOP HLT 0 PROTECTION AGAINST DIRECT CALL. * $RQST LIB 5 GET ADDRESS OF VIOLATION. LIA 4 DO NOT REARRANGE!!! CPA D4 POWER FAIL? LDB $PWR5 YES, USE LAST INTERRUPT ADDR. STF 5 REENABLE PARoITY ERROR OPTION. STB VADR SAVE VIOLATION ADDRESS. STB XSUSP,I SET AS POINT OF SUSPENSION. STB $LIBR SAVE (P+1) OF ISZ $LIBR CALL. SFC 5 IF FLAG CLEAR,NOT MEU VIOL JMP MEUER UJP *+2 RBL,CLE,SLB,ERB CHECK FOR PARITY ERROR HLT 5 FOUND ONE!!!!! LDA B,I GET WORD. AND B074K ISOLATE INSTR. CODE. CPA JSBI IF INSTRUCTION IS JSB JMP *+2 CHECK OPERAND ADDRESS. JMP MPERR -MEMORY PROTECT ERROR- LDA B,I CHECK FOR EFFECTIVE AND B2000 ADDRESS SZA LINK THRU CURRENT PAGE? LDA VADR YES, USE CURRENT PAGE BITS XOR VADR,I MIRGE THE PAGE OFFSET AND G76 UNDER THE RULES OF WOO. XOR VADR,I NOW HAVE THE ADDRESS RAL,CLE,SLA,ERA IF INDIRECT INDR LDA A,I GET NEXT LEVEL RAL,CLE,SLA,ERA CHECK FOR MULTI LEVEL JMP INDR FOUND ONE SO LOOP (MUST END) * CPA EXECA -EXEC-. JMP R0 YES, REQUEST TO BE ANALYSED. CPA LIBRA -LIBRARY ROUTINE CALLING FOR JMP LIBRC RE-ENTRANT OR PRIVILEGED RUN. CPA LIBXA -LIBRARY ROUTINE RETURNING JMP LIBXC TO CALLER. * * CHECK FOR USER CALL TO LIBRARY PROGRAM * STA B SAVE OPERAND ADDRESS. LDA LBORG SUBTRACT LIBRARY CMA,CLE,INA AREA ORIGIN FROM ADA B OPERAND ADDRESS. LDA B (E = 0 IF SYSTEM VIOLATION ) CMA,SEZ,CLE,INA SKIP IF VIOLATION ALREADY ELSE ADA $SGAF TEST FOR ABOVE LIB. SEZ,RSS IF NOT CALL TO LIBRARY RESIDENT, JMP MPERR THEN VALID MEMORY PROTECT ERROR. LDA $LIBR -CALL TO LIBRARY. STA B,I SET (P+1) ADDRESS IN ENTRY POINT ADB D2 SET (P+1) OF STB $LIBR JSB $LIBR IN -$LIBR-. JMP LIBRC - TRANSFER TO $LIBR SECTION $SGAF NOP SSGA START ADR SPC 1 JSBI JSB 0 B074K OCT 074000 G76 OCT 76000 EXECA DEF EXEC RQP1A DEF RQP1 VADR NOP $PWR5 NOP ADDR OF INTERRUPT BEFORE POWER FAIL DM9 DEC -9 * * ANALYZE SYSTEM REQUEST * R0 LDA $LIBR,I (A) = RETURN ADDRESS OF JSB EXEC. ISZ $LIBR SET $LIBR TO FIRST PRAM. (RQ) ADDRESS. STA RQRTN SAVE IN BASE PAGE LDB $LIBR CACULATE THE NUMBER OF CMB,CLE PARAMETERS IN REQUEST ADB A LESS THE REQUEST CODE. STB RQCNT AND SAVE # OF ACTUAL PARAMETERS. STB A CMB,SEZ,CME SKIP IF RETURN IS BAD (< JSB +2) * ADA DM9 IS GREATER CLA,SEZ THAN JMP RQERR 8. * STA RQP2 ZERO STA RQP3 PARAMETER STA RQP4 STA RQP5 ADDRESS STA RQP6 STA RQP7 AREA STA RQP8 STA RQP9 * LDA RQP1A SET TEMP2 = STA TEMP2 ADDRESS OF RQP1 IN BASE PAGE STA TEMP3 SAVE FOR CALL BY NAME TEST R1 LDA $LIBR GET EFFECTIVE OPERAND ADDRESS. R1D1 LDA A,I FIRST LEVEL TO A SZA IF THROUGH A CPA D1 OR B JMP RQERR BAD NEWS FELLOW! * RAL,CLE,SLA,ERA REMOVE INDIRECT BIT SKIP IF DIRECT JMP R1D1 STILL INDIRECT GO TRY AGAIN. * STA TEMP2,I SET IN BASE PAGE. ISZ TEMP2 INDEX ISZ $LIBR ADDRESSES AND INB,SZB PARAMETER COUNT. JMP R1 - CONTINUE - SKP * CHECK LEGALITY OF REQUEST CODE * LDA RQP1,I GET REQUEST CODE LDB XEQT COMPUTE ADB D15 THE STATUS WORD STB TEMP1 ADDRESS AND SAVE LDB B,I GET STATUS RAL,CLE,ERA PUT ABORT OPTION BIT RBL,ERB IN SIGN OF STATUS STB TEMP1,I AND RESET IN ID-SEG. SSB IF OPTION SELECTED ISZ RQRTN STEP RETURN ADDRESS. STA RQP1 SAVE THE REQUEST CODE. SZA IF ZERO SKIP TO REJECT ADA CODE# IF RQUEST CODE IF NOT DEFINED MG SSA,RSS -THEN JMP RQERR TOUGH LUCK, YOUR A DEAD DUCK! * ADA RQTBL GET ADDRESS OF PROCESSOR TO A LDA A,I GET ADDRESS SZA,RSS IF NOT LOADED JMP RQERR THEN REQUEST CODE ERROR * STA VADR SAVE THE ADDRESS * * TEST EACH PRAMETER FOR BEING BELOW THE FENCE IF * THE CALL CAUSES A STORE TO THE AREA DEFINED. * LDB RQP1 USE REQUEST CODE CLE,ERB TO INDEX INTO ADB RQTBL THE BY NAME TABLE LDA B,I GET THE FLAG WORD LDB RQCNT GET THE NUMBER OF PRAMS TO CMB,SEZ,RSS TEST SET COUNT ALF,ALF ROTATE IF ODD REQUEST CODE STB TEMP1 SET PRAMETER COUNT * R3 ISZ TEMP3 STEP THE PRAMETER ADDRESS LDB TEMP3,I GET THE ADDRESS ISZ TEMP1 SKIP IF END OF LIST CMB,CLE,RSS SET UP FOR TEST AND SKIP JMP VADR,I GO EXERCISE THE REQUEST SLA,RAR IF FLAG NOT SET THEN ADB FENCE SKIP THE ADD CLB,SEZ,RSS SET B FOR ERROR SKIP IF ERROR JMP R3 NO ERROR GO TEST NEXT PRAM * LDA RQ1 SET A FOR ERROR JMP $ERAB GO SEND 'RQ00' ERROR SPC 1 D1 DEC 1 D2 DEC 2 D15 DEC 15 DM1 DEC -1 CODE# ABS TBL-TBLE-1 NEGATIVE OF NUMBER OF REQUEST+1 RQTBL DEF TBLE ADDRESS INDIRECT OF LAST + 1. HED ** SUPERVISORY CONTROL OF LIBRARY PROGRAM EXECUTION ** * * SUPERVISORY CONTROL OF PROGRAM LIBRARY EXECUTION * * ALL LIBRARY PROGRAMS REFERENCED BY USER PROGRAMS * IN THE SYSTEM ARE COMBINED IN A BLOCK OF MEMORY * WHICH IS PROTECTED FROM THE REAL-TIME AREA. THE * LIBRARY AREA IS IMMEDIATELY BELOW THE RT AREA * AND JUST ABOVE THE SYSTEM AREA. * * A USER LIBRARY CALL CAUSES A PROTECT VIOLATION. * THIS SECTION FACILITATES ENTRY INTO THE LIBRARY * PROGRAM BY PERFORMING THE NECESSARY PROCESSING * FOR RE-ENTRANCY OR OPERATING THE PROGRAM WITH H= * THE INTERRUPT SYSTEM TURNED OFF FOR A 'PRIVILEGED' * EXECUTION ŎPROGRAM. * * RE-ENTRANT OR PRIVILEGED PROGRAM FORMAT: * ---------------------------------------- * * ENTRY NOP * JSB $LIBR * DEF TDB (OR 'NOP' IF PRIVILEGED) * - FIRST INSTRUCTION FOR FUNCTION - * - CODE * - TO * - PERFORM * - PROGRAM FUNCTION * EXIT JSB $LIBX * DEF TDB (OR DEF ENTRY IF PRIVILEGED) * DEC N RETURN ADJUSTMENT FOR RE-ENTRANT * - * TDB NOP HOLDS SYSTEM POINTER TO ID-EXTENSION. * DEC N LENGTH OF TEMPORARY DATA BLOCK * NOP RETURN ADDRESS OF CALL. * - BLOCK USED FOR * HOLDING TEMPORARY * VALUES GENERATED * BY THE ROUTINE. * * * < $LIBR> IS ENTERED WHEN A LIBRARY * PROGRAM IS CALLED. IF THE CALLED * PROGRAM IS 'RE-ENTRANT' AND IS CALLED * DURING THE PROCESSING OF A PREVIOUS * CALL, THE TEMPORARY-DATA-BLOCK IS * MOVED INTO A BLOCK IN AVAILABLE MEMORY * BEFORE THE ROUTINE IS ENTERED. * * LIBRA DEF $LIBR * $LIBR NOP DIRECT ENTRY HAS TO BE PRIV. STA XA,I AND GOING DEEPER LDA $LIBR,I MAKE SURE SZA AND IF GOING RENT JMP MPERR SEND SOUTH INSTEAD. * LIBRX LDA XA,I RESTORE AND RETURN ISZ $LIBR SET RIGHT ADDRESS ISZ $PVCN AND STEP THE DEPTH COUNTER JMP $LIBR,I RETURN TO USER * LIBRC LDB $LIBR,I GET (P+2) OF -$LIBR- CALL. SZB,RSS IF (P+2) = 0, THEN CALLED PROGRAM JMP PVEXC IS IN 'PRIVILEGED' FORMAT. * STB TEMP1 SAVE -TDB- ADDRESS. LDA B,I GET WORD 1 OF DATA BLOCK. LDA A,I GET ID SEG ADDRESS OR ZERO RAL,CLE,ERA REMOVE POSSIBLE SIGN BIT CPA XEQT RECURSIVE ENTRY? JMP ERE01 YES GO ABORT HIM INB STEP TO LENGTH WORD IN TDB SZA IF BLOCK IN USE GET LENGTH LDA B,I ELSE ADA D4 USE JUSTz FOUR WORDS STA TEMP4 SAVE LENGTH FOR ALLOCATE CALL LDB DHED GET POINTER TO HEAD OF RENT LDA XEQT LIST ADA D20 CHECK IF ALREADY IN LIST STA TEMP3 SAVE ID-SEG POINTER LDA A,I GET THE STATUS WORD ALF,RAL BIT 10 IS RENT BIT SSA,RSS IF CLEAR THEN THIS IS FIRST ENTRY JMP RE2 SO GO SET UP * LDB XEQT NOT FIRST ENTRY SO FIND OTHERS JSB FINDL USING FINDL ROUTINE JMP ERE01 LIST ERROR ABORT THE PGM ADB D3 STEP TO SUB QUE HED RE2 STB TEMP2 SET POINTER TO LIST HEAD * JSB $ALC ALLOCATE THE MEMORY TEMP4 NOP NUMBER OF WORDS REQUIRED JMP NVRM IF NEVER ANY MEMORY, TRY 4 ONLY JMP LB05 NO MEMORY NOW, SUSPEND. CCE ALLOC DONE. * CPB TEMP4 DID WE GET THE REQUESTED NUMBER? B40 CLE YES CLEAR E AS A FLAG * XLB TEMP2,I GET OLD POINTER XSA TEMP2,I SET NEW BLOCK ADDRESS XSB A,I LINK OLD BLOCKS INTO THE LIST LDB XEQT GET THE ID-SEG ADDRESS SEZ,INA STEP A AND SKIP IF EXACT ALLOCATION ADB SIGN ELSE ADD SIGN BIT TO ID-ADDRESS XSB A,I SET IN WORD 2 STA TEMP4 SET TDB ADDRESS POINTER INA SET TO WORD 3 ADDRESS LDB TEMP1 SET TDB ADDRESS IN WORD THREE XSB A,I INA CLEAR CLB WORD XSB A,I FOUR * LDB TEMP1,I IF BLOCK AVAILABLE THEN SZB,RSS SKIP THE JMP RE4 MOVE * SEZ,INA SET A TO SAVE BLOCK ADDRESS INA (EXTRA WORD USED IN ID-EXTENSION) LDB TEMP1 DIG THE TDB SIZE OUT CLE,INB OF THE TDB LDB B,I AND SET IN B JSB MTDB MOVE OUT THE TDB RE4 LDA TEMP4 GET THE ADDRESS OF THE ID-SEG. ADDRESS STA TEMP1,I AND SET IN THE TDB LDA TEMP3,I GET THE ID-STATUS WORD 3 IOR B2000 SET THE RENT BIT STA TEMP3,I RESTORE THE WORD LDB TEMP1 (B) = ADDR. OF TDB. ADB D2 SET LDA $LIBR (P+1) ADA DM2 OF ORIGINAL LDA A,I CALL IN STA B,I WORD 3 OF TDB IN PROGRAM. ISZ $LIBR SET TO FIRST INSTR IN LIB. PROG. * LDB $LIBR SET RETURN ADDRESS STB XSUSP,I IN THE ID-SEG. JMP $RENT RETURN TO THE DISPATCHER * $PVCN NOP SKP * * REJECT SECTION CAUSED BY NO MEMORY * AVAILABLE FOR -TDB-. CALLING USER PROGRAM * IS SUSPENDED BACK TO POINT OF CALL AND * LINKED INTO MEMORY SUSPENSION LIST. * NVRM LDA D4 NEVER ENOUGH MEMORY, REQUEST 4 NEXT TIME STA XTEMP,I LB5 JSB $LIST SUSPEND OCT 504 PROGRAM JMP $XEQ TRANSFER TO EXECUTE SECTION. * LB05 LDA $LIBR BACK UP TO ADA DM2 THE ENTRY POINT. CCB SUBTRACT ONE FROM THE RETURN ADB A,I ADDR TO GET ADDR OF THE CALL. STB XSUSP,I POST THIS ADDR AS SUSP.POINT. JMP LB5 SUSPEND PROGRAM FOR MEMORY. * * * INITIATE PRIVILEGED EXECUTION OF USER PROGRAM * PVEXC EQU * RESTORE REGISTERS. DLD XI,I GET X,Y TO A,B CAX PUT IN X CBY AND Y NOTMX LDA XEO,I NOW E,O CLO SLA,ELA STF 1 LDB XB,I JMP LIBRX GO GET A AND EXIT * HED RENT SUBROUTINES * MTDB MOVES A TDB TO SYSTEM MEMORY AND UPDATES THE LINKAGES * AS REQUIRED. * * CALLING SEQUENCE: * * TEMP6 = NUMBER OF WORDS REQUIRED (IF ALLOCATION) * TEMP1 = ADDRESS OF TDB TO BE MOVED * A = CORE ADDRESS (FROM $ALC ) * B = NUMBER OF WORDS ALLOCATED (FROM $ALC ) * E = 0 IF MEMORY IS ALREADY ALLOCATED * = 1 IF TEMP6 IS SET AND A AND B ARE NOT. * * THE SECOND WORD OF THE SAVE AREA IS SET TO THE CONTENTS * OF B WHILE THE SECOND WORD OF THE TDB DETERMINS HOW * MANY WORDS TO MOVE. * * TEMP USAGE IN THIS ROUTINE IS: * * AHLD DESTINATION ADDRESS * TEMP7 ID-EXTENSION ADDRESS(CONTENTS OF TEMP1,I) * MTDB NOP STA AHLD RSA SAVE MEU STATUS RAL,RAL STA MVSTS UJP *+2 SEZ,RSS IF NO ALLOCATE OPTION JMP MTDB2 SKIP ALLOCATE CALL * JSB $ALC GET THE MEMORY TEMP6 NOP JMP MTDB0 NEVER ANY MEMORY JMP LB5 NO MEMORY NOW, SUSPEND PROG * STA AHLD SET UP DESTINATION POINTER MTDB2 EQU * LDA TEMP1,I SAVE THE ID-EXTENSION ADDRESS STA TEMP7 LDA TEMP1 GET THE TDB ADDRESS XSA AHLD,I AND SET IT IN THE SAVE AREA. AHLD EQU *-1 ISZ AHLD STEP TO WORD TWO XSB AHLD,I AND SET ACTUAL COUNT ADB DM2 ADJUST COUNT FOR MOVE CBX AND SET FOR MWI ADA D2 ADJUST THE FROM ADDRESS LDB AHLD GET THE TO ADRESS INB ADJUST TO ADDRESS MWI MOVE BLOCK INTO SYSTEM MAP * CLA STA TEMP1,I SET THE TDB "FREE" XLB TEMP7,I GET THE ID-SEGMENT ADDRESS FOR RBL,CLE,ERB THE OWNING PROGRAM ADB D20 INDEX TO THE STATUS WORD LDA B,I FETCH IT AND SET IOR B4000 THE RENT MEMORY MOVED STA B,I BIT ISZ TEMP7 STEP TO THE TDB POINTER ADDRESS LDA AHLD GET THE NEW LOCATION ADA C100K SUBTRACT ONE AND ADD SIGN XSA TEMP7,I AND SET IN THE EXTENSION. MTDBX JRS MVSTS MTDB,I MVSTS BSS 1 * MTDB0 CLA NEVER ANY MEMORY CLB RETURN (A)=0, (B)=0 JMP MTDBX SPC 2 * FINDL FINDS A ID-EXTENSION GIVEN THE ID-SEGMENT ADDRESS * * CALLING SEQUENCE: * * LDB ID-SEG ADDRESS * JSB FINDL * NOT FOUND RETURN * FOUND RETURN B = ADDRESS OF EXTENSION,TEMP5 = ADDRESS OF * PREVIOUS BLOCK IN THE LIST (FOR UNLINKING). * E = }0. * * TEMP USAGE: * * TEMP5 = LAST POINTER * TEMP6 = ID-SEGMENT ADDRESS * FINDL NOP STB TEMP6 SAVE THE ID-SEGMENT ADDRESS LDB DHED GET THE HED OF THE LIST ADDRESS FIND1 STB TEMP5 SET LAST POINTER XLB B,I GET THE ADDRESS OF THE EXTENSION SZB,RSS END OF LIST? JMP FINDL,I YES- MAKE NOT FOUND RETURN LDA B ADDRESS TO A INA STEP TO THE ID-ADDRESS XLA A,I GET THE ADDRESS RAL,CLE,ERA CLEAR POSSIBLE SIGN BIT CPA TEMP6 THIS IT? CLE,RSS YES RETURN E = 0 JMP FIND1 NO TRY NEXT ENTRY ISZ FINDL STEP TO TRUE RETURN JMP FINDL,I RETURN SKP * RTN4 RETURNS THE FOUR WORD ID-EXTENSION AND CAN CLEAR * THE PROGRAMS RENT BIT * * CALLING SEQUENCE: * * TEMP2 = ADDRESS OF THE FOUR WORD BLOCK * E = 0 IF THE RENT BIT IS TO BE CLEARED. * TEMP1 = ADDRESS OF THE TDB (TO SET FIRST WORD TO ZERO) * JSB RTN4 * * TEMP USAGE: * TEMP2 AS ABOVE * TEMP3 NUMBER OF WORDS TO RETURN * TEMP1 AS ABOVE * RTN4 NOP LDA TEMP2 GET BLOCK ADDRESS INA INDEX TO ID SEG ADDRESS XLB A,I GET ID-SEG ADDRESS LDA D4 SET A TO THE REQUEST LENGTH RBL,SLB,ERB IF WE GOT 4 SKIP INA ELSE SET TO 5. STA TEMP3 SET RETURN LENGTH SSB IS RENT BIT CLEAR REQUESTED? JMP RTNA NO SKIP ADB D20 YES INDEX TO THE BIT LDA B,I GET THE WORD XOR B2000 ZAP THE BIT STA B,I RESET THE WORD RTNA CLA CLEAR THE TDB FLAG STA TEMP1,I JSB $RTN RETURN THE MEMORY TEMP2 NOP TEMP3 NOP JMP RTN4,I RETURN SPC 2 DHED DEF *+1 NOP HED OF ID-EXTENSION LIST DM3 DEC -3 D20 DEC 20 B4000 OCT 4000 B2000 OCT 2000 SIGN DEF 0,I HED $REIO RENT I/O PROCESSOR ROUTINE * $REI$B@BELOW TDB SO SKIP ADB A,I ADD TDB LENGTH XLB TEMP4,I GET THE NEXT ENTRY TO B SEZ,CCE,RSS E=0 IF NOT IN THE TDB. JMP REIO1 TRY NEXT TDB HE OWNS. * LDB A,I GET LENGTH OF TDB AND SET STB TEMP6 FOR MTDB XLA TEMP5,I IF ALREADY MOVED LDB TEMP1,I THEN SKIP SZB MOVE AND USE CURRENT POINTER JSB MTDB GO MOVE THE TDB RAL,CLE,ERA CLEAR THE SIGN BIT XLB A,I OLD TDB ADDRESS TO B CMA,INA NEG. OF NEW ADDRESS TO A STA $MVBF SET MOVED TDB TO SAM FOR RTIOC ADB A NEG. OF OFFSET TO B REIO2 ADB TEMP3 NEG OF NEW BUFFER ADDRESS TO B CMB,CCE,INB SET POSITIVE AND SET E. JMP $REIO,I RETURN TO CALLER $MVBF NOP MOVED TDB TO SAM FLAG FOR RTIOC HED RESTORE MOVED TDB'S FOR CURRENT PROGRAM * $RSRE MOVES BACK ANY TDB MOVED OUT BY CONTENDING PROGRAMS * THIS ROUTINE IS CALLED BY THE DISPATCHER WHEN IT IS * ABOUT TO DISPATCH A PROGRAM AND THE RENT MEMORY * MOVED BIT IS SET IN THE PROGRAMS ID-SEGMENT. * * CALLING SEQUENCE: * * SET UP BASE PAGE (XEQT ETC.) * JSB $RSRE * * ON RETURN THE PROGRAM IS READY TO RUN * * IF MEMORY IS NEEDED BUT NOT AVTAILABLE THE PROGRAM IS * MEMORY SUSPENDED AND RETURN IS TO $XEQ. * * TEMP USAGE: * * TEMP1 = TDB POINTER * TEMP3 = THE FROM ADDRESS * TEMP6 = # WORDS FOR ALLOCATION * TEMP4 = MOVE COUNTER * TEMP5 = RETURN MEMORY ADDRESS * TEMP9 = RETURN # WORDS * $RSRE NOP RSA SAVE MEU STATUS RAL,RAL STA RESTS UJP *+2 RSRE1 LDB XEQT GET THE ID-SEGMENT EXTENSION JSB FINDL JMP RSRE3 NOT FOUND GO EXIT * RSRE2 ADB D2 INDEX TO THE TDB ADDRESS XLA B,I GET THE TDB ADDRESS TO A SSA IF NOT MOVED OUT THEN SKIP JMP RSRE4 ELSE GO MOVE BACK * SEZ,CCE,INB GET ADDRESS OF NEXT BLOCK ADB DM3 TO B XLB B,I SZB IF ZERO THEN DONE JMP RSRE2 ELSE GO TEST NEXT ONE * RSRE3 LDB XEQT GET THE ID-ADDRESS ADB D20 AND REMOVE LDA B,I THE MEMORY XOR B4000 MOVE REQUIRED BIT STA B,I RESET THE WORD JRS RESTS $RSRE,I RETURN AND RESTORE MEU STATUS * RSRE4 RAL,CLE,ERA CLEAR THE SIGN BIT AND STA TEMP5 SAVE THE ADDRESS STB TEMP3 SET THE FORM ADDRESS XLB A,I GET THE TDB ADDRESS STB TEMP1 SET THE TDB ADDRESS INA STEP TO THE ALLOCATED COUNT XLA A,I GET AND STA TEMP9 SET FOR RETURN CALL DLD B,I GET CURRENT OWNER AND ACTUAL COUNT STB TEMP6 SET COUNT FOR ALLOCATION ADB DM2 SET UP THE MOVE COUNT STB TEMP4 SAVE IT CCE,SZA SKIP IF SUBROUTINE IS FREE JSB MTDB MOVE THE OTHER USER TO SYS. MEM. * LDB TEMP4 PUT MOVE COUNT IN CBX X CCB ADB TEMP3 BACK UP TO THE ID ADDRESS IN THE EXTENSION STB TEMP1,I SET IN THE TDB TO SHOW OWNER LDB TEMP1 SET UP ID-EXTENSION XSB TEMP3,I LDA TEMP5 GET ADDRESS OF MEMORY ADA D2 GADJUST FOR MOVE ADB D2 ADJUST TO ADDRESS ALSO * MWF MOVE FROM SYS TO USER * JSB $RTN RETURN THE MEMORY TEMP5 NOP TEMP9 NOP JMP RSRE1 GO TRY AGAIN RESTS BSS 1 HED ABORT PROCESSOR FOR PROGRAM ABORTED IN A RENT SUBROUTINE * $ABRE CLEANS UP MEMORY ALLOCATION AND OWNERSHIP FLAGS * FOR A PROGRAM ABORTED (OR TERMINATED) WHILE IN A REENTRENT * SUBROUTINE. * * CALLING SEQUENCE: * * A=0 IF DISC RESIDENT * A#0 IF CORE RESIDENT * * LDB ID-SEG ADDRESS * JSB $ABRE * * TEMP USAGE: * * TEMP4 = NEXT ID-SEG EXTENSION * TEMP1 = TDB ADDRESS * TEMP7 = MEMORY ADDRESS * TEMP8 = # WORDS TO RETURN * TEMP9 = CORE RESIDENT FLAG (PASSED IN A) * SAVER = ID-SEGMENT ADDRESS SAVE WHILE RN RELEASE CALLED * $ABRE NOP STA TEMP9 SAVE THE RESIDENCY FLAG RSA GET MEU STATUS RAL,RAL UJP *+2 STA ABSTS SAVE CURRENT MEU STATUS LDA B ADA D20 ADVANCE TO FATHER PTR LDA A,I ALF,RAL TEST REENTRANT BIT SSA SEARCH ONLY IF NEED TO. JSB FINDL DOES HE HAVE ANY? JMP ABRX NO EXIT * XLA B,I YES UNLINK FROM LIST XSA TEMP5,I ABRE1 STB TEMP2 SET ID-EXTENTION ADDRESS CLA,SEZ,RSS COMPUTE ADDRESS LDA D3 OF NEXT ENTRY ADA B IN THE PROGRAMS LIST XLA A,I AND SAVE STA TEMP4 IT * ADB D2 INDEX TO THE TDB ADDRESS XLA B,I FETCH IT RAL,CLE,SLA,ERA CLEAR MOVED BIT, SKIP IF NOT JMP ABRE2 NOT MOVED CONTINUE * STA TEMP1 SET THE TDB ADDRESS FOR CLEAR LDB TEMP9 GET THE RESIDENCY FLAG CMA,CLE IF THE TDB IS NOT IN THE LIB. AREA ADA RTORG AND THE PROG IS DISC RESIDENT SEZ,CCE,RSS THEN DO NOT CLEAR THE TDB SZB JMP ABRE4 EITHER RESIDENT OR TRUE LIB. JMP AB7bRE3 IN DISC RESIDENT PGM. * ABRE2 STA TEMP7 SET UP TO RETURN IT INA STEP TO THE LENGTH XLA A,I GET IT STA TEMP8 SET FOR RETURN CALL JSB $RTN RETURN THE SAVE AREA TEMP7 NOP TEMP8 NOP * ABRE3 CLA,CCE CLEAR TEMP1 TO AVOID PROBLEMS STA TEMP1 JSB RTN4 RETURN THE 4 WORD EXTENSION ABRE6 LDB TEMP4 GET ADDRESS OF NEXT CCE,SZB EXTENSION JMP ABRE1 GO DO IT IF IT EXISTS ABRX JRS ABSTS $ABRE,I RETURN,RESET MEU ABSTS BSS 1 * ABRE4 LDA $PBUF GET BUFFER ADDRESS FOR STORAGE. IOR SIGN ADD SIGN BIT TO MOVE CURRENT USA USER'S MAP INTO STORAGE BUFFER. LDA $MRMP GET ADDRESS OF MEMORY RESIDENT USA MAP AND SET IT UP. JSB RTN4 GO RELEASE ID EXTENSION. LDA $PBUF RESTORE OLD USER MAP FROM USA STORAGE AREA AND GO SEE IF JMP ABRE6 ANY MORE ID EXTENSIONS. HED $LIBX EXIT PROCESSOR FOR RENT/PRIV LIB ROUTINES * < $LIBX> IS ENTERED WHEN A LIBRARY * PROGRAM TERMINATES ITS EXECUTION. A * TEMPORARY DATA BLOCK IS MOVED BACK * INTO THE LIBRARY PROGRAM, IF REQUIRED, * BEFORE RETURN TO THE ORIGINAL CALLER. * * LIBXA DEF $LIBX * $LIBX NOP NON MP ENTRY - MUST BE STA XA,I RETURNING FORM PRIV. SUB. LDA $PVCN SUBTRACT ONE FORM THE COUNT CMA,INA WITH OUT AFFECTING CMA,SZA,RSS "E" ($PVCN >0 ) JMP LB10 IF NOT STILL PRIV. JMP * STA $PVCN STILL PRIV. SET THE COUNTER BACK LDA $LIBX,I TRACK DOWN THE RETURN LDA A,I ADDRESS STA $LIBX AND SET IT LDA XA,I RESTORE A AND JMP $LIBX,I RETURN * LB10 STA $PVCN RETURN NON PRIV. SET COUNTER STB XB,I TO ZERO AND FINISH THE REG. SAVE ERA,ALS E SOC O INA STA XEO,I LDA $LIBX,I GET THE LDA A,I RETURN ADDRESS  STA XSUSP,I AND SAVE IT CXA CYB SAVE THE X,Y REGS. DST XI,I IN THE X,Y SAVE AREA JMP $RENT NOW GO SET THE FENCE * * * RE-ENTRANT PROGRAM RETURNING TO USER CALL. * LIBXC LDB $LIBR,I SET -TDB- ADDRESS. STB TEMP1 IN TEMP1. ISZ $LIBR SET TO (P+2) OF CALL TO -$LIBX-. ADB D2 GET LDA B,I RETURN POINT ADJUSTMENT. ADA $LIBR,I ADD TO (P+1) OF LIBRARY CALL STA XSUSP,I AND SET FOR RETURN TO USER. * LDB XEQT GET ID EXTENSION JSB FINDL ADDRESS JMP MPERR NOT FOUND??? JMP LB14 START SEARCH * LB15 SEZ,CCE,RSS FIND NEXT ENTRY ADDRESS ADB D3 STB TEMP5 SAVE POINTER XLB B,I GET ADDRESS LB14 STB A GET ADDRESS OF INA ID WORD CPA TEMP1,I THIS ONE?? RSS YES GO DO IT JMP LB15 NO TRY NEXT ONE * STB TEMP2 SAVE BLOCK ADDRESS XLB B,I RELINK THE BLOCKS XSB TEMP5,I JSB RTN4 RETURN THE ID-EXTENSION JMP $RENT TDB = 0, GO TO CHECK RETURN. * HED ** SYSTEM DISC ALLOCATION/RELEASE PROCESSOR ** * SYSTEM DISC ALLOCATION/RELEASE REQUESTS * * THESE REQUESTS CONFORM TO THE GENERAL * SYSTEM REQUEST FORMAT. * * A. DISC TRACK ALLOCATION * * THE ALLOCATION REQUEST INCLUDES THE * NUMBER OF CONTIGUOUS TRACKS DESIRED, A * PARAMETER TO INDICATE SUSPENSION OR * NO SUSPENSION IF THE REQUESTED SPACE IS * NOT AVAILABLE AND VARIABLE STORAGE FOR * RETURNING THE STARTING TRACK NUMBER, THE * DISC LOGICAL UNIT NUMBER AND THE NUMBER * OF SECTORS PER TRACK FOR THE ASSIGNED * DISC. * * (P) JSB EXEC * (P+1) DEF *+6 (DEFINE RETURN) * (P+2) DEF RCODE ( " REQUEST CODE) * (P+3) DEF #TRAK ( " # TRACKS DESIRED) * (P+4) DEF STRAK ( " WORD FOR TRACK #) * (P+5) DEF DISC ( " " FOR DISC LU #) *  (P+6) DEF SECT# ( " " FOR # SECTORS) * (P+7) - RETURN - * * RCODE DEC M * #TRAK DEC N * STRAK NOP * DISC NOP * SECT# NOP * * M = 4 ALLOCATE TRACK TO PROGRAM * = 15 ALLOCATE TRACK GLOBALLY * * #TRAK (BIT 15):= 0 TO MEAN SUSPENSION IF * TRACKS NOT AVAILABLE * = 1 TO MEAN NO SUSPENSION AND * SET (STRAK) = -1 IF NO * TRACKS AVAILABLE. * * STRAK : THE STARTING TRACK NUMBER OF THE * CONTIGUOUS GROUP ALLOCATED IS * STORED IN THIS WORD ( OR = -1 AS * DESCRIBED FOR 'NO SUSPENSION' ABOVE). * * DISC : THE LOGICAL UNIT NUMBER OF THE DISC * ON WHICH THE TRACK(S) WERE ALLOCATED * IS STORED IN THIS WORD. * * SECT#: THE NUMBER OF SECTORS PER TRACK FOR * THIS DISC ALLOCATION IS STORED IN * THIS WORD. SKP * * B. DISC TRACK RELEASE * * THE RELEASE REQUEST PROVIDES FOR RELEASING * A SINGLE TRACK, A CONTIGUOUS GROUP OF TRACKS * OR ALL TRACKS ASSIGNED. THE TRACKS TO BE * RELEASED MUST BE EITHER ASSIGNED TO THE * REQUESTING PROGRAM (REQUEST CODE 5) OR * ASSIGNED GLOBALLY (REQUEST CODE 16). * * (P) JSB EXEC * (P+1) DEF *+5 (DEFINE RETURN) * (P+2) DEF RCODE ( " REQUEST CODE) * (P+3) DEF #TRAK ( " # TRACKS TO RELEASE) * (P+4) DEF STRAK ( " STARTING TRACK #) * (P+5) DEF DISC ( " DISC LU # ) * (P+6) - RETURN - * * RCODE DEC M * #TRAK DEC N * STRAK NOP * DISC NOP * * M = 5 RELEASE PROGRAM TRACK * = 16 RELEASE GLOBAL TRACK * * #TRAK: = N, TO INDICATE THE NUMBER OF CONTIG- * UOUS TRACKS TO RELEASE BEGINNING * AT THE TRACK NUMBER IN 'STRAK'. * * = -1, TO MEAN RELEASE ALL TRACKS ASSIGNED * TO THE USER PROGRAM -  * VALID ONLY FOR PROGRAM ASSIGNED TRACKS * IN THIS CASE, THE 'STRAK' ANDNk * 'DISC' PARAMETERS NEED NOT * BE INCLUDED. * * STRAK: THE STARTING TRACK OF THE GROUP TO * BE RELEASED IS STORED IN THIS WORD. * * DISC: THE LOGICAL UNIT NUMBER OF THE DISC * CONTAINING THE TRACKS IS STORED * IN THIS WORD. SKP * * ** TRACK ASSIGNMENT TABLE ** * * THE *TAT* IS A VARIABLE LENGTH TABLE DESCRIBING * THE AVAILABILITY OF EACH DISC TRACK ON THE * SYSTEM DISC AND, IF INCLUDED, THE AUXILIARY DISC. * THE *TAT* IS CONSTRUCTED BY BASED ON * USER PARAMETERS DECLARING THE SIZE OF THE SYSTEM * DISC AND THE AVAILABILITY AND SIZE OF AN AUXILIARY * DISC. EACH TRACK IS REPRESENTED BY A 1-WORD ENTRY. * THE FIRST WORDS OF THE TABLE CORRESPOND TO THE * N TRACKS OF THE SYSTEM DISC, USUALLY 32, 64 OR * 128. THE WORD "TATSD" IN THE BASE PAGE COMMUNI- * CATION AREA CONTAINS THE SIZE OF THE SYSTEM DISC * AS A POSITIVE INTEGER. IF AN AUXILIARLY DISC IS * INCLUDED, THE REST OF THE *TAT* CONTAINS 1-WORD * ENTRIES TO DESCRIBE THE TRACKS ON THAT DISC. * RTGEN INITIALIZES THE PROTECTED TRACKS OF THE * SYSTEM DISC TO BE ASSIGNED TO THE SYSTEM (PERM- * ANENTLY UNAVAILABLE). * THE CONTENTS OF A TRACK ASSIGNMENT ENTRY WORD * MAY BE ONE OF THE FOUR VALUES: * * 0 - AVAILABLE FOR ASSIGNMENT * 100000 - ASSIGNED TO THE SYSTEM (OR PROTECTED) * 077777 - ASSIGNED GLOBALLY * NNNNN - USER PROGRAM ASSIGNMENT. NNNNN IS THE * ID SEGMENT ADDRESS OF THE PROGRAM. * * THE WORD "TATLG" IN THE BP COMMUNICATION AREA * CONTAINS THE NEGATIVE LENGTH OF THE TAT. * THE WORD "TAT" CONTAINS THE FWA OF THE TABLE. * * ** VARIABLE NUMBER OF SECTORS PER TRACK ON FIXED-HEAD SYSTEMS ** * * ONE RTE CAN ACCOMODATE TWO FIXED-HEAD * DISC UNITS TERMED THE SYSTEM DISC (LU #2) * AND THE AUXILIARY DISC (LU#3). TS=0.*HESE DISCS * MAY BE DIFFERENT MODELS OF A FIXED-HEAD * DISC AND WITH DIFFERING NUMBER OF SECTORS * PER TRACK. FOR THIS REASON THE WORDS * 'SECT2' AND 'SECT3' IN THE BASE PAGE * COMMUNICATION AREA CONTAIN THE NUMBER OF * SECTORS PER TRACK FOR LOGICAL UNITS 2 AND 3. * * SKP v0* TRACK ALLOCATION (USER CALL) * DISCA CCB,RSS SET DISC1 LDB XEQT ENTRY LDA RQCNT INSURE ADA DM4 THAT SSA 4 PARAMETERS ARE SUPPLIED. JMP DERR1 -NO, ERROR 'DR01' * LDA RQP2,I GET '#TRAK' PARAMETER TO CHECK AND C100K 'N'. REMOVE BIT 15, SZA,RSS -ERROR IF JMP DERR2 #TRAK = 0. * ELB,CLE,ERB JSB $DREQ CALL FOR CONTIGUOUS ALLOCATION * SZB IF TRACKS ALLOCATED, JMP DSC3 CONTINUE. * * NO TRACKS ARE AVAILABLE * CCA CHECK SUSPENSION LDB RQP2,I PARAMETER. SSB IF BIT 15 = 1, GO TO SET STRAK JMP DSC3 = -1 AND RETURN TO CALLER. * * SUSPEND PROGRAM - LINK INTO DISC SUSPENSION LIST * JSB $LIST SUSPEND OCT 505 PROGRAM JMP $XEQ - EXIT - * * AVAILABLE TRACK FOUND * DSC3 STA RQP3,I SAVE STARTING TRACK #. LDA SECT2 SET TO STORE CPB D3 # SECTORS PER TRACK IN LDA SECT3 'SECT#' DEPENDING ON LU # IN B. STA RQP5,I SET # SECTORS. * STB RQP4,I SET DISC LOGICAL UNIT #. * DSC4 LDA RQRTN SET *XSUSP* TO STA XSUSP,I BE EXIT ADDRESS JMP $XEQ - EXIT -. * D3 DEC 3 DM2 DEC -2 DM4 DEC -4 C100K OCT 77777 * * * TRACK RELEASE (USER CALL) * DISC2 CLA,CLE,RSS SET DISCB CLA,CCE,INA ENTRY STA TEMP7 SWITCH LDA RQCNT INSURE SZA,RSS THAT AT LEAST 1 PARAMETER GIVEN. JMP DERR1 - NO, ERROR LDA XEQT (A)= ID SEGMENT ADDRESS LDB RQP2,I GET PARAMETER: CPB DM1 IF = -1, JMP DSC7 GO TO RELEASE ALL FOR THIS PROG * LDA RQCNT INSURE THAT THE ADA DM3 STRAK AND DISC PARAMETERS SSA ARE PROVIDED. JMP DERR1 -NO, ERROR * LDA RQP4,I GET DISC LU #. CLE,ERA CHECK VALIDITY. CPYiA D1 IF NOT 2 OR 3 CLB,RSS THEN GO SEND HIM JMP DERR2 DOWN THE TUBES. * SEZ IF LU 3 USE ADB TATSD AUXILIARY DISC ADB RQP3,I ADD STRAK FROM USER CALL. * LDA RQP2,I GET #TRAK. CMA,INA SET NEGATIVE FOR SSA,RSS COUNTER. ERROR IF 0 OR JMP DERR2 ORIGINALLY NEGATIVE. STA TEMP1 SET COUNTER. * LDA TEMP7 RELEASE CCE,SZA NON-GLOBAL JMP DSC8 GLOBAL * ADB TAT ADD THE TAT ADDRESS DSC5 LDA B,I GET CURRENT TRACK ASSIGNMENT CPA XEQT COMPARE TO PROGRAM ID SEG ADDRESS CLA,RSS JMP DERR3 OTHERWISE, REQUEST ERROR. STA B,I = 0 TO BE AVAILABLE. INB ADD 1 TO TAT ADDRESS. ISZ TEMP1 -INDEX COUNTER. JMP DSC5 -MORE * DSC6 JSB $SDSK FINISHED-SCHEDULE DISC SUSP PROGS * JMP DSC4 GO ADVANCE RETURN ADDRESS AND EXIT * DSC8 LDA TEMP1 SET A TO NUMBER OF TRACKS(-) JSB $CREL TRY CONDITIONAL RELEASE STB XA,I SET RESULT IN USER A REG. JMP DSC4 AND GO EXIT * DSC7 SEZ IF GLOBAL RELEASE JMP DERR1 SHOT DOWN THE CLOD. JSB $SDRL RELEASE ALL TRACKS JMP DSC6 GO SCHEDULE ALL WAITING PGMS. * * * $CREL CONDITIONALLY RELEASES SYSTEM OR GLOBAL TRACKS * THE CONDITION BEING: * A) THAT THEY ARE ASSIGNED AS EXPECTED AND * B) THAT THEY ARE NOT IN A DISC I/O QUEUE. * * CALLING SEQUENCE: * * E = 1 IF GLOBAL TRACK RELEASE * E = 0 IF SYSTEM TRACK RELEASE * A = THE NEGATIVE OF THE NUMBER OF TRACKS TO RELEASE. * B = THE FIRST TRACK'S OFFSET IN THE TAT. * * JSB $CREL * * RETURN CONDITIONS ARE: * * B = -1 ONE OR MORE OF THE TRACKS IS IN USE * = -2 ONE OR MORE OF THE TRACKS IS NOT ASSIGNED AS SPECIFIED. * = 0 TRACKS WERE RELEASED. * $CREL NOP ADB TAT ] GET THE TAT ADDRESS TO B STB TEMP4 STB TEMP7 ENTRY IN TAT SPC 1 STA TEMP1 SET THE COUNTERS STA TEMP6 LDA C100K SET UP THE SEZ,RSS ASSIGNMENT FLAG INA STEP GLOBAL TO SYSTEM STA TEMP2 SAVE IT LDA TATSD COMPUTE THE DISC LU ADA TAT A IS THE TAT POSITION CMA,INA (-) OF THE FIRST WORD OF LU 3. ADA B SUBTRACT FROM TAT POSITON OF FIRST TRACK CLE,SSA IF NEG. THEN ADJUST ADA TATSD FOR LU 2 (SETS E) STA TEMP8 SET THE TRACK NUMBER CLB,SEZ,INB,RSS SET B TO INB THE DISC LU LESS ONE. STB $OTRL SAVE THE LU ISZ $OTRL ADD THE MISSING ONE. ADB DRT GET THE EQT ADDRESS LDA B,I INTO JSB $CVEQ EQT1 SPC 1 DSC9 LDA TEMP7,I GLOBAL CPA TEMP2 TRACK? RSS YES-GO SEE IF IN USE JMP DSC15 NO-RETURN TO PROG WITH A=-2 LDB EQT1,I GET REQUESTS QUEUED ON DISC ELB,CLE,ERB STRIP POSSIBLE SIGN BIT DSC10 STB TEMP9 DISC QUEUE EXHAUSTED? SZB,RSS JMP DSC12 YES-GO TO NEXT TRACK INB NO-SEE IF REQUEST LDA B,I IS FOR THIS TRACK ALF,ALF AND D3 CPA $OTRL SAME LU? I.E. DISC? RSS YES-CHECK IF SAME TRACK JMP DSC11 NO ADB D3 LDA B,I CPA TEMP8 SAME TRACK? JMP DSC14 YES-RETURN WITH A=-1 SPC 1 DSC11 LDB TEMP9,I GO TO NEXT REQUEST JMP DSC10 IN QUEUE SPC 1 DSC12 ISZ TEMP7 SET UP FOR NEXT TRACK ISZ TEMP8 CHECK NEXT TRACK ISZ TEMP1 ALL TRACKS CHECKED? JMP DSC9 NO TRY AGAIN SPC 1 DSC13 STB TEMP4,I CLEAR ALL ISZ TEMP4 TRACKS ISZ TEMP6 JMP DSC13 SETUP TO RETURN JSB $SDSK SCHEDULE ANY WAITING PGMS. JMP $CREL,I AND RETURN % SPC 1 DSC14 CCB,RSS STORE B REGISTER DSC15 LDB DM2 TO INDICATE WHY NO TRACKS JMP $CREL,I RELEASED AND RETURN * * DISC REQUEST ERROR SECTION * DERR1 CLB,INB,RSS -ILLEGAL DISC REQUEST - DR01 - DERR2 LDB D2 -ILLEGAL TRACK # - DR02 - JMP DERR DERR3 LDB D3 -TRACK NOT ASSIGNED TO PROG- DR03 DERR LDA DRA (A) = DR IN ASCII. $ERAB ADB AS00 ADD ASC "00" JSB $ERMG PRINT ERROR DIAG. AND ABORT PROG JMP $XEQ -EXIT- * DRA ASC 1,DR AS00 ASC 1,00 * * * SUBROUTINE: <$OTRL> * * PURPOSE: THIS SUBROUTINE SCANS THE TAT * (TRACK ASSIGNMENT TABLE) AND * RELEASES ANY TRACKS ASSIGNED * TO THE PROGRAM WHOSE ID SEGMENT * ADDRESS IS IN THE A REGISTER. * * * CALL: (A) = ID SEGMENT ADDRESS OF PROGRAM * WHOSE TRACKS ARE TO BE RELEASED * (P) JSB $OTRL * (P+1) -RETURN- * * $OTRL NOP STA TEMP3 SAVE ID SEGMENT ADDRESS LDA *-2 AND RETURN ADDRESS FOR STA $SDRL $SDRL ROUTINE AND JUMP JMP SDSC1 TO IT SKP * * SUBROUTINE: < $SDRL > * * PURPOSE: THIS ROUTINE SCANS THE TAT * (TRACK ASSIGNMENT TABLE) AND * RELEASES ANY TRACKS ASSIGNED * TO THE PROGRAM WHOSE ID SEGMENT * IS DEFINED IN *XEQT* OR ANY TRACKS ASSIGNED * GLOBALLY DEPENDING ON A REG CONTENTS ON ENTRY. * * * EXCEPTION: IF THE NAME OF THE SUBJECT PROGRAM IS * "EDIT",OR "D.RTR" AN IMMEDIATE EXIT IS MADE TO * AVOID RELEASING SAVED SOURCE FILES AND * DIRECTORY TRACKS IN THE NAME OF THESE * PROGRAMS. * * CALL: (A) = ID SEGMENT ADDRESS OF PROGRAM * OR 077777B (GLOBAL FLAG) * (P) JSB $SDRL * (P+1) -RETURN- * * $SDRL NOP STA TEMP3 DLD IDADD,I GET THE ID ADDRESSES OF D.RTR IDADD EQU *-1 AND EDIT CPA TEMP3 IF D.RTR  RSS CPB TEMP3 OR EDIT JMP $SDRL,I DO NOT RELEASE THE TRACKS * SDSC1 LDA TAT SET *TAT* STA TEMP1 ADDRESS LDA TATLG AND TAT LENGTH STA TEMP2 AS INDEX. CLB (B) = 0 FOR RELEASE * SDSC2 LDA TEMP1,I GET CURRENT TRACK ASSIGNMENT. CPA TEMP3 IF ASSIGNED TO THIS PROGRAM, STB TEMP1,I RELEASE IT. ISZ TEMP1 SET ISZ TEMP2 FOR JMP SDSC2 NEXT TRACK. JSB $SDSK SCHEDULE DISC SUSPENDED PROGRAMS JMP $SDRL,I -FINISHED- * SKP * * SYSTEM SUBROUTINE: < $DREQ> * * PURPOSE: THIS SUBROUTINE PROVIDES FOR THE * ALLOCATION OF 'N' CONTIGUOUS TRACKS * FOR BOTH SYSTEM ROUTINES AND NORMAL * USER PROGRAMS. THE 'N' CONTIGUOUS * TRACKS ALLOCATED WILL BE ON THE SAME * DISC UNIT, NO SPANNING OF DISCS WITH * ONE ALLOCATION IS ALLOWED. * * CALL: (A) = NUMBER OF CONTIGUOUS TRACKS * (B) = : 0 FOR CALL FROM SYSTEM ROUTINE * : (XEQT) FOR AN ACTUAL USER * REQUEST. THE ID SEGMENT * ADDRESS (XEQT) IS STORED IN * THE ASSIGNED TRACK WORDS IN * THE -TAT-. * : (077777B) FOR A GLOBAL ASSIGNMENT REQUEST. * THIS OCTAL NUMBER IS STORED IN THE * ASSIGNED TRACK WORDS IN THE -TAT-. * * (P) JSB $DREQ * (P+1) -RETURN- * * ON RETURN: 1) B = 0 IF N TRACKS WERE * NOT AVAILABLE * * 2) A = STARTING TRACK ADDRESS * OF N TRACKS. * B = LOGICAL UNIT # OF DISC * * $DREQ NOP CMA,INA SET COUNT NEGATIVE FOR LOOPS STA TEMP1 SAVE '-N' * CLA,INA ALLOCATION IS TOP DOWN FOR SYS CLE,SZB REQUEST AND BOTTOM UP JMP DREQ0 FOR USER REQUEST - USER JMP. * CCA,CCE SET INCREMENT VALUE AND SYSTEM FLAG LDB SIGN B= SYS TAT FLAG WORD DREQ0 STB TEMP6 SAVE ASSIGNMENT VALUE. STA $DREL SET TABLE INCREMENT VALUE (+1 OR -1) * LDB TAT SET *TAT* LDA B COMPUTE ADDRESS OF LU 3'S ADA TATSD TAT POSITION SEZ IF SYSTEM RQ. ADA $DREL SUBTRACT ONE STA TEMP7 SET ADDRESS OF FIRST WORD ON OTHER DISC LDA TATLG AND TAT LENGTH STA TEMP4 AS INDEX. CMA,SEZ IF SYSTEM RQ. ADB A SET TO START AT THE TOP * DREQ1 LDA B,I GET CURRENT TRACK ASSIGNMENT. SZA,RSS IF NOT ASSIGNED, JMP DREQ3 CHECK FOR N CONTIGUOUS. * DREQ8 ADB $DREL SET FOR DREQ5 ISZ TEMP4 NEXT JMP DREQ1 TRACK. * DREQ2 CLB NOT AVAILABLE, EXIT JMP $DREQ,I WITH (B) = 0. * * AVAILABLE TRACK FOUND - CHECK NEXT 'N-1' TRACKS * DREQ3 STB TEMP3 (B) = FIRST TRACK TAT INDEX. LDA TEMP1 SET STA TEMP2 'N' AS INDEX. DREQ4 LDA B,I CHECK CURRENT SZA TRACK ASSIGNMENT. JMP DREQ8 -ASSIGNED, CONTINUE OTHER SCAN. * ISZ TEMP2 INDEX -'N' RSS NOT ZERO, CHECK NEXT TRACK. JMP DREQ6 - FOUND N TRACKS - * ADB $DREL INDEX TO NEXT TRACK CPB TEMP7 DISC (LU 2)? JMP DREQ5 YES - DO NOT SPAN * ISZ TEMP4 INDEX AND TRACK INDEX. JMP DREQ4 -NOT FINISHED WITH TAT SIZE. * JMP DREQ2 NOT N AVAILABLE. * * N CONTIGUOUS TRACKS FOUND * DREQ6 SEZ IF SYSTEM REQUEST STB TEMP3 SET START ALLOCATION ADDRESS LDB TEMP3 SET THE FIRST TRACK TAT ADDRESS. LDA TEMP6 SET TRACK WORD DREQ7 STA B,I = 100000 FOR SYSTEM USE INB OR TO THE ID SEGMENT ADDRESS ISZ TEMP1 OF THE USER PROGRAM OR TO JMP DREQ7 077777B FOR GLOBAL ASSIGNMENT\. * LDA TEMP7 GET ADDRESS OF LU 3 TR 0 IN TAT CMA,SEZ,RSS AND SUBTRACT FROM INA ADA TEMP3 ALLOCATED POSITION CLE,SSA IF ON LU 3 THEN WE HAVE THE TRACK ADA TATSD ELSE NOW WE HAVE IT (E SET TOO) CLB,CME,INB TURN E AROUND TO LEAST LU BIT ELB SET DISC LU IN B JMP $DREQ,I -EXIT-. SPC 1 TEMP1 NOP SKP * * SYSTEM SUBROUTINE: < $DREL> * * PURPOSE: THIS ROUTINE RELEASES 'N' CONTIGUOUS * TRACKS (ASSIGNED TO THE SYSTEM) * BEGINNING AT TRACK 'M'. * * CALL: (A) = 'M' - STARTING TRACK # (+ SIZE OF * SYSTEM DISC IF LU #3) * (B) = 'N' - # OF CONTIGUOUS TRACKS * (P) ) JSB DREL * (P+1) -RETURN- A = 0. * * $DREL CXA CXA FOR X,Y CONFIGURATION ADA TAT COMPUTE *TAT* ADDRESS STA TEMP1 OF STARTING ADDRESS. LDA A,I GLOBAL TRACKS SSA,RSS ARE NOT TO JMP $DREL,I BE RELEASED. CMB,INB SET 'N' AS INDEX. CLA SET CURRENT STA TEMP1,I TRACK ISZ TEMP1 RELEASED INB,SZB JMP *-3 JSB $SDSK SCHEDULE ANY SUSPENDED PROGRAMS. JMP $DREL,I -EXIT- * * SUBROUTINE: < $SDSK > * * PRUPOSE: THIS ROUTINE CALLS FOR THE * SCHEDULING OF ALL USER PROGRAMS * SUSPENDED BECAUSE OF DISC TRACK * AVAILABILITY. * * CALL: (P) JSB $SDSK * (P+1) - RETURN - A = 0 * * $SDSK DEF IDADD LINK FOR START UP CODE ISZ $LIST FORCE ENTRY INTO DISPATCHER. DSKD1 LDB SUSP4 GET DISC SUSPENSION LIST POINTER. CCE,SZB,RSS IF EMPTY LIST, JMP $SDSK,I EXIT. * JSB $LIST CALL *SCHEDULER* TO OCT 401 LINK INTO SCHEDULE LIST. * JMP DSKD1 SCHEDULE NEXT PROGRAM HED * EXEC - ERROR MESSAGE SECTION * * * ERROR SECTION * * THE FOLLOWING DIAGNOSTICS ARE OUTPUT ON THE * SYSTEM TELETYPEWRITER ON DETECTION OF: * * 1) VALID MEMORY PROTECT VIOLATION (I.E THE * INSTRUCTION CAUSING THE VIOLATION IS * NOT JSB EXEC. * * MP -PNAME- -PADDR- * * 2) REQUEST CODE UNDEFINED OR ILLEGAL * NUMBER OF PARAMETERS * * RQ -PNAME- -PADDR- * * THE ROUTINE -$ERMG- IS USED TO FORMAT * THE DIAGNOSTIC AND CALL FOR ITS OUTPUT. * * ERE01 LDA RE (A) = 'RE' RSS MPERR LDA MP (A) = 'MP' RSS MEUER LDA DM (A) = 'DM' RSS * RQERR LDA RQ1 (A) 'RQ' LDB BLANK (B) = BLANKS JSB $ERMG JMP $XEQ * MP ASC 1,MP RQ1 ASC 1,RQ RE ASC 1,RE DM ASC 1,DM DYNAMIC MAPPING SYSTEM * * SUBROUTINE: <$ERMG> * * PURPOSE: THIS ROUTINE FORMATS A DIAGNOSTIC * MESSAGE WHICH CONTAINS A FOUR * CHARACTER MNEMONIC DESCRIBING THE * ERROR WITH THE PROGRAM NAME AND * LOCATION OF THE ERROR. IT THEN * CALLS THE ROUTINE <$SYMG> TO * OUTPUT THE MESSAGE. * * CALL: (A),(B) CONTAIN A 4 ASCII CHARACTER * MNEMONIC OR CODE DESCRIBING THE ERROR * * (P) JSB $ERMG * (P+1) - RETURN - (REGISTERS MEANINGLESS) SKP * $ERMG JMP EXINT FIRST ENTRY BY JMP GOES TO INIT * STA MSG+1 SET ERROR MNEMONIC IN STB MSG+2 FIRST 4 CHARACTERS OF MESSAGE. * LDB XEQT SET (B) = ADDRESS OF POINT OF ADB D8 SUSPENTION IN ID-SEG. STB $SDSK AND SAVE FOR ABORT OPTION ADB D4 SET (B) = ADDRESS OF 3-WORD NAME LDA B,I AND SET STA MSG+4 PROGRAM INB NAME LDA B,I IN STA MSG+5 MESSAGE. CLE,INB (E=0 FOR ASCII CONVERSION) LDA B,I AND C377 IOR B40 STA MSG+6 INB GET THE STATUS LDA B,I WORD AND IF RAL,CLE,SLA,ERA ABORT OPTIN IN EFFECT JMP NOABT GO SET IT UP. * ERM LD*A XSUSP,I GET LOCATION OF ERROR JSB $CVT3 CONVERT TO OCTAL/ASCII FORMAT LDB A,I MAKE STB MSG+7 5-DIGIT MEMORY ADDRESS. INA SET DLD A,I GET THE OTHER TWO WORDS DST MSG+8 AND SET IN THE MESSAGE * LDA MSGA CALL TO JSB $SYMG OUTPUT DIAGNOSTIC. * LDA XEQT NOW GO JSB $ABRT ABORT THE PROGRAM * JMP $ERMG,I D4 DEC 4 D8 DEC 8 C377 OCT 177400 * NOABT ADB DM6 SET A,B ADDRESS STB DSTAD SET DOUBLE STORE ADDRESS DLD DLD MSG+1 GET THE ERROR CODE DST DSTAD,I SET A,B TO THE ERROR CODE DSTAD EQU *-1 DOUBLE STORE ADDRESS * CCA,CLE USE THE RETURN ADDR - 1 FOR CPB BLANK (BUT IF "MP","RQ", OR "RE" JMP ERM ABORT ANYWAY) ADA RQRTN STA $SDSK,I THE RETURN ADDRESS TO THE PGM. JSB $LIST OCT 501 JMP $ERMG,I RETURN * DM6 DEC -6 * * MSGA DEF *+1 * MSG DEC -18 EXINT STB $SDSK,I SET THE TWO SPECIAL ID-SEG. ADDS ASC 1, XOR 40 WHEN EXECUTED BLANK ASC 1, JMP $CGRN GO SET UP RN CODE IF ANY LDB B,I GET THE ADDR OF D.RTR'S ID-SEG. JMP $SCLK GO START THE CLOCK SPC 1 BSS 7+BLANK-* * A EQU 0 B EQU 1 HED * EXEC -- REQUEST CODE TABLE * *** REQUEST CODE TABLE *** * * THIS DEFINES THE RELATION FOR SYSTEM * REQUEST CODES AND CORRESPONDING PROCESSORS. * THE TABLE CONSISTS OF ONE-WORD ENTRIES IN * NUMERIC ORDER CORRESPONDING TO THE DEFINED * SYSTEM REQUEST CODES. THE CONTENTS OF EACH * ENTRY IS THE BASE PAGE LINKAGE ADDRESS OF * THE WORD CONTAINING THE ENTRY POINT ADDRESS * * OF THE PROCESSOR. AN -EXT- MUST BE USED * WITH THE -DEF- IN DEFINING THE TABLE. * * THE WORD LABELED -CODE#- CONTAINS THE NEGATIVE OF * ONE + THE TOTAL # OF REQUEST CODES. * EXT $IORQ TBL DEF $IORQ CODE 1 I/O READ DEF $IORQ CODE 2 I/O WRITE DEF $IORQ CODE 3 I/O CONTROL * DEF DISC1 CODE 4 DISC TRACK ALLOCATION DEF DISC2 CODE 5 DISC TRACK RELEASE * EXT $MPT1 DEF $MPT1 CODE 6 PROGRAM COMPLETION * EXT $MPT2 DEF $MPT2 CODE 7 OPERATOR SUSPENSION * EXT $MPT3 DEF $MPT3 CODE 8 LOAD PROGRAM SEG$MNT * EXT $MPT4 DEF $MPT4 CODE 9 SCHEDULE WITH WAIT * EXT $MPT5 DEF $MPT5 CODE 10 SCHEDULE PROGRAM * EXT $MPT6 DEF $MPT6 CODE 11 REAL TIME/DATE * EXT $MPT7 DEF $MPT7 CODE 12 TIME SELECTION * DEF $IORQ CODE 13 I/O DEVICE STATUS * EXT $MPT9 DEF $MPT9 CODE 14 GET-PUT STRING * DEF DISCA CODE 15 GLOBAL TRACK ASSIGNMENT DEF DISCB CODE 16 GLOBAL TRACK RELEASE * DEF $IORQ CODE 17 READ CLASS I/O DEF $IORQ CODE 18 WRITE CLASS I/O DEF $IORQ CODE 19 CONTROL CLASS I/O DEF $IORQ CODE 20 WRITE-READ CLASS I/O * EXT $GTIO DEF $GTIO CODE 21 GET CLASS I/O * EXT $MPT8 DEF $MPT8 CODE 22 SWAP/CORE USAGE REQUEST * DEF $MPT4 CODE 23 SCHEDULE WITH WAIT/WAIT * DEF $MPT5 CODE 24 SCHEDULE NO WAIT/WAIT * EXT $PTST DEF $PTST CODE 25 PARTITION STATUS * * * * DEFINE END OF TABLE AND # ENTRIES IN TABLE. * -ADDITIONAL REQUESTS MAY BE INSERTED * AT THIS POINT. * TBLE EQU * * * THE NAMTB WHICH FOLLOWS CONTAINS A BIT FOR EACH PRAMETER * IN AN EXEC CALL WHICH SHOULD BE CALLED BY NAME...THAT IS * THE SYSTEM WILL NORMALLY STORE INTO THE LOCATION DEFINED * BY THE PRAMETER. THIS TABLE IS USED TO CHECK SUCH * PRAMETERS TO SEE IF THEY ARE ABOVE THE CURRENT * FENCE ADDRESS. * * 8 BITS ARE DEVOTED TO EACH CALL. THE LEAST BIT REFERS * TO PRAMETER NUMBER TWO AND SO ON. * THE 'L' AND 'H' NUMBERS ARE SET UP TO REFER TO EACH * ɣPRAMETER BY NUMBER WHERE L REFERS TO THE LOW OR ODD * CALL FOR EACH WORD AND H REFERS TO THE HIGH OR EVEN CALL. * H = HIGH(EVEN CALL) * L = LOW(ODD CALL) * NAMTB ABS L3 0/1 (READ BUFFER) ABS 0 2/3 ABS H3+H4+H5 4/5 (ALLOCATE PRAMS) ABS 0 6/7 ABS L8 8/9 (SCHEDULE) ABS L2+L3+H8 10/11 (SCHED WWAIT),(TIME VALUES) ABS L3+L4+L5 12/13 (STAT RETURN) ABS L3+L4+L5+H3 14/15 (G/S PRM.ST),(GL.ALC.PRM) ABS L7 16/17 (CLASSWORD FOR 17,18,20) ABS H7+L4 18/19 (CLASSWORD) ABS H7+L3+L5+L6+L7 20/21 (CLASSWORD,BUFFER,AND OPT PRAMS) ABS L8 22/23 (SCHEDULE W WAIT/WAIT) ABS L3+L4+L5+H8 24/25 (SCHEDULE NO WAIT/WAIT),(PART.STATUS) SPC 2 L2 EQU 1 L3 EQU 2 L4 EQU 4 L5 EQU 10B L6 EQU 20B L7 EQU 40B L8 EQU 100B H2 EQU 400B H3 EQU 1000B H4 EQU 2000B H5 EQU 4000B H6 EQU 10000B H7 EQU 20000B H8 EQU 40000B HED * * SYSTEM BASE PAGE COMMUNICATION AREA * * . EQU 1650B ESTABLISH ORIGIN OF AREA * * SYSTEM TABLE DEFINITION * * XI EQU .-1 X,Y SAVE ADDRESS EQTA EQU .+0 FWA OF EQUIPMENT TABLE EQT# EQU .+1 # OF EQT ENTRIES DRT EQU .+2 FWA OF DEVICE REFERENCE TABLE LUMAX EQU .+3 # OF LOGICAL UNITS (IN DRT) INTBA EQU .+4 FWA OF INTERRUPT TABLE INTLG EQU .+5 # OF INTERRUPT TABLE ENTRIES TAT EQU .+6 FWA OF TRACK ASSIGNMENT TABLE KEYWD EQU .+7 FWA OF KEYWORD BLOCK * * I/O MODULE/DRIVER COMMUNICATION * EQT1 EQU .+8 ADDRESSES EQT2 EQU .+9 EQT3 EQU .+10 OF EQT4 EQU .+11 EQT5 EQU .+12 CURRENT EQT6 EQU .+13 EQT7 EQU .+14 15 - WORD EQT8 EQU .+15 EQT9 EQU .+16 EQT EQT10 EQU .+17 EQT11 EQU .+18 ENTRY EQT12 EQU .+81 EQT13 EQU .+82 EQT14 EQU .+83 EQT15 EQU .+84 * CHAN EQU .+19 CURRENT DMA CHANNEL # TBG EQU .+20 I/O ADDRESS OF TIME-BASE CA3RD SYSTY EQU .+21 EQT ENTRY ADDRESS OF SYSTEM TTY * * SYSTEM REQUEST PROCESSOR /'EXEC' COMMUNICATION * * RQCNT EQU .+22 # OF REQUEST PARAMETERS -1 RQRTN EQU .+23 RETURN POINT ADDRESS RQP1 EQU .+24 ADDRESSES RQP2 EQU .+25 RQP3 EQU .+26 OF REQUEST RQP4 EQU .+27 RQP5 EQU .+28 PARAMETERS RQP6 EQU .+29 RQP7 EQU .+30 (SET FOR MAXIMUM OF RQP8 EQU .+31 9 PARAMETERS) RQP9 EQU .+32 * * DEFINITION OF SYSTEM LISTS (QUEUES) * * SKEDD EQU .+33 'SCHEDULE' LIST, SUSP3 EQU .+36 'AVAILABLE MEMORY' LIST, SUSP4 EQU .+37 'DISC ALLOCATION' LIST, SUSP5 EQU .+38 'OPERATOR SUSPEND' LIST * DEFINITION OF EXECUTING PROGRAM ID SEGMENT' * * XEQT EQU .+39 ID SEGMENT ADDR. OF CURRENT PROG. XLINK EQU .+40 'LINKAGE' XTEMP EQU .+41 'TEMPORARY (5-WORDS) XPRIO EQU .+46 'PRIORITY' WORD XPENT EQU .+47 'PRIMARY ENTRY POINT' XSUSP EQU .+48 'POINT OF SUSPENSION' XA EQU .+49 'A REGISTER' AT SUSPENSION XB EQU .+50 'B REGISTER' XEO EQU .+51 'E AND OVERFLOW * * SYSTEM MODULE COMMUNICATION FLAGS * * OPATN EQU .+52 OPERATOR/KEYBOARD ATTENTION FLAG OPFLG EQU .+53 OPERATOR COMMUNICATION FLAG SWAP EQU .+54 RT DISC RESIDENT SWAPPING FLAG DUMMY EQU .+55 I/O ADDRESS OF DUMMY INT. CARD IDSDA EQU .+56 DISC ADDR. OF FIRST ID SEGMENT IDSDP EQU .+57 -POSITION WITHIN SECTOR * * DEFINITION OF MEMORY ALLOCATION BASES * * BPA1 EQU .+58 FWA R/T DISC RES. BP LINK AREA BPA2 EQU .+59 LWA R/T DISC RES. BP LINK AREA BPA3 EQU .+60 FWA BKG DISC RES. BP LINK AREA LBORG EQU .+61 FWA OF RESIDENT LIBRARY AREA RTORG EQU .+62 FWA OF REAL-TIME AREA RTCOM EQU .+63 LENGTH OF REAL TIME COMMON AREA RTDRA EQU .+64 FWA OF R/T DISC RESIDENT AREA AVMEM EQU .+65 FWA OF SYSTEM AVAILABLE MEMORY BKORG EQU .+66 FWA OF BACKGROUND AREA BKCOM EQU .+67 LENGTH OF BABKGSMUND COMMON AREA BKDRA EQU .+68 FWA O NLHF BKG DISC RESIDENT AREA * * UTILITY PARAMETERS * TATLG EQU .+69 LENGTH OF TRACK ASSIGNMENT TABLE TATSD EQU .+70 # OF TRACKS ON SYSTEM DISC SECT2 EQU .+71 # SECTORS/TRACK ON LU 2 (SYSTEM) SECT3 EQU .+72 # SECTORS/TRACK ON LU 3 (AUX.) DSCLB EQU .+73 DISC ADDR OF RES LIB ENTRY PTS DSCLN EQU .+74 # OF RES LIB ENTRY POINTS DSCUT EQU .+75 DISC ADDR OF RELOC UTILITY PROGS DSCUN EQU .+76 # OF RELOC UTILITY PROGS LGOTK EQU .+77 LOAD-N-GO: LU,STG TRACK,# OF TRKS LGOC EQU .+78 CURRENT LGO TRACK/SECTOR ADDRESS SFCUN EQU .+79 SOURCE FILE LU AND DISC ADDRESS MPTFL EQU .+80 MEMORY PROTECT ON/OFF FLAG (0/1) FENCE EQU .+85 MEM PROTECT FENCE ADDRESS BKLWA EQU .+87 LWA OF MEMORY IN BACKGROUND * ORG * PROGRAM LENGTH END EXEC >N &; 92060-18019 A S C0122 $TRRN              H0101 FASMBҬ̬à$NN-USYSMUNS HDA-MŠUVŠ$NN-USYSMUNS NAM:$N SU:9060-09 :9060-609 PGM:G.A.A. (éPYGHԠH-PAKADMPANY95.A̠GHS SVD.NϠPAԠƠHSPGAMMAYBŠPHPD PDUDҠANSADϠANHҠPGAMANGUAGŠHUԪ HŠPҠNNSNԠƠH-PAKADMPANY. NAM$N09060-609V.A5036 Ԡ$NB$DNϬ$SD3$SK NԠ$N$GN$UU SUP AU0 BU $NSHŠNUKANUPUN. ԠSADBYHŠDSPAHҠHNVҠAPGAMMPS (HŠA̠SBYAYƠHŠNNԠANUPUN. SUNNSϠASŠANYA̠KSANDANYA AANSHŠPGAMHAS.ԠASϠASSANYU KSHŠPGAMHAS. ANGSUN: DBD-SGMNԠADDSS SB$N NMA̠UNGSSMANNGSS $NNP SB$UUASŠANYUKSSԠUPMPS DAD$NSԠHŠABŠADDSS SAMPBHPS SAMP DAAɠGԠHŠABŠSZ MANASZASSSԠNGAVŠƠZϠ MP$N SAMP3SԠPUNS SAPҠBHPS NSZMPDAAŠP DAMPɠGԠHŠN AƬAƠPUԠNҠAGNנA ANDB3MASK PAP5ƠNDBYMPNG SAMPɠPGAMAGҠNԠP SZPSPUN MPNPƠNԠDN N3SZMPA̠KP DAMPɠGԠHŠN ANDB3\A̠K PAP5ϠMPNGPGAM MPN6GϠASŠHŠK NSZMP3SPUN MPN3ƠNԠDNŠP DBMPGԠHŠDAAŠAG DAD$NANDHŠAAŠSUSPNDAG SZBSSƠANYDAAD SB$SD3SHDUŠANYANGPGAMS MP$NɠUN N6ҠMPɠAҠHŠK SAMPɠAGANDS SZASSƠDAAD SAMPSԠAGҠNDƠP SBSNנSHDUŠANYASҠHSN MPNUNϠP SKP $GNSHŠAҠGBA̠NUNŠҠUSŠBYDVS ANDHҠSUHUSҠNSYSMPGAMS ANGSUN: DANSԠAϠUSҠND SB$GNA̠HSUN UNGSSMANNGSS. $GNMPMPNZŠNSԠUMPϠH. SABSAVŠHŠNNUMB ANDB3AUAŠHŠAB ADAD$NADDSS SAMPANDSԠ DABGԠNDAGAN ҠB3SԠHŠGBA̠AG PAMPɠSHSAGA̠N? SSYSSKP MP$GNɠNϠUNNϠAN AND3AҠHŠN SAMPɠANDSԠ SBSNנSHDUŠANYANGPGAMS MP$GNɠUN SPà3 SNנSHDUSANYPGAMSSUSPNDDNHŠ'3'S HAAG(MP(USUAYNKUSԠSUSPND SNנNP DAMPGԠHŠAGD SB$SD3SHDUŠA̠SUHAS MPSN׬ɠUN SKP HSSUBUNŠASSA̠U'SKDBYAPGAM ANDSHDUSANYPGAMSANGҠAN UҠANN. ANGSUN: DBDADDSS SB$UU UN-GSSMANNNGSS $UUNP SB $DNϠGԠHŠDNUMB SBP5SԠҠ$N BƬBƠPUԠHŠAGD SBP6NHGHND ADBP5ANDNBHNDS SBPSԠNP DAUMAؠSԠUPϠSANH MAŬNAD SAMP DADԠGԠHŠDԠADDSS SAMP3ANDSԠҠP UUDAMP3ɠSAHҠA ANDB300KDU'S SZAHSNŠKD? MPUUYS-GϠS UUSZMP3NϠYSSPϠNԠNY SZMPƠNԠDN MPUUYNԠN BSZSSƠNNŠASD MP$UUɠUSԠ SBMPɠAҠHŠN SBSNנSHDUŠNAS DAD$NANDAAN SB$SD3AS MP$UUɠ UUB S̠0SHԠKAGϠנB ADBD$NANDNDؠNϠHŠNAB DABɠGԠHŠNAG PAPUNԠPGAM? ŬSSYSSKP MPUUNϠNNUŠSAH SBMPYSSԠADDSSҠSHDU DAMP3ɠGԠHŠDԠNY AND300AҠHŠAG SAMP3ɠSԠԠAND MPUUNNUŠSAH D$NDƠ$NB B3Ԡ3 3Ԡ00 B300Ԡ300 300Ԡ0 SPà MPSAD$NNAZŠD MPDBBɠGԠADDSS MP3MP$SKD.ҠANDGϠSAԠK DԠU65B UMAؠU653B P5U0B P6U05B PU06B PU0B GPGAMNGH ND$N   92060-18020 1840 S 0522 RTE-III SCHEDULAR              H0105 ASMB,R,Q,C ** RT SCHEDULER MODULE ** HED RTE SCHEDULER/MESSAGE PROCESSOR * NAME: SCHED * SOURCE: 92060-18020 * RELOC: 92060-16020 * PGMR: G.A.A.,L.W.A.,D.L.S. * DATE: 5\5\75 * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM SCHEDM 92060-16020 REV.1840 780810 * SUP ******************************************************************* * * ***** AMD ***** JUL,73 ***** DAS ***** APR,75 * ******************************************************************* * * SCHED ENTRY POINT NAMES * ENT $LIST,$MESS,$CVT3,$CVT1,$ABRT,$TYPE ENT $MPT1,$MPT2,$MPT3,$MPT4,$MPT5,$MPT6 ENT $PARS,$STRT,$SCD3,$INER,$MPT7,$ASTM ENT $MPT8,$IDNO,$WORK,$WATR,$IDSM ENT $MPT9,$RTST,$CVWD,$STRG,$IDEX ENT $MPSA,$MSEX,$PBUF,$PTST * * SCHED EXTERNAL REFERENCE NAMES * EXT $XSIO,$IOUP,$IODN,$ERMG,$DREQ EXT $IOCL,$OTRL,$DREL EXT $ERAB,$ZZZZ,$TIME,$PVCN EXT $ERIN,$NOPG,$OPER,$ILST,$NOLG,$LGBS,$NMEM EXT $XEQ,$TMRQ,$ONTM,$ALC,$RTN EXT $BRED,$TIMR,$ETTM,$TIMV,$TREM EXT $RNTB,$CREL,$SYMG,$SDRL EXT $ENDS,$ALDM,$DMAL,$MATA,$PRCN EXT $MEU ALDM EQU $ALDM DMAL EQU $DMAL PRCNG EQU $PRCN * * *******************MEU INSTRUCTIONS*********** ********************************************** EXT $BLLO,$BLUP * ******************************************************************* * * THE SCHED MODULE OF HP2100 REAL TIME EXECUTIVE CONSISTS OF * * 1. LIST PROCESSORS * 2. LINK PROCESSORS * 3. OPERATOR INPUT MESSAGE PROCESSORS * 4. SYSTEM STPART UP AND OPER INPUT REQUEST ACKNOWLEDGE * 5. MEMORY PROTECT VIOLATION SCHEDULER PREPROCESSORS * 6. ABORT AND TERMINATION PROCESSORS * ******************************************************************* HED --BUFFERS, CONSTANTS, POINTERS, ETC * TEMP LDA EQT11 ***TEMPORARY WORKING STORAGE AREA TEMP1 STA TEMP5 * TEMP2 LDB EQT12 * TEMP3 STB TEMP6 * TEMP4 JSB $RTN * THESE TEMPS ARE USED TO INITIALIZE TEMP5 NOP *** SYSTEM AVAILABLE MEMORY. TEMP6 NOP * AND ALSO TMP JMP $ALC * USED BY $PARS AS CONTIGUOUS BUFFER SPACE WORK JMP GTFMG * $WORK EQU WORK * WPRIO NOP * ASCI BSS 1 * ASCI1 BSS 1 *** ASCI2 BSS 1 DM5 DEC -5 * D2 DEC 2 D4 DEC 4 D5 DEC 5 D6 DEC 6 D7 DEC 7 D9 DEC 9 D14 DEC 14 D15 DEC 15 D17 DEC 17 * D1 OCT 1 D3 DEC 3 B77 OCT 77 B177 OCT 177 B377 OCT 377 * ZERO REP 5 (NOTE: EQUATED TO $IDEX) NOP DEF0 DEF ZERO $IDEX EQU ZERO (DUMMY ENTRY USED BY RTE-IV FMGR) HED ID-SEGMENT MAP ID-SEGMENT MAP ID-SEGMENT MAP * WORD USE * 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 0 * ! ! ! ! ! ! * 1 LIST LINKAGE * ! ! ! ! ! ! * 2-6 5 WORD TEMPORARY AREA USED FOR SPECIAL FLAGS IN QUEUES ETC. * ! ! ! ! ! ! * 7 PRIORITY * ! ! ! ! ! ! * @ 8 PRIMARY ENTRY POINT * ! ! ! ! ! ! * 9 POINT OF SUSPENSION (XSUSP) * ! ! ! ! ! ! * 10 A REGISTER AT SUSPENSION (XA) * ! ! ! ! ! ! * 11 B REGISTER AT SUSPENSION (XB) * ! ! ! bK ! ! ! * 12 E/O REGISTERS AT SUSPENSION (XEO) * ! ! ! ! ! ! * @ 13 NAME ( FIRST AND SECOND CHARACTERS ) * ! ! ! ! ! ! * @ 14 NAME (THIRD AND FOURTH CHARACTERS) * ! ! ! ! ! ! * @ 15 NAME (FIFTH CHARACTER)---- TM CL AM SS --- TYPE --- * ! ! ! ! ! ! * 16 NA NP W A O R D --- STATUS- * ! ! ! ! ! ! * 17 TIME LIST LINKAGE WORD * ! ! ! ! ! ! * @ 18 RESOLUTION T -------MULTIPLE----------------------- * ! ! ! ! ! ! * @ 19 LOW ORDER 16 BITS OF EXECUTE TIME LESS 24 HRS IN 10'S MS. * ! ! ! ! ! ! * @ 20 HIGH ORDER 16 BITS OF EXECUTE TIME * ! ! ! ! ! ! * 21 BA FW AT RM RE PW RN --FATHER ID-SEG. NUMBER-- * ! ! ! ! ! ! * 22 RP ---# OF PAGES---,--MPFTI-- .. ----PARTITION #---- * ! ! ! ! ! ! * @ 23 LOW MAIN ADDRESS * ! ! ! ! ! ! * @ 24 HI MAIN ADDRESS + 1 * ! ! ! ! ! ! * @ 25 LOW BASE PAGE ADDRESS * ! ! ! ! ! ! * @ 26 HI BASE PAGE ADDRESS + 1 * ! ! ! ! ! ! * @ 27 DISC ADDRESS (LU (15),TRACK (14-7),SECTOR(6-0) * ! ! ! ! ! ! * 28 SWAP DISC ADDRESS (LU (15),TRACK (14-7),#TRACKS(6-0) * ! ! Q ! ! ! ! * 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 0 * * @ WORDS USED IN SHORT ID SEGMENTS SKP * WHERE THE FLAG BITS MEAN: * * TM = TEMP LOAD (COPY OF ID-SEG NOT ON DISC) * CL = CORE LOCK (MAY NOT SWAP) * AM = ALL MEMORY (PROGRAM USES ALL OF ITS AREA) * SS = SHORT SEGMENT (INDICATES A 9-WORD ID-SEGMENT) * NA = NO ABORT (PASS ABORT ERRORS TO THE PROGRAM INSTEAD) * NP = NO PRAMS ALLOWED ON RESCHEDULE. * W = WAIT BIT (WAITING FOR PROG. WHOES ID-SEG ADD. IS IN WD.2) * A = ABORT ON NEXT LIST ENTRY FOR THIS PGM. * O = OPERATOR SUSPEND ON NEXT SCHEDULE ATTEMPT * R = RESOURCE SAVE (SAVE RESOURCES WHEN SETING DORMANT) * D = DORMANT BIT (SET DORMANT ON NEXT SCHEDULE ATTEMPT) * T = TIME LIST ENTRY BIT (PROG IS IN THE TIME LIST) * BA = BATCH (PROGRAM IS RUNNING UNDER BATCH) * FW = FATHER IS WAITING (HE SCHEDULE WITH WAIT) * AT = ATTENTION BIT (OPERATOR HAS REQUESTED ATTENTION) * RM = RE-ENTRENT MEMORY MUST BE MOVED BEFORE DISPATCHING PGM. * RE = RE-ENTRENT ROUTINE IN CONTROL NOW * PW = PROGRAM WAIT (SOME PROGRAM WANTS TO SCHEDULE THIS ONE ) * RN = RESOURCE NUMBER EITHER OWNED OR LOCKED BY THIS PGM. * RP = RESERVED PARTITION FOR REQUESTING PROGRAMS ONLY. * * * $LIST STATE TRANSITION TABLE: * * THE FOLLOWING TABLE DETAILS THE STATE TRANSITIONS EFFECTED BY * $LIST. THE MAJOR STATES ARE 0 THRU 6 (DORMANT THRU OP-SUSP) * AND THE STATE MODIFIERS ARE THE ADDITIONAL BITS SET FROM TIME * TO TIME IN THE STATUS WORD. THE BITS WHICH AFFECT OR ARE * MODIFIED BY $LIST ARE (SEE ABOVE DESCRIPTION): * * BIT WEIGHT POSITION * O 10 9 * W 4 12 * R 2 7 * D 1 6 * * THESE BITS ARE COMBINED TO FORM 16 SUBSTATES AS PER THE TABLE BELOW * THE ENTRYS IN EACH SQUARE OF THE TABLE DEFINE THE NEXT STATE AS * FOLLOWS: * * THE FIMRST DIGIT IS THE REQUESTED MAJOR TRANSITION (FROM * THE $LIST CALL). * THE SECOND TWO NUMBERS (SEPERATED BY A ".") DEFINE THE NEXT * MAJOR STATE . SUBSTATE. THUS 62.10 INDICATES A OP-SUSPEND * REQUEST (6) CAUSES A MOVEMENT TO I/O SUSPEND (2) SUBSTATE 10 * (THE O BIT IS SET). * A "*" AS THE DESTINATION INDICATES THE CURRENT STATE/SUB- * STATE I.E. NO CHANGE. * ILLEGAL OR UNEXPECTED STATES ARE MARKED WITH "X" * ONLY EXPECTED CALLS ARE PLOTTED. * * IN GENERAL CODE EXTERNAL TO $LIST MOVES PROGRAMS FROM SUB-STATE * TO SUB-STATE WHILE ONLY $LIST CAN MOVE A PROGRAM FROM ONE * MAJOR STATE TO ANOTHER. HED SYSTEM STATE TABLE******SYSTEM STATE TABLE*** *MAJOR STATE 0 1 2 3 4 5 6 *SUB-STATES *---------!-----!-------!-------!-------!-------!-------!------ * 0 11.0 00.0 02.1 00.0 00.0 00.0 00.0 * 22.0 11.0 11.0 11.0 11.0 11.0 * 33.0 62.10 66.0 66.0 66.0 * 44.0 * 55.0 * 66.0 *---------!-----!-------!-------!-------!-------!-------!------ * 1 D X X 02.1 X X X X * 10.0 * 62.11 *---------!-----!-------!-------!-------!-------!-------!------ * 2 R 11.0 00.2 02.3 00.2 00.2 00.2 06.3 * 66.3 *---------!-----!-------!-------!-------!-------!-------!------ * 3 RD X X 0* X X X 0* * 10.2 10.2 *---------!-----!-------!-------!-------!-------!-------!------ * 4 W 00.0 33.4 00.0 00.0 00.0 00.0 00.0 * 1* 13.4 * 66.4 *---------!-----!-------!-------!-------!-------!-------!------ * 5 WD X X X X X X X *---------!-----!-------!-------!-------!-------!-------!------ * 6 WR 0* X X 00.6 X X 06.7 * 13.4 * 66.7 *---------!-----!-------!-------!-------!-------!-------!------ * 7 WRD X X X X X X 0* * 10.6 *---------!-----!-------!-------!-------!-------!-------!------ * 10 O X X 02.11 X X X X * 16.0 * 6* *---------!-----!-------!-------!-------!-------!-------!------ * 11 OD X X 0* X X X X * 10.0 * 6* *---------!-----!-------!-------!-------!-------!-------!------ * 12 OR X X 02.13 X X X X *---------!-----!-------!-------!-------!-------!-------!------ * 13 ORD X X 0* X X X X * 16.3 * 6* *---------!-----!-------!-------!-------!-------!-------!------ * 14 OW X X X X X X X *---------!-----!-------!-------!-------!-------!-------!------ * 15 OWD X X X X X X X *---------!-----!-------!-------!-------!-------!-------!------ * 16 OWR X X X X X X X *---------!-----!-------!-------!-------!-------!-------!------ * 17 OWRD X X X X X X X *---------!-----!-------!-------!-------!-------!-------!------ HED REAL TIME SCHEDULER---LIST PROCESSOR SECTION--- * * THE $LIST PROCESSOR SECTION OF THE HP-2100 REAL TIME * EXECUTIVE PROCESSES THE FOLLOWING LIST REQUESTS * 1. DORMANT * 2. SCHEDULE * 3. OPERATOR SUSPEND * 4. NON-OPERATOR SUSPEND * A. I/O * B. MEMORY AVAILABLE * C. DISC AVAILABLE * 5. SEGMENT LOADING * * * * CALLING SEQUENCE I@* * JSB $LIST * OCT (ADDRESS CODE)(FUNCTION CODE) * DEF (ADDRESS) * * IF A = 0, THEN NO MESSAGE * A NOT 0, THEN ADDR OF MESSAGE * IF ERROR, (B) CONTAINS ASCII ERR CODE * WHERE * FUNCTION CODE * 0 = DORMANT REQUEST * 1 = SCHEDULE REQUEST * 2 = I/O SUSPEND REQUEST * 3 = GENERAL WAIT LIST REQUEST * 4 = MEMORY AVAILABEL REQUEST * 5 = DISK ALLOCATION REQUEST * 6 = OPERATOR SUSPEND REQUEST * 17 = RELINK PROGRAM REQUEST * 10 THRU 16 ARE NOT ASSIGNED * * ADDRESS CODE * 0 = ID SEGMENT NAME FOLLOWED BY 5 OPTIONAL * PARAMETERS TO GO INTO TEMPORARY AREA OF ID SEG. * 1 = ID SEGMENT ADDRESS * 2 = ASCII PROGRAM NAME ADDRESS * 3 = ID SEGMENT ADDRESS IN WORK * 4 = ID SEGMENT ADDRESS IN B-REG * 5 = ID SEGMENT ADDRESS IN XEQT * 6 = ID SEG ADD FOLLOWED BY CONTENTS TO BE PUT * INTO "B-REG @ SUSP" WORD OF ID SEG. * 7 = ID SEG NAME FOLLOWED BY 5 PARAMETERS TO GO * INTO ID'S TEMPORARY AREA. * * * ADDRESS * KEYWORD, ID SEGMENT, OR * PROGRAM NAME ADDRESS AS SPECIFIED BY CODE * MUST NOT BE SUPPLIED FOR * ADDRESS CODES 3 AND 4. * SKP $LIST NOP ENTRY/EXIT LDA $LIST,I WORD 1 AND D15 STA L0091 STORE AWAY REQUEST CODE XOR $LIST,I FORM ADDR CODE ALF,ALF *. RAL,RAL CPA D4 ADDRESS IN B-REG? JMP L0021 YES GO SET UP CPA D3 ADDRESS IN WORK? JMP L0060 YES GO SET UP LDB XEQT PRESET FOR CURRENT EXECUTING PGM. CPA D5 CURRENT PGM? JMP L0021 YES GO SET IT UP ISZ $LIST STEP TO ADDRESS WORD LDB $LIST,I GET IT TO B CPA D1 IS ADDRESS NOW IN B? JMP L0021 YES GO SET IT UP CPA D2 DOES B POINT TO AN ASCII NAME? JMP DL02 YES, SO GO SEE IF PROGRAM EXISTS. * STB RETRN B-REG MAY BE A RETURN ADDRESS, SO SAVE. ISZ $LIST BUMP POINTER TO EITHER PROG.NAME OR ADD. CPA D6 JMP DL06 LDB $LIST,I GET THE ID ADD. OR PROG.NAME ADDRESS. SZA,RSS IF ADDRESS = 0 THEN ID ADDRESS. JMP DL00 IF NON ZERO, THEN PROCESS AS ADDRESS * JSB TNAME OF PROGRAM NAME. GO GET ID ADDRESS. SEZ IF PROGRAM DOES NOT JMP NPRG EXIST, THEN TELL FOLKS. * DL00 JSB DORM? SETUP THE $LIST PRAMS & SEE IF DORMANT. SZA IS THE PROGRAM DORMANT? JMP L0074 NO, GO TELL CALLER TO FORGET IT. * * THE FOLLOWING ROUTINE IS USED FOR ADDRESS CODES 0 AND 7 * TO STUFF PARAMETERS INTO THE PROGRAM'S ID SEGMENT. CODES * 0 AND 7 ARE PROVIDED FOR DRIVERS WHICH WISH TO SCHEDULE * PROGRAMS. * * ASSUMPTIONS * 1) AT LEAST ONE PARAMETER MUST BE SUPPLIED(I.E. ONE DEF). * 2) THE RETURN ADDRESS MUST END THE PARAMETERLIST. * 3) 5 PARAMETERS ARE THE MAXIMUM. * 4) ABSOLUTELY NO ERROR CHECKING IS DONE. * ISZ $LIST BUMP $LIST TO POINT TO FIRST PARAMETER. LDB RETRN USE RETURN ADDRESS CMB,INB TO DETERMINE HOW MANY ADB $LIST PARAMETERS TO PASS. STB DM5 SAVE TO FAKE OUT SUBROUTINE *PRAM*. * LDA WORK SET A-REG TO ID ADDRESS. LDB $LIST SET B-REG TO PARAMETER'S ADDRESS. ADB uySIGN SET SIGN BIT OF B-REG. JSB PRAM GO STUFF THE ID ADDRESS. * LDA DMM5 RESET -5 CONSTANT STA DM5 TO MINUS 5. CCA SET UP THE RETURN ADA RETRN ADDRESS FOR $LIST'S STA $LIST REURN. JMP L0275 NOW GO SCHEDULE THE PROGRAM. * DL06 LDA $LIST,I SET A-REG TO "B-REG @ SUSP". STA TEMPX AND SAVE TEMPORRIALLY. JSB DORM? SET UP LIST PARAMETERS & CHECK FOR DORMANT. SZA IF PROGRAM IS DORMANT, JMP L0075 THEN TELL CALLER TO FORGET IT. LDB WORK PUT "B-REG @ SUSP" ADB D10 VALUE INTO THE LDA TEMPX PROPER ID STA B,I SEGMENT JMP L0275 WORD.GO SCHEDULE. * DL02 JSB TNAME NOW ITS IN B SEZ,RSS SKIP IF NOT FOUND OR SHORT ID SEG. JMP L0021 PROG FOUND, SO GO PROCESS JMP NPRG1 * NPRG CCA RESTORE ADA RETRN $LIST FOR STA $LIST RETURN. NPRG1 LDA $NOPG NO SUCH PROG ERROR MESSAGE LDB D5 NO SUCH PROG ERROR CODE JMP L0015 GO TO RETURN * * PROCESS ID SEGMENT ACCORDING TO REQUEST CODE * L0060 LDB WORK SET B-REG TO ID ADDRESS. * L0021 JSB DORM? GET CURRENT PROGRAM LDB L0091 REQUEST CODE. SZB,RSS CHECK IF DORMANT REQUEST JMP L0100 DORMANT REQUEST CPB D1 CHECK IF SCHEDULE REQUEST JMP L0200 YES CPB D6 CHECK IF OPERATOR SUSPEND REQUEST JMP L0300 YES CPB D15 CHECK IF LINKAGE UPDATE REQUEST JMP L0135 YES JMP L0400 MUST BE A SIMPLE LIST MOVE * L0074 CCA RESTORE ADA RETRN $LIST STA $LIST FOR RETURN. L0075 LDA $ILST ILLEGAL STATUS MESSAGE ADDRESS LDB D3 ILLEGAL STATUS ERROR CODE JMP L0015 GO TO EXIT * RETRN NOP DMM5 DEC -5 TEMPX NOP SKP * ************************************************************ * * THE DORM? SUBROUTINE IS CALLED BY THE $LIST PROCESSOR * FOR ALL CALLS. IT'S PRIMARY PURPOSE IN LIFE IS TO SET * UP WORK, WPRIO, WSTAT AND L0090. IN ADDITION, IT RETURNS * L0090, THE PROGRAM'S CURRENT STATUS, IN THE A REGISTER. * $LIST FUNCTION CODES OF 0, 6 AND 7(THE DRIVER $LIST CALLS) * USE THIS SUBROUTINE TO SEE IF THE PROGRAM IS DORMANT. * * CALLING SEQUENCE: * LDB ID-ADDRESS * JSB DORM? * * RETURN: * A-REG = CURRENT STATUS(BITS 0-6) * ************************************************************* * DORM? NOP STB $WORK SET UP THE ID ADDRESS FOR LATER. ADB D6 AND STB WPRIO THE PRIORITY WORD ADB D9 AND STB WSTAT THE STATUS WORD. LDA B,I GET THE OLD STATUS AND D15 AND KEEP ONLY LOWER STA L0090 STATUS BITS. JMP DORM?,I RETURN TO USER. HED LIST PROCESSOR--DORMANT REQUEST * * DORMANT REQUEST * * THE DORMANT REQUEST IS PROCESSED AS FOLLOWS: * IF ABORT BIT SET, MAKE PROGRAM DORMANT * IF ALREADY DORMANT, RETURN * IF SCHEDULED, THEN ENTERED INTO DORMANT LIST, POINT * OF SUSPENSION CLEARED. * IF ID SEGMENT ADDRESS IS SAME AS RESIDING * BACKGROUND DISC RESIDENT PROGRAM, THEN BKRES * FLAGS ARE CLEARED SO ANOTHER PROGRAM MAY BE * LOADED INTO THE AREA. * IF ID SEGMENT ADDRESS IS SAME AS RESIDING REAL * TIME DISC RESIDENT PROGRAM, THEN RDISK FLAGS * ARE CLEARED SO ANOTHER PROGRAM MAY BE LOADED * INTO THE AREA. * IF NOT ONE OF ABOVE, THEN DORMANT BIT SET IN STATUS SPC 1 L0100 LDB WSTAT,I CHECK IF ABORT BIT SET BLF RBL,SLB,BLF JMP L0115 YES, SO GO MAKE DORMANT CPA D2 IF I/O SUSPE^NDED L0103 ALF,SLA,RAL SET DORMANT BIT JMP L0350 ELSE GO CHECK RESOURCE BIT * L0105 IOR WSTAT,I IF I-O SUSP.,MERGE CURRENT STATUS AND SET JMP L0375 NP BIT IF DOER IS NOT CUR.PROG.(TO SAVE TEMPS). * L0115 LDA WORK CLEAR ID SEG TEMP AND SET B LDB DEF0 JSB PRAM LDB WORK SET FLAG FOR DISPATCHER CLA CPB XEQT STA $PVCN ADB D8 LINK THROUGH XSUSP LDA $ZZZZ SO RESIDENT FLAGS STB $ZZZZ ARE STA B,I CLEARED ADB D6 INDEX TO TYPE WORD LDA B,I AND CLEAR AND NCLAM THE CORE LOCK AND ALL OF MEMORY STA B,I BITS CLA STA XEQT CLEAR CURRENT PGM FLAG IN CASE IT IS SPC 1 L0130 STA WSTAT,I SET THE NEW STATUS AND D15 GET THE ADDITION CODE L0135 LDB L0090 SET B FOR LINK JSB LINK RELINK THE PROG CLA SET FOR NORMAL RETURN LDB $WORK SET B-REG=ID ADDRESS OF PROG L0015 ISZ $LIST STEP TO RETURN ADDRESS JMP $LIST,I LOOK MA! NO LABEL! SPC 1 SPC 1 L0350 SLB,RSS IF RESOURCE BIT NOT SET JMP L0115 GO MAKE DORMANT CPA D6 IF OPERATOR SUSPENDED JMP L0103 GO SET DORMANT BIT TOO. * L0355 LDA WSTAT,I GET OLD STATUS AND CLD.R CLEAR THE "R" AND "D" BITS L0375 LDB WORK IF NOT CURRENT CPB XEQT PROGRAM THEN RSS IOR B20K SET THE NO PRAMS BIT. JMP L0130 GO PUT IN THE DORM LIST SPC 2 L0090 NOP L0091 NOP SPC 1 NCLAM OCT 177637 HED LIST PROCESSOR--SCHEDULE REQUEST * * SCHEDULE REQUEST * * THE SCHEDULE REQUEST IS PROCESSED AS FOLLOWS: * IF ABORT BIT SET, STORE ID SEGMENT ADDRESS SUCH THAT * PROGRAM WILL BE ABORTED AT NEXT ENTRY FROM XEQ * IF DORMANT BIT SET, GO TO DORMANT REQUEST * IF OPERATOR-SUSPEND BIT SET, GO TO OPERATOR-SUSPEND * REQUEST * IF SCHEDULED, THEN STATUS ERROR EXIT * IF CURRENT STATUS NOT ONE OF ABOVE, THE PROGRAM IS * ENTERED INTO THE SCHEDULE LIST. * L0200 CPA D6 IF OP-SUSP JMP L0250 GO CHECK FOR DORMANT BIT LDB WSTAT,I GET WHOLE STATUS WORD CPA D2 IF I/O SUSP. THEN BLF,SLB,BLF ROTATE AND SKIP JMP L0255 ELSE GO CHECK WAIT BIT * RBR,SLB,RBL IF OP-SUSP BIT SET JMP L0220 GO CHECK FURTHER * L0270 CLA,INA SET A FOR SCHEDULE RBL DORM BIT TO 15 SSB IF DORM BIT SET JMP L0100 GO SET DORMANT * * CHECK FOR SERIAL REUSABLE OR SAVE RESORCES OR * OP SUSPEND TERMINATION LAST TIME THROUGH. * L0275 LDA L0090 GET THE CURRENT STATUS. SZA IF 0 CPA D6 OR 6, THEN RSS CHECK ON THE PROGS LAST PARTITION. JMP L0290 ELSE, GO SCHEDULE THE PROGRAM. * LDB WORK GET THE ID ADDRESS AND ADB D14 INDEX TO THE TYPE LDA B,I WORD AND GET AND D15 TYPE ONLY. CPA D1 NOW IF ITS MEMORY RESIDENT, THEN NO JMP L0290 PARTITION SO JUST SCHEDULE. * ADB D7 MUST BE 1ST DISPATCH & DISC RESIDENT. LDA B,I GET THE PARTITION WORD. AND B77 USE IT TO INDEX MPY D6 INTO THE $MATA ADA $MATA TABLE. ADA D3 CHECK TO SEE LDA A,I IF THE D BIT AND B20K IS SET. SZA,RSS IF NOT SET, THEN JMP L0290 GO SCHEDULE IT. LDA WORK GET THE ID ADDRESS AND MOVE JSB DMAL INTO THE ALLOCATED LIST. * L0290 CLA,INA SET FOR SCHEDULE AND JMP L0130 THEN DO IT TO IT !!! * L0220 RBL,SLB CHECK RESOURCE BIT JMP L0230 IF SET GO CLEAR OP-SUSP SSB IF DORM BIT SET JMP L0100 GO MAKE DORMANT * L0YANLH230 LDA B1004 CLEAR THE OP-SUSP BIT AND JMP L0280 GO OP-SUSP THE PGM. * L0250 LDA WSTAT,I IF OP-SUSP BIT SET AND B100 AND DORM BIT SET SZA JMP L0355 GO CLEAR BIT AND SET DORMENT * L0255 LDA WSTAT,I IF WAIT BIT SET ALF,SLA,ALF THEN ALF,SLA,ALF GO MOVE TO WAIT LIST (SKIPS) JMP L0270 ELSE, SCHEDULE THE PROGRAM * XOR D3 CHANGE STATUS TO 3 AND D15 L0280 XOR WSTAT,I AND JMP L0130 GO RELINK HED LIST PROCESSOR--SUSPEND REQUESTS * * OPERATOR SUSPEND REQUEST * * THE OPERATOR-SUSPEND REQUEST IS PROCESSED AS FOLLOWS: * IF DORMANT, THEN ENTER INTO OPERATOR SUSPEND LIST * IF ALREADY OPERATOR SUSPEND, THEN STATUS ERROR EXIT N* IF SCHEDULED, THEN ENTER INTO OPERATOR SUSPEND LIST * IF NOT ONE OF ABOVE, THEN OPERATOR-SUSPEND BIT SET * L0300 LDB WSTAT,I CGET THE FULL STATUS WORD SZB IF ZERO CPA D6 OR OP-SUSP JMP L0075 REJECT THE REQUEST * CPA D2 IF I/O SUSP JMP L0310 GO SET TO "O" BIT * SZA IF DORM WITH RESOURCES SKIP JMP L0400 ELSE GO RELINK I.E. SET OP-SUSP. * LDA B306 ELSE SET "R" AND "D" BITS AND IOR B PUT IN OP-SUSP LIST JMP L0130 * L0310 LDA B1000 SET OPER-SUSP BIT IN STATUS JMP L0105 GO SET BIT AND EXIT SPC 1 * * NON-OPERATOR SUSPEND REQUEST * * THE NON-OPERATOR SUSPEND REQUEST IS PROCESSED AS FOLLOWS: * THE PROGRAM IS ENTERED INTO THE REQUESTED LIST AND * THE NEW STATUS REPLACES THE 4 LOW ORDER BITS OF THE * PROGRAM STATUS-THUS SAVING THE DORMANT OR OPERATOR- * SUSPEND BITS THAT MAY BE PRESENT. * * L0400 LDA WSTAT,I UPDATE STATUS SAVING ALL AND C17 BUT LOW 4 BITS IOR L0091 JMP L0130 GO TO EXIT SPC 1 C17 OCT 177760 B100 OCT 100 B306 OCT 306 B1004 OCT 1004 CLD.R OCT 57460 HED LINK UPDATE PROCESSOR * * THE LINK PROCESSOR SECTION OF THE HP-2116 REAL TIME * EXECUTIVE * 1. REMOVES A PROGRAM FROM A LIST * AND * 2. ENTERS THE PROGRAM INTO ANOTHER LIST AT THE PROPER PLACE * ACCORDING TO PRIORITY LEVEL. * * * * CALLING SEQUENCE * * LDB CODE1 * LDA CODE2 * JSB LINK * * WHERE * CODE1 = CODE OF REMOVAL LIST * CODE2 = CODE OF INSERTION LIST * THE ID SEGMENT IS ASSUMED TO BE LOCATED IN WORK * AND WPRIO SET * * * THE REMOVAL OF PROGRAM FROM A LIST CONSISTS OF: * 1. IF I/O LIST (CODE 2), THEN THIS IS SPECIAL CASE * U AND DOES NOT REQUIRE REMOVAL. * 2. IF NULL LIST, THEN ERROR EXIT TAKEN. * 3. IF FIRST AND ONLY PROGRAM IN LIST, THEN LIST * VALUE SET TO ZERO. * 4. IF FIRST PROGRAM IN LIST, BUT NOT THE ONLY * PROGRAM IN LIST(LINKAGE NOT ZERO), THEN SET LIST * VALUE TO THE LINKAGE VALUE. * 5. IF IN MIDDLE OF LIST, THE LINKAGE OF THE ID SEG * MENT WHICH POINTS TO THE PROGRAM TO BE REMOVED * IS SET TO THE LINKAGE VALUE OF THE PROGRAM THAT * IS REMOVED. * 6. IF LAST PROGRAM IN LIST, THE LINKAGE VALUE OF * PREVIOUS PROGRAM IN LIST IS SET TO ZERO. * LINK NOP ENTRY/EXIT SZB IGNOR DORMANT AND CPB D2 I/O LIST REQUESTS JMP LK100 YES, SEE IF ADDITION. ADB LLIST ADD TOP OF LIST POINTER * LK010 STB TEMP TOP OF REMOVAL LIST LDB B,I GET TOP OF LIST POINTER SZB,RSS END OF LIST? JMP LK150 YES, RETURN CPB WORK MATCHES PROGRAM? RSS YES JMP LK010 NO, KEEP SEARCHING LDB B,I UPDATE LINKAGE TO BYPASS STB TEMP,I THE DELETED ID SEG HED LINK PROCESSOR--ADDING PROGRAM TO A LIST * * ADD A PROGRAM TO A LIST * * THE ADDITION OF PROGRAM TO A LIST CONSISTS OF: * 1. IF I/O LIST (CODE 2), THEN THIS IS SPECIAL CASE * AND NO ADDITION MADE TO LIST. * 2. IF NULL LIST, THEN LIST VALUE SET TO POINT TO ID * SEGMENT OF PROGRAM TO BE ADDED AND THE LINKAGE * SET TO ZERO. * 3. IF NOT NULL LIST, THE PROGRAM IS INSERTED INTO * LIST ACCORDING TO PRIORITY LEVEL AND LINKAGES * CHANGED TO REFLECT THIS INSERTION. * 4. IF OF LOWER PRIOR. THAN ANY PROGRAM IN LIST, THEN * LAST LINKAGE IS SET TO POINT TO THE PROG*RAM TO * BE ADDED AND THE PROGRAM LINKAGE IS CLEARED. * LK100 SZA IGNOR DORMANT AND CPA D2 I/O LIST REQUESTS JMP LINK,I YES, RETURN ADA LLIST ADD TOP OF LIST POINTER * LK110 STA TEMP SAVE TOP OF LIST POINTER LDA A,I GET POINTER SZA,RSS END OF LIST? JMP LK140 YES, LINK IN NEW PROG CPA WORK IS IT A DUPLIC. PROG? JMP LK150 YES, DUPLIC SO RETURN STA B NOT DUPLIC, COMPARE PRIORITY ADB D6 OF WORK ID SEG LDB B,I AGAINST CMB,INB CURRENT ADB WPRIO,I ID SEG SSB,RSS WORK < CURRENT? JMP LK110 NO, SEE NEXT ONE * LK140 STA WORK,I LINK THIS TO FOLLOW WORK LDA WORK LINK WORK TO FOLLOW STA TEMP,I PREVIOUS PROG * LK150 JMP LINK,I RETURN * * LLIST DEF DORMT TOP OF LIST ADDRESS WSTAT NOP WORK STATUS ADDRESS DM32 DEC -32 B1000 OCT 1000 B4000 OCT 4000 COM OCT 54 TBUF DEF TEMP5 TBUFS DEF TEMP5+7 DM58 DEC -58 HED OPERATOR INPUT MESSAGE PROCESSOR * * THE $MESS PROCESSOR SECTION OF HP-2116 REAL TIME EXECUTIVE * PROCESSES THE FOLLOWING OPERATOR INPUT REQUESTS: * * 1. TURN ON A PROGRAM * ON[IH],XXXXX * ON[IH],XXXXX,NOW * ON[IH],XXXXX,P1,...,P5 * ON[IH],XXXXX,NOW,P1,...,P5 * 2. TURN OFF A PROGRAM * OF,XXXXX,P * 3. OPERATOR SUSPEND A PROGRAM * SS,XXXXX * 4. CONTINUE A OPERATOR SUSPENDED PROGRAM * GO[IH],XXXXX * GO[IH],XXXXX,P1,...,P5 * 5. CURRENT STATUS OF A PROGRAM * ST,XXXXX * 6. CHANGE PROGRAM ID SEGMENT TIME PARAMETERS. * IT,XXXXX,R,MMM * IT,XXXXX,R,MMM,HR,MN * IT,XXXXX,R,MMM,HR,MN,SC * IT,XXXXX,R,MMM,HR,MN,SC,MS * 7. CHANGE PROGRAM PRIORITY * PR,XXXXX,ZZ * 8. SET REAL TIME CLOCK AND START TIME BASE GENERATOR * TM,DAY,HR,MN,SC * 9. CURRENT REAL TIME CLOCK VALUES * TI * 10. SET A SLOT OR DEVICE DOWN. * DN,N1 * DN,,N2 * 11. SET A SLOT AND DEVICES UP * UP,NN * 12. LOGICAL UNIT SWITCH AND STATUS * LU,N1 * LU,N1,N2 * LU,N1,N2,N3 * 13. EQUIPMENT STATUS * EQ,NN * 14. SET SOURCE FILE * LS,P1,P2 * 15. SELECT LOAD-AND-GO * LG,P * 16. CHANGE DEVICE TIME-OUT PARAMETER * TO,N1 * TO,N1,N2 * 17. RELEASE PROGRAM'S TRACKS * RT,XXXXX * 19. SET BREAK FLAG * BR,XXXXX * 20. ABORT JOB REQUEST * AB * 21. RUN REQUEST * RU[IH],XXXXX * RU[IH],XXXXX,P1,...,P5 * 22. BUFFER LIMIT PRINT/CHANGE * BL OR BL,N1,N2 HED OPERATOR INPUT MESSAGE DECIPHER ROUTINE * * CALLING SEQUENCE * JSB $MESS * B CONTAINS NUMBER OF CHARACTERS * A IS THE BUFFER ADDRESS * * * * INPUT DECIPHER ROUTINE ROUTINE SCANS THE ASCII OPERATOR * INPUT AND STORES THE DATA INTO PARAMETERS. * THIS ROUTINE ASSUMES THE CHARACTER COUNT IN B ON ENTRY AND * DATA IN BUFFR. COMMA IS USED TO SEPARATE PARAMETERS. A PARA- * METER MAY BE UP TO 6 ASCII CHARACTERS- EXCEPT FOR OP CODE * WHICH MUST BE 2 CHARACTERS. A MAXIMUM OF 40 CHARACTERS MAY BE * INPUT. A COUNT IS KEPT OF THE NUMBER OF PARAMETERS INPUT AND * A CHARACTER COUNT IS KEPT FOR EACH PARAMETER. THE VALUES ARE * STORED LEFT ADJUSTED IN THE BUFFERS. * * $MESS NOP ENTRY/EXIT SZB,RSS IS COUNT ZERO JMP M0150 YES, SO EXIT STA BFADD SAVE BUFFER ADDRESS AND STB BFCNT SAVE POSITIVE CHAR.COUNT. JSB $PARS GO PARSE THE REQUEST BUFAD DEF PRAMS ADDRESS OF PRAMETER BUFFER HED MESSAGE PROCESSOR--OP REQUEST SEARCH * * THIS SECTION CHECKS THE OPERATOR REQUEST CODE AGAINST{ THE * LEGAL REQUEST CODES AND JUMPS TO THE PROPER PROCESSOR. ******************************************************************* * TO ADD NEW REQUEST ONE MERELY, * A. ADDS ASCII OPERATION CODE TO TABLE -LDOPC- * B. ADDS PROCESSOR START ADDRESS TO TABLE -LDJMP- * C. ADDS PROCESSOR CODING TO PROCESS THE REQUEST. ******************************************************************* * SJP *+2 ENABLE SYSTEM MAP LDB OP OPERATION CODE INTO B STB OPP SET STOP FLAG LDA LDOPC SET OPERATION TABLE POINTER STA TEMP1 LDA LDJMP SET OPERATION PROC. JUMP ADDRESS STA TEMP2 LDA P1 SEND P1 IN A REG. UNL IFN LST CPB DBUG **********DEBUG********** CLB,RSS **********DEBUG********** JMP M0030 **********DEBUG********** STB FLG **********DEBUG********** JSB $DDT **********DEBUG********** DEF $TYPE+2 **********DEBUG********** DBUG ASC 1,DB **********DEBUG********** EXT $DDT **********DEBUG********** UNL XIF LST M0030 CPB TEMP1,I COMPARE WITH TABLE VALUE JMP TEMP2,I COMPARES GO DO IT ISZ TEMP1 DOES NOT COMPARE-INCREMENT OP TABLE ISZ TEMP2 INCREMENT JUMP ADR. JMP M0030 GO TO COMPARE NEXT OP CODE * OPER LDA $OPER ILLEGAL OPERATION CODE REQUEST $MSEX JRS $MEU $MESS,I RETURN AND RESTORE MEU STATUS MSEX EQU $MSEX * * ****NOTE THAT $MEU IS THE STATUS OF MEU AT LAST*** ****INTERRUPT---IT IS SAVED IN $CIC BEFORE A ***** ****INTERRUPT FROM THE DUMMY CARD CAN COME IN***** ****AND CHANGE THE STATUS************************ * * * LDOPC DEF *+1 OPERATION CODE TABLE ADDRESS ASC 8,RTONOFSSGOSTPRIT $ASTM ASC 9,TMDNUPLUEQLSLGTOTI ASC 4,BRABRUBL OPP NOP OPCODE FOR CURRENT REQUEST LDJMP DEF *+1,I JUMP ADDRESS FOR EACH OPER. CODE DEF M0070  RELEASE PROGRAM'S TRACKS DEF M0100 TURN ON DEF M0200 TURN OFF DEF M0300 OPERATOR SUSPEND DEF M0400 REMOVE OPERATOR SUSPEND DEF M0500 STATUS DEF M0650 PRIORITY CHANGE DEF M0600 INTERVAL TIME CHANGE DEF M0700 REAL TIME CLOCK INITIALIZATION DEF M0800 DN REQUEST DEF $IOUP UP REQUEST DEF M0920 LU REQUEST DEF M0920 EQ REQUEST DEF M0960 LS REQUEST DEF M0970 LG REQUEST DEF M0920 TO REQUEST DEF M0750 TI REQUEST DEF M0725 BR REQUEST DEF M0950 AB REQUEST DEF M0408 RU REQUEST DEF BLIM BL REQUEST DEF OPER OPERATOR ERROR HED PARSE SUBROUTINE FOR OPERATOR MESSAGES * CALLING SEQUENCE: * LDA BUFFER ADDRESS * LDB CHARACTER COUNT * JSB $PARS * DEF PRAM BUFFER * -RETURN- * * THE PRAM BUFFER IS 33 WORDS LONG AND CONTAINS UP TO 8 * PRAMETER DESCRIPTERS FOLLOWED BY THE PRAMETER COUNT. * * EACH PARAMETER DESCRIPTER CONSISTS OF FOUR WORDS: * * WORD MEANING * 1 FLAG WORD 0=NULL PRAMETER * 1=NUMERIC PRAMETER * 2=ASCII PRAMETER * 2 0 IF NULL,VALUE IF NUMERIC,ASCII(1,2) IF ASCII * 3 0 IF NOT ASCII ELSE ASCII(3,4) * 4 0 IF NOT ASCII ELSE ASCII(5,6) * * TEMP USAGE IN PARSE SECTION: * * TEMPP = CHARACTER ADDRESS * TEMP = PARAMETER FLAG ADDRESS * TEMP1 = TEMP BUFFER FETCH ADD. * TEMP2 = TEMP BUFFER STORE ADD. * TEMP3 = LAST INPUT CHAR.+1 ADD. * TEMP4 = PARAMETER VALUE ADDRESS. * TBUF = DEF TEMP5 (6 LOCATIONS) * Mq TBUFS = DEF TEMP5+7 * $PARS NOP ENTRY/EXIT CLE,ELA MAKE CHARACTER ADD. STA TEMPP SET BUFFER CHAR ADD. ADA B COMPUTE END ADDRESS. STA TEMP3 AND SET IT. LDB DM32 CLEAR PARAMETER AREA STB TEMP LDB $PARS,I CLA MES1 STA B,I INB ISZ TEMP JMP MES1 * STA B,I CLEAR THE PRAM COUNT STB WSTAT SET ADDRESS OF PRAM COUNT DEC09 LDA TBUF INITIALIZE TEMP BUFFER ADDRESS STA TEMP1 STA TEMP2 * DEC10 LDB TEMPP GET THE BUFFER CHAR ADDRESS CPB TEMP3 IF NO MORE CHARACTERS JMP DEC60 GO PROCESS PRAM ISZ TEMPP STEP INPUT POINTER CLE,ERB CONVERT TO WORD SET UP LOW IN E LDA B,I GET WORD FROM THE BUFFER SEZ,RSS CHECK IF TO EXAMINE UPPER/LOWER ALF,ALF UPPER, SO ROTATE TO LOWER BITS AND B377 MASK OFF ALL BUT LOW ORDER CPA COM SEE IF A COMMA JMP DEC60 YES CPA LASCI CHECK IF BLANK CHARACTER JMP DEC10 YES, SO SKIP CHARACTER LDB TEMP2 CHECK IF 6 CHARACTERS IN PRAM CPB TBUFS IF SO JMP DEC10 SKIP STORE STA TEMP2,I STORE THE CHARACTER STA SABRT SAVE THE LAST CHARACTER ISZ TEMP2 STEP FOR NEXT CHAR. * JMP DEC10 GO TO PROCESS NEXT CHARACTER * * ATTEMPT NUMERIC CONVERSION OF PRAM. * DEC60 LDA WSTAT,I FIRST SET UP POINTERS RAL,RAL TAKE 4 TIMES THE PRAM NUMBER ADA $PARS,I PLUS THE OP CODE ADDRESS-1 STA TEMP SET FLAG ADDRESS CLE,INA ONE MORE AND WE HAVE STA VALOC THE PRAMETER VALUE LOCATION LDA TEMP2 IF NO CHARACTERS CPA TBUF INPUT JMP DEC75 GO TRY NEXT ONE * * NOW TRY FOR A NUMBER * ISZ TEMP,I SET FLAG TO 1 FOR NUMBER LDB TEMP1,I GET FIRST CHAR CPB DASH MINUS SIGN? ISZ TEMP1 YES, INCRE TO NEXT CHAR CPA TEMP1 (A) STILL = TEMP2 JMP DEC80 IF "-" WAS ONLY CHAR, THEN ASCII * LDB D10 SET UP CONVERSION BASE LDA SABRT CPA "B" IF B SUFFIX LDB D8 SET FOR BASE 8 STB TEMP4 SET BASE DEC65 MPY VALOC,I BUMP THE CURRENT VALUE VALOC EQU *-1 LDB TEMP1,I GET THE NEXT CHAR. ADB DM58 IF GREATER THAN "9" SEZ,CLE,RSS THEN NOT A NUMBER ADB D10 IF LESS THAN "0" SEZ,CLE,RSS THEN JMP DEC80 NOT A NUMBER ADA B ACCUMULATE THE STA VALOC,I NUMBER ISZ TEMP1 STEP THE BUFFER ADDRESS LDA TEMP4 GET THE BASE TO A LDB TEMP1 AND THE NEXT CHAR. LOC. TO B CPB TEMP2 IF END THEN JMP DEC70 GO TO NEXT PRAM * INB IF BASE 8 CONVERSION CPB TEMP2 AND LAST CPA D10 CHAR. THEN DONE SO SKIP JMP DEC65 ELSE GO GET THE NEXT ONE * SPC 1 DEC70 LDB VALOC,I GET VALUE LDA TBUF,I IF NEG NUMBER, CPA DASH CMB,INB NEGATE VALUE STB VALOC,I STORE VALUE * DEC75 ISZ WSTAT,I COUNT THE PRAMETER LDA WSTAT,I IF LDB TEMP3 EOL OR CPB TEMPP 8 PRAMS LINE RSS THEN CPA D8 JMP DEC90 GO PROCESS JMP DEC09 ELSE GO GET NEXT CHARACTER SPC 1 DEC80 ISZ TEMP,I SET NOT NUMBER FLAG LDA AASCI FILL THE PRAM WITH BLANKS LDB VALOC PRAM ADDRESS TO B INB DON'T WORRY ABOUT FIRST WORD STA B,I SET SECOND WORD CLE,INB STEP TO THIRD WORD STA B,I SET THIRD WORD TO DOUBLE BLANK. LDB TBUF GET THE TEMP BUFFER POINTER DEC85 CPB TEMP2 END OF INPUT? JMP DEC75 YES GO PROCESS NEXT PRAM CPB STOP SIXTH CHAR YET? JMP DEC75 YES, dxEND PARAM LDA B,I GET THE CHARACTER SEZ,RSS IF UPPER CHARACTER ALF,SLA,ALF ROTATE AND SKIP XOR VALOC,I LOWER ADD THE UPPER CHAR. XOR LASCI ADD/DELETE THE LOWER BLANK STA VALOC,I STORE THE PACKED WORD SEZ,CME,INB STEP B,SKIP IF UPPER ISZ VALOC ELSE STEP STORE ADDRESS. JMP DEC85 GO GET OTHER CHAR. SPC 2 DEC90 ISZ $PARS STEP RETURN ADDRESS JMP $PARS,I RETURN SPC 2 "B" OCT 102 ASCII "B" DASH OCT 55 ASCII "-" STOP DEF TEMP5+6 ASCII 6TH CHAR STOP HED MESSAGE PROCESSOR--RT,XXXXX COMMAND * * RT,XXXXX * * THE RELEASE TRACKS ROUTINE FUNCTIONS AS FOLLOWS: * IF PROGRAM STATUS NOT DORMANT, STATUS ERROR. * IF DORMANT, ALL TRACKS ASSIGNED TO THAT PROGRAM * ARE RELEASED - ALL PROGRAMS IN DISC TRACK * ALLOCATION SUSPENSION ARE RESCHEDULED. * M0070 JSB TTNAM GO FIND ID SEGMENT ADDRESS ADB D8 PROGRAM MUST BE DORMANT. LDA B,I WILL BE IF POINT OF SZA SUSPENSION IS ZERO. JMP M0405 OTHERWIZE, ILL STATUS ERROR. LDA WORK GET ID SEGMENT ADDRESS JSB $OTRL RESCHEDULE DISC-SUSP PROGRAMS JMP M0150 RETURN- HED MESSAGE PROCESSOR--ON,XXXXX COMMAND * ***************************************************************** * * ON[IH],XXXXX * ON[IH],XXXXX,NOW * ON[IH],XXXXX,P1,...,P5 * ON[IH],XXXXX,NOW,P1,...,P5 * * THE ON REQUEST FUNCTIONS AS FOLLOWS: * IF NO RESOLUTION CODE, THEN PROGRAM SCHEDULED. * IF -NOW- OPTION, THEN ENTER PROGRAM INTO TIME LIST * AND SET TIME VALUES TO CURRENT TIME PLUS 10 MSC * IF NOT ONE OF ABOVE, AND TIME VALUES ARE ZERO THEN * PROGRAM FUNCTIONS SAME AS -NOW- OPTION. * IF NOT ONE OF ABOVE, AND TIME VALUES ARE PRESENT, * } THEN PROGRAM IS ADDED TO TIME LIST. * NOTE: 1)ALL THE ABOVE OPTIONS ALLOW PARAMETERS TO BE * PASSED TO THE PROGRAM. THESE MUST BE ASCII * DECIMAL NUMBERS WHICH ARE CONVERTED TO BINARY * AND STORED IN ID SEGMENT TEMP AREA. UPON * EXECUTION, THE B REGISTER WILL POINT TO TEMP. * UP TO 5 PARAMETERS MAY BE INPUT. IF NO PARA- * METERS ARE INPUT, THE TEMP AREA ARE ZEROS BUT * B REGISTER WILL STILL POINT TO TEMP. AREA * 2) THE ABOVE OPTIONS WILL ALLOW THE ORIGINAL * SCHEDULING STRING TO BE SAVED(UNLESS 'IH' * IS SPECIFIED OR THERE ARE NO PARAMETERS). * THE SCHEDULED PROGRAM MAY RECOVER THIS STRING * WITH AN EXEC 14 CALL. * ******************************************************************** * M0100 JSB TTNAM FIND ID SEGMENT ADDR LDB WSTAT,I IF NO PARAMETERS RBL,RBL BIT IS SET, THEN SSB,RSS ILLEGAL STATUS. SZA CHECK IF PROGRAM DORMANT JMP M0405 ILLEGAL STATUS ERROR JSB PLOAD GO TO PROCESS CONTROL PRAMETERS LDB WORK ADB D17 COMPUTE RES/T/MULT ADDR LDA B,I ALF,RAR AND D7 CHECK RESOLUTION CODE SZA NONE, SO GO TO SCHED NOW JMP M0110 M0105 JSB $LIST SCHEDULE PROGRAM OCT 301 JMP MSEX RETURN M0110 INB SET B FOR $ONTM LDA CP2 IF ASCII RAR,SLA "NO" ENTERED LDA P2 THEN CPA NO GO PUT CCA IN THE TIME LIST FOR NOW+10MS. JRS $MEU $ONTM COMPLETE IN TIME MODULE HED MESSAGE PROCESSOR--OF,XXXXX COMMAND * * OF,XXXXX * OF,XXXXX,1 "ABORT" * OF,XXXXX,8 "ABORT AND REMOVE FROM SYSTEM" * * THE OF REQUEST FUNCTIONS AS FOLLOWS: * IF PROGRAM DORMANT, IT MAY STILL BE IN TIME LIST SO * A CALL IS MADE TO REMOVE PROGRAM FROM TIME LIST * IF ABORT OPTION 1, THEN $ABRT PROCESSOR IS * CALLED. IF ABORT OPTION 8, IN ADDITION TO * $ABRT PROCESSOR BEING CALLED, IF BIT 7 OF THE * TYPE FIELD IS SET, THEN TRACK(S) WHERE PROGRAM * IS STORED IS ALSO RELEASED BY $DREL. THE NAME * FIELD IN THE ID SEGMENT IS CLEARED SO THAT THE * PROGRAM CANNOT BE CALLED AGAIN. * IF PROGRAM SCHEDULED OR OPERATOR-SUSPENDED, THEN * DORMANT REQUEST MADE VIA LIST PROCESSOR AND * PROCEED AS ABOVE. * IF PROGRAM STATUS NOT ONE OF ABOVE, THE DORMANT BIT * IS SET IN STATUS, IF NOT ABORT OPTION. IF ABORT * OPTION, CHECK IF AVAILABLE MEMORY OR UNAVAILABL * DISC TRACK SUSPENSION-IN WHICH CASE THE ABORT * BIT IS SET AND $ABRT CALLED. IF STATUS IS I/O * SUSPENSION, SET ABORT BIT AND RETURN. * IF INPUT SUSPENSION, CHECK IF * PROGRAM BEING READ IN FROM DISC. IF YES, THEN * SET ABORT BIT AND RETURN. IF NOT BEING READ IN * FROM DISC, SET ABORT BIT AND CALL $IOCL TO * CLEAR THE I/O REQUEST * M0200 JSB TTNAM GO TO FIND ID SEG ADDR M0202 LDB WORK GET ID SEG ADDRESS AND STB TEMPH SAVE IT IN LOCAL STORE SEZ IF SHORT ID-SEG. JMP M0207 GO TEST FOR 8 LDA P2 GET PRAM TWO SZA IF NOT ZERO GO DO POWER THING JMP M0250 * M0240 JSB SABRT GO DO SOFT ABORT JMP $XEQ EXIT DONE * M0250 LDA WSTAT,I POWER ABORT SO AND D15 GET CURRENT STATUS SWP PUT ID-SEG. ADDRESS IN A,STAT IN B CPB D2 IF I/O SUSP THEN JMP $IOCL GO ABORT THEC^ I/O * JSB $ABRT GO TO ABORT ROUTINE CLE CLEAR E FOR TRACK RELEASE M0207 LDA P2 RELEASE PROG'S TRACKS? CPA D8 IF P = 8, RSS YES JMP $XEQ NO-SO RETURN * LDB TEMPH ADB D14 GET ADDRESS OF LAST LDA B,I NAME WORD ALF,ALF CHECK IF TYPE BIT 7 SET SSA,RSS JMP $XEQ NO-CANNOT REL PROG TRACKS SEZ,INB,RSS IF SHORT ID-SEG. SKIP ADB D7 ELSE INDEX TO MEM ADDRESS FOR LONG LDA B,I CMA,INA INB ADA B,I STA TEMP3 # WORDS OF MAIN INB LDA B,I CMA,INA INB ADA B,I # WORDS IN BASE PAGE INB SET UP THE DISC ADDRESS POINTER STB TEMP1 IN TEMP1 CLB CLEAR FOR DOUBLE SHIFT ADA B177 ROUND UP TO NEAREST SECTOR IOR B177 SET THE LOW BITS AND ADA TEMP3 ADD AND ROUND UP THE MAIN LSR 6 DIVIDE BY 64 TO GET SECTORS STA TEMP5 TOTAL # SECTORS IN PROGRAM LDA TEMP1,I GET THE DISC ADDRESS LSR 7 SHIFT TO TRACK AND B377 ADDRESS AND LDB TEMP1,I CHECK IF LU 2 OR 3 SSB LU 2 ADA TATSD LU 3 STA TEMP2 ACTUAL STARTING TRACK # LDB SECT2 LDA TEMP1,I CHECK IF LU 2 OR 3 SO CAN DIVIDE SSA BY # OF TRACKS FOR THAT LDB SECT3 DISC. STB TEMP LDA TEMP1,I GET THE TRACK ADDRESS AND B177 MASK OUT THE SECTOR ADDRESS CMA,INA,SZA,RSS IF ZERO RELEASE THIS TRACK JMP M0226 ADA TEMP ELSE SUBTRACT FROM TRACK ISZ TEMP2 SIZE STEP TO NEXT TRACK CMA,INA AND COMPUTE THE REMAINING SECTORS M0226 ADA TEMP5 A IS TOTAL NUMBER TO CLB CLEAR FOR DIVIDE STB TEMP1,I WIPE THE TRACK WORD WHILE WERE HERE SZA GEORGES FIX 3/13 SSA _NLH RELEASE IF NEGATIVE JMP M0227 FORGET THE WHOLE THING DIV TEMP SZB CHECK IF PARTIAL TRACK INA YES STA B (B)=# TRACKS LDA TEMP2 (A)=STARTING TRACK JSB $DREL CALL EXEC SYS RELEASE TRACKS M0227 LDB TEMPH ADB D12 CLA STA B,I INB STA B,I INB LDA B,I SAVE THE OLD SHORT/LONG AND B77 FLAG STA B,I JMP $XEQ GO EXIT SPC 1 * * THE SOFT ABORT ROUTINE CLEARS ANY RESOURCE FLAGS * CALLS THE TERMINATION ROUTINE AND REMOVES A PROGRAM FROM * THE TIME LIST. * * IT ALSO SETS THE ABORT FLAG (100000) IN THE FATHERS ID-SEG. * (IF THERE IS A FATHER AND HE IS WAITING) SO THAT RMPAR * MAY RECOVER THE PRAMETER. * * IF THE PROGRAM IS WAITING FOR A SON IT CLEARS THE SONS sN* "FATHER IS WAITING" FLAG. * * CALLING SEQUENCE: * * LDB ID-SEG. ADDRESS * JSB SABRT * * RETURN REGISTERS MEANING LESS. * * THIS ROUTINE DOES NOT GENERATE AN ABORT MESSAGE NOR DOES IT * PULL A PROGRAM OUT OF AN I/O LIST. ($LIST DOES SET A FLAG * WHICH WILL PUT THE PROGRAM DORMANT ON I/O COMPLETION. * SABRT NOP STB TEMPH SAVE THE ID ADDRESS ADB D15 GET THE STATUS LDA B,I WORD AND ZAPR CLEAR THE RESOURCE BIT STA B,I RESET IT INB SET B TO THE TIME LIST WORD JSB $TREM REMOVE PGM FROM THE TIME LIST LDB TEMPH RESTORE THE ID ADDRESS AND ADB D15 INDEX TO THE STATUS WORD LDB B,I AND FETCH IT BLF,SLB IF PROGRAM IS WAITING JMP SABT2 GO CLEAR THE SONS FLAG * SABT1 LDB TEMPH RESTORE THE ID-SEG. ADDRESS AND JSB TERM CALL THE TERMINATION PROCESSOR ISZ POP STEP TO THE FATHER'S FIRST PRAM WORD RSS JMP SABRT,I LDA SIGN SET SIGN BIT FOR FATHER ABORT FLAG STA POP,I SET THE ABORT FLAG LDB POP CACULATE THE B-REG ADDRESS ADB D9 AND LDA POP SET IT TO STA B,I POINT TO THE ABORT WORD JMP SABRT,I DONE RETURN * SABT2 LDB TEMPH GET THE SONS ID ADDRESS INB FROM WORD TWO LDB B,I OF THE ID-SEGMENT ADB D20 INDEX TO THE FATHER WAIT FLAG WORD LDA B,I GET THE WORD RAL,CLE,RAL CLEAR BIT 14 ERA,RAR AND STA B,I RESTORE THE WORD JMP SABT1 GO TERMINATE THE PROGRAM SPC 2 TEMPH DEF FMGR D12 DEC 12 DM24 DEC -24 DM60 DEC -60 ZAPR OCT 177477 HED MESSAGE PROCESSOR--SS,XXXXX COMMAND * * SS,XXXXX PROCESSOR * * THE SUSPEND REQUEST FUNCTIONS AS FOLLOWS: * IF PROGRAM DORMANT OR OPERATOR SUSPENDED, THEN * ILLEGAL STATUS ERROR *  IF SCHEDULED, THEN OPERATOR SUSPEND VIA $LIST * IF OTHER THAN ABOVE, SET THE OPERATOR-SUSPEND BIT * IN STATUS. AND ALL THESE WONDERS ARE * BY $LIST. * M0300 JSB $LIST OCT 206 SCHED TO OPER-SUSP DEFP1 DEF P1 BY NAME SZA IF ERROR JMP MSEX EXIT * LDA WSTAT,I SET THE NO PRAMS IOR B20K BIT STA WSTAT,I TO PREVENT PRAMS ON RESTART LDA WORK GET ID ADR JSB ALDM GO PUT IN DORM LIST & SET DM FLAG JMP M0150 EXIT SPC 2 B20K OCT 20000 HED MESSAGE PROCESSOR--GO COMMAND * ***************************************************************** * * GO[IH],XXXXX * GO[IH],XXXXX,P1,...,P5 * * THE CONTINUE FROM POINT OF SUSPENSION FUNCTIONS AS * FOLLOWS: * IF NOT OPERATOR SUSPEND: * BIT SET - REMOVE OPER-SUSP BIT IN STATUS * BIT NOT SET - ERROR EXIT FOR MESSAGE * IF OPERATOR SUSPEND, SCHEDULE PROGRAM. UNLESS * 'IH' IS SPECIFIED OR NO PARAMETERS ARE GIVEN, * ANY PREVIOUS OPERATOR SCHEDULING STRING IS * RELEASED AND THE 'GO' SCHEDULING STRING IS * SAVED FOR RETRIEVAL BY THE PROGRAM USING AN * EXEC 14 CALL. * ***************************************************************** * M0400 JSB TTNAM GO TO FIND ID SEG ADDR CPA D6 CHECK IF PROGRAM OPERATOR-SUSPEND JMP M0410 OPERATOR-SUSPEND--SO GO TO PROCESS LDA WSTAT,I NOT OPER SUSP - AND B1000 IS BIT SET? SEZ IF SHORT ID-SEG SEND ERROR SZA,RSS JMP M0405 NO, ERROR- XOR WSTAT,I YES, CLEAR BIT STA WSTAT,I AND M0150 CLA EXIT JMP MSEX * M0405 LDA $ILST ILLEGAL STATUS MESSAGE ADDRESS JMP MSEX EXIT SKP * ****************************A************************************* * * RU[IH],XXXXX * RU[IH],XXXXX,P1,...,P5 * * THE RU COMMAND FUNCTIONS AS FOLLOWS: * IF DORMANT, THE PROGRAM IS SCHEDULED. * PARAMETERS MAY BE PASSED TO THE PROGRAM. THESE * ARE TREATED LIKE PARAMETERS IS THE GO COMMAND * (SEE NOTE 1 FOR THE GO COMMAND). * THE SCHEDULING STRING MAY BE SAVED. SEE NOTE 2 * FOR THE GO COMMAND. * ******************************************************************* * M0408 JSB TTNAM RUN COMMAND ROUTINE LDB WSTAT,I IF NO PARAMETERS RBL,RBL BIT IS SET, THEN SSB,RSS ILLEGAL STATUS. SZA IF NOT DORMANT JMP M0405 GIVE THE MESSAGE,ELSE DO IT * M0410 LDA D2 CHECK IF CONTROL PARAMETERS FOLLOW CPA PARAM JMP M0105 NO,DO NOT RETURN STRING,SCHEDULE PROGRAM. * JSB PLOAD GO TO PROCESS CONTROL PARAMETERS JMP M0105 GO SCHEDULE THE PROGRAM HED MESSAGE PROCESSOR--ST,XXXXX COMMAND * * ST,XXXXX PROCESSOR * * IF XXXXX = 0 NAME AND PARTITION# OF CURRENT PGM IS PRINTED * IF XXXXX > 0 NAME OF THE PGM IN PARTITION #XXXXX IS PRINTED * THE STATUS REQUEST OUTPUTS THE REQUESTED PROGRAM STATUS * IN THE FOLLOWING FORMAT: * PRPRP S R MMMM HR MN SC MS T * * PRPRP =PRIORITY * S = STATUS (0 THRU 6 * R = RESOLUTION CODE (0 THRU 4) * MMM = MULTIPLE VALUE * HR = NEXT START TIME -HR * MN = NEXT START TIME -MIN * SC = NEXT START TIME -SEC * MS = NEXT START TIME -10 MSEC * T = PRESENT IF PROGRAM IN TIME LIST * M0500 LDB XEQT IF ZERO SZA,RSS GIVE STATUS OF JMP M0540 CURRENT PGM SSA JMP M0505 IF NEG, ASSUME WANT PRG STATUS CCB $MATA-1 IS ADDR OF ADB $MATA  COUNT OF PTTNS LDB B,I CMB IF (A) .LE. TOTAL ADB A NUMBER OF PTTNS SSB THEN GIVE PTTN STATUS JMP M0530 * M0505 JSB TTNAM GO TO FIND ID SEGMENT ADDR CLB,CCE STB RQP3 SET UP FOR $TIMV CALL JSB $CVT1 CONVERT STATUS TO ASCII. ALF,ALF MOVE TO HIGH HALF WORD STA BUFF4 STORE STATUS IN BUFFER. LDB DM28 CPA BL9 IF SHORT ID-SEG LDB DM8 SET FOR 8 CHAR. MESS STB BUFFR STORE CHARACTER COUNT IN BUFFER LDB WORK ADB D6 PRIORITY ADDRESS CPA BL9 IF SHORT ID-SEG CLA,RSS SET PR TO 0 LDA B,I JSB $CVT1 CONVERT PRIORITY TO ASCII LDB ASCI1 GET DIGITS 23-45 TO B-A RRL 8 34-52 IN B-A STB BUFF2 SET 34 LDB ASCI 1-52 IN B-A ALF,ALF 1-25 IN B-A RRL 8 12-5 IN B-A STB BUFF1 SET 12 STA BUFF3 SET 5 BLANK LDB TEMP6 RESTORE B TO PRIOR ADDRESS ADB D11 RESOL CODE/MULT ADDRESS LDA B,I ALF,RAR AND D7 JSB $CVT1 CONVERT RESOLUTION CODE TO ASCII ALF,ALF ROTATE TO HIGH HALF WORD STA BUFF5 STORE RESOLUTION CODE IN BUFFER LDA B,I AND B7777 JSB $CVT1 CONVERT MULTIPLE TO ASCII STA BUFF7 STORE MULTIPLE IN BUFFER LDA ASCI1 STA BUFF6 STORE MULTIPLE IN BUFFER LDA B,I CHECK IF PROG IN TIME LIST ALF,SLA TEST BIT 12 (T) BIT JMP M0510 YES LDA AASCI PROGRAM NOT IN TIME LIST RSS M0510 LDA TZERO PROG IN TIME LIST STA BUF14 STORE ASCII BLANK OR T IN BUFFER INB SET B TO TIME ADDRESS LDA DTEMP SET UP TO GET TIME TO STA RQP2 TEMP AREA DLD B,I GET TIME FROM ID-SEG JSB $TIMV CONVERT THE TIME LDA TEMP[3 GET HOURS JSB $CVT1 CONVERT LDB ASCI1 GET VALUE RRR 8 ROTATE TO BLANK ON EACH SIDE DST BUFF8 SET IN MESSAGE LDA TEMP2 GET MIN. VALUE JSB $CVT1 CONVERT STA BUF10 STUFF IN BUFFER LDA TEMP1 AND AGAIN FOR SEC JSB $CVT1 LDB ASCI1 VALUE TO A BLANK TO B RRR 8 ROTATE DST BUF11 SET IN BUFFER LDA TEMP ONE MORE TIME FOR 10'S OF MS. JSB $CVT1 STA BUF13 STORE TENS OF MSEC IN BUFFER M0520 LDA BUFAD LOAD A WITH OUTPUT BUFFER ADDRESS JMP MSEX RETURN SPC 1 TZERO ASC 1, T D11 DEC 11 B7777 OCT 7777 DTEMP DEF TEMP BL9 ASC 1,9 BLANK 9 DM28 DEC -28 DM1 DEC -1 D21 DEC 21 SPC 1 M0530 ADA DM1 MPY D6 (PTTN#-1)*6 IS ADA $MATA ADDR OF ENTRY IN MATA ADA D2 +2 FOR ID SEG ADDR WORD LDB A,I (B)=ID SEG ADDR JMP M0550 GO PRINT PRG NAME * M0540 SZB,RSS ANY PRG RUNNING? JMP M0550 NO PRINT 0 ADB D21 GET PARTITION # LDA B,I FROM ID SEG WORD 22 AND B77 CCE,INA GET USERS ACTUAL PART NUMBER JSB $CVT1 CONVERT TO DECIMAL STA BUFF4 SET IN MESSAGE LDB XEQT (B)=ID SEG ADDR LDA DM8 (A)=COUNT 8 CHARS JMP M0560 GO PRINT M0550 CCA SET A FOR ZERO PRINT SZB SKIP IF NO PROGRAM LDA DM5 ELSE RESET A FOR PGM PRINT M0560 STA BUFFR SET MESSAGE LENGTH LDA MPT81 GET UPPER ASCII "0" TO A SZB SKIP IF NO PGM ADB D12 ELSE STEP TO NAME ADDRESS LDA B,I STA BUFF1 SET NAM12 INB STEP TO NEXT NAME WORD DLD B,I GET THE NEXT WORDS STA BUFF2 SET NAM34 LDA AASCI FILL RIGHT BLANK BLF,BLF INTO NAM5 RRL 8 STB BUFF3 SET NAM5 JMP M0520 GO EXIOT SPC 2 $PBUF DEF BUFFR * INBUF BSS 22 MESSAGE INPUT BUFFER BUFFL EQU *-INBUF+*-INBUF LENGTH IN #CHARS SPC 2 * SYSTEM OUTPUT BUFFER * BUFFR EQU * SHOULD BE AT LEAST 15 WORDS LONG BUFF1 EQU BUFFR+1 BUFF2 EQU BUFFR+2 BUFF3 EQU BUFFR+3 BUFF4 EQU BUFFR+4 BUFF5 EQU BUFFR+5 BUFF6 EQU BUFFR+6 BUFF7 EQU BUFFR+7 BUFF8 EQU BUFFR+8 BUFF9 EQU BUFFR+9 BUF10 EQU BUFFR+10 BUF11 EQU BUFFR+11 BUF12 EQU BUFFR+12 BUF13 EQU BUFFR+13 BUF14 EQU BUFFR+14 BSS 33 ENDT EQU * DEFINE END OF BUFFER FOR TEST ORG INBUF PUT INIT CODE IN BUFFER $STRT LDA DM5 STA TEMP5 PREPARE TO CALL $ALC LDA DEQT1 TO RETURN BLOCKS OF MEMORY STA TEMP6 TO INITIALIZE SYSTEM AVAILABLE MEMORY JSB SYSMP GO SET UP SYSTEM MAP MRTNL LDA TEMP6,I BLOCK ADDRESSES ARE IN PAIRS STA MADR1 EQT1 THRU EQT12 ISZ TEMP6 LDA TEMP6,I STA NWDS1 ISZ TEMP6 JSB $RTN RETURN A BLOCK MADR1 NOP NWDS1 NOP ISZ TEMP5 DONE WITH EQT1 THRU EQT10? JMP MRTNL NO, RELEASE NEXT BLOCK JMP TEMP YES, RELEASE LAST BLOCK DEQT1 DEF EQT1 GOES TO GTFMG FROM $ALC VIA $WORK * GTFMG LDB TEMPH GET FMGR'S NAME ADDRESS JSB $ZZZZ GO TO DISPATCHER TO SET UP LDB TERM GET ADDRESS JSB TNAME OF D.RTR TO B SEZ,RSS IF NONE SKIP STB ID.RT SET FOR LATER. LDB P1OR2 LOOK UP EDIT'S ADDRESS JSB TNAME ALSO SEZ,RSS IF NONE SKIP STB ID.RT+1 SET IN LIST LDB TEMPH NOW FIND JSB TNAME FMGR'S ID-SEGMENT ADDRESS SEZ,RSS IF NONE SKIP STB IDFMG SET ADDRESS LDB DSMP JSB TNAME SEZ,RSS STB $IDSM LDA D$RN TRACK DOWN RN TABLE ADDRESS RAL,CLE,SLA,ERA IF INDIRECT LDA A,I USE NEXT LEVEL * LDB IDADS GET ADDRESS OF ID ADDRESSES JMP $ERMG GO TnO EXEC TO SET UP NO RETURN * * IDADS DEF ID.RT FMGR ASC 3,FMGR D.RTR ASC 3,D.RTR DSMP DEF *+1 ASC 3,SMP D$RN DEF $RNTB ORG BUFFR SHARE PARSE BUFFER WITH MESSAGE BUFFER * * PARAMETER POINTERS FOR DATA STORAGE * PRAMS BSS 1 CHARACTER COUNT-OP CODE OP BSS 3 OPERATION CODE CP1 BSS 1 CHAR COUNT-PARAM 1 P1 BSS 3 PARAM 1 (UP TP 3 WORDS-6CHAR.) CP2 BSS 1 CHAR COUNT-PARAM 2 P2 BSS 3 PARAMETER 2 CP3 BSS 1 CHAR COUNT-PARAM 3 P3 BSS 3 PARAMETER 3 CP4 BSS 1 CHAR COUNT-PARAM 4 P4 BSS 3 PARAMETER 4 CP5 BSS 1 CHAR COUNT -PARAM 5 P5 BSS 3 PARAMETER 5 CP6 BSS 1 CHAR COUNT-PARAM 6 P6 BSS 3 PARAMETER 6 CP7 BSS 1 CHAR COUNT-PARAM 7 P7 BSS 3 PARAMETER 7 PARAM BSS 1 PARAMETER COUNTER ORG D$RN+1 HED ROUTINE TO SET UP SYSTEM MAP SYSMP NOP CLA START REGISTER 0 LDB TBL START VALUE 0 LDX D32 LENGTH OF SYSTEM XMS LOAD SYSTEM MAP LDA $MPSA GET START PAGE SYS AV AND B1777 STA TBL B HAS START VALUE LDA EQT1 AND B1777 XOR EQT1 KEEP ONLY PAGE ALF RAL,RAL GET IN LOW 5 BITS STA NWDS1 START PAGE OF SAM LDA TBL XOR $MPSA GET LENGTH ALF RAL,RAL A HAS LENGTH STA MADR1 TEMPORORY STORE CAX PUT IN XREG LDB TBL START PAGE NUMBER LDA NWDS1 START REGISTER XMS LOAD MAP LDA NWDS1 YES ADA MADR1 TOTAL NUMBER REGISTERS MAPPED LDB A IOR WRTPR STA WRTPR LDA B CMB,INB ADB D32 SEE HOW MANY LEFT CBX LDB WRTPR GET WRITE PROTECT XMS SJP SYSMP,I ENABLE SYSTEM MAP SKP 2 $MPSA BSS 1 0-9,STARTING PAGE SYS AV MEM * LL 10-15,NUMBER PAGES SAM TBL NOP WRTPR OCT 100000 B1777 OCT 1777 D32 DEC 32 HED MESSAGE PROCESSOR--IT,XXXXX COMMAND * IT,XXXXX * IT,XXXXX,R,MMM * IT,XXXXX,R,MMM,HR,MN * IT,XXXXX,R,MMM,HR,MN,SC * IT,XXXXX,R,MMM,HR,MN,SC,MS * * R=RESOLUTION CODE * 1= TEN MILLISECOND CODE * 2= SECONDS CODE * 3= MINUTES CODE * 4= HOURS CODE * MM= MULTIPLICATION FACTOR * HR= START HOURS * MN= START MINUTES * SC= START SECONDS * MS= START TENS OF MILLISECONDS * M0600 JSB TTNAM GO FIND ID SEG ADDR SZA PROG MUST BE DORMANT TO CONTINUE JMP M0405 ILLEGAL STATUS ERROR LDA WORK SET ADA D17 UP THE TIME PRAMETER STA TEMPP STARTING ADDRESS. LDB P2 GET THE RESOLUTION ADB DM5 CODE AND TEST SSB,RSS FOR MORE THAN 4. JMP $INER GREATER THAN 4-ILLEGAL CODE LDA P3 GET THE MULT. FACTOR. LDB TEMPP,I GET THE OLD TIME PRAM. BLF,ERB IF IN TIME LIST ALF,ERA SET BIT IN NEW WORD. LDB P2 GET RESOLUTION TO B SZB,RSS IF ZERO RESOLUTION JMP M0605 GO REMOVE FROM TIME LIST LSR 3 SHIFT THE WHOLE MESS TO A M0604 STA TEMPP,I SET NEW RESOLUTION MULT. ISZ TEMPP INCR TO TMS ADDRESS LDA P7 GET TENS OF MS. ADA DM100 SSA,RSS MINUS, IF LEGAL VALUE JMP $INER INPUT ERROR LDA P6 GET SECONDS VALUE ADA DM60 SSA,RSS MINUS, IF LEGAL VALUE JMP $INER INPUT ERROR LDA P5 GET MINUTES. ADA DM60 SSA,RSS YES, SO CONVERT TO DECIMAL JMP $INER INPUT ERROR LDA P4 GET HOURS ADA DM24 SSA,RSS MINUS, IF LEGAL VALUE JMP $INER INPUT ERROR LDA DP4 SET DEFS TO THE PRAMS STA RQP5 ON THE BASE LDA DP5 _ PAGE FOR STA RQP6 $ETTM LDA DP6 THE SET TIME STA RQP7 SUBROUTINE LDA DP7 IN THE STA RQP8 RTIME MODULE LDB TEMPP GET ID-SEG ADDRESS AND JSB $ETTM GO SET VALUES IN ID-SEG JMP M0150 EXIT $MESS SPC 2 M0605 CCB REMOVE PGM FROM TIME ADB TEMPP LIST JSB $TREM CLA AND CONTINUE JMP M0604 SETTING UP THE ID-SEG SPC 1 DM100 DEC -100 SPC 2 BLIM CLB,CCE,INB CHECK TO SEE IF EXAMINE CPB PARAM ONE PRAM? JMP BLIMP YES GO PRINT LIMITS * LDB P2 GET THE SECOND PRAMETER CMB,INB,SZB GET NEW UPPER LIMIT STB $BLUP IF ZERO SKIP THE STORE CMA,INA SET UP THE LOWER LIMIT STA $BLLO JMP M0150 GO EXIT DONE SPC 1 BLIMP LDA $BLLO GET THE LOWER LIMIT CMA,INA SET POSITIVE JSB $CVT1 CONVERT TO ASCII OCTAL STA BUFF3 SET LOW DIGITS DLD ASCI GET THE HIGH 4 DIGITS DST BUFF1 AND SET IN BUFFER LDA $BLUP GET THE UPPER LIMIT CMA,CCE,INA SET POSITIVE JSB $CVT1 CONVERT STA BUFF7 SET THE LOW DIGITS DLD ASCI GET THE HIGH DIGITS DST BUFF5 SET IN THE BUFFER LDA AASCI GET A DOUBLE BLANK STA BUFF4 SET BETWEEN THE NUMBERS LDA DM14 GET RECORD LENGTH STA BUFFR SET IN THE BUFFER AND JMP M0520 GO SEND THE MESSAGE SPC 1 DM14 DEC -14 HED MESSAGE PROCESSOR--PR,XXXXX,ZZ COMMAND * * PR,XXXXX,ZZ PROCESSOR * * THE PRIORITY CHANGE ROUTINE FUNCTIONS AS FOLLOWS: * IF PROGRAM STATUS OTHER THAN DORMANT, STATUS ERROR. * IF DORMANT, THEN PRIORITY VALUE CHANGED AND PROGRAM * LIST UPDATED VIA LINK PROCESSOR. * M0650 JSB TTNAM GO TO FIND ID SEG ADDR SEZ MUST BE A PROGRAM TO CONTINUE JMP NXPRG ILLEGAL PROGRAM MESSAGE LDA P2 GET PRIORITY SSA,RSS SZA,RSS CHECK IF ZERO PRIORITY REQ JMP $INER ERROR-ILLEGAL VALUE LDB WORK ADB D6 STA B,I STORE NEW PRIORITY VALUE STA NPCNG SAVE NEW PRIORITY JSB $LIST RELINK THE PROGRAM OCT 317 BY NEW PRIORITY LDB NPCNG GET NEW PRIO LDA WORK GET ID ADR JSB PRCNG GO RELINK IN ALLOCATED LIST CLA JMP MSEX RETURN NPCNG BSS 1 SPC 5 * MESSAGE PROCESSOR -- TM COMMAND * M0700 LDB DEFP1 PASS PRAM. ADDRESS TO JRS $MEU $TMRQ RTIME PROCESSOR SPC 2 * MESSAGE PROCESSOR -- BR,XXXX REQUEST * * SET BREAK BIT IN PROGRAMS ID-SEGMENT * M0725 JSB TTNAM LOOK UP THE PROGRAM SEZ IF NOT FOUND JMP NXPRG REJECT REQUEST M0730 ADB D20 INDEX TO BREAK WORD LDA B,I GET WORD IOR B10K SET BREAK BIT STA B,I RESTORE THE WORD JMP M0150 EXIT HED MESSAGE PROCESSOR--TI COMMAND * * TI COMMAND * * THE REQUEST TO GET CURRENT SYSTEM TIME OUTPUTS CURRENT * YEAR, DAY NUMBER, HOUR, MINUTES, AND SECONDS IN THE * FOLLOWING FORMAT: * YEAR.DAY..HR..MN..SC * WHERE THE .'S ARE BLANKS * M0750 LDA DM20 STA BUFFR SET OUTPUT CHARACTER COUNT LDA DTEMP SET UP TO GET THE TIME STA RQP2 TO TEMP AREA ADA D5 STA RQP3 DLD $TIME JSB $TIMV GO GET TIME JSB $CVT1 CONVERT YEARS STA BUFF2 SET LEAST TWO DIGITS LDA ASCI1 GET THE NEXT TWO DIGITS STA BUFF1 AND SET THEM LDA TEMP4 GET DAYS JSB $CVT1 CONVERT AND STORE DAYS STA BUFF4 SET LEAST TWO DIGITS LDA ASCI1 GET NEXT DIGIT STA BUFF3 SET IN BUFFER LDA AASCI STUFF NECESSARY WORDS WITH STA BUFF5 BLANKS STA BUFF7  STA BUFF9 LDA TEMP3 GET HOURS JSB $CVT1 CONVERT AND STORE HOURS STA BUFF6 LDA TEMP2 JSB $CVT1 CONVERT AND STORE MINUTES STA BUFF8 LDA TEMP1 JSB $CVT1 CONVERT AND STORE SECONDS STA BUF10 JMP M0520 GO SET A AND EXIT SPC 1 DM20 DEC -20 * * DN,N1 OR DN,,N2 * * THE REQUEST TO DOWN AN EQT OR LU WORKS AS FOLLOWS: * IF N1 IS GIVEN, DOWN THE EQT POINTED TO BY N1. * IF N2 IS GIVEN, DOWN THE LU POINTED TO BY N2. * M0800 CCE NO THIRD PARAMETER. JSB P1OR2 SET A=PARAMETER 1, B=PARAMETER 2. JMP $IODN GO TO 'DOWN' ROUTINE. HED MESSAGE PROCESOR--LU,EQ AND TO COMMANDS * * THE FOLLOWING COMMANDS ARE PASSED TO THE PROGRAM * $$CMD FOR PROCESSING. $$CMD DOES ALL PROCESSING * AND RETURNS ANY ERROR OR STATUS MESSAGES RESULTING * FROM THESE COMMANDS. * * LU,N1[,N2[,N3]] * EQ,N1[,N2] * TO,N1[,N2] * M0920 LDB $$CMD JSB TNAME CHECK LEGALITY OF SEZ PROGRAM NAME. JMP NXPRG PROGRAM DOES NOT EXIT. * LDA WSTAT,I CHECK STATUS AND D15 OF PROGRAM. SZA ERROR IF PROGRAM JMP M0405 NOT IN DORMANT STATE. * LDA PARAM IF ONLY ONE PARAMETER, CPA D2 THEN SET PARAMETER JMP FXSC5 TWO TO -1. * FXSC2 LDA B MOVE PARAMETERS LDB DEFP0 INTO THE PROGRAM'S JSB PRAM ID SEGMENT. * JSB $LIST SCHEDULE THE PROGRAM. OCT 301 (ID ADDRESS IN WORK) CLA JMP MSEX RETURN. * FXSC5 CLA,INA SET STA CP2 PARAMETER CMA,INA TWO STA CP2+1 TO JMP FXSC2 -1. * $$CMD DEF *+1 ASC 3,$$CMD SKP P1OR2 DEF ABM ENTRY/EXIT LDA CP2 CHECK IF JUST SZA,RSS ONE PARAMETER JMP P1OR5 YES - GO EXIT n_ LDA P2 GET SECOND PRAM. SEZ,RSS IS A THIRD PARAMETER POSSIBLE? JMP P1OR7 YES P1OR3 LDB A LOAD B WITH 'N2' OR 'N3:N2' P1OR4 LDA P1 LOAD A WITH N1 JMP P1OR2,I P1OR5 CCB SET B REG TO -1 FOR 1 PARAMETER JMP P1OR4 P1OR7 AND B377 SAVE BITS 7-0 STA P2 OF 'N2' LDA P3 GET 'N3' AND B37 KEEP BITS 4-0 AND LSL 11 MOVE THEM TO POSITIONS 15-11 ADA P2 ADD IN THE 'N2' PRAM JMP P1OR3 GO EXIT * B37 OCT 37 * * INPUT ERROR MESSAGE OUTPUT * * $INER LDA $ERIN INPUT ERROR MESSAGE JMP MSEX RETURN HED MESSAGE PROCESSOR -- AB COMMAND * * MESSAGE PROCESSOR -- AB COMMAND * * THE AB COMMAND ABORTS THE BATCH PROGRAM CURRENTLY * BEING EXECUTED * * IT TRACKS DOWN THE LOWEST LEVEL USING FMGR AS THE * FIRST LEVEL. IF FMGR IS NOT WAITING THEN IT'S BREAK * FLAG IS SET. IF FMGR IS DORMANT THE REQUEST IS ILLEGAL * IF D.RTR IS AT THE END OF THE LIST THEN THE * INVOLKING PROGRAM IS ABORTED OR, IF FMGR, THE BREAK FLAG * IS SET. * M0950 ALR,ALF KILL BIT 3 (NEVER =8) STA P2 SET THE OPTION FLAG LDB IDFMG GET FMGR'S ID-SEG. ADDRESS M0951 STB WORK AND SET UP WORK SZB IF NO FMGR SKIP ADB D15 INDEX TO STATUS LDA B,I GET STATUS AND D15 IF FMGR IS DORMANT SZA,RSS THEN JMP M0405 ILLEGAL STATUS EXIT * LDA B,I GET STATUS ALF,CLE,SLA IF WAITING JMP M0958 GO TRACK DOWN * M0955 LDB IDFMG GET FMGR'S ID-SEG ADDRESS CPB WORK IF SAME AS CURRENT JMP M0730 GO SET BREAK FLAG * JMP M0202 ABORT * M0958 LDB WORK GET CURRENT ID INB STEP TO WAIT PROGRAM LDB B,I GET ADDRESS CPB ID.RT IF D.RTR JMP M0955 GO DO PREVIOUS PGM. * CPB $IDSM NLH IF SMP JMP M0955 GO TO PREV. JMP M0951 AND CONTINUE HED MESSAGE PROCESSOR - LS N1,N2 PROCESSOR * * SET "SOURCE FILE" IDENTIFICATION * * THE OPERATOR REQUEST IS: * "LS,LUN,1ST TRACK # " * THIS STATEMENT SETS THE SOURCE FILE CONTROL WORD * IN THE COMMUNICATION AREA IN THE FOLLOWING * FORMAT( THE WORD IS LABELED "SFCUN" ): * ******************************* * *LU* ST. TRACK #* ZERO * * ******************************* * 15,14 - 7,6 - 0 (BITS) * * THE LOGICAL UNIT # AND STARTING TRACK # ARE * RECORDED BY THE 'EDITOR' WHEN THE SOURCE FILE * IS CREATED. * * VALIDITY CHECKS ARE FOR LOGICAL UNIT = 2 OR 3, * HOWEVER, A LU = 0 WILL SET "SFCUN" = 0. * M0960 CLB IF PARAM 1 = 0, GO TO SZA,RSS JMP M0961 CLEAR "SFCUN" CLE,ERA SET E IF LU 3. CPA D1 IF NOT LU 2 OR THREE CPB CP2 OR P2 NOT SUPPLIED THEN TAKE JMP $INER ERROR EXIT. ERB SET SIGN OF B TO 1 IF LU 3. =yN ADB P2 ADD THE TRACK AND ASL 7 NORMALIZE (I.E. PUT IN 14-07) * M0961 STB SFCUN SET "SFCUN" JMP M0150 GO EXIT * ID.RT NOP STORAGE FOR D.RTR ADDRESS NOP STORAGE FOR EDIT ADDRESS IDFMG NOP STORAGE FOR FMGR ADDRESS $IDSM NOP STORAGE FOR SMP ADDRESS HED MESSAGE PROCESSOR - LG,N COMMAND * * SET "LOAD-AND-GO" PARAMETERS * * THE OPERATOR STATEMENT IS: * "LG,# OF TRACKS" * * THIS STATEMENT ALLOWS THE OPERATOR TO: * 1. ALLOCATE A NUMBER OF CONTIGUOUS DISC * TRACKS FOR 'LOAD-AND-GO' USAGE. * 2. RELEASE TRACK(S) CURRENTLY ASSIGNED TO LGO. * * THIS REQUEST HAS NO EFFECT IF LGO CURRENTLY IN USE * * THE BASE PAGE COMMUNICATION AREA WORDS DESCRIBED * BELOW CONTAIN THE LGO TRACK ASSIGNMENTS: * * ******************************** * 'LGOTK' *LU* ST. TRACK # * # OF TRACKS * * ******************************** * 15,14---------07,06---------00 * * ******************************** * 'LGOC' *LU* TRACK # * SECTOR # * * ******************************** * 15,14---------07,06---------00 * * LGOTK DEFINES THE LU #, THE STARTING TRACK # * AND THE NUMBER OF CONTIGUOUS TRACKS. THIS * WORD IS ZERO IF NO TRACKS ARE ALLOCATED. * * LGOC DEFINES THE CURRENT AVAILABLE SECTOR. * THIS IS UPDATED BY 'RTIOC' AND RESET TO * THE BEGINNING OF THE AREA BY THE LOADER * AFTER LOADING FROM THE LGO AREA; ALSO BY * THIS ROUTINE WHEN THE TRACKS ARE ALLOCATED. * * M0970 AND B177 MAX. VALUE OF 127. STA P1 -SAVE P- SZA,RSS IF P = 0, GO TO JMP M0971 RELEASE LGO TRACK(S). CLA CHECK FOR CPA LGOTK CURRENT ASSIGNMENT. M0975 CLB,RSS -NONE JMP M0971 -RELEASE CURRENT * LDA P1 (A) = # OF TRACKS JSB $DREQ ALLOCATE TRACKS * SZB,RSS IF P TRACKS D8NOT JMP M0972 AVAILABLE, GO FOR DIAG. RETURN. * RBR SET SIGN OF B IF LU 3. ASL 16 MOVE THE TRACK UP ASL 7 TO BITS 14-07 OF B. STB LGOC SET LGOC. ADB P1 SET # OF TRACKS IN 06-00 STB LGOTK AND SET LGOTK. * JMP MSEX -RETURN- * M0971 CPA LGOTK JMP MSEX LDB LGOTK GET ASSIGNMENT WORD TO RELEASE. CLE,ELB SET E IF LU = 3 LSR 8 SET FIRST TRACK IN B ALF,ALF PUT # OF RAR TRACKS IN A CMA,SEZ,CLE,INA SET NEGATIVE,SKIP IF LU 2. ADB TATSD ADD SYSTEM DISC SIZE JSB $CREL GO RELEASE IF POSSIBLE SZB RELEASE OK? JMP M1973 NO SEND THE NASTY MESSAGE. STB LGOTK CLEAR 'LOAD-AND-GO' STB LGOC CONTROL WORDS. CPB P1 IF P = 0, JMP M0150 -RETURN- JMP M0975 GO TO ALLOCATE NEW TRACKS. * M0972 LDA $NOLG PRINT: NO LGO SPACE RSS M1973 LDA $LGBS PRINT: LGO IN USE JMP MSEX HED MESSAGE PROCESSOR CONSTANTS ETC. LASCI OCT 000040 ASCII BLANK IN LOW CHARACTER MASKU OCT 177400 UPPER CHARACTER MASK (AND) TEMPP NOP TEMPORARY STORAGE KEY NOP TEMPORARY STORAGE * DEFP0 DEF DP0,I DEFP2 DEF DP2,I DP0 DEF OP DP1 DEF P1 DP2 DEF P2 DP3 DEF P3 DP4 DEF P4 DP5 DEF P5 DP6 DEF P6 DP7 DEF P7 HED CONTROL PARAMETER STORE IN ID SEGMENT PLOAD NOP ENTRY/EXIT LDA WSTAT,I IF NO PRAM BIT IS RAL,RAL SET THEN DO NOT PASS CLE,SSA THE SCHEDULING STRING JMP PLOAD,I (SET E=0 FOR ALCST BELOW). LDB PARAM IF NO PARAMETERS, CPB D2 THEN DO NOT PASS JMP PLOD5 THE SCHEDULING STRING. LDB OP+1 CHECK FOR "IH" IN CPB ASCIH COMMAND TO INHIBIT JMP PLOD5 PASSAGE OF STRINGS. * LDB WORK NO "IH",SO GET ID-SEG ADDRESS B JSB ALCST AND GO STORE THE STRING. JMP NOMEM MEMORY ALLOCATION ERROR? JMP NOMEM YES, GO SEND MESSAGE. * PLOD5 LDB DEFP2 GET INDIRECT DEF TO PRAMS. LDA CP2 GET PRAM FLAG RAR,SLA IF ASCII "NO" LDA P2 ENTERED CPA NO THEN STEP PRAM ADDRESS FIRST TIME INB STEP PRAM ADDRESS LDA WORK GET ID-SEGMENT ADRESS JSB PRAM GO SET PRAMS. JMP PLOAD,I RETURN. * NOMEM LDA $NMEM GO ISSUE NO MEMORY JMP $MSEX MESSAGE AND RETURN. * ASCIH ASC 1,IH NO ASC 1,NO SKP * * SUBROUTINE TO SET UP THE PRAMETERS IN A PROGRAMS * ID-SEGMENT. PRAM SETS FIVE PRAMETERS AND THE B * REGISTER. IF THE NO PRAMETER FLAG IS SET NO * ACTION IS TAKEN. * * CALLING SEQUENCE: * * LDB PRAM ADDRESS (OR INDIRECT TO LIST OF ADDRESSES) * LDA ID-SEGMENT ADDRESS * JSB PRAM * * RETURN: * =1 NO PRAMS BIT SET. * =0 NO PRAMS BIT NOT SET. * OTHER REGISTERS MEANINGLESS. * PRAM NOP INA STEP TO THE PRAM AREA STA TEMP SET IN TEMP ADA D9 STEP TO THE B-REGISTER STA TEMP1 ADDRESS AND SAVE ADA D5 STEP TO THE STATUS ADDRESS LDA A,I GET THE STATUS AND CHECK RAL,RAL THE NO PRAM ALLOWED BIT CCE,SSA IF SET THEN (SET E REG) JMP PRAM,I JUST EXIT * RSA GET MEU STATUS RAL,RAL GET CURRENT STATUS STA PRSTM UJP *+2 ENABLE USER MAP LDA TEMP GET THE PRAM AREA ADDRESS AND STA TEMP1,I SET IT IN THE B REG. SAVE AREA LDA DM5 SET UP THE STA TEMP1 COUNTER PRAM1 CLA ZERO ADDRESS GETS A ZERO LDA B,I GET PRAM STA TEMP,I STUFF IT ISZ TEMP STEP STORE ADDRESS CLE,INB STEP SOURCE ADDRESS (CLEAR E REG) ISZ TEMP1 DONE? JMvP PRAM1 NO- CONTINUE JRS PRSTM PRAM,I YES-EXIT PRSTM NOP HED MESSAGE PROCESSOR NAME SEARCH * * CALL TO NAME SEARCH ROUTINE * * CALLING SEQUENCE: * * JSB TTNAM NAME ASSUMED TO BE IN P1 * * ON RETURN: * WORK AND B CONTAIN THE ID-SEG. ADDRESS * WSTAT CONTAINS THE STATUS ADDRESS * A CONTAINS THE LEAST 4 STATUS BITS. * E = 0 IF STANDARD ID SEGMENT * E = 1 IF SHORT (9 WORD ) ID SEGMENT * IF A SHORT ID SEGMENT A WILL BE SET TO 9. * TTNAM NOP ENTRY/EXIT LDB DEFP1 ADDRESS OF ASCII PROG NAME JSB TNAME CALL TO NAME SEARCH ROUTINE SZA,RSS IF ZERO, THEN PROG NOT FOUND JMP NXPRG SO TAKE GAS! LDA WSTAT,I GET STATUS TO A AND D15 MASK IT AND SEZ IF SHORT ID SEGMENT LDA D9 REPLACE IT WITH 9. JMP TTNAM,I RETURN SPC 2 NXPRG LDA $NOPG NO SUCH PROG ERROR JMP MSEX EXIT HED SEARCH KEYWORD LIST FOR PROGRAM NAME * ON ENTRY * B IS ADDRESS OF ASCII PROGRAM NAME * ON RETURN * A IS 0 IF PROGRAM NOT FOUND (E=1) * B AND WORK ARE THE ID SEGMENT ADDRESS OF REQUESTED PROGRAM * WSTAT = THE STATUS WORD ADDRESS. * E = 0 IF STANDARD ID SEGMENT * E = 1 IF SHORT (9 WORD ) ID SEGMENT OR NOT FOUND * TNAME NOP ENTRY/EXIT STB TEMP3 ADDRESS OF NAME 1 AND 2 INB INCR TO CHAR 3 AND 4 ADDR STB TEMP4 SAVE IT INB INCR TO CHAR 5 ADDR LDA B,I ASCII NAME CHAR 5 AND X AND MASKU MASK OFF X STA TEMP5 SZA IF NULL CHAR. FOURCE ERROR RETURN LDA KEYWD STA KEY TOP OF KEYWORD LIST TN005 LDA KEY,I CHECK IF AT END OF LIST CCE,SZA,RSS JMP TNAME,I END OF LIST ERROR RETURN ADA D12 LDB A,I ID SEG ASCII NAME CHARS 1 AND 2 CPB TEMP3,I COMPARE WITH REQUESTED CHAR 1,2 INA,RS&S COMPARES JMP TN030 DOES NOT COMPARE-GO TO NEXT PROG LDB A,I ID SEG ASCII NAME CHARS 3 AND 4 CPB TEMP4,I COMPARE WITH REQUESTED CHARS 3,4 INA,RSS COMPARES JMP TN030 DOES NOT COMPARE-GO TO NEXT PROG STA WSTAT SET UP WSTAT IN CASE LDA A,I ID SEG ASCII NAME CHARS 5,X STA B SAVE FOR SHORT ID TEST AND MASKU MASK OFF X CPA TEMP5 COMPARE CHARACTER 5 JMP TN040 COMPARES-SO PROGRAM FOUND * TN030 ISZ KEY INCREMENT KEYWORD ADDRESS JMP TN005 GO TO COMPARE CHARACTERS TN040 LSR 4 MOVE SHORT ID BIT TO LEAST B ERB SET E FOR RETURN LDB KEY,I LOAD B WITH ID SEGMENT ADDRESS STB WORK SET IN WORK ISZ WSTAT STEP TO STATUS ADDRESS AND JMP TNAME,I EXIT HED CVT3 (BINARY TO ASCII CONVERSION) * * BINARY TO ASCII CONVERSION ROUTINE * * CALLING SEQUENCE * * SET E TO 0 IF OCTAL CONVERSION OR * SET E TO 1 FOR DECIMAL CONVERSION * LDA NUMBER TO BE CONVERTED * JSB $CVT3 * * RETURN ADDRESS OF ASCI IN A AND E=1. * RESULTS IN ASCI, ASCI+1, ASCI+2 * LEADING 0'S SUPPRESSED * $CVT3 NOP ENTRY/EXIT STB TEMP6 SAVE B REGISTER LDB PTTE INIT LOCATION OF BUFFER STB TMP LDB AASCI SET BUFFER=ASCII BLANK'S STB ASCI STB ASCI1 STB ASCI2 LDB DF10 ASSUME BASE TEN SEZ,CLE,RSS IF BASE EIGHT INB SET UP FOR BASE EIGHT STB BASE SET CONVERSION BASE ADDRESS DPCRL CLB START CONVERSION DIV BASE DIVIDE BY BASE BASE EQU *-1 DEFINE BASE ADDRESS ADB B20 CONVERT TO ASCII-BLANK SEZ IF HIGH DIGIT BLF,BLF ROTATE ADB TMP,I ADD CURRENT VALUE STB TMP,I STORE THE CONVERTED VALUE CCB,SEZ PREPARE FOR SUBTRACT lADB TMP IF HIGH CHAR. BACKUP SEZ,CME BUFFER POINTER STB TMP AND RESET SZA IF MORE DIGITS JMP DPCRL GO SET THE NEXT ONE * CCE SET E FOR NEXT CALL (ASSUME BASE 10) LDA PTT LOAD A WITH ASCI BUFFER ADDRESS LDB TEMP6 RESTORE B JMP $CVT3,I RETURN * B20 OCT 20 DF10 DEF D10 D10 DEC 10 D8 DEC 8 PTT DEF ASCI PTTE DEF ASCI2 HED $CVT1 (BINARY TO ASCII CONVERSION) * CALLING SEQUENCE: SAME AS $CVT3 * * RETURN RESULTS LEAST TWO DIGITS IN A. * OTHERS AS PER $CVT3 * $CVT1 NOP JSB $CVT3 GO CONVERT THE NUMBER LDA ASCI2 GET LEAST TWO DIGITS JMP $CVT1,I RETURN HED OUTPUT *_ ON SYSTEM TELETYPE ******************************************************************* * THE $TYPE SECTION FUNCTIONS AS FOLLOWS: * ENTRY IS MADE BY STRIKING ANY SYSTEM TELETYPE KEY. * IF TELETYPE FLAG NOT BUSY, THEN * IS OUTPUT AND A * REQUEST IS MADE FOR INPUT. IF FLAG IS SET THEN * IGNORE REQUEST. UPON COMPLETION OF INPUT (LF), * THE MESSAGE PROCESSOR ROUTINE IS CALLED. * UPON RETURN, IF A REGISTER IS ZERO THEN NO * MESSAGE TO BE OUTPUT. IF A NON-ZERO, THEN A IS * ADDRESS OF MESSAGE TO OUTPUT WITH CHARACTER * COUNT THE FIRST WORD IN BUFFER. ******************************************************************* * $TYPE LDA FLG CHECK SYSTEM TTY FLAG SZA JMP $XEQ BUSY, SO RETURN TO $XEQ JSB $XSIO CALL TO OUTPUT ASTERISK(*) OCT 1 ON SYSTEM TELETYPE NOP NOP OCT 2 DEF ASTRK DM4 DEC -4 OUTPUT CHARACTER COUNT OCT 0 SAYS DON'T NEED USER MAP JSB $XSIO CALL TO REQUEST OPERATOR INPUT OCT 1 DEF TYP10 INPUT COMPLETION ADDRESS NOP OCT 401 T INPUT WITH TYPEOUT IBUF DEF INBUF ABS -BUFFL DETERMINED BY $STRT ROUTINE OCT 0 DONT NEED USER MAP ISZ FLG SET SYSTEM TTY BUSY FLAG JMP $XEQ GO TO $XEQ * TYP10 CLA CLEAR THE COM FLAG STA FLG LDA IBUF GET BUFFER ADDRESS TO A JSB $MESS GO TO MESSAGE PROCESSOR ROUTINE SZA,RSS CHECK IF MESSAGE TO BE OUTPUT JMP TYP30 NO MESSAGE-SO GO RETURN * ISZ FLG SET THE COM FLAG LDB A,I STB TYP26 BRS CONVERT CHARACTER COUNT  CMB,INB TO POSITIVE WORD COUNT. STB TYPCO SAVE WORD COUNT. LDB IBUF GET BUFFER INA ADDRESSES. MVW TYPCO GO MOVE WORDS. * JSB $XSIO CALL TO OUTPUT ERR MESSAGE OCT 1 DEF TYP30 COMPLETION ADDRESS TYPCO NOP OCT 2 DEF INBUF TYP26 NOP OCT 0 DONT NEED USER MAP JMP $XEQ GO TO $XEQ TYP30 CLA CLEAR SYSTEM FLAG FOR NEXT STA FLG REQUEST JMP $XEQ ASTRK OCT 006412 CR, LF ASC 1,*_ ASTERISK, LEFT ARROW HED $ABRT ROUTINE TO ABORT A PROGRAM * ROUTINE: < $ABRT > * * PURPOSE: THIS ROUTINE PROVIDES FOR REMOVING * A USER PROGRAM FROM EXECUTION USUALLY * AFTER AN ERROR CONDITION IS DETECTED * WHICH PROHIBITS CONTINUED EXECUTION. * THE PROGRAM IS SET TO THE DORMANT * STATE, TIME INTERVAL REMOVED AND ANY * DISC TRACKS ASSIGNED TO THE PROGRAM * RELEASED. * * THE PROGRAM NAME IS SET IN THE MESSAGE * "XXXXX ABORTED" WHICH IS PRINTED * ON THE SYSTEM TELETYPE. * * CALL: (A) = ID SEGMENT ADDRESS * (P) JSB ABORT * (P+1) -RETURN- (REGISTERS MEANINGLESS) * $ABRT NOP SET ID SEGMENT ADDRESS STA TEMPH FOR SABRT CALL ADA D15 INDEX TO THE STATUS WORD LDB A,I GET THE WO>RD ADB B4000 SET THE ABORT BIT STB A,I RESET THE STATUS WORD LDB TEMPH SET B AND CALL JSB SABRT THE SOFT ABORT ROUTINE LDA TEMPH GET THE ADDRESS AND JSB $SDRL GO RELEASE THE DISC TRACKS LDB TEMPH SET (B) = ADDRESS OF 3-WORD ADB D12 PROGRAM NAME IN ID SEGMENT. LDA B,I SET STA ABM PROGRAM INB NAME LDA B,I IN STA ABM+1 MESSAGE INB LDA B,I AND MASKU MASK OUT THE LOWER CHARACTER IOR LASCI REPLACE WITH A BLANK STA ABM+2 LDA ABMA PRINT MESSAGE: JSB $SYMG "XXXXX ABORTED" JMP $ABRT,I -EXIT- * ABMA DEF *+1 DEC -13 ABM ASC 7,EDIT ABORTED (NAME 'EDIT' IS USED) AASCI ASC 1, HED MEMORY PROTECT VIOLATION SCHEDULER PREPROCESSORS ******************************************************************* * THE $MPT1 THRU $MPT9 PREPROCESSORS CONSIST OF MEMORY * PROTECT VIOLATION CALLS FROM EXEC THAT INVOLVE LIST * PROCESSING. * THE FOLLOWING REQUESTS ARE HANDLED: * PROGRAM COMPLETION (DORMANT) * SUSPEND (OPERATOR) * BACKGROUND SEGMENT LOAD * SCHEDULE WITH WAIT * SCHEDULE WITHOUT WAIT * CURRENT SYSTEM TIME (TIME ROUTINE CALL) * SET ID SEGMENT TIME VALUES (TIMER ROUTINE CALL) * SET/CLEAR ALL-OR-MEMORY AND CORE-LOCK FLAGS * GET/PUT A COMMAND STRING ******************************************************************* SPC 3 * * DORMANT REQUEST - PROGRAM HAS RUN TO COMPLETION * $MPT1 JSB GETID GET THE ID-SEGMENT ADDRESS OF AFFECTED STB P2 PROGRAM - SAVE THE ID ADDRESS FOR PRAM MOVE CPB XEQT IF CURRENT PGM. SKIP JMP MPT1A FATHER CHECKS * ADB D20 STEP TO FATHER POINTER ADDRESS CCA GET ADA B,I TO A AND kQB377 AND MASK ADA KEYWD ADDRESS OF ID OF FATHER IN A LDA A,I NOW CPA XEQT CURRENT PROGRAM? RSS YES SKIP JMP ESC04 NO GO FLUSH * LDB WORK RESTORE THE ID-SEGMENT ADDRESS TO B * MPT1A LDA RQRTN UPDATE THE RETURN STA XSUSP,I ADDRESS CLA SET A TO ZERO IN CASE LDA RQP3,I PRAMETER NOT SUPPLIED CMA,SZA,RSS IS THIS GUY SERIALLY REUSABLE JMP MPT1E YES, GO DO IT INA,SZA,RSS JMP MPT1B STANDARD TERMINATION CALL. * INA,SZA,RSS IS IT JMP MPT1C A SAVE RESOURCES TERMINATION * INA,SZA,RSS MAY BE A SOFT ABORT JMP M0240 YES GO TO ABORT ROUTINE * INA,SZA,RSS HARD ABORT (LAST CHANCE) JMP M0250 WOW THAT WAS CLOSE! * ESC02 LDB D2 YOU LOSE - UNRECOGNIZED PRAMETER. JMP ESCXX GO ABORT HIM * MPT1C LDA WORK GET ID ADR JSB ALDM GO PUT IN DORMANT LIST & SET FLG LDB WORK RESTORE B LDA WSTAT,I SET THE IOR B200 RESOURCE BIT IN THE STATUS STA WSTAT,I AND THEN CPB XEQT IF CURRENT PROGRAM JMP MPT1D SKIP DORMANT REQUEST JSB $LIST OCT 400 JMP $XEQ GO TO DISPATCHER * MPT1E CPB XEQT TERM SON AS REUSABLE RSS JMP MPT1B GO DO NORMAL TERMINATE JSB TERM CALL TERMINATE ROUTINE ISZ TMP,I IF OK, SET FLAG FOR SERIAL REUSE LDA IDCKK (ID ADDRESS SAVED HERE IN TERM) JSB ALDM GO PUT IN DORMANT LIST & SET FLAG JMP MPT1F GO FINISH PROCESSING * MPT1D JSB $WATR FIND WAITERS LDB XEQT MPT1B JSB TERM CALL TERMINATION ROUTINE MPT1F LDA DM3 IF REQUEST PRAMS ADA RQCNT THEN SSA SKIP JMP $XEQ ELSE GO TO THE DISPATCHER * LDB DEFR4 GET DEF TO PRAMS LDA P2 GET ID-ADDRESS JSB PRAM TRANSFER THE PRAMETERS _JMP $XEQ GO TO THE DISPATCHER SPC 1 DM3 DEC -3 SKP * THE TERM SUBROUTINE PERFORMS THE FOLLOWING FUNCTIONS: * * 1. CALL $LIST TO PUT THE PROGRAM IN THE DORMANT LIST * 2. IF THE PROGRAM HAS A FATHER WHO IS WAITING THE * FATHER IS RESCHEDULED * 3. CHECKS TO SEE IF ANOTHER PROGRAM IS WAITING FOR THIS ONE * AND SCHEDULES IT IF SO. * * CALLING SEQUENCE: * * LDB ID ADDRESS * JSB TREM * * ON RETURN THE FATHER POINTER (IF ANY) IS IN POP. * AND IF HE WAS WAITING E WILL BE SET ELSE E=0. * TERM DEF D.RTR JSB $LIST PUT PGM. IN DORMANT OCT 400 LIST LDB WORK GET ID SEG ADDRESS * STB IDCKK SAVE THE ID-ADDRESS ADB D20 INDEX TO THE PA POINTER LDA B,I GET THE WORD STB TMP SAVE THE ADDRESS RAL,ELA SET E IF FATHER IS WAITING CCB,SEZ,CME,RSS E=0 IF FATHER/1 IF NO FATHER JMP TERM2 IF NO FATHER GO SET -1. ADB KEYWD KEYWD-1 TO B (SETS E) RAR,CLE,RAR RESTORE A AND SET E TO FATHER WAITING. AND B377 GET THE FATHER ID NUMBER ADB A ID ADDRSS TO B LDB B,I GET THE ID-SEG ADDRESS TERM2 STB POP SAVE THE ADDRESS ADB D15 REMOVE THE POP'S WAIT BIT LDA B,I GET POP'S STATUS AND B7777 KNOCK OUT THE WAIT BIT SEZ,RSS IF WAITING STA B,I RESTORE THE WORD AND D15 IF POP'S CPA D3 IN THE WAIT LIST SEZ AND WAITING JMP TERM3 JSB $LIST THEN RESCHEDULE OCT 101 THE FATHER POP DEF POP * TERM3 LDA TMP,I GET THE FLAG WORD AND B7400 AND KEEP ONLY RE,RM,RN FLAGS STA TMP,I IN WORD JMP TERM,I RETURN * * D20 DEC 20 SIGN OCT 100000 B200 OCT 200 B7400 OCT 7400 DEFR4 DEF RQP4,I SPC 2 $WATR NOP LDA B ADB D20 LDB B,I BLF,BLF RBR,SLrB JSB $SCD3 SCHEDULE IF ANY WAITING JMP $WATR,I RETURN SPC 2 * * PROGRAM SUSPEND REQUEST * $MPT2 LDA XEQT GET ADDR OF ID SEG ADA D20 LDA A,I GET FATHER POINTER CLB SSA IF BATCH FLAG IS SET JMP ESCXX ABORT SC00 LDA XEQT GET CURRENT ID ADR JSB ALDM GO PUT IN DORMANT LST & SET DM FLAG JSB $LIST OCT 506 OPERATOR SUSPEND REQUEST JMP MEM15 GO UPDATE XSUSP SPC 3 * * READ IN BACKGROUND PROGRAM SEGMENT * $MPT3 CCA CHECK PARAMETER COUNT ADA RQCNT SSA JMP ESC01 ERROR, SO RETURN LDB RQP2 ADDR OF ASCII PROG SEGMENT JSB TNAME GO FIND THE ID SEG. SZA,RSS IF NOT FOUND JMP ESC05 TAKE GAS! ADB D7 STEP TO PRIMARY ENT PT. SEZ IF SHORT ID-SEG. STEP ADB D4 TO THE SHORT ID-SEG PRI ENT PT. ADD LDA B,I FETCH AND STA $WATR SAVE FOR RETURN ADDRESS IF ALL OK. ADB D7 STEP TO TYPE ADDRESS LDA B,I BET TYPE AND D7 MASK IT SEZ,RSS IF SHORT IT MUST BE A SEG. CPA D5 SEGMENT?? CCE,RSS YES SKIP. JMP ESC03 NO TAKE GAS! LDA $WATR ALL OK, SO GET SEG ENTRY POINT STA RQRTN AND SAVE AS RETURN ADDRESS. LDB WORK GET THE ID-SEG ADDRESS STB XA,I JSB $BRED GO SET UP TO LOAD CCB SET THE ALL OF CORE ADB WSTAT BIT LDA B,I FOR THE IOR LASCI DISPATCHER STA B,I JSB PRAMO PASS PRAMETERS IF ANY JMP MEM15 ADVANCE THE RETURN ADDRESS AND EXIT SPC 3 * PRAMO PASSES PRAMETERS FORM RQP3,4,5,6,AND 7 TO * THE ID-SEGMENT POINTED TO BY WORK. * * CALLING SEQUENCE: * * SET UP WORK * JSB PRAMO * * ID-SEGMENT MUST NOT HAVE NO PRAM BITS SET IN IT'S STATUS. * PRy[AMO NOP CLB,INB IF NO PRAMS CPB RQCNT THEN JMP PRAMO,I JUST EXIT * LDA WORK SET ADDRESS IN A LDB DEFR3 PRAM ADDRESS IN B AND JSB PRAM GO MOVE THE PRAMS. JMP PRAMO,I RETURN. SKP * * $SCD3 SCHEDULES PROGRAMS IN THE WAIT LIST (STATUS-3) * WHICH ARE WAITING FOR THE GIVEN RESOURCE. * * CALLING SEQUENCE: * * LDA RESOURCE FLAG (CONTENTS OF XTEMP OF WAITER) * JSB $SCD3 * RETURN - B,E = 0 A = ? * $SCD3 NOP STA $IDNO SAVE THE RESOURCE ID FLAG LDB SUSP2 GET THE LIST HEAD SCD31 CLE,SZB,RSS IF END OF LIST JMP $SCD3,I RETURN * LDA B GET THIS ENTRIES INA FLAG FROM LDA A,I HIS ID-SEGMENT CPA $IDNO THIS ONE?? JMP SCD32 YES GO RESCHEDULE * LDB B,I NO GET NEXT ENTRY TO B JMP SCD31 AND GO TEST IT. * SCD32 LDA B,I GET THE NEXT ID IN LIST STA PRAMO AND SAVE IT JSB $LIST SCHEDULE THE PROGRAM OCT 401 WHOES ID-SGEMENT ADDRESS IS IN B LDB PRAMO GET NEXT ID TO B JMP SCD31 SCAN THE REST OF THE LIST SKP * SCHEDULE REQUEST WITH WAIT * $MPT4 JSB IDCKK CHECK IF PROGRAM DORMANT LDB XEQT GET THE ADDRESS ADB D20 OF THE BATCH FLAG XOR B,I AND SET IT AND C120K INTO THE XOR B,I THE NEW PROGRAM IOR B40K SET THE FATHER IS WAITING BIT STA $IDNO,I SET THE WORD IN THE SON'S ID. JSB $LIST PUT CURRENT PGM IN OCT 503 THE WAIT LIST LDB XEQT ADB D15 LDA B,I IOR B10K SET STATUS WAIT REQUEST BIT STA B,I INTO CURRENT EXEC PROGRAM RSS * * SCHEDULE REQUEST WITHOUT WAIT * $MPT5 JSB IDCKK CHECK IF PROGRAM DORMANT * MEM15 LDA RQRTN STA XSUSP,I POINT JMP $XEQ * ESC01 CLB,INB,RSS ILLEGAL PARAMETER COUNT ESNLHC03 LDB D3 PROGRAM CANNOT BE SCHEDULED. RSS ESC04 LDB D4 CONTROLLED PROGRAM NOT A SON. RSS ESC05 LDB D5 NO SUCH PROGRAM ERROR CODE. RSS ESC07 LDB D7 PROHIBITED CORE LOCK ATTEMPTED. RSS ESC10 LDB D10 NO MEMORY EVER FOR STRING PASAGE. ESCXX LDA ASY OUTPUT SC ERROR CODE JMP $ERAB CALL SYSTEM ERROR MESSAGE ROUTINE * B40K OCT 40000 C120K OCT 57777 SKP * * CALL TO GET SYSTEM REAL TIME * $MPT6 DLD $TIME CALL TIME SUBROUTINE JSB $TIMV JMP MEM15 GO TO STORE RETURN ADDRESS * * GETID IS A SUBROUTINE TO GET THE ID-SEGMENT ADDRESS * FROM PRAMETER NUMBER TWO WHERE THE USER MAY * SUPPLY ZERO (HIS ID) OR NOTHING (HIS ID) OR * AN ASCII NAME. * * CALLING SEQUENCE: * * JSB GETID * RETURN B= THE ID-SEGMENT ADDRESS. * IF NOT FOUND THEN ERROR "SC05"IS GENERATED * E=0 * A=0 ON ALL RETURNS * WORK = THE ID-ADDRESS * WSTAT = THE ID-STATUS ADDRESS N* GETID NOP CLA IF NOT SUPPLIED PRESET TO ZERO LDB XEQT AND CURRENT PGM ADB D12 SET B TO POINT TO CURRENT NAME LDA RQP2,I GET THE PRAMETER SZA IF ZERO OR NOT SUPPLIED SKIP LDB RQP2 GET ADDRESS OF NAME JSB TNAME GO SEARCH FOR IT CLA,SEZ IF FOUND SKIP JMP ESC05 ELSE FLUSH HIM OUT OF THE SYSTEM * JMP GETID,I RETURN SPC 2 * $IDNO COMPUTES THE ID-SEGMENT NUMBER OF A PROGRAM * * CALLING SEQUENCE * LDB ID-SEGMENT ADDRESS * JSB $IDNO * RETURN ID NUMBER IN B * $IDNO NOP STB GETID SAVE THE REQUESTED ID-ADDRESS LDB KEYWD IDNO LDA B,I GET KEYWORD BLOCK ENTRY INB STEP FOR NEXT ONE CPA GETID THIS IT? CMB,INB,RSS YES NEGATE AND SKIP JMP IDNO NO CONTINUE LOOP * ADB KEYWD NEGATIVE OF NUMBER TO B CMB,INB SET POSITIVE AND JMP $IDNO,I RETURN SKP * * CALL TO SET ID SEGMENT TIME VALUES * $MPT7 LDA DM7 CHECK PARAM COUNT FOR 7. ADA RQCNT SZA,RSS JMP MPT7A 7 IS OK. ADA D3 CHECK PARAM COUNT FOR 4. SZA JMP ESC01 ERROR IN PARAMETER COUNT LDA RQP5,I 4 IS OK, SO CHECK IF INITIAL SSA,RSS OFFSET IS NEGATIVE. IF POSITIVE, JMP ESC02 THEN ERROR CONDITION. * MPT7A LDA RQP3,I IF RESOLUTION CODE LDB D6 SZA ZERO OR ADA DM5 GREATER THAN 4 SSA,RSS THEN JMP ESCXX ABORT * JSB GETID GO GET THE ID-SEGMENT ADDRESS TO B LDA RQRTN PUT RETURN STA XSUSP,I ADDRESS IN THE ID SEG. JMP $TIMR GO CONTINUE REQUEST IN TIME ROUTINE SPC 1 * CHECK IF PROGRAM DORMANT AND THEN SCHEDULE IDCKK NOP LDB RQP2 GET ID SEGMENT ADDRESS JSB TNAME SEZ JMP ESC05 NO SUCH PROGRAM ERROR ADB D14 MAKE SUR*E IT IS NOT LDA B,I A SEGMENT AND D7 CPA D5 IF SEGMENT JMP ESC03 TAKE GAS! * LDB XEQT COMPUTE THE ID NUMBER JSB $IDNO AND STB GETID SAVE IT LDA WORK ALSO COMPUTE THE ADA D20 FATHER POINTER WORD ADDRESS STA $IDNO AND SAVE IT LDA WSTAT,I CHECK PROGRAM STATUS FOR DORMANT AND S&NP KEEP JUST THE IMPORTANT BITS STA XA,I RETURN PROG STATUS IN A REG SZA DORMANT? JMP IDCK2 NO - CHECK FURTHER * LDB RQP9,I (A MUST=0)CHECK IF THE OPTIONAL SZB,RSS PARAMETER STRING IS INCLUDED. JMP IDCK4 IF NOT,SKIP STRING STORAGE. JSB $CVWD CONVERT BUFFER LENGTH TO STB BFCNT POSITIVE CHARS AND SAVE. LDA RQP8 SET UP BUFFER ADDRESS. STA BFADD CLE LDB WORK GET ID-SEGMENT ADDRESS JSB ALCST AND STORE PARM.STRING. JMP ESC10 ABORT PROGRAM(SC10)IF NO MEM EVER. JMP NMNOW SUSPEND FATHER IF NO MEM NOW. * IDCK4 JSB PRAMO PASS THE PARAMETERS,IF ANY,TO IDCK5 JSB $LIST THE ID-SEG.AND THEN SCHEDULE. OCT 301 STA XA,I SHOW THAT IT WAS DONE LDA WORK SET UP THE WAIT POINTER STA XTEMP,I INCASE IT IS A 9 REQUEST LDA $IDNO,I GET THE CURRENT FLAG BITS AND C377 MASK OUT ANY OLD FATHER NUMBER. IOR GETID ADD THE FATHER NUMBER STA $IDNO,I AND RESET IT. JMP IDCKK,I RETURN SPC 1 IDCK2 RAL,ALR IF JUST THE NO PRAMS CMA,CLE,INA SET E LDA $IDNO,I CHECK TO SEE AND B377 IF THIS GUY IS THE FATHER CPA B IF NOT RSS THEN JMP MPT15 GO TEST FOR QUEING * SEZ IF JUST "NP" BIT THEN JMP IDCK5 GO SCHEDULE HIM * LDA WSTAT,I IF "R" AND "D" BITS BOTH SET AND B300 THEN JUST CPA B300 CLEAR THEM ELSE  CLB,RSS JMP MPT15 GO CHECK FOR QUEUEING * XOR WSTAT,I CLEAR THE "R" AND "D" BITS STA WSTAT,I AND RESET IN SON'S ID STB XA,I INDICATE SUCESS. JMP MEM15 AND EXIT. * DM7 DEC -7 DM8 DEC -8 C377 OCT 177400 SKP * *SCHEDULE WITH WAIT WITH WAIT REQUEST * * IF REQUESTED PROGRAM IS NOT DORMANT THE REQUESTER IS * SUSPENDED UNTIL IT IS. * MPT15 LDA RQP1 HERE AFTER FINDING REQUESTED PGM BUSY CPA D9 IF NO WAIT RSS THEN JUST DO CPA D10 THE OLD JMP MEM15 THING * LDB WORK ELSE SET THE SUSPEND REASON STB XTEMP,I IN REQUESTERS ID-SEGMENT LDA $IDNO,I TO INDICATE IOR B1000 WE WERE HERE STA $IDNO,I JSB $LIST PUT REQUESTER IN WAIT LIST OCT 503 JMP $XEQ GO TRY SOMEBODY ELSE. SPC 2 ASY ASC 1,SC ASCII -SC- FOR SCHED ERROR DEFR3 DEF RQP3,I B10K OCT 10000 S&NP OCT 20017 STATUS PLUS NO PRAMS BIT MASK B300 OCT 300 SKP * * $MPT8 SET/CLEAR ALL OF MEMORY AND CORE LOCK FLAGS * * EXEC 22 REQUEST WITH ONE PRAMETER * PRAMETER MEANING * 0 CLEAR CORE LOCK * 1 SET CORE LOCK * 2 CLEAR ALL OF MEMORY FLAG * 3 SET ALL OF MEMORY FLAG. * $MPT8 LDB XEQT GET THE ADDRESS ADB D14 OF THE BITS IN THE ID-SEGMENT STB $LIST SAVE ADDRESS LDA B,I GET CURRENT STATUS LDB RQP2,I GET THE REQUEST WORD CMB,INB,SZB,RSS IF ZERO JMP CLCL CLEAR THE CORE LOCK * INB,SZB,RSS IF ONE JMP STCL SET THE CORE LOCK * INB,SZB,RSS IF TWO JMP CLAM CLEAR ALL OF MEMORY FLAG * INB,SZB IF NOT THREE THEN JMP ESC02 GO ABORT HIM. * B40 CLE MUST BE SET ALL OF MEMORY REQUEST CLAM LDB B40 GET THE ALL MEMORY BIT TO B JMP MPT81 < GO SET CLEAR THE BIT * STCL LDB SWAP CHECK IF LEGAL REQUEST RBR,RBR GET LEGAL FLAG SLA TO LEAST B RBR,CLE CLE,SLB,RSS IF ILLEGAL JMP ESC07 GO DO HIM IN * CLCL LDB B100 GET THE CORE LOCK FLAG TO B MPT81 IOR B SET THE FLAG SEZ AND IF A CLEAR REQUEST XOR B CLEAR THE FLAG STA $LIST,I RESET THE WORD JMP MEM15 GO EXIT. SKP * * EXEC CALL FOR PARTITION STATUS * * CALLING SEQUENCE : JSB EXEC * DEF *+6 RETURN * DEF D25 CODE=25 * DEF PART# PARTITION NUMBER * DEF PAGE# RETURNED STARTING PAGE # * DEF #PGS RETURNED NUMBER OF PAGES * DEF PSTA RETURNED PARTITION STATUS * BIT15 = BG/RT 0/1 * BIT14 = FREE FOR ALL/RESERVED 0/1 * BIT 0-7 OCCUPANT ID SEG NUMB * * #PGS = -1 ON RETURN IF PARTITION NUMBER IS ERRONEOUS * $PTST LDA DM4 CHECK IF ATLEAST 4 ADA RQCNT PARAMETERS ARE PRESENT. SSA JMP ESC01 ERROR, TOO FEW PARAMETERS. * CLA CLEAR OUT USER'S RETURN WORDS STA RQP3,I STA RQP4,I STA RQP5,I LDA RQP2,I (A) = PTTN# CMA,INA SSA,RSS JMP PT.ER ERROR IF <= 0 * CCB ADB $MATA SET # PARTITION ADA B,I FROM $MATA-1 SSA PARTITION# > COUNT? JMP PT.ER YES,ERROR * CCA ADA RQP2,I MPY D6 (PART#-1)*6 IS ADA $MATA THE ADDR OF THE ENTRY ADA D2 STA RQP6 SAVE ADDR OF ENTRY'S LDB A,I THIRD WORD SZB JSB $IDNO STB RQP7 SAVE ID SEG ADDR IN TEMP * ISZ RQP6 BUMP ADDR IN ENTRY LDA RQP6,I R GET FOURTH WORD AND B1777 START PAGE IN BITS 0-9 STA RQP3,I RETURN PARTITION START PAGE * ISZ RQP6 BUMP ADDR IN ENTRY LDA RQP6,I GET FIFTH WORD CLE,ELA PUT RESERVED FLAG IN (E) RAR AND B1777 #PAGES IN BITS 0-9 STA RQP4,I RETURN #PAGES LDA RQP7 FETCH ID SEG ADDR RAL,RAL ERA PUT INTO BIT14 WITH ID SEG ADDR ISZ RQP6 BUMP ADDR LDB RQP6,I GET LAST WORD CLE,ELB PUT RT FLAG IN (E) ERA PUT INTO BIT15 WITH ID SEG STA RQP5,I RETURN ID SEG ADDR,ETC * PT.RT LDA RQRTN STA XSUSP,I SET RETURN ADDRESS JMP $XEQ RETURN TO PROGRAM * PT.ER CCA STA RQP4,I RETURN -1 FOR ERROR JMP PT.RT SKP * ********************************************************************** * * EXEC 14--GET/PUT A COMMAND STRING. * * FOUR PARAMETERS USED: * . * . * . * JSB EXEC * DEF RTN * DEF ICODE * DEF GPCOD * DEF IBUFR * DEF IBUFL * RTN . * . * . * ICODE DEC 14 * GPCOD DEC 1 OR 2 1 = GET(RETRIEVE)PARAMETER STRING * 2 = PUT(WRITE)PARAMETER STRING TO FATHER * IBUFR BSS N BUFFER OF N WORDS * IBUFL DEC N(OR -2N) BUFFER LENGTH WORDS(+) OR CHARACTERS(-) * ****************************************************************** * $MPT9 LDA RQCNT CHECK TO SEE ADA DM3 IF THERE ARE SSA FOUR PARAMETERS. JMP ESC01 SORRY BUDDY, YOU BLEW IT! LDA RQP3 SAVE ADDRESS STA BFADD OF BUFFER. LDB RQP4,I GET BUFFER LENGTH, SAVE STB $IDNO FOR TRANS.LOG CHECK, JSB $CVWD CONVERT TO POSITIVE STB BFCNT CHAR COUNT AND SAVE. LDA RQP2,I GET TYPE OF REQUEST. ADA DM2 SZA,RSS  JMP MPT9W 2=WRITE. INA,SZA 1=READ. JMP ESC02 ILLEGAL REQUEST. * MPT9R RSA SAVE MEU RAL,RAL STATUS. SJP *+2 FORCE SYSTEM MAP. STA PRAMO LDB XEQT READ A STRING BLOCK FOR AN ID-SEG. JSB $STSH TO THE BUFFER(E=1,EXTRA WORD). SZA,RSS GET THE STRING BLOCK ADDRESS JMP NOSTR FOR THIS PROG. IF NO STRING, ADA D2 THEN SET A=1, CLEAR B, AND RETURN. LDB A,I GET ACTUAL SIZE OF STORED CMB,CLE,INB STRING AND COMPARE TO ADB BFCNT TO THE REQUESTED LDB A STRING SIZE. SEZ,INA,RSS SET A REG. TO SOURCE ADDRESS. LDB BFCTA USE WHICHEVER SIZE IS LDB B,I SMALLER AND CONVERT STB BFCNT INB TO WORDS AND USE BRS AS MOVE WORDS STB XB,I COUNT. LDB BFADD SET B REG. TO DESTINATION ADD. LDX XB,I MWI GO MOVE WORDS. LDB XEQT WHEN COMPLETE, RETURN THE JSB $RTST STRING BLOCK TO MEMORY. LDB XB,I GET MOVE WORDS COUNT. LDA $IDNO IF ORIGINAL REQUEST WAS SSA FOR CHARS, THEN DOUBLE LDB BFCNT WORD COUNT FOR TRANS.LOG. JRS PRAMO MPT91 GO SETUP REGS. AND RETURN. * MPT9W LDA XEQT WRITE A STRING BLOCK TO THE FATHER. ADA D20 GET CURRENT PROGRAM LDA A,I AND DETERMINE IF THERE AND B377 IS A FATHER. SZA,RSS JMP NOPAW ERROR, NO FATHER. CCB,CCE GET ID(SET E=1 FOR ALCST) ADB KEYWD SEGMENT ADB A ADDRESS OF LDB B,I FATHER. JSB ALCST DEALLOCATE AND THEN ALLOC.BLOCK FOR PAW. JMP ESC10 IF SUCCESS ALLOC.,THEN SET A=0.IF NO JMP NMNOW MEM EVER,ABORT SON(SC10).IF NO MEM MPT91 CLA NOW, SUSPEND THE SON. * MPT95 STB XB,I SET UP B REGISTER. STA XA,I SEwT UP A REGISTER. JMP MEM15 RETURN. * NMNOW JSB $LIST NOT ENOUGH MEMORY NOW SO OCT 504 LINK PROGRAM INTO MEMORY JMP $XEQ SUSPENSION LIST. * NOSTR JRS PRAMO NOPAW NOPAW INA IF NO STRING ON 'GET' OR CLB NO FATHER ON 'PUT', THEN JMP MPT95 SET A=1 OR B=0. * DM2 DEC -2 SKP ************************************************************** * * SUBROUTINE TO STORE A STRING IN SYSTEM AVAILABLE MEMORY. * ALCST DEALLOCATES ANY STRING MEMORY, ALLOCATES A BLOCK OF * MEMORY, TRANSFERS THE STRING INTO THE BLOCK, AND LINKS THE * BLOCK INTO THE HEAD OF THE STACK LOCATED AT $STRG. THE LINKED * BLOCKS LOOK AS FOLLOWS: * * * *********** ********************* * $STRG * ---------* 0 OR LINK-------------- * *********** *-------------------* * EXTRA WORD BIT------* ID SEG ADDRESS * * *-------------------* * * # CHARS IN STRING * * *-------------------* * * CHAR 1 CHAR 2 * * *-------------------* * * * * *-------------------* * * CHAR M * * ********************* * * EXTRA WORD * * *-------------------* * * * WORD 1 = LINK TO NEXT BLOCK OR 0 FOR LAST BLOCK * WORD 2 = BITS 0-14 = ID-SEGMENT ADDRESS * BIT 15 = EXTRA WORD IN BLOCK BIT(SEE $ALC) * WORD 3 = ACTUAL NUMBER OF CHARS (M) IN STRING * * CALLING SEQUENCE: * BFADD:= BUFFER ADDRESS * BFCNT:= POSITIVE BUFFER WORD COUNT * CLE/CCE (SEE BELOW) * LDB ID-SEGMENT ADDRESS * JSB ALCST * * RETURN: * (P+1) =-1, =MEANINGLESS UNSUCCESSFUL,NO MEM EVER * (P+2) =0 , =MEANINGLESS UNSUCCESSFUL,NO MEM NOW * +? (P+3) =+ , =MEANINGLESS SUCCESSFUL ALLOCATION EVER * * AND ARE MODIFIED * TEMP1, TEMP4 AND TEMP6 ARE USED. * CALLS $RTST WHICH USES TEMP2, TEMP3 AND TEMP5. * * ON ENTRY, IF E REG=0, THE BASE PAGE WORD XTEMP(1721B)IS * SET TO THE ID SEGMENT WORD 2 ADDRESS INDICATED BY THE B REG * AND THEN RESTORED ON EXIT. IF THE E REG = 1, THEN XTEMP IS * NOT MODIFIED. SINCE ON "NOT ENOUGH MEMORY", $ALC WILL STORE * THE AMOUNT OF MEMORY REQUIRED IN 'XTEMP,I', THIS WILL RESULT: * 1)E=0,SAVE MEMORY SIZE IN XTEMP OF B REG PROGRAM, OR * 2)E=1,SAVE MEMORY SIZE IN XTEMP OF CURRENT PROGRAM(USED * ONLY IN EXEC 14 CALL FROM SON TO FATHER). * *************************************************************** * ALCST NOP RSA SAVE MEU RAL,RAL STATUS. SJP *+2 FORCE SYSTEM MAP. STA TEMP6 STB TEMP1 SAVE ID ADDRESS. LDA XTEMP SAVE CURRENT PROGRAM'S ID STA TEMP4 WORD 4. SEZ,INB,RSS IF E=0,THEN SETUP OUR PROGRAM'S STB XTEMP ID WORD 2 FOR USE BY $ALC. LDB TEMP1 GET ID ADDRESS AND JSB $RTST RETURN ANY STRING MEMORY. LDA BFCNT GET CHAR COUNT. INA CHANGE TO ARS WORD COUNT STA RTSTW AND SAVE. ADA D3 INCREMENT WORD COUNT BY STA WORDS 3 FOR LINKAGE WORDS AND JSB $ALC GO GET MEMORY. WORDS NOP JMP ALST9 NO MEMORY EVER RETURN. JMP ALST8 NO MEMORY NOW RETURN. CCE OK RETURN. SET E REG TO CPB WORDS 1 IF AN EXTRA WORD WAS CLE RETURNED. LDB $STRG LINK THE BLOCK INTO STB A,I THE HEAD OF THE STA $STRG STACK HEADED AT $STRG. LDB TEMP1 GET ID-SEG ADDRESS, ADD IN RBL,ERB EXTRA BLOCK WORD BIT, INA AND ST<ORE IN SECOND STB A,I BLOCK WORD. LDB BFCNT STORE BUFFER CHAR INA COUNT IN THIRD STB A,I WORD OF BLOCK. INA LDB A GET ADD.OF DESTINATION BUFFER. LDA BFADD GET ADDRESS OF SOURCE BUFFER. LDX RTSTW MWF GO MOVE WORDS FROM USER MAP. ISZ ALCST SUCCESSFUL RETURN. ALST8 ISZ ALCST NO MEMORY NOW RETURN. ALST9 LDB TEMP4 RESTORE CURRENT PROGRAM'S STB XTEMP ID WORD 2 ADDRESS. JRS TEMP6 ALCST,I NO MEMORY EVER RETURN--A=STATUS. * STRGA DEF $STRG $STRG OCT 0 HEAD OF STRING STORAGE STACK. BFCTA DEF BFCNT BFCNT BSS 1 BFADD BSS 1 SKP ************************************************************** * * SUBROUTINE TO RETURN SYSTEM AVAILABLE MEMORY ALLOCATED * FOR A STRING. GIVEN A PROGRAM'S ID-SEGMENT ADDRESS, $RTST * LOCATES THE STRING IN THE BLOCK HEADED AT $STRG, UNLINKS * IT AND RETURNS IT TO SAVMEM. * * CALLING SEQUENCE: * LDB ID-SEGMENT ADDRESS * JSB $RTST * * RETURN: * NO REGISTERS ARE SAVED. * USES TEMP2 AND TEMP5 FOR TEMPOARAY STROAGE. * CALLS $STSH WHICH USES TEMP3. * ************************************************************** * $RTST NOP RSA RAL,RAL SAVE MEU STATUS. SJP *+2 FORCE SYSTEM MAP. STA TEMP5 STB TEMP2 SAVE ID-SEGMENT ADDRESS. RTST1 JSB $STSH GET STRING BLOCK ADD.(E=1,EXTRA WD). SZA,RSS CHECK IF STRING JMP RTST9 BLOCK FOUND. STA RTSTA STORE STARTING BLOCK ADDRESS. LDA A,I UNLINK BLOCK STA B,I FROM STACK. LDA RTSTA ADA D2 GET SIZE OF LDB A,I BLOCK, CONVERT INB TO WORDS BRS AND ADB D3 ADD 3. SEZ IF EXTRA WORD BIT SET, INB ADD 1 TO SIZE. STB RTSTW STORE CTOTAL SIZE OF BLOCK. JSB $RTN RETURN MEMORY BLOCK. RTSTA NOP RTSTW NOP LDB TEMP2 GET ID SEGMENT ADDRESS. JMP RTST1 CHECK FOR ANY MORE BLOCKS. * RTST9 JRS TEMP5 $RTST,I RETURN. SKP ********************************************************************** * * SUBROUTINE $STSH CHASES DOWN A STRING BLOCK IN THE STACK * HEADED AT $STRG GIVEN THE ID-SEGMENT ADDRESS. ASSUMES ENTRY * IN THE SYSTEM MAP. * * CALLING SEQUENCE: * LDB ID-SEGMENT ADDRESS * JSB $STSH * * RETURN: * =0 = COULD NOT FIND NAMED BLOCK * =+ = ADDRESS OF BLOCK, E=1 = EXTRA WORD IN BLOCK * B= ADDRESS OF PREVIOUS BLOCK * USES TEMPORARY LOCATION TEMP3. * ********************************************************************** * $STSH NOP STB TEMP3 SAVE ID-SEGMENT ADDRESS LDB STRGA GET POINTER TO HEAD OF STACK. STSH1 LDA B,I GET BLOCK ADDRESS AND CLE,SZA,RSS IF ZERO, THEN END JMP STSH9 OF STACK. INA OTHERWIZE,INCREMENT IT,AND GET LDA A,I GET ID-SEGMENT ADDRESS. ELA,RAR SAVE EXTRA WORD BIT IN E REG. CPA TEMP3 IF THIS IS CORRECT JMP STSH2 BLOCK, THEN RETURN. LDB B,I OTHERWIZE, GO CHECK JMP STSH1 NEXT BLOCK. * STSH2 LDA B,I SET A=BLOCK ADDRESS AND STSH9 JMP $STSH,I RETURN. * ********************************************************************** * * $CVWD CONVERTS NEGATIVE CHARACTER COUNT OR POSITIVE WORD COUNT * TO POSITIVE CHARACTER COUNT. * * CALLING SEQUENCE: * LDB COUNT(+ = WORDS, - = CHARACTERS) * JSB $CVWD * * RETURN: * B = +CHARACTERS * ********************************************************************** * $CVWD NOP SSB CONVERT NEGATIVE CMB,INB,RSS CHARACTERS AND BLS POSITIVE WORDS TO  JMP $CVWD,I POSITIVE CHARACTERS. HED ** SYSTEM BASE PAGE COMMUNICATION AREA ** * * *** SYSTEM BASE PAGE COMMUNICATION AREA *** * XI EQU 1647B . EQU 1650B ESTABLISH ORIGIN OF AREA * * SYSTEM TABLE DEFINITION * * EQTA EQU .+0 FWA OF EQUIPMENT TABLE EQT# EQU .+1 # OF EQT ENTRIES * DRT EQU .+2 FWA OF DEVICE REFERENCE TABLE LUMAX EQU .+3 # OF LOGICAL UNITS (IN DRT) * INTBA EQU .+4 FWA OF INTERRUPT TABLE INTLG EQU .+5 # OF INTERRUPT TABLE ENTRIES * TAT EQU .+6 FWA OF TRACK ASSIGNMENT TABLE * KEYWD EQU .+7 FWA OF KEYWORD BLOCK * * I/O MODULE/DRIVER COMMUNICATION * EQT1 EQU .+8 ADDRESSES EQT2 EQU .+9 EQT3 EQU .+10 OF EQT4 EQU .+11 EQT5 EQU .+12 CURRENT EQT6 EQU .+13 EQT7 EQU .+14 15-WORD EQT8 EQU .+15 EQT9 EQU .+16 EQT EQT10 EQU .+17 EQT11 EQU .+18 ENTRY EQT12 EQU .+81 EQT13 EQU .+82 EQT14 EQU .+83 EQT15 EQU .+84 * CHAN EQU .+19 CURRENT DMA CHANNEL # TBG EQU .+20 I/O ADDRESS OF TIME-BASE CARD SYSTY EQU .+21 EQT ENTRY ADDRESS OF SYSTEM TTY * * SYSTEM REQUEST PROCESSOR /'EXEC' COMMUNICATION * * RQCNT EQU .+22 # OF REQUEST PARAMETERS -1 RQRTN EQU .+23 RETURN POINT ADDRESS RQP1 EQU .+24 ADDRESSES RQP2 EQU .+25 RQP3 EQU .+26 OF REQUEST RQP4 EQU .+27 RQP5 EQU .+28 PARAMETERS RQP6 EQU .+29 RQP7 EQU .+30 (SET FOR MAXIMUM OF RQP8 EQU .+31 9 PARAMETERS) RQP9 EQU .+32 * * DEFINITION OF SYSTEM LISTS (QUEUES) * * DORMT EQU .+32 ADDRESS OF 'DORMANT' LIST, SKEDD EQU .+33 'SCHEDULE' LIST, SUSP2 EQU .+35 'WAIT' LIST, SUSP3 EQU .+36 'AVAILABLE MEMORY' LIST, SUSP4 EQU .+37 'DISC ALLOCATION' LIST, SUSP5 EQU .+38 'OPERATOR SUSPEND' LIST * * DEFINITION OF EXECUTING PROGRAM ID SEGMENT' * * XEQT EQU .+39 ID SEGMENT ADDR. OF CURRENT PROG. XLINK EQU .+40 'LINKAGE' XTEMP EQU .+41 'TEMPORARY (5-WORHDS) XPRIO EQU .+46 'PRIORITY' WORD XPENT EQU .+47 'PRIMARY ENTRY POINT' XSUSP EQU .+48 'POINT OF SUSPENSION' XA EQU .+49 'A REGISTER' AT SUSPENSION XB EQU .+50 'B REGISTER' XEO EQU .+51 'E AND OVERFLOW * * SYSTEM MODULE COMMUNICATION FLAGS * * OPATN EQU .+52 OPERATOR/KEYBOARD ATTENTION FLAG OPFLG EQU .+53 OPERATOR COMMUNICATION FLAG SWAP EQU .+54 RT DISC RESIDENT SWAPPING FLAG DUMMY EQU .+55 I/O ADDRESS OF DUMMY INT. CARD IDSDA EQU .+56 DISC ADDR. OF FIRST ID SEGMENT IDSDP EQU .+57 -POSITION WITHIN SECTOR * * DEFINITION OF MEMORY ALLOCATION BASES * * BPA1 EQU .+58 FWA R/T DISC RES. BP LINK AREA BPA2 EQU .+59 LWA R/T DISC RES. BP LINK AREA BPA3 EQU .+60 FWA BKG DISC RES. BP LINK AREA LBORG EQU .+61 FWA OF RESIDENT LIBRARY AREA RTORG EQU .+62 FWA OF REAL-TIME AREA RTCOM EQU .+63 LENGTH OF REAL TIME COMMON AREA RTDRA EQU .+64 FWA OF R/T DISC RESIDENT AREA AVMEM EQU .+65 FWA OF SYSTEM AVAILABLE MEMORY BKORG EQU .+66 FWA OF BACKGROUND AREA BKCOM EQU .+67 LENGTH OF BACKGROUND COMMON AREA BKDRA EQU .+68 FWA OF BKG DISC RESIDENT AREA * * UTILITY PARAMETERS * TATLG EQU .+69 LENGTH OF TRACK ASSIGNMENT TABLE TATSD EQU .+70 # OF TRACKS ON SYSTEM DISC SECT2 EQU .+71 # SECTORS/TRACK ON LU 2 (SYSTEM) SECT3 EQU .+72 # SECTORS/TRACK ON LU 3 (AUX.) * DSCLB EQU .+73 DISC ADDR OF RES LIB ENTRY PTS DSCLN EQU .+74 # OF RES LIB ENTRY POINTS DSCUT EQU .+75 DISC ADDR OF RELOC UTILITY PROGS DSCUN EQU .+76 # OF RELOC UTILITY PROGS LGOTK EQU .+77 LOAD-N-GO: LU,STG TRACK,# OF TRKS LGOC EQU .+78 CURRENT LGO TRACK/SECTOR ADDRESS SFCUN EQU .+79 SOURCE FILE LU AND DISC ADDRESS MPTFL EQU .+80 MEMORY PROTECT ON/OFF FLAG (0/1) FENCE EQU .+85 MEM PROTECT FENCE ADDRESS * BKLWA EQU .+87 LWA OF MEMORY IN BACKGROUND * * FREG1 EQU LBORG FREG2 EQU RTORG FREG3 EQU BKORG FLG EQU OPFLnNLHG * A EQU 0B LOCATION OF A REGISTER B EQU 1B LOCATION OF B REGISTER ORG * PROGRAM LENGTH END $LIST N Id 92060-18022 1639 S 0422 ASMB SRC              H0104 xASMB,R,B,L,Z,C RTE ASSEMBLER SEPT 1976 * * NAME: ASMB * SOURCE: 92060-18022 * RELOC: 92060-16022 * PGMR: C.C.H * MODIFIED BY EARL STUTES 1976-09-20-1600 * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1975. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** IFN HED * DOS ASMB XXXXX-XXXXX * (C) HEWLETT-PACKARD COMPANY 1975. XIF IFZ HED * RTE ASMB 92060-18022 * (C) HEWLETT-PACKARD COMPANY 1975. XIF NAM ASMB,3,99 92060-16022 REV.B 760924 * ******************************* * * NOTE: ON CONTROL STATEMENT; * * * N = DISK O.S. USAGE * * * Z = REAL TIME USAGE * * ******************************* * ********************************************* * * ASSEMBLER CONTROL STATEMENT OPTIONS * * * * * * A = ABSOLUTE ASSEMBLY * * * B = PUNCH BINARY OBJECT TAPE * * * C = SCHEDULE 'XREF' FOR XREF TABLE * * * F = FLOATING POINT HDWE. INSTRUCTIONS * * * L = LIST OUTPUT * * * N = ASSEMBLE STATEMENTS WITHIN 'IFN' * * * R = RELOCATABLE ASSEMBLY * * * T = LIST SYMBOL TABLE (END OF PASS 1) * * * X = NON-EAU INSTRUCTIONS * * * Z = ASSEMBLE STATEMENTS WITHIN 'IFZ' * * ********************************************* * ENT ASMB EXT ?HA3Z,?LITI,?AREC,?BREC,?ART,?LKLI EXT ?CMQ,?ENP,?EXP,?INSR,?INS?,EXEC ENT ?ASCN,?ASMB,?BNCN,?BPKU,?CHOP,?CHPI,?DCOD ENT ?ENDS,?ERPR,?MSYS,?GETC,?MOVE,?MSYM,?RLUN ENT ?AFLG,?LSTL,?LUNI,?RFLG,?Z,?ASM1,?LABE ENT ?OKOL,?ORRP,?PNLE,?SETM,?SUP,?LPER,?PERL ENT ?LOUT,?LTFL,?DRFL,?LTSA,?LTSB,?ORGS,?CNTR ENT ?TSTR,?ASII,?ICSA,?FLGS,?BFLG,?LFLG,?TFLG ENT ?X,?MESX,?ASCI,?LINC,?LINS,?LIST,?LUNP ENT ?OPLK,?OPER,?PKUP,?PLIT,?PNCH,?PRNT,?RSTA ENT ?LWA,?RDSC,?WEOF,?WRIF,?LGFL ENT ?SEGM,?SYMK,?V,?ARTL,?LST,?PLIN,?PCOM,?SECT ENT ?NEAU,?HA38,?XRFI ENT ?FPT,?FP,?ENER,?PRPG ENT ?BPSV,?BASF,?GETA ENT ?NDOP,?NDSY,?SYML,?SYMT SUP SUPPRESS EXTENDED LISTING * ****************************** * * OPCODE AND PSEUDO-OP TABLE * * ****************************** OPT OCT 40502,51421,0, 40504,40416,42001 ABS/ADA OCT 40504,41016,46001, 40514,43060,31700 ADB/ALF OCT 40514,51060,31400, 40514,51460,31000 ALR/ALS OCT 40516,42016,12001, 40522,51460,31100 AND/ARS OCT 40523,41407,0, 41114,43060,25700 ASC/BLF OCT 41114,51060,25400, 41114,51460,25000 BLR/BLS OCT 41122,51460,25100, 41123,51412,0 BRS/BSS OCT 41503,40461,53400, 41503,41061,47400 CCA/CCB OCT 41503,42463,42300, 41514,40461,52400 CCE/CLA OCT 41514,41061,46400, 41514,41450,106700 CLB/CLC OCT 41514,42463,0, 41514,43052,103100 CLE/CLF OCT 41515,40461,53000, 41514,47430,103101 CMA/CLO OCT 41515,41061,47000, 41515,42463,42200 CMB/CME OCT 41517,46403 COM DEF ?CMQ OCT 41520,40416,52001, 41520,41016,56001 CPA/CPB OCT 42105,41410,0, 42105,43020,0 DEC/DEF OCT 42105,54025,0, 41131,52043,0 DEX/BYT OCT 42514,40460,131600, 42516,52004 ELA/ENT DEF ?ENP OCT 42514,41060,125600, 42516,42014,0 ELB/END OCT 42522,40460,131500, 42521,52413,0 ERA/EQU OCT 42522,41060,125500, 42530,52005 ERB/EXT DEF ?EXP OCT 44114,52051,102000,46111,40450,1 l02500 HLT/LIA OCT 46111,41050,106500,46511,40450,102400 LIB/MIA SKP * ?FPT EQU * < FLOATING POINT SUBROUTINE/MACRO OPCODES > * OCT 43101,42006 FAD DEF ?HA38 OCT 43104,53006 FDV DEF ?HA38 OCT 43115,50006 FMP DEF ?HA38 OCT 43123,41006 FSB DEF ?HA38 * OCT 44516,40466,52004, 44516,41066,46004 INA/INB OCT 44517,51016,32001, 44523,55016,36000 IOR/ISZ OCT 45115,50016,26000, 45123,41016,16000 JMP/JSB OCT 46104,40416,62001, 46104,41016,66001 LDA/LDB OCT 46511,41050,106400, 47101,46415,0 MIB/NAM OCT 47117,50030,0, 47503,52011,0 NOP/OCT OCT 47524,40450,102600, 47522,43401 OTA/ORG DEF ORGP OCT 47524,41050,106600, 47522,51002 OTB/ORR DEF ORRP OCT 51101,46060,31200, 51101,51060,31300 RAL/RAR OCT 51102,46060,25200, 51102,51060,25300 RBL/RBR OCT 51120,46032,0 RPL OCT 51123,51470,42001, 51505,55062,42040 RSS/SEZ OCT 51506,41452,102200, 51506,51452,102300 SFC/SFS OCT 51514,40465,10010, 51514,41065,4010 SLA/SLB OCT 51517,41453,102201, 51517,51453,102301 SOC/SOS OCT 51523,40464,52020, 51523,41064,46020 SSA/SSB OCT 51524,40416,72000, 51524,41016,76000 STA/STB OCT 51524,41450,102700, 51524,43052,102100 STC/STF OCT 51524,47430,102101, 51532,40467,52002 STO/SZA OCT 51532,41067,46002, 54117,51016,22001 SZB/XOR OCT 47522,41000 ORB DEF ORBP OCT 46123,52024,0, 51513,50022,0 LST/SKP OCT 51525,50040,1, 44105,42017 SUP/HED DEF HEDSB OCT 52516,46024,1, 51105,50035 UNL/REP DEF REPSB OCT 52516,51440,0, 44506,47031,116 UNS/IFN OCT 54111,43031,0, 44506,55031,132 XIF/IFZ OCT 51520,41423,0, 46511,41500,0 SPC/MIC * SKP * * * * 21MX INSTRUCTION SET * * * * OCT 41501,54030,101741, 41501,54430,101751 CAX/CAY OCT 41502,54030,105741, 41502,54430,105751 CBX/CBY OCT 54101,54030,101747, 54101,54430,101757 XAX/XAY OCT 54102,54030,105747, 54102,54430,105757 XBX/XBY OCT 44523,54030,105760, 44523,54430,105770 ISX/ISY OCT 42123,54030,105761, 42123,54430,105771 DSX/DSY OCT 46104,54110,105745, 46104,54510,105755 LDX/LDY OCT 45114,54511,105762, 45120,54513,105772 JLY/JPY OCT 46101,54111,101742, 46101,54511,101752 LAX/LAY OCT 46102,54111,105742, 46102,54511,105752 LBX/LBY OCT 51501,54111,101740, 51501,54511,101750 SAX/SAY OCT 51502,54111,105740, 51502,54511,105750 SBX/SBY OCT 51524,54111,105743, 51524,54511,105753 STX/STY OCT 40504,54110,105746, 40504,54510,105756 ADX/ADY OCT 41530,40430,101744, 41530,41030,105744 CXA/CXB OCT 41531,40430,101754, 41531,41030,105754 CYA/CYB OCT 46102,52030,105763, 51502,52030,105764 LBT/SBT OCT 51506,41030,105767, 52102,51515,105775 SFB/TBS OCT 51502,51515,105773, 41502,51515,105774 SBS/CBS OCT 41502,52114,105766, 46502,52114,105765 CBT/MBT OCT 46526,53514,105777, 41515,53514,105776 MVW/CMW OCT 42102,46041,0, 42102,51042,1 DBL/DBR * * * * * 21MX - MEU INSTRUCTIONS * * * * OCT 42112,50111,105732, 42112,51511,105733 DJP/DJS OCT 45122,51515,105715 JRS OCT 46106,40430,101727, 46106,41030,105727 LFA/LFB OCT 46502,43030,105703, 46502,44430,105702 MBF/MBI OCT 46502,53430,105704, 46527,43030,105706 MBW/MWF OCT 46527,44430,105705, 46527,53430,105707 MWI/MWW OCT 50101,40430,101712, 50101,41030,105712 PAA/PAB OCT 50102,40430,101713, 50102,41030,105713 PBA/PBB OCT 51123,40430,101730, 51123,41030,105730 RSA/RSB OCT 51126,40430,101731, 51126,41030,105731 RVA/RVB OCT 51512,50111,105734, 51512,51511,105735 SJP/SJS OCT 51523,46511,105714 SSM OCT 51531,40430,101710, 51531,41030,105710 SYA/SYB OCT 52512,50111,105736, 52512,51511,105737 UJP/UJS OCT 52523,40430,101711, 52523,41030,105711 USA/USB OCT 54103,40511,101726, 54103,41111,105726 XCA/XCB OCT 54114,40511,101724, 54114,41111,105724 XLA/XLB OCT 54115,40430,101722, 54115,41030,105722 XMA/XMB OCT 54115,46430,105720, 54115,51430,105721 XMM/XMS OCT 54123,40511,101725, 54123,41111,105725 XSA/XSB * ?NEAU EQU * * START OF NON-EAU OPTABLE SWAP AREA * * OCT 42111,53026,100400, 42114,42026,104200 DIV/DLD OCT 42123,52026,104400, 46520,54426,100200 DST/MPY OCT 40523,46027,100020, 40523,51027,101020 ASL/ASR OCT 46123,46027,100040, 46123,51027,101040 LSL/LSR OCT 51122,46027,100100, 51122,51027,101100 RRL/RRR OCT 51527,50030,101100,51101,46451,105000 SWP/RAM * ?FP EQU * * OCT 0,54030,105100,43114,52030,105120 FIX/FLT OCT 0 ********* END OF OPCODE TABLE *********** SKP * ************************************* * * PUT OUT A MESSAGE TO THE OPERATOR * * ************************************* MESSX NOP STA MESS SET MESSAGE LOCN STB MESS+1 SET MESSAGE LENGTH JSB EXEC DEF *+5 DEF .1+1 OUTPUT REQ. CODE DEF .1 OUTPUT ON SYSTEM TTY DEF MADDR MESSAGE ADDRESS DEF MSGLN MESSAGE LENGTH JSB EXEC GO SET EOT ON INPUT DEVICE DEF *+3 DEF .1+2 DEF EOTIN SETS EOT STATUS ON INPUT DEVICE JMP MESSX,I EXIT SEGNM ASC 3,ASMB MADDR ASC 7, /ASMB: $END MESS ASC 2, MESSAGE EXTENSION MSGLN DEC 9 TELOP ASC 4, /ASMB: XREF ASC 3,XREF ASC 5,SCHEDULED ?XRFI NOP CROSS REFERENCE INPUT FLAG. * ******************************* * * GO TO LOAD THE NEXT SEGMENT * * ******************************* SEGMT STA SEGNM+2 SET CORRECT DIGIT (1,2,OR 3) JSB EXEC DEF *+3 DEF .8 SEGMENT REQ. C!ODE DEF SEGNM LOC'N OF 5 CHAR SEGM'T NAME SPC 1 * *********************** * * EXIT FROM ASSEMBLER * * *********************** ABORT LDA *+4 SET UP END MESSAGE FOR EOF ABORT LDB *+4 JSB MESSX GO PRINT KESSAGE JMP ASMEX GO TO COMPLETION ASC 2,XEND ASMBX LDA CFLAG SZA,RSS IS CROSS REF TABLE REQUESTED? JMP ASMEX NO LDA DRFLG SZA IS DISK OK FOR XREF USAGE? JMP ASMEX NO, GO TO PROGRAM COMPLETION. IFZ LDA ?XRFI GET XREF INPUT FLAG ( 0 OR 2 ) LDB TSTRT GET SOURCE LUN/START-TRACK CODE CMB,INB FORM CODE: XREF INPUT=WORK-TRACKS CPA .1+1 IS SOURCE FROM DISC-FILE ? RSS YES, GO TO SCHEDULE "XREF" STB ?XRFI NO. SOURCE= ASMB WORK-TRACKS. XIF LDA LINC+1 GET CURRENT PAGE NUMBER. CMA,INA NEGATE FOR SIGNAL TO 'XREF'. STA LINC+1 SAVE: 'XREF' SCHED. PARAMETER. LDA PLINE GET THE NEGATED NO. LINES/PAGE. CMA,INA MAKE THE VALUE POSITIVE. STA PLINE SAVE IT FOR 'XREF'. * JSB EXEC INFORM THE DEF *+5 OPERATOR THAT DEF .1+1 THE CROSS-REFERENCE DEF .1 GENERATOR DEF TELOP HAS BEEN DEF .12 SCHEDULED. * JSB EXEC SCHEDULE XREF GENERATOR DEF *+8 RETURN ADDRESS DEF .9 SCHEDULE WITH WAIT DEF XREF PROGRAM NAME DEF ?XRFI SOURCE INPUT POINTER DEF ZERO NO CHARACTER LIMITS DEF LINC+1 -LAST ASSEMBLER PAGE NUMBER. DEF PLINE NUMBER OF LINES PER PAGE. DEF LUNPR PRINTER LOGICAL UNIT * ASMEX EQU * * IFZ JSB EXEC GO RELEASE ALL TRACKS DEF *+3 DEF .1+4 RCODE =5 DEF ..M1 -1 = RELEASE ALL TRACKS XIF LDA BLNS BLANK-_OUT LDB BLNS MESSAGE EXTENSION, AND JSB MESSX PRINT: " /ASMB: $END " * * JSB EXEC PROGRAM COMPLETION DEF *+2 DEF .1+5 COMPLETION REQ CODE .8 DEC 8 * SKP * ********************************************* * * OPLK: OPCODE TABLE LOOKUP - WALDY HACCOU * * * CALLING SEQUENCE: L JSB OPLK,I * * * L+1 ERROR RETURN * * * L+2 NORMAL RETURN * * * OUTPUT VALUES: VALUE IN A REG. AND 'CODE'* * * INSTR.FORMAT IN B AND 'INST'* * ********************************************* DOPL DEF TEMP+5 DEF OPT LOC'N OF OPCODE TABLE OPLK NOP JSB BPKUP GET OPCODE POSN STB SCN1+1 CLA STA TEMP+6 CLEAR TEMP+6 STA MFLAG CLEAR SUPPLEMENTAL TABLE FLAG LDA 1 B REG TO A REG JSB GETA GET OPCODE ADDRESS STB *+4 LDA ...1+2 (3) LDB DOPL L(TEMP+5) JSB MOVE NOP MOVE ORIGIN HERE LDB DOPL+1 L(OPCODE TABLE) OPLGO LDA 1,I GET NEXT ENTRY INB CPA TEMP+5 CHECK 1ST 2 CHARS. JMP K J ADB ...1+1 (2) LDA 1,I SZA END OF TABLE? JMP OPLGO NO-PICK UP NEXT ENTRY LDA MFLAG YES- SZA REACHED END OF SUPPL. TABLE? JMP OPMIC YES-CHECK FOR 'MIC' LDB ?NDOP NO-SET POINTER TO TABLE STB MFLAG SET SUPPLEMENTAL TABLE FLAG CPB ?LWA ANY ENTRIES IN SUPPLEMENTAL TABLE? JMP OPMIC NO--INVALID OPCODE; CHECK 'MIC'. JMP OPLGO GO TO CHECK NEXT ENTRY OPMIC LDA CODE GET OPCODE I.D. NO. CPA B100 CODE =100B (MIC)? JMP OPLK,I YES-O.K., RETURN. * * * ERROR EXIT HERE * * LDA .OP 'OP' OPCODE ERROR JSB ERPR CLA FORCE A 'NOP' FOR STA INST INVALID OPCODE'S INSTRUCTION. JMP OPLK,I EXIT HERE ON 'OP' ERROR K LDA 1,I CHECK LAST CHAR OF OPCODE AND UMSK CPA TEMP+6 COMPARE IT JMP *+2 OPCODE FOUND ,SKIP JMP J NOT FOUND, TRY NEXT ENTRY LDA 1,I AND LMASK SET 'A' = OPCODE TYPE INB LDB 1,I STB INST = INSTRUCTION FORMAT STA CODE = VALUE OF CODE ISZ OPLK JMP OPLK,I EXIT ALPHA+2 * MFLAG NOP SUPPLEMENTAL-OPCODE-TABLE FLAG * SKP * ****************************************************** * * EVALUATE OPERAND; TEST/PROCESS 'C' OR 'I' MODIFIER * * ****************************************************** * CLER DEF RELC START OF 5 WORD CLEAR AREA CHOP NOP * * * ON ENTRY A = MODIF.PARAMETER (I,C,0=NONE,2=ASC) * * * B= MASK NECESSARY FOR I OR C MODIFIER * * STA FLAG STB FLAQ SPC 1 * * CLEAR CHOP PARAMS IN T, RELC, SIGN, SUMP & TERM.. * LDA ...1+4 (5) LDB CLER START OF CLEAR AREA JSB SETM ZERO NOP TO SET MEMORY TO ZERO STA XORD INITIALIZE XORD =0. ISZ SIGN SET SIGN = + (+1=+,-1=-) LDA SCN1+2 OPER.POSN. STA PNTR SZA,RSS JMP HD22 ERROR**NO OPERAND * * * GET THE 1ST CHARACTER * JSB GETC CPA L+3 PLUS? JMP HD32+2 YES CPA L+5 MINUS? JMP HD32 YES JMP HD32+3 NO * * * PROCESS AN ASTERISK '*' * HD26 CLA,INA SET A=1 CPA SYMP IS THE '*' ALONE? RSS YES - GOOD JMP HD22 NO - IT'S AN ERROR ADA ?BASF SET A = CURRENT RELOCATION TYPE. LDB AFLAG GET ABS. ASSMBL. FLAG SZB IS THIS AN ABS. ASSEMBLY? CLA YES, CLEAR A(WILL BE RELOC. BIT) LDB PLCN PROG LOCN CNTR TO B REG STB SAVB u SAVE PLCN VALUE-TEMPORARILY. JMP HD50A * * * CHOP LOOP PROCESSING HERE * HD30 LDA PEEK CPA L+4 TEST PEEK FOR A JMP HD36 COMMA, GO TO TEST MODIFIERS CPA BLNK JMP HD40 =BLNK CLB,INB SET 'SIGN' FOR + CPA L+3 PLUS? RSS YES * * * PROCESS SIGNS HERE * HD32 CCB SET 'SIGN' FOR - STB SIGN (HD32+1) ISZ PNTR * * * PICK UP NEXT SET OF CHARS.IN BUFFER * JSB BPKUP GET POSN OF NXT NON-BLNK CHAR.HD32+3 STA PEEK STB PASCN SAVE PNTR FOR ASCN RTN JSB MSYMS MEAS.SYMBOL, SET SYMP/SYMN ADA PNTR STA PNTR * * * TEST FOR NUMERIC OR SYMBOLIC SET * LDA PEEK FIRST CHAR OF SET TO A FOR TESTING LDB TEST STB PEEK SAVE CHAR.FOR LATER TEST CPA L+2 ASTERISK? JMP HD26 TO '*' PROC ADA .M58 -58 SSA,RSS TEST FOR SYMBOLIC TERM JMP HD50 PROCESS THE SYMBOL ADA LPDG+3 (10) SSA JMP HD50 PROCESS THE SYMBOL * * * PROCESS NUMERIC SET HERE * LDB SYMP ADB ..M1 LDA LAST IS B LAST - CPA .B CHARACTER? JMP *+2 * * SET B REG FOR ASCN ROUTINE ADB .401B LDA PASCN JSB ASCN TO AXCII CONVERSION TO BINARY JMP CHOP,I ERROR EXIT FROM ASCII CONV. JMP HD61+1 A REG CONTAINS THE VALUE * * * TEST INFORMATION FOLLOWING COMMA, IF LEGAL * * -USES FLAG AND FLAQ * * -IF C OR I, SET CORRECT BIT IN INSTRUC. USING FLAQ AS MASK * HD36 LDB FLAG SZB,RSS IS COMMA LEGAL JMP HD37 -NO- ERROR CPB ...1+1 'ASC'? JMP HD40 -YES- ISZ PNTR POINT TO CHAR.FOLLOWING COMMA JSB BPKUP SEARCH FOR NON-BLANK JSB MSYM MEASURE SYMBOL CPA ...1 1 CHAR SYMBOL? JMP *+3 YESO * * NO - ERROR HD37 JSB OPERR OPERAND ERROR JMP HD40 LDA TEST CPA BLNK BLANK TERMINATOR? JMP *+2 -YES- JMP HD37 -NO- ERROR LDA LAST CHAR TO A CPA FLAG =I/C? RSS YES, O.K. JMP HD37 ERROR: NOT 'I' OR 'C' MODIFIER! LDA INST IOR FLAQ SET I OR C BIT STA INST LDA CODE CPA L+2 STF OR CLF? (52) JMP HD37 -YES- ERROR * * * CHOP TERMINATION PROCESSOR * * HD40 CLA INITIALIZE THE STA SIGN OFFSET FLAG TO ZERO. LDA RELC A=RELOCATION CODE LDB CODE B=INSTRUCTION I.D. SZA ABSOLUTE OPERAND? JMP RELOC NO, CHECK RELOCATABLE. HD40A LDA SUMP YES, GET OPERAND VALUE. SSA NEGATIVE? CPB .12+5 YES. IS IT ABS (21B)? JMP HD42 YES-OK- CPB .32B NO. IS IT RPL (32B)? JMP HD42 YES-OK- JMP HD22 NO. *ERROR* * * * VALUE IS RELOCATABLE, TEST FOR VALIDITY * * RELOC LDA T IS RELOC. NUMBER SZA CANCELLED? JMP HD40B NO. CHECK FOR LEGAL RELOC. STA RELC YES, SET RELOCATION CODE =0. JMP HD40A GO TO CHECK FOR NEGATIVE OPERAND. HD40B CPA ...1 LEGAL RELOC? (+1) RSS -YES- SKIP JMP HD22 NO,ERROR. CPB ...1 ORG? JMP E -YES * * * CHECK: EQU,END,ORG,DEF,HED,& I/O EXT * * ADB .M11 -11 SSB CODE <13B? JMP HD22 YES, ERROR ADB ..M1+5 -6 SSB CODE > 20B ? JMP E NO. CHECK FOR EXTERNAL. ADB .M27B YES. CODE LESS THAN SSB 50B ? JMP HD22 YES. ERROR: NOT I/O! ADB ..M1+2 CODE GREATER THAN SSB,RSS 52B ? JMP HD22 YES. ERROR: NOT I/O! CLB FORCE ERROR IF NON-EXT I/O. E LDA RELC GET RELOC. CODE. CPA ...1+3 EXTERNAL ? JMP HD41 YES. CHECK VALIDITY. LDA SUMP GET VALUE OF OPERAND. SSA,RSS ERROR, IF NEGATIVE. SZB,RSS RELOC. VALID FOR THIS OPCODE? JMP HD22 NO. * 'M' ERROR * JMP HD42 VALID RELOC. GO TO FINISH. * * * TEST FOR EXT W/OFFSET; SET SIGN & OFFSET VALUE * * HD41 LDA TERM GET NUMBER OF OPERAND TERMS. CPA .1 SINGLE EXTERNAL REFERENCE ? JMP HD42 YES, NO MORE CHECKING NEEDED. ADB .1+5 (6) TEST FOR EQU. SZB,RSS EQU TO EXTERNAL, WITH OFFSET ? JMP HD22 YES, *ERROR* LDA SUMP GET COMBINED OPERAND VALUE. LDB XORD GET EXTERNAL ORDINAL NUMBER. STB SIGN SET OFFSET FLAG = EXT ORDINAL #. CMB,INB NEGATE ORDINAL VALUE. ADA B SUBTRACT EXTERNAL ORDINAL VALUE. STA SUMP SAVE OFFSET VALUE. * * * NORMAL EXIT FROM CHOP, HERE * * HD42 LDA RELC RELOCATION CODE IN (A) AND LDB SUMP SUM IN (B) ON EXIT. ISZ CHOP JMP CHOP,I EXIT ALPHA+2 * * *CHOP ERROR EXIT* * HD22 LDA .MBLN 'M' FOR M TERM ERROR JSB ERPR ERROR PRINT CLA CLEAR THE STA SIGN OFFSET FLAG. JMP CHOP,I EXIT ALPHA+1 * * * PROCESS SYMBOLIC TERM HERE * * HD50 JSB SYMK GO TO SYMBOL TABLE LOOKUP JMP HD6 ERR0R STB SAVB SAVE VALUE FOUND IN B. LDB FLEX GET FIRST WORD OF SYMBOL ENTRY. SSB IS THIS AN UNDEFINED 'ENT' ? JMP HD6 YES * ERROR * HD50A AND .1+6 TYPE MASK SZA,RSS RELOCATABLE TYPE? JMP HD61 NO, ABSOLUTE. * SKP * * * TEST FOR EXTERNAL EQU (RELC=5) * CPA ...1+4 RELOC=5? LDA ...1+3 YES, SET FOR 4 * * * TEST FOR REPLACEMENT CODE SYMBOL (RELC= SHFB6) * * LDB CODE GET OPCODE I.D. CPA .1+5 REPLACEMENT CODE SYMBOL ? CPB .32B YES, IS OPCODE RPL ? RSS YES, CONTINUE. JMP HD22 NO *ERROR* LDB RELC GET OPERAND RELOC. CODE. SZB,RSS FIRST SYMBOL ENCOUNTERED ? STA RELC YES,SET OPERAND RELOC. CODE. CPA RELC NO, TEST FOR SAME RELOC. TYPE. CPB .1+3 SAME. ANOTHER EXTERNAL ? JMP HD22 *ERROR* DIFFERENT OR 2 EXT'S. LDB SAVB GET SYMBOL'S VALUE. CPA .1+3 IF SYMBOL IS AN EXTERNAL, STB XORD SAVE THE ORDINAL NUMBER. * * *UPDATE SIGN SAVER * LDB SIGN COMPUTE ALGEBRAIC RUNNING SUM ADB T OF SYMBOLIC TERM'S SIGNS. STB T END RESULT=0/+1,ELSE 'M' ERROR. HD61 LDA SAVB VALUETO A ISZ TERM UPDATE NO OF TERMS LDB SIGN SSB IS SIGN NEGATIVE? CMA,INA -YES- COMPLEMENT ADA SUMP -UPDATE RUNNING SUM STA SUMP JMP HD30 * * * UNDEFINED SYMBOL EXIT * * HD6 LDA .UN 'UN' UNDEFINED SYMBOL JMP HD22+1 TO ERPR .M11 DEC -11 .M27B OCT -27 .401B OCT 401 .32B OCT 32 .50 DEC 50 .M58 DEC -58 XORD NOP TEMP. STORAGE: EXTERNAL ORDN'L NO. * SKP H* ******************** * * READ A STATEMENT * * ******************** RSTA NOP LDA REP SZA,RSS ARE WE REPEATING A STATE? JMP RXT NO - ISZ REP YES, ARE WE DONE? JMP RZP NO RXT LDB FBOI LDA .50 FOR 50 WORDS JSB SETM SET I/O BUFF TO BLANKS BLNS ASC 1, RXC JSB %READ GO READ A STATEMENT DEF *+5 DEF LUNIN LUN FFUB DEF BUFF DEF .M80 80 CHARACTERS INPUT JMP ABORT EOF RETURN - NOT POSSIBLE STB SCN1 SAVE ACTUAL CHARACTER COUNT CMB,INB STB PNTR SAVE NEG. CHAR COUNT * ******************************************** * * DWRIT - WRITE A STATEMENT ONTO THE DISC. * * ******************************************** LDA LUNIN GET INPUT LUN CPA .1+1 IS IT THE DISK? JMP DWDUN YES, SKIP DISK WRITE LDA DRFLG GET FLAG SZA IS DISK FULL? JMP DWDUN YES, SKIP FURTHER WRITING JSB %WRIS GO TO WRITE ON DISC DEF *+4 DEF BUFF BUFFER DEF PNTR NEG. CHAR COUNT ISZ DRFLG DISC FULL - TURN OFF DISC FLAG DWDUN LDB SCN1 SZB,RSS END OF TAPE? (B=0?) JMP TAPN YES - GO SET PARAMETERS ISZ SEQN BUMP SEQ.NO. CLB,INB 1 TO B STB PNTR SET PNTR = 1 ADB SCN1 GET TOATL LENGTH * * SET CHARS FOLLOWING STATE.TO BLANKS * BRS ADB FFUB LDA BLNS STA 1,I RXL CLA (ENTER FOR REP PROCESSOR) STA BYFLG CLR PUNCH BYTE FLAG STA SCN1+3 STA TEST STA SIGN CLR EXT W/OFFSET FLAG. ISZ ASM1 CONTROL STATE.? JMP *+6 NO.. LDA ...1+4 YES, SET LIST CODE JSB LIST CLA,INA SET A = 1 STA TAPE SET TAPE COUNT = 1, IN CASE OF ? JMP RSTA,I EXIT * *  * CHECK LABEL AREA * JSB PKUP PICK UP NEXT CHAR; BUMP PNTR CPA L+2 *? JMP HI24 -YES- * * * IS LABEL PRESENT? * CPA BLNK LABEL PRESENT ? JMP HS50 NO. GO TO PROCESS OPCODE. CLB =0: SYMTS LABEL CHECK. JSB SYMTS GO TO CHECK FOR VALID LABEL. NOP ERRORS ALREADY NOTED; CONTINUE SCANNING. JMP HS49 GO TO LABEL POST-PROCESSOR. * * SYMTS - TEST FOR VALID CHARACTERS IN A LABEL/SYMBOL * * ENTER: CHAR. IN LOW & 'TEST';=0:LABEL OR NEG. CHAR. CNT.:OPERAND. * EXIT: P+1 INVALID (SY ERROR PRINTED); P+2 VALID; & MEANINGLESS. * SYMTS NOP STB SCNT SAVE NEGATIVE CHARACTER COUNT. JSB LBL GO TO TEST FOR ILLEGAL CHARACTER, LDA TEST GET CHAR.; TEST FOR NUMERIC 1RST CHAR. ADA .M48 SUBTRACT 60B (ASCII '0'). SSA FIRST CHARACTER <60B ? JMP HS20 YES - O.K. - GO GET NEXT CHARACTER. ADA .M15 NO. SUBTRACT 17B. SSA FIRST CHARACTER >= 77B (ASCII '?') ? JMP LBLER NO--ILLEGAL FIRST CHARACTER! HS20 JSB PKUP GET NEXT CHARACTER. CPA BLNK END OF LABEL (SYMBOL TERMINATOR) ? JMP SYMEX YES, GO TO COMPLETION. JSB LBL NO. GO TO TEST VALIDITY OF THIS CHAR. JMP HS20 GO TO GET THE NEXT CHARACTER. * SYMEX LDA SERR GET INVALID CHARACTER FLAG. SZA,RSS ANY INVALID CHARACTERS ? ISZ SYMTS NO. SET RETURN TO P+2. CLA CLEAR INVALID CHARACTER FLAG. STA SERR FOR NEXT USER. JMP SYMTS,I RETURN: P+1-ERROR; P+2-VALID SYMBOL. * * * TEST FOR ILLEGAL CHAR. IN SYMBOL * * * THEY ARE ' ( ) * + , - * * LBL NOP ADA .M46 SUBTRACT 56B (ASCII '.') SSA,RSS GREATER THAN 55B ? JMP LBLEX YES-O.K. ADA .1+6 NO. ADD BACK 7B. SSA ` LESS THAN 47B (ASCII ' ) ? JMP LBLEX YES-O.K. LBLER LDA SERR GET ERROR FLAG. SZA ANY PREVIOUS ERRORS, THIS SYMBOL ? JMP LBLEX YES, AVOID ADDITIONAL ERROR MESSAGES. LDA .SY NO. GET 'SY' - ILLEGAL SYMBOL INDICATOR. JSB ERPR GO TO PRINT THE ERROR MESSAGE. ISZ SERR SET ILLEGAL CHARACTER FLAG. LBLEX ISZ SCNT DECREMENT COUNT. ALL CHARACTERS CHECKED? JMP LBL,I NO. GO BACK FOR MORE. JMP SYMEX YES, GO TO COMPLETION. * SCNT NOP NEGATIVE CHARACTER COUNT FOR 'SYMTS'. SERR NOP ILLEGAL CHAR. FLAG (0=OK;1=INVALID CHAR.) * * * 'REP' PROCESSING * RZP ISZ REQ 1ST REP PASS? JMP RXT YES,READ STATEMENT CCA STA REQ SET REQ = -1 CLA,INA STA PNTR SET PNTR=1 JMP RXL * * * LABEL POST-PROCESSOR * * HS49 LDA PNTR ADA ..M1+1 (-2) SET LABEL LENGTH STA SCN1+3 * * * PROCESS OPCODE * * HS50 JSB OPLK SEARCH FOR OPCODE JMP HSERR ERROR EXIT JSB PKUP GET NEXT CHAR (_*+5) CPA BLNK BLANK? JMP *+4 YES? CPA L+4 COMMA? JSB BPKUP YES-GET NEXT NON-BLANK JMP *-5 GET NEXT CHAR. * * * TEST FOR OPCODE LENGTH LEGAL * LDB PNTR CMB,INB (POINTS TO BLNK FOLLOWING OPCODE) ADB SCN1+1 CPB ..M1+3 (-4) JMP HS54 LENGTH OK (=3) LDA CODE ADA .M48 CODE-60B SSA,RSS MICRO-OP ? JMP HS54 YES * * * ERROR PROCESSOR FOR OPCODE * LDA .OP 'OP'= OPCODE HAS TOO MANY CHARS. JSB ERPR HSERR LDA ASM1 LDB IFUSE CPB .1 SKIP CODE BECAUSE OF IFZ/IFN? JMP IFPRN YES - GO PRINT THE STATEMENT. SSA IS THIS AN INITIAL READ REQUEST? JMP HI24 -IT'S FROM INIT, SKIP OUTPUT BELOW. LDA PASS S SZA,RSS JSB ?LABE INSERT LABEL FOR OPCODE ERROR JSB LOUT TO BREC JSB LIST ISZ PLCN BUMP LOCN.CNTR JMP RXT READ NEXT STATE. HI24 LDA ...1+2 (3) REMARK PROC. JSB LIST JMP RXT READ NEXT STATEMENT * * * PICK UP OPERAND LOCN, THEN EXIT * * HS54 LDB CODE CPB .31B IS THIS IFZ/IFN/XIF? JMP IFZN YES LDA IFUSE GET 'IF' USE FLAG CPA .1 SKIP ASSEMBLING? CPB .12 IS IT AN 'END'? RSS YES - DON'T SKIP IT JMP HI24+1 GO ON AND PRINT THE STATEMENT JSB BPKUP GO SKIP BLANKS IF NECESSARY. ADB .M81 (-81) TEST FOR PNTR< 81 CLA SET A=0 STA LTFLG CLEAR LITERAL FLAG SSB SKIP IF FIELD OUT OF RANGE LDA PNTR PNTR TO A STA SCN1+2 OPERND POSN SZA OPERAND PRESENT? * * * TEST FOR LITERAL * JSB PKUP YES - GET 1ST CHAR. LDB AFLAG GET FLAG FOR 'ABS' TEST CPA EQ IS THE OPERAND A LITERAL? SZB YES, BUT EXIT IF ABSOLUTE ASS'Y. JMP RSTA,I NO EXIT FROM READER HERE. JSB PKUP GET THE LITERAL TYPE, NOW. LDB SCN1+2 GET OPERAND PNTR ADB .1+1 ADD 2 STA LTFLG SET LIT.FLAG(=LITERAL TYPE) LDA CODE * NOW CHECK FOR LEGAL LITERAL * CPA .1+5 ARITHMETIC MACRO? STB SCN1+2 YES, SET OPERAND POINTER. CPA .12+2 MEMORY REFERENCE? STB SCN1+2 YES, SET OPERAND POINTER. CPA .26B MPY/DIV/DLD/DST ? STB SCN1+2 YES, SET OPERAND POINTER. CMA,INA NEGATE OPCODE I.D. NO. ADA .A (101B) SSA OPCODE >100B ? STB SCN1+2 RESET POINTER TO LITERAL VAALUE. JMP RSTA,I EXIT FROM RSTA HERE .26B OCT 26 * SPC 2 * * PROCESS 'IFZ', 'IFN', OR 'XIF' CODES..* SPC 1 IFZN LDA INST GET INSTR.FORMAT(HAS IF CHAR IN) CLB SZA,RSS IS INST = 0? (IS IT XIF) ? JMP IFZN3 YES CPB IFUSE IFUSE = 0? JMP IFZN2 YES - GO ON WITH PROCESSING IFZNR LDA IF NO, ERROR, WE'RE IN IF OR REP JSB ERPR PRINT 'IF' ERROR JMP IFZN3+1 YES, GO ON WITH PROGRAM IFZN2 CLB,INB SET B = 1 CPA IFTST IS 'IF' CHARACTER MATCHED? CMB,INB YES - SET B = -1 IFZN3 STB IFUSE SET 'IFUSE' FLAG CLB CPB REP IN RANGE OF A REPEAT? JMP *+3 NO - OK STB REP YES - CLEAR 'REP' FLAG JMP IFZNR GO PRINT ERROR DIAG. IFPRN CLA,INA SET UP FOR NO INST, NO LOC'N PRNT JMP HI24+1 GO TO LIST AND CONTINUE SPC 1 IF ASC 1,IF ERROR IN IFZ OR IFN EQ OCT 75 EQUAL SIGN(=) .31B OCT 31 =IFZ,IFN,XIF TYPE .M80 DEC -80 .M46 DEC -46 .M81 DEC -81 ASM1 OCT -1 CONTROL STATE.FLAG .SY ASC 1,SY HEDR DEF HEADP UMSK OCT 177400 MASK FOR UPPER CHARACTER LMASK OCT 377 MASK FOR LOWER CHARACTER TAPE OCT 1 COUNT SOURCE TAPES SPC 1 * * SET SEQN TO ZERO, BUMP AND CONVERT SEQN. NO. * SPC 1 TAPN STB SEQN SET SEQ. NO. TO ZERO ISZ TAPE ADD 1 TO TAPE # LDA TAPE CCE CONVERT TO ASCII JSB BNCN CONVERT TO ASCII OCTAL LDA ASCI+2 STA ASCI+4 STORE IT INTO THE HEADER JMP RXC * SKP * * * TEST FOR LABEL PRESENT AND INSERT IN SYMBOL TABLE * * SET CORRECT RELOC.CODE BEFORE INSERTION. * ?LABE NOP LDA SCN1+3 GET LABEL LENGTH SZA,RSS LABEL PRESENT ? JMP ?LABE,I NO, DONE, EXIT.. STA SYMP SET CHAR COUNT LDB FFUB STB SYMP+1 SET LABEL ADDR. LDB LTFLG STB FLAQ SAVE LTFLG CLA STA LTFLG LTFLG_0 LDA AFLAG SZA IS THIS AN ABSOLUTE ASSEMBLY? JMUfP LABEX YES CLA,INA SET A = 1 LDB ?BASF SZB IN BASE PAGE ? INA YES, SET A = 2 LDB PLCN JSB ?INSR INSERT LABEL INTO SYMBOL TABLE NOP ERROR EXIT LDB FLAQ STB LTFLG RESTORE LTFLG JMP ?LABE,I EXIT LABEX JSB ?INS? GO TO INSERT RTN IN ASMB3 NOP ERROR EXIT JMP ?LABE,I EXIT * SKP * ************************************** * * MOVE: MOVES A STRING OF CHARACTERS * * * LINKAGE: A = NO.OF CHARS TO MOVE * * * B = DESTINATION ADDRESS * * * L JSB MOVE,I * * * L+1 SOURCE ADDRESS * * * L+2 RETURN * * * ADDR.TRUE IF STARTS ON LEFT * * * 2'S COMPL.IF STARTS ON RIGHT * * ************************************** MOVE NOP SZA IS CHAR.COUNT = 0? JMP *+3 NO JSB OPERR YES JMP MOVX CMA,INA STA GTEM+3 =-A * * SET UP DESTINATION CLE,SSB CMB,CCE,INB ELB STB GTEM+1 LDB MOVE,I GET SOURCE ADDRESS * * SET UP SOURCE CLE,SSB CMB,CCE,INB ELB STB GTEM+2 * * NOW MOVE THE CHARACTERS * $ LDB GTEM+2 CLE,ERB E_BIT #0 LDA 1,I B,I TO A SEZ,RSS E=0? ALF,ALF ROTATE . AND LMASK MASK OUT UPPER 8 BITS * * LOWER 8 BITS OF A CONTAINS CHAR.TO BE MOVED.* STA GTEM LDB GTEM+1 DEST TO B CLE,ERB E_BIT #0 LDA 1,I B,I TO A SEZ,RSS E=0? ALF,ALF ROTATE AND UMSK IOR GTEM * * CHAR.NOW IN A, WITH OTHER HALF OF DEST.WORD.* * * SINCE IT'S ON RIGHT WE MAY HAVE TO ROTATE * SEZ,RSS E=0? ALF,ALF C ROTATE STA 1,I A TO B,I * * NOW IT'S IN OK, BUMP COUNTERS AND PROCEED * ISZ GTEM+2 ISZ GTEM+1 ISZ GTEM+3 JMP $ MOVX ISZ MOVE JMP MOVE,I RETURN TO L+2 OF LINKAGE * ********************************************* * * SYMK: LOOKUP SYMBOL TABLE ENTRY; W HACCOU * * * LINKAGE: INPUT; SYMP=NO CHARS;SYMN=FWA * * * OF NAME..OUTPUT;A=TYPE,B=VALUE* * * L JSB SYMK,I * * * L+1 UNDEF.SYMBOL EXIT * * * L+2 NORMAL RETN * * ********************************************* SYMK NOP CLA INITIALIZE NAME(4), STA NAME 0 TO 1ST, BLANKS TO LDA BLNS OTHER WORDS STA NAME+1 STA NAME+2 LDA SYMP NO.OF CHARS ADA ..M1+5 (-6) SSA JMP *+5 * * * SYMBOL TOO LONG, PRINT DIAG.; SET LENGTH = 5 * * LDA .SY 'SY' TOO MANY CHARS IN SYMBOL JSB ERPR LDA ...1+4 (5) STA SYMP LDA SYMP (FROM *-5) LDB SYMP+1 ADDR.OF 1ST CHAR. STB *+4 LDB NAMI CMB,INB JSB MOVE NOP (SET AT *-4) LDA SYMP NO.OF CHARS. ARS STORE NUMBER OF INA WORDS IN ENTRY-1 STA TEMP+2 INTO TEMP+2 INA STA TEMP+3 AND TEMP+3 ALF,ALF ALF ADA NAME SET NUMBER OF WORDS STA NAME TO COMPARE FIRST WORDS LDA X IN THE STA SYMI SYMBTAB ADDR.COUNTER LP2 LDA NAMI STA SALU RESET NAME ADDR. COUNTER LDA SYMI STA TEMP+4 SAVE FWA OF SYMB.TBL.ENTRY LDA SYMI,I SZA,RSS JMP SYMK,I UNDEFINED EXIT FROM HERE STA FLEX SAVE 1ST WORD OF ENTRY AND SMASK 70377B CPA NAME COMPARE 1ST WORDS JMP *+6 ALF AND .12+3 (17B)MASK -2NO.WRDS IN ENTRY ADA SYMI LP3 STA SYMI BUMP ADDR.CNTR JMP LP2 LDA TEMP+2 (FROM *-6) ADA SYMI SET LIMIT=LWA-1 STA VAL0 OF SYMTAB ENTRY ISZ SYMI BUMP ADDR CNTR (FROM *+7) LDA SYMI CPA VAL0 END OF ENTRY? JMP *+8 YES ISZ SALU NO LDA SYMI,I COMPARE NEXT 2 CHARS. CPA SALU,I JMP *-7 EQUAL; COMPARE NEXT TWO. LP4 LDA TEMP+3 ADA TEMP+4 SET FWA OF NEXT ENTRY JMP LP3 CHK NXT SYMTAB ENTRY LDA FLEX GET 1ST ENTRY WRD (FROM *-8) ALF,ALF AND .12+3 (17B) LDB LTFLG SZB,RSS LITERAL IN OPERAND? JMP *+6 NO CPB ...1 ARITH MACRO WITH LITERAL? JMP *+4 YES CPA ...1+6 RELC=7? JMP *+4 YES, DONE. JMP LP4 NO, GO BACK CPA ...1+6 LITERAL? JMP LP4 YES, GO BACK(OPERAND IS'NT LITERAL) LDB SYMI,I B=VALUE ISZ SYMK JMP SYMK,I EXIT ALPHA+2 HERE SMASK OCT 70377 .400B OCT 400 .M16 DEC -16 .M48 DEC -48 SALU NOP TEMPORARY FOR NAME ADDR. COUNTER * SKP * ************************* * * PUNCH A BINARY RECORD * * ************************* PNCH NOP LDB BFLAG GET 'B' FLAG ADB LGFLG LOAD/GO SZB,RSS PUNCH FLAG ON? JMP PNCH,I NO - EXIT * * * COMPUTE CHECKSUM * * LDB FUBP = ADDRESS OF PUNCH BUFFER. LDA PBUF GET RECORD LENGTH. ALF,ALF POSITION TO LOWER BYTE. STA CNTB SAVE FOR 'EXEC' CALL. CMA,INA NEGATE WORD COUNT AND INA -1 (LENGTH NOT IN CK.SUM). STA GTEM STORE CHKSUM CNTR CLA CLEAR STA PBUF+2 CHECKSUM BUFFER-WORD. ISZ 1 BUMP REC.ADDR. ADA 1,I ADD TO CHK SUM ISZ GTEM DONE? JMP *-3 -NO ST/A PBUF+2 -YES- STORE SUM LDA BFLAG GET PUNCH FLAG SZA,RSS PUNCH BIN. TAPE JMP PNLGO NO, SKIP BINARY OUTPUT * * * GO TO SYS PUNCH * * JSB EXEC GO PUNCH BIN RECORD DEF *+5 DEF .1+1 'OUTPUT' REQ CODE DEF LUNPN FUBP DEF PBUF DEF CNTB WORD COUNT LDA LGFLG SZA,RSS LOAD AND GO? JMP PNCHX NO PNLGO JSB %WRIT GO WRITE IN JOB BIN. AREA DEF *+3 DEF PBUF BUFFER DEF CNTB WORD COUNT PNCHX CLA STA PBUF * * * EXIT HERE * * JMP PNCH,I * SKP * ******************************************** * * ASCN - CONVERT AN ASCII NUMBER TO BINARY * * * -ENTRY: A CONTAINS POSITION OF 1ST CHAR. * * * B(LOWER) CONTAINS NO. OF CHARS. * * * B(UPPER): MODE(BELOW) * * * 0 = OCTAL * * * 1 = FIXED DECIMAL * * * 2 = FLOATING DECIMAL * * * 3 = EXTENDED FLTG. DECIMAL * * * -EXIT : L+1 = ERROR RETURN ON ILLEGAL * * * CHARACTER OR OVERFLOW. * * * L+2 = NORMAL RETURN * * * MODE=0 OR 1, VALUE IN A * * * MODE=2, VALUE IN A AND B * * * MODE=3, VALUE IN A, B AND VALU * * * NOTE: FOR MODES 2 AND 3 VALUES IN A AND * * * B ARE ALSO IN VAL0 AND VAL1 RESP. * * ******************************************** ASCNP NOP ASCN EQU ASCNP STA SYMI CHAR POS. IN SYMI LDA LMSK AND 1 CMA,INA STA DCNT CHAR COUNT IN DCNT LDA 1 ALF,CLE,ALF POSITION THE MODE AND LMSK STA MODE SET MODE IN MODE ERA,SLA INTEGER CONVERSION? JMP ASCN2 NO - GO TO FLOATING PT ROUTINE JSB INTEG -GO TO INTEGER CONVERSION XNORM ISZ ASCNP SET UP FOR NORMAL RETURN JMP ASCNP,I EXIT * ***************************************** * * FLOATING POINT PROCESSING STARTS HERE * * ***************************************** ASCN2 CLA STA VAL0 CLEAR NUMBER SLOTS STA VAL1 STA VALU STA DEXP CLEAR DEC. OVERFLOW SLOT CCA STA DSIG SET SIGN(-1) FIR + STA CNVT SET FLAG FOR SIGN IN 1ST POSN. LDA BIT15 STA DFCNT SET DFCNT = 100000B FDCN1 JSB CNVRT CONVERT A CHARACTER JMP FDCN3 NON DIGIT RETURN ISZ DFCNT BUMP FRAC. COUNT LDA DEXP SZA OVERFLOW? JMP DCOV YES LDA VALU NO, PROCESS DIGIT STA VALUS LDA VAL1 LDB VAL0 JSB SHFT1 JSB SHFT1 NUM TIMES 4 AT THIS POINT SEZ,SSB,RSS OVERFLOW? RSS NO JMP DCOV YES LDB VALU ADB VALUS JSB CHK OVERFLOW FROM VALU? STB VALUS LDB VAL0S ADA VAL1 JSB CHKB IF VAL1 OV, BUMP B ADB VAL0 NUM TIMES 5 AT THIS POINT JSB SHFT1 NUM TIMES 10 HERE SEZ,SSB,RSS OVERFLOW? JMP *+3 NO DCOV ISZ DEXP YES, BUMP OVERFLOW DIGIT COUNT JMP FDCN7 LDB VALUS ADB CNVT FINALLY ADD LATEST DIGIT TO NUM JSB CHK IF OV, BUMP VAL1 STB VALUS LDB VAL0S JSB CHKB IF VAL1 OV, BUMP VAL0 SEZ,SSB,RSS OVERFLOW? JMP FDCN6 NO JMP DCOV YES FDCN3 CPA L+6 DEC PNT? (NON DIG.FROM CNVRT) JMP FDCN5 YES CPA .E 'E'? JMP *+3 YES ILEX LDA .IL NO, GO GET 'IL' JMP OVEX+1 GO TO ERROR DIAG EXIT ISZ DCNT LAST CHARACTER? JMP FDHOP NO - GO TO PROCESS EXPONENT FDCN5 LDA DFCNT SSA,RSS IS THIS A SECOND DEC.PNT? JMP ILEX YES CLA g STA DFCNT CLEAR COUNTER FOR DIGITS AFTER . JMP FDCN7 FDCN6 STB VAL0 SAVE NEW VALUE IN VAL0,VAL1,VALU STA VAL1 LDA VALUS STA VALU FDCN7 ISZ DCNT LAST CHARACTER? JMP FDCN1 NO- GET NEXT CHAR. * ************************************* * * PROCESS EXPONENT, IF PRESENT, AND * * * FINISH THE NUMBER(NORMALIZE, ETC)* * ************************************* FDHOP LDB DFCNT CMB,SSB,INB,RSS WAS A DEC POINT PRESENT? CLB NO, CLEAR B ADB DEXP STB DEXP SET CURRENT COUNT FOR DEC EXPONENT LDA DSIG STA SDSIG SAVE SIGN OF MANTISSA CLA NO - CONTINUE PROCESSING LDB TEST CPB .E IS EXPONENT THERE? JSB INTEG YES - EVALUATE IT ADA DEXP A+OVERFLOW CHARS STA DEXP SET VALUE OF DECIMAL EXPONENT LDA VAL0 CHECK FOR A VALUE OF ZERO IOR VAL1 IOR VALU SZA,RSS IS THE VALUE=0? JMP UNDTF YES, NORMAL EXIT FROM ASCN RTN. LDA .47 STA FEXP SET BINARY EXPONENT = 47 * * NORMALIZE THE NUMBER(IN VAL0,VAL1,VALU) * FDHP2 LDB VAL0 LDA VAL1 SSB IS BIT 15=0? JMP FDHP3 NO- GO SHIFT THEM ALL BACK 1 LDB VALU CLE,ELB SHIFT FROM VALU TO VAL1 ELA STB VALU STA VAL1 LDB VAL0 ELB SHIFT FROM VAL1 TO VAL0 STB VAL0 CCA ADA FEXP JMP FDHP2-1 FEXP-1 TO 'A' FDHP3 CLE,ERB SHIFT THEM ALL 1 RIGHT ERA STB VAL0 LDB VALU ERB STA VAL1 STB VALU ISZ FEXP NOP * LDA DEXP CLE,SZA,RSS JMP FDHPX DONE IF EXPONENT=0 SSA IS EXPONENT POSITIVE? JMP FDHP6 NO - GO TO DIVIDE BY 10 ADA ..M1 YES - MULTIPLY NUMBER BY 10 HERE STA DEXP DEXP=DEXP-1 LDA .1+2 ADA FEXP STA FEXP _- FEXP=FEXP+3 LDA VAL0 STA VAL0S LDA VALU STA VALUS LDB VAL1 JSB SHFR1 SHIFT VAL0,VAL1,VALU - JSB SHFR1 -RIGHT 2 PLACES ADA VALUS STA VALU NEW VALU JSB CHKB IF OV, BUMP B REG. LDA VAL0S ADB VAL1 JSB CHK OVERFLOW? FDHP5 ADA VAL0 STA VAL0 NEW VAL0 STB VAL1 NEW VAL1 JMP FDHP2 GO BACK TO RE-NORMALIZE * * DIVIDE NUMBER IN VAL0,VAL1,VAL2 BY 10 * FDHP6 INA STA DEXP DEXP=DEXP+1 LDA ..M1+2 ADA FEXP STA FEXP FEXP=FEXP-3 * * GO TO DIVIDE BY 10 HERE * LDA UVAL FDHP7 ADA ..M1+2 -3 CPA VSTOP LAST SECTION PROCESSED? JMP FDHP9 YES, LEAVE DIVIDE PROC NOW STA CNVT CONTAINS ADDR OF SECTION VEING DON * * DIVIDE 'A' BY 10 * * RESULT IN A AND B(=LEAST SIG.) LDB .M16 STB TEMP LDB TENTH CLA CLE,SLB CHECK FOR ANOTHER ADD ADA CNVT,I ERA ERB ISZ TEMP ALL DONE? JMP *-5 NO - CONTINUE STA CNVT,I SAVE 'A' VALUE ISZ CNVT BUMP ADDRESS STB CNVT,I SAVE 'B' VALUE LDA CNVT GET ADDRESS READY TO RESET JMP FDHP7 FDHP9 JSB COL45 PROCESS COL. 5 JSB COL45 PROCESS COLUMN 4 ADB VAL1 JSB CHK ADB VAL0S JSB CHK JSB COL32 PROCESS COLUMN 3 ADB VALU JSB CHK ADB VAL1S JSB CHK STB VALU VALU COMPUTED JSB COL32 PROCESS COLUMN 2 JMP FDHP5 GO STORE VAL0 AND VAL1. CONTINUE * ****************************** * * SET UP FLTG DECIMAL RESULT * * * FOR EXIT FROM CONVERSION * * ****************************** FDHPX LDA VAL1 LDB VAL0 JSB CHKM IS MODE EXT.DEC? JMP *+3 NO LDA VALU LDB VAL1 ADA .200B ROUND THE jLEAST SIGNIF. WORD JSB CHKB BUMP B IF E=1 JSB CHKM MODE=EXT.DEC? JMP *+4 NO STB VAL1 YES LDB VAL0 JSB CHKB BUMP VAL0 IF E=1 SSB,RSS VAL0<0? JMP *+4 NO RBR,CLE IT WAS A POWER OF 2 ISZ FEXP BUMP EXPONENT NOP STB VAL0 SAVE MOST SIF. JSB CHKM MODE = EXTEN.DEC? JMP *+2 LDB VAL1 YES AND UMSK STA DSIG CLEAR LOW 8 BITS OF 'A' AND SAVE ISZ SDSIG IS SIGN OF MANTISSA=+ JMP FDHR4 NO, GO PROCESS NEG. MANTISSA FDHRT LDA FEXP GET FRACTIONAL EXPONENT IN A/B LDB FEXP AND .1776 CLEAR LOWER 7 BITS SZA POSITIVE OVERFLOW? CPA .1776 MAYBE, NEG. OVERFLOW? CPB .1776 MAYBE, IS EXPON,=-200B? JMP FDHR3 YES, ALSO OTHER OVERFLOWS.. LDA FEXP GET THE EXPONENET AGAIN RAL POSITION IT AND LMSK CLEAR BITS 15-8 ADA DSIG ADD IN THE LEAST SIG.PART JSB CHKM IS IT EXTEND.DEC? UNDTF STA VAL1 NO,SET VAL1=LEAST STA VALU YES, SET VALU=LEAST SIGN. LDB VAL1 GET WORD 2 LDA VAL0 GET MOST SIGNIF. JMP XNORM GO OUT THE NORMAL EXIT FDHR3 SSB,RSS IS IT REALLY AN UNDERFLOW? JMP OVEX NO CLA YES, SET NO. = ZERO STA VAL0 CLEAR VAL0 JMP UNDTF FDHR4 CMA,INA START GETTING COMPLEMENT CMB JSB CHKB AND UMSK STA DSIG SAVE LEAST SIGNIFICANT BITS JSB CHKM IS IT EXTEND.DEC? JMP *+5 NO STB VAL1 LDB VAL0 CMB JSB CHKB CLE,ELB LDA ..M1 SSB,RSS WAS N0. A POWER OF 2? JMP *+4 NO ADA FEXP YES STA FEXP SUBTRACT 1 FROM EXPONENT. RSS ERB RESET B STB VAL0 JMP FDHRT * ************************* * TRN * CHECK MODE OF NUMBER * * * L+2 EXIT IF EXTENDED * * * ELSE L+1 * * ************************* CHKM NOP STB DEXP SAVE THE 'B' REG. LDB MODE CPB .1+2 IS MODE EXTEND.DEC? ISZ CHKM YES, BUMP RETURN ADDRESS LDB DEXP RESTORE THE 'B' REG. JMP CHKM,I * * PROCESS PARAMETERS FOR COLS. 4 AND 5 * COL45 NOP LDB 0 LOAD 'B' WITH 'A' (OVERFLOW BITS) CLA,CLE ADB VALU JSB CHK ADB VALUS JSB CHK ADB VAL1S JSB CHK JMP COL45,I * * PROCESS PARAMETERS FOR COLS 2 AND 3 * COL32 NOP LDB 0 SET B=A(OVERFLOW FROM PREV COL.) CLA,CLE ADB VAL1 JSB CHK ADB VAL0 JSB CHK ADB VAL0S JSB CHK JMP COL32,I * * CHECK FOR OVERFLOW FROM 'B' * CHK NOP SEZ OVERFLOW? CLE,INA YES, BUMP 'A', CLEAR 'E' JMP CHK,I * * CHECK FOR OVERFLOW- IF TRUE, BUMP 'B' * CHKB NOP SEZ CLE,INB JMP CHKB,I * * SHIFT NUMBER IN VAL0,VAL1,VALU RIGHT U * SHFR1 NOP LDA VAL0 CLE,ERA VAL0 RIGHT 1 ERB VAL1 RIGHT 1 STA VAL0 LDA VALU ERA,CLE VALU RIGHT 1 STA VALU JMP SHFR1,I RETURN * ST* ********************************** * * CNVRT - CONVERT AN ASCII CHAR. * * * TO BINARY. * * * - MODE = 0,OCTAL; ELSE DECIMAL * * * - L+1 RETURN IF NON-NUMBERIC * * ********************************** * CNVRT NOP LDA SYMI GET POS'N.OF CHARACTER JSB GETC GET CHARACTER ISZ SYMI BUMP POS'N LDB MODE SZB OCTAL CONVERSION? LDB ..M1+1 NO - SET FOR DEC.CONV ADB .M8 B=-8 HERE, IF OCTAL CONVERSION ADA .M48 -60B + A SSA IS VALUE LESS THAN ZERO? JMP CNVR2 YES ADB 0 NO - ADD IN MAX DIGIT VALUE. SSB IS IT A VALID NUMBER? JMP CNVRX YES- GO TO EXIT WITH NO. IN A. CNVR2 LDA TEST NO - TEST FOR + OR - CPA L+3 PLUS? JMP CNVR4 YES CPA L+5 NO - IS IT MINUS ? CLA,RSS YES JMP CNVRT,I NO - TAKE L+1 EXIT STA DSIG CNVR4 CLA ISZ CNVT HAS SIGN BEEN ENCOUNTERED BEFOR? JMP ILEX YES- 'IL' EXIT FROM ASCN CNVRX STA CNVT ISZ CNVRT JMP CNVRT,I * SKP * ************************************** * * INTEG - CONVERT A STRING OF ASCII * * * CHARS TO AN OCTAL(MODE=0) * * * OR DECIMAL INTEGER. * * *-IF OTHER THAN A LEADING SIGN OR * * * NUMBER IS FOUND 'IL' EXIT IS TAKEN * * *-'OV' EXIT IF OVERFLOW. * * ************************************** INTEG NOP CCB STB DSIG SET SIGN FLAG FOR PLUS STB CNVT SET 1ST CHAR FLAG(FOR SIGN CHK) * *ON ENTRY A=0(USED FOR THE INITIAL VALUE.) *** INTG2 STA VALUS SAVE CURRENT VALUE JSB CNVRT CONVERT A CHARACTER JMP ILEX ERROR - NON NUMERIC LDA VALUS CLE,ELA JSB OVTST |E TEST 4 TIMES A FOR OVERFLOW LDB MODE NO OVERFLOW SZB MODE = OCTAL ADA VALUS NO - 5 TIMES A(IT'S DECIMAL) JSB OVTST TEST 8(OR 10) TIMES A FOR OV ADA CNVT NO - ADD IN NEW DIGIT SEZ OVERFLOW? JMP OVEX YES ISZ DCNT LAST CHAR IN STRING? JMP INTG2 NO - GET ANOTHER SZB,RSS MODE = OCTAL? JMP INTG6 YES - OK CPA BIT15 IS NO. + OR - 32768? JMP INTG6 YES - OK SSA IS SIGN NEG? JMP OVEX YES - OVERFLOW INTG6 ISZ DSIG IS SIGN NEGATIVE? CMA,INA YES - COMPLEMENT A. JMP INTEG,I EXIT * *************************** * * SHIFT FOR MULTIPLY BY 2 * * *************************** SHFT1 NOP STB VAL0S SAVE VAL0S LDB VALUS GET VALUS CLE,ELB ELA SHIFT VAL1,VALUS STB VALUS SAVE VALUS LDB VAL0S GET VAL0S ELB SHIFT VAL0S,VAL1 STB VAL0S SAVE VAL0S JMP SHFT1,I RETURN * ****************************************** * * TEST ZERO BIT AND 'E' BIT FOR OVERFLOW * * ****************************************** OVTST NOP ELA 2 TIMES ENTRY VALUE OF 'A' SEZ,SLA,RSS OVERFLOW? JMP OVTST,I NO - RETURN OVEX LDA .OV GET 'OV' FOR ERROR DIAGNOSTIC. JSB ERPR JMP ASCNP,I LEAVE VIA RERROR EXIT * UVAL DEF VALU+3 ASCN 1ST PICKUP FOR DVD BY 10 VSTOP DEF VAL0S-3 ASCN LAST PICKUP FOR DIV BY 10 .47 DEC 47 .1776 OCT 177600 177600 TENTH OCT 146314 146314 .200B OCT 200 200B LMSK EQU LMASK LMDG DEF *+1 (ASCN) DEC -1000,-100,-10 LPDG DEF *+1 (ASCN) DEC 1000,100,10 * * ************************************** * * BINARY TO ASCII CONVERSION ROUTINE * * * A = NUMBER TO BE CONVERTED * * * E = 0 CONVERT TiO OCTAL * * * E = 1 CONVERT TO DECIMAL * * ************************************** OCT 30060 PACKED ASCII '00'. BNCN NOP LDB ICSA GET LOC'N OF ACSI BUFFER STB SYMI CCB STB VALUS START UPPER LDB BNCN-1 SET BUFFER=ASCII ZERO'S STB ASCI STB ASCI+1 STB ASCI+2 SEZ TEST E BIT (=0,OCTAL =1,DECIMAL) JMP % DEC CONVERSION LDB ..M1+5 (-6) STB DCNT CLE,ELA STA VALU CLA ELA SIGN BIT IS SIXTH DIGIT JSB DPCK LDA VALU ALF,RAR STA VALU AND ...1+6 (7) MASK 1 DIGIT ISZ DCNT END ? JMP *-6 NO. CONTINUE. JMP BNCN,I YES, EXIT DPCK NOP ADA SYMI,I ISZ VALUS JMP *+4 ALF,ALF STA SYMI,I JMP DPCK,I STA SYMI,I ISZ SYMI CCA STA VALUS JMP DPCK,I EXIT % LDB ..M1+2 (-3) DEC. CONVERSION RTN STB DCNT LDB LMDG STB VAL0 LDB LPDG STB VAL1 LDB 0 A TO B ISZ SYMI DPCR CLA,RSS INA (FROM *+3) ADB VAL0,I COUNT NO.OF TIMES GT 10**N SSB,RSS JMP *-3 ADB VAL1,I <10**N, RESTORE VALUE JSB DPCK PACK DIGIT ISZ VAL1 ISZ VAL0 ISZ DCNT JMP DPCR RETURN FOR 10**N-1 LDA 1 JSB DPCK JMP BNCN,I EXIT * SKP * ***************** * * ORR PROCESSOR * * ***************** ORRP NOP LDA JMPI (OR$ PARAMETER) JSB OR$ TO PRE-PROC STA ORRSV 0 TO ORRSV LDA ORRS GET THE SAVED MAIN PLCN STA PLCN SET PLCN TO MAIN LOC CNT. JMPI JMP ORRP,I EXIT(PICKED UP AT *-5) * * * ORG/ORR PRE-PROCESSOR * * OR$ NOP STA TST SET EXEC. PARAMETER. LDA ?BASF LDB PLCN SZA ARE WE IN BASE PAGE ? STB ?BPSV YES, SAVE B.P. LOCATION COUNTER. LDA ORRSV GET ORRSV SZA,RSS WERE WE IN MAIN PROG? TST NOP YES, EXIT IF ORRP; SAVE LOC CNTR IF ORGP: SSA WAS THIS SECTION SET BY AN ORG ? JSB ORGST GO SET HIGH PLCN VALUE IN PROG. CLA STA ?BASF CLEAR BASE PAGE FLAG. JMP OR$,I * ***************** * * ORG PROCESSOR * * ***************** STBI STB ORRS THIS IS A PARAMETER ORGP NOP LDA STBI GET OR$ PARAMETER. JSB OR$ CCA STA ORRSV SET ORRSV = -1 * * * GO TO EVALUATE OPERAND * * JSB CHOPI JMP ORGP,I ERROR EXIT STB PLCN LDB AFLAG SZB,RSS SKIP OUT, IF ABSOLUTE ASSEMBLY CPA ...1 RELOC? JMP ORGP,I YES,OK JSB OPERR NO, 'M' ERROR JMP ORGP,I EXIT * SKP * ******************************* * * LIST ROUTINE: PARAMETERS; * * * IF A=0,4,6,7 B=RELOC CODE * * * A=0 FULL LINE * * * A=1 NO INST OR LOCN * * * A=2 NO INST * * * A=3 COMMENT * * * A=4 NO SEQ.NO., NO STATE.* * * A=5 PRINT 'ASMB' STATEMENT* * * A=6 INST ONLY(EXT OFFSET)* * * A=7 NO LOCN (RPL CODE) * * ******************************* LISTD DEC 60,-61 LISTK DEF IOBF+6 INSTRUCTION LOC'N DEF IOBF+3 LOCATION LOC'N DEF IOBF+2 LIST COMMENT LOC'N LIST NOP STB SAVB SAVE ASCII RELOC CODE STA SAVB+1 SAVE LIST PARAM. CPA ...1+4 CONTROL STATE.? JMP HI82 YES LDB LFLAG GET LIST FLAG SZB,RSS PUNCH ONLY? JMP LIST,I YES, EXIT LDB PASS SZB,RSS PASS 1 ? JMP LIST,I YES, EXIT LDA LST SZA LIST FLAG=0 ? JMP LIST,I NO, EXIT  LDA LPDG+3 (10) LDB FBOI JSB SETM SET BUFFER TO ASC 1, BLANKS LDA SAVB+1 CPA ...1 A=1? JMP HI82 YES CPA ...1+1 A=2? JMP HI80 YES * * * CONVERT INSTRUCTION * LDB SAVB STB IOBF+9 SET RELOC INDIC LDA INST CLE E=0 JSB BNCN CONVERT TO ASCII OCTAL LDB LISTK L(IOBF+6) JSB V MOVE NO.TO BUFFER LDA SAVB+1 GET LIST PARAMETER. CPA .1+6 (7) NO LOCATION ? JMP HI82 YES, GO CONVERT SEQ. NUMBER. CPA .1+5 (6) INSTRUCTION ONLY ? JMP HX8 YES, CHECK FOR SUPPRESS. * SKP * * CONVERT LOCATION CNTR * * HI80 LDA PLCN CLE E=0 JSB BNCN CONVERT TO ASCII OCTAL LDB LISTK+1 L(IOBF+3) LDA ...1+4 (5) JSB MOVE LISTL NOP -ASCI GOES IN HERE LDA SAVB+1 CPA ...1+3 A=4? JMP HX8 YES * * * CONVERT SEQ.NO. * HI82 LDA SEQN CCE E=1 JSB BNCN CONVERT IT TO ASCII DECIMAL LDA ASCI+1 STA IOBF LDA ASCI+2 STA IOBF+1 * * * SET UP BUFFER LENGTH, ADJUST IF >80 CHARS * LDB SAVB+1 CPB ...1+4 CONTROL STATE.? STA ASCI+4 SET TAPE # =1 LDA SCN1 STATE.LENGTH CPB ...1+2 REMARK? JMP HI19 YES HI17 STA 1 H TO B ADA LISTD+1 -61 SSA,RSS LENGTH>60 ? LDB LISTD YES, SET B=60 ADB ...1+3 ADD 4 STB 0 NEW LENGTH TO A HI18 ADA .12+4 LENGTH+16 LDB FBOI JSB PRNT *PRINT THE LINE OF OUTPUT * JMP LIST,I EXIT * * * SET UP FOR LIST COMMENT * HI19 LDB LISTK+2 L(IOBF+2) JSB MOVE DEF BUFF LDA SCN1 ADA .M16 LENGTH-16 JMP HI17 * * * TEST FOR EXTENDED SUP * HX8 LDB SUP SZB SU~PPRESS THE LISTING ? JMP LIST,I YES, EXIT LDA .1+3 INITIALIZE STATEMENT LENGTH =4. JMP HI18 GO TO PRINT THE LINE. FBOI DEF IOBF * SKP * ****************** * * SKIP 'A' LINES * * ****************** LINS NOP SZA,RSS DON'T GO TO DRIVER, JMP LINS,I IF COUNT =0 (IT'S NOT NECESSARY). STA DSIG SET LINES TO SKIP INTO CNTR. JSB EXEC SKIP LINES DEF *+4 DEF .1+2 'CONTROL' REQ CODE DEF PRSPC DEF DSIG LINE COUNT JMP LINS,I RETURN. * ********************************************************************** * * * * FIND NUM.OF CHARS IN A TERM * * * * * ENTER:=DON'T CARE; =RELATIVE POS'N IN 'BUFF' OF 1RST CHAR. * * EXIT: =NO. CHARS. IN TERM; B=STARTING MEMORY ADDRESS OF TERM * * 'TEST'=CONTINUATOR CHAR., FOLLOWING TERM * * 'LAST'=LAST CHARACTER IN TERM * ********************************************************************** * MSYM NOP STB SAVB STB PNTR CLA START WITH STA DSIG ZERO FOR CNTR STA TEST HI42 STA LAST LAST LDA SAVB JSB GETC CPA L+2 * ? JMP HI43 YES CPA BLNK END OF SYMBOL? JMP *+7 -YES- ADA .M46 -46 = -56B SSA,RSS >55B ? JMP HI44 -YES, NOT A TERMINATOR. ADA ...1+6 (7) NO. SSA >47B [TERMINATOR: ' ( ) * + , - ] ? JMP HI44 NO * * SET UP FOR EXIT * LDA PNTR JSB GETA LDA DSIG NO.OF SYMBOLS TO A JMP MSYM,I EXIT HI43 LDA DSIG CPA ...1 IS '*' ALONE? JSB OPERR NO, ERROR HI44 ISZ DSIG BUMP CNTR.  ISZ SAVB LDA TEST JMP HI42 * * ******************************** * * PRINT OUTPUT AND COUNT LINES * * ******************************** PRNT NOP CMA,INA SET CHAR COUNT NEG. FOR I/O STA SAVB SAVE THE CHARACTER COUNT STB PRLOC GIVE THE BUFFER ORIGIN ISZ LINC END OF PAGE ? JMP I - NO LDB PLINE STB LINC RESET THE LINE COUNTER LDA .1+6 SKIP SEVEN LINES ON TTY, CMA,INA OR GO TO TOP OF FORM JSB LINS ON LINEPRINTER. ISZ LINC+1 BUMP PAGE NO. CCE SET FOR DECIMAL NO.CONVERSION. LDA LINC+1 GET PAGE NO. JSB BNCN CONVERT TO ASCII OCTAL * * * SET UP PAGE HEADER * LDA RC 'E' STA ASCI LDA LPDG+3 OUTPUT 10 CHARS. LDB PASS SZB,RSS LIST PASS? JMP *+3 NO ADA ...1+3 (4) SET UP FOR HEADER ADA HED CMA,INA STA DSIG SET CHAR COUNT JSB EXEC GO TO PRINT THE HEADER DEF *+5 DEF .1+1 DEF LUNPR DEF HEADP HEADER LOC'N DEF DSIG COUNT LDA .1+1 PREPARE TO JSB LINS SKIP 2 LINES. I JSB EXEC GO OUTPUT A LINE DEF *+5 DEF .1+1 DEF LUNPR PRLOC NOP BUFFER ORIGIN DEF SAVB CHARACTER COUNT JMP PRNT,I PRINT EXIT LINC OCT -1,0 LINE CNTR/PAGE CNTR PCOMP NOP =0 IF PRINTER, =-56 IF TTY * SKP * ******************* * * SET UP A HEADER * * ******************** HEDSB NOP LDA SCN1+2 SZA,RSS HEADER PRESENT? JMP HXD NO-RETURN ADA ..M1 CMA,INA ADA SCN1 STA HED HEADER LENGTH IN 'HED' LDB .64 ADA .M65 -65 SSA,RSS IS HEADER TOO LONG (MORE THAN 64 CHARS) STB HED SET HEADER LENGTH TO 64 LDA SCN1+2  JSB GETA GET ADDRESS OF HEADER LDA HED STB *+3 LDB HXD. GET L(HEDR+9) JSB MOVE NOP ADDR OF HEADER LDA HED ADA ...1+1 HXD STA HED JMP HEDSB,I .64 DEC 64 .M65 DEC -65 HXD. DEF HXBUF LOCATION OF HEADER HED NOP HEADER FLAG(LENGTH) ICSA DEF ASCI LOC'N OF ASCI BUFFER * ************************** * * PRINT ERROR DIAGNOSTIC * * ************************** DEF IOBF+5 ERPR NOP ISZ ERRCN BUMP ERROR COUNTER LDB BLNS STA IOBF+5 ERROR DIAG. STB IOBF+6 BLANKS STB IOBF+9 BLANK OUT RELOC INDIC. LDA SEQN CCE JSB BNCN CONVERT TO ASCII OCTAL LDA ASCI+1 FOR USE IN STA IOBF+7 THE LDA ASCI+2 DIAGNOSTIC STA IOBF+8 JSB PRPAG GO PRINT PREVIOUS PAGE NO. LDA SCN1 GET STATEMENT LENGTH ADA LPDG+3 (+10) LDB ERPR-1 GET STATE,ORIGIN (IOBF+5) JSB PRNT PRINT THE MESSAGE. JMP ERPR,I EXIT SKP * *PRINT PREVIOUS PAGE CONTAINING ERROR ** * PRPAG NOP USED IN 'ERPR' AND 'ENDSB' CLA,INA SET UP TO EMIT A BLANK LINE LDB HEDR JSB PRNT GO TO PRINT ROUTINE LDA LINC GET CURRENT LINE VALUE CPA ..M1 IS IT SET FOR A PAGE EJECT? JMP *-5 YES, GO OUTPUT ANOTHER BLANK LIN LDB PASS LDA TAPE GET SOURCE TAPE NO. SZB FIRST PASS? LDA PRERR GET PREVIOUS PAGE(=0 IF 1ST ERR) CCE JSB BNCN CONVERT PAGE OR TAPE TO DECIMAL LDA .TNO GET ' #' LDB PASS SZB FIRST PASS? LDA .PG GET "PG" FOR PAGE POINTER STA ASCI SET IN '**' LDA ASCI+1 AND .2077 MAKE 1ST DIGIT BLANK STA ASCI+1 LDA .1+5 GET PARAM FOR 6 CHARS LDB ICSA BUFFER ORG JSB PRNT X GO PRINT "**PAGE" OR " #TAPE" LDA LINC+1 GET CURRENT PAGE NUMBER. STA PRERR SET PREV. PAGE = CURRENT PAGE. JMP PRPAG,I EXIT .PG ASC 1,PG .2077 OCT 20077 * ************************************** * * PRINT ERROR COUNT AT END OF A PASS * * * SPACE TO BOTTOM OF PAGE * * * INIT.LINE,ERROR AND SEQUENCE CNTRS* * * SET CONTROL STATEMENT FLAG = -1 * * ************************************** ENDSB NOP LDB PASS SZB,RSS FIRST PASS? JMP GETER YES, BYPASS MESSAGE CHANGE. DLD TOTAL NO. CHANGE MESSAGE DST PAU+7 FROM: LDA TOTAL+2 "PASS#1" STA PAU+9 TO: "*TOTAL". GETER LDA ERRCN GET CURRENT ERROR COUNT. ADA ?ENER INCLUDE ENTRY POINT ERRORS, IF ANY. STA ERRCN UPDATE TOTAL ERROR COUNT. SZA,RSS ANY ERRORS? JMP ENDSR NO ERRORS.. LDB PASS SZB FIRST PASS? JSB PRPAG NO, PUT OUT THE PAGE POINTER LDA ERRCN GET THE TOTAL ERROR COUNT CCE JSB BNCN CONVERT TO ASCII OCTAL LDA ASCI+1 LDB ASCI+2 JMP *+3 ENDSR LDA BLNS * * * 'NO'ERROR SETUP * * LDB .NO FOR 'NO' ERRORS STA PAU+1 STB PAU+2 LDA L (40) NO OF CHARS IN MESSG. LDB PAU-1 BUFF ADDR JSB PRNT PRINT DIAG. JSB OKOLE STA ASM1 SET CONT.STATE.FLG CLA,INA SET A=1 STA TAPE SET TAPE COUNTER = 1 JMP ENDSB,I EXIT END SUBROUTINE * DEF PAU LOC OF PASSOVER STATE. * PAU EQU * ESTABLISH START OF MESSAGE. * IFZ ASC 20,**0000 ERRORS PASS#1 **RTE ASMB 760924** XIF IFN ASC 20,**0000 ERRORS PASS#1 **DOS ASMB 750420** XIF TOTAL ASC 3,*TOTAL * ?PERL DEF *+1 ?BASF NOP BASE PAGE FLAG. ?BPSV NOP HIGHEST BASE PAGE VALUE. REP NOP REPEAT COUNTER REQ NOP FLAG FOR 1ST STATE AFTER REP LST NOP LST/UNL FLAG LTFLG NOP LITERAL FLAG(0=NO LIT.) ORRSV NOP =0 IN REG. PROG;=-1 IN ORG SECTN ORRS NOP SAVE LAST PLCN VAL FOR ORR SET ORGSV NOP HIGHEST PLCN VAL IN AN ORG SECTN PRERR NOP PREV. PAGE # CONTAINING ERROR. SUP NOP SUP/UNS FLAG IFUSE NOP =1, SKIP ASSMBL.; =-1, IN 'IF' RANGE SEQN NOP SEQUENCE COUNTER ?LPER ABS *-?PERL-1 LENGTH OF AREA TO BE CLEARED * ?ENER NOP 'ENT' ERROR COUNT STORAGE ERRCN NOP ERROR COUNTER. * SKP * *********************************** * * SPACE TO BOTTOM OF CURRENT PAGE * * * (USED BY HED AND PROC.ABOVE) * * *********************************** OKOLE NOP CLB SET B=0 LDA LINC LINE COUNT - INA,SZA =-1 ? LDB PLINE NO, SET B=STAN.LINE COUNT CPB PCOMP TTY OUT?(IF COUNT=-1, WON'T COMP) JSB LINS NO-GO TO PAGER CCA STA LINC SET LINC = -1 JMP OKOLE,I EXIT * * * PICK UP NEXT CHAR, ADD 1 TO PNTR * * PKUP NOP LDA PNTR JSB GETC ISZ PNTR JMP PKUP,I * * * SEARCH FOR NON-BLANK CHAR, SET PNTR AT IT * * BPKUP NOP JSB PKUP CPA BLNK BLANK? JMP *-2 YES - GET NEXT CHAR. LDB PNTR NO - SET PNTR TO LAST NON-BLANK ADB ..M1 STB PNTR JMP BPKUP,I * ***************************** * * PUNCH AND SET UP FOR LIST * * ***************************** LOUT NOP CLA 0 TO A CLB,INB 1 TO B CPB PASS SKIP PUNCH IF IN PASS 1 RSS PASS 2, SO PUNCH. JMP PLST PASS 1 SO PREPARE FOR LIST. CPA AFLAG ABSOLUTE ASSEMBLY ? JMP RLREC NO, GO PROCESS RELOC. RECORD. JSB ?AREC YES,GO TO ABS REC. PROCESSOR. RSS SKIP TO PREPARE FOR LIST. RLREC JSB ?BREC GO TO RELOC. REC PROCESSOR. PLST CLA 0 TO A LDB BLNS BLANKS TO B JMP LOUT,I EXIT * SKP * * GET HIGHEST CURRENT LOCATION VALUE FOR 'ORG' PROCESSING. * ORGST NOP LDA ORGSV LAST ADDR. GENERATED DURING ORG CMA,INA ADA 1 "A" REGISTER _ LAST 'PLCN' VALUE SSA,RSS GREATER ? STB ORGSV NO. USE 'PLCN' VALUE FOR HI ORG CLA,INA "A" = 1 JMP ORGST,I RETURN. * * ***************** * * ORB PROCESSOR * * ***************** ORBP NOP LDA AFLAG SZA,RSS RELOCATABLE ASSEMBLY ? JMP XYZ YES. LDA .IL NO - 'IL ERROR ! JSB ERPR JMP ORBP,I RETURN. * XYZ LDB PLCN LDA ?BASF SZA ARE WE IN BASE PAGE ? JMP ORBP,I YES, EXIT. LDA ?BPSV NO, SET PLCN TO STA PLCN LATEST B.P. VALUE ISZ ?BASF SET B.P. FLAG. LDA ORRSV ARE WE IN SZA MAIN PROGRAM ? JSB ORGST NO, SET HIGH PLCN VALUE. SZA,RSS STB ORRS SAVE PLCN. CLA,INA STA ORRSV SET ORRSV = 1 JMP ORBP,I RETURN. * SKP * **************************** * * PROCESS ARITHMETIC MACRO * * **************************** DEF TEMP+4 HA38 JSB ARTLT GO TO LITERAL PROCESSOR LDA L+6 (PERIOD) STA TEMP+4 LDB HA38-1 =L(TEMP+4) LOWER CMB,INB STB SYMP+1 LOC.OF SYMBOL LDA ...1+3 (4) EXT RELOC CODE STA SYMP NO.OF CHARS. LDB PASS SZB JMP ?ART GO TO ARITH('ART') ROUTINE LDB CNTR EXT.NUMBER JSB ?INSR INSERT INTO SYMBOL TABLE RSS ERROR- SKIP NEXT ISZ CNTR BUMP EXT CNTR LDA .1+1 2 JMP ?HA3Z CNTR OCT 1 EXT COUNTER,FOR PASS 1. * ************************** * * MEASURE LITERAL LENGTH * * ************************** MSYML NOP LDA SCN1+2 GET OPERAND POSITION STA SAVB SPC 1 * * SET UP AND TEST NEXR CHARACTER ISZ SAVB SAVB = OPDRND POS'N+1 LDA SAVB GET CURRENT POSITION JSB GETC GET THE CHATACTER CPA BLNK IS IT A SPACE? RSS YES, END OF LITERAL JMP *-5 NO, GO EXAMEINE THE NEXT CHARACT. LDB SCN1+2 GET STARTING POSITION CMB,INB COMPLEMENT IT. ADB SAVB RESULTS IN THE LITERAL LENGTH JMP MSYML,I EXIT * SKP * ******************** * * PROCESS LITERALS * * ******************** PLITS NOP LDA LTFLG LITERAL FLAG CPA .F =F ? JMP PER CPA .A =A ? JMP P.A CPA .L =L? JMP P.L JSB MSYML =B OR D; GET SYMB LNG. LDA LTFLG CPA .B =B? JMP *+6 YES CPA .D =D? JMP *+3 YES PER JSB OPERR 'M' ERROR JMP PLITS,I EXIT ADB .400B LDA SCN1+2 JSB ASCN CONVERT TO BINARY JMP PLITS,I ERROR RETURN P.1 STA ASCI LDA ...1+1 STA SYMP LDA PASS SZA PASS 1 ? JMP *+4 NO JSB ?LITI YES, INSERT LIT.INTO SYMBOL TABL JMP PLITS,I ERROR RETURN RSS JSB ?LKLI LOOKUP LITERAL IN SYMBOL TABLE ISZ PLITS JMP PLITS,I NORMAL RETURN P.L CLA EXPRESSION PROCESSOR STA LTFLG JSB CHOPI EVALUATE OPERAND JMP PLITS,I ERROR EXIT SZA ABSOL.VALUE? JMP PER NO-ERROR LDA 1 VALUE TO A REG JMP P.1 P.A LDA SCN1+2 JSB GETA STB *+4 ADDR OF OPERAND LDA ...1+1 2 CHNLHARS LDB ICSA GET LOC'N OF ACSI BUFFER JSB MOVE NOP OPERAND ADDR. JMP P.1+1 .A OCT 101 ASCII 'A' .D OCT 104 'D' .F OCT 106 'F' .L OCT 114 'L' SKP $N* ************************* * * ARITH MACRO PROCESSOR * * ************************* ARTLT NOP LDA LTFLG GET LITERAL FLATG SZA,RSS LITERAL PRESENT? JMP ARTLT,I NO LITERAL, EXIT LDB TEMP+6 STB ARTSV+1 LDB TEMP+5 1ST 2 OPCODE CHARS FOR TEST STB ARTSV CPB .MP MPY? JMP LTAR YES CPB .DI DIV? JMP LTAR YES CPB .DS DST? JMP *+3 YES, ERROR CPA .F =F? FLTG PT LIT PROC JMP LERR+3 JSB OPERR NO,'M'ERROR LERR CLB B=0 CLA,INA A=1 JMP LTAR+2 JSB MSYML PROC.LIT.LNG. ADB .1000 2 TO 'B' UPPER LDA SCN1+2 OPERND PNTR JSB ASCN CONVRT ASCII TO FLTG.PT. JMP LERR ERROR RETURN STA ASCI STB ASCI+1 LDA ...1+3 (4) STA SYMP SET SYMK/INSR PARAMS. LDA PASS SZA,RSS PASS 1 ? JMP *+3 YES JSB ?LKLI NO, LOOKUP LIT. IN SYMBL TABLE JMP LTAR+2 EXIT JSB ?LITI INSERT LITERAL INTO SYMBOL TABLE JMP LTARZ ERROR EXIT(OK) ISZ PLEN JMP LTARZ LTAR JSB PLITS JMP LERR ERROR RETURN STA LTSVA SAVE A STB LTSVB SAVE B LTARZ CLA,INA STA LTFLG SET LTFLG=1 FOR LIT.IN ARITH MACRO. LDA ARTSV SET OPCODE CHARS BACK STA TEMP+5 FOR FURTHER PROCESSING LDA ARTSV+1 STA TEMP+6 JMP ARTLT,I EXIT FROM LIT. PROC. HERE SPC 1 .MP ASC 1,MP .DI ASC 1,DI .DS ASC 1,DS ARTSV OCT 0,0 LTSVA NOP FOR ART USE LTSVB NOP * ******************** * * SETUP FOR REPEAT * * ******************** REPSB NOP LDA REP SZA IN 'REP' RANGE? JMP RXP YES, ERROR JSB CHOPI EVAL NO.OF REP'S JMP RXP+2 ERROR EXIT SZA VAL RELOC? JMP RXR  YES, ERROR SZB,RSS VAL=0? JMP RXP+2 YES INB NO. CMB,INB -B TO B LDA ..M1+1 STA REQ SET REQ=-2(FOR SEQNO PROC) RXX STB REP B TO REP (NO.OF REPEATS) JMP REPSB,I RXP LDA .OP 'OP' ERROR(IN RANGE OF 'REP') JSB ERPR CLB 0 TO B (FOR NO REP) JMP RXX RXR JSB OPERR RELC.VAL(ERROR) 'M' JMP RXP+2 * * * SET UP FOR EVALUATION OF OPERAND IN WHICH A COMMA * * IS ILLEGAL. * CHOPI NOP CLA JSB CHOP JMP CHOPI,I ISZ CHOPI JMP CHOPI,I * ************************************* * * GET BREC CODE AND LIST RELOC CHAR * * BREC CODE IN A, LIST CHAR IN B. * ************************************* DCOD NOP LDB BLNS SZA,RSS ABSOLUTE REL.? JMP DCOD,I YES,DONE STA SAVB SAVE RELC CODE CPA ...1+4 IS IT EQU EXT ? ADA ..M1 YES, SET = 4. ADA RC-1 POINT TO CORR.RELC.CHAR. LDB 0,I PICK IT UP LDA BYFLG SZA,RSS LDA SAVB PICK UP RELC CODE IF NECESSARY. JMP DCOD,I RETURN * * * MOVE CHARS.TO A BUFFER FROM ASCI * * * BUFFER ADDR.IN B REG. * * V NOP LDA ...1+5 JSB MOVE DEF ASCI JMP V,I * * * SET UP AND PRINT 'M' DIAG. FOR OPERAND ERROR * * OPERR NOP LDA .MBLN 'M'= OPERAND ERROR JSB ERPR JMP OPERR,I * ********************************************************************** * * * * GET BUFFER ADDRESS OF ITEM * * * * * ENTER: =CHARACTER POS'N. RELATIVE TO 'BUFF'; =DON'T CARE * * EXIT: =+-CHAR. MEMORY ADDR.; NEG-IN LOWER BYTE,POS-UPPER * * 2 * ********************************************************************** * GETA NOP ADA ..M1 A-1 TO A CLE,ERA ADA FFUB SEZ UPPER ADDR? CMA,INA NO - COMPLEMENT IT. STA 1 A TO B JMP GETA,I * ********************************************************************** * * * * GET AN OPERAND CHAR. * * * * * ENTER: =CHAR. POS'N RELATIVE TO 'BUFF'; =DON'T CARE * * EXIT: =CHAR.(LOWER BYTE); =WORD ADDRESS OF 'TEST' * * 'TEST' = CHARACTER (LOWER BYTE) * * * ********************************************************************** * GETC NOP JSB GETA STB *+5 LDB TS ADDR OF 'TEST' TO B REG CMB,INB CLA,INA SET =1 JSB MOVE NOP (FROM *-5) LDA TEST JMP GETC,I TS DEF TEST * * ************************************ * * MEASURE SYMBOL AND SET * * * SYMP = SYMBOL CHAR COUNT * * * SYMP+1 = SYMBOL POSITION * * ************************************ MSYMS NOP JSB MSYM STA SYMP STB SYMP+1 JMP MSYMS,I * * ***************************** * * SET MEMORY TO GIVEN VALUE * * ***************************** * SETM NOP CMA,INA SET VALUE FOR COUNTER STA DSIG LDA SETM,I GET PARAMETER TO BE STORED IN AREA STA 1,I - PLACE PARAMETER IN MEMORY ISZ 1 ISZ DSIG JMP *-3 ISZ SETM JMP SETM,I SKP *%WRIS WRITES SOURCE ONTO DISK. RECORD FORMAT:1ST WORD=-N,IT IS *FOLLOWED BY N CHARACTERS. RECORDS ARE PACKED WITHIN TRACKS, *TRACKS ARE LINKED. INITIALIZATION IS ACCOMPLISHED BY CALLING *%WRIN. IT WILL ASK FOR A TRACK, INITIALIZE %WRIS,AND RETURN *A WORD=LUN,FIRST TRACK NO. * *CALLING SEQUENCES: * JSB %WRIS * DEF *+4 * DEF BUFFR FWA OF OUTPUT BUFFER * DEF RLEN -(NO OF CHARS), 0 FOR EOT * ERROR RETURN (DISK FULL) * NORMAL RETURN WITH (A)= LUN,TRACK NO * * JSB %WRIN * ERROR RETURN (NO MORE TRACKS) * NORMAL RETURN WITH (A)= LUN,TRACK NO * *TO END A FILE, CALLING SEQUENCE IS: JSB %WEOF * * *GETRK REQUESTS A TRACK FROM EXEC. IF NO TRACKS ARE AVAILABLE, *THE ERROR RETURN WILL BE TAKEN *CALLING SEQUENCE: JSB GETRK * ERROR RETURN * NORMAL RETURN GETRK NOP JSB EXEC GET TRACK DEF *+6 DEF .1+3 GET TRACK DEF TCONS GET 1 TRACK, DO NOT SUSPEND. IFN DEF WTRAC TRK NO. DEF WLUN LUN XIF IFZ DEF NTRAC DEF NLUN XIF DEF S/TRK GIVES # TRACKS/SECTOR IFN LDA WTRAC XIF IFZ LDA NTRAC XIF SSA TRACK HERE ? JMP GETRK,I NO, ERROR RETURN ISZ GETRK BUMP FOR JMP GETRK,I NORMAL RETURN WINIT NOP IFN LDA WTRAC LDB WLUN XIF IFZ LDA NTRAC STA WTRAC LDB NLUN STB WLUN XIF BLF,BLF ADA 1 (A)= LUN,TRACK NO. STA LUNTR LUN,TRACK TO RETURN ON EXIT LDB WBFWA STB WBFAD BUFFER ADDR= BUFFER FWA LDB .M64 -64 STB BCOUN BUFFER COUNT CLB STB WSECT SECTOR NO =0 JMP WINIT,I NORMAL EXIT %WRIS NOP LDA %WRIS,I STA EXIT EX]/IT POINT ISZ %WRIS LDA %WRIS LDA 0,I RAL,CLE,SLA,ERA TEST I-BIT AND CLEAR JMP *-2 INDIRECT,CONTINUE THRU I-CHAIN STA SBUFR SOURCE-BUFFER ADDR ISZ %WRIS LDA %WRIS,I LDA 0,I -(NO OF CHARS) ISZ %WRIS ARS STA 1 CMB,INB BLF,BLF ADA ..M1 -1 STA ACOUN -(NO OF WORDS +1) STB WBFAD,I NO. OF WORDS IN UPPER JMP WRIS1+3 WRIS0 EQU * IFN JSB WOUT OUTPUT SECTOR XIF LDA WSECT SECTOR NO. INA CPA S/TRK END OF TRACK ? JMP WRIS3 YES IFZ JSB WOUT NO,OUTPUT SECTOR XIF ISZ WSECT BUMP SECTOR NO. LDA WBFWA STA WBFAD BUFFER ADDR = BUFFER FWA LDA .M64 -64 STA BCOUN BUFFER COUNT = -64 JMP WRIS2 WRIS3 EQU * IFZ STB TEMP SAVE CURRENT WORD XIF JSB GETRK GET TRACK JMP %WRIS,I ERROR RETURN,NO TRACKS AVAILABLE IFN JSB WINIT INITIALIZE FOR NEW TRACK JMP WRIS2 XIF IFZ LDA NLUN NEW LUN ALF,ALF ADA NTRAC SET LUN/TRACK STA BUFFR+63 LUN,TRACK NO. TO LAST WORD OF TRK JSB WOUT OUTPUT LAST SECTOR JSB WINIT INITIALIZE FOR NEW TRACK LDA TEMP STA WBFAD,I WORD TO DISK JMP WRIS1+3 XIF WRIS1 LDB SBUFR,I STB WBFAD,I WORD TO DISK ISZ SBUFR BUMP SOURCE POINTER ISZ WBFAD BUMP OUTPUT-BUFFER POINTER ISZ BCOUN END OF SECTOR ? RSS NO JMP WRIS0 WRIS2 ISZ ACOUN END OF TRANSFER ? JMP WRIS1 NO, CONTINUE CCA STA WBFAD,I SET CURRENT EOF LDA LUNTR (A)= LUN,TRACK NO. JMP EXIT,I RETURN WOUT NOP JSB EXEC DEF *+7 DEF .1+1 +2 = CODE FOR WRITE DEF WLUN LUN OF CURRENT WRITE-TRACK WBFWA DEF BUFFHR WRITE BUFFER DEF B100 =64 DEF WTRAC TRACK NO DEF WSECT SECTOR NO JMP WOUT,I WTRAC NOP CURRENT TRACK WSECT NOP CURRENT SECTOR WLUN NOP LUN FOR CURRENT TRACK SBUFR NOP SOURCE BUFFER ADDR ACOUN NOP SOURCE COUNT LUNTR NOP LUN, TRACK NO.FOR RETURN S/TRK NOP # OF SECTORS PER TARACK TCONS OCT 100001 ?WEOF EQU WOUT * SKP *%WRIT WRITES RELOCATABLE RECORDS ON DISK. TRACKS ARE ASSUMED *CONSECUTIVE, CURRENT SECTOR NO. IS ASSUMED AVAILABLE IN BASE *PAGE. RECORD-FORMAT IS AS IN BCS. *CALLING SEQUENCE: * JSB %WRIT * DEF *+3 * DEF BUFFR FWA OF WRITE-BUFFER * DEF RLEN NO OF WORDS * IFN WROVF CCA LDB .A PICK UP JBINS JSB EXEC SET JBINS=-1 DEF *+2 DEF .M19 -19 JSB EXEC DEF *+5 DEF .1+1 +2 = CODE FOR WRITE DEF .1 LUN=1 FOR SYSTEM TTY DEF OVMES FWA OF MESSAGE DEF .M8 -8 FOR 8 CHARS JMP %WRIF,I EXIT FROM %WRIF OR %WRIT.. OVMES ASC 4,JBIN OVF XIF .WRIN NOP IFN LDA 102B JBINC SZA,RSS IS A JBIN TRACK AVAILABLE? JMP WROVF NO, GO TO OVERFLOW ROUTINE CLB LSL 8 SHIFT TRACK NO INTO B ALF,ALF (A)= SECTOR NO STB TRACK XIF IFZ LDA 1766B CURRENT LOAD AND GO FLAG LDB .1+1 2 SSA INB STB WLUN LUN=2 IF SIGN=0, =3 OTHERWISE ALF,ALF RAL AND LMASK A=TRACK # STA TRACK SET TRACK NO. LDA 1766B AND .177 A=SECTOR # XIF STA SECTR LDA .M64 STA BCOUN SECTOR-BUFFER COUNT=-64 LDA BFWA STA BFRAD SECTOR-BUFFER ADDR= FWA BUFFER JMP .WRIN,I IFZ .177 OCT 177 XIF * *%WRIF OUTPUTS THE WRITE-BUFFER TO THE CURRENT SECTOR *ON DISK, UPDATES THE CURRENT SECTOR NO. *%WRIF IS USUALLY CALLED AT THE END OF EACH SUBPROGRAM OUTPUT. %WRIF NOP IFN LDA 101B CPA ..M1 IS JBIN TRACK IN USE? JMP %WRIF,I NO, RETURN FROM %WRIF XIF CLA STA BFRAD,I CLEAR NEXT WORD IN SECTOR JSB EXEC WRITE SECTOR DEF *+7 IFN DEF ..M1+1 -2 = CODE FOR WRITE DEF .1+1 =LUN 2 XIF IFZ DEF .1+1 CODE FOR WRITE=2 DEF WLUN LUN XIF BFWA DEF BUFFR FWA OF BUFFER DEF B100 64 WORDS DEF TRACK TRACK NO DEF SECTR SECTOR NO IFN LDA 102B LGOC WORD INA ISZ SECTR BUMP SECTOR NO LDB SECTR CPB 116B NO OF SECTORS IN TRACK CLB,RSS JMP WRIF2 RRL 8 TRACK NO TO B WRIF1 ADB ..M1 TRK-1 = NEXT JBIN TRK STB TRACK NEW TRACK NO JSB EXEC STATUS REQUEST DEF *+5 DEF .12+4 CODE=+16 DEF .1 1 TRACK DEF TRACK STARTING TRACK NO. DEF STRAK ACTUAL AVAIL GOOD TRACK RETURNED LDA STRAK SZA,RSS OVERFLOW ? JMP WROVF YES LDB TRACK CPB STRAK IS IT A GOOD TRACK? CLA,RSS YES, GO TEST IT FURTHER JMP WRIF1 NO, TRY NEXT LOWER TRACK CPB RTRAK,I IS THE SOURCE FILE ON THIS TRAC? JMP WROVF YES, GO TO JBIN OVERFLOW.. RRR 8 GOOD TRACK TO UPPER A WRIF2 LDB .B =LOC 102B (JBINC) JSB EXEC SET JBINC = TRACK/0 (AT 102B ) DEF *+2 DEF .M19 -19 XIF JSB .WRIN RE-INITIALIZE FOR NEXT WRITE JMP %WRIF,I EXIT * OCT -1 -1= FIRST TIME; %WRIT NOP LDA %WRIT,I STA EXIT SET RETURN ADDR STA %WRIF SET EXIT FROM 'WROVF' IF NEEDED. ISZ %WRIT-1 FIRST TIME IN THIS ROUTINE? RSS NO  JSB .WRIN INITIALIZE IFN LDA 101B JBINS CPA ..M1 NO JBIN LEFT? JMP EXIT,I YES, EXIT XIF ISZ %WRIT LDA %WRIT LDA 0,I RAL,CLE,SLA,ERA TEST I-BIT AND CLEAR JMP *-2 STA WBFAD SOURCE-BUFFER FWA ISZ %WRIT LDA %WRIT,I LDA 0,I CMA,INA STA RCOUN SET COUNT WMOVE LDA WBFAD,I STA BFRAD,I MOVE WORD ISZ BFRAD POINTERS ISZ BCOUN BUMP SECTOR-BUFFER COUNT RSS JSB %WRIF END OF BUFFER, WRITE SECTOR ISZ WBFAD BUMP ISZ RCOUN BUMP COUNTER JMP WMOVE CONTINUE TRANSFER JMP EXIT,I EXIT NOP RETURN ADDR STRAK NOP TEMP FOR NEXT GOOD TRACK NO .M19 DEC -19 TRACK NOP CURRENT TRACK NO SECTR NOP CURRENT SECTOR NO BCOUN NOP COUNT FOR WRITE-BUFFER BFRAD NOP CURRENT ADDR IN WRITE-BUFFER WBFAD NOP CURRENT SOURCE-BUFFER ADDR * SKP *READS SOURCE FROM DISK (IF LUN= 2) OR OTHER DEVICE *CALLING SEQUENCE FOR %READ: JSB %READ * DEF *+5 * DEF LUNIN LUN FOR INPUT * DEF BUFR FWA OF READ BUFFER * DEF RLEN -(NO OF CHARS) * EOF RETURN * NORMAL RETURN *RETURNS WITH: (B) = NO.OF CHARS. %READ NOP LDA %READ,I STA EXIT RETURN ADDRESS ISZ %READ LDA %READ,I STA LUNAD ADDR FOR LUN OF INPUT ISZ %READ LDA %READ LDA 0,I RAL,CLE,SLA,ERA TEST I-BIT AND CLEAR JMP *-2 INDIRECT, GO ON THRU INDIR.CHAIN STA RBFAD FWA OF READ-BUFFER ISZ %READ LDA %READ,I STA RLGTH RECORD-LENGTH ADDR ISZ %READ BUMP RETURN ADDR FOR EOF RETURN LDA LUNAD,I CPA .1+1 READ FROM DISK(LUN=2)? JMP טREAD1 YES JSB EXEC READ FROM OTHER THAN DISK DEF *+5 IFN DEF ..M1 -1 = CODE FOR READ XIF IFZ DEF .1 CODE = 1 FOR READ XIF LUNAD NOP ADDR OF INPUT-LUN OF CONTROL CARD RBFAD NOP ADDR OF READ-BUFFER RLGTH NOP ADDR OF ASKED-FOR RECD LENGTH JMP EXIT,I EXIT READ1 JSB GETWD GET RECORD HEAD ALF,ALF (A)= NO OF WORDS LDB 0 SZA,RSS END OF TAPE ? JMP EXIT,I YES, EXIT WITH (B)=0 SSA EOF ? JMP %READ,I YES, EOF RETURN CMA,INA -( NO OF WORDS IN RECORD) RBL STB SBUFR RECORD LENGTH IN CHARS. LDB RLGTH,I ASKED-FOR RECORD-LENGTH (-) BRS CONVERT TO -(WORD COUNT) STA RCOUN SET CURRENT-RECORD COUNT STB ACOUN SET ASKED-FOR RECORD COUNT JSB GETWD GET WORD FROM DISK STA RBFAD,I WORD TO USER-S BUFFER ISZ RBFAD BUMP BUFFER ADDR ISZ ACOUN BUMP COUNT RSS JMP READ2 READY,FINISH UP ISZ RCOUN BUMP RECORD COUNT JMP *-7 CONTINUE LDB SBUFR RETURN ACTUAL REC. LENGTH IFN JMP EXIT,I RETURN XIF IFZ JMP *+6 XIF JSB GETWD GET NEXT WORD READ2 ISZ RCOUN SKIP TO END OF RECORD JMP *-2 LDB RLGTH,I READY, RETURN ASKED-FOR REC.LGTH CMB,INB COMPLEMENT ASKED FOR CHAR. COUNT IFZ LDA RCODE CODE-WORD TO A XIF JMP EXIT,I GETWD NOP LDA BFRA,I ISZ BFRA ISZ BCOU BUMP BUFFER COUNTER JMP GETWD,I EXIT STA TEMP SAVE A IN TEMP ISZ SECT IFN LDB SECT CPB 116B END OF TRACK ? CLB,RSS YES, SECTOR NO.= 0 JMP GETW1 STB SECT SECTOR NO. = 0 ISZ TRAK BUMP TO NEXT TRACK NUMBER JSB EXEC STATUS CHECK DEF *+5 DEF jJ.M16 CODE= -16 FOR USER AREA STATUS DEF .1 1 TRACK DEF TRAK STARTING TRACK DEF TRAK NEXT GOOD TRACK XIF IFZ LDB .1755 ADB RLUN LDB 1,I CPB SECT END OF TRACK ? CLB,RSS YES, SECTOR NO.= 0 JMP GETW1 STA RCODE SAVE CODE-WORD STB SECT SECTOR NO =0 LSL 8 LUN TO B ALF,ALF STA TRAK SET TRACK NO STB RLUN SET LUN JSB READS READ SECTOR JMP GETWD+1 GET RECORD WORD XIF GETW1 JSB READS READ NEXT SECTOR LDA TEMP RESTORE LAST WORD FROM TEMP JMP GETWD,I READS NOP LDA BFW STA BFRA BUFFER-PNTR.=FWA OF BUFFER LDA .M64 -64 STA BCOU BUFFER COUNTER JSB EXEC READ SECTOR DEF *+7 IFN DEF ..M1 -1 = CODE FOR READ XIF IFZ DEF .1 1= CODE FOR READ XIF DEF RLUN LUN BFW DEF BUFR FWA OF READ BUFFER DEF B100 64 WORDS DEF TRAK TRK. NO. DEF SECT SECTOR NO. JMP READS,I EXIT IFZ NLUN NOP SAVES NEW LUN NTRAC NOP SAVES NEW TRACK RCODE NOP SAVE CODE/WORD IN HERE .1755 OCT 1755 XIF RCOUN BSS 1 CURRENT-RECORD COUNT TRAK NOP CURRENT TRACK SECT NOP CURRENT SECTOR BCOU NOP SECTOR-BUFFER COUNTER RLUN NOP LUN OF CURRENT TRACK BFRA NOP POINTER FOR INTERNAL BUFFER B100 OCT 100 .M64 DEC -64 * *%RDSC READS A SECTOR *CALLING SEQUENCE: LDA CODE * JSB %RDSC * RETURN (A)= LAST WORD IN SECTOR %RDSC NOP LDB ?SECT GET STARTING SECTOR # STB SECT SECTOR NO. CLB LSL 8 SHIFT LUN TO B STB RLUN LUN= 2 OR 3 ALF,ALF STA TRAK JSB READS READ SECTOR JMP %RDSC,I * ?SECT NOP SAVE STARTING SECTOR #(FROM %JFILE). SKP * * ASSEMBLY OPTION FLAGS * * FLAGS DEF *+1 POINTS AT BFLAG BFLAG NOP PUNCH REQUEST LFLAG NOP LIST RFLAG NOP RELOCATABLE ASMBLY(OPTIONAL FLG) TFLAG NOP SYMBOL TABLE PRINT REQ. IFTST NOP CONTAINS 'IF' FLAG(N,Z, OR 0) AFLAG NOP ABSOLUTE ASMBLY. CFLAG NOP CROSS REFERENCE TABLE FLAG LGFLG NOP LOAD/GO FLG(=99 WHEN ON) DRFLG NOP FULL DISC IF NON ZERO TSTRT NOP STARTING TRACK PLINE DEC -56 STANDARD LINE COUNT LUNIN OCT 5 LUN, INPUT (READ CW) EOTIN OCT 705 CW TO SET EOT STATUS LUNPN OCT 104 PUNCH CW(=LUN OF PUNCH) LUNPR OCT 6 PRINTER LUN PRSPC OCT 1106 FUNC CODE TO SPACE PRINTER PNLED OCT 1004 CW TO OUTPUT LEADER/TRAILER ?LWA NOP LAST WORD ADDR. OF AVAIL. MEMORY X DEF TEMP+2340B RELOC LENGTH OF HPAP/RTE/DOS Z DEF TEMP+1550B ABS LENGTH OF RT/DOS ASMB ?NDOP NOP POINTS TO SUPPLEMENTARY OPCODES ?NDSY NOP POINTS TO END OF SYMBOL TABLE HEADP ASC 2, PAG ASCI BSS 3 DEST. OF CONVRTED DEC. NOS. ASCI1 EQU ASCI+1 .TNO ASC 3, # PART OF HEADER HXBUF EQU * HEADER BUFFER. GTEM EQU HXBUF+32 TEMP STORAGE: 'MOVE' & 'PNCH'. BUFFR EQU GTEM+4 DISC-WRITE SECTOR BUFFER. BUFR EQU BUFFR+65 DISC-READ SECTOR BUFFER. B EQU 1 SPC 1 * **** THE FOLLOWING 244B WORDS OF CODE SHOULD NOT BE SHIFTED. **** * **** [ AREA IS OVERLAYED BY HEADER, 'GTEM' & DISC BUFFERS. ] **** SPC 1 .700B OCT 700 D99 DEC 99 .13 OCT 15,77,12 B1100 OCT 1100 .D. ASC 1,D * %WRIN NOP JSB GETRK GET TRACK JMP %WRIN,I ERROR RETURN,NO TRACKS LEFT ISZ %WRIN BUMP FOR NORMAL RETURN JSB WINIT INITIALIZE FOR NEW TRACK JMP %WRIN,I EXIT * SKP *%JFIL GETS SOURCE-FILE CODEWDRD FROM BASE PAGE, FORMS A WORD= *LUN,TRACK AND CALLS %RDIN WITH IT. * %JFIL NOP IFN LDB 124B JFILS: 1RST TRK/SECTR NO. (DOS). LDA .1+1 LUN = 2 RRL 8 TRACK NO TO A BLF,BLF SECTOR NO TO LOW B STB ?SECT SAVE STARTING SECTOR # XIF IFZ LDB 1767B LS PNTR: 1RST TRK/SECTR NO. (RTE). CLA RRL 1 ADA .1+1 LUN=2 OR 3 RRL 8 TRACK # TO A STA RCODE SET CODE-WORD(LUN/TRACK #) XIF STA ?TSTR SAVE FOR PASS 2 CODE WORD JSB ?RDSC JMP %JFIL,I * GOGO CPA .1+1 SOURCE INPUT FROM DISC? JMP ASMJF YES JSB %WRIN NO - INITIALIZE *WRIS CLA ERROR - DISC FULL STA ?TSTR SET STARTING LUN/TRACK SZA,RSS IS THE DISC FULL? ISZ DRFLG YES, SET THE DISC FLAG FOR FULL RSS ASMJF JSB %JFIL INITIALIZE DISC FILE LDA .D. GET CHAR TO LOAD THE DATA JMP SEGMT GO LOAD THE DATA SEGMENT ASMB JSB BM INPUT LUN? JMP *+6 NO CPA .3 IF AUX DISC SPECIFIED (LU 3), LDA .2 FORCE TO LU 2 (FOR %JFIL,ETC.). STA LUNIN SET-UP INPUT LOGICAL UNIT. ADA .700B STA EOTIN SET EOT STATUS CW JSB BM LIST LUN? JMP *+4 NO STA LUNPR YES - SET UP ADA B1100 STA PRSPC SET SPACE CW JSB BM PUNCH LUN? JMP *+5 NO ADA B100 YES STA LUNPN ADA .700B STA PNLED SET LEADER/TRAILER CW JSB BM LINE COUNT? JMP *+3 NO CMA,INA STA PLINE SET LINE COUNT JSB BM LOAD/GO? RSS NO ASMLG STA LGFLG SET FLAG IFN CLA TO SET RTRAK(IN BASE PAGE)=0 LDB RTRAK GET ADDRESS OF RTRAK JSB EXEC DEF *+2 DEF .M19 -19=STORE IN BASE PAGE RSS SKIP OVER RTRAK ADDRESS STORAGE RTRAK OCT 267 ADDRESS OFZ* RTRAK IN BASE PAGE LDA 100B LWA AVAIL. MEM. IN DOS XIF IFZ LDA 1777B LWA AVAIL. MEM. IN REAL TIME XIF STA ?LWA SAVE IT FOR USE IN SEGMENTS STA ?NDOP SET START OF SUPPLEMENTAL OPCODES. CLA STA ?NDOP,I CLEAR START OF SUPPLEMENTAL TABLE. JSB EXEC GO CHECK FOR LIST EQUIPMENT TYPE DEF *+4 DEF .13 STATUS REQUEST DEF LUNPR DEF TEMP LDA TEMP ALF,ALF AND .13+1 MASK OUT EQT TYPE LDB PLINE B=-NO. OF LINES PER PAGE CPA .13+2 IS IT A PRINTER? CLB YES, CLEAR B STB PCOMP SET TTY TEST FLAG. LDA LUNPR GET PRINTER LOGICAL UNIT NUMBER. IOR .200B SET V-BIT(#7) OF CONWORD, TO STA LUNPR REQUEST PRINTING OF 1RST CHAR. CLA,INA STA .1 SET 1 INA STA .1+1 SET 2 INA STA .1+2 SET 3 INA STA .1+3 SET 4 INA STA .1+4 SET 5 INA STA .1+5 SET 6 INA STA .1+6 SET 7 CCA STA ..M1 SET -1 LDA LUNIN GET LUN TO SEE IF IT IS =2. IFN LDB 124B GET SOURCE ORG ON DISC (DOS JFILS). XIF IFZ LDB 1767B GET SOURCE ORG ON DISC (RTE LS PNTR). XIF CPA .2 IS SOURCE INPUT FROM DISC? SZB YES.. IS JFILE IN CORE? JMP GOGO YES, GO COMPLETE INITIALIZATION. LDA *+3 NO, PICK UP DIAG. MESSAGE. LDB *+3 JMP *+3 GO EXIT VIA ERROR DIAGNOSTIC ASC 2,NPRG NO PROG IN JFILE WHEN INPUT=2 JSB MESSX PRINT DIAGNOSTIC JMP ASMEX GO TO COMPLETION SPC 1 * BM NOP LDA B,I GET RUN PARAMETER CPA D99 LOAD/GO? JMP ASMLG YES - DONE INB NO - BUMPPOINTER SZA PARAMETER PRESENT? ISZ BM YES - BUMP FOR L+2V EXIT JMP BM,I * .2 OCT 2 .3 OCT 3 SPC 1 BSS BUFFR-*+129 MAINTAINS SIZE OF SECTOR BUFFER. SPC 1 ?AFLG EQU AFLAG ?ARTL EQU ARTLT ?ASCI EQU ASCI ?ASCN EQU ASCN ?ASII EQU ASCI1 ?ASM1 EQU ASM1 ?ASMB EQU ASMBX ?BFLG EQU BFLAG ?BNCN EQU BNCN ?BPKU EQU BPKUP ?CHOP EQU CHOP ?CHPI EQU CHOPI ?CNTR EQU CNTR ?DCOD EQU DCOD ?DRFL EQU DRFLG ?ENDS EQU ENDSB ?ERPR EQU ERPR ?FLGS EQU FLAGS ?GETA EQU GETA ?GETC EQU GETC ?HA38 EQU HA38 ?ICSA EQU ICSA ?LFLG EQU LFLAG ?LGFL EQU LGFLG ?LINC EQU LINC ?LINS EQU LINS ?LIST EQU LIST ?LOUT EQU LOUT ?LST EQU LST ?LSTL EQU LISTL ?LTFL EQU LTFLG ?LTSA EQU LTSVA ?LTSB EQU LTSVB ?LUNI EQU LUNIN ?LUNP EQU LUNPN ?MESX EQU MESSX ?MOVE EQU MOVE ?MSYM EQU MSYM ?MSYS EQU MSYMS ?OKOL EQU OKOLE ?OPER EQU OPERR ?OPLK EQU OPLK ?ORGS EQU ORGSV ?ORRP EQU ORRP ?PCOM EQU PCOMP ?PKUP EQU PKUP ?PLIN EQU PLINE ?PLIT EQU PLITS ?PNCH EQU PNCH ?PNLE EQU PNLED ?PRNT EQU PRNT ?PRPG EQU PRPAG ?RDSC EQU %RDSC ?RFLG EQU RFLAG ?RLUN EQU RLUN ?RSTA EQU RSTA ?SEGM EQU SEGMT ?SETM EQU SETM ?SUP EQU SUP ?SYMK EQU SYMK ?SYML EQU MSYML ?SYMT EQU SYMTS ?TFLG EQU TFLAG ?TSTR EQU TSTRT ?V EQU V ?WRIF EQU %WRIF ?X EQU X FWA AVAIL. FOR RELOCAT. ASS'YS. ?Z EQU Z FWA AVAIL. FOR ABSOLUTE ASS'YS. SKP * **************************** * * TEMPORARY AND FLAG REGION* * **************************** TEMP EQU * TEMP AT START OF OVERLAY AREA # EQU TEMP SAME AS DATA ORIGIN SPC 1 VAL0 EQU TEMP+1 ASCN - MOST SIGNIFICANT 1/3 VAL0S EQU TEMP+2 ASCN VAL1 EQU TEMP+3 ASCN - MIDDLE 1/3 VAL1S EQU TEMP+4 ASCN VALU EQU TEMP+5 ASCN - LEAST SIGNIFICANT 1/3 VALUS EQU TEMP+6 ASCN DCNT EQU VAL1S ASCN PASCN EQU TEMP+2 NUMBER PNTR SAVE(CHOP) ...1 EQU TEMP+7 .1 EQU ...1 .12 EQU .1+7 ..M1 EQU .12+6 L EQU ..M1+6 .9 EQU #+41B .M8 EQU #+43B .M15 ZXTEQU #+44B BLNK EQU #+46B =40B(LOWER BLANK) .IL EQU #+47B .MBLN EQU #+50B .NO EQU #+51B .OP EQU #+52B .OV EQU #+53B .UN EQU #+54B .1000 EQU #+57B BIT15 EQU #+60B .E EQU #+61B .B EQU #+62B RC EQU #+64B NAMI EQU #+71B LOC'N FOR TEMP SYMBOL STORAGE NAME EQU #+72B FOR USE BY 'OPLK' * * FOLLOWING 5 LOC'S ARE CLEARED IN CHOP ROUTINES * RELC EQU #+76B RELOCATION FLAG SIGN EQU #+77B SUMP EQU #+100B RUNNING SUM FOR 'CHOP' TERM EQU #+101B NO. OF TERMS IN AN OPERAND T EQU #+102B BYFLG EQU #+104B BYTE FLAG FOR 'BREC' FLEX EQU #+105B 'ASCN' MODE EQU FLEX CNTB EQU #+106B CODE EQU #+107B OPCODE TYPE(FROM OPTABLE) DSIG EQU #+110B 'ASCN' FLAG EQU #+111B FLAQ EQU #+112B INST EQU #+113B OPCODE FORMAT LAST EQU #+114B PASS EQU #+115B PASS FLAG(0=PASS 1 AND 1=PASS2) PEEK EQU #+116B LAST CHAR PICKED UP PLCN EQU #+117B PROGRAM LOCATION COUNTER PLEN EQU #+120B LIT LENGTH PASS 1/LIT ORG PASS 2 PNTR EQU #+121B POINTS AT LAST OR CURRENT CHAR. SAVB EQU #+123B SCN1 EQU #+125B STATE LNG/OPCODE/OPERAND/LABEL(4) SYMI EQU #+132B ADDR CNTR FOR SYMBOL TBL (SYMK) FEXP EQU SYMI SYMP EQU #+133B SYMBOL LNG/ AND LOC'N TEST EQU #+135B TEST CHARACTER ENT. EQU #+137B ENTC EQU #+140B ENTV EQU #+141B DEXP EQU ENT. CNVT EQU ENTC ASCN SDSIG EQU ENTV ASCN - SAVE SIGN OF MANTISSA DFCNT EQU ENTV * * I/O STATEMENT BUFFER * IOBF EQU #+142B 50 WORDS + END OF STATEMENT BUFF * * INPUT BUFFER 'BUFF' STARTS IN 11TH WORD * BUFF EQU IOBF+12B PBUF EQU #+225B 60 WORD PUNCH BUFFER SPC 1 END ASMB O!Z =\ 92060-18023 A S C0122 RTE ASMB SEG D              H0101 ASMBҬB̬àŠASSMBҠAP̠95 NAM:ASMBD SU:9060-03 :9060-603 PGM:..H. (éPYGHԠH-PAKADMPANY95.A̠GHS SVD.NϠPAԠƠHSPGAMMAYBŠPHPD PDUDҠANSADϠANHҠPGAMANGUAGŠHUԪ HŠPҠNNSNԠƠH-PAKADMPANY. HDŠASMBD9060-03(éH-PAKADMPANY95. NAMASMBD5999060-603V.A500 NԠASMBD Ԡ?ASMB?BPKU?PKUP?SA?SM?SGM?ASM Ԡ?MSج?GS?AG Ԡ?ج?Z?A?G?SA?S Ԡ?UNɬ?ɬ?NAU?HA3 Ԡ?P?PԬ?NDSY MPAYANDAGGN AU0 BU MPBSS SUPSUPPSSNDDSNG ...Dà356 .Dà356 ..MDà---3--5-6 ̠Ԡ50555355556(+-. .9Dà9 .9Dà9(35B .MDà- .M5Dà-5 .M9Dà-9 BNKԠ0ҠBANKUPPҠ0(0B .̠ASà .MBNASàM .NϠASàN .PASàP .VASàV .UNASàUN BNSASàASɠBANKS ױ0Ԡ6000ADDSSMASK .000Ԡ000 BԱ5Ԡ00000 .ŠԠ05 .BԠ0 DƠ+ADDSSƠ àASà5ŠҠBà .U... NAMɠDƠNAMŠ'NҠMPSYMB̠SAAG NAMŠԠ0000PKUAG UMPSAMŠASDAAGN BSS36ҠMPAYB PASSU+5BPASSAG(0PASSANDPASS PNU+BPGAMANUN PNU+0BԠNGHPASSԠGPASS PNҠU+BPNSAԠeASԠҠUNԠHA. ɯϠSAMNԠBUҠ (NPU(BUƩSASNHD BƠBSS63B50DS+SBU. BUƠUB+B PBUƠԠ00000000SAԠƠPUNHBU(NAMMԩ ASà3 Ԡ00003000000 BSS3SԠƠPUNHBU Ԡ0ADҠBUҠV. Ԡ55ҠASMBHK ASMBDDA?SA MANA SA?S A SAPASSSԠPASSAG0(PASS SB?SAADANDPNԠN̠SAMN SԠҠ'ASMB'NSԠPSNS DABU MANA ADABU+ PAASMBD-55B(..ASMB? MPPSYS N̠SAMNԠҠUNŠ SҠDA.S'N'SAMN' DB.S+ SB?MSؠPNԠMSSAG MP?ASMBASSMBҠ SԠҠN̠PNS(ABìƬ̬NҬԬجZ PSDA.+(5 SAPNҠSԠPNҠ5 ANAZ SAPԠؠҠƠPNUN PUPSB?PKUPGԠNԠHAA PABNKDNŠ? MPGYS SZASSHAҽ0? MPGYS0K PA+MMA? SS-YS- MPSҠ-N- SB?BPKUSKPBANKS DB?GS'NƠN̠HAҠS PA.BB?(PUNH MPBNYS PA.̠?(Sԩ NBYS PA.Ҡ?(.-NԠNSSAY ADB...+YS PA.Ԡ?(SYMB̠ABŠPNԩ ADB...+YS PA.NSԠҠN? ADB...+3YS PA.ZSԠҠZ? ADB.+3YS PA.AA?(ABSUŠASSMBY? ADB.+YS PA.à?(SS.AB? ADB.+5YS PB?ƻGSSKPƠANYPNUND MPSԠNϠNŠMAHSϠA BNSAɠSԠPNAG SZPNҠBUMPPNҠҠNԠHA. MPPUPGϠҠNԠPN .̠ԠASɠ'' .NԠ6'N' .ҠԠ'' .ԠԠ'' .ZԠ3'Z' .AԠ0'A' .àԠ03'' .ؠԠ30'' .ƠԠ06'' PԠDà0''Ҡ''PNUN NؠDà-NGHƠANGPNԠPDŠNS DSNDƠ?P'NƠHD.'د'PDS AS.ɠԠ3ASɠ''ϠNABŠ'د'PDS DSϠDƠ?PԠ'NƠANGPNԠPDŠNS MVàDƠ+ANGPNԠPDŠB.VAUS ADDV Ԡ30060500030530605060 MPSB Ԡ355006050033060500 NDƠANGPNԠNS SKP S.KNP DAPԠADAHPNAG SZASKPƠAG0 MPSҠƠPNԠS NANMNԠVAUŠƠAG SAPԠSAVŠNAGPSN MPS.KɠUN MVŠSBS.KGϠHKGA̠PN DBDSNADBHABŠPN B̬ŬSBBAҠNDԠBԬƠANY. DBBɠPUԠPNҠADD.NB DAAS.ɠADAHASɠ"" SABɠSŠNؠPAԠƠAB DBDSϠADBHSNDABŠPN B̬ŬSBBAҠNDԠBԬƠANY. DBBɠPUԠPNҠADD.NB MVDAMVìɠADSԠD SABɠSŠNAB SZMVàNMNԠϠNԠD NBNMNԠPN SZNؠNMNԠUNԬSKPƠ0 kMPMVUNҠNԠD MPBN+UN SԠPA.ƠSPN MPMVŠYSGϠHANGŠAB PA.ؠSPN MPMVŠYSGϠHANGŠAB MPSҠNϬPNԠN̠SAMNԠ! MVŠSBS.KHKƠƠB DBDSàMVŠN-AUPDŠVAUS B̬ŬSBBAҠNDԠBԬƠANY. DBBɠPUԠPNҠADDSSNB MVDAMVìɠPDŠABŠNASMB.. A̬ŬSAAAҠNDԠBԬƠANY. DAAɠGԠDԠADDSS. SABɠSŠNנVAUŠNϠPDŠB. SZMV NBBUMPABŠPN SZUNؠSABŠA̠MVD? MPMVNϬGϠMVŠANHҠD. MPBN+ UNؠDà-3NGHƠNנAB DSàDƠ?NAUANƠPDŠVAUŠDSN. MVàDƠ+NN-AUPDŠVAUSҠAB. Ԡ53006DV DƠ?HA3 Ԡ006DD DƠ?HA3 Ԡ35006DS DƠ?HA3 Ԡ650506MPY DƠ?HA3 Ԡ0NDƠNנAB SԠҠMPAABYAMNGHŠPNS GDB?AG DA?G SZBSS'A'S? MP+3N SZAYS-S''S? MPSҠYS-N̠N DA?ؠGԠAƠAVAABŠ SZB'A'S? DA?ZYS-GԠAҠABS.ASSMBY. MANA ADA?AA-AAVA̠MM.NA NAANנSYMB̠B̠NGH AҠSYMB̠ABŠ ŠŽ SZBABS.ASSY? ŠYS-Ž0 DB?ZGԠAƠABS̠ASSY. SZSKPƠABS.ASSY. DB?ؠAƠSYMB̠Ϡ'B' SB?NDSYSԠADDSSƠNDƠSYMB̠AB SB?SM NPSԠSYMB̠ABŠϠZ SAԠPASSHŠ DA?UNɠGԠNPUԠUN PA.+SԠHŠDS? SSYS AN SA?ɠSԠƠNPUԠAG... DAױ0 SA?ASMSԠAGҠ'N'PSSNG A SAPASSSԠPASSAGҠPASS SAPNNAZŠPG'NUN SAPNAҠA̠NGHAG DANGԠNGHƠNAMNSNAA. DBADGԠAƠNAMNSN. SB?SMGϠSԠBANKSNϠHŠAA. Ԡ000DUA̠ASɠBANKS. DAABSASG.A̠ҠABSU DB?AGGԠABSU-ASSMBYAG. SZBSSABS.ASSY?-SKPƠU. DA+PKUPDŠҠASMB MP?SGMGϠϠADHŠNԠSGMN ASàASɠ''Ҡ.ASSMBY-'ASMB' ABSAASà3ASɠ'3'ҠABS.ASSMBY-'ASMB3' .SASàSASɠ'S'ҠN̠SM.ҠMSG. ADDƠPBU+AƠNAMNSNAA. NU+(5BNGHƠNAMNSNAA. NDASMBD   ) 92060-18024 A S C0222 RTE ASMB SEG 1              H0102 ASMBҬB̬àŠASSMBҠAP̠95 NAM:ASMB SU:9060-0 :9060-60 PGM:..H. (éPYGHԠH-PAKADMPANY95.A̠GHS SVD.NϠPAԠƠHSPGAMMAYBŠPHPD PDUDҠANSADϠANHҠPGAMANGUAGŠHUԪ HŠPҠNNSNԠƠH-PAKADMPANY. HDŠASMB9060-0(éH-PAKADMPANY95. NAMASMB5999060-60V.A500 NԠASMB NԠ?ɬ?MѬ?NSҬ?HA3Z?NP?P Ԡ?SA?PҬ?MVŬ?HPɬ?PҬ?PԬ?GS Ԡ?ASN?BPKU?MSYM?PKUP?SYMK?HP?NDS Ԡ?D̬?MSYS?SGMì?PNH?V? Ԡ?SA?BG?G?̬?NҬ?PN Ԡ?A̬?ASM?P?BNN?DD?MSج?PN Ԡ?ABŬ?SҬ?Ƭ?DS Ԡ?UNɬ?G̬?PK?NDP?NDSY?NҬ?PPG Ԡ?BPSV?GA?Gì?SYM SUP MPBSS5BSVŠMPAYAA UMPSAMŠASDAAGN VA0UMP+'ASN'AND'SYMK' DNԠUMP+ ...UMP+ .U... .U.+ ..MU.+6 ̠U..M+6 .9U+B .9U+B .MU+3B .M5U+B .M9U+5B BNKU+6B0B(ҠBANK .̠U+B .MBNU+50B .NϠU+5B BNSU+55B BԱ5U+60B .ŠU+6B .BU+6B NAMɠU+B'NҠMPSYMB̠SAG NAMŠU+BҠUSŠBY'PK' SUMPU+00BUNNNGSUMҠ'HP' AU+05B'ASN' NBU+06B DŠU+0BPDŠYP(MPABũ ؠUA(ASN NSԠU+3BPDŠMA ASԠU+B PKU+6BASԠHAҠPKDUP PNU+BPGAMANUN PNU+0BzpԠNGHPASSԠGPASS PNҠU+BPNSAԠASԠҠUNԠHA. SNU+5BSAŠNGPDůPANDAB( SYMɠU+3BADDҠNҠҠSYMB̠B̠(SYMK SYMPU+33BSYMB̠NGAND'N SԠU+35BSԠHAA N.U+3B NàU+0B NVU+B ɯϠSAMNԠBUҠ BƠU+B50DS+NDƠSAMNԠBU (NPUԠBUҠ'BU'SASNHD BUƠUB+B PBUƠBSS60SAVSHŠ'NAM'DN. Ԡ0ADҠBUҠV. NԠUPBUƠD(BKNԠҠBN.D. SPà ASNU?ASN BAGU?BG BPKUPU?BPKU HPU?HP HPɠU?HP NҠU?N PҠU?P GAU?GA GàU?G GU? MVŠU?MV MSYMU?MSYM MSYMSU?MSYS PҠU?P GSVU?GS PKUPU?PKUP PNHU?PNH SAU?SA SYMSU?SYM ؠU? SPà ASMBSBSA DAD PA.+3'HD'SA? MPHYS SA?ASMAҠ'S'AND'N'AGS PA.+(3NAM? MPHɱ NϠNAMҠG DA.NϠ'N'NϠGҠNAMSAMN SBP MPHA3+ HSBNSԬɠGϠϠHDSB MPASMB PSSNAMŠҠBNAYD PNSAVԠ00ҠUSŠN'NAM'SUP HɱDBSN+ SBMSYMMASUŠHŠNAM SBHɱ SAPNSAVSAVŠƠHASNHŠPAAM DBSԠGԠNNUA SBPNSAV+ANDSAVŠ DBSAD SBMVŠMVŠԠϠHŠ'NAM'D HɱNP DAPNSAV+GԠHŠNNUA PA+MMA?(ANHҠPAAM? SSYS MPHɱ6NϠ-GϠSԠҠND DAPNSAVGԠƠHASNUNԠPAAM ADAPN NA SAPNҠhSԠPNҠϠNԠPAAM SBBPKUPSANϠNԠPAAM. SBMSYMMASUŠ SAPNSAVSAVŠƠHASNHŠPAAM AƬA NAҠDMA̠NV AƬAƠPSN SAPAAM.Ҡ'ASN'Ϡ'B'G. DASԠGԠNNUA SAPNSAV+ANDSAVŠ DAPNҠGԠPSNƠNUMB SBASNGϠNVԠHŠNUMB AҠUNSԠ'A'0 SAPB9 SZPB9 MPHɱ+ PB9DƠPBU+9 Hɱ6PABNKGA? SSYS SBPҠNϠ-PNԠ'M' DAPBU+9 SZASSSYPŽ0(SYSM? SAPBU+0YSSԠPY0. SPà NDDNAMDPSSҠ SPà DAPNSAVGԠƠHAS.NUNԠPAAM. ADAPN NASԠPNҠϠNԠPAAM. SAPNҠSAVŠҠBUҠMV. MANAMPUŠHŠNUMBҠ ADASNADDNA̠HAASƠANY. SSANAMŠ? MPHA3N. SAPNSAVYS.SAVŠHAAҠUN. DAPNҠAVŠPNҠϠSA SBGAƠNAMDNSN SBSADSUŠBU. DAPNSAVGԠNUMBҠƠHAAS DBDSADANDDSNANADDSS SBMVŠҠDAAMV. SADNP DAPNSAVNVԠNUMBҠ NAHAAS ASNUMBҠƠDS. AƬAƠPSNϠUPPҠBY. ADANԠMPUŠA̠NAM-àDUN SANԠSAVŠҠPUNHUN. SKP HA3SBSAGϠϠGԠNԠSAMN. DADŠGԠPDŠDN. PA.SԠHŠ'ND'SAMNԠ? MPHB00YSGϠϠ'ND'PSS. PABNK(0BSUPUNS? MPHA3GN-LPASS. PA.3BPAMNԠDŠ? MPHAYSGϠϠP̠PSS. PA.00BUSҠMDŠ(Mé? MPMàYSGϠPSS. ADA..M+(-3 SSAүBG? MPHA6YSUŠϠPSS. PA.BNAM? MPHA63YS ADA..M+(-3 SSA'M''N'Ҡ''? MPNSԬɠUMPϠUNŠDSGNADNNS PA...+'U'? MPHA56ϠU PA.9(BHD? MPHA3GN-PASS. PA.(BSKP? MPHA3GN-PASS. PA.+(5BSP? MPHA3GN-PASS. PA.+(6BSԯUN? MPHA3GN-PASS. SԠҠAB̠D SBAB DADŠPDŠNDA PAD MPHA0'SA'D' PABYԠSԠA'BY'? MPHA0YSGϠPSS. PA.9P? MPHA6YS PA...+6( MPHA5ϠAS PA.6BNGҠAH(HADAũ? MPHA0YS.... PA...+5(6AHMA? MPNSԬɠYSMUMPϠPSS.. ADA.M0-0 SSAԠҠD? MPHA0YS. SZASSBSS? MPHA3MϠBSSPSS. PA...+3(MM? MPHA3̠YSSԠҠA DADŠGԠPDŠ.D.NUMB. ADAM00BSUBAԠ00A. SSASSDŠ<00B? MPMàNϬ'SAMDŠMA. HA3BANAϠADDϠPN NMNԠPGAMN.N. HA3ZADAPNADDUNԠ'N. SAPNSAVŠNנPG.'NUN. MPHA3GϠϠGԠNԠSAMN. .6BԠ6ҠHADAŠAHM SPà PSSBSS  HA3MSBHPɠVAUAŠPAND. MPHA3Ҡ DABϠA MPHA3ZGϠUPDAŠPG.'NUN. HA3̠DAG SZASSA̠PSNԠ? MPHA3BN DANS SASA̠GA̠HNS? MP+3YS SBPҠNϠ'M' MPHA3B SB?PԠPSSA NPGNŠ MPHA3B .BԠ .3BԠ3 .00BԠ00 M00BԠ-00 .M0Dà-0 BYԠԠ3PDŠ.D.N.Ҡ'BY' DؠԠ5PYPŠҠ'D' SADDƠPBU+3PNSAԠPUNHBU DSADDƠPBU+ADD:NAMNSNBU. NGNPAGҠPSSNGNYPNS SBSS SKP PSS'MMN'DAAN MѠDASN+ SAPNҠSԠPN SASԠSԠSԠ(U0. MADBPN SBSYMKGϠϠHKҠVADSYMB. MPHA3Ҡ!GϠϠGԠNԠSAMN. DBPBƱ0ɠSAVŠUNԠM.'N SBSҠSYMB̠ABŠVAU. DBSԠGԠHAAҠNGHŠSYMB. PB+MMA? MPHMYS PBBNKNDƠPAND? MPHMYS'SBANK PB̠ԠPAN? SSYS( MPHA55+N.:SԠPASS SBBPKUPSKPBANKS SBMP+SAVŠPN SBMSYMMASUŠMNGH SAMPSAVŠNUMBҠƠHAAS SBSPNҠAGNPN DAS PA+ԠPAN? SSYS MPHA55+N.SԠPASS! SAPK DBMP DAAS ADB..MNGH-ϠBG PA.BB?(A̠VAUũ SSYS-SKP ADB.0BNϬSԠҠDMA DAMP+ SBASNGϠϠASɠNVSNUN MPHA3Ҡ ADAPBƱ0ɠBUMPNGHƠMMN SAPBƱ0 NSԠ'MMN'SYMB̠NϠABŠ HM3DA...+SԠýMMN DBSVAUŠϠB SBNSҠNSԠSYMB NPҠ DAPK PABNKBANK? MPHA3YSԠϠHA3 PA+MMA? SSYS SBPKUPGԠNԠHA SBNDSSԠҠMNAN MPMA HMSZPBƱ0 SBPKSAVŠS MPHM3 PSS''DAAN PDASN+ SAPNҠSԠPN PADBPN SBSYMKGϠϠHKҠVADSYMB. MPHA3:NVADSYMB̠! DBNҠVAUŠϠB DA...+3(ԠND. SBNSҠGϠϠNSNUN MP+Ҡ SZNҠBUMPԠN DAS SBNDSSԠҠMNAN MPPAGϠBAKH'SANHҠ''!! PSS'N'DAAN NPDA.0BSԠNG0B SANG DASN+ SAPNҠSԠPN NPADBPN SBSYMKGϠϠHKҠVADSYMB. MPHA3:NVADSYMB̠! DA.0BSԠ'U'''DS B SBNSҠNSԠNϠHŠSYMB̠AB NP DAS SBNDSSԠҠMNAN MPNPA NDSNPSԠҠMNAN PABNKƠMNԠҠ MPHA55 PA+MMA? SSYS MPHA55+NԠANҠ SBBPKUPSANϠNԠHA. MPNDS HA55ŠA SANGAҠ'N'AG MPHA3ԠNABANK SPà PN++'A'ϠPNҠ SPNҠNP ADAPN NA SAPNҶ MPSPNҬ .0BԠ0 .0BԠ0 PBƱ0DƠPBU+0BADDSS:NAM-DMMNDAAN. SPà HA63DA.̠NAMSGA̠AҠSA MPHA55+ϠP NS:ADDNYϠHŠSYMB̠ABŬנHAU NKAG:AYPŠBVAUŠNNPUԠ (UPUԩSYMPN.ƠHAS.SYMNNYA ̠SBNSҬɠ +ҠN('S'Ҡ'DD'PND +NMA̠N .NASà3NDDS NSҠNP SAرSAVŠYP SBNAM+3SAVŠVAU SB?SYMKSYMB̠ABŠKUP MPNSNԠUNDGϠϠNS. DBNGAADYH. SZBSSNNYP? MPNSYN ADA..M+3(-HKSYMB̠YP: SSASԠABS̬B.P.ҠM? MPNSàYS NҠDA.N'N':NGYPŬDUPAŠ MPNSؠNŠϠ-DNDSYMB. NSYAND.+6SAŠSYMB̠YP. DBؠGԠUNԠנƠNY. SSBSSUNDNDNYPN? MPNSGN DBرYSGԠUNԠSYMB̠YP PB.+3UANGԠϠN-DNDSYMB? MPNS-YS:'DD'! ADA..M+3NϬHKYP: SSASSABS̬B.P.̬ҠM? MPNҠNVADYPŠҠN! DAرGԠSYMB̠YP. AƬAƠPSNϠBS- ҠؠNUDŠGNA̠DAA AŬAAҠUNDNDB. DBNAM+3SԠVAUŠN SBVA0ɠSYMB̠ABŠNY. MPNS-NSHPSSNG. NSGPA.+6A? MPNSҬɠYS PA...+3? MP+YSS DA.N+NϬ'DD'Ҡ(MUPŠSYMB̩ NSؠSBP MPNSҬɠGԠUԠH PAرAŠBH'S? MPNSҬɠYSAKŠ'DD'Ԡ(ҠAH.MA'S. MP-5GϠϠҠPN NSDAر AƬA ADANAMŠYPŠNSԠD SANAMŠƠNY DBNAM ADBMP+ SBVA0SԠM DA?NDPA-ҠSYMB̠AB MANA ADASYMɠSԠҠSYMB̠B ADAMP+V SSA MP+3N DA.N+'S'SYMB̠ABŠV MPNSؠ'S' DANAM+3MVŠVAU SAɠUP DANAM DB0ɠADDNY(M+6 SBSYMɬɠϠSYMB PAVA0 MPNS5GϠSԠNנNDƠSYMB̠AB. NA SZSYM MP-6 NS5DBSYM SB?NDSYSԠNנNDƠSYMB̠AB. MPNSؠ. NSàDA.000 ҠMP+ SAMP+ɠSԠNYPNԠYP NSؠSZNSҠBUMPԠPNԠҠA+ MPNSҬɠԠH NSԠA̠NϠSYMB̠ABŠ NNP DA?SAGԠ'NƠASɠBU SASYMP+ DA...+6( SAG DBPN SBNSҠNSԠSYMB MPNɠҠN. SZPNBUMPA̠'NN SZN MPNɠ(NMA̩ SKP PSSԠANDDà HA0BNBB PADؠHKDŠҠ'D' ADB.+B3ƠDŠS'D' SBDNԠSԠNUNԠBUMP A SANB SAMP DASN+ SAPNҠSԠPN 640PKUPANDAMNŠAHAAҠ HASBPKUP DBDNԠGԠUNԠBUMP PA+MMA? MPHAYSGϠSANҠNԠPAAM. PB.+SԽ3(..Dة? MPHAYS PA+6PD? MPHAYSGϠSԠ.PN. PA.Š''? MPHAYSGϠSŠƠDMA̠P.AS HAPABNKNDƠSAMN? MPHA9YS MPHA SԠԠPԠAGSKPBANKSҠNԠHAҠ HAA SAMP SBBPKUP DBDNԠGԠ'BUMP'UN MPHA+ ԠPԠSԠҠNUMBҠUSNGBH.ANDŠ HADAMP SZMP SZAŠҠ'.'UNDY? BYSSԠB0. ADBNB(HA+ SBNBADDϠDUN MPHA NDƠNUMàPSUD-PPSSҠ HA9DADN ADANBSԠANϠƠNSϠBŠUSD DBDŠGԠPDŠ.D.N. ŠPPAŠҠMANDҠS. PBBYԠBY? AYSDVDŠBY SZDDBYŠMANNG? NAYSADDϠDUN. MPHA3Z >66 PSSASà(GԠVAUŠƠN HA5DA...+('AS'ND.ҠHP SB?HP MPHA3BҠ SZA MPHA55-NԠABS.VA. SZBSSZϠDS? MPHA55YS-Ҡ ADB.M9-9 DASUMP SSBSKPƠDS MPHA3Z HA55SZPNҠԠ DA.MBN'M'(BADPAND SBPҠϠPNԠҠDAG. MPHA3 SYMK:HKҠAVADSYMB̠ N:ND MàDASN+ SAPNҠMVŠPNҠϠPAND SB?PKHKҠDUPAŠPDŠMNM. MPM0NԠDUPA MPSBPҠ'M'M(PAND SADŠSԠDŠNԠUA̠00B MPHA3 M0DAMP+5SAVŠUSҠMNMN SASDŠSAVŠSԠHAAS DAMP+6 SAMMPSAVŠASԠHAA SԠMNMNàҠAPHANY BYHKNGNԠ3HAAS DA..M+(-3 SAMP M0SBPKUP MANA ADA.00B SSASSVAUŠSSHANA? MPMPYS-ҬNԠAPHA ADA.3B SSAVAUŠGҠHANZ? MPMPYS-ҬNԠAPHA SZMPDNŠHMNMN? MPM0NϠ-GϠGԠNԠHAA DA.+5 SADŠDŽ'ABS'ҠHPPSSNG DA.+SԠAҠMMASP SBVMàGϠPKUPMϠDůSԠPA SANS ASԠAҠNϠMMASP SBVM SSBVAUŠPUS? MPMPNϬŠHAVŠAN ADB.MVAUŠNAANDB SSBSSBSSHAN? MPMPNϠ- ADA.00BYS-SԠUPD PA.00BDŠ00B? DA.30BYS-NϠPAAMSSϠYPŠ30B SAD NנNҠNנPDŠNϠSUPPMNAYPDŠABŠ DA?NDP ADA..M+SԠNנSUPP.PDŠGN SAB MBNB ADB?NDSY SSBPABŠV? MPMñ0N DA.N+YS'S'PABŠV SBP MPHA3 Mñ0SA?NDP DBSD SB;<:6AɠSŠSԠHAS. NA DBMMPPKUP3DHA. ADBDŠNSԠDŠ(0-0 SBAɠS NA DBNSԠSŠMD SBAɠNϠAB MPHA3MPŠPDŠNYNAB. VMàHKSҠMMASNUMSANDYPŠƠUPUԠ MPANDPSS(MDŠANDPAAMҠ. VMàNP SAMSAVŠHPNPUԠPAAM SBPKUP PA+MMA? SSYS MPMPNϠ- SBBPKUPSKPVҠANYBANKS SBSN+SԠPANDAԠNנPAAM DAM SBHPGϠVAUAŠPAAM MPHA3ҠUN SZASVAUŠABSU? MPMPNϠ- DASUMPAANDBVAU MPVMìɠ MNPSAVŠAҠHPNAN .30BԠ30 AU0 BU SDŠNPSAVŠDŠYPůSAVŠSԠPDŠHAS. MMPNPSAVŠ3DPDŠHAA SPà HANGŠ'N.ؠNASMBƠHSPGS.A30B SPà ?MѠUM ?NPUNP ?PUP ?HA3ZUHA3Z ?NSҠUNS AB̠U?AB ?ɠUN SPà NDASMB K< !: 92060-18025 1639 S 0222 ASMB2 SRC              H0102 ASMB,R,B,L,C RTE ASSEMBLER SEPT 1976 * * NAME: ASMB2 * SOURCE: 92060-18025 * RELOC: 92060-16025 * PGMR: C.C.H. * * MODIFIED BY EARL STUTES 1976-09-20-1600 * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1975. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** HED * RTE ASMB2 92060-18025 * (C) HEWLETT-PACKARD COMPANY 1975. * NAM ASMB2,5,99 92060-16025 REV.B 760924 ENT ASMB2 ENT ?ART,?BREC,?LKLI EXT ?DCOD,?GETC,?LINC,?LIST,?LOUT,?OKOL,?OPLK EXT ?SUP,?BPKU,?PKUP,?PNCH,?SYMK,?BFLG EXT ?LFLG,?LTFL,?LTSA,?LTSB,?RSTA,?ERPR,?CHOP EXT ?CHPI,?OPER,?PLIT,?ASCN,?MSYM,?ASM1,?ICSA EXT ?LINS,?ARTL,?LST,?LPER,?PERL,?SETM,EXEC EXT ?LGFL,?BASF,?SYML EXT ?X,?MOVE,?PLIN,?PCOM,?WRIF EXT ?ASCI,?ASII,?PNLE,?ENDS,?ASMB SUP TEMP BSS 225B RESERVE TEMPORARY AREA # EQU TEMP SAME AS DATA ORIGIN VALU EQU TEMP+5 ...1 EQU TEMP+7 .1 EQU ...1 .12 EQU .1+7 ..M1 EQU .12+6 L EQU ..M1+6 .9 EQU #+41B .M8 EQU #+43B .M29 EQU #+45B BLNK EQU #+46B =40B(LOWER BLANK) .IL EQU #+47B ILLEGAL OPERAND MSG CONSTANT 1976-09-20-1500 .NO EQU #+51B .OP EQU #+52B .OV EQU #+53B .UN EQU #+54B BLNS EQU #+55B TW10 EQU #+56B ADDRESS MASK .1000 EQU #+57B BIT15 EQU #+60B .E EQU #+61B RC EQU #+64B RELC EQU #+76B RELOCATION FLAG SIGN EQU #+77B SUMP EQU #+100B RUNNING SUM FOR 'CHOP' TERM EQU #+101B NO. OF TERMS IN AN OPERAND T EQU #+102B BYFLG EQU #+104B BYTE FLAG FOR 'BREC' CNTB EQU #+106B CODE EQU #+107B OPCODE TYPE(FROM OPTABLE) DSIG EQU #+110B 'ASCN' FLAG EQU #+111B FLAQ EQU #+112B INSTv EQU #+113B OPCODE FORMAT LAST EQU #+114B PASS EQU #+115B PASS FLAG(0=PASS 1 AND 1=PASS2) PLCN EQU #+117B PROGRAM LOCATION COUNTER PLEN EQU #+120B LIT LENGTH PASS 1/LIT ORG PASS 2 PNTR EQU #+121B POINTS AT LAST OR CURRENT CHAR. RCNT EQU #+122B SAVB EQU #+123B SCN1 EQU #+125B STATE LNG/OPCODE/OPERAND/LABEL(4) SVST EQU #+131B SYMP EQU #+133B SYMBOL LNG/ AND LOC'N TEST EQU #+135B TEST CHARACTER * * I/O STATEMENT BUFFER * IOBF EQU #+142B 50 WORDS + END OF STATEMENT BUFF PBUF OCT 0,0,0,0 WCNT EQU PBUF WORD(BLK) CNT FOR BIN.RECRD. ASM1 EQU ?ASM1 ASMBX EQU ?ASMB BFLAG EQU ?BFLG CHOP EQU ?CHOP CHOPI EQU ?CHPI ERPR EQU ?ERPR GETC EQU ?GETC LINC EQU ?LINC LIST EQU ?LIST LOUT EQU ?LOUT LST EQU ?LST LTFLG EQU ?LTFL MSYML EQU ?SYML OKOLE EQU ?OKOL OPERR EQU ?OPER RSTA EQU ?RSTA SYMK EQU ?SYMK A EQU 0 B EQU 1 * SKP * ******************* * * CONTINUE PASS 2 * * ******************* ASMB2 LDA ?LPER LENGTH OF 'CLEAR'AREA LDB ?PERL GET ORIGIN OF 'CLEAR' AREA JSB ?SETM GO TO SET MEMORY ROUTINE OCT 0 TO SET MEMORY TO ZERO CLA STA PLCN INITIALIZE PROG LOC'N COUNTER CLA,INA STA PASS SET PASS FLAG JSB RSTA READ CONTROL STATEMENT LDA TW10 STA ASM1 SET FLAG FOR 'INIT' PORTION ASH JSB RSTA READ A SOURCE STATEMENT(NAM?) LDA CODE CPA .12+3 HED? JMP ASH YES, GO PICK UP THE NEXT STATEME STA ASM1 CLEAR 'CS' AND 'INIT' FLAG CPA .12+1 (13) NAM ? JMP HC02 YES, GO TO LIST IT. LDA .NO 'NO'= NO ORG OR NAM STATEMENT JSB ERPR JMP HC05 ERROR EXIT FROM INIT BSS PBUF-*+61 RESERVE REMAINING PUNCH BUFFER * SKP * ****************************** * * SKIP AND SPACE LIST OUTPUT * * ****************************** SKPRk LDB LINC 'SKIP'ENTRY CMB,INB JMP SK2 SPCR JSB CHOPI EVALUATE SPACE COUNT CLB,INB ERROR - SET COUNT=1 SK2 SZB,RSS SPACES=0? JMP HC04 YES, EXIT TO HC04(START OF PASS) LDA ?LFLG NO, START LINE SKIPPING SZA,RSS LIST REQUESTED? JMP HC04 EXIT TO HC04(START OF PASS) LDA LST LST FLAG SZA SUPPRESS LISTING? JMP HC04 YES, EXIT TO HC04(START OF PASS) STB DSIG SET COUNTER LDA LINC CPA ..M1 ON LAST LINE? JMP HC04 YES - EXIT ADB LINC SSB,RSS WILL IT GO TO BOTTOM OF PAGE? JMP *+5 YES,GO TO SKIP TO BOTTOM. STB LINC NO, SAVE NEW LINE COUNT LDA DSIG GET NO. OF LINES TO BE SKIPPED JSB ?LINS GO TO LINE SKIPPER JMP HC04 EXIT TO GET NEXT STATEMENT JSB OKOLE SKIP TO BOTTOM OF PAGE. JMP HC04 EXIT TO GET NEXT STATEMENT * ************************* * * BINARY OUTPUT ROUTINE * * ************************* .M54 DEC -54 OCT 60100 RIC=5, CURRENT PAGE BREC NOP STA EXTFL SAVE FOR EXTERNAL CHECKS. CPA .10B TWO WORD EXTERNAL ? LDA ...1+4 YES, SET RELOC. INDICATOR TO 5 STA SAVB+1 SAVE RELOC'N BYTE LDA BFLAG GET PUNCH REQUEST FLAG ADA ?LGFL LOAD/GO FLAG SZA,RSS WAS PUNCH REQUESTED? JMP BREC,I NO. LDA WCNT SZB RECORD OUT ? JMP HI66 NO. SZA,RSS WCNT=0? JMP BREC,I YES. * * * OUTPUT A RECORD * HI60 LDA WCNT ALF,ALF ROTATE 8 STA WCNT STORE WCNT IN UPPER PBUF LDA SVST,I POSITION REMAIN RELOCATION BYTES ALF,RAR ISZ RCNT JMP *-2 RAL STA SVST,I STORE RELOC.BYTES * * * SET REC.ID CODE (WORD 2) * LDB BREC-1 GET RIC/PAGE INDICATOR CLA,OLINA CPA ?BASF IF BASE PAGE RELOCATABLE, LDB MICRD+2 SET RIC = 060000 . ADB PBUF+1 SET REMAINDER STB PBUF+1 JSB ?PNCH GO TO 'PUNCH' JMP BREC,I AND EXIT * * * PROCESS A BINARY OUTPUT WORD * * DEF PBUF+4 HI66 LDA WCNT SZA FIRST WORD OF RECORD? JMP HI70 -NO- LDB PLCN PLCN TO BREG STB PBUF+3 SET DBL ADDR. STA PBUF+1 SET PBUF+1=0 LDB ...1+3 (4) STB WCNT SET WCNT = 4 LDB HI66-1 STB STOR SET STOR=L(PBUF+4) LDB ..M1+4 (-5) STB RCNT SET RCNT=-5 LDB .M54 -54 STB CNTB SET CNTB FOR WORD COUNT HI70 LDB RCNT CPB ..M1+4 RCNT= -5? JMP HI74 -YES-SET UP ADDRESSES * * * STORE RELOC.BYTE / UPDATE * * HI71 ISZ PBUF+1 UPDATE # OF DATA WRDS LDA SVST,I GET RELOC. BYTE WORD ALF,RAR POSITION FOR NEXT WORD IOR SAVB+1 GET THE NEW BYTE STA SVST,I STORE BACK IN BYTE WORD ISZ RCNT BYTE WORD FULL? JMP HI76 -NO- LDB ..M1+4 -YES- =-5 STB RCNT RESET RCNT TO -5 RAL STA SVST,I LDA CNTB CPA ..M1 RSS ISZ CNTB HI76 LDB INST ISZ WCNT ADVANCE WORD COUNT LDA EXTFL GET TWO-WORD EXT. FLAG. CPA .10B TWO-WORD EXTERNAL ? JMP EXT2 YES, GO TO PROCESS. STB STOR,I NO, STORE INSTRUCTION. ISZ STOR CCE PREPARE FOR BYTE ADDRESS WORD, IF ANY. CPA ...1+4 (5) 2 WORD INSERT? JMP HI77 YES, GO TO PROCESS. CPA .1+5 (6) BYTE ADDRESS ? JMP BYTAD YES, GO PROCESS. JMP HI78 TO EXIT TEST * * * PROCESS 2-WORD EXTERNAL (R = 5) OR BYTE ADDRESS (R = 6) * * EXT2 LDA SIGN GET OFFSET FLAG (EXT ORDN'L) CLE,SZA IS THIS AN EXT W/OFFSET? [E_0] CCE,RSS YES, SET =',1 AND SKIP. LDA SUMP NO: I/O EXT. USE ORDN'L IN SUMP. ALS,ALS POSITION ORDINAL TO BITS 9-2. SEZ MEM. REF. EXTERNAL WITH OFFSET ? IOR INST YES, INCLUDE INSTRUCTION CODE. IOR .1+2 ADD ABSOLUTE 'MR' INDICATOR (3). STA STOR,I STORE FIRST WORD OF PAIR. ISZ STOR ADVANCE PUNCH-BUFFER POINTER. BYTAD LDA SUMP GET OFFSET VALUE, OR BYTE ADDRESS IF ANY. SEZ,RSS MEM. REF. EXT. W/OFFSET OR BYTE ? LDA INST NO,I/O. USE INSTRUCTION. STA STOR,I STORE SECOND WORD OF PAIR. JMP HI77A GO TO COMPLETE THE PROCESS. * HI77 LDA SUMP GET RELOCATABLE VALUE. STA STOR,I AND BRMSK CLEAR UPPER 6 BITS OF 'SUMP' BRS,BRS CLEAR LOWER 2 BITS OF INST BLS,BLS IOR 1 'OR' B TO A STA INST HI77A ISZ WCNT ADVANCE WORD COUNT. ISZ STOR ADVANCE PUNCH-BUFFER POINTER. ISZ CNTB BUMP CNTB RSS JMP HI60 HI78 ISZ CNTB IS THIS THE LAST WORD? JMP BREC,I NO- EXIT JMP HI60 YES- GO TO PUNCH HI74 LDB STOR STB SVST CLA STA SVST,I CLEAR RELOC BYTE WORD ISZ STOR ISZ WCNT JMP HI71 STOR BSS 1 BRMSK OCT 1777 .10B OCT 10 EXTFL NOP TWO-WORD EXTERNAL FLAG. SKP HC02 LDA ...1+1 LIST PARAMETER HC03 JSB LIST * * * READ NEXT STATEMENT * HC04 JSB RSTA READ NEXT STATEMENT * * * TEST MNEMONIC CODES FOR PROCESS TYPE * HC05 LDA CODE LDB INST SZA,RSS (0) ORB ? JMP HC42 YES. CPA .100B CODE = 'MIC' ? JMP X39 YES, GO LIST IT. ADA M100B SUBTRACT 100 OCTAL SSA,RSS CODE >100B ? JMP XMIC YES, ITS A MICROCODE MACRO. LDA CODE GET OPCODE I.D. NO. AGAIN. CPA L+3 (43) SOC OR SOS ? JMP HC28 YES AND .M8 (177770) CPA L I/O ?  JMP IOPR YES ARS,ARS SHIFT A RIGHT 4 BITS ARS,ARS CPA .1+2 60/70(MICRO-OP?) JMP MICR YES LDA CODE GET JUMP TABLE ADDRESS ADA CODLC ADD OPCODE INCREMENT JMP A,I JUMP TO PROCESSOR .100B OCT 100 M100B OCT -100 * * * PROCESS MEMORY REFERENCE INSTRUCTIONS * MEMRY LDA INST LDB LTFLG SZB LITERAL PRESENT? JMP HCY YES AND ..M1+1 NO, CLEAR LDSB OF 'INST' STA INST LDA .I SET FOR INDIRECT BIT LDB BIT15 INDIRECT BIT MASK(100000B) JSB CHOP JMP HC17E ERROR EXIT HCX STB SUM. OPERND VALUE CLB LIST PARAMETER=0 HCXL STB TERM SAVE THE LIST PARAMETER LDB SUM. GET THE OPERAND VALUE * * * RELOC.CODE IS IN RELC * SZA ABS? JMP HC11 NO ADB TW10 YES, SUBTRACT 2000B. SSB,RSS IS THE OPERAND LESS THAN 2000B? JSB OPERR NO, IT'S AN "M" TERM ERROR HC11 LDA SUM. LDB CODE CPB .12+4 (16) DEF? JMP HC14A YES, GO CHECK FOR EXT W/OFFSET. LDA RELC CPA ...1+1 (2) B.P. RELOCATABLE ? JMP *+3 YES. SZA ABSOLUTE? JMP HC15 NO SPC 1 * * TEST FOR OPERAND >1023 * SPC 1 LDA SUM. ADA TW10 (176000) SSA,RSS JMP OI.SP LDA INST CLEAR AND CBIT CURRENT-PAGE BIT [MASK=175777] STA INST JMP HC14 SPC 1 * * TEST FOR OPERAND & INSTR IN SAME PAGE * SPC 1 OI.SP LDA RELC CPA ...1+1 (2) B.P. RELOCATABLE ? JMP HC13 YES, ERROR. LDA PLCN AND TW10 CMA,INA ADA SUM. AND TW10 SZA,RSS JMP *+3 HC13 LDA .OV 'OV' ERROR. JSB ERPR LDA BRMSK STRIP UPPER SIX BITS. AND SUM. STA SUM. HC14 LDA RELC eCPA ...1+1 (2) B.P. RELOCATABLE ? JMP HC15+2 HC14A LDA SIGN GET OFFSET FLAG (EXT ORDINAL). SZA IS OPERAND EXT W/OFFSET ? JMP HC17A YES, IGNORE ORDN'L FOR NOW. LDA SUM. NO, GET OPERAND VALUE. LDB CODE GET OPCODE ID NUMBER. CPB .12+4 ARE WE PROCESSING A 'DEF'(16B) ? JMP HC17 YES, SET UP ADDRESS FOR 'BREC'. HC14B LDA SUM. NO, GET OPERAND VALUE; AND BRMSK MASK TO FORM ADDRESS, AND JMP HC17 INSERT INTO INST. HC15 CPA .1+3 EXTERNAL ? (4) JMP HC14A YES, GO CHECK FOR OFFSET. LDB ...1+4 (5) STB BYFLG LDB BFLAG GET THE PUNCH FLAG ADB ?LGFL LOAD/GO FLAG SZB,RSS PUNCH REQUESTED? JMP HC14B NO, GO TO SET ADDR INTO INST ADA ..M1 FORM 'MR' INDICATOR FOR OPERAND HC17 IOR INST STA INST SET LOADER FLAG LDA SIGN GET OFFSET FLAG. HC17A LDB .10B GET TWO-WORD EXT INDICATOR. SZA EXTERNAL W/OFFSET IN PROCESS ? STB BYFLG YES, SET FLAG FOR BREC. * * * SET UP FOR DCOD* LDA RELC HC19 JSB ?DCOD * * * OUTPUT A BINARY WORD * STB SAVB CLB,INB JSB BREC * * * OUTPUT A LINE FOR LISTING * LDA INST GET INSTRUCTION PATTERN. LDB SIGN GET OFFSET FLAG. SZB PROCESSING MEM. REF. W/OFFSET? IOR B YES, INCLUDE EXT ORDN'L NO. STA INST SAVE INSTRUCTION FOR LISTING. LDB SAVB GET RELOC. CHARACTER. LDA TERM GET THE LIST PARAMETER JSB LIST GO TO LIST THE LINE. LDA SIGN GET OFFSET FLAG. SZA,RSS PROCESSING MEM. REF. EXT W/OFFSET ? JMP HC20 NO, GO TO ADVANCE LOC'N COUNTER. LDA SUM. YES, GET OFFSET VALUE. STA INST SAVE IN INST FOR LISTING. LDB PLUS SET = ASCII: +BLANK. LDA .1+5 6=LIST CODE FOR INSTRUACTION ONLY. JSB LIST GO TO LIST OFFSET VALUE. HC20 ISZ PLCN ADVANCE LOCATION COUNTER. JMP HC04 GO TO READ NEXT STATEMENT. PLUS ASC 1,+ OFFSET LIST INDICATOR. * ***************** * * BSS PROCESSOR * * ***************** BSSP JSB CHOPI EVAL. OPERAND JMP HC02 ERROR SZB,RSS B=0? JMP HC02 YES CLB B=0 JSB BREC CLA A=0 LDB BLNS NO RELOC. INDIC. JSB LIST LDA SUMP PICK UP BLOCK LENGTH FOR PLCN ADA PLCN STA PLCN JMP HC04 EXIT * SKP * ************************ * * PROCESSOR JUMP TABLE * * ************************ * CODLC DEF *,I DEF HC42 ORG 1 DEF HC42 ORR 2 DEF X39 *COM 3 DEF X39 *ENT 4 DEF X39 *EXT 5 DEF INST,I *ARITH 6 DEF NUMP ASC 7 DEF NUMP DEC 10 DEF NUMP OCT 11 DEF BSSP BSS 12 DEF EQUP EQU 13 DEF FIN2 END 14 DEF X39 *NAM 15 DEF MEMRY MEMORY 16 DEF X50 HED 17 DEF MEMRY DEF 20 DEF HC26 ABS 21 DEF SKPR SKP 22 DEF SPCR SPC 23 DEF X54 LST/UNL 24 DEF NUMP DEX 25 DEF HC70 HDW ARITH 26 DEF HC80 HDW SHIFT 27 DEF HC30 CLO ETC 30 .I OCT 111 ASCII 'I' 31 DEF RPLP RPL 32 CBIT OCT 175777 33 M17 DEC -17 34 DEF X52 REP 35 .JSB OCT 16000 36 .C OCT 103 ASCII 'C' 37 DEF X56 SUP/UNS 40 DEF BYTE DBL 41 DEF BYTE DBR 42 DEF BYTEG BYT 43 SUM. BSS 1 DEX OCT 25 'DEX' OPCODE TYPE SKP * *q***************************** * * ARITHMETIC MACRO PROCESSOR * * ****************************** ART JSB SYMK GO TO SYMBOL TABLE LOOKUP RSS ERROR RETN(UNDEF) JMP *+4 NORMAL RET'N LDA .UN 'UN'= UNDEFINED SYMBOL JSB ERPR CLB SET B = 0 ADB .JSB 'JSB' INSTRUCTION MASK STB INST LDA ...1+3 (4) A=EXT JSB BREC PUNCH LDB RC+4 ' X' CLA * ********************************************** * * PROCESS THE 'DEF' FOLLOWING THE FIRST WORD * * * OF AN ARITHMETIC PAIR * * ********************************************** ARTX JSB LIST GO TO LIST FIRST WORD LDA .12+4 (20B) STA CODE =DEF CLA STA INST CLEAR INST LDA LTFLG SZA LITERAL PRESENT? JMP ALTR YES LDA .I SET UP FOR INDIRECT BIT LDB BIT15 MASK= 100000B JSB CHOP NOP ALTZ ISZ PLCN BUMP LOCATION COUNT STB SUM. SAVE OPERAND VALUE LDB .1+3 LIST PARAMETER=4 JMP HCXL ALTR LDA ?LTSA PICK UP LDB ?LTSB LITERAL PARAMS. JMP ALTZ FROM LKLIT * * * LITERAL PROCESSING * * HCY SLA,RSS LSB OF INST INDIC LITERAL POSSIBLE JMP HCZ NO, ERROR AND ..M1+1 CLEAR LSB OF INST STA INST JSB ?PLIT JMP HCZ+1 ERROR EXIT JMP HCX HCZ JSB OPERR 'M' ERROR HC17E CLA LIST PARAMETER =0 STA TERM SAVE IT JMP HC17 * SKP * * * PROCESS 'ABS' OPCODE * * HC26 JSB CHOPI GO EVALUATE OPERAND JMP HP2D ERROR STB INST JMP HP2D OK.. * * * OUTPUT BIN RECRD AND/OR LIST LINE * * HC30 JSB LOUT JSB LIST * * * ADD 1 TO PROG. LOCN. CNTR. * ISZ PLCN BUMP LOCATION CNTR JMP HC04 * X39 CLA,INA 1 TO A JMP HC03 * * * ORG,ORB,ORR PRE-PROCESSOR * * HC42 CLB OUTPUT A JSB BREC RECORD JSB INST,I JUMP TO CORRECT SUBROUT. JMP HC02 BACK TO START LIST X50 LDA ?LFLG GET THE LIST FLAG SZA,RSS IS LIST FLAG OFF? JMP HC04 YES - GO TO NEXT STATEMENT JSB INST,I TO HEADER SUBROUTINE LDA LST SZA,RSS IS LIST FLAG ON? JSB OKOLE YES, SPACE TO BOTTOM OF PAGE JMP HC04 GET NEXT STATEMENT X52 JSB INST,I TO REPSB JMP X39 X54 STB LST SET LST/UNL FLAG JMP HC04 BYPASS LISTING FOR 'LST/UNL' X56 STB ?SUP SET 'SUP/UNS' FLAG JMP X39 SPC 1 * * PASS 2 'EQU' PROCESSOR * * EQUP JSB CHOPI EVAL. OPERAND CLB ERROR EXITS LDA PLCN STA SUMP SAVE PLCN VALUE STB PLCN SET PLCN=0 LDA ...1+1 (2) LIST 'EQU' JSB LIST LDA SUMP REPLACE PLCN VALUE STA PLCN JMP HC04 HC70 LDA LTFLG GET LITERAL FLAG SZA ARE LITERALS PRESENT? JSB ?ARTL YES, GO TO LITERAL PROCESSOR JSB LOUT OUTPUT THE ARITH INSTRUCTION JMP ARTX GO PROCEESS THE 'DEF' PORTION.. HC80 JSB CHOPI GO EVALUATE THE COUNT JMP HC84 BAD COUNT EXIT ADB M17 B-17 SSB B GRTR THAN 16? CPB M17 NO. IS B=0? JSB OPERR YES, IT'S AN 'M' ERROR,. LDA SUMP GET THE SHIFT OR ROTATE COUNT.. AND .12+3 MASK OUT LOWEST 4 BITS HC82 ADA INST MAKE UP THE FINAL INSTRUCTION STA INST JMP HC30 GO AND OUTPUT THE INSTRUCTION HC84 CLA SET COUNT FOR 16 BIT SHIFT ROTATE JMP HC82 SPC 1 * ************************ * * PASS 2 RPL PROCESSOR * * ************************ RPLP LDA SCN1+3 CHECK FOR LABEL. SZA PRHESENT ? JMP *+4 YES, GO EVALUATE THE OPERAND. LDA .LB NO, GET ERROR MNEMONIC 'LB'. JSB ERPR GO TO INDICATE THE ERROR. RSS CLEAR THE INSTR. FIELD FOR LIST. JSB CHOPI GO TO EVALUATE THE OPERAND. CLB * ERROR * SET OPERAND =0. STB INST SAVE OPERAND VALUE FOR LIST. LDA .1+6 (7) LIST WITHOUT LOCATION. LDB SBLN ASCII:S-BLANK (SUBSTITUTION) JMP HC03 GO TO LIST THE STATEMENT. .LB ASC 1,LB ASCII 'LB' NO-LABEL ERROR CODE. SBLN ASC 1,S REPLACEMENT CODE INDICATOR: 'S'. * SKP * ************************* * * OCT/DEC/ASC PROCESSOR * * ************************* NUMP LDA SCN1+2 STA PNTR SET POINTER LDA ..M1 STA T+1 SET FPAS=-1 LDA CODE CPA ...1+6 (7) JMP ASCR HE06 LDB PNTR PNTS AT 1ST CH OF NUMBER STB SIGN CLB STB CNTC INB STB RELC * * * TEST CHARACTER FOR TERMINATOR * HE08 LDA PNTR JSB GETC STA TERM CPA L+4 COMMA? JMP HE12 YES CPA BLNK BLANK? JMP HE12 YES * * * UPDATE CHAR.CNTR(CNTC) AND POSN. PNTR(TLOC) * LDB CODE CPB .9 OCT? JMP HE10+1 YES CPB DEX 'DEX'? JMP HE11 YES LDB ...1+1 (2) NOT OCTAL CPA L+6 PERIOD? STB RELC YES, SET RELC = 2 CPA .E 'E' ? HE10 STB RELC YES, SET RELC FOR USE AS ASCN MD ISZ CNTC ISZ PNTR BUMP PNTR JMP HE08 HE11 LDB .1+2 SET B=3 FOR DEX MODE JMP HE10 * * * SET UP VALUE FOR LIST AND/OR PUNCH * HE12 LDA CODE CLB CPA .9 OCT? JMP *+3 YES LDB RELC NOT OCT BLF,BLF ADB CNTC LDA SIGN JSB ?ASCN GO TO 'ASCI' CONVERSION CLA SET A=0 STA INST STB SUMP STORE VALUE LDA VALU SAVE LEAST SIG PART OF 'DEX' STA SIGN HE18 JSB NOUT LDA RELC ARS,SLA IS RELC = 0 OR 1? JMP HE20 NO, ITS 3 OR 2 LDA TERM CPA BLNK JMP HC04 EXIT ON BLANK ISZ PNTR BUMP PNTR JSB ?BPKU SCAN OVER BLANKS LDA PNTR TEST FOR EOL 1976-09-20-1500 CMA,INA ADA SCN1 THE RECORD CHARACTER COUNT SSA,RSS JMP HE06 MORE DATA FOLLOWS LDA .IL SOMETHING IS NOT GOOD JSB ?ERPR TELL EM KEMO SABE CLA MAKE A NOP STA INST AND JSB NOUT DUMP IT JMP HC04 BUG OUT, U DONE HE20 LDA SUMP STA INST VALUE TO INST LDB RELC CPB .1+2 IS RELC=3? JMP HE22 YES- SET SUMP FOR 3RD WORD CLA HE21 STA RELC SET RELC FOR NEXT TEST JMP HE18 * HE22 LDA SIGN STA SUMP VALU TO SUMP LDA .1+1 FOR SETTING RELC=2 JMP HE21 * *************************** * * OCT DEC ASC WORD OUTPUT * * *************************** NOUT NOP CLA SET A=0 FOR 1ST LINE OUTPUT ISZ T+1 SKIP FOR 1ST LINE OF OUTPUT. LDA ...1+3 (4) SET A=4 FOR LIST LDB BLNS JSB LIST CLA CLB,INB JSB BREC PUNCH ISZ PLCN BUMP LOCN CNTR. JMP NOUT,I EXIT * ******************** * * PROCESS ASC HERE * * ******************** ASCR LDA ...1+1 (2) INDIC.'ASC' JSB CHOP GO EVALUATE WORD LENGTH JMP HC30 * ERROR EXIT SZA VALUE ABSOL.? JMP HP2D-1 NO; * ERROR * SZB,RSS ASKING FOR ZERO WORDS ? JMP HP2D-1 YES, * ERROR * ADB .M29 (-29)(VALUE IS IN SUMP TOO) SSB,RSS VAL.>28? JMP HP2D-1 YES; * ERROR * LDA PNTR STA T LDA SUMP #;NLH CMA,INA STA CNTC VALUE(COMPL.) TO CNTC * * * PICK UP WORDS AND STORE INTO PROGRAM * SB ISZ T LDA T JSB GETC ALF,ALF STA TEST ISZ T LDA T JSB GETC STA INST * * * OUTPUT 2 ASCI CHARACTERS * JSB NOUT CLA STA TEST ISZ CNTC JMP SB JMP HC04 DONE, GO GET NEXT STATEMENT * ************************* N* * PROCESS I/O GROUP HERE * * ************************** RAM OCT 105000 OCT 177400 I/O MASKS OCT 300 IOPR LDA SCN1+2 IS OPERAND SZA PRESENT? JMP P YES! LDA CODE NO OPERAND. CPA L+1 'HLT'? JMP HP2D * * * OPERAND ERROR EXIT HERE * JSB OPERR (HP2D-1) HP2D CLA STA TERM SAVE THE LIST PARAMETER JMP HC19 P LDA .C TEST FOR 'CLEAR FLAG'(C). LDB .1000 GET 'C' MASK FOR IO INSTR. JSB CHOP JMP Q ERROR EXIT SZA,RSS ABSOLUTE? JMP ABSL YES, GO PROCESS. CPA .1+3 EXTERNAL I/O OPERAND? ALS,SLA YES, SET TO 10 FOR BYFLAG. JMP R NO. ERROR! STA BYFLG SET BYFLG. LDA INST GET UNCONFIGURED INSTRUCTION. LDB SIGN GET THE OFFSET FLAG. SZB,RSS EXTERNAL I/O WITH OFFSET ? JMP IOEX NO, SINGLE EXTERNAL TERM. ADA SUMP YES. ADD OFFSET TO INSTRUCTION. STA INST SAVE THE MODIFIED INSTRUCTION. STB SUMP PUT EXT ORDN'L IN SUMP FOR BREC. IOEX CLB CLEAR LIST PARAMETER STB TERM TO LIST WHOLE LINE. STB SIGN SET EXT I/O FLAG FOR BREC. JMP HC19-1 OUTPUT BINARY; LIST LINE. ABSL LDA SUMP GET I/O OPERAND. LDB INST LOAD B WITH INSTRUCTION FORMAT ADA IOPR-2 MASK WITH 177300 CPB RAM IS IT A RAM INSTR RSS SKIP IF YES ADA IOPR-1 FINISH MASK IF NOT RAM LDB SUMP RESTORE B CONTENTS * * * TEST FOR VALUE>63 * SSA JMP *+4 VAL>64 LDA .OV 'OV' ADDRESS OVERFOLW JSB ERPR Q CLB ADB INST STB INST JMP HP2D R JSB OPERR 'M' ERROR - RELOC.I/O ADDR. JMP Q * * * PROCESS SOC OR SOS HC28 LDA SCN1+2 PNTR TO OPERAND LDB 0 A TO B JSB ?MSYM  ADA ..M1 SZA JMP HP2D LDA LAST CPA .C IS 'C' PRESENT? JMP *+2 YES JMP HP2D NO * * * 'OR' 1 TO BIT 9 (C BIT) OF I/O INST * LDA INST IOR .1000 MASK IN CURRENT BIT STA INST JMP HP2D * ********************** * * MICRO-OP PROCESSOR * * ********************** CNTC BSS 1 INSV EQU SUM. MICRD OCT 7777,4000,60000,60,71,14000 * * * INITIALIZE FLAGS * MICR CLA STA CNTC =0 WHEN CLE APPEARS STA TERM BITS 12-11 = 1 IF B REG * BITS 12-11 = 2 IF A REG STA TEMP+4 BITS 14-13=1 IF SRG; =2 IF ASG STA INSV USED TO ACCUMULATE THE CODE STA FLAG STA TEST CLEAR CHAR TESTER * * START HERE FOR EACH NEW CODE * * F LDA INST UNPACK THE MICRO-OP CODE * *THE FORMAT IS: BITS 14-13=1 IF SRG,2 IF ASG, 0 IF EITHER. * BITS 12-11=1 IF BREG,2 IF AREG, 0 IF NEITHER. * BITS 11-0 = ACTUAL 12 BIT CODE AND MICRD EXTRACT OPCODE STA FLAQ SAVE IT (=+2) LDA CODE THIS IS THE GROUP NUMBER. CMA,INA MAKE SURE'IT'S BIGGER THAN THE LAST ADA FLAG A=(LAST GRP)-(PRESENT GRP) SSA JMP O SEQUENCE IS OK * * * IF PRES GRP IS GO WE CAN CHANGE IT AND MAY BE OK LDA CODE CPA MICRD+3 IS CODE TYPE = 60B (MICRO-OP)? JMP *+4 CHANGE ERROR GROUP AND OP CODE MERR LDA .OP 'OP' FOR OPCODE ERROR JSB ERPR RETURN JMP HP2D LDA MICRD+4 71B, CHANGE GROUP (FROM *-4) STA CODE TO 71 * * * MOVE BITS 8-5 OF OPCODE TO BITS 4 AND 2-0 * LDA FLAQ AND MICRD+1 SET A/B BIT STA 1 SAVE IN B. XOR FLAQ ALF,ALF MOVE TO BITS O AND 15-13 RAR,SLA MOVE BIT 0 TO INA BIT 1. ALF,RAR ROTATE LEFT 3 TO BITS 4,2-0 IOR 1 PUT IN THE A/B BIT JMP F+2 O LDA CODE STA FLAG SET LAST GRP TO PRESENT GRP * * * CHECK REGISTER CONSISTENCY * LDA INST AND MICRD+5 GET BITS 12-11 IOR TERM CPA MICRD+5 IF EQUAL, THERE'S A REGISTER JMP MERR INCONSISTENCY. STA TERM NEW REGS TO REGS, * * * OTHERWISE CHECK GROUP CONSISTENCY * LDA INST AND MICRD+2 BITS 14-13 IOR TEMP+4 CPA MICRD+2 IF EQUAL,THERE ARE 2 CODES JMP MERR FROM DIFFERENT GROUPS. STA TEMP+4 * * CHECK FOR CLE * LDA FLAQ SZA,RSS ISZ CNTC * * * NOW 'OR' THE CODE INTO CURRENT CODE SO FAR * IOR INSV STA INSV * * * GET THE NEXT CHARACTER * LDA SCN1+1 OPCODE PNTR ADA ...1+2 (3) STA PNTR POINTS AT POS'N FOLLOWING OPCODE JSB ?PKUP CPA BLNK IS THIS CHAR. A BLANK ? JMP *+7 IF SO, WE'RE DONE. CPA L+4 COMMA ? JMP *+2 JMP MERR INVALID CHAR.-'M' ERROR ! * * * GET THE NEXT OPCODE * JSB ?OPLK OPCODE LOOKUP JMP HP2D JMP F * * * TO FINISH TEST CLE; IF USED AND IN ASG SET, ADD 40 * * TO THE CODE. LDA TEMP+4 (FROM *-7) ALF,ALF SZA,RSS IOR BLNK (40B) LDB CNTC SZB,RSS CLA IOR INSV STA INST JMP HP2D * ******************************** * * SEARCH SYMBL TBL FOR LITERAL * * ******************************** LKLIT NOP LDA ?ICSA GET LOC'N OF ASCI BUFFER STA SYMP+1 STA LTFLG SET LTFLG#0 JSB SYMK SYMBOL TABLE LOOKUP ROUTINE CLB ERROR RETURN ADB PLEN ADDR OF LITERAL CLA,INA A=1 STB SUMP STA RELC JMP LKLIT,I LKLIT EXIT *A * .13B OCT 13 SCODE NOP SAVE CODE-100B FOR XMIC PROCESS ROTFL OCT 125252 ODD/EVEN FLAG LMASK OCT 377 UMASK EQU RAM+1 177400B * * ************************************ * * GENERATE A STRING OF BYTES. * * * OCTAL NUMBERS ONLY * * * -377 >= NUMBER <=+377 * * ************************************ * BYTEG LDA SCN1+2 START INITIALIZATION STA PNTR SET PNTR TO 1ST BYTE LDA ..M1 STA T+1 SET FIRST LINE LIST OUTPUT FLAG LDA ROTFL STA SCODE SET RIGHT/LEFT ALTERNATOR * BYT01 LDB PNTR STB SIGN SAVE START OF BYTE CLB STB CNTC INITIALIZE CHARACTER COUNT * BYT03 LDA PNTR GET A CHARACTER JSB GETC STA TERM SAVE IT CPA L+4 COMMA? (END OF BYTE) JMP BYT05 YES GO PROCESS A BYTE CPA BLNK BLANK? (END OF BYTE AND STRING) JMP BYT05 YES GO PROCESS A BYTE * ISZ CNTC BUMP CHAR. COUNT ISZ PNTR BUMP CHAR. POINTER JMP BYT03 GO GET NEXT CHAR. * BYT05 LDB CNTC B=CHARACTER COUNY LDA SIGN A = POINTER TO BYTE JSB ?ASCN CONVERT BYTE TO OCTAL NUMBER CLA ERROR RETURN - SET A=0. STA B SAVE VALUE IN B AND UMASK SZA GRTR THAN 377B? CPA UMASK MAYBE - TEST FOR GOOD NEG. VALUE JMP *+3 NUMBER IS OK JSB OPERR ERROR CLB LDA B AND LMASK LDB SCODE RBR,SLB LEFT BYTE BEING PROCESSED? JMP BYT10 YES STB SCODE SAVE LEFT/RT FLAG ADA INST NO - SET UP TO GENERATE A WORD STA INST BYT06 JSB NOUT OUTPUT A WORD TO LIST/PUNCH LDA TERM GET LAST CHAR. TESTED CPA BLNK BLANK? (END OF STATEMENT) JMP HC04 YES - EXIT JMP BYT12 NO - GO START NEXT BYTE * SKP BYT10 ALF,ALF PROCESS LEFT4 BYTE STA INST PLACE IN UPPER 'INST' STB SCODE SAVE LEFT/RT FLAG LDB TERM CPB BLNK LAST TERM IN STRING? JMP BYT06 YES - GO OUTPUT IT BYT12 ISZ PNTR NO - START NEXT BYTE JSB ?BPKU JMP BYT01 * * ********************************************************** * * PROCESS BASE SET EXTENSION AND MEMORY EXPANSION CODES * * ********************************************************** * XMIC STA SCODE SAVE CODE-100B CMA,INA STA OPNUM START ON PARAMETER COUNT ADA .1+6 (7) SSA,RSS CODE GRTR THAN 107B? JMP PROCX NO - OPNUM OK LDB ..M1 B = -1 CPA ..M1+5 (-6) CODE = 115B? (BITS INSTRUCTION) ADB ..M1 B = -2 STB OPNUM PROCX JSB LOUT OUTPUT MICROCODE TO BINARY JSB LIST LIST MICRO SOURCE STATEMENT LDA PLCN SAVE LOCN CNTR AT INSTRUCTION STA STAR PSEUDO LOCN CNTR STA STARX ORIGINAL LOCATION ISZ STAR BUMP PSEUDO COUNTER ISZ PLCN BUMP PROGRAM LOCATION COUNTER PROC1 LDA .12+4 STA CODE SET CODE = 20B (DEF) LDA STARX RESET PLCN TO INSTRUC LOCN STA PLCN CLA STA INST CLEAR INSTRUCTION STA BYFLG AND BYFLG LDA SCODE A=ORIGINAL CODE(-100B) LDB LTFLG SZB LITERAL? JMP PROC7 YES CPA .13B NO - IS CODE = 113?(NO INDIRECT) JMP PROC2 YES LDB BIT15 NO LDA .I JSB CHOP EVALUATE OPERAND JMP PRERR+1 ERROR JMP *+3 PROC2 JSB CHOPI EVALUATE OPERAND WITH NO',I' JMP PRERR+1 ERROR SZA ABSOLUTE VALUE? JMP *+4 NO ADB TW10 YES (VAL-2000B) SSB,RSS GRTR THAN 1777B? JMP PRERR YES,ERROR CPA .1+3 (4) EXTERNAL SYMBOL? RSS YES JMP PROC4 NO LDB SCODE CPB .1`3B CODE = 113B? (JPY) JMP PRERR YES - ERROR * PROC4 LDA PNTR STA SCN1+2 RESET POINTER LDA SIGN SZA,RSS TEST FOR EXT WITH OFFSET JMP NOTSO LDB .10B SET UP BYFLG STB BYFLG JMP *+2 SKIP ONE BECAUSE OF EXT WITH OFFSET NOTSO LDA SUMP IOR INST 'OR' INST TO EXT ORDINAL AND SAVE STA INST SET VALUE INTO INSTRUCTION SSA WAS ADDR INDIRECT? ISZ SCN1+2 YESM , BUMP OPERAND LOCATION LDA RELC JSB ?DCOD STB SAVB SAVE ASCII RELOC. CHARS. LDB STAR SET PLCN TO ACTUAL LOCN STB PLCN CLB,INB SET B=1 JSB BREC GO PUNCH THE WORD LDB SAVB B = ASCII RELOC CHARS. LDA .1+3 A = 4 JSB LIST LDA SIGN TEST FOR EXT WITH OFFSET SZA,RSS JMP NOOFF DON'T GOT ANY LDA SUMP STA INST LDB PLUS LDA .1+5 JSB LIST LIST THE OFFSET NOOFF ISZ PLCN BUMP PROG.LOCATION COUNTER ISZ STAR BUMP PSEUDO CNTR CLA STA INST CLEAR INST FOR FINAL NOP(IF ANY) STA LTFLG CLEAR LITERAL FLAG. LDB SCODE CPB .12 CODE = 114B(NOP IN 3RD WORD?) JMP PROCA YES, EMIT A 'NOP' ISZ OPNUM NO - LAST PARAMETER? JMP PROC1 NO - GO PROCESS NEXT ONE JMP HC04 YES - DONE * PROC7 CPA .10B =110B CODE? JMP PROC8 YES CPA .12 =114B CODE? JMP PROC8 YES CPA .12+1 =113B CODE? JMP PROC8 YES PRERR JSB OPERR NO - ERROR CLA STA SUMP INA STA RELC LDB LTFLG SZB,RSS LITERAL? JMP PROC4 NO JMP *+3 YES PROC8 JSB ?PLIT JMP PRERR+1 ERROR JSB MSYML LDA SAVB STA PNTR JMP PROC4 * PROCA JSB LOUT LDA .1+3 (4) SET FOR RESTRICTED LISTING JMP HC30+1 * STAR NOP f PSEUDO LOCN COUNTER STARX NOP LOCN OF INSTRUCTION * * ************************************** * * PROCESS DEFINITION OF BYTE ADDRESS * * * CODES ARE 'DBL' AND 'DBR' * * ************************************** * BYTE LDA .20B STA CODE SET CODE = 'DEF' JSB CHOPI GO EVALUATE OPERAND JMP BYERR+1 ERROR EXIT CLE,ELB ADDRESS * 2; E := 0 FOR ERROR CHECK SEZ OPERAND VALID? JMP BYERR NO GO TELL EM ADB INST STB SUMP SUMP = BYTE ADDRESS STA INST SZA ABSOLUTE? JMP BYEX NO ADB M200B YES SSB,RSS LESS THAN 200B? JMP BYERR NO, ERROR BYEX CPA .1+3 (4) EXT? JMP BYERR YES, ERROR BYOUT ADA ..M1 (-1) AND .1+2 (3) SET 'MR' CHARACTERS FOR LOADER STA INST LDA .1+5 (6) STA BYFLG SET FLAG FOR BREC RPROCESSING LDA RELC JSB ?DCOD GO SET UP LIST CHARACTERS STB SAVB SAVE RELOCATION ASCII CHARS. CLB,INB SET FOR INSERTING A WORD JSB BREC GO TO BINARY OUTPUT ROUTINE LDB SAVB LDA SUMP STA INST SET UP ADDRESS FOR LISTING CLA JMP HC30+1 CONTINUE TO LAST PART BYERR JSB OPERR CLA STA RELC JMP BYOUT M200B OCT -200 OPNUM NOP .20B EQU .12+4 (20B) * SKP * ****************************** * * PASS 2 END PROCESSOR * * ****************************** ENDRC OCT 120000 FOR RIC = 5 * FIN2 CLB JSB BREC PUNCH REST OF LAST DBL RECORD. CLA STA ?BASF CLEAR B.P. FLAG FOR CURRENT PAGE STA PBUF STA PBUF+1 STA PBUF+2 STA PBUF+3 LDA PLEN IF PLEN=0 THERE ARE NO LITERALS SZA,RSS LITERALS PRESENT ? JMP HC56 NO-BYPASS LITERAL PROCESSING. STA PLCN YES, SET PLCN=FWA AFTER P$ROGRAM LDA ?X NL01 STA ENTV ADDR OF SYMBOL TABLE LDA ENTV,I 1ST WRD OF ENTRY SZA,RSS END OF TABLE? JMP NL99 YES ALF STA 1 AND ...1+6 GET ENTRY LENGTH STA ENTC LDA 1 ALF AND .12+3 GET ENTRY TYPE CPA ...1+6 LITERAL? JMP NL20 YES NL10 LDA ENTV UPDATE TO NEXT ENTRY ADDRESS ADA ENTC JMP NL01 GO TO PROCESS NEXT ENTRY * * * PROCESS A LITERAL FOR OUTPUT * NL20 LDA ENTV CMA,INA SET UP ADDR OF LITRL CONSTANT LDB ?ICSA GET LOC'N OF ASCI BUFFER STA *+3 LDA ...1+3 4 TO A JSB ?MOVE LIT CONST TO ASCI/ASCI+1 NOP LDA ?ASII STA NLST SAVE 2ND WRD LDA ?ASCI PROCESS 1ST WORD STA INST JSB LOUT PUNCH LDA ...1+3 JSB LIST LDA ENTC CPA ...1+2 IS IT 2 WORD CONSTANT? JMP NL30 NO LDA NLST YES STA INST PROCESS 2ND WORD ISZ PLCN BUMP LOCN COUNTER JSB LOUT PUNCH LDA ...1+3 JSB LIST NL30 ISZ PLCN BUMP LOCN CNTR JMP NL10 * * EXIT HERE * NL99 CLB JSB BREC * * * PUNCH 'END' RECORD * HC56 LDA .2000 FOR WCNT = 4 STA WCNT SET WORD COUNT LDA SCN1+2 POINTS TO OPERAND (IF ANY) STA PBUF+3 CLEARED IF NO EXECUTION ADDRESS SZA EXEC.ADDR.PRSNT? * * * PROCESS EXEC.ADDR. * JSB ?CHPI GO EVALUATE OPERAND JMP HC54 ERROR, OR NO EXECUTION ADDRESS CPA ...1+1 (2) B.P. RELOCATABLE ? INA,RSS YES. SET R & T (3); SKIP. CPA .1 RELOCATABLE? JMP HC55 YES JSB ?OPER ERROR - NOT RELOCATABLE HC54 CLA CLB HC55 STB PBUF+3 STORE THE EXECUTION ADDRESS. ADA ENDRC SET RIC = 5 STA PBUF+1 LDA ?BFLG GET PUNCH FLAG ADA ?LGFL LO640AD/GO FLAG SZA,RSS PUNCHING REQUESTED? JMP HC57 NO - END OF PROGRAM JSB ?PNCH LDA ?LGFL SZA JSB ?WRIF CLOSE OUT LOAD/GO AREA LDA ?BFLG PUNCH FLAG SZA,RSS WAS A TAPE BEING PUNCHED? JMP HC57 NO, SKIP TRAILER OUTPUT * ****************** * * OUTPUT TRAILER * * ****************** JSB EXEC GO TO EXEC DEF *+3 DEF .1+2 DEF ?PNLE LEADER/TRAILER CW HC57 CLA,INA SET A=1 FOR LIST PARAMETER LDB BLNS BLANKS FOR RELOC,INDIC. JSB LIST JSB ?ENDS * PRINT ERROR COUNT * LDB ?PLIN CPB ?PCOM TTY OUTPUT ? JMP ASMBX YES, GO TO END OF ASSEMBLER CCA NO, SET FOR TOP OF FORM JSB ?LINS GO TO LINE SKIP ROUTINE JMP ASMBX EXIT FROM ASSEMBLER NLST NOP TEMPORARY ENTC NOP TEMPORARY ENTV NOP ENTBL COUNTER .2000 OCT 2000 SPC 1 ******************************************************************** ********** CHANGE LOC'N. X IN ASMB IF THIS PROGS. LWA > 2340B ****** ******************************************************************** SPC 1 ?ART EQU ART ?BREC EQU BREC ?LKLI EQU LKLIT SPC 1 END ASMB2 J6 #? 92060-18026 A S C0122 RTE ASMB SEG 3              H0101 ASMBҬB̬àŠASSMBҠUNŠ95 NAM:ASMB3 SU:9060-06 :9060-606 PGM:..H. (éPYGHԠH-PAKADMPANY95.A̠GHS SVD.NϠPAԠƠHSPGAMMAYBŠPHPD PDUDҠANSADϠANHҠPGAMANGUAGŠHUԪ HŠPҠNNSNԠƠH-PAKADMPANY. HDŠASMB39060-06(éH-PAKADMPANY95. NAMASMB35999060-606V.A5060 NԠASMB3?NS? Ԡ?BPKU?SA?PKUP?SYMK?HP?NDS?PN Ԡ?D̬?MSYS?ASMB?SGMì?PҬ? Ԡ?MVŬ?BG?G?G?HP Ԡ?V?ASM?MSج?BNN?PNԬ?NDP Ԡ?SҬ?Ƭ?DSì?UNɬ?NDSY?PҬ?PK SUP MPBSS5BSVŠMPAYAA UMPSAMŠASDAAGN VA0UMP+'ASN'AND'SYMK' DNԠUMP+ ...UMP+ .U... .U.+ ..MU.+6 ̠U..M+6 .9U+B .9U+B .MU+3B .M9U+5B BNKU+6B0B(ҠBANK .̠U+B .MBNU+50B .NϠU+5B BNSU+55B .ŠU+6B NAMɠU+B'NҠMPSYMB̠SAG NAMŠU+BҠUSŠBY'PK' SUMPU+00BUNNNGSUMҠ'HP' NBU+06B DŠU+0BPDŠYP(MPABũ NSԠU+3BPDŠMA PNU+BPGAMANUN PNҠU+BPNSAԠASԠҠUNԠHA. SNU+5BSAŠNGPDůPANDAB( SYMɠU+3BADDҠNҠҠSYMB̠B̠(SYMK SYMPU+33BSYMB̠NGAND'N NVU+B ɯϠSAMNԠBUҠ BƠU+B50DS+NDƠSAMNԠBU NPUԠBUҠ'BU'SASNHD BUƠUB+}GB PBUƠBSSSAVSHŠ'NAM'DN BAGU?BG BPKUPU?BPKU HPɠU?HP PҠU?P AGU?G MVŠU?MV MSYMSU?MSYS PKUPU?PKUP SAU?SA ؠU? SPà3 ASMB3SBSA DAD PA.+3'HD'SA? MPHYS SA?ASMAҠ'S'AND'N'AGS DB.000 SBPNNAZŠPGAMUN PA.SPDŠANG? MPHɱ DA.NϠ'N'NϠGSAMN SBP MPHA3+ HSBNSԬɠGϠϠHDSB MPASMB3 HɱSB?HPPSSANGNVAU MPHA3+ҠUN SBPNSԠNA̠UNҠVAU MPHA3GϠϠSAԠPASS BSSPBU-+6MAKŠMҠSԠƠPUNHBU SKP HA3SBSAGϠϠGԠNԠSAMN. DADŠGԠPDŠDN. PA.SԠHŠ'ND'SAMNԠ? MPHB00YSGϠϠHŠ'NDPSS. PABNK(0BSUPUNS? MPHA3GN-PASS. PA.3BPAMNԠDŠ? MPHA63YSҠ PA.00BUSҠMDŠ('M'? MPMàYSGϠPSS. ADA..M+-3 SSA MPHA6ҠҠGUND PA.BNAM? MPHA63YS ADA..M+(-3 SSA'M''N'Ҡ''? MPHA63YS- PA...+'U'? MPHA56ϠU PA.9(BHD? MPHA3GN-PASS. PA.(BSKP? MPHA3GN-PASS. PA.+GN-PASS. MPHA3GN-PASS. PA.+(6BSԯUN? MPHA3GN-PASS. SԠҠAB̠D DASN+3GԠAB̠NGH SZASSAB̠PSNԠ? MPHABNϬDCN SASYMPSԠHAҠUN DBUB SBSYMP+SԠAB̠ADD. ASԠA0ҠABSUŠVAU DBPN SBNSҠNSԠAB̠NϠSYMB̠AB NPҠ HABDADŠPDŠNDA PAD MPHA0'SA'D' PABYԠSԠA'BY'? MPHA0YSGϠPSS. PA.9P? MPHA6YS PA...+6( MPHA5ϠAS PA.6BNGҠAH(HADAũ? MPHA0YS.... PA...+5(6AHMA? MPHA63YS ADA.M0-0 SSAԠҠD? MPHA0YS. SZASSBSS? MPHA3MϠBSSP. DADŠGԠPDŠ.D.NUMB. ADAM00BSUBAԠ00A SSASSDŠ<00B? MPMàNϬ'SAMDŠMA. HA3BANAϠADDϠPN NMNԠPGAMN.N. HA3ZADAPN(HA3B+ SAPN MPHA3 .6BԠ6ҠHADAŠAHM .3BԠ3P̠D. SPà PSSBSS HA3MSBHPɠVA.PAND MPHA3 DABϠA MPHA3Z .BԠ .M0Dà-0 .00BԠ00 M00BԠ-00 DؠԠ5PYPŠҠ'D' BYԠԠ3PDŠ.D.N.Ҡ'BY' SKP NS:ADDNYϠHŠSYMB̠ABŬנHAU NKAG:BVAUŠNNPUԠ (UPUԩSYMPN.ƠHAS.SYMNNYA ̠SBNSҬɠ +ҠN('S'Ҡ'DD'PND +NMA̠N .DDASàDDS NSҠNsP SBNAM+3SAVŠVAU SB?SYMKSYMB̠ABŠKUP MPNS DA.DDNϬ'DD'Ҡ(MUPŠSYMB̩ NSؠSBP MPNSҬɠGԠUԠH NSDBNAM ADBMP+ SBVA0SԠM DA?NDPGԠAAVA.MM. MANA ADASYMɠSԠҠSYMB̠B ADAMP+V SSA MP+3N DA.DD+'S'SYMB̠ABŠV MPNSؠGϠϠPNԠҠMSSAG. DANAM+3MVŠVAU SAɠUP DANAM DB0ɠADDNY(M+6 SBSYMɬɠϠSYMB PAVA0 MPNSؠ NA SZSYM MP-6 NSؠDBSYM SB?NDSYSԠNנNDƠSYMB̠AB. SZNSҠBUMPԠPNԠҠA+ MPNSҬɠԠH HA63DA.̠GA̠PD:ABS.ASSMBS! MPHA55+ϠP SKP PSSԠANDDà HA0BNBB PADؠHKDŠҠ'D' ADB.+B3ƠDŠS'D' SBDNԠSԠNUNԠBUMP A SANB SAMP DASN+ SAPNҠSԠPN PKUPANDAMNŠAHAAҠ HASBPKUP(HA0+ASHA DBDNԠGԠUNԠBUMP PA+MMA? MPHAYSGϠSANҠNԠPAAM. PB.+SԽ3(..Dة? MPHAYS PA+6PD? MPHAYS PA.Š''? MPHA HAPABNKNDƠSAMN? MPHA9YS MPHA SԠԠPԠAGSKPBANKSҠNԠHAҠ HAA SAMP SBBPKUP DBDNԠGԠ'BUMP'UN MPHA+ ԠPԠԡSԠҠNUMBҠUSNGBH.ANDŠ HADAMP SZMP SZAŠҠ'.'UNDY? BYSSԠB0. ADBNB(HA+ SBNBADDϠDUN MPHA NDƠNUMàPSUD-PPSSҠ HA9DADN ADANBSԠANϠƠNSϠBŠUSD DBDŠGԠPDŠ.D.NUMB. ŠPPAŠҠMANDҠS. PBBYԠBY? AYSDVDŠBY SZDDBYŠMANNG? NAYSADDϠDUN. MPHA3Z SKP PSSASà(GԠVAUŠƠN HA5DA...+('AS'ND.ҠHP SB?HP MPHA3BҠ SZA MPHA55-NԠABS.VA. SZBSSZϠDUNԠ? MPHA55YSҠ ADB.M9-9 DASUMP SSBSKPƠDS MPHA3Z HA55SZPNҠԠ DA.MBN'M'(BADPAND SBPҠϠPNԠҠDAG. MPHA3 PSSUPSUDϠ HA56SBHPɠVAUAŠPAND MPHA3Ҫ PA...+3(Ԡ? DA...+(5SԠҠNN-PNH SAMPN SBMP+ BNB SBMSYMSGϠϠMAS.SYMB̬SԠSYMPSYMN DAMP DBMP+ SNDAB̠ϠABŠ SBNSҠϠSYMB̠ABŠNSNN NP MPHA3 GҠPP.UMPS HA6SBNSԬɠGϠϠSUBUN MPHA3 HA0DA.+A MPHA3Z SKP y PASSNDPSSҠ DƠBU HB00DA?GGԠABŠUPUԠAG SZASS MPHB0ABŠNԠUSD-NSHPASS DAHB00- ADA.+3 SAHB00-SԠHB00-(BU+ DAؠGԠAƠAVAABŠMMY SANVϠNV HBؠDANVɠSԠSԠDƠNY SZASSMPD? MPHB0YS-GϠϠNSHPASS DBNVGԠB̠NYAN MBNB SNDADD.ϠMVŠNKAG SBHMV5 MVŠBANKSϠBU DBBNS SBBU SBBU+ SBBU+ SBBU+3 DBUBADD.ƠBUƠϠB SPà MVŠHASMSYMB̠ABŠ A AND...+6(ҠN.ƠDS. SASUMP PA...+( A Ҡ... SBMV HMV5NP GԠVAUŠƠSYMB̠ DBSUMP(N.ƠDSNNY ADB..M ADBNV SBNV DA SZNV ŠSԠŠ0ҠA̠NV. SB?BNN SŠASɠVAUŠNϠBU DBHB00-GԠ(BU+ SB?V DBUBSԠPNԠPAAMS DA.+( SB?PNԠGϠϠPN MPHBؠNYDN. .PASSASàPASS SKP SPND HB0SB?NDSGϠϠNDPASSPSS DB?D̠GԠHŠDSàAG SZBDSKBNGUSD? MPHB0ҠN. DA?UNɠGԠNPUԠUN PA.+SԠHŠDS? SSYSSKPHŠNG SB?ƠŠSԠƠASԠS DA?SҠYSGԠNA̠DŠD SB?DSàGϠNAZŠҠNנSA DA.+ŠNPUԠUNҠPASS. l"SA?UNɠSԠNPUԠUNDS MPHB09YSSKP'NDPASS'MSSAG HB0ҠDA.PASSPUԠUԠ"NDASMBPASS"MSS DB.PASS+ SB?MS SBàGϠϠPAҠSUSPNDUN DƠ+ DƠ.+6PAҠSUSPND.D SPà SAԠ'ABSU'PASSHŠ SPà SԠҠPUNHUPU SPà HB09DABAG SZASSPUNHUSD? MP+5N SBàYSUPUԠHŠAD DƠ+3 DƠ.+ADҠѠD DƠ?PNŠADүAҠ DAAGGԠHŠSԠAG ADABAGGԠPUNHAG SZASԠҠPUNH? MPHBSAԠPASS MP?ASMBASSMBҠ HBDA+PKUPNԠDŠϠGԠASMB5 MP?SGMGϠϠADҠҠNԠSGMN ASà .000Ԡ000 UBDƠBU SKP PSSNDDNSUNSԠANDUSҠMDS MàSABD-00BNנNB DA.+SԠA PB.YPŠB? NAYSA3 PB.+YPŠ5B? NAYSA3 ADB.M SSBSSUSҠD?(0BHU0B MPHA3ZNϬUSŠVAUŠNAҠPNBUMP ADB.+6 ADABAMAϠNSUNUN. MPHA3Z PSSA'M'PSUDϠPAN(..USҠMDũ MA:MàMMMìN HŠ MMMUSҠDSGNADMNMNà(A̠APHABé/H àUSҠDSGNADUNNDŠ(0ϠB NNUMBҠƠPAAMSNUSҠPAND MàDASN+ SAPNҠMVŠPNҠϠPAND SB?PKHKҠDUPAŠMNMN MPM0GD-MNMNàNԠUND MPSB?PҠҠNPAND('M'M SADŠ-SԠDŠNԠ00B MPHA3GϠGԠNԠNSUN M0DAMP+5SAVŠUSҠMNMNàHŠ SASDŠSAVŠSԠHAS. DAMP+6 SAMMPSAVŠASԠHAA SԠ3HAASҠAPHANYMNMNà DA..M+ SAMP M0SBPKUPPKUPAHAA MANA ADA.00B SSASSSSHANҠA? MPMPYS-NN-APHA ADA.3B SSAGAҠHANҠZ? MPMPYS-NN-APHA SZMPASԠHAAҠSD? MPM0NϠ-GϠGԠNԠN DA.B SADŠSԠDŠ'ABS'Ϡ̠HPN. DA.+SԠҠMMASPNHP SBVMàPKUPMϠDŠANDSԠPA SANSԠSAVŠUSҠUNND ASԠҠNϠMMASPNHP SBVMàGԠVAUŠƠN SSBSVAUŠƠNPSV MPMPNϠ- ADB.M SSBSSSNGAҠHAN? MPMPYS- ADA.00B PA.00B̠DŠBŠ00B? DA.30BYS-NϠPAAMS.HUS'S30B SADŠSAVŠDŠҠPABŠNY NҠNנPDŠNϠSUPPMNAYPDŠABŠ DA?NDPGԠGƠSUPP.PDŠAB ADA..M+SԠNנGN ABSAB MBNBSAԠSԠҠV ADB?NDSY SSBPABŠV? MPMñ0N DA.SϠYS-PNԠ'S' SBP MPHA3GϠҠNԠSAMN Mñ0SA?NDPSԠNנPABŠGN DBSD SBAɠSŠSԠHAS. NA DBMMPGԠ3DHA. ADBDŠNSԠD SBAɠSŠԠNϠHŠAB NA DBNS SBAɠSŠHŠMDŠ(UNN MPHA3GϠҠNԠSAMN SKP VMàHKSҠMMASNUMSANDYPŠƠUPUԠ MPANDPSSҠ(MDŠANDƠPAAMS VMàNP SAMSAVŠHPNPUԠPAAM SBPKUPPKUPAHA. PA+SԠAMMA? SSYS MPMPNϠ- SBBPKUPSKPVҠNGBANKS SBSN+SԠPANDPNҠϠNԠPAAM. DAM SB?HPVAUAŠHŠPAAM MPHA3Ҡ-GϠϠNԠSUŠSA. SZAABSUŠVAU? MPMPҠ-N DASUMPVAUŠNBHAANDBN MPVMìɠUN MNPSAVŠAҠHPNY .BU.+5(B .30BԠ30 SDŠNPSAVŠSԠNMMNàHAS. MMPNPSAVŠ3DHA. AU0 BU .SϠASàS SPà HANGŠ'N.ZNASMBƠHSPGS.A550B SPà ?NS?UNS SPà NDASMB3 <:66< $3 92060-18027 1639 S 0222 ASMB4 SRC              H0102 ASMB,R,B,L,C RTE ASSEMBLER SEPT 1976 * * NAME: ASMB4 * SOURCE: 92060-18027 * RELOC: 92060-16027 * PGMR: C.C.H. * MODIFIED BY EARL STUTES 1976-09-20-1600 * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1975. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** HED * RTE ASMB4 92060-18027 * (C) HEWLETT-PACKARD COMPANY 1975. * NAM ASMB4,5,99 92060-16027 REV.B 760924 ENT ASMB4,?AREC EXT ?SUP,?BPKU,?PKUP,?BFLG,?LFLG,?RSTA,?ERPR EXT ?OPLK,?GETC,?LINC,?LIST,?LOUT,?OKOL EXT ?CHOP,?CHPI,?OPER,?ASCN,?MSYM,?ASM1,?LINS EXT ?LST,?LPER,?PERL,?SETM,EXEC EXT ?LUNP,?PNLE,?ENDS,?PLIN,?PCOM,?ASMB SUP TEMP BSS 225B RESERVE TEMPORARY AREA # EQU TEMP SAME AS DATA ORIGIN VALU EQU TEMP+5 ...1 EQU TEMP+7 .1 EQU ...1 .12 EQU .1+7 ..M1 EQU .12+6 L EQU ..M1+6 .9 EQU #+41B .M8 EQU #+43B .M29 EQU #+45B BLNK EQU #+46B =40B(LOWER BLANK) .NO EQU #+51B .OP EQU #+52B .OV EQU #+53B .IL EQU #+47B BLNS EQU #+55B TW10 EQU #+56B ADDRESS MASK .1000 EQU #+57B BIT15 EQU #+60B .E EQU #+61B RELC EQU #+76B RELOCATION FLAG SIGN EQU #+77B SUMP EQU #+100B RUNNING SUM FOR 'CHOP' TERM EQU #+101B NO. OF TERMS IN AN OPERAND T EQU #+102B CNTB EQU #+106B CODE EQU #+107B OPCODE TYPE(FROM OPTABLE) DSIG EQU #+110B 'ASCN' FLAG EQU #+111B FLAQ EQU #+112B INST EQU #+113B OPCODE FORMAT LAST EQU #+114B PASS EQU #+115B PASS FLAG(0=PASS 1 AND 1=PASS2) PLCN EQU #+117B PROGRAM LOCATION COUNTER PNTR EQU #+121B POINTS AT LAST OR CURRENT CHAR. SCN1 EQU #+125B STATE LNG/OPCODE/OPERAND/LABEL(4) TEST EQU #+135BI TEST CHARACTER * * I/O STATEMENT BUFFER * IOBF EQU #+142B 50 WORDS + END OF STATEMENT BUFF PBUF OCT 0,0,0,0 WCNT EQU PBUF WORD(BLK) CNT FOR BIN.RECRD. ASM1 EQU ?ASM1 BFLAG EQU ?BFLG CHOP EQU ?CHOP CHOPI EQU ?CHPI ERPR EQU ?ERPR GETC EQU ?GETC LINC EQU ?LINC LIST EQU ?LIST LOUT EQU ?LOUT LST EQU ?LST OKOLE EQU ?OKOL OPERR EQU ?OPER RSTA EQU ?RSTA A EQU 0 B EQU 1 SPC 1 * **************************************** * * CONTINUE PASS 2 OF ABSOLUTE ASSEMBLY * * **************************************** SPC 1 ASMB4 LDA ?LPER LENGTH OF CLEAR AREA LDB ?PERL GET ORIGIN OF 'CLEAR' AREA JSB ?SETM GO TO SET MEMORY ROUTINE OCT 0 TO SET MEMORY TO ZERO LDA .2000 STA PLCN INITIALIZE PROG LOC'N COUNTER CLA,INA STA PASS SET PASS FLAG JSB RSTA READ CONTROL STATEMENT LDA TW10 STA ASM1 SET FLAG FOR 'INIT' PORTION ASH JSB RSTA READ A SOURCE STATEMENT(NAM?) LDA CODE CPA .12+3 HED? JMP ASH YES, GO PICK UP THE NEXT STATEME STA ASM1 CLEAR 'CS' AND 'INIT' FLAG CPA .1 JMP HI12 LDA .NO 'NO'= NO ORG OR NAM STATEMENT JSB ERPR JMP HC05 ERROR EXIT FROM INIT HI12 JSB ?CHOP EVALUATE ORG JMP HC02 ERROR RETURN STB PLCN JMP HC02 * .2000 OCT 2000 BSS PBUF-*+61 RESERVE REMAINING PUNCH BUFFER * SKP * ****************************** * * SKIP AND SPACE LIST OUTPUT * * ****************************** SKPR LDB LINC 'SKIP'ENTRY CMB,INB JMP SK2 SPCR JSB CHOPI EVALUATE SPACE COUNT CLB,INB ERROR - SET COUNT=1 SK2 SZB,RSS SPACES=0? JMP HC04 EXIT TO HC04(START OF PASS) LDA ?LFLG NO, START LINE SKIPPING SZA,RSS LIST REQUESTED? JMP HC04 2 EXIT TO HC04(START OF PASS) LDA LST LST FLAG SZA SUPPRESS LISTING? JMP HC04 EXIT TO HC04(START OF PASS) STB DSIG SET COUNTER LDA LINC CPA ..M1 ON LAST LINE? JMP HC04 YES - EXIT ADB LINC SSB,RSS WILL IT GO TO BOTTOM OF PAGE? JMP *+5 YES,GO TO TOP OF FORM STB LINC NO, SAVE NEW LINE COUNT LDA DSIG GET NO. OF LINES TO BE SKIPPED JSB ?LINS GO TO LINE SKIPPER JMP HC04 EXIT TO GET NEXT STATEMENT JSB OKOLE SKIP TO TOP OF FORM JMP HC04 EXIT TO GET NEXT STATEMENT * * ************************* * * BINARY OUTPUT ROUTINE * * ************************* .M57 DEC -57 DEF PBUF+2 BREC NOP LDA BFLAG GET PUNCH REQUEST FLAG SZA,RSS WAS PUNCH REQUESTED? JMP BREC,I NO. LDA WCNT SZB RECORD OUT? JMP HI66 NO. SZA,RSS WCNT=0? JMP BREC,I YES. HI60 LDA WCNT ** OUTPUT A BINARY RECORD ** ALF,ALF ROTATE 8 STA WCNT STORE WCNT IN UPPER PBUF ALF,ALF ADA .1+2 ADD 3 TO THE DATA COUNT STA CNTB SET COUNTER = WCNT+3 JSB EXEC PUNCH CURRENT RECORD DEF *+5 DEF .1+1 CW DEF ?LUNP LUN OF PUNCH DEV. DEF PBUF PUNCH BUFFER DEF CNTB WORD COUNT CLA STA WCNT INITIALIZE WCNT =0 JMP BREC,I AND EXIT HI66 SZA 1ST WORD OF BINARY RECORD? JMP HI70 -NO- LDB PLCN PLCN TO BREG STB PBUF+59 PUT IN CHECKSUM SAVER STB PBUF+1 SET RECORD ADDR. LDA BREC-1 STA STOR SET STOR=L(PBUF+2) LDA .M57 STA CNTB SET COUNT=-57 HI70 LDA INST STA STOR,I SET CURRENT BIN. WORD ISZ STOR BUMP POINTER ADA PBUF+59 UPDATE CHECKSUM STA PBUF+59 STA STOR,I SAVE IN LWA+1 OF PUNCH RECORD ISZ WCNT ISZ CNTB IS RECORD FULL? JMP BREC,I NO - EXIT JMP HI60 YES - GO PUNCH STOR BSS 1 SPC 2 HC02 LDA ...1+1 LIST PARAMETER HC03 JSB LIST * * * READ NEXT STATEMENT * HC04 JSB RSTA READ NEXT STATEMENT * * * TEST MNEMONIC CODES FOR PROCESS TYPE * * HC05 LDA CODE LDB INST CPA .100B CODE = 'MIC' ? JMP X39 YES, GO TO LIST IT. ADA M100B SUBTRACT 100 OCTAL SSA,RSS CODE >100B ? JMP XMIC YES, IT'S A MICROCODE MACRO. LDA CODE GET OPCODE I.D. AGAIN. CPA L+3 (43) SOC OR SOS ? JMP HC28 YES AND .M8 (177770) CPA L I/O ? JMP IOPR YES ARS,ARS SHIFT A RIGHT 4 BITS ARS,ARS CPA .1+2 60 OR 70?(MICRO-OP?) JMP MICR YES LDA CODE ADA CODLC SET UP ADDRESS OF PROCESSOR JMP A,I JUMP TO OPCODE PROCESSOR * SKP * ************************ * * PROCESSOR JUMP TABLE * * ************************ * * CODLC DEF *,I DEF HC42 ORG 1 DEF HC42 ORR 2 DEF HC38 *COM 3 DEF HC38 *ENT 4 DEF HC38 *EXT 5 DEF HC38 *ARITH 6 DEF NUMP ASC 7 DEF NUMP DEC 10 DEF NUMP OCT 11 DEF BSSP BSS 12 DEF EQUP EQU 13 DEF FIN2 END 14 DEF HC38 *NAM 15 DEF MEMRY MEMORY 16 DEF X50 HED 17 DEF MEMRY DEF 20 DEF HC26 ABS 21 DEF SKPR SKP 22 DEF SPCR SPC 23 DEF X54 LST/UNL 24 DEF NUMP DEX 25 DEF HC70 HDW ARITH 26 DEF HC80 HDW SHIFT 27 DEF HC30 CLO, ETC. 30 .I OCT 111 M ASCII I 31 DEF HC38 *RPL 32 CBIT OCT 175777 33 .1777 OCT 1777 34 DEF X52 REP 35 M17 DEC -17 36 -17 FOR SHIFT-ROT CNTC NOP 37 MICRO-OP PROC DEF X56 SUP/UNS 40 DEF BYTE DBL 41 DEF BYTE DBR 42 DEF BYTEG BYT 43 INSV NOP MICRO-OP PROC SUM. EQU INSV MEMORY REF PROC. DEX OCT 25 'DEX' OPCODE TYPE * SKP * * PROCESS MEMORY REFERENCE INSTRUCTIONS * * MEMRY LDA INST AND ..M1+1 CLEAR LDSB OF 'INST' STA INST LDA .I SET FOR INDIRECT BIT LDB BIT15 INDIRECT BIT MASK(100000B) JSB CHOP JMP HC17E ERROR EXIT HCX STB SUM. OPERAND VALUE CLB LIST PARAMETER=0 HCXL STB TERM SAVE THE LIST PARAMETER LDA SUM. LDB CODE CPB .12+4 (16) DEF? JMP HC17 ADA TW10 NO - TEST FOR OPERAND>1023 SSA,RSS IS IT? JMP *+5 YES. LDA INST NO - SET TO CLEAR'CURRENT' BIT. AND CBIT CURRENT BIT MASK(175777) STA INST RESTORE JMP HC14 LDA PLCN TEST NOW FOR OPER.AND INSTR. AND TW10 IN THE SAME PAGE OF MEMORY CMA,INA ADA SUM. AND TW10 SZA,RSS IN SAME PAGE? JMP *+3 YES LDA .OV NO - IT'S AN OVERFLOW JSB ERPR LDA .1777 AND SUM. STRIP UPPER 6 BITS OF OPERAND STA SUM. HC14 LDA SUM. GET ADDRESS HC17 IOR INST FOR INSTRUCTION, AND STA INST SET LOADER FLAG * * * OUTPUT A BINARY WORD * * HC19 CLB,INB JSB BREC * * * OUTPUT A LINE FOR LISTING * * LDB BLNS GET BLANKS FOR LIST ROUTINE LDA TERM GET THE LIST PARAMETER JSB LIST ISZ PLCN JMP HC04 "* SKP * ***************** * * BSS PROCESSOR * * ***************** BSSP JSB CHOPI EVAL. OPERAND JMP HC02 ERROR SZB,RSS B=0? JMP HC02 YES CLB B=0 JSB BREC CLA A=0 LDB BLNS NO RELOC. INDIC. JSB LIST LDA SUMP PICK UP BLOCK LENGTH FOR PLCN ADA PLCN STA PLCN JMP HC04 EXIT * SKP * ********************************************** * * PROCESS THE 'DEF' FOLLOWING THE FIRST WORD * * * OF AN ARITHMETIC PAIR * * ********************************************** HC70 JSB LOUT OUTPUT THE ARITH. OPERATION JSB LIST LIST THE FIRST WORD LDA .12+4 (20B) STA CODE =DEF CLA STA INST CLEAR INST LDA .I SET UP FOR INDIRECT BIT LDB BIT15 MASK= 100000B JSB CHOP NOP ISZ PLCN BUMP LOCATION COUNTER STB SUM. SAVE OPERAND VALUE LDB .1+3 LIST PARAMETER=4 JMP HCXL HC17E CLA LIST PARAMETER =0 STA TERM SAVE IT JMP HC17 * * * PROCESS 'ABS' OPCODE * * HC26 JSB CHOPI GO EVALUATE OPERAND JMP HP2D ERROR STB INST JMP HP2D OK.. * * * OUTPUT BIN RECRD AND/OR LIST LINE * * HC30 JSB LOUT JSB LIST * * * ADD 1 TO PROG. LOCN. CNTR. * * ISZ PLCN BUMP LOCATION CNTR JMP HC04 * * * COM,ENT,EXT AND ARITH MACRO * HC38 LDA .IL ILLEGAL IN ABSOLUTE ASSEMBLY JSB ERPR X39 CLA,INA 1 TO A JMP HC03 * SKP * * * PRE-PROCESSOR FOR ORG AND ORR * * HC42 CLB OUTPUT A JSB BREC RECORD JSB INST,I JUMP TO CORRECT SUBROUT. JMP HC02 BACK TO START LIST X50 LDA ?LFLG GET THE LIST FLAG SZA,RSS IS LIST FLAG O;PFF? JMP HC04 YES - GO TO NEXT STATEMENT JSB INST,I TO HEADER SUBROUTINE JSB OKOLE SPACE TO BOTTOM OF PAGE JMP HC04 GET NEXT STATEMENT X52 JSB INST,I TO REPSB JMP X39 X54 STB LST SET LST/UNL FLAG JMP HC04 EAS 1976-09-20-1600 X56 STB ?SUP SET 'SUP/UNS' FLAG JMP X39 SPC 1 * * PASS 2 'EQU' PROCESSOR * * EQUP JSB CHOPI EVAL. OPERAND CLB ERROR EXITS LDA PLCN STA SUMP SAVE PLCN VALUE STB PLCN SET PLCN=0 LDA ...1+1 (2) LIST 'EQU' JSB LIST LDA SUMP REPLACE PLCN VALUE STA PLCN JMP HC04 HC80 JSB CHOPI GO EVALUATE THE COUNT JMP HC84 BAD COUNT EXIT ADB M17 B-17 SSB B GRTR THAN 16? CPB M17 NO. IS B=0? JSB OPERR YES, IT'S AN 'M' ERROR,. LDA SUMP GET THE SHIFT OR ROTATE COUNT.. AND .12+3 MASK OUT LOWEST 4 BITS HC82 ADA INST MAKE UP THE FINAL INSTRUCTION STA INST JMP HC30 GO AND OUTPUT THE INSTRUCTION HC84 CLA SET COUNT FOR 16 BIT SHIFT ROTATE JMP HC82 * SKP * ************************* * * OCT/DEC/ASC PROCESSOR * * ************************* NUMP LDA SCN1+2 STA PNTR SET POINTER CLA STA T+1 SET FPAS=0 LDA CODE CPA ...1+6 (7) JMP ASCR HE06 LDB PNTR PNTS AT 1ST CH OF NUMBER STB SIGN CLB STB CNTC INB STB RELC * * * TEST CHARACTER FOR TERMINATOR * HE08 LDA PNTR JSB GETC STA TERM CPA L+4 COMMA? JMP HE12 YES CPA BLNK BLANK? JMP HE12 YES * * * UPDATE CHAR.CNTR(CNTC) AND POSN. PNTR(TLOC) * LDB CODE CPB .9 OCT? JMP HE10+1 YES CPB DEX 'DEX'? JMP HE11 YES F LDB ...1+1 (2) NOT OCTAL CPA L+6 PERIOD? STB RELC YES, SET RELC = 2 CPA .E 'E' ? HE10 STB RELC YES, SET RELC FOR USE AS ASCN MD ISZ CNTC ISZ PNTR BUMP PNTR JMP HE08 HE11 LDB .1+2 SET B=3 FOR DEX MODE JMP HE10 * * * SET UP VALUE FOR LIST AND/OR PUNCH * HE12 LDA CODE CLB CPA .9 OCT? JMP *+3 YES LDB RELC NOT OCT BLF,BLF ADB CNTC LDA SIGN JSB ?ASCN GO TO 'ASCI' CONVERSION CLA SET A=0 STA INST STB SUMP STORE VALUE LDA VALU SAVE LEAST SIG PART OF 'DEX' STA SIGN HE18 JSB NOUT LDA RELC ARS,SLA IS RELC = 0 OR 1? JMP HE20 NO, ITS 3 OR 2 LDA TERM GET THE TERMINATOR CPA BLNK IS THIS THE END OF THE TERM ? JMP HC04 YES, EXIT ON BLANK ISZ PNTR BUMP PNTR JSB ?BPKU SCAN OVER BLANKS LDA PNTR TEST FOR EOL 1976-09-20-1600 CMA,INA ADA SCN1 THE RECORD CHARACTER COUNT SSA,RSS JMP HE06 MORE DATA FOLLOWS LDA .IL SOMETHING IS NOT GOOD JSB ?ERPR TELL EM KEMO SABE CLA MAKE A NOP STA INST AND JSB NOUT DUMP IT JMP HC04 BUG OUT, U DONE * HE20 LDA SUMP STA INST VALUE TO INST LDB RELC CPB .1+2 IS RELC=3? JMP HE22 YES- SET SUMP FOR 3RD WORD CLA HE21 STA RELC SET RELC FOR NEXT TEST JMP HE18 * HE22 LDA SIGN STA SUMP VALU TO SUMP LDA .1+1 FOR SETTING RELC=2 JMP HE21 * *************************** * * OCT DEC ASC WORD OUTPUT * * *************************** NOUT NOP LDA T+1 1ST LIST LINE FLAG SZA 1ST? JMP *+4 NO INA 1 TO A STA T+1 SET FLAG CLA,RSS CLEAR A,SKIP LDA ...1+3 (4) SET A=4 FOR LIST LDB BLNS JSB LIST CLA CLB,INB JSB BREC PUNCH ISZ PLCN BUMP LOCN CNTR. JMP NOUT,I EXIT * ******************** * * PROCESS ASC HERE * * ******************** ASCR LDA ...1+1 (2) INDIC.'ASC' JSB CHOP GO EVALUATE WORD LENGTH JMP HC30 ERROR EXIT SZA VALUE ABSOL.? JMP HP2D-1 NO; ERROR SZB,RSS ASKING FOR ZERO WORDS? JMP HP2D-1 YES * ERROR * ADB .M29 (-29)(VALUE IS IN SUMP TOO) SSB,RSS VAL.>28? JMP HP2D-1 YES; ERROR LDA PNTR STA T LDA SUMP CMA,INA STA CNTC VALUE(COMPL.) TO CNTC * * * PICK UP WORDS AND STORE INTO PROGRAM * SB ISZ T LDA T JSB GETC ALF,ALF STA TEST ISZ T LDA T JSB GETC STA INST * * * OUTPUT 2 ASCI CHARACTERS * JSB NOUT CLA STA TEST ISZ CNTC JMP SB JMP HC04 DONE, GO GET NEXT STATEMENT * ************************* * * PROCESS I/O GROUP HERE * * ************************** RAM OCT 105000 OCT 177400 OCT 300 IOPR LDA SCN1+2 IS OPERAND SZA PRESENT? JMP P YES! LDA CODE NO OPERAND CPA L+1 'HLT'? JMP HP2D YES * * * OPERAND ERROR EXIT HERE * JSB OPERR (HP2D-1) HP2D CLA STA TERM SAVE THE LIST PARAMETER JMP HC19 P LDA .C TEST FOR 'CLEAR FLAG'(C). LDB .1000 GET 'C' MASK FOR IO INSTR. JSB CHOP JMP Q ERROR EXIT LDA 1 LDB INST LOAD B WITH OCTAL INSTR ADA IOPR-2 MASK FIRST PART CPB RAM SEE IF A RAM INSTR RSS SKIP NEXT MASK IF RAM ADA IOPR-1 IF NOT RAM ADD SECOND PART LDB SUMP RESTORE B REG * SKP * * * TEST FOR VALUE>63 * * SSA VALUE >64 ? JMP *+4 YES-O.K. LDA .OV 'OV' ADDRESS OVERFLOW JSB ERPR GO PRINT ERROR MESSAGE. Q CLB ADB INST (HE54+1) STB INST JMP HP2D .C OCT 103 ASCII 'C' * * * PROCESS SOC OR SOS * HC28 LDA SCN1+2 PNTR TO OPERAND LDB 0 A TO B JSB ?MSYM ADA ..M1 SZA JMP HP2D LDA LAST CPA .C IS 'C' PRESENT? JMP *+2 YES JMP HP2D NO * * * 'OR' 1 TO BIT 9 (C BIT) OF I/O INST * * LDA INST IOR .1000 MASK IN CURRENT BIT STA INST JMP HP2D * SKP * ********************** * * MICRO-OP PROCESSOR * * ********************** MICRD OCT 7777,4000,60000,60,71,14000 * * * INITIALIZE FLAGS * MICR CLA STA CNTC =0 WHEN CLE APPEARS STA TERM BITS 12-11 = 1 IF B REG * BITS 12-11 = 2 IF A REG STA TEMP+4 BITS 14-13=1 IF SRG; =2 IF ASG STA INSV USED TO ACCUMULATE THE CODE STA FLAG STA TEST CLEAR CHAR TESTER * * * START HERE FOR EACH NEW CODE * F LDA INST UNPACK THE MICRO-OP CODE * * THE FORMAT IS: * BITS 14-13=1 IF SRG,2 IF ASG, 0 IF * EITHER * BITS 12-11=1 IF BREG,2 IF AREG, 0 IF * NEITHER. * BITS 11-0 = ACTUAL 12 BIT CODE AND MICRD EXTRACT OPCODE STA FLAQ SAVE IT (=+2) LDA CODE THIS IS THE GROUP NUMBER. CMA,INA MAKE SURE IT'S BIGGER THAN THE LAST. ADA FLAG A=(LAST GRP)-(PRESENT GRP) SSA JMP O SEQUENCE IS OK * * * IF PjRES GRP IS GO WE CAN CHANGE IT AND MAY BE OK LDA CODE CPA MICRD+3 IS CODE TYPE = 60B (MICRO-OP)? JMP *+4 CHANGE ERROR GROUP AND OP CODE MERR LDA .OP 'OP' FOR OPCODE ERROR JSB ERPR RETURN JMP HP2D LDA MICRD+4 71B, CHANGE GROUP (FROM *-4) STA CODE TO 71 * * * MOVE BITS 8-5 OF OPCODE TO BITS 4 AND 2-0 * LDA FLAQ AND MICRD+1 SET A/B BIT STA 1 SAVE IN B. XOR FLAQ ALF,ALF MOVE BITS 0 AND 15-13 RAR,SLA MOVE BIT 0 TO INA BIT 1. ALF,RAR ROTATE LEFT 3, TO BITS 4,2-0 IOR 1 PUT IN THE A/B BIT JMP F+2 O LDA CODE STA FLAG SET LAST GRP TO PRESENT GRP * * * CHECK REGISTER CONSISTENCY * LDA INST AND MICRD+5 GET BITS 12-11 IOR TERM CPA MICRD+5 IF EQUAL, THERE'S A REGISTER JMP MERR INCONSISTENCY. STA TERM NEW REGS TO REGS, * * * OTHERWISE CHECK GROUP CONSISTENCY * LDA INST AND MICRD+2 BITS 14-13 IOR TEMP+4 CPA MICRD+2 IF EQUAL,THERE ARE 2 CODES JMP MERR FROM DIFFERENT GROUPS. STA TEMP+4 * * * CHECK FOR CLE * LDA FLAQ SZA,RSS ISZ CNTC * * * NOW 'OR' THE CODE INTO CURRENT CODE SO FAR * IOR INSV STA INSV * * * GET THE NEXT CHARACTER * LDA SCN1+1 OPCODE PNTR ADA ...1+2 (3) STA PNTR POINTS AT POS'N FOLLOWING OPCODE JSB ?PKUP CPA BLNK IS THIS CHAR. A BLANK ? JMP *+7 YES, WE'RE DONE. CPA L+4 COMMA ? JMP *+2 JMP MERR * * * GET THE NEXT OPCODE * JSB ?OPLK OPCODE LOOKUP JMP HP2D JMP F * * * TO FINISH TEST CLE; IF USED AND IN ASG SET, ADD 40 * * TO THE CODE. LDA TEMP+4 (FROM *-7) ALF,ALF SZA,bHFBRSS IOR BLNK (40B) LDB CNTC SZB,RSS CLA IOR INSV STA INST JMP HP2D * SKP * ***************** * * PROCESS 'END' * * ***************** * FIN2 CLB JSB BREC PUNCH REST OF LAST DBL RECORD LDB ?BFLG SZB,RSS WAS PUNCHING REQUESTED? JMP FIN3 NO JSB EXEC YES- OUTPUT TRAILER DEF *+3 DEF .1+2 CW DEF ?PNLE LEADER PARAMETER/LUN FIN3 CLA,INA LDB BLNS JSB LIST LIST 'END' STATEMENT JSB ?ENDS GO TO END SUBROUTINE LDB ?PLIN CPB ?PCOM TTY OUTPUT? JMP ASMBX YES CCA NO - ITS ON A PRINTER JSB ?LINS SKIP TO TOP OF FORM JMP ASMBX GO TO COMPLETION * SKP ',H* * ********************************************************* * * PROCESS BASE SET EXTENSION AND MEMORY EXPANSION CODES * * ********************************************************* * XMIC STA SCODE SAVE CODE-100B CMA,INA STA OPNUM START SETTING PARAMETER COUNT ADA .1+6 SSA,RSS CODE GRTR THAN 107B? JMP PROCX NO - OPNUM IS OK LDB ..M1 B = -1 CPA ..M1+5 BIT TYPE INSTR.? (115B) ADB ..M1 B = -2 IF YES STB OPNUM SAVE PARAMETER COUNT PROCX JSB LOUT OUTPUT MICROCODE TO PUNCH JSB LIST LIST SOURCE STATEMENT LDA PLCN GET CURRENT LOCN COUNTER VALUE STA STAR SAVE IN PSEUDO COUNTER STA STARX SAVE AS ORIGINAL VALUE ISZ STAR BUMP PSEUDO ISZ PLCN BUMP ACTUAL * PROC1 LDA .20B SET CODE TO = 20B(DEF) STA CODE IN ORDER TO FAKE OUT CHOP LDA STARX STA PLCN RESET PLCN TO STARTING VALUE CLA STA INST CLEAR INSTRUCTION LDA SCODE CPA .13B IS CODE = 113B?(NO INDIRECT) JMP PROC2 YES LDB BIT15 NO LDA .I JSB CHOP EVALUATE AN OPERAND JMP PROC3 ERROR EXIT JMP PROC4 NORMAL RETURN * PROC2 JSB CHOPI EVALUATE OPER.(NON-INDIRECT) JMP PROC3 ERROR EXIT JMP PROC4 NORMAL RETURN PROC3 CLA STA SUMP SET VALUE = 0 PROC4 LDA PNTR STA SCN1+2 RESET POINTER TO NEXT OPERAND LDA SUMP IOR INST STA INST INST = OPERAND VALUE SSA WAS ADDR INDIRECT? ISZ SCN1+2 YES, BUMP LOCN OF OPERAND LDB STAR STB PLCN SET LOCN COUNTER TO ACTUAL VALUE JSB LOUT GO PUNCH IT LDA .1+3 JSB LIST GO LIST IT ISZ PLCN BUMP LOCN COUNTER ISZ STAR BUMP PSEUDO LOCN COUNTER CLA STA INST CLEAR INST IN CASE FINAL NOP LDB SCODE CPB .12 CODE=114B? (NOP IN LAST WORD) JMP PROCA YES - EXIT ISZ OPNUM LAST OPERAND? JMP PROC1 NO - GO PROCESS NEXT ONE JMP HC04 YES - GO FOR NEXT SOURCE STATEM. * PROCA JSB LOUT GO PUNCH NOP LDA .1+3 SET FOR RESTRICTED LIST JMP HC30+1 GO. * STAR NOP PSEUDO LOCN COUNTER STARX NOP LOCN OF INSTRUCTION .13B OCT 13 13B SCODE NOP SAVE CODE-100B .100B OCT 100 100B M100B OCT -100 -100B OPNUM NOP SAVE OPERAND COUNT .20B EQU .12+4 20B ROTFL OCT 125252 ODD/EVEN FLAG LMASK OCT 377 377B UMASK EQU RAM+1 177400B * * ************************************ * * GENERATE A STRING OF BYTES. * * * OCTAL NUMBERS ONLY * * * -377 >= NUMBER <=+377 * * ************************************ * BYTEG LDA SCN1+2 START INITIALIZATION STA PNTR SET PNTR TO 1ST BYTE CLA STA T+1 SET FIRST LINE LIST OUTPUT FLAG LDA ROTFL STA SCODE SET RIGHT/LEFT ALTERNATOR * BYT01 LDB PNTR STB SIGN SAVE START OF BYTE CLB STB CNTC INITIALIZE CHARACTER COUNT * BYT03 LDA PNTR GET A CHARACTER JSB GETC STA TERM SAVE IT CPA L+4 COMMA? (END OF BYTE) JMP BYT05 YES GO PROCESS A BYTE CPA BLNK BLANK? (END OF BYTE AND STRING) JMP BYT05 YES GO PROCESS A BYTE * ISZ CNTC BUMP CHAR. COUNT ISZ PNTR BUMP CHAR. POINTER JMP BYT03 GO GET NEXT CHAR. * BYT05 LDB CNTC B=CHARACTER COUNT LDA SIGN A = POINTER TO BYTE JSB ?ASCN CONVERT BYTE TO OCTAL NUMBER CLA ERROR RETURN - SET A=0. STA B SAVE VALUE IN B AND UMASK SZA GRTR THAN 377B? CPA UMASK MAYBE - TEST FOR GOOD NEG. VALUE JMP *+3 NUMBER IS OK 1 JSB OPERR ERROR CLB LDA B AND LMASK LDB SCODE RBR,SLB LEFT BYTE BEING PROCESSED? JMP BYT10 YES STB SCODE SAVE LEFT/RIGHT FLAG ADA INST NO - SET UP TO GENERATE A WORD STA INST BYT06 JSB NOUT OUTPUT A WORD TO LIST/PUNCH LDA TERM GET LAST CHAR. TESTED CPA BLNK BLANK? (END OF STATEMENT) JMP HC04 YES - EXIT JMP BYT12 NO - GO START NEXT BYTE * BYT10 ALF,ALF PROCESS LEFT BYTE STA INST PLACE IN UPPER 'INST' STB SCODE SAVE LEFT/RIGHT FLAG LDB TERM CPB BLNK LAST TERM IN STRING? JMP BYT06 YES - GO OUTPUT IT BYT12 ISZ PNTR NO - START NEXT BYTE JSB ?BPKU JMP BYT01 * * ******************************************************* * * PROCESS BYTE LOCN DEFINE INSTRUCTIONS - DBL AND DBR * * ******************************************************* * BYTE LDA .20B STA CODE SET CODE=DEF TO FAKE OUT CHOP JSB CHOPI JMP HC17E ERROR EXIT CLE,ELB ADDRESS * 2. E := 0 FOR ERROR CHECK SEZ OPERAND VALID? JMP HP2D-1 NO,GO TELL EM JMP HCX GO COMPLETE PROCESSING * SPC 1 ******************************************************************** ********** CHANGE LOC'N. Z IN ASMB IF THIS PROGS. LWA > 1550B ****** ******************************************************************** SPC 1 ASMBX EQU ?ASMB ?AREC EQU BREC SPC 1 END ASMB4  &; 92060-18028 A S C0322 RTE ASMB XREF              H0103 ASMBҬB̬àůDS''SS-NŠABŠGNA HDůDSƠ9060-0(éH-PAKADMPANY95. NAM: SU:9060-0 :9060-60 PGM:..H. (éPYGHԠH-PAKADMPANY95.A̠GHS SVD.NϠPAԠƠHSPGAMMAYBŠPHPD PDUDҠANSADϠANHҠPGAMANGUAGŠHUԪ HŠPҠNNSNԠƠH-PAKADMPANY. NAMƬ3999060-60V.A500 Ԡì.PSY HSPGAMPDUSASSNŠABŠҠANPGAM NNHP-ؠASSMBYANGUAGŠ(HPAP.HŠABŠN- SSSƠASԠƠSYMBSNAPHABàDҬAHD BYSANNHŠPGAMANDASԠƠNS HAԠSYMB.AHANSA5-DGԠSUNŠNUMBҬ- DBYHŠNUMBҠƠHŠAPŠNHHԠAPPAS.HSŠ AŠSPAADBYASASH.HŠAPŠNUMBҠSNԠPNDHN NŠAPŠNYSS. HŠMHDUSDSϠADNHŠHPAPSUŠPGAMAND BUDAABŠƠNS.HŠAŠϠNNA̠ABSH AB̠ABŠ(ABANDHŠSSNŠABŠ(AB.HS ABSAŠGANZDASS: AB:AHNYNANSHŠAB̠NAMŠASS: DUNԠHA. HA.HA.3(PNA̩ HA.HA.5(PNA̩ HA.6HA.(PNA̩ HŠDUNԠMAYBŠ3Ҡ AB:AHNYNANSHŠNG: -NUMBҠƠDSNNY(-N- AB̠SUNŠNUMB .""ABSAŠADDDASNUND ... .N""SԠƠABpŠSPUSHDDN. NϠNKAGŠBNHŠABSSUDBAUSŠHŠNS AŠNHŠSAMŠDҠANDSPNDҠ. NŠHAԠABBGNSNנŠANDABNHGHŬSϠHA BHAŠPN-NDD. AAB̠HHHASBNDNDBUԠNVҠNDSSGNDBY A""NUMNPDNGHŠAB. AAB̠HHHASBNDNDMŠHANNŠ̠HAVŠADNN DƠHASHMAKS:"". AAB̠HHHASBNNDBUԠNVҠDND̠HAVŠA DNNDƠUSNMAKS"?????". ANYNSUNHAԠ̠HAVŠANԠUPNHŠPGAMSNG ASGBҬNZƬ.̠BŠDNDASS: "ؠNNNNNNNNNN"HŠؠSHŠYPŠƠNS. ANDNNNNNSHŠSUNŠNUMBҠƠHŠNSUN. AA̠NSUN̠BŠDNDASAAB̠HSDNN DHDSHҠSUNŠNUMBSDNŠHŠHYŠUSD. PAAMS:N(ABìDũ .NƬA(BìDũ A0ҠNԠSPD: DS-NPUԠMKAA -GA!("NDƠ" A̠NPUԠMASUŠ. AN̠NPUԠMUN. A-N̠NPUԠM-ASMBKAKS. -ASMB̠BŠ-SHDUD ASŠKAKSHNƠSDN. .NƬAB(ìDũ B0̠ASKҠNϠAPHAMS. B0̠ASK"NҠMSҠ" HŠPAҠSHUDNҠϠAPHAHAAS PSNNGHŠBGNNNGANDASԠSYMBS ƠHSPASS.HŠMSSAGŠ̠NNUŠA AHPASSUN̠AŠSND. 3.NƬAB(Dũ à0̠GVZAPŠNUMBSHSUNŠNUMBS àN̠GVŠNϠAPŠNUMBSHUSANG AGҠSUNŠNUMBS à-NƠ̠NUMBҠPAGSNSUVY MHŠASԠ-ASMBPAGŠNUMB. (APŠNUMBS̠BŠPND. ۠MŠHAN6APS:PSSNGMNAS! .NƬABìD(ũ D0̠GVŠ55NSPҠPAG. DN̠GVŠNNSPҠPAG.0 PAҠBANHABŠ AHSNGŠNYSPNDSҠHA3-DP-ABŠNY. NSAŠADDSSSƠPDůPANDPSSS. AMPS: <PGNà0àUNƠA̠ɯϬNUPS DBUƠUGN SBSPAŠGԠAN SBSPAŠN DAADBPGԠADDSSƠDUMMYBASŠPAG MANAMAKŠNG SANADBPSAV DAAMAҠH SAPSԠS SABSԠANDSԠUP SASԠSPNS DAPMSԠUPHŠHGHNDM MASSANAƠHŠPNKMAG SAPMAA(ƠNԠSANG DBD$NNҠ$NԠNHŠS SBS DASSSԠԠUPAS SAS5ɠAPAŠHSS DAP SASԴɠN DASԱSԠAG SA$NԠҠADPHAS DBD$PVDϠSAMŠҠ$PV SBS DAP SASԴ DASS SAS5 DASԱ SA$PVSԠAGҠADPHAS ASԠHŠNAVŠNPUԠAG SA DBD$SNҠ$ASN SBSŠHŠSYMB̠AB DBD$USNנNҠ$US SBS DBD$NԠAND$NB SBS DB$UAVAND$UAV SBS SBDSUSԠUPHŠDSàSPANS. SԠMŠBASŠGNAҠHANN SBSPAŠNנN HNԠDAP9 DBMS30MS30ADD:BGHN? SBADPNԠMSSAGŬGԠPY DAPSԠҠA̠DGSNPU SBDNGԠDGSUNA MPHNԠPAԠNPU SABHNSԠBGHANN̠N. GԠPV.N.ADADD. SBSPAŠNנN DUMYDAP DBMSMSADD:PV.N.AD? SBADPNԠMSSAGŬGԠPY DAPSԠҠA̠DGSNPU SBDNGԠDGS MPDUMY-ҬPAԠNPU. SAPàSԠADD.ƠDUMMY4AD. N BGNNN-DMSDŠ SԠSAPPNGAG DA"G"GԠASɠ'G'ANDG SBSAP?ASK'GSAPPNG?' SASAPƠSAVŠHŠAGB DA"BG"NנHŠSAMŠҠBAKGUND SBSAP? A̠PSNHŠB ҠSAPƠMBNŠH'G'AG SASAPƠANDSAVŠ NDNN-DMSDŠ Z BGNDMSDŠ DAP3SԠBHGAND SASAPƠBGSAPAGSAAYS. SPà SBSPA MAP?DAMMPASKUSҠƠDVSASS DBMSMP.MMNƠSϬSԠAG SBY?NϠSYSMϠMAPMMN MPMAP?ASKAGANƠBADANS SAMAPGSAVŠƠYS0ƠN NDDMSDŠ DA"G"NנASK SBK?'GŠK?' A̬A̠AŠϠPPҠBԠPSN ҠSAPƠMBN SASAPƠANDSAV DA"BG"NנDϠSAMŠҠBAKGUND SBK? AƬA ҠSAPƠMBN SASAPƠSAVŠHŠD. SPD̠SBSPA DAPGԠH DBMS33SAPDAY SBAD DAN3NV SBDNϠBNAYMDMA MPSPD̠ҠYAGAN ANDM00Ơ56 SZASSHN MPSPK SBNҠBHAND MPSPD̠YAGAN SPKDANϠMBN AƬAƠHSAP ҠSAPƠAG SASAPƠANDSAV N BGNNN-DMSDŠ SԠASԠDAVA̠MMY SBSPAŠNנN SMADAP DBMSS3MSS3ADD:AMM? SBADPNԠMSSAGŬGԠPY DAP5SԠҠ5A̠DGSNPU SBDNGԠDGSUN?~A MPSMAPAԠNPU SAASMSԠAMMҠSYSM NDNN-DMSDŠ Z BGNDMSDŠ SBSPAŠSKPAN MMSZDAP9HNASKUS DBMSS3ҠNUMBҠƠPAGS SBADƠMANMMY DANGԠDMA SBDNDGSҠYAGAN MPMMSZƠ SANUMPG SPà DMNŠASԠADDҠAVAABŠϠSDNԠSYSM SPà DBP3ƠPAGSS MBVҠ3HN ADBAUSŠ3SŠUS SSBSSHAԠHŠSAD DAP3 SPà S̠0MUԠBY0ANDSUBA ADAN6565ANDSAVŠASAS SAASMUSABŠMMD NDDMSDŠ SԠPGAMNPUԠUN SBSPAŠNנN PGMNDAP0 DBMSSMSSADD:PGMNP? SBADPNԠMSSAGŬGԠPY SBSNԠGԠDŬANAYS MPPGMNPAԠUNԠNY SAPGMADSԠPGAMNPUԠDVҠADD SԠBAYNPUԠUN SBSPAŠNנN BNDAP0 DBMSS5MSS5ADD:BҠNP? SBADPNԠMSSAGŬGԠPY SBSNԠGԠDŬANAYS MPBNPAԠNY SABADSԠBNPUԠDVҠADDSS SԠPAAMҠNPUԠUN SBSPAŠNנN PANDAP0 DBMSS6MSS6ADD:PAMNP? SBADPNԠMSSAGŬGԠPY SBSNԠGԠDŬANAYS MPPANPAԠPAAMҠNPU SAPAADPAADPAMNPUԠDVҠADD SBPBԠNSHHŠDSàSԠUP. DAANPԠSԠANS SAANSҠNԠD DAPSԠSԠBMƠPGAM SASSԠDNDS. SPà HŠNGUASSԠUPHŠUNԠPAGŠNKAGŠMAG AAHHSDBU.HSŠϠAASVAYH NA̠GNAҠDŠBUԠAŠNԠUSDUN̠PAMANDAD M. BPUDBU+6+3AVŠ6DSҠDBU BNKUBP-3SԠSAҠPN UBPUBP+ BPUBP+ BBPUBP+3 UBBPUBP+ BBPUBP+5 UBPUBP+6 UUBPUBP+ UBPUBP+ HDŠGNAҠNAZŠANDAD(VAYD NAZŠADNG NPUԠA SADNSԠDSKҠUNԠϠZ SBSPAŠNנN SBSPAŠNנN MAGԠMP+9ƠMAGAPŠNԠDNDSKP SBDMAGɠSŠND Ԡ3MԠUN ANAANDSPA BϠ SBDMAGɠNUMB Ԡ HԠ HԠHAS DAAMGԠASԠDAVA̠MMY ADAN9ADUSԠҠSԠDNԠNGH SABDNԠBDNԠADDҠƠSԠDN SAPDNԠPDNԠADDSSƠNԠDN DASSԠSSԠADDҠƠSԠPGMSԠNY SAPSԠPSԠADDSSƠNDƠS DADSKSàGԠDSKADDSSƠSAHAA SADSKADSԠUNԠDSKADDSS DBADBUƠGԠADDSSƠDBU SBUADNAZŠUNԠDBUƠADDSS SBBU̠AҠDBU DAN6 SADNԠNAZŠUNԠDBUƠUN ASԠA- SAPGPGADNGAG- SԠҠPGBNDƠAD SҠ00-ADNԠSUŠPG SҠ0-MNAŠADNG SҠ0-ADBAYPGAM SNSBHԷGԠSҬSԠNPUԠUN AGԠS SASKPƠMŠSϠAD MPSؠPSSNDƠADNDN SNDBPGMADGԠPGNPUԠDVҠADD ASSASKP-ADPGAMAP DBBADGԠBҠNPUԠDVҠADD SBPNADSԠNPUԠUNԠDVҠADD A SAGSԠԠAGGNŠ0 ADBNAYD DNDBABUƠABUƠADDҠƠBU SBBU̠AҠBU DADMAG PAPNAD ASS MPPDV. SASSYSSԠASԠSKAGS SASAUؠϠ-NASŠNPUԠMSAMŠDS DAN6 DBABU SBPNAD Ԡ000000 MPM MPPA. MPS PDV.DAN6 DBABUƠABUƠADDSSƠBU SBPNADɠGԠBNAYDMNPԠUN SZASԠҠDAMSNPU MPSҠNϠ-PSSD DAGGԠԠAG SZASKPƠMAؠ0ƠPMD MPDNGNŠ0DAMS MԠDAP DBMSSMSSADD: SBDKYɠPN: MPSNSԠSҬSԠNPUԠUNU PSSNPUԠD SҠA SAGSԠԠAGMAؠ0 DABU+GԠDDN AƬAҠAŠàϠנA ANDMSAŠ SAààDDNԠD SZASKPƠABSUŠD ADA6ADD-6B SSASSSԠҠà(5 MPҠNVADDYP SԠHKSUM DBBUƠGԠDNGH BƬBƠAŠϠנB MBNBSԠϠNG ADBP3ADD3ҠDUNԠNHKSUM SSBSSSԠҠSHԠ(3D MPҠSHԠ(-3DD SBKSUMGUŠHKSUM PABU+SԠHGVNHKSUM MPDàPSSVADD NVADHKSUM PA.ŠDA0 VDBBUSԠƠPSSNGASKP SSB MPDNHNUSԠNNU SBҠSNDҠMSSAG DAPGGԠHŠADNGAG DBDANDHŠNAMŠADDSSƠUNԠMDU SZAƠNԠHNAMDU DBMSUSŠ'(NN'NSAD DAP5PNԠ5HAAS SBDKYɠƠPGAMNAMŠNY HԠ0BAԠҠPA AGԠHŠSHGS DBPGGԠHŠADNGAG SSAƠUSHNԠHSN SZBƠNϠUNԠPGAM MPN̠GԠABUԠUSHNG DABUDSŠBAKUPHŠDNԠS SAPDN DABUSԠANDHŠNԠS SAPS ASԠHŠUSHNG SABUSԠAG SAPGANDHŠNAMPDAG SBDDUԠSԠHŠBUҠPNS DAD5ɠϠHŠGN SADSKAD MPDNGϠGԠHŠNԠD N̠DADMAGƠҠN PAPNADMASSSAG ASSHNSKP MPDNSŠADHŠD BMASSSAGŠS SBDMAGɠBAKSPA ԠN HԠD HԠAND MPDNADD ҠDA0 MPVGϠSԠANDPNԠMSSAG ASSYDSBYYP DàDAàGԠàDNԠD DBPGPGPGAMADNGAG PAPà?(NAM MPNAMҠPSSNAM SZBSKPƠNԠADNG MPNMҠDUԠƠSUN PAPà?(Nԩ MPNҠPSSNԠ PAP3à3?(DB̩ MPDBҠPSSDB̠ PAPà?(ԩ MPҠPSSԠ SKP PSSNDD ANASԠMASK ANDBU+SAŠMS AҠMVŠMSϠSGNPSN ҠD6ɠADDϠYP SAD6ɠSԠMSYP A SAPGSԠPGADAGADNG SANGSԠAGҠBUԠNDUN SBDԠPAKPUԠUԠϠDSK DAD5ɠGԠNAMDSKADDSS DBABUƠNPUԠNAMD SBDSK DAHMPD? SZASSYSSKP MPKSMNϬUSԠGUŠHKSUM DAHSŠNGH ҠMSGNNϠ SABU+6 KSMSBKSUMGϠGUŠHŠHKSUM SABU+NנHKSUM DAD5ɠUPUԠNAM DBABUƠDAGAN SBDSK MPDNNנG NMҠDA03NԠPNGUNԠDYP MPVSԠҠANAND. SPà D$PVDƠA$PV "BG"ASàBG N BGNNN-DMSDŠ "G"ASàG NDNN-DMSDŠ Z BGNDMSDŠ "G"ASà NDDMSDŠ N BGNNN-DMSDŠ SAP?ASKSHŠ'ؠSAPPNG?'USNANDUNS HŠANAZDANS. ANGSUN: DA"G"Ҡ"BG" SBSAP? UNAƠYS0ƠN. SAP?NP SAMS3ɠSԠHŠ'G'Ҡ'BG' SBSPAŠSPAŠϠMAKŠԠKNA SAPDAPGԠUN DBMS3GԠHŠMSSAGŠADDSS SBY?NϠASKANDANAZŠHŠSPN MPSAPBADNSYAGAN MPSAP?ɠ NDNN-DMSDŠ K?ASKSA6TRNNDANAZSHŠ'ؠŠK?'USN. ANGSUN: DA"G"Ҡ"BG" SBK? UNAƠYS0ƠN. K?NP SAMS3ɠSԠHŠ'G'Ơ'BG'NMSSAG SBSPAŠMAKŠԠKNA. KDAP3GԠHŠNGH DBMS3GԠMSSAGŠADDSS SBY?NϠGϠASKANDGԠANS MPKҠSϠY MPK?ɠUN SPà Y?NϠUNŠSNDSAUSNϠHŠY ANDADSANDANAZSHŠSPN ANGSUN: DAMSSAGŠHAAҠUN DBMSSAGŠADDSS SBY?N MP NMA̠UNAҠYS0ҠN. Y?NϠNP SBADGϠPNԠMSSAGŠANDGԠANS SBYůNϠANAZŠHŠANS MPY?NϬɠҠ ASSNϠUN ANAYSUN SZY?NϠSPUNADDSS MPY?NϬɠUNϠA. SKP NAMDPSS NAMUBU+3 NAM3UBU+ NAM5UBU+5 NPGUBU+6 NMUBU+ NYPUBU+9 NPϠUBU+0 NNԱUBU+ NNԲUBU+ NN3UBU+3 NNԴUBU+ NN5UBU+5 NN6UBU+6 DNAMDƠNAM NAMҠSZBSSSKPƠADNG MPNMҠDUԠƠSUN DAPDNԠSAVŠUNԠDNԠAND SABUDS DAPSԠADDSS SABUSԠҠPSSBŠMDUŠPUG DABUƠGԠDNGH AƬAƠAŠϠנA TPAP9SԠҠNAMà9DS DAPGԠNנNAMàNGHD AƬAƠAŠϠHGHA SABUƠSԠNAMàNGHND B SBDSNԠAҠDSKSGMNԠUN SBNGAҠDSKSGMNԠUNԠAG SBPGSԠPGNԠADNG DBDNAMGԠNAMŠADDSS SBDSSAHҠHŠNY MPNNAYS-NҠNAM DA0GԠҠDŠ-DUPAŠNAMS SBҠPNԠDAGNS DAP5 DBDGԠADDSSƠNAMŠNDN SBDKYɠPNԠDUPAŠPG.NAM MPPNAPAŠSԠƠDN NNADANAMGԠNAMŠ SADɠSԠNAMŠNDN DANAM3GԠNAMŠ3 SADɠSԠNAMŠ3NDN DANAM5GԠNAMŠ5 ANDM00SAVŠUPPҠHA SAD3ɠSԠNAMŠ5NDN DADNԠGԠADDSSƠNԠDN SAPDNԠSAVŠNԠDNԠADDSS PNADANYPGԠPGAMYP ANDMSAŠYP SBҠHANGŠƠNSSAYŠ3 SAD6ɠSԠYPŠNDN DBNMGԠMMNNGH SBDɠSAVŠMMNNGH DADSKADDSKADUNԠDSKADD SAD5ɠSԠUNԠDSKADDҠNDN DBNPGMPD? SSBSSƠYSSKPSԠSH AHSŬAҠSH SAH DAMNZŠHŠSԠDB̠ADDSS SADɠϠMAؠPSSB AANDHŠPG.NGH SAHMN.PSSB A SADɠAҠBSDNԠMANADDSS DNSBDԠPAKDUPUԠϠDSK MPDNGԠNԠD SKP DB̠àPSS DBҠDABU+3GԠHŠANADDSS MANA ƠSSHANUN ADADɠMN. SSASKP MPDBұSŠUSԠSKP DABU+3NנMN.SϠSԠ SADɠNHŠDN. DBұDABU+GԠHŠNGH ANDMƠHŠD(N.ƠPGAMDS ADABU+3MPUŠMA.ADADDSS DBASAVŠNB MBNBƠHSSAN ADBHMA.HN SSBSԠH SAHNנMA. MPDNGϠŠHŠDϠHŠDS SKP NԯԠDPSS NҠASSNԠPSS ҠAԠPSS SANGNGNԯԠAG DABU+SԠN.SYMBS ANDM3SAŠN.SYMBS MANA SANԠSԠSYMB̠UN DBABUƠABUƠA(BUƩ ADBP3P3+3 SBSYMSԠSANGSYMB̠ADD SNؠDBSYMSԠBҠS SBSŠNҠSYMB̠NHŠS MPN3NנNYGϠNSH. DANGGԠNԯԠAG SZASSSKPƠN MPNشMPŠԠPSSNG PSSNԠ DASԴƠHSSAUD MANASYMB ADASSԠHN SSASSGVŠ MPDUPN DASԴɠGԠDƠSԠNY SZASSSKPƠNN-ZϠ(DND MPNزMAKŠNYҠDND SSASKPƠNYMAD MPN6MAKŠNYҠBS DUPNDA05SԠDŠ-DUPAŠNYPN SBҠPNԠҠMSSAG DAP5 DBSԱSԱADDҠƠSYMB SBDKYɠPNԠDUPAŠNYSYMB DASԴɠGԠHŠUNԠDNNG ADAN5VAUŠANDƠNԠASƠDNNG SSASSSYMB MPNز6GϠDNŠHŠSYMB MPN5SŠGϠDNŠNYƠNנSƠD. N6DAD6ɠGԠUNԠYP ANDMSAŠYP PAP3YPŠBGDSKSDN? SSYS-NNUŠ(ҩ MPNزMAKŠNYҠUNDND DAұ3SԠDŠNVADBGBSD SBҠVABŠ NزDADGԠMANDNԠADDSS SASԴɠNҠDNԠADDҠND MPN5 N3DANGGԠԯNԠAG SZASKPƠԠNY MPNزSԠDƠNԠNY DAD6ɠGԠYP ANDMSAŠYP DBDGԠMANDNԠADDSS PAP5YPŠBS? MBSSYS-SԠSԴBSƬSKP BNϠ-SԠSԴUNDND SBSԴɠYS-SԠADDSSNSԠD NشDAD6ɠGԠYP ANDMSAŠYP PAP5YPŠBGSGMN? SSYS-NNU MPN5NϠ-GNŠBGSGMANADD DADGԠUNԠDNԠADDSS SAMANSAVŠDNԠADDSS DASԴɠGԠDNԠADDSS SZASKPƠUNDND SSASKPƠDNԠADDSS MPN5GNŠUNDND PAPƠSPA̠SYMB SSSSҠG PAP3HŠBS SSB PAP MPN5 SADNԠSԠDNԠADDSSҠD SBDؠSԠDNԠADDSSS HԠ0DNԠNԠUND DAD6ɠGԠYP SSASSSKPƠMAN MPNMANSԠAGҠGNNGBS ANDMSAŠYP PAP3YPŠBGDSKSDN? BSSSԠAGҠBSƬSKP NMANBSԠAGҠGNNGBS SBHAҠSԠAG0-GNůBS DAMAjNGԠUNԠDNԠADDSS SADNԠSԠҠNԠDNԠADDSSS SBDؠSԠUNԠDNԠADDSSS HԠ0ADDSSNVAD SZHAҠSKP-SԠDNԠADDҠҠBS MPN5GNŠƠNԠMANBGDSKS DASԴɠGԠBGMANADDSS SADɠSԠMANDNԠADDҠNBSDN N5DASYMGԠSYMB̠ADD ADAP3ADUSԠҠBHNԠ SASYMSAVŠHŠADDSSҠNԠSYMB DBNGGԠԯNԠAG SZBSSƠԠSKPHŠSPA̠SYMB MPNظD ADBSYMGԠHŠAG DABɠϠA ANDP5SAŠHŠSYMB̠YP DBSԴɠƠUNDNDMUS SZBSSBŠAUD MPNطSYMB̠SϠDN'ԠS SZAƠPGAM PAPҠBASŠPAG MPNطHNSANDADSYMB̠SKP SASԴɠSԠHŠSPA̠AG DASYMɠGԠHŠVAU SAS5ɠANDSԠ NطSZSYMSPϠHŠNԠSYMB NظSZNԠSԠSYMB̠UN MPSNؠPSSNԠSYMB MPDNPAKDUPUԠϠDSK SKP ŠààNDSK DԠPAKSHŠUNԠNNSƠBUƠNϠDBUƠANDDUMPS DBUƠHNԠNANS6DSƠAABŠNPU. ƠHŠNDDSBNGPSSDDԠSS PSSNGBAYPGAMSANDSSHŠN.ƠPAKD AABŠBAYDSND0ƠDNԠ USŠNMVNGHŠAABŠBAYϠHŠPD AAƠHŠDSKAҠHŠADNGPHASŠSMP. ANGSUN: AGND BGND SBD UN:NNSƠAANDBDSYD DԠNP DBABUƠGԠADDSSƠBU SBUA̠SAVŠUNԠBUƠADDSS DABUƠGԠDNGH ,AƬAƠAŠϠנA MANA SANԠSAVŠDNGHUN DDAUA̬ɠGԠDMBU SAUADɠSԠDNϠDBU SZDNԠSKPƠDBUƠU MPG̠SԠҠNDƠBU SBDDUԠUPUԠDBUƠϠDSK SSMԠUNԠDBUƠADDҠNMN G̠SZUADNҠUNԠDBUƠADDSS SZUA̠NҠUNԠBUƠADDSS SZNԠSKPƠBUƠMVDϠDBU MPDMVŠNԠDϠDBU DANGGԠNDAG SZASSSKPƠNDDAD MPDԬɠUN DADN PAN6BUҠMPY? SS SBDDUԠUPUԠϠDSK DAD6ɠGԠYP ANDMSAŠYP PAP5YPŠBGSGMN? MPDԬɠUN DADSNԠGԠA̠BҠDSKSҠUN SADɠSԠA̠SҠUNԠNDN MPDԬɠUN SKP UPUԠDBUƠϠDSK HŠDDUԠSUBUNŠSHŠNNSƠDBUƠNH UNԠDSKS.NGHSDBUƠSAD HŠUNԠADDSSANDUNԠҠDBUƠAŠSԬ ANDHŠNԠDSKADDSSSSԠNϠDSKAD. ANGSUN: AGND BGND SBDDU UN:NNSƠAANDBAŠDSYD DDUԠNP DADSKADGԠUNԠDSKADDSS DBADBUƠGԠBUҠADDSS SBDSKϠUPUԠDϠDSK DBADBUƠGԠADDSSƠDBU SBUADNAZŠDBUƠUNԠADDSS SBBU̠AҠDBU DAN6 SADNԠNAZŠUNԠDBUƠUN SZDSNԠUNԠD DADSKADGԠUNԠDSKADDSS SBDSKANҠUNԠDSKADDSS SADSKADSԠNנDSKADDSS MPDDUԬɠUN SKP /1APHABàNPUԠN HŠSNԠSUBUNŠANAYZSHŠSPNSŠҠHŠPGAM BAYANDPAAMҠNPU. ANGSUN: AGND BGND SBSN UN: (N+:ANNVADSԠƠHAAS(NԠPԬMԬY ҠN.ƠHAASHASBNDD. AҠPNNGHŠDAGNSìAUNSMADŠ PMԠHŠMSSAGŠϠBŠPAD.HŠNNS ƠAANDBAŠDSYD. (N+:AADDSSƠDSGNADNPUԠDV BDSYD SNԠNP DANSԠMAؠN.DGSҠGNA SBGNAMVŠBUƠϠBU SBGA̠GԠNԠHAҠMBU PAZϠHAҠZ?(NDƠBUҩ MP+3YS-NNU DNSBNҠNVADYSPNS MPSNԬɠUN- DABUƠGԠ-HAAҠD PA"Y"YPŠY? MPYUNYS-UNԠSYP PA"P"YPŠPԠAD? MPPUNSԠUNԠPԠAD PA"M"YPŠMAGAP? MPMUNSԠUNԠMAGAP PA"D"YPŠDSà? MPMUN-PSSASMAGAP. MPDNNVADPԬMԠҠY YUNDADYDYYNPUԠDVҠADDSS SS PUNDADPҠDPҠPԠADҠDVҠADD MPP.DV MUNAMԠҠD PADMAGDVҠADD? MPDNNϠ- SAMAGԠYS-AҠAGϠPMԠND DADMAGDMAGMAGAPŠDVҠADD P.DVSZSNԠNҠUNADDSS MPSNԬɠUN HDŠGNAҠSԠUNDNDNAS(VAYD SԠUNDNDS HŠUNDNDNA̠NSANBŠSDA AHND--APŠNDNSDD. NGMPNƠHŠԠSNGHŠMPU HASϠPMԠHŠPAҠϠUNҠADDNA PGAMNPUԬҠNNUŠHHŠPSSNGƠPAAMS. SؠSBSPAŠNנN SBSPAŠNנN A SANNԠSԠSYMB̠UNԠ- DASSԠSԠBMƠPGMS SASԠҠSAN UNؠSBSؠSԠSԱ-S5 MPUԠNDƠS DASԴɠGԠDƠS MASSANASZASKPƠUNDNDҠBS MPUNؠYNԠSԠSYMB SZNNԠSԠҠSԠUNDƠ MPUؠNϠ-PUԠUԠSYMB̠NAM DAP0 DBMSSMSSADD:UNDƠS SBDKYɠPN:UNDƠS SBSPAŠNנN UؠDAP5 DBSԱSԱA(SYMB̩ SBDKYɠPNԠSYMB MPUNؠYNԠSYMB UԠSZNNԠSԠҠNϠUNDƠS MPNDؠNϠ-MԠMSSAG DAP DBMSS9MSS9ADD:NϠUNDƠS SBDKYɠPNԠMSSAG NDؠSBSPAŠNנN SBHԷAԠҠPAҠNVNN AGԠSHGS SASSSKPƠSH0UP MPSNSԠҠPGAMҠBҠAD ASԠPDSKADDSS SADSKAZ SAҠAҠHŠҠAGҠPAMNPU SASH SASHAҠSHDDSGAG DAMAGԠƠMԠҠDƠUSD SZAҠNPUԠSKPϠND MPPASNϬNAŠPAAMҠNPU. SBDMAGɠNDSANDBY Ԡ5MԠҠD. MPPASNAŠPAAMҠNPUԠSN HDŠGNAҠA̠SAGŠ(VAYD 0ASà0HKSUM 03ASà03DUԠƠSUN 0ASà0NVADD 05ASà05DUPAŠNYPNS 0ASà0DUPAŠPGAMNAMS ұ3ASà3BGSGMNԠPDSBGMAN F "Y"ASàY "P"ASàP "M"ASàM "D"ASàD D$NDƠ+ ASà3.ZN A$PVASà3.ZPV MSS3DƠ+ N ASà5AMM? Z ASà5MMSZ? MSSDƠ+ ASà5PGMNP? MSS5DƠ+ ASà5BҠNP? MSS6DƠ+ ASà5PAMNP? MSSDƠ+ ASà MSSDƠ+ MSS9DƠ+ ASàNϠUNDƠS MS30DƠ+ ASà5BGHN? N BGNNN-DMSDŠ MS3DƠ+ ASà6GSAPPNG? NDNN-DMSDŠ MS3DƠ+ ASàGŠK? MS33DƠ+ ASà6SAPDAY? Z BGNDMSDŠ MSMP.DƠ+ ASàPV.DVSASSMMN? MMPUP NDDMSDŠ SSԠNP BUDNP BUSԠNP SPà PGMADBSSPGAMNPUԠDVҠADDSS BADBSSBNPUԠDVҠADD PNADBSSNPUԠDVҠADDSS GBSSNDAPŠAG-0GNMA NGBSSBUԠNDAG àBSSDDNAND SYMBSSHAҠADD NNԠBSSUNDNDSYMB̠UN PMDƠ-6NDƠPNKMAGŠAA HDŠGNAҠPAAMҠPHAS HKSUMUN BUDAHKSUMҠHŠDNBU ANGSUN: AGND BGND SBKSUM UN: AHKSUMƠD BDSYD KSUMNP DBBUƠGԠDNGH BƬBƠAŠϠנB MBNBSԠϠNG ADBP3ADUSԠUNԠϠSHנSKPPDDS SBDNԠSԠDDUN DABU+GԠDNAZŠHKSUM DBABUƠABUƠA(BUƩ ADBP3SԠϠD ADABɠADDDϠHKSUM NBNMNԠADDSS ST$ZDNԠSKPƠNDƠD MP-3NNU MPKSUMɠUN SPà NUMA̠NPUԠN HŠDNSUBUNŠANAYZSHŠNPUԠҠH HANN̠N.DSKSZSBGHANN̠N.ANDAS DƠAVAABŠMMY. ANGSUN: AMAؠN.ƠHAASPMDNSPNS. HŠSGNƠADMNSHŠNVSNM ASɠϠA̠(PS.ҠDMA̠(NG.. BGND SBDN UN: (N+:NNSƠAANDBAŠDSYD.ANNVAD HAAҠHASBNDDNHŠSPNSŬ HŠSPNSŠNANSANNVADN.HAAS. HŠMSSAGŠSϠBŠPADNUN. (N+:ANVDSU DNNP SBGàGԠA̯DMA̬UNA MP+NVADDG SBGA̠GԠNԠHAҠMBU PAZϠHAҠZ?(NDƠBUҩ MP+3YS-NNU SBNҠNVADDGԠNY MPDNɠUN SZDNNҠUNADDSS DANϠGԠNVDNUMB MPDNɠUN SKP NVADYSPNS HŠNҠSUBUNŠPNSHŠDAGNSàҠNVAD SPNSSDUNGHŠNAZANSN. ANGSUN: AGND BGND SBN UN:NNSƠAANDBAŠDSYD. NҠNP DA0SԠNVADDVŠҠD SBҠPNԠҠMSSAG MPNҬɠUN SPà 0ASà0 SKP SԠPAAMSNϠDNS HŠPAAMҠNPUԠSNPMSAAN(ҠNDUN ƠHŠYPŬPYANDUNNVA̠ҠAHPGAM. AHPAAMҠDHASNŠƠHŠNGMAS: NAMŬYP NAMŬY2PŬPY NAMŬYPŬPYUNNVA YPŠDMA̠DGS(-99 PYDMA̠DGS(0-99 UNNVA̠6PANDS -SUNDŠ(DMA̠DGS -UNMUPŠ(5DMA̠DGS 3-HUS(DMA̠DGS -MNUS(DMA̠DGS 5-SNDS(DMA̠DGS 6-0'SMUSNDS(DMA̠DGS N:YPŠƠBGDSKSDNSHAVNGBGSGMNSMAYN BŠADHUԠDSYNGANSHP. PAAMSBSPAŠNנN DADSKASAVŠUPPҠDSàADDSS SADSSϠŠANMDYPGSNHŠDS DAP0 DBMSMSADD:PAAMS SBDKYɠPN:PAAMS SBSPAŠNנN DBPAADGԠPAAMNPUԠDVҠADDSS PBDYNPUԠUNԠY? SSYS-NNU SBHԷAԠҠNSNƠPAAMS PASԠDAP6 DBABUƠGԠADDSSƠBU SBPAADɠGԠASɠPAAMҠD SZASSSKPƠHASNPU MPPASԠPAԠPAAMҠNPU SAPANϠSAVŠPAAMҠDNGH NAZAPD ŬANG ADAABUƠHŠNPUԠSNG BASA SBAɠSANNҠSP SBGNԠNAZŠBUҠSAN DAN5 SBGNAMVŠHASMBUƠϠBU PA""HAS? MPSBYS-SԠBAYYPŠNDN PADBKBANKNŠҠMMN? MPPASԠYSYANH SBGA̠GԠNԠHAҠMBU PABANKHAҠBANK?(DMҠMMA MPPANKYS-NNU PANҠDA09PAAMҠNAMŠ MPPA PANKDBABUƠNDHŠPGAM SBDSNHŠDNԠAB MPPANҠNԠUND-NVADNAM {SԠYP DAN SBGàNVԠϠA MPPAҠNVADDG SBGA̠GԠNԠHAҠMBU PAZϠHAҠZ?(NDƠBUҩ SSYS-NMU PABANKHAҠBANK?(DMҠMMA MPSYPSԠPGAMYPŠNDN PAҠDAұ0PAAMҠYPŠ MPPA SYPBƠHSSHŠSHDUDPGM DADAGAN PASHHN SBSHAҠSAG DBNϠGԠNVDNUMB DAD6ɠGԠUNԠYP ANDMϠA PABƠNϠHANG MPYPKSKPHK PBPƠHANGŠSϠŠSB PAP6MUSԠBŠGA̠ŠS.B.MDU SSKSKP MPPAҠNԠK YPKDANϠƠAUϠSHD ANDP6BԠNԠS SZASSHNUSԠG MPSHSԠYP. SPà DBNϠAUϠSHD...SUBA ADBN00MYPŠ SBNϠGԠA̠YP. SPà DAD6ɠMGŠMSBԠN ANDMSGNHYP. ҠB DBDBPNSϠDN. SPà SSASSƠNԠMANPGM MPSHGNҠ ANDMMASKϠHŠDYP SZAƠZϠ ADAN5MŠHAN SSASKP SBSHSŠSԠPGMDNԠNSHAG SPà SHDANϠGԠNנYP SBҠҠԬ DBAHNMG DAD6ɠNϠDNԠ6 ANDM600 ҠB SAD6 SPà SBGA̠GԠNԠHAҠMBU PAZϠHAҠZϠ?(NDƠBUҩ MPPASԠYS-GԠNԠPAAMҠD SԠNנPGAMPY 1 DAN5SԠUNԠҠDMA̠NVSN SBGàNVԠϠA MPPAPҠPY SSAƠNGAV MPPAPҠHN SBGA̠GԠNԠHAҠMBU SZAHAҠZϠ?(NDƠBUҩ PABANKHAҠBANK?(DMҠMMA MPSNҠSԠPY PAPҠDAұPAAMҠPY MPPA SNҠDAD5ɠGԠHŠNAMD DBADBUƠϠDBU SBDSKɠMHŠDS DBNϠGԠPY SZBSSSKP-PYND DBP99PAŠZϠPYH99 DAD6ɠGԠHŠYP ANDMANDSAŠ SZASSƠASYSMPGAMUS BPYZ SBDBU+0SԠNנPYNHŠD SBGA̠GԠNԠHAҠMBU PAZϠHAҠZϠ?(NDƠBUҩ MPPAҠYS-GϠŠHŠNAMD GԠSUND DANSԠҠDMA̠DGS SBNԠGԠDGSMBU SADBU+SԠNHŠNAMD GԠUNMUP DAN5SԠUNԠҠDMA̠NVSN SBNԠGԠDGSMBU ANDM600SAŠUPPҠ3BSNA SZASKPƠVADMUP MPPAҠNVADUNNVMA DANϠGԠNVDNUMB SADBU+SԠNHŠNAMD GԠHUS DANSԠҠDMA̠DGS SBNԠGԠDGSMBU SADBU+3SԠNHŠNAMD GԠMNUS DANSԠҠDMA̠DGS SBNԠGԠDGSMBU SADBU+SԠNHŠNAMD 0GԠSNDS DANSԠҠDMA̠DGS SBNԠGԠDGSMBU SADBU+5SԠNHŠNAMD GԠNSƠMSNDS DANSԠҠDMA̠NVSN SBGàNVԠϠA MPPAҠNVADDG SBGA̠GԠNԠHAҠMBU SZAHAҠ0?(NDƠBUҩ MPPAҠNϠ-NVADDM DANϠGԠNVDNUMB SADBU+6SԠNHŠNAMD PAҠDBABUƠMVŠHŠD DAADBUƠBUƠҠHKSUM SBMV Dà-6 SBKSUMDϠAHKSUM SABU+SԠNHŠD DAD5ɠGԠHŠDSàADDSS DBABUƠANDŠHŠNAMD SBDSKϠBAKUԠϠHŠDS MPPASԠGԠNԠPAAMҠD UNNVA̠NPUԠN NԠNP SBGàNVԠϠA MPPAҠNVADDG SBGA̠GԠNԠHAҠMBU PABANKHAҠBANK?(DMҽMMA SSYS-NNU MPPAҠNϠ-NVADDM DANϠGԠNVDNUMB MPNԬɠUNHNUMBҠNA PAҠDAұPAAMҠNVA̠ PAҠSBPNҠSNDҠMSSAG MPPASԠYAGAN PNҠNPSUBUNŠϠSԠҠHϠANDPNԠ SAMPŠSAVŠҠD SBPNԠSԠҠPNNGBU DAMPŠGԠҠD SBҠPNԠҠMSSAG SBSPAŠNנN MPPNҬɠUN PNԠBUƠUNSSMY PNԠNPPNԠNNSƠBU DBPAADGԠADDSSƠPAAMҠUN PBDYDVŠY? MPPNԬɠYS-MԠPNԴ#TRNNGNY DAPANϠPANϠPAAMҠDNGH DBABUƠABUƠBUҠADDSS SBDKYɠPNԠPAAMҠD MPPNԬɠUN SBSBPNԠSԠҠPNNG SBSPAŠNנN HANGŠNSSN DAPGԠMSSAGŠNGH DBMSSNDMSSAG SBDKYɠ'HANGŠNS?' SBSPAŠSKPAN PNԠDAP6ADH DBABUƠNԠD SBPAADɠMHŠPAMҠNPUԠDV SZASSƠZ MPPNԠYAGAN SAPANϠSAVŠUN NAMPUŠH ŬAASԠDADDSS ADAABUƠAND B SBAɠAҠHŠNԠD SBGNԠGԠHŠNԠNAM DAN5 SBGNABU PA""Ơ'' MPNԠDNŠGϠϠNԠSN PADBKƠ''ҠBANKN MPPNԠYHŠNԠN SBGA̠GԠHŠNԠHA PABANKƠMMA MPNKK DA09SŠ MPAҠGϠPԠ NKDBABUƠNDH SBSŠDNŠANDҠAŠS NP(DN'ԠAŠƠAҠDND DANGԠYPŠAG SBGNAAA PA"AB"ƠABSU BŠSԠAG PA"P"ƠPA BŬNBSԠHҠAG SZƠNNŠƠHŠABV MPNN AҠDAұ0HNSND AҠSBPN MPPN NNϠADBP3ADUSԠϠNԠYP SBDSSAVŠNMP cTTSBGA̠HKҠMMA PABANKASNԠHAA SSƠN MPAҠBH DAUA̠SAVŠUN SADPSN DABUU̠ҠBAKNG SADUP DAPGԠNUMB SBGàASSUMNGA SSƠҠMGHԠBŠDMA̠SϠSKP MPNàԠSA̠SϠGϠSԠUP DADBAKUPHŠSANN SAUA̠PSN DAD SABUU DANNנY SBGàADMA̠NVSN SSҠPD(35DNHŠD MPAҠNϠҠSϠNGNPU DAHAҠMAKŠSUŠ PAP0ASNA"D" SSYSSϠAҠSϠGD MPAҠNϠGϠBH NàDADSSԠHŠNԠYP SASԴɠAND DANϠVAU SAS5ɠNHŠSYMB̠AB MPPNԠGϠGԠNԠSYMB. NԠSBPNԠPNԠŠƠUD SBSPAŠSNDASPA DADSSŠHŠPƠDS SADSKAAG SKP SԠBAYMYPŠAS HSSNSUDHNHŠPAAMSHAV BNMPYADN.ԠMPUSHŠMAMUMNGH BHHŠA̠MŠANDBAKGUNDMMNAAS. NAYԠSVSA-DSNƠDŠҠAHUS PGAM(PUSANADDNA̠6DSƠDSKSDNԩ GNAŠHŠDSGMNS.NAYԠSVSAKYD NANHŠADDSSƠAHDSGMN. A SAGBGàAҠGUNDUSNGBGMMNAG SASNԠAҠSHԠDSGUN SANԠAҠNGDSGUN SASSNԠAҠBGSG.DSGUN SAMԠAҠԠMNGH SAMBGAҠBGMNGH SBNDؠNAZŠD SؠSBDؠC_SԠDNԠADDSSS MPMNMNAŠDSGMNԠUN DAD6ɠGԠYP ANDMSAŠtYPŠANDVMBS DBDɠGԠMMNNGH ŠAҠGUNDUSNGBGMMNSH PAPƠBGSDNԠUSNGGMMN SS N BGNNN-DMSDŠ PAPҠBGDSàSDNԠUSNGGMMN SS PAP3ҠBGSGUSNGGMMN SS NDNN-DMSDŠ PAPҠYPŠԠSDN? SS PAPҠYPŠԠDSKSDN? MPSàSԠԠMMNNGH PAP9ƠGS.USNGBGMMN ŬSSSԠSSMMNSH PAP0KSŠƠGDSàSDN ŬSS PAP3YPŠBGDSKSDN?? N BGNNN-DMSDŠ SS PAPYPŠBGSDN? SS PAP5YPŠBGSG?? NDNN-DMSDŠ MPSBàSԠBGMMNNGH Z BGNDMSDŠ DAD6ɠGԠYPŠAGAN ANDM3BUԠAVŠSSGABԠN NDDMSDŠ PAPƠŠSB. SS PAZϠYPŠSYSM? SS PAP6YPŠBAY? Z BGNDMSDŠ SS PAP30YPŠSSGA?? NDDMSDŠ SZBSSSKP-HASNVADMMN MPSұKGϠSŠƠDSGNDD DA3SԠDŠNVADMMN SBҠPNԠDAGNS DAP5 DBDGԠDNԠADDSS SBDKYɠPNԠPGNAMŠҠNVADM MPSؠPSSNԠDN SBàSZƠSSMMNSHS SZGBGàSԠHŠSSMMNAG DAMBGGԠPVUSMAؠMMNNGH /MANA ADABSԠAPGM-PVUSM SSASSSKPƠPVUSGA SBMBGSԠNנMAؠBGMMNNGH MPSұHKYP SàDAMԠGԠPVUSMAؠMMNNGH MANA ADABSԠAPGM-PVUSM SSASSSKPƠPVUSGA SBMԠSԠNנMAؠԠMNGH SұDAD6ɠGԠMS SSASSSKPƠMAN MPSؠPSSNԠDN ANDMSAŠYP PAPYPŠԠSDN? N BGNNN-DMSDŠ SS PAPҠYPŠBGSDN? NDNN-DMSDŠ SZSNԠYSUNԠSHԠDSGMN PAPƠGUNDDSàSDN SS PAP3BAKGUNDDSàSDN SZNԠUNԠANGDSGMN PAP5ƠASGMN SZSSNԠUNԠASGMNԠDSGMN MPSؠGϠPSSHŠNԠMDU MNSBSPA DAP3 DBMSMSADD:ƠBANKD'S SBADPNԠANDGԠPY DANGԠ SBGàDMA̠DGSNV MPM-NVADNPU. SZASSƠZϬADD NAҠBKG.N-NŠADNG. ADANԠADDϠNGDSGMNԠUN. SAN SBSPAŠSND MDAP3MSSAG DBMS3'ƠBANKSGMNԠD'S?' SBADANDGԠANS DANNV SBGàHŠANS MPMҠYAGAN SPà ADASSNԠADDϠHŠSHԠDSGUN SASSNԠANDS ADANԠSUMHŠA̠UN ADASN NAADDNŠҠSPD SAKYN Z BGNDMSDŠ 8 ASKҠMAMUMNUMBҠƠPANSϠBŠDND SPà SBSPA GNPDAMS30̠NGHƠMSG DBMS30.ADҠƠMSSAG SBADSNDANDADSPNS DANHKҠDMA SBGàDGSNSPNS MPGNPYAGANN SPà DBN65 ADBAƠMŠHAN6 SSBSSHNGϠANDASK MPGNPAGAN SAMAPԠSŠSAVŠMAؠN.PAS. NDDMSDŠ MPNԠGϠADHŠSYSM MDAM3PN SBҠ"Ҡ0" MPMN+ DBKASà M3ASà0 SSNԠNP "P"ASàP DSNP MSDƠ+ ASà6HANGŠNS?MSSAG SPà MSDƠ+ ASàPV.N.ADADD? SPà MSDƠ+ ASàƠBANKDSGMNS? SPà MS3DƠ+ ASà6ƠBANKBGSG.DSGMNS? BGNDMSDŠ Z MS30.DƠ+ MS30ASà3MAؠNUMBҠƠPANS? MS30̠UP5 NDDMSDŠ SKP AҠUNDNDS PASDASSԠNAZŠS SASԠGNҠPDNDNS S3SBSؠSԠSԠADDSSS MPNDBSԠUSAGŠAGS DASԴɠGԠDNԠADDSS MANA SSASKP-UNDND MPS3GNŠDNDNYPN DAPSԠUNDNDSϠZϠPAŠNS SASԴɠAҠDNԠADDSS MPS3YNԠSԠNY SPà HSUNŠSADAҠHŠSYSMSADDBUԠBŠH BAY. SPà oAҠADAGSҠYPŠ6PGMS 6NP SԠBAYSDNԠAGS SBNDؠNAZŠD SؠSBDؠSԠDNԠADDSSS MP6ɠNDƠDNS DAD6ɠGԠYP ANDMSAŠYP PAPƠUDŠS. SSPSS PAP6YPŠBAY? SSYS-NNU MPSؠPSSNԠDN DAD3ɠYPŠ6-GԠADAG AҬŬAADBԠϠŠ-ANDAD SAD3ɠSԠADAG SZSSASԠADD? MPSؠNϠ-NNU DA39YS-GA̠SYSMN SBҠҠ39 DAP5NנSNDHŠNAM DBDƠHŠADPGM SBDKY SPà SBNSԠNAZŠS SUؠSBSؠSԠUNԠSԠADDSSS MPSؠND-NNUŠDSAN DASԴɠGԠDNԠADDSS PADNԠBNGSϠUNԠPG? ASSYS-NNU MPSUؠNϠ-YNԠN SAS5ɠSԠNKϠZ. MPSUؠNNUŠSAH SPà DM̠NPDMŠUNADYPŠ6ϠYPŠ DABDNԠSԠUPHŠSAN SADNԠPAAMS DAP6ҠYPŠ6 SAPYPŠSAN DMSSBDSNGϠSԠDADDSSS MPDM̬ɠND-SϠUN DBD3ɠASPGM SBSSADD? SZD6ɠNϻHANGŠϠYPŠ. MPDMSYSNϠNNUŠSAN NDBDBD$ҠNDHŠBAY SBSSNYPNS$B ASSUSŠZϠƠNԠUND DASԱ SA$BҠSAVŠҠHŠAD DBD$ؠDϠSAMŠHNGҠ$B SBSS ASS DASԱ SA$B DAAPASGnԠADDҠƠPAAMҠNPUԠD SAANSSԠNA̠ANSҠADDSS MPPAAMGԠPAAMS D$ҠDƠ+ ASà3$B D$ؠDƠ+ ASà3$B HDŠGNAҠGNAŠɯϠABS GNAŠɯϠABS HSSNƠDŠGNASHŠɯϠABS ҠHŠSYSM.HSŠNUDŠHŠUPMNԠABŠ(ԩ SANDADDVŠNŠABŠ(DԩANDNUPԠAB. HŠԠDSHAVŠHŠNGMA: NDVNHNSUƠԠNMDU. SPà DASMPؠVAU-ABŠPN ADAPϠADDSSN SASMP5-DNY. MPSPPBAK̠DN. SPà HŠNGABŠNANSA5-D NYҠAHƠHŠSYSMNY PNSϠBŠSUDHAVAU.H ABŠNDSHADNANNGZ. NYSUU: D0-PNҠϠNYP.NAM D-VAUŠϠBŠSUDNNYP. DS3-NYPNԠNAM SPà SABU $MMPDƠ+ NP ASà3$MMP $NDSDƠ+ NP ASà3$NDS $MAADƠ+ NP ASà3$MAA $MPSADƠ+ NP ASà3$MPSA $MPԠDƠ+ NP ASà3$MP $ҠDƠ+ DP̠NP(VAUŠSԠHNPANSDND ASà3$ $BGҠDƠ+(VAUŠSԠAҬASABVũ DPBG̠NP ASà3$BG $MPDƠ+ NP ASà3$MP $PSADƠ+ NP ASà3$PSA Dà0NDƠABŪ SPà S.DƠSAB SMPBSS MMMPBSS SPà SNDU SKP SԠGA̠ADDSSSƠSYSMAVAABŠMMY MMSԠDADDҠƠS.A.M. MMASԠDADDҠƠS.A.M.+ N:HŠMGA̠ADDSSSUSDSNŠS.A.M. MAYAPPAҠϠHŠSYSMAԠANADDSSHHS HAN(BYANNGA̠ƠPAGSSPHYSA̠ADD. HSSBAUSŠSSGAANDBHMMNSPHYSAYSD BNHŠNDƠHŠBAYANDHŠSAԠƠSAMY HSŠAASAŠNԠNUDDNHŠSYSM'SMAP(Ҡ"GA ADDSSSPA".PN:SSGAANDMMNAŠNSYSM'S MAPƠUSҠSADPVDVSAŠϠUSŠMMN. SPà DAPSYSAŠS.A.M.AҠSYSM DBMAPGUNSSUSҠSADDVSUSŠMMN SZBHGNAŠAҠMMN DAPM AUAŠHŠNUMBҠƠH MANAPAGS(SZŠƠGAPSPAANG ADAPSAMS.A.M.MNDƠSYSBM SZAƠS.A.M.SASNSAMŠ ADANNԠPAGŠHŠGAPSZ. SAMM(SAVŠGAPSZŠNMM S̠0GԠGAPSZŠNDSAND MANAADUSԠAƠS.A.M. ADASAMDNADHN SAMMSŠNMM. SPà DAMMSMAYADUSԠA+ MANAS.A.M.DNAD ADAPDSKHNNVԠPAGŠADD S̠0ϠDADD SAMMANDSŠNMM. NDDMSDŠ HDŠGNAҠMPŠABSUŠAD BGNAN-UP....DϠNԠAנSASBYNDHSPN SPà DANSԠPUԠҠUNŠADDSSN SAANSSAԠV. SPà AҠSYSMMMUNANAA DASBPGԠADDҠƠSYSMMAA DBNMGԠNG.NGHƠMMAA SBDNԠSԠUNԠҠANGBPAA B SBAɠAҠBPMMAAD NA SZDNԠSKP-AAAD MP-3NNUŠANGBPAA MVŠUYPGSϠנDSK A SAUNԠAҠUYPGAMUN DADSKADGԠUNԠDSKADDSS SADSKUԠSAVŠDSKADDҠƠUYPGS SBNDؠNAZŠDNԠSAN GBSBDؠSԠDNԠADDSSS MPNDUA̠UYPGAMSMVD DAD6ɠGԠYP ANDMSAŠYP PAPYPŠUY? SSYS-MV MPGBGNŠHҠPGAMS DADɠGԠDSKSҠUN MANA SADSNԠSԠSҠUN DAD5ɠGԠNA̠DSKADD DBDSKADSԠUNԠDS SBD5ɠNDNԠҠB.D. SSAƠSAHNԠNSAMŠUN MPMV̠SKPS DBDSKASAMŠUNԠHKϠSŠƠABSUŠHASVD MBHSAABŠPGM ADBASUBAԠUNԠABSADDSS SSBSSV? MPMV̠NϠGϠMVŠHŠPGM DA3YS SBҠNԠVABŠGϠ̠HM MV̠SADSKDSԠUNԠUYDSKADDSS DBABUƠGԠADDSSƠBU SBDSKɠADUYPGAMD DADSKADGԠUNԠABSUŠDSKADD DBABUƠGԠADDSSƠBU SBDSKϠŠUYDNDSK DADSKADGԠUNԠABSUŠDSKADD SBDSKANҠDSKADDSS SADSKADSԠNנUNԠDSKADDSS DADSKDGԠUNԠUYDSKADD SBDSKANҠDSKADDSS SZDSNԠSKP-UYPGAMMVD MPMV̠MVŠNԠUYPGAM SZUNԠNҠUYPGAMUN MPGBSANDNSҠNԠUYPG MAKŠBAYNYPNԠS NDUA SABNԠAҠBAYNYPNԠUN SAADAҠANADDҠҠABD DADSKADGԠUNԠABSUŠDSKADD SADSKBSAVŠBҠNYPNԠSԠADD SBUSSUPUԠHŠBUSNGUSҠMAP DAM000H000ҠHŠBAS SAABҬɠŠBAS ADANANDMA SAMABì SBNSԠNAZŠSԠSAN BSԠSBSؠSԠUNԠSԠADDSSS MPNDSؠNDƠS DASԴɠGԠDNԠADDҠҠNYPN SADNԠSԠDNԠADDSSҠD SZASSƠUNDNDSYMB̠G MPBSSԠҠGNADSYMB ADAN5ƠSƠDNNG SSASYMB MPBUGϠSNDԠHH SBDؠSԠDNԠADDSSS HԠ0NVADDNԠADDSS DAD6ɠGԠPGAMYP ANDMSAŠYP SZASSSYPŠASYSMPGAM MPBϠYSGϠDϠ ANDMKPHŠSGNGANԠBS N BGNNN-DMSDŠ PAPKPƠŠSDN SS PAP6YPŠBAY? SSYS-PSSBAYNYP PAPYPŠBGSDN? NDNN-DMSDŠ Z BGNDMSDŠ PAP6NYBҠANDSYSNSSAVD NDDMSDŠ ASSYS-PSS MPBSԠGNŠNN-BAYNYPN BϠSADNԠAҠHŠYPŠAG BUSBBUԠSNDHŠNYPN MPBSԠGϠGԠHŠNԠN BSDAS5ɠƠUNDNDSYMB̠HASA SZANN-ZϠVAU SBBUԠSNDԠANYAY MPBSԠNNUŠHŠSAN BUԠNPUNŠϠUPUԠNYPNS DASԱɠGԠNYPNԠ DBMABìɠGԠHŠŠAVŠAN NBƠHŠNԠD SBABDϠUPUԠNAMŠ DASԲɠGԠNYPNԠ3 SBABDϠUPUԠNAMŠ3 DAS3ɠGԠNYPNԠ5 ANDM00SAŠUPPҠHA ADADNԠADDHŠAGD SBABDϠUPUԠNAMŠ5 DAS5ɠGԠSYMB̠VAU SBABDϠUPUԠVAUŠƠNYP SZBNԠNҠNYPNԠUN MPBUԬɠUN UPUԠHŠDNAY NDSؠSBNSԠDNAYSND SNDSBSؠƠDNAN MPNDSNDƠN'SG1FϠAPUP DASԴɠGԠHŠDNԠADDSS SADNԠSԠҠD ADAN5ƠUNDNDҠS SSADNNG MPSNDSKPHŠSYMB SBDؠGԠHŠDNԠADDSSS HԠ0PS! DAD6ɠGԠHŠYP ANDMSA PAPƠNԠBAY ANASS MPSNDYHŠNԠN SADNԠSŠSԠHŠAGϠ DAD5ɠGԠHŠDSàADDSS SAS5ɠANDSԠNVAUŠD SBBUԠUPUԠHŠN MPSNDYHŠNԠN. NDSSBBPDSAUPUԠMANDҠƠBҠS SBSYSBAKϠHŠSYSMMAP GNAŠBANKDSGMNS NDBɠDAUAKMŠBANKD'S? PAASKY? MPND̠NϠHנABUԠSHԠNS? DANYSGNAŠA SBGNDBANKDSGMN MPNDBɠNDANH? ND̠DASKYAƠNԠKYDS NA PADSADHNMNA MPNDSZBANKUPU. DANA-ҠBANKDSGMNԠAG. SBGNSDGNAŠDSGMN. MPND̠PAԠS. PUԠUԠDSKDNAY NDSZDADSKADGԠUNԠDSàADDSS. AƬAƠAŠDSKAKN.ϠנA A̠SA ANDM3AKNUMB. NASԠANUMBҠƠUSDAKS SAUAԠSAVŠN.ƠUSDAKS MANA SANԠSԠAKUSAGŠUN A SABUƠAҠBU DAADԠSԠHŠAԠADDSS SAUAɠҠUD SYSҠDAMSGNSԠAGҠSYSM-USDAK SBUDUPUԠAK-USDAG SZNԠSPHŠUN SSMŠϠDϠNNU MPUSҠDNŠ-UMP SZBUƠSPUNԠAK DABUƠGԠUNԠAK SBSԠSԠAGGD? PBBUƠ?? MPSYSҠYS-SԠ DAҴNϠ-BMB SBҠŠANNԠV USҠDAUAԠSԠAN.ƠUSDAKS SBDSԠSԠDSKAKAB SBMDϠUSHNA̠SҠMDBU DAAԠGԠADDSSƠ SAAGԠADDSSƠ DAԠGԠN.ƠԠNS SAԣSԠN.ƠԠNS DAASԠGԠADDҠƠDVƠAB SADԠSԠADDҠƠDVƠAB DASԠGԠN.ƠDVƠABŠNS SAUMAؠSԠN.ƠDVƠABŠNS DAANԠGԠADDҠƠNUPԠAB SANBASԠADDҠƠNUPԠAB DANԠGԠN.ƠNԠNS SANGSԠN.ƠNԠNS DAADԠGԠADDҠƠDSKAKAB SAAԠSԠADDҠƠDSKAKAB DAKYADGԠADDҠƠKYDS SAKYDSԠADDҠƠKYDS DABHNGԠɯϠADDҠҠBG SABGSԠɯϠADDҠҠBG DAYHGԠɯϠADDҠҠSYSYP SASYSYSԠɯϠADDҠҠSYSYP DBSHSԠDADDSSҠZ SBSKDDNSHDUDS DASAPƠGԠSAPPNGAG SASAPSԠSAPPNGAG DABADGԠADDҠƠBAY SABGSԠADDҠƠBAY DAADGԠԠMADDSS SAGSԠԠMADDSS DAMԠGԠԠMNGH SAMSԠԠMNGH N BGNNN-DMSDŠ DAMM6SԠAƠү SADADSàSDNԠAA. DASYMADGԠADDSSƠSYSAVMM SAAVMMSԠADDҠƠSYSAVMM NDNN-DMSDŠ DABGBNDSԠBGBUNDAY SABKGSԠBGBUNDAY DAMBGSԠBAKGUND SABKMMMNNGH. N BGNNN-DMSDŠ DAMMGԠBGDSKSDNԠGN SABKDASԠBGDSKSDNԠGN NDNN-DMSDŠ DAASMGԠASԠAVA̠ADDҠҠSYSM SABKASԠASԠAVA̠ADDҠҠSYSM N BGNNN-DMSDŠ DAUBPSԠAƠүԠDSàSDN SABPANKAANBASŠPAG. DAUBPSԠAҠү SABPABASŠPAGŠNK. DAUBBPSԠAƠBKGDSàSDN SABPA3NKAANBASŠPAG. NDNN-DMSDŠ Z BGNDMSDŠ DAP SABPASԠNKҠԠD'S SABPA3SԠNKҠBGD'S DANKSAVŠSԠSYSNK ADANSSNŬ SABPAASASԠNKҠԠD'S NDDMSDŠ DAPàSԠADDSS SADUMMYPVGDɯϠAD. DASDSSԠSSAK SASԲSYSMDSà(U. DAADSSԠSSAK SAS3AUAYDSà(U3. DADSKSYSԠDSàADD. SADSDASԠDSGMN. DADSPSԠPSNƠSԠDSGMN SADSDPNS. DADSKBGԠDSKADDҠƠBNYPS SADSBSԠDSKADDҠƠBNYPS DABNԠGԠN.ƠBNYPS SADSNSԠN.ƠBNYPS DADSKUԠGԠDSKADDҠƠUYPGS SADSUԠSԠDSKADDҠƠUYPGS DAUNԠGԠN.ƠUYPGS SADSUNSԠN.ƠUYPGS DADSZŠSYSMDSàSZ SAASD DADSZŠA̠DɼbTRNSàABŠNGH ADADAUN MANA SAAGSԠA̠DSKABŠNGH Z BGNDMSDŠ A SAMMAҠUNKUԠƠMM NDDMSDŠ DADMMSԠUPHŠMMYAB SABUƠϠBŠSԠADDSS DBN6DBYNUMB MADʠDABUƬɠƠDS MANAAUAŠHŠNUMB SZBUƠSPϠHŠHGHD ADABUƬɠMPUŠSZ SABUƬɠSԠ SZBUƠSPϠHŠNԠD NBSZBƠDNŠ MPMADʠSŠP SAԱSԠHŠASԠD DADMMMVŠHŠŠMMY DBDԱABŠN SBMVנHŠԠAA Dà- DASBPMVŠHŠSYSM DBADBPAA ADBAϠH SBMVנHŠDUMMYBASŠPAG NMABSSA-000B PUԠUԠBASŠPAG SBDSKVGԠNԠVNSҠADDSS SADSKAVSAVŠNԠAVAABŠDSKADD N BGNNN-DMSDŠ DADSKABGԠNA̠ABSUŠDSKADD SADSKADSԠUNԠDSKADDSS DAM000GԠUPPҠSYSMBPADDSS DBPGԠҠSYSMBPADDSS SBBPUԠUPUԠSDNԠBPSN NDNN-DMSDŠ Z BGNDMSDŠ SPà ŠUPPҠPAԠƠSYSMBASŠPAGŠϠDSK. HŠPNƠHŠBASŠPAGŠNANNGMMY SDNԠPGAMNKSASAADYNU. vTSNŠŠPBABYNDDHŠҠPNN HŠMDSԠƠASҬԠSMSԠNVNNԠ ŠHŠMANDҠƠHŠB.P.USNGABDϬA DAԠAMŬϠNSUŠHAԠNנDSA MGDNϠHŠAPPPAŠPSNSNDSK. Š̠ABDϠŠAŠNGPAGŠDSV PAGŠ0SNŠABDϠASDSGNDϠVҠA̠BAS PAGŠNSNϠHŠN-Š"DUMMYBASŠPAG" NSADƠHŠDSK. SPà DADSKBPGԠSANGSҠƠSBP SADBDSKANDSAVŠNABDϠMAP. DAM00SԠBASŠŠADD SADBASŠNMAP. DAM000ANDSԠMAؠŠADDҠSN SADBMAؠNMAP. DADBMAPSԠABDϠϠUSŠSPA SBSDSMAPB. DANKSAVŠŠADDSSƠS ADAADBPSYSMNKNMPAY. SAMP5 DBNKNVԠAGԠBPADDҠϠPAGŠ ADBM000ADDҠϠAKŠUԠABD. SPà BPDAMP5ɠPKUPNԠBPDAND SBABDϠŠϠDSKNMNNGB SZMP5G(AGԩANDMP5 PBM000(SUũAHMŠUN MPBPNDNDƠPAGŠSPASSD MPBP(AGԠADDҠPAGŠ SPà MP5BSSA̠MPAY DBMAPDƠ+MAPPNGNS DBASŠBSSҠABDϬDϠNԪ DBMAؠBSSMVŠׯSPԠ DBDSKBSSϠAHH. SPà BPNDU NDDMSDŠ DADDAUSHHŠABDϠBU DBADBUƠϠH SBDSKϠDS DAASԠGԠADDSSƠBԠSPS. SBSԠUSHHŠNA̠S DAP DBMS3MS3ADD:SYSMSD SBDKYɠPN:SYSMSDNDSK DADSKAVNV AƬAƠAS A̠USD ANDM3DS i-MANA DBABUƠADDSS(AKϠDMA SBNVDAND DABU+S SAMS3+6NMSSAG. DADSKAVNV ANDMS ASNVԠϠDSS MANA(DMA̩ DBABUƠ SBNVDAND DABU+S SAMS3+N DABU+MSSAG ANDM3SAŠ3DDGԬ ҠUBNKADDUPPҠBANK. SAMS3+0 DAP3PNԠMSSAG: DBMS3"SYSSZ: SBDKYɠKؠSà(0" SBSPA DADSKAVGԠNԠAVAABŠDSKADD DBDNGԠDSKҠUN SBHԷ MP-NDƠB (UNNDSKPԩ PSBNP DMMDƠMM DԱDƠԱ ASKYNPADDSSƠSԠSHԠD'SKYD SKP Z BGNDMSDŠ D:SSUPDƠD-SGMNԠҠ- DMAԠ-BԠ5:PANASSGND 0-:PANSZŠM.NPAGS NGNGBASŠPAGŠ(PAGS- -9:MMPԠNŠB̠ND 6:SVD(0 0-5:ASSGNDPANNUMB- ANGSUN: SBSYS(ҠMAKŠSUŠABDϠSMAPPNGSYSM APAGSNDDBYPGAMN.BASŠPAG BADDҠƠDNԠNYҠPG SBD SUBUNSAD:ABD UN: ABŠDSYD SPà DؠNP SZADN'ԠNUDŠBAS ADANPAGŠNSZ. SADMSAVŠPAGŠM SBDMSAVŠDNԠPN ADBP5BADDҠƠDNԠD6 SPà HKUSŠƠSSGA SPà DABYɠGԠPGYPŠMDN ANDM0ANDSAŠHŠSSGAB. SZASSƠNԠUSNGSSGA MPNSSàHNGϠHKHҠMMNS. SPà DASSGAƠUSNGSSGAHNPKUP MPDSԠMPԠNDؠANDGϠŠD-SG. SPà NԠUSNGSSGAUSŠMMNSZŠMDN (HҠSMŠҠNNũVSŠMMNBԠNYPŬ ANDנϠYPŠBSϠNDؠNϠABŠ MPԠNDS. SPà NSSàDABɠGԠYPŠAGANANDSAVŠBS ANDM30ANDVSŠMMNB. ADBNPKUPMMNSZ DBBɠNDN. SZBƠANYHNSԠBԠNA. ҠM SPà ADADB.USŠBԠPANNAϠND DAAɠABŬANDPKUPMPԠND. SPà ANANSMPԠNDجMGŠNSZŠUMN ANDŠDSK. SPà DSԠB Ҡ3PUԠMPԠNDؠAND ҠDMPAGŠMԠNPP ̠0PSNSNA-G SPà SADM3SAVŠNנDD DBDMHNPKUPDNԠADDҬ SBDNDANDNVԠϠD-SGP ADBPPNԠϠD-SGD DADM3ANDŠNנNNS SBABDϠϠDSK. SPà DADMMGŠPANSZ S̠UMNԠSS DBDMNϠUPPҠBY ADBPƠDNԠD. ҠB SAB SPà UNϠA MPDج SPà NSANS. SPà DMBSS DMBSS DM3BSS SSGAUMPԠNDؠƠUSNGSSGA DNàU0MPԠNDؠƠDSKSׯϠM. MNàUMPԠNDؠƠMMSׯϠM. BGU3MPԠNDؠƠUSҠƠBGM. ԠUMPԠNDؠƠUSҠƠԠM. ÓSPà NDؠKUPAB ABŠNANSMPԠNDS(SSGADNì MNìBGҠԩ HŠNDؠϠHSABŠSBSNG: BS0:00-SHUDN'ԠHAPPN (MYPũ0-ԠMMS 0-ԠDSKS -BGDSKS BԠ:0-NϠMMNUSD -MMNUSD BԠ3:0-USŠNMA̠MMN -USŠVSŠMMN SPà DB.DƠ+ ABS0NDؽ0000-SHUDN'ԠHAPPN ABSMNà000-MҠׯϠMMN ABSDNà000-ԠDҠׯϠMMN ABSDNà00-BGDҠׯϠMMN ABS0000BADNY ABSԠ00-MҠׯԠMMN ABSԠ00-ԠDҠׯԠMMN ABSBG0-BGDҠׯBGMMN ABS0000-BADNYSHUDN'ԠU ABSMNà00-MҠׯϠMMN(VSũ ABSDNà00-ԠDҠׯϠMMN(VSũ ABSDNà0-BGDҠׯϠMMN(VSũ ABS000-BADNY ABSBG0-MҠׯBGMMN ABSBG0-ԠDҠׯBGMMN ABSԠ-BGDҠׯԠMMN NDƠAB SPà5 DND-NDDSGMNԠADDSSBYADNG KYDMDS. ANGS:UNS:(N+ (NSUŠ'SYS'MAPSSԠҠABDϩASDSYD (NSUŠDؠADAҠҠPGBSDSGADD DBDN-ADD SBDND SPà DNDNP ADBPPNԠϠDNԠD DAM3PKUPKYDAND ANDBɠSAŠ. ADAKYADADDKYDBASŠADD DBAANDSAVŠNBҠDP. SBDPנHNADKYD. DBA MPDNDɠUNׯD-SGADDҠNB. DMNŠPAGŠNbUMNSҠAPGAM ANGSUN:UNSUN: AHGHMANADD+BŠDSYD BנMANADDҠAPAGŠUMN SBPGѠN.BASŠPAG. SPà PGѠNP MBB-MAN- ADABAN.DSNDD- Ҡ0APAGS- ANDM3ANUԠBADBS ADAPAPAGS+(..N̠BASŠPAGũ SPà MPPGѬɠPAGŠUMNS. NDDMSDŠ SKP PNԠHADNGNAZŠD HŠSHDSUBUNŠPNSHŠHADNGSҠHŠDN YPSƠPGAMSADDSSHŠN-PGAMS-ADD-Y AGANDGNSHŠSANƠDN. ANGSUN: AN.HAS.(PS.NMSSAG BADDSSƠMSSAG SBSHD UN:NNSƠAANDBAŠDSYD SHDNP DSԠBUƠSAVŠHŠMSSAG SBSPAŠNנN DDBUƠN SBDKYɠPNԠHADNG SBSPAŠNנN A SAAGSԠPGAMS-ADDAG- DABDNԠGԠSԠDNԠADDSS SADNԠSԠDNԠADDSSҠDSAN MPSHDɠUN SPà HŠMVנSUBUNŠMVSDSMNŠŠAN ϠANH ANGSUN: DAMADDSS DBϠADDSS SBMV Dà-DUN MVנNP SABU DAMV׬ɠGԠHŠUN SABU+SԠNUN MVײDABUƬɠGԠAD SABɠSԠ NB SZBUƠSPHŠADDSSS SZBU+DN? MPMVײNϠDϠHŠNԠN SZMVנSPϠUNPN MPMV׬ɠYS-UN SKP UPDAŠSDNԠMMYBUNDS HŠNADSUBUNŠUPDASHŠMANANDBPMMYBUNDS MHAԠUSDNHŠPVUSADNGA. ANGSUN: AGND BGND SBNAD UN:NNSƠAANDBAŠDSYD NADNP DAP̠GԠUNԠANADDSS SAPP̠SԠNנPGAMàADDSS DAB̠GԠUNԠBPàADDSS SAPB̠SԠNנBPANADDSS MPNADɠUN SPà5 DSKVSHŠUNԠDS ADDSSϠBŠVN.HSS DNŠϠNASŠADNNY DUNGŠUN DSKVNP DADSKADGԠUNԠADDSS SAƠVNSKP SBDSKASŠSPBYN SADSKADSԠADDSS MPDSKVɠUN-ADDSSNA. HDŠGNAҠPAGŠPAMSANDNSANS ұASàBGBUNDAY Ҳ3ASà3NVADABPNKAGŠADDSS ҴASà MS3DƠMS3 MSDƠ+ DƠ+6 ASàԠM MS5DƠMS5 MS6DƠMS6 MSDƠ+ DƠ+6 ASàBGM N BGNNN-DMSDŠ MS9DƠMS9 NDNN-DMSDŠ MS0DƠMS0 MS3DƠMS3 MSUMS3 MSDƠMS MS3DƠ+ ASà6SYSSZ:ؠKSؠSS(0 ASԠDƠS MP3ɠMP3ɠNA̠MPNSUN SKP SҠBSS0BSAPBUҠMA BPSYBSSҠSYSMBPADDSS UBPSYBSSUPPҠSYSMBPADDSS DSKBPBSSSYSBPDSKADDSS MANBSSMANSDNԠҠADDSS UMANBSSMANSDNԠUPPҠADDSS DSKҠBSSMANSDNԠDSKADDSS BMANNPMANBGҠADDSS UBMANNPMANBGUPPҠADDSS DSKBGNPMANBAKGUNDDSKADDSS SYMADBSSAVA̠SYSMMADD BGBNDBSSBAKGUNDBUNDAY DSKAVBSSNԠAVAABŠDSKADDSS DSKàBSSDSKADDSSƠBAYD DSKBBSSDSKADDҠƠBAYNYPS DSKUԠBSSUYPGDSKADDSS DSKBSBSSDSKADDҠƠMANBGDSKSBP DSKBҠBSSUNԠMANBGDSKSDSKAD ADԠBSSADDҠƠDSKDNAY BNԠBSSSDNԠBҠNYPԠUN UNԠBSSUYBAYUN KYADBSSUNԠKYDADDSS ADBSSԠMŠADDSS BADBSSBAYDŠADDSS SYBADBSSADDҠƠSԠBPNKҠBG DSADBSSADDҠƠSԠDSGMN ABSDBSSDNԠADDҠҠNԠBGSGSAN MAPBSSMAMUMԠDSKSDNԠPG MABBSSMAMUMԠDSKSDNԠBP DMBSBSSBGMANADDSSҠBS MS0ASàBPNKAGŠ MS3ASàBAY N BGNNN-DMSDŠ MS5ASà6GSDNS MS6ASà9GDSàSDNS NDNN-DMSDŠ Z BGNDMSDŠ MS5ASàMMYSDNS MS6ASà9ԠDSàSDNS NDDMSDŠ N BGNNN-DMSDŠ MS9ASà6BGSDNS NDNN-DMSDŠ MS0ASà9BGDSàSDNS MS3ASàSYSMSDNDS MSASàABPNKAG? YPMSNP SKP Z BGNDMSDŠ SԠANBASŠAԠSԠPAGŠNGSYSM ҬƠUSDMMN.HSUNŠSADB ANƠAHDSKSDNԠPGAM SPà SBNP DBSSGA.GԠAƠSYSB+ DAD6ɠGԠPGYP ANDM0SAŠSSGABԠNYPŬ ҠDɠMGŠNMMNNGH SZAANDƠHŠUSSH DBMPSԠàBASŠABVŠMMN. A ADABGԠAƠSYSҠMMN ANDM60KPUSԠPAGŠNUMBҬ ADAM000BUMPϠSAԠƠNԠPAG SAPP̠ANDSAVŠASANBAS. ASԠBASŠPAGŠAAN SABPMAؠHGH-A-MAK MPSBɠUN NDDMSDŠ HDŠGNAҠSANDNSҠPGAMYP SANDNSҠPGAMYP HŠDSNSUBUNŠSANSDNԠҠAPGAMƠH UNԠYPŠ(SԠNPYPũ. ANGSUN: AGND BGND SBDSN UN:NNSƠAANDBAŠDSYD. ŠMSAGҠUNԠPGAM. DSNNP DADNԠGԠNԠDNԠNSAN SADNԠSԠDNԠADDSSҠD SBDؠSԠDNԠADDSSS MPDSNɠUN-NDƠDNS DADGԠUNԠMANDNԠADDSS SAMANSAVŠUNԠMANDNԠADDSS DADNԠGԠNԠDNԠADDSS SADNԠSAVŠADDҠҠNԠDNԠSAN DAD6ɠGԠYP A̬ŬASԠŠMS ANDYPMSSAŠPGAMYP PAPYPŠUNԠYP? SSYS-NNU MPDSN+3GNŠDNԠ-YNԠDN SZDSNNҠUNADDSS MPDSNɠUN HDŠGNAҠSԠҠSMŠPGAMSADD SԠҠSMŠPGAMSADD HŠNSԠSUBUNŠHKSҠPGAMSƠHŠUN YPŠADD.ԠSUDNGMPNƠH ADNGSUNŠҠAHPGAMYP.ƠNϠPGAMS HSYPŠHAVŠBNADDԠPNSHŠMSSAG (NNũNHŠPN. HSŠԠPSHŠUNԠBASŠPAGŠNKAGŠADDSS. ANGSUN: AGND BGND SBNS UN:NNSj2AANDBAŠDSYD. NSԠNP DABPMAؠGԠUNԠPƠNKAG SZAGƠNϠPGAMSADD MPBPPԠSND:(NNũ DAP6 DBMSMSADD:(NNũ SBDKYɠPN:(NNũ N MPNSԬɠUN BPPԠSBBPNҠSNDBPNKAGŠMSSAG MPNSԬɠUN Z BPPԠMPNSԬ SPà MS0DƠMS0 MS03DƠMS0+5 SPà BPNҠNPSNDMSSAGŠ'BPNKAGŠ' DBMS03ؠSNANNY SBNVDNVԠϠMSSAG DAP6GԠNGH DBMS0ANDADDSS SBDKYɠSNDMSSAG MPBPNҬɠUN HDŠGNAҠAҠA̠SԠNS AҠA̠SԠNS ԠASHŠUNԠBPNKAGŠADDSSSNHŠBASŠPAG MAG.(ASB-ADS. ANGSUN: AUNԠנBPADDSS BUNԠHGHBPADDSSPUSN SB UN:NNSƠAANDBAŠDSYD. ԠNP Z BGNDMSDŠ SAMSAVŠPAMNMP DABPNàANDPKUPBPNMN AANDSAVŠSGN(<0DN DAMHNSŠPAM. SZƠBPNKSGϠDNAD SPHNSAPPAMS. NDDMSDŠ MBNBSԠHGHBUNDNGAV ADBASԠAA̠DUN SSBSSSKP-SMŠBPSNϠA MPԬɠUN-NϠBPSN SBDNԠSԠUNԠҠANG ADAADBPADUSԠҠBPADDSS DBDGԠHŠANGD SBAɠAҠBPD NA SZDNԠSKP-A̠BPA MP-3 MPԬɠNDƠANG Z BGNDMSDŠ MBSS SNDDMSDŠ SPà SBPSԠHŠSPDBASŠPAGŠMAGŠDSϠ- ANGSUN:SAMŠAS. SBPNP SBԠSAVŠHŠHGHM BSԠHŠAҠD SBDϠ- DBԠSŠB SBԠGϠSԠHŠDSϠ- SZDSԠAҠDϠ0 NPAAYSSKPPD MPSBPɠUN SPà DNP HDŠGNAҠUPUԠABSUŠBASŠPAGŠD UPUԠABSUŠBASŠPAGŠD BPUԠUPUSHŠBASŠPAGŠSNƠDŠNGADNG AHDSKSDNԠPGAMBGNNNGHHŠDSK ADDSSSPDNDSKAD. ANGSUN: AUPPҠBPADDSSPUSN BҠBPADDSS SBBPU UN:NNSƠAANDBAŠDSYD. BPUԠNP MANAMPMNԠUPPҠADDSS ADABADDҠADDSS SANԠSAVŠBPNGH ADBADBPADUSԠҠBPADDSS SBUAԠSAVŠUNԠҠŠADD SSASSSKP-SMŠDŠNBP MPBPUԬɠUN-A̠DŠU DADSKADGԠUNԠDSKADDSS BPSYϠSBDSKϠUPUԠUNԠBPS DADSKADGԠUNԠDSKADDSS SBDSKANҠDSKADDSS SADSKADSAVŠNԠDSKADDSS DBNԠGԠUNԠNGH ADBP6 SBNԠSAVŠUNԠҠNԠPASS SSBSSSKP-MŠDŠϠPUԠU MPBPUԬɠUN-A̠DŠU DBUAԠGԠUNԠנŠADDSS ADBP6 SBUAԠSԠNԠŠADDSS MPBPSYϠUPUԠNԠSҠϠDSK HDŠGNAҠNVԠAϠASɠAԠB NVԠAϠASɠAԠB HŠNVDSUBUNŠNVSHŠNNSƠA NϠASɠ(DMA̠ҠA̩AԠH.ŠANSPD BYB.HŠNVDSUԠUS3DSANDS NHŠMA:جHASPAŠNHŠSԠPSN. ANGSUN: AN.ϠBŠNVD.ƠHŠSGNƠASPS. HŠNVSNSϠBŠNA̻ƠNGAVŬ NDMA. BADDSSƠŠANҠNVDSU SBNVD UN:NNSƠAANDBAŠDSYD. NVDNP SBUAԠSԠMSSAGŠADDSS DBPSGԠADDҠƠA̠PS SSASKPƠA̠NVUD DBDPSGԠADDSSƠDMA̠PS SBANADSԠPҠANGŠADDSS SSASSSKPƠNGAVŠ(DMA̩ MANANVԠNUMBҠϠNGAV SABPUԠNUMBҠNB(MANDҩ DAN SANԠSԠNVSNUN SBGDGԠSԠDG ҠUBNKADDBANKϠSԠHA SAUAԬɠSAVŠSԠBANKHAA SZUAԠNҠMSSAGŠADDSS NDSBGDGԠNԠDG AƬAƠAŠϠUPP SAUAԬɠSAVŠUPPҠHAA SBGDGԠNԠDG ҠUAԬɠADDUPPҠHA SAUAԬɠSAVŠNԠHAAS SZUAԠNҠMSSAGŠADDSS SZNԠSKP-5DGSN MPNDNϠ-NNUŠHNԠDG MPNVDɠYS-UN HDŠGNAҠGԠDGԠҠNVD GԠDGԠҠNVD GDPVDSHŠASɠHAASҠNVD. ANGSUN: AGND BMAND SBGD UN: AASɠDG BGND GDNP A NAADBANADɠADDP MBSSBNBSZBSKP-YNԠHGHҠDG MPGԲDGԠUND NANҠDG MBNBSŠMANDҠϠNGAV MPNAYHGHҠDG GԲADBANADɠADDP MBNBSŠMAND SZANADNҠPҠSԠADDSS ҠM60NVԠϠAS MPGDɠUNHDGԠNA HDŠGNAҠAҠMMYMAPBU AҠMMYMAPBU SԠASHŠMMYMAPBUҠHBANKS. ANGSUN: AGND BGND SBS UN:NNSƠAANDBAŠDSYD. SԠNP DBAMSԠAMSԠADDҠƠMS DAN SAAMADSԠBUҠNGH DABNKSGԠBANKHAAS SABɠAҠBUҠD NB SZAMADA̠DSA? MP-3NϠ-NNUŠANG MPSԬɠUN SPà B00Ԡ00 BU5DƠNAM5D6ƠBUƠADDSS HDŠGNAҠNAŠMANPGAMADNG NAŠMANPGAMADNG ADSHŠSUBUNŠҠNYϠADSҠHS PGAMSHHUŠUSŠƠANנBPANDPGAMBAS. ANGSUN: AGND BGND SBAD UN:NNSƠAANDBAŠDSYD. ADNP Z BGNDMSDŠ NDAŠVADYƠSSGANS SPà DAD6ɠYP ANDM0KAԠSSGAB SASSGAƠSԠSSGAAG(0NϠSSGAUSũ NDDMSDŠ B SBHDGSԠHADNGAG N BGNNN-DMSDŠ DAPP̠GԠPGAMANADDSS SAP̠SԠUNԠPGàADDSS NDNN-DMSDŠ Z BGNDMSDŠ DAD6ɠGԠYPŠAGAN ANDMUSԠPMAYBS DBPP̠PKUPBASŠADD PAPANDƠPGSDSKSDN SS PAP3(HҠԠҠBG ADBGBUMPBr2YNUGH NDؠGSAG SBP NDDMSDŠ DAPB̠GԠBPANADDSS SAB̠SԠUNԠBPàADDSS SBADSADPGAM DABGƠNԠBAD SZASSHN SBSPAŠNנN MPADɠUN Z BGNDMSDŠ SSGAƠBSS NDDMSDŠ HDŠGNAҠADANDNKMANPGAMSANDSUBUNS ADNKMANPGSUBS. ADSSHŠMANADNGSUBUNŠҠGNANGHŠABSU DŠANDNKNGA̠ADSUBUNS.ԠSUSDBYAH PGAMYPŠҠADNG.ԠADSHŠAABŠDSM HŠSAHPNƠHŠDSKANDSHŠABSUŠD NHŠҠ(PDPNƠHŠDSK. ANGSUN: AGND BGND SBADS UN:NNSƠAANDBAŠDSYD. ADSNP SBSؠSԠUPAؠUPNY A SAPGSԠAGNϠDB̠SN ADNDAP̠AҠHŠPNKMAG SBPKAA DAP̠SAVŠҠS SAHҠNԠPASS DAB SAH3 A ADؠSA0 DAH3BPNK DBB̠ADDSSS SB DAH3 SAB̠SŠB SBSԠBANKMMYMAPBU AAҠHŠBAYAP SAADPDS SABP DAAMSԠAMSԠADDҠƠMMMAPBU SAAMADSԠUNԠMMYMAPADDSS DAHDGGԠHADNGMAԠAG SAMP SSASSSKPƠNGAVŠ(MAN SZAMADNҠUNԠMMMAPADD DADɠGԠNAMŠ SAAMADɠSԠNAMŠNMMYMAP SZAMADNҠU`^TRNNԠMMYMAPADDSS DADɠGԠNAMŠ3 SAAMADɠSԠNAMŠ3NMMYMAP SZAMADNҠUNԠMMYMAPADDSS DAD3ɠGԠNAMŠ5 ANDM00SAŠUPPҠHA ҠBANKADDBANK(Ԡ0 SAAMADɠSԠNAMŠ5NMMYMAP DAD6ɠPKUPYP ANDMMASKϠAUA̠YP. SADYP DAD5ɠGԠHŠNAMD SADSKDSAVŠUNԠDSàADDSS SBDBNGԠHŠNAMD DBNԠSBZADADNG? MPHN DA0 SZASԠPASS? MPHYS SZMPNϠ-SԠMPAYHDG MPSUBHD MPH HSZHDGSԠA̠HNG MPSUBHDSKPPYUPUԠҠSUB HDAD6ɠSԠUNԠADYP ANDMKAԠPMAYVBS Z BGNDMSDŠ PAP5DN'ԠHANGŠMMN MPMKҠSGMNS(USŠMAN'S DBDɠHSSAMAN SBMSZSԠHSMSZŠASM. NDDMSDŠ DBBGBNDGԠBAKGUNDMMNBUND PAPƠGUND SS PAP SS PAPҠBAKGUNDUSNGGUNDMMN N BGNNN-DMSDŠ SS PAP SS PAP3NϠYPŠ3'SN- NDNN-DMSDŠ DBADUSŠGUNDMMNADDSS SBMADSԠHŠMMNBASŠADDSS MKDADSKADGԠUNԠDSKADDSS DB0 SZBSSƠSԠPASS SADSKMNSAVŠNA̠MANDSKADDSS DAPYPŠƠUDSUBUN bTANDMҠSSGAUN PAPAD MPSUBHDSNDSUBHADMAP DAPAҠGԠԠPAN(Ԡ50 ҠAMADɠHANGŠNAMŠ5BANKϠNAMŠ5( SAAMADɠSԠNAMŠ5ԠPANNMAP DANPϠGԠPYMHŠNAMD SZASSƠZϠS DAP99Ϡ99 SZBSSUNSSSYSMHH ASԠϠZ SAUPɠSԠҠHŠD-SGGNAN MANASԠϠNGAVŠҠDMA̠NV DBABUƠGԠMSSAGŠADDSS SBNVDNVԠϠDMA̯A DABU+GԠHGHϠHAAS SAMS+3SԠNMAP DABU+GԠASԠSGNANԠDGS SAMS+SԠPYNMMYMAP DANNԲSԠUPHŠMŠPAAMS AS̠SԠHŠSUN DBNNԱANDMUP BS ASҠMBN SAMUҠSԠҠDSGGNA DANN5GԠHŠSNDS MPYP00NVԠϠ0'SƠMS. ADANN6ADD0'SƠMS. SANϠSAVŠMP DANNԴGԠHŠHUS MPYP60NVԠϠMN. ADANN3ADDMN. MPYP6KNVԠϠ0'MS ŠPPAŠҠADD ADANϠADD0'SMS. SZŠƠV NBSPHGHDҠPA ADANDAY+SUBAԠNŠDAYƠ0'SMS. SZŠƠVҠ NBSPHGHDҠDG ADBNDAY DSԠMŠSAVŠDUBŠDMŠҠD-SG. SUBHDDAP̠GԠUNԠPGàADD DBAMM5SԠBADDҠƠMMYMAP+5 SBNVDNVԠϠDMA̯A DAMSԠPUԠA""NH PABNKSHGHPAԠƠH MPSUBHADDSSƠNԠASUBHAD DAMS+5..ƠMAN ADAB00NVԠBANKϠ SAMS+5SŠ. SUBHDABU+GԠ AƬAҠAŠϠנA ANDMSAŠ PAPNAMD? SSYS-NNU HԠ0BNVADDSKD DABU+6GԠPGAMNGH SAPGHSAVŠPGAMNGH A̬ŬAMVŠPSSBŠSGNB ADAP̠MPUŠHŠASԠDADDSS ADAN DBAMMAND SBNVDNVԠϠHŠMAP N BGNNN-DMSDŠ DAB̠GԠHŠUNԠBPADDSS SAPBŠANDSԠҠBPD DBBU+ADVANŠNKAA ADBB̠BYNDHŠPGAM SBASԠҠBPV ADABPSUBAԠASԠD+ SSASSƠNԠNGAV MPű6ҠGϠSNDMSSAG NDNN-DMSDŠ Z BGNDMSDŠ SԠANBASŠҠBSU SPà DBBU+GԠSZŠƠBASŠPAGŠD DABPNàANDGUŠUԠƠ'ŠGNG SSAUPҠDNNBAS MPSUBH3PAG. SPà DAB̠GNGUPS SAPBŠBBASŠAԠB ADBB̠NMNԠNKBAS DABPMԠSUBAԠM MANAM ADABNԠADDҠϠHK MPSUBHBASŠPAGŠV. SPà SUBH3MBNBGNGDN...SUBAԠBNGH ADBB̠MNKBAS NBADDN SBPBŠϠGԠBBAS. ADBNGԠNԠAVAABŠNKADD. DAB MANASUBAԠNנBASŠMM ADABPMԠϠHKҠV. SPà SUBHSSASSƠMԠSDD MPű6ҠHAVŠAN. NDDMSDŠ NDSBB̠BASŠPAG DAPB SBSBPSԠPGAMBASŠPAGŠMAGŠϠ- DABUƠGԠDSZ AƬAƠנDҠA SABUƠSAVŠNGHԠHA SBZADADNG? MPNDNϬSKP DA0SԠPASS? SZASSNϬDϠMAP MPNMPYSNϠMAP DBBU5HŠSHDNBU SZAGBUMPHŠ̠AG NPNASŠƠAP DANNUMBҠƠDS SANԠϠMVŠϠBU DAAMSԠADDSSƠNAMŠBU SADNԠSAVŠҠPN HDADNԬɠGԠNAMŠDANDADDSS SABɠSŠNBU NBBUMPB SZDNԠBUMPNAMŠADDSS SZNԠA̠DN? MPHNϬDϠM DABNKSGԠϠBANKS SABɠPUԠHMNBUƠBŠHŠMMNS DABUƠGԠDSZ ADAN5DUŠϠMAPNGH ASMSҠHAAҠUN DBBU5ADDSSƠMAPANDMMNS SBDKYɠPNԠA HŠNGUNSNKAPGAMHUGHUNԠPAG NKSHNPSSB.HSSPSSBŠHNHŠNGH ƠHŠPGAMSKNNANDHNHŠPGAMSNԠAN ASSMBDYPŠ3Ҡ5PGAM. SPà3 NMPU Z BGNDMSDŠ DADɠMPA MANAHSMDU'SMMN ADAMSZDAANϠMAN'S SSASSҠƠGA. MPNM DA5 SB NDDMSDŠ NMDA0SԠƠPASSS? SSA MPNDNϠ-PASSNY SZASSƠPASSN MPHGϠHKҠPN SPà DAP̱PASSϠSϠSԠUPHŠN SAP̲K̠HŠUPPҠAA SBNKSSԠҠDNNGD MPH0GϠSԠHŠBUNDYS SPà H,SBGPSԠUPAUNԠPAGŠNKAA SAP̱USŠҠBH AAAS SAP̱HAҠHŠUNԠDS SAP̲H BDSPAҠANԠUNԠPAG B̠NKSƠPSSB? SSBƠYS- MPHGϠSԠUP HANϠ-SנGBԠ0 MPADؠSA SPà HDAPGH SSASSNϠUNԠPAGŠNKS DADYPƠASSMBDYPŠ3Ҡ5 PAP3 SS PAP5 MPH DAP̠GԠADD SABƠASԠD ҠMƠPAG SPà MBNBMPUŠDS NBMANNG ADBANPAG SBMP SPà DAPGHMPUŠDS A̬ŬAƠPGAM MBNBHAԠA ADBABYNDHS SBMPPAG SPà SSBPGAMԠN SSHSPAG? SZBSSNϠ-SKP MPNנYSGϠSԠUPHŠHGHAA SPà DAMPMPUŠMNMUM: ASHAƠDSƠPG MBNBNUNԠPAG-- ADBADSƠPGN SSBSSNԠPAG SPà DAMPDVDŠHS BMNMUMBY DVPU SZASSƠNN-ZϬUSŠASSZ MPNנƠנUNԠPGNKBU SS SPà H0DAP̱HGԠPASSNŠDNDNGH DBHSԠN SBNKɠҠNKADDSS ADBAANDUPPҠM SBP̠ƠNKBU SBNKɠ(ASϠPGAMADADDSS SBPAҠHŠUNԠPAGŠMAG SPà SBGPGԠANHҠPNKAA DAPGHGԠPGAMNGH A̬ŬASPPSSBŠSGPNB ADAP̠ADDHŠBASŠADDSS SANKɠSԠGNƠHGHNKAA ҠMPS NASԠD SANKɠNԠPAG SBPGϠAҠHŠAADAA AAҠHŠUPPҠUNԠD SAP̲H NDDBP̠GԠPGAMANBAS SBADSԠUNԠANADDSS DAUA̠GԠUNԠBUƠADDSS ADABUƠADUSԠҠNDƠNAMD SAUA̠SԠҠNDƠNAMD DANԠGԠUNԠBUƠUN ADABUƠADUSԠҠNDƠNAMD SANԠSԠNנUNԠUN ASSYNԬԬDB̬NDS SàDAUA̬ɠSAVŠHŠDNGH SABUƠDB̠SKPUN SBDBSԠGԠADDҠƠNԠDNBU DAUA̬ɠGԠSNDDND DBASAVŠDNB AƬAҠAŠàϠנA ANDMSAŠ PAPNԠD? MPDNҠPSSNԠD PAP3DB̠D? MPDDBҠPSSDB̠D PAPԠD? MPDҠPSSԠD PAP5NDD? SSYS-PSSNDD HԠ0BNVADDSKD SBZADADNG? MPSؠN NנDA0ƠSԠ SSANAƠNԠUNԠPAGŠNKNG MPPNDUSԠGϠND PAPƠPASSN MPPSԠGϠDϠPASS PASSϠUPUԠHŠPNKAASANDUPDA. DAP̱UPUԠH SBUPנAA DAP̲SԠUPҠH SBNKSHGHAA DAP̲HGԠHŠNUMBҠAAD ADANKɠANDMPUŠHŠUPPҠM SANKɠSԠHŠAUA̠VAU DAP̲rLN SBUPUPUԠHŠNKS PNDSBDBSԠGԠADDҠƠNԠDNBU SBDBSԠGԠADDҠƠNԠDNBU DAP̠GԠUNԠPGANBAS ADAUA̬ɠADDANADDSS DBHDGGԠHADNGAG SZBSSSKPUNSSMAN SAPNԠSAVŠPMAYNYPNԠҠD SؠSBNSԠNAŠS SԠSBSؠSԠSԠADDSSS MPSҠNDƠS DAS3ɠGԠD3ƠSԠ(DNA̩ ANDM00SAŠUPPҠHAҠ-AҠD SAS3ɠSԠNAMŠ5NS MPSԠNNUŠANGDNAS SҠSBZADASUNԠPGMADD? MPPSMNϠSKPADDSSUPDA DAPGHGԠPGAMNGH A̬ŬASԠŠSGN ADAP̠ADDPGAMANBAS ADAP̲HԠANYUNԠPAGŠNKS SAP̠AAD BGԠHŠSH DAB̠G.ANDHŠUNԠBPADDSS BƬBҠƠBԠ3 SBSS SBBPNҠPԠHŠBPNKAG PSMSBNDؠSANH PSNSBDؠDNSҠMDUS MPGԠϠADNNŠSϠGϠ DAD3ɠGԠHŠAGD SANAƠAADYADD MPPSNYHŠNԠN AҬSAA̠ƠMUSԠADAGS MPNDGϠAD MPPSNSŠGϠYNԠDN. NDSAD3ɠSԠHŠADDAG MPADNANDGϠAD GA̠NA̠BSS ADAP DBAƠP̠SGA MANA ADAMABìɠHANMABà(ABDϠHGHAMAK SSASS MPƲ A SBABD ƲDAB̠UPDA DBAHŠMAؠBP MBNBADDSS ADBBPMAؠNDD N BGNNN-DMSDŠ TSSB SABPMA NDNN-DMSDŠ Z BGNDMSDŠ SԠBASŠPAGŠHGHAҠMAK SPà DABPNàABPNMN SSAUPҠDN?? MPBPDàDNSŠƠ SSBUPSŠƠHGH MPUPDAԠYSHGHҠSϠUPDA MPBPNԠҬNNU BPDàSSBDNSŠƠ MPBPNԠNϬUSԠNNU UPDAԠDAB̠YSUPDA SABPMA BPNԠU NDDMSDŠ DAPYPŠGԠUNԠPGAMYP PAP3YPŠBGDSKSDN? MPADSɠYS-DϠNԠAҠADDAGS SBD3AҠPG-ADDAGS MPADSɠUN-A̠AGSAD N BGNNN-DMSDŠ ű6ҠDAұ6GԠBPV SBҠMSSAGŠNHŠY B ADBSBPUSŠMAؠŠHAV MPNDANDNNUŠAD NDNN-DMSDŠ Z BGNDMSDŠ ű6ҠDAұ6PNԠBPV SBҠMSSAG DBBPNàUSŠM MBNB+Ҡ-ASBAS ADBBPMԠPAGŠBASŠ(DPNDSNHH 'ŠGNGUPҠDN AANGNKS MPND NDDMSDŠ PSԠDBP̱HSԠUPHŠNנP ADBHUSŠSUMƠDANDUSDNKS SBP̠SԠNנADDSS MPADؠGϠSAԠHŠNA̠PASS SPà 5ASà5 SKP PSSNԯԠDS DNҠASSSԠNԠAGANDSKP DҠASԠԠAG SANGSAVŠNԯԠAG DABGԠN.NSNԯN ANDM3SAŠSYMB̠UN MANA SANԠSԠSYMB̠UN SBDBSԠgGԠADDҠƠNԠDNBU SBDBSԠGԠADDҠƠNԠDNBU NSYMDAUA̬ɠGԠNAMŠ SABUƠSAVŠNAMŠNMPBU SBDBSԠGԠADDҠƠNԠDNBU DAUA̬ɠGԠNAMŠ3 SABU+SAVŠNAMŠNMPBU SBDBSԠGԠADDҠƠNԠDNBU DAUA̬ɠGԠNAMŠ5 SABU+SAVŠNAMŠNMPBU SBDBSԠGԠADDҠƠNԠDNBU DBABUƠGԠADDSSƠSYMB SBSSSԠSԠADDSSS HԠ0BNԯԠNԠUNDNS DANGGԠNԯԠAG SZASSSKPƠNY MPԱPSS SBZADƠNԠADNGUNԠPGM MPNNԠSKPNKANDMAP DASԴɠƠHSNԠSSƠDNNG ADAN5SKPƠPGAM SSAҠBASŠPAGŠAAB MPNNԠGϠDϠSƠDNNGHNG DABU+GԠHŠAN ANDPNDA ADAMADAŠH DBAɠSYMB ADBUA̬ɠADDUNԠANVAU SBPNDSAVŠABSNYP.ADDSS SBS5ɠSԠVAUŠNHŠS DA0ƠSԠƠ SZASSPASSSSKP MPNNԠHŠMAPANDؠUP AGԠSHGS SSASSSKP-SH5UP(SԠNS MPMNԠSUPPSSPNNGƠMAP SBSԠAҠMMYMAPBU DABASԠGԠBANKASSK SAMS+SԠNMAP DASԱɠGԠNAMŠ SAMS+SԠNMMYMAP DASԲɠGԠNAMŠ3 SAMS+3SԠNMMYMAPBU DAS3ɠGԠNAMŠ5 ANDM00SAŠUPPҠHA ҠBANKSԠҠHAAҠBANK SAMS+SԠNAMŠ5NMMMAP DAS5ɠGԠABSUŠNYP.ADDSS DBI9AMM5GԠADDSSƠMSSAG SBNVDNVԠϠDMA̯A DAP6 DBAMSԠGԠADDSSƠMMMAPBU SBDKYɠPNԠNYPN MNԠSBDAؠؠUPA̠NSϠHSSYMB NNԠSBDBSԠGԠADDҠƠNԠDNBU MPNDPSSNԠSYMB ԱDABU+GԠDNA SAS3ɠSԠDNA̠NS DASԴɠGԠDNԠADDSS SZAƠNYNԠDND PAP SS PAP3ҠS-DNNG SSHN PAPSKPHŠAD MPBSANDUSԠNNU SADNԠSԠDADDҠҠD DADGԠUNԠDNԠADDSS SABUƠSAVŠUNԠDNԠADDSS SBDؠSԠDNԠADDSSS HԠ0BDNԠNԠUNDNS DAD6ɠGԠMSYP SABU+SAVŠMSYP DAD3GԠPGAMUSAGŠAGADDSS SABU+SAVŠUSAGŠAGADDSS DABUƠGԠUNԠDNԠADDSS SADNԠSԠUNԠDNԠADD SBDؠSԠDNԠADDSSS HԠ0BUNԠDNԠNԠUNDNS DABU+GԠMSYPŠҠ A̬ŬASԠŠMS ANDMSAŠYP Z BGNDMSDŠ PAP30UMPƠSSGAMDU MPKSS NDDMSDŠ SZASSƠSYSMN MPԲ3NNU ANDMKPUSԠHŠנYP PAP6YPŠBAY? MPBUԠYS-SԠҠADNG DBP6SŠƠUNԠYP PBDYPS6HN MPAҠҬYPS630MAY NYA̠YPS0630 Բ3PAPYPŠUY? MPBUԠYS-SԠҠADNG SZSKP-NԠMANPGAM MPNDGNŠPGAMA BUԠDABU+ɠGԠPGAMUSAGŠAG SASKP-PGAMNԠADD MPNDMԠPGAMSԠNY DBPYPŠƠBAKGUNDSGMN PBP5HN ҠPSԠHŠBSAG ҠPSԠHŠMUSԠADAG SABU+ɠSŠHŠAGϠHŠDN NDSZNԠSKP-A̠SYMBSPSSD MPNSYMNϠ-PSSNԠSYMB MPSàNϠ-ASSYNԠD AҠDAұ5SԠҠDŠ-GA̠A SBҠPNԠHŠN-N MPNDSԠҠANH Z BGNDMSDŠ MAKŠSUŠPGAMHASSSGAPVGS KSSàDBSSGAƠGԠAG SZBƠSԬHN MPNDUSԠNNU DA5SŠSNDҠMSG SB MPND 5ASà5 NDDMSDŠ BSDABGADNGŠS.B? ŬSZASS MPNDNϠSϠSKP BYSSԠUP DASԱHŠBPAMNԠD PA$PVNŠϠ$PV? BŬNBYSSԠAGS PA$NԠNŠϠ$N? BŠYSSԠAGS SZSSƠNH MPNDAԠNMAY SBBPSŠSԠHŠAPAG SAPBANDSԠADDSS MPNDANDNNU SKPҠDABUƠSKPADB̠D AƬAƠGԠSAVDDNGH MANAANDSԠNGAV NASKPHŠNGH SABUƠSԠҠUN SKPؠSBDBSԠSKPAD SZBUƠDN? MPSKPؠNϠDϠNԠN. MPSàYSGϠGԠNԠD PSSDB̠DS DDBҠSBZADƠNԠADNG MPSKPҠSKPϠND DABGԠUN ANDMSAŠUN MANA SANԠSԠNSUNUN DABMPUŠHŠDS ANDM00AN DBP̠GԠHŠMANANBAS SZASSƠBASŠPAG DBPBŠPAŠHBPBAS SBDBADANDSԠHŠDBASŠADDSS SBDBSԠGԠADDҠƠNԠDNBU SBDBSԠGԠADDҠƠNԠDNBU DBUA̬ɠGԠANADDSS ADBDBADAŠHŠDADDSS SBDBADSAVŠANADDSS DBDɠGԠSԠDB̠ADDSS SZPGSKP-SԠDB̠D MPDB0GNŠSUBSUNԠDS N BGNNN-DMSDŠ AAҠHŠBSSAG SABSSDP DA0ƠUNԠPAGŠNKNGHN SZAMUSԠNԠSKPҠŠSŠHŠNKS DAD6ɠGԠYP ANDMSAŠYP PAPYPŠԠDSKSDN? SS PAP3YPŠBGDSKSDN? SS PAP5YPŠBGSGMN? SS MPDB0SԠPGMAD0ҠSDNS NDNN-DMSDŠ Z BGNDMSDŠ MŠHŠNSԠBSSƠMDU ƠMDUŠSASGMNԠHNDN' SŠBSSNDSKSNŠԠNY NDASADDSSSSHADHHŠMAN SPà A SABSSDPZϠADPNԠS DAD6 ANDMGԠPMAYMDUŠYP PAP5 SSADUSԠADPԠҠSG MPDB0SAԠM̠à0 ҠA̠HS NDDMSDŠ SBBSSDPSAVŠNA̠PGDSPAMN ADBABҬɠDSà SBABҬɠBASŠADDSS SBMABìɠANDHŠMAؠADDSS DB0SBDBSԠGԠADDҠƠNԠDNBU DḆDBUA̬ɠGԠANBYԢS SBKYSAVŠҠANYP DAN5 SANSNSԠANBYŠUN SBDBSԠGԠADDҠƠNԠDNBU DB̲DAKYGԠANBYS AƬAҠAŠϠנA SAKYSAVŠҠNԠNSUND ANDMSAŠUNԠBY PAPNA̠N? MPDB̴YS-GԠNKADDSS PAP5MMYN? MPDB5YS-HKҠNDԠNK PAP6BYŠADDSS? MPDB6YS-GϠAUAŠHŠADDSS. ADABADADDANBASŠABŠADD DBAɠGԠANBAS ADBUA̬ɠADDUNԠNSUND AAҠHŠNSUN MPDB̴ANDGϠNHŠYPŠPSS DB33SBDBSԠGԠADDҠƠNԠDNBU SZNԠSKP-ASԠNSUNU SSNϠ-NNU MPSàYS-ASSYNԠD SZDBADNҠDB̠ANADDSS SZNSNSKPƠNנANBY MPDB̲NϠ-PSSNԠNSUN MPDḆYS-GԠNԠANBY PSSDB̠ԠD DB̴DAUA̬ɠGԠUNԠDB̠D ANDNԲKAҠHŠUNԠPAGŠB BSԠSԠϠZ DB̴SANSҠSAVŠHŠNSUND MPDB5GϠϠYPŠ5DHAND DB5DAUA̬ɠGԠUNԠDB̠D ANDNԲKAҠHŠUNԠPAGŠB DB56SANSҠSAVŠNSUND SBDBSԠGԠADDҠƠNԠDNBU DBUA̬ɠGԠADDSSϠB DANSҠGԠHŠNSUN AƬA̠SԠ AƠABYŠADDSS DANSҠGԠNSUND ANDP3SAŠHŠMҠD ADAMADNDؠNϠHŠBASŠAB ADBAɠAŠHŠADDSS rSZƠBYŠADDSSHN ADBAɠDUBŠHŠADDSS DANSҠGԠHŠNSUNDAGAN ASASMVŠDNA̠ϠנA. DB̠YPŠNSH DB5ANDM3SAŠHŠDNA SAشɠSAVŠDNA̠NHŠؠUPAB SB3ɠSAVŠHŠSԯADDSS DANSҠGԠHŠNSUNAGAN ANDM60SAŠHŠPDŠAND SAزɠPUԠԠNHŠUPAB DADBADGԠHŠDADDSS SAرɠSԠHŠŠADDSSNHŠAB DAشɠGԠHŠDNA SZASSƠNN MPDB5GϠUPUԠHŠNSUN SBSSKҠDNA̠NS'S HԠ0HAԠƠNԠH DASԱSԠHŠSԠNYNH DBBGGԠHŠBAG SZBSSƠNԠADNGŠSB MPDB̴5USԠNNU PAPBSŠSHSANŠϠ$NԠҠ$PV? SSYSSKP MPDB̴5NϬNNU DA$BҠYSUSŠ$BҠNSAD SAS SBS HԠ0 DAرɠGԠHŠŠADDSS NAANDSԠHŠADDSS SAADPAP DAN3 SAADPƠSԠҠSԠADDSS DB̴DASԱGԠNנSԠNYANDNNU DB̴5SAشɠؠUPAB DASԴɠGԠHŠDNNADDSS PAP3ƠPDND SSHNG PAPSND MPDB5HŠNSUN PAPƠSYMB̠SNMMAN MPDB5GϠADDUSԠҠMMAN DAS5ɠSŠƠSYMB ŬSZASDND MPDB5GϠSND DB60DA0ƠNԠADNG SZASKPHŠؠNY SBSؠUNDNDSYMB̠MAKŠؠNY AMAKŠSUŠؠNYS SAرɠAGDPL+TRNPY MPDB33GϠGԠNԠNY DB5DAرɠGԠHŠADDSS PAADPHSAAPADDSS SSYSSKP MPDB6NϬDϠNMA̠AD DAADPƠGԠAPASNAG NASZASSASԠAPƠH? MPADDرYSGϠDϠ+HNG NASZASSؠADDSS? MPADDؠYSGϠDϠؠADDSSHNG AMUSԠBŠP+AP SAشɠSԠSԠؠADDSSϠZ SZADPƠSԠҠؠADDSSNԠAP DB3ɠGԠADDSSMؠS SBADPSԠҠN DB3SAVŠHŠؠNYADDSS SBPSϠŠANؠ SA3ɠSԠϠNPNASŠNԠN DABPGԠAGHAԠS NASZASSƠN MPDB60GϠMAKŠؠNY DB6SBDؠSNDHŠNSUN MPDB33GϠGԠHŠNԠNY DB5DAMADNYPNԠSNMMN ADA3ɠSϠؠH SA3ɠHŠS MPDB5ANDUPUԠHŠNSUN DB6DAUA̬ɠGԠHŠNSUND ҠM000SԠHŠNNA̠BYŠAGB MPDB56NHŠDB̠5D ADDؠSA3ɠZAPHŠS SZADPSԠҠNԠAP SZADPƠAPNԠADDSS(+ DA$BؠPAŠHSNŠH SASԠ$B SBSؠSԠԠUP HԠ0 DASBSԠNSUN SAزɠϠASB MPDB̴GϠSND NԲKԠ5 SBSB0 ADDرSAADPAҠA̠APS SAADP 8TDBBPGԠYPŠAG NBSZBƠ$PV MPDB6USԠSNDHŠD SASԱSŠAҠHŠSԠADDSS DA3ɠSԠHSD SAPɠNHŠHҠؠNY SBDAؠGϠSNDBHNSUNS MPDB33GԠHŠNԠNSUN ZADNPSԠҠADNGUNԠPGM DABGBADNG? SZASS MP+3NϻHNADNG-GϠSPADDSS DAP6YSUNԠPGMYPŽ6? PADYP SZZADBANDSؠҠNԠBSPADDSS MPZADɠUN SPà MŠBSS MUҠNP PNP PBNP BPNP ADPNP ADPƠNP SPà3 SS-SAHSS'SҠNŠHDNA̠MAHNG ش ANGSUN: AGND BGND UNSUN:NNSƠAANDBDSYD. (N+:UNԠSԠPNSSԠUPҠASԠS. DNA̠NԠUND. (N+:UNԠSԠPNSSԠϠSԠNANNG DSDDNA. SSNP SBNSԠSԠSԠϠSԠS DBSԠPKUPSԠPN SSSKPNҠSԠM SPà SϲADBP3PNԠϠNԠS PBPSԠƠAԠNDƠS'S MPSϴHN. ADBPSŠPNԠϠD.NS DAشɠANDMPAŠHUP. ҠB ANDM3ƠנBYŠDSN' SZAMAHHNYN MPSϲSԠNY. SPà ADBNMAH..SԠADDҠƠS SPà SϴSBSԠSԠADDҠƠUNԠS SBSؠGϠSԠSԠPNS MPSSɠNϠMAH-N+ SZSS MPSSɠMAH-N+ SPà3 DؠDSHŠؠUPPNDϠBYHŠUNԠؠUP ABŠANDSԠNYS.DؠSUSDҠA NSUNSAN,DMAYBŠADNY AҠHŠSYMB̠(ƠANYSDND. ANGSUN: SԠUPر-ANDSԱ-5ҠHŠNY SB UNHŠؠNYSŬABMANNGSS DؠNP BŠSԠHŠNԠBPNK SBBPN̠AG DAشɠƠN SZASSSԠADDSS MPVؠUSŠZϠVAU DAS5ɠGԠHŠSYMB̠VAU DBSԴɠGԠHŠSYMB̠YP PBPSPAMNԠSYMB MPZؠGϠDϠPAMN VؠDBزɠGԠHŠBY BƬB̠BԠ B̬ŬSBBŠAND ADAADUBŠHŠADDSSƠS BƬBƠSŠB BƬBҠHUԠHŠBYŠB SBزɠANDSԠNHŠAB ADA3ɠMPUŠHŠMMYADDSS SAPNDANDSAV ANDM060AԠHŠPAGŠNUMB SAPAGNϠANDSAV SZASSƠBASŠPAGŠP MPPؠGϠAԠASUNԠPAG DAرɠGԠHŠNS.ADDSS ANDM060AԠHŠPAG SAPPAGSAVŠ DBشɠGԠHŠSԠADDSS SZBƠԠN MPؠUSŠABPNK PAPAGNϠƠSAMŠPAGŠASPAND MPPؠGϠDϠUNԠPAGŠK ؠDAزɠGԠHŠNSUN ŬAZAPHŠNDԠB SZBƠԠN MPDƠGϠUSŠANK SZASSƠNԠAMƠNSUN MPPؠHNDϠHŠDƠK DƠDBPNDGԠHŠPAND SZƠNDԠN ADBMSGNADDHŠSGNB SBPNDSԠ DAشɠƠNA̠N SZAHN SABPN̠SԠҠBASŠPAGŠNKNY SBBPSNGԠANKADDSS ҠMSGNAADDSSSԠNDԠB ؠSABSAVŠHŠADDSS ANDMB0PUGŠHŠPAGŠBS PABƠHŠŠSM SSHN'SAPNKS ҠM000SԠHŠPB YؠҠزɠNUDŠHŠNSUN ZؠDB0ƠNԠADNG SZBSSHN MPAؠSKPHŠDSà DBرɠGԠHŠŠADDSS SBABDϠUPUԠHŠD AؠAŠHŠؠUPABŠNY SAر MPDجɠAND PؠDAPNDPBPDƠ-GԠPADDSS DBزɠ ŬBD SZBSSHN MPYؠUSԠPKUPHŠND. DBPAGNϠƠABASŠPAGŠN SZBҠ DBشɠNԠAN SZBHNDϠDԠNK SZBPN̠SŠSԠϠUSŠBPNK(SKPS MPؠUSŠSANDADNK MPؠUSŠBPNK PPAGNP BPN̠NP SPà3 SؠNDSHŠSԠŠؠUPABŠNY. ANGSUN: SBS SؠNP SBؠNZŠHŠؠUPAB SرSBؠSԠADDSSS MPSزԠNנNY DAرɠHSNY? SSASSŠƠNGAV MPSرNϠKPKNG MPSجɠ SزDAؠƠNנNY SAPؠUPDAŠHŠND BƠHŠS SBرɠANDAҠHŠNY MPSجɠ SPà3 DAؠDSA̠ؠUPҠHŠUNԠSԠNY ANGSUN: SԠUPHŠSԠNY SBDA DAؠNP SBؠSԠUPHŠSAN DAɱSBؠSԠADDSSS MPDAɲNDƠSԠGϠϠԠD DAرɠƠNU̠NY SSAHN MPDAɱGNҠ DAشɠGԠSԠNY PASԱHSNY? SB%DؠYSDϠHŠ MPDAɱGԠNԠؠUP DAɲSBSؠSԠUPAŠؠUPNY MPDAجɠAND SKP ؠADDSSUNS ؠANDؠSԠUPHŠر-شADDSSS ؠNZSHŠADDSSϠHŠSԠNY ؠGԠHŠNԠNY ANGSUN: SBؠABGNDASԠNUNBSAVD ؠNP DABؠSԠؠϠS SAؠNY MPجɠUN ANGSUN: SBؠABGNDASԠBSAVDNUN UNϠP+ƠKϠP+ƠBYNDNDƠDNDؠUPS ؠNP DAؠGԠUNԠAN PAPؠNDƠS? SSYSSKPHŠND SZؠSPϠANAŠUNADDSS SAرSԠUP NAH SAزADDSSS NA SA3 NA SAش NASԠNԠADDSS SAؠN MANAHKҠMMYV ADAPDN SSASSƠUԠƠMMYSKP MPجɠSŠUNϠA MPSҠSŠGϠϠҠUN HDŠGNAҠADUYSUBUNS AҠPGAMS-ADDAGS D3ASHŠUSAGŠAGSϠNSUŠHAԠPGAMS̠B -ADDAGANƠADMŠHANN.HSSSSNA ҠA̠UYPGAMSANDUSҠSUBUNSBUԠMUSԠN BŠDNŠҠSYSMPGAMSBAYPGAMSҠMANUS PGAMS.BHHŠUSAGŠAGNHŠDNԠNYANDH SYMB̠VAUSҠA̠NYPNSNHŠPGAMAŠAD. ANGSUN: AGND BGND SBD3 UN:NNSƠAANDBAŠDSYD. D3NP DBP3GԠHŠSANDADAG DAP5 @CPAPYPŠPGBGSGMN? DBPYS-GԠBSAGBS SBUAPSԠUNԠPGAGBS SBNDؠNZŠHŠDNԠSANN D3SBDؠGԠHŠNԠDN. MPD3ɠƠNNŠHNԠ-DN DAD6ɠGԠMSYP A̬ŬASԠŠƠMAN ANDMSAŠYP SZASSƠSYSM MPD3GԠ ANDMSAŠUH PAP6YPŠBAY? MPD3HN-DϠNԠHANGŠAG PAPƠBYP ŠSԠNԠMANAG SZƠMAN MPD3GԠ DAD3ɠGԠUSAGŠAG ANDPSAŠHŠUSAGŠAG PAUAPƠNŠHAԠŠAŠA SSSKP MPD3SŠYHŠNԠN ҠD3ɠZAPHŠUSAGŠAGS SAD3ɠANDSŠHŠD SBNSԠNAZŠS SUԠSBSؠSԠUNԠSԠADDSSS MPD3YNԠDN DASԴɠGԠDNԠADDSS PADNԯԠBNGSϠUNԠPG? BSSYS-NNU MPSUԠYNԠSԠNY SBS5ɠAҠSYMB̠VAU MPSUԠNNUŠANGBPNKADD. SPà HŠGPUNŠSSUPANDNZSANנPNKAA ANGSUN: SBGP UNANKP̲ADDSS GPNP DAP̲USŠUNԠP SBNKSSԠADDSSS A̠HŠNKUN SAP̲ SBNKSԠADDSSҠNԠAA ASԠAAϠZϠSZ SANK SANK DANK3SԠHŠMAGŠADDSS NA SANK3 DANKSԠNנPANDAҠ SAP̲ MPGPɠUN SKP 1GԠBPNKADDҬSԠBPVAU BPSNSANSHŠUNԠAADNKS ҠAVAUŠUA̠ϠHŠUNԠPAND.ƠSUHAVAU SUNDHŠADDSSƠHŠPANDSUND NHŠA-GS.HSŬANנNKDS SVDANDHŠADDSSƠHSDUNDNA. NHSASŠHŠPANDDSSԠNHŠAAN MAGŠAA. ANGSUN: AGND BGND SBBPSN UN: ABPNKADDSSҠUNԠPAND BDSYD BPSNNP SBNKؠNZŠHŠNKMAPP BPSòSBNKSԠUPHŠSԠAA MPBPSôƠNNԠGϠAA SBSNSANHŠAAҠANK MPBPSòƠNNUNDYNԠAA MPBPSNɠSŠUNHŠNK BPSôSBAàNNAADSϠAAŠN MPBPSNɠANDUN SKP SANAAҠSAMŠPAND HŠSNSUBUNŠNSHŠSANҠAGVNPAND NHŠUNԠNKSN. ANGSUN: SԠUPNKNKNK3ϠPNԠϠHŠUNԠNKAA SԠPNDϠHŠVAUŠDSDANDBPN̠Ϡ-ҠANYAA ANDϠ0ҠBASŠPAGŠNY. SBSNBP UN: P+:NKNԠUND P+:NKUND(AADDҠƠPAND SNNP DANKɠGԠHŠҠADDSS SANKANDSAVŠ DBBPN̠GԠHŠBASŠPAGŠNYAG ANDM060SAŠHŠPAGŠƠUNԠAA SZASSƠBPHN BSԠBҠK SSBSSƠBPNYANDNԠBP MPSNɠUNNԠUND SZAHKƠGHԠPAGŠ(BPSAAYSGHԩ PAPPAG SSGDNKAA MPSNɠNԠGHԠPAGŬ DBNK3ɠGԠHŠMAGŠADDSSϠB SNDANKGԠHŠAUA̠ADDSSϠA p"PANKɠNDƠAA? MPSNɠYSԠNԠUND DABɠNϬGԠHŠVAU PAPNDHS? MPSNYSGϠUN NBNϠSԠҠNԠNY SZNK MPSN SNDANKGԠHŠŠADDSS SZSNSPϠHŠUNADDSS MPSNɠUNNKUNDADDSSNA SKP SԠUPNKAA NKNKSANDNKؠMANAGŠHŠNKAA. HSAASMPSDƠPSANDNKAA MAGSASS: DHŠAUA̠ŠADDSSƠHŠNKAA DHŠAUA̠ŠADDSSƠHŠASԠD+ƠHŠAA D3HŠADDSSƠHŠADSMAGŠƠHŠAA HŠSԠHŠNSAŠҠBASŠPAGŠASS: AAHŠŠSDNԠSYSMBASŠPAGŠAA AAHŠBAKGUNDŠSDNԠAA AA3HŠUNԠPGAMSBASŠPAGŠAA ҠHSŠAAHŠMAGŠSNHŠDUMMYBASŠPAG ҠA̠HҠNS(..ҠUNԠPAGŠNKAAS HŠMAGŠSHŠHŠDDNNƠHŠAA. NA̠ASSHŠASԠDNDAASHŠNŠHAԠHASA DADDSSƠP̲HHSUSUAYHŠHGH UNԠPAGŠNKAAҠHŠUNԠPGAM NKؠNZSHŠSANNNGƠHŠNKAGŠAA NKSSUPNKNKNK3ҠHŠNԠNY P+UNNDANGHŠSNϠNԠN. P+NDANGHAԠHŠSԠUPASDN. NKSSSUPNKNKNK3GVNHAԠHŠSԠDADDSS SKNN(ANDPASSDNHŠAGSҩ NKؠNP DANKGԠNA̠ADDSS SANKSԠNNK MPNKجɠUN SPà3 NKNP DANKGԠUNԠADDSS PAP̲ƠASԠNY MPNKɠUNNDƠS DAAɠGԠHŠAUA̠ADDSS ANDM060SAŠ}HŠPAGŠADDSS SZASSƠBASŠPAGŠDϠHŠBPHNG MPNKB DANKɠSŠAUAŠHŠADDSS MANAHŠN ADANKɠNY ADANK3ɠBYSKPPNGVҠHŠMAG NKASBNKSSԠUPHŠNנAA SZNKSԠKUNADDSS MPNKɠUN NKBDANKҠBASŠPAG ADAP3USŠNԠH MPNKADAA. SPà3 NKSNP SANKSԠHŠNKPNSUP NA SANK NA SANK3 MPNKSɠANDUN SPà3 NKDƠBNK SKP AAŠNנNKD HŠAàSUBUNŠSABSHSA̠HŠNKAGŠADDSSS. ƠHŠAADNKDASNHŠSYSMMMUNANAA ADSGNSàSPND. ANGSUN: AGND BGND SBA UN: AAADBPNKADDSS BDSYD AàNP DBPNDSAVŠHŠPAND SBASAVAY BSԠPAND SBPNDϠZϠϠA̠SN DAP̱SԠUPϠSANHŠנPNKAA SBNKS SBSNSANHŠAA SSƠNԠAADSKP MPAϱSŠGϠSԠUP DAP̲YHŠHGHAA SBNKSSԠԠUP SBSNSAN ANASSƠNԠUNDSKP MPAϱSŠGϠSԠԠUP N BGNNN-DMSDŠ SANK̠HŠUN DAB̠HKҠVҠ PASBPϠMUH? MPұ6YSGϠSNDMSSAG SZB̠SPҠNԠM DBAMPUŠH ADBADBPMAGŠƠHŠBASŠPAG NDNN-DMSDŠ Z BGNDMSDŠ SԠUPNנNKNBASŠPAGŠAA SPà fSANKSKPAG DAB̠DSNנNK PABPMԠUA̠MԠADD MPұ6YS DBANϬSAVŠNKADD ADABPNàUPDAŠϠN SAB̠SԠNԠNKADD DABGԠA̠ADDҠƠNנNK ADBADBPANDMAGŠADDҠƠNנNK SPà B̠NANSPNҠϠNԠŠBPNK(SAS AԠҠD'SSYBPҠM'SANDSBPҠSYS BANDSSGAMDUS.BPNàSԠϠ-HN ADNGSYSABSBSSGAANDϠ+ HS.BPMԠSԠϠSYBP(ABVŠAPS ҠSYSBABSANDSSGAANDϠS SYSMNKҠHS. NDDMSDŠ AϱSAHAҠSԠHŠADDSS DAASAVGԠHŠPAND SAPNDSŠ SABɠSԠԠNHŠMAGŠAA DANKƠAANM PAP̱PנAA SZP̱HSPHŠUN PAP̲ƠMHŠHGHAA SZP̲HSPSUN DAHAҠSԠHŠADDSSNA MPAìɠANDUN ұ6DAұ6GԠHŠҠD SBҠSND AUNZϠASHŠNK MPAì ASAVNP SKP PAKHŠPNKAA PKPAKSHŠUNԠPAGŠNKAAϠGԠDƠNK AASHAԠAŠNϠNGҠAV. ANGSUN: DAUNԠPAGŠADDSS SBPK UNGSSMANNGSS PK̠DŠA̠NKAASHAԠAŠABV PSANDҠϠANAANAPAGŠBנHŠPAG ADDSSNANNY.Ԡ̠ASϠDŠA NSҠZϠNGHAAS. PKNP ANDM060SAVŠH MANAPAG SAPAGADDSS DAPSGԠHŠSԠNYϠSAV SAPSAVŠҠ̻ASԠVADNY SBNKSSԠUPHŠNKAA SBNKGԠHŠSԠPSSBŠPUGŠAA MPPKɠƠNNŠHN DANKɠƠHSAA PANKɠSƠZϠNGH MPP0GϠSԠUP ANDM060SŠƠAASABVŠҠUA ADAPAGϠHŠSAVŠPAGŠAA SSASSHN MPPKɠԠ-NϠPAKNDD P0DANKSԠUPHŠNԠAVAAB P̱SAPPN P5SBNKGԠHŠNԠNY MPP3ƠNNŠGϠHAND DANKɠƠS PANKɠAZϠNY MPP5ԠHŠNY ANDM060SAŠHŠPAGŠADDSS ADAPAGƠS SSABנHŠSPDPAG MPP5ԠHŠNY DAPKPHŠAA SAPSԠASԠAAPN SAPSԠMVŠPN DANKɠSԠUPH MANA ADANKɠMV SAP3UN DANKɠSԠDS SAPɠN SZP DANKɠ SAP SZP DAPAND NA SAPɠH DBNK3ɠMV P̲SZPH DABɠMAG SAPɠϠHŠNנAN NB SZP3 MPP̲ DANKAND PAP̲P̲ MPP3ƠNDGϠDϠSPA DAPUPDA NAҠHŠNԠNY MPP̱ANDGϠDϠ P3DBPSԠUP SBP̲P̲HŠUPPҠM MPPKɠAND SPà PNP PNP P3NP PNP PAGNP SKP AҠHŠUNԠPAG PASHŠUNԠPAGŠNKNGMAGŠPNDAԠBY HŠUNԠNKNY. PNP DANKɠMPU MANANUMB ADANKɠ SANKDSϠA SZASSƠZϠHN MPPɠ DANK3 SANKؠGԠADDSSƠAA ñAA SANKجɠAD SZNKؠSPϠNԠN DANKؠHK ADAPMVנ SSASSMAGŠAA MPUNGϠSHNƠV SZNKSPUN MPñƠNԠDNŠDϠNԠN MPPɠUN UNDANK3ɠAUAŠMA ADAPMAASZ MASSANAƠNGAV ASԠϠZ ADANKɠADDBASŠADDSS SANKɠSԠNנUPPҠND MPPɠANDUN SKP UPUԠUNԠUNԠPAG UPUPUSHŠAASPDBYNKNKANDNK3 ϠHŠDS. ANGSUN: SԠUPNKNKNK3 SBUP UNGSSMANNGSS UPNP SBNKSSԠUPHŠNKAA DANKɠGԠH MANANUMBҠ ADANKɠDSϠUPUԠ MANASZASSAANDƠZ MPUPɠUN SADNԠSԠHŠUN DANK3ɠGԠHŠADDSSƠHŠSԠD SABUƠANDSԠ DBNKɠGԠHŠŠADDSSϠBŠUSD UòDABUƬɠGԠAD SBABDϠSNDԠϠHŠDS SZBUƠSPHŠDADDSS SZDNԠANDHŠUNԠDN? MPUòNϠDϠHŠNԠD MPUPɠYSUN SKP ADAABŠDN DBSԠSABSHSHŠADDSSƠHŠNԠDƠHŠAAB DNBU.ƠBUƠHASBNPSSDԠSSUSAA̠ DBNϠADANHҠPAKDAABŠD. ANGSUN: AGND BGND SBDBS UN:NNSƠAANDBAŠDSYD DBSԠNP SZUA̠NҠUNԠBUƠADDSS SZNԠSKP-NDƠBU MPDBSԬɠUN SBDBNADNԠAABŠ MPDBSԬɠUN HDŠGNAҠADDSMDSK ADPAKDAABŠS HŠDBNSUBUNŠADSHŠPAKDAABŠDSM HŠDSKASSPDBYHŠDSKADDSSAԠDSKD. ANGSUN: AGND BGND SBDBN UN:NNSƠAANDBAŠDSYD. DBNNP DADSKDGԠUNԠDSKADDSS DBDBNGԠUNADDSS PBDBNSƠNAMDAD SSAANDSYSMSUBHANN̠SKP MPDBNSŠGϠAD DBDSKAGԠMAؠADDSSNN MBƠGAҠHANҠUA ADBAHSADADDSS SSBSSƠPSVŠ-K MPDBNSϠNNU DA3SŠ-ŠSԠHŠD SBҠSϠBMB DBNDBABUƠGԠADDSSƠBU SBUA̠SԠUNԠBUƠADDSS SBDSKɠADDMDSK DADSKDGԠDSKADDSS SADSKؠ-SAVŠUNԠADDSS. SBDSKANҠDSKADDSS SADSKDSԠNԠDSKADDSS DAN6 SANԠSԠUNԠBUƠUN MPDBNɠUN SPà DBNSDƠDBNԠADDSSƠNAMDADUN SPà3 ұ5ASà5GA̠A̠BYYPŠ6PGM ұ6ASà6BPNKAGŠAAU BNKSASàBANKS BASԠASàBANKASSK PAҠԠ50ԠPAN SPà HDŠGNAҠGNAŠNԠNYKYDDSG GNAŠNԠNYKBYDDSG GNDGNASHŠUNԠDSGMNԠANDKYD ҠHŠPGAMADD.NADDNԠGNASH NKAGŠUDNHŠNUPԠABŠҠHSŠPGAMS HHAŠϠBŠSHDUDUPNPԠƠANNUP. ANGSUN: A0(GNAŠSHԠDSGMNԩ -(GNAŠNGDSGMNԩ -(GNAŠBANKNGDSGMNԩ BGND SBGND UN:NNSƠAANDBAŠDSYD N:HANGDҠ-ɬBUԠMPABŠH-. ABSADDҠƠDSGMNԠNAGԠSYSMSSAVD NDNԠDҠAҠASSϠD-SG. GNDNP SAPGSAVŠDSGMNԠNGHAG PANƠBANKGN MPBDGϠSNDHŠKYD SPà NנҠ-ɠ DBSYSADGԠSAԠADDҠҠD-SG DAPGSHSASH SZASSD-SGMN?? ADBGYSADDSԠҠ-GS SBSH3SAVŠSAԠADDҠNAMP SBSYSADANDUPDAŠBAS. SBUAɠUPDAŠUDPҠ. SPà GNAŠNԠNYҠUSҠSYS DAASԠGԠHŠADDSSƠNԠMAG SAUA̠SԠUNԠNԠADDSS DANԠGԠN.ƠNԠNS MANASZASSSKP-NԠNԠMPY MPSKYGNAŠKYDDSGMN SANԠSAVŠA̠NԠUN GԠDAUA̬ɠGԠUNԠDNN MANASԠNGAVŠNSҠS PAMANUA̠ϠMANDNԠADD? SSYS-NNU MPNPNGNŠƠƠNԠUNԠMAN DASYSADGԠDSGADDSS MANAGԠ'SMPMNԠҠNԠNY DBASԠMPUŠHŠNԠ MBNBADDSS ADBUA̠iBSԠSԠPUS ADBANԠAUA̠ŠADDSS SBABDϠSNԠHŠNYϠHŠDS NPNSZUA̠SPϠHŠNԠNY SZNԠSKP-NԠHAUSD MPGԠANAYZŠNԠNԠNY GNAŠKYD SKYDAMANGԠMANDNԠADDSS SADNԠSԠADDSSҠD SBDؠSԠDNԠADDSSS HԠ0NϠDNԠUND SPà DBSYSADPNԠϠDSGMN DADGԠDNԠPN PASHSHDUŠPGM? SBSHYS-SAVŠSDADDSS BDDASYSADGԠHŠD-ADDSSϠA DBUAKANDHŠUNԠŠADDSS SBABDϠϠBANDUPUԠϠHŠDS SBUAKSԠHŠNנADDSS DBSYSADGԠHŠADDSS DAPGGԠHŠDSGMNԠNGHAG ADBPADUSԠҠNԠDSGMNԠADD SZASKP-SHԠDSGMN ADBP6ADUSԠҠNGDSGMN SBSYSADSԠNԠDSGMNԠADDSS GNAŠDSGMN DAPGƠAG- PANBANKUPUԬ MPGNDɠ SPà NנҠ-ɠ DAKYADSAVŠKYD MASԠ ADAUAKAҠASSϠD-SG. SAD DBN6 SBZUԠUPUԠZSϠDSGMN DAUPɠGԠHŠUNԠPY SBUDUPUԠDϠDSGMNԠBU DAPNԠGԠPMAYNYPN SBUDUPUԠDϠDSGMNԠBU DBN SBZUԠUPUԠZSϠDSGMN DASH3GԠADDSSƠUNԠDSG &ZXTTZNASPϠPAMS SBUDUPUԠBGϠDSGMN ASNDůϠGS SBUDHŠDSGMN DADɠGԠNAMŠ SBUDUPUԠDϠDSGMNԠBU DADɠGԠNAMŠ3 SBUDUPUԠDϠDSGMNԠBU DAD6ɠGԠYP ANDMSAŠYP SABSAVŠYPŠNB DAD3ɠGԠNAMŠ5 ANDM00SAŠNAMŠ5 ҠBADDYPŠϠNAMŠ5 SBUDUPUԠDϠDSGMNԠBU APSԠҠDMAN DBDƠHSPGMϠB PBSHSHDUD ANASԠSHDUDAG SBUDSԠDND ASԠMŠNK SBUDϠZϠANDUPU DAMUҠGԠSUNDŬàMU SBUDUPUԠDϠDSGMNԠBU DAMŠGԠנPAԠƠM SBUDUPUԠSϠDSG DAM+GԠHGHHA SBUDUԠMSHAƠϠDSG DBNZS SBZUԠDSGAND SZPGSKP-PUUԠNGDSGMN MPGNDɠUN-SHԠDSGMN DAPP̠GԠUNԠPGàADDSS ADABSSDPADDNA̠PGDSPAMN SBUDUPUԠDϠDSGMNԠBU DAP̠GԠUNԠANADDSS MANAHK ADAASMMMYV SSANASZAKƠPSҠ- MPұYSGϠSNDHŠBH DAP̠NϠSNDHŠUPPҠM GN9SBUDUPUԠDϠDSGMNԠBU DAPB̠GԠנBPANADD SBUDUPUԠDϠDSGMNԠBU DAB̠GԠHGHBPANADD SBUDUPUԠDϠDSGMNԠBU DADSKMNGԠNA̠MANDSKADDSS SBUDqUPUԠDϠDSGMNԠBU A SBUDUPUԠDϠDSGMNԠBU MPGNDɠUN-DSGMNԠU SPà ұDAұSNDҠ SBҠMMYV DAASMUSŠASԠDƠMMYNSAD MPGN9GϠNSHHŠD-SGMN SKP UPUԠZϠϠDBU ZUԠPUSUԠZSϠHŠDSGMNԠBU. ANGSUN: AGND BN.ƠZSϠGϠUԠ(NG.. SBZU UN:NNSƠAANDBAŠDSYD. ZUԠNP SBNԠSAVŠN.ƠZSϠGϠU A SBUDUPUԠZϠϠDBU SZNԠSKP-A̠ZSU MP-3NNUŠZϠUPUԠϠBU MPZUԬɠUN SPà GNSDNPGNAŠSHԠSGMNԠD-SGMNS SAPGSAVŠHŠAG DBSKYAGԠHŠKYD DASDSAADDSSANDSNNS SBABDϠSNDHŠKYDϠHŠDS SBSKYASԠHŠNנKYDADDSS DBSDSAGԠHŠD-ADDSS ADBP9ADDUSԠҠNԠM SBSDSAANDSAV ADBPADDUSԠҠADDSSƠUNԠD DAPGHSA PANBANKSHY? MPBSDYSGϠDϠBANKHNG DAPNԠNϠGԠHŠPYMAYNYPN SBABDϠSNDԠϠHŠDS DAMANGԠHŠDN SADNԠϠUN SBD HԠ0BҠBŠN DADɠGԠNAMŠ SBABDϠSNDϠHŠDS DADɠGԠNAMŠ3 SBABDϠSND DAD3ɠGԠNAMŠ5 ANDM00MASK ҠPSԠYPŠANDSHԠAG SBABDϠSNDԠϠHŠDS DABSPADGԠHŠMMYADDSS ADABSSDPADDUSԠҠADNGBSS SBABDeϠSNDMAN DAP̠GԠAND MANAHKҠMANMMY ADAASMVҠ SSANASZAƠVҠ MPBS3GϠPԠ DAP̠KSϠPUԠԠU BS0SBABDϠSNDMAN DABSBADGԠAND SBABDϠSNDBP DAB̠GԠAND SBABDϠSNDBP DADSKMNGԠDSàADDSS BSɲSBABD MPGNSDɠUN BSDADBP3ҠBANK DAP6SԠHŠSHԠBԠNY MPBSɲGϠSND. BS3DAұSNDҠMSSAG SBSDSSAVŠPNҠNϠDSG SB DBSDSSŠPN DAASMUSŠASԠDƠMMYNSAD MPBS0GϠNSHHŠD-SGMN SDSANP SKYANP SDSBSS SKP UPUԠDSGMNԠDϠBU UDPAKSHŠDSҠHŠDSGMNSNHŠDSGMN BUҠANDSHŠBUҠNHŠDSKHNԠNANS 6DS. ANGSUN: AUNԠDSGMNԠD BGND SBUD UN:NNSƠAANDBAŠDSYD UDNP DBUAɠGԠHŠUNԠD-SGMNԠADDSS SBABDϠSNDHŠDϠHŠDS SBUAɠSԠHŠADDSSҠNԠM MPUDɠUN HDŠGNAҠUPUԠABSUŠPGAMD UPUԠABSUŠPGAMD ABDϠPUSUԠHŠUNԠABSUŠDŠDҠHŠPGAM BNGADD.ԠSHŠGAPSHZϠDSƠH UNԠDASBYNDHŠHGHSԠPVUSYGNAD D. ABDϠKSMAABŠƠHŠDSHHDN HŠUNԠDŠSGMN'SDSàADDSS.HSABŠS ASS: ABDSKɠSHŠBASŠDSàADDSSƠHŠUNԠDŠSGMN ABҬɠSHŠBASŠŠADDSSƠHŠUNԠDŠSGMN MABìɠSHŠMAؠŠADDSSBANDSϠAҠNHŠSGMN MABìɠSHUDBŠNZDϠABҬɠAND̠BŠUPDADBY HSUNŠASHŠADADVANS. HSUNŠHASNϠSNSNBAKNGUPANDVAYNG. ANGSUN: AUNԠABSUŠDŠD BŠADDSSƠHŠD SBABD UN:A-GHASPVUSNNSƠMDDD. B-GHASŠADDSSPUSN ABDϠNP SSBƠSSHANZϠHN MPABDϬɠVҠנƠMMSϠGN SBASAVSAVŠHŠŠADDSS SANSAVANDHŠDŠD ADB̲000ƠADDSS SSBSNH MPABBPBASŠPAGŠGϠDϠSPA DAABҠSAVŠUNԠBASŠPAM SAABMNA̠MP DBAɠƠHŠUNԠ DAP5ADDSSSSS PAPYPŠHANHSBASŠANDSG.AD MBNBSS MPAB0NԠASGAD ADBASAVƠBHNDNSU SSBHN SBUSҠSԠUPϠؠMAN. AB0DBASAVSŠHŠŠADDSS MBNBMPUŠSԠMD ADBMABìɠMA NBAND SBABSKSԠHŠSKPUNԠ(-ϠSKP DAMABìɠGԠHŠUNԠMA NAPUSN SSBSSƠNԠSKPPNG DAASAVUSŠGVNADDSS DBABҬɠANDMPUŠ MBNBADDSSS ADABMHŠBASŠADDSS SSADAGSàHA HԠ66BSHUDNVҠBŠNGAV BPPAŠϠDVD DVP6DVDŠBYHŠSҠSZ ADBADBUƠSԠDBUƠS SBUADSԠADDSSҠS SABSAVŠHŠSҠUN DAABDSKɠGԠHŠBASŠDSàADDSS MBNBSZBSSSԠHŠUNԠNGAV MPSADƠZϠUSŠSԠADDSS SBABNԠSԠHŠA̠UN ABSASBDSKABUMPHŠDSàADDSS SZABNԠHŠSPDNUMB MPABSAƠMS SADSANDASԠHŠNנDSàADDSS PADDAƠSAMŠASD MPABàSҠSN DADDAGԠHŠDADDSS DBADBUƠANDBUҠADDSS SSASSƠA̠DSàADDSS SBDSKϠŠHŠBU DBABSKGԠHŠSKPUN MBNBSԠPSV DAADBUƠƠSԠDƠBU PAUADANDNԠBAKNG SSBUP SS MPABDSKPHŠAD DBADBUƠADNHŠS DANDAϠBŠMDD SBDSK ABDDANDAUPDAŠHŠDS SADDAADDSS ABàDAABSKGԠHŠSKPUN SSASSƠNNŠϠSKP MPABUUSԠPUPUԠHŠD ABɠASŠ SBS̠HZS SZABSKDN? MPABɠNϠDϠNԠD ABUDANSAVGԠHŠD SBS̠UPUԠ SBBSAVSAVŠPҠNNSƠD DAASAVGԠHŠŠADDSS DBAƠN MBNBMAMUM ADBMABìɠHN SSBS SAMABìɠSԠ DAABMS SBSDSHŠPAMS DADDAƠNנMA MANADSàADDSS ADADSKADHN ABؠDBASAV NB SSASSSKPUN MPABز DADDAAND SADSKADUPDAŠHŠDSàADDSS ABزDABSAVSԠPҠNNSƠD MPABDϬɠANDHNUN SPà ABBPDBASAVGԠHŠŠADDSS ADBADBPADUSԠҠDUMMYBASŠPAGŠADDSS DABɠUND SABSAVNNS DANSAVƠD. SABɠSԠHŠD ASԠϠUŠ MPABؠANDGϠ SPà ABMNP NDANP DDAԠ- ABSKNP NSAVNP ASAVNP ABDSKNP ABҠNP MABàNP BSAVNPUSDHŠANDNS ϠUNDVAUŠ MDDD. SKP SDSSSABDSKMABìABҠϠAA+A+ ҠUSŠBYABD SDSNP SAABҠS NAH SAMABàADDSS NA SAABDSKHŠABSUPUԠUN MPSDSɠUN SPà3 USҠSSUPHŠABDϠSPANADDSSS USҠK ANGSUN SBUS USҠNP DADUSҠGԠDƠϠUSҠAAY SBSDSANDSԠԠUP MPUSҬɠUN SPà3 USSSSUPHŠABDϠSPANADDSSS USҠDŠUSNGHŠUNԠDSàADDSSANDPP ҠHŠŠADDSS. ANGSUN: SBUSS USSNP SBUSҠSԠUPHŠADDSSS SBSԠSԠUPHŠADDSSS MPUSSɠUN SPà SԠSSHŠUNԠPP̠ANDDSàADDSSSNH UNԠABDϠSPANAB ANGSUN SBS SԠNP DADSKADGԠUNԠDSàADDSS SAABDSKɠSԠԠNHŠSPàBU DAPP̠GԠHŠUNԠŠADDSS SAABҬɠANDS SAMABìɠԠUP MPSԬɠUN SPà SGSSSUPANנABDϠAAҠSGMNS HŠSAMŠASUSS. SGSNP SBSGGϠSԠHŠADDSSS SBSԠSԠHŠPAMAS MPSGSɠUN SPà SGSHŠSGMNԠVSNƠUS SGNP DADSGSGԠHŠADDSS 2 SBSDSSԠԠUP MPSGɠUN SPà3 SYSSSUPHŠABDϠSPANAAYϠPNԠAԠH SYSMAB. ANGSUN: SBSYS SYSNP DADMAGԠHŠSYSMSP.ADDSS SBSDSSԠUPHŠADDSSS MPSYSɠUN SPà DMADƠMAN DUSҠDƠ+ BSS3 DSGSDƠ+ BSS3 SKP SԠҠABSUŠBUҠU S̠PUSUԠHŠUNԠABSUŠBUҠHN NANS6DSƠD.NADDNԠHKS ANGSUN: AUNԠD BGND SBS UN:ADSYDBHASDNNS ƠADDSSDD. S̠NP DBUADƠH ADBN6UNԠADDSS PBADBUƠSHŠNDƠHŠBU MPS̠HNԠSU SUDBUADɠSAVŠDDNNS SAUADɠSԠHŠD SZUADBUMPHŠADDSS MPS̬ɠANDUN S̠SAMDϠSAVŠHŠUNԠD DADDAGԠHŠDSàADDSS DBADBUƠANDBUҠADDSSAND SBUADSԠHŠNנBUҠADDSS SBDSKϠUPUԠHŠBU DADDAUPDA SBDSKAHŠDS SADDAADDSS DAMDϠSŠHŠDŠD MPSUANDGϠUPUԠ ұASàMMYV SKP UPUԠSԠ(ƠANYƠABS. MDϠPUSUԠHŠUNԠSҠƠԠNANSANYDS ABSUŠD.HSSNMAYDNŠNYAԠHŠNDƠHŠGN ANGSUN: AGND BGND SBMD UN:NNSƠAANDBAŠDSYD. MDϠNP DADDAGԠHŠUNԠDSàADDSS DBADBUƠANDHŠBUҠADDSS SSA8ƠAGDADDSS SBDSKϠUPUԠHŠD SBBPDSAUPDAŠHŠDSàADDSS MPMDϬɠUN SPà3 BPDSAADVANSHŠDSKADDSSϠHŠNԠVN DSàADDSSASSUMNGHŠUNԠDSàADDSS SNԠAVAAB.HSSNMAYDN AҠAHMANSADDANDBŠHŠBAS PAGŠSUPU. ANGSUN: SBBPDSADSNԠUSŠABUNSAUNԠDSàADDSS BPDSANP DADSKADBUMP SBDSKAHŠDSàADDSS SADSKADANDSԠ SBDSKVMAKŠSUŠԠSVN MPBPDSAɠUN SKP YůNϠNPANAYZŠYSNϠSPNSS DAN3UN:P+ SBGNAP+N SBGA̠+3YS SZAMŠHN3HA MPYůҠ DBBUƠGԠSPNS PBYHAҠY? DAPYS-SԠUNSԠҠYS PBNHAҠASԠN? ANAYS-SԠUNҠYS SZASSS̠Z? MPYůҠYS-NԠYSҠNϠ- ADAYůNϠADUSԠUN MPAɠUN YůҠSBNҠҠ-SNDMSSAG MPYůNϬɠANDAKŠҠ SPà YHAҠASàY NHAҠASàN SPà HBNDSAUNŠϠASKHŠPAҠƠHŠANSϠHANG ABUNDYGԠHSANSҠANDHKԠҠGAY. HŠMSSAGSSNԠA: ؠYYYYYAND HANGŠ?HŠؠSA0HAA MSSAGŠSUPPDASPAԠƠHŠA ANDYYYYYSHŠUNԠBUNDNA ҠDMA. GA̠SPNSA: 0NϠHANG. NHŠNYYYYYANDSSHANҠUA̠ HŠSUPPDM. ANGSUN: AUNԠYYYYYA0MANSA SBHBNDA<0(N'SMPMNԩ MANSDMA DƠADDSSƠؠ(5DMSSAGũ DƠUPPҠMԠƠSPN UN(AAYSP+3ANנBUND. HBNDNP SABGSAVŠDMA̠AG SSASKPƠA̠US NASŠMAKŠD.SԠ'SMPMN SAMPؠSAVŠDAUԠVAU DBHBNDɠGԠHŠMSSAGŠADDSSAND SBMP̠SԠUPϠMV DAN5VŠDS SAҠϠMHŠMSSAG: DBDMS"HANGŠؠYYYYY" HNؠDAMP̬ɠMV SABɠ5 NBDS SZMP̠ SZҠH MPHNؠMSSAG SZHBNDNDؠϠHŠUPPҠM SBMP̠SAVŠHŠADDSSҠYNAS HVҠDBMP̠Ơ DAMPؠNVԠHŠNUMB SBNVDϠHŠBU SBSPAŠSNDASPA DBDMSGԠHŠADDSS DAP6ANDSNDMSSAG SBDKYɠ"ؠYYYYY"ϠHŠY DA"?"PUԠA"?"AҠHŠ SAMűSSԠ DAP9SNDMSSAGŠANDG DBADMSSPNŠ SBAD"HANGŠ?" DAP5NVԠSPN DBBGADAG SSBDMA̠US?? MANAYSASKGàҠDMA SBGàGԠBNAYUVAN MPBҠҠ-PA SBGA̠NDƠBU? SZASS MPHKYSK- BҠDAұSNDҠ SB MPHVҠANDPA HKDANϠGԠVAU SZASSƠZϠUS DAMPؠSUPPDVAU DBMPؠGԠ-ABSVAU SSBSSƠUPPҠM. MBNB SSAGԠABSVAUŠ MANAUNԠ. ADBAƠMԠSSHAN SSBUNԠHN MPBҠ DBHBNDɠGԠUPPҠBUND DBBɠϠB MBƠGAҠHAN ADBAMA SSBSSHN MPBҠ SZHBNDSŠ MPHBNDɠUNVAUŠNA SPà BGBSSDMA̯A̠AG MPؠNP MP̠NP DMSDƠ. ADMSDƠ+ ASàHANG .ؠBSS5 MűSNP BSS3 "?"ASà? SPà ASUԠSADҠA̠YUPU ԠSNDSHŠUSԠϠHŠYSԠDVŠAND ƠBԠƠHŠSHGSҠS SSԠԠASϠSNDSԠϠHŠPUNH. ASUԠNPNYPN DSԠASASAVŠHŠPAMS AƠBԠ6S ANDP6HNPNԠNY DBDNS SZA PBASU SSSKPƠϠBŠPND MPNSԠSŠGϠSԠҠPUNH DDASAGԠHŠPNԠPAMS SBSDɠSNDϠHŠSԠDV NSԠAGԠHŠSHGS ANDP6MASKBԠ SZASSƠNԠS MPASUԬɠ DDASAGԠHŠPAMS SBDHSPɠSNDUSԠϠHŠPUNH MPASUԬɠUN DNDƠNADDSSҠUNM ASABSSGSҠSAV ASBBSSAA ASNSHŠNPUԠUN.ԠADSMHŠY UNSSSHGSҠBԠ5SNANDҠ0NHH ASŠԠADSMHŠPHϠAD. ԠHNHSHŠADNHŠSԠDVŠƠSH3SN ANDNHŠPUNHƠSHSN. ASNNPNYPN SBASBSAVŠBUҠADDSS BGԠHŠSHGS BƬBƠAŠB BƬBҠ6ϠS SB~ƠS MPASPҠGϠDϠPҠNPU ASYDBASBS SBYNɠGԠDMHŠY ASSBAҠHŠ SBҠAG SZASSƠZϠNGH MPASNɠDϠNԠH SAASASԠHŠUN AGԠHŠSHG. ANDPMASKϠBԠ3 SZASSS? MPASPUNϠYHŠPUNH DDASAGԠHŠPAMS SBSDɠSNDϠHŠSԠDV ASPUDAASASԠANASŠŠ BGԠHŠS. BҬB BҬBҠHKҠHϠNPUNH SBSS? MPASNɠNϠUN DBASBYSGԠHŠADDSS SBDHSPɠSNDϠPUNH DAASASŠA MPASNɠANDUN ASPҠDBҠƠҠAGS SZBHN MPASYGϠDϠYNPUԠANYAY DBASBGԠHŠBUҠADDSS SBDPҬɠGϠϠHŠPHϠAD MPASSGϠSԠҠH MS5ASà5BGMMN N BGNNN-DMSDŠ MS5ASà5BADDS MS53ASà5GMMN MS5ASà5GSADD MS55ASà5GDSàADD MS56ASà5BGBUNDY MS5ASà5BGSADD MS59ASà5BGDSàADD MS60ASà5SYSAVMM NDNN-DMSDŠ Z BGNDMSDŠ MS53ASà5ԠMMN MS60ASà5נSPG MS6ASà5SԠDSKPG NDDMSDŠ Z BGNDMSDŠ SPà ŠHAԠMSSAGŠANDSPA SPà HԷNP SBSPA DBHM. DAHM SBDKYɠSNDMSSAG DAN0 SAHN HPSBSPAŠPUԠUԠNBANKNS SZHN MPHP HԠBHAԠҠSҠHANGS MPHԷ SPà HNBSS HM.DƠ+ ASà5HAԠ-SԠSҠPSSUN HM̠UP9 NDDMSDŠ N BGNNN-DMSDŠ HԷNP HԠB MPHԷ NDNN-DMSDŠ AҠBUҠHA̠ZS HŠBU̠SUBUNŠASA6-DBUҠHZS. ANGSUN: AGND BADDSSƠBU SBBU UN:NNSƠAANDBAŠDSYD. BU̠NP DAN6 SADNԠSԠBUҠNGH6 A SABɠAҠBUҠD NB SZDNԠA̠DSA? MP-3NϠ-NNUŠANG MPBU̬ɠUN SKP NנNŠ(ҬƩNY HŠSPAŠSUBUNŠSUSDϠSPAŠUPHŠPN. ANGSUN: AGND BGND SBSPA UN:NNSƠAANDBAŠDSYD. SPAŠNP DBDBNKGԠADDSSƠABANK ANASԠHAAҠUNԠN SBDKYɠUPUԠҬƠNY MPSPAŬɠUN SPà3 SPà PN:Ҡ HŠҠSUBUNŠSUSDϠPNԠHŠDAGNSS ҠA̠ҠMSSAGS. ANGSUN: A-DGԠASɠҠD BGND SB UN:NNSƠAANDBAŠDSYD. ҠNPPNԠҠMSSAGS SAAM+3SԠҠDŠNϠMSSAG DAP6 DBAMҠAMҠMSSAGŠADDSS SBDKYɠPNԠҠMSSAG NMPҬɠUN VABŠҠ ҠNP SBҠPNԠҠMSSAG H0HԠ0BAԠ-PGAMANNԠNNU MP-VABŠ AMҠDƠ+ ASà3ҠҠMSSAGŠҠ+D Z BGNDMSDŠ j AGN-PNԠUNԠBUNDAYHNASKUS ƠHŠANSϠAGNAԠAPAGŠBUNDAY MƠMSSAG:). THIS REQUEST HAS THE * SPECIAL FORMAT: * * (EQ T7,I) 'CONTAINS A POINTER TO A GROUP OF * 3 OR 4 WORDS CONTAINING THE BUFFER ADDRESS(WORD 1), * LENGTH(WORD 2) AND TRACK/SECTOR(WORD 3 OR IF SIGN * BIT IS SET ON WORD 3 THEN IT IS THE SECTOR (THE SIGN * IS STRIPED) AND E'WORD FOUR IS THE TRACK) ADDRESS FOR * EACH TRANSFER. THE GROUP OF TRANSFER VECTORS IS * OPEN-ENDED AND IS TERMINATED BY A ZERO-WORD. * ALL TRANSFERS ARE MADE BEFORE A COMPLETION * RETURN TO IS MADE. * * ******** WARNING ***************************************************** * * THIS DRIVER WILL CORRECTLY HANDLE MULTI-CPU, MULTI-DRIVE CONDITIONS * ONLY WITH THE LATEST FIRMWARE IN THE DISC CONTROLLER. IT WILL ALSO * HANDLE MULTI-DRIVE CONDITIONS WITH OLD FIRMWARE IN THE CONTROLLER. * HOWEVER, IF USED WITH OLD FIRMWARE IN A MULTI-CPU ENVIROMENT IT WILL * LIKELY PUT THE SYSTEM INTO A TIGHT INTERRUPT DRIVEN LOOP. * * THIS IS INTENDED AS THERE IS NO CORRECT ANSWER TO THE PROBLEM WITH OLD * FIRMWARE. THE TIGHT LOOP WILL OCCUR ON FIRST CONTENTION FOR THE LOCK * REQUEST AND WILL "HEAL" ON REMOVAL OF THE CONTENTION (OTHER CPU * UNLOCKS), SOLUTION: * GET NEW FIRMWARE!!! * ************************************************************************* SKP RWSUB NOP READ/WRITE ROUTINE ENTRY * E = 0 WRITE * E = 1 READ * * B = BUFFER ADDRESS * A = -LENGTH IN WORDS SPC 3 STB UBUF SAVE BUFFER ADDRESS. STA LN.N SAVE LENGTH LDB TRACK GET THE TRACK AND BLF COMBINE WITH ADB UNIT THE UNIT CPB LTRK SAME AS IN LOCAL BUFFER? LDB BM10 YES; B_-8. LDA HDSC CHECK THE HEAD/SECT CPA LHDSC SAME AS IN LOCAL BUFFER? INB YES; B_B+1 LDA LN.N UNDER 129 WORDS SEZ,RSS IF WRITE JMP WRT1 GO DO WRITE TESTS * ADA D128 REQUESTED? CPB BM7 ALL CONDITIONS MET? SSA MET? JMP RD2 NO; GO READ * LDA LBUFA YES; SET FOR MOVE CPA UBUF IF DATA IS WANTED IN LOCAL JMP CLE BUFFER CLE AND RET;URN * STA LBUFP SET UP FOR LDA LN.N MOVE LDB UBUF JSB MOVE AND MOVE DATA CLE CLE SET E FOR CONTINUATION JMP RWSUB,I RETURN B40 EQU CLE SPC 3 RD2 LDB UBUF READ; TO LOCAL CPB LBUFA BUFFER? STB LTRK SHOW LOCAL SECTOR BUFFER ENPTY WRT1 SSB,RSS IF SAME TRACK JMP WRIT DIFFERENT TRACK SKIP * ADA D128 AND REQUEST TO WRITE MORE THAN 128 CLE,SSA,RSS WORDS OR CPB BM7 TO WRITE ON LOCAL SECTOR STB LTRK YES; SET TO SHOW NONE IN WRIT JSB SEEK SEEK RECORD LDA DMAC GET THE DMA CONTROL WORD OTAD OTA 6 SEND TO THE DMA LDA RDCM GET THE READ COMMAND SEZ,CME,RSS READ? LDA WRCM NO - USE WRITE COMMAND STA SEEK SAVE THE COMMAND LDA UBUF GET BUFFER ADDRESS SEZ,RSS ADA MSIGN AND SET DIRECTION BIT CLCD2 CLC 2 SET FOR BUFFER OTAD2 OTA 2 SEND BUFFER ADDRESS LDA LN.N GET LENGTH STCD2 STC 2 SET FOR LENGTH OTAD3 OTA 2 SEND IT. CON LDA SEEK GET THE COMMAND JSB OUTCC AND SEND IT STCDC STC 6,C START DMA CLCD CLC 6 INHIBIT DMA INTERRUPT JSB WAITS GO WAIT FOR INTERRUPT STFD STF 6 FOURCE DMA COMPLETION LIAD2 LIA 2 GET RESIDUE FOR CORRECTION ALG. JSB STATS DO STATUS JMP WRIT ERROR; RETRY * JMP CON CONTINUE THE XFER AFTER CORRECTION * LDA UBUF WAS XFER TO LOCAL BUFFER CPA LBUFA ? RSS JMP RWSUB,I NO; RETURN * LDA TRACK UPDATE THE ALF ADA UNIT STA LTRK LOCAL BUFFER LDA HDSC GET THE CURRENT HEAD /SECTOR STA LHDSC SET HD/SECT WORD JMP RWSUB,I RETURN * TRACK NOP DMAC NOP DMA CONTROL WORD (SELECT CODE ONLY) HDSC NOP LTRK OCT -1 LHDSC NOP LN.N NOP UBUF NOP RDCM ABS REdoADC READ COMMAND WRCM ABS WRITC WRITE COMMAND D128 DEC 128 BM7 OCT -7 SKP SPC 3 SEEK NOP SEEK ROUTINE * 1. SEEK RECORD WHOSE TRACK IS * IN TRACK, UNIT HDSC * 2. DO ADDRESS RECORD * 3. SEND THE FILE MASK SK2 JSB SEAD SEND THE SEEK COMMAND AND DATA ABS SEEKC+HOLD JSB WAITI WAIT FOR ATTENTION SK1 RAR,RAR MOVE SEEK CHECK BIT RAR,SLA,RAL TO LEAST A AND SKIP IF OK SLA IF NOT READY OR NO SEEK CHECK JMP SK3 CONTINUE THE PROCESS (GET NOT READY LATER) * JMP SK2 GO REISSUE THIS SEEK * SK3 JSB SEAD SEND ADDRESS RECORD ABS ADREC LDA FILM GET THE FILE MASK XOR UNIT CHEAT OUTC JSB OUTC AND SEND THE IT JMP SEEK,I RETURN * FILM OCT 7404 FILE MASK SPARING ONLY * * * SEAD NOP * SEAD SEND THE SEEK/ADDRESS RECORD * COMMANDS TO THE CONTROLLER * CALLING SEQUENCE: * * JSB SEAD * OCT COMMAND EITHER SEEK OR ADDRESS RECORD * * ASSUMES CYL = CYLINDER ADDRESS * HDSC= HEAD AND SECTOR * UNIT= UNIT ADDRESS * SEK2 LDA SEAD,I GET THE COMMAND JSB OUTC SEND IT TO THE CONTROLLER SFC1 SFC DC ACCEPTED? JMP SKOK YES CONTINUE * JMP NRERR ELSE TAKE NOT READY EXIT * * SKOK LDA TRACK GET THE CYLINDER ADDRESS OTA1 OTA DC,C AND SEND IT ISZ SEAD STEP TO RETURN ADDRESS JSB WAFLG WAIT FOR FLAG JMP NRERR IF NONE THEN NOT READY LDA HDSC NOW THE HEAD/SECTOR OTA2 OTA DC,C SEND IT JMP SEAD,I RETURN * B27 OCT 27 * * * OUTC SEND COMMAND TO THE CONTROLLER AND * WAIT FOR ACCEPTANCE * OUTC NOP JSB OUTCC SEND THE C{OMMAND JSB WFLS WAIT FOR THE FLAG JMP OUTC,I RETURN * * OUTCC SEND COMMAND TO INTERFACE DO NOT WAIT FOR FLAG. * OUTCC NOP CLC1 CLC DC SET 'HERE-COME-DE-WORD' XOR UNIT ADD/SUBTRACT THE UNIT OTA3 OTA DC,C SEND THE WORD JMP OUTCC,I RETURN * * * INWD WAITS FOR A FLAG AND THEN INPUTS ONE WORD TO A. * INWD NOP JSB WAFLG WAIT FOR THE FLAG JMP NRERR IF NO RESPONCE TAKE NOT READY EXIT * LIA1 LIA DC,C GET THE WORD JMP INWD,I RETURN * * * WAITI WAIT FOR INTERRUPT AND ANNALIZE REASON FOR INTERRUPT * IF NO STATUS BIT SET EXIT TO CALLER * ELSE DO STATUS AND: * 1. IF UNIT 10 GO TO HOL10 (TO COMPLETE HOLD) * 2. IF CURRENT UNIT RESTORE E AND RETURN * 3. IF NOT CURRENT UNIT IGNOR THE INTERRUPT AND * POSSIBLY CALL SYSTEM UP PROCESSOR * * WAITI DEF IGNOR INTERRUPT BEFORE EXPECTED IGNOR ELB SAVE THE E REG STB MOVE IN MOVE ENTRY POINT CLA CLEAR THE RETURN ADDRESS STA RTNCD SWITCH IGNO2 ISZ C.XX TAKE CONTINUATION INTERRUPT STC1 STC DC SET FOR INTERRUPT JMP C.XX,I RETURN * C.XX NOP INTERRUPT RETURNS TO HERE ISZ STACT IF TO IGNOR STATUS RSS THEN JMP WAIER JUST GO RETURN * JSB STATW THIS CALL ASSUMES WE HAVE CONTROLLER CPB D10 UNIT 10 WAKE UP? JMP HOL10 YES GO PROCESS IT * CPB UNIT THIS THE CURRENT UNIT? RSS YES SKIP JMP IGNOR NO GO PROCESS ATTENTION INTERRUPT * WAIER LDB MOVE RESTORE ERB THE E REG. JMP WAITI,I AND RETURN * * THIS WILL PUT A SYSTEM WITH * THE OLD CONTROLLER INTO A TIGHT LOOP- * USE NEW FIRMWARE WITH MULT-CPU * HOL10 LDA S1CD IF NOT SUCCESSFUL CPA B27 THEN JMP LOKEX GO EXIT * LDA EQT1t!3,I ELSE JSB $CGRN CLEAR THE RN CLA AND THE STA EQT13,I LOCK 10 FLAG LOKEX LDB D10 * IGNOR CLA MUST BE ATTENTION STA EQT15,I OF SOME KIND CPB D10 IF UNIT 10 JMP WAK SKIP THE CORE SECTOR CLEAR * LDB WAITI IF WE DO NOT EXPECT AN CPB DIGNO INTERRUPT STB LTRK CLEAR IN CORE FLAGS. WAK JSB WAKEN SET UP WAKE UP OR END LDA EQT# GO TO SYSTEM LDB I.XX $IOUP IF SZB WE DID A JMP IGNO2 NOT READY * STC2 STC DC SET CONTROL FIRST JMP $UPIO NOW GO UP THE DEVICE * * * WAITS DOES WAITI WITHOUT STATUS * WAITS NOP CCA SET THE NO STATUS STA STACT FLAG JSB WAITI WAIT FOR THE INTERRUPT JMP WAITS,I RETURN * * RTNCD OCT 4 STACT NOP D10 DEC 10 HLD10 ABS RECAC+HOLD+10 USE RECALABRATE COMMAND TO HOLD UNIT NOP * * * * * * WAKEN CALLED BEFORE ANY EXIT FOR COMPLETION OR * AFTER AND UNEXPECTED INTERRUPT * * WAKEN NOP STB XOR SAVE B LDA ENDC PRESET TO SEND THE END COMMAND LDB WAITI IF WAITING FOR CPB DSK1 A SEEK TO COMPLETE JMP WAKX JUST END * LDB EQT13,I GET THE WAKE UP FLAG SZB IF NOT WAITING FOR 10 LDA HLD10 SKIP ELSE LOAD WAKE 10 COMMAND XOR UNIT FOOL OUTC WAKX JSB OUTCC SEND THE COMMAND LDB XOR RESTORE B JMP WAKEN,I RETURN * * ENDC ABS ENDCC DSK1 DEF SK1 DIGNO DEF IGNOR RETURN FOR IGNOR INTERRUPT * STATUS CHECK SECTION * STATUS MAY REQUIRE AND INTERRUPT IF CONTROLLER * IS NOT CONNECTED TO THIS CPU. * THE ERROR COUNTER IS RESET FOR EACH CORRECT * STATUS. * THE STATUS WORD IN THE EQT IS SET AS FOLLOWS * 0 - ANY ERROR * 1 - DRIVE BUSYֈ (HEADS NOT OVER A TRACK) * 2 - DRIVE NOT READY (HEADS NOT LOADED => 1 ALSO) * 3 - SEEK CHECK (BAD ADDRESS-USUALLY WIPES SYSTEM) * 4 - FIRST STATUS * 5 - DRIVE FAULT * 6 - FORMAT SWITCH IS ON * 7 - PROTECT SWITCH IS ON * * * A WRITE TO A PROTECTED CYLINDER WILL * FOURCE A PARITY ERROR RETURN * UNLESS THE FORMAT SWITCH IS ON, IN WHICH * CASE THE WRITE IS RETRIED WITH A WRITE * INITIALIZE. * NOT READY WILL FOURCE A NOT READY RETURN * * * STATS NOP * * STATS CALLING SEQUENCE: * * LIA DMAWC/CLA,INA SET DMA RESIDUE IF DMA XFER ELSE 1 * JSB STATS * JMP RETRY RETRY THE TRANSFER (E= NOT E) * JMP CONT CONTINUE THE TRANSFER (E=E) * OK EXIT (E=E) * * THE FOLLOWING ACTIONS ARE TAKEN ON THE STATUS-1 WORD: * * STATS PROBLEM ACTION * * 00 NO ERROR OK - IF DMA RESIDUE = 0 EXIT ELSE RETRY * 07 CLY. COMP. ERR RECALIBRATE - RETRY EXIT * 10 DATA ERROR RETRY EXIT (UP TO 10 TIMES) * 11 HEAD/SECT COMP. RECALIBRATE - RETRY EXIT * 16 OVERRUN RETRY EXIT (UP TO 10 TIMES) * 17 CORR. DATA ERR TRY TO CORRECT THEN: * 1. IF FAIL RETRY EXIT (UP TO 10 TIMES) * 2. IF SUCCESS AND DMA RESIDUE = 0 * TAKE OK EXIT, ELSE IF RESIDUE = 1 * UPDATE VERIFY COUNTERS AND TAKE * CONTINUE EXIT, IF RESIDUE # 0 OR 1 * CONTINUE EXIT. * 20 ILLEGAL TRACK PARITY ERROR ABORT * 22 NOT READY RETRY EXIT * 23 STATUS-2 IF PROTECT THEN PARITY ERROR ABORT * ELSE NOT READY ABORT * 26 WRITE PROTECT IF FORMATSy SWITCH ON RESET COMMAND * TO INITIALIZE WITH SPD BITS AND * TAKE CONTINUE EXIT, ELSE PARITY * ERROR ABORT * -- ALL OTHERS NOT READY ABORT * * STA WAKEN SAVE THE DMA RESIDUE JSB STATW DO THE STATUS REQUEST LDB S1CD GET THE STATUS-1 CODE SZB,RSS IF NO ERROR JMP OKEX THEN JUST EXIT * CPB B20 ILLEGAL TRACK? JMP PARER GO GIVE PARITY ERROR * CPB B26 WRITE PROTECT? JMP PARER GO CHECK THE SWITCH * CPB B23 STATUS-2 ERROR? JMP NR? GO CHECK FOR NOT READY * CPB B16 RETRY OVER RUNS JMP REXIT FOR EVER * ISZ ERCTR STEP ERROR COUNT RSS STILL OK SO CONTINUE JMP PARER TOO MANY ERROR - ABORT * CPB B7 FOR CYL. ERROR RSS * CPB B11 AND HEAD/SECT. COMP JMP RECAL TRY RECALABRATE * CPB B17 LAST CHANCE RSS POSSIBLY CORRECTABLE ERROR * JMP REXIT NONE OF THE ABOVE TRY IT AGAIN * * POSSIBLY CORRECTABLE DATA ERROR. GET SYNDROME FROM CONTROLER * AND GIVE IT A TRY. * LDA RQSYN SEND THE COMMAND JSB OUTCC TO THE CONTROLLER JSB WAITS WAIT FOR INTERRUPT - NO STATUS LIA2 LIA DC,C GET UPDATED STATUS ALF,ALF AND STA SU SAVE IT JSB INWD BURN THE CYL. ADDRESS JSB INWD GET THE SECTOR STA WAITS SAVE IT JSB INWD GET THE DISPLACEMENT STA STATW AND SAVE JSB INWD NOW GET STA PAT1 AND JSB INWD SAVE STA PAT2 THE JSB INWD THREE STA PAT3 CORRECTION WORDS LDA SU GET THE UPDATED STATUS SLA,RSS IF NOT CORRECTABLE JMP REXIT TAKE RETRY EXIT * * CORRECTION ROUTINE USES THE FOLLOWING: * UBUFՇ = BUFFER ADDRESS * -LN.N = ORIGIONAL TRANSFER WORD COUNT * WAITI = REMAINING WORD COUNT * * IF WAITI = 1 THEN ENTRY IS FROM VERIFY SO CORRECTION IS * NOT NEEDED. * LDB WAKEN GET THE DMA RESIDUE CPB B1 IF ONE JMP CKCNT GO SET UP TO CONTINUE VERIFY * LDA LN.N GET ORGIONAL LENGTH CMA,INA TO A SZB,RSS IF END OF TRANSFER JMP ZRORS DO SPECIAL * * * COMPUTE LOWER AND UPPER LIMITS IN BUFFER FOR FIXUP. * ADB DMABT RESTORE THE MISSING RESIDUE BITS ADA B GET UPPER LIMIT STA B SAVE IT LIMST ADA DM128 NOW LOWE LIMIT ADA UBUF ADD IN THE BUFFER ADDRESS ADB UBUF AND STA S1 SET THE LOW STB SU AND HIGH LIMITS ADA STATW ADD THE RETURNED DISPLACEMENT LDB A SET CORRECTION ADDRESS IN B JSB XOR CORRECT PAT1 NOP THE JSB XOR DATA PAT2 NOP IN THE JSB XOR BUFFER PAT3 NOP * DONE? LDA WAKEN IF TRANSMISSION COMPLETE SZA,RSS THEN JMP OKEX TAKE OK EXIT * JMP CONEX ELSE TAKE CONTINUE EXIT * * ZRORS LDB A RESIDUE IS ZERO ADA B177 B GET UPPER LIMIT OFFSET AND DM128 ROUND A UP TO NEXT 128 WD. JMP LIMST CONTINUE CORRECTION. * * CKCNT LDA HDSC VERIFY IN PROGESS CMA,INA GET THE ORGIONAL HEAD ADDRESS ADA WAITS AND COMPUTE THE NUMBER CHECKED AND B377 INA STA HDSC SET THE NEW ORG. CMA,INA SUBTRACT ADA TVCNT FROM VERIFY COUNT JMP DONE? AND GO TEST IF DONE. * * RECAL LDA RECLC RECALABRATE JSB OUTCC THE DISC JSB WAITI WAIT FOR ATT. REXIT CME SET E TO NOT E FOR RETRY JMP STATS,I TAKE RETRY EXIT * RECLC ABS RECAC+HOLD * NR? ALF,ALF IF PROTECTED SEZ,SSA IF SWITCH OFF AND WRITE * JMP PARER TAKE PARITY ERROR EXIT * JMP NRERR ELSE TAKE NOT READY EXIT * * OKEX LDA WAKEN IF DMA DISAGREES SSA JMP REXIT RETRY THE TRANSFER * LDB BM12 RESET THE ERROR STB ERCTR ON OK EXITS ISZ STATS STEP RETURN ADDRESS CONEX ISZ STATS LDB MOVE RESTORE ERB THE E REG. JMP STATS,I RETURN * * B1 OCT 1 B11 OCT 11 B16 OCT 16 B17 OCT 17 B20 OCT 20 B22 OCT 22 B23 OCT 23 B26 OCT 26 B160K OCT 160000 DMABT NOP HIGH DMA WORD COUNT BITS NOT RETURNED RQSYN ABS RQSYC TVCNT NOP INIAC ABS INITC * * XOR THIS ROUTINE DOES THE CORRECTION FOR CORRECTABLE * DATA ERRORS. * * CALLING SEQUENCE: * * SET S1 TO THE LOWER LIMIT * SU TO THE UPPER LIMIT * B TO THE BUFFER ADDRESS * JSB XOR * OCT PATTERN * RETURN B_B+1 * * THE PATTERN WILL BE XORED WITH THE WORD AT AND RESTORED TO * B,I IF AND ONLY IF S1<= B < SU. B IS ALWAYS INCREMENTED. * XOR NOP LDA S1 GET LOWER LIMIT CMA,CLE,INA WATCH 'E' IT DOES ALL THE WORK ADA B SET 'E' IF S1<= B. LDA B NOW TEST UPPER LIMIT CMA,SEZ,CLE = IS BAD / SKIP IF LOW FAILED ADA SU SET 'E' IF B< SU SEZ,RSS IF OUSIDE LIMITS JMP EXXOR GO BUMP B AND EXIT * LDA B,I FIX THE DATA XOR XOR,I AND STA B,I RESTORE IT EXXOR INB STEP ADDRESS ISZ XOR STEP RETURN ADDRESS JMP XOR,I AND RETURN * * STATW NOP CORE STATUS ROUTINE GETS THE STATUS ONLY * LEAVES STATUS IN: * S1 STATUS WORD ONE * SU AND B STATUS UNIT RETURNED * S1CD ERROR CODE FROM S1 IN LOW PART * EQT5 AND A STATUS 2 ROTATED 1 BIT * LEFT LOW 8 BITS ONLY * CCA SET THE STATUS COMMAND IN PROGESS STA STACT FLAG TO PREVENT WAITI PROBLEMS LDA STC GET THE STATUS COMMAND JSB OUTCC SEND THE COMMAND (MUST NOT USE OUTC JSB WAFLG OR WFLS HERE SINCE THEY MAY JSB WAITI BE WAITING. LIA3 LIA DC,C GET THE FIRST STATUS WORD STA S1 SAVE IT AND B377 GET UNIT STA SU SAVE IT XOR S1 GET BACK HIGH PART ALF,ALF ROTATE TO LOW A AND B37 KEEP THE STATUS STA S1CD JSB INWD GET STATUS-2 WORD RAL ROTATE XOR EQT5,I PUT IN LOW EQT5 AND B377 UNDER THE RULES XOR EQT5,I OF WOO LDB S1 IF PROTECTED RBL SET SSB BIT IOR B20 4 STA EQT5,I LDB SU GET THE UNIT BACK TO B STB STACT CLEAR THE STATUS IN PROGESS FLAG JMP STATW,I AND RETURN * STC ABS STATC SU NOP S1 NOP S1CD NOP B37 OCT 37 * * * WAFLG WAITS FOR A FLAG FOR A TIME AND THEN RETURNS * P+1 IF NO FLAG IN TIME * P+2 IF A FLAG MADE IT IN TIME * WAFLG NOP LDB WCOUN PICK A TIME SFS1 SFS DC FLAG HERE YET? JMP WAFTB NO GO TEST TIMER * ISZ WAFLG YES STEP RETURN TO P+2 JMP WAFLG,I AND DO IT * WAFTB ISZ B TIME HERE YET? (ISZ FOR TO SAVE E REG.) JMP SFS1 NO TRY THE FLAG AGAIN * JMP WAFLG,I YES TAKE P+1 EXIT * * * WFLS WAIT FOR FLAG, IF NONE WAIT FOR INTERRUPT * * WFLS NOP JSB WAFLG FLAG WITHOUT INTERRUPT? JSB WAITS NO WAIT FOR INTERRUPT JMP WFLS,I RETURN * B377 OCT 377 BM12 OCT -12 WCOUN DEC -35 ERCTR OCT -12 EQT# DEC 1 SET ON FIRST ENTRY SPC 2 NRERR CLA,INA NOT READY -SET A=1 -POST INTERRUPT *CLB SET BEEN HERE FLAG STB I.XX LDB RTNCD GET THE RETURN CODE SZB,RSS IF ZERO DO COMPLETION EXIT JMP COMEX GO DO COMPLETION EXIT * * * ISZ C.XX BUMP TO PROPER RETURN ADDRESS PARER LDA B3 A_3 ERROR RETURN COMEX LDB EQT9,I COMPLETION RETURN STA RTNCD B = TRACK OR TLOG. JMP NRRTN GO TAKE CENTRAL EXIT * * B140. OCT 101400 B3 OCT 3 LBUFA DEF BUF BUFA EQU LBUFA * * MOVE NOP MOVE SUBROUTINE * ENTER WITH A = -COUNT * B = DESTINATION/SOURCE * E = 1 FROM LOCAL BUF * E = 0 TO LOCAL BUF * LBUFP = LOCAL BUFFER ADD * FOR THIS MOVE CMA,INA SET COUNT POSITIVE STA COUNT SET COUNTER LDA LBUFP GET LOCAL BUFFER ADDRESS SEZ,RSS IF TO LOCAL BUFFER SWP SWAP THE ADDRESSES. JSB .MVW DO WORD MOVE DEF COUNT NOP * JMP MOVE,I NO; RETURN. SPC 2 COUNT NOP LBUFP NOP SKP * THE TRIPLET PROCESSOR TAKE SYSTEM OR USER * GENERATED TRIPLETS AND TRANSLATES THEM * INTO READ, WRITE, AND MOVE REQUESTS * * CALLING SEQUENCE: * * EQT8 NEG REQUEST LENGTH IN WORDS * EQT9 SYSTEM TRACK NUMBER (NOT ACTUAL) * EQT10 SYSTEM SECTOR NUMBER (NOT ACTUAL) * EQT11 REQUEST BUFFER ADDRESS. (SIGN BIT SET FOR READ) * * * $TB32 IS USED TO TRANSLATE THE TRACK TO * AN ACTUAL UNIT AND CYLINDER AND HEAD NUMBER. * THE FORMAT IS A SET OF TRIPLETS AS FOLLOWS: * * WORD 1: CYLINDER NUMBER OF FIRST TRACK * WORD 2: BITS 12-15 NO. OF SURFACES/ CYLINDER * BITS 8-11 HEAD NO. OF TRACK 0. * BITS 0- 3 UNIT NUMBER OF DISC * WORD 3: NUMBER OF TRACKS ON THIS SUBCHANNEL. * * THE WORD AT TB32A WILL BE THE NEGATIVE OF THE NUMBER OF * THE ABOVE TRIPLETS WHICH WILL START AT TB32A+1,I. * * CONSTANTS FOR TIPLT * BM10 OCT -10 TB32A DEF TBXX MXSIZ NOP MAX NO OF WORDS PER TRACK SPC 4 TIPLT DLD EQT9,I GET TRACK AND SECTOR ADDRESS SSA,RSS IF EITHER IS NEGATIVE SSB THEN JMP REJCT GO REJECT THE CALL * CLA CLEAR A TO AVOID OVERFLOW ASL 6 SECTOR * 64 CMB,INB MAKE IT NEGATIVE ADB EQT8,I ADD THE NO OF WORDS IN XFER ADB MXSIZ SUBTRACT FROM MAX WORD COUNT SOS REJECT IF OVERFLOW SET DUE TO SECTOR TO BIG SSB TRAK WRAP AROUND? JMP REJCT YES GO REJECT THE REQUEST * LDA BM12 SET ERROR COUNTER STA TPER FOR 10 TRIES LDA SUBCH GET THE SUBCHANNEL ADA TB32A ADD THE TABLE ADDRESS INA STEP ONE FOR THE COUNTER LDB A,I GET THE FIRST CYL. TO B STB TRACK SAVE IT INA STEP TO THE NEXT WORDS STA COUNT SAVE THE ADDRESS DLD A,I GET THE WORDS MSIGN EQU *-1 AND B377 ISOLATE THE UNIT STA UNIT AND SET IT LDA B SET IN B FOR POSSIBLE REJECT CMA,INA NEGATE THE NUMBER ADA EQT9,I ADD THE ADDRESSED TRACK NUMBER SSA IF POSITIVE THEN ERROR JMP CLC2 NEGATIVE SO OK - CONTINUE * LDA EQT5,I SET THE IOR B40 END OF TAPE BIT IN THE STATUS STA EQT5,I EQT STATUS WORD JMP NRRTN EXIT ERROR * TFLG JSB WFLS WAIT FOR THE FLAG CLC2 CLC DC IF CONTROLLER IS DOING SFC2 SFC DC SOMETHING FOR US JMP TFLG ALREADY GO TEST FOR A FLAG * JSB STATW THROW AWAY FIRST STATS(CONTROLLER BUG) JSB STATW GET STATUS AND RAR,RAR IFd NOT SLA READY JMP NRERR TAKE NOT READY EXIT * LDA COUNT,I GET THE HEAD/ UNIT WORD ALF # HEADS TO LOW A AND B17 ISOLATE STA WAITS SAVE LDA EQT9,I GET THE TRACK NUMBER CLB SET TO DIVIDE DIV WAITS A = CYL OFFSET / B= HD OFFSET ADA TRACK A= CYL. STA TRACK SAVE IT ASR 8 PUT HEAD IN ITS PLACE ADA COUNT,I ADD THE BASE HEAD AND B7400 ISOLATE THE HEAD LDB EQT10,I GET THE SECTOR CLE,ERB TAKE 1/2 OF IT ADA B COMBINE HEAD AND SECTOR TIPRT STA HDSC SAVE FOR ADDRESS STA CHDSC AND FOR CYCLICK CHECK. LDB EQT8,I BRING IN THE STB TPLN LENGTH LDB EQT11,I AND THE STB TPBUF BUFFER ADDRESS SPC 2 LDA TPLN PRESET A FOR EVEN SECTOR LDB EQT10,I GET SECTOR CCE,SLB,RSS IF EVEN JMP TPNXT JUMP * LDB BUFA ELSE READ LDA DM128 128 WORDS TO JSB RWSUB LOCAL BUFFER LDA HLBUF SET MOVE BUFFER STA LBUFP ADDRESS LDB TPLN GET LENGTH ADB B100 LESS 64 LDA TPLN USE MIN OF REQUEST CLE,SSB AND LDA BM100 6 4 LDB TPBUF GET ADDRESS ELB,RBR CLEAR SIGN & SET READ/WRITE JSB MOVE GO MOVE THE WORDS. LDA DM128 SET TO WRITE LDB BUFA THE SECTOR SEZ,RSS WRITE REQUEST? JSB RWSUB YES; WRITE IT OUT. LDA BM100 UP DATE POINTERS TPA CMA,INA TO REFLECT STA MOVE LAST TRANSFER ADA TPBUF ADJUST BUFFER ADDRESS STA TPBUF LDA MOVE ADA B100 ROUND UP THE COUNT CLB CLEAR B FOR SHIFT LSR 7 SHIFT TO GET SECTOR COUNT ADA HDSC ADD TO THE CURRENT SECTOR STA HDSC SAVE FOR NEXT ACCESS LDA TPLN $ GET THE LENGTH ADA MOVE SUBTRACT THE NUMBER XFERED CLE,SSA,RSS IF NONE LEFT CHECK JMP CYCK FOR CYCLIC CHECK * STA TPLN SAVE LENGTH TPNXT LDB TPBUF GET BUFFER ADDRESS CLE,SSB READ? JMP TPRD YES; GO TRANSFER REST OF RECORD * ADA B100 NO; MORE THAN 64 WORDS LEFT CCE,SSA,RSS ? JMP TPB NO; GO TRANSFER LAST WORDS * LDA TPLN YES; TEST FOR MORE THAN LESS THAN AND B100 64 WORDS MOD 128 LEFT STA B SAVE FLAG ADA TPLN GET LENGTH TO SET FOR X-FER CLE,SZB IF LESS THAN 64 MOD 128 LEFT AND DM128 DELETE EXCELL OVER EVEN SECTORS LDB TPBUF GET BUFFER ADDRESS TPRD ELB,RBR SET READ/WRITE FLAG JSB RWSUB DO THE TRANSFER. LDA LN.N GET THE LENGTH AND JMP TPA GO UP DATE THE POINTERS SPC 2 TPB LDA DM128 WRITE OF LAST 64 WORD IN LDB BUFA FIRST HALF OF SECTOR STB LBUFP SET UP JSB RWSUB AND READ THE SECTOR LDA TPLN SET UP TO LDB TPBUF MOVE THE USER WORDS JSB MOVE GO MOVE TO THE BUFFER LDA DM128 WRITE THE BUFFER OUT AGAIN. LDB BUFA AGAIN JSB RWSUB SPC 3 CYCK LDA EQT6,I REQUEST FOR CYCLIC AND B2002 CHECK CPA B2002 AND WRITE RSS YES SKIP JMP EOXF NO- RETURN * LDA CHDSC SET THE HEAD/SECTOR FOR STA HDSC SEEK JSB SEEK LDB EQT8,I CALCULATE THE CMB,INB NUMBER LDA EQT10,I OF B10 SLA SECTORS TRANSFERED ADB B100 START ODD - ADD 64 TO COUNT ADB B177 ROUND UP TO NEXT HIGHER SECTOR LSR 7 SECTOR COUNT TO B LDA B MOVE TO A CONV STA TVCNT SET COUNT LDA VERFC GET THE COMMAND AND JSB OUTC SEND IT LDA TVCNT NOW SEND THE OTA4 OTA DC,C THE COUNT JSB WAITS WAIT FOR IT CLA,CLE,INA SET DMA RESIDUE FOR VERIFY JSB STATS DO FULL STATUS JMP BADV BAD NEWS * JMP CONV CORRECTABLE SO CONTINUE * JMP EOXF O-K RETURN * * BADV LDA CHDSC SET THE HEAD/SECTOR ADDRESS IN A ISZ TPER STEP COUNTER JMP TIPRT TOO MANY? - NO TRY AGAIN * JMP PARER YES; TAKE PARITY ERROR EXIT. SPC 3 HLBUF DEF BUF+64 TPLN NOP TPBUF NOP TPER NOP CHDSC NOP SUBCH NOP B100 OCT 100 DM128 DEC -128 BM100 OCT -100 B7 OCT 7 B7400 OCT 7400 VERFC ABS VERC SPC 2 REJCT CLA,INA ILLEGAL CALL SO REJECT STC3 STC DC JMP I.XX,I IT SKP * INITIATOR ENTRY POINT I.XX NOP CLC4 JMP CONFI CONFI SETS THIS WORD TO CLC DC * LDA CHAN CONFIGURE THE DMA ADA STF FIRST A STF STA STFD ADA B500 NOW A OTA STA OTAD XOR B1100 NOW A STC ,C STA STCDC XOR B5000 NOW A CLC STA CLCD XOR B4 NOW A CLC TO LOW SELECT CODE STA CLCD2 XOR WRCM NOW A STC TO LOW STA STCD2 XOR B100 NOW A OTA TO LOW STA OTAD2 STA OTAD3 ADA BM100 NOW A LIA TO LOW STA LIAD2 CCA ADA I.XX SET RETURN STA C.XX ADDRESS LDA B4 SET THE RETURN CODE STA RTNCD LDA EQT4,I GET THE UNIT RRR 6 FROM THE EQT AND B37 MASK TO UNIT NUMBER STA B SAVE IN B ADA B TIMES ADA B THREE FOR TABLE INDEX ADB TB32A,I TEST FOR ILLEGAL SSB,RSS NEGATIVE OK JMP REJCT ELSE REJECT THE REQUEST * STA SUBCH SET THE SUBCHANNEL * STA STACT CLEAR NO STATUS FLAG LDA EQT6,I IF CONTROL REQUEST AND B3 THEN CPA B3 GO WAIT FOR CONTROLLER JMP CLC3 * JMP OK  ELSE READ,WRITE * CLRBS JSB WFLS WAIT FOR FLAG CLC3 CLC DC CLEAR BUSY FLAG SFC3 SFC DC BY CYLING MEMORY JMP CLRBS IF STILL BUSY TRY AGAIN * * LDA EQT6,I GET AND ISOLATE CPA B3 UN LOCK REQUEST? JMP ULOCK YES GO DO IT. * CPA B1503 LOCK REQUEST? JMP LOCK YES GO DO IT * CPA B3I IF SYSTEM CLEAR RSS JMP NRRTN * LDA WAITI AND WAITING CPA DREXI FOR RECAL RSS CPA DSK1 OR SEEK RSS JMP NRRTN * JSB SEAD THEN SEEK ABS SEEKC WITHOUT HOLD TO CLEAR HOLD JMP NRRTN RETURN. SPC 1 OK LDA BM12 RESET STA ERCTR THE ERROR COUNTER LDA EQT6,I GET THE REQUEST CODE SYS2 LDB EQT7,I GET BUFFER ADDRESS SSA SYSTEM REQUEST? JMP SYS YES; GO DO SYSTEM THING. * LNTS LDA EQT6,I GET THE REQUEST CODE RAR,CLE,ELA SET RBL,ERB SIGN OF BUFFER ADDRESS TO SHOW DIRECTION STB EQT11,I AND SAVE FOR TIPLT CALL LDA EQT8,I GET THE LENGTH. STA EQT12,I SAVE FOR EXIT SSA,RSS MAKE NEGATIVE CMA,INA,RSS WORDS B1100 ARS AND STA EQT8,I SAVE B2002 SZA IF ZERO SKIP CALL JMP TIPLT CALL FOR X-FER * EOXF LDA EQT6,I GET REQUEST CODE SSA SYSTEM JMP SYS2 YES; GO GET NEXT TRIPLET * DONE LDB EQT12,I NO; DONE; GET TLOG CCE,SSB SET POSITIVE CMB,INB IF NEG. NRRTN LDA DIGNO RESET THE WAITI STA WAITI RETURN ADDRESS JSB WAKEN SEND ANY NEEDED WAKE UPS LDA RTNCD GET RETURN CODE (0 OR 4) CPA B4 IF 4 ISZ C.XX RETURN VIA C.XX+1 (SET -1 ABOVE) JMP STC1 ELSE C.XX SPC 2 SYS STB MOVE SYSTEM TRIPLET PROCESSOR INB STEP TO THE ADDRESS OF LDA B,I LENGTH AND STORE IԬT IN STA EQT8,I THE EQUIPMENT TABLE INB STEP TO THE DISC ADDRESS LDA B,I GET THE ADDRESS RAL,CLE,SLA,ERA IF FOUR WORD ENTRY INB,RSS STEP TO THE TRACK AND SKIP MASK AND B177 MASK THE SECTOR AND STA EQT10,I AND SET IT IN THE EQT XOR B,I GET THE TRACK ADDRESS ALF,ALF ROTATE TO LOW A RAL SEZ IF FOUR WORD ENTRY USE LDA B,I FULL FOURTH WORD FOR TRACK STA EQT9,I AND SET IN THE EQT INB STEP TO ADDRESS OF NEXT TRIPLET STB EQT7,I AND SET IT IN THE EQT LDB MOVE,I GET THE BUFFER ADDRESS SZB IF ZERO THEN DONE JMP LNTS GO DO THE TRANSFER. SPC 2 LDA RTNCD GET THE RETURN CODE SZA,RSS IF ZERO- JMP DONE GO RETURN * LDA UNIT GET THE XOR FILM SET FILE MASK COMMAND JSB OUTCC AND SEND IT JSB WAITS GO WAIT FOR A INTERRUPT JMP DONE EXIT SPC 2 LOCK LDA EQT7,I GET THE RN NUMBER STA EQT13,I AND SAVE IT JMP NRRTN AND RETURN * * ULOCK LDA CLR10 GET THE CLEAR UNIT XOR UNIT COMMAND JSB OUTC SEND IT CLA STA EQT13,I CLEAR THE RN NUMBER IN CASE WE STILL JMP NRRTN HAVE IT AND GO EXIT. SPC 2 CLR10 ABS RECAC+10 CLEAR WITH A RECALABRATE REQUEST B4 OCT 4 B177 OCT 177 B1503 OCT 1503 B5000 OCT 5000 B500 OCT 500 STF STF 0 DREXI DEF REXIT B3I DEF 3,I SKP BUF BSS 128 LN EQU * ORG BUF CONFI STA DMAC SAVE THE SELECT CODE IOR OTAC CONFIGURE STA OTA1 ALL STA OTA2 THE I/O STA OTA3 INSTRUCTIONS STA OTA4 XOR B11C STA STC1 STA STC2 STA STC3 XOR B0400 STA SFS1 XOR B1600 STA LIA1 STA LIA2 STA LIA3 XOR B1700 STA SFC1 STDA SFC2 STA SFC3 XOR B4500 STA CLC1 STA CLC2 STA CLC3 STA CLC4 LDA CHAN GET THE CURRENT DMA CHANNEL ADA LIA MAKE LIA DMA XOR B4 MAKE IT LOW DMA SELECT CODE STA LIADM SET IT ADA B100 NOW A OTA STA OTADM AND SET IT ADA B100 NOW A STC STA STCDM AND SET IT CCA SEND AN -1 TO DMA STCDM STC 2 PREPARE FOR WORD COUNT OTADM OTA 2 AND LIADM LIA 2 GET IT BACK CMA A NOW HAS THE MISSING BITS FOR DMA WORD STA DMABT COUNT RESIDUE SAVE IT CLB FIND LDA EQTA THE EQT CMA,INA NUMBER ADA EQT1 FOR THE UP REQUEST DIV .15 INA AND STA EQT# SET IT LDA TB32B GET THE ADDRESS OF THE TABLE ADDRESS LDA A,I GET THE ADDRESS RAL,CLE,SLA,ERA JMP *-2 STIL INDIRECT GO GET NEXT LEVEL LDB A,I GET THE FIRST WORD OF THE TABLE SSB,RSS IF < 0 THEN THIS IS THE SUBCHAN COUNT INA,RSS IT WAS POSITIVE SO STEP THE TABLE ADDRESS LDB SECTR IT WAS < 0 SO USE THE BASE PAGE SECTOR COUNT STA TB32A SET THE TABLE ADDRESS BLS,BLS SET TO MAX NUMBER BLF STB MXSIZ OF WORDS PER TRACK AND SET JMP CLC4 * TB32B DEF TB32A ADDRESS OF THE TABLE ADDRESS OTAC OTA 0,C LIA LIA 0 B11C OCT 1100 B4500 OCT 4500 B1600 OCT 1600 B0400 OCT 0400 B1700 OCT 1700 .15 DEC 15 TEST EQU LN-* ERROR HERE MEANS THE CONFIGURE ROUTINE * I TOO LONG. . EQU 1650B EQTA EQU . EQT1 EQU .+8 EQT4 EQU EQT1+3 EQT5 EQU EQT1+4 EQT6 EQU EQT1+5 EQT7 EQU EQT1+6 EQT8 EQU EQT1+7 EQT9 EQU EQT1+8 EQT10 EQU EQT1+9 EQT11 EQU EQT1+10 EQT12 EQU .+81 EQT13 EQU .+82 EQT15 EQU .+84 CHAN EQU .+19 I.32 EQU I.XX C.32 EQU C.XX DC EQU 0 A EQU 0 B EQU 1 HO2xvrLD EQU 200B SEEKC EQU 1000B ADREC EQU 6000B STATC EQU 1400B READC EQU 2400B WRITC EQU 4000B RECAC EQU 400B WAKE EQU 13000B INITC EQU 5400B VERC EQU 3400B ENDCC EQU 12400B RQSYC EQU 6400B SECTR EQU .+71 LNPG EQU LN DRIVER LENGTH END  x 6O 92060-18033 A S 0322 RTGEN PART 2 SRC              H0103 ASMB,R,L,C MH-RTGEN DRIVER SECTION. HED MH RTGEN DRIVER SECTION PAPER TAPE BOOTSTRAP * NAME: MHDVR * SOURCE: 92060-18033 * RELOC: SEE NAM RECORD * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1975. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM MHGEN 92060-16033 REV. A 750911 SUP * * CONSTANTS ARE EXTERNAL ON BASE PAGE * EXT N1,N2,N3,N4,N5,N6,N8,N9,N10,N16,N27 EXT N64,P2,P3,P4,P5,P6,P7,P8,P9,P11,P12,P13,P14 EXT P15,P16,P17,P18,P19,P20,P21,P22,P23,P24,P25 EXT P28,P29,P31,P33,P60,P64,P99,P202,P6K,L60,L2000 EXT M60,M77,M120,M177,M377,M777,M400,D128,M200,M0760 EXT M1740,M1600,M1777,M2000,M1377,M7400,M7000,M7600 EXT M7700,M7777,M0300,M1177 EXT DPWRS,P0100,P1000,P100,P10,P1 EXT OPWRS,M0100,M1000,M100,M10 EXT LWASM,PPREL,PPREL,BLANK,UBLNK,MSIGN,RPARB EXT DSKA,MOVW * * ENTRY POINTS FOR THIS MODULE * * VARIABLES ... * ENT SYSCH SYSTEM SUBCHANNEL ENT AUXCH AUX DISC SUBCHANNEL ENT DSIZE SYSTEM DISC SIZE (TRACKS) ENT DAUXN AUX DISC SIZE (TRACKS) ENT DSETU INITILIZE SUBROUTINE ENT DSKSC SCRATCH DISC ADDRESS ENT LSSYS,LSAUX LAST SEEK FLAGS ENT DISKA INCREMENT DISC ADDRESS SUBROUTINE ENT DISKO DISC OUTPUT ROUTINE ENT DISKI DISC INPUT ROUTINE ENT DSTBL GENERATE DISC TABLE SUBROUTINE ENT TRTST TEST CURRENT TRACK SUBROUTINE ENT DTSET SET UP TAT SUBROUTNE ENT SDS# SYSTEM DISC SECTORS/TRACK ENT ADS# AUX DISC SECTORS/TRACK ENT FSECT FLUSH FINAL SECTOR FROJM CORE ENT DERCN DISC ERROR COUNT ENT DBPO ORG OF DUMMY BASE PAGE ENT DSKAB INITIAL ABS DISC ADDRESS ENT PTBOT CONFIGURE DISC/ PUNCH BOOT * * UTILITY SUBROUTINES * EXT DOCON,SPACE,READ,GETNA,GINIT,GETOC,GETAL EXT INERR,YE/NO,LSTS,ERROR,LSTE,LABDO,IRERR EXT OUTID,CONVD * A EQU 0 B EQU 1 DRKEY EQU 102B TTY ADDRESS SPC 3 BEGIN EQU * START OF PROG. SPC 1 TBUF BSS 5 TEMP BUFFER TBCHN BSS 1 TEMP DRHSP EQU 103B PUNCH ADDRESS DC EQU 0 * * DEFINE LST ADDRESSES * LST EQU 7 LST IS FIXED ON BASE PAGE LST1 EQU LST LST2 EQU LST+1 LST3 EQU LST+2 LST4 EQU LST+3 LST5 EQU LST+4 HED MH RTGEN - CONSTANTS AND ADDRESSES * DSKAB OCT 2 INITIAL DISC ADDRESS FOR SYS CODE ASBUF DEF ASPBF+1 ADDRESS OF 9-WORD BUFFER IN BOOT ABOOT DEF START ADDRESS OF BOOTSTRAP LOADR INITE DEF INIER FOR DISK ERROR #SUBC NOP NUMBER OF SUBCHANNELS DEFINED DSIZE BSS 1 DISK SIZE - NO. OF TRACKS DSKSC BSS 1 ADDRESS OF DISK SCRATCH AREA DAUXN BSS 1 AUXILIARY DISK SIZE SDS# BSS 1 # SECTORS/TRACK FOR SYSTEM DISC$ ADS# OCT 0 # SECTORS/TRACK FOR AUX. DISC DERCN BSS 1 DISK ERROR COUNTER ATB30 DEF TB30 DIST1 DEF ATB30 DIST2 DEF ATB30 LSSYS OCT -1 SYSTEM LAST SEEK FLAG LSAUX OCT -1 SCRATCH LAST SEEK FLAG SCRSZ BSS 1 SIZE OF SCRATCH UNIT SYSCH BSS 1 SUBCHANNEL OF SYSTEM UNIT AUXCH BSS 1 SUBCHANNEL OF AUX UNIT SCRCH BSS 1 SUBCHANNEL OF SCRATCH UNIT INIT1 NOP INITILIZATION FLAG FOR DRIVER * ADBP DEF DBP ADDRESS OF DUMMY BASE PAGE DBP EQU * START OF DUMMY BASE PAGE DBPO EQU DBP DEFINE ENTRY POINT * MES8 DEF MES08 MES08 ASC 8,SCRATCH SUBCHNL? #DATA ABS I/OTB-I/OTC NO. OF DATA I/O INSTRUCTIONS INTMP BSS 1 TEMP FOR INITILIZATION ROUTINES MS3 DEF *+1 SUBCHANNEFL NUMBER MESAGE ASC 3, 00? MES1 DEF *+1 ASC 20,# TRKS, FIRST CYL #, HEAD #, # SURFACES, ASC 14, UNIT, # SPARES FOR SUBCHNL: P68 DEC 68 LENGTH OF MESSAGE * MES50 DEF *+1 ASC 7,START SCRATCH? MES4 DEF MES04 MES04 ASC 6,PUNCH BOOT? MES05 ASC 8,SYSTEM SUBCHNL? MES07 ASC 9,AUX DISC SUBCHNL? MES40 DEF *+1 ASC 13,# 128 WORD SECTORS/TRACK? "/E" ASC 1,/E "?0" ASC 1,?0 MES5 DEF MES05 MES7 DEF MES07 DLST DEF LST HED INTERACTIVE DISC SET UP SECTION * * THE FOLLOWING MESSAGES ARE PRINTED DURING THE INITIALIZATION * PHASE, WITH THE SPECIFICATIONS FOR EACH VALID RESONSE. * * * MESSAGE RESPONSE * * MH DISC CHANL? ENTER 2 OCTAL DIGITS * * # TRKS, FIRST TRK ON SUBCHNL: * 0? * . ENTER TWO 3 DIGIT DECIMAL NOS. * . SEPERATED BY A COMMA * . OR * . /E * 7? * * SYSTEM SUBCHNL? ENTER 1 OCTAL DIGIT * * AUX DISC (YES OR NO)? ENTER YES OR NO * * AUX DISC SUBCHNL? ENTER 1 OCTAL DIGIT * * SCRATCH SUBCHNL? ENTER 1 OCTAL DIGIT (MAY BE ANY DEFINED SUBCHNL) * * START SCRATCH? ENTER 3 DECIMAL DIGITS * * # 128 WORD SECTORS/TRACK? ENTER 3 DECIMAL DIGITS $$ SPC 3 DSETU NOP ENTRY POINT FOR QUESTION SECESSION. LDB $TB32 PUT TB32 IN THE LST JSB LSTE NOP IGNOR ALREADY THERE RETURN CLA CLEAR THE FLAG WORDS CHNLD LDA P16 LDB MESS2 MESS2 = ADDR: CONTROLLER CHNL? JSB READ PRINT MESSAGE, GET REPLY LDA P2 SET FOR 2 OCTAL DIGITS INPUT JSB DOCON GET DIGITS, RETURN OCTAL JMP CHNLD REPEAT INPUT * STA DCHNL SET DISK CHANNEL NUMBER * JSB SPACE SET UP TRACK MAP STB30 LDA P68 SEND MESSAGE: LDB MES1 # TRKS, FIRST CYL #, HEAD #, # SURFACES, JSB DRKEY,I UNIT, # SPARES FOR SUBCHNL: LDA ATB30 SET ADDRESSES STA SDS# FOR INPUT  STA INTMP AND CLEAR LOOPS LDB M7600 =-128 CLEAR CLA THE TB30. STA INTMP,I TRACK ISZ INTMP MAP INB,SZB STEP COUNT - DONE? JMP TB30. NO - CLEAR NEXT WORD * STA INIT1 CLEAR INIT FLAG STA #SUBC SET 0 DEFINED SUBCHANNELS TB30A STB INTMP SAVE CURRENT UNIT LDA B CONVERT FOR THE MESSAGE JSB KCVT STA MS3+2 SET IN THE MESSAGE LDB MS3 GET MESSAGE ADDRESS LDA P5 AND LENGTH JSB READ GO GET THE ANSWER LDA N2 GET FIRST JSB GETNA TWO CHARACTERS CPA "/E" /E? JMP TB30X YES - GO CHECK FURTHER * JSB GINIT NO - REINITIALIZE LBUF SCAN LDA N4 CONVERT 4 DIGITS JSB GETOC DECIMAL JMP TB30E ERROR - * STA TBCHN SET # TRACKS IN TEMP SZA,RSS IF ZERO JMP TB30B GO UPDATE POINTERS * JSB GETAL NOT ZERO - GET NEXT CHARACTER CPA BLANK COMMA IN? RSS YES - SKIP JMP TB30E NO - ERROR * LDA N3 SET FOR JSB GET 3 DECIMAL DIGITS AND CONVERT STA SDS#,I THE CYL # FOR TRACK 0. CCA GET 1 DIGIT JSB GET HEAD NUMBER STA B SAVE ADA N5 MUST BE LESS THAN 5. SSA,RSS WELL? JMP TB30E NO - BITCH * BLF,BLF PUT IN ITS PLACE STB BSHED AND SAVE CCA NOW GET # SURFACES JSB GET MUST BE 1 TO 5. STA B SZA ADA N6 SSA,RSS WELL? JMP TB30E NOT GOOD! BITCH BLF,BLF MOVE TO HIGH BLF END AND ADB BSHED COMBINE WITH HEAD STB BSHED CLA,INA NOW GET UNIT JSB GET MUST BE 0 TO 7. ADA BSHED GOOD - ADD THE HEAD WORD STA BSHED AND SAVE IT. CLA PREPARE FOR DEFAULT # SPARES  STA TBUF+1 NAMELY 0. JSB GETAL TEST FOR SPARES CPA BLANK WELL? RSS YES, SO SET TO CONVERT 2 DIGITS JMP TB30C NO, USE DEFAULT * LDA N2 JSB GET CONVERT THE # SPARES STA TBUF+1 SAVE THE NUMBER JSB GETAL END OF LINE? SZA WELL? JMP TB30E NO - TOO BAD - AND YOU ALMOST * MADE IT TOO. TB30C ISZ SDS# STEP TO HEAD/UNIT WORD. LDA BSHED AND STA SDS#,I SALT IT AWAY. ISZ SDS# NOW THE # TRACKS LDA TBCHN WORD STA SDS#,I SALT IT AWAY. STA DSIZE SET ALSO FOR ASSUMPTION STA SCRSZ OF ONE UNIT ONLY ISZ SDS# STEP TO SPARES LDA TBUF+1 AND STA SDS#,I SALT THAT AWAY TOO. LDA INTMP TO THIS SUBCHANNEL STA SYSCH FOR DEFAULT STA SCRCH SINGLE SUBCHANNEL SYSTEM ISZ #SUBC STEP TOTAL SUBCHANNEL COUNT TB30B ISZ SDS# STEP TABLE ISZ INTMP STEP SUBCHANNEL TB30F LDB INTMP IF CURRENT SUBCHANNEL CPB P32 IS 32 THEN JMP TB30Y DONE SO GO EXIT * JMP TB30A NOT 32 - GO ASK FOR NEXT ONE * SPC 1 TB30E JSB INERR TELL HIM THERE WAS AN ERROR JMP TB30F GO ASK AGAIN * SPC 1 TB30X JSB GETAL /E ENTERED SZA ANY THING ELSE? JMP TB30E YES - ERROR * TB30Y LDA #SUBC NO - GET NUMBER OF CHANNELS CMA,INA,SZA DEFINED - IS IT ZERO? JMP TB30Z NO - SKIP * JSB INERR YES - TELL HIM JMP STB30 AND RESTART * TB30Z JSB DSSIZ GET THE SYSTEM DISC # SECT./TRK. STA SDS# AND SET IT. CLA,INA IF ONLY CPA #SUBC ONE SUBCHANNEL JMP AUXIN SKIP TO THE AUX. MESSAGE * SPC 1 JSB SPACE ISYSC LDA P15 SEND MESSAGE: LDB MES5 SYSTEM SUBCHNL? JSB READ GET ANSWER CLA,INA x ONE DIGIT OCTAL JSB DOCON GO CONVERT JMP ISYSC ERROR - TRY AGAIN * JSB TSTCH TEST FOR LEGAL SUBCHANNEL STB DSIZE SET SYSTEM SIZE STA SYSCH SET SYSTEM SUBCHANNEL ADB M7400 TEST FOR TOO MANY TRACKS CMB,SSB,INB,SZB OK? JMP SYSER NO GO BITCH SPC 1 JSB SPACE SCRUN LDA P16 SEND MESSAGE: LDB MES8 SCRATCH SUBCHNL? JSB READ GO GET ANSWER CLA,INA CONVERT ONE OCTAL JSB DOCON DIGIT JMP SCRUN ERROR - TRY AGAIN * JSB TSTCH TEST FOR LEGAL SUBCHANNEL STA SCRCH SAVE SCRATCH SUBCHANNEL STB SCRSZ AND SIZE AUXIN CLA PRESET TO SHOW NO AUX DISC STA DAUXN SET CHANNEL TO ZERO CCA AND SUBCHANNEL STA AUXCH TO -1. JSB SPACE AUXDS LDA P31 SEND MESSAGE LDB MES6 AUX DISC (YES OR NO OR # TRKS)? JSB READ GO GET ANSWER LDA N3 FIRST TRY FOR A DECIMAL JSB GETOC NUMBER JMP AUX0 NO TRY FOR YES OR NO * STA TBUF SAVE THE NUMBER JSB GETAL END OF INPUT? SZA JMP AUX0 NO LET YE/NO SEND ERROR * LDA TBUF GET BACK THE SIZE STA DAUXN SET THE AUX DISC SIZE JSB DSSIZ GET ITS # SECTORS / TRACK JMP AUX3 GO SET IT * AUX0 JSB GINIT RESET THE SCANNER JSB YE/NO TRY FOR YES OR NO JMP AUXDS NO MUST BE BAD ANSWER * JMP STSCR NO - SKIP * CLA,INA YES - IF ONLY ONE CPA #SUBC DISC SUBCHANNEL THEN JMP AUX4 THEN WRONG ANSWER TRY AGAIN * JSB SPACE YES - SET UP AUX UNIT AUXUN LDA P17 SEND QUESTION: LDB MES7 AUX DISC SUBCHNL? JSB READ GO SEND AND GET ANSWER CLA,INA CONVERT ONE DIGIT OCTAL JSB DOCON JMP AUXUN ERROR - TRY AGAIN * JSB TSTCH TEST FOR LEGAL W UNIT AUX1 STB DAUXN SET SIZE OF AUX UNIT CPA SYSCH SAME AS SYSTEM? RSS YES - ERROR SKIP JMP AUX2 NO - GO SET UP * AUX4 JSB INERR SEND ERROR MESSAGE JMP AUXIN AND TRY AGAIN * SYSER JSB INERR SEND ERROR MESSAGE JMP ISYSC TRY AGAIN * AUX2 ADB M7400 TOO MANY TRACKS FOR AUX CMB,SSB,INB,SZB DISC? JMP AUX4 YES GO BITCH * SPC 1 STA AUXCH SET AUX CHANNEL LDA SDS# SET AUX TRK SIZE TO SAME AS SYS DISC AUX3 STA ADS# SET AUX DISC # SECT. TRACK SPC 1 STSCR JSB SPACE NEW LINE STREL LDA P14 LDB MES50 MES50 = ADDR: START SCRATCH? JSB READ PRINT MESSAGE, GET REPLY LDA N3 SET FOR 3 DECIMAL DIGITS INPUT JSB DOCON GET DIGITS, RETURN OCTAL JMP STREL REPEAT INPUT * LDB SCRSZ GET SCRATCH SIZE CMB,INB IF INPUT NOT GREATER ADB A THAN DISC SSB SIZE JMP STREM SKIP * JSB INERR ELSE ERROR JMP STREL TRY AGAIN * STREM LDB SCRCH GET SCRATCH SUBCHANNEL CPB SYSCH IF SAME AS SYSTEM RSS SKIP ADA M400 ELSE ADD 400 TO FLAG AS NON SYSTEM SZA IF SYSTEM AND ZERO SKIP RAL,SLA ELSE MULTIPLY BY TWO LDA DSIZE ZERO ON SYSTEM - USE UPPER HALF SYSTEM ALF,ALF ROTATE TO RAR,RAR TRACK LOCATION AND M7600 MASK TO TRACK STA DSKSC SET START SCRATCH * * NOTE: THE FACT THAT ANY GIVEN DISC * ADDRESS IS ON A UNIT OTHER THAN * THE SYSTEM UNIT IS FLAGGED BY * ITS TRACK ADDRESS BEING GREATER THAN * 400 BY THE AMOUNT OF THE DESIRED * TRACK. JMP DSETU,I RETURN TO MAIN LINE CODE SPC 1 P32 P DEC 32 BSHED NOP SPC 1 * * GET # SECTORS FOR DISC * DSSIZ NOP JSB SPACE NEW LINE #SEC1 LDA P25 LDB MES40 MES40 = ADDR: # 128 WORD SECTORS/TRACK?$$ JSB READ PRINT MESSAGE, GET REPLY LDA N3 SET FOR 3 DECIMAL DIGITS INPUT JSB DOCON GET DIGITS, RETURN OCTAL JMP #SEC1 REPEAT INPUT * ALS DOUBLE FOR 64 WORD SECTORS JMP DSSIZ,I RETURN SPC 2 GET NOP GET SUBROUTINE CHECKS FOR EXISTANCE STA TBUF AND GETS NEXT JSB GETAL INPUT NUMBER CPA BLANK PASS NUMBER TYPE ECT FLAG IN A RSS LINE NOT EMPTY SO SKIP JMP TB30E EMPTY LINE SO ERROR * LDA TBUF GET TYPE/ # DIGITS JSB GETOC GET NUMBER JMP TB30E CONVERSION ERROR BITCH * JMP GET,I ELSE RETURN SKP SPC 3 * SUBROUTINE TO TEST LEGALITY OF * A SUBCHANNEL. THE TEST CONSISTS * OF LOOKING FOR THE DESIRED * CHANNEL IN THE TRACK MAP. * CALLING SEQUENCE * * P-1 ERROR RETURN * P JSB TSTCH * P+2 NORMAL RETURN CHANNEL IN A SIZE IN B SPC 1 * A ON ENTRY IS ASSUMED TO BE THE SUBCHANNEL TO BE CHECKED. * ERROR EXIT IS P-1 * IF THE SUBCHANNEL IS LEGAL IT IS RETURNED IN A * AND B IS THE NUMBER OF TRACKS ON THAT CHANNEL SPC 1 TSTCH NOP LDB A NUMBER TO B BLS,BLS INDEX INTO THE ADB ATB30 MAP TABLE ADDRESS ADB P2 STEP TO # TRACKS LDB B,I GET # TRACKS IN B SZB IF ZERO - ERROR - SKIP JMP TSTCH,I ELSE OK - RETURN B= # TRACKS * LDA INIT1 ELSE GET INIT FLAG SZA,RSS IF NOT SET JSB INERR SEND ERROR MESSAGE LDA TSTCH GET RETURN ADDRESS xADA N2 ADJUST FOR P-1 JMP A,I AND RETURN SKP * * INSERT CHNL NO. IN INSTRUCTION * * THE STDSK SUBROUTINE SETS THE CURRENT DISK CHANNEL * NOS. IN THE I/O INSTRUCTIONS. * * CALLING SEQUENCE: * A = NO. WORDS TO BE CONFIGURED (NEG.) * B = ADDRESS OF INSTRUCTION ADDR LIST * JSB STDSK * * RETURN: * A = DESTROYED * B = NEXT INSTRUCTION ADDRESS * STDSK NOP STA TBUF SAVE NO. OF INSTRUCTIONS STDS1 LDA B,I GET INSTRUCTION AND M7700 ISOLATE INSTRUCTION CODE IOR DCHNL INSERT CHANNEL NO. STA B,I SET INSTRUCTION IN CODE INB INCR INSTRUCTION ADDRESS ISZ TBUF SKIP - ALL INSTRUCTIONS CONFIG. JMP STDS1 CONFIGURE NEXT INSTRUCTION JMP STDSK,I RETURN * SPC 2 HED MH RTGEN CONFIGURE AND COMPLETE INITILIZATION PTBOT NOP CONFIGURE/PUNCH BOOT ENTRY POINT LDA #DATA GET THE NUMBER OF DATA CHANNEL INSTRUCTIONS LDB HPDSK GET THE ADDRESS OF THE DISK ADDRESSES JSB STDSK GO SET DATA CHANNEL ADDRESSES JSB INITS INITILIZE THE SYSTEM DISC SPC 1 LDB ABOOT WRITE THE DISC BOOT ON CLA,CLE THE JSB DISKD DISC TRACK 0 SECT 0 TO SET ADDRESSES LDB DP#RM GET THE TABLE ADDRESS IN BOOT LDA PL#ST AND ADDRESS IN PARER BOOT JSB MOVW MOVE THE WORDS DEC -10 LDB D#HDS GET ADDRESS OF REST OF PRAMS LDA DIST1 GET ADDRESS OF DISC PRAMS INA STEP TO THE HEAD/UNIT WORD LDA A,I GET THE WORD ALF ROTATE TO LOW A AND M17 AND ISOLATE THE #HEADS PER CYL. STA B,I SET FOR BOOT INB STEP THE ADDRESS LDA H#AD GET THE BASE HEAD ADDRESS STA PT#H2 SET IN SECOND ADDRESS FOR PT ALF,ALF AND SET BASE HEAD FOR STA B,I AND SET IT FOR THE BOOT IN&B STEP TO NEXT ADDRESS LDA PT#TR STA PT#T2 SET FOR ADDRESS RECORD STA B,I SET FOR THE BOOT INB STEP TO NEXT ADDRESS LDA SDS# SET ALF,RAL THE RAL NUMBER OF WORDS STA B,I PER TRACK LDA LWASM GET LWAM AND M0760 MASK TO PAGE STA TBUF SAVE LDA BADD GET THE BOOT ADDRESS AND M1177 MASK TO PAGE BITS AND IOR TBUF ADD PAGE BITS AND STA BADD SET FOR THE PAPER BOOT RAL,CLE,ERA CLEAR THE SIGN BIT INB STA B,I SET THE ADDRESS INB FOR BOOTING STA B,I AND STA BADDD FOR THE PAPER BOOT INB LDA B,I GET THE TABLE ADDRESS AND M1777 AND MASK TO PAGE OFFSET IOR TBUF ADD THE PAGE BITS STA B,I AND RESTORE INB STEP THE THE NEXT ONE LDA B,I GET THE DEF AND M1777 SAVE THE OFFSET IOR TBUF SET THE PAGE STA B,I AND RESET INB AND YET ANOTHER LDA B,I AND M1777 IOR TBUF STA B,I LDA DDIV CONFIGURE THE DIVIDE AND M1777 IOR TBUF STA DDIV AND RESET IT INB ONE MORE TIME LDA B,I AND M1777 IOR TBUF STA B,I DONE SO LDB ABOOT OUTPUT THE BOOTSTRAP CLA,CLE TO THE DISC JSB DISKD TRACK ZERO SECT ZERO SKP BOOT0 JSB SPACE NEW LINE LDA P11 SEND MESSAGE LDB MES4 PUNCH BOOT? JSB READ GET THE WORD JSB YE/NO ANALIZE JMP BOOT0 ERROR - TRY AGAIN * JMP PTBOT,I NO RETURN TO MAIN SPC 1 JSB LEADR PUNCH LEADR LDA NBLC GET BOOT LENGTH STA TBUF SET FOR CHECK SUM CACULATION LDA STRAP GET LOAD ADDRESS CLB,RSS INITIALIZE CHECKSUM BOOT1 ADB A,OB@0 TO GIVE 1K TO BP IMAGE OCT 112400 END COMMAND (WAITS FOR ATTN.) WA#KE OCT 113000 PT#SK OCT 101200 PT#TR NOP H#AD NOP PT#AD OCT 106000 PT#T2 NOP PT#H2 NOP OCT 107404 FILE MASK R#DCM OCT 102400 P#EN OCT 101400 STATUS COMMAND BADD ABS START-O+I+I THESE DSKDR ABS DC DMA CON WORD DM128 DEC -128 BADDD ABS START-O B174C OCT 17400 P#END ABS P#EN-ADCON P#DMA ABS R#DCM-ADCON SPC 1 HNDR JMP S#ART-ADCON MUST BE AT 100B WHEN LOADED * NOP LOCATION FOR CHECK SUM SPC 2 BORG EQU 100B+S#ART-HNDR RUN TIME ORG OF PAPER BOOT ADCON EQU HNDR-100B ADDRESS ADJUSTING CONSTANT. BL EQU HNDR-S#ART+1 BOOT LENGTH BL4 EQU BL+BL+BL+BL BOOT LENGTH TIMES 4 BL16 EQU BL4+BL4+BL4+BL4 TIMES 16 BL64 EQU BL16+BL16+BL16+BL1RY6 TIMES 64 BL256 EQU BL64+BL64+BL64+BL64 TIMES 256 BOOTL ABS -BL-3 LENGTH FOR PUNCHING NBLC ABS -BL-2 BOOT LENGTH FOR CHECK SUM CACULATION HED GENERATE $TB31 TRACK MAP TABLE DSTBL NOP * GENERATE TB32 SPC 2 LDA ATB30 GET THE TABLE ADDRESS STA TBUF SET FOR INDEXING LDA #SUBC GET NUMBER OF WORDS CMA,INA SET NEGATIVE STA TBUF+1 SET COUNT LDB $TB32 GET THE LST ENTRY JSB LSTS FOR $TB32 HLT 0 BAD NEWS NO $TB32 ????? LDB PPREL GET THE CORE ADDRESS FOR TABLE STB LST5,I SET IN THE SYMBOL TABLE LDA TBUF+1 SEND THE SUBCHANNEL COUNT JSB LABDO FIRST * DSTB1 LDA TBUF,I GET WORD FROM TABLE JSB LABDO SEND TO DISC ISZ TBUF STEP TABLE ADDRESS LDA TBUF,I GET THE HEAD/UNIT WORD JSB LABDO SEND IT ISZ TBUF STEP TO THE # OF TRACKS WORD LDA TBUF,I AND JSB LABDO SEND IT ISZ TBUF STEP OVER THE SPARE WORD ISZ TBUF ISZ TBUF+1 STEP COUNT - DONE? JMP DSTB1 NO - GET NEXT ENTRY * STB PPREL RESET NEW CORE ADDRESS JMP DSTBL,I RETURN SPC 3 $TB32 DEF *+1 ASC 3,$TB32 * HED MH RTGEN INCREMENT DISC ADDRESS ROUTINE * * INCREMENT DISK ADDRESS * * THE DISKA SUBROUTINE INCREMENTS THE CURRENT DISK ADDRESS * TO PROVIDE THE ADDRESS OF THE SUCCEEDING SECTOR, * WHETHER THAT SECTOR IS ON THE SAME TRACK OR THE FOLLOWING * TRACK. IN ADDITION, THE DISKA SUBROUTINE CHECKS THAT * THE NEXT DISK ADDRESS IS VALID. * * CALLING SEQUENCE: * A = CURRENT DISK ADDRESS * B = IGNORED * JSB DISKA * * RETURN: * A = NEXT DISK ADDRESS * B = DESTROYED * DISKA NOP STA B SAVE CURRENT ADDRESS AND M177 ISOLATE SECTOR NUMBER INA ADD 1. CPA SDS# IF =$B@< TO MAX NO. ON SYS. DISC, CLA SET # = 0, STA DISKT AND SAVE NEW SECTOR #. LDA B ISOLATE ALF,ALF TRACK RAL ADDRESS AND M777 IN LOW A. CLB IF NEW CPB DISKT SECTOR # = 0, INA ADD 1 TO TRACK #. CPB DISKT NEW TRACK? JSB TRTST YES - TEST FOR DEFECTIVE SEZ IF SYSTEM SKIP JMP DISK2 ELSE CHECK AGAINST SCTATCH * CPB DSIZE TO LARGE OVER FLOW? JMP DKERR YES - BOMB * JMP DISK3 NO - SKIP * DISK2 CPB SCRSZ SCRATCH OVERFLOW? JMP DKERR YES - BOMB * DISK3 ALF,RAL RESTORE TRACK # TO 14-07, RAL,RAL AND IOR DISKT INSERT SECTOR #. JMP DISKA,I -RETURN. * DKERR LDA ERR17 SET CODE FOR INSUFFICIENT DISK JSB IRERR IRRECOVERABLE ERROR EXIT ERR17 ASC 1,17 IRERR DOES NOT RETURN * DISKT NOP -TEMPORARY STORAGE HED TEST FOR BAD TRACK SUBROUTINE * THE TRTST ROUTINE IS A DUMMY FOR THIS DISC SINCE ALL BAD TRACKS * HAVE BEEN SPARED. SPC 2 TRTST NOP ALF,CLE,ALF ROTATE TRACK TO ERA,RAL HIGH A AND SAVE SCRBIT IN E * ALF,ALF YES ROTATE AND STA B SAVE IN B FOR RETURN SEZ IF NOT SYS UNIT IOR M400 RESET SIGN JMP TRTST,I RETURN * sB HED MH RTGEN DISC INPUT CONTROL * * DISK INPUT DRIVER * * THE DISKI SUBROUTINE CONTROLS THE INPUT FROM THE DISK. * * THIS ROUTINE USES A CORE BUFFER TO MAKE THE DISC APPEAR TO HAVE * 64 WORD SECTORS. * * * CALLING SEQUENCE: * A = DISK ADDRESS * B = CORE ADDRESS * JSB DISKI * * RETURN: CONTENTS OF A AND B ARE DESTROYED. * DISKI NOP CLE,ERA SET EVEN SECTOR ADDRESS STB DISKO SAVE CORE ADDRESS FOR MOVE LDB OUBUF+1 GET OUTBUFFER ADDRESS CPA OUBUF REQUESTED SECTOR IN OUTBUFFER? JMP DIS01 YES - GO MOVE * LDB INBUF+1 REQUESTED SECTOR IN INBUFFER? CPA INBUF ? JMP DIS01 YES GO MOVE * ELA SECTOR NOT IN CORE GO CCE TO DRIVER JSB DISKD TO READ THE SECTOR LDA DCMND SET TO SHOW CLE,ERA SECTOR IN STA INBUF CORE LDB INBUF+1 GET BUFFER ADDRESS DIS01 LDA N64 SET COUNT FOR 64 STA DISKT WORDS SEZ IF ODD SECTOR ADB P64 ADD 64 TO LOCAL BUFFER ADDRESS DIS03 LDA B,I MOVE THE STA DISKO,I ISZ DISKO 64 INB WORDS ISZ DISKT TO THE JMP DIS03 USER BUFFER * JMP DISKI,I RETURN HED MH RTGEN DISC OUTPUT CONTROL * * DISK OUTPUT DRIVER * * THE DISKO SUBROUTINE CONTROLS ALL OUTPUT TO THE * DISC. IT USES A CORE BUFFER TO MAKE THE DISC APPEAR TO HAVE 64 * WORD SECTORS. * * CALLING SEQUENCE: * A = DISK ADDRESS * B = CORE ADDRESS * JSB DISKO * * RETURN: CONTENTS OF A AND B ARE DESTROYED. * DISKO NOP STB DISKI SAVE CORE ADDRESS LDB DSKA GET LAST MAX ADDRESS CMB,INB SET NEG AND ADB A SUBTRACT FROM CURRENT ACCESS SSB,RSS IF CURRENT HIGHER STA DSKA THEN RESET MAX. CLE,ERA SET TO EVE ]N SECTOR CPA OUBUF SAME AS CURRENT SECTOR? JMP DIS02 YES - GO MOVE * ELA,CLE NO - SET TO WRITE CURRENT SECTOR STA DISKA SAVE REQUEST ADDRESS LDA OUBUF GET BUFFER ADDRESS FOR CORE SECTOR LDB OUBUF+1 GET CORE ADDRESS OF THE SECTOR ELA,CLE CLEAR E FOR WRITE JSB DISKD WRITE THE SECTOR LDA DISKA GET THE REQUESTED SECTOR LDB OUBUF+1 AND LOCAL BUFFER ADDRESS CCE SET E FOR READ JSB DISKD READ THE SECTOR LDA DISKA SET TO SHOW IT IS IN CLE,ERA STA OUBUF CORE DIS02 LDB INBUF IF CURRENT WRITE BUFFER CPA B IS THE READ CCB BUFFER THEN STB INBUF SHOW READ BUFFER EMPTY LDB N64 SET COUNTER FOR STB DISKT 64 WORDS LDB OUBUF+1 GET THE LOCAL BUFFER ADDRESS SEZ IF ADDRESS IS ODD ADB P64 64 TO THE BUFFER LOCATION DIS04 LDA DISKI,I MOVE STA B,I THE INB ISZ DISKI TO THE ISZ DISKT LOCAL JMP DIS04 BUFFER AND * JMP DISKO,I RETURN SPC 3 OUBUF OCT 2 DEF BUFOU OUTPUT BUFFER ADDRESS INBUF OCT -1 INBUF IN CORE FLAG (IMPOSSIBLE) DEF BUFIN INPUT BUFFER ADDRESS BUFIN BSS 128 INPUT BUFFER FOR DISC BUFOU BSS 128 OUTPUT BUFFER FOR DISC HED MH RTGEN PAGE CONSTANTS * * SET DISK TRACK TABLE * * DTSET SETS UP THE DISK TRACK TABLE FOR BOTH THE SYSTEM * AND AUXILIARY DISK. SINCE ALL TRACKS ARE GOOD IT ONLY * SAVES THE NUMBER OF SYSTEM TRACKS FOR THE PROTECT TRACKS * ROUTINE IN FSECT. * * CALLING SEQUENCE: * A = NO. USED TRACKS * JSB DTSET * * RETURN: CONTENTS OF A AND B ARE DESTROYED. * DTSET NOP CMA,INA SET NEGATIVE AND STA TBUF SAVE # OF USED TRACKS JMP DTSET,I RETURN SPC 2 ADTSE DEF *+1 ERROR ROUTINE ADDRESS  JMP DSKER GO TO NORMAL ERROR ROUTINE SPC 1 * SPC 3 * FSECT IS A ROUTINE TO SET LOAD SPECS IN THE LOAD SPEC. * TABLE IN THE DISC RESIDENT BOOT EXTENSION AND TO * FLUSH THE FINAL SECTOR FROM CORE AT THE END OF * GENERATION AND IT ALSO WRITE PROTECTS THE SYSTEM * PORTION OF THE DISC. * * CALLING SEQUENCE: * * LDA SPEC BUFFER ADDRESS I.E. ADDRESS OF THE NINE WORDS * JSB FSECT * RETURN REGS. MEANINGLESS * FSECT NOP STA DTSET SAVE THE ADDRESS FOR A BIT LDB ABOOT GET THE CLA,CCE BOOT FROM JSB DISKD THE DISC LDA DTSET GET THE FROM ADDRESS LDB ASBUF AND THE TO ADDRESS JSB MOVW AND MOVE THE WORDS DEC -9 LDB ABOOT NOW WRITE CLA,CLE THE BOOT JSB DISKD BACK TO THE DISC CLE LDA OUBUF FLUSH LDB OUBUF+1 THE FINAL BUFFER ELA,CLE FROM CORE JSB DISKD * * PROTECT CODE - THE SYSTEM TRACKS ARE PROTECTED BY READING THEM * (1K WORDS AT A TIME) INTO THE BASE PAGE IMAGE BUFFER AND * THEN WRITING THEM BACK OUT WITH THE PROTECT FLAG SET. * * CLA SET FIRST TRACK STA TBUF+1 NUMBER IN TEMP LDA ADTSE SET INITIALIZE ERROR STA INITE ADDRESS LDA SDS# CACULATE # ALF,RAL WORDS RAL ON A TRACK STA DTSET AND SAVE LDA FLGPT GET PROTECT CODE WORD STA INIT1 SET SO DRIVER KNOWS * PNXT2 CLA CLEAR THE NUMBER DONE ON THIS TRACK STA TBUF+2 NXPTB LDB L2000 PRESET TO DO 1K WORDS STB DM128 ADB TBUF+2 UPDATE NUMBER DONE STB TBUF+2 STB A CAN WE ADA DTSET DO A FULL SSA,RSS 1K? JMP DO1K YES GO DO IT * ADA M2000 NO - COMPUTE NUMBER CMA,INA,SZA,RSS ZERO => DONE? JMP PNXTR YES - DO NEXT TRACK * = STA DM128 NO SET FOR REST OF TRACK DO1K LDB ADBP READ THE SECTION LDA TBUF+1 INTO THE BP IMAGE AREA CCE SET FOR READ JSB DISKD DO IT LDA STATB PROPOGATE THE S ELA BIT (SPARE) LDA FLGPT TO THE INIT COMMAND RAL,ERA AND STA INIT1 RESET LDA TBUF+1 GET THE DISC ADDRESS LDB ADBP AND THE CORE ADDRESS CLE JSB DISKD WRITE OUT THE BUFFER * LDA TBUF+1 BUMP THE DISC ADA P16 ADDRESS BY STA TBUF+1 16 SECTORS (1024 WORDS) JMP NXPTB GO DO NEXT BUFFER * PNXTR LDA TBUF+1 GET THE TRACK ADDRESS ADA N16 BACK OUT THE +16 AND M7600 ISOLATE THE TRACK ADA M200 ADD ONE STA TBUF+1 AND RESET ISZ TBUF DONE? JMP PNXT2 NO DO THE NEXT TRACK * JMP FSECT,I YES - RETURN * * FLGPT OCT 41400 FLGDF OCT 21400 FLGSP OCT 101400 HED MH RTGEN COMMON I/O DISC DRIVER * THE DISKD SUBROUTINE IS THE MAIN DISC INPUT/OUTPUT DRIVER. * IT SETS UP THE COMPLETE TRANSFER AND READS OR WRITES * 128 WORD SECTORS ON THE DISC. IT WAITS UNTIL THE TRANSFER * IS COMPLETE. STATUS IS DONE AFTER EACH TRANSFER FOR WRITE * PROTECT ERRORS THE OPERATOR IS ASKED TO TURN ON THE SWITCH. * FOR UNDEFINED ERRORS OR ERRORS THAT SHOULD NOT HAPPEN SUCH AS * DEFECTIVE CYLINDER ERRORS THE IRRECOVERABLE ERROR ERR40 IS * TAKEN. FOR NOT READY ERRORS THE OPERATOR IS NOTIFIED. * FOR OTHER ERRORS TEN TRIES ARE MADE. IF THE ERROR STILL EXIST * AND: * * A - IF THE INIT FLAG IS SET EXIT TO INITE INDIRECT * * B - ELSE NOTIFY OPERATOR AND HALT * A= DISC ADDRESS -64 WORD/SECT BASIS- * EXCEPT WHEN INIT1 IS NON ZERO AND THE * P BIT (BIT 14 IN INIT1) IS ZERO IN WHICH * A IS THE TRACK ADDRESS ONLY (TO ALLOW BIGGER *  NUMBERS. * B= DISC STATUS * SPC 3 * CALLING SEQUENCE * A = DISK ADDRESS -ON A 64 WORD/SECTOR BASIS - * EXCEPT WHEN INIT1 IS NON ZERO AND THE * P BIT (BIT 14 IN INIT1) IS ZERO IN WHICH * A IS THE TRACK ADDRESS ONLY (TO ALLOW BIGGER * NUMBERS. * B = CORE ADDRESS * E = 1 FOR READ * E = 0 FOR WRITE * * RETURN - ALWAYS NORMAL--REGS. MEANINGLESS SPC 3 DISKD NOP RBL,ERB SET THE READ/WRITE BIT STB MADDR AND SAVE THE ADDRESS LDB INIT1 GET INIT FLAG WORD SZB,RSS IF ZERO DO STANDARD ADDRESS JMP DISK0 * RBL ELSE TEST IF WRITE PROTECT SSB WELL? JMP DISK0 YES DO STANDARD ADDRESS * CLB,CLE CLEAR THE SECTOR ADDRESS STB SECT1 JMP DISK1 AND SKIP * DISK0 STA DCMND DO TRACK MAPPING AND M177 ISOLATE SECTOR STA SECT1 SAVE XOR DCMND ISOLATE THE TRACK CLE,ELA SCRATCH UNIT FLAG TO E ALF,ALF ROTATE TRACK TO LOW A DISK1 LDB DIST1 GET ADDRESS OF SEZ SYSTEM/SCRATCH PARAMETER TABLE - SCRATCH? LDB DIST2 YES - GET SCRATCH PARAMETERS JSB DADTR TRANSLATE THE TRACK ADDRESS LDB #UNST SET # TO CONFIGURE COUNTER STB UNCOU LDB UNITC GET UNIT CONFIGURE ADDRESS NXUN XOR B,I AND CONFIGURE THE UNIT NUMBERS AND M17 OF COURSE THIS XOR B,I CODE WORKS STA B,I INB ISZ UNCOU DONE? JMP NXUN NO TRY AGAIN * LDA WRTCM GET THE WRITE COMMAND ADA INIT1 ADD THE INIT CODE STA W#CMD AND SET IT LDA PT#TR GET THE CYLINDER LDB SECT1 SECTOR BRS ADJUST OUT THE 64 WORD JASS ADB H#AD PUT IN THE HEAD DST CYLAD SET THE SEEK ADDRESSES LDA INIT1 Є GET THE INIT CODE CPA FLGSP IF SPARING OR RSS DOING A DEFECTIVE TRICK CPA FLGDF THEN JMP RTRY SKIP THE SECOND ADDRESS SET UP * LDA CYLAD ELSE DST CYLA2 SET UP THE ADDRESS RECORD COMMAND * RTRY LDA N10 SET THE ERROR STA EDCNT COUNTER TO 10 TRIES OVER JSB STATW GET STATUS RBR,SLB,RBL READY? JMP NRERR NO SO LONG * SLB IF DRIVE BUSY JMP OVER WAIT FOR IT * LDB MADDR GET THE CORE ADDRESS LDA R#DCM PRESET FOR READ SSB,RSS WRITE? LDA W#CMD YES RESET TO WRITE RAL IS PROTECT BIT SET?? SSA WELL? JMP WPCAL YES JUST DO ADDRESS RECORD (NO SEEK) * RAR NO RESTORE THE COMMAND JSB XFER STANDARD TRANSFER DEF WAITC-1 ADDRESS OF COMMAND TABLE DEF R/WCM ADDRESS OF END OF TABLE CKSTA ADA CTABA INDEX WITH STATUS INTO JMP A,I STATUS XFER TABLE * WPCAL RAR RESTORE THE COMMAND JSB XFER WRITE PROTECT TRANSFER DEF ADRES-1 START WITH THE ADDRESS RECORD DEF R/WCM STILL END SAME PLACE JMP CKSTA GO DO STATUS CHECK * * CTABA DEF *+1 CODE ERROR DISPOSITION JMP ENDOK 00 NO ERROR - TEST FOR VERIFY JSB FAULT 01 ILLEGAL OP - PROGRAM FAULT JSB FAULT 02 UNIT AVAIL. PROGRAM FAULT JSB FAULT 03 CONTROLLER JSB FAULT 04 SHOULD JSB FAULT 05 NEVER JSB FAULT 06 SEND THESE ERRORS JMP RECAL 07 CYL COMPARE TRY TO RECAL. JMP ERRDS 10 PARITY ERROR TRY AGAIN JMP EOCYL 11 HEAD/SECTOR? RESTART ERR43 JSB FAULT 12 I/O PROGRAM (WHO? ME?) PROGRAM FAULT JSB FAULT 13 UN IMPLEMENTED CODE FAULT JMP EOCYL 14 END OF CYL. BAD # SECT/TRK ERR43,RESTART JSB FAULT 15 UN IMPLEMENTED CODE FAULT JMP ERRDS 16 OVER RUN JUST RETRY JMP ERRDS 17 CORRECTABLE ERROR DON'T EVEN TRY JSB FAULT 20 ILLEGAL SPARE - FAULT JSB FAULT 21 DEFECTIVE TRACK - FAULT JMP ST2ER 22 ACCESS NOT READY - STATUS 2 ERROR JMP ST2ER 23 STATUS 2 GO CHECK JSB FAULT 24 UN IMPLEMENTED FAULT JSB FAULT 25 ERROR CODEDS JMP ST2ER 26 ILLEGAL WRITE TEST ST 2 JMP UWAIT 27 WAIT FOR THE UNIT. * * ERRDS ISZ DERCN STEP TOTAL ERROR COUNT NOP IGNOR SKIP ISZ EDCNT STEP OPERATION ERROR COUNT JMP OVER OK TRY AGAIN * LDA INIT1 IF DOING INIT SZA THEN GO DO SPARING JMP INITE,I TRICK * DSKER LDA ERR22 ELSE SEND JSB ERROR ERROR 22 LDA DCMND GET DISK ADDRESS LDB STATB AND THE STATUS HLT 22B PAUSE JMP RTRY TRY AGAIN ON RESTART SPC 1 * STATUS-2 ERROR POSSIBLE CONDITIONS ARE: * NO ERROR SO JUST RETRY AT ERRDS * NOT READY GO TO NRERR TO WAKE HIM UP * PROTECTED SEND TURN ON THE SWITCH MESSAGE * ST2ER LDA B STATUS -2 TO A AND M40 KEEP /FORMAT BITS SZA,RSS SET?? JMP WRPTM IF SWITCH OFF GO BITCH * SSB,RSS IF NO STATUS 2 ERROR JMP ERRDS JUST COUNT IT AND TRY AGAIN * LDA B GET THE STATUS WORD AGAIN AND P4 ISOLATE THE SEEK CHECK BIT SZA IF SET THEN WE HAVE A BAD ADDRESS JMP EOCYL SO GO RESTART THE GEN. * JMP NRERR MUST BE NOT READY * WRPTM JSB SPACE WRITE PROTECT SWITCH IS LDA P33 LDB MES32 OFF - SO JSB DRKEY,I TELL THE MAN TO TURN IT ON HLT 32B WAIT FOR TURN ON JMP RTRY TRY AGAIN. SPC 1 NRERR JSB SPACE DISC IS NOT READY LDA P24 LDB MS4 SEND THE WORD TO THE MAN JSB DRKEY,I LDA STATB HLT 33B PAUSE JMP RTRY ON RESTART RETRY ÑSPC 1 * FAULT NOP ENTRY FOR TRACE BACK ONLY LDA ERR40 SHOULD NEVE GET HERE JSB IRERR NOT RECOVERABLE - SHOULD NEVER HAPPEN - SPC 1 ERR40 ASC 1,40 ERROR CODE WRTCM OCT 4000 ENDC OCT 12400 VERCM OCT 3400 CALC OCT 600 WAITX OCT 13000 M140 OCT 140 M40 OCT 40 UN#IT NOP * * SPC 2 * UWAIT WAIT FOR UNIT TO BECOME AVAILABLE * * UWAIT LDA WAITX SEND THE WAIT UWAT1 JSB OUTCC COMMAND JSB WAITF AND WAIT JMP OVER OK NOW TRY IT * * * RECAL RECALABRATE THE DISC ON CYLINDER COMAPRE ERRORS * RECAL LDA CALC GET COMMAND JMP UWAT1 GO SEND IT * * ENDOK AFTER A SUCCESFUL TRANSFER WE MUST DO AND END * TO ALLOW OTHER CPU'S TO ACCESS THE CONTROLLER. * EXCEPT IF WE JUST READ A CHUNCK TO WRITE PROTECT IT. * ALSO IF DOING INITIALIZE AND NOT FLAGING DEFECTIVE DO * A VERIFY TO CHECK FOR ERRORS. * * ENDOK LDA INIT1 GET THE INIT FLAG SZA,RSS IF CLEAR JMP EXDVR JUST GO SEND THE END * RAL,SLA IF SPARING JMP SPARA GP SET UP SPARE ADDRESS * RAL,SLA IF JUST PROTECTING JMP STDAD USE STANDARD ADDRESS * RAL,SLA IF FLAGING DEFECTIVE JMP EXDVR DON'T EVEN CHECK * STDAD LDB DM128 EITHER STRAIGHT INIT. OR CMB,INB PROTECT LSR 7 SET UP THE STB VERCO SECTOR COUNT LDA VERCM SEND VERIFY COMMAND JSB XFER AND GO DEF WAITC-1 DO IT DEF VERCO SZA ANY ERROR IS JMP ERRDS BAD NEWS * * EXDVR SEND END COMMAND UNLESS WRITE PROTECTING AND * READING EXDVR LDA MADDR GET READ/WRITE BIT LDB INIT1 AND COMMAND RBL PUT WP BIT IN 15 SSA,RSS IF WRITING JMP ENDSX GO END * SSB IF READING AND PROTECT BIT SET JMP DISKD,I JUST RETURN * ENDSX LDA ENDC GET THE END COMMAND JSB OUTCC SEND IT JMP DISKD,I AND EXIT * * SPARA SETS ADDRESSES TO VERIFY A SPARE TRACK * SPARA DLD CYLA2 USE THE REAL DST CYLAD ADDRESS FOR SEEK JMP STDAD GO TRY THE VERIFY * * * XFER THE TRANSFER ROUTINE * DOES DMA SET UP,AND SENDS A SERIES OF WORDS TO THE DISC * CONTROLLER. THEN STATUS IS DONE USING STATW. * * CALLING SEQUENCE: * * A= COMMAND FOR THE XFER READ/WRITE INIT ETC. * B= ADDRESS WITH DIRECTION BIT SET FOR DMA * JSB XFER * DEF COMMAND LIST * DEF LAST COMMAND (ALSO DMA COMMAND) * * XFER NOP STA R/WCM SET THE READ WRITE COMMAND LDA DSKDR SET UP THE OTA 6 DMA CLC 2 OTB 2 STC 2 LDA DM128 OTA 2 LDB XFER,I GET THE HEAD OF THE LIST ISZ XFER STEP TO THE END ADDRESS NXTC INB STEP TO THE FIRST COMMAND LDA B,I GET THE WORD CPA R/WCM IF ACTION COMMAND CCE,RSS SKIP TO THE CLC RAL,CLE,SLA,ERA ELSE CLEAR THE SIGN AND IF SET DSK20 CLC DC TELL THE CONTROLLER IT IS A COMMAND DSK21 OTA DC,C SEND THE WORD CPB XFER,I IF THIS IS THE ACTION WORD STC 6,C START THE DMA DSK22 STC DC AND THE CONTROLLER SEZ IF NOT A COMMAND SKIP THE FLAG WAIT JSB WAITF WAIT FOR THE FLAG STF 6 STOP THE DMA CPB XFER,I DONE? RSS YES SKIP JMP NXTC NO GO DO THE NEXT ONE * JSB WAITF THIS WAIT IS ONLY NEEDED FOR VERIFY ISZ XFER STEP TO EXIT ADDRESS JSB STATW GET THE STATUS WORDS JMP XFER,I AND GET OUT * * * XFER COMMAND TABLE * WAITC OCT 113000 SEEKC OCT 101200 MUST CONFIGURE TO UNIT CYLAD NOP CYLINDER ADDRESS HDSCT NOP HEAD AND SECTOR ADRES OCT 106000 NEEDS UNIT CYLA2 NOP CYLINDER ADDRESS FOR ADDRESS RECORD HDSC2 NOP FILMK OCT 107404 FILE MASK/SPARING ONLY R/WCM OCT 102400 READ/WRIT COMMAND VERCO NOP VERIFY COUNT * * END OF LIST * * UNIT CONFIGURE LIST * UNITC DEF *+1,I DEF WAITX DEF WA#KE DEF SEEKC DEF VERCM DEF CALC DEF ADRES DEF R/WCM DEF STACC DEF WRTCM DEF R#DCM DEF PT#SK DEF PT#AD DEF P#EN #UNST ABS UNITC-*+1 NUMBER IN THE LIST * * * DADTR ROUTINE TO TRANSLATE A TRACK ADDRESS INTO CYL,HEAD * UNIT TO BE STORED AT: * * CYL AT: PT#TR * HEAD AT: H#AD ALSO RETURNED IN B. * UNIT AT: UN#IT ALSO RETURNED IN A. * * CALLING SEQUENCE: * * LDA TRACK SET TRACK ADDRESS IN A. * LDB MAPAD SET MAP ADDRESS IN B. * JSB DADTR CALL * RETURN A=UNIT, B=HEAD * * DADTR NOP STB H#AD SAVE THE ADDRESS INB BUMP TO THE HEAD/UNIT STA UN#IT SAVE THE TRACK ADDRESS STB UNCOU SAVE UNIT ADDRESS LDA B,I GET AND ISOLATE ALF # HEADS PER CYL AND M17 STA PT#TR SAVE IT CLB DIVIDE # TRACKS LDA UN#IT BY DIV PT#TR NUMBER OF HEADS/CYL ADA H#AD,I ADD BASE CYLINDER ADDRESS STA PT#TR SET THE CYLINDER ADDRESS BLF,BLF PUT HEAD ADDRESS IN IT'S PLACE ADB UNCOU,I ADD THE BASE HEAD ADDRESS LDA B PUT INTO A TO AND M74C ISOLATE STA H#AD STORE IT AS PROMISED SWP GET UNIT FROM LOW B AND M377 ISOLATE STA UN#IT STORE IT AS PROMISED JMP DADTR,I RETURN A= UNIT, B=HEAD * * STATW RETURNS STATUS AS FOLLOWS: * * STATB FULL STATUS 1 WORD * A ERROR CODE (MAX=27) FROM STATUS 1 * ZB@:=2 CHARACTER ASCII COMMAND. * :=P1 * :=P2 * :=P3 * :=FLAG AS TO WHAT TO DO WITH MESSAGES. * 0 = PRINT MESSAGES ON LU 1(CAME FROM SYSTEM) * NONZERO = RETURN MESS.TO USER(CAME FROM *MESSS*) * ******************************************************************* * SKP CMD NOP P1 NOP P2 NOP P3 NOP CONLU NOP * $$CMD NOP JSB RMPAR GET THE PROGRAM'S DEF *+2 PARAMETERS. DEF CMD * JSB $LIBR NOP * CLA SET PRIORITY OF $$CMD STA XPRIO,I TO ZERO(HIGHEST). LDA OPCDA STA TEMP1 SET UP COMMAND POINTER. LDA OPCDJ STA TEMP2 SSET UP COMMAND SUBROUTINE POINTER. LDB CMD STB STOP SET UP ILLEGAL COMMAND STOP. * M0030 CPB TEMP1,I GO SCAN JMP M0040 FOR THE ISZ TEMP1 COMMAND ISZ TEMP2 PROCESSOR JMP M0030 SUBROUTINE. * OPCDA DEF *+1 ASC 3,LUEQTO STOP NOP OPCDJ DEF *+1,I DEF LUPR DEF EQ.ST DEF CH.TO DEF OPER SKP * * M0040 JSB TEMP2,I GO PROCESS COMMAND. * JSB $LIBX GO UNPRIVILEGED. DEF *+1 DEF *+1 * SZA,RSS IF NO MESSAGE, JMP LL9 THEN END PROGRAM. * STA IBUFL IF MESSAGE, STA BUFL THEN INA SAVE STA IBUFA MESSAGE STA BUFA POINTERS. * LDB CONLU CHECK IF TERMINAL SZB IS THE SYSTEM JMP LL8 CONSOLE. * JSB EXEC IF TERMINAL IS SYSTEM CONSOLE, DEF *+5 THEN SEND MESSAGES TO LU 1. DEF .2 DEF .1 IBUFA NOP IBUFL NOP JMP LL9 * LL8 JSB EXEC IF TERMINAL IS NOT SYSTEM CONSOLE, DEF *+5 THEN RETURN MESSAGE TO USER. DEF .14 DEF .2 BUFA NOP BUFL NOP * LL9 JSB EXEC RETURN TO CALLER DEF *+4 OR TO SYSTEM. DEF .6 DEF ZERO DEF .1 JMP $$CMD * ZERO NOP SKP * EQ.ST NOP LDA P1 JSB IODNS CHECK P2 AND SET EQT ADDRESSES. JMP EQER LDB P2 CHECK PARAMETER #2. LDA EQT4,I GET EQT CHANNEL WORD. CLE,SSB,RSS IF P2=-1, OUTPUT EQT STATUS JMP EQST1 OTHERWIZE, SET BUFFERING BIT IN EQT. * JSB $CVT1 OUTPUT THE EQT STATUS. STA EQMS1 CONVERT THE CHANNEL NUMBER. * LDA EQT4,I CONVERT ASR 6  UNIT #. AND B37 JSB $CVT1 STA EQMS5 LDA EQT4,I SET LDB EQBLK D (FOR DMA CHANNEL) RAL,SLA OR LDB EQBD 0 STB EQMS3 LDB EQBLK SET SSA B (FOR AUTOMATIC BUFFERING) LDB EQBB OR STB EQMS4 0 LDA EQT5,I SET RAL,RAL AVAILABILITY AND .3 STATUS ADA EQBLK (0,1,2,OR3) STA EQMS6 LDA EQT5,I CONVERT ALF,CLE,ALF EQUIPMENT ADA B3000 TYPE (SET HIGH BITS TO JSB $CVT1 FOOL LEADING BLANK GENERATOR) STA EQMS2 DVRNN. LDA EQMSA (A) = ADDRESS OF REPLY JMP EQ.ST,I RETURN. * EQST1 ERB ROTATE BIT 1 TO E RAL,RAL AND PUT IN ERA,RAR 14 OF EQT4 STA EQT4,I AND RESTORE CLA =0 NO RETURN MESSAGE JMP EQ.ST,I * EQER LDA $ERIN 'INPUT ERROR' JMP EQ.ST,I RETURN. * EQMSA DEF *+1 DEC -20 ASC 1, EQMS1 NOP I/O CHANNEL # EQBD ASC 2, DVR EQMS2 NOP EQUIP TYPE CODE EQMS3 NOP D OR 0 EQMS4 NOP B OR 0 ASC 1, U EQMS5 NOP UNIT # EQMS6 NOP AVAILABILITY * EQBLK ASC 1, 0 EQBB ASC 1, B * .2 DEC 2 .3 DEC 3 .6 DEC 6 .14 DEC 14 B37 OCT 37 * TEMP1 NOP TEMP2 NOP SKP * **************************************************************** * * 'LOGICAL UNIT' STATEMENT * * FORMAT: LU,P1(,P2(,P3)) WHERE: * * P1 = LOGICAL UNIT # * P2 = 0, EQT ENTRY #, OR NOT PRESENT * P3 = SUBCHANNEL # OR NOT PRESENT IN WHICH * CASE IT DEFAULTS TO ZERO * * ACTION: 1) P2 AND P3 NOT INPUT; THE ASSIGNMENT OF * LOGICAL UNIT P1 IS PRINTED AS: * ' LU #P1 = EXX SYY D ' * WHERE: * P1=LOGICAL UNIT NUMBER * XX=EQT NUMBER * 0 YY=SUBCHANNEL NUMBER * D=IF PRESENT, THE LU IS DOWN. * 2) P2 = 0; THE ASSIGNMENT IS RELEASED, * I.E, THE CORRESPONDING * WORD IN THE DEVICE * REFERENCE TABLE (DRT) * IS SET = 0. * 3) N2 # 0 THE LU'S ASSIGNMENT IS CHANGED TO POINT * TO THE NEW EQT AND SUBCHANNEL. ANY I/O * ASSOCIATED WITH THE OLD EQT AND SUBCHANNEL * (DEVICE)IS TRANSFERRED TO THE NEW DEVICE. * * THE FOLLOWING LOCATIONS ARE USED AS TEMPORARIES BY LUPR: * := LU NUMBER := P3,P2 NEW SUBCH-EQT WORD * :=DRT WORD 1 ADDRESS :=DRT WORD 2 ADDRESS * :=EQT1 ADDRESS OF OLD :=NEW DEVICE'S EQT NUMBER * DEVICE * :="NEW DEVICE'S EQT IS :=NEW DEVICE SPLIT SUB. * DOWN" FLAG. * :=NEW DEVICE'S MAJOR LU * :#0 INITIATE REQUEST :#0 MORE THAN ONE LU FOR * ON NEW DEVICE UP OLD DEVICE * :=SEE SUB. SDRT2 * :=OLD SUBCH-EQT WORD :=OLD DEVICE MAJOR-LU * :=OLD DEVICE MAJOR-LU :=OLD DEVICE MAJOR-LU * DRT WORD 1 ADDRESS DRT WORD 2 ADDRESS * :=NEW DEVICE MAJOR-LU :=NEW DEVICE MAJOR-LU * DRT WORD 1 ADDRESS DRT WORD 2 ADDRESS * **************************************************************** * SKP LUPR NOP LDA P1 SET A=LU. LDB P2 IF P2 = -1, THEN GO CPB M1 PRINT CURRENT ASSIGNMENT. JMP LUPR0 * LDA B AND B377 SAVE LOWER 8 BITS STA P2 OF P2 AS EQT LDA P3 ADD IN LOWER AND B37 5 BITS OF P3 LSL 11 AC SUBCHANNEL ADA P2 AND SAVE AS NEW.u STA P2 SUBCHANNEL-EQT WORD. * LDA P1 CPA .2 PREVENT JMP LUER REASSIGNMENT CPA .3 OF LU 2 JMP LUER OR LU 3. * LUPR0 CMA,CLE,INA,SZA,RSS ILLEGAL LU NUMBER JMP LUER IF THE LU IS LESS ADA LUMAX THEN 1 OR GREATER CCA,SEZ,RSS THEN LUMAX. JMP LUER * ADA P1 SAVE ADA DRT DRT WORD STA DRT1A 1 AND ADA LUMAX WORD 2 STA DRT2A ADDRESSES. * CCE,INB,SZB,RSS IF P2=-1, THEN GO(SET E=1 FOR LUPR3) JMP LUPR3 PRINT CURRENT ASSIGNMENT. * LDB DRT PREVENT CLE,INB ASSIGNMENT(CLEAR E) DLD B,I OF ANY OTHER CPB P2 DEVICE SZB,RSS TO CPA P2 LU 2 JMP LUER OR 3. SKP * LDA P2 CONSTRUCT I/O AND B174K SUBCHANNEL WORD ELA,RAL FOR NEW DEVICE(E WAS ALF,RAL CLEARED)WITH LOWER CLB,SEZ BITS IN BITS 2-5 ADA B20K AND UPPER BIT IN STA WORD2 BIT 13(CLEAR B REG). * STB NINTF CLEAR "NEW DEVICE I/O INITIATE" FLAG. STB TTEMP CLEAR "NEW DEVICE EQT IS DOWN" FLAG. * LDA DRT1A,I SAVE AND C3700 OLD SUBCH-EQT STA OSBEQ WORD AND AND B77 EQT1 SZA,RSS JMP LUP25 ADA M1 OF MPY .15 OLD(CLEAR B REG.) ADA EQTA DEVICE'S LUP05 STA OEQT1 EQT. * LDA P2 CHECK LEGALITY OF AND B77 N2(NEW EQT)AND STA NEQT# SZA,RSS SET THE EQT JMP LUPR2 JSB IODNS ADDRESSES. JMP LUER * * SPECIAL TEST TO SEE IF MOVING I-O TO A DISK.IF SO, ERROR. * LDA EQT1 IS NEW ADA .4 DEVICE A LDA A,I AND B36K DISK? CPA B14K JMP LU100 YES, SwXO GO DO CHECK. * **************************************************************** * DETERMINE IF THE OLD DEVICE IS UP OR DOWN. **************************************************************** * LUPR1 LDA DRT2A,I CHECK IF OLD SSA DEVICE IS JMP DNXX UP OR DOWN. SKP **************************************************************** * OLD DEVICE IS UP. IS THERE MORE THAN ONE LU FOR IT? **************************************************************** UPXX LDA LUMAX SET UP TO SCAN THE LUS CMA,INA STA XLUS IF COUNT GOES TO ZERO THERE IS BUT ONE. LDB DRT GET ADDRESS OF THE FIRST ONE LUCO LDA B,I GET AN ENTRY AND C3700 DROP POSSIBLE LOCK BITS CPA OSBEQ IF NOT THE SAME CPB DRT1A OR IF SAME ENTRY INB,RSS SKIP TO GO ROUND AGAIN JMP MLUS ELSE THERE ARE MORE THAN ONE * ISZ XLUS COUNT DOWN THE ENTRIES JMP LUCO AROUND WE GO *************************************************************** * IF THE DEVICE IS UP AND HAS MORE THAN ONE LU THEN ITS * QUEUE IS NOT MOVED. THIS PREVENTS UNWANTED LOSS OF DATA * CAUSED BY UNRELATED LU CHANGES. *************************************************************** * * DETERMINE IF THE NEW DEVICE IS UP OR DOWN. **************************************************************** MLUS LDA NEQT# CHECK IF NEW SZA,RSS DEVICE IS THE JMP UPBIT BIT BUCKET. * JSB CKNLU CHECK IF NEW DEVICE IS UP OR DOWN. JMP UPDN NEW DEVICE IS DOWN. ISZ TTEMP NEW DEVICE'S EQT IS DOWN. **************************************************************** * THE OLD AND NEW DEVICE ARE UP OR THE OLD DEVICE IS UP * AND THE NEW DEVICE'S EQT IS DOWN. SKP ******************************************************************* UPUP LDA P1 NEW DEVICE IS UP. CPA .1 CHECK IF OLD JMP UPLU1 DEVICE IS LU 1.@ * UPUP5 LDA XLUS IF ANOTHER LU EXISTS SZA THEN JMP UPMU DON'T MOVE THE QUEUE * LDB OEQT1,I UNLINK I/O REQUESTS FROM THE RBL,CLE,ERB OLD DEVICE. SKIP THE SZB,RSS LDB OEQT1 LDA DRT2A FIRST I-O REQUEST. JSB $UNLK DEF OSBEQ * LDB DRT2A,I RESET WORD 2 OF THE I/O REQUESTS JSB FXWD2 TO THE SUBCHANNEL OF THE NEW DEVICE. LDA OEQT1 LDB DRT2A,I LINK THE I/O REQUESTS JSB $XXUP ON THE NEW DEVICE. STB DRT2A,I CLEAR UP THE CURRENT LU STA NINTF SET THE MUST START NEW I/O FLAG UPMU LDA TTEMP IS THE NEW DEVICE'S SZA,RSS EQT DOWN? JMP LUP50 NO, SO CONTINUE. * LDB EQT1,I YES, SO RBL,CLE,ERB UNSTACK SZB,RSS NORMAL USER LDB EQT1 I/O(SKIP FIRST JMP DNDE5 ENTRY)AND CONTINUE. * XLUS NOP SKP UPLU1 LDA EQT5,I GET DEVICE AND B374C TYPE OF THE SZA,RSS NEW DEVICE AND SEE JMP UPLU2 IF IT IS LEGAL CPA B2400 (00 OR 05 SUB 0) RSS FOR A SYSTEM JMP LUER CONSOLE. LDA WORD2 SZA JMP LUER * UPLU2 LDA TTEMP MAKE SURE NEW DEVICE'S SZA EQT IS NOT DOWN. JMP LUER LDA EQT1 SET NEW SYSTEM CONSOLE STA SYSTY ADDRESS IN BASE PAGE. JMP UPUP5 GO TRANSFER I/O. * * UPBIT LDA P1 CHANGING AN UP DEVICE TO CPA .1 THE BIT BUCKET. ERROR JMP LUER IF THE OLD DEVICE IS JMP UPUP5 THE SYSTEM CONSOLE. SKP ****************************************************************** * THE OLD DEVICE IS UP AND THE NEW DEVICE IS DOWN. ********************************************************************* UPDN STB TTEMP SAVE LU# OF FIRST LU(MAJOR LU)OF NEW DEVICE. STA NDML2 SAVE DRT WORD 2 ADDRESS OF NEW-MAJOR-LU.=Q ADB M1 COMPUTE NEW- ADB DRT MAJOR-LU STB NDML1 DRT WORD 1. * LDB P1 CHECK IF THIS CPB .1 WILL SET LU JMP LUER 1 DOWN. * LDB TTEMP CHECK IF LU IS CMB,INB LOWER THEN THE ADB P1 MAJOR LU FOR SSB,RSS THE NEW DOWNED JMP UPDN5 DEVICE. * LDB A,I LU IS BELOW NEW DEVICE'S MAJOR LU. STB DRT2A,I MOVE I/O FROM MAJOR LU TO LU. LDB XLUS IF CURRENT DEVICE STILL HAS AN LU SZB THEN JMP DNDN6 SKIP THE MOVE * LDB DRT2A CHASE DOWN THIS DOWN I/O JSB CHASE QUEUE TO ITS END. LDA B * LDB OEQT1,I UNLINK I/O REQUESTS FOR THE RBL,CLE,ERB OLD DEVICE AND ADD TO SZB,RSS LDB OEQT1 JSB $UNLK THE I-O QUEUE. SKIP FIRST ENTRY. DEF OSBEQ JMP DNDN6 GO MODIFY LU'S FOR THE NEW DEVICE. SKP UPDN5 LDB XLUS IF WE STILL HAVE A LU FOR THIS DEVICE SZB THEN JMP UPDN6 SKIP THE MOVE * LDB NDML2 NEW DEVICE'S MAJOR LU IS BELOW LU. JSB CHASE CHASE DOWN THIS I-O QUEUE LDA B TO ITS END. * LDB OEQT1,I UNLINK I/O REQUESTS RBL,CLE,ERB FOR THE OLD DEVICE SZB,RSS (SKIP FIRST REQUEST)AND LDB OEQT1 ADD TO DOWNED LU I/O JSB $UNLK QUEUE. DEF OSBEQ * UPDN6 LDA TTEMP SET ADA MSIGN THE LU STA DRT2A,I DOWN. JMP LUP50 GO FINISH. SKP **************************************************************** * THE OLD DEVICE IS DOWN. ******************************************************************* * DETERMINE IF THE NEW DEVICE IS UP OR DOWN. * DNXX LDA NEQT# CHECK IF SZA,RSS NEW DEVICE JMP DNUP IS BIT BUCKET. * JSB CKNLU CHECK IF NEW DEVICE IS UP OR DOWN. JMP DNDN NEW DEV}640ICE IS DOWN. JMP DNDNE NEW DEVICE'S EQT IS DOWN. **************************************************************** * THE OLD DEVICE IS DOWN AND THE NEW DEVICE IS UP(OR BIT BUCKET) ********************************************************************** DNUP JSB DETOL DETERMINE THE OLD-MAJOR-LU. LDB ODML2,I RESET WORD 2 OF I/O REQUESTS JSB FXWD2 TO THE SUBCHANNEL OF THE NEW DEVICE. * LDA OEQT1 LDB ODML2,I LINK OLD DEVICE'S I/O REQUESTS JSB $XXUP ON THE NEW DEVICE. STA NINTF * JSB FOLDD FIX ALL OLD DOWNED LU'S THAT NEED IT. JMP LUP52 ****************************************************************** * THE OLD DEVICE IS DOWN AND THE NEW DEVICE'S EQT IS DOWN. ********************************************************************* DNDNE JSB DETOL DETERMINE OLD DEVICE'S MAJOR-LU LDA OEQT1 LINK OLD DEVICE'S I/O REQUESTS ON THE LDB ODML2,I NEW DEVICE'S EQT. JSB $XXUP STA NINTF * JSB FOLDD FIX OLD DOWNED DEVICE'S LU'S THAT NEED IT. * 6 LDB EQT1 UNLINK ANY NORMAL USER DNDE5 CLA I/O FROM THE NEW DEVICE'S EQT. JSB $UNLK DEF P2 JMP LUP50 SKP **************************************************************** * THE OLD AND NEW DEVICES ARE DOWN. ********************************************************************* DNDN STB TTEMP SAVE NEW DEVICE MAJOR-LU AND STA NDML2 ITS DRT WORD 2 ADDRESS. ADB M1 SAVE ITS ADB DRT DRT WORD STB NDML1 2 ADDRESS. * JSB DETOM DETERMINE THE OLD DEVICE'S MAJOR-LU. * LDB TTEMP CHECK IF NEW CMB,INB NEW DEVICE'S MAJOR ADB P1 LU IS < LU. SSB,RSS LU < NEW DEVICE'S MAJOR LU. JMP DNDN5 * DNDN9 LDB DRT2A LU IS BELOW NEW DEVICE'S MAJOR LU. JSB CHASE CHASE DOWN THE LU'S I/O LDA NDML2,I QUEUE TO ITS END AND RAL,CLE,ERA ADD THERE THE NEW DEVICE'S XSA B,I MAJOR-LU I/O QUEUE. * LDA OMJLU IF OLD MAJOR LU EQUALS TO CPA P1 LU, THEN FIX UP OLD DEVICE'S RSS LU'S TO INCLUDE THE NEW OLD- JMP DNDN6 MAJOR-LU. OTHERWIZE, CONTINUE. * LDA OSBEQ A=OLD SUBCHANNEL-EQT WORD. LDB DRT1A INB B=LU WORD 1 ADDRESS + 1. JSB FXOLD GO FIX OLD DEVICE'S LU'S. * DNDN6 LDA P2 MODIFY ALL LU'S STA SSBEQ FOR NEW DEVICE LDA P1 TO POINT TO IOR MSIGN LU. LDB NDML1 CLE JSB SDRT2 JMP LUP50 SKP DNDN5 SZB,RSS CASE WHERE OLD AND NEW DEVICES ARE JMP LUP60 BOTH DOWN AND EQUAL. * LDB NDML2 LU > NEW DEVICE MAJOR-LU. JSB CHASE CHASE DOWN THE NEW MAJOR-LU'S. CCA I/O QUEUE TO ITS END. * ADA DRT CALCULATE DRT ADA OMJLU WORD 2 OF STA ODML1 OLD MAJOR-LU. * ADA LUMAX LINK OLD MAJOR LU I/O LDA A,I M RAL,CLE,ERA QUEUE TO END OF NEW XSA B,I MAJOR I/O QUEUE. * LDA TTEMP MAKE LU POINT TO IOR MSIGN NEW DEVICE MAJOR-LU. STA DRT2A,I * LDA OMJLU IF LU = OLD CPA P1 MAJOR-LU, RSS THEN CONTINUE, JMP LUP50 ELSE DONE. * LDA OSBEQ FIX OLD LDB ODML1 DEVICE'S INB LU'S. JSB FXOLD SKP ****************************************************************** * FINISH SWITCHING LU ******************************************************************* LUP50 LDA DRT1A,I SET UP DRT AND B3700 WORD 1 WITH ADA P2 NEW DEVICE AND STA DRT1A,I OLD LOCK FLAG. * LUP52 LDA NINTF CHECK IF AN I/O SZA,RSS OPERATION MUST BE JMP LUP55 INITIATED ON THE NEW EQT. CPA $DMEQ YES, IF THE NEW DEVICE IS THE BIT BUCKET, JMP LUP80 THEN SET A FLAG FOR IOCX. JSB $DLAY IF NOT,SET A TIMEOUT FOR INITIATION. * LUP55 LDA .4 SCHEDULE ANY WAITERS ON JSB $SCD3 DOWNED DEVICES. LDA OEQT1 SET UP THE OLD DEVICE'S JSB $ETEQ EQT ADDRESSES, CHECK BUFFER JSB $CKLO LIMITS AND SCHED WAITERS. * LDA P1 IF LU CHANGED WAS CPA .1 SYSTEM CONSOLE THEN JMP LUP70 ISSUE A MESSAGE. * LUP60 CLA JMP LUPR,I OTHERWIZE, RETURN. * LUP70 CLA ISSUE '**' STA CONLU MESSAGE TO LDA NSYSM NEW SYSTEM JMP LUPR,I CONSOLE. * LUP80 ISZ $BITB SET A FLAG FOR IOCX SO THAT JMP LUP55 IT WILL CLEAN OUT THE BIT BUCKET. * LUPR2 LDA $DMEQ SET UP DUMMY JSB $ETEQ EQT ADDRESES FOR JMP LUPR1 THE BIT BUCKET. * LUP25 LDA $DMEQ JMP LUP05 * LUER LDA $ERIN JMP LUPR,I 'INPUT ERROR' SKP * SPECIAL TEST TO DISALLOW SWTCHING AN LU TO A DISK IF THE * LU HAS I/O STA]CKED ON IT(OR IT'S EQT). * LU100 LDA DRT2A,I DOES THE LU RAL,CLE,ERA HAVE ANY I/O SZA HUNG ON IT? JMP LUER YES, ISSUE ERROR MESSAGE. * SEZ IF NO I/O AND LU IS DOWN, JMP LUPR1 THEN ALLOW SWTCH. LDA OEQT1,I OTHERWIZE, IF UP AND NO I/O IS SZA,RSS HUNG ON THE OLD EQT, THEN JMP LUPR1 ALLOW SWTCH. * JMP LUER IF I-O HUNG ON EQT,THEN ISSUE ERROR MESS. * ****************************************************************** * DISPLAY LU AND IT'S STATUS ****************************************************************** * LUPR3 LDA P1 GET AND JSB $CVT1 SAVE THE STA LUMSG+2 ASCII LU #. LDA DRT1A,I GET AND AND B77 SAVE JSB $CVT1 THE ASCII STA LUMSG+5 EQT #. LDA DRT1A,I CHECK IF AND B174K A SUBCHANNEL CCE,SZA IS SPECIFIED. JMP LUP14 LDA DBLBK IF SUBCHANNEL=0, STA LUMSG+6 THEN DO NOT DISPLAY JMP LUP15 THE SUBCHANNEL. * LUP14 LDB BLS IF SUBCHANNEL#0, STB LUMSG+6 THEN DISPLAY ALF,RAL THE ASCII JSB $CVT1 SUBCHANNEL. LUP15 STA LUMSG+7 LDB DBLBK CHECK IF LDA DRT2A,I THE DEVICE SSA IS UP OR LDB EQBD DOWN. IF STB LUMSG+8 DOWN, LDA LUMGA PRINT A "D". JMP LUPR,I RETURN. SKP * * VARIABLES, CONSTANTS AND BUFFERS FOR LUPR * NSYSM DEF *+1 DEC -2 ASC 1,** * LUMGA DEF *+1 DEC -18 LUMSG ASC 9,LU #N1 = EXX SYY * B174K OCT 174000 B176K OCT 176000 B20K OCT 20000 B14K OCT 14000 B36K OCT 36000 B77 OCT 77 B377 OCT 377 B3700 OCT 3700 C3700 OCT 174077 MSIGN OCT 100000 .1 DEC 1 .4 DEC 4 .15 DEC 15 M1 DEC -1 * DBLBK ASC 1, BLS ASC 1, S * DRT1A NOP DRT2A NOP NINTF NOP TTEMP NOP OEQT1 NOP NEQT# NOP gU WORD2 NOP OSBEQ NOP OMJLU NOP OLD DEVICE MAJOR LU. ODML1 NOP OLD DEVICE MAJOR-LU DRT WORD 1 ADDRESS. ODML2 NOP OLD DEVICE MAJOR-LU DRT WORD 2 ADDRESS. NDML1 NOP NEW DEVICE MAJOR-LU DRT WORD 1 ADDRESS. NDML2 NOP NEW DEVICE MAJOR-LU DRT WORD 2 ADDRESS. SKP ***************************************************************** * * SUBROUTINE CKNLU: * * CKNLU DETERMINES IF THE DEVICE(LU) OR THE EQT POINTED TO BY * THE SUBCHANNEL-EQT WORD IS UP OR DOWN. * * CALLING SEQUENCE: * := SUBCHANNEL IN BITS 11-15, EQT IN BITS 0-5. * :=ADDRESS OF FIFTH EQT WORD. * JSB CKNLU * * RETURN: * (P+1) DEVICE IS DOWN. * (P+2) EQT IS DOWN. * (P+3) DEVICE IS UP OR NO DEVICE FOUND. * ALL REGISTERS ARE VIOLATED. * AT (P+1): :=MAJOR LU # OF DOWNED DEVICE. * :=MAJOR LU DRT WORD 2 ADDRESS. * USES SDRT2 AS A TEMPORARY. * **************************************************************** * CKNLU NOP LDA EQT5,I CHECK IF RAL,SLA THE EQT JMP CKNL0 IS UP OR SSB DOWN. JMP CKNL2 THE EQT IS DOWN. * CKNL0 LDB LUMAX CMB,INB STB SDRT2 LDB DRT CKNL1 LDA B,I DETERMINE AND C3700 IF THE CPA P2 NEW JMP CKNL7 DEVICE INB EXISTS. ISZ SDRT2 JMP CKNL1 JMP CKNL9 THE DEVICE DOES NOT EXIST. * CKNL7 ADB LUMAX DETERMINE IF THE DEVICE LDA B,I IS UP OR DOWN. SSA JMP CKNL8 CKNL9 ISZ CKNLU THE DEVICE IS UP, RETURN TO P+3. CKNL2 ISZ CKNLU THE EQT IS DOWN, RETURN TO P+2. JMP CKNLU,I RETURN. * CKNL8 STB A THE DEVICE IS DOWN. LDB LUMAX SET =DRT WORD 2 ADDRESS. ADB SDRT2 SET =LU #. INB JMP CKNLU,I RETURN TO P+1. "1 SKP **************************************************************** * SUBROUTINE SDRT2: * * SDRT2 WILL STORE THE A REG IN DRT WORD 2 FOR ANY DRT ENTRIES * WHICH CORRESPOND TO THE SUBCHANNEL AND EQT GIVEN IN P2. IF * ON ENTRY E=1, THEN SDRT2 WILL SCAN ONLY TO THE FIRST ENTRY * CORRESPONDING TO P2. IF E=0, THEN SDRT2 WILL SCAN THE ENTIRE * DRT FROM THE GIVEN ENTRY TO ITS END. * * CALLING SEQUENCE: * :=SUBCHANNEL-EQT WORD FOR THE LU'S TO SCAN FOR: * BITS 5-0=EQT * BITS 15-11=SUBCHANNEL * :=DRT WORD 1 ADDRESS FROM WHICH TO BEGIN SCAN. * :=CONTENTS TO STORE INTO DRT WORD 2. * :=0 SCAN TO END OF DRT. * :=1 SCAN ONLY FOR FIRST ENTRY. * JSB SDRT2 * USES TEMPORARY LOCATIONS CKNLU,SDRT8,SDRT9 * RETURN: * NO REGISTERS ARE SAVED ON EXIT. * ON EXIT: * :=NEXT DRT WORD 1 ADDRESS TO BE SCANNED. * := LUMAX - LAST LU# SCANNED. ***************************************************************** * SDRT2 NOP STA CKNLU SAVE CONTENTS TO STORE INTO DRT WORD 2. LDA LUMAX SET ADA DRT CMA,INA UP ADA B STA SDRT9 COUNTER. STB SDRT8 SAVE ADDRESS OF FIRST DRT ENTRY TO SCAN. SZA,RSS JMP SDRT2,I * SDR29 LDA SDRT8,I SET CONTENTS AND C3700 OF DRT WORD 2 CPA SSBEQ AND COMPARE TO JMP SDR22 SUBCHANNEL-EQT WORD. SDR25 ISZ SDRT8 INCREMENT DRT ADDRESS. ISZ SDRT9 INCREMENT COUNT. JMP SDR29 CLA JMP SDRT2,I NO MORE ENTRIES, SO RETURN. * SDR22 LDB CKNLU FOUND AN ENTRY, LDA SDRT8 POSITION TO ADA LUMAX WORD 2 AND STB A,I STORE NEW CONTENTS. SEZ,RSS IF E=1, JMP SDR25 THEN CONTINUE SCAN. ISZ SDRT8 OTHERWIZE, INCREMENT DRT LDA SDRT9 ADDRESSES AND RETURN. INA JMP SDRT2,I * SDRT8 NOP SDRT9 NOP SSBEQ NOP * ********************************************************************* * * SUBROUTINE CHASE: * * CHASE WILL FIND THE END OF AN I/O QUEUE GIVEN IT'S HEAD. * * CALLING SEQUENCE: * :=ADDRESS OF HEAD OF I/O QUEUE. * JSB CHASE * * RETURN: * ALL REGISTERS ARE MODIFIED. * :=ADDRESS OF LINK WORD OF LAST I/O REQUEST. * :=0 * ******************************************************************** * CHASE NOP CHASE CHAS1 XLA B,I DOWN RAL,CLE,ERA THE LU'S SZA,RSS I/O QUEUE JMP CHASE,I TO ITS LDB A END. JMP CHAS1 SKP * ***************************************************************** * * SUBROUTINE FXWD2: * * FXWD2 CHANGES THE SUBCHANNEL IN WORD 2 OF EACH I/O REQUEST * IN THE GIVEN I/O QUEUE. * * CALLING SEQUENCE: * :=NEW SUBCHANNEL: BITS 2-5=LOWER 4 BITS * BIT 13 =UPPER BIT. * :=POINTER TO FIRST I-O REQUEST =0 IF NO REQUESTS. * JSB FXWD2 * * RETURN: * ALL REGISTERS ARE VIOLATED. * ****************************************************************** * FXWD2 NOP RBL,CLE,ERB STRIP POSSIBLE SIGN BIT. FWD21 SZB,RSS IF END OF I/O QUEUE, JMP FXWD2,I THEN EXIT. STB SDRT2 INB POSITION TO I/O XLA B,I CONTROL WORD. AND WD2SB STRIP OFF OLD SUBCHANNEL IOR WORD2 AND ADD IN NEW SUBCHANNEL. XSA B,I XLB SDRT2,I FIX NEXT I/O REQUEST. JMP FWD21 * WD2SB OCT 157703 SKP * **************************************************************** * * SUBROUTINE DETOL * * DETOL DETERMINES WHAT THE OLD DEVICE'S MAJOR-LU IS AND SETS * UP LOCATIONS OMJLU, ODML1 AND ODM)L2. * * CALLING SEQUENCE: * JSB DETOL * * RETURN: * ALL REGISTERS ARE MODIFIED. * :=OLD DEVICE'S MAJOR-LU. * :=OLD DEVICE'S MAJOR-LU DRT WORD 1 ADDRESS. * :=OLD DEVICE'S MAJOR-LU DRT WORD 2 ADDRESS. **************************************************************** * DETOL NOP JSB DETOM DETERMINE THE OLD MAJOR-LU. ADA M1 COMPUTE THE ADA DRT OLD DEVICE'S STA ODML1 MAJOR-LU'S ADA LUMAX DRT WORD 1 STA ODML2 AND 2 ADDRESSES. JMP DETOL,I RETURN. * * ********************************************************************** * * SUBROUTINE DETOM: * * DETOM RETURNS THE OLD DEVICE'S MAJOR-LU. * * CALLING SEQUENCE: * JSB DETOM * * RETURN: * :=OLD DEVICE'S MAJOR-LU. * ************************************************************************ * DETOM NOP LDA DRT2A,I DETERMINE IF LU IS RAL,CLE,ERA THE OLD MAJOR-LU. CLE,SZA,RSS IF NO QUEUE, THEN LU CCE IS THE OLD MAJOR-LU. STA B IF QUEUE ELEMENT IS < 2000, ADB B176K THEN QUEUE ELEMENT IS SEZ OLD MAJOR LU. LDA P1 IF 2000 <= QUEUE ELEMENT, THEN ELEMENT STA OMJLU IS ADDRESS AND LU IS OLD MAJOR-LU. JMP DETOM,I RETURN. SKP * ***************************************************************** * * SUBROUTINE FOLDD: * * FOLDD WILL FIX THE DRT WORD 2'S OF THE OLD DEVICE'S LU'S. * * CALLING SEQUENCE: * :=THE OLD DEVICE'S MAJOR-LU. * :=THE OLD DEVICE'S MAJOR-LU DRT WORD 1 ADDRESS. * JSB FOLDD * * RETURN: * ALL REGISTERS ARE MODIFIED. ***************************************************************** * FOLDD NOP LDA DRT1A,I SET UP DRT WORD 1 AND B3700 OF LU WITH THE NEW ADA P2W DEVICE AND OLD STA DRT1A,I LOCK FLAG. * CLA SET DRT WORD 2 OF STA DRT2A,I LU TO UP STATE. * LDA OMJLU IF LU=OLD DEVICE MAJOR-LU CPA P1 THEN FIX LU'S FOR THE RSS OLD DEVICE. JMP FOLDD,I OTHERWIZE, RETURN. LDA OSBEQ OLD MAJOR LU. LDB ODML1 INB JSB FXOLD FIX LU'S FOR THE OLD DEVICE. JMP FOLDD,I RETURN. SKP * ***************************************************************** * * SUBROUTINE FXOLD: * * FXOLD WILL CREATE A NEW MAJOR-LU FOR THE OLD DEVICE, POINT * ANY OTHER LU'S FOR THIS DEVICE TO THE MAJOR-LU, AND SET ALL * THESE LU'S DOWN. * * CALLING SEQUENCE: * :=SUBCHANNEL-EQT WORD OF THE LU TO SCAN FOR. * :=DRT WORD 1 ADDRESS TO BEGIN SCAN. * JSB FXOLD * CALLS SUBROUTINE SDRT2 * * REUTRN: * NO REGISTERS ARE SAVED. * ***************************************************************** * FXOLD NOP STA SSBEQ LDA MSIGN CREATE A NEW CCE OLD-MAJOR- JSB SDRT2 LU. SZA,RSS IF A=0, THEN NO OTHER JMP FXOLD,I LU'S ON OLD DEVICE. * ADA LUMAX OTHERWIZE, POINT IOR MSIGN ALL OTHER LU'S LDB SDRT8 FOR OLD DEVICE CLE TO THE NEW JSB SDRT2 OLD-MAJOR-LU. JMP FXOLD,I RETURN. SKP * **************************************************************** * * ' DEVICE TIME-OUT PARAMETER ' STATEMENT * * FORMAT: TO,P1,P2 WHERE * * P1 = EQT # * P2 = TIME-OUT PARAMETER OR -1 * * ACTION: IF P2 = -1, A SECOND PARAMETER WAS NOT * RECEIVED FROM THE MESSAGE PROCESSOR; * THEREFORE, PRINT THE CURRENT TIME-OUT * PARAMETER OF DEVICE P1. * * BOTH P1 AND P2 PRESENT, ASSIGN P2 AS THE * NEW TIME-OUT PARAME.TER FOR DEVICE P1. * ***************************************************************** * CH.TO NOP LDA P1 GET EQT NUMBER AND JSB IODNS CHECK VALIDITY. JMP TOER INPUT ERROR. LDB P2 LOOK AT P2 SZB,RSS IF N2 ZERO, DISABLE JMP CHTO2 TIME-OUT FOR DEVICE * INB,SZB IF N2 = -1, OUTPUT T-O PARAMETER JMP CHTO1 OTHERWISE, ENTER NEW T-O VALUE * LDA EQT14,I CONVERT T-O PARAMETER CCE,SZA TO DECIMAL ASCII B3000 CMA JSB $CVT3 LDB A,I GET THE HIGH WORD ADB B164C ADD '=' - 'BLANK' STB TOMS+3 CCE,INA DLD A,I STORE IN MESSAGE DST TOMS+4 * LDA P1 CONVERT EQT # JSB $CVT1 TO DECIMAL ASCII STA TOMS+2 STORE INTO MESSAGE LDA TOMSA JMP CH.TO,I RETURN. SKP CHTO1 CMB,INB ERROR IF ATTEMPT LDA EQT5,I TO SET TYPE 0 OR 5 AND B374C DEVICE TIME-OUT SZA VALUE TO LESS THAN CPA B2400 FIVE SECONDS. RSS JMP CHTO2 OTHERWISE, STORE * LDA .500 NEW TIME-OUT ADA B VALUE. SSA,RSS JMP TOER * CHTO2 STB EQT14,I CLA JMP CH.TO,I RETURN WITHOUT MESSAGE. * TOER LDA $ERIN 'INPUT ERROR' JMP CH.TO,I RETURN. * TOMSA DEF *+1 DEC -12 TOMS ASC 2,TO# NOP ASC 1, = NOP NOP * .500 DEC 500 B164C OCT 16400 B2400 OCT 2400 B374C OCT 37400 SKP OPER NOP LDA $OPER JMP OPER,I * IODNS NOP STA B IF CMB,INB,SZB EQT SSA NUMBER CCB,RSS IS ZERO ADB EQT# SSB THEN TAKEE, JMP IODNS,I ERROR EXIT. JSB $CVEQ OTHERWIZE, SET EQT ENTRY ADDRESSES. ISZ IODNS JMP IODNS,I RETURN. * A EQU 0 B EQU 1  * $OPER DEF *+1 DEC -12 ASC 6,OP CODE ERR $ERIN DEF *+1 DEC -12 ASC 6,INPUT ERROR HED ** SYSTEM BASE PAGE COMMUNICATION AREA ** XI EQU 1647B . EQU 1650B ESTABLISH ORIGIN OF AREA * * SYSTEM TABLE DEFINITION * * EQTA EQU .+0 FWA OF EQUIPMENT TABLE EQT# EQU .+1 # OF EQT ENTRIES DRT EQU .+2 FWA OF DEVICE REFERENCE TABLE LUMAX EQU .+3 # OF LOGICAL UNITS (IN DRT) INTBA EQU .+4 FWA OF INTERRUPT TABLE INTLG EQU .+5 # OF INTERRUPT TABLE ENTRIES TAT EQU .+6 FWA OF TRACK ASSIGNMENT TABLE KEYWD EQU .+7 FWA OF KEYWORD BLOCK * * I/O MODULE/DRIVER COMMUNICATION * EQT1 EQU .+8 ADDRESSES EQT2 EQU .+9 EQT3 EQU .+10 OF EQT4 EQU .+11 EQT5 EQU .+12 CURRENT EQT6 EQU .+13 EQT7 EQU .+14 15-WORD EQT8 EQU .+15 EQT9 EQU .+16 EQT EQT10 EQU .+17 EQT11 EQU .+18 ENTRY EQT12 EQU .+81 EQT13 EQU .+82 EQT14 EQU .+83 EQT15 EQU .+84 * CHAN EQU .+19 CURRENT DMA CHANNEL # TBG EQU .+20 I/O ADDRESS OF TIME-BASE CARD SYSTY EQU .+21 EQT ENTRY ADDRESS OF SYSTEM TTY * * SYSTEM REQUEST PROCESSOR /'EXEC' COMMUNICATION * * RQCNT EQU .+22 # OF REQUEST PARAMETERS -1 RQRTN EQU .+23 RETURN POINT ADDRESS RQP1 EQU .+24 ADDRESSES RQP2 EQU .+25 RQP3 EQU .+26 OF REQUEST RQP4 EQU .+27 RQP5 EQU .+28 PARAMETERS RQP6 EQU .+29 RQP7 EQU .+30 (SET FOR MAXIMUM OF RQP8 EQU .+31 RQP9 EQU .+32 9 PARAMETERS) * * DEFINITION OF SYSTEM LISTS (QUEUES) * * SKEDD EQU .+33 'SCHEDULE' LIST, SUSP2 EQU .+35 'WAIT' LIST, SUSP3 EQU .+36 'AVAILABLE MEMORY' LIST, SUSP4 EQU .+37 'DISC ALLOCATION' LIST, SUSP5 EQU .+38 'OPERATOR SUSPEND' LIST * * DEFINITION OF EXECUTING PROGRAM ID SEGMENT' * * XEQT EQU .+39 ID SEGMENT ADDR. OF CURRENT PROG. XLINK EQU .+40 'LINKAGE' XTEMP EQU .+41 'TEMPORARY (5-WORDS) XPRIO EQU .+46 'PRIORITY' WORD XPzENT EQU .+47 'PRIMARY ENTRY POINT' XSUSP EQU .+48 'POINT OF SUSPENSION' XA EQU .+49 'A REGISTER' AT SUSPENSION XB EQU .+50 'B REGISTER' XEO EQU .+51 'E AND OVERFLOW * * SYSTEM MODULE COMMUNICATION FLAGS * * OPATN EQU .+52 OPERATOR/KEYBOARD ATTENTION FLAG OPFLG EQU .+53 OPERATOR COMMUNICATION FLAG SWAP EQU .+54 RT DISC RESIDENT SWAPPING FLAG DUMMY EQU .+55 I/O ADDRESS OF DUMMY INT. CARD IDSDA EQU .+56 DISC ADDR. OF FIRST ID SEGMENT IDSDP EQU .+57 -POSITION WITHIN SECTOR * * DEFINITION OF MEMORY ALLOCATION BASES * * BPA1 EQU .+58 FWA R/T DISC RES. BP LINK AREA BPA2 EQU .+59 LWA R/T DISC RES. BP LINK AREA BPA3 EQU .+60 FWA BKG DISC RES. BP LINK AREA LBORG EQU .+61 FWA OF RESIDENT LIBRARY AREA RTORG EQU .+62 FWA OF REAL-TIME AREA RTCOM EQU .+63 LENGTH OF REAL TIME COMMON AREA RTDRA EQU .+64 FWA OF R/T DISC RESIDENT AREA AVMEM EQU .+65 FWA OF SYSTEM AVAILABLE MEMORY BKORG EQU .+66 FWA OF BACKGROUND AREA BKCOM EQU .+67 LENGTH OF BACKGROUND COMMON AREA BKDRA EQU .+68 FWA OF BKG DISC RESIDENT AREA * * UTILITY PARAMETERS * TATLG EQU .+69 LENGTH OF TRACK ASSIGNMENT TABLE TATSD EQU .+70 # OF TRACKS ON SYSTEM DISC SECT2 EQU .+71 # SECTORS/TRACK ON LU 2 (SYSTEM) SECT3 EQU .+72 # SECTORS/TRACK ON LU 3 (AUX.) DSCLB EQU .+73 DISC ADDR OF RES LIB ENTRY PTS DSCLN EQU .+74 # OF RES LIB ENTRY POINTS DSCUT EQU .+75 DISC ADDR OF RELOC UTILITY PROGS DSCUN EQU .+76 # OF RELOC UTILITY PROGS LGOTK EQU .+77 LOAD-N-GO: LU,STG TRACK,# OF TRKS LGOC EQU .+78 CURRENT LGO TRACK/SECTOR ADDRESS SFCUN EQU .+79 SOURCE FILE LU AND DISC ADDRESS MPTFL EQU .+80 MEMORY PROTECT ON/OFF FLAG (0/1) FENCE EQU .+85 MEM PROTECT FENCE ADDRESS BKLWA EQU .+87 LWA OF MEMORY IN BACKGROUND * ORG * LENGTH OF SYSTEM COMMAND PROGRAM. END $$CMD uHFBBH =X 92060-18037 1826 S 2522 &RT3GN RTE-III ON LINE GEN.             H0125 ܮASMB,Z,R,L,C HED RT2/3GN -- MAIN FOR ON-LINE GENERATOR IFN ASSEMBLY OPTION "N" FOR RTE-II NAM RT2GN,3,90 92001-16031 REV.1826 780508 XIF IFZ ASSEMBLY OPTION "Z" FOR RTE-III NAM RT3GN,3,90 92060-16037 REV.1826 780508 XIF SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 2 SPC 1 ************************************************************ * * NAME RT2GN/RT3GN MAIN FOR ON-LINE GENERATOR * SOURCE PART # 92001-18031 / 92060-18037 * REL PART # 92001-16031 / 92060-16037 * WRITTEN BY: KFH, JH, RB, GAA * ************************************************************* SPC 3 * * DEFINE ENTRY POINTS. * * OPERATOR INPUT SUBROUTINES: * ENT PROMT PRINT COMMAND AND ACCEPT INPUT. ENT READ READ INPUT. ENT RNAME SPECIAL ENTRY TO READ SUBR. ENT YE/NO ANALYZE YES/NO RESPONSE. ENT DOCON ANALYZE INPUT FOR OCTAL VALUE. ENT GETAL SUPPLY CHAR FOR GETNA & GETOC. ENT GETNA MOVE LBUF TO TBUF. ENT GETOC LBUF CHAR FROM ASCII TO OCTAL. ENT GINIT INITIALIZE LBUF SCAN. * * DIAGNOSTIC SUBROUTINES: * ENT GN.ER PRINT DIAGNOSTIC. ENT INERR CALL ERROR AND CONTINUE. ENT IRERR CALL ERROR AND ABORT. ENT ABORT ABORT THE GENERATION. * * DISC FILE I/O SUBROUTINES: * ENT CRETF CREATE A FILE. ENT CLOSF CLOSE A FILE. ENT CLSAB CLOSE RTGEN OUTPUT FILE. ENT CHFIL CHECK FOR FILE ERRORS. ENT DRKEY WRITE ON I2NTERACTIVE DEVICE. ENT SPACE OUTPUT BLANK LINE. ENT LFOUT WRITE ONTO LIST FILE. ENT RDNAM FIND A NAM RECORD IN A FILE. ENT RDBIN READ RELOCATABLE FILE. ENT GTERM PURGE ALL FILES ON ABORT. * * CORE-IMAGE OUTPUT FILE SUBROUTINES. * ENT DISKA INCR. DISC ADDRESS. ENT DISKI INPUT CONTROL. ENT DISKO OUTPUT CONTROL. ENT DISKD I/O SUBROUTINE. * * DCB'S: * ENT IPDCB COMMAND FILE DCB. ENT LFDCB LIST FILE DCB. ENT RRDCB RELOCATABLE FILE DCB. ENT NMDCB NEW-NAM FILE DCB. ENT ECDCB ECHO DCB * * LST, IDENT, FIX-UP SUBS AND POINTERS. * ENT INLST,LSTS,LSTX,LSTE ENT TLST,PLST ENT .LST1,.LST2,.LST3,.LST4,.LST5 * ENT INIDX,IDXS,IDX ENT TIDNT,PIDNT ENT ID1,ID2,ID3,ID4,ID5,ID6,ID7,ID8,ID9,ID10,ID11 ENT ID12,ID13,ID14,ID15,ID16 * ENT FIXX,FIX,PFIX,TFIX ENT FIX1,FIX2,FIX3,FIX4 * ENT LNKX,LNK,LNKS ENT LNK1,LNK2,LNK3 * * LINKAGES FOR SEGMENT SUBR CALLS TO ANOTHER SEGMENT. * ENT LLOAD "LOAD" EXT NLOAD * ENT LOADS "LOADS" EXT LODER * ENT GENIO "GENIO" EXT GNIO ENT FWBPL EXT FWENT * ENT DSTBL "DSTBL" EXT DSTB EXT DSTB5 * ENT FSECT "FSECT" EXT FSEC EXT FSEC5 * IFZ ******* BEGIN DMS CODE ******** ENT PARTD "PARTS" EXT PARTS ******* END DMS CODE ******** XIF * * POINTERS FOR CURRENT PAGE LINKAGE IMAGE AREA. * ENT TBLNK,CPLIM ENT LRBP,URBP,IRBP ENT LBBP,UBBP,IBBP ENT CUBP,UCUBP,ICUBP,CUBPA * * MISCELLANEOUS SUBROUTINES: * ENT CONVD ENT LABDO,USER,USERS,SEGS,SYS * * MISCELLANEOUS VARIABLES: * ENT NAMRC,NAMBL,NAMOF ENT ERRLU,ATRCM,IACOM,TRCHK ENT SWRET ENT FMRR ENT DPRS2  ENT .NM. ENT BPARS ENT OCTNO ENT BUFUL ENT TCHAR ENT DSKAD ENT ADBUF ENT MAPFG ENT NUMPG ENT PTYPE ENT TYPMS ENT DSKAB ENT $RNT,$PRV ENT TBCHN,PIOC,SWAPF ENT LBUF,TBUF,LWASM,PPREL ENT SDS#,CURAL,CPL2 ENT CMFLG ENT ABCOR ENT MXABC ENT SETDS ENT OLDDA ENT ADBP,NADBP ENT OUBUF ENT TTIME,TIME1,MULR ENT LWSBP ENT NLCOM ENT EOBP ENT #IREG ENT CPLSB,ASKEY,SISDA,SKEYA ENT P3,P4,P5,P14 ENT M7400 * SKP * * DEFINE EXTERNALS * EXT INPUT,LURQ EXT WRITF,EXEC,CLOSE EXT LOCF,APOSN EXT CREAT,OPEN,READF,CNUMD EXT .ENTR EXT PARSE EXT COR.A,RMPAR,DSETU,PTBOT EXT DSET5,PTBT5 EXT DLRM1,DLRM7 * SPC 2 * * DEFINE A AND B REG * A EQU 0 B EQU 1 SUP SPC 3 LST#T DEC 2 # LST TRACKS. IDT#T DEC 3 # IDENT TRACKS. FIX#T DEC 1 # FIX-UP TRACKS. SECWD DEC 128 # WORDS PER SECTOR. SKP * IDENT FORMAT * * WORD 1: ID1 - NAME 1,2 * WORD 2: ID2 - NAME 3,4 * WORD 3: ID3 - NAME 5, USAGE FLAG (SEE BELOW) * WORD 4: ID4 - COMMON LENGTH * WORD 5: (15): ID5 - BASE/CURRENT PAGE LINKING FLAG * WORD 5: (14): ID5 - NEW NAM RECORD FLAG * WORD 5: (13-4): ID5 - NOT USED * WORD 5: (3-0): ID5 - MAP OPTIONS * WORD 6 (15): ID6 - M/S * WORD 6 (08-14): ID6 - NOT USED * WORD 6 (04): ID6 - SSGA (RTE-III) * WORD 6 (03): ID6 - REVERSE COMMON (RTE-III) * WORD 6 (00-06): ID6 - TYPE * WORD 7: ID7 - LOWEST DBL ADDRESS * WORD 8: ID8 - DISK LENGTH FOR UTILITY RELOCATABLES * OR.. MAIN IDENT INDEX FOR SEGMENTS * OR.. (MEU SYSTEMS) PG REQMTS (8 BITS) * THEN KEYWD INDEX (LOW 8 BITS). * WORD 9: ID9 - FILE NAME 1,2 * WORD 10: ID10 - FILE NAME 3,4 * WORD 11: ID11 - FILE NAME 5,6 * WORD 12: ID12 - SECURITY CODE * WORD 13: ID13 - CARTRIDGE LABEL * WORD 14: ID14 - RECORD NUMBER * WORD 15: ID15 - RELATIVE BLOCK * WORD 16: ID16 - BLOCK OFFSET * * USAGE FLAG BITS ARE AS FOLLOWS: * * BIT 0 IF SET MODULE WAS LOADED * BIT 1 IF SET MUST LOAD THIS MODULE (EXT DEFINED BY IT) * BIT 2 IF SET THIS MODULE WAS LOADED AS PART OF A SEGMENT * * * LST FORMAT * * WORD 1: .LST1 - NAME 1,2 * WORD 2: .LST2 - NAME 3,4 * WORD 3: .LST3 - NAME 5, ORDINAL * WORD 4: .LST4 - IDENT INDEX OR 2 IF COMMON, 3 IF ABS, 4 IF REPLACE * WORD 5: .LST5 - SYMBOL VALUE * * * FIXUP TABLE FORMAT * * FIX1: CORE ADDRESS * FIX2: INSTRUCTION CODE * FIX3: OFFSET * FIX4: INDEX OF LST ENTRY REFERENCED, OR ZERO IF NONE * SKP * * PROGRAM TYPES (NON-MEU) * * 0: SYSTEM * 1: RT RESIDENT * 2: RT DISK RESIDENT * 3: BG DISK RESIDENT * 4: BG RESIDENT * 5: BG SEGMENT * 6: LIBRARY * 7: UTILITY * 8: LOAD ONLY TO SATISFY EXTERNAL REFERENCES. * 9: RT RESIDENT USING BACKGROUND COMMON. * 10: RT DISC RESIDENT USING BACKGROUND COMMON. * 12: BG RESIDENT USING FORGROUND COMMON. * 11: BG DISC RESIDENT USING FORGROUND COMMON. * 13: BG SEGMENT USING FORGROUND COMMON * 14: TYPE 6 THAT IS TO BE FOURCE LOADED TO THE LIBRARY. * 30: (MEU SYSTEM SSGA MODULE) CONVERTED TO TYPE 7. * 16-29,31 (MEU MODULES USING SSGA) TYPE SET TO TYPE-16. * 15,32-99:UNUSED (TYPE + 80 IS USED TO DESIGNATE AUTO SPC 1 * PROGRAM TYPES (MEU SYSTEMS) * * 0: SYSTEM * 1: MEMORY RESIDENT * 2: RT DISK RESIDENT * 3: BG DISK RESIDENT * 4: (CONVERTED TO 9) * 5: BG SEGMENT * 6: LIBRARY * 7: UTILITY * 8: LOAD ONLY TO SATISFY EXTERNAL REFERENCES. * 9: MEMORY RESIDENT USING BACKGROUND COMMON. * 10: RT DISC RESIDENT USING BACKGROUND COMMON. * 11: BG DISC RESIDENT USING FORGROUND COMMON. * 12: (CONVERTED TO TYPE 1) * 13: (CONVERTED TO 5, USES SAME COMMON AS MAIN) * 14: TYPE 6 THAT IS TO BE FOURCE LOADED TO THE LIBRARY. * 30: SUBSYSTEM GLOBAL MODULE * 17,18,19,25,26,27: TYPES 1,2,3,9,10,11 (RESP.) * W/ACCESS TO SSGA. * 15,16,20-24,28,29,31-99:UNUSED (TYPE + 80 IS USED TO * DESIGNATE AUTO SCHEDULE AT STARTUP, BUT MAY * ONLY BE ENTERED IN PARM PHASE. +80 IS JUST * A FLAG TO PARM PHASE, NOT STORED IN ID-SEG.) * * SKP * * ERROR CODES * * 0: GENERATOR ERROR (SEND IN BUG REPORT) * 1: INVALID REPLY TO INITIALIZATION PARAMETERS * 2: INSUFFICIENT AMOUNT OF AVAILABLE MEMORY FOR TABLES * 3: RECORD OUT OF SEQUENCE * 4: INVALID RECORD TYPE * 5: DUPLICATE ENTRY POINTS * 6: COMMAND ERROR - PROGRAM INPUT PHASE * 7: LST,IDENT,FIXUP TABLE OVERFLOW * 8: DUPLICATE PROGRAM NAMES * 9: PARAMETER NAME ERROR * 10: PARAMETER TYPE ERROR * 11: PARAMETER PRIORITY ERROR * 12: PARAMETER EXECUTION INTERVAL ERROR * 13: BG SEGMENT PRECEDES BG DISC RESIDENT * 14: SYS AV MEM OR BG BOUNDARY ERRORS * 15: ILLEGAL CALL BY A TYPE 6 PROGRAM (MAY CALL TYPE 0 AND 6 ONLY) * 16: BP LINKAGE AREA OVERFLOW * 17: TYPE 1 OUTPUT FILE OVERFLOW (ESTIMATE WAS NOT LARGE ENOUGH) * 18: MEMORY OVERFLOW * 19: TR STACK UNDERFLOW/OVERFLOW * 20: INVALID COMMAND INPUT LU * 21: '$CIC' NOT FOUND IN LOADER SYMBOL TABLE * 22: LIST FILE ERROR * 23: INVALID FWA BP LINKAGE REPLY * 24: INVALID CHANNEL NO. IN EQT RECORD * 25: INVALID DRIVER NAME IN EQT RECORD * 26: INVALID D, B, U, OPERANDS IN EQT RECORD * 27: INVALID DEVICE REFERENCE NO. * 28: INVALID INTERRUPT REC CHANNEL NO. * 29: INVALID INTERRUPT REC CHANNEL NO. ORDER * 30: INVALID INT RECORD MNEMONIC * 31: INVALID EQT NO. IN INT RECORD * 32: INVALID PROGRAM NAME IN INT RECORD * 33: INVALID ENTRY POINT IN INT RECORD * 34: INVALID ABSOLUTE VALUE IN INT RECORD * 35: BP INTERRUPT LOCATION OVERFLOW * 36: INVALID TERMINATING OPERAND IN INT RECORD * 37: INVALID COMMON LENGTH IN SYS, LIB, OR SSGA MODULE..... * 38: ID-SEGMENT OF SEGMENT 3 NOT FOUND * 39: ILLEGAL SYSTEM }CALL OF TYPE 6 PROGRAM * 40: NOT USED * 41: NOT USED * 42: NOT USED * 43: NOT USED SKP ******************************************************************** * * * M E U E R R O R C O D E S * * * ******************************************************************** SPC 1 * DURING DEFINITION OF PARTITIONS: * 44: INVALID PARTITION NUMBER * 45: INVALID PARTITION SIZE * 46: INVALID PARTITION TYPE * 47: INVALID PARTITION RESERVE * USER RESPONSE TO 44 THRU 47: REENTER DESCRIPTION * OF PARTITION IN QUESTION AND CONTINUE. * 53: PARTITION SIZES DON'T TOTAL AVAILABLE AREA * USER RESPONSE TO 53: REDEFINE ALL PARTITIONS * * DURING ASSIGNMENT OF PROGRAMS TO PARTITIONS: * 48: INVALID OR UNKNOWN PROGRAM NAME * 49: INVALID PARTITION NUMBER * 50: PROGRAM TOO LARGE FOR PARTITION SPECIFIED * USER RESPONSE TO 48 THRU 50: REENTER ASSIGNMENT * OR GIVE UP AND CONTINUE * * DURING OVERRIDE OF PROGRAM SIZE REQMTS: * 48: (SAME AS ABOVE) * 51: INVALID SIZE (LARGER THAN ALLOWABLE OR * SMALLER THAN PROGRAM REQUIREMENT * USER RESPONSE TO 48 OR 51: REENTER SIZE OVERRIDE * OR GIVE UP AND CONTINUE * * DURING PROGRAM LOADING AND RELOCATION: * 52: MODULE WITHOUT SSGA BIT IN TYPE HAS * EXTERNAL REF TO AN SSGA ENTRY POINT * 54: SUBROUTINE OR SEGMENT DECLARED MORE COMMON THAN MAIN * USER RESPONSE: RECOMPILE MAIN SPECIFYING MAX COMMON NEEDED SKP DBP EQU * FWA DUMMY BASE PAGE. * ************************************************ * * * THE NEXT 1K IS OVERLAID FOR DUMMY BASE PAGE * * WHEN RTGN3 BEGINS EXECUTION. * * * ************************************************ SPC 5 START NOP STB PARMA SAVE THE COMMAND ADDRESS * * SET UP COMMAND LU OR FILE, AND THE ERRLU * STRT1 JSB RMPAR RETRIEVE PARAMETERS DEF *+2 DEF PARMA * * STRT2 LDA PARMA GET FIRST WORD SZA,RSS IF ZERO ISZ PARMA SET TO 1 (DEFAULT TO SYS CONSOLE) CLB,INB LU'S TYPE IS 1 AND M7400 IS INPUT AN ASCII FILE NAME? SZA INB YES, FILE'S TYPE IS 2 STB PARS2 TYPE WORD FOR PRS21,+1,+2 DLD PARS3 GET POSSIBLE SEC. CODE & LU STA PRS31 AND SAVE STB PRS41 LDA RWSUB GET POTENTIAL R/W SUBFUNCTION STA PARS5 SAVE FOR OPEN CALL LDB C4040 CONVERT 0 FILL'S IN NAME LDA PARS2+2 TO BLANKS SZA,RSS STB PARS2+2 LDA PARS2+3 SZA,RSS STB PARS2+3 * JSB STATE SET THE STATE FLAGS IACOM & CMDLU JMP INVLU INVALID INPUT LU SPECIFIED - GO RECOVER LDA CMDLU IF AN INTERACTIVE LU, SET THE LDB IACOM 1 MEANS INTERACTIVE SZB,RSS CLA,INA DEFAULT TO LU 1 STA ERRLU ERROR LU * JSB FOPEN GO OPEN FILE DEF *+3 DEF IPDCB DEF PARS5 LDA FMRR SSA,RSS ANY ERRORS? JMP STRT3 NO CMA,INA SET POS. FOR CONVERT STA FMRR JSB CNUMD GET DEC ERROR CODE DEF *+3 DEF FMRR DEF FERMA ERROR MESSAGE ADDR LDA FERMA+2 GET LAST TWO CHARACTERS STA FERMA * JSB EXEC SEND ERROR TO OPERATOR LU DEF *+5 DEF P2 DEF ERRLU DEF FILEA+1 DEF B7 STRT4 CLA SET BACK TO LU 1 STA CMDLU STA PARMA STA IACOM INA STA ERRLU JMP STRT2 START OVER * INVLU JSB EXEC INVALID INPUT LU SPECIFIED DEF *+5 ISSUE ERROR MESSAGE TO LU 1 (NOW DEF P2 DEFAULT ERRLU) DEF P1 DEF GNR20 DEF P5 JMP STRT4 SET UP THE INPUT LU * STRT3 CCA ADA STKAD RESET STACK POINTER. STA P:TR CLA JSB PUSH GO PLACE ON STACK JSB GTERM ERROR RETURN - CAN'T HAPPEN! * LDA ERRLU WE'RE GOING TO OVERLAY 3 WORDS CMA,INA LDB DSTRT AT STRT3 - IN ORDER TO SETUP JSB CONVD THE ERROR COMMAND: LDA STRT3+2 "TR,ERRLU" STA TRCOM+2 STORE THE ASCII LU * LDA CPLIM NEGATE HIGH END OF CURRENT CMA,INA PAGE LINK LIMIT IMAGE STA CPLIM AREA SKP * ALLOCATE SPACE FOR FIX-UP,IDENT, AND LST TABLES: * * DETERMINE HOW MUCH CORE REMAINS BEYOND LONGEST * SEGMENT, DIVIDE INTO 3 BLOCKS FOR IN-CORE CHUNKS * OF TABLES, AND ALLOCATE DISC SPACE FOR TABLE STORAGE. * AVAILABLE CORE MUST BE AT LEAST 512 WORDS. * THE LST IS ALLOCATED LAST TO USE WASTED CORE FROM * FIXUP & IDENT BLOCKS. * LDA 1657B ADDR OF KEYWORD TABLE. STA TEMP1 TRY LDB TEMP1,I GET NEXT ID SEG ADDRESS SZB END OF TABLE IF ZERO JMP TRYY LDA ERR38 SEGMENT 3'S ID SEGMENT IS MISSING JMP NROOM+1 SEND ERROR & TERMINATE * TRYY ADB P12 GET TO NAME. LDA B,I GET FIRST TWO CHAR. * * DYNAMICALLY DETERMINE LONGEST SEGMENT * CPA AS.RT "RTGN3" = LONGEST SEGMENT. RSS MATCH. JMP NEXT INB LDA B,I GET SECOND TWO CHAR. CPA AS.GN RSS MATCH. JMP NEXT INB LDA B,I AND M7400 CPA AS.3 "3". JMP MATCH NEXT ISZ TEMP1 JMP TRY * MATCH LDA TEMP1,I GET ADDR OF IDSEG. JSB COR.A GET TO LWAM OF SEGMENT. INA GET FWAM. STA FWAM SAVE AS FIRST WORD AVAIL. MEM. CMA,INA GET SIZE OF UNDECLARED CORE. ADA LWAM LWAM SET BY RTE. STA NEXT LDA N512 MAKE SURE ENOUGH CORE. ADA NEXT AT LEAST 512 WORDS WORTH SSA JMNdP NROOM NO ROOM. BAIL OUT. LDA NEXT CLB DIV P4 ALLOCATE AVAILABLE MEMORY: STA TEMP1 1/4 TH FOR FIXUP TABLE, AND CMA,INA 3/8 TH'S EACH FOR IDENT AND LST ADA NEXT ARS DIVIDE BY TWO STA TEMP2 * * SET UP FIX-UP TABLE. LDA TEMP1 JSB TTRUN TRUNCATE TO TRACK SIZE SETF0 CLB DIV SECWD SEE HOW MANY SECTORS FIT. STA FX.#S SAVE # SECT PER FIX-UP BLOCK. MPY SECWD CONVERT TO WORDS FOR LENGTH. STA LFIX OF DISC READS AND WRITES. CLB BLOCK MULTIPLE MUST END ON A TRACK LDA P6144 BOUNDARY AS WELL DIV LFIX SZB,RSS JMP SETF1 OK LDA LFIX ADA N128 DECREMENT SIZE BY ONE SECTOR JMP SETF0 * TTRUN NOP CLB TRUNCATE BLOCK SIZE DIV P6144 IF GREATER THAN 6144(#WORD/TRACK) SZA LDB P6144 TO ONE TRACK STB A JMP TTRUN,I * SETF1 LDA LFIX CLB GET # 4 WORD ENTRIES IN DIV P4 THE BLOCK. STA EFIX SAVE # ENTRIES IN BLOCK. * LDA FWAM INITIALIZE FIX-UP POINTERS: STA BFIX FIRST ENTRY, CLA STA PFIX # ENTRIES USED, STA TFIX CURRENT ENTRY INDEX. STA B.F 1ST ENTRY NOW IN CORE. * * SET UP IDENT TABLE. THIS ONE HAS AN OFFSET OF +10. * LDA BFIX SET FWA IDENT AREA AT ADA LFIX STA BIDNT END OF FIX-UP AREA. LDA TEMP2 GET BLOCK JSB TTRUN TRUNCATE BLOCK SIZE IF NECESSARY SETI0 CLB DIV SECWD SEE HOW MANY SECTORS FIT STA ID.#S MPY SECWD CONVERT TO WORDS FOR LENGTH STA LIDNT CLB BLOCK MULTIPLE MUST END ON LDA P6144 TRACK BOUNDARY AS WELL DIV LIDNT SZB,RSS JMP SETI1 OK LDA LIDNT DECREMENT BLOCK ADA N128 SIZE BY ONE SECTOR JMP SETI0 SETI1 LDA LIDNT G CLB GET # 16 WORD ENTRIES IN DIV P16 THE BLOCK. STA EIDNT SAVE # ENTRIES IN BLOCK. * LDA P10 INITIALIZE IDENT POINTERS: STA PIDNT # ENTRIES USED +10, STA TIDNT CURRENT ENTRY INDEX, STA B.I 1ST ENTRY INDEX NOW IN CORE. * * SET UP LOADER SYMBOL TABLE (LST). * LDA BIDNT SET FWA LST AREA AT END ADA LIDNT STA BLST OF IDENT AREA. CMA,INA USE ALL OF REMAINING ADA LWAM AVAILABLE MEMORY. JSB TTRUN TRUNCATE BLOCK SIZE IF NECESSARY SETL0 CLB DIV SECWD SEE HOW MANY SECTORS FIT. STA LS.#S SAVE # SECT PER LST BLOCK. MPY SECWD CONVERT TO WORDS FOR LENGTH STA LLST OF DISC READS AND WRITES. CLB LDA P6144 BLOCK MULTIPLE DIV LLST MUST END ON TRACK SZB,RSS BOUNDARY AS WELL JMP SETL1 LDA LLST ADA N128 DECREMENT BY ONE SECTOR JMP SETL0 SETL1 LDA LLST CLB GET # 5 WORD ENTRIES IN DIV P5 THE BLOCK. STA ELST SAVE # ENTRIES. * CLA INITIALIZE LST POINTERS: STA PLST # ENTRIES USED, STA TLST CURRENT ENTRY INDEX, STA B.L 1ST ENTRY NOW IN CORE. SKP * * ALLOCATE DISC SPACE FOR FIX-UP, IDENT, LST. * LDA FIX#T GET # FIX-UP TRACKS, ADA IDT#T ADD # IDENT TRACKS, ADA LST#T ADD # LST TRACKS. IOR MSIGN SET NO SUSPEND BIT STA NEXT TOTAL # TRACKS TO ALLOCATE. * GETTR JSB EXEC DEF *+6 DEF P4 DEF NEXT # TRACKS REQUESTED. DEF FTRKA RETURNED: FIRST TRACK. DEF DSKLU RETURNED: WHICH DISC. DEF SECTK RETURNED: SECTORS/TRACK. * LDA FTRKA GET FIRST TRACK # SSA,RSS REQUEST GRANTED? JMP ALLOC YES JSB SPACE JSB EXEC NO, TELL USER OF PROBLEM DEF *+5 DEF vP2 DEF ERRLU DEF TRMSG DEF P14 "GENERATOR WAITING FOR TRACKS" * LDA NEXT TAKE OUT NO-SUSPEND BIT XOR MSIGN STA NEXT SUSPEND UNTIL TRACKS ARE AVAILABLE JMP GETTR * * SETB NOP CLE,ELA MPY BY 2 (64-WORD SECTORS) CLB DIV SECTK FIND MULT. FACTOR PER WRITE SZB,RSS IF A TRACK MULTIPLE LDB P96 THEN SET IT SO JMP SETB,I # 64-WORD SECTORS PER BLOCK * * ALLOC LDA FX.#S GET # 128 WORD SECTORS. JSB SETB STB FX.#S SET # 64 WORD SECTORS PER BLOCK. LDA ID.#S JSB SETB STB ID.#S LDA LS.#S JSB SETB STB LS.#S * LDA FTRKA STA FX.BT FIX-UP START TRACK. STA FX.LT FIX-UP TRACK LAST READ. ADA FIX#T STA FX.ET FIX-UP LAST TRACK +1. STA ID.BT IDENT START TRACK. STA ID.LT IDENT TRACK LAST READ. ADA IDT#T STA ID.ET IDENT LAST TRACK +1. STA LS.BT LST START TRACK. STA LS.LT LST TRACK LAST READ. ADA LST#T STA LS.ET LST LAST TRACK +1. CLA STA FX.LS STA ID.LS STA LS.LS SKP * * GET NAME, SECUR, LABEL OF LIST FILE. * FNAME LDA P10 "LIST FILE?" LDB LSTFI JSB RNAME GET LIST FILE JSB CRETF GO CREATE THE FILE DEF *+5 DEF LFDCB DEF P64 DEF P3 DEF ZERO JSB CHFIL CHECK FILE STATUS JMP FNAME ERROR ISZ LFERR 1=> ACKNOWLEDGE LIST FILE ERRORS * DLD PARS2 WAS NAME A FILE OR LU? CPA P1 RSS JMP FLNM0 FILE NAME, SO DEFAULT TO LSTLU=0 STB LSTLU SAVE THE LU - MAY NOT BE INTERACTIVE JSB EXEC DETERMINE THE DEVICE TYPE DEF *+5 DEF P13 DEF LSTLU DEF EQT5 DEF FNAME SAVES A LINK TO EQT4!! * CLB LDA FNAME IF BIT BUCKET WAS SPECIFIEZD, AND M77 DON'T MISTAKE IT FOR A TYPE SZA,RSS 00 DEVICE JMP SETIA * LDB LSTLU LDA EQT5 INTERACTIVE DEVICES ARE TYPE 0, OR ALF,ALF TYPE 5, SUBCHANNEL 0 AND M77 STA EQT5 CPA P5 JSB LUSUB GET TYPE 5 SUBCHANNEL CLB SZA,RSS INB SET INTERACTIVE SETIA STB IALST 0=NOT INTERACTIVE, 1=IT IS * SZB IF ITS INTERACTIVE JMP EC? THEN DON'T LOCK LULOC JSB LURQ DEF *+4 DEF IOPTN DEF LSTLU DEF P1 * SZA,RSS WAS IT SUCCESSFUL? JMP EC? YES JSB SPACE JSB EXEC DEF *+5 DEF P2 DEF ERRLU DEF LUMSG DEF P17 "GENERATOR WAITING ON LIST LU LOCK" * LDA IOPTN SET THE WAIT BIT FOR NEXT CALL XOR MSIGN STA IOPTN JMP LULOC * * RE-OPEN THE LIST FILE WITH A NON-EXCLUSIVE OPEN SO IT CAN * BE EXAMINED CONCURRENT WITH GENERATION * FLNM0 JSB OPEN A CALL TO OPEN AN ALREADY DEF *+7 OPEN FILE WILL RESULT DEF LFDCB IN IT BEING CLOSED AND DEF FMRR RE-OPENED WITH THE OPTIONS DEF PARS2+1 DEF P1 DEF PARS3+1 DEF PARS4+1 JSB CHFIL JMP FLNM0 * * ASK WHETHER ECHO IS DESIRED * AND OPEN IT IF SO * EC? LDA P5 LDB ECHOI JSB YE?NO JMP EC? INVALID REPLY STA ECHON 1 FOR YES, 0 FOR NO * CLA,INA SET UP FOR CREATION STA PARS2 OF DUMMY DCB IN TYP0 LDA ERRLU STA PARS2+1 LU ALREADY DETERMINED JSB FOPEN DEF *+3 DEF ECDCB DEF RWSUB * JSB CHFIL JSB GTERM RSS SKIP * * GET SIZE, NAME, SECUR, LABEL OF CORE-IMAGE RTE OUTPUT FILE. * JSB INERR INPUT ERROR EST# JSB SPACE LDA P30 LDB FISIZ "EST. # TRACKS IN OUTPUT FILE?" JSB READ LDA N3 =NLH JSB DOCON GET BINARY. JMP EST# ERROR. TRY AGAIN. STA NEXT ADA MIN10 CHECK FOR 10 TRACKS MIN. SSA JMP EST#-1 LDA NEXT MPY P48 GET # BLOCKS. SSA IF NEGATIVE THEN RETRY JMP EST#-1 STA NEXT * FLNAM JSB SPACE LDA P17 LDB OUTFI JSB RNAME "OUTPUT FILE NAME?" * LDA PARS2 CHECK FOR NUMERIC OR NULL ANSWER CMA,INA,SZA IF NULL(TYPE 0) INA,SZA,RSS OR NUMERIC(TYPE 1) RSS JMP FLNMC THEN ITS A LU JSB INERR JMP FLNAM * FLNMC JSB CRETF GO CREATE THE OUTPUT FILE DEF *+5 DEF ABDCB DEF NEXT # BLOCKS. DEF P1 TYPE 1 FILE. DEF ZERO JSB CHFIL CHECK FILE ERROR JMP FLNAM RETRY...ERROR * * GET TARGET DISK TYPE * JSB SPACE RSS JSB INERR INPUT ERROR TO "TARGET DISK?" STRT0 LDA P12 TO GET THE INITIAL SEGMENT LDB MES00 DEPENDS ON THE DISK TYPE JSB READ MES00: "TARGET DISK?" LDA N4 WN JSB DOCON CONVERT 4 DEC DIGITS JMP STRT0 ERROR - TRY AGAIN CLB,INB CPA P7900 CHECK FOR A CLB 7900 CPA P7905 OR A 7905 CCB CPA P7906 OR A 7906 CCB CPA P7920 OR A 7920 CCB STB DTYPE 0=7900, -1=7905,7920 SSB JMP STRT5 SZB JMP STRT0-1 NONE OF THE ABOVE * JSB SWAP SWAP IN SEGMENT 1 FOR 7900 DEC 1 DISK DEPENDENT SUBROUTINES LDA DLRM1 JMP .NM * STRT5 JSB SWAP SWAP IN SEGMENT 7 FOR 7905 DEC 7 DISK DEPENDENT SUBROUTINES LDA DLRM7 * * CREATE TEMPORARY FILE FOR MODIFIED NAM RECORDS. * .NM STA DLRMA JSB CREAT CREATE @.NM.@ FILE NAME. DEF *+6 DEF NMDCB DEF FMRR DEF .NM. DEF P64 DEF P5 * LDA FMRR DUPLICATE NAME? CPA N2 RSS YES JMP .NMCH CHECK FOR OTHER ERRORS * JSB OPEN OPEN THE FILE(OLD) DEF *+4 DEF NMDCB DEF FMRR DEF .NM. * JSB CLOSE NOW CLOSE IT WITH TRUNCATE DEF *+4 TO 0 DEF NMDCB DEF FMRR DEF P64 JMP .NM+1 NOW RETRY THE CREATE * .NMCH JSB CHFIL OTHER ERRORS JSB GTERM YES, SO ABORT SKP * * THE FOLLOWING MESSAGES ARE PRINTED DURING THE INITIALIZATION * PHASE, WITH THE SPECIFICATIONS FOR EACH VALID RESONSE. * * * MESSAGE RESPONSE * * * TBG CHNL? ENTER 2 OCTAL DIGITS * * PRIV. INT. CARD ADDR? ENTER 2 OCTAL DIGITS * * SWAPPING? ENTER YES OR NO * * LWA MEM? ENTER 5 OCTAL DIGITS * * JSB SPACE GET A NEW LDA ADBP GET ADDRSS OF DUMMY BASE PAGE CMA,INA MAKE NEG STA NADBP SAVE LDB D$REN ENTER .ZRNT IN THE LST JSB LSTE LDA RSS SET IT UP AS STA .LST5,I A REPLACE WITH RSS LDA P4 STA ʵ.LST4,I ENT CLA STA $RNT INDEX IS 0 * LDB D$PRV DO SAME FOR .ZPRV JSB LSTE LDA P4 STA .LST4,I LDA RSS STA .LST5,I CLA,INA STA $PRV SET FLAG FOR LOAD PHASE * LDB D$CLS ENTER $CLAS IN JSB LSTE THE SYMBOL TABLE LDB D$LUS NOW ENTER $LUSW JSB LSTE LDB D$RNT AND $RNTB JSB LSTE LDB $LUAV AND $LUAV JSB LSTE * LDB DTYPE SET UP THE DISC SPECIFICATIONS. SSB JMP SPEC5 JSB DSETU 7900 RSS RSS * SPEC5 JSB DSET5 7905 * * SET TIME BASE GENERATOR CHANNEL * JSB SPACE NEW LINE CHNLT LDA P9 LDB MES30 MES30 = ADDR: TBG CHNL? JSB READ PRINT MESSAGE, GET REPLY LDA P2 SET FOR 2 OCTAL DIGITS INPUT JSB DOCON GET DIGITS, RETURN OCTAL JMP CHNLT REPEAT INPUT STA TBCHN SET TBG CHANNEL NO. * * GET PRIV. INT. CARD ADDR. * JSB SPACE NEW LINE DUMY LDA P22 LDB MES41 MES41 = ADDR: PRIV. INT. CARD? JSB READ PRINT MESSAGE, GET REPLY LDA P2 SET FOR 2 OCTAL DIGITS INPUT JSB DOCON GET DIGITS JMP DUMY -ERROR, REPEAT INPUT. STA PIOC SET ADDR. OF DUMMY CARD. IFN *** BEGIN NON-MEU CODE *** * * SET SWAPPING FLAG * * LDA "FG" GET ASCII 'FG' AND GO JSB SWAP? ASK 'FG SWAPPING?' STA SWAPF SAVE THE FLAG BIT * LDA "BG" NOW THE SAME FOR BACKGROUND JSB SWAP? RAL POSITION THE BIT IOR SWAPF COMBINE WITH 'FG' FLAG STA SWAPF AND SAVE IT **** END NON-MEU CODE **** XIF IFZ ***** BEGIN MEU CODE ***** LDA P3 SET BOTH FG AND STA SWAPF BG SWAP FLAGS ALWAYS. SPC 1 JSB SPACE MAPC? LDA MLMP ASK USER IF DRIVERS ACCESS COMMON, IF SO, VM LDB MSMP. SET FLAG FOR SYSTEM TO MAP COMMON JSB YE?NO JMP MAPC? ASK AGAIN IF BAD ANSWER STA MAPFG SAVE 1 IF YES, 0 IF NO ****** END MEU CODE ****** XIF LDA "FG" NOW ASK JSB LOCK? 'FG CORE LOCK?' RAL,RAL ROTATE TO PROPER BIT POSITION IOR SWAPF COMBINE STA SWAPF AND SAVE * LDA "BG" NOW DO SAME FOR BACKGROUND JSB LOCK? ALF,RAR IOR SWAPF COMBINE STA SWAPF SAVE THE WORD. * SWPDL JSB SPACE LDA P11 GET THE LDB MES33 SWAP DELAY JSB READ LDA N3 CONVERT JSB DOCON TO BINARY FROM DECIMAL JMP SWPDL ERROR TRY AGAIN * AND M7400 IF > 256 SZA,RSS THEN JMP SWPOK * JSB INERR BITCH AND JMP SWPDL TRY AGAIN * SWPOK LDA OCTNO COMBINE ALF,ALF WITH SWAP IOR SWAPF FLAG STA SWAPF AND SAVE IFN *** BEGIN NON-MEU CODE *** * * SET LAST WORD AVAIL MEMORY * JSB SPACE NEW LINE SMLWA LDA P8 LDB MESS3 MESS3 = ADDR: LWA MEM? JSB READ PRINT MESSAGE, GET REPLY LDA P5 SET FOR 5 OCTAL DIGITS INPUT JSB DOCON GET DIGITS, RETURN OCTAL JMP SMLWA REPEAT INPUT STA LWASM SET LWA MEM FOR SYSTEM **** END NON-MEU CODE **** XIF * IFZ ***** BEGIN MEU CODE ***** JSB SPACE SKIP A LINE MEMSZ LDA P9 THEN ASK USER LDB MESS3 FOR NUMBER OF PAGES JSB READ OF MAIN MEMORY LDA N4 GET 4 DECIMAL JSB DOCON DIGITS OR TRY AGAIN JMP MEMSZ IF ERROR STA NUMPG SPC 1 * DETERMINE LAST ADDR AVAILABLE TO RESIDENT SYSTEM * SPC 1 LDB P32 IF #PAGES IS CMB OVER 32 THEN ADB A USE 32, ELSE USE SSB,RSS WHAT HE SAID LDA P32 SPC 1 LSL 10 MULT BY 1024 AND SUBTRACT ADA N193 193 AND SAVE AS LAST STA LWASM USEABLE MEM WORD ****** END MEU CODE ****** XIF LDB DTYPE FINISH THE DISC SET UP. SSB JMP SET05 JSB PTBOT 7900 BOOT RSS * SET05 JSB PTBT5 7905 BOOT * JMP SEGCN SPC 5 * * NOT ENOUGH CORE BEYOND LONGEST SEGMENT * FOR LST, IDENT, FIXUP TABLES. * NROOM LDA ERR02 JSB GN.ER JSB GTERM * ERR02 ASC 1,02 ERR38 ASC 1,38 SEGMENT 3'S ID-SEGMENT MISSING SKP * * OVERLAID CONSTANTS. * FWAM NOP CALCULATED AT RUNTIME LWAM EQU 1777B END OF CORE * N4 DEC -4 MIN10 DEC -10 N128 DEC -128 N512 DEC -512 N193 DEC -193 P1 DEC 1 P9 DEC 9 P11 DEC 11 P16 DEC 16 P17 DEC 17 P22 DEC 22 P30 DEC 30 P32 DEC 32 P48 DEC 48 P96 DEC 96 P6144 DEC 6144 #WORDS PER TRACK P7900 DEC 7900 P7905 DEC 7905 P7906 DEC 7906 P7920 DEC 7920 MSIGN OCT 100000 IOPTN OCT 1 FTRKA NOP RWSUB OCT 400 "FG" ASC 1,FG "BG" ASC 1,BG AS.RT ASC 1,RT IFN AS.GN ASC 1,2G XIF IFZ AS.GN ASC 1,3G XIF AS.3 OCT 31400 LONGEST SEG = RTGN3. TEMP1 NOP TEMP2 NOP DSTRT DEF STRT3 * D$REN DEF *+1 ASC 3,.ZRNT D$PRV DEF *+1 ASC 3,.ZPRV D$CLS DEF *+1 ASC 3,$CLAS D$LUS DEF *+1 ASC 3,$LUSW D$RNT DEF *+1 ASC 3,$RNTB $LUAV DEF *+1 ASC 3,$LUAV * TRMSG ASC 14,GENERATOR WAITING FOR TRACKS LUMSG ASC 17,GENERATOR WAITING ON LIST LU LOCK MES00 DEF *+1 ASC 6,TARGET DISK? LSTFI DEF *+1 ASC 5,LIST FILE? OUTFI DEF *+1 ASC 9,OUTPUT FILE NAME? ECHOI DEF *+1 ASC 3,ECHO? FISIZ DEF *+1 ASC 15,EST. # TRACKS IN OUTPUT FILE? MES30 DEF *+1 ASC 5,TBG CHNL? MES41 DEF *+1 ASC 11,PRIV. INT. CARD ADDR? IFN **** BEGIN NON-DMS CODE **** MES31 DEF *+1 ASC 6,FG SWAPPING? **** END NON-DMS CODE **** XIF MES32 DEF *+1 ASC 7,FG CORE LOCK? MES33 DEF *+1 ASC 6,SWAP DELAY? MESS3 DEF *+1 IFN ASC 5,LWA MEM? XIF IFZ **** BEGIN DMS CODE **** ASC 5,MEM SIZE? MSMP. DEF *+1 ASC 14,PRIV. DRIVERS ACCESS COMMON? MLMP DEC 28 **** END DMS CODE **** XIF GNR20 ASC 5,GEN ERR 20 HED RTGEN SUBROUTINES. IFN **** BEGIN NON-DMS CODE **** * * * SWAP? ASKS THE 'XX SWAPPING?' QUESTION AND RETURNS * THE ANALIZED ANSWER. * * CALLING SEQUENCE: * LDA "FG" OR "BG" * JSB SWAP? * RETURN A=1 IF YES, 0 IF NO. * SWAP? NOP STA MES31,I SET THE 'FG' OR 'BG' JSB SPACE SPACE TO MAKE IT LOOK NEAT FSWAP LDA P12 GET COUNT LDB MES31 GET THE MESSAGE ADDRESS JSB YE?NO ASK AND ANALIZE THE RESPONCE JMP FSWAP BAD NEWS, TRY AGAIN * JMP SWAP?,I EXIT **** END NON-DMS CODE **** XIF SPC 5 * * * LOCK? ASKS AND ANALIZES THE 'XX CORE LOCK?' QUESTION. * * CALLING SEQUENCE: * * LDA "FG" OR "BG" * JSB LOCK? * RETURN A=1 IF YES, 0 IF NO. * * LOCK? NOP STA MES32,I SET THE 'FG' OF 'BG' IN MESSAGE JSB SPACE MAKE IT LOOK NEAT. LOCK1 LDA P13 GET THE LENGTH LDB MES32 GET MESSAGE ADDRESS JSB YE?NO GO ASK AND GET ANSWER JMP LOCK1 ERROR SO RETRY * JMP LOCK?,I RETURN SKP * YE?NO ROUTINE SENDS A QUESTION TO THE TTY * AND READS AND ANALIZES THE RESPONSE * * CALLING SEQUENCE: * * LDA MESSAGE CHARACTER COUNT * LDB MESSAGE ADDRESS * JSB YE?NO * JMP ERROR * NORMAL RETURN A=1 FOR YES, 0 FOR NO. * YE?NO NOP JSB READ GO PRINT MESSAGE AND GET ANSWER JSB YE/NO ANALIZE THE ANSWER JMP YE?NO,I ERROR EXIT * CLA,RSS NO RETURN CLA,INA YES RETURN ISZ YE?NO STEP RETURN ADDRESS f JMP YE?NO,I RETURN TO CALLER. SPC 5 * BSS 2000B+DBP-* RESERVE 1K FOR DUMMY BASE PAGE. * SPC 5 *********************************************** * * * END OF AREA OVERLAID FOR DUMMY BASE PAGE. * * * *********************************************** SKP DSKAB DEC 2 INITIAL DISC ADDR FOR SYS CODE. * DBPO EQU DBP ADBP DEF DBPO ADDR OF DUMMY BASE PAGE NADBP NOP NEG OF RTGN START * * CURRENT PAGE LINKAGE IMAGE AREA. * TBLNK BSS 1 BSS 2 LRBP BSS 1 AREA 1: CR SYSTEM BP URBP BSS 1 IRBP BSS 1 LBBP BSS 1 AREA 2: BG RES BASE PAGE. UBBP BSS 1 IBBP BSS 1 CUBP BSS 1 AREA 3: CURRENT PROG BP. UCUBP BSS 1 ICUBP BSS 1 * BSS 600 CURRENT PAGE LINKAGE IMAGE AREA. * CPLIM DEF * END OF CP LINK AREA. CUBPA DEF CUBP ADDR OF CURRENT BP SPECS. SPC 2 FWSCA EQU 1647B EXTEND COMM AREA FOR I-REG PTR LWSBP ABS FWSCA LWA BP LINK AREA +1 EOBP ABS -FWSCA #IREG DEC 2 SAVE 2 I-REGS NLCOM ABS FWSCA-2000B SPC 2 P8 DEC 8 TTIME BSS 1 TIME1 BSS 1 MULR BSS 1 * $RNT BSS 1 INDEX OF $RENT ENTRY $PRV BSS 1 INDEX OF $PRIV ENTRY * CURAL NOP CURRENT LBUF ADDRESS. CPL2 NOP ADDR OF HIGH CURRENT PAGE LINK SPECS. PPREL NOP INITIAL PROG RELOC ADDR. * TBCHN NOP TIME BASE GENERATOR CHANNEL LWASM NOP LAST WORD SYSTEM AVAILABLE MEMORY PIOC NOP ADDR OF PRIVILEGED I/0 CARD SWAPF NOP SWAPPING FLAG = 0/1 = NO/YES DTYPE NOP TARGET DISK = 0/-1 = 7900/7905 LBUF BSS 64 LOAD BUFFER TBUF BSS 4 TEMP BUFFER SKP * * SEGMENT LOADING CONTROL. * ************************************** * SEGCN JSB SWAP DO PROG INPUT PHASE. P2 DEC 2 JSB INPUT GO TO SEGMENT. * FWBPL JSB SWAP GO GENERATE RTERu! P3 DEC 3 JMP FWENT SPC 5 * * CONTROL ROUTINES FOR SEGMENT CALLS TO SUBROUTINES * IN ANOTHER SEGMENT. * LLOAD NOP IN-CORE RTGN3 ISSUED CALL. JSB SWAP ROLL IN RTGN4. P4 DEC 4 * JSB NLOAD CALL "LOAD" IN RTGN4. * JSB SWAP BRING BACK RTGN3. DEC 3 JMP LLOAD,I RETURN. SPC 3 LOADS NOP IN-CORE RTGN3 ISSUED CALL. JSB SWAP ROLL IN RTGN4. DEC 4 * JSB LODER CALL "LOADS" IN RTGN4. * JSB SWAP BRING BACK RTGN3. DEC 3 JMP LOADS,I RETURN. SPC 3 GENIO NOP IN-CORE RTGN3 ISSUED CALL. JSB SWAP ROLL IN RTGN5. P5 DEC 5 * JSB GNIO CALL "GENIO" IN RTGN5. * JSB SWAP BRING BACK RTGN3. DEC 3 JMP GENIO,I RETURN. SPC 3 IFZ ******* BEGIN DMS CODE ******** PARTD NOP IN-CORE RTGN3 ISSUED CALL JSB SWAP ROLL IN RTGN6 DEC 6 * JSB PARTS DO PARTITION DEFINITION * JSB SWAP BRING BACK RTGN3 DEC 3 JMP PARTD,I ****** END DMS CODE ****** XIF SPC 3 DSTBL NOP IN-CORE RTGN5 ISSUED CALL. LDB DTYPE DETERMINE DISK TYPE SSB JMP D05 * JSB SWAP ROLL IN RTGN1(7900) DEC 1 JSB DSTB CALL "DSTBL" IN RTGN1. JMP BACK5 * D05 JSB SWAP ROLL IN RTGN7(7905) DEC 7 JSB DSTB5 CALL "DSTBL" IN RTGN7 * * BACK5 JSB SWAP BRING BACK RTGEN5. DEC 5 JMP DSTBL,I RETURN. SPC 3 FSECT NOP IN-CORE RTGN3 ISSUED CALL. LDB DTYPE DETERMINE DISK TYPE SSB JMP F05 * JSB SWAP ROLL IN RTGN1 (7900) DEC 1 JSB FSEC CALL "FSECT" IN RTGN1. JMP BK3 * F05 JSB SWAP ROLL IN RTGN7 (7905) DEC 7 JSB FSEC5 CALL "FSECT" IN RTGN7 * BK3 JSB SWAP BRING BACK RTGN3. D DEC 3 JMP FSECT,I RETURN. SPC 4 * * ROUTINE TO SWAP SEGMENTS * CALLING SEQUENCE * JSB SWAP * DEC SEG # * A AND B REG SAVED * SWAP NOP DST ABREG SAVE REGISTERS. CCA ADA SWAP,I GET SEG NUMBER. MPY P3 ADA RTGMA STA SWAPA JSB EXEC ROLL IN SEGMENT DEF *+3 - IT WILL COME BACK TO SWRET DEF P8 AFTER EXECUTING FRONT END CODE. SWAPA NOP SWRET ISZ SWAP GET RETURN ADDRESS DLD ABREG RESTORE REGISTERS. JMP SWAP,I AND RETURN SPC 1 ABREG BSS 2 * * THE FOLLOWING ORDER MUST NOT BE CHANGED * RTGMA DEF *+1 IFN ASC 3,RT2G1 7900 DISC SUBR. SEGMENT. ASC 3,RT2G2 PROG-PARAM INPUT PHASE SEGMENT. ASC 3,RT2G3 LOADING CONTROL SEGMENT. ASC 3,RT2G4 LOADER SEGMENT. ASC 3,RT2G5 I-O TABLE GENERATION SEGMENT. ASC 3, ASC 3,RT2G7 7905 DISK SUBR. SEGMENT . XIF IFZ ASC 3,RT3G1 7900 DISC SUBR. SEGMENT ASC 3,RT3G2 PRO-PARAM INPUT PHASE SEGMENT ASC 3,RT3G3 LOADING CONTROL SEGMENT ASC 3,RT3G4 LOADER SEGMENT ASC 3,RT3G5 I/O TABLE GENERATION SEGMENT ASC 3,RT3G6 PARTITION DEFINITION SEGMENT ASC 3,RT3G7 7905 DISC SUBR. SEGMENT XIF SKP * * CONVERT A TO ASCII AT B * * THE CONVD SUBROUTINE CONVERTS THE CONTENTS OF A * INTO ASCII (DECIMAL OR OCTAL) AT THE LOCATION SPECIFIED * BY B. THE CONVERTED RESULT REQUIRES 3 WORDS, AND IS * IN THE FORMAT: XXXXX, WITH A SPACE IN THE FIRST POSITION. * * CALLING SEQUENCE: * A = NO. TO BE CONVERTED. IF THE SIGN OF A IS POS., * THE CONVERSION IS TO BE IN OCTAL; IF NEGATIVE, * IN DECIMAL. * B = ADDRESS OF CORE LOCATION FOR CONVERTED RESULT * JSB CONVD * * RETURN: CONTENTS OF A AND B ARE DESTOYED. * CONVD NOP STB CURAT SET MESSAGE ADDRESS h LDB OPWRS GET ADDR OF OCTAL POWERS SSA SKIP IF OCTAL CONV REQUIRED LDB DPWRS GET ADDRESS OF DECIMAL POWERS STB RANAD SET POWER RANGE ADDRESS SSA,RSS SKIP IF NEGATIVE (DECIMAL) CMA,INA CONVERT NUMBER TO NEGATIVE STA B PUT NUMBER IN B (REMAINDER) LDA N2 STA TCNT SET CONVERSION COUNTER JSB GETD GET FIRST DIGIT IOR UBLNK ADD BLANK TO FIRST CHAR STA CURAT,I SAVE FIRST BLANK, CHARACTER ISZ CURAT INCR MESSAGE ADDRESS NEXTD JSB GETD GET NEXT DIGIT ALF,ALF ROTATE TO UPPER STA CURAT,I SAVE UPPER CHARACTER JSB GETD GET NEXT DIGIT IOR CURAT,I ADD UPPER CHAR STA CURAT,I SAVE NEXT 2 CHARACTERS ISZ CURAT INCR MESSAGE ADDRESS ISZ TCNT SKIP - 5 DIGITS IN JMP NEXTD NO - CONTINUE WITH NEXT DIGIT JMP CONVD,I YES - RETURN * OPWRS DEF *+1 OCT 10000 OCT 1000 OCT 100 OCT 10 OCT 1 * DPWRS DEF *+1 DEC 10000 DEC 1000 DEC 100 P10 DEC 10 DEC 1 * N2 DEC -2 TCNT NOP SPC 5 * * GET DIGIT FOR CONVD * * GETD PROVIDES THE ASCII CHARACTERS FOR CONVD. * * CALLING SEQUENCE: * A = IGNORED * B = REMAINDER * JSB GETD * * RETURN: * A = ASCII DIGIT * B = IGNORED * GETD NOP CLA INCRA ADB RANAD,I ADD POWER CMB,SSB,INB,SZB SKIP - TRY NEXT HIGHER DIGIT JMP GET2 DIGIT FOUND INA INCR DIGIT CMB,INB RESTORE REMAINDER TO NEGATIVE JMP INCRA TRY HIGHER DIGIT GET2 ADB RANAD,I ADD POWER CMB,INB RESTORE REMAINDER ISZ RANAD INCR POWER LIST ADDRESS IOR M60 CONVERT TO ASCII JMP GETD,I RETURN WITH DIGIT IN A * M60 OCT 60 RANAD NOP SKP * * SET UP LNK AREA * * LNKA, LNKS, AND LNKX MANAGE THE LINK AREA. * THIS AREA IS COMPOSED OF TRIPLETS AND LINK AREA * IMAGES AS FOLLOWS: * * WORD1 THE ACTUAL CORE ADDRESS OF THE LINK AREA * WORD2 THE ACTUAL CORE ADDRESS OF THE LAST WORD+1 OF THE AREA * WORD3 THE ADDRESS OF THE LOADRS IMAGE OF THE AREA * * THE FIRST THREE ENTRIES ARE FOR BASE PAGE AS FOLLOWS: * * AREA 1 THE CORE RESIDENT SYSTEM BASE PAGE AREA * AREA 2 THE BACK GROUND CORE RESIDENT AREA * AREA 3 THE CURRENT PROGRAMS BASE PAGE AREA * * FOR THESE AREA THE IMAGE IS IN THE DUMMY BASE PAGE * FOR ALL OTHER ENTRIES (I.E. FOR CURRENT PAGE LINK AREAS) * THE IMAGE FOLLOWS THE THREE WORD DEFINITION OF THE AREA. * * IN ALL CASES THE LAST DEFINED AREA IS THE ONE THAT HAS A * WORD1 ADDRESS OF CPL2, WHICH IS USUALLY THE HIGH * CURRENT PAGE LINK AREA FOR THE CURRENT PROGRAM * * LNKX INITILIZES THE SCANNING OF THE LINKAGE AREA * LNK SETS UP LNK1, LNK2, LNK3 FOR THE NEXT ENTRY * P+1 RETURN INDICATING THERE IS NO NEXT ONE. * P+2 INDICATING THAT THE SET UP WAS DONE. * * LNKS SETS UP LNK1, LNK2, LNK3 GIVEN THAT THE FIRST WORD ADDRESS * IS KNOWN (AND PASSED IN THE A REGISTER) * LNKX NOP LDA TLNK GET INITIAL ADDRESS STA LNK1 SET IN LNK1 JMP LNKX,I RETURN SPC 3 LNK NOP LDA LNK1 GET CURRENT ADDRESS CPA CPL2 IF LAST ENTRY JMP LNK,I RETURN, END OF LST * LDA A,I GET THE ACTUAL ADDRESS AND M0760 ISOLATE THE PAGE ADDRESS SZA,RSS IF BASE PAGE DO THE BP THING JMP LNKB * LDA LNK1,I ELSE CACULATE THE ADDRESS OF CMA,INA THE NEXT ADA LNK2,I ENTRY ADA LNK3,I BY SKIPPING OVER THE IMAGE LNKA JSB LNKS SET UP THE NEW AREA ISZ LNK SET OK RETURN ADDRESS JMP LNK,I RETURN * LNKB LDA LNK1 FOR BASE PAGE ADA P3 USE NEXT THREE JMP LNKA WORD AREA. SPC 3 LNKS NOP STvA LNK1 SET THE LINK POINTERS UP INA STA LNK2 INA STA LNK3 JMP LNKS,I AND RETURN SPC 3 LNK1 NOP LNK2 NOP LNK3 NOP TLNK DEF TBLNK M0760 OCT 076000 SKP * * NUMERICAL INPUT CONTROL * * THE DOCON SUBROUTINE ANALYZES THE INPUT FOR THE * CHANNEL NO., DISK SIZES, TBG CHANNEL NO. AND LAST * WORD OF AVAILABLE MEMORY. * * CALLING SEQUENCE: * A = MAX NO. OF CHARACTERS PERMITTED IN RESPONSE. * THE SIGN OF A DETERMINES THE CONVERSION FROM * ASCII TO OCTAL (POS.) OR DECIMAL (NEG.). * B = IGNORED * JSB DOCON * * RETURN: * (N+1): CONTENTS OF A AND B ARE DESTROYED. AN INVALID * CHARACTER HAS BEEN DETECTED IN THE RESPONSE, OR * THE RESPONSE CONTAINS AN INVALID NO. CHARACTERS. * THE MESSAGE IS TO BE REPEATED ON RETURN. * (N+2): A = CONVERTED RESULT * DOCON NOP JSB GETOC GET OCTAL/DECIMAL, RETURN OCTAL JMP *+4 INVALID DIGIT JSB GETAL GET NEXT CHAR FROM LBUF SZA,RSS CHAR = ZERO? (END OF BUFFER) JMP *+3 YES - CONTINUE JSB INERR INVALID DIGIT ENTRY JMP DOCON,I RETURN ISZ DOCON INCR RETURN ADDRESS LDA OCTNO GET CONVERTED NUMBER JMP DOCON,I RETURN SKP * * GET CHAR FROM LBUF, RETURN IN A * * THE FOLLOWING SUBROUTINE SUPPLIES THE CHARACTERS FOR * GETNA AND GETOC. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB GETAL * * RETURN: * A = CURRENT CHARACTER * B = DESTROYED * GETAL NOP LDA CMFLG CMFLG = COMMA-IN FLAG SZA,RSS SKIP IF NO COMMA IN JMP BLRET RETURN BLANK LDB BUFUL GET U/L FLAG IGNOR LDA CURAL,I GET CHAR FROM LBUF SZB SKIP IF LOWER CHAR ALF,ALF ROTATE TO LOWER AND M377 ISOLATE LOWER CHAR CPA STAR IF STAR CLA s TREAT AS END OF LINE SZA,RSS END OF BUFFER? JMP GETAL,I YES - RETURN WITH ZERO CMB,SZB RESET U/L, SKIP IF UPPER CHAR ISZ CURAL INCR LBUF ADDRESS STB BUFUL SAVE U/L FLAG CPA BLANK CHAR = BLANK? JMP IGNOR IGNORE BLANKS * CPA COMMA CHAR = COMMA? ISZ CMFLG RESET FLAG TO SHOW COMMA IN (SKIPS) JMP GETAL,I RETURN WITH NON-BLANK CHAR BLRET LDA BLANK REPLACE WITH BLANK CHAR JMP GETAL,I RETURN WITH BLANK * COMMA OCT 54 STAR OCT 52 BLANK OCT 40 BUFUL NOP BUFFER U/L FLAG. CMFLG NOP COMMA FLAG= -1/0= NOT IN/IN. M377 OCT 377 SKP * * MOVE ALPHA FROM LBUF TO TBUF * * THE FOLLOWING SUBROUTINE MOVES THE CHARACTERS FROM LBUF * TO TBUF. * * CALLING SEQUENCE: * A = MAX. NO. OF CHARACTERS TO BE MOVED. THE SIGN OF A * DESIGNATES THE POSITION OF THE FIRST CHARACTER. * IF THE SIGN OF A IS POSITIVE, THE FIRST CHAR IS TO * BE MOVED TO THE LOW CHAR IN TBUF. IF A IS NEGATIVE, THE * FIRST CHARACTER IS TO BE MOVED TO THE UPPER CHAR IN TBUF. * B = IGNORED * JSB GETNA * * RETURN: * A = FIRST CHAR (IF ONLY 1 CHAR) OR FIRST 2 CHARS MOVED. * B = DESTROYED * GETNA NOP CCE,SSA,RSS SET E = 1 (EVEN) POSITION CMA,CLE,INA SET E = 0 (ODD) POSITION - COMP STA MAXC MAXC = MAXIMUM NO. CHARS LDA ATBUF ATBUF = ADDR OF TBUF STA CURAT SET CURRENT TBUF ADDRESS CLB STB ATBUF,I CLEAR WORD 1 OF TBUF CCA STA CMFLG SET COMMA-IN FLAG SEZ,RSS SKIP - ODD POSITION JMP OCHAR BEGIN WITH ODD CHARACTER NEXTC JSB GETAL GET CHAR FROM LBUF SZA,RSS END OF BUFFER? LDA BLANK YES - REPLACE CHAR WITH BLANK ALF,ALF ROTATE TO UPPER A STA CURAT,I SET CHARACTER IN TBUF ISZ MAXC CHECK FOR ALL CHARS IN JMP #MNLHOCHAR GET ODD CHAR FROM LBUF LDA ATBUF,I GET FIRST 2 TRANSFERRED CHARS JMP GETNA,I YES - RETURN OCHAR JSB GETAL GET CHAR FROM LBUF SZA,RSS END OF BUFFER? LDA BLANK REPLACE ZERO CHAR WITH BLANK IOR CURAT,I ADD TO UPPER CHAR IN TBUF STA CURAT,I SET CHARS IN TBUF ISZ CURAT INCR TBUF ADDRESS ISZ MAXC CHECK FOR ALL CHARS IN JMP NEXTC NO - TRY NEXT UPPER CHAR LDA ATBUF,I GET FIRST 2 TRANSFERRED CHARS JMP GETNA,I RETURN * CURAT NOP CURRENT TBUF ADDR. ATBUF DEF TBUF MAXC NOP MAX. CHAR COUNT. SKP * * CONVERT OCT/DEC ASCII TO BINARY * * THE GETOC SUBROUTINE CONVERTS THE NEXT CHARACTERS IN LBUF FROM * ASCII (DECIMAL OR OCTAL) TO THEIR BINARY VALUE. jN* * CALLING SEQUENCE: * A = MAX. NO. OF CHARS IN CONVERSION REQUEST. IF A IS * POSITIVE, THE REQUEST IS FOR OCTAL; IF A IS NEGATIVE, * THE REQUEST IS FOR DECIMAL. * B = IGNORED * JSB GETOC * * RETURN: * (N+1): INVALID DIGIT OR OVERFLOW IN CONVERSION * (N+2): A = CONVERTED NO. * B = DESTROYED * GETOC NOP LDB N8 GET OCTAL RANGE SSA SKIP IF OCTAL REQUEST LDB N10 GET DECIMAL RANGE STB DRANG SET DIGIT RANGE SSA,RSS SKIP IF DECIMAL REQUEST CMA,INA SET REQUEST COUNT TO NEGATIVE STA MAXC SET MAX NO. OF DIGITS CCA STA DIFLG SET DATA-IN FLAG = NO DATA IN STA CMFLG SET COMMA-IN FLAG CLA STA OCTNO OCTNO = OCTAL NUMBER GETNX JSB GETAL GET CHAR FROM LBUF SZA,RSS CHAR = ZERO? (END OF BUFFER) JMP ENDOC YES - RETURN CPA BLANK CHAR = BLANK? (COMMA IN) JMP ENDOC YES - RETURN ADA L60 SUBTRACT 60B FROM CHAR STA TCHAR SAVE CHAR SSA SKIP IF VALID LOWER LIMIT JMP DGERR INVALID DIGIT ADA DRANG ADD DIGIT RANGE CLE,SSA,RSS CLEAR E - SKIP IF VALID DIGIT JMP DGERR INVALID DIGIT ISZ DIFLG INCR DATA-IN FLAG, SKIP NOP LDA OCTNO GET PREVIOUS OCTAL NO. ADA A SET A = OCTNO X 2 ADA A SET A = OCTNO X 4 LDB DRANG GET DIGIT RANGE CPB N10 RANGE = DECIMAL? ADA OCTNO SET A = OCTNO X 5 ADA A SET A = OCTNO X 10/8 ADA TCHAR SET A = NEW OCTAL NO. STA OCTNO SAVE NEW OCTAL NO. SEZ TEST FOR OVERFLOW JMP DGERR INVALID NO. ISZ MAXC SKIP IF ALL DIGITS PROCESSED JMP GETNX GET NEXT DECIMAL DIGIT ISZ GETOC INCR RETURN ADDRESS LDA OCTNO GET OCTAL EQUIVALENT DGERR JMP GETOC,I RETURN ENDOC ISZ DIFLG SKIP - NO DATA IN JMP *-4 DATA IN - NORMAL RETURN JMP GETOC,I RETURN - ERROR * TCHAR NOP TEMP CHAR SAVE AREA. DIFLG NOP DATA-IN FLAG= -1/0= NOT IN/IN. DRANG NOP DIGIT RANGE. OCTNO NOP OCTAL DIGIT. L60 OCT -60 N10 DEC -10 N8 DEC -8 SKP * * INITIALIZE CHAR TRANSFER * * THE GINIT SUBROUTINE SETS THE CURRENT ADDRESS AND UPPER/LOWER * FLAG FOR SCANNING LBUF. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB GINIT * * RETURN : CONTENTS OF A AND B ARE DESTROYED * GINIT NOP LDA ALBUF ALBUF = ADDR OF LBUF STA CURAL SET CURRENT LBUF ADDRESS CCB STB BUFUL BUFUL = BUFFER U/L FLAG JMP GINIT,I SPC 10 * * INVALID TTY RESPONSE * * THE INERR SUBROUTINE PRINTS THE DIAGNOSTIC FOR INVALID * RESPONSES DURING THE INITIALIZATION SECTION. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB INERR * * RETURN: CONTENTS OF A AND B ARE DESTROYED. * INERR NOP LDA ERR01 SET INVALID DEVICE ERROR CODE JSB GN.ER PRINT GN.ER MESSAGE JMP INERR,I RETURN SPC 1 ERR01 ASC 1,01 SKP * SUBROUTINE TO READ INPUT * RNAME NOP READ FILE NAME. ISZ RMODE JSB READ CLB STB RMODE JMP RNAME,I * * READ NOP STA READ2 SZA,RSS IF ZERO, THEN NULL PROMPT LDB ALBUF SO PUT A BOGUS ADDRESS IN READB STB READ1 READ0 JSB PROMT DEF *+6 READ1 NOP MSG BUFR NULL IF NO PROMPT. DEF READ2 ZERO LEN IF NO PROMPT. ALBUF DEF LBUF DEF P80 DEF PARSA * STA PARNO SAVE PARAM RECORD LENGTH LDA TBUF STA TEMP4 SAVE IT JSB GINIT CLA,INA JSB GETNA IF FIRST CHAR IS A BLANK CPA BLANK OR A * THEN SKIP RECORD RSS JMP READt|5 NOT SO CLA STA READ2 DON'T REISSUE PROMPT JMP READ0 * READ5 LDA TEMP4 STA TBUF RESTORE LDB RMODE CHECK WHICH ENTRY. SZB JMP READ,I LDA PARNO INA CLE,ERA CONVERT TO WORD ADDR. ADA ALBUF GET TO END OF BUFFER. CLB INSERT ZERO AT END. STB A,I JSB GINIT INITIALIZE LBUF SCAN. LDA PARNO RETURN WITH RECORD LEN. JMP READ,I SPC 1 READ2 NOP RMODE OCT 0 PARNO NOP TEMP4 NOP P80 DEC 80 SKP * ANALYZE YES/NO RESPONSE * RETURN: (P+1) ERROR * (P+2) NO * (P+3) YES * YE/NO NOP LDA N3 JSB GETNA JSB GETAL SZA MORE THEN 3 CHAR JMP YE/ER ERROR LDB ATBUF,I GET RESPONSE CPB YCHAR YE? LDA P2 YES - SET RETURN OFFSET FOR YES CPB NCHAR WAS IT NO? CLA,INA YES - SET RETURN FOR YES SZA,RSS STILL ZERO? JMP YE/ER YES - NOT YES OR NO - ERROR ADA YE/NO ADJUST RETURN JMP A,I RETURN YE/ER JSB INERR ERROR - SEND MESSAGE JMP YE/NO,I AND TAKE ERROR EXIT SPC 1 YCHAR ASC 1,YE NCHAR ASC 1,NO N3 DEC -3 SPC 5 * * NEW LINE (CR,LF) ON TTY * * THE SPACE SUBROUTINE IS USED TO SPACE UP THE TELEPRINTER. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB SPACE * * RETURN: CONTENTS OF A AND B ARE DESTROYED. * SPACE NOP LDB DBLNK GET ADDRESS OF A BLANK CLA,INA SET CHARACTER COUNT = ONE JSB DRKEY OUTPUT CR, LF ON TTY JMP SPACE,I RETURN * DBLNK DEF UBLNK UBLNK OCT 20000 SKP * * PRINT: ERR XX * * THE ERROR SUBROUTINE IS USED TO PRINT THE DIAGNOSTICS * FOR ALL ERROR MESSAGES. * * CALLING SEQUENCE: * A = 2-DIGIT ASCII ERROR CODE, IF NEG THEN DON'T DO A TR,ERRLU8. * B = IGNORED * JSB GN.ER * * RETURN: CONTENTS OF A AND B ARE DESTROYED. * GN.ER NOP PRINT ERROR MESSAGES CLE IF A IS NEG THEN SET IT POSITIVE SSA AND DON'T DO A TR CME SEZ CMA,INA STA AMERR+5 SET ERROR CODE INTO MESSAGE SEZ JMP EROUT LDA IACOM IS COMMAND LU INTERACTIVE ALREADY? SZA JMP EROUT YES * LDA TRCHK SAVE RETURN ADDRESS OF TRCHK IN CASE ITS STA ABORT CALLING ERROR LDA ATRCM SIMULATE THE "TR,ERRLU" LDB B6 JSB TRCHK GO PUSH THE STACK LDA ABORT RESTORE TRCHK RETURN ADDRESS STA TRCHK * LDA EOFFL NO MESSAGE IF EOF-GENERATED SZA JMP GN.ER,I * EROUT JSB SPACE LDA P10 LDB AMERR AMERR = MESSAGE ADDRESS JSB DRKEY PRINT ERROR MESSAGE JMP GN.ER,I RETURN * ATRCM DEF TRCOM TRCOM ASC 3,TR, XX EOFFL NOP SKP * IRRECOVERABLE ERROR EXIT * IRERR NOP JSB GN.ER PRINT GN.ER MESSAGE JSB GTERM IRRECOVERABLE ERROR * AMERR DEF *+1 ASC 5,GEN ERR ERROR MSG = ERR + CODE SPC 5 ABORT NOP FORMERLY "HLT 0B". CCA ADA ABORT GET ADDR OF ABORT CALLER. LDB DER00 JSB CONVD PUT IN MESSAGE. LDA P18 LDB ABERR JSB DRKEY DISPLAY ER00 AND ADDRESS. JSB GTERM ABORT (NO RETURN). * ABERR DEF ERR00 ERR00 ASC 9,GEN ERR 00 DER00 DEF ERR00+6 P18 DEC 18 SKP * THE INIDX,IDXS AND IDX SUBROUTINES ARE USED TO SET THE CURRENT * INDICES FOR THE ENTRY IN THE PROGRAM IDENTIFICATION * BLOCK TABLE (IDENT). THE INDEX OF THE NEXT ENTRY * IN THE IDENT TABLE IS CONTAINED IN TIDNT. ON RETURN FROM * IDX, TIDNT CONTAINS THE INDEX OF THE NEXT AVAILABLE * ENTRY IN IDENT. THE ADDRESS OF THE FIRST ENTRY IS CONTAINED * IN BIDNT AND THE # ENTRIES USED IS IN PIDNT. * * 3 IDXS FINDS AN ENTRY IN THE TABLE. * * IF THE NEXT IDENT ENTRY OVERFLOWS INTO THE LAST LST ENTRY, * IDX PRINTS A DIAGNOSTIC AND EXITS TO THE IRRECOVERABLE ERROR * SUBROUTINE. * * SET INITIAL IDENT ADDRESS * * INIDX SETS THE INDEX OF THE FIRST ENTRY IN THE IDENT * TABLE AS THE CURRENT INDEX. * * NOTE. OFFSET = 10 TO AVOID PROBLEMS WITH VALUES * 1-5 IN LST WORD 4. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB INIDX * * RETURN: CONTENTS OF A DESTROYED, B PRESERVED * INIDX NOP LDA P10 RESET CURRENT IDENT INDEX. STA TIDNT (HAS OFFSET OF 10) JMP INIDX,I RETURN SKP * IDXS FINDS AN ID ENTRY IN THE IDENT TABLE. * * CALLING SEQUENCE: * A = IGNORED * B = ADDRESS OF THE NAME TO FIND. * JSB IDXS * * RETURN: CONTENTS OF A AND B ARE DESTROYED. * (N+1): CURRENT IDENT ADDRESSES ARE FOR THE NEXT FREE ENTRY IN * THE IDENT LIST. SYMBOL NOT FOUND. * (N+2): CURRENT IDENT ADDRESSES ARE FOR THE SPECIFIED PROGRAM. * IDXS NOP JSB INIDX INIT TIDNT TO 1ST IDENT. STB INIDX SAVE POINTER TO ASCII NAME. * ** OTHER SUBS MAY WANT NAME PTR IN INIDX ** * IDXS2 JSB IDX SET IDENT ENTRY ADDRESSES. JMP IDXS,I END OF TABLE. ID1,ID2,... SET. LDB INIDX GET ADDR OF TARGET MATCH. LDA B,I CPA ID1,I CHAR 1 & 2 MATCH? INB,RSS JMP IDXS2 NO. GET NEXT ENTRY. LDA B,I CPA ID2,I CHAR 3 & 4 MATCH? INB,RSS JMP IDXS2 NO. GET NEXT ENTRY. LDA B,I XOR ID3,I AND M7400 CHECK CHAR 5. SZA JMP IDXS2 NOT THIS ENTRY. ISZ IDXS FOUND. TAKE SUCCESS RETURN. JMP IDXS,I SKP * * SET IDENT ADDRESSES FROM TIDNT * * IDX SETS THE ADDRESSES OF THE CURRENT 11-WORD ENTRY IN THE * IDENT TABLE FROM THE INDEX OF THE CURRENT ENTRY (TIDNT). * THE6\ TIDNT ENTRY MAY REFERENCE CURRENT/FORWARD/BACKWARD * BLOCKS. IDX ASSURES THAT THE PROPER BLOCK IS IN CORE. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB IDX * * RETURN: CONTENTS OF A DESTROYED, B PRESERVED. * (N+1): CURRENT IDENT ADDRESSES ARE THE ADDRESSES * OF THE NEXT AVAILABLE IDENT ENTRY, OR THE * END OF THE IDENT TABLE HAS BEEN REACHED. * (N+2): CURRENT IDENT ENTRY ADDRESSES (NOT END OF IDENT) * IDX NOP STB ID16 TEMP SAVE LDA B.I CHECK IF ENTRY IN CORE (DOT OK). CMA,INA ADA TIDNT SSA JMP IDX0 .LT. LOW ENTRY INDEX. * LDA B.I (NOT "B,I" - DOT OK) ADA EIDNT CMA,INA ADA TIDNT SSA JMP IDX2 IN CORE. * IDX0 LDA TIDNT .GT. HIGH ENTRY INDEX. ADA N10 CLB DIV EIDNT GET BLOCK NO. STA B.I TEMP SAVE... DOT OK. MPY ID.#S GET # SECTORS OFFSET. CLB DIV SECTK CHECK TRACK SPILL OVER. STB ID.CS REMAINDER= NEW CURR. SECTOR. ADA ID.BT STA ID.CT NEW CURRENT TRACK. * ADB ID.#S GET LAST+1 SECTOR OF BLOCK. CMB,INB ADB SECTK SSB,RSS JMP *+4 CLB STB ID.CS IF END NOT ON SAME TRACK, ISZ ID.CT START BLOCK ON NEXT TRACK * CPA ID.ET END OF IDENT DISK AREA? JMP LSERR YES. IDENT OVERFLOW! * JSB RDIDN WRITE/READ THE DISC. LDA B.I DOT OK. SET NEW LOW INDEX. MPY EIDNT ADA P10 ADD THE OFFSET. STA B.I DOT OK. IDX2 LDA TIDNT GET ADDR OF DESIRED ENTRY. ADA N10 ADJUST FOR OFFSET. CLB DIV EIDNT LDA B REMAINDER = OFFSET. ALF MULTIPLY BY 16 WORDS PER ENTRY ADA BIDNT STA ID1 SET ADDRESS OF NAME 1,2 INA STA ID2 SET ADDRESS OF NAME 3,4 INA STA ID3 SET ADDRESS OF NAME 5, USE FLAG INA STA ID4 SET ADDRESS OF COM/PROG LENGTH INA STA ID5 SET ADDRESS OF LINKS-MAP OPT FLAGS. INA STA ID6 SET ADDRESS OF M/S,PRIOR/DISK,TY INA STA ID7 SET ADDRESS OF LOWEST DBL. INA STA ID8 SET MAIN IDENT ADDR FOR BS INA STA ID9 SET FILE NAME ADDRESSES. INA STA ID10 INA STA ID11 INA STA ID12 SET ADDRESS OF SECURITY CODE INA STA ID13 SET ADDRESS OF CR LABEL . INA STA ID14 SET ADDRESS OF RECORD NUMBER INA STA ID15 SET ADDRESS OF REL. BLOCK INA LDB ID16 RESTORE B-REG STA ID16 SET ADDRESS OF BLK OFFSET * LDA PIDNT CHECK IF END OF IDENT. CMA,INA ADA TIDNT SSA ISZ IDX NOT END. P+2 EXIT. ISZ TIDNT SET NEXT IDENT ENTRY. JMP IDX,I RETURN * B.I DEC 10 1ST ENTRY INDEX OF CUR CORE BLOCK. * (OFFSET = 10) SPC 3 * POINTERS FOR IDENT TABLE. * BIDNT NOP FWA CORE BLOCK. TIDNT NOP CURRENT ENTRY INDEX IN CORE BLOCK. PIDNT NOP # ENTRIES USED + 10. EIDNT NOP # IDENT ENTRIES PER CORE BLOCK. LIDNT NOP # WORDS PER DISC WRITE/READ. ID.BT NOP START TRACK ID.LT NOP LAST TRACK ID.LS NOP AND SECTOR READ. ID.CT NOP CURRENT TRACK ID.CS NOP AND SECTOR (OR NEXT REQUIRED). ID.ET NOP ENDING TRACK ID.#S NOP # SECTORS PER BLOCK. * ID1 NOP ID2 NOP ID3 NOP ID4 NOP ID5 NOP ID6 NOP ID7 NOP ID8 NOP ID9 NOP ID10 NOP ID11 NOP ID12 NOP ID13 NOP ID14 NOP ID15 NOP ID16 NOP SKP * * SUBROUTINE TO WRITE-READ IDENT TABLE FROM DISC. * CALLING SEQUENCE: * JSB RDIDN * RDIDN NOP LDA ID.LS GET LAST SECTOR ADDR. LDB IDZQ.LT GET LAST TRACK ADDR. CPA ID.CS EQUAL TO CURRENT? RSS YES. JMP RDID1 NO. WRITE AND READ. CPB ID.CT SAME TRACK? JMP RDIDN,I YES, RETURN. * RDID1 LDA BIDNT STA WI1 STA WI2 * JSB EXEC WRITE OUT CURRENT BLOCK. DEF *+7 DEF P2 DEF DSKLU WI1 NOP DEF LIDNT DEF ID.LT DEF ID.LS * JSB EXEC READ NEW BLOCK. DEF *+7 DEF B1 DEF DSKLU WI2 NOP DEF LIDNT DEF ID.CT DEF ID.CS * LDA ID.CT RESET TRACK & SECTOR ADDRS. STA ID.LT LDA ID.CS STA ID.LS JMP RDIDN,I SKP * THE INLST, LSTS, LSTE AND LSTX SUBROUTINES ARE USED TO SET THE * CURRENT LOADER SYMBOL TABLE (LST) INDICES. THE INDEX OF THE * NEXT ENTRY IN LST IS CONTAINED IN TLST. ON RETURN FROM INLST, * TLST CONTAINS THE INDEX OF THE NEXT AVAILABLE ENTRY IN LST, OR * THE INDEX OF THE END OF LST. THE ADDRESS OF THE FIRST ENTRY * IN LST IS AT BLST AND THE # ENTRIES USED IS IN PLST. * * IF THE NEXT ENTRY IN LST OVERFLOWS CORE-DISC SPACE, * LSTX PRINTS A DIAGNOSTIC AND EXITS * TO THE IRRECOVERABLE ERROR SUBROUTINE. * * INLST SETS THE ADDRESS OF THE FIRST ENTRY IN LST. * INLST NOP CLA STA TLST RESET CURRENT LST INDEX. JMP INLST,I RETURN SPC 3 * LSTS SEARCHES THE LST FOR A SPECIFIED ENTRY. * * CALLING SEQUENCE: * A = IGNORED * B = ADDRESS OF THE ASCII NAME TO BE FOUND. * JSB LSTS * * RETURN: CONTENTS OF A AND B DESTROYED. * (N+1): THE END OF THE LST WAS FOUND WITH OUT FINDING THE * SYMBOL. THE LST ENTRIES ARE SET TO THE NEXT AVAILABLE * ENTRY. * (N+2): THE CURRENT LST ADDRESS POINT TO THE FOUND ENTRY. * LSTS NOP JSB INLST INIT TLST TO 1ST LST INDEX. STB INLST SAVE PTR TO ASCII NAME * ** SOME SUBS EXPECT LSTS TO STORE THIS ** * W ** POINTER IN INLST'S ENTRY POINT ** LSTS2 JSB LSTX SET LST ENTRY ADDRESSES. JMP LSTS,I END OF TABLE. .LST1,...,.LST5 SET. LDB INLST GET ADDR OF TARGET MATCH. LDA B,I CPA .LST1,I CHAR 1 & 2 MATCH? INB,RSS JMP LSTS2 NO. GET NEXT ENTRY. LDA B,I CPA .LST2,I CHAR 3 & 4 MATCH? INB,RSS JMP LSTS2 NO. GET NEXT ENTRY. LDA B,I XOR .LST3,I AND M7400 CHECK CHAR 5. SZA JMP LSTS2 NOT THIS ENTRY. ISZ LSTS FOUND. TAKE SUCCESS RETURN. JMP LSTS,I SKP * SET LST ADDRESSES FROM TLST * * LSTX SETS THE CURRENT LST ADDRESSES FROM TLST. THE TLST ENTRY * MAY REFERENCE CURRENT-FORWARD-BACKWARD BLOCKS. LSTX ASSURES * THAT THE PROPER CORE BLOCK IS IN CORE. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB LSTX * * RETURN: CONTENTS OF A DESTROYED, B PRESERVED. * (N+1): THE END OF LST IS REACHED AND THE CURRENT * LST ADDRESSES ARE THE ADDRESSES OF THE NEXT AVAILABLE * ENTRY IN LST. * (N+2): CURRENT LST ADDRESSES ARE SET (NOT END OF LST). * LSTX NOP STB .LST5 TEMP SAVE LDA B.L CHECK IF ENTRY IN CORE. CMA,INA ADA TLST SSA JMP LSTX0 .LT. LOW ENTRY INDEX. * LDA B.L ADA ELST CMA,INA ADA TLST SSA JMP LSTX2 * LSTX0 LDA TLST .GT. HIGH ENTRY INDEX. CLB DIV ELST GET BLOCK NUMBER. STA B.L SAVE FOR LATER. MPY LS.#S GET # SECTORS OFFSET. CLB DIV SECTK SEE IF TRACK SPILL OVER. STB LS.CS REMAINDER= NEW CUR. SECTOR. ADA LS.BT STA LS.CT NEW CURRENT TRACK. * ADB LS.#S GET LAST+1 SECTOR OF BLOCK. CMB,INB ADB SECTK IF END NOT ON SAME TRACK, SSB,RSS START BLOCK ON NEXT TRACK. JMP *+4 O CLB STB LS.CS ISZ LS.CT * CPA LS.ET END OF LST DISC AREA? JMP LSERR YES. LST OVERFLOW! * JSB RDSMB WRITE/READ THE DISC. LDA B.L SET NEW LOW INDEX. MPY ELST STA B.L LSTX2 LDA TLST GET ADDR OF DESIRED ENTRY. CLB DIV ELST LDA B REMAINDER= OFFSET. MPY P5 ADA BLST STA .LST1 SET WORD 1 ADDR. INA STA .LST2 SET WORD 2 ADDR INA STA .LST3 SET WORD 3 ADDR INA STA .LST4 SET WORD 4 ADDR INA LDB .LST5 RESTORE B-REG STA .LST5 SET WORD 5 ADDR LDA PLST CHECK IF END OF LST. CMA,INA ADA TLST SSA ISZ LSTX NOT END. P+2 EXIT. ISZ TLST SET NEXT LST INDEX. JMP LSTX,I RETURN * B.L OCT 0 1ST ENTRY INDEX NOW IN CORE. * LSERR LDA ERR07 JSB IRERR IRRECOVERABLE ERROR EXIT * ERR07 ASC 1,07 IDENT/LST/FIX-UP OVERFLOW. SKP * ENTER A NEW SYMBOL * * LSTE SEARCHS THE LST FOR A SYMBOL AND IF NOT FOUND ENTERS IT * IN THE LST. * * CALLING SEQUENCE: * A = IGNORED * B = SYMBOL ADDRESS * JSB LSTE * * RETURN: CONTENTS OF A AND B ARE DESTROYED. * (N+1): SYMBOL IS NEW AND WAS ENTRED, LST ADDRESS ARE SET UP * (N+2): SYMBOL WAS IN LST. LST ADDRESS ARE SET UP. * LSTE NOP JSB LSTS SEARCH FOR THE SYMBOL JMP LSTE2 IF NOT FOUND GO ENTER * ISZ LSTE STEP TO ALREADY IN LST EXIT JMP LSTE,I AND EXIT * LSTE2 LDB INLST,I GET THE FIRST CHARACTERS OF NEW STB .LST1,I SYMBOL AND SET IN THE LIST ISZ INLST STEP TO NEXT CHARACTERS LDA INLST,I GET THE CHARACTERS STA .LST2,I AND SET ISZ INLST STEP TO THE LAST CHARACTER LDA INLST,I FETCH IT AND M7400 KEEP ONLY THE HIGH CHARACTER STA .LST3,I SET IT IN THE LST CLA CLEAR STA .LST4,I THE IDENT FLAG STA .LST5,I AND VALUE FIELDS ISZ PLST BUMP # LST ENTRIES. JMP LSTE,I EXIT BACK TO THE USER. SKP * * * POINTERS FOR LOADER SYMBOL TABLE (LST). * BLST NOP FWA CORE BLOCK. TLST NOP CURRENT ENTRY INDEX IN CORE BLOCK. PLST NOP # ENTRIES USED. ELST NOP # LST ENTRIES PER CORE BLOCK. LLST NOP # WORDS PER DISC WRITE/READ. LS.BT NOP START TRACK LS.LT NOP LAST TRACK LS.LS NOP AND SECTOR READ. LS.CT NOP CURRENT TRACK LS.CS NOP AND SECTOR (OR NEXT REQUIRED). LS.ET NOP ENDING TRACK LS.#S NOP # SECTORS PER BLOCK. * .LST1 OCT 0 .LST2 OCT 0 .LST3 OCT 0 .LST4 OCT 0 .LST5 OCT 0 SKP * * SUBROUTINE TO READ/WRITE SYMBOL TABLE FROM DISC * CALLING SEQUENCE * JSB RDSMB * RDSMB NOP LDA LS.LS GET LAST SECTOR ADDRESS LDB LS.LT GET LAST TRACK ADDRESS CPA LS.CS IS IT EQUAL TO CURRENT? RSS YES JMP WTSMT NO...WRITE AND READ CPB LS.CT HOW ABOUT THE TRACK ADDRESS? JMP RDSMB,I SAME THING...DON'T DO ANYTHING * WTSMT LDA BLST STA WS1 STA WS2 * JSB EXEC GO WRITE OUT CURRENT DEF *+7 DEF P2 DEF DSKLU WS1 NOP DEF LLST DEF LS.LT DEF LS.LS * JSB EXEC READ IN NEW BLOCK DEF *+7 DEF B1 DEF DSKLU WS2 NOP DEF LLST DEF LS.CT DEF LS.CS * LDA LS.CT STA LS.LT LDA LS.CS STA LS.LS RESET TRACK SECTOR ADDRESS JMP RDSMB,I AND RETURN SKP * * THE FIXX AND FIX SUBROUTINES ARE USED TO SET THE * CURRENT FIX-UP TABLE INDICES. * * FIXX SETS THE INDEX OF THE FIRST ENTRY IN THE FIX-UP * TABLE AS THE CURRENT ENTRY. * FIXX NOP CLA STA TFIX JMP FIXX,IG SPC 5 * * FIX SETS THE CURRENT FIX-UP ADDRESSES FROM TFIX. * THE TFIX ENTRY MAY REFERENCE CURRENT-FORWARD-BACKWARD * BLOCKS. FIX ASSURES THAT THE PROPER BLOCK IS IN CORE. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB FIX * * RETURN: A LOST, B SAVED. * P+1 IF BEYOND END OF DEFINED FIX-UPS * P+2 IF DEFINED ENTRY. * FIX NOP STB FIX4 TEMP SAVE LDA B.F CHECK IF ENTRY IS IN CORE. CMA,INA ADA TFIX SSA JMP FIX0A .LT. LOW ENTRY INDEX. * LDA B.F ADA EFIX CMA,INA ADA TFIX SSA JMP FIX0C * FIX0A LDA TFIX .GT. HIGH ENTRY INDEX. CLB DIV EFIX GET BLOCK NUMBER. STA B.F MPY FX.#S GET # SECTORS OFFSET. CLB DIV SECTK SEE IF TRACK SPILL OVER. STB FX.CS REMAINDER = NEW CURRENT SECTOR. ADA FX.BT STA FX.CT NEW CURRENT TRACK. * ADB FX.#S GET LAST+1 SECTOR OF BLOCK. CMB,INB ADB SECTK IF END NO ON SAME TRACK, SSB,RSS START BLOCK ON NEXT TRACK. JMP *+4 CLB STB FX.CS ISZ FX.CT * CPA FX.ET END OF FIX-UP DISC AREA? JMP LSERR YES. FIX-UP OVERFLOW! * JSB RDFIX WRITE/READ THE DISC. LDA B.F SET NEW LOW INDEX. MPY EFIX STA B.F FIX0C LDA TFIX GET ADDR OF DESIRED ENTRY. CLB DIV EFIX LDA B REMAINDER = OFFSET. MPY P4 ADA BFIX STA FIX1 SET WORD 1 ADDR. INA STA FIX2 SET WORD 2 ADDR. INA STA FIX3 SET WORD 3 ADDR. INA LDB FIX4 RESTORE B-REG STA FIX4 SET WORD 4 ADDR. LDA PFIX CHECK IF END OF DEFINED FIX-UPS. CMA,INA ADA TFIX SSA ISZ FIX NOT END. P+2 EXIT. ISZ TFIX SET NEXT FIX-UP ENTRY. JMP FIX,I RETURN. * B.F OCT 0 LOW IN-NLHDEX OF BLOCK IN CORE SKP * * * POINTERS FOR FIX-UP TABLE. * BFIX NOP FWA CORE BLOCK. TFIX NOP CURRENT ENTRY INDEX IN CORE BLOCK. PFIX NOP # ENTRIES USED. EFIX NOP # FIX-UP ENTRIES PER CORE BLOCK. LFIX NOP # WORDS PER DISC WRITE/READ. FX.BT NOP START TRACK FX.LT NOP LAST TRACK FX.LS NOP AND SECTOR READ. FX.CT NOP CURRENT TRACK FX.CS NOP AND SECTOR (OR NEXT REQUIRED). FX.ET NOP ENDING TRACK FX.#S NOP # SECTORS PER BLOCK. * FIX1 NOP FIX2 NOP FIX3 NOP FIX4 NOP SKP * * SUBROUTINE TO READ/WRITE FIX-UP TABLE FROM DISC. * CALLING SEQUENCE: NN* JSB RDFIX * RDFIX NOP LDA FX.LS GET LAST SECTOR ADDRESS. LDB FX.LT GET LAST TRACK ADDRESS. CPA FX.CS IS IT EQUAL TO CURRENT? RSS YES. JMP RDFX1 NO... WRITE AND READ. CPB FX.CT HOW ABOUT TRACK ADDRESS? JMP RDFIX,I SAME THING... DON'T TO ANYTHING. * RDFX1 LDA BFIX STA WX1 SET BUFFER ADDRESS. STA WX2 * JSB EXEC GO WRITE OUT CURRENT BLOCK. DEF *+7 DEF P2 DEF DSKLU WX1 NOP DEF LFIX DEF FX.LT DEF FX.LS * JSB EXEC READ IN NEW BLOCK. DEF *+7 DEF B1 DEF DSKLU WX2 NOP DEF LFIX DEF FX.CT DEF FX.CS * LDA FX.CT RESET TRACK & SECTOR ADDRESSES. STA FX.LT LDA FX.CS STA FX.LS JMP RDFIX,I RETURN. SKP * * SUBROUTINE TO CLOSE AND PURGE ALL FILES * CURRENTLY OPEN TO PROGRAM IN CASE OF ABORT * * JSB GTERM * * GTERM NOP LDA P14 GO PRINT ABORT LDB DFABM MESSAGE TO THE JSB LFOUT OUTPUT LIST FILE LDA ABDCB+5 GET # OF SECTORS CLE,ERA CONVERT TO BLOCKS STA BLKS AND SAVE IT JSB CLOSF PURGE THE FILE!!! DEF *+3 DEF ABDCB DEF BLKS JSB OPEN OPEN FILE IN ORDER DEF *+4 TO PURGE IT DEF NMDCB (DON'T WANT TO DEF FMRR TO CALL PURGE) DEF .NM. JSB CLOSE PURGE TEMP NEW NAM FILE. DEF *+4 DEF NMDCB DEF FMRR DEF P64 JSB CLOSF CLOSE LIST FILE DEF *+3 DEF LFDCB DEF ZERO JSB CLOSF CLOSF RELOCATABLE INPUT FILE IF OPEN DEF *+3 DEF RRDCB DEF ZERO JSB CLOSF CLOSE ANSWER FILE DEF *+3 DEF IPDCB DEF ZERO JSB CLOSF CLOSE ECHO DEF *+3 DEF ECDCB DEF ZERO * * AT THIS POINT ALL FILES ARE CLOSED OR PURGED * TELL WORLD WE ARE DONE * LDA IALST ABORT MESSAGE ALREADY SZA PRINTED? JMP RELTR JSB EXEC PRINT OUT ABORT MESSAGE DEF *+5 DEF P2 DEF ERRLU DFABM DEF ABMSG "RT-GN ABORTED" DEF B7 * RELTR JSB EXEC RELEASE TRACKS DEF *+3 DEF P5 DEF M1 JSB EXEC AND TURN OFF DEF *+2 DEF B6 SPC 1 ABMSG ASC 1,RT IFN ASC 1,2G XIF IFZ ASC 1,3G XIF ASC 5,N ABORTED B1 OCT 1 B6 OCT 6 B7 OCT 7 BLKS NOP .NM. ASC 1,@. IFN ASC 1,NM XIF IFZ ASC 1,MN XIF ASC 1,.@ SKP * * SUBROUTINE TO WRITE ON INTERACTIVE COMMAND INPUT DEVICE * AND LIST FILE * CALLING SEQUENCE * JSB DRKEY * A REG= SIO LENGTH WORD * B REG= ADDRESS OF MESSAGE * DRKEY NOP DST ABREG SAVE A AND B REG FOR LFOUT JSB BYTCN CONVERT SIO TO USUAL INB SKIP OVER LEADING SPACE ADA M1 CUT COUNT NOT INCLUDE SPACE STA PRNTA SAVE LENGTH STB PRNTB SAVE ADDRESS LDA IALST IS THE LIST FILE AN I.A. LU? SZA JMP PRNT1 YES, SO DONT PRINT MESSAGE TWICE LDA IACOM IS THE COMMAND DEVICE I.A.? SZA,RSS JMP PRNT1 NO, SO DONT WRITE TO IT * JSB WRITF OUTPUT MESSAGE DEF *+5 DEF IPDCB TO THE INPUT DEVICE DEF FMRR PRNTB NOP DEF PRNTA LENGTH * PRNT1 DLD ABREG GET LENGTH AGAIN JSB LFOUT WRITE TO FILE JMP DRKEY,I AND RETURN SPC 1 PRNTA NOP M1 DEC -1 SKP * SUBROUTINE TO CONVERT SIO LENGTH TO POSITIVE WORDS * BYTCN NOP STA BYTCA SAVE LENGTH FOR CHECKING LATTER SSA WORDS OR CHARACTERS? JMP *+3 WORDS CMA,INA CONVERT CHAR TO WORDS ARS DIVIDE BY 2+1 STA BYTCYC SAVE IN DOWN COUNTER STB BYTCD SAVE B TEMPORARILY. LDB N40 TRUNCATE TO 40 WORDS. ADA P40 SSA STB BYTCC LDB BYTCD RESTORE B. LDA LSBFA GET ADDRESS WHERE TO PUT OUTPUT STA BYTCD SAVE FOR MOVE BYTC1 LDA B,I MOVE MESSAGE STA BYTCD,I ISZ BYTCD INB ISZ BYTCC DONE? JMP BYTC1 NO LDB BYTCA WORDS OR CHARACTERS? SSB JMP BYTC2 WORDS CLE,ERB CONVERT CHARACTERS TO WORDS SEZ,RSS ODD # OF CHAR? JMP BYTC3 NO STB BYTCC YES...SAVE COUNT FOR LATTER ISZ BYTCC INCLUDE ODD CHAR ADB LSBFA GET TO END LDA B,I AND M7400 MASK OFF LOWER HALF IOR B40 OR IN A SPACE STA B,I SAVE IT LDB BYTCC GET LENGTH AGAIN BYTC3 RSS SKIP OVER COMPLEMENTING BYTC2 CMB,INB CHANGE NEG WORDS TO + WORDS LDA B GET LENGTH IN A REG LDB OTBFA GET ADDRESS OF BUFFER...INCLUDING SPACE INA INCLUDE SPACE IN COUNT JMP BYTCN,I AND RETURN SPC 1 BYTCA NOP BYTCC NOP BYTCD NOP OTBFA DEF OTBUF LSBFA DEF OTBUF+1 OTBUF ASC 1, PRINT BUFFER BSS 40 * B40 OCT 40 N40 DEC -40 P40 DEC 40 SKP * * SBROUTINE TO WRITE ONTO A LIST FILE * CALLING SEQUENCE * JSB LFOUT * AREG = SIO LENGTH * B REG= BUFFER ADDRESS * LFOUT NOP JSB BYTCN CONVERT LENGTH STA LOUTA STB LSBF SAVE BUFFER ADDRESS FOR OUTPUTING JSB WRITF WRITE THE RECORD DEF *+5 LDCBA DEF LFDCB DEF FMRR LSBF NOP LIST BUFFER ADDRESS HERE DEF LOUTA * LDA FMRR SSA,RSS JMP LF0 NO LIST FILE ERROR * LDB LFERR ARE WE ACKNOWLEDGING LIST FILE SZB,RSS ERRORS? JMP LF0 NO * CMA,INA SET POSITIVE FOR CONVERSION STA FMRR JSB CNUMD CONVERT ERROR CODE TO ASCII DEF *+3 DEF FMRR DEF FERMA ADDRESS OF ERROR MESSAGE LDA FERMA+2 PICK OFF CODE STA FERMA * JSB WRITF DEF *+5 SEND A BLANK LINE DEF ECDCB DEF FMRR DEF C4040 DEF B1 * JSB WRITF SEND: DEF *+5 FMP ERR -XX DEF ECDCB DEF FMRR DEF FILEA+1 (CHFIL WASN'T CALLED BECAUSE DEF B6 IT CALLS ... LFOUT) * LDA ERR22 STORE GEN ERROR CODE IN MESSAGE STA AMERR+5 JSB WRITF SEND: DEF *+5 GEN ERR 22 DEF ECDCB DEF FMRR DEF AMERR+1 (GN.ER WASN'T CALLED BECAUSE DEF P5 IT CALLS ... LFOUT) * ASKAG JSB WRITF ASK: DEF *+5 "OK TO CONTINUE?" DEF ECDCB DEF FMRR DEF OKAY? DEF P8 * LDA ERRLU SET ECHO BIT IN IOR B400 EXEC CONTROL STA FMRR WORD GETAN JSB EXEC RETRIEVE OPERATOR'S ANSWER DEF *+5 DEF B1 DEF FMRR DEF ECBF DEF N2 SZB,RSS SKIP IF INPUT RECEIVED JMP GETAN ELSE GET AGAIN * CLA SET TO IGNORE ALL FUTURE LIST STA LFERR FILE ERRORS INA TURN ECHO ON STA ECHON * LDA ECBF OKAY? CPA YCHAR "YE" JMP LF0 YES-CONTINUE CPA NCHAR "NO" JSB GTERM NO-ABORT JMP ASKAG ASK AGAIN * LF0 LDA ECHON ARE WE TO ECHO? SZA,RSS JMP LFOUT,I NO * LDA IALST IS THE LIST FILE AN SZA,RSS INTERACTIVE LU? JMP LF1 NO, GO CHECK COMMAND INPUT LDB LSTLU IS THE LIST LU SAME AS CPB ERRLU LU OF OPERATOR CONSOLE? JMP LFOUT,I YES - DON'T ECHO * LF1 LDA IACOM IS THE COMMAND INPUT SZA,RSS FROM AN INTERACTIVE LU? JMP LF2 NO - SO PERFORM ECHO LDB CMDLU .IS THE COMMAND LU THE CPB ERRLU SAME AS OP CONSOLE? JMP LFOUT,I YES - SO DON'T ECHO * LF2 LDA LSBF SET BUFFER ADDRESS STA ECBF JSB WRITF AND OUTPUT IT DEF *+5 DEF ECDCB DEF FMRR ECBF NOP DEF LOUTA JMP LFOUT,I AND RETURN * ECHON NOP ECHO FLAG, 1=ON LOUTA NOP LFERR NOP LIST FILE ERROR ACKNOWLEDGER,0=NO,1=YES ERR22 ASC 1,22 LIST FILE GEN. ERROR CODE OKAY? ASC 8,OK TO CONTINUE? SKP * SUBROUTINE TO OPEN A RELOCATABLE FILE AND ADVANCE TO THE * NAM GIVEN IN THE CURRENT IDENT ENTRY. THE FILE IS LEFT OPEN. * THE NAM DESIRED MAY BE IN THE SAME FILE AS THE PREVIOUS ONE. * * CALLING SEQUENCE: * * A = BUFFER ADDRESS FOR NAM RECORD. * B = 0, DON'T COMPARE BUFFER FILE NAMES * JSB RDNAM * ERROR RETURN * NORMAL RETURN: A = # WORDS. * RDNAM NOP STA RDNMA SAVE BUFFER ADDRESS. SZB,RSS SKIP IF CHECK WANTED JMP RDNM1 LDB DPRS2 CHECK WHETHER RDBIN'S FILE NAME INB IS THE SAME AS IN IDENT. LDA B,I CPA ID9,I INB,RSS JMP RDNM1 NO MATCH. LDA B,I CPA ID10,I INB,RSS JMP RDNM1 NO MATCH. LDA B,I CPA ID11,I INB,RSS JMP RDNM1 NO MATCH LDA B,I CPA ID12,I SECURITY CODE INB,RSS JMP RDNM1 NO MATCH LDA B,I CPA ID13,I CR LABEL JMP RDNM3 THE NAMES MATCH. GO SEARCH. * RDNM1 JSB CLOSE NAMES DO NOT MATCH. CLOSE THIS DEF *+3 FILE AND GET THE RIGHT ONE. DEF RRDCB DEF FMRR * LDA P2 SET TYPE = ASCII. STA PARS2 LDA ID9,I STORE FILE NAME FROM IDENT. STA PARS2+1 LDA ID10,I STA PARS2+2 LDA ID11,I STA PARS2+3 LDA ID12,I GET SECURITY CODE STA PRS31 LDA ID13,I AND CR LABEL STA PRS41 * RDNM3 LDA RDNMA RESTORE BUFFER ADDRESS. CCB SIGNAL RDBIN TO CALL APOSN. JSB RDBIN READ NEXT RECORD FROM FILE. JMP RDNAM,I ERROR. SZA,RSS JMP RDNM3 EOF. MUST HAVE BEEN PAST THE NAM. * ISZ RDNAM SET FOR NORMAL EXIT. JMP RDNAM,I * RDNMA NOP RDNMB NOP SKP * SUBROUTINE TO GET NAME * OPEN,READ AND CLOSE A RELOCATABLE FILE. * CALLING SEQUENCE * JSB RDBIN * ERROR RETURN * NORMAL RETURN * * A REG= BUFFER ADDRESS * B REG: 0 = NULL * 1 = LOCATE BEFORE READ. * -1 = POSITION BEFORE READ. * UPON RETURN * A REG=0 EOF OR A = NUMBER OF WORDS. * RDBIN NOP STA RBINA SAVE BUFFER ADDRESS STB RBINB SAVE CODE. LDA RRDCB+9 SEE IF DCB OPEN CPA 1717B IS IT OPEN JMP RBIN2 YES...DON'T RE OPEN RBIN1 JSB FOPEN TRY TO OPEN FILE DEF *+3 DEF RRDCB DEF B300 JSB CHFIL JMP RDBIN,I RBIN2 LDA RBINB GET CODE. SZA,RSS JMP RBOPN ZERO = NO ACTION. * CPA M1 JMP RBIN3 -1 = PRE-POSITION THE FILE. ADA M1 1 = GET THE FILE POSITION. SZA JMP RBOPN UNDEFINED. ASSUME ZERO. * JSB LOCF GET POSITION OF NEXT DEF *+6 RECORD IN THE FILE. DEF RRDCB DEF FMRR DEF NAMRC DEF NAMBL DEF NAMOF * JMP RBIN4 * RBIN3 JSB APOSN POSITION THE FILE. DEF *+6 DEF RRDCB DEF FMRR DEF ID14,I DEF ID15,I DEF ID16,I * RBIN4 JSB CHFIL JMP RDBIN,I * RBOPN JSB READF READ THE FILE DEF *+6 DEF RRDCB DEF FMRR DEF RBINA,I DEF D60 MAX OF 60 WORDS DEF RLEN LENGTH OF RECORD JSB CHFIL SEE IF ANY ERROR JMP RDBIN,I ERROR...DO ERROR RETURN LDA RLEN GET LENGTH SZA,RSS IGNORE ZERO LENGTH RECORDS.  JMP RBOPN ISZ RDBIN GET NORMAL RETURN. CPA M1 EOF? RSS JMP RDBIN,I NO JSB CLOSF YES...CLOSE FILE DEF *+3 DEF RRDCB DEF ZERO CLA TELL THEM END OF FILE JMP RDBIN,I AND RETURN SPC 2 RBINA NOP RELOC. INPUT BUFFER ADDRESS RBINB NOP " FILE POSITION FLAG RLEN NOP " RECORD LENGTH NAMRC NOP NAMBL NOP NAMOF NOP SKP * * SUBROUTINE TO OPEN A FILE * CALLING SEQUENCE * JSB FOPEN FILE OPEN * DEF *+3 * DEF DCB ADDRESS * DEF SUBFUNCTION FOR READ OR WRITE IN CASE A TYPE 0 FILE * * ASSUMES THAT PARS2+1=FILE NAME * PARS3+1=SECURITY CODE * PARS4+1=LU * ODCBA NOP SUBF NOP FOPEN NOP JSB .ENTR DEF ODCBA LDA ODCBA GGET DCB ADDRESSPE LDB SUBF,I GET SUBFUNCTION JSB TYP0 CHECK IF TYPE IS 0 JMP FOPEN,I YES EXIT JSB OPEN TRY TO OPEN FILE DEF *+7 DEF ODCBA,I DEF FMRR DEF PARS2+1 NAME DEF ZERO OPEN OPTION DEF PARS3+1 SECURTIY CODE DEF PARS4+1 LOGICAL UNIT JMP FOPEN,I RETURN SKP * * SUBROUTINE TO CREATE A DUMMY TYPE 0 FILE * CALLING SEQUENCE * LDA DCB ADDRESS * LDB SUBFUNCTION * JSB TYP0 * RETURN HERE(P+1) IF IT IS TYPE 0 * RETURN HERE(P+2) IF IT IS NOT TYPE 0 * * TYP0 NOP STA T0DCB LDA PARS2 CMA,INA,SZA IF NULL OR NUMERIC (TYPE 0,1) INA,SZA,RSS THEN OPEN A DUMMY TYPE 0 JMP TYP1 ISZ TYP0 OTHERWISE TAKE NOT JMP TYP0,I TYPE 0 EXIT TYP1 LDA PARS2+1 GET LU SZA,RSS IF NOT DEFINED INA DEFINE AS LU = 1 STA PARS2+1 CLA JSB SETIT SET DIRECTORY JSB SETIT ADDRESS TO ZERO JSB SETIT ALSO SET TYPE TO 0 LDA PARS2+1 GET LOGICAL UNIT ._ IOR B MERGE IN SUBFUNCTION JSB SETIT AND SET IN DCB JSB EXEC GET DRIVER TYPE DEF *+4 DEF P13 DEF PARS2+1 DEF EQT5 LDA EQT5 GET TYPE ALF,ALF ROTATE TO LOW A AND M77 AND MASK STA EQT5 SAVE CPA P5 IF TYPE 5, MUST RSS JMP NOT05 CCA ADA DRT DETERMINE ITS SUBCHANNEL ADA PARS2+1 FROM THE LU LDA A,I ALF,RAL AND B7 STA SUB05 SAVE THE SUBCHANNEL * LDA EQT5 NOT05 LDB B100 GET EOF CONTROL SUBFUNCTION CPA P5 RSS JMP TYP2 LDA SUB05 IF SUBCHANNEL 0 SZA,RSS JMP TYP3 JMP SEOF * TYP2 ADA MD17 IF TYPE > 16 SSA,RSS JMP SEOF SET EOF CODE * TYP3 LDB B1000 LDA EQT5 CPA P2 IS DRIVER A PUNCH JMP SEOF GO SET LEADER GENERATION CLB SZA,RSS IF TYPE=0 DON'T DO PAGE EJECT JMP SEOF CPA P5 RSS JMP TYP4 LDA SUB05 NEED TO GET SUBCH ON A TYPE 5 SZA,RSS JMP SEOF * TYP4 LDB B1100 LINE SPACE OPTION SEOF LDA PARS2+1 GET LU IOR B MERGE EOF CONTROL SUBFUNCTION JSB SETIT SET IN DCB CLA JSB SETIT SET NO SPACING LEGAL LDA B1001 SET READ&WRITE LEGAL JSB SETIT AND SECURITY CODES AGREE JSB SETIT AND UPDATE MODEES AGREE LDA 1717B GET MY ID ADDRESS ISZ T0DCB INCREMENT TO WORD 9 JSB SETIT SET OPEN FLAG LDA T0DCB ADA P3 STA T0DCB SET TO WORD 13 CLA SET IN CORE BUFFER FLAG JSB SETIT TO ZERO INA JSB SETIT SET RECORD COUNT CLA STA FMRR CLEAR ERROR CODE FOR TYPE 0 LDB EQT5 IF THIS IS A MT UNIT CPB P5 OR DVR05 DEVICE RSS CPB B23 THEN DON'T WRITE AN EOF JMP TYP0,I LDB T0DCB GET˗ DCB ADDRESS ADB MD11 RESET TO WORD5, CONTROL FUNC LDB B,I GET CONTROL WORD STB SETIT SAVE IN TEMP LOCATION JSB EXEC DO AN EOF DEF *+4 DEF P3 DEF SETIT TEMP WHERE FUNCTION CODE LOCATED DEF MD17 FORCE A PAGE EJECT OR LEADER CLA JMP TYP0,I * * SETIT NOP STA T0DCB,I SET IN DCB ISZ T0DCB INCREMENT TO NEXT WORD JMP SETIT,I * * T0DCB NOP EQT5 NOP MD17 DEC -17 MD11 DEC -11 B23 OCT 23 B100 OCT 100 B300 OCT 300 B1000 OCT 1000 B1001 OCT 100001 B1100 OCT 1100 SPC 2 D60 DEC 60 SUB05 NOP TYPE 5 SUBCHANNEL DRT EQU 1652B SKP * * SUBROUTINE TO CREATE A FILE * CALLING SEQUENCE * JSB CRETF * DEF *+5 * DEF DCB ADDRESS * DEF SIZE * DEF TYPE * DEF SUBFUNCTION FOR READ/WRITE IN CASE A TYPE 0 FILE * * ASSUMES THAT PARS2+1=FILE NAME * PARS3+1=SECURITY CODE * PARS4+1=LU * SPC 1 CDCBA NOP CSIZ NOP CTYP NOP CSBUF NOP CRETF NOP JSB .ENTR DEF CDCBA JSB FOPEN GO TRY TO OPEN THE FILE DEF *+3 DEF CDCBA,I DEF CSBUF,I SZA,RSS TYPE 0? JMP CRETF,I YES...RETURN JSB CLOSE IF NOT CLOSE FILE IF OPEN DEF *+3 DEF CDCBA,I DEF FMRR JSB CREAT TRY CREATING THE FILE DEF *+8 DEF CDCBA,I DEF FMRR DEF PARS2+1 DEF CSIZ,I DEF CTYP,I DEF PARS3+1 DEF PARS4+1 JMP CRETF,I SKP * * SUBROUTINE TO CLOSE A FILE * USED TO DETERMINE IF CLOSING A DUMMY TYPE 0 * CALLING SEQUENCE * JSB CLOSF * DEF *+3 * DEF DCB ADDRESS * DEF TRUNCATE OPTION (DEFAULT IS ZERO) * * CLDCB NOP COPTN DEF ZERO CLOSF NOP JSB .ENTR DEF CLDCB LDA CLDCB,I GET DIRECTORY DISC ADDRESS SZA,RSS IF ZERO JM P FCLS1 THEN DUMMY DCB JSB CLOSE ELSE DO STANDARD CLOSE DEF *+4 DEF CLDCB,I DEF FMRR DEF COPTN,I FCLS1 LDA DFZER RESET THE OPTION WORD STA COPTN IN CASE NOT SUPPLIED NEXT TIME LDA CLDCB,I SZA JMP CLOSF,I DONE WITH FILES LDA CLDCB MAKE SURE DUMMY DCB CLOSED. ADA D9 CLB STB A,I LDA CLDCB SEE IF LIST DCB CPA LDCBA RSS YES IT IS JMP CLOSF,I NO ADA P4 STA FCLS2 SAVE FOR EXEC CALL JSB EXEC DO A PAGE EJECT DEF *+4 DEF NABP3 CONTROL REQUEST FCLS2 NOP LU DEF MD17 PAGE EJECT CODE NOP JMP CLOSF,I AND RETURN * * D9 DEC 9 NABP3 OCT 100003 NO ABORT 3 * SKP * * SUBROUTINE TO CLOSE THE ABSOLUTE CORE IMAGE FILE * * CALLING SEQUENCE * JSB CLSAB * NORMAL RETURN * * THIS ROUTINE WILL DELETE UNUSED FILE AREA * CLSAB NOP ASSUMES NO EXTENTS BEC TYPE 1 CLB LDA FMRR GET DISKD ERROR CODE SSA IF NEGATIVE THE EXACT SIZE WAS CORRECT JMP SETBL LDA ABDCB+3 TRK CMA,INA ADA ABDCB+10 CTRK - TRK MPY ABDCB+8 (CTRK - TRK) * #SEC/TR LDB ABDCB+4 CMB,INB ADA B (CTRK - TRK) * #S/TR - SEC ADA ABDCB+11 (CTRK - TRK) * #S/TR - SEC + CSEC ARS CONVERT TO NUMBER OF BLOCKS LDB ABDCB+5 GET NUMBER OF SECS CLE,ERB CONVERT TO BLOCKS CMA,INA SET CURRENT BLOCK NEG ADB A # OF BLKS - CURRENT BLK CCA ADB A ONE MORE FOR GOOD MEASURE SETBL STB TMP JSB CLOSF DEF *+3 DEF ABDCB DEF TMP JMP CLSAB,I * TMP NOP ABDCB BSS 144 ABS FILE DCB SKP * * SUBROUTINE TO PRINT COMMAND AND ACCEPT * INPUT. * CALLING SEQUENCE * JSB PROMT * DEF *+6 * DEF ֐PRINT MESSAGE BUFFER * DEF LENGTH (IN SIO FORMAT) * DEF REPLY ADDRESS * DEF LENGTH (IN + # OF CHARACTERS) * DEF PARSE BUFFER * * A REG= + NUMBER OF CHARACTERS * PMEMB NOP PMEML NOP PRADD NOP PRLEN NOP PPARS NOP PROMT NOP JSB .ENTR DEF PMEMB PRMT1 LDB PMEMB GET BUFFER ADDRESS LDA PMEML,I GET LENGTH SZA SKIP IF NO QUESTION. JSB DRKEY PRINT QUESTION PRMT5 LDA PRLEN,I GET LENGTH INA CONVERT TO WORDS CLE,ERA STA PRMTA SAVE LENGTH CMA,INA CONVERT TO NEGATIVE WORD COUNT STA PRMTB SAVE IN TEMP LDB PRADD GET ADDRESS WHERE TO SPACE FILL LDA C4040 SPACE WORD STA B,I INB ISZ PRMTB DONE? JMP *-3 NO JSB READF GO GET INPUT DEF *+6 DEF IPDCB FROM INPUT DEVICE DEF FMRR DEF PRADD,I DEF PRMTA DEF PRMTB JSB CHFIL SEE IF WE HAD A FILE ERROR JMP INPRR LDA PRMTB GET LENGTH FOR PRINT ON FILE SSA,RSS IS IT A END OF FILE JMP PRMT2 NO LDA IACOM IF THE COMMAND INPUT IS FROM AN SZA INTERACTIVE LU, THEN JMP PRMT1 TRY AGAIN FOR RESPONSE LDA TR ELSE GO SIMIULATE A TR STA PRADD,I COMMAND TO POP LDA PRADD THE STACK LDB P2 ISZ EOFFL SIGNAL NO ERROR MESSAGE JMP PRMT3 * INPRR CLA FORCE AN INPUT FILE ERROR STA IACOM AND A TR,ERRLU LDA ERR20 JSB GN.ER JMP PRMT1 TRY AGAIN * PRMT2 SZA,RSS IF ZERO-LENGTH RECORD JMP PRMT5 SIMPLY SKIP AND RETRY CLE,ELA CONVERT TO CHARACTERS STA PRMTB LDA IALST IF LIST DEVICE A FILE SZA,RSS (NON-INTERACTIVE) JMP PRMTL THEN ECHO INPUT CPA IACOM IF BOTH COMMAND AND LIST FILE RSS ARE INTERACTIVE, JMP PRKMTL LDA LSTLU THEN SEE IF THEY'RE TO THE SAME CPA CMDLU LU JMP PRMTN YES, SO DON'T ECHO INPUT * PRMTL LDB PRADD GET INPUT LDA PRMTB JSB LFOUT WRITE IT ONTO LIST FILE * PRMTN LDA PRADD,I SEE IF THEY WANT OUT? CPA !! JSB GTERM YES...GET OUT AND M7400 CHECK FIRST CHARACTER FOR CPA ASTER AN * MEANING A COMMENT JMP PRMT5 GO GET NEXT COMMAND CPA LCOMM CHECK FIRST CHARACTER JMP PRMT6 FOR A , OR : MEANING CPA LCOLN A "TR" RSS JMP PRMT7 LDA PRADD,I ADA B171 CONVERT TO A , FOR PARSE STA PRADD,I JMP PRMT6 PRMT7 LDA PRADD,I GET AGAIN JSB PARSE DEF *+4 DEF PRADD,I DEF PRMTB DEF PPARS,I LDB PPARS GET FIRST 2 CHARS. INB LDA B,I CPA TR TRANSFER COMMAND? RSS JMP PRMT4 NO - GO EXIT INB YES - BUT CHECK LDA B,I FURTHER FOR A AND M7400 BLANK OR A CPA LBLNK COMMA IN CHARACTER 3 JMP PRMT6 CPA LCOMM RSS JMP PRMT4 PRMT6 LDA PRADD GET BUFFER ADDRESS LDB PRMTB GET LENGTH PRMT3 JSB TRCHK GO DO TR THING CLA RESET IF EOF-GENERATED STA EOFFL JMP PRMT1 GO RETRY COMMAND PRMT4 LDA PRMTB GET ACTUAL REPLY LENGTH JMP PROMT,I AND RETURN SPC 1 C4040 ASC 1, !! ASC 1,!! TR ASC 1,TR ASTER OCT 25000 * PRMTA NOP PRMTB NOP LBLNK OCT 20000 LCOMM OCT 26000 , LCOLN OCT 35000 : B171 OCT 171000 SKP * SUBROUTINE TO DETERMIN IF STACK IS TO * BE PUSHED OR POPPED * * IF PUSHED, IT CLOSES THE CURRENT FILE, * SAVES RC,AND OPENS NEW FILE * * IF POPPED, IT CLOSES THE CURRENT FILE, * OPENS THE PREVIOUS FILE, AND POSITIONS * IT TO THE PROPER RECORD * SPC 1 TRCHK NOP STB PRMTB SAVE LEN̜NLHGTH STA TRCH1 SET BUFF ADDR. JSB PARSE GO REPARSE DEF *+4 TRCH1 NOP DEF PRMTB DEF BPARS LDA PARS2 GET FILE TYPE SZA IF NOT NULL JMP TR3 GO TO PUSH * TR1 JSB CLOSF CLOSE THE CURRENT FILE DEF *+3 DEF IPDCB DFZER DEF ZERO JSB POP GO POP STACK JMP POPRR ERROR, NO MORE ENTRIES STA RC SAVE RECORD COUNT JSB FOPEN OPEN PREVIOUS FILE DEF *+3 DEF IPDCB DEF B400 JSB CHFIL JMP TRCHK,I FILE ERROR - STAY AT ERRLU LDA IPDCB+2 GET TYPE SZA,RSS IF TYPE 0 JMP TRCHK,I EXIT LDA RC GET RECORD COUNT CMA,INA SET NEGATIVE AND STA COUNT SAVE TR2 ISZ COUNT ARE WE THERE YET? N RSS JMP TRCHK,I YES...GET OUT JSB READF READ A RECORD DEF *+6 DEF IPDCB DEF FMRR DEF PRADD,I DEF ZERO DEF RL JSB CHFIL JMP TRCHK,I ERROR - STAY AT ERRLU LDA RL SSA IF EOF...POP STACK JMP TR1 JMP TR2 GET NEXT RECORD SKP * * PLACE NEW INPUT FILE ON STACK AND PUSH * TR3 LDA IPDCB+14 GET REC NUMBER OF NEXT RECORD STA RC SAVE AS CURRENT RECORD # JSB CLOSF GO CLOSE THE FILE DEF *+3 DEF IPDCB DEF ZERO LDA RC GET RECORD COUNT JSB PUSH GO PUSH STACK JMP PUSHR ERROR - STACK OVERFLOW JMP TR4 OPEN FILE JSB RECOV INVALID LU SPECIFIED LDA ERR20 RECOVER AND ISSUE JSB GN.ER ERROR MESSAGE JMP TRCHK,I * TR4 JSB FOPEN GO OPEN NEW FILE DEF *+3 DEF IPDCB DEF B400 LDA FMRR AN ERROR? SSA,RSS JMP TRCHK,I RETURN (MAY BE TO CHFIL ITSELF) STA PUSH SAVE ERROR VALUE JSB RECOV RECOVER PREVIOUS ENTRY LDA PUSH RESTORE STA FMRR JSB CHFIL ISSUE ERROR & TRANSFER TO ERRLU JMP TRCHK,I AND RETURN * PUSHR CCA ADA P:TR RESET THE POINTER FOR POP STA P:TR JSB RECOV RECOVER PREVIOUS ENTRY * POPRR CLA INSURE THAT A "TR,ERRLU" IS DONE STA IACOM LDA ERR19 TRANSFER STACK UNDERFLOW OR OVERFLOW JSB GN.ER JMP TRCHK,I SKP RECOV NOP RECOVERS THE PREVIOUSLY OPEN STACK ENTRY JSB POP JMP NONET NONE THERE STA RC JSB FOPEN GO OPEN THE FILE DEF *+3 DEF IPDCB DEF B400 LDA RC STA IPDCB+14 JMP RECOV,I NONET CLA "TR,ERRLU" MUST BE DONE STA IACOM JMP RECOV,I * ERR19 ASC 1,19 ERR20 ASC 1,20 COUNT NOP RC NOP RL NOP B400 OChT 400 SKP * * SUBROUTINE TO PUSH AND POP A STACK * STACK DEFINITION * WORD 6= RECORD COUNT FOR NEXT RECORD TO READ * WORD 5= CARTRIDGE REFERENCE NUMBER * WORD 4= SECURITY CODE * WORD 3= 0 ELSE CH5 & CH6 * WORD 2= 0 ELSE CH3 & CH4 * WORD 1= LU ELSE CH1 & CH2 * WORD 0= TYPE...1=TYPE 0, 2=REGULAR * * PUSH-PLACES FILE NAME AND TYPE ON STACK * LEAVES POINTER AT RECORD COUNT (WORD 6) * ASSUMES PARS2 CONTAINS INFO NEEDED * * CALLING SEQUENCE * LDA RC OF CURRENT FILE * JSB PUSH * (P+1) ERROR RETURN STACK OVERFLOW * (P+2) NORMAL RETURN * (P+3) ERROR RETURN INVALID LU * SPC 1 PUSH NOP STA P:TR,I SAVE CURRENT RECORD COUNT ISZ P:TR INCREMENT TO BEGINNING OF NEXT ENTRY LDA ENDST GET END OF STACK ADDRESS CPA P:TR IF = JMP PUSH,I THEN OVERFLOW DLD PARS2 SAVE TYPE DST P:TR,I ISZ P:TR ISZ P:TR DLD PARS2+2 STORE CHARS 3-6 DST P:TR,I ISZ P:TR ISZ P:TR LDA PARS3+1 GET SECURITY CODE LDB PARS4+1 AND CRN DST P:TR,I ISZ P:TR ISZ P:TR JSB STATE SET THE STATES IACOM AND CMDLU ISZ PUSH INVALID LU ISZ PUSH SET FOR NORMAL RETURN JMP PUSH,I AND RETURN SKP * * SUBROUTINE THAT MOVES THE POINTER TO PREVIOUS * STACK ENTRY * PLACES RECORD COUNT IN A REG * LEAVES POINTER AT REC. COUNT * * CALLING SEQUENCE * JSB POP * ERROR RETURN * NORMAL RETURN * A REG=REC. COUNT * SPC 1 POP NOP LDA P:TR GET CURRENT POINTER ADA MD13 DECREMENT TO PREVIOUS ENTRY LDB STKAD GET STACK ADDRESS CMB,INB ADB A IF CURRENT LESS THAN SSB START OF STACK JMP POP,I NO MORE ENTRIES STA P:TR SET AS NEW POINTER DLD P:TR,I GET OLD ENTRY DST PARS2 ISZ P:TR INCREMENT TO WORDS 3 AND 4 ISZ P:TR DLD P:TR,I DST PARS2+2 ISZ P:TR ISZ P:TR DLD P:TR,I STA PARS3+1 STB PARS4+1 ISZ P:TR ISZ P:TR JSB STATE SET THE STATES IACOM AND CMDLU NOP INVALID LU ERROR NOT POSSIBLE HERE LDA P:TR,I GET RECORD COUNT ISZ POP GET NORMAL RETURN JMP POP,I AND RETURN SPC 2 STKAD DEF STACK BSS 1 STACK BSS 70 ALLOWS A NESTING LEVEL TO 10 ENDST DEF * P:TR DEF STACK-1 MD13 DEC -13 SKP * * STATE SETS THE CURRENT "STATE" FLAGS IACOM AND CMDLU, * REFLECTING THE.NEW COMMAND INPUT DEVICE/FILE. * ASSUMES PARS2 AND PARS2+1 CONTAIN THE TYPE * AND FIRST PARAMTER, RESPECTIVELY * * CMDLU = LU #, ELSE 0 FOR ASCII FILE * IACOM = 0 IF A NON-INTERACTIVE LU, OR FILE * = 1 IF AN INTERACTIVE LU * * RETURN (P+1) ERROR - INVALID INPUT LU SPECIFIED * (P+2) NORMAL * STATE NOP DLD PARS2 GET WORD0 = PARAMETER TYPE CPA P2 & WORD1 = PARAMETER CLB A TYPE 2 IS A FILE NAME STB CMDLU SO IS 0, OR THE LU CPA P2 JMP STATF FILE NAME, GO SET IACOM TO 0 * SSB JMP STATE,I CAN'T BE < 0 ADB N64 CHECK IF LU > 63 SSB,RSS JMP STATE,I TOO BAD! * JSB EXEC GET LU TYPE FROM EQT DEF *+5 DEF NAB13 NO-ABORT 13 CALL DEF CMDLU DEF EQT5 DEF EQT4 JMP STATE,I EXEC ERROR RETURN LDA EQT4 CHECK FOR VALID LU AND M77 IF THE SELECT CODE IS 0 SZA,RSS THEN ITS THE BIT BUCKET JMP STATE,I WE'RE EXPECTING INUT FROM! * LDA EQT5 ALF,ALF GET TYPE TO LOW A AND M77 STA EQT5 SAVE IT LDB CMDLU CPA P5 TYPE 5 ? JSB LUSUB YES, GO RETRIEVE ITS SUBCHANNEL ^ CLB * STATF SZA,RSS TYPE 0, OR TYPE 5'S SUBCHANNEL 0? INB YES, SO AN INTERACTIVE DEVICE STB IACOM 0 = NOT IA, 1 = IA ISZ STATE JMP STATE,I * EQT4 NOP NAB13 OCT 100015 SKP * * LUSUB RETURNS IN (A) THE SUBCHANNEL FOR THE LU * SPECIFIED IN (B). * LUSUB NOP CCA ADA DRT POSITION TO CORRECT DEVICE REFERENCE ADA B TABLE ENTRY FOR THE LU LDA A,I ALF,RAL AND B7 STA SUB05 JMP LUSUB,I SKP * * FILE CHECK ROUTINE * CALLING SEQUENCE * JSB CHFIL * ERROR RETURN * NORMAL RETURN * MUST SEND ERROR PRAM TO FMRR * CHFIL NOP LDA FMRR SSA,RSS ANY ERRORS? JMP FNOER CMA,INA SET POS FOR CONVERT STA FMRR JSB CNUMD GET DEC ERROR CODE DEF *+3 DEF FMRR DEF FERMA ERROR MESSAGE ADDRESS LDA FERMA+2 GET LAST TWO CHARACTERS STA FERMA SAVE FOR MESSAGE LDA IACOM DETERMINE IF WE ARE TO BRANCH TO SZA THE ERROR LU JMP ROUT NO, SINCE ALREADY GET INPUT FROM IA DEVICE * LDA TRCHK SAVE ITS RETURN ADDRESS STA DISKA IN A TEMP LDA ATRCM SIMULATE A "TR,ERRLU" LDB B6 JSB TRCHK DO THE TR LDA DISKA RESTORE THE RETURN ADDRESS STA TRCHK * ROUT JSB SPACE LDA P12 LDB FILEA JSB DRKEY SEND ERROR TO USER RSS FNOER ISZ CHFIL GET NORMAL RETURN IF NO ERROR JMP CHFIL,I AND RETURN SPC 2 FILEA DEF *+1 ASC 5,FMP ERR - FERMA ASC 4, FMRR NOP SKP * * INCREMENT DISK ADDRESS * * THE DISKA SUBROUTINE INCREMENTS THE CURRENT DISK ADDRESS * TO PROVIDE THE ADDRESS OF THE SUCCEEDING SECTOR, * WHETHER THAT SECTOR IS ON THE SAME TRACK OR THE FOLLOWING * TRACK. * * NOTE... THIS ROUTINE IS GOOD FOR MH & 7905 DISC. * ... MUST BE MODIFIED FOR FH. * * CALLING SEQUENCE: * A = CURRENT DISK ADDRESS * B = IGNORED * JSB DISKA * * RETURN: * A = NEXT DISK ADDRESS * B = DESTROYED * DISKA NOP STA B SAVE CURRENT ADDRESS AND M177 ISOLATE SECTOR NUMBER INA ADD 1. CPA SDS#T IF = TO MAX NO. ON SYS. DISC, CLA SET # = 0, STA DISKT AND SAVE NEW SECTOR #. LDA B ISOLATE ALF,ALF TRACK RAL ADDRESS AND M777 IN LOW A. CLB IF NEW CPB DISKT SECTOR # = 0, INA ADD 1 TO TRACK #. * ALF,RAL RESTORE TRACK # TO 14-07, RAL,RAL AND IOR DISKT INSERT SECTOR #. JMP DISKA,I -RETURN. * DISKT NOP -TEMPORARY STORAGE M177 OCT 177 M777 OCT 777 SDS#T DEC 96 SYSTEM DISK SECTORS PER TRACK SDS# NOP SKP * * DISK INPUT DRIVER * * THE DISKI SUBROUTINE CONTROLS THE INPUT FROM THE DISK. * * THIS ROUTINE USES A CORE BUFFER TO MAKE THE DISC APPEAR TO HAVE * 64 WORD SECTORS. * * NOTE... THIS ROUTINE IS GOOD FOR MH & 7905 DISC. * ...MUST BE MODIFIED FOR FH. * * * CALLING SEQUENCE: * A = DISK ADDRESS * B = CORE ADDRESS * JSB DISKI * * RETURN: CONTENTS OF A AND B ARE DESTROYED. * DISKI NOP CLE,ERA SET EVEN SECTOR ADDRESS STB DISKO SAVE CORE ADDRESS FOR MOVE LDB OUBUF+1 GET OUTBUFFER ADDRESS CPA OUBUF REQUESTED SECTOR IN OUTBUFFER? JMP DIS01 YES - GO MOVE * LDB INBUF+1 REQUESTED SECTOR IN INBUFFER? CPA INBUF ? JMP DIS01 YES GO MOVE * ELA SECTOR NOT IN CORE GO CCE TO DRIVER JSB DISKD TO READ THE SECTOR LDA DCMND SET TO SHOW CLE,ERA SECTOR IN STA INBUF CORE LDB INBUF+1 GET BUFFER ADDRESS DIS01 LDA N64 SET COUNT FOR 64 STA DISKT WORDS SEZ IF ODD SECTOR ADB P64 ADD 64 TO LOCAL BUFFER ADDRESS DIS03 LDA B,I MOVE THE STA DISKO,I ISZ DISKO 64 INB WORDS ISZ DISKT TO THE JMP DIS03 USER BUFFER * JMP DISKI,I RETURN SKP * * DISK OUTPUT DRIVER * * THE DISKO SUBROUTINE CONTROLS ALL OUTPUT TO THE * DISC. IT USES A CORE BUFFER TO MAKE THE DISC APPEAR TO HAVE 64 * WORD SECTORS. * * NOTE... THIS ROUTINE IS GOOD FOR MH & 7905 DISC. * ...MUST BE MODIFIED FOR FH. * * CALLING SEQUENCE: * A = DISK ADDRESS * B = CORE ADDRESS * JSB DISKO * * RETURN: CONTENTS OF A AND B ARE DESTROYED. * DISKO NOP STB DISKI SAVE CORE ADDRESS LDB DSKA GET LAST MAX ADDRESS CMB,INB SET NEG AND ADB A SUBTRACT FROM CURRENT ACCESS SSB,RSS IF CURRENT HIGHER STA DSKA THEN RESET MAX. CLE,ERA SET TO EVEN SECTOR CPA OUBUF SAME AS CURRENT SECTOR? JMP DIS02 YES - GO MOVE * ELA,CLE NO - SET TO WRITE CURRENT SECTOR STA DISKA SAVE REQUEST ADDRESS LDA OUBUF GET BUFFER ADDRESS FOR CORE SECTOR LDB OUBUF+1 GET CORE ADDRESS OF THE SECTOR ELA,CLE CLEAR E FOR WRITE JSB DISKD WRITE THE SECTOR LDA DISKA GET THE REQUESTED SECTOR LDB OUBUF+1 AND LOCAL BUFFER ADDRESS CCE SET E FOR READ JSB DISKD READ THE SECTOR LDA DISKA SET TO SHOW IT IS IN CLE,ERA STA OUBUF CORE DIS02 LDB INBUF IF CURRENT WRITE BUFFER CPA B IS THE READ CCB BUFFER THEN STB INBUF SHOW READ BUFFER EMPTY LDB N64 SET COUNTER FOR STB DISKT 64 WORDS LDB OUBUF+1 GET THE LOCAL BUFFER ADDRESS SEZ IF ADDRESS IS ODD ADB P64 64 TO THE BUFFER LOCATION DIS04 LDA DISKI,I MOVE STA B,I THE INB ISZ DISKI TO THE ISZ DISKT LOCAL JMP DIS04 BUFFER AND * JMP DISKO,I RETURN * DSKA NOP SPC 3 OUBUF OCT 2 DEF BUFOU OUTPUT BUFFER ADDRESS INBUF OCT -1 INBUF IN CORE FLAG (IMPOSSIBLE) DEF BUFIN INPUT BUFFER ADDRESS BUFIN BSS 128 INPUT BUFFER FOR DISC BUFOU BSS 128 OUTPUT BUFFER FOR DISC SKP * * THE DISKD SUBROUTINE PERFORMS ALL I/O TO THE CORE-IMAGE * RTE SYSTEM OUTPUT FILE. THROUGHOUT THE GENERATOR, DISC * ADDRESSES ARE USED AND MAINTAINED AS IN THE OFF-LINE * VERSION SINCE RTE REQUIRES LOCATIONS OF ITEMS ON THE DISC. * DISC ADDRESSES ARE RELATIVE TO THE START OF THE DISC, THUS * ARE RELATIVE TO THE START OF THE OUTPUT FILE. * * DISKD CONVERTS THE DISC ADDRESS IN THE A-REG (64 WORD BASIS) * TO A RECORD NUMBER WITHIN THE TYPE 1 OUTPUT FILE. READF * AND WRITF CALLS SPECIFY THIS RECORD NUMBER IN ORDER TO * SATISFY THE RANDOM ACCESS NATURE OF I/O TO THIS FILE. * * CALLING SEQUENCE: * * A = DISC ADDR ON A 64 WORD/SECTOR BASIS. * IF NEGATIVE, IMPLIES THAT THE HEADER RECORD IS * TO BE WRITTEN * B = CORE ADDRESS. * E = 1 FOR READ, * = 0 FOR WRITE. * * JSB DISKD * * RETURN - ALWAYS NORMAL, REGS DESTROYED. * DISKD NOP SSB,RSS IF NEGATIVE,THEN WE'RE JMP DIS0 WRITING THE HEADER RECORD STB HEADR WSET FLAG CMB,INB CLA,INA STA NUM FOR THE WRITE * DIS0 STB BUFR1 STORE CORE ADDR IN STB BUFR2 READF AND WRITF CALLS. CLB ELB STB FMRR TEMP SAVE READ-WRITE CODE. * * COMPUTE RECORD NUMBER * FROM THE DISC ADDRESS. * LDB HEADR SSB JMP DIS1 HEADER RECORD - WRITE IT STA DCMND SAVE DISC ADDR. AND M177 ISOLATE SEJCTOR (64 BASIS). STA SECT1 XOR DCMND ISOLATE THE TRACK. ELA,CLE,ERA ALF,ALF RAL MPY SDS#T MULT. BY # 64 WD SECT/TRACK. ADA SECT1 ADD OFFSET. CLE,ERA FORM 128 WORD SECTOR # (0,1,2,,,) ADA P2 GET RECORD NUMBER (2,3,4,,,) STA NUM SAVE FOR CALL. * DIS1 LDA FMRR SEE IF READ OR WRITE. SZA JMP READD * JSB WRITF WRITE. DEF *+6 DEF ABDCB DEF FMRR BUFR1 NOP DEF IL DEF NUM * LDA FMRR CHECK FOR END OF FILE. ADA P12 SZA JMP CHK NOT END. LDA ERR17 IRRECOVERABLE ERROR! JSB IRERR * READD JSB READF READ. DEF *+7 DEF ABDCB DEF FMRR BUFR2 NOP DEF IL DEF LEN DEF NUM * * IGNORE -12 ERROR (EOF SENSED) ON READ: THAT RECORD * HAS NOT YET BEEN WRITTEN. BUFFER WILL CONTAIN * GARBAGE BUT OK FOR PACKING PURPOSES. * LDA FMRR CPA N12 JMP DISKD,I RETURN * CHK JSB CHFIL CHECK FOR ERRORS. JSB GTERM ERROR - ABORT. CLA STA HEADR RESET JMP DISKD,I NO ERROR, RETURN. * DCMND NOP SECT1 NOP NUM NOP IL DEC 128 LEN NOP N12 DEC -12 P12 DEC 12 ERR17 ASC 1,17 HEADR NOP HEADER RECORD FLAG SKP * * OUTPUT ABSOLUTE PROGRAM WORD * * LABDO PUTS OUT THE CURRENT ABSOLUTE CODE WORD FOR THE PROGRAM * BEING LOADED. IT FILLS THE GAPS WITH ZERO CODES IF THE * CURRENT WORD FALLS BEYOND THE HIGHEST PREVIOUSLY GENERATED * WORD. * * LABDO WORKS FROM A TABLE OF THREE WORDS WHICH DEFINE * THE CURRENT CODE SEGMENT'S DISC ADDRESS. THIS TABLE IS * AS FOLLOWS: * * ABDSK,I IS THE BASE DISC ADDRESS OF THE CURRENT CODE SEGMENT * ABCOR,I IS THE BASE CORE ADDRESS OF THE CURRENT CODE SEGMENT * MXABC,I IS THE MAX CORE ADDRESS OBTAINED SO FAR IN THE SEGMENT * * MXABC,I SHOULD BE INITILIZED TO ABCOR,I AND WILL BE UPDATED BY * THIS ROUTINE AS THE LOAD ADVANCES. * * THIS ROUTINE HAS NO RESTRICTIONS ON BACKING UP AND OVERLAYING. * * CALLING SEQUENCE: * A = CURRENT ABSOLUTE CODE WORD * B = CORE ADDRESS OF THE WORD * JSB LABDO * * RETURN: A-REG HAS PREVIOUS CONTENTS OF MODIFIED WORD. * B-REG HAS CORE ADDRESS PLUS ONE * LABDO NOP SSB IF LESS THAN ZERO THEN JMP LABDO,I OVER FLOW OF MEM SO IGNOR * STB CASAV SAVE THE CORE ADDRESS STA INSAV AND THE CODE WORD ADB L2000 IF ADDRESS SSB IS ON THE JMP LABBP BASE PAGE GO DO SPECIAL * LDA ABCOR SAVE CURRENT BASE PRAM STA LABTM IN LOCAL TEMP LDB A,I IF THE CURRENT CORE LDA P5 ADDRESS IS LESS CPA PTYPE THAN THIS BASE AND SEG. LOAD CMB,INB,RSS JMP LAB01 NOT A SEG LOAD * ADB CASAV IF BOTH CONDITIONS TRUE SSB THEN JSB USER SET UP TO FIX MAIN. LAB01 LDB CASAV RESTORE THE CORE ADDRESS CMB,INB COMPUTE OFFSET FROM OLD ADB MXABC,I MAX INB AND STB LABSK SET THE SKIP COUNT (-# TO SKIP) LDA MXABC,I GET THE CURRENT MAX INA PLUS ONE SSB,RSS IF NOT SKIPPING LDA CASAV USE GIVEN ADDRESS LDB ABCOR,I AND COMPUTE CORE CMB,INB ADDRESS OFSET ADA B FROM THE BASE ADDRESS SSA DIAGOSTIC HALT JSB ABORT SHOULD NEVER BE NEGATIVE CLB PREPARE TO DIVIDE DIV P64 DIVIDE BY THE SECTOR SIZE ADB ADBUF SET DBUF OFFSET STB CURAD SET ADDRESS FOR TSTEL * STA B SAVE THE SECTOR COUNT LDA ABDSK,I GET THE BASE DISC ADDRESS CMB,INB,SZB,RSS SET THE COUNT NEGATIVE JMP FSTAD IF ZERO USE FIRST ADDRESS * STB ABCNT SET THE CALL COUNTER LABSA JSB DISKA BUMP THE DISC ADDRESS ISZ ABCNT THE SPECIFIED NUMBER JMP LABSA OF TIMES * FSTAD STA NEWDA SET THE NEW DISC ADDRESS CPA OLDDA IF SAME AS OLD JMP LABIC SECTOR IS IN CORE * LDA OLDDA GET THE OLD ADDRESS LDB ADBUF AND BUFFER ADDRESS SSA,RSS IF REAL DISC ADDRESS JSB DISKO WRITE THE BUFFER LDB LABSK GET THE SKIP COUNT CMB,INB SET POSITIVE LDA ADBUF IF FIRST WORD OF BUFFER CPA CURAD AND NOT BACKING SSB UP RSS JMP LABRD SKIP THE READ * LDB ADBUF READ IN THE SECTOR LDA NEWDA TO BE MODIFIED JSB DISKI LABRD LDA NEWDA UPDATE THE DISC STA OLDDA ADDRESS LABIC LDA LABSK GET THE SKIP COUNT SSA,RSS IF NONE TO SKIP JMP LABOU JUST OPUTPUT THE WORD * LABFI CLA ELSE FILL JSB TSTEL WITH ZEROS ISZ LABSK DONE? JMP LABFI NO DO NEXT WORD * LABOU LDA INSAV GET THE WORD JSB TSTEL OUTPUT IT STB LBSAV SAVE PRIOR CONTENTS OF WORD LDA CASAV GET THE CORE ADDRESS LDB A IF NEW CMB,INB MAXIMUM ADB MXABC,I THEN SSB SET STA MXABC,I SET IT LDA LABTM RESET JSB SETDS THE PRAMETERS LDA OLDDA IF NEW MAX CMA,INA DISC ADDRESS ADA DSKAD THEN LABEX LDB CASAV INB SSA,RSS SKIP RETURN JMP LABX2 * LDA OLDDA AND STA DSKAD UP DATE THE DISC ADDRESS LABX2 LDA LBSAV SET PRIOR CONTENTS OF WORD JMP LABDO,I AND THEN RETURN SPC 2 LABBP LDB CASAV GET THE CORE ADDRESS ADB ADBP ADJUST FOR DUMMY BASE PAGE ADDRESS LDA B,I RETURN OLD STA LBSAV CONTENTS LDA INSAV OF WORD. STA B,I SET THE WORD CLA SET TO FOURCE EXIT u JMP LABEX AND GO EXIT SPC 2 LABTM NOP NEWDA NOP OLDDA OCT -1 LABSK NOP INSAV NOP CASAV NOP ABDSK NOP ABCOR NOP MXABC NOP LBSAV NOP USED HERE AND IN TSTEL * TO RETURN OLD VALUE OF * MODIFIED WORD. ABCNT NOP CURAD NOP L2000 OCT -2000 DSKAD NOP PTYPE NOP SKP * * SETDS SETS ABDSK,MXABC,ABCOR TO A,A+1,A+2 * FOR USE BY LABDO * SETDS NOP STA ABCOR SET INA THE STA MXABC ADDRESS INA FOR STA ABDSK THE ABS OUTPUT ROUTINE JMP SETDS,I RETURN SPC 3 * USER SETS UP THE LABDO SPECIFICATION ADDRESSES FOR * USER WORK * * CALLING SEQUENCE * * JSB USER * USER NOP LDA DUSER GET DEF TO USER ARRAY JSB SETDS AND SET IT UP JMP USER,I RETURN SPC 3 * USERS SETS UP THE LABDO SPECIFICATION ADDRESSES FOR * USER CODE USING THE CURRENT DISC ADDRESS,AND PPREL * FOR THE CORE ADDRESS. * * CALLING SEQUENCE: * * JSB USERS * USERS NOP JSB USER SET UP THE ADDRESSES JSB SET SET UP THE ADDRESSES JMP USERS,I RETURN SPC 2 * SET SETS THE CURRENT PPREL AND DISC ADDRESSES IN THE * CURRENT LABDO SPECIFICATION TABLE * * CALLING SEQUENCE * * JSB SET * SET NOP LDA DSKAD GET CURRENT DISC ADDRESS STA ABDSK,I SET IT IN THE SPEC BUFFER LDA PPREL GET THE CURRENT CORE ADDRESS STA ABCOR,I AND SET STA MXABC,I IT UP JMP SET,I RETURN SPC 2 * SEGS SETS UP A NEW LABDO AREA FOR SEGMENTS * THE SAME AS USERS. * SEGS NOP JSB SEG GO SET THE ADDRESSES JSB SET SET THE PRAMATERS JMP SEGS,I RETURN SPC 2 * SEG IS THE SEGMENT VERSION OF USER * SEG NOP LDA DSEGS GET THE ADDRESS JSB SETDS SET IT UP JMP SEE:G,I RETURN SPC 3 * SYS SETS UP THE LABDO SPECIFICATION ARRAY TO POINT AT THE * SYSTEM TABLE. * * CALLING SEQUENCE: * * JSB SYS * SYS NOP LDA DLRMA GET THE SYSTEM SPEC. ADDRERSS JSB SETDS SET UP THE ADDRESSES JMP SYS,I RETURN SPC 2 DLRMA NOP DUSER DEF *+1 BSS 3 DSEGS DEF *+1 BSS 3 SKP * * TEST FOR ABSOLUTE BUFFER FULL * * TSTEL PUTS OUT THE CURRENT ABSOLUTE BUFFER WHEN IT * CONTAINS 64 WORDS OF CODE. IN ADDITION, IT CHECKS FOR * * CALLING SEQUENCE: * A = CURRENT WORD * B = IGNORED * JSB TSTEL * * RETURN: A DESTROYED, B HAS OLD CONTENTS * OF ADDRESSED WORD. * TSTEL NOP LDB CURAD IF THE ADB N64 CURRENT ADDRESS CPB ADBUF IS THE END OF THE BUFFER JMP TSTFL THEN IT IS FULL * TSTOU LDB CURAD,I SAVE OLD WORD CONTENTS STA CURAD,I SET THE WORD ISZ CURAD BUMP THE ADDRESS JMP TSTEL,I AND RETURN * TSTFL STA SCW SAVE THE CURRENT WORD LDA OLDDA GET THE DISC ADDRESS LDB ADBUF AND BUFFER ADDRESS AND STB CURAD SET THE NEW BUFFER ADDRESS JSB DISKO OUTPUT THE BUFFER LDA OLDDA UP DATE JSB DISKA THE DISC STA OLDDA ADDRESS LDA SCW RESTORE THE CODE WORD JMP TSTOU AND GO OUTPUT IT * N64 DEC -64 SCW NOP ADBUF DEF *+1 DBUF BSS 64 HED RTGEN CONSTANTS AND WORKING STORAGE. * * * RTGEN CONSTANTS AND WORKING STORAGE. * P13 DEC 13 P14 DEC 14 M77 OCT 77 P64 DEC 64 ZERO NOP M7400 OCT 177400 CMDLU NOP LSTLU NOP ERRLU DEC 1 DEFAULT VALUE IACOM NOP INTERACTIVE COMMAND DEVICE, 0=NO, 1=YES IALST NOP INTERACTIVE LIST DEVICE, 0=NO, 1=YES SECTK NOP DSKLU NOP MAPFG NOP IF COMMON MAPPED BY SYSTEM NUMPG NOP TYPMS NOP CPLSB NOP ASKEY NOP ADDR OF 1ST SHORT ID'S EY NLHWORD. SISDA NOP SKEYA NOP SPC 3 DPRS2 DEF PARS2 . EQU * PARS1 BSS 4 .. EQU * PARS2 BSS 1 PRS21 BSS 3 PARS3 BSS 1 PRS31 BSS 3 PARS4 BSS 1 PRS41 BSS 3 PARS5 BSS 1 PRS51 BSS 3 SPC 1 ORG . BPARS BSS 42 ORG .. PARSA BSS 42 SPC 3 * * I-O LU # * PARMA EQU PARS2+1 SPC 1 * * DEFINE DCB'S * LFDCB BSS 144 ECDCB BSS 144 RRDCB BSS 144 IPDCB BSS 3 INDB3 BSS 141 NMDCB BSS 144 * SPC 2 END EQU * END START \NASMB,Z,R,L,C HED RTGN1 - 7900 RTGEN SUBROUTINE SEGMENT. IFN ASSEMBLY OPTION "N" FOR RTE-II NAM RT2G1,5,90 92001-16031 771216 XIF IFZ ASSEMBLY OPTION "Z" FOR RTE-III NAM RT3G1,5,90 92060-16037 771216 XIF * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAME: RT2G1/RT3G1 * SOURCE: 92001-18031/92060-18037 * RELOC: 92001-16031/92060-16037 * WRITTEN BY: K. HAHN, J. HARTSELL, G. ANZINGER * * * SUBROUTINE ENTRY POINTS: * ENT DSETU,PTBOT ENT DSTB ENTRY FOR DSTBL. ENT FSEC ENTRY FOR FSECT. ENT DLRM1 * * * * EXTERNAL UTILITY SUBROUTINES: * EXT CRETF,WRITF,CLOSF,FMRR,CHFIL,DISKD EXT DRKEY,SWRET,RNAME EXT DOCON,SPACE,READ,GETNA,GINIT,GETOC,GETAL EXT INERR,YE/NO,LSTE,LSTS,ABORT,LABDO EXT PIOC,TBCHN * * EXT .LST5,OUBUF EXT LWASM,TBUF,SDS#,PPREL * A EQU 0 B EQU 1 SUP SKP * THE FOLLOWING BLOCK OF STORAGE FOR VARIABLES PRECEEDS, * AND IS REFERENCED BY, EACH SEGMENT. IT IS NOT OVERLAID * AS EACH NEW SEGMENT IS LOADED INTO CORE. * * THE LOCATION OF EACH VARIABLE MUST BE THE SAME IN * ALL SEGMENTS. IF A CHANGE IS MADE, MAKE THE SAME * CHANGE IN THE REST OF THE SEGMENTS. * * * SYSCH BSS 1 SUBCHANNEL OF SYSTEM UNIT. AUXCH BSS 1 SUBCHANNEL OF AUX UNIT. DSIZE BSS 1 DISK SIZE -NO. OF TRACKS. DAUXN BSS 1 AUXILIARY DISK SIZE. ADS# BSS 1 AUX DISC SECTORS/TRACK. * * RELOCATION BASE TABLE. RBTA BSS 1 ABSOLUTE PROGRAM BASE. TPREL BSS 1 CURRENT PROGRAM BASE ADDRESS. TPBRE BSS 1 BASE PAGE RELOCATION ADDRESS. COMAD BSS 1 CURRENT COMMON RELOCATION BASE. BSS 1 ABS PROGRAM BASE FOR MR CODE. * WDCNT BSS 1 TEMPORARY WORD COUNTER. DSKSY BSS 1 INITIAL ID SEGMENT DISK ADDRESS IDSP BSS 1 POSITION OF 1ST ID SEG. IN SECT TTYCH BSS 1 SYSTEM TTY CHANNEL NO. * PLFLG BSS 1 PROGRAM LOAD. FLAG = -1/0 = L/NL DSCNT BSS 1 DISK SEGMENT SECTOR COUNT * NXFLG BSS 1 ENT/EXT FLAG = -1/0 EXCNT BSS 1 SYMBOL COUNTER * LCNT BSS 1 CURRENT LBUF COUNT DCNT BSS 1 CURRENT DBUF COUNT CURAI BSS 1 CURRENT IBUF COUNT * CPLS BSS 1 ADDRESS OF TOP OF FIXED CP LINK IMAGE CPL1 BSS 1 ADDRESS OF LOW CURRENT PAGE LINK SPECS. CPL1H BSS 1 NUMBER OF CURRENT PAGE LINKS ASSIGNED CPL2H BSS 1 IN LOW AND HIGH AREA RESPECTIVELY URBP1 BSS 1 LWA R/T DISC RES BP LINK AREA BPMAX BSS 1 MAX USED BASE PAGE LINKAGE +1 CURAK BSS 1 CURRENT KBUF ADDRESS * CURAT BSS 1 CURRENT TBUF ADDRESS TCNT BSS 1 CURRENT TBUF COUNT * CURAP BSS 1 CURRENT PLIST ADDRESS * AMAD BSS 1 CURRENT MLIST ADDRESS * LICNT BSS 1 LONG ID SEGMENT COUNT SICNT BSS 1 SHORT ID SEGMENT COUNT SSCNT BSS 1 BG. SEG ID COUNT COMRT BSS 1 MAXIMUM RT COM LENGTH COMBG BSS 1 MAX BG COM LENGTH * DSKEY BSS 1 CURRENT KEYWORD DISK ADDRESS DSKID BSS 1 DISK ID SEGMENT ADDRESS KEYCN BSS 1 TOTAL KEYWORD COUNT KEYCT BSS 1 CURRENT KEYWORD COUNT * MLIST BSS 11 MEMORY MAP BUFFER * TEMP1 BSS 1 TEMP2 BSS 1 LWH1 BSS 1 LWH2 BSS 1 LWH3 BSS 1 LWH4 BSS 1 L01 BSS 1 * FSYBP BSS 1 FIRST WORD SYS BP LINKAGE SYSAD BSS 1 CURRENT ID SEGMENT ADDRESS * TBREL BSS 1 CURRENT BP RELOC ADDR PBREL BSS 1 INITIAL BP RELOC ADDR * RELAD BSS 1 CURRENT CORE RELOCATION ADDRESS * BSBAD BSS 1 BG SEGMENT BP RELOC ADDR BSPAD BSS 1 BG SEGMENT PROG RELOC ADDR * LFLAG BSS 1 PROGRAMS-LOADED FLAG IMAIN BSS 1 CURRENT MAIN IDENT INDEX. HDFLG BSS 1 HEADING FORMAT FLAG CIDNT BSS 1 CURRENT MAIN IDENT INDEX. * AEQT BSS 1 ADDRESS OF EQUIPMENT TABLE CEQT BSS 1 NO. ENTRIES IN EQUIPMENT TABLE * ASQT BSS 1 ADDR OF DEVICE REFERENCE TABLE CSQT BSS 1 NO. ENTRIES IN DEV. REF. TABLE * AINT BSS 1 ADDRESS OF INTERRUPT TABLE CINT BSS 1 NO. ENTRIES IN INTERRUPT TABLE * DSKIN BSS 1 DISK ADDR OF INT CODE RECORD INTCN BSS 1 RECORD COUNT OF INT CODE * CURIL BSS 1 CURRENT ILIST ADDRESS ILIST BSS 64 USER SYSTEM PROG IDENT ADDR LIST * IDSAV BSS 1 INDEX OF CURRENT IDENT. DSKMN BSS 1 INITIAL MAIN DISK ADDRESS BSSDP BSS 1 INITIAL DISK RES MAIN BSS DISP PRENT BSS 1 PRIMARY ENTRY POINT DBLAD BSS 1 CURRENT DBL ADDRESS REKEY BSS 1 INSTRUCTION TYPE BYTE INSCN BSS 1 INSTRUCTION TYPE COUNTER INSTR BSS 1 CURRENT INSTRUCTION PAGNO BSS 1 CURRENT PAGE NO. OPRND BSS 1 CURRENT OPERAND PLGTH BSS 1 PROGRAM LENGTH DRT2 BSS 1 DISK DRT ENTRY ( SYSTEM) DRT3 BSS 1 AUX DISK DRT ENTRY LIBFG BSS 1 LDTYP BSS 1 SCH1 BSS 1 INDEX OF IDENT OF PGM TO BE SCHEDULED SCH3 BSS 1 ADDRESS OF CURRENT ID SEGMENT SCH4 BSS 1 ADDRESS OF THE SCHEDULED PGM ID SEG FGBGC BSS 1 BACKGROUND USING FG COMMON FLAG $LIBR BSS 1 INDEX OF $LIBR ENT $LIBX BSS 1 INDEX OF $LIBX ENT CUPRI BSS 1 * MEM1 BSS 1 MEM2 BSS 1 MEM3 BSS 1 MEM4 BSS 1 MEM5 BSS 1 MEM6 BSS 1 MEM7 BSS 1 MEM8 BSS 1 MEM9 BSS 1 MEM10 BSS 1 MEM11 BSS 1 MEM12 BSS 1 * IFZ ***** BEGIN MEU CODE ***** COMSZ BSS 1 #WORDS COMMON DECLARED FOR * }v CURRENT MAIN LPCOM BSS 1 LAST PAGE CONTAINING ANY COMMON FPSAM BSS 1 1ST PAGE CONTAINING S.A.M. FWSAM BSS 1 1ST WORD CONTAINING S.A.M. LPSYS BSS 1 LAST PAGE CONTAINING SYS OR LIB FPDSK BSS 1 1ST PAGE DISK PART AREA LOLNK BSS 1 LOW LINK FOR SSGA,LIB, OR SYS HILNK BSS 1 HI LINK USED BY MEM RES PRG BPINC BSS 1 CURR DIRECTION FOR BP LINK * ALLOCATION. +1=UP,-1=DOWN BPLMT BSS 1 WORD AFTER LAST WORD AVAIL * FOR BP LINK ALLOCATION TPMAX BSS 1 HWM FOR RELOCATION OF BG * MAINS AND SEGS MAXPT BSS 1 NUM PARTS. ALLOWED MAT. BSS 1 ADR OF LENGTH WORD * BEFORE MEM ALLOC TABLE (MAT) SSGA. BSS 1 FWA SSGA (LAST WORD SYS * OR LIB +1) FWMRP BSS 1 FWA MEM RES PROG AREA * (NEXT WORD AFTER COMMONS) MAP. BSS 1 PTR TO MEU RES MAP MPFT. BSS 1 PTR TO MPFT ****** END MEU CODE ****** XIF * SECTR BSS 0 BOOTSTRAP BUFFER FORMAT * LBPSY BSS 1 LOWER SYSTEM BP ADDRESS UBPSY BSS 1 UPPER SYSTEM BP ADDRESS DSKBP BSS 1 SYS BP DISK ADDRESS * LRMAN BSS 1 MAIN RESIDENT LOWER ADDRESS URMAN BSS 1 MAIN RESIDENT UPPER ADDRESS DSKRR BSS 1 MAIN RESIDENT DISK ADDRESS * LBMAN BSS 1 MAIN BG LOWER ADDRESS UBMAN BSS 1 MAIN BG UPPER ADDRESS DSKBG BSS 1 MAIN BACKGROUND DISK ADDRESS * SYMAD BSS 1 AVAIL SYS MEM ADDR BGBND BSS 1 BACKGROUND BOUNDARY * DSKAV BSS 1 NEXT AVAILABLE DISK ADDRESS DSKLC BSS 1 DISK ADDRESS OF LIBRARY CODE DSKLB BSS 1 DISK ADDR OF LIBRARY ENTRY PTS DSKUT BSS 1 UTILITY PROG DISK ADDRESS DSKBS BSS 1 DISK ADDR OF MAIN BG DISK RES BP DSKBR BSS 1 CURRENT MAIN BG DISK RES DISK ADu ADICT BSS 1 ADDR OF DISK DICTIONARY LBCNT BSS 1 RESIDENT LIBR ENTRY PT COUNT UTCNT BSS 1 UTILITY LIBRARY COUNT KEYAD BSS 1 CURRENT KEYWORD ADDRESS RTCAD BSS 1 RT COM CORE ADDRESS LBCAD BSS 1 LIBRARY CODE ADDRESS SYBAD BSS 1 ADDR OF FIRST BP LINK FOR BG IDSAD BSS 1 ADDR OF FIRST ID SEGMENT ABSID BSS 1 IDENT ADDR FOR NEXT BG SEG SCAN MAXRP BSS 1 MAXIMUM RT DISK RESIDENT PROG MAXRB BSS 1 MAXIMUM RT DISK RESIDENT BP IDMBS BSS 1 BG MAIN ADDRESS FOR BS REF * TB30 BSS 128 TRACK MAP TABLE #SUBC BSS 1 # SUBCHANNELS DEFINED(7905) SPC 4 ********************************************************* * * * END OF COMMON STORAGE BLOCK FOR ALL SEGMENTS. * * * ********************************************************* SPC 2 DLRM1 DEF LRMAN SKP * * THIS SEGMENT CONTAINS THE DISC DEPENDENT SUBROUTINES * FROM THE MH RTGEN DRIVER SECTION. THE FOLLOWING ARE * THE MODIFICATIONS MADE TO THE OFF-LINE VERSIONS. * * * DSETU - IN RTGN1: CALLED BY MAIN. * --MODIFICATIONS: SCRATCH DISC OMITTED. * * DSSIZ - IN RTGN1; CALLED BY DSETU. * * TSTCH - IN RTGN1; CALLED BY DSETU. * --MODIFICATIONS: INIT1 FLAG OMITTED. * * STDSK - IN RTGN1; CALLED BY PTBOT. * * PTBOT - IN RTGN1; CALLED BY MAIN. * --MODIFICATIONS: INITS CALL OMITTED, * PAPER TAPE BOOT WRITTEN ON FMP FILE. * * INITS - OMITTED. * * INIER - OMITTED. * * DSTBL - IN RTGN1; CALLED BY RTGN5 VIA MAIN. * --SLIGHT MODIFICATION. * * DISKA - IN MAIN; CHANGE REQ'D FOR FH GEN (OK FOR 7905). * --MODIFICATION: NO TEST FOR DEFECTIVE TRACKS. * * TRTST - OMITTED. * * DISKI - IN MAIN; CHANGE REQ'D FOR FH GEN (OK FOR 7905). * * DISKO - IN MAIN; CHANGE REQ'D FOR FH GEN (OK FOR 7905). * * DTSET - OMITTED. * * FSECT - IN RTGN1; CALLED BY RTGN3 VIA MAIN. * --MODIFICATIONS: OUBUF IS AN ENT IN MAIN. * * DISKD - IN MAIN; CHANGE REQ'D FOR FH GEN (OK FOR 7905). * --MODIFICATIONS: TRANSLATES DISC ADDR TO RECORD * NUMBER, USES FMP WRITF/READF CALLS FOR ACCESS * TO CORE-IMAGE RTE SYSTEM OUTPUT FILE. * * ATB30 - TRACK MAP TABLE - LOCATED IN BSS BLOCK WHICH * PRECEEDS ALL SEGMENTS. NEEDS DIFFERENT SIZE * FOR 7905. HED MH RTGEN - CONSTANTS AND ADDRESSES BEGIN JMP SWRET SEGMENT'S ENTRY POINT ASBUF DEF ASPBF+1 ADDRESS OF 9-WORD BUFFER IN BOOT ABOOT DEF START ADDRESS OF BOOTSTRAP LOADR DSKSC BSS 1 SUBCHANNEL COUNTER. * #DATA ABS I/OTB-I/OTC NO. OF DATA I/O INSTRUCTIONS #CMND ABS I/OTC-I/OTD NO. OF COMMAND I/O INSTRUCTIONS INTMP BSS 1 TEMP FOR INITILIZATION ROUTINES MS3 DEF *+1 SUBCHANNEL NUMBER MESAGE ASC 2, MES1 DEF *+1 ASC 15,# TRKS, FIRST TRK ON SUBCHNL: * MES4 DEF MES04 MES04 ASC 8,BOOT FILE NAME? MES05 ASC 8,SYSTEM SUBCHNL? MES07 ASC 9,AUX DISC SUBCHNL? MES40 DEF *+1 ASC 13,# 128 WORD SECTORS/TRACK? "/E" ASC 1,/E "?0" ASC 1,?0 MES5 DEF MES05 MES7 DEF MES07 TTEMP NOP STEMP NOP * ATB30 DEF TB30 HED INTERACTIVE DISC SET UP SECTION * * THE FOLLOWING MESSAGES ARE PRINTED DURING THE INITIALIZATION * PHASE, WITH THE SPECIFICATIONS FOR EACH VALID RESONSE. * * * MESSAGE RESPONSE * * MH DISC CHANL? ENTER 2 OCTAL DIGITS * * # TRKS, FIRST TRK ON SUBCHNL: * 0? * . ENTER TWO 3 DIGIT DECIMAL NOS. * . SEPERATED BY A COMMA * . OR * . /E * 7? * * # 128 WORD SECTORS/TRACK? ENTER 3 DECIMAL DIGITS * * SYSTEM SUBCHNL? ENTER 1 OCTAL DIGIT * * AUX DISC (YES OR NO)? ENTER YES OR NO * * AUX DISC SUBCHNL? ENTER 1 OCTAL DIGIT SPC 3 DSETU NOP ENTRY POINT FOR QUESTION SECESSION. LDB $TB31 PUT TB31 IN THE LST :\ JSB LSTE NOP IGNOR ALREADY THERE RETURN CHNLD LDA P13 LDB MESS2 MESS2 = ADDR: DISK CHNL? JSB READ PRINT MESSAGE, GET REPLY LDA P2 SET FOR 2 OCTAL DIGITS INPUT JSB DOCON GET DIGITS, RETURN OCTAL JMP CHNLD REPEAT INPUT * STA DCHNL SET DISK CHNL # FOR BOOTSTRAP. ADA N8 MUST BE >=10 SSA,RSS JMP STB30-1 OK JSB INERR JMP CHNLD ASK AGAIN * JSB SPACE SET UP TRACK MAP STB30 LDA P29 SEND MESSAGE: LDB MES1 # TRKS, FIRST TRK ON SUBCHNL: JSB DRKEY PRINT MESSAGE LDA ATB30 SET ADDRESSES STA STEMP FOR INPUT *TEMP* STA INTMP AND CLEAR LOOPS ADA P8 SET # TRACKS ADDRESS STA TTEMP * TEMP * LDB N16 CLEAR CLA THE TB30. STA INTMP,I TRACK ISZ INTMP MAP INB,SZB STEP COUNT - DONE? JMP TB30. NO - CLEAR NEXT WORD * STA DSKSC SET 0 DEFINED SUBCHANNELS TB30A STB INTMP SAVE CURRENT UNIT ADB "?0" ADD CONSTANT TO GET ?X BLF,BLF AND ROTATE TO GET X? STB MS3+2 SET IN MESSAGE LDB MS3 GET MESSAGE ADDRESS LDA P4 AND LENGTH JSB READ GO GET THE ANSWER LDA N2 GET FIRST JSB GETNA TWO CHARACTERS CPA "/E" /E? JMP TB30X YES - GO CHECK FURTHER * JSB GINIT NO - REINITIALIZE LBUF SCAN LDA N3 CONVERT 3 DIGITS JSB GETOC DECIMAL JMP TB30E ERROR - * STA TTEMP,I SET # TRACKS SZA,RSS IF ZERO JMP TB30B GO UPDATE POINTERS * JSB GETAL NOT ZERO - GET NEXT CHARACTER CPA BLANK COMMA IN? RSS YES - SKIP JMP TB30E NO - ERROR * LDA N3 SET FOR JSB DOCON 3 DECIMAL DIGITS AND CONVERT JMP TB30E+1 ERROR * STA STEMP,I SET FIRST TRACK OF CHANNEL LDA TTEMP,I GET CHANNEL SIZE STA DSIZE SET SYSTEM LDA INTMP TO THIS SUBCHANNEL STA SYSCH FOR DEFAULT ISZ DSKSC STEP TOTAL SUBCHANNEL COUNT TB30B ISZ STEMP STEP TABLE ISZ TTEMP ADDRESSES ISZ INTMP STEP SUBCHANNEL TB30F LDB INTMP IF CURRENT SUBCHANNEL CPB P8 IS 8 THEN JMP TB30Y DONE SO GO EXIT * JMP TB30A NOT 8 - GO ASK FOR NEXT ONE * SPC 1 TB30E JSB INERR TELL HIM THERE WAS AN ERROR CLA CLEAR STA TTEMP,I CURRENT # TRACKS JMP TB30F GO ASK AGAIN * SPC 1 TB30X JSB GETAL /E ENTERED SZA ANY THING ELSE? JMP TB30E YES - ERROR * TB30Y LDA DSKSC NO - GET NUMBER OF CHANNELS CMA,INA,SZA DEFINED - IS IT ZERO? JMP TB30Z NO - SKIP * JSB INERR YES - TELL HIM JMP STB30 AND RESTART * TB30Z JSB DSSIZ GET THE SYSTEM DISC # SECT./TRK. STA SDS# AND SET IT. * SPC 1 JSB SPACE ISYSC LDA P15 SEND MESSAGE: LDB MES5 SYSTEM SUBCHNL? JSB READ GET ANSWER LDA N5 JSB DOCON GO CONVERT JMP ISYSC ERROR - TRY AGAIN * JSB TSTCH TEST FOR LEGAL SUBCHANNEL STB DSIZE SET SYSTEM SIZE STA SYSCH SET SYSTEM SUBCHANNEL RSS * SETEM CLA LDB ATB30 EXTRACT INFO ADB A CONCERNING SYSTEM LDB B,I SUBCHANNEL STB T#AC0 AND STORE VALUES FOR BOOT LDB A CLE,ERB STB UN#IT * XOR P1 SET PLATTER NUMBER. ALF,ALF RAL STA H#AD * LDA S#EKC ADA B STA S#EKC SET HEAD # IN SEEK COMMAND LDA R#DCM ADA B STA R#DCM AND IN THE READ COMMAND SPC 1 AUXIN CLA PRESET TO SHOW NO AUX DISC STA DAUXN SET CHANNEL TO ZERO STA ADS#  CCA AND SUBCHANNEL STA AUXCH TO -1. JSB SPACE AUXDS LDA P31 SEND MESSAGE LDB MES6 AUX DISC (YES OR NO OR # TRKS)? JSB READ GO GET ANSWER LDA N3 FIRST TRY FOR A DECIMAL JSB GETOC NUMBER JMP AUX0 NO TRY FOR YES OR NO * STA TBUF SAVE THE NUMBER JSB GETAL END OF INPUT? SZA JMP AUX0 NO LET YE/NO SEND ERROR * LDA TBUF RESTORE THE SIZE TO A AND STA DAUXN SET THE AUX DISC SIZE JSB DSSIZ GET ITS # SECTORS / TRACK JMP AUX3 GO SET IT * AUX0 JSB GINIT RESET THE SCANNER JSB YE/NO TRY FOR YES OR NO JMP AUXDS NO MUST BE BAD ANSWER * JMP STSCR NO - SKIP * CLA,INA YES - IF ONLY ONE CPA DSKSC DISC SUBCHANNEL THEN JMP AUX4 THEN WRONG ANSWER TRY AGAIN * JSB SPACE YES - SET UP AUX UNIT AUXUN LDA P17 SEND QUESTION: LDB MES7 AUX DISC SUBCHNL? JSB READ GO SEND AND GET ANSWER LDA N5 JSB DOCON JMP AUXUN ERROR - TRY AGAIN * JSB TSTCH TEST FOR LEGAL UNIT STB DAUXN SET SIZE OF AUX UNIT CPA SYSCH SAME AS SYSTEM? RSS YES - ERROR SKIP JMP AUX2 NO - GO SET UP * AUX4 JSB INERR SEND ERROR MESSAGE JMP AUXIN AND TRY AGAIN * SPC 1 AUX2 STA AUXCH SET AUX CHANNEL LDA SDS# SET AUX TRK SIZE TO SAME AS SYS DISC AUX3 STA ADS# SET AUX DISC # SECT. TRACK SPC 1 STSCR JMP DSETU,I RETURN TO MAIN LINE CODE SPC 1 * * GET # SECTORS FOR DISC * DSSIZ NOP JSB SPACE NEW LINE #SEC1 LDA P25 LDB MES40 MES40 = ADDR: # 128 WORD SECTORS/TRACK?$$ JSB READ PRINT MESSAGE, GET REPLY LDA N3 SET FOR 3 DECIMAL DIGITS INPUT JSB DOCON GET DIGITS, RETURN OCTAL JMP #SEC1 <:6 REPEAT INPUT * ALS DOUBLE FOR 64 WORD SECTORS JMP DSSIZ,I RETURN SKP SPC 3 * SUBROUTINE TO TEST LEGALITY OF * A SUBCHANNEL. THE TEST CONSISTS * OF LOOKING FOR THE DESIRED * CHANNEL IN THE TRACK MAP. * CALLING SEQUENCE * * P-1 ERROR RETURN * P JSB TSTCH * P+2 NORMAL RETURN CHANNEL IN A SIZE IN B SPC 1 * A ON ENTRY IS ASSUMED TO BE THE SUBCHANNEL TO BE CHECKED. * ERROR EXIT IS P-1 * IF THE SUBCHANNEL IS LEGAL IT IS RETURNED IN A * AND B IS THE NUMBER OF TRACKS ON THAT CHANNEL SPC 1 TSTCH NOP LDB A MAKE SURE THAT SUBCHANNEL ADB N8 SPECIFIED IS <=7 SSB,RSS JMP TSTER IT ISN'T * LDB ATB30 GET TABLE ADDRESS ADB A ADD SUBCHANNEL ADB P8 STEP TO # TRACKS LDB B,I GET # TRACKS IN B SZB IF ZERO - ERROR - SKIP JMP TSTCH,I ELSE OK - RETURN B= # TRACKS * TSTER JSB INERR SEND ERROR MESSAGE LDA TSTCH GET RETURN ADDRESS ADA N2 ADJUST FOR P-1 JMP A,I AND RETURN O<* N5 DEC -5 N8 DEC -8 SKP * * INSERT CHNL NO. IN INSTRUCTION * * THE STDSK SUBROUTINE SETS THE CURRENT DISK CHANNEL * NOS. IN THE I/O INSTRUCTIONS. * * CALLING SEQUENCE: * A = NO. WORDS TO BE CONFIGURED (NEG.) * B = ADDRESS OF INSTRUCTION ADDR LIST * JSB STDSK * * RETURN: * A = DESTROYED * B = NEXT INSTRUCTION ADDRESS * STDSK NOP STA TBUF SAVE NO. OF INSTRUCTIONS STDS1 LDA B,I GET INSTRUCTION AND M7700 ISOLATE INSTRUCTION CODE IOR DCHNL INSERT CHANNEL NO. STA B,I SET INSTRUCTION IN CODE INB INCR INSTRUCTION ADDRESS ISZ TBUF SKIP - ALL INSTRUCTIONS CONFIG. JMP STDS1 CONFIGURE NEXT INSTRUCTION JMP STDSK,I RETURN * SPC 2 A#DTK DEF #WDTK HED MH RTGEN CONFIGURE AND COMPLETE INITILIZATION PTBOT NOP CONFIGURE/PUNCH BOOT ENTRY POINT LDA #DATA GET THE NUMBER OF DATA CHANNEL INSTRUCTIONS LDB HPDSK GET THE ADDRESS OF THE DISK ADDRESSES JSB STDSK GO SET DATA CHANNEL ADDRESSES ISZ DCHNL STEP TO COMMAND CHANNEL LDA #CMND GET NUMBER OF COMMAND CHANNEL INSTRUCTIONS JSB STDSK SET COMMAND CHANNEL ADDRESSES SPC 1 LDB A#DTK GET THE TABLE ADDRESS IN BOOT LDA SDS# SET ALF,RAL THE RAL NUMBER OF WORDS STA B,I PER TRACK INB STEP BOOT ADDRESS LDA T#AC0 SET THE TRACK ADDRESS FOR TRACK 0 STA B,I IN THE BOOT INB SET THE LDA S#EKC SEEK COMMAND STA B,I LDA SDS# SET THE RAR,RAR # OF SECTORS/SURFACE INB STA B,I INB CMA,INA SET NEGATIVE OF ABOVE STA B,I INB LDA H#AD SET THE HEAD STA B,I BITS INB LDA R#DCM SET THE READ COMMAND STA B,I INB LDPA UN#IT AND THE UNIT STA B,I INB LDA B,I GET THE TABLE ADDRESS AND M1777 AND MASK STA TBUF+1 TO PAGE OFFSET LDA LWASM GET LWAM AND M0760 MASK TO PAGE STA TBUF SAVE IOR TBUF+1 ADD THE PAGE OFFSET STA B,I SET THE TABLE ADDRESS LDA BADD GET THE BOOT ADDRESS AND M1177 MASK TO PAGE BITS AND IOR TBUF ADD PAGE BITS AND STA BADD SET FOR THE PAPER BOOT RAL,CLE,ERA CLEAR THE SIGN BIT STA RECNT SET IN THE DR BOOT STA SPCAD A COUPLE OF TIMES * LDB ABOOT OUTPUT THE BOOTSTRAP CLA,CLE TO PSEUDO TRACK 0 SECTOR 0 JSB DISKD IN CORE IMAGE OUTPUT FILE. SKP BOOT0 JSB SPACE NEW LINE LDA P15 SEND MESSAGE LDB MES4 BOOT FILE NAME? JSB RNAME GET THE NAME. * JSB GINIT IF 0 ANSWER, THEN CLA,INA NO BOOT WANTED JSB GETNA CPA ZERO JMP PTBOT,I * JSB CRETF CREATE BOOT FILE. DEF *+5 DEF BTDCB DEF P1 DEF P7 DEF M2300 * JSB CHFIL CHECK FILE STATUS. JMP BOOT0 ERROR- TRY AGAIN. * LDA NBLC GET BOOT LENGTH STA TBUF SET FOR CHECK SUM CACULATION LDA STRAP GET LOAD ADDRESS CLB,RSS INITIALIZE CHECKSUM BOOT1 ADB A,I COMPUTE CHECKSUM INA STEP ADDRESS ISZ TBUF DONE? JMP BOOT1 NO - GET NEXT WORD * STB A,I YES - SET CHECKSUM * JSB WRITF OUTPUT THE BOOTSTRAP FILE. DEF *+5 DEF BTDCB DEF FMRR DEF STRAP+1 DEF BOOTL * LDA BTDCB+2 IF ITS A TYPE 0 FILE SZA THEN WRITE AN EOF JMP BOOTC NO JSB WRITF DEF *+5 DEF BTDCB DEF FMRR DEF STRAP+1 DEF N1 * BOOTC JSB CLOSF CLOSE BOOT FILE. DEF *+2 DEF BTDCB * JMP PTBOT,I RETURN TO MAIN. SPC 2 MESS2 DEF *+1 ASC 7,MH DISC CHNL? MES6 DEF *+1 ASC 16,AUX DISC (YES OR NO OR # TRKS)? HPDSK DEF I/OTB,I ADDRESS OF I/O INSTRUCTION LIST DCHNL BSS 1 DISK I/O CHANNEL NO. (OCTAL) P7 DEC 7 N1 DEC -1 BTDCB BSS 144 BOOT FILE DCB M2300 OCT 2300 ZERO OCT 60 HED MH RTGEN DISC DRIVE I/O INSTRUCTION ADDRESSES I/OTB DEF DSKDA DATA CHANNEL DEF DSKDB DEF DSKDC DEF DSKDD DEF DSKDE DEF DSKDF DEF DSKDG DEF DSKDH DEF DSKDI DEF DSKDJ DEF DSKDK DEF DSKDL DEF DSKDM DEF DSKDN DEF DSKDO DEF DSKDP DEF DSKDQ DEF DSKDR DEF DSKDS DEF DSKDZ I/OTC DEF DSKCA COMMAND CHANNEL DEF DSKCB DEF DSKCC DEF DSKCD DEF DSKCE DEF DSKCF DEF DSKCG DEF DSKCG DEF DSKCH DEF DSKCI DEF DSKCJ DEF DSKCK DEF DSKCL DEF DSKCM DEF DSKCP DEF DSKCQ DEF DSKCR DEF DSKCS DEF DSKCT DEF DSKCU DEF DSKCV I/OTD EQU * HED MH RTGEN ** SECT. 0 TRK 0 BOOTSTRAP ** * * THE FOLLOWING LOADER PERMITS LOADING OF THE RESIDENT PORTIONS * OF THE REAL TIME MONITOR. THE LOADER IS LOCATED ON SECTOR 0/1, * TRACK 0 OF THE SYSTEM DISC. IT IS GENERATED BY THE SYSTEM * GENERATOR AND CONSISTS OF: * * (1) THE INSTRUCTIONS REQUIRED FOR LOADING THE SYSTEM * (2) THE DISK AND CORE ADDRESSES SPECIFYING LOADING * * * THE ADDRESSES REQUIRED FOR LOADING ARE THE FOLLOWING: * * (A) BASE PAGE LINKAGES * (1) LOW CORE ADDRESS * (2) HIGH CORE ADDRESS * (3) DISK ADDRESS OF ABSOLUTE CODE * * (B) SYSTEM, RT RESIDENT MAIN * (1) LOW CORE ADDRESS * (2) HIGH CORE ADDRESS * (3) DISK ADDRESS OF ABSOLUTE CODE * * (C) BG RESIDENT MAIN * (1) LOW CORE ADDRESS * (2) HIGH CORE ADDRESS * q (3) DISK ADDRESS OF ABSOLUTE CODE * * THE PROGRAM IS ASSUMED TO BE LOADED IN THE AREA JUST PRECEDING * THE PROTECTED LOADER. * START ABS LDB-O+ASPBF GET ADDRESS OF DISK SPEC. BUFFER ABS STB-O+SPCAD SET CURRENT SPBUF ADDRESS ABS JSB-O+PLOAD LOAD MAIN SYSTEM, RT RESIDENTS ABS JSB-O+PLOAD LOAD MAIN BG RESIDENTS ABS JSB-O+PLOAD LOAD BP LINKAGES JMP 3B,I TRANSFER TO RT MONITOR ENTRY PT. * PLOAD ABS 2000B-OO+START ADDRESS OR BOOT WHEN BBDL'ED ABS LDB-O+SPCAD+I+I GET LOW CORE ADRESS ABS ISZ-O+SPCAD INCR CURRENT SPBUF ADDRESS ABS LDA-O+SPCAD+I+I GET HIGH CORE ADRESS ABS ISZ-O+SPCAD INCR CURRENT SPBUF ADDRESS CMA,CCE,INA COMPLEMENT, SET DIRECTION BIT ADA B SET A = TOTAL WORD COUNT RBL,ERB SET DIRECTION BIT IN CORE ADDR CLC 2 OTB 2 SET MEMORY ADDRESS REGISTER ABS STA-O+RECNT INITIALIZE REMAINING COUNT ABS LDA-O+SPCAD+I+I GET THE DISK ADRESS ABS AND-O+M.177 ISOLATE THE SECTOR ADDRESS STA B SET IN B ABS XOR-O+SPCAD+I+I ISOLATE THE TRACK ADRESS ABS ISZ-O+SPCAD STEP THE PRAM TABLE LOCATION ALF,ALF ROTATE TO RAL LOW A ABS ADA-O+TBASE ADD TRACK ZERO TO GET ABSOLUTE TRACK ABS STA-O+T#ACK SAVE FOR ADDRESSING BRS ADDJUST SECTOR COUNT FOR 128 WORD SECTORS LDA B GET SECTOR TO A ALF,ALF MULTIPLY BY RAR 128 CMA,INA AND SUBTRACT FROM SLOAD ABS ADA-O+#WDTK NUMBER OF WORDS PER TRACK ABS STA-O+P#WDS SET POSITIVE # WORDS CMA,INA AND ABS STA-O+N#WDS NEGATIVE # WORDS THIS TRACK RSS SKIP OVER BBDL ADDRESS DEF ABS 2000B+BENT-OO DEFINE ADDRESS OF BENT ABS LDA-O+RECNT GET NUMBER LEFT SSA,RSS IF POSITIVE ABS JMP-O+PLOAD+I+I DONE - SO EXIT * ABS ADA-O+P#WDS ELSE SET TO READ ABS STA-O+RECNT SAV]E REMANING COUNT SSA NEXT TRACK CLA USE MIN. OF NUMBER ON TRACK OR ABS ADA-O+N#WDS NUMBER LEFT STC 2 SET DMA FOR WORD COUNT OTA 2 AND SEND IT ABS LDA-O+T#ACK GET THE TRACK ADDRESS DSKDA OTA 0 AND SEND DSKDB STC 0,C IT ABS LDA-O+SKCMD GET THE SEEK DSKCA CLC 1 COMMAND AND DSKCB OTA 1 SEND IT DSKCC STC 1,C START SEEK ABS ADB-O+N#SCT SUBTRACK NUMBER PER SIDE SSB,RSS IF SIDE TWO ABS ADB-O+.400 ADD HEAD BIT SSB ELSE ABS ADB-O+P#SCT ADD BACK TO GET SECTOR ABS ADB-O+B#MSK ADD THE SUBCHANNEL HEAD BIT DSKDC SFS 0 WAIT FOR TRACK ABS JMP-O+DSKDC * DSKDD OTB 0 SEND HEAD/SECTOR WORD DSKDE STC 0,C TELL THE CONTROLLER ABS LDA-O+R#CMD GET THE READ COMMAND DSKCD SFS 0 WAIT FOR SEEK ABS JMP-O+DSKCD * DSKCE OTA 1 SEND READ COMMAND DSKDF STC 0,C SET UP FOR READ DSKCF CLC 1 STC 6,C START DMA DSKCG STC 1,C START READ DSKCH SFS 1 WAIT FOR END ABS JMP-O+DSKCH * STF 6 DISABLE DMA FOR STATUS DSKDG STC 0,C DO ABS LDA-O+U#NIT STATUS DSKCI CLC 1 DSKCJ OTA 1 ON UNIT DSKCK STC 1,C DSKDH SFS 0 WAIT FOR STATUS ABS JMP-O+DSKDH * DSKDI LIA 0 GET STATUS SLA IF BAD HLT 31B STATUS HALT SLA ON RESTART ABS JMP-O+START START OVER * CLB SET SECTOR TO ZERO FOR REST OF SEGMENT ABS ISZ-O+T#ACK STEP THE TRACK ADDRESS CLA AND ABS JMP-O+SLOAD GO LOAD * * DATA AREA T#ACK DEC -128 MOVE COUNT FOR BBDL MOVE .400 OCT 400 M.177 OCT 177 P#WDS NOP N#WDS NOP RECNT OCT 1500 CONFIGURED TO BBL ADDRESS SPCAD OCT 1500 CONFIGURED TO BBL ADDRESS #WDTK DEC 3072 THESE 8 TBASE NOP - SYSTEM TRACK SKCMD OCT 30000 P#SCT DEC -12 WORDS ARE N#SCT DEC 12 B#MSK NOP SET BY THE R#CMD OCT 20000 U#NIT NOP GENERATOR ASPBF ABS ASPBF+1-O BSS 9 SYSTEM LOADING SPECIFICATIONS BENT NOP JSB HERE FROM BBDL STF 6 CLEAN UP DMA CLC 0,C AND THE I/O SYSTEM HLT 77B DISABLE THE LOADR ENABLE SWITCH AND RUN * DRBOT ABS LDA-OO+PLOAD+I+I MOVE 128 WORDS TO BBL-128 ABS STA-OO+RECNT+I+I ABS ISZ-OO+PLOAD ABS ISZ-OO+RECNT ABS ISZ-OO+T#ACK DONE? ABS JMP-OO+DRBOT NO GET NEXT WORD * ABS JMP-OO+SPCAD+I+I YES GO EXECUTE THE BOOT * * * * THE FOLLOWING EQU SECTION ALLOWS THE BOOTSTRAP * TO BE LOCATED ANYWHERE IN CORE WHEN OUTPUT TO * DISK, BUT EXECUTABLE FROM THE LAST PAGE OF CORE. * * * O EQU START-1500B SET FOR START AT 1500 PAGE RELATIVE * LDB EQU 066000B LDB STB EQU 076000B STB ADB EQU 046000B ADB JSB EQU 016000B JSB ISZ EQU 036000B ISZ LDA EQU 062000B LDA STA EQU 072000B STA ADA EQU 042000B ADA AND EQU 012000B AND XOR EQU 022000B XOR JMP EQU 026000B JMP I EQU 040000B INDIRECT BIT (CODE AS I+I) * * THE FOLLOWING EQU ARE USE TO SET UP THE BBDL MOVE CODE * WHEN BOOTED BY THE BBDL THE LOADR IS LOADED TO 2011 * AND JSB'ED TO AT 2055,I (44 RELATIVE) * OO EQU START-11B RELATIVE PAGE LOCATION OF START HED MOVE HEAD PAPER TAPE BOOT STRAP * MOVING HEAD BOOTSTRAP * THIS BOOTSTRAP IS CONFIGURED AND PUNCHED BY THE GENERATOR AND IS * USED TO LOAD THE DISC RESIDENT BOOTSTRAP FROM SYSTEM TRACK * 0 SECTOR 0. * SPC 3 STRAP DEF *+1 ADDRESS OF THE BOOT STRAP ABS BL256 LENGTH OF LOADR IN HIGH HALF OF WORD ABS BORG LOAD ADDRESS S#ART CLC 0,C STOP EVERTHING - RTE IS COMMING! LDA T#AC0-ADCON SEEK DSKDJ OTA 0 TO DSKDK STC 0,C FIdRST SYSTEM LDA S#EKC-ADCON TRACK DSKCL OTA 1 DSKCM STC 1,C AND DSKDS SFS 0 JMP *-1-ADCON HEAD * LDA H#AD-ADCON DSKDL OTA 0 START DSKDM STC 0,C SEEK LDA DSKDR-ADCON SET OTA 6 UP CLC 2 DMA LDB BADD-ADCON BUFFER ADDRESS OTB 2 LDA DM128-ADCON 128 WORDS STC 2 OTA 2 DSKDZ SFS 1 WAIT FOR JMP *-1-ADCON SEEK * LDA R#DCM-ADCON SET DSKCP CLC 1 UP DSKCQ OTA 1 THE DSKDN STC 0,C READ STC 6,C DSKCR STC 1,C START READ DSKCS SFS 1 WAIT JMP *-1-ADCON FOR IT * STF 6 CLEAR DMA FOR STATUS DSKDO STC 0,C DO LDA UN#IT-ADCON STATUS DSKCT CLC 1 DSKCU OTA 1 DSKCV STC 1,C DSKDP SFS 0 WAIT FOR JMP *-1-ADCON STATUS * DSKDQ LIA 0 RBL,CLE,ERB REMOVE SIGN BIT FROM ADDRESS SLA,RSS ANY ERRORS? JMP B,I NO. GO TO THE EXTENSION * CPA JSTLD-ADCON IS THIS THE FIRST TIME? RSS YES, TRY AGAIN. HLT 11B NO HALT JMP S#ART-ADCON RETRY ON RESTART * JSTLD OCT 040001 DM128 DEC -128 BADD ABS START-O+I+I THESE UN#IT NOP SEVEN H#AD NOP WORDS S#EKC OCT 30000 ARE R#DCM OCT 20000 SET BY DSKDR OCT 120000 THE T#AC0 NOP GENERATOR SPC 1 HNDR JMP S#ART-ADCON MUST BE AT 100B WHEN LOADED * NOP LOCATION FOR CHECK SUM SPC 2 BORG EQU 100B+S#ART-HNDR RUN TIME ORG OF PAPER BOOT ADCON EQU HNDR-100B ADDRESS ADJUSTING CONSTANT. BL EQU HNDR-S#ART+1 BOOT LENGTH BL4 EQU BL+BL+BL+BL BOOT LENGTH TIMES 4 BL16 EQU BL4+BL4+BL4+BL4 TIMES 16 BL64 EQU BL16+BL16+BL16+BL16 TIMES 64 BL256 EQU BL64+BL64+BL64+BL64 TIMES 256 BOOTL ABS BL+3 LENGTH FOR PUNCHING NBLC ABS -BL-2 BOOT LENGTH FOR CHECK SUM CACULATION HED RTGN1 - MH RTGEN SUBROUTINE SEGMjENT. * * GENERATE $TB31 TRACK MAP TABLE. * DSTB EQU * *** ENTRY POINT FOR DSTBL *** DSTBL NOP * GENERATE TB31 SPC 2 LDA ATB30 GET THE TABLE ADDRESS STA TBUF SET FOR INDEXING LDA N16 GET NUMBER OF WORDS STA TBUF+1 SET COUNT LDB $TB31 GET THE LST ENTRY JSB LSTS FOR $TB31 JSB ABORT BAD NEWS NO $TB31 ????? LDB PPREL GET THE CORE ADDRESS FOR TABLE STB .LST5,I SET IN THE SYMBOL TABLE * DSTB1 LDA TBUF,I GET WORD FROM TABLE JSB LABDO SEND TO DISC ISZ TBUF STEP TABLE ADDRESS ISZ TBUF+1 STEP COUNT - DONE? JMP DSTB1 NO - GET NEXT ENTRY * STB PPREL RESET NEW CORE ADDRESS * * SAVE THE SYSTEM SUBCHANNEL INFORMATION IN THE HEADER * RECORD, REUSING THE TMT BUFFER * LDA SYSCH GET THE SYSTEM SUBCHANNEL'S ADA ATB30 FIRST TRACK # LDB A,I STB TB30 AND STORE IT IN THE FIRST WORD ADA P8 LDB A,I GET THE # TRACKS STB TB30+1 AND SAVE IT JMP DSTBL,I RETURN SPC 3 $TB31 DEF *+1 ASC 3,$TB31 * SKP * * FSECT IS A ROUTINE TO SET LOAD SPECS IN THE LOAD SPEC. * TABLE IN THE DISC RESIDENT BOOT EXTENSION AND TO * FLUSH THE FINAL SECTOR FROM CORE AT THE END OF * GENERATION. * * CALLING SEQUENCE: * * LDA SPEC BUFFER ADDRESS I.E. ADDRESS OF THE NINE WORDS * JSB FSECT * RETURN REGS. MEANINGLESS * FSEC EQU * *** ENTRY POINT FOR FSECT *** FSECT NOP STA DSTBL SAVE THE ADDRESS FOR A BIT LDB ABOOT GET THE CLA,CCE BOOT FROM JSB DISKD THE DISC LDA DSTBL GET THE FROM ADDRESS LDB ASBUF AND THE TO ADDRESS JSB MOVW AND MOVE THE WORDS DEC -9 LDB ABOOT NOW WRITE CLA,CLE THE BOOT JSB DISKD BACK TO THE DISC  CLE DLD OUBUF FLUSH THE FINAL BUFFER. ELA,CLE FROM CORE JSB DISKD * * MOVE THE SYSTEM SUBCHANNEL DEFINITION TO FOLLOW THE * EQT DEFINITIONS IN THE HEADER RECORD. RESET WORDS * 1-6 IN IT, AND WRITE THE RECORD OUT. * LDB CEQT POSITION POINTER AFTER EQT'S ADB P6 ADB ATB30 LDA TB30 GET THE FIRST TRACK FROM WHERE STA B,I IT HAD BEEN TEMPORARILY STORED INB AND SAVE LDA TB30+1 GET THE # TRACKS STA B,I AND SAVE * LDA SYSCH SET WORDS 1-6 STA TB30 SYSTEM SUBCHANNEL LDA DRT2 AND M77 STA TB30+1 SYSTEM EQT # LDA CEQT STA TB30+2 # OF EQT'S LDA PIOC STA TB30+3 PRIV INT CHANNEL LDA TBCHN STA TB30+4 TBG CHANNEL LDA TB30+127 RETRIEVE FROM TEMP. STORAGE AND M77 STA TB30+5 TTY CHANNEL LDB ATB30 CMB,INB CLA,CLE JSB DISKD WRITE IT OUT * JMP FSECT,I RETURN SKP * * THE MOVW SUBROUTINE MOVES WORDS FROM ONE CORE LOCATION * TO ANOTHER * * CALLING SEQUENCE: * * LDA FROM ADDRESS * LDB TO ADDRESS * JSB MOVW * DEC -WORD COUNT * MOVW NOP STA TBUF LDA MOVW,I GET THE COUNT STA TBUF+1 SET IN COUNTER * MOVW2 LDA TBUF,I GET A WORD STA B,I SET IT INB ISZ TBUF STEP THE ADDRESSES ISZ TBUF+1 DONE? JMP MOVW2 NO DO THE NEXT ONE * ISZ MOVW STEP TO RETURN POINT JMP MOVW,I YES- RETURN HED RTGN1 CONSTANTS AND WORKING STORAGE. N2 DEC -2 N3 DEC -3 N16 DEC -16 P1 DEC 1 P2 DEC 2 P4 DEC 4 P6 DEC 6 P8 DEC 8 P13 DEC 13 P15 DEC 15 P17 DEC 17 P25 DEC 25 P29 DEC 29 P31 DEC 31 M77 OCT 77 M0760 OCT 76000 M1777 OCT 1777 M7700 OCT 177700 M1177 OCT 101777 BLANK OCT 40 * END EQǜ<:6U * * END BEGIN 0<ASMB,Z,R,L,C HED RTGN2 - PROGRAM INPUT PHASE SEGMENT. IFN ASSEMBLY OPTION "N" FOR RTE-II NAM RT2G2,5,90 92001-16031 771221 XIF IFZ ASSEMBLY OPTION "Z" FOR RTE-III NAM RT3G2,5,90 92060-16037 771221 XIF SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 2 SPC 1 ****************************************************** * * NAME: RT2G2/RT3G2 * SOURCE PART #: 92001-18031/92060-18037 * REL PART #: 92001-16031/92060-16037 * WRITTEN BY: HAHN - HARTSELL - COOLEY - ANZINGER - WONG * ****************************************************** SPC 1 ENT INPUT * * EXTERNAL REFERENCE NAMES * EXT .LST1,.LST4,.LST5 EXT CURAL,LBUF,TBUF EXT BPARS,DPRS2 EXT PROMT,LSTS,INLST,LSTX,LSTE EXT TLST,PLST,TIDNT,PIDNT EXT INIDX,IDXS,IDX EXT ID1,ID2,ID3,ID4,ID5,ID6,ID7,ID8,ID9,ID10,ID11 EXT ID12,ID13,ID14,ID15,ID16 EXT SWRET,RDBIN EXT RRDCB,CLOSF,ABORT EXT GN.ER,DRKEY,SPACE,GTERM EXT OCTNO,BUFUL,TCHAR EXT READ,GETNA,GETAL,GETOC EXT READF,NMDCB,FMRR,CHFIL,RDNAM,WRITF,CLOSE EXT LOCF,RWNDF,APOSN EXT NAMRC,NAMBL,NAMOF EXT IACOM,ATRCM,TRCHK * A EQU 0 B EQU 1 SUP ************************************************************************ * SKP * THE FOLLOWING BLOCK OF STORAGE FOR VARIABLES PRECEEDS, * AND IS REFERENCED BY, EACH SEGMENT. IT IS NOT OVERLAID * AS EACH NEW SEGMENT IS LOADED INTO CORE. * * THE LOCATION OF EACH VARIABLE MUST BE THE SAME IN * ALL SEGMENTS. IF A CHANGE IS MADE, MAKE THE SAME * CHANGE IN THE REST OF THE SEGMENTS. * * * SYSCH BSS 1 SUBCHANNEL OF SYSTEM UNIT. AUXCH BSS 1 SUBCHANNEL OF AUX UNIT. DSIZE BSS 1 DISK SIZE -NO. OF TRACKS. DAUXN BSS 1 AUXILIARY DISK SIZE. ADS# BSS 1 AUX DISC SECTORS/TRACK. * * RELOCATION BASE TABLE. RBTA BSS 1 ABSOLUTE PROGRAM BASE. TPREL BSS 1 CURRENT PROGRAM BASE ADDRESS. TPBRE BSS 1 BASE PAGE RELOCATION ADDRESS. COMAD BSS 1 CURRENT COMMON RELOCATION BASE. BSS 1 ABS PROGRAM BASE FOR MR CODE. * WDCNT BSS 1 TEMPORARY WORD COUNTER. DSKSY BSS 1 INITIAL ID SEGMENT DISK ADDRESS IDSP BSS 1 POSITION OF 1ST ID SEG. IN SECT TTYCH BSS 1 SYSTEM TTY CHANNEL NO. * PLFLG BSS 1 PROGRAM LOAD. FLAG = -1/0 = L/NL DSCNT BSS 1 DISK SEGMENT SECTOR COUNT * NXFLG BSS 1 ENT/EXT FLAG = -1/0 EXCNT BSS 1 SYMBOL COUNTER * LCNT BSS 1 CURRENT LBUF COUNT DCNT BSS 1 CURRENT DBUF COUNT CURAI BSS 1 CURRENT IBUF COUNT * CPLS BSS 1 ADDRESS OF TOP OF FIXED CP LINK IMAGE CPL1 BSS 1 ADDRESS OF LOW CURRENT PAGE LINK SPECS. CPL1H BSS 1 NUMBER OF CURRENT PAGE LINKS ASSIGNED CPL2H BSS 1 IN LOW AND HIGH AREA RESPECTIVELY URBP1 BSS 1 LWA R/T DISC RES BP LINK AREA BPMAX BSS 1 MAX USED BASE PAGE LINKAGE +1 CURAK BSS 1 CURRENT KBUF ADDRESS * CURAT BSS 1 CURRENT TBUF ADDRESS TCNT BSS 1 CURRENT TBUF COUNT * CURAP BSS 1 CURRENT PLIST ADDRESS * AMAD BSS 1 CURRENT MLIST ADDRESS * LICNT BSS 1 LONG ID SEGMENT COUNT SICNT BSS 1 SHORT ID SEGMENT COUNT SSCNT BSS 1 BG. SEG ID COUNT COMRT BSS 1 MAXIMUM RT COM LENGTH COMBG BSS 1 MAX BG COM LENGTH * DSKEY BSS 1 CURRENT KEYWORD DISK ADDRESS DSKID BSS 1 DISK ID SEGMENT ADDRESS KEYCN BSS 1 TOTAL KEYWORD COUNT KEYCT BSS 1 CURRENT KEYWORD COUNT * MLIST BSS 11 MEMORY MAP BUFFER * TEMP1 BSS 1 TEMP2 BSS 1 LWH1 BSS 1 LWH2 BSS 1 LWH3 BSS 1 LWH4 BSS 1 L01 BSS 1 * FSYBP BSS 1 FIRST WORD SYS BP LINKAGE SYSAD BSS 1 CURRENT ID SEGMENT ADDRESS * TBREL BSS 1 CURRENT BP RELOC ADDR PBREL BSS 1 INITIAL BP RELOC ADDR * RELAD BSS 1 CURRENT CORE RELOCATION ADDRESS * BSBAD BSS 1 BG SEGMENT BP RELOC ADDR BSPAD BSS 1 BG SEGMENT PROG RELOC ADDR * LFLAG BSS 1 PROGRAMS-LOADED FLAG IMAIN BSS 1 CURRENT MAIN IDENT INDEX. HDFLG BSS 1 HEADING FORMAT FLAG CIDNT BSS 1 CURRENT MAIN IDENT INDEX. * AEQT BSS 1 ADDRESS OF EQUIPMENT TABLE CEQT BSS 1 NO. ENTRIES IN EQUIPMENT TABLE * ASQT BSS 1 ADDR OF DEVICE REFERENCE TABLE CSQT BSS 1 NO. ENTRIES IN DEV. REF. TABLE * AINT BSS 1 ADDRESS OF INTERRUPT TABLE CINT BSS 1 NO. ENTRIES IN INTERRUPT TABLE * DSKIN BSS 1 DISK ADDR OF INT CODE RECORD INTCN BSS 1 RECORD COUNT OF INT CODE * CURIL BSS 1 CURRENT ILIST ADDRESS ILIST BSS 64 USER SYSTEM PROG IDENT ADDR LIST * IDSAV BSS 1 INDEX OF CURRENT IDENT. DSKMN BSS 1 INITIAL MAIN DISK ADDRESS BSSDP BSS 1 INITIAL DISK RES MAIN BSS DISP PRENT BSS 1 PRIMARY ENTRY POINT DBLAD BSS 1 CURRENT DBL ADDRESS REKEY BSS 1 INSTRUCTION TYPE BYTE INSCN BSS 1 INSTRUCTION TYPE COUNTER INSTR BSS 1 CURRENT INSTRUCTION PAGNO BSS 1 CURRENT PAGE NO. OPRND BSS 1 CURRENT OPERAND PLGTH BSS 1 PROGRAM LENGTH DRT2 BSS 1 DISK DRT ENTRY ( SYSTEM) DRT3 BSS 1 AUX DISK DRT ENTRY LIBFG BSS 1 LDTYP BSS 1 SCH1 BSS 1 INDEX OF IDENT OF PGM TO BE SCHEDULED SCH3 BSS 1 ADDRESS OF CURRENT ID SEGMENT SCH4 BSS 1 ADDRESS OF THE SCHEDULED PGM ID SEG FGBGC BSS 1 v BACKGROUND USING FG COMMON FLAG $LIBR BSS 1 INDEX OF $LIBR ENT $LIBX BSS 1 INDEX OF $LIBX ENT CUPRI BSS 1 * MEM1 BSS 1 MEM2 BSS 1 MEM3 BSS 1 MEM4 BSS 1 MEM5 BSS 1 MEM6 BSS 1 MEM7 BSS 1 MEM8 BSS 1 MEM9 BSS 1 MEM10 BSS 1 MEM11 BSS 1 MEM12 BSS 1 * IFZ ***** BEGIN DMS CODE ***** COMSZ BSS 1 #WORDS COMMON DECLARED FOR * CURRENT MAIN LPCOM BSS 1 LAST PAGE CONTAINING ANY COMMON FPSAM BSS 1 1ST PAGE CONTAINING S.A.M. FWSAM BSS 1 1ST WORD CONTAINING S.A.M. LPSYS BSS 1 LAST PAGE CONTAINING SYS OR LIB FPDSK BSS 1 1ST PAGE DISK PART AREA LOLNK BSS 1 LOW LINK FOR SSGA,LIB, OR SYS HILNK BSS 1 HI LINK USED BY MEM RES PRG BPINC BSS 1 CURR DIRECTION FOR BP LINK * ALLOCATION. +1=UP,-1=DOWN BPLMT BSS 1 WORD AFTER LAST WORD AVAIL * FOR BP LINK ALLOCATION TPMAX BSS 1 HWM FOR RELOCATION OF BG * MAINS AND SEGS MAXPT BSS 1 NUM PARTS. ALLOWED MAT. BSS 1 ADR OF LENGTH WORD * BEFORE MEM ALLOC TABLE (MAT) SSGA. BSS 1 FWA SSGA (LAST WORD SYS * OR LIB +1) FWMRP BSS 1 FWA MEM RES PROG AREA * (NEXT WORD AFTER COMMONS) MAP. BSS 1 PTR TO MEU RES MAP MPFT. BSS 1 PTR TO MPFT ****** END DMS CODE ****** XIF * SECTR BSS 0 BOOTSTRAP BUFFER FORMAT * LBPSY BSS 1 LOWER SYSTEM BP ADDRESS UBPSY BSS 1 UPPER SYSTEM BP ADDRESS DSKBP BSS 1 SYS BP DISK ADDRESS * LRMAN BSS 1 MAIN RESIDENT LOWER ADDRESS URMAN BSS 1 MAIN RESIDENT UPPER ADDRESS DSKRR BSS 1 MAIN RESIDENT DISK ADDRESS * LBMAN BSS 1 MAIN BG LOWER ADDRESS UBMAN BSS 1 MAIN BG UPPER ADDRESS DSKBG BSS 1 MAIN BACKGROUND DISK ADDRESS * SYMAD BSS 1 AVAIL SYS MEM ADDR BGBND BSS 1 BACKGROUND BOUNDARY * DSKAV BSS 1 NEXT AVAILABLE DISK ADDRESS DSKLC BSS 1 DISK ADDRESS OF LIBRARY CODE DSKLB BSS 1 DISK ADDR OF LIBRARY ENTRY PTS DSKUT BSS 1 UTILITY PROG DISK ADDRESS DSKBS BSS 1 DISK ADDR OF MAIN BG DISK RES BP DSKBR BSS 1 CURRENT MAIN BG DISK RES DISK AD ADICT BSS 1 ADDR OF DISK DICTIONARY LBCNT BSS 1 RESIDENT LIBR ENTRY PT COUNT UTCNT BSS 1 UTILITY LIBRARY COUNT KEYAD BSS 1 CURRENT KEYWORD ADDRESS RTCAD BSS 1 RT COM CORE ADDRESS LBCAD BSS 1 LIBRARY CODE ADDRESS SYBAD BSS 1 ADDR OF FIRST BP LINK FOR BG IDSAD BSS 1 ADDR OF FIRST ID SEGMENT ABSID BSS 1 IDENT ADDR FOR NEXT BG SEG SCAN MAXRP BSS 1 MAXIMUM RT DISK RESIDENT PROG MAXRB BSS 1 MAXIMUM RT DISK RESIDENT BP IDMBS BSS 1 BG MAIN ADDRESS FOR BS REF * TB30 BSS 128 TRACK MAP TABLE #SUBC BSS 1 " # SUBCHANNELS DEFINED(7905) SPC 5 ********************************************************* * * * END OF COMMON STORAGE BLOCK FOR ALL SEGMENTS. * * * ********************************************************* SKP LSWAP NOP * * RESOLVE ANY ARITHMETIC DEF'S TO EXTERNALS * LDA N GET LOOP COUNTER STA BLINE SAVE IN TEMP LOCATION LDB LSTAA GET ADDRESS OF WHERE LIST ROUTINE LOCATED LOOP LDA B,I GET ADDRESS RSS LDA A,I RAL,CLE,SLA,ERA JMP *-2 STA B,I AND SAVE IT AGAIN INB ISZ BLINE DONE? JMP LOOP NO LDA DNAM FIX MOVEX CALLS STA LBUF4 LDA ALBUF STA ML0 JMP SWRET RETURN TO MAIN. SPC 1 N DEC -3 LSTAA DEF *+1 ATBUF DEF TBUF ALBUF DEF LBUF DNAM DEF LBUF +3 SKP * * BEGIN PROGRAM INPUT PHASE (UNDER COMMAND CONTROL). * INPUT NOP JSB SPACE LDA P17 LDB MESS7 JSB DRKEY "PROG INPUT PHASE:" LDA PLST SET BOTTOM OF PROGRAM STA SLST DEFINED LST (INDEX #) * JSB PRCMD PROCESS OPERATOR COMMANDS. * CLA STA SCH1 STA SCH4 * * CLEAR UNDEFINED EXTS * LDA SLST INITIALIZE LSTX STA TLST IGNOR PREDEFINED ENTRIES CLST3 JSB LSTX SET LST ADDRESSES JMP ENDLB SET USAGE FLAGS * LDA .LST4,I GET IDENT INDEX CMA,INA SSA SKIP - UNDEFINED EXT JMP CLST3 IGNORE DEFINED ENTRY POINT * LDA P4 SET UNDEFINEDS TO ZERO REPLACE ENTS STA .LST4,I CLEAR IDENT INDEX JMP CLST3 TRY NEXT LST ENTRY * ENDLB LDB D$LIR FIND THE LIBRARY JSB LSTS ENTRY POINTS $LIBR CLA,INA,RSS USE ZERO IF NOT FOUND LDA TLST ADA N1 STA $LIBR SAVE FOR THE LOADER * LDB D$LIX DO SAME THING FOR $LIBX JSB LSTS CLA,INA,RSS LDA TLST ADA N1 STA $LIBX * JMP PARAM GO DO PARAM INPUT PHASE. * D$LIR DEF *+1 ASC 3,$LIBR D$LIX DEF *+1 ASC 3,$LIBX * P17 DEC 17 MESS7 DEF *+1 ASC 9,PROG INPUT PHASE: N1 DEC -1 SKP SPC 1 ***** * ** BLINE ** BLANK OUT THE PRINT LINE BUFFER (LBUF) * CALLING SEQUENCE: * * JSB BLINE * RETURN * ***** BSS 1 BLINE NOP LDA ALBUF STA BLINE-1 LDA MD24 LDB BLANK STB BLINE-1,I ISZ BLINE-1 INA,SZA JMP *-3 JMP BLINE,I ***** STMP1 NOP * ***** * ** DELIM ** ADVANCE POINTERS TO ASCII INPUT BUFFER PAST NEXT * DELIMETER. ACCEPTABLE DELIMITERS ARE A COMMA, ONE OR * MORE BLANKS, OR A COMMA IMBEDDED IN BLANKS. * CALLING SEQUENCE: * * JSB DELIM * RE4TURN1 NOTHING BUT BLANKS OR A COMMENT TO END OF LINE * RETURN2 DELIMETER FOUND * * NOTE: IF NO VALID DELIMITER IS FOUND (OR COMMA WITH NOTHING BUT * BLANKS TO THE END OF LINE) A DIRECT JUMP TO THE COMMAND * ERROR ROUTINE WILL RESULT. THUS CONTROL MAY NOT BE RETURNED ***** DELIM NOP JSB QGETC GET THE NEXT CHAR JMP DELIM,I END OF LINE , RETURN (P+1) LDB N2 INITIALIZE STB STMP1 COMMA COUNTER CPA B40 IS THIS A BLANK? JMP DEL01 YES CPA B54 NO, IS IT A COMMA? RSS JMP CMER NO, ERROR ISZ STMP1 DEL01 JSB NXTC GET NEXT NON BLANK CHAR JMP DEL02 END OF LINE CPA B54 GOT ONE, IS IT A COMMMA? RSS JMP DEL03 NO ISZ STMP1 YES, IS IT THE SECOND ONE? JMP DEL01 NO, GET NEXT NON BLANK CHARACTER DEL03 JSB BAKUP YES, BACK UP BUFFER POINTERS ISZ DELIM AND EXIT (P+2) JMP DELIM,I DEL02 ISZ STMP1 WAS THERE A COMMA? JMP DELIM,I NO, EXIT (P+1) JMP CMER YES, ERROR ***** * ** BAKUP ** BACK UP INPUT BUFFER (QIBUF) POINTERS BY ONE CHARACTER * CALLING SEQUENCE: * * JSB BAKUP * RETURN * ***** BAKUP NOP CCA ADA QQCNT DECREMENT CHAR COUNT STA QQCNT LDB QQPTR SLA AND IF NECESSARY, ADB N1 DECREMENT POINTER STB QQPTR JMP BAKUP,I ***** * ** PRCMD ** MAIN ENTRY POINT - CONTROL IS PASSED TO NXTCM TO GET THE NEXT * COMMAND. THAT COMMAND IS PARSED, AND CONTROL IS PASSED * TO ITS ASSOCIATED PROCESSING ROUTINE. IF A FATAL ERROR * IS DETECTED, CONTROL IS RETURNED TO THE ROUTINE CALLING * PRCMD AT (P+1). THE ONLY OTHER EXIT IS VIA THE END * COMMAND (P+2). AFTER PROCESSING ANY OTHER COMMAND, * CONTROL RETURNS TO NXTCM TO PROCESS THE NEXT COMMAND. * ***** PRCMD NOP PROCESS OPERATOR COMMANDS. NXTCM JSB CMDIN GET NEXT COMMAND LINE LDA CTACN COMST JMP'S HERE VIA NXTCM+1 LDB CTABL JSB SCAN SCAN 1ST ELEMENT FOR MATCH JMP CMER COMMAND ERROR. ADA PTABL JUMP TO PROCESSOR LDA A,I JMP A,I * ***** CMER LDA ERR06 JSB GN.ER JMP NXTCM GET NEXT COMMAND FROM TTY * ERR06 ASC 1,06 SKP ***** * * BRANCH TABLE FOR COMMAND PROCESSORS. * ORDER OF THIS TABLE MUST CONFORM TO ORDER OF FIRST ENTRIES IN * COMMAND PNEUMONIC TABLE. * ***** PTABL DEF * DEF MAPST MAP STATEMENT DEF RELST RELOCATE STATEMENT DEF RELST REL STATEMENT DEF DSPST DISPLAY STATEMENT DEF EOL /E STATEMENT DEF LNKST LINKS STATEMENT DEF COMST * STATEMENT ***** * * COMMAND PNEUMONIC TABLE * * BITS 15-8 # CHARS IN ASCII KEYWORD TABLE * BITS 7-0 OFFSET IN THAT TABLE (TO LOCATE ASCII WORDS) * * THE ORDER OF ENTRIES IN THIS TABLE IS USED IN DETERMINING THE * OFFSET ASSOCIATED WITH KEYWORDS. THUS ORDER IN THIS TABLE IS * OF PARAMOUNT IMPORTANCE. IF ANY KEYWORD IS EXACTLY THE SAME * AS THE BEGINNING OF A LONGER KEYWORD, THE LONGER KEYWORD MUST * APPEAR FIRST. (FOR EXAMPLE RELOCATE APPEARS BEFORE REL) * ***** CTACN ABS CTABS-CTABN NEG NBR ENTRIES IN TABLE CTABL DEF CTABS CTABS ABS 1400B+AMAP-CMTBL MAP ABS 4000B+ARELC-CMTBL RELOCATE ABS 1400B+ARELC-CMTBL REL ABS 3400B+ADISP-CMTBL DISPLAY ABS 1000B+AEND.-CMTBL /E ABS 2400B+ALINK-CMTBL LINKS ABS 0400B+ASTAR-CMTBL * CTABN EQU * LTABS ABS 2400B+ATBLE-CMTBL TABLE ABS 3000B+AUNDE-CMTBL UNDEFS MTABS ABS 3400B+AMODS-CMTBL MODULES ABS 3400B+AGLOS-CMTBL GLOBALS ABS 2400B+ALINK-CMTBL LINKS ABS 1400B+AOFF.-CMTBL OFF ABS 1400B+AALL.-CMTBL ALL ITAB ABS 1000B+AIN..-CMTBL IN BTAB ABS 2000B+ABASE-CMTBL BASE CPTAB ABS 3400B+ACURN-CMTBL CURRENT|l ITABL DEF ITAB BTABL DEF BTAB CPTBL DEF CPTAB LTABL DEF LTABS MTABL DEF MTABS ***** * ASCII KEYWORD TABLE * ORDER OF ENTRIES IN THIS TABLE IS ON NO IMPORTANCE ***** CMTBL DEF * AMAP ASC 2,MAP ARELC ASC 4,RELOCATE ADISP ASC 4,DISPLAY ATBLE ASC 3,TABLE AUNDE ASC 3,UNDEFS AMODS ASC 4,MODULES AGLOS ASC 4,GLOBALS ALINK ASC 3,LINKS ASTAR ASC 1,* AOFF. ASC 2,OFF AALL. ASC 2,ALL AEND. ASC 1,/E AIN.. ASC 1,IN ACURN ASC 4,CURRENT ABASE ASC 2,BASE * HYADD DEF *+1 PRPTA ASC 1,- * PTR NOP CNTR NOP PTR2 NOP CCNT NOP QQCN1 NOP QQPT. NOP TEMP NOP NCHAR NOP CNT NOP SKP SKP * * SCANNER ROUTINE * ***** * ** SCAN ** SCAN INPUT BUFFER (QIBUF) FOR KEYWORD * CALLING SEQUENCE: * * LDA NUMBER OF ENTRIES TO SEARCH * LDB ADDRESS OF PNEUMONIC TABLE ENTRY ASSOC WITH FIRST CHOICE * JSB SCAN * RETURN1 NOT FOUND * RETURN2 FOUND, OFFSET FROM FIRST ENTRY SEARCHED IN .A. * * NOTE: THIS ROUTINE WILL SKIP LEADING BLANKS IN ATTEMPTING A MATCH. * FURTHER,BUFFER POINTERS ARE ADVANCED PAST THE KEYWORD * MATCHED OR RESET IF NO MATCH OCCURRED. ***** SCAN NOP ENTRY/EXIT STB PTR INITIALIZE SCANNER STA CNTR CLA STA CNT INITIALIZE OFFSET COUNTER SCAN1 LDA PTR,I GET COMMAND POINTER WORD AND B377 MASK COMMAND TABLE OFFSET ADA CMTBL STA PTR2 STORE POINTER TO ASCII COMMAND LDA PTR,I ALF,ALF AND B377 GET # CHARS. STA NCHAR ISZ CNT BUMP OFFSET COUNTER CLA STA CCNT LDA QQCNT SAVE CHARACTER STREAM STA QQCN1 LDA QQPTR STA QQPT. POINTERS. JSB NXTC GET THE FIRST NON-BLANK CHAR CLA END OF LINE JMP SCAN5 GET REST OF CHARS IN LOOP SCAN2 JSB QGETC GET NEXT CHARACTER. CLA NO MORE CHARS. SCAN5 STA TEMP LDA PTR2,I LDB CCNT ISZ CCNT CPB NCHAR ALL CHARS. MATCH? JMP SCAN4 YES-CHECK END OF INPUT ELEMENT. SLB,RSS IS CHAR IN HIGH-ORDER BYTE? ALF,ALF YES--ROTATE TO LOW AND B177 MASK SLB BUMP ASCII COMMAND TABLE POINTER ON ISZ PTR2 EVEN-NUMBERED CHARACTERS. CPA TEMP DO CHARS. MATCH? JMP SCAN2 YES--SO FAR. LDA QQPT. NO--BACKUP POINTERS STA QQPTR LDA QQCN1 STA QQCNT SPC 1 * NOW BUMP COMMAND TABLE POINTER, OR TAKE ERROR EXIT * IF NO MORE LEFT SPC 1 ISZ PTR ISZ CNTR END OF TABLE? JMP SCAN1 NO JMP SCAN,I SPC 1 SCAN4 LDA TEMP IS NEXT SOURCE CHAR A DELIMITER? SZA END OF LINE? JSB BAKUP LDA CNT ISZ SCAN JMP SCAN,I SKP * * INPUT COMMAND LINE * ***** * ** CMDIN ** INPUT NEXT COMMAND LINE * CALLING SEQUENCE: * * JSB CMDIN * RETURN * * * RETURN: QQCHC= POSITIVE # CHARS TRANSMITTED * ***** CMDIN NOP CLA RESET INCOMING CHARACTER STA QQCNT POINTERS LDA QBUFA STA QQPTR JSB PROMT SEND PROMT,READ REPLY DEF *+6 DEF PRPTA DEF P1 DEF QIBUF DEF D72 DEF BPARS STA QQCHC JMP CMDIN,I AND RETURN * MOVE3 NOP SKP ***** * ** MOVE. ** MOVE BLOCK OF CHARS FROM INPUT BUFFER (QIBUF) TO A * SPECIFIED LOCATION. STOP AT FIRST DELIMITER. * CALLING SEQUENCE: * * LDA ADDRESS OF DESTINATION * JSB MOVE. * RETURN * ***** MOVE. NOP STA MOVE3 SAVE DESTINATION ADDRESS JSB NXTC GET NEXT NON BLANK CHAR JMP CMER NONE FOUND MOV01 ALF,ALF POSITION CHAR TO LEFT, STA MOVE3,I AND STORE IN OUTPUT BUFFER JSB QGETC GET NEXT CHAR JMP MOV03 END OF LINE CPA B40 BLANK? JMP MOV02 CPA B54 COMMA? JMP MOV02 CPA GB@= "1" ? SSB JMP LDRIN OK LDB A ADB L73 < A ":"? SSB,RSS JMP LDRIN OK JMP CMER LU CAN'T BE USED * B53 OCT 53 + L60 OCT -60 L73 OCT -73 XNAMA DEF XNAM ***** * ** DISPLAY COMMAND PROCESSOR * ***** DSPST LDA IACOM IF COMMANDS ARE FROM AND INTERACTIVE STA TIACM DEVICE, SZA JMP DISDN THEN DISPLAY ALREADY GOES TO THEM LDA ATRCM ELSE SIMULATE A "TR,ERRLU" LDB P6 JSB TRCHK * DISDN JSB BLINE BLANK PRINT LINE LDA QQPTR SAVE STA STMP BUFFER LDA QQCNT POINTERS STA SVAL LDA ALBUF MOVE NAME OF ENTITY TO BE DISPLAYED JSB MOVE. INTO THE OUTPUT BUFFER LDA STMP STA QQPTR RESTORE BUFFER POINTERS LDA SVAL STA QQCNT LDA N2 LDB LTABL JSB SCAN IS THIS A KEYWORD? JMP DSP10 NO, IT MUST BE AN IDENTIFIER CPA B2 UNDEFS? JMP OLSTU CPA P1 TABLE? JMP OLSTE JMP CMER ERROR. SPC 2 DSP10 LDB ALBUF JSB LSTS SEARCH SYMBOL TABLE JMP DSP30 SYMBOL IS UNDEFINED LDB .LST5,I GET VALUE LDA LBUF+2 SET EQUAL SIGN(=) IN 6TH CHAR AND UPCM OF PRINT LINE IOR B75 STA LBUF+2 LDA LBUF4 JSB CONV CONVERT THE VALUE TO ASCII LDA P12 DSP25 LDB ALBUF JSB DRKEY PRINT THE LINE DSP27 LDA TIACM DETERMINE STATE BEFORE THE DISPLAY SZA JMP NXTCM WAS ALREADY INTERACTIVE LDA ATRCM MUST POP THE "TR,ERRLU" LDB B2 WE PUT THER E JSB TRCHK WITH A "TR" ONLY JMP NXTCM * DSP30 LDA N5 MOVE "UNDEFINED" TO LBUF LDB DSP40 JSB MOVEX LBUF4 NOP LDA D15 JMP DSP25 * DSP40 DEF *+1 ASC 5,UNDEFINED TIACM NOP TEMPORARY STORAGE OF IACOM * OLSTE CLA,INA,RSS ENTRY POINT LIST OPTION. OLSTU CLA LIST UNDEFINED SYMBOLS OPTION. JSB EPL JMP DSP27 ***** * ** MAP COMMAND PROCESSOR * * MAPMD--CORE MAP LISTING FLAG * BIT 0 GLOBAL VARIABLES * 1 MODULES * 2 LINKS ***** MAPST LDA N5 LDB MTABL JSB SCAN JMP CMER STA B LDA MAPMD CPB P1 MODULES? IOR B2 SET BIT 1 CPB B2 GLOBALS? IOR P1 SET BIT 0 CPB P3 LINKS? IOR P4 SET BIT 2 CPB P4 OFF? CLA RESET POINTER CPB P5 ALL? IOR B7 SET BITS 2-0 STA MAPMD JSB DELIM ADVANCE PAST DELIMITERS RSS JMP MAPST JMP NXTCM GET NEXT COMMAND SPC 1 STMP NOP SVAL NOP ***** * ** LINKS IN ** COMMAND PROCESSOR. * ***** LNKST CCA LDB ITABL JSB SCAN LOOK FOR "IN" JMP CMER CCA LDB BTABL JSB SCAN LOOK FOR "BASE" JMP *+3 NO. CLA YES. JMP LNK01 CCA LDB CPTBL JSB SCAN LOOK FOR "CURRENT" JMP CMER NEITHER. CLA,INA LNK01 STA LNKMD 0=BASE, 1=CURRENT. JMP NXTCM * ***** * ** "*" ** COMMAND PROCESSOR * ***** COMST NOP CLA RESET INCOMING POINTERS STA QQCNT LDA QBUFA STA QQPTR JSB PROMT READ REPLY DEF *+6 DEF PRPTA DEF ZERO DON'T REISSUE PROMPT DEF QIBUF DEF D72 DEF BPARS STA QQCHC JMP NXTCM+1 SCAN NEW COMMAND * ***** * ** NXTC ** GET NEXT NON-BLANK CHAR FROM INPUT BUFFER (QIBUF) *CALLING SEQUENCE: * & * JSB NXTC * RETURN1 NO MORE NON-BLANK CHARS * RETURN2 GOT ONE, AND IT IS RETURNED IN .A. * ***** NXTC NOP GET NEXT NONN-BLANK CHARACTER. JSB QGETC JMP NXTC,I ERROR RETURN CPA B40 BLANK? JMP NXTC+1 GET ANOTHER CHARACTER ISZ NXTC TAKE NORMAL EXIT JMP NXTC,I B55 OCT 55 SKP * * RECORD PROCESSING CONTROL * ******************************************************************** * THE TRANSFER OF CONTROL TO * THE APPROPRIATE RECORD PROCESSORS IS MADE * FROM THIS SECTION. EACH PROCESSOR (EXCEPT * NAM PROCESSOR) RETURNS TO THE LABEL -LDRIN-. * * INPUT RECORD, LEGALITY CHECK AND CHECKSUM SECTION ******************************************************************** LDRIN LDA RIC WAS LAST RECORD AN END RECORD? CPA P5 JMP NXTCM GET NEXT COMMAND INCHK LDA ALBUF GET BUFFER WHERE TO PUT REL. LDB POSIN GET RDBIN FLAG. JSB RDBIN GET NEXT RELOCATABLE RECORD JMP CMER FILE ERROR ON INPUT SZA,RSS EOF? JMP NXTCM END OF FILE. * * CHECK FOR LEGAL RECORD TYPE * CLA CLEAR RDBIN FLAG. STA POSIN LDA LBUF+1 GET TYPE WORD ALF,RAR ROTATE RIC FIELD TO AND B7 LOW A AND ISOLATE CODE STA RIC SAVE FOR PROCESSING SZA IF RIC=0 ADA M6 OR GREATER THAN 5 SSA,RSS ERROR? JMP RCERR YES JMP LDRC NO. PROCESS RECORD * RCERR LDA ERR04 YES...TELL THEM ILLEGAL RECORD JMP ERCOV GO TEST & PRINT MESSAGE. SPC 2 * PROCESS VALID RECORD * LDRC ISZ NREC BUMP COUNT # GOOD RECORDS. LDA RIC (A) = RECORD TYPE LDB SERFG CPA P1 IF RIC = 1, THEN GO TO PROCESS JMP LDRC3 NAM RECORD. CPA P5 IF END RECORD THEN PROCESS IT JMP ENDR SSB SKIP RECORD IF NOT LOADING. JMP INCHK CPA B2 / IF RIC = 2, JMP ENTR GO PROCESS ENT RECORD. CPA P3 IF RIC = 3, GO TO JMP DBLR DBL RECORD PROCESSOR. CPA P4 EXT? JMP EXTR EXT RECORD PROCESSOR. SPC 5 * * PROCESSING FOR END RECORD. * ENDR CLA CLEAR FLAG FOR STA NAMR. NAM RECORD EXPECTED. STA SERFG SET PROG LOAD FLAG = LOADING INA STA POSIN SIGNAL RDBIN TO CALL LOCF SSB B STILL IS OLD SERFG JMP INCHK SKIP THIS END RECORD * * PROCESS END RECORD AND LBUF+1 ISOLATE M/S RAR MOVE M/S TO SIGN POSITION IOR ID6,I ADD TO TYPE STA ID6,I SET M/S, TYPE * LDA LWH1 COMPILED PROGRAM? SZA,RSS SKIP IF YES. JMP END2 * * SET NEW LENGTH OF COMPILED PROGRAM. * JSB LOCF SAVE CURRENT POSITION IN FILE. DEF *+6 DEF RRDCB DEF FMRR DEF IRECR DEF IRBR DEF IOFFR JSB CHFIL JSB GTERM * LDA ACBUF READ NAM REC INTO CBUF. CCB JSB RDNAM JSB ABORT ERROR. * LDA CBUF IF 9 WORD RECORD, MAKE ALF,ALF IT 17 WORDS. CPA P9 LDA P17 STA IL ALF,ALF STA CBUF * LDA LWH2 STORE PROGRAM LENGTH. IOR SIGN SET "COMPILED" BIT. STA CBUF+6 JSB CKSUM COMPUTE & STORE NEW CHECKSUM. * JSB WRITF WRITE RECORD TO NEW NAM FILE. DEF *+5 DEF NMDCB DEF FMRR DEF CBUF DEF IL * JSB CHFIL JSB GTERM ABORT IF WRITE ERROR. * LDA ID5,I SET FLAG IN IDENT. IOR BIT14 STA ID5,I * JSB APOSN RESTORE FILE POSITION. DEF *+6 DEF RRDCB DEF FMRR DEF IRECR DEF IRBR DEF IOFFR JSB CHFIL JSB GTERM * END2 LDA XNAM IF XNAM ZERO, SZA CONTINUE PROCESSING RECORDS, JMP NXTCM ELSE GET NEXT COMMAND. JMP INCHK SKP * * PRELIMINARY NAM RECORD PROCESSING * ***** * * THIS PROCESSING OF NAM RECORDS OCCURS BEFORE DECIDING * WHETHER OR NOT TO RELOCATE A MODULE * ***** LDRC3 LDB NAMR. IS NAM 1ST RECORD? SZB IS NAM 1ST RECORD? JMP NMERR NO--SEQUENCE ERROR. LDB XNAMA LDA B,I SZA,RSS WAS A MODULE NAME SPECIFIED? JMP L.DC4 NO. CPA LBUF+3 YES--DOES THIS MODULE MATCH THE NAME? INB,RSS JMP LDRC6 NO--SKIP IT LDA B,I CPA LBUF+4 INB,RSS JMP LDRC6 LDA B,I XOR LBUF+5 AND UPCM SZA JMP LDRC6 L.DC4 CLA STA SERFG CLEAR LOADING FLAG. ISZ NAMR. NAM NOT EXPECTED. JMP NAMR GO PROCESS NAM RECORD. * * RESET PROCESSING - PROGRAM FROM LIBRARY IS * TO BE DISCARDED. LDRC6 CLA STA NAMR. CCA STA SERFG RECORD SKIPPING MODE. JMP INCHK * NMERR LDA ERR03 MISSING END RECORD JMP ERCOV SKP * * MOVEX SUBROUTINE. * * CALLING SEQUENCE: * A = NEG # WORDS * B = ADDR OF SOURCE BUFFER * JSB MOVEX * DEF ADDR OF DESTINATION BUFFER * BSS 2 STORAGE FOR MOVEX MOVEX NOP MOVE A BLOCK OF DATA STA MOVEX-1 STORE NEG. # WORDS. LDA MOVEX,I ISZ MOVEX STA MOVEX-2 STORE TO POINTER LDA B,I GET WORD STA MOVEX-2,I STORE INB ISZ MOVEX-2 ISZ MOVEX-1 DONE? JMP *-5 JMP MOVEX,I YES SPC 3 * * CONSTANTS AND STORAGE FOR MAIN CONTROL SECTION * NREC NOP #GOOD RECORDS COUNTER. RIC OCT 0 HOLDS RECORD IDENTIFICATION CODE UPCM OCT 77400 UPPER CHARACTER MASK. SERFG NOP PROG LOAD FLAG: -1/0=NL/L. NAMR. NOP "NAM REC EXPECTED" FLAG. * M6 DEC -6 D72 DEC 72 * ERR04 ASC 1,04 ERR03 ASѣC 1,03 * * XNAM BSS 3 * BLANK ASC 1, (ORG LBUF-1 FOR EPL SUBROUTINE) NBUF BSS 6 POSIN OCT 0 POSITIONING CODE FOR RDBIN SUBR. SKP * NAM RECORD PROCESSOR * NAMR LDA PIDNT SAVE CURRENT IDENT AND STA BUID LST ENTRY INDICES. LDA PLST STA BULST FOR POSSIBLE MODULE PURGE LDB DNAM GET NAME ADDRESS JSB IDXS SEARCH FOR THE ENTRY JMP ENTNA ENTER NAME * LDA ERR08 GET ERROR CODE - DUPLICATE NAMES CMA,INA SET NEG SO NO TR,ERRLU MAY BE DONE JSB GN.ER PRINT DIAGNOSTIC LDA P5 LDB ID1 GET ADDRESS OF NAME IN IDENT JSB DRKEY PRINT DUPLICATE PROG. NAME * JSB FINDN DID IT HAVE A MODIFIED NAM RECORD? JMP REPNA NO CLA,INA INVALIDATE THE RECORD LDB ACBUF ADB P3 STA B,I JSB NEWNM AND REWRITE THE RECORD JMP REPNA REPLACE REST OF IDENT * ENTNA LDA LBUF+3 GET NAME 1,2 STA ID1,I SET NAME 1,2 IN IDENT LDA LBUF+4 GET NAME 3,4 STA ID2,I SET NAME 3,4 IN IDENT LDA LBUF+5 GET NAME 5 AND M7400 SAVE UPPER CHAR STA ID3,I SET NAME 5 IN IDENT ISZ PIDNT BUMP IDENT COUNTER. * REPNA LDA LBUF+9 GET PROGRAM TYPE AND M177 ISOLATE TYPE JSB FILTR CHANGE IF NECESSARY *RTE 2 & 3* STA ID6,I SET TYPE IN IDENT LDB LBUF+8 GET COMMON LENGTH STB ID4,I SAVE COMMON LENGTH * LDA LNKMD SET BASE/CURRENT LINKAGE RAR AND MAP OPTIONS. IOR MAPMD STA ID5,I CLA,INA LDB LBUF+6 COMPILED? SSB,RSS IF YES, SKIP & SET SWITCH CLA OTHERWISE, CLEAR SWITCH STA LWH1 LDA M7777 INITILIZE THE FIRST DBL ADDRESS STA ID7,I TO MAX POSSIBLE CLA AND THE PROG. LENGTH TO STA LWH2 MIN. POSSIBLE STA ID8,bI CLEAR BS IDENT MAIN ADDRESS LDA DPRS2 SET FILE NAME IN IDENT. INA LDB A,I STB ID9,I INA LDB A,I STB ID10,I INA LDB A,I STB ID11,I ADA B2 POSITION TO SECURITY CODE LDB A,I STB ID12,I SAVE IT ADA P4 POSITION TO CR LABEL LDB A,I STB ID13,I LDA NAMRC STA ID14,I SET RECORD NUMBER. LDA NAMBL STA ID15,I SET RELATIVE BLOCK. LDA NAMOF STA ID16,I SET BLOCK OFFSET. JMP LDRIN GET NEXT RECORD SKP * * DBL REC PROCESSOR * DBLR LDA LBUF+3 GET THE RELOCATION ADDRESS CMA,INA IF LESS THAN CURRENT ADA ID7,I MIN. SSA SKIP JMP DBLR1 ELSE JUST SKIP * LDA LBUF+3 NEW MIN. SO SET IT STA ID7,I IN THE IDENT. * DBLR1 LDA LBUF+1 GET THE LENGTH AND M77 OF THE RECORD (NO. OF PROGRAM WORDS) ADA LBUF+3 COMPUTE MAX. LOAD ADDRESS LDB A SAVE IN B CMB,INB IF THIS IS A NEW ADB LWH2 MAX. THEN SSB SET THE STA LWH2 NEW MAX. JMP LDRIN GO GET NEXT RECORD. SKP * * ENT/EXT RECORD PROCESSOR * ENTR CCA,RSS ENT PROCESSOR EXTR CLA EXT PROCESSOR STA NXFLG NXFLG = ENT/EXT FLAG LDA LBUF+1 SET NO. SYMBOLS AND M37 ISOLATE NO. SYMBOLS CMA,INA STA EXCNT SET SYMBOL COUNT LDB ALBUF ALBUF = A(LBUF) ADB P3 P3 = +3 STB SYM12 SET STARTING SYMBOL ADDR * SETNX LDB SYM12 SET B FOR LSTE JSB LSTE ENTR SYMBOL IN THE LST JMP ENTX3 NEW ENTRY GO FINISH. * * LDA NXFLG GET ENT/EXT FLAG SZA,RSS SKIP IF ENT JMP ENTX4 COMPLETE EXT PROCESSING * * PROCESS ENT REC * LDA SLST IF THIS IS A FORCED  CMA SYMBOL ADA TLST THEN SSA GIVE ERROR JMP DUPEN * LDA .LST4,I GET WORD 4 OF LST ENTRY SZA,RSS SKIP IF NON-ZERO (DEFINED) JMP ENTX2 MAKE ENTRY FOR DEFINED EXT * SSA SKIP IF ENTRY MADE JMP ENTX6 MAKE ENTRY FOR BS EXT * DUPEN LDA ERR05 SET CODE - DUPLICATE ENTRY POINT CMA,INA SET NEG SO NO TR,ERRLU MAY BE DONE JSB GN.ER PRINT GN.ER MESSAGE LDA P5 LDB .LST1 .LST1 = ADDR OF SYMBOL JSB DRKEY PRINT DUPLICATE ENTRY SYMBOL LDA .LST4,I GET THE CURRENT DEFINING ADA N5 VALUE AND IF NOT A SELF DEFINING SSA,RSS SYMBOL JMP ENTX2 GO REDEFINE THE SYMBOL * JMP ENTX5 ELSE GO REDEFINE ONLY IF NEW SELF DEF. * ENTX6 LDA ID6,I GET CURRENT TYPE AND M7 ISOLATE TYPE CPA P3 TYPE = BG DISK RESIDENT? RSS YES - CONTINUE (ERROR) JMP ENTX2 MAKE ENTRY FOR UNDEFINED EXT * LDA ERR13 SET CODE = INVALID BG BS ORDER JMP ERCO1 ENTX2 CCA GET MAIN IDENT INDEX. ADA TIDNT STA .LST4,I ENTER IDENT INDEX IN WORD 4 JMP ENTX5 * ENTX3 LDA NXFLG GET EXT/ENT FLAG SZA SKIP IF EXT ENTRY JMP ENTX2 SET WORD 4 OF ENT ENTRY * LDA ID6,I GET TYPE AND M7 ISOLATE TYPE CCB GET MAIN IDENT INDEX ADB TIDNT CPA P5 TYPE = BS? CMB,RSS YES - SET .LST4 = BS REF, SKIP CLB NO - SET .LST4 = UNDEFINED STB .LST4,I YES - SET INDEX IN LST WORD 4 ENTX4 LDA ID6,I GET TYPE AND M7 ISOLATE TYPE CPA P5 TYPE = BG SEGMENT? RSS YES - CONTINUE JMP ENTX5 NO - IGNORE BG SEG MAIN ADDR * CCA ADA TIDNT GET CURRENT IDENT INDEX. STA IMAIN SAVE IDENT INDEX. LDA .LST4,I GET IDENT INDEX. ;SZA SKIP IF UNDEFINED. SSA SKIP IF IDENT INDEX. JMP ENTX5 IGNORE UNDEFINED EXT * CPA B2 IF SPECIAL SYMBOL RSS FOR GET CPA P3 THE BS RSS BIT CPA P4 JMP ENTX5 * STA TIDNT SET IDENT INDEX FOR IDX JSB IDX SET IDENT ADDRESSES JSB ABORT IDENT NOT FOUND LDA ID6,I GET TYPE SSA,RSS SKIP IF MAIN JMP NTMAN SET FLAG FOR IGNORING BS REF * AND M7 ISOLATE TYPE CPA P3 TYPE = BG DISK RESIDENT? CCB,RSS SET FLAG FOR BS REF, SKIP NTMAN CLB SET FLAG FOR IGNORING BS REF STB TCHAR SET FLAG = 0/-1 = IGNORE/BS REF LDA IMAIN GET CURRENT IDENT INDEX. STA TIDNT SET FOR NEXT IDENT. JSB IDX SET CURRENT IDENT ADDRESSES JSB ABORT INDEX INVALID. ISZ TCHAR SKIP - SET IDENT ADDR FOR BS REF JMP ENTX5 IGNORE IF NOT MAIN BG DISK RES * LDA .LST4,I GET BG MAIN INDEX. STA ID8,I SET MAIN IDENT INDEX IN BS IDENT ENTX5 LDA SYM12 GET SYMBOL ADDR ADA P3 ADJUST FOR BOTH ENT & EXT STA SYM12 SAVE THE ADDRESS FOR NEXT SYMBOL LDB NXFLG GET EXT/ENT FLAG SZB,RSS IF EXT SKIP THE SPECIAL SYMBOL JMP ENTX8 CODE * ADB SYM12 GET THE FLAG LDA B,I AND P15 ISOLATE THE SYMBOL TYPE LDB .LST4,I IF UNDEFINED MUST SZB,RSS BE A FOURCED JMP ENTX7 SYMBOL SO DON'T RESET * SZA IF PROGRAM CPA P1 OR BASE PAGE JMP ENTX7 THEN STANDARD SYMBOL SKIP * STA .LST4,I SET THE SPECIAL FLAG LDA SYM12,I GET THE VALUE STA .LST5,I AND SET IT ENTX7 ISZ SYM12 STEP TO THE NEXT SYMBOL ENTX8 ISZ EXCNT TEST SYMBOL COUNTER JMP SETNX PROCESS NEXT SYMBOL * JMP LDRIN GO GET NEXT RECORD. SKP ERCOV iLDB SERFG IF PROCESSING A SKIP SSB JMP INCHK THEN JUST CONTINUE * CMA,INA SET NEG SO NO TR,ERRLU MAY BE DONE ERCO1 JSB GN.ER SEND ERROR MESSAGE LDA SERFG GET THE LOADING FLAG LDB ID1 AND THE NAME ADDRESS OF CURRENT MODULE SZA IF NOT WITHIN A MODULE LDB MES22 USE '(NONE' INSTEAD LDA NAMR. SZA,RSS LDB MES22 LDA P5 PRINT 5 CHARACTERS JSB DRKEY OF PROGRAM NAME ON TTY * LDA NAMR. WAS A NAM RECORD EXPECTED SZA,RSS SKIP IF ONE WASN'T JMP ERCO2 YES, NEEDN'T BACK UP THE INDICES LDA SERFG WAS A SKIP BEING PROCESSED SSA SKIP IF ONE WASN'T JMP ERCO3 NEED'T BACK UP INDICES * LDA BUID BACK UP THE IDENT LST STA PIDNT LDA BULST AND THE ENT LIST STA PLST * ERCO2 CCA SET THE FLUSHING STA SERFG FLAG ERCO3 CLA STA NAMR. AND CLEAR THE NAM EXPECTED FLAG. JMP INCHK GO GET THE NEXT RECORD SPC 4 * * SUBROUTINE TO COMPUTE & STORE CHECKSUM OF NAM RECORD IN CBUF. * CKSUM NOP LDB CBUF GET RECORD LENGTH. BLF,BLF CMB,INB NEGATE. ADB P3 SKIP WORDS 1-3. STB WDCNT RECORD WORD COUNTER. LDA CBUF+1 INITIALIZE CHECKSUM. LDB ACBUF ADB P3 ADA B,I ADD WORD TO CHECKSUM. INB ISZ WDCNT JMP *-3 LOOP TILL DONE. STA CBUF+2 STORE NEW CHECKSUM. JMP CKSUM,I EXIT. SKP * * FILTR - FILTERS PROGRAM TYPES FOR RTE-II & III * * CALLING SEQ: RETURN: (N+1) * LDA TYPE A=NEW TYPE * JSB FILTR B=DESTROYED * SPC 1 FILTR NOP IFZ ***** BEGIN DMS CODE ***** LDB A SET A WITH WHOLE AND M17 TYPE AND B WITH LOW SWP 4 BITS (PRIMARY TYPE, REV). SPC 1 nB@< CPB P4 TYPE 4 XOR P13 BECOMES 9 SPC 1 CPB P12 TYPE 12 XOR P13 BECOMES 1 SPC 1 CPB P13 TYPE 13 XOR P8 BECOMES 5 ****** END DMS CODE ****** XIF SPC 1 IFN *** BEGIN NON-DMS CODE *** LDB A SET UP A WITH WHOLE TYPE AND M37 AND B WITH LOW 4 SWP BITS (PRI TYPE, REV, SSGA) SPC 1 CPB P30 TYPE 30 XOR P25 BECOMES 7 SPC 1 AND M17 SHUT OFF ANY SSCA BITS **** END NON-DMS CODE **** XIF SPC 1 JMP FILTR,I SKP * BUID NOP SAVED IDENT INDEX. BULST NOP SAVED LST INDEX. N5 DEC -5 P1 DEC 1 P3 DEC 3 P4 DEC 4 P5 DEC 5 P8 DEC 8 P9 DEC 9 P12 DEC 12 P13 DEC 13 P15 DEC 15 P25 DEC 25 P30 DEC 30 M7 OCT 7 M17 OCT 17 M37 OCT 37 M77 OCT 77 M177 OCT 177 M7400 OCT 177400 M7777 OCT 77777 ERR05 ASC 1,05 ERR08 ASC 1,08 ERR13 ASC 1,13 SYM12 NOP SLST NOP SIGN OCT 100000 * MES22 DEF *+1 ASC 3,(NONE) SPC 4 * * PROCESSOR FOR END COMMAND * ***** * ** END COMMAND PROCESSOR * ***** * * PRINT LIST OF UNDEFINEDS, IF ANY, OR "NO UNDEFS" * EOL CLA JSB EPL JMP PRCMD,I END OF COMMANDS. B* * ***** CONSTANTS ***** * MD24 DEC -24 M1 OCT -1 B2 OCT 2 B40 OCT 40 B51 OCT 51 B54 OCT 54 SKP * * SET PARAMETERS INTO IDENTS * * THE PARAMETER INPUT SECTION PERMITS ALTERATION (OR INTRODUCTION) * OF THE TYPE, PRIORITY, AND EXECUTION INTERVAL FOR EACH PROGRAM. * EACH PARAMETER RECORD HAS ONE OF THE FOLLOWING FORMATS: * * NAME,TYPE * NAME,TYPE,PRIORITY * NAME,TYPE,PRIORITY,EXECUTION INTERVAL * * TYPE = 2 DECIMAL DIGITS (1-99) * PRIORITY = 5 DECIMAL DIGITS (0-32767) * EXECUTION INTERVAL = 6 OPERANDS * 1 - RESOLUTION CODE (2 DECIMAL DIGITS) * 2 - EXECUTION MULTIPLE (5 DECIMAL DIGITS) * 3 - HOURS (2 DECIMAL DIGITS) * 4 - MINUTES (2 DECIMAL DIGITS) * 5 - SECONDS (2 DECIMAL DIGITS) * 6 - 10'S MULLISECONDS (2 DECIMAL DIGITS) * * NOTE: TYPE OF BG DISK RESIDENTS HAVING BG SEGMENTS MAY NOT * BE ALTERED WITHOUT DESTROYING RELATIONSHIP. * PARAM JSB SPACE NEW LINE LDA P10 LDB MES24 MES24 = ADDR: PARAMETERS JSB DRKEY PRINT: PARAMETERS * PARST CLA,INA LDB HYADD JSB READ GET ASCII PARAMETER RECORD SZA,RSS SKIP IF CHARS INPUT JMP PARST REPEAT PARAMETER INPUT * LDA N5 JSB GETNA MOVE CHARS FROM LBUF TO TBUF CPA "/E" CHARS = /E? JMP SETLB YES - CLOSE FILE. * CPA BLANK BLANK LINE OR COMMENT? JMP PARST YES TRY ANOTHER * JSB GETAL GET NEXT CHAR FROM LBUF CPA B40 CHAR = BLANK?(DELIMITER = COMMA) JMP PANOK YES - CONTINUE * PANER LDA ERR09 PARAMETER NAME ERROR JMP PARER * PANOK LDB ATBUF FIND THE PROGRAM JSB IDXS IN THE IDENT TABLE JMP PANER NOT FOUND- INVALID NAME * * SET TYPE LDA N2 JSB GETOC CONVERT TO OCTAL JMP PATER INVALID DIGIT * JSB GETAL GET NEXTƭ CHAR FROM LBUF CPA ZERO CHAR = ZERO? (END OF BUFFER) RSS YES - CONTIMUE CPA B40 CHAR = BLANK?(DELIMITER = COMMA) JMP SETYP SET PROGRAM TYPE IN IDENT * PATER LDA ERR10 PARAMETER TYPE ERROR JMP PARER * SETYP CLB IF THIS IS THE SCHEDULED PGM CCA ADA TIDNT AGAIN CPA SCH1 THEN STB SCH1 CLEAR ITS FLAG LDB OCTNO GET CONVERTED NUMBER LDA ID6,I GET CURRENT TYPE AND M177 TO A CPA B IF NO CHANGE JMP TYPOK SKIP CHECK * CPB P14 IF CHANGE IS TO CORE RES LIB CPA P6 MUST BE LEGAL CORE RES. LIB. MODULE RSS OK SKIP JMP PATER NOT OK, ERROR * TYPOK LDA OCTNO IF AUTO SCHED AND P64 BIT NOT SET SZA,RSS THEN JUST GO JMP SCH SET TYPE. SPC 1 LDB OCTNO AUTO SCHED...SUBTRACT ADB N80 80 FROM TYPE TO STB OCTNO GET REAL TYPE. SPC 1 LDA ID6,I MERGE M/S BIT IN AND SIGN WITH TYPE. IOR B CCB ADB TIDNT B HAS IDENT INDEX. SPC 1 SSA,RSS IF NOT MAIN PGM JMP SCH IGNOR IT AND M7 MASK TO THE ID TYPE SZA IF ZERO OR ADA N5 MORE THAN 4 SSA SKIP STB SCH1 ELSE SET PGM IDENT IN SCH FLAG SPC 1 SCH LDA OCTNO GET NEW TYPE JSB FILTR FILTER IT, LDB A THEN MERGE LDA ID6,I INTO IDENT 6 AND M7600 IOR B STA ID6,I SPC 1 JSB GETAL GET NEXT CHAR FROM LBUF CPA ZERO CHAR = ZERO ? (END OF BUFFER) JMP PARST YES - GET NEXT PARAMETER RECORD * * SET NEW PROGRAM PRIORITY * LDA N5 SET COUNT FOR DECIMAL CONVERSION JSB GETOC CONVERT TO OCTAL JMP PAPER PRIORITY ERROR _* SSA IF NEGATIVE JMP PAPER THEN ERROR * JSB GETAL GET NEXT CHAR FROM LBUF SZA CHAR = ZERO ? (END OF BUFFER) CPA B40 CHAR = BLANK?(DELIMITER = COMMA) JMP SETNR SET PRIORITY * PAPER LDA ERR11 PARAMETER PRIORITY ERROR JMP PARER * SETNR CLB SIGNAL RDNAM TO IGNORE NAME IN PARSA LDA ACBUF GET THE NAM RECORD TO CBUF. JSB RDNAM JSB ABORT ERROR. * JSB FINDN SEARCH FOR A MODIFIED NAM RECORD JMP SETPR DIDN'T HAVE ONE YET JMP SETPR FOUND, NOW MODIFY IT SKP * * SEARCH FOR A MODIFIED NAM RECORD BELONGING TO THE CURRENT IDENT * * * RETURN: (P+1) IDENT DOES NOT PRESENTLY HAVE ONE * (P+2) FOUND ONE - POSITIONED AT IT * * BRANCHES TO PACLO ON FILE ERROR (FOR TERMINATION) * FINDN NOP CLA STA IRECW LDA ID5,I CHECK IF NAM RECORD ALREADY HAS RAL MODIFIED VERSION (COMPILED PROG). SSA,RSS JMP FINDN,I NO. * JSB LOCF YES. SAVE CURRENT WRITE POINTERS. DEF *+6 DEF NMDCB DEF FMRR DEF IRECW DEF IRBW DEF IOFFW * JSB CHFIL JMP PACLO ERROR. * JSB RWNDF REWIND THE FILE. DEF *+3 DEF NMDCB DEF FMRR * JSB CHFIL JMP PACLO ERROR. * END1 JSB LOCF GET LOC. OF NEXT RECORD. DEF *+6 DEF NMDCB DEF FMRR DEF IRECR DEF IRBR DEF IOFFR * JSB CHFIL JMP PACLO ERROR. * JSB READF READ THE RECORD. DEF *+6 DEF NMDCB DEF FMRR DEF CBUF DEF P60 DEF LEN * JSB CHFIL JMP PACLO ERROR. * LDA LEN CPA N1 JMP PACLO ERROR IF EOF. * LDB ACBUF COMARE NAM IN CBUF ADB P3 AGAINST NAM IN IDENT. LDA B,I CPA ID1,I INB,RSS JMP END1 NO MATCH. LDA B,I CPA ID2,I INB,RSS JMP END1 NO MATCH. LDA B,I XOR ID3,I AND M7400 SZA JMP END1 NO MATCH. * JSB APOSN MATCH. POSITION NEXT WRITE. DEF *+6 DEF NMDCB DEF FMRR DEF IRECR DEF IRBR DEF IOFFR * JSB CHFIL JMP PACLO ERROR. * ISZ FINDN BUMP RETURN ADDRESS JMP FINDN,I SKP * SETPR LDA CBUF ADJUST RECORD LENGTH FOR THOSE ALF,ALF NOT FIXED FOR COMPILED PROGRAMS. CPA P9 LDA P17 STA IL ALF,ALF STA CBUF LDB OCTNO GET PRIORITY SZB,RSS SKIP - PRIORITY ENTERED LDB P99 REPLACE ZERO PRIORITY WITH 99 LDA ID6,I GET THE TYPE AND M177 AND ISOLATE IT SZA,RSS IF A SYSTEM PROGRAM USE CLB PRIORITY ZERO STB CBUF+10 SET NEW PRIORITY IN THE RECORD JSB GETAL GET NEXT CHAR FROM LBUF CPA ZERO CHAR = ZERO ? (END OF BUFFER) JMP PARWR YES - GO REWRITE THE NAM RECORD * * GET RESOLUTION CODE * LDA N2 SET FOR 2 DECIMAL DIGITS JSB EXINT GET DIGITS FROM LBUF STA CBUF+11 SET IN THE NAM RECORD * * GET EXECUTION MULTIPLE * LDA N5 SET COUNT FOR DECIMAL CONVERSION JSB EXINT GET DIGITS FROM LBUF AND M1600 ISOLATE UPPER 3 BITS IN A SZA SKIP IF VALID MULTIPLE JMP PAIER INVALID EXECUTION INTERV FORMAT LDA OCTNO GET CONVERTED NUMBER STA CBUF+12 SET IN THE NAM RECORD * * GET HOURS * LDA N2 SET FOR 2 DECIMAL DIGITS JSB EXINT GET DIGITS FROM LBUF STA CBUF+13 SET IN THE NAM RECORD * * GET MINUTES * LDA N2 SET FOR 2 DECIMAL DIGITS ' JSB EXINT GET DIGITS FROM LBUF STA CBUF+14 SET IN THE NAM RECORD * * GET SECONDS * LDA N2 SET FOR 2 DECIMAL DIGITS JSB EXINT GET DIGITS FROM LBUF STA CBUF+15 SET IN THE NAM RECORD * * GET TENS OF MILLISECONDS * LDA N2 SET FOR DECIMAL CONVERSION JSB GETOC CONVERT TO OCTAL JMP PAIER INVALID DIGIT JSB GETAL GET NEXT CHAR FROM LBUF SZA CHAR = 0? (END OF BUFFER) JMP PAIER NO - INVALID DELIMITER * LDA OCTNO GET CONVERTED NUMBER STA CBUF+16 SET IN THE NAM RECORD * PARWR JSB NEWNM BUILD NEW MODIFIED RECORD JMP PARST GO PROCESS NEXT ENTRY SKP * * COMPUTE AND STORE NEW CHECKSUM, WRITE RECORD TO * NEW NAM FILE, AND SET FLAG IN IDENT. * NEWNM NOP JSB CKSUM * JSB WRITF WRITE RECORD. DEF *+5 DEF NMDCB DEF FMRR DEF CBUF DEF IL * JSB CHFIL ABORT IF WRITE ERROR. JMP PACLO * LDA ID5,I SET FLAG IN IDENT. IOR BIT14 STA ID5,I * LDA IRECW WAS IT AN UPDATE WRITE? SZA,RSS JMP NEWNM,I NO. * JSB APOSN YES. GET BACK TO OLD PLACE. DEF *+6 DEF NMDCB DEF FMRR DEF IRECW DEF IRBW DEF IOFFW JSB CHFIL JMP PACLO * JMP NEWNM,I * IRECW NOP IRBW NOP IOFFW NOP IRECR NOP IRBR NOP IOFFR NOP P60 DEC 60 LEN NOP BIT14 OCT 40000 ACBUF DEF CBUF CBUF BSS 60 SKP * EXECUTION INTERVAL INPUT CONTROL EXINT NOP JSB GETOC CONVERT TO OCTAL JMP PAIER INVALID DIGIT JSB GETAL GET NEXT CHAR FROM LBUF CPA B40 CHAR = BLANK? (DELIMITER=COMMA) RSS YES - CONTINUE JMP PAIER NO - INVALID DELIMITER LDA OCTNO GET CONVERTED NUMBER JMP EXINT,I RETURN WITH NUMBER IN A * PAIER LDA ERR12 PARAMETER INTERVAL ERROR PARER JSB PNERR SEND ERROR MESSAGE JMP PARST TRY AGAIN * PNERR NOP SUBROUTINE TO PRINT ERROR JSB GN.ER PRINT GN.ER MESSAGE JSB SPACE NEW LINE JMP PNERR,I RETURN * PACLO JSB CLOSE CLOSE NEW NAM FILE. DEF *+3 DEF NMDCB DEF TEMP1 * LDA FMRR WRITE ERROR? SSA,RSS JMP PARST NO. * JSB GTERM ABORT. SKP * * CHANGE ENTS SECTION * SETLB JSB CLOSE CLOSE THE NAM RECORD FILE DEF *+3 DEF NMDCB DEF TEMP1 JSB SPACE * LDA P12 GET MESSAGE LENGTH LDB MES21 SEND MESSAGE JSB DRKEY 'CHANGE ENTS?' * PENT CLA,INA LDB HYADD JSB READ READ THE ENT RECORD. SZA,RSS IF ZERO JMP PENT TRY AGAIN * LDA N5 TO JSB GETNA TBUF CPA "/E" IF '/E' JMP EXENT DONE GO TO NEXT SECTION * CPA BLANK IF '*' OR BLANK LINE JMP PENT TRY THE NEXT LINE * JSB GETAL GET THE NEXT CHAR CPA B40 IF COMMA JMP ENTOK OK * ENAME LDA ERR09 ELSE ERROR JMP EARER GO REPORT IT * ENTOK LDB ATBUF FIND THE JSB LSTE DEFINE AND OR LOCATE LST NOP (DON'T CARE IF EARLIER DEFINED) * LDA N2 GET TYPE FLAG JSB GETNA CARACTER CLE CPA "AB" IF ABSOLUTE CLB,CCE SET FLAG CPA "RP" IF REPLACE CLB,CCE,INB SET OTHER FLAG SEZ IF NONE OF THE ABOVE JMP ENTNO * EATER LDA ERR10 THEN SEND ERROR EARER JSB PNERR JMP PENT * ENTNO ADB P3 ADJUST TO ENT TYPE STB IDXS SAVE IN TEMP JSB GETAL CHECK FOR COMMA CPA B40 AS NEXT CHARACTER RSS IF NOT JMP EATER BITCH *  LDA CURAL SAVE CURRENT STA ID1 POSITION LDA BUFUL FOR BACKING STA ID2 UP LDA B7 GET NUMBER JSB GETOC ASSUMING OCTAL RSS IF ERROR MIGHT BE DECIMAL SO SKIP JMP ENTOC IT IS OCTAL SO GO SET UP * LDA ID1 BACK UP THE SCANNER STA CURAL POSITION LDA ID2 STA BUFUL LDA N7 NOW TRY JSB GETOC A DECIMAL CONVERSION RSS ERROR EXPECTED ( 12345D) ON THE D JMP EATER NO ERROR SO WRONG INPUT * LDA TCHAR MAKE SURE ERROR CPA P20 WAS ON A "D" RSS YES SO FAR SO GOOD JMP EATER NO GO BITCH * ENTOC LDA IDXS SET THE ENT TYPE STA .LST4,I AND LDA OCTNO VALUE STA .LST5,I IN THE SYMBOL TABLE JMP PENT GO GET NEXT SYMBOL. * EXENT JSB SPACE SEND A SPACE SKP * * SET LIBRARY, COM, TYPE TOTALS * * THIS SECTION IS EXECUTED WHEN THE PARAMETERS HAVE * BEEN COMPLETELY READ IN. IT COMPUTES THE MAXIMUM LENGTH OF * BOTH THE REAL TIME AND BACKGROUND COMMON AREAS. * FINALLY, IT RESERVES A 22-WORD SECTION OF CODE FOR EACH USER * PROGRAM (PLUS AN ADDITIONAL 6 WORDS IF DISK RESIDENT) TO * GENERATE THE ID SEGMENTS. FINALLY, IT RESEVES A KEYWORD TO * CONTAIN THE ADDRESS OF EACH ID SEGMENT. * * CLA STA FGBGC CLEAR FORGROUND USING BG COMMON FLAG STA SICNT CLEAR SHORT ID SEG COUNT STA LICNT CLEAR LONG ID SEG COUNT STA SSCNT CLEAR BG SEG. ID SEG COUNT STA COMRT CLEAR RT COM LENGTH STA COMBG CLEAR BG COM LENGTH STA IDSP RTMR FLAG *TEMP* STA DSKSY BGMR FLAG *TEMP* JSB INIDX INITIALIZE IDX SETIX JSB IDX SET IDENT ADDRESSES JMP TRMCN TERMINATE ID SEGMENT COUNT * LDA ID6,I GET TYPE AND M17 ISOLATE tYPE AND REV COM BITS LDB ID4,I  GET COMMON LENGTH CLE CLEAR FORGROUND USING BG COMMON SWITCH CPA P11 IF BG RESIDENT USING FG COMMON RSS IFN *** BEGIN NON-DMS CODE *** CPA P12 OR BG DSC RESIDENT USING FG COMMON RSS CPA P13 OR BG SEG USING FG COMMON RSS **** END NON-DMS CODE **** XIF CPA P1 OR TYPE = RT RESIDENT? RSS CPA B2 OR TYPE = RT DISK RESIDENT? JMP SETRC SET RT COMMON LENGTH * CPA P9 IF FG RES. USING BG COMMON CCE,RSS SET CROSS COMMON SWITCH CPA P10 LIKEWISE IF FG DSC RESIDENT CCE,RSS CPA P3 TYPE = BG DISK RESIDENT?? IFN *** BEGIN NON-DMS CODE *** RSS CPA P4 TYPE = BG RESIDENT? RSS CPA P5 TYPE = BG SEG?? **** END NON-DMS CODE **** XIF JMP SETBC SET BG COMMON LENGTH * IFZ ***** BEGIN DMS CODE ***** LDA ID6,I GET TYPE AGAIN AND M37 BUT LEAVE SSGA BIT ON ****** END DMS CODE ****** XIF CPA P14 IF CORE RES LIB. RSS CPA ZERO TYPE = SYSTEM? RSS CPA P6 TYPE = LIBRARY? IFZ ***** BEGIN DMS CODE ***** RSS CPA P30 TYPE = SSGA?? ****** END DMS CODE ****** XIF SZB,RSS SKIP - HAS INVALID COMMON JMP SETR1 PROCESS NEXT IDENT * LDA ERR37 SET CODE = INVALID COMMON JSB GN.ER PRINT DIAGNOSTIC LDA P5 LDB ID1 GET IDENT ADDRESS JSB DRKEY PRINT PROG NAME FOR INVALID COM JMP SETIX PROCESS NEXT IDENT * SETBC SEZ IF CROSS COMMON SWITCH SET ISZ FGBGC SET THE CROSS COMMON FLAG LDA COMBG GET PREVIOUS MAX COMMON LENGTH CMA,INA ADA B SET A = PROG COM - PREVIOUS COM SSA,RSS SKIP IF PREVIOUS GREATER STB COMBG SET NEW MAX BG COMMON LENGTH JMP SETR1 CHECK FTYPE * SETRC LDA COMRT GET PREVIOUS MAX COMMON LENGTH CMA,INA ADA B SET A = PROG COM - PREVIOUS COM SSA,RSS SKIP IF PREVIOUS GREATER STB COMRT SET NEW MAX RT COM LENGTH SETR1 LDA ID6,I GET M/S SSA,RSS SKIP IF MAIN JMP SETIX PROCESS NEXT IDENT * AND M7 ISOLATE TYPE CLB CPA P1 TYPE = RT RESIDENT? IFN *** BEGIN NON-DMS CODE *** INB,RSS CPA P4 OR TYPE = BG RESIDENT? **** END NON-DMS CODE **** XIF ISZ SICNT YES, COUNT SHORT ID SEGMENT SZB IF ONE ENCOUNTERED ISZ IDSP SIGNAL IN *TEMP* FOR LATER CLB RESET FLAG CPA B2 IF FORGROUND DISC RESIDENT INB,RSS OR CPA P3 BACKGROUND DISC RESIDENT ISZ LICNT COUNT A LONG ID SEGMENT SZB IF A RTDR ENCOUNTERED ISZ DSKSY THEN SIGNAL IN *TEMP* FOR LATER CPA P5 IF A SEGMENT ISZ SSCNT COUNT A SEGMENT ID SEGMENT JMP SETIX GO PROCESS THE NEXT MODULE * * TRMCN JSB SPACE LDA P23 LDB MES42 MES42 = ADDR: # OF BLANK ID'S JSB READ PRINT AND GET REPLY LDA N5 GET 5 JSB GETOC DECIMAL DIGITS, CONVERT JMP TRM2 -INVALID INPUT. SZA,RSS IF ZERO, ADD 1 INA FOR BKG. ON-LINE LOADING. ADA LICNT ADD TO LONG ID SEGMENT COUNT. LDB A CHECK AGAINST THE 254 MAX ADA N255 SSA,RSS JMP TRM2 TOO BIG STB LICNT * JSB SPACE SEND TRM4 LDA P31 MESSAGE LDB MES43 '# OF BLANK SEGMENT ID'S?' JSB READ AND GET ANSWER LDA N5 CONVERT JSB GETOC THE ANSWER JMP TRM5 ERROR TRY AGAIN ADA SSCNT ADD TO THE SHORT ID SEG COUNT LDB A AND M7400 SZA CHECK AGAINST 255 MAX JMP TRM5 STB SSCNT  RESTORE ADB LICNT SUM THE TOTAL COUNT ADB SICNT INB ADD ONE FOR STOP WORD STB KEYCN IFZ SKP ***** BEGIN DMS CODE ***** ******************************************************************** * * * ASK FOR MAXIMUM NUMBER OF PARTITIONS TO BE DEFINED * * * ******************************************************************** SPC 1 JSB SPACE GNP LDA MS30L LENGTH OF MSG LDB MS30. ADR OF MESSAGE JSB READ SEND AND READ RESPONSE LDA N5 CHECK FOR 5 DECIMAL JSB GETOC DIGITS IN RESPONSE RSS TRY AGAIN ON ERROR JMP GNP1 LDA TRM3 JSB GN.ER JMP GNP SPC 1 GNP1 LDB N65 ADB A IF MORE THAN 64, SSB,RSS THEN GO AND ASK JMP GNP AGAIN STA MAXPT ELSE SAVE MAX NO. PARTS. ****** END DMS CODE ****** XIF JMP INPUT,I RETURN TO MAIN. * TRM2 LDA TRM3 PRINT JSB GN.ER "ERR 01" JMP TRMCN+1 * TRM5 LDA TRM3 JSB GN.ER JMP TRM4 * * ZERO OCT 0 N7 DEC -7 N255 DEC -255 P6 DEC 6 P10 DEC 10 P11 DEC 11 P14 DEC 14 P18 DEC 18 P20 DEC 20 P23 DEC 23 P31 DEC 31 P64 DEC 64 P99 DEC 99 N65 DEC -65 N80 DEC -80 "/E" ASC 1,/E "AB" ASC 1,AB "RP" ASC 1,RP M1600 OCT 160000 M7600 OCT 177600 IL NOP * MES24 DEF *+1 ASC 5,PARAMETERS MES21 DEF *+1 ASC 6,CHANGE ENTS? MES42 DEF *+1 ASC 12,# OF BLANK ID SEGMENTS? MES43 DEF *+1 ASC 16,# OF BLANK BG SEG. ID SEGMENTS? **** BEGIN DMS CODE **** IFZ MS30. DEF *+1 ASC 13,MAX NUMBER OF PARTITIONS? MS30L EQU P25 XIF ***** END DMS CODE ***** * ERR09 ASC 1,09 ERR10 ASC 1,10 ERR11 ASC 1,11 ERR12 ASC 1,12 ERR37 ASC 1,37 TRM3 ASC 1,01 SKP ***** * ** EPL * ENTRY POINT LIST ROUTINE * * CALLING SEQUENCE: * (A): =0, LIST UNDEFINED EXTERNAL SYMBOLS. * =1, LIST ENTRY POINT SYMBOLS AND * * (P) JSB EPL * (P+1) (RETURN) A AND B DESTROYED * ***** EPL NOP ENTRY/EXIT POINT STA NBUF SAVE ENTRY PARAMETER. SZA,RSS UNDEFS? JMP EPL5 YES EPL0 JSB INLST INITIALIZE SYMBOL TABLE POINTERS. EPL1 JSB LSTX SET LST ENTRY ADDRESSES JMP EPL3 END OF SYMBOL TABLE JSB MLBUF MOVE SYMBOL TO LBUF LDB .LST4,I (B) = ENT. ADDRESS LDA NBUF (A) = ENTRY PARAMETER SZA IF ENT LIST REQUESTED JMP EPL2 GO DISPLAY. CMB,SSB,INB,SZB SKIP IF UNDEF OR BS REF. JMP EPL1 GO CHECK NEXT ENTRY. * LDA TEMP1 HEADING PRINTED? SZA JMP EPL8 YES. ISZ TEMP1 NO. SET FLAG AND LDA UNDFS PRINT "UNDEFS". LDB UNDFS+1 JSB DRKEY * EPL8 LDB ALBUF LDA P5 JSB DRKEY OUTPUT SYMBOL. JMP EPL1 CONTINUE SCAN * * LIST SYMBOL TABLE * EPL2 CMB,SSB,INB,SZB,RSS ENTRY DEFINED? JMP EPL1 NO JMP EPL8 PROCESS NEXT ENTRY IN LST. * EPL5 LDA SLST SET BOTTOM OF PGM LST FOR SCAN. STA TLST CLA CLEAR HEADING FLAG. STA TEMP1 JMP EPL1 * EPL3 LDA NBUF IF NO UNDEFS, ADA TEMP1 PRINT "NO UNDEFS". SZA JMP EPL,I * LDA EPL6 NO--PRINT "NO UNDEFS" LDB EPL6+1 JSB DRKEY JMP EPL,I SPC 1 EPL6 DEC 9 DEF *+1 ASC 5,NO UNDEFS SPC 1 * UNDFS DEC 7 DEF *+1 ASC 4, UNDEFS * * CONSTANT AND STORAGE SECTION FOR -EPL- . * M3 OCT -3 B7 OCT 7 B60 OCT 60 * * * MOVE CURRENT SYMBOL FROM SYMBOL TABLE TO LBUF * MLBUF NOP LDA M3 LDB .LST1 JSB MOVEX ML0 NOP LDA LBUF+2 MAKE 6TH CHAR. A BLANK IOR B40 STA LBUF+2 JMP MLBUF,I SKP ***** * * SUBROUTINE: CONV (CONVERT 15-BIT BINARY NUMBER * TO 6-CHARACTER (LEADING BLANK) * ASCII FORM OF THE OCTAL * REPRESENTATION.) * * CALLING SEQUENCE: * * (A)-ADDRESS OF 3-WORD AREA FOR * STORING ASCII/OCTAL CHARACTERS * (B)-BINARY VALUE FOR CONVERSION * * (P) JSB CONV * (P+1) (RETURN)-(A)=NEXT ADDRESS OF STORAGE * AREA,(B)-DESTROYED. ***** CONV NOP STA NBUF+3 SAVE STORAGE AREA ADDRESS RBL POSITION FIRST DIGIT TO B(15-13). LDA M3 LET CONVERT COUNTER STA NBUF+4 = -3. LDA B40 MAKE FIRST CHARACTER A SPACE. CONV1 ALF,ALF ROTATE CHAR. TO UPPER POSITION STA NBUF+5 AND SAVE. BLF,RBR POSITION NEXT DIGIT TO B(02-00), LDA B AND B7 ISOLATE DIGIT. IOR B60 MAKE AN ASCII CHAR. (60 - 67). IOR NBUF+5 PACK IN UPPER CHARACTER STA NBUF+3,I AND STORE IN STORAGE AREA. ISZ NBUF+3 ADD 1 TO STORAGE AREA ADDRESS. BLF,RBR ROTATE NEXT DIGIT TO LOW B, LDA B ISOLATE CHAR AND B7 IN LOW A, IOR B60 MAKE AN ASCII CHAR. ISZ NBUF+4 INDEX CONVERT COUNTER JMP CONV1 NOT FINISHED. LDA NBUF+3 FINISHED, SET (A)= NEXT STORAGE JMP CONV,I AREA WORD ADDRESS AND EXIT. * SPC 2 ***** * ** QGETC ** GET NEXT CHAR FROM INPUT BUFFER (QIBUF) * CALLING SEQUENCE: * * JSB * RETURN1 NO MORE CHARS IN BUFFER * RETURN2 GOT ONE, RETURN IT IN .A. * ***** QGETC NOP GET A CHARACTER LDB QQCNT CPB QQCHC END OF INPUT? JMP QGETC,I YES. ISZ QQCNT COUNT CHARS READ LDA QQPTR,I SLB,RSS LEFT CHAR? ALF,ALF YES, MNLHOVE RIGHT AND B177 SLB IF THIS CHAR IS RIGHT, ... ISZ QQPTR NEXT ONE IS LEFT OF NEXT WORD. CPA STAR IF * THEN END OF LINE RSS ISZ QGETC SKIP EXIT JMP QGETC,I * QBUFA DEF QIBUF QIBUF BSS 40 QQCHC NOP QQCNT NOP QQPTR NOP STAR OCT 52 SKP * * CONSTANTS,AND MESSAGES * * ***** CONSTANTS ***** * B50 OCT 50 D15 DEC 15 B75 OCT 75 B177 OCT 177 B377 OCT 377 N2 DEC -2 LNKMD NOP LINKS FLAG. MAPMD NOP MAP FLAG. SPC 3 SPC 1 END EQU * * END LSWAP @NASMB,Z,R,L,C HED RTGN3 - LOADING CONTROL SEGMENT IFN ASSEMBLY OPTION "N" FOR RTE-II NAM RT2G3,5,90 92001-16031 771219 XIF IFZ ASSEMBLY OPTION "Z" FOR RTE-III NAM RT3G3,5,90 92060-16037 771219 XIF SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 2 SPC 1 ****************************************************** * * NAME: RT2G3/RT3G3 * SOURCE PART #: 92001-18031 / 92060-18037 * REL PART #: 92001-16031 / 92060-16037 * WRITTEN BY: K. HAHN, J. HARTSELL, G. ANZINGER * ****************************************************** SPC 1 * * ENTRY POINT NAMES * ENT FWENT * * EXTERNAL REFERENCE NAMES * IFZ EXT PARTD XIF * EXT .NM.,IRERR EXT LLOAD,LOADS,GENIO,FSECT EXT SDS#,CURAL,CPL2,PPREL EXT TBCHN,LWASM,PIOC,SWAPF,LBUF,TBUF EXT RDNAM,RDBIN EXT CONVD,LABDO,DISKA,DISKO,DISKI EXT OCTNO,DSKAD,PTYPE,TYPMS EXT GETOC,GETAL,SPACE,READ,GN.ER,DRKEY,ABORT EXT ADBP,SETDS EXT INLST,LSTX,LSTS EXT .LST1,.LST2,.LST3,.LST4,.LST5 EXT INIDX,IDX,TIDNT EXT ID1,ID2,ID3,ID4,ID5,ID6,ID8 EXT TBLNK EXT LRBP,URBP,IRBP EXT LBBP,UBBP,IBBP EXT CUBP,UCUBP,ICUBP,CUBPA EXT LNK,LNKS EXT LNK1,LNK2,LNK3 EXT SEGS,SYS,USERS,USER EXT SWRET,DSKAB,PFIX,TFIX,ADBUF,OLDDA,YE/NO EXT EXEC,CLSAB,LFOUT,CLOSF,LFDCB,FMRR,IPDCB,ERRLU EXT LWSBP,NLCOM,#IREG EXT CLOSE,NMDCB,OPEN,RRDCB,ECDCB EXT ABCOR,MXABC,TTIME,TIME1,MULR EX'7T CPLSB,ASKEY,SISDA,SKEYA EXT P3,P4,P5,P14 EXT M7400 * * A EQU 0 B EQU 1 SUP ************************************************************************ * SKP * THE FOLLOWING BLOCK OF STORAGE FOR VARIABLES PRECEEDS, * AND IS REFERENCED BY, EACH SEGMENT. IT IS NOT OVERLAID * AS EACH NEW SEGMENT IS LOADED INTO CORE. * * THE LOCATION OF EACH VARIABLE MUST BE THE SAME IN * ALL SEGMENTS. IF A CHANGE IS MADE, MAKE THE SAME * CHANGE IN THE REST OF THE SEGMENTS. * * * SYSCH BSS 1 SUBCHANNEL OF SYSTEM UNIT. AUXCH BSS 1 SUBCHANNEL OF AUX UNIT. DSIZE BSS 1 DISK SIZE -NO. OF TRACKS. DAUXN BSS 1 AUXILIARY DISK SIZE. ADS# BSS 1 AUX DISC SECTORS/TRACK. * * RELOCATION BASE TABLE. RBTA BSS 1 ABSOLUTE PROGRAM BASE. TPREL BSS 1 CURRENT PROGRAM BASE ADDRESS. TPBRE BSS 1 BASE PAGE RELOCATION ADDRESS. COMAD BSS 1 CURRENT COMMON RELOCATION BASE. BSS 1 ABS PROGRAM BASE FOR MR CODE. * WDCNT BSS 1 TEMPORARY WORD COUNTER. DSKSY BSS 1 INITIAL ID SEGMENT DISK ADDRESS IDSP BSS 1 POSITION OF 1ST ID SEG. IN SECT TTYCH BSS 1 SYSTEM TTY CHANNEL NO. * PLFLG BSS 1 PROGRAM LOAD. FLAG = -1/0 = L/NL DSCNT BSS 1 DISK SEGMENT SECTOR COUNT * NXFLG BSS 1 ENT/EXT FLAG = -1/0 EXCNT BSS 1 SYMBOL COUNTER * LCNT BSS 1 CURRENT LBUF COUNT DCNT BSS 1 CURRENT DBUF COUNT CURAI BSS 1 CURRENT IBUF COUNT * CPLS BSS 1 ADDRESS OF TOP OF FIXED CP LINK IMAGE CPL1 BSS 1 ADDRESS OF LOW CURRENT PAGE LINK SPECS. CPL1H BSS 1 NUMBER OF CURRENT PAGE LINKS ASSIGNED CPL2H BSS 1 IN LOW AND HIGH AREA RESPECTIVELY URBP1 BSS 1 LWA R/T DISC RES BP LINK AREA BPMAX BSS 1 MAX USED BASE PAGE LINKAGE +1 CURAK BSS 1 CURRENT KBUF ADDRESS * CURAT BSS 1 CURRENT TBUF ADDRESS TCNT BSS 1 6Z CURRENT TBUF COUNT * CURAP BSS 1 CURRENT PLIST ADDRESS * AMAD BSS 1 CURRENT MLIST ADDRESS * LICNT BSS 1 LONG ID SEGMENT COUNT SICNT BSS 1 SHORT ID SEGMENT COUNT SSCNT BSS 1 BG. SEG ID COUNT COMRT BSS 1 MAXIMUM RT COM LENGTH COMBG BSS 1 MAX BG COM LENGTH * DSKEY BSS 1 CURRENT KEYWORD DISK ADDRESS DSKID BSS 1 DISK ID SEGMENT ADDRESS KEYCN BSS 1 TOTAL KEYWORD COUNT KEYCT BSS 1 CURRENT KEYWORD COUNT * MLIST BSS 11 MEMORY MAP BUFFER * TEMP1 BSS 1 TEMP2 BSS 1 LWH1 BSS 1 LWH2 BSS 1 LWH3 BSS 1 LWH4 BSS 1 L01 BSS 1 * FSYBP BSS 1 FIRST WORD SYS BP LINKAGE SYSAD BSS 1 CURRENT ID SEGMENT ADDRESS * TBREL BSS 1 CURRENT BP RELOC ADDR PBREL BSS 1 INITIAL BP RELOC ADDR * RELAD BSS 1 CURRENT CORE RELOCATION ADDRESS * BSBAD BSS 1 BG SEGMENT BP RELOC ADDR BSPAD BSS 1 BG SEGMENT PROG RELOC ADDR * LFLAG BSS 1 PROGRAMS-LOADED FLAG IMAIN BSS 1 CURRENT MAIN IDENT INDEX. HDFLG BSS 1 HEADING FORMAT FLAG CIDNT BSS 1 CURRENT MAIN IDENT INDEX. * AEQT BSS 1 ADDRESS OF EQUIPMENT TABLE CEQT BSS 1 NO. ENTRIES IN EQUIPMENT TABLE * ASQT BSS 1 ADDR OF DEVICE REFERENCE TABLE CSQT BSS 1 NO. ENTRIES IN DEV. REF. TABLE * AINT BSS 1 ADDRESS OF INTERRUPT TABLE CINT BSS 1 NO. ENTRIES IN INTERRUPT TABLE * DSKIN BSS 1 DISK ADDR OF INT CODE RECORD INTCN BSS 1 RECORD COUNT OF INT CODE * CURIL BSS 1 CURRENT ILIST ADDRESS ILIST BSS 64 USER SYSTEM PROG IDENT ADDR LIST * IDSAV BSS 1 INDEX OF CURRENT IDENT. DSKMN BSS 1 INITIAL MAIN DISK ADDRESS BSSDP BSS 1 INITIAL DISK RES MAIN BSS DISP PRENT BSS 1 PRIMARY ENTRY POINT DBLAD BSS 1 CURRENT DBL ADDRESS REKEY BSS 1 INSTRUCTION TYPE BYTE INSCN BSS 1 INSTRUCTION TYPE COUNTER INSTrR BSS 1 CURRENT INSTRUCTION PAGNO BSS 1 CURRENT PAGE NO. OPRND BSS 1 CURRENT OPERAND PLGTH BSS 1 PROGRAM LENGTH DRT2 BSS 1 DISK DRT ENTRY ( SYSTEM) DRT3 BSS 1 AUX DISK DRT ENTRY LIBFG BSS 1 LDTYP BSS 1 SCH1 BSS 1 INDEX OF IDENT OF PGM TO BE SCHEDULED SCH3 BSS 1 ADDRESS OF CURRENT ID SEGMENT SCH4 BSS 1 ADDRESS OF THE SCHEDULED PGM ID SEG FGBGC BSS 1 BACKGROUND USING FG COMMON FLAG $LIBR BSS 1 INDEX OF $LIBR ENT $LIBX BSS 1 INDEX OF $LIBX ENT CUPRI BSS 1 * MEM1 BSS 1 MEM2 BSS 1 MEM3 BSS 1 MEM4 BSS 1 MEM5 BSS 1 MEM6 BSS 1 MEM7 BSS 1 MEM8 BSS 1 MEM9 BSS 1 MEM10 BSS 1 MEM11 BSS 1 MEM12 BSS 1 * IFZ ***** BEGIN DMS CODE ***** COMSZ BSS 1 #WORDS COMMON DECLARED FOR * CURRENT MAIN LPCOM BSS 1 LAST PAGE CONTAINING ANY COMMON FPSAM BSS 1 1ST PAGE CONTAINING S.A.M. FWSAM BSS 1 1ST WORD CONTAINING S.A.M. LPSYS BSS 1 LAST PAGE CONTAINING SYS OR LIB FPDSK BSS 1 1ST PAGE DISK PART AREA LOLNK BSS 1 LOW LINK FOR SSGA,LIB, OR SYS HILNK BSS 1 HI LINK USED BY MEM RES PRG BPINC BSS 1 CURR DIRECTION FOR BP LINK * ALLOCATION. +1=UP,-1=DOWN BPLMT BSS 1 WORD AFTER LAST WORD AVAIL * FOR BP LINK ALLOCATION TPMAX BSS 1 HWM FOR RELOCATION OF BG * MAINS AND SEGS MAXPT BSS 1 NUM PARTS. ALLOWED MAT. BSS 1 ADR OF LENGTH WORD * BEFORE MEM ALLOC TABLE (MAT) SSGA. BSS 1 FWA SSGA (LAST WORD SYS * OR LIB +1) FWMRP BSS 1 FWA MEM RES PROG AREA * (NEXT WORD AFTER COMMONS) MAP. BSS 1 PTR TO MEU RES MAP MPFT. BSS 1 PTR TO MPFT ****** END DMS CODE ****** XIF * SECTR BSS z*0 BOOTSTRAP BUFFER FORMAT * LBPSY BSS 1 LOWER SYSTEM BP ADDRESS UBPSY BSS 1 UPPER SYSTEM BP ADDRESS DSKBP BSS 1 SYS BP DISK ADDRESS * LRMAN BSS 1 MAIN RESIDENT LOWER ADDRESS URMAN BSS 1 MAIN RESIDENT UPPER ADDRESS DSKRR BSS 1 MAIN RESIDENT DISK ADDRESS * LBMAN BSS 1 MAIN BG LOWER ADDRESS UBMAN BSS 1 MAIN BG UPPER ADDRESS DSKBG BSS 1 MAIN BACKGROUND DISK ADDRESS * SYMAD BSS 1 AVAIL SYS MEM ADDR BGBND BSS 1 BACKGROUND BOUNDARY * DSKAV BSS 1 NEXT AVAILABLE DISK ADDRESS DSKLC BSS 1 DISK ADDRESS OF LIBRARY CODE DSKLB BSS 1 DISK ADDR OF LIBRARY ENTRY PTS DSKUT BSS 1 UTILITY PROG DISK ADDRESS DSKBS BSS 1 DISK ADDR OF MAIN BG DISK RES BP DSKBR BSS 1 CURRENT MAIN BG DISK RES DISK AD ADICT BSS 1 ADDR OF DISK DICTIONARY LBCNT BSS 1 RESIDENT LIBR ENTRY PT COUNT UTCNT BSS 1 UTILITY LIBRARY COUNT KEYAD BSS 1 CURRENT KEYWORD ADDRESS RTCAD BSS 1 RT COM CORE ADDRESS LBCAD BSS 1 LIBRARY CODE ADDRESS SYBAD BSS 1 ADDR OF FIRST BP LINK FOR BG IDSAD BSS 1 ADDR OF FIRST ID SEGMENT ABSID BSS 1 IDENT ADDR FOR NEXT BG SEG SCAN MAXRP BSS 1 MAXIMUM RT DISK RESIDENT PROG MAXRB BSS 1 MAXIMUM RT DISK RESIDENT BP IDMBS BSS 1 BG MAIN ADDRESS FOR BS REF * TB30 BSS 128 TRACK MAP TABLE #SUBC BSS 1 # SUBCHANNELS DEFINED(7905) SPC 4 ********************************************************* * * * END OF COMMON STORAGE BLOCK FOR ALL SEGMENTS. * * * ********************************************************* SPC 4 AILST DEF ILIST SKP * NOTE THE FOLLOWING RESOLVES ARITHMETIC DEF'S TO EXTERNALS * LABS LDA N2 GET LOOP COUNTER STA TEMP1 SAVE LDB LSTAA GET AD.DRESS OF LIST LOOP LDA B,I GET ADDRESS RSS LDA A,I RAL,CLE,SLA,ERA JMP *-2 STA B,I AND SAVE IT AGAIN INB ISZ TEMP1 JMP LOOP JMP SWRET RETURN TO MAIN * * LSTAA DEF *+1 ATBUF DEF TBUF ALBUF DEF LBUF SKP ERR23 ASC 1,23 INVALID FWA BP LINKAGE ADDRESS * * PROGRAM CONSTANT FACTORS N2 DEC -2 N5 DEC -5 N11 DEC -11 P2 DEC 2 P6 DEC 6 P7 DEC 7 P9 DEC 9 P10 DEC 10 P12 DEC 12 P15 DEC 15 P17 DEC 17 P22 DEC 22 P24 DEC 24 P28 DEC 28 P30 DEC 30 P31 DEC 31 P32 DEC 32 P192 DEC 192 L2000 OCT -2000 M7 EQU P7 M37 EQU P31 M77 OCT 77 M177 OCT 177 M2000 OCT 2000 * HLT0 HLT 0B MSIGN OCT 100000 UBLNK OCT 20000 D$STR DEF *+1 ASC 3,$STRT SKP * * LOAD ABSOLUTE SYSTEM * * THIS SEGMENT CONTROLS THE GENERATION OF * THE ABSOLUTE CODE FOR THE SYSTEM. EACH PROGRAM * IS LOADED BY TYPE AS FOLLOWS: * * (1) SYSTEM * (2) RESIDENT LIBRARY * (3) RT RESIDENTS * (4) RT DISK RESIDENTS * (5) BG RESIDENTS * (6) BG DISK RESIDENTS (AND BG SEGMENTS) * * EACH TYPE OF PROGRAM IS LOADED IN THE FOLLOWING MANNER: * * (1) THE IDENTIFICATION BLOCK FOR THE PROGRAM IS LOCATED * IN IDENT. A CALL TO LOAD IS EXECUTED TO LOAD THIS PROGRAM AND * ALL CALLED SUBROUTINES. IF THE PROGRAM IS DISK RESIDENT, * THE BASE PAGE SECTION OF CODE IS WRITTEN ON THE DISK * IMMEDIATELY AFTER THE MAIN SECTION OF CODE. IF THE * PROGRAM IS RT DISK RESIDENT, THE BOUNDARIES OF THE LARGEST * SECTION OF BASE PAGE AND PROGRAM ARE SAVED. IF THE PROGRAM IS * A USER PROGRAM (OTHER THAN SYSTEM USER PROGRAM) AN ID SEGMENT IS * GENERATED. FINALLY, THE BASE PAGE LINKAGE ADDRESSES ARE MADE * UNAVAILABLE TO SUBSEQUENT PROGRAMS IF THE PROGRAM IS DISK RESIDENT. * * THE ALLOCATION OF MEMORY TO THE SYSTEM IS GIVEN BELOW: * THE FREE MEMORY 2aIS REPORTED TO THE SYSTEM IN EQT1 TO EQT12 * WITH THE ODD NUMBERED ENTRIES BEING THE CORE ADDRESSES * AND THE EVEN NUMBERED ENTRIES BEING THE NUMBER OF WORDS. SKP ************************************************** * * * * * BG DISK RESIDENTS * * * ************************************************** * POSSIBLE SYSTEM AVAL MEM BLOCK * ************************************************** * BG RESIDENTS * * * * * ************************************************** * POSSIBLE SYSTEM AVAL MEM BLOCK * ************************************************** * BG COMMON * **************** BG BOUNDARY ********************* * * * POSSIBLE SYSTEM AVAL MEM BLOCK * ************************************************** * * * * * RT DISK RESIDENTS * * * ************************************************** * POSSIBLE SYSTEM AVAL MEM BLOCK * ************************************************** * * * RT RESIDENTS * * * ************************************************** * POSSIBLE SYSTEM AVAL MEM BLOCK * ************************************************** * RT COMMON * ***************** RT BOUNDARY ******************** * RESIDENT LIBRARY * ********************************************`,****** * POSSIBLE SYSTEM AVAL MEM BLOCK * ************************************************** * * * DISK ALLOCATION TABLE * * ID SEGMENTS * * KEYWORDS * * SYSTEM TABLES * * * ************************************************** * * * RT EXECUTIVE * * SYSTEM DRIVERS ETC. * * * ********************* 2000 *********************** * * * BASE PAGE LINKAGES * * * ************************************************** SKP * MEM AS SEEN MEM AS SEEN MEM AS SEEN MEM AS SEEN * BY SYSTEM BY ANY MEM BY DISC PROG BY DISC PROG * RES PROG USING COMMON NOT USING * OR SSGA COMMON OR * SSGA ************************************************************ 77777 * (MAX=77777) * ROM BOOT * (MAX=77777) * (MAX=77777) * * * DR BOOT * * * * * EXTENSION * * * * **************** * * 77500 * * (MAX=77477) * DISC RESIDENT* DISC RESIDENT* * * * PROGRAMS * PROGRAMS * * * * USING * NOT USING * * * MEMORY * COMMON OR * COMMON OR * * * RESIDENT * SSGA * SSGA * * * PROGRAMS * * * * SYSTEM * * * * * * (ALL MUST * (EACH HAS ~ * (EACH HAS * * AVAILABLE * FIT INTO * THIS SPACE * THIS SPACE * * * THIS SPACE) * AVAILABLE) * AVAILABLE) * * MEMORY * * * * * * * * * * (PHYSICALLY * * * * * AFTER MEM * * * * * RESIDENT * * * * * PROGRAMS) * * * * *-------------******************************* * * * * * * COMMON AREA * BACKGROUND COMMON AREA * * * IN SYSTEM * * * * MAP ONLY IF ******************************* * * USER SAID * * * * PRIV DRVRS * REAL-TIME COMMON AREA * * * ACCESS * * * * COMMON. ******************************* * * * * * * * SUBSYSTEM GLOBAL AREA * * * * * * ************************************************************ * MEMORY RESIDENT LIBRARY * ************************************************************ * * * REAL-TIME EXECUTIVE, DRIVERS, * * TABLES, ETC. * * * ************************************************************ 2000 * COMMUNICATION AREA, SYSTEM LINKS, RES LIBRARY LINKS * ************************************************************ * MEMORY RESIDENT PROGRAM * * * LINKS * DISC RESIDENT PROGRAM * ******************************  LINKS, ASCENDING FROM 2 * * TRAP CELLS * * ************************************************************ 0 * * RELOCATION IN A MAPPED RTE SYSTEM SKP * SET FWA BP LINKAGE FWENT JSB SPACE LDA P15 LDB MES27 MES27 = ADDR: FWA BP LINKAGE? JSB READ PRINT AND GET REPLY LDA P4 JSB GETOC GET 4 OCTAL DIGITS, CONVERT JMP LNKER INVALID DIGIT ENTERED JSB GETAL GET NEXT CHAR FROM LBUF SZA,RSS END OF BUFFER? JMP SETFB YES - SET FWA BP LINKAGE LNKER LDA ERR23 GET ERROR CODE FOR INVALID REPLY JSB GN.ER PRINT DIAGNOSTIC JMP FWENT REPEAT MESSAGE SETFB LDB OCTNO GET FWA BP SZB,RSS SKIP - VALID (NON-ZERO) FWA BP JMP LNKER REPEAT FWA BP LINKAGE INPUT STB FSYBP SET ADDR OF FIRST SYS LINK STB BPMAX INITILIZE TOP OF USED LINK POINTER JSB SPACE NEW LINE * * CLEAR LST WORD 5 JSB INLST INITIALIZE LST ADDRESSES CLLST JSB LSTX SET LST ADDRESSES JMP CLRID-1 CLEAR USAGE FLAGS CLA LDB .LST4,I GET TYPE ADB N5 IF SELF SSB,RSS DEFINING SKIP CLEAR STA .LST5,I CLEAR .LST WORD 5 LDA .LST3,I GET WORD 3 OF .LST ENTRY AND M7400 ISOLATE UPPER CHARACTER STA .LST3,I SET .LST WORD 3 WITH NO ORDINAL JMP CLLST CONTINUE CLEARING LST * * CLEAR PROGRAM USAGE FLAGS JSB INIDX INITIALIZE IDENT ADDRESSES CLRID JSB IDX SET IDENT ADDRESSES JMP IDCLR ALL IDENT FLAGS CLEAR LDA ID3,I GET USAGE FLAG AND M7400 SET FLAG = ZERO STA ID3,I SET CLEARED USAGE FLAG JMP CLRID CLEAR NEXT IDENT FLAG * CLEAR PAGE 1 FOR INDIRECT LINKS IDCLR LDA L2000 STA WDCNT O SET WORD COUNT = 2000(8) CLA LDB ADBP GET ADDRESS OF PSEUDO BASE PAGE CLRBP STA B,I CLEAR WORD IN BASE PAGE AREA INB INCR PAGE ADDRESS ISZ WDCNT SKIP - AREA CLEARED JMP CLRBP CONTINUE CLEARING SKP * * LOAD INITIALIZATION * IFN *** BEGIN NON-DMS CODE *** CLA STA RBTA CLEAR RELOCATION BASE TABLE. STA TPREL STA TPBRE STA COMAD+1 STA TBLNK INITILIZE THE LNKX STARTER STA LIBFG SET LIB FLAG TO SHOW NOT LIBRARY STA KEYCT STA RELAD CLEAR RELOCATION ADDR FOR LABDO STA COMAD CLEAR COMMON RELOC BASE STA PTYPE SET PROGRAM TYPE = SYSTEM STA URBP CLEAR UPPER RESIDENT BP BOUND STA LBBP CLEAR LOW BACKGROUND BP BOUND STA UBBP CLEAR HIGH BACKGROUND BP BOUND STA LRBP CLEAR LOW RESIDENT BP BOUND LDA FSYBP GET FIRST WORD AVAIL BP LINKAGE STA PBREL SET BP RELOC ADDRESS STA CUBP SET UP THE CURRENT BP VALUES ADA ADBP SET DUMMY IMAGE ADDRESS STA ICUBP AND LDA LWSBP THE UPPER LIMIT STA UCUBP OF BASE PAGE LDA CUBPA GET THE ADDRESS OF LAST LINKAGE ENTRY STA CPL2 AND SET LINK LST STA CPLS END MARKS LDA M2000 STA PPREL SET PROGRAM RELOC ADDR STA LRMAN SET LOWER RESIDENT MAIN ADDR STA URMAN SET CURRENT UPPER MAIN ADDRESS LDA DSKAB GET INITIAL ABSOLUTE DISK ADDR STA DSKAD SET CURRENT ABSOLUTE DISK ADDR STA DSKBP SET INITIAL BP ADDRESS * LDA M2000 GET UPPER ADDRESS OF BASE PAGE STA UBPSY SAVE UPPER BP DISK ADDRESS LDB P2 GET LOWER ADDRESS OF BASE PAGE STB LBPSY SAVE LOWER BP DISK ADDRESS JSB BPOUT OUTPUT RESIDENT BP CODE JSB DSKEV INSURE EVEN SECTOR ADDRESS STA DSKRR SET MAIN RESIDENGT DISK ADDRESS * JSB SYS SET UP THE SYSTEM LOAD PRAMS LDA M177 SET SEARCH MASK STA TYPMS TO PICK UP WHOLE TYPE **** END NON-DMS CODE **** XIF IFZ ***** BEGIN DMS CODE ***** * DISK LOAD INITIALIZATION * SPC 1 CLA STA RBTA CLEAR THE RELOCATION BASE TABLE STA TPREL STA TPBRE STA COMAD+1 STA RELAD STA TBLNK RESET THE LNKX STARTER STA LIBFG SET "NOT LOADING RES LIB" STA KEYCT STA COMAD RESET COMMON RELOC BASE SPC 1 STA PTYPE SET UP TO LOAD TYPE 0 PROGS SPC 1 STA MEM3 CLEAR THE MEMORY TABLE STA MEM4 STA MEM5 STA MEM7 STA MEM8 STA MEM9 STA MEM10 STA MEM11 SPC 1 * SET BOUNDS FOR BASE PAGE LINK SCANNING SPC 1 STA LRBP SHOW NO LINKS IN RESIDENT STA URBP BASE PAGE AREA STA LBBP OR IN BG RESIDENT STA UBBP BASE PAGE AREA SPC 1 STA LBMAN THESE THREE WORDS AREN'T USED STA UBMAN BUT MUST BE ZEROED BECAUSE STA DSKBG THEY'RE IN THE SEGMENT'S BSS AREA SPC 1 LDA FSYBP SET "CURRENT PROGRAM" SCAN AREA STA CUBP TO START AT FIRST LINK ADDR ADA ADBP ...AND SET ADDR OF RTGEN STA ICUBP IMAGE OF THE AREA SPC 1 LDA LWSBP CURRENT PROGS SCAN AREA ENDS AT STA UCUBP SYSTEM COMM AREA SPC 1 LDA CUBPA MARK CURRENT PAGE LINK STA CPL2 AREA EMPTY STA CPLS SPC 1 * SET RELOCATION ADDRESSES SPC 1 LDA M2000 STA PPREL SYSTEM RELOC BASE = 2000B STA LRMAN SAME FOR LOWER RES BOUND STA URMAN AND,CURRENTLY FOR UPPER RES BND SPC 1 * SET INITIAL DISK ADDRESSES NLHHN SPC 1 LDA DSKAB FIRST DISK ADDRESS STA DSKAD SET AS CURRENT STA DSKBP AND AS LOC OF BASE PAGE SPC 1 * STORE BASE PAGE ON DISK, JUST TO SAVE SPACE FOR IT SPC 1 LDA M2000 SET PARM AND SAVE STA UBPSY UPPER SYSTEM BP ADDR LDB P2 SET OTHER PARM AND STB LBPSY SAVE LOWER ADDR JSB BPOUT DUMP A BASE PAGE TO DISK SPC 1 * BUMP TO NEXT EVEN SECTOR AND SAVE ADDR SPC 1 JSB DSKEV ALIGN AT EVEN SECTOR STA DSKRR AND SAVE ADDR SYS ON DSK SPC 1 * SET UP LABDO CONTROL WORDS TO ACCESS SYSTEM AREA OF DISK SPC 1 JSB SYS SPC 1 * SET PROGRAM TYPE MASK TO LOOK AT WHOLE * TYPE FIELD WHEN SCANNING THROUGH IDENT LIST SPC 1 LDA M177 LOW SEVEN BITS STA TYPMS SPC 1 * SET BP LINK PARMS TO ALLOCATE TOP-DOWN FROM SYSTEM * COMMUNICATION AREA TO FIRST AVAILABLE LINK SPC 1 CCA STA BPINC SET INC= -1 SPC 1 ADA LWSBP SET FIRST LINK ADDR STA PBREL TO WORD BEFORE COMM AREA SPC 1 LDA FSYBP SET BP LINK ALLOCATION STA BPLMT LIMIT TO LOWEST WORD AVAILABLE SPC 1 LDA M2000 STA BPMAX RESET BP LINK HIGH WATER MARK ****** END DMS CODE ****** XIF SKP * * LOAD SYSTEM * LDA P6 LDB MES12 MES12 = ADDR: SYSTEM JSB SETHD PRINT HEADING, INITIALIZE IDX SYLD JSB IDSCN SCAN IDENTS JMP SYEND END OF IDENTS LDB ID3,I GET USAGE FLAG SLB,INB SKIP IF UNUSED JMP SYLD IGNORE USED PROGRAM * STB ID3,I SET WORD 3 WITH USAGE FLAG JSB LLOAD INITIATE AND LLOAD MAIN PROGRAM JSB INCAD UPDATE BP, PROG RELOC ADDR JMP SYLD PROCESS NEXT SYSTEM PROGRAM * SYEND JSB NOTST TEST FOR PROGRAMS LOADED JSB SPACE NEW LINE B JSB GENIO SET I/O TABLES LDA TBREL UPDATE THE BASE PAGE STA PBREL AND REPORT STA BPMAX JSB BPLNR THE CURRENT BP USAGE * * SET UP THE KEYWORD AREA * LDA DSKAD GET CURRENT ABSOLUTE DISK ADDR STA DSKEY SAVE DISK ADDR FOR KEYWORDS LDA PPREL GET CURRENT PROGRAM RELOC ADDR STA KEYAD SET CURRENT KEYWORD ADDRESS STA CURAK SET FOR ID SEG GEN TOO ADA KEYCN ADD TOTAL KEYWORD COUNT STA PPREL SET NEW RELOC ADDRESS FOR ID SEG STA SYSAD SET INITIAL ID SEGMENT ADDRESS STA IDSAD SET ADDR OF FIRST ID SEG STA CURAI SET ADDRESS FOR OUTID LDA KEYAD COMPUTE THE KEYWORD ADDRESS ADA LICNT FOR SHORT ADA SICNT BACKGROUND SEGMENT ID SEGMENTS STA SKEYA AND SET IT STA ASKEY ALSO FOR BLANK GENERATION * LDB IDSAD GET ADDRESS OF FIRST ID SEGMENT * ***** BEGIN NON-DMS CODE ***** * IFN LDA IDSP ANY RT MEM RES? SZA JMP ADIR YES, SO ADJUST LDA DSKSY ANY RT DISK RES? SZA JMP ADIR+1 YES, SO DON'T ADJUST XIF ***** END NON-DMS CODE ***** * LDA SICNT BUMP PAST PREFIX IF SZA MEM RES (SHORT ID) IS FIRST ADIR ADB #IREG THEN GET ITS DISC ADDR CLA BY WRITING WORD TO DISC. JSB LABDO * * SET UP ID SEGMENT AREA * CCA BACK UP TO ID-SEG START (AFTER ADA B PREFIX), AND MASK TO POSITION IN AND M77 SECTOR (MOD 640), THEN SAVE STA IDSP FOR BASE PAGE LATER. SPC 1 LDA DSKAD GET CURRENT DISK ADDRESS STA DSKID SET DISK ID ADDRESS STA DSKSY SET INITIAL ID SEGMENT DISK ADDR * * SAVE SPACE FOR ID SEGS,DISK DICT * LDA P22 BASE LEN OF ID SEG ADA #IREG PLUS OFFSET FOR IREG STORAGI1E MPY SICNT TIMES # OF SHORT ID'S TELLS * SPACE NEEDED. STA OCTNO SAVE COUNT LDA LICNT GET LONG ID SEGMENT COUNT MPY P28 ADJUST LENGTH FOR LONG ID SEG ADA OCTNO ADD THE SHORT COUNT ADA PPREL ADD THE BASE ADDRESS STA OCTNO SAVE THE ADDRESS ADA N11 COMPUTE THE KEY ADDRESS FOR FIRST STA SISDA BG SEG. ID SEGMENT AND SAVE LDA SSCNT RESERVE ROOM MPY P9 FOR THE BG SEG. ID SEGS ADA OCTNO COMPUTE NEW MEMORY ADDRESS IFZ ***** BEGIN DMS CODE ***** * LEAVE SPACE FOR MAT AND RESIDENT PROG MAP STA MAT. COMPUTE ADDR OF MAT STA OCTNO AND SAVE... LDA MAXPT MULTIPLY #PARTS BY MPY P6 #WORDS/ENTRY AND INA ADD 1 FOR A LENGTH WORD SPC 1 ADA OCTNO GET NEXT AVAIL MEM ADDR STA MAP. SAVE AS ADDR OF MR MAP ADA P32 ADD LENGTH OF MAP STA MPFT. THEN SAVE START ADDR OF MPFT ADA P5 ADVANCE PAST MPFT ****** END DMS CODE ****** XIF STA ADICT SAVE ADDR OF DISK DICTIONARY ADA DSIZE ADJUST FOR DISC DICT LENGTH ADA DAUXN + AUX DISC LENGTH IFN *** BEGIN NON-DMS CODE *** STA MEM1 SET ADDRESS OF FIRST FREE MEMORY AREA JSB CHBND CHANGE DEF MES52 ' LIB ADDRS' DEF LWASM THE SKY IS THE LIMIT, BUT.... STA MEM2 SAVE THE UPPER ADDRESS OF FREE AREA **** END NON-DMS CODE **** XIF STA PPREL SAVE NEW MAIN RELOCATION ADDRESS STA LBCAD SAVE LIBRARY CODE ADDRESS CCB RESERVE ALL THE SPACE SO FAR ADB A BY SENDING THE LAST WORD CLA JSB LABDO OUTPUT ZEROS CCA SET LIB FLAG TO SHOW LIB LOADING STA LIBFG SO ONLY TYPE 6 PROGRAMS WILL LOAD JSB CLRT6 GO CLEAR LOAD FLAGS FOR TYPE 6 PGMS * *  LOAD LIBRARY * LDA P14 SET TO GET RESIDENT LIB. ROUTINES STA PTYPE LDA P7 LDB MES13 MES13 = ADDR: LIBRARY JSB SETHD PRINT HEADING, INITIALIZE IDX LDLB JSB IDSCN SCAN IDENTS JMP LBEND END OF IDENTS LDB ID3,I GET USAGE FLAG SLB,INB SKIP IF UNUSED LIBRARY ROUTINE JMP LDLB IGNORE USED PROGRAM * LDA P14 IF THIS IS A FOURCE LOAD CPA PTYPE THEN STB ID3,I SET THE LOADED FLAG JSB LLOAD INITIATE AND LLOAD MAIN PROGRAM JSB INCAD UPDATE BP, PROG RELOC ADDR JMP LDLB PROCESS NEXT LIBRARY PROGRAM IFN *** BEGIN NON-DMS CODE *** LBEND LDA PTYPE WAS LIB LOAD FOR CPA P4 BACKGROUND RES? JMP COMTS YES; DONE * LDB P4 SET UP FOR NEXT SCAN CPA P14 IF CURRENT WAS FOURCE LOAD CLB,INB DO FG RES ELSE DO BG RES STB PTYPE NO; SET FOR NEXT SCAN LDA M7 RESET SCAN MASK STA TYPMS FOR LEAST BITS ONLY LDA P10 RESET IDX STA CIDNT TO START OF LIST (OFFSET=10) JMP LDLB GO CHECK FOR BACKGROUND RES LIB SPC 1 COMTS CLA CLEAR LIB LOAD FLAG STA LIBFG JSB SPACE JSB DEMTL DEMOT UN CALLED TYPE 6 TO TYPE 7 JSB NOTST TEST FOR PROGRAMS LOADED JSB SPACE NEW LINE LDA PPREL GET CURRENT PROG RELOCATION BASE STA RTCAD SAVE RT LOAD ADDRESS CMA,INA COMPUTE MAX ALLOWABLE ANSWER ADA LWASM AND STA TEMP2 SET FOR CALL LDA COMRT GET CURRENT COMMON SIZE JSB CHBND CHANGE COMMON SIZE? DEF MES53 MESSAGE ADDRESS DEF TEMP2 UPPER LIMIT STA COMRT SET NEW COMMON SIZE SZA,RSS SKIP IF NON-ZERO JMP COMRZ IGNORE ZERO COMMON * * PUT OUT HALTS FOR RT COMMON * LDA PPREL GET CURRENT PROG RELbOC ADDR STA RELAD SET CURRENT RELOCATION ADDRESS LDB MES14+1 GET MESSAGE ADDRESS JSB CONVD CONVERT TO DECIMAL IN MESSAGE LDA P16 LDB MES14 MES14 = ADDR: RT COM JSB DRKEY PRINT LISTING JSB SPACE NEW LINE LDB COMRT GET RT COM LENGTH CMB,INB STB TCNT SET RT COM LENGTH LDB PPREL GET THE ADDRESS OF COMMON FGCOM LDA HLT0 GET HALT CODE FOR RT COM JSB LABDO OUTPUT HALT CODE FOR COMMON ISZ TCNT SKIP - RT COM FILLED WITH HALTS JMP FGCOM CONTINUE FILLING RT COMMON * STB PPREL SET NEW CORE ADDRESS COMRZ CLA,INA STA PTYPE SET PROGRAM TYPE = RT RESIDENT LDA PPREL GET RT RESIDENT BOUND STA MEM3 SAVE LOWER BOUND OF FREE AREA JSB CHBND CHANGE IT? DEF MES54 DEF LWASM ADDRESS OF UPPER LIMIT STA MEM4 SAVE UPPER LIMIT OF FREE AREA STA PPREL SET NEW ADDRESS CLA CLEAR THE FIX UP LIST STA PFIX UNDEFINES ARE LOST HERE * LDA FGBGC DO FG PROGRAMS REFER SZA,RSS TO BG COMMON? JMP RRLDD NO- SKIP QUESTION * LDA PPREL YES ASK FOR THE BG JSB CHBND BOUNDRY DEF MES56 NOW SO WE DEF LWASM KNOW WHERE COMMON STA BGBND IS. **** END NON-DMS CODE **** XIF IFZ ***** BEGIN DMS CODE ***** LBEND CLA,INA DID WE FINISH LOADING LIB FOR CPA PTYPE RESIDENT?? JMP COMTS YES, CONTINUE...... STA PTYPE NO, SET UP LDA M7 THE SCAN STA TYPMS MASK LDA P10 AND RESET STA CIDNT THE LST POINTERS JMP LDLB AND RESTART SPC 1 COMTS EQU * JSB NOTST PRINT "NONE" IF NO LIB JSB SPACE SKIP A LINE SPC 1 * * LOAD SUBSYSTEM GLOBAL MODULES * SPC 1 SSGA1 JSB SPACE LDA M177 SET TYPEy MASK FOR IDSCN STA TYPMS TO LOOK AT WHOLE TYPE LDA P30 SET TO SCAN FOR TYPE O/ STA PTYPE MODULES (SSGA MODULES) LDA MS31L PASS MSG LNTH LDB MS31. AND ADDRESS JSB SETHD TO HEADER ROUTINE SPC 1 LDA PPREL STA SSGA. SET START ADDR OF SSGA SPC 1 * FIND SSGA MODULES AND LOAD * (NOTE THAT WE ARE STILL LOADING AS IF LOADING THE * LIBRARY.....LINKS ARE STILL DESCENDING IN BASE PAGE) SPC 1 SSGA2 JSB IDSCN FIND NEXT TYPE 30 JMP SSGA3 (NO MORE,EXIT) LDA ID3,I PICK UP USE FLAG CLB,INB IOR B SET LOADED BIT STA ID3,I AND RESTORE JSB LLOAD LLOAD THE MODULE JSB INCAD UPDATE RELOC BASES JMP SSGA2 THEN GO FIND NEXT MODULE SPC 1 MS31. DEF *+1 ASC 12,SUBSYSTEM GLOBAL MODULES MS31L EQU P24 SPC 1 SSGA3 EQU * SPC 1 * CLEAN UP AFTER LOADING LIBRARY AND SSGA MODULES SPC 1 CCA GET LAST WORD ADDR ADA SSGA. OF SYSTEM LSR 10 AND ISOLATE AND M77 PAGE NUMBER. STA LPSYS SAVE LAST PAGE ADDR OF SYSTEM SPC 1 CLA CLEAR THE STA LIBFG "LIBRARY LOADING" FLAG LDA PBREL SET THE ADDRESS INA OF THE LOWEST STA LOLNK LINK USED BY THE SYSTEM SPC 1 JSB DEMTL DEMOTE UNCALLED TYPE 6 TO 7 JSB NOTST ANY PROGS LOADED?? JSB SPACE SKIP A LINE SPC 1 * SET UP COMMON AREAS....START WITH REAL TIME SPC 1 LDA PPREL COMPUTE MAX SIZE FOR STA RTCAD RT COM BY SUBTRACTING CMA,INA CURRENT LOCATION FROM ADA LWASM LAST AVAILABLE STA TEMP2 SAVE AS A LIMIT SPC 1 LDA COMRT ASK IF HE WANTS TO CMA JSB CHBND CHANGE DEF MES53 SIZE DEF TEMP2 AND THEN  STA COMRT STORE NEW SIZE SPC 1 LDA RTCAD LOAD START ADDR OF RT COM LDB MES14+1 JSB CONVD STUFF IN MESSAGE LDA P16 LDB MES14 JSB DRKEY AND PRINT IT JSB SPACE SPC 1 * NOW ASK ABOUT BG COMMON SPC 1 LDA COMRT SAVE BASE OF RT COMMON ADA PPREL AND STA BGBND COMPUTE AND CMA,INA SAVE MAX ADA LWASM ALLOWABLE STA TEMP2 COMMON SIZE SPC 1 LDA COMBG DISPLAY REQUIRED CMA JSB CHBND SIZE OF COMMON DEF MES57 AND ASK DEF TEMP2 TO CHANGE STA COMBG SPC 1 LDA BGBND LOAD START ADDR OF BG COMMON LDB MES18+1 JSB CONVD STUFF IN MESSAGE LDA P16 LDB MES18 AND DISPLAY JSB DRKEY JSB SPACE SPC 1 * NOW ASK ABOUT ALIGNING LWA OF BG COMMON SPC 1 CCA ADA BGBND ADA COMBG GET LWA COMMON LDB MSBGX POINT TO MESSAGE JSB ALIGN AND ASK FOR CHANGE DEF MSBG LDB A SAVE NEXT ADDR AFTER COMMON INB AS FIRST ADDR IN MEM RES STB FWMRP PROGRAM AREA LSR 10 THEN SHIFT TO GET LAST PAGE AND M37 CONTAINING COMMON STA LPCOM AND SAVE FOR LATER SPC 1 * IF MEM RES BOUND WAS CHANGED, EXTRA WORDS ARE * ADDED TO THE BG COMMON AREA SPC 1 LDA FWMRP LDB BGBND ADD ANY EXTRA WORDS CMB,INB INTO THE ADA B BACKGROUND STA COMBG COMMON AREA SPC 1 * WRITE HALTS ON DISK FROM (RTCAD) THRU (FWMRP-1) SPC 1 LDA COMRT ADA COMBG GET TOTAL COMMON SIZE SZA,RSS JMP COMEX JUMP OUT IF NO COMMON SPC 1 CMA,INA STA TCNT SET LOOP COUNTER TO -LENGTH OF COMMON LDB PPREL WTCOM LDA HLT0 WRITE ONE JSB LABDO HALT AT ISZ TCNT A TIME JMP WTCOM TILL DONE SPC 1 STB PPREL THEN UPDATE RELOC BASE SPC 1 COMEX EQU * SPC 1 * * INITIALIZE FOR MEMORY RESIDENT PROGRAM LOADING * SPC 1 LDA M7 SET IDENT SCAN MASK TO STA TYPMS CHECK PRIMARY BITS ONLY. CLA,INA SET UP TO SCAN FOR STA PTYPE TYPE 1 PROGRAMS CLA CLEAR FIX-UP LIST...ALL STA PFIX REMAINING UNDEFS ARE LOST. SPC 1 * SET FOR BOTTOM-UP LINK ALLOCATION SPC 1 CLA STA BPMAX RESET HIGHWATERMARK * FOR BP LINK ALLOCATION CLA,INA INDICATE ASCENDING STA BPINC ALLOCATION OF LINKS SPC 1 LDA LOLNK UPPER LIMIT FOR MEM RES LINKS STA BPLMT IS LOW SYSTEM LINK SPC 1 LDA FSYBP AND LOWER LIMIT IS STA PBREL FIRST ALLOWED BY USER SPC 1 * RESET LINK AREA POINTERS * RESET CP LINK AREA POINTERS SPC 1 LDA CUBPA STA CPL2 LAST CP AREA=LAST BP AREA STA CPLS LAST "SAVE" CP AREA=LAST BP AREA ****** END DMS CODE ****** XIF SKP * * LOAD RT RESIDENTS * RRLDD EQU * IFZ ***** BEGIN DMS CODE ***** LDA P16 ****** END DMS CODE ****** XIF IFN *** BEGIN NON-DMS CODE *** LDA P12 **** END NON-DMS CODE **** XIF LDB MES15 MES15 = ADDR: RT RESIDENTS JSB SETHD PRINT HEADING, INITIALIZE IDX RRLD JSB IDSCN SCAN IDENTS JMP RREND END OF IDENTS SEZ,RSS SKIP IF MAIN JMP RRLD IGNORE SUB LDB ID3,I GET USAGE FLAG SLB,INB SKIP - PROGRAM NOT LOADED JMP RRLD IGNORE LOADED PROGRAM STB ID3,I SET NEW USAGE FLAG JSB LLOAD INITIATE AND LLOAD MAIN PROGRAM CLA JSB GENID GENERATE ID SEtGMENT, KEYWORD IFZ ***** BEGIN DMS CODE ***** CLA NO PARTITION REQMT CCB ADB TIDNT IDENT INDEX (TIDNT POINTS TO NEXT ENTRY) JSB IDFIX GO SET MEM PROTECT INDEX ****** END DMS CODE ****** XIF JSB INCAD UPDATE BP, PROG RELOC ADDR JMP RRLD PROCESS NEXT RT RESIDENT * RREND JSB NOTST TEST FOR PROGRAMS LOADED JSB SPACE NEW LINE LDA PPREL GET CURRENT PROG RELOCATION BASE STA URMAN SET UPPER RESIDENT MAIN ADDR IFN *** BEGIN NON-DMS CODE *** STA MEM5 SAVE LOW BOUND OF POTENTIAL FREE AREA **** END NON-DMS CODE **** XIF * CMA,INA CHECK FOR MEMORY OVERFLOW ADA M7747 PAST 77500 SSA,RSS JMP $STRT * LDA ERR18 SEND ERROR DIAGNOSTIC JSB IRERR AND ABORT * M7747 OCT 77477 * $STRT JSB CCPLK PACK THE CURRENT PAGE LINKAGE AREA JSB BPDSA OUTPUT REMAINDER OF RECORD * * SCAN LST FOR INITIAL ENTRY POINT * LDB D$STR GET ADDRESS OF STRT JSB LSTS SCAN LST FOR IT JSB ABORT START NOT FOUND IN LST LDB ADBP GET ADDR FOR JMP,I START ADB P2 ADJUST LDA JMP3I GET JMP 3,I CODE STA B,I SET JMP 3,I IN BP LOCATION INB INCR CURRENT BP ADDRESS LDA .LST5,I GET CORE ADDRESS FOR START STA B,I SET ADDR OF START IN BP LOCATION IFZ ***** BEGIN DMS CODE ***** * * DUMP LOW PART OF BASE PAGE TO DISK. DISK RESIDENT PROGRAMS * CAN'T SEE (OR SHARE) ANY WORDS BELOW LOLNK (LOWEST SYSTEM LINK) * ANYHOW, SO THEY ARE NOT NEEDED IN THE GENERATOR ANY LONGER. * WE NEED THE AREA THEY OCCUPY IN THE BASE PAGE IMAGE FOR THE * DISK PROGRAM LINKS. * SPC 1 LDA DSKAD STA TEMP4 SAVE THE CURRENT DISK ADDR LDA DSKBP STA DSKAD BACK UP DISK TO START OF *  SYSTEM BASE PAGE SPC 1 LDB P2 START AT LOW ADDRESS LDA LOLNK AND CONTINUE UP TO SYS LNKS JSB BPOUT AND WRITE WHAT WE'VE GOT SPC 1 LDA TEMP4 RESTORE THE PREVIOUS DISK STA DSKAD ADDRESS. SPC 1 * INITIALIZE FOR REAL TIME DISK RESIDENT LOADING SPC 1 CLA STA MAXRP STA MAXRB LDA P2 STA PTYPE SET TO FIND TYPE 1 PROGS SPC 1 LDA LOLNK SET LOW SYS OR LIB OR SSGA LNK STA LRBP AS LOWEST RES LINK ADA ADBP AND SAVE ITS IMAGE ADDR STA IRBP LDA LWSBP SET LAST LINK BEFORE COMM AREA STA URBP (+1) AS LAST RES LINK SPC 1 * SET BPLINK SCAN AREA FOR CURRENT PROGRAM AND BOUNDS * FOR BP LINK ALLOCATION. NOTE THAT THAT BP LINK ALLOCATION * REMAINS SET IN THE "UPWARD" DIRECTION FROM MEM RESIDENT * LOADING, AND LIMIT IS STILL LOLNK. SPC 1 LDA P2 SET LOWEST DISK LINK STA PBREL STARTING AT 2 STA CUBP ADA ADBP AND SAVE ITS IMAGE STA ICUBP ADDRESS. LDA LOLNK SET UPPER DISK LINK AS STA UCUBP BELOW SYS,LIB, AND SSGA LNKS * CLEAR BASE PAGE IMAGE OF MEMORY RESIDENT PROGRAM LINKS SPC 1 LDA PBREL START CLEAR AT 2 LDB LOLNK AND END 1 BEFORE LOW SYS LINK JSB CLRLT AND GO DO IT SPC 1 * RESET CP LINK AREA POINTERS TO "EMPTY" SPC 1 LDA CUBPA STA CPL2 LAST CP AREA=LAST BP AREA STA CPLS LAST "SAVE" CP AREA=LAST BP AREA SPC 1 * UPDATE "LAST WORD OF MEMORY" ADDR - DON'T NEED TO LEAVE ROOM * FOR THE 64 WORD BOOT IN A DISK PARTITION SPC 1 LDA LWASM TAKE CURRENT LAST WORD ADA P192 ADD BOOT SIZE STA LWASM AND RESTORE ****** END DMS CODE ****** XIF IFN *** BEGIN NON-DMS CODE *** CLA STA MAXRP CLEAR MAX RT DISK RES PROG LGTH STA MAXRB CLEAR MAX RT DISK RES BP LENGTH ISZ PTYPE SET PROGRAM TYPE = RT DISK RES LDA CUBP SET UP THE STA LRBP BP AREA POINTERS ADA ADBP ADD THE DUMMY BASE PAGE ADDRESS STA IRBP AND SET THE BASE DUMMY ADDRESS LDA TBREL NOW THE NEW STA CUBP USER AREA STA URBP SET THE TOP OF THE RES. AREA ADA ADBP (ALL THE REST) STA ICUBP * LDA MEM5 GET THE CURRENT DR AREA ADDRESS JSB CHBND ASK IF IT'S TO BE CHANGED DEF MES55 DEF LWASM STA MEM6 SAVE THE UPPER FREE AREA LIMIT STA PPREL AND THE CURRENT ADDRESS JSB CCPLK PACK THE CP LINK AREA LDA CPL2 SAVE LAST ADDRESS STA CPLS OF CP IMAGE **** END NON-DMS CODE **** XIF SKP * * LOAD RT DISK RESIDENTS * LDA P17 LDB MES16 MES16 = ADDR: RT DISK RESIDENTS JSB SETHD PRINT HEADINGS, INITIALIZE IDX RDLD JSB DSKEV START DISK RESIDENTS ON EVEN SECTOR CLA KILL ANY LEFT OVER STA PFIX FIX UP ENTRYS JSB IDSCN SCAN IDENTS JMP RDEND END OF IDENTS SEZ,RSS SKIP IF MAIN JMP RDLD IGNORE SUBS LDB ID3,I GET USAGE FLAG SLB,INB SKIP - PROGRAM NOT LOADED JMP RDLD IGNORE LOADED PROGRAM STB ID3,I SET NEW USAGE FLAG IFZ ***** BEGIN DMS CODE ***** * * SAVE IDENT POINTER AND SET RELOC BASE DEPENDING * ON USE OF COMMON OR SSGA. * CCA ADA TIDNT SAVE IDENT INDEX STA IDSAV JSB SETRB SET RELOC BASE ****** END DMS CODE ****** XIF JSB USERS SET UP TO OUTPUT USER CODE JSB LLOAD INITIATE AND LLOAD MAIN PROGRAM LDA CPLS BACK UP THE CP LINK STA CPL2 BOTTOM JSB SYS RESET TO OUTPUT SYSTEM CODE CCA JSB GENID GENERATE ID SEGM4(ENT, KEYWORD IFN *** BEGIN NON-DMS CODE *** LDA PPREL GET PROG RELOC ADDR CMA,INA ADA TPREL SET A = PROG LENGTH LDB MAXRP GET PREVIOUS MAX PROG LENGTH CMB,INB ADB A SET B = PROG LENGTH - MAX LENGTH SSB,RSS SKIP IF NO NEW MAXIMUM STA MAXRP SET NEW MAX PROG LENGTH LDA PBREL GET BP RELOC ADDR CMA,INA ADA TBREL SET A = BP LENGTH LDB MAXRB GET PREVIOUS MAX BP LENGTH CMB,INB ADB A SET B = BP LENGTH - MAX LENGTH SSB,RSS SKIP IF NO NEW MAXIMUM STA MAXRB SET NEW MAX BP LENGTH **** END NON-DMS CODE **** XIF JSB BPDSA OUTPUT REMAINING OF ABS REC LDA TBREL GET UPPER BP ADDRESS LDB PBREL GET LOWER BP ADDRESS JSB BPOUT OUTPUT BP SECTION LDA PBREL GET LOWER RT DISK RES BP ADDR LDB TBREL GET UPPER BOUND BP ADDRESS JSB CLRLT CLEAR LOCAL BP LINKS IFZ ***** BEGIN DMS CODE ***** * * ALSO SET NEW FIELDS (WORD 22) IN ID-SEG. * LDA TPREL PASS START LOC LDB PPREL AND END LOC + 1 JSB PGREQ TO PAGE REQ ROUTINE * (RETURNS A=#PAGES) LDB IDSAV GET IDENT INDEX JSB IDFIX AND FIX WORD 22 IN IDSEG ****** END DMS CODE ****** XIF JMP RDLD PROCESS NEXT RT DISK RESIDENT * * TEMP4 BSS 1 RDEND EQU * JSB NOTST PRINT "NONE" IF NO RT DR'S JSB SPACE IFN *** BEGIN NON-DMS CODE *** LDA BPMAX GET CURRENT BP ADDRESS JSB CHBND ASK FOR NEW ONE DEF MS02 DEF LWSBP UPPER LIMIT = 1650 STA SYBAD SET NEW BP ADDRESS STA BPMAX AND NEW UPPER LIMIT ADA M1 SET THE LAST LINK ADDRESS STA URBP1 FOR FORGROUND * LDB FGBGC CHECK IF WE ALREADY LDA BGBND HAVE THE BACKGROUND BOUNDRY SZB,RSS LDA LW2NLHASM NO THE SKY IS THE LIMIT STA TEMP2 SET UPPER LIMIT OF SYS MEMORY oN* LDA PPREL GET PROG RELOC ADDRESS ADA MAXRP ADD MAX. DR PROG. LENGTH JSB CHBND ASK IF WE ARE TO CHANGE IT DEF MES60 DEF TEMP2 STA SYMAD SET SYSTEM AVAIL MEM ADDRESS STA MEM7 SET LOWER BOUND OF FREE MEM. * LDA BGBND GET CURRENT BG BOUND IN CASE LDB FGBGC DO WE HAVE ONE? SZB JMP BGSET YES GO SET IT UP * LDA MEM7 GET LOWER BOUND OF FREE AREA JSB CHBND ASK FOR NEW ONE DEF MES56 DEF LWASM SKY IS THE LIMIT BGSET STA MEM8 SAVE THE UPPER LIMIT OF THE FREE AREA STA BGBND SET THE BACKGROUND BOUNDRY STA RELAD AND THE RELOCATION ADDRESS STA LBMAN AND A FEW STA PPREL MORE GOODIES CMA,INA COMPUTE ADA LWASM THE MAX COMMON STA TEMP2 SIZE AND SAVE IT SKP * * GET BG BOUNDARY * LDA DSKAD GET DISK ADDRESS STA DSKBG SAVE ADDRESS OF BG CODE LDA SYBAD GET CURRENT BG BP ADDRESS STA PBREL SET BP RELOCATION ADDRESS STA LBBP SET LOW BG BP ADDRESS STA UBBP SET UPPER BASE PAGE TO SAME STA TBREL SET RELOCATION BASE STA CUBP ALSO SET UP CURRENT BASE PAGE ADA ADBP COMPUT IMAGE ADDRESS STA IBBP SET IMAGE ADDRESS STA ICUBP FOR BOTH AREAS * JSB USERS SET UP THE USERS MAP FOR BG CORE RES LDA COMBG CHECK FOR A LARGER JSB CHBND COMMON FOR DEF MES57 BACKGROUND DEF TEMP2 STA COMBG SET THE NEW COMMON SIZE SZA,RSS SKIP IF BACKGROUND COMMON JMP RICLR IGNORE ZERO COMMON * * FILL BG COMMON WITH HALTS * LDB MES18+1 GET ADDRESS OF MESSAGE JSB CONVD CONVERT TO OCTAL/DECIMAL LDA P16 LDB MES18 GET MESSAGE ADDRESS JSB DRKEY PRINT BACKGROUND COMMON LISTING JSB SPACE NEW LINEj LDB COMBG GET BG COM LENGTH CMB,INB STB TCNT SET COMMON LENGTH LDB PPREL GET ADDRESS OF BG COMMON BGCOM LDA HLT0 GET HALT CODE JSB LABDO OUTPUT HALT CODE FOR COMMON ISZ TCNT SKIP - BG COM FILLED WITH HALTS JMP BGCOM CONTINUE FILLING BG COMMON * STB PPREL SET NEW ADDRESS RICLR LDA P4 STA PTYPE SET PROGRAM TYPE = BG RESIDENT LDA PPREL GET CURRENT BG RESIDENT ADDRESS STA MEM9 SAVE FOR FREE MEMORY LIST JSB CHBND CHANGE IT? DEF MES58 DEF LWASM STA PPREL SET NEW ADDRESS STA MEM10 AND UPPER BOUND OF FREE AREA SKP * * LOAD BG RESIDENTS * LDA P12 LDB MES19 MES19 = ADDR: BG RESIDENTS JSB SETHD PRINT HEADING, INITIALIZE IDX BRLD JSB IDSCN SCAN IDENTS JMP BREND END OF IDENTS SEZ,RSS SKIP IF MAIN JMP BRLD IGNORE SUBS LDB ID3,I GET USAGE FLAG SLB,INB SKIP - PROGRAM NOT LOADED JMP BRLD IGNORE LOADED PROGRAM STB ID3,I SET NEW USAGE FLAG JSB USER SET USER MAP JSB LLOAD INITIATE AND LLOAD MAIN PROGRAM JSB SYS SET SYSTEM MAP AGAIN JSB INCAD INCR RELOCATION ADDRESSES CLA JSB GENID GENERATE ID SEGMENT, KEYWORD JMP BRLD PROCESS NEXT BG RESIDENT * BREND JSB NOTST TEST FOR PROGRAMS LOADED JSB SPACE NEW LINE JSB BPDSA OUTPUT REMAINDER OF ABS REC LDA CUBPA SET THE LOWER LIMIT TO STA CPLS FLUSH WHAT WE HAVE PASSED LDA PPREL GET CURRENT PROGRAM RELOC BASE STA UBMAN SAVE UPPER BG MAIN ADDRESS STA MEM11 SAVE THE LOWER BOUND OF THE FREE JSB CHBND AREA AND ASK FOR BG DISC BOUND DEF MES59 DEF LWASM STA MEM12 SAVE THE HIGH BOUND STA PPREL AND THE NEW RELOCATION ADDRESS JSB CCPLK zPACK THE CURRENT PAGE AREA LDA TBREL GET CURRENT BP ADDRESS STA UBBP SET UPPER BACKGROUND BP BOUND STA CUBP SET CURRENT BP ADDRESS ADA ADBP AND ITS IMAGE STA ICUBP ADDRESS LDA CPL2 GET THE CP LINK IMAGE STA CPLS ADDRESS AND SAVE IT STA CPLSB ALSO FOR AFTER SEGMENTS **** END NON-DMS CODE **** XIF ***** BEGIN DMS CODE ***** IFZ LDA CUBPA RESET POINTERS TO STA CPL2 HIGH CP LINK AREA, STA CPLS HIGHEST AREA TO BE SAVED IN PACK, STA CPLSB AND CPLS FOR B.S. LOADING. XIF ****** END DMS CODE ****** SKP * * LOAD BG DISK RESIDENTS * LDA P3 SET PROGRAM TYPE AS STA PTYPE BG DISK RESIDENT LDA P17 LDB MES20 MES20 = ADDR: BG DISK RESIDENTS JSB SETHD PRINT HEADING INITIALIZE IDX BDLD JSB DSKEV LOAD DISC RESIDENTS ON EVEN SECTOR CLA KILL ANY LEFT OVER FIX UPS STA TFIX JSB IDSCN SCAN IDENTS JMP BDEND END OF IDENTS SEZ,RSS SKIP IF MAIN JMP BDLD IGNORE SUBS LDB ID3,I GET USAGE FLAG SLB,INB SKIP - PROGRAM NOT LOADED JMP BDLD IGNORE LOADED PROGRAM STB ID3,I SET NEW USAGE FLAG CCA ADA TIDNT GET CURRENT MAIN IDENT INDEX STA IDSAV SAVE MAIN IDENT INDEX FOR BS REF IFZ ***** BEGIN DMS CODE ***** JSB SETRB SET UP RELOC BASE ****** END DMS CODE ****** XIF JSB USERS SET UP A NEW USER JSB LLOAD INITIATE AND LLOAD MAIN PROGRAM JSB SYS RESET TO SYSTEM MAP CCA JSB GENID GENERATE ID SEGMENT, KEYWORD JSB BPDSA OUTPUT REMAINDER OF RECORD LDA DSKAD GET CURRENT DISK ADDRESS STA DSKBS SAVE DISK ADDR OF BP SECTION LDA TBREL GET UPPER BP ADDRESS LDB PBREL GET LOWER BP ADDRESS JSB BPOUT OUTPUT BP SECTION LDA TPREL GET CURRENT PROG RELOC ADDR STA BSPAD SAVE PROG RELOC ADDR FOR BS IFZ ***** BEGIN DMS CODE ***** STA TPMAX SET HWM FOR MAIN ****** END DMS CODE ****** XIF JSB CCPLK PACK THE CP LINK AREA LDA CPL2 UP DATE STA CPLS THE LOW SAVE ADDRESS LDA TBREL GET CURRENT BP RELOC ADDR STA BSBAD SAVE BP RELOC ADDR FOR BS LDA P5 STA PTYPE SET TYPE = BG SEGMENT JSB INIDX INITIALIZE IDX BSLD JSB IDX SET IDENT ADDRESSES JMP BSEND END OF IDENTS CCA ADA TIDNT GET CURRENT MAIN IDENT INDEX STA IMAIN SAVE MAIN BS IDENT INDEX LDA ID6,I GET TYPE SSA,RSS SKIP IF MAIN BG SEGMENT JMP BSLD IGNORE SUBS AND M7 ISOLATE TYPE CPA P5 TYPE = BG SEGMENT? RSS YES - CONTINUE JMP BSLD NO - IGNORE IDENT LDA ID8,I GET BS MAIN IDENT INDEX CPA IDSAV BS CALLS THIS BG MAIN? RSS YES - CONTINUE JMP BSLD NO - IGNORE BACKGROUND SEGMENT LDA TIDNT GET NEXT IDENT INDEX STA ABSID SAVE INDX FOR NEXT BG SEG SCAN CCB STB HDFLG SET HEADING FLAG FOR BG SEGMENT JSB DSKEV SET FOR EVEN SECTOR JSB SEGS SET UP A NEW USER AREA LDA BSPAD RESET THE LDB ABCOR STA B,I BASE CORE ADDRESSES FOR LDB MXABC STA B,I A SEGMENT LOAD JSB LOADS LOAD BG SEGMENT LDA CPLS RESET THE CP LINK STA CPL2 BOTTOM JSB SYS RESET TO SYSTEM MAP JSB SPACE NEW LINE CCA JSB GNSID GENERATE ID SEGMENT, KEYWORD JSB BPDSA OUTPUT REMAINING OF ABS REC IFZ ***** BEGIN DMS CODE ***** LDB TPREL SUBTRACT SEG'S HIGH ADDR LDA B FROM PREV MAX CMA,INA HIGH ADDR ADA TPMAX JSSA IF NEW IS HIGHER STB TPMAX THEN STORE AS MAX ****** END DMS CODE ****** XIF LDA TBREL GET UPPER BP ADDRESS LDB BSBAD GET LOWER BS BP ADDRESS JSB BPOUT OUTPUT BP SECTION LDA BSBAD GET BS BP RELOC ADDR LDB TBREL GET UPPER BOUND BP ADDRESS JSB CLRLT CLEAR BP LINKAGES LDA BSBAD GET BS BP RELOC ADDRESS STA TBREL SET BP RELOC ADDR LDA BSPAD GET BS PROG RELOC ADDRESS STA TPREL SET PROG RELOC ADDR LDA ABSID GET NEXT BG SEG IDENT INDEX STA TIDNT SET IDENT INDEX FOR IDX JMP BSLD LOAD NEXT BG SEGMENT * BSEND EQU * IFZ ***** BEGIN DMS CODE ***** * * FIX ID SEGMENT * LDA TPMAX PASS MAX HIGH ADDR LDB PPREL AND LOW ADDR, THEN JSB PGREQ PRINT PAGES AND SET A-REG LDB IDSAV PASS PAGE REQMT & IDENT JSB IDFIX INDEX THEN FIX iD SEG. ****** END DMS CODE ****** XIF LDA DSKAD GET CURRENT DISK ADDRESS STA DSKBR SAVE CURRENT DISK ADDR OF ABS LDA DSKBS GET DISK ADDR FOR MAIN BP CODE STA DSKAD SET CURRENT BP CODE ADDRESS LDA BSBAD GET UPPER ADDR OF BP CODE LDB PBREL GET LOW ADDR FOR BP CODE JSB BPOUT OUTPUT BP CODE FOR MAIN DISK RES LDA DSKBR GET CURRENT DISK ADDRESS STA DSKAD SET CURRENT ABS DISK ADDRESS LDA PBREL GET LOW BP ADDRESS LDB BSBAD GET UPPER BOUND BP CODE JSB CLRLT CLEAR BP LINKAGES * LDA P3 STA PTYPE SET PROG TYPE = BG DISK RESIDENT JSB CLID3 CLEAR PROGS-LOADED FLAGS LDA IDSAV GET MAIN IDENT INDEX STA TIDNT SET CURRENT IDENT INDEX LDA CPLSB RESET THE LOW SAVE ADDRESS STA CPLS RESET FOR BG MAIN STA CPL2 PROGRAMS JMP BDLD LOAD NEXT BG DISK RESIDENT * BDEND JSB NOTST TEST FOR PROGRAMS LOADED JSB SPACE  NEW LINE SPC 2 IFZ ***** BEGIN DMS CODE ***** * JSB PARTD PARTITION DEFINITION PHASE * ***** END DMS CODE ***** XIF SKP * MOVE UTILITY PROGS TO OUTFILE * CLA STA UTCNT CLEAR UTILITY PROGRAM COUNT LDA DSKAD GET CURRENT DISK ADDRESS STA DSKUT SAVE DISK ADDR OF UTILITY PROGS JSB INIDX INITIALIZE IDENT SCAN GETLB JSB IDX SET IDENT ADDRESSES JMP ENDU ALL UTILITY PROGRAMS MOVED LDA ID6,I GET TYPE AND M177 ISOLATE TYPE CPA P7 TYPE = UTILITY? RSS YES - MOVE JMP GETLB IGNORE OTHER PROGRAMS * LDB DSKAD SET CURRENT DISC ADDR STB ID5,I IN IDENT FOR LIB. DICT. * LDA ALBUF READ UTILITY PROG NAM RECORD. STA CURAL CCB JSB RDNAM JSB ABORT ERROR ON READ. SZA,RSS JSB ABORT END OF FILE. * LDA N64 INIT PACKING COUNT. STA TEMP2 LDA APBUF INIT PACK BUF ADDRESS. STA CURD * MOVEL JSB MVREL SEND RECORD TO OUT FILE. LDA LBUF+1 WAS IT AN END RECORD? ALF,RAR AND M7 CPA P5 JMP MOVEN YES. * LDA ALBUF NO. READ NEXT RELOC RECORD. STA CURAL CLB JSB RDBIN JSB ABORT SZA,RSS JSB ABORT JMP MOVEL * MOVEN ISZ UTCNT BUMP UTILITY PROG COUNT. LDA CURD ANYTHING IN PACK BUF? CPA APBUF JMP GETLB NO. * CLA YES. FILL OUT WITH ZEROES. MREL1 STA CURD,I ISZ CURD ISZ TEMP2 DONE? JMP MREL1 NO. LDA DSKAD YES. LDB APBUF JSB DISKO FLUSH TO DISK. LDA DSKAD JSB DISKA INCR. DISC ADDRESS. STA DSKAD * JMP GETLB SCAN IDENTS FOR NEXT UTILITY PROG. * * SUBR TO SEND RELOC UTILITY RECORD TO OUTFILE. * MVREL NOP LDAA LBUF ALF,ALF CMA,INA STA TEMP1 NEGATIVE WORD COUNT FOR LBUF. * MREL2 LDA CURAL,I MOVE A WORD TO PACKING BUFR. STA CURD,I ISZ CURAL BUMP BUFFER POINTERS. ISZ CURD ISZ TEMP2 END OF BUFFER? JMP MREL3 NO. LDA DSKAD YES. OUTPUT PACK BUF TO DISK. LDB APBUF STB CURD JSB DISKO LDA DSKAD UPDATE DISK ADDRESS. JSB DISKA STA DSKAD LDA N64 RESET PACKING COUNT. STA TEMP2 * MREL3 ISZ TEMP1 END OF RELOC RECORD? JMP MREL2 NO. JMP MVREL,I YES. EXIT. * N64 DEC -64 M1 DEC -1 APBUF DEF FWENT BUFR OVERLAYS FRONT END. CURD NOP * * MAKE LIBRARY ENTRY POINT LIST ENDU CLA STA LBCNT CLEAR LIBRARY ENTRY POINT COUNT STA RELAD CLEAR RELOCATION ADDR FOR LABDO LDA DSKAD GET CURRENT ABSOLUTE DISK ADDR STA DSKLB SAVE LIBR ENTRY POINT LIST ADDR JSB USERS OUTPUT THE LIB USING USER MAP LDA M2000 WITH 2000 FOR THE BASE LDB ABCOR STA B,I CORE BASE ADA M1 AND MAX LDB MXABC STA B,I JSB INLST INITIALIZE LST SCAN LBLST JSB LSTX SET CURRENT LST ADDRESSES JMP ENDSX END OF LIST * LDA .LST4,I GET IDENT INDEX FOR ENTRY POINT * STA TIDNT SET IDENT INDEX FOR IDX SZA,RSS IF UNDEFINED SYMBOL GO JMP LBLTS TEST FOR GENERATED SYMBOL * ADA N5 IF SELF DEFINING SSA SYMBOL JMP LBOU GO SEND IT FORTH WITH * JSB IDX SET IDENT ADDRESSES JSB ABORT INVALID IDENT ADDRESS LDA ID6,I GET PROGRAM TYPE AND M177 ISOLATE TYPE SZA,RSS IS TYPE A SYSTEM PROGRAM JMP LBO YES GO DO IT * AND M7 KEEP THE SIGNIFIGANT BITS IFN **** BEGIN NON-DMS CODE **** CLB,INB CPA B KEEP IF CORE RESIDENT RSS CPA P6 TYPE = LIBRARY? RSS YES - PROCESS LIBRARY ENTRY PT CPA P4 TYPE = BG RESIDENT? **** END NON-DMS CODE **** XIF IFZ **** BEGIN DMS CODE **** CPA P6 **** END DMS CODE **** XIF CLA,RSS YES - PROCESS JMP LBLST IGNORE NON-LIBRARY ENTRY POINT * LBO STA TIDNT CLEAR THE TYPE FLAG LBOU JSB LBOUT SEND THE ENTRY POINT JMP LBLST GO GET THE NEXT ONE * LBLTS LDA .LST5,I IF UNDEFINED SYMBOL HAS A SZA NON-ZERO VALUE JSB LBOUT SEND IT ANY WAY JMP LBLST CONTINUE THE SCAN * * LBOUT NOP ROUTINE TO OUTPUT ENTRY POINTS LDA .LST1,I GET ENTRY POINT 1,2 LDB MXABC GET THE CORE RELATIVE LOCATION LDB B,I INB OF THE NEXT RECORD JSB LABDO OUTPUT NAME 1,2 LDA .LST2,I GET ENTRY POINT 3,4 JSB LABDO OUTPUT NAME 3,4 LDA .LST3,I GET ENTRY POINT 5 AND M7400 ISOLATE UPPER CHAR ADA TIDNT ADD THE FLAG WORD JSB LABDO OUTPUT NAME 5 LDA .LST5,I GET SYMBOL VALUE JSB LABDO OUTPUT VALUE OF ENTRY PT ISZ LBCNT INCR ENTRY POINT COUNT JMP LBOUT,I RETURN * * * OUTPUT THE DICTIONARY * ENDSX JSB INLST DICTIONARY IS IN ORDER SXEND JSB LSTX OF DEFINATION JMP ENDS2 END OF ENT'S GO WRAP UP * LDA .LST4,I GET THE IDENT INDEX STA TIDNT SET FOR IDX ADA N5 IF UNDEFINED OR SELF SSA DEFINING JMP SXEND SKIP THE SYMBOL * JSB IDX GET THE IDENT ADDRESSES JSB ABORT WOOPS! LDA ID6,I GET THE TYPE AND M177 ISOLATE CPA P7 IF NOT LIBRARY CLA,INA,RSS JMP SXEND TRY THE NEXT ONE * STA TIDNT ELSE SET THE FLAG TO 1 LDA ID5,I GET THE DISC ADDRESS STA S.LST5,I AND SET IN VALUE WORD JSB LBOUT OUTPUT THE ENT JMP SXEND TRY THE NEXT ONE. * ENDS2 JSB BPDSA OUTPUT REMAINDER OF LIBR LIST JSB SYS BACK TO THE SYSTEM MAP * * GENERATE BLANK ID SEGMENTS * ENDBI LDA CURAK MORE BLANK ID'S? CPA ASKEY ? JMP ENDRL NO HOW ABOUT SHORT ONES? * LDA N2 YES GENERATE A JSB GENID BLANK ID SEGMENT JMP ENDBI NEED ANOTHER? * ENDRL LDA SKEYA IF NEXT KEYWORD IS INA CPA IDSAD THEN TERMINATE JMP ENDSZ BLANK OUTPUT. * LDA N2 A=-2 FOR BLANK ID SEGMENT FLAG. JSB GNSID GENERATE ID SEGMENT. JMP ENDRL REPEAT TEST. * * PUT OUT DISK DICTIONARY ENDSZ LDA DSKAD GET CURRENT DISC ADDRESS. ALF,ALF ROTATE DISK TRACK NO. TO LOW A RAL ISOLATE AND M377 TRACK NUMBER. INA SET A = NUMBER OF USED TRACKS STA CURAT SAVE NO. OF USED TRACKS CMA,INA STA TCNT SET TRACK USAGE COUNT CLA STA TBUF CLEAR TBUF LDA ADICT SET THE TAT ADDRESS STA CURAI FOR OUTID SYSTR LDA MSIGN SET FLAG FOR SYSTEM-USED TRACK JSB OUTID OUTPUT TRACK-USED FLAG ISZ TCNT STEP THE COUNT JMP SYSTR MORE TO DO CONTINUE * USRTR JSB REMDO FLUSH FINAL SECTOR FROM DBUF SKP * * CLEAR SYSTEM COMMUNICATION AREA * * THIS OVERLAYS 131 OCTAL WORDS * BELOW THE LABEL "USRTR". * LDA FWCMM GET ADDR OF SYS COMM AREA LDB NLCOM GET NEG. LENGTH OF COMM AREA STB WDCNT SET COUNT FOR CLEARING BP AREA CLB STB A,I CLEAR BP COMM AREA WORD INA ISZ WDCNT SKIP - AREA CLEARED JMP *-3 CONTINUE CLEARING BP AREA * * LDA AEQT GET ADDRESS OF EQT STA EQTA GEDT ADDRESS OF EQT * LDA CEQT GET NO. OF EQT ENTRIES STA EQT# SET NO. OF EQT ENTRIES * LDA ASQT GET ADDR OF DEV REF TABLE STA DRT SET ADDR OF DEV REF TABLE * LDA CSQT GET NO. OF DEV REF TABLE ENTRIES STA LUMAX SET NO. OF DEV REF TABLE ENTRIES * LDA AINT GET ADDR OF INTERRUPT TABLE STA INTBA SET ADDR OF INTERRUPT TABLE * LDA CINT GET NO. OF INT ENTRIES STA INTLG SET NO. OF INT ENTRIES * LDA ADICT GET ADDR OF DISK TRACK TABLE STA TAT SET ADDR OF DISK TRACK TABLE * LDA KEYAD GET ADDR OF KEYWORD LIST STA KEYWD SET ADDR OF KEYWORD LIST * LDA TBCHN GET I/O ADDR FOR TBG STA TBG SET I/O ADDR FOR TBG * LDA TTYCH GET I/O ADDR FOR SYS TELETYPE STA SYSTY SET I/O ADDR FOR SYS TELETYPE * LDB SCH4 SET ID ADDRESS OR ZERO STB SKEDD IN SCHEDULED LIST * LDA SWAPF GET SWAPPING FLAG STA SWAP SET SWAPPING FLAG * LDA LBCAD GET ADDR OF LIBRARY STA LBORG SET ADDR OF LIBRARY * LDA RTCAD GET RT COM ADDRESS STA RTORG SET RT COM ADDRESS * LDA COMRT GET RT COM LENGTH STA RTCOM SET RT COM LENGTH * * SWTCH NEEDS RTDRA,AVMEM, & BKDRA SET FOR RTE-III FMGR INITIALIZATION LDA MEM6 SET FWA OF R/T STA RTDRA DISC RESIDENT AREA. * LDA SYMAD GET ADDRESS OF SYS AV MEM STA AVMEM SET ADDR OF SYS AV MEM * LDA BGBND SET BG BOUNDARY STA BKORG SET BG BOUNDARY * LDA COMBG SET BACKGROUND STA BKCOM COMMON LENGTH. * LDA MEM12 GET BG DISK RESIDENT ORIGIN STA BKDRA SET BG DISK RESIDENT ORIGIN * LDA LWASM GET LAST AVAIL ADDR FOR SYSTEM STA BKLWA SET LAST AVAIL ADDR FOR SYSTEM * IFN *** BEGIN NON-DMS CODE *** LDA URBP SET FWA OF R/T DISC RESIDENT STA BPA1 LINK AREA IN BASE PAGE. * LDA URBP1 SET LWA FOR R/T STA BPA2 BASE PAGE LINK. * LDA UBBP SET FWA OF BKG DISC RESIDENT STA BPA3 LINK AREA IN BASE PAGE. **** END NON-DMS CODE **** XIF * IFZ ***** BEGIN DMS CODE ***** LDA P2 STA BPA1 1ST LINK FOR RT DR'S STA BPA3 1ST LINK FOR BG DR'S CCA ADA LOLNK SAVE LOWEST SYS LINK-1 STA BPA2 AS LAST LINK FOR RT DR'S ****** END DMS CODE ****** XIF LDA PIOC SET ADDRESS OF STA DUMMY PRIVILEGED I/O CARD. * LDA SDS# SET # SECTORS/TRACK FOR STA SECT2 SYSTEM DISC (LU #2). * LDA ADS# SET # SECTORS/TRACK FOR STA SECT3 AUXILIARY DISC (LU #3). * LDA DSKSY SET DISC ADDR. OF STA IDSDA FIRST ID SEGMENT. * LDA IDSP SET POSITION OF 1ST ID SEGMENT STA IDSDP IN SECTOR. * LDA DSKLB GET DISK ADDR OF LIB ENTRY PTS STA DSCLB SET DISK ADDR OF LIB ENTRY PTS * LDA LBCNT GET NO. OF LIB ENTRY PTS STA DSCLN SET NO. OF LIB ENTRY PTS * LDA DSKUT GET DISK ADDR OF UTILITY PROGS STA DSCUT SET DISK ADDR OF UTILITY PROGS * LDA UTCNT GET NO. OF UTILITY PROGS STA DSCUN SET NO. OF UTILITY PROGS LDA DSIZE SYSTEM DISC SIZE STA TATSD * LDA DSIZE TOTAL DISC TABLE LENGTH ADA DAUXN CMA,INA STA TATLG SET TOTAL DISK TABLE LENGTH * LDA DMEM1 SET UP THE MEMORY TABLE STA TBUF TO BE FIRST ADDRESS LDB N6 FOLLOWED BY NUMBER STB TEMP4 MADJ LDA TBUF,I OF WORDS CMA,INA CACULATE THE NUMBER ISZ TBUF STEP TO THE HIGH WORD LDB TBUF,I COMPUTE SIZE ADA B CMB,INB MAKE SURE HIGH ADDRESS <77776 ADB M7..5 SSB ADA N2 IF NOT, ADJUST DOWNWARD STA TBUF,I SET IT ISZ TBUF STEP TO THE NEXT WORD ISZ TEMP4 IF DONE EXIT JMP MADJ ELSE LOOP * IFZ ***** BEGIN DMS CODE **** CLA STA MEM6 CLEAR JUNK OUT OF MEM6 STA MEM12 CLEAR JUNK OUT OF MEM12 ****** END DMS CODE ****** XIF * STA EQT12 SET THE LAST WORD * LDA DMEM1 MOVE THE FREE MEMORY LDB DEQT1 TABLE INTO JSB MOVW THE EQT AREA DEC -11 * LDA NLCOM SET UP # WORDS. STA OUTBP LDA FWCMM MOVE THE SYS COM LDB ADBP AREA ADB LWSBP TO THE JSB MOVW THE DUMMY BASE PAGE OUTBP NOP SPC 2 * PUT OUT BASE PAGE * JSB DSKEV GET NEXT EVEN SECTOR ADDRESS STA DSKAV SAVE NEXT AVAILABLE DISK ADDR IFN *** BEGIN NON-DMS CODE *** LDA DSKAB GET INITIAL ABSOLUTE DISK ADDR STA DSKAD SET CURRENT DISK ADDRESS LDA M2000 GET UPPER SYSTEM BP ADDRESS LDB P2 GET LOWER SYSTEM BP ADDRESS JSB BPOUT OUTPUT RESIDENT BP SECTION **** END NON-DMS CODE **** XIF SPC 2 IFZ ***** BEGIN DMS CODE ***** * WRITE UPPER PART OF SYSTEM BASE PAGE TO DISK. * * THE PORTION OF THE BASE PAGE CONTAINING MEMORY * RESIDENT PROGRAM LINKS WAS ALREADY WRITTEN OUT. * SINCE WE PROBABLY ENDED THE LOWER PORTION IN * THE MIDST OF A SECTOR, IT IS MOST CONVENIENT TO * WRITE THE REMAINDER OF THE B.P. USING LABDO, A * WORD AT A TIME, TO INSURE THAT NEW WORDS ARE * MERGED INTO THE APPROPRIATE POSITIONS ON DISK. * * WE TELL LABDO WE ARE WRITING PAGE 1 WORDS VICE * PAGE 0 SINCE LABDO WAS DESIGNED TO VECTOR ALL BASE * PAGE REFERENCES INTO THE IN-CORE "DUMMY BASE PAGE" * INSTEAD OF THE DISK. SPC 1 LDA DSKBP GET STARTING SECTOR OF SBP STA DBDSK AND SAVE IN LABDO MAP. LDA M2002 SET BASE CORE ADDR STA DBASE IN MAP. FNLH LDA M4000 AND SET MAX CORE ADDR SEEN STA DBMAX IN MAP. LDA DBMAP SET LABDO TO USE SPECIAL JSB SETDS MAP BELOW. LDA LOLNK SAVE CORE ADDRESS OF LOWEST ADA ADBP SYSTEM LINK IN TEMPORARY. STA TEMP5 LDB LOLNK CONVERT TARGET BP ADDR TO PAGE 1 ADB M2000 ADDR TO FAKE OUT LABDO. SPC 1 BLOOP LDA TEMP5,I PICK UP NEXT BP WORD AND JSB LABDO WRITE TO DISK, INCREMENTING B VN ISZ TEMP5 REG (TARGET) AND TERMP5 CPB M4000 (SOURCE) EACH TIME UNTIL JMP BPEND END OF PAGE IS PASSED JMP BLOOP (TARGET ADDR = PAGE 2) SPC 1 TEMP5 BSS 1 LOCAL TEMPORARY DBMAP DEF *+1 *MAPPING ENTRIES * DBASE BSS 1 * FOR LABDO, DO NOT* DBMAX BSS 1 * MOVE W/RESPECT * DBDSK BSS 1 * TO EACH OTHER. * SPC 1 BPEND EQU * ****** END DMS CODE ****** XIF LDA OLDDA FLUSH THE LABDO BUFFER LDB ADBUF TO THE JSB DISKO DISC LDA ASECT GET ADDRESS OF BOOT SPECS. JSB FSECT FLUSH THE FINAL SECTOR * * LDA P22 LDB MES23 MES23 = ADDR: *SYSTEM STORED ETC JSB DRKEY PRINT: SYSTEM STORED ON DISK * LDA DSKAV CONVERT ALF,ALF LAST RAL USED AND M377 DISC CMA,INA LDB ATBUF ADDRESS (TRACK #) TO DECIMAL JSB CONVD AND LDA TBUF+2 STORE STA MES38+6 IN MESSAGE. LDA DSKAV CONVERT AND M177 SECTOR ARS CONVERT TO 128 WORD SECTORS CMA,INA (DECIMAL) LDB ATBUF # JSB CONVD AND LDA TBUF+2 STORE STA MES38+11 IN LDA TBUF+1 MESSAGE AND M377 ISOLATE 3RD DIGIT, IOR UBLNK ADD UPPER BLANK. STA MES38+10 LDA P31 PRINT MESSAGE: LDB MES38 "SYS SIZE: JSB DRKEY TRK XX SEC XXX(10)" JSB SPACE SKP * * GENERATION COMPLETE. CLEAN HOUSE. * LDA DSKAV FORCE ACESS TO LAST RECORD LDB ADBUF SO TRUNCATE WILL WORK. JSB DISKI JSB CLSAB CLOSE CORE-IMAGE FILE. * LDA P14 PRINT: LDB MES11 "RTGEN FINISHED" JSB LFOUT * JSB OPEN OPEN FILE IN ORDER DEF *+4 TO PURGE IT DEF NMDCB DEF FMRR DEF .NM. * JSB CLOSE  PURGE TEMP NEW NAM FILE. DEF *+4 DEF NMDCB DEF FMRR DEF P64 * JSB CLOSF CLOSF PRINT FILE DEF *+3 DEF LFDCB DEF ZERO * JSB CLOSF CLOSE LAST RELOCATABLE DEF *+3 INPUT FILE DEF RRDCB DEF ZERO * JSB CLOSF DEF *+3 DEF ECDCB DEF ZERO * JSB CLOSF CLOSE INPUT FILE DEF *+3 DEF IPDCB DEF ZERO * JSB EXEC PRINT OUT ENDING MESSAGE DEF *+5 DEF P2 DEF ERRLU DEF MES11+1 DEF P7 * JSB EXEC RELEASE SYMBOL TABLE TRACKS DEF *+3 DEF P5 DEF M1 * * JSB EXEC TERMINATE. DEF *+2 DEF P6 * ZERO NOP * MES11 DEF *+1 ASC 1,RT IFN ***** BEGIN NON-DMS CODE ***** ASC 1,2G ***** END NON-DMS CODE ***** XIF IFZ ***** BEGIN DMS CODE ***** ASC 1,3G ***** END DMS CODE ***** XIF ASC 5,N FINISHED * DMEM1 DEF MEM1 DEQT1 DEF EQT1 * M2002 OCT 2002 M4000 OCT 4000 M377 OCT 377 P16 DEC 16 M7..5 OCT 77775 SKP SKP *** SYSTEM BASE PAGE COMMUNICATION AREA *** * * SYSTEM TABLE DEFINITION * * FWCMM DEF USRTR-131B . EQU USRTR-130B * XI EQU .-1 ADDR OF I-REG SAVE AREA * FOR RUNNING PROG (MEU) EQTA EQU .+0 FWA OF EQUIPMENT TABLE EQT# EQU .+1 # OF EQT ENTRIES LUMAX EQU .+3 # OF LOGICAL UNITS (IN DRT) DRT EQU .+2 FWA OF DEVICE REFERENCE TABLE INTBA EQU .+4 FWA OF INTERRUPT TABLE INTLG EQU .+5 # OF INTERRUPT TABLE ENTRIES TAT EQU .+6 FWA OF TRACK ASSIGNMENT TABLE KEYWD EQU .+7 FWA OF KEYWORD BLOCK * * I/O MODULE/DRIVER COMMUNICATION * EQT1 EQU .+8 ADDRESSES EQT2 EQU .+9 EQT3 EQU .+10 OF EQT4 EQU .+11 EQT5 EQU .+12 CURRENT EQT6 EQU .+13 EQT7 EQU .+14 15-WORD EQT8 EQU .+15 EQT9 EQU .+16  EQT EQT10 EQU .+17 EQT11 EQU .+18 ENTRY EQT12 EQU .+81 EQT13 EQU .+82 EQT14 EQU .+83 EQT15 EQU .+84 * CHAN EQU .+19 CURRENT DMA CHANNEL # TBG EQU .+20 I/O ADDRESS OF TIME-BASE CARD SYSTY EQU .+21 EQT ENTRY ADDRESS OF SYSTEM TTY * * SYSTEM REQUEST PROCESSOR /'EXEC' COMMUNICATION * * RQCNT EQU .+22 # OF REQUEST PARAMETERS -1 RQRTN EQU .+23 RETURN POINT ADDRESS RQP1 EQU .+24 ADDRESSES RQP2 EQU .+25 RQP3 EQU .+26 OF REQUEST RQP4 EQU .+27 RQP5 EQU .+28 PARAMETERS RQP6 EQU .+29 RQP7 EQU .+30 (SET FOR MAXIMUM OF RQP8 EQU .+31 8 PARAMETERS) * * DEFINITION OF SYSTEM LISTS (QUEUES) * * DORMT EQU .+32 ADDRESS OF 'DORMANT' LIST, SKEDD EQU .+33 'SCHEDULE' LIST, SUSP3 EQU .+36 'AVAILABLE MEMORY' LIST, SUSP4 EQU .+37 'DISC ALLOCATION' LIST, SUSP5 EQU .+38 'OPERATOR SUSPEND' LIST * * DEFINITION OF EXECUTING PROGRAM ID SEGMENT' * * XEQT EQU .+39 ID SEGMENT ADDR. OF CURRENT PROG. XLINK EQU .+40 'LINKAGE' XTEMP EQU .+41 'TEMPORARY (5-WORDS) XPRIO EQU .+46 'PRIORITY' WORD XPENT EQU .+47 'PRIMARY ENTRY POINT' XSUSP EQU .+48 'POINT OF SUSPENSION' XA EQU .+49 'A REGISTER' AT SUSPENSION XB EQU .+50 'B REGISTER' XEO EQU .+51 'E AND OVERFLOW * * SYSTEM MODULE COMMUNICATION FLAGS * * OPATN EQU .+52 OPERATOR/KEYBOARD ATTENTION FLAG OPFLG EQU .+53 OPERATOR COMMUNICATION FLAG SWAP EQU .+54 RT DISC RESIDENT SWAPPING FLAG DUMMY EQU .+55 I/O ADDRESS OF DUMMY INT. CARD IDSDA EQU .+56 DISC ADDR. OF FIRST ID SEGMENT IDSDP EQU .+57 -POSITION WITHIN SECTOR * * DEFINITION OF MEMORY ALLOCATION BASES * * BPA1 EQU .+58 FWA R/T DISC RES. BP LINK AREA BPA2 EQU .+59 LWA R/T DISC RES. BP LINK AREA BPA3 EQU .+60 FWA BKG DISC RES. BP LINK AREA LBORG EQU .+61 FWA OF RESIDENT LIBRARY AREA RTORG EQU .+62 FWA OF REAL-TIME AREA RTCOM EQU .+63 LENGTH OF REAL TIME COMMON AREA RTDRA EQU .+64 FWA OF R/T DISC RESIDENT AREA AVMEM EQU .+65 FWA OF SYSTEM AVAILABLE MEMORY BKORG EQU .+66 FWA OF BACKGROUND AREA BKCOM EQU .+67 LENGTH OF BACKGROUND COMMON AREA BKDRA EQU .+68 FWA OF BKG DISC RESIDENT AREA * * UTILITY PARAMETERS * TATLG EQU .+69 LENGTH OF TRACK ASSIGNMENT TABLE TATSD EQU .+70 # OF TRACKS ON SYSTEM DISC SECT2 EQU .+71 # SECTORS/TRACK ON LU 2 (SYSTEM) SECT3 EQU .+72 # SECTORS/TRACK ON LU 3 (AUX.) DSCLB EQU .+73 DISC ADDR OF RES LIB ENTRY PTS DSCLN EQU .+74 # OF RES LIB ENTRY POINTS DSCUT EQU .+75 DISC ADDR OF RELOC UTILITY PROGS DSCUN EQU .+76 # OF RELOC UTILITY PROGS LGOTK EQU .+77 LOAD-N-GO: LU,STG TRACK,# OF TRKS LGOC EQU .+78 CURRENT LGO TRACK/SECTOR ADDRESS SFCUN EQU .+79 SOURCE FILE LU AND DISC ADDRESS MPTFL EQU .+80 MEMORY PROTECT ON/OFF FLAG (0/1) FENCE EQU .+85 MEM PROTECT FENCE ADDRESS BKLWA EQU .+87 LWA OF MEMORY IN BACKGROUND HED RTGN3 - LOADING CONTROL SEGMENT SUBROUTINES. IFZ ***** BEGIN DMS CODE ***** * * IDFIX: SETS UP WORD 22 OF ID-SEGMENT FOR RTE-III * * WORD 22 FORMAT - BIT 15: 1=PARTITION ASSIGNED * 10-14: PARTITION SIZE REQMT. IN PAGES * NEGLECTING BASE PAGE (#PAGES-1) * 7-9: MEM PROTECT FENCE TBL INDEX * 6: RESERVED (0) * 0-5: ASSIGNED PARTITION NUMBER-1 * * CALLING SEQUENCE: * * JSB SYS (OR MAKE SURE LABDO IS MAPPING SYSTEM) * A= #PAGES NEEDED BY PROGRAM INCL. BASE PAGE * B= INDEX OF IDENT ENTRY FOR PROG * JSB IDFIX * * SUBROUTINES CALLED: LABDO * * RETURN: * A,B,E DESTROYED SPC 1 IDFIX NOP SZA DON'T INCLUDE BASE ADA M1 PAGE IN SIZE. STA IDTM1 SAVE PAGE REQMT STB TIDNT STORE DESIRED ENTRY INDEX JSB IDX AND BRING INTO CORE JSB ABORT NOT THERE SPC 1 * CHECK USE OF SSGA SPC 1 LDA ID6,I GET PROG TYPE FROM IDENT AND M20 AND ISOLATE THE SSGA BIT. SZA,RSS IF NOT USING SSGA, JMP NOSSC THEN GO CHECK OTHER COMMONS. SPC 1 LDA XSSGA IF USING SSGA, THEN PICK UP JMP IDSET MPFT INDEX AND GO WRITE ID-SEG. SPC 1 * NOT USING SSGA; USE COMMON SIZE FROM IDENT * (EITHER SOME OR NONE), REVERSE COMMON BIT IN TYPE, * AND LOW TWO TYPE BITS TO INDEX INTO TABLE OF * MPFT INDICES. SPC 1 NOSSC LDA ID6,I GET TYPE AGAIN AND SAVE BITS AND M13 0,1, AND REVERSE COMMON BIT. LDB ID4,I PICK UP COMMON SIZE SZB IF ANY, THEN SET BIT 2 IN A. IOR P4 SPC 1 ADA IDTB. USE BIT PATTERN IN A TO INDEX LDA A,I TABLE, AND PICK UP MPFT INDEX. SPC 1 * A CONTAINS MPFT INDEX, MERGE IN SIZE REQUIREMENT * AND WRITE DISK. SPC 1 IDSET CLB PUT MPFT INDEX AND RRR 3 IOR IDTM1 PAGE REQMT IN PROPER RRL 10 POSITIONS IN A-REG SPC 1 STA IDTM3 SAVE NEW ID WORD JSB IDFND FIND ID-SEG ADDRESS ADB P21 POINT TO ID-SEG WORD 22 LDA IDTM3 AND WRITE NEW CONTENTS JSB LABDO TO DISK. SPC 1 LDA IDTM1 MERGE PARTITION SIZE LSL 8 REQUIREMENT LESS 1 IOR ID8,I INTO UPPER BYTE STA ID8,I OF IDENT WORD 8 SPC 1 * RETURN TO CALLER JMP IDFIX,I SPC 1 * CONSTANTS, ETC. SPC 1 IDTM1 BSS 1 IDTM3 BSS 1 XSSGA DEC 4 MPFT INDEX IF USING SSGA XDRNC EQU 0 MPFT INDEX IF DISK RES W/O COM. XMRNC EQU 1 MPFT INDEX IF MEM RES W/O COM. XBG EQU 3 MPFT INDEX IF USER OF BG COM. XRT EQU 2 MPFT INDEX IF USER) OF RT COM. M20 EQU P16 * M13 OCT 13 SPC 4 * INDEX LOOKUP TABLE * * TABLE CONTAINS MPFT INDICES (XSSGA, XDRNC, * XMRNC, XBG, OR XRT) * * THE INDEX TO THIS TABLE IS 4 BITS LONG: * * BITS 0,1: 00 - SHOULDN'T HAPPEN * (FROM TYPE) 01 - RT MEM RES * 10 - RT DISK RES * 11 - BG DISK RES * BIT 2: 0 - NO COMMON USED * 1 - COMMON USED * BIT 3: 0 - USE NORMAL COMMON * 1 - USE REVERSE COMMON SPC 1 IDTB. DEF *+1 ABS 0 INDEX=0000-SHOULDN'T HAPPEN ABS XMRNC 0001-MR W/O COMMON ABS XDRNC 0010-RT DR W/O COMMON ABS XDRNC 0011-BG DR W/O COMMON ABS 0 0100 BAD ENTRY ABS XRT 0101-MR W/RT COMMON ABS XRT 0110-RT DR W/RT COMMON ABS XBG 0111-BG DR W/BG COMMON ABS 0 1000-BAD ENTRY,SHOULDN'T OCCUR ABS XMRNC 1001-MR W/O COMMON (REVERSE) ABS XDRNC 1010-RT DR W/O COMMON (REVERSE) ABS XDRNC 1011-BG DR W/O COMMON (REVERSE) ABS 0 1100-BAD ENTRY ABS XBG 1101-MR W/BG COMMON ABS XBG 1110-RT DR W/BG COMMON ABS XRT 1111-BG DR W/RT COMMON * END OF TABLE SPC 4 * * IDFND - FIND ID SEGMENT ADDRESS BY READING * KEYWORD FROM DISC. * * CALLING SEQ: RETURN SEQ: (N+1) * (INSURE 'SYS' MAP IS SET FOR LABDO) A IS DESTROYED * (INSURE IDFIX CALLED EARLIER FOR PROG) B IS ID SEG ADDR * (INSURE PROG'S IDENT IS IN CORE) * JSB IDFND * SPC 1 IDFND NOP LDA M377 PICKUP KEYWD# IN IDENT AND ID8,I WORD 8 AND ISOLATE IT ADA KEYAD ADD KEYWORD BASE ADDR LDB A AND SAVE IN B FOR DPRW. JSB DPRW THEN READ KEYWD. LDB A JMP IDFND,I RETURN W/ID-SEG ADDR IN B. SPC 4 * DETERMINE PAGE REQUIREMENTS FOR A PROGRAM * * CALLING SEQUENCE: RETURN SEQUENCE: * A=HIGH MAIN ADDR+1 B,E DESTROYED * B=LOW MAIN ADDR A=PAGE REQUIREMENT * JSB PGREQ INCL. BASE PAGE. SPC 1 PGREQ NOP CMB B=-LOMAIN-1 ADA B A=NO. WORDS NEEDED-1 RRR 10 A=#PAGES-1 AND M37 CLEAN OUT BAD BITS ADA P2 A=#PAGES+1(I.E. INCL BASE PAGE) SPC 1 JMP PGREQ,I PAGE REQUIREMENTS. ****** END DMS CODE ****** XIF SKP * * PRINT HEADING, INITIALIZE IDX * * THE SETHD SUBROUTINE PRINTS THE HEADINGS FOR THE DIFFERENT * TYPES OF PROGRAMS LOADED, SETS THE NO-PROGRAMS-LOADED-YET * FLAG, AND ORIGINS THE SCAN OF IDENT. * * CALLING SEQUENCE: * A = NO. CHARS. (POS.) IN MESSAGE * B = ADDRESS OF MESSAGE * JSB SETHD * * RETURN: CONTENTS OF A AND B ARE DESTROYED * SETHD NOP DST TBUF SAVE THE MESSAGE JSB SPACE NEW LINE DLD TBUF NOW JSB DRKEY PRINT HEADING JSB SPACE NEW LINE CCA STA LFLAG SET PROGRAMS-LOADED FLAG = -1 LDA P10 GET FIRST IDENT INDEX STA CIDNT SET IDENT ADDRESS FOR ID SCAN JMP SETHD,I RETURN SPC 2 * * THE MOVW SUBROUTINE MOVES WORDS FROM ONE CORE LOCATION * TO ANOTHER * * CALLING SEQUENCE: * * LDA FROM ADDRESS * LDB TO ADDRESS * JSB MOVW * DEC -WORD COUNT * MOVW NOP STA TBUF LDA MOVW,I GET THE COUNT STA TBUF+1 SET IN COUNTER * MOVW2 LDA TBUF,I GET A WORD STA B,I SET IT INB ISZ TBUF STEP THE ADDRESSES ISZ TBUF+1 DONE? JMP MOVW2 NO DO THE NEXT ONE * ISZ MOVW STEP TO RETURN POINT JMP MOVW,I YES- RETURN SKP * *  UPDATE RESIDENT MEMORY BOUNDS * * THE INCAD SUBROUTINE UPDATES THE MAIN AND BP MEMORY BOUNDS * FROM THAT USED IN THE PREVIOUS LOADING CALL. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB INCAD * * RETURN: CONTENTS OF A AND B ARE DESTROYED * INCAD NOP LDA TPREL GET CURRENT RELOCATION ADDRESS STA PPREL SET NEW PROGRAM RELOC ADDRESS LDA TBREL GET CURRENT BP RELOC ADDRESS STA PBREL SET NEW BP RELOCATION ADDRESS JMP INCAD,I RETURN SPC 5 * DSKEV FORCES THE CURRENT DISC * ADDRESS TO BE EVEN. THIS IS * DONE TO INCREASE LOAD EFFENCIENCY * DURING RTE EXECUTION DSKEV NOP LDA DSKAD GET CURRENT ADDRESS SLA IF EVEN SKIP JSB DISKA ELSE STEP BY ONE STA DSKAD RESET ADDRESS JMP DSKEV,I RETURN - ADDRESS IN A. SKP * N6 DEC -6 P21 DEC 21 * MES13 DEF MS13 MES14 DEF *+2 DEF *+6 ASC 8,RT COM MES15 DEF MS15 MES16 DEF MS16 MES18 DEF *+2 DEF *+6 ASC 8,BG COM IFN *** BEGIN NON-DMS CODE *** MES19 DEF MS19 **** END NON-DMS CODE **** XIF MES20 DEF MS20 MES22 DEF *+1 ASC 3,(NONE) MES23 DEF MS23 MES12 EQU MES23 MES27 DEF MS27 * MES38 DEF *+1 ASC 16,SYS SIZE: XX TRKS, XXX SECS(10) * ASECT DEF SECTR JMP3I JMP 3,I INITIAL JMP INSTRUCTION * MES57 ASC 5,BG COMMON IFN *** BEGIN NON-DMS CODE *** MES52 ASC 5, LIB ADDRS MES53 ASC 5, FG COMMON MES54 ASC 5,FG RES ADD MES55 ASC 5,FG DSC ADD MES56 ASC 5,BG BOUNDRY MES58 ASC 5,BG RES ADD MES59 ASC 5,BG DSC ADD MES60 ASC 5, SYS AVMEM **** END NON-DMS CODE **** XIF IFZ ***** BEGIN DMS CODE ***** MES53 ASC 5,RT COMMON MES60 ASC 5,LW RES PRG MES61 ASC 5,1ST DSK PG ****** END DMS CODE ****** XIF * SPC 3 MS02 ASC 8,BP LINKAGET XXXXX MS13 ASC 4,LIBRARY IFN *** BEGIN NON-DMS CODE *** MS15 ASC 6,FG RESIDENTS MS16 ASC 9,FG DISC RESIDENTS **** END NON-DMS CODE **** XIF IFZ ***** BEGIN DMS CODE ***** MS15 ASC 8,MEMORY RESIDENTS MS16 ASC 9,RT DISC RESIDENTS ****** END DMS CODE ****** XIF IFN *** BEGIN NON-DMS CODE *** MS19 ASC 6,BG RESIDENTS **** END NON-DMS CODE **** XIF MS20 ASC 9,BG DISC RESIDENTS MS23 ASC 11,SYSTEM STORED ON DISC MS27 ASC 8,FWA BP LINKAGE? SKP IFZ ***** BEGIN DMS CODE ***** * * SET RELOCATION BASE AT FIRST PAGE FOLLOWING SYSTEM * OR, IF USED, COMMON. THIS ROUTINE IS CALLED BEFORE * RELOCATION OF EACH DISK RESIDENT PROGRAM SPC 1 SETRB NOP LDB SSGA. GET LWA OF SYS/LIB + 1 LDA ID6,I GET PROG TYPE AND M20 ISOLATE SSGA BIT IN TYPE, IOR ID4,I MERGE IN COMMON LENGTH, SZA AND IF HE USES EITHER LDB FWMRP SET RELOC BASE ABOVE COMMON. CCA ADA B GET LWA OF SYS OR COMMON, AND M1760 KEEP JUST PAGE NUMBER, ADA M2000 BUMP TO START OF NEXT PAGE STA PPREL AND SAVE AS RELOCATION BASE. CLA RESET BASE PAGE ALLOCATION STA BPMAX HIGH-WATER-MARK JMP SETRB,I RETURN * M1760 OCT 176000 SPC 5 * * DPRW - READ AND REWRITE A WORD FROM THE ABSOLUTE SYSTEM * STORED ON THE DISK * * CALL A-IGNORED * B- ABS TARGET SYSTEM ADDR * RETURN: B SET TO B+1 * A=CONTENTS OF DESIRED WORD SPC 1 DPRW NOP JSB LABDO READ AND DESTROY WORD STA DPRWT SAVE IN TEMP ADB M1 BACK UP ADDR JSB LABDO RESTORE WORD LDA DPRWT BACK TO A JMP DPRW,I AND RETURN SPC 1 DPRWT BSS 1 ****** END DMS CODE ****** XIF SKP * * SCAN IDENTS FOR PROGRAM TYPE * * THE IDSCN SUBROUTINE SCANS IDENT FOR A PROGRAM OF THE * CURRENT TYPE (SET IN PTYPE). * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB IDSCN * * RETURN: CONTENTS OF A AND B ARE DESTOYED. * E = M/S FLAG FOR CURRENT PROGRAM. * IDSCN NOP LDA CIDNT GET NEXT IDENT IN SCAN STA TIDNT SET IDENT INDEX FOR IDX JSB IDX SET IDENT ADDRESSES JMP IDSCN,I RETURN - END OF IDENTS CCA ADA TIDNT GET CURRENT MAIN IDENT INDEX STA IMAIN SAVE CURRENT MAIN IDENT INDEX LDA TIDNT GET NEXT IDENT INDEX STA CIDNT SAVE ADDR FOR NEXT IDENT SCAN LDA ID6,I GET TYPE RAL,CLE,ERA SET E = M/S AND TYPMS ISOLATE PROGRAM TYPE CPA PTYPE CURRENT TYPE? RSS YES - CONTINUE JMP IDSCN+3 IGNORE IDENT - TRY NEXT IDENT ISZ IDSCN INCR RETURN ADDRESS JMP IDSCN,I RETURN SKP * * TEST FOR SOME PROGRAMS LOADED * * THE NOTST SUBROUTINE CHECKS FOR PROGRAMS OF THE CURRENT * TYPE LOADED. IT IS EXECUTED FOLLOWING COMPLETION OF THE * LOADING SEQUENCE FOR EACH PROGRAM TYPE. IF NO PROGRAMS OF * THIS TYPE HAVE BEEN LOADED, IT PRINTS THE MESSAGE * (NONE) ON THE TELEPRINTER. * OTHERWISE IT REPORTS THE CURRENT BASE PAGE LINKAGE ADDRESS. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB NOTST * * RETURN: CONTENTS OF A AND B ARE DESTROYED. * NOTST NOP LDA BPMAX GET CURRENT TOP OF LINKAGE ISZ LFLAG IF NO PROGRAMS LOADED JMP BPRPT SEND: (NONE) LDA P6 LDB MES22 MES22 = ADDR: (NONE) JSB DRKEY PRINT: (NONE) IFN JMP NOTST,I RETURN * BPRPT JSB BPLNR SEND BP LINKAGE MESSAGE JMP NOTST,I RETURN XIF IFZ BPRPT JMP NOTST,I XIF SPC 2 MES02 DEF MS02 MES03 DEF MS02+5 SPC 2 BPLNR NOP SEND MESSAGE 'BP LINKAGE XXXXX' LDB MES03 XXXXX IS IN A ON ENTRY *JSB CONVD CONVERT TO MESSAGE LDA P16 GET LENGTH LDB MES02 AND ADDRESS JSB DRKEY SEND MESSAGE JMP BPLNR,I RETURN SKP * * CLEAR LOCAL LST ENTRIES * * CLRLT CLEARS THE CURRENT BP LINKAGE ADDRESSES IN THE BASE PAGE * IMAGE. (CLEARS B-A WORDS). * * CALLING SEQUENCE: * A = CURRENT LOW BP ADDRESS * B = CURRENT HIGH BP ADDRESS PLUS ONE * JSB CLRLT * * RETURN: CONTENTS OF A AND B ARE DESTROYED. * CLRLT NOP IFZ ***** BEGIN DMS CODE ***** STA CLRTM SAVE PARM IN TEMP LDA BPINC AND PICK UP BP INCREMENT ELA AND SAVE SIGN (<0 = DOWN) LDA CLRTM THEN RESTORE PARM. SEZ IF BP LINKS GO DOWNWARD, SWP THEN SWAP PARMS. ****** END DMS CODE ****** XIF CMB,INB SET HIGH BOUND NEGATIVE ADB A SET A = TOTAL WORD COUNT SSB,RSS SKIP - SOME BP SECTION TO CLEAR JMP CLRLT,I RETURN - NO BP SECTION STB WDCNT SET COUNT FOR CLEARING ADA ADBP ADJUST FOR BP ADDRESS LDB CLWRD GET THE CLEARING WORD STB A,I CLEAR BP WORD INA ISZ WDCNT SKIP - ALL BP CLEAR JMP *-3 JMP CLRLT,I END OF CLEARING IFZ ***** BEGIN DMS CODE ***** CLRTM BSS 1 ****** END DMS CODE ****** XIF * CLWRD NOP SKP * * OUTPUT ABSOLUTE BASE PAGE CODE * * BPOUT OUTPUTS THE BASE PAGE SECTION OF CODE FOLLOWING LOADING OF * EACH DISK RESIDENT PROGRAM, BEGINNING WITH THE DISK * ADDRESS SPECIFIED IN DSKAD. * * CALLING SEQUENCE: * A = UPPER BP ADDRESS PLUS ONE * B = LOWER BP ADDRESS * JSB BPOUT * * RETURN: CONTENTS OF A AND B ARE DESTOYED. * BPOUT NOP CMA,INA COMPLEMENT UPPER ADDRESS ADA B ADD LOWER ADDRESS STA TCNT SAVE BP LENGTH ADB ADBP ADJUST FOR BP ADDRES=HFBS STB CURAT SAVE CURRENT LOWER CORE ADDR SSA,RSS SKIP - SOME CODE IN BP JMP BPOUT,I RETURN - ALL CODE OUT LDA DSKAD GET CURRENT DISK ADDRESS BPSYO JSB DISKO OUTPUT CURRENT BP SECTOR LDA DSKAD GET CURRENT DISK ADDRESS JSB DISKA INCR DISK ADDRESS STA DSKAD SAVE NEXT DISK ADDRESS LDB TCNT GET CURRENT LENGTH ADB P64 STB TCNT SAVE COUNT FOR NEXT PASS SSB,RSS SKIP - MORE CODE TO PUT OUT JMP BPOUT,I RETURN - ALL CODE OUT LDB CURAT GET CURRENT LOW CORE ADDRESS ADB P64 STB CURAT SET NEXT CORE ADDRESS JMP BPSYO OUTPUT NEXT SECTOR TO DISK * P64 DEC 64 SKP * CLEAR PROGRAMS-LOADED FLAGS * * CLID3 CLEARS THE USAGE FLAGS TO ENSURE THAT PROGRAMS WILL BE * RE-LOADED AGAIN IF CALLED MORE THAN ONCE. THIS IS ESSENTIAL * FOR ALL UTILITY PROGRAMS AND USER SUBROUTINES, BUT MUST NOT * BE DONE FOR SYSTEM PROGRAMS, LIBRARY PROGRAMS, OR MAIN USER * PROGRAMS. BOTH THE USAGE FLAG IN THE IDENT ENTRY AND THE * SYMBOL VALUES FOR ALL ENTRY POINTS IN THE PROGRAM ARE CLEARED. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB CLID3 * RETURN: CONTENTS OF A AND B ARE DESTROYED. * CLID3 NOP LDB P3 GET THE STANDARD FLAG LDA P5 CPA PTYPE PROG = BG SEGMENT? LDB P7 YES - GET BS FLAG BITS /dH STB CURAP SET CURRENT PROG FLAG BITS JSB INIDX INITILIZE THE IDENT SCANNER TRID3 JSB IDX GET THE NEXT IDENT. JMP CLID3,I IF NONE THEN EXIT - DONE * LDA ID6,I GET M/S,TYPE RAL,CLE,ERA SET E IF MAIN AND M177 ISOLATE TYPE SZA,RSS IF SYSTEM JMP TRID3 FORGET IT * AND M7 ISOLATE FURTHER CPA P6 TYPE = LIBRARY? JMP TRID3 THEN - DO NOT CHANGE FLAG * CCB PRESET B TO IMPOSSIBLE TYPE CPA P7 IF LIB TYPE CLB,CLE SET NOT MAIN FLAG(B=SYS TYPE) CPB PTYPE IF SYS REF TO LIB JMP TRID3 DON'T CLEAR IT (ONE COPY FOR SYS) * SEZ IF MAIN JMP TRID3 FORGET IT * LDA ID3,I GET USAGE FLAG AND P7 ISOLATE THE USAGE FLAG CPA CURAP IF ONE THAT WE ARE AFTER RSS SKIP JMP TRID3 ELSE TRY THE NEXT ONE * XOR ID3,I ZAP THE USAGE FLAGS STA ID3,I AND RESTORE THE WORD JSB INLST INITIALIZE LSTX CLSUT JSB LSTX SET CURRENT LST ADDRESSES JMP TRID3 TRY NEXT IDENT * CCA ADA TIDNT GET IDENT INDEX CPA .LST4,I ENT/EXT BELONGS TO CURRENT PROG? CLB,RSS YES - CONTINUE JMP CLSUT TRY NEXT LST ENTRY * STB .LST5,I CLEAR SYMBOL VALUE JMP CLSUT CONTINUE CLEARING BP LINK ADDR. SKP * * PACK THE CP LINK AREA * * CCPLK PACKS THE CURRENT PAGE LINK AREA TO GET RID OF LINK * AREAS THAT ARE NO LONGER ACTIVE. * * CALLING SEQUENCE: * * LDA CURRENT PAGE ADDRESS * JSB CCPLK * * RETURN REGISTERS MEANING LESS * * CCPLK WILL DELETE ALL LINK AREAS THAT ARE ABOVE * CPLS AND REFER TO AN AREA ON A PAGE BELOW THE PAGE * ADDRESS IN A ON ENTRY. IT WILL ALSO DELETE ALL * ENTRIES FOR ZERO LENGTH AREAS. * CCPLK NOP AND M0760 SA&VE THE CMA,INA PAGE STA CPAG ADDRESS LDA CPLS GET THE LOWEST ENTRY TO SAVE STA TCCP4 SAVE FOR LAST VALID ENTRY JSB LNKS SET UP THE LNK AREA JSB LNK GET THE FIRST POSSIBLE PURGE AREA JMP CCPLK,I IF NONE THEN EXIT * LDA LNK1,I IF THIS AREA CPA LNK2,I IS OF ZERO LENGTH JMP CCPL0 GO SET UP * AND M0760 ELSE IF AREA IS ABOVE OR EQUAL ADA CPAG TO THE SAVE PAGE AREA SSA,RSS THEN JMP CCPLK,I EXIT - NO PACK NEEDED * CCPL0 LDA LNK1 SET UP THE NEXT AVAILABLE CCPL1 STA TCCP1 POINTER CCPL5 JSB LNK GET THE NEXT ENTRY JMP CCPL3 IF NONE GO HANDLE * LDA LNK1,I IF STILL CPA LNK2,I A ZERO ENTRY JMP CCPL5 REJECT THE ENTRY AND M0760 ISOLATE THE PAGE ADDRESS ADA CPAG IF STILL SSA BELOW THE SPECIFIED PAGE JMP CCPL5 REJECT THE ENTRY * LDA TCCP1 KEEP THE AREA STA TCCP4 SET LAST AREA POINTER STA TCCP2 SET MOVE POINTER LDA LNK2,I SET UP THE CMA,INA ADA LNK1,I MOVE STA TCCP3 COUNT LDA LNK1,I SET WORDS STA TCCP2,I ONE ISZ TCCP2 LDA LNK2,I TWO STA TCCP2,I ISZ TCCP2 LDA TCCP2 AND INA STA TCCP2,I THREE LDB LNK3,I MOVE CCPL2 ISZ TCCP2 THE LDA B,I IMAGE STA TCCP2,I TO THE NEW LOCATION INB ISZ TCCP3 JMP CCPL2 * LDA LNK1 AND CPA CPL2 CPL2 JMP CCPL3 IF END GO DO SPECIAL * LDA TCCP2 UPDATE INA FOR THE NEXT ENTRY JMP CCPL1 AND GO DO IT * CCPL3 LDB TCCP4 SET UP STB CPL2 CPL2, THE UPPER LIMIT JMP CCPLK,I AND EXIT SPC 2 TCCP1 NOP TCCP2 NOP TCCP3 NOP TCCP4 NOP CPAG NOP M0760 OCT 076000 SKP * * H GENERATE INT ENTRY,KEYWD,ID SEG * * GENID GENERATES THE CURRENT ID SEGMENT AND KEYWORD * FOR THE PROGRAM LOADED. IN ADDITION, IT GENERATES THE * LINKAGE REQUIRED IN THE INTERRUPT TABLE FOR THOSE PROGRAMS * WHICH ARE TO BE SCHEDULED UPON RECEIPT OF AN INTERRUPT. * * CALLING SEQUENCE: * A = 0 (GENERATE SHORT ID SEGMENT) * -1 (GENERATE LONG ID SEGMENT) * -2 (GENERATE BLANK LONG ID SEGMENT) * B = IGNORED * JSB GENID * * RETURN: CONTENTS OF A AND B ARE DESTROYED * * NOTE: CHANGED FOR RTE-III, BUT COMPATIBLE WITH RTE-II. * ABS ADDR OF ID SEGMENT IN TARGET SYSTEM IS SAVED * IN IDENT WORD 8 FOR LATER ACCESS TO ID-SEG. * GENID NOP STA PLFLG SAVE ID SEGMENT LENGTH FLAG CPA N2 IF BLANK GEN JMP BLID GO SEND THE KEY WORD SPC 1 ****************** NEW FOR RTE-III ******************** LDB SYSAD GET START ADDR FOR ID-SEG LDA PLFLG IS THIS A SHORT SZA,RSS ID-SEGMENT? ADB #IREG YES, ADD OFFSET FOR I-REGS STB SCH3 SAVE START ADDR IN A TEMP STB SYSAD AND UPDATE BASE STB CURAI UPDATE OUTID PTR TOO. ************************************************************** SPC 1 * * GENERATE INT ENTRY FOR USER SYS * LDA AILST GET THE ADDRESS OF INT IMAGE STA CURAL SET CURRENT INT ADDRESS LDA CINT GET NO. OF INT ENTRIES CMA,INA,SZA,RSS SKIP - INT NOT EMPTY JMP STKEY GENERATE KEYWORD, ID SEGMENT STA TCNT SAVE TOTAL INT COUNT GETIT LDA CURAL,I GET CURRENT WORD IN INT CMA,INA TEST NEGATIVE ENTRIES FOR ILIST CPA IMAIN EQUAL TO MAIN IDENT INDEX? RSS YES - CONTINUE JMP NOTPN IGNORE REF IF NOT CURRENT MAIN * LDA SYSAD GET ID SEG ADDRESS CMA,INA GET 2'S COMPLEMENT FOR INT ENTRY LDB AILST COMPUTE THE INT CORE CMB,INB ADDRRESS ADB CURAL = ILST OFFSET PLUS ADB AINT ACTUAL CORE ADDRESS JSB LABDO SENT THE ENTRY TO THE DISC NOTPN ISZ CURAL STEP TO THE NEXT ENTRY ISZ TCNT SKIP - INT EXHAUSTED JMP GETIT ANALYZE NEXT INT ENTRY * * GENERATE KEYWORD STKEY LDA IMAIN GET MAIN IDENT INDEX STA TIDNT SET ADDRESS FOR IDX JSB IDX SET IDENT ADDRESSES JSB ABORT NO IDENT FOUND SPC 1 LDB SYSAD CCA ADA TIDNT GET IDENT POINTER CPA SCH1 SCHEDULE PGM? STB SCH4 YES - SAVE ITS ID ADDRESS BLID LDA SYSAD GET THE ID-ADDRESS TO A LDB CURAK AND THE CURRENT CORE ADDRESS JSB LABDO TO B AND OUTPUT TO THE DISC STB CURAK SET THE NEW ADDRESS LDB SYSAD GET THE ADDRESS LDA PLFLG GET THE ID SEGMENT LENGTH FLAG ADB P22 ADJUST FOR NEXT ID SEGMENT ADDR SZA SKIP - SHORT ID SEGMENT ADB P6 ADJUST FOR LONG ID SEGMENT STB SYSAD SET NEXT ID SEGMENT ADDRESS * * GENERATE ID SEGMENT * LDA PLFLG IF FLAG = -2 FOR CPA N2 BLANK OUTPUT, JMP GENID,I EXIT SPC 1 ************************* NEW FOR RTE-III ******************** LDA KEYAD SAVE KEYWORD CMA OFFSET FOR ADA CURAK LATER ACCESS TO ID-SEG. STA ID8,I (TEMP SAVE) ************************************************************** LDB N6 JSB ZOUT OUTPUT ZEROES TO ID SEGMENT LDA CUPRI GET THE CURRENT PRIORITY JSB OUTID OUTPUT WORD TO ID SEGMENT BUFFER LDA PRENT GET PRIMARY ENTRY POINT JSB OUTID OUTPUT WORD TO ID SEGMENT BUFFER LDB N2 JSB ZOUT OUTPUT ZEROES TO ID SEGMENT LDA SCH3 GET ADDRESS OF CURRENT ID SEG INA STEP TO PRAM LIST JSB OUTID OUTPUT B REG TO ID SEGMENT  CLA SEND E/O REGS TO JSB OUTID THE ID SEGMENT LDA ID1,I GET NAME 1,2 JSB OUTID OUTPUT WORD TO ID SEGMENT BUFFER LDA ID2,I GET NAME 3,4 JSB OUTID OUTPUT WORD TO ID SEGMENT BUFFER LDA ID6,I GET TYPE AND M7 ISOLATE TYPE STA B SAVE TYPE IN B LDA ID3,I GET NAME 5 AND M7400 ISOLATE NAME 5 IOR B ADD TYPE TO NAME 5 JSB OUTID OUTPUT WORD TO ID SEGMENT BUFFER CLA PRESET FOR DORMANT CCB ADB TIDNT IF THIS PGM TO BE CPB SCH1 SCHEDULED CLA,INA SET SCHEDULED FLAG JSB OUTID SET WORD IN ID CLA SET TIME LINK JSB OUTID TO ZERO AND OUTPUT LDA MULR GET RESOLUTION CODE, EXEC MULT JSB OUTID OUTPUT WORD TO ID SEGMENT BUFFER LDA TTIME GET LOW PART OF TIME JSB OUTID OUTPUT LS TO ID SEG LDA TIME1 GET HIGH HALF JSB OUTID OUT MS HALF TO ID SEG LDB N2 ZEROS TO JSB ZOUT ID SEG 21 AND 22 ISZ PLFLG SKIP - PUTOUT LONG ID SEGMENT JMP GENID,I RETURN - SHORT ID SEGMENT * LDA PPREL GET CURRENT PROG RELOC ADDRESS ADA BSSDP ADD INITIAL PROG DISPLACEMENT IFZ **** BEGIN DMS CODE **** LDB ID1,I LOOK FOR FMGR ID-SEG CPB "FM" RSS JMP WRD23 LDB ID2,I CPB "GR" RSS JMP WRD23 STA B SAVE A-REG LDA ID3,I AND M1774 ISOLATE UPPER HALF SWP RESORE A-REG CPB LBLNK RSS JMP WRD23 * STA MEM12 LATER USED TO SET BKDRA ADA M1 STA MEM6 " " " " RTDRA STA SYMAD " " " " AVMEM INA RESTORE ***** END DMS CODE ***** XIF WRD23 JSB OUTID OUTPUT WORD TO ID SEGMENT BUFFER LDA TPREL GET CURRENT RELOCATION ADDRESS CMA,INA ; CHECK ADA LWASM MEMORY OVERFLOW SSA,INA,SZA OK IF POS OR -1 JMP ER18 YES GO SEND THE BITCH * LDA TPREL NO SEND THE UPPER LIMIT GENI9 JSB OUTID OUTPUT WORD TO ID SEGMENT BUFFER LDA PBREL GET LOW BP RELOCATION ADDR JSB OUTID OUTPUT WORD TO ID SEGMENT BUFFER LDA TBREL GET HIGH BP RELOCATION ADDR JSB OUTID OUTPUT WORD TO ID SEGMENT BUFFER LDA DSKMN GET INITIAL MAIN DISK ADDRESS JSB OUTID OUTPUT WORD TO ID SEGMENT BUFFER CLA JSB OUTID OUTPUT WORD TO ID SEGMENT BUFFER JMP GENID,I RETURN - ID SEGMENT OUT * SPC 1 ER18 LDA ERR18 SEND ERROR 18 JSB GN.ER MEMORY OVERFLOW LDA LWASM USE LAST WORD OF MEMORY INSTEAD JMP GENI9 GO FINISH THE ID-SEGMENT * ERR18 ASC 1,18 IFZ **** BEGIN DMS CODE **** "FM" ASC 1,FM "GR" ASC 1,GR LBLNK OCT 020000 M1774 OCT 177400 ***** END DMS CODE ***** XIF SKP * * OUTPUT ZERO TO IDBUF * * ZOUT PUTS OUT ZEROES TO THE ID SEGMENT BUFFER. * * CALLING SEQUENCE: * A = IGNORED * B = NO. OF ZEROES TO GO OUT (NEG.). * JSB ZOUT * * RETURN: CONTENTS OF A AND B ARE DESTOYED. * ZOUT NOP STB TCNT SAVE NO. OF ZEROES TO GO OUT CLA JSB OUTID OUTPUT ZERO TO IDBUF ISZ TCNT SKIP - ALL ZEROES OUT JMP *-3 CONTINUE ZERO OUTPUT TO IBUF JMP ZOUT,I RETURN SPC 2 GNSID NOP GENERATE SHORT SEGMENT ID-SEGMENTS STA PLFLG SAVE THE FLAG LDB SKEYA GET THE KEYWORD LDA SISDA ADDRESS AND ITS CONTENTS JSB LABDO SEND THE KEY WORD TO THE DISC STB SKEYA SET THE NEW KEYWORD ADDRESS LDB SISDA GET THE ID- ADDRESS ADB P9 ADDJUST FOR NEXT TIME STB SISDA AND SAVE ADB P2 ADDJUST FOR ADDRESS OF CURRENT ID LDA PLFLG THIS A CPA N2 BLANK SHORTY? JMP BLSID YES GO DO BLANK THING * LDA PRENT NO GET THE PRYMARY ENTRY POINT JSB LABDO SEND IT TO THE DISC LDA IMAIN GET THE IDENT INDEX STA TIDNT TO CURRENT JSB IDX JSB ABORT BETTER BE ONE LDA ID1,I GET NAME 1,2 JSB LABDO SEND TO THE DISC LDA ID2,I GET NAME 3,4 JSB LABDO SEND IT LDA ID3,I GET NAME 5 AND M7400 MASK IOR P21 SET TYPE AND SHORT FLAG JSB LABDO SEND IT TO THE DISC LDA BSPAD GET THE MEMORY ADDRESS ADA BSSDP ADDJUST FOR LEADING BSS JSB LABDO SEND MAIN 1 LDA TPREL GET AND CMA,INA CHECK FOR MAIN MEMORY ADA LWASM OVER FLOW SSA,INA,SZA IF OVER FLOW JMP BLSI3 GO REPORT IT * LDA TPREL OK SO PUT IT OUT BLSI0 JSB LABDO SEND MAIN 2 LDA BSBAD GET AND JSB LABDO SEND BP 1 LDA TBREL GET AND JSB LABDO SEND BP 2 LDA DSKMN GET DISC ADDRESS BLSI2 JSB LABDO JMP GNSID,I RETURN * BLSID ADB P3 FOR BLANK LDA P16 SET THE SHORT BIT ONLY JMP BLSI2 GO SEND IT. * BLSI3 LDA ERR18 SEND ERROR MESSAGE STB SIDS2 SAVE POINTER TO ID SEG JSB GN.ER LDB SIDS2 LDA LWASM USE LAST WORD OF MEMORY INSTEAD JMP BLSI0 GO FINISH THE ID-SEGMENT * SIDS2 BSS 1 SKP * * OUTPUT ID SEGMENT WORD TO IBUF * * OUTID PACKS THE WORDS FOR THE ID SEGMENTS IN THE ID SEGMENT * BUFFER AND WRITES THE BUFFER ON THE DISK WHEN IT CONTAINS * 64 WORDS. * * CALLING SEQUENCE: * A = CURRENT ID SEGMENT WORD * B = IGNORED * JSB OUTID * * RETURN: CONTENTS OF A AND B ARE DESTROYED * OUTID NOP LDB CURAI GET THE CURRENT ID-SEGMENT ADDRESS JSB LABDO SEND THE WORD TO THE DISC STB CURAI SET THE ADDRESS FOR NEXT TIME JMP OUTID,I RETURN SKP * * OUTPUT REST (IF ANY) OF ABS. REC * * REMDO PUTS OUT THE CURRENT SECTOR IF IT CONTAINS ANY WORDS OF * ABSOLUTE CODE. THIS IS NORMALLY DONE ONLY AT THE END OF THE GEN * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB REMDO * * RETURN: CONTENTS OF A AND B ARE DESTROYED. * REMDO NOP LDA OLDDA GET THE CURRENT DISC ADDRESS LDB ADBUF AND THE BUFFER ADDRESS SSA IF A GOOD ADDRESS JSB DISKO OUTPUT THE CODE JSB BPDSA UPDATE THE DISC ADDRESS JMP REMDO,I RETURN SPC 3 * BPDSA ADVANCES THE DISK ADDRESS TO THE NEXT EVEN * DISC ADDRESS ASSUMING THE CURRENT DISC ADDRESS * IS NOT AVAILABLE. THIS IS NORMALLY DONE * AFTER EACH MAIN IS LOADED AND BEFORE THE BASE * PAGE IS OUTPUT. * * CALLING SEQUENCE: * * JSB BPDSA DOES NOT USE A/B RETURNS A=CURRENT DISC ADDRESS * BPDSA NOP LDA DSKAD BUMP JSB DISKA THE DISC ADDRESS STA DSKAD AND RESET IT JSB DSKEV MAKE SURE IT IS EVEN JMP BPDSA,I RETURN SKP * CHBND IS A ROUTINE TO ASK THE OPERATOR IF HE WANTS TO CHANGE * A BOUNDRY, GET HIS ANSWER AND CHECK IT FOR LEGALITY. * THE MESSAGES SENT ARE: * * XXXXXXXXXX YYYYY AND * CHANGE XXXXXXXXXX? WHERE XXXXXXXXXX IS A 10 CHARACTER * MESSAGE SUPPLIED AS PART OF THE CALL * AND YYYYY IS THE CURRENT BOUND IN OCTAL * OR DECIMAL. * LEGAL RESPONSES ARE: * * 0 NO CHANGE. * N WHERE N>YYYYY AND LESS THAN OR EQUAL TO * THE SUPPLIED LIMIT. * * CALLING SEQUENCE: * A = CURRENT YYYYY A > 0 MEANS OCTAL * JSB CHBND A < 0 MEANS DECIMAL(ONE'S COMPLEMENT) * DEF ADDRESS OF XXXXXXXXXX (5 WORD MESSAGE) * DEF UPPER LIMIT OF RESPONSE * * RETURN (ALWAYS P+3) A = NEW BOUND. * CHBND NOP STA CBFLG SAVE DECIMAL FLAG SSA SKIP IF OCTAL REQUEST,ELSE INA MAKE DEC, REQUEST 2'S COMPLMNT STA TMPX SAVE DEFAULT VALUE LDB CHBND,I GET THE MESSAGE ADDRESS AND STB TMPL SET UP TO MOVE LDA N5 FIVE WORDS STA GN.ER TO FORM THE MESSAGE: LDB DMES " CHANGE XXXXXXXXXX YYYYY" CHNX LDA TMPL,I MOVE STA B,I 5 INB WORDS ISZ TMPL TO ISZ GN.ER THE JMP CHNX MESSAGE * ISZ CHBND INDEX TO THE UPPER LIMIT STB TMPL SAVE THE ADDRESS FOR RETRY IN CASE CHOVR LDB TMPL OF ERROR LDA TMPX CONVERT THE NUMBER JSB CONVD TO THE BUFFER JSB SPACE SEND A SPACE LDB DMES GET THE ADDRESS LDA P16 AND SEND MESSAGE JSB DRKEY "XXXXXXXXXX YYYYY" TO THE TTY LDA "?" PUT A "?" AFTER THE XXXXXXXXXX STA ME11S SET IT LDA P19 SEND MESSAGE AND GET LDB ADMES RESPONSE FOR JSB READ " CHANGE XXXXXXXXXX?" LDA P5 CONVERT RESPONSE LDB CBFLG LOAD FLAG SSB DECIMAL REQUEST?? CMA,INA YES, ASK GETOC FOR DECIMAL JSB GETOC GET BINARY EQUIVALENT JMP CBERR ERROR - REPEAT * JSB GETAL END OF BUFFER? SZA,RSS JMP CHOK YES OK- * CBERR LDA ERR14 SEND ERROR 14 JSB GN.ER JMP CHOVR AND REPEAT * CHOK LDA OCTNO GET VALUE SZA,RSS IF ZERO USE LDA TMPX SUPPLIED VALUE LDB TMPX GET -ABS VALUE SSB,RSS OF UPPER LIMIT. CMB,INB SSA GET ABS VALUE OF CMA,INA CURRENT TOO. ADB A IF LIMIT LESS THAN SSB CURRENT THEN JMP CBERR ERROR * LDB CHBND,I GET UPPER BOUND LDB B,I TO B CMB IF GREATER THAN ADB A i MAX SSB,RSS THEN JMP CBERR ERROR * ISZ CHBND ELSE EXIT JMP CHBND,I RETURN VALUE IN A SPC 2 ERR14 ASC 1,14 BG BOUNDARY ERROR CBFLG BSS 1 DECIMAL/OCTAL FLAG TMPX NOP TMPL NOP DMES DEF .XXX ADMES DEF *+1 ASC 4, CHANGE .XXX BSS 5 ME11S NOP BSS 3 "?" ASC 1,? P19 DEC 19 SKP IFZ **** BEGIN DMS CODE **** * * ALIGN - PRINT CURRENT BOUNDARY THEN ASK USER * IF HE WANTS TO ALIGN AT A PAGE BOUNDARY * * FORM OF MESSAGE: XXXXX * ALIGN AT NEXT PAGE? * * CALLING SEQUENCE: * LDA XXXXX (BINARY...A<0 MEANS DECIMAL) * LDB ADDR TO INSERT XXXXX IN * JSB ALIGN * DEF * * NOTE: IS CHARACTER LENGTH FOLLOWED * BY ASCII TEXT. * * RETURN: AT N+2 * B IS DESTROYED * A IS OLD OR UPDATED VALUE OF XXXXX. * SPC 1 ALIGN NOP STA ATMP1 SAVE ORIGINAL BOUND STB ATMP2 AND SPOT IN MESSAGE BUFF JSB SPACE SKIP A LINE JSB APRNT AND PRINT OLD BOUNDARY. ALIG1 LDB MSAL. LDA P19 SEND ALIGN QUESTION JSB READ AND READ ANSWER. JSB YE/NO JMP ALIG1 REPEAT QUERY IF BAD RESPONSE. JMP ALNO JUMP IF HE SAID NO. SPC 1 * USER SAID ALIGN SPC 1 LDA ATMP1 PICK UP ORIG BOUNDARY, IOR M1777 ROUND TO PAGE END, STA ATMP1 AND SAVE, LDB ATMP2 THEN GO PRINT NEW JSB APRNT BOUNDARY. SPC 1 * USER SAID DON'T ALIGN SPC 1 ALNO LDA ATMP1 PASS BACK BOUNDARY ISZ ALIGN AND RETURN JMP ALIGN,I TO CALLER. SPC 1 * SEND MESSAGE ROUTINE SPC 1 APRNT NOP LDA ATMP1 PICK UP XXXXX IN BINARY LDB ATMP2 AND ADDR FOR INSERT,  JSB CONVD STUFF XXXXX IN MSG LDB ALIGN,I POINT TO MESSAGE, LDA B,I GET LEN TO A, INB AND TEXT ADDR TO A, JSB DRKEY AND PRINT IT JMP APRNT,I RETURN SPC 2 ATMP1 BSS 1 ATMP2 BSS 1 SPC 1 MSAL. DEF *+1 ASC 10,ALIGN AT NEXT PAGE? M1777 OCT 1777 SPC 1 MSMR DEC 32 ASC 16,LWA MEM RESIDENT PROG AREA XXXXX MSMRX DEF MSMR+14 SPC 1 MSBG DEC 20 ASC 10,LWA BG COMMON XXXXX MSBGX DEF MSBG+8 SPC 1 ***** END DMS CODE ***** XIF SKP * THIS ROUTINE IS CALLED AFTER THE SYSTEM IS LOADED BUT BEFORE THE * LIBRARY. SPC 1 * CLEAR LOAD FLAGS FOR TYPE 6 PGMS * CLRT6 NOP * SET LIBRARY RESIDENT FLAGS JSB INIDX INITIALIZE IDX SETLX JSB IDX SET IDENT ADDRESSES JMP CLRT6,I END OF IDENTS LDA ID6,I GET TYPE AND M177 ISOLATE TYPE CPA P14 IF FOURCED CORE RES. RSS PROCESS CPA P6 TYPE = LIBRARY? RSS YES - CONTINUE JMP SETLX PROCESS NEXT IDENT * LDA ID3,I TYPE = 6 - GET LOAD FLAG RAR,CLE,ELA LOAD BIT TO E - AND CLEARED STA ID3,I RESET CLEARED FLAG SEZ,RSS WAS IT LOADED? JMP SETLX NO - CONTINUE LDA ERR39 YES - ILLEGAL SYSTEM REFERENCE JSB GN.ER GN.ER 39 LDA P5 NOW SEND THE NAME LDB ID1 OF THE CALLED PGM JSB DRKEY SPC 1 JSB INLST INITIALIZE LSTX SETUX JSB LSTX SET CURRENT LST ADDRESSES JMP SETLX END - CONTINUE ID SCAN CCA ADA TIDNT GET IDENT ADDRESS CPA .LST4,I ENT BELONGS TO CURRENT PROG? CLA,RSS YES - CONTINUE JMP SETUX NO - TRY NEXT ENT STA .LST5,I SET LINK TO ZERO. JMP SETUX CONTINUE SEARCH SPC 2 * DEMOTES UNCALLED TYPE 6 PHFBROGRAMS TO TYPE 7 * DEMTL NOP DEMOTE UNCALLED TYPE 6 TO TYPE 7 LDA P10 SET UP THE SCAN STA CIDNT PARAMETERS LDA P6 FOR TYPE 6 STA PTYPE SCAN DEMS JSB IDSCN GO SET ID ADDRESSES JMP DEMTL,I END - SO RETURN LDB ID3,I WAS PGM SLB,RSS LOADED? ISZ ID6,I NO; CHANGE TO TYPE 7. JMP DEMS YES/NO CONTINUE SCAN * ERR39 ASC 1,39 * * END LABS HASMB,Z,R,L,C HED RTGN4 - LOADER SEGMENT. IFN ASSEMBLY OPTION "N" FOR RTE-II NAM RT2G4,5,90 92001-16031 REV.1826 780508 XIF IFZ ASSEMBLY OPTION "Z" FOR RTE-III NAM RT3G4,5,90 92060-16037 REV.1826 780508 XIF SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 2 SPC 1 ****************************************************** * * NAME: RT2G4/RT3G4 * SOURCE PART #: 92001-18031/92060-18037 * REL PART #: 92001-16031/92060-16037 * WRITTEN BY: KFH, JH, GAA * ****************************************************** SPC 1 * * ENTRY POINT NAMES * ENT NLOAD,LODER * * EXTERNAL REFERENCE NAMES * EXT INLST,LSTX,LSTS,TLST EXT .NM. EXT .LST1,.LST2,.LST3,.LST4,.LST5 EXT INIDX,IDX,TIDNT EXT ID1,ID2,ID3,ID4,ID5,ID6,ID7 EXT FIXX,FIX,PFIX,TFIX EXT FIX1,FIX2,FIX3,FIX4 EXT LNKX,LNK,LNKS EXT LNK1,LNK2,LNK3 EXT FMRR,CHFIL * EXT CPLIM,ADBP,EOBP,LWSBP,#IREG EXT LBUF,TBUF,CURAL,CPL2,PPREL EXT $RNT,$PRV EXT CONVD,SPACE,RDBIN,DRKEY,GN.ER,ABORT EXT LABDO,SWRET EXT OPEN,READF,CLOSE,NMDCB,RDNAM EXT PTYPE,DSKAD,ABCOR,MXABC,TTIME,MULR * A EQU 0 B EQU 1 SUP ************************************************************************ * SKP * THE FOLLOWING BLOCK OF STORAGE FOR VARIABLES PRECEEDS, * AND IS REFERENCED BY, EACH SEGMENT. IT IS NOT OVERLAID * AS EACH NEW SEGMENT IS LOADED INTO CORE. * * THE LOCATION OF EACH VARIABLE MUST BE THE SAME IN * ALL SEGMENTS. IF A CHANGE IS MADE, MAKE THE SAME * CHANGE IN THE REST OF THE SEGMENTS. * * * SYSCH BSS 1 SUBCHANNEL OF SYSTEM UNIT. AUXCH BSS 1 SUBCHANNEL OF AUX UNIT. DSIZE BSS 1 DISK SIZE -NO. OF TRACKS. DAUXN BSS 1 AUXILIARY DISK SIZE. ADS# BSS 1 AUX DISC SECTORS/TRACK. * * RELOCATION BASE TABLE. RBTA BSS 1 ABSOLUTE PROGRAM BASE. TPREL BSS 1 CURRENT PROGRAM BASE ADDRESS. TPBRE BSS 1 BASE PAGE RELOCATION ADDRESS. COMAD BSS 1 CURRENT COMMON RELOCATION BASE. BSS 1 ABS PROGRAM BASE FOR MR CODE. * WDCNT BSS 1 TEMPORARY WORD COUNTER. DSKSY BSS 1 INITIAL ID SEGMENT DISK ADDRESS IDSP BSS 1 POSITION OF 1ST ID SEG. IN SECT TTYCH BSS 1 SYSTEM TTY CHANNEL NO. * PLFLG BSS 1 PROGRAM LOAD. FLAG = -1/0 = L/NL DSCNT BSS 1 DISK SEGMENT SECTOR COUNT * NXFLG BSS 1 ENT/EXT FLAG = -1/0 EXCNT BSS 1 SYMBOL COUNTER * LCNT BSS 1 CURRENT LBUF COUNT DCNT BSS 1 CURRENT DBUF COUNT CURAI BSS 1 CURRENT IBUF COUNT * CPLS BSS 1 ADDRESS OF TOP OF FIXED CP LINK IMAGE CPL1 BSS 1 ADDRESS OF LOW CURRENT PAGE LINK SPECS. CPL1H BSS 1 NUMBER OF CURRENT PAGE LINKS ASSIGNED CPL2H BSS 1 IN LOW AND HIGH AREA RESPECTIVELY URBP1 BSS 1 LWA R/T DISC RES BP LINK AREA BPMAX BSS 1 MAX USED BASE PAGE LINKAGE +1 CURAK BSS 1 CURRENT KBUF ADDRESS * CURAT BSS 1 CURRENT TBUF ADDRESS TCNT BSS 1 CURRENT TBUF COUNT * CURAP BSS 1 CURRENT PLIST ADDRESS * AMAD BSS 1 CURRENT MLIST ADDRESS * LICNT BSS 1 LONG ID SEGMENT COUNT SICNT BSS 1 SHORT ID SEGMENT COUNT SSCNT BSS 1 BG. SEG ID COUNT COMRT BSS 1 MAXIMUM RT COM LENGTH COMBG BSS 1 MAX BG COM LENGTH * DSKEY BSS 1 CURRENT KEYWORD DISK ADDRESS DSKID BSS 1 DISK ID SEGMENT ADDRESS KEYCN BSS 1 =? TOTAL KEYWORD COUNT KEYCT BSS 1 CURRENT KEYWORD COUNT * MLIST BSS 11 MEMORY MAP BUFFER * TEMP1 BSS 1 TEMP2 BSS 1 LWH1 BSS 1 LWH2 BSS 1 LWH3 BSS 1 LWH4 BSS 1 L01 BSS 1 * FSYBP BSS 1 FIRST WORD SYS BP LINKAGE SYSAD BSS 1 CURRENT ID SEGMENT ADDRESS * TBREL BSS 1 CURRENT BP RELOC ADDR PBREL BSS 1 INITIAL BP RELOC ADDR * RELAD BSS 1 CURRENT CORE RELOCATION ADDRESS * BSBAD BSS 1 BG SEGMENT BP RELOC ADDR BSPAD BSS 1 BG SEGMENT PROG RELOC ADDR * LFLAG BSS 1 PROGRAMS-LOADED FLAG IMAIN BSS 1 CURRENT MAIN IDENT INDEX. HDFLG BSS 1 HEADING FORMAT FLAG CIDNT BSS 1 CURRENT MAIN IDENT INDEX. * AEQT BSS 1 ADDRESS OF EQUIPMENT TABLE CEQT BSS 1 NO. ENTRIES IN EQUIPMENT TABLE * ASQT BSS 1 ADDR OF DEVICE REFERENCE TABLE CSQT BSS 1 NO. ENTRIES IN DEV. REF. TABLE * AINT BSS 1 ADDRESS OF INTERRUPT TABLE CINT BSS 1 NO. ENTRIES IN INTERRUPT TABLE * DSKIN BSS 1 DISK ADDR OF INT CODE RECORD INTCN BSS 1 RECORD COUNT OF INT CODE * CURIL BSS 1 CURRENT ILIST ADDRESS ILIST BSS 64 USER SYSTEM PROG IDENT ADDR LIST * IDSAV BSS 1 INDEX OF CURRENT IDENT. DSKMN BSS 1 INITIAL MAIN DISK ADDRESS BSSDP BSS 1 INITIAL DISK RES MAIN BSS DISP PRENT BSS 1 PRIMARY ENTRY POINT DBLAD BSS 1 CURRENT DBL ADDRESS REKEY BSS 1 INSTRUCTION TYPE BYTE INSCN BSS 1 INSTRUCTION TYPE COUNTER INSTR BSS 1 CURRENT INSTRUCTION PAGNO BSS 1 CURRENT PAGE NO. OPRND BSS 1 CURRENT OPERAND PLGTH BSS 1 PROGRAM LENGTH DRT2 BSS 1 DISK DRT ENTRY ( SYSTEM) DRT3 BSS 1 AUX DISK DRT ENTRY LIBFG BSS 1 LDTYP BSS 1 SCH1 BSS 1 INDEX OF IDENT OF PGM TO BE SCHEDULED SCH3 BSS 1 ADDRESS OF CURRENT ID SEGMENT SCH4 BSS 1 ADDRESS OF THE SCHEDULED PGM ID SEG FGBGC BSS 1 v BACKGROUND USING FG COMMON FLAG $LIBR BSS 1 INDEX OF $LIBR ENT $LIBX BSS 1 INDEX OF $LIBX ENT CUPRI BSS 1 * MEM1 BSS 1 MEM2 BSS 1 MEM3 BSS 1 MEM4 BSS 1 MEM5 BSS 1 MEM6 BSS 1 MEM7 BSS 1 MEM8 BSS 1 MEM9 BSS 1 MEM10 BSS 1 MEM11 BSS 1 MEM12 BSS 1 * IFZ ***** BEGIN MEU CODE ***** COMSZ BSS 1 #WORDS COMMON DECLARED FOR * CURRENT MAIN LPCOM BSS 1 LAST PAGE CONTAINING ANY COMMON FPSAM BSS 1 1ST PAGE CONTAINING S.A.M. FWSAM BSS 1 1ST WORD CONTAINING S.A.M. LPSYS BSS 1 LAST PAGE CONTAINING SYS OR LIB FPDSK BSS 1 1ST PAGE DISK PART AREA LOLNK BSS 1 LOW LINK FOR SSGA,LIB, OR SYS HILNK BSS 1 HI LINK USED BY MEM RES PRG BPINC BSS 1 CURR DIRECTION FOR BP LINK * ALLOCATION. +1=UP,-1=DOWN BPLMT BSS 1 WORD AFTER LAST WORD AVAIL * FOR BP LINK ALLOCATION TPMAX BSS 1 HWM FOR RELOCATION OF BG * MAINS AND SEGS MAXPT BSS 1 NUM PARTS. ALLOWED MAT. BSS 1 ADR OF LENGTH WORD * BEFORE MEM ALLOC TABLE (MAT) SSGA. BSS 1 FWA SSGA (LAST WORD SYS * OR LIB +1) FWMRP BSS 1 FWA MEM RES PROG AREA * (NEXT WORD AFTER COMMONS) MAP. BSS 1 PTR TO MEU RES MAP MPFT. BSS 1 PTR TO MPFT ****** END MEU CODE ****** XIF * SECTR BSS 0 BOOTSTRAP BUFFER FORMAT * LBPSY BSS 1 LOWER SYSTEM BP ADDRESS UBPSY BSS 1 UPPER SYSTEM BP ADDRESS DSKBP BSS 1 SYS BP DISK ADDRESS * LRMAN BSS 1 MAIN RESIDENT LOWER ADDRESS URMAN BSS 1 MAIN RESIDENT UPPER ADDRESS DSKRR BSS 1 MAIN RESIDENT DISK ADDRESS * LBMAN BSS 1 MAIN BG LOWER ADDRESS UBMAN BSS 1 MAIN BG UPPER ADDRESS DSKBG BSS 1 MAIN BAC5KGROUND DISK ADDRESS * SYMAD BSS 1 AVAIL SYS MEM ADDR BGBND BSS 1 BACKGROUND BOUNDARY * DSKAV BSS 1 NEXT AVAILABLE DISK ADDRESS DSKLC BSS 1 DISK ADDRESS OF LIBRARY CODE DSKLB BSS 1 DISK ADDR OF LIBRARY ENTRY PTS DSKUT BSS 1 UTILITY PROG DISK ADDRESS DSKBS BSS 1 DISK ADDR OF MAIN BG DISK RES BP DSKBR BSS 1 CURRENT MAIN BG DISK RES DISK AD ADICT BSS 1 ADDR OF DISK DICTIONARY LBCNT BSS 1 RESIDENT LIBR ENTRY PT COUNT UTCNT BSS 1 UTILITY LIBRARY COUNT KEYAD BSS 1 CURRENT KEYWORD ADDRESS RTCAD BSS 1 RT COM CORE ADDRESS LBCAD BSS 1 LIBRARY CODE ADDRESS SYBAD BSS 1 ADDR OF FIRST BP LINK FOR BG IDSAD BSS 1 ADDR OF FIRST ID SEGMENT ABSID BSS 1 IDENT ADDR FOR NEXT BG SEG SCAN MAXRP BSS 1 MAXIMUM RT DISK RESIDENT PROG MAXRB BSS 1 MAXIMUM RT DISK RESIDENT BP IDMBS BSS 1 BG MAIN ADDRESS FOR BS REF * TB30 BSS 128 TRACK MAP TABLE #SUBC BSS 1 # SUBCHANNELS DEFINED(7905) SPC 2 ********************************************************* * * * END OF COMMON STORAGE BLOCK FOR ALL SEGMENTS. * * * ********************************************************* SPC 2 MRTAD DEF TPREL RBTAD DEF RBTA AMLST DEF MLIST AMEM5 DEF MLIST+5 AMEM8 DEF MLIST+8 SKP * * PROGRAM CONSTANT FACTORS N1 DEC -1 N3 DEC -3 N5 DEC -5 N8 DEC -8 N11 DEC -11 NDAY OCT 177574,025000 P1 DEC 1 P2 DEC 2 P3 DEC 3 P4 DEC 4 P5 DEC 5 P6 DEC 6 P7 DEC 7 P11 DEC 11 P12 DEC 12 P13 DEC 13 P14 DEC 14 P15 DEC 15 P16 DEC 16 P60 DEC 60 P99 DEC 99 P100 DEC 100 P6K DEC 6000 M7 EQU P7 M17 EQU P15 M20 EQU P16 M1760 OCT 176000 M1777 OCT 1777 M7400 OCT 177400 * BLANK OCT 040 BLANK MSIGN OCT 100000 NEGATIVE SIGN SKP LODR NOP * * NOTE THE FOLLOWING RESOLVES ARITHMETIC DEF'S TO EXTERNALS * LDA N GET LOOP COUNTER STA TEMP1 SAVE IN TEMP LOCATION LDB LSTAA GET ADDRESS OF WHERE LIST ROUTINE LOCATED LOOP LDA B,I HERE WE CHASE DOWN OUR OWN RSS LDA A,I RAL,CLE,SLA,ERA JMP *-2 STA B,I AND SAVE IT AGAIN INB ISZ TEMP1 DONE? JMP LOOP NO JMP SWRET RETURN TO MAIN FOR CALL * TO NLOAD OR LODER. * SPC 1 N DEC -3 LSTAA DEF *+1 ATBUF DEF TBUF LBUF5 DEF LBUF+5 ALBUF DEF LBUF SKP SKP * * INITIATE MAIN PROGRAM LOADING * * NLOAD IS THE SUBROUTINE FOR ENTRY TO LODER FOR THOSE * PROGRAMS WHICH REQUIRE USE OF A NEW BP AND PROGRAM BASE. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB LOAD (FROM ANOTHER SEGMENT) * * RETURN: CONTENTS OF A AND B ARE DESTOYED. * NLOAD NOP (WAS "LOAD") IFZ **** BEGIN MEU CODE **** * INDICATE VALIDITY OF SSGA REFERENCES SPC 1 LDA ID6,I TYPE AND M20 LOOK AT SSGA BIT STA SSGAF SET SSGA FLAG (0=NO SSGA USE) ****** END MEU CODE ****** XIF CCB STB HDFLG SET HEADING FLAG LDA ID6,I GET TYPE AGAIN AND M7 JUST PRIMARY BITS LDB PPREL PICK UP BASE ADDR CPA P2 AND IF PROG IS DISK RESIDENT RSS CPA P3 (EITHER RT OR BG) ADB #IREG BUMP BY ENOUGH FOR * INDEX REG STORAGE STB TPREL LDA PBREL GET BP RELOCATION ADDRESS STA TBREL SET CURRENT BP RELOC ADDRESS JSB LODER LOAD PROGRAM LDA LIBFG IF NOT LIB LOAD SZA,RSS THEN JSB SPACE NEW LINE JMP NLOAD,I RETURN IFZ **** BEGIN MEU CODE **** bSSGAF BSS 1 ***** END MEU CODE ***** XIF SKP * * LOAD, LINK MAIN PROG & SUBS. * * LODER IS THE MAIN LOADING SUBROUTINE FOR GENERATING THE ABSOLUTE * CODE AND LINKING ALL CALLED SUBROUTINES. IT IS USED BY EACH * PROGRAM TYPE FOR LOADING. IT READS THE RELOCATABLE RECORDS FROM * THE DESIGNATED FILE, AND WRITES THE ABSOLUTE CODE * INTO THE CORE-IMAGE OUTPUT FILE. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB LOADS (FROM ANOTHER SEGMENT) * * RETURN: CONTENTS OF A AND B ARE DESTOYED. * LODER NOP (WAS "LOADS") JSB SFIX SET UP A FIX UP ENTRY CCA STA PLFLG SET FLAG = NO DBL RECS IN * LOADN LDA TPREL CLEAR THE CP LINK IMAGE JSB CCPLK AREA LDA TPREL SAVE FOR RESET STA LWH4 FOR NEXT PASS LDA TBREL STA LWH3 CLA LOADX STA L01 0 IF 1/2 PASSES, -1 IF 1/1 PASS, 1 IF 2/2 PASSES * LDA LWH3 BP LINK LDB TBREL ADDRESSES JSB CLRLT LDA LWH3 STA TBREL RESTORE TBREL JSB CLIST BLANK MEMORY MAP BUFFER CLA CLEAR THE LIBRARY TRAP STA ADTRP WORDS STA LIBTP LDA AMLST AMLST = ADDR OF MEM MAP BUFFER STA AMAD SET CURRENT MEMORY MAP ADDRESS LDA HDFLG GET HEADING FORMAT FLAG STA TEMP2 SSA,RSS SKIP IF NEGATIVE (MAIN) ISZ AMAD INCR CURRENT MEM MAP ADDR LDA ID1,I GET NAME 1,2 STA AMAD,I SET NAME 1,2 IN MEMORY MAP ISZ AMAD INCR CURRENT MEMORY MAP ADDRESS LDA ID2,I GET NAME 3 4 STA AMAD,I SET NAME 3,4 IN MEMORY MAP ISZ AMAD INCR CURRENT MEMORY MAP ADDRESS LDA ID3,I GET NAME 5 AND M7400 ISOLATE UPPER CHAR IOR BLANK ADD BLANK (OCT 40) STA AMAD,I SET NAME 5 IN MEMORY MAP LDA ID6,I PICK UP TYPE AND M7 MASK TO ACTUAL TYPE.  STA LDTYP * * READ NAM RECORD. * LDA ALBUF READ NAM RECORD FROM FILE. STA CURAL CCB JSB RDNAM JSB ABORT ERROR ON READ. SZA,RSS JSB ABORT END OF FILE. CMA,INA SET COUNT WORD. STA LCNT * LDA ID5,I CHECK IF NAM RECORD HAS RAL A MODIFIED VERSION. SSA,RSS JMP LOADC NO. * JSB OPEN YES. SEARCH NEW NAM FILE DEF *+4 FOR REPLACEMENT RECORD. DEF NMDCB DEF FMRR DEF .NM. FILE NAME = "@.NM.@" * JSB CHFIL JSB ABORT * CREAD JSB READF DEF *+6 DEF NMDCB DEF FMRR DEF LBUF DEF P60 DEF LEN * JSB CHFIL JSB ABORT * LDA LEN BETTER BE THERE! CPA N1 JSB ABORT * LDB ALBUF COMPARE NAM IN LBUF ADB P3 LDA B,I AGAINST CPA ID1,I NAM IN IDENT. INB,RSS JMP CREAD NO MATCH. LDA B,I CPA ID2,I INB,RSS JMP CREAD NO MATCH. LDA B,I XOR ID3,I AND M7400 SZA JMP CREAD NO MATCH. * JSB CLOSE MATCH. DEF *+3 DEF NMDCB DEF FMRR * LOADC JSB ZLOAD LOADING? JMP LH7 NO * LDA L01 SZA 1ST PASS? JMP LH7 YES * ISZ TEMP2 NO - TEST TEMPORARY HDFLG JMP SUBHD * JMP LH8 * LPAR OCT 50 LEFT PAREN. * LH7 ISZ HDFLG TEST REAL THING JMP SUBHD SKIP PRIORITY OUTPUT FOR SUB * LH8 LDA ID6,I SET CURRENT LOAD TYPE AND M17 LOOK AT PRIMARY & REV BITS IFZ ***** BEGIN MEU CODE ***** CPA P5 DON'T CHANGE COMMON JMP COMOK FOR SEGMENTS (USE MAIN'S) LDB ID4,I THIS IS A MAIN STB COMSZ SET HIS COM SIZE AS LIMIT. ****** END MEU CODE ****** XIF + LDB BGBND GET BACKGROUND COMMON BOUND CPA P1 IF FORGROUND RSS CPA P2 RSS CPA P11 OR BACKGROUND USING FORGROUND COMMON IFN *** BEGIN NON-MEU CODE *** RSS CPA P12 RSS CPA P13 NO TYPE 13'S IN RTE-III **** END NON-MEU CODE **** XIF LDB RTCAD USE FORGROUND COMMON ADDRESS STB COMAD SET THE COMMON BASE ADDRESS COMOK LDA DSKAD GET CURRENT DISK ADDRESS LDB L01 SZB,RSS IF 1ST PASS, STA DSKMN SAVE INITIAL MAIN DISK ADDRESS LDA PTYPE IF FOURCED SUBROUTINE AND M17 OR SSGA ROUTINE CPA P14 LOAD JMP SUBHD SEND SUB HEAD MAP * LDA LPAR GET LEFT PAREN (OCT 50) IOR AMAD,I CHANGE NAME 5, BLANK TO NAME 5,( STA AMAD,I SET NAME 5, LEFT PAREN IN MAP LDA LBUF+10 GET PRIORITY FROM THE NAM RECORD SZA,RSS IF ZERO SET LDA P99 TO 99 SZB,RSS UNLESS SYSTEM WHICH CLA SET TO ZERO STA CUPRI SET FOR THE ID-SEG GENERATION CMA,INA SET TO NEGATIVE FOR DECIMAL CONV LDB ATBUF GET MESSAGE ADDRESS JSB CONVD CONVERT TO DECIMAL/OCTAL LDA TBUF+1 GET HIGH TWO CHARACTERS STA MLIST+3 SET IN MAP LDA TBUF+2 GET 2 LEAST SIGNIFICANT DIGITS STA MLIST+4 SET PRIORITY IN MEMORY MAP LDA LBUF+12 SET UP THE TIME PARAMETERS ASL 4 FIRST THE RESOLUTION LDB LBUF+11 AND MULTIPLE BLS ASR 4 COMBINE STA MULR SET FOR ID SEG GENERATOR LDA LBUF+15 GET THE SECONDS MPY P100 CONVERT TO 10'S OF MS. ADA LBUF+16 ADD 10'S OF MS. STA TEMP1 SAVE TEMP * LDA LBUF+13 GET THE HOURS MPY P60 CONVERT TO MIN. ADA LBUF+14 ADD MIN. MPY P6K CONVERT TO 10'MS CLE PREPARE FOR ADD ADA TEMP1 ADD 10'S MS. SEZ,CLE IF OVERFLOW INB STEP HIGH ORDER PART ADA NDAY+1 SUBTRACT ONE DAY OF 10'S MS. SEZ,CLE IF OVER FLOW INB STEP HIGH ORDER DIGIT ADB NDAY DST TTIME SAVE DOUBLE WORD TTIME FOR ID-SEG. * SUBHD LDA TPREL GET CURRENT PROG RELOC ADDR LDB AMEM5 SET B = ADDR OF MEMORY MAP + 5 JSB CONVD CONVERT TO DECIMAL/OCTAL LDA MLIST PUT A ")" IN THE CPA BLNKS HIGH PART OF THE JMP SUBH2 ADDRESS IF NOT A SUBHEAD * LDA MLIST+5 I.E. IF MAIN ADA B4400 CONVERT BLANK TO ) STA MLIST+5 RESTORE IT. SUBH2 LDA LBUF+1 GET RIC ALF,RAR ROTATE TO LOW A AND M7 ISOLATE RIC CPA P1 NAM RECORD? RSS YES - CONTINUE JSB ABORT INVALID DISK RECORD LDA LBUF+6 GET PROGRAM LENGTH STA PLGTH SAVE PROGRAM LENGTH RAL,CLE,ERA REMOVE POSSIBLE SIGN BIT ADA TPREL COMPUTE THE LAST WORD ADDRESS ADA N1 LDB AMEM8 AND JSB CONVD CONVERT TO THE MAP IFN *** BEGIN NON-MEU CODE *** LDA TBREL GET THE CURRENT BP ADDRESS STA TPBRE AND SET FOR BP CODE JSB ZLOAD IF THIS MODULE IS NOT BEING LOADED CLB,RSS THEN IGNORE ANY ORB'S FOR NOW LDB LBUF+7 ADVANCE LINK AREA ADB TBREL BEYOND THE PROGRAM STB A TEST FOR BP OVERFLOW ADA EOBP SUBTRACT LAST WORD +1 SSA,RSS IF NOT NEGATIVE JMP E16RR GO SEND MESSAGE **** END NON-MEU CODE **** XIF IFZ ***** BEGIN MEU CODE ***** * * SET RELOCATION BASE FOR ORB STUFF SPC 1 JSB ZLOAD IF THIS MODULE IS NOT BEING LOADED CLB,RSS THEN IGNORE ANY ORB'S FOR NOW LDB LBUF+7 GET SIZE OF BASE PAGE CODE LDA BPINC AND FIGURE OUT IF WE'RE GOING SSA UP OR DOWN IN BASE JMP SUBH3 PAGE.e SPC 1 LDA TBREL GOING UP, SET STA TPBRE ORB BASE AT TBREL ADB TBREL INCREMENT LINK BASE LDA BPLMT SUBTRACT LIMIT CMA,INA FROM ADA B NEXT ADDR TO CHECK FOR JMP SUBH4 BASE PAGE OVERFLOW. SPC 1 SUBH3 CMB,INB GOING DOWN...SUBTRACT ORB LENGTH ADB TBREL FROM LINK BASE INB ADD ONE STB TPBRE TO GET ORB BASE. ADB N1 GET NEXT AVAILABLE LINK ADDR. LDA B CMA,INA SUBTRACT NEW BASE FROM LIMIT ADA BPLMT TO CHECK FOR OVERFLOW. SPC 1 SUBH4 SSA,RSS IF LIMIT IS EXCEEDED, WE JMP E16RR HAVE AN ERROR. ****** END MEU CODE ****** XIF CONLD STB TBREL BASE PAGE LDA TPBRE JSB SETBP SET PROGRAM BASE PAGE IMAGE TO -1 LDA LBUF GET RECORD SIZE ALF,ALF LOW ORDER A STA LBUF SAVE IN RIGHT HALF JSB ZLOAD LOADING? JMP NOLD NO, SKIP * LDA L01 FIRST PASS? SZA,RSS NO, DO MAP JMP NOMP YES, NO MAP * ISZ LFLAG BUMP THE LOADED FLAG NOP IN CASE OF LEAP LDA ID5,I CHECK FOR "MAP MODULES". RAR SLA,RSS JMP NOMP NO. BIT 1 NOT SET. * LDB LBUF5 THE SIXTH WORD IN LBUF LDA N11 NUMBER OF WORDS STA TCNT TO MOVE TO LBUF LDA AMLST ADDRESS OF NAME BUFFER STA WDCNT SAVE FOR POINTER LH1 LDA WDCNT,I GET NAME WORD, AND ADDRESS STA B,I STORE IN LBUF INB BUMP B ISZ WDCNT BUMP NAME ADDRESS ISZ TCNT ALL DONE? JMP LH1 NO, DO MORE * LDA BLNKS GET TWO BLANKS STA B,I PUT THEM IN LBUF BEFORE THE COMMENTS LDA LBUF GET RECORD SIZE ADA N5 REDUCE TO MAP LENGTH ALS TIMES 2 FOR CHARACTER COUNT LDB LBUF5 ADDRESS OF MAP AND COMfHFBMENTS JSB DRKEY PRINT ALL * * THE FOLLOWING ROUTINES LINK A PROGRAM THROUGH CURRENT PAGE * LINKS WHEN POSSIBLE. THIS IS POSSIBLE WHEN THE LENGTH * OF THE PROGRAM IS KNOWN AND WHEN THE PROGRAM IS NOT AN * ASSEMBLED TYPE 3 OR 5 PROGRAM. SPC 3 2HNOMP EQU * IFZ ***** BEGIN MEU CODE ***** LDA ID4,I COMPARE CMA,INA THIS MODULE'S COMMON ADA COMSZ DECLARATION TO MAIN'S SSA,RSS ERROR IF GREATER. JMP NOM2 LDA ERR54 JSB ..GNR ****** END MEU CODE ****** XIF NOM2 LDA L01 1ST OF 2 PASSES? SSA JMP NOLD NO - 1 PASS ONLY * SZA,RSS IF PASS ONE JMP LH12 GO CHECK FOR OPTION SPC 1 LDA CPL1 PASS TWO SO SET UP THE NOW STA CPL2 KILL THE UPPER AREA JSB LNKS SET FOR DEFINING CODE JMP LH10 GO SET THE BOUNDRYS SPC 1 LH12 JSB GETCP SET UP A CURRENT PAGE LINK AREA STA CPL1 USE FOR BOTH CLA AREAS STA CPL1H CLEAR THE COUNT WORDS STA CPL2H LDB ID5,I DOES OPERATOR WANT CURRENT PAGE SSB LINKS IF POSSIBLE? IF YES - JMP LH222 GO SET UP * LH2 CCA JMP LOADX RESTART SPC 1 LH222 LDA PLGTH SSA,RSS NO CURRENT PAGE LINKS LDA LDTYP IF ASSEMBLED TYPE 3 OR 5 CPA P3 RSS CPA P5 JMP LH2 * LDA TPREL GET ADDR STA B OF LAST WD IOR M1777 OF PAGE SPC 1 CMB,INB COMPUTE # WDS INB REMAINING ADB A ON PAGE STB TEMP2 SPC 1 LDA PLGTH COMPUTE # WDS RAL,CLE,ERA OF PROGRAM CMB,INB THAT FALL ADB A BEYOND THIS STB TEMP1 PAGE SPC 1 SSB PROGRAM FIT ON RSS THIS PAGE? SZB,RSS NO - SKIP JMP NOLOW YES GO SET UP THE HIGH AREA SPC 1 LDA TEMP2 COMPUTE MINIMUM OF: ARS HALF # WDS OF PROG CMB,INB ON CURRENT PAGE-OR- ADB A # WDS OF PROG ON SSB,RSS NEXT PAGE SPC 1 LDA TEMP1 q DIVIDE THIS CLB MINIMUM BY DIV P4 FOUR SZA,RSS IF NON-ZERO, USE AS SIZE JMP NOLOW OF LOW CURRENT PG LINK BUFF RSS SPC 1 LH10 LDA CPL1H GET PASS ONE DEFINED LENGTH LDB LWH4 SET NEW STB LNK1,I LOWER LINK ADDRESS ADB A AND UPPER LIMIT STB TPREL OF LINK BUFFER STB LNK2,I (ALSO PROGRAM LOAD ADDRESS) JSB CLRCP CLEAR THE CURRENT PAGE IMAGE SPC 1 JSB GETCP GET ANOTHER CP LINK AREA LDA PLGTH GET PROGRAM LENGTH RAL,CLE,ERA STRIP POSSIBLE SIGN BIT ADA TPREL ADD THE BASE ADDRESS STA LNK1,I SET ORGION OF HIGH LINK AREA IOR M1777 TOP IS INA FIRST WORD OF STA LNK2,I NEXT PAGE JSB CLRCP GO CLEAR THE ALLOCATED AREA CLA CLEAR THE UPPER COUNT WORD STA CPL2H * NOLD LDB TPREL GET PROGRAM RELOCATION BASE STB RELAD SET CURRENT RELOCATION ADDRESS * * CLASSIFY ENT, EXT, DBL, END RECS * CCA FORCE FILE READ. STA LCNT JSB DBSET GET FIRST WORD IN RECORD. CLSRC LDA CURAL,I SAVE THE RECORD LENGTH FOR STA TBUF DBL SKIP ROUTINE JSB DBSET GET ADDR OF NEXT WORD IN LBUF LDA CURAL,I GET SECOND WORD IN RECORD LDB A SAVE WORD IN B ALF,RAR ROTATE RIC TO LOW A AND M7 ISOLATE RIC CPA P2 ENT RECORD? JMP DENTR PROCESS ENT RECORD CPA P3 DBL RECORD? JMP DDBLR PROCESS DBL RECORD CPA P4 EXT RECORD? JMP DEXTR PROCESS EXT RECORD CPA P5 END RECORD? RSS YES - PROCESS END RECORD JSB ABORT INVALID DISK RECORD * JSB ZLOAD LOADING? JMP CLSTX NO * NOLOW LDA L01 IF FIRST OF SSA,INA IF NOT CURRENT PAGE LINKING JMP PEND JUST GO END spIT * CPA P1 IF PASS ONE JMP CPRST GO DO PASS TWO * * PASS TWO OUTPUT THE CP LINK AREAS AND UPDATE. * LDA CPL1 OUTPUT THE JSB OUTCP LOW AREA LDA CPL2 SET UP FOR THE JSB LNKS HIGH AREA LDA CPL2H GET THE NUMBER ALLOCATED ADA LNK1,I AND COMPUTE THE UPPER LIMIT STA LNK2,I SET THE ACTUAL VALUE LDA CPL2 NOW JSB OUTCP OUTPUT THE LINKS * PEND JSB DBSET GET ADDR OF NEXT WORD IN LBUF JSB DBSET GET ADDR OF NEXT WORD IN LBUF LDA TPREL GET CURRENT PROG RELOCATION BASE ADA CURAL,I ADD RELOCATION ADDRESS LDB HDFLG GET HEADING FLAG SZB,RSS SKIP UNLESS MAIN STA PRENT SAVE PRIMARY ENTRY POINT FOR ID CLSTX JSB INLST INITIATE LSTX CLST JSB LSTX SET LST ADDRESSES JMP LSTCR END OF LST * LDA .LST3,I GET WORD 3 OF .LST (ORDINAL) AND M7400 ISOLATE UPPER CHAR - CLEAR ORD STA .LST3,I SET NAME 5 IN .LST JMP CLST CONTINUE CLEARING ORDINALS * LSTCR JSB ZLOAD WAS CURRENT PGM LOADED? JMP PLSCM NO SKIP ADDRESS UP DATE * LDA PLGTH GET PROGRAM LENGTH RAL,CLE,ERA SET E = SIGN ADA TPREL ADD PROGRAM RELOCATION BASE ADA CPL2H REFLECT ANY CURRENT PAGE LINKS STA TPREL ALLOCATED LDB ID5,I CHECK FOR "MAP LINKS" LDA TBREL CURRENT BP ADDRESS. RBR,RBR IF BIT 2 SLB IS SET JSB BPLNR REPORT THE BP LINKAGE PLSCM JSB INIDX SCAN THE PLSCN JSB IDX IDENTS FOR MODULES JMP CLFLG LEFT TO LOAD NONE SO GO EXIT * LDA ID3,I GET THE FLAG WORD SLA,INA IF ALREADY LOADED JMP PLSCN TRY THE NEXT ONE * RAR,SLA,RAL IF MUST LOAD FLAG SET JMP ENTID GO LOAD IT * JMP PLSCN ELSE GO TRY NEXT IDENT. * * ENTID STA ID3,I SET THE LOADED FLAG AND GO LOAD. JMP LOADN (RDNAM WILL CLOSE THE OLD FILE) * CLFLG CCA HANDLE ZERO LENGTH PROGRAMS. ADA TPREL FILL FINAL BSS. STA TEMP1 CMA,INA LDB MXABC ADA B,I SSA,RSS JMP CLF2 CLA LDB TEMP1 JSB LABDO CLF2 LDA TBREL UPDATE LDB A THE MAX BP CMB,INB ADDRESS IF ADB BPMAX NEEDED IFN *** BEGIN NON-MEU CODE *** SSB STA BPMAX **** END NON-MEU CODE **** XIF IFZ ***** BEGIN MEU CODE ***** * SET BASE PAGE HIGH WATER MARK SPC 1 LDA BPINC A=BP INCREMENT SSA UP OR DOWN?? JMP BPDEC DOWN, SEE IF LOWER SSB UP, SEE IF HIGHER JMP UPDAT YES, HIGHER SO UPDATE JMP BPCNT LOWER, CONTINUE BPDEC SSB DOWN, SEE IF LOWER JMP BPCNT NO, JUST CONTINUE UPDAT LDA TBREL YES, UPDATE STA BPMAX BPCNT EQU * ****** END MEU CODE ****** XIF LDA PTYPE GET CURRENT PROGRAM TYPE CPA P3 TYPE = BG DISK RESIDENT? JMP LODER,I YES - DO NOT CLEAR LOADED FLAGS * JSB CLID3 CLEAR PROG-LOADED FLAGS JMP LODER,I RETURN - ALL FLAGS CLEARED * E16RR EQU * IFN *** BEGIN NON-MEU CODE *** LDA ERR16 GET BP OVERFLOW JSB ..GNR MESSAGE ON THE TTY CCB ADB LWSBP USE MAX WE HAVE JMP CONLD AND CONTINUE LOAD **** END NON-MEU CODE **** XIF IFZ ***** BEGIN MEU CODE ***** LDA ERR16 PRINT BP OVFLOW JSB ..GNR MESSAGE LDB BPINC USE LIMIT CMB,INB +1 OR -1 AS BASE ADB BPLMT PAGE BASE (DEPENDS ON WHETHER * WE'RE GOING UP OR DOWN * ALLOCATING LINKS JMP CONLD ****** END MEU CODE ****** XIF CPRST LDB CPL1H SET UP THE NEW TPREL ADB LWH4 USE SUM OF OLD1i AND USED LINKS STB TPREL SET NEW ADDRESS JMP LOADX GO START THE FINAL PASS SPC 1 ERR54 ASC 1,54 ERR16 ASC 1,16 LEN NOP P30 DEC 30 M37 OCT 37 M77 OCT 77 M100 OCT 100 M177 OCT 177 M377 OCT 377 M0760 OCT 076000 M2000 OCT 2000 M1177 OCT 101777 SKP * PROCESS ENT/EXT RECORDS DENTR CCA,RSS SET ENT FLAG AND SKIP DEXTR CLA SET EXT FLAG STA NXFLG SAVE ENT/EXT FLAG LDA B GET NO. ENTRIES IN EXT/ENT AND M37 ISOLATE SYMBOL COUNT CMA,INA STA EXCNT SET SYMBOL COUNTER JSB DBSET GET ADDR OF NEXT WORD IN LBUF JSB DBSET GET ADDR OF NEXT WORD IN LBUF NXSYM LDA CURAL,I GET NAME 1,2 STA TBUF SAVE NAME 1,2 IN TEMP BUFF JSB DBSET GET ADDR OF NEXT WORD IN LBUF LDA CURAL,I GET NAME 3,4 STA TBUF+1 SAVE NAME IN TEMP BUFF JSB DBSET GET ADDR OF NEXT WORD IN LBUF LDA CURAL,I GET NAME 5 STA TBUF+2 SAVE NAME IN TEMP BUFF JSB DBSET GET ADDR OF NEXT WORD IN LBUF LDB ATBUF GET ADDRESS OF SYMBOL JSB LSTS SET LST ADDRESSES JSB ABORT ENT/EXT NOT FOUND IN LST * LDA NXFLG GET ENT/EXT FLAG SZA,RSS SKIP IF ENTRY JMP EXT1 PROCESS EXT * JSB ZLOAD IF NOT LOADING CURRENT PGM JMP NLENT SKIP LINK AND MAP * LDA .LST4,I IF THIS ENT IS SELF DEFINING ADA N5 SKIP IF PROGRAM SSA OR BASE PAGE RELOCATABLE JMP NLENT GO DO SELF DEFINING THING * LDA TBUF+2 GET THE RELOCATION AND P7 INDICATOR ADA MRTAD RELOCATE THE LDB A,I SYMBOL ADB CURAL,I ADD CURRENT RELOCATION VALUE STB OPRND SAVE ABS ENTRY PT. ADDRESS STB .LST5,I SET VALUE IN THE .LST LDA L01 IF 1ST OF TWO SZA,RSS PASSES, SKIP JMP NLENT THE MAP AND FIX UP * LDA ID5,I CHECK FOR "MAP GLOBALS". SLA,RSS SKIP - BIT 0 SET (LIST ENTS). JMP MLENT SUPPRESS PRINTING OF ENTS. * JSB CLIST CLEAR MEMORY MAP BUFFER LDA BLAST GET BLANK, ASTERISK STA MLIST+1 SET IN MAP LDA .LST1,I GET NAME 1,2 STA MLIST+2 SET IN MEMORY MAP LDA .LST2,I GET NAME 3,4 STA MLIST+3 SET IN MEMORY MAP BUFFER LDA .LST3,I GET NAME 5 AND M7400 ISOLATE UPPER CHAR IOR BLANK SET LOWER CHARACTER = BLANK STA MLIST+4 SET NAME 5 IN MEM MAP LDA .LST5,I GET ABSOLUTE ENTRY PT. ADDRESS LDB AMEM5 GET ADDRESS OF MESSAGE JSB CONVD CONVERT TO DECIMAL/OCTAL LDA P16 LDB AMLST GET ADDRESS OF MEM MAP BUFFER JSB DRKEY PRINT ENTRY POINT MLENT JSB DAFIX FIX UP ALL REFERENCES TO THIS SYMBOL NLENT JSB DBSET GET ADDR OF NEXT WORD IN LBUF JMP EXEND PROCESS NEXT SYMBOL * EXT1 LDA TIDNT SAVE CURRENT IDENT INDEX. ADA N1 STA TBUF LDA TBUF+2 GET ORDINAL STA .LST3,I SET ORDINAL IN .LST * LDA .LST4,I GET IDENT INDEX SZA IF ENTRY NOT DEFINED CPA P2 RSS CPA P3 OR SELF-DEFINING RSS THEN CPA P4 SKIP THE LOAD JMP LIBTS AND JUST CONTINUE * STA TIDNT SET ID INDEX FOR IDX STA TBUF+3 SAVE FOR LATER. JSB IDX SET IDENT ADDRESSES JSB ABORT IDENT NOT FOUND IN LIST LDA ID6,I GET M/S, TYPE STA TBUF+1 SAVE M/S, TYPE LDA ID3,I GET PROGRAM USAGE FLAG STA TBUF+2 SAVE USAGE FLAG LDA TBUF GET CURRENT IDENT INDEX STA TIDNT SET CURRENT IDENT INDEX. JSB IDX SET IDENT ADDRESSES JSB ABORT CURRENT IDENT NOT FOUND IN LIST LDA TBUF+1 GET M/S, TYPE FOR EXT RAL,CLE,ERA SET E = M/S AND M177 ISOLATE TYPE IFZ ***** BEGIN MEU CODE ***** CPA P30 JUMP IF SSGA MODULE JMP CKSSC ****** END MEU CODE ****** XIF SZA,RSS IF SYSTEM REFERENCE JMP EXT23 CONTINUE * AND M7 KEEP JUST THE LOW TYPE CPA P6 TYPE = LIBRARY? JMP LIBUT YES - TEST FOR LOADING * LDB P6 ELSE IF CURRENT TYPE CPB LDTYP IS 6 THEN JMP CALER ERROR, TYPES 6,14,30 MAY * ONLY CALL TYPES 0,6,14,30 * EXT23 CPA P7 TYPE = UTILITY? JMP LIBUT YES - TEST FOR LOADING * SEZ SKIP - NOT MAIN PROGRAM JMP EXEND IGNORE PROGRAM CALL LIBUT LDA TBUF+2 GET PROGRAM USAGE FLAG SLA SKIP - PROGRAM NOT LOADED JMP EXEND OMIT PROGRAM LIST ENTRY * LDA TIDNT SAVE CURRENT IDENT INDEX. ADA N1 STA TBUF LDA TBUF+3 GET BACK TO REFERENCED IDENT. STA TIDNT JSB IDX JSB ABORT LDA TBUF+2 LDB PTYPE IF BACK GROUND SEGMENT CPB P5 THEN IOR P4 SET THE BS FLAG IOR P2 SET THE MUST LOAD FLAG STA ID3,I RESTORE THE FLAG TO THE IDENT LDA TBUF RESTORE CURRENT IDENT STA TIDNT INDEX JSB IDX AND ADDRESSES. JSB ABORT MUST BE THERE. * EXEND ISZ EXCNT SKIP - ALL SYMBOLS PROCESSED JMP NXSYM NO - PROCESS NEXT SYMBOL * JMP CLSRC NO - CLASSIFY NEXT RECORD * CALER LDA ERR15 SET ERROR CODE - ILLEGAL CALL JSB ..GNR PRINT THE NO-NO JMP EXEND TEST FOR ANOTHER IFZ ***** BEGIN MEU CODE ***** * MAKE SURE PROGRAM HAS SSGA PRIVILEGES CKSSC LDB SSGAF GET FLAG SZB IF SET, THEN JMP EXEND JUST CONTINUE LDA ERR52 ELSE SEND ERROR MSG JSB ..GNR JMP EXEND ERR52 ASC 1,52 ****** END MEU CODE ****** XIF LIBTS LDA LIBFG LOADING CORE RESo. LIB? CLE,SZA,RSS JMP EXEND NO SO SKIP * LDA TLST YES,SET UP LIB REPLACE CODE. ADA N1 CLB,CLE CPA $PRV REFERENCE TO .ZPRV? CLB,CCE,INB YES SET FLAGS CPA $RNT REFERENCE TO .ZRNT? CCB,CCE YES SET FLAGS SEZ,RSS IF NEITHER JMP EXEND TREAT NORMALLY * STB LIBTP ELSE SET THE TRAP FLAG STA TRPLB AND LST INDEX JMP EXEND AND CONTINUE * * SKIPR LDA TBUF SKIP A DBL RECORD ALF,ALF GET SAVED RECORD LENGTH CMA,INA AND SET NEGATIVE INA SKIP THE LENGTH STA TBUF SET FOR COUNTER SKIPX JSB DBSET SKIP A WORD ISZ TBUF DONE? JMP SKIPX NO DO NEXT ONE. * JMP CLSRC YES GO GET NEXT RECORD * * * * PROCESS DBL RECORDS * DDBLR JSB ZLOAD IF NOT LOADING JMP SKIPR SKIP TO END * LDA B GET COUNT AND M77 ISOLATE COUNT CMA,INA STA EXCNT SET INSTRUCTION COUNT LDA B COMPUTE THE RECORDS AND M100 RELOCATION LDB TPREL GET THE MAIN RELOCATION BASE SZA,RSS IF BASE PAGE LDB TPBRE REPLACE WITH BP BASE STB DBLAD AND SET THE RECORD BASE ADDRESS JSB DBSET GET ADDR OF NEXT WORD IN LBUF JSB DBSET GET ADDR OF NEXT WORD IN LBUF * LDB CURAL,I GET RELOCATION ADDRESS ADB DBLAD RELOCATE THE RECORD ADDRESS STB DBLAD SAVE RELOCATION ADDRESS LDB ID7,I GET FIRST DBL ADDRESS ISZ PLFLG SKIP - FIRST DBL RECORD JMP DBL0 IGNORE SUBSEQUENT RECORDS IFN *** BEGIN NON-MEU CODE *** CLA CLEAR THE BSS FLAG STA BSSDP LDA L01 IF CURRENT PAGE LINKING THEN SZA MUST NOT SKIP OR WE LOSE THE LINKS LDA ID6,I GET TYPE AND M7 ISOLATE TYPE CPA P2 TYPE = RT DIBSK RESIDENT? RSS CPA P3 TYPE = BG DISK RESIDENT? RSS CPA P5 TYPE = BG SEGMENT? RSS JMP DBL0 SET PGMAD = 0 FOR RESIDENTS **** END NON-MEU CODE **** XIF IFZ ***** BEGIN MEU CODE ***** * COME HERE ON FIRST BSS OF MODULE * IF MODULE IS A SEGMENT THEN DON'T * STORE BSS ON DISK SINCE IT ONLY * INDICATES ADDRESSES SHARED WITH THE MAIN SPC 1 CLA STA BSSDP ZERO LOAD POINT OFFSET LDA ID6,I AND M7 GET PRIMARY MODULE TYPE CPA P5 RSS ADJUST LOAD PT FOR SEG JMP DBL0 START FROM REL LOC 0 * FOR ALL OTHERS ****** END MEU CODE ****** XIF STB BSSDP SAVE INITIAL PROG DISPLACEMENT LDA ABCOR ADB A,I DISC /CORE STB A,I BASE ADDRESS LDA MXABC STB A,I AND THE MAX ADDRESS DBL0 JSB DBSET GET ADDR OF NEXT WORD IN LBUF DBL1 LDB CURAL,I GET RELOCATION BYTES STB REKEY SAVE FOR RELOCATION TYPE LDA N5 STA INSCN SET RELOCATION BYTE COUNT JSB DBSET GET ADDR OF NEXT WORD IN LBUF * DBL2 LDA REKEY GET RELOCATION BYTES ALF,RAR ROTATE TO LOW A STA REKEY SAVE FOR NEXT INSTRUCTION WORD AND M7 ISOLATE CURRENT BYTE CPA P4 EXTERNAL REFERENCE? JMP DBL4 YES - GET LINK ADDRESS * CPA P5 MEMORY REFERENCE? JMP DBL5 YES - CHECK FOR INDIRECT LINK * CPA P6 BYTE ADDRESS? JMP DBL6 YES - GO CACULATE THE ADDRESS. * ADA RBTAD ADD RELOCATION BASE TABLE ADDR LDB A,I GET RELOCATION BASE ADB CURAL,I ADD CURRENT INSTRUCTION WORD CLA CLEAR THE INSTRUCTION JMP DBL42 AND GO JOIN THE TYPE 4 PROCESSOR * DBL33 JSB DBSET GET ADDR OF NEXT WORD IN LBUF ISZ EXCNT SKIP - LAST INSTRUCTION OUT RSS NO - C&ONTINUE JMP CLSRC YES - CLASSIFY NEXT RECORD ISZ DBLAD INCR DBL RELOCATION ADDRESS ISZ INSCN SKIP IF NEW RELOCATION BYTE JMP DBL2 NO - PROCESS NEXT INSTRUCTION JMP DBL1 YES - GET NEXT RELOCATION BYTE * * * PROCESS DBL EXT RECORD * DBL4 LDA CURAL,I GET CURRENT DBL WORD AND NT2K CLEAR THE CURRENT PAGE BIT CLB SET OFFSET TO ZERO DBL42 STA INSTR SAVE THE INSTRUCTION WORD JMP DBL54 GO TO TYPE 5 RECORD HANDLER * DBL5 LDA CURAL,I GET CURRENT DBL WORD AND NT2K CLEAR THE CURRENT PAGE BIT DBL56 STA INSTR SAVE INSTRUCTION CODE JSB DBSET GET ADDR OF NEXT WORD IN LBUF LDB CURAL,I GET ADDRESS TO B LDA INSTR GET THE INSTRUCTION ALF,RAL SET E ELA IF A BYTE ADDRESS LDA INSTR GET INSTRUCTION CODE AND P3 ISOLATE THE MR FIELD ADA MRTAD INDEX INTO THE BASE TABLE ADB A,I RELOCATE THE ADDRESS SEZ IF BYTE ADDRESS THEN ADB A,I DOUBLE THE ADDRESS LDA INSTR GET THE INSTRUCTION WORD AGAIN ARS,ARS MOVE ORDINAL TO LOW A. * * DBL TYPE 4 JOINS HERE * DBL54 AND M377 ISOLATE THE ORDINAL STA FIX4,I SAVE ORD IN FIX UP TBL (TEMP). STB FIX3,I SAVE THE OFFSET/ ADDRESS LDA INSTR GET THE INSTRUCTION AGAIN AND M1760 ISOLATE THE OP CODE AND STA FIX2,I PUT IT IN THE FIXUP TABLE LDA DBLAD GET THE RECORD ADDRESS STA FIX1,I SET THE CORE ADDRESS IN THE TABLE LDA FIX4,I GET THE ORDINAL SZA,RSS IF NONE JMP DBL57 GO OUTPUT THE INSTRUCTION * JSB LSTOS LOOK FOR ORDINAL IN LST'S JSB ABORT HALT IF NOT THERE * LDA TLST GET THE LST ENTRY INDEX ADA N1 LDB LIBFG GET THE LIB FLAG SZB,RSS IF NOT LOADING CORE RES LIB JMP DBL45 JUST CONTINUE * }  CPA TRPLB ELSE IS THIS A REFERENCE TO .ZRNT,.ZPRV ? RSS YES SKIP JMP DBL45 NO, CONTINUE * LDA $LIBR YES USE $LIBR INDEX INSTEAD STA TLST JSB LSTX JSB ABORT LDA FIX1,I GET THE CORE ADDRESS INA AND SET THE ADDRESS STA ADTRP TRAP LDA N3 STA ADTPF SET FOR FIRST ADDRESS DBL44 LDA TLST GET NEW LST ENTRY AND CONTINUE DBL45 SZA,RSS 0 MEANS .ZRNT INDEX CCA SO SET A SPECIAL, DONT WANT 0 STA FIX4,I FIX UP TABLE LDA .LST4,I GET THE DEFINITION ADDRESS CPA P3 IF PREDEFINED RSS THEN GO CPA P4 SEND JMP DBL57 THE INSTRUCTION * CPA P2 IF SYMBOL IS IN COMMAN JMP DBL58 GO ADDJUST FOR COMMAN * LDA .LST5,I ELSE IF SYMBOL CCE,SZA IS DEFINED JMP DBL57 GO SEND IT * DBL60 LDA L01 IF NOT LOADING SZA SKIP THE FIX ENTRY JSB SFIX UNDEFINED SYMBOL MAKE FIX ENTRY CCA MAKE SURE FIX ENTRY IS STA FIX1,I FLAGED PROPERLY JMP DBL33 GO GET NEXT ENTRY * DBL57 LDA FIX1,I GET THE ADDRESS CPA ADTRP THIS A TRAP ADDRESS RSS YES SKIP JMP DBL61 NO, DO NORMAL LOAD * LDA ADTPF GET TRAP REASON FLAG INA,SZA,RSS LAST TRAP OF THREE? JMP ADDX1 YES GO DO X+1 THING * INA,SZA,RSS X ADDRESS? JMP ADDX YES GO DO X ADDRESS THING * LDA TFIX SAVE INDEX OF ADA N1 THIS FIX-UP STA TBUF+3 ENTRY. CLA MUST BE P+1 TRAP STA FIX4,I SET LST FIX INDEX TO ZERO ISZ ADTPF SET FOR X ADDRESS NEXT TRAP LDB FIX3,I GET ADDRESS FROM FIX LST STB ADTRP SET FOR NEXT STA FIX3,I SET TO NOP INCASE NOT RENT LDA LIBTP GET FLAG THAT TELLS INA,SZA,RSS IF .ZRNT JMP DBL60 HFB GO MAKE FIX ENTRY * DBL61 JSB DFIX SEND THE INSTRUCTION JMP DBL33 GO GET THE NEXT ENTRY * DBL58 LDA COMAD ENTRY POINT IS IN COMMON ADA FIX3,I SO FIX THE STA FIX3,I THE OFFSET JMP DBL57 AND OUTPUT THE INSTRUCTION * DBL6 LDA CURAL,I GET THE INSTRUCTION WORD IOR M2000 SET THE INTERNAL BYTE FLAG BIT JMP DBL56 JOIN THE DBL 5 CODE * ADDX STA FIX3,I ZAP THE OFFSET ISZ ADTRP SET FOR NEXT TRAP ISZ ADTPF TRAP NEXT ADDRESS (X+1) LDA $LIBX REPLACE THIS ONE WITH STA TLST $LIBX INDEX. JSB LSTX SET IT UP JSB ABORT LDA JSB SET INSTRUCTION STA FIX2,I TO A JSB JMP DBL44 GO SEND IT * NT2K OCT 175777 JSB JSB 0 * ADDX1 STA ADTRP CLEAR ALL TRAPS STA ADTPF LDB LIBTP GET TYPE FLAG INB,SZB IF .ZPRV JMP DBL61 JUST SEND THE WORD * INA SET TO FORCE A FIX IN DAFIX STA TLST WHERE FIX4,I = 0 LDA FIX3,I GET THIS DEF STA FIXTP SAVE FOR OTHER ENTRY. LDA TBUF+3 GET BACK TO THE STA TFIX JSB FIX OTHER FIX-UP ENTRY. JSB ABORT LDA FIXTP SET DEF IN THAT ENTRY. STA FIX3,I JSB DAFIX GO SEND BOTH INSTRUCTIONS JMP DBL33 GET THE NEXT INSTRUCTION SPC 4 xH* * ZLOAD NOP TEST FOR LOADING CURRENT PGM LDA LIBFG LIB LOADING? SZA,RSS JMP *+3 NO; THEN LOADING - GO STEP ADDRESS LDA P6 YES; CURRENT PGM TYPE=6? CPA LDTYP ISZ ZLOAD LIB AND SIX OR NOT LIB STEP ADDRESS JMP ZLOAD,I RETURN SPC 4 * ..GNR NOP LDB L01 IF THIS IS THE FIRST OF TWO SZB PASSES THEN SKIP THE ERROR PRINTOUT JSB GN.ER ELSE DO IT JMP ..GNR,I SPC 4 FIXTP NOP TRPLB NOP LIBTP NOP ADTRP NOP ADTPF NOP BLAST ASC 1, * BLANK,ASTERISK ERR15 ASC 1,15 HED RTGN4 - LOADER SEGMENT SUBROUTINES. * * LSTOS - SEARCHES LST'S FOR ONE WITH ORDINAL MATCHING * FIX4,I * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * * RETURN SEQUENCE: CONTENTS OF A AND B DESTROYED. * (N+1): CURRENT LST POINTERS SET UP FOR LAST LST. * ORDINAL NOT FOUND. * (N+2): CURRENT LST POINTERS SET TO LST CONTAINING * DESIRED ORDINAL. * LSTOS NOP JSB INLST RESET TO START OF LST. LSTO2 JSB LSTX SET ADDRS FOR NEXT ENTRY. JMP LSTOS,I IF AT END, TAKE FAILURE EXIT. * LDA FIX4,I COMPARE ORDINALS. XOR .LST3,I AND M377 SZA JMP LSTO2 NO MATCH: TRY NEXT ENTRY. ISZ LSTOS NATCH: TAKE SUCCESS EXIT. JMP LSTOS,I SKP * DFIX DOES THE FIX UP POINTED TO BY THE CURRENT FIX UP * TABLE AND LST ENTRYS. DFIX IS USED FOR ALL * INSTRUCTIONS AND MAY BE CALLED ONLY * AFTER THE SYMBOL (IF ANY) IS DEFINED. * * CALLING SEQUENCE: * * SET UP FIX1-4 AND LST1-5 FOR THE ENTRY * * JSB FIX * * RETURN THE FIX ENTRY IS FREE, A/B MEANINGLESS * DFIX NOP CCB,CLE SET THE NOT BP LINK STB BPONL FLAG LDA FIX4,I IF NO SZA,RSS LST INDEX JMP VFIX USE ZERO VALUE * WILL BE -1 FOR .ZRNT INDEX *  BUT NO PROBLEM SINCE IT IS * A REPLACE OPERATION * LDA .LST5,I GET THE SYMBOL VALUE LDB .LST4,I GET THE SYMBOL TYPE CPB P4 IS REPLACEMENT SYMBOL JMP ZFIX GO DO REPLACEMENT * VFIX LDB FIX2,I GET THE BYTE BLF,RBL BIT TO RBL,CLE,SLB,ERB E AND ADA A DOUBLE THE ADDRESS IF SET BLF,BLF RESTORE B BLF,RBR WITHOUT THE BYTE BIT STB FIX2,I AND RESET IN THE TABLE ADA FIX3,I COMPUTE THE MEMORY ADDRESS STA OPRND AND SAVE AND M0760 EXTRACT THE PAGE NUMBER STA PAGNO AND SAVE SZA,RSS IF BASE PAGE OP JMP CPFIX GO TREAT AS CURRENT PAGE * LDA FIX1,I GET THE INSTR. ADDRESS AND M0760 EXTRACT THE PAGE STA OPPAG SAVE IT LDB FIX4,I GET THE LIST INDEX SZB IF EXT REFERENCE JMP WFIX USE A BP LINK * CPA PAGNO IF SAME PAGE AS OPERAND JMP CPFIX GO DO CURRENT PAGE TRICK * WFIX LDA FIX2,I GET THE INSTRUCTION CLE,ELA ZAP THE INDIRECT BIT SZB IF EXT REFERENCE JMP IDEF GO USE A LINK * SZA,RSS IF NOT A MRF INSTRUCTION JMP CPFIX THEN DO THE DEF TRICK * IDEF LDB OPRND GET THE OPERAND SEZ IF INDIRECT REFERENCE ADB MSIGN ADD THE SIGN BIT STB OPRND RESET IT LDA FIX4,I IF EXTERNAL REFERENCE SZA THEN STA BPONL SET FOR BASE PAGE LINK ONLY JSB BPSCN GET A LINK ADDRESS IOR MSIGN A = ADDRESS, SET INDIRECT BIT * XFIX STA B SAVE THE ADDRESS AND M1177 =B101777 PURGE THE PAGE BITS CPA B IF THERE WERE SOME RSS THEN IT'S A CP LINK SO IOR M2000 SET THE CP BIT * YFIX IOR FIX2,I INCLUDE THE INSTRUCTION ZFIX LDB L01 IF NOT LOADING SZB,RSS qz THEN JMP AFIX SKIP THE DISC WRITE * LDB FIX1,I GET THE CORE ADDRESS JSB LABDO OUTPUT THE WORD AFIX CCA FREE THE FIX UP TABLE ENTRY STA FIX1,I JMP DFIX,I AND EXIT * CPFIX LDA OPRND CP/BP/DEF - GET OP ADDRESS LDB FIX2,I IF CLE,ELB DEF SZB,RSS THEN JMP YFIX JUST PICK UP THE INDIRECT. * LDB PAGNO IF A BASE PAGE REFERENCE SZB OR IF LDB FIX4,I NOT AN EXT SZB THEN DO DIRECT LINK ISZ BPONL ELSE SET TO USE BP LINK (SKIPS) JMP XFIX USE STANDARD LINK * JMP WFIX USE BP LINK * OPPAG NOP BPONL NOP SKP * SFIX FINDS THE FIRST FREE FIX UP TABLE ENTRY. * * CALLING SEQUENCE: * * JSB SFIX * SFIX NOP JSB FIXX INITILIZE THE FIX UP TABLE SFIX1 JSB FIX SET ADDRESSES JMP SFIX2 EXIT NEW ENTRY * LDA FIX1,I THIS ENTRY FREE? SSA,RSS FREE IF NEGATIVE JMP SFIX1 NO KEEP LOOKING * JMP SFIX,I EXIT * SFIX2 ISZ PFIX IF NEW ENTRY, COUNT IT. CCB STB FIX1,I AND CLEAR THE ENTRY JMP SFIX,I EXIT SKP * DAFIX DOES ALL FIX UP FOR THE CURRENT LST ENTRY * * CALLING SEQUENCE: * * SET UP THE LST ENTRY * * JSB DAFIX * DAFIX NOP JSB FIXX SET UP THE SCAN DAFI1 JSB FIX SET ADDRESSES JMP DAFI2 END OF LIST GO TO EXIT CODE * LDA FIX1,I IF NULL ENTRY SSA THEN JMP DAFI1 IGNOR IT * LDA TLST GET LST INDEX. ADA N1 CPA FIX4,I THIS ENTRY? JSB DFIX YES DO THE FIX JMP DAFI1 GET NEXT FIX UP * DAFI2 JSB SFIX SET UP A FREE FIX UP ENTRY JMP DAFIX,I AND EXIT SKP * CLEAR PROGRAMS-LOADED FLAGS * * CLID3 CLEARS THE USAGE FLAGS TO ENSURE THAT PROGRAMS WILL BE * RE-LOADED AGAIN IF CALLED MOR?E THAN ONCE. THIS IS ESSENTIAL * FOR ALL UTILITY PROGRAMS AND USER SUBROUTINES, BUT MUST NOT * BE DONE FOR SYSTEM PROGRAMS, LIBRARY PROGRAMS, OR MAIN USER * PROGRAMS. BOTH THE USAGE FLAG IN THE IDENT ENTRY AND THE * SYMBOL VALUES FOR ALL ENTRY POINTS IN THE PROGRAM ARE CLEARED. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB CLID3 * RETURN: CONTENTS OF A AND B ARE DESTROYED. * CLID3 NOP LDB P3 GET THE STANDARD FLAG LDA P5 CPA PTYPE PROG = BG SEGMENT? LDB P7 YES - GET BS FLAG BITS STB CURAP SET CURRENT PROG FLAG BITS JSB INIDX INITILIZE THE IDENT SCANNER TRID3 JSB IDX GET THE NEXT IDENT. JMP CLID3,I IF NONE THEN EXIT - DONE * LDA ID6,I GET M/S,TYPE RAL,CLE,ERA SET E IF MAIN AND M177 ISOLATE TYPE SZA,RSS IF SYSTEM JMP TRID3 FORGET IT * AND M7 ISOLATE FURTHER CPA P6 TYPE = LIBRARY? JMP TRID3 THEN - DO NOT CHANGE FLAG * CCB PRESET B FOR IMPOSSIBLE TYPE CPA P7 IF LIB TYPE CLB,CLE SET NOT MAIN FLAG (B=SYS TYPE) CPB PTYPE IF SYS REF TO LIB JMP TRID3 DON'T CLEAR IT (ONE COPY IN SYSTEM) * SEZ IF MAIN JMP TRID3 FORGET IT * LDA ID3,I GET USAGE FLAG AND P7 ISOLATE THE USAGE FLAG CPA CURAP IF ONE THAT WE ARE AFTER RSS SKIP JMP TRID3 ELSE TRY THE NEXT ONE * XOR ID3,I ZAP THE USAGE FLAGS STA ID3,I AND RESTORE THE WORD JSB INLST INITIALIZE LSTX CLSUT JSB LSTX SET CURRENT LST ADDRESSES JMP TRID3 TRY NEXT IDENT * LDA TIDNT GET IDENT INDEX ADA N1 CPA .LST4,I ENT-EXT BELONGS TO CURRENT PROG? CLB,RSS YES - CONTINUE JMP CLSUT TRY NEXT LST ENTRY * STB .LST5,I CLEAR SYMBOL VALUE JMP CLSUT CONTINUE CLEAR>ING BP LINK ADDR. SPC 2 * THE GETCP ROUTINE SETS UP AND INITILIZES A NEW CP LINK AREA * * CALLING SEQUENCE: * * JSB GETCP * * RETURN A = LNK1,CPL2 ADDRESS * GETCP NOP LDA CPL2 USE CURRENT TOP JSB LNKS SET ADDRESSES CLA FOOL THE LINK ROUTINE STA CPL2 JSB LNK SET ADDRESS FOR NEXT AREA CLA SET AREA TO ZERO SIZE STA LNK1,I STA LNK2,I LDA LNK3 SET THE IMAGE ADDRESS INA STA LNK3,I LDA LNK1 SET NEW TOP AND A FOR EXIT STA CPL2 JMP GETCP,I RETURN SKP * * GET BP LINK ADDR, SET BP VALUE * * BPSCN SCANS THE CURRENT ALLOCATED LINKS * FOR A VALUE EQUAL TO THE CURRENT OPERAND. IF SUCH A VALUE * IS FOUND, THE ADDRESS OF THE OPERAND IS RETURNED * IN THE A-REGISTER. OTHERWISE, A NEW LINK WORD IS * RESERVED AND THE ADDRESS OF THIS WORD RETURNED IN A. * IN THIS CASE THE OPERAND WORD IS SET IN THE ALLOCATION * IMAGE AREA. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB BPSCN * * RETURN: * A = BP LINK ADDRESS FOR CURRENT OPERAND * B = DESTOYED * BPSCN NOP * JSB LNKX INITILIZE THE LINK MAPPER BPSC2 JSB LNK SET UP THE FIRST AREA JMP BPSC4 IF NON LEFT GO ALLOCATE * JSB SCN SCAN THE AREA FOR A LINK JMP BPSC2 IF NON FOUND TRY NEXT AREA * JMP BPSCN,I ELSE RETURN THE LINK * BPSC4 JSB ALLOC NON ALLOCATED SO ALLOCATE ONE JMP BPSCN,I AND RETURN SKP * * SCAN AREA FOR SAME OPERAND * * THE SCN SUBROUTINE CONTROLS THE SCAN FOR A GIVEN OPERAND * IN THE CURRENT LINK SECTION. * * CALLING SEQUENCE: * SET UP LNK1, LNK2, LNK3 TO POINT TO THE CURRENT LINK AREA * SET OPRND TO THE VALUE DESIRED, AND BPONL TO -1 FOR ANY AREA * AND TO 0 FOR BASE PAGE ONLY. * * JSB SCNBP * * RETURN: * P+1Q: LINK NOT FOUND * P+2: LINK FOUND (A = ADDR OF OPERAND) * SCN NOP LDA LNK1,I GET THE LOWER ADDRESS STA LNK AND SAVE IT LDB BPONL GET THE BASE PAGE ONLY FLAG AND M0760 ISOLATE THE PAGE OF CURRENT AREA SZA,RSS IF BP THEN CCB SET B FOR OK SSB,RSS IF BP ONLY AND NOT BP JMP SCN,I RETURN NOT FOUND * SZA CHECK IF RIGHT PAGE (BP IS ALWAYS RIGHT) CPA OPPAG RSS GOOD LINK AREA JMP SCN,I NOT RIGHT PAGE, EXIT * LDB LNK3,I GET THE IMAGE ADDRESS TO B SCN1 LDA LNK GET THE ACTUAL ADDRESS TO A CPA LNK2,I END OF AREA? JMP SCN,I YES, EXIT NOT FOUND * LDA B,I NO, GET THE VALUE CPA OPRND THIS IT? JMP SCN2 YES, GO RETURN IT * INB NO SET FOR NEXT ENTRY ISZ LNK JMP SCN1 * SCN2 LDA LNK GET THE CORE ADDRESS ISZ SCN STEP TO THE RETURN ADDRESS JMP SCN,I RETURN, LINK FOUND, ADDRESS IN A SKP * * ALLOCATE NEW LINK WORD * * THE ALLOC SUBROUTINE ESTABLISHES ALL THE LINKAGE ADDRESSES. * IF THE ALLOCATED LINK WORD FALLS IN THE SYSTEM COMMUNICATION AREA, * A DISGNOSTIC IS PRINTED. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB ALLOC * * RETURN: * A = ALLOCATED BP LINK ADDRESS * B = DESTROYED * ALLOC NOP LDB OPRND SAVE THE OPERAND STB ALSAV LOCALLY CLB SET OPERAND STB OPRND TO ZERO TO CALL SCN LDA CPL1 SET UP TO SCAN THE LOW CP LINK AREA JSB LNKS JSB SCN SCAN THE AREA RSS IF NOT ALLOCATED SKIP JMP ALLO1 ELSE GO SET UP * LDA CPL2 TRY THE HIGH AREA JSB LNKS SET IT UP JSB SCN SCAN IT CLA,INA,RSS IF NOT FOUND SKIP JMP ALLO1 ELSE GO SET IT UP IFN *** BEGIN NON-MEU CODE *** STA LNK1 FOOL THE COUNTER LDA TBREL CHECK FOR OVER FLOW CPA LWSBP TOO MUCH? JMP ER16 YES GO SEND MESSAGE * ISZ TBREL STEP FOR NEXT TIME LDB A COMPUTE THE ADB ADBP IMAGE OF THE BASE PAGE **** END NON-MEU CODE **** XIF IFZ ***** BEGIN MEU CODE ***** * SET UP NEW LINK IN BASE PAGE AREA SPC 1 STA LNK1 SKIP FLAG = 1 LDA TBREL DOES NEW LINK CPA BPLMT EQUAL LIMIT ADDR JMP ER16 YES,ERROR LDB A NO, SAVE LINK ADDR ADA BPINC UPDATE TO NEXT STA TBREL SET NEXT LINK ADDR LDA B GET REAL ADDR OF NEW LINK ADB ADBP AND IMAGE ADDR OF NEW LINK SPC 1 * TBREL CONTAINS POINTER TO NEXT FREE BPLINK (STARTS * AT 2 FOR DR'S, FSYBP FOR MR'S, AND LWSBP FOR SYS, * LIB, AND SSGA MODULES). BPINC SET TO -1 WHEN * LOADING SYS, TABLES, LIB, & SSGA, AND TO +1 * OTHERWISE. BPLMT SET TO FSYBP (ABOVE TRAP CELLS) * FOR SYS,LIB,TABLES,AND SSGA, AND TO LOWEST * SYSTEM LINK FOR OTHERS. ****** END MEU CODE ****** XIF ALLO1 STA TCHR SET THE ADDRESS LDA ALSAV GET THE OPERAND STA OPRND RESTORE IT STA B,I SET IT IN THE IMAGE AREA LDA LNK1 IF ALLOCATION FROM CPA CPL1 CP LOW AREA ISZ CPL1H STEP THE COUNT CPA CPL2 IF FORM THE HIGH AREA ISZ CPL2H STEP ITS COUNT LDA TCHR SET THE ADDRESS IN A JMP ALLOC,I AND RETURN * ER16 LDA ERR16 GET THE ERROR CODE JSB ..GNR SEND IT CLA RETURN ZERO AS THE LINK JMP ALLOC,I * ALSAV NOP TCHR NOP SKP * * PACK THE CP LINK AREA * * CCPLK PACKS THE CURRENT PAGE LINK AREA TO GET RID OF LINK * AREAS THAT ARE NO LONGER ACTIVE. * * CALLING SEQUENCE: * * LDA CURRENT PAGE ADDRESS * JSB CCPLK * * RETURN REGISTERS MEANING LESS * * CCPLK WILL DELETE ALL LINK AREAS THAT ARE ABOVE * CPLS AND REFER TO AN AREA ON A PAGE BELOW THE PAGE * ADDRESS IN A ON ENTRY. IT WILL ALSO DELETE ALL * ENTRIES FOR ZERO LENGTH AREAS. * CCPLK NOP AND M0760 SAVE THE CMA,INA PAGE STA CPAG ADDRESS LDA CPLS GET THE LOWEST ENTRY TO SAVE STA TCCP4 SAVE FOR LAST VALID ENTRY JSB LNKS SET UP THE LNK AREA JSB LNK GET THE FIRST POSSIBLE PURGE AREA JMP CCPLK,I IF NONE THEN EXIT * LDA LNK1,I IF THIS AREA CPA LNK2,I IS OF ZERO LENGTH JMP CCPL0 GO SET UP * AND M0760 ELSE IF AREA IS ABOVE OR EQUAL ADA CPAG TO THE SAVE PAGE AREA SSA,RSS THEN JMP CCPLK,I EXIT - NO PACK NEEDED * CCPL0 LDA LNK1 SET UP THE NEXT AVAILABLE CCPL1 STA TCCP1 POINTER CCPL5 JSB LNK GET THE NEXT ENTRY JMP CCPL3 IF NONE GO HANDLE * LDA LNK1,I IF STILL CPA LNK2,I A ZERO ENTRY JMP CCPL5 REJECT THE ENTRY AND M0760 ISOLATE THE PAGE ADDRESS ADA CPAG IF STILL SSA BELOW THE SPECIFIED PAGE JMP CCPL5 REJECT THE ENTRY * LDA TCCP1 KEEP THE AREA STA TCCP4 SET LAST AREA POINTER STA TCCP2 SET MOVE POINTER LDA LNK2,I SET UP THE CMA,INA ADA LNK1,I MOVE STA TCCP3 COUNT LDA LNK1,I SET WORDS STA TCCP2,I ONE ISZ TCCP2 LDA LNK2,I TWO STA TCCP2,I ISZ TCCP2 LDA TCCP2 AND INA STA TCCP2,I THREE LDB LNK3,I MOVE CCPL2 ISZ TCCP2 THE LDA B,I IMAGE STA TCCP2,I TO THE NEW LOCATION INB ISZ TCCP3 JMP CCPL2 * LDA LNK1 AND CPA CPL2 CPL2 JMP CCPL3 IF END GO DO SPECIAL * LDA TCCP2 UPDATE t3 INA FOR THE NEXT ENTRY JMP CCPL1 AND GO DO IT * CCPL3 LDB TCCP4 SET UP STB CPL2 CPL2, THE UPPER LIMIT JMP CCPLK,I AND EXIT SPC 2 TCCP1 NOP TCCP2 NOP TCCP3 NOP TCCP4 NOP CPAG NOP SKP * * CLEAR THE CURRENT PAGE * * CLRCP CLEARS THE CURRENT PAGE LINKING IMAGE POINTED AT BY * THE CURRENT LNK ENTRY. * CLRCP NOP LDA LNK2,I COMPUTE CMA,INA NUMBER ADA LNK1,I OF STA LNK WORDS TO CLEAR SZA,RSS IF ZERO THEN JMP CLRCP,I EXIT * LDA LNK3,I STA LNKX GET ADDRESS OF AREA CLRC1 CLA CLEAR STA LNKX,I A WORD ISZ LNKX STEP TO NEXT ONE LDA LNKX CHECK FOR ADA CPLIM OVERFLOW OF SSA,RSS IMAGE AREA JMP TRUN GO SHORTEN IF OVERFLOW * ISZ LNK STEP COUNTER JMP CLRC1 IF NOT DONE DO NEXT ONE * JMP CLRCP,I RETURN * TRUN LDA LNK3,I CACULATE MAX ADA CPLIM AREA SIZE CMA,SSA,INA IF NEGATIVE CLA SET TO ZERO ADA LNK1,I ADD BASE ADDRESS STA LNK2,I SET NEW UPPER END JMP CLRCP,I AND RETURN SKP * * OUTPUT CURRENT CURRENT PAGE * * OUTCP OUTPUTS THE AREA SPECIFIED BY LNK1, LNK2, AND LNK3 * TO THE DISC. * * CALLING SEQUENCE: * * SET UP LNK1, LNK2, LNK3 * JSB OUTCP * * RETURN REGISTERS MEANINGLESS * OUTCP NOP JSB LNKS SET UP THE LNK AREA LDA LNK1,I GET THE CMA,INA NUMBER OF ADA LNK2,I WORDS TO OUTPUT TO CMA,INA,SZA,RSS A AND IF ZERO JMP OUTCP,I RETURN * STA WDCNT SET THE COUNT LDA LNK3,I GET THE ADDRESS OF THE FIRST WORD STA TBUF AND SET IT LDB LNK1,I GET THE CORE ADDRESS TO BE USED OUTC2 LDA TBUF,I GET A WORD JSB LABDO SEND IT TO THE DISC ISZ TBUF STEP THE WORD ADDRESS ISZ WDCNT AND THE COUNT DONE? JMP OUTC2 NO DO THE NEXT WORD * JMP OUTCP,I YES RETURN SKP * * READ RELOCATABLE RECORD CONTROL * * DBSET ESTABLISHES THE ADDRESS OF THE NEXT WORD OF THE RELOCATABLE * RECORD IN LBUF. IF LBUF HAS BEEN PROCESSED, IT ISSUES A CALL TO * RDBIN TO READ ANOTHER RELOCATABLE RECORD. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB DBSET * * RETURN: CONTENTS OF A AND B ARE DESTROYED * DBSET NOP ISZ CURAL INCR CURRENT LBUF ADDRESS ISZ LCNT SKIP - END OF LBUF JMP DBSET,I RETURN LDA ALBUF READ NEXT RELOC RECORD. STA CURAL CLB JSB RDBIN JSB ABORT ERROR (MSG ALREADY DISPLAYED). SZA,RSS JSB ABORT EOF. CMA,INA SET COUNT. STA LCNT JMP DBSET,I RETURN. SPC 3 SPC 1 * SEND MESSAGE "BP LINKAGE XXXX" ROUTINE. SPC 1 BPLNR NOP LDB MES03 XXX IS IN A ON ENTRY. JSB CONVD LDA P16 LDB MES02 JSB DRKEY JMP BPLNR,I * MES02 DEF MS02 MS02 ASC 8,BP LINKAGE XXXXX MES03 DEF MS02+5 SKP * CLEAR LOCAL LST ENTRIES * * CLRLT CLEARS THE CURRENT BP LINKAGE ADDRESSES IN THE BASE PAGE * IMAGE. (CLEARS B-A WORDS). * * CALLING SEQUENCE: * A = CURRENT LOW BP ADDRESS * B = CURRENT HIGH BP ADDRESS PLUS ONE * JSB CLRLT * * RETURN: CONTENTS OF A AND B ARE DESTROYED. * CLRLT NOP IFZ ***** BEGIN MEU CODE ***** STA CLRTM SAVE PARM IN TEMP LDA BPINC AND PICK UP BP INCREMENT ELA AND SAVE SIGN (<0 = DOWN) LDA CLRTM THEN RESTORE PARM. SEZ IF BP LINKS GO DOWNWARD, SWP THEN SWAP PARMS. ****** END MEU CODE ****** XIF CMB,INB ZB@<,B><,T> * * N1 = CHANNEL NO. (2 OCTAL DIGITS) * N2 = DRIVER CLASS. CODE (2 OCTAL DIGITS) * D = DMA FLAG (OPTIONAL) * B = BUFFERING FLAG (OPTIONAL) * T = TIME-OUT VALUE TO BE ENTERED * * IF T IS ENTERED, A VALUE FOR THE DEVICE'S TIME-OUT * CLOCK MUST BE NEXT ENTERED IN RESPONSE TO: * ' T = ' * THE OPERATOR MUST ENTER A POSITIVE DECIMAL NUMBER * OF UP TO FIVE DIGITS. THIS IS THEN THE NUMBER OF * TIME BASE GENERATOR INTERRUPTS (10 MSEC INTERVALS) * BETWEEN THE TIME IO IS INITIATED ON THE DEVICE AND * THE TIME AFTER WHICH THE DEVICE SHOULD HAVE INTERRUPTED. * IF THE DEVICE HAS NOT INTERRUPTED BY THIS TIME, IT * IS CONSIDERED TO HAVE TIMED-OUT. * * * EACH DRT RECORD CONSISTS OF A 2-DIGIT NO. SPECIFYING THE * CORRESPONDING ENTRY IN THE EQUIPMENT TABLE * AND AN OPTIONAL 1-DIGIT NO. SPECIFYING A * SUBCHANNEL WITHIN THAT ENTRY. FOR EXAMPLE, IN * RESPONSE TO THE MESSAGE: 5 = ?, THE RESPONSE 6 INDICATES THAT * THE LOGICAL UNIT NO. 5 IS TO USE DEVICE 6 IN EQT. * WHEREAS THE RESPONSE 6,2 INDICATES THAT THE * LOGICAL UNIT NO. 5 IS TO USE SUBCHANNEL 2 OF * DEVICE 6 IN EQT. * * * THE INT RECORDS HAVE ONE OF THE FOLLOWING FORMATS: * * N1,EQT,N2 * N1,PRG,NAME * N1,ENT,ENTRY * N1,ABS,N3 * * N1 = CHANNEL NO. (2 OCTAL DIGITS - MUST BE IN INCREASING ORDER) * EXCEPTION: IF N1 = 04 (POWER - FAIL), * THIS ENTRY DOES NOT HAVE TO BE IN ORDER. ALSO, * ONLY AN ENT OR AN ABS TYPE ENTRY IS ACCEPTED * FOR N1 = 04. * N2 = EQT NO. * NAME = PROGRAM NAME TO BE SCHEDULED * ENTRY = ENTRY POINT TO WHICH TRANSFER IS TO BE MADE * N3 = ABSOLUTE VALUE (6 OCTAL DIGITS) * * * GNIO NOP LDA GNIO SAVE RETURN ADDRESS. STA IRERR *TEMP STORE* CLA SET FLAG *TEMP* tSTA .LST1 TO DETERMIN IF A TABLE GENERATED STA GN.ER CLEAR THE ERROR FLAG JSB DSTBL GO GENERATE A DISC MAP TABLE LDA IRERR RESTORE RETURN ADDR. STA GNIO LDA .LST1 IF A SZA TABLE GENERATED JSB DAFIX FIX UP THE REFERENCES * * GENERATE THE CLASS I/O TABLE * CLA STA SPLCO CLEAR THE SPOOL EQT COUNT. JSB RED2 SEND MESSAGE AND GET ANSWER DEC 18 18 CHARACTERS DEF MES04 '*# OF I/O CLASSES?' DEF $CLS ADDRESS OF ENT NAME ADB OCTNO RESERVE ROOM STB PPREL FOR IT (SETS IT TO ZERO) * * GENERATE THE LU MAP TABLE * JSB RED2 SEND MESSAGE AND GET ANSWER DEC 18 DEF MES05 '*# OF LU MAPPINGS?' DEF $LUMP ADDRESS OF ASC ENT NAME LDA OCTNO INITILIZE THE TABLE CMA,INA TO STA TBUF -1'S NXLUM CCA AND JSB LABDO THEN ISZ TBUF JMP NXLUM RESET * STB PPREL THE RELOCATION ADDRESS * * GENERATE THE RN TABLE * JSB RED2 SEND MESSAGE AND GET DEC 23 ANSWER DEF MES06 '*# OF RESOURCE NUMBERS?' DEF $RNTB ADDRESS OF ENT POINT NAME ADB OCTNO RESERVE THE TABLE AREA STB PPREL (SETS IT TO ZERO) STB AEQT SAVE ADDRESS OF EQT * * SET UP THE BUFFER LIMITS * BLGEN LDA D26 SEND MESSAGE 'BUFFER LIMITS (LOW,HIGH)?' LDB DMES7 AND GET ANSWER JSB READ JSB BLSET SET UP DEF $BLLO LOWER LIMIT JMP BLGEN IF ERROR TRY AGAIN * JSB BLSET NOW SET UP THE UPPER LIMIT DEF $BLHI JMP BLGEN IF ERROR TRY AGAIN * * * GENERATE EQUIPMENT TABLE (EQT) * JSB SPACE MAKE IT LOOK NICE. CLA STA CEQT CLEAR NO. OF EQT ENTRIES CCA SET DRT2 AND STA DRT2 DRT3 STA DRT3 TO IMPOSSIBL|E NUMBERS LDA ATB30 ADA P6 SET FOR HEADER RECORD STA TEMP3 STORAGE LDA P23 LDB MES25 MES25 = ADDR: * EQT TABLE ENTRY JSB DRKEY PRINT: * EQUIPMENT TABLE ENTRY * SEQT JSB SPACE SEND SPACE LDA CEQT CONVERT CMA LDB ATBUF THE CURRENT EQT JSB CONVD NUMBER TO ASCII LDA TBUF+2 SET IN THE STA MESEQ EQT MESSAGE BUFFER LDA P7 GET MESSAGE LENGTH LDB MESQE SEND MESSAGE "EQT XX?" AND JSB READ GET EQT RECORD FROM TTY LDA N2 JSB GETNA MOVE 2 CHARS TO TBUF CPA "/E" CHARS = /E? JMP EQTFX YES - SET DEVICE REF TABLE (SQT) JSB GINIT RE-INITIALIZE LBUF SCAN LDA P2 JSB GETOC GET 2 OCTAL DIGITS, CONVERT JMP IOERR INVALID DIGIT JSB GETAL GET NEXT CHAR FROM LBUF CPA BLANK CHAR = COMMA? JMP CLDBU YES - SET CHNL NO., CLEAR D,B,U IOERR LDA ERR24 SET CODE = INVALID CHNL IN EQT JSB GN.ER PRINT DIAGNOSTIC JMP SEQT GET NEXT EQT RECORD * CLDBU LDB OCTNO GET I/O CHANNEL NO. STB IOADD SET I/O ADDRESS CLA STA IODMA CLEAR DMA FLAG STA IOBUF CLEAR AUTOMATIC BUFFERING FLAG STA FIX3,I CLEAR THE STA FIX4,I FLAG WORDS STA TVAL AND TIME OUT VALUE CCA STA TFLAG CLEAR TIME-OUT FLAG LDA N2 JSB GETNA MOVE 2 CHARS TO TBUF CPA "DV" CHAR = "DV"? CLA,INA,RSS YES - CONTINUE JMP DVERR INVALID DRIVER NAME JSB GETNA MOVE 1 CHAR TO TBUF (CHAR 3) JMP STYPE GET DRIVER TYPE * DVERR LDA ERR25 SET CODE = INVALID DRIVER NAME JSB GN.ER PRINT DIAGNOSTIC JMP SEQT GET NEXT EQT RECORD * STYPE STA X. SAVE KEY CHARACTER (R FOR STD.) LDA N2 JSB GETNA MOVE 2 CHARS TO TBUF STA .YY SAVE 2 ASCII CHARS FOR I.XX,C.'XX CCA ADA CURAL ADJUST CURRENT LBUF ADDR STA CURAL RESET CURAL TO CONVERT TYPE LDA P2 JSB GETOC GET 2 OCTAL CHARS, CONVERT JMP DVERR INVALID DRIVER NAME * LDB OCTNO GET DRIVER TYPE BLF,BLF ROTATE TO UPPER B STB IOTYP SET DRIVER TYPE JSB GETAL GET NEXT CHAR FROM LBUF CPA ZERO END OF BUFFER? JMP GENEQ SCAN FOR I.XX, C.XX CPA BLANK CHAR = COMMA? RSS YES - CONTINUE JMP DVERR NO - INVALID DRIVER NAME * CCA STA FIX1,I STA DFLAG SET DMA-IN FLAG STA BFLAG SET BUFFERING-IN FLAG STA XFLAG SET EQT EXTEND FLAG * INDBU CCA STA CMFLG SET COMMA FLAG = NO COMMA IN JSB GETAL GET NEXT CHAR FROM LBUF CPA "D" CHAR = D? JMP SEDMA YES - SET DMA CODE * CPA "B" CHAR = B? JMP SETBU YES - SET BUFFERING CODE * CPA "T" CHAR = T? JMP SETIM YES - SET TIME-OUT FLAG * CPA "X" CHAR = X? JMP SETEX YES GO SET UP EQT EXTENSION * UNERR LDA ERR26 SET CODE = INVALID D,B,T,X JSB GN.ER PRINT DIAGNOSTIC JMP SEQT GET NEXT EQT RECORD * SETIM ISZ TFLAG SKIP - FIRST T ENTERED JMP UNERR DUPLICATE T'S ENTERED * JMP TEQU GET THE TIME OUT VALUE * EQTST JSB GETAL GET NEXT CHAR FROM LBUF CPA ZERO END OF BUFFER? JMP GENEQ SCAN FOR I.XX, C.XX * CPA BLANK CHAR = COMMA? JMP INDBU YES - GET NEXT D,B,U, ENTRY * JMP UNERR NO - INVALID D,B,U CHARACTER * SEDMA ISZ DFLAG SKIP - FIRST D ENTERED JMP UNERR DUPLICATE D'S ENTERED * LDA MSIGN SET BIT 15 = 1 FOR DMA FLAG STA IODMA SET DMA CODE JMP EQTST TEST FOR NEXT OPERAND * SETBU ISZ BFLAG SKIP - FIRST B ENTERED JMP UNERR DUPLICATE B'S ENTERED * LDFA BIT14 SET BIT14 = 1 STA IOBUF SET AUTOMATIC BUFFERING CODE JMP EQTST TEST FOR NEXT OPERAND * SETEX ISZ FIX1,I SKIP FIRST X ENTERED JMP UNERR NO BITCH * TEQU STA I.XX SAVE THE TYPE FLAG JSB GETAL GET THE NEXT CHARACTER CPA EQU IF NOT "=" RSS JMP UNERR BITCH * LDA N5 GET DECIMAL NUMBER JSB GETOC JMP UNERR ILLEGAL NUMBER SO BITCH * LDB I.XX GET THE TYPE FLAG CPB "X" IF EXTENSION STA FIX3,I SAVE THE LENGTH OF THE EXTENSION CPB "T" IF TIME OUT STA TVAL SET THE TIME OUT VALUE JMP EQTST GO GET THE NEXT OPERAND * GENEQ LDA X. GET THE KEY CHARACTER CPA "R" IF R THEN USE LDA "." A PERIOD. IOR "INL" SET "I" IN UPPER HALF STA X. SET FOR LST SEARCH LDB ENT GET ADDRESS JSB LSTS LOOK FOR SYMBOL JMP DVERR ILLEGAL DRIVER ENT NOT FOUND. * LDA .LST5,I GET CORE ADDRESS STA I.XX SAVE DRIVER ENTRY POINT * LDA X. GET THE I. OR WHAT EVER XOR B5000 CHANGE IT TO C. OR WHAT EVER STA X. AND RESET LDB ENT SCAN THE LST JSB LSTS FOR THE "C.YY" ENTRY POINT. JMP NOCXX C.XX NOT FOUND IN LST * LDA .LST5,I GET CORE ADDRESS STCXX STA C.XX SAVE DRIVER EXIT POINT LDA X. IF THIS IS CPA "CS" DVS43 THEN LDA .YY COUNT CPA "43" A ISZ SPLCO SPOOL EQT * LDA IOADD SAVE THE CHANNEL AND AND M377 TYPE IN THE HEADER ALF,ALF RECORD LDB IOTYP BLF,BLF IOR B STA TEMP3,I ISZ TEMP3 * CLA LDB PPREL GET THE ADDRESS JSB LABDO PUT OUT I/O LIST POINTER LDA I.XX GET DRIVER ENTRY POINT JSB LABDO OUTPUT ABSOLUTE DVRXX ENT ADDR LDA C.XX B@< GET DRIVER EXIT POINT JSB LABDO OUTPUT ABSOLUTE DVRXX COMP. ADDR LDA IODMA GET DMA CODE IOR IOBUF ADD BUFFERING CODE IOR IOADD ADD CHANNEL NO. JSB LABDO OUTPUT D,B,U, CHANNEL * LDA IOTYP GET EQUIPMENT TYPE CODE AND M7000 ISOLATE UPPER 7 BITS SZA SKIP - TYPE = 0,I CLA,RSS SET STATUS = 0, SKIP LDA BLANK SET STATUS = 40(8) IOR IOTYP ADD EQUIPMENT TYPE CODE JSB LABDO OUTPUT EQUIPMENT TYPE, STATUS * LDA N8 ADB P6 INDEX TO EQT12 LDA FIX3,I GET EXTENSION SIZE JSB LABDO AND SEND IT TO THE DISC STB FIX2,I SAVE EQT13 ADDRESS FOR EXTENT ALLOCATION INB STEP TO EQT14 LDA TVAL GET THE TIME OUT VALUE SZA IF ZERO LEAVE IT CMA ELSE SET IT TO ONES COMPLEMENT JSB LABDO SEND TIME OUT TO EQT INB SET THE ADDRESS STB PPREL OF THE NEXT EQT * JSB SFIX GET A NEW FIXUP TABLE ENTRY IF NEEDED ISZ CEQT INCR EQT ENTRY COUNT JMP SEQT PROCESS NEXT EQT RECORD * NOCXX LDA I.XX C.XX NOT FOUND SO USE JMP STCXX I.XX ADDRESS cdB SPC 2 MESQE DEF *+1 ASC 2,EQT DO NOT REARANGE THESE MESEQ NOP THESE THREE ASC 1,? LINES "CS" ASC 1,CS "43" ASC 1,43 SPLCO NOP D26 DEC 26 "R" OCT 122 "X" OCT 130 EQU OCT 75 ASCII "=" XFLAG NOP TVAL NOP "DV" ASC 1,DV "." OCT 56 "INL" OCT 44400 ASCII I NULL B5000 OCT 5000 SPC 5 * THE BLSET ROUTINE SETS UP THE BUFFER LIMITS. * * CALLING SEQUENCE: * * JSB BLSET * DEF ENT NAME ENTRY POINT NAME ADDRESS * JMP RETRY ERROR RETURN * * --- NORMAL EXIT * BLSET NOP FIRST FIND LDB BLSET,I THE ENTRY POINT ISZ BLSET STEP RETURN ADDRESS JSB LSTS SEARCH FOR THE ENTRY JMP FGET IF NOT FOUND JUST EXIT * LDA N5 CONVERT A 5 DIGIT DECIMAL JSB GETOC LIMIT JMP BLSET,I ERROR TAKE ERROR EXIT * LDB .LST5,I GET THE LIST ADDRESS CMA,INA SET THE LIMIT NEGATIVE AND JSB LABDO GO OUTPUT THE LIMIT FGET ISZ BLSET STEP TO OK RETURN JMP BLSET,I AND RETURN SKP * * THE RED2 SUBROUTINE IS USED TO SET UP TABLES * WHICH START WITH THERE SIZE AS THE FIRST WORD * * CALLING SEQUENCE: * * JSB RED2 * DEC XX CHARACTER COUNT OF QUESTION. * DEF MESXX ADDRESS OF ASCII MESSAGE * DEF ENT ADDRESS OF ASCII ENTRY POINT NAME * RETURN B=NEXT AVAILABLE CORE LOCATION * REERR JSB INERR SEND ERROR 01 AND RSS RETRY * RED2 NOP ENTRY POINT RERED DLD RED2,I GET THE MESSAGE PRAMETERS JSB READ GO SEND MESSAGE AND GET RESPONCE LDA N3 CONVERT 3 ASCII DIGITS JSB DOCON AS DECIMAL JMP RERED IF ERROR RETRY * AND M7400 IF NOT LESS THAN SZA 256 JMP REERR THEN ERROR * LDA OCTNO GET THE ANSWER AGAIN SZA,RSS IF ZERO INA SET TO ONE STA OCTNO AND RESET ISZ RED2 STEP ISZ RED2 TO THE SYMBOL ADDRESS LDB RED2,I FIND JSB LSTS THE SYMBOL IN THE LST JSB ABORT MUST BE THERE LDB PPREL DEFINE THE SYMBOL STB .LST5,I LDA OCTNO OUTPUT THE FIRST JSB LABDO WORD STB PPREL UPDATE THE ADDRESS JSB DAFIX FIX UP ALL REFERENCES JSB SPACE MAKE IT LOOK NICE. LDB PPREL SET B FOR RETURN ISZ RED2 SET RETURN ADDRESS JMP RED2,I RETURN * MES04 ASC 9,*# OF I/O CLASSES? MES05 ASC 9,*# OF LU MAPPINGS? MES06 ASC 12,*# OF RESOURCE NUMBERS? DMES7 DEF MES07 MES07 ASC 13,BUFFER LIMITS (LOW, HIGH)? $CLS ASC 3,$CLAS $RNTB ASC 3,$RNTB $LUMP ASC 3,$LUSW $BLLO ASC 3,$BLLO $BLHI ASC 3,$BLUP $LUAV DEF *+1 ASC 3,$LUAV SPC 2 EQTFX JSB FIXX ALLOCATE AND SET UP NXEQF JSB FIX EXTENDED EQTS JMP SSQT END OF FIXUPS GO DO SQT * LDA FIX1,I GET THE TYPE FLAG SZA IF NOT ZERO THEN NOT JMP NXEQF AN EQT PATCH ENTRY * LDB FIX2,I GET EQT12 ADDRESS LDA PPREL AND CURRENT CORE ADDRESS JSB LABDO OUTPUT THE ADDRESS LDA PPREL RESERVE THE ADA FIX3,I CORE STA PPREL CCA CLEAR THE FIX STA FIX1,I ENTRY JMP NXEQF AND TRY THE NEXT ONE * SSQT LDB $LUAV MAKE THE LUAV TABEL JSB LSTS FIRST SET UP THE ENTRY JSB ABORT IT BETTER BE THERE LDB PPREL GET THE CORE ADDRESS STB .LST5,I SET THE ADDRESS LDA SPLCO GET THE NUMBER OF ENTRYS CMA,INA,SZA IF ZERO SKIP THE TABEL GEN. JSB LABDO SEND THE TABEL HEAD (IF NONE ZERO) ADB SPLCO ADJUST FOR THE TABLE SIZE ADB SPLCO (TWO WORD ENTRYS) STB PPREL SET THE NEW ADDRESS JSB DAFIX GO FIX UP ANY REFERENCES SKP * * SET DEVICE REFERENCE TABLE (DRT) * JSB SPACE NEW LINE JSB SPACE NEW LINE LDA PPREL GET CURRENT RELOCATION ADDRESS STA ASQT SAVE SQT ADDRESS CLA,INA STA CSQT SET SQT COUNT = 1 CCA STA LFLAG SET 1ST DEV REF INPUT FLAG = -1 LDA P24 LDB MES26 MES26 = ADDR: *DEV REF TABLE JSB DRKEY PRINT: * DEVICE REFERENCE TABLE * DEVRE LDA CSQT GET CURRENT DEV REF NO. CMA,INA SET TO NEG. FOR DECIMAL CONV LDB ATBUF GET ADDRESS OF TBUF JSB CONVD CONVERT TO DECIMAL AT TBUF LDA TBUF+2 GET 2 LEAST SIGNIFICANT DIGITS AND M7400 ISOLATE UPPER CHAR CPA UASCZ CHAR = ASCII ZERO? LDA UBLNK YES - REPLACE WITH BLANK STA B SAVE UPPER CHAR LDA TBUF+2 GET 2-DIGIT DEV REF NO. AND M177 ISOLATE LOWER CHAR IOR B SET A = DEV REF CODE STA MES28,I PUT DEV REF CODE IN MESSAGE JSB SPACE NEW LINE LDA P11 LDB MES28 MES28 = ADDR: XX = EQT #? JSB READ GET SQT RECORD FROM TTY LDA N2 JSB GETNA MOVE 2 CHARS TO TBUF CPA "/E" CHARS = /E? JMP SINTT YES - SET INTERRUPT TABLE JSB GINIT RE-INITIALIZE LBUF SCAN LDA N2 JSB GETOC GET 2 DECIMAL DIGITS, CONVERT JMP DRERR INVALID DIGIT ENTERED STA TEMPL SAVE DEV. REF. NO. SZA,RSS IF NO CHANNEL JMP SUBCH IGNOR SUBCHANNEL JSB GETAL COMMA ENCOUNTERED? SZA,RSS YES - GO GET SUBCHANNEL JMP SUBCH NO - DEFAULT IT TO ZERO * LDA N2 JSB GETOC GET TWO DECIMAL DIGITS JMP DRERR AND M37 KEEP MAX SIZE CPA OCTNO IF NOT SAME RSS JMP DRERR THEN ERROR * SUBCH STA TEMPS SAVE SUB CHANNEL ALF,ALF SET SUBCHANNEL NO. ALF,RAR INTO BITS 13 - 11 STA TEMPH SAVE SUBCHANNEL NO. LDA TEMPL GET DEV. REF. NO. CMA,INA COMPLEMENT ADA CEQT ADD NO. EQT ENTRIES SSA SKIP IF VALID DEV. REF NO. JMP DRERR INVALID DEV. REF. NO. (NO EQT) LDA TEMPL GET DEV. REF NO. LDB CSQT GET CURRENT SQT NO. CPB P1 FIRST ENTRY? RSS YES - CONTINUE CPB P2 SECOND ENTRY? RSS YES - CONTINUE JMP SESQT PUT OUT DEV REF NO. TO SQT SZA,RSS SKIP IF DEV REF IS NOT ZERO JMP DRERR INVALID DEV. REF. NO. CPB P1 FIRST SQT ENTRY? RSS YES - CONTINUE (SET TTY CHANNEL) JMP SESQT PUT OUT DEV. REF. NO. TO SQT CMA,INA COMPLEMENT CURRENT DEV. REF. NO. LDB AEQT GET ADDRESS OF EQT INA,SZA,RSS SKIP - DEV. REF. NOT 1 JMP *+4 SET TTY CHANNEL NO. = FIRST EQT ADB P15 ADJUST CURRENT EQT ADDRESS INA,SZA SKIP - EQT FOUND JMP *-2 CONTINUE CURRENT EQT SEARCH STB TTYCH SET EQT ADDR IN TTY CHANNEL * ADB P3 RETRIEVE THE CHANNEL NO. JSB LABDO TO INSERT IN THE HEADER RECORD STA TB30+127 PLACE IN LAST WORD FOR NOW ADB N1 RESTORE THE WORD JSB LABDO * SESQT LDB CSQT SET UP TO TEST LDA TEMPS FOR PROPER SUB CHANNEL REFERENCES CPB P2 DEV. REF = 2? CPA SYSCH YES - SYSTEM SUB CHANNEL? RSS YES - YES OR NO -X SKIP JMP DRERR YES - NO - ERROR CPB P3 DEV. REF =3? CPA AUXCH YES - AUX SUB CHANNEL? JMP SETQT YES - YES OR NO - X - GO SETUP * LDA AUXCH GET THE CHANNEL SSA IF DISC ON DIFFERENT CONTROLER JMP SETQT GO SET IT UP * LDA TEMPL YES - NO - TEST FOR AUX UNIT DEFINED LDB DAUXN SZB SKIP IF NO AUX UNIT JMP DRERR AUX DEFINED SO ERROR * SZA NO AUX-UNIT WAS REF = 0? JMP DRERR NO - SO ERROR * SETQT LDA TEMPL GET DEV. REF. NO. IOR TEMPH SET IN SUBCHANNEL NO. LDB CSQT SET UP TO TEST FOR ILLEGAL DISC REF. CPA DRT2 IF SAME AS SYSTEM DISC JMP DRERR ERROR CPB P2 IF SYSTEM DISC ENTRY STA DRT2 SET FOR FUTURE TESTING CPA DRT3 IF SAME AS AUX DISC JMP DRERR ERROR SZA,RSS IF ZERO SKIP JMP *+3 TEST FOR AUX ENTRY CPB P3 IF AUX ENTRY STA DRT3 SET FOR FUTURE TESTING LDB PPREL SET CORE ADDRESS JSB LABDO OUTPUT SQT ENTRY ISZ PPREL INCR CURRENT RELOC ADDRESS ISZ CSQT INCR CURRENT SQT COUNT JMP DEVRE GET NEXT SQT ENTRY DRERR LDA ERR27 SET CODE = INVALID DEV. REF. NO. JSB GN.ER PRINT DIAGNOSTIC JMP DEVRE REPEAT INPUT * TEMPL NOP TEMPH NOP TEMPS NOP TEMP3 NOP D$CIC DEF $CIC SKP SINTT JSB SPACE NEW LINE JSB SPACE NEW LINE CCB ADB CSQT SUBTRACT 1 FROM SQT COUNT STB CSQT SET SQT COUNT * ADB PPREL THE FOLLOWING ALLOWS FOR TWO WORDS STB PPREL PER DRT ENTRY CLA ZERO THEM OUT JSB LABDO * * SET INTERRUPT TABLE (INT) * LDA PPREL GET CURRENT RELOCATION ADDR STA AINT SAVE INTERRUPT TABLE ADDRESS LDA DSKAD GET CURRENT ABS. CODE DISK ADDR STA DSKIN SAVE INT CODE DISK ADDR LDA DCNT GET CURRENT ABS. CODE DBUF COUNT STA INTCN SAVE INT CODE DISK RECORD COUNT LDA P17 LDB MES29 MES29 = ADDR. * INT TABLE JSB DRKEY PRINT: * INTERRUPT TABLE LDB AILST GET ADDRESS OF ILIST STB CURIL GET CURRENT ILIST ADDRESS JSB BUFCL CLEAR ILIST * LDB D$CIC GET ADDRESS OF CIC JSB LSTS GET LST ADDRESS JMP NOCIC CIC NOT FOUND IN LST LDA .LST5,I GET CORE ADDRESS STA OPRND SET FOR BP SCAN  CLA SET BP ONLY STA BPONL FLAG JSB BPSCN GO GET THE LINK ADDRESS IOR IJSB ADD JSB 0,I CODE STA JSCIC SET JSB CIC,I CODE LDB FSYBP GET FWA BP LINKAGE CMB,INB COMPLEMENT STB TCNT SET TEMPORARY COUNT LDB ADBP ADJUST FOR FIRST BP ADDRESS STA B,I PUT JSB CIC,I IN BP LOCATION INB INCR CURRENT BP ADDRESS ISZ TCNT SKIP - ALL INT LOCATIONS FILLED JMP *-3 CONTINUE FILLING INT LOCATIONS * LDB P4 INITIALIZE TRAP CELL FOUR ADB ADBP ADJUST TO PSEUDO BASE PAGE LDA HLTB4 TO HALT(B) 4 STA B,I ADB P2 GET ADDR OF FIRST INT LOCATION STB MEM12 SET CURRENT BP ADDRESS * SETIN CLA,INA NEW LINE LDB HYADD JSB READ GET INT RECORD FROM TTY LDA N2 JSB GETNA MOVE 2 CHARS TO TBUF CPA "/E" CHARS = /E? JMP ENDIO YES - I/O TABLES COMPLETE JSB GINIT RE-INITIALIZE LBUF SCAN LDA P2 JSB GETOC GET 2 OCTAL DIGITS, CONVERT JMP CHERR INVALID INT CHANNEL NO. DIGIT JSB GETAL GET NEXT CHAR FROM LBUF CPA BLANK CHAR = COMMA? JMP SETCH SAVE INT CHANNEL NO. CHERR LDA ERR28 SET CODE = INVALID INT CHNL NO. JSB GN.ER PRINT DIAGNOSTIC JMP SETIN REPEAT INT REC INPUT * NOCIC LDA ERR21 SET CODE = CIC NOT FOUND IN LST JSB IRERR IRRECOVERABLE ERROR * SETCH LDA OCTNO GET INT CHANNEL NO. STA INTCH SAVE CHANNEL NO. * LDA N2 JSB GETNA MOVE 2 CHARS TO TBUF CPA "EQ" CHARS = EQ? JMP INTEQ YES - PROCESS INT EQT RECORD * CPA "PR" CHARS = PR? JMP INTPR YES - PROCESS INT PRG RECORD * CPA "EN" CHARS = EN? JMP INTEN YES - PROCESS INT ENT RECORD * CPA "AB" CHARS = AB? JMP INTAB YES - PROCESS INT ABS RE"XCORD * IMNEM LDA ERR30 SET CODE = INVALID INT MNEMONIC JSB GN.ER PRINT DIAGNOSTIC JMP SETIN REPEAT INT REC INPUT * INTEQ LDA N2 JSB GETNA MOVE NEXT 2 CHARS TO TBUF CPA UTCHR CHARS = T,BLANK? RSS YES - CONTINUE JMP IMNEM NO - INVALID INT MNEMONIC LDA N2 JSB GETOC GET 2 DECIMAL DIGITS, CONVERT JMP EQUER INVALID EQT NO. IN INT REC LDB OCTNO GET EQT TABLE ENTRY NO. CMB,INB,SZB,RSS SKIP - VALID LOWER LIMIT JMP EQUER INVALID EQT REFERENCE STB TCHR SAVE EQT NO. ADB CEQT ADD UPPER EQT REF. NO. SSB,RSS SKIP - INVALID UPPER LIMIT JMP TSTIQ TEST FOR FIRST EQT REFERENCE * EQUER LDA ERR31 SET CODE = INVALID EQT NO. JSB GN.ER PRINT DIAGNOSTIC JMP SETIN REPEAT INT REC INPUT * TSTIQ LDB TCHR GET EQT REF. NO. LDA AEQT GET ADDR OF EQT INB,SZB,RSS SKIP - NOT FIRST EQT REFERENCE JMP SEQTI SET EQT ADDR IN INT TABLE * ADA P15 ADJUST FOR NEXT EQT ENTRY ADDR INB,SZB SKIP - EQT ADDRESS FOUND JMP *-2 CONTINUE EQT SEARCH * SEQTI LDB JSCIC GET JSB CIC CODE JMP COMIN SET INTERRUPT TABLE, LOCATION * INTPR LDA N2 JSB GETNA MOVE 2 CHARS TO TBUF CPA UGCHR CHARS = G,BLANK? RSS YES - CONTINUE JMP IMNEM NO - INVALID INT MNEMONIC LDA N5 JSB GETNA MOVE 5 CHARS TO TBUF * LDB ATBUF FIND THE PROGRAM JSB IDXS IN THE IDENT LIST JMP PRERR INVALID PROGRAM NAME LDB JSCIC GET JSB CIC CODE LDA TIDNT GET CURRENT IDENT INDEX ADA N1 CMA,INA SET NEGATIVE JMP COMIN SET INTERRUPT TABLE, LOCATION * PRERR LDA ERR32 SET CODE = INVALID PROGRAM NAME JSB GN.ER PRINT DIAGNOSTIC JMP SETIN REPEAT INT REC INPUT * * INTEN LDA N2 JSB GETNA MOVE_ 2 CHARS TO TBUF CPA UTCHR CHARS = T, BLANK RSS YES - CONTINUE JMP IMNEM INVALID INT MNEMONIC LDA N5 JSB GETNA MOVE 5 CHARS TO TBUF * LDB ATBUF FIND THE ENTRY JSB LSTS IN THE LST JMP ENERR INVALID ENTRY POINT LDA .LST4,I GET IDENT INDEX SZA,RSS SKIP - ENT IS DEFINED JMP ENERR INVALID ENTRY POINT STA TIDNT SET IDENT INDEX OF PROGRAM JSB IDX SET IDENT ADDRESSES JSB ABORT END OF IDENT LIST LDA ID6,I GET PROGRAM TYPE AND M177 ISOLATE TYPE SZA,RSS SKIP - NOT SYSTEM PROGRAM JMP SETEN SET ENTRY POINT ADDRESS * ENERR LDA ERR33 SET CODE = INVALID ENTRY POINT JSB GN.ER PRINT DIAGNOSTIC JMP SETIN REPEAT INT RECORD INPUT * SETEN LDA .LST5,I GET CORE ADDRESS STA OPRND SET THE OPERAND ADDRESS JSB BPSCN GET THE LINK ADDRESS IOR IJSB ADD JSB 0,I CODE STA B CLA SET INT ENTRY = ZERO JMP COMIN SET INTERRUPT TABLE, LOCATION * INTAB LDA N2 JSB GETNA MOVE 2 CHARS TO TBUF CPA USCHR CHARS = U,BLANK RSS YES - CONTINUE JMP IMNEM NO - INVALID INT MNEMONIC LDA P6 JSB GETOC GET 6 OCTAL DIGITS, CONVERT JMP ABERR INVALID ABS DIGIT CLA LDB OCTNO GET ABSOLUTE VALUE * COMIN STA TBUF SAVE INT TABLE CODE STB TBUF+1 SAVE INT LOCATION CODE JSB GETAL GET NEXT CHAR FROM LBUF CPA ZERO END OF BUFFER? JMP *+4 YES - CONTINUE * LDA ERR36 SET CODE = INVALID FINAL OPRND JSB GN.ER PRINT DIAGNOSTIC JMP SETIN GET NEXT INT RECORD * LDA INTCH GET INT CHANNEL NO. CPA P4 SPECIAL PROCESSING JMP PFINT IF TRAP CELL FOUR CMA,INA ADA NADBP ADJUST FOR BP LOCATION ADDR ADA MEM12 ADD CURRENT BP ADDRESS SZA,RSS SKIP - NOT NEXT LOCATION JMP STINT SET INTERRUPT TABLES, LOCATION * SSA SKIP - INVALID CHANNEL NO. ORDER JMP FILLI FILL IN SKIPPED VALUES LDA ERR29 SET CODE = INVALID INT CHNL ORDR JSB GN.ER PRINT DIAGNOSTIC JMP SETIN GET NEXT INTERRUPT RECORD * PFINT LDA TBUF IF TRAP CELL FOUR, SZA ENTRY MUST BE AN JMP CHERR 'ABS' OR AN 'ENT' * LDA ADBP ADA P4 ADJUST LDB TBUF+1 STORE INTO STB A,I TRAP CELL FOUR JMP SETIN GET NEXT INTERRUPT RECORD * HLTB4 OCT 103004 TRAP CELL DEFAULT VALUE * FILLI STA TCNT SET NO. OF FILL-INS REQUIRED FILLJ CLA SET INTERRUPT TABLE ENTRY = ZERO LDB PPREL GET ADDRESS JSB LABDO OUTPUT ZERO TO INTERRUPT TABLE ISZ PPREL INCR CURRENT INT TABLE ADDRESS LDA JSCIC GET JSB CIC CODE STA MEM12,I PUT JSB CIC IN INT LOCATION ISZ MEM12 INCR CURRENT INT LOCATION ADDR ISZ CURIL STEP THE INT IMAGE ADDRESS ISZ TCNT SKIP - ALL FILL-INS COMPLETE JMP FILLJ CONTINUE INT FILL-IN * STINT LDB TBUF+1 GET INT LOCATION CODE STB MEM12,I PUT INT LOCATION CODE IN INT LOC ISZ MEM12 INCR CURRENT BP LOCATION ADDR LDB MEM12 GET INT LOCATION ADDR ADB NADBP ADJUST FOR BP ADDR CMB,INB ADB FSYBP ADD ADDR OF FIRST SYS LINK SSB,RSS SKIP - INT LOCATION OVERFLOW JMP NOBPO SET INT TABLE ENTRY * LDA ERR35 SET CODE = BP INT LOC OVERFLOW JSB GN.ER PRINT DIAGNOSTIC JSB SPACE NEW LINE JMP FWBPL GET FWA BP LINKAGE * ABERR LDA ERR34 SET CODE = INVALID ABS DIGIT JSB GN.ER PRINT DIAGNOSTIC JMP SETIN REPEAT INT REC INPUT * NOBPO LDA TBUF GET INT TABLE CODE STA CURIL,I SET WORD IN INT IMAGE ISZ CURIL STEP IMAGE ADDRESS F*<:6OR NEXT TIME LDB PPREL GET CORE ADDRESS JSB LABDO OUTPUT INT TABLE ENTRY ISZ PPREL INCR CURRENT RELOCATION ADDR JMP SETIN GET NEXT INT TABLE RECORD * ENDIO LDA AINT GET ADDRESS OF INT CMA,INA ADA PPREL ADD CURRENT RELOCATION ADDR STA CINT SAVE NO. INT ENTRIES JSB SPACE NEW LINE JSB SPACE NEW LINE JMP GNIO,I RETURN - CONTINUE LOADING < SKP * IOADD BSS 1 I/O ADDR (CHANNEL NO.) IN EQT IODMA BSS 1 I/O DMA FLAG IN EQT IOBUF BSS 1 I/O BUFFERING FLAG IN EQT IOTYP BSS 1 I/O DRIVER TYPE IN EQT (OCTAL) DFLAG BSS 1 DMA-IN FLAG FOR EQT BFLAG BSS 1 BUFFERING-IN FLAG FOR EQT TFLAG BSS 1 TIME-OUT ENTRY FLAG FOR EQT INTCH BSS 1 INT RECORD CHANNEL NO. JSCIC BSS 1 JSB CIC,I CODE FOR INTERRUPT LOC I.XX BSS 1 DRIVER ENTRY POINT C.XX BSS 1 DRIVER EXIT POINT * MS28 ASC 6, = EQT #? MS29 ASC 9,* INTERRUPT TABLE ENT DEF *+1 X. ASC 1,I. .YY NOP ASC 1, SPC 1 MES25 DEF *+1 ASC 12,* EQUIPMENT TABLE ENTRY SPC 1 MES26 DEF *+1 ASC 12,* DEVICE REFERENCE TABLE SKP ERR21 ASC 1,21 $CIC NOT FOUND IN LST ERR24 ASC 1,24 INVALID CHANNEL NO. IN EQT REC ERR25 ASC 1,25 INVALID DRIVER NAME ERR26 ASC 1,26 INVALID D,B, OR T OPERAND ERR27 ASC 1,27 INVALID DEVICE REF. NO. ERR28 ASC 1,28 INVALID INT REC CHANNEL NO. ERR29 ASC 1,29 INVALID INT CHANNEL NO. ORDER ERR30 ASC 1,30 INVALID INT REC MNEMONIC ERR31 ASC 1,31 INVALID EQT NO. IN INT RECORD ERR32 ASC 1,32 INVALID PROGRAM NAME IN INT REC ERR33 ASC 1,33 INVALID ENTRY POINT IN INT RECORD ERR34 ASC 1,34 INVALID ABS VALUE IN INT REC ERR35 ASC 1,35 BP INTERRUPT LOCATION OVERFLOW ERR36 ASC 1,36 INVALID FINAL OPERAND IN INT REC "/E" ASC 1,/E IJSB JSB 0,I I-JSB CODE FOR INTERRUPT LOCS UASCZ OCT 30000 UPPER ASCII ZERO CHAR "D" OCT 104 ASCII CHAR D "B" OCT 102 ASCII CHAR B "T" OCT 124 ASCII CHAR T BIT14 OCT 40000 BIT 14=1 $CIC ASC 3,$CIC "EQ" ASC 1,EQ "PR" ASC 1,PR "EN" ASC 1,EN "AB" ASC 1,AB UTCHR ASC 1,T UGCHR ASC 1,G USCHR ASC 1,S MES28 DEF MS28 MES29 DEF MS29 SPC 2 ZERO DEC 0 P1 DEC 1 P2 DEC 2 P3 DEC 3 P4 DEC 4 P6 DEC 6 P7 DEC 7 P11 DEC 11 P15 DEC 15 fP17 DEC 17 P23 DEC 23 P24 DEC 24 N2 DEC -2 N3 DEC -3 N5 DEC -5 N8 DEC -8 M37 OCT 37 M377 OCT 377 M177 OCT 177 M7000 OCT 177000 M7400 OCT 177400 MSIGN OCT 100000 BLANK OCT 40 HYADD DEF *+1 ASC 1,- UBLNK OCT 20000 SKP * DFIX DOES THE FIX UP POINTED TO BY THE CURRENT FIX UP * TABLE AND LST ENTRYS. DFIX IS USED FOR ALL * INSTRUCTIONS AND MAY BE CALLED ONLY * AFTER THE SYMBOL (IF ANY) IS DEFINED. * * CALLING SEQUENCE: * * SET UP FIX1-4 AND LST1-5 FOR THE ENTRY * * JSB FIX * * RETURN THE FIX ENTRY IS FREE, A/B MEANING LESS * DFIX NOP CCB,CLE SET THE NOT BP LINK STB BPONL FLAG LDA FIX4,I IF NO SZA,RSS LST INDEX JMP VFIX USE ZERO VALUE * LDA .LST5,I GET THE SYMBOL VALUE LDB .LST4,I GET THE SYMBOL TYPE CPB P4 IS REPLACEMENT SYMBOL JMP ZFIX GO DO REPLACEMENT * VFIX LDB FIX2,I GET THE BYTE BLF,RBL BIT TO RBL,CLE,SLB,ERB E AND ADA A DOUBLE THE ADDRESS IF SET BLF,BLF RESTORE B BLF,RBR WITHOUT THE BYTE BIT STB FIX2,I AND RESET IN THE TABLE ADA FIX3,I COMPUTE THE MEMORY ADDRESS STA OPRND AND SAVE AND M0760 EXTRACT THE PAGE NUMBER STA PAGNO AND SAVE SZA,RSS IF BASE PAGE OP JMP CPFIX GO TREAT AS CURRENT PAGE * LDA FIX1,I GET THE INSTR. ADDRESS AND M0760 EXTRACT THE PAGE STA OPPAG SAVE IT LDB FIX4,I GET THE LIST INDEX SZB IF EXT REFERENCE JMP WFIX USE A BP LINK * CPA PAGNO IF SAME PAGE AS OPERAND JMP CPFIX GO DO CURRENT PAGE TRICK * WFIX LDA FIX2,I GET THE INSTRUCTION CLE,ELA ZAP THE INDIRECT BIT SZB IF EXT REFERENCE JMP IDEF GO USE A LINK * SZA,RSS IF NOT A MRF INSTRUCTION JMP CPFIX THEN_ DO THE DEF TRICK * IDEF LDB OPRND GET THE OPERAND SEZ IF INDIRECT REFERENCE ADB MSIGN ADD THE SIGN BIT STB OPRND RESET IT LDA FIX4,I IF EXTERNAL REFERENCE SZA THEN STA BPONL SET FOR BASE PAGE LINK ONLY JSB BPSCN GET A LINK ADDRESS IOR MSIGN A = ADDRESS, SET INDIRECT BIT * XFIX STA B SAVE THE ADDRESS AND M1177 =B101777 PURGE THE PAGE BITS CPA B IF THERE WERE SOME RSS THEN IT'S A CP LINK SO IOR M2000 SET THE CP BIT * YFIX IOR FIX2,I INCLUDE THE INSTRUCTION ZFIX LDB L01 IF NOT LOADING SZB,RSS THEN JMP AFIX SKIP THE DISC WRITE * LDB FIX1,I GET THE CORE ADDRESS JSB LABDO OUTPUT THE WORD AFIX CCA FREE THE FIX UP TABLE ENTRY STA FIX1,I JMP DFIX,I AND EXIT * CPFIX LDA OPRND CP/BP/DEF - GET OP ADDRESS LDB FIX2,I IF CLE,ELB DEF SZB,RSS THEN JMP YFIX JUST PICK UP THE INDIRECT. * LDB PAGNO IF A BASE PAGE REFERENCE SZB OR IF LDB FIX4,I NOT AN EXT SZB THEN DO DIRECT LINK ISZ BPONL ELSE SET TO USE BP LINK (SKIPS) JMP XFIX USE STANDARD LINK * JMP WFIX USE BP LINK * OPPAG NOP BPONL NOP SKP * SFIX FINDS THE FIRST FREE FIX UP TABLE ENTRY. * * CALLING SEQUENCE: * * JSB SFIX * SFIX NOP JSB FIXX INITILIZE THE FIX UP TABLE SFIX1 JSB FIX SET ADDRESSES JMP SFIX2 EXIT NEW ENTRY * LDA FIX1,I THIS ENTRY FREE? SSA,RSS FREE IF NEGATIVE JMP SFIX1 NO KEEP LOOKING * JMP SFIX,I EXIT * SFIX2 ISZ PFIX IF NEW ENTRY, COUNT IT. CCB STB FIX1,I AND CLEAR THE ENTRY JMP SFIX,I EXIT SPC 3 * DAFIX DOES ALL FIX UP FOR THE CURRENT LST ENTRY * * CALLING SEQUENCE: * * S.ET UP THE LST ENTRY * * JSB DAFIX * DAFIX NOP JSB FIXX SET UP THE SCAN DAFI1 JSB FIX SET ADDRESSES JMP DAFI2 END OF LIST GO TO EXIT CODE * LDA FIX1,I IF NULL ENTRY SSA THEN JMP DAFI1 IGNOR IT * LDA TLST GET LST INDEX. ADA N1 CPA FIX4,I THIS ENTRY? JSB DFIX YES DO THE FIX JMP DAFI1 GET NEXT FIX UP * DAFI2 JSB SFIX SET UP A FREE FIX UP ENTRY JMP DAFIX,I AND EXIT SKP * * GET BP LINK ADDR, SET BP VALUE * * BPSCN SCANS THE CURRENT ALLOCATED LINKS * FOR A VALUE EQUAL TO THE CURRENT OPERAND. IF SUCH A VALUE * IS FOUND, THE ADDRESS OF THE OPERAND IS RETURNED * IN THE A-REGISTER. OTHERWISE, A NEW LINK WORD IS * RESERVED AND THE ADDRESS OF THIS WORD RETURNED IN A. * IN THIS CASE THE OPERAND WORD IS SET IN THE ALLOCATION * IMAGE AREA. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB BPSCN * * RETURN: * A = BP LINK ADDRESS FOR CURRENT OPERAND * B = DESTOYED * BPSCN NOP * JSB LNKX INITILIZE THE LINK MAPPER BPSC2 JSB LNK SET UP THE FIRST AREA JMP BPSC4 IF NON LEFT GO ALLOCATE * JSB SCN SCAN THE AREA FOR A LINK JMP BPSC2 IF NON FOUND TRY NEXT AREA * JMP BPSCN,I ELSE RETURN THE LINK * BPSC4 JSB ALLOC NON ALLOCATED SO ALLOCATE ONE JMP BPSCN,I AND RETURN SKP * * SCAN AREA FOR SAME OPERAND * * THE SCN SUBROUTINE CONTROLS THE SCAN FOR A GIVEN OPERAND * IN THE CURRENT LINK SECTION. * * CALLING SEQUENCE: * SET UP LNK1, LNK2, LNK3 TO POINT TO THE CURRENT LINK AREA * SET OPRND TO THE VALUE DESIRED, AND BPONL TO -1 FOR ANY AREA * AND TO 0 FOR BASE PAGE ONLY. * * JSB SCNBP * * RETURN: * P+1: LINK NOT FOUND * P+2: LINK FOUND (A = ADDR OF OPERAND) * SCN NOP LDA LNK1,I GET THE LOWER ADDRESSS STA LNK AND SAVE IT LDB BPONL GET THE BASE PAGE ONLY FLAG AND M0760 ISOLATE THE PAGE OF CURRENT AREA SZA,RSS IF BP THEN CCB SET B FOR OK SSB,RSS IF BP ONLY AND NOT BP JMP SCN,I RETURN NOT FOUND * SZA CHECK IF RIGHT PAGE (BP IS ALWAYS RIGHT) CPA OPPAG RSS GOOD LINK AREA JMP SCN,I NOT RIGHT PAGE, EXIT * LDB LNK3,I GET THE IMAGE ADDRESS TO B SCN1 LDA LNK GET THE ACTUAL ADDRESS TO A CPA LNK2,I END OF AREA? JMP SCN,I YES, EXIT NOT FOUND * LDA B,I NO, GET THE VALUE CPA OPRND THIS IT? JMP SCN2 YES, GO RETURN IT * INB NO SET FOR NEXT ENTRY ISZ LNK JMP SCN1 * SCN2 LDA LNK GET THE CORE ADDRESS ISZ SCN STEP TO THE RETURN ADDRESS JMP SCN,I RETURN, LINK FOUND, ADDRESS IN A SKP * * ALLOCATE NEW LINK WORD * * THE ALLOC SUBROUTINE ESTABLISHES ALL THE LINKAGE ADDRESSES. * IF THE ALLOCATED LINK WORD FALLS IN THE SYSTEM COMMUNICATION AREA, * A DISGNOSTIC IS PRINTED. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB ALLOC * * RETURN: * A = ALLOCATED BP LINK ADDRESS * B = DESTROYED * ALLOC NOP LDB OPRND SAVE THE OPERAND STB ALSAV LOCALLY CLB SET OPERAND STB OPRND TO ZERO TO CALL SCN LDA CPL1 SET UP TO SCAN THE LOW CP LINK AREA JSB LNKS JSB SCN SCAN THE AREA RSS IF NOT ALLOCATED SKIP JMP ALLO1 ELSE GO SET UP * LDA CPL2 TRY THE HIGH AREA JSB LNKS SET IT UP JSB SCN SCAN IT CLA,INA,RSS IF NOT FOUND SKIP JMP ALLO1 ELSE GO SET IT UP IFN *** BEGIN NON-MEU CODE *** STA LNK1 FOOL THE COUNTER LDA TBREL CHECK FOR OVER FLOW CPA LWSBP  TOO MUCH? JMP ER16 YES GO SEND MESSAGE * ISZ TBREL STEP FOR NEXT TIME LDB A COMPUTE THE ADB ADBP IMAGE OF THE BASE PAGE **** END NON-MEU CODE **** XIF IFZ ***** BEGIN MEU CODE ***** * SET UP NEW LINK IN BASE PAGE AREA SPC 1 STA LNK1 SKIP FLAG = 1 LDA TBREL DOES NEW LINK CPA BPLMT EQUAL LIMIT ADDR JMP ER16 YES,ERROR LDB A NO, SAVE LINK ADDR ADA BPINC UPDATE TO NEXT STA TBREL SET NEXT LINK ADDR LDA B GET REAL ADDR OF NEW LINK ADB ADBP AND IMAGE ADDR OF NEW LINK SPC 1 * TBREL CONTAINS POINTER TO NEXT FREE BPLINK (STARTS * AT 2 FOR DR'S, FSYBP FOR MR'S, AND LWSBP FOR SYS, * LIB, AND SSGA MODULES). BPINC SET TO -1 WHEN * LOADING SYS, TABLES, LIB, & SSGA, AND TO +1 * OTHERWISE. BPLMT SET TO FSYBP (ABOVE TRAP CELLS) * FOR SYS,LIB,TABLES,AND SSGA, AND TO LOWEST * SYSTEM LINK FOR OTHERS. ****** END MEU CODE ****** XIF ALLO1 STA TCHR SET THE ADDRESS LDA ALSAV GET THE OPERAND STA OPRND RESTORE IT STA B,I SET IT IN THE IMAGE AREA LDA LNK1 IF ALLOCATION FROM CPA CPL1 CP LOW AREA ISZ CPL1H STEP THE COUNT CPA CPL2 IF FORM THE HIGH AREA ISZ CPL2H STEP ITS COUNT LDA TCHR SET THE ADDRESS IN A JMP ALLOC,I AND RETURN * ER16 LDA ERR16 GET THE ERROR CODE JSB GN.ER SEND IT CLA RETURN ZERO AS THE LINK JMP ALLOC,I * ALSAV NOP TCHR NOP SKP * * CLEAR BUFFER WITH OCTAL ZEROES * * THE BUFCL SUBROUTINE CLEARS A 64-WORD BUFFER WITH ZEROES. * * CALLING SEQUENCE: * A = IGNORED * B = ADDRESS OF BUFFER * JSB BUFCL * * RETURN: CONTENTS OF A AND B ARE DESTROYED. * BUFCL NOP LDA N64 STA WDCNT SET BUFFER LENGTH = 64 CLe'*($A STA B,I CLEAR BUFFER WORD INB ISZ WDCNT ALL WORDS CLEAR? JMP *-3 NO - CONTINUE CLEARING JMP BUFCL,I RETURN SPC 5 * M0760 OCT 76000 M1177 OCT 101777 M2000 OCT 2000 N1 DEC -1 N64 DEC -64 ERR16 ASC 1,16 BP LINKAGE AREA FULL. * * END GIO *ASMB,R,L,C HED RTGN6 - PARTITION DEFINITION SEGMENT. NAM RT3G6,5,90 92060-16037 771221 SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 3 ****************************************************** * * NAME RT3G6 * SOURCE PART # 92060-18037 * REL PART # 92060-16037 * WRITTEN BY: K. HAHN, R. BRUBAKER * ****************************************************** SPC 1 * * ENTRY POINT NAMES * ENT PARTS * * EXTERNAL REFERENCE NAMES * EXT LSTS,.LST5 EXT IDXS,ID1,ID2,ID3,ID6,ID8 EXT TIDNT,TBUF,IDX * EXT SWRET,ABORT,NUMPG,GETAL EXT DRKEY,GN.ER,GETNA,GETOC,GINIT EXT READ,SPACE,LABDO,MAPFG,PTYPE EXT CONVD,SYS,TYPMS,OCTNO,YE/NO * A EQU 0 B EQU 1 SUP ************************************************************************ * SKP * THE FOLLOWING BLOCK OF STORAGE FOR VARIABLES PRECEEDS, * AND IS REFERENCED BY, EACH SEGMENT. IT IS NOT OVERLAID * AS EACH NEW SEGMENT IS LOADED INTO CORE. * * THE LOCATION OF EACH VARIABLE MUST BE THE SAME IN * ALL SEGMENTS. IF A CHANGE IS MADE, MAKE THE SAME * CHANGE IN THE REST OF THE SEGMENTS. * * * SYSCH BSS 1 SUBCHANNEL OF SYSTEM UNIT. AUXCH BSS 1 SUBCHANNEL OF AUX UNIT. DSIZE BSS 1 DISK SIZE -NO. OF TRACKS. DAUXN BSS 1 AUXILIARY DISK SIZE. ADS# BSS 1 AUX DISC SECTORS/TRACK. * * RELOCATION BASE TABLE. RBTA BSS 1 ABSOLUTE PROGRAM BASE. TPREL BSS 1 CURRENT PROGRAM BASE ADDRESS. TPBRE BSS 1 BASE PAGE RELOkCATION ADDRESS. COMAD BSS 1 CURRENT COMMON RELOCATION BASE. BSS 1 ABS PROGRAM BASE FOR MR CODE. * WDCNT BSS 1 TEMPORARY WORD COUNTER. DSKSY BSS 1 INITIAL ID SEGMENT DISK ADDRESS IDSP BSS 1 POSITION OF 1ST ID SEG. IN SECT TTYCH BSS 1 SYSTEM TTY CHANNEL NO. * PLFLG BSS 1 PROGRAM LOAD. FLAG = -1/0 = L/NL DSCNT BSS 1 DISK SEGMENT SECTOR COUNT * NXFLG BSS 1 ENT/EXT FLAG = -1/0 EXCNT BSS 1 SYMBOL COUNTER * LCNT BSS 1 CURRENT LBUF COUNT * DCNT BSS 1 CURRENT DBUF COUNT * CURAI BSS 1 CURRENT IBUF COUNT * CPLS BSS 1 ADDRESS OF TOP OF FIXED CP LINK IMAGE CPL1 BSS 1 ADDRESS OF LOW CURRENT PAGE LINK SPECS. CPL1H BSS 1 NUMBER OF CURRENT PAGE LINKS ASSIGNED CPL2H BSS 1 IN LOW AND HIGH AREA RESPECTIVELY URBP1 BSS 1 LWA R/T DISC RES BP LINK AREA BPMAX BSS 1 MAX USED BASE PAGE LINKAGE +1 CURAK BSS 1 CURRENT KBUF ADDRESS * CURAT BSS 1 CURRENT TBUF ADDRESS TCNT BSS 1 CURRENT TBUF COUNT * CURAP BSS 1 CURRENT PLIST ADDRESS * AMAD BSS 1 CURRENT MLIST ADDRESS * LICNT BSS 1 LONG ID SEGMENT COUNT SICNT BSS 1 SHORT ID SEGMENT COUNT SSCNT BSS 1 BG. SEG ID COUNT COMRT BSS 1 MAXIMUM RT COM LENGTH COMBG BSS 1 MAX BG COM LENGTH * DSKEY BSS 1 CURRENT KEYWORD DISK ADDRESS DSKID BSS 1 DISK ID SEGMENT ADDRESS KEYCN BSS 1 TOTAL KEYWORD COUNT KEYCT BSS 1 CURRENT KEYWORD COUNT * MLIST BSS 11 MEMORY MAP BUFFER * TEMP1 BSS 1 TEMP2 BSS 1 LWH1 BSS 1 LWH2 BSS 1 LWH3 BSS 1 LWH4 BSS 1 L01 BSS 1 * FSYBP BSS 1 FIRST WORD SYS BP LINKAGE SYSAD BSS 1 CURRENT ID SEGMENT ADDRESS * TBREL BSS 1 CURRENT BP RELOC ADDR PBREL BSS 1 INITIAL BP RELOC ADDR * RELAD BSS 1 CURRENT CORE RELOCATION ADDRESS * BSBAD BSS 1 BG SEGMENT BP RELOC ADDR BSPAD BSS 1 BG SEGMENT PROG RELOC ADDR * LFLAG BSS 1 PROGRAMS-LOADED FLAG IMAIN BSS 1 CURRENT MAIN IDENT INDEX. HDFLG BSS 1 HEADING FORMAT FLAG CIDNT BSS 1 CURRENT MAIN IDENT INDEX. * AEQT BSS 1 ADDRESS OF EQUIPMENT TABLE CEQT BSS 1 NO. ENTRIES IN EQUIPMENT TABLE * ASQT BSS 1 ADDR OF DEVICE REFERENCE TABLE CSQT BSS 1 NO. ENTRIES IN DEV. REF. TABLE * AINT BSS 1 ADDRESS OF INTERRUPT TABLE CINT BSS 1 NO. ENTRIES IN INTERRUPT TABLE * DSKIN BSS 1 DISK ADDR OF INT CODE RECORD INTCN BSS 1 RECORD COUNT OF INT CODE * CURIL BSS 1 CURRENT ILIST ADDRESS ILIST BSS 64 USER SYSTEM PROG IDENT ADDR LIST * IDSAV BSS 1 INDEX OF CURRENT IDENT. DSKMN BSS 1 INITIAL MAIN DISK ADDRESS BSSDP BSS 1 INITIAL DISK RES MAIN BSS DISP PRENT BSS 1 PRIMARY ENTRY POINT DBLAD BSS 1 CURRENT DBL ADDRESS REKEY BSS 1 INSTRUCTION TYPE BYTE INSCN BSS 1 INSTRUCTION TYPE COUNTER INSTR BSS 1 CURRENT INSTRUCTION PAGNO BSS 1 CURRENT PAGE NO. OPRND BSS 1 CURRENT OPERAND PLGTH BSS 1 PROGRAM LENGTH DRT2 BSS 1 DISK DRT ENTRY ( SYSTEM) DRT3 BSS 1 AUX DISK DRT ENTRY LIBFG BSS 1 LDTYP BSS 1 SCH1 BSS 1 INDEX OF IDENT OF PGM TO BE SCHEDULED SCH3 BSS 1 ADDRESS OF CURRENT ID SEGMENT SCH4 BSS 1 ADDRESS OF THE SCHEDULED PGM ID SEG FGBGC BSS 1 BACKGROUND USING FG COMMON FLAG $LIBR BSS 1 INDEX OF $LIBR ENT $LIBX BSS 1 INDEX OF $LIBX ENT CUPRI BSS 1 * MEM1 BSS 1 MEM2 BSS 1 MEM3 BSS 1 MEM4 BSS 1 MEM5 BSS 1 MEM6 BSS 1 MEM7 BSS 1 MEM8 BSS 1 MEM9 BSS 1 MEM10 BSS 1 MEM11 BSS 1 MEM12 BSS 1 * COMSZ BSS 1 #WORDS COMMON DECLARED FOR * CURRENT MAIN LPCOM BSS 1 LAST PAGE CONTAINING ANY COMMON FPSAM BSS 1 1ST PAGE CONTA8INING S.A.M. FWSAM BSS 1 1ST WORD CONTAINING S.A.M. LPSYS BSS 1 LAST PAGE CONTAINING SYS OR LIB FPDSK BSS 1 1ST PAGE DISK PART AREA LOLNK BSS 1 LOW LINK FOR SSGA,LIB, OR SYS HILNK BSS 1 HI LINK USED BY MEM RES PRG BPINC BSS 1 CURR DIRECTION FOR BP LINK * ALLOCATION. +1=UP,-1=DOWN BPLMT BSS 1 WORD AFTER LAST WORD AVAIL * FOR BP LINK ALLOCATION TPMAX BSS 1 HWM FOR RELOCATION OF BG * MAINS AND SEGS MAXPT BSS 1 NUM PARTS. ALLOWED MAT. BSS 1 ADR OF LENGTH WORD * BEFORE MEM ALLOC TABLE (MAT) SSGA. BSS 1 FWA SSGA (LAST WORD SYS * OR LIB +1) FWMRP BSS 1 FWA MEM RES PROG AREA * (NEXT WORD AFTER COMMONS) MAP. BSS 1 PTR TO MEU RES MAP MPFT. BSS 1 PTR TO MPFT * SECTR BSS 0 BOOTSTRAP BUFFER FORMAT * LBPSY BSS 1 LOWER SYSTEM BP ADDRESS UBPSY BSS 1 UPPER SYSTEM BP ADDRESS DSKBP BSS 1 SYS BP DISK ADDRESS * LRMAN BSS 1 MAIN RESIDENT LOWER ADDRESS URMAN BSS 1 MAIN RESIDENT UPPER ADDRESS DSKRR BSS 1 MAIN RESIDENT DISK ADDRESS * LBMAN BSS 1 MAIN BG LOWER ADDRESS UBMAN BSS 1 MAIN BG UPPER ADDRESS DSKBG BSS 1 MAIN BACKGROUND DISK ADDRESS * SYMAD BSS 1 AVAIL SYS MEM ADDR BGBND BSS 1 BACKGROUND BOUNDARY * DSKAV BSS 1 NEXT AVAILABLE DISK ADDRESS DSKLC BSS 1 DISK ADDRESS OF LIBRARY CODE DSKLB BSS 1 DISK ADDR OF LIBRARY ENTRY PTS DSKUT BSS 1 UTILITY PROG DISK ADDRESS DSKBS BSS 1 DISK ADDR OF MAIN BG DISK RES BP DSKBR BSS 1 CURRENT MAIN BG DISK RES DISK AD ADICT BSS 1 ADDR OF DISK DICTIONARY LBCNT BSS 1 RESIDENT LIBR ENTRY PT COUNT UTCNT BSS 1 UTILITY LIBRARY COUNT KEYAD BSS 1  CURRENT KEYWORD ADDRESS RTCAD BSS 1 RT COM CORE ADDRESS LBCAD BSS 1 LIBRARY CODE ADDRESS SYBAD BSS 1 ADDR OF FIRST BP LINK FOR BG IDSAD BSS 1 ADDR OF FIRST ID SEGMENT ABSID BSS 1 IDENT ADDR FOR NEXT BG SEG SCAN MAXRP BSS 1 MAXIMUM RT DISK RESIDENT PROG MAXRB BSS 1 MAXIMUM RT DISK RESIDENT BP IDMBS BSS 1 BG MAIN ADDRESS FOR BS REF * TB30 BSS 128 TRACK MAP TABLE #SUBC BSS 1 # SUBCHANNELS DEFINED(7905) SPC 3 ********************************************************* * * * END OF COMMON STORAGE BLOCK FOR ALL SEGMENTS. * * * ********************************************************* SKP "/E" ASC 1,/E "R" OCT 122 BLNKS ASC 1, BLANK OCT 40 M0400 OCT 040000 M1777 OCT 1777 M2000 OCT 2000 M77 OCT 77 M7400 OCT 177400 M7700 OCT 177700 N1 DEC -1 N2 DEC -2 N32 DEC -32 N4 DEC -4 N5 DEC -5 P1 DEC 1 P7 DEC 7 P10 DEC 10 P14 DEC 14 P16 DEC 16 P17 DEC 17 P19 DEC 19 P2 DEC 2 P20 DEC 20 P21 DEC 21 P22 DEC 22 P24 DEC 24 P26 DEC 26 P30 DEC 30 P3 DEC 3 P31 DEC 31 P4 DEC 4 P32 DEC 32 P33 DEC 33 P5 DEC 5 P6 DEC 6 M37 EQU P31 M7 EQU P7 MSIGN OCT 100000 * MES22 DEF *+1 ASC 3,(NONE) MES61 ASC 5,1ST DSK PG SKP * * NOTE THE FOLLOWING RESOLVES DEF'S TO EXTERNALS * PART LDA N GET LOOP COUNTER STA TEMP1 SAVE IN TEMP LOCATION LDB LSTAA GET ADDRESS OF WHERE LIST ROUTINE LOCATED LOOP LDA B HERE WE CHASE DOWN OUR OWN LDA A,I INDRECTS RSS LDA A,I RAL,CLE,SLA,ERA JMP *-2 STA B,I AND SAVE IT AGAIN INB ISZ TEMP1 DONE? JMP LOOP NO JMP SWRET RETURN TO MAIN. * SPC 1 N DEC -1 LSTAA DEF *+1 ATBUF DEF TBUF m SKP * PARTS NOP * * LIST PARTITION REQUIREMENTS FOR RT & BG * DISC RESIDENTS * SPC 1 LDA M7 SET IDSCN MASK TO LOOK STA TYPMS AT PRIMARY TYPE ONLY. LDA P2 SET IDSCN TYPE TO STA PTYPE REAL TIME DISC RESIDENTS LDA "RT" STUFF 'RT' IN STA MSQ1 MESSAGE. SPC 1 PQLP1 LDB MSQ1. SENT EITHER RT OR BG LDA MSQ1L PARTITION REQMT JSB DRKEY MESSAGE. SPC 1 CLA SET FLAG FOR NO PROGRAMS STA PQFLG OF TYPE FOUND. LDA P10 REINIT IDENT PTRS STA CIDNT FOR IDSCN. PQLP2 JSB IDSCN FIND PROG MATCHING PTYPE JMP PQDON (NO MORE) ISZ PQFLG INCR FLAG - AT LEAST ONE PROG LDA ID8,I PICK UP PAGE REQMT RRR 8 AND ISOLATE AND M37 IT. CMA GET -(PAGES +1) LDB MSQ2X AND STUFF JSB CONVD DECIMAL EQUIV IN MSG SPC 1 LDA BLNKS PUT BLANKS STA MSQ2 LDA ID1,I THEN PROGRAM NAME STA MSQ2+1 LDA ID2,I IN MESSAGE... STA MSQ2+2 LDA ID3,I AND M7400 IOR P32 STA MSQ2+3 SPC 1 LDA MSQ2L LDB MSQ2. JSB DRKEY SEND THE MESSAGE JMP PQLP2 THEN LOOK FOR MORE PROGS SPC 1 PQDON LDA PQFLG ANY PROGRAMS FOUND? SZA IF AT LEAST ONE JMP PQSOM THEN JUMP. LDA P6 ELSE PRINT LDB MES22 "(NONE)". JSB DRKEY SPC 1 PQSOM JSB SPACE SKIP A LINE LDA P3 DID WE ALREADY LOOK CPA PTYPE FOR BG'S? JMP PQEND YES, DONE STA PTYPE NO, STUFF LDA "BG"2 'BG' IN HEADER STA MSQ1 MESSAGE AND JMP PQLP1 CONTINUE. SPC 2 PQFLG BSS 1 SPC 1 MSQ1. DEF *+1 MSQ1 ASC 10,XX PARTITION REQMTS: MSQ1L EQU P20 SPC 1 MSQ2. DEF *+1 C- MSQ2 ASC 8, NNNNN XX PAGES MSQ2L EQU P16 MSQ2X DEF MSQ2+2 SPC 1 MSQ3. DEF *+1 ASC 15,LARGEST ADDRESSABLE PARTITION: MSQ3L EQU P30 SPC 1 MSQ4. DEF *+1 MSQ4 ASC 4,W/ COM SPC 1 "O" ASC 1,O SPC 1 PQADD NOP *PRINT LARGEST PART MESSAGE* STB MSQ4+1 MAKE MESSAGE W/COM OR LDB MSQ2X W/O COM, THEN PUT SIZE ADA N32 JSB CONVD IN MESSAGE LDA MSQ4. LDB MSQ2. STUFF IN MSG JSB MOVW HEAD,OVERLAYING HIGH-ORDER DEC -4 ZEROS OF PAGE SIZE. LDB MSQ2. LDA MSQ2L JSB DRKEY PRINT MESSAGE JMP PQADD,I SPC 1 PQEND EQU * * * LIST LARGEST ADDRESSABLE PART SIZES * SPC 1 LDA MSQ3L LDB MSQ3. PRINT HEADER JSB DRKEY LDB "O" PASS AN O (FOR W/O) LDA LPSYS AND LAST SYS PAGE JSB PQADD AND PRINT MSG (MAX W/O COM) SPC 1 CCA ADA FWMRP CALCULATE LAST PAGE LSR 10 CONTAINING COMMON AND M77 AND PASS IN A. LDB BLNKS PASS BLANKS IN B. JSB PQADD AND PRINT (MAX W/ COM) JSB SPACE SPC 1 * ASK IF WE SHOULD ALIGN M.R.P UPPER BOUND (S.A.M. LOWER * BOUND). THEN GET FIRST DISK PARTITION PAGE (S.A.M. * UPPER BOUND). SPC 1 CCA ADA URMAN A=LWA MEM RES PROGS LDB MSMRX POINT TO MESSAGE JSB ALIGN ASK IF WE SHOULD ALIGN DEF MSMR (MSG POINTER) INA A=FWA S.A.M. STA FWSAM SAVE ADDR LSR 10 AND THEN AND M77 GET PAGE # STA FPSAM AND SAVE THAT..... SPC 1 LDA LPSYS GET LAST SYS PAGE LDB MAPFG (OR LAST COMMON PAGE IF SZB SYSTEM IS TO MAP THE LDA LPCOM COMMON AREA). CPA FPSAM DOES SYS SHARE A PAGE WITH SAM?? ADA N1 YES, REDUCE COUNT CMA,INA  COMPUTE MAX PAGE # ALLOWABLE ADA P31 FOR SAM UPPER BND (PAGE AFTER) ADA FPSAM MAX=31-SYSLASTPAGE+1STPAGESAM STA FPDSK AND SAVE AS 1ST DISK PAGE SPC 1 LDB NUMPG IF MORE PAGES ADDRESSABLE THAN CMA,INA REALLY AVAILABLE, ADA NUMPG BETTER SET S.A.M LIMIT SSA TO LAST REAL PAGE. STB FPDSK SPC 1 LDB FPSAM PASS CURRENT END OF INB SYS AV MEM, AND JSB SAMSZ PRINT CURRENT SAM SIZE. SPC 1 LDA FPSAM PROMPT 1ST SAM PAGE INA PLUS ONE CMA AND ASK FOR FIRST JSB CHBND DISK PAGE DEF MES61 (PASS 1'S COMP FOR DECIMAL) DEF FPDSK STA FPDSK SAVE FOR LATER SPC 1 LDB A PASS 1ST DISK PAGE AS END S.A.M. JSB SAMSZ THEN PRINT FINAL S.A.M SIZE SPC 1 * DEFINE DISK RESIDENT PROGRAM PARTITIONS SPC 1 * CLEAR M.A.T. FIRST. SET LINK WORDS TO -1 TO * SHOW PARTITIONS UNDEFINED. SPC 1 DPINT JSB SYS MAP SYSTEM AREA ON DISK LDA MAXPT SET LOOP COUNTER TO CMA -(NO. OF PARTS +1) STA DPTMP AND SAVE SPC 1 CLA,INA GET ABS TARGET ADDR JSB DPCNV OF PART 1 DESCRIPTOR LDB A SAVE IN B-REG JMP DPCN2 ENTER LOOP AT BOTTOM SINCE * MAXPT MAY BE XERO SPC 1 DPLP3 CCA SET LINK TO JSB LABDO MINUS 1 DPLP4 CLA THEN SET NEXT JSB LABDO 5 WORDS TO ZERO ISZ DPTM2 JMP DPLP4 DPCN2 LDA N5 REPEAT THE ABOVE STA DPTM2 TILL MAT IS ISZ DPTMP EXHAUSTED JMP DPLP3 SPC 1 * ASK USER TO DEFINE PARTITIONS SPC 1 LDA FPDSK COMPUTE # OF CMA,INA REMAINING ADA NUMPG PAGES. STA DPARE  SAVE SIZE OF DISK AREA CMA,INA CONVD NEEDS NEG PARM LDB MXM1 POINT TO SPOT IN MSG JSB CONVD STUFF DECIMAL INTO MSG JSB SPACE SPC 1 LDB MSM1. LDA MLM1 JSB DRKEY SEND SIZE LEFT SPC 1 LDA MAXPT SZA,RSS JMP DPTHD IF NO PARTS ALLOWED...DON'T ASK SPC 1 LDB MSM2. LDA MLM2 JSB DRKEY SEND INSTRUCTIONS SPC 1 * READ PARTITION DEFINITION AND PARSE SPC 1 DPRD CLA,INA LDB HYADD JSB READ READ USER LDA N2 INPUT JSB GETNA AND CPA "/E" CONTINUE UNLESS JMP DPEND HE ENTERED /E SPC 1 * GET PARTITION NUMBER SPC 1 JSB GINIT REINITIALIZE PARSE LDA N2 AND ASK FOR JSB GETOC UP TO 2 DECIMAL JMP DPER1 DIGITS (PART #) STA DPNUM SPC 1 CMA,INA IF PART # IS GREATER ADA MAXPT THAN MAXPT OR=0 SSA,RSS WE HAVE CPA MAXPT AN ERROR JMP DPER1 JSB DPCHK MAKE SURE JMP DPER1 WE HIT A JMP DPER1 COMMA SPC 1 * GET NUMBER OF PAGES FOR PARTITION SPC 1 LDA N4 ASK FOR JSB GETOC FOUR DECIMAL DIGIT JMP DPER2 # OF PAGES ADA N1 REDUCE BY ONE STA DPSIZ AND SAVE. SPC 1 SSA CHECK IF JMP DPER2 BETWEEN CMA,INA 1 AND 1024 ADA M1777 PAGES ENTERED SSA BY USER. JMP DPER2 SPC 1 JSB DPCHK MAKE SURE JMP DPER2 JMP DPER2 WE HIT A COMMA... SPC 1 * GET TYPE: EITHER "RT" OR "BG" SPC 1 LDA N2 JSB GETNA GET 2 CHARS CLB CPA "BG"2 IF BG JMP DPTYP INB ELSE INCREMENT CPA "RT" AND IF RT JMP DPTYP THE JUMP  JMP DPER3 OTHERWISE ERROR. SPC 1 DPTYP STB DPTY CCA SET RESERVED FLG=-1 STA DPRSV IN CASE THAT PARM IS OMITTED SPC 1 JSB DPCHK CHECK DELIMITER JMP DPER3 ERROR IF NOT COMMA OR EOR JMP DPSTO GO BUILD MAT ENTRY IF EOR * ELSE CONTINUE ON COMMA SPC 1 * GET RESERVED FLAG SPC 1 LDA P1 READ ONE JSB GETNA CHARACTER CPA "R" IF AN R ISZ DPRSV THEN SET FLG AND SKIP JMP DPER4 ELSE ERROR SPC 1 JSB DPCHK CHECK DELIMITER JMP DPER4 ANY BUT "," OR EOR BAD JMP DPSTO EOR OK JMP DPER4 COMMA BAD SPC 1 * BUILD MAT ENTRY - THINGS AREA A LITTLE CONFUSING SINCE * THE M.A.T. IS ALREADY ON DISK AS PART OF THE SYSTEM AREA SPC 1 DPSTO LDA DPNUM CONVERT PART # JSB DPCNV TO CORE ADDR LDB A CLA JSB LABDO CLEAR LINK WORD ADB P3 POINT TO PART SIZE, RSV FLAG SPC 1 LDA DPRSV GET RESERVED FLAG INA IF SET (0) THEN RAR SET BIT 15 IN MAT WORD IOR DPSIZ MERGE IN PART SIZE SPC 1 JSB LABDO WRITE MAT WORD 4 LDA DPTY PICK UP TYPE BIT RAR MAKE IT SIGN BIT * (1=RT,0=BG) JSB LABDO WRITE WORD 5 SPC 1 * GO GET NEXT PARTITION DEFINITION SPC 1 JMP DPRD SKP * ALL PARTS DESCRIBED, CHECK FOR USE OF ALL CORE AND SORT * INTO RT AND BG FREE LISTS SPC 1 DPEND CLA STA DPTOT INIT PAGE COUNT LDA MAXPT SET UP A COUNTER CMA,INA FOR NUMBER OF STA DPTMP MAT ENTRIES SPC 1 * LOOK AT ALL PARTITION LENGTHS AND INSURE TOTAL IS OK SPC 1 CLA,INA GET ADDR JSB DPCNV OF LDB A PART 1'S DESCRIPTOR DPQLP1 JSB DPRW READ LINK WORD ADB P3 POINT TO LENGTH WORD SSA LINK <0?? JMP DPCN1 YES, UNDEFINED JSB DPRW READ LENGTH-1 AND M1777 ISOLATE IT AND GET INA TRUE VALUE ADA DPTOT ADD TO TOTAL STA DPTOT AND UPDATE SPC 1 ADB N1 DPCN1 ADB P2 POINT TO NEXT LINK ISZ DPTMP AND CONTINUE JMP DPLP1 TILL DONE SPC 1 LDA DPARE GET SIZE OF DISK AREA CPA DPTOT COMPARE WITH SUM OF PARTS JMP DPTHD EQUAL, CONTINUE SPC 1 * ERROR - PARTITIONS DON'T TOTAL TO SIZE OF AVAIL AREA SPC 1 LDA ERR53 JSB GN.ER SEND ERR 54 MESSAGE JMP DPINT AND START WHOLE PARTITION * THING OVER AGAIN SKP * THREAD MAT INTO TWO LISTS: BG FREE LIST, AND RT FREE LIST SPC 1 DPTHD CLA INITIALIZE STA DPRTL TWO STA DPBGL FREE LISTS SPC 1 LDA MAXPT SAVE CMA -MAX PT -1 STA DPTMP AS LOOP COUNTER LDA FPDSK STA DPORG SET FIRST PAGE TO GIVE AWAY CLA,INA JSB DPCNV A=ABS ADDR OF MAT#1 STA DPTM2 SAVE IT JMP DPEN3 ENTER LOOP AT BOTTOM SPC 1 * BEGIN MAIN LOOP: INSERT PART DESCRIPTORS INTO LISTS * AND SET PARTITION START ADDRS INTO DESCRIPTORS SPC 1 DPLP2 LDB DPTM2 GET ABS ADDR OF NEXT MAT ENTRY JSB DPRW READ LINK SSA IF UNDEFINED PART THEN JMP DPEN2 DON'T LINK IT. ADB P2 ELSE POINT TO PAGE ADDR * FIELD IN MAT ENTRY. JSB LABDO READ AND DESTROY FIELD IOR DPORG OR-IN START PAGE ADB N1 BACK UP LABDO TO SAME WORD JSB LABDO AND REWRITE THE FIELD SPC 1 JSB DPRW NOW GET LENGTH OF PART AND M1777 ISOLATE IXT STA DPSIZ SAVE FOR COMPARE IN SORT INA AND MAKE TRUE LENGTH SPC 1 ADA DPORG UPDATE THE STA DPORG PARTITION ORIGIN LOCATION SPC 1 JSB DPRW READ AND RESTORE THE RT FLAG AND MSIGN LEAVE JUST SIGN BIT STA DPRSV AND SAVE. SPC 1 * LINK MAT ENTRY (A-REG CONTAINS RT FLAG) LDB DPBG. LOAD BG LIST HEAD IF SSA BG PARTITION LDB DPRT. ELSE RT LIST HEAD STB DPLH. SAVE ADDR OF LIST HEAD LDB B,I LOAD LIST HEAD CONTENTS SPC 1 * CHASE DOWN FREE LIST TO FIND PLACE TO INSERT ENTRY SPC 1 DPLNK EQU * B CONTAINS POINTER TO FIRST * MAT ENTRY IN LIST, A IGNORED. STB DPCUR SAVE FIRST AS CURRENT CLA STA DPPRV AND ZERO AS PREVIOUS SPC 1 DPLL1 LDB DPCUR IF POINTER IS NULL SZB,RSS THEN JMP DPLEX WERE DONE ADB P4 ELSE POINT TO LEN OF CURRENT JSB DPRW READ/RESTORE LENGTH AND M1777 AND ISOLATE IT CMA,INA IF INSERTEE SIZE IS ADA DPSIZ LESS THAN CURRENT SSA THEN WERE JMP DPLEX DONE SPC 1 LDB DPCUR ELSE SAVE CUR AS STB DPPRV PREVIOUS AND READ JSB DPRW NEXT LINK STA DPCUR AND SET AS CURRENT JMP DPLL1 THEN LOOP BACK AND CONTINUE SPC 1 * FOUND POSITION TO INSERT - IF DPPRV IS STILL ZERO, * THEN INSERTEE GOES AT TOP OF LIST. * DPLEX LDA DPTM2 A POINTS TO INSERTEE LDB DPPRV IS PREVIOUS GUY HEAD?? SZB JMP DPINS NO, INSERT IN LIST STA DPLH.,I YES,JUST MAKE HEAD POINT HERE JMP DPFOR THEN FIX FOW'D PNTR SPC 1 DPINS EQU * GO MAKE MAT(DPPRV) POINT * TO INSERTEE, B POINTS TO * PREVIOUS MAT ENTRYmNLH JSB LABDO SPC 1 DPFOR EQU * MAKE INSERTEE POINT TO NEXT MAT * ENTRY. LDA DPCUR WRITE ADDR OF NEXT MAT ENTRY LDB DPTM2 INTO 1ST WORD OF INSERTEE JSB LABDO SPC 1 DPEN2 LDA P6 POINT TO NEXT ADA DPTM2 MAT ENTRY STA DPTM2 DPEN3 ISZ DPTMP CONTINUE UNTIL MAT JMP DPLP2 IS EXHAUSTED SPC 1 N* DONE THREADING PARTITION DESCRIPTORS, STORE LENGTH OF * M.A.T. (MAY BE ZERO) ON DISK SPC 1 LDB MAT. POINT TO WORD BEFORE M.A.T. LDA MAXPT AND CRAM IN THE JSB LABDO NO. OF PARTITIONS SPC 1 * SKIP AROUND CONSTANTS AND SUBROUTINES SPC 1 JMP MPSRT SKP * SUBROUTINES, ERROR ROUTINES, VARIABLES, AND CONSTANTS SPC 1 DPER1 LDA ERR44 JMP DPERR DPER2 LDA ERR45 JMP DPERR DPER3 LDA ERR46 JMP DPERR DPER4 LDA ERR47 DPERR JSB GN.ER SEND ERROR MESSAGE JMP DPRD GO REREAD ENTRY SPC 1 ERR44 ASC 1,44 ERR45 ASC 1,45 ERR46 ASC 1,46 ERR47 ASC 1,47 SPC 3 * PRINT SIZE OF SYS AV MEM IN DECIMAL WORDS * B-REG CONTAINS PAGE# OF PAGE AFTER S.A.M. SPC 1 SAMSZ NOP LDA FPSAM COMPUTE TOTAL PAGES CMA OF S.A.M. ADA B AND MULTIPLY BY LSL 10 1024, SAVE SWP IN B-REG. SPC 1 LDA FWSAM COMPUTE #WORDS AND M1777 IN 1ST PAGE OF CMA,INA SAM, THEN ADA M2000 ADD TO TOTAL. ADA B CMA,INA PASS -NUMBER OF WORDS LDB MXSM TO GET DECIMAL ASCII JSB CONVD IN MESSAGE. JSB SPACE SPC 1 LDB MSSM. PRINT LDA MLSM THE JSB DRKEY MESSAGE. SPC 1 JMP SAMSZ,I SPC 1 MSSM. DEF *+1 ASC 12,SYS AV MEM: XXXXX WORDS MXSM DEF MSSM.+7 MLSM EQU P24 HYADD DEF *+1 ASC 1,- SKP * CHECK NEXT CHAR IN LBUF FOR DELIMITER * * RETURNS: * (N) NOT COMMA OF EOR * (N+1) END-OF-RECORD * (N+2) COMMA SPC 1 DPCHK NOP JSB GETAL GET NEXT CHAR CPA BLANK JMP DPC1 JUMP IF COMMA SZA JMP DPC3 JUMP IF NOT COMMA OR EOR JMP DPC2 JUMP IF EOR DPC1 ISZ DPCHK DPC2 ISZ DPCHK DPC3 JMP DPCHK,I SP]%C 3 * CONVERT PARTITION NUMBER TO ABS CORE ADDR IN TARGET SYSTEM * * LDA PART# (1 THRU 64) * JSB DPCNV DPCNV NOP ADA N1 MPY P6 GET OFFSET IN M.A.T. ADA MAT. MAKE ABSOLUTE INA ADJUST FOR LENGTH WORD JMP DPCNV,I SPC 3 * DPRW - READ AND REWRITE A WORD FROM THE ABSOLUTE SYSTEM * STORED ON THE DISK * * CALL A-IGNORED * B- ABS TARGET SYSTEM ADDR * RETURN: B SET TO B+1 * A=CONTENTS OF DESIRED WORD SPC 1 DPRW NOP JSB LABDO READ AND DESTROY WORD STA DPRWT SAVE IN TEMP ADB N1 BACK UP ADDR JSB LABDO RESTORE WORD LDA DPRWT BACK TO A JMP DPRW,I AND RETURN SPC 1 DPRWT BSS 1 SKP * * IDFND - FIND ID SEGMENT ADDRESS BY READING * KEYWORD FROM DISC. * * CALLING SEQ: RETURN SEQ: (N+1) * (INSURE 'SYS' MAP IS SET FOR LABDO) A IS DESTROYED * (INSURE IDFIX CALLED EARLIER FOR PROG) * DESIRED INDENT MUST BE IN CORE * JSB IDFND * SPC 1 IDFND NOP LDA M377 PICKUP KEYWD# AND AND ID8,I ISOLATE IT FROM IDENT WORD 8 ADA KEYAD ADD KEYWORD BASE ADDR LDB A AND SAVE IN B FOR DPRW. JSB DPRW THEN READ KEYWD. LDB A JMP IDFND,I RETURN W/ID-SEG ADDR IN B. * M377 OCT 377 SPC 4 DPTMP BSS 1 DPTM2 BSS 1 "RT" ASC 1,RT "BG"2 ASC 1,BG ("BG", EARLIER, GETS OVERLAYED) DPNUM BSS 1 PART # (1 THRU 64)?????? DPSIZ BSS 1 PART SIZE(1 TO 1024 PAGES) DPTY BSS 1 PART TYPE (BG=0,RT=1) DPRSV BSS 1 PART RSV FLG (-1,NOT RES,0=RES) DPTOT BSS 1 DPARE BSS 1 SIZE OF DISK PART AREA IN PAGES DPORG BSS 1 TEMP USED FOR PART ORIGINS DPBG. DEF DPBGL DPRT. DEF DPRTL DPLH. BSS 1 POINTER TO EITHER LIST HEAD DPCUR BSS 1 USED DURING FREE LIST BUILD DPPR]V BSS 1 USED DURING FREE LIST BUILD SPC 3 MSM1 ASC 11,PAGES REMAINING: XXXXX MXM1 DEF MSM1+8 MLM1 EQU P22 MSM1. DEF MSM1 SPC 1 MSM2 ASC 9,DEFINE PARTITIONS MSM2. DEF MSM2 MLM2 EQU P17 SPC 1 ERR53 ASC 1,53 SKP * ALLOW USER TO ALTER THE PROGRAMS PAGE REQUIREMENTS * ONLY INCREASES ARE ALLOWED * * SEND MESSAGE: "MODIFY PROGRAM PAGE REQUIREMENTS?" * * USER RESPONDS WITH: PROGNAME,PARTSIZE * (PARTSIZE INCLUDES BASE PAGE) * * USER TERMINATES WITH: /E * * NOTE: THIS IS DONE BEFORE ASSIGNING PROGRAMS TO * PARTITIONS, SO WE DON'T NEED TO CHECK IF * PROGRAM WILL STILL FIT IN ITS ASSIGNED PARTITION SPC 1 * SEND QUESTION SPC 1 MPSRT JSB SPACE LDA MLM5 LDB MSM5. JSB DRKEY SPC 1 * GET PROGRAM NAME, SET UP POINTERS TO IDENT SPC 1 MPLOP JSB APRED USE CODE IN ASSIGN PART. ROUTINE JMP APSRT JUMP OUT IF /E WAS ENTERED * CONVERT SIZE TO BINARY AND VERIFY SPC 1 LDA N2 GET 2 DECIMAL DIGITS JSB GETOC FROM LBUF AND JUMP JMP MPER1 IF BAD DIGIT ADA N1 SAVE OVERRIDE LESS 1 STA DPSIZ SPC 1 LDB DPID READ LO-MAIN ADB P22 ADDRESS JSB DPRW FROM ID-SEGMENT LSR 10 GET PAGE NUMBER AND M37 AND ISOLATE. ADA DPSIZ GET TOTAL PAGES CMA,INA AND COMPARE TO 32. ADA P32 SSA ERROR IF OVER 32. JMP MPER1 SPC 1 LDA ID8,I GET PAGE REQMT LSR 8 FROM IDENT. POSITION AND M37 AND ISOLATE. CMA,INA SUBTRACT REQMT ADA DPSIZ FROM REQUEST, AND SKIP IF SSA REQMT IS EQUAL OR LESS. JMP MPER1 ERROR IF OVERRIDE IS LESS SPC 1 * OVERRIDE IS VALID, UPDATE SIZE REQMT IN ID-SEGMENT SPC 1 LDB DPID DESTeRUCTIVELY READ WORD22 ADB P21 (THE DMS WORD) FROM THE ID- JSB LABDO SEGMENT. RRR 10 AND M7700 THEN MERGE IN NEW IOR DPSIZ PAGE REQUIREMENTS AND RRL 10 BACKUP THE ADDRESS TO ADB N1 WORD 22 AGAIN JSB LABDO AND REWRITE IT JMP MPLOP GO READ NEXT SKP * ALLOW USER TO ASSIGN A PROGRAM TO A PARTITION. * PROGRAMS THUS ASSIGNED WILL RUN IN NO OTHER * PARTITION. * * SEND MESSAGE: "ASSIGN PROGRAM PARTITIONS?" * * USER RESPONDS WITH: PROGNAME,PART# * * USER TERMINATES WITH: /E SPC 1 * SEND QUESTION SPC 1 APSRT JSB SPACE LDA MLM4 LDB MSM4. JSB DRKEY SPC 1 * READ RESPONSES (CALL INLINE SUBROUTINE) SPC 1 APLOP JSB APRED JMP APEND END LOOP IF /E WAS ENTERED JMP APCNV ELSE CONTINUE APRED NOP APRD2 CLA,INA LDB HYADD JSB READ GET RESPONSE. LDA N5 ASK FOR A 5 CHAR NAME,BUT JSB GETNA IF THE 1ST 2 CHARS ARE CPA "/E" /E THEN JMP APRED,I WE ARE DONE JSB DPCHK CHAR AFTER PROGRAM NAME JMP APER1 SHOULD BE A COMMA, OTHERWISE JMP APER1 WE HAVE AN ERROR. SPC 1 * GO LOCATE PROGRAM IN IDENT TABLE * SET UP POINTERS ID1,I THRU ID8,I * PUT ID SEG ADDR IN 'DPID' SPC 1 LDB ATBUF LOCATE IDENT JSB IDXS AND SET POINTERS. JMP APER1 ERROR IF NOT FOUND JSB IDFND GET ID-SEG ADDR STB DPID AND SAVE. ADB P14 READ PROG TYPE FROM JSB DPRW ID-SEG WORD 15 AND M7 1= BASIC TYPE-IS CPA P2 NOT 2 (RT DISK RES) RSS OR 3 (BG DISK RES) CPA P3 THEN WE DONT MESS RSS AROUND WITH PARTITION JMP APER1 STUFF. ISZ APRED INCREMENT TO NORMAL RETURN POINT JMP APRED,I AND RETURN TO CALLER DPID BSS 1 POINTER TO ID-SEG FOR NAMED PROG SPC 1 * CONVERT PARTITION NUMBER TO BINARY * AND VERIFY SPC 1 APCNV LDA N2 GET A 2-DIGIT DECIMAL NUMBER JSB GETOC FROM LBUF AND MAKE IT BINARY JMP APER2 ERROR IF BAD DIGIT STA DPNUM CMA,INA IF ENTRY IS MORE THAN MAX ADA MAXPT ESTABLISHED EARLIER OR SSA,RSS ZERO, CPA MAXPT THEN WE HAVE JMP APER2 AN ERROR. SPC 1 JSB DPCHK IT'S ALSO AN ERROR IF NEXT JMP APER2 CHAR IS ANYTHING BUT RSS END OF JMP APER2 RECORD. SPC 1 * SEE IF PARTITION IS DEFINED SPC 1 LDA DPNUM CONVERT PART. NUMBER TO JSB DPCNV ABS ADDRESS IN M.A.T. IN STA DPTM2 TARGET SYSTEM AND SAVE IT. LDB A JSB DPRW READ LINK FIELD IN M.A.T. ENTRY SSA IF IT IS NEGATIVE JMP APER2 THAT MEANS UNDEFINED PARTITION SPC 1 * GOOD PARTITION NUMBER - SEE IF PROG WILL FIT SPC 1 LDB DPTM2 READ SIZE OF ADB P4 THE SPECIFIED PARTITION JSB DPRW (LOW 10 BITS OF FIELD) AND M1777 AND SAVE IT STA DPSIZ SPC 1 LDB DPID READ WORD 22 (DMS WORD) FROM ADB P21 ID-SEGMENT AND SAVE IT. JSB DPRW STA DPTMP RRR 10 ISOLATE SIZE FIELD FROM AND M37 ID-SEGMENT CMA,INA AND COMPARE WITH ADA DPSIZ PARTITION SIZE SSA ERROR IF PARTITION JMP APER3 IS SMALLAR THAN PROGRAM SPC 1 * PROGRAM WILL FIT PARTITION: FIXUP ID-SEGMENT SPC 1 LDA DPTMP PICK UP OLD CONTENTS OF AND M7700 ID-SEG WORD 22 IOR DPNUM AND MERGE IN PARTITION ADA N1 NUMBER LESS 1 IOR MSIGN AND ASSIGNED  LDB DPID BIT. THEN ADB P21 REWRITE THAT WORD JSB LABDO IN ID-SEGMENT JMP APLOP GO BACK AND GET NEXT USER INPUT SPC 1 MSM5 ASC 17,MODIFY PROGRAM PAGE REQUIREMENTS? MSM5. DEF MSM5 MLM5 EQU P33 SPC 1 MSM4 ASC 13,ASSIGN PROGRAM PARTITIONS? MLM4 EQU P26 MSM4. DEF MSM4 SPC 1 APER1 LDA ERR48 SEND APPROPRIATE ERROR JSB GN.ER JMP APRD2 MESSAGE APER2 LDA ERR49 JMP APERR APER3 LDA ERR50 APERR JSB GN.ER JMP APLOP ERR48 ASC 1,48 ERR49 ASC 1,49 ERR50 ASC 1,50 MPER1 LDA ERR51 JSB GN.ER JMP MPLOP ERR51 ASC 1,51 SPC 1 APEND EQU * SKP * BUILD MEMORY PROTECT FENCE TABLE * * (MPFT CONTAINS ABS ADDR OF TABLE IN TARGET SYSTEM) * * TABLE FORMAT: WORD LOGICAL FENCE ADDR FOR * 0 - DISK RES PROG W/O COMMON * 1 - MEM RES PROG W/O COMMON * 2 - ANY PROG USING RT COMMON * 3 - ANY PROG USING BG COMMON * 4 - ANY PROG USING SSGA SPC 1 JSB SYS LET LABDO KNOW WE'RE REFERING * TO SYSTEM ADDRESSES. LDA LPSYS USING LAST PAGE TOUCHED BY SYS INA OR LIBRARY, COMPUTE FIRST ADDR LSL 10 AVAILABLE TO ANY DISK RES LDB MPFT. PROGRAM AND SAVE AS WORD 0 JSB LABDO OF MPFT. SPC 1 LDA FWMRP SAVE FIRST WORD ADDR OF MEM RES JSB LABDO PROGS IN WORD 1. SPC 1 LDA RTCAD AND FIRST WORD ADDR OF RT JSB LABDO COMMON IN WORD 2. SPC 1 LDA BGBND AND FIRST WORD ADDR OF BG JSB LABDO COMMON IN WORD 3. SPC 1 LDA SSGA. AND FIRST WORD ADDR OF SSGA JSB LABDO IN WORD 4. SKP * * BUILD DMS MAP FOR MEMORY RESIDENT PROGRAMS * (SET DMS WRITE-PROTECT BIT FOR ALL PAGES * ABOVE LAST MEMORY RES PROG PAGE). a* SPC 1 JSB SYS MAKE SURE LABDO ADDRESSES THE * SYSTEM PART OF THE DISK. LDA N32 SET A LOOP COUNTER STA DPTMP FOR 32 ITERATIONS. CLA SET INITIAL PHYSICAL PAGE ADDR STA DPTM2 TO ZERO. SPC 1 LDA URMAN GET LAST WORD ADDR OF MEM RES ADA N1 PROG AREA RRR 10 ISOLATE THE PAGE NUMBER AND M37 AND SAVE (-PAGE#-1) FOR CMA LATER STA MMTMP COMPARISON. SPC 1 LDB MAP. POINT TO FIRST WORD OF MAP IN SPC 1 TARGET SYSTEM. MMLOP LDA DPTM2 ADA MMTMP IF THIS PAGE IS ABOVE THE SSA HIGHEST MEM RES PROG PAGE JMP MMOK THEN SET THE WRITE PROTECT LDA M0400 BIT AND THE READ IOR MSIGN PROTECT BIT. RSS MMOK CLA ELSE CLEAR IT ADA DPTM2 MERGE IN PAGE NUMBER SPC 1 JSB LABDO WRITE MAP WORD (IWTH OR W/O ISZ DPTM2 WRITE-PROTECT BIT). INCREMENT ISZ DPTMP ABS PAGE ADDR AND LOOP BACK JMP MMLOP UNTIL ALL 3I REGS ARE FILLED. SKP * STUFF CRITICAL VALUES INTO ENTRY POINTS DECLARED * IN SYSTEM MODULES. (TABLE DRIVEN FOR EASY CHANGE) SPC 1 * COMPLETE THE TABLE OF VALUES LDA MAP. SET ADDR OF RESIDENT STA $MRMP+1 PROGRAM MAP. LDA LPSYS SET LENGTH OF SYSTEM INA AND LIB IN PAGES STA $ENDS+1 LDA MAT. SET ADDR OF MEMORY ALLOCATION INA TABLE. (NOTE THIS IS ADDR OF STA $MATA+1 NEXT WORD AFTER TABLE LENGTH). LDA MPFT. SET ADDR OF MEMORY PROTECT STA $MPFT+1 FENCE TABLE. SPC 1 LDA FPSAM GET NUMBER OF PAGES PARTIALLY CMA,INA OR FULLY OCCUPIED BY S.A.M. ADA FPDSK LSL 10 THEN SHIFT TO POSITION, IOR FPSAM MERGE IN FIRST PAGE ADDR 2 STA $MPSA+1 AND SET IN TABLE. SPC 1 LDA FWSAM COMPUTE LWA MEM RES PROG ADA N1 FROM FWA S.A.M, THEN STA $EMRP+1 STUFF IN TABLE SPC 1 LDA FPDSK COMPUTE LAST PAGE OF S.A.M. ADA N1 AND STUFF INTO STA $LPSA+1 TABLE. SPC 1 * LOOK UP ENTRIES IN MODULES AND STUFF IN * VALUES FROM TABLE. SPC 1 JSB SYS TELL LABDO WE'RE ADDRESSING * THE TARGET SYSTEM. LDA SCT. INITIALIZE A POINTER INTO STA SCTMP THE VALUE TABLE SPC 1 SCLOP LDB SCTMP,I LOAD POINTER TO ENTRY NAME SZB,RSS IN TABLE JMP SCEND (ZERO MEANS END OF TABLE). JSB LSTS FIND NAME IN LST AREA AND JSB ABORT ABORT IF MISSING. SPC 1 LDB .LST5,I GET ENTRY ADDRESS ISZ SCTMP LDA SCTMP,I AND DESIRED VALUE JSB LABDO THEN STUFF IT IN MODULE. SPC 1 LDA SCTMP FIX VALUE-TABLE POINTER ADA P4 TO ADDRESS NEXT STA SCTMP 5-WORD ENTRY. JMP SCLOP LOOP BACK TILL DONE. SPC 1 * THE FOLLOWING TABLE CONTAINS A 5-WORD * ENTRY FOR EACH OF THE SYSTEM ENTRY * POINTS TO BE STUFFED WITH A VALUE. THE * TABLE ENDS WITH A WORD CONTAINING ZERO. * * ENTRY STRUCTURE: * WORD 0 - POINTER TO ENTRY PT. NAME * WORD 1 - VALUE TO BE STUFFED IN ENTRY PT. * WORDS 2,3,4 - ENTRY POINT NAME SPC 1 SCTAB EQU * $MRMP DEF *+2 NOP ASC 3,$MRMP $ENDS DEF *+2 NOP ASC 3,$ENDS $MATA DEF *+2 NOP ASC 3,$MATA $MPSA DEF *+2 NOP ASC 3,$MPSA $MPFT DEF *+2 NOP ASC 3,$MPFT $RTFR DEF *+2 DPRTL NOP (VALUE SET WHEN PARTITIONS DEFINED) ASC 3,$RTFR $BGFR DEF *+2 (VALUE SET EARLIER, AS ABOVE) DPBGL NOP ASC 3,$BGFR $EMRP DEF *+2 Z NOP ASC 3,$EMRP $LPSA DEF *+2 NOP ASC 3,$LPSA DEC 0 *END OF TABLE* SPC 1 SCT. DEF SCTAB SCTMP BSS 1 MMTMP BSS 1 SPC 1 SCEND EQU * SKP * SET LOGICAL ADDRESSES OF SYSTEM AVAILABLE MEMORY * * MEM1 = FIRST WORD ADDR OF S.A.M. * MEM2 = LAST WORD ADDR OF S.A.M. +1 * * NOTE: THE TERM,LOGICAL ADDRESS, IS USED SINCE S.A.M. * MAY APPEAR TO THE SYSTEM AT AN ADDRESS WHICH IS LOWER * THAN (BY AN INTEGRAL # OF PAGES) ITS PHYSICAL ADDR. * THIS IS BECAUSE SSGA AND BOTH COMMONS PHYSICALLY RESIDE * BETWEEN THE END OF THE LIBRARY AND THE START OF SAM, YET * THESE AREAS ARE NOT INCLUDED IN THE SYSTEM'S MAP (OR "LOGICAL * ADDRESS SPACE"). EXCEPTION:SSGA AND COMMON ARE IN SYSTEM'S * MAP IF USER SAID PRIV DRIVERS ARE TO USE COMMON. SPC 1 LDA LPSYS RELOCATE S.A.M. AFTER SYSTEM LDB MAPFG UNLESS USER SAID DRIVERS USE COMMON, SZB THEN RELOCATE AFTER COMMON LDA LPCOM * CALCULATE THE NUMBER OF WHOLE CMA,INA PAGES (SIZE OF GAP) SEPARATING ADA FPSAM S.A.M. FROM END OF SYS/LIB/COM SZA IF S.A.M. STARTS ON SAME OR ADA N1 NEXT PAGE THE GAP IS ZERO. STA MEM2 (SAVE GAP SIZE IN MEM2) LSL 10 GET GAP SIZE IN WORDS AND CMA,INA ADJUST FWA OF S.A.M. ADA FWSAM DOWNWARD, THEN STA MEM1 STORE IN MEM1. SPC 1 LDA MEM2 SIMILARLY, ADJUST LWA+1 OF CMA,INA S.A.M. DOWNWARD ADA FPDSK THEN CONVERT PAGE ADDR LSL 10 TO WORD ADDR STA MEM2 STORE IN MEM2 JMP PARTS,I SKP * * THE MOVW SUBROUTINE MOVES WORDS FROM ONE CORE LOCATION * TO ANOTHER * * CALLING SEQUENCE: * * LDA FROM ADDRESS * LDB TO ADDRESS * JSB MOVW * DEC -WORD COUNT * MOVW NOP STA TBUF LDmA MOVW,I GET THE COUNT STA TBUF+1 SET IN COUNTER * MOVW2 LDA TBUF,I GET A WORD STA B,I SET IT INB ISZ TBUF STEP THE ADDRESSES ISZ TBUF+1 DONE? JMP MOVW2 NO DO THE NEXT ONE * ISZ MOVW STEP TO RETURN POINT JMP MOVW,I YES- RETURN SKP * * SCAN IDENTS FOR PROGRAM TYPE * * THE IDSCN SUBROUTINE SCANS IDENT FOR A PROGRAM OF THE * CURRENT TYPE (SET IN PTYPE). * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB IDSCN * * RETURN: CONTENTS OF A AND B ARE DESTOYED. * E = M/S FLAG FOR CURRENT PROGRAM. * IDSCN NOP LDA CIDNT GET NEXT IDENT IN SCAN STA TIDNT SET IDENT INDEX FOR IDX JSB IDX SET IDENT ADDRESSES JMP IDSCN,I RETURN - END OF IDENTS LDA TIDNT GET CURRENT MAIN IDENT INDEX ADA N1 STA IMAIN SAVE CURRENT MAIN IDENT INDEX LDA TIDNT GET NEXT IDENT INDEX STA CIDNT SAVE ADDR FOR NEXT IDENT SCAN LDA ID6,I GET TYPE RAL,CLE,ERA SET E = M/S AND TYPMS ISOLATE PROGRAM TYPE CPA PTYPE CURRENT TYPE? RSS YES - CONTINUE JMP IDSCN+3 IGNORE IDENT - TRY NEXT IDENT ISZ IDSCN INCR RETURN ADDRESS JMP IDSCN,I RETURN SKP * CHBND IS A ROUTINE TO ASK THE OPERATOR IF HE WANTS TO CHANGE * A BOUNDRY, GET HIS ANSWER AND CHECK IT FOR LEGALITY. * THE MESSAGES SENT ARE: * * XXXXXXXXXX YYYYY AND * CHANGE XXXXXXXXXX? WHERE XXXXXXXXXX IS A 10 CHARACTER * MESSAGE SUPPLIED AS PART OF THE CALL * AND YYYYY IS THE CURRENT BOUND IN OCTAL * OR DECIMAL. * LEGAL RESPONCES ARE: * * 0 NO CHANGE. * N WHERE N>YYYYY AND LESS THAN OR EQUAL TO * THE SUPPLIED LIMIT. * * CALLING SEQUENCE: * A = CURRENT YYYYY A > 0 MEANS OCTAL * JSB CHBND  A < 0 MEANS DECIMAL. * DEF ADDRESS OF XXXXXXXXXX (5 WORD MESSAGE) * DEF UPPER LIMIT OF RESPONCE * * RETURN (ALWAYS P+3) A = NEW BOUND. * CHBND NOP STA CBFLG SSA INA STA TMPX SAVE CURRENT VALUE LDB CHBND,I GET THE MESSAGE ADDRESS AND STB TMPL SET UP TO MOVE LDA N5 FIVE WORDS STA GN.ER TO FORM THE MESSAGE: LDB DMES " CHANGE XXXXXXXXXX YYYYY" CHNX LDA TMPL,I MOVE STA B,I 5 INB WORDS ISZ TMPL TO ISZ GN.ER THE JMP CHNX MESSAGE * ISZ CHBND INDEX TO THE UPPER LIMIT STB TMPL SAVE THE ADDRESS FOR RETRY IN CASE CHOVR LDB TMPL OF ERROR LDA TMPX CONVERT THE NUMBER JSB CONVD TO THE BUFFER JSB SPACE SEND A SPACE LDB DMES GET THE ADDRESS LDA P16 AND SEND MESSAGE JSB DRKEY "XXXXXXXXXX YYYYY" TO THE TTY LDA "?" PUT A "?" AFTER THE XXXXXXXXXX STA ME11S SET IT LDA P19 SEND MESSAGE AND GET LDB ADMES RESPONCE FOR JSB READ " CHANGE XXXXXXXXXX?" LDA P5 CONVERT RESPONCE LDB CBFLG LOAD PROMPT SSB DECIMAL REQUEST?? CMA,INA YES, ASK GETOC FOR DECIMAL JSB GETOC GET BINARY EQUIVALENT JMP CBERR ERROR - REPEAT * JSB GETAL END OF BUFFER? SZA,RSS JMP CHOK YES OK- * CBERR LDA ERR14 SEND ERROR 14 JSB GN.ER JMP CHOVR AND REPEAT * CHOK LDA OCTNO GET VALUE SZA,RSS IF ZERO USE LDA TMPX SUPPLIED VALUE LDB TMPX GET -ABS VALUE SSB,RSS OF UPPER LIMIT. CMB,INB SSA GET ABS VALUE OF CMA,INA CURRENT TOO. ADB A IF LIMIT LESS THAN SSB CURRENT THEN JMP CBERR ERROR * LDB CHBND,I GET UPPER BOUND LDB B,I ]TO B CMB IF GREATER THAN ADB A MAX SSB,RSS THEN JMP CBERR ERROR * ISZ CHBND ELSE EXIT JMP CHBND,I RETURN VALUE IN A SPC 2 CBFLG NOP TMPX NOP TMPL NOP DMES DEF .XXX ADMES DEF *+1 ASC 4, CHANGE .XXX BSS 5 ME11S NOP BSS 3 "?" ASC 1,? ERR14 ASC 1,14 SKP * * ALIGN - PRINT CURRENT BOUNDARY THEN ASK USER * IF HE WANTS TO ALIGN AT A PAGE BOUNDARY * * FORM OF MESSAGE: XXXXX * ALIGN AT NEXT PAGE? * * CALLING SEQUENCE: * LDA XXXXX (BINARY...A<0 MEANS DECIMAL) * LDB ADDR TO INSERT XXXXX IN * JSB ALIGN * DEF * * NOTE: IS CHARACTER LENGTH FOLLOWED * BY ASCII TEXT. * * RETURN: AT N+2 * B IS DESTROYED * A IS OLD OR UPDATED VALUE OF XXXXX. * SPC 1 ALIGN NOP STA ATMP1 SAVE ORIGINAL BOUND STB ATMP2 AND SPOT IN MESSAGE BUFF JSB SPACE SKIP A LINE JSB APRNT AND PRINT OLD BOUNDARY. ALIG1 LDB MSAL. LDA MSALL SEND ALIGN QUESTION JSB READ AND READ ANSWER. JSB YE/NO JMP ALIG1 REPEAT QUERY IF BAD RESPONSE. JMP ALNO JUMP IF HE SAID NO. SPC 1 * USER SAID ALIGN SPC 1 LDA ATMP1 PICK UP ORIG BOUNDARY, IOR M1777 ROUND TO PAGE END, STA ATMP1 AND SAVE, LDB ATMP2 THEN GO PRINT NEW JSB APRNT BOUNDARY. SPC 1 * USER SAID DON'T ALIGN SPC 1 ALNO LDA ATMP1 PASS BACK BOUNDARY ISZ ALIGN AND RETURN JMP ALIGN,I TO CALLER. SPC 1 * SEND MESSAGE ROUTINE SPC 1 APRNT NOP LDA ATMP1 PICK UP XXXXX IN BINARY LDB ATMP2 AND ADDR FOR INSERT, JSB CONVD STUFF XXXXX IN MSG NLH LDB ALIGN,I POINT TO MESSAGE, LDA B,I GET LEN TO A, INB AND TEXT ADDR TO A, JSB DRKEY AND PRINT IT JMP APRNT,I RETURN SPC 2 ATMP1 BSS 1 ATMP2 BSS 1 SPC 1 MSAL. DEF *+1 ASC 10,ALIGN AT NEXT PAGE? MSALL EQU P19 SPC 1 MSMR DEC 32 ASC 16,LWA MEM RESIDENT PROG AREA XXXXX MSMRX DEF MSMR+14 SPC 4 END PART NASMB,Z,R,L,C HED RTGN7 - 7905 RTGEN SUBROUTINE SEGMENT. IFN ASSEMBLY OPTION "N" FOR RTE-II NAM RT2G7,5,90 92001-16031 771216 XIF IFZ ASSEMBLY OPTION "Z" FOR RTE-III NAM RT3G7,5,90 92060-16037 771216 XIF * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** SPC 3 ****************************************************************** * * NAME: RT2G7/RT3G7 * SOURCE: 92001-18031/92060-18037 * REL: 92001-16031/92060-16037 * WRITTEN BY:K.HAHN, G. ANZINGER * ****************************************************************** SPC 3 * * 7905 SUBROUTINE ENTRY POINTS: * ENT DSET5 ENTRY FOR DSETU ENT PTBT5 ENTRY FOR PTBOT ENT DSTB5 ENTRY FOR DSTBL. ENT FSEC5 ENTRY FOR FSECT. ENT DLRM7 * * * * * EXTERNAL UTILITY SUBROUTINES: * EXT CRETF,WRITF,CLOSF,FMRR,CHFIL,DISKD EXT DRKEY,SWRET,RNAME,CONVD EXT DOCON,SPACE,READ,GETNA,GINIT,GETOC,GETAL EXT INERR,YE/NO,LSTE,LSTS,ABORT,LABDO EXT PIOC,TBCHN * * EXT .LST5,OUBUF EXT LWASM, TBUF, SDS#, PPREL * A EQU 0 B EQU 1 SUP SKP * THE FOLLOWING BLOCK OF STORAGE FOR VARIABLES PRECEEDS, * AND IS REFERENCED BY, EACH SEGMENT. IT IS NOT OVERLAID * AS EACH NEW SEGMENT IS LOADED INTO CORE. * * THE LOCATION OF EACH VARIABLE MUST BE THE SAME IN * ALL SEGMENTS. IF A CHANGE IS MADE, MAKE THE SAME * CHANGE IN THE REST OF THE SEGMENTS. * * * SYSCH BSS 1 SUBCHANNEL OF SYSTEM UNIT. AUXCH BSS 1 SUBCHANNEL OF AUX UNIT. _w DSIZE BSS 1 DISK SIZE -NO. OF TRACKS. DAUXN BSS 1 AUXILIARY DISK SIZE. ADS# BSS 1 AUX DISC SECTORS/TRACK. * * RELOCATION BASE TABLE. RBTA BSS 1 ABSOLUTE PROGRAM BASE. TPREL BSS 1 CURRENT PROGRAM BASE ADDRESS. TPBRE BSS 1 BASE PAGE RELOCATION ADDRESS. COMAD BSS 1 CURRENT COMMON RELOCATION BASE. BSS 1 ABS PROGRAM BASE FOR MR CODE. * WDCNT BSS 1 TEMPORARY WORD COUNTER. DSKSY BSS 1 INITIAL ID SEGMENT DISK ADDRESS IDSP BSS 1 POSITION OF 1ST ID SEG. IN SECT TTYCH BSS 1 SYSTEM TTY CHANNEL NO. * PLFLG BSS 1 PROGRAM LOAD. FLAG = -1/0 = L/NL DSCNT BSS 1 DISK SEGMENT SECTOR COUNT * NXFLG BSS 1 ENT/EXT FLAG = -1/0 EXCNT BSS 1 SYMBOL COUNTER * LCNT BSS 1 CURRENT LBUF COUNT DCNT BSS 1 CURRENT DBUF COUNT CURAI BSS 1 CURRENT IBUF COUNT * CPLS BSS 1 ADDRESS OF TOP OF FIXED CP LINK IMAGE CPL1 BSS 1 ADDRESS OF LOW CURRENT PAGE LINK SPECS. CPL1H BSS 1 NUMBER OF CURRENT PAGE LINKS ASSIGNED CPL2H BSS 1 IN LOW AND HIGH AREA RESPECTIVELY URBP1 BSS 1 LWA R/T DISC RES BP LINK AREA BPMAX BSS 1 MAX USED BASE PAGE LINKAGE +1 CURAK BSS 1 CURRENT KBUF ADDRESS * CURAT BSS 1 CURRENT TBUF ADDRESS TCNT BSS 1 CURRENT TBUF COUNT * CURAP BSS 1 CURRENT PLIST ADDRESS * AMAD BSS 1 CURRENT MLIST ADDRESS * LICNT BSS 1 LONG ID SEGMENT COUNT SICNT BSS 1 SHORT ID SEGMENT COUNT SSCNT BSS 1 BG. SEG ID COUNT COMRT BSS 1 MAXIMUM RT COM LENGTH COMBG BSS 1 MAX BG COM LENGTH * DSKEY BSS 1 CURRENT KEYWORD DISK ADDRESS DSKID BSS 1 DISK ID SEGMENT ADDRESS KEYCN BSS 1 TOTAL KEYWORD COUNT KEYCT BSS 1 CURRENT KEYWORD COUNT * * MLIST BSS 11 MEMORY MAP BUFFER * TEMP1 BSS 1 TEMP2 BSS 1 LWH1 BSS 1 LWH2 BSS 1 LWH3 BSS 1 LWH4 BSS 1 L01 BSS 1 * FSYBP BSS 1 FIRST WORD SYS BP LINKAGE SYSAD BSS 1 CURRENT ID SEGMENT ADDRESS * TBREL BSS 1 CURRENT BP RELOC ADDR PBREL BSS 1 INITIAL BP RELOC ADDR * RELAD BSS 1 CURRENT CORE RELOCATION ADDRESS * BSBAD BSS 1 BG SEGMENT BP RELOC ADDR BSPAD BSS 1 BG SEGMENT PROG RELOC ADDR * LFLAG BSS 1 PROGRAMS-LOADED FLAG IMAIN BSS 1 CURRENT MAIN IDENT INDEX. HDFLG BSS 1 HEADING FORMAT FLAG CIDNT BSS 1 CURRENT MAIN IDENT INDEX. * AEQT BSS 1 ADDRESS OF EQUIPMENT TABLE CEQT BSS 1 NO. ENTRIES IN EQUIPMENT TABLE * ASQT BSS 1 ADDR OF DEVICE REFERENCE TABLE CSQT BSS 1 NO. ENTRIES IN DEV. REF. TABLE * AINT BSS 1 ADDRESS OF INTERRUPT TABLE CINT BSS 1 NO. ENTRIES IN INTERRUPT TABLE * DSKIN BSS 1 DISK ADDR OF INT CODE RECORD INTCN BSS 1 RECORD COUNT OF INT CODE * CURIL BSS 1 CURRENT ILIST ADDRESS ILIST BSS 64 USER SYSTEM PROG IDENT ADDR LIST * IDSAV BSS 1 INDEX OF CURRENT IDENT. DSKMN BSS 1 INITIAL MAIN DISK ADDRESS BSSDP BSS 1 INITIAL DISK RES MAIN BSS DISP PRENT BSS 1 PRIMARY ENTRY POINT DBLAD BSS 1 CURRENT DBL ADDRESS REKEY BSS 1 INSTRUCTION TYPE BYTE INSCN BSS 1 INSTRUCTION TYPE COUNTER INSTR BSS 1 CURRENT INSTRUCTION PAGNO BSS 1 CURRENT PAGE NO. OPRND BSS 1 CURRENT OPERAND PLGTH BSS 1 PROGRAM LENGTH DRT2 BSS 1 DISK DRT ENTRY ( SYSTEM) DRT3 BSS 1 AUX DISK DRT ENTRY LIBFG BSS 1 LDTYP BSS 1 SCH1 BSS 1 INDEX OF IDENT OF PGM TO BE SCHEDULED SCH3 BSS 1 ADDRESS OF CURRENT ID SEGMENT SCH4 BSS 1 ADDRESS OF THE SCHEDULED PGM ID SEG FGBGC BSS 1 BACKGROUND USING FG COMMON FLAG $LIBR BSS 1 INDEX OF $LIBR ENT $LIBX BSS 1 INDEX OF $LIBX ENT CUPRI BSS 1 * MEM1 BSS 1 MEM2 BSS 1 MEM3 BSS vC1 MEM4 BSS 1 MEM5 BSS 1 MEM6 BSS 1 MEM7 BSS 1 MEM8 BSS 1 MEM9 BSS 1 MEM10 BSS 1 MEM11 BSS 1 MEM12 BSS 1 * * IFZ ***** BEGIN MEU CODE ***** COMSZ BSS 1 #WORDS COMMON DECLARED FOR * CURRENT MAIN LPCOM BSS 1 LAST PAGE CONTAINING ANY COMMON FPSAM BSS 1 1ST PAGE CONTAINING S.A.M. FWSAM BSS 1 1ST WORD CONTAINING S.A.M. LPSYS BSS 1 LAST PAGE CONTAINING SYS OR LIB FPDSK BSS 1 1ST PAGE DISK PART AREA LOLNK BSS 1 LOW LINK FOR SSGA,LIB, OR SYS HILNK BSS 1 HI LINK USED BY MEM RES PRG BPINC BSS 1 CURR DIRECTION FOR BP LINK * ALLOCATION. +1=UP,-1=DOWN BPLMT BSS 1 WORD AFTER LAST WORD AVAIL * FOR BP LINK ALLOCATION TPMAX BSS 1 HWM FOR RELOCATION OF BG * MAINS AND SEGS MAXPT BSS 1 NUM PARTS. ALLOWED MAT. BSS 1 ADR OF LENGTH WORD * BEFORE MEM ALLOC TABLE (MAT) SSGA. BSS 1 FWA SSGA (LAST WORD SYS * OR LIB +1) FWMRP BSS 1 FWA MEM RES PROG AREA * (NEXT WORD AFTER COMMONS) MAP. BSS 1 PTR TO MEU RES MAP MPFT. BSS 1 PTR TO MPFT ****** END MEU CODE ****** XIF * SECTR BSS 0 BOOTSTRAP BUFFER FORMAT * LBPSY BSS 1 LOWER SYSTEM BP ADDRESS UBPSY BSS 1 UPPER SYSTEM BP ADDRESS DSKBP BSS 1 SYS BP DISK ADDRESS * LRMAN BSS 1 MAIN RESIDENT LOWER ADDRESS URMAN BSS 1 MAIN RESIDENT UPPER ADDRESS DSKRR BSS 1 MAIN RESIDENT DISK ADDRESS * LBMAN BSS 1 MAIN BG LOWER ADDRESS UBMAN BSS 1 MAIN BG UPPER ADDRESS DSKBG BSS 1 MAIN BACKGROUND DISK ADDRESS * SYMAD BSS 1 AVAIL SYS MEM ADDR BGBND BSS 1 BACKGROUND BOUNDARY * DSKAV BSS 1 NEXT AVAILABLE DISK ADDRESS DSKLC BSS 1 - DISK ADDRESS OF LIBRARY CODE DSKLB BSS 1 DISK ADDR OF LIBRARY ENTRY PTS DSKUT BSS 1 UTILITY PROG DISK ADDRESS DSKBS BSS 1 DISK ADDR OF MAIN BG DISK RES BP DSKBR BSS 1 CURRENT MAIN BG DISK RES DISK AD ADICT BSS 1 ADDR OF DISK DICTIONARY LBCNT BSS 1 RESIDENT LIBR ENTRY PT COUNT UTCNT BSS 1 UTILITY LIBRARY COUNT KEYAD BSS 1 CURRENT KEYWORD ADDRESS RTCAD BSS 1 RT COM CORE ADDRESS LBCAD BSS 1 LIBRARY CODE ADDRESS SYBAD BSS 1 ADDR OF FIRST BP LINK FOR BG IDSAD BSS 1 ADDR OF FIRST ID SEGMENT ABSID BSS 1 IDENT ADDR FOR NEXT BG SEG SCAN MAXRP BSS 1 MAXIMUM RT DISK RESIDENT PROG MAXRB BSS 1 MAXIMUM RT DISK RESIDENT BP IDMBS BSS 1 BG MAIN ADDRESS FOR BS REF * TB30 BSS 128 TRACK MAP TABLE #SUBC BSS 1 # SUBCHANNELS DEFINED SPC 5 ********************************************************* * * * END OF COMMON STORAGE BLOCK FOR ALL SEGMENTS. * * * ********************************************************* SPC 2 DLRM7 DEF LRMAN SKP * * * THIS SEGMENT CONTAINS THE DISC DEPENDENT SUBROUTINES * FROM THE MH RTGEN DRIVER SECTION. THE FOLLOWING ARE * THE MODIFICATIONS MADE TO THE OFF-LINE VERSIONS. * * * DSET5 - IN RTGN7: CALLED BY MAIN. * --MODIFICATIONS: SCRATCH DISC OMITTED. * * DSSIZ - IN RTGN7; CALLED BY DSET5. * * TSTCH - IN RTGN7; CALLED BY DSET5. * --MODIFICATIONS: INIT1 FLAG OMITTED. * * STDSK - IN RTGN7; CALLED BY PTBT5. * * PTBT5 - IN RTGN7; CALLED BY MAIN. * --MODIFICATIONS: INITS CALL OMITTED, * PAPER TAPE BOOT WRITTEN ON FMP FILE. * * INITS - OMITTED. * * INIER - OMITTED. * * DSTB5 - IN RTGN7; CALLED BY RTGN5 VIA MAIN. * --SLIGHT MODIFICATION. * * DISKA - IN MAIN; CHANGE REQ'D FOR FH GEN * --MODIFICATION: NO TEST FOR DEFECTIVE TRACKS. * * TRTST - OMITTED. * * DISKI - IN MAIN; CHANGE REQ'D FOR FH GEN * * DISKO - IN MAIN; CHANGE REQ'D FOR FH GEN * * DTSE5 - OMITTED. * * FSEC5 - IN RTGN7; CALLED BY RTGN3 VIA MAIN. * --MODIFICATIONS: OUBUF IS AN ENT IN MAIN. * * DISKD - IN MAIN; CHANGE REQ'D FOR FH GEN * --MODIFICATIONS: TRANSLATES DISC ADDR TO RECORD * NUMBER, USES FMP WRITF/READF CALLS FOR ACCESS * TO CORE-IMAGE RTE SYSTEM OUTPUT FILE. * * ATB30 - TRACK MAP TABLE - DIFFERENT SIZES FOR 7900 OR * 7905 HED MH RTGEN - CONSTANTS AND ADDRESSES * BEG05 JMP SWRET SEGMENT ENTRY POINT * DC EQU 0 ASBUF DEF ASPBF+1 ADDRESS OF 9-WORD BUFFER IN BOOT ABOOT DEF START ADDRESS OF BOOTSTRAP LOADR ATB30 DEF TB30 * #DATA ABS I/OTB-I/OTC NO. OF DATA I/O INSTRUCTIONS INTMP BSS 1 TEMP FOR INITILIZATION ROUTINES MS3 DEF *+1 SUBCHANNEL NUMBER MESAGE ASC 3, 00? MES1 DEF *+1 ASC 20,# TRKS, FIRST CYL #, HEAD #, # SURFACES, ASC 14, UNIT, # SPARES FOR SUBCHNL: P68 DEC 68 LENGTH OF MESSAGE * MES4 DEF MES04 MES04 ASC 8,BOOT FILE NAME? MES05 ASC 8,SYSTEM SUBCHNL? MES07 ASC 9,AUX DISC SUBCHNL? MES40 DEF *+1 ASC 13,# 128 WORD SECTORS/TRACK? "/E" ASC 1,/E SBUF BSS 3 DSBUF DEF SBUF MES5 DEF MES05 MES7 DEF MES07 * L2000 OCT -2000 M0760 OCT 76000 M77 OCT 77 M377 OCT 377 M1177 OCT 101777 M1777 OCT 1777 M74C OCT 7400 M7400 OCT 177400 M7600 OCT 177600 M7700 OCT 177700 N2 DEC -2 N3 DEC -3 N4 DEC -4 N5 DEC -5 N6 DEC -6 P1 DEC 1 P2 DEC 2 P4 DEC 4 P5 DEC 5 P6 DEC 6 P7 DEC 7 P15 DEC 15 P16 DEC 16 P17 DEC 17 P25 DEC 25 P31 DEC 31 BLANK OCT 40 STEMP NOP TTEMP NOP HED INTERACTIVE DISC SET UP SECTION * * THE FOLLOWING MESSAGES ARE PRINTED DURING THE INITIALIZATION * PHASE, WITH THE SPECIFICATIONS FOR EACH VALID RESONSE. * * * MESSAGE  RESPONSE * * CONTROLLER CHANNEL? ENTER 2 OCTAL DIGITS * * # TRKS, FIRST CYL #, HEAD #, # SURFACES, UNIT, # SPARES FOR SUBCHNL? * 0? * . * . * . * . * 32? * * SYSTEM SUBCHNL? ENTER 1 OCTAL DIGIT * * AUX DISC (YES OR NO)? ENTER YES OR NO * * AUX DISC SUBCHNL? ENTER 1 OCTAL DIGIT * * # 128 WORD SECTORS/TRACK? ENTER 3 DECIMAL DIGITS $$ SPC 3 DSET5 EQU * **ENTRY POINT FOR DSETU** DSETU NOP ENTRY POINT FOR QUESTION SECESSION. LDB $TB32 PUT TB32 IN THE LST JSB LSTE NOP IGNOR ALREADY THERE RETURN CHNLD LDA P16 LDB MESS2 MESS2 = ADDR: CONTROLLER CHNL? JSB READ PRINT MESSAGE, GET REPLY LDA P2 SET FOR 2 OCTAL DIGITS INPUT JSB DOCON GET DIGITS, RETURN OCTAL JMP CHNLD REPEAT INPUT * STA DCHNL SET DISK CHANNEL NUMBER ADA N8 MUST BE >=10 SSA,RSS JMP STB30-1 JSB INERR IT WAS'T JMP CHNLD TRY AGAIN * JSB SPACE SET UP TRACK MAP STB30 LDA P68 SEND MESSAGE: LDB MES1 # TRKS, FIRST CYL #, HEAD #, # SURFACES, JSB DRKEY UNIT, # SPARES FOR SUBCHNL: LDA ATB30 SET ADDRESSES STA STEMP FOR INPUT STA INTMP AND CLEAR LOOPS LDB M7600 =-128 CLEAR CLA THE TB30. STA INTMP,I TRACK ISZ INTMP MAP INB,SZB STEP COUNT - DONE? JMP TB30. NO - CLEAR NEXT WORD * STA #SUBC SET 0 DEFINED SUBCHANNELS TB30A STB INTMP SAVE CURRENT UNIT LDA B CONVERT FOR THE MESSAGE CMA,INA LDB DSBUF JSB CONVD LDA SBUF+2 STA MS3+2 SET IN THE MESSAGE LDB MS3 GET MESSAGE ADDRESS LDA P5 AND LENGTH JSB READ GO GET THE ANSWER LDA N2 GET FIRST JSB GETNA TWO CHARACTERS CPA "/E" /E? JMP TB30X YES - GO CHECK FURTHER * JSB mGINIT NO - REINITIALIZE LBUF SCAN LDA N4 CONVERT 4 DIGITS JSB GETOC DECIMAL JMP TB30E ERROR - * STA TTEMP SET # TRACKS IN TEMP SZA,RSS IF ZERO JMP TB30B GO UPDATE POINTERS * JSB GETAL NOT ZERO - GET NEXT CHARACTER CPA BLANK COMMA IN? RSS YES - SKIP JMP TB30E NO - ERROR * LDA N3 SET FOR JSB GET 3 DECIMAL DIGITS AND CONVERT STA STEMP,I THE CYL # FOR TRACK 0. CCA GET 1 DIGIT JSB GET HEAD NUMBER STA B SAVE ADA N5 MUST BE LESS THAN 5. SSA,RSS WELL? JMP TB30E NO - BITCH * BLF,BLF PUT IN ITS PLACE STB BSHED AND SAVE CCA NOW GET # SURFACES JSB GET MUST BE 1 TO 5. STA B SZA ADA N6 SSA,RSS WELL? JMP TB30E NOT GOOD! BITCH BLF,BLF MOVE TO HIGH BLF END AND ADB BSHED COMBINE WITH HEAD STB BSHED CLA,INA NOW GET UNIT JSB GET MUST BE 0 TO 7. ADA BSHED GOOD - ADD THE HEAD WORD STA BSHED AND SAVE IT. CLA PREPARE FOR DEFAULT # SPARES STA TBUF+1 NAMELY 0. JSB GETAL TEST FOR SPARES CPA BLANK WELL? RSS YES, SO SET TO CONVERT 2 DIGITS JMP TB30C NO, USE DEFAULT * LDA N2 JSB GET CONVERT THE # SPARES STA TBUF+1 SAVE THE NUMBER JSB GETAL END OF LINE? SZA WELL? JMP TB30E NO - TOO BAD - AND YOU ALMOST * MADE IT TOO. TB30C ISZ STEMP STEP TO HEAD/UNIT WORD. LDA BSHED AND STA STEMP,I SALT IT AWAY. ISZ STEMP NOW THE # TRACKS LDA TTEMP WORD STA STEMP,I SALT IT AWAY. STA DSIZE SET ALSO FOR ASSUMPTION ISZ STEMP STEP ThO SPARES LDA TBUF+1 AND STA STEMP,I SALT THAT AWAY TOO. LDA INTMP TO THIS SUBCHANNEL STA SYSCH FOR DEFAULT ISZ #SUBC STEP TOTAL SUBCHANNEL COUNT TB30B ISZ STEMP STEP TABLE ISZ INTMP STEP SUBCHANNEL TB30F LDB INTMP IF CURRENT SUBCHANNEL CPB P32 IS 32 THEN JMP TB30Y DONE SO GO EXIT * JMP TB30A NOT 32 - GO ASK FOR NEXT ONE * SPC 1 TB30E JSB INERR TELL HIM THERE WAS AN ERROR JMP TB30F GO ASK AGAIN * SPC 1 TB30X JSB GETAL /E ENTERED SZA ANY THING ELSE? JMP TB30E YES - ERROR * TB30Y LDA #SUBC NO - GET NUMBER OF CHANNELS CMA,INA,SZA DEFINED - IS IT ZERO? JMP TB30Z NO - SKIP * JSB INERR YES - TELL HIM JMP STB30 AND RESTART * TB30Z JSB DSSIZ GET THE SYSTEM DISC # SECT./TRK. STA SDS# AND SET IT. * SPC 1 JSB SPACE ISYSC LDA P15 SEND MESSAGE: LDB MES5 SYSTEM SUBCHNL? JSB READ GET ANSWER LDA N5 JSB DOCON GO CONVERT JMP ISYSC ERROR - TRY AGAIN * JSB TSTCH TEST FOR LEGAL SUBCHANNEL STB DSIZE SET SYSTEM SIZE STA SYSCH SET SYSTEM SUBCHANNEL ADB M7400 TEST FOR TOO MANY TRACKS CMB,SSB,INB,SZB OK? JMP SYSER NO GO BITCH * * SET VALUES FOR THE BOOT * RSS SETEM CLA SUBCHANNEL IN A MPY P4 LDB ATB30 POSITION WITHIN TMT FOR INFO ADB A LDA B,I GET FIRST CYLINDER # STA PT#TR INB LDA B,I LDB A AND M74C STA H#AD SET HEAD # FOR COMMANDS LDA B AND M377 GOT THE UNIT LDB WA#KE NOW INCORPORATE IT ADB A IT INTO THE WAKEUP, STB WA#KE SEEK,AND READ COMMANDS LDB PT#SK ADB A STB PT#SK LDB PT#AD ADB A STB PT#AD LDB 'R#DCM ADB A STB R#DCM LDB P#EN ADB A STB P#EN * SPC 1 AUXIN CLA PRESET TO SHOW NO AUX DISC STA DAUXN SET CHANNEL TO ZERO STA ADS# #SECT PER TRACK TO ZERO, CCA AND SUBCHANNEL STA AUXCH TO -1. JSB SPACE AUXDS LDA P31 SEND MESSAGE LDB MES6 AUX DISC (YES OR NO OR # TRKS)? JSB READ GO GET ANSWER LDA N3 FIRST TRY FOR A DECIMAL JSB GETOC NUMBER JMP AUX0 NO TRY FOR YES OR NO * STA TBUF SAVE THE NUMBER JSB GETAL END OF INPUT? SZA JMP AUX0 NO LET YE/NO SEND ERROR * LDA TBUF GET BACK THE SIZE STA DAUXN SET THE AUX DISC SIZE JSB DSSIZ GET ITS # SECTORS / TRACK JMP AUX3 GO SET IT * AUX0 JSB GINIT RESET THE SCANNER JSB YE/NO TRY FOR YES OR NO JMP AUXDS NO MUST BE BAD ANSWER * JMP STSCR NO - SKIP * CLA,INA YES - IF ONLY ONE CPA #SUBC DISC SUBCHANNEL THEN JMP AUX4 THEN WRONG ANSWER TRY AGAIN * JSB SPACE YES - SET UP AUX UNIT AUXUN LDA P17 SEND QUESTION: LDB MES7 AUX DISC SUBCHNL? JSB READ GO SEND AND GET ANSWER LDA N5 JSB DOCON JMP AUXUN ERROR - TRY AGAIN * JSB TSTCH TEST FOR LEGAL UNIT AUX1 STB DAUXN SET SIZE OF AUX UNIT CPA SYSCH SAME AS SYSTEM? RSS YES - ERROR SKIP JMP AUX2 NO - GO SET UP * AUX4 JSB INERR SEND ERROR MESSAGE JMP AUXIN AND TRY AGAIN * SYSER JSB INERR SEND ERROR MESSAGE JMP ISYSC TRY AGAIN * AUX2 ADB M7400 TOO MANY TRACKS FOR AUX CMB,SSB,INB,SZB DISC? JMP AUX4 YES GO BITCH * SPC 1 STA AUXCH SET AUX CHANNEL LDA SDS# SET AUX TRK SIZE TO SAME AS SYS DISC AUX3 STA ADS# SET AUX DISC # SECT. TRACK e+B@< SPC 1 * NOTE: THE FACT THAT ANY GIVEN DISC * ADDRESS IS ON A UNIT OTHER THAN * THE SYSTEM UNIT IS FLAGGED BY * ITS TRACK ADDRESS BEING GREATER THAN * 400 BY THE AMOUNT OF THE DESIRED * TRACK. STSCR JMP DSETU,I RETURN TO MAIN LINE CODE SPC 1 P32 DEC 32 BSHED NOP SPC 1 * * GET # SECTORS FOR DISC * DSSIZ NOP JSB SPACE NEW LINE #SEC1 LDA P25 LDB MES40 MES40 = ADDR: # 128 WORD SECTORS/TRACK?$$ JSB READ PRINT MESSAGE, GET REPLY LDA N3 SET FOR 3 DECIMAL DIGITS INPUT JSB DOCON GET DIGITS, RETURN OCTAL JMP #SEC1 REPEAT INPUT * ALS DOUBLE FOR 64 WORD SECTORS JMP DSSIZ,I RETURN SPC 2 GET NOP GET SUBROUTINE CHECKS FOR EXISTANCE STA TBUF AND GETS NEXT JSB GETAL INPUT NUMBER CPA BLANK PASS NUMBER TYPE ECT FLAG IN A RSS LINE NOT EMPTY SO SKIP JMP TB30E EMPTY LINE SO ERROR * LDA TBUF GET TYPE/ # DIGITS JSB GETOC GET NUMBER JMP TB30E CONVERSION ERROR BITCH * JMP GET,I ELSE RETURN cB SKP SPC 3 * SUBROUTINE TO TEST LEGALITY OF * A SUBCHANNEL. THE TEST CONSISTS * OF LOOKING FOR THE DESIRED * CHANNEL IN THE TRACK MAP. * CALLING SEQUENCE * * P-1 ERROR RETURN * P JSB TSTCH * P+2 NORMAL RETURN CHANNEL IN A SIZE IN B SPC 1 * A ON ENTRY IS ASSUMED TO BE THE SUBCHANNEL TO BE CHECKED. * ERROR EXIT IS P-1 * IF THE SUBCHANNEL IS LEGAL IT IS RETURNED IN A * AND B IS THE NUMBER OF TRACKS ON THAT CHANNEL SPC 1 TSTCH NOP LDB A SUBCHANNEL SPECIFIED MUST BE <=31 ADB N32 SSB,RSS JMP TSTER IT WASN'T * LDB A NUMBER TO B BLS,BLS INDEX INTO THE ADB ATB30 MAP TABLE ADDRESS ADB P2 STEP TO # TRACKS LDB B,I GET # TRACKS IN B SZB IF ZERO - ERROR - SKIP JMP TSTCH,I ELSE OK - RETURN B= # TRACKS * TSTER JSB INERR SEND ERROR MESSAGE LDA TSTCH GET RETURN ADDRESS ADA N2 ADJUST FOR P-1 JMP A,I AND RETURN * N8 DEC -8 N32 DEC -32 SKP * * INSERT CHNL NO. IN INSTRUCTION * * THE STDSK SUBROUTINE SETS THE CURRENT DISK CHANNEL * NOS. IN THE I/O INSTRUCTIONS. * * CALLING SEQUENCE: * A = NO. WORDS TO BE CONFIGURED (NEG.) * B = ADDRESS OF INSTRUCTION ADDR LIST * JSB STDSK * * RETURN: * A = DESTROYED * B = NEXT INSTRUCTION ADDRESS * STDSK NOP STA TBUF SAVE NO. OF INSTRUCTIONS STDS1 LDA B,I GET INSTRUCTION AND M7700 ISOLATE INSTRUCTION CODE IOR DCHNL INSERT CHANNEL NO. STA B,I SET INSTRUCTION IN CODE INB INCR INSTRUCTION ADDRESS ISZ TBUF SKIP - ALL INSTRUCTIONS CONFIG. JMP STDS1 CONFIGURE NEXT INSTRUCTION JMP STDSK,cI RETURN * SPC 2 HED MH RTGEN CONFIGURE AND COMPLETE INITILIZATION PTBT5 EQU * **ENTRY POINT FOR PTBOT** PTBOT NOP CONFIGURE/PUNCH BOOT ENTRY POINT LDA #DATA GET THE NUMBER OF DATA CHANNEL INSTRUCTIONS LDB HPDSK GET THE ADDRESS OF THE DISK ADDRESSES JSB STDSK GO SET DATA CHANNEL ADDRESSES * LDB DP#RM GET THE TABLE ADDRESS IN BOOT LDA PL#ST AND ADDRESS IN PARER BOOT JSB MOVW MOVE THE WORDS DEC -10 LDB D#HDS GET ADDRESS OF REST OF PRAMS LDA SYSCH GET ADDRESS OF SYSTEM PARAMTERS RAL,RAL POSITION TO SYSTEM SUBCH ADA ATB30 INA STEP TO THE HEAD/UNIT WORD LDA A,I GET THE WORD ALF ROTATE TO LOW A AND M17 AND ISOLATE THE #HEADS PER CYL. STA B,I SET FOR BOOT INB STEP THE ADDRESS LDA H#AD GET THE BASE HEAD ADDRESS STA PT#H2 SET IN SECOND ADDRESS FOR PT ALF,ALF AND SET BASE HEAD FOR STA B,I AND SET IT FOR THE BOOT INB STEP TO NEXT ADDRESS LDA PT#TR STA PT#T2 SET FOR ADDRESS RECORD STA B,I SET FOR THE BOOT INB STEP TO NEXT ADDRESS LDA SDS# SET ALF,RAL THE RAL NUMBER OF WORDS STA B,I PER TRACK LDA LWASM GET LWAM AND M0760 MASK TO PAGE STA TBUF SAVE LDA BADD GET THE BOOT ADDRESS AND M1177 MASK TO PAGE BITS AND IOR TBUF ADD PAGE BITS AND STA BADD SET FOR THE PAPER BOOT RAL,CLE,ERA CLEAR THE SIGN BIT INB STA B,I SET THE ADDRESS INB FOR BOOTING STA B,I AND STA BADDD FOR THE PAPER BOOT INB LDA B,I GET THE TABLE ADDRESS AND M1777 AND MASK TO PAGE OFFSET IOR TBUF ADD THE PAGE BITS STA B,I I AND RESTORE INB STEP THE THE NEXT ONE LDA B,I GET THE DEF AND M1777 SAVE THE OFFSET IOR TBUF SET THE PAGE STA B,I AND RESET INB AND YET ANOTHER LDA B,I AND M1777 IOR TBUF STA B,I LDA DDIV CONFIGURE THE DIVIDE AND M1777 IOR TBUF STA DDIV AND RESET IT INB ONE MORE TIME LDA B,I AND M1777 IOR TBUF STA B,I DONE SO * LDB ABOOT OUTPUT THE BOOTSTRAP CLA,CLE TO THE DISC JSB DISKD TRACK ZERO SECT ZERO SPC 3 BOOT0 JSB SPACE NEW LINE LDA P15 SEND MESSAGE LDB MES4 BOOT FILE NAME? JSB RNAME GET THE NAME * JSB GINIT IF A 0 WAS ENTERED, THEN CLA,INA SKIP THE BOOT JSB GETNA CPA ZERO JMP PTBOT,I * JSB CRETF CREAT BOOT FILE DEF *+5 DEF BTDCB DEF P1 DEF P7 DEF M2300 * JSB CHFIL CHECK FILE STATUS JMP BOOT0 ERROR-TRY AGAIN * LDA NBLC GET BOOT LENGTH STA TBUF SET FOR CHECK SUM CACULATION LDA STRAP GET LOAD ADDRESS CLB,RSS INITIALIZE CHECKSUM BOOT1 ADB A,I COMPUTE CHECKSUM INA STEP ADDRESS ISZ TBUF DONE? JMP BOOT1 NO - GET NEXT WORD * STB A,I YES - SET CHECKSUM * JSB WRITF OUTPUT THE BOOTSTRAP FILE DEF *+5 DEF BTDCB DEF FMRR DEF STRAP+1 DEF BOOTL * LDA BTDCB+2 SZA IF ITS A TYPE 0 FILE JMP BOOTC THEN WRITE AN EOF JSB WRITF DEF *+5 DEF BTDCB DEF FMRR DEF STRAP+1 DEF N1 * BOOTC JSB CLOSF CLOSE BOOT FILE DEF *+2 DEF BTDCB * JMP PTBOT,I RETURN TO MAIN SPC 2 N1 DEC -1 BTDCB BSS 144 M2300 OCT 2300 MESS2 DEF *+1  ASC 8,CONTROLLER CHNL? MES6 DEF *+1 ASC 16,AUX DISC (YES OR NO OR # TRKS)? HPDSK DEF I/OTB,I ADDRESS OF I/O INSTRUCTION LIST DCHNL BSS 1 DISK I/O CHANNEL NO. (OCTAL) ZERO OCT 60 DP#RM DEF WAK PL#ST DEF WA#KE D#HDS DEF #HDS * HED MH RTGEN DISC DRIVE I/O INSTRUCTION ADDRESSES I/OTB DEF DSK1 DATA CHANNEL DEF DSK2 DEF DSK3 DEF DSK4 DEF DSK5 DEF DSK6 DEF DSK7 DEF DSK10 DEF DSK11 DEF DSK12 DEF DSK13 DEF DSK14 DEF DSK15 DEF DSK16 DEF DSKDR I/OTC EQU * HED MH RTGEN ** SECT. 0 TRK 0 BOOTSTRAP ** * * THE FOLLOWING LOADER PERMITS LOADING OF THE RESIDENT PORTIONS * OF THE REAL TIME MONITOR. THE LOADER IS LOCATED ON SECTOR 0/1, * TRACK 0 OF THE SYSTEM DISC. IT IS GENERATED BY THE SYSTEM * GENERATOR AND CONSISTS OF: * * (1) THE INSTRUCTIONS REQUIRED FOR LOADING THE SYSTEM * (2) THE DISK AND CORE ADDRESSES SPECIFYING LOADING * * * THE ADDRESSES REQUIRED FOR LOADING ARE THE FOLLOWING: * * (A) BASE PAGE LINKAGES * (1) LOW CORE ADDRESS * (2) HIGH CORE ADDRESS * (3) DISK ADDRESS OF ABSOLUTE CODE * * (B) SYSTEM, RT RESIDENT MAIN * (1) LOW CORE ADDRESS * (2) HIGH CORE ADDRESS * (3) DISK ADDRESS OF ABSOLUTE CODE * * (C) BG RESIDENT MAIN * (1) LOW CORE ADDRESS * (2) HIGH CORE ADDRESS * (3) DISK ADDRESS OF ABSOLUTE CODE * * THE PROGRAM IS ASSUMED TO BE LOADED IN THE AREA JUST PRECEDING * THE PROTECTED LOADER. * START ABS LDB-O+ASPBF GET ADDRESS OF DISK SPEC. BUFFER ABS STB-O+SPCAD SET CURRENT SPBUF ADDRESS ABS JSB-O+PLOAD LOAD MAIN SYSTEM, RT RESIDENTS ABS JSB-O+PLOAD LOAD MAIN BG RESIDENTS ABS JSB-O+PLOAD LOAD BP LINKAGES JMP 3B,I TRANSFER TO RT MONITOR ENTRY PT. * PLOAD ABS 2000B-OO+START ADDRESS OR BOOT WHEN BBDL'ED ABS LDB-O+SPCAD+I+I GET LOW CORE ADRESS ABS ISZ-O+SPCAD #f INCR CURRENT SPBUF ADDRESS ABS LDA-O+SPCAD+I+I GET HIGH CORE ADRESS ABS ISZ-O+SPCAD INCR CURRENT SPBUF ADDRESS CMA,CCE,INA COMPLEMENT, SET DIRECTION BIT ADA B SET A = TOTAL WORD COUNT RBL,ERB SET DIRECTION BIT IN CORE ADDR CLC 2 OTB 2 SET MEMORY ADDRESS REGISTER ABS STA-O+RECNT INITIALIZE REMAINING COUNT ABS LDB-O+SPCAD+I+I GET THE DISK ADRESS ABS ISZ-O+SPCAD BUMP THE ADDRESS FOR NEXT LSR 7 TRACK IN B, SECTOR IN HIGH A ABS STB-O+T#ACK SAVE THE TRACK FOR LOOP SLOAD CLB LSR 10 PUT SECTOR IN LOW ABS STA-O+BENT SAVE THE SECTOR ABS LDA-O+T#ACK GET THE TRACK DIV -O+#HDS GET RELATIVE TRACK/HEAD DDIV EQU *-1 ABS ADA-O+TBASE ADD TRACK ZERO TO GET ABS. TRACK ABS STA-O+CYLA1 SAVE FOR ADDRESSING ABS STA-O+CYLA3 SAVE FOR ADDRESSING ABS ADB-O+BHD# ADD THE BASE HEAD ADDRESS ABS LDA-O+BENT GET SECTOR TO A BLF,BLF PUT HEAD IN HIGH B AND ABS ADB-O+BENT ADD THE SECTOR ABS STB-O+HDA SET THE HEAD/SECTOR ADDRESSES RSS SKIP OVER THE BBDL ADDRESS DEF ABS 2000B+BENT-OO DEFINE ADDRESS OF BENT ABS STB-O+HDA3 SET THE HEAD/SECTOR ADDRESSES LSL 7 SECTOR TIMES 128 CMA,INA AND SUBTRACT FROM ABS ADA-O+#WDTK NUMBER OF WORDS PER TRACK ABS STA-O+P#WDS SET POSITIVE # WORDS CMA,INA AND ABS STA-O+N#WDS NEGATIVE # WORDS THIS TRACK ABS LDA-O+RECNT GET NUMBER LEFT SSA,RSS IF POSITIVE ABS JMP-O+PLOAD+I+I DONE - SO EXIT * ABS ADA-O+P#WDS ELSE SET TO READ ABS STA-O+RECNT SAVE REMANING COUNT SSA NEXT TRACK CLA USE MIN. OF NUMBER ON TRACK OR ABS ADA-O+CN#WDS NUMBER LEFT STC 2 SET DMA FOR WORD COUNT OTA 2 AND SEND IT ABS LDB-O+D#PRM GET THE COMMAND SLOOP INB ADDRESS LDA B,I GET A COMMAND RAL,CLE,SLA,ERA IF SIGN BIT SET DSK10 CLC DC SEND COMMAND IS COMMING DSK11 OTA DC,C SEND THE COMMAND ABS CPB-O+A#DMA IF DMA STC 6,C START IT DSK12 STC DC ALLOW ATTENTION SEZ,RSS IF NOT A COMMAND ABS JMP-O+STDMA DON'T WAIT FOR FLAG * DSK13 SFS DC WAIT FOR THE FLAG ABS JMP-O+*-1 STDMA STF 6 STOP DMA IF NEEDED ABS CPB-O+A#END END OF LOOP? RSS SKIP IF END ABS JMP-O+SLOOP NOT END AROUND WE GO * DSK14 LIA DC,C GET STATUS 1 DSK15 SFS DC WAIT FOR FLAG ABS JMP-O+*-1 DSK16 LIB DC,C GET STATUS 2 ABS AND-O+C174B ISOLATE SZA,RSS IF NO ERRORS ABS JMP-O+OK CONTINUE * ABS CPA-O+C174B IF ATTENTION RSS SKIP HLT 31B ELSE HALT ABS JMP-O+START TRY AGAIN * OK ABS ISZ-O+T#ACK STEP THE TRACK ADDRESS ABS JMP-O+SLOAD GO LOAD (A=0=SECTOR ADDRESS) * * DATA AREA C174B OCT 17400 P#WDS DEC -128 N#WDS NOP WAK OCT 113000 SKCMD OCT 101200 CYLA1 NOP HDA NOP AD#RC OCT 106000 CYLA3 NOP HDA3 NOP FILM# OCT 107404 R#CMD OCT 102400 S#TAC OCT 101400 #HDS OCT 2 BHD# NOP TBASE NOP #WDTK DEC 6144 RECNT OCT 1500 CONFIGURED TO BBL ADDRESS SPCAD OCT 1500 CONFIGURED TO BBL ADDRESS D#PRM ABS WAK-O-1 A#DMA ABS R#CMD-O A#END ABS S#TAC-O ASPBF ABS ASPBF+1-O BSS 9 SYSTEM LOADING SPECIFICATIONS BENT NOP JSB HERE FROM BBDL T#ACK STF 6 CLEAN UP DMA CLC 0,C AND THE I/O SYSTEM HLT 77B DISABLbE THE LOADR ENABLE SWITCH AND RUN * DRBOT ABS LDA-OO+PLOAD+I+I MOVE 128 WORDS TO BBL-128 ABS STA-OO+RECNT+I+I ABS ISZ-OO+PLOAD ABS ISZ-OO+RECNT ABS ISZ-OO+P#WDS DONE? ABS JMP-OO+DRBOT NO GET NEXT WORD * ABS JMP-OO+SPCAD+I+I YES GO EXECUTE THE BOOT SKP * * * * THE FOLLOWING EQU SECTION ALLOWS THE BOOTSTRAP * TO BE LOCATED ANYWHERE IN CORE WHEN OUTPUT TO * DISK, BUT EXECUTABLE FROM THE LAST PAGE OF CORE. * * * O EQU START-1500B SET FOR START AT 1500 PAGE RELATIVE * CPB EQU 056000B CPB CPA EQU 052000B CPA LDB EQU 066000B LDB STB EQU 076000B STB ADB EQU 046000B ADB JSB EQU 016000B JSB ISZ EQU 036000B ISZ LDA EQU 062000B LDA STA EQU 072000B STA ADA EQU 042000B ADA AND EQU 012000B AND XOR EQU 022000B XOR JMP EQU 026000B JMP I EQU 040000B INDIRECT BIT (CODE AS I+I) * * THE FOLLOWING EQU ARE USE TO SET UP THE BBDL MOVE CODE * WHEN BOOTED BY THE BBDL THE LOADR IS LOADED TO 2011 * AND JSB'ED TO AT 2055,I (44 RELATIVE) * OO EQU START-11B RELATIVE PAGE LOCATION OF START HED MOVING HEAD PAPER TAPE BOOT STRAP * MOVING HEAD BOOTSTRAP * THIS BOOTSTRAP IS CONFIGURED AND PUNCHED BY THE GENERATOR AND IS * USED TO LOAD THE DISC RESIDENT BOOTSTRAP FROM SYSTEM TRACK * 0 SECTOR 0. SPC 2 STRAP DEF *+1 ADDRESS OF THE BOOT STRAP ABS BL256 LENGTH OF LOADR IN HIGH HALF OF WORD ABS BORG LOAD ADDRESS S#ART CLC 0,C STOP EVERTHING - RTE IS COMMING! LDA DSKDR-ADCON SET OTA 6 UP CLC 2 DMA LDB BADD-ADCON BUFFER ADDRESS OTB 2 LDA DM128-ADCON 128 WORDS STC 2 OTA 2 LDB P#LST-ADCON N#XT INB STEP ADDRESS N#XT1 LDA B,I GET THE COMMAND RAL,CLE,SLA,ERA IF A CLC IS NEEDED DSK1 CLC DC DO IT DSK2 OTA DC,C SEND THE WORD CPB P#DMA-ADCON DMA NOW? STC 6,C YES DSK3 STC DC ALLOW ATTENTION SEZ,RSS IF NOT A COMMAND JMP DMAST-ADCON DON'T WAIT FOR FLAG * DSK4 SFS DC WAIT FOR FLAG JMP *-1-ADCON * DMAST STF 6 CLEAR DMA CPB P#END-ADCON END OF LOOP RSS YES SKIP OUT JMP N#XT-ADCON NO DO NEXT WORD * DSK5 LIA DC,C GET THE STATUS 1 WORD DSK6 SFS DC WAIT FOR 2 JMP *-1-ADCON * DSK7 LIB DC,C GET STATUS 2 AND B174C-ADCON ISOLATE THE IMPORTANT BITS SZA,RSS IF OK JMP BADDD-ADCON,I GO EXECUTE THE BOOT * RBR,SLB,RBL TEST READY BIT JMP ATN#-ADCON NOT READY GO WAIT FOR ATTN. * CPA B174C-ADCON IF ATTENTION RSS JUST TRY AGAIN HLT 11B ELSE HALT JMS#A JMP S#ART-ADCON TRY AGAIN * ATN# LDB P#LST-ADCON GET 'END' COMMAND ADDRESS AND JMP N#XT1-ADCON GO SEND IT AND WAIT FOR ATTN. P#LST DEF *+1-ADCON ADDRESS OF COMMAND LIST OCT 112400 END COMMAND (WAITS FOR ATTN.) WA#KE OCT 113000 PT#SK OCT 101200 PT#TR NOP H#AD NOP PT#AD OCT 106000 PT#T2 NOP PT#H2 NOP OCT 107404 FILE MASK R#DCM OCT 102400 P#EN OCT 101400 STATUS COMMAND BADD ABS START-O+I+I THESE DSKDR ABS DC DMA CON WORD DM128 DEC -128 BADDD ABS START-O B174C OCT 17400 P#END ABS P#EN-ADCON P#DMA ABS R#DCM-ADCON SPC 1 HNDR JMP S#ART-ADCON MUST BE AT 100B WHEN LOADED * NOP LOCATION FOR CHECK SUM SPC 2 BORG EQU 100B+S#ART-HNDR RUN TIME ORG OF PAPER BOOT ADCON EQU HNDR-100B ADDRESS ADJUSTING CONSTANT. BL EQU HNDR-S#ART+1 BOOT LENGTH BL4 EQU BL+BL+BL+BL BOOT LENGTH TIMES 4 BL16 EQU BL4+BL4+BL4+BL4 TIMES 16 BL64 EQU BL16+BL16+BL16+BL16 TIMES 64 BL256 EQU BL64+BL64+BL64+BL64 TIMES 256 BOOTL ABS BL+3 LENGTH FOR PUNCHING NBLC ABS -BL-2 BOOT LENGTH FOR CHECK SUM CACULATION HED GENERATE $TB31 TRACKl8 MAP TABLE DSTB5 EQU * **ENTRY POINT FOR DSTBL** DSTBL NOP * GENERATE TB32 SPC 2 LDA ATB30 GET THE TABLE ADDRESS STA TBUF SET FOR INDEXING LDA #SUBC GET NUMBER OF WORDS CMA,INA SET NEGATIVE STA TBUF+1 SET COUNT LDB $TB32 GET THE LST ENTRY JSB LSTS FOR $TB32 JSB ABORT BAD NEWS NO $TB32 ????? LDB PPREL GET THE CORE ADDRESS FOR TABLE STB .LST5,I SET IN THE SYMBOL TABLE LDA TBUF+1 SEND THE SUBCHANNEL COUNT JSB LABDO FIRST * DSTB1 LDA TBUF,I GET WORD FROM TABLE JSB LABDO SEND TO DISC ISZ TBUF STEP TABLE ADDRESS LDA TBUF,I GET THE HEAD/UNIT WORD JSB LABDO SEND IT ISZ TBUF STEP TO THE # OF TRACKS WORD LDA TBUF,I AND JSB LABDO SEND IT ISZ TBUF STEP OVER THE SPARE WORD ISZ TBUF ISZ TBUF+1 STEP COUNT - DONE? JMP DSTB1 NO - GET NEXT ENTRY * STB PPREL RESET NEW CORE ADDRESS * * THE FOLLOWING REUSES THE TMT FOR BUILDING THE * GENERATOR HEADER RECORD, OVERLAYING $TB30. * HENCE, THE SYSTEM SUBCHANNEL DEFINITION IS FIRST * OBTAINED FROM IT, AND THAT INFO STORED IN THE FIRST * 6 WORDS (TO BE MOVED BY FSECT). * LDA SYSCH GET THE SYSTEM SUBCHANNEL MPY P4 POSITION TO ITS TB30 ENTRY ADA ATB30 STA TTEMP AND SAVE IT LDB A,I STB TB30 FIRST CYLINDER INA LDB A,I STB STEMP SAVE FOR LATER INA LDB A,I STB TB30+1 # TRACKS INA LDB A,I STB TB30+2 # SPARES LDA STEMP ALF AND M17 STA TB30+3 # SURFACES LDA STEMP ALF,ALF AND M17 STA TB30+4 STARTING HEAD LDA STEMP AND M17 STA TB30+5 UNIT # * JMP DSTBL,I RETURN SPC 3 $TB32 DEF *+1 ASC 3,$TB32 * HED 7905 RTGEN SUBROUTINE SEGMENT * * FSECT IS A ROUTINE TO SET LOAD SPECS IN THE LOAD SPEC. * TABLE IN THE DISC RESIDENT BOOT EXTENSION AND TO * FLUSH THE FINAL SECTOR FROM CORE AT THE END OF * GENERATION. * * CALLING SEQUENCE: * * LDA SPEC BUFFER ADDRESS I.E. ADDRESS OF THE NINE WORDS * JSB FSECT * RETURN REGS. MEANINGLESS * FSEC5 EQU * **ENTRY POINT FOR FSECT** FSECT NOP STA DSTBL SAVE THE ADDRESS FOR A BIT LDB ABOOT GET THE CLA,CCE BOOT FROM JSB DISKD THE DISC LDA DSTBL GET THE FROM ADDRESS LDB ASBUF AND THE TO ADDRESS JSB MOVW AND MOVE THE WORDS DEC -9 LDB ABOOT NOW WRITE CLA,CLE THE BOOT JSB DISKD BACK TO THE DISC CLE DLD OUBUF FLUSH THE FINAL BUFFER ELA,CLE FROM CORE JSB DISKD * * WRITE THE GENERATOR HEADER RECORD, STORED IN THE TMT BUFFER. * THE FIRST 6 WORDS MUST BE MOVED TO THEIR APPROPRIATE PLACE * FOLLOWING THE EQT DEF'S, AND THE SYSTEM CHANNEL INFO STORED * IN THESE FIRST 6 WORDS. * LDB ATB30 POSITION WITHIN HEADER RECORD LDA B ADB P6 ADB CEQT FOLLOWS THE EQT DEFS JSB MOVW MOVE THE 6 WORDS DEC -6 * LDA SYSCH STA TB30 THE SYSTEM SUBCHANNEL LDA DRT2 AND M77 STA TB30+1 " " EQT # LDA CEQT STA TB30+2 # EQT'S LDA PIOC STA TB30+3 PRIVILEGED INTERRUPT CHANNEL LDA TBCHN STA TB30+4 TBG CHANNEL LDA TB30+127 RETRIEVE FROM TEMP. STORAGE AND M77 STA TB30+5 TTY CHANNEL LDB ATB30 CMB,INB NEGATE IT SO DISKD WILL KNOW CLA,CLE JSB DISKD JMP FSECT,I SKP * * THE MOVW SUBROUTINE MOVES WORDS FROM ONE CORE LOCATION * TO ANOTHER * * CALLING SEQUENCE: * * LDA FROMyB@< ADDRESS * LDB TO ADDRESS * JSB MOVW * DEC -WORD COUNT * MOVW NOP STA TBUF LDA MOVW,I GET THE COUNT STA TBUF+1 SET IN COUNTER * MOVW2 LDA TBUF,I GET A WORD STA B,I SET IT INB ISZ TBUF STEP THE ADDRESSES ISZ TBUF+1 DONE? JMP MOVW2 NO DO THE NEXT ONE * ISZ MOVW STEP TO RETURN POINT JMP MOVW,I YES- RETURN M17 OCT 17 END EQU * * END BEG05 HB VB 92060-18038 1826 S 0622 &SWTCH RTE SWITCH PROGRAM             H0106 )ASMB,R,L,C,N HED SWTCH - TRANSFERS FILE CONTAINING RTE SYSTEM GENERATED ON-LINE. NAM SWTCH,3,10 92060-16038 REV.1826 780510 SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 2 **************************************** * * NAME: SWTCH * SOURCE: 92060-18038 * BINARY: 92060-16038 * WRITTEN BY: KFH * **************************************** SPC 2 * * TURN - ON SEQUENCE: * * RU,SWTCH,FLNAME:SC:LB,CHANNEL,SUBCHANNEL/UNIT,AUTO,FILES,TYPE6 * * WHERE: * * FLNAME:SC:LB IS THE ABSOLUTE FILE NAME OF THE SYSTEM * CHANNEL IS THE OCTAL TARGET CHANNEL, WITH A "B" APPENDED * SUBCHANNEL IS THE TARGET 7900 SUBCHANNEL * OR * UNIT IS THE TARGET 7905/7920 UNIT * AUTO IS Y/N, FOR AUTO BOOT-UP * FILES IS Y/N, FOR SAVING THE TARGET FILE SYSTEM * TYPE6 IS Y/N, FOR PURGING THE TYPE 6 FILES AT THE TARGET SPC 2 * * * THE ON-LINE RTE GENERATOR PRODUCES AN FMP FILE CONTAINING * A COMPLETE RTE-II OR RTE-III SYSTEM FOR A SPECIFIC CONFIGURATION. * SWTCH COPIES THE FILE ONTO THAT CHANNEL AND SUBCHANNEL(UNIT), OR * TO A USER-SPECIFIED 'TEMPORARY' CHANNEL AND SUBCHANNEL(UNIT). * AND BEFORE THE TRANSFER BEGINS, THE FILE IS CHECKED FOR VALIDITY, * THE OPERATOR IS NOTIFIED OF THE DESTINATION CONFIGURATION, * INCLUDING THE SUBCHANNEL DEFINITION. * * IF THE NEW RTE SYSTEM OVERLAYS THE CURRENT SYSTEM, A NEW * FMP SETUP (INITIALIZED) CODE WORD IS COMPUTED AND WRITTEN * INTO THE FMP CARTRIDGE DIRECTORY SO THAT ON BOOTUP, FMP * WILL REMAIN INTACT (INITIALIZED). SKP * ENTRY POINT>S * ENT SWTCH * ENT MAINR ENT DFTR,DNHD,DNSU,DNSP,DNTR,DSBCH ENT TUNIT,TCH,TSBCH ENT INITF,LNGTH ENT BUFAD,XOUT,DSTAD ENT CNVAS,CLEN,DSPLY,LINBL ENT BOOTF * * EXTERNAL ENTRY POINTS * EXT RMPAR,EXEC,$LIBR EXT OPEN,READF,LOCF,CLOSE EXT $LIBR,$LIBX * EXT DISK0,DISK5 EXT INP0,INP5 EXT INIT0,INIT5 EXT STDS0,STDS5 EXT CNUMD,GETST EXT FLGTR SPC 2 A EQU 0 B EQU 1 SUP SKP * HEADER RECORD FORMAT * * ------------------------------------ * ! SYSTEM SUBCHANNEL # ! * ------------------------------------ * ! SYSTEM EQT # ! * ------------------------------------ * ! NUMBER OF EQT'S ! * ------------------------------------ * ! PRIV. INT. CHANNEL ! * ------------------------------------ * ! TBG CHANNEL ! * ------------------------------------ * ! TTY CHANNEL ! * ------------------------------------ * ! CHANNEL # ! EQT TYPE ! FOR EQT #1 * ------------------------------------ * ! CHANNEL # ! EQT TYPE ! FOR EQT #2 * ------------------------------------ * . . * . . * . . * ------------------------------------ * ! CHANNEL # ! EQT TYPE ! FOR EQT #N * ------------------------------------ - * ! FIRST CYLINDER # ! SYSTEM * ------------------------------------ * ! # TRACKS ! SUBCHANNEL * ------------------------------------ * !  # SPARES ! DEFINITION * ------------------------------------ * ! # SURFACES ! FOR * ------------------------------------ * ! STARTING HEAD # ! A * ------------------------------------ * ! UNIT # ! 7905/7920 * ------------------------------------ - * * OR OR * * ------------------------------------ - * ! FIRST TRACK ! FOR A * ------------------------------------ * ! # TRACKS ! 7900 * ------------------------------------ - SKP SPC 4 *------------------------------------------------------------------------ * * THE FOLLOWING 6144 WORDS WILL BE OVERLAID * ONCE THE TRANSFER PROCESS BEGINS. BUFR * WILL CONTAIN ONE TRACK'S WORTH OF INFO. * *------------------------------------------------------------------------ SPC 4 BUFR BSS 128 BUFFER FOR 1 FULL TRACK (6144 WORDS) * * MES1 DEF *+1 ASC 22, ****** W A R N I N G ****** MES2 DEF *+1 ASC 23,ALL ACTIVITY MUST BE TERMINATED BEFORE SYSTEM ASC 9,TRANSFER PROCESS. SPC 2 BSS 256+BUFR-* NEED TO READ 2 RECORDS AT VERF1 SPC 2 MES3 DEF *+1 ASC 14,FILE NAME OF NEW RTE SYSTEM? MES4 DEF *+1 ASC 9,ILLEGAL FILE NAME MES5 DEF *+1 ASC 15,NEW SYSTEM I/O CONFIGURATION: MES6 DEF *+1 ASC 16,CHANNEL XX PRIVILEGED INTERRUPT MES6A DEF MES6+5 MES7 DEF *+1 ASC 7,CHANNEL XX TBG MES7A DEF MES7+5 MES8 DEF *+1 ASC 9,CHANNEL XX TYPE=XX MES8A DEF MES8+5 MES8B DEF MES8+9 MES9 DEF *+1 ASC 22,NEW SYSTEM (LU2) CHANNEL= XX SUBCHANNEL= XX MES9A DEF MES9+14 MES9B DEF MES9+22 MES10 DEF *+1 ASC 20,7900 LOGICAL SUBCHANNEL X FIzRST TRACK# MS10A ASC 9,XXXX #TRACKS XXXX MS10C DEF MS10A MS10D DEF MS10A+7 MES11 DEF *+1 ASC 23,7905/ HEAD# X #TRACKS XXXX #SURFACES X MS11C DEF *+1 ASC 23,7920 UNIT# X FIRST CYL# XXXX #SPARES X MS11A DEF MES11+15 MS11B DEF MS11C+15 MES12 DEF *+1 ASC 23,TARGET CHANNEL FOR NEW SYSTEM? (XX OR " "CR) MES13 DEF *+1 ASC 20,TARGET SUBCHANNEL(LOGICAL)/UNIT FOR NEW ASC 11,SYSTEM? (X OR " "CR) SPC 2 BSS 512+BUFR-* NEED TO READ IN 512 WORDS AT F$T0 SPC 2 MES14 DEF *+1 ASC 20,NEW SYSTEM WILL OVERWRITE FILE XXXXXX. MES16 DEF *+1 ASC 23,NOW IS THE TIME TO INSERT CORRECT CARTRIDGE IN MES17 DEF *+1 ASC 23,TARGET SUBCHANNEL/UNIT. (" "CR TO CONTINUE) MES18 DEF *+1 ASC 16,SAVE FILES AT TARGET? (Y OR N) MES19 DEF *+1 ASC 19,NEW SYSTEM WILL DESTROY SOME FMP FILES MES20 DEF *+1 ASC 12,OK TO PROCEED? (Y OR N) MES22 DEF *+1 ASC 15,PURGE TYPE 6 FILES? (Y OR N) MES23 DEF *+1 ASC 20,INFORMATION STORED ON SUBCHANNEL/UNIT XX ASC 12, OF TARGET CHANNEL XX MS23B DEF *+1 ASC 9,WILL BE DESTROYED MS23A DEF MES23+31 MES24 DEF *+1 ASC 12,AUTO BOOT-UP? (Y OR N) MES25 DEF *+1 ASC 25,PRESENT CONFIGURATION DOESN'T PERMIT AUTO BOOT-UP. MES26 DEF *+1 ASC 22,SYSTEM WILL HALT AFTER TRANSFER COMPLETION. MES32 DEF *+1 ASC 17,READY TO TRANSFER. OK TO PROCEED? * SWAP0 DEF *+1 ASC 3,DSEG0 7900 DISK DRIVER SEGMENT SWAP5 DEF *+1 ASC 3,DSEG5 7905/7920 DISK DRIVER SEGMENT SKP * CONSTANTS * B17 OCT 17 B177 OCT 177 B777 OCT 777 B1774 OCT 177400 B2060 OCT 20060 * N6 DEC -6 N7 DEC -7 N31 DEC -31 N64 DEC -64 N89 DEC -89 N512 DEC -512 * P12 DEC 12 P14 DEC 14 P17 DEC 17 P28 DEC 28 P29 DEC 29 P64 DEC 64 P98 DEC 98 P512 DEC 512 * SKP * * * F$TB SEARCHES THE RESIDENT LIBRARY ENTRY POINT * LIST FOR THE APPR|^OPRIATE TRACK MAP TABLE, * $TB31 OR $TB32 (DEPENDENT UPON THE SOURCE * DISK TYPE), AND RETURNS IT IN BUFR. * * CALLING SEQUENCE: JSB F$TB * DEF .1 OR .2 * F$TB NOP LDA #LEP GET # OF LIBRARY ENTRY POINTS MPY P4 4 WORDS PER ENTRY STA LEPL SAVE SIZE OF L.E.P. LIST * LDA ALEP GET DISK ADDRESS OF LEP LIST LDB A ALF,ALF RAL AND B777 STA LTRK SAVE THE TRACK LDA B AND B177 F$T3 STA LSEC AND SECTOR ADA N89 DETERMINE IF THE SECTOR RESULTS IN SSA LESS THAN 512 WORDS LEFT ON TRACK JMP F$T1 <89 INA SEE HOW MANY SECTORS LESS MPY P64 CMA,INA AND SUBTRACT FROM ADA P512 512 MAX STA LLEN LENGTH OF READ JMP F$T0 F$T1 LDA LEPL JSB GTLEN GET READ LENGTH F$T0 JSB READD READ IT * CLB LDA LLEN DIV P4 GET THE # OF ENTRIES READ IN CMA,INA NEGATE STA LCNT LOOP COUNTER LDB BUFAD F$T2 STB BPTR * LDA $T CPA B,I A "$T"? INB,RSS JMP NOTIT NO LDA B3 CPA B,I A "B3"? INB,RSS JMP NOTIT NO LDA F$TB,I LDA A,I GET "1" OR "2" XOR B,I AND B1774 SZA,RSS A MATCH? JMP F$T7 YES!! * NOTIT ISZ LCNT DONE WITH CURRENT BUFFER? RSS JMP F$T4 YES LDB BPTR ADB P4 JMP F$T2 * F$T4 LDA LLEN SEE IF ALL WERE SEARCHED CMA ADA LEPL SSA IF WE'VE GONE THRU THE ENTIRE LEP JMP ABF$ THEN ITS NOT THERE, SO ABORT SWTCH INA STA LEPL NEW # LEFT * LDB LSEC DETERMINE IF TRACK CROSSING ADB N89 IF >= 88 THEN THERE WILL BE INB SSB JMP F$T5 NOPE * ISZ LTRK YES, INCREMENT TO NEXT TRACK# CLB STB LSEC SET NEXT SECTOR TO 0 JMP F$T1 SET LENGTH OF READ * F$T5 LDA LSEC INCREMENT TO NEXT STARTING ADA P8 SECTOR JMP F$T3 SET LENGTH OF READ * F$T7 STB LCNT TEMPORARY SAVE LDB P17 DETERMINE IF WE'RE TO READ LDA SEQT IN A $TB31 (17 WORDS), OR SLA,RSS A $TB32 (98 WORDS) LDB P98 STB LLEN * LDB LCNT RESTORE ENTRY POINTER LDA B,I DETERMINE IF ENTRY IS AT A INB AND P1 MEMORY ADDRESS, OR A DISK SZA BY CHECKING BIT 0 OF WORD 3 JMP F$T9 DISK ADDR * LDA B,I GET THE MEMORY ADDRESS LDB SEQT DETERMINE IF USER-DEFINED TMT SLB,RSS DIFFERENT CHECKS FOR 7900-7905/7920 JMP F$T10 7905/7920 LDB A,I GET WORD 1 SSB IF NEGATIVE, THERE'S AN EXTRA WORD INA * F$T11 LDB LLEN # WORDS TO GET CMB,INB STB LCNT LOOP COUNTER LDB BUFAD STB BPTR BUFFER POINTER RSS F$T8 ISZ BPTR NEXT LOCATION LDB A,I STB BPTR,I STORE WORD INA INCRMENT MEMORY ADDRESS ISZ LCNT DONE? JMP F$T8 NO LDA BUFAD STA BPTR ISZ F$TB JMP F$TB,I * F$T10 LDB A,I CHECK WORD 1 SSB,RSS IF POSITIVE,THERE'S AN EXTRA WORD INA JMP F$T11 * F$T9 LDA B,I TRANSLATE THE DISK ALF,ALF ADDRESS TO RAL AND B377 STA LTRK TRACK AND LDA B,I AND B177 STA LSEC SECTOR * JSB READD READ IT LDA BUFAD INA SKIP EXTRA WORD STA BPTR ISZ F$TB JMP F$TB,I * ABF$ LDA P28 LDB MES30 JSB DSPLY JMP XOUT TERMINATE SWTCH SPC 3 #LEP EQU 1762B # OF LIBRARY ENTRY POINTS IN LIST ALEP EQU 1761B ADDR " " " LIST LEg!PL NOP LENGTH " " " " LCNT NOP COUNTER $T ASC 1,$T B3 ASC 1,B3 .1 ASC 1,1 .2 ASC 1,2 MES30 DEF *+1 ASC 28,SOURCE SUBCHANNEL NOT FOUND ON A SYSTEM TRACK MAP TABLE SKP * * GTLEN COMPUTES LLEN FOR READING THE * LIBRARY ENTRY POINTS LIST INTO * BUFR * * CALLING SEQUENCE: (A)=REMAINING SIZE OF L.E.P. * JSB GTLEN * GTLEN NOP LDB P512 THE NORMAL BUFFER SIZE CMA,INA IF MORE THAN THE REMAINING ADA P512 LEP SIZE, THEN USE THE SIZE SSA,RSS IN (A) LDB LEPL STB LLEN JMP GTLEN,I SPC 5 * * READD READS LLEN WORDS AT TRACK LTRK, AND * SECTOR LSEC * READD NOP JSB EXEC DEF *+7 DEF P1 DEF P2 DEF BUFR DEF LLEN DEF LTRK DEF LSEC * JMP READD,I * * LTRK NOP LSEC NOP SKP * * VERIFIES THE EXISTENCE OF A SYSTEM SUBCHANNEL MATCH * AT THE TARGET CHANNEL AND SUBCHANNEL. THE FOLLOWING * CHECKS ARE MADE: * * VERIFY THAT A CARTRIDGE DIRECTORY EXISTS ON THE * LAST SYSTEM TRACK (AS DEFINED BY THE NEW * SYSTEM) * VERIFY THAT A FILE DIRECTORY SPECIFICATION ENTRY * EXISTS ON THIS TRACK * VERIFY THAT A TRACK 0 SECTOR 0 BOOTSTRAP EXISTS * AT THE FIRST PHYSICAL TRACK/CYLINDER OF * DESTINATION SYSTEM * * * RETURN: (P+1) CAN'T SAVE THE FILE STRUCTURE * (P+2) CAN SAVE IT * VFYSY NOP CLA STA INITF CLEAR INIT WORD FOR DISKD * LDA N128 STA LNGTH READ 128 WORDS CCE HOPEFULLY THEY WILL CONTAIN LDB BUFAD THE CARTRIDGE DIRECTORY AT STB BPTR TARGET SUBCHANNEL LDA DNTR DESTINATION SYSTEM LAST(LOGICAL) ADA N1 TRACK, LESS 1 ALF,ALF RAR JSB DISKD * * * VERIFY THE EXISTENCE OF A CARTRIDGE DIRECTORY  * LDA N31 MAX # CARTRIDGE ENTRIES STA TEMP1 CHCD0 LDA BPTR,I GET WORD 0 OF ENTRY SSA JMP NOTFS LU WORD < 0 LDB N64 ADB A SSB,RSS JMP NOTFS LU > 77(8) * CPA P0 END OF LU'S ? JMP CHCD3 YES CPA P2 LU 2 (SYSTEM) ? RSS YES JMP CHCD1 CHECK WORDS 1-3 IN ENTRY * LDB BPTR GET WORD #1 OF THE (POSSIBLY) INB SYSTEM LU 2 ENTRY LDA B,I SSA JMP NOTFS LAST FMP TRACK WORD < 0 STA D.LT SAVE FOR LATER CHECKS * CHCD1 LDA N3 STA TEMP2 * CHCD2 ISZ BPTR CHECK WORDS 1,2,&3 LDA BPTR,I OF ENTRY FOR VALUES SSA >= 0 JMP NOTFS INVALID ISZ TEMP2 JMP CHCD2 CHECK NEXT WORD ISZ BPTR NEXT ENTRY WORD 0 ISZ TEMP1 LAST ENTRY (31)? JMP CHCD0 NO,CONTINUE * CHCD3 LDA D.LT (WAS INITIALLY -1) SSA JMP NOTFS NEVER SET BY A LU 2 LDA BF124 SZA JMP NOTFS WORD 124 OF CD MUST = 0 * * * LOOKED LIKE A CARTRIDGE DIRECTORY. NOW TRY FOR A * FILE DIRECTORY IN THE NEXT BLOCK. * LDA DNTR DETERMINE DISK ADDRESS OF NEXT ADA N1 BLOCK CONTAINING THE ALF,ALF FILE SPEC ENTRY RAR IOR P14 READ 128 WORDS, HOPEFULLY THE LDB BUFAD SPEC ENTRY STB BPTR CCE JSB DISKD * LDA BPTR,I TESTS FOR A VALID FILE DIRECTORY ENTRY: SSA,RSS JMP NOTFS WORD 0 MUST BE < 0 * LDA N7 WORDS 1-7,9-15 IN SPEC MUST BE >= 0 STA TEMP2 CHFD1 ISZ BPTR LDA BPTR,I SSA JMP NOTFS < 0, THEREFORE INVALID ISZ TEMP2 JMP CHFD1 * ISZ BPTR WORD 8 MUST BE < 0 LDA BPTR,I SSA,RSS JMP NOTFS LDA N6 NOW CHECK WORDS 9-15 STA TEMP2 CHFD2 ISZ BPTR LDA BPTR&&,I SSA JMP NOTFS ISZ TEMP2 JMP CHFD2 * LDA BF6 WORD 6 (#SECTORS/TRACK) MUST BE LDB BF5 >= WORD 5 (NEXT AVAILABLE SECTOR) CMB,INB ADA B SSA JMP NOTFS INVALID * LDA BF7 LOWEST DIRECTORY TRACK(LOGICAL) LDB BF8 MINUS THE NEGATIVE # DIRECTORY STB D.# TRACKS, CMB MINUS 1 ADA B GIVES LAST FMP TRACK CPA D.LT MUST = LAST FMP TRACK INDICATED RSS IN CD FOR LU 2 JMP NOTFS INVALID * LDB DNTR DOES THE LOGICAL DIRECTORY TRACK # ADB N1 AT TARGET = LOGICAL DIRECTORY TRACK # CPA B FOR DESTINATION (THE LAST LOGICAL TRACK FOR RSS SYSTEM LU) ? JMP NOTFS NO LDA BF4 SAVE THE FIRST FMP TRACK FOR STA FFMP FUTURE CHECKS * * * VERIFY THAT A TRACK 0 SECTOR 0 BOOTSTRAP EXISTS AT THE * DESTINATION SYSTEM'S PHYSICAL LOCATION OF LOGICAL TRACK 0 * SECTOR 0 * LDB BUFAD READ(HOPEFULLY) THE TRACK 0,SECTOR 0 STB BPTR BOOTSTRAP CCE CLA JSB DISKD * JSB VT0S0 VERIFY ITS EXISTENCE JMP NOTFS NO GOOD * LDA BF99 TBASE (WORD 100 OF BOOTSTRAP) IS THE CPA DFTR PHYSICAL LOCATION (TRACK OR CYLINDER) OF RSS TRACK 0 AT THE TARGET - MUST BE EQUAL JMP NOTFS TO THAT OF DESTINATION TRACK 0 * LDA DEQT FURTHER CHECKS FOR A 7905/7920 SYSTEM SLA REPLACEMENT JMP VOUT * LDA BF97 GET NUMBER OF SURFACES CPA DNSU SAME AS DESTINATION? RSS JMP NOTFS NO LDA BF98 GET STARTING HEAD # CPA DNHD SAME AS DESTINATION? RSS JMP NOTFS NO * VOUT ISZ VFYSY LOOKS VALID JMP VFYSY,I SPC 2 * * ONE OF THE ABOVE TESTS FAILED, THEREFORE NOT ALLOWING THE * TARaGET FILE STRUCTURE TO BE SAVED * NOTFS LDA TSBCH LDB DEQT SLB,RSS LDA TUNIT ADA B2060 STA MES23+20 LDA P1 SET FO CNVAS STA CLEN LDA TCH LDB MS23A JSB CNVAS LDA P32 LDB MES23 "INFORMATION STORED ON SUBCHANNEL UNIT XX OF JSB DSPLY TARGET CHANNEL YY WILL BE DESTROYED" LDA P9 LDB MS23B JSB DSPLY * JSB OK? CHECK ANSWER * CLA STA SAVE DON'T SAVE FILES STA TYP6 " " PURGE TYPE 6'S JMP VFYSY,I * BF4 EQU BUFR+4 BF5 EQU BUFR+5 BF6 EQU BUFR+6 BF7 EQU BUFR+7 BF8 EQU BUFR+8 BF97 EQU BUFR+97 BF98 EQU BUFR+98 BF99 EQU BUFR+99 BF124 EQU BUFR+124 SKP * * VERIFIES THE EXISTENCE OF A TRACK 0, SECTOR 0 BOOTSTRAP * * * RETURN: (P+1) NOT A BOOTSTRAP * (P+2) YES, ONE EXISTS * VT0S0 NOP LDB BPTR CHECK MATCH ON WORDS 3,4,5(ALL SAME),6,7 ADB P2 LDA B,I 12,13,14,15,16 CPA WD345 WORD 3 INB,RSS JMP VT0S0,I NO LDA B,I CPA WD345 WORD 4 INB,RSS JMP VT0S0,I NO LDA B,I CPA WD345 WORD 5 INB,RSS JMP VT0S0,I NO LDA B,I CPA WD6 WORD 6 INB,RSS JMP VT0S0,I NO LDA B,I CPA WD7 WORD 7 RSS JMP VT0S0,I NO ADB P5 LDA B,I CPA WD12 WORD 12 INB,RSS JMP VT0S0,I NO LDA B,I CPA WD13 WORD 13 INB,RSS JMP VT0S0,I NO LDA B,I CPA WD14 WORD 14 INB,RSS JMP VT0S0,I NO LDA B,I CPA WD15 WORD 15 INB,RSS JMP VT0S0,I NO LDA B,I CPA WD16 WORD 16 RSS JMP VT0S0,I NO ISZ VT0S0 JMP VT0S0,I OK!!!!! SPC 2 WD345 OCT 017506 BOOTSTRAP WORDS 3,4,& 5 WD6 OCT 124003 " WORD 6 WDF7 OCT 002011 " WORD 7 WD12 OCT 003304 " WORD 12 WD13 OCT 040001 " WORD 13 WD14 OCT 005225 " WORD 14 WD15 OCT 106702 " WORD 15 WD16 OCT 106602 " WORD 16 SKP * * STDSK CONTROLS THE CALL TO CONFIGURE THE * DISK DRIVER (EITHER DISK0 FOR 7900 OR DISK5 * FOR 7905/7920), VIA A CALL TO STDS0 OR STDS5 * STDSK NOP LDA DEQT SLA JMP STDS1 JSB STDS5 CONFIGURE THE 7905/7920 DRIVER JMP STDSK,I * STDS1 JSB STDS0 CONFIGURE THE 7900 DRIVER JMP STDSK,I SKP * OK? QUERIES THE USER WITH: * "OK TO PROCEED? (Y OR N)" * AND TRANSFERS TO XOUT ON A "N" RESPONSE, * DOING A SIMPLE RETURN ON A "Y" RESPONSE. * OK? NOP LDA P12 LDB MES20 JSB DSPLY JSB YE?NO DECIPHER ANSWER JMP OK?+1 INVALID REPLY JMP XOUT NO,TERMINATE SWTCH JMP OK?,I SPC 4 * YE?NO READS THE OPERATOR ANSWER ( Y OR N ) * RETURNS TO (P+1) IF INVALID ANSWER * (P+2) IF NO * (P+3) IF YES * YE?NO NOP JSB EXEC RETRIEVE ANSWER DEF *+5 DEF P1 DEF OPLU DEF BUFR DEF N2 SZB,RSS JMP YE?NO+1 TRY AGAIN FOR A RESPONSE * CLE CHECK HIGH HALF FIRST LDA BUFR YENO ALF,ALF AND B377 CPA "N" JMP NOUT CPA "Y" JMP YOUT * SEZ CHECK THE LOW HALF? JMP YE?NO,I ALREADY DID - NEITHER MATCHES LDA BUFR SWITCH EM ALF,ALF CCE JMP YENO CHECK THE LOW HALF * YOUT ISZ YE?NO NOUT ISZ YE?NO JMP YE?NO,I * "N" OCT 116 "Y" OCT 131 SKP * * CHECKS FOR A SPACE (PSEUDO CARRIAGE RETURN) FROM * THE OPERATOR. (B) IS THE LENGTH OF INPUT IN CHARACTERS * RETURN: (P+1) NOT A SPACE * (P+2) A SPACE (SO MAY USE DEFAULT VALUES) * HFBBHDFLT NOP CPB P1 ONE CHARACTER RETURNED? RSS JMP DFLT,I NO, SO DON'T BOTHER CHECKING LDA BUFR AND B1774 CPA LBLNK ISZ DFLT GOT ONE JMP DFLT,I * LBLNK OCT 20000 SKP * * PARMP, PARAMETER PARSING ROUTINE (CONVERTED FROM NAMR,DLB) * PRODUCES A PARAMETER BUFFER 11 WORDS LONG * * THE ELEVEN WORDS ARE DESCRIBED AS FOLLOWS: SPC 1 * WORD 1 = 0 IF TYPE = 0 (SEE BELOW) * WORD 1 = 16 BIT TWO'S COMPLEMENT NUMBER IF TYPE = 1 * WORD 1 = CHARS 1 & 2 IF TYPE = 3 * WORD 2 = 0 IF TYPE = 0 OR 1, CHARS 2 & 3 OR TRAILING SPACE(S) IF 3. * WORD 3 = SAME AS WORD 2. (TYPE 3 PARAM. IS LEFT JUSTIFIED) * WORD 4 = PARAMETER TYPE OF ALL 7 PARAMETERS IN 2 BIT PAIRS. * 0 = NULL PARAMETER * 1 = INTEGER NUMERIC PARAMETER * 2 = NOT IMPLEMENTED YET. (FMGR?) * 3 = LEFT JUSTIFIED 6 ASCII CHARACTER PARAMETER. * BITS FOR ,FNAME : P1 : P2 : P3 : P4 : P5 : P6 , : P7 * 0,1 2,3 4,5 6,7 8,9 10,11 12,13 14,15 * WORD 5 = 1ST SUB-PARAMETER AND HAS CHARACTERISTICS OF WORD 1. * WORD 6 = 2ND SUB-PARAMETER DELIMETED BY COLONS AS IN WORD 5. * WORD 7 = 3RD SUB-PARAM. AS 5 & 6. (MAY BE 0, NUMBER OR 2 CHARS) * WORD 8 = 4TH " * WORD 9 = 5TH " * WORD 10 = 6TH " * WORD 11 = 7TH " SPC 2 * * WHERE: * DNAME = ELEVEN WORD DESTINATION PARAMETER BUFFER ADDRESS * INBUF = STARTING ADDRESS OF INPUT BUFFER CONTAINNING "NAMR". * PARML = CHARACTER LENGTH OF "INBUF". (MUST BE POSITIVE) * ISTRC = THE STARTING CHARACTER NUMBER IN "INBUF". THIS * PARAMETER WILL BE UPDATED FOR POSSIBLE NEXT CALL * TO "PARMP" AS THE START CHARACTER IN "INBUF". * CAUTION!!!! * ISTRC IS MODIFIED BY THIS ROUTINE, THEREFORE IT MUST * BE PASSED AS A VARIABLE (NOT A CONSTANT) FROM CALLER.(FTN) * SKP * CHECK CALLERS PARAMETERS FOR CORRECTN7FESS SPC 1 INBUF NOP INPUT BUFFER ADDRESS PARML NOP TRANSMISSION LOG IN CHARACTERS ISTRC NOP CURRENT STARTING CHARACTER IN INBUF * PARMP NOP CCA SET TO NO COMMAS STA FRSTC CLA,INA STA ISTRC SET FIRST CHAR LDB BUFAD STB INBUF INPUT BUFFER ADDRESS LDB DNAME STB BPTR NOW CLEAR OUT DEST BUFFER LDA N11 GET DEST BUFFER LENGTH STA SUBCT SAVE IN TEMP CLA ZERO BUFFER STA B,I INB ISZ SUBCT JMP *-3 LDA INBUF FORM STARTING CHARACTER CLE,ELA ADDRESS OF INPUT STA INBUF SAVE AS CHARACTER ADDRESS. LDB PARML GET CHARACTER LENGTH ADA B GET ADDRESS OF LAST+1 CHARACTER STA EOFBF AND SAVE FOR LATER USE LDA ISTRC GET START CHAR IN "INBUF" CMB,SSB,INB,SZB CHECK FOR 0 & NEG. CMA,INA,RSS >0, MAKE ISTRC NEG. + TEST FOR 0 CCE DIDN'T PASS, SET FLAG CMA SUBTRACT 1 FROM ISTRC ADB A A-REG = ISTRC - PARML -1 CCA,SEZ TEST E FOR ERROR JMP PARMP,I RETURN A= -1 FOR ERROR LDA BPTR GET DESTINATION BUFFER LDB A ADB P3 SET ADDRESS OF TYPE WORD STB WORD4 STB BPTR AND BUFFER POINTER LDB P3 GET LENGTH OF BUFFER (WORDS) JSB SCAN GET 1ST PARAMETER RAR,RAR POSITION "TYPE BITS" STA WORD4,I AND INITIALIZE LDB FRSTC WAS A COMMA ENCOUNTERED SZB JMP MORE0 NO RAR,RAR YES, SKIP APPROPRIATE RAR,RAR POSITIONS IN WORD4,I STA WORD4,I ISZ BPTR AND UPDATE DESTINATION ISZ BPTR POINTER JMP MORE1 MORE0 LDB N2 SET TO GET THE NEXT 2 PARAMETERS AFTER: STB SUBCT ISZ BPTR LDA BPTR CLB,INB JSB SCAN IOR WORD4,I SET BITS FOR SECURITY CODE (FIRST TIdSME THRU), RAR,RAR OR LABEL PARAMETER(SECOND TIME THRU) STA WORD4,I ISZ SUBCT RSS JMP MORE1 LDB FRSTC GOT A COMMA AFTER ONLY ONE COLON? SZB JMP MORE0+2 NO, A SECOND COLON ISZ BPTR UPDATE DESTINATION POINTER RAR,RAR AND TYPE BITS FOR NULL PARAMETER STA WORD4,I MORE1 LDB N5 NOW SCAN FOR NEXT 5 SUB-PARAMS STB SUBCT MORE2 ISZ BPTR LDA BPTR GET DESTINATION BUFFER ADDRESS CLB,INB AND THE LENGTH JSB SCAN GET NEXT SUB PARAM IOR WORD4,I MERGE IN WITH PREV. RAR,RAR POSITION "PARAM TYPE BITS" STA WORD4,I AND PUT BACK ISZ SUBCT DONE WITH ALL SEVEN? JMP MORE2 NO, CONTINUE JMP PARMP,I SKP * SCAN ONE PARAMETER OR SUB-PARAM. FOR SETTING OF VARIOUS POINTERS * * * SOB , - 1 2 3 4 B , EOB * ^ ^ ^ ^ ^ ^ ^ ^ * INBFF ISTAR FSTCA FNMCA LNBCA LSTCA EOFBF INBFF+PARML SPC 1 * WHERE: * INBFF = START OF BUFFER (CHARACTER ADDRESS) * ISTAR = RELETIVE STARTING CHARACTER NUMBER IN "INBFF". * FSTCA = FIRST NON SPACE CHARACTER BEFORE DELIMETER. * FNMCA = FIRST NON "+" OR "-" AFTER "FSTCA". * LNBCA = LAST NON SPACE OR "B" CHARACTER BEFORE DELIMETER+1. * EOFBF = ENTERS AT "EOB" AND IS MOVED BACK TO 1ST AFTER "," DELIM. * INBFF+PARML = END OF BUFFER + 1 CHARACTER ADDRESS. SPC 1 EOFBF EQU PARML ADDRS. OF LAST CHAR+1,IN "INBFF" INBFF EQU INBUF ADDRS. OF "INPUT BUFFER TO SCAN" ISTAR EQU ISTRC ADDRS. OF START CHAR IN "INBFF" SPC 1 SCAN NOP A=DEST BUFFER ADDRS, B=LENGTH(WORDS) STA DESTA SAVE DESTINATION ADDRESS STB DESTL SAVE DEST. BUFFER LENGTH (WORDS) *- ADB A FORM LAST+1 ADDRESS *- STB FSTCA SAVE TEMP *- CLB ZERO OUT THE DESTINATION BUFFER *-ZMORE STB A,I *- INA *- CPA pFSTCA DONE? *- CCB,RSS YES, CONTINUE *- JMP ZMORE NO, ZERO SOME MORE SPC 1 * SCAN UNTIL NON ASCII SPACE & SET "FSTCA" SPC 1 CCB GET MINUS ONE IN B-REG. ADB INBFF ADDRESS OF THE START ADB ISTAR CHARACTER AMORE STB FSTCA SAVE THE 1ST CHAR ADDRESS STB LSTCA AND LAST CHAR ADDRESS STB LNBCA SET LAST NON "B" CHAR. ADDRS. STB FNMCA SET 1ST NON "-" OR "+" CHAR ADDRS. CLA EXIT, A-REG = PARAMETER TYPE CPB EOFBF CHECK IF END OF BUFFER JMP SCAN,I NULL PARAMETER RETURN JSB GNC GET NEXT CHARACTER ISZ ISTAR ADVANCE CHARACTER POINTER CPA O40 IS IT EQUAL TO ASCII SPACE JMP AMORE YES, IGNORE IT STA FSTCR SET THE FIRST CHARACTER CPA PLUS CHECK IF 1ST CHAR RSS IS A PLUS OR MINUS CPA MINUS IF IT IS, BUMP ISZ FNMCA THE START CHAR FOR NUMB. CONV. SPC 1 * SCAN FOR DELIMETERS ":" & "," & "B" & END OF BUFFER. SKP SMORE CPA COLON COLON DELIMETER JMP CONVT NOW, GO CONVERT POSSIBLE # CPA COMMA CHECK IF COMMA JMP INCOM CHECK FOR FIRST COMMA CPA "B" CHECK THE TRAILING CHARACTER CCE,RSS FOR A "B". IF IT IS, STB LNBCA DON'T SET THE NON B CHAR ADDRS. LDA D10 SET THE BASE = 10 SEZ CHANGE TO B= 8, IF LAST CHAR LDA O10 IS EQUAL TO "B" STA BASE1 SET BASE OF NUMBER SYSTEM ADA O60 AND CALCULATE UPPER CMA,INA LIMIT CHECK WORD. STA BASE2 AND FOR LATER USE STB LSTCA AND IT'S ADDRESS+1 SIGNR CPB EOFBF REACHED END OF INBFF? JMP CONVT YES, SKIP NEXT CHAR JSB GNC GET NEXT CHARACTER ISZ ISTAR ADVANCE THE CHARACTER POINTER CPA O40 IGNORE TRAILING SPACES JMP SIGNR BY NOT ENCLUDING IN SCAN JMP SMORE GO CHECKލ IT SPC 2 INCOM ISZ FRSTC FIRST COMMA? NOP NO SPC 2 * CHECK IF ANY POSSIBLE ASCII NUMBERS TO CONVERT. SPC 1 CONVT CLA NOW TRY NUMBER CONVERSION LDB FSTCA GET 1ST CHAR ADDRESS CPB LSTCA IS IT = LAST CHAR ADDRESS? JMP SCAN,I YES, RETURN, NULL PARAMETER LDB FNMCA CHECK IF ANY DATA TO BE CPB LNBCA CONVERTED TO A JMP NOTNU NUMBER. SPC 1 * NOW CHECK IF NUMBER OR ASCII STRING & CONVERT TO NUMBER SPC 1 MMORE MPY BASE1 TRY CONVERSION STA DESTA,I ACCUMULATE NUMBER LDB FNMCA GET CURRENT CHAR ADDRESS SKIP1 JSB GNC GET THE NEXT CHARACTER STB FNMCA PUT BACK + 1 CPA O40 IGNORE ASCII SPACES JMP SKIP1 ADA BASE2 NO, CHECK IF ASCII NUMBER SEZ,CLE,RSS NUMBER MUST BE "0" TO "BASE" ADA BASE1 SEZ,CLE,RSS JMP NOTNU NOT NUMBER, MOVE BUFFER ADA DESTA,I ACCUMULATE THE NUMBER * SOC * CHECK OF OVERFLOWED? * CCA * YES, FORCE RESULT NEG. CPB LNBCA DONE? RSS YES, CONTINUE JMP MMORE SPC 1 * NOW CHECK SIGN OF NUMBER SPC 1 * SOC * TEST IF OVERFLOW? * RAL,CLE,ERA * CHANGE -1 TO 77777B IF OVERFLOW LDB FSTCR CHECK SIGN OF NUMBER CPB MINUS WAS IT NEG? * CMA,SEZ * YES. (*CHANGE TO CMA,INA) CMA,INA YES, MAKE NEG. * RSS * * INA * STA DESTA,I SAVE BACK IN DEST. BUFFER CLA,INA,RSS EXIT A=1 FOR PARAMETER TYPE EXIT3 LDA P3 EXIT A=3 FOR PARAMETER TYPE JMP SCAN,I RETURN DONE SPC 1 * NOT NUMBER, MOVE PARAM INTO DEST. BUFFER SPC 1 NOTNU LDB DESTA GET DEST BUFFER ADDRS CLE,ELB FORM CHARACTER ADDRESS STB FNMCA SAVE FOR NEAR USE ADB DESTL FORM LAST CHAR+1 ADDRESS ADB DESTL TIMES 2 FROM WORDS w. STB LNBCA SAVE FOR NEAR USE MSTOR LDB FSTCA GET FIRST CHAR. ADDRESS LDA O40 GET SPACE JUST IN CASE CPB LSTCA CHECK IF LAST CHARACTER ADDRESS JMP SKIP2 YES, SKIP GET CHAR FROM "INBFF" JSB GNC GET NEXT CHARACTER STB FSTCA SAVE NEXT CHAR ADDRESS SKIP2 LDB FNMCA GET DEST CHAR ADDRESS CPB LNBCA CHECK IF END OF DEST. BUFFER JMP EXIT3 YES, RETURN DONE ISZ FNMCA BUMP TO NEXT CHAR CLE,ERB CHANGE TO WORD ADDRESS SEZ,RSS POSITION ALF,SLA,ALF PACK XOR B,I AND XOR O40 STORE STA B,I BACK JMP MSTOR GO TRY NEXT CHAR SPC 1 FSTCR NOP FIRST NON SPACE CHARACTER IN BUFFER FSTCA NOP ADDRESS OF FSTCR LSTCA NOP ADDRESS OF LSTCR BASE1 NOP BASE OF NUMBER BASE2 NOP HI BASE TEST OF NUMBER FNMCA NOP CURRENT CHAR SCAN FOR CONVT LNBCA NOP DESTA NOP DESTINATION BUFFER ADDRESS DESTL NOP DEST. BUFFER LENGTH IN CHARACTERS SPC 1 GNC NOP GET NEXT CHARACTER CLE,ERB FORM WORD ADDRESS DESTROY E-REG LDA B,I GET WORD SEZ,RSS HI -OR- LO CHARACTER ALF,ALF AND O177 MASK DOWN TO 7 BITS ELB RESTORE B-REG INB BUMP THE B-REGISTER JMP GNC,I RETURN A= CHARACTER SPC 1 O177 OCT 177 "B" OCT 102 MINUS OCT 55 PLUS OCT 53 O60 OCT 60 O40 OCT 40 COMMA OCT 54 COLON OCT 72 FRSTC DEC -1 FIRST COMMA NOT IN YET O10 OCT 10 D10 DEC 10 SUBCT NOP HOLDS SUB-PARAM. COUNTER N11 DEC -11 N5 DEC -5 SPC 4 WORD4 NOP ADDRESS FOR TYPE WORD DNAME DEF *+1 NAME BSS 3 FOR FILE NAME BSS 1 TYPE WORD BSS 7 PARAMETERS 1-7 ISECU EQU NAME+4 ICR EQU NAME+5 PARM1 EQU NAME+6 PARM2 EQU NAME+7 PARM3 EQU NAME+8 PARM4 EQU NAME+9 PARM5 EQU NAME-+10 APARM EQU NAME SKP * PYN - CHECKS FOR A "Y" OR "N" TURN-ON PARAMTER * A-REG = THE PARAMETER * B-REG = PRESENT STATE OF WORD 4,I * * RETURN:(P+1) NEITHER, OR NOT SPECIFIED * (P+2) GOT ONE, A-REG = 0 FOR NO, =1 FOR YES * PYN NOP STA TEMP1 SAVE THE PARAMETER RBR,RBR NEXT WORD4 POSITION SLB,RSS IS THIS PARAMETER SPECIFIED? JMP PYN,I NO * LDA B AND P3 CPA P3 ASCII? RSS JMP PYN,I NO STB TEMP2 SAVE CCB LDA TEMP1 ALF,ALF SHIFT TO LOW AND B377 CPA "N" CLB CPA "Y" CLB,INB SSB,RSS ISZ PYN MATCH SSB,RSS ISZ BATCH ONE MORE FOUND NOP LDA B RESTORE LDB TEMP2 JMP PYN,I SPC 3 B400 OCT 400 N72 DEC -72 P5 DEC 5 P7 DEC 7 P8 DEC 8 P9 DEC 9 P32 DEC 32 P256 DEC 256 "!!" ASC 1,!! SKP * * * MAINLINE CODE FOR SWTCH * * THE PRECEDING CODE AND THE CODE UP TO BFULL IS OVERLAID * WHEN THE TRANSFER IS BEGUN * SWTCH NOP STB APARM JSB RMPAR DEF *+2 DEF APARM * * * SET UP THE OPERATOR'S LU * LDA APARM GET PARAMETER 1 SZA,RSS SPECIFIED? ISZ APARM NO,SO DEFAULT TO LU 1 AND B1774 SZA NUMERIC? JMP *+3 NO,ASCII - USE DEFAULT LU 1 LDA APARM STA OPLU SET THE LU * LDA OPLU SET ECHO BIT IN IOR B400 OPERATOR LU WORD. STA OPLU * LDA SYSTY GET I-O CHANNEL ADA P3 OF SYSTEM CONSOLE LDA A,I AND B77 STA HTTY * JSB LINBL LDA P22 DISPLAY WARNING MESSAGES. LDB MES1 JSB DSPLY LDA P32 LDB MES2 JSB DSPLY * * * PARSE THE TURN-ON PARAMETERS * JSB GETST GET THE PARAMETER STRING <DEF *+4 DEF BUFR DEF P48 DEF ERR * PARS SZB,RSS ANY THERE? JMP GTNAM NO RBL CONVERT TO CHARACTERS STB PARML SAVE # CHARACTERS JSB PARMP GO PARSE THEM CPA N1 JMP GTNAM COULDN'T * * RETRIEVE CHANNEL PARAMTER * LDB WORD4,I GET THE TYPE WORD INTO B SZB,RSS JMP GTNAM NO PARAMTERS BLF,BLF SWAP HIGH AND LOW RBL,RBL GET BITS "7-6" TO LOW SLB,RSS JMP CP2 NOT SPECIFIED LDA B AND P3 CHECK TYPE CPA P1 RSS JMP CP2 NOT AN INTEGER LDA PARM1 STA TCH GOT ONE - CHECK IT'S RANGE LATER ISZ BATCH * * RETRIEVE THE SUBCHANNEL/UNIT CP2 RBR,RBR GET BITS "9-8" TO LOW SLB,RSS JMP CP3 NOT SPECIFIED LDA B AND P3 CPA P1 MUST BE AN INTEGER RSS JMP CP3 NOT ONE LDA PARM2 STA TSBCH SAVE IT ISZ BATCH * * RETRIEVE PARAMETERS 3,4, AND 5 CP3 LDA PARM3 JSB PYN RSS NO GOOD STA AUTO LDA PARM4 JSB PYN RSS NO GOOD STA SAVE LDA PARM5 JSB PYN RSS NO GOOD STA TYP6 * RBR,RBR GET BITS "1-0" AGAIN LDA B AND P3 CPA P3 ASCII FILE NAME? ISZ BATCH YES, NOP * CPA P3 FILE NAME? JMP VERIF YES, GO VERIFY IT GTNAM JSB LINBL NO. LDA P14 LDB MES3 JSB DSPLY ASK FOR FILE NAME, SECUR, LABEL. * READN JSB EXEC READ INPUT. DEF *+5 DEF P1 DEF OPLU DEF BUFR DEF N72 * SZB,RSS JMP READN TRY AGAIN FOR RESPONSE STB PARML POSITIVE # CHARACTERS. * LDA BUFR WANT TO EXIT? CPA "!!" CHECK FOR !! JMP XOUT YES * JSB PARMP PARSE THE STRING. i SSA JMP GTNAM TRY AGAIN * VERIF JSB OPEN OPEN THE FILE. DEF *+7 DEF DCB DEF ERR DEF NAME DEF P0 DEF ISECU DEF ICR * SSA,RSS OPEN ERROR? JMP VERF1 NO. * ERRV LDA P9 YES. DISPLAY MSG AND RE-TRY. LDB MES4 JSB DSPLY JSB CLOSE GO CLOSE THIS FILE DEF *+3 DEF DCB DEF ERR JMP GTNAM * VERF1 CPA P1 TYPE 1 FILE? JMP *+2 JMP ERRV NO. * JSB READF READ FIRST TWO RECORDS. DEF *+5 DEF DCB DEF ERR DEF BUFR DEF P256 * SSA READ ERROR? JMP ERRV YES. * LDB BUFAD DOES SECOND RECORD LOOK LIKE ADB P128 STB BPTR A TRACK 0, SECTOR 0 BOOTSTRAP? JSB VT0S0 VERIFY IT JMP ERRV NOT ONE * * LDA DCB+5 SAVE FILE SIZE. ARS ADA N1 LESS ONE FOR HEADER RECORD STA SIZE # 128-WORD SECTORS. CLB DIV P48 GET LENGTH IN TRACKS SZB INA FOR PARTIAL TRACKS ADA P8 SYSTEM AVAILABLE TRACKS STA SZTRK SIZE IN TRACKS * LDA DCB+9 SAVE DCB ID SEGMENT STA TEMP1 ADDRESS WORD JSB CLOSE BEFORE CLOSING THE ABSOLUTE OUTPUT DEF *+3 VIA FMP DEF DCB DEF ERR LDA TEMP1 NOW FUDGE THE DCB IN ORDER STA DCB+9 TO KEEP IT 'OPEN' CLA STA DCB+13 CLEAR THE IN-BUFFER FLAG SKP * * PROCESS HEADER RECORD * LDA BUFR GET NEW SYSTEM INFO SSA CHECK AGAINST AN RTEIV FILE JMP ERRV WHICH WE CAN'T DO STA DSBCH SET DESTINATION SUBCHANNEL LDA BUFR+2 STA #EQTS # EQT'S IN SYSTEM LDA BUFR+3 STA DPI DESTINATION PRIVILEGED INTERRUPT LDA BUFR+4 STA DTBG " TBG CHANNEL LDA BUFR+5 STA DTTY " TTY CHANNEL LDB BUFAD ADB BUFR+1 ADB P5 LDA B,I ALF,ALF AND B377 STA DCH " SYSTEM DISK CHANNEL LDA B,I AND B377 STA DEQT " DISK TYPE(EQT) * * ROLLS IN THE CORRECT DISK DRIVER SEGMENT, DEPENDENT * UPON THE DESTINATION DISK TYPE * LDB SWAP5 ADDRESS OF 7905/7920 SEGMENT'S NAME LDA DEQT SLA LDB SWAP0 " 7900 " " STB SWAPA JSB EXEC ROLL IN THE SEGMENT - IT WILL DEF *+3 COME BACK TO MAINR AFTER DEF P8 EXECUTING THE SEGMENT'S SWAPA NOP FRONT END CODE * MAINR LDB BUFAD SUBCHANNEL DEFINITION: ADB #EQTS ADB P6 POSITION TO EQT'S IN HEADER LDA B,I STA DFTR DESTINATION FIRST TRACK INB LDA B,I STA DNTR " NUMBER TRACKS LDA DEQT SLA JMP OUTIO * INB DESTINATION IS 7905/7920 LDA B,I STA DNSP " NUMBER SPARES INB LDA B,I STA DNSU " " SURFACES INB LDA B,I STA DNHD " HEAD NUMBER INB LDA B,I STA DUNIT " UNIT * * * DISPLAY DESTINATION I/O CONFIGURATION * OUTIO JSB LINBL LDB MES5 LDA P15 JSB DSPLY "NEW SYSTEM I/O CONFIGURATION" JSB LINBL * LDB P1 SET FOR CNVAS STB CLEN LDA DPI SZA,RSS DEFINED? JMP OUT1 NO LDB MES6A JSB CNVAS LDA P16 LDB MES6 JSB DSPLY "CHANNEL XX PRIVILEGED INTERRUPT" * OUT1 LDA DTBG LDB MES7A JSB CNVAS LDA P7 LDB MES7 JSB DSPLY "CHANNEL XX TBG" * LDA #EQTS GET REMAINING EQT'S CMA,INA STA TEMP2 NEG. # EQT'S ST0 LDA #EQTS CMA,INA STA TEMP1 $ NEG. CURRENT EQT # LDB BUFAD ADB P5 STB TEMP4 POSITION IN EQT'S, LESS 1 * ST1 ISZ TEMP4 LDA TEMP4,I GET ENTRY ALF,ALF AND B377 AND ITS CHANNEL CPA CURCH NEXT CHANNEL? RSS JMP ST2 NOPE LDB MES8A YES,DISPLAY IT JSB CNVAS LDA TEMP4,I AND B377 LDB MES8B JSB CNVAS LDA P9 LDB MES8 JSB DSPLY "CHANNEL XX TYPE YY" ISZ TEMP2 INCREMENT # FOUND RSS JMP ST4 ALL DONE * ST2 ISZ TEMP1 END OF EQT LIST? JMP ST1 NO ISZ CURCH CHANNEL NOT IN SYSTEM JMP ST0 SEARCH FOR NEXT * * * DISPLAY DESTINATION SYSTEM SUBCHANNEL DEFINITION * ST4 JSB LINBL LDA DCH GET DESTINATION CHANNEL # LDB MES9A JSB CNVAS LDA DSBCH LDB MES9B JSB CNVAS LDA P22 LDB MES9 JSB DSPLY "NEW SYSTEM(LU 2) CHANNEL=XX SUBCHANNEL=XX" * JSB LINBL LDA DEQT SLA,RSS JMP D05 7905/7920 DESTINATION DISK * LDA DSBCH ADA B2060 ALF,ALF STA MES10+13 STORE LOGICAL SUBCH. IN MESSAGE LDA DFTR CMA,INA LDB P2 SET FOR CNVAS STB CLEN LDB MS10C " FIRST TRACK # " JSB CNVAS LDA DNTR CMA,INA LDB MS10D " # TRACKS " JSB CNVAS LDA P29 LDB MES10 "7900 LOGICAL SUBCHANNEL XX FIRST TRACK XXX JSB DSPLY # TRACKS XXX" JMP GETEM * D05 LDA DNHD 7905/7920 SUBCHANNEL DEFINITION ADA B2060 STA MES11+7 STORE HEAD # IN MESSAGE LDA P2 STA CLEN LDA DNTR CMA,INA LDB MS11A " # TRACKS " JSB CNVAS LDA DUNIT ADA B2060 STA MS11C+7 " UNIT # " LDA DNSU ADA B2060 STA MES11+23 " # SURFACES " LDA DFTRAHFB CMA,INA LDB MS11B " FIRST TRACK " JSB CNVAS LDA DNSP ADA B2060 STA MS11C+23 " # SPARES " LDA P23 LDB MES11 "7905 UNIT # XX FIRST CYL # XXX HEAD # X JSB DSPLY # SURFACES X #TRACKS XXX #SPARES XXX" LDA P23 LDB MS11C JSB DSPLY SKP * * CHECK TARGET CHANNEL * GETEM JSB LINBL LDA TCH GET TARGET CHANNEL SSA,RSS SPECIFIED? JMP CHCH YES, CHECK FOR VALIDITY ASKCH LDA P23 LDB MES12 JSB DSPLY "TARGET CHANNEL FOR NEW SYSTEM?" * ASK0 JSB EXEC READ ANSWER DEF *+5 DEF P1 DEF OPLU DEF BUFR DEF N8 SZB,RSS JMP ASK0 TRY AGAIN FOR RESPONSE * JSB DFLT CR? JMP ASK1 NO LDA DCH YES, DEFAULT TARGET CHANNEL STA TCH TO DESTINATION CHANNEL JMP GTSCH * ASK1 LDA P2 JSB GETOC CONVERT ANSWER JMP ASKCH ERROR-TRY AGAIN STA TCH * CHCH ADA N8 CHECK FOR CORRECT SSA RANGE (10-77 OCTAL) JMP ASKCH < 10, TRY AGAIN ADA N56 SSA,RSS JMP ASKCH > 77, TRY AGAIN H* * CONFIGURE THE DISK DRIVER DISKD TO THE TARGET CHANNEL * GTSCH JSB STDSK * * CHECK TARGET SUBCHANNEL OR UNIT * LDA TSBCH GET THE TARGET SUBCHANNEL SSA,RSS SPECIFIED? JMP CHSB YES, CHECK VALIDITY ASKSB JSB LINBL LDA P31 LDB MES13 JSB DSPLY "TARGET SUBCHANNEL(LOGICAL)/UNIT FOR NEW SYSTEM?" * ASKS1 JSB EXEC READ ANSWER DEF *+5 DEF P1 DEF OPLU DEF BUFR DEF N8 SZB,RSS JMP ASKS1 TRY AGAIN FOR RESPONSE * JSB DFLT CR? JMP ASK3 NO LDA DEQT SLA,RSS DEFAULT TO EITHER 7900 SUBCHANNEL OR 7905/7920 UNIT JMP ASK2 LDA DSBCH DEFAULT TARGET SUBCHANNEL TO DESTINATION SUBCHANNEL STA TSBCH JMP CHOV * ASK2 LDA DUNIT STA TUNIT DEFAULT TARGET UNIT TO DESTINATION UNIT JMP CHOV * ASK3 LDA P1 JSB GETOC CONVERT ANSWER TO OCTAL JMP ASKSB ERROR, TRY AGAIN STA TSBCH **TEMP** * CHSB ADA N8 SSA,RSS JMP ASKSB > 7, TRY AGAIN LDB TSBCH LDA DEQT FOR THE 7905/7920, SAVE THE ANSWER AS THE UNIT SLA,RSS STB TUNIT SKP * * CHECK FOR OVERWRITE OF ABSOLUTE FILE CONTAINING NEW SYSTEM * CHOV JSB LOCF GET LU OF DISK DEF *+8 CONTAINING THE FILE. DEF DCB DEF ERR DEF IREC DEF IRB DEF IOFF DEF JSEC DEF SLU * LDB DRT GET THE SOURCE SUBCHANNEL. ADB SLU ADB N1 LDA B,I ALF,RAL AND B37 STA SSBCH * JSB EXEC GET SOURCE EQT TYPE DEF *+5 AND CHANNEL # DEF P13 DEF SLU DEF IEQT5 DEF IEQT4 * LDA IEQT4 AND B77 STA SCH DISC CHANNEL LDA IEQT5 ALF,ALF AND B77 STA SEQT DISC TYPE * CPA DEQT SAME AS TARGET TYPE? RSS JMP OKAY \@NO, THEN NO PROBLEM WITH OVERLAYING ABS FILE LDA SCH CPA TCH SAME DISC CHANNEL? RSS JMP OKAY NO, AGAIN NO PROBLEM * LDA SEQT GET DISC TYPE SLA,RSS JMP OV05 CHECK VIA 7905/7920 * * * GET 7900 SOURCE SUBCHANNEL DEFINITION VIA $TB31 * JSB F$TB SEARCH THRU SYSTEM ENTRY POINTS FOR IT DEF .1 LDA BPTR GO INTO TABLE AND RETRIEVE: ADA SSBCH LDB A,I STB SFTR SOURCE SUBCHANNEL'S FIRST(PHYSICAL) TRACK * * * 7900 CHECKS FOR OVERWRITE OF ABSOLUTE FILE * LDA SSBCH GET SOURCE SUBCHANNEL(IE, PLATTER) CPA TSBCH COMPARE WITH TARGET SUBCHANNEL RSS JMP OKAY NO PROBLEM, DIFFERENT SUBCHANNELS * LDA SZTRK GET NEW SYSTEM SIZE, IN # TRACKS ADA DCB+3 ADD FIRST FILE TRACK # ADA SFTR CONVERT TO ABSOLUTE LAST TRACK OF FILE,+8 ADA N8 LESS THOSE AVAILABLE TRACKS CMA,INA NEGATE ADA DFTR ADD FIRST TRACK OF NEW SYSTEM SSA,RSS LAST SOURCE TRACK MUST BE < FIRST SYSTEM TRACK JMP OKAY NO PROBLEM LDA DFTR GET FIRST SYSTEM TRACK CMA ADA DCB+3 ADD FIRST FILE TRACK ADA SFTR CONVERT TO ABSOLUTE FOR FILE SSA,RSS FIRST SOURCE TRACK MUST BE > FIRST SYSTEM TRACK JMP OKAY NO PROBLEM * * * NEW SYSTEM WILL OVERLAY ABSOLUTE FILE CONTAINING IT * OVWR JSB LINBL LDA NAME STORE ABS, FILE NAME IN MESSAGE STA MES14+17 LDA NAME+1 STA MES14+18 LDA NAME+2 STA MES14+19 LDA P20 LDB MES14 JSB DSPLY TELL USER JMP XOUT TERMINATE SWTCH SKP *CONSTANTS B37 OCT 37 B77 OCT 77 N56 DEC -56 P15 DEC 15 P19 DEC 19 P23 DEC 23 P25 DEC 25 P31 DEC 31 * IOFF NOP IRB NOP IREC NOP JSEC NOP * * SUBCHANNEL DEFINITION CONTAINING THE ABSOLUTE (SOURCE) FILE * SEQT NOP SOUR"CE CHANNEL EQT TYPE SCH NOP " " SSBCH NOP " SUBCHANNEL SFTR NOP " " FIRST TRACK SNHD NOP " " STARTING HEAD SNSU NOP " " # SURFACES SUNIT NOP " " UNIT SLU NOP " LU SKP * * GET 7905/7920 SOURCE SUBCHANNEL DEFINITION VIA $TB32 * OV05 JSB F$TB DEF .2 LDA SSBCH MPY P3 LDB BPTR RETRIEVE FROM TABLE: INB ADB A LDA B,I STA SFTR SOURCE SUBCHANNEL'S FIRST CYLINDER # INB LDA B,I AND B17 STA SUNIT " " UNIT # LDA B,I ALF AND B17 STA SNSU " " # SURFACES LDA B,I ALF,ALF AND B17 STA SNHD " " STARTING HEAD # * * 7905/7920 CHECKS FOR OVERWRITE OF ABS FILE * LDA SUNIT CPA TUNIT SAME UNIT? RSS JMP OKAY NO, SO OVERWRITE NOT POSSIBLE * CLB LDA SZTRK GET SYSTEM SIZE, IN # TRACKS ADA DCB+3 ADD FIRST FILE TRACK ADA N8 LESS THOSE AVAILABLE TRACKS DIV SNSU CONVERT TO CYLINDER ADA SFTR ADD FIRST SOURCE SUBCH CYLINDER CMA,INA NEGATE ADA DFTR ADD FIRST NEW SYSTEM CYLINDER SSA,RSS LAST SOURCE CYL MUST BE < FIRST SYSTEM CYL JMP OKAY NO PROBLEM CLB LDA DCB+3 GET FIRST SOURCE TRACK DIV SNSU CONVERT TO CYLINDER ADA SFTR ADD FIRST SOURCE SUBCH CYLINDER LDB DFTR GET FIRST NEW SYSTEM CYLINDER CMB ADB A ADD FIRST SOURCE CYLINDER SSB,RSS FIRST SOURCE CYL MUST BE > FIRST SYSTEM CYL JMP OKAY NO PROBLEM * * POSSIBLE OVERWRITE EXISTS: LAST CYL OF NEW SYSTEM > FIRST CYL OF * ABSOLUTE FILE * LDA SNSU GET # OF SOURCE SUBCH. SURFACES CMA,INA STA ΫTEMP1 AND STORE ITS NEGATIVE CLB,INB LDA SNHD GET STARTING HEAD ADA DSBUF AND ITS ENTRY ADDRESS IN BUFFER SETSS CPA ESBUF OVERFLOW(ERRONEOUS DEFINITION)? JMP INDS YES-GO SET DESTINATION SURFACES STB A,I SET SURFACE "OCCUPIED" INA ISZ TEMP1 INCREMENT TO NEXT SURFACE(SKIP IF DONE) JMP SETSS GO SET NEXT * INDS LDA DNSU GET # OF DESTINATION SURFACES CMA,INA STA TEMP1 AND SET NEGATIVE LDA DNHD GET STARTING HEAD ADA DDBUF AND ITS ENTRY ADDRESS IN BUFFER SETDS CPA EDBUF OVERFLOW(ERRONEOUS DEFINITION)? JMP OVRLP GO CHECK OVERLAPS STB A,I SET SURFACE "OCCUPIED" INA ISZ TEMP1 INCREMENT TO NEXT SURFACE (SKIP IF DONE) JMP SETDS GO SET NEXT * OVRLP LDB N5 CHECK FOR MATCH ON ANY SURFACE STB TEMP1 LDB DDBUF STB TEMP2 SET DEST. ENTRY ADDRESS LDB DSBUF STB TEMP4 AND SOURCE ENTRY ADDRESS MATCH LDA TEMP2,I GET DEST. SURFACE SZA,RSS OCCUPIED? JMP NEXTS NO,INCREMENT TO NEXT SURFACES CPA TEMP4,I IS THE SOURCE SURFACE ALSO OCCUPIED? JMP OVWR YES,SO OVERWRITE POSSIBLE NEXTS ISZ TEMP2 INCREMENT TO NEXT SURFACE ADDRESSES ISZ TEMP4 ISZ TEMP1 DID 5 SURFACE CHECKS ALREADY? JMP MATCH NO JMP OKAY YES - AND WE MADE IT * DSBUF DEF *+1 BSS 5 SOURCE SURFACES 0-4 ESBUF DEF * DDBUF DEF *+1 BSS 5 DESTINATION SURFACES 0-4 EDBUF DEF * SKP * * WE PASSED THE FIRST TEST!!! * * IF THE HOST AND TARGET SYSTEM'S ARE BOTH 7905/7920'S THEN WE'RE * GOING TO SEARCH $TB32 NOW BEFORE THE USER HAS AN OPPORTUNITY * TO INSERT A DIFFERENT SYSTEM DISC. * FOR NOW, ONLY HUNIT WILL BE CHECKED AT CHPNT. * OKAY JSB EXEC GET I/O CHANNEL AND EQT TYPE OF LU 2 DEF *+5 DEF P13 DEF P2 DEF IEQT5 DEF IEQT4 * LDA IEQT5 GET HOST EQT TYPE ALF,ALF AND B77 CPA DEQT SLA SAME DISC TYPE - SEE WHICH JMP OKAYY 7900, NO PROBLEM CUZ CAN USE SUBCHANNEL * LDA IEQT4 GET CHANNEL AND B77 CPA TCH SAME? RSS YES JMP OKAYY NO PROBLEM HERE LDA DRT GET LU 2'S SUBCHANNEL INA LDA A,I ALF,RAL AND B7 STA HSBCH * * GET 7905/7920 HOST SUBCHANNEL DEFINITION VIA $TB32 * JSB F$TB DEF .2 LDA HSBCH MPY P3 LDB BPTR RETRIEVE FROM TABLE: INB ADB A LDA B,I STA HFTR HOST SUBCHANNEL'S FIRST CYLINDER # INB LDA B,I AND B17 STA HUNIT " " UNIT # LDA B,I ALF AND B17 STA HNSU " " # SURFACES LDA B,I ALF,ALF AND B17 STA HNHD " " STARTING HEAD # SKP * * * OPERATOR GIVEN OPPORTUNITY TO INSERT CORRECT CARTRIDGE * OKAYY LDA BATCH CMA,SSA,INA,SZA SKIP IF <= 0 JMP SAVE? NOT SO IN BATCH MODE JSB LINBL LDA P23 LDB MES16 JSB DSPLY LDA P23 "NOW IS THE TIME TO INSERT CORRECT LDB MES17 CARTRIDGE IN TARGER SUBCHANNEL/UNIT" JSB DSPLY * CRLF JSB EXEC GET ANSWER DEF *+5 DEF P1 DEF OPLU DEF BUFR DEF P3 SZB,RSS CHECK TRANS. LOG JMP CRLF TRY AGAIN FOR ANSWER * * CHECK IF FILE STRUCTURE AT TARGET IS TO BE SAVED * SAVE? LDA SAVE WAS IT SPECIFIED AT TURN-ON TIME? SSA,RSS JMP SAV?? YES * SAV1 LDA P16 NO, ASK THEM LDB MES18 JSB DSPLY "SAVE FILES AT TARGET? (Y OR N) * JSB YE?NO READ ANSWER JMP SAV1 INVALID REPLY CLA,RSS NO CLA,INA YES, SAVE IT STA SAVE * SAV?? CPA P0 J1DO WE SAVE THE FILES ? JMP AUTO? NOPE * * CHECK THE SYSTEM AT THE TARGET * JSB VFYSY VERIFY THE SYSTEM OUT THERE! JMP AUTO? CAN'T SAVE THE FILES * LDA SZTRK SIZE OF NEW SYSTEM (INCLUDING 8 TRACKS LDB FFMP OF AVAILABLE TRACK SPACE) MUST BE CMA,INA < FIRST FMP TRACK OF TARGET ADA B SUBCHANNEL SSA,RSS JMP SAVE6 NO PROBLEM * LDA P19 WARN USER LDB MES19 JSB DSPLY "NEW SYSTEM WILL DESTROY SOME FMP FILES" JSB OK? "OK TO PROCEED?" * CCA SET TO PROCEED, BUT SAVE AS MANY FILES STA SAVE AS POSSIBLE * * * CHECK IF TYPE 6 FILES ARE TO BE SAVED * SAVE6 LDA TYP6 SPECIFIED AT TURN-ON TIME? SSA,RSS JMP AUTO? YES * SAV6A LDA P15 NO, ASK THEM LDB MES22 JSB DSPLY "PURGE TYPE 6 FILES? (Y OR N)" * JSB YE?NO DECIPHER ANSWER JMP SAV6A INVALID REPLY CLA,RSS NO CLA,INA YES STA TYP6 SKP * * THE FOLLOWING CONDITIONS FOR AUTO BOOT-UP ARE CHECKED: * DESTINATION CHANNEL = TARGET CHANNEL * DESTINATION SUBCHANNEL/UNIT = TARGET SUBCHANNEL/UNIT * DESTINATION TBG CHANNEL = HOST TBG CHANNEL * DESTINATION TTY CHANNEL = HOST TTY CHANNEL * DESTINATION PI CHANNEL = HOST PI CHANNEL ( IF BOTH EXIST) * AUTO? LDA AUTO SPECIFIED AT TURN-ON TIME? SZA,RSS JMP CHPNT YES, ONLY THAT THEY DON'T WANT IT * LDA DCH COMPARE DISC CHANNELS CPA TCH RSS JMP CANT NO MATCH LDB DEQT SLB CHECK SUBCHANNELS OR UNITS JMP AUT0 LDA DUNIT CPA TUNIT JMP AUT1 JMP CANT NO MATCH ON 7905/7920 UNIT * AUT0 LDA DSBCH CPA TSBCH RSS JMP CANT NO MATCH ON 7900 SUBCHANNEL # * AUT1 LDA TBG GET HOST TBG CHANNEL CPq A DTBG RSS JMP CANT TBG'S DON'T MATCH LDA HTTY CPA DTTY RSS JMP CANT TTY CHANNELS DON'T MATCH LDA PI GET HOST PI CHANNEL CPA P0 IF EITHER THE HOST OR JMP AUT2 LDB DPI CPB P0 DESTINATION PI IS 0, JMP AUT2 THEN DON'T CHECK CPA B RSS JMP CANT PI CHANNELS DON'T MATCH * * * AUTO BOOT-UP IS POSSIBLE * AUT2 LDA AUTO HAS IT BEEN SPECIFIED YET? SSA,RSS -1=NOT SPECIFIED, 1=YES JMP CHPNT YES, AND WANT IT AUT3 LDA P12 LDB MES24 JSB DSPLY "AUTO BOOT-UP? (Y OR N)" JSB YE?NO GET ANSWER JMP AUT3 INVALID REPLY CLA,RSS NO CLA,INA YES STA AUTO JMP CHPNT * * * WON'T BE BOOTING UP NEW SYSTEM * CANT LDA P25 LDB MES25 JSB DSPLY "PRESENT CONFIGURATION DOESN'T PERMIT AUTO BOOT-UP" CLA STA AUTO * * * DETERMINE IF WE'RE OVERLAYING PART OF THE HOST SYSTEM. * ALSO, DETERMINE IF WE CAN RETURN TO HOST SYSTEM AFTER * TRANSFER, OTHERWISE HALT * CHPNT JSB EXEC GET I/O CHANNEL AND EQT TYPE OF LU 2 DEF *+5 DEF P13 DEF P2 DEF IEQT5 DEF IEQT4 * LDA IEQT5 GET HOST EQT TYPE ALF,ALF AND B77 CPA DEQT SAME AS NEW? RSS JMP GO LDA IEQT4 AND B77 CPA TCH REPLACING CURRENT? RSS MAYBE JMP GO LDA DRT GET LU 2'S SUBCHANNEL INA LDA A,I ALF,RAL AND B7 STA HSBCH LDB DEQT SLB,RSS JMP CHPT5 CHECK 7905/7920 SUBCHANNEL DEFN CPA TSBCH SAME 7900 SUBCHANNELS? RSS JMP GO NO,SO NO PROBLEM * * WILL BE REPLACING CURRENT SYSTEM * REPL CLA,INA STA PONRT SET "POINT OF NO RETURN" FLAG FOR THE LDA AUTO SZA JMP ZGO LDA P22 ERROR MESSAGE PROCESSING LDB MES26 JSB DSPLY "SYSTEM WILL HALT AFTER TRANSFER COMPLETION" JMP GO * * GOT 7905/7920 HOST SUBCHANNEL DEFINITION (VIA $TB32) AT OKAY * * 7905/7920 CHECKS FOR OVERWRITE OF HOST SYSTEM, USING HUNIT ONLY * CHPT5 LDA HUNIT CPA TUNIT SAME UNIT? JMP REPL YES - SO HALT IF NO AUTO-BOOT JMP GO NO, SO OVERWRITE NOT POSSIBLE * * LDA SZTRK GET SYSTEM SIZE, IN # TRACKS * CLB * DIV DNSU CONVERT TO # CONTIGUOUS CYLINDERS * INA PLUS ONE FOR REMAINDER, STARTING HEADS,... * STA TEMP3 SAVE IT * LDA HFTR GET STARTING CYLINDER OF HOST SYSTEM * CMA,INA NEGATE * ADA DFTR ADD STARTING CYLINDER FOR SYSTEM * ADA TEMP3 ADD # CYLINDERS NEEDED FOR SYSTEM * SSA * JMP GO NO OVERWRITE PROBLEM * * POSSIBLE OVERWRITE EXISTS: LAST CYL OF NEW SYSTEM > FIRST CYL OF * HOST SYSTEM. * * LDA DNSU CHECK # SURFACES OF HOST TO DESTINATION, * LDB HNSU DEPENDING ON # SURFACES AND STARTING HEAD # * CPA P3 IF EITHER COVERS 3 SURFACES, THEN OVERWRITE EXISTS * JMP REPL * CPB P3 * JMP REPL * CPA P2 IF BOTH HAVE 2 SURFACES, THEN OVERWRITE EXISTS * RSS * JMP BOTH * CPA HNSU * JMP REPL YES *BOTH CPA P1 IF BOTH HAVE JUST ONE SURFACE, THEN THEY * RSS MAY BE THE SAME ONE * JMP TUONE * CPA HNSU * RSS * JMP TUONE * LDA HNHD HAVE TO COMPARE THE STARTING HEAD #'S * CPA DNHD * JMP REPL THE SAME ! * JMP GO * * HAVE THE TWO SURFACE - ONE SURFACE COMBINATION. CHECK FOR A COMMON * SURFACE. * *TUONELDA HNSU GET THE STARTING HEAD OF THE 1-SURFACE * CPA P1 INTO A-REG * JMP SEQ2 * LDA DNHD AND THE STARTING HEAD OF THE 2-SURFACE * LDB HNHD INTO B-REG * JMP OVRLY *SEQ2 LDA HNHD * LDB DNHD * *OVRLYCPB A d) SAME? * JMP REPL YUP! * INB INCREMENT TO 2ND HEAD # * CPB A CHECK THE SECOND SURFACE * JMP REPL SAME * * * * ALLOW OPERATOR ONE MORE OPPORTUNITY TO GET OUT * GO LDA BATCH NO MESSAGE IN BATCH MODE CMA,SSA,INA,SZA SKIP IF <= 0 JMP PURGF LDA P17 LDB MES32 JSB DSPLY "READY TO TRANSFER. OK TO PROCEED?" JSB YE?NO JMP GO INVALID REPLY JMP XOUT BAIL OUT JMP PURGF YES, GET WITH IT SKP * * PURGE ALL FILES FROM THE FILE DIRECTORY (AND THEIR EXTENTS) * THAT WERE OVERLAID BY THE NEW SYSTEM - LISTING THEM AT THE * SAME TIME. * PURGF JSB EXEC CORE LOCK - TO DEF *+3 PREVENT SWTCH FROM DEF P22 FROM BEING SWAPPED OUT DEF P1 * LDB SAVE WERE THE FMP FILES TO BE SAVED? SZB,RSS JMP XFER NO * LDA D.LT CONVERT LAST FMP LOGICAL ADDRESS AND B377 TO THE LOGICAL TRACK AND SECTOR ALF,ALF ADDRESS FOR DISKD RAR STA D.LT RE-STORE STA DSTAD LDA D.# STA TEMP4 SAVE FOR LOOP CHECKS * CLB STB INITF FOR DISKD LDA N6144 STA LNGTH LDA BUFAD STA BPTR * LDA SAVE SSA,RSS WERE ANY FMP FILES OVERLAID? JMP PUR6 NO,CHECK ON TYPE 6 FILES * LDA LWAM SET THE ADDRES OF THE ADA N3 FIRST FILE NAME ENTRY STA PENT * CLA,INA STA REWRT SET RE-WRITE FOR CD LDA D.LT LDB BUFAD CCE SET FOR READ JMP BFULL * B7 OCT 7 SPC 3 ****************************************************************************** * * THE FOLLOWING BSS ALLOWS FOR OVERLAY OF THE * PREVIOUS CODE, AND ADDS ADDITIONAL BSS'S FOR * AN AREA TOTALING 6144(DECIMAL) WORDS. * BSS 6144+BUFR-* * ***************************************************************************** SPC 3 BFULL JSB DISKD FIRST FULL TRACK READ JSB LINBL LDA P10 HEADING: LDB MES27 JSB DSPLY "OVERLAID FMP FILES:" CCA STA CURCH SET FOR PURGT LDA BPTR POSITION TO CARTRIDGE SPECIFICATION ADA P900 ENTRY WORD 4 LDB SZTRK AND STORE THE NEW FIRST STB A,I FMP TRACK * LDB BPTR POSITION TO FIRST FILE ADB B200 DIRECTORY ENTRY ON THE LDA N376 TRACK LOOP0 STA TCNT SET # ENTRIES TO SEARCH LOOP1 STB BPTR BUFFER POINTER LDA BPTR,I GET WORD 0 CPA N1 JMP INCRB ALREADY PURGED SZA,RSS JMP INCRB NOT AN ENTRY ADB P4 POSITION TO TRACK ADDRESS LDA B,I LDB SZTRK COMPARE WITH LAST SYSTEM CMB,INB TRACK ADA B SSA WAS THE FILE IN THE NEW SYSTEM AREA? JSB PURGT PURGES,LISTS ENTRY * INCRB JSB UPDAT SET TO SEARCH NEXT ENTRY JMP LOOP1 CONTINUE IN SAME TRACK JMP PUR6 PURGE TYPE 6 FILES JMP LOOP0 CONTINUE IN NEW TRACK * P900 DEC 900 SKP * PURGES ANY TYPE 6 FILES OF THE TARGET FMP FILE SYSTEM * PUR6 LDA TYP6 ARE WE TO PURGE ANY? SZA,RSS JMP XFER NO * CLA CLEAR THE STA REWRT REWRITE & FILES FLAGS STA CURCH FOR PURGT LDA D.# STA TEMP4 SET THE # DIRECTORY TRACKS TO SEARCH LDA D.LT FIRST DIRECTORY TRACK STA DSTAD LDB BUFAD STB BPTR CCE JSB DISKD READ IT * LDB BPTR POSITION TO FIRST ADB B200 FILE DIRECTORY ENTRY LDA N376 LOOP2 STA TCNT # ENTRIES TO SEARCH LOOP3 STB BPTR BUFFER POINTER LDA BPTR,I GET WORD 0 CPA N1 JMP INCRE ALREADY PURGED SZA,RSS JMP INCRE NOT AN ENTRY ADB P3 POSITION TO FILE TYPE LDkB@ CURRENT SYSTEM UNDER WHICH SWTCH IS OPERATING * HSBCH NOP HOST SYSTEM DISK SUBCHANNEL HUNIT NOP " " " UNIT(7905/7920) HNHD NOP " SUBCHANNEL STARTING HEAD (7905/7920) HNSU NOP " " # SURFACES " HFTR NOP " " STARTING TRACK/CYLINDER HTTY NOP " TTY CHANNEL SPC 3 * DESTINATION => GENERATION-DEFINED SYSTEM * DCH NOP DESTINATION SYSTEM DISC CHANNEL DSBCH NOP " " " SUBCHANNEL DEQT NOP " " " EQT TYPE DUNIT NOP " " " UNIT DFTR NOP " " " FIRST TRACK/CYLINDER DNTR NOP " " " NUMBER TRACKS DNHD NOP " " " STARTING HEAD (7905/7920) DNSU NOP " " " NUMBER SURFACES " DNSP NOP " " " " SPARES " DTTY NOP " TTY CHANNEL DPI NOP " PI CHANNEL DTBG NOP " TBG CHANNEL SPC 3 * TARGET => TEMPORARY STORAGE FOR NEW SYSTEM * TCH DEC -1 TARGET DISC CHANNEL TSBCH DEC -1 " " SUBCHANNEL TUNIT DEC -1 " " UNIT (7905/7920) SKP * MES15 DEF *+1 ASC 20,TRANSFER CANCELLED AND SWTCH TERMINATED. MES27 DEF *+1 ASC 10,OVERLAID FMP FILES: MES28 DEF *+1 ASC 10,TYPE 6 FILES PURGED: MES29 DEF *+1 MS29 ASC 6, MES31 DEF *+1 ASC 5,FILE ERR - MS31A BSS 0 MES33 DEF *+1 ASC 7,SWTCH FINISHED SPC 3 BOOTF NOP "WE'RE BOOTING" FLAG FOR DISKD (0=NOT NOW) AUTO DEC -1 AUTO BOOT-UP FLAG (0=NO, 1=YES) SAVE DEC -1 SAVE TARGET FILES(0=NO,1=YES,-1=OVERLAYS SOME) TYP6 DEC -1 PURGE TYPE 6 FILES FLAG (0=NO, 1=YES) BATCH DEC -5 BATCH MODE ( NO<=0, YES>=1 ) #EQTS NOP NUMBER OF DESTINATION EQT'S CURCH DEC 0 CURRENT CHANNEL COUNTER PONRT NOP "POINT-OF-NO-RETURN" FLAG (0=OK,1=WILL,-1=DONE) D.LT DEC -1 LAST DIRECTORY TRACK FROM TARGET'S CD D.# NOP # DIRECTORY TRACKS FROM TARGET'S CD TAT NOP DISK ADDRESS OF TAT IN NEW SYSTEM FFMP NOP FIRST LOGICAL FMP TRACK AT TARGET * LNGTH NOP LENGTH OF READ/WRITE INITF NOP DISKD COMMAND MASK DSTAD NOP DESTINATION DISK ADDRESS BUHFBFAD DEF BUFR BPTR NOP BUFR POINTER EOFLG NOP REWRT NOP RE-WRITE TRACK FLAG SIZE NOP # BLOCKS IN FILE SZTRK NOP # TRACKS IN FILE (PLUS 8) * TEMP1 NOP TEMPORARY TEMP2 NOP " TEMP3 NOP " TEMP4 NOP " * DRT EQU 1652B PI EQU 1737B TBG EQU 1674B SYSTY EQU 1675B * IEQT4 NOP IEQT5 NOP SKP P0 DEC 0 P2 DEC 2 P3 DEC 3 P4 DEC 4 P6 DEC 6 P13 DEC 13 P16 DEC 16 P22 DEC 22 P20 DEC 20 P48 DEC 48 P128 DEC 128 P1024 DEC 1024 P6144 DEC 6144 * N1 DEC -1 N2 DEC -2 N3 DEC -3 N8 DEC -8 N128 DEC -128 * B60 OCT 60 B167 OCT 167 B377 OCT 377 B1776 OCT 177600 * OPLU DEC 1 DEFAULT OPER CONSOLE LU (MAY * BE OVERWRITTEN) CNTR NOP DBLNK DEF BLNK BLNK OCT 20040 * * DCB BSS 144 ERR NOP LLEN NOP * END EQU * * * END SWTCH GHASMB,R,L,C HED SWTCH - DSEG0, 7900 DISK DRIVER SEGMENT NAM DSEG0,5,11 92060-16038 760715 SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 2 **************************************** * * NAME: DSEG0 * SOURCE: 92060-18038 * BINARY: 92060-16038 * WRITTEN BY: K. HAHN * **************************************** * * * ENTRY POINTS * ENT DISK0,STDS0 ENT INP0,INIT0 ENT FLGTR * * * EXTERNAL ENTRY POINTS * EXT MAINR EXT $LIBR,$LIBX EXT TCH,TSBCH,DFTR EXT INITF,LNGTH EXT CNVAS,CLEN,DSPLY,LINBL EXT DSBCH,XOUT,BUFAD EXT BOOTF * * A EQU 0 B EQU 1 SUP SKP BEG0 JMP MAINR SEGMENT'S ENTRY POINT SPC 3 TEMP BSS 3 TEMP FOR INTIALIZATION * M100 OCT 100 B177 OCT 177 M440 OCT 440 M0100 OCT 10000 M1776 OCT 177600 M7700 OCT 177700 * N10 DEC -10 * P1 DEC 1 P2 DEC 2 P4 DEC 4 P9 DEC 9 P12 DEC 12 P14 DEC 14 P16 DEC 16 P17 DEC 17 P25 DEC 25 * INP0 OCT 101000 INITIALIZE, WRITE PROTECT COMMAND BITS INIT0 OCT 100000 " " " SKP * * INSERT CHNL NO. IN INSTRUCTION * * THE STDSK SUBROUTINE SETS THE CURRENT DISK CHANNEL * NOS. IN THE I/O INSTRUCTIONS. * * STDS0 NOP LDA TCH SAVE TARGET DISK CHANNEL STA TEMP1 LDA #DATA GET # WORDS TO BE CONFIGURED LDB HPDSK GET ADDRESS OF INSTR ADDR LIST STDS1 STA TEMP2 SAVE NO. OF INSTRUCTIONS STDS2 LDA B,I GET INSTRUCTiION AND M7700 ISOLATE INSTRUCTION CODE IOR TEMP1 INSERT CHANNEL NO. STA B,I SET INSTRUCTION IN CODE INB INCR INSTRUCTION ADDRESS ISZ TEMP2 SKIP - DONE WITH SET JMP STDS2 CONFIGURE NEXT INSTRUCTION * LDA TEMP1 DONE WITH COMMAND CHANNEL? CPA TCH RSS JMP STDS3 YES LDA #CMND GET # COMMAND INSTRUCTIONS ISZ TEMP1 STEP TO COMMAND CHANNEL JMP STDS1 GO CONFIGURE * STDS3 LDA N10 CLEAR THE BAD TRACK STA TEMP TABLE LDB FLGTR GET ADDRESS OF TABLE CCA STA TEMP+2 SET TO NO BAD TRACKS STDS4 STA B,I SET TO -1 FOR NO ENTRY INB STEP TABLE ADDRESS ISZ TEMP DONE? JMP STDS4 NO, DO NEXT ONE STA B,I JMP STDS0,I RETURN * * #DATA ABS I/OTB-I/OTC # DATA INSTRUCTIONS #CMND ABS I/OTC-I/OTD # COMMAND INSTRUCTIONS HPDSK DEF I/OTB,I ADDR OF I/O INSTRUCTION LIST TEMP1 NOP TEMP2 NOP * ADDRESS OF BAD TRACK TABLE FLGTR DEF STDS0+1 WHICH OVERLAYS 10 WORDS OF STDS0 SKP * * THE DRIVER ENTERS HERE AFTER 10 TRIES HAVE FAILED TO INITILIZE A * TRACK. * INIER JSB INTON TURN INTERRUPTS BACK ON LDA STATB GET STATUS AND AND M440 MASK SEEK CHECK CHECK AND END OF CYLINDER SZA,RSS BITS - IF NOT SET CONTINUE JMP INIE0 WITH BAD TRACK ROUTINE * LDA P14 ELSE SEND BAD SPECIFICATION LDB ERR43 JSB DSPLY "INVALID DISC SPECIFICATIONS" JMP XOUT TERMINATE SWTCH * INIE0 LDA INITF SAVE THE INITF STA TEMP2 FLAG WORD LDA DFCYF SET COMMAND STA INITF TO FLAG TRACK DEFECTIVE CLE AND LDB BUFAD CALL LDA DCMND THE DRIVER JMP DISK0+1 DRIVER * INIEH ISZ TEMP+2 BAD TRACK HEADER PRINTED YET JMP INIES YES - SKIP/ * JSB LINBL LDA P12 LDB TSBCH GET SUBCHANNEL ADB BLK0 ADD ASC BLANK 0 STB EMES1-1 SET IN MESSAGE LDB EMES1 SEND THE JSB DSPLY MESSAGE * INIES LDA DCMND GET TRACK ADDRESS AND M1776 ALF,ALF MOVE IT TO LOW RAL A CMA,INA SET NEGATIVE FOR DECIMAL CONVERSION LDB P2 STB CLEN FOR CNVAS LDB ALBUF SET BUFFER ADDRESS JSB CNVAS CONVERT THE NUMBER LDA P4 AND LDB ALBUF SEND JSB DSPLY THE TRACK NUMBER * * TRACK IS NOW FLAGGED AND REPORTED IT IS NOW ENTERED IN THE * BAD TRACK TABLE. * LDA TEMP2 STA INITF RESTORE IT LDA DCMND GET THE TRACK AND M1776 ADA DSBCH STA TEMP1 AND SAVE LDB FLGTR GET THE BAD TRACK TABLE ADDRESS LDA N10 ALLOW 10 ENTRIES STA TEMP+1 SET COUNTER INIE1 LDA B,I GET ENTRY SSA NEGATIVE? JMP INIET YES - USE THIS ONE * INB NO ALREADY USED ISZ TEMP+1 STEP COUNT 10 YET? JMP INIE1 NO - TRY NEXT ONE * LDA P16 LDB ERR41 JSB DSPLY "LIMIT OF 10 BAD TRACKS EXDEEDED" JMP XOUT AND TERMINATE SWTCH * INIET LDA TEMP1 GET SUBCHANNEL/TRACK STA B,I SET IN TABLE JMP DISK0,I GO FINISH INITILIZATION. * DFCYF OCT 100400 ALBUF DEF *+1 BSS 2 EMES2 ASC 12,BAD TRACKS SUBCHANNEL X EMES1 DEF EMES2 BLK0 ASC 1, 0 * ERR41 DEF *+1 ASC 16,LIMIT OF 10 BAD TRACKS EXCEEDED ERR43 DEF *+1 ASC 14,INVALID DISC SPECIFICATIONS HED DISC DRIVE I/O INSTRUCTION ADDRESSES I/OTB DEF DSK51 DATA CHANNEL DEF DSK52 DEF DSK53 DEF DSK54 DEF DSK55 DEF DSK56 DEF DSK57 DEF DSK58 DEF DSK59 DEF DSK60 DEF DSK61 DEF DSKDR I/OTC DEF DSK01 COMMAND CHANNEL >m DEF DSK02 DEF DSK03 DEF DSK04 DEF DSK05 DEF DSK07 DEF DSK08 DEF DSK09 DEF DSK10 DEF DSK11 DEF DSK16 DEF DSK71 I/OTD EQU * HED 7900 I/O DISC DRIVER * THE DISKD SUBROUTINE IS THE MAIN DISC INPUT/OUTPUT DRIVER. * IT SETS UP THE COMPLETE TRANSFER AND READS OR WRITES * LNGTH WORDS ON THE DISC. IT WAITS UNTIL THE TRANSFER * IS COMPLETE. STATUS IS DONE AFTER EACH TRANSFER FOR WRITE * PROTECT ERRORS THE OPERATOR IS ASKED TO TURN ON THE SWITCH. * FOR DEFECTIVE CYLINDER ERRORS THE IRRECOVERABLE ERROR ERR40 IS * TAKEN. FOR NOT READY ERRORS THE OPERATOR IS NOTIFIED. * FOR OTHER ERRORS TEN TRIES ARE MADE. IF THE ERROR STILL EXIST * AND: * * A - IF THE INIT FLAG IS SET GO TO INIER * * B - ELSE NOTIFY OPERATOR AND TERMINATE * * CALLING SEQUENCE * LNGTH = NEGATIVE # WORDS TO TRANSMIT * A = DISK ADDRESS -ON A 64 WORD/SECTOR BASIS - * B = CORE ADDRESS * E = 1 FOR READ * E = 0 FOR WRITE * * RETURN - ALWAYS NORMAL--REGS. MEANINGLESS SPC 3 DISK0 NOP RBL,ERB SET THE READ/WRITE BIT STB MADDR AND SAVE THE ADDRESS STA DCMND DO TRACK MAPPING AND B177 ISOLATE SECTOR STA SECT1 SAVE XOR DCMND ISOLATE THE TRACK CLE,ELA ALF,ALF ROTATE TRACK TO LOW A ADA DFTR ADD FIRST TRACK TO RELATIVE TRACK STA T#AC0 SAVE ABSOLUTE TRACK LDB TSBCH GET SUBCHANNEL NUMBER CLE,ERB B IS UNIT NOT E IS HIGH HEAD BIT STB UN#IT SAVE UNIT NUMBER ADB M0100 SET COMMANDS LDA INITF ADD INIT FLAG TO WRITE ADA B COMMAND STA W#CMD AND SET WRITE COMMAND ADB M0100 READ STB R#DCM SET READ ADB M0100 STB S#EKC SEEK CLA,SEZ,CLE,RSS IF E = 0 INA SET HEAD 2 LDB SECT1 GET SECTOR I BRS B IS ACTUAL SECTOR STB H#AD SAVE ADB NSEC SUBTRACT NUMBER ON A SIDE SSB,RSS IF POSITIVE STB H#AD RESET SECTOR ELA MOVE IN LOW HEAD BIT ALF,ALF ROTATE ADA H#AD AND ADD THE SECTOR STA H#AD SAVE HEAD/SECTOR ADDRESS JSB $LIBR KILL THE INTERRUPT SYSTEM NOP CLF 0 * RTRY LDA N10 RESET 10 TRY COUNTER STA EDCNT DSK16 STF 1 SET FLAG FOR STATUS JSB STATC GO DO STATUS AND M100 CHECK READY BIT SZA IF SET JMP NRERR GO TELL THE MAN * LDA T#AC0 SET TRACK TO A JSB SEEK AND SEEK THE RECORD LDB MADDR SET THE CORE ADDRESS TO B LDA R#DCM SET FOR READ SSB,RSS WRITE? LDA W#CMD YES - RESET TO WRITE DSK01 CLC 1 SET UP COMMAND DSK02 OTA 1 SEND COMMAND DSK51 STF 0 SET FOR WRITE CLE,SSB READ? DSK52 STC 0,C YES / RESET FOR READ LDA DSKDR GET DMA WORD OTA 6 ASSIGN DMA CLC 2 SET FOR ADDRESS OTB 2 SEND ADDRESS LDA LNGTH SET LENGTH STC 2 SET FOR LENGTH OTA 2 SEND IT STC 6,C START DMA DSK03 STC 1,C START DRIVE CLC 6 JSB STATC GET STATUS STA STATB SAVE SLA JMP ERRCH CHECK ERROR STATUS * LDA BOOTF ARE WE BOOTING UP? SZA,RSS JMP DISKR NO,CONTINUE STF 6 YES CLC 0,C LDA M2055,I GET STARTING ADDRESS ADA P4 SKIP: STF 6, CLC 0,C, HLT 77 LDB M1742 NOW DETERMINE IF WE'RE IN CPB P2 AN RTE-II OR RTE-III RSS MUST DISABLE MAPPING FOR RTE-III JMP A,I GO TO RTE! DJP A,I WELL SAID! * M2055 OCT 2055 M1742 EQU 1742B * DISKR JSB INTON OK, SO TURN ON INTERRUPTS LDA INITF CHECP4K IF MAY HAVE BEEN ALF,ALF FLAGGING A DEFECTIVE SLA TRACK, SO RETURN JMP INIEH TO REPORT IT JMP DISK0,I ELSE RETURN * ERRCH RAL,CLE,ERA CLEAR SIGN BIT CPA P9 WRITE PROTECT ERROR? JMP WRPTM YES - GO TELL HIM * CPA P25 DEFECTIVE CYLINDER? JMP DISBM * AND M100 ISOLATE READY BIT SZA READY? JMP NRERR NO - GO TELL USER * CLA YES, TRY TO RECOVER JSB SEEK SEEK TO CYLINDER 0 ISZ EDCNT INCREMENT # TRIES JMP DSK16 NOT TEN YET GO TRY AGAIN * LDA INITF 10 TIMES IN INIT PHASE? CPA INIT0 JMP INIER YES GO TO INIT ERROR ROUTINE * * JSB INTON TURN THE INTERRUPTS BACK ON LDA DCMND INSERT THE TRACK IN THE AND M1776 ALF,ALF RAL CMA,INA NEGATE FOR CNVAS LDB P2 STB CLEN LDB ER22A JSB CNVAS LDA P16 LDB ERR22 JSB DSPLY "PARITY OR DATA ERROR TRACK XXX" LDA INITF DETERMINE ACTION TO TAKE ALF,ALF RAR SLA IF WRITE PROTECT BIT SET,THEN JMP XOUT TRACKS WERE BEING WRITTEN, SO EXIT LDA INITF IF INITIALIZE BIT SET, THEN SSA JMP INIER+1 GO TO INIT ERROR ROUTINE JMP XOUT ELSE TERMINATE SWTCH * * DISBM JSB INTON ON INTERRUPTS! LDA INITF IF DEFECTIVE CYLINDER ALF,ALF IS BEING FLAGGED BY SLA INIER JMP INIEH IGNORE ERROR, GO REPORT TRACK * RAL IF WRITE PROTECT SET, THEN SLA THE SYSTEM IS BEING WRITTEN JMP IRERR AND THAT'S IRRECOVERABLE! * LDA INITF IF INITIALIZE BIT SET, THEN SSA JMP INIER+1 GO FLAG IT DEFECTIVE * IRERR LDA DCMND INSERT TRACK # IN MESSAGE AND M1776 ALF,ALF RAL CMA,INA LDB P2 STB CLEN= LDB ER40A JSB CNVAS LDA P16 LDB ERR40 JSB DSPLY "DEFECTIVE CYLINDER - TRACK XXX" JMP XOUT AND EXIT * * NRERR JSB INTON INTERRUPTS ON JSB LINBL DISC NOT READY LDA P12 LDB MES33 TELL 'EM JSB DSPLY "READY DISC AND PRESS RUN" JSB $LIBR TURN OFF NOP CLF 0 DSK56 LIA 0 GET STATUS TO A HLT 33B PAUSE JMP RTRY ON RESTART, RETRY * * WRPTM JSB INTON JSB LINBL WRITE PROTECT SWITCH IS ON LDA P17 LDB MES32 JSB DSPLY "TURN OFF DISC PROTECT - PRESS RUN" JSB $LIBR OFF AGAIN NOP CLF 0 HLT 32B WAIT FOR IT JMP RTRY AND DO IT AGAIN * SPC 3 * * TURNS THE INTERRUPT SYSTEM BACK ON * INTON NOP DSK71 CLF 1 JSB $LIBX DEF INTON SPC 2 * SEEK ROUTINE SEEK NOP DSK57 OTA 0 SEND TRACK DSK58 STC 0,C SET DATA TO SHOW TRACK SEND ALF,ALF TRACK TO HIGH A ADA UN#IT ADD THE UNIT NUMBER LDB S#EKC GET SEEK COMMAND DSK09 CLC 1 SET UP COMMAND CHANNEL DSK10 OTB 1 SEND COMMAND DSK11 STC 1,C TELL CONTROLLER LDB H#AD GET HEAD/SECTOR ADDRESS DSK59 SFS 0 READY? JMP DSK59 WAIT * DSK60 OTB 0 SEND HEAD/SECTOR DSK61 STC 0,C START JSB STATC GET STATUS JMP SEEK,I RETURN SPC 2 * * WAIT AND STATUS ROUTINE STATC NOP DSK04 SFS 1 WAIT FOR FLAG JMP DSK04 * STF 6 CLEAR DMA DSK05 CLC 1 CLEAR CONTROLLER DSK53 STC 0,C SET DATA FOR LDA UN#IT STATUS DSK07 OTA 1 SEND STATUS REQUEST DSK08 STC 1,C START DSK54 SFS 0 WAIT FOR JMP DSK54 STATUS * DSK55 LIA 0,C GET STATUS AND JMP STATC,I RETURN SPC 5 MADDR NOP MEMORY A0.*DDRESS FOR CURRENT TRANSFER DCMND NOP DISC ADDRESS FOR CURRENT TRANSFER EDCNT NOP ERROR COUNT FOR CURRENT TRANSFER SECT1 NOP STATB NOP NSEC DEC -24 W#CMD OCT 010000 UN#IT NOP H#AD NOP S#EKC OCT 030000 R#DCM OCT 020000 DSKDR OCT 120000 MUST BE CONFIGURED T#AC0 NOP * ERR22 DEF *+1 ASC 16,PARITY OR DATA ERROR TRACK XXXX ER22A DEF ERR22+15 * ERR40 DEF *+1 ASC 16,DEFECTIVE CYLINDER - TRACK XXXX ER40A DEF ERR40+15 * MES33 DEF *+1 ASC 12,READY DISC AND PRESS RUN * MES32 DEF *+1 ASC 17,TURN OFF DISC PROTECT - PRESS RUN * END EQU * * END BEG0 * * END EQU * END BEG0 0ASMB,R,L,C HED SWTCH - DSEG5, 7905 DISK DRIVER SEGMENT NAM DSEG5,5,11 92060-16038 760715 SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 2 **************************************** * * NAME: DSEG5 * SOURCE: 92060-18038 * BINARY: 92060-16038 * WRITTEN BY: K. HAHN * **************************************** * * * ENTRY POINTS * ENT DISK5,STDS5 ENT INP5,INIT5 * * * EXTERNAL ENTRY POINTS * EXT MAINR EXT $LIBR,$LIBX EXT DFTR,DNTR,DNHD,DNSU,DNSP EXT TCH,TUNIT,DSBCH EXT CNVAS,CLEN,DSPLY,LINBL EXT LNGTH,BUFAD,XOUT,DSTAD EXT INITF EXT BOOTF * * A EQU 0 B EQU 1 SUP SKP BEG5 JMP MAINR SEGMENT'S ENTRY POINT * * INP5 OCT 041400 INITIALIZE ,WRITE PROTECT COMMAND BITS INIT5 OCT 001400 " " " FLGPT EQU INP5 FLGDF OCT 021400 FLGSP OCT 101400 * BADHD NOP BAD TRACKS HEADER FLAG * M17 OCT 17 M37 OCT 37 M177 OCT 177 M74C OCT 7400 M7700 OCT 177700 M1776 OCT 177600 * N10 DEC -10 * P1 DEC 1 P2 DEC 2 P4 DEC 4 P12 DEC 12 P14 DEC 14 P15 DEC 15 P16 DEC 16 P17 DEC 17 SKP * * INSERT CHNL NO. IN INSTRUCTION * * THE STDSK SUBROUTINE SETS THE CURRENT DISK CHANNEL * NOS. IN THE I/O INSTRUCTIONS. * * STDS5 NOP LDB HPDSK GET ADDR OF INSTRUCTION ADDR LIST LDA #DATA GET # INSTRUCTIONS TO CONFIGURE STA TEMP1 STDS1 LDA B,I GET INSTRUCTION AND M7700 ISOLATE INSTӷRUCTION CODE IOR TCH INSERT CHANNEL NO. STA B,I SET INSTRUCTION IN CODE INB INCR INSTRUCTION ADDRESS ISZ TEMP1 SKIP - ALL INSTRUCTIONS CONFIG. JMP STDS1 CONFIGURE NEXT INSTRUCTION * CCA SET NO HEADER STA BADHD FOR BAD TRACKS JMP STDS5,I RETURN * #DATA ABS I/OTB-I/OTC # DATA I/O INSTRUCTIONS HPDSK DEF I/OTB,I ADDRESS OF INSTRUCTIONS TEMP1 NOP SKP * THE DRIVER ENTERS HERE AFTER 10 TRIES HAVE FAILED TO INITILIZE A * TRACK. SPC 2 EOCYL JSB INTON LDB ERR43 ELSE SEND BAD SPECIFICATION LDA P14 JSB DSPLY MESSAGE AND JMP XOUT TERMINATE * INIER ISZ BADHD BAD TRACK HEADER PRINTED YET JMP INIES YES - SKIP * JSB LINBL LDA DSBCH CONVERT THE SUBCHANNEL TO ASCII CMA,INA LDB P1 STB CLEN LDB EMES1 JSB CNVAS LDA P12 LDB EMES2 SEND THE JSB DSPLY MESSAGE LDA P16 SEND THE SECOND LINE: LDB EMES3 " LOGICAL CYL HD UNIT" JSB DSPLY AND AWAY IT GOES. INIES LDA DCMND GET TRACK ADDRESS ALF,ALF RAL INBSP LDB ABTMS ADDRSS OF BAD TRACK JSB TRKMS SEND THE BAD TRACK NUMBERS * * TRACK IS NOW REPORTED TO THE OPERATOR * LDA DNSP GET THE # SPARES CPA UBADC OUT OF SPARES?? JMP EOCYL YES GO SEND ERROR 43 AND TERMINATE * LDA INITF SAVE THE CURRENT FLAG WORD STA TEMP1 LDA FLGDF SET TO FLAG DEFECTIVE STA INITF LDA DNTR GET BASE SPARE TRACK ADDRESS ADA UBADC ADD NUMBER USED SO FAR JSB DADTR GO TRANSLATE TO DISC ADDRESSES LDA PT#TR PICK UP THE CYL (B= HEAD) DST CYLA2 SET THE SPARES ADDRESS LDA DSTAD PICK UP TRACK TO BE FLAGGED LDB BUFAD GET CORE ADDRESS CLE SET TO WRITE JMP DISK~5+1 FLAG THE TRACK DEFECTIVE INIFS DLD CYLAD SET UP TO FLAG DST CYLA2 THE SPARE TRACK LDA FLGSP SET IOR TEMP1 POSSIBLY THE WRITE PROTECT BIT STA INITF THE SPARING FLAG LDA DNTR COMPUTE THE TRACK ADDRESS ADA UBADC AGAIN ALF,ALF TRANSLATE TO BITS 15-7 RAR CLE SET TO WRITE LDB BUFAD JMP DISK5+1 FLAG THE SPARE * * TRACK NOW SPARED REPORT WHICH SPARE USED * INIRS LDA UBADC REPORT THE LDB ASPMS USED SPARE JSB TRKMS OK LDA TEMP1 RESET THE INIT FLAG STA INITF AND ISZ UBADC STEP THE SPARE COUNTER JMP DISK5,I CONTINUE WRITING & INITIALIZING * * NIXSP LDA UBADC HERE IF SPARE IS BAD ISZ UBADC BUMP SPARE COUNT ADA DNTR COMPUTE UNIT TRACK# JMP INBSP GO REPORT BAD SPARE SKP * * REPORT BAD TRACK/ SPARE ROUTINE * * A = LOGICAL TRACK * B = ADDRESS OF FIRST 5 WORDS OF MESSAGE * PT#TR = CYL ADDRESS * H#AD = HEAD ADDRESS * UN#IT = UNIT ADDRESS * * JSB TRKMS * RETURN A,B MEANINGLESS * TRKMS NOP STB TRK01 SAVE THE ADDRESS CMA,INA SET UP TO CONVERT THE TRACK LDB P2 STB CLEN LDB ALBUF TO THE MESSAGE BUFFER JSB CNVAS DO IT LDA PT#TR NOW CONVERT CMA,INA THE CYL. # LDB ACYLM TO THE MESSAGE JSB CNVAS LDA H#AD CONVERT THE HEAD ALF,ALF ADA BL0 STA HEDMS SET IT IN THE MESSAGE LDA UN#IT NOW THE UNIT ADA BL0 STA UNIMS SET IN THE MESSAGE LDA N6 STA MOV6 COUNTER LDA TRK01 GET THE PREAMBLE LDB EMES4 AND STB TEMP2 MOVE LDB A,I MOVE IT TO THE STB TEMP2,I MESSAGE ISZ TEMP2 INA ISZ MOV6 JMP MOVE LDA P15 SEND LDB EMES4 "XXXXXXXXXX LLLLL ߊCCCCCC H U" JSB DSPLY TO THE TTY JMP TRKMS,I AND RETURN * MOV6 NOP N6 DEC -6 TEMP2 NOP TRK01 NOP ASPMS DEF SPMS ABTMS DEF BTMS ALBUF DEF TKMS ACYLM DEF CYLMS EMES4 DEF EMS4 EMES2 DEF *+1 ASC 11,BAD TRACKS SUBCHANNEL XX EMSS2 NOP LOCATION FOR XX EMES1 DEF EMSS2 BL0 ASC 1, 0 EMES3 DEF *+1 ASC 5, ASC 11, LOGICAL CYL HEAD UNIT EMS4 ASC 6,BAD TRACK TKMS ASC 3, CYLMS ASC 3, HEDMS ASC 2, UNIMS ASC 1, BTMS ASC 6,BAD TRACK SPMS ASC 6,SPARED TO ERR43 DEF *+1 ASC 14,INVALID DISC SPECIFICATIONS UBADC NOP # USED SPARES SKP HED MH RTGEN DISC DRIVE I/O INSTRUCTION ADDRESSES I/OTB DEF DSKDR DATA CHANNEL DEF DSK20 DEF DSK21 DEF DSK22 DEF DSK24 DEF DSK25 DEF DSK26 DEF DSK27 DEF DSK28 DEF DSK29 DEF DSK30 I/OTC EQU * * * OCT 112400 END COMMAND (WAITS FOR ATTN.) WA#KE OCT 113000 PT#SK OCT 101200 PT#TR NOP H#AD NOP PT#AD OCT 106000 PT#T2 NOP PT#H2 NOP OCT 107404 FILE MASK R#DCM OCT 102400 P#EN OCT 101400 STATUS COMMAND DSKDR ABS 0 DMA CON WORD HED 7905 I/O DISC DRIVER * THE DISKD SUBROUTINE IS THE MAIN DISC INPUT/OUTPUT DRIVER. * IT SETS UP THE COMPLETE TRANSFER AND READS OR WRITES * LNGTH WORDS ON THE DISC. IT WAITS UNTIL THE TRANSFER * IS COMPLETE. STATUS IS DONE AFTER EACH TRANSFER FOR WRITE * PROTECT ERRORS THE OPERATOR IS ASKED TO TURN ON THE SWITCH. * FOR UNDEFINED ERRORS OR ERRORS THAT SHOULD NOT HAPPEN SUCH AS * DEFECTIVE CYLINDER ERRORS THE IRRECOVERABLE ERROR ERR40 IS * TAKEN. FOR NOT READY ERRORS THE OPERATOR IS NOTIFIED. * FOR OTHER ERRORS TEN TRIES ARE MADE. IF THE ERROR STILL EXIST * AND: * * A - IF THE INIT FLAG IS SET GO TO EOCYL * * B - ELSE NOTIFY OPERATOR AND TERMINATE * * CALLING SEQUENCE * LNGTH = NEGATIVE # WORDS TO TRANSMIT * A = DISK ADDRESSM -ON A 64 WORD/SECTOR BASIS - * B = CORE ADDRESS * E = 1 FOR READ * E = 0 FOR WRITE * * RETURN - ALWAYS NORMAL--REGS. MEANINGLESS SPC 3 DISK5 NOP RBL,ERB SET THE READ/WRITE BIT STB MADDR AND SAVE THE ADDRESS STA DCMND DO TRACK MAPPING AND M177 ISOLATE SECTOR STA SECT1 SAVE XOR DCMND ISOLATE THE TRACK CLE,ELA ALF,ALF ROTATE TRACK TO LOW A JSB DADTR TRANSLATE THE TRACK ADDRESS LDB #UNST SET # TO CONFIGURE COUNTER STB UNCOU LDB UNITC GET UNIT CONFIGURE ADDRESS NXUN XOR B,I AND CONFIGURE THE UNIT NUMBERS AND M17 OF COURSE THIS XOR B,I CODE WORKS STA B,I INB ISZ UNCOU DONE? JMP NXUN NO TRY AGAIN * LDA WRTCM GET THE WRITE COMMAND ADA INITF ADD THE INIT CODE STA W#CMD AND SET IT LDA PT#TR GET THE CYLINDER LDB SECT1 SECTOR BRS ADJUST OUT THE 64 WORD JASS ADB H#AD PUT IN THE HEAD DST CYLAD SET THE SEEK ADDRESSES LDA INITF GET THE INIT CODE AND M137 MAY BE WRITE PROTECTING CPA FLGSP IF SPARING OR RSS DOING A DEFECTIVE TRICK CPA FLGDF THEN JMP OFF SKIP THE SECOND ADDRESS SET UP * LDA CYLAD ELSE DST CYLA2 SET UP THE ADDRESS RECORD COMMAND * OFF JSB $LIBR KILL THE INTERRUPT SYSTEM NOP CLF 0 * RTRY LDA N10 SET THE ERROR STA EDCNT COUNTER TO 10 TRIES OVER JSB STATW GET STATUS RBR,SLB,RBL READY? JMP NRERR NO SO LONG * SLB IF DRIVE BUSY JMP OVER WAIT FOR IT * LDB MADDR GET THE CORE ADDRESS LDA R#DCM PRESET FOR READ SSB,RSS WRITE? LDA W#CMD YES RESET TO WRITE * JSB XFER STANDARD TRANSFER DEF WAITC-1 ADDRESS OF COMMAND TABLE DEF R/WCM ADDRESS OF END OF TABLE CKSTA ADA CTABA INDEX WITH STATUS INTO JMP A,I STATUS XFER TABLE * * CTABA DEF *+1 CODE ERROR DISPOSITION JMP ENDOK 00 NO ERROR - TEST FOR VERIFY JSB FAULT 01 ILLEGAL OP - PROGRAM FAULT JSB FAULT 02 UNIT AVAIL. PROGRAM FAULT JSB FAULT 03 UNIMPLEMENTED ERROR CODE - FAULT JSB FAULT 04 " " " " JSB FAULT 05 " " " " JSB FAULT 06 " " " " JMP RECAL 07 CYL COMPARE TRY TO RECAL. JMP ERRDS 10 PARITY ERROR TRY AGAIN JMP EOCYL 11 HEAD/SECTOR? RESTART ERR43 JSB FAULT 12 I/O PROGRAM (WHO? ME?) PROGRAM FAULT JSB FAULT 13 UNIMPLEMENTED ERROR CODE - FAULT JMP EOCYL 14 END OF CYL. BAD # SECT/TRK ERR43,RESTART JSB FAULT 15 UNIMPLEMENTED ERROR CODE - FAULT JMP ERRDS 16 OVER RUN JUST RETRY JMP ERRDS 17 CORRECTABLE ERROR DON'T EVEN TRY JSB FAULT 20 ILLEGAL SPARE - FAULT JSB FAULT 21 DEFECTIVE TRACK - FAULT JMP ST2ER 22 ACCESS NOT READY - STATUS 2 ERROR JMP ST2ER 23 STATUS 2 GO CHECK JSB FAULT 24 UNIMPLEMENTED ERROR CODE - FAULT JSB FAULT 25 " " " " JMP ST2ER 26 ILLEGAL WRITE TEST ST 2 JMP UWAIT 27 WAIT FOR THE UNIT. SPC 2 * * ERRDS ISZ EDCNT STEP OPERATION ERROR COUNT JMP OVER OK TRY AGAIN * LDA INITF IF DOING INIT SZA,RSS THEN MAY DO SPARING JMP DSKER NOT INIT JSB INTON CPA INIT5 INIT ONLY? RSS CPA INP5 INIT,WRITE PROTECT? JMP INIER YES, GO SPARE IT CPA FLGDF IF TRACK IS BEING SET JMP INIFS DEFECTIVE AND M137 CPA FLGSP IF TRACK IS BEING SPARED JMP NIXSP RSS SKIP INTON CALL * DSKER JSB INTON LDA DCMND  ERROR MESSAGE CONTAINING THE AND M1776 TRACK # ALF,ALF RAL CMA,INA LDB P2 STB CLEN LDB ER22A JSB CNVAS LDA P16 LDB ERR22 JSB DSPLY "PARITY OR DATA ERROR TRACK XXXX" JMP XOUT SPC 3 * STATUS-2 ERROR POSSIBLE CONDITIONS ARE: * NO ERROR SO JUST RETRY AT ERRDS * NOT READY GO TO NRERR TO WAKE HIM UP * PROTECTED SEND TURN ON THE SWITCH MESSAGE * ST2ER LDA INITF CHECK IF WE WERE INITIALIZING SZA,RSS JMP ST2 NO * LDA B STATUS -2 TO A AND M40 KEEP FORMAT BITS SZA,RSS SET?? JMP WRPTM TURN ON FORMAT SWITCHH LDA B GET STATUS -2 AGAIN AND M100 GET PROTECTED BIT SZA JMP WRPTM TURN OFF THE WRITE PROTEC * ST2 SSB,RSS IF NO STATUS 2 ERROR JMP ERRDS JUST COUNT IT AND TRY AGAIN * LDA B GET THE STATUS WORD AGAIN AND P4 ISOLATE THE SEEK CHECK BIT SZA IF SET THEN WE HAVE A BAD ADDRESS JMP EOCYL SO TERMINATET THE GEN. * JMP NRERR MUST BE NOT READY * WRPTM STA TEMP2 SAVE BITS OF STATUS-2 JSB INTON JSB LINBL WRITE PROTECT SWITCH IS LDA TEMP2 RETRIEVE THOSE BITS LDB MES34 "TURN ON FORMAT SWITCH - PRESS RUN" SZA LDB MES32 "TURN OFF DISK PROTECT - PRESS RUN" LDA P17 JSB DSPLY * JSB $LIBR OFF THE INTERRUPTS FOR A HALT NOP CLF 0 HLT 32B WAIT FOR TURN ON JMP RTRY TRY AGAIN. SPC 1 NRERR JSB INTON JSB LINBL DISC IS NOT READY LDA P12 LDB MES33 SEND THE WORD TO THE MAN JSB DSPLY "READY DISC AND PRESS RUN" * JSB $LIBR OFF THE INTERRUPTS FOR A HALT NOP CLF 0 LDA STATB HLT 33B PAUSE JMP RTRY ON RESTART RETRY SPC 1 * FAULT NOP ENTRY FOR TRACE BACK ONLY JSB INTON TURN ON INTERRUPTS FOR MESSAGE LDA DCMND AND M1776 INSERT TRACK # IN IT ALF,ALF RAL CMA,INA LDB P2 STB CLEN LDB ER40A JSB CNVAS LDA P16 LDB ERR40 JSB DSPLY "DEFECTIVE CYLINDER - TRACK XXX" JMP XOUT TERMINATE SPC 1 ERR40 DEF *+1 ASC 16,DEFECTIVE CYLINDER - TRACK XXXX ER40A DEF ERR40+15 WRTCM OCT 4000 ENDC OCT 12400 VERCM OCT 3400 CALC OCT 600 WAITX OCT 13000 M40 OCT 40 M100 OCT 100 M137 OCT 137777 UN#IT NOP * SPC 3 * * INTON TURNS THE INTERRUPT SYSTEM BACK ON * INTON NOP DSK30 CLF 0 CLC 6 JSB $LIBX DEF INTON SPC 3 * UWAIT WAIT FOR UNIT TO BECOME AVAILABLE * * UWAIT LDA WAITX SEND THE WAIT UWAT1 JSB OUTCC COMMAND JSB WAITF AND WAIT JMP OVER OK NOW TRY IT * SPC 3 * * RECAL RECALIBRATE THE DISC ON CYLINDER COMPARE ERRORS * RECAL ISZ EDCNT CHECK COUNT RSS JMP DSKER LDA CALC GET COMMAND JMP UWAT1 GO SEND IT SPC 3 * * ENDOK AFTER A SUCCESFUL TRANSFER WE MUST DO AND END * TO ALLOW OTHER CPU'S TO ACCESS THE CONTROLLER. * ALSO IF DOING INITIALIZE AND NOT FLAGGING DEFECTIVE DO * A VERIFY TO CHECK FOR ERRORS. * * ENDOK LDA INITF GET THE INIT FLAG SZA,RSS IF CLEAR JMP ENDSX JUST GO SEND THE END * RAL,SLA IF SPARING JMP SPARA GP SET UP SPARE ADDRESS * RAL,SLA IF JUST PROTECTING JMP STDAD USE STANDARD ADDRESS * RAL,SLA IF FLAGING DEFECTIVE JMP ENDSX DON'T EVEN CHECK * STDAD LDB LNGTH EITHER STRAIGHT INIT. OR CMB,INB PROTECT LSR 7 SET UP THE STB VERCO SECTOR COUNT LDA VERCM SEND VER3IFY COMMAND JSB XFER AND GO DEF WAITC-1 DO IT DEF VERCO SZA ANY ERROR IS JMP ERRDS BAD NEWS * ENDSX LDA ENDC GET THE END COMMAND JSB OUTCC SEND IT LDA BOOTF ARE WE BOOTIN UP? SZA,RSS YES, SO GO DO IT! JMP ENDBR NO STF 6 CLC 0,C LDA M2055,I GET STARTING ADDRESS ADA P4 SKIP: STF 6, CLC 0,C, HLT 77 LDB M1742 DETERMINE IF WE'RE IN AN CPB P2 RTE-II OR AN RTE-III RSS MUST DISABLE MAPPING FOR RTE-III JMP A,I GO TO RTE! DJP A,I WELL SAID! * M2055 OCT 2055 M1742 EQU 1742B * ENDBR JSB INTON LDA INITF CPA FLGDF BRANCH APPROPRIATELY, JMP INIFS FLAGGING DEFECTIVE AND M137 CPA FLGSP JMP INIRS FLAGGING A SPARE JMP DISK5,I AND EXIT * * SPARA SETS ADDRESSES TO VERIFY A SPARE TRACK * SPARA DLD CYLA2 USE THE REAL DST CYLAD ADDRESS FOR SEEK JMP STDAD GO TRY THE VERIFY SKP * * * XFER THE TRANSFER ROUTINE * DOES DMA SET UP,AND SENDS A SERIES OF WORDS TO THE DISC * CONTROLLER. THEN STATUS IS DONE USING STATW. * * CALLING SEQUENCE: * * A= COMMAND FOR THE XFER READ/WRITE INIT ETC. * B= ADDRESS WITH DIRECTION BIT SET FOR DMA * JSB XFER * DEF COMMAND LIST * DEF LAST COMMAND (ALSO DMA COMMAND) * * XFER NOP STA R/WCM SET THE READ WRITE COMMAND LDA DSKDR SET UP THE OTA 6 DMA CLC 2 OTB 2 STC 2 LDA LNGTH OTA 2 LDB XFER,I GET THE HEAD OF THE LIST ISZ XFER STEP TO THE END ADDRESS NXTC INB STEP TO THE FIRST COMMAND LDA B,I GET THE WORD CPA R/WCM IF ACTION COMMAND CCE,RSS SKIP TO THE CLC RAL,CLE,SLA,ERA ELSE CLEAR THE SIGN AND IF SET DSK20 CLC 0 TELL THE CONTROLLER IT IS A COMMAND DSK21 OTA 0,C SEND THE WORD CPB XFER,I IF THIS IS THE ACTION WORD STC 6,C START THE DMA DSK22 STC 0 AND THE CONTROLLER SEZ IF NOT A COMMAND SKIP THE FLAG WAIT JSB WAITF WAIT FOR THE FLAG STF 6 STOP THE DMA CPB XFER,I DONE? RSS YES SKIP JMP NXTC NO GO DO THE NEXT ONE * JSB WAITF THIS WAIT IS ONLY NEEDED FOR VERIFY ISZ XFER STEP TO EXIT ADDRESS JSB STATW GET THE STATUS WORDS JMP XFER,I AND GET OUT * * * XFER COMMAND TABLE * WAITC OCT 113000 SEEKC OCT 101200 MUST CONFIGURE TO UNIT CYLAD NOP CYLINDER ADDRESS HDSCT NOP HEAD AND SECTOR ADRES OCT 106000 NEEDS UNIT CYLA2 NOP CYLINDER ADDRESS FOR ADDRESS RECORD HDSC2 NOP FILMK OCT 107404 FILE MASK/SPARING ONLY R/WCM OCT 102400 READ/WRIT COMMAND VERCO NOP VERIFY COUNT * * END OF LIST * * UNIT CONFIGURE LIST * UNITC DEF *+1,I DEF WAITX DEF WA#KE DEF SEEKC DEF VERCM DEF CALC DEF ADRES DEF R/WCM DEF STACC DEF WRTCM DEF R#DCM DEF PT#SK DEF PT#AD DEF P#EN #UNST ABS UNITC-*+1 NUMBER IN THE LIST SKP * * * DADTR ROUTINE TO TRANSLATE A TRACK ADDRESS INTO CYL,HEAD * UNIT TO BE STORED AT: * * CYL AT: PT#TR * HEAD AT: H#AD ALSO RETURNED IN B. * UNIT AT: UN#IT ALSO RETURNED IN A. * * CALLING SEQUENCE: * * LDA TRACK SET TRACK ADDRESS IN A. * JSB DADTR CALL * * DADTR NOP CLB DIVIDE # TRACKS BY DIV DNSU NUMBER OF HEADS/CYL ADA DFTR ADD BASE CYLINDER ADDRESS STA PT#TR SET THE CYLINDER ADDRESS ADB DNHD ADD THE BASE HEAD ADDRESS BLF,BLF PUT HEAD ADDRESS IN IT'S PLACE LDA B B@< PUT INTO A TO AND M74C ISOLATE STA H#AD STORE IT AS PROMISED SWP GET UNIT FROM LOW B LDA TUNIT STA UN#IT STORE IT AS PROMISED JMP DADTR,I RETURN A= UNIT, B=HEAD SKP * * STATW RETURNS STATUS AS FOLLOWS: * * STATB FULL STATUS 1 WORD * A ERROR CODE (MAX=27) FROM STATUS 1 * B STATUS 2 WORD * * STATW NOP LDA STACC GET STATUS COMMAND JSB OUTCC SEND IT JSB WAITF WAIT FOR FLAG DSK24 LIA 0,C GET WORD 1 JSB WAITF WAIT FOR FLAG DSK25 LIB 0,C GET WORD 2 STA STATB SAVE WORD 1 ALF,ALF ROTATE AND M37 ISOLATE CPA M37 ATTENTION? JMP STATW+1 YES TRY AGAIN * JMP STATW,I NO - RETURN SPC 3 * * * OUTCC OUTPUT A COMMAND WORD * OUTCC NOP DSK26 CLC 0 SEND "HERE COME DE WORD" DSK27 OTA 0,C SEND DE WORD DSK28 STC 0 SET UP IN CASE IT IS NEEDED JMP OUTCC,I RETURN SPC 3 * * * WAITF WAITS FOR A FLAG * WAITF NOP DSK29 SFS 0 HERE YET JMP *-1 NO KEEP TRYING * JMP WAITF,I YES RETURN SPC 3 * * STACC OCT 1400 MADDR NOP MEMORY ADDRESS FOR CURRENT TRANSFER UNCOU NOP DCMND NOP DISC ADDRESS FOR CURRENT TRANSFER EDCNT NOP ERROR COUNT FOR CURRENT TRANSFER SECT1 NOP STATB NOP W#CMD NOP MES32 DEF *+1 ASC 17,TURN OFF DISC PROTECT - PRESS RUN MES34 DEF *+1 ASC 17,TURN ON FORMAT SWITCH - PRESS RUN MES33 DEF *+1 ASC 12,READY DISC AND PRESS RUN ERR22 DEF *+1 ASC 16,PARITY OR DATA ERROR TRACK XXXX ER22A DEF ERR22+15 * * END EQU * END BEG5 B \K 92060-18039 1704 S C0222 &SAVE DISC SAVE PROGRAM             H0102 ŦASMB,R,L,C * NAME: SAVE * SOURCE: 92060-18039 * RELOC: 92060-16039 * PGMR: S.P.K. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM SAVE,3,99 92060-16039 REV.1704 770117 * DISC TO MAG TAPE DATA TRANSFER EXT DMT,RMPAR,COR.A,EXEC,BUFER,ITASK SAVE JSB RMPAR GET PARAMETERS DEF *+2 DEF IP CLA STA ITASK TASK=0 FOR SAVE JSB BUFER ROUTINE TO FIND FWA IN FREE MEM OF PARTITION DEF FWA AND TO DETERMINE # OF WORDS IN AVMEM DEF PLEN DEF BFLEN # OF WORDS IN AVMEM * LDA FWA INA STA ITR SET UP VERIABLE FOR TRACK # INA STA JB ADDRESS FOR READ BUFFER JSB DMT GO TO MAIN DISC TO MAG TAPE ROUTINE DEF *+8 DEF FWA,I ADDR OF WRITE BUFFER - KB DEF JB,I ADDR OF READ BUFFER - JB DEF PLEN LENGTH OF PPARTITION DEF BFLEN # OF WORDS IN AVMEM DEF IP BUFFER WITH PARAMETERS DEF ITR,I ADDR OF TRACK # - ITR DEF FWA,I ADDR OF SUBCHNL # - ISUB JSB EXEC END OF SAVE PROGRAM DEF *+2 DEF D6 * A EQU 0 B EQU 1 IP BSS 5 ITR BSS 1 JB BSS 1 FWA BSS 1 PLEN BSS 1 BFLEN BSS 1 D6 DEC 6 END SAVE FTN4,L C NAME: DMT C SOURCE: 92060-18039 C RELOC: 92060-16039 C PGMR: S.P.K. C C *************************************************************** C * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * C * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * C * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* C * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C *************************************************************** C SUBROUTINE DMT (KB,JB,IPLEN,IBLEN,IP,ITR,ISUB) DIMENSION IP(5),KB(1),JB(1),ILUTR(64), C IHDR(140),INAME(3),IREG(2),ICHAR2(2),ITITL(4) EXTERNAL MESG,MPFND,ASCDC,DCASC,SUB,CHDLU,TPPOS, C CHUTP,LUTRK,PRNTH,MEMGT,READU EQUIVALENCE (REG,IA,IREG),(IREG(2),IB),(INAME,NAME1), C (INAME(2),NAME2),(INAME(3),NAME3),(IHDR(37),ITAPE), C (IHDR(39),ITPSV),(IHDR(40),LU2),(IHDR(42),IREC), C (IHDR(43),ITB30) DATA ITITL/2HFI,2HLE,2H I,2HD?/,IHDR(41)/0/, C ISIGN/100000B/,IVERFY/0/,IQUES/2H??/ CALL EXEC (22,3) ITLU=IP CALL MEMGT (1653B,LUMAX) IF ((ITLU.LE.0).OR.(ITLU.GT.LUMAX)) ITLU=1 LP=IP(2) IMLU=IP(4) IDTYP=IP(5) IF (IBLEN.LT.2050) GO TO 770 IF (IPLEN.EQ.-1) CALL MESG (ITLU,27) IF (IBLEN.LT.6146) GO TO 5 IF (IPLEN.EQ.0) CALL MESG (ITLU,3) CALL MESG (ITLU,2) CALL READU (ITLU,IYES,1) IF (IYES.NEQ.2HYE) GO TO 5 ISIZE=6144 INCR=96 IREC=1 IF (IPLEN.EQ.1) GO TO 8 GO TO 9 5 ISIZE=2048 INCR=32 IREC=0 IF (IPLEN.EQ.-1) GO TO 9 8 CALL MESG (ITLU,0) CALL READU (ITLU,IVERFY,1) C CHECK IF LOGICAL OR PHYSICAL COPY 9 IF (LP) 10,100,10 C CHECK IF PROPER UNIT # SPECIFIED FOR PHYSICAL COPY 10 IUNIT=IP(3) ITPSV=2 CALL CHUTP(ITLU,IUNIT,IDTYP) GO TO 110 C LOGICAL COPY TO BE DONE C /CHECK IF IDLU IS FOR DISC UNITS ONLY 100 IDLU=IP(3) ITPSV=1 CALL CHDLU(ITLU,IDLU,ISUB,IDTYP) 110 NAME3=2H1 IF (IDTYP.EQ.7905) NAME3=2H2 CALL MPFND(INAME,ITLU,IDTYP,ITB30,JB) IHDR(38)=IDTYP IF (IDTYP.EQ.7905) GO TO 140 MPST=43 IF (ITB30.LT.0) MPST=44 GO TO 150 140 MPST=44 IF (IHDR(44).LT.0) MPST=45 C CHECK IF IMLU IS FOR MAG TAPE UNIT ONLY 150 IF ((IMLU.LT.0).OR.(IMLU.GT.LUMAX)) GO TO 580 IF (IMLU.EQ.0) IMLU=8 CALL EXEC (13,IMLU,IEQT5) IF (IAND(IEQT5,37000B)-11000B) 580,155,580 C REQUEST A MAG TAPE LU LOCK W/OUT WAIT & NO-ABORT 155 CALL LURQ (140001B,IMLU,1) IF (IA.EQ.0) GO TO 160 C MT LU LOCK WAS NOT SUCCESSFUL, TELL USER CALL MESG (ITLU,25) C REQUEST MT LU LOCK WITH WAIT CALL LURQ (1,IMLU,1) C WRITE RING IN THE MAG TAPE? 160 REG=EXEC(3,600B+IMLU) IF (IAND(IA,4B).EQ.4B) GO TO 750 CALL EXEC (2,ITLU,ITITL,4) 165 DO 170 ITRY = 1,36 IHDR(ITRY)=2H 170 CONTINUE REG = EXEC (1,ITLU+400B,IHDR,36) IF (IB.NEQ.0) GO TO 180 CALL EXEC (2,ITLU,IQUES,1) GO TO 165 180 IF (LP.EQ.0) GO TO 250 C C BUILD LU-# OF TRACKS TABLE FOR SOURCE DISC USING TRACK MAP INFO C LUFLG=1 CALL LUTRK(ITLU,LIMIT,IUNIT,IDTYP,IHDR,MPST,ILUTR,LUFLG,IEQT) LU2=LUFLG GO TO 300 C BUILD ILUTR TABLE FOR LP=0 250 ILUTR=IDLU ILUTR(2)=IHDR(MPST+ISUB+8) IF (IDTYP.EQ.7905) ILUTR(2)=IHDR(MPST+ISUB*3+2) LIMIT=1 LU2=0 IF (IDLU.EQ.2) LU2=1 C POSITION TAPE TO DESIRED FILE # AND WRITE HEADER RECORD ON TAPE 300 IFILE=0 ITAPE=1 CALL TPPOS(ITLU,IMLU,IFILE,ITAPE) CALL EXEC(2,IMLU,IHDR,140) C C START DATA TRANSFER FROM DISC TO MAG TAPE USING ILUTR TABLE C DO 410 ILU=1,LIMIT,2 IDLU=ILUTR(ILU) ILT=ILUTR(ILU+1)-1 CALL SUB (IDLU,ISUB) DO 400 ITR=0,ILT DO 390 ISEC=0,95,INCR c ITRY=1 335 REG= EXEC (1,IDLU,JB,ISIZE,ITR,ISEC) IF (IB.EQ.ISIZE) GO TO 337 IF (ITRY.EQ.7) GO TO 680 ITRY=ITRY+1 GO TO 335 337 REG=EXEC(3,600B+IDLU) IF (IDTYP.EQ.7905) GO TO 340 IF (IAND(IA,10B)-10B) 350,345,350 340 IF (IAND(IA,20B).NEQ.20B) GO TO 350 345 ISUB=ISUB+ISIGN 350 REG=EXEC(3,600B+IMLU) 353 IF (IAND(IA,40B).EQ.40B) GO TO 650 354 ITRY=1 355 REG= EXEC (2,IMLU,KB,ISIZE+2) 390 CONTINUE 400 CONTINUE 410 CONTINUE 450 ENDFILE IMLU C C VERIFY WANTED? C IF (IVERFY.NEQ.2HYE) GO TO 500 C YES, PASS ILUTR TABLE TO SAM USING CLASS I/O CALL CALL EXEC(20,0,ILUTR,64,IDUMY,JDUMY,ICLAS) NAME1=2HVE NAME2=2HRF NAME3=2HY C POSITION MAG TAPE TO BEGINING OF FILE ON TAPE 1 IF (ITAPE.EQ.1) GO TO 470 JTAPE=ITAPE 460 CALL MESG (ITLU,24) CALL MESG (ITLU,11) REWIND IMLU PAUSE CALL TPPOS(ITLU,IMLU,IFILE,JTAPE) CALL PRNTH(ITLU,IMLU,KB) IF (KB.EQ.-1) GO TO 460 GO TO 480 470 CALL TPPOS(ITLU,IMLU,IFILE,ITAPE) CALL EXEC (1,IMLU,KB,140) C UNLOCK MAG TAPE LU 480 CALL LURQ (0,IMLU,1) C SCHEDULE VERFY PROGRAM WITH WAIT CALL EXEC (23,INAME,ITLU,ICLAS,LIMIT,IMLU,IREC) 500 REWIND IMLU STOP 580 CALL MESG (ITLU,8) CALL READU (ITLU,ICHAR,1) CALL ASCDC (ICHAR,1,IMLU) GO TO 150 650 CALL MESG (ITLU,12) CALL MESG (ITLU,11) REWIND IMLU CALL EXEC (7) ITAPE=ITAPE+1 CALL EXEC (2,IMLU,IHDR,140) GO TO 354 680 CALL MESG (ITLU,13) CALL DCASC (ICHAR2,2,ITR) CALL EXEC (2,ITLU,ICHAR2,2) CALL DCASC(ICHAR,1,IDLU) CALL EXEC (2,ITLU,ICHAR,1) 695 CALL MESG (ITLU,14) STOP 750 CALL MESG(ITLU,10) CALL MESG (ITLU,11) CALL EXEC (7) GO TO 160 770 CALL MESG (ITLU,1) GO TO 695 END END$  ^ i 92060-18040 1704 S C0222 & RESTR DISC RESTORE PROGRAM             H0102 +ASMB,R,L,C * NAME: RSTOR * SOURCE: 92060-18040 * RELOC: 92060-16040 * PGMR: S.P.K. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM RSTOR,3,99 92060-16040 REV.1704 770117 * MAG TAPE TO DISC DATA TRANSFER EXT MTD,BUFER,RMPAR,EXEC,ITASK RSTOR JSB RMPAR GET PARAMETERS PASSED BY USER DEF *+2 DEF IP CLA,INA STA ITASK TASK=1 FOR RESTORE JSB BUFER GET FWA OF AVMEM IN PARTITION & # WORDS IN AVMEM DEF FWA ADDRESS OF FWA IN AVMEM DEF PLEN DEF BFLEN # OF WORDS IN AVMEM LDA FWA INA STA ITR SET UP VARIABLES USED BY MTD ROUTINE INA STA JB BUFFER TO WRITE ON DISC ADA D98 STA ILUTR LU-#TRCKS TABLE AT KB(101) LDA FWA BUFFER FOR HEADER REC IS PLACED IN LAST 140 WORDS ADA BFLEN OF PARTITION ADA N140 FWA+BFLEN-140 STA IHDR ADA D37 IHDR(38) STA IDTP1 IDTYP1 INA STA ITPSV IHDR(39)-TYPE OF SAVE INA STA LU2 IHDR(40)-LU2 INVOLVED IN SAVE? ADA D2 IHDR(42)-REC SIZE OF SAVED DATA STA RSIZE ADA D33 STA ILUTB IHDR(75)-COPY OF LU-#TRCKS TABLE JSB MTD GO TO MAIN RESTORE ROUTINE DEF *+15 DEF FWA,I KB DEF PLEN LENGTH OF PARTITION DEF BFLEN # WORDS IN AVMEM DEF JB,I JB DEF ITR,I ITR DEF FWA,I ITB30 DEF ILUTR,I ILUTR DEF IHDR,I IHDR DEF IDTP1,I IDTYP1 DEF ITPSV,I ITPSV DEF LU2,I LU2 DEF RS  IZE,I RECORD SIZE-IREC DEF ILUTB,I ILUTB DEF IP PARAMETER LIST JSB EXEC END RSTOR DEF *+2 DEF D6 * FWA BSS 1 PLEN BSS 1 BFLEN BSS 1 JB BSS 1 ITR BSS 1 ILUTR BSS 1 IHDR BSS 1 IDTP1 BSS 1 ITPSV BSS 1 LU2 BSS 1 RSIZE BSS 1 ILUTB BSS 1 IP BSS 5 D2 DEC 2 D6 DEC 6 D33 DEC 33 D37 DEC 37 D98 DEC 98 N140 DEC -140 END RSTOR Lb FTN4,L C NAME: MTD C SOURCE: 92060-18040 C RELOC: 92060-16040 C PGMR: S.P.K. C C *************************************************************** C * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * C * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * C * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* C * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C *************************************************************** C SUBROUTINE MTD(KB,IPLEN,IBLEN,JB,ITR,ITB30,ILUTR,IHDR,IDTYP1, C ITPSV,LU2,IREC,ILUTB,IP) DIMENSION IP(5),KB(1),JB(1),ILUTR(1),IHDR(1),INAME(3), C IREG(2),ICHAR2(2),ITB30(1),ILUTB(1) EXTERNAL MPFND,ASCDC,DCASC,MESG,READU,CHUTP, C CHDLU,MATCH,LUTRK,TPPOS,PRNTH,MEMGT EQUIVALENCE (IREG(1),IA,REG),(IREG(2),IB),(INAME,NAME1), C (INAME(2),NAME2),(INAME(3),NAME3) DATA IVERFY/0/ C CHECK IF PROPER LOG DEVICE CALL EXEC (22,3) ITLU=IP CALL MEMGT (1653B,LUMAX) IF ((ITLU.LE.0).OR.(ITLU.GT.LUMAX)) ITLU=1 LP=IP(2) IMLU=IP(3) IDTYP2=IP(5) C CHECK IF IMLU IS FOR MAG TAPE UNIT ONLY 1 IF ((IMLU.LT.0).OR.(IMLU.GT.LUMAX)) GO TO 580 IF (IMLU.EQ.0) IMLU=8 CALL EXEC (13,IMLU,IEQT5) IF (IAND(IEQT5,37000B).NEQ.11000B) GO TO 580 C REQUEST LU LOCK FOR MT WITHOUT WAIT & WITH NO-ABORT CALL LURQ(140001B,IMLU,1) IF (IA.EQ.0) GO TO 2 C LU LOCK WAS NOT SUCCESSFUL- TELL USER CALL MESG (ITLU,25) C REQUEST LU LOCK WITH WAIT CALL LURQ (1,IMLU,1) 2 IFILE=0 CALL TPPOS (ITLU,IMLU,IFILE,ITAPE) CALL PRNTH (ITLU,IMLU,IHDR) IF (IHDR.EQ.-1) GO TO 2 IF (LP.NEQ.0) LP=1 IF (ITPSV.LT.0) GO TO 790 IF (ITPSV.NEQ.(LP+1)) GO TO 770 IF (IBLEN.LT.2150) GO TO 800 IF (IPLEN.EQ.-1) CALL MESG (ITLU,27) IF (IBLEN.GE.6246) GO TO 4 IF (IREC.EQ.|1) GO TO 800 3 ISIZE=2048 INCR=32 GO TO 5 4 IF (IREC.EQ.0) GO TO 3 ISIZE=6144 INCR=96 IF (IPLEN.EQ.1) GO TO 5 IF (IPLEN.EQ.0) CALL MESG (ITLU,3) GO TO 8 5 IF (IPLEN.EQ.-1) GO TO 8 CALL MESG(ITLU,0) CALL READU(ITLU,IVERFY,1) C CHECK IF LOGICAL OR PHYSICAL COPY 8 IF (LP.EQ.0) GO TO 100 C CHECK IF PROPER DRIVE NUMBER SPECIFIED FOR PHYSICAL RESTORE 10 IUNIT2=IP(4) CALL CHUTP(ITLU,IUNIT2,IDTYP2) GO TO 120 C LOGICAL RESTORE TO BE DONE C CHECK IF IDLU IS FOR DISC UNITS ONLY 100 IDLU=IP(4) CALL CHDLU(ITLU,IDLU,ISUB2,IDTYP2) 120 NAME3=2H1 IF (IDTYP2.EQ.7905) NAME3=2H2 130 CALL MPFND(INAME,ITLU,IDTYP2,ITB30,JB) IF (IDTYP2.EQ.7905) GO TO 140 MPST2=1 IF (ITB30.LT.0) MPST2=2 GO TO 150 140 MPST2=2 IF (ITB30(2).LT.0) MPST2=3 C C READ INFO FROM HEADER RECORD C 150 ITAPE=IHDR(37) IF ((LU2.EQ.1).AND.(IDTYP1.NEQ.IDTYP2)) GO TO 750 C FIND THE START ADDRESS OF TRACK MAP TABLE OF SOURCE DISC 180 IF (IDTYP1.EQ.7905) GO TO 190 MPST1=43 IF (IHDR(43).LT.0) MPST1=44 GO TO 200 190 MPST1=44 IF (IHDR(44).LT.0) MPST1=45 C READ FIRST DATA RECORD FROM TAPE TO FIND UNIT # OF SURCE DISC 200 CALL EXEC (1,IMLU,ISUB1,1) BACKSPACE IMLU C C FIND UNIT# OF SOURCE DISC C ISUB1=IAND(ISUB1,77777B) IF (IDTYP1.EQ.7905) GO TO 210 IUNIT1=ISUB1/2 GO TO 215 210 NSUB=-IHDR(MPST1-1) IUNIT1=IAND(IHDR(MPST1+ISUB1*3+1),17B) 215 IF (LP.EQ.0) GO TO 230 C C BUILD LU-#TRACKS TABLE FOR DESTINATION DISC UNIT C 220 LUFLG=1 CALL LUTRK (ITLU,LIMIT,IUNIT2,IDTYP2,ITB30,MPST2,ILUTR,LUFLG, C IEQT) GO TO 250 C BUILD ILUTR TABLE FOR LP=0 CASE (NEEDS ENTRIES FOR ONLY 1 LU) 230 ILUTR=IDLU IF (IDTYP2.EQ.7905) GO TO 240 ILUTR(2)=ITB30(MPST2+ISUB2+8) GO TO 245 240 ILUTR(2)=ITB30(MPST2+ISUB2*3+2) 245 LIMIT=1 250 IF ((LU2.EQ.0).OR.(LP.EQ.0)) GO TO 260 C MATCH THE TRACK MAP INFO. FOR DESTINATION AND SOURCE UNITS C CALL MATCH (ITLU,IDTYP1,IEQT,IUNIT1,IUNIT2,MPST1,MPST2,IHDR, C ITB30,ILUTR) C C BUILD # TRACKS TABLE FOR SOURCE DISC C 260 IF (IDTYP1.EQ.7905) GO TO 270 IF (LP.EQ.1) GO TO 265 IHDR(43)=IHDR(MPST1+ISUB1+8) IHDR(44)=-1 GO TO 300 265 ISUBF=ISUB1 IF (IUNIT1*2.NEQ.ISUB1) ISUBF=ISUB1-1 IHDR(43)=IHDR(MPST1+ISUBF+8) IHDR(44)=IHDR(MPST1+ISUBF+9) IHDR(45)=-1 GO TO 300 C BUILD TABLE FOR SOURCE 7905 DISC 270 IF (LP.EQ.1) GO TO 280 IHDR(43)=IHDR(MPST1+ISUB1*3+2) IHDR(44)=-1 GO TO 300 C BUILD TABLE FOR SOURCE 7905 DISC WHEN LP=1 C FIND THE FIRST SUBCHANNEL FOR SOURCE 7905 DISC UNIT C BUILD THE TABLE 280 IWORD1=0 DO 285 IWORD=0,NSUB-1 IF (IAND(IHDR(MPST1+IWORD*3+1),17B).NEQ.IUNIT1) GO TO 285 IHDR(IWORD1+43)=IHDR(MPST1+IWORD1*3+2) IWORD1=IWORD1+1 285 CONTINUE 290 IF (IWORD1.LT.32) IHDR(IWORD1+43) = -1 C C MATCH THE # OF TRACKS INFO. FOR DATA TRANSFER WITHOUT LU2 C 300 IF ((LU2.EQ.1).AND.(LP.EQ.1)) GO TO 350 ITEMP=1 DO 340 IWORD=43,74 IF (IHDR(IWORD).EQ.-1) GO TO 350 DO 330 ILU = ITEMP,LIMIT,2 IF ((LU2.EQ.1).AND.(IHDR(IWORD).NEQ.ILUTR(ILU+1))) GO TO 750 IF (IHDR(IWORD).LE.ILUTR(ILU+1)) GO TO 310 330 CONTINUE GO TO 750 310 ITEMP1=ILUTR(ITEMP) ILUTR(ITEMP)=ILUTR(ILU) ILUTR(ILU)=ITEMP1 ITEMP1=ILUTR(ITEMP+1) ILUTR(ITEMP+1)=ILUTR(ILU+1) ILUTR(ILU+1)=ITEMP1 ITEMP=ITEMP+2 340 CONTINUE 350 DO 355 IWORD=1,64 ILUTB(IWORD)=ILUTR(IWORD) 355 CONTINUE C C START DATA TRANSFER FROM DISC TO MAG TAPE C DO 400 IWORD = 1,32 IF (IHDR(42+IWORD).EQ.-1) GO TO 410 IDLU=ILUTB(IWORD*2-1) IF ((IDLU.EQ.2).OR.(IDLU.EQ.3)) GO TO 730 nN IFLAG=0 DO 390 ITR=0,IHDR(IWORD+42)-1 DO 380 ISEC=0,95,INCR C READ RECORDS FROM MAG TAPE 357 REG=EXEC(1,IMLU,KB,ISIZE+2) 358 ITRY=1 IF (ITR.NEQ.KB(2)) GO TO 700 360 REG=EXEC (2,IDLU+74000B,JB,ISIZE,ITR,ISEC) C WRITE RECORD ON DISC IF (IB.EQ.ISIZE) GO TO 365 IF (ITRY.GT.7) GO TO 620 ITRY=ITRY+1 GO TO 360 365 IF (IFLAG.EQ.1) GO TO 370 REG=EXEC(3,600B+IDLU) IF (IDTYP2.EQ.7905) GO TO 367 IF (IAND(IA,10B)-10B) 370,368,370 367 IF (IAND(IA,20B).NEQ.20B) GO TO 370 368 CALL MESG (ITLU,21) IFLAG=1 370 REG=EXEC(3,600B+IMLU) IF (IAND(IA,40B).NEQ.40B) GO TO 380 375 CALL MESG (ITLU,12) CALL MESG (ITLU,11) REWIND IMLU CALL EXEC (7) 377 REWIND IMLU CALL PRNTH (ITLU,IMLU,JB) IF (JB.EQ.-1) GO TO 377 ITAPE=JB(37) 380 CONTINUE 390 CONTINUE 400 CONTINUE C C SCHEDULE VERIFY PROGRAM WITH WAIT IF VERIFY OPTION CHOSEN C 410 IF (IVERFY.NEQ.2HYE) GO TO 500 IF (ITAPE.EQ.1) GO TO 430 CALL MESG(ITLU,24) CALL MESG (ITLU,11) REWIND IMLU PAUSE JTAPE=ITAPE 420 CALL TPPOS(ITLU,IMLU,IFILE,JTAPE) CALL PRNTH(ITLU,IMLU,KB) IF (KB.EQ.-1) GO TO 420 GO TO 450 430 CALL TPPOS (ITLU,IMLU,IFILE,ITAPE) CALL EXEC (1,IMLU,KB,140) C PASS ILUTR TABLE TO SAM USING CLASS I/O CALL 450 CALL EXEC (20,0,ILUTB,64,IDUMY,JDUMY,ICLAS) NAME1=2HVE NAME2=2HRF NAME3=2HY C UNLOCK MAG TAPE LU CALL LURQ(0,IMLU,1) CALL EXEC(23,INAME,ITLU,ICLAS,LIMIT,IMLU,IREC) 500 REWIND IMLU STOP 580 CALL MESG (ITLU,8) CALL READU(ITLU,ICHAR,1) CALL ASCDC(ICHAR,1,IMLU) GO TO 1 620 CALL MESG (ITLU,13) 630 CALL DCASC(ICHAR2,2,ITR) CALL EXEC (2,ITLU,ICHAR2,2) CALL DCASC (ICHAR,1,IDLU) CALL EXEC (2,ITLU,ICHAR,1) 640 CALL MESG (ITLU,14) STOP 700 CALL MESG (ITLU,26) GO TO 630 730 CALL MESG(ITLU,22) GO TO 640 750 CALL MESG (ITLU,16) GO TO 640 770 CALL MESG (ITLU,20) GO TO 640 790 CALL MESG (ITLU,23) GO TO 640 800 CALL MESG (ITLU,1) GO TO 640 END END$ _ ` m 92060-18041 1704 S C0222 &VERFY DISC VERIFY PROGRAM             H0102 ASMB,R,L,C * NAME: VERFY * SOURCE: 92060-18041 * RELOC: 92060-16041 * PGMR: S.P.K. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM VERFY,3,99 92060-16041 REV.1704 761201 * VERFIY DATA TRANSFERED BY SAVE,RSTOR OR COPY EXT EXEC,VRFSB,COR.A,RMPAR VERFY JSB RMPAR DEF *+2 FETCH PARAMETERS PASSED BY SCHEDULING PROGRAM DEF IP SUP LDA 1717B JSB COR.A ROUTINE TO FIND FWA IN FREE MEM OF PARTITION STA FWA ADA D2 SETTING UP PARMS TO PASS TO MAIN VERIFY ROUTINE STA KBUF LDB IP+4 IF IP(5)=0 BUFFER SIZE USED BY SCHEDULING PROG SZB IS 2048 WORDS OTHERWISE 6144 WORDS JMP B6144 6144 WORD RECORDS USED ADA D2048 2048 WORD REC.-SET UP BUF TO READ REC FROM DISC STA JBUF JMP GOVER * B6144 ADA D6144 6144 WORD REC.- SET UP BUF TO READ REC FROM DISC STA JBUF * GOVER JSB VRFSB MAIN VERIFY ROUTINE DEF *+5 DEF FWA,I DEF KBUF,I DEF JBUF,I DEF IP JSB EXEC END VERIFY PROGRAM DEF *+2 DEF D6 * * A EQU 0 B EQU 1 IP BSS 5 FWA BSS 1 JBUF BSS 1 KBUF BSS 1 D2 DEC 2 D6 DEC 6 D20 DEC 20 D2048 DEC 2048 D6144 DEC 6144 END VERFY +FTN4,L C NAME: VRFSB C SOURCE: 92060-18041 C RELOC: 92060-16041 C PGMR: S.P.K. C C *************************************************************** C * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * C * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * C * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* C * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C *************************************************************** C SUBROUTINE VRFSB (KB,KBUF,JBUF,IP) C PROGRAM TO VERIFY DATA BY WORD TO WORD COMPARISON C THIS PROGRAM IS SCHEDULED WITH WAIT BY A DISC BACKUP UTILITY C DIMENSION ILUTR(64),KB(1),JBUF(1),KBUF(1),IP(1),IREG(2), C IM1(5),IM2(18),IM3(14),IM4(18),ITRCK(2),ITITL(4), C ITAPE(5),IOK(6),IM5(7) EQUIVALENCE (IM2(12),ITRCK),(IM2(18),IDLU),(REG,IA,IREG), C (IB,IREG(2)) EXTERNAL DCASC,MEMGT DATA IM1,IM1(2),IM1(3),IM1(4),IM1(5)/2HVE,2HRI, C 2HFY,2HIN,2HG /,IM2/2HVE,2HRI,2HFY, C 2H E,2HRR,2HOR,2H A,2HT ,2HTR,2HAC,2HK ,2H ,2H ,2H &, C 2H L,2HU ,2H# ,2H /,IM3/2HEO,2HT ,2HRE,2HAC,2HHE, C 2HD,,2H M,2HOU,2HNT,2H N,2HEX,2HT ,2HTA,2HPE/, C IM4/2HRE,2HST,2HRT,2H V,2HER,2HFY,2H B,2HY ,2HEN, C 2HTE,2HRI,2HNG,2H ',2HGO,2H,V,2HER,2HFY,2H' /, C ITITL/2HFI,2HLE,2H I,2HD:/, C ITAPE/2HTA,2HPE,2H#:,2H /, C IOK/2HOK,2H? ,2H(Y,2HES,2H/N,2HO)/, C IFLAG/0/,IFLAG1/0/,IM5/2HVE,2HRF,2HY ,2HAB,2HOR,2HTE,2HD /, C ITYPE/0/,I77777/77777B/,IQUES/2H??/ C THE FOLLOWING PARAMETERS ARE PASSED BY THE UTILITY PROGRAM: C IP1 - TTY LU OF USER CONSOLE, IP2 - CALL NUMBER, C IP3 - 0 IF TRANSFER BET. DISC & MAG TAPE, 1 IF XFER BET 2 DISCS C IP4 - MAG TAPE LU IF IP3 IS +VE OR DEST. DISC POINTER IN ILUTR C IP5 - 0 IF BUF SIZE HAS TO BE 2048 WORDS, 1 IF 6144 WORDS C CALL EXEC (22,3) ITLU=IP IF (IP(3).LT.0) ITYPE=1 LIMIT=IAND(IP(3),I77777) IMLU=IP(4) IF (IP(5).EQ.1) GO TO 5 ISIZE=2048 INCR=32 GO TO 7 5 ISIZE=6144 INCR=96 7 CALL EXEC (2,ITLU,IM1,5) C GET THE BUFFER PASSED BY UTILITY PRAGRAM CALL EXEC (21,IP(2),ILUTR,64) C FORMAT OF ILUTR IS: WORD 1 = LU# OF SUBCHANNEL 1 ON DISC 1 C WORD 2 = # TRACKS FOR SUBCHANNEL 1 ON DISC 1 C WORD 3 = LU# OF SUBCHANNEL 2 ON DISC 1, ......... C IF XFER WAS DISC TO DISC - WORD 32 = # TRACKS ON SUB 16 DISC 1 C WORD 33 = LU# OF SUBCHNL 1 ON DISC 2, ............. C C IF XFER WAS BET DISC & MT WORD 32 = #TRACKS ON SUB 16 ON DISC 1 C WORD 33 = LU # OF SUBCHNL 17 ON DISC 1, ..... C C IF DISC HAS N SUBCHANNELS, WHERE N < 32 (16 IF TYPE = 1), C WORD 2N+1=-1 TO MARK THE END OF LIST OF LU#'S C C FIND DISC TYPE FOR IDLU1 CALL EXEC (13,ILUTR,IEQT5) IDTYP=7900 IF (IAND(IEQT5,37400B).EQ.15000B) IDTYP=7905 C C C GO THROUGH ILUTR TABLE C 20 DO 250 ILU=1,LIMIT,2 C IDLU1=ILUTR(ILU) ILT=ILUTR(ILU+1)-1 IFT=0 IFLAG=0 IF (ITYPE.EQ.1) IDLU2=ILUTR(ILU+LIMIT+1) C LOOP FOR TRACKS ON SUBCHANNEL C 50 DO 200 ITR = IFT,ILT C LOOP FOR SECTOR # FOR EACH TRACK DO 150 ISEC=0,95,INCR REG= EXEC (1,IDLU1,JBUF,ISIZE,ITR,ISEC) IF (IFLAG.EQ.1) GO TO 55 IF (IDLU1.NEQ.2) GO TO 55 IF (IDTYP.EQ.7905) GO TO 51 IF (IAND(IA,10B).EQ.10B) GO TO 55 GO TO 52 51 IF (IAND(IA,20B).EQ.20B) GO TO 55 52 IFLAG=1 CALL MEMGT(1756B,ILT) ILT=ILT-1 CALL EXEC (1,IDLU1,JBUF,128,ILT,14) IFT=JBUF(5) IF (ITYPE.EQ.0) GO TO 60 GO TO 50 55 IF (ITYPE.EQ.0) GO TO 60 C C READ RECORD FROM SECOND DISC CALL EXEC (1,IDLU2,KBUF,ISIZE,ITR,ISEC) GO TO 70 C EOT REACHED? 60 REG=EXEC(3,600B+IMLU) IF (IAND(IA,40B).NEQ.40B) GO TO 62 CALL EXEC (2,ITLU,IM3,14) nQ 63 CALL EXEC (2,ITLU,IM4,18) REWIND IMLU PAUSE CALL EXEC (1,IMLU,KB,140) CALL EXEC (2,ITLU,ITITL,4) CALL EXEC (2,ITLU,KB,36) CALL DCASC(ITAPE(5),1,KB(37)) CALL EXEC(2,ITLU,ITAPE,5) CALL EXEC (2,ITLU,IOK,6) 85 IYES=2H REG = EXEC (1,ITLU+400B,IYES,1) IF (IB.NEQ.0) GO TO 80 CALL EXEC (2,ITLU,IQUES,1) GO TO 85 80 IF (IYES.NEQ.2HAB) GO TO 61 CALL EXEC (2,ITLU,IM5,7) STOP 61 IF (IYES.NEQ.2HYE) GO TO 63 62 IF (IFLAG.EQ.0) GO TO 69 IF (IFLAG1.EQ.1) GO TO 69 CALL EXEC (1,IMLU,KB,2) 64 IF (KB(2).NEQ.IFT) GO TO 60 BACKSPACE IMLU IFLAG1=1 GO TO 50 C READ RECORD FROM MAG TAPE 69 CALL EXEC (1,IMLU,KB,ISIZE+2) C C VERIFY BY MAKING WORD TO WORD COMPARISON C 70 DO 100 IWORD=1,ISIZE IF (JBUF(IWORD).NEQ.KBUF(IWORD)) GO TO 110 100 CONTINUE C WORDS DO NOT MATCH, INFORM USER GO TO 150 110 CALL DCASC (ITRCK,2,ITR) CALL DCASC (IDLU,1,IDLU1) CALL EXEC (2,ITLU,IM2,18) 150 CONTINUE 200 CONTINUE 250 CONTINUE STOP END END$ - b l 92060-18042 1704 S C0222 © DISC COPY PROGRAM             H0102 {ASMB,R,L,C * NAME: COPY * SOURCE: 92060-18042 * RELOC: 92060-16042 * PGMR: S.P.K. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM COPY,3,99 92060-16042 REV.1704 770214 * DISC TO DISC DATA TRANSFER EXT DD,EXEC,BUFER,RMPAR,ITASK COPY JSB RMPAR DISC TO DISC COPY UTILITY DEF *+2 DEF IP LDA D2 STA ITASK TASK=2 FOR COPY JSB BUFER GET FWA & # OF WORDS IN AVMEM FOR THIS PARTITION DEF FWA DEF PLEN DEF BFLEN JSB DD MAIN ROUTINE TO DO COPY OPERATIONS DEF *+6 DEF FWA,I DEF PLEN LENGTH OF PARTITION DEF BFLEN DEF FWA,I 7905 TRACK MAP TABLE TO OVERLAY BUFFER DEF IP JSB EXEC END COPY PROGRAM DEF *+2 DEF D6 * IP BSS 5 FWA BSS 1 PLEN BSS 1 BFLEN BSS 1 D2 DEC 2 D6 DEC 6 END COPY FTN4,L C NAME: DD C SOURCE: 92060-18042 C RELOC: 92060-16042 C PGMR: S.P.K. C C *************************************************************** C * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * C * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * C * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* C * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C *************************************************************** C SUBROUTINE DD(JB,IPLEN,IBLEN,ITB32,IP) DIMENSION JB(1),ITB31(17),ITB32(1),IREG(2),ILUTR(68),IP(5), C ICHAR2(2),INAME(3) EQUIVALENCE (IA,REG,IREG(1)),(IB,IREG(2)),(INAME,NAME1), C (INAME(2),NAME2),(INAME(3),NAME3) EXTERNAL MPFND,DCASC,ASCDC,MESG,CHDLU,CHUTP,MEMGT, C READU,LUTRK,MATCH DATA ISYLU/0/,IVERFY/0/,ISIGN/100000B/ CALL EXEC (22,3) ITLU=IP CALL MEMGT (1653B,LUMAX) IF ((ITLU.LE.0).OR.(ITLU.GT.LUMAX)) ITLU=1 LP=IP(2) IF (IBLEN.LT.2050) GO TO 770 IF (IPLEN.EQ.-1) CALL MESG (ITLU,27) IF (IBLEN.LT.6146) GO TO 5 IF (IPLEN.EQ.0) CALL MESG (ITLU,3) CALL MESG (ITLU,2) CALL READU(ITLU,IYES,1) IF (IYES.NEQ.2HYE) GO TO 5 ISIZE=6144 INCR=96 IREC=1 IF (IPLEN.EQ.1) GO TO 12 GO TO 20 5 ISIZE=2048 INCR=32 IREC=0 12 IF (IPLEN.EQ.-1) GO TO 20 CALL MESG (ITLU,0) CALL READU(ITLU,IVERFY,1) 20 IF (LP.EQ.0) GO TO 100 C PHYSICAL COPY TO BE MADE IUNIT1=IP(3) IUNIT2=IP(4) C ASK FOR SOURCE DISC TYPE CALL MESG(ITLU,17) CALL READU(ITLU,ICHAR2,2) CALL ASCDC(ICHAR2,2,IDTYP1) C C CHECK IF DISC TYPE AND UNIT # VALID CALL CHUTP(ITLU,IUNIT1,IDTYP1) C ASK FOR DESTINATION DISC TYPE 70 CALL MESG(ITLU,50) CALL READU(ITLU,ICHAR2,2) CALL ASCDC (ICHAR2,2,IDTYP2) C CHECK IF DESTINATION DISC TYPE ANDe UNIT VALID CALL CHUTP(ITLU,IUNIT2,IDTYP2) GO TO 150 C C CHECK FOR VALIDITY OF DISC LU'S FOR LOGICAL COPY, FIND THE C SOURCE AND DESTINATION SUBCHANNEL NUMBERS C 100 IDLU1=IP(3) IDLU2=IP(4) CALL CHDLU(ITLU,IDLU1,ISUB1,IDTYP1) CALL CHDLU (ITLU,IDLU2,ISUB2,IDTYP2) C C FETCH TRACK MAP TABLES FOR IDTYP1 & IDTYP2 C 150 IF ((IDTYP1.EQ.7900).OR.(IDTYP2.EQ.7900)) GO TO 160 155 NAME3=2H2 CALL MPFND(INAME,ITLU,7905,ITB32,JB) C FIND THE STARTING POINT IN TMT FOR 7905 MPST2=2 IF (ITB32(2).LT.0) MPST2=3 GO TO 170 C ONE OR BOTH IDTYP'S ARE 7900 160 NAME3=2H1 CALL MPFND (INAME,ITLU,7900,ITB31,JB) C FIND THE STARTING POINT IN TMT FOR 7900 MPST1=1 IF (ITB31.LT.0) MPST1=2 IF (IDTYP1.EQ.IDTYP2) GO TO 170 C C ONE DISC IS A 7900 AND THE OTHER A 7905 GO TO 155 C C FOLLOWING SECTION BUILDS LU-#TRACKS TABLE (ILUTR) USING C THE TRACK MAP TABLES AND COMPARES DESTINATION AND SOURCE C SUBCHANNEL SIZES 170 IF (LP.EQ.0) GO TO 230 IF (IDTYP1.EQ.7905) GO TO 180 CALL LUTRK(ITLU,LIMIT,IUNIT1,IDTYP1,ITB31,MPST1,ILUTR,LUFLG, C IEQT) GO TO 200 180 CALL LUTRK(ITLU,LIMIT,IUNIT1,IDTYP1,ITB32,MPST2,ILUTR,LUFLG, C IEQT) 200 LU2=LUFLG IDEST=LIMIT+2 IF (IDTYP2.EQ.7905) GO TO 220 CALL LUTRK(ITLU,LIMIT1,IUNIT2,IDTYP2,ITB31,MPST1,ILUTR(IDEST), C LUFLG,IEQT) GO TO 225 220 CALL LUTRK(ITLU,LIMIT1,IUNIT2,IDTYP2,ITB32,MPST2,ILUTR(IDEST), C LUFLG,IEQT) 225 LIMIT1=LIMIT+1+LIMIT1 GO TO 250 230 ILUTR=IDLU1 IF (IDLU1.EQ.2) LU2=1 IF (IDTYP1.EQ.7905) GO TO 235 ILUTR(2)=ITB31(MPST1+ISUB1+8) GO TO 240 235 ILUTR(2)=ITB32(MPST2+ISUB1*3+2) 240 LIMIT=1 LIMIT1=3 ILUTR(3)=IDLU2 IF (IDTYP2.EQ.7905) GO TO 245 ILUTR(4)=ITB31(MPST1+ISUB2+8) GO TO 250 245 ILUTR(4)=I0TB32(MPST2+ISUB2*3+2) C MATCH TRACK MAP INFORMATION 250 IF ((LU2.EQ.1).AND.(LP.EQ.1)) GO TO 280 C IF LU2 IS NOT INVOLVED, USE ILUTR TABLE TO CHECK IF SOURCE DATA C WILL FIT ON DESTINATION UNIT C ITEMP=LIMIT+2 DO 260 ILU=1,LIMIT,2 DO 270 ILU1=ITEMP,LIMIT1,2 IF ((LU2.EQ.1).AND.(ILUTR(ILU+1).NEQ.ILUTR(ILU1+1))) GO TO 750 IF (ILUTR(ILU+1).LE.ILUTR(ILU1+1)) GO TO 275 270 CONTINUE GO TO 750 275 ITEMP1=ILUTR(ITEMP) ILUTR(ITEMP)=ILUTR(ILU1) ILUTR(ILU1)=ITEMP1 ITEMP1=ILUTR(ITEMP+1) ILUTR(ITEMP+1)=ILUTR(ILU1+1) ILUTR(ILU1+1)=ITEMP1 ITEMP=ITEMP+2 260 CONTINUE GO TO 300 280 IF (IDTYP1.NEQ.IDTYP2) GO TO 750 IF (IDTYP1.EQ.7905) GO TO 295 CALL MATCH (ITLU,IDTYP1,IEQT,IUNIT1,IUNIT2,MPST1,MPST1,ITB31, C ITB31,ILUTR(IDEST)) GO TO 300 295 CALL MATCH (ITLU,IDTYP1,IEQT,IUNIT1,IUNIT2,MPST2,MPST2,ITB32, C ITB32,ILUTR(IDEST)) 300 DO 460 ILU=1,LIMIT,2 IDLU1=ILUTR(ILU) ILT=ILUTR(ILU+1)-1 IDLU2=ILUTR(ILU+LIMIT+1) IF ((IDLU2.EQ.2).OR.(IDLU2.EQ.3)) GO TO 730 330 IFLAG=0 DO 450 ITR =0,ILT DO 410 ISEC = 0,95,INCR 332 ITRY=1 335 REG=EXEC(1,IDLU1,JB,ISIZE,ITR,ISEC) IF (IB.EQ.ISIZE) GO TO 340 IF (ITRY.EQ.7) GO TO 680 ITRY=ITRY+1 GO TO 335 C WRITE BUFFER ON DESTINATION DISC 340 ITRY=1 350 REG=EXEC(2,IDLU2,JB,ISIZE,ITR,ISEC) IF (IB.EQ.ISIZE) GO TO 380 IF (ITRY.EQ.7) GO TO 700 ITRY=ITRY+1 GO TO 350 380 IF (IFLAG.EQ.1) GO TO 410 REG=EXEC (3,600B+IDLU2) IF (IDTYP2.EQ.7905) GO TO 370 IF (IAND(IA,10B)-10B)410,375,410 370 IF (IAND(IA,20B).NEQ.20B) GO TO 410 375 CALL MESG(ITLU,21) IFLAG=1 410 CONTINUE 450 CONTINUE 460 CONTINUE C C VERIFY WANTED? C 500 IF (IVERFY.NEQ.2HYE) GO TO 550 C YES, PASS ILUTR TABLE TO SAM USING CLASS I/O CALL CALL EXEC (20,0,ILUTR,64,IDUMY,JDUMY,ICLAS) NAME1=2HVE NAME2=2HRF NAME3=1HY C SCHEDULE VERIFY PROGRAM WITH WAIT LIMIT=LIMIT+ISIGN CALL EXEC (23,INAME,ITLU,ICLAS,LIMIT,0,IREC) 550 STOP C C ERROR MESSAGES C 680 IDLU=IDLU1 685 CALL MESG(ITLU,13) CALL DCASC (ICHAR2,2,ITR) CALL EXEC (2,ITLU,ICHAR2,2) CALL DCASC (ICHAR,1,IDLU) CALL EXEC (2,ITLU,ICHAR,1) 695 CALL MESG(ITLU,14) STOP 700 IDLU=IDLU2 GO TO 685 730 CALL MESG (ITLU,22) GO TO 695 750 CALL MESG(ITLU,16) GO TO 695 770 CALL MESG(ITLU,1) GO TO 695 END END$ 7 d o 92060-18043 1704 S C1822 &DBKLB DISC BACK UP LIB.             H0118 ASMB,R,L,C * NAME: DBKLB * SOURCE: 92060-18043 * RELOC: 92060-16043 * PGMR: S.P.K. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM DBKLB,0 92060-16043 REV.1704 770214 ENT DBKLB DBKLB EQU * END DBKLB K^ASMB,R,L,C * NAME: BUFER * SOURCE: 92060-18043 * RELOC: 92060-16043 * PGMR: S.P.K. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM BUFER,7 92060-16043 760721 ENT BUFER ROUTINE TO FIND HIGH ADDR OF MAIN AND DETERMINE EXT COR.A # OF WORDS IN PROGRAM'S PARTITION AND BUFER NOP IN FREE AVAILABLE MEM IN PARTITION LDA 1717B ADDRESS OF ID SEG OF MAIN PROG JSB COR.A SYS ROUTINE TO GET FWA OF FREE MEM IN PARTITION LDB BUFER,I STA B,I ADDRESS OF FWA RETURNED IN A REG STA FWAVM LDA 1717B ADDR OF IDSEG OF CURRENT MAIN PROG ADA D14 ADDR OF 15TH WORD OF ID SEG LDA A,I VALUE OF 15 TH WORD OF ID SEG AND .17 FIND TYPE OF PROG IE.FG OR BG CPA D3 BG DISC RESIDENT? RSS JMP FG NO FOREGROUND DISC RESIDENT LDA 1777B YES, LWA MEM IN BG PARTITION STA LWA LDB 1754B FWA OF BG PARTITION STB FWA JMP BLEN FIND LENGTH OF AVMEM * FG LDA 1751B LWA+1 MEM IN FG PARTITION ADA N1 LWA IN FG PARTITION STA LWA LDB 1750B FWA OF FG PARTITION STB FWA * BLEN LDA NAME3 ADDRESS OF FIRST 2 CHARS OF NAME AND MASKU MASK OFF LOWER CHAR STA NAME3 LDA KEYWD TOP OF KEYWORD LIST STA KEY TN005 LDA KEY,I CHECK IF END OF LIST CCE,SZA,RSS JMP NOID END OF INSTR LIST, NO ID SEGMENT ADA D12 LDB A,I ID SEG ASCII NAME CHARS 1 & 2 CPB NAME1 COMPARE WITH CHAR 1 & 2 INA,RSS COMP.ARES JMP TN030 DOES NOT COMPARE, GO TO NEXT ID SEG LDB A,I ID SEG ASCII NAME 3,4 CPB NAME2 COMPARE WITH REQUESTED CHARS 3,4 INA,RSS COMPARES JMP TN030 DOES NOT COMPARE-GO TO NEXT ID SEG LDA A,I ID SEG ASCII NAME CHAR 5 STA B AND MASKU CPA NAME3 COMPARE CHAR 5 JMP TN040 COMPARES - SO ID SEG FOUND * TN030 ISZ KEY INCREMENT KEYWORD ADDRESS JMP TN005 GO TO COMPARE CHARACTERS TN040 LDB KEY,I ADDRESS OF ID SEGMENT LDA BPA1 RTE II OR III ? CPA D2 RSS RTE III JMP BLEN2 RTE II FIND BUFFER LENGTH ADB D21 POINT TO WORD 22 OF ID SEGMENT LDA B,I LOAD CONTENTS OF WORD 22 AND .76K CLE ELA,ALF ROTATE # OF PAGES TO RAL LOWER 6 BITS STA NAME1 SAVE IT ADA N14 IS IT LESS THAN 15 PAGES? SSA JMP BFLN2 YES, THEN CANNOT DO VERIFY WITH 6K BUFFER CLB,INB NO, B REG = 1 - CAN VERIFY WITH 6K BUFFER JMP BUFLN SEND VALUE OF B REG BACK TO MAIN PROG BFLN2 LDA NAME1 ADA N6 IS IT LESS THAN 7 PAGES? SSA CCB,RSS YES, THEN CANNOT VERIFY AT ALL CLB NO THEN CAN VERIFY WITH 2048 WORD BUF JMP BUFLN NOID CCB B REG = -1 - ID SEG NOT FOUND JMP BUFLN BLEN2 LDB FWA CMB,INB FIND PARTITION SIZE ADB LWA INB LWA-FWA+1 ADB N1350 ADD -13500 - -VE OF PARTITION SIZE REQD. SSB FOR VERIFY WITH 6144 WORD BUFFER CLB,RSS CANNOT VERIFY WITH 6144 WORD BUFFER CLB,INB VERIFY WITH 6K BUFFER POSSIBLE BUFLN ISZ BUFER LDA BUFER,I PASS BACK LENGTH OF PARTITION STB A,I LDA LWA FIND LENGTH OF AVMEM IN PARTITION LDB FWAVM CMB,INB B REG HAS FWA OF AVMEM ADB A INB LWA-FWAVM+1 ISZ BUFER  LDA BUFER,I STB A,I # OF WORDS IN FREE AVMEM IN PARTITION ISZ BUFER JMP BUFER,I RETURN * A EQU 0 B EQU 1 FWAVM BSS 1 LWA BSS 1 FWA BSS 1 KEY BSS 1 MASKU OCT 177400 .76K OCT 76000 N1350 DEC -13500 N14 DEC -14 D21 DEC 21 BPA1 EQU 1742B KEYWD EQU 1657B VERFY ASC 6,VERFY NAME1 EQU VERFY NAME2 EQU VERFY+1 NAME3 EQU VERFY+2 D2 DEC 2 D3 DEC 3 N6 DEC -6 D12 DEC 12 D14 DEC 14 N1 DEC -1 .17 OCT 17 END FTN4,L C NAME: CHDLU C SOURCE: 92060-18043 C RELOC: 92060-16043 C PGMR: S.P.K. C C *************************************************************** C * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * C * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * C * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* C * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C *************************************************************** C SUBROUTINE CHDLU(ITLU,IDLU,ISUB,IDTYP) EXTERNAL SUB,READU,MESG,ASCDC,DCASC,MEMGT CALL MEMGT(1653B,LUMAX) 10 IF ((IDLU.LT.1).OR.(IDLU.GT.LUMAX)) GO TO 530 CALL EXEC (13,IDLU,IEQT5) C EQUIPMENT TYPE 32? IF (IAND(IEQT5,37400B)-15000B) 115,130,530 C EQUIPMENT TYPE 31? 115 IF (IAND(IEQT5,37400B)-14400B) 530,140,530 130 IDTYP=7905 GO TO 150 140 IDTYP=7900 150 CALL SUB(IDLU,ISUB) RETURN 530 CALL MESG(ITLU,7) CALL DCASC (ICHAR,1,IDLU) CALL EXEC (2,ITLU,ICHAR,1) ICHAR=2H CALL READU(ITLU,ICHAR,1) CALL ASCDC(ICHAR,1,IDLU) GO TO 10 END END$ =FTN4,L C NAME: CHUTP C SOURCE: 92060-18043 C RELOC: 92060-16043 C PGMR: S.P.K. C C *************************************************************** C * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * C * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * C * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* C * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C *************************************************************** C SUBROUTINE CHUTP(ITLU,IUNIT,IDTYP) EXTERNAL MESG,ASCDC,READU,DCASC DIMENSION ICHAR2(2) 10 IF ((IDTYP.EQ.7900).OR.(IDTYP.EQ.7901)) GO TO 50 IF ((IDTYP.EQ.7905).OR.(IDTYP.EQ.7920)) GO TO 60 CALL MESG(ITLU,15) CALL DCASC (ICHAR2,2,IDTYP) CALL EXEC (2,ITLU,ICHAR2,2) CALL READU(ITLU,ICHAR2,2) CALL ASCDC (ICHAR2,2,IDTYP) GO TO 10 50 IDTYP=7900 IF ((IUNIT.LT.0).OR.(IUNIT.GT.3)) GO TO 505 RETURN 60 IDTYP=7905 IF ((IUNIT.LT.0).OR.(IUNIT.GT.7)) GO TO 505 RETURN 505 CALL MESG(ITLU,6) CALL DCASC (ICHAR,1,IUNIT) CALL EXEC (2,ITLU,ICHAR,1) ICHAR=2H CALL READU(ITLU,ICHAR,1) CALL ASCDC(ICHAR,1,IUNIT) GO TO 10 END END$ wFTN4,L C NAME: LUTRK C SOURCE: 92060-18043 C RELOC: 92060-16043 C PGMR: S.P.K. C C *************************************************************** C * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * C * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * C * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* C * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C *************************************************************** C SUBROUTINE LUTRK(ITLU,LIMIT,IUNIT,IDTYP,ITB30,MPST,ILUTR,LUFLG, C IEQT1) C ROUTINE TO DECODE TRACK MAP TABLE AND BUILD TABLE FOR LU# AND C # OF TRACKS FOR THE DISC UNIT SPECIFIED BY IUNIT C C FORMAT OF TABLE IS: WORD 1 - LU# OF SUBCHANNEL 1 ON DISC 1 C WORD 2- # OF TRACKS FOR SUBCHANNEL 1 ON DISC 1, C WORD 3- LU# OF SUBCHANNEL 2 ON DISC 1 .............. C EXTERNAL MESG DIMENSION ITB30(1),ILUTR(1) LUFLG=0 IF (IDTYP.EQ.7900) GO TO 20 C FIND FIRST SUBCHANNEL # ON 7905 DISC UNIT C NSUB=-ITB30(MPST-1) ISUB=-1 10 IF (ISUB.EQ.NSUB) GO TO 150 ISUB=ISUB+1 C ISOLATE UNIT NUMBER FOR EVERY SUBCHANNEL ON TRACK MAP TABLE C UNTIL IT MATCHES IUNIT C IF (IAND(ITB30(MPST+ISUB*3+1),17B).NEQ.IUNIT) GO TO 10 GO TO 30 C C FIRST SUBCHANNEL # ON 7900 DISC UNIT 20 ISUB=IUNIT*2 30 IDLU=1 40 IEQT=0 IFLAG=0 C CALL ROUTINE TO GO THRU DEVICE REFERENCE TABLE AND FIND LU FOR C SUBCHANNEL CALL DRT (ISUB,IDLU,IEQT) C DRT RETURNS WITH LU=-1 IF SUBCHANNEL IS NOT ASSIGNED AN LU# IF (IDLU.EQ.-1) GO TO 200 C C CHECK EQUIPMENT# IN STATUS WORD TO MAKE SURE LU RETURNED IS FOR C THE RIGHT DISC UNIT TYPE C CALL EXEC (13,IDLU,IEQT5) IF ((IAND(IEQT5,37400B).EQ.15000B).AND.(IDTYP.EQ.7905)) C GO TO 50 IF ((IAND(IEQT5,37400B).EQ.14400B).AND.(IDTYP.EQ.7900)) C GO TO 50   C THE EQUIPMENT TYPE IS NOT 31 OR 32, LU # NOT RIGHT, TRY AGAIN C IDLU=IDLU+1 GO TO 40 C FILL THE ILUTR TABLE WITH LU# AND # OF TRACKS 50 DO 90 ILU = 1,63,2 ILUTR(ILU)=IDLU IF (IDLU.EQ.2) LUFLG=1 C GET # OF TRACKS IF (IDTYP.EQ.7905) GO TO 60 ILUTR(ILU+1)=ITB30(MPST+ISUB+8) C ALL SUBCHANNELS FOR 7900 DISC UNIT DONE? IF (ISUB.EQ.IUNIT*2+1) GO TO 100 ISUB=ISUB+1 GO TO 80 60 ILUTR(ILU+1)=ITB30(MPST+ISUB*3+2) 70 IF (ISUB.EQ.NSUB-1) GO TO 100 ISUB=ISUB+1 IF (IAND(ITB30(MPST+ISUB*3+1),17B).NEQ.IUNIT) GO TO 70 80 IDLU=1 IFLAG=-1 C FIND LU# FOR GIVEN SUBCHANNEL AND EQT# CALL DRT(ISUB,IDLU,IEQT) IF (IDLU.EQ.-1) GO TO 200 90 CONTINUE C C END OF LIST OF LU #'S TO BE MARKED WITH -1 100 LIMIT=ILU IEQT1=IEQT RETURN C "IMPROPER TRACK MAP INFO. " 150 CALL MESG (ITLU,28) CALL MESG (ITLU,14) STOP C ERROR MESSAGE PRINTED - LU # NOT ASSIGNED TO FOLL. SUBCHNL 200 CALL MESG(ITLU,9) ICHAR=2H CALL DCASC(ICHAR,1,ISUB) CALL EXEC (2,ITLU,ICHAR,1) C ASSIGN LU# TO SUBCHANNEL AND RSTART UTILITY USIG RTE GO CMND CALL MESG (ITLU,11) PAUSE IF (IFLAG) 80,40 END END$ ASMB,R,L,C * NAME: MATCH * SOURCE: 92060-18043 * RELOC: 92060-16043 * PGMR: S.P.K. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM MATCH,7 90260-16043 770214 ENT MATCH ROUTINE TO MATCH TRACK MAP INFO FOR 2 DISC UNITS EXT MESG,EXEC,RMOVI,DRT,DCASC,EXEC MATCH NOP LDA MATCH,I STA RETRN SAVE RETURN ADDRESS CLA STA IWORD FETCH VALUES OF FIRST 8 ARGUMENTS LDB N7 STB ITEMP ITEMP IS COUNTER LOOP ISZ MATCH LOAD THEM IN BUF LDA MATCH,I ADDRESS OF ARGUMENT IN A REG LDA A,I VALUE IN A REG LDB ABUF LOAD ADDRESS OF BUFFER ADB IWORD DISPLACEMENT STA B,I ISZ IWORD ISZ ITEMP JMP LOOP LDB N3 STB ITEMP ITEMP IS COUNTER LOOP0 ISZ MATCH FETCH THE ADDRESSES OF 2 TRACK MAP TABLES LDA MATCH,I JSB RMOVI LDB ABUF ADDRESS OF BUFFER FOR PARAMETERS ADB IWORD INDEX INTO IT STA B,I STORE TABLE ADDRESS IN BUFFER ISZ IWORD ISZ ITEMP JMP LOOP0 LDA MPST1 ADJUST MAP START ADDRESS FOR ASSEMBLY ADA N1 STA MPST1 LDA MPST2 ADA N1 STA MPST2 LDA IDTYP CHECK DISC TYPE - 7900,7905 CPA D7905 7905 DISC? JMP M7905 YES,JUMP JSB M7900 NO,MATCH INFO, FOR 7900 DISC UNITS DEF D0 MATCH FIRST SUBCHNL STARTING TRACK # JSB M7900 DEF D1 MATCH SECOND SUBCHNL(REMOVABLE) STARTING TRACK # JSB M7900 DEF D8 MATCH FIRST SUBCHNL # OF TRACKS JSB M7900  DEF D9 MATCH SECOND SUBCHNL # OF TRACKS JMP RETRN,I TM INFO FOR BOTH 7900 UNITS MATCHES, RETURN M7905 LDA MPST1 DETERMINE NUMBER OF SUBCHNLS IN TRACK MAP TABLE ADA N1 ADA MAP1 LDA A,I CMA,INA NUMBER IS -VE SO MAKE IT +VE STA NSUB1 LDA MPST2 FIND # OF SUBCHANNELS IN MAP2 ADA N1 ADA MAP2 LDA A,I CMA,INA MAKE IT +VE STA NSUB2 # OF SUBCHANNELS IN MAP2 CLA STA ISUB1 SUBCHNL #'S FOR SOURCE DISC LOOP1 LDB MAP1 MAP ADDRESS OF SOUCE UNIT JSB CMPR IS ISUB1 ON IUNIT1? DEF MPST1 MAP START ADDR OF MAP1 DEF IUNT1 UNIT# OF SOURCE UNIT SZA A REG = 0 IF ISUB1 ON UNIT1 JMP ENDL3 NO,TRY NEXT SUBCHNL STB ITMP1 ADDR OF TRACK MAP INFO FOR ISUB1 STA ISUB2 YES, ISUB2 IS SUBCHNL FOR DEST DISC IUNIT2 LOOP2 LDB MAP2 MAP ADDRESS OF DEST DISC UNIT JSB CMPR ISUB2 ON IUNIT2? DEF MPST2 MAP START ADDR OF MAP2 DEF IUNT2 UNIT# OF SOURCE UNIT SZA A REG =0 SAYS ISUB2 IS ON IUNIT2 JMP ENDL2 NO, TRY NEXT SUBCHNL * TRACK MAP INFO FOR BOTH SUBCHANNELS MATCHES? STB ITMP2 ADDR OF TRACK MAP INFO FOR ISUB2 LDA ITMP1 BOTH SBCHNLS ARE ON DESIRED UNIT#'S LDA A,I START COMPARING - AREG HAS FIRST WORD LDB ITMP2 FIRST WORD FOR SUBCHNL ON 2ND DISC UNIT LDB B,I CPA B COMPARE RSS JMP ENDL2 DOES NOT MATCH - TRY WITH NEXT SUBCHNL LDA ITMP1 MATCH SECOND WORD FOR BOTH SUBCHANNELS INA LDA A,I BRING CONTENTS OF 2ND WORD AND .7776 MASK OUT THE UNIT# FROM WORD 2 OF SBCHNL ON UNIT1 STA ITEMP LDA ITMP2 POINTER TO BEG OF SUBCHNL INFO ON MAP 2 INA LDA A,I CONTENS OF WORD 2 AND .7776 MASK OUT UNIT# FROM WORD 2 OF SBCHNL ON UNIT2 CPA ITEMP COMPARE WORD INFO RSS e JMP ENDL2 DO NOT MATCH - TRY WITH NEXT SUBCHNL LDA ITMP1 YES,COMPARE WORD 3 ADA D2 LDA A,I LDB ITMP2 FETCH CONTENTS OF WORD3 OF SUBCHNL ON UNIT2 ADB D2 LDB B,I CPA B JMP ENDL1 ENDL2 ISZ ISUB2 NO MATCH - TRY WITH NEXT SUBCHNL LDA ISUB2 INCREMENT AND TRY AGAIN CPA NSUB2 ALL SUBCHANNELS LOOKED AT? JMP ERROR YES - NO MATCH IN ENTIRE TMT - ERROR JMP LOOP2 NO - TRY AGAIN ENDL1 LDA ILUTR LU#-#TRACKS TABLE ADDR ADA ILU POINT TO NEXT ENTRY POINT IN IT INA # OF TRACKS ENTRY FOR ISUB2 STB A,I MTCH2 CLA STA ITEMP JSB DRT FIND LU# OF ISUB2 DEF *+4 DEF ISUB2 DEF ITEMP LU# DEF IEQT EQT # LDB ITEMP WAS SUBCHNL ENTRY MADE IN DRT? SSB,RSS JMP MTCH1 YES JSB MESG NO, LU# NOT ASSIGNED TO SUBCHNL DEF *+3 DEF ITLU DEF D9 ASSIGN LU# TO FOLL SUBCHNL JSB DCASC CONVERT SUBCHNL# TO ASCII DEF *+4 DEF ITEMP DEF D1 DEF ISUB JSB EXEC DISPLAY SUBCHANNEL # DEF *+5 DEF D2 DEF ITLU DEF ITEMP DEF D1 JSB MESG DEF *+3 DEF ITLU DEF D11 RESTART MESSAGE JSB EXEC DEF *+2 DEF D7 PAUSE JMP MTCH2 CONTINUE * MTCH1 LDA ILUTR ADDRESS OF LU-#TRACKS TABLE ADA ILU INDEX INTO TABLE STB A,I LU# ENTRY MADE IN TABLE LDA ILU INCREMENT ILU INDEX BY 2 ADA D2 STA ILU ENDL3 ISZ ISUB1 MATCH FOUND - NOW TRY WITH NEXT SUBCHNL LDA ISUB1 ON IUNIT1 CPA NSUB1 ALL SUBCHANNELS HAVE BEEN MATCHED? JMP RETRN,I YES-RETURN JMP LOOP1 NO - FIND NEXT ONE * *ERROR - SYSTEM LU TO BE RESTORED,SOURCE AND DEST TRCK MAP INFO * DOES NOT MATCH * ERROR JSB MESG DEF *+3 DEF ITLU $W DEF D16 JSB MESG DEF *+3 DEF ITLU DEF D14 JSB EXEC DEF *+2 DEF D6 * *SUBROUTINE TO COMPARE 1 WORD OF TRACK MAP INFO. FOR 7900 DISC UNITS * *CALLING SEQUENCE: *JSB M7900 *DEF DN DN IS THE DISPLACEMENT WITHIN TMT * M7900 NOP LDB M7900,I GET PARAMETER ADDRESS LDB B,I VALUE OF ARGUMENT STB ITEMP LDA IUNT1 ADA A ADA MPST1 POINTER TO BEG. OF INFO. FOR UNIT1 IN MAP 1 ADA MAP1 ADA ITEMP POINTER TO REQUIRED WORD IN MAP 1 LDA A,I FETCH CONTENTS OF WORD * LDB IUNT2 REPEAT PROCEDURE FOR WORD IN MAP 2 ADB B ADB MPST2 ADB MAP2 ADB ITEMP LDB B,I CPA B COMPARE INFO RSS JMP ERROR NO MATCH - ERROR ISZ M7900 MATCH, GET RETURN ADDRESS JMP M7900,I RETURN * *SUBROUTINE TO COMPARE UNIT# FOR GIVEN SBCHNL AND GIVEN DISC UNIT# * *CALLING SEQUENCE: *JSB CMPR *DEF MPST MAP START ADDR *DEF UNIT# * A REG=ISUB SUBCHNL # WHOSE UNIT # HAS TO BE COMPARED * B REG = MAP ADDRESS * RETURNS: A REG = 0 IF SUBCHNL IS ON UNIT * 1 OTHERWISE * B REG = IF A REG = 0 THEN ADDR OF TRACK MAP INFO FOR SUB * CMPR NOP STA ISUB ALS INDEX TO THE BEG OF SUBCHANNEL ENTRY ADA ISUB ISUB*3 ADA B ADDRESS OF MAP LDB CMPR,I GET MAP START ADDR LDB B,I ADA B STA ITEMP INA LDA A,I BRING CONTENTS OF 2ND WORD FOR SBCHNL AND .17 ISOLATE UNIT # ISZ CMPR LDB CMPR,I LDB B,I BRING UNIT # CPA B COMPARE UNIT #'S JMP EQUAL MATCH,JUMP LDA D1 DO NOT MATCH RETURN WITH 1 IN A REG JMP RCMPR EQUAL CLA RETURN WITH 0 IN A REG LDB ITEMP ADDR OF TRACK MAP INFO FOR SUB RCMPR ISZ CMPR RETURN ADDRESS JMP CMPR,I RETURN * * A EQU 90 B EQU 1 ABUF DEF BUF BUF BSS 10 ITLU EQU BUF IDTYP EQU BUF+1 DISC TYPE IEQT EQU BUF+2 EQT # OF DISC IUNT1 EQU BUF+3 UNIT # 1 IUNT2 EQU BUF+4 UNIT # 2 MPST1 EQU BUF+5 STARTING WORD # ON MAP 1 MPST2 EQU BUF+6 STARTING WORD # ON MAP 2 MAP1 EQU BUF+7 ADDR OF TRACK MAP TABLE OF SOURCE DISC MAP2 EQU BUF+8 ADDR OF TRACK MAP TABLE OF DEST DISC ILUTR EQU BUF+9 ADDR OF LU#-# OF TRACKS TABLE IWORD BSS 1 ILU DEC 0 RETRN BSS 1 ITEMP BSS 1 ITMP1 BSS 1 ITMP2 BSS 1 ISUB1 BSS 1 ISUB2 BSS 1 ISUB BSS 1 NSUB1 BSS 1 NSUB2 BSS 1 D0 DEC 0 D1 DEC 1 D2 DEC 2 D6 DEC 6 D7 DEC 7 D8 DEC 8 D9 DEC 9 D11 DEC 11 D14 DEC 14 D16 DEC 16 D96 DEC 96 D7905 DEC 7905 N1 DEC -1 N3 DEC -3 N7 DEC -7 .17 OCT 17 .7776 OCT 77760 END \FTN4,L C NAME: MPFND C SOURCE: 92060-18043 C RELOC: 92060-16043 C PGMR: S.P.K. C C *************************************************************** C * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * C * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * C * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* C * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C *************************************************************** C SUBROUTINE MPFND(MPNAM,ITLU,IDTYP,ITMT,JB) C FIND TRACK MAP TABLE BY LOOKING AT LIST OF ENTRY POINTS EXTERNAL DSCAD,MESG,MEMGT DIMENSION MPNAM(3),JB(1),ITMT(1) DATA ISIZE/2048/ MPNAM=2H$T MPNAM(2)=2HB3 C LOC 1762B HAS THE NO. OF ENTRY POINTS IN LIST C EACH ENTRY POINT IS FOUR WORDS LONG C IDSCLN IS NO. OF WORDS TAKEN UP BY THE ENTRY POINT LIST 140 CALL MEMGT(1762B,IDSCLN) IDSCLN=IDSCLN*4 C 1761B IS THE DISC ADRESS OF FW OF ENTRY POINT LIST CALL MEMGT(1761B,IPARM) C CONVERT DISC ADDRESS TO TRACK #, SECTOR # AND LU # CALL DSCAD (IPARM,ILU,ITRCK,ISECTR) ITEMP=96-ISECTR IF (ITEMP.GE.32) GO TO 145 JBUFL=ITEMP*64 GO TO 150 C MAX BUFFER LENGTH 145 JBUFL=ISIZE 150 IF (IDSCLN.LT.JBUFL) JBUFL=IDSCLN C READ JBUFL WORDS FROM ENTRY POINT LIST CALL EXEC (1,ILU,JB,JBUFL,ITRCK,ISECTR) C EACH ENTRY POINT HAS 4 WORDS - FIRST 5 CHARACTERS ASSIGNED TO C ENTRY POINT NAME, IF LOWER BYTE OF WORD 3 IS 1 THEN ROUTINE IS C ON DISC AND WORD 4 CONTAINS THE DISC ADDRESS OF ROUTINE - IF C LOWER BYTE OF WORD 3 IS NOT 1 THEN ROUTINE IS IN MEMORY AND C WORD 4 IS MEMORY ADDRESS OF ROUTINE C C GO THROUGH LIST TO FIND MATCHING ENTRY POINT NAME DO 147 IWORD=1,JBUFL,4 IF (JB(IWORD).NEQ.MPNAM) GO TO 147 IF (JB(IWORD+1).NEQ.MPNAM(2)) GO TO 147 IF ((IAND(JB(IWORD+2),177400B)+40B).EQ.MPNAM(3)) GO TO 230 14!  7 CONTINUE IDSCLN=IDSCLN-JBUFL C IF NO MORE WORDS LEFT IN LIST THEN ERROR, ELSE TRY WITH NEXT BUF IF (IDSCLN) 700,700,200 200 ISECTR=ISECTR+32 C SET UP SECTOR & TRACK ADDRESS TO READ NEXT SET OF DATA FROM DISC ITEMP=96-ISECTR IF (ITEMP.GE.32) GO TO 145 IF (ITEMP.LE.0) GO TO 210 JBUFL=ITEMP*64 GO TO 150 210 ISECTR=0 ITRCK=ITRCK+1 GO TO 145 C IF LOWER BYTE OF WORD 3 IS 1 THEN DISC ADDRESS 230 IF (IAND(JB(IWORD+2),377B).EQ.1) GO TO 250 C GET MEMORY ADDRESS OF ROUTINE MPADR=JB(IWORD+3) IF (IDTYP.EQ.7905) GO TO 232 M=17 GO TO 237 232 M=98 C MOVE M WORDS OF TRACK MAP INTO BUFFER 237 DO 240 IWORD=1,M CALL MEMGT(MPADR+IWORD-1,ITMT(IWORD)) 240 CONTINUE RETURN C CONVERT DISC ADRESS INTO TRACK#,SECTOR# AND LU# 250 CALL DSCAD(JB(IWORD+3),ILU,ITRCK,ISECTR) M=17 IF (IDTYP.EQ.7905) M=98 C READ M WORDS OF TRACK MAP FROM DISC CALL EXEC (1,ILU,ITMT,M,ITRCK,ISECTR) RETURN C ERROR - ROUTINE NAME CANNOT BE FOUND IN ENTRY POINT LIST 700 CALL MESG (ITLU,4) CALL EXEC (2,ITLU,MPNAM,3) CALL MESG (ITLU,14) STOP END END$ l FTN4,L C NAME: PRNTH C SOURCE: 92060-18043 C RELOC: 92060-16043 C PGMR: S.P.K. C C *************************************************************** C * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * C * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * C * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* C * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C *************************************************************** C SUBROUTINE PRNTH (ITLU,IMLU,IBUF) C SUBROUTINE TO READ HEADER RECORD AND PRINT TITLE AND TAPE # C DIMENSION IBUF(1),ITITL(4),ITAPE(5),IOK(7) EXTERNAL MESG,DCASC,READU DATA ITITL/2HFI,2HLE,2H I,2HD:/, C ITAPE,ITAPE(2),ITAPE(3),ITAPE(4)/2HTA,2HPE,2H#:,2H /, C IOK/2HOK,2H? ,2H (,2HYE,2HS/,2HNO,2H) / 10 CALL EXEC (1,IMLU,IBUF,140) CALL EXEC (2,ITLU,ITITL,4) CALL EXEC (2,ITLU,IBUF,36) CALL DCASC (ITAPE(5),1,IBUF(37)) CALL EXEC (2,ITLU,ITAPE,5) CALL EXEC (2,ITLU,IOK,7) CALL READU(ITLU,IYES,1) IF (IYES.EQ.2HYE) RETURN CALL MESG (ITLU,11) PAUSE IBUF=-1 RETURN END END$ FTN4,L C NAME: TPPOS C SOURCE: 92060-18043 C RELOC: 92060-16043 C PGMR: S.P.K. C C *************************************************************** C * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * C * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * C * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* C * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C *************************************************************** C SUBROUTINE TPPOS(ITLU,IMLU,IFILE,ITAPE) C ROUTINE TO POSITION MAG TAPE TO A DESIRED FILE # EXTERNAL ASCDC,READU,MESG EQUIVALENCE (REG,IA) IF (IFILE.GT.0) GO TO 25 10 CALL MESG (ITLU,5) CALL READU(ITLU,NFILE,1) CALL ASCDC (NFILE,1,IFILE) C CHECK IF FILE # > 0 AND <= 8 IF (IFILE.EQ.0) IFILE=1 IF ((IFILE.LT.1).OR.(IFILE.GT.8)) GO TO 100 15 REWIND IMLU C POSITION BY MOVING TAPE IFILE-1 FILES FORWARD IF (IFILE.EQ.1) RETURN DO 20 NFILE=1,IFILE-1 C FORWARD SPACE MAG TAPE BY 1 FILE CALL EXEC (3+100000B,1300B+IMLU) GO TO 120 C EOT MARK SEEN? IF YES, ERROR - FILE NOT FOUND 17 REG=EXEC(3,600B+IMLU) IF (IAND(IA,40B).EQ.40B) GO TO 120 20 CONTINUE RETURN C 25 IF (ITAPE.NEQ.1) GO TO 15 IF (IFILE.EQ.1) GO TO 15 CALL EXEC (3,200B+IMLU) CALL EXEC (3,1400B+IMLU) CALL EXEC (3,300B+IMLU) RETURN C C ERROR MESSAGES 100 CALL MESG(ITLU,18) GO TO 10 120 CALL MESG (ITLU,19) CALL MESG(ITLU,11) REWIND IMLU PAUSE GO TO 10 END END$ ASMB,R,L,C * NAME: ASCDC * SOURCE: 92060-18043 * RELOC: 92060-16043 * PGMR: S.P.K. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM ASCDC,7 92060-16043 760622 ENT ASCDC ROUTINE TO CONVERT ASCII TO DEC OR OCTAL ENT ASCOC ASCDC NOP ASCII TO DECIMAL LDA D9 STA RADIX SET UP RADIX JMP START ASCOC NOP ASCII TO OCTAL LDA ASCOC STA ASCDC LDA D7 STA RADIX SET UP RADIX TO 7 START CLA STA VAL VAL IS GOING TO ACCUMULATE INTEGER VALUE STA IWORD IWORD IS COUNTER FOR WORD IN BUF BEING CONVERTED LDA ASCDC,I STA RETRN SAVE RETURN ADDRESS ISZ ASCDC LDA ASCDC,I STA INAM SAVE ADDRESS OF CHARACTER STRING ISZ ASCDC LDA ASCDC,I LDA A,I ADA N1 STA NWORD SAVE # OF WORDS TO BE CONVERTED-1 LDA IWORD LOOP ADA INAM INDEX INTO CHARACTER STRING BUFFER LDA A,I FETCH CURRENT WORD IN STRING TO BE CONVERTED STA CWORD AND .1774 SEPERATE UPPER BYTE ALF,ALF CPA SPACE IF SPACE ENCOUNTERED IN FIRST BYTE IGNORE IT JMP IGNOR CLB CLEAR FLAG TO INDICATE UPPER BYTE OF CURRENT WORD STB IFLAG IS BEING CONVERTED CNVRT ADA .N60 CONVERT CMA,SSA,INA,RSS NEGATIVE NUMBER? JMP ERR YES,ERROR ADA RADIX CMA,SSA,INA,RSS INTEGER? JMP ERR NO,ERROR ADA RADIX BACK TO ORIGINAL NUMBER LDB RADIX CMB CLO ADA VAL ADD EXISTING VALUE TO THE NEW INTEGER T  10 TIMES ISZ B JMP *-2 SOC IF OVERFLOW, ERROR JMP ERR STA VAL LDA IFLAG JUST CONVERTED UPPER BYTE? SZA JMP NEXT YES, GET NEXT BYTE IGNOR LDA CWORD NO, FETCH CURRENT WORD THAT IS BEING CONVERTED AND .377 EXTRACT LOWER BYTE CPA SPACE SPACE? JMP DONE YES, DONE ISZ IFLAG SET FLAG TO INDICATE CONVERTING LOWER BYTE JMP CNVRT NEXT LDA IWORD GET ASCII STRING COUNTER CPA NWORD ALL WORDS IN STRING CONVERTED? JMP DONE YES, DONE INA NO, SET POINTER TO CONVERT THE NEXT WORD STA IWORD JMP LOOP DONE ISZ ASCDC LDA ASCDC,I LDB VAL STB A,I JMP RETRN,I RETURN WITH CONVERTED VALUE ERR ISZ ASCDC RETURN WITH VALUE = -1 LDA ASCDC,I LDB N1 STB A,I JMP RETRN,I * A EQU 0 B EQU 1 N1 DEC -1 .N60 OCT -60 .1774 OCT 177400 .377 OCT 377 D9 DEC 9 D7 DEC 7 VAL BSS 1 RADIX BSS 1 RETRN BSS 1 IFLAG BSS 1 CWORD BSS 1 NWORD BSS 1 IWORD BSS 1 INAM BSS 1 SPACE OCT 00040 END ʡ ASMB,R,L,C * NAME: DCASC * SOURCE: 92060-18043 * RELOC: 92060-16043 * PGMR: S.P.K. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM DCASC,7 92060-16043 760622 ENT DCASC ROUTINE TO CONVERT DECIMAL INTEGERS TO ASCII DCASC NOP CLA STA IFLAG STA CWORD LDA DCASC,I STA RETRN ISZ DCASC LDA DCASC,I STA INAM BUFFER ADDRESS ISZ DCASC LDA DCASC,I LDA A,I ADA N1 STA NWORD LENGTH OF BUFFER-1 LDA INAM BUFFER TO BE BLANKED LOOP0 LDB SPACE STB A,I BLANK OUT A WORD IN BUFFER LDB CWORD USE CWORD AS COUNTER TO POINT IN TO BUFFER CPB NWORD ALL WORDS IN BUFFER DONE? JMP DCAS1 YES, GO ON INA ISZ CWORD INCREMENT COUNTER JMP LOOP0 DCAS1 ISZ DCASC LDA DCASC,I LDA A,I LOAD INTEGER TO BE CONVERTED LOOP CLB DIV D10 DIVIDE INTEGER BY BASE 10 STA QOTNT QOTNT IS USED TO EXTRACT REMAINING DIGITS ADB .60 B REG CONTAINS REMAINDER WHICH IS THE LATEST DIGIT * TO BE CONVERTED BY ADDING OCTAL 60 STB BYTE ASCII INTEGER SAVED LDA IFLAG CHECK TO SEE IF THIS IS A LOW ORDER BYTE SZA LOW ORDER BYTE IF IFLAG=0, ELSE HIGH ORDER BYTE JMP HIGH LDA BYTE STA CWORD STORE BYTE IN LOWER HALF OF CWORD LDA QOTNT GET READY TO EXTRACT AND CONVERT NEXT DIGIT ISZ IFLAG SET FLAG TO INDICATE WORKING ON HIGH ORDER BYTE JMP LOOP START CONVERSION AGAIN HIGH LDA   BYTE BIT 0 NOT SET IF HIGH ORDER BYTE ALF,ALF STORE BYTE IN UPPER HALF OF CWORD ADA CWORD STA CWORD LDA NWORD ADA INAM REG A POINTS TO BUFFER WHERE CWORD IS PLACED LDB CWORD STB A,I LDA NWORD SZA,RSS HAS THE BUFFER BEEN FILLED? JMP RETRN,I YES,RETURN TO CALLING ROUTINE ADA N1 NO,DECREASE NWORD TO POINT TO NEXT WORD IN BUFFER STA NWORD CLA STA IFLAG CLEAR FLAG TO INDICATE WORKING ON LOW ORDER BYTE LDA QOTNT GET READY TO EXTRACT NEXT DIGIT SZA IF QOTNT=0 THEN NO MORE DIGITS LEFT TO CONVERT JMP LOOP JMP RETRN,I * A EQU 0 B EQU 1 RETRN BSS 1 NWORD BSS 1 CWORD BSS 1 IFLAG BSS 1 QOTNT BSS 1 BYTE BSS 1 N1 DEC -1 D10 DEC 10 .60 OCT 60 INAM BSS 1 SPACE ASC 1, END ASMB,R,L,C * NAME: DRT * SOURCE: 92060-18043 * RELOC: 92060-16043 * PGMR: S.P.K. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM DRT,7 92060-16043 760622 ENT DRT DEVICE REFERENCE TABLE IS SCANNED THROUGH TO FIND EXT RMOVI DRT NOP LU# FOR GIVEN SUBCHANNEL AND EQT# LDA DRT,I SAVE RETURN POINTER STA RETRN ISZ DRT LDA DRT,I PICK UP SUBCHANNEL # TO BE FOUND IN DRT LDA A,I STA ISUB ISZ DRT LDA DRT,I PICK UP LAST PLACE (LU) LOOKED AT IN DRT LDA A,I NON-ZERO IF EQT DID NOT SHOW RIGHT DEVICE TYPE STA ILU LDA DRT INA LDA A,I PICK UP EQT# PARAMETER. IF FIRST SUBCHNL EQT# PARM. JSB RMOVI STA IEQT WILL BE 0, ELSE >0 FOR NEXT SUBCHNLS LOOP LDB IDRT ADB ILU INDEX INTO DRT ADB N1 LDA B,I AND .174 FIND SUBCHNL # OF PARTICULAR DRT ENTRY ALF,RAL CPA ISUB JMP EQT JUMP IF MATCHING SUBCHNL # FOUND CHLU LDA ILU HAVE ALL THE ENTRIES IN DRT BEEN CHECKED? CPA LUMAX JMP ERR YES, THEREFORE ERROR ISZ ILU NO, THEREFORE INCREAMENT LU# AND TRY AGAIN JMP LOOP EQT LDB IDRT FIND EQT # FOR GIVEN SUBCHNL ADB ILU ADB N1 LDA B,I AND .77 LDB IEQT,I SZB IF LOOKING FOR SUBCHNL FIRST TIME, * RETURN EQT # TO CHECK FOR DEVICE JMP CHEQT IF LOOKING FOR NEXT SUBCHNL, CHECK IF EQT # MATCHES STA IEQT,I LU LDA DRT,I LDB ILU RETURN LU # FOR GIVEN SUBCHNL STB A,I JMk  P RETRN,I ERR LDA DRT,I NO LU # ASSIGNED TO GIVEN SUBCHNL LDB N1 STB A,I JMP RETRN,I CHEQT CPA B CHECK IF EQT #'S MATCH JMP LU YES. RETURN WITH LU # JMP CHLU NO. TRY WITH NEXT LU # RETRN BSS 1 ISUB BSS 1 IEQT BSS 1 ILU BSS 1 IDRT EQU 1652B FWA OF DRT LUMAX EQU 1653B # OF ENTRIES IN DRT A EQU 0 B EQU 1 .77 OCT 77 .174 OCT 174000 N1 DEC -1 END A ASMB,R,L,C * NAME: DSCAD * SOURCE: 92060-18043 * RELOC: 92060-16043 * PGMR: S.P.K. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM DSCAD,7 92060-16043 760622 EXT EXEC ROUTINE TO FIND LU#, TRACK#, SECTOR # FROM ENT DSCAD DISC ADDRESS WORD. WHERE IF BIT 15=0 LU = 2, DSCAD NOP IF BIT 15=1, LU=3; BITS 7-14 IS TRACK NUMBER; LDA DSCAD,I BITS 0-6 IS SECTOR NUMBER STA RETRN SAVE RETURN POINTER ISZ DSCAD LDA DSCAD,I LDA A,I STA IDADR ISZ DSCAD LDB DSCAD,I STB T1 SSA JMP LU3 LDB D2 STB T1,I LU=2 JMP TRCK LU3 LDB D3 LU=3 STB T1,I TRCK AND .776 FIND TRACK # ISZ DSCAD LDB DSCAD,I ALF,ALF RAL STA B,I STA ITRCK LDA IDADR AND .177 FIND SECTOR # ISZ DSCAD LDB DSCAD,I STA B,I JMP RETRN,I RETURN TO CALLING ROUTINE IDADR BSS 1 T1 BSS 1 ITRCK BSS 1 RETRN BSS 1 MSG ASC 2,HERE D3 DEC 3 D2 DEC 2 D1 DEC 1 .776 OCT 77600 .177 OCT 177 A EQU 0 B EQU 1 END ASMB,R,L,C * NAME: MEMGT * SOURCE: 92060-18043 * RELOC: 92060-16043 * PGMR: S.P.K. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM MEMGT,7 92060-16043 760622 ENT MEMGT ROUTINE TO RETURN CONTENTS OF GIVEN LOC IN MEMORY MEMGT NOP ROUTINE TO GET CONTENTS OF GIVEN MEMORY LOCATION LDA MEMGT,I STA RETRN SAVE RETURN ADDRESS ISZ MEMGT LDA MEMGT,I LDA A,I A REG HAS CONTENTS ADDRESS OF LOCATION LDA A,I A REG HAS CONTENTS OF LOCATION ISZ MEMGT LDB MEMGT,I B REG HAS ADDRESS OF VARIABLE STA B,I JMP RETRN,I RETURN A EQU 0 B EQU 1 RETRN BSS 1 END ASMB,R,L,C * NAME: SUB * SOURCE: 92060-18043 * RELOC: 92060-16043 * PGMR: S.P.K. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM SUB,7 92060-16043 760622 ENT SUB ROUTINE TO DETERMINE SUBCHNL# OF GIVEN LU# SUB NOP LU# ENTRY IN DRT (BITS 11-15) IS USED LDA SUB,I STA RETRN SAVE RETURN ADDRESS ISZ SUB LDB SUB,I B HAS ADDRESS OF SUBCHANNEL LU LDB B,I LU # IN B REG ADB N1 ADB DRT ADDRESS OF FIRST WORD IN DRT LDA B,I DRT ENTRY IN A REG AND .1740 MASK OFF BITS 0-10 ALF,RAL ROTATE BITS 11-15 TO 0-4 POSITION ISZ SUB LDB SUB,I ADDRESS OF ISUB STA B,I PASS BACK SUBCHANNEL # JMP RETRN,I RETURN TO CALLING ROUTINE RETRN BSS 1 A EQU 0 B EQU 1 .1740 OCT 174000 N1 DEC -1 DRT EQU 1652B FWA OF DRT END FTN4,L C NAME: READU C SOURCE: 92060-18043 C RELOC: 92060-16043 C PGMR: S.P.K. C C *************************************************************** C * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * C * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * C * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* C * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C *************************************************************** C SUBROUTINE READU(ITLU,IBUF,ILEN) DIMENSION IBUF(1),IREG(2) EQUIVALENCE (IREG(1),IA,REG),(IREG(2),IB) DATA IABRT/2HAB/,IQUES/2H??/ 5 DO 10 I=1,ILEN IBUF(I)=2H 10 CONTINUE REG = EXEC (1,ITLU+400B,IBUF,ILEN) IF (IB.NEQ.0) GO TO 20 CALL EXEC (2,ITLU,IQUES,1) GO TO 5 20 IF (IBUF(1).NEQ.IABRT) RETURN CALL MESG (ITLU,14) STOP END END$ tASMB,R,L,C * NAME: RMOVI * SOURCE: 92060-18043 * RELOC: 92060-16043 * PGMR: S.P.K. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM RMOVI,7 92060-16043 760622 ENT RMOVI ROUTINE TO REMOVE INDIRECTS FROM GIVEN ADDRESS RMOVI NOP ROUTINE TO REMOVE INDIRECTS FROM DEF ADDRESSES RSS MOREI LDA A,I REG A HAS INDIRECT ADDRESS RAL,CLE,SLA,ERA JMP MOREI STILL AN INDIRECT ADDRESS JMP RMOVI,I * A EQU 0 END jASMB,R,L,C * NAME: MESG * SOURCE: 92060-18043 * RELOC: 92060-16043 * PGMR: S.P.K. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM MESG,7 92060-16043 770214 ENT MESG,ITASK ROUTINE TO PRINT MESSAGES FOR EXT EXEC SAVE, RSTOR AND COPY MESG NOP SUP LDA MESG,I STA RETRN SAVE RETURN ADDRESS ISZ MESG LDA MESG,I LDB A,I STB ITLU ISZ MESG LDA MESG,I LDB A,I STB TEMP MESSAGE # CPB D50 IF MSG# IS 28 CONVERT IT TO 17 LDB D17 LDA MSG ADA B LDB A,I LDA B,I STA IBUFL INB STB MADDR LDA ITASK FIND CORRESP PROG NAME MESG ACCORDING TO TASK ALS MULTIPLY TASK # BY 2 ADA ITASK TASK# * 3 ADA NADDR ADDRESS OF BEGINING OF MESSAGES WITH NAMES STA ADDR LDA TEMP MESSAGE #? CPA D11 IS IT RESTART ------ BY ENTERING........? JMP MESG1 YES CPA D14 IS IT ----- ABORTED? JMP MESG2 CPA D25 IS IT MESG # 25? JMP MESG2 YES CPA D17 IS IT MESG # 17? JMP MESG3 YES CPA D50 USE DIFFERENT NAME ADDR FOR MESG 28 RSS JMP MESG5 LDA ADDR2 RSS MESG3 LDA ADDR1 ADB D7 JSB MOVE JMP MESG5 MESG2 LDA ADDR YES, THEN A REG HAS ADDR OF NAME JSB MOVE MOVE NAME MESSAGE INTO MESSAGE 14 JMP MESG5 SEND MESSAGE OUT TO TTY MESG1 LDA ADDR MESSAGE OF NAME ADB D4 INDEX INTO IT JSB MOVE ZkMOVE APPROPRIATE NAME IN IT LDA ADDR MESSAGE OF NAME LDB MADDR ADB D15 INDEX FURTHER INTO MSG11 JSB MOVE MOVE WORDS MESG5 JSB EXEC DEF *+5 DEF ICODE DEF ITLU DEF MADDR,I DEF IBUFL JMP RETRN,I * MOVE NOP ROUTINE TO MOVE THREE WORDS FROM STA TEMP SAVE CONTENTS OF A REG LDA N3 STA COUNT COUNTER LOOP LDA TEMP LDA A,I STA B,I INB ISZ TEMP ISZ COUNT JMP LOOP JMP MOVE,I RETURN * MSG DEF MESGX MESGX DEF MSG0 DEF MSG1 DEF MSG2 DEF MSG3 DEF MSG4 DEF MSG5 DEF MSG6 DEF MSG7 DEF MSG8 DEF MSG9 DEF MSG10 DEF MSG11 DEF MSG12 DEF MSG13 DEF MSG14 DEF MSG15 DEF MSG16 DEF MSG17 DEF MSG18 DEF MSG19 DEF MSG20 DEF MSG21 DEF MSG22 DEF MSG23 DEF MSG24 DEF MSG25 DEF MSG26 DEF MSG27 DEF MSG28 * A EQU 0 B EQU 1 RETRN BSS 1 ITLU BSS 1 IBUFL BSS 1 ICODE DEC 2 MSG0 DEC 8 ASC 8,VERIFY? (YES/NO) MSG1 DEC 12 ASC 12,PARTITION SIZE TOO SMALL MSG2 DEC 17 ASC 17,6144 WORD BUFFER DESIRED? (YES/NO) MSG3 DEC 30 ASC 4,WARNING- ASC 26,PARTITION SIZE TOO SMALL FOR VERIFY W/ 6144 WORD BUF MSG4 DEC 16 ASC 16,FOLLOWING TRCK MAP TBL NOT FOUND MSG5 DEC 3 ASC 3,FILE#? MSG6 DEC 21 ASC 21,FOLLOWING DISC DRIVE# IMPROPER,ENTER AGAIN MSG7 DEC 20 ASC 20,FOLLOWING DISC LU# IMPROPER, ENTER AGAIN MSG8 DEC 11 ASC 11,IMPROPER MT LU#, LU#=? MSG9 DEC 16 ASC 16,ASSIGN LU# TO FOLLOWING SUBCHNL MSG10 DEC 15 ASC 15,NO WRITE RING, WRITE ENABLE MT MSG11 DEC 19 ASC 19,RESTART BY ENTERING 'GO, ' MSG12 DEC 13 ASC 13,EOT REACHED,MOUNT NEW TAPE MSG13 DEC 17 ASC 17,DISC ERROR AT FOLLOWING TRCK & LUJ) # MSG14 DEC 7 ASC 7, ABORTED MSG15 DEC 20 ASC 20,FOLLOWING DISC TYPE IMPROPER,ENTER AGAIN MSG16 DEC 22 ASC 22,SOURCE & DEST TRACK MAP INFO. NOT COMPATIBLE MSG17 DEC 16 ASC 16,DISC TYPE FOR DISC UNIT? MSG18 DEC 7 ASC 7,IMPROPER FILE# MSG19 DEC 7 ASC 7,FILE NOT FOUND MSG20 DEC 17 ASC 17,SAVE TYPE NOT SAME AS RESTORE TYPE MSG21 DEC 17 ASC 17,WARNING-WRITING ON PROTECTED TRCKS MSG22 DEC 13 ASC 13,DEST SUBCHNL IS LU2 OR LU3 MSG23 DEC 20 ASC 20,OFF-LINE SAVE,CANNOT BE RESTORED ON-LINE MSG24 DEC 7 ASC 7,MOUNT TAPE# 1 MSG25 DEC 14 ASC 14, WAITING FOR MT LU LOCK MSG26 DEC 18 ASC 18,MISSING REC FOR FOLLOWING TRCK & LU# MSG27 DEC 27 ASC 27,WARNING-VERFY NOT DEFINED OR PARTITION SIZE TOO SMALL MSG28 DEC 11 ASC 11,IMPROPER TRCK MAP INFO NADDR DEF *+1 MSAVE ASC 3,SAVE MRSTR ASC 3,RSTOR MCOPY ASC 3,COPY ADDR1 DEF *+1 ASC 3,SOURCE ADDR2 DEF *+1 ASC 3,DEST ITASK BSS 1 MADDR BSS 1 ADDR BSS 1 D4 DEC 4 D7 EQU MSG14 D11 EQU MSG8 D14 EQU MSG25 D15 EQU MSG10 D17 EQU MSG2 D25 DEC 25 D50 DEC 50 N3 DEC -3 TEMP BSS 1 COUNT BSS 1 END LU v4 92060-18045 1631 S 0122 &RDNAM READ NAMR PROGRAM             H0101 SPL,L,O ! NAME: RDNAM ! SOURCE: 92060-18045 ! RELOC: 92060-16045 ! PGMR: A.M.G. ! ! *************************************************************** ! * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * ! * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * ! * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* ! * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ! *************************************************************** ! NAME RDNAM(3,99) "92060-16045 REV.1631 760413" ! ! LET RMPAR, \PARAMETER PASSING READF, \FILE READ OPEN, \FILE OPEN CLOSE, \FILE CLOSE PRTN, \PARAM. PASS TO CALLER EXEC \RTE SYSTEM CALLS BE SUBROUTINE,EXTERNAL ! LET PRAM1,PRAM2,PRAM3,PRAM4,PRAM5, \CALLING PARAMETERS DCB(144), \DCB BUFFER RTN1,RTN2,RTN3,RTN4,RTN5, \RETURN PARAMETERS IL \RECORD LENGTH BE INTEGER ! ! ! THE FOLLOWING PROGRAM READS A CASSETTE DIRECTORY FILE ! WHICH HAS BEEN READ INTO A FMGR FILE, AND FOR EACH ! RECORD READ, RETURNS A FILE NAME TO BE READ FROM THE ! CASSETTE AND UPDATED ONTO THE RTE MASTER CARTRIDGE. ! ! ! RDNAM: RMPAR(PRAM1) !GET CALLING PARS. OPEN(DCB,RTN5,PRAM1) !OPEN DIRECTORY FILE. IF RTN5 < 0 THEN GOTO ERRET !IF ERROR, LEAVE. RDREC: READF(DCB,RTN5,RTN1,4,IL) !READ A RECORD. IF RTN5 < 0 THEN GOTO ERET1 !IF ERROR, LEAVE. IF IL = -1 THEN GOTO TERM !IF EOF, STOP. IF RTN4 < 0 THEN GOTO RDREC !IF DELETED FILE, RETRY. RTN4 _ (RTN4 AND 377K) OR 20000K PRTN(RTN1) )   !RETURN FILE NAME. EXEC(6,0,1) !TERM. SAVING RESOURCES. GOTO RDREC TERM: RTN1 _ -1 ERET1: CLOSE(DCB) ERRET: PRTN(RTN1) EXEC(6) END RDNAM END$ f  w~ 92060-18046 1805 S C0122 &UPDAT UPDATE TRANSFER FILE             H0101 :SV,4 :***** :*****NAME: &UPDAT :*****SOURCE: 92060-18046 :***** REV 1805,771108 :***** :TE,*****RTE MASTER SOFTWARE DISC UPDATE PROCESS! :SE,RT,32767,&DRCTY,1,0 :CA,6:P,0 :ST,3G,0 :IF,6P,EQ,-6,3 :TE,*****&UPDAT CREATES AND USES FILE &DRCTY AS A :TE,***** DIRECTRY FILE. PURGE &DRCTY BEFORE STARTING. :IF,,EQ,,71 :CA,6:P,0 ::&PKDIS :IF,6P,NE,11,3 :TE,*****OF,XXXXX,8 ANY RP'ED PROGRAMS ON :TE,***** ON THE RTE MASTER SOFTWARE DISC. :IF,,EQ,,65 :IF,6P,NE,-8,3 :TE,*****FILE OPEN OR LOCK REJECTED ON THE :TE,***** RTE MASTER SOFTWARE DISC. :IF,,EQ,,61 :LG,1 :MR,%RDNAM:1G:2G :IF,6P,NE,-6,4 :TE,*****RELOCATABLE OF PROGRAM RDNAM NOT FOUND. :TE,***** CHECK TO MAKE SURE %RDNAM IS ON THE :TE,***** RTE MASTER SOFTWARE DISC. :IF,,EQ,,54 :TE,*****PROGRAM RDNAM IS BEING LOADED. :RU,LOADR,99,64,0 :IF,1P,NE,0,1 :RU,LOADR,,%RDNAM:1G:2G,0 :CN,5,RW :ST,5,3G:::3:-1 :IF,6P,NE,-6,5 :TE,*****NO ROOM ON DISK FOR DIRECTORY FILE. :TE,***** CHECK TO MAKE SURE THAT THE CARTRIDGE :TE,***** REFERENCE NUMBER OF THE MASTER RTE :TE,***** DISK IS 32767. :IF,,EQ,,38 :ST,3G,0 :IF,6P,NE,-6,4 :TE,*****MINI CARTRIDGE DIRECTORY NOT FOUND. :TE,***** CHECK TO MAKE SURE THAT THE MINI :TE,***** CARTRIDGE IS IN LU 5. :IF,,EQ,,31 :CA,4 :TE,*****THE FOLLOWING FILES ON THE RTE MASTER :TE,***** SOFTWARE DISC ARE BEING PURGED. :RU,RDNAM,-27P,-26P,-25P,4G :CA,4,1 :IF,1P,EQ,-1,3 :DP,10G :PU,10G:1G:2G :IF,,EQ,,-6 :TR,&PKDIS :CA,4 :TE,*****THE FOLLOWING MINI CARTRIDGE FILES ARE BEING :TE,***** ADDED TO THE RTE MASTER SOFTWARE DISC. :RU,RDNAM,-27P,-26P,-25P,4G :CA,4,1 :IF,1P,EQ,-1,14 :IF,4P,EQ,20101B,6 :IF,4P,EQ,20122B,7 :IF,4P,EQ,20123B,8 :TE,*****THE TYPE OF THE NEXT MINI CARTRIDGE FILE TO BE :TE,***** TRANSFERRED IS NOT S,R, OR A AND IS BEING IGNORED. :ST,5,0 :IF,,EQ,,5 :ST,5,10G:1G:2G:7:-1,BA :IF,,EQ,,3 :ST,5,10G:1G:2G:5:-1,BR :IF,,EQ,,1 :ST,5,10G:1G:2G:4:-1,AS :DP,10G :IF,,EQ,,-17 :CA,6:P,0 :TE,*****RTE MASTER SOĺ  FTWARE DISC UPDATE IS NOW COMPLETE. :PU,3G :CN,5,RW :TE,*****PROGRAM RDNAM WILL BE ABORTED. :OF,RDNAM :TE,*****MINI CARTRIDGE MAY BE REMOVED WHEN :TE,***** REWIND IS COMPLETE. :CN,5,RW :TE,* :IF,6P,EQ,0,2 :TE,*****UPDATE ABORTED! :IF,,EQ,,1 :TE,*****UPDATE DONE! :TE,* :LG,0 :EX õ  x 92060-18047 1631 S 0122 &PKDIS PKDISC TRANSFER FILE             H0101 :***** :*****NAME: &PKDIS :*****SOURCE: 92060-18047 :***** REV.1631,760624 :***** :PK,32767,RT :: 3 y 92060-18048 1805 S C0622 DBKUPS OFF LINE DISC BACK UP PROGRAM UP             H0106 ASMB,R,L,C * NAME: DBKUP * SOURCE: 92060-18048 * RELOC: 92060-16048 * PGMR: S.P.K. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM DBKUP,3,99 92060-16048 REV.1805 771202 * OFF-LINE DISC BACKUP UTILITY EXT $LIBR,$LIBX,EXEC,COR.A SUP A EQU 0 B EQU 1 NSUB NOP # OF SUBCHANNELS ON 7905 DISC UNIT ISIZE NOP SIZE OF REC READ FROM DISC JSIZE NOP SIZE OF RECORD READ FROM OR WRITTEN TO MT INCR NOP INCREMENTS FOR SECTOR COUNT M24K NOP VRFLG NOP DOSDF NOP TEMP NOP TEMP1 NOP TEMP2 NOP SUB# NOP TRACK NOP TRCK1 NOP UN#IT NOP SUNIT NOP DUNIT NOP SVTPN NOP HEADR BSS 140 AHDR DEF HEADR TAPEN EQU HEADR+36 SVTYP EQU HEADR+38 SYSTP EQU HEADR+40 IREC EQU HEADR+41 TRKMP EQU HEADR+42 AMAP1 DEF HEADR+42 AMAP2 DEF HEADR+43 ATB31 NOP ATB32 NOP KB BSS 6146 SUB1# EQU KB JB EQU KB+2 C1 EQU JB C2 EQU JB+1 C3 EQU JB+2 C4 EQU JB+3 C5 EQU JB+4 C6 EQU JB+6 C7 EQU JB+8 C8 EQU JB+9 LB EQU KB+2048 MB EQU LB+2048 AKB DEF KB AJB DEF JB ALB DEF LB AMB DEF MB LABEL BSS 128 LABEL BUFFER FOR DOS SUBCHNLS ALABL DEF LABEL D128 DEC 128 YE ASC 1,YE D1 DEC 1 D2 DEC 2 D3 DEC 3 D4 DEC 4 D5 DEC 5 D6 DEC 6 D7 DEC 7 D8 DEC 8 D9 DEC 9 D10 DEC 10 D11 DEC 11 D12 DEC 12 D13 DEC 13 D14 DEC 14 D15 DEC 15 D16 DEC 16 D17 DEC 17 D19 DEC 19 D20 DEC 20 D21 DEC 21 D22 DEC 22 D23 DEC 23 D25 DEC 25 D28 DEC 28 D30 DEC 30 D36 DEC 36 D140 DEC 140 D96 DEC 96 D410 DEC 410 D411 .DEC 411 D2048 DEC 2048 D6144 DEC 6144 N1 DEC -1 N2 DEC -2 TST05 DEF *+1 N411 DEC -411 N1234 DEC -1234 N4 DEC -4 N3 DEC -3 ASC 2, 410 ASC 2,1233 ASC 1, 2 ASC 1, 3 DEC -411 DEC -1645 DEC -5 DEC -4 ASC 2, 410 ASC 2,1644 ASC 1, 3 ASC 1, 4 N823 DEC -823 N4116 DEC -4116 N6 DEC -6 N5 DEC -5 ASC 2, 822 ASC 2,4115 ASC 1, 4 ASC 1, 5 SECTR NOP #SPTR NOP # OF SPARE TRACKS FOR SUBCHNL CSPAR NOP BASE ADDR OF SPARE TRACK POOL UBADC NOP # OF USED SPARES PT#TR NOP CYLINDER # H#AD NOP HEAD # ITLU EQU D1 OPERATOR CONSOLE LU MTLU EQU D8 MAG TAPE LU SORCE ASC 3,SOURCE DEST ASC 3,DEST SAVE ASC 2,SAVE COPY ASC 2,COPY CLF CLF 0 JSBCI NOP MTRCN NOP DBKUP LIA 1 READ SWITCH REGISTER CONTENTS SZA,RSS 0? JMP NOCNF YES - RE-CONFIGURATION OF MT AND TTY IS NOT STA SWREG DESIRED JSB CNFIG RE-CONFIGURE RTE-M FOR MT AND TTY CHANNELS JMP STRT1 * NOCNF JSB WRITE DISC BACKUP UTILITY DEF MSG1 DEF D10 LDA CLF INSERT CLF INSTR IN TRAP CELL FOR DVR05 DEVICE ADA .12 STA .12,I NOCN1 JSB QTASK TASK? TASK=0 - SAVE, 1=RESTORE LDA TASK CPA D2 IS TASK COPY? JMP STRT1 YES LDA MTRCN NO, THEN IS RECONFIGURATION OF MT CHANNEL REQRD? SZA JSB CNFIG YES * STRT1 DLD AMAP1 DST ATB31 CLA STA VFLAG STA VRFLG STA DOSDF STA RTFLG INA STA M24K LDA TASK IS TASK RESTORE? CPA D1 JMP RSTOR HANDLE RESTORE SEPARATELY CLA INITIALIZE RECORD SIZE INDICATOR STA IREC JSB QDISC QUERY DISC FEATURES JSB V6144 VERIFY POSSIBLE W/ 6144 WORD BUF? SZA JMP SACO1 YES,ASK IF LARGE BUFFER SIZE IS DESIRED? A JSB WRITE DEF ERR0 DEF D5 JSB WRITE NO, GIVE WARNING MESSAGE DEF MSG25 WARNING - MEM SIZE TOO SMALL FOR VERIFY W/ DEF D23 6144 WORD BUF CLA STA M24K M24K=0 IF VERIFY W/ 6144 WORD BUF NOT POSSIBLE * = 1 OTHERWISE SACO1 JSB QUERY DEF MSG24 6144 WORD BUFFER DESIRED? DEF D13 DEF EXP6 REPLY YES OR NO DEF D10 LDA RBUF WHAT IS THE RESPONSE? CPA YE JMP SAC20 NO LDA D2048 STA JSIZE SIZE OF BUFFER TO BE READ OR WRITTEN TO MT LDA D32 STA INCR JMP SACO2 SAC20 LDA D6144 YES STA JSIZE LDA D96 STA INCR INCREMENT = 96 SECTORS CLA,INA IREC=1 TO INDICATE 6144 WORD REC SIZE STA IREC LDA M24K VERFIFY POSSIBLE? SZA,RSS JMP SACO3 NO * WANT VERIFY? SACO2 JSB QUERY DEF MSG17 VERIFY? DEF D4 DEF EXP6 REPLY YES OR NO DEF D10 LDA RBUF CPA YE YES? ISZ VRFLG VRFLG=1 INDICATES THAT VERIFY IS DESIRED SACO3 LDA TASK TASK? SZA SAVE? JMP SACO4 NO, COPY CLA STA FILEN FILE# INITIALIZED TO 0 JSB WRITE SET UP HEADER RECORD AND WRITE IT ON MT DEF MSG15 FILE ID? DEF D4 SACO9 LDA N36 STA COUNT COUNTER LDA SPACE CLEAR FILE ID BUFFER LDB AHDR ADDRESS OF HEADER RECORD STA B,I INB POINT TO NEXT WORD IN FILE ID BUFFER ISZ COUNT INCREMENT COUNT JMP *-3 IF ALL 36 WORDS NOT CLEARED, CLEAR NEXT ONE JSB EXEC READ RESPONSE IN HEADER BUFFER DEF *+5 DEF D1 DEF RITLU ITLU+400B DEF HEADR DEF D36 LDA HEADR HELP NEEDED? CPA QUES ?? RSS JMP SACO8 NO JSB WRITE YES-EXPLAIN DEF EXP15 ENTER MT FILE ID OF MAX 72 CHAyRR DEF D17 JMP SACO9 ASK FOR FILE ID AGAIN * SACO8 JSB MTNR MT READY? JSB WRING WRITE RING IN? JSB POSN POSITION MAG TAPE CLA,INA TAPE# = 1 STA TAPEN LDA SDTYP SOURCE DISC TYPE STA HEADR+37 LDA COTYP COPY TYPE CMA,INA -VE TO INDICATE OFF-LINE SAVE STA HEADR+38 JSB EXEC WRITE HEADER RECORD ON MT DEF *+5 DEF D2 DEF MTLU DEF HEADR DEF D140 * SACO4 LDA D6144 6144 WORD BUFFERS TO READ & WRITE ON DISC STA ISIZE LDA SDTYP SOURCE DISC TYPE? CPA D7900 7900 DISC? RSS YES JMP SAC05 NO, 7905 OR 7920 LDA PLATR PLATR # INDICATES SUBCHANNEL # FOR 7900 DISC STA SUB# SACO0 JSB TSTC0 FIND SIZE OF SUBCHANNEL STB NTRCK SIZE (# OF TRACKS) RETURNED IN AREG CLA STA TRACK STA KB+1 SACO5 OTA 1 OUTPUT TRACK # TO SWITCH REGISTER LDA SUNIT SOURCE UNIT FOR DISC DRIVER STA UN#IT CLA SECTOR # = 0 STA SECTR LDB AJB CORE ADDRESS OF BUFFER JSB RD00 READ A TRACK FROM 7900 DISC LDA TASK TASK IS SAVE? SZA JMP SACO6 NO,COPY JSB WRTMT YES WRITE RECORD ON MAG TAPE JMP SACO7 SACO6 LDA DUNIT SET UP UNIT # FOR DESTINATION DISC STA UN#IT LDB AJB CORE ADDRESS OF BUFFER JSB WR00 WRITE TRACK ON 7900 DEST DISC SACO7 ISZ TRACK GO TO NEXT TRACK LDA TRACK STA KB+1 CPA NTRCK ALL TRACKS IN SUB# READ? RSS JMP SACO5 NO, DO NEXT ONE LDA COTYP YES, DONE IF COPY TYPE IS FROM-TO CPA D2 UNIT COPY? RSS JMP DONE NO, SO DONE LDA SUB# YES, SUBCHNL # SZA JMP DONE SUB# = 1, THEREFORE DONE ISZ SUB# SUB#=0, SO SAVE OR COPY SUB# 1 LDA SUB# JMP SACO0 * X* SOURCE DISC IS 7905 OR 7920 * SAC05 LDA ATB32 # OF SUBCHNLS IS STORED IN FIRST WORD OF TMT ADA N1 LDA A,I SSA IF -VE CONVERT IT TO A +VE # CMA,INA STA NSUB # OF DEFINED SUBCHNLS IN TRACK MAP TABLE CLA STA SUB# FIRST SUB# = 0 SAC09 JSB TSTC5 GET # TRACKS & BASE ADDR OF SPARE TRK POOL LDA ATB32 # OF SUBCHNLS ENTRY IN AREG ADA N1 LDA A,I SSA,RSS IF TRACK SPARING IS DESIRED, THIS ENTRY IS -VE JMP SAC08 ENTRY IS +VE SO NO TRACK SPARING IS DESIRED JSB NSPRS TRCK SPARING WANTED,FIND # SPARE TRACKS FOR SUB# STA #SPTR # OF SPARES RETURNED IN A REG SAC08 CLA STA UBADC # OF USED SPARES STA TRACK COUNTER FOR TRACK # STA SECTR SECTOR # STA KB+1 SAC07 OTA 1 LDB SUB# CURRENT SUBCHNL# BLS SUB#*2 ADB SUB# SUB#*3 ADB ATB32 ADD ADDR OF TRACK MAP TABLE STB DIST1 ADDR OF TRACK MAP INFO FOR SUB# LDA SUNIT STA UN#IT SET UP SOURCE UNIT # FOR DRIVER JSB RD05 READ A RECORD FROM 7905 SOURCE DISC LDA TASK TASK? SZA SAVE? JMP SAC06 NO, COPY JSB WRTMT YES, WRITE RECORD ON TAPE JMP SAC10 SAC06 LDA DOSDF WAS THE DEFECTIVE TRACK FLAG FOR SZA DOS DISC TURNED ON? JMP INIEW YES, GO SPARE THIS TRACK TOO LDA DUNIT WRITE DATA ON DESTINATION DISC UNIT STA UN#IT LDB AJB JSB WR05 WRITE TRACK ON 7905 DISC SAC10 ISZ TRACK INCREMENT TRACK# LDA TRACK STA KB+1 CPA NTRCK ALL TRACKS IN SUB# SAVED OR COPIED? RSS JMP SAC07 NO DO THIS TRACK LDA SYSTP YES - SYSTEM TYPE? SZA,RSS RTE? JMP SAC11 LDA COTYP DOS SYSTEM - COPY TYPE? CPA D2 UNIT? JSB LBCNG YES, UPDATE USER LABEL ON SUB# TO REFLECT # OF * Q BAD TRACKS AND NEXT AVAILABLE SPARE ENTRIES SAC11 ISZ SUB# GO TO NEXT SUBCHNL LDA SUB# CPA NSUB ALL SUBCHNLS DEFINED HAVE BEEN SAVED OR COPIED? JMP DONE YES JMP SAC09 NO, SAVE OR COPY THIS SUB# * * TASK IS TO RESTORE MAG TAPE * RSTOR CLA STA FILEN FILE # INITIALIZED TO 0 STA EOFLG END OF FILE FLAG INITIALIZED TO 0 JSB MTNR MT READY? JSB POSN ASK FOR FILE# AND POSITION MT TO IT JSB PRNTH READ AND PRINT HEADR INFO DEF HEADR ADDRESS OF HEADER BUFFER JMP RSTR2 CORRECT TAPE JSB WRITE MOUNT CORRECT TAPE DEF MSG26 DEF D9 JSB PAUSE TAPE IS NOT OK, WAIT FOR USER TO MOUNT JMP RSTOR RIGHT TAPE, POSITION, PRINT HEADER, ETC. AGAIN * RSTR2 LDA SVTYP SSA CMA,INA IF COPY TYPE IS -VE CONVERT TO +VE STA COTYP LDA HEADR+37 STA SDTYP READ SOURCE DISC TYPE FROM HEADER STA DTYPE DEST DISC TYPE IS SAME AS SOURCE DISC TYPE JSB QDISC QUERY DISC FEATURES LDA D6144 INITIALIZE ISIZE TO 6144 STA ISIZE LDB IREC BUFFER SIZE OF SAVE RECORDS? SZB,RSS REC=6144 WORDS? JMP RSTR8 STA JSIZE YES, SET UP SIZE AND INCR FOR MAG TAPE RECORDS LDA D96 STA INCR INCREMENTS FOR SECTOR #'S JSB V6144 CAN VERIFY BE DONE W/ 6144 WORD BUFFER? SZA JMP RSTR3 YES, MEMORY IS >= 24K JSB WRITE DEF ERR0 WARNING-- DEF D5 JSB WRITE NO, SEND WARNING MESSAGE DEF MSG25 WARNING-MEM SIZE TOO SMALL FOR VERIFY W/ 6144 DEF D23 WORD BUFFER JMP RSTR4 RSTR8 LDB D2048 REC SIZE IS 2048 WORDS STB JSIZE LDB D32 STB INCR * WANT VERIFY? RSTR3 JSB QUERY DEF MSG17 VERIFY? DEF D4 DEF EXP6 REPLY YES OR NO DEF D10 LDA RBUF CHECK RESPONSE CPA YE YES? ISZ VRFLG VERIFY WANTED, TURN FLAG ON TO INDICATE THIS * * RSTR4 LDA N1 SET SUBCHNL# TO -1 STA SUB# LDA SVTYP WAS SAVE DONE ON-LINE OR OFF-LINE? SSA JMP RSTR7 OFF-LINE SAVE LDA TRKMP LDB SDTYP ON-LINE SAVE - SOURCE DISC TYPE? CPB D7900 7900? JMP RSTR6 YES SSA,RSS IF FIRST WORD +VE THEN USER DEFINED TRACK MAP ISZ ATB32 START OF TRACK MAP INFO IS INCREMENTED BY 1 JMP RSTR9 RSTR6 SSA SOURCE DISC WAS A 7900 ISZ ATB31 USER DEFINED TRACK MAP TABLE JMP RST10 RSTR7 LDA SDTYP OFF-LINE SAVE - SOURCE DISC TYPE? CPA D7900 7900? JMP RST10 YES RSTR9 LDA ATB32 COMPUTE # OF SUBCHANNELS DEFINED ADA N1 IN TRACK MAP TABLE LDA A,I SSA # OF SUBCHNLS -VE? CMA,INA YES, CONVERT IT TO +VE STA NSUB # OF SUBCHNLS DEFINED ON 7905 SOURCE DISC RST10 JSB RDMT READ ALL RECORDS FROM MT THAT BELONG LDA EOFLG TO SAME TRACK -- GET END OF FILE FLAG SZA,RSS SET? JMP RST17 NO LDA SDTYP YES CPA D7900 7900 DISC? JMP DONE YES, THEN DONE LDA COTYP CPA D2 UNIT COPY? RSS JMP DONE NO, THEN DONE LDA SYSTP SZA,RSS DOS SYSTEM? JMP DONE NO, THEN DONE JSB LBCNG UPDATE LABELS ON DOS SUBCHNL JMP DONE RST17 LDA KB+1 WAS THIS TRACK USUCCESSFULLY SAVED? SSA,RSS JMP RST11 NO ELA,CLE,ERA CLEAR SIGN BIT STA TRACK JSB WRITE YES - PRINT WARNING MESSAGE DEF ERR0 WARNING - DEF D5 JSB WRITE DEF MSG30 TRACK AT FOLLOWING LOC WAS NOT SAVED SUCCESSFULLY DEF D25 LDA TRACK LDB SDTYP SOURCE DISC TYPE CPB D7900 7900 DISC? JMP RST12 YES JSB PTRK5 PRINT LOCTION OF TRACK JMP RST14 RST12 LDA KB FIND REAL TRACK # ELA,CLE,ERA CLEAR SIGN BIT ADA ATB31 ADD ADDRESS OF TRACK MAP TABLE LDA A,I FIRST TRACK # OF SUBCHANNEL ADA TRACK ADD RELATIVE TRACK # JSB PTRK0 PRINT LOC OF TRACK FOR 7900 DISC RSS RST11 STA TRACK RST14 LDA TRACK OTA 1 OUTPUT TRACK # TO SWITCH REGISTER CLA SECTOR # = 0 STA SECTR LDA DUNIT SET UNIT # FOR DRIVER STA UN#IT LDA SDTYP SOURCE DISC TYPE? CPA D7900 7900 DISC? JMP RST15 YES LDA DOSDF NO, IS THIS A DOS DISC AND IF SO WAS THE PREVIOUS SZA TRACK DEFECTIVE? JMP INIEW YES, THEN MARK THIS ONE DEFECTIVE & SPARE IT LDA SUB# SAVE ORIGINAL VALUE OF SUB# STA SUB LDA KB IS THIS A NEW SUBCHNL? ELA,CLE,ERA CLEAR SIGN BIT CPA SUB# JMP RST16 NO, IT IS SAME AS BEFORE STA SUB# JSB TSTC5 GET #TRCKS & BASE SPARE POOL ADDR FOR SUB# LDA ATB32 TRACK MAP TABLE ADDRESS ADA N1 LDA A,I IF VALUE -VE THEN TRACK SPARING DESIRED SSA,RSS JMP RST16 TRACK SPARING NOT DESIRED LDB SYSTP SZB,RSS DOS SYSTEM? JMP RST18 NO, RTE LDA SUB WAS ORIGINAL VALUE -1? SSA JMP RST19 YES,THEN DONT CHANGE ANY LABELS LDB SUB# STB SUB SAVE NEW VALUE OF SUB# STA SUB# JSB LBCNG UPDATE LABELS ON DOS SUBCHNL JMP RST19 RST18 JSB NSPRS FIND # OF SPARE TRACKS ALLOWED FOR THIS SUB# STA #SPTR RST19 CLA STA UBADC INITIALIZE # OF USED SPARES TO 0 RST16 JSB WR05 WRITE RECORD ON 7905 DISC RSS RST15 JSB WR00 DISC IS 7900 - WRITE REC ON IT JMP RST10 READ NEXT RECORD FROM MT * * TASK IS COMPLETED, NOW CHECK IF VERIFY REQUESTED * DONE LDA TASK WAS TASK SAVE? SZA JMP DONE1 NO LDA MTLU  ADA .100 SET UP CONTROL WORD FOR EOF MARK STA TEMP1 JSB EXEC YES THEN WRITE AN EOF MARK ON MT DEF *+3 DEF D3 DEF TEMP1 EOF MARK DONE1 LDA VRFLG LOAD VERIFY FLAG SZA JMP VERFY IT IS ON, SO VERIFY DATA JUST TRANSFERRED JMP EXIT TERMINATE UTILITY * * ENTER HERE WHEN UTILITY HAS TO BE ABORTED * EXITU JSB WRITE DEF MSG20 DISC BACKUP UTILITY IS ABORTED DEF D15 JMP NOCN1 ASK FOR NEXT TASK EXIT JSB WRITE TASK COMLETED DEF MSG19 DEF D7 LDA TASK TASK IS COPY? CPA D2 JMP NOCN1 YES THEN DONE JSB MTNR MAG TAPE READY? JSB REWND NO, THEN REWIND MAG TAPE JMP NOCN1 ASK FOR NEXT TASK * * * VERIFY DATA * VERFY ISZ VFLAG VFLAG=1 TO INDICATE VERIFY OPERATION JSB WRITE INFORM USER THAT DATA IS NOW BEING VERIFIED DEF MSG31 VERIFYING DEF D5 LDA JSIZE SET UP SIZE DISC BUFFER TO MATCH MT BUFFER STA ISIZE LDA TASK CPA D2 TASK IS COPY? JMP VRF10 YES, HANDLE IT SEPARATELY LDA TAPEN TAPE# STA SVTPN SAVE TAPE# INDICATING LAST TAPE USED CPA D1 TAPE# = 1? JMP VERF3 YES VERF1 JSB WRITE NO DEF MSG29 MOUNT TAPE# 1 DEF D7 JSB REWND JSB PAUSE WAIT FOR USER TO MOUNT FIRST TAPE JSB MTNR MT READY? JSB POSN POSITION IT TO FILE# IN FILEN JSB PRNTH PRINT HEADER AND ASK OK ON TAPE DEF HEADR ADDRESS OF BUFFER FOR HEADER REC JMP VERF4 TAPE OK JMP VERF1 TAPE NOT OK - TRY AGAIN * VERF3 JSB MTNR MT READY? JSB POSN POSITION MT TO FILEN JSB EXEC DEF *+5 DEF D1 DEF MTLU READ HEADER RECORD DEF HEADR DEF D140 * VERF4 LDA TASK SZA TASK WAS SAVE? JMP VERF5 NO - IT WAS RESTORE LDB uSDTYP SOURCE DISC TYPE STB DSCTP LDB SUNIT SOURCE DISC UNIT # STB UN#IT JMP VLOOP VERF5 LDB DTYPE DESTINATION DISC TYPE STB DSCTP LDB DUNIT DEST UNIT# STB UN#IT LDA COTYP IS IT A FR-TO? CPA D3 RSS JMP VLOOP NO LDA DSUB# YES, THEN DEST SUB# STA SUB# LDA DPLTR DEST PLATTER # STA PLATR VLOOP CLA SECTOR # IS 0 STA SECTR INA STA VRFLG RESET VRFLG VLP1 LDA MTLU EOT REACHED? ADA .600 STA TEMP2 CONTROL WORD FOR DYNAMIC STATUS OF MT JSB EXEC FIND DYNAMIC STATUS OF MT DEF *+3 DEF D3 DEF TEMP2 AND .40 AREG HAS STATUS WORD CPA .40 IF BIT 5 IS ON, EOT HAS BEEN REACHED RSS JMP VERF6 EOT NOT REACHED LDA SVTPN EOT REACHED CPA TAPEN IS THIS EOF TOO? JMP VDONE ALL TAPES HAVE BEEN VERIFIED, DONE JSB WRITE ASK FOR NEXT TAPE TO BE MOUNTED DEF MSG18 EOT READCHED, MOUNT NEXT TAPE DEF D14 JSB REWND REWIND MAG TAPE VERF7 JSB PAUSE WAIT FOR TAPE TO BE MOUNTED JSB MTNR MAG TAPE READY? JSB REWND REWND MAG TAPE JSB PRNTH PRINT HEADER REC INFO & ASK IF OK DEF HEADR JMP VERF6 TAPE OK JSB WRITE MOUNT CORRECT TAPE DEF MSG26 DEF D9 JMP VERF7 RIGHT TAPE NOT MOUNTED, WAIT AGAIN VERF6 LDA JSIZE ADD 2 WORDS FOR HEADER INFO ADA D2 STA TEMP1 JSB MTNR MAG TAPE READY? JSB EXEC READ RECORD FROM MAG TAPE DEF *+5 DEF D1 DEF MTLU DEF KB DEF TEMP1 SZB,RSS EOF REACHED? JMP VDONE YES LDA TASK SAVE? SZA,RSS JMP VRF32 YES LDA COTYP CPA D3 FROM - TO COPY? JMP VRF30 YES VRF32 LDA KB NO ELA,CLE,ERA CLEAR SI VGN BIT STA SUB# VRF30 LDA KB+1 ELA,CLE,ERA CLEAR SIGN BIT STA TRACK OTA 1 OUTPUT TRACK # TO SWITCH REG LDA JSIZE IS BUFFER SIZE 6144 WORDS? CPA D6144 JMP VERF2 YES THEN USE BUFFER AT END OF SUBROUTINES LDB AJB ADB JSIZE CORE BUFFER ADDRESS RSS VERF2 LDB AVBUF CCE E REG = 1 FOR READ OPERATION CLA STA INIT1 CLEAR INIT BIT FOR DISK DRIVER LDA DSCTP DISC TYPE? CPA D7900 7900 DISC? JMP VERF8 YES LDA TASK SAVE? SZA,RSS JMP VRF19 YES LDA COTYP CPA D3 FROM - TO COPY? JMP VRF12 YES VRF19 LDA SUB# SET UP TRACK MAP ADDRESS FOR SUB# ALS ADA SUB# SUB#*3 ADA ATB32 JMP VRF18 VRF12 LDA AFRMP SET UP DIST1 FOR FROM - TO COPY INA VRF18 STA DIST1 TRACK MAP FOR DISC DRIVER TO USE LDA TRACK JSB DISK5 NO,7905 OR 7920 DISC,READ REC FROM IT JMP VERF9 VERF8 LDA COTYP CPA D3 FROM - TO COPY? JMP VRF11 YES LDA ATB31 SET UP REAL TRACK ADDRESS ADA SUB# LDA A,I A REG HAS BASE TRACK ADDR RSS VRF11 LDA FTRCK REAL TRACK ADDRESS FOR DEST DISC ADA TRACK OF FROM-TO COPY IN A REG JSB DISK0 7900 DISC, READ RECORD FROM IT VERF9 LDA VRFLG HAS A VERIFY ERROR BEEN DETECTED IN THIS TRACK? SSA,RSS JSB CMPAR NO, THEN COMPARE THE 2 BUFFERS JMP VRF22 SUCCESSFUL COMPARE CCA STA VRFLG UNSUCCESSFUL COMPARE VRF22 LDA SECTR ADA INCR INCREMENT SECTOR COUNT CPA D96 ALL 96 SECTOR FOR TRACK VERIFIED? JMP VLOOP YES STA SECTR NO, VERIFY NEXT PORTION OF TRACK JMP VLP1 * * TASK WAS COPY * VRF10 CLA STA TRACK INITIALIZE TRACK AND SECTOR COUNTERS STA SECTR LDA JSIZE SET SIZE OF BUF TO WHAT USER HAD SEPCI8FIED STA ISIZE LDB SDTYP STB DSCTP CPB D7900 7900 DISC? JMP VRF15 YES CLA STA SUB# SUB#=0 INITIALLY VLP4 JSB TSTC5 FIND # OF TRACKS IN SUBCHNL VLP3 LDA SUB# ALS ADA SUB# MULTIPLY SUB# 3 TIMES ADA ATB32 ADDR OF TRACK MAP INFO FOR SUBCHNL STA DIST1 LDA TRACK OTA 1 OUTPUT TRACK # TO SWITCH REG LDA SUNIT STA UN#IT SET UNIT # FOR DISC DRIVER LDB AJB CORE ADDR OF BUFFER LDA TRACK CCE E REG =1 FOR READ JSB DISK5 READ REC FROM 7905 DISC LDA COTYP CPA D3 FROM - TO COPY? RSS JMP VRF25 NO LDA AFRMP YES INA SET UP DIST1 FOR FROM TO COPY DEST SUBCHNL STA DIST1 VRF25 LDA DUNIT SET DEST UNIT# FOR DISC DRIVER STA UN#IT DEST UNIT LDA ISIZE SIZE OF BUFFER? CPA D6144 6144 WORDS? JMP VRF16 YES LDB AJB NO, 2048 WORDS ADB ISIZE CORE ADDRESS OF BUFFER FOR DEST DISC RSS VRF16 LDB AVBUF USE BUFFER AT END OF SUBROUTINES LDA TRACK CCE E REG = 1 FOR READ JSB DISK5 READ FROM DEST DISC JSB CMPAR COMPARE THE TWO RECORDS RSS SUCCESSFUL COMPARE RETURN JMP VRF13 USUCCESSFUL COMPARE, VERIFY NEXT TRACK LDA SECTR ADA INCR INCREMENT SECTOR COUNT CPA D96 ALL 96 SECTORS VERIFIED? JMP VRF13 YES STA SECTR NO, VERIFY NEXT PORTION OF TRACK JMP VLP3 VRF13 ISZ TRACK INCREMENT TRACK COUNTER LDA TRACK CPA NTRCK ALL TRACKS VERIFIED? JMP VRF14 YES CLA NO STA SECTR SECTOR COUNT TO 0 JMP VLP3 VRF14 ISZ SUB# LDA SUB# CPA NSUB ALL SUBCHNLS VERIFIED? JMP EXIT YES CLA STA TRACK STA SECTR LDA SUB# JMP VLP4 mNLHNO THEN VERIFY NEXT SUBCHNL * 7N* DISC IS 7900 * VRF15 LDA PLATR PLATR # SAME AS FIRST SUB# STA SUB# VLP7 JSB TSTC0 FIND # OF TRACKS IN SUB# STB NTRCK # OF TRACKS RETURNED IN A REG CLA STA TRACK INITIALIZE TRACK AND SECTOR TO 0 VLP6 STA SECTR LDA TRACK OTA 1 OUTPUT TRACK # TO SWITCH REG VLP5 LDA SUNIT STA UN#IT SET UP SOURCE UNIT # FOR DISC DRIVER LDB AJB CORE ADDRESS FOR BUFFER CCE E REG=1 FOR READ LDA ATB31 SET UP REAL TRACK ADDRESS ADA SUB# LDA A,I BASE TRACK ADDR FOR SUB# ADA TRACK ADD RELATIVE TRACK ADDRESS JSB DISK0 CALL DISC DRIVER SSA WAS THIS TRACK MARKED DEFECTIVE? JMP VRF20 YES, FORGET IT, VERIFY NEXT ONE LDA DUNIT SET UP DEST UNIT # FOR DRIVER STA UN#IT LDA ISIZE BUFFER SIZE? CPA D6144 6144 WORDS? JMP VRF17 YES LDB AJB ADB ISIZE ADDR OF BUFF FOR DEST DISK READ RSS VRF17 LDB AVBUF USE BUFFER AT END OF SUBROUTINES CCE E REG = 1 FOR READ LDA COTYP CPA D3 FROM - TO COPY? RSS JMP VRF26 NO LDA PLATR SAVE PLATTER # STA TBUF LDA SUB# SAVE SUBCHNL # STA TBUF+1 LDA DPLTR YES, SET UP PLATR AND SUB# STA PLATR LDA DSUB# STA SUB# LDA TRACK SET UP REAL TRACK ADDRESS IN A REG ADA FTRCK ADD BASE TRACK # TO RELATIVE TRACK # RSS VRF26 LDA TRCK1 REAL TRACK ADDRESS FOR OTHER THAN FROM-TO COPY JSB DISK0 READ BUF FROM DEST DISC VRF31 JSB CMPAR COMPARE TWO BUFFERS RSS SUCCESSFUL COMPARE JMP VRF20 UNSUCCESSFUL COMPARE, VERIFY NEXT TRACK LDA SECTR ADA INCR INCREMENT SECTOR COUNT CPA D96 ALL 96 SECTORS VERIFIED? JMP VRF20 YES STA SECTR NO, VERIFY NEXT PORTION OF TRACK LDA COTYP IS IT A FROM-T9O COPY? CPA D3 RSS JMP VLP5 DLD TBUF RESTORE STA PLATR PLATTER# STB SUB# AND SUBCHANNEL # JMP VLP5 VRF20 LDA COTYP IS IT A FROM-TO COPY? CPA D3 RSS JMP VRF33 DLD TBUF YES, RESTORE SOURCE STA PLATR PLATTER # STB SUB# SUBCHANNEL # VRF33 ISZ TRACK INCREMENT TRACK COUNTER LDA TRACK CPA NTRCK ALL TRACKS IN SUB# VERIFIED? JMP VRF21 YES CLA NO, THE SECTOR IS 0 JMP VLP6 VRF21 LDA SUB# IF SUB#=1, THEN DONE SZA JMP EXIT LDA COTYP CPA D3 FROM-TO COPY? JMP EXIT YES, THEN DONE ISZ SUB# YES - VERIFY NEXT SUBCHNL LDA SUB# JMP VLP7 * VDONE JSB REWND DONE VERIFYING JMP EXIT * VFLAG NOP DSCTP NOP * * * CNFIG NOP ROUTINE TO CONFIGURE RTE-M OP SYSTEM LDA MTRCN ONLY MAG TAPE TO BE CONFIGURED? SZA JMP CNFG3 YES JSB $LIBR TURN OFF ALL INTERRUPTS NOP AND MEMORY PROTECT FENCE CLF 0 LDA .15,I SAVE JSB CIC,I INSTR IN TEMP LOC STA JSBCI LDA CLF INSERT CLF INSTR IN MT TRAP CELLS ADA .23 STA .23,I INA STA .24,I LDA INTBA ADDRESS OF INTERRUPT TABLE LDB INTAD MAKE A COPY OF INT. TABLE IN USER AREA JSB .MVW MOVE WORDS SUBROUTINE DEF INTLG LENGTH OF BUFFER TO BE MOVED NOP LDA SWREG GET CONTENTS OF SW REG ELA,CLE,ERA CLEAR SIGN BIT STA SWREG LDA CN1 CONFIGURE I O INSTR TO CONSOLE SC ADA SWREG STA CN1 LDA CN2 ADA SWREG STA CN2 LDA CN3 ADA SWREG STA CN3 LDA MRSET MASTER RESET WORD CN1 CLF 0 CN2 OTA 0 CN3 SFS 0 FLAG IS SET ONLY IF 12966 CARD JMP CNFG0 SYSTEM CONSOLE USES DVR00 * SYSTEM CONSOLE USES DVR05 TYPE DRIVER LDA EQTA ADDRESS OF FIRST EQT ENTRY ADA D30 ADDRESS OF DVR05 (3RD) EQT ENTRY STA SYSTY CHANGE SYSTEM TTY EQT TO POINT TO EQT#3 * CHANGE DRT ENTRIES TO HAVE LU 1 POINT TO EQT #3 LDA DRT,I AND .3700 ADA D3 EQT# 3 IN IST ENTRY OF DRT STA DRT,I LDB DRT ADB D8 POINT TO LU 9 LDA B,I AND .1777 INA POINT LU 9 TO EQT # 1 STA B,I * LDA CLF INSERT CLF INSTR IN TRAP CELL FOR DVR00 DEVICE ADA .15 STA .15,I JMP CNFG1 CNFG0 LDA CLF INSERT CLF INSTR IN TRAP CELL FOR DVR05 DEVICE ADA .12 STA .12,I CNFG1 JSB SCHNG CHANGE SELECT CODE ENTRIES IN EQT & INT TABLE DEF SWREG DEF SYSTY,I JSB INTON TTY CONFIGURED - TURN ON ALL INTERRUPTS CNFG2 JSB WRITE DISK BACKUP UTILITY DEF MSG1 DEF D10 JSB QTASK QUESTION TASK TO BE DONE LDA TASK CPA D1 TASK=RESTOR? JMP CNFG3 YES, JUMP SZA,RSS TASK=SAVE? JMP CNFG3 YES ISZ MTRCN SET FLAG TO INDICATE MT NOT RECONFIGURED JMP CNFIG,I CONFIGURATION DONE * *TASK IS EITHER SAVE OR RESTORE *CONFIGURE MAG TAPE CHANNEL * CNFG3 JSB QCHNL DEF MSG14 MT CHANNEL #? DEF D9 LDA CHANL MT CHANNEL # STA MCHNL LDA EQTA BEGINNING OF EQT TABLES ADA D15 STA EQTAD ADDR OF EQT ENTRY FOR MT JSB $LIBR TURN OFF INTERRUPTS AND MEM PROTECT FENCE NOP CLF 0 JSB SCHNG CONFIGURE NEW MT CHANNEL BY CHANGING SC # DEF MCHNL IN EQT TABLE AND INTERRUPT TABLE ENTRIES DEF EQTAD,I JSB INTON TURN ON ALL INTERRUPTS, ETC. LDA MTRCN ONLY MT HAD TO BE CONFIGURED? SZA,RSS JMP CNFIG,I NO, THEN RETURN CLA YES, THEN CLEAR MTRCN FLAG STA MTRCN * JMP CNFIG,I RETURN * INTAD DE.YF INTA INTERRUPT TABLE ADDRESS INTA EQU LABEL INTERRUPT TABLE ENTRIES .15 OCT 15 PRE CONFIGURED SELECT CODE OF CONSOLE .12 OCT 12 .23 OCT 23 .24 OCT 24 MRSET OCT 150077 MASTER RESET WORD FOR CONSOLE .3700 OCT 3700 DRT EQU 1652B DEVICE REFERENCE TABLE SWREG NOP EQTAD NOP ADDRESS OF A EQT ENTRY MCHNL NOP MAG TAPE CHANNEL # INTBA EQU 1654B INTERRUPT TABLE ADDRESS IN SYSTEM INTLG EQU 1655B LENGTH OF INTERRUPT TABLE EQTA EQU 1650B ADDR OF EQT TABLE ENTRIES SYSTY EQU 1675B * * * INTON - ROUTINE TO TURN ON INTERRUPTS AND MEMORY PROTECT FENCE * CALLING SEQUENCE: JSB INTON * * INTON NOP JSB $LIBX LIBRARY ROUTINE TO TURN ON INTERRUPTS DEF INTON RETURNS TO LOCATION AFTER JSB INTON INSTRUCTION * * * INT0N - ROUTINE TO TURN ON INTERRUPTS AND CLEAR FLAG FOR * 7900 DISC CHANNEL * CALLING SEQUENCE: JSB INT0N * * INT0N NOP DSK70 CLF 1 CLC 6 JSB $LIBX TURN ON INTERRUPTS DEF INT0N RETURN * * INT5N - ROUTINE TO TURN ON ALL INTERRUPTS AND MEMORY PROTECT * FENCE * CALLING SEQEUNCE: JSB INT5N * * INT5N NOP DSK71 CLF 1 CLC 6 JSB $LIBX LIBRARY ROUTINE TO TURN ON INTERRUPTS DEF INT5N RETURN TO LOCATION AFTER JSB INTON * * *SCHNG - ROUTINE TO CHANGE SC# ENTRIES IN EQT & INTERRUPT TABLE *CALLING SEQUENCE - JSB SCHNG * DEF SC# NEW SELECT CODE # * DEF EQTAD ADDRESS OF EQT TABLE ENTRY * WHERE CHANGE IS TO BE MADE * SCHNG NOP LDA SCHNG,I BRING IN NEW SELECT CODE # LDA A,I STA NEWSC ISZ SCHNG LDA SCHNG,I ADDRESS OF EQT ENTRY JSB RMOVI REMOVE ANY INDIRECTS STA EQTAD STA B VALUE RETURNED IN A REG ADB D3 LDA B,I CONTENTS OF WORD 4 OF EQT TABLE AND .77 STA OLDSC PRE CONFIGURED SC FOR DEVICE LDA B,I  AND .1777 ZERO OUT OLD SC ADA NEWSC INSERT NEW SC IN SLOT STA B,I REPLACE WORD 4 OF EQT TABLE CLA STA TEMP LDA INTAD CHECK IF OLD SC CONTROLLER TOOK UP 2 I/O SLOTS ADA OLDSC ADA N6 INA POINT TO OLDSC+1 ENTRY IN INTERRUPT TABLE LDA A,I GET EQTAD FROM IT CPA EQTAD ISZ TEMP OLDSC CONTROLLER DOES TAKE UP 2 I/O SLOTS LDA INTBA CLEAR ENTRY IN INT TABLE FOR OLD CHANNEL ADA OLDSC ADA N6 LDB A,I GET CONTENTS OF INTERRUPT TABLE AT OLDSC CPB EQTAD IS IT SAME AS THIS EQT ENTRY? RSS YES, THEN CLEAR IT JMP SCHN5 NO, THEN DO NOT CLEAR LDB CLF ADB OLDSC STB OLDSC,I STORE CLF INSTR IN TRAP CELL CLB CLEAR INT TABLE ENTRY CORRESPONDING TO OLDSC STB A,I SCHN5 LDB TEMP TWO ENTRIES TO BE GIVEN NEW EQTAD? SZB,RSS JMP SCHN1 NO INA YES LDB A,I ANY OTHER DEVICE ASSIGNED TO THIS SC? CPB EQTAD RSS NO, CLEAR CONTENTS OF OLDSC IN INTERRUPT TABLE JMP SCHN1 YES, SET UP NEW SELECT CODE ENTRIES LDB CLF INSERT CLF INSTR IN NEXT ENTRY ADB OLDSC INB ISZ OLDSC STB OLDSC,I CLB CLEAR CORRESPONDING INT TABLE ENTRY STB A,I SCHN1 LDA INTBA CHANGE NEW SC SLOT IN INT TABLE TO POINT ADA NEWSC TO EQT ENTRY ADA N6 LDB EQTAD STB A,I LDB JSBCI STORE JSB CIC,I INSTR IN TRAP CELL STB NEWSC,I CORRESPONDING TO NEWSC LDB TEMP CONTROLLER NEEDS 2 I/O CHANNELS? SZB,RSS JMP RSCHN NO RETURN INA YES CHANGE NEXT ENTRY LDB EQTAD STB A,I LDB JSBCI JSB CIC,I INSTR IN NEWSC+1 TRAP CELL ISZ NEWSC STB NEWSC,I * RSCHN ISZ SCHNG RETURN JMP SCHNG,I * OLDSC NOP NEWSC NOP DCHNL NOP SCHNL NOP .77 OCT 77 * * QCHNL - ROUTINE TO FIND CHANNEL # FOR GIVEN UNIT & TEST IF IT IS * BETWEEN 10-77 OCTAL * CALLING SEQUENCE - JSB QCHNL * DEF MSGX MESG ADDR TO ASK USER FOR CHANNEL # * DEF DN # OF WORDS IN MESSAGE * * QCHNL NOP LDA QCHNL,I STA TEMP1 ADDR OF MESSAGE ISZ QCHNL LDB QCHNL,I ADDR OF MESSAGE LENGTH LDB B,I MESS LENGTH STB TEMP2 JSB QUERY DEF TEMP1,I XXXX CHANNEL #? DEF TEMP2 LENGTH OF MESSAGE DEF EXP4 REPLY OCTAL 10 TO 77 DEF D10 LENGTH OF EXPLNAITON JSB GINIT CONVERT ASCII TO OCTAL LDA D2 2 CHARACTERS TO BE CONVERTED JSB GETOC CONVERT 2 CHARACTERS FROM RDBUF JMP EXPL ERROR RETURN STA CHANL OCTAL VALUE RETURNED IN A REG LDB CHANL ADB .N10 ADD -10B SSB LESS THAN 10B? JMP EXPL YES, EXPLAIN RESPONSE AND ASK AGAIN LDB CHANL ADB .N100 SSB,RSS CHANNEL# > 77B? JMP EXPL YES, EXPLAIN AGAIN ISZ QCHNL JMP QCHNL,I RETURN * CHANL NOP .N10 OCT -10 .N100 OCT -100 * * * QDISC - ROUTINE TO QUERY DISC FEATURES AND CONFIGURE IT * CALLING SEQUENCE : JSB QDISC * QDISC NOP CLA STA IFLAG LDA TASK TASK? CPA D1 RESTORE? JMP DESTN YES DLD SORCE SET UP MESSAGE TO SAY DST MSG4 SOURCE DISC CHANNEL #? DST MSG21 SOURCE DISC DRIVE#? LDA SORCE+2 STA MSG4+2 STA MSG21+2 JSB QCHNL SOURCE DISC CHANNEL #? DEF MSG4 DEF D11 JSB QDUTP SOURCE DISC TYPE? DEF MSG5 DEF D9 DEF MSG21 AND UNIT #? DEF D10 LDA DTYPE STA SDTYP SOURCE DISC TYPE LDA DUNIT STA SUNIT SOURCE UNIT # LDA CHANL STA SCHNL SOURCE DISC CHANNEL # JSB DC\CNFG CONFIGURE SOURCE DISC * * FIND TYPE OF SAVE OR COPY * QDSC5 LDA TASK SZA TASK? JMP QDSC3 TASK IS COPY DLD SAVE SET UP MESG TO SAY TYPE OF SAVE? JMP QDSC4 QDSC3 DLD COPY SET UP MESSAGE TO SAY 'TYPE OF COPY?' QDSC4 DST MSG3+4 JSB QUERY DEF MSG3 TYPE OF COPY? DEF D7 DEF EXP3 REPLIES ARE: UN,FR DEF D9 LDB RBUF CPB UN JMP QDSC6 UNIT COPY CPB FR RSS JMP EXPL ERRONEOUS REPLY - EXPLAIN AND ASK AGAIN LDA D3 FROM-TO COPY RSS QDSC6 LDA D2 UNIT COPY STA COTYP LDB SDTYP SOURCE DISC TYPE? CPB D7900 7900? RSS YES JMP QDSC2 NO CPA D3 FROM-TO COPY? JMP FRMTO YES JMP TMT01 NO, UNIT COPY, BUILD 7900 TRACK MAP TABLE * * DISC IS 7905 OR 7920 QDSC2 LDB SUNIT FIND DISC TYPE BY PULLING STATUS JSB STAT5 FROM CONTROLLER STA SDTYP A REG=0--7905B,1--7920,2--7905A JSB MSINS CONFIGURE EXPL MESGS FOR DISC TYPE JSB QUERY FIND SYSTEM TYPE DEF MSG7 RTE OR DOS DISC? DEF D8 DEF EXP7 REPLIES ARE: RT,DO DEF D9 LDB RBUF CPB RT JMP QDSC1 RTE DISC CPB DO JMP DOS DOS DOSC JMP EXPL EXPLAIN AND ASK AGAIN QDSC1 CLA SYSTEM TYPE=0 FOR RTE STA SYSTP LDA COTYP COPY TYPE? CPA D3 FROM-TO COPY? JMP FRMTO YES JSB QUERY YES, RTE DISC DEF MSG6 WANT TRACK SPARING? DEF D10 DEF EXP6 REPLY YES OR NO DEF D10 LDB RBUF CPB YE JMP TRKSP YES, ASK FOR TRACK MAP INFO FOR SOURCE DISC UNIT * TRACK MAP INFO ( DEFAULT ) FOR UNIT COPY CLA,INA STA AMAP1,I # OF SUBCHANNELS IS 1 LDA AUNIT ADDR OF START OF TRCK MAP TBL LIST LDB SDTYP SOURCE DISC TYPE? -CPB D7905 7905A? JMP QMOVE YES, THEN MOVE INTO ATB32 CPB D7906 7906? ADA D3 YES, TRCK MAP TBL STARTS AT AUNIT+3 CPB D7920 7920? ADA D6 YES,TRCK MAP TBL STARTS AT AUNIT+6 QMOVE LDB ATB32 JSB .MVW MOVE 3 WORDS FOR TRCK MAP TABLE DEF D3 NOP JMP RQDSC RETURN * * TRACK MAP INFORMATION * * TRKSP CLA STA SYSTP JSB WRITE SEND MESSAGE TO TTY DEF MSG8 ENTER FOLL. TM INFO. FOR SOURCE UNIT ONLY DEF D28 JSB DSETU BUILD TRACK MAP TABLE FOR 7905 SOURCE DISC UNIT JMP RQDSC RETURN * DOS LDA D1 STA SYSTP SYSTP=1 FOR DOS SYSTEM LDA COTYP COPY TYPE? CPA D3 FROM-TO COPY? JMP FRMTO YES ****ENTER TRACK MAP INFO FOR DOS DISC JSB QUERY DEF MSG32 # OF SUBCHNLS TO BE COPIED? DEF D14 DEF EXP32 REPLY 1 TO 3 DEF D6 JSB CVTST CONVERT # OF SUBCHNLS TO DECIMAL & TEST DEF D1 ITS VALIDITY DEF NSUB DEF N4 LDA NSUB NSUB HAS # OF SUBCHNLS SZA,RSS JMP EXPL IT IS 0, EXPLAIN AND ASK AGAIN ALS MULTIPLY BY 2 ADA NSUB A REG HAS NSUB*3 INA STA TEMP TEMP HAS # WORDS TO BE MOVED IN TMT LDB NSUB CMB,INB MAKE #SBCHNLS -VE TO INDICATE LDA ADOSM TRACK SPARING IS DESIRED STB A,I # OF SUBCHNLS ENTERED IN TRCK MAP TBL LDB ATB32 ADDRESS OF BEGINNING OF $TB32 ADB N1 TRACK MAP TABLE JSB .MVW MOVE TEMP # WORDS FROM DOS MAP TO $TB32 DEF TEMP NOP JMP RQDSC RETURN * *FROM-TO COPY TO BE MADE * FRMTO LDA D3 STA COTYP COPY TYPE IS 3 LDA SDTYP CPA D7900 DISC TYPE 7900? JMP FRMT1 YES LDA IFLAG DOING DEST DISC QUERY? SZA,RSS JMP FRMT7 NO JSB QUERY YES DEF MSG9B 8TO CYLINDER#? DEF D7 DEF EXP9 REPLY 0 TO 410 (OR 821) DEF D7 JMP FRMT6 FRMT7 JSB QUERY DISC IS 7905 DEF MSG9 FROM CYLINDER #? DEF D8 DEF EXP9 REPLY 0 TO 410 (OR 821) DEF D7 FRMT6 JSB CVTST DEF D2 DEF FCYL CONVERT AND TEST CYLINDER # DEF C1 LDA IFLAG SZA DO NOT DO FOLLOWING IF QUERYING FOR DEST DISC JMP FRMT5 FOR FROM - TO COPY LDA SYSTP SZA RTE DISC? JMP FRDOS NO DOS DISC JSB QUERY DEF MSG10 # OF TRACKS? DEF D6 DEF EXP10 REPLY 1 TO 1233(OR 4111) DEF D8 JSB CVTST CONVERT AND TEST IF # OF TRACKS IS BET 0-1233 DEF D2 DEF NTRCK # OF TRACKS DEF C2 LDA NTRCK SZA,RSS = 0? JMP EXPL YES EXPLAIN AND ASK AGAIN JMP FRMT5 FRDOS JSB QUERY DEF MSG10 # OF TRACKS? DEF D6 DEF EX10B REPLY 1 TO 200 DEF D7 JSB CVTST CONVERT AND TEST DEF D2 DEF NTRCK DEF N201 LDA NTRCK SZA,RSS # OF TRACKS = 0? JMP EXPL YES, EXPLAIN AND ASK AGAIN ALS NTRCK*2 STA NTRCK FRMT5 JSB QUERY DEF MSG11 NUMBER OF SURFACES? DEF D7 DEF EXP11 REPLY 1 TO 3(OR 5) DEF D6 JSB CVTST CONVER AND TEST DEF D1 DEF NSRFC DEF C3 LDA NSRFC SZA,RSS # OF SURFACES = 0? JMP EXPL YES, EXPLAIN AND ASK AGAIN JSB QUERY DEF MSG12 STARTING HEAD#? DEF D8 DEF EXP12 REPLY 0 TO 2(OR 4) DEF D6 JSB CVTST CONVERT AND TEST DEF D1 DEF STRTH STARTING HEAD DEF C4 * BUILD TRACK MAP TABLE FOR FROM-TO COPY LDA IFLAG QUERYING DEST DISC FOR FROM-TO COPY? SZA JMP FRM15 YES LDB ATB32 NO ADB N1 RSS FRM15 LDB AFRMP ADDRESS OF TMT FOR DEST SUBCHNL FOR FR-TO COPY LDA D1 STA B,I INB LDA FCYL STA B,I FROM CYLINDER STORED IN TMT LDA NSRFC # OF SURFACES ALF ROTATE TO BRING THEM TO BIT 3 ADA STRTH ADD STARTING HEAD# ALF,ALF NOW BITS 12-15 IS # SURFACES,BITS 8-11 HEAD# ADA DUNIT BITS 0-3 UNIT # INB STA B,I STORE INTO TRACK MAP TABLE LDA NTRCK # OF TRCKS INB STA B,I STORE IN TMT JMP RQDSC RETURN * * DISC IS 7900 FRMT1 LDA IFLAG QUERYING DEST DISC FOR FROM-TO COPY? SZA,RSS JMP FRM20 NO JSB QUERY YES DEF MSG9C TO TRACK#? DEF D5 DEF EXP9A REPLY O TO 202 DEF D7 JMP FRM21 * FRM20 JSB QUERY DEF MSG9A FROM TRACK #? DEF D7 DEF EXP9A REPLY 0 TO 202 DEF D7 FRM21 JSB CVTST CONVERT AND TEST DEF D2 DEF FTRCK DEF N203 FRMT2 LDA IFLAG QUERYING DEST DISC FOR FROM-TO COPY? SZA,RSS JMP FRM10 NO LDB ATB31 YES, THEN FIND # OF TRACKS READ FROM SOURCE DISC ADB D8 LDA B,I SZA IS IT 0 FOR SUBCHNL 0? JMP FRM12 NO, THEN THIS IS IT INB YES , THEN SUBHNL 1 MUST BE THE RIGHT ONE LDA B,I FRM12 STA NTRCK JMP FRM11 TEST IF LAST TRACK IS WITHIN BOUNDS FRM10 JSB QUERY DEF MSG10 # OF TRACKS DEF D6 DEF EX10A REPLY 1 TO (203-FROM TRACK#) DEF D14 JSB CVTST CONVER AND TEST IF # TRCKS IS BET 0 AND 203 DEF D2 DEF NTRCK DEF N204 LDA NTRCK SZA,RSS = 0? JMP EXPL YES EXPLAIN AND TRY AGAIN FRM11 ADA FTRCK TEST IF LAST TRACK TOO LARGE ADA N204 SSA JMP FRMT3 LST TRCK IS WITHIN BOUNDS JSB WRITE DEF ERR5 LAST TRACK TOO LARGE DEF D10 LDA IFLAG SZA JMP FRMT1 QUt ERYING DEST DISC FOR FROM-TO COPY JMP FRMT2 ASK QUESTION AGAIN FRMT3 JSB QUERY DEF MSG13 PLATTER #? DEF D5 DEF EXP13 REPLIES ARE: 0,1 (0-FIXED,1-REMOVABLE) DEF D19 JSB GINIT CONVERT TO DECIMAL LDA N2 -VE CHARACTER COUNT FOR CONVERSION TO DECIMAL JSB GETOC JMP EXPL ERROR RETURN LDB IFLAG SZB,RSS QUERYING DEST DISC FOR FRM-TO COPY? JMP FRM25 NO STA DPLTR DEST PLATR # FOR FROM TO COPY STA DSUB# DEST SUB# FOR FROM-TO COPY SZA TEST IT CPA D1 JMP RQDSC RETURN BECAUSE IT IS 0 OR 1 JMP EXPL ERROR TRY AGAIN FRM25 STA PLATR SZA,RSS 0? JMP TMT00 YES CPA D1 = 1? JMP TMT00 YES JMP EXPL EXPLAIN AND ASK AGAIN * CONSTRUCT TRACK MAP TABLE FOR 7900 FROM-TO OR UNIT COPY TMT01 LDA D203 # OF TRACKS FOR UNIT COPY STA NTRCK CLA FIRST TRACK FOR UNIT COPY IS 0 STA FTRCK STA SUB# FIRST SUBCHNL FOR UNIT COPY IS 0 STA PLATR JMP TMT03 TMT00 LDA PLATR SUB# FOR FROM-TO COPY STA SUB# TMT03 CLA CLEAR TMT LDB ATB31 STA B,I INB STA B,I ADB D7 STA B,I INB STA B,I TMT02 LDA ATB31 ADA SUB# POINT TO 0 OR 1 SUBCHNL PART IN TMT LDB FTRCK FIRST TRACK STB A,I STORE IN TMT ADA D8 LDB NTRCK STB A,I STORE # OF TRACKS LDA SUB# SZA SUB# = 1? JMP RQDSC YES, THEN DONE LDA COTYP NO, THEN UNIT COPY? CPA D2 RSS JMP RQDSC NO, RETURN ISZ SUB# YES, MAKE ENTRIES FOR NEXT SUBCHNL JMP TMT02 * * IF TASK IS SAVE-RETURN, IF TASK IS COPY WORK ON DEST SBCHNL * RQDSC LDA IFLAG WAS QUERYING DEST DISC FOR FROM-TO COPY? SZA,RSS JMP RQDS1 NO CLA YES 74THEN CLEAR FLAG STA IFLAG JMP QDISC,I RETURN RQDS1 LDA TASK SZA,RSS SAVE? JMP QDISC,I YES - RETURN * DESTN DLD DEST SET UP MESSAGE TO SHOW DST MSG4 'DEST DISC CHANNEL#?' DST MSG21 'DEST DISC DRIVE#?' LDA DEST+2 STA MSG4+2 STA MSG21+2 LDA TASK CPA D2 TASK IS COPY? JMP DEST2 YES, THEN DONT QUERY DEST DISC CHANL # JSB QCHNL WORK ON DESTINATION DISC DEF MSG4 DEST DISC CHANNEL#? DEF D11 LDA CHANL STA DCHNL JSB DCNFG CONFIGURE DEST DISC CHANNEL DEST2 JSB QUNIT QUERY DEST DISC TYPE AND UNIT # DEF MSG21 QUERY DEST DISC UNIT # DEF D10 LDA DTYPE DISC TYPE IS 7900? CPA D7900 JMP DEST3 YES, THEN DO NOT GET STATUS LDB DUNIT DESTINATION DISC UNIT# JSB STAT5 FIND DEST DISC TYPE STA DTYPE JSB MSINS CONFIGURE EXPL MESSAGES DEST3 LDA COTYP CPA D3 FROM - TO COPY? RSS JMP QDISC,I RETURN CLA,INA YES STA IFLAG SET IFLAG TO INDICATE QUERYING DEST DISC JMP FRMTO FOR FROM TO COPY * PLATR DEC 0 DPLTR NOP DSUB# NOP NTRCK NOP FTRCK NOP FCYL NOP STRTH NOP NSRFC NOP COTYP NOP DO ASC 1,DO RT ASC 1,RT UN ASC 1,UN FR ASC 1,FR D203 DEC 203 N201 DEC -201 N203 DEC -203 N204 DEC -204 AUNIT DEF *+1 DEC 0 OCT 30000 DEC 1233 DEC 0 .4000 OCT 40000 DEC 1644 DEC 0 OCT 50000 DEC 4115 FRMAP BSS 4 AFRMP DEF FRMAP DOSMP DEC -3 DEC 0 M0100 OCT 10000 D400 DEC 400 DEC 0 OCT 10400 DEC 400 DEC 0 OCT 11000 DEC 400 ADOSM DEF DOSMP * * * STAT5 - ROUTINE TO PULL STATUS FOR SOURCE 7905,7905B OR 7920 * SOURCE UNIT & DETERMINE DISC TYPE FROM BITS 9-12 OF * STATUS WORD 2 * BITS 9-12 = 0 THEN 7905B * )NLH = 1 THEN 7920 * = 2 THEN 7905A * CALLING SEQUENCE: JSB STAT5 * B REG = SOURCE UNIT # * RETURNS: A REG = SOURCE DISC TYPE * * $dNSTAT5 NOP LDA STACC CONFIGURE STATUS REQUEST COMMAND AND .1777 CLEAR BITS 0-5 ADA B ADD SOURCE UNIT # STA STACC ST5T2 JSB $LIBR TURN OFF INTERRUPTS NOP CLF 0 JSB STATW ROUTINE TO BRING STATUS JSB INT5N CPB .1002 DISC NOT READY? JMP ST5T1 YES, THEN SEND MESSAGE LSL 3 B REG HAS STATUS WORD 2 CLA BRING BITS 9-12 OF B REG INTO A REG RRL 4 A REG HAS SOURCE DISC TYPE JMP STAT5,I RETURN ST5T1 JSB WRITE SEND 'READY DISC ' MESSAGE DEF MS4 DEF D5 JSB PAUSE JMP ST5T2 TRY AGAIN * .1002 OCT 100002 * * * MSINS - ROUTINE TO MOVE APPROPRIATE BOUNDARY PARAMETERS * INTO A COMMON BUFFER AREA FOR 7905A,7905B OR * 7920 DISCS. ROUTINE CONFIGURES EXPANATION * MESSAGES FOR THESE PARAMETERS * CALLING SEQUNCE: JSB MSINS * A REG = DISC TYPE * * MSINS NOP LDB TST05 START OF PARAMETER LIST CPA D7906 A REG HAS DISC TYPE ADB D10 7905B DISC,PARM LIST IS TST05+10 CPA D7920 7920? ADB D20 YES,PARM LIST IS TST05+20 LDA B TRANSFER SOURCE ADDRESS INTO A REG LDB AJB DESTINATION ADDRESS JSB .MVW MOVE 10 WORD PARAMETER LIST DEF D10 NOP DLD C5 SET UP EXLANATION MESSAGES DST EXP9+5 DST EXMS3+11 DLD C6 DST EXP10+6 DST EXMS3+6 LDA C7 STA EXP12+5 STA EXMS3+16 LDA C8 STA EXP11+5 STA EXMS3+20 JMP MSINS,I RETURN * * * QDUTP - ROUTINE TO QUERY DISC TYPE & DISC DRIVE (UNIT) # * AND TEST BOTH VALUES * CALLING SEQUENCE: JSB QDUTP * DEF MSGX MESSAGE TO ASK FOR DISC TYPE * DEF DX LENGTH OF MESSAGE * DEF MSGY MESSAGE TO ASK FOR DISC DRIVE # * DEF DY LENGTH OF MESSAGE * RETURNS: DISC TYPE IN DTYPE & DISC DRIVE # IN DUNIT * * QDUTP NOP LDA QDUTP,I FETCH MESG ADDR TO QUERY DISC TYPE STA TEMP1 ISZ QDUTP LDA QDUTP,I FETCH MESG LENGTH LDA A,I ACTUAL VALUE IN A REG STA TEMP2 JSB QUERY DEF TEMP1,I XXXX DISC TYPE? DEF TEMP2 DEF EXP5 REPLIES ARE:7900,7905,7906,7920 DEF D16 JSB GINIT CONVERT DISC TYPE FROM ASCII TO INTEGER LDA N4 JSB GETOC CONVERT JMP EXPL ERROR RETURN STA DTYPE CPA D7900 7900 DISC? JMP QDUT1 YES FIND DRIVE # CPA A7905 7905? JMP QDUT1 YES CPA A7906 7906? JMP QDUT1 YES CPA A7920 7920? RSS JMP EXPL NO, EXPLAIN AND ASK AGAIN * FIND UNIT # FOR DISC QDUT1 ISZ QDUTP FETCH NEXT TWO PARAMETERS JMP QUNT1 QUNIT NOP 2ND ENTRY POINT TO FIND UNIT # ONLY LDA QUNIT SET UP RETURN ADDRESS STA QDUTP QUNT1 LDA QDUTP,I STA TEMP1 MESG ADDR TO ASK FOR DISC DRIVE# ISZ QDUTP LDA QDUTP,I LDA A,I MESG LENGTH IN A REG STA TEMP2 LDA DTYPE DISC TYPE? CPA D7900 7900? RSS JMP QUNT2 NO 7905 OR 7920 * QUERY FOR 7900 DISC UNIT# JSB QUERY DEF TEMP1,I XXXXX DISC DRIVE#? DEF TEMP2 DEF EX21A REPLY 0 TO 3 DEF D6 JSB CVTST CONVERT AND TEST FOR VALIDITY OF RESPONSE DEF D1 DEF DUNIT IS UNIT# < 4 & >= 0? DEF N4 JMP RQDUT RETURN * QUERY FOR 7905 DISC UNIT# QUNT2 JSB QUERY DEF TEMP1,I UNIT#? DEF TEMP2 DEF EXP21 REPLY 0 TO 7 DEF D6 JSB CVTST CONVERT UNIT# FROM ASCII TO DECIMAL DEF D1 AND TEST IF < 8 & >= 0 DEF DUNIT DEF N8 * RETURN RQDUT ISZ QDUTP JMP QDUTP,I RETURN * DTYPE NOP SDTYP NOP N8 DEC -8 D7900 DEC 79:00 D7905 DEC 2 D7920 DEC 1 D7906 DEC 0 A7905 DEC 7905 A7920 DEC 7920 A7906 DEC 7906 * * * QTASK - ROUTINE TO FIND TASK TO BE PERFORMED * * QTASK NOP CLA STA TASK INITIALIZE TASK TO 0 JSB QUERY DEF MSG2 TASK? DEF D3 DEF EXP2 REPLIES ARE: SAVE,RESTORE,COPY DEF D11 LDA RBUF CPA SA TASK IS SAVE? JMP QTASK,I YES, TASK=0 FOR SAVE CPA RE RESTORE? JMP QRSTR YES CPA CO COPY? RSS JMP EXPL NO, EXPLAIN AND ASK AGAIN LDA D2 TASK = 2 FOR COPY STA TASK RSS QRSTR ISZ TASK TASK=1 FOR RESTORE JMP QTASK,I RETURN * TASK DEC 0 SA ASC 1,SA RE ASC 1,RE CO ASC 1,CO * * * DCNFG - ROUTINE TO CONFIGURE DISC CHANNEL * * DCNFG NOP LDA DTYPE DISC TYPE? CPA D7900 7900? RSS JMP C7905 NO * CONFIGURE 7900 DISC LDA I#OTC END OF INSTRUCTION LIST LDB LST1 BEGINNING OF INSTRUCTION LIST JSB DCHCN CONFIGURE DATA CHANNEL ISZ CHANL CONFIGURE COMMAND CHANNEL LDA I#OTE LDB LST2 BEG OF INST LIST JSB DCHCN JMP DCNFG,I RETURN * CONFIGURE 7905 DISC C7905 LDA I/OTC END OF INST LIST LDB LST3 BEG OF INST LIST JSB DCHCN JMP DCNFG,I RETURN * * * POSN - ROUTINE TO POSITION MAG TAPE AT DESIRED FILE# BET 1-8 * CALLING SEQUENCE: JSB POSN * * POSN NOP LDA FILEN FILEN IS 0? SZA JMP POSN2 NO THEN POSITION TO FILE# IN FILEN POSN1 JSB QUERY DEF MSG16 MT FILE#? DEF D5 DEF EXP16 REPLY 1 TO 8 DEF D6 JSB CVTST DEF D1 CONVERT FILE# FROM ASCII TO DECIMAL DEF FILEN AND TEST IF 0FILEN > 0 & <= 8 DEF N9 LDA FILEN FILEN=0? SZA,RSS ISZ FILEN YES, DEFAULT = 1 * REWIND MAG TAPE POSN4 JSB MTNR MAG TAPE READY? Y JSB REWND REWIND MAG TAPE * POSITION MAG TAPE LDA FILEN CPA D1 IF FILEN=1, THEN ALREADY POSITIONED JMP POSN,I SO RETURN ADA N1 # OF EOF MARKS TO BE FOUND CMA,INA NEGATE VALUE STA PTEMP LOOPF LDA MTLU SET UP CONTROL WORD FOR DYNAMIC STATUS REQ ADA .600 STA TEMP1 JSB EXEC DEF *+3 DEF D3 DEF TEMP1 SLA IS MAG TAPE STILL REWINDING? JMP LOOPF YES, THEN WAIT FOR IT TO COMPLETE LDA D3 SET UP REQUEST CODE SO THAT ERRORS ARE RETURNED ADA MSIGN TO THE UTILITY PROGRAM STA TEMP1 LDA MTLU SET UP CONTROL WORD FOR FORWARD SPACE I FILE CMND ADA .1300 STA TEMP2 JSB EXEC DEF *+3 DEF TEMP1 DEF TEMP2 FORWARD SPACE 1 FILE JMP ERPOS ERROR RETURN LDA MTLU SET UP CONTROL WORD FOR DYNAMIC STATUS REQUEST ADA .600 STA TEMP1 JSB EXEC DEF *+3 DEF D3 EOT SEEN? DEF TEMP1 AND .40 EOT BIT = 1 IN STATUS WORD? CPA .40 JMP ERPOS YES ERROR - FILE NOT FOUND ISZ PTEMP NO NEXT FILE TO BE FORWARDED? JMP LOOPF YES JMP POSN,I NO - MT IS POSITIONED - RETURN * POSN2 LDA SVTPN WAS LAST TAPE# = 1? CPA D1 RSS YES, THEN BACKSPACE TO THIS FILE JMP POSN4 NO, THEN POSITION FROM BEGINING OF TAPE LDA FILEN JUST WANT TO BACKSPACE TO BEGINING OF THIS FILE CPA D1 IS FILE#=1? JMP POSN3 YES THEN JUST REWIND LDA .200 SET UP FUNCTION WORD FOR ADA MTLU BACK SPACING ONE RECORD (EOF RECORD) STA TEMP1 JSB EXEC BACK SPACE ONE RECORD DEF *+3 DEF D3 DEF TEMP1 LDA .1400 SET UP FUNCTION WORD FOR BACKSPACING 1 FILE ADA MTLU STA TEMP1 JSB EXEC BACK SPACE ONE FILE DEF *+3 DEF D3  DEF TEMP1 LDA .300 SET UP FUNCTION WORD TO FORWARD SPACE ONE RECORD ADA MTLU STA TEMP1 JSB EXEC FORWARD SPACE ONE RECORD (EOF OF PREVIOUS FILE) DEF *+3 DEF D3 DEF TEMP1 JMP POSN,I RETURN POSN3 JSB REWND FILE # = 1 JMP POSN,I RETURN * ERROR - FILE NOT FOUND ERPOS JSB REWND REWIND MAG TAPE JSB WRITE DEF ERR1 FILE NOT FOUND DEF D7 JMP POSN1 ASK AGAIN * FILEN NOP PTEMP NOP N9 DEC -9 .400 OCT 400 .200 OCT 200 .300 OCT 300 .1400 OCT 1400 * * * REWND - ROUTINE TO REWIND MAG TAPE * CALLING SEQUENCE: JSB REWND * * REWND NOP LDA MTLU ADA .400 SET UP CONTROL WORD FOR REWIND STA TEMP1 JSB EXEC REWIND MAG TAPE DEF *+3 DEF D3 DEF TEMP1 JMP REWND,I RETURN * * * PRNTH - ROUTINE TO READ AND PRINT HEADER RECORD FROM MT FILE * CALLING SEQUENCE: JSB PRNTH * DEF HEADR ADDR OF BUFFER TO HOLD HEADER RECORD * RETURN: TO LOC P IF NORMAL RETURN * TO LOC P+1 OTHERWISE * * PRNTH NOP LDA PRNTH,I STA TEMP ADDR OF BUF FOR HEADER RECORD JSB EXEC DEF *+5 READ HEADER RECORD FROM MAG TAPE DEF D1 DEF MTLU DEF TEMP,I DEF D140 HEADER RECORD IS 140 WORDS LONG JSB WRITE DEF FILID FILE ID: DEF D4 JSB WRITE DEF TEMP,I PRINT TITLE FROM FIRST 36 WORDS OF HEADER DEF D36 LDA TEMP ADA D36 POINT TO TAPE# LDA A,I TAPE # IN A REG STA TEMP SAVE TAPE## JSB DCASC CONVERT TAPE# FROM DECIMAL TO ASCII DEF *+4 DEF TAPE#+4 DEF D1 DEF TEMP JSB WRITE TAPE#: XX DEF TAPE# DEF D5 JSB QUERY DEF OK OK? DEF D2 DEF EXP6 REPLY YES OR NO DEF D9 LDA RBUF CPA YE IS IT OK? JMP RPRNT YES - NORMAL RETURN TO P ISZ PRNTH NO - RETURN TO P+1 RPRNT ISZ PRNTH JMP PRNTH,I RETURN * FILID ASC 4,FILE ID: TAPE# ASC 5,TAPE#: XX OK ASC 2,OK? * * * PAUSE - ROUTINE TO WAIT FOR USER TO TAKE ACTION ASKED BY * UTILITY AND RESTART UTILITY BY TYPIN 'GO' * CALLING SEQUENCE: JSB PAUSE * * PAUSE NOP JSB WRITE DEF MSG27 RSTRT UTILITY BY ENTERING 'GO' DEF D16 PAUS1 JSB READ READ RESPONSE LDA RBUF CPA GO 'GO'? JMP PAUSE,I YES,RETURN JMP PAUS1 NO, WAIT FOR 'GO' RESPONSE * GO ASC 1,GO * * * QUERY - ROUTINE TO ASK QUESTION, READ RESPONSE, * EXPLAIN IF NECESSARY, AND ASK AGAIN * CALLING SEQUENCE: JSB QUERY * DEF MSG MESSAGE ADDRESS * DEF DN MESSAGE LENGTH * DEF EXP EPLANATION MESSAGE ADDRESS * DEF DN " " LENGTH * RETURNS: RESPONSE IN RBUF * * QUERY NOP QURY1 LDA QUERY LEAVE RETURN ADDRESS IN QUERY STA SAVEQ LDA A,I GET MESSAGE ADDRESS JSB RMOVI REMOVE INDIRECTS STA QTMP1 ISZ SAVEQ LDA SAVEQ,I GET MESSAGE LENGTH STA QTMP2 JSB WRITE WRITE MESSAGE ON USER TTY DEF QTMP1,I ADDR OF MESSAGE AND MESG LENGTH ADDRESSES DEF QTMP2,I ISZ SAVEQ POINT TO EXPLANATIOON MESSAGE PARM JSB READ READ USER RESPONSE FROM TTY LDA RBUF CPA QUES "??"? JMP EXPL YES - USER NEEDS HELP IN ANSWERING LDA QUERY NO - RETURN ADA D4 JMP A,I B REG HAS # OF WORDS IN RESPONSE * EXPLANATION REQUIRED EXPL LDA SAVEQ,I EXPLANATION MESSAGE ADDRESS STA QTMP1 ISZ SAVEQ LDA SAVEQ,I EXPLANATION MESSAGE LENGTH STA QTMP2 JSB WRITE DEF QTMP1,I DEF QTMP2,I JMP QURY1 ASK AGAIN AND READ RESPONSE AGAIN * QUES ASC 1,?? SAtVEQ NOP QTMP1 NOP QTMP2 NOP * * * READ - ROUTINE TO READ USER RESPONSE FROM TTY * CALLING SEQUENCE: JSB READ * RETURNS: REPONSE IN RBUF, # OF WORDS IN REPONSE IN B REG * * READ NOP LDA N36 STA RCNT COUNTER LDA SPACE LDB ARBUF ADDRESS OF READ BUFFER STA B,I STORE 0 IN RBUF INB ISZ RCNT JMP *-3 JSB EXEC DEF *+5 DEF D1 DEF RITLU ITLU+400B DEF RBUF DEF D36 READ 36 WORDS FROM TTY LDA RBUF CPA AB USER WANTS TO ABORT PROGRAM? JMP EXITU YES JMP READ,I NO - RETURN * RBUF EQU LABEL+90 ARBUF DEF RBUF RITLU OCT 401 AB ASC 1,AB SPACE ASC 1, N36 DEC -36 RCNT NOP * * * WRITE - ROUTINE TO WRITE MESSAGES ON TTY * CALLING SEQUENCE: JSB WRITE * DEF MSG MESSAGE * DEF DN LENGTH OF MESSAGE * * WRITE NOP LDA WRITE,I GET FIRST PARAMETER-MESSAGE ADDR JSB RMOVI STA WTMP1 ISZ WRITE LDA WRITE,I GET 2ND PARAMETER-MESSAGE LENGTH JSB RMOVI STA WTMP2 JSB EXEC WRITE MESSAGE ON TTY DEF *+5 DEF D2 DEF ITLU DEF WTMP1,I MESSAGE DEF WTMP2,I MESSAGE LENGTH ISZ WRITE RETURN ADDRESS JMP WRITE,I RETURN * WTMP1 NOP WTMP2 NOP * * * CVTST - ROUTINE TO CONVERT ASCII TO DECIMAL AND TEST IF VALUE * IS >= 0 & <= UPPER LIMIT SUPPLIED BY CALLING ROUTINE * CALLING SEQUENCE: JSB CVTST * DEF # OF CHARACTERS IN BUFFER TO BE CONVERTED * DEF VARIABLE HOLD CONVERTED DEC VALUE * DEF -(UPPER LIMIT+1) * * CVTST NOP LDA CVTST,I FETCH ADDR OF FIRST PARAMETER LDA A,I # OF CHAR IN BUF TO BE CONVERTED STA NCHAR JSB GINIT CONVERT ASCII TO DECIMAL LDA NCHAR ALS A REG HAS # OF CHARACTERS TO BE CONVERTED CMA,INA  -VE FOR DECIMAL CONVERSION JSB GETOC CONVERT JMP EXPL ERROR RETURN STA NUMBR DECIMAL #, NOW TEST IT ISZ CVTST GET ADDRESS OF SECOND PARRAMETER LDB CVTST,I ADDR OF SECOND PARAMETER STA B,I STORE DEC VALUE IN 2ND PARAMETER SSA CONVERTED VALUE < 0? JMP EXPL YES, EXPLAIN AND ASK FOR RESPONSE AGAIN ISZ CVTST LDB CVTST,I ADDR OF 3RD PARAMETER LDB B,I -(UPPER LIMIT+1) ADA B VALUE > UPPER LIMIT? SSA,RSS JMP EXPL YES, EXPLAIN AND ASK AGAIN ISZ CVTST JMP CVTST,I RETURN * NCHAR NOP NUMBR NOP * * * V6144 - ROUTINE TO DETERMINE IF SIZE OF PHYSICAL MEMORY IS LARGE * ENOUGH TO ENABLE VERIFY WITH 6144 WORD BUFFER SIZE * CALLING SEQUENCE: JSB V6144 * RETURN: A REG = 0 IF 6144 WORD BUF VERFIFY NOT POSSIBLE * =1 OTHERWISE * * V6144 NOP JSB $LIBR TURN OFF ALL INTERRUPTS NOP AND MEMORY PROTECT FENCE CLF 0 LDA LWA24 CHANGE LWA MEM OF BG PART IN BASE PAGE STA BGLWA TO INDICATE BG PART SIZE IS 24K LDA PATRN PATTERN OF 177777 TO WRITE IN LOC 57777 LDB LWA24,I SAVE ORIGINAL CONTENTS STA LWA24,I LOC 57677 LDA LWA24,I READ THE CONTENTS OF LOC STB LWA24,I STORE BACK CONTENTS CPA PATRN COMPARE, IF AREG = PATRN THEN MEM SIZE>=24K RSS JMP V2048 MEM NOT LARGE ENOUGH TO HOLD 2 6144 WORD BUFS JSB INTON LEAVE THE BASE PAGE LOC OF BG LWA AT 57777 LDA XEQT ID SEGMENT OF THIS UTILITY JSB COR.A FIND FIRST WORD AVAILABLE OF FREE MEM STA AVBUF ADDR OF 2ND BUF FOR VERIFY IF BUF SIZE=6144 CLA,INA RETURN WITH A REG = 1 JMP V6144,I RETURN * VERIFY NOT POSSIBLE WITH BUFFER SIZE OF 6144 WORDS V2048 LDA LWA16 CHANGE LWA TO 16K STA BGLWA STORE IT IN BASE PAGE LOCATION JSB INTON TURN ON INTERR7!UPTS AND MEM PROTECT FENCE CLA RETURN WITH A REG = 0 JMP V6144,I RETURN * AVBUF NOP XEQT EQU 1717B LWA24 OCT 57677 LWA OF 24K MEM LWA16 OCT 37677 LWA OF 16K MEM BGLWA EQU 1777B LWA IN BG MEM PATRN OCT 177777 * * * NSPRS - ROUTINE TO FIND # OF SPARES FOR A GIVEN SUBCHANNEL(SUB#) * CALLING SEQUENCE: JSB NSPRS * ASSUMED THAT SUB# HAS SUBCHANNEL # * RETURNS: A REG WITH # OF SPARES FOR SUB# * * NSPRS NOP CLA CLEAR IFLAG STA IFLAG LDA D411 INITIALIZE POSSIBLE # OF SPARES STA NSPTR LDA SUB# LDB ADR ADDR OF TABLE WITH HD#,CYL#,#SRFCES,HEAD BUF INFO JSB ABSAD TO BE SUPPLIED BY ABSAD ROUTINE LDA SUB# FIND ENDING CYL# AND HEAD# ALS MULTIPLY BY 2 ADA SUB# SUB#*3 ADA ATB32 7905 TRACK MAP TABLE STA DIST2 ADDR OF TM INFO FOR SUB# ADA D2 A REG POINTS TO # OF TRACKS IN SUB# LDA A,I A REG HAS # OF TRACKS ADA N1 LAST TRACK IN SUB# LDB DIST2 JSB DADTR FIND ABSOLUTE ADDR OF LAST TRACK IN SUB# LDA PT#TR CYLINDER # RETURNED IN A REG STA ECYL END CYLINDER FOR SUB# BLF,BLF MOVE HEAD# TO LOW HALF STB EHEAD HEAD# FOR LAST TRACK * * # OF SPARES IS DETERMINED BY GOING THROUGH AND COMPARING * FISRT AND LAST CYLINDERS AND # OF SURFACES COVERED BY SUB# * AND ALL SUBCHANNELS ON SAME UNIT AS SUB# * LDA NSUB IF THERE IS ONLY ONE SUBCHANNEL DEFINED CPA D1 CALCULATE # OF SPARES JMP NSPR4 CLA STA SUB FIRST SUBCHANNEL IS 0 NSPR1 CPA SUB# IS IT SUB#? JMP NSPR9 YES, THEN LOOK AT NEXT SUBCHANNEL LDB ADR1 TABLE ADDRESS FOR ABSOLUTE TRACK ADDRESS AND JSB ABSAD HEAD BUFFER FOR SUB LDA UNIT UNIT#'S FOR THE 2 SUBCHNLS SAME? CPA UNIT1 RSS JMP NSPR9 NO, THEY ARE DIFFERENT - TRY NEXT SUBCHNL  LDA ECYL YES, COMPARE END CYL OF SUB# AND FIRST CPA SCYL1 CYL OF SUB - ARE THEY THE SAME? JMP NSPEQ YES CMA,INA NO THEN FIRST CYL OF SUB < ENC CYL OF SUB#? ADA SCYL1 SSA IF NEGATIVE YES JMP NSPLT YES ADA N1 STA NSPCL POSSIBLE # OF SPARE CYLINDERS JSB SMHED BOTH SUBCHANNELS HAVE ANY SURFACE IN COMMON? SZA,RSS JMP NSPR4 NO,THEN CALCULATE # SPARE CYL AGAIN CCA YES,SET FLAG TO CALCULATE SP TRKS BET FIRST STA IFLAG HEAD OF SUB# AND SUB JMP NSP12 DO NOT RE-CALCULATE # OF SPARE CYL NSPR4 LDB ECYL NO,END CYLINDER OF SUB# CMB,INB ADB D410 410-ECYL=POSSIBLE # OF SPARE CYLINDERS LDA SDTYP SOURCE DISC TYPE? CPA D7920 7920? ADB D412 YES,THEN POSSIBLE # SPARE CYL=822-ECYL STB NSPCL NSP12 CLA CALCULATE # SPARES ON ECYL BETWEEN STA TEMP EHEAD AND LAST SURFACE # LDB EHEAD NSPR6 CPB D4 IS IT THE LAST SURFACE? JMP NSPR3 YES INB NO, CHECK NEXT SURFACE LDA AHD GET VALUE OF NEXT ENTRY IN HEAD BUFFER ADA B LDA A,I SZA IS IT INCLUDED FOR THIS SUBCHNL? ISZ TEMP YES, INCREMENT EXTRA # SPARES BY 1 JMP NSPR6 TRY FOR NEXT SURFACE NSPR3 ISZ IFLAG WAS FLAG SET TO -1? JMP NSP15 NO, THEN DONE LDA AHD EVALUATE #0OF SPARES AFTER EHEAD STA TEMP1 SAVE ADDRESS OF HEAD BUFFER FOR SUB# LDB AHD1 STB TEMP2 SAVE ADDRESS OF HEAD BUFFER FOR SUB NSPR8 LDA TEMP1,I GET VALUE OF ENTRY IN HEAD BUFFER SZA,RSS JMP NSPR7 THIS SURFACE NOT INCLUDED IN SUB# LDB TEMP2,I SURFACE INCLUDED IN SUB? SZB JMP NSP15 YES, THEN NO MORE EXTRA SPARES ISZ TEMP NO, THEN THIS IS AN EXTRA SPARE NSPR7 ISZ TEMP1 TRY NEXT SURFACE ISZ TEMP2 JMP NSPR8 NSP15 CLA -g CLEAR IFLAG STA IFLAG LDA NSPCL #L OF POSSIBLE SPARE CYLINDERS LDB NSRF # OF SPARE CYLINDERS * # OF SURFACES CMB,INB = # OF SPARE TRACKS STB COUNT NSPR2 ISZ COUNT RSS JMP NSPR5 ALL SURFACES ACCOUNTED FOR ADA NSPCL ADD # OF SPARE CYLINDERS ONE MORE TIME JMP NSPR2 NSPR5 ADA TEMP ADD ANY EXTRA SPARES LDB NSPTR # OF SPARE TRACKS EVALUATED PREVIOUSLY CMB,INB NEW-OLD ADB A NEW # SPARES > OLD # SPARE? SSB STA NSPTR NO, NSPTR=NEW # SPARES JMP NSPR9 ON TO THE NEXT SUBCHANNEL * * END CYLINDER OF SUB# = START CYLINDER OF SUB * NSPEQ JSB SMHED BOTH SUBCHANNELS HAVE ANY HEAD# 'S IN COMMON? SZA JMP NSPER YES - ERROR CONDITION JMP NSPR4 EVALUATE POSSIBLE # OF SPARE CYLINDERS * *START CYLINDER OF SUB < END CYLINDER OF SUB# * NSPLT JSB SMHED SPAN SAME HEADS? SZA,RSS JMP NSPR4 EVALUATE POSSIBLE SPARE CYLINDERS LDB SUB BLS SUB*2 ADB SUB SUB*3 ADB ATB32 MAP ADDRESS FOR SUB LDA B ADA D2 POINTER TO # OF TRACKS IN SUB LDA A,I # OF TRACKS IN SUB ADA N1 LAST TRACK # IN SUB JSB DADTR FIND ABSOLUTE ADDR OF LAST TRACK IN SUB LDA SCYL START CYL OF SUB# CMA,INA ADA PT#TR END CYL OF SUB - START CYL OF SUB# SSA,RSS END CYL OF SUB>=START CYL OF SUB#? JMP NSPER YES - ERROR CONDITION JMP NSPR4 NO EVALUATE POSSIBLE SPARE CYLINDERS * NSPR9 ISZ SUB INCREMENT SUBCHNL COUNT LDA SUB CPA NSUB DONE LOOKING AT ALL SUBCHANNELS RSS JMP NSPR1 NO, REPEAT PROCESS AGAIN NSP10 LDA NSPTR RETURN LDB NSUB IF THERE IS ONLY ONE SUBCHNL CPB D1 DEFINED, CHECK # OF SPARES RSS ONE SUCHNL DEFINED JMP NSPRS,I RETURN, MORE THAN 1 mCHFBSUBCNLS DEFINED CMA,INA -VE OF # OF SPARES FOR THIS SUBCHNL ADA D10 IS IT > 10? SSA JMP NSP11 YES , THEN LIMIT THEM TO 10 LDA NSPTR NO, KEEP THEM AS NSPTR JMP NSPRS,I RETURN NSP11 LDA D10 LIMIT # OF SPRES TO 10 STA NSPTR JMP NSPRS,I RETURN * * ERROR CONTDITION * NSPER JSB WRITE DEF ERR0 WARNING -- DEF D5 JSB WRITE DEF ERR6 SUBCHANNELS OVERLAP ON SOURCE UNIT DEF D16 CLA RETURN WITH # OF SPARES AS 0 STA NSPTR JMP NSPRS,I * D412 DEC 412 ADR DEF *+1 HEAD NOP UNIT NOP SCYL NOP NSRF NOP HD BSS 5 AHD DEF HD ADR1 DEF *+1 HEAD1 NOP UNIT1 NOP SCYL1 NOP NSRF1 NOP HD1 BSS 5 AHD1 DEF HD1 ECYL NOP EHEAD NOP COUNT NOP NSPCL NOP NSPTR NOP SUB NOP * * * ABSAD - ROUTINE FINDS ABSOLUTE ADDRESS OF FIRST TRACK OF A GIVEN * SUBCHANNEL - SETS UP HEAD BUFFER FOR IT IE. IF SUBCHNL * IS DEFINED TO USE 2 SURFACES, SAY 1 & 2, THEN HDBUF=0, * HDBUF+1=1, HDBUF+2=1 * CALLING SEQUENCE: JSB ABSAD * A REG = SUBCHANNEL # * B REG = ADDR OF TABLE WITH FOLLOWING FORMAT: * ATBLE DEF *+1 ADDR OF TABLE * HEAD BSS 1 STARNG HEAD# FOR SBCHNL * UNIT BSS 1 UNIT# FOR SUBCHNL * SCYL BSS 1 STARTING CYL # * NSRFC BSS 1 # OF SURFACEES FOR SBCHNL * HDBUF BSS 5 HEAD BUFFER FOR SUBCHNL * RETURNS: TABLE FILLED UP WITH APPROPRIATE EENTRIES FOR SUBCHANNEL * * 1HABSAD NOP STA SUB SAVE SUBCHANNEL # STB ADDR SAVE ADDRESS OF TABLE ALS MULTIPLY SUB BY 2 ADA SUB SUB*3 ADA ATB32 ADDR POINTING TO TRACK MAP INFO FOR SUB LDB A THIS ADDR HAS TO BE IN B REG FOR DADTR ROUTINE CLA FIND ABSOLUTE ADDR OF FIRST TRACK IN SUBCHNL JSB DADTR IE. TRACK 0 BLF,BLF MOVE HEAD # TO LOW HALF STB ADDR,I HEAD# LDB ADDR INB STA B,I UNIT # INB LDA PT#TR STA B,I CYLINDER# INB LDA NSRFC STA B,I NUMBER OF SURFACES INB STB HDBUF HEAD BUFFER CLA STA COUNT COUNTER TO INDEX INTO HDBUF ABSA1 LDA HDBUF CLEAR HEAD BUFFER ADA COUNT CLB STB A,I CLEAR AN ENTRY IN HDBUF LDB COUNT CPB D4 ALL 5 ENTRIES DONE JMP ABSA2 YES ISZ COUNT NO, CLEAR NEXT ENTRY JMP ABSA1 * ABSA2 CLA,INA COUNT IS COUNTER FOR #0OF SURFACES COVERED STA COUNT INITIALIZE IT TO 1 LDA ADDR,I GET STARTING HEAD FROM THE TABLE ADA HDBUF ABSA3 CLB,INB AND STORE 1 IN HDBUF+COUNT STB A,I LDB ADDR ADB D3 GET # OF SURFACES FOR SUBCHNL LDB B,I CPB COUNT ALL SURFACES ACCOUNTED FOR? JMP ABSAD,I YES - RETURN LDB SDTYP DISC TYPE? CPB D7905 7905 DISC? LDB D2 YES, THEN HEADS 0-2 CPB D7906 7906 DISC? LDB D3 YES THEN HEADS 0-3 CPB D7920 7920 DISC? LDB D4 YES, THEN HEADS 0-4 ABSA4 ADB HDBUF B REG HAS LAST AVAIL HEAD # CPB A CURRENT HEAD#># HEADS AVAIL ON DISC? JMP ERROR YES,ERROR ISZ COUNT NO, DO NEXT SURFACE INA JMP ABSA3 * ERROR JSB DCASC DEF *+4 DEF ERR7+14 CONVERT SUBCHANNEL # TO ASCII DEF D1 DEF SUB JSB WRITE  DEF ERR7 IMPROPERLY DEFINED SUBCHANNEL XX DEF D15 JMP EXITU ABORT UTILITY * ADDR NOP HDBUF NOP * * * SMHED - ROUTINE TO DETERMINE IF THERE IS A COMMON SURFACE * USED BY 2 SUBCHANNELS * CALLING SEQUENCE: JSB SMHED * ASSUMED THAT HD & HD1 ARE TWO HEAD BUFFERS FOR THE SUBCHNLS * RETURNS: A REG = 0 IF NO COMMON SURFACES FOUND * = 1 OTHERWISE * * SMHED NOP CLA A REG IS COUNTER SMHD1 LDB AHD ADB A LDB B,I SZB,RSS HD+A REG=1? JMP SMHD2 NO, SUBCHNL DOES NOT USE THIS SURFACE LDB AHD1 DOES THE 2ND SUBCHNL ALSO USE THIS SURFACE? ADB A LDB B,I SZB,RSS YES, IF B REG = 1 JMP SMHD2 NO, SO TRY FOR NEXT SUBCHNL CLA,INA EQUAL SO RETURN 1 IN A REG JMP SMHED,I * SMHD2 CPA D4 ALL FIVE SURFACES LOOKED AT? JMP SMHD3 YES INA NO, INCREMENT A JMP SMHD1 LOOK AT NEXT SURFACE (HEAD POSITION) * SMHD3 CLA NO COMMON SURFACE RETURN WITH A REG = 0 JMP SMHED,I RETURN * * * FLGDS - ROUTINE TO FLAG A DEFECTIVE TRACK AND SPARE IT TO * A GIVEN TRACK # * CALLING SEQUENCE: JSB FLGDS * A REG HAS TRACK# OF SPARE TO BE USED * ASSUME: ADDR OF LOC TO GO TO IF A DEFECTIVE SPARE IS FOUND * IS SET UP IN INITE LOC AND DEFECTIVE TRACK# IS IN TRACK * * FLGDS NOP STA SPTRK SAVE SPARE TRACK # LDB FLGDF SET INIT1 WORD TO FLAG TRACK DEFECTGIVE STB INIT1 LDB DIST1 TRACK MAP ADDR FOR SUB# JSB DADTR GET ABSOLUTE TRACK ADDR FOR SPARE TRACK LDA PT#TR A HAS CYLINDER #, DST CYLA2 B REG HAS HEAD# CLA,INA STA RTFLG SET RETURN FLAG LDA TRACK DEFECTIVE TRACK# LDB AJB CORE ADDR OF BUFFER CLE REG E=0 FOR WRITE JSB DISK5 SET UP DEFECTIVE TRACK DLD CYLAD SAVE THESE TWO WORDS  DST TBUF FOR LATER USE CLA,INA DO A FAKE WRITE TO FIND STA IFLAG STATUS OF SPARE TRACK STA RTFLG SET RETURN FLAG LDA FLMSK CHANGE FILE MASK TO NO AUTO SPARING STA FILMK CLA STA INIT1 CLEAR INIT WORD LDA SPTRK SPARE TRACK # LDB AJB ADDRESS OF BUFFER CLE E REG=0 FOR WRITE JSB DISK5 WRITE LDA FLMSK+1 RESTORE FILE MASK TO AUTO SPARE STA FILMK LDA STATB CHECK STATUS RAL,RAL IS THE DEFECTIVE BIT ON THE SSA SPARE TRACK SET? JMP FLGD1 YES, THEN HONOR IT LDA D2 NO THEN MARK THE SPARE TRACK STA IFLAG WITHOUT SEEKING AGAIN DLD TBUF SET UP TO FLAG THE SPARE TRACK DST CYLA2 LDA KB PROTECT BIT ON SAVED TRACK SET? SSA,RSS JMP INIEV NO LDA FLGPS YES, SO FLAG TRACK SPARED AND PROTECTED RSS INIEV LDA FLGSP SET SPARE FLAG BUT NOT PROTECT STA INIT1 SET INIT1 WORD FOR DRIVER FLGD1 CLA,INA SET RETURN FLAG STA RTFLG LDA SPTRK CLE REG E = 0 FOR WRITE LDB AJB JSB DISK5 FLAG THE SPARED TRACK CLA CLEAR IFLAG STA IFLAG JMP FLGDS,I RETURN * SPTRK NOP RTFLG NOP * * * RDTP - IF EOT HAS NOT BEEN REACHED A REC OF LENGTH JSIZE+2 * IS READ FROM MAG TA E, IF EOT HAD BEEN REACHED ROUTINE * ASKS USER TO MOUNT NEXT TA E AND THEN READS REC * CALLING SEQUENCE: JSB RDTP * A REG CONTAINS ADDRESS OF BUFFER INTO * WHICH REC HAS TO BE READ * RETURNS: EOFLG=0 IF EOF HAS NOT BEEN REACHED * =1 IF EOF HAS BEEN REACHED * * RDTP NOP STA ABUF ADDRESS OF BUFFER JSB EOT EOT DETECTED DURING PREVIOUS READ OPERATION SZA,RSS JMP RDTP1 NO, READ REC RDTP2 JSB MTNR MAG TAPE READY? JSB REWND REWIND NEW MAG TAPE JSB PRNTH PRINT INFO. ON HEADER REC - TAPE OK? DEF HEADR JMP RDTP1 TAPE OK JSB WRITE MOUNT CORRECT TAPE DEF MSG26 DEF D9 JSB PAUSE WAIT FOR RIGHT TAPE TO BE MOUNTED JMP RDTP2 PRINT HEADER INFO AGAIN RDTP1 LDA JSIZE SIZE OF BUFFER WITHOUT HEADER WORDS ADA D2 ADD HEADER WORDS STA TEMP1 SIZE OF BUFFER TO BE READ FROM MT JSB MTNR MAG TAPE READY? JSB EXEC READ RECORD DEF *+5 DEF D1 DEF MTLU DEF ABUF,I DEF TEMP1 SZB,RSS EOF SEEN? ISZ EOFLG YES, THEN SET EOF FLAG JMP RDTP,I B REG HAS # OF WORDS TRANSMITTED, RETURN * SIZE NOP ABUF NOP EOFLG NOP * * * WRTTP - ROUTINE TO WRITE RECORD ON MAG TAPE IF EOT HAS NOT * BEEN REACHED, IF EOT SEEN, ASK USER TO MOUNT NEW TAPE * CALLING SEQUENCE: JSB WRTTP * A REG HAS ADDRESS OF BUFFER TO BE WRITTEN * * WRTTP NOP STA ABUF SAVE ADDRESS OF BUF JSB EOT EOT HAS BEEN REACHED? SZA,RSS JMP WRTP1 NO,CONTINUE WITH WRITE ISZ TAPEN YES, INCREMENT TAPE # JSB WRING WRITE RING ON MAG TAPE? JSB EXEC WRITE HEADER RECORD ON NEW MT DEF *+5 DEF D2 DEF MTLU DEF HEADR DEF D140 * WRTP1 LDA JSIZE ADA D2 DATA WORDS + 2 WORDS OF HEADER INFO STA TEMP1 JSB MTNR MAG TAPE READY? JSB EXEC WRITE RECORD ON MT DEF *+5 DEF D2 DEF MTLU DEF ABUF,I DEF TEMP1 JMP WRTTP,I RETURN * * * RDMT - IF BUFFER SIZE SPECIFIED BY USER IS 2048 WORDS THEN * THIS ROUTINE READS 3 RECORDS FROM MT TO MAKE UP A * 6144 WORD BUFFER TO WRITE ON DISC * CALLING SEQUENCE: JSB RDMT * * RDMT NOP LDA AKB FIRST READ A JSIZE REC FROM MT JSB RDTP INTO KB BUFFER LDA EOFLG K EOF DETECTED? SZA JMP RDMT,I YES, THEN RETURN LDA JSIZE NO, CHECK IF JSIZE IS 6144 WORDS CPA D6144 JMP RDMT,I YES, RETURN DLD KB+2048 SAVE LAST TWO WORDS OF KB, THEY WILL BE OVERLAYED DST RTEMP BY TWO HEADER WORDS OF NEXT RECORD TO BE READ LDA ALB ADDRESS OF NEXT BUFFER JSB RDTP READ JSIZE RECORD DLD RTEMP LOAD THE SAVED WORDS AND STORE THEM BACK DST KB+2048 IN THEIR ORIGINAL LOC DLD LB+2048 SAVE LAST TWO WORDS OF LB BUF DST RTEMP LDA AMB BUFFER FOR THIRD REC JSB RDTP READ ANOTHER JSIZE REC FROM MT DLD RTEMP RESTORE BACK THE LAST TWO WORDS OF LB DST LB+2048 JMP RDMT,I RETURN * RTEMP BSS 2 * * * WRTMT - ROUTINE TO WRITE EITHER 6144 WORD RECORD OR IF * JSIZE IS LESS THAN 6144, BREAK BUFFER INTO 3 2048 * RECORDS AND WRITE THEM ON MAG TAPE * CALLING SEQUENCE: JSB WRTMT * * WRTMT NOP LDA AKB BUFFER CONTAINING 6144 WORD DATA JSB WRTTP WRITE JSIZE WORDS FROM IT ON TAPE LDA JSIZE IS JSIZE = 6144 WORDS? CPA D6144 JMP WRTMT,I YES, THEN WHOLE BUFFER WRITTEN TO MT DLD KB NO,DO NEXT PORTION OF BUFFER DST LB STORE THE TWO HEADER WORDS FROM KB IN LB & LB+1 LDA ALB WRITE LB BUFFER TO MT JSB WRTTP DLD KB LAST PORTION OF BUFFER TO BE WRITTEN DST MB WRITE HEADER WORDS FOR MB BUFFER LDA AMB WRITE MB BUFFER TO TAPE JSB WRTTP JMP WRTMT,I RETURN * * * EOT - ROUTINE TO CHECK IF EOT HAS BEEN DETECTED, IF SO * ASK USER TO MOUNT NEXT TAPE * CALLING SEQUENCE: JSB EOT * RETURNS: 0 IN A REG IF EOT HAS NOT BEEN DETECTED * 1 IN A REG IF EOT HAS BEEN DETECTED * * EOT NOP LDA MTLU SET CONTROL WORD FOR DYNAMIC STATUS REQUEST ADA .600 STA TEMP1 CONTROL WORD JSB EXEC DEF *+3  DEF D3 DYNAMIC STATUS FOR MT DEF TEMP1 AND .40 IF BIT 5 IS ON EOT HAS BEEN REACHED CPA .40 JMP EOT1 EOT REACHED CLA EOT NOT REACHED JMP EOT,I RETURN WITH A REG = 0 * EOT1 JSB WRITE INFORM USER THAT EOT HAS BEEN DETECTED DEF MSG18 EOT HAS BEEN REACHED, MOUNT NEXT TAPE DEF D14 JSB REWND JSB PAUSE ENTER 'GO' WHEN READY JSB MTNR MT READY? CLA,INA JMP EOT,I RETURN WITH A REG = 1 * .40 OCT 40 .100 OCT 100 .600 OCT 600 .1300 OCT 1300 * * * MTNR - ROUTINE TO TEST IF MAG TAPE IS READY * CALLING SEQUENCE: JSB MTNR * * MTNR NOP MTNR1 LDA .600 ADA MTLU FUNCTION CODE FOR DYNAMIC STATUS REQUEST STA TEMP JSB EXEC DYNAMIC STATUS REQUEST DEF *+3 DEF D3 DEF TEMP SLA,RSS BIT SET? JMP MTNR,I NO, RETURN JSB WRITE MAG TAPE NOT READY DEF MSG23 DEF D6 JSB PAUSE JMP MTNR1 * * * WRING - ROUTINE TO CHECK IF WRITE RING IS PRESENT ON MAG TAPE * CALLING SEQUENCE: JSB WRING * * WRING NOP WRNG1 LDA .600 ADA MTLU SET UP CONTROL WORD FOR DYNAMIC STATUS REQUEST STA TEMP JSB EXEC DEF *+3 DEF D3 DEF TEMP AND D4 SZA,RSS WRITE RING ON? JMP WRING,I YES JSB WRITE NO, THEN SEND MESSAGE TO USER DEF ERR2 NO WRITE RING, WRITE ENABLE MT DEF D15 JSB PAUSE JSB MTNR JMP WRNG1 DID USER REALLY WRITE ENABLE MT? * * * * .MVW - MOVES SPECIFIED # OF WORDS FROM ONE LOCATION TO NEXT * CALLING SEQUENCE: JSB .MVW * DEF #WRDS # OF WORDS TO BE MOVED * A REG = ADDRESS OF SOURCE BUFFER * B REG = ADDRESS OF DESTINATION BUFFER * * .MVW NOP STA .TMP1 SAVE ADDR OF SOURCE BUFFER STB .TMP2 SAVE ADDR OF DEST BUFFER LIA 6  FIND OUT IF THE COMPUTER IS A 2100 OR EARLIER SZA,RSS JMP NMX0 YES, IT IS NOT AN MX OR XE CCA ADA .MVW POINT A REG TO JSB .MVW INSTR STA .MVW MAKE THIS THE RETURN ADDRESS LDA MVW GET MVW INSTR STA .MVW,I REPLACE JSB .MVW WITH MVW MICRO INSTRUCTION LDA .TMP1 RESTORE CONTENTS OF A REG JMP .MVW,I RETURN AND EXECUTE MVW INSTR NMX0 LDA .MVW,I ADDR OF # OF WORDS TO BE MOVED LDA A,I # OF WORDS TO BE MOVED STA COUNT CLA STA .TEMP MLOOP LDA .TMP1 ADDR OF SOURCE BUF ADA .TEMP INDEX INTO BUF LDA A,I GET WORD TO BE MOVED LDB .TMP2 ADB .TEMP INDEX INTO DEST BUFFER STA B,I MOVE WORD INTO DEST BUFFER ISZ .TEMP LDA .TEMP CPA COUNT ALL WORDS MOVED? RSS JMP MLOOP ISZ .MVW ISZ .MVW RETURN JMP .MVW,I * .TEMP NOP .TMP1 NOP .TMP2 NOP MVW MVW 0 * * * .CMW - ROUTINE TO COMPARE TWO BUFFERS * CALLING SEQUENCE: JSB .CMW * DEF #WRDS # OF WORDS * A REG = BUFFER 1 ADDRESS * B REG = BUFFER 2 ADDRESS * RETURN: IF BUFFERS EQUAL TO P LOC * IF BUFFERS NOT EQUAL TO P+1 LOC * * .CMW NOP STA .TMP1 STB .TMP2 SAVE ADDRESSES OF THE TWO BUFFERS TO BE COMPARED LIA 6 IS IT A 2100 OR EARLIER COMPUTER? SZA,RSS JMP NMX01 YES CCA NO, REPLACE JSB INSTR WITH CMW INSTR ADA .CMW STA .CMW JSB INSTR IS RETURN ADDRESS LDA CMW STA .CMW,I REPLACE JSB .CMW INSTR WITH CMW MICRO INSTR LDA .TMP1 RESTORE A REGISTER JMP .CMW,I NMX01 LDA .CMW,I GET # OF WORDS TO BE COMPARED LDA A,I STA COUNT ISZ .CMW ISZ .CMW SUCCESSFUL COMPARE RETURN LOACATION CLA STA .TEMP INDEX FOR THE TWO BUFFERS CMWLP LDA .TMP1 ADA .TEMP  LDA A,I A REG HAS WORD TO BE COMPARED LDB .TMP2 ADB .TEMP LDB B,I B REG HAS CORRESPONDING WORD FROM 2ND BUFFER CPA B RSS JMP .CMW1 NO MATCH, RETURN TO P+1 ISZ .TEMP MATCH, THEREFORE COMPARE NEXT 2 WORDS LDA .TEMP CPA COUNT ALL WORDS COMPARED? JMP .CMW,I YES THEN RETURN JMP CMWLP NO THEN COMPARE NEXT TWO WORDS .CMW1 ISZ .CMW ISZ .CMW JMP .CMW,I RETURN * CMW CMW 0 * * * RD00 - ROUTINE TO READ RECORD FROM 7900 DISC * CALLING SEQUENCE: JSB RD00 * * RD00 NOP CLA CLEAR INIT FLAG STA INIT1 LDA TRACK SET TRACK ADDRESS TO REAL TRACK# LDB ATB31 ADDR OF TRACK MAP TABLE ADB SUB# LDB B,I BASE TRACK ADDR ADA B BASE+RELATIVE TRACK # LDB AJB ADDRESS OF BUFFER IN CORE CCE E REG = 1 FOR READ JSB DISK0 READ FROM 7900 DISC SSA,RSS IF A IS -VE, DATA ERROR OR PARITY ERROR JMP RD001 NO ERROR LDA KB+1 TURN ON SIGN BIT OF KB+1 ADA MSIGN TO INDICATE DATA WAS READ UNSUCCESSFULLY STA KB+1 SAVE IT IN HEADER INFO. FOR BUFFER * RD001 LDB SUB# LDA STATB TRACK JUST READ IS WRITE PROTECTED? ELA,CLE,ERA CLEAR SIGN BIT FROM STATUS WORD CPA .2010 DATA PROTECT SWITCH AND FLAGGED CYL BITS ON? JMP RD002 YES CPA .10 JUST FLAGGED CYL BIT ON? RD002 ADB MSIGN YES, TURN ON SIGN BIT STB KB STORE FOR HEADER INFO OF TRACK JMP RD00,I RETURN * MSIGN OCT 100000 .2010 OCT 2010 .10 OCT 10 * * * WR00 - ROUTINE TO WRITE RECORD ON 7900 DISC * CALLING SEQUENCE: JSB WR00 * * WR00 NOP LDB MSIGN LDA KB SAVE RECORD WAS WRITE PROTECTED? ELA CHECK SIGN BIT SEZ ADB M1000 YES, ADD PROTECT FLAG BIT IN INIT WORD STB INIT1 SET UP INIT1 FOR 7900 DISC DRIVER CLE,ERA CLEAR SIGN BIT STA SUB# LDA KB+1 CLEAR SIGN BIT FROM 2ND HEADER WORD ELA,CLE,ERA STA TRACK TRACK# LDA COTYP CPA D3 FROM - TO COPY? RSS JMP WR01 NO LDA PLATR YES, THEN SET UP PLATR & SUB# LDB SUB# FOR DEST DISC FOR FROM-TO COPY DST TBUF LDA DPLTR DESTINATION PLATR STA PLATR LDA DSUB# DESTINATION SUB# STA SUB# LDA TRACK ADA FTRCK BASE + RELATIVE TRACK ADDRESS JMP WR02 WR01 LDA TRACK LDB ATB31 ADB SUB# LDB B,I ADA B REAL TRACK ADDRESS WR02 LDB AJB ADDRESS OF CORE BUFFER CLE E REG=0 FOR WRITE JSB DISK0 ASK DRIVER TO WRITE REC LDA COTYP CPA D3 COPY TYPE FROM TO ? RSS JMP WR00,I NO DLD TBUF YES THEN RESTORE ORIGINAL SUB# AND PLATR VALUES STA PLATR FOR SOURCE DISC STB SUB# JMP WR00,I RETURN * M1000 OCT 1000 * * * RD05 - ROUTINE TO READ DATA FROM 7905 DISC * CALLING SEQUENCE: JSB RD05 * * RD05 NOP CLA SET INIT1 BIT TO 0 STA INIT1 LDA TRACK LDB AJB CORE BUFFER ADDRESS CCE SET E REG=1 FOR READ JSB DISK5 ASK DRIVER TO READ RECORD FROM 7905 DISC CPA PATRN ILLEGAL SPARE ENCOUNTERED? RSS JMP RD052 NO LDA COTYP IS IT A FROM-TO COPY? CPA D3 JMP RD051 YES, THEN GIVE ILLEGAL SPARE ERROR MESSAGE LDB ATB32 NO, TRACK SPARING REQUESTED? ADB N1 LDB B,I B REG HAS FIRST WORD OF TRACK MAP TABLE SSB,RSS JMP SAC10 NO, THEN SKIP THIS REC DO NEXT ONE RD051 JSB WRITE GIVE ERROR MESSAGE DEF ERR12 ILLEGAL SPARE AT: DEF D9 LDA TRACK PRINT TRACK LOC JSB PTRK5 JSB QUERY DEF MSG28 CONTINUE? DEF D5 DEF EXP6 u REPLY YES OR NO DEF D9 LDA RBUF WHAT IS THE RESPONSE? CPA YE RSS JMP EXITU DOES NOT WISH TO CONTINUE ABORT UTILITY LDA KB+1 MARK TRACK DEFECTIVE ADA MSIGN STA KB+1 JMP RD05,I RETURN RD052 LDB SUB# LDA STATB GET STATUS WORD AND .4000 TRACK JUST READ WAS PROTECTED? CPA .4000 ADB MSIGN YES, TURN ON BIT 15 OF KB STB KB JMP RD05,I RETURN * * * * WR05 - ROUTINE TO WRITE ON 7905 DISC * CALLING SEQUENCE: JSB WR05 * * WR05 NOP LDA COTYP CPA D3 FROM - TO COPY? RSS JMP WR050 LDA AFRMP YES, THEN DEST TRACK MAP TABLE IS DIFFERENT INA STA DIST1 SET UP FOR DISC DRIVER CLA STA SUB# SUB# ALWAYS 0 FOR FROM - TO COPY JMP WR058 WR050 LDA KB ELA,CLE,ERA CLEAR SIGN BIT STA SUB# CALCULATE TRACK MAP ADDRESS FOR SUB# ALS ADA SUB# SUB#*3 ADA ATB32 STA DIST1 LDA ATB32 IS TRACK SPARING REQUIRED? ADA N1 LDA A,I SSA,RSS JMP WR058 NO LDA FLMSK YES, THEN FIRST WRITE W/OUT AUTO STA FILMK TRACK SPARING WR058 CLA,INA STA IFLAG IFLAG=1 IF THIS IS WRITE FOR STATUS PURPOSES LDB AJB CORE ADDRESS OF BUFFER CLA STA INIT1 SET UP INIT1 WORD FOR DISK DRIVER LDA DUNIT STA UN#IT UNIT # FOR DRIVER LDA KB+1 CLEAR SIGN BIT ON TRACK ADDRESS ELA,CLE,ERA STA TRACK CLE E REG=0 FOR WRITE JSB DISK5 WRITE DATA ON DISC LDB IFLAG IS THIS WRITE WITH TRACK SPARING? SSB JMP WR056 YES CPA PATRN NO,TRIED TO WRITE ON SPARED TRACK? RSS JMP WR051 NOT AN ILLEGAL SPARE JSB WRITE YES, GIVE ERROR MESSAGE DEF ERR12 ILLEGAL SPARE AT: DEF D9 LDA TRACK REPORT LOACATION OF TRACK JSB PTRK5 JSB QUERY DEF MSG28 CONTINUE? DEF D5 DEF EXP6 REPLY YES OR NO DEF D9 LDA RBUF WHAT IS THE RESPONSE? CPA YE RSS JMP EXITU DOES NOT WISH TO CONTINUE CLA CONTINUE, CLEAR IFLAG STA IFLAG JMP WR05,I RETURN WR051 LDA KB SSA,RSS WRITE PROTECT NEEDED? JMP WR053 LDB STATB YES LDA FLGPT WRITE PROTECT FLAG IN A SSB SPARED TRACK? LDA FLGPS YES, WRITE PROTECT + SPARED FLAG IN A JMP WR055 WR053 LDA STATB DEST TRACK WAS WRITE PROTECTED AND .4000 GET P BIT FROM STATUS CPA .4000 RSS SET THEN CLEAR IT JMP RWR05 NOT SET - RETURN LDB STATB IF DEST TRACK WAS WRITE PROTECTED LDA M1400 WIPE OUT WP STATUS-PLAIN INITIALIZE SSB SPARE BIT TURNED ON? LDA FLGSP YES, RESTORE SPARE STATUS BUT NOT PROTECT WR055 STA INIT1 LDA D2 SET IFLAG TO DO WRITE WITHOUT SEEK STA IFLAG WR057 LDB AJB CORE BUFFER ADDRESS LDA TRACK CLE REG E=0 FOR WRITE? JSB DISK5 IFLAG = 2 TO WRITE WITHOUT SEEK RWR05 CLA STA IFLAG CLEAR IFLAG JMP WR05,I * TRACK SPARING IS DESIRED WR056 LDA FLMSK+1 RESTORE FILE MASK TO AUTO TRACK SPARE STA FILMK LDA STATB IS THE DEFECTIVE BIT SET ON TRACK? RAL,RAL SSA JMP WR057 YES, THEN SPARE TRACK LDA FLGPT PROTECT FLAG + INITIALIZE LDB KB PROTECT FLAG ON ON SAVED TRACK? SSB,RSS LDA M1400 NO PLAIN INITIALIZE JMP WR055 RE-WRITE THE TRACK * IFLAG NOP FLMSK OCT 107400 FILE MASK WITHOUT AUTO SPARE OCT 107404 FILE MASK WITH AUTO SPARE * * * CMPAR - ROUTINE TO MAKE WORD TO WORD COMPARISON OF TWO BUFFERS * CALLING SEQUENCE: JSB CMPAR * AJB & AJB+JSIZE ARE ASSUMED TO BE ADDRESSES OF THE 2 BUFFERS * BUFFER LENGTH IS JSIZE * RETURNS: TO LOC P IF SUCCESSFUL COMPARE * TO LOC P+1 IF UNSUCCESSFUL COMPARE * * CMPAR NOP LDA AJB A REG HAS ADDR OF FIRST BUFFER LDB JSIZE SIZE OF EACH BUFFER CPB D6144 6144 WORD BUFFER? JMP CMPR2 YES ADB A NO, ADDRESS OF 2ND BUFFER IN B REG RSS CMPR2 LDB AVBUF ADDR OF 2ND BUFFER FOR BUF OF 6144 WORDS JSB .CMW COMPARE JSIZE WORDS DEF JSIZE NOP JMP CMPAR,I SUCCESSFUL COOMPARE, RETURN * NOP JSB WRITE COMPARE ERROR DEF MSG22 VERIFY ERROR AT: DEF D8 LDA TRACK LDB DSCTP CPB D7900 JMP CMPR1 JSB PTRK5 JMP CMPR3 CMPR1 LDA TRCK1 JSB PTRK0 CMPR3 ISZ CMPAR RETURN TO P+1 JMP CMPAR,I RETURN * * * LBCNG - ROUTINE TO CHANGE # OF BAD TRACKS AND NEXT AVAILABLE * SPARE TRACK INFO ON USER LABEL OF A DOS SUBCHANNEL * CALLING SEQUENCE: JSB LBCNG * * LBCNG NOP LDA D128 STA ISIZE SIZE OF 1 BLOCK FOR DISC DRIVER CLA STA SECTR STA INIT1 LDB ALABL READ FIRST TRACK IN SUBCHNL CCE JSB DISK5 LDA ALABL ADA D3 LABEL WORD LDB ASYST SYSTEM ASCII WORDS JSB .CMW COMPARE BUFFERS WHOSE ADDRESSES ARE IN A & B REG DEF D3 NOP JMP LBCN1 SUCCESSFUL COMPARE NOP JMP USER NO MATCH SO USER SUBCHANNEL LBCN1 LDA LABEL+64 TRACK # IS IN UPPER BYTE ALF,ALF BRING IT TO LOWER BYTE ALS MULTIPLY IT BY 2 LDB ALABL CCE JSB DISK5 READ TRACK WITH USER LABEEL ON IT * USER LDA UBADC # OF USED SPARES IN A REG ARS DIVIDE BY 2 STA LABEL+65 UPDATE # OF USED SPARE TRACKS WORD IN USER LABEL LDA UBADC CMA,INA BASE SPARE POOL ADDRESS - # USED SPARES = ADA CSPAR NEXT AVAILABLE SPARE TRACNLHK ARS DIVIDE BY 2 STA LABEL+66 UPDATE NEXT AVAIL SPARE TRCK WORD IN USER LABEL LDA TRCK1 LDB ALABL CLE JSB DISK5 WRITE UPDATED USER LABEL BACK ON DISC LDA D6144 STORE BACK ORIGINAL SIZE OF BUFFER FOR DRIVER STA ISIZE JMP LBCNG,I RETURN * ASYST DEF SYSTM SYSTM ASC 3,SYSTEM * TBCHN NOP TEMP DSIZE NOP DISK SIZE - NO. OF TRACKS SDS# NOP # SECTORS/TRACK FOR SYSTEM DISC$ DERCN NOP DISK ERROR COUNTER * "/E" ASC 1,/E SKP SPC 3 ǷN* SUBROUTINE TO TEST LEGALITY OF * A SUBCHANNEL. THE TEST CONSISTS * OF LOOKING FOR THE DESIRED * CHANNEL IN THE TRACK MAP. * CALLING SEQUENCE * * P-1 ERROR RETURN * P JSB TSTCH * P+2 NORMAL RETURN CHANNEL IN A SIZE IN B SPC 1 * A ON ENTRY IS ASSUMED TO BE THE SUBCHANNEL TO BE CHECKED. * ERROR EXIT IS P-1 * IF THE SUBCHANNEL IS LEGAL IT IS RETURNED IN A * AND B IS THE NUMBER OF TRACKS ON THAT CHANNEL SPC 1 TSTC0 NOP LDB ATB31 GET TABLE ADDRESS ADB A ADD SUBCHANNEL ADB D8 STEP TO # TRACKS LDB B,I GET # TRACKS IN B JMP TSTC0,I RETURN B= # TRACKS * * LST1 DEF *+1 I#OTB DEF DSK51 DEF DSK52 DEF DSK53 DEF DSK54 DEF DSK55 DEF DSK57 DEF DSK58 DEF DSK59 DEF DSK60 DEF DSK61 DEF DSK#R I#OTC DEF * LST2 DEF *+1 I#OTD DEF DSK01 DEF DSK02 DEF DSK03 DEF DSK04 DEF DSK05 DEF DSK07 DEF DSK08 DEF DSK09 DEF DSK10 DEF DSK11 DEF DSK16 DEF DSK70 I#OTE DEF * * S#EKC OCT 30000 R/DCM OCT 20000 DSK#R OCT 120000 T#AC0 NOP * * * * THE DISKD SUBROUTINE IS THE MAIN DISC INPUT/OUTPUT DRIVER. * IT SETS UP THE COMPLETE TRANSFER AND READS OR WRITES * 128 WORD SECTORS ON THE DISC. IT WAITS UNTIL THE TRANSFER * IS COMPLETE. STATUS IS DONE AFTER EACH TRANSFER FOR WRITE * PROTECT ERRORS THE OPERATOR IS ASKED TO TURN ON THE SWITCH. * FOR DEFECTIVE CYLINDER ERRORS THE IRRECOVERABLE ERROR ERR40 IS * TAKEN. FOR NOT READY ERRORS THE OPERATOR IS NOTIFIED. * FOR OTHER ERRORS TEN TRIES ARE MADE. IF THE ERROR STILL EXIST * AND: * * A - IF THE INIT FLAG IS SET EXIT TO INITE INDIRECT * * B - ELSE NOTIFY OPERATOR ATLND HALT * A= DISC ADDRESS -64 WORD/SECT BASIS- * B= DISC STATUS * SPC 3 * CALLING SEQUENCE * B = CORE ADDRESS * E = 1 FOR READ * E = 0 FOR WRITE * * RETURN - ALWAYS NORMAL--REGS. MEANINGLESS SPC 3 DISK0 NOP STA TRCK1 RBL,ERB SET THE READ/WRITE BIT STB MADDR AND SAVE THE ADDRESS LDB SUB# GET SUBCHANNEL NUMBER CLE,ERB B IS UNIT NOT E IS HIGH HEAD BIT LDB UN#IT GET UNIT NUMBER ADB M0100 SET COMMANDS LDA INIT1 ADD INIT FLAG TO WRITE ADA B COMMAND STA W#CMD AND SET WRITE COMMAND ADB M0100 READ STB R/DCM SET READ ADB M0100 STB S#EKC SEEK CLA,SEZ,CLE,RSS IF E = 0 INA SET HEAD 2 LDB SECTR GET SECTOR BRS B IS ACTUAL SECTOR STB H#AD SAVE ADB N24 SUBTRACT NUMBER ON A SIDE SSB,RSS IF POSITIVE STB H#AD RESET SECTOR ELA MOVE IN LOW HEAD BIT ALF,ALF ROTATE ADA H#AD AND ADD THE SECTOR STA H#AD SAVE HEAD/SECTOR ADDRESS TRY00 JSB $LIBR TURN OFF INTERRUPTS NOP CLF 0 RTRY0 LDA N10 RESET 10 TRY COUNTER STA EDCNT DSK16 STF 1 SET FLAG FOR STATUS JSB STATC GO DO STATUS AND .100 CHECK READY BIT SZA IF SET JMP NR#RR GO TELL THE MAN * LDA TRCK1 SET TRACK TO A JSB SEEK AND SEEK THE RECORD LDB MADDR SET THE CORE ADDRESS TO B LDA R/DCM SET FOR READ SSB,RSS WRITE? LDA W#CMD YES - RESET TO WRITE DSK01 CLC 1 SET UP COMMAND DSK02 OTA 1 SEND COMMAND DSK51 STF 0 SET FOR WRITE CLE,SSB READ? DSK52 STC 0,C YES / RESET FOR READ LDA DSK#R GET DMA WORD OTA 6 ASSIGN DMA CLC 2 SET FOR ADDRESS OTB 2 SEND ADDRESS LDA ISIZE SET LENGTH TO -ISIZE CMA,INA STC 2 SET FOR LENGTH OTA 2 SEND IT STC 6,C START DMA DSK03 STC 1,C START DRIVE CLC 6 JSB STATC GET STATUS STA STATB SAVE SLA JMP DERRC STATUS NOT OK-CHECK FOR ERRORS JSB INT0N STATUS OK - TURN ON INTERRUPTS JMP DISK0,I RETURN * DERRC RAL,CLE,ERA CLEAR SIGN BIT CPA .11 WRITE PROTECT ERROR? JMP WRPT0 YES - GO TELL HIM * CPA .31 DEFECTIVE CYLINDER? RSS JMP DERRD NO - CHECK FOR OTHER ERRORS JSB INT0N TURN ON INTERRUPTS LDA N1 POSSIBLE ONLY DURING READ JMP DISK0,I RETURN WITH A REG = -1 * DERRD AND .100 ISOLATE READY BIT SZA READY? JMP NR#RR NO - GO TELL HIM * CLA AND JSB SEEK ZERO ISZ DERCN STEP TOTAL ERROR COUNT ISZ EDCNT TIME THIS OP COUNTER JMP DSK16 NOT TEN YET GO TRY AGAIN * JMP IN#ER BAD TRACK REPORT IT * WRPT0 JSB INT0N TURN ON INTERRUPTS JSB WRITE WRITE PROTECT SWITCH IS OFF DEF MES32 ASK USER TO TURN IT ON DEF D11 JSB PAUSE WAIT FOR TURN ON JMP TRY00 TRY AGAIN. SPC 1 NR#RR JSB INT0N TURN ON INTERRUPTS JSB WRITE DISC IS NOT READY DEF MS4 SEND THE WORD TO THE MAN DEF D5 JSB PAUSE PAUSE JMP TRY00 ON RESTART RETRY SPC 1 SPC 2 SEEK NOP SEEK ROUTINE DSK57 OTA 0 SEND TRACK DSK58 STC 0,C SET DATA TO SHOW TRACK SEND ALF,ALF TRACK TO HIGH A ADA UN#IT ADD THE UNIT NUMBER LDB S#EKC GET SEEK COMMAND DSK09 CLC 1 SET UP COMMAND CHANNEL DSK10 OTB 1 SEND COMMAND DSK11 STC 1,C TELL CONTROLLER LDB H#AD GET HEAD/SECTOR ADDRESS DSK59 SFS 0 READY? JMP DSK59 WAIT * DSK60 OTB 0 SEND HEAD/SECTOR DSK61 STC 0,C START JSB STATC GET STATUS JMP SEEK,I RETURN SPC 2 STATC NOP WAIT AND STATUS ROUTINE DSK04 SFS 1 WAIT FOR FLAG JMP DSK04 * STF 6 CLEAR DMA DSK05 CLC 1 CLEAR CONTROLLER DSK53 STC 0,C SET DATA FOR LDA UN#IT STATUS DSK07 OTA 1 SEND STATUS REQUEST DSK08 STC 1,C START DSK54 SFS 0 WAIT FOR JMP DSK54 STATUS * DSK55 LIA 0,C GET STATUS AND JMP STATC,I RETURN SPC 2 LASK NOP NSEC NOP * * BAD TRACK TO BE REPORTED * IN#ER JSB INT0N TURN ON INTERRUPTS LDA STATB GET STATUS AND MASK SEEK CHECK AND M440 SZA,RSS CHECK END OF CYLINDER BITS JMP IN#E0 IF NOT SET CONTINUE WITH BAD TRACK REPORTING JSB WRITE DEF ERR8 IF SET GIVE ERROR MESSAGE AND ABORT UTILITY DEF D22 UNRECOVERABLE DISC ERROR-EOC OR SEEK CHECK JMP EXITU ABORT UTILITY * IN#E0 LDA VFLAG VERIFYING? SZA YES JMP DISK0,I YES, RETURN JSB WRITE REPORT BAD TRACK DEF ERR9 DEF D7 LDA TRCK1 JSB PTRK0 PRINT LOC OF TRACK JSB QUERY DEF MSG28 CONTINUE? DEF D5 DEF EXP6 REPLY YES OR NO DEF D9 LDA RBUF CPA YE RSS JMP EXITU ABORT UTILITY LDA N1 YES THEN RETURN WITH -1 IN A REG JMP DISK0,I * .11 OCT 11 .31 OCT 31 N10 DEC -10 N24 DEC -24 * * PTRK0 - ROUTINE TO PRINT TRACK # AND PLATTER # OF A TRACK ON * OPERATOR CONSOLE * CALLING SEQUENCE: JSB PTRK0 * A REG = TRACK# * * PTRK0 NOP STA TEMP1 SAVE TRACK# JSB DCASC CONVERT TRACK # TO ASCII DEF *+4 DEF TRKAD+3 DEF D2 DEF TEMP1 TRACK# JSB DCASC CONVERT PLATTER # TO ASCIIw DEF *+4 DEF TRKAD+10 DEF D1 DEF SUB# PLATTER # (SUBCHNL #) JSB DCASC CONVERT UNIT # TO ASCII DEF *+4 DEF TRKAD+15 DEF D1 DEF UN#IT UNIT# JSB WRITE SEND TRACK LOCATIONS TO TTY DEF TRKAD DEF D16 JMP PTRK0,I RETURN * TRKAD ASC 16,TRACK# , PLATTER# , UNIT# * * TBUF BSS 5 TEMP BUFFER DC EQU 0 HED MH RTGEN - CONSTANTS AND ADDRESSES * INITE DEF INIER FOR DISK ERROR INIT1 NOP INITILIZATION FLAG FOR DRIVER DIST1 NOP DIST2 NOP * INTMP NOP TEMP FOR INITILIZATION ROUTINES MS3 ASC 6,SUBCHNL 00? EXMS3 ASC 21,REPLY 1 TO 1233, 0 TO 410, 0 TO 2, 1 TO 3 MES1 ASC 20,# TRKS, FIRST CYL #, HEAD #, # SURFACES * HED INTERACTIVE DISC SET UP SECTION * * THE FOLLOWING MESSAGES ARE PRINTED DURING THE INITIALIZATION * PHASE, WITH THE SPECIFICATIONS FOR EACH VALID RESONSE. * * * MESSAGE RESPONSE * * MH DISC CHANL? ENTER 2 OCTAL DIGITS * * # TRKS, FIRST CYL#, HEAD #, # SURFACES ON SUBCHNL: * 0? * . ENTER FOUR DECIMAL NOS. * . SEPERATED BY A COMMA * . OR * . /E * 32? * DSETU NOP ENTRY POINT FOR QUESTION SECESSION. STB30 JSB WRITE DEF MES1 #TRKS, FIRST CYL#, HEAD#, #SURFACES DEF D20 LDA ATB32 SET ADDRESSES STA SDS# FOR INPUT STA INTMP AND CLEAR LOOPS LDB N96 CLEAR CLA THE TB30. STA INTMP,I TRACK ISZ INTMP MAP INB,SZB STEP COUNT - DONE? JMP TB30. NO - CLEAR NEXT WORD * STA INIT1 CLEAR INIT FLAG STA NSUB SET 0 DEFINED SUBCHANNELS TB30A STB INTMP SAVE CURRENT UNIT JSB DCASC CONVERT DECIMAL SBCHNL# TO ASCII DEF *+4 DEF MS3+4 INSERT THE ASCII CHARACTERS IN MESSAGE DEF D1 DEF INTMP JSB QUERY DEF MS3 9m SUBCHNL XX? DEF D6 DEF EXMS3 DEF D21 LDA RBUF GET FIRST CPA "/E" /E? JMP TB30Y YES - GO CHECK FURTHER * JSB GINIT NO - REINITIALIZE LBUF SCAN LDA N4 CONVERT 4 DIGITS JSB GETOC DECIMAL JMP EXPL ERROR - * STA TBCHN SET # TRACKS IN TEMP SZA,RSS IF ZERO JMP TB30B GO UPDATE POINTERS * JSB GETAL NOT ZERO - GET NEXT CHARACTER CPA BLANK COMMA IN? RSS YES - SKIP JMP EXPL NO - ERROR * LDA N3 SET FOR JSB GET 3 DECIMAL DIGITS AND CONVERT STA SDS#,I THE CYL # FOR TRACK 0. CCA GET 1 DIGIT JSB GET HEAD NUMBER STA B SAVE ADA N5 MUST BE LESS THAN 5. SSA,RSS WELL? JMP EXPL NO - BITCH * BLF,BLF PUT IN ITS PLACE STB BSHED AND SAVE CCA NOW GET # SURFACES JSB GET MUST BE 1 TO 5. STA B SZA ADA N6 SSA,RSS WELL? JMP EXPL NOT GOOD! BITCH BLF,BLF MOVE TO HIGH BLF END AND ADB BSHED COMBINE WITH HEAD ADB SUNIT ADD UNIT# STB BSHED TB30C ISZ SDS# STEP TO HEAD/UNIT WORD. LDA BSHED AND STA SDS#,I SALT IT AWAY. ISZ SDS# NOW THE # TRACKS LDA TBCHN WORD STA SDS#,I SALT IT AWAY. STA DSIZE SET ALSO FOR ASSUMPTION ISZ NSUB STEP TOTAL SUBCHANNEL COUNT TB30B ISZ SDS# STEP TABLE ISZ INTMP STEP SUBCHANNEL TB30F LDB INTMP IF CURRENT SUBCHANNEL CPB D32 IS 32 THEN JMP TB30Y DONE SO GO EXIT * JMP TB30A NOT 32 - GO ASK FOR NEXT ONE * SPC 1 * SPC 1 * TB30Y LDA NSUB NO - GET NUMBER OF CHANNELS SZA,RSS IS IT 0? JMP EXPL YES, THEN ASK AGAIN CMA,INA W DEFINED LDB ATB32 ADB N1 STA B,I STORE -VE # OF SUBCHANNELS IN TRACK MAP TABLE JMP DSETU,I RETURN * * SPC 1 BSHED NOP N96 DEC -96 D32 DEC 32 SPC 1 GET NOP GET SUBROUTINE CHECKS FOR EXISTANCE STA TBUF AND GETS NEXT JSB GETAL INPUT NUMBER CPA BLANK PASS NUMBER TYPE ECT FLAG IN A RSS LINE NOT EMPTY SO SKIP JMP EXPL EMPTY LINE SO ERROR * LDA TBUF GET TYPE/ # DIGITS JSB GETOC GET NUMBER JMP EXPL CONVERSION ERROR BITCH * JMP GET,I ELSE RETURN SKP SPC 3 * SUBROUTINE TO TEST LEGALITY OF * A SUBCHANNEL. THE TEST CONSISTS * OF LOOKING FOR THE DESIRED * CHANNEL IN THE TRACK MAP. * CALLING SEQUENCE * * P-1 ERROR RETURN * P JSB TSTC5 * P+2 NORMAL RETURN CHANNEL IN A SIZE IN B SPC 1 * A ON ENTRY IS ASSUMED TO BE THE SUBCHANNEL TO BE CHECKED. * ERROR EXIT IS P-1 * IF THE SUBCHANNEL IS LEGAL IT IS RETURNED IN A * AND B IS THE NUMBER OF TRACKS ON THAT CHANNEL SPC 1 TSTC5 NOP LDB COTYP CPB D2 UNIT COPY? RSS JMP TST55 NO LDB SYSTP SZB,RSS DOS DISC? JMP TST55 NO,RTE LDB D400 # OF TRACKS FOR A DOS SUBCHNL STB NTRCK LDB D409 BASE SPARE POOL ADDR FOR DOS SUBCHNL STB CSPAR JMP TSTC5,I RETURN TST55 LDB A NUMBER TO B BLS INDEX INTO THE ADB A SUBCHNL# * 3 ADB ATB32 MAP TABLE ADDRESS ADB D2 STEP TO # TRACKS LDB B,I GET # TRACKS IN B STB NTRCK STB CSPAR JMP TSTC5,I RETURN * D409 DEC 409 SKP * * INSERT CHNL NO. IN INSTRUCTI1ON * * THE DCHCN SUBROUTINE SETS THE CURRENT DISK CHANNEL * NOS. IN THE I/O INSTRUCTIONS. * * CALLING SEQUENCE: * A = ADDRESS OF END OF INSTRUCTION ADDRESS LIST * B = ADDRESS OF INSTRUCTION ADDR LIST * JSB DCHCN * * DCHCN NOP STA TBUF ADDR OF END OF INSTRUCTION ADDR LIST STB TBUF+1 ADDR OF BEGINNING OF INSTRUCTION ADDR LIST LOOPC LDB TBUF+1 CPB TBUF COMPARE ADDR OF BEG WITH END OF INST LIST JMP DCHCN,I THEY MATCH, ALL INSTRUCTIONS CONFIGURED LDB B,I GET INSTRUCTION ADDRESS LDA B,I GET INSTURCTION AND .1777 MASK OUT THE OLD CHANNEL# IOR CHANL INSERT NEW CHANNEL# STA B,I STORE IT BACK ISZ TBUF+1 MOVE DOWN TO THE NEXT INSTR JMP LOOPC REPEAT PROCEDURE * .1777 OCT 177700 * * LST3 DEF *+1 I/OTB DEF DSKDR DEF DSK20 DEF DSK21 DEF DSK22 DEF DSK24 DEF DSK25 DEF DSK26 DEF DSK27 DEF DSK28 DEF DSK29 DEF DSK71 I/OTC DEF * * * FLGPT OCT 41400 FLGDF OCT 21400 FLGSP OCT 101400 FLGPS OCT 141400 PROTECT AND SPARE WA#KE OCT 113000 PT#SK OCT 101200 PT#AD OCT 106000 PT#T2 NOP PT#H2 NOP OCT 107404 FILE MASK R#DCM OCT 102400 P#EN OCT 101400 DSKDR ABS DC DMA CON WORD HED MH RTGEN COMMON I/O DISC DRIVER * THE DISKD SUBROUTINE IS THE MAIN DISC INPUT/OUTPUT DRIVER. * IT SETS UP THE COMPLETE TRANSFER AND READS OR WRITES * 128 WORD SECTORS ON THE DISC. IT WAITS UNTIL THE TRANSFER * IS COMPLETE. STATUS IS DONE AFTER EACH TRANSFER FOR WRITE * PROTECT ERRORS THE OPERATOR IS ASKED TO TURN ON THE SWITCH. * FOR UNDEFINED ERRORS OR ERRORS THAT SHOULD NOT HAPPEN SUCH AS * DEFECTIVE CYLINDER ERRORS THE IRRECOVERABLE ERROR ERR40 IS * TAKEN. FOR NOT READY ERRORS THE OPERATOR IS NOTIFIED. * FOR OTHER ERRORS TEN TRIES ARE MADE. IF THE ERROR STILL EXIST * AND: * * CALLING SEQUENCE * -r A = TRACK # * B = CORE ADDRESS * E = 1 FOR READ * E = 0 FOR WRITE * * RETURN - ALWAYS NORMAL--REGS. MEANINGLESS SPC 3 DISK5 NOP STA TRCK1 RBL,ERB SET THE READ/WRITE BIT STB MADDR AND SAVE THE ADDRESS LDA RTFLG IS RETURN FLAG SET? SZA JMP DISK3 YES, THEN DO NOT CHANGE ORIGINAL RETURN LOC LDA DISK5 SAVE ORIGINAL RETURN ADDRESS STA RDSK5 DISK3 CLA STA RTFLG CLEAR THE RETURN FLAG LDA ISIZE CONVERT SIZE TO -VE CMA,INA STA SIZE * DISK1 LDA TRCK1 A REG HAS TRACK # LDB DIST1 GET ADDRESS OF JSB DADTR TRANSLATE THE TRACK ADDRESS LDA UN#IT LDB #UNST SET # TO CONFIGURE COUNTER STB UNCOU LDB UNITC GET UNIT CONFIGURE ADDRESS NXUN XOR B,I AND CONFIGURE THE UNIT NUMBERS AND M17 OF COURSE THIS XOR B,I CODE WORKS STA B,I INB ISZ UNCOU DONE? JMP NXUN NO TRY AGAIN * LDA IFLAG IS THIS WRITE WITH TRACK SPARING AND SSA AND TRACK HAS DEFECTIVE BIT MARKED? ISZ IFLAG YES, THEN SET IFLAG=0 RSS NO JMP INITE,I THEN HONOR IT AND SPARE TRACK * LDA WRTCM GET THE WRITE COMMAND ADA INIT1 ADD THE INIT CODE STA W#CMD AND SET IT LDA PT#TR GET THE CYLINDER LDB SECTR SECTOR BRS ADJUST OUT THE 64 WORD JASS ADB H#AD PUT IN THE HEAD DST CYLAD SET THE SEEK ADDRESSES LDA INIT1 GET THE INIT CODE CPA FLGSP IF SPARING OR RSS DOING A DEFECTIVE TRICK CPA FLGPS RSS CPA FLGDF THEN JMP TRY05 SKIP THE SECOND ADDRESS SET UP * LDA CYLAD ELSE DST CYLA2 SET UP THE ADDRESS RECORD COMMAND LDA N10 DISK ERROR COUNT INITIALIZED TO -10 STA DERCN USED FOR CYLINDER COMPARE tERRORS TRY05 JSB $LIBR TURN OFF INTERRUPTS NOP CLF 0 * RTRY LDA N10 SET THE ERROR STA EDCNT COUNTER TO 10 TRIES OVER JSB STATW GET STATUS RBR,SLB,RBL READY? JMP NRERR NO SO LONG * SLB IF DRIVE BUSY JMP OVER WAIT FOR IT * LDB MADDR GET THE CORE ADDRESS LDA R#DCM PRESET FOR READ SSB WRITE? JMP DISK2 NO, DO STANDARD ADDRESSING LDA W#CMD YES RESET TO WRITE LDB IFLAG IF WRITING FOR 2ND TIME JUST DO ADDR REC CPB D2 JMP WPCAL YES JUST DO ADDRESS RECORD (NO SEEK) * DISK2 LDB MADDR JSB XFER STANDARD TRANSFER DEF WAITC-1 ADDRESS OF COMMAND TABLE DEF R/WCM ADDRESS OF END OF TABLE CKSTA STB STAT2 SAVE STATUS-2 WORD STA STAT1 SAVE STATUS PORTION OF STAT1 WORD LDB IFLAG COMING HERE FOR FIRST TIME WRITE WHEN CPB D1 TRACK SPARING IS NOT REQUIRED? RSS JMP CKSTB NO, CHECK FOR ERRORS LDA ATB32 IS THIS WRITE WITH TRACK SPARING? ADA N1 LDA A,I SSA,RSS JMP CKSTB NO, THEN CHECK STATUS LDB STAT2 STATUS WORD 2 LDA STAT2 SSA ERROR? JMP ST2ER YES, PROCESS IT AND .100 SZA WRITE PROTECT SWITCH ON? JMP WRPTM YES CCA YES, SET IFLAG=-1 STA IFLAG TO HAVE WR05 CHECK FOR D BIT IN STATUS JSB INT5N TURN ON INTERRUPTS JMP DISK5,I RETURN CKSTB LDA STAT1 RESTORE STATUS WORDS LDB STAT2 ADA CTABA INDEX WITH STATUS INTO JMP A,I STATUS XFER TABLE * WPCAL LDB MADDR JSB XFER WRITE PROTECT TRANSFER DEF ADRES-1 START WITH THE ADDRESS RECORD DEF R/WCM STILL END SAME PLACE JMP CKSTA GO DO STATUS CHECK * * CTABA DEF *+1 CODE ERROR DISPOSITION JMP ENDOK 00 NO ERROR - TEST FOR VERIFY JSB FAULT 01 ILLEGAL OP - PROGRAM FAULT JSB FAULT 02 UNIT AVAIL. PROGRAM FAULT JSB FAULT 03 CONTROLLER JSB FAULT 04 SHOULD JSB FAULT 05 NEVER JSB FAULT 06 SEND THESE ERRORS JMP RECAL 07 CYL COMPARE TRY TO RECAL. JMP ERRDS 10 PARITY ERROR TRY AGAIN JMP EOCYL 11 HEAD/SECTOR? RESTART ERR43 JSB FAULT 12 I/O PROGRAM (WHO? ME?) PROGRAM FAULT JSB FAULT 13 UN IMPLEMENTED CODE FAULT JMP EOCYL 14 END OF CYL. BAD # SECT/TRK ERR43,RESTART JSB FAULT 15 UN IMPLEMENTED CODE FAULT JMP ERRDS 16 OVER RUN JUST RETRY JMP ERRDS 17 CORRECTABLE ERROR DON'T EVEN TRY JMP SPARE 20 ILLEGAL SPARE JMP INERR 21 DEFECTIVE TRACK - REPORT JMP ST2ER 22 ACCESS NOT READY - STATUS 2 ERROR JMP ST2ER 23 STATUS 2 GO CHECK JSB FAULT 24 UN IMPLEMENTED FAULT JSB FAULT 25 ERROR CODEDS JMP ST2ER 26 ILLEGAL WRITE TEST ST 2 JMP UWAIT 27 WAIT FOR THE UNIT. * * ERRDS ISZ EDCNT STEP OPERATION ERROR COUNT JMP OVER OK TRY AGAIN JSB INT5N TURN ON INTERRUPTS LDA VFLAG VERIFYING? SZA JMP DISK5,I YES, RETURN JMP INITE,I GO TO SPARING ROUTINE WHETHER READ OR WRITE * * STATUS-2 ERROR POSSIBLE CONDITIONS ARE: * NO ERROR SO JUST RETRY AT ERRDS * NOT READY GO TO KNRERR TO WAKE HIM UP * PROTECTED SEND TURN ON SWITCH MESSAGE * * * ST2ER LDA MADDR INITIALIZING? (IE.WRITING?) SSA JMP ST2 NO LDA B YES, STATUS -2 TO A AND M40 KEEP /FORMAT BITS SZA,RSS SET?? JMP FRMT IF SWITCH OFF GO BITCH LDA STAT2 NO, THEN WRITE PROTECT SWITCH ON? AND .100 SZA JMP WRPTM YES, THEN ASK USER TURN IT OFF * ST2 SSB,RSS IF NOT STATUS 2 ERROR JMP ERRDS JUST COUNT IT AND TRY AGAIN LDA B GET zTHE STATUS WORD AGAIN AND D4 ISOLATE THE SEEK CHECK BIT SZA IF SET THEN WE HAVE A BAD ADDRESS JMP EOCYL SO GO RESTART THE GEN. * JMP NRERR MUST BE NOT READY * FRMT JSB INT5N TURN ON INTERRUPTS JSB WRITE DEF MES33 TURN ON FORMAT SWITCH DEF D11 LDA STAT2 PROTECT SWITCH ON? AND .100 SZA JMP WRPT2 YES ASK USER TO TURN IT OFF JMP WRPT3 NO, THEN WAIT FOR USER TO TURN FORMAT SWITCH ON * WRPTM JSB INT5N TURN ON INTERRUPTS WRPT2 JSB WRITE WRITE PROTECT SWITCH IS OFF DEF MES32 TELL THE USER TO TURN IT ON DEF D11 WRPT3 JSB PAUSE WAIT FOR TURN ON JMP TRY05 TRY AGAIN. NRERR JSB INT5N TURN ON INTERRUPTS JSB WRITE DISC IS NOT READY DEF MS4 SEND THE WORD TO THE MAN DEF D5 JSB PAUSE JMP TRY05 ON RESTART RETRY * FAULT NOP ENTRY FOR TRACE BACK ONLY JSB INT5N TURN ON INTERRUPTS JMP EXITU SHOULD NEVE GET HERE SPARE JSB INT5N TURN ON INTERRUPTS CCA RETURN WITH ALL 1'S IN A REG JMP DISK5,I HAD TRIED TO READ OR WRTIE ON SPARED TRCK * THE DRIVER ENTERS HERE AFTER 10 TRIES HAVE FAILED TO INITILIZE THE * DISC. EOCYL JSB INT5N TURN ON INTERRUPTS JSB WRITE ELSE SEND BAD SPECIFICATION DEF ERR8 UNRECOVERABLE DISC ERROR-EOC OR SEEK CHE DEF D22 JMP EXITU ABORT UTILITY * INERR JSB INT5N TURN ON INTERRUPTS * INIER CLA CLEAR IFLAG STA IFLAG LDA SYSTP TYPE OF SYSTEM OF DISC? SZA RTE DISC? JMP INIED NO, DOS INBSP JSB WRITE PRINT HEADER FOR BAD TRACK DEF ERR9 BAD TRACK AT: DEF D7 LDA TRACK RTE DISC JSB PTRK5 CONVERT BAD TRACK ADDR TO ASCII LDA MADDR CORE ADDRESS OF BUFFER SSA READ OPERATION JMP INIEU YES LDA ATB34NLH2 NO ADA N1 LDA A,I SSA TRACK SPARING WANTED? JMP INIET YES INIEU JSB QUERY NO, ENCOUNTERED BAD TRACK ON A READ OPER DEF MSG28 OR WRITE WITHOUT TRACK SPARING DEF D5 ASK OF USER WANTS TO CONTINUE WITH TASK DEF EXP6 REPLY YES OR NO DEF D9 LDA RBUF CHECK RESPONSE CPA YE RSS JMP EXITU USER DOES NOT WISH TASK TO CONTINUE,ABOR LDA KB+1 YES, MARK BIT 15 OF KB+1=1 ADA MSIGN STA KB+1 INDICATING DATA IS DEFECTIVE JMP DISK5,I RETURN * TRACK IS NOW REPORTED TO THE OPERATOR INIET LDA NSPTR # OF SPARE TRACKS FOR SUB# CPA UBADC OUT OF SPARES? RSS JMP INIEZ NO JSB DCASC YES DEF *+4 CONVERT SUBCHANNEL # TO ASCII DEF ERR4+16 DEF D1 # OF ASCII WORDS TO BE PUT IN BUFFER DEF SUB# SUBHANNEL # TO BE CONVERTED JSB WRITE SEND MESSAGE TO USER DEF ERR4 OUT OF SPARES FOR SUBCHNL XX DEF D17 JMP EXITU UTILITY IS ABORTED * GNINIEZ LDA AINXS SET DRIVER ABORT ADDRESS TO NEXT SPARE E STA INITE LDA CSPAR BASE ADDRESS OF SPARE TRACK POOL ADA UBADC ADD # USED SO FAR-INDICATES TRACK USED A JSB FLGDS FLAG TRACKS DEFECTIVE AND SPARED RESPECT JSB WRITE REPORT THE USED SPARE TRACK DEF SPMS SPARED TO: DEF D5 LDA SPTRK SPARE TRACK # JSB PTRK5 PRINT THE ADDR OF SPARE TRACK ISZ UBADC INCREMENT # OF USED SPARE TRACKS LDA AINIE RESET THE INIT ABORT ADDRESS FOR DRIVER STA INITE JMP RDSK5,I RETURN TO ORIGINAL LOC * * SPARED TRACK WAS BAD * NIXSP JSB WRITE BAD TRACK AT: DEF ERR9 DEF D7 LDA UBADC ADDR OF BAD TRACK ADA CSPAR JSB PTRK5 ISZ UBADC INCREMENT # SPARES USED JMP INIET SPARE THE PREVIOUS SPARE TRACK * * DOS DISC * INIED LDA MADDR SSA READ OPERATION? JMP INIEG YES LDA TRACK NO, WRITE ERA SEZ EVEN TRACK? JMP INIEC ODD TRACK DO NOT PRINT BAD TRACK MESSAGE INIEG JSB WRITE PRINT BAD TRACK HEADER DEF ERR9 DEF D7 LDA TRACK JSB PTRK5 SEND THE BAD TRACK # LDA MADDR READ OPERATION? SSA JMP INIEU ASK IF USER WANTS UTILITY TO CONTINUE INIEC LDA UBADC WRITE OPERATION CPA D10 ALL 10 SPARE TRACKS USED UP? RSS JMP INIEE NO, THEN SPARE TRACK JMP INIET YES, OUT OF SPARES * INIEE LDA ANXSD ADDRESS OF LOC TO GO TO IN A STA INITE DEFECTIVE SPARE IS FOUND LDA TRACK ODD OR EVEN TRACK#? ERA CHECK BIT 0 SEZ BIT 0 ON? JMP INODD YES, THEN TRACK IS ODD LDA UBADC NO CMA,INA BASE SPARE TRACK ADDR - # OF USED SPARES ADA CSPAR -1 = ADDR OF NEXT TRACK TO BE USED AS SPA ADA N1 JSB FLGDS FLAG TRACKS DEFECTIVE AND SPARES JSB WR4ITE DEF SPMS SPARED TO DEF D5 LDA SPTRK TO REPORT THE USED SPARE JSB PTRK5 CONVERT THE TRACK ADDRESS TO ASCII ISZ DOSDF TURN THE DOS DEFECTIVE TRACK FLAG ON LDA AINIE RESET THE INIT ABORT ADDRESS FOR DRIVER STA INITE JMP RDSK5,I RETURN TO ORIGINAL LOC * FIRST TRACK WAS EVEN, SO 2ND TRACK HAS TO BE MARKED DEFECTIVE TOO * INIEW CLA CLEAR DOS DEFECTIVE TRACK FLAG STA DOSDF LDA UBADC # OF USED SPARES CMA,INA BASE SPARE TRACK ADDR-# OF USED SPARES ADA CSPAR A REG HAS TRACK # OF SPARE TRACK TO BE U LDB ANXSD SET INIT ABORT ADDRESS FOR DRIVER STB INITE JSB FLGDS FLAG TRACKS DEFECTIVE AND SPARED LDA UBADC BUT DO NOT REPORT IT ADA D2 INCREMENT # OF USED SPARES BY 2 STA UBADC LDA AINIE RESET INIT ABORT ADDRESS STA INITE JMP RDSK5,I RETURN TO ORIGINAL LOC * FIRST TRACK WAS ODD INODD LDA UBADC # OF USED SPARE TRACKS CMA,INA CONVERT IT TO -VE # ADA CSPAR BASE ADDR OF SPARE TRACK POOL LDB ANXSD SET INIT ABORT BIT FOR DRIVER STB INITE JSB FLGDS FLAG IT DEFECTIVE AND SPARED LDA AINIE RESET INIT ABORT ADDRESS FOR DRIVER STA INITE LDA DUNIT DESTINATION UNIT # STA UN#IT SET UNIT # FOR DRIVER CLA,INA SET IFLAG SO THAT DRIVER DOES NOT PROCESS ERRORS STA IFLAG LDA TRACK TRACK # JUST FOUND DEFECTIVE ADA N1 ADD -1 TO IT STA TRACK TRACK # OF EVEN # TRACK ALREADY WRITTEN LDB AJB BUFFER ADDRESS JSB RD05 READ THE EVEN NUMBERED TRACK FROM DEST U CLA CLEAR IFLAG STA IFLAG LDA ANXSE SET INIT ABORT ADDRESS FOR DRIVER STA INITE LDA UBADC # OF USED SPARES CMA,INA ADA CSPAR A REG HAS SPARE TRACK TO BE USED ADA N1 -1 MAKES IT EVEN TRACK #r JSB FLGDS FLAG TRACKS DEFECTIVE AND SPARED JSB WRITE DEF ERR9 PRINT BAD TRACK HEADER DEF D7 LDA TRACK JSB PTRK5 JSB WRITE DEF SPMS SPARED TO: DEF D5 LDA SPTRK DIVIDE SPARE TRACK# BY 2 JSB PTRK5 PRINT LOC OF SPARE TRACK ON TTY LDA UBADC ADA D2 UPDATE # OF SPARES USED STA UBADC ISZ TRACK SET TRACK # BACK TO ORIGINAL # LDA AINIE RESET INIT ABORT ADDRESS STA INITE JSB RDSK5,I RETURN TO ORIGINAL LOC * ENTER HERE IF A SPARE IS BAD NXSPD LDA UBADC # OF USED SPARES ADA D2 INCREMENT IT BY 2 STA UBADC JMP INIEC * ENTER HERE IF A BAD SPARE IS FOUND AND IT IS EVEN # TRACK * AND ITS CORRESPONDING ODD TRACK HAS BEEN ALREADY SPARED NXSPE LDA UBADC ADA D2 STA UBADC ISZ TRACK JSB RD05 READ THE ODD SPARED TRACK DATA BACK IN A JMP INIEC AND REDO SPARING USING NEXT TWO TRACKS * AINIE DEF INIER AINXS DEF NIXSP ANXSD DEF NXSPD ANXSE DEF NXSPE M1400 OCT 1400 M440 OCT 440 SPMS ASC 5,SPARED TO: * WRTCM OCT 4000 ENDC OCT 12400 VERCM OCT 3400 CALC OCT 600 WAITX OCT 13000 M40 OCT 40 STAT1 NOP STAT2 NOP * * * UWAIT WAIT FOR UNIT TO BECOM AVAILABLE * * UWAIT LDA WAITX SEND THE WAIT UWAT1 JSB OUTCC COMMAND JSB WAITF AND WAIT JMP OVER OK NOW TRY IT * * * RECAL RECALABLRATE THE DISC ON CYLINDER COMAPRE ERRORS * RECAL ISZ DERCN INCREMENT DISC ERROR COUNT JMP RECL1 NOT 10 YET JSB INT5N ERROR ENCOUNTERED 10 TIMES JSB WRITE DEF ERR13 CYLINDER COMPARE ERROR AT: DEF D13 LDA TRCK1 JSB PTRK5 PRINT TRACK ADDRESS JMP EXITU ABORT UTILITY RECL1 LDA CALC GET COMMAND JMP UWAT1 GO SEND IT * * ENDOK AFTER A SUCCESFUL TRANSFER WE MUST DO AND END * TO ALLOW OTHER CPU'S TO] ACCESS THE CONTROLLER. * EXCEPT IF WE JUST READ A CHUNCK TO WRITE PROTECT IT. * ALSO IF DOING INITIALIZE AND NOT FLAGING DEFECTIVE DO * A VERIFY TO CHECK FOR ERRORS. * * ENDOK LDA INIT1 GET THE INIT FLAG SZA,RSS IF CLEAR JMP ENDSX JUST GO SEND THE END * RAL,SLA IF SPARING JMP SPARA GP SET UP SPARE ADDRESS * RAL,SLA IF JUST PROTECTING JMP STDAD USE STANDARD ADDRESS * RAL,SLA IF FLAGING DEFECTIVE JMP ENDSX DON'T EVEN CHECK * STDAD LDB SIZE EITHER STRAIGHT INIT. OR CMB,INB PROTECT LSR 7 SET UP THE STB VERCO SECTOR COUNT LDA VERCM SEND VERIFY COMMAND JSB XFER AND GO DEF WAITC-1 DO IT DEF VERCO SZA ANY ERROR IS JMP ERRDS BAD NEWS * * ENDSX LDA ENDC GET THE END COMMAND JSB OUTCC SEND IT JSB INT5N TURN ON INTERRUPTS JMP DISK5,I AND EXIT * * SPARA SETS ADDRESSES TO VERIFY A SPARE TRACK * SPARA DLD CYLA2 USE THE REAL DST CYLAD ADDRESS FOR SEEK JMP STDAD GO TRY THE VERIFY * * * XFER THE TRANSFER ROUTINE * DOES DMA SET UP,AND SENDS A SERIES OF WORDS TO THE DISC * CONTROLLER, THEN STATUS IS DONE USING STATW. * * CALLING SEQUENCE: * * A= COMMAND FOR THE XFER READ/WRITE INIT ETC. * B= ADDRESS WITH DIRECTION BIT SET FOR DMA * JSB XFER * DEF COMMAND LIST * DEF LAST COMMAND (ALSO DMA COMMAND) * * XFER NOP STA R/WCM SET THE READ WRITE COMMAND LDA DSKDR SET UP THE OTA 6 DMA CLC 2 OTB 2 STC 2 LDA SIZE OTA 2 LDB XFER,I GET THE HEAD OF THE LIST ISZ XFER STEP TO THE END ADDRESS NXTC INB STEP TO THE FIRST COMMAND LDA B,I GET THE WORD CPA R/WCM IF ACTION COMMAND CCE,RSS SKIP TO THE CLC RAL,CLE,SLA,ERA ELSE CLEAR THE SIGN AND IF SET DSK20 CLC DC TELL THE CONTROLLER IT IS A COMMAND DSK21 OTA DC,C SEND THE WORD CPB XFER,I IF THIS IS THE ACTION WORD STC 6,C START THE DMA DSK22 STC DC AND THE CONTROLLER SEZ IF NOT A COMMAND SKIP THE FLAG WAIT JSB WAITF WAIT FOR THE FLAG STF 6 STOP THE DMA CPB XFER,I DONE? RSS YES SKIP JMP NXTC NO GO DO THE NEXT ONE * JSB WAITF THIS WAIT IS ONLY NEEDED FOR VERIFY ISZ XFER STEP TO EXIT ADDRESS JSB STATW GET THE STATUS WORDS JMP XFER,I AND GET OUT * * XFER COMMAND TABLE * WAITC OCT 113000 SEEKC OCT 101200 MUST CONFIGURE TO UNIT CYLAD NOP CYLINDER ADDRESS HDSCT NOP HEAD AND SECTOR ADRES OCT 106000 NEEDS UNIT CYLA2 NOP CYLINDER ADDRESS FOR ADDRESS RECORD HDSC2 NOP FILMK OCT 107404 FILE MASK/SPARING ONLY R/WCM OCT 102400 READ/WRIT COMMAND VERCO NOP VERIFY COUNT * * END OF LIST * * UNIT CONFIGURE LIST * UNITC DEF *+1,I DEF WAITX DEF WA#KE DEF SEEKC DEF VERCM DEF CALC DEF ADRES DEF R/WCM DEF STACC DEF WRTCM DEF R#DCM DEF PT#SK DEF PT#AD DEF P#EN #UNST ABS UNITC-*+1 NUMBER IN THE LIST * * * DADTR ROUTINE TO TRANSLATE A TRACK ADDRESS INTO CYL,HEAD * UNIT TO BE STORED AT: * CYL AT: PT#TR * HEAD AT: H#AD ALSO RETURNED IN B. * # HEAD/CYL AT: NSRFC * * CALLING SEQUENCE: * * LDA TRACK SET TRACK ADDRESS IN A. * LDB MAPAD SET MAP ADDRESS IN B. * JSB DADTR CALL * RETURN A=UNIT#, B=HEAD * * DADTR NOP STB H#AD SAVE THE ADDRESS INB BUMP TO THE HEAD/UNIT STA DTEMP SAVE THE TRACK ADDRESS STB UNCOU SAVE UNIT 7ADDRESS LDA B,I GET AND ISOLATE ALF # HEADS PER CYL AND M17 STA PT#TR SAVE IT STA NSRFC # OF HEADS/CYLINDER CLB DIVIDE # TRACKS LDA DTEMP BY DIV PT#TR NUMBER OF HEADS/CYL ADA H#AD,I ADD BASE CYLINDER ADDRESS STA PT#TR SET THE CYLINDER ADDRESS BLF,BLF PUT HEAD ADDRESS IN IT'S PLACE ADB UNCOU,I ADD THE BASE HEAD ADDRESS LDA B PUT INTO A TO AND M74C ISOLATE STA H#AD STORE IT AS PROMISED SWP GET UNIT# FROM LOW B AND M377 ISOLATE UNIT# JMP DADTR,I RETURN B=HEAD, A=UNIT# * M377 OCT 377 DTEMP NOP * * STATW RETURNS STATUS AS FOLLOWS: * * STATB FULL STATUS 1 WORD * A ERROR CODE (MAX=27) FROM STATUS 1 * B STATUS 2 WORD * * STATW NOP LDA STACC GET STATUS COMMAND JSB OUTCC SEND IT JSB WAITF WAIT FOR FLAG DSK24 LIA DC,C GET WORD 1 JSB WAITF WAIT FOR FLAG DSK25 LIB DC,C GET WORD 2 STA STATB SAVE WORD 1 ALF,ALF ROTATE AND M37 ISOLATE CPA M37 ATTENTION? JMP STATW+1 YES TRY AGAIN * JMP STATW,I NO - RETURN * * * OUTCC OUTPUT A COMMAND WORD * OUTCC NOP DSK26 CLC DC SEND "HERE COME DE WORD" DSK27 OTA DC,C SEND DE WORD DSK28 STC DC SET UP IN CASE IT IS NEEDED JMP OUTCC,I RETURN * * * WAITF WAITS FOR A FLAG * WAITF NOP DSK29 SFS DC HERE YET JMP *-1 NO KEEP TRYING * JMP WAITF,I YES RETURN * * M37 OCT 37 STACC OCT 1400 M17 OCT 17 M74C OCT 7400 MADDR NOP MEMORY ADDRESS FOR CURRENT TRANSFER UNCOU NOP DCMND NOP DISC ADDRESS FOR CURRENT TRANSFER EDCNT NOP ERROR COUNT FOR CURRENT TRANSFER STATB NOP W#CMD NOP RDSK5 NOP MES32 ASC 11,TURN OFF DISC PROTECT MES33 ASC 11,TURN ON FWORMAT SWITCH MS4 ASC 5,READY DISC * * * * PTRK5 - PRINT LOCATION OF TRACK ON TTY * CALLING SEQUENCE: JSB PTRK5 * A REG = TRACK# * * PTRK5 NOP STA TEMP1 SAVE TRACK # LDB DIST1 FIND PHYSICAL TRACK ADDRESS JSB DADTR LDA ATB32 IF TRACK SPARING IS DESIRED TEHN ADA N1 LDA A,I SSA,RSS SBCHNL #'S ARE REAL, OTHERWISE MADE UP B JMP PTR55 TRACK SPARING NOT DESIRED LDA SYSTP DOS SYSTEM? SZA,RSS JMP PTR52 NO LDA TEMP1 YES, THEN DIVIDE TRACK # BY 2 ARS FOR DOS LOGICAL TRACK # STA TEMP1 PTR52 JSB DCASC CONVERT SUBCHANNEL # TO ASCII DEF *+4 DEF TRAD1+4 DEF D1 DEF SUB# SUBCHANNEL # JSB DCASC CONVERT LOGICAL TRACK# TO ASCII DEF *+4 DEF TRAD1+10 DEF D2 DEF TEMP1 TRACK# JSB WRITE PRINT SUBCHNL AND TRACK#'S DEF TRAD1 DEF D12 * PTR55 JSB DCASC CONVERT CYLINDER # TO ASCII DEF *+4 DEF TRAD2+2 DEF D2 DEF PT#TR CYLINDER # LDA H#AD ALF,ALF STA HEAD JSB DCASC CONVERT HEAD # TO ASCII DEF *+4 DEF TRAD2+8 DEF D1 DEF HEAD HEAD # JSB DCASC CONVERT UNIT# TO ASCII DEF *+4 DEF TRAD2+13 DEF D1 DEF UN#IT UNIT# JSB WRITE PRINT ABSOLUTE ADDRESS OF TRACK DEF TRAD2 DEF D14 JMP PTRK5,I RETURN * TRAD1 ASC 12,SBCHNL# , TRACK# TRAD2 ASC 14,CYL# , HEAD# , UNIT# * * * GETAL - GET CHAR FROM RBUF, RETURN IN A * CALLING SEQUENCE: JSB GETAL * RETURNS: CURRENT CHAR IN A REG * * GETAL NOP LDA CMFLG CMFLG=COMMA-IN FLAG SZA,RSS SKIP IF NO COMMA IN JMP BLRET RETURN BLANK LDB BUFUL GET U/L FLAG IGNOR LDA CURAL,I GET CHAR FROM LBUF SZB SKIP IF LOWER CHAR ALF,ALF ROTATE TO LOWE>R AND M377 ISOLATE LOWER CHAR CMB,SZB RESET U/L, SKIP IF UPPER CHAR ISZ CURAL INCR RBUF ADDRESS STB BUFUL SAVE U/L FLAGE CPA BLANK CHAR=BLANK? RSS JMP COMIN COMMA IN? ISZ MAXC INCREMENT MAX CHAR COUNT JMP IGNOR IGNORE BLANKS JMP BLRET RETURN WITH BLANK COMIN CPA COMMA CHAR=COMMA? ISZ CMFLG RESET FLAG TO SHOW COMMA IN (SKIPS) JMP GETAL,I RETURN WITH NON-BLANK CHAR BLRET LDA BLANK REPLACE WITH BLANK CHAR JMP GETAL,I RETURN WITH BLANK * COMMA OCT 54 BLANK OCT 40 BUFUL NOP CMFLG NOP COMMA FLAG=-1/0 = NOT IN/IN * * * GETOC - CONVERT OCT/DEC ASCII TO BINARY - CONVERTS THE NEXT CHAR * IN RBUF FROM ASCII TO THEIR BINARY (DECIMAL OR OCTAL) VALUE * CALLING SEQUENCE: JSB GETOC * A REG = MAX. NO. OF CHARS IN CONVERSION REQUEST. IF A IS * +VE, THE REQUEST IS FOR OCTAL, IF A IS -VE, THE * REQUEST IS FOR DECIMAL * RETURN: P - INVALID DIGIT OR OVERFLOW IN CONVERSION * P+1 - A = CONVERTED # * * GETOC NOP LDB N8 GET OCTAL RANGE SSA SKIP IF OCTAL REQUEST LDB N10 GET DECIMAL RANGE STB DRANG SET DIGIT RANGE SSA,RSS SKIP IF DECIMAL REQUEST CMA,INA SET REQUEST COUNT TO -VE STA MAXC SET MAX. NO OF DIGITS CCA STA DIFLG SET DATA-IN FLAG=NO DATA IN STA CMFLG SET COMMA-IN FLAG CLA STA OCTNO OCTNO=OCTAL # GETNX JSB GETAL GET CHAR FROM RBUF CPA BLANK CHAR = BLANK? (COMMA IN) JMP ENDOC YES-RETURN ADA .N60 SUBTRACT 60B FROM CHAR STA TCHAR SAVE CHAR SSA SKIP IF VALID LOWER LIMIT JMP DGERR INVALID DIGIT ADA DRANG CLE,SSA,RSS JMP DGERR ISZ DIFLG INCR DATA-IN FLAG, SKIP NOP LDA OCTNO GET PREVIOUS OCT NO  ADA A SET A = OCT NO * 2 ADA A SET A = OCTNO * 4 LDB DRANG GET DIGIT RANGE CPB N10 RENGE=DECIMAL? ADA OCTNO SET A = OCTNO * 5 ADA A SET A = OCTNO * 10/8 ADA TCHAR SET A = NEW OCTAL NO. STA OCTNO SEZ TEST FOR OVERFLOW JMP DGERR INVALID NO. ISZ MAXC SKIP IF ALL DIGITS PROCESSED JMP GETNX GET NEXT DECIMAL DIGIT ISZ GETOC INCR RETURN ADDRESS LDA OCTNO GET OCTAL EQUIVALENT DGERR JMP GETOC,I RETURN ENDOC ISZ DIFLG SKIP - NO DATA IN JMP *-4 DATA IN - NORMAL RETURN JMP GETOC,I RETURN - ERROR * TCHAR NOP MAXC NOP DIFLG NOP DATA-IN FLAG = -1/0 = NOT IN/IN DRANG NOP DIGIT RANGE OCTNO NOP OCTAL # * * * GINIT - INITIALIZE CHAR TRANSFER - ROUTINE SETS THE CURRENT * ADDRESS AND UPPER/LOWER FLAG FOR SCANNING RBUF * CALLING SEQUENCE: JSB GINIT * * GINIT NOP LDA ARBUF ALBUF = ADDR OF RBUF STA CURAL SET CURRENT RBUF ADDRESS CCB STB BUFUL BUFUL=BUFFER U/L FLAG JMP GINIT,I * .N60 OCT -60 CURAL NOP * * * DCASC - ROUTINE CONVERTS DECIMAL NUMBERS TO ASCII * CALLING SEQUENCE: JSB DCASC * DEF *+4 RETURN ADDRESS * DEF PARM1 PARM1 IS VARIABLE NAME TO CONTAIN * DEF PARM2 PARM2 IS MAX # OF WORDS IN PARM1 * DEF PARM3 PARM3 IS THE DEC# TO BE CONVERTED * * DCASC NOP CLA STA DFLAG STA CWORD LDA DCASC,I STA RETRN ISZ DCASC LDA DCASC,I STA INAM BUFFER ADDRESS ISZ DCASC LDA DCASC,I LDA A,I ADA N1 STA NWORD LENGTH OF BUFFER-1 LDA INAM BUFFER TO BE BLANKED LOOP0 LDB SPACE STB A,I BLANK OUT A WORD IN BUFFER LDB CWORD USE CWORD AS COUNTER TO POINT IN TO BUFFER bCPB NWORD ALL WORDS IN BUFFER DONE? JMP DCAS1 YES, GO ON INA ISZ CWORD INCREMENT COUNTER JMP LOOP0 DCAS1 ISZ DCASC LDA DCASC,I LDA A,I LOAD INTEGER TO BE CONVERTED LOOP CLB DIV D10 DIVIDE INTEGER BY BASE 10 STA QOTNT QOTNT IS USED TO EXTRACT REMAINING DIGITS ADB .60 B REG CONTAINS REMAINDER WHICH IS THE LATEST DIGIT * TO BE CONVERTED BY ADDING OCTAL 60 STB BYTE ASCII INTEGER SAVED LDA DFLAG CHECK TO SEE IF THIS IS A LOW ORDER BYTE SZA LOW ORDER BYTE IF IFLAG=0, ELSE HIGH ORDER BYTE JMP HIGH LDA BYTE STA CWORD STORE BYTE IN LOWER HALF OF CWORD LDA QOTNT GET READY TO EXTRACT AND CONVERT NEXT DIGIT ISZ DFLAG SET FLAG TO INDICATE WORKING ON HIGH ORDER BYTE JMP LOOP START CONVERSION AGAIN HIGH LDA BYTE BIT 0 NOT SET IF HIGH ORDER BYTE ALF,ALF STORE BYTE IN UPPER HALF OF CWORD ADA CWORD STA CWORD LDA NWORD ADA INAM REG A POINTS TO BUFFER WHERE CWORD IS PLACED LDB CWORD STB A,I LDA NWORD SZA,RSS HAS THE BUFFER BEEN FILLED? JMP RETRN,I YES,RETURN TO CALLING ROUTINE ADA N1 NO,DECREASE NWORD TO POINT TO NEXT WORD IN BUFFER STA NWORD CLA STA DFLAG CLEAR FLAG TO INDICATE WORKING ON LOW ORDER BYTE LDA QOTNT GET READY TO EXTRACT NEXT DIGIT SZA IF QOTNT=0 THEN NO MORE DIGITS LEFT TO CONVERT JMP LOOP JMP RETRN,I * RETRN NOP NWORD NOP CWORD NOP QOTNT NOP BYTE NOP INAM NOP DFLAG NOP ADWRD DEF CWORD .60 OCT 60 * * * RMOVI - REMOVES INDIRECTS FROM ADDRESSES PASSED AS PARAMETERS * CALLING SEQUENCE: JSB RMOVI * A REG = ADDR WHOSE INDIRECTS HAVE TO BE REMOVED * RETURNS: ADDRESS WITHOUT INDIRECTS IN A REG * * RMOVI NOP ROUTINE TO REMtOVE INDIRECTS FROM DEF ADDRESSES RSS MOREI LDA A,I REG A HAS INDIRECT ADDRESS RAL,CLE,SLA,ERA JMP MOREI STILL AN INDIRECT ADDRESS JMP RMOVI,I * * * ***** MESSAGES ****** * * MSG1 ASC 10,DISC BACKUP UTILITY MSG2 ASC 3,TASK? EXP2 ASC 11,REPLIES ARE: SA,RE,CO MSG3 ASC 7,TYPE OF XXXX? EXP3 ASC 9,REPLIES ARE: UN,FR MSG4 ASC 11, DISC CHANNEL#? EXP4 ASC 10,REPLY 10 TO 77 OCTAL MSG5 ASC 9,SOURCE DISC TYPE? EXP5 ASC 16,REPLIES ARE:7900,7905,7906,7920 MSG6 ASC 10,WANT TRACK SPARING? EXP6 ASC 10,REPLIES ARE: YES,NO MSG7 ASC 8,RTE OR DOS DISC? EXP7 ASC 9,REPLIES ARE: RT,DO MSG8 ASC 28,ENTER TRACK MAP INFO FOR SOURCE DISC UNIT AS SHOWN BELOW MSG9 ASC 8,FROM CYLINDER#? MSG9A ASC 7,FROM TRACK #? MSG9B ASC 7,TO CYLINDER #? MSG9C ASC 5,TO TRACK#? EXP9 ASC 7,REPLY 0 TO 410 EXP9A ASC 7,REPLY 0 TO 202 MSG10 ASC 6,# OF TRACKS? EXP10 ASC 8,REPLY 1 TO 1233 EX10A ASC 14,REPLY 1 TO (203-FROM TRACK#) EX10B ASC 7,REPLY 1 TO 200 MSG11 ASC 7,# OF SURFACES? EXP11 ASC 6,REPLY 1 TO 3 MSG12 ASC 8,STARTING HEAD#? EXP12 ASC 6,REPLY 0 TO 2 MSG13 ASC 5,PLATTER #? EXP13 ASC 19,REPLIES ARE: 0,1 (0-FIXED,1-REMOVABLE) MSG14 ASC 9,MAG TAPE CHANNEL#? MSG15 ASC 4,FILE ID? EXP15 ASC 17,ENTER 72 CHAR MAX MT FILE ID MSG16 ASC 5,MT FILE#? EXP16 ASC 6,REPLY 1 TO 8 MSG17 ASC 4,VERIFY? MSG18 ASC 14,EOT REACHED, MOUNT NEXT TAPE MSG19 ASC 7,TASK COMPLETED MSG20 ASC 15,DISC BACKUP UTILITY IS ABORTED MSG21 ASC 10,SOURCE DISC DRIVE#? EXP21 ASC 6,REPLY 0 TO 7 EX21A ASC 6,REPLY 0 TO 3 MSG22 ASC 8,VERIFY ERROR AT: MSG23 ASC 6,MT NOT READY MSG24 ASC 13,6144 WORD BUFFER DESIRED? MSG25 ASC 23,MEM SIZE TOO SMALL FOR VERIFY W/ 6144 WORD BUF MSG26 ASC 9,MOUNT CORRECT TAPE MSG27 ASC 16,RESTART UTILITY BY ENTERING 'GO' MSG28 ASC 5,CONTINUE? MSG29 ASC 7,MOUNT TAPE# 1 MSG30 ASC 25,TRACK AT FOLLOWING LOC WAS NOT SAVED SUCCESSFULLY MSG31 ASC 5,VERIFYING MSG32 ASC 14,# OF SUBCHNLS TO BE COPIED? EXP32 ASC 6,REPLY 1 TO 3 ERR0 ASt6HFBC 5,WARNING -- ERR1 ASC 7,FILE NOT FOUND ERR2 ASC 15,NO WRITE RING, WRITE ENABLE MT ERR4 ASC 17,OUT OF SPARE TRACKS FOR SUBCHNL ERR5 ASC 10,LAST TRACK TOO LARGE ERR6 ASC 16,SUBCHNLS ON SOURCE UNIT OVERLAP ERR7 ASC 15,IMPROPERLY DEFINED SUBCHNL: ERR8 ASC 22,UNRECOVERABLE DISC ERROR-EOC OR SEEK CHECK ERR9 ASC 7,BAD TRACK AT: ERR12 ASC 9,ILLEGAL SPARE AT: ERR13 ASC 13,CYLINDER COMPARE ERROR AT: END DBKUP H U 92060-18049 1631 S 1122 OFF LINE DISK BACK UP SYSTEM             H0111 ASMB,R,L,C ** SCHEDULER MODULE ** * COMPARED WITH RTE-II LISTING ON 750729 HED RTE SCHEDULER/MESSAGE PROCESSOR * NAME: XMSC * SOURCE: PROD.-SOUR. * RELOC: PROD.-RELO. * PGMR: G.A.A.,L.W.A.,E.J.W. * DATE: DATE * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM XMSC,0 760608 * SUP ******************************************************************* ***** AMD ***** JUL,73 ***** DSD ***** APR,75 ******************************************************************* * * SCHED ENTRY POINT NAMES * ENT $LIST,$CVT3,$CVT1,$ABRT,$TYPE ENT $MPT2,$INER,$MSEX ENT $STRT,$SCD3 ENT $MPT8,$WORK,$WATR * * SCHED EXTERNAL REFERENCE NAMES * EXT $ERMG EXT $SCLK EXT $ZZZZ,$PVCN EXT $NOPG,$ILST EXT $XEQ,$ALC,$RTN EXT $SYMG EXT $SABR * * UNL $TEMP$ SUPPRESS LONG COMMENTS ******* UNL $TEMP$ * ******************************************************************* * * THE SCHED MODULE OF HP2100 REAL TIME EXECUTIVE CONSISTS OF * * 1. LIST PROCESSORS * 2. LINK PROCESSORS * 3. OPERATOR INPUT MESSAGE PROCESSORS * 4. SYSTEM START UP AND OPER INPUT REQUEST ACKNOWLEDGE * 5. MEMORY PROTECT VIOLATION SCHEDULER PREPROCESSORS * 6. ABORT AND TERMINATION PROCESSORS * ******************************************************************* * LST $TEMP$ * --BUFFERS, CONSTANTS, POINTERS, ETC * $STRT EQU * SYSTEM INITIALIZATION ENTRY POINT * T4 JSB PATCH {***DEBUG * T0 JMP TEMPP -NOP- BECOMES NOP AFTER STARTUP ST2 JSB $RTN RE-INITIALIZE MEMORY T1 NOP WITH MAX T2 NOP ST3 JMP TEMP5 -NOP- BECOMES NOP AFTER STARTUP * EXT $CLCH,$ETEQ LDA EQT# ***DEBUG*** CMA,INA ***DEBUG*** STA PATCH ***DEBUG*** LDA EQTA ***DEBUG*** STA PTR ***DEBUG*** EQLOP STA PTR ***DEBUG*** JSB $ETEQ ***DEBUG*** CLA ***DEBUG*** STA EQT1,I ***DEBUG*** STA EQT15,I ***DEBUG*** LDA EQT5,I ***DEBUG*** AND C140K ***DEBUG*** STA EQT5,I ***DEBUG*** JSB $CLCH ***DEBUG*** LDA PTR ***DEBUG*** ADA D15 ***DEBUG*** ISZ PATCH ***DEBUG*** JMP EQLOP ***DEBUG*** * LDB KEYWD ***DEBUG*** STB PTR ***DEBUG*** RSLOP LDB PTR,I ***DEBUG*** SZB,RSS ***DEBUG*** JMP RSDON ***DEBUG*** ADB D20 ***DEBUG*** LDA B,I ***DEBUG*** AND CLRPA ***DEBUG*** STA B,I ***DEBUG*** LDA PTR,I ***DEBUG*** JSB $ABRT ***DEBUG*** ISZ PTR JMP RSLOP ***DEBUG*** RSDON NOP ***DEBUG*** JSB $SCLK CLA ***DEBUG*** STA FLG ***DEBUG*** STA OPATN ***DEBUG*** JMP $TYPE ***DEBUG*** * JMP $XEQ * OPATN EQU 1734B ***DEBUG*** CLRPA OCT 6400 ***DEBUG*** KEEP ONLY RM,RE,RN C140K OCT 37777 EXT $MPFT,$EMRP ***DEBUG*** PATCH NOP ***DEBUG*** CCA ***DEBUG*** ADA AVMEM ***DEBUG*** STA $EMRP ***DEBUG*** LDA RTORG ***DEBUG*** STA MPFT ***DEBUG*** STA MPFT+1 ***DEBUG*** STA MPFT+3 ***DEBUG*** STA MPFT+4 ***DEBUG*** LDA DMPFT ***DEBUG*** STA $MPFT ***DEBUG*** LDA B14 ***DEBUG*** STA SWAP ***DEBUG*** LDB KEYWD ***DEBUG*** STB PTR ***DEBUG*** CLB ***DEBUG*** IDLOP LDA PTR,I ***DEBUG*** SZA,RSS ***DEBUG*** JMP IDDON ***DEBUG*** ADA D18 ***DEBUG*** STB A,I ***DEBUG*** INA ***DEBUG*** STB A,I ***DEBUG*** INA ***DEBUG*** STB A,I ***DEBUG*** INA ***DEBUG*** STB A,I ***DEBUG*** ISZ PTR ***DEBUG*** JMP IDLOP ***DEBUG*** * IDDON STB T4 ***DEBUG*** JMP PATCH,I ***DEBUG*** * D18 DEC 18 ***DEBUG*** B14 OCT 14 ***DEBUG*** PTR OCT 0 ***DEBUG*** DMPFT DEF MPFT ***DEBUG*** MPFT OCT 0,0,0,0,0 ***DEBUG*** * TEMPP LDA AVMEM ***TEMPORARY WORKING STORAGE AREA TEMP STA T1 * DO NOT REARRANGE! TEMP1 CMA,INA * TEMP2 ADA BKORG * TEMP3 STA T2 * TEMP4 JMP ST2 * THESE TEMPS ARE USED TO INITIALIZE TEMP5 CLA *** SYSTEM AVAILABLE MEMORY. TEMP6 STA T0 * AND ALSO TMP STA ST3 * USED BY $PARS AS CONTIGUOUS BUFFER SPACE TEMPH JMP $ALC * TBUF DEF TEMP5 $WORK JSB $ZZZZ * TBUFS DEF TEMP5+7 WPRIO NOP * ASCI NOP * ASCI1 NOP * ASCI2 JMP $ERMG *** WSTAT NOP DM5 DEC -5 * D2 DEC 2 D4 DEC 4 D5 DEC 5 D6 DEC 6 D9 DEC 9 D15 DEC 15 * D1 OCT 1 D3 DEC 3 * ZERO REP 5 NOP DEF0 DEF ZERO UNL $TEMP$ HED ID-SEGMENT MAP ID-SEGMENT MAP ID-SEGMENT MAP * WORD USE * 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 0 * ! ! ! ! ! ! * 1 LIST LINKAGE * ! ! ! ! ! ! * 2-6 5 WORD TEMPORARY AREA USED FOR SPECIAL FLAGS IN QUEUES ETC. * ! ! ! ! ! !  * 7 PRIORITY * ! ! ! ! ! ! * @ 8 PRIMARY ENTRY POINT * ! ! ! ! ! ! * 9 POINT OF SUSPENSION (XSUSP) * ! ! ! ! ! ! * 10 A REGISTER AT SUSPENSION (XA) * ! ! ! ! ! ! * 11 B REGISTER AT SUSPENSION (XB) * ! ! ! ! ! ! * 12 E/O REGISTERS AT SUSPENSION (XEO) * ! ! ! ! ! ! * @ 13 NAME ( FIRST AND SECOND CHARACTERS ) * ! ! ! ! ! ! * @ 14 NAME (THIRD AND FOURTH CHARACTERS) * ! ! ! ! ! ! * @ 15 NAME (FIFTH CHARACTER)---- TM CL AM SS --- TYPE --- * ! ! ! ! ! ! * 16 NA NP W A O R D --- STATUS- * ! ! ! ! ! ! * 17 TIME LIST LINKAGE WORD * ! ! ! ! ! ! * @ 18 RESOLUTION T -------MULTIPLE----------------------- * ! ! ! ! ! ! * @ 19 LOW ORDER 16 BITS OF EXECUTE TIME LESS 24 HRS IN 10'S MS. * ! ! ! ! ! ! * @ 20 HIGH ORDER 16 BITS OF EXECUTE TIME * ! ! ! ! ! ! * 21 BA FW AT RM RE PW RN --FATHER ID-SEG. NUMBER-- * ! ! ! ! ! ! * 22 RP ---# OF PAGES---,--MPFTI-- .. ----PARTITION #---- * ! ! ! ! ! ! * @ 23 LOW MAIN ADDRESS * ! ! ! ! ! ! * @ 24 HI MAIN ADDRESS + 1 * f ! ! ! ! ! ! * @ 25 LOW BASE PAGE ADDRESS * ! ! ! ! ! ! * @ 26 HI BASE PAGE ADDRESS + 1 * ! ! ! ! ! ! * @ 27 DISC ADDRESS (LU (15),TRACK (14-7),SECTOR(6-0) * ! ! ! ! ! ! * 28 SWAP DISC ADDRESS (LU (15),TRACK (14-7),#TRACKS(6-0) * ! ! ! ! ! ! * 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 0 * * @ WORDS USED IN SHORT ID SEGMENTS SKP * WHERE THE FLAG BITS MEAN: * TM = TEMP LOAD (COPY OF ID-SEG NOT ON DISC) * CL = CORE LOCK (MAY NOT SWAP) * AM = ALL MEMORY (PROGRAM USES ALL OF ITS AREA) * SS = SHORT SEGMENT (INDICATES A 9-WORD ID-SEGMENT) * NA = NO ABORT (PASS ABORT ERRORS TO THE PROGRAM INSTEAD) * NP = NO PRAMS ALLOWED ON RESCHEDULE. * W = WAIT BIT (WAITING FOR PROG. WHOES ID-SEG ADD. IS IN WD.2) * A = ABORT ON NEXT LIST ENTRY FOR THIS PGM. * O = OPERATOR SUSPEND ON NEXT SCHEDULE ATTEMPT * R = RESOURCE SAVE (SAVE RESOURCES WHEN SETING DORMANT) * D = DORMANT BIT (SET DORMANT ON NEXT SCHEDULE ATTEMPT) * T = TIME LIST ENTRY BIT (PROG IS IN THE TIME LIST) * BA = BATCH (PROGRAM IS RUNNING UNDER BATCH) * FW = FATHER IS WAITING (HE SCHEDULE WITH WAIT) * AT = ATTENTION BIT (OPERATOR HAS REQUESTED ATTENTION) * RM = RE-ENTRENT MEMORY MUST BE MOVED BEFORE DISPATCHING PGM. * RE = RE-ENTRENT ROUTINE IN CONTROL NOW * PW = PROGRAM WAIT (SOME PROGRAM WANTS TO SCHEDULE THIS ONE ) * RN = RESOURCE NUMBER EITHER OWNED OR LOCKED BY THIS PGM. * RP = RESERVED PARTITION FOR REQUESTING PROGRAMS ONLY. * * * $LIST STATE TRANSITION TABLE: * THE FOLLOWING TABLE DETAILS THE STATE TRANSITIONS EFFECTED BY * $LIST. THE MAJOR STATES ARE 0 THRU 6 (DORMANT THRU OP-SUSP) * AN9D THE STATE MODIFIERS ARE THE ADDITIONAL BITS SET FROM TIME * TO TIME IN THE STATUS WORD. THE BITS WHICH AFFECT OR ARE * MODIFIED BY $LIST ARE (SEE ABOVE DESCRIPTION): * BIT WEIGHT POSITION * O 10 9 * W 4 12 * R 2 7 * D 1 6 * * THESE BITS ARE COMBINED TO FORM 16 SUBSTATES AS PER THE TABLE BELOW * THE ENTRYS IN EACH SQUARE OF THE TABLE DEFINE THE NEXT STATE AS * FOLLOWS: * * THE FIRST DIGIT IS THE REQUESTED MAJOR TRANSITION (FROM * THE $LIST CALL). * THE SECOND TWO NUMBERS (SEPERATED BY A ".") DEFINE THE NEXT * MAJOR STATE . SUBSTATE. THUS 62.10 INDICATES A OP-SUSPEND * REQUEST (6) CAUSES A MOVEMENT TO I/O SUSPEND (2) SUBSTATE 10 * (THE O BIT IS SET). * A "*" AS THE DESTINATION INDICATES THE CURRENT STATE/SUB- * STATE I.E. NO CHANGE. * ILLEGAL OR UNEXPECTED STATES ARE MARKED WITH "X" * * ONLY EXPECTED CALLS ARE PLOTTED. * * IN GENERAL CODE EXTERNAL TO $LIST MOVES PROGRAMS FROM SUB-STATE * TO SUB-STATE WHILE ONLY $LIST CAN MOVE A PROGRAM FROM ONE * MAJOR STATE TO ANOTHER. HED SYSTEM STATE TABLE******SYSTEM STATE TABLE*** *MAJOR STATE 0 1 2 3 4 5 6 *SUB-STATES *---------!-----!-------!-------!-------!-------!-------!------ * 0 11.0 00.0 02.1 00.0 00.0 00.0 00.0 * 22.0 11.0 11.0 11.0 11.0 11.0 * 33.0 62.10 66.0 66.0 66.0 * 44.0 * 55.0 * 66.0 *---------!-----!-------!-------!-------!-------!-------!------ * 1 D X X 02.1 X X X X * 10.0 * 62.11 *---------!-----!-------!-------!-------!-------!-------!------ * 2 R 11.0 00.2 02.3 00.2 00.2 00.2 06.3 * 66.3 *---------!-----!-------!-------!-------!-------!-------!------ * 3 RD X X 0* X X X 0* * 10.2 10.2 *---------!-----!-------!-------!-------!-------!-------!------ * 4 W 00.0 33.4 00.0 00.0 00.0 00.0 00.0 * 1* 13.4 * 66.4 *---------!-----!-------!-------!-------!-------!-------!------ * 5 WD X X X X X X X *---------!-----!-------!-------!-------!-------!-------!------ * 6 WR 0* X X 00.6 X X 06.7 * 13.4 * 66.7 *---------!-----!-------!-------!-------!-------!-------!------ * 7 WRD X X X X X X 0* * 10.6 *---------!-----!-------!-------!-------!-------!-------!------ * 10 O X X 02.11 X X X X * 16.0 * 6* *---------!-----!-------!-------!-------!-------!-------!------ * 11 OD X X 0* X X X X * 10.0 * 6* *---------!-----!-------!-------!-------!-------!-------!------ * 12 OR X X 02.13 X X X X *---------!-----!-------!-------!-------!-------!-------!------ * 13 ORD X X 0* X X X X * 16.3 * 6* *---------!-----!-------!-------!-------!-------!-------!------ * 14 OW X X X X X X X *---------!-----!-------!-------!-------!-------!-------!------ * 15 OWD X X X X X X X *---------!-----!-------!-------!-------!-------!-------!------ * 16 OWR X X X X X X X *---------!-----!-------!-------!-------!-------!-------!------ * 17 OWRD X X X NX X X X *---------!-----!-------!-------!-------!-------!-------!------ HED REAL TIME SCHEDULER---LIST PROCESSOR SECTION--- * * THE $LIST PROCESSOR SECTION OF THE HP-2100 REAL TIME * EXECUTIVE PROCESSES THE FOLLOWING LIST REQUESTS * 1. DORMANT * 2. SCHEDULE * 3. OPERATOR SUSPEND * 4. NON-OPERATOR SUSPEND * A. I/O * B. MEMORY AVAILABLE * C. DISC AVAILABLE * 5. SEGMENT LOADING * * * * CALLING SEQUENCE * * JSB $LIST * OCT (ADDRESS CODE)(FUNCTION CODE) * DEF (ADDRESS) * * IF A = 0, THEN NO MESSAGE * A NOT 0, THEN ADDR OF MESSAGE * IF ERROR, (B) CONTAINS ASCII ERR CODE * WHERE * FUNCTION CODE * 0 = DORMANT REQUEST * 1 = SCHEDULE REQUEST * 2 = I/O SUSPEND REQUEST * 3 = GENERAL WAIT LIST REQUEST * 4 = MEMORY AVAILABEL REQUEST * 5 = DISK ALLOCATION REQUEST * 6 = OPERATOR SUSPEND REQUEST * 17 = RELINK PROGRAM REQUEST * 10 THRU 16 ARE NOT ASSIGNED * * ADDRESS CODE * 1 = ID SEGMENT ADDRESS * 2 = ASCII PROGRAM NAME ADDRESS * 3 = ID SEGMENT ADDRESS IN WORK * 4 = ID SEGMENT ADDRESS IN B-REG * 5 = ID SEGMENT ADDRESS IN XEQT * * * ADDRESS * KEYWORD, ID SEGMENT, OR * PROGRAM NAME ADDRESS AS SPECIFIED BY CODE * MUST NOT BE SUPPLIED FOR * ADDRESS CODES 3 AND 4. * LST $TEMP$ SKP $LIST OCT 1 ENTRY/EXIT (INIT.#0 FYOR DISPATCHER) LDA $LIST,I WORD 1 AND D15 STA L0091 STORE AWAY REQUEST CODE XOR $LIST,I FORM ADDR CODE ALF,ALF RAL,RAL CPA D4 ADDRESS IN B-REG? JMP L0021 YES GO SET UP CPA D3 ADDRESS IN WORK? JMP L0060 YES GO SET UP LDB XEQT PRESET FOR CURRENT EXECUTING PGM. CPA D5 CURRENT PGM? JMP L0021 YES GO SET IT UP ISZ $LIST STEP TO ADDRESS WORD LDB $LIST,I GET IT TO B CPA D1 IS ADDRESS NOW IN B? JMP L0021 YES GO SET IT UP SPC 1 LDA $NOPG NO SUCH PROG ERROR MESSAGE LDB D5 NO SUCH PROG ERROR CODE JMP L0015 GO TO RETURN * * PROCESS ID SEGMENT ACCORDING TO REQUEST CODE * L0021 STB $WORK SET ADDRESS IN WORK * L0060 LDA $WORK ID SEGMENT ADDRESS ADA D6 STA WPRIO PRIORITY ADDRESS ADA D9 STA WSTAT STATUS ADDRESS LDA WSTAT,I AND D15 STA L0090 STORE CURRENT PROG STATUS LDB L0091 REQUEST CODE SZB,RSS CHECK IF DORMANT REQUEST JMP L0100 DORMANT REQUEST CPB D1 CHECK IF SCHEDULE REQUEST JMP L0200 YES CPB D6 CHECK IF OPERATOR SUSPEND REQUEST JMP L0300 YES CPB D15 CHECK IF LINKAGE UPDATE REQUEST JMP L0135 YES JMP L0400 MUST BE A SIMPLE LIST MOVE * L0075 LDA $ILST ILLEGAL STATUS MESSAGE ADDRESS LDB D3 ILLEGAL STATUS ERROR CODE JMP L0015 GO TO EXIT HED LIST PROCESSOR--DORMANT REQUEST * * DORMANT REQUEST * * THE DORMANT REQUEST IS PROCESSED AS FOLLOWS: * IF ABORT BIT SET, MAKE PROGRAM DORMANT * IF ALREADY DORMANT, RETURN * IF SCHEDULED, THEN ENTERED INTO DORMANT LIST, POINT * OF SUSPENSION CLEARED. * IF ID SEGMENT ADDRESS IS SAME AS RESIDING *  BACKGROUND DISC RESIDENT PROGRAM, THEN BKRES * FLAGS ARE CLEARED SO ANOTHER PROGRAM MAY BE * LOADED INTO THE AREA. * IF ID SEGMENT ADDRESS IS SAME AS RESIDING REAL * TIME DISC RESIDENT PROGRAM, THEN RDISK FLAGS * ARE CLEARED SO ANOTHER PROGRAM MAY BE LOADED * INTO THE AREA. * IF NOT ONE OF ABOVE, THEN DORMANT BIT SET IN STATUS SPC 1 L0100 LDB WSTAT,I CHECK IF ABORT BIT SET BLF RBL,SLB,BLF JMP L0115 YES, SO GO MAKE DORMANT CPA D2 IF I/O SUSPENDED L0103 ALF,SLA,RAL SET DORMANT BIT JMP L0350 ELSE GO CHECK RESOURCE BIT * L0105 IOR WSTAT,I MERGE THE CURRENT STATUS STA WSTAT,I RESET THE NEW STATUS JMP L0014 GO TO EXIT * L0350 EQU * NO RESOURCES IN L0115 LDB $WORK SET FLAG FOR DISPATCHER CLA CPB XEQT STA $PVCN ADB D8 LINK THROUGH XSUSP LDA $ZZZZ SO RESIDENT FLAGS STB $ZZZZ ARE STA B,I CLEARED CLA STA XEQT CLEAR CURRENT PGM FLAG IN CASE IT IS SPC 1 L0130 STA WSTAT,I SET THE NEW STATUS AND D15 GET THE ADDITION CODE L0135 LDB L0090 SET B FOR LINK JSB LINK RELINK THE PROG L0014 CLA SET FOR NORMAL RETURN L0015 ISZ $LIST STEP TO RETURN ADDRESS JMP $LIST,I LOOK MA! NO LABEL! SPC 1 * L0355 LDA WSTAT,I GET OLD STATUS AND CLD.R CLEAR "R" AND "D" (BITS 7,6) LDB $WORK IF NOT CURRENT CPB XEQT PROGRAM THEN RSS IOR B20K SET THE NO PRAMS BIT. JMP L0130 GO PUT IN THE DORM LIST SPC 2 L0090 NOP L0091 NOP B20K OCT 20000 SPC 1 HED LIST PROCESSOR--SCHEDULE REQUEST * SCHEDULE REQUEST * THE SCHEDULE REQUEST IS PROCESSED AS FOLLOWS: * IF ABORT BIT SET, STORE ID SEGMENT ADDRESS SUCH THAT * V PROGRAM WILL BE ABORTED AT NEXT ENTRY FROM XEQ * IF DORMANT BIT SET, GO TO DORMANT REQUEST * IF OPERATOR-SUSPEND BIT SET, GO TO OPERATOR-SUSPEND REQUEST * IF SCHEDULED, THEN STATUS ERROR EXIT * IF CURRENT STATUS NOT ONE OF ABOVE, THE PROGRAM IS * ENTERED INTO THE SCHEDULE LIST. * L0200 CPA D6 IF OP-SUSP JMP L0250 GO CHECK FOR DORMANT BIT LDB WSTAT,I GET WHOLE STATUS WORD CPA D2 IF I/O SUSP. THEN BLF,SLB,BLF ROTATE AND SKIP JMP L0255 ELSE GO CHECK WAIT BIT * RBR,SLB,RBL IF OP-SUSP BIT SET JMP L0220 GO CHECK FURTHER * L0270 CLA,INA SET A FOR SCHEDULE RBL DORM BIT TO 15 SSB IF DORM BIT SET JMP L0100 GO SET DORMANT JMP L0130 SCHEDULE * L0220 RBL CHECK RESOURCE BIT (EXCEPT IN M-I) SSB IF DORM BIT SET JMP L0100 GO MAKE DORMANT * L0230 LDA B1004 CLEAR THE OP-SUSP BIT AND JMP L0280 GO OP-SUSP THE PGM. * L0250 LDA WSTAT,I IF OP-SUSP BIT SET AND B100 AND DORM BIT SET SZA JMP L0355 GO CLEAR BIT AND SET DORMENT * L0255 LDA WSTAT,I IF WAIT BIT SET ALF,SLA,ALF THEN ALF,SLA,ALF GO MOVE TO WAIT LIST (SKIPS) JMP L0270 ELSE, SCHEDULE THE PROGRAM * XOR D3 CHANGE STATUS TO 3 AND D15 L0280 XOR WSTAT,I AND JMP L0130 GO RELINK HED LIST PROCESSOR--SUSPEND REQUESTS * * OPERATOR SUSPEND REQUEST * * THE OPERATOR-SUSPEND REQUEST IS PROCESSED AS FOLLOWS: * IF DORMANT OR OPERATOR SUSPENDED, STATUS ERROR! * IF SCHEDULED, ADD TO OPERATOR SUSPEND LIST * IF NOT ONE OF ABOVE, SET OPERATOR-SUSPEND BIT * L0300 LDB WSTAT,I GET THE FULL STATUS WORD SZB IF ZERO (DORMANT) CPA D6 OR OP-SUSP JMP L0075 REJECT THE REQUEST * CPA D2 IF Il/O SUSP JMP L0310 GO SET TO "O" BIT * JMP L0400 ELSE GO RELINK I.E. SET OP-SUSP. * L0310 LDA B1000 SET OPER-SUSP BIT IN STATUS JMP L0105 GO SET BIT AND EXIT SPC 1 * * NON-OPERATOR SUSPEND REQUEST * * THE NON-OPERATOR SUSPEND REQUEST IS PROCESSED AS FOLLOWS: * THE PROGRAM IS ENTERED INTO THE REQUESTED LIST AND * THE NEW STATUS REPLACES THE 4 LOW ORDER BITS OF THE * PROGRAM STATUS-THUS SAVING THE DORMANT OR OPERATOR- * SUSPEND BITS THAT MAY BE PRESENT. * * L0400 LDA WSTAT,I UPDATE STATUS SAVING ALL AND C17 BUT LOW 4 BITS IOR L0091 JMP L0130 GO TO EXIT SPC 1 C17 OCT 177760 B100 OCT 100 B1004 OCT 1004 CLD.R OCT 57460 CLEARS STATUS, R, D, NP, AND NA BITS HED LINK UPDATE PROCESSOR * * THE LINK PROCESSOR OF THE REAL TIME EXECUTIVE. * 1. REMOVES A PROGRAM FROM A LIST * 2. ENTERS THE PROGRAM INTO ANOTHER LIST AT THE PROPER PLACE * ACCORDING TO PRIORITY LEVEL. * * * * CALLING SEQUENCE * * LDB CODE1 * LDA CODE2 * JSB LINK * * WHERE * CODE1 = CODE OF REMOVAL LIST * CODE2 = CODE OF INSERTION LIST * THE ID SEGMENT IS ASSUMED TO BE LOCATED IN WORK * AND WPRIO SET * * * THE REMOVAL OF PROGRAM FROM A LIST CONSISTS OF: * 1. IF I/O LIST (CODE 2), THEN THIS IS SPECIAL CASE * AND DOES NOT REQUIRE REMOVAL. * 2. IF NULL LIST, THEN ERROR EXIT TAKEN. * 3. IF FIRST AND ONLY PROGRAM IN LIST, THEN LIST * VALUE SET TO ZERO. * 4. IF FIRST PROGRAM IN LIST, BUT NOT THE ONLY * PROGRAM IN LIST(LINKAGE NOT ZERO), THEN SET LIST * VALUE TO THE LINKAGE VALUE. * 5. IF IN MIDDLE OF LIST, THE LINKAGE OF THE ID SEG * MENT WHICH POINTS TO THENLH PROGRAM TO BE REMOVED * IS SET TO THE LINKAGE VALUE OF THE PROGRAM THAT * IS REMOVED. * 6. IF LAST PROGRAM IN LIST, THE LINKAGE VALUE OF * PREVIOUS PROGRAM IN LIST IS SET TO ZERO. * LINK NOP ENTRY/EXIT SZB IGNOR DORMANT AND CPB D2 I/O LIST REQUESTS JMP LK100 YES, SEE IF ADDITION. ADB LLIST ADD TOP OF LIST POINTER * LK010 STB TEMP TOP OF REMOVAL LIST LDB B,I GET TOP OF LIST POINTER SZB,RSS END OF LIST? JMP LK150 YES, RETURN CPB $WORK MATCHES PROGRAM? RSS YES JMP LK010 NO, KEEP SEARCHING LDB B,I UPDATE LINKAGE TO BYPASS STB TEMP,I THE DELETED ID SEG ;N HED LINK PROCESSOR--ADDING PROGRAM TO A LIST * * ADD A PROGRAM TO A LIST * * THE ADDITION OF PROGRAM TO A LIST CONSISTS OF: * 1. IF I/O LIST (CODE 2), THEN THIS IS SPECIAL CASE * AND NO ADDITION MADE TO LIST. * 2. IF NULL LIST, THEN LIST VALUE SET TO POINT TO ID * SEGMENT OF PROGRAM TO BE ADDED AND THE LINKAGE * SET TO ZERO. * 3. IF NOT NULL LIST, THE PROGRAM IS INSERTED INTO * LIST ACCORDING TO PRIORITY LEVEL AND LINKAGES * CHANGED TO REFLECT THIS INSERTION. * 4. IF OF LOWER PRIOR. THAN ANY PROGRAM IN LIST, THEN * LAST LINKAGE IS SET TO POINT TO THE PROGRAM TO * BE ADDED AND THE PROGRAM LINKAGE IS CLEARED. * LK100 SZA IGNOR DORMANT AND CPA D2 I/O LIST REQUESTS JMP LINK,I YES, RETURN ADA LLIST ADD TOP OF LIST POINTER * LK110 STA TEMP SAVE TOP OF LIST POINTER LDA A,I GET POINTER SZA,RSS END OF LIST? JMP LK140 YES, LINK IN NEW PROG CPA $WORK IS IT A DUPLIC. PROG? JMP LK150 YES, DUPLIC SO RETURN STA B NOT DUPLIC, COMPARE PRIORITY ADB D6 OF WORK ID SEG LDB B,I AGAINST CMB,INB CURRENT ADB WPRIO,I ID SEG SSB,RSS WORK < CURRENT? JMP LK110 NO, SEE NEXT ONE * LK140 STA $WORK,I LINK THIS TO FOLLOW WORK LDA $WORK LINK WORK TO FOLLOW STA TEMP,I PREVIOUS PROG * LK150 JMP LINK,I RETURN * * LLIST DEF DORMT TOP OF LIST ADDRESS B1000 OCT 1000 B4000 OCT 4000 HED OPERATOR INPUT MESSAGE PROCESSOR UNL $TEMP$ * * THE $MESS PROCESSOR SECTION OF HP-2116 REAL TIME EXECUTIVE * PROCESSES THE FOLLOWING OPERATOR INPUT REQUESTS: * 1. TURN ON A PROGRAM * ON,XXXXX * ON,XXXXX,NOW * ON,XXXXX,P1,...,P5 * t ON,XXXXX,NOW,P1,...,P5 * 2. TURN OFF A PROGRAM * OF,XXXXX,P * 3. OPERATOR SUSPEND A PROGRAM * SS,XXXXX * 4. CONTINUE A OPERATOR SUSPENDED PROGRAM * GO,XXXXX * GO,XXXXX,P1,...,P5 * 5. CURRENT STATUS OF A PROGRAM * ST,XXXXX * 6. CHANGE PROGRAM ID SEGMENT TIME PARAMETERS. * IT,XXXXX,R,MMM * IT,XXXXX,R,MMM,HR,MN * IT,XXXXX,R,MMM,HR,MN,SC * IT,XXXXX,R,MMM,HR,MN,SC,MS * 7. CHANGE PROGRAM PRIORITY * PR,XXXXX,ZZ * 8. SET REAL TIME CLOCK AND START TIME BASE GENERATOR * TM,DAY,HR,MN,SC * 9. CURRENT REAL TIME CLOCK VALUES * TI * 10. SET A EQUIPMENT DOWN * DN,NN * 11. SET A EQUIPMENT UP * UP,NN * 12. LOGICAL UNIT * LU,N1 * LU,N1,N2 * LU,N1,N2,N3 * 13. EQUIPMENT STATUS * EQ,NN * 14. SET SOURCE FILE * LS,P1,P2 * 15. SELECT LOAD-AND-GO * LG,P * 16. CHANGE DEVICE TIME-OUT PARAMETER * TO,N1 * TO,N1,N2 * 17. RELEASE PROGRAM'S TRACKS * RT,XXXXX * 19. SET BREAK FLAG * BR,XXXXX * 20. ABORT JOB REQUEST * AB * 21. RUN REQUEST * RU,XXXXX * RU,XXXXX,P1,...,P5 * 22. BUFFER LIMIT PRINT/CHANGE * BL OR BL,N1,N2 HED OPERATOR INPUT MESSAGE DECIPHER ROUTINE * * CALLING SEQUENCE * JSB $MESS * B CONTAINS NUMBER OF CHARACTERS * A IS THE BUFFER ADDRESS * * * * INPUT DECIPHER ROUTINE ROUTINE SCANS THE ASCII OPERATOR * INPUT AND STORES THE DATA INTO PARAMETERS. * THIS ROUTINE ASSUMES THE CHARACTER COUNT IN B ON ENTRY AND * DATA IN BUFFR. COMMA IS USED TO SEPARATE PARAMETERS. A PARA- * METER MAY BE UP TO 6 ASCII CHARACTERS- EXCEPT FOR OP CODE * WHICH MUST BE 2 CHARACTERS. A MAXIMUM OF 40 CHARACTERS MAY BE * INPUT. A COUNT IS KEPwT OF THE NUMBER OF PARAMETERS INPUT AND * A CHARACTER COUNT IS KEPT FOR EACH PARAMETER. THE VALUES ARE * STORED LEFT ADJUSTED IN THE BUFFERS. LST $TEMP$ * * * HED CVT3 (BINARY TO ASCII CONVERSION) * BINARY TO ASCII CONVERSION ROUTINE * CALLING SEQUENCE * SET E TO 0 IF OCTAL CONVERSION OR * E TO 1 FOR DECIMAL CONVERSION * LDA NUMBER TO BE CONVERTED * JSB $CVT3 * RETURNS ADDRESS OF ASCI IN A AND E=1. * RESULTS IN ASCI, ASCI+1, ASCI+2 * LEADING 0'S SUPPRESSED * $CVT3 NOP ENTRY/EXIT STB TEMP6 SAVE B REGISTER LDB PTTE INIT LOCATION OF BUFFER STB TMP LDB AASCI SET BUFFER=ASCII BLANK'S STB ASCI STB ASCI1 STB ASCI2 LDB DF10 ASSUME BASE TEN SEZ,CLE,RSS IF BASE EIGHT INB SET UP FOR BASE EIGHT STB BASE SET CONVERSION BASE ADDRESS DPCRL CLB START CONVERSION DIV BASE DIVIDE BY BASE BASE EQU *-1 DEFINE BASE ADDRESS ADB B20 CONVERT TO ASCII-BLANK SEZ IF HIGH DIGIT BLF,BLF ROTATE ADB TMP,I ADD CURRENT VALUE STB TMP,I STORE THE CONVERTED VALUE CCB,SEZ PREPARE FOR SUBTRACT ADB TMP IF HIGH CHAR. BACKUP SEZ,CME BUFFER POINTER STB TMP AND RESET SZA IF MORE DIGITS JMP DPCRL GO SET THE NEXT ONE * CCE SET E FOR NEXT CALL (ASSUME BASE 10) LDA PTT LOAD A WITH ASCI BUFFER ADDRESS LDB TEMP6 RESTORE B JMP $CVT3,I RETURN * B20 OCT 20 DF10 DEF D10 D10 DEC 10 D8 DEC 8 PTT DEF ASCI PTTE DEF ASCI2 AASCI OCT 20040 * * $CVT1 CALLING SEQUENCE: SAME AS $CVT3 * RETURN RESULTS LEAST TWO DIGITS IN A, REST SAME AS $CVT3 * $CVT1 NOP JSB $CVT3 GO CONVERT THE NUMBER LDA ASCI2 GET LEAST TWO DIGITS  JMP $CVT1,I RETURN HED OUTPUT *_ ON SYSTEM TELETYPE ******************************************************************* $TYPE JMP $XEQ IGNOR SYSTEM TTY FLAG HED $ABRT ROUTINE TO ABORT A PROGRAM * ROUTINE: < $ABRT > * * PURPOSE: THIS ROUTINE PROVIDES FOR REMOVING * A USER PROGRAM FROM EXECUTION USUALLY * AFTER AN ERROR CONDITION IS DETECTED * WHICH PROHIBITS CONTINUED EXECUTION. * THE PROGRAM IS SET TO THE DORMANT * STATE, TIME INTERVAL REMOVED AND ANY * DISC TRACKS ASSIGNED TO THE PROGRAM * RELEASED. * * THE PROGRAM NAME IS SET IN THE MESSAGE * "XXXXX ABORTED" WHICH IS PRINTED * ON THE SYSTEM TELETYPE. * * CALL: (A) = ID SEGMENT ADDRESS * (P) JSB ABORT * (P+1) -RETURN- (REGISTERS MEANINGLESS) * $ABRT NOP SET ID SEGMENT ADDRESS STA TEMPH FOR $SABR CALL ADA D15 INDEX TO THE STATUS WORD LDB A,I GET THE WORD ADB B4000 SET THE ABORT BIT STB A,I RESET THE STATUS WORD LDB TEMPH SET B AND CALL JSB $SABR THE SOFT ABORT ROUTINE LDB TEMPH SET (B) = ADDRESS OF 3-WORD ADB D12 PROGRAM NAME IN ID SEGMENT. LDA B,I SET STA ABM PROGRAM INB NAME LDA B,I IN STA ABM+1 MESSAGE INB LDA B,I AND MASKU MASK OUT THE LOWER CHARACTER IOR LASCI REPLACE WITH A BLANK STA ABM+2 LDA ABMA PRINT MESSAGE: JSB $SYMG "XXXXX ABORTED" JMP $ABRT,I -EXIT- * ABMA DEF *+1 DM13 DEC -13 ABM ASC 7,EDIT ABORTED SPC 1 HED MEMORY PROTECT VIOLATION SCHEDULER PREPROCESSORS D20 DEC 20 D12 DEC 12 MASKU OCT 177400 LASCI OCT 40 * $WATR NOP LDA B ADB D20 LDB B,I BLF,BLF RBR,SLB JSB $SCD3 SCHEDULE IF ANY WAITING JMP $WAT4R,I RETURN SPC 2 * * PROGRAM SUSPEND REQUEST * $MPT2 EQU * JSB $LIST OCT 506 OPERATOR SUSPEND REQUEST * $MPT8 EQU * MEM15 LDA RQRTN STA XSUSP,I SET RETURN POINT JMP $XEQ * SPC 3 * * * $SCD3 SCHEDULES PROGRAMS IN THE WAIT LIST (STATUS-3) * WHICH ARE WAITING FOR THE GIVEN RESOURCE. * * CALLING SEQUENCE: * * LDA RESOURCE FLAG (CONTENTS OF XTEMP OF WAITER) * JSB $SCD3 * RETURN - B,E = 0 A = ? * $SCD3 NOP STA TEMPR SAVE THE RESOURCE ID FLAG LDB SUSP2 GET THE LIST HEAD SCD31 CLE,SZB,RSS IF END OF LIST JMP $SCD3,I RETURN * LDA B GET THIS ENTRIES INA FLAG FROM LDA A,I HIS ID-SEGMENT CPA TEMPR THIS ONE?? JMP SCD32 YES GO RESCHEDULE * LDB B,I NO GET NEXT ENTRY TO B JMP SCD31 AND GO TEST IT. * SCD32 LDA B,I GET THE NEXT ID IN LIST STA TEMPQ AND SAVE IT JSB $LIST SCHEDULE THE PROGRAM OCT 401 WHOSE ID-SEGMENT ADDRESS IS IN B LDB TEMPQ GET NEXT ID TO B JMP SCD31 SCAN THE REST OF THE LIST * TEMPR NOP TEMPQ NOP * $INER HLT 13B * $MSEX HLT 23B DUMMY ENTRY POINTS * HED ** SYSTEM BASE PAGE COMMUNICATION AREA ** * * *** SYSTEM BASE PAGE COMMUNICATION AREA *** * . EQU 1650B ESTABLISH ORIGIN OF AREA * * SYSTEM TABLE DEFINITION * * EQTA EQU .+0 FWA OF EQUIPMENT TABLE EQT# EQU .+1 # OF EQT ENTRIES * KEYWD EQU .+7 FWA OF KEYWORD BLOCK * * I/O MODULE/DRIVER COMMUNICATION * EQT1 EQU .+8 ADDRESSES EQT5 EQU 1665B EQT15 EQU .+84 * * SYSTEM REQUEST PROCESSOR /'EXEC' COMMUNICATION * * RQRTN EQU .+23 RETURN POINT ADDRESS * * DEFINITION OF SYSTEM LISTS (QUEUES) * * DORMT EQU .+32 ADDRESS OF 'DORMANT' LIST, SUSP2 EQU .+35 'WAIT' LIST, * * DEFINITION OF EXECUTING PROGRAM ID SEGMENT' * * a$"XEQT EQU .+39 ID SEGMENT ADDR. OF CURRENT PROG. XSUSP EQU .+48 'POINT OF SUSPENSION' * * SYSTEM MODULE COMMUNICATION FLAGS * * FLG EQU .+53 OPERATOR COMMUNICATION FLAG SWAP EQU .+54 RT DISC RESIDENT SWAPPING FLAG * * DEFINITION OF MEMORY ALLOCATION BASES * * RTORG EQU .+62 FWA OF REAL-TIME AREA AVMEM EQU .+65 FWA OF SYSTEM AVAILABLE MEMORY BKORG EQU 1752B * A EQU 0B LOCATION OF A REGISTER B EQU 1B LOCATION OF B REGISTER * ORG * PROGRAM LENGTH * END $LIST L$ASMB,R,N,L,C ** EXECUTIVE MODULE ** * COMPARED WITH RTE-II LISTING ON 750729 HED ** REAL-TIME EXECUTIVE CENTRAL CONTROL MODULE ** * NAME: XMEX * SOURCE: PROD.-SORC. * RELOC: PROD.-RELO. * PGMR: G.A.A.,L.W.A.,E.J.W. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1975. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM XMEX 760608 * ***** AMD-DAS ***** FEB,72 ***** REV.LWH ***** ***** RTE-III EXECM 750505 *** * ENT EXEC,$ERMG,$RQST ENT $LIBR,$LIBX ENT $ERAB,$PVCN,$REIO,$RSRE,$ABRE ENT $PWR5 * EXT $CVT3,$SYMG,$LIST,$XEQ,$IRT EXT $RENT,$ABRT,$SCD3 EXT $SCLK SUP A EQU 0 B EQU 1 MIC SVR,105620B,2 MIC RSR,105621B,2 * UNL $TEMP$ ***** < EXEC > PROGRAM DESCRIPTION ***** * * THE PRIMARY FUNCTION OF THIS PROGRAM IS * TO PROVIDE GENERAL CHECKING AND EXAMINATION * OF SYSTEM SERVICE REQUESTS AND TO CALL THE * APPROPRIATE PROCESSING ROUTINE IN OTHER * SECTIONS OF THE REAL-TIME EXECUTIVE. * * THIS PROGRAM IS CALLED DIRECTLY FROM THE * CENTRAL INTERRUPT CONTROL SECTION * WHEN A MEMORY PROTECT VIOLATION IS ACKNOWLEDGED. * ALL SYSTEM REQUESTS BY A USER PROGRAM CAUSE A * PROTECT VIOLATION. * * SYSTEM REQUEST FORMAT: * ---------------------- * * THE GENERAL FORMAT OF A SYSTEM REQUEST IS * A BLOCK CONTAINING AN EXECUTABLE INSTRUCTION * TO GAIN ENTRY TO THE EXECUTIVE AND AN ADDRESS * LIST OF PARAMETERS. THE FIRST PARAMETER IS * A NUMERIC CODE IDENTIFYING THE REQUEST TYPE. * THE LENGTH OF THE PARAMETER LIST VARIES * ACCORDING TO THE AMOUNT OF INFORMATION RE- O * QUIRED FOR EACH REQUEST (OR VARIATIONS WITHIN * A SINGLE REQUEST). THIS FORMAT ALLOWS SYSTEM * REQUESTS TO BE SPECIFIED IN A FORTRAN CALL * STATEMENT IN ADDITION TO ASSEMBLY LANGUAGE FORMAT. * * CALL EXEC (P1,P2,...PN) * * OR * * EXT EXEC * JSB EXEC (CAUSES MEMORY PROTECT VIOLATION) * DEF *+1+N DEFINE EXIT POINT, N= # PARAMETERS * DEF RCODE DEFINE REQUEST CODE * DEF P1 DEFINE PARAMETER LIST, 1 TO N * . * . (PARAMETERS MAY BE INDIRECTLY * . REFERENCED, E.G. DEF P3,I) * DEF PN * - EXIT POINT - * * RCODE DEC N * P1 DEC/OCT/DEF,ETC TO DEFINE A VLAUE * * * RE-ENTRANT LIBRARY REQUEST * -------------------------- * * THE SYSTEM LIBRARY (RESIDENT) CONTAINS * PROGRAMS STRUCTURED IN 'RE-ENTRANT' FORMAT * OR IN 'PRIVILEGED' EXECUTION FORMAT. * * - RE-ENTRANT FORMAT ALLOWS A LIBRARY * PROGRAM TO BE RE-ENTERED BY A CALL FROM * A HIGHER-PRIORITY PROGRAM DURING THE * PROCESSING OF A CALL FROM A LOWER-PRIORITY * PROGRAM. * * - PRIVILEGED EXECUTION FORMAT ALLOWS A * SHORT-RUNNING LIBRARY PROGRAM TO BE EXECUTED * WITH THE INTERRUPT SYSTEM DISABLED. * * * * MEMORY PROTECT ERROR: * --------------------- * * IF THE INSTRUCTION CAUSING THE PROTECT VIOLATION * IS NOT A JSB EXEC OR A JSB TO LIBRARY * PROGRAM, THEN A USER PROGRAM ERROR IS * ASSUMED. A DIAGNOSTIC IS OUTPUT TO THE SYSTEM * TELETYPE LISTING THE PROGRAM NAME AND ADDRESS * OF VIOLATING INSTRUCTION AND THE PROGRAM IS * SET DORMANT IN THE PROGRAM ABORT PROCEDURE. * LST $TEMP$ SKP ************DMS INSTRUCTIONS***************** * $RQST LIB 5 GET ADDRESS OF VIOLATION. LIA 4 DO NOT REARRANGE!!! CPA D4 POWER FAIL? LDB $PWR5 YES, USE LAST INTERRUPT ADDR. STF 5 REENABLE PARITY ERROR OPTIONN. STB XSUSP,I SET POSSIBLY DIFFERENT ADDR HLT 5 SIGNAL MP OR PARITY ERROR JMP $IRT PRESSED 'RUN' TO IGNORE IT * RQP2A DEF RQP2 VADR NOP $PWR5 NOP ADDR OF INTERRUPT BEFORE POWER FAIL DM9 DEC -9 * EXEC NOP ENTRY-EXIT CLF 0 DISABLE INTERRUPT SYSTEM CLA JSB PRVIO ALLOW PRIV-I/O, NO SAVE REGS. LDB EXEC SAVE RETURN STB $LIBR ADDRESS ADB DM1 SAVE CALL ADDRESS STB XSUSP,I AS POINT OF SUSPENSION * * * ANALYZE SYSTEM REQUEST * R0 LDA $LIBR,I (A) = RETURN ADDRESS OF JSB EXEC. ISZ $LIBR SET $LIBR TO FIRST PRAM. (RQ) ADDRESS. STA RQRTN SAVE IN BASE PAGE LDB $LIBR CACULATE THE NUMBER OF CMB,CLE PARAMETERS IN REQUEST ADB A LESS THE REQUEST CODE. STB RQCNT AND SAVE # OF ACTUAL PARAMETERS. STB A STB CNT CMB,SEZ,CME SKIP IF RETURN IS BAD (< JSB +2) * ADA DM9 CLA,SEZ JMP RQERR ERROR IF >8. * STA RQP2 ZERO STA RQP3 PARAMETER STA RQP4 STA RQP5 ADDRESS STA RQP6 STA RQP7 AREA STA RQP8 STA RQP9 * * * CHECK LEGALITY OF REQUEST CODE * LDA $LIBR GET ADDR OF THE REQ PARAM LDA A,I RAL,CLE,SLA,ERA REMOVE INDIRECTS JMP *-2 LDA A,I GET ACTUAL REQ CODE LDB XEQT COMPUTE ADB D15 THE STATUS WORD STB TEMP3 ADDRESS AND SAVE LDB B,I GET STATUS RAL,CLE,ERA PUT ABORT OPTION BIT RBL,ERB IN SIGN OF STATUS STB TEMP3,I AND RESET IN ID-SEG. SSB IF OPTION SELECTED ISZ RQRTN STEP RETURN ADDRESS. STA RQP1 SAVE THE REQUEST CODE. SZA IF ZERO SKIP TO REJECT ADA CODE# IF RQUEST CODE IF NOT DEFINED SSA,RSS -THEN JMP RQERR TOUGH LUCK, aYOU'RE A DEAD DUCK! * ADA RQTBL GET ADDRESS OF PROCESSOR TO A LDA A,I GET ADDRESS SZA,RSS IF NOT LOADED JMP RQERR THEN REQUEST CODE ERROR * STA VADR SAVE THE ADDRESS * * TEST EACH PRAMETER FOR BEING BELOW THE FENCE IF * THE CALL CAUSES A STORE TO THE AREA DEFINED. * LDB RQP1 USE REQUEST CODE CLE,ERB TO INDEX INTO ADB RQTBL THE BY NAME TABLE LDA B,I GET THE FLAG WORD STA FLAGS * ISZ $LIBR LDA $LIBR GET ADDR OF 2ND PARAM LDB RQP2A GET ADDR OF 2ND BP PARAM MIC1 JMP NOMC2 -LRR- IF HAVE MICROCODE * OCT 105622 MACRO CALL FOR LRR CNT OCT 0 COUNT OF PARAMS LEFT FLAGS OCT 0 BITS FOR PARAM ADDR CHECK DEF FENCE ADDR OF FENCE WORD RSS ERROR RETURN JMP VADR,I SUCCESSFUL RETURN * SZB,RSS JMP $ERAB JMP RQERR * NOMC2 STB TEMP2 SAVE BP PTR LDA CNT CMA,INA,SZA,RSS NEGATE COUNT JMP VADR,I DO REQ. IF 0 PARAMS STA CNT * R3 LDA $LIBR GET ADDR OF PARAM ADDR R1D1 LDA A,I GET ACTUAL PARAM ADDR SZA CPA D1 IS IT POINTING TO A OR B REGS? JMP RQERR YES, ERROR. RAL,CLE,SLA,ERA INDIRECT? JMP R1D1 GO GET DIRECT ADDR * STA TEMP2,I SAVE DIRECT ADDR ON BP CMA,CLE READY TO SUBTR FROM FENCE LDB FLAGS SLB,RBR NEED TO TEST AGAINST MP FENCE? ADA FENCE YES, SUBTRACT STB FLAGS SAVE SHIFTED FLAG BITS CLB,SEZ PARAM ADDR < FENCE? JMP ER1 YES, RQ00 ERROR * ISZ $LIBR INCRE TO NEXT USER PARAM ISZ TEMP2 INCRE TO NEXT BP LOC ISZ CNT DONE YET? JMP R3 NO JMP VADR,I YES, DO THE REQUEST * ER1 LDA RQ1 SET A FOR ERROR JMP $ERAB GO SEND 'RQ00' ERROR SPC 1 D1 DEC 1 D2 DEC 2 %D15 DEC 15 DM1 DEC -1 CODE# ABS TBL-TBLE-1 NEGATIVE OF NUMBER OF REQUEST+1 RQTBL DEF TBLE ADDRESS INDIRECT OF LAST + 1. HED ** SUPERVISORY CONTROL OF LIBRARY PROGRAM EXECUTION ** UNL $TEMP$ * * SUPERVISORY CONTROL OF PROGRAM LIBRARY EXECUTION * * ALL LIBRARY PROGRAMS REFERENCED BY USER PROGRAMS * IN THE SYSTEM ARE COMBINED IN A BLOCK OF MEMORY * WHICH IS PROTECTED FROM THE REAL-TIME AREA. THE * LIBRARY AREA IS IMMEDIATELY BELOW THE RT AREA * AND JUST ABOVE THE SYSTEM AREA. * * A USER LIBRARY CALL CAUSES A PROTECT VIOLATION. * THIS SECTION FACILITATES ENTRY INTO THE LIBRARY * PROGRAM BY PERFORMING THE NECESSARY PROCESSING * FOR RE-ENTRANCY OR OPERATING THE PROGRAM WITH H= * THE INTERRUPT SYSTEM TURNED OFF FOR A 'PRIVILEGED' * EXECUTION PROGRAM. * * RE-ENTRANT OR PRIVILEGED PROGRAM FORMAT: * ---------------------------------------- * * ENTRY NOP * JSB $LIBR * DEF TDB (OR 'NOP' IF PRIVILEGED) * - FIRST INSTRUCTION FOR FUNCTION - * - CODE * - TO * - PERFORM * - PROGRAM FUNCTION * EXIT JSB $LIBX * DEF TDB (OR DEF ENTRY IF PRIVILEGED) * DEC N RETURN ADJUSTMENT FOR RE-ENTRANT * - * TDB NOP HOLDS SYSTEM POINTER TO ID-EXTENSION. * DEC N LENGTH OF TEMPORARY DATA BLOCK * NOP RETURN ADDRESS OF CALL. * - BLOCK USED FOR * HOLDING TEMPORARY * VALUES GENERATED * BY THE ROUTINE. * * * < $LIBR> IS ENTERED WHEN A LIBRARY * PROGRAM IS CALLED. IF THE CALLED * PROGRAM IS 'RE-ENTRANT' AND IS CALLED * DURING THE PROCESSING OF A PREVIOUS * CALL, THE TEMPORARY-DATA-BLOCK IS * MOVED INTO A BLOCK IN AVAILABLE MEMORY * BEFORE THE ROUTINE IS ENTERED. * * LST $TEMP$ * * *CALLING SEQUENCES: ENTRY TERMINATION * *PRIVILEGED: JSB $LIBR JSB $LIBX *  NOP DEF (PROGRAM ENTRY PT) * *RE-ENTRANT: JSB $LIBR JSB $LIBX * DEF TDB DEF TDB * DEC 0 OR 1 * * BASIC ASSUMPTION: PRIVILEGED ROUTINES MAY NOT CALL * RE-ENTRANT ROUTINES * * $LIBR NOP CLF 0 TURN OF INTERRUPTS STA XA,I SAVE A-REG LDA $LIBR,I GET TYPE OF $LIBR CALL IN (A) JSB PRVIO LET PRIV-I/O CONTINUE CCA ADA $LIBR SET POINT OF SUSPENSION STA XSUSP,I AT THE CALL LDA $LIBR,I ALL REGS SAVED FOR $LIBR RENT ISZ $LIBR STEP TO RETURN ADDR SZA WHAT KIND OF $LIBR CALL? JMP LRRNT RE-ENTRANT, TDB ADDR IN A * LDA XA,I PRIVILEGED CALL ISZ $PVCN BUMP DEPTH COUNTER JMP $LIBR,I ENTER PRIVILEGED SUBROUTINE * LRRNT STA TEMP1 SAVE TDB ADDR LDA $PVCN SZA TRY TO GO RE-ENTRANT WHILE PRIVILEGED? JMP ERE01 YES, ABORT PROG * LDB TEMP1,I GET TDB WORD 1 SZB,RSS WAS SUBR ALREADY ENTERED? JMP LRENT NO, ENTER NOW * LDA B,I GET TDB OWNER'S ID SEG WORD 21 AND B2000 SZA IS IT STILL IN RE-ENTRANT CODE? JMP LRWAT YES, WAIT TILL IT'S DONE * LRENT LDB XEQT ADB D20 STB TEMP1,I SET TDB OWNER'S ID ADDR WORD 21 LDA B,I IOR B2000 SET REENTRANT BIT (BIT 10) STA B,I IN OWNER'S ID STATUS WORD LDB TEMP1 ADB D2 (B) = ADDR OF TDB WORD 3 LDA $LIBR ADA N3 LDA A,I (A) = RETURN ADDR FROM SUBR STA B,I SAVE RETURN ADDR IN TDB LDA $LIBR CHANGE POINT OF SUSPENSION STA XSUSP,I TO EXECUTE SUBR JMP $RENT * LRWAT LDA TEMP1,I FOR NEW-COMERS TO WAIT FOR STA XTEMP,I CURRENT TDB OCCUPANT TO FINISH JSB $LIST SUSPENSION IN THE GENERAL WAIT LIST OCTDz 503 JMP $XEQ * * * $LIBX NOP CLF 0 TURN OFF INTERRUPTS STA XA,I SAVE A-REG LDA $PVCN SZA,RSS EXIT FROM PRIV-SUB MODE? JMP LXRNT NO, EXIT REENTRANT MODE. * CLA EXIT PRIV-SUB JSB PRVIO LET PRIV I/O GO LDA $PVCN SUBTRACT ONE FROM COUNT CMA,INA WITH OUT AFFECTING CMA,SZA,RSS "E" ($PVCN >0 ) JMP LXPRX IF NOT STILL PRIV. JMP * STA $PVCN STILL PRIV. SET THE COUNTER BACK LDA $LIBX,I TRACK DOWN THE RETURN LDA A,I ADDRESS STA $LIBX AND SET IT LDA XA,I RESTORE A AND JMP $LIBX,I RETURN TO LIBRARY AREA * LXPRX STA $PVCN RETURN NON PRIV. SET COUNTER LDA $LIBX,I GET THE LDA A,I RETURN ADDRESS STA XSUSP,I AND SAVE IT LDA XA,I JSB SAVER SAVE REGISTERS JMP $RENT RETURN TO USER * * * RE-ENTRANT PROGRAM RETURNING TO USER CALL. * LXRNT CLA,INA (A)#0 FOR SAVE REGS JSB PRVIO AND LET PRIV-I/O CONTINUE. LDB $LIBX,I SET -TDB- ADDRESS. STB TEMP1 IN TEMP1. ISZ $LIBX SET TO (P+2) OF CALL TO -$LIBX-. ADB D2 GET LDA B,I RETURN POINT ADJUSTMENT. ADA $LIBX,I ADD TO (P+1) OF LIBRARY CALL STA XSUSP,I AND SET FOR RETURN TO USER. * LDB TEMP1,I GET OWNER'S ID WORD 21 ADDR LDA B,I XOR B2000 CLEAR REENTRANT BIT OF STA B,I OWNER'S ID STATUS WORD * CLA STA TEMP1,I CLEAR CURRENT TDB OCCUPANT WORD LDA B JSB $SCD3 RESCHEDULE WAITERS LXRNX JMP $RENT RETURN VIA DISPATCHER * * $PVCN NOP TEMP1 NOP TEMP2 NOP TEMP3 NOP N3 DEC -3 D20 DEC 20 B2000 OCT 2000 * * * SUBROUTINES: AND USED FOR * SAVING AND RESTORING REGISTERS * IN LIBRARY PROGRAM PROCESSING. * SAVER NOP MIC3 JMP MIC4 OR STA XA,I IF NO ۵MICRO STB XB,I ERA,ALS SOC INA STA XEO,I MX3 JMP SAVER,I RETURN IF NOT MX, CXA IF MX DST XI,I JMP SAVER,I * MIC4 SVR XA,I XI,I SAVE REGS MICRO CALL JMP SAVER,I RETURN * RSTR NOP MIC5 JMP MIC6 OR LDA XEO,I IF NO MICRO CLO SLA,ELA STF 1 MX4 JMP NMX4 IF NOT MX, DLD IF MX DEF XI,I CAX CBY NMX4 LDA XA,I LDB XB,I JMP RSTR,I RETURN * MIC6 RSR XA,I XI,I RESTORE REGS MICRO CALL JMP RSTR,I RETURN * * PRVIO CALLING SEQUENCE * CLF 0 TURN OFF INTERRUPTS * STA XA,I SAVE A-REG * LDA OPT =0 NO SAVE REGS, #0 SAVE ALL REGS * JSB PRVIO CALL PRVIO * (A) AND (B) MEANINGLESS ON RETURN * PRVIO NOP ENABLE PRIV-I O AND SZA,RSS SAVE REGS IF (A)#0 JMP SW1 JUST TURN OFF INTERRUPTS * LDA XA,I SAVE ALL REGS JSB SAVER * SW1 JMP PRVIO,I OR STC DUMMY CLC 6 CLC 7 STF 0 REENABLE INTS FOR PRIV-I/O CARDS JMP PRVIO,I RETURN * * $REIO NOP DUMMY $REIO ROUTINE FOR RTIOC CALL JMP $REIO,I * $RSRE NOP DUMMY $RSRE ROUTINE FOR DISPA CALL JMP $RSRE,I * $ABRE NOP CLEAN UP RE-ENTRANT STUFF WHEN ADB D20 A PROGRAM IS ABORTED LDA B,I GET WORD 21 OF ID SEG AND B2000 SZA,RSS WAS PROG IN RE-ENTRANT CODE? JMP $ABRE,I NO, RETURN * LDA B YES, RESCHEDULE WAITERS FOR TDB JSB $SCD3 IF THERE ARE ANY JMP $ABRE,I RETURN * HED * EXEC - ERROR MESSAGE SECTION * * * ERROR SECTION * * THE FOLLOWING DIAGNOSTICS ARE OUTPUT ON THE * SYSTEM TELETYPEWRITER ON DETECTION OF: * * 1) REQUEST CODE UNDEFINED OR ILLEGAL * NUMBER OF PARAMETERS * * RQ -PNAME- -PADDR- * * THE ROUTINE -$ERMG- IS USED TO FORMAT * THE DIAGNOSTIC ANDM CALL FOR ITS OUTPUT. * * ERE01 LDA RE (A) = 'RE' RSS RQERR LDA RQ1 (A) 'RQ' LDB BLANK (B) = BLANKS JSB $ERMG JMP $XEQ * AS00 ASC 1,00 RQ1 ASC 1,RQ RE ASC 1,RE * $ERAB ADB AS00 ADD ASC "00" JSB $ERMG PRINT ERROR DIAG.,ABORT PROG JMP $XEQ -EXIT- SPC 3 * SUBROUTINE: <$ERMG> * * PURPOSE: THIS ROUTINE FORMATS A DIAGNOSTIC * MESSAGE WHICH CONTAINS A FOUR * CHARACTER MNEMONIC DESCRIBING THE * ERROR WITH THE PROGRAM NAME AND * LOCATION OF THE ERROR. IT THEN * CALLS THE ROUTINE <$SYMG> TO * OUTPUT THE MESSAGE. * * CALL: (A),(B) CONTAIN A 4 ASCII CHARACTER * MNEMONIC OR CODE DESCRIBING THE ERROR * * (P) JSB $ERMG * (P+1) - RETURN - (REGISTERS MEANINGLESS) SPC 2 * $ERMG JMP $I.EX DO INIT STUFF * STA MSG+1 SET ERROR MNEMONIC IN STB MSG+2 FIRST 4 CHARACTERS OF MESSAGE. * LDB XEQT SET (B) = ADDRESS OF POINT OF ADB D8 SUSPENTION IN ID-SEG. STB PRVIO AND SAVE FOR ABORT OPTION ADB D4 SET (B) = ADDRESS OF 3-WORD NAME LDA B,I AND SET STA MSG+4 PROGRAM INB NAME LDA B,I IN STA MSG+5 MESSAGE. CLE,INB (E=0 FOR ASCII CONVERSION) LDA B,I AND C377 IOR B40 STA MSG+6 INB GET THE STATUS LDA B,I WORD AND IF RAL,CLE,SLA,ERA ABORT OPTIN IN EFFECT JMP NOABT GO SET IT UP. * ERM LDA XSUSP,I GET LOCATION OF ERROR JSB $CVT3 CONVERT TO OCTAL/ASCII FORMAT LDB A,I MAKE STB MSG+7 5-DIGIT MEMORY ADDRESS. INA SET DLD A,I GET THE OTHER TWO WORDS DST MSG+8 AND SET IN THE MESSAGE * LDA MSGA CALL TO JSB $SYMG OUTPUT DIAGNOSTIC. * LDA XEQT NOW GO NJSB $ABRT ABORT THE PROGRAM * JMP $ERMG,I D4 DEC 4 D8 DEC 8 C377 OCT 177400 * NOABT ADB DM6 SET A,B ADDRESS STB DSTAD SET DOUBLE STORE ADDRESS DLD MSG+1 GET THE ERROR CODE DST DSTAD,I SET A,B TO THE ERROR CODE DSTAD EQU *-1 DOUBLE STORE ADDRESS * CCA,CLE USE THE RETURN ADDR - 1 FOR CPB BLANK (BUT IF "MP","RQ", OR "RE" JMP ERM ABORT ANYWAY) ADA RQRTN STA PRVIO,I THE RETURN ADDRESS TO THE PGM. JSB $LIST OCT 501 JMP $ERMG,I RETURN * DM6 DEC -6 B40 OCT 40 * MSGA DEF *+1 MSG DEC -18 ASC 2, BLANK ASC 7, SPC 2 EXT $MIC $I.EX EQU * SYSTEM INITIALIZATION CODE LDA DUMMY GET DUMMY CARD ADDR SZA,RSS JMP NOPRV NO PRIVILEGED I/O IOR CLC STA SW1 SET CONFIGURED CLC INSTRUCTION NOPRV EQU * LIA 6 SZA,RSS WHAT KIND OF CPU? JMP NMX NOT MX OR XE. LDA .CXA IT IS MX OR XE STA MX3 LDA .DLD STA MX4 * NMX LDA $MIC SZA,RSS IS THERE MICROCODE? JMP NMC0 =0, NO MICRO LDA .LRR #0, YES, MICRO STA MIC1 JMP $SCLK DONE NMC0 LDB SAXAI NO MICRO STB MIC3 LDB LAEOI STB MIC5 JMP $SCLK DONE * .DLD DLD 0 .CXA CXA .LRR OCT 105622 CLC CLC 0 SAXAI STA XA,I LAEOI LDA XEO,I * HED * EXEC -- REQUEST CODE TABLE * *** REQUEST CODE TABLE *** * * THIS DEFINES THE RELATION FOR SYSTEM * REQUEST CODES AND CORRESPONDING PROCESSORS. * THE TABLE CONSISTS OF ONE-WORD ENTRIES IN * NUMERIC ORDER CORRESPONDING TO THE DEFINED * SYSTEM REQUEST CODES. THE CONTENTS OF EACH * ENTRY IS THE BASE PAGE LINKAGE ADDRESS OF * THE WORD CONTAINING THE ENTRY POINT ADDRESS * * OF THE PROCESSOR. AN -EXT- MUST BE USED * WITH THE -DEF- IN DEFINING THE TABLE. * * THE WORD LABELED -CODE#- CON.TAINS THE NEGATIVE OF * ONE + THE TOTAL # OF REQUEST CODES. * EXT $IORQ TBL DEF $IORQ CODE 1 I/O READ DEF $IORQ CODE 2 I/O WRITE DEF $IORQ CODE 3 I/O CONTROL NOP CODE 4 DISC TRACK ALLOCATION NOP CODE 5 DISC TRACK RELEASE * EXT $MPT1 DEF $MPT1 CODE 6 PROGRAM COMPLETION * EXT $MPT2 DEF $MPT2 CODE 7 OPERATOR SUSPENSION NOP CODE 8 LOAD PROGRAM SEG$MNT * EXT $MPT4 DEF $MPT4 CODE 9 SCHEDULE WITH WAIT * EXT $MPT5 DEF $MPT5 CODE 10 SCHEDULE PROGRAM * EXT $MPT6 DEF $MPT6 CODE 11 REAL TIME/DATE * EXT $MPT7 DEF $MPT7 CODE 12 TIME SCHEDULE DEF $IORQ CODE 13 I/O DEVICE STATUS NOP CODE 14 NO SUCH CALL NOP CODE 15 GLOBAL TRACK ASSIGNMENT NOP CODE 16 GLOBAL TRACK RELEASE NOP CODE 17 READ CLASS I/O NOP CODE 18 WRITE CLASS I/O NOP CODE 19 CONTROL CLASS I/O NOP CODE 20 WRITE-READ CLASS I/O NOP CODE 21 GET CLASS I/O * EXT $MPT8 DEF $MPT8 CODE 22 SWAP/CORE USAGE REQUEST DEF $MPT4 CODE 23 SCHEDULE WITH WAIT/WAIT DEF $MPT5 CODE 24 SCHEDULE NO WAIT/WAIT * * * DEFINE END OF TABLE AND # ENTRIES IN TABLE. * -ADDITIONAL REQUESTS MAY BE INSERTED * AT THIS POINT. * TBLE EQU * * * THE NAMTB WHICH FOLLOWS CONTAINS A BIT FOR EACH PRAMETER * IN AN EXEC CALL WHICH SHOULD BE CALLED BY NAME...THAT IS * THE SYSTEM WILL NORMALLY STORE INTO THE LOCATION DEFINED * BY THE PRAMETER. THIS TABLE IS USED TO CHECK SUCH * PRAMETERS TO SEE IF THEY ARE ABOVE THE CURRENT * FENCE ADDRESS. * * 8 BITS ARE DEVOTED TO EACH CALL. THE LEAST BIT REFERS * TO PRAMETER NUMBER TWO AND SO ON. * THE 'L' AND 'H' NUMBERS ARE SET UP TO REFER TO EACH * PRAMETER BY NUMBER WHERE L REFERS TO THE LOW OR ODD * CALL FOR EACH WORD AND H REFERS TO THE HIGH OR EVEN CALL. * H = HIGH(EVEN CALL) * L = LOW(ODD CALL) * NAMTB ABS L3 0/1 (READ BUFFER) ABS 0 2/3 ABS H3+H4+H5 4/5 (ALLOCATE PRAMS) ABS 0 6/7 ABS 0 8/9 ABS L2+L3 10/11 (TIME VALUES) ABS L3+L4 12/13 (STAT RETURN) ABS L3+L4+L5 14/15 (GLOBAL ALLOCATE PRAMETERS) ABS L7 16/17 (CLASSWORD FOR 17,18,20) ABS H7+L4 18/19 (CLASSWORD) ABS H7+L3+L5+L6+L7 20/21 (CLASSWORD,BUFFER,AND OPT PRAMS) ABS 0 22/23 ABS L3+L4+L5 24/25 SPC 2 L2 EQU 1 L3 EQU 2 L4 EQU 4 L5 EQU 10B L6 EQU 20B L7 EQU 40B L8 EQU 100B H2 EQU 400B H3 EQU 1000B H4 EQU 2000B H5 EQU 4000B H6 EQU 10000B H7 EQU 20000B H8 EQU 40000B HED * * SYSTEM BASE PAGE COMMUNICATION AREA * * XI EQU 1647B . EQU 1650B ESTABLISH ORIGIN OF AREA * * SYSTEM TABLE DEFINITION * * * * SYSTEM REQUEST PROCESSOR /'EXEC' COMMUNICATION * * RQCNT EQU .+22 # OF REQUEST PARAMETERS -1 RQRTN EQU .+23 RETURN POINT ADDRESS RQP1 EQU .+24 ADDRESSES RQP2 EQU .+25 RQP3 EQU .+26 OF REQUEST RQP4 EQU .+27 RQP5 EQU .+28 PARAMETERS RQP6 EQU .+29 RQP7 EQU .+30 (SET FOR MAXIMUM OF RQP8 EQU .+31 9 PARAMETERS) RQP9 EQU .+32 * * DEFINITION OF EXECUTING PROGRAM ID SEGMENT' * * XEQT EQU .+39 ID SEGMENT ADDR. OF CURRENT PROG. XTEMP EQU .+41 'TEMPORARY (5-WORDS) XSUSP EQU .+48 'POINT OF SUSPENSION' XA EQU .+49 'A REGISTER' AT SUSPENSION XB EQU .+50 'B REGISTER' XEO EQU .+51 'E AND OVERFLOW * * SYSTEM MODULE COMMUNICATION FLAGS * * DUMMY EQU 1737B DUMMY CARD FOR PRIV-I/O * * UTILITY PARAMETERS * FENCE EQU .+85 MEM PROTECT FENCE ADDRESS * ORG * PROGRAM LENGTH INLH END EXEC aNASMB,R,L,C ** INPUT/OUTPUT CONTROL MODULE ** * COMPARED WITH RTE-II LISTING ON 750729 HED ** INPUT/OUTPUT CONTROL MODULE ** * DATE: 5/05/75 * NAME: XMIO * SOURCE: PROD.-SOUR. * RELOC: PROD.-RELO. * PGMR: G.A.A.,L.W.A.,E.J.W. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1975. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM XMIO 760608 * ***** AMD-DAS ***** FEB,72 ***** REV.LWH ***** * * * * ENT $CIC,$XSIO,$SYMG,$IORQ,$IOUP,$IODN ENT $ETEQ,$IRT,$XCIC,$DEVT,$EQCK ENT $UPIO,$CVEQ,$YCIC ENT $BLLO,$BLUP,$OPSY ENT $CLCH * EXT $RQST,$CLCK,$XEQ,$TYPE,$LIST,$ALC,$RTN EXT $SCD3,$ERMG EXT $CVT1,$ABRT,$INER,$ZZZZ EXT $ERAB,$CVT3,$MIC,$QCHK EXT .MVW * MIC SVR,105620B,2 SAVE REGISTERS MIC RSR,105621B,2 RESTORE REGISTERS MIC STR,105623B,1 SEQUENTIAL STORE VALUE MIC INT,105624B,1 INTERRUPT TABLE SEARCH MIC LNK,105625B,2 I/O REQUEST LINK * * ORB $BLLO DEC -100 $BLUP DEC -300 ORR $OPSY DEC -7 * * UNL $TEMP$ UNL $TEMP$ * MODULE OF THE R E A L - T I M E E X E C U T I V E * * * THIS INCLUDES THE FOLLOWING MAJOR SECTIONS: * * 1) CENTRAL INTERRUPT CONTROL * * 2) INPUT / OUTPUT CONTROL * - I/O REQUEST PROCESSING * - I/O COMPLETION PROCESSING * - GENERAL I/O ERROR PROCESSING * * 3) SYSTEM ERROR DIAGNOSTIC PRINT ROUITNE * * 4) PROCESSOR FOR OPERATOR I/O STATEMENTS * HED < CENTRAL INTERRUPT CONTROL > * *** C E N T R A L I N T E R R U P T C O N T R O L *** ¦* * THE PROCESSING OF SYSTEM INTERRUPTS IS CONTROLLED * BY DIRECTING ALL SOURCES TO THE ENTRY POINT < $CIC>. * < $CIC> IS RESPONSIBLE FOR SAVING AND RESTORING * THE CURRENT STATE OF THE MACHINE, ANALYSING THE * SOURCE OF THE INTERRUPT, AND ACTIVATING THE * APPROPRIATE PROCESSOR. THIS ROUTINE IS TABLE-DRIVEN * BY THE *INTERRUPT TABLE*. * * SPECIAL PROCESSING FOR A "PRIVILEGED" CLASS OF * INTERRUPTS IS PROVIDED BY $CIC. THIS IS DESCRIBED * FULLY IN SECTION III BELOW. BRIEFLY, A SPECIAL * I/O CARD CAN BE USED TO SEPARATE SPECIAL INTERRUPTS * FROM NORMAL SYSTEM CONTROLLED INTERRUPTS. THE * PRESENCE AND LOCATION OF THE SPECIAL CARD IS * NOTED AT SYSTEM CONFIGURATION TIME. IF IT IS * PRESENT, THE EXEC OPERATIONS ARE NOT PERFORMED * WITH THE INTERRUPT SYSTEM DISABLED BUT RATHER * WITH THE CONTROL SET ON THE SPECIAL CARD TO * HOLD OFF SYSTEM I/O INTERRUPTS. * * I. INTERRUPT TABLE (INTBL) * * A TABLE, ORDERED BY HARDWARE INTERRUPT PRIORITY, * DESIGNATES THE ASSOCIATED SOFTWARE PROCESSOR AND * THE PROCEDURE FOR INITIATING THE PROCESSOR. THIS * TABLE IS CONSTRUCTED BY *RTGEN* ON INFORMATION * SUPPLIED BY THE USER IN CONFIGURING THE SYSTEM. * THE TABLE CONSISTS OF ONE ENTRY PER INTERRUPT * SOURCE: EACH ENTRY CONTAINS ONLY ONE WORD. THE * CONTENTS OF EACH VALID ENTRY IS THE IDENTIFIER * OF THE PROCESSOR. SYSTEM PROCESSORS ARE NOTED * BY POSITIVE VALUES, USER PROCESSORS BY NEGATIVE * VALUES: * * 1. SYSTEM - THE IDENTIFIER IS THE ADDRESS OF * THE EQT ENTRY IDENTIFYING THE I/O DEVICE. * * 2. USER - THE ADDRESS OF THE PROGRAM * IDENTIFICATION SEGMENT IS IN 2-S COMPLEMENT * FORM IN THE ENTRY. * * 3. ILLEGAL - AN ENTRY CORRESPONDING TO AN * ILLEGAL INTERRUPT SOURCE CONTAINS ZERO. * * A PROCESSOR IS CALLED DIRECTLY IF IT RESPONDS * TO STANDARD SYSTEM INTERRUPT (E.G., $CLCK, * MEMORY PROTECT, I/O DEVICE CONTROLLED BY A * SYSTEM g!DRIVER) OR IS SCHEDULED IN THE NORMAL * PRIORITY ORDER IF IT RESPONDS TO A USER * CONTROLLED DEVICE OR INTERRUPT SOURCE. SKP * II. INTERRUPT PROCESSING * * INTERRUPT ACKNOWLEDGEMENT BY THE CPU CAUSES * THE INSTRUCTION IN THE WORD CORRESPONDING * TO THE I/O CHANNEL ADDRESS TO BE EXECUTED. * FOR ALL ACTIVE I/O CHANNELS ( PLUS LOCATIONS * 5-7 ) CONTROLLED BY THE SYSTEM, THE INSTRUCTION * SET IN EACH INTERRUPT LOCATION IS A JUMP * SUBROUTINE INDIRECTLY TO < $CIC>. * SKP * <$CIC> PERFORMS THE FOLLOWING: * * 1. DISABLES THE INTERRUPT SYSTEM. * * 2. SAVES ALL REGISTERS PLUS THE INTERRUPT * RETURN POINT IN THE EXECUTING * ID SEGMENT. * * 3. CLEARS THE FLAG OF THE INTERRUPT SOURCE. * * 4. SETS 'MPTFL' = 1 TO MEAN MEMORY PROTECT * IS OFF - FLAG FOR PRIVILEGED PROCESSORS. * * 5. CHECKS FOR SPECIAL INTERRUPT PROCESSING. * IF 'DUMMY' IN BASE PAGE COMMUNICATION * AREA = 0, THEN LEAVE THE INTERRUPT SYSTEM * DISABLED AND GO TO STEP 6. * * 'DUMMY' > 0 - PRIVILEGED INTERRUPTS: * -THE CONTENTS OF 'DUMMY' IS THE I/O * ADDRESS OF THE CARD; THIS IS USED TO * SET THE CONTROL FF ON THE CARD (FLAG * IS ALREADY SET) TO HOLD OFF LOWER * PRIORITY INTERRUPTS (SYSTEM INTERRUPTS) * -CLEARS THE CONTROL FLIP-FLOP OF * EACH DMA CHANNEL TO PROHIBIT POSSIBLE * INTERRUPTS FROM OCCURRING. * -ENABLE THE INTERRUPT SYSTEM. * * 6. TRANSFERS DIRECTLY TO THE INTERRUPT * PROCESSOR FOR SOURCES OF: * * 5 - MEMORY PROTECT VIOLATION * (TBG) - TIME BASE GENERATOR * * FOR OTHER SOURCES, THE INTERRUPT SOURCE * CODE IS USED TO INDEX THE INTERRUPT TABLE. * THE CONTENTS OF THE INTBL ENTRY DETERMINES * THE MANNER IN INITIATING THE PROCESSOR: * * A. +, THE CONTENTS O`F THE ENTRY IS * ASSUMED TO BE THE FWA OF AN EQT ENTRY. * THE ADDRESSES OF THE 15-WORD ENTRY * ARE SET IN AND CONTROL * TRANSFERRED DIRECTLY TO THE COMPLETION * SECTION ADDRESS (WORD 3 OF EQT ENTRY). * * B. -, THE VALUE IS SET POSITIVE AND IS * SET IN A CALL TO <$LIST> IN THE * SCHEDULING MODULE- THE CALL IS MADE IF * THE USER PROGRAM IS DORMANT- CONTROL IS * TRANSFERRED TO $XEQ. IF THE PROGRAM IS * NOT DORMANT, IT IS NOT SCHEDULED AND THE * DIAGNOSTIC "SC03 INT XXXXX" IS OUTPUT * TO THE SYSTEM TTY- XXXXX IS THE PROGRAM * NAME. CONTROL IS RETURNED TO THE INTER- * RUPTED SEQUENCE. * * C. 0, ILLEGAL OR UNDEFINED INTERRUPTS ARE * NOT PROCESSED BUT THE DIAGNOSTIC * "ILL INT XX" IS OUTPUT TO THE SYSTEM * TTY. XX IS THE INTERRUPT CODE. * * 7. I/O DRIVER RETURNS INDICATE CONTINUATION * OR COMPLETION OF THE OPERATION BY THE * DRIVER OR DEVICE: * * A. RETURN AT (P+1): COMPLETION OF THE * OPERATION. $CIC TRANS- * FERS DIRECTLY TO THE * IOC COMPLETION SECTION * AT < IOCOM >. CONTROL * IS NOT RETURNED TO * < $CIC>. * * B. RETURN AT (P+2): CONTINUATION OF THE * OPERATION. $CIC RETURNS * TO THE INTERRUPTED * SEQUENCE AS DESCRIBED * IN STEP 8 FOLLOWING. * * 8. RESTORING INTERRUPT CONDITIONS AND RETURN * TO POINT OF INTERRUPTION. AN ENTRY POINT * CALLED '$IRT' IS PROVIDED FOR USE BY * OTHER MODULES OF THE R/T EXEC TO RESET * FLAGS AND THE DMA CHANNELS AND RETdURN TO * THE USER PROGRAM. * * THE CALLING SEQUENCE IS JUST: * * - JMP $IRT - * * $IRT PERFORMS THE FOLLOWING: * 1 - DISABLES THE INTERRUPT SYSTEM * 2 - SETS 'MPTFL' = 0 TO MEAN THAT MEMORY * PROTECT IS ON (ENABLED). * 3 - SKIP TO 6 IF NOT A PRIVILEGED SYSTEM * 4 - ISSUES A CLC TO CLEAR THE CONTROL * FF ON THE SPECIAL CARD. * 5 - SETS THE CONTROL FF ON EITHER DMA * CHANNEL IF BIT 15 OF THE INTBL WORD * =1 TO MEAN IT IS ACTIVE. THIS * ENABLES DMA INTERRUPTS ONLY. * 6 - RESTORES THE REGISTERS AND * 7 - EXECUTES THE CURRENT PROGRAM AT XSUSP. * * * SKP * III. SPECIAL (PRIVILEGED) INTERRUPTS * * THIS PROVISION ALLOWS INTERRUPTS FROM SPECIAL * DEVICES TO BE RECOGNIZED WITHIN 100 MICRO SECONDS * AND TO BE PROCESSED BY SPECIAL, COMPLETELY * INDEPENDENT ROUTINES CLASSIFIED AS SYSTEM TYPE * PROGRAMS. INTERRUPTS ARE CHANNELED DIRECTLY * TO THE ENTRY POINT OF A ROUTINE BY A JSB INDIRECT * IN THE CORRESPONDING CORE LOCATION. $CIC IS * NOT AWARE OF THESE SPECIAL INTERRUPTS OCCURRING; * IT ONLY ALLOWS THE INTERRUPT SYSTEM TO BE * ENABLED AND A SOFTWARE FLAG SET TO INDICATE * THE STATUS OF MEMORY PROTECT. THE JSB TO THE * ENTRY POINT FOR A ROUTINE IS SET BY USING THE * "ENT,XXXXX" STATEMENT IN RTGEN WHEN CONFIGURING * A REAL-TIME SYSTEM. * THE SPECIAL PROCESSING ROUTINES CANNOT USE * ANY FEATURES OR REQUESTS OF THE STANDARD * R/T EXEC. THESE ARE INDEPENDENT ROUTINES. * COMMUNICATION BETWEEN A NORMAL PROGRAM UNDER * THE CONTROL OF THE R/T EXEC AND A SPECIAL * INTERRUPT PROCESSOR CAN BE DONE THROUGH * THE APPROPRIATE COMMON REGION: I.E. FLAGS OR * INDICATORS CAN BE SET IN PRE-DEFINED WORDS * IN COMMON TO INITIATE PROCESSING. THE NORMAL * USER PROGRAM CAN `=BE SCHEDULED TO RUN AT A * PERIODIC TIME INTERVAL TO SCAN THE INDICATORS. * THIS FACILITY IS PROVIDED TO ACCOMODATE HIGH- * SPEED PROGRAM CONTROLED DATA TRANSMISSION * WHICH REQUIRES QUICK RESPONSE. * THE SPECIAL INTERRUPT PROCESSORS ARE * RESPONSIBLE FOR SAVING AND RESTORING ALL * REGISTERS USED AND FOR RESTORING MEMORY * PROTECT TO ITS STATE BEFORE THE SPECIAL * INTERRUPT OCCURRED. MEMORY PROTECT IS * AUTOMATICALLY DISABLED AT THE OCCURRENCE * OF ANY INTERRUPT. THE WORD 'MPTFL' IN THE * BASE PAGE COMMUNICATION AREA IS SET BY THE * R/T EXEC TO INDICATE THE STATUS OF THE * MEMORY PROTECT: * * 'MPTFL' = 0 MEANS MEMORY PROTECT IS 'ON'. * THE SPECIAL ROUTINE MUST ISSUE * A STC 5 IMMEDIATELY BEFORE * RETURNING TO THE INTERRUPTED * SEQUENCE BY A JMP -,I * * = 1 MEANS THAT THE R/T EXEC ITSELF * WAS EXECUTING WHEN THE INTERRUPT * OCCURRED AND THAT MEMORY * PROTECT IS 'OFF'. THE ROUTINE * MUST NOT ISSUE THE STC 5 IN * THIS CASE. * * IF A SPECIAL INTERRUPT ROUTINE MUST EXECUTE * WITH THE INTERRUPT SYSTEM DISABLED, THE * STC 0 TO RE-ENABLE INTERRUPTS JUST PRIOR TO * EXITING MUST BE IN THE FOLLOWING SEQUENCE IF * MEMORY PROTECT IS ALSO TO BE TURNED ON: * * - STF 0 - * - STC 5 - * - JMP -,I - LST $TEMP$ SKP $CIC NOP * CLF CLF 0 DISABLE INTERRUPT SYSTEM * * PRESERVE CURRENT STATUS OF MACHINE * MIC JMP MIC1 STA XA,I IF NO MICRO TO SAVE REGS STB XB,I SAVE REGISTERS ERA,ALS A,B SOC E AND INA OVERFLOW STA XEO,I MX1 JMP LIA4 CXA IF MX CYB DST XI,I SAVE X AND Y * LIA4 LIA 4 GET INTERRUPT CODE STA INTCD SAVE INTERRUPT CODE CPA .5 MP? JMP ZCIC YES, AVOID CLF. IOR CLF STA CLFXX CONFIGURE CLEAR FLAG CLFXX NOP LET PRIVILEGED I-O INTERRUPT * ZCIC EQU * SW1 JMP CIC.0 (STC DUMMY IF PRIVILEDGED OPTION) * CLC 6 STOP DMA FROM INTERRUPTING, CLC 7 SO THAT ONLY PRIVILEGED DRIVERS CAN. STF STF 0 RE-ENABLE INTERRUPTS * CIC.0 EQU * LDB $CIC SAVE P-REGISTER A POSSIBLE STB XSUSP,I POINT OF SUSPENSION. LDB INTCD RESTORE INT CODE * * CHECK FOR TRANSFER TO NON-I/O SYSTEM PROCESSOR * CPB .5 IF MEMORY PROTECT VIOLATION, JMP $RQST CHECK MP OR PARITY VIOLATION. * CPB TBG IF TIME BASE GENERATOR, JMP $CLCK GO TIME PROCESSOR. * * CHECK LEGALITY OF INTERRUPT * MIC2 JMP MIC3 OR NOP IF NO MICRO ADB N6 CODE - 6. STB A (SAVE FOR TABLE INDEX) ADB INTBA INDEX TO PROPER ENTRY CMA,CLE,SSA - ERROR IF CODE ADA INTLG LESS THAN 6 OR BEYOND * * GET PROCESSOR IDENT FROM INTERRUPT TABLE * LDA B,I CODE. GET CONTENTS OF ENTRY SEZ SKIP IF OUT OF INTBL RANGE. CLE,SZA,RSS UNDEFINED INTERRUPT JMP CIC.4 IF VALUE = 0, ISSUE DIAG. * * LDB INTCD REMOVE ERB BIT 15 OF INTBL WORD CPB .3 IF DMA CHANNEL RAL,CLE,ERA INTERRUPT. * SSA,RSS SYSTEM PROCESSOR IS TO BE CALLED JMP CIC.2 IF VALUE IS POSITIVE. * ** INTERRUPT PROCESSOR IS USER ROUTINE TO BE ** SCHEDULED FOR PRIORITY EXECUTION * CMA,INA SET POSITIVE TO GET ID SEGMENT STA B ADDRESS, SET IN B TO <$LIST>. * CIC.3 ADA .15 CHECK STATUS OF PROGRAM. LDA A,I IF STATUS IS ZERO (DORMANT), SZA SCHEDULE PROGRAM, OTHERWISE JMP CIC.5 ISSUE DIAGNOSTIC. * JSB $LIST CALbL SCHEDULER TO LINK PROGRAM OCT 401 INTO SCHEDULE LIST. JMP $XEQ SPC 1 N6 DEC -6 * * * ASSUME PROCESSOR FOR CODE GT= 6 IS A * SYSTEM I/0 DRIVER. VALUE OF INTERRUPT * TABLE ENTRY IS THE STARTING ADDRESS * OF THE EQUIPMENT TABLE ENTRY CORRESPONDING * TO THE INTERRUPTING DEVICE. * CIC.2 JSB $ETEQ SET EQT ENTRY ADDRESSES. CIC.6 EQU * * LDA INTCD (A) = INTERRUPT SOURCE CODE * LDB EQT14,I SET DEVICE STB EQT15,I TIME-OUT CLOCK * * CALL I/O PROCESSOR, COMPLETION SECTION * LDB EQT3,I CALL DRIVER JSB B,I *COMPLETION* SECTION. * JMP IOCOM (P+1): *COMPLETION RETURN* * CLA (P+2): *CONTINUATION RETURN* LDB OPATN CHECK FOR OPERATOR ATTENTION. STA OPATN -CLEAR OPERATOR FLAG- SZB IF FLAG SET, JMP $TYPE ACKNOWLEDGE. * LDA $LIST ANY SCHEDULE ACTIVITY? SZA,RSS YES, SKIP JMP $IRT NO, RETURN TO POINT OF INTERRUPT * JMP $XEQ SCHEDULE NOW, NOT 10MS LATER!! * * * $XCIC LIA 4 ### SPECIAL CLUDGE TO SKIP CLF ### $YCIC STA INTCD MIC4 JMP MIC5 OR NOP IF NO MICRO, CXA IF MX MX4 JMP ZCIC CYB IF MX DST XI,I SAVE X,Y IF MX JMP ZCIC SNEAK TO FRONT DOOR FROM REAR ENTRANCE SPC 2 MIC1 SVR XA,I XI,I MICRO FOR SAVE REGS JMP LIA4 * MIC5 SVR DUM XI,I MICRO SAVE X,Y ONLY JMP ZCIC * MIC3 INT INTBA SEARCH INTERRUPT TABLE JMP CIC.4 ERROR RETURN JMP CIC.2 CALL DRIVER JMP CIC.3 CALL PROGRAM * * * * ILLEGAL OR UNDEFINED INTERRUPT * CIC.4 LDA INTCD GET THE INTERRUPT CODE. JSB $CVT1 CONVERT. STA CICM1+6 STUFF IN THE MESSAGE LDA CICM1 PRINT JMP CIC.7 "ILL INT XX" * * ISSUE DIAGNOSTIC FOR BEING UNABLE TO * SCHEDULE USER PROGRAM ON INTERRUPT. * CIC.5 ADB .12 SET (B) TO ADDRESS OF NAME IN LDA B,I PROGRAM ID SEGMENT. STA CICM2+7 STORE INB PROGRAM DLD B,I NAME IN DST CICM2+8 DIAGNOSTIC AND PRINT LDA CICM2 "SC03 INT XXXXX" CIC.7 JSB $SYMG * * RESET INTERRUPT CONDITIONS - RETURN TO SEQUENCE * SKP * * ROUTINE: '$IRT' * * THIS ROUTINE RETURNS TO THE CURRENT USER PROGRAM. * IT DOES THE PRIV. INTERRUPT SYSTEM EXIT THING AND * RESTORES THE PROGRAMS REGISTERS AND THE INTERRUPT * AND MEMORY PROTECT SYSTEM. * * CALLING SEQUENCE: * * SET UP XEQT AREA ON THE BASE PAGE FOR THE PROGRAM * * JMP $IRT * $IRT LDA XSUSP,I GET THE EXECUTE ADDRESS * STA INTCD SAVE THE RETURN ADDRESS CLF 0 TURN OF INT.SYS SW2 JMP MIC6 CLC IF PRIV. ELSE RETURN STF1 STF 12B DLD INTBA,I CHECK CONDITION OF DMA CHANNELS SSA IF BIT=1, DMA #1 IS ACTIVE SO STC 6 STC TO ENABLE DMA INTERRUPT SSB IF USER WANTED IT STC 7 SAME FOR DMA #2 MIC6 JMP MIC7 NOP IF NO MICRO, DLD IF MX * MX6 JMP NMIC6 DEF XI,I IF MX CAX CBY * NMIC6 LDA XEO,I RESTORE E AND CLO O REGS. SLA,ELA PRIOR TO INTERRUPT TURN OFF STF 1 TO KEEP TIME DOWN * IRT2 DLD XA,I RESTORE THE A AND B REGS IRT3 STF 0 TURN ON THE INTERRUPT SYSTEM JMP INTCD,I RETURN. NOTICE, NO MP! * MIC7 RSR XA,I XI,I MICRO FOR RESTORE REGS JMP IRT3 SPC 4 CICM1 DEF *+1 N10 DEC -10 ASC 5,ILL INT XX * CICM2 DEF *+1 N15 DEC -15 ASC 8,SC03 INT XXXXX DUM EQU *-3 DUMMY BUFFER (3 WORDS) * INTCD NOP HOLDS INTERRUPT SOURCE CODE B37 OCT 37 N2 DEC -2 * HED < RT EXECUTIVE INPUT/OUTPUT CONTROL > UNL $TEMP$ *** I N P U T / O U T P U T C O N T R O L *** * * THE I/O SCHEDULING AND CONTROL MODULE < IOC > * IS RESPONSIBLE FOR ALLOCATING THE USE OF ALL * STANDARD I/O DEVICES AND THE TWO DMA CHANNELS. * I/O DRIVERS OPERATE UNDER CONTROL OF AND * <$CIC> FOR INITIATION AND COMPLETION OF SYSTEM * AND USER DIRECTED I/O OPERATIONS. I/O DRIVERS * ARE INDEPENDENT PROGRAMS IDENTIFIED TO * BY THE DEVICE ASSOCIATED EQUIPMENT TABLE. DRIVERS * ARE COMPOSED TO TWO SECTIONS: *INITIATION* AND * *COMPLETION*. THE *INITIATION* SECTION IS * CALLED BY TO EXAMINE AND INITIATE AN I/O * OPERATION. THE *COMPLETION* SECTION IS CALLED * BY <$CIC> TO CONTINUE OR COMPLETE THE OPERATION. * DRIVERS PROVIDE FOR SIMULTANEOUS MULTI-DEVICE * CONTROL BY USING THE DEVICE EQT ENTRY FOR * VARIABLE STORAGE. * * I. * EQUIPMENT TABLE * (EQT) * * EACH I/O DEVICE CONTROLLED BY THE IOC/DRIVER * RELATIONSHIP IS DEFINED BY STATIC AND DYNAMIC * INFORMATION IN THE EQUIPMENT TABLE. THE EQT * IS A SYSTEM RESIDENT TABLE WHICH IS CONSTRUCTED * FROM USER DIRECTIVES BY . EACH EQT * ENTRY IS COMPOSED OF 15-WORDS IN THE FOLLOWING FORMAT: * SKP * * WORD CONTENTS * ---- ---------------------------- * 1 * I/O LIST . LINK POINTER * * 2 *DRIVER *INITIATION ADDRESS* * 3 *DRIVER *COMPLETION ADDRESS* * 4 *DBPOT/----UNIT#--CHANNEL #* * 5 *AV-TYPE CODE- UNIT STATUS* * 6 *REQUEST CONTROL WORD * * 7 *REQUEST BUFFER ADDRESS * * 8 *REQUEST BUFFER LENGTH * * 9 *TEMPORARY OR DISC TRACK # * * 10 *TEMPORARY OR DISC SECTOR #* * 11 *DRIVER TEMPORARY STORAGE* * 12 * " " " * * 13 * " " " * * 14 * DEVICE CLOCK RESET VALUE * * 15 * " " WORKING " * * * D: =1 IF A DMA CHANNEL REQUIRED FOR TRANSFER * B: =1 IF AUTOMATIC OUPUT BUFFERING DESIRED * P: =1 IF DRIVER TO HANDEL POWER FAIL RECOVERY. * O: =1 IF DRIVER TO HANDEL TIME OUT. * T: DEVICE TIME-OUT BIT - CLEARED BEFORE EACH * IO INITIATION; SET IF DEVICE TIMES-OUT. * UNIT#: OPTIaONAL FOR DEVICES REQUIRING * SUB-CHANNEL DESIGNATION * CHANNEL#: I/O SELECT CODE (LOWER # IF * MULTI-BOARD INTERFACE) * AV (AVAILABILITY INDICATOR): * =0, UNIT AVAILABLE FOR OPERATION * =1, UNIT DISABLED * =2, UNIT CURRENTLY IN OPERATION * =3, UNIT WAITING FOR DMA CHANNEL * TYPE CODE: CODE IDENTIFYING TYPE OF I/O DEVICE * UNIT STATUS: ACTUAL OR SIMULATED UNIT STATUS * AT END OF OPERATION * * II. * DEVICE REFERENCE TABLE * (DRT) * * THE DEVICE REFERENCE TABLE PROVIDES FOR * LOGICAL ADDRESSING OF PHYSICAL UNITS DEFINED * IN THE EQUIPMENT TABLE. THE *DRT* CONSISTS * OF 1-WORD ENTRIES CORRESPONDING TO THE RANGE * OF USER-SPECIFIED "LOGICAL" UNITS, 1 TO N * WHERE N IS LT OR = TO 63(10). THE CONTENTS OF * THE WORD CORRESPONDING TO A LOGICAL UNIT IS * THE RELATIVE POSITION OF THE EQT ENTRY * DEFINING THE ASSIGNED PHYSICAL UNIT,IN * BITS 5 - 0, THE LOCKING RN NUMBER IN * BITS 6 -10, WHILE * BITS 11-15 CONTAIN THE SUBCHANNEL OF THE * EQT ENTRY TO BE REFERENCED BY THIS * LOGICAL UNIT NUMBER. * * CERTAIN LOGICAL UNIT #S ARE PERMANENTLY * ASSIGNED TO FACILITATE SYSTEM, USER AND * SYSTEM SUPPORT I/O OPERATIONS. THESE ARE: * * 1 - SYSTEM TELETYPEWRITER * 2 - SYSTEM DISC * 3 - AUXILIARY DISC * 4 - 'STANDARD' PUNCH UNIT * 5 - 'STANDARD' INPUT UNIT * 6 - 'STANDARD' LIST UNIT * 7 - ASSIGNED * . BY * . USER * 63 - * * III. INPUT/OUTPUT REQUESTS * * I/O REQUESTS INCLUDE COMMANDS FOR * READ, WRITE, CONTROL(FUNCTIONS) AND STATUS. * THE FORMAT OF THESE REQUESTS CONFORM TO * THE GENERAL SYSTEM REQUEST FORMAT. THE * NUMBER OF PARAMETERS VARIES DEPENDING * ON THE TYPE OF REQUEST AND THE CHARAC- * TERISTICS OF THE REFERENCED DEVICE. * * A USER I/O REQUEST IS DIRECTED TO * AT -$IORQ- BY THE EXECUTIVE REQUEST * PROCESSOR <$RQST>. SYSTEM I/O REQUESTS * ARE IN A DIFFERENT FORMAT AND ARE PROCESSED * AT THE SECTION -$XSIO- IN . REFER TO * THAT SECTION FOR DETAILED DESCRIPTION. * * A *STATUS* REQUEST IS PROVIDED * FOR USER AND SYSTEM SUPPORT PROGRAMS * WHICH REQUIRE KNOWLEDGE OF DEVICE * CONDITIONS OR TYPE BEFORE A READ/WRITE/ * CONTROL REQUEST IS MADE. THE PROGRAM * IS NOT SUSPENDED ON THIS CALL. * A PARAMETER WORD IS INCLUDED IN THE * REQUEST TO CONTAIN THE DEVICE STATUS ON * RETURN TO THE USER. THIS STATUS IS FROM WORD * 5 OF THE EQT ENTRY FOR THE DEVICE. * ALSO, AN ADDITIONAL PARAMETER WORD CAN BE * INCLUDED IN THE REQUEST- WORD 4 OF THE * EQT ENTRY IS RETURNED IF THE ADDITIONAL * PARAMETER WORD IS INCLUDED. * * A DYNAMIC STATUS REQUEST CAN BE MADE BY * MEANS OF A CONTROL REQUEST, THE FORMAT * OF WHICH IS DEFINED BELOW. IN THIS CASE, * THE REQUEST IS QUEUED, THE DRIVER IS ENTERED, * AND THE STATUS IS RETURNED TO THE CALLING * PROGRAM IN THE A REGISTER. * SKP * * A. READ/WRITE REQUEST FORMAT * * EXT EXEC * JSB EXEC * DEF EXIT (DEFINE EXIT POINT) * DEF RCODE (DEFINE READ (1) OR WRITE(2)) * DEF CONWD (DEFINE CONTROL WORD) * DEF BUFFR (DEFINE BUFFER LOCATION) * DEF BUFFL (DEFINE BUFFER LENGTH) * DEF DTRAK (OPTIONAL - DISC TRACK #) * DEF DSECT (OPTIONAL - DISC SECTOR #) * EXIT --- * . * . * RCODE DEC 1 OR 2 * CONWD OCT NNNNN CONTROL INFO/LOGICAL UNIT # * BUFFL DEC N OR -N WORD OR CHARACTER LENGTH * DTRAK DEC N DISC TRACK # * DSECT DEC N STARTING SECTOR # * * BIT 12 OF THE CONTROL WORD SET ON NON-DISC REQUESTS * INDICATES A DOUBLE BUFFER FOR THIS OPERATION. * IN THIS CASE THE CONTROL BUFFER IS AT "DTRAK" AND IT'S * LENGTH IN WORDS IS AT "DSECT". * * * B. CONTROL REQUEST FORMAT * * EXT EXEC * JSB EXEC * DEF EXIT (DEFINE EXIT POINT) * DEF RCODE qNLH (DEFINE REQUEST CODE) * DEF CONWD (DEFINE CONTROL WORD) * DEF PARAM (DEFINE OPTIONAL PARAMETER) * EXIT --- * . * . * RCODE DEC 3 * CONWD OCT NNNNN CONTROL CODE/LOGICAL UNIT # * PARAM DEC N PARAMETER REQUIRED BY TYPE OF CODE * * CONTROL CODES (FIELD 10-06 OF CONTROL WORD): * * 01 - WRITE END-OF-FILE --/ PRIMARILY * 02 - BACKSPACE 1 RECORD / FOR * 03 - FORWARD SPACE 1 RECORD / MAGNETIC * 04 - REWIND / TAPE * 05 - REWIND STANDBY / UNITS * 06 - DYNAMIC STATUS --/ * 07 - SET EOT STATUS (FOR PAPER TAPE INPUT) * 10 - GENERATE LEADER FOR PAPER TAPE * 11 - LIST OUTPUT LINE SPACING * 12 - WRITE FILE GAP --/ PRIMARILY * 13 - FORWARD SPACE FILE/ FOR MAGNETIC * 14 - BACKWARD SPACE FILE/ TAPE UNITS SKP N* C. DEVICE STATUS REQUEST FORMAT * * EXT EXEC * JSB EXEC * DEF EXIT (DEFINE EXIT POINT) * DEF RCODE (DEFINE REQUEST CODE) * DEF CONWD (DEFINE CONTROL WORD) * DEF STAT1 (DEFINE STATUS WORD 1) * DEF STAT2 (DEFINE STATUS WORD 2 -- OPTIONAL) * EXIT --- * . * . * RCODE DEC 13 STATUS REQUEST CODE = 13 * CONWD OCT NN LOGICAL UNIT # * STAT1 NOP WORD 5 OF EQT ENTRY FOR * DEVICE STORED IN THIS WORD. * STAT2 NOP WORD 4 OF EQT ENTRY FOR * DEVICE STORED IN THIS WORD * IF PRESENT IN REQUEST. * * * IV. GENERAL OPERATION * * ALL INPUT/OUTPUT OPERATIONS ARE PERFORMED * CONCURRENTLY WITH PROGRAM COMPUTATION IN THE * OVERALL SYSTEM. AN I/O OPERATION IS CONSIDERED * TO BE NON-BUFFERED TO THE REQUESTING USER * PROGRAM AS THE PROGRAM IS SUSPENDED UNTIL * THE TRANSMISSION OR OPERATION IS COMPLETED. * THE EXCEPTION TO THIS IS IN PROVIDING FOR * AUTOMATIC BUFFERING OF OUTPUT TO USER- * DESIGNATED DEVICES. IN THIS CASE, THE USER * BUFFER IS MOVED TO SYSTEM AVAILABLE MEMORY * AND THE USER PROGRAM IS NOT SUSPENDED. * * V. CLASS I/O OPERATIONS * * CLASS I/O REFERS TO NO-WAIT I/O IN WHICH THE USER * DIRECTS THE COMPLETION INFORMATION TO A 'CLASS' BY * NUMBER. LEGAL CLASSES ARE DEFINED AT GENERATION TIME * AND QUEUES ARE KEPT FOR EACH CLASS IN A TABLE CALLED * THE CLASS TABLE. THIS TABLE IS LOCATED AT $CLAS * AND CONSISTS OF A LENGTH WORD (DEFINING THE NUMBER * OF WORDS (CLASSES) IN THE TABLE (SYSTEM)) FOLLOWED * BY ONE WORD FOR EACH DEFINED CLASS. * * IN OPERATION THE USER REQUESTS I/O ON A CLASS, * RTIOC REQUESTS BUFFER MEMORY FOR THE REQUEST * MOVES THE REQUEST TO THE BUFFER MEMORY * QUEUES THE REQUEST ON THE SPECIFIED EQT AND *  NOTES IN THE CLASS QUEUE THAT A REQUEST IS * PENDING. * * ON COMPLETION THE COMPLETED REQUEST IS QUEUED IN THE CLASS * QUEUE AND ANY PROGRAM WAITING FOR THE CLASS * IS RESTARTED. * SKP LST $TEMP$ $IORQ EQU * WE ARE ALREADY IN USER MAP. CLA SET CONTROL FLAG=0 TO MEAN STA CONFL *REQUEST* SECTION ENTERED STA TEMP5 CLEAR LU FLAG FOR LU 0 * CPA RQCNT INSURE AT LEAST ONE PRAMETER JMP ERR01 - NO, ISSUE DIAGNOSTIC. * * LOGICAL UNIT REFERENCE VALIDITY CHECK * CCA,CCE TRANSLATE BY -1 ADA RQP2,I EXTRACT LOGICAL UNIT # FROM AND B77 PARAMETER 1 STA TEMP1 SAVE LU-1 FOR STATUS CALL LDB A CPB B77 IF 0 SPECIFIED JMP L.00X GO DO IMMEDIATE COMPLETION THING * CMA,CLE CHECK FOR ZERO AND ADA LUMAX FOR A VALUE GT THE LARGEST SEZ,RSS DEFINED #. JMP ERR02 - ERROR, OUTSIDE OF RANGE. * * DRT ENTRY: ---------------------------- * : :SUBCH: EQT# : * ---------------------------- * ADB DRT INDEX TODEVICE-REFERENCE-TABLE LDA B,I GET EQT ASSIGNMENT. STA TEMP5 SAVE FOR 'WORD2' ROUTINE. AND B77 MASK OUT SUBCHANNEL CCE,SZA,RSS IF ZERO JMP L.00X THEN DO IMMEADIATE COMPLETION THING JSB $CVEQ CONVERT TO ABSOLUTE EQT ADDRESSES * * REQUEST CODE ANALYSIS * L.000 LDA RQP1 GET REQUEST CODE (PARAMETER 1). AND .15 KEEP LOW PART STA RQPX SAVE IT CPA .13 TRANSFER IF JMP L.15 * STATUS * REQUEST. * LDB EQT5,I IF REFERENCED DEVICE RBL,SLB IS DOWN JMP L.002 NO DEVICE NOT DOWN * SSB IF DOWN THEN JMP L.014 GO SUSPEND THE PROGRAM * L.002 LDB XPRIO,I SE T THE PRIORITY STB TEMP2 FOR LINK AND STB TEMP6 FOR BUFFERING CPA .3 IF REQUEST IS JMP L.02 SKIP FURTHER ANALYSIS. LDB RQCNT CHECK # OF ADB N3 PARAMETERS SUPPLIED SSB FOR READ OR WRITE. JMP ERR01 -ERROR, LT 3. * * BUFFER LEGALITY CHECK FOR INPUT. * BFCK LDB RQP4,I GET THE LENGTH CLE,SSB,RSS CONVERT TO JMP BFCK1 WORDS IF BRS CHARACTERS CMB,INB SET POSITIVE AND BFCK1 STB RQP8 SAVE. SPC 1 CPA .2 IF WRITE REQUEST, JMP L.02 SKIP BUFFER CHECK. SPC 1 ADB RQP3 CHECK IF AREA EXTENDS ABOVE THE CMB,SEZ,CLE,INB,RSS LAST WORD ADB BKLWA OF MEMORY INB CLB,SEZ,RSS IF SO THEN JMP ERR04 ERROR 4 DIAGNOSTIC JMP L.02 NO ERROR ON BUFF. ADDR. * * L.014 LDB .4 L.013 STB XTEMP,I SET 4 IN FIRST WORD OF TEMP AREA. L.015 JSB $LIST PUT PGM IN WAIT LIST OCT 503 UNTIL DEVICE COMES UP. JMP $XEQ EXIT TO DISPATCHER SPC 1 ICOMX NOP DUMMY EQT FOR LU=0 B3700 OCT 3700 DO NOT REARRANGE NEXT 6 LINES WORD2 NOP .12 DEC 12 .13 DEC 13 TEMP1 NOP EQT6 OF DUMMY * N3 DEC -3 C100K OCT 77777 DUMEQ DEF ICOMX ADDRESS OF DUMMY EQT SPC 2 L.00X LDA DUMEQ SET UP DUMMY EQT FOR LU=0 JSB $ETEQ ON BASE PAGE JMP L.000 CONTINUE PROCESSING SKP L.02 CLA,SEZ,RSS IF BIT 12 OF CONWORD LDA RQP2,I SET AND ALF,SLA NOT FIVE PRAMS JMP ERR01 TAKE GAS! * * *WORD2 ASSEMBLE CONTROL WORD * * CONTROL WORD IS BUILT AS FOLLOWS: * ******************************************************** * T * S * X * U * S FUN * SUB CHAN * REQUEST CODE * * 15/14*13 *12 *11 * 10----6* 5------2 * 1/0 * ******************************************************** * L * WHERE: * T= 0 FOR STD USER REQUEST CODE = 1 FOR READ (CLASS OR NORMAL) * = 1 FOR BUFFERED RQ. = 2 FOR WRITE " * = 2 FOR SYSTEM = 3 FOR CONTROL " * = 3 FOR CLASS RQ. * * 'SUB CHAN' IS THE LOW 4 BITS AND 'S' IS THE 5'TH BIT OF THE * SUB CHANNEL. * * 'X' IS THE DOUBLE BUFFER BIT * 'U' IS CURRENTLY UNUSED * 'S FUN' IS THE USER SUB FUNCTION * * IF THE DEVICE IS A DISC THEN THE 'X' BIT IS CLEARED AND BITS * 8,9 IN 'S FUN' ARE SET TO THE LU IF 2 OR 3 ,ELSE THEY ARE * ZEROED. * * THIS ROUTINE DOES NOT BUILD THE 'T' FIELD. *** CALL WITH E=0 *** * WORD1 CLE LDB RQPX LDA RQP2,I COMBINE REQUEST CODE WITH AND B137C CONTROL INFORMATION ADB A TEMPORARILY STORE IT- LDA TEMP5 GET DRT ENTRY FOR THIS LU AND B174K GET SUBCHANNEL ELA,RAL SAVE HIGH BIT AND ALF,RAL POSITON REST ADA B ADD IT TO THE WORD SEZ IF HIGH BIT SET ADA B20K SET IT IN THE WORD STA WORD2 * LDB RQPX GET THE MASKED REQUEST * * CHECK FOR AUTOMATIC BUFFERING REQUIREMENT * L.027 CPB .1 SKIP CHECK IF REQUEST JMP L.10 IS INPUT. * LDA EQT4,I CHECK THE UNIT DESCRIPTOR RAL WORD IN ITS EQT ENTRY,BIT 14, SSA,RSS FOR BUFFERING. JMP L.10 -NO * LDA RQP2,I DYNAMIC STATUS AND B3700 REQUESTS ADA B ARE NEVER CPA B603 BUFFERED JMP L.10 DYNAMIC STATUS DO STD. USER RQ. * * * AUTOMATIC BUFFERING SECTION * L.028 LDA N2 USE 5 WORDS FOR CONTROL REQUEST CPB .3 IF REQUEST IS FOR -CONTROL-, JMP L.03 SKIP BUFFER SIZE CHECK. * LDA RQP8 GET THE XFER LENGTH STA TEMP3 -SET AS MOVE INDEX- LDB RQP2,I IF DOUBLE BUFFER REQUEST BLF,SLB THEN ADA RQP6,I ADD IN THE SECOND BUFFER L.03 #ADA .8 ADD 8 FOR BLOCK CONTROL WORDS. ADA N1 THEN SUBTRACT 1 STA L.04 AND SET UP IN CALL * LDA N41 IF PRIORITY ADA XPRIO,I LT 41 THEN SSA DO NOT DO BUFFER LIMIT JMP L.031 TEST * * LDB $BLUP CHECK IF BEYOND THE LIMIT IN WORDS JSB $QCHK ON THIS DEVICE JMP L.013 BUFFER LIMITED! * * ALLOCATE BLOCK IN TEMPORARY STORAGE * L.031 JSB $ALC CALL AT SYSTEM ENTRY POINT L.04 NOP - REQUESTED LENGTH OF BLOCK - JMP L.10 NEVER ANY MEMORY SO GO UNBUFFERED JMP L.042 NO MEMORY NOW, SUSPEND. JMP L.06 ALLOCATION OK. * * * NO MEMORY AVAILABLE FOR BLOCK - CALLING USER * PROGRAM IS TO BE LINKED INTO MEMORY SUSPENSION * $LIST AND RE-SCHEDULED AT POINT OF REQUEST * WHEN A PREVIOUSLY ALLOCATED BLOCK IS RELEASED. * L.042 JSB $LIST CALL TO LINK PROGRAM INTO OCT 504 MEMORY SUSPENSION LIST. JMP $XEQ * * B603 OCT 603 N41 DEC -41 B137C OCT 13700 B20K OCT 20000 * * SET REQUEST PARAMETERS, PROGRAM PRIORITY AND * USER BUFFER INTO TEMPORARY BLOCK. * L.06 STB L.04 SET ACTUAL BLOCK LENGTH. STA TEMP1 SAVE BLOCK CCE,INA STA B SAVE ADDRESS OF WORD 2 LDA WORD2 GET CONTROL WORD IOR B40K SET = 1 FOR BUFFERING. STA B,I AND SET IN WORD 2 OF BLOCK. INB BUMP TO WORD 3 LDA TEMP6 SET REQUESTING PROGRAM PRIORITY STA B,I IN WORD 3. INB BUMP TO WORD 4 LDA L.04 SET BLOCK LENGTH IN STA B,I WORD 4. INB BUMP TO WORD 5 L.061 LDA .3 IF REQUEST CPA RQPX IS -CONTROL-, SKIP JMP L.08 BUFFER MOVE * LDA RQP4,I SET USER BUFFER LENGTH STA B,I IN WORD 5. CMA,CLE,INA SET E IF ZERO LENGTH BUFFER CLA IN CASE RQP5 IS 0 LDA RQP5,I GET FIRST OPTIONAL WORD h INB BUMP TO WORD 6 STB TEMPW SAVE THE ADDRESS OF THE LOCATION STA B,I SET IT INB BUMP TO WORD 7 CLA IN CASE RQP6 IS 0 LDA RQP6,I GET SECOND OPTIONAL WORD STA B,I SET IT IN THE BUFFER SEZ,CLE,INB IF BUFFER LENGTH = 0, JMP L.075 SKIP BUFFER MOVE. * LDA RQP3 SET USER BUFFER ADDR L.065 EQU * FOR MOVE TO TEMP. BLOCK JSB .MVW DEF TEMP3 NOP * L.075 LDA RQP6,I GET LENGTH OF SECOND BUFFER STA TEMP3 SET FOR MOVE LDA RQP2,I GET THE REQUEST CONTROL WORD ALF,SLA IF FIRST TIME AND DOUBLE BUFFER SEZ,CCE SKIP JMP L.13 ELSE CONTINUE * STB TEMPW,I SET BUFFER ADDRESS IN REQUEST LDA RQP5 GET USER BUFFER ADDRESS JMP L.065 GO MOVE THE BUFFER * L.08 CLA IN CASE RQP3=0 LDA RQP3,I FOR CONTROL REQUEST, SET WORD 3 STA B,I (PARAM) IN PLACE OF RECORD JMP L.13 LENGTH. SPC 2 SPC 2 * * REQUEST IS A NORMAL WRITE, CONTROL OR READ. * THE PARAMETERS OF THE REQUEST ARE MOVED * INTO THE ID SEGMENT OF THE REQUESTING * PROGRAM. THE ID SEGMENT IS THEN LINKED * INTO THE I/O LIST FOR THE REFERENCED DEVICE. * THE -SCHEDULER- IS THEN CALLED TO REMOVE * THE PROGRAM FROM THE SCHEDULED LIST AND TO * CHANGE THE PROGRAM STATUS TO I/O SUSPENSION. * L.10 CLA IN CASE RQP3=0 LDB RQP3,I SET CONTROL WORD LDA RQP1 (A) = REQUEST CODE CPA .3 IF CONTROL GO JMP L.101 SET IT UP * LDB RQP3 BUFFER ADDRESS TO B * SPC 1 STB XTEMP+1,I SET BUFFER ADDRESS OR CONTROL WORD LDA RQP4,I BUFFER STA XTEMP+2,I LENGTH AND LDA RQP2,I GET THE CON WORD CMA,CME SET COMPLEMENT LDB RQP5 GET SECOND BUFFER ADDRESS ALF,SLA IF NONE SZB,RSS RSS LDB B,I  GET THE OPTION WORD STB XTEMP+3,I SET THE PRAMETER IN THE ID-SEGMENT * CLA IN CASE RQP6=0 LDA RQP6,I SET THE FINAL OPTIONAL WORD STA XTEMP+4,I IN THE ID-SEGMENT * CLE,RSS SKIP CONTROL SET UP L.101 STB XTEMP+1,I SET CONTROL WORD LDA WORD2 GET CONTROL WORD STA XTEMP,I SAVE IN TEMPORARY #1 LDB XEQT SET ADDRESS OF LINK WORD STB TEMP1 IN TEMP1. * JSB $LIST CALL SCHEDULER TO SUSPEND PROG. OCT 402 - ID SEG. ADDR./I/O SUSPEND - * * CALL -LINK- TO PERFORM THE LINKING OF THE NEW * BLOCK INTO THE DEVICE QUEUE OF * WAITING OPERATIONS. * L.13 EQU * IF STANDARD I/O L.131 LDB XSUSP,I SET THE SUSP POINT STB XA,I IN XA FOR THE ABORT ROUTINE L.132 LDA RQRTN AND SET THE RETURN ADDRESS STA XSUSP,I IN THE ID-SEG. JSB LINK LINK SETS E=0 IF EMPTY QUEUE LDB EQT1 IF DUMMY EQT FOR LU=0 CPB DUMEQ THEN JMP L.135 GO TO COMPLETE * * SEZ,RSS IF QUEUE WAS EMPTY CALL DRIVR. * * EMPTY LIST, CALL TO INITIATE CURRENT REQUEST. * JSB DRIVR JMP $XEQ - OPERATION INITIATED - JMP NOTRD - OPERATION REJECTED OR COMPLETED - * L.135 LDB RQP4,I GET THE REQUEST LENGTH SSB AND SET UP CMB,INB THE TLOG LDA .2 SET A FOR IMMEDIATE COMPLETION JMP R00 AND GO TO COMPLETION SECTION * * STATUS REQUEST SECTION * L.15 LDA RQCNT INSURE THAT AT LEAST 2 ADA N2 PARAMETERS PROVIDED - ONE SSA TO STORE STATUS WORD. JMP ERR01 -NO, ERROR '01'. * LDB EQT5,I STORE WORD 5 OF EQT ENTRY IN STB RQP3,I 'STAT1' LDA EQT4,I STORE WORD 4 OF EQT ENTRY IN STA RQP4,I 'STAT2' IF CODED. LDB TEMP1 ADB DRT LDA B,I GET SUBCHANNEL FOR DRT WORD#1 AND B174K ALF,RAL PUT INTO LOW 5 BITS ADB LUMAX LDB B,I GET UP/DOWN BIT OF LU CLE,ELB (DRT WORD#2) RAL,ERA ADD TO SUBCHANNEL BITS STA RQP5,I STORE IN 'STAT3' * L.16 LDA RQRTN UPDATE THE STA XSUSP,I RETURN ADDRESS JMP $XEQ AND EXIT SPC 3 RQPX NOP SKP UNL $TEMP$ * SUBROUTINE: -LINK- * * PURPOSE: THIS ROUTINE PROVIDES FOR ADDING * AN I/O REQUEST INTO THE SUSPENDED * LIST (QUEUE) CORRESPONDING TO THE * REFERENCED DEVICE. THE PROCEDURE * OF ADDING AN ENTRY INTO THE LIST * INVOLVES ONLY THE ALTERATION OF * THE LINKAGE VALUE IN THE NEW ENTRY * AND IN THE ENTRY PRECEDING THE * NEW ONE IN THE PRIORITY CHAIN. * THE NEW ENTRY IS LINKED ACCORDING * TO ITS PRIORITY AND ON A FIFO * BASIS WITHIN THE SAME PRIORITY * LEVEL. THE END OF A LIST IS MARKED * BY A LINKAGE VALUE OF ZERO. THE * FIRST ENTRY IN A LIST IS SKIPPED * BECAUSE IT IS ASSUMED TO BE THE * REQUESTOR FOR THE CURRENT I/O * OPERATION. IF THE LIST IS EMPTY, * THE LINK WORD IN THE EQT ENTRY * IS SET TO POINT TO THE NEW ENTRY * AND AN INDICATION IS GIVEN TO * THE CALLER OF -LINK- THAT THE * NEW REQUEST MAY BE INITIATED. * * CALL: THE FOLLOWING LOCATIONS MUST BE * SET TO THE INDICATED VALUES * BEFORE THE CALL IS MADE: * * TEMP1 = LOCATION OF NEW REQUEST * TO BE LINKED INTO THE * I/O LIST DEFINED BY THE * CURRENT EQT ENTRY. THE * ADDRESS OF THE LINKAGE * WORD IN THE EQT ENTRY * IS IN -EQT1-. * * TEMP2 = PRIORITY OF THE NEW * REQUEST. * * TEMPL = DISC QUEUE FLAG (# 0 MEANS DISC) * * - JSB LINK * - (RETURN) (E) = 0 IF THE NEW *  REQUEST IS THE ONLY ENTRY * IN THE I/O LIST, I.E. THE * DRIVER MAY BE CALLED TO * INITIATE THE NEW OPERATION. * * THERE ARE NO ERROR CONDITIONS * DETECTED OR DIAGNOSED BY THIS * ROUTINE. * * SKP LST $TEMP$ LINK NOP MIC8 JMP MIC9 OR LDB EQT1 IF NO MICRO CLE,RSS SET FIRST FLAG AND SKIP * * FIRST ENTRY IN LIST IS SKIPPED BECAUSE IT * IS THE CALLER FOR THE CURRENT OPERATION * ACTIVE ON THE I/O DEVICE. * ************************************************* **WILL ENTER IN EITHER MAP,BUT THIS IS OK BECAUSE **THE LIND WORD WILL BE IN THE ENABLED MAP AREA** ************************************************* LINK1 SEZ,CCE,RSS IF NOT FIRST SKIP JMP LINK7 GO START THE SCAN * STB TEMP3 TEMP3 = ADDRESS OF CURRENT ENTRY. CCE,INB EXAMINE THE LDA B,I TYPE FIELD IN WORD 2 OF BLOCK INB TO DETERMINE LOCATION RAL OF PRIORITY. SSA IF BUFFERED REQUEST JMP LINK8 B POINTS AT PRIORITY * SLA,RSS IF USER REQUEST JMP LINK5 GO BUMP BY 4 * CLA USE PRIORITY 0 FOR SYSTEM JMP LINK2 NO USE ZERO PRIORITY * LINK5 ADB .4 IS IN WORD 7 OF ID SEGMENT. LINK8 LDA B,I GET PRIORITY OF CURRENT ENTRY. LINK2 LDB TEMP3 CMA,INA SUBTRACT CURRENT PRIORITY FROM ADA TEMP2 PRIORITY OF NEW REQUEST. SSA IF CURRENT IS LOWER PRIORITY JMP LINK3 (HIGHER #), GO TO LINK NEW. * LINK7 STB TEMP5 SAVE PREVIOUS ENTRY POINTER LDB B,I GET NEXT ENTRY ELB,CLE,ERB CLEAR POSSIBLE SIGN BIT SZB IF END-OF-LIST, SKIP. JMP LINK1 -CONTINUE SCAN. * * PROPER POSITION (BY PRIORITY) IS FOUND IN LIST, * OR ELSE THE SCAN OF THE LIST IS FINISHED AND * THE NEW REQUEST IS ADDED AS THE LAST ENTRY. * LINK3 LDA TEMP1 ߱ SET ADDRESS OF NEW ENTRY IN STB TEMP1,I SET ADDRESS OF NEXT OR 0 IF LAST XOR TEMP5,I KEEP SIGN OF OLD WORD AND C100K IF IT WAS SET XOR TEMP5,I STA TEMP5,I SET THE POINTER TO THE NEW REQUEST SPC 1 LINK9 EQU * JMP LINK,I -EXIT TO CALLER. SPC 1 MIC9 LDA TEMP2 (A)=PRIORITY OF NEW REQ. LDB TEMP1 (B)=ADDR OF NEW REQUEST LNK EQT1 0B DO MICRO CALL JMP LINK9 RETURN * A SYSTEM REQUEST HAS BEEN FOUND IN THE QUE * SYSTEM DISC REQUESTS ARE QUED BY THE PRIORITY IN * WORD 7 OF THE CALL. OTHER SYSTEM REQUEST ARE AT * PRIORITY ZERO. SKP UNL $TEMP$ SPC 4 * SUBROUTINE: -DRIVR- * * PURPOSE: THIS ROUTINE PROVIDES A CENTRAL POINT * FOR CALLING AN I/O DRIVER TO INITIATE * A NEW OPERATION. THIS ROUTINE, BEFORE * CALLING A DRIVER, SETS THE REQUEST * PARAMETERS INTO THE APPROPRIATE WORDS * IN THE EQT ENTRY CORRESPONDING TO THE * REFERENCED DEVICE AND ASSIGNS A DMA * CHANNEL IF REQUIRED. * IT ALSO SETS THE DEVICE TIME-OUT CLOCK. * * REQUIREMENTS: THE ADDRESSES OF THE EQUIPMENT * TABLE ENTRY (15 WORDS) MUST BE SET * IN EQT1 TO EQT15 BEFORE THE ROUTINE * IS CALLED. * * CALLING SEQUENCE: - PARAMETER SET UP AS ABOVE- * - (REGISTERS MEANINGLESS) - * * (R) JSB DRIVR * (P+1) -OPERATION INITIATED OR STACKED * (P+2) -OPERATION REJECTED OR COMPLETED- * * ERRORS/DIAGNOSTICS: A DRIVER IS CALLED ONLY * IF THE UNIT IS AVAILABLE * AND NOT BUSY; OTHERWISE, * RETURN IS MADE TO THE * CALLER. IF THE DRIVER * FINDS THE UNIT UNAVAILABLE * OR THE REQUEST ILLEGAL FOR * THE UNIT, THE INDICATION IS * rw RETURNED TO THE CALLER FOR * FURTHER ACTION. LST $TEMP$ * DRIVR NOP LDA EQT5,I CHECK AVAILABILITY RAL OF DEVICE SSA,SLA IF DMA WAIT JMP DVR00 GO DO DMA WAIT THING. * CMA,SSA,SLA,RSS IF DOWN OR BUSY JMP DRIVR,I EXIT * * * DEVICE IS AVAILABLE - CHECK FOR DMA REQUIREMENT * LDA EQT4,I SKIP DMA CHANNEL ASSIGNMENT IF SSA,RSS NOT REQUIRED ( D FIELD = 0 ) JMP DRV02 IN WORD 4 OF EQT ENTRY. SPC 1 * DMA CHANNEL REQUIRED - ATTEMPT TO ASSIGN CHANNEL * DVR0 LDA DMACF IF DMA QUEUE IS NOT EMPTY B2002 SZA JMP DVR1 THEN JUST ADD THIS EQT TO QUE. * DVR00 LDA .6 INITIALIZE FOR STA CHAN CHANNEL 6 (DMA # 1 ) LDB INTBA ADDR. OF DMA 1 IN INTERRUPT TABLE CLA IF DMA CHANNEL # 1 CPA B,I AVAILABLE (INTBL ENTRY = 0), JMP DRV01 GO TO ASSIGN IT TO THIS UNIT. * INB SET FOR CHANNEL 7, ISZ CHAN DMA CHANNEL # 2. CPA B,I IF THIS CHANNEL AVAILABLE, JMP DRV01 GO TO ASSIGN IT. * * NO CHANNEL AVAILABLE - SET FLAGS AND RETURN * DVR1 LDA EQT5,I IF DEVICE SSA IS ALREADY WAITING FOR DMA, JMP DRIVR,I EXIT. * IOR B140K SET AVAIL TO SAY WAITING FOR STA EQT5,I DMA, ADD 1 TO ISZ DMACF # DEVICES WAITING. JMP DRIVR,I - EXIT TO CALLER - * DRV03 SEZ,CLE,INB STEP OVER PRIORITY AND INB IF CLASS REQUEST OVER CLASS WORD AND .6 ISOLATE REQUEST (A IS SHIFTED REMEMBER) CPA .6 IF CONTROL REQUEST JMP DRV2 GO SET IT UP * STB A SET BUFFER ADDRESS ADA .4 IN A (SKIP LENGTH AND TWO OPTION WDS) JMP DRV3 GO FINISH SET UP. * * ASSIGN AVAILABLE CHANNEL * DRV01 LDA EQT1 SET EQT ENTRY ADDRESS IN INTER- STA B,I RUPT TABLE ENTRY FOR CHANNiwHFBEL. LDB DMACF IF UNIT WAS LDA EQT5,I PREVIOUS WAITING SSA FOR A DMA ADB N1 CHANNEL, SUBTRACT 1 FROM # OF STB DMACF UNITS WAITING. ALR,RAR CLEAR STA EQT5,I FIELD. * * TRANSFER REQUEST PARAMETERS TO EQT ENTRY * DRV02 EQU * DV02C LDB EQT1,I GET CURRENT REQUEST ADDRESS INB FROM LINK WORD OF EQT ENTRY. LDA B,I GET REQUEST CONTROL WORD, AND NTSUB SET SUBCHANNEL BITS TO ZERO STA EQT6,I SET IN EQT 6. XOR B,I SET SUBCHANNEL RAL,RAL NUMBER INTO RAL,SLA,RAL BITS 10-6 OF WORD XOR B2002 SET HIGH BIT, CLEAR LOW BIT STA TEMPL SAVE FOR EQT4 LDA B,I CLE,ELA IF REQUEST IS DRV2 INB SSA HELD AS A TEMPORARY BLOCK FOR JMP DRV03 BUFFERING, JUMP. LDA B,I DRV3 STA EQT7,I ADDRESS. INB LDA B,I SET BUFFER STA EQT8,I LENGTH. INB DLD B,I SET ADDITIONAL 2 DST EQT9,I PARAMETERS IF SUPPLIED. H* * CALL DRIVER -INITIATION- SECTION * LDA EQT14,I SET DEVICE LDB EQT15,I TIME OUT CLOCK ONLY SZB,RSS IF NOT CURRENTLY RUNNING STA EQT15,I LDA EQT4,I ZERO TIME-OUT AND C7700 BIT AND SET IOR TEMPL IN SUBCHANNEL STA EQT4,I SET (A) = CHANNEL AND B77 # OF I/O DEVICE. LDB EQT2,I CALL DRIVER *INITIATION* JSB B,I SECTION. SKP * DRIVER RETURNS AN INDICATION OF THE ACCEPTANCE * OR REJECTION OF THE REQUESTED OPERATION: * (A) = 0, OPERATION SUCCESSFULLY INITIATED * (A) NOT = 0, OPERATION REJECTED AND (A) * CONTAINS A NUMERIC CODE * IDENTIFYING THE CAUSE OF * THE REJECT. * * = 1 READ OR WRITE REQUEST ILLEGAL FOR DEVICE * = 2 CONTROL REQUEST ILLEGAL OR NOT DEFINED * = 3 EQUIPMENT MALFUNCTION OR NOT READY * = 4 IMMEDIATE COMPLETION OF OPERATION * = 5 DRIVER REQUIRES DMA BUT FLAG IS NOT SET IN EQT * STA TEMP6 SAVE DRIVER CODE. CCE,SZA IF REJECTED, JMP DRV06 EXAMINE REASON * * OPERATION INITIATED * LDB EQT5,I SET RBL,ERB = 2 TO SAY DEVICE LDA EQT1,I SZA STB EQT5,I IN OPERATION. JMP DRIVR,I EXIT. * * OPERATION REJECTED * DRV06 STB TEMPW SAVE (B) CLA CLEAR DEVICE STA EQT15,I TIME-OUT CLOCK JSB CLDMA CLEAR DMA IF ALLOCATED LDA TEMP6 (A) = REJECT CODE. CPA .5 IF DMA REQUIRED JMP DVR0 GO ATTEMPT ASSIGNMENT ISZ DRIVR SET RETURN TO (P+2). CPA .3 IF NOT READY THEN JMP DRIVR,I -EXIT. JMP ILLCD ELSE GO TO SEND THE MESSAGE * C7700 OCT 170077 NTSUB OCT 153703 INCLUDE Z BIT B174K OCT 174000 SIGN OCT 100000 HED < I/O MODULE SUBSECTION - SYSTEM REQUEST PROCESSOR > UNL $TEMP$ * SYSTEM I/O REQUEST PROCESSOR - $XWiSIO- * * A PRIVATE ENTRY IS PROVIDED AT ENTRY POINT * < $XSIO> TO ALLOW MODULES OF THE REAL TIME * EXECUTIVE TO CALL FOR I/O OPERATIONS WITHOUT * INCURRING THE OVERHEAD AND PROCEDURES * INVOLVED WITH USER I/O REQUESTS. NO ERROR * CHECKING IS PERFORMED, THE REQUEST IS LINKED * INTO THE APPROPRIATE I/O LIST AT A PRIORITY * LEVEL OF ZERO (HIGHEST PRIORITY), AND CONTROL * IS RETURNED TO THE FIRST WORD FOLLOWING THE * REQUEST CALL. * REQUEST FORMAT: A SYSTEM I/O REQUEST DIFFERS * FROM THE USER I/O REQUEST IN * FORMAT AND POWER. SPECIFICALLY, * A SYSTEM DISC CALL CAN SPECIFY A * SERIES OF TRANSFERS TO BE * PERFORMED BEFORE THE NEXT * OPERATION IS INITIATED. A * COMPLETION ADDRESS CAN BE * SPECIFIED FOR OPERATION OF * AN OPEN SUBROUTINE AT THE * END OF THE OPERATION. THIS * FACILITY IS ONLY AVAILABLE * TO SYSTEM ROUTINES AND IS * USED TO RESET FLAGS, ETC. * BECAUSE AN OPERATION IS * ALWAYS BUFFERED TO THE * SYSTEM. A ZERO COMPLETION * ADDRESS INDICATES ABSENCE * OF A COMPLETION ROUTINE. * WORD * ---- EXT $XSIO * 1 JSB $XSIO * 2 OCT * 3 DEF * 4 NOP * 5 OCT * 6 DEF * 7 DEC OR * * DISC VERSION OF REQUEST: * WORD 6 OF REQUEST POINTS TO AN ARRAY * CONTAINING -N- SETS OF TRIPLETS * DECLARING BUFFER ADDRESS, LENGTH AND * TRACK/SECTOR ADDRESS FOR EACH TRANSFER. * THE SET OF TRIPLETS IS OPEN-ENDED AND * TERMINATED BY A ZERO WORD: * * 1 DEF < BUFFER ADDRESS> * 2 DEC < BUFFER LENGTH > * 3 OCT < TRACK/SECTOR #> * . ETC * . . * N DEC 0 (END OF TRIPLETS) * FOR DISC REQUEST THE 7'TH WORD IS THE REQUEST PRIORITY. * LST $TEMP$ * $XSIO NOP CCB ADB $XSIO,I GET LOGICAL UNIT #. ADB DRT INDEX INTO DRT. LDA B,I GET ASSIGNED EQT ENTRY #. STA TEMPL AND SAVE IT JSB $CVEQ CONVERT TO ABSOLUTE EQT ADDRESSES * LDB $XSIO SET ADDRESS ADB .2 OF LIST POINTER WORD IN STB TEMP1 REQUEST FOR . * LDA TEMPL GET THE SUBCHANNEL WORD AND B174K ISOLATE SUBCHANNEL CLE,INB P+4 IS ADDR OF CONWORD ELA,ALF SIGN TO E ELA,SLA,RAL ADA B20K ADA SIGN ADD 'SYSTEM REQUEST' BIT XOR B,I ADD CONWORD INFO AND SUBCH =B120074 REMOVE EXCESS XOR B,I STA B,I PUT THE RESULT BACK IN THE QUE CLA SET PRIORITY OF REQUEST = 0 STA TEMP2 FOR , STA CONFL SET CONTROL FLAG = 0 (REQUEST). ADB .4 BUMP RETURN ADDR STB $XSIO FOR REGULAR RETURN JSB LINK CALL TO LINK REQUEST IN I/O LIST. * SEZ,RSS IF DEVICE NOT BUSY * JSB DRIVR CALL DRIVER TO INITIATE OPERATION JMP $XSIO,I -GOOD REQUEST,EXIT * LDB $XSIO BAD NEWS SO TRANSFER THE STB XSIOE RETURN ADDRESS FOR NR ROUTINE * JMP NOTRD PRINT DIAGNOSTIC. * XSIOE NOP SUBCH OCT 120074 SUBCHANNEL MASK PLUS SYSTEM RQ CODE HED < I/O CONTROL MODULE - COMPLETION SUBSECTION > UNL $TEMP$ * * I/O COMPLETION SUBSECTION * * THIS SECTION IS RESPONSIBLE FOR THE INITIATION * OF STACKED I/O OPERATIONS, PLACING A USER * PROGRAM BACK IN A SCHEDULED STATE WHEN ITS * I/O OPERATION IS COMPLETED, DYNAMIC ALLOCATION * OF THEޭ TWO DMA CHANNELS AMONG SYNCHRONOUS * DEVICES, AND CALLING FOR OPERATOR NOTIFICATION * OF EQUIPMENT MALFUNCTION. * * IS ENTERED DIRECTLY FROM INTERRUPT CONTROL * WHEN AN I/O OPERATION IS TERMINATED AND ALL * ERROR RECOVERY PROCEDURES HAVE BEEN ATTEMPTED. * ON ENTRY TO THIS SECTION, (B) CONTAINS THE * NUMBER OF WORDS TRANSFERRED. THE ADDRESSES OF * THE EQUIPMENT TABLE ENTRY ARE SET IN -EQT1- TO * - EQT 15-. * * REQUESTS ARE STACKED IN LISTS FOR EACH DEVICE * ACCORDING TO PRIORITY. THE REQUESTS ARE EITHER * USER (NORMAL), USER (AUTOMATIC OUTPUT BUFFERING) * OR SYSTEM - IDENTIFICATION OF REQUEST TYPE * THE CODE IN BITS 15-14 OF THE * IN EACH REQUEST CALL. THE FORMATS OF THE THREE * TYPES OF REQUESTS AS THEY APPEAR IN THE I/O * LISTS ARE: * * 1) USER (NORMAL OPERATION) T=0 * * THE PARAMETERS FROM THE REQUEST ARE STORED * IN THE TEMPORARY AREA OF THE PROGRAM ID * SEGMENT. THE LINK WORD OF THE SEGMENT IS * USED TO LINK INTO THE I/O LIST. * * WORD CONTENTS * ---- -------- * 1 < LINKAGE WORD > * 2 * 3 * 4 * 5 * 6 * 7 * . -REMAINDER OF ID SEGMENT . * * SKP * 2) USER (AUTOMATIC OUTPUT BUFFERING) T=1 * * REQUESTS OF THIS TYPE ARE CONSTRUCTED * IN THE SECTION OF SYSTEM AVAILABLE MEMORY. * * WORD CONTENTS * ---- -------- * 1 < LINKAGE WORD > * 2 * 3 * 4 * 5 * 6 * 7 * 8 * . . . . * . . . . * N+7 * * 3) USER (CLASS INPUT/OUTPUT) T=3 * * REQUESTS OF THIS TYPE ARE CONSTRUCTED * IN THE SECTION OF SYSTEM AVAILABLE MEMORY. * * WORD CONTENTS * ---- -------- * 1 < LINKAGE WORD > * 2 * 3 (CHANGED TO STATUS AT COMP.) * 4 * 5 * 6 (CHANGED TO TLOG AT COMP.) * 7 * 8 * 9 * . . . . * . . . . * N+8 * * * 4) SYSTEM REQUEST T=2 * * THE SYSTEM REQUEST IS LINKED INTO * THE I/O LIST BY USING WORD 4 OF THE * CALL AS A LINK WORD. A SYSTEM * REQUEST ASSUMES THE PRIORITY LEVEL * OF ZERO (HIGHEST PRIORITY). * * WORD CONTENTS * ---- -------- * 1 < JSB $XSIO > * 2 < LOGICAL UNIT # > * 3 * 4 < LINKAGE WORD > * 5 * 6 * 7 * 8 * * THE FIELD (BITS 15-14 IN CONTROL WORD) * IDENTIFIES THE REQUEST TYPE AS: * * 00 USER (NORMAL OPERATION) * 01 USER (AUTOMATIC BUFFERING) * 10 SYSTEM * 11 CLASS I/O * * SKP LST $TEMP$ IOCOM RAL,CLE,ERA CLEAR THE SIGN BIT AND SAVE IN E STA TEMP3 SAVE STATUS FROM DRIVER AND STB TLOG TRANSMn1ISSION LOG * CLA CLEAR STA COMPL CLEAR COMPLETION ADDRESS. STA EQT15,I CLEAR TIME-OUT CLOCK * LDA EQT4,I SET THE COMPLETION SECTION FLAG STA CONFL AND TEST FOR DMA RETURN SEZ,RSS SIGN OF A IS EXPLICID RETURN OF SSA DMA CHANNEL, CALL TO JSB CLDMA RELEASE ITS ASSIGNMENT. * LDB EQT1,I GET CONTROL WORD FROM CLE,SZB,RSS IF ILLEGAL ENTRY JMP CIC.4 SEND ERROR MESSAGE * SSB,INB JMP L.502 CLEAN UP IF CLEAR COMPLETION * LDA B,I EXTRACT FIELD. STA TEMP0 SAVE CONTROL WORD. RAL,SLA,ELA IF BIT 15 = 1 ( = 2 OR 3) JMP L.53 PROCESS AS SYSTEM REQUEST. SEZ,RSS IF = 0, PROCESS JMP L.51 AS NORMAL USER REQUEST. * * RELEASE AUTOMATIC BUFFERING BLOCK * LDA TEMP3 BY PASS RELEASE OF SZA BUFFER IF MALFUNCTION JMP L.70 OCCURRED ADB .2 GET TOTAL LDB B,I BLOCK LENGTH AND STB L.50+1 SET IN RELEASE CALL. LDB EQT1,I SET ADDRESS OF BLOCK STB L.50 IN CALL. LDA B,I SET LINK TO NEXT STACKED STA EQT1,I REQUEST IN EQT ENTRY - WORD 1. * JSB $RTN RELEASE BLOCK TO AVAILABLE MEM. L.50 NOP - BLOCK ADDRESS - NOP - BLOCK LENGTH - L.501 LDB $BLLO CHECK IF BELOW THE LIMIT JSB $QCHK JMP L.54 NO GO START NEXT ONE * LDA B YES RESCHEDULE ANY WAITERS JSB $SCD3 JMP L.54 THEN GO START THE NEXT REQUEST * L.502 ADB C100K SUBTRACT ONE AND SIGN BIT STB EQT1,I RESET IN THE EQT AND JMP L.55 GO START THE NEXT RQ. * * NORMAL USER OPERATION COMPLETION * L.51 LDB EQT1,I GET ID SEGMENT ADDRESS LDA B,I SET NEXT LINK ADDRESS STA EQT1,I IN WORD 1 OF EQT ENTRY. STB L.52 SET CURRENT ADDR. FOR SCHEDULER., * ADB .9 SET (B) = ADDR. OF XA IN ID SEG. LDA TEMP3 GET COMPLETION STATUS CLE,SZA SET BIT 14 CCE IN STATUS WORD LDA EQT5,I IF THE STATUS RAL,RAL IS NON-ZERO ERA,CLE,ERA AND SAVE IN USER A-REG. STA B,I CONTENTS OF PROGRAM. INB STB TEMP9 SAVE TRANSMISSION LOG ADDRESS LDA TLOG SET TRANSMISSION LOG AS STA B,I SAVED B-REGISTER. * ADB .5 INDEX TO THE STATUS WORD LDA B,I AND SAVE FOR STA TEMPX DISC ERROR ROUTINE * JSB $LIST CALL SCHEDULER MODULE TO PLACE OCT 101 USER PROGRAM INTO L.52 NOP LIST. JMP L.54 * * SYSTEM REQUEST COMPLETION * L.53 EQU * LDB EQT1,I GET CURRENT REQUEST ADDR. LDA B,I SET NEXT LINK ADDRESS STA EQT1,I IN EQT ENTRY. ADB N1 GET WORD 3 OF REQUEST LDA B,I . STA COMPL SAVE COMPLETION ADDR. OR ZERO. * * < L.54 > : AT THIS POINT: * 1) A TEMPORARY BUFFER HAS BEEN RELEASED, * 2) A NORMAL OPERATION HAS CAUSED THE * REQUESTING PROGRAM TO BE LINKED * BACK INTO THE LIST, OR * 3) A SYSTEM REQUEST COMPLETION ADDRESS * HAS BEEN SAVED. * L.54 LDA TEMP3 DON'T START NEXT OPER. IF ERROR CMA,SSA,INA,SZA OCCURRED ON COMPLETION OR JMP L.70 ON CLASS I/O INITIATION * * L.55 LDA EQT5,I CHECK FIELD. RAL SSA IF AV SAYS DOWN JMP IOCX GO EXIT * * SECTION <60> PROVIDES FOR INITIATING THE NEXT * OPERATION WAITING FOR THE COMPLETED DEVICE. * L.60 LDA EQT5,I SET ALR,RAR FIELD STA EQT5,I = 0 TO SAY AVAILABLE. JMP L.68 GO START THE NEXT REQUEST * * * .11 DEC 11 SKP * * THIS DEVICE IS COMPETING WITH OTHER DEVICEhS FOR * THE USE OF THE AVAILABLE DMA CHANNEL. THE * FIELD IN THE CURRENT ENTRY IS SET = 3 TO MEAN * WAITING FOR DMA. THE EQT IS THEN SCANNED FROM * FIRST TO LAST ORDER (#1 TO N) TO FIND THE FIRST * UNIT WAITING FOR DMA. THEREFORE, THE ORDER OF * THE EQT DETERMINES PRIORITY FOR DYNAMIC ASSIGN- * MENT OF DMA CHANNELS - THE SYSTEM DISC SHOULD * BE THE FIRST ENTRY IN THE EQT. * L.63 LDA EQT# SET # OF CMA,INA EQT ENTRIES STA TEMP1 AS AN INDEX VALUE. LDB EQTA INITIALIZE TO FIRST EQT ENTRY. * L.64 STB TEMP2 SAVE CURRENT ENTRY ADDR. ADB .4 EXTRACT LDA B,I FIELD FROM RAL WORD 5. SSA,SLA IF A = 3, GO TO JMP L.66 ASSIGN DMA. * L.65 ADB .11 SET (B) FOR NEXT ENTRY. ISZ TEMP1 END OF EQT? JMP L.64 - NO, CONTINUE SCAN * CCA DECREMENT THE DMA COUNT ADA DMACF (MUST HAVE ABORTED A DMA STA DMACF WAIT WITH 'OF,XXX,1' REQUEST) JMP IOCX EXIT * L.66 CLA,INA IF ONLY 1 DEVICE WAITING CPA DMACF FOR DMA, GO TO JMP L.67 ASSIGN TO THIS DEVICE. * LDA TEMP2 IF CURRENT UNIT IS CPA EQTA FIRST IN EQT (I.E SYSTEM DISC) JMP L.67 ASSIGN ANYWAY. * CPA EQT1 IF SAME DEVICE JUST COMPLETED, JMP L.65 ALLOW OTHER DEVICES DMA TIME. * L.67 LDA TEMP2 IF DEVICE TO BE INITIATED IS CPA EQT1 SAME AS INTERRUPTING DEVICE, RSS SKIP SETTING EQT ADDRESSES. * JSB $ETEQ SET EQT ADDRESSES. * * CALL IF A REQUEST IS STACKED OR A * WAITING UNIT IS ASSIGNED A DMA CHANNEL. * L.68 LDA EQT1,I IF NO REQUEST SZA,RSS WAITING, JMP IOCX EXIT. * JSB DRIVR CALL RSS IF GOOD REQUEST THEN SKIP JMP NOTRD DIAGNOSTIC IF NOT AVAILABLE. * * I/O COMPLETION - EXIT SECTION. * * THISv ROUTINE CHECK FOR A DMA QUEUE AND IF ANY AND IF A CHANNEL IS * AVAILABLE THE CHANNEL ASSIGNMENT ROUTINE IS ENTERED. * IOCX LDA DMACF GET THE DMA QUEUE FLAG SZA,RSS IF EMPTY QUE THEN JMP IOCX1 GO EXIT * .DLD DLD INTBA,I ELSE GET THE DMA FLAGS SZA IF ANY SZB,RSS AVAILABLE JMP L.63 GO ALLOCATE IT. * IOCX1 LDA COMPL IF SYSTEM REQUEST LDB TLOG SZA COMPLETION ROUTINE SPECIFIED, JMP COMPL,I OPERATE IT. * LDB OPATN GET OPERATOR ATTENTION FLAG STA OPATN - CLEAR FLAG - SZB IF OPERATOR DESIRES CONTROL, JMP $TYPE ACKNOWLEDGE. JMP $XEQ TRANSFER TO EXECUTE SECTION. * * I/O DEVICE COMPLETION ERROR FROM DRIVER * (A) = ERROR CODE * L.70 LDA TEMP3 CPA .3 IF PARITY ERROR, CCE,RSS CHECK FOR DISC. JMP IOERR - OTHER ERROR CONDITION - * LDA EQT5,I IF AND B36K DEVICE CPA B14K IS DISC, PUT JMP DISCE OUT SPECIAL MESSAGE. * LDA .3 PARITY ERROR ON JMP IOERR OTHER DEVICE, PRINT DIAG. * * * DISC ERROR PROCESSING (SYSTEM/USER) * DISCE LDA TLOG (A) = ERROR TRACK ADDRESS. JSB $CVT3 CONVERT TO DECIMAL ASCII. INA DLD A,I SET DECIMAL TRACK DST DMSG+1 IN ERROR MESSAGE. JSB CPEQT COMPUTE EQT ENTRY # (SETS E). STA DMSG+5 SET IN ERROR MESSAGE. * LDA EQT4,I GET SUBCHANNEL ALF,ALF AND CONVERT RAL,RAL TO ASCII AND B37 JSB $CVT1 STA DMSG+7 * * LDA EQT1 SAVE DISC STA TEMP7 -EQT- ADDRESS LDA COMPL SAVE REQUEST (SYSTEM) STA TEMP8 COMPLETION ADDRESS * LDA DMSGA PRINT DIAGNOSTIC: JSB $SYMG "TRNNNN EQTXX,UYY S(OR U)" * * LDA L.52 (A)= ID SEGMENT ADDRESS LDB TEMPX GET THE SAVED STATUS AND IF (NO-ABORT SET SSB,RSS SKIP THE ABORT JSB $ABRT -- ABORT PROGRAM -- * L.71 STB TLOG SET TLOG FOR SYSTEM EXIT LDA TEMP8 RESET "COMPLETION" STA COMPL ADDRESS. LDA TEMP7 RESET EQT STA CONFL SET FLAG FOR COMPLETION. JSB $ETEQ ADDRESSES JMP L.60 * * DMSGA DEF *+1 DEC -18 DMSG ASC 9,TRNNNN EQTXX,UYY S B36K OCT 36000 * B14K OCT 14000 HED < I/O CONTROL MODULE - ERROR SECTION > * * I/O REQUEST ERROR SECTION * * PART 1: ERRORS ENCOUNTED IN ANALYSING A * USER REQUEST CAUSE A DIAGNOSTIC * TO BE PRINTED ON THE SYSTEM * TELETYPEWRITER AND THE USER * PROGRAM ABORTED. THE FORMAT OF * THE DIAGNOSTIC IS: * * 'IONN PNAME RADDR' * * AS CONSTRUCTED AND SET * BY THE ROUTINE -$ERMG- IN * THE PROGRAM <$RQST>. -NN- IS A * CODE IDENTIFYING THE ERROR TYPE. * ERR01 CLB,INB INSUFFICIENT # OF PARAMETERS RSS ERR02 LDB .2 ILLEGAL LOGICAL UNIT REFERENCE, RSS = 0 OR UNDEFINED. ERR04 LDB .4 USER BUFFER VIOLATES SYSTEM * LDA ERIO (A) = ASCII * IO *. JMP $ERAB WRITE DIAGONISTIC AND EXIT TO DISPATCHER * E07 ASC 1,07 ERIO ASC 1,IO SKP UNL $TEMP$ * PART 2: ILLEGAL REQUEST DETECTED BY * I/O DRIVER. THE REASON IS A READ OR * WRITE OPERATION IS ILLEGAL FOR THE * DEVICE OR A CONTROL REQUEST IS * MEANINGLESS FOR THE DEVICE. * AN ADDITIONAL REASON FOR TRANSFER TO THIS * SECTION IS AN "IMMEDIATE COMPLETION" (CODE 4) * RETURN FROM THE DRIVER; PROCESSED AS A * CONTROL REJECT. * * * ERROR PROCEDURE IS: * 1. IF THE REQUEST IS PROCESSED AS * BUFFERED OUTPUT, THE TEMPORARY * BLOCK IS RELEASED TO AVAILABLE * MEMORY. * * 2. THE REJECT IS IGNORED IF A SYSTEM * PROGRAM GENERATED THE REQUEST - * HOWEVER, A COMPLETION ROUTINE, * IF SPECIFIED IN THE REQUEST, IS * OPERATED. (NOTE: THIS PHILOSOPHY * IS BASED ON THE ASSUMPTION THAT * THIS CONDITION SHOULD NEVER OCCUR.) * * 3. A USER CONTROL REQUEST WHICH IS * REJECTED IS TREATED AS IF IT * WAS PERFORMED. THE PROGRAM IS * LINKED BACK INTO THE SCHEDULE LIST. * * 4. A USER READ OR WRITE REQUEST REJECT * CAUSES A DIAGNOSTIC TO BE ISSUED * AND THE PROGRAM ABORTED. SKP LST $TEMP$ ILLCD CLB CPA .4 IF CODE =4 FOR IMMEDIATE RAR,SLA COMPLETION, TREAT AS CONTROL R00 STB TEMPW ELSE SET TLOG TO 0. STA TEMP4 REJECT, SAVE CODE. LDB EQT1,I GET LOCATION OF LDA B,I ILLEGAL REQUEST (LINK ADDR.) STA TEMP0 SAVE NEXT REQUEST ADDRESS. INB GET CONTROL WORD LDA B,I OF REQUEST BLOCK STA EQT6,I SAVE FOR REXIT RAL CHECK FIELD SSA,RSS FOR TYPE OF REQUEST BLOCK. JMP R02 -USER OR SYSTEM- * STA TEMP3 SET ENTRY FLAG FOR CLASS COMP. ADB .2 BUFFERED BLOCK. LDB B,I GET TOTAL BLOCK LENGTH. STB R01+1 SET IN RELEASE CALL. LDA EQT1,I SET FWA OF BLOCK STA R01 IN RELEASE CALL. JSB $RTN RELEASE BLOCK. R01 NOP - FWA - NOP - # WORDS - JMP REXIT * R02 SLA,RSS CHECK FIELD AGAIN. JMP R03 -USER PROGRAM REQUEST- * ADB N2 GET WORD IN SYSTEM REQUEST LDA B,I CONTAINING -COMPLETION ROUTINE- STA COMPL ADDRESS OR 0 AND SAVE IT. JMP REXIT * R03 LDA TEMP4 USER REQUEST- CPA .2 CONTINUE IF CONTROL REQUEST JMP R04 REJECTED. LDA EQT1,I SET ID SEGMENT ADDRESS OF PROGRAM STA XEQT CONTAINING ERROR. ADA .8 GET POINT OF SUSPENSION ADDRESS LDB A,I GET RETURN ADDRESS STB RQRTN AND SAVE ON BASE PAGE INA SET XSUSP STA XSUSP TO POINT TO SAVED INITIAL CALL ADDRESS LDA EQT1 SAVE CURRENT STA TEMP9 EQT ENTRY ADDRESS. LDA CONFL SAVE CURRENT STA SCONF *CONTROL FLAG* LDA ERIO (A) = ASCII * IO * LDB E07 (B) = 07 FOR ILLEGAL READ/WRITE JSB $ERMG PRINT DIAGNOSTIC B2400 CLA SET XEQT STA XEQT TO ZERO TO FOURCE RELOAD LDA SCONF RESTORE STA CONFL *CONTROL FLAG* LDA TEMP9 RESTORE UNIT JSB $ETEQ EQT ENTRY ADDRESSES. JMP REXIT * R04 LDA EQT1,I SET PROGRAM ID SEGMENT STA R05+2 ADDR. IN LIST CALL. ADA .9 (A) = ADDR. OF XA IN ID SEGMENT. LDB EQT5,I SET DEVICE STATUS STB A,I WORD IN XA. LDB TEMPW STORE INA TRANSMISSION LOG STB A,I IN XB. R05 JSB $LIST CALL SCHEDULER OCT 101 TO LINK PROGRAM BACK NOP INTO SCHEDULE LIST. * REXIT LDA TEMP0 SET NEXT LIST STA EQT1,I ENTRY ADDRESS. LDA EQT6,I GET CONWORD REXI2 LDB CONFL IF THE IOC *COMPLETION* SZB SECTION IS IN CONTROL, JMP L.501 RETURN TO L.60 FOR NEXT REQUEST * SSA REJECT OCCURED IN *REQUEST* SECTION JMP $XSIO,I IF SYSTEM RETURN TO SYSTEM CALLER. JMP $XEQ ELSE GO TO THE DISPATCHER. * * SKP * * I/O DEVICE ERROR SECTION * * THIS SECTION IS ENTERED WHEN A DEVICE * IS UNAVAILABLE FOR INITIATION OF AN * OPERATION OR WHEN AN ERROR IS DETECTED * AT THE END OF AN OPERATION. A DIAGNOSTIC * IS PRINTED ON THE SYSTEM TELETYPE IN THE * FOLLOWING FORMAT: * * I/O ERROR MN EQT #NN * * WHERE NN IS THE EQT ENTRY # OF THE DEVICE * AND MN IS A MNEMONIC DESCRIBING TH;NLHE * CONDITION: * * 1. NR - DEVICE NOT READY * 2. ET - END OF TAPE OR TAPE SUPPLY LOW * 3. PE - TRANSMISSION PARITY ERROR * 4. TO - DEVICE TIMED-OUT * - NEW CODES MAY BE ADDED - * * ON ENTRY TO THE SECTION, (A) CONTAINS A # * CORRESPONDING TO THE ASSOCIATED MNEMONIC * AND EQT1 CONTAINS ADDRESS OF DEVICE. * * NOTRD CLA,INA -SPECIAL NOT READY ENTRY- * NIOERR EQU * ADA ERTBL INDEX TO ERROR CODE TABLE. LDA A,I GET MNEMONIC AND STA IOMSG+4 SET IN DIAGNOSTIC MESSAGE. * LDA EQT1 STA TEMP9 LDA EQT5,I GET STATUS WORD FROM EQT ALR,RAR SET IOR B40K FIELD TO 1, STA EQT5,I -UNIT DISABLED- * JSB CPEQT COMPUTE EQT ENTRY #. STA IOMSG+8 I/O DIAGNOSTIC. * LDA CONFL SAVE CURRENT STA SCONF *CONTROL FLAG* * LDA IOMSA (A) = ADDR. OF DIAGNOSTIC JSB $SYMG CALL TO PRINT. * LDB TEMP9 LDA SCONF RESTOR *CONTROL FLAG* STA CONFL CPB SYSTY JMP L.60 * LDA B,I GET FIELD INA WORD LDA A,I TO A. STA TEMP9 SAVE IT RSS PUT ALL WAITING PROGRAMS IOER0 LDB TEMPX,I IN THE WAIT LIST IOER1 STB TEMPX IOER2 LDA TEMPX,I GET QUEUE WORD SZA,RSS IF END JMP IOER4 GO EXIT * STA IOER3 SAVE THE ID-SEG ADDRESS INA STEP TO CON WORD LDB A,I GET THE CON WORD TO B RBL ROTATE CMB,SSB,SLB,RSS IF NOT A STANDARD USER JMP IOER0 REQUEST TRY NEXT ONE * LDB .4 STANDARD USER STB A,I SET TEMP WORD # 1 TO 4 ADA .8 STEP TO A REG. LDB A,I GET SAVED PT. OF SUSPENSION ADA N1 AND STORE STB A,I IT IN XSUSP FOR THE PGM. LDA IOER3,I GET THE NEXT LINK STA TEMPX,I RELINK THE LIST JSB $LIST PUT THE PGM IN OCT 103 THE WAIT LIST IOER3 NOP JMP IOER2 GO TRY NEXT ENTRY * IOER4 LDB TEMP9 GET THE SAVED CONWORD FOR LDA CONFL THE BAD REQUEST SZA IF CONPLETION SECTION IN CONTROL, JMP IOCX GO EXIT IOC * RBL,SLB SSB *REQUEST* SECTION. JMP $XEQ IF USER GO TO EXECUTE SECTION JMP XSIOE,I ELSE RETURN TO SYSTEM CALLER * IOMSA DEF *+1 DEC -18 IOMSG ASC 4,I/O ERR NOP ASC 3, EQT # TEMPX NOP * * I/O DEVICE ERROR MNEMONIC TABLE - ORDERED * BY ERROR CODE DESCRIBING CONDITION * ERTBL DEF * * ASC 1,NR - NOT READY - * ASC 1,ET - END OF TAPE (INFORMATION) - * ASC 1,PE - TRANSMISSION PARITY ERROR - * ASC 1,TO - TIMED-OUT - * * NEW CODES ADDED AT THIS POINT HED < IO-DEVICE TIME-OUT PROCESSOR > * * * AFTER A DEVICE IS DISCOVERED TO HAVE TIMED-OUT * BY RTIME'S $CLCK PROCESSOR,THIS * ROUTINE IS ENTERED. ITS PURPOSE IS TO * CLEAR THE PENDING IO TRANSFER AND ENTER * IOCOM IN SUCH A WAY AS TO SIMULATE AN IO * COMPLETION RETURN FROM THE DRIVER ITSELF. * * * ENTER FROM SCHEDULER MODULE: * * (A)
* * $DEVT ADA N14 POINT TO EQT JSB $ETEQ SET EQT ADDRESSES LDA EQT1,I SSA CLEAR REQ TIMED-OUT? JMP CLTIM YES, JUST CLEAR * LDA EQT4,I IOR B4K SET TIME-OUT BIT STA EQT4,I STA B SAVE WORD IN B FOR TEST AND B77 SELECT CODE TO A STA INTCD BLF,SLB IF DRIVER TO HANDLE TIME JMP CIC.6 OUT GO CALL THE DRIVER. * CLTIM JSB $CLCH CLEAR ALL CHANNELS LDA .4 SERVICED BY THIS ENTRY CLB SIMULATE COMPLETION JMP IOCOM RETURN FROM DRIVER * N14 DEC -14 HED < I/O CONTROL MODULE - DATA SECTION > * CONSTANT AND VARIABLE STORAGE AREA A EQU 0 DEFINE SYMBOLIC REFERENCES B EQU 1 FOR A AND B REGISTERS. .1 DEC 1 .2 DEC 2 .3 DEC 3 .4 DEC 4 .5 DEC 5 .6 DEC 6 .8 DEC 8 .9 DEC 9 .15 DEC 15 N1 DEC -1 * B77 OCT 77 B140K OCT 140000 B40K OCT 40000 B4K OCT 4000 * MIC0 EQU * TEMP2 LIA 6 TEMP3 SZA,RSS MX OR XE? TEMP4 JMP NMX0 NO TEMP5 LDA .CXA TEMP6 SZB,RSS MICRO? TEMP7 STA MIC4 NO, B=0 TEMP8 SZB,RSS MICRO? TEMP9 STA MX1 NO TEMP0 LDA .CYB TEMPL STA MX4 TEMPW LDA .DLD TLOG SZB,RSS COMPL STA MIC6 DMACF LDA DFXII SZB,RSS STA MX6 JMP NMX0 * CONFL CXA .CXA EQU CONFL SCONF CYB .CYB EQU SCONF HED ** I/O CONTROL - OPERATOR COMMUNICATION ** UNL $TEMP$ * * I/O MODULE // OPERATOR COMMUNICATION * * * THE SYSTEM PES FOR COMMANDS FROM THE * OPERATOR TO CONTROL THE OVERALL STATUS OF * I/O EQUIPMENT, CHANGE ASSIGNMENT OF LOGICAL * UNITS AND TO INTERROGATE THE STATUS AND * PROPERITES OF THE DEVICES IN THE EQUIPMENT * TABLE. * * OPERATOR STATEMENTS ARE PROCESSED ONLY * FROM THE DESIGNATED SYSTEM TELETYPE. THE * ROUTINE IN THE SCHEDULING MODULE * IS RESPONSIBLE FOR STATEMENT DECODE AND * PARAMETER SEPARATION AND CONVERSION. THE * ASSOCIATED STATEMENT PROCESSOR IS CALLED * TO PERFORM THE REQUESTED ACTION. THE * STATEMENT PROCESSING IS ALL TABLE-DRIVEN * AS DESCRIBED IN THE LISTING AND DOCUMENTATION * OF THE SCHEDULING MODULE. * * * TWO OF THE FOLLOWING STATEMENT PROCESSORS * MUST BE INCLUDED IN THE BASIC SYSTEM PACKAGE. * THESE ARE THE 'UP' AND 'DOWN' STATEMENTS * CONCERNING THE OVERALL STATUS OF I/O DEVICES. * THE OTHER THREE STATEMENT PROCESSORS ( LOGICAL * UNIT ASSIGNMENT, TIME-OUT, AND EQT STATUS) * ARE OPTIONAL AND MAY BE REMOVED BY DELETING * THE SECTIONS AND RE-ASSEMBLING THIS MODULE. * SKP LST $TEMP$ * * 'DOWN' STATEMENT (REQUIRED) * * FORMAT: DN,NN WHERE NN IS THE EQT # * OF THE I/O DEVICE * * ACTION: THE AVAILABILITY FIELD OF THE * REFERENCED DEVICE (EQT ENTRY #) * IS SET = 1 (UNIT DISABLED) * * CALL (FROM MESSAGE PROCESSOR): * * (A) = NN (EQT #) IN BINARY * (P) JMP $IODN * * RETURN IS TO <$XEQ> IF ACTION TAKEN OR * TO -MESS,I- TO PRINT ERROR DIAGNOSTIC * 7 * INPUT ERROR * IF NN IS ILLEGAL. * $IODN JSB $EQCK CHECK 'NN' AND SET EQT ADDRESSES. LDA EQT1 IF ATTEMPT TO 'DOWN' SYSTEM CPA SYSTY TELETYPE, IGNORE ACTION AND JMP $INER TREAT AS 'INPUT ERROR'. LDA EQT5,I SET AVAILABITY FIELD ALR,RAR =1 TO IOR B40K MEAN STA EQT5,I UNAVAILABLE. * LDB EQT1 GET EQT ADDRESS TO B JMP IOER1 -GO PUT ALL WAITERS IN THE WAIT LIST * * *$EQCK* SUBROUTINE TO CHECK LEGALITY OF AN * EQT # (IN A-REGISTER) AND TO CALL * A SUBROUTINE TO CONSTRUCT THE EQT * ENTRY ADDRESSES. * $EQCK NOP STA B ERROR CMB,INB,SZB IF EQT NO. IS ZERO SSA OR NEGATIVE CCB,RSS SKIP ADB EQT# CHECK FOR LIMITS SSB IF ANY ERROR, JMP $INER GO TO $MESS ERROR EXIT. * JSB $CVEQ SET EQT ENTRY ADDRESSES. CLB STB CONFL SET ALL THE FLAGS STB TEMP9 TO ZERO STB COMPL JMP $EQCK,I * * SKP * * ' UP ' STATEMENT (REQUIRED) * * FORMAT: UP,NN WHERE NN IS THE EQT # * OF THE I/O DEVICE * * ACTION: THE AVAILABILITY FIELD OF THE * REFERENCED DEVICE (EQT ENTRY #) * IS SET = 0 (UNIT AVAILABLE). * * IF I/O REQUESTS ARE SUSPENDED IN * THE DEVICE QUEUE, THE *IOCOM* * SECTION (AT *L.68*) IS ENTERED * TO INITIATE THE WAITING OPERATION. * * CALL (FROM MESSAGE PROCESSOR): * * (A) = NN (EQT #) IN BINARY * (P) JMP $IOUP * * RETURN IS *IOCOM* OR TO *$XEQ* IF ACTION * IS TAKEN. IF NN ILLEGAL, RETURN IS TO * *MESS,I* TO PRINT 'INPUT ERROR'. * * $IOUP JSB $EQCK CHECK 'NN' AND SET EQT ADDRESSES. $UPIO EQU * *** CAUTION - SOMEBODY DOES 'JMP $IOUP+1' FROM OUTSIDE LDA .4 RESCHEDULE ALL WAITING PGMS. JSB $SCD3 STB COMPL SET COMPLETION IN CONTROWeL FLAG JSB CLDMA HELP POWER FAIL OUT WITH DMA. * LDA EQT5,I GET AVAILABILITY * ISZ CONFL SET THE CONTROL FLAG SSA,RSS IF DOWN OR AVAIL. JMP L.60 GO TRY TO OPERATE JMP $XEQ ELSE JUST FORGIT IT. HED < I/O CONTROL MODULE - SUBROUTINE SECTION > * * SUBROUTINE: < $SYMG > (SYSTEM MESSAGE) * * PURPOSE: THIS ROUTINE PROVIDES FOR THE * OUTPUT OF SYSTEM MESSAGES AND * ERROR DIAGNOSTICS ON THE SYSTEM * TELETYPEWRITER. THE ROUTINE * MAINTAINS A 'ROTATING' BUFFER * AREA CONSISTING OF 5 10-WORD * BLOCKS - I.E., THE MAXIMUM * LENGTH OF A MESSAGE IS 18 * CHARACTERS (9-WORDS) PLUS 1 * WORD PRECEDING THE MESSAGE * WHICH CONTAINS THE CHARACTER * COUNT. * * CALL: (A) = ADDRESS OF FIRST WORD OF * MESSAGE BLOCK - THIS WORD * CONTAINS THE CHARACTER * LENGTH OF THE MESSAGE AS * A NEGATIVE VALUE. * * (P) JSB $SYMG * (P+1) -RETURN- * * ON RETURN: * (A) = 0 - MESSAGE ACCEPTED AND * MOVED TO BUFFER. * (A) NOT = 0 - BUFFER FILLED, * MESSAGE REJECTED * (E) = 0 * * $SYMG NOP JMP SBUF CHANGED TO CLE ON FIRST ENTRY LDB SY# IF BUFFER CPB .5 IS FILLED, JMP $SYMG,I REJECT EXIT. * LDB SYC SET CURRENT STB SYT1 JSB .MVW DEF .10 NOP ISZ SY# INCRE COUNT ENTRY LDA SYT1 ADA .10 (A) = NEXT ENTRY ADDR LDB SYC (B) = CURRENT ENTRY ADDRESS. CPA SBL IF NEXT EXCEEDS BUFFER, LDA SBF RESET TO FWA BUFFER STA SYC AND SAVE. * LDA SY# IF ENTRY. CPA .1 COUNT = 1, JSB SYSCL INITIATE OUTPUT. * SYS24- CLA,CLE (A) = 0 FOR EXIT WITH JMP $SYMG,I MESSAGE ACCEPTED. * * CALL <$XSIO> TO INITIATE OUTPUT * SYSCL NOP LDA B,I GET THE MESSAGE LENGTH STA SYS7 SET IN THE CALL INB STEP TO BUFFER ADDRESS STB SYS6 SET IN THE CALL JSB $XSIO OCT 1 - LOGICAL UNIT 1 - SYS TTY DEF SYS8 - COMPLETION ROUTINE ADDRESS NOP OCT 2 - ASCII WRITE - SYS6 NOP MESSAGE ADDRESS SYS7 NOP MESSAGE LENGTH OCT 0 SAYS DO NOT NEED USER MAP JMP SYSCL,I * * COMPLETION ROUTINE FROM I/O CALL * SYS8 CCA SUBTRACT 1 FROM ADA SY# ENTRY COUNT FOR STA SY# MESSAGE JUST OUTPUT. SZA,RSS IF NO MORE IN BUFFER, JMP $XEQ EXIT. * LDB SYS6 SET ADB .9 NEXT ENTRY CPB SBL ADDRESS LDB SBF JSB SYSCL INITIATE OUTPUT JMP $XEQ -EXIT. * SY# NOP SYT1 DEF XI,I DFXII EQU SYT1 FOR INITIALIZATION CODE SYC DEF SBUF SBF DEF SBUF .10 DEC 10 SKP * SUBROUTINE: <$CVEQ> * * PURPOSE: THIS ROUTINE CONVERTS AN EQT * ENTRY # TO AN EQT DISPLACEMENT * AND CALLS <$ETEQ> TO SET THE * ENTRY ADDRESSES. * * CALLING SEQUENCE: * * (A) = EQT ENTRY # * * (P) JSB $CVEQ * (P+1) -RETURN- REGISTERS MEANINGLESS * * $CVEQ NOP AND B77 MASK TO LOW BITS ADA N1 SUBTRACT 1 AND MPY .15 MULTIPLY BY 15 ADA EQTA ABSOLUTE ADDRESS. * JSB $ETEQ SET ALL 15 ADDRESSES. * JMP $CVEQ,I -RETURN- * * SUBROUTINE: * * PURPOSE: THIS ROUTINE COMPUTES THE ENTRY # * OF THE ENTRY DESCRIBED BY -EQT1-. * THE # IS CONVERTED TO DECIMAL ASCII. * * CALLING SEQUENCE: (P) JSB CPEQT * (P+1) - RETURN - * ON RETURN, (A) = # IN ASCII * * CPEQT NOP LDA EQTA SUBTRACT DEVICE CMA,INA EQT ENTRY ADDRESS ADA EQT1 FROM FWA OF EQT. CLB CLEAR B FOR DIVIDE DIV .15 DIVIDE BY 15 CCE,INA SET E FOR CONVERSION/ADJUST COUNT. * JSB $CVT1 CONVERT TO DECIMAL JMP CPEQT,I SKP * SUBROUTINE: < $ETEQ > * * PURPOSE: THIS ROUTINE SETS THE ADDRESSES * OF THE 15 WORDS OF AN * EQUIPMENT TABLE ENTRY IN THE * 15 WORDS IN BASE PAGE COMMUNICATION * AREA LABELLED -EQT1- TO -EQT15-. * * CALLING SEQUENCE: * * (A) - STARTING ADDRESS OF THE EQT * ENTRY FOR THE REFERENCED * I/O UNIT. * * (P) JSB $ETEQ * (P+1) - RETURN - (A),(B) MEANINGLESS * * THERE ARE NO ERROR RETURNS OR * ERROR CONDITIONS DETECTED. * * $ETEQ NOP MIC10 JMP MIC11 OR STA EQT1 IF NO MICRO INA STA EQT2 INA STA EQT3 INA STA EQT4 INA STA EQT5 INA STA EQT6 INA STA EQT7 INA STA EQT8 INA STA EQT9 INA STA EQT10 INA STA EQT11 INA * STA EQT12 INA STA EQT13 INA STA EQT14 INA STA EQT15 JMP $ETEQ,I * MIC11 LDB AEQ1 (A)=VALUE OF FIRST ENTRY STR 11 (B)=ADDR OF FIRST ENTRY, DO 11 WORDS LDB AEQ12 STR 4 DO LAST 4 WORDS JMP $ETEQ,I RETURN * AEQ1 DEF EQT1 AEQ12 DEF EQT12 * SKP UNL $TEMP$ * * SPECIAL SECTION "I/O CLEAR " * ENTRY POINT IS "$IOCL" * * PURPOSE: THE FUNCTION OF THIS ROUTINE * IS TO REMOVE A PROGRAM FROM AN * I/O HANG-UP CONDITION RESULTING * FROM AN INPUT REQUEST NOT BEING * COMPLETED BY THE DEVICE. * * THIS "CLEARING" PROCEDURE IS * INITIATED BY THE OPER)ATOR IN * USING THE I/O ABORT VERSION OF THE * "OF,XXXXX,1" COMMAND. THE "OF" * STATEMENT PROCESSOR IN 'SCHED' * CALLS THIS SECTION IF THE REF- * ERENCED PROGRAM IS SUSPENDED * FOR AN I/O INPUT REQUEST. * * PROCESS: THE LIST OF EACH EQT ENTRY * IS SEARCHED TO FIND THE QUEUED * REQUEST CORRESPONDING TO THE * ID SEGMENT OF THE REFERENCED * PROGRAM. THE ENTRY IS REMOVED * FROM THE LIST AND THE LIST IS * APPROPRIATELY LINKED TO REFLECT * THE CHANGE. * * IF THE ENTRY WAS THE FIRST ONE * IN THE LIST (I.E. THE ACTIVE * REQUEST), THE DEVICE'S CHANNELS * AND DMA CHANNEL, IF ASSIGNED,ARE * CLEARED. THE DEVICE'S TIME-OUT * CLOCK IS CLEARED. $ABRT IS * CALLED TO ABORT THE PROGRAM AND * CONTROL IS TRANSFERRED TO "$XEQ" * IF THE DEVICE WAS NOT CLEARED * OR TO "L.55" IN "IOCOM" TO * INITIATE THE NEXT STACKED * REQUEST (OR TO ALLOCATE THE * DMA CHANNEL). * * CALLING SEQUENCE: * * (A)= ID SEGMENT ADDRESS OF PROGRAM * * (P) JMP $IOCL * * -NO RETURN - * * SKP LST $TEMP$ ENT $IOCL * $IOCL STA TEMP1 SAVE ID SEGMENT ADDRESS. LDA EQT# SET TEMP2 = NEGATIVE CMA,INA NUMBER OF EQT STA TEMP2 ENTRIES. LDA EQTA INITIALIZE FOR * IOCL STA IOCL5 EQT ENTRY WORD IOCL0 STA IOCL6 1 ADDRESS. RAL,CLE,ERA CLEAR SIGN, SET E IF SET * IOCL1 LDA A,I GET LINK ADDRESS. CPA TEMP1 JUMP IF A JMP IOCL2 MATCH TO PROGRAM. * SZA IF NOT END OF LIST, JMP IOCL0 CONTINUE SCAN. * LDA IOCL5 SET (A) = ADDRESS OF ADA .15 NEXT EQT ENTRY. ISZ TEMP2 IF NOT END OF EQT, GO JMP IOCL TO SCAN NEXT ENTRY LIST. * $o LDA TEMP1 NOT FOUND SO JSB $ABRT JUST ABORT THE PGM JMP $XEQ -NOT FOUND, EXIT TO $XEQ * * PROGRAM REQUEST ENTRY FOUND, UNLINK REQUEST. * IOCL2 LDB A,I GET NEXT LINK AND SET RAL,ERA PASS OLD SIGN TO NEXT LINK STB IOCL6,I IN PREVIOUS LINK. * LDA TEMP1 "ABORT ISZ TEMP1 CHECK IF THIS IS A LDB TEMP1,I SYSTEM REQUEST SSB,RSS IF SO SKIP ABORT JSB $ABRT PROGRAM" * LDA IOCL5 IF PROGRAM REQUEST LDB IOCL6,I CPA IOCL6 WAS CURRENT ENTRY, SSB AND NOT NOW CLEARING, SKIP. JMP $XEQ -EXIT TO $XEQ. * JSB $ETEQ * * JSB CLDMA CLEAR ANY DMA CHANNEL ASSIGNED LDA B3.I GET CLEAR REQUEST (100003B) STA EQT6,I SET IN EQT LDA EQT5,I GET CURRENT STATUS RAL,CLE IF DOWN OR IN DMA SSA WAIT JMP $XEQ JUST LEAVE IT ALONE * ERA ELSE SET NOT BUSY STA EQT5,I AND PLANT LDA EQT4,I GET THE SELECT CODE LDB EQT2,I AND THE I.XX ADDRESS AND B77 ISOLATE THE SELECT CODE AND JSB B,I RUN THE DRIVER * * IF REQUEST ACCEPTED THEN WE MUST SET UP FOR AN INTERRUPT BY * * A) SETTING THE DEVICE BUSY * B) SETTING A TIME OUT (1 SEC. IS ARBITRARILY USED) * * IF REQUEST IS NOT ACCEPTED OR IS COMPLETED THEN: * * A) ZAP TIME OUT AND * B) GO TO IOCOM TO GET THE NEXT REQUEST * CLB,CCE FIRST ZAP TIME OUT STB EQT15,I LDB EQT1,I SET THE SIGN BIT IN EQT1 RBL,ERB FOR IOCOM (NOW OR LATER) STB EQT1,I CCE,SZA INTERRUPT EXPECTED? JMP IOCOM NO SO JUST GO TO IOCOM * LDA EQT5,I YES SO SET RAL,ERA BUSY STA EQT5,I AND LDA N100 SET UP STA EQT15,I A REASONABLE TIME OUT JMP $XEQ GO TO THE DISPATCHER * SPC 1 IOCL5 NOP IO@ CL6 NOP SKP * * ROUTINE TO CLEAR DMA CHANNEL IF ASSIGNED TO DEVICE * CLDMA NOP LDB INTBA GET THE INTERRUPLE ADDRESS TO B LDA B,I AND DMA 6 ENTRY TO A RAL,CLE,ERA CLEAR THE SIGN BIT CPA EQT1 THIS CHANNEL ASSIGNED? CLA,RSS YES- SKIP JMP IOCL3 NO TRY NEXT CHANNEL * CLC 6 CLEAR CHANNEL STF 6 6. STA B,I SET IT AVAILABLE IN INTBA * IOCL3 INB STEP TO DMA 7 ENTRY LDA B,I GET TO A AND RAL,CLE,ERA CLEAR THE SIGN BIT CPA EQT1 THIS CHANNEL ASSIGNED? CLA,RSS YES - SKIP JMP CLDMA,I NO - EXIT CHANNELS CLEARED * CLC 7 CLEAR CHANNEL 7 STF 7 AND STA B,I MAKE IT AVAILABLE. JMP CLDMA,I * * ROUTINE TO CLEAR ALL CHANNELS SERVICED BY EQT ENTRY * $CLCH NOP JSB CLDMA CLEAR DMA CHANNEL IF ASSIGNED LDA INTLG STORE INTERRUPT CMA,INA TABLE LENGTH- ADA .2 RELATED INDEX STA TEMPW LDA CLR10 STORE INITIAL STA CLCSC CLC S.C. LDA INTBA INSTRUCTION ADA .2 CLRNX LDB A,I GET NEXT TABLE ENTRY- CPB EQT1 DOES IT REFERENCE THIS EQT? CLCSC CLC 00B YES-GO CLEAR IT ISZ TEMPW THRU TABLE? INA,RSS NO-INDEX TO NEXT ENTRY JMP $CLCH,I YES-EXIT * ISZ CLCSC JMP CLRNX * CLR10 CLC 10B B3.I OCT 100003 N100 DEC -10 HED * $SYMG BUFFER AND PRIVLEDGE I/O CONFIGURE SECTION * * SBUF BSS 50 ORG SBUF PUT IOC CONFIGURING ROUTINE IN BUFFER STA SBUF SAVE THE A REG. CLA STA $ZZZZ ZERO THE ABORT LIST STA DUMMY,I ZAP THE PRIV. TRAP CELL. CLA,INA STA MPTFL SET MPTFL TO 'MP' ALWAYS OFF LDA DUMMY GET THE DUMMY I/O ADDRESS SZA,RSS IF NONE JMP NOPRV GO EXIT < ADA CLCP CONFIGURE THE DUMMY ADDRESSES STA CLC2,I USE INDIRECTS TO AVOID LINKS XOR STCP STA STC2,I STC STA STCP XOR STFP AND STA STF2,I AND STF STA STFP STCP OCT 4000 STFP OCT 600 NOPRV LDA CLE REPLACE CALL TO HERE STA $SYMG+1 WITH A CLE * LDB $MIC SZB DO WE HAVE MICRO? JMP MIC0 YES STB MIC2 STB MIC4 STB MIC6 LDA SAXAI STA MIC LDA LBEQ1 STA MIC8 LDA SAEQ1 STA MIC10 JMP MIC0 * NMX0 LDA SBUF RESTORE A SZA DUMMY MESSAGE FOR NO TIMER? JMP $SYMG+1 NO, CONTINUE THE MESSAGE BIT JMP $SYMG,I YES, RETURN NOW SPC 2 SAXAI STA XA,I LBEQ1 LDB EQT1 SAEQ1 STA EQT1 CLE CLE CLCP CLC 0 STC2 DEF SW1 STF2 DEF STF1 CLC2 DEF SW2 * L EQU 50+SBUF-* ERROR HERE MEANS WE RAN OUT OF BUFFER ORR LEAVE THE BUFFER SBL DEF * * ORG * SIZE OF MODULE HED ** SYSTEM BASE PAGE COMMUNICATION AREA ** XI EQU 1647B . EQU 1650B ESTABLISH ORIGIN OF AREA * * SYSTEM TABLE DEFINITION * * EQTA EQU .+0 FWA OF EQUIPMENT TABLE EQT# EQU .+1 # OF EQT ENTRIES DRT EQU .+2 FWA OF DEVICE REFERENCE TABLE LUMAX EQU .+3 # OF LOGICAL UNITS (IN DRT) INTBA EQU .+4 FWA OF INTERRUPT TABLE INTLG EQU .+5 # OF INTERRUPT TABLE ENTRIES * * I/O MODULE/DRIVER COMMUNICATION * EQT1 EQU .+8 ADDRESSES EQT2 EQU .+9 EQT3 EQU .+10 OF EQT4 EQU .+11 EQT5 EQU .+12 CURRENT EQT6 EQU .+13 EQT7 EQU .+14 15-WORD EQT8 EQU .+15 EQT9 EQU .+16 EQT EQT10 EQU .+17 EQT11 EQU .+18 ENTRY EQT12 EQU .+81 EQT13 EQU .+82 EQT14 EQU .+83 EQT15 EQU .+84 * CHAN EQU .+19 CURRENT DMA CHANNEL # TBG EQU .+20 I/O ADDRESS OF TIME-BASE CARD SYSTY EQU .+21 EQT ENTRY ADDRESS OF SYSTEM TTY * * SYSTEM REQUEST PROCESSOR /'EXEC' COMMU!HFBNICATION * * RQCNT EQU .+22 # OF REQUEST PARAMETERS -1 RQRTN EQU .+23 RETURN POINT ADDRESS RQP1 EQU .+24 ADDRESSES RQP2 EQU .+25 RQP3 EQU .+26 OF REQUEST RQP4 EQU .+27 RQP5 EQU .+28 PARAMETERS RQP6 EQU .+29 RQP7 EQU .+30 (SET FOR MAXIMUM OF RQP8 EQU .+31 8 PARAMETERS) * * DEFINITION OF SYSTEM LISTS (QUEUES) * * * * DEFINITION OF EXECUTING PROGRAM ID SEGMENT' * * XEQT EQU .+39 ID SEGMENT ADDR. OF CURRENT PROG. XTEMP EQU .+41 'TEMPORARY (5-WORDS) XPRIO EQU .+46 'PRIORITY' WORD XSUSP EQU .+48 'POINT OF SUSPENSION' XA EQU .+49 'A REGISTER' AT SUSPENSION XB EQU .+50 'B REGISTER' XEO EQU .+51 'E AND OVERFLOW * * SYSTEM MODULE COMMUNICATION FLAGS * * OPATN EQU .+52 OPERATOR/KEYBOARD ATTENTION FLAG DUMMY EQU .+55 I/O ADDRESS OF DUMMY INT. CARD * * DEFINITION OF MEMORY ALLOCATION BASES * * * * UTILITY PARAMETERS * MPTFL EQU .+80 MEMORY PROTECT ON/OFF FLAG (0/1) BKLWA EQU .+87 LWA OF MEMORY IN BACKGROUND * ORG * LENGTH OF RTIOC END $CIC bHASMB,R,L,C ** DISPATCHER MODULE ** * COMPARED WITH RTE-II LISTING 750729 HED MEMORY-BASED REAL TIME DISPATCHER * DATE: 5/5/75 * NAME: XMDI * SOURCE: PROD.-SOUR. * RELOC: PROD.-RELO. * PGMR: G.A.A.,L.W.A.,E.J.W. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1975. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM XMDI,0 760608 * SUP ******************************************************************** ***** AMD ***** JUL,73 ***AMD-DSD***** MAY,75 ***** DSD ***** JUL,75 ******************************************************************** * * DISPATCHER ENTRY POINT NAMES * ENT $RENT,$ZZZZ,$XEQ ENT $MPFT,$EMRP * * DISPATCHER EXTERNAL REFERENCE NAMES * EXT $WATR,$IRT,$ABRE,$LIST EXT $MIC MIC STR,105623B,1 SEQUENTIAL STORE VALUE SKP * THE DISPA MODULE OF THE HP-2100 REAL TIME EXECUTIVE * * PERFORMS THE FOLLOWING FUNCTIONS: * * 1. IDLE LOOP WHEN NO PROGRAMS ARE SCHEDULED OR CANNOT BE * * EXECUTED. * * 2. SWITCHES PROGRAM EXECUTION SUCH THAT THE HIGHEST * * PRIORITY EXECUTABLE PROGRAM EXECUTES. * * 3. SETS THE FENCE REGISTER ACCORDING TO PROGRAM TYPE. * * 4. LOADS, SWAPS, AND EXECUTES DISC RESIDENT PROGRAMS * * * CALLING SEQUENCE * JMP $XEQ * * $XEQ LDB $ZZZZ CHECK IF PROGRAM TO BE ABORTED SZB JMP ABORT YES GO HANDLE IT LDB $LIST IF LIST NOT ENTERED SZB,RSS THEN NOTHING NEW SO JMP $IRT GO CONTINUE CURRENT PGM * 0G LDA SKEDD LOAD TOP OF SCHEDULE LIST CLB STB $LIST PREVENT NEEDLESS LIST SCANS RSS SKIP FIRST TIME LDA ZWORK,I GET THE NEXT PGM IN THE LIST SZA IF ZERO, THEN NO PROG SCHED JMP X0010 GO TO PROCESS SCHED LIST * * NO PROGRAM SCHEDULED--SETUP FOR IDLE LOOP * * * THE IDLE LOOP SECTION CONSISTS OF: * * CLEARING XEQT WORD TO SIGNIFY THAT NO PROGRAM * * CURRENTLY EXECUTING. * * STORE ADDRESS OF 4 DUMMY WORDS INTO XSUSP-XSUSP+3 * * DUE TO I/O PROCESSING. * * SET MEMORY PROTECT REGISTER TO ZERO. * * CALL INTERRUPT RESTORE ROUTINE, $IRT * JUMP TO * * * * STA FENCE SET THE FENCE TO ZERO LDA $S.ID JSB $X041 SET UP SYSTEM ID JMP $IRT GO TO IDLE LOOP * IDLE JMP * IDLE LOOP * $S.ID DEF *+1 ADDR OF SYSTEM ID SEGMENT OCT 0,0,0,0,0,0,0 DEF IDLE PRIMARY ENTRY DEF IDLE INITIAL POINT OF SUSPENSION OCT 0,0,0 ASC 3,IDLE! OCT 0,0,0,0,0,0 SKP ABORT LDA B,I GET POSSIBLE NEXT PGM STA $ZZZZ AND SET IT FOR ABORT CLA CLEAR THE XSUSP ADDRESS STABI STA B,I FOR THE NEXT START ADB DM8 BACK UP TO ID-SEG ADDRESS STB A SAVE THE ID-SEG. ADDRESS STB TMP A FEW TIMES JSB $ABRE RELEASE ANY RE-ENTRANT MEMORY. * LDB TMP JSB $WATR SCHEDULE ANYONE WAITING JMP $XEQ ABORTION DONE. * SKP * THE SWITCHING SECTION USES THE SCHEDULE LIST TO DETERMINE * * WHICH PROGRAM TO EXECUTE-STARTING FROM TOP OF LIST.  * * IF PROGRAM FROM LIST OF LOWER OR EQUAL PRIORITY, * * THEN EXECUTION OF CURRENT PROGRAM CONINUES. * * IF PROGRAM FROM LIST OF HIGHER PRIORITY AND * * TYPE EITHER REAL TIME RESIDENT OR BACKGROUND * * RESIDENT, EXECUTION SWITCHING TAKES PLACE.* * TYPE IS BACKGROUND DISC RESIDENT, * * GO TO BACKGROUND DISC PROCESSING. * * TYPE IS REAL TIME DISC RESIDENT, GO TO REAL * * TIME DISC RESIDENT PROCESSING * * X0010 STA ZWORK SCHED LIST PROG ID SEG ADDRESS ADA D6 STA ZPRIO PRIORITY ADDRESS ADA D8 STA ZTYPE TYPE ADDRESS ADA D7 STA ZMPID MAP WORD ADDRESS * LDA XEQT ANY PROGRAM CURRENTLY EXECUTING? SZA,RSS YES, TEST FOR HIGHEST PRIORITY JMP X0030 NO, EXECUTE NEW SCHEDULED PROG ADA D15 CHECK STATUS OF XEQT ID SEGMENT LDA A,I AND D15 MASK TO MAJOR STATUS CPA D1 RSS SCHEDULED-SO GO TO CHECK PRIORITY JMP X0030 NOT SCHEDULED -SO GO SWITCH LDA XPRIO,I LOAD TEST PROGRAM PR CMA,INA MAKE NEGATIVE ADA ZPRIO,I SUPTRACT FROM CURRENT PGM PR. SSA,RSS IF SIGN A=0 THEN PROG OF HIGHER PR JMP RNOLD CURR PROG HIGHER PRIOR THAN SCHED PROG * * RNOLD LDA XEQT RESET POINTERS FOR CURR PROG STA ZWORK SINCE WE WILL NOT RUN SCHED PROG ADA D14 STA ZTYPE ADA D7 STA ZMPID JMP $RENT * * X0030 EQU * CLA STA MPN STORE MPFT INDEX LDA ZWORK ADA MI GET ADR FOR INDEX REGISTERS STA XI SET POINTER TO INDEX REGISTERS * LDA ZWORK IF SAME AS CURRENT PGM CPA XEQT THEN JMP $RENT SKIP BASE PAGE SET UP. JSB $X041 SET UP BASE PAGE ID SEG PTRS LDB XSUSP,I CHECK IF PROGRAM SUSPENDED CMB,INB,SZB IF SO THEN JMP $RENT GO SET IT UP LDB XPENT,I GET PRIMARY ENTRY PT. STB XSUSP,I SET ENTRY ADDRESS * * CHECK IF PT OF SUSPENSION IN LIBRARY AREA * $RENT EQU * LDB XTEMP+4 GET THE RENT BIT ADB D15 LDB B,I GET THE WORD BLF,RBL ROTATE TO PUT RENT BIT IN SIGN SSB,RSS IF RENT NOT IN CONTROL JMP X0028 GO SET FENCE LDA LBORG SET THE LIBRARY FENCE JMP X0029 GO SET IT UP * * * $X041 NOP SET UP B.P. ID SEG PTRS LDB DM12 (12 WORDS) STB TMP LDB XQDEF PUT THEM AT XEQT STA XEQT X0041 JMP MIC OR STA B,I IF NO MICRO INA INB ISZ TMP JMP X0041 JMP $X041,I RETURN WHEN DONE * XQDEF DEF XLINK * MIC STR 12 CALL MICROCODE JMP $X041,I RETURN * * * * SET MEMORY PROTECT ACCORDING TO PROG TYPE * * X0028 LDA MPN GET MPFT INDEX ADA $MPFT LDA A,I GET FENCE X0029 STA FENCE * * RESTORE REGISTERS, MEMORY PROTECT, AND TURN ON INTERRUPT SYSTEM * JMP $IRT GO EXECUTE THE PROGRAM SPC 3 * XEQ PROCESSOR--BUFFERS, CONSTANTS, POINTERS, ETC * * ZWORK NOP SCHED LIST ID SEGMENT ADDRESS ZPRIO NOP SCHED LIST PRIORITY LIST ZTYPE NOP SCHED LIST TYPE ADDRESS ZMPID NOP SCHED LIST MAP & MPFTI WORD TMP NOP TEMPORARY WORKING STORAGE * D1 DEC 1 D6 DEC 6 D7 DEC 7 D8 DEC 8 D14 DEC 14 D15 DEC 15 DM8 DEC -8 DM12 DEC -12 * $EMRP NOP FWA SAM-1 (SET BY GENERATOR) $MPFT NOP ADDR M.P. FENCE TABLE (SET BY GENERATOR) MPN NOP INDEX TO MPFT, BP FLAG MI DEC -2 NEG # OF INDEX REGS SPC 2 * MPFT INDEX * * BUILT BY THE GENERATOR AS FOLLOWS: * 0 ON-LINE ADDED PROGRAM, NO COMMON * 1 SYSTEM GENERATLED PROGRAM, NO COMMON * 2 RT COMMON, ANY PROGRAM * 3 -- NOT USED -- * 4 SSGA, ANY PROGRAM * * HED SYSTEM START UP ******************************************************************** * THE START SECTION: * * CLEARS INTERRUPT SYSTEM * * INITIALIZES MAPS IN RTE-M III * ******************************************************************** * $ZZZZ NOP CLC 0 CLEAR INTERRUPT SYSTEM LDB STABI LDA $MIC SZA,RSS ANY MICRO? STB X0041 NO, PUT STA B,I THERE JMP $ZZZZ,I END DISPATCHER INITIALIZE * ORG * SIZE OF MODULE HED ** SYSTEM BASE PAGE COMMUNICATION AREA ** * * *** SYSTEM BASE PAGE COMMUNICATION AREA *** * XI EQU 1647B . EQU 1650B ESTABLISH ORIGIN OF AREA * * SYSTEM TABLE DEFINITION * * * DEFINITION OF SYSTEM LISTS (QUEUES) * * SKEDD EQU .+33 'SCHEDULE' LIST, * * DEFINITION OF EXECUTING PROGRAM ID SEGMENT' * * XEQT EQU .+39 ID SEGMENT ADDR. OF CURRENT PROG. XLINK EQU .+40 'LINKAGE' XTEMP EQU .+41 'TEMPORARY (5-WORDS) XPRIO EQU .+46 'PRIORITY' WORD XPENT EQU .+47 'PRIMARY ENTRY POINT' XSUSP EQU .+48 'POINT OF SUSPENSION' * * * DEFINITION OF MEMORY ALLOCATION BASES * * LBORG EQU .+61 FWA OF RESIDENT LIBRARY AREA * * UTILITY PARAMETERS * FENCE EQU .+85 MEM PROTECT FENCE ADDRESS * * * * A EQU 0B LOCATION OF A REGISTER B EQU 1B LOCATION OF B REGISTER * ORG * PROGRAM LENGTH END $ZZZZ =OASMB,R,L,C,N HED * REAL-TIME EXECUTIVE MEMORY ALLOCATION * * DATE: 5/05/75 * NAME: XMAL * SOURCE: 92060-18017 * RELOC: 92060-16017 * PGMR: G.A.A.,L.W.A.,E.J.W. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1975. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * IFN * BEGIN NON-DMS CODE *************** NAM XMAL,0 751121 *** END NON-DMS CODE *************** XIF IFZ ***** BEGIN DMS CODE *************** NAM XMAL,0 760317 ******* END DMS CODE *************** XIF * ENT $ALC,$RTN EXT $LIST,$WORK,$MIC * * REQUESTS MAY BE MADE TO ALLOCATE AND RELEASE BUFFERS * FROM THE MEMORY AVAILABLE AFTER LOADING. * * 1. ALLOCATE: CALLING SEQUENCE - * (P) JSB $ALC * (P+1) (# OF WORDS NEEDED) * (P+2) -RETURN NO MEMORY EVER (A)=-1, (B)=MAX EVER * (P+3) -RETURN NO MEMORY NOW (A)=0, (B)=MAX NOW * (P+4) -RETURN OK (A)=ADDR , (B)=SIZE OR SIZE+1 * * 2. RELEASE BUFFER TO AVAILABLE MEMORY * (P) JSB $RTN * (P+1) (FWA OF BUFFER) * (P+2) (# OF WORDS RETURNED) * (P+3) -RETURN- (ALL REGISTERS DESTROYED) * * IF A REQUEST FOR A BUFFER OF LENGTH X CANNOT BE FILLED * DURING A GIVEN CALL, RETURN IS MADE WITH: * (A) = 0 * IF, WHEN BUFFER REQUESTED, - (SMEM ) - SHOWS INSUFFICIENT CORE * AVAILABLE TO CONTAIN A BUFFER OF THE LENGTH REQUESTED, * THEN RETURN IS MADE WITH: * (A) = -1 * (B) = MAXIMUM LENGTH BUFFER THAT THE PROGRAM MAY ALLOCATE. * TO FIND OUT HOW LARGE A BUFFER MAY BE ALLOCATED, USE THE CALL * JSB $ALC *  DEC 32767 * BLOCKS OF MEMORY AVAILABLE FOR OUTPUT BUFFERING ARE LINKED THROUGH * THE FIRST TWO WORDS OF EACH BLOCK - * WORD1 - LENGTH OF BLOCK * WORD2 - ADDRESS OF NEXT BLOCK (OR 77777 IF THIS IS LAST BLOCK) * THE ALLOCATOR 'TRANSFERS' THE UPPER END OF A BLOCK TO IOC AND * SHORTENS THE LENGTH OF THE BLOCK BY THE AMOUNT 'TRANSFERRED' * REGISTERS ARE NOT PRESERVED SKP SKP 2 $ALC JMP ALCIN INIT (FROM $STRT, RETURNS TO $WORK) SPC 1 IFZ ***** BEGIN DMS CODE *************** RSA STORE MEU STATUS IN MEM RAL,RAL STA ALCST SJP *+2 ******* END DMS CODE *************** XIF SPC 1 LDA $ALC,I GET THE LENGTH OF THE REQUEST STA ADX AND SAVE IT STA XTEMP,I SAVE IN ID SEG IN CASE SUSPEND LDB A ADA SMEM ENOUGH MEMORY NOW SSA TO HONOR THE REQUEST? JMP .A1 YES, GO ALLOCATE. ADB MAXEV SSB,RSS WHAT ABOUT LATER? JMP ERETN NEVER! ISZ $ALC MAYBE, BUT NOT NOW. REJ CLA,CLE,RSS A=0, E=0 NOT NOW ERETN CCA,CLE A=-1,E=0 NOT EVER JMP SETB RETURN * .A1 ISZ $ALC TRY AN ALLOCATION CCA SET CORE AVAIL. NOW TO 0 STA ALCIN LDB PNTRA START THE SEARCH LOOP WITH .A2 STB BAD SET LAST BUFFER ADDRESS CLE,INB STEP TO THE NEXT ADDRESS LDB B,I GET THE NEXT SEGMENT ADDRESS CPB M7 IF 77777 THEN END OF LIST AND NO JMP NOMOR MEMORY SO REJECT LDA B,I CHECK TO SEE IF THIS IS THE ADA ALCIN LARGEST LENGTH SO FAR LDA B,I GET THE LENGTH CMA,SEZ SET NEG(-1) AND IF STA ALCIN LARGEST SO FAR SAVE ADA ADX WILL IT SATISFY THE REQUEST? CMA,SSA IF ZERO OR NEGATIVE USE IT JMP .A2 ELSE GO TRY NEXT ONE ADA DM2 IS BLOdzCK AT LEAST 2 WORDS CCE,SSA LARGER THAN REQUEST? JMP .A4 NO-ALLOCATE WHOLE BLOCK ADA D2 (A)=LENGTH(I)-L(X) STA B,I SET NEW L(I) ADA B (A)=BUFFER ADDRESS JMP SETA RETURN TO USER * .A4 LDA B,I ALLOCATE ENTIRE BLOCK. STA ADX SET BUFFER LENGTH STB A BUFFER ADDRESS TO A .INB CCE,INB SET E FOR ACCEPTED RETURN LDB B,I GET THE POINTER TO THE NEXT BLOCK ISZ BAD STEP TO POINTER ADDRESS IN LAST STB BAD,I BLOCK AND SET THE POINTER SETA ISZ $ALC SETB LDB MAXEV SET B FOR REJECT SZA,RSS IF JUST FOR NOW RESET TO MAX LDB SMEM AVAILABLE NOW CMB,SEZ SET POSITIVE AND IF REQUEST LDB ADX SATISFIED SET TO LENGTH ISZ $ALC STEP RETURN ADDRESS SPC 1 IFN * BEGIN NON-DMS CODE *************** JMP $ALC,I RETURN *** END NON-DMS CODE *************** XIF SPC 1 IFZ ***** BEGIN DMS CODE *************** JRS ALCST $ALC,I RETURN, RESTORE STATUS TO MEU ALCST BSS 1 ******* END DMS CODE *************** XIF SPC 1 * NOMOR LDA ALCIN PICK UP MAX LEFT DURING SEARCH STA SMEM UPDATE MAX AVAILABLE NOW JMP REJ NOW RETURN * * $RTN NOP ENTRY POINT FOR BUFFER RETURN SPC 1 IFZ ***** BEGIN DMS CODE *************** RSA STORE MEU STATUS RAL,RAL STA ALCST SJP *+2 ******* END DMS CODE *************** XIF SPC 1 LDA $RTN,I (A) = FWA RETURN BUFFER (ADX) STA ADX CMA,INA SET NEG AND STA SAVA SAVE ISZ $RTN * LDB $RTN,I # OF WORDS RETURNED (X) ADB DM2 SSB <2? JMP RETNR BUFFER TOO SMALL - IGNORE MIC1 JMP NMIC1 LDB PNTRA GET THE STARTING POINTER OCT 105627 CALL MICRO. (A)=-ADDR,(B)=PNTRA STB BAD JM\P .R12 * NMIC1 LDA PNTRA GET STARTING POINTER .R11 STA BAD BAD _ AAD NMIC3 INA LDB A,I AAD _ NEXTBUFAD STB A A _ PNTR ADB SAVA AAD -ADX CMB,SSB,INB,SZB ADX-AAD>=0? RSS SKIP IF FOUND JMP .R11 ELSE CONTINUE * * * LDB BAD GET LOWER BUFFER ADDRESS .R12 CPB PNTRA IF LOCATE POINTER JMP .R3 ASSUME NO OVERLAP ADB B,I ADD LENGTH AND ADB SAVA SUBTRACT NEW BLOCK ADDRESS CMB,SSB,INB,RSS IF NEG NO OVERLAP SO JMP .R3 JUMP ADB $RTN,I ELSE COMPUTE NEW LENGTH ADB BAD,I NOW HAVE NEW +OLD-OVERLAP .R4 STB BAD,I SET LENGTH ;CHECK FOR HIGH OVER- ADB BAD LAP COMPUTE END OF BLOCK CMB,CLE,INB AND SUBTRACT FROM THE HIGH BLOCK ADB A A HAS HIGH BLOCK ADDRESS SEZ,CLE,SZB IF RESULT POSITIVE JMP .R5 JUMP ADB A,I ADD OLD UPPER LENGTH ADB BAD,I CURRENT LENGTH STB BAD,I NEW+OLD-OVERLAP CLE,INA GET POINTER AND BRING LDA A,I DOWN TO NEW BLOCK .R5 LDB BAD,I SAVE MAX LENGTH THIS RETURN ISZ BAD STEP TO POINTER ADRRESS STA BAD,I SET THE POINTER LDA SMEM CHECK TOO SEE IF THIS LENGTH ADA B ADD CURRENT MAX CMB,SEZ,CLE SET NEG; NEW MAX? STB SMEM YES; SET IT RETNR ISZ $RTN MEM16 LDB SUSP3 GET SUSPENSION LIST PTR SZB,RSS IF END OF LIST JMP MPRTN RETURN. * LDA B INA PICK UP XTEMP,I FOR LDA A,I BLOCK SIZE REQUESTED. ADA SMEM COMPARE TO MAX NOW CMA,SSA,INA,SZA ENOUGH YET? JMP MPRTN NO, TOO BAD. JSB $LIST YES, SCHEDULE PROGRAM. OCT 401 JMP MEM16 TRY NEXT PROGRAM TOO. * .R3 ISZ BAD NO LOW OVERLAP SET NEW BLOCK LDB ADX ADDRESS IN LOW BLOCK STB BAD,I TO LIN?K THE BLOCKS STB BAD SET POINTER FOR HIGH BLOCK CHECK LDB $RTN,I SET B TO THE LENGTH OF RETURN JMP .R4 CHECK FOR HIGH OVERLAP * MPRTN EQU * SPC 1 IFN * BEGIN NON-DMS CODE *************** JMP $RTN,I RETURN *** END NON-DMS CODE *************** XIF SPC 1 IFZ ***** BEGIN DMS CODE *************** JRS ALCST $RTN,I RETURN, RESTORE DMS STATUS ******* END DMS CODE *************** XIF SPC 1 * * PNTRA DEF SMEM DUMMY BLOCK ADDRESS(DON'T MESS!) SMEM OCT -1 DUMMY BLOCK LENGTH (NOT USED) PNTR OCT 77777 DUMMY BLOCK END (DON'T MESS!) BAD NOP SAVA NOP M7 OCT 77777 DM2 OCT -2 D2 OCT 2 ADX NOP * ALCIN LDA SMEM INITIALIZATION CODE MAXEV STA * MAX SIZE BLOCK EVER AVAILABLE CLB LDA $MIC SZA DO WE HAVE MICROCODE? STB MIC1 YES JMP $WORK JMP TO NEXT STARTUP ROUTINE * A EQU 0 B EQU 1 SUSP3 EQU 1714B XTEMP EQU 1721B * BSS 0 LENGTH OF PROGRAM * END $ALC pAASMB,R,L ** RT MESSAGE MODULE ** HED RT MESSAGE MODULE * NAME: XASCM * SOURCE: 92060-18015 * RELOC: 92060-16015 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1975. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM XASCM 92060-16015 REV.A 741120 * SUP * ENTRY REFERENCE NAMES * ENT $OPER,$ERIN,$NOPG,$ILST,$NOLG,$LGBS * ******************************************************************** * * THE RTE MESSAGE MODULE CONTAINS ALL THE FIXED MESSAGES THE * SYSTEM OUTPUTS TO THE USER. * * THESE MESSAGES CONSISTS OF A CHARACTER COUNT (NEGATIVE) * FOLLOWED BY THE ASCII MESSAGE. * * THE ENTRY POINT IS ON A DEF TO THE ABOVE MESSAGE. * ******************************************************************** * $ILST DEF *+1 ILLEGAL STATUS ERROR MESSAGE DEC -14 ASC 7,ILLEGAL STATUS * $NOLG DEF *+1 DM12 DEC -12 ASC 6,NO LGO SPACE * $LGBS DEF *+1 DM10 DEC -10 ASC 5,LGO IN USE * $OPER DEF *+1 OPERATION CODE ERROR MESSAGE DEC -12 ASC 6,OP CODE ERR * $NOPG DEF *+1 NO SUCH PROGRAM ERROR MESSAGE DEC -12 NO ASC 6,NO SUCH PROG * $ERIN DEF *+1 INPUT ERROR MESSAGE DEC -12 ASC 6,INPUT ERROR * END $ERIN RASMB,R,L,C NAM XMDU 760608 ENT $QCHK * $QCHK NOP ISZ $QCHK NO OVERFLOW, RETURN OK JMP $QCHK,I RETURN * ENT $SABR,$MPT1,$MPT4,$MPT5,$MPT7 EXT $WORK,$XEQ,$LIST,$ERMG,$ABRT,$IOCL * A EQU 0 B EQU 1 * $SABR NOP STB TEMPH SAVE ID SEG ADDR ADB D16 INDEX TO TIME-LIST WORD JSB $TREM REMOVE FROM TIME-LIST LDB TEMPH JSB TERM TERMINATE PROG JMP $SABR,I RETURN * TERM NOP JSB $LIST MOVE PROG TO DORMANT STATE OCT 400 LDB $WORK ADB D20 INDEX TO FATHER WORD LDA B,I AND B7400 KEEP ONLY RE,RM,RN FLAGS STA B,I JMP TERM,I RETURN * * $MPT1 CLA EXEC (6) TERMINATION LDA RQP2,I SZA OPTION WORD = 0? JMP ERQ1 NO, ERROR 'RQ' * LDB XEQT (B) = ID SEG ADDR LDA RQRTN STA XSUSP,I SET RETURN ADDR CLA IN CASE RQP3 NOT GIVEN. LDA RQP3,I ADA M2 SSA OPTION < 2 ? JMP MPT1B YES, TREAT AS NORMAL * CMA,INA,SZA,RSS JMP SOFT (2) SOFT ABORT * INA,SZA,RSS JMP HARD (3) HARD ABORT * MPT1B JSB TERM DO TERMINATE STUFF JMP $XEQ RETURN TO DISPATCHER * SOFT JSB $SABR DO SOFT ABORT JMP $XEQ RETURN TO DISPATCHER * HARD LDA D15 (B) STILL HAS ID SEG ADDR ADA B INDEX TO STATUS WORD LDA A,I AND D15 JUST KEEP STATUS PART STA B LDA XEQT CPB D2 I/O SUSPENDED? JMP $IOCL YES, KILL I/O * JSB $ABRT FINISH THE ABORT JMP $XEQ RETURN TO DISPATCHER * SPC 4 $MPT4 EQU * DUMMY ENTRY $MPT5 EQU * DUMMY ENTRY $MPT7 EQU * DUMMY ENTRY ERQ1 LDA RQ1 NONE OF ABOVE LDB BLANK JSB $ERMG JMP $XEQ * RQ1 ASC 1,RQ BLANK ASC 1, D2 DEC 2 D15 DEC 151 D16 DEC 16 D20 DEC 20 TEMPH NOP B7400 OCT 7400 M2 DEC -2 * RQRTN EQU 1677B RQP2 EQU 1701B RQP3 EQU 1702B XEQT EQU 1717B XSUSP EQU 1730B * * * ENT $CLCK,$TIME,$TIMV,$SCLK,$MPT6 EXT $XEQ,$SYMG $TIME OCT 16000 OCT 177650 OCT 3573 * $CLCK JMP $XEQ * $TIMV NOP JMP *-1,I * $SCLK NOP CLA NO MESSAGE IF NO TIMER & NO CONSOLE JSB $SYMG NEED TO INITIALIZE MIO MODULE JMP $XEQ * * $MPT6 LDA RQRTN STA XSUSP,I JMP $XEQ * * ENT $TADD,$TREM,$TLST,$ETTM,$TIMR ENT $ITRQ,$TMRQ,$ONTM,$TIRQ,$CHTO,$STRQ EXT $MSEX,$LIST * $TADD NOP JMP *-1,I $TREM NOP JMP *-1,I $ETTM NOP JMP *-1,I $TIMR NOP JMP *-1,I $TLST NOP JMP *-1,I $ITRQ NOP $TIRQ NOP $TMRQ NOP $ONTM NOP NO CONSOLE, SO DUMMY IT UP $STRQ NOP $CHTO CLA JMP $MSEX * * ENT $LUPR,$EQST,$BLRQ,$PRRQ EXT $MSEX * $LUPR EQU * $EQST EQU * $BLRQ EQU * $PRRQ EQU * CLA JMP $MSEX * ENT $MIC $MIC NOP * ENT .MVW .MVW NOP STA .A LIA 6 SZA,RSS MX OR XE COMPUTER? JMP NMX0 NEITHER CCA ADA .MVW GET P+1 STA .MVW CALCULATE P LDA MVW STA .MVW,I PATCH INSTRUCTION LDA .A RESTORE A JMP .MVW,I GO DO MVW THING * NEITHER MX NOR XE NMX0 LDA .MVW,I MICRO CODE MOVE REPLACEMENT LDA A,I GET THE COUNT ISZ .MVW STEP TO NOP (NOP IS RETURN) SZA,RSS JMP OUT SKIP MOVE IF ZERO COUNT * CMA,INA SET IT -VE STA COUNT SET COUNTER LOOP LDA .A,I GET WORD STA B,I SET IN DESTINATION INB STEP DESTINATION ISZ .A SOURCE ISZ COUNT AND COUNT JMP LOOP IF NOT DONE LOOP * OUT LDA .A PUT NEXT LOC IN A JMP .MVW,I AND RETURN g * MVW MVW 0 .A EQU *-1 COUNT NOP END END ՛ n 92060-18050 1805 S 0122 &AN3F0 RTE-III 7900 DISC ANSWERS             H0101 &LISTF,,32767, * LIST FILE YES 30 * EST # TRACKS !SYSTM,,32767, * 02-1-78 7900 * TARGET DISC 11 203,0 * SUBCHANNEL 0 203,0 * SUBCHANNEL 1 /E 48 1 * SYSTEM SUBCHANNEL NO * AUX DISC 10 * TBG 0 * PI NO * ACCESS COMMON YE * FG CORE LOCK YE * BG CORE LOCK 50 * SWAP DELAY 32 * MEM SIZE !BOOT,,32767, * BOOT FILE LINKS IN CURRENT MAP ALL REL,%CR3SY,,32767 REL,%SYLIB,,32767 REL,%LDR3 ,,32767 REL,%BMPG1,,32767 REL,%BMPG2,,32767 REL,%BMPG3,,32767 REL,%BMLIB,,32767 REL,%$CMD3,,32767 REL,%EDITR,,32767 REL,%DVR00,,32767 REL,%4DV05,,32767 REL,%DVR12,,32767 REL,%DVA12,,32767 REL,%DVR23,,32767 REL,%DVR31,,32767 REL,%ASMB ,,32767 REL,%XREF ,,32767 REL,%WHZT3,,32767 REL,%RT3G1,,32767 REL,%RT3G2,,32767 REL,%SWTCH,,32767 REL,%SAVE ,,32767 REL,%RESTR,,32767 REL,%COPY ,,32767 REL,%VERFY,,32767 REL,%DBKLB,,32767 REL,%RLIB1,,32767 REL,%RLIB2,,32767 REL,%FF4.N,,32767 /E D.RTR,1,1 WHZAT,3,1 ASMB,3,95 XREF,3,96 LOADR,3,97 EDITR,3,50 $$CMD,3 /E .MPY,RP,100200 .DIV,RP,100400 .DLD,RP,104200 .DST,RP,104400 /E 5 * BLANK ID SEGS 10 * BLANK BG SEG ID SEGS 2 * # PARTITIONS 100 * FWA BP 5 * I-O CLASSES 5 * LU MAPPINGS 5 * RN'S 100,400 * BUFFER LIMITS 11,DVR31,D * EQT 1 - 7900 13,DVR05,B,X=13,T=12000 * EQT 2 - 2644 16,DVR23,D,B,T=9999 * EQT 3 - 7970 MT 22,DVR02,B,T=50 * EQT 4 - PUNCH 21,DVR12,B,T=100 * EQT 5 - 2767 LP   14,DVR00,B * EQT 6 - 2600 TTY 15,DVR01,T=50 * EQT 7 - PHOTOREADER 20,DVA12,B,T=100 * EQT 8 - 2607 LP /E 2,0 * LU 1 - 2644 CONSOLE 1,1 * LU 2 - 7900, UPPER 0 * LU 3 2,1 * LU 4 - CTU, LEFT 2,2 * LU 5 - CTU, RIGHT 8,0 * LU 6 - 2607 LP 6,0 * LU 7 - 2600 TERMINAL 3 * LU 8 - MT 7 * LU 9 - PHOTOREADER 1 * LU 10 - 7900, LOWER 4,4 * LU 11 - PUNCH 5,0 * LU 12 - 2767 LINE PRINTER /E 11,EQT,1 * 7900 DISC 12,EQT,1 * 7900 DISC 13,EQT,2 * 2644 CONSOLE 14,EQT,6 * 2600 CONSOLE 15,EQT,7 * PHOTOREADER 16,EQT,3 * 7970 MAG TAPE 17,EQT,3 * 7970 MAG TAPE 20,EQT,8 * 2607 LP 21,EQT,5 * 2767 LP 22,EQT,4 * PHOTOREADER 77,EQT,5 * DUMMY !! /E 0 * RT COMMON 0 * BG COMMON NO * ALIGN YES * ALIGN 17 * 1ST DISC PAGE 1,15,BG * PARTITION /E LOADR,15 ASMB,15 XREF,15 EDITR,15 RT3GN,15 SAVE,15 RSTOR,15 COPY,15 VERFY,15 /E /E w   92060-18051 1726 S 0122 &AN3F5 RTE-III 7905 DISC ANSWERS             H0101 &LISTF,,32767, * LIST FILE YES 30 * EST # TRACKS !SYSTM,,32767, * 9-14-76 7905 * TARGET DISC 11 203,0,0,2,0,3 * SUBCHANNEL 0 203,103,0,2,0,3 * SUBCHANNEL 1 203,206,0,2,0,3 * SUBCHANNEL 2 203,309,0,2,0,1 * SUBCHANNEL 3 203,0,2,1,0,3 * SUBCHANNEL 4 203,206,2,1,0,2 * SUBCHANNEL 5 203,0,3,1,0,3 * SUBCHANNEL 6 203,206,3,1,0,2 * SUBCHANNEL 7 203,0,4,1,0,3 * SUBCHANNEL 8 203,206,4,1,0,2 * SUBCHANNEL 9 1024,411,0,5,0,6 * SUBCHANNEL 10 1024,617,0,5,0,6 * SUBCHANNEL 11 /E 48 0 * SYSTEM SUBCHANNEL NO * AUX DISC 10 * TBG 0 * PI NO * ACCESS COMMON YE * FG CORE LOCK YE * BG CORE LOCK 50 * SWAP DELAY 32 * MEM SIZE !BOOT,,32767, * BOOT FILE LINKS IN CURRENT MAP ALL REL,%CR3SY,,32767 REL,%SYLIB,,32767 REL,%LDR3 ,,32767 REL,%BMPG1,,32767 REL,%BMPG2,,32767 REL,%BMPG3,,32767 REL,%BMLIB,,32767 REL,%$CMD3,,32767 REL,%EDITR,,32767 REL,%DVR00,,32767 REL,%4DV05,,32767 REL,%DVR12,,32767 REL,%DVA12,,32767 REL,%DVR23,,32767 REL,%DVR32,,32767 REL,%ASMB ,,32767 REL,%XREF ,,32767 REL,%WHZT3,,32767 REL,%RT3G1,,32767 REL,%RT3G2,,32767 REL,%SWTCH,,32767 REL,%SAVE ,,32767 REL,%RESTR,,32767 REL,%COPY ,,32767 REL,%VERFY,,32767 REL,%DBKLB,,32767 REL,%RLIB1,,32767 REL,%RLIB2,,32767 REL,%FF4.N,,32767 /E D.RTR,1,1 WHZAT,3,1 ASMB,3,95 XREF,3,96 LOADR,3,97 EDITR,3,50 $$CMD,3 /E~| .MPY,RP,100200 .DIV,RP,100400 .DLD,RP,104200 .DST,RP,104400 /E 5 * BLANK ID SEGS 10 * BLANK BG SEG ID SEGS 2 * # PARTITIONS 100 * FWA BP 5 * I-O CLASSES 5 * LU MAPPINGS 5 * RN'S 100,400 * BUFFER LIMITS 11,DVR32,D * EQT 1 - 7905 13,DVR05,B,X=13,T=12000 * EQT 2 - 2644 16,DVR23,D,B,T=9999 * EQT 3 - 7970 MT 22,DVR02,B,T=50 * EQT 4 - PUNCH 21,DVR12,B,T=100 * EQT 5 - 2767 LP 14,DVR00,B * EQT 6 - 2600 TTY 15,DVR01,T=50 * EQT 7 - PHOTOREADER 20,DVA12,B,T=100 * EQT 8 - 2607 LP /E 2,0 * LU 1 - 2644 CONSOLE 1,0 * LU 2 - 7905\7920, SUBCHANNEL 0 0 * LU 3 2,1 * LU 4 - CTU, LEFT 2,2 * LU 5 - CTU, RIGHT 8,0 * LU 6 - 2607 LP 6,0 * LU 7 - 2600 TERMINAL 3 * LU 8 - MT 7 * LU 9 - PHOTOREADER 1,1 * LU 10 - 7905\7920, SUBCHANNEL 1 4,4 * LU 11 - PUNCH 5,0 * LU 12 - 2767 LINE PRINTER 1,2 * LU 13 - 7905\7920, SUBCHANNEL 2 1,3 * LU 14 - 7905\7920, SUBCHANNEL 3 1,4 * LU 15 - 7905\7920, SUBCHANNEL 4 1,5 * LU 16 - 7905\7920, SUBCHANNEL 5 1,6 * LU 17 - 7905\7920, SUBCHANNEL 6 1,7 * LU 18 - 7905  \7920, SUBCHANNEL 7 1,8 * LU 19 - 7905\7920, SUBCHANNEL 8 1,9 * LU 20 - 7905\7920, SUBCHANNEL 9 1,10 * LU 21 - 7905\7920, SUBCHANNEL 10 1,11 * LU 22 - 7905\7920, SUBCHANNEL 11 /E 11,EQT,1 * 7905 DISC 13,EQT,2 * 2644 CONSOLE 14,EQT,6 * 2600 CONSOLE 15,EQT,7 * PHOTOREADER 16,EQT,3 * 7970 MAG TAPE 17,EQT,3 * 7970 MAG TAPE 20,EQT,8 * 2607 LP 21,EQT,5 * 2767 LP 22,EQT,4 * PUNCH 77,EQT,5 * DUMMY !! /E 0 * RT COMMON 0 * BG COMMON NO * ALIGN YES * ALIGN 17 * 1ST DISC PAGE 1,15,BG * PARTITION /E LOADR,15 ASMB,15 XREF,15 EDITR,15 RT3GN,15 SAVE,15 RSTOR,15 COPY,15 VERFY,15 /E /E   92060-18052 1707 S 0122 2645A SOFT KEY UTILITY              H0101 LFTN4,B,L C PROGRAM KEYS(3,75) C C DATE: 09 FEB 77 C DIMENSION IDCB(144),IBUF(40),IREG(2),LU(5) DIMENSION NWRDS(8),IBUF2(33),IBUF3(33) DIMENSION LABL1(13,4),LABL2(13,4) DIMENSION ISTRG(45,8) C C DIMENSION TERMINAL INITIALIZATION AND LABEL DISPLAY RECORDS C INTEGER REC1(4),REC2(55),REC3(55),REC4(2) C C DIMENSION SOFT KEY ASCII COMMAND STRING RECORD C INTEGER REC5(360),REC6(2) C C DIMENSION ASCII BUFFERS C INTEGER REC7(53),REC8(51),REC9(72),REC10(35),REC11(72) INTEGER REC12(29),REC13(62),REC14(53),REC15(41),REC16(52) INTEGER REC17(19),REC18(20),REC19(16),REC20(5),REC21(12) C C EQUIVALENCES C EQUIVALENCE (REG,IREG,IA),(IREG(2),IB),(KEYN,REC9(21)) EQUIVALENCE (IERR,REC17(12)) C C LABEL EQUIVALENCES C EQUIVALENCE (LABL1(1,1),REC2(7)),(LABL2(1,1),REC3(7)) C C ASCII COMMAND STRING EQUIVALENCE C EQUIVALENCE (ISTRG(1,1),REC5(6)) C C DATA RECORD TO INITIALIZE THE TERMINAL C DATA REC1/015555B,015530B,015550B,015512B/ C C DATA RECORD TO DISPLAY THE FIRST FOUR SOFT KEY LABELS C DATA REC2/020033B,023141B,030562B,033103B,015446B,062102B, 1 020040B,020040B,020040B,020040B,020040B,020040B, 2 020040B,020040B,015446B,062100B,015503B,015446B, 3 062102B,020040B,020040B,020040B,020040B,020040B, 4 020040B,020040B,020040B,015446B,062100B,015503B, 5 015446B,062102B,020040B,020040B,020040B,020040B, 6 020040B,020040B,020040B,020040B,015446B,062100B, 7 015503B,015446B,062102B,020040B,020040B,020040B, 8 020040B,020040B,020040B,020040B,020040B,015446B, 9 062100B/ C C DATA RECORD TO DISPLAY THE SECOND FOUR SOFT KEY LABELS C DATA REC3/020033B,023141B,031562B,033103B,015446B,062102B, 1 020040B,020040B,020040B,020040B,020040B,020040B, 2 020040B,020040B,015446B,062100B,015503B,015446B, 3  062102B,020040B,020040B,020040B,020040B,020040B, 4 020040B,020040B,020040B,015446B,062100B,015503B, 5 015446B,062102B,020040B,020040B,020040B,020040B, 6 020040B,020040B,020040B,020040B,015446B,062100B, 7 015503B,015446B,062102B,020040B,020040B,020040B, 8 020040B,020040B,020040B,020040B,020040B,015446B, 9 062100B/ C C DATA RECORD TO PROTECT SOFT KEY LABEL DISPLAY AND SET UP TERMINAL C DATA REC4/015502B,015554B/ C C DATA RECORD CONTAINING COMMAND STRINGS FOR SOFT KEYS 1 THRU 8. C C COMMAND STRING FOR SOFT KEY 1 C DATA REC5/015446B,063062B,060461B,065440B,031114B,015560B, 1 39*020040B, C C COMMAND STRING FOR SOFT KEY 2 C 2 015446B,063062B,060462B,065440B,031114B,015561B, 3 39*020040B, C C COMMAND STRING FOR SOFT KEY 3 C 4 015446B,063062B,060463B,065440B,031114B,015562B, 5 39*020040B, C C COMMAND STRING FOR SOFT KEY 4 C 6 015446B,063062B,060464B,065440B,031114B,015563B, 7 39*020040B, C C COMMAND STRING FOR SOFT KEY 5 C 8 015446B,063062B,060465B,065440B,031114B,015564B, 9 39*020040B, C C COMMAND STRING FOR SOFT KEY 6 C A 015446B,063062B,060466B,065440B,031114B,015565B, B 39*020040B, C C COMMAND STRING FOR SOFT KEY 7 C C 015446B,063062B,060467B,065440B,031114B,015566B, D 39*020040B, C C COMMAND STRING FOR SOFT KEY 8 C E 015446B,063062B,060470B,065440B,031114B,015567B, F 39*020040B/ C C HOME THE CURSOR C DATA REC6/015550B,015501B/ C C ASCII MESSAGE BUFFERS C DATA REC7/006412B,2HEN,2HTE,2HR ,2HON,2HE ,2HOF,2H T,2HHE,2HSE, C2H F,2HUN,2HCT,2HIO,2HNS,2H: ,2H[C,2HRE,2HAT,2HE,,2HMO,2HDI,2HFY, C2H,O,2HUT,2HPU,2HT,,2HLI,2HST,2H] ,006412B,2HOR,2H P,2HRE,2HSS, C2H [,2HRE,2HTU,2HRN,2H] ,2 HTO,2H T,2HER,2HMI,2HNA,2HTE,2H T, C2HHI,2HS ,2HPR,2HOG,2HRA,2HM:/ C DATA REC8/006412B,2HEN,2HTE,2HR ,2H[S,2HOF,2HT ,2HKE,2HY , C2HNU,2HMB,2HER,2H (,2H1-,2H8),2H] ,2HTO,2H B,2HE ,2HPR,2HOG, C2HRA,2HMM,2HED,2H O,2HR ,006412B,2HPR,2HES,2HS ,2H[R,2HET, C2HUR,2HN],2H I,2HF ,2HLA,2HST,2H A,2HSS,2HIG,2HNM,2HEN,2HT , C2HHA,2HS ,2HBE,2HEN,2H M,2HAD,2HE:/ C DATA REC9/006412B,2H S,2HOF,2HT ,2HKE,2HY ,2HAS,2HSI,2HGN, C2HME,2HNT,2H F,2HOR,2H F,2HUN,2HCT,2HIO,2HN ,2HKE,2HY ,020040B, C2*006412B,2HEN,2HTE,2HR ,2HUP,2H T,2HO ,2H[1,2H6 ,2HCH,2HAR, C2HAC,2HTE,2HRS,2H] ,2HFO,2HR ,2HSO,2HFT,2H K,2HEY,2H L,2HAB, C2HEL,2H O,2HR ,006412B,2HPR,2HES,2HS ,2H[R,2HET,2HUR,2HN],2H I, C2HF ,2HNO,2H L,2HAB,2HEL,2H I,2HS ,2HTO,2H B,2HE ,2HAS,2HSI, C2HGN,2HED,2H: / C DATA REC10/06412B,2HEN,2HTE,2HR ,2H[0,2H] ,2HFO,2HR ,2HNO, C2HRM,2HAL,2H O,2HR ,2H[2,2H] ,2HFO,2HR ,2HTR,2HAN,2HSM,2HIT, C2H O,2HNL,2HY ,006412B,2HCO,2HMM,2HAN,2HD ,2HST,2HRI,2HNG, C2H T,2HYP,2HE:/ C DATA REC11/006412B,2HEN,2HTE,2HR ,2H[U,2HP ,2HTO,2H 8,2H0 , C2HCH,2HAR,2HAC,2HTE,2HRS,2H] ,2HFO,2HR ,2HSO,2HFT,2H K,2HEY, C2H C,2HOM,2HMA,2HND,006412B,2HST,2HRI,2HNG,2H T,2HO ,2HBE, C2H A,2HSS,2HIG,2HNE,2HD ,2HTO,2H T,2HHI,2HS ,2HKE,2HY ,2HOR, C2H P,2HRE,2HSS,2H [,2HRE,2HTU,2HRN,2H] ,006412B,2HTO,2H D, C2HEF,2HAU,2HLT,2H T,2HO ,2HST,2HAN,2HDA,2HRD,2H C,2HOM,2HMA, C2HND,2H S,2HTR,2HIN,2HG:/ C DATA REC12/006412B,2HEN,2HTE,2HR ,2H[F,2HIL,2HE ,2HNA,2HME, C2H,S,2HEC,2HUR,2HIT,2HY ,2HCO,2HDE,2H,C,2HAR,2HTR,2HID,2HGE, C2H] ,2HOR,2H [,2H26,2H45,2HA ,2HLU,2H] / C DATA REC13/2HWH,2HER,2HE ,2HSO,2HFT,2H K,2HEY,2H C,2HOM,2HMA, C2HND,2H S,2HET,2H T,2HO ,2HBE,2H M,2HOD,2HIF,2HIE,2HD ,2HIS, C2H S,2HTO,2HRE,2HD ,2HOR,006412B,2HPR,2HES,2HS ,2H[R,2HET, C2HUR,2HN],2H T,2HO ,2HCO,2HNT,2HIN,2HUE,2H M,2HOD,2HIF,2HYI, C2HNG,2H A,2H C,2HOM,2HMA,2HND,2H S,2HET,2H I,2HN ,2HTH,2HIS, C2He P,2HRO,2HGR,2HAM,2H: / C DATA REC14/2HWH,2HER,2HE ,2HSO,2HFT,2H K,2HEY,2H C,2HOM,2HMA, C2HND,2H S,2HET,2H T,2HO ,2HBE,2H O,2HUT,2HPU,2HT ,2HIS, C2H S,2HTO,2HRE,2HD ,2HOR,006412B,2HPR,2HES,2HS ,2H[R,2HET, C2HUR,2HN],2H T,2HO ,2HOU,2HTP,2HUT,2H D,2HIR,2HEC,2HTL,2HY , C2HFR,2HOM,2H T,2HHI,2HS ,2HPR,2HOG,2HRA,2HM:/ C DATA REC15/2HTO,2H W,2HHI,2HCH,2H C,2HOM,2HMA,2HND,2H S,2HET, C2H I,2HS ,2HTO,2H B,2HE ,2HOU,2HTP,2HUT,2H O,2HR ,2H[R,2HET, C2HUR,2HN],2H T,2HO ,006412B,2HRE,2HPL,2HAC,2HE ,2HOR,2HIG, C2HIN,2HAL,2H F,2HIL,2HE ,2HOR,2H L,2HU:/ C DATA REC16/2HWH,2HER,2HE ,2HSO,2HFT,2H K,2HEY,2H C,2HOM,2HMA, C2HND,2H S,2HET,2H T,2HO ,2HBE,2H L,2HIS,2HTE,2HD ,2HIS,2H S, C2HTO,2HRE,2HD ,2HOR,006412B,2HPR,2HES,2HS ,2H[R,2HET,2HUR, C2HN],2H T,2HO ,2HLI,2HST,2H D,2HIR,2HEC,2HTL,2HY ,2HFR,2HOM, C2H T,2HHI,2HS ,2HPR,2HOG,2HRA,2HM:/ C DATA REC17/006412B,2HFI,2HLE,2H M,2HAN,2HAG,2HER,2H E, C2HRR,2HOR,020055B,020040B,2H H,2HAS,2H O,2HCC,2HUR, C2HRE,2HD / C DATA REC18/006412B,2HER,2HRO,2HR ,2HIN,2H R,2HEA,2HDI,2HNG, C2H C,2HOM,2HMA,2HND,2H S,2HET,2H F,2HRO,2HM ,2HLU,2H! / C DATA REC19/006412B,2HNO,2H O,2HRI,2HGI,2HNA,2HL ,2HFI, C2HLE,2H O,2HR ,2HLU,2H E,2HXI,2HST,2HS:/ C DATA REC20/006412B,2HEN,2HD ,2HKE,2HYS/ C DATA REC21/006412B,2HKE,2HYS,2H H,2HAS,2H B,2HEE,2HN , C2HAB,2HOR,2HTE,2HD!/ C C C RETRIEVE LU NUMBER OF 2645A INPUT TERMINAL-ILU C RETRIEVE LU NUMBER OF LIST DEVICE-LU(2) C CALL RMPAR(LU) IF((LU.LT.1).OR.(LU.GT.63))LU=1 ILU=IOR(LU,400B) C IF((LU(2).LT.1).OR.(LU(2).GT.63))LU(2)=ILU LU(2)=IOR(LU(2),200B) C C GO INITIALIZE ALL BUFFERS C GOTO 700 5 ICR=0 IMOD=0 IOUT=0 ILST=0 C C C CREATE, MODIFY, OUTPUT OR LIST A SOFT KEY COMMAND SET? C 10 CALL EXEC(2,ILU,REC7,53) REG=EXEC(1,ILU,IBUF,1) IF(IBUF.EQ.040440B)GOTO 3000 IF(IB.EQ.0)GOTO 2000 IBUF=IAND(IBUF,077400B) IF(IBUF.EQ.041400B)GOTO 200 IF(IBUF.EQ.046400B)GOTO 300 IF(IBUF.EQ.047400B)GOTO 400 IF(IBUF.EQ.046000B)GOTO 500 GOTO 10 C C READ COMMAND SET FROM OLD FILE C C C OPEN OLD FILE C 17 CALL OPEN(IDCB,IERR,IBUF2(2),0,IBUF2(6),IBUF2(10)) IF(IERR.LT.0)GOTO 630 C C READ CONTENTS OF FILE C CALL READF(IDCB,IERR,REC1,4) IF(IERR.LT.0)GOTO 630 C CALL READF(IDCB,IERR,REC2,55) IF(IERR.LT.0)GOTO 630 C CALL READF(IDCB,IERR,REC3,55) IF(IERR.LT.0)GOTO 630 C CALL READF(IDCB,IERR,REC4,2) IF(IERR.LT.0)GOTO 630 C K=1 DO 20 I=1,8 CALL READF(IDCB,IERR,REC5(K),45,LEN) IF(IERR.LT.0)GOTO 630 NWRDS(I)=LEN K=K+45 20 CONTINUE C CALL READF(IDCB,IERR,REC6,2) IF(IERR.LT.0)GOTO 630 C C CLOSE FILE C CALL CLOSE(IDCB,IERR) IF(IERR.LT.0)GOTO 630 IF(IMOD.EQ.1)GOTO 315 IF(IOUT.EQ.1)GOTO 415 IF(ILST.EQ.1)GOTO 510 C C READ OLD COMMAND SET FROM A DEVICE LU C 22 REG=EXEC(1,IBUF2(2),REC1,4) IF(IB.NE.4)GOTO 675 C REG=EXEC(1,IBUF2(2),REC2,55) IF(IB.NE.55)GOTO 675 C REG=EXEC(1,IBUF2(2),REC3,55) IF(IB.NE.55)GOTO 675 C REG=EXEC(1,IBUF2(2),REC4,2) IF(IB.NE.2)GOTO 675 C K=1 DO 25 I=1,8 REG=EXEC(1,IBUF2(2),REC5(K),45) NWRDS(I)=IB K=K+45 25 CONTINUE C REG=EXEC(1,IBUF2(2),REC6,2) IF(IB.NE.2)GOTO 675 IF(IMOD.EQ.1)GOTO 315 IF(IOUT.EQ.1)GOTO 415 IF(ILST.EQ.1)GOTO 510 C C C MAKE SOFT KEY ASSIGNMENTS C C C REQUEST FUNCTION KEY NUMBER WHOSE ASSIGNMENT IS TO BE MADE. C 30 CALL EXEC(2,ILU,REC8,51) REG=EXEC(1,ILU,KEYN,1) IF(IB.EQ.0)GOTO 10 IF(KEYN.EQ.040440B)GOTO 3000 IMSK1=IAND(KEYN,177B) IF(IMSK1.NE.40B)GOTO 30 IMSK2=IAND(KEYN,077400B) IF((IMSK2.GT.034000B).OR.(IMSKx2.LT.030400B))GOTO 30 KEY=KEYN/400B-60B C C READ SOFT KEY LABEL ASSIGNMENT OF UP TO 16 CHARACTERS AND STORE. C CALL EXEC(2,ILU,REC9,72) C REG=EXEC(1,ILU,IBUF,8) IF(IBUF.EQ.040440B)GOTO 3000 IF(IB.EQ.0)GOTO 45 C C CENTER THE SOFT KEY LABEL IN THE LABEL FIELD. C NUM=IAND(IB,1) IF(NUM.NE.0)GOTO 35 I1=IB GOTO 40 35 I1=IB+1 40 L=((8-I1)/2)+1 C C INITIALIZE LABEL BUFFER FOR SPECIFIC KEY C 45 IF(KEY.GT.4)KEY1=KEY-4 DO 55 J=1,8 IF(KEY.GT.4)GOTO 50 LABL1(J,KEY)=020040B GOTO 55 50 LABL2(J,KEY1)=020040B 55 CONTINUE IF(IB.EQ.0)GOTO 85 C C SAVE THE SOFT KEY LABEL C 65 DO 80 K=1,IB IF(KEY.GT.4)GOTO 70 LABL1(L,KEY)=IBUF(K) GOTO 75 70 LABL2(L,KEY1)=IBUF(K) 75 L=L+1 80 CONTINUE C C REQUEST SOFT KEY TYPE C 85 CALL EXEC(2,ILU,REC10,35) C REG=EXEC(1,ILU,IBUF,1) IF(IBUF.EQ.040440B)GOTO 3000 IF(IB.NE.0)GOTO 90 ITYPE=62B GOTO 95 90 ITYPE=IAND(IBUF,177B) IF(ITYPE.NE.40B)GOTO 85 ITYPE=IAND(IBUF,077400B) IF((ITYPE.NE.030000B).AND.(ITYPE.NE.031000B))GOTO 85 ITYPE=ITYPE/400B C C SAVE THE SOFT KEY TYPE C 95 REC5(45*(KEY-1)+2)=IOR(ITYPE,063000B) C C C REQUEST ASCII COMMAND STRING C C 100 CALL EXEC(2,ILU,REC11,72) C REG=EXEC(1,ILU,IBUF,-80) IF(IBUF.EQ.040440B)GOTO 3000 IF(IB.NE.0)GOTO 105 NWRDS(KEY)=6 L=45*(KEY-1) REC5(L+4)=065440B REC5(L+5)=031114B REC5(L+6)=015560B+(KEY-1) GOTO 180 105 IC=IB C C CONVERT NUMBER OF CHARACTERS TO ASCII EQUIVALENT C 115 NCHAR=KCVT(IC) C C CALCULATE WHERE TO STORE COMMAND STRING LENGTH IN REC5 C LOC=((KEY-1)*45)+4 C C IF(IC.GE.10)GOTO 165 C C NUMBER OF CHARACTERS IN COMMAND STRING IS LESS THAN 10. C C MASK SINGLE DIGIT,OR WITH ASCII L, SHIFT TO UPPER BYTE, OR C WITH ASCII L, STORE IN WORD FIVE OF COMMAN`D STRING. C SET WORD FOUR OF ASCII COMMAND STRING TO 065440B. C ICHR1=IAND(NCHAR,77B)*400B REC5(LOC)=065440B REC5(LOC+1)=IOR(ICHR1,114B) GOTO 170 C C NUMBER OF CHARACTERS IN COMMAND STRING IS GE 10. C C MASK UPPER BYTE, SHIFT TO LOWER BYTE, OR WITH ASCII SMALL C K AND STORE IN WORD FOUR OF COMMAND STRING. C 165 ICHR1=IAND(NCHAR,037400B)/400B REC5(LOC)=IOR(065400B,ICHR1) C C MASK LOWER BYTE, MOVE TO UPPER BYTE, OR WITH ASCII L AND C STORE IN WORD FIVE OF COMMAND STRING. C ICHR2=IAND(NCHAR,77B)*400B REC5(LOC+1)=IOR(ICHR2,114B) C C CALCULATE NUMBER OF WORDS IN COMMAND STRING C 170 NUM=IAND(IB,1) IF(NUM.NE.0)GOTO 175 I1=IB/2 GOTO 180 175 I1=(IB+1)/2 C C INITIALIZE COMMAND STRING BUFFER FOR SPECIFIC KEY C 180 DO 185 I=2,40 ISTRG(I,KEY)=020040B 185 CONTINUE IF(IB.EQ.0)GOTO 30 C C SAVE COMMAND STRING C DO 190 I=1,I1 ISTRG(I,KEY)=IBUF(I) 190 CONTINUE C C SAVE NUMBER OF WORDS IN THE STRING C NWRDS(KEY)=5+I1 GOTO 30 C C C CREATE A NEW SOFT KEYS COMMAND SET C C 200 ICR=1 GOTO 700 205 ICR=0 GOTO 30 C C C MODIFY AN OLD COMMAND SET C C 300 IMOD=1 CALL EXEC(2,ILU,REC12,29) CALL EXEC(2,ILU,REC13,62) C REG=EXEC(1,ILU,IBUF,-20) CALL PARSE(IBUF,IB,IBUF3) IF(IBUF3(2).EQ.040440B)GOTO 3000 IF(IBUF3.EQ.0)GOTO 315 IBUF2=IBUF3 IBUF2(2)=IBUF3(2) IBUF2(3)=IBUF3(3) IBUF2(4)=IBUF3(4) IBUF2(6)=IBUF3(6) IBUF2(10)=IBUF3(10) GOTO 700 305 IF(IBUF2.EQ.1)GOTO 310 GOTO 17 310 IF((IBUF2(2).LT.1).OR.(IBUF2(2).GT.63))GOTO 300 GOTO 22 315 IMOD=0 GOTO 30 C C OUTPUT COMMAND SET C 400 IOUT=1 C C REQUEST WHERE COMMAND SET TO BE OUTPUT IS STORED [FILE,LU OR KEYS] C CALL EXEC(2,ILU,REC12,29) CALL EXEC(2,ILU,REC14,53) C REG=EXEC(1,ILU,IBUF,-20) CALL PtARSE(IBUF,IB,IBUF3) IF(IBUF3(2).EQ.040440B)GOTO 3000 IF(IBUF3.EQ.0)GOTO 415 IBUF2=IBUF3 IBUF2(2)=IBUF3(2) IBUF2(3)=IBUF3(3) IBUF2(4)=IBUF3(4) IBUF2(6)=IBUF3(6) IBUF2(10)=IBUF3(10) IF(IBUF2.EQ.1)GOTO 405 GOTO 17 405 IF((IBUF2(2).LT.1).OR.(IBUF2(2).GT.63))GOTO 400 GOTO 22 C C REQUEST [FILE,LU] WHERE COMMAND SET IS TO BE OUTPUT C 415 IOUT=0 IFLG=0 CALL EXEC(2,ILU,REC12,29) CALL EXEC(2,ILU,REC15,41) C REG=EXEC(1,ILU,IBUF,-20) CALL PARSE(IBUF,IB,IBUF3) IF(IBUF3(2).EQ.040440B)GOTO 3000 C C COMMAND SET TO BE OUTPUT TO A FILE OR LU? C IF(IBUF3.EQ.0)GOTO 420 IF(IBUF3.EQ.1)GOTO 430 GOTO 600 420 IF(IBUF2.EQ.0)GOTO 1000 IF(IBUF2.EQ.1)GOTO 425 GOTO 610 425 IF((IBUF2(2).LT.1).OR.(IBUF2(2).GT.63))GOTO 415 GOTO 665 430 IF((IBUF3(2).LT.1).OR.(IBUF3(2).GT.63))GOTO 415 GOTO 660 C C LIST COMMAND SET C 500 ILST=1 CALL EXEC(2,ILU,REC12,29) CALL EXEC(2,ILU,REC16,52) C REG=EXEC(1,ILU,IBUF,-20) CALL PARSE(IBUF,IB,IBUF3) IF(IBUF3(2).EQ.040440B)GOTO 3000 IF(IBUF3.EQ.0)GOTO 510 IBUF2=IBUF3 IBUF2(2)=IBUF3(2) IBUF2(3)=IBUF3(3) IBUF2(4)=IBUF3(4) IBUF2(6)=IBUF3(6) IBUF2(10)=IBUF3(10) IF(IBUF2.EQ.1)GOTO 505 GOTO 17 505 IF((IBUF2(2).LT.1).OR.(IBUF2(2).GT.63))GOTO 500 GOTO 22 C C LIST SOFT KEY COMMAND SET C 510 ILST=0 DO 515 K=1,4 REG=EXEC(2,LU(2),LABL1(1,K),8) ITYPE=IAND(REC5(2+45*(K-1)),77B) REG=EXEC(2,LU(2),ITYPE,1) REG=EXEC(2,LU(2),ISTRG(1,K),NWRDS(K)) 515 CONTINUE DO 520 K=1,4 REG=EXEC(2,LU(2),LABL2(1,K),8) ITYPE=IAND(REC5(2+45*(K+3)),77B) REG=EXEC(2,LU(2),ITYPE,1) REG=EXEC(2,LU(2),ISTRG(1,K+4),NWRDS(K+4)) 520 CONTINUE GOTO 10 C C COMMAND SET IS TO BE STORED IN A FILE C C 600 IBUF2=IBUF3  IBUF2(2)=IBUF3(2) IBUF2(3)=IBUF3(3) IBUF2(4)=IBUF3(4) IBUF2(6)=IBUF3(6) IBUF2(10)=IBUF3(10) GOTO 615 C C CREATE OR REPLACE COMMAND SET FILE C 610 CALL OPEN(IDCB,IERR,IBUF2(2),0,IBUF2(6),IBUF2(10)) IF(IERR.LT.0)GOTO 630 GOTO 620 615 CALL CREAT(IDCB,IERR,IBUF2(2),5,4,IBUF2(6),IBUF2(10)) IF(IERR.LT.0)GOTO 630 C C WRITE FIRST RECORD C 620 CALL WRITF(IDCB,IERR,REC1,4) IF(IERR.LT.0)GOTO 630 C C WRITE SECOND RECORD FOR FIRST FOUR SOFT KEY LABELS C CALL WRITF(IDCB,IERR,REC2,55) IF(IERR.LT.0)GOTO 630 C C WRITE THIRD RECORD FOR SECOND FOUR SOFT KEY LABELS C CALL WRITF(IDCB,IERR,REC3,55) IF(IERR.LT.0)GOTO 630 C C WRITE FOURTH RECORD C CALL WRITF(IDCB,IERR,REC4,2) IF(IERR.LT.0)GOTO 630 C C WRITE SOFT KEY COMMAND STRINGS C K=1 DO 625 KEY=1,8 CALL WRITF(IDCB,IERR,REC5(K),NWRDS(KEY)) IF(IERR.LT.0)GOTO 630 K=K+45 625 CONTINUE C C WRITE SIXTH RECORD C CALL WRITF(IDCB,IERR,REC6,2) IF(IERR.LT.0)GOTO 630 C C WRITE AN END OF FILE C CALL WRITF(IDCB,IERR,REC6,-1) IF(IERR.LT.0)GOTO 630 GOTO 650 C C FILE MANAGER ERROR MESSAGE C C CONVERT TWO'S COMPLEMENT OF FMGR ERROR CODE TO POSITIVE C OCTAL EQUIVALENT C 630 IFLG=1 IERR1=IERR-1B IB=1 DO 645 I=1,16 IE=IAND(IERR1,IB) IF(IE.EQ.IB)GOTO 635 IERR1=IERR1+IB GOTO 640 635 IERR1=IERR1-IB 640 IB=IB*2B 645 CONTINUE C C CONVERT OCTAL ERROR CODE TO ASCII EQUIVALENT C IERR=KCVT(IERR1) C C WRITE ERROR MESSAGE C CALL EXEC(2,ILU,REC17,19) C C CLOSE FILE C 650 CALL CLOSE(IDCB,IERR) IF(IMOD.EQ.1)GOTO 300 IF(IOUT.EQ.1)GOTO 400 IF(ILST.EQ.1)GOTO 500 IF(IFLG.EQ.1)GOTO 415 GOTO 10 C C C COMMAND SET TO BE OUTPUT TO A DEVICE LOGICAL UNIT C 660 IBUF2=IBUF3 IBUF2(2)=IBUF3(2) C C WRITE FIRST RECO<:6RD TO LU C 665 REG=EXEC(2,IBUF2(2),REC1,4) C C WRITE SECOND RECORD TO LU C REG=EXEC(2,IBUF2(2),REC2,55) C C WRITE THIRD RECORD TO LU C REG=EXEC(2,IBUF2(2),REC3,55) C C WRITE FOURTH RECORD TO LU C REG=EXEC(2,IBUF2(2),REC4,2) C C WRITE SOFT KEY COMMAND STRINGS C K=1 DO 670 KEY=1,8 REG=EXEC(2,IBUF2(2),REC5(K),NWRDS(KEY)) K=K+45 670 CONTINUE C C WRITE SIXTH RECORD TO LU C REG=EXEC(2,IBUF2(2),REC6,2) GOTO 10 C C EXEC ERROR MESSAGE C 675 CALL EXEC(2,ILU,REC18,20) IF(IMOD.EQ.1)GOTO 300 IF(IOUT.EQ.1)GOTO 400 IF(ILST.EQ.1)GOTO 500 GOTO 10 C C INITIALIZE ALL BUFFERS C 700 DO 710 K=1,4 DO 710 J=1,8 LABL1(J,K)=020040B LABL2(J,K)=020040B 710 CONTINUE DO 715 K=1,8 NWRDS(K)=6 L=45*(K-1) REC5(L+2)=063062B REC5(L+4)=065440B REC5(L+5)=031114B REC5(L+6)=015560B+(K-1) DO 715 J=2,40 ISTRG(J,K)=020040B 715 CONTINUE IF(ICR.EQ.1)GOTO 205 IF(IMOD.EQ.1)GOTO 305 GOTO 5 C C NO ORIGINAL FILE OR LU EXISTS MESSAGE C 1000 CALL EXEC(2,ILU,REC19,16) GOTO 415 C C END KEYS MESSAGE C 2000 CALL EXEC(2,ILU,REC20,5) GOTO 4000 C C KEYS HAS BEEN ABORTED MESSAGE C 3000 CALL EXEC(2,ILU,REC21,12) 4000 END END$ <  92060-18053 1707 S 0122 2645A SOFT KEY DUMP UTILITY             H0101 )FTN4,B,L C PROGRAM KYDMP(3,10) C C DATE:09 FEB 77 C C C KYDMP IS A PROGRAM THAT WILL OUTPUT SOFT KEY COMMAND SETS C FROM DISC OR MINI CARTRIDGE FILE OR LU TO A 2645A TERMINAL C IN AN HP 1000 SYSTEM. IT IS PROVIDED SPECIFICALLY FOR RTE-M C SYSTEMS IN WHICH THERE IS NO FMGR PROGRAM. C C USE ONE OF THE FOLLOWING COMMAND SEQUENCES TO RUN KYDMP C FROM RTE OR FMGR: C C 1) TO DUMP A COMMAND SET FROM A DISC OR MINI-CARTRIDGE C FILE USE: C C RU,KYDMP,[LU],FI,[LN],[AM] [,SECURITY CODE] C C 2) TO DUMP A COMMAND SET FROM AN UNNAMED MINI-CARTRIDGE C FILE USE: C C RU,KYDMP,[LU],CTU C C WHERE: [LU] = THE LU# OF THE 2645A TERMINAL TO WHICH C THE COMMAND SET IS TO BE OUTPUT.DEFAULT C IS LU 1. C C FI,LN,AM =FILE NAME WHERE COMMAND SET IS STORED C FI = FIRST TWO CHARACTERS OF ASCII NAME C LN = SECOND TWO CHARACTERS OF ASCII NAME C AM = THIRD TWO CHARACTERS OF ASCII NAME C C SECURITY CODE = SECURITY CODE OF FILE (OPTIONAL) C C CTU = LU# OF 2645A CTU WHERE COMMAND SET TO BE C DUMPED IS STORED. C C DIMENSION IDCB(144),IP(5),NAM(3),IBUF(55) DIMENSION MSG1(22),MSG2(20),MSG3(17),IA(2) C EQUIVALENCE (IP(2),NAM),(REG,IA),(IB,IA(2)),(IERR,MSG2(8)) C DATA MSG1/006412B,2HNO,2H S,2HEC,2HON,2HD ,2HPA,2HRA,2HME, C2HTE,2HR ,2HSP,2HEC,2HIF,2HIE,2HD ,2HOR,2H N,2HEG,2HAT, C2HIV,2HE / C C DATA MSG2/006412B,2HFM,2HGR,2H E,2HRR,2HOR,020055B,020040B, C2H W,2HHE,2HN ,2HRE,2HAD,2HIN,2HG ,2HFR,2HOM,2H F,2HIL,2HE / C DATA MSG3/006412B,2HER,2HRO,2HR ,2HIN,2H R,2HEA,2HDI,2HNG, C2H F,2HRO,2HM ,2H26,2H45,2HA ,2HCT,2HU / C C C RETRIEVE PARAMETERS C CALL RMPAR(IP) IF((IP.LT.1).OR.(IP.GT.77B))IP=1 C C IS SECOND PARAMETER AN LU? C IF(IP(2).LT.1)GOTO 300 IF(IP(2).LT.77B)GOTO 200 C C SECOND PARAMETER IS A FILE NAME C IF(IP(3).EQ.0)IP(3)=020040B IF(IP(4).EQ.0)IP(4)=020040B C C READ COMMAND SET FROM A FILE AND OUTPUT TO 2645A C C OPEN FILE C CALL OPEN(IDCB,IERR,NAM,0,IP(5)) IF(IERR.LT.0)GOTO 310 C C READ FIRST RECORD AND OUTPUT C CALL READF(IDCB,IERR,IBUF,4) IF(IERR.LT.0)GOTO 310 REG=EXEC(2,IP,IBUF,4) C C READ SECOND RECORD AND OUTPUT C CALL READF(IDCB,IERR,IBUF,55) IF(IERR.LT.0)GOTO 310 REG=EXEC(2,IP,IBUF,55) C C READ THIRD RECORD AND OUTPUT C CALL READF(IDCB,IERR,IBUF,55) IF(IERR.LT.0)GOTO 310 REG=EXEC(2,IP,IBUF,55) C C READ FOURTH RECORD AND OUTPUT C CALL READF(IDCB,IERR,IBUF,2) IF(IERR.LT.0)GOTO 310 REG=EXEC(2,IP,IBUF,2) C C READ EIGHT COMMAND STRING RECORDS AND OUTPUT C DO 110 I=1,8 CALL READF(IDCB,IERR,IBUF,45,LEN) IF(IERR.LT.0)GOTO 310 REG=EXEC(2,IP,IBUF,LEN) 110 CONTINUE C C READ LAST RECORD AND OUTPUT C CALL READF(IDCB,IERR,IBUF,2) IF(IERR.LT.0)GOTO 310 REG=EXEC(2,IP,IBUF,2) C C CLOSE FILE C CALL CLOSE(IDCB,IERR) GOTO 400 C C C READ COMAND SET FROM LU C C READ FIRST RECORD FROM 2645A CTU AND OUTPUT C 200 REG=EXEC(1,NAM,IBUF,4) IF(IB.NE.4)GOTO 330 REG=EXEC(2,IP,IBUF,4) C C READ SECOND RECORD FROM 2645A CTU AND OUTPUT C REG=EXEC(1,NAM,IBUF,55) IF(IB.NE.55)GOTO 330 REG=EXEC(2,IP,IBUF,55) C C READ THIRD RECORD FROM 2645A CTU AND OUTPUT C REG=EXEC(1,NAM,IBUF,55) IF(IB.NE.55)GOTO 330 REG=EXEC(2,IP,IBUF,55) C C READ FOURTH RECORD FROM 2645ACTU AND OUTPUT C REG=EXEC(1,NAM,IBUF,2) IF(IB.NE.2)GOTO 330 REG=EXEC(2,IP,IBUF,2) C C READ EIGHT COMMAND STRING RECORDS AND OUTPUT C B DO 210 I=1,8 REG=EXEC(1,NAM,IBUF,45) REG=EXEC(2,IP,IBUF,IB) 210 CONTINUE C C READ LAST RECORD FROM 2645A CTU AND OUTPUT C REG=EXEC(1,NAM,IBUF,2) IF(IB.NE.2)GOTO 330 REG=EXEC(2,IP,IBUF,2) GOTO 400 C C MESSAGE-SECOND PARAMETER ZERO OR NEGATIVE C 300 CALL EXEC(2,IP,MSG1,22) GOTO 400 C C MESSAGE-ERROR WHEN READING FROM FILE C 310 IERR1=IERR-1B IB=1 DO 320 I=1,16 IE=IAND(IERR1,IB) IF(IE.EQ.IB)GOTO 312 IERR1=IERR1+IB GOTO 315 312 IERR1=IERR1-IB 315 IB=IB*2B 320 CONTINUE IERR=KCVT(IERR1) CALL EXEC(2,IP,MSG2,20) GOTO 400 C C ERROR WHEN READING FROM 2645A CTU C 330 CALL EXEC(2,IP,MSG3,17) 400 END END$ !  92060-18054 1826 S C0122 OPEN COMPILER LIBRARY              H0101 ӛASMB,R,L,C HED COMPILER LIBRARY OPEN ROUTINE NAM OPN.C,7 92060-18054 780407 REV. 1826 $CLIB *ADDED STA C.EXT,I TO LINE 4 FOR REV 1826 (WASNT RESET EXTERN NO) * * *************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * * REPRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * *************************************************************** * * * * SOURCE PART NUMBER : 92060-18054 * * * * * OPEN DEFAULT FILE * * THIS ROUTINE WILL INSPECT THE FILE CONTROL BLOCK AND DETERMINE * WHETHER TO OPEN A 'FMGR' FILE, SCRATCH FILE OR LOGICAL UNIT. * IN THE CASE OF THE 'FMGR' FILE IT WILL SET UP THE PARAMETERS * AND CALL 'GEX.C'. IF IT IS A SCRATCH FILE IT WILL GET A TRACK * FOR RTE OR A SCRATCH FILE IN THE CASE OF OF RTE-M. * * * * * * CALLING SEQUENCE: * * A REGISTER CONTAINS THE PROMPT CHARACTERS * * JSB OPN.C * DEF FCB * ERROR RETURN * NO ERROR RETURN * * ON RETURN A < 0 INDICATES ERROR * A = 0 INDICATES NO ERROR * * * * ENTRY POINT: * ENT OPN.C * * EXTERNALS: * EXT EXEC SYSTEM EXEC EXT GEX.C CREATE-OPEN ROUTINE EXT LURQ LOCK LU ROUTINE EXT CRE.C CREATE ROUTINE EXT ADS.C FCB ADDRESS PASSER ROUTINE EXT C.TRN ASCII STRING CONTAINING TURN ON LIST FROM 'NAMR' EXT .MVW MOVE WORD ROUTINE EXT C.HLK HEAD OF FCB LINKED LIST EXT C.LNK FCB LINK WORD EXT C.FCB ADDRESS OF FCB EXT C.FID FCB ID WORD EXT C.FLU FCB LOGICAL UNIT WORD EXT C.STR FCB CURRENT EXTENT TRACK NUMBER WORD EXT C.SSC FCB CURRENT EXTENT SECTOR NUMBER WORD EXT C.EXT FCB EXTENT NUMBER WORD EXT C.RSC 1w FCB EXTENT OFFSET NUMBER EXT C.S/T FCB NUMBER OF BLOCKS/TRACK WORD EXT C.#SC FCB NUMBER OF BLOCKS/EXTENT WORD EXT C.BFF FCB BUFFER ADDRESS WORD EXT C.WRD FCB CURRENT WORD POINTER WORD EXT C.FAD FCB DIRECTORY ADDRESS FROM D.RTR WORDS EXT C.HTR FCB START OF FILE TRACK NUMBER WORD EXT C.HLU FCB HEAD LOGICAL UNIT NUMBER EXT C.SLU FCB SECONDARY LOGICAL UNIT NUMBER WORD EXT C.RC# FCB RECORD NUMBER EXT C.?? FCB PROMPT CHARACTERS EXT C.GRW FCB REWIND GUARANTEE ROUTINE ADDRESS EXT C.INS FCB $INCLUDE ROUTINE ADDRESS * EXT C.NAM DEFAULT FILE NAME EXT C.SC DEFAULT FILE SECURITY CODE EXT C.CR DEFAULT FILE CARTRIDGE OR LU NUMBER EXT C.FTY DEFAULT FILE TYPE EXT C.FSZ DEFAULT FILE SIZE EXT C.TYP 'NAMR' TYPE EXT C.FCB ADDRESS OF FCB * EXT D.RP1 RETURN PARAMETERS EXT D.RP2 OF OPEN CREATE ROUTINE 'GEX.C' EXT D.RP3 EXT D.RP4 EXT D.RP5 EXT D.RP6 EXT D.RP7 EXT C.INP EXT C.LEN EXT NAMR EXT FCB1. EXT FCB2. EXT RW#EC EXT C.SON EXT .TTY TEST FOR INTERACTIVE TERMINAL EXT CLO.C THE CLOSE ROUTINE * * * A EQU 0 B EQU 1 * OPN.C NOP JSB ADS.C SET UP FILE CONTROL BLOCK ADDRESSES DEC 0 STA PRMPT SAVE PROMPT CHARACTERS CLA STA C.EXT,I STA C.RSC,I INITIALIZE FCB FOR STA C.LNK,I RESTART STA C.RC#,I STA READF STA C.??,I LDA C.FID,I SEE IF FILE IS ALREADY OPEN AND B10 CPA B10 JMP RET2 YES, EXIT LDA .1 STA TMP INITIALIZE THE NAMR STRING CHARACTER POINTER LDA C.FID,I IOR B10 SET OPEN BIT ELA,CLE,ERA CLEAR OUT DEVICE TYPE FLAG STA C.FID,I ALF,RAL GET THE DEFAULT PARAMETER FROM C.FID AND B17 CPA .1 IS THIS THE SOURCE INPUT FCB? JMP *+2 YES JMP FATHR NO LDB C.NAM STB C.INP SET UP THE SOURCE FCB NAMR POINTER LDB C.SON SSB ARE WE A SON PROCESS JMP SON1 YES FATHR INA SET UP CMA THE STA END PARSE STOP FLAG GETPR JSB NAMR PARSE TURN ON STRING DEF *+5 RETURN ADDRESS DEF C.NAM,I DESTINATION ADDRESS DEF C.TRN SOURCE ADDRESS DEF C.LEN CHARACTER LENGTH OF SOURCE BUFFER DEF TMP THE STARTING CHARACTER NUMBER SSA DONE? JMP DONE YES ISZ END REACHED NAMR YET? JMP GETPR NO DONE LDB C.INP GET SOURCE ADB .5 LDA C.CR,I IS CRN SUPPLIED FOR THIS FILE? SZA,RSS LDA B,I NO, USE SOURCE CRN STA C.CR,I * * DETERMINE TYPE OF OPERATION * * THE FCB CONTAINS THE OPERATION TYPE AS FOLLOWS: * * TYPE = 0 IS READ SOURCE FILE(OR LU) * = 1 IS WRITE BINARY FILE(OR LU) * = 2 IS WRITE SCRATCH FILE * = 3 IS WRITE LIST FILE(OR LU) * = 4 IS READ SOURCE AND GUARANTEE REWINDABLITY * = 5 IS WRITE BINARY ABSOLUTE FILE (OR LU) * LDA C.FID,I EXTRACT AND .7 FCB OPERATION TYPE STA B STA OPTYP SAVE FILE OPEN TYPE CPB .2 WRITE SCRATCH JMP WRTSC YES, CREATE SCRATCH FILE * LDA C.TYP,I ISOLATE AND .3 PARAMETER TYPE CPA .1 INTEGER(LOGICAL UNIT!) JMP OPNLU YES! CPA .3 FILE NAME? JMP *+3 YES! SZA NULL? JMP E200 NO SUCH TYPE! * CPB .1 WRITE BINARY? JMP WRITB YES , CREATE BINARY FILE! CPB .3 WRITE SOURCE? JMP WRITS YES, CREATE SOURCE FILE CPB .5 WRITE ABSOLUTE? JMP WRITB YES, CREATE ABSOLUTE FILE * * READ SOURCE FILE OPEN * SZA,RSS NULL SOURCE NAMR? JMP E202 YES! * OPNA CCA STA READF SET UP READ SOURCE FLAG FOR SECURITY CODE CHECK * * * * GEX.C IS CALLED TO OPEN A FILE, ON RETURN FROM GEX.C * THE FOLLOWING PARAMETERS ARE PASSED BACK IN D.RP1 THRU D.RP7 * * D.RP1 = ERROR CODE, IF > 0 THEN THE # OF SECTORS IN THE FILE * D.RP2 = TRACK AND LOGICAL UNIT * D.RP3 = OFFSET AND SECTOR NUMBER * D.RP4 = TRACK NUMBER (LU IF TYPE = 0) * D.RP5 = NUMBER OF SECTORS IN TRACK AND SECTOR NUMBER * D.RP6 = SECURITY CODE OF THE FILE * D.RP7 = TYPE OF THE FILE * * OPEN LDA .2 CALL LDB C.CR,I ROUTINE TO JSB GEX.C OPEN A FILE DEF C.NAM,I JMP OPN.C,I ERROR BUG OUT! * LDA D.RP7 CHECK TO SEE IF FILE TYPE MATCHES LDB OPTYP CPB .1 BINARY FILE OPEN?? JMP BIN YES! CPB .3 LIST FILE OPEN? JMP LST YES! CPB .5 ABSOLUTE FILE OPEN? JMP BIA YES! * CKSC LDA D.RP6 IS SECURITY SZA,RSS = ZERO JMP RETRN YES, MATCH ANYTHING ELSE TEST IT CPA C.SC,I CODE OF FILE SAME AS USER SUPPLIED? JMP RETRN YES, OK! ISZ READF IS THIS A READ ONLY OPERATION? JMP E7 NO , ILLEGAL SECURITY CODE! SSA IS THE FILE READ PROTECTED JMP E7 YES, NO CAN READ ON EITHER! RETRN LDB D.RP1 TYPE 0 FILE? LDA D.RP4 A=LU#,B=#SECTRS SZB,RSS JMP OPNL1 YES JSB SETUP SET UP THE FCB * * LINK THE FCB INTO THE LIST - HEAD IS GLOBAL CALLED C.HLK * LDA C.HLU,I SET TRACK LU STA C.FLU,I INTO PRIMARY LU LDA OPTYP WHAT KIND ON INITIALIZATION DO SZA,RSS WE NEED ON THE DATA BUFFER JMP TYPE0 CPA .4 GARRENTEE REWIND? 9  JMP TYPE4 YES TEST FURTHER TYPEN LDA B100K INITIALIZE TO FORCE A WRITE JMP *+2 SONXT CLA TYPE0 EQU SONXT STA C.BFF,I SET THE FCB BUFFER TO FORCE A READ RET1 CLA,INA STA C.WRD,I CLEAR WORD PTR RET1B LDA C.HLK GET HEAD LDB C.FCB GET ADDRESS OF FILE CONTROL BLK STB C.HLK AND SET IT IN HEAD POINTER SZA HEAD LINK PTR EMPTY? STA C.FCB,I NO, SO PLACE ADDRESS IN NEW FCB RET2 CLA CLEAR ERROR RETURN ISZ OPN.C TAKE P+2 EXIT JMP OPN.C,I * TYPE4 LDA C.FLU,I IS THE LU A UNIT RECORD TYPE? SSA JMP TYPEN YES, INITIALIZE TO WRITE JMP TYPE0 NO, INITIALIZE TO READ * BIA CPA .7 ABSOLUTE FILE? JMP CKSC YES! JMP E16 NO, ILLEGAL FILE TYPE BIN CPA .5 BINARY FILE? JMP CKSC YES! JMP E16 NO, ILLEGAL FILE TYPE * LST CPA .3 SOURCE FILE? JMP CKSC1 YES! CPA .4 SOURCE FILE? JMP CKSC1 YES! JMP E16 NO ,ILLEGAL FILE TYPE * CKSC1 LDA C.SON AM I A SON PROCESS SZA,RSS JMP CKSC NO LDA C.EXT,I IN EXTENT? SZA,RSS JMP CKSC2 NO LDA .3 LDB C.CR,I CRN JSB GEX.C OPEN EXTENT DEF .0 JMP E203 CAN'T OPEN EXTENT CKSC2 CCA JSB RW#EC READ NEXT SECTOR JMP E204 READ ERROR LDA OPTYP CPA .3 IS THIS THE LIST FILE CLA,CCE,RSS YES SET THE SIGN BIT CLA,INA,RSS NO SET THE LSB ERA STA C.BFF,I BUFFER FLAG WORD JMP RET1B * E204 LDA M204 READ ERROR JMP OPN.C,I E203 LDA M203 OPEN ERROR JMP OPN.C,I E202 LDA M202 NO SOURCE NAMR JMP OPN.C,I E15 LDA M15 BAD NAMR JMP OPN.C,I E16 JSB NCLOS ILLEGAL TYPE LDA M16 JMP OPN.C,I E201 LDA M201 NO BINARY ERROR JMP OPN.C,I E200 LDA M200 BAD FCB FOyRMAT ERROR JMP OPN.C,I TAKE P+1 ERROR EXIT E7 JSB NCLOS SECURITY CODE ERROR LDA M7 JMP OPN.C,I SPC 3 NCLOS BSS 1 CLOSE THAT FILE THAT SHOULD NOT BE OPEN LDA C.HLK U GOT TO LINK IT IN FIRST LDB C.FCB STB C.HLK STB PLACE FOR CLO.C SZA IS ANYTHING IN THE LINKED LIST? STA C.FCB,I JSB CLO.C PLACE BSS 1 NOP IGNORE ANY OTHER ERRORS JMP NCLOS,I SPC 3 * * WRITE BINARY (TYPE=5) FILE OR ABSOLUTE (TYPE=7) * WRITB LDA C.TYP,I IS NAME SZA,RSS A NULL? JMP E201 YES SET ERROR TO 201 SO NOT TO OUTPUT BINARY LDB PERCT USE % FOR FIRST CHARACTER IF BINARY LDA OPTYP GET FCB OPERATION TYPE CPA .5 WRITE BINARY ABSOLUTE? LDB XCLAM YES, USE ! FOR FIRST CHARACTER JSB MINUT TEST FOR MINUS LDA .5 SET FILE TYPE FOR BINARY RELOCATABLE LDB OPTYP CPB .5 TEST FOR WRITE BINARY ABSOLUTE LDA .7 YES CHANGE FILE TYPE PARAMETER JMP CREAT CREATE FILE OR OPEN IT * * * WRITE SOURCE FILE - LIST(CREATE TYPE 4 FILE) * * WRITS LDA C.SON CPA M1 C.SON TRUE? RSS YES JMP WRTS1 NO LDA .FCB2 JSB GTFCB MOVE THE FATHER FCB IN LDA C.NAM,I FETCH THE FIRST CHAR OF NAMR AND =B77777 MASK OFF THE EXCLUSIVE OPEN BIT STA C.NAM,I PUT IT BACK WRTS1 LDA C.TYP,I IS NAMR SZA,RSS A NULL? JMP LU6 YES, SET LU TO 6 LDB APOST JSB MINUT TEST FOR MINUS CHAR IN NAMR LDA C.SON ARE WE A SON PROCESS? SSA JMP OPEN YEA SWEETY, GO DO IT LDA .4 CREATE A TYPE 4 FILE SPC 2 CREAT LDB C.FTY,I TEST FOR A BAD FILE TYPE SSB JMP E15 IT WAS A NEGATIVE NUMBER AND FMGR DOES NOT LIKE THAT JSB CRE.C AND GO TO TO IT JMP *+2 ERRO|R, DO SPECIAL CHECK JMP RETRN WE MADE IT SWEETY CPA M2 DUPLICATE NAME? JMP CKNAM YES, CHECK IF SAME AS SOURCE NAMR JMP OPN.C,I NO, GO GIVE THE ERROR TO THE CALLER * * CHECK NAME TO SEE IF IT STARTS WITH A (') FOR LIST OR (%) FOR * BINARY. IF SO OPEN IT AND USE IT IF NOT THEN ERR 15. * CKNAM LDA C.NAM,I GET AND UCMSK FIRST CHARACTER CPA TMP (') LIST, (%) BINARY, (!) ABSOLUTE JMP OPEN YES, OPEN EXISTING FILE JMP E15 NO, GIVE ERROR * * TEST FOR MINUS SIGN IN NAMR AND SET UP NAMR IF NECESSARY * MINUT BSS 1 STB TMP SAVE THE POTENTIAL NAMR FIRST CHAR LDA C.NAM,I AND UCMSK CPA MINUS IS THE FIRST CHARACTER A MINUS? JMP *+2 YES JMP MINUT,I NO LDA C.INP,I AND UCMSK CPA AMPSD IS SOURCE 1ST CHAR AN & JMP *+2 YES JMP E15 NO GO TELL EM LDA C.INP LDB C.NAM JSB .MVW MOVE THE NAMR DEF .10 OCT 0 LDA C.NAM,I AND B377 IOR TMP PUT PROPER 1ST CHAR IN NAMR STA C.NAM,I JMP MINUT,I * * * * * WRITE SCRATCH FILE (GET TRACK FOR RTE-II,RTE-III, AND RTE-IV) * (OPEN SCRATCH FILES FOR RTE-M) * WRTSC LDA .4 JSB GEX.C GET SCRATCH FILE JMP OPN.C,I ERROR BUG OUT JMP RETRN SET UP FCB * * * * OPEN LOGICAL UNIT DEVICE * LU6 LDA .6 DEFAULT TO LU 6 JMP OPNL1 OPNLU LDA C.NAM,I GET LU FROM OPNL1 SSA IS IT NEGATIVE CMA,INA YES, FLIP IT STA LU SET CONTROL LU IOR B600 SET V AND K BITS TO ECHO AND PRINT COLUMN ONE ON LP CPB .1 BINARY? JMP WRTBN YES! CPB .5 ABSOLUTE? JMP WRTBN YES! STA C.FLU,I SET UP THE FCB LU WORD CPB .4 INPUT SOURCE-GUARANTEE REWINDABILITY? JMP INSRC SZB,RSS PLAIN OLD READ SOURCE? JMP INSRC YES, GO SET PAPER TAPE EOT * DTTY2 JSB .TTY TEST FOR INTERACTIVE LU DEF RT1 DEF LU * * RT1 CPA M1 JMP GOOD JMP LULK * * GOOD LDA PRMPT SET PROMPT STA C.??,I CHARACTERS UP OPN1 LDA C.FID,I SET SIGN IOR SIGN BIT TO SHOW STA C.FID,I IT IS AN LU. LDA OPTYP IS THIS CPA .4 READ OPERATION? JMP OPSCR YES! JMP RET1 NO! * OPSCR JSB GEX.C GET SCRATCH FILE - A = 4 I HOPE JMP OPN.C,I ERROR EXIT JSB SETUP SET UP FCB LDA C.HLU,I AND ALSO STA C.SLU,I SETUP SECONDARY LU LDA B100K STA C.BFF,I SET THE FCB BUFFER TO FORCE A WRITE JMP RET1 * LULK JSB LURQ LOCK DEF *+4 DEF B101 THE DEF C.FLU,I DEF .1 DEVICE CPA .1 LU ALREADY LOCKED? JMP OPN1 YES! SZA,RSS REQUEST MAKE IT? JMP OPN1 YES! JSB EXEC NO RESCHEDULE DEF *+6 DEF .12 DEF .0 AGAIN 15 SECONDS FROM NOW DEF .2 DEF .0 DEF M15 JMP LULK * WRTBN IOR B100 SET BINARY STA C.FLU,I FLAG LDA B1000 SET UP TO OUTPUT LEADER JMP CONT INSRC LDA B700 SET UP FOR END OF PAPER TAPE REQUEST CONT IOR LU STA LU JSB EXEC OUTPUT CONTROL FUNCTION DEF *+3 DEF .3 DEF LU JMP DTTY2 * * * * * SET UP DATA IN FCB * SETUP NOP LDB C.BFF CCA INB STA B,I PUT AN EOF MARK IN THE FCB BUFFER LDA D.RP1 MAKE SECTORS/FILE INTO BLOCKS/FILE RAR STA C.#SC,I AND STORE INTO FCB LDA D.RP2 AND B77 ISOLATE FILE LU AND STA TMP SAVE IT CMA,INA SET MINUS LU STA C.CR,I LDA D.RP4 GET START STA C.STR,I TRACK AND SET IN FCB STA C.HTR,I IN BOTH CURRENT AND HEAD TRACK LDA TMP DISC FILE! IOR PROBT OR IN DISC UNPROTECT BITS STA C.HLU,I SET IN FCB LDA D.RP5 EXTRACT AND B377 START SECTOR STA C.SSC,I SET START BLOCK XOR D.RP5 EXTRACT ALF,ALF #BLOCKS/TRACK RAR STA C.S/T,I SET UP NUMBER OF BLOCKS/TRACK IN FCB JMP SETUP,I * * * SET UP A SOURCE INPUT FCB FOR A SON PROCESS * SON1 LDA .FCB1 JSB GTFCB MOVE THE FATHER FCB IN CLA STA C.RSC,I STA C.EXT,I LDA C.FAD,I TEST FOR SCRATCH FILE SZA JMP OPNA NOT A SCRATCH FILE LDA C.HTR,I STA C.STR,I DO A FILE REWIND OPERATION JMP SONXT GO DO A SON_SCRATCH TYPE EXIT * * MOVE AN FCB * THE FROM ADDRESS IS ALREADY IN A * GTFCB BSS 1 JMP *+2 CLEAR ANY INDIRECTS LDA A,I RAL,CLE,SLA,ERA JMP *-2 LDB C.FLU DESTINATION FCB JSB .MVW MOVE IT SWEETY DEF D25 THATS HOW BIG IT IS OCT 0 FOR THE MICRO-CODE JMP GTFCB,I SPC 3 * * CONSTANTS AND BUFFERS * .FCB1 DEF FCB1. .FCB2 DEF FCB2. TMP BSS 1 OPTYP BSS 1 .0 DEC 0 .1 DEC 1 .2 DEC 2 .3 DEC 3 .4 DEC 4 .5 DEC 5 .6 DEC 6 .7 DEC 7 .10 DEC 10 .12 DEC 12 .13 DEC 13 D25 DEC 25 M1 DEC -1 M2 DEC -2 M7 DEC -7 M15 DEC -15 M16 DEC -16 M200 DEC -200 M201 DEC -201 M202 DEC -202 M203 DEC -203 M204 DEC -204 B10 OCT 10 B17 OCT 17 B77 OCT 77 B100 OCT 100 B377 OCT 377 B600 OCT 600 B700 OCT 700 B1000 OCT 1000 UCMSK OCT 77400 END NOP LU NOP READF NOP B101 OCT 100001 B100K OCT 100000 SIGN EQU B100K PROBT OCT 74000 PRMPT BSS 1 MINUS OCT 26400 MINUS CHARACTER AMPSD OCT 23000 AMPERSAND PERCT OCT 22400 PERCENT CHARACTER XCLAM OCT 20400 EXCLAMATION CHARACTER APOST OCT 23400 APOSTROPHE CHARA<:6CTER SPC 2 END ¸<  92060-18055 1805 S C0122 &CLO.C COMPILER LIBRARY CLOSE             H0101 bASMB,R,L,C HED COMPILER LIBRARY CLOSE ROUTINE NAM CLO.C,7 92060-18055 771025 REV. 1805 $CLIB 0815 * * *************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * * REPRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * *************************************************************** * * * * SOURCE PART NUMBER : 92060-18055 * * * CLOSE FILE ROUTINE * * THIS ROUTINE WILL SEARCH THE LINKED LIST OF FCB'S AND REMOVE IT * FROM THE LIST. IT WILL THEN BE CLOSED. IF IT IS A SCRATCH FILE * THE TRACKS WILL BE RETURNED TO THE SYSTEM. IF IT IS A READ FILE * IT WILL BE CLOSED. IF IT IS WRITE FILE THE * FCB WILL BE CHECKED TO SEE IF THE BUFFER NEEDS TO BE WRITTEN OUT * AND IF SO IT WILL BE WRITTEN OUT PRIOR TO CLOSING. * ALSO IF THE FILE DOES NOT HAVE EXTENTS IT WILL BE TRUNCATED. * * * * * * * CALLING SEQUENCE: * * JSB CLO.C * DEF FCB * ERROR RETURN * NO ERROR RETURN * * ON RETURN A < 0 INDICATES ERROR * A = 0 INDICATES NO ERROR * * * * ENTRY POINT: * ENT CLO.C * * EXTERNALS: * EXT EXEC SYSTEM EXEC EXT GEX.C D.RTR REPLACEMENT ROUTINE EXT ADS.C FCB ADDRESS PASSER ROUTINE EXT GE#SC WRITE OUT BUFFER ROUTINE EXT D.RP1 ERROR PARAMETER FROM D.RTR CALL EXT C.HLK HEAD OF FCB LINKED LIST EXT C.LNK FCB LINK WORD EXT C.FCB ADDRESS OF FCB EXT C.FID FCB ID WORD EXT C.FLU FCB LOGICAL UNIT WORD EXT C.STR FCB CURRENT EXTENT TRACK NUMBER WORD EXT C.SSC FCB CURRENT EXTENT SECTOR NUMBER WORD EXT C.EXT FCB EXTENT NUMBER WORD EXT C.S/T FCB NUMBER OF BLOCKS/TRACK WORD EXT C.#SC FCB NUMBER OF BLOCKS/EXT]ENT WORD EXT C.RSC CURRENT OFFSET SECTOR NUMBER EXT C.BFF FCB BUFFER ADDRESS WORD EXT C.WRD FCB CURRENT WORD POINTER WORD EXT C.FAD FCB DIRECTORY ADDRESS FROM D.RTR WORDS EXT C.HTR FCB START OF FILE TRACK NUMBER WORD EXT C.SLU FCB SECONDARY LOGICAL UNIT NUMBER WORD EXT C.?? FCB PROMPT CHARACTERS EXT C.GRW FCB REWIND GUARANTEE ROUTINE ADDRESS EXT C.INS FCB $INCLUDE ROUTINE ADDRESS EXT C.SON THE SON PROCESS FLAG EXT LURQ THE LU LOCK GUY EXT .TTY THE INTERACTIVE TEST GUY * EXT C.FCB ADDRESS OF FCB * * * * DETERMINE TYPE OF OPERATION * * THE FCB CONTAINS THE OPERATION TYPE AS FOLLOWS: * * TYPE = 0 IS READ SOURCE FILE(OR LU) * = 1 IS WRITE BINARY FILE(OR LU) * = 2 IS WRITE SCRATCH FILE * = 3 IS WRITE LIST FILE(OR LU) * * * A EQU 0 B EQU 1 * CLO.C NOP JSB ADS.C SET UP FILE CONTROL BLOCK ADDRESSES DEC 0 CLA STA SECTS SET FOR NO TRUNCATION LDA AHEAD GET ADDRESS OF NEXT LDB A,I PTR AND ALSO PTR SZA,RSS IS IT EMPTY? JMP CLO.C,I ERROR EXIT CPB C.FCB IS IT THE ONE WE'RE LOOKING FOR JMP FND YES, GOT IT LDA B NO, CONTINUE ON DOWN THE LIST JMP NEXT FND LDB B,I REMOVE STB A,I IT BY CONNECTING NEXT TO PREVIOUS FCB * LDA C.FID,I IS THIS A LOGICAL SSA,RSS UNIT? JMP FILE NO, GO PROCESS THE FILE LDA C.FLU,I STA LU JSB .TTY TEST FOR INTERACTIVE DEF *+1+1 DEF LU SSA IF INTERACTIVE THEN JMP EXIT JUST BUG OUT JSB LURQ UNLOCK THE TURKEY DEF *+3+1 DEF .40K UNLOCK REQ DEF C.FLU,I DEF .1 NOP JMP EXIT * FILE LDA C.FID,I DETERMINE AND =B7 FCB 1 TYPE CPA .2 SCRATCH? JMP CLSSC CLOSE SCRATCH FILE SZA READ FCB CPA =D4 SOURCE REWIND FILE? JMP CLSRD CLOSE SOURCE TYPE FILES * CLSWR LDA C.BFF,I SHOULD BUFFER SSA,RSS BUFFER BE FLUSHED? JMP TRUN NO! CLA CLOSE WRITE FCB CLB JSB GE#SC AND FLUSH BUFFER JMP CLO.C,I ERROR RETURN * * TRUNCATE IF NO EXTENTS * TRUN LDA C.EXT,I IS SZA AND EXTENTS? JMP CLSRD YES! LDA C.#SC,I DETERMINE CMA,INA ADA C.RSC,I NUMBER OF UNUSED INA SECTORS ALS STA SECTS JMP CLSRD CLOSE FILE * * * CLOSE SCRATCH FILE * CLSSC LDA .5 CALL CLOSE GEX.C TO RETURN SCRATCH FILE JSB GEX.C JMP EXIT YES! * * CLOSE READ FILE * CLSRD LDA C.SON LDB C.FAD,I SSA,RSS IF SON_PROCESS THEN JMP SCRTX TEST FOR SCRATCH SZB,RSS IF SCRATCH THEN JMP EXIT JUST BUG OUT * SCRTX SZB,RSS IF SCRATCH THEN JMP CLSSC GIVE IT BACK CLA CLOSE FILES CLB JSB GEX.C DEF SECTS JMP CLO.C,I ERROR EXIT P+1 EXIT ISZ CLO.C JMP CLO.C,I OK RETURN P+2 * * CONSTANTS AND BUFFERS * AHEAD DEF C.HLK ADDRESS OF HEAD OF LINKED LIST SECTS NOP NUMBER OF SECTORS TO TRUNCATE LU EQU SECTS ID BSS 5 .40K OCT 40000 UNLOCK - NO ABORT .1 DEC 1 .2 DEC 2 .5 DEC 5 B17 OCT 17 END ե  92060-18056 1726 S C0122 COMPILER LIBRARY READ             H0101 ASMB,L,C NAM RED.C,7 92060-18056 770523 REV. 1726 $CLIB * * NAME: RED.C * SOURCE: 92060-18056 * PGMR: EARL STUTES * *************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * * REPRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * *************************************************************** SPC 2 * THIS IS THE TOP LEVEL DRIVE ROUTINE FOR THE COMPILER * LIBRARY READ FUNCTION SPC 3 * PROC READFCB(FCB,BUFFER,LENGTH,LINE#); * VALUE LENGTH;INTEGER LENGTH,LINE#;RECORD FCB; * INTEGER ARRAY BUFFER; * EXIT AT PARAMETER LIST + 1 WITH ERROR NUMBER IN A * EXIT AT PARAMETER LIST + 2 WITH RECORD NUMBER IN A AND * WORD COUNT IN B * BEGIN * ADDRESSSETUP; * IF FCB.PROMPT <> 0 THEN * EXEC(2,FCB.FLU,FCB.PROMPT,1); * READARECORD; * IF ERROR THEN GO ERROR EXIT; * ALENGTH ;= B; * WRITEAFTERREAD; * IF ERROR THEN GO ERROR EXIT; * A := FCB.RECORD# := FCB.RECORD# + 1; * INCLUDE; * IF ERROR THEN GO ERROR EXIT; * B := RECORDLENGTH; * END OF READFCB; SKP ENT RED.C EXT C.GRW ADDRESS OF THE WRITEAFTERREAD ROUTINE EXT C.INS ADDRESS OF THE INCLUDE ROUTINE EXT ADS.C POINTER SETUP ROUTINE EXT C.RC# THE CURRENT RECORD # EXT C.?? THE FCB PROMPT CHARACTER AND FLAG * * PROC READFCB(FCB,BUFFER,LENGTH,LINE#); * VALUE LENGTH;INTEGER LENGTH,LINE#;RECORD FCB; * INTEGER ARRAY BUFFER; * BEGIN ALEN BSS 1 RED.C BSS 1 * ADDRESSSETUP; JSB ADS.C DEC -2 * IF FCB.PROMPT <> 0 THEN LDA C.??,I SZA,RSS JMP L00 JSB EXEC DEF *+4+1 DEF .2 DEF C.FLU,I DEF C.??,I DEF .1 * READARECORD; L00 JSB REDC. * IF ERROR THEN GO ERROR EXIT; JMP RED.C,I * ALA%ENGTH := B; STB ALEN * WRITEAFTERREAD; JSB C.GRW,I * IF ERROR THEN GO ERROR EXIT; JMP RED.C,I * A := FCB.RECORD# := FCB.RECORD# + 1; LDA C.RC#,I INA STA C.RC#,I * INCLUDE; JSB C.INS,I * IF ERROR THEN GO ERROR EXIT; JMP RED.C,I * B := RECORDLENGTH; LDB ALEN * END OF READFCB; ISZ RED.C JMP RED.C,I SKP * IT IS ASSUMED THAT THE REQUIRED ENVIRONMENT HAS BEEN SET UP * BY THE CALLING ROUTINE NAMELY THAT ALL PARAMETERS NECESSARY * FOR THE PROPER EXECUTION HAVE BEEN SET BEFORE THE CALL * * IT IS ALSO ASSUMED THAT THE ROUTINE WILL RETURN TO P+1 ON * ERROR CONDITIONS WITH THE ERROR CODE IN THE A REGISTER. * * THE NORMAL RETURN WILL BE TO P+2 WITH THE WORD COUNT IN B * A AT THAT TIME WILL BE MEANINGLESS SPC 3 *PROC READARECORD; * BEGIN * INTEGER UP,SAVECOUNT,WORKCOUNT; * IF FCB.UNITRECORD THEN * EXEC(1,FCB.LU,USERBUFFER,RLENGTH) * ELSE * [ IF (NOT BUFFERVALID) OR (FCB.BP > 128) THEN * [ GETNEXTSECTOR(TRUE); * IF ERROR THEN GO TO ERROR EXIT; ] * UP := 0; * WORKCOUNT := SAVECOUNT := DISCBUFFER[FCB.BP]; * IF WORKCOUNT < 0 THEN * GO EXIT * ELSE * [ WHILE WORKCOUNT > 0 DO * [ FCB.BP := FCB.BP+1; * IF FCB.BP > 128 THEN * [ GETNEXTSECTOR(TRUE); * IF ERROR THEN GO TO ERROR EXIT; ] * USERBUFFER[UP] := DISCBUFFER[FCB.BP]; * UP := UP+1; * IF UP = RLENGTH THEN * [ B := RLENGTH; * FCB.BP := FCB.BP + WORKCOUNT + 1; * GO EXIT2;]; * WORKCOUNT := WORKCOUNT-1 ]; * FCB.BP := FCB.BP+2;]; *EXIT: B := SAVECOUNT;] *EXIT2: * END OF READARECORD; SKP EXT C.STR FCB.STARTRACK EXT C.FLU THE FILE PRIMARY LU EXT C.BFF THE FCB BUFFER POINTER EXT C.FAD FMGR DIRECTORY ADDRESS EXT C.WRD BP EQU C.WRD DISC BUFFER POINTER EXT EXEC GUESS WHO EXT C.PR1 THE CALLER'S FIRST PARAMETER .UBUF EQU C.PR1 EXT C.FID FCB ID WORD EXT C.PR2 THE CALLER'S SECOND PARAMETER RLEN EQU C.PR2 LENGTH OF USER BUFFER EXT GES.C THE READ/WRITE SECTOR WORK HORSE *PROC READARECORD; * BEGIN * INTEGER UP,SAVECOUNT,WORKCOUNT; UP BSS 1 USER BUFFER POINTER SAVC BSS 1 DISC RECORD LENGTH HOLDER WORKC BSS 1 DISC RECORD WORKING COUNTER .1 DEC 1 .2 DEC 2 .M1 DEC -1 SPC 2 B EQU 1 ENT REDC. REDC. BSS 1 * IF FCB.UNITRECORD THEN LDA C.FID,I UNITRECORD FLAG IS THE SIGN BIT SSA,RSS JMP L0 * EXEC(1,FCB.LU,USERBUFFER,RLENGTH) JSB EXEC DEF *+4+1 DEF .1 DEF C.FLU,I DEF .UBUF,I DEF RLEN,I JMP L5 * ELSE * [ IF (NOT BUFFERVALID) OR (FCB.BP > 128) THEN L0 LDA C.BFF,I AND =B77777 SZA,RSS JMP GETIT LDA BP,I ADA =D-129 SSA JMP L1 * [ GETNEXTSECTOR(TRUE); GETIT CCA JSB GES.C * IF ERROR THEN GO ERROR EXIT; ] JMP REDC.,I * UP := 0; L1 CLA STA UP * WORKCOUNT := SAVECOUNT := DISCBUFFER[FCB.BP]; LDB C.BFF ADB BP,I LDA B,I STA SAVC * IF WORKCOUNT < 0 THEN SSA,RSS JMP WHILE * GO EXIT; JMP EXIT * ELSE * WHILE WORKCOUNT > 0 DO WHILE STA WORKC SZA,RSS JMP EWHIL * [ FCB.BP := FCB.BP+1; ISZ BP,I * IF FCB.BP > 128 THEN LDA BP,I ADA =D-129 SSA JMP L3 * [ GETNEXTSECTOR(TRUE); CCA JSB GES.C * IF ERROR THEN GO ERROR EXIT; ] JMP REDC.,I * END; * USERBUFFER[UP] := DISCBUFFER[FCB.BP]; L3 LDB C.BFF ADB BP,I LDA B,I LDB .UBUF ADB UP STA B,I * UP := UP+1; ISZ UP * IF UP = RLENGTH THEN LDB UP CPB RLEN,I JMP *+2 JMP L4 * [ B := RLENGTH; * FCB.BP := FCB.BP + W(ORKCOUNT + 1; LDA BP,I ADA WORKC INA STA BP,I * GO EXIT2;] JMP EXIT2 * WORKCOUNT := WORKCOUNT-1 ] L4 CCA ADA WORKC JMP WHILE EWHIL EQU * * FCB.BP ;= FCB.BP+2 ]; ISZ BP,I ISZ BP,I *EXIT: B := SAVECOUNT; EXIT EQU * LDB SAVC *EXIT2: EXIT2 EQU * L5 ISZ REDC. JMP REDC.,I END   92060-18057 1726 S C0122 COMPILER LIBRARY WRITE             H0101 ASMB,L,C NAM WRT.C,7 92060-18057 770523 REV. 1726 $CLIB * * * NAME: WRT.C * SOURCE: 92060-18057 * PGMR: EARL STUTES * *************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * * REPRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * *************************************************************** SPC 2 * THIS IS THE TOP LEVEL DRIVE ROUTINE FOR THE COMPILER * LIBRARY WRITE FUNCTION SPC 3 * PROC WRITEFCB(,FCB,BUFFER,LENGTH); * VALUE LENGTH;INTEGER LENGTH;INTEGER ARRAY BUFFER;RECORD FCB; * EXIT AT PARAMETER LIST + 1 WITH ERROR NUMBER IN A * EXIT AT PARAMETER LIST + 2 REGISTERS MEANINGLESS * BEGIN * ADDRESSSETUP; * WRITEARECORD(LENGTH); * IF ERROR THEN GO ERROR EXIT; * END OF WRITEFCB; ENT WRT.C EXT ADS.C POINTER SETUP ROUTINE EXT C.PR2 LENT. EQU C.PR2 * * PROC WRITEFCB(FCB,BUFFER,LENGTH); * VALUE LENGTH;INTEGER LENGTH;INTEGER ARRAY BUFFER;RECORD FCB; * BEGIN WRT.C BSS 1 ENTRY POINT * ADDRESSSETUP; JSB ADS.C DEC -2 * WRITEARECORD(LENGTH); LDB LENT.,I JSB WRTC. * IF ERROR THEN GO ERROR EXIT; JMP WRT.C,I * END OF WRITEFCB; ISZ WRT.C JMP WRT.C,I SKP * THIS ROUTINE ASSUMES THAT THE REQUIRED ENVIRONMENT HAS BEEN SET UP * BY THE CALLER, NAMELY THAT ALL PARAMETERS NECESSARY FOR THE PROPER * EXECUTION HAVE BEEN SET BEFORE THE CALL. * * IT IS ALSO ASSUMED THAT THE ROUTINE WILL RETURN TO P+1 ON * ON ERROR CONDITIONS WITH THE ERROR CODE IN THE A REGISTER. * * THE NORMAL RETURN WILL BE TO P+2 WITH BOTH REGISTERS MEANINGLESS SPC 3 * PROC BUMBP; * BEGIN * FCB.BP := FCB.BP+1; * IF FCB.BP >= 128 THEN * [ WRITEBUFFER ;= TRUE; * GETNEXTSECTOR(FALSE); * IF ERROR THEN GO ERROR EXIT;] * END OF BUMBP & NORMAL RETURN TO P+1 ERROR EXITS WRITEARECORD SPC 3 BUMBP BSS 1 ISZ BP,I LDA BP,I ADA =D-129 SSA JMP BUMBP,I CLA,CCE ERA WRITEBUFFER FLAG = SIGN BIT STA C.BFF,I OF THE FIRST WORD IN THE BUFFER CLA JSB GES.C JMP WRTC.,I ALL THE WAY OUT JMP BUMBP,I SKP *PROC WRITEARECORD(LENGTH); *VALUE LENGTH; INTEGER LENGTH; * THE LENGTH WILL BE PASSED IN THE B REGISTER * BEGIN * INTEGER UP, * WORKCOUNT, * .2; * IF LENGTH < 0 THEN GO EXIT; * IF UNITRECORD THEN * EXEC(2,FCB.LU,USERBUFFER,LENGTH) * ELSE * [ UP := 0; * DISCBUFFER[FCB.BP] := WORKCOUNT := LENGTH; * WHILE WORKCOUNT > 0 DO * [ BUMBP; * DISCBUFFER[FCB.BP] := USERBUFFER[UP]; * UP := UP+1; * WORKCOUNT ;= WORKCOUNT-1; ]; * BUMBP; * DISCBUFFER[FCB.BP] := LENGTH; * BUMBP; * DISCBUFFER[FCB.BP] ;= -1; * WRITEBUFFER := TRUE;]; * END OF WRITEARECORD; SKP ENT WRTC. EXT C.FID FCB.ID THE FCB ID WORD EXT C.WRD EXT C.FLU FCB LU BP EQU C.WRD DISC BUFFER POINTER EXT C.BFF DISC BUFFERHEAD POINTER EXT C.PR1 THE USERS FIRST PARAMETER .UBUF EQU C.PR1 USER BUFFERHEAD POINTER EXT GES.C THE SECTOR READWRITE WORK HORSE B EQU 1 EXT EXEC GUESS WHO *PROC WRITEARECORD(LENGTH); * VALUE LENGTH; INTEGER LENGTH; * THE LENGTH WILL BE PASSED IN THE B REGISTER LENT# BSS 1 THE LENGTH VALUE HOLDER * BEGIN * INTEGER UP, UP BSS 1 * WORKCOUNT, WORKC BSS 1 * .2 := 2; .2 DEC 2 WRTC. BSS 1 ENTRY POINT STB LENT# * IF LENGTH < 0 THEN GO EXIT; SSB JMP EXIT * IF UNITRECORD THEN LDB C.FID,I UNITRECORD FLAG IS THE SIGN BIT OF THE ID SSB,RSS JMP L1 * EXEC(2,LU,.UBUF,LENGTH) JSB EXEC DEF *+4+1 DEF .2 DEF C.FLU,I DEF .UBUF,I VL DEF LENT# JMP EXIT * ELSE * UP := 0; L1 CLA STA UP * DISCBUFFER[FCB.BP] := WORKCOUNT := LENGTH; LDB C.BFF ADB BP,I LDA LENT# STA B,I * WHILE WORKCOUNT > 0 DO WHILE STA WORKC SZA,RSS JMP EWHIL * [ BUMBP; JSB BUMBP * DISCBUFFER[FCB.BP] := USERBUFFER[UP]; LDB .UBUF ADB UP LDA B,I LDB C.BFF ADB BP,I STA B,I * UP := UP+1; ISZ UP * WORKCOUNT := WORKCOUNT-1;]; CCA ADA WORKC JMP WHILE EWHIL EQU * * BUMBP; JSB BUMBP * DISCBUFFER[FCB.BP] := LENGTH; LDB C.BFF ADB BP,I LDA LENT# STA B,I * BUMBP; JSB BUMBP * DISCBUFFER[FCB.BP] ;= -1;]; CCA LDB C.BFF ADB BP,I STA B,I * WRITEBUFFER := TRUE; CLA,INA RAR STA C.BFF,I * END OF WRITEARECORD; EXIT ISZ WRTC. JMP WRTC.,I END 4  92060-18058 1805 S C0122 &SPC.C COMPILER LIBRARY SPACE             H0101 hASMB,R,L,C HED COMPILER LIBRARY SPACE ROUTINE NAM SPC.C,7 92060-18058 770809 REV. 1805 $CLIB 1250 * * *************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * * REPRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * *************************************************************** * * * * SOURCE PART NUMBER : 92060-18058 * * * LINE SPACE ROUTINE * * THIS ROUTINE WILL EJECT PAGES AND SPACE LINES ON LISTINGS * * * * * * * CALLING SEQUENCE: * * JSB SPC.C * DEF FCB * DEF FUN * ERROR RETURN * NO ERROR RETURN * * ON RETURN A < 0 INDICATES ERROR * A = 0 INDICATES NO ERROR * * WHERE FUN < 0 INDICATES PAGE EJECT IF LINE PRINTER * FUN > 0 SPACE 'FUN' LINES. * * * * ENTRY POINT: * ENT SPC.C * * EXTERNALS: * EXT EXEC SYSTEM EXEC EXT WRTC. WRITE ROUTINE EXT ADS.C FCB ADDRESS PASSER ROUTINE EXT C.FID FCB ID WORD EXT C.FLU FCB LOGICAL UNIT WORD EXT C.STR FCB CURRENT EXTENT TRACK NUMBER WORD EXT C.SSC FCB CURRENT EXTENT SECTOR NUMBER WORD EXT C.EXT FCB EXTENT NUMBER WORD EXT C.S/T FCB NUMBER OF BLOCKS/TRACK WORD EXT C.#SC FCB NUMBER OF BLOCKS/EXTENT WORD EXT C.WRD FCB CURRENT WORD POINTER WORD EXT C.FAD FCB DIRECTORY ADDRESS FROM D.RTR WORDS EXT C.HTR FCB START OF FILE TRACK NUMBER WORD EXT C.SLU FCB SECONDARY LOGICAL UNIT NUMBER WORD EXT C.?? FCB PROMPT CHARACTERS EXT C.GRW FCB REWIND GUARANTEE ROUTINE ADDRESS EXT C.INS FCB $INCLUDE ROUTINE ADDRESS * EXT C.PR1 PARAMETER ONE ADDRESS * * * * DETERMINE TYPE OF OJJPERATION * * THE FCB CONTAINS THE OPERATION TYPE AS FOLLOWS: * * TYPE = 0 IS READ SOURCE FILE(OR LU) * = 1 IS WRITE BINARY FILE(OR LU) * = 2 IS WRITE SCRATCH FILE * = 3 IS WRITE LIST FILE(OR LU) * = R IS READ SOURCE GUARANTEE REWINDABLILITY * * * A EQU 0 B EQU 1 * SPC.C NOP JSB ADS.C SET UP FILE CONTROL BLOCK ADDRESSES M1 DEC -1 LDB C.PR1,I GET CONTROL FUNCTION WORD LDA C.FID,I GET FILE/LU FLAG SSA IS THIS LU? JMP LUDEV YES! * * THIS A FILE SO WRITE EITHER A M1 FOR PAGE EJECT OR WRITE * THE NECESSARY LINE FOR LINE SPACING. * LDA LBUF SET UP BUFFER STA C.PR1 FOR WRITE SSB PAGE EJECT? JMP EJCTF WRITE A M1 IN COL 1 OF A LINE TO DO PAGE EJECT CMB,INB SET UP LINE STB CTR COUNTER WRT LDB .1 WRITE A JSB WRTC. A BLANK LINE(ONE CHAR) JMP ERROR ERROR RETURN ISZ CTR DONE? JMP WRT NO! JMP RETRN YES! * * EJECT PAGE * EJCTF LDA PBUF SET UP STA C.PR1 PAGE EJECT BUFFER LDB .1 JSB WRTC. WRITE A MINUS ONE FOR PAGE EJECT JMP ERROR ERROR RETURN JMP RETRN * LUDEV LDA C.FLU,I SET UP CONTROL WORD AND B77 MASK EXTRANEOUS BITS IOR B1100 MASK IN LINE CONTROL FUNCTIONS STA LU STB CTR SET CONTROL FUNCTION JSB EXEC PERFORM DEF *+4 DEF .3 CONTROL FUNCTION DEF LU DEF CTR RETRN ISZ SPC.C GOOD RETURN ERROR JMP SPC.C,I RETURN * * CONSTANTS AND VARIABLES * .1 DEC 1 .3 DEC 3 B77 OCT 77 B1100 OCT 1100 CTR NOP LINE COUNTER LU NOP LOGICAL UNIT LBUF DEF *+1 ASC 1, BLANKS PBUF DEF .1 END    92060-18059 1805 S C0122 &RWN.C COMPILER LIBRARY REWIND             H0101 ASMB,L,C NAM RWN.C,7 92060-18059 771025 REV. 1805 $CLIB 0735 * * NAME: RWN.C * SOURCE: 92060-18059 * PGMR: EARL STUTES * *************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * * REPRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * *************************************************************** SPC 2 * THIS PROCEDURE PROVIDES THE REWIND FUNCTION FOR THE COMPILER * LIBRARY/ SPC 3 * PROC REWIND(FCB); * RECORD FCB; * BEGIN * BOOLEAN READWRITEFLAG := FALSE; * ADDRESSETUP; * IF FCB.TYPE = REWIND AND FCB.UNITRECORD THEN * [ FCB.UNITRECORD := FALSE; * IF INTERACTIVE(FCB.FLU) THEN * FCB.PROMPT := 0; * ELSE * UNLOCK(FCB.FLU); * FCB.FLU := FCB.SLU;] * IF WRITEBUFFER THEN * GETNEXTSECTOR(FALSE); * IF ERROR THEN GO ERROR EXIT;] * FCB.EXTENT# := 0; * GEX.C(3,FALSE); * ^ * +---------READWRITEFLAG = WRITE * IF RETURNP1 < 0 THEN * GO ERROR EXIT; * FCB.STARTTRACK := RETURNP4; * FCB.STARTSECTOR := RETURNP5 AND @377; ] * FCB.OFFSETBLOCK :=0; * FCB.RECORD# := 0; * BUFFERVALID := FALSE; * FCB.BP ;= 1; * END OF REWIND SKP ENT RWN.C EXT ADS.C ADDRESS SETUP PROC EXT C.FLU FCB PRIMARY FILE LU EXT C.HLU FCB HEAD LOGICAL UNIT EXT C.SLU FCB SECONDARY FILE LU EXT C.FAD FCB FILE DIRECTORY ADDRESS EXT C.HTR FCB HEAD TRACK EXT C.STR FCB START TRACK EXT C.SSC FCB START SECTOR EXT C.RSC FCB OFFSET BLOCK EXT C.FID FCB ID EXT C.EXT FCB EXTENT # EXT C.BFF FCB BUFFER POINTER EXT C.?? FCB PROMPT CHARACTER HOLDER EXT C.WRD FCB WORD OFFSET POINTER  EXT C.RC# FCB RECORD NUMBER EXT GES.C THE DISC READ/WRITE ROUTINE EXT GEX.C THE HIDE THE FMGR/OPSYS ROUTINE EXT D.RP1 D.RTR RETURN PARAMETER 1 EXT D.RP4 D.RTR RETURN PARAMETER 4 EXT D.RP5 D.RTR RETURN PARAMETER 5 EXT EXEC GUESS WHO EXT .TTY THE INTERACTIVE TTY TEST ROUTINE EXT LURQ THE LU LOCK ROUTINE B EQU 1 SPC 2 * PROC REWIND(FCB); * RECORD FCB; * BEGIN UNLOK OCT 40000 .1 DEC 1 * BOOLEAN READWRITEFLAG := FALSE; RWFLG OCT 0 LU BSS 1 SPC 2 RWN.C BSS 1 ENTRY POINT * ADDRESSETUP; JSB ADS.C DEC 0 * IF FCB.TYPE = REWIND AND FCB.UNITRECORD THEN LDA C.FID,I AND =B100007 CPA =B100004 JMP *+2 JMP WTEST * [ FCB.UNITRECORD := FALSE; LDA C.FID,I ELA,CLE,ERA STA C.FID,I * IF INTERACTIVE(FCB.FLU) THEN LDA C.FLU,I AND =B77 STA LU JSB .TTY DEF *+1+1 DEF LU SSA,RSS JMP L0X * FCB.PROMPT := 0; CLA STA C.??,I * ELSE * UNLOCK(LU); L0X JSB LURQ DEF *+3+1 DEF UNLOK DEF LU DEF .1 NOP DON'T DO ANYTHING ABOUT IT * FCB.FLU := FCB.SLU; ] LDA C.SLU,I STA C.FLU,I * IF WRITEBUFFER THEN WTEST LDA C.BFF,I SSA,RSS JMP L0 * [ GETNEXTSECTOR(FALSE); LA EQU * CLA JSB GES.C * IF ERROR THEN GO ERROR EXIT;] JMP RWN.C,I * FCB.EXTENT# := 0; L0 EQU * CLA STA C.EXT,I * GEX.C(3,FALSE); LDA =D3 JSB GEX.C DEF RWFLG * IF RETURNP1 < 0 THEN * GO ERROR EXIT; JMP RWN.C,I * FCB.STARTTRACK := RETURNP4; LDA D.RP4 STA C.STR,I * FCB.STARTSECTOR := RETURNP5 AND @377; ] LDA D.RP5 AND =B377 STA C.SSC,I * FCB.OFFSETBLOCK := 0; L2 EQU * CLA STA  C.RSC,I * FCB.RECORD# := 0; STA C.RC#,I * BUFFERVALID := FALSE; STA C.BFF,I * FCB.BP ;= 1; INA STA C.WRD,I * END OF REWIND ISZ RWN.C JMP RWN.C,I END ļ  92060-18060 1726 S C0122 COMPILER LIBRARY EOF             H0101 ASMB,L,C NAM EOF.C,7 92060-18060 770523 REV. 1726 $CLIB * * NAME: EOF.C * SOURCE: 92060-18060 * PGMR: EARL STUTES * *************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * * REPRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * *************************************************************** SPC 2 * THIS PROCEDURE PROVIDES THE END OF FILE FUNCTION FOR THE COMPILER * LIBRARY * * PROC ENDOFFILE(FCB); * RECORD FCB; * BEGIN * INTEGER FUNCTION, * .M2 := -2, * .3 := 3; * ADDRESSETUP; * IF FCB.UNITRECORD THEN * [ FUNCTION := FCB.LU AND @77 OR @100; * EXEC(.3,FUNCTION); * FUNCTION := FCB.LU AND @77 OR @1000; * EXEC(.3,FUNCTION); * FUNCTION := FCB.LU AND @77 OR @1100; * EXEC(.3,FUNCTION,.M2);] * ELSE * [ IF WRITEBUFFER THEN * [ GETNEXTSECTOR(FALSE); * IF ERROR THEN GO ERROR EXIT;] * END OF ENDOFFILE; SKP ENT EOF.C EXT EXEC GUESS WHO EXT ADS.C FIX UR POINTERS CHEAP EXT C.BFF THE DISC BUFFER POINTER EXT GES.C DISC SECTOR READ/WRITE PROC EXT C.FID FCB ID WORD EXT C.FLU FCB LU WORD B EQU 1 * PROC ENDOFFILE(FCB); * RECORD FCB; * BEGIN * INTEGER FUNCTION, FUNC. BSS 1 * .M2 := -2, .M2 DEC -2 * .3 := 3; .3 DEC 3 SPC 2 EOF.C BSS 1 * ADDRESSETUP; JSB ADS.C DEC 0 * IF FCB.UNITRECORD THEN LDA C.FID,I SSA,RSS JMP L1 * [ FUNCTION := FCB.LU AND @77 OR @100; LDB =B100 JSB ANDOR * EXEC(.3,FUNCTION); JSB EXEC DEF *+2+1 DEF .3 DEF FUNC. * FUNCTION := FCB.LU AND @77 OR @1000; LDB =B1000 JSB ANDOR * EXEC(.3,FUNCTION); JSB EXEC ^   DEF *+2+1 DEF .3 DEF FUNC. * FUNCTION := FCB.LU AND @77 OR @1100; LDB =B1100 JSB ANDOR * EXEC(.3,FUNCTION,.M2); JSB EXEC DEF *+3+1 DEF .3 DEF FUNC. DEF .M2 JMP EXIT * ELSE L1 EQU * * IF WRITEBUFFER THEN LDA C.BFF,I SSA,RSS JMP EXIT * [ GETNEXTSECTOR(FALSE); CLA JSB GES.C * IF ERROR THEN GO ERROR EXIT;] JMP EOF.C,I * END OF ENDOFFILE; EXIT ISZ EOF.C JMP EOF.C,I SPC 3 ANDOR BSS 1 LDA C.FLU,I AND =B77 IOR B STA FUNC. JMP ANDOR,I END B   92060-18061 1726 S C0122 COMPILER LIBRARY GET MEM             H0101 ASMB,L,C HED COMPILER LIBRARY - GET MAIN MEMORY * *************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * * REPRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * *************************************************************** * * * * * IFN NAM GMM.C,7 92060-18061 770523 REVM 1726 $CLIB EXT LIMEM XIF IFZ NAM GMM.C,7 92060-18061 770523 REV. 1726 $CLIB EXT COR.A,ID.AD XIF ENT GMM.C * * THIS COMPILER LIBRARY ROUTINE SCANS THE CALLER-PROVIDED SEGMENTS' * ID SEGMENTS AND RETURNS THE AMOUNT OF MAIN MEMORY BETWEEN THE * HIGHEST USED AND THE END OF MAIN MEMORY. THIS IS THE AREA THAT * MAY BE USED AS SYMBOL TABLE AREA BY THE CALLER. * * CALLING SEQUENCE: JSB GMM.C * DEF #SEGS NUMBER OF SEGMENTS * DEF ENTRY POINT OF A ROUTINE WHICH * HAS THE FOLLOWING CALLING SEQUENCE: * RETURNS: A = FWAM * B = LWAM * * * JSB * DEF SEG# SEGMENT NUMBER (POSITIVE) * SEG# < #SEGS * * RETURNS: B = ADDRESS OF THE REFERENCED SEGMENT'S * (SEG#) NAME (5 CHARACTERS) * * GMM.C NOP ENTRY IFZ LDA XEQT SET MINIMUM ADDRESS JSB COR.A AS MAIN'S FWAM STA CMIN LDA GMM.C,I LDA A,I GET # OF SEGMENTS CMA,INA,SZA,RSS AND TEST FOR COMPLETION JMP DONE * STA NSEG ISZ GMM.C STEP TO ADDRESS OF TRANSLATOR LDA GMM.C,I SAVE SEGMENT TRANSFER STA ENTRY ADDRESS CLA INITJB  IALIZE CALL NUMBER STA SEG# NEXT JSB ENTRY,I GET NAME OF SEGMENT DEF SEG# * JSB ID.AD GET SEGMENT'S ADDRESS SZB,RSS IF NONE, SKIP IT JMP NOID * LDA B GET FWAM JSB COR.A STA B COMPARE TO CURRENT FWAM CMB,INB ADB CMIN IF HIGHER, SSB SET NEW FWAM STA CMIN NOID ISZ SEG# INCREMENT SEGMENT # ISZ NSEG AND COUNT IT JMP NEXT TRY NEXT SEGMENT * DONE LDB BKLWA B=LWAM XIF IFN JSB LIMEM GET DATA FROM SUP DEF *+4 DEF NSEG JUST A ZERO DEF CMIN DEF ENTRY CCB COMPUTE THE LWAM ADB ENTRY ADB CMIN FROM THE # OF WORDS AND ORG ISZ GMM.C STEP RETURN ADDRESS XIF LDA CMIN A=FWAM ISZ GMM.C JMP GMM.C,I EXIT * BKLWA EQU 1777B XEQT EQU 1717B A EQU 0 B EQU 1 CMIN NOP ENTRY NOP NSEG NOP IFZ SEG# NOP XIF END ~*   92060-18062 1726 S C0122 COMPILER LIBRARY OVERLAY             H0101 ASMB,L HED COMPILER LIBRARY - GET SEGMENT * *************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * * REPRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * *************************************************************** * * * * * IFN NAM OLY.C,7 92060-18062 770523 REVM 1726 $CLIB EXT SEGLD SUP EQU SEGLD XIF IFZ NAM OLY.C,7 92060-18062 770523 REV. 1726 $CLIB EXT EXEC SUP EQU EXEC XIF ENT OLY.C ENT C.OLY ADDRESS OF CURRENT SEGS ID * * THIS COMPILER LIBRARY ROUTINE LOADS A NEW SEGMENT INTO MEMORY * AND TRANSFERS CONTROL TO IT. * * CALLING SEQUENCE: JSB OLY.C * DEF SEGID POINTER TO SEGMENT NAME * * OLY.C NOP ENTRY LDA OLY.C,I STA C.OLY SEGMENT NAME JSB SUP CALL THE SUPERVISOR DEF *+3 IFZ DEF SEGL XIF C.OLY NOP IFN DEF SEGL XIF ISZ OLY.C SHOULD NOT RETURN JMP OLY.C,I IF IT RETURNS, EXIT * SEGL OCT 100010 END )  92060-18063 1805 S C0122 &RUN.C COMPILER LIBRARY RUN PROG             H0101 ASMB,L NAM RUN.C,7 92060-18063 770812 REV. 1805 $CLIB 1155 * PROC RUN.C(FCB1,FCB2,PRAM,ID); * STRING ID; * COMMENT ID IS THE NAME STRING OF THE PROGRAM TO BE SCHEDULED; * INTEGER ARRAY PRAM; * COMMENT PRAM IS A 5 WORD ARRAY USED TO PASS USER DATA BETWEEN * THE FATHER AND SON PROCESSES; * RECORD FCB1,FCB2; * COMMENT FCB'S ARE DATA STRUCTURES CONTAINING ALL THE DATA * NECESSARY TO MANAGE A FILE IT IS ASSUMED THAT FCB1 IS TO BE * THE INPUT FILE, AND FCB2 IS THE LIST FILE BEING PASSED TO THE * SON PROCESS; * BEGIN * MOVE FCB1 TO FCB1. FOR 25 WORDS; * MOVE FCB2 TO FCB2. FOR 25 WORDS; * IF FCB1 = SYSSCRATCH THEN * UNLINK(FCB1); * CLOSE-ALL-LINKED-FCB'S; * SCHEDULE(ID,PRAMLIST); * IF ERROR THEN GO ERROR EXIT; * PICKUP_AND_STORE_THE_RETURN_PARAMETERS; * IF FCB1 = SYSSCRATCH THEN * LINK_IT_BACK_IN; * END OF RUN.C; SKP ENT RUN.C EXT EXEC GUESS WHO EXT .MVW THE MOVE WORDS GUY EXT C.TRN THE TURN ON STRING EXT C.LEN THE TURN ON STRING LENGTH EXT CLO.C THE LIBRARY CLOSE ROUTINE EXT ADS.C PARAMETER SET UP EXT GEX.C D.RTR CALLER EXT INDC. INDIRECT CLEANER EXT FCB1. FCB1'S PLACE IN THE TURN ON STRING EXT FCB2. FCB1'S PLACE IN THE TURN ON STRING EXT C.HLK THE FCB LINKED LIST HEAD EXT C.PAS THE PARAMETER PASSING BUFFER * PROC RUN.C(FCB1,FCB2,ID,PRAM); * STRING ID; * INTEGER ARRAY PRAM; * COMMENT PRAM IS A 5 WORD ARRAY USED TO PASS USER DATA BETWEEN * THE FATHER AND SON PROCESSES; * RECORD FCB1,FCB2; * BEGIN A EQU 0 B EQU 1 .FCB1 DEF FCB1. .FCB2 DEF FCB2. FCB1P BSS 1 LOCAL POINTER SET UP TO POINT TO FCB1 .CHLK DEF C.HLK .PRAM BSS 1 .CPAS DEF C.PAS D5 DEC 5 D14 DEC 14 D25 DEC 25 D111 DEC 111 .SKED DEC 23 SCRFG BSS 1 THE SCRATCH FILE FLAG RUN.C BSS 1 * MOVE FCB1 TO FCB1. FOR 25 WORDS; LDB RUN.C W JSB INDC. GET THE FROM ADDRESS AND CLEAR OFF INDIRECTS STB FCB1P SAVE FOR LATER USE LDA B ADA =D2 LDB .FCB1 GET THE TO ADDRESS AND CLEAR OFF INDIRECTS JMP *+2 LDB B,I RBL,CLE,SLB,ERB JMP *-2 JSB .MVW MOVE IT DEF D25 NOP * MOVE FCB2 TO FCB2. FOR 25 WORDS; ISZ RUN.C LDB RUN.C JSB INDC. LDA B ADA =D2 LDB .FCB2 JMP *+2 LDB B,I RBL,CLE,SLB,ERB JMP *-2 JSB .MVW MOVE IT DEF D25 NOP * IF FCB1 = SYSSRATCH THEN LDB FCB1P ADB =D7 LDA B,I STA SCRFG SAVE IT FOR LATER USE SZA JMP CLOSE * UNLINK(FCB1); LDA .CHLK NEXT LDB A,I SZA,RSS JMP CLOSE CPB FCB1P JMP FOUND LDA B JMP NEXT GO AROUND AGAIN FOUND LDB B,I STB A,I * CLOSE ALL_LINKED_FCB'S; CLOSE LDA C.HLK SZA,RSS JMP SKED STA CLOSF JSB CLO.C CLOSF BSS 1 JMP EXIT JMP CLOSE * MOVE_THE_USERS_PARAMETERS_DOWN; SKED ISZ RUN.C LDB RUN.C JSB INDC. STB ID ISZ RUN.C LDB RUN.C JSB INDC. STB .PRAM LDA B LDB .CPAS JMP *+2 LDB B,I RBL,CLE,SLB,ERB JMP *-2 JSB .MVW DEF D5 NOP * SCHEDULE(ID,PRAMLIST); JSB EXEC DEF *+9+1 DEF .SKED ID BSS 1 DEF C.PAS DEF C.PAS+1 DEF C.PAS+2 DEF C.PAS+3 DEF C.PAS+4 DEF C.TRN DEF D111 * IF ERROR THEN GO ERROR EXIT; * PICKUP THE RETURN PARAMETERS AND STORE THEM INTO PRAM; LDA B LDB .PRAM JSB .MVW DEF D5 NOP * IF FCB1 = SYSSCRATCH THEN LDA SCRFG SZA JMP EXIT * LINK_IT_BACK_IN; LDA FCB1P STA C.HLK CLA STA FCB1P,I EXIT ISZ RUN.C JMP RUN.s( C,I END :  92060-18064 1726 S C0122 COMPILER LIBRARY END             H0101 ASMB,R,L,C HED COMPILER LIBRARY END ROUTINE IFZ NAM END.C,7 92060-18064 770515 REV. 1726 $CLIB XIF IFN NAM END.C,7 92060-18064 770515 REVM.1726 $CLIB XIF * * * Z GETS YOU AN RTE-II/RTE-III VERSION * N GETS YOU AN RTE-M VERSION * * *************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * * REPRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * *************************************************************** * * * * SOURCE PART NUMBER : 92060-18064 * * * END ROUTINE * * THIS ROUTINE WILL SEARCH THE LINKED LIST OF FCB'S AND CLOSE ALL * FILES. IT WILL PASS A FIVE WORD LIST OF ERRORS BACK TO THE CALLING * PROGRAM AND TERMINATE EXECUTION. * * * * * * * CALLING SEQUENCE: * * JSB END.C * DEF COMLST * ERROR RETURN * NOTE: THIS ROUTINE RETURNS TO THE SCHEDULING PRGRAM ON SUCCESSFUL * COMPLETION. * * ON RETURN A < 0 INDICATES ERROR * * * * ENTRY POINT: * ENT END.C * * EXTERNALS: * UNL IFN LST EXT LIMEM RETURN MEMORY UNL XIF LST EXT EXEC SYSTEM EXEC EXT PRTN PARAMETER RETURNER EXT CLO.C CLOSE ROUTINE EXT C.HLK HEAD OF FCB LIST * * * * * DETERMINE TYPE OF OPERATION * * THE FCB CONTAINS THE OPERATION TYPE AS FOLLOWS: * * TYPE = 0 IS READ SOURCE FILE(OR LU) * = 1 IS WRITE BINARY FILE(OR LU) * = 2 IS WRITE SCRATCH FILE * = 3 IS WRITE LIST FILE(OR LU) * * * A EQU 0 B EQU 1 * END.C NOP LDA C.HLK GET ADDRESS OF END1 STA FCB OF FCB SZA,RSS END? JMP EXIT YES! JSB CLO.C CLOSs  E FCB FCB NOP JMP ERROR ERROR! LDA FCB,I GET NEXT FCB ADDRESS JMP END1 AND CLOSE IT * ERROR ISZ END.C STEP TO RETURN UNL IFN LST JSB LIMEM RETURN MEMORY DEF *+2 DEF M1 UNL XIF LST JMP END.C,I ERROR RETURN * EXIT LDA END.C,I GET THE DEF TO THE PRAMS STA PADD AND PUT IN THE PRAM CALL JSB PRTN RETURN DEF *+2 PARAMETER STRING PADD DEF END.C,I JSB EXEC TERMINATE DEF *+2 DEF .6 * .6 DEC 6 UNL IFN LST M1 DEC -1 UNL XIF LST END n"   92060-18065 1805 S C0122 &PRM.C COMPILER LIBRARY GET PRAM             H0101 ASMB,L NAM PRM.C,7 92060-18065 771021 REV. 1805 1805 * PROCEDURE PRM.C(PARAMETER#); * VALUE PARAMETER#; INTEGER PARAMETER#; * BEGIN * GLOBAL STRING INSTRING; * GLOBAL INTEGER ARRAY PASSED; * GLOBAL BOOLEAN SONFLAG; * GLOBAL INTEGER LENGTH; * INTEGER I, * POINTER; * INTEGER ARRAY NAMBUFFER[0:9]; * IF SONFLAG AND PRAMETER# < 6 THEN * BEGIN * A := PASSED[PARAMETER#]; * B := 0; * END * ELSE * BEGIN * POINTER := 1; * FOR I := -1 TO PARAMETER# DO * NAMR(NAMBUFFER,INSTRING,LENGTH,POINTER); * END; * END OF PRM.C; SKP * PROCEDURE PRM.C(PARAMETER#); * VALUE PARAMETER#; INTEGER PARAMETER#; ENT PRM.C * GLOBAL STRING INSTRING; EXT C.TRN THE TURN ON STRING * GLOBAL INTEGER ARRAY PASSED; EXT C.PAS THE ARRAY OF PASSED PARAMETERS .CPAS DEF C.PAS+0 * GLOBAL BOOLEAN SONFLAG; EXT C.SON * GLOBAL INTEGER LENGTH; EXT C.LEN THE TURN ON STRING LENGTH * GLOBAL PROCEDURE NAMR(DEST,SOURCE,LENGTH,RUNNINGPOINTER)\ EXT NAMR THE NAMR PARSE ROUTINE A EQU 0 B EQU 1 * BEGIN * INTEGER I, I BSS 1 * POINTER; POINT BSS 1 * INTEGER ARRAY NAMBF[0:9] NAMBF BSS 10 PRAM# BSS 1 PRM.C BSS 1 LDA PRM.C,I LDA A,I GET THE PARAMETER# * IF SONFLAG AND PRAMETER# < 6 THEN STA PRAM# ADA =D-6 AND C.SON SSA,RSS JMP L1 * BEGIN * A := PASSED[PARAMETER#]; LDB .CPAS JMP *+2 LDB B,I RBL,CLE,SLB,ERB JMP *-2 ADB =D-1 ADB PRAM# LDA B,I * B := 0; CLB * END JMP EXIT * ELSE * BEGIN L1 EQU * * POINTER := 1; CLB,INB STB POINT * FOR I := -1 TO PARAMETER# DO LDA PRAM# CMA,INA ADA =D-2 STA I * NAMR(PARSEDBUFFER,INSTRING,LENGTH,POINTER); FLOOP JSB NAMR DEF *+4+1 .NAMB DEF NAMBF DEF C.TRN DEF C.LEN DEF POINT * END;    ISZ I JMP FLOOP LDA NAMBF LDB .NAMB CLE,ELB EXIT ISZ PRM.C JMP PRM.C,I END * END OF PRM.C; )   92060-18066 1726 S C0122 COMPILER LIBRARY GET MEMSG             H0101 #ASMB,L,C HED COMPILER LIBRARY - GET MAIN MEMORY * *************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * * REPRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * *************************************************************** * * * * * IFN NAM GMS.C,7 92060-18066 770523 REVM 1726 $CLIB EXT LIMEM XIF IFZ NAM GMS.C,7 92060-18066 770523 REV. 1726 $CLIB EXT COR.A,ID.AD EXT C.OLY ADDRESS OF LAST SEGMENT LOADED * XIF ENT GMS.C * * THIS COMPILER LIBRARY ROUTINE RETURNS THE FREE MEMORY BOUNDS FOR * THE CURRENT SEGMENT OF A SEGMENTED PROGRAM. * * CALLING SEQUENCE: JSB GMS.C * RETURNS: A = FWAM * B = LWAM * * GMS.C NOP ENTRY IFZ LDB C.OLY GET THE ADDRESS OF THE CURRENT OVERLAY JSB ID.AD TRANSLATE TO AN ID SEGMENT ADDRESS LDA B PUT IN A SZA,RSS IF NONE LDA XEQT USE THE MAIN JSB COR.A GET THE FWAM TO A LDB BKLWA B=LWAM JMP GMS.C,I EXIT * BKLWA EQU 1777B XEQT EQU 1717B XIF IFN JSB LIMEM GET BOUNDS FROM SUP DEF *+6 DEF ZERO DEF DUM DEF DUM DEF FWAM DEF NUMWD CCB COMPUTE LWAM ADB NUMWD FROM NUMBER ADB FWAM AND DIMIT LDA FWAM FWAM TO A JMP GMS.C,I RETURN * ZERO NOP DUM NOP FWAM NOP NUMWD NOP XIF A EQU 0 B EQU 1 END     92060-18067 1726 S C0122 COMPILER LIBRARY WRT AFT RD             H0101 :ASMB,L,C NAM WARC.,7 92060-18067 770523 REV. 1726 $CLIB * * NAME: WARC. * SOURCE: 92060-18067 * PGMR: EARL STUTES * *************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * * REPRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * *************************************************************** SPC 2 * THIS PROCEDURE PROVIDES THE SCRATCH FILE WRITE FUNCTION * FOR SOURCE THAT IS READ IN FROM A UNIT RECORD DEVICE AND * MUST BE SAVE ON DISC FOR A SECOND PASS * ENT WARC. EXT C.FLU THE LU OF INTEREST EXT C.SLU THE SECONDARY LU (DISC I HOPE) EXT C.FID FCB.ID THE FCB ID WORD EXT WRTC. THE DISC WRITE PROCEDURE * PROC WRITEAFTERREAD(LENGTH); * VALUE LENGTH; INTEGER LENGTH; * COMMENT LENGTH IS PASSED IN THE B REGISTER * BEGIN * INTEGER SAVELU; * IF FCB.UNITRECORD THEN * [ FCB.UNITRECORD := FALSE; * SAVELU := FCB.LU; * FCB.LU := FCB.SLU; * WRITEARECORD(LENGTH); * IF ERROR THEN GO ERROR EXIT; * FCB.SLU := FCB.LU; * FCB.LU := SAVELU; * FCB.UNITRECORD := TRUE;] * END OF WRITEAFTERREAD; SPC 2 * PROC WRITEAFTERREAD(LENGTH); * VALUE LENGTH; INTEGER LENGTH; * COMMENT LENGTH IS PASSED IN B * BEGIN * INTEGER SAVELU; SAVLU BSS 1 WARC. BSS 1 ENTRY POINT * IF FCB.UNITRECORD THEN LDA C.FID,I SSA,RSS JMP L1 * [ FCB.UNITRECORD := FALSE; RAL,CLE,ERA STA C.FID,I * SAVELU := FCB.LU; LDA C.FLU,I STA SAVLU * FCB.LU := FCB.SLU; LDA C.SLU,I STA C.FLU,I * WRITEARECORD(LENGTH); JSB WRTC. * IF ERROR THEN GO ERROR EXIT; JMP WARC.,I * FCB.SLU := FCB.LU; LDA C.FLU,I STA C.SLU,I * FCB.LU := SAVELU; LDA SAVLn  U STA C.FLU,I * UNITRECORD := TRUE;] LDA C.FID,I CCE RAL,ERA STA C.FID,I * END OF WRITEAFTERREAD; L1 ISZ WARC. JMP WARC.,I END *^5 h   92060-18068 1726 S C0122 COMPILER LIBRARY GET/PUT SEC             H0101 _ASMB,L,C NAM GES.C,7 92060-18068 770523 REV. 1726 $CLIB * * NAME: GES.C * SOURCE: 92060-18068 * PGMR: EARL STUTES * *************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * * REPRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * *************************************************************** SPC 2 * THIS PROCEDURE DOES ALL OF THE WORK NECESSARY TO MAKE THE NEXT * SECTOR AVAILABLE TO THE COMPILER LIBRARY FOR BOTH READ AND WRITE * OPERATIONS. SPC 4 * PROC READWRITE(R/WFLG); * VALUE R/WFLG; BOOLEAN R/WFLG; * R/WFLAG IS PASSED IN A * BEGIN * INTEGER TRACK, * .128 := 128, * SECTOR, * REQCODE; * REQCODE := (IF R/WFLAG THEN 1 ELSE 2); * TRACK := STARTRACK+(STARTSECTOR/2+OFFSETBLOCK)/BLOCKSPERTRACK; * SECTOR := ((STARTSECTOR/2 + OFFSETBLOCK) MOD BLOCKSPERTRACK)*2; * EXEC(REQCODE,FCB.LU,BUFFER,128,TRACK,SECTOR); * IF STATUS <> 0 THEN * BEGIN * A := -1; * ERROR RETURN & P+1 * END * ELSE * NORMAL RETURN & P+2 * END OF READWRITESECTOR; SKP ENT RW#EC EXT EXEC EXT C.STR EXTENT START TRACK EXT C.SSC EXTENT START SECTOR EXT C.BFF THE BUFFER POINTER EXT C.RSC CURRENT OFFSET BLOCK EXT C.S/T BLOCKS PER TRACK EXT C.FLU THE LU OF INTEREST * PROC READWRITE(R/WFLG); * VALUE R/WFLG; BOOLEAN R/WFLG; * BEGIN * INTEGER TRACK, TRACK BSS 1 * .128 := 128, .128 DEC 128 * SECTOR, SECTR BSS 1 * REQCODE, REQCD BSS 1 SPC 3 RW#EC BSS 1 ENTRY POINT * REQCODE := (IF R/WFLAG THEN 1 ELSE 2) CLB,INB SZA,RSS INB STB REQCD * TRACK := FCB.STARTTRACK+(STARTSECTOR/2 + OFFSETBLOCK) / BLOCKSPERTRACK; LDB C.SSC,I Y BRS ADB C.RSC,I ASR 16 DIV C.S/T,I ADA C.STR,I STA TRACK * SECTOR := ((STARTSECTOR/2+OFFSETBLOCK) MOD BLOCKSPERTRACK)*2; BLS STB SECTR LDA C.BFF INA STA .DBUF * EXEC(REQCODE,FCB.LU,BUFFER,128,TRACK,SECTOR); JSB EXEC DEF *+6+1 DEF REQCD DEF C.FLU,I .DBUF BSS 1 DEF .128 DEF TRACK DEF SECTR * IF STATUS <> 0 THEN SLA CCA,RSS ISZ RW#EC JMP RW#EC,I * BEGIN * A := -1; * ERROR RETURN & P+1 * END * ELSE * NORMAL RETURN & P+2 * END OF READWRITESECTOR; SKP *PROC GETNEXTSECTOR(R/WFLAG); *VALUE R/WFLAG; BOOLEAN R/WFLAG; * R/WFLAG IS PASSED IN THE A REGISTER; *BEGIN *INTEGER COUNT; *IF FCB.OFFSETBLOCK = FCB.NUMBEROFBLOCKS THEN *[ FCB.EXTENT := FCB.EXTENT + 1; * GETEXTENT(3,R/WFLAG); * FCB.STARTTRACK := RETURNP4; * FCB.STARTSECTOR ;= RETURNP5 AND @377; * FCB.OFFSETBLOCK ;= 0;]; *IF R/WFLAG THEN *[ READWRITE(R/WFLAG,BUFFER,COUNT); * IF ERROR THEN GO ERROR EXIT;] *ELSE * IF WRITEBUFFER THEN * [ READWRITE(R/WFLAG,BUFFER,COUNT); * IF ERROR THEN GO ERROR EXIT;]; *FCB.OFFSETBLOCK := FCB.OFFSETBLOCK + 1; *IF FCB.BP > 128 THEN * FCB.BP := FCB.BP - 128; *ELSE * FCB.BP := 1; *IF R/WFLAG THEN * BUFFERVALID := TRUE *ELSE * WRITEBUFFER := FALSE; *END OF GETNEXTSECTOR; SKP *PROC GETNEXTSECTOR(R/WFLAG); *VALUE R/WFLAG; BOOLEAN R/WFLAG; * R/WFLAG IS PASSED IN THE A REGISTER ENT GES.C ENT GE#SC EXT C.FAD FILE DIRECTORY WORD D EXT C.FLU FILE LU WORD EXT C.EXT FCB EXTENT # EXT GEX.C CALLD.RTR PROCEDURE EXT D.RP4 D.RTR RETURNP4 EXT D.RP5 D.RTR RETURNP5 A EQU 0 B EQU 1 RWFLG BSS 1 R/WFLAG VALUE HOLDER *BEGIN .1 DEC 1 SPC 2 GES.C BSS 1 ENTRY GE#SC EQU GES.C STA RWFLG SAVE THE PARAMETERS *IF FCB.OFFSETBLOCK = FCB.NUMBERH OFBLOCKS THEN EXT C.RSC OFFSETBLOCK WORD IN FCB EXT C.#SC NUMBEROFBLOCKS WORD IN FCB LDB C.RSC,I CPB C.#SC,I JMP *+2 JMP L1 *[ FCB.EXTENT := FCB.EXTENT + 1; ISZ C.EXT,I * CALLD.RTR(3,R/WFLAG); LDA =D3 JSB GEX.C DEF RWFLG * IF ERROR THEN GO ERROR EXIT; JMP GES.C,I * FCB.STARTTRACK := RETURNP4; LDA D.RP4 STA C.STR,I EXT C.SSC THE EXTENT START SECTOR * FCB.STARTSECTOR ;= RETURNP5 AND @377;]; LDA D.RP5 AND =B377 STA C.SSC,I * FCB.OFFSETBLOCK ;= 0;]; L4 CLA STA C.RSC,I *IF R/WFLAG THEN L1 LDA RWFLG SZA JMP L5 * IF WRITEBUFFER THEN LDB C.BFF,I SSB,RSS JMP L7 * [ READWRITE(R/WFLAG); L5 JSB RW#EC * IF ERROR THEN GO ERROR EXIT;]; JMP GES.C,I * FCB.OFFSETBLOCK := FCB.OFFSETBLOCK + 1; L7 ISZ C.RSC,I * EXIT: *IF FCB.BP > 128 THEN EXIT EQU * LDA BP,I ADA =D-129 SSA,INA * FCB.BP := FCB.BP - 128 *ELSE * FCB.BP := 1; CLA,INA STA BP,I EXT C.WRD THE BUFFER OFFSET POINTER BP EQU C.WRD *IF R/WFLAG THEN ISZ RWFLG CLA,RSS * BUFFERVALID := TRUE CLA,INA *ELSE * WRITEBUFFER := FALSE; STA C.BFF,I ISZ GES.C JMP GES.C,I END ]  92060-18069 1826 S C0122 D.RTR INTF COMPILER LIBRARY             H0101 0ASMB,L,C IFN NAM GEX.C,7 92060-18069 780323 REV. 1826 $CLIB XIF IFZ NAM GEX.C,7 92060-18069 780405 REVM 1826 $CLIB XIF SPC 3 * NAME: GEX.C * SOURCE: 92060-18069 * PGMR: EARL STUTES SPC 3 *************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * * REPRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * *************************************************************** SPC 2 * USE ASMB,Z FOR RTE M * USE ASMB,N FOR RTE II-III-IV SPC 3 * THIS PROCEDURE HANDLES SEVERAL OF THE DIFFERENCES BETWEEN RTE-II AND * RTE II-III AND RTE-M FOR THE COMPILER LIBRARY * PROC CALLD.RTR(FUNCTION,PRAM,CR); * VALUE FUNCTION,CR; INTEGER FUNCTION,CR; * POINTER PRAM; * FUNCTION IS PASSED IN THE A REGISTER * CR IS PASSED IN THE B REGISTER * PRAM IS A POINTER TO THE SET OF DATA NEEDED BY THE FUNCTION REQUESTED * * THE FUNCTION VALUES ARE: * 0 => CLOSE * 1 => CREATE * 2 => OPEN NEW FILE * 3 => OPEN EXTENT * 4 => OPEN SCRATCH FILE * 5 => CLOSE SCRATCH FILE * * THE PARAMETERS ARE DEFINED BY THE FUNCTION: * * 0 => PRAM = POINTER TO THE NUMBER OF SECTORS TO BE DELETED * 1 => PRAM = A POINTER TO THE SKELETON DIRECTORY ENTRY IN CORE * 2 => PRAM = POINTER TO THE NAME BUFFER * 3 => PRAM = POINTER TO THE READ/WRITE FLAG * * THE RETURNED PARAMETERS WILL BE RETRIEVED AND PLACED * VARIABLES VISIBLE TO THE CALLER * THE FIRST FIVE ARE THOSE COMING DIRECTLY FROM D.RTR * THE 6TH & 7TH ARE THOSE PARAMETERS NEEDED BY THE NEW OPEN FUNCTION ENT D.RP1 D.RTR RETURN PARAMETER #1 ENT D.RP2 D.RTR RETURN PARAMETER #2 ENT D.RP3 D.RTR RETURN PARAMETER #3 ENT D.RP4 D.RTR RETURN PARAMETER #4 ENT D.RP5 D.RTR RETURN PARAMETER #5 ENT D.RP6 D.RTR RETURN PARAMETER #6 SECURITY CODE ENT D.RP7 D.RTR RETURN PARAMETER #7 TYPE CODE * BEGIN * CASE FUNCTION OF * MAKECLOSECALL; * MAKECREATCALL; * MAKEOPENCALL; * MAKEOPENEXTCALL; * DOSCRATCHOPENTRICK; * DOSCRATCHCLOSETRICK; * ESAC; * FETCHRETURNPRAMETERS; * IF ERROR THEN * GO ERROR EXIT; * IF FUNCTION = NEWOPEN THEN * GETP6&P7; * END OF CALLD.RTR SKP ENT GEX.C EXT EXEC GUESS WHO EXT P.PAS PARAMETER PASSING EXT C.FAD FCB FILE DIRECTORY WORD EXT C.BFF FCB BUFFER POINTER EXT C.FID FCB ID WORD EXT C.EXT FCB EXTENT COUNTER EXT C.HLU FCB HEAD LU EXT C.S/T FCB SECTORS / TRACK EXT C.HTR FCB HEAD TRACK EXT C.STR FCB CURRENT START TRACK EXT C.FLU FCB LOGICAL UNIT EXT C.#SC FCB BLOCKS / EXTENT UNL IFZ LST EXT LIMEM RTE-M GET MEMORY LIMITS PROCEDURE EXT $LIBR TURN OFF MEMORY PROTECT EXT $LIBX TURN MEMORY PROTECT BACK ON XIF LST A EQU 0 B EQU 1 MYID EQU 1717B FUNCT BSS 1 THE PASSED IN FUNCTION PARAMETER CR BSS 1 THE PASSED IN CR PARAMETER D.RP6 BSS 1 FSCTR EQU D.RP6 SCTRS BSS 1 EITHER CURRENT SECTOR OR #OF SECTORS TRACK BSS 1 THE TRACK BEING WRITEN ON OR READ FROM D.RP7 BSS 1 DLU EQU D.RP7 THE DISC LU IN USE .M1 DEC -1 .0 DEC 0 .1 DEC 1 .2 DEC 2 .4 DEC 4 .5 DEC 5 .9 DEC 9 QSKED DEC 23 EXEC SCHEDULE REQUEST CODE .128 DEC 128 UNL IFN LST NEWOP EQU .2 NEW OPEN FUNCTION CODE D.RTR ASC 3,D.RTR LIMEM EQU 0 A FAKE FOR RTE II-III UNL XIF IFZ LST .NAME DBL NAME A NECESSARY BYTE POINTER NEWOP DEC 11 NEW OPEN FUNCTION CODE D.RFP ASC 3,D.RFP XIF LST SPC 2 GEX.C DEF LIMEiM THIS IS REALLY THE ENTRY POINT DST FUNCT SAVE PASSED PARAMETERS ADA JTAB FUNCTION CASE STATMENT JMP A,I SPC 2 JTAB DEF JTBL JTBL JMP CLOSE JMP CREAT JMP NOPEN JMP EOPEN JMP SOPEN JMP SCLOS SPC 3 UNL IFN LST CREAT JSB INDC. GET THE PARAMETER JSB GETRK GET A TRACK JSB EXEC WRITE OUT THE SKELETON TO DISC DEF *+6+1 DEF .2 DEF DLU DEF .PRAM,I DEF .9 DEF TRACK DEF .0 LDA TRACK PACK TRACK & LU ALF,ALF RAR,RAR IOR DLU STA TRLU JSB EXEC CALL D.RTR DEF *+7+1 DEF QSKED DEF D.RTR DEF MYID DEF TRLU DEF CR DEF .0 DEF FUNCT JSB GIVBK GIVE THE TRACK BACK TO THE SYSTEM JMP FETCH EXIT CASE XIF SPC 3 UNL IFZ LST CREAT JSB INDC. INB .PRAM IS STILL IN B STB D.RP2 INB STB D.RP3 ADB =D5 LDA MYID SET UP THE ID POINTER ADA =D26 STA IDPTR LDA B,I FETCH THE RECORD SIZE INB LDB B,I FETCH THE SECURITY CODE JSB STFID GO STUFF THE ID FOR D.RFP LDB .PRAM ADB =D3 LDA B,I GET THE TYPE CODE INTO A ADB =D3 LDB B,I GET THE FILE SIZE INTO B JSB EXEC CALL D.RFP DEF *+7+1 DEF QSKED DEF D.RFP DEF FUNCT DEF CR DEF .PRAM,I DEF D.RP2,I DEF D.RP3,I JMP FETCH EXIT CASE XIF SPC 3 UNL IFN LST NOPEN JSB INDC. GET THE PARAMETER POINTER LDA .PRAM,I GET THE PARAMETER IOR =B100000 SET THE EXCLUSIVE OPEN BIT IN THE NAME STA .PRAM,I LDA MYID IOR =B100000 SET THE NEW OPEN BIT IN THE ID STA IMYID INB .PRAM IS IN B ALSO STB D.RP2 INB STB D.RP3 JSB EXEC CALL D.RTR DEF *+7+1 DEF QSKED DEF D.RTR DEF IMYID DEF .PRAM,I DEF D.RP2,I DEF D.RP3,I DEF CR JMP FETCH EXIT CASE XIF UNL IFZ LST NOPEN JSB INDC. LDA .PRAM,I MAKEOPENCALL IOR =B100000 SET THE EXCLUSIVE OPEN BIT IN THE NAME STA .PRAM,I INB STB D.RP2 INB STB D.RP3 LDA NEWOP STA FUNCT FIX UP THE FUNCTION CALL FOR RTE-M JSB EXEC CALL D.RFP DEF *+7+1 DEF QSKED DEF D.RFP DEF FUNCT DEF CR DEF .PRAM,I DEF D.RP2,I DEF D.RP3,I JMP FETCH EXIT CASE XIF SPC 3 UNL IFN LST SPC 3 * THE FOLLOWING ALGORITHM IS THE EXTENT OPEN ALGORITM * THAT WILL HANDLE BOTH SYSTEM TRACKS AND FMGR EXTENTS * NOTE THAT SYSTEM TRACKS ARE REUSED WHEN POSSIBLE AND * IN FACT THE REWIND FUNCTION IS SIMPLY AN OPEN EXTENT 0 * OF AN ALREADY OPEN FILE * IF NOT FMGRFILE THEN * [ IF FCB.EXTENT = 0 THEN * [ NEWLU := FCB.HLU; * TRLU := FCB.HEADTRACK; ] * ELSE * [ READPRIVATEDIRECTORY; * IF NEWTRACK THEN * IF R/WFLAG THEN * [ A := -12 * GO ERROR EXIT;] * ELSE * [ INITIALIZEANEWTRACK; * WRITEPRIVATEDIRECTORY; ] * SETUPD.RTRETURN ] SPC 2 * IF NOT FMGRFILE THEN EOPEN JSB INDC. GET THE PARAMETER POINTER LDB C.FAD,I SZB JMP L2 * IF FCB.EXTENT = 0 THEN LDA C.EXT,I SZA JMP LX * [ NEWLU := FCB.HLU; * TRLU := FCB.HEADTRACK; DLD C.HTR,I JMP LA * ELSE * [ READPRIVATEDIRECTORY; LX EQU * LDA C.FLU,I STA DLU LDA C.STR,I STA TRACK LDA C.#SC,I ALS STA SCTRS JSB REDPD * IF NEWTRACK THEN DLD TRLU SSA,RSS h JMP LA * IF R/WFLAG THEN LDA .PRAM,I SSA,RSS JMP LB * [ A := -12 LDA =D-12 * GO ERROR EXIT;] JMP EXIT * ELSE * [ INITIALIZEANEWTRACK; LB EQU * JSB INNEW * WRITEPRIVATEDIRECTORY; ] LDA C.#SC,I ALS STA SCTRS JSB EXEC DEF *+6+1 DEF .2 DEF C.FLU,I DEF TRACK DEF .2 DEF C.STR,I DEF SCTRS DLD TRACK LA EQU * * SETUPD.RTRETURN ] STB C.FLU,I JSB SD.RN ISZ GEX.C JMP EXIT * ELSE L2 EQU * XIF UNL IFZ LST EOPEN EQU * JSB INDC. XIF LST LDA .PRAM,I MAKEOPENEXTCALL LDB =D6 SZA,RSS ADB =D2 STB FUNCT LDA C.EXT STA .PRAM JMP CEXEC SPC 2 UNL IFN LST CLOSE JSB INDC. MAKECLOSECALL CEXEC JSB EXEC DEF *+7+1 DEF QSKED DEF D.RTR DEF MYID DEF .PRAM,I DEF C.FAD,I DEF C.FAD+1,I DEF FUNCT JMP FETCH XIF UNL IFZ LST CLOSE JSB INDC. CEXEC JSB EXEC MAKECLOSECALL DEF *+6+1 DEF QSKED DEF D.RFP DEF FUNCT DEF C.FAD,I DEF C.FAD+1,I DEF .PRAM,I JMP FETCH XIF UNL IFN LST SPC 3 SOPEN JSB INNEW INITIALIZEANEWTRACK; * SET UP PRAMS FOR D.RTR LIKE RETURN LDA TRACK JSB SD.RN LDA DLU STA D.RP2 CLA STA C.FAD,I STA C.FAD+1,I STA D.RP6 LDA =D3 STA D.RP7 JMP EXIT XIF SPC 3 UNL IFZ LST * SCRATCH OPEN FOR THE RTE-M SYSTEM * 1. CREATE A NEW FILE WITH PROG NAME * 2. IF (RETURNP1 = -2) OR (RETURNP1 >= 0) THEN * OPEN THE FILE EXCLUSIVE * 3. IF ANY ERROR THEN TAKE ERROR EXIT * 4. FETCH THE RETURN PARAMET!ERS AND NORMAL EXIT * BUILD SCRATCH FILE NAME SOPEN LDA C.FID,I ALF,ALF RAL,RAL AND =B17 IOR =B60 LDB .NAME SBT LDA MYID ALS ADA =D24 MBT .5 * SET RECORD SIZE IN ID LDA MYID ADB =D26 STA IDPTR CLA * SET SECURITY CODE IN ID CLB JSB STFID * TYPE CODE IN A LDA =D3 * FILE SIZE IN B LDB =D24 * SCHEDULE D.RFP JSB EXEC DEF *+7+1 DEF QSKED DEF D.RFP DEF .1 DEF .0 DEF NAME DEF NAME+1 DEF NAME+2 * PICK UP THE RETURN PARAMETERS LDA B,I * IF NOT((RETURNP1 = -2) OR (RETURNP1 >= 0)) THEN SSA,RSS JMP OPNIT CPA =D-2 JMP OPNIT * GO ERROR EXIT JMP GEX.C,I * OPEN THE FILE EXCLUSIVE OPNIT LDA NAME IOR =B100000 STA NAME LDA =D11 STA FUNCT JSB EXEC DEF *+7+1 DEF QSKED DEF D.RFP DEF FUNCT DEF .0 DEF NAME DEF NAME+1 DEF NAME+2 * GO FINISH UP JUST LIKE A NEW OPEN JMP FETCJ XIF SPC 3 UNL IFN LST SCLOS LDA C.HTR,I STA TRACK STA TRLU * DLU := NLU := FCB.HLU; LDA C.HLU,I AND =B77 STA DLU STA NLU LDA C.#SC,I ALS STA SCTRS *DO [ READPRIVATEDIRECTORY; CLOOP JSB REDPD * GIVETRACKBACK; ] JSB GIVBK LDA NLU AND =B77 STA DLU LDA TRLU STA TRACK * UNTIL (TRLU < 0); SSA,RSS JMP CLOOP JMP GEX.C,I XIF UNL IFZ LST SCLOS JSB EXEC DEF *+6+1 DEF QSKED DEF D.RFP DEF .0 DEF C.FAD,I DEF C.FAD+1,I DEF .0 JMP GEX.C,I XIF LST * ESAC; SPC 3 UNL IFN LST FETCH LDA B PRAM ADDRESS TO A CLB,CCE ERB JSB P.PAS 'tFETCH THE RETURN PARAMETERS DEC -5 D.RP1 BSS 1 D.RP2 BSS 1 D.RP3 BSS 1 D.RP4 BSS 1 D.RP5 BSS 1 ISZ GEX.C XIF UNL IFZ LST FETCH ISZ GEX.C FETCJ JSB GETPR XIF LST LDA D.RP1 CHECK FOR ERRORS SSA * IF FUNCTION = NEWOPEN THEN LDA FUNCT CPA NEWOP JMP *+2 JMP NOTOP EN * GETP6&P7; LDA D.RP2 AND =B77 STA DLU LDA D.RP2 ALF,ALF RAL,RAL AND =B1777 STA TRACK LDA D.RP3 AND =B377 STA FSCTR JSB EXEC FETCH THE DIRECTORY ENTRY DEF *+6+1 DEF .1 DEF DLU DEF C.BFF,I DEF .128 DEF TRACK DEF FSCTR LDA D.RP3 FETCH THE TYPE CODE ALF,ALF AND =B377 ADA =B3 ADA C.BFF LDB A,I STB D.RP7 ADA =B5 FETCH THE SECURITY CODE LDB A,I STB D.RP6 JMP FILID NOTOP CPA .1 JMP *+2 JMP EXIT FILID DLD D.RP2 DST C.FAD,I EXIT ISZ GEX.C JMP GEX.C,I SPC 3 UNL IFN LST GETRK BSS 1 GET A SCRATCH TRACK FROM THE SYSTEM JSB EXEC DEF *+5+1 DEF .4 DEF .1 DEF TRACK DEF DLU DEF SCTRS JMP GETRK,I SPC 3 GIVBK BSS 1 GIVE A TRACK BACK TO THE SYSTEM JSB EXEC DEF *+4+1 DEF .5 DEF .1 DEF TRACK DEF DLU JMP GIVBK,I SPC 3 INNEW BSS 1 GET A NEW TRACK FROM THE SYSTEM JSB GETRK LDA SCTRS ADA =D-2 STA SCTRS JSB EXEC AND INITIALIZE THE LAST BLOCK TO DEF *+6+1 INDICATE THE END OF THE TRACK CHAIN DEF .2 DEF DLU DEF .M1 DEF .1 DEF TRACK DEF SCTRS JMP INNEW,I SPC 3 REDPD BSS 1 READ THE TRACK LINK DATA JSB EXEC DEF *+6+1 DEF .1 L0.*DEF DLU DEF TRLU DEF .2 DEF TRACK DEF SCTRS JMP REDPD,I SPC 3 SD.RN BSS 1 SETUPD.RTRETURN STA D.RP4 THE TRACK WORD LDA SCTRS STA D.RP1 NUMBER OF SECTORS IN THE FILE ADA =D2 ALF,ALF STA D.RP5 JMP SD.RN,I SPC 3 UNL XIF LST INDC. BSS 1 CLEAR INDIRECTS AND FETCH THE PARAMETER POINTER LDB GEX.C ILOOP LDB B,I RBL,CLE,SLB,ERB CLEAR THE I-BIT AND TEST JMP ILOOP STB .PRAM JMP INDC.,I UNL IFZ LST GETPR BSS 1 FETCH THE D.RFP RETURN PARAMETERS LDA B CLB,CCE ERB JSB P.PAS DEC -5 D.RP1 BSS 1 D.RP2 BSS 1 D.RP3 BSS 1 D.RP4 BSS 1 D.RP5 BSS 1 JMP GETPR,I SPC 3 STFID BSS 1 STUFF THE ID SEGMENT WORDS WITH THE RIGHT DATA JSB $LIBR NOP DST IDPTR,I JSB $LIBX DEF STFID UNL XIF LST .PRAM EQU D.RP1 NAME EQU D.RP2 TRLU EQU D.RP4 IDPTR BSS 1 IMYID EQU D.RP5 NLU EQU D.RP5 END BP0  92060-18070 1805 S C0122 &CRE.C COMPILER LIBRARY CREATE             H0101 _ASMB,R,L,C HED COMPILER LIBRARY CREATE ROUTINE NAM CRE.C,7 92060-18070 REV.1805 770803 $CLIB 1445 * * *************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * * REPRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * *************************************************************** * * * * SOURCE PART NUMBER : 92060-18070 * * * CREATE FILE SUBROUTINE * * THIS ROUTINE WILL CREATE A FILE AS REQUIRED BY THE OPEN ROUTINE. * CRE.C WILL TAKE THE 'NAMR' DATA AND PUT IT IN A BUFFER WHICH IS * A SKELETON FOR A DIRECTORY ENTRY AND WRITE OUT TO A DISC TRACK * THEN CALL D.RTR WHICH READS THE DISC TRACK AND CREATES A FILE * DIRECTORY. THE DISC TRACK IS THEN RETURNED. * * * * CALLING SEQUENCE: * * * A = CREATED FILE TYPE(4 FOR SOURCE, 5 FOR BINARY) * JSB CRE.C * ERROR RETURN * NO ERROR RETURN * * * A <= INDICATES ERROR NUMBER * * ENTRY POINT: * ENT CRE.C * * EXTERNALS: * EXT EXEC SYSTEM EXECUTIVE EXT GEX.C CREATE/OPEN ROUTINE EXT NAM.. CHECK NAME ROUTINE * EXT C.NAM DEFAULT FILE NAME EXT C.NA3 FILE NAME - LAST 2 CHARACTERS EXT C.SC DEFAULT FILE SECURITY CODE EXT C.CR DEFAULT FILE CARTRIDGE OR LU NUMBER EXT C.FTY DEFAULT FILE TYPE EXT C.FSZ DEFAULT FILE SIZE EXT C.TYP 'NAMR' TYPE * * * A EQU 0 B EQU 1 * CRE.C NOP LDB C.FTY,I HAS USER REQUESTED SZB,RSS A FILE TYPE? STA B YES, USE IT! STB BUF+3 NO, USE DEFAULT!! JSB NAM.. IS NAME DEF *+2 OK? DEF C.NAM,I SZA JMP ERROR NO! DLD C.NAM,I SET DST BUF UP Nju  AME LDA C.NA3,I IN BUFFER STA BUF+2 PRIOR TO WRITING OUT ON DISC TRACK LDB C.FSZ,I SZB,RSS IS SIZE ZERO? LDB .24 YES, USE DEFAULT OF 1 TRACK WORTH BLS DOUBLE TO SSB GET 64 CCB 64 WORD SECTORS, SET TO -1 IF ALL OF DISC STB BUF+6 LDA C.SC,I SET SECURITY CODE STA BUF+8 * CLA,INA LDB C.CR,I JSB GEX.C CREATE FILE DEF BUF ERROR JMP CRE.C,I ERROR RETURN ISZ CRE.C JMP CRE.C,I GOOD RETURN * * * CONSTANTS AND BUFFERS * .24 DEC 24 BUF NOP NAME NOP IS NOP HERE NOP PRGRAM TYPE NOP NOP NOP NOP NOP PRGRAM SECURITY CODE NOP END    92060-18071 1805 S C0122 &ADS.C COMPILER LIBRARY FCB PTRS             H0101 ASMB,R,L,C HED COMPILER LIBRARY UTILITY ROUTINE ADS.C NAM ADS.C,7 92060-18071 REV.1805 770809 1045 * * NAME: ADS.C * SOURCE: 92060-18071 * PGMR: G.A.A. - EARL STUTES * *************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * * REPRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * *************************************************************** SPC 2 EXT P.PAS ENT C.LNK ADDRESS OF FCB LINK WORD ENT C.FID ADDRESS OF FCB ID WORD ENT C.FLU ADDRESS OF FCB LU WORD ENT C.STR ADDRESS OF BASE TRACK WORD ENT C.SSC ADDRESS OF BASE SECTOR WORD ENT C.RSC ADDRESS OF CURRENT RELATIVE SECTOR ENT C.EXT ADDRESS OF CURRENT EXTENT ENT C.S/T ADDRESS OF NUMBER OF SECTORS/TRACK WORD ENT C.#SC ADDRESS OF FILE SIZE WORD ENT C.WRD ADDRESS OF WORD POSITION WORD ENT C.BFF ADDRESS OF DATA BUFFER ENT C.FAD ADDRESS OF DIRECTORY ADDRESS WORDS ENT C.HTR ADDRESS OF HEAD TRACK OF FILE ENT C.HLU ADDRESS OF HEAD LU OF FILE ENT C.SLU ADDRESS OF SECONDARY LOGICAL UNIT ENT C.RC# ADDRESS OF CURRENT RECORD # ENT C.?? ADDRESS OF PROMPT CHARACTERS ENT C.GRW ADDRESS OF REWIND GUARANTEE ROUTINE ENT C.INS ADDRESS OF INCLUDE ROUTINE ENT C.PR1 DEFS TO PARAMETERS INDIRECTS REMOVED ENT C.PR2 ENT C.PR3 ENT C.PR4 ENT C.PR5 ENT C.PR6 ENT C.PR7 ENT C.FCB FCB ADDRESS ENT C.NAM THE NAMR BUFFER POINTER ENT C.TYP TYPE AS PER "NAMR",=0 NULL,=1 LU,=3 FILE ENT C.SC SECURITY CODE ENT C.CR CARTRIDGE REFERENCE NUMBER ENT C.FTY FILE TYPE ENT C.FSZ 3 FILE SIZE ENT C.NA2,C.NA3,C.NA9,C.NA0 * ABOVE ARE THE REST OF THE NAMR POINTERS ENT C.CNT * ENT ADS.C THIS ROUTINE ENTRY POINT ENT LINC. ENTRY POINT FOR LINK SETUP ONLY ENT INDC. INDIRECT CLEANER * * THIS ROUTINE SET UP THE ABOVE VALUES FOR USE BY * OTHER ROUTINES IN THE COMPILER LIBRARY * * CALLING SEQUENCE * * ENT NOP ENTRY POINT OF SUBROUTINE * JSB ADS.C * DEC -N -# OF PRAMS (0-7) * - RETURN - REGS AS AT CALL * * WHERE ENT WAS CALLED BY * * JSB ENT * DEF FCB * DEF P1 * . * . * . * DEF PN (MAX OF 7 MIN OF ZERO) * * ON RETURN ENT WILL POINT TO THE ADDRESS FOLLOWING THE * DEF PN SKP ADS.C NOP LETS GET TO IT STA ASAVE SAVE REGS STB BSAVE LDB ADS.C GET THE ADDRESS ADB N2 OF THE ENT STB AD JSB IND GET THE FIRST DEF * CPB C.LNK IF ALREADY SET UP JMP EXIT1 JUST EXIT * LDA B JSB LINKS SET UP THE LINKS * CLB,CCE SET TO GET REST BY VALUE ERB CLEAR E SET SIGN ON B JSB P.PAS GET THE REST DEC -2 C.GRW NOP INSURE REWINDABILITY ADDRESS C.INS NOP INCLUDE ROUTINE ADDRESS * EXIT1 LDA PAD SET THE ADDRESS OF THE PRAMS STA PA FOR LOOP LDA ADS.C,I GET THE PRAMETER COUNT ISZ ADS.C STEP TO THE RETURN ADDRESS SZA,RSS IF NO PRAMS JMP EXIT GO EXIT * IOR N8 LIMIT IS 7 MV JSB IND GET THE NEXT DEF STB PA,I SET IT IN THE LIST ISZ PA STEP THE PADRESS INA,SZA DONE? JMP MV NO * EXIT LDA ASAVE RESTORE LDB BSAVE THE REGISTERS JMP ADS.C,I AND RETURN * IND NOP INDIRECT ROUTINE LDB AD,I GET THE DEF ISZ AD,I STEP THE USER RETURN ADDRESS q JSB INDC. GET THE POINTED TO DEF * JMP IND,I AND RETURN * INDC. BSS 1 CLEAR OFF THE INDIRECTS INDLP LDB B,I RBL,CLE,SLB,ERB JMP INDLP JMP INDC.,I * THIS PROCEDURE SETS UP THE POINTERS TO AN FCB * GIVEN THE ADDRESS OF THE FCB IN THE A REGISTER * * CALLING SEQUENCE * LDA .FCB LOAD THE FCB POINTER IN A * JSB LINKS * * ON RETURN A IS SET TO THE ADDRESS OF THE LAST * POINTER STORED + 1 * LINKS BSS 1 LINC. EQU LINKS CLB,CLE JSB P.PAS GET THE FIRST 18 WORDS DEC -28 C.LNK NOP C.FCB EQU C.LNK C.FID NOP C.FLU NOP C.STR NOP C.SSC NOP C.S/T NOP C.#SC NOP C.FAD NOP C.FA2 NOP C.HTR NOP C.HLU NOP C.?? NOP C.SLU NOP C.RC# NOP C.WRD NOP C.RSC NOP C.EXT NOP C.NAM NOP C.NA2 NOP C.NA3 NOP C.TYP NOP C.SC NOP C.CR NOP C.FTY NOP C.FSZ NOP C.NA9 NOP C.NA0 NOP C.BFF NOP LDB C.BFF JSB INDC. STB C.BFF JMP LINKS,I * ASAVE BSS 1 BSAVE NOP N2 DEC -2 N8 DEC -8 MASK PAD DEF *+1 C.PR1 NOP C.PR2 NOP C.PR3 NOP C.PR4 NOP C.PR5 NOP C.PR6 NOP C.PR7 NOP PA NOP AD EQU C.PR7 A EQU 0 B EQU 1 SPC 3 * FOLLOWING ARE THE ENTRY POINTS FOR THOSE ROUTINES THAT ARE * NOT IMPLEMENTED OR NOT USED BY A PARTICULAR FCB ENT C.DUM ENT INSC. ENT CNTC. C.DUM BSS 1 INSC. EQU C.DUM CNTC. EQU C.DUM ISZ C.DUM JMP C.DUM,I C.CNT DEF C.DUM END   92060-18072 1805 S C0122 &C.BS2 COMPILER LIBRARY SRATCH BF2             H0101 `WASMB,R,L,C NAM C.BS2,7 92060-18072 771214 REV. 1805 $CLIB 1520 HED SOURCE INPUT/OUTPUT BUFFER * * SOURCE I/O BUFFER * ENT C.BS2 BUFFER ENTRY POINT * * * C.BS2 BSS 129 * * END   92060-18073 1726 S C0122 COMPILER LIBRARY SG NM ADD             H0101 ASMB,L HED COMPILER LIBRARY - GET SEGMENT ADDRESS * *************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * * REPRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * *************************************************************** * * * * * NAM ID.AD,7 92060-18073 770523 REV. 1726 $CLIB ENT ID.AD * * THIS COMPILER LIBRARY ROUTINE SEARCHES THE LIST OF ID SEGMENTS * TO FIND THE ADDRESS OF THE SEGMENT WHOSE NAME IS GIVEN IN THE * ADDRESS SAVED IN THE B-REGISTER. * * CALLING SEQUENCE: B = ADDRESS OF SEGMENT NAME * JSB ID.AD * * RETURNS: B = 0 IF NOT FOUND * B = ADDRESS IF FOUND * * ID.AD NOP ENTRY STB NADD1 SAVE ADDRESSES INB OF EACH WORD STB NADD2 IN NAME INB STB NADD3 LDB KEYWD GET HEAD OF KEYWORDS STB CID AND SET FOR LOOP NEXT LDB CID,I BEGIN SEARCHETURN SZB,RSS TEST FOR END OF LIST JMP ID.AD,I YES, NOT FOUND - EXIT * ADB D12 NO, INDEX TO NAME LDA NADD1,I CHECK FIRST WORD CPA B,I MATCH? INB,RSS YES, SKIP TO NEXT WORD JMP NOYET NO * LDA NADD2,I CHECK SECOND WORD CPA B,I MATCH? INB,RSS YES, SKIP TO NEXT WORD JMP NOYET NO * LDA NADD3,I CHECK THIRD WORD XOR B,I UPPER CHARACTER ONLY AND C377 LDB CID,I LOAD B, IN CASE OF MATCH SZA,RSS MATCH? JMP ID.AD,I YES - FOUND * NOYET ISZ CID NO, TRY NEXT ONE JMP NEXT * D12 DEC 12 C377 OCT 177400 KEYWD EQU 1657B A EQU 0 B EQU 1 CID NOP NADD1 NOP NADD2 NOP NADD3 NOP END .    92060-18074 1805 S C0122 &C.TRN COMPILER LIBRARY TURN ON STR             H0101 ASMB,L NAM C.TRN,7 92060-18074 770824 REV. 1805 $CLIB 0920 * THIS IS A DATA STRUCTURE USED BY * SEVERAL OF THE COMPILER LIBRARY ROUTINES ENT C.TRN THE TURN ON STRING ENT C.LEN THE TURN ON STRING LENGTH ENT C.TIM THE LIBRARY TIME STRING ENT C.SON THE SON FLAG ENT FCB1. FCB1 BUFFER ENT FCB2. FCB2 BUFFER ENT C.PAS ENT C.HLK OPEN FCB LIST HEAD POINTER ENT C.TTY TERMINAL LU FCB ENT C.INP POINTER TO THE INPUT NAMR EXT C.DUM A DUMMY U DUMMY C.HLK BSS 1 C.INP BSS 1 INITIALIZED BY OPN.C SPC 3 * THIS IS THE FCB FOR THE TTY * C.TTY NOP LINK OCT 100003 TERMINAL DEVICE FCB OCT 401 LOGICAL UNIT OCT 0,0,0,0,0,0,0,0 DUMMY FILLERS ASC 1,]_ A HARD CODED PROMPT CHARACTER OCT 0,0,0,0,0,0,0,0 OCT 0,0,0,0,0,0,0,0 DEF C.DUM REWIND NOT SUPPORTED DEF C.DUM SPC 3 C.SON BSS 1 C.TRN BSS 40 C.LEN BSS 1 C.TIM ASC 15,12:01 PM MON., 29 DEC., 1977 FCB1. BSS 25 FCB2. BSS 25 C.PAS BSS 5 END   92060-18075 1805 S C0122 &C.SAU COMPILER LIBRARY SRC FCB             H0101 ϡASMB,R,L,C HED COMPILER LIBRARY FILE CONTROL BLOCK NAM C.SAU,7 92060-18075 770721 REV. 1805 $CLIB 1505 * *************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * * REPRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * *************************************************************** SPC 2 * SOURCE PART NUMBER: 92060-18075 * * READ SOURCE - NO REWIND - FILE CONTROL BLOCK * * * * GENERAL FILE CONTROL BLOCK FORMAT * * 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 0 * +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+ * C.LNK ! LINK TO NEXT FCB ! WORD 0 * +--+-----------+--------------+--------+--------+ * C.FID !DD!DFLT PRM# ! FCB # !XXXXXXXX!FCB TYPE! WORD 1 * +--+-----------+--------------+--------+--------+ * C.FLU ! !FUNCT CODE ! LOGICAL UNIT # ! WORD 2 * +--------------+--------------+-----------------+ * C.STR ! CURRENT EXTENT START TRACK NUMBER ! WORD 3 * +-----------------------------------------------+ * C.SSC ! CURRENT EXTENT START BLOCK NUMBER ! WORD 4 * +-----------------------------------------------+ * C.S/T ! NUMBER OF BLOCKS IN TRACK ! WORD 5 * +-----------------------------------------------+ * C.#SC ! NUMBER OF BLOCKS PER EXTENT ! WORD 6 * +-----------------------------------------------+ * C.FA1 ! DIRECTORY ADDRESS ! WORD 7 * +------------- ---------------+ * C.FA2 ! FROM D.RTR ! WORD 8 * +-----------------------------------------------+ * C.HTR ! HEAD TRACK NUMBER ! WORD 9 * +-I----------------------------------------------+ * C.HLU ! HEAD LOGICAL UNIT NUMBER ! WORD 10 * +-----------------------------------------------+ * C.?? ! PROMPT CHARACTERS ! WORD 11 * +-----------------------------------------------+ * C.SLU ! SECONDARY LOGICAL UNIT NUMBER ! WORD 12 * +-----------------------------------------------+ * C.RC# ! RECORD NUMBER ! WORD 13 * +-----------------------------------------------+ * C.WRD ! CURRENT WORD POINTER ! WORD 14 * +-----------------------------------------------+ * C.RSC + CURRENT EXTENT OFFSET BLOCK ! WORD 15 * +-----------------------------------------------+ * C.EXT ! EXTENT NUMBER ! WORD 16 * +-----------------------------------------------+ * C.NAM ! PARSED NAMR WORD 1 ! WORD 17 * +-----------------------------------------------+ * C.NA2 ! WORD 2 ! WORD 18 * +-----------------------------------------------+ * C.NA3 ! WORD 3 ! WORD 19 * +-----------------------------------------------+ * C.TYP ! WORD 4 ! WORD 20 * +-----------------------------------------------+ * C.SC ! WORD 5 ! WORD 21 * +-----------------------------------------------+ * C.CR ! WORD 6 ! WORD 22 * +-----------------------------------------------+ * C.FTY ! WORD 7 ! WORD 23 * +-----------------------------------------------+ * C.FSZ ! WORD 8 ! WORD 24 * +-----------------------------------------------+ * C.NA9 ! WORD 9 ! WORD 25 *  +-----------------------------------------------+ * C.NA0 ! WORD 10 ! WORD 26 * +-----------------------------------------------+ * C.BSO ! BUFFER ADDRESS ! WORD 27 * +-----------------------------------------------+ * C.GRW ! REWIND CHECK GUARANTEE ADDRESS ! WORD 28 * +-----------------------------------------------+ * C.INS ! $INCLUDE ROUTINE ADDRESS ! WORD 29 * +-----------------------------------------------+ SKP ENT C.SAU * EXT C.BSA SOURCE BUFFER ADDRESS EXT INSC. $INCLUDE ROUTINE EXT C.DUM THE DUMMY, DUMMY * * * WHERE: FCB TYPE = 0 FOR READ SOURCE * = 1 FOR WRITE BINARY * = 2 FOR READ-WRITE SCRATCH * = 3 FOR WRITE SOURCE * FCB # = THE NUMBER ASSIGNED TO THIS FCB * DFLT PR # = THE DEFAULT PARAMETER NUMBER * DD = 0 FOR DISC DEVICE * 1 FOR UNIT RECORD DEVICE * * * * * * C.SAU NOP LINK OCT 4000 DEFAULT PARAMETER #1, READ SOURCE NOP LOGICAL UNIT NOP START TRACK NUMBER NOP START SECTOR NUMBER NOP NUMBER OF BLOCKS PER TRACK NOP NUMBER OF BLOCKS IN EXTENT NOP DIRECTORY ADDRESS NOP FROM D.RTR NOP HEAD TRACK NUMBER NOP HEAD LOGICAL UNIT NUMBER NOP SECONDARY LOGICAL UNIT NOP PROMPT CHARACTERS NOP CURRENT RECORD NUMBER NOP CURRENT WORD POINTER NOP CURRENT EXTENT OFFSET BLOCK NOP EXTENT NUMBER NOP PARSED NAMR WORD 1 NOP PARSED NAMR WORD 2 NOP PARSED NAMR WORD 3 NOP d PARSED NAMR WORD 4 NOP PARSED NAMR WORD 5 NOP PARSED NAMR WORD 6 NOP PARSED NAMR WORD 7 NOP PARSED NAMR WORD 8 NOP PARSED NAMR WORD 9 NOP PARSED NAMR WORD 10 DEF C.BSA BUFFER ADDRESS DEF C.DUM REWIND GUARANTEE ROUTINE DEF INSC. $INCLUDE ROUTINE ADDRESS END   92060-18076 1805 S C0122 &C.SOR COMPILER LIBRARY SRC FCB             H0101 ޞASMB,R,L,C HED COMPILER LIBRARY FILE CONTROL BLOCK NAM C.SOR,7 92060-18076 770815 REV. 1805 $CLIB 1210 * * * READ/REWIND FILE CONTROL BLOCK * SCRATCH FILE CREATED IF NECESSARY TO SUPPORT RE-READ * * * GENERAL FILE CONTROL BLOCK FORMAT * * 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 0 * +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+ * C.LNK ! LINK TO NEXT FCB ! WORD 0 * +--+-----------+--------------+--------+--------+ * C.FID !DD!DFLT PRM# ! FCB # !XXXXXXXX!FCB TYPE! WORD 1 * +--+-----------+--------------+--------+--------+ * C.FLU ! !FUNCT CODE ! LOGICAL UNIT # ! WORD 2 * +--------------+--------------+-----------------+ * C.STR ! CURRENT EXTENT START TRACK NUMBER ! WORD 3 * +-----------------------------------------------+ * C.SSC ! CURRENT EXTENT START BLOCK NUMBER ! WORD 4 * +-----------------------------------------------+ * C.S/T ! NUMBER OF BLOCKS IN TRACK ! WORD 5 * +-----------------------------------------------+ * C.#SC ! NUMBER OF BLOCKS PER EXTENT ! WORD 6 * +-----------------------------------------------+ * C.FA1 ! DIRECTORY ADDRESS ! WORD 7 * +------------- ---------------+ * C.FA2 ! FROM D.RTR ! WORD 8 * +-----------------------------------------------+ * C.HTR ! HEAD TRACK NUMBER ! WORD 9 * +-----------------------------------------------+ * C.HLU ! HEAD LOGICAL UNIT NUMBER ! WORD 10 * +-----------------------------------------------+ * C.?? ! PROMPT CHARACTERS ! WORD 11 * +-----------------------------------------------+ * C.SLU ! SECONDARY LOGICAL UNIT NUMBER ! WORD 12 * +---------------------------u--------------------+ * C.RC# ! RECORD NUMBER ! WORD 13 * +-----------------------------------------------+ * C.WRD ! CURRENT WORD POINTER ! WORD 14 * +-----------------------------------------------+ * C.RSC + CURRENT EXTENT OFFSET BLOCK ! WORD 15 * +-----------------------------------------------+ * C.EXT ! EXTENT NUMBER ! WORD 16 * +-----------------------------------------------+ * C.NAM ! PARSED NAMR WORD 1 ! WORD 17 * +-----------------------------------------------+ * C.NA2 ! WORD 2 ! WORD 18 * +-----------------------------------------------+ * C.NA3 ! WORD 3 ! WORD 19 * +-----------------------------------------------+ * C.TYP ! WORD 4 ! WORD 20 * +-----------------------------------------------+ * C.SC ! WORD 5 ! WORD 21 * +-----------------------------------------------+ * C.CR ! WORD 6 ! WORD 22 * +-----------------------------------------------+ * C.FTY ! WORD 7 ! WORD 23 * +-----------------------------------------------+ * C.FSZ ! WORD 8 ! WORD 24 * +-----------------------------------------------+ * C.NA9 ! WORD 9 ! WORD 25 * +-----------------------------------------------+ * C.NA0 ! WORD 10 ! WORD 26 * +-----------------------------------------------+ * C.BSO ! BUFFER ADDRESS ! WORD 27 * +-----------------------------------------------+ * C.GRW ! REWIND CHECK GUARANTEE ADDRESS ! WORD 28 * +---------------------R--------------------------+ * C.INS ! $INCLUDE ROUTINE ADDRESS ! WORD 29 * +-----------------------------------------------+ SKP ENT C.SOR * EXT C.BSO SOURCE BUFFER ADDRESS EXT WARC. WRITE AFTER READ PROCEDURE EXT INSC. $INCLUDE ROUTINE * * * WHERE: FCB TYPE = 0 FOR READ SOURCE * = 1 FOR WRITE BINARY * = 2 FOR READ-WRITE SCRATCH * = 3 FOR WRITE SOURCE * = 4 FOR WRITE-READ SOURCE * = 5 FOR WRITE BINARY ABSOLUTE * FCB # = THE NUMBER ASSIGNED TO THIS FCB * DFLT PR # = THE DEFAULT PARAMETER NUMBER * DD = 0 FOR DISC DEVICE * 1 FOR UNIT RECORD DEVICE * * * * * * C.SOR NOP LINK OCT 4004 DEFAULT PARAMETER #1, READ SOURCE NOP LOGICAL UNIT NOP START TRACK NUMBER NOP START SECTOR NUMBER NOP NUMBER OF BLOCKS PER TRACK NOP NUMBER OF BLOCKS IN EXTENT NOP DIRECTORY ADDRESS NOP FROM D.RTR NOP HEAD TRACK NUMBER NOP HEAD LOGICAL UNIT NUMBER NOP SECONDARY LOGICAL UNIT NOP PROMPT CHARACTERS NOP CURRENT RECORD NUMBER NOP CURRENT WORD POINTER NOP CURRENT EXTENT OFFSET BLOCK NOP EXTENT NUMBER NOP PARSED NAMR WORD 1 NOP PARSED NAMR WORD 2 NOP PARSED NAMR WORD 3 NOP PARSED NAMR WORD 4 NOP PARSED NAMR WORD 5 NOP PARSED NAMR WORD 6 NOP PARSED NAMR WORD 7 NOP PARSED NAMR WORD 8 NOP PARSED NAMR WORD 9 NOP PARSED NAMR WORD 10 DEF C.BSO 4 BUFFER ADDRESS DEF WARC. REWIND GUARANTEE ROUTINE DEF INSC. $INCLUDE ROUTINE ADDRESS END   92060-18077 1805 S C0122 &C.BIN COMPILER LIBRARY BIN FCB             H0101 ЃASMB,R,L,C HED COMPILER LIBRARY FILE CONTROL BLOCK NAM C.BIN,7 92060-18077 770721 REV. 1805 $CLIB 1520 * *************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * * REPRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * *************************************************************** SPC 2 * SOURCE PART NUMBER: 92060-18077 * * WRITE BINARY - RELOCATABLE - RECORD ORIENTED * * * * GENERAL FILE CONTROL BLOCK FORMAT * * 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 0 * +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+ * C.LNK ! LINK TO NEXT FCB ! WORD 0 * +--+-----------+--------------+--------+--------+ * C.FID !DD!DFLT PRM# ! FCB # !XXXXXXXX!FCB TYPE! WORD 1 * +--+-----------+--------------+--------+--------+ * C.FLU ! !FUNCT CODE ! LOGICAL UNIT # ! WORD 2 * +--------------+--------------+-----------------+ * C.STR ! CURRENT EXTENT START TRACK NUMBER ! WORD 3 * +-----------------------------------------------+ * C.SSC ! CURRENT EXTENT START BLOCK NUMBER ! WORD 4 * +-----------------------------------------------+ * C.S/T ! NUMBER OF BLOCKS IN TRACK ! WORD 5 * +-----------------------------------------------+ * C.#SC ! NUMBER OF BLOCKS PER EXTENT ! WORD 6 * +-----------------------------------------------+ * C.FA1 ! DIRECTORY ADDRESS ! WORD 7 * +------------- ---------------+ * C.FA2 ! FROM D.RTR ! WORD 8 * +-----------------------------------------------+ * C.HTR ! HEAD TRACK NUMBER ! WORD 9 * +-R----------------------------------------------+ * C.HLU ! HEAD LOGICAL UNIT NUMBER ! WORD 10 * +-----------------------------------------------+ * C.?? ! PROMPT CHARACTERS ! WORD 11 * +-----------------------------------------------+ * C.SLU ! SECONDARY LOGICAL UNIT NUMBER ! WORD 12 * +-----------------------------------------------+ * C.RC# ! RECORD NUMBER ! WORD 13 * +-----------------------------------------------+ * C.WRD ! CURRENT WORD POINTER ! WORD 14 * +-----------------------------------------------+ * C.RSC + CURRENT EXTENT OFFSET BLOCK ! WORD 15 * +-----------------------------------------------+ * C.EXT ! EXTENT NUMBER ! WORD 16 * +-----------------------------------------------+ * C.NAM ! PARSED NAMR WORD 1 ! WORD 17 * +-----------------------------------------------+ * C.NA2 ! WORD 2 ! WORD 18 * +-----------------------------------------------+ * C.NA3 ! WORD 3 ! WORD 19 * +-----------------------------------------------+ * C.TYP ! WORD 4 ! WORD 20 * +-----------------------------------------------+ * C.SC ! WORD 5 ! WORD 21 * +-----------------------------------------------+ * C.CR ! WORD 6 ! WORD 22 * +-----------------------------------------------+ * C.FTY ! WORD 7 ! WORD 23 * +-----------------------------------------------+ * C.FSZ ! WORD 8 ! WORD 24 * +-----------------------------------------------+ * C.NA9 ! WORD 9 ! WORD 25 *  +-----------------------------------------------+ * C.NA0 ! WORD 10 ! WORD 26 * +-----------------------------------------------+ * C.BSO ! BUFFER ADDRESS ! WORD 27 * +-----------------------------------------------+ * C.GRW ! REWIND CHECK GUARANTEE ADDRESS ! WORD 28 * +-----------------------------------------------+ * C.INS ! $INCLUDE ROUTINE ADDRESS ! WORD 29 * +-----------------------------------------------+ SKP ENT C.BIN * EXT C.BBI BINARY BUFFER ADDRESS EXT C.DUM DUMMY LINK * * * WHERE: FCB TYPE = 0 FOR READ SOURCE * = 1 FOR WRITE BINARY * = 2 FOR READ-WRITE SCRATCH * = 3 FOR WRITE SOURCE * FCB # = THE NUMBER ASSIGNED TO THIS FCB * DFLT PR # = THE DEFAULT PARAMETER NUMBER * DD = 0 FOR DISC DEVICE * 1 FOR UNIT RECORD DEVICE * * * * * * C.BIN NOP LINK OCT 14001 DEFAULT PARAMETER #3, WRITE RELOC BINARY NOP LOGICAL UNIT NOP START TRACK NUMBER NOP START SECTOR NUMBER NOP NUMBER OF BLOCKS PER TRACK NOP NUMBER OF BLOCKS IN EXTENT NOP DIRECTORY ADDRESS NOP FROM D.RTR NOP HEAD TRACK NUMBER NOP HEAD LOGICAL UNIT NUMBER NOP SECONDARY LOGICAL UNIT NOP PROMPT CHARACTERS NOP CURRENT RECORD NUMBER NOP CURRENT WORD POINTER NOP CURRENT EXTENT OFFSET BLOCK NOP EXTENT NUMBER NOP PARSED NAMR WORD 1 NOP PARSED NAMR WORD 2 NOP PARSED NAMR WORD 3 NOP PARSED NAMR WORD 4 NOP  PARSED NAMR WORD 5 NOP PARSED NAMR WORD 6 NOP PARSED NAMR WORD 7 NOP PARSED NAMR WORD 8 NOP PARSED NAMR WORD 9 NOP PARSED NAMR WORD 10 DEF C.BBI BUFFER ADDRESS DEF C.DUM REWIND GUARANTEE ROUTINE DEF C.DUM $INCLUDE ROUTINE ADDRESS END   92060-18078 1805 S C0122 &C.LST COMPILER LIBRARY LIST FCB             H0101 4}ASMB,R,L,C HED COMPILER LIBRARY FILE CONTROL BLOCK NAM C.LST,7 92060-18078 770721 REV. 1805 $CLIB 1530 * *************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * * REPRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * *************************************************************** SPC 2 * SOURCE PART NUMBER: 92060-18078 * * WRITE LIST FILE - LINE SPACE AND EOF * * * * GENERAL FILE CONTROL BLOCK FORMAT * * 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 0 * +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+ * C.LNK ! LINK TO NEXT FCB ! WORD 0 * +--+-----------+--------------+--------+--------+ * C.FID !DD!DFLT PRM# ! FCB # !XXXXXXXX!FCB TYPE! WORD 1 * +--+-----------+--------------+--------+--------+ * C.FLU ! !FUNCT CODE ! LOGICAL UNIT # ! WORD 2 * +--------------+--------------+-----------------+ * C.STR ! CURRENT EXTENT START TRACK NUMBER ! WORD 3 * +-----------------------------------------------+ * C.SSC ! CURRENT EXTENT START BLOCK NUMBER ! WORD 4 * +-----------------------------------------------+ * C.S/T ! NUMBER OF BLOCKS IN TRACK ! WORD 5 * +-----------------------------------------------+ * C.#SC ! NUMBER OF BLOCKS PER EXTENT ! WORD 6 * +-----------------------------------------------+ * C.FA1 ! DIRECTORY ADDRESS ! WORD 7 * +------------- ---------------+ * C.FA2 ! FROM D.RTR ! WORD 8 * +-----------------------------------------------+ * C.HTR ! HEAD TRACK NUMBER ! WORD 9 * +---------c--------------------------------------+ * C.HLU ! HEAD LOGICAL UNIT NUMBER ! WORD 10 * +-----------------------------------------------+ * C.?? ! PROMPT CHARACTERS ! WORD 11 * +-----------------------------------------------+ * C.SLU ! SECONDARY LOGICAL UNIT NUMBER ! WORD 12 * +-----------------------------------------------+ * C.RC# ! RECORD NUMBER ! WORD 13 * +-----------------------------------------------+ * C.WRD ! CURRENT WORD POINTER ! WORD 14 * +-----------------------------------------------+ * C.RSC + CURRENT EXTENT OFFSET BLOCK ! WORD 15 * +-----------------------------------------------+ * C.EXT ! EXTENT NUMBER ! WORD 16 * +-----------------------------------------------+ * C.NAM ! PARSED NAMR WORD 1 ! WORD 17 * +-----------------------------------------------+ * C.NA2 ! WORD 2 ! WORD 18 * +-----------------------------------------------+ * C.NA3 ! WORD 3 ! WORD 19 * +-----------------------------------------------+ * C.TYP ! WORD 4 ! WORD 20 * +-----------------------------------------------+ * C.SC ! WORD 5 ! WORD 21 * +-----------------------------------------------+ * C.CR ! WORD 6 ! WORD 22 * +-----------------------------------------------+ * C.FTY ! WORD 7 ! WORD 23 * +-----------------------------------------------+ * C.FSZ ! WORD 8 ! WORD 24 * +-----------------------------------------------+ * C.NA9 ! WORD 9 ! WORD 25 * +-----------------------------------------------+ * C.NA0 ! WORD 10 ! WORD 26 * +-----------------------------------------------+ * C.BSO ! BUFFER ADDRESS ! WORD 27 * +-----------------------------------------------+ * C.GRW ! REWIND CHECK GUARANTEE ADDRESS ! WORD 28 * +-----------------------------------------------+ * C.INS ! $INCLUDE ROUTINE ADDRESS ! WORD 29 * +-----------------------------------------------+ SKP ENT C.LST * EXT C.BLI LIST BUFFER ADDRESS EXT C.DUM $INCLUDE ROUTINE * * * WHERE: FCB TYPE = 0 FOR READ SOURCE * = 1 FOR WRITE BINARY * = 2 FOR READ-WRITE SCRATCH * = 3 FOR WRITE SOURCE * FCB # = THE NUMBER ASSIGNED TO THIS FCB * DFLT PR # = THE DEFAULT PARAMETER NUMBER * DD = 0 FOR DISC DEVICE * 1 FOR UNIT RECORD DEVICE * * * * * * C.LST NOP LINK OCT 10003 DEFAULT PARAMETER #2, WRITE LIST FILE OCT 1 LOGICAL UNIT NOP START TRACK NUMBER NOP START SECTOR NUMBER NOP NUMBER OF BLOCKS PER TRACK NOP NUMBER OF BLOCKS IN EXTENT NOP DIRECTORY ADDRESS NOP FROM D.RTR NOP HEAD TRACK NUMBER NOP HEAD LOGICAL UNIT NUMBER NOP SECONDARY LOGICAL UNIT NOP PROMPT CHARACTERS NOP CURRENT RECORD NUMBER NOP CURRENT WORD POINTER NOP CURRENT EXTENT OFFSET BLOCK NOP EXTENT NUMBER NOP PARSED NAMR WORD 1 NOP PARSED NAMR WORD 2 NOP PARSED NAMR WORD 3 NOP PARSED NAMR WORD 4 NOP PAURSED NAMR WORD 5 NOP PARSED NAMR WORD 6 NOP PARSED NAMR WORD 7 NOP PARSED NAMR WORD 8 NOP PARSED NAMR WORD 9 NOP PARSED NAMR WORD 10 DEF C.BLI BUFFER ADDRESS DEF C.DUM REWIND GUARANTEE ROUTINE DEF C.DUM $INCLUDE ROUTINE ADDRESS END !P  92060-18079 1805 S C0122 &C.SC0 COMPILER LIBRARY SCRATCH FCB0             H0101 >ASMB,R,L,C HED COMPILER LIBRARY FILE CONTROL BLOCK NAM C.SC0,7 92060-18079 770802 REV. 1805 $CLIB 0915 * *************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * * REPRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * *************************************************************** SPC 2 * SOURCE PART NUMBER: 92060-18079 * * READ - WRITE SCRATCH FILE - REWIND IF NECESSARY * * * * GENERAL FILE CONTROL BLOCK FORMAT * * 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 0 * +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+ * C.LNK ! LINK TO NEXT FCB ! WORD 0 * +--+-----------+--------------+--------+--------+ * C.FID !DD!DFLT PRM# ! FCB # !XXXXXXXX!FCB TYPE! WORD 1 * +--+-----------+--------------+--------+--------+ * C.FLU ! !FUNCT CODE ! LOGICAL UNIT # ! WORD 2 * +--------------+--------------+-----------------+ * C.STR ! CURRENT EXTENT START TRACK NUMBER ! WORD 3 * +-----------------------------------------------+ * C.SSC ! CURRENT EXTENT START BLOCK NUMBER ! WORD 4 * +-----------------------------------------------+ * C.S/T ! NUMBER OF BLOCKS IN TRACK ! WORD 5 * +-----------------------------------------------+ * C.#SC ! NUMBER OF BLOCKS PER EXTENT ! WORD 6 * +-----------------------------------------------+ * C.FA1 ! DIRECTORY ADDRESS ! WORD 7 * +------------- ---------------+ * C.FA2 ! FROM D.RTR ! WORD 8 * +-----------------------------------------------+ * C.HTR ! HEAD TRACK NUMBER ! WORD 9 * H+-----------------------------------------------+ * C.HLU ! HEAD LOGICAL UNIT NUMBER ! WORD 10 * +-----------------------------------------------+ * C.?? ! PROMPT CHARACTERS ! WORD 11 * +-----------------------------------------------+ * C.SLU ! SECONDARY LOGICAL UNIT NUMBER ! WORD 12 * +-----------------------------------------------+ * C.RC# ! RECORD NUMBER ! WORD 13 * +-----------------------------------------------+ * C.WRD ! CURRENT WORD POINTER ! WORD 14 * +-----------------------------------------------+ * C.RSC + CURRENT EXTENT OFFSET BLOCK ! WORD 15 * +-----------------------------------------------+ * C.EXT ! EXTENT NUMBER ! WORD 16 * +-----------------------------------------------+ * C.NAM ! PARSED NAMR WORD 1 ! WORD 17 * +-----------------------------------------------+ * C.NA2 ! WORD 2 ! WORD 18 * +-----------------------------------------------+ * C.NA3 ! WORD 3 ! WORD 19 * +-----------------------------------------------+ * C.TYP ! WORD 4 ! WORD 20 * +-----------------------------------------------+ * C.SC ! WORD 5 ! WORD 21 * +-----------------------------------------------+ * C.CR ! WORD 6 ! WORD 22 * +-----------------------------------------------+ * C.FTY ! WORD 7 ! WORD 23 * +-----------------------------------------------+ * C.FSZ ! WORD 8 ! WORD 24 * +-----------------------------------------------+ * C.NA9 ! WORD 9 ! WORD 25 *  +-----------------------------------------------+ * C.NA0 ! WORD 10 ! WORD 26 * +-----------------------------------------------+ * C.BUF ! BUFFER ADDRESS ! WORD 27 * +-----------------------------------------------+ * C.GRW ! REWIND CHECK GUARANTEE ADDRESS ! WORD 28 * +-----------------------------------------------+ * C.INS ! $INCLUDE ROUTINE ADDRESS ! WORD 29 * +-----------------------------------------------+ SKP ENT C.SC0 * EXT C.BS0 SCRATCH BUFFER ADDRESS EXT C.DUM $INCLUDE ROUTINE * * * WHERE: FCB TYPE = 0 FOR READ SOURCE * = 1 FOR WRITE BINARY * = 2 FOR READ-WRITE SCRATCH * = 3 FOR WRITE SOURCE * FCB # = THE NUMBER ASSIGNED TO THIS FCB * DFLT PR # = THE DEFAULT PARAMETER NUMBER * DD = 0 FOR DISC DEVICE * 1 FOR UNIT RECORD DEVICE * * * * * * C.SC0 NOP LINK OCT 00002 READ OR WRITE SCRATCH OCT 0 LOGICAL UNIT NOP START TRACK NUMBER NOP START SECTOR NUMBER NOP NUMBER OF BLOCKS PER TRACK NOP NUMBER OF BLOCKS IN EXTENT NOP DIRECTORY ADDRESS NOP FROM D.RTR NOP HEAD TRACK NUMBER NOP HEAD LOGICAL UNIT NUMBER NOP SECONDARY LOGICAL UNIT NOP PROMPT CHARACTERS NOP CURRENT RECORD NUMBER NOP CURRENT WORD POINTER NOP CURRENT EXTENT OFFSET BLOCK NOP EXTENT NUMBER NOP PARSED NAMR WORD 1 NOP PARSED NAMR WORD 2 NOP PARSED NAMR WORD 3 NOP PARSED NAMR WORD 4 NOP PARSED  NAMR WORD 5 NOP PARSED NAMR WORD 6 NOP PARSED NAMR WORD 7 NOP PARSED NAMR WORD 8 NOP PARSED NAMR WORD 9 NOP PARSED NAMR WORD 10 DEF C.BS0 BUFFER ADDRESS DEF C.DUM REWIND GUARANTEE ROUTINE DEF C.DUM $INCLUDE ROUTINE ADDRESS END p  92060-18080 1805 S C0122 &C.SC1 COMPILER LIBRARY SCRATCH FCB1             H0101 AASMB,R,L,C HED COMPILER LIBRARY FILE CONTROL BLOCK NAM C.SC1,7 92060-18080 770802 REV. 1805 $CLIB 0905 * *************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * * REPRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * *************************************************************** SPC 2 * SOURCE PART NUMBER: 92060-18080 * * READ - WRITE SCRATCH FILE - REWIND IF NECESSARY * * * * GENERAL FILE CONTROL BLOCK FORMAT * * 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 0 * +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+ * C.LNK ! LINK TO NEXT FCB ! WORD 0 * +--+-----------+--------------+--------+--------+ * C.FID !DD!DFLT PRM# ! FCB # !XXXXXXXX!FCB TYPE! WORD 1 * +--+-----------+--------------+--------+--------+ * C.FLU ! !FUNCT CODE ! LOGICAL UNIT # ! WORD 2 * +--------------+--------------+-----------------+ * C.STR ! CURRENT EXTENT START TRACK NUMBER ! WORD 3 * +-----------------------------------------------+ * C.SSC ! CURRENT EXTENT START BLOCK NUMBER ! WORD 4 * +-----------------------------------------------+ * C.S/T ! NUMBER OF BLOCKS IN TRACK ! WORD 5 * +-----------------------------------------------+ * C.#SC ! NUMBER OF BLOCKS PER EXTENT ! WORD 6 * +-----------------------------------------------+ * C.FA1 ! DIRECTORY ADDRESS ! WORD 7 * +------------- ---------------+ * C.FA2 ! FROM D.RTR ! WORD 8 * +-----------------------------------------------+ * C.HTR ! HEAD TRACK NUMBER ! WORD 9 * 7+-----------------------------------------------+ * C.HLU ! HEAD LOGICAL UNIT NUMBER ! WORD 10 * +-----------------------------------------------+ * C.?? ! PROMPT CHARACTERS ! WORD 11 * +-----------------------------------------------+ * C.SLU ! SECONDARY LOGICAL UNIT NUMBER ! WORD 12 * +-----------------------------------------------+ * C.RC# ! RECORD NUMBER ! WORD 13 * +-----------------------------------------------+ * C.WRD ! CURRENT WORD POINTER ! WORD 14 * +-----------------------------------------------+ * C.RSC + CURRENT EXTENT OFFSET BLOCK ! WORD 15 * +-----------------------------------------------+ * C.EXT ! EXTENT NUMBER ! WORD 16 * +-----------------------------------------------+ * C.NAM ! PARSED NAMR WORD 1 ! WORD 17 * +-----------------------------------------------+ * C.NA2 ! WORD 2 ! WORD 18 * +-----------------------------------------------+ * C.NA3 ! WORD 3 ! WORD 19 * +-----------------------------------------------+ * C.TYP ! WORD 4 ! WORD 20 * +-----------------------------------------------+ * C.SC ! WORD 5 ! WORD 21 * +-----------------------------------------------+ * C.CR ! WORD 6 ! WORD 22 * +-----------------------------------------------+ * C.FTY ! WORD 7 ! WORD 23 * +-----------------------------------------------+ * C.FSZ ! WORD 8 ! WORD 24 * +-----------------------------------------------+ * C.NA9 ! WORD 9 ! WORD 25 *  +-----------------------------------------------+ * C.NA0 ! WORD 10 ! WORD 26 * +-----------------------------------------------+ * C.BSO ! BUFFER ADDRESS ! WORD 27 * +-----------------------------------------------+ * C.GRW ! REWIND CHECK GUARANTEE ADDRESS ! WORD 28 * +-----------------------------------------------+ * C.INS ! $INCLUDE ROUTINE ADDRESS ! WORD 29 * +-----------------------------------------------+ SKP ENT C.SC1 * EXT C.BS1 SCRATCH BUFFER ADDRESS EXT C.DUM $INCLUDE ROUTINE * * * WHERE: FCB TYPE = 0 FOR READ SOURCE * = 1 FOR WRITE BINARY * = 2 FOR READ-WRITE SCRATCH * = 3 FOR WRITE SOURCE * FCB # = THE NUMBER ASSIGNED TO THIS FCB * DFLT PR # = THE DEFAULT PARAMETER NUMBER * DD = 0 FOR DISC DEVICE * 1 FOR UNIT RECORD DEVICE * * * * * * C.SC1 NOP LINK OCT 00102 READ OR WRITE SCRATCH OCT 0 LOGICAL UNIT NOP START TRACK NUMBER NOP START SECTOR NUMBER NOP NUMBER OF BLOCKS PER TRACK NOP NUMBER OF BLOCKS IN EXTENT NOP DIRECTORY ADDRESS NOP FROM D.RTR NOP HEAD TRACK NUMBER NOP HEAD LOGICAL UNIT NUMBER NOP SECONDARY LOGICAL UNIT NOP PROMPT CHARACTERS NOP CURRENT RECORD NUMBER NOP CURRENT WORD POINTER NOP CURRENT EXTENT OFFSET BLOCK NOP EXTENT NUMBER NOP PARSED NAMR WORD 1 NOP PARSED NAMR WORD 2 NOP PARSED NAMR WORD 3 NOP PARSED NAMR WORD 4 NOP PARSED  NAMR WORD 5 NOP PARSED NAMR WORD 6 NOP PARSED NAMR WORD 7 NOP PARSED NAMR WORD 8 NOP PARSED NAMR WORD 9 NOP PARSED NAMR WORD 10 DEF C.BS1 BUFFER ADDRESS DEF C.DUM REWIND GUARANTEE ROUTINE DEF C.DUM $INCLUDE ROUTINE ADDRESS END q  92060-18081 1805 S C0122 &C.SC2 COMPILER LIBRARY SCRATCH FCB2             H0101 CASMB,R,L,C HED COMPILER LIBRARY FILE CONTROL BLOCK NAM C.SC2,7 92060-18081 770802 REV. 1805 $CLIB 0910 * *************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * * REPRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * *************************************************************** SPC 2 * SOURCE PART NUMBER: 92060-18081 * * READ - WRITE SCRATCH FILE - REWIND IF NECESSARY * * * * GENERAL FILE CONTROL BLOCK FORMAT * * 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 0 * +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+ * C.LNK ! LINK TO NEXT FCB ! WORD 0 * +--+-----------+--------------+--------+--------+ * C.FID !DD!DFLT PRM# ! FCB # !XXXXXXXX!FCB TYPE! WORD 1 * +--+-----------+--------------+--------+--------+ * C.FLU ! !FUNCT CODE ! LOGICAL UNIT # ! WORD 2 * +--------------+--------------+-----------------+ * C.STR ! CURRENT EXTENT START TRACK NUMBER ! WORD 3 * +-----------------------------------------------+ * C.SSC ! CURRENT EXTENT START BLOCK NUMBER ! WORD 4 * +-----------------------------------------------+ * C.S/T ! NUMBER OF BLOCKS IN TRACK ! WORD 5 * +-----------------------------------------------+ * C.#SC ! NUMBER OF BLOCKS PER EXTENT ! WORD 6 * +-----------------------------------------------+ * C.FA1 ! DIRECTORY ADDRESS ! WORD 7 * +------------- ---------------+ * C.FA2 ! FROM D.RTR ! WORD 8 * +-----------------------------------------------+ * C.HTR ! HEAD TRACK NUMBER ! WORD 9 * 5+-----------------------------------------------+ * C.HLU ! HEAD LOGICAL UNIT NUMBER ! WORD 10 * +-----------------------------------------------+ * C.?? ! PROMPT CHARACTERS ! WORD 11 * +-----------------------------------------------+ * C.SLU ! SECONDARY LOGICAL UNIT NUMBER ! WORD 12 * +-----------------------------------------------+ * C.RC# ! RECORD NUMBER ! WORD 13 * +-----------------------------------------------+ * C.WRD ! CURRENT WORD POINTER ! WORD 14 * +-----------------------------------------------+ * C.RSC + CURRENT EXTENT OFFSET BLOCK ! WORD 15 * +-----------------------------------------------+ * C.EXT ! EXTENT NUMBER ! WORD 16 * +-----------------------------------------------+ * C.NAM ! PARSED NAMR WORD 1 ! WORD 17 * +-----------------------------------------------+ * C.NA2 ! WORD 2 ! WORD 18 * +-----------------------------------------------+ * C.NA3 ! WORD 3 ! WORD 19 * +-----------------------------------------------+ * C.TYP ! WORD 4 ! WORD 20 * +-----------------------------------------------+ * C.SC ! WORD 5 ! WORD 21 * +-----------------------------------------------+ * C.CR ! WORD 6 ! WORD 22 * +-----------------------------------------------+ * C.FTY ! WORD 7 ! WORD 23 * +-----------------------------------------------+ * C.FSZ ! WORD 8 ! WORD 24 * +-----------------------------------------------+ * C.NA9 ! WORD 9 ! WORD 25 *  +-----------------------------------------------+ * C.NA0 ! WORD 10 ! WORD 26 * +-----------------------------------------------+ * C.BUF ! BUFFER ADDRESS ! WORD 27 * +-----------------------------------------------+ * C.GRW ! REWIND CHECK GUARANTEE ADDRESS ! WORD 28 * +-----------------------------------------------+ * C.INS ! $INCLUDE ROUTINE ADDRESS ! WORD 29 * +-----------------------------------------------+ SKP ENT C.SC2 * EXT C.BS2 LIST BUFFER ADDRESS EXT C.DUM $INCLUDE ROUTINE * * * WHERE: FCB TYPE = 0 FOR READ SOURCE * = 1 FOR WRITE BINARY * = 2 FOR READ-WRITE SCRATCH * = 3 FOR WRITE SOURCE * FCB # = THE NUMBER ASSIGNED TO THIS FCB * DFLT PR # = THE DEFAULT PARAMETER NUMBER * DD = 0 FOR DISC DEVICE * 1 FOR UNIT RECORD DEVICE * * * * * * C.SC2 NOP LINK OCT 00102 READ OR WRITE SCRATCH OCT 1 LOGICAL UNIT NOP START TRACK NUMBER NOP START SECTOR NUMBER NOP NUMBER OF BLOCKS PER TRACK NOP NUMBER OF BLOCKS IN EXTENT NOP DIRECTORY ADDRESS NOP FROM D.RTR NOP HEAD TRACK NUMBER NOP HEAD LOGICAL UNIT NUMBER NOP SECONDARY LOGICAL UNIT NOP PROMPT CHARACTERS NOP CURRENT RECORD NUMBER NOP CURRENT WORD POINTER NOP CURRENT EXTENT OFFSET BLOCK NOP EXTENT NUMBER NOP PARSED NAMR WORD 1 NOP PARSED NAMR WORD 2 NOP PARSED NAMR WORD 3 NOP PARSED NAMR WORD 4 NOP PARSED NAMR WORD 5 NOP PARSED NAMR WORD 6 NOP PARSED NAMR WORD 7 NOP PARSED NAMR WORD 8 NOP PARSED NAMR WORD 9 NOP PARSED NAMR WORD 10 DEF C.BS2 BUFFER ADDRESS DEF C.DUM REWIND GUARANTEE ROUTINE DEF C.DUM $INCLUDE ROUTINE ADDRESS END Rr  92060-18082 1726 S C0122 COMPILER LIBRARY BIN FCB SH             H0101 ASMB,R,L,C HED COMPILER LIBRARY BINARY FILE CONTROL BLOCK NAM C.BNS,7 92060-18082 770515 REV. 1726 $CLIB * * *************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * * REPRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * *************************************************************** * * * * SOURCE PART NUMBER : 92060-18082 * * * * WRITE BINARY - SHARE RESOURCES * * * GENERAL FILE CONTROL BLOCK FORMAT * * * 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 0 * +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+ * C.LNK ! LINK TO NEXT FCB ! WORD 0 * +--+-----------+--------------+--------+--------+ * C.FID !DD!DFLT PRM# ! FCB # !XXXXXXXX!FCB TYPE! WORD 1 * +--+-----------+--------------+--------+--------+ * C.FLU ! !FUNCT CODE ! LOGICAL UNIT # ! WORD 2 * +--------------+--------------+-----------------+ * C.STR ! CURRENT EXTENT START TRACK NUMBER ! WORD 3 * +-----------------------------------------------+ * C.SSC ! CURRENT EXTENT START BLOCK NUMBER ! WORD 4 * +-----------------------------------------------+ * C.RSC ! CURRENT EXTENT OFFSET BLOCK ! WORD 5 * +-----------------------------------------------+ * C.EXT ! EXTENT NUMBER ! WORD 6 * +-----------------------------------------------+ * C.S/T ! NUMBER OF BLOCKS IN TRACK ! WORD 7 * +-----------------------------------------------+ * C.#SC ! NUMBER OF BLOCKS PER EXTENT ! WORD 8 * +-----------------------------------------------+ * C.FA1 ! DIRECTORY ADDRESS ! WORD 9 * +------------- ---------------+ * C.FA2 ! FROM D.RTR ! WORD 10 * +-----------------------------------------------+ * C.HTR ! HEAD TRACK NUMBER ! WORD 11 * +-----------------------------------------------+ * C.HLU ! HEAD TRACK LOGICAL UNIT ! WORD 12 * +-----------------------------------------------+ * C.SLU ! SECONDARY LOGICAL UNIT NUMBER ! WORD 13 * +-----------------------------------------------+ * C.RC# ! RECORD NUMBER ! WORD 14 * +-----------------------------------------------+ * C.?? ! PROMPT CHARACTERS ! WORD 15 * +-----------------------------------------------+ * C.WRD ! CURRENT WORD POINTER ! WORD 16 * +-----------------------------------------------+ * C.BUF ! BUFFER ADDRESS ! WORD 17 * +-----------------------------------------------+ * C.GRW ! REWIND CHECK GUARANTEE ADDRESS ! WORD 18 * +-----------------------------------------------+ * C.INS ! $INCLUDE ROUTINE ADDRESS ! WORD 19 * +-----------------------------------------------+ * C.CNT ! CONTROL ROUTINE ADDRESS ! WORD 20 * +-----------------------------------------------+ * * * * * * DETERMINE TYPE OF OPERATION * * THE FCB CONTAINS THE OPERATION TYPE AS FOLLOWS: * * TYPE = 0 IS READ SOURCE FILE(OR LU) * = 1 IS WRITE BINARY FILE(OR LU) * = 2 IS WRITE SCRATCH FILE * = 3 IS WRITE LIST FILE(OR LU) * = 4 IS REWINDABLE SOURCE * * * ENT C.BNS * EXT C.DUM DUMMY WARC. EXT INSC. $INCLUDE ROUTINE EXT CNTC. CONTROL ROUTINE * * * WHERE: FCB TYPE = 0 FOR READ SOURCE * = 1 FO' R WRITE BINARY * = 2 FOR READ-WRITE SCRATCH * = 3 FOR WRITE SOURCE * FCB # = THE NUMBER ASSIGNED TO THIS FCB * DFLT PR # = THE DEFAULT PARAMETER NUMBER * DD = 0 FOR DISC DEVICE * 1 FOR UNIT RECORD DEVICE * * * * * * C.BNS NOP LINK OCT 14001 DEFAULT PARAMETER #3, WRITE BINARY FILE NOP LOGICAL UNIT NOP START TRACK NUMBER NOP START SECTOR NUMBER NOP OFFSET BLOCK NUMBER NOP EXTENT NUMBER NOP NUMBER OF BLOCKS PER TRACK NOP NUMBER OF BLOCKS IN EXTENT NOP DIRECTORY ADDRESS NOP FROM D.RTR NOP HEAD TRACK NUMBER NOP HEAD TRACK LOGICAL UNIT NOP SECONDARY LOGICAL UNIT NOP CURRENT RECORD NUMBER NOP PROMPT CHARACTERS NOP CURRENT WORD POINTER DEF BUFR BUFFER ADDRESS DEF C.DUM REWIND GUARANTEE ROUTINE DEF INSC. $INCLUDE ROUTINE ADDRESS DEF CNTC. CONTROL ROUTINE ADDRESS * * BUFR BSS 129 DUMMY BUFFER END   92060-18083 1726 S C0122 COMPILER LIBRARY SRC BUF             H0101 ASMB,R,L,C HED COMPILER LIBRARY SOURCE BUFFER NAM C.BSA,7 92060-18083 770515 REV. 1726 $CLIB * * *************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * * REPRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * *************************************************************** * * * * SOURCE PART NUMBER : 92060-18083 * * * SOURCE I/O BUFFER * ENT C.BSA BUFFER ENTRY POINT * * * C.BSA BSS 129 * * END +  92060-18086 1726 S C0122 COMPILER LIBRARY SRC BUF             H0101 ASMB,R,L,C HED COMPILER LIBRARY SOURCE BUFFER NAM C.BSO,7 92060-18086 770515 REV. 1726 $CLIB * * *************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * * REPRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * *************************************************************** * * * * SOURCE PART NUMBER : 92060-18086 * * * SOURCE I/O BUFFER * ENT C.BSO BUFFER ENTRY POINT * * * C.BSO BSS 129 * * END /.  92060-18087 1726 S C0122 COMPILER LIBRARY BIN BUF             H0101 ASMB,R,L,C HED COMPILER LIBRARY BINARY BUFFER NAM C.BBI,7 92060-18087 770515 REV. 1726 $CLIB * * *************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * * REPRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * *************************************************************** * * * * SOURCE PART NUMBER : 92060-18087 * * * BINARY I/O BUFFER * ENT C.BBI BUFFER ENTRY POINT * * * C.BBI BSS 129 * * END   92060-18088 1726 S C0122 COMPILER LIBRARY LIST BUF             H0101 ASMB,R,L,C HED COMPILER LIBRARY LIST BUFFER NAM C.BLI,7 92060-18088 770515 REV. 1726 $CLIB * * *************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * * REPRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * *************************************************************** * * * * SOURCE PART NUMBER : 92060-18088 * * * LISTING I/O BUFFER * ENT C.BLI BUFFER ENTRY POINT * * * C.BLI BSS 129 * * END <  92060-18089 1805 S C0122 &C.BS0 COMPILER LIBRARY SCRATCH BF 0             H0101 1ASMB,R,L,C NAM C.BS0,7 92060-18089 771214 REV. 1805 $CLIB 1512 HED SOURCE INPUT/OUTPUT BUFFER * * SOURCE I/O BUFFER * ENT C.BS0 BUFFER ENTRY POINT * * * C.BS0 BSS 129 * * END   92060-18090 1726 S C0122 COMPILER LIBRARY SCR BUF 2             H0101 ASMB,R,L,C HED COMPILER LIBRARY SCRATCH BUFFER #1 NAM C.BS1,7 92060-18090 770515 REV. 1726 $CLIB * * *************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * * REPRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * *************************************************************** * * * * SOURCE PART NUMBER : 92060-18090 * * * SOURCE I/O BUFFER * ENT C.BS1 BUFFER ENTRY POINT * * * C.BS1 BSS 129 * * END   92060-18091 1826 S C0122 INITIAL COMPILER LIBRARY              H0101 ASMB,L,C HED COMPILER LIBRARY INITIALIZE SUBROUTINE -- SUP.C IFN NAM SUP.C,7 92060-18091 780206 REV. 1826 $CLIB XIF IFZ NAM SUP.C,7 92060-18091 780331 REVM 1826 $CLIB XIF * * * N OPTION GETS YOU AN RTE II III IV VERSION * Z OPTION GETS YOU AN RTE M VERSION * * * CALLING SEQUENCE: * * JSB SUP.C * DEF STRING * ERROR RETURN * RETURN * * A<0 INDICATES THE ERROR * B ::= STRING LENGTH IN WORDS * * STRING IS A 15 WORD ARRAY WHERE YOU WANT THE TIME STRING * (FORMAT: 12:01 PM MON., 29 DEC., 1982 ) * PROCEDURE SUP.C(TIMESTRING); * STRING TIMESTRING; * BEGIN * GLOBAL BOOLEAN SONFLAG; * GLOBAL INTEGER TURN_ON_STRING; * GLOBAL STRING LIBRARYTIME; * INTEGER ARRAY MONTHS[0:23] := "MAR.APR.MAY JUNEJULYAUG. * SEP.OCT.NOV.DEC.JAN.FEB."; * INTEGER ARRAY DAYS[0:14] := "FRI.SAT.SUN.MON.TUE.WED.THU."; * FETCH_TURN_ON_STRING; * IF LENGTH(TURN_ON_STRING) = 113 THEN * SONFLAG := TRUE * ELSE * BEGIN * TURN_ON_STRING_LENGTH := B; * BUILD_THE_TIMESTRING; * END; * PASS_TIME_STRING_TO USER; * END OF SUP.C; SKP * PROCEDURE SUP.C(TIMESTRING); ENT SUP.C * STRING TIMESTRING; * BEGIN * GLOBAL BOOLEAN SONFLAG; EXT C.SON THE I WAS SCHEDULED BY SOMEBODY FLAG * GLOBAL INTEGER TURN_ON_STRING; EXT C.TRN THE TURN ON STRING IN ALL ITS GLORY EXT C.LEN THE LENGTH OF THE TURN ON STRING * GLOBAL STRING LIBRARYTIME; EXT C.TIM THE LIBRARY TIME STRING EXT EXEC GUES WHO EXT .MVW THE MOVE WORDS ROUTINE UNL IFZ LST EXT GTF.C DISGUISES RTE-M AS RUN STRING CAPABLE UNL XIF LST SPC 5 A EQU 0 B EQU 1 D1 DEC 1 O13 OCT 13 D222 DEC -222 THE MAX LENGTH OF THE C.TRN BUFFER ":" ASC 1, : D14 DEC 14 .CTIM DEF C.TIM A LOCAL POINTER TO THE GLOBAL * INTEGER ARRAY TIME[MSEC,SEC,MINUT,HOUR,DAY,YEAR]; TIME EQU * MSEC BSS 1 SEC BSS 1 MINUT BSS 1 HOUR BSS 1 DAY BSS 1 YEAR BSS 1 * INTEGER ARRAY MONTH[0:23] := MONTH DEF *-1 ASC 12,MAR.APR.MAY JUNEJULYAUG. ASC 12,SEP.OCT.NOV.DEC.JAN.FEB. * INTEGER ARRAY DAYS[0:14] := DAYS DEF *+1 ASC 14,FRI.SAT.SUN.MON.TUE.WED.THU. D15 DEC 15 SKP ************** START PROGRAM *************** SUP.C BSS 1 * FETCH_TURN_ON_STRING; UNL IFN LST JSB EXEC DEF *+4+1 DEF D14 DEF D1 DEF C.TRN DEF D222 * IF LENGTH(TURN_ON_STRING) = 222 THEN LDA B ADA D222 SZA JMP L1 * SONFLAG := TRUE; CCA STA C.SON JMP L2 * ELSE UNL XIF IFZ LST JSB GTF.C UNL XIF LST * BEGIN * TURN_ON_STRING_LENGTH := B; L1 EQU * STB C.LEN * BUILD_THE_TIMESTRING; JSB EXEC DEF *+3+1 DEF O13 DEF TIME DEF YEAR LDA MINUT JSB PD00 LDB ":" IOR =B30000 PUT IN LEADING ZERO IF NECESSARY RRR 8 B=UNITS-BLANK;A= ":"-TENS DST C.TIM+1 LDA HOUR TEST FOR AM OR PM LDB =APM ADA =D-12 SSA,RSS JMP PM LDB =AAM LDA HOUR PM STB C.TIM+3 SZA,RSS LDA =D12 HOUR := 12 JSB PD00 STA C.TIM+0 LDA YEAR ADA =D-1900 JSB PD00 CONVERT THE YEAR STA C.TIM+14 LDB DAY ADB =D-60 LDA YEAR AND =D3 SZA LEAP YEAR CHECK SSB ADB =D-1 SSB ADB =D366 ADB =D31 LDA B RAL,RAL ADA B MULTIPLY BY 5 CLB DIV =D153 STA TIME SAVE THE MONTH FOR A WHILE LDA B CLB DIV =D5 INA JSB PD00 GET DAY OF MONTH STA C.TIM+8  LDB TIME NOW GET THE MONTH BLS ADB MONTH INDEX INTO MONTH TABLE DLD B,I DST C.TIM+10 CCA ITS TIME TO GET THE DAY OF THE WEEK ADA YEAR ARS,ARS ADA YEAR ADA DAY CLB DIV =D7 BLS ADB DAYS INDEX INTO DAY TABLE DLD B,I DST C.TIM+5 * END; SPC 3 * PASS_TIME_STRING_TO_USER; L2 LDA .CTIM JMP *+2 ILOP1 LDA A,I RAL,CLE,SLA,ERA JMP ILOP1 LDB SUP.C ILOP2 LDB B,I RBL,CLE,SLB,ERB JMP ILOP2 JSB .MVW DEF D15 NOP LDB D15 ISZ SUP.C ISZ SUP.C JMP SUP.C,I SPC 3 PD00 BSS 1 CLB DIV =D10 SZA ADA =A 0 ALF,ALF ADA B IOR =A 0 JMP PD00,I * END OF SUP.C; END   92060-18092 1805 S C1222 FTN4 MAIN              H0112 ASMB,Q,C HED ** 16K FTN4 COMPILER (FTN4:PASS1) ** NAM FTN4,3 92060-16092 780131 REV. 1805 SPC 1 * * * * *************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * * REPRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * *************************************************************** * * * * * * EXT'S WITH A LEADING 'F.' ARE VARIABLES OR JUMP TARGETS * * THE COLUMN THE EXT STARTS IN DEFINES THE SUBROUTINE IT IS * DEFINED IN AS FOLLOWS * 2 -- OA.F (WRITE PASS FILE ROUTINES) * 3 -- NEX.F (STATEMEXTS THAT DON'T CONTAIN EXPRESSIONS) * 4 -- FA.F (THE ASSIGNMEXT TABLE ROUTINES) * 5 -- EX.F (STATEMEXTS USING THE EXPRESSION EVALUATOR) * 6 -- IC.F (THE CHARACTER INPUT ROUTINES) * 7 -- IDN.F (THE TOKEN INPUT ROUTINES) * 8 -- FTN4 ( THE MAIN) ENT F..DP BASE OF SYMBOL TABLE EXT F..E DIMENSIONS CONSTANT BIT FROM ASSIGNS TABLE EXT F.A ASSIGNMEXT TABLE ADDRESS (CURRENT ENTRY) EXT F.ASS ASSIGNMEXT STATEMEXT PROCESSOR EXT F.ABT ABORT COMPILE EXTRY ENT F.ACC TEMP ACCUMULATOR FLAG EXT F.AF ADDRESS FIELD CURREXT F.A ENT F.ARF NO. OF SUB. FUN. ARGUMEXTS EXT F.ASP ASSIGN STMT. PROCESSOR EXT F.AT ADDRESS TYPE OF CURREXT F.A ENT F.AT. SUBSCRIPT INFO FLAG ENT F.BGN RETURN FROM F4.0 EXT F.BSP BACKSPACE STMT. PROCESSOR ENT F.BUF A BUFFER EXT F.C OFFSET FOR CURRENT MR INSTRUCTION EXT F.CAL CALL STATEMEXT PROCESSOR EXT F.CC CHARACTER COUNT ENT F.CCW FTN OPTION WORD EXT F.CIN CURREXT CI BUFFER LIșNE NUMBER EXT F.CLN INPUT ITEM CURREXT LINE # EXT F.CON CONTINUE STMT. PROCESSOR ENT F.CSZ COMMON SIZE ENT F.D DO TABLE POINTER ENT F.D.T ADDRESS OF '.' FUN. TABLE EXT F.D0 ARRAY ELEMEXT SIZE EXT F.D1 DIMENSION 1 EXT F.D2 DIMENSION 2 EXT F.D3 DIMENSION 3 EXT F.DCF DIM, COM FLAG ENT F.DEF DATA EXISTS FLAG EXT F.DID ADDRESS OF F.IDI EXT F.DLF DELIMETER FLAG ENT F.DNB DEF OF NBUF (NAM RECORD) EXT F.DNI ADDRESS OF NID ENT F.DO LWAM - END OF DO TABLE EXT F.DOP DO STATEMEXT PROCESSOR EXT F.DP BASE OF USER SYMBOL TABLE EXT F.DTY IMPLICIT TYPE TABLE EXT F.E EQUIVALENCE TABLE POINTER EXT F.EFG E - FLAG - SET IF SUBSCRIPT IS DUMMY EXT F.EFP ENDFILE STMT. PROCESSOR ENT F.EMA F.A OF EMA EXT ENTRY, WINDOW SIZE ENT F.EMS EMA SIZE DOUBLE WORD, (INTERNAL FORMAT) ENT F.END END FLAG EXT F.EQE EQUVALENCE ERROR FLAG ENT F.EQF EQUIVALENCE FLAG ENT F.ER0 'RX' OF ERRX LIB ERROR ROUTINE EXT F.ERF ERROR FLAG (# OF ER.F CALLS) EXT F.ERN ERROR ARRAY EXT F.EXF EXTERNAL STATEMEXT FLAG EXT F.FMT FORMAT STMT. PROCESSOR EXT F.GOP GO TO STATEMEXT PROCESSOR EXT F.IDI INPUT ARRAY NON-NUMERIC ENT F.IFF IF FLAG EXT F.IFP IF STATEMEXT PROCESSOR EXT F.IM CURREXT ITEM MODE (REAL, COMPLEX,ECT.) ENT F.INT TEMP VARIABLE ARRAY ENT F.IOF INDICATOR FOR I/O INDEX EVALUATOR EXT F.IU CURREXT ITEM USAGE (DUM., RELATIVE, ECT.) EXT F.HDL LENGTH OF HEAD MESSAGE ENT F.L # WORDS ON STACK 2 EXT F.LFF LOCICAL IF FLAG EXT F.LLO CURRENT RELOCATAION ADDRESS(TWO WORDS) EXT F.LLT ADDRESS OF LINE LOCATION TABLE (SET BY INIT) ENT F.LO  END OF ASSIGNMEXT TABLE+1 EXT F.LOP NO. LINES LEFT ON THIS PAGE. EXT F.LPR ( LOC OF EQUIVALENCE GROUP ENT F.LSF EXPECT FIRST STATEMEXT FLAG ENT F.LSN F.A OF LAST STATEMEXT NUMBER ENT F.LSP LAST OPERATION FLAG ENT F.MFL TYPE STMT. MODE FLAG EXT F.NC NAME CHANGE FLAG. EXT F.NCR NO CROSS REF FLAG EXT F.ND NUMBER OF DIMENSIONS ENT F.NEQ # OF EQUIVALENCE GROUPS EXT F.NT NAME TAG 0= VAR, 1=CONSTANT. EXT F.NTF NAME TAG FLAG EXT F.NW NO. WORDS THIS TABLE F.A EXTRY. EXT F.NXN NO INPUT FLAG EXT F.OFE DATA POOL OVERFLOW ERROR EXTRY. ENT F.OPF OUTPUT PACK FLAG EXT F.R JSB ERR0 FLAG EXT F.PAK PACK BUFFER WORD EXT F.PAP PAUSE STMT. PROCESSOR EXT F.RDP READ STATEMEXT PROCESSOR EXT F.REL SUB. PROG. RETURN LOCATION ENT F.RPL PROGRAM LOCATION COUNTER EXT F.RPR ) LOC OF EQUIVALENCE GROUP EXT F.RTN RETURN STMT. PROCESSOR EXT F.RWP REWIND STMT. PROCESSOR ENT F.S02 RETURN FORM RCOM F.1 ENT F.S03 LOAD F.1 AND PASS CONTROL ENT F.S1B BOTTOM OF STACK 1 ENT F.S1T TOP OF STACK 1 EXT F.S2B BOTTOM OF STACK 2 ENT F.S2T TOP OF STACK 2 ENT F.SBF 0= MAIN, ELSE SUBROUTINE ENT F.SCC SAVE F.CC ENT F.SEE RETURN FROM F4.1 ENT F.SEG LOAD A NEW SEGMENT ENT F.SFF SUBROUTINE/FUNCTION FLAG 0/1 EXT F.SFP STATEMEXT FUNCTION PROCESSOR ENT F.SID STATEMEXT ID PHASE FLAG ENT F.SLF STATEMEXT LEVEL FLAG ENT F.SPF SPECIFICATION FLAG SET TO CURREXT STMT. LEVEL ENT F.SPS STATEMEXT PROCESSOR SWITCH EXT F.SRL SAVE RPL AT BEGINNING OF RECORD ENT F.STA FLAG THAT IS ZERO UNTIL THE FTN STATEMEXT IS READ ENT F.STB STRING BACK JUMP FLAG EXT F.STP STOP STMT. PROCESSOR ENT F.STS TO STATEMEXT SCAN EXT F.SVL SAVE # WORDS ON OPER STACK (F.L) ENT F.SXF COMPLEX CONSTANT FLAG ENT F.T # WORDS ON STACK 1 ENT F.TAC ? EXT F.TC NEXT CHARACTER EXT F.TIM TIME ARRAY ADDRESS IN HEAD EXT F.TRM TERMINATE COMPILE ENT F.TYP TYPE STATEMEXT FLAG EXT F.WRP WRITE STATEMEXT PROCESSOR EXT F.X1 F.A OF F.D1 EXT F.X2 F.A OF F.D2 EXT F.X3 F.A OF F.D3 * * EXT'S WITH A TRAILING '.F' ARE SUBROUTINES * ENT AA.F ASSIGN ADDRESS SUB. EXT AI.F ASSIGN ITEM EXT ASC.F CONVERT TO 4 ASCII DIGITS EXT BNI.F CLEAR NID TO BLANKS EXT BOM.F DISASTOR ERROR REPORT (NO RETURN) EXT CID.F CLEAR F.ID ARRAY EXT CDI.F CLEAR IDI ROUTINE EXT CRP.F CROSS REF PAIR SUB. ENT CRT.F TEST FOR CARRAGE RETURN EXT DAF.F DEFINE (F.AF) EXT DAT.F DEFINE (AT) EXT DIM.F DEFIND (F.IM) EXT DIU.F DEFINE (F.IU) EXT DL.F DEFINE LOCATION SUBROUTINE EXT EJP.F PAGE EJECT SUBROUTINE EXT ER.F ERROR PRINT SUBROUTINE EXT ESC.F ESTABLISH CONSTANT SUBROUTINE EXT ESD.F ESTABLISH DEF SUBROUTINE EXT EXN.F EXAMINE NEXT CHARACTER EXT FA.F FETCH ASSIGNS EXT FID.F FETCH (ID) TO NID (UNPACK) ENT FNS.F FIRST NOT SPEC. STMEXT CHECK EXT FXC.F CHECK IF SUB. IN FIX-EXT TABLE EXT GNA.F GET NEXT SYMBOL TABLE EXTRY EXT GPE.F GENERATE SUB. PROG. EXTRANCE EXT IA.F INPUT (A) CHARACTERS SUBROUTINE EXT IC.F GET NEXT CHARACTER EXT ICH.F GET NEXT NON BLANK CHAR. AND TYPE IT EXT IDN.F INPUT DO NOT ASSIGN (GET NEXT OPERAND) EXT IDS.F INPUT DIGIT STRING EXT IFT.F IF GOTO COMPLETION EXT II.F INPUT ITEM EXT IIV.F IN|PUT INTEGER VARABLE EXT IN2.F INIT FOR OA.F MODULE EXT IN3.F INIT FOR ENX.F MODULE EXT IN4.F INIT FOR FA.F MODULE EXT IN5.F INIT FOR EX.F MODULE EXT IN6.F INIT FOR IC.F MODULE EXT IN7.F INIT FOR IDN.F MODULE EXT INM.F INPUT NAME EXT IOP.F INPUT OPERATOR EXT ISN.F INPUT STATEMEXT NUMBER EXT ISY.F INPUT SYMBOL EXT ITS.F INTEGER TEST EXT MCC.F RESET TO FIRST COLUMN OF STATEMEXT EXT MPN.F MOVE PROGRAM NAME (TO NAM RECORD ECT.) ENT NEW.F SUB TO CLEAR TEMPS FOR A NEW MODULE EXT NCT.F TEST FOR NOT A CONSTANT EXT NST.F TEST FOR NOT A SUBROUTINE NAME EXT NTI.F MOVE NID TO F.IDI (PACKS) EXT NWI.F SET F.D0 TO # WORDS IN ARRAY EXT OA.F OUTPUT ASSIGNMEXT TABLE OPERAND EXT OAI.F OUTPUT ABS. INSTRUCTION EXT OC.F OUTPUT CONSTANT EXT ODF.F OUTPUT DOT FUNCTION EXT OLR.F OUTPUT LOAD ADDRESS EXT OMR.F OUTPUT MEMORY REF. INSTRUCTION EXT OS.F OUTPUT SECTOR TO INTERPASS FILE EXT OW.F OUTPUT WORD EXT OZ.F OUTPUT ZREL (OP *+N) EXT PAK.F PACK SUBROUTINE EXT PDF.F PRODUCE DEF SUBROUTINE EXT PSL.F PRINT LINE ON PRINTER EXT PTM.F PROGRAM TERMINATION CODE GEN. EXT RTN.F SUBROUTINE RETURN HANDLER EXT RP.F INPUT ')' ENT SCC.F SAVE F.CC SUBROUTINE EXT SCP.F SAVE CURREXT STATPMEXT POSITION. EXT SKL.F SKIP LINES ON LIST EXT SNC.F START NEXT CARD SUBROUTINE EXT SOA.F STORE AND OUTPUT (OA.F) EXT TDO.F DO TERMINATION CODE GENERATOR EXT TCT.F TEST (A) = F.TC ELSE ER 28 EXT TS.F TAG SUBPROGRAM SUB. EXT TV.F TAG VARIABLE EXT UC.F UNINPUT COLUMN EXT WAR.F ERROR COMMEXT SUBROUTINE (WARNINGS) SPC 1 * THIS FORTRAN IV COMPILER RkYUNS UNDER VARIOUS OP * SYSTEMS THROUGH SUITABLE INTERFACE ROUTINES. * * OPSYSTEM INTERFACE: * * EXT SEG.F SEGMENT TRANSLATOR EXT WRT.C EXT C.TTY EXT C.BIN BINARY FCB (MUST BE IN MAIN) EXT C.TRN COMPILER LIB. DATA STORE EXT OLY.C SEGMENT LOAD * GENERAL LIBRARY ROUTINES * * * * EXTRY POINTS IN THE SEGMENTS * EXT F.COM COMMON STATEMENT PROCESSOR EXT F.CPX COMPLEX STATEMENT PROCESSOR EXT F.DAT DATA STATEMENT PROCESSOR EXT F.DBL DOUBLE STATEMENT PROCESSOR EXT F.DIM DIMENSION STATEMENT PROCESSOR EXT F.EQU EQUIVALENCE STATEMENT PROCESSOR EXT F.EXT EXTERNAL STATEMENT PROCESSOR EXT F.FUN FUNCTION STATEMENT PROCESSOR EXT F.IMP IMPLICIT STATEMENT PROCESSOR EXT F.INP INTEGER STATEMENT PROCESSOR EXT F.LOG LOGICAL STATEMENT PROCESSOR EXT F.PRO PROGRAM STATEMENT PROCESSOR EXT PU2.F PUSH ONTO STACK 2 ROUTINE EXT F.RCO RELATE COMMON AND FINISH EQU PROCESSING EXT F.REA REAL STATEMENT PROCESSOR EXT F.SUB SUBROUTINE STATEMENT PROCESSOR EXT F.BLK BLOCK DATA STATEMENT PROCESSOR EXT FER.F FORM PROGRAM ENTRANCE CODE SPC 1 SUP A EQU 0 A-REGISTER B EQU 1 B-REGISTER SKP * PBUF BSS 0 F.BUF BSS 0 NBUF EQU PBUF+65 LINE #S FOR 21 CARDS IN CRDBF * * DEF C.TRN DUMMY REF. TO FOURCE LOAD WITH MAIN DEF C.BIN ALSO A DUMMY * BSS 60-*+NBUF RESERVE ROOM OF NAM RECORD SPC 1 FTN4 BSS 0 DST F.IDI SAVE THE RUN REGS. LDB K4 GO TO SEGMENT 4 JMP F.SEG * * * F.STA NOP FTN READ YET FLAG F.CCW DEC 1 COMPILE OPTION CONTROL WORD (PRINT CON REC.) F.DNB DEF NBUF K2 DEC 2 K4 DEC 4 B15 OCT 15 B54 OCT 54 F.ER0 ASC 1,R0 F.DO NOP LWAM; END OF F.DO TABLE SKP  * ************************* * * COMPILE A NEW PROGRAM * * ************************* SPC 1 NEW.F NOP CLA STA STBFL CLEAR STRING BACK FLAG STA F.NEQ SET # OF EQUIV GP.=0 STA F.OPF SET NOT TO OUTPUT STA F.NXN RESET NO INPUT FLAG STA F.SID CLEAR THE SCAN SWITCH LDA K73 STA F.LSP SET PATH TO THIS STATMENT TRUE STA F.CC SET F.CC=73 JMP NEW.F,I RETURN SPC 2 SPC 1 F.D.T DEF ..TBL * F..DP NOP FIX EXTERNAL F.LO NOP END OF ASSIGNMENT TABLE +1 F.EQF NOP NEG. IF NOT PROC EQUIV F.S1B NOP BEGIN OPERAND STACK F.S1T NOP END OPERAND STACK F.S2T NOP END OPERATOR STACK F.NEQ NOP # OF EQUIVALENCE GROUPS K73 DEC 73 SPC 2 * *********** * * SAVE CC * * *********** SPC 1 SCC.F NOP LDA F.CC SAVE COLUMN COUNTER STA F.SCC JMP SCC.F,I * F.SCC OCT 0 SAVE F.CC K27 DEC 27 K29 DEC 29 SKP * ******************* * * STATEMENT INPUT * * ******************* SPC 1 F.BGN JSB SCC.F SAVE THE CHARACTER POSITION CLA STA F.OPF CLEAR THE PACK FLAG STA F.STB CLEAR STRING-BACK FLAG STA F.A SET ASSIGNMENT TABLE PTR TO 0 STA F.MFL CLEAR MODE FLAG JSB EXN.F EXAMINE NEXT CHAR. CPA B15 IF BLANK CARD JMP CRT.F TREAT AS A CONTINUE CARD * LDA F.CC BEYOND COL. 6? ADA KM6 SZA,RSS IF EXACTLY 6 THEN MUST BE ISZ F.CC A '0' SO PUSH ON SSA,RSS WELL?? JMP STIN2 YES, NO NUMBER. * JSB ISN.F INPUT STATEMENT NUMBER STIN2 LDA F.A STA F.LSN LAST STATEMENT NUMBER FLAG SZA,RSS JMP STIN0 CURRENT CARD HAS NO STATEMENT NO. LDA K27 27 LDB F.AT CPB REL JSsB WAR.F ERROR 27: STMT NO. PREVIOUSLY DEFINED STIN0 LDA F.IFF IF FLAG SET? SZA XOR F.LSN YES JSB IFT.F F.IFF TEST (RTNS A=0) CPA F.CC BLANK CARD INPUT? JMP STIN6 YES. CPA F.LSN STATEMENT # ON CARD? JMP F.STS NO. GO SCAN THE STATEMENT LDA F.TC LOAD THE LAST CHARACTER READ. CPA B15 CARRIAGE-RETURN? JMP STIN1 YES, PRINT SOURCE LINE. JSB EXN.F GET THE NEXT CHARACTER. LDA F.CC LOAD THE COLUMN POINTER. SZA COLUMNS 7 THRU 72 BLANK? JMP F.STS NO, IDENTIFY THE CARD TYPE. ISZ F.CC SET F.CC=1 STIN1 LDA K29 BITCH: STATEMENT NO. ON BLANK CARD JSB ER.F SPC 2 SPC 1 STIN6 JSB SNC.F BLANK CARD; SET FOR NEXT CARD JMP F.BGN PROCESS THE CURRENT CARD. SPC 2 KM3 DEC -3 KM6 DEC -6 B50 OCT 50 DSLH OCT 42015 END$. ASC 2,END$ SKP * THE FOLLOWING IS A FLOW CHART OF THE STATEMENT IDENTIFIER AND * DISPATCHER. TWO SYMBOLS ARE USED FOR DECISION BLOCKS AS FOLLWOS: * * * Y=X? IF Y=X EXIT WILL BE '1' (TRUE), ELSE '0' (FALSE) * Y=? THIS IS REALLY A COMPUTED GO TO OR CASE STATEMENT. * EXITS WILL BE LABELED WITH THE VALUE OF Y WHICH * TAKES THAT EXIT. * * LABELS ARE USED TO COROLATE THE FLOW CHART AND THE LISTING * * ROUTINES USED FUNCTION * IDN.F INPUTS 6 ALF/NUM OR TO DELIMITER OR OPERAND TO DELIMITER- * INPUTS WHOLE HOLLERITH STRINGS AND EXCEPT FOR > 6 * CHARACTERS ALF/NUM IDENTIFIER STRINGS INPUTS * THE DELIMITER AND LEAVES IT IN F.TC. * ICH.F INPUTS ONE NON-BLANK CHARACTER AND SET DELIMITER FLAG. * CLID CLEARS NUMBER ACCUMULATOR * IDS.F INPUT DIGIT STRING. * MCC.F RESETS TO BEGINNING OF STATEMENT. * ISY.F INPUTS A SYMBOL AND SETS ARRAY IDENTIFIER. * * * SHORT HAND FOR TEMPS * T1 = T1STS * W T2 = T2STS * T4 = T4SID * * FLOW LINES * * ! = DOWN * ^ = UP FLOW * _ = LEFT FLOW * - = RIGHT FLOW * = = EQUALITY TEST * O = TWO OR MORE LINES JOIN (ELSE THEY CROSS) SKP * T1_ -1 WE BEGIN JUST AFTER STSCC * T4,T2_ 0 START BY LOOK FOR A 'DO' STMT. * FIRST TWO CHAR = 'DO'? * 0! 1! * !__________ ! * ! T3_ 0 LOOK FOR DIGITS * ! O______ X * ! ICH.F ^ * ! DIGIT? T3_ #0 * ! 0! 1! ^ * ! T3= 0? ---^ * ! 1! 0! * O________________________ F.TC= ','? IF OPTIONAL COMMA THEN DO * ! 0! 1! * ! UC.F,IDN.F ! LOOK FOR INT. VAR. * ! ! ! * ! F.NT=NAMED? ! * ! 0! 1! ! * O______________ F.TC= '='? ! FOLLOWED BY '='? * ! 0! 1! ! * O________________________! ----------------O STSC3______________O * ! ! IDN.F ^ * ! ! ! ^ * ! ! TC=? ^ * ! ! !____!__O-------------ELSE---O * ! ! ! ! ! ! ^ * ! ! 'C/R' ',' ')' '(' ^ * ! ! ! !STSC5 ! ! ^ * !-----------------O________________!____ T2=0? T2_T2+1 ! ^ * ! ! 1! 0! ! T2_T2-1 ^ * ! STSCB ! ! ! ! ! ^ * MCC.F ! ! !---O------O---------^ * F.SID_1 ! ! * IDN.F !----****STIDO**** * TC=LETTER,',' OR '/'? *IT IS A DO * * 1! 0! STSC9 *STATEMENT * * ! ! ************* * ! O_______________________ X * ! TC=? ^ * ! ________O------------------- ^ * ! ! ! ! ! ! ! ^ * ! 'C/R' '"' ')' '(' E '=' ^ * ! !STID0! ! ! L ! ^ * ! O_____O T4_T4-1 ! S ! ^ ^------! * ! ! ^ !T4_T4+1E ! ^ ^ ISY.F,MCC.F * ! ! ^ T4=0? ! ! T4=0? ^ ^ ! * O____ ^ 1! 0! ! ! 0! 1! ^ ^ ARRAY? * ! STID0 ^ EXN.F --O__O____ ! ^ ^ 1! 0! * MCC.F ^ ! IDN.F ! ^ ^ ! *STFPR***** * FIRST 3 CHAR='IF('? ^ TC='='? !---------!-^ ^ ! *STATEMENT* * 1! 0! ^ 0! 1! ! ^ ! *FUNCTION * * ****IFPR**** *ONE OF THE*^___ O_____________ ^ ! *********** * *IT'S AN IF* *KEY WORD * MCC.F ^ ***FASS****** * *STATEMENT * *STATEMENTS* T1=1? ONLY 1 '('? ^ *ASSIGNMENT * * ************ ************ 0! 1--------------^ *STATEMENT * * --------------------************* SKP * ****************** * * STATEMENT SCAN * * ****************** SPC 1 * SCANS THE FIRST CARD OF ALL STATEMENTS DETERMINING IF THE * STATEMENT TYPE IS A REPLACEMENT STATEMENT, A DO STATEMENT * (= FOLLOWED BY ,),OR ARITHMETIC STATEMENT FUNCTION(= AND * THE OPERAND TERMINATED BY '(' AND WAS NOT AN ARRAY). SPC 1 F.STS JSB SCC.F SAVE F.CC LDA K2 STA F.NXN SET NO INPUT FLAG ************************THIS END$ CHECB@ A DEF ENTRY SPC 1 * *********************** * * GET EXT ID FROM TBL * * *********************** * * GETEX NOP GET00 LDA B,I GET THE CURRENT VALUE CMA,INA,SZA IF NON-ZERO THATS ALL THERE IS TO IT JMP GETEX,I JUST RETURN IT * ISZ EXTID ALLOCATE A NEW EXT LDA EXTID AND CMA,INA SET ITS NEGATIVE STA B,I IN THE TABLE JMP GET00 GO SET IT AND EXIT * * *********************** * * STORE AND OUTPUT OA * * *********************** SPC 1 SOA.F NOP STB F.A SAVE IT JSB OA.F JMP SOA.F,I SPC 1 * *********************** * * OUTPUT DOT FUNCTION * * *********************** SPC 1 ODF.F NOP ADB F.D.T GET ADDRESS TO B JSB GETEX GET THE EXT ID IOR JSBI ADD THE JSB JSB OW.F SEND IT KK01 OCT 100000 JMP ODF.F,I AND RETURN SPC 1 * **************h********** * * OUTPUT ABSOLUTE DATA * * ************************ SPC 1 OAD.F NOP JSB OW.F OUTPUT THE INSTRUCTION OCT 0 R=0 FOR ABSOLUTE DATA (OCT WORD) JMP OAD.F,I RETURN A=0, E=1 SPC 1 * ******************************* * * OUTPUT ABSOLUTE INSTRUCTION * * ******************************* SPC 1 OAI.F NOP JSB OW.F OCT 140000 R110 FOR MNEMONIC OPCODE JMP OAI.F,I RETURN A=0, E=1 SPC 1 * *************************************** * * OUTPUT MEMORY REFERENCE INSTRUCTION * * *************************************** SPC 1 OMR.F NOP JSB OW.F OUTPUT INSTRUCTION R101 OCT 120000 R=5 FOR MEMORY REFERENCE LDB T1OW GET THE ADDRESS ADB K8 ALLOW A NEGATIVE OFFSET OF 8 CLE,SSB,RSS IF NOT AN A.T. REF JMP OMR.F,I JUST RETURN * LDB T1OW RESTORE THE ADDRESS TO B RBL,ERB ELSE SET THE USED LDA B,I BIT IOR B10 IN THE A.T. STA B,I AND THEN CLA JMP OMR.F,I RETURN * * ******************************************* * *OUTPUT MR WITH OFFSET B= OFFSET,A=INSTR.* * ******************************************* * * OMA.F NOP STB F.C SET THE OFFSET JSB OA.F OUT PUT TO F.A WITH OFFSET OF B JMP OMA.F,I RETURN * * * ******************************************** * * PRODUCE THE DEF DESCRIBED BY CURRENT F.A * * ******************************************** * * PDF.F NOP LDA F.RPL DEFINE ITS ADDRESS JSB DAF.F AS THE CURRENT ADDRESS LDB F.AT WHERE IS IT CPB BCOMI LABELED COM? JMP PDF03 YES DO SPECIAL * CLA NO SET FOR DEF CPB COM IN COMMON? LDA K2 YES SET MR  LDB F.A INDEX ADB K2 INTO THE ENTRY LDB B,I AND GET THE ADDRESS JSB OMR.F OUTPUT THE WORD PDF02 LDA F.A,I SET THE R FLAG IOR B20 TO SHOW STA F.A,I IT WAS DONE JMP PDF.F,I AND RETURN * PDF03 LDB F.A LABELED COMMON REFERENCE ADB K2 GET THE LDA B,I OFFSET AND STA F.C SET UP INB GET THE LDB B,I ADDRESS OF THE MASTER INB INDEX TO THE EXT WORD JSB GETEX GET THE EXT NO ADB N1PS ADD THE SIGN BIT AND SUBTRACT ONE CLA SET INSTRUCTION TO DEF JSB OW.F SEND IT OCT 160000 MAKE SURE IT IS WITH OFFSET JMP PDF02 GO SEND IT * * K8 DEC 8 F.C NOP B20 OCT 20 COM OCT 4000 F.AT=COM BCOMI OCT 7000 F.AT=BCOMI N1PS OCT 77777 -1+100000B SKP * OUTPUT LOAD ADDRESS=RPL SPC 1 OLR.F NOP CLB LDA F.RPL JSB OW.F R001 OCT 20000 R=1 JMP OLR.F,I RETURN A=0, E=1 SPC 2 * * OUTPUT ZREL * SPC 1 OZ.F NOP OUTPUT COMMAND OF FORM 'OP *+N' ADB ADON ADD CURRENT DISPLACEMENT ADB F.C NOT CURRENTLY NEEDED BUT FEEL FREE STB F.C SET THE TOTAL DISPLACEMENT LDB F.LLO GET THE BASE ADDRESS JSB OMR.F OUTPUT INSTR. (A) HAS OP IN IT JMP OZ.F,I SPC 1 * ************************************* * * GENERATE SUBPROGRAM ENTRANCE CODE * * ************************************* SPC 1 GPE.F NOP JSB OLR.F OUTPUT LOAD ADDRESS=RPL CLA JSB OAI.F OUTPUT 'NOP' LDB .ENTR GENERATE ENTRY CODE: JSB ODF.F 'JSB .ENTR' (RTNS A=0) LDB F.SRL JSB OMR.F OUTPUT DEF *-N-2 JMP GPE.F,I * .ENTR DEF .TBL+27 TRANSFER ACTUAL PARAMETERS T0OC BSS 1 T1OC BSS 1 JSBI OCT 16000 F.SRL NOP FI@RST CODE WORD ADDRESS SPC 1 * ******************* * * OUTPUT CONSTANT * * ******************* SPC 1 OC.F NOP OUTPUT INT,REA,LOG,CPX, OR DBL LDA F.D0 CONSTANT. CMA,INA STA T0OC -LENGTH OF CONST LDA F.DID 1ST LOC OF F.IDI STA T1OC OC01 LDA T1OC,I JSB OAD.F OUTPUT WORD ISZ T1OC ISZ T0OC JMP OC01 NOT DONE; OUTPUT MORE WORDS. JMP OC.F,I RETURN A=0, E=1 SKP * *************** * * OUTPUT WORD * * *************** SPC 1 * INPUT: (A)=WORD TO BE OUTPUT * (B)=2ND WORD IF MR * (F.C)=OFFSET IF R=111 OR IF R=101 AND F.C#0 * R =RELOCATION INDICATOR IN HIGH ORDER (-1 IF SRC) SPC 1 OW.F NOP STA T0OW SAVE (A) STB T1OW SAVE (B) LDB OW.F,I LDA F.C IF OFFSET GIVEN SZA,RSS SKIP JMP OW00 THE FOLLOWING TEST * CPB R101 IF MR AND OFFSET LDB R111 SET TO OFFSET TYPE OW00 STB R ISZ OW.F CPB R011 IS THIS TERMINATING RECORD? JMP OWS40 YES * CPB R001 IS THIS A NEW LOAD LOC? JMP OWS41 YES * OW03 LDA KM63 DETERMINE ROOM IN PRESENT SECTOR ADA F.BUF ADD CURRENT USAGE CLB,INB IF A NEW RECORD CPB F.BUF THEN JMP OW07 GO SET IT UP * LDB R ADD TO PRIOR DATA RECORD. CPB R111 IF OFSET INA,RSS ADD TWO CPB R101 MEM REF? INA YES. NEEDS EXTRA WORD. LDB RNO ADB KM5. SSB,RSS NEW BYTE WORD NEEDED? INA YES. ALLOW FOR IT SSA,RSS ROOM FOR THESE WORDS? JMP OW06 NO. USE NEW SECTOR. * SSB,RSS BYTE WORD FULL? JMP OW16 YES. START NEW BYTE WORD * JMP OW17 USE PRESENT ONE SPC 1 OWS41 LDA T0OW ELSE SET UP STA F.LLO THE NEW ADDRESS LDA T1OW AND STA ADON OFFSET OWS40 JSB OS.F FLUSH THE CURRENT RECORD JMP OW.F,I AND RETURN (A=0, E=1) * OW06 JSB OS.F FULL. OUTPUT RECORD OW07 LDA F.LLO LOAD LOCATION JSB WR SEND IT LDA ADON ADD-ON JSB WR SEND IT * OW16 LDA PBPT START NEW BYTE WORD. STA RPTR SAVE ITS LOCATION CLA STA RNO JSB WR SEND A ZERO OW17 LDB RNO REL BYTE NO. BLS ADB RNO 3*RNO LDA R RECORD TYPE BYTE CMB,RSS RAR POSITION R-BYTE INB,SZB SHIFT COMPLETE? JMP *-2 NO IOR RPTR,I STA RPTR,I COMBINE PRIOR BYTE WORD ISZ F.RPL RPL=RPL+1 LDB F.RPL LDA K84 OVERFLOW CODE SSB OVERFLOW?? JMP F.ABT RPL OVERFLOW ISZ ADON ADON=ADON+1 ISZ RNO COUNT R-BYTES LDA T0OW JSB WR SEND THE WORD LDB R LDA T1OW GET WORD TWO CPB R101 MEMORY REFERENCE? JSB WR YES SEND IT CPB R111 OFFSET TYPE? JSB WR SEND IT IN THIS CASE ALSO LDA F.C GET OFFSET CPB R111 OFFSET TYPE JSB WR YES SEND THE OFFSET CLA,CCE CLEAR A AND STA F.C F.C JMP OW.F,I RETURN A=0, E=1 SPC 1 WR NOP WRITE WORD AND PUSH POINTERS STA PBPT,I ISZ PBPT ISZ F.BUF JMP WR,I RETURN * F.LLO BSS 1 LOAD LOCATION ADON BSS 1 ADD-ON TO LOAD LOCATION PBPT BSS 1 PBUF WORD POINTER RLPT NOP RECORD LENGTH POINTER RPTR BSS 1 RECORD R1R2R3R4R5 LOCATION RNO BSS 1 R NUMBER KM5. DEC -5 KK31 OCT 100001 T0OW BSS 1 SAVE ENTRY (A) T1OW BSS 1 SAVE ENTRY (B) R BSS 1 INTERMEDIATE CODE RECORD TYPE K3 DEC 3 oyNLHKM63 DEC -63 K5 DEC 5 R010 OCT 40000 R011 OCT 60000 K84 DEC 84 SPC 1 * ***************** * * OUTPUT SECTOR * * ***************** SPC 1 OS.F NOP CLB,INB IF EMPTY RECORD CPB F.BUF JUST JMP OS.F,I RETURN * LDB OWK1 STB PBPT RESET PBUF POINTER JSB WRT.C OUTPUT BUFFER TO DISC DEF C.SC1 OWK1 DEF F.BUF DEF F.BUF FIRST WORD IS THE TRUE LENGTH JMP PASER IF NO ERROR RETURN * CLA,CCE SET BUFFER TO POINT TO NEXT WD JSB WR AND COUNT TO ONE JMP OS.F,I RETURN A=0, E=1 * PASER LDA K99 SEND PASS WRITE BOOM JMP F.ABT NO RETURN SPC 1 K99 DEC 99 K64 DEC 64 EXTID NOP * IN2.F NOP INIT CODE FOR THIS MODULE LDA OWK1 REMOVE THE INDIRECT RAL,CLE,SLA,ERA IF SET LDA A,I GET THE REAL ADDRESS STA OWK1 ON THE BUFFER ADDRESS STA PBPT CLA CLEAR STA EXTID THE EXT ID COUNTER JSB WR SET COUNT TO 1 AND PUSH THE POINTER JMP IN2.F,I RETURN * END wxNASMB,Q,C HED FTN STATEMENT PROCESSORS STMTS WITHOUT EXPRESSIONS NAM NEX.F,8 92060-16092 771116 * * * * *************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * * REPRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * *************************************************************** * * * * * * EXT'S WITH A LEADING 'F.' ARE VARIABLES OR JUMP TARGETS * * THE COLUMN THE EXT STARTS IN DEFINES THE SUBROUTINE IT IS * DEFINED IN AS FOLLOWS * 2 -- OA.F (WRITE PASS FILE ROUTINES) * 3 -- NEX.F (STATEMEXTS THAT DON'T CONTAIN EXPRESSIONS) * 4 -- FA.F (THE ASSIGNMEXT TABLE ROUTINES) * 5 -- EX.F (STATEMEXTS USING THE EXPRESSION EVALUATOR) * 6 -- IC.F (THE CHARACTER INPUT ROUTINES) * 7 -- IDN.F (THE TOKEN INPUT ROUTINES) * 8 -- FTN4 ( THE MAIN) EXT F..DP BASE OF SYMBOL TABLE EXT F..E DIMENSIONS CONSTANT BIT FROM ASSIGNS TABLE EXT F.A ASSIGNMEXT TABLE ADDRESS (CURRENT ENTRY) EXT F.ASS ASSIGNMEXT STATEMEXT PROCESSOR EXT F.ABT ABORT COMPILE EXTRY EXT F.ACC TEMP ACCUMULATOR FLAG EXT F.AF ADDRESS FIELD CURREXT F.A EXT F.ARF NO. OF SUB. FUN. ARGUMEXTS ENT F.ASP ASSIGN STMT. PROCESSOR EXT F.AT ADDRESS TYPE OF CURREXT F.A EXT F.AT. SUBSCRIPT INFO FLAG EXT F.BGN RETURN FROM F4.0 ENT F.BSP BACKSPACE STMT. PROCESSOR EXT F.BUF A BUFFER EXT F.C OFFSET FOR CURRENT MR INSTRUCTION EXT F.CAL CALL STATEMEXT PROCESSOR EXT F.CC CHARACTER COUNT EXT F.CCW FTN OPTION WORD EXT F.CIN CURREXT CI BUFFER LINE NUMBER ? EXT F.CLN INPUT ITEM CURREXT LINE # ENT F.CON CONTINUE STMT. PROCESSOR EXT F.CSZ COMMON SIZE EXT F.D DO TABLE POINTER EXT F.D.T ADDRESS OF '.' FUN. TABLE EXT F.D0 ARRAY ELEMEXT SIZE EXT F.D1 DIMENSION 1 EXT F.D2 DIMENSION 2 EXT F.D3 DIMENSION 3 EXT F.DCF DIM, COM FLAG EXT F.DEF DATA EXISTS FLAG EXT F.DID ADDRESS OF F.IDI EXT F.DLF DELIMETER FLAG EXT F.DNB DEF OF NBUF (NAM RECORD) EXT F.DNI ADDRESS OF NID EXT F.DO LWAM - END OF DO TABLE EXT F.DOP DO STATEMEXT PROCESSOR EXT F.DP BASE OF USER SYMBOL TABLE EXT F.E EQUIVALENCE TABLE POINTER EXT F.EFG E - FLAG - SET IF SUBSCRIPT IS DUMMY ENT F.EFP ENDFILE STMT. PROCESSOR EXT F.END END FLAG EXT F.EQE EQUVALENCE ERROR FLAG EXT F.EQF EQUIVALENCE FLAG EXT F.ER0 'RX' OF ERRX LIB ERROR ROUTINE EXT F.ERF ERROR FLAG (# OF ER.F CALLS) EXT F.ERN ERROR ARRAY EXT F.EXF EXTERNAL STATEMEXT FLAG ENT F.FMT FORMAT STMT. PROCESSOR EXT F.GOP GO TO STATEMEXT PROCESSOR EXT F.IDI INPUT ARRAY NON-NUMERIC EXT F.IFF IF FLAG EXT F.IFP IF STATEMEXT PROCESSOR EXT F.IM CURREXT ITEM MODE (REAL, COMPLEX,ECT.) EXT F.INT TEMP VARIABLE ARRAY EXT F.IOF INDICATOR FOR I/O INDEX EVALUATOR EXT F.IU CURREXT ITEM USAGE (DUM., RELATIVE, ECT.) EXT F.HDL LENGTH OF HEAD MESSAGE EXT F.L # WORDS ON STACK 2 EXT F.LFF LOCICAL IF FLAG EXT F.LLO CURRENT RELOCATAION ADDRESS(TWO WORDS) EXT F.LLT ADDRESS OF LINE LOCATION TABLE (SET BY INIT) EXT F.LO END OF ASSIGNMEXT TABLE+1 EXT F.LOP NO. LINES LEFT ON THIS PAGE. EXT F.LPR ( LOC OF EQUIVALENCE GROUP EXT F.LSF EXPECT FIRST STATEMEXTS FLAG EXT F.LSN F.A OF LAST STATEMEXT NUMBER EXT F.LSP LAST OPERATION FLAG EXT F.MFL TYPE STMT. MODE FLAG EXT F.NC NAME CHANGE FLAG. EXT F.NCR NO CROSS REF FLAG EXT F.ND NUMBER OF DIMENSIONS EXT F.NEQ # OF EQUIVALENCE GROUPS EXT F.NT NAME TAG 0= VAR, 1=CONSTANT. EXT F.NTF NAME TAG FLAG EXT F.NW NO. WORDS THIS TABLE F.A EXTRY. EXT F.NXN NO INPUT FLAG EXT F.OFE DATA POOL OVERFLOW ERROR EXTRY. EXT F.OPF OUTPUT PACK FLAG EXT F.R JSB ERR0 FLAG EXT F.PAK PACK BUFFER WORD ENT F.PAP PAUSE STMT. PROCESSOR EXT F.RDP READ STATEMEXT PROCESSOR ENT F.REL SUB. PROG. RETURN LOCATION EXT F.RPL PROGRAM LOCATION COUNTER EXT F.RPR ) LOC OF EQUIVALENCE GROUP ENT F.RTN RETURN STMT. PROCESSOR ENT F.RWP REWIND STMT. PROCESSOR EXT F.S02 RETURN FORM RCOM F.1 EXT F.S03 LOAD F.1 AND PASS CONTROL EXT F.S1B BOTTOM OF STACK 1 EXT F.S1T TOP OF STACK 1 EXT F.S2B BOTTOM OF STACK 2 EXT F.S2T TOP OF STACK 2 EXT F.SBF 0= MAIN, ELSE SUBROUTINE EXT F.SCC SAVE F.CC EXT F.SEE RETURN FROM F4.1 EXT F.SEG LOAD A NEW SEGMENT EXT F.SFF SUBROUTINE/FUNCTION FLAG 0/1 EXT F.SFP STATEMEXT FUNCTION PROCESSOR EXT F.SID STATEMEXT ID PHASE FLAG EXT F.SLF STATEMEXT LEVEL FLAG EXT F.SPF SPECIFICATION FLAG SET TO CURREXT STMT. LEVEL EXT F.SPS STATEMEXT PROCESSOR SWITCH EXT F.SRL SAVE RPL AT BEGINNING OF RECORD EXT F.STA FLAG THAT IS ZERO UNTIL THE FTN STATEMEXT IS READ EXT F.STB STRING BACK JUMP FLAG ENT F.STP STOP STMT. PROCESSOR EXT F.STS TO STATEMEXT SCAN EXT F.SVL SAVE # WORDS ON OPER STACK (F.L) EXT F.SXF COMPLEX CONSTANT FLAG  EXT F.T # WORDS ON STACK 1 EXT F.TAC ? EXT F.TC NEXT CHARACTER EXT F.TIM TIME ARRAY ADDRESS IN HEAD EXT F.TRM TERMINATE COMPILE EXT F.TYP TYPE STATEMEXT FLAG EXT F.WRP WRITE STATEMEXT PROCESSOR EXT F.X1 F.A OF F.D1 EXT F.X2 F.A OF F.D2 EXT F.X3 F.A OF F.D3 * * EXT'S WITH A TRAILING '.F' ARE SUBROUTINES * EXT AA.F ASSIGN ADDRESS SUB. EXT AI.F ASSIGN ITEM EXT ASC.F CONVERT TO 4 ASCII DIGITS EXT BNI.F CLEAR NID TO BLANKS EXT BOM.F DISASTOR ERROR REPORT (NO RETURN) EXT CID.F CLEAR F.ID ARRAY EXT CDI.F CLEAR IDI ROUTINE EXT CRP.F CROSS REF PAIR SUB. EXT CRT.F TEST FOR CARRAGE RETURN EXT DAF.F DEFINE (F.AF) EXT DAT.F DEFINE (AT) EXT DIM.F DEFIND (F.IM) EXT DIU.F DEFINE (F.IU) EXT DL.F DEFINE LOCATION SUBROUTINE EXT EJP.F PAGE EJECT SUBROUTINE EXT ER.F ERROR PRINT SUBROUTINE EXT ESC.F ESTABLISH CONSTANT SUBROUTINE EXT ESD.F ESTABLISH DEF SUBROUTINE EXT EXN.F EXAMINE NEXT CHARACTER EXT FA.F FETCH ASSIGNS EXT FID.F FETCH (ID) TO NID (UNPACK) EXT FNS.F FIRST NOT SPEC. STMEXT CHECK EXT FXC.F CHECK IF SUB. IN FIX-EXT TABLE EXT GNA.F GET NEXT SYMBOL TABLE EXTRY EXT GPE.F GENERATE SUB. PROG. EXTRANCE EXT IA.F INPUT (A) CHARACTERS SUBROUTINE EXT IC.F GET NEXT CHARACTER EXT ICH.F GET NEXT NON BLANK CHAR. AND TYPE IT EXT IDN.F INPUT DO NOT ASSIGN (GET NEXT OPERAND) EXT IDS.F INPUT DIGIT STRING EXT IFT.F IF GOTO COMPLETION EXT II.F INPUT ITEM EXT IIV.F INPUT INTEGER VARABLE EXT IN2.F INIT FOR OA.F MODULE ENT IN3.F INIT FOR ENX.F MODULE EXT IN4.F INIT FOR FA.F MODULE EXT IN5.F INIT FOR EX.F MODULE EXT IN6.F INIT FOR IC.F MODULE EXT IN7.F INIT FOR IDN.F MODULE EXT INM.F INPUT NAME EXT IOP.F INPUT OPERATOR EXT ISN.F INPUT STATEMEXT NUMBER EXT ISY.F INPUT SYMBOL EXT ITS.F INTEGER TEST EXT MCC.F RESET TO FIRST COLUMN OF STATEMEXT EXT MPN.F MOVE PROGRAM NAME (TO NAM RECORD ECT.) EXT NEW.F SUB TO CLEAR TEMPS FOR A NEW MODULE EXT NCT.F TEST FOR NOT A CONSTANT EXT NST.F TEST FOR NOT A SUBROUTINE NAME EXT NTI.F MOVE NID TO F.IDI (PACKS) EXT NWI.F SET F.D0 TO # WORDS IN ARRAY EXT OA.F OUTPUT ASSIGNMEXT TABLE OPERAND EXT OAI.F OUTPUT ABS. INSTRUCTION EXT OC.F OUTPUT CONSTANT EXT ODF.F OUTPUT DOT FUNCTION EXT OLR.F OUTPUT LOAD ADDRESS EXT OMR.F OUTPUT MEMORY REF. INSTRUCTION EXT OS.F OUTPUT SECTOR TO INTERPASS FILE EXT OW.F OUTPUT WORD EXT OZ.F OUTPUT ZREL (OP *+N) EXT PAK.F PACK SUBROUTINE EXT PDF.F PRODUCE DEF SUBROUTINE EXT PSL.F PRINT LINE ON PRINTER ENT PTM.F PROGRAM TERMINATION CODE GEN. ENT RTN.F SUBROUTINE RETURN HANDLER EXT RP.F INPUT ')' EXT SCC.F SAVE F.CC SUBROUTINE EXT SCP.F SAVE CURREXT STATPMEXT POSITION. EXT SKL.F SKIP LINES ON LIST EXT SNC.F START NEXT CARD SUBROUTINE EXT SOA.F STORE AND OUTPUT (OA.F) EXT TDO.F DO TERMINATION CODE GENERATOR EXT TCT.F TEST (A) = F.TC ELSE ER 28 EXT TS.F TAG SUBPROGRAM SUB. EXT TV.F TAG VARIABLE EXT UC.F UNINPUT COLUMN EXT WAR.F ERROR COMMEXT SUBROUTINE (WARNINGS) * * CONTARY TO THE NOTION THAT THIS ROUTINE DOES NOT * DO EXPRESSIONS WE MUST INVOKE THE EXPRESSION ANALIZER * EXT MAP.F PRODUCE EMAP CALL IF NEEDED * * LIBRARY EXTERNALS * * A pEQU 0 B EQU 1 .TBL EQU 0 FEDP EQU 0 SUP IN3.F NOP INIT SUB JMP IN3.F,I RETURN SKP SPC 2 * ************************ * * PAUSE-STOP PROCESSOR * * ************************ SPC 1 F.PAP LDB .PAUS JMP PAST2 SPC 1 F.STP LDB .STOP CLA CPA F.LFF PART OF A LOGICAL "IF"? STA F.LSP NO, RESET LAST OPERATION FLAG. PAST2 STB T2PAS CLAI CLA STA T3PAS # OF OCTAL DIGITS STA F.IDI BINARY OCTAL DIGIT STRING PAST3 JSB ICH.F INPUT CHAR. SZB JMP PAST4 NON-DIGIT ADA BM70 SSA,RSS JMP PAST9 DIGIT .GT. 7 ADA K8 LDB F.IDI BLF,RBR IOR B STA F.IDI F.IDI=F.IDI+F.TC (BINARIZED) ISZ T3PAS # OF OCTAL DIGITS JMP PAST3 * PAST9 LDA K21. JSB WAR.F INVALID OCTAL DIGITS JSB CDI.F INI=0 PAST4 LDA K69 LDB T3PAS ADB KM5 SSB,RSS JSB WAR.F ERROR: MORE THAN 4 DIGITS. JSB AUN.F ASSIGN UNIT NO. LDB T2PAS LOC. OF '.PAUS' OR '.STOP' JSB ODF.F OUTPUT DOT FUNCTION JMP ILTRM * T2PAS NOP T3PAS NOP # OF OCTAL DIGITS .PAUS DEF .TBL+37 PAUSE .STOP DEF .TBL+38 STOP K21. DEC 21 K69 DEC 69 BM70 OCT -70 KM5 DEC -5 K8 DEC 8 SKP * ********************** * * ASSIGN UNIT NUMBER * * ********************** SPC 1 AUN.F NOP FROM PAUSE-STOP PROC. LDA F.IDI SZA,RSS NUMBER SPECIFIED? JMP AUN04 NO. LDA INT JSB ESC.F ESTABLISH CONSTANT JSB AI.F ASSIGN ITEM LDA LDA.. 'LDA' JSB OA.F OUTPUT 'LDA F.A' JMP AUN.F,I SPC 1 AUN04 LDA CLAI JSB OAI.F OUTPUT 'CLA' JMP AUN.F,I SPC 2 * ******************************* * * END FILE, BACKSPACE, REWIND * * ******************************* SPC 1 F.EFP LDA K64 X=1 FOR END-FILE. JMP EBR02 SPC 1 F.BSP LDA O200 X=2 FOR BACK-SPACE JMP EBR02 SPC 1 F.RWP LDA O400 X=4 FOR REWIND EBR02 STA T1EBR SAVE X JSB IOP.F INPUT OPERAND JSB TV.F TAG VARIABLE JSB ITS.F INTEGER TEST JSB MAP.F IF VARABLE IS IN EMA MAP IT IN STA F.A SET ADDRESS LDA LDA.. JSB OA.F 'LDA F.A' LDA T1EBR (X) ADA LOG +3.F.FB STA F.IDI F.IDI=30XYY LDA INT JSB ESC.F ESTABLISH CONSTANT JSB AI.F ASSIGN ITEM LDA ADAI. JSB OA.F 'ADA F.A' LDB .TAPE LOC. OF '.TAPE' JSB ODF.F OUTPUT DOT FUNCTION JMP CRT.F C/R TEST * * * T1EBR NOP .TAPE DEF .TBL+39 FOR REWIND,BACKSPACE,OR END FILE O200 OCT 200 O400 OCT 400 ADAI. OCT 42000 LDA.. OCT 62000 INT OCT 10000 F.IM=INTEGER K64 DEC 64 SKP * ******************** * * FORMAT PROCESSOR * * ******************** SPC 1 F.FMT LDB F.LFF LDA K88 88 CCE,SZB TRUE BRANCH OF LOGICAL "IF"? JSB ER.F YES. BITCH. * LDA F.LSN GET STMT. NO. F.A LDB K2 SZA IF NO STMT. NO. DONOT OUTPUT STB F.OPF SET OUTPUT FLAG LDB F.RPL SAVE CURRENT LOCATION STB T1FMT IN TEMP RAL,ERA SET UP ORG TO AST CLB STB RTN.F ZAP THE '(' LEVEL COUNT JSB OW.F SET LOAD ADDRESS OCT 20000 R=1 JSB ICH.F INPUT CHARACTER CPA B50 '(' JMP FMTP2 * LDA K79 JSB WAR.F FORMAT NOT START WITH '(' FMTP2 JSB CID.F CLEAR F.ID TO 0 JSB IDS.F INPUT DIGIT STRING STB COUNT SAVE POSSIBLE HOLLERITH COUNT LDB F.TC GET NEXT CHARACTER CPB B110. 'H' JMP FMTP9 YES * CPbB B42 '"'? JMP FMTP6 * CPB B15 C/R JMP FMTP1 YES ERROR * LDA RTN.F GET CURRENT '(' COUNT CPB B50 THIS A '('? INA YES CPB B51 A ')'? ADA KM1 YES STA RTN.F SAVE NEW COUNT SSA,RSS IF NEGATIVE THEN WE FOUND THE MATCH TO THE FIRST ONE JMP FMTP2 NOPE CONTINUE * JSB ICH.F SHOULD TRANSFER THE C/R JMP FMTP7 GO WRAP IT UP (CRT.F WILL CATCH IT IF NOT A CR) * FMTP1 LDA K80 CR BEFORE MATCHING ')' FMTP3 JSB WAR.F FORMAT NOT ENDED BY ')' FMTP7 CLB SET OK EXIT FMTP8 CLA STA F.OPF RESET OUTPUT FLAG LDA F.RPL COMPUTE THE NEGATIVE CMA,INA ADA T1FMT SIZE OF THE STRING STB COUNT ERROR FLAG TO COUNT LDB F.LSN RESET INB THE F.AF OF THE STMT. NO STA B,I TO THE (-SIZE) OF THE STRING LDA T1FMT SET STA F.RPL THE LOCATION COUNTER BACK JSB OLR.F SET FOR FUNNY FILE TOO ISZ COUNT IF NO ERROR EXIT JMP CRT.F TO 'C/R' TEST & STERM * LDA K20. SENT EMPTY DIGIT STING JSB ER.F ERROR (NO RETURN) SPC 1 FMTP6 JSB IC.F PASS QUOTE STRING JSB PAK.F TO OUTPUT FILE CPA B15 IF END OF LINE BEFORE CLOSE QUOTE JMP FMTP3 ERR 13: HOLLERTH STRING TERMINATED CPA B42 CLOSE QUOTE? JMP FMTP2 YES GET NEXT ELEMENT JMP FMTP6 NO DO NEXT CHARACTER * FMTP9 LDB COUNT BEGIN "NH" STRING. CMB,INB,SZB IF NO NUMBER SKIP JMP FMTP4 COUNT NON-0 * CCB SET DEFAULT COUNT FOR ONE CHAR. SZA IF DIGITS THEN JMP FMTP8 ERROR SET FLAG AND WRAPUP * * FMTP4 STB COUNT PASS COUNT CHARACTERS TO OUTPUT FMTP5 JSB IC.F GET ONE JSB PAK.F PASS IT CPA B15 IF END OF STATEMENT THEN JMP FMTP3 REPORT ERROR: * ISZ COUNT STEP COUNT DONE? JMP FMTP5 NO PASS THE NEXT CHAR. JMP FMTP2 YES GET THE NEXT ELEMENT * COUNT NOP COUNT FOR 'H' STRINGS T1FMT NOP B51 OCT 51 K7 DEC 7 B42 OCT 42 " B110. OCT 110 H K20. DEC 20 K80 DEC 80 K88 DEC 88 K2 DEC 2 B50 OCT 50 KM1 DEC -1 B15 OCT 15 B377 OCT 377 SPC 1 * ******************** * * RETURN PROCESSOR * * ******************** SPC 1 F.RTN JSB ICH.F INPUT A CHAR. LDB F.SBF SUBPROGRAM FLAG SET? STB F.A SZB,RSS JMP RTNP7 NO, RETURN IN MAIN PROGRAM JSB RTN.F RETURN HANDLER JMP RTNP1 SPC 1 RTNP7 JSB PTM.F PROGRAM TERMINATION EXEC CALL LDA K7 JSB WAR.F RTNP1 LDA F.LFF LOG IF FLAG SET? SZA,RSS STA F.LSP NO. RESET LAST OPERATION FLAG ILTRM CLA,INA SET LAST STA F.LSF STATEMENT FLAG (ILLEGAL DO TERM) JMP CRT.F TEST FOR END OF LINE SKP ****** RETURN HANDLER SPC 1 RTN.F NOP LDA F.SFF CMA,INA,SZA,RSS JMP RTNP8 SUBROUTINE. INA,SZA,RSS FUNCTION; F.SFF=1? JMP RTNP4 YES, 1ST RETURN IN FUNCTION LDA JMP. 'JMP' LDB F.SFF JSB OMR.F OUTPUT 'JMP F.SFF' JMP RTN.F,I SPC 1 RTNP4 LDA F.RPL STA F.SFF LDA F.SBF LDAAI LDA A,I AND ADDR =B70000 CPA INT JMP RTNP6 IM(F.SBF)=INT CPA LOG JMP RTNP6 IM(F.SBF)=LOG CPA REA JMP RTNP5 F.IM=REA JMP RTNP8 MUST BE DOUBLE OR COMPLEX (HANDLED BY DUM TRICK) SPC 1 RTNP5 LDB .DLD JSB ODF.F OUTPUT 'JSB .DLD' RTNP2 LDB F.SBF STB F.A CLA,RSS OUTPUT 'DEF F.A' RTNP6 LDA LDA.. 'LDA' JSB OA.F OUTPUT OA RTNP8 LDA IJMP. 'JMP,I' LDB F.REL RETURN 'NOP' LOC. JSB OMR.F 'JMP F.REL,I' JM BP RTN.F,I * F.REL NOP SUBPROG RETURN LOCATION .DLD DEF .TBL+7 DOUBLE LOAD .DFER DEF .TBL+24 DOUBLE PRECISION TRANSFER .CFER DEF .TBL+25 COMPLEX TRANSFER K79 DEC 79 O K89 DEC 89 O124 OCT 124 T IJMP. OCT 126000 JMP. OCT 26000 ADDR OCT 70000 LOG OCT 30000 F.IM=LOGICAL REA OCT 20000 F.IM= REAL DBL OCT 60000 F.IM=DOUBLE * * * *********************************** * * PROGRAM TERMINATION EXEC CALL * * *********************************** SPC 1 PTM.F NOP LDB ENDK1 ADB F..DP ADJUST FOR TABLE LOCATION LDA JSBI 'JSB' JSB SOA.F OUTPUT 'JSB .EXEC' CLA LDB K2 JSB OZ.F OUTPUT 'DEF *+2' LDA K6. 6 STA F.IDI LDA INT JSB ESC.F ESTABLISH CONSTANT JSB AI.F ASSIGN 6 TO DATA POOL CLA JSB OA.F 'DEF =6' JMP PTM.F,I * K6. DEC 6 JSBI OCT 16000 ENDK1 DEF FEDP+246B 'F.A OF EXEC' SKP * ********************** * * CONTINUE PROCESSOR * * ********************** SPC 1 F.CON LDA F.LSP LAST OPERATION FLAG ADA F.LSN LAST STATEMENT NUMBER FLAG STA F.LSP F.LSP=F.LSP+F.LSN CLA STA F.LSF JSB ICH.F INPUT THE NEXT CHARACTER. LDB F.LFF LDA K89 89 SZB TRUE BRANCH OF LOGICAL "IF"? JSB WAR.F YES, COMMENT ON EFFECTIVE "NOP". JMP CRT.F C/R TEST SPC 2 * ******************** * * ASSIGN PROCESSOR * * ******************** SPC 1 F.ASP JSB ISN.F INPUT STATEMENT NUMBER ISZ F.CC CLA 'DEF' LDB F.A SET UP JSB ESD.F THE DEF ENTRY IN THE SYMBOL TABLE LDA F.A SAVE A.T. POINTER FOR LATER STA T0STF IN CASE $EMAP CALL LDA O124 'T' JSB TCT.F F.TC-TEST JSB ICH.F INPUT CHARACTER LDA B@ EMA, 0 => NOT EMA * * MASTER OR LABEL ENTRY FOR LABELED COMMON * OR SUBPROGRAM NAME ENTRY * * !---!---------!---------!----------!----------!---------! * NAME CHARACTERS 5 AND 6 (IF NEEDED) * !---!---------!---------!----------!----------!---------! * NAME CHARACTERS 3 AND 4 (IF NEEDED) * !---!---------!---------!----------!----------!---------! * NAME CHARACTERS 1 AND 2 (ALWAYS) * !---!---------!---------!----------!----------!---------! * AF=0 OR - EXT ID NUMBER OR REL ADDRESS OF STMT. FUNCTION * (AT=REL) OR ADDRESS OF DEF IF DUMMY (AT=DUM) * !---!---------!---------!----------!----------!---------! * !NT ! IM ! AT ! IU ! ! E !M NW ! * !---!---------!---------!------!------!---!---!---------! * !15 !14 13 12!11 10 9! 8 7 6 ! 5 4 3 ! 2 1 0! * !---!---------!---------!---------!-----------!---------! * * NT=0 IU=SUB AT=BCOMI,STR-ABS,REL,DUM IM=INT,REA,LOG,CPX,DBL * * STATEMENT NUMBERS * * !---!---------!---------!----------!----------!---------! * 4TH AND 5TH DIGIT (IN ASCII) (IF NEEDED) * !---!---------!---------!----------!----------!---------! * !---!---------!---------!----------!----------!---------! * "@" AND 1ST DIGIT (IN ASCII) (ALWAYS) * !---!---------!---------!----------!----------!---------! * AF= PROGRAM ADDRESS OF STATEMENT (AT=REL) * POINTER TO THIS ENTRY IF UNDEFINED (AT=STR-ABS) * !---!---------!---------!----------!----------!---------! * !NT ! IM ! AT ! IU ! ! E ! NW ! * !---!---------!---------!------!------!---!---!---------! * !15 !14 13 12!11 10 9! 8 7 6 ! 5 4 3 ! 2 1 0! * !---!---------!---------!---------!-----------!---------! * * NT=0 IM=0 AT=REL,STR-ABS IU=0 * * DEF POINTERS * * !---!---------!---------!----------!----------!---------! * IF SIGN SET THE REST IS ADDRESS OF TABEL ENTRY DEF IS TO * IF SIGN NOT SET THEN VALUE OF THE DEF (IN COM IF AT=COM ) * !---!---------!---------!----------!----------!---------! * AF= PROGRAM ADDRESS OF DEF * POINTER TO THIS ENTRY IF UNDEFINED * !---!---------!---------!----------!----------!---------! * !NT ! IM ! AT ! IU ! ! R! E ! NW ! * !---!---------!---------!------!------!---!---!---------! * !15 !14 13 12!11 10 9! 8 7 6 ! 5 4 3 ! 2 1 0! * !---!---------!---------!---------!-----------!---------! * * NT=1 IM=0 AT=REL,COM,STR-ABS IU=VAR R=1 IF DEFINED,ELSE 0 * * DEF POINTERS (EXTERNAL WITH OFFSET) * * !---!---------!---------!------Sr----!----------!---------! * POINTER TO ENTRY CONTAINING THE EXT NO. (USUALLY BCOMI) * !---!---------!---------!----------!----------!---------! * OFFSET TO BE ADDED TO THE EXTERNAL * !---!---------!---------!----------!----------!---------! * AF= PROGRAM ADDRESS OF DEF * !---!---------!---------!----------!----------!---------! * !NT ! IM ! AT ! IU ! !R ! E ! NW ! * !---!---------!---------!------!------!---!---!---------! * !15 !14 13 12!11 10 9! 8 7 6 ! 5 4 3 ! 2 1 0! * !---!---------!---------!---------!-----------!---------! * * NT=1 IM=0 AT=BCOMI IU=VAR R=1 IF DEFINED,ELSE 0 * * OBJECT CODE OR LOAD ADDRESS ENTRIES * * !---!---------!---------!----------!----------!---------! * AF=RELATIVE LOCATION IN THE PROGRAM OR 0 IF NOT DEFINED * !---!---------!---------!----------!----------!---------! * !NT ! IM ! AT ! IU ! ! E ! NW ! * !---!---------!---------!------!------!---!---!---------! * !15 !14 13 12!11 10 9! 8 7 6 ! 5 4 3 ! 2 1 0! * !---!---------!---------!---------!-----------!---------! * * NT=0 IM=TWPE AT= STR-ABS IU=0 * * CONSTANTS * * !---!---------!---------!----------!----------!---------! * VALUE OF THE CONSTANT (1 WORD FOR IM=INT,LOG * 2 FOR IM=REA ,3 FOR IM=DBL, 4 FOR IM= CPX * !---!---------!---------!----------!----------!---------! * AF= PROGRAM ADDRESS OF CONSTANT * !---!---------!---------!----------!----------!---------! * !NT ! IM ! AT ! IU ! ! E ! NW ! * !---!---------!---------!------!------!---!---!---------! * !15 !14 13 12!11 10 9! 8 7 6 ! 5 4 3 ! 2 1 0! * !---!---------!---------!---------!-----------!---------! * NT=1 IM=INT,REA,LOG,CPX,DBL AT=REL,STR-ABS IU=VAR/CON * * TEMPORARY VARABLES * * !---!---------!---------!----------%!----------!---------! * TEMP ID A NEGATIVE NUMBER WHICH IS ASSIGNED BY TYPE * MODE ID-RANGE * REA -2001 TO -2777 * LOG -3001 TO -3777 * OBJECT TMP -4001 TO -4777 * CPX -5001 TO -5777 * DBL -6001 TO -6777 * ADDR -7001 TO -7777 * !---!---------!---------!----------!----------!---------! * AF= ASSIGNED LOCATION OF THE TEMP OR IF IM=ADDR THEN * THE ITEM MODE OF THE ITEM BEING ADDRESSED BY THIS ADDRESS * !---!---------!---------!----------!----------!---------! * !NT ! IM ! AT ! IU ! NC ! R ! E ! NW ! * !---!---------!---------!------!------!---!---!---------! * !15 !14 13 12!11 10 9! 8 7 6 ! 5 4 3 ! 2 1 0! * !---!---------!---------!---------!-----------!---------! * NT=0 IM=INT,LOG,REA,DBL,CPX,ADDR AT=REL IU=VAR/CON * * FIX-EXT ENTRY * * !---!---------!---------!----------!----------!---------! * CHAR 5,6 OF SUB NAME (IF NEEDED) * !---!---------!---------!----------!----------!---------! * CHAR 3,4 OF SUB NAME (IF NEEDED) * !---!---------!---------!----------!----------!---------! * !---!---------!---------!----------!----------!---------! * A! CHAR 1 ! B! CHAR 2 OF NAME * !---!---------!---------!----------!----------!---------! * EXT ID NO. OR ZERO IF NOT USED * !---!---------!---------!----------!----------!---------! * !NT ! IM ! AT ! IU ! NC ! R ! E ! NW ! * !---!---------!---------!------!------!---!---!---------! * !15 !14 13 12!11 10 9! 8 7 6 ! 5 4 3 ! 2 1 0! * !---!---------!---------!---------!-----------!---------! * NT=0 IM=THE MODE OF THE SUB AT=STR-ABS IU=SUB * A=1 IF ORGIONAL NAME CAN NOT BE USED(NEED NAME CHANGE) * IT IS USED IN A FUNCTION OR SUB CALL * B=1 THIS ENTRY WAS REFERENCED IN A TYPE STATEMENT * SKP * ************'***** * * FETCH ASSIGNS * * ***************** SPC 1 FA.F NOP LDB F.A LDA B,I AND KK01 100000B STA F.NT F.NT=NT(F.A) LDA B,I AND KK02 70000B STA F.IM F.IM=IM(F.A) LDA B,I AND KK03 7000B STA F.AT F.AT=AT(F.A) LDA B,I AND B600 STA F.IU F.IU=IU(F.A) LDA B,I AND B140 STA F.NC F.NC=NC(F.A) LDA B,I AND K16 STA F.R F.R=R(F.A) LDA B,I AND K8 STA F..E F..E=E(F.A) LDA B,I AND K7 STA F.NW F.NW=NW(F.A) INB LDA B,I (A)=GF(F.A) STA X5 STA F.AF JSB NWE.F NO. OF WORDS FOR ASSIGNMNT ENTRY ADB KM2 STB F.D0 F.D0=NO. OF WDS FOR THIS ITEM MODE CLA CLEAR THE UPPER STA F.D0+1 HALF OF THE DOUBLE WORD LDA F.IU CPA ARR RSS JMP FA02 NON-ARRAY * LDB X5 (B)=ADDR OF SUBSCRIPT INFO ENTRY LDA B,I AND K16 STA F.R F.R=R(X5) LDA B,I AND KK02 70000 ALF STA F.ND F.ND=IM(X5), (# OF DIMENSIONS) CMA,INA STA T5FA ADB K2 LDA B,I STA F.DAY POINTS TO BASE ADDR OF ARRAY INB CLA STA F.D2 INITIALIZE DIMENSIONS 2 & 3 TO 0 STA F.D3 LDA B COPY ASSIGN TBL POINTERS FOR LDB K1FA F.D1, F.D2, F.D3 STB T3FA JSB .MVW TO F.X1, F.X2, F.X3 DEF K3 NOP LDA K2FA D TABLE ADDR STA T4FA FA06 LDB T3FA,I LDA B,I ADB K2 SET FOR RIGHT ENTRY AND KK03 =B7000 ISOLATE AT FIELD CPA DUM DUMMY VARIABLE CLA,RSS YES USE ZERO LDA B,I NO USE ID(XJ) STA T4FA,I DJ= 0 (IF DUM) OR ID(XJ) ISZ T4FA BUMP D TABLE POINTER ISZ T3FA BUMP X TABLE POIhTRNNTER ISZ T5FA NO. OF DIM EXHAUSTED? JMP FA06 NO LDB X5 INB LDA B,I (A)=GF(X5) STA F.AF FA02 LDA F.AF (A)=F.AF JMP FA.F,I * F..E BSS 1 ARR OCT 600 IU=3 DUM OCT 5000 AT=5 TWPE OCT 40000 SUB OCT 200 IU=1 REL OCT 1000 AT=1 X5 BSS 1 ASSIGN TABLE POINTER FOR ARRAY . K1FA DEF F.X1 START LOC OF X-TABLE K2FA DEF F.D1 START LOC OF D-TABLE TT3FA BSS 1 X-TABLE POINTER T4FA BSS 1 D-TABLE POINTER T5FA BSS 1 KK03 OCT 7000 TO ENTRACT AT FIELD K16 DEC 16 K8 DEC 8 KM2 DEC -2 F.DAY NOP BASE ADDRESS OF ARRAY F.IM NOP ITEM MODE: REAL, CPX, INT, ETC. F.IU NOP ITEM USAGE: DUMMY, RELATIVE, ETC. F.NC NOP NAME CHANGE FLAG F.ND NOP # OF DIMENSIONS F.NT NOP NAME TAG: 0 IF VAR, 1 IF CONST F.NW NOP # WORDS IN ASSIGN TABLE ENTRY F.AT NOP ADDRESS TYPE F.AF NOP ADDRESS FIELD F.R NOP "JSB ERR0" FLAG F.D0 NOP WORDS/ARRAY ELEMENT NOP F.D0 IS A DOUBLE WORD F.D1 NOP DIMENSION 1 F.D2 NOP F.D3 NOP F.X1 NOP F.X2 NOP F.X3 NOP SKP * ******************* * * MOVE NID TO F.IDI * * ******************* SPC 1 NTI.F NOP LDA NID ALF,ALF IOR NID+1 STA F.IDI LDA NID+2 ALF,ALF IOR NID+3 STA F.IDI+1 LDA NID+4 ALF,ALF IOR NID+5 STA F.IDI+2 JMP NTI.F,I SPC 2 NID BSS 6 F.DNI DEF NID * * SPC 2 * *********************** * * CLEAR NID TO BLANKS * * *********************** SPC 1 BNI.F NOP LDA B40 STA NID STA NID+1 STA NID+2 STA NID+3 STA NID+4 STA NID+5 JMP BNI.F,I * SKP * *************** * * ASSIGN ITEM * * *************** SPC 1 AI.F NOP CLA STA TSUBF RESET SUBPROG FLAG STA AF12 LDA F.NT IS ITEM A NAME? SZA,RSS JSB NTI.F YES, F.IDI=NID LDA F.IM IS IT A 2-WORD STRING-BACK ENTRY? CPA TWPE =B40000 JMP AI24 YES * CLA CLEAR THE FIX/EXT SWITCH STA FIXSW TO SHOW IN FIX/EXT PART OF TABLE LDB F.IDI GET THE FIRST |ID WORD LDA F.NT SET E CMA,CLE,INA IF ITEM IS NAMED LDA F..DP GET ORGION OF TABLE SEZ,RSS IF NOT A NAMED ITEM JMP AI150 DON'T BOTHER WITH FIX-EXT ENTRIES * INA SKIP THE FIRST DUMMY ENTRY AI00 STA F.A SET TENATIVE ADDRESS ADA K2 INDEX TO THE ID WORD (IT MAY NOT EXIST BUT LDA A,I GET THE ID WORK BE PATIENT IT WORKS AND KK47 THIS CODE SCANS ONLY THE FIX-EXT CPA B DO ID'S MATCH IN FIRST WORD? JMP AI04 YES GO CHECK THE REST * AI021 LDA F.A,I REJECT THE ENTRY AND K7 INDEX TO THE NEXT ONE ADA F.A HAVE ITS ADDRESS CPA F.DP IF END OF FIX-EXT JMP AI151 GO SET THE SWITCH * JMP AI00 NO GO TEST THIS ENTRY * AI150 LDA F.DP ENTRY TO SCAN ONLY USER TABLE AI151 ISZ FIXSW SET SWITCH TO SHOW IN USER TABLE AI15 STA F.A NOW SCAN THE USER TABLE ADA K2 I KNOW IT CAN BE SHORTER CPB A,I BUT 50% OF THE COMPILE IS SPENT HERE JMP AI03 SO MAKE IT FASTER! * AI022 LDA F.A,I GET TO THE NEXT AND K7 ENTRY ADA F.A CPA F.S2B END OF TABLE? JMP AI120 YES GO SET UP NEW SYMBOL * JMP AI15 NO TRY NEXT ONE * AI02 LDB F.IDI RESTORE B IN CASE LDA FIXSW WHICH TABLE? SZA WELL? JMP AI022 THE USERS * JMP AI021 OURS * AI120 STA F.A SET ADDRESS FOR NEW ENTRY JMP AI12 AND GO SET IT UP * F.DP NOP ADDRESS OF USER A.T. K7 DEC 7 KM3 DEC -3 KK47 OCT 77577 KK01 DEF 0,I K2 DEC 2 F.S2B NOP END OF A.T. F.A NOP A.T. CURRENT ADDRESS FIXSW NOP * * AI04 LDB F.A GET THE ADDRESS OF THE ID ADB K2 AGAIN XOR B,I GET THE FLAG BITS CPA KK01 =B100000 IF RENAMED REJECT THE ENTRY JMP AI02 TRY THE NEXT ENTRY * ݎ STA AF12 SET THE FLAG BITS FOR LATER AI03 LDA F.A,I THE ID WORD 1 MATCHES XOR F.NT MAKE SURE WE ARE LOOKING SSA AT THE RIGHT TYPE ENTRY JMP AI02 NOPE, A FLUKE REJECT IT * LDA F.A,I GET THE SYMBOL AND K7 SIZE ADA KM3 SUBTRACT 3 CMA,SSA,RSS DID IT HAVE AN ID 1?? JMP AI02 NO! REJECT IT * STA F.NW SET COUNT FOR REST OF MATCH LDB F.A INDEX ADB K3 TO THE ID WORD 2 LDA F.DID GET THE ADDRESS OF WHAT WE WANT STA T1AI SET FOR LOOP JMP AI17 GO TEST THE REST OF THE SYMBOL * AI05 LDA B,I CPA T1AI,I MATCH?? INB,RSS YEP, STEP B TO NENT WORD OF TABLE JMP AI02 ID FIELD NOT MATCHED REJECT THE ENTRY AI17 ISZ T1AI ISZ F.NW FULL IF MATCHED? JMP AI05 NO TRY THE NENT WORD LDA F.NT YES SZA,RSS IS ITEM A CONSTANT? JMP AI28 NO. LDA F.A,I YES DO THE CONSTANT THING AND KK02 =B70000 ISOLATE THE F.IM FIELD XOR F.IM SZA JMP AI02 IF F.IM .NE. IM(F.A) REJECT WRONG TYPE CONSTANT LDA F.A,I AND IUMSK (A)=IU(F.A) CPA F.IU SZA,RSS JMP AI02 F.IU .NE. IU(F.A), OR = BUT F.IU=0 AI06 JSB FA.F FETCH ASSIGN LDA TSUBF SUBPROG FLAG SET? SZA JMP AI10 YES LDA F.NTF NO TAG FLAG SET? SZA JMP AI08 YES, DO NOT TAG ITEM LDA F.IU F.IU FLAGGED? SZA JMP AI09 YES. CHECK FOR DUMMY ITEM LDA F.SPF CURRENT STATEMENT LEVEL CPA K4 RSS EXECUTABLE STATEMENT JMP AI01 NO * LDA F.AT YES CPA DUM JMP AI07 F.AT=DUM * AI01 LDA F.SPF SPEC STATEMENT? SZA (YES IF LEVEL 0 OR 1) CPA K1 SPECIFICATION STATEMENT? JMP AI08 YES * AI07 LDA mF.TC F.TC=( ? CPA B50 JMP AI13 YES, SUBPROGRAM JSB TV.F NO, TAG VARIABLE AI08 CLB STB F.NTF RESET NO TAG FLAG STB F.AT. RESET SUBSCRIPT INFORMATION LDA F.IM F.IM FROM FA.F JMP AI.F,I SPC 1 AI09 CPA ARR JMP AI08 DO NOT RE-TYPE DUMMY ARRAY CPA SUB JMP AI08 DO NOT RE-TYPE DUMMY SUBPROG LDA F.AT CPA REL F.AT=REL? JMP AI08 YES LDA F.IM CPA TWPE F.IM=4? JMP AI08 YES, STRINGBACK LDA F.IDI SSA JMP AI08 TEMP CELL JMP AI01 TAG ITEM AS 'SUB' IF F.TC=( SPC 1 AI13 LDA F.DCF DIM,COM,EQV FLAG SET? SZA,RSS AI10 JSB TS.F NO. TAG SUBPROGRAM JMP AI08 SPC 1 AI12 LDA F.AT. HERE ON END OF TABLE CPA DIM. =B6000 JMP AI26 SUBSCRIPT INFORMATION LDA F.NT IS IT A NAME? SZA,RSS JMP AI40 YES. GET SYMBOL SIZE JSB NWE.F CONSTANT; GET NO. OF WORDS JMP AI14 SPC 1 AI24 LDA F.S2B STA F.A F.A=NENT ASSIGNMENT ENTRY LOC. LDB K2 2 WORDS FOR THIS STRING-BACK ITM JMP AI14 SPC 1 AI26 LDB F.IM NO. OF SUBSCRIPTS BLF ADB K3 JMP AI14 SPC 1 STRAB OCT 2000 F.AT=2 (STR-ABS) UNDEFINED DIM. OCT 6000 F.AT=6 (DIMENSION INFORMATION ENTRY) SPC 1 AI40 CLB,INB COMPUTE THE SYMBOL LENGTH IN WORDS LDA TWOBS TWO BLANKS TO A CPA F.IDI+1 IF ONE WORD JMP AI44 DONE SO JUMP * CPA F.IDI+2 TWO OR THREE WORDS? INB,RSS TWO SKIP ADB K2 THREE AI44 ADB K2 (B)=NO. OF WORDS FOR ASSI ENTRY AI14 STB F.NW NO. OF WORDS IN THIS ENTRY LDA IUMSK IF SPECIAL DEF OFFSET ENTRY CPA B7600 MAY NEED ONE MORE WORD LDA F.AT. WELL? CPA BCOMI ??? ISZ F.NW YES STEP THE COUNT n LDA F.LO ADA F.NW STA F.LO STA F.S2B BEGIN ADDR OF OPERATOR STACK LDA F.S2T STA J ADA B STA F.S2T LAST WORD LOC OF OPERATOR STACK LDA F.L CMA,INA ADA B SSA LDB F.L CMB,INB STB T3AI -(# OF WDS TO BE MOVED) LDA F.S1T END OF OPERAND STACK LDB F.SPF SPECIFICATION LEVEL? SZB CPB K1 LDA F.E YES, (A)=END OF EQUIVALENCE TBLE CMA,INA ADA F.S2T SSA,RSS JMP F.OFE DATA POOL OVERFLOW AI16 LDA J MOVE WORDS LDB A,I ADA F.NW STB A,I (J+NW)=(J) CCA ADA J STA J J=J-1 ISZ T3AI JMP AI16 LDB F.A LDA F.IU . AF=0 IF F.IU=SUBPROG CPA SUB . ELSE AF=F.A CLB STB F.AF .. LDA F.AT. CPA DIM. =B6000 RSS LDA STRAB . STA F.AT ADDRESS TYPE IOR F.NT NAME TAG IOR F.IM ITEM MODE IOR F.IU ITEM USAGE IOR F.EFG E FLAG IOR F.NW NO. OF WORDS IN THIS ASSI ENTRY LDB F.A GET THE ADDRESS TO B STA B,I 1ST WORD IN ASSIGNMENT ENTRY INB LDA F.AF ADDRESS FIELD STA B,I 2ND WORD IN ASSIGNMENT ENTRY INB LDA F.AT IF A DIMENSION CPA DIM. ENTRY SKIP INB A WORD (USED FOR ARRAY BASE ADDRESS) LDA F.DID 1ST WORD LOC OF F.IDI STA T1AI AI20 CPB F.LO ALL SET? JMP AI22 YES GO FINISH * LDA T1AI,I GET THE NENT ID WORD STA B,I SET IT IN THE TABLE INB STEP THE ADDRESSES ISZ T1AI JMP AI20 AROUND WE GO MOVE ID INTO THE ASS. TBL. * AI22 CLA STA F.EFG RESET E-FLAG JMP AI06 SPC 1 AI27 LDA T1AI,I CPA TWOBS 2 BLANKS? JMP AI30 YES JMP AI02 NO * 5F.LCM NOP SET NON-ZERO FOR SYMBOLS IN LABELED COMMON F.NTF NOP NON ZERO IF NOT TO BE TAGGED AS NAME TWOBS ASC 1, J BSS 1 TEMP INDEX K4 DEC 4 B50 OCT 50 K3 DEC 3 B40 OCT 40 K64 DEC 64 T1AI BSS 1 TEMP CELL T2AI BSS 1 TEMP CELL T3AI BSS 1 T4AI NOP F.A T5AI NOP F.A+1 T6AI NOP F.A+2 F.EXF NOP ENT FLAG AIK1 DEF F.IDI+1 AIK2 DEF F.IDI+2 SPC 1 AI28 LDA T1AI ITEM NOT CONSTANT. CPA AIK1 JMP AI27 CPA AIK2 JMP AI27 AI30 LDA FIXSW IS IT IN FIX ENTERNAL TABLE? SZA JMP AI06 NO LDB F.A STB T4AI F.A INB STB T5AI F.A+1 INB STB T6AI F.A+2 LDB F.DCF DIM, COM FLAG SET? SZB JMP AI33 YES, ASSIGN TO DATA POOL LDB F.EQF IN EQUIV GROUP? SSB,RSS JMP AI33 YES LDA F.TYP SZA TYPE STATEMENT? JMP AI36 YES. LDA F.TC F.TC=( CPA B50 JMP AI38 LDA T4AI,I AND K8 (A)=E(F.A) LDB T5AI,I (B)=AF(F.A) SZB JMP AI48 CPB F.EXF ENT FLAG SET? RSS JMP AI32 YES. SET E(F.A). CCE,SZA JMP AI34 E(F.A) .NE. 0 AI31 LDA T6AI,I AND KK47 =B77577 RAL,ERA SET SIGN STA T6AI,I SET AF12(F.A)=2 JMP AI02 SPC 1 AI48 SZA JMP AI34 E(F.A)=1 JMP AI02 E(F.A)=0 SPC 1 AI33 LDA T6AI,I AND KK46 =B100200 CPA SUB AF12=B200? JMP AI39 YES, APPEAR IN TYPE JMP AI35 SPC 1 AI39 LDA T4AI,I AND KK02 GET F.IM FIELD STA F.IM AI35 LDA T4AI,I AND K8 (A)=E(F.A) CCE,SZA,RSS JMP AI31 LDA K25 ERR 25: SUBPROG NAME USED WHERE JSB ER.F VAR OR CONST EXPECTED. SPC 1 AI32 LDA K8 IOR T4GAI,I STA T4AI,I SET E(F.A)=1 AI34 LDA AF12 AF12(F.A)=0 ? SSA JMP AI02 NO. LDA T4AI,I AND B140 (A)=NC(F.A) CPA B40 LDA B44 $ CPA K64 LDA B43 # CPA B140 LDA B45 % SZA,RSS JMP AI06 NO NAME CHANGE NEEDED * LDB NWET1 GET DOUBLE 3/4 WORD FLAG CPB K2 IF 3 WORD DOUBLE JMP AI345 ALL IS OK * CPA B44 IF NOT THEN LDA "/" CHANGE $ -> / AI345 STA NID CHANGE 1ST CHAR OF NAME ACCORDINGLY JSB NTI.F MOVE NID TO F.IDI JMP AI37 CONTINUE SEARCH WITH NEW NAME * B43 OCT 43 B44 OCT 44 B45 OCT 45 B140 OCT 140 "/" OCT 57 SPC 1 AI36 LDA T6AI,I AND KK47 =B77577 IOR SUB STA T6AI,I LDA T4AI,I AND KK02 ITEM MODE FIELD CPA F.MFL MODE FLAG OF TYPE STATEMENT JMP AI34 MODES MATCHED LDA T6AI,I IOR KK01 =B100000. STA T6AI,I SET AF12(F.A)=B100200 LDA T4AI,I AND K8 (A)=E(F.A) AI37 LDB SUB SZA STB F.IU E(F.A)=1,SO SET F.IU=SUB JMP AI02 SEARCH ASSIGNMENT TABLE AGAIN SPC 1 AI38 LDA T4AI,I IOR K8 SET E(F.A)=1 (SAME AS DEFIN ENT) STA T4AI,I LDA AF12 CPA KK46 =B100200 JMP AI49 AF12=B100200 CPA KK01 =B100000 JMP TSE33 IMPROPER USE OF SUBR NAME. JMP AI06 AF12(F.A)=2 SPC 1 AI49 STA TSUBF SET TAG 'SUB' FLAG JMP AI37 * AF12 NOP SAVE AF12(F.A) F.DCF NOP DIM,COM FLAG F.EFG NOP E-FLAG(SET IF SUBSCRIPT DUMMY) KK46 OCT 100200 CPX. OCT 50000 F.IM = CPX REA OCT 20000 IM=2 DBL OCT 60000 IM=6 DOUBLE * SPC 1 * ***************************************** * * (B)=NO. OF WORDS FOR ASSIGNMENT ENTRY * * ******************************'*********** SPC 1 NWE.F NOP LDB K3 LDA F.IM CPA REA F.IM=2 ? INB YES,REAL CONSTANT CPA DBL F.IM=6 ? ADB NWET1 YES,DOUBLE PRECISION CONSTANT CPA CPX. F.IM=5 ? ADB K3 YES,COMPLEX JMP NWE.F,I * NWET1 NOP SPC 1 * ******************************* * * GET NEXT ASSIGNMEXT POINTER * * ******************************* SPC 1 * ENTRY: F.A=CURRENT POINTER TO ASSIGNMENT TABLE ENTRY * EXIT : F.A=POINTER TO NENT ENTRY IN THE ASSIGNMENT TABLE * (A)=F.A-F.S2B (.GE. 0 MEANS TOP OF ASSIGNMENT TABLE REACHED * FIXF=F.A-F.DP (.LT. 0 MEANS IN FIX ENT. TABLE, * .GE. 0 MEANS IN ASSIGNMENT TABLE). SPC 1 GNA.F NOP LDA F.A,I GET FIRST ENTRY AND K7 ISOLATE THE LENGTH ADA F.A INDEX TO THE NENT ENTRY STA F.A AND SET IT'S ADDRESS LDB F.DP BETTER TO KEEP (-DP) FOR THIS CMB,INB ADB A LDA F.S2B HERE (F.DP-F.S2B) WOULD HELP SPEED IT UP CMA,INA ADA F.A (A)=F.A-F.S2B JMP GNA.F,I * SKP * ******************* * * DEFINE LOCATION * * ******************* SPC 1 * DEFINE: AF(F.A)=RPL (PRESENT LOCATION COUNTER) * F.AT(F.A)=REL SPC 1 DL.F NOP LDA REL JSB DAT.F DEFINE AT LDA F.RPL JSB DAF.F DEFINE F.AF JMP DL.F,I SPC 1 * ************ * * FETCH F.ID * * ************ SPC 1 * COPY NAME FROM TABLE ENTRY TO NID IN A1 FORMAT. * FID.F NOP JSB BNI.F CLEAR NID TO BLANKS JSB NW.F F.NW=(A)=-(NO. OF WDS IN NAME) SSA,RSS JMP FID.F,I NO F.ID FIELD (DUMMY 1 OR 2 WD) LDA F.DNI LOC. OF 1ST WD OF NID BUFFER STA T1FID LDB F.A ADB K2 FID02 LDA B,I ALF,ALF f AND B377 STA T1FID,I STORE 1ST CHAR INTO NID BUFFER ISZ T1FID BUMP NID BUFFER LOC BY 1 LDA B,I AND B377 STA T1FID,I STORE 2ND CHAR INTO NID BUFFER ISZ T1FID BUMP NID BUFFER LOC INB BUMP ID FIELD LOC ISZ F.NW ID FIELD EXHAUSTED? JMP FID02 NO. JMP FID.F,I * T1FID BSS 1 NID BUFFER POINTER SPC 1 B377 OCT 377 VAR OCT 400 IU=2 SKP * ******************************** * * (A)=-(NO. OF WORDS IN ID(F.A) * * ******************************** SPC 1 NW.F NOP LDA F.A,I GET THE LENGTH WORD AND K7 ADA KM2 CMA,INA STA F.NW (A)=F.NW=-(NO. OF WORDS IN ID(F.A) JMP NW.F,I SKP * ****************** * * TAG SUBPROGRAM * * ****************** SPC 1 TS.F NOP LDA F.IU CPA VAR JMP TS06 F.IU=VAR CPA SUB JMP TS04 JSB NUTST NO USAGE TEST SPC 1 LDA K85 TEST FOR USER NAME = INTRINSIC LDB F.DP IF INTRINSIC CMB,INB AREA OF SYMBOL TABLE ADB F.A THEN SSB SEND JSB WAR.F THE WARNING TS03 LDA SUB JSB DIU.F DEFINE F.IU AS SUBPROG LDA F.AT CPA DUM JMP TS02 IT IS DUMMY JSB FA.F FETCH ASSIGN LDA TSUBF TAG-SUBR FLAG SET? SZA JMP TS10 YES. LDA F.AT CPA REL JMP TS.F,I EXIT, SUB ALREADY DEFINED TS10 CLA LDB F.A INB STA B,I AF(F.A)=0 JMP TS.F,I SPC 1 TS02 LDA K86 LDB F.SPF CPB K3 JSB WAR.F DUMMY ARG SUBSCRIPTED IN ASF JMP TS.F,I SPC 1 TS04 LDA TSUBF F.IU = SUBROUTINE. SZA,RSS JMP TS03 LDA F.A,I AND B600 CPA SUB JMP TS.F,I JMP TS03 SPC 1 TS06 LDA F.AT CPA DUM  JMP TS03 TSE33 LDA K33 JSB ER.F VARIABLE RENAMED AS SUBROUTINE SPC 2 T0TS NOP BAD9P NOP BAD 9 TABLE PTR TSUBF NOP TAG 'SUB' FLAG KM9 DEC -9 K33 DEC 33 K68. DEC 68 K75. DEC 75 K85 DEC 85 K86 DEC 86 B600 OCT 600 KK02 OCT 70000 TO ENTRACT F.IMFIELD SPC 1 SPC 2 * *********** * * F.TC TEST * * *********** SPC 1 * ENTRY: (A)=CORRECT TERMINATING CHAR. SPC 1 TCT.F NOP CPA F.TC JMP TCT.F,I F.TC=(A),EXIT LDA K28 JSB ER.F IMPROPER TERMINATING CHARACTER SPC 2 * ********************* * * NON-CONSTANT TEST * * ********************* SPC 1 NCT.F NOP LDA F.NT SZA,RSS JMP NCT.F,I EXIT, ITEM NOT A CONSTANT LDA K24 JSB ER.F CONSTANT MUST NOT BE PRESENT SKP * *********************** * * NON-SUBROUTINE TEST * * *********************** SPC 1 NST.F NOP LDA K25 LDB F.IU CPB SUB JSB ER.F SUBPROGRAM NAME NOT ALLOWED JMP NST.F,I EXIT SPC 2 * **************** * * INTEGER TEST * * **************** SPC 1 ITS.F NOP LDA F.IM F.IM=INTEGER? CPA INT JMP ITS.F,I YES, EXIT LDA K26 NO JSB ER.F ITEM NOT AN INTEGER SPC 2 * ***************** * * NO USAGE TEST * * ***************** SPC 1 NUTST NOP LDA F.IU IS ITEM NAME ALREADY USED? SZA,RSS JMP NUTST,I NO, EXIT LDA K22. YES, NAME ALREADY BEING USED JSB ER.F SPC 2 INT OCT 10000 IM=1 INTEGER K22. DEC 22 K24 DEC 24 K25 DEC 25 K26 DEC 26 K27 DEC 27 K28 DEC 28 K29 DEC 29 SPC 2 * **************** * * TAG VARIABLE * * **************** SPC 1 TV.F NOP LDA F.IU  CPA VAR RSS JSB NUTST NO USAGE TEST LDA VAR JSB DIU.F DEFINE F.IU JMP TV.F,I SPC 2 * ************* * * DEFINE F.IM * * ************* SPC 1 * ENTRY: (A)=NEW ITEM MODE SPC 1 DIM.F NOP STA F.IM F.IM=(A) LDA F.A,I AND KK15 =B107777 IOR F.IM STA F.A,I IM(F.A)=F.IM JMP DIM.F,I SPC 2 * ********************** * * ESTABLISH CONSTANT * * ********************** SPC 1 * INPUT: (A)=MODE OF ITEM SPC 1 ESC.F NOP STA F.IM LDA KK01 =B100000 STA F.NT F.NT=1 FOR CONSTANT LDA VAR STA F.IU SET F.IU=VAR JMP ESC.F,I EXIT SKP * **************** * ESTABLISH DEF * * **************** * * * THIS ROUTINE ESTABLISHES A 3 OR 4 WORD ASSIGNMENT TABEL ENTRY * WHICH IF REFERENCED WILL CAUSE A DEF TO BE GENERATED -- * EITHER ALONG THE WAY OR AT THE END OF THE CODE GENERATION. * * CALLING SEQUENCE: * * LDA OFFSET (ONLY ZERO ALLOWED IF ENTRY IS UNDEFINED) * LDB F.A POINTER TO ASSIGNMENT TABEL ENTRY TO BE DEFED * JSB ESD.F * RETURN A=0 * * ESD.F NOP STA T1ESD SAVE THE OFFSET STB F.A SET UP AND JSB FA.F FETCH ASSIGNS LDA F.AT GET LOCATION INFO LDB F.AF ADDRESS TO B CPA BCOM LABELED COMMON REFERENCE? JMP ESD02 YES DO SPECIAL * ADB T1ESD ADD THE OFFSET CPB F.AF IF OFFSET IS ZERO LDB F.A THEN USE A POINTER IN STEAD CPB F.A ADB KK18 SET SIGN BIT =B100000 CPA COM IF IN COMMON RSS LDA STRAB USE COM ELSE USE STR-ABS FOR AT STB F.IDI SET VALUE NEEDED ESD01 STA T1ESD SAVE REQUIRED F.AT CLA ESTABLISH CONSTANT JSB ESC.F ! NT=0 IM=0 IU=VAR LDA B7600 SET UP FOR STA IUMSK SPECIAL SEARCH LDA F.IU MIRGE AT AND IU IOR T1ESD AND STA F.IU SET FOR AI JSB AI.F ASSIGN ITEM LDA T1ESD MAKE SURE JSB DAT.F F.AT IS RIGHT LDA B600 RESTORE STA IUMSK THE IU MASK CLA CLEAR A AND JMP ESD.F,I RETURN * ESD02 INB ENTRY IS IN LABELED COMMON DLD B,I GET THE OFFSET AND F.A OF ADA T1ESD THE MASTER ADD THE OFFSET DST F.IDI STOR FOR THE NEW ID LDA BCOMI SET REQUIRED F.AT STA F.AT. AND JMP ESD01 GO FINISH * B7600 OCT 7600 IUMSK OCT 600 T1ESD NOP COM OCT 4000 F.AT=COM BCOM OCT 3000 BCOMI EQU KK03 =B7000 KK18 DEF 0,I SKP * ************* * * DEFINE F.IU * * ************* SPC 1 * ENTRY: (A)=NEW F.IU (SUBR, VAR, OR 0) SPC 1 DIU.F NOP STA F.IU F.IU=(A) LDA F.A,I AND KK16 =B177177 IOR F.IU STA F.A,I IU(F.A)=F.IU JMP DIU.F,I * KK15 OCT 107777 KK16 OCT 177177 KK17 OCT 170777 SPC 2 * ************* * * DEFINE F.AT * * ************* SPC 1 * ENTRY: (A)=NEW AT(F.A) SPC 1 DAT.F NOP STA F.AT F.AT=(A) LDA F.A,I AND KK17 =B170777 IOR F.AT STA F.A,I JMP DAT.F,I SPC 2 * ************* * * DEFINE AF * * ************* SPC 1 * ENTRY: (A)=NEW F.AF SPC 1 DAF.F NOP STA F.AF F.AF=(A) LDB F.A LDA B,I AND B600 GET F.IU FIELD CPA ARR JMP DAF04 IU(F.A)=ARR DAF02 LDA F.A,I TEST IF LABELED COMMON AND KK03 =B7000 CPA BCOM WELL? INB,RSS YES INDEX TO THE INFO ENTRY RSS LDB B,I GET IT INB B NOW POINTS AT AF OF INFO. ENT IN BCOM LDA F.AF GET THE VALUE STA B,I STORE IT JMP DAF.F,I RETURN SPC 1 DAF04 INB LDB B,I (B)=GF(F.A) JMP DAF02 SPC 2 * ****************** * * FETCH CONSTANT * * ****************** SPC 1 FC.F NOP JSB CDI.F CLEAR F.IDI BUFFER TO 0 JSB NW.F (A)=-(NO. OF WORDS IN ID FIELD) SSA,RSS JMP FC.F,I DUMMY 1 OR 2 WORD ENTRY * LDA F.DID LOC. OF 1ST WORD OF F.IDI BUFFER STA T1FC LDB F.A ADB K2 FC02 LDA B,I STA T1FC,I COPY F.ID FIELD TO F.IDI BUFFER ISZ T1FC INB ISZ F.NW JMP FC02 * JMP FC.F,I * T1FC BSS 1 F.IDI BUFFER POINTER SPC 1 * ********************************* * *F.D0: NUMBER OF WORDS FOR ITEM * * ********************************* SPC 1 NWI.F NOP LDA F.IU CPA ARR CLB,RSS JMP NWI.F,I * LDA F.D3 SZA,RSS JMP NWI06 F.D3=0 * JSB MPY.F USE DOUBLE WORD BY SINGLE MPY ROUTINE DEF F.D2 NWI02 JSB MPY.F DEF F.D1 NWI04 JSB MPY.F DEF F.D0 DST F.D0 F.D0=NO. OF WORDS IN ARRAY JMP NWI.F,I EXIT * RPLOV LDA K84 JMP F.ABT RPL OVERFLOW * K84 DEC 84 * NWI06 LDA F.D2 SZA JMP NWI02 * LDA F.D1 JMP NWI04 SPC 1 * * ***************************************** * * DOUBLE WORD X SINGLE WORD MPY ROUTINE * * ***************************************** * * MPY.F NOP STA MPYT0 SAVE THE LOW PART OF OPERAND 1 LDA MPY.F,I GET OPERAND 2 ADDRESS ISZ MPY.F SET RETURN ADDRESS STA MPYD SAVE ADDRESS OF OPERAND 2 LDA B GET HIGH PART OF OPERAND 1 TO A MPY MPYD,I MPY TIMES OPERAND 2 MPYD EQU *-1 STA MPYT1 SAVE LOW PART OF PRODUCT (HIGH BETTER BE ZERO) TRN LDA MPYT0 GET LOW PART OF OPERAND 1 TO A MPY MPYD,I FORM PRYMARY CROSS PRODUCT ASL 1 ADJUST TO CLEAR BIT 15 OF A AND MOVE IT TO B CLE,ERA SET PROPER A ADB MPYT1 ADD SAVE RESULT OF HIGH ORDER CACULATION JMP MPY.F,I RETURN * MPYT0 NOP MPYT1 NOP END TASMB,Q,C HED STATEMENT PROCESSORS FOR FTN4 NAM EX.F,8 92060-16092 780301 * * THIS SUBROUTINE PROCESS FTN STATEMENTS WHICH REQUIRE * EXPRESSION EVALUATION. * * * * *************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * * REPRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * *************************************************************** * * * * * * EXT'S WITH A LEADING 'F.' ARE VARIABLES OR JUMP TARGETS * * THE COLUMN THE EXT STARTS IN DEFINES THE SUBROUTINE IT IS * DEFINED IN AS FOLLOWS * 2 -- OA.F (WRITE PASS FILE ROUTINES) * 3 -- NEX.F (STATEMEXTS THAT DON'T CONTAIN EXPRESSIONS) * 4 -- FA.F (THE ASSIGNMEXT TABLE ROUTINES) * 5 -- EX.F (STATEMEXTS USING THE EXPRESSION EVALUATOR) * 6 -- IC.F (THE CHARACTER INPUT ROUTINES) * 7 -- IDN.F (THE TOKEN INPUT ROUTINES) * 8 -- FTN4 ( THE MAIN) EXT F..DP BASE OF SYMBOL TABLE EXT F..E DIMENSIONS CONSTANT BIT FROM ASSIGNS TABLE EXT F.A ASSIGNMEXT TABLE ADDRESS (CURRENT ENTRY) ENT F.ASS ASSIGNMEXT STATEMEXT PROCESSOR EXT F.ABT ABORT COMPILE EXTRY EXT F.ACC TEMP ACCUMULATOR FLAG EXT F.AF ADDRESS FIELD CURREXT F.A EXT F.ARF NO. OF SUB. FUN. ARGUMEXTS EXT F.ASP ASSIGN STMT. PROCESSOR EXT F.AT ADDRESS TYPE OF CURREXT F.A EXT F.AT. SUBSCRIPT INFO FLAG EXT F.BGN RETURN FROM F4.0 EXT F.BSP BACKSPACE STMT. PROCESSOR EXT F.BUF A BUFFER EXT F.C OFFSET FOR CURRENT MR INSTRUCTION ENT F.CAL CALL STATEMEXT PROCESSOR EXT F.CC CHARACTER COUNT EXT F.CCW FTN OPTION WORD EXT F.CIN CURREXT CI BUFFER LINE NUMBER EXT F.CLN INPUT ITEM CURREXT LINE # EXT F.CON CONTINUE STMT. PROCESSOR EXT F.CSZ COMMON SIZE EXT F.D DO TABLE POINTER EXT F.D.T ADDRESS OF '.' FUN. TABLE EXT F.D0 ARRAY ELEMEXT SIZE EXT F.D1 DIMENSION 1 EXT F.D2 DIMENSION 2 EXT F.D3 DIMENSION 3 EXT F.DCF DIM, COM FLAG EXT F.DEF DATA EXISTS FLAG EXT F.DID ADDRESS OF F.IDI EXT F.DLF DELIMETER FLAG EXT F.DNB DEF OF NBUF (NAM RECORD) EXT F.DNI ADDRESS OF NID EXT F.DO LWAM - END OF DO TABLE ENT F.DOP DO STATEMEXT PROCESSOR EXT F.DP BASE OF USER SYMBOL TABLE EXT F.E EQUIVALENCE TABLE POINTER EXT F.EFG E - FLAG - SET IF SUBSCRIPT IS DUMMY EXT F.EFP ENDFILE STMT. PROCESSOR EXT F.EMA F.A OF EMA EXT ENTRY, WINDOW SIZE EXT F.EMS EMA SIZE DOUBLE WORD, (INTERNAL FORMAT) EXT F.END END FLAG EXT F.EQE EQUVALENCE ERROR FLAG EXT F.EQF EQUIVALENCE FLAG EXT F.ER0 'RX' OF ERRX LIB ERROR ROUTINE EXT F.ERF ERROR FLAG (# OF ER.F CALLS) EXT F.ERN ERROR ARRAY EXT F.EXF EXTERNAL STATEMEXT FLAG EXT F.FMT FORMAT STMT. PROCESSOR ENT F.GOP GO TO STATEMEXT PROCESSOR EXT F.IDI INPUT ARRAY NON-NUMERIC EXT F.IFF IF FLAG ENT F.IFP IF STATEMEXT PROCESSOR EXT F.IM CURREXT ITEM MODE (REAL, COMPLEX,ECT.) EXT F.INT TEMP VARIABLE ARRAY EXT F.IOF INDICATOR FOR I/O INDEX EVALUATOR EXT F.IU CURREXT ITEM USAGE (DUM., RELATIVE, ECT.) EXT F.HDL LENGTH OF HEAD MESSAGE EXT F.L # WORDS ON STACK 2 EXT F.LFF LOCICAL IF FLAG EXT F.LLO CURRENT RELOCATAION ADDRESS(TWO WORDS) EXT F.LLT ADDRESS OF LINE LOCATION TABLE (SET BY INI׿T) EXT F.LO END OF ASSIGNMEXT TABLE+1 EXT F.LOP NO. LINES LEFT ON THIS PAGE. EXT F.LPR ( LOC OF EQUIVALENCE GROUP EXT F.LSF EXPECT FIRST STATEMEXT FLAG EXT F.LSN F.A OF LAST STATEMEXT NUMBER EXT F.LSP LAST OPERATION FLAG EXT F.MFL TYPE STMT. MODE FLAG EXT F.NC NAME CHANGE FLAG. EXT F.NCR NO CROSS REF FLAG EXT F.ND NUMBER OF DIMENSIONS EXT F.NEQ # OF EQUIVALENCE GROUPS EXT F.NT NAME TAG 0= VAR, 1=CONSTANT. EXT F.NTF NAME TAG FLAG EXT F.NW NO. WORDS THIS TABLE F.A EXTRY. EXT F.NXN NO INPUT FLAG EXT F.OFE DATA POOL OVERFLOW ERROR EXTRY. EXT F.OPF OUTPUT PACK FLAG EXT F.R JSB ERR0 FLAG EXT F.PAK PACK BUFFER WORD EXT F.PAP PAUSE STMT. PROCESSOR ENT F.RDP READ STATEMEXT PROCESSOR EXT F.REL SUB. PROG. RETURN LOCATION EXT F.RPL PROGRAM LOCATION COUNTER EXT F.RPR ) LOC OF EQUIVALENCE GROUP EXT F.RTN RETURN STMT. PROCESSOR EXT F.RWP REWIND STMT. PROCESSOR EXT F.S02 RETURN FORM RCOM F.1 EXT F.S03 LOAD F.1 AND PASS CONTROL EXT F.S1B BOTTOM OF STACK 1 EXT F.S1T TOP OF STACK 1 EXT F.S2B BOTTOM OF STACK 2 EXT F.S2T TOP OF STACK 2 EXT F.SBF 0= MAIN, ELSE SUBROUTINE EXT F.SCC SAVE F.CC EXT F.SEE RETURN FROM F4.1 EXT F.SEG LOAD A NEW SEGMENT EXT F.SFF SUBROUTINE/FUNCTION FLAG 0/1 ENT F.SFP STATEMEXT FUNCTION PROCESSOR EXT F.SID STATEMEXT ID PHASE FLAG EXT F.SLF STATEMEXT LEVEL FLAG EXT F.SPF SPECIFICATION FLAG SET TO CURREXT STMT. LEVEL EXT F.SPS STATEMEXT PROCESSOR SWITCH EXT F.SRL SAVE RPL AT BEGINNING OF RECORD EXT F.STA FLAG THAT IS ZERO UNTIL THE FTN STATEMEXT IS READ EXT F.STB STRING BACK JUMP F-pLAG EXT F.STP STOP STMT. PROCESSOR EXT F.STS TO STATEMEXT SCAN EXT F.SVL SAVE # WORDS ON OPER STACK (F.L) EXT F.SXF COMPLEX CONSTANT FLAG EXT F.T # WORDS ON STACK 1 EXT F.TAC ? EXT F.TC NEXT CHARACTER EXT F.TIM TIME ARRAY ADDRESS IN HEAD EXT F.TRM TERMINATE COMPILE EXT F.TYP TYPE STATEMEXT FLAG ENT F.WRP WRITE STATEMEXT PROCESSOR EXT F.X1 F.A OF F.D1 EXT F.X2 F.A OF F.D2 EXT F.X3 F.A OF F.D3 * * EXT'S WITH A TRAILING '.F' ARE SUBROUTINES * EXT AA.F ASSIGN ADDRESS SUB. EXT AI.F ASSIGN ITEM EXT ASC.F CONVERT TO 4 ASCII DIGITS EXT BNI.F CLEAR NID TO BLANKS EXT BOM.F DISASTOR ERROR REPORT (NO RETURN) EXT CID.F CLEAR F.ID ARRAY EXT CDI.F CLEAR IDI ROUTINE EXT CRP.F CROSS REF PAIR SUB. EXT CRT.F TEST FOR CARRAGE RETURN EXT DAF.F DEFINE (F.AF) EXT DAT.F DEFINE (AT) EXT DIM.F DEFIND (F.IM) EXT DIU.F DEFINE (F.IU) EXT DL.F DEFINE LOCATION SUBROUTINE EXT EJP.F PAGE EJECT SUBROUTINE EXT ER.F ERROR PRINT SUBROUTINE EXT ESC.F ESTABLISH CONSTANT SUBROUTINE EXT ESD.F ESTABLISH DEF SUBROUTINE EXT EXN.F EXAMINE NEXT CHARACTER EXT FA.F FETCH ASSIGNS EXT FID.F FETCH (ID) TO NID (UNPACK) EXT FNS.F FIRST NOT SPEC. STMEXT CHECK ENT FXC.F CHECK IF SUB. IN FIX-EXT TABLE EXT GNA.F GET NEXT SYMBOL TABLE EXTRY EXT GPE.F GENERATE SUB. PROG. EXTRANCE EXT IA.F INPUT (A) CHARACTERS SUBROUTINE EXT IC.F GET NEXT CHARACTER EXT ICH.F GET NEXT NON BLANK CHAR. AND TYPE IT EXT IDN.F INPUT DO NOT ASSIGN (GET NEXT OPERAND) EXT IDS.F INPUT DIGIT STRING ENT IFT.F IF GOTO COMPLETION EXT II.F INPUT ITEM A EXT IIV.F INPUT INTEGER VARABLE EXT IN2.F INIT FOR OA.F MODULE EXT IN3.F INIT FOR ENX.F MODULE EXT IN4.F INIT FOR FA.F MODULE ENT IN5.F INIT FOR EX.F MODULE EXT IN6.F INIT FOR IC.F MODULE EXT IN7.F INIT FOR IDN.F MODULE EXT INM.F INPUT NAME EXT IOP.F INPUT OPERATOR EXT ISN.F INPUT STATEMEXT NUMBER EXT ISY.F INPUT SYMBOL EXT ITS.F INTEGER TEST EXT MCC.F RESET TO FIRST COLUMN OF STATEMEXT EXT MPN.F MOVE PROGRAM NAME (TO NAM RECORD ECT.) EXT NEW.F SUB TO CLEAR TEMPS FOR A NEW MODULE EXT NCT.F TEST FOR NOT A CONSTANT EXT NST.F TEST FOR NOT A SUBROUTINE NAME EXT NTI.F MOVE NID TO F.IDI (PACKS) EXT NWI.F SET F.D0 TO # WORDS IN ARRAY EXT OA.F OUTPUT ASSIGNMEXT TABLE OPERAND EXT OAI.F OUTPUT ABS. INSTRUCTION EXT OC.F OUTPUT CONSTANT EXT ODF.F OUTPUT DOT FUNCTION EXT OLR.F OUTPUT LOAD ADDRESS EXT OMR.F OUTPUT MEMORY REF. INSTRUCTION EXT OS.F OUTPUT SECTOR TO INTERPASS FILE EXT OW.F OUTPUT WORD EXT OZ.F OUTPUT ZREL (OP *+N) EXT PAK.F PACK SUBROUTINE EXT PDF.F PRODUCE DEF SUBROUTINE EXT PSL.F PRINT LINE ON PRINTER EXT PTM.F PROGRAM TERMINATION CODE GEN. EXT RTN.F SUBROUTINE RETURN HANDLER EXT RP.F INPUT ')' EXT SCC.F SAVE F.CC SUBROUTINE EXT SCP.F SAVE CURREXT STATPMEXT POSITION. EXT SKL.F SKIP LINES ON LIST EXT SNC.F START NEXT CARD SUBROUTINE EXT SOA.F STORE AND OUTPUT (OA.F) ENT TDO.F DO TERMINATION CODE GENERATOR EXT TCT.F TEST (A) = F.TC ELSE ER 28 EXT TS.F TAG SUBPROGRAM SUB. EXT TV.F TAG VARIABLE EXT UC.F UNINPUT COLUMN EXT WAR.F ERROR COMMEXT SUBROUTINE (WARNINGS) * * EXTERNALS IN THE S5gEGMENT * EXT EE.F EXPRESSION EVALUATOR EXT GIM.F GET ITEM MODE EXT GST.F GENERATE STORE IN TEMP EXT PU2.F PUSH ONTO STACK 2 SUB EXT MAP.F MAP EMA VARIABLE EXT EA?.F EMA TEST ROUTINE * A EQU 0 B EQU 1 .TBL EQU 0 * * INITIALIZE ROUTINE FOR THIS MODULE * IN5.F NOP CLA CLEAR THE STA T0STF STATEMENT FUNCTION FLAG JMP IN5.F,I RETURN SKP * ******************* * * IF ( PROCESSOR * * ******************* SPC 1 F.IFP JSB EE.F EXPRESSION EVALUATOR KM7 DEC -7 STA T1IFL F.IM OF EVALUATED VALUE LDA B51 ')' JSB TCT.F F.TC-TEST JSB EXN.F EXAMINE NEXT CHARACTER SZB DIGIT? JMP IFLP6 NO. STATEMENT TO FOLLOW LDA SSAI 'SSA' JSB OAI.F OUTPUT ABSOLUTE INSTRUCTION JSB ISN.F INPUT FIRST STATEMENT # LDA JMP. JSB OA.F OUTPUT JMP TO IT LDA B54 , JSB TCT.F JSB ISN.F INPUT SECOND STATEMENT # LDA F.TC CPA B54 ',' ? JMP IFLP3 YES. THIRD STMT # FOLLOWS IFLP2 LDA F.A STA F.IFF RTNP1 LDA F.LFF IF LOGICAL IF FLAG SZARS SZA,RSS NOT SET STA F.LSP RESET LAST OPERATION FLAG ILTRM CLA,INA SET LAST STATEMENT STA F.LSF FLAG ILLEGAL TERMINATION JMP CRT.F GO TEST FOR END OF STATEMENT * IFLP3 LDB T1IFL 3-WAY IF. LDA B75 CPB LOG VALUE IS LOGICAL? JSB WAR.F YES. GRIPE: LOG IF WITH 3 BRANCHES LDA SZARS 'SZA,RSS' JSB OAI.F OUTPUT ABS. INSTRUCTION LDA JMP. 'JMP' JSB OA.F OUTPUT JMP TO 2D STMT # JSB ISN.F INPUT THIRD STATEMENT # JMP IFLP2 SPC 1 IFLP6 LDA K62 62 LDB T1IFL F.IM OF EVALUATED VALUE CPB LOG RSS JSB WAR.F ARITH IF WITH STATEMENT FOLLOWING. LDA K52 LDB F.STB STRING FLAG SET? SZB JSB ER.F YES. LOGICAL IF WITHIN LOGICAL IF LDB F.TC LOAD THE NEXT CHARACTER. CPB B15 END OF CARD? JMP IFLP1 YES. BITCH. LDA KK62. 'SSA,RSS' JSB OAI.F OUTPUT ABS INSTRUCTION LDA TWPE F.IM=4 JSB ESC.F ESTABLISH CONSTANT JSB AI.F ASSIGN ITEM LDA JMP. 'JMP' JSB OA.F OUTPUT 'JMP F.A' LDA F.A STA F.STB SET STRINGBACK FLAG STA F.LFF ASLO THE LOGICAL IF FLAG JSB EXN.F EXAMINE NEXT CHARACTER JSB SCP.F SAVE CURRENT CARD POSITION FOR RESCAN JMP F.STS TO STATEMENT SCAN * B51 OCT 51 ')' B54 OCT 54 ',' K52 DEC 52 K62 DEC 62 K89. DEC 89 KK62. SSA,RSS T1IFL NOP F.IM OF EVALUATED VALUE SPC 1 IFLP1 ISZ F.CC SET "F.CC" TO 1. LDA K89. 89 JSB ER.F ERROR 89. SPC 1 * ************ * * IFF TEST * * ************ SPC 1 * TO OUTPUT THE OBJECT CODE FOR AN UNCONDITIONAL GO TO * ENTRY: IF (A)=0, NO OBJECT CODE OUTPUT * IF (A) NON-ZERO, OUTPUT JMP 1-IFF * IFF=ASSIGNMENT TABLE POINTER OF JUMPED-TO STATEMENT SPC 1 IFT.F NOP CCE,SZA,RSS JMP IFT02 NO OBJECT OUTPUT LDA JMP. 'JMP' LDB F.IFF ASSIGNMENT TABLE PTR RBL,ERB SET INDIRECT JSB OMR.F OUTPUT MR LDA T1IFL F.IM OF IF EXPRESSION CPA LOG JMP IFT02 CLA CPA F.LFF STA F.LSP RESET LAST OPERATION FLAG IFT02 CLA STA T1IFL RESET LOG IF E.E. F.IM STA F.IFF RESET IF FLAG JMP IFT.F,I SPC 1 * ******************* * * GO TO PROCESSOR * * ******************* SPC 1 F.GOP JSB EXN.F EXAMINE NEXT CHARACTER SZB CHAR. A DIGIT? JMP GOTO2 NO# JSB ISN.F INPUT STATEMENT NUMBER LDA F.A STA F.IFF JMP ILTRM ILLEGAL TERMINATOR CHECK. SPC 1 GOTO2 LDA F.DLF CHAR. A LETTER? SZAI SZA JMP GOTO4 NO. DELIMITER. JSB IIV.F ASSIGNED; INPUT INTEGER VARIABLE JSB MAP.F GET ADDRESS IF IN EMA CCE SET UP E TO INDICATE CPA F.A IF EMA OR NOT CLE SET E IF EMA STA F.A SET ADDRESS LDA LDAI GET A LOAD A INSTRUCTION LDB F.AT IF DUM THEN SEZ,RSS OR IF IN EMA CPB DUM MUST GET THE JSB OA.F OUTPUT LDA F.A OR LDA B,I IF EMA SZA,RSS IF RESULT NOW IN A STA F.A SET IT AS NEXT ADDRESS LDA IJMPI GET JUMP INDIRECT JSB OA.F PUT OUT THE JUMP LDA F.TC CPA B54 ',' JSB IBL.F INPUT BRANCH LIST GOTO3 CLA STA F.L LDA F.LO STA F.S2B STA F.S2T JMP RTNP1 DETERMINE PROPER TERMINATION. SPC 1 JMPAI JMP A,I JMP INSTRUCTION * GOTO4 JSB IBL.F COMPUTED; INPUT BRANCH LIST CPA B54 NEXT CHAR = , ? RSS JSB UC.F NO. UNINPUT COLUMN JSB EE.F EVALUATE GOTO INDEX EXPR. KM5 DEC -5 STA T1GOT SAVE F.A OF VAR OR TEMP CELL LDA JSBI 'JSB' LDB .GOTO ADDR OF .GOTO JSB ODF.F 'JSB .GOTO' (RETURNS A=0) LDB T1IBL # OF STATEMENTS ADB K2 JSB OZ.F 'DEF RPL+N+2' CLA STA II CLEAR THE STACK INDEX LDB T1GOT F.A OF VAR OR TEMP CELL JSB OA.F PRODUCE THE DEF GOTO6 ISZ II STEP THE STACK INDEX LDB II INDEX INTO THE STACK (REMBER IT IS ADB F.LO MOVING AS WE ADD THE DEF ENTRIES) LDB B,I GET THE STMT. NO. F.A SZB,RSS END OF LIST IS MARKED WITH ZERO JMP GOTO3 END WRAP IT UP * CLA USE ZERO OFFSET JShB ESD.F ESTABLISH DEF TO THIS STMT. NO JSB PDF.F PRODUCE IT JMP GOTO6 AROUND WE GO * II NOP SUPPLEMENTARY INDEX K2 OCT 2 B50 OCT 50 '(' T1IBL NOP NO. OF STMT NUMBERS T1GOT NOP IJMPI OCT 126000 JSBI OCT 16000 .GOTO DEF .TBL+49 COMPUTED GO TO SPC 2 * ********************* * * INPUT BRANCH LIST * * ********************* SPC 1 IBL.F NOP CLA STA T1IBL T1=0 JSB ICH.F INPUT CHAR. LDA B50 '(' JSB TCT.F F.TC-TEST IBL02 JSB ISN.F INPUT STATEMENT NUMBER LDA F.A JSB PU2.F STORE STMENT NO. F.A IN STACK ISZ T1IBL INCREMENT NUMBER OF STMNT NOS. LDA F.TC CPA B54 ',' ? JMP IBL02 YES. GET ANOTHER STMT NO. CLA JSB PU2.F ENTER 0 INTO STACK JSB RP.F )-INPUT OPERATOR JSB ICH.F GET NEXT CHARACTER JMP IBL.F,I SKP * **************** * * DO PROCESSOR * * **************** SPC 1 F.DOP LDA K50 LDB T1IFL F.IM OF LOG IF E.E. F.IM CPB LOG JSB WAR.F DO IN LOG IF STATEMENT CLA STA T1IFL RESET LOG IF E.E. FLAG JSB ISN.F INPUT STATEMENT NUMBER LDA K23 _. LDB F.AT . NON-REL TEST CPB REL . JSB ER.F _. LDA F.A STA DOSN DO STATEMENT NUMBER PTR SAVED JSB IIV.F INPUT INTEGER VARIABLE LDB F.D DOPR5 CPB F.DO VERIFY UNIQUE CONTROL VAR. JMP DOPR7 ALL CHECKED: OK. ADB K2 LDA B,I CPA F.A JMP DOPR0 ADB K3 JMP DOPR5 SPC 1 DOPR0 LDA K51 ERROR 51 JSB ER.F NESTED DO WITH SAME CONTR VAR * DOSN BSS 1 DO STATEMENT NUMBER SAVED REL OCT 1000 K23 DEC 23 K3 DEC 3 B60 OCT 60 B15 OCT 15 K50 DEC 50 K51 DEC 51 B75 OCT 75 B104 OCT 104 'D' B17617 OCT 117 'O' SPC 1 DOPR7 LDA B75 '=' JSB TCT.F F.TC TEST LDA KM5 JSB DPO.F D=D-5 LDA DOSN STA B,I (D)=F.A OF STATEMENT NUMBER ADB K2 LDA F.A STA B,I (D+2)=F.A OF INDEX VARIABLE JSB EE.F EVALUATE INITIAL INDEX KM2 DEC -2 LDA B54 , JSB TCT.F JSB EE.F EVALUATE FINAL INDEX DEC -4 JSB ATD.F ALLOCATE TEMP CELL TO DO LOOP LDB F.D ADB K3 STA B,I (D+3)=F.A OF TERMINATING INDEX LDB F.TC CPB B15 STEP SIZE SPECIFIED? JMP DOPR8 NO. USE 1 JSB EE.F EVALUATE STEP SIZE DEC -4 JSB ATD.F ALLOCATE TEMP CELL TO DO LOOP JMP DOPR9 SKIP DEFINING OF ONE * DOPR8 JSB CN1.F DEFINE-FETCH CONSTANT 1 DOPR9 LDB F.D INB STA B,I (D+1)=F.A OF INCREMENTING INDEX ADB K3 LDA F.RPL STA B,I (D+4)=RPL JMP ILTRM SPC 2 * ******************************** * * TERMINATE DO RANGE * * ******************************** * TDO.F NOP TERMINATE DO, CALLED AFTER EACH LABELED STATEMENT STA LSTN SAVE THE CURRENT STATEMENT NUMBER LDB F.D LOC OF LAST DO ENTRY IN DO TABLE STER4 STB III SAVE DO TABLE POINTER CLA CPB F.DO END OF DO TABLE SEARCH? JMP TDO.F,I YES RETURN * LDA LSTN IS THIS STMNT NO. A DO TERMINAT? CPA B,I JMP STER6 YES STA F.LSF SET LAST STMNT FLAG (ILL.DO TERM.) STER5 LDB III ADB K5 JMP STER4 SPC 1 STER6 LDB F.LSF LAST STMNT FLAG SET? LDA K30 SZB JSB ER.F YES, ILL. DO TERMINATING STMNT LDB F.D INB LDA B,I STA F.M3 F.M3 INB LDA B,I STA CONTR INDEX I INB LDA B,I STA F.M2 cF.M2 INB LDA B,I STA JMPAD 1ST STATEMENT OF LOOP ADDR. JSB DT.F DO TERMINATING LDA F.D ADA K5 STA F.D F.D=F.D+5 TO ELIMINATE DO ENTRY JMP STER5 CONTINUE SEARCH * K5 DEC 5 K30 DEC 30 III NOP LSTN NOP * * *************************************** * * ALLOCATE TEMP CELL TO DO EXPRESSION * * *************************************** SPC 1 * ENTRY: (A)=F.A POINTER OF INT CONST/INT VAR/TEMP CELL SPC 1 ATD.F NOP LDB F.A ADB K2 2 LDB B,I SSB,RSS JMP ATD.F,I NOT INT TEMP CELL CCB ADB F.INT STB F.INT F.INT=F.INT-1 JMP ATD.F,I SKP * *************************** * * DATA POOL OVERFLOW TEST * * *************************** SPC 1 * INPUT: (A) = DELTA-D. RETURN NEW D IN B SPC 1 DPO.F NOP ADA F.D STA F.D F.D=(A) LDB A CMA,INA ADA F.LO ADA F.L (A)=LO+F.L-D SSAI SSA JMP DPO.F,I EXIT * JMP F.OFE DATA POOL OVERFLOW BAIL OUT!@*?##@@'** * ST.RF NOP JMP. OCT 26000 SPC 1 JMPAD BSS 1 POINTER TO BEGIN OF IMP. DO BODY SKP * ************************ * * READ-WRITE PROCESSOR * * ************************ SPC 1 F.RDP CLB,RSS F.WRP CLB,INB STB IOF SET I/O FLAG (0=READ,1=WRITE) CLBI CLB STB ST.RF STB LREQ JSB ICH.F INPUT CHARACTER LDA B50 '(' JSB TCT.F F.TC-TEST JSB IOP.F INPUT OPERAND: LU LDA F.IU CPA ARR F.IU=ARR? RSS YES JSB TV.F NO,TAG VAR/CON JSB FA.F FETCH ASSIGN JSB ITS.F INTEGER TST LDA F.IU IF ARRAY CPA ARR CHECK RSS JMP RWP00 NOT ARRAY * LDA F.TC IF CPA B50 '(' RSS m JMP RWP00 * JSB EE.F EVALUATE THE ADDRESS DEC -3 OF THE ELEMENT STA F.A SET F.A OF THE ADDRESS RWP00 JSB MAP.F IF IN EMA MAP IT IN STA F.A SET F.A FOR RESULT LDA LDA.. 'LDA' JSB OA.F OUTPUT 'LDA F.A' LDA CLBI 'CLB' LDB IOF I/O FLAG (0=READ, 1=WRITE) SZB,RSS LDA F.WRP 'CLB,INB' LDB F.TC CPB B54 ',' JMP RWP03 FORMATTED. * JSB OAI.F SEND THE CLB OR CLB,INB LDB .BIO. JSB ODF.F BINARY; OUTPUT 'JSB .BIO.' LDA F.TC CPA B51 ')' RSS JMP IOL53 ILLEGAL DELIMITER JSB ICH.F INPUT CHAR. LDA IOF LIST REQUIRED IFF OUTPUT. STA LREQ JMP RWP07 CHECK FOR I/O LIST. SPC 1 RWP04 JSB RWPSU SEND THE CLB,INB (BETTER BE) LDB IOF FREE FIELD FORMAT. OUTPUT? LDA K64 SZB JSB ER.F YES. FREE FIELD NOT ALLOWED ISZ F.CC JSB ICH.F INPUT CHARACTER CLA,INA STA LREQ LIST REQUIRED CLA JSB OW.F OUTPUT ABS. DATA NOP RWP06 JSB RP.F )-INPUT OPERATOR LDA TWPE F.IM=4 JSB ESC.F ESTABLISH CONSTANT JSB AI.F ASSIGN ITEM CLA JSB OA.F OUTPUT 'DEF F.A' LDA F.A STA ST.RF RWP07 LDA F.TC CPA B15 'C/R' JMP RWP01 YES. NO I/O LIST. JSB UC.F UNINPUT COLUMN CLA STA LCHAR LCHAR=0 INITIALLY. JSB IOL.F I/O LIST PROCESSOR. RWP08 LDB .DTA. LDA IOF I/O FLAG (0=READ, 1=WRITE) SZA JSB ODF.F WRITE; OUTPUT 'JSB .DTA.' LDB ST.RF SZB,RSS JMP CRT.F INB LDA F.RPL STA B,I AF(F.A)=RPL JMP CRT.F TO C/R TEST SPC 1 RWP01 LDB LREQ NO I/O LIST SUPPLIED. SZB,RSS IS ONE NEEDED? JMP RWP08 NO. LDA K63 JSB ER.F ERROR: NO LIST. SPC 1 RWP03 STA T1RWP SAVE THE CLB OR CLB,INB CODE JSB EXN.F EXAMINE NEXT CHARACTER SZB DIGIT? JMP RWP14 NO. NOT FORMAT STATEMENT NO. JSB ISN.F INPUT STATEMENT NO. ISZ F.CC RWP05 JSB RWPSU SEND THE CLB OR CLB,INB AND THE JSB .DIO. LDB F.A F.A OF THE STMT. NO. JSB ESD.F ESTABLISH DEF TO FMT. JSB PDF.F PRODUCE IT JMP RWP06 SPC 1 RWP14 CPA B52 F.TC = '*' ? JMP RWP04 YES. FREE FIELD INPUT * JSB INM.F INPUT NAME JSB EA?.F IF IN EMA RSS JMP RWP15 THEN WE CAN NOT DO IT * LDB F.IU CPB ARR JMP RWP13 F.IU=ARRAY * LDB F.AT MUST BE ASSIGNED STMT. NO. CPB DUM CHECK IF DUM (** EXTENSION OF STANDARD HERE**) JMP RWP09 YES GO SUCK IT IN * JSB RWPSU NO SEND THE B REG SET UP AND THE JSB .DIO. CLA,CCE SET UP TO PRODUCE AN INDIRECT DEF ERA SIGN TO A JMP RWP10 GO PRODUCE IT * RWP09 LDA LDBI PRODUCE A LDB OF THE DUM,I JSB OA.F SEND IT LDA STBI NOW HAVE THE DEF IN B LDB K3 STORE IT IN THE JSB OZ.F CALLING SEQUENCE RWP13 JSB RWPSU PRODUCE THE CLB(,INB) JSB .DIO. CODE RWP10 JSB OA.F SAVE LOC. IF DUM ASSNG. OR DEF ARRY JMP RWP06 CONTINUE WITH THE READ/WRITE * RWP15 LDA K47 ILLEGAL FORMAT REF JSB ER.F DOWN THE TUBES * RWPSU NOP SUB TO SEND THE SAVED B REG SETUP LDA T1RWP GET THE SAVED WORD JSB OAI.F SEND ABSOLUTE INSTRUCTION LDB .DIO. AND THE JSB .DIO. JSB ODF.F NEITHER OF THESE CHANGES F.A JMP RWPSU,I RETURN * T1RWP NOP TEMP CELL STBI OCT 76000 STORE B INSTRUCTION SPC 2 * ******************************** * * I/O STATEMENT LIST PROCESSOR * * ********TRN************************ SPC 1 IOL.F NOP READ() OR WRITE() {T CLA STA F.L NUMBER SYNTAX ENTRIES STACKED STA LDADD LAST LOAD ADDRESS WORD IN A.T. STA RECL RECORD LENGTH OF LAST RECORD LDA F.RPL STA F.SRL SAVE RPL TO COMPUTE RECORD SIZES IOL01 JSB II.F INPUT NEXT ITEM IN LIST IOL51 LDB F.TC SZA,RSS IS ITEM MODE 0? JMP IOL10 YES, DELIMITER WAS JUST INPUT CPB O75 NO, IS F.TC AN '=' ? JMP IOL24 YES, PROCESS IMPLIED DO CONTROL IOL52 CLA CHECK WHETHER READ OR CPA IOF WRITE IS BEING PROCESSED JSB NCT.F INPUT; MUST BE VARIABLE JSB NST.F SUBPROG NAME IS ILLEGAL LDA K22 LDB F.IU SZB,RSS IF F.IU = 0, JSB ER.F ILLEGAL USAGE OF NAME * LDA F.A GET A.T. ADDRESS TO A STA T0IOL SAVE IT STB T2IOL SAVE ITEM USAGE CPB ARR IS NAME IN LIST AN ARRAY? RSS YES JMP IOL02 NO. * LDB F.TC CPB B50 IS ARRAY NAME SUBSCRIPTED? CLA,RSS YES JMP IOL16 NO. * STA T2IOL CLEAR THE ARR FLAG SINCE ONLY AN ELEMENT JSB EE.F GET ARRAY ELEMENT ADDRESS KM3 DEC -3 JMP IOL15 GO STORE THE ADDRESS * IOL02 JSB MAP.F CHECK IF IN EMA CPA K1 =1 IF TRUE JMP IOL15 EMA VARABLE GO STORE THE ADDRESS * IOL16 LDA LCHAR PRECEDING CHARACTER CPA B51 CANNOT BE ')' JMP IOL53 ERROR 53 LDA F.TC STA LCHAR UPDATE LCHAR JSB GIM.F GET ITEM MODE OF ITEM IN LIST. STA T1IOL SAVE ITEM MODE LDA T2IOL CPA ARR IS ITEM AN ARRAY NAME? RSS YES JMP IOL05 NO. LDA F.R SZA IF F.R IS 0, ALL DIMENSIONS CONST. JMP IOL03 NO,GENERATE ARRAY SIZE CALC. CODE CLA,INA STA F.D0 F.D0=1 LDA F.IM CPA CPX F.IM=CPX? ISZ F.D0 YES, F.D0=2 JSB NWI.F F.D0=F.D0*F.D1*F.D2*F.D3 DST T3IOL SAVE ARRAY WORDCOUNT JMP IOL05 SPC 1 IOL15 ALF,ALF CONFIGURE A STA OR STB ALF,RAR BASED ON THE 0 OR 1 RETURNED ADA STAI LDB K2 STORE THE ADDRESS IN LINE JSB OZ.F FOR THE CALL LDB T0IOL SAVE F.A STA T0IOL SET FLAG TO SHOW IT WAS DONE (GETS NOP) STA T2IOL KILL POSSIBLE ARRAY FLAG (NOT WHOLE THING) STB F.A F.A FROM T0IOL JMP IOL16 RETURN TO GET TYPE ECT. * K64 DEC 64 IOF BSS 1 INPUT=0, OUTPUT=1 FLAG. RECL NOP RECORD LENGTH LCHAR NOP LCHAR=0 AT BEGINNING OF I/O LIST INT OCT 10000 F.IM=1 INTEGER REA OCT 20000 F.IM=2 REAL LOG OCT 30000 F.IM=3 LOGICAL TWPE OCT 40000 F.IM=4 DUMMY TWO WORD ENTRY CPX OCT 50000 F.IM=5 COMPLEX DBL OCT 60000 F.IM=6 DOUBLE * ARR OCT 600 F.IU=3 ARRAY K22 DEC 22 LREQ NOP LIST REQUIRED IF NON-0 .DIO. DEF .TBL+28 FORMATTED ENTRY TO FRMTR .BIO. DEF .TBL+29 BINARY ENTRY TO FRMTR .DTA. DEF .TBL+36 LDA.. OCT 62000 B52 OCT 52 * K47 DEC 47 K63 DEC 63 SKP * * * * I/O STATEMENT LIST PROCESSOR, CONTINUED * * VARIABLE ARRAY SIZE; GENERATE SIZE CALC. CODE. * IOL03 LDB F.D2 GET SECOND DIMENSION LDA T1IOL AND TYPE OF ARRAY CCE,SZB,RSS IF SINGL DIMENSION CPA CPX AND NOT COMPLEX JMP IOL00 * ERB SET UP TO DEF THE TEMP. STB T3IOL SAVE THE DEF ,I LDA F.X1 GET THE F.A OF THE TEMP STA T5IOL AND SET IT JMP IOL05 GO SET THE PROPER CALL * IOL00 LDA LDAI 'LDA' MUST COMPUTE THE SIZE LDB F.X1 JSB SOA.F OUTPUT LDA FIRST DIMENSION. LDA F.D2 2ND DIMENSION SZA,RSS IF F.D2 # 0, MPY BY SECOND DIM. JMP IOL04 IF F.D2 = 0, SKIP MPY. LDB .MPY JSB ODF.F OUTPUT JSB .MPY (RETURNS A(=0) LDB F.X2 JSB SOA.F OUTPUT DEF DIMENSION 2 LDA F.D3 F.D3 SZA,RSS IF F.D3 # 0, MPY BY THIRD DIM. JMP IOL04 IF F.D3 = 0, SKIP MPY. LDB .MPY JSB ODF.F OUTPUT JSB .MPY (RETURNS A=0) LDB F.X3 JSB SOA.F OUTPUT DEF DIMENSION 3 IOL04 LDA ALSI 'ALS' LDB T1IOL CPB CPX IF ITEM MODE IS COMPLEX JSB OAI.F OUTPUT 'ALS' TO MULT. BY 2. LDA STAI STORE THE COMPUTED LDB K3 IN LINE JSB OZ.F STA T3IOL SET T3IOL SO 'NOP' WILL BE OUTPUT. IOL05 LDA T1IOL CPA CPX IF COMPLEX ITEM IN I/O LIST, JMP IOL07 OUTPUT JSB .RAY. LDB T2IOL CPB ARR IF ENTIRE ARRAY BEING OUTPUT JMP IOL06 SELECT ARRAY ENTRY POINT IN FMTR CPA INT NO, SELECT SINGLE ELEMENT ENTRY LDB .IIO. CPA LOG LDB .IIO. CPA DBL LDB .XIO. CPA REA LDB .RIO. JMP IOL08 SPC 1 IOL06 CPA INT SELECT ARRAY ENTRY POINT TO FMTR LDB .IAY. CPA LOG LDB .IAY. CPA DBL LDB .XAY. CPA REA IOL07 LDB .RAY. STB T4IOL SAVE THE '.' FUNCTION OFFSET LDA T0IOL IF THIS IS AN EMA THAT WAS ALREADY MAPPED STA F.A SZA SKIP THE MAP TEST NOW JSB EA?.F ELSE TEST IF AN EMA ARRAY JMP IOL17 NO GO USE STD. CALL * LDB T4IOL GET THE '.' OFFSET ADB K19 INDEX TO THE EMA '.' FUNCTION OFFSET JSB ODF.F SEND THE JSB LDB F.AF GET ADDRESS OF THE EMA OFFSET INB LDA B,I GET LOW ORDER WORD ADB K2 INDEX TO THE HIGH ORDER WORD LDB B,I GET IT CLE,ERB CONVERT TO A RAL,ERA STD. DOUBLE INTEGER JSB DTR.F SEND DEF TO ESTABLISHED REAL CONSTANT DLD T3IOL GET THE NUMBER OF ELEMENTS TO DO CMA,CLE,INA SET NEGATIVE CMB,SEZ DO HIG H HALF INB DON'T FORGET THE CARRY JSB DTR.F SEND A DEF TO IT JMP IOL11 CONTINUE PROCESSING DELIMETER * IOL17 LDB T4IOL GET DOT FUNCTION OFFSET BACK IOL08 JSB ODF.F OUTPUT JSB TO ROUTINE FOR I/O LDB T0IOL JSB SOA.F OUTPUT DEF ELEMENT LDA T3IOL GET THE SIZE (NOP IF COMPUTED) LDB T2IOL CPB ARR IF F.IU = ARRAY, JMP IOL14 OUTPUT SIZE WORD LDA K2 LDB T1IOL CPB CPX IF F.IM=CPX, IOL09 JSB OW.F OUTPUT SIZE WORD OF OCT 2 NOP JMP IOL11 FINISH PROCESSING DELIMITER SPC 1 IOL14 LDB T5IOL GET THE DIRECT DEF FLAG SZB,RSS IF NOT SET JMP IOL09 GO SEND THE SIZE * JSB SOA.F SEND THE DEF ,I STA T5IOL CLEAR THE FLAG FOR NEXT TIME JMP IOL11 * K19 DEC 19 T4IOL NOP * DTR.F NOP DO DEF TO REAL DST F.IDI SET REAL VALUE IN IDI LDA REA MAKE JSB ESC.F A REAL CONSTANT JSB AI.F ASSIGN IT CLA AND SEND JSB OA.F A DEF TO IT JMP DTR.F,I RETURN * SPC 1 IOL10 CPB B50 PROCESS DELIMITER AND CONTINUE. JMP IOL12 LDA LCHAR CPA B51 IF PREVIOUS F.TC = ')' JMP IOL91 SZA,RSS IF START OF LIST JMP IOL92 JMP IOL53 OTHERWISE SYNTAX ERROR SPC 1 IOL91 STB LCHAR LCHAR= ')' CHANGE TO F.TC IOL11 LDB F.TC ON ENTRY AFTER PROCESSING ELEMENT, CPB B51 IS F.TC =')'? JMP IOL13 YES, NEW RECORD AND MATCH PARENS. * CPB B54 NO,IS F.TC = ','? JMP IOL01 YES,SCAN NEXT ITEM IN LIST. * IOL92 CPB B15 IS F.TC = CARRIAGE RETURN? JMP IOL27 YES, FIX UP LOAD ADDRESS POINTERS * IOL53 LDA K53 NO, CONSTRUCTION ERROR: JSB ER.F ILLEGAL DELIMITER * K53 DEC 53 SPC 1 IOL12 STA F.SXF SET TO NON-0 AS A FLAG, STB T0IOL  SAVE F.TC = '(' JSB II.F INPUT NEXT ITEM IN LIST. LDB F.NT (B)= NAME TAG OF NEXT ITEM CPA CPX IS ITS ITEM MODE COMPLEX? SZB,RSS AND IS IT A CONSTANT? RSS NO - IT IS NOT A COMPLEX CONSTANT JMP IOL52 YES - COMPLEX CONSTANT IN LIST. * STA T1IOL SAVE ITEM MODE OF NEXT ITEM. LDA F.A STA T2IOL SAVE F.A IN CASE F.IM#0. LDA F.TC LDB T0IOL STA T0IOL SAVE F.TC JUST INPUT AND STB F.TC RESTORE F.TC ='(' LDA LCHAR IF '(' PRECEDED BY ')' CPA B51 JMP IOL53 ERROR 53 * STB LCHAR JSB NR.F START A NEW RECORD FOR THE '(' LDB KM2 RESERVE TWO TEMPS FOR IMPLIED DO ADB F.INT SO THEY ARE NOT USED DURING STB F.INT ARRAY SUBSCRIPT EVALUATION LDB T0IOL STB F.TC RESTORE NEXT F.TC. LDA T2IOL STA F.A RESTORE F.A TO NEXT ITEM IF NEEDED LDA T1IOL SZA,RSS IF F.IM OF NEXT ITEM IS ZERO JMP IOL10 CONTINUE WITHOUT SCANNING AGAIN. * JSB FA.F OTHERWISE FETCH ITS ASSIGNS LDA F.IM LOAD ITS ITEM MODE JMP IOL51 CONTINUE WITHOUT FURTHER SCAN SPC 1 IOL13 JSB MPL.F START NEW RECORD FOR ')' AND MATCH IT JMP IOL01 SPC 1 * PROCESS IMPLIED DO CONTROL INFO. SPC 1 IOL24 LDA LCHAR SYNTAX CHAR BEFORE INDEX = CPA B54 IF NOT A COMMA, RSS JMP IOL53 ERROR 53 * JSB ITS.F CONTR. VAR. MUST BE INTEGER JSB NCT.F CONTR. VAR. MUST NOT BE CONSTANT JSB TV.F MUST BE VARIABLE LDB F.D POINTS TO FIRST DO TABLE WORD IOL23 CPB F.DO VERIFY UNIQUE CONTROL VAR. JMP IOL26 ALL CHECKED: OK. * ADB K2 LDA B,I CPA F.A JMP IOL32 NOT UNIQUE: ERROR 51. * ADB K3 JMP IOL23 SPC 1 IOL32 LDA K51. JSB ER.F REPEATED IN IM9PLIED DO NEST. * K51. DEC 51 SPC 1 IOL26 LDA F.A PROCESS IMPLIED DO CONTROL INFO STA CONTR SAVE POINTER TO CONTROL VAR. JSB NR.F START NEW RECORD FOR INITIAL. CODE LDA CONTR RESTORE F.A TO POINT TO CONTR VAR STA F.A ISZ F.INT RELEASE THE SAVED TEMPS ISZ F.INT RELEASE THE SAVED TEMPS JSB EE.F GENERATE INIT. CODE FOR I=M1 DEC -2 LDA B54 ',' JSB TCT.F COMMA TEST FOR I=M1, ISZ F.IOF SET F.IOF FLAG JSB EE.F EVALUATE THE EXPRESSION KM4. DEC -4 STA F.M2 STORE POINTER IN F.M2 STA F.A A.T. POINTER TO PARAMETER LDB F.INT SAVE CURRENT TEMP STATUS STB MPL.F SO WE CAN RELEASE LATER JSB ATD.F SAVE TEMP FOR STEP-SIZE PARAM. LDB B54 CPB F.TC IS F.TC A COMMA? RSS JMP IOL22 NO GO DEFINE A 1 * JSB EE.F CALL EXPRESSION EVALUATOR DEC -4 JMP IOL25 SKIP SET UP OF 1 * IOL22 JSB CN1.F BUILD A 1 IOL25 STA F.M3 SAVE POINTER TO STEP-SIZE IN F.M3 STA F.A A.T. POINTER TO PARAMETER LDA MPL.F RELEASE STA F.INT POSSIBLE TEMP SAVED ABOVE CLA STA F.IOF RESTORE F.IOF FLAG LDA B51 STA LCHAR I/O LIST CHAR = ')' JSB TCT.F MAKE SURE F.TC = ')' JSB MPL.F START NEW RECORD, FIND MATCHING '(' LDA A,I GET THE F.A OF THE JUMP TARGET RAL,ERA STORE IN JMPAD F.A,I POINTING TO STA JMPAD BEGINNING OF IMPLIED DO BODY JSB DT.F OUTPUT DO TERMINATION CODE JMP IOL01 SPC 1 MPL.F NOP A ')' FOUND START NEW RECORD AND JSB NR.F THEN CCA FIND THE MATCHING '(' LDB KM2 LOOK DOWN THE STACK ADA F.S2T JSB MP.F MATCH IT JMP MPL.F,I RETURN * * IOL27 CCA FIX UP LOAD ADDRESS A.T. POINTERS ADA F.S2B  INITIALIZE STACK POINTER STA T0IOL IOL28 LDA T0IOL POINT TO ADA K2 NEXT SYNTAX ELEMENT STACKED. STA T0IOL LDB F.S2T CMB,INB ADB A (B) _ STACK POINTER - STACK TOP SSB,RSS PAST TOP? JMP IOL33 YES, DONE PROCESSING LIST LDB A,I FIX UP MORE LOAD ADD. CPB B50 IS SYNTAX A LEFT PAREN? JMP IOL29 YES, FIND MATCHING RIGHT PAREN CPB B51 NO, IS SYNTAX A RIGHT PAREN? JMP IOL31 YES, FILL IN LOAD ADD FOR RECORD. JMP IOL28 NO, MUST BE DO CONTR VAR, SKIP IT SPC 1 IOL29 LDB K2 SEARCH UP THE STACK FOR MATCHING JSB MP.F RIGHT PARENTHESIS. ADA KM3 POINTS TO SYNTAX ELEM. BEFORE ). STA T1IOL LDB A,I IS PREVIOUS SYNTAX ELEMENT AN SSB,RSS IMPLIED DO CONTROL VARIABLE? JMP IOL31 NO, FIX UP LOAD ADD. FOR'(' REC. INA INSERT LOAD ADDRESS FOR RECORD JSB ILA.F CONTAINING DO INITIALIZATION. LDA T1IOL,I (A) = F.A,I TO DO CONTROL VAR. LDB T1IOL (B) = STK2 WORD WHICH CONTAINS(A) IOL30 ADB KM2 NEXT SYNTAX BELOW(B) IN STK2 CPB T0IOL IS NEXT SYNTAX THE ( OF DO BODY? JMP IOL31 YES, INSERT LOAD ADDRESS FOR BODY CPA B,I NO, IS IT IDENTICAL TO CONT. VAR? JMP IOL32 YES, ERROR-REPEATED CONT. VAR. JMP IOL30 NO, LOOK AT NEXT SYNTAX IN STK2. SPC 1 IOL31 LDA T0IOL ADDRESS OF WORD IN STACK2 INA CONTAINING POINTER TO LOAD ADD. JSB ILA.F INSERT LOAD ADDRESS INTO A.T. JMP IOL28 CONTINUE FIXING UP LOAD ADDRS. SPC 1 IOL33 CLA SET NUMBER OF ELEMENTS STACKED STA F.L ON STACK 2 TO 0. LDB F.S2B STB F.S2T JMP IOL.F,I DONE PROCESSING I/O LIST. * T0IOL NOP T1IOL NOP T2IOL NOP T3IOL OCT 0,0 DOUBLE WORD ARRAY SIZE * F.IOF IN INIT-Z AREA T5IOL NOP CONTR NOP PTR TO IMPLIED DO CONTR. VAR. SKP * ********************************* * * MEMORY REFERENCE INSTRUCTIONS * * ********************************* SPC 1 * INSTRUCTION CODE + NON PAGE-0 BIT SET SPC 1 SPC 1 ADDR OCT 70000 F.IM=7 ADDRESS SPC 1 **************************** INDEXS INTO FIX-ENT TABLE ***??? .MPY DEF .TBL+5 FIX-POINT MPY .XIO. DEF .TBL+30 DOUBLE PREC. DATA I/O FOR FRMTR .RIO. DEF .TBL+31 REAL DATA I/O FOR FRMTR .IIO. DEF .TBL+32 INTEGER I/O FOR FRMTR .XAY. DEF .TBL+33 DOUBLE ARRAY I/O FOR FRMTR .RAY. DEF .TBL+34 REAL ARRAY I/O FOR FRMTR .IAY. DEF .TBL+35 INTEGER ARRAY I/O FOR FRMTR ALSI ALS SKP * ************** * * NEW RECORD * * ************** SPC 1 NR.F NOP COMPLETE INFO FOR PREVIOUS LDA F.SRL RECORD (FIND RECORD LENGTH) CMA,INA AND START NEW RECORD. ADA F.RPL STA LDADD,I STORE RECORD SIZE IN ASSIGN TABLE LDA F.RPL ENTRY FOR LOAD ADD. FOR RECORD LDB LDADD IF LDADD = 0, CCE,SZB,RSS STA LRPL SAVE RPL AT START OF FIRST STA F.SRL SAVE BEGINNING OF NEW RECORD. LDA F.TC PUT I/O LIST SYNTAX (, I, ) ON STK CPA B50 IS SYNTAX A LEFT PAREN? JMP PIO01 YES, STACK IT. CPA B51 NO, IS SYNTAX A RIGHT PAREN? JMP PIO01 YES, STACK IT. LDA F.A NO, STACK POINTER TO CONTROL VAR RAL,ERA (A) _ F.A,I. F.A POINTS TO CONT VAR PIO01 JSB PU2.F STACK SYNTAX OF I/O LIST ON STK2 LDA TWPE LOAD F.IM=4 FOR TWO WORD PSEUDO ENT JSB ESC.F ESTABLISH DUMMY A.T.ENTRY JSB AI.F AND ASSIGN IT TO TABLE LDA F.A STACK ON TOP OF I/O LIST JSB PU2.F SYNTAX,THE A.T. POINTER TO THIS LDA F.A CCE,INA SAVE POINTER TO WORD IN ASSIGN STA LDADD TABLE TO HOLD NEXT LOAD ADDRESS. LDA F.A CLB,CCE 6 RAL,ERA SET INDIRECT JSB OW.F OUTPUT LOAD ADDRESS AS AN OCT 20000 R001 JMP NR.F,I ASSIGNMENT TABLE POINTER * LRPL NOP SAVE RPL AT START OF I/O LIST LDADD NOP LOAD ADDRESS- A T POINTER OR RPL SKP * *********************** * * INSERT LOAD ADDRESS * * *********************** SPC 1 ILA.F NOP INSERT LOAD ADDRESS INTO A.T. LDA A,I (A) = ADDRESS OF WORD IN ASSIGN. INA TABLE TO CONTAIN LOAD ADDRESS LDB LRPL PREVIOUS LOAD ADDRESS ADB RECL + LENGTH OF PREV RECORD STB LRPL GIVES NEW LOAD ADDRESS. LDB A,I TAKE LENGTH OF NEW RECORD STB RECL FROM ASSIGN.TAB. AND PLACE IN LDB LRPL RECL FOR USE NEXT TIME. STB A,I INSERT LOAD ADDRESS INTO A. T. JMP ILA.F,I SPC 2 * ********************* * * MATCH PARENTHESES * * ********************* SPC 1 MP.F NOP MATCH PAREN IN STACK 2 STA T0MP LOCATION OF PAREN TO BE MATCHED STB T1MP SEARCH UP STK IS +2, DOWN IS -2 CLB INITIALIZE PAREN COUNTER MP01 LDA T0MP,I WORD 1 OF 2 WORD STACK 2 ENTRY CPA B50 IS SYNTAX '('? INB YES, BUMP COUNT CPA B51 NO, IS SYNTAX ')'? ADB KM1 YES, DECREMENT COUNT LDA T0MP SZB,RSS IS COUNT = 0? JMP MP03 YES, FINISH UP ADA T1MP UPDATE POINTER IN STACK TO STA T0MP POINT TO NEXT SYNTAX ELEMENT CMA,INA ADA F.S2B (A) _ F.S2B - POINTER SSA,RSS PAST BOTTOM OF STACK? JMP MP02 YES. MISMATCH ERROR. LDA T0MP NEGI CMA,INA ADA F.S2T (A) _ F.S2T - POINTER SSA,RSS PAST TOP OF STACK? JMP MP01 NO, CONTINUE SEARCH MP02 LDA K9 YES, MISMATCH ERROR JSB ER.F NO RETURN SPC 1 MP03 CCE,INA ؚ RETURN POINTER TO STK WORD +1 JMP MP.F,I FOR LOAD ADDRESS STARTING RECORD * T0MP BSS 1 T1MP BSS 1 K9 DEC 9 STAI OCT 72000 SKP * ****************************** * * OUTPUT DO TERMINATION CODE * * ****************************** SPC 1 DT.F NOP TERM. CODE FOR I=M1,M2,M3 LDB CONTR SET UP STB F.A ADDRESS OF COUNTR JSB MAP.F IF IN EMA GEN ADDRESS STA CONTR AND RESET VAR. LOCATION LDB A GET LOCATION TO B LDA LDAI 'LDA' JSB SOA.F DT07 LDB F.M3 'ADA F.M3' LDA ADAI JSB SOA.F LDA STAI 'STA' LDB CONTR STA I JSB SOA.F DT08 LDA NEGI CMA,INA JSB OAI.F LDB F.M2 'ADA F.M2' LDA ADAI JSB SOA.F LDB F.M3 (B)=F.M3 LDABI LDA B,I CHECK NAME TAG OF F.A (STEP-SIZE) SSAI. SSA JMP DT0C CONSTANT STEP. LDA LDBI LDB F.M3 (VARIABLE STEP-SIZE) JSB SOA.F LDA SSBI SSB JSB OAI.F LDA NEGI CMA,INA JSB OAI.F DT02 LDA KK62 SSA,RSS (VAR. OR POS. STEP-SIZE) DT03 JSB OAI.F LDA JMP. 'JMP' LDB JMPAD JSB OMR.F JMP DT.F,I * DT0C STB F.A CONSTANT STEP SIZE. ADB K2 GET CONSTANT VALUE ADDRESS LDA B,I GET THE CONSTANT (SIGN AT LEAST) KK62 SSA,RSS JMP DT02 IF POSITIVE (INCREMENT) * LDA SZAI IF NEGATIVE(DECREMENT) SZA JSB OAI.F OUTPUT ABSOLUTE INSTRUCTION LDA SSAI. SSA JMP DT03 SPC 1 * F.M2 NOP F.M3 NOP LDBI OCT 66000 ADAI OCT 42000 SSBI SSB K1 DEC 1 SPC 3 CN1.F NOP DEFINE CONSTANT ONE (1) CLA,INA SET VALUE STA F.IDI IN F.IDI LDA INT MAKE INTEGER JSB ESC.F ESTABLISH CONSTANT JSB AI.F ASSIGN IT LDA F.A RETURN THE ADDRESS OF IT JM;P CN1.F,I SKP * ****************** * * CALL PROCESSOR * * ****************** SPC 1 F.CAL JSB ISY.F INPUT SYMBOL JSB NTI.F MOVE NID TO F.IDI LDB F.DNB GET THE ADDRESS FO THE NAM ADB K3 IN THE NAM RECORD BUFFER LDA F.IDI CPA B,I CHECK FOR RECURSION. INB,RSS MAY BE STEP TO NEXT WORD JMP CALL5 NO SKIP REST * LDA F.IDI+1 CPA B,I INB,RSS STEP TO LAST WORD JMP CALL5 * LDB B,I GET THE LAST WORD LDA K75 SET EORR CODE IN CASE CPB F.IDI+2 JSB ER.F PROG NAME = CALLED NAME CALL5 LDA F.IU CPA SUB RSS JSB TS.F TAG SUBPROGRAM JSB EE.F EVALUATE SUBROUTINE CALL KM1 DEC -1 JMP CRT.F * K4 DEC 4 SUB OCT 200 F.IU=1 SUBPROGRAM SPC 2 * ********************************** * * ASSIGNMENT STATEMENT PROCESSOR * * ********************************** SPC 1 F.ASS JSB II.F INPUT ITEM JSB NCT.F NON-CONSTANT TEST JSB NST.F NON-SUBPROGRAM TEST JSB EE.F EVALUATE ASSIGNMENT STMT. DEC -6 JMP CRT.F SKP * *********************** * * FIX-EXT-TABLE CHECK * * *********************** SPC 1 FXC.F NOP LDA F.A *******************MAY BE ABLE TO USE LDA FIXF SSA,RSS ***IF * WE GET HERE FROM SYMBOL TABEL SCAN (SEE GNA.F) CMA,INA ADA F.DP SSA IN FIX-EXT TABLE? JMP FXC.F,I NO. EXIT LDB F.A ADB K2 LDA B,I IOR KK46 100200 STABI STA B,I SET AF12(F.A)=1 JSB AI.F ASSIGN ITEM JMP FXC.F,I * K49 DEC 49 STRAB OCT 2000 STR-ABS F.AT = UNDEFINED SPC 1 * ******************************** * * STATEMENT FUNCTION PROCESSOR * * ********************************  SPC 1 F.SFP JSB ISY.F INPUT SYMBOL JSB FXC.F FIX-EXT-TABLE CHECK LDA K49 IF THIS IS THE SAME NAME AS THE CURRENT LDB F.SBF SUBROUTINE MODULE CPB F.A THEN JSB ER.F TOO BAD ! * LDA K22 IF ALREADY USED LDB F.AT AS CPB STRAB ANY THING OTHER THAN TYPE RSS NO GOOD SKIP THE ERROR JSB ER.F TOO BAD ALSO! * LDA F.IM STA T1STF SAVE F.IM OF S.F. NAME STA F.DEF SET 'ASF' FLAG LDA F.A STA T0STF SAVE ASSI PTR OF S.F. NAME CLA JSB DIU.F F.IU=0 JSB OLR.F SEND LOAD ADDRESS IN CASE NOT DONE ALREADY * * * ******************** * * INPUT DUMMY LIST * * ******************** SPC 1 * TO PROCESS A LIST OF DUMMY ARGUMENTS FOR: * STATEMENT FUNCTIONS * SUBROUTINES * & FUNCTIONS SPC 1 * ALL NAMES IN THE LIST ARE ENTERED INTO THE ASSIGNMENT * TABLE WITH: * F.IU=0 * F.AT=DUM * AF=RPL SPC 1 * FOR STATEMENT FUNCTIONS, THE OLD ASSIGNMENTS ARE SAVED * SO THAT THEY CAN BE RESTORED AFTER THE STATEMENT * FUNCTION IS PROCESSED. SPC 1 LDA B50 '(' JSB TCT.F F.TC TEST CLA STA F.ARF SET # OF ARG=0 LDB F.RPL STB F.SRL SAVE REL PROGRAM LOCATION LDB F.IM F.IM=CPX OR DBL? CPB CPX RSS CPB DBL JSB OAI.F GENERATE NOP FOR IT IDL02 JSB ISY.F INPUT SYMBOL JSB FXC.F IN FIX-EXT TABLE CHECK LDA F.NT SZA JMP IDL01 * LDB F.D CHECK IF ALREADY IN IDL03 CPB F.DO SAVE TABLE JMP IDL01 NO TABLE IS EMPTY (OR END) * ADB K3 GET F.A OF THIS ENTRY LDA B,I CPA F.A ALREADY IN THE TABLE? JMP IDL00 YES SEND WARNING * INB NO TRY N%EXT JMP IDL03 ENTRY * IDL00 LDA K76 JSB WAR.F DOUBLY DEFINED DUMMY VARIABLES IDL01 LDA K74 74 LDB F.A CPB T0STF JSB WAR.F ASF NAME IN ITS DUMMY LIST LDA KM4. JSB DPO.F SET DATA POOL, CHK OFLOW LDA F.A INA LDA A,I STA B,I (D)=AF(F.A) INB LDA F.AT STA B,I (D+1)=AT(F.A) INB LDA F.IU STA B,I (D+2)=IU(F.A) INB LDA F.A STA B,I (D+3)=F.A CLA JSB DIU.F DEFINE IU(F.A)=0 ISZ F.ARF F.ARF=F.ARF+1 LDA F.RPL JSB DAF.F DEFINE AF(F.A)=RPL LDA DUM JSB DAT.F DEFINE AT(F.A)=DUM CLA GENERATE A JSB OAI.F NOP FOR THIS DUMMY LDA F.TC CPA B54 ',' ? JMP IDL02 YES. GET ANOTHER ARG. LDA B51 ) JSB TCT.F * JSB ICH.F LDA T0STF RESTORE ASSI PTR OF S.F. NAME STA F.A JSB DL.F AF(F.A)=RPL, AT(F.A)=REL LDA F.RPL STA T2STF SAVE LOC. OF S.F. NOP JSB GPE.F GENERATE PROGRAM ENTRANCE LDA O75 '=' JSB TCT.F F.TC-TEST LDB T1STF STB F.IM RESTORE F.IM OF S.F. NAME JSB EE.F EXPRESSION EVALUATOR DEC 0 STFP2 LDB F.D ADB K3 LDA B,I RESTORE ASSI PTR STA F.A ADB KM1 LDA B,I RESTORE F.IU JSB DIU.F LDB F.D INB LDA B,I RESTORE AT JSB DAT.F LDA F.D,I LDB F.A INB STA B,I RESTORE F.AF LDA F.D ADA K4 STA F.D F.D=F.D+4 CPA F.DO END OF DO TBL REACHED? RSS JMP STFP2 NOT YET LDA T0STF STA F.A F.A=ASSI PTR OF STMENT FUNC NAME LDA IJMP. 'JMP,I' JSB OA.F OUTPUT OA JSB FA.F FETCH ASSIGNS LDB F.IU SZB JMP STFP4 ݚTRN JSB TS.F TAG SUBPROGRAM STFP3 LDA T2STF JSB DAF.F SET S.F. NOP LOC INTO A.F. OF S.F. JMP CRT.F C/R TEST SPC 1 STFP4 CPB VAR JMP STFP6 LDA K75 JSB WAR.F RECURSION JMP STFP3 * STFP6 LDA K25. JSB WAR.F VARIABLE USED AS SUBROUTINE LDA SUB JSB DIU.F SET F.IU=SUB JMP STFP3 SPC 1 T0STF NOP SAVE ASSI PTR OF STMT FUNC NAME T1STF NOP T2STF NOP KK46 OCT 100200 O75 OCT 75 VAR OCT 400 F.IU=2 VARIABLE IJMP. OCT 126000 LDAI OCT 62000 K25. DEC 25 K75 DEC 75 SPC 2 * RPLOV LDA K84 OUT OF MEMORY JMP F.ABT ABORT THE COMPILE * K76 DEC 76 K74 DEC 74 K84 DEC 84 DUM OCT 5000 AT=5 ORG * END HTASMB,Q,C HED INPUT GROUP FOR FTN4 COMPILER NAM IC.F,8 92060-16092 780131 * * THIS MODULE CONTAINS THE CARD,CHARACTER,AND ITEM INPUT ROUTINES * * * * * * *************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * * REPRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * *************************************************************** * * * * * * EXT'S WITH A LEADING 'F.' ARE VARIABLES OR JUMP TARGETS * * THE COLUMN THE EXT STARTS IN DEFINES THE SUBROUTINE IT IS * DEFINED IN AS FOLLOWS * 2 -- OA.F (WRITE PASS FILE ROUTINES) * 3 -- NEX.F (STATEMEXTS THAT DON'T CONTAIN EXPRESSIONS) * 4 -- FA.F (THE ASSIGNMEXT TABLE ROUTINES) * 5 -- EX.F (STATEMEXTS USING THE EXPRESSION EVALUATOR) * 6 -- IC.F (THE CHARACTER INPUT ROUTINES) * 7 -- IDN.F (THE TOKEN INPUT ROUTINES) * 8 -- FTN4 ( THE MAIN) EXT F..DP BASE OF SYMBOL TABLE EXT F..E DIMENSIONS CONSTANT BIT FROM ASSIGNS TABLE EXT F.A ASSIGNMEXT TABLE ADDRESS (CURRENT ENTRY) EXT F.ASS ASSIGNMEXT STATEMEXT PROCESSOR ENT F.ABT ABORT COMPILE EXTRY EXT F.ACC TEMP ACCUMULATOR FLAG EXT F.AF ADDRESS FIELD CURREXT F.A EXT F.ARF NO. OF SUB. FUN. ARGUMEXTS EXT F.ASP ASSIGN STMT. PROCESSOR EXT F.AT ADDRESS TYPE OF CURREXT F.A EXT F.AT. SUBSCRIPT INFO FLAG EXT F.BGN RETURN FROM F4.0 EXT F.BSP BACKSPACE STMT. PROCESSOR EXT F.BUF A BUFFER EXT F.C OFFSET FOR CURRENT MR INSTRUCTION EXT F.CAL CALL STATEMEXT PROCESSOR ENT F.CC CHARACTER COUNT EXT F.CCW FTN [OPTION WORD ENT F.CIN CURREXT CI BUFFER LINE NUMBER ENT F.CLN INPUT ITEM CURREXT LINE # EXT F.CON CONTINUE STMT. PROCESSOR EXT F.CSZ COMMON SIZE EXT F.D DO TABLE POINTER EXT F.D.T ADDRESS OF '.' FUN. TABLE EXT F.D0 ARRAY ELEMEXT SIZE EXT F.D1 DIMENSION 1 EXT F.D2 DIMENSION 2 EXT F.D3 DIMENSION 3 EXT F.DCF DIM, COM FLAG EXT F.DEF DATA EXISTS FLAG EXT F.DID ADDRESS OF F.IDI ENT F.DLF DELIMETER FLAG EXT F.DNB DEF OF NBUF (NAM RECORD) EXT F.DNI ADDRESS OF NID EXT F.DO LWAM - END OF DO TABLE EXT F.DOP DO STATEMEXT PROCESSOR EXT F.DP BASE OF USER SYMBOL TABLE EXT F.E EQUIVALENCE TABLE POINTER EXT F.EFG E - FLAG - SET IF SUBSCRIPT IS DUMMY EXT F.EFP ENDFILE STMT. PROCESSOR EXT F.EMA F.A OF EMA EXT ENTRY, WINDOW SIZE EXT F.EMS EMA SIZE DOUBLE WORD, (INTERNAL FORMAT) EXT F.END END FLAG ENT F.EQE EQUVALENCE ERROR FLAG EXT F.EQF EQUIVALENCE FLAG EXT F.ER0 'RX' OF ERRX LIB ERROR ROUTINE ENT F.ERF ERROR FLAG (# OF ER.F CALLS) ENT F.ERN ERROR ARRAY EXT F.EXF EXTERNAL STATEMEXT FLAG EXT F.FMT FORMAT STMT. PROCESSOR EXT F.GOP GO TO STATEMEXT PROCESSOR EXT F.IDI INPUT ARRAY NON-NUMERIC EXT F.IFF IF FLAG EXT F.IFP IF STATEMEXT PROCESSOR EXT F.IM CURREXT ITEM MODE (REAL, COMPLEX,ECT.) EXT F.INT TEMP VARIABLE ARRAY EXT F.IOF INDICATOR FOR I/O INDEX EVALUATOR EXT F.IU CURREXT ITEM USAGE (DUM., RELATIVE, ECT.) ENT F.HDL LENGTH OF HEAD MESSAGE EXT F.L # WORDS ON STACK 2 ENT F.LFF LOCICAL IF FLAG EXT F.LLO CURRENT RELOCATAION ADDRESS(TWO WORDS) EXT F.LLT ADDRESS OF LINE LOCATION TABLE (SET BY INIT) 1e EXT F.LO END OF ASSIGNMEXT TABLE+1 ENT F.LOP NO. LINES LEFT ON THIS PAGE. ENT F.LPR ( LOC OF EQUIVALENCE GROUP EXT F.LSF EXPECT FIRST STATEMEXT FLAG EXT F.LSN F.A OF LAST STATEMEXT NUMBER EXT F.LSP LAST OPERATION FLAG EXT F.MFL TYPE STMT. MODE FLAG EXT F.NC NAME CHANGE FLAG. ENT F.NCR NO CROSS REF FLAG EXT F.ND NUMBER OF DIMENSIONS EXT F.NEQ # OF EQUIVALENCE GROUPS EXT F.NT NAME TAG 0= VAR, 1=CONSTANT. EXT F.NTF NAME TAG FLAG EXT F.NW NO. WORDS THIS TABLE F.A EXTRY. ENT F.NXN NO INPUT FLAG ENT F.OFE DATA POOL OVERFLOW ERROR EXTRY. EXT F.OPF OUTPUT PACK FLAG EXT F.R JSB ERR0 FLAG EXT F.PAK PACK BUFFER WORD EXT F.PAP PAUSE STMT. PROCESSOR EXT F.RDP READ STATEMEXT PROCESSOR EXT F.REL SUB. PROG. RETURN LOCATION EXT F.RPL PROGRAM LOCATION COUNTER ENT F.RPR ) LOC OF EQUIVALENCE GROUP EXT F.RTN RETURN STMT. PROCESSOR EXT F.RWP REWIND STMT. PROCESSOR EXT F.S02 RETURN FORM RCOM F.1 EXT F.S03 LOAD F.1 AND PASS CONTROL EXT F.S1B BOTTOM OF STACK 1 EXT F.S1T TOP OF STACK 1 EXT F.S2B BOTTOM OF STACK 2 EXT F.S2T TOP OF STACK 2 EXT F.SBF 0= MAIN, ELSE SUBROUTINE EXT F.SCC SAVE F.CC EXT F.SEE RETURN FROM F4.1 EXT F.SEG LOAD A NEW SEGMENT EXT F.SFF SUBROUTINE/FUNCTION FLAG 0/1 EXT F.SFP STATEMEXT FUNCTION PROCESSOR EXT F.SID STATEMEXT ID PHASE FLAG EXT F.SLF STATEMEXT LEVEL FLAG EXT F.SPF SPECIFICATION FLAG SET TO CURREXT STMT. LEVEL EXT F.SPS STATEMEXT PROCESSOR SWITCH EXT F.SRL SAVE RPL AT BEGINNING OF RECORD EXT F.STA FLAG THAT IS ZERO UNTIL THE FTN STATEMEXT IS READ EXT F.STB STRING BACK JUMP FLAG EX5T F.STP STOP STMT. PROCESSOR EXT F.STS TO STATEMEXT SCAN ENT F.SVL SAVE # WORDS ON OPER STACK (F.L) EXT F.SXF COMPLEX CONSTANT FLAG EXT F.T # WORDS ON STACK 1 EXT F.TAC ? ENT F.TC NEXT CHARACTER ENT F.TIM TIME ARRAY ADDRESS IN HEAD ENT F.TRM TERMINATE COMPILE EXT F.TYP TYPE STATEMEXT FLAG EXT F.WRP WRITE STATEMEXT PROCESSOR EXT F.X1 F.A OF F.D1 EXT F.X2 F.A OF F.D2 EXT F.X3 F.A OF F.D3 * * EXT'S WITH A TRAILING '.F' ARE SUBROUTINES * EXT AA.F ASSIGN ADDRESS SUB. EXT AI.F ASSIGN ITEM ENT ASC.F CONVERT TO 4 ASCII DIGITS EXT BNI.F CLEAR NID TO BLANKS ENT BOM.F DISASTOR ERROR REPORT (NO RETURN) EXT CID.F CLEAR F.ID ARRAY EXT CDI.F CLEAR IDI ROUTINE ENT CRP.F CROSS REF PAIR SUB. EXT CRT.F TEST FOR CARRAGE RETURN EXT DAF.F DEFINE (F.AF) EXT DAT.F DEFINE (AT) EXT DIM.F DEFIND (F.IM) EXT DIU.F DEFINE (F.IU) EXT DL.F DEFINE LOCATION SUBROUTINE ENT EJP.F PAGE EJECT SUBROUTINE ENT ER.F ERROR PRINT SUBROUTINE EXT ESC.F ESTABLISH CONSTANT SUBROUTINE EXT ESD.F ESTABLISH DEF SUBROUTINE ENT EXN.F EXAMINE NEXT CHARACTER EXT FA.F FETCH ASSIGNS EXT FID.F FETCH (ID) TO NID (UNPACK) EXT FNS.F FIRST NOT SPEC. STMEXT CHECK EXT FXC.F CHECK IF SUB. IN FIX-EXT TABLE EXT GNA.F GET NEXT SYMBOL TABLE EXTRY EXT GPE.F GENERATE SUB. PROG. EXTRANCE ENT IA.F INPUT (A) CHARACTERS SUBROUTINE ENT IC.F GET NEXT CHARACTER ENT ICH.F GET NEXT NON BLANK CHAR. AND TYPE IT EXT IDN.F INPUT DO NOT ASSIGN (GET NEXT OPERAND) EXT IDS.F INPUT DIGIT STRING EXT IFT.F IF GOTO COMPLETION ENT II.F INPUT ITEM ENT ~R IIV.F INPUT INTEGER VARABLE EXT IN2.F INIT FOR OA.F MODULE EXT IN3.F INIT FOR ENX.F MODULE EXT IN4.F INIT FOR FA.F MODULE EXT IN5.F INIT FOR EX.F MODULE ENT IN6.F INIT FOR IC.F MODULE EXT IN7.F INIT FOR IDN.F MODULE ENT INM.F INPUT NAME ENT IOP.F INPUT OPERATOR ENT ISN.F INPUT STATEMEXT NUMBER ENT ISY.F INPUT SYMBOL EXT ITS.F INTEGER TEST ENT MCC.F RESET TO FIRST COLUMN OF STATEMEXT ENT MPN.F MOVE PROGRAM NAME (TO NAM RECORD ECT.) EXT NEW.F SUB TO CLEAR TEMPS FOR A NEW MODULE EXT NCT.F TEST FOR NOT A CONSTANT EXT NST.F TEST FOR NOT A SUBROUTINE NAME EXT NTI.F MOVE NID TO F.IDI (PACKS) EXT NWI.F SET F.D0 TO # WORDS IN ARRAY EXT OA.F OUTPUT ASSIGNMEXT TABLE OPERAND EXT OAI.F OUTPUT ABS. INSTRUCTION EXT OC.F OUTPUT CONSTANT EXT ODF.F OUTPUT DOT FUNCTION EXT OLR.F OUTPUT LOAD ADDRESS EXT OMR.F OUTPUT MEMORY REF. INSTRUCTION EXT OS.F OUTPUT SECTOR TO INTERPASS FILE EXT OW.F OUTPUT WORD EXT OZ.F OUTPUT ZREL (OP *+N) EXT PAK.F PACK SUBROUTINE EXT PDF.F PRODUCE DEF SUBROUTINE ENT PSL.F PRINT LINE ON PRINTER EXT PTM.F PROGRAM TERMINATION CODE GEN. EXT RTN.F SUBROUTINE RETURN HANDLER EXT RP.F INPUT ')' EXT SCC.F SAVE F.CC SUBROUTINE ENT SCP.F SAVE CURREXT STATPMEXT POSITION. ENT SKL.F SKIP LINES ON LIST ENT SNC.F START NEXT CARD SUBROUTINE EXT SOA.F STORE AND OUTPUT (OA.F) EXT TDO.F DO TERMINATION CODE GENERATOR EXT TCT.F TEST (A) = F.TC ELSE ER 28 EXT TS.F TAG SUBPROGRAM SUB. EXT TV.F TAG VARIABLE ENT UC.F UNINPUT COLUMN ENT WAR.F ERROR COMMEXT SUBROUTINE (WARNINGS) * * COMPILER LIBRARY ROUTINES USoED * EXT C.SAU SOURCE FCB EXT C.LST LIST FCB EXT RED.C READ ROUTINE EXT SPC.C SPACE ROUTINE EXT WRT.C WRITE FILE ROUTINE EXT C.SC1 SCRATCH FILE FCB EXT C.SC0 SCRATCH FILE FCB EXT RWN.C REWIND ROUTINE * * LIBRARY ROUTINES * EXT .MVW EXT IFBRK * SUP * A EQU 0 B EQU 1 * F.NXN NOP NO INPUT FLAG B15 OCT 15 CARRAGE RETURN (USED AS END OF LINE) FTNF OCT 1 B377 OCT 377 B40 OCT 40 K45 DEC 45 * * INITIALIZE THIS MODULE * IN6.F NOP STB CRD#1 SET CARD BUFFER POINTER ADB K45 FOR BOTH BUFFERS STB CRD#2 SSA IF CALL JUST TO MOVE THE CARD BUFFERS JMP IN6.1 SKIP UNRELATED GARBAGE * SZA IF A NEW # LINES PER PAGE STA LINEP SET IT CLB,SEZ,INB,RSS IF A NEW COMPILE JMP NOTNW NO * STB FTNF SET THE FTN FLAG JSB RWCDF IF NEW COMPILE ALSO SET STA CD#F CARD FILE TO ZERO STA CD#1 AND CLEAR THE LOCAL CARD BUFFERS STA CD#2 ALSO SET STA PGNUM THE PAGE NUMBER BACK TO ZERO CCA AND SET STA F.LOP TO FOURCE A PAGE EJECT NOTNW LDA KM32 SET XREF COUNTER STA NWRDS LDA DEFCR AND BUFFER POINTER STA LWORD CLA CLEAR THE NO. CARDS IN STA FIRST SET FIRST FLAG IN6.1 CLA ENTRY FOR BUFFER MOVE ONLY STA CD# TO ZERO LDB DCD#1 SET UP BUFFER JSB SETCA NO. ONE INCASE SNC.F CALLED FIRST CLA,INA STA LIFCC INITIAL COLUMN COUNTER JMP IN6.F,I RETURN SKP F.LFF NOP T0IC NOP K73 DEC 73 DCD#1 DEF CRD#1 DEF TO CARD BUFFER ADDRESSES SPC 2 * **************** * * INPUT COLUMN * * **************** SPC 1 IC.F NOP LDB F.EQF IF IN EQUIV GROUP SSB SKIP CAR!D TEST LDB CD# IF CURRENT CARD IS ZERO SZB,RSS THEN THERE IS NONE SO JMP IC02 GO FIND ONE * LDB F.CC COLUMN COUNTER CPB K73 END OF CURRENT CARD? JMP IC10 YES, GET ANOTHER * SZB CHARACTER OBTAINED? JMP IC18 NO. FETCH FROM BUFFER * IC00 LDA B15 (A)=C/R IC04 ISZ F.CC F.CC=F.CC+1 IC06 STA F.TC C/R, /, OR CHAR. FROM CARD OR EQU BUFFER JMP IC.F,I EXIT * IC10 LDB F.NXN NO INPUT FLAG SET? LDA B15 SZB JMP IC06 YES - SEND C/R * IC02 ISZ CD# BUMP THE CARD NUMBER LDA CD# GET THE REQUIRED CARD NUMBER LDB K7 SET THE COLUMN COUNTER CPA K1 BASED ON THE CARD NUMBER LDB LIFCC FIRST CARD OF STMT. MAY START ELSE WHERE STB F.CC SET IT LDB DCD#1 PICK A DEF TO BUFFER # 1 CPA CD#1 REQUIRED CARD IN BUFFER 1? JMP INC YES GO SET IT UP * ADB K2 INDEX TO THE NEXT BUFFER CPA CD#2 REQUIRED CARD IN BUFFER # 2? JMP INC YES GO SET IT UP * LDA CD#1 CARD IS NOT IN MEMORY SO CMA,INA FIGURE WHICH BUFFER WE WILL USE ADA CD#2 USE ONE WITH LOWEST NUMBERED CARD IN IT SSA,RSS B CURRENTLY POINTS AT BUFFER 2 SO ADB KM2 ADJUST IF IT IS TO BE 1. JSB SETCA SET UP THE BUFFER ADDRESSES ECT. * LDA CD#P GET THE CURRENT FILE COUNT INA DOES THE BUFFER CONTAIN CPA DCD#,I THE NEXT CARD TO BE PUT IN THE CARD FILE? CLA,INA,RSS YES MUST WRITE IF .... JMP IC07 NO CARD NEED NOT BE WRITTEN * CPA CD# ... FIRST CARD OR ... JMP IC03 (IT IS FIRST CARD) * LDA F.SID ... STILL SCANNING. SZA,RSS WELL...?? JMP IC07 NO CARD NEED NOT BE WRITTEN * IC03 JSB WRT.C WRITE THE CARD IN THE DEF C.SC0 CARD FILE DEF CBA,4I SO WE CAN GET IT BACK DEF K42 JMP PASER IF ERROR ABORT * ISZ CD#F STEP THE COUNT OF CARDS IN THE FILE ISZ CD#P AND THE CURRENT POSITION * IC07 LDA CD# NOW WE KNOW WHERE TO PUT IT SO FIGURE OUT CMA,INA WHERE TO GET IT ADA CD#F GET FROM SCRATCH FILE IF IT CONTAINS THE SSA,RSS THE REQUIRED NUMBER WELL? JMP INF YES GO READ IT IN * JSB RD.F READ A NEW CARD JMP IC08 GO CHECK FOR EOS ECT. * * INC JSB SETCA SET UP THE CURRENT BUFFER JMP IC08 AND GO CHECK FOR EOS ECT. * * SETCA NOP SET UP BUFFER POINTER ROUTINE LDA B,I GET POINTED TO ADDRESS STA LINOL SAVE THE LINE NUMBER LOCATION IN THE BUFFER ADA K3 INDEX TO THE BUFFER ADDRESS STA CBA SET CURRENT BUFFER ADDRESS ADA K40 INDEX TO CARD LENGTH AREA STA CICNT SET POINTER INA NOW SET UP THE STA MLIN LINE COUNT LOCATION INB SET THE LOCAL STB DCD# POINTER TO THE CARD NUMBER JMP SETCA,I RETURN * EOSF NOP FIRST NOP CRD#1 DEF * CONFIGURED BY INIT ROUTINE CD#1 NOP CARD NUMBER (WITHIN STATEMENT) FOR BFR #1 CRD#2 DEF * CONFIGURED BY INIT ROUTINE CD#2 NOP CARD NUMBER (WITHIN STATEMENT) FOR BFR #2 CD# NOP CURRENT CARD NUMBER DCD# NOP POINTER TO CURRENT CARD BUFFER CARD NUMBER K1 DEC 1 CD#F NOP CD#P NOP SKP * ********************** * * CARD IMAGE INPUT * * ********************** SPC 1 RD.F NOP READ ROUTINE RD00 JSB IFBRK CHECK IF HE HAS HAD ENOUGH DEF *+1 SSA WELL JMP BREAK YES GO QUIT * JSB RED.C READ SOURCE FILE DEF C.SAU CBA NOP DEF K40 80 CHARACTERS JMP F.TRM ERROR ON READ ERROR 67 * STA MLIN,I SAVE THE LINE CO,UNT FROM READ STB CICNT,I SAVE WORD COUNT IN WD 41 OF CI SSB IF EOF JMP F.TRM GO WRAP IT UP * STB A CMB COMPUTE NO OF WORDS ADB K40 LEFT IN THE CARD BUFFER SSB IF NONE JMP IC134 SKIP FILL * STB T0IC SAVE COUNT ADA CBA ADDRESS OF FIRST UNUSED WORD LDB LINO FILL WITH STB A,I BLANKS STA B SET TO MOVE REST INTO PLACE INB A= FROM B= TO JSB .MVW MOVE WORDS DEF T0IC NOP IC134 JSB PSI.F PRINT THE CARD LDA MLIN,I GET THE COUNT PASSED IN SSA IF NEGATIVE JMP RD06 TREAT CARD AS A COMMENT * LDA CD# STUFF THE CURRENT CARD NUMBER STA DCD#,I IN THE BUFFER FLAG JSB SOU.F PUT IN PASS TWO FILE IF 'M' OPTION LDA CBA,I CPA KK10 IF CARD STARTS WITH '$ ' JMP F.TRM GO WIND IT UP * AND KK07. (A)HI=1ST CHAR. OF CARD BUFFER CPA KK08 IS IT A 'C' ? JMP RD06 YES, A COMMENT CARD * CPA "D" OPTIONAL CARD? JMP RD05 YES GO CHECK IF OPTION ENABLED * CPA KK09 IS IT A '$' ? JMP IC14B YES, MAY BE A CONTROL CARD PASSIT * LDB FTNF FTN FLAG SET? (IT IS 1 IF SO) SZB JMP IC141 YES. PRINT CONTROL CARD * RD04 ISZ FIRST STEP THE CARD NUMBER LDA CBA COMPUTE ADDRESS ADA K2 OF THE SIXTH COLUMN LDA A,I AND GET IT AND B377 (A)LO=CI(6) LDB K7 7 CPA B60 CLB,INB,RSS "0". CPA B40 CLB,INB,RSS CLA,RSS SET EOSF (END OF STATEMENT FLAG) IC14B LDA CD# TO ZERO (NOT END) OR CARD # IF END IC14 STA EOSF STB F.CC SET THE COLUMN POINTER CLB,INB IF FIRST CARD CPB FIRST AND SZA CONTINUED JMP RD.F,I NOPE IT IS OK * ! STA FIRST RESET FIRST SWITCH LDA K90 FIRST STMT. IS CONTINUED JSB ER.F BITCH SPC 1 IC141 CLA IF HERE THEN B=1 STA FTNF CLEAR THE FTN FLAG JMP IC14 * RD05 XOR CBA,I ISOLATE THE NEXT CHAR IOR BLNK PUT BLANK IN HIGH PART STA CBA,I PUT BACK IN BUFFER LDA F.CCW CHECK THE D BIT AND B100 SZA SKIP IF TO BE TREATED AS COMMENT JMP RD04 D IS SET TREAT AS STD. STMT. * RD06 CLB COMMENT CARD STB F.END CLEAR THE END SWITCH JMP RD00 AND READ ANOTHER CARD * "D" OCT 42000 BLNK OCT 20000 SPC 1 * INF LDA CD# CHECK IF A REWIND IS NEEDED CMA,INA IT IS IF REQUESTED CARD IS ADA CD#P LESS THAN OR EQUAL TO CURRENT POSITION SSA,RSS WELL? JSB RWCDF YES REWIND THE CARD FILE JSB RED.C READ CARD FROM THE SAVE FILE DEF C.SC0 DEF CBA,I DEF K42 JMP PASER ABORT IF ERROR * ISZ CD#P STEP THE CURRENT POSITION ON THE SAVE FILE LDA CD#P CHECK IF THIS IS THE REQUIRED CARD CPA CD# WELL? CLB,RSS YES SKIP OUT JMP INF NO READ AGAIN * STA DCD#,I SET BUFFER FLAG TO SHOW CARD IS HERE * IC08 LDA MLIN,I GET THE CURRENT LINE NUMBER STA F.CIN SET FOR XREF WORD LDA EOSF CHECK IF THIS IS THE END OF STATEMENT CARD CPA CD# WELL? CLA,RSS YES SET UP TO SEND A C/R JMP IC18 NO GO GET A CHARACTER * STA F.CC END OF STATEMENT SET F.CC TO ZERO AND JMP IC00 GO PICK A C/R (F.CC WILL BE STEPPED) * * GET CHARACTER FROM CARD OR EQU BUFFER SPC 1 IC18 CCB ADB F.CC BRS (B)=(F.CC-1)/2 LDA F.EQF IS IT IN EQUIVALENCE BUFFER SSA,RSS JMP IC26 YES, GET CHAR. FROM EQU BUFFER ADB CBA (B)=LOC. OF WORD CONTAINING CHAR. LDA B,I (A)=WORD CONTAINING CHAR. JMP IC20 SPC 1 IC26 CCA ADA F.EQF EQUIV BUF POINTER LDB F.CC SLB,RSS STA F.EQF F.CC EVEN ADA F.E ADDR OF END OF EQUIV TABLE LDA A,I IC20 LDB F.CC SLB ALF,ALF F.CC ODD, (A)LO=LEFT CHAR. AND B377 JMP IC04 GO EXIT SPC 1 * HERE ON "END$" TO WRAP IT UP. * F.TRM LDA K67 LDB F.END F.END SET? SZB,RSS F.ABT JSB BOM.F NO. ERR 67: '$' OCCURS BEFORE 'END' EXIT LDB K4 GO TO STB F.STA SEGMENT JMP F.SEG 4 TO COMPLETE * BREAK LDA K96 SEND THE BREAK ERROR MESSAGE JMP F.ABT AND EXIT * K96 DEC 96 SPC 1 F.CC NOP CARD COLUMN F.TC NOP LAST CHARACTER F.CSW NOP LIMIT SW (DON'T READ NEW CARD IF SET) K7 OCT 7 KM7 DEC -7 K2 DEC 2 K40 DEC 40 K67 DEC 67 K90 DEC 90 KK07. OCT 177400 KK08 OCT 41400 'C' IN HIGH ORDER BITS KK09 OCT 22000 '$' IN HIGH ORDER BITS KK10 ASC 1,$ '$ ' B100 OCT 100 SPC 1 LINO ASC 1, BLANKS FOR FILL ROUTINE CICNT NOP CI BUF WDCNT; MUST FOLLOW CI! MLIN NOP MASTER BUFFER LINE NUMBER MUST BE WD 42 F.CIN NOP CURRENT LINE NUMBER SKP * ********************* * * PRINT SOURCE LINE * * ********************* SPC 1 * ENTRY: (A)=BUFFER LOCATION * (B)=NO. OF WORDS TO BE PRINTED * PRINTS SPECIFIED TEXT, PRECEDED BY PAGE HEADER * AND TWO BLANK LINES IF AT TOP OF PAGE. TEXT IS * PRECEDED BY A WORD OF BLANKS FOR LPT FORMAT CONTROL. * PSL.F NOP STA PBFL SAVE NO. OF WORDS TO BE PRINTED STB PBFP SAVE TEXT ADDR LDA F.LOP INA,SZA,RSS AT BOTTOM OF PAGE? JSB EJP.F YES. FORMFEED LDA F.LOP SZA,RSS AT TOP OF FORM? JSB PHEDR YES. PRINT HEADER ISHFBZ F.LOP JSB WRT.C WRITE THE LINE DEF C.LST THE FCB PBFP DEF PBFP THE BUFFER DEF PBFL IT'S LENGTH JMP EXIT NOTHING TO DO BUT EXIT IF ERROR ON LIST * JMP PSL.F,I OK RETURN * EJP.F NOP CLB CPB F.LOP AT TOP OF PAGE? JMP EJP.F,I YES. IGNORE * LDA F.LOP GET NUMBER LEFT ON THE PAGE STB F.LOP SET NUMBER LEFT TO ZERO ADA KM6 SET TO SKIP 6 EXTRA ON TTY'S LDB F.CCW GET THE OPTION WORD BLF,BLF TEST IF TTY FORMAT DESIRED SSB,RSS IF NOT LDA KM2 REPLACE FORM FEED WITH SPC TWO LINES FOR CRT'S. JSB SKPCL CALL COMP. LIB. SKIP ROUTINE JMP EJP.F,I RETURN * SKL.F NOP SKIP (A)+1 LINES ON LPT LDB F.LOP SZB,RSS AT TOP OF PAGE? JMP SKL.F,I YES. IGNORE. (SHOULDN'T GET HERE) * INA ADB A SSB TEST IF NEAR BOTTOM JMP SKPBN NOT NEAR BOTTOM. * JSB EJP.F AT BOTTOM; DO FORMFEED INSTEAD JMP SKL.F,I dDH* SKPBN STB F.LOP JSB SKPCL COMP. LIB. SKIP ROUTINE JMP SKL.F,I * SKPCL NOP ROUTINE TO SKIP ACCORDING TO A STA MCC.F SAVE A JSB SPC.C CALL COMP. LIB. SKIP ROUTINE DEF C.LST DEF MCC.F PRAMETER NOP IGNOR SKIPING ERRORS JMP SKPCL,I RETURN * PBFL NOP # OF WDS TO BE PRINTED * * PHEDR NOP AT TOP OF PAGE; PRINT HEADER ISZ PGNUM LDA PGNUM JSB ASC.F STA F.HDL+5 STB F.HDL+4 JSB WRT.C WRITE HEADER. DEF C.LST LIST FCB DEF F.HDL+1 ADDRESS OF HEAD DEF F.HDL LENGTH OF HEAD JMP EXIT EXIT IF LIST ERROR * LDA K2 SKIP TWO LINES JSB SKPCL LDA LINEP CMA,INA STA F.LOP JMP PHEDR,I * LINEP NOP F.LOP NOP PGNUM NOP HEDML NOP * F.HDL ASC 7, PAGE 0001 HEADN ASC 3,FTN. PROG NAME F.TIM NOP OPSYS PUT TIME MSG HERE ASC 20, * SKP * ********************** * * PRINT SOURCE IMAGE * * ********************** SPC 1 PSI.F NOP LDA MLIN,I CARD COUNT SSA IF NEGATIVE CMA,INA SET POSITIVE JSB ASC.F CONVERT TO ASC.FI CHARS SWP SWITCH SO WE CAN USE THE DST DST LINOL,I SET IN THE CURRENT BUFFER LINOL EQU *-1 CONFIGURED BY BUFFER SET ROUTINE LDA F.CCW CHECK IF WE ARE TO LIST IT SLA,RSS WELL? JMP PSI.F,I NO RETURN NOW * LDA CICNT,I # OF WORDS IN IMAGE ADA K3 LDB LINOL LOC OF LINE # JSB PSL.F LIST THE CARD JMP PSI.F,I RETURN SPC 2 K42 DEC 42 K4 DEC 4 SPC 2 * **************************** * * SET UP TO RESCAN THE STMT * * **************************** SPC 1 MCC.F NOP CLA SET THE CURRENT CARD TO ZERO STA CD# TO FOURCE RESCAN STA F.H~SID CLEAR THE SCAN SWITCH LDB LIFCC GET START OF CARD COLUMN CPB K1 IF IT IS 1 THEN LDB K7 CHANGE TO 7 (STMT. # PICKED ON FIRST SCAN) STB LIFCC SET THE INITIAL COLUMN JMP MCC.F,I RETURN SPC 1 * ********************************************* * * SET CURRENT POSITION AS START OF STATEMENT* * ********************************************* * SCP.F NOP LDA CD# GET THE NUMBER OF THE NEW FIRST CARD LDB F.CC ALSO SAVE THE COLUMN POSITION JSB CCB.F CLEAR THE CARD BUFFER JMP SCP.F,I RETURN SPC 1 LIFCC NOP * * **************************** * * SET UP FOR NEW STATEMENT * * **************************** * SNC.F NOP SCN1 LDA EOSF IF LAST CARD OF PRIOR STMT. SZA NOT READ JMP SCN2 * ISZ CD# STEP THE CARD NUMBER AND JSB RD.F READ JMP SCN1 UNTIL IT IS READ * SCN2 CLB,INB SET THE RESET LOCATION JSB CCB.F CLEAR THE CARD BUFFER CLA STA EOSF CLEAR THE END OF STMT. FLAG LDA MLIN,I GET LINE NUMBER STA F.CIN AND MAKE SURE IT IS RIGHT JMP SNC.F,I RETURN SPC 2 RWCDF NOP ROUTINE TO REWIND THE CARD FILE JSB RWN.C REWIND THE CARD FILE DEF C.SC0 AND CLEAR ITS COUNTS JMP PASER ABORT IF ERROR * CLA STA CD#P RESET THE CURRENT POSITION POINTER JMP RWCDF,I RETURN * * CCB.F NOP ROUTINE TO CLEAR THE CARD FILE AND BUFFERS STB LIFCC SET THE RESET COLUMN CLB,CLE SET THE NO CARD PRESENT FLAG IN B STB CD# SET INITIAL CARD NUMBER CPA CD#1 IS THIS CARD IN BUFFER 1 OR 2? CCE IT IS IN 1 CLA,SEZ,INA,RSS ARRANGE AN INITIAL CARD # FLAG SWP SWAP IF NEEDED STA CD#1 THE FLAGS STB CD#2 AS REQUIRED JSB RWCDF REWIND THE CARD BUFFER STA CD#F CLEAR ITS COUNT ISZ F.SID SET THE SCAN SWITCH JMP CCB.F,I RETURN * K10 DEC 10 SKP * ***************************************** * * CROSS REFERENCE INFORMATION OUTPUT * * ***************************************** SPC 1 CROUT NOP LDB DEFCR CPB LWORD JMP CROUT,I BUFFER IS EMPTY. * CLA STA LWORD,I FLAG END OF BUFFER JSB WRT.C WRITE THE RECORD DEF C.SC1 ON THE SCRATCH FILE DEF CRBUF-1 INCLULDE THE FLAG WORD DEF K34 34 WORDS JMP PASER ERROR ON PASS FILE * LDA KM32 REINITIALIZE NUMBER OF WORDS STA NWRDS LDA DEFCR REINTIALIZE STARTING ADDRESS OF PAIRS STA LWORD JMP CROUT,I * DEFCR DEF CRBUF CROSS REFERENCE BUFFER LWORD NOP NWRDS NOP KM32 DEC -32 K34 DEC 34 KM2 OCT -2 CROSS REF FLAG. DO NOT MOVE!! CRBUF BSS 33 SKP * *********************************** * * CROSS REFERENCE BUFFER * * *********************************** SPC 1 * THIS BUFFER IS USED TO WRITE CROSS REFERENCE PAIRS * TO THE INTERMEDIATE CODE STRING. THE RECORD GOES * OUT AS SOURCE CODE. IN ORDER THAT PASS 2 WILL NOT * TREAT IT AS A SOURCE LINE, THE FIRST WORD OF THE * RECORD IS ALWAYS 'C'. THIS COMBINATION DOES NOT * OCCUR FOR ACTUAL SOURCE LINES OUTPUT (M OPTION ON * CONTROL STATEMENT) BECAUSE COMMENT LINES ARE NOT * WRITTEN TO THE INTERMEDIATE FILE. SPC 1 * CROSS REFERENCE PAIRS HAVE THE FORM: SPC 1 * WORD 1: ASSIGNMENT TABLE ADDRESS OF IDENTIFIER * WORD 2: SOURCE LINE NUMBER OF OCCURENCE SPC 1 * BOTH WORDS ARE IN BINARY. THERE ARE 16 PAIRS PER * RECORD EXCEPT (POSSIBLY) THE LAST ONE FOR A PROGRAM. * = THE WORD FOLLOWING THE LAST PAIR IS 0. THIS IS USUALLY * WORD 34 OF THE RECORD SPC 1 * **************************** * * CROSS REFERENCE PAIRS * * **************************** SPC 1 * ON ENTRY, F.A CONTAINS ASSIGNMENT TABLE POINTER ADDRESS * OF IDENTIFIER AND * F.CIN CONTAINS THE LINE NUMBER WHERE IT WAS * FOUND (EXCEPT FOR THE RIGHT-MOST ELEMENT * IN A LINE. THIS ROUTINE WILL FIND ITS * CORRECT LINE NUMBER. SPC 1 CRP.F NOP LDA F.CCW IS 'C' SET FOR AND K16 CROSS REFERENCE? SZA,RSS JMP CRP.F,I NO- DON'T BUILD CROSS REF. PAIR. LDA F.A SSA IF NEGATIVE JMP CRFL JUST FLUSH THE BUFFER * STA LWORD,I OUTPUT ASSIGN. TABLE PTR PART ISZ LWORD BUMP POINTER TO BUFFER ISZ NWRDS BUMP COUNTER LDA F.CLN STA LWORD,I OUTPUT LINE NO. PART OF PAIR. ISZ LWORD BUMP BUFFER POINTER ISZ NWRDS BUMP WORD COUNT. FULL? JMP CRP.F,I NOT YET. CRFL JSB CROUT OUTPUT IT JMP CRP.F,I SKP * *************************** * * OUTPUT SOURCE TO I-FILE * * *************************** SPC 1 SOU.F NOP LDA F.CCW AND K2 M-BIT(MIXED) SET? SZA,RSS JMP SOU.F,I NO. OMIT SOURCE OUTPUT. * LDA CBA,I GET THE FIRST CHARACTER AND KK07. IF 'C' CPA KK08 THEN JMP SOU.F,I DON'T KEEP IT * JSB OW.F FLUSH CODE TO THIS POINT OCT 60000 TO MAKE MIXED LISTING LOOK NICE LDA LINOL,I SET SIGN ON FIRST WORD IOR MSIGN AS A FLAG FOR STA LINOL,I FOR PASS 2 LDA CICNT,I GET CARD IMAGE WD COUNT ADA K3 INCLUDE CARD # STA ICK1 JSB WRT.C WRITE THE RECORD DEF C.SC1 ON THE SCRAT\UCH FILE DEF LINOL,I DEF ICK1 JMP PASER IF ERROR GO REPORT IT * JMP SOU.F,I * PASER LDA K99 ERROR ON PASS WRITE JMP F.ABT ABORT THE COMPILE * ICK1 NOP # OF WORDS TO BE OUTPUT K16 DEC 16 K99 DEC 99 K5 DEC 5 MSIGN DEF 0,I SKP * ****************** * * UNINPUT COLUMN * * ****************** SPC 1 UC.F NOP CCA ADA F.CC STA F.CC F.CC=F.CC-1 JMP UC.F,I SPC 2 * *********************************** * * INPUT CHARACTER, DETERMINE TYPE * * *********************************** * * ON RETURN A=F.TC=CHARACTER * B=F.NFL=CHAR IF NON-DIGIT ,ELSE 0 * E=F.DFL=1 IF DLIMITER ,ELSE 0 FOR ALF,NUM. SPC 1 ICH.F NOP JSB IC.F INPUT COLUMN CPA B40 IS CHARACTER A BLANK? JMP *-2 YES. GET ANOTHER CHARACTER JSB PAK.F PACK CHAR. INTO F.PAK LDA F.TC STA F.DLF SAVE CHAR. IN F.DLF STA NFL SAVE CHAR. IN NFL ADA BM60 CCE,SSA JMP ICH02 F.TC .LT. "0" ADA BM12 SSA JMP ICH04 F.TC IS A DIGIT ADA KM7 CCE,SSA JMP ICH02 F.TC NON-DIGIT, NON-ALPHABET ADA BM32 CCE,SSA JMP ICH06 ALPHABETIC. ICH02 LDA F.TC CHAR. JUST INPUT LDB NFL RETURN DIGIT FLAG JMP ICH.F,I EXIT (E=0) SPC 1 ICH04 CLA STA NFL F.TC IS A DIGIT ICH06 CLA,CLE STA F.DLF F.TC IS ALPHANUMERIC JMP ICH02 * BM60 OCT -60 BM32 OCT -32 BM12 OCT -12 F.DLF NOP #0 IF F.TC IS A DELIMITER NFL NOP 0 IF F.TC IS A DIGIT SKP * ************************** * * EXAMINE NEXT CHARACTER * * ************************** SPC 1 EXN.F NOP JSB ICH.F INPUT CHARACTER JSB UC.F UNINPUT COLUMN LDA F.CIN FPSAVE CURRENT LINE NUMBER STA F.CLN FOR XREF LDA F.TC RETURN NEXT CHAR JMP EXN.F,I RETURN NFL IN B SPC 1 * ************** * * INPUT ITEM * * ************** SPC 1 II.F NOP LDA F.EQF IF EQUIV. GROUP BEING SCANNED, SSA SKIP STRIPPING BLANKS JSB EXN.F STRIP OFF BLANKS PRECEDING ITEM JSB IDN.F INPUT DNA SZA F.IM=0, POSSIBLE ERROR CPA TWPE ALSO IF PSUDO JMP II.F,I * JSB AI.F ASSIGN ITEM STA T2II SAVE F.IM LDA F.NT IOR F.NCR SZA IS NAME TAG = 0? JMP IIEX NO - CONSTANT INPUT LDA F.EQF IS EQUIVALENCE GROUP BEING SCANNED? SSA JSB CRP.F NO. BUILD CROSS REFERENCE PAIR IIEX LDA T2II RETURN F.IM JMP II.F,I * F.CLN NOP F.NCR NOP NO CROSS REFERENCE FLAG T2II NOP K18 DEC 18 TWPE OCT 40000 SPC 1 * ************** * * INPUT NAME * * ************** SPC 1 INM.F NOP JSB IOP.F INPUT OPERAND LDA K18 LDB F.NT IS OPERAND A NAME? SZB JSB WAR.F NO. GRIPE LDA F.IM YES, (A)=F.IM OF THE OPERAND JMP INM.F,I SKP * ************************ * * INPUT (A) CHARACTERS * * ************************ SPC 1 * ENTRY: (A)=NUMBER OF CHARACTERS TO BE INPUT * EXIT IF (A) CHARACTERS ARE INPUT OR A DELIMITER ENCOUNTERED SPC 1 IA.F NOP CMA,INA,SZA,RSS SET FOR COUNT IF ZERO JMP IA.F,I EXIT NO ACTION * STA T0IA NUMBER OF CHARS. TO BE INPUT IA02 JSB ICH.F INPUT A CHAR. SEZ SKIP IF NOT A DELIMITER JMP IA.F,I YES EXIT * ISZ T0IA ALL CHARACTERS IN YET? JMP IA02 NO, GO GET THE NEXT ONE * JMP IA.F,I YES, EXIT * T0IA OCT 0 K17 DEC 17 SPC 1 * u **************** * * INPUT SYMBOL * * **************** SPC 1 ISY.F NOP CLA,INA STA F.NTF SET NO-TAG FLAG JSB INM.F INPUT NAME JMP ISY.F,I SPC 1 * ************************** * * INPUT INTEGER VARIABLE * * ************************** SPC 1 IIV.F NOP JSB IOP.F INPUT OPERAND JSB TV.F TAG VARIABLE JSB ITS.F INTEGER TEST JSB NCT.F NON-CONSTANT TEST JMP IIV.F,I SPC 1 * ***************** * * INPUT OPERAND * * ***************** SPC 1 IOP.F NOP JSB II.F INPUT ITEM SZA JMP IOP.F,I (A)=F.IM OF THE OPERAND LDA K17 JSB ER.F DELIMITER FOUND WHEN OPERAND EXPECTED SKP * ************************** * * INPUT STATEMENT NUMBER * * ************************** SPC 1 ISN.F NOP JSB BNI.F CLEAR NID TO BLANKS LDA K64 '@' LDB F.DNI GET ADDRESS OF NID STA B,I SET FIRST WORD TO '@' INB SET B FOR NEXT WORD LDA KM6 STA T1ISN T1=-6 STB T2ISN T2=ADDR(NID+1) JSB EXN.F STRIP OFF PRECEDING BLANKS ISN02 JSB ICH.F INPUT CHAR CPA B60 LEADING 0? JMP ISN02 YES. IGNORE IT. LDA K31 SZB DIGIT? JSB ER.F NO, NON-DIGIT CHAR IN STMNT NO. ISN04 ISZ T1ISN 5 DIGITS INPUT? JMP ISN06 NO ISN05 LDA B40 JSB ER.F ERR 32: INVALID STMT NO. SPC 1 ISN06 LDA F.TC STA T2ISN,I STORE DIGIT INTO NID BUFFER ISZ T2ISN T2=T2+1 JSB ICH.F STRIP BLANKS LDA F.CC IF THE CHAR. IS IN COL. STA F.NTF SET THE NO TAG FLAG CPA K7 6 THEN IT MUST BE ZERO AND NOT PART OF THE JMP ISN07 STATEMENT NUMBER. (IC.F BUMMPED THE 6 TO 7) * SZB,RSS DIGIT? JMP ISN04 YES_S * LDA F.TC GET CHAR. BACK TO A CPA B54 ',' JMP ISN07 * CPA B15 'C/R' JMP ISN07 * LDB F.CC ADB KM7 SSB JMP ISN05 F.CC .LE. 6; STMT NO. ERROR. * JSB UC.F UNINPUT COLUMN ISN07 CLA STA F.IU F.IU=0 STA F.NT F.NT=0 STA F.IM F.IM=0 JSB AI.F ASSIGN ITEM JSB CRP.F BUILD CROSS REFERENCE PAIR LDA F.IM RETURN F.IM IN (A) JMP ISN.F,I SPC 1 T1ISN BSS 1 COUNT FOR NO. OF DIGITS T2ISN BSS 1 NID BUFFER POINTER K6 OCT 6 B60 OCT 60 B54 OCT 54 K64 DEC 64 "@" KM6 DEC -6 K31 DEC 31 SPC 2 F.OFE LDA K3 HERE ON DATA POOL OVERFLOW JMP F.ABT ABORT THE JOB SPC 2 * **************************************** * * MOVE PROGRAM NAME TO PBUF,ERBF,HEADN * * **************************************** SPC 1 MPN.F NOP STA T1MPN SAVE MOVE FROM LOC. LDB HDLP7 JSB .MVW MOVE NAME TO F.HDL+7,8,9 DEF K3 NOP LDA T1MPN LDB F.DNB ADB K3 JSB .MVW MOVE NAME TO NBUF+3,4,5 DEF K3 NOP LDA T1MPN LDB ERBP1 JSB .MVW MOVE NAME TO ERBF+1,2,3 DEF K3 NOP JMP MPN.F,I SPC 1 T1MPN NOP MOVE FROM LOC. SPC 1 ERBP1 DEF ERBF+1 HDLP7 DEF HEADN SKP * ********************** * * CATASTROPHIC ERROR * * ********************** SPC 1 * TO PRINT ERROR MESSAGE & SCAN NEXT STATEMENT * INPUT: (A)=ERROR TYPE SPC 1 ER.F NOP ISZ F.ERF STEP ERROR COUNT STA ERTYP (A)=ERROR TYPE CLB STB F.NXN INITIALIZE "NO INPUT" FLAG. LDA F.CC ADA KM74 F.CC .LT. 74 ? SSA JMP ER05 YES STB F.CC NO; EQUIV GROUP ERROR. SET F.CC=0 LDB F.RPR SET START OF GROUP BUFFER STB T2WAR IN LOCAL TEMP LDB F.LPR ( LOC OF GROUP CMB LDA F.E CMA,INA ADA F.RPR SSA (A)=F.RPR-E ADB F.E BEYOND LAST GROUP SSA,RSS ADB F.RPR ) LOC OF GROUP STB T1ERR =-(F.LPR-F.RPR+1) STB T1WAR SAVE FOR PRINT LDB F.LPR '(' LOC OF GROUP ER01 LDA B,I COPY EQUIV GROUP TO CARD BUFFER. STA T0WAR SAVE IN TEMP LDA F.RPR,I SWAP EQU GROUP END FOR STA B,I END LDA T0WAR FOR PRINTING STA F.RPR,I ISZ F.RPR PUSH THE BOTTOM END POINTER CPB F.RPR DONE? RSS YES SKIP ADB KM1 NO PUSH THE TOP COUNTER CPB F.RPR DONE? RSS YES SKIP JMP ER01 NO SWAP THE NEXT TWO WORDS * CLA JSB SKL.F SKIP A LINE LDA T1WAR GET THE SAVED LENGTH CMA,INA SET POSITIVE LDB T2WAR GET THE ADDRESS JSB PSL.F PRINT OUT GROUP ER05 LDA ERTYP (A)=ERROR TYPE CPA K84. RPL OVERFLOW? JMP F.ABT YES, TERMINATE JOB JSB WAR.F PRINT OUT ERROR COMMENT LDA F.CC FROM EQUIVALENCE GROUP? LDB B15 SZA STB F.TC NO SET EOL FOR CRT.F CLA STA F.LFF RESET LOG IF FLAG STA F.OPF RESET OUTPUT PACK FLAG STA F.SVL CLEAR SAVE L STA F.T F.T=0 (NO. OF WORDS ON STACK 1) STA F.ACC SHOW NOTHING IN REGISTERS. STA F.L F.L=0 (NO. OF WORDS ON STACK 2) LDB F.DO STB F.D F.D=F.DO TO DELETE CURRENT DO TABLE CPA F.EQE SKIP IF NOT AN EQUIVALENCE ERROR JMP CRT.F TO C/R TEST & STERM * JMP F.EQE,I RETURN TO EQU PROCESSOR TO CLEAN UP SPC 1 KM1 DEC -1 K84. DEC 84 KM74 DEC -74 K3 DEC 3 T1ERR NOP COUNTER T0WAR NOP T2WAR NOP F.EQE NOP EQUIV GROUP ERROR FLAG ERTYP NOP M{ ERROR TYPE SPC 2 BOM.F NOP DISASTER DETECTED SET UP THE MESSAGE ISZ F.ERN STEP THE DISASTER COUNT STA ERTYP SAVE THE CODE LDA DDISA GET THE ADDRESS OF 'DISASTR' LDB DERBF AND THE MESSAGE ADDRESS JSB .MVW MOVE IT IN DEF K4 NOP FOR .MVW LDA ERTYP RESTOR THE ERROR CODE JSB WAR.F SEND THE MESSAGE JMP BOM.F,I RETURN SPC 1 F.LPR NOP '(' ADDRESS IN EQUIV STMT. F.RPR NOP ')' ADDRESS IN EQUIV. STMT. F.SVL NOP NO WORDS IN STACK DDISA DEF *+1 ASC 4,DISASTR F.ERN NOP ERROR ARRAY NOP CUMMULATIVE ERROR COUNT NOP CUMMULATIVE WARNING COUNT F.ERF NOP NO OF ERRORS WARNF NOP NO. OF WARNINGS SKP * ***************** * * ERROR COMMENT * * ***************** SPC 1 * TO PRINT ERROR COMMENT & CONTINUE SCANNING CURRENT SOURCE * INPUT: (A)=ERROR TYPE * CC=THE # OF THE COLUMN JUST BEYOND WHERE * THE ERROR WAS DETECTED. SPC 1 WAR.F NOP ISZ WARNF SET WARNING FLAG STA ERTYP SAVE ERROR TYPE JSB PD.F MAKE TWO ASCII DIGITS STA ERBF+9 ERROR TYPE STA F.LSP SET LAST OPERATION FLAG CLB,INB CPB F.CC CLA,RSS CCA ADA F.CC (A)=F.CC-1 SSA CLA * LDB CBA GET CURRENT CARD LENGTH ADB K40 (IT IS AFTER THE CARD) LDB B,I STB T0WAR SAVE FOR TO PRINT BLS IN CHARACTERS STB T1WAR SAVE IT CMB,INB IF ERROR IS OFF ADB A THE CARD SSB,RSS THEN LDA T1WAR USE LAST CHAR. ON THE CARD STA T1WAR SAVE THE COLUMN NUMBER JSB PD.F MAKE TWO ASCII DIGITS STA ERBF+21 ERROR COLUMN CLA JSB SKL.F SKIP A LINE LDA F.CC IF AT hCOL. 0 SZA,RSS THEN JMP WARN4 SKIP PRINTING THE CARD * SSA IF NEGATIVE JMP WARN3 SKIP THE CARD AND THE POINTER * LDA T0WAR NO. OF WORDS IN CURRENT CARD LDB CBA CARD IMAGE BUFFER JSB PSL.F PRINT IT OUT WARN4 LDB CBA GET THE BUFFER ADDRESS CLE,ELB CONVERT TO CHAR ADDRESS ADB T1WAR ADD THE COLUMN NUMBER CLE,ERB ADDRESS TO B, UPPER, LOWER TO E STB T0WAR SAVE THE ADDRESS LDA B,I AND ITS CONTENTS STA T2WAR FOR TO RESTORE IT SEZ IF LOWER CHAR JMP WAR02 LOWER CHAR. GO HANDLE * LDA "?B" GET AND PLANT A "? " WAR03 STA B,I IN THE BUFFER AFTER THE BAD GUY LDB CBA GET THE ADDRESS LDA T1WAR AND THE CHARACTER COUNT ADA K2 ADJUST FOR BLANKS AND ODD ARS CONVERT TO WORDS JSB PSL.F PRINT IT LDA T2WAR RESTORE THE BUFFER STA T0WAR,I JUST IN CASE WARN3 LDA ER.F CALL FROM ER.F?? SZA,RSS YES IT IS A ERROR JMP WARN5 NO IT IS A WARNING LDA DERR0 MOVE IN THE ERROR STRING LDB DERBF JSB .MVW DEF K4 NOP WARN5 LDA K23. LDB F.CC IF NEGATIVE COL. COUNTER SSB THEN LDA K16 SKIP THE 'AT COL...' JASS LDB ERCK1 "ERR N DETECTED ..." JSB PSL.F PRINT ERROR MESSAGE CLA STA ER.F RESET ER.F CALL FLAG JSB SKL.F SKIP A LINE LDA DWARN MOVE BACK THE WARNING LDB DERBF STRING JSB .MVW DEF K4 NOP JMP WAR.F,I * DERR0 DEF *+1 ASC 4, ERROR DERBF DEF ERDFX DWARN DEF *+1 ASC 4,WARNING ECC1F NOP ERROR ON F.CC=1 FLAG K23. DEC 23 ERCK1 DEF ERBF-1 LOC. OF ERROR MESSAGE SPC 1 WAR02 LDA B,I GET THE WORD XOR "?" CNANGE LOWER CHAR TO "?" AND B377 ISOLATE THE mHFBUPPER CHARACTER XOR B,I JMP WAR03 * T1WAR NOP "?" OCT 77 "?B" ASC 1,? SPC 2 ASC 1, ERBF ASC 5,** ** ERDFX ASC 17,WARNING DETECTED AT COLUMN SPC 2 * ******************************** * * CONVERT TO FOUR ASCII DIGITS * * ******************************** SPC 1 ASC.F NOP CLB CLEAR FOR DIV DIV K100 SEPERATE HIGH AND LOW DIGITS STB T1FC SAVE THE LOW ONES JSB PD.F CONVERT THE HIGH DIGITS STA T2FC SAVE THEM LDA T1FC GET THE LOW JSB PD.F CONVERT LDB T2FC RESTORE THE HIGH TO B JMP ASC.F,I RETURN * T1FC NOP T2FC NOP "00" ASC 1,00 K100 DEC 100 * *************** * * PACK DIGITS * * *************** SPC 1 * ENTRY: (A)=TWO DIGIT DECIMAL NUMBER BINARIZED * EXIT: (A)=ASCII EQUIVALENT OF ENTRY (A) SPC 1 PD.F NOP CLB DIV K10 ALF,ALF IOR B IOR "00" ADD THE ASCII BITS JMP PD.F,I SPC 1 ORG * END yHASMB,Q,C HED IDA.F AND IDS.F FOR FTN COMPILER NAM IDN.F,8 92060-16092 780302 * * * * *************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * * REPRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * *************************************************************** * * * * * * EXT'S WITH A LEADING 'F.' ARE VARIABLES OR JUMP TARGETS * * THE COLUMN THE EXT STARTS IN DEFINES THE SUBROUTINE IT IS * DEFINED IN AS FOLLOWS * 2 -- OA.F (WRITE PASS FILE ROUTINES) * 3 -- NEX.F (STATEMEXTS THAT DON'T CONTAIN EXPRESSIONS) * 4 -- FA.F (THE ASSIGNMEXT TABLE ROUTINES) * 5 -- EX.F (STATEMEXTS USING THE EXPRESSION EVALUATOR) * 6 -- IC.F (THE CHARACTER INPUT ROUTINES) * 7 -- IDN.F (THE TOKEN INPUT ROUTINES) * 8 -- FTN4 ( THE MAIN) EXT F..DP BASE OF SYMBOL TABLE EXT F..E DIMENSIONS CONSTANT BIT FROM ASSIGNS TABLE EXT F.A ASSIGNMEXT TABLE ADDRESS (CURRENT ENTRY) EXT F.ASS ASSIGNMEXT STATEMEXT PROCESSOR EXT F.ABT ABORT COMPILE EXTRY EXT F.ACC TEMP ACCUMULATOR FLAG EXT F.AF ADDRESS FIELD CURREXT F.A EXT F.ARF NO. OF SUB. FUN. ARGUMEXTS EXT F.ASP ASSIGN STMT. PROCESSOR EXT F.AT ADDRESS TYPE OF CURREXT F.A EXT F.AT. SUBSCRIPT INFO FLAG EXT F.BGN RETURN FROM F4.0 EXT F.BSP BACKSPACE STMT. PROCESSOR EXT F.BUF A BUFFER EXT F.C OFFSET FOR CURRENT MR INSTRUCTION EXT F.CAL CALL STATEMEXT PROCESSOR EXT F.CC CHARACTER COUNT EXT F.CCW FTN OPTION WORD EXT F.CIN CURREXT CI BUFFER LINE NUMBER EXT F.CLN INPUT ITEM CURREXT LINE # EXT F.CON CONTINUE STMT. PROCESSOR EXT F.CSZ COMMON SIZE EXT F.D DO TABLE POINTER EXT F.D.T ADDRESS OF '.' FUN. TABLE EXT F.D0 ARRAY ELEMEXT SIZE EXT F.D1 DIMENSION 1 EXT F.D2 DIMENSION 2 EXT F.D3 DIMENSION 3 EXT F.DCF DIM, COM FLAG EXT F.DEF DATA EXISTS FLAG ENT F.DID ADDRESS OF F.IDI EXT F.DLF DELIMETER FLAG EXT F.DNB DEF OF NBUF (NAM RECORD) EXT F.DNI ADDRESS OF NID EXT F.DO LWAM - END OF DO TABLE EXT F.DOP DO STATEMEXT PROCESSOR EXT F.DP BASE OF USER SYMBOL TABLE ENT F.DTY IMPLICIT TYPE TABLE ENT F.E EQUIVALENCE TABLE POINTER EXT F.EFG E - FLAG - SET IF SUBSCRIPT IS DUMMY EXT F.EFP ENDFILE STMT. PROCESSOR EXT F.EMA F.A OF EMA EXT ENTRY, WINDOW SIZE EXT F.EMS EMA SIZE DOUBLE WORD, (INTERNAL FORMAT) EXT F.END END FLAG EXT F.EQE EQUVALENCE ERROR FLAG EXT F.EQF EQUIVALENCE FLAG EXT F.ER0 'RX' OF ERRX LIB ERROR ROUTINE EXT F.ERF ERROR FLAG (# OF ER.F CALLS) EXT F.ERN ERROR ARRAY EXT F.EXF EXTERNAL STATEMEXT FLAG EXT F.FMT FORMAT STMT. PROCESSOR EXT F.GOP GO TO STATEMEXT PROCESSOR ENT F.IDI INPUT ARRAY NON-NUMERIC EXT F.IFF IF FLAG EXT F.IFP IF STATEMEXT PROCESSOR EXT F.IM CURREXT ITEM MODE (REAL, COMPLEX,ECT.) EXT F.INT TEMP VARIABLE ARRAY EXT F.IOF INDICATOR FOR I/O INDEX EVALUATOR EXT F.IU CURREXT ITEM USAGE (DUM., RELATIVE, ECT.) EXT F.HDL LENGTH OF HEAD MESSAGE EXT F.L # WORDS ON STACK 2 EXT F.LFF LOCICAL IF FLAG EXT F.LLO CURRENT RELOCATAION ADDRESS(TWO WORDS) ENT F.LLT ADDRESS OF LINE LOCATION TABLE (SET BY INIT) EXT F.LO END OF ASSIGNMEXT TABLE+1   EXT F.LOP NO. LINES LEFT ON THIS PAGE. EXT F.LPR ( LOC OF EQUIVALENCE GROUP EXT F.LSF EXPECT FIRST STATEMEXT FLAG EXT F.LSN F.A OF LAST STATEMEXT NUMBER EXT F.LSP LAST OPERATION FLAG EXT F.MFL TYPE STMT. MODE FLAG EXT F.NC NAME CHANGE FLAG. EXT F.NCR NO CROSS REF FLAG EXT F.ND NUMBER OF DIMENSIONS EXT F.NEQ # OF EQUIVALENCE GROUPS EXT F.NT NAME TAG 0= VAR, 1=CONSTANT. EXT F.NTF NAME TAG FLAG EXT F.NW NO. WORDS THIS TABLE F.A EXTRY. EXT F.NXN NO INPUT FLAG EXT F.OFE DATA POOL OVERFLOW ERROR EXTRY. EXT F.OPF OUTPUT PACK FLAG EXT F.R JSB ERR0 FLAG ENT F.PAK PACK BUFFER WORD EXT F.PAP PAUSE STMT. PROCESSOR EXT F.RDP READ STATEMEXT PROCESSOR EXT F.REL SUB. PROG. RETURN LOCATION EXT F.RPL PROGRAM LOCATION COUNTER EXT F.RPR ) LOC OF EQUIVALENCE GROUP EXT F.RTN RETURN STMT. PROCESSOR EXT F.RWP REWIND STMT. PROCESSOR EXT F.S02 RETURN FORM RCOM F.1 EXT F.S03 LOAD F.1 AND PASS CONTROL EXT F.S1B BOTTOM OF STACK 1 EXT F.S1T TOP OF STACK 1 EXT F.S2B BOTTOM OF STACK 2 EXT F.S2T TOP OF STACK 2 EXT F.SBF 0= MAIN, ELSE SUBROUTINE EXT F.SCC SAVE F.CC EXT F.SEE RETURN FROM F4.1 EXT F.SEG LOAD A NEW SEGMENT EXT F.SFF SUBROUTINE/FUNCTION FLAG 0/1 EXT F.SFP STATEMEXT FUNCTION PROCESSOR EXT F.SID STATEMEXT ID PHASE FLAG EXT F.SLF STATEMEXT LEVEL FLAG EXT F.SPF SPECIFICATION FLAG SET TO CURREXT STMT. LEVEL EXT F.SPS STATEMEXT PROCESSOR SWITCH EXT F.SRL SAVE RPL AT BEGINNING OF RECORD EXT F.STA FLAG THAT IS ZERO UNTIL THE FTN STATEMEXT IS READ EXT F.STB STRING BACK JUMP FLAG EXT F.STP STOP STMT. PROCESSOR  EXT F.STS TO STATEMEXT SCAN EXT F.SVL SAVE # WORDS ON OPER STACK (F.L) EXT F.SXF COMPLEX CONSTANT FLAG EXT F.T # WORDS ON STACK 1 EXT F.TAC ? EXT F.TC NEXT CHARACTER EXT F.TIM TIME ARRAY ADDRESS IN HEAD EXT F.TRM TERMINATE COMPILE EXT F.TYP TYPE STATEMEXT FLAG EXT F.WRP WRITE STATEMEXT PROCESSOR EXT F.X1 F.A OF F.D1 EXT F.X2 F.A OF F.D2 EXT F.X3 F.A OF F.D3 * * ENT'S WITH A TRAILING '.F' ARE SUBROUTINES * EXT AA.F ASSIGN ADDRESS SUB. EXT AI.F ASSIGN ITEM EXT ASC.F CONVERT TO 4 ASCII DIGITS EXT BNI.F CLEAR NID TO BLANKS EXT BOM.F DISASTOR ERROR REPORT (NO RETURN) ENT CID.F CLEAR F.ID ARRAY ENT CDI.F CLEAR IDI ROUTINE EXT CRP.F CROSS REF PAIR SUB. EXT CRT.F TEST FOR CARRAGE RETURN EXT DAF.F DEFINE (F.AF) EXT DAT.F DEFINE (AT) EXT DIM.F DEFIND (F.IM) EXT DIU.F DEFINE (F.IU) EXT DL.F DEFINE LOCATION SUBROUTINE EXT EJP.F PAGE EJECT SUBROUTINE EXT ER.F ERROR PRINT SUBROUTINE EXT ESC.F ESTABLISH CONSTANT SUBROUTINE EXT ESD.F ESTABLISH DEF SUBROUTINE EXT EXN.F EXAMINE NEXT CHARACTER EXT FA.F FETCH ASSIGNS EXT FID.F FETCH (ID) TO NID (UNPACK) EXT FNS.F FIRST NOT SPEC. STMEXT CHECK EXT FXC.F CHECK IF SUB. IN FIX-EXT TABLE EXT GNA.F GET NEXT SYMBOL TABLE EXTRY EXT GPE.F GENERATE SUB. PROG. EXTRANCE EXT IA.F INPUT (A) CHARACTERS SUBROUTINE EXT IC.F GET NEXT CHARACTER EXT ICH.F GET NEXT NON BLANK CHAR. AND TYPE IT ENT IDN.F INPUT DO NOT ASSIGN (GET NEXT OPERAND) ENT IDS.F INPUT DIGIT STRING EXT IFT.F IF GOTO COMPLETION EXT II.F INPUT ITEM EXT IIV.F INPUT INTEGER VARABLE EXT ~ IN2.F INIT FOR OA.F MODULE EXT IN3.F INIT FOR ENX.F MODULE EXT IN4.F INIT FOR FA.F MODULE EXT IN5.F INIT FOR EX.F MODULE EXT IN6.F INIT FOR IC.F MODULE ENT IN7.F INIT FOR IDN.F MODULE EXT INM.F INPUT NAME EXT IOP.F INPUT OPERATOR EXT ISN.F INPUT STATEMEXT NUMBER EXT ISY.F INPUT SYMBOL EXT ITS.F INTEGER TEST EXT MCC.F RESET TO FIRST COLUMN OF STATEMEXT EXT MPN.F MOVE PROGRAM NAME (TO NAM RECORD ECT.) EXT NEW.F SUB TO CLEAR TEMPS FOR A NEW MODULE EXT NCT.F TEST FOR NOT A CONSTANT EXT NST.F TEST FOR NOT A SUBROUTINE NAME EXT NTI.F MOVE NID TO F.IDI (PACKS) EXT NWI.F SET F.D0 TO # WORDS IN ARRAY EXT OA.F OUTPUT ASSIGNMEXT TABLE OPERAND EXT OAI.F OUTPUT ABS. INSTRUCTION EXT OC.F OUTPUT CONSTANT EXT ODF.F OUTPUT DOT FUNCTION EXT OLR.F OUTPUT LOAD ADDRESS EXT OMR.F OUTPUT MEMORY REF. INSTRUCTION EXT OS.F OUTPUT SECTOR TO INTERPASS FILE EXT OW.F OUTPUT WORD EXT OZ.F OUTPUT ZREL (OP *+N) ENT PAK.F PACK SUBROUTINE EXT PDF.F PRODUCE DEF SUBROUTINE EXT PSL.F PRINT LINE ON PRINTER EXT PTM.F PROGRAM TERMINATION CODE GEN. EXT RTN.F SUBROUTINE RETURN HANDLER ENT RP.F INPUT ')' EXT SCC.F SAVE F.CC SUBROUTINE EXT SCP.F SAVE CURREXT STATPMEXT POSITION. EXT SKL.F SKIP LINES ON LIST EXT SNC.F START NEXT CARD SUBROUTINE EXT SOA.F STORE AND OUTPUT (OA.F) EXT TDO.F DO TERMINATION CODE GENERATOR EXT TCT.F TEST (A) = F.TC ELSE ER 28 EXT TS.F TAG SUBPROGRAM SUB. EXT TV.F TAG VARIABLE EXT UC.F UNINPUT COLUMN EXT WAR.F ERROR COMMEXT SUBROUTINE (WARNINGS) * * EXT .MVW LIBRARY MOVE WORDS ROUTINE * * * A EQU D0 B EQU 1 * * IN7.F NOP INITIALIZE ROUTINE STA SLINE ZAP THE LINE COUNT LDA F.CCW GET THE 'Y' AND B1000 BIT FROM THE CON WORD LDB K2 AND SZA SET UP ADDRESS OF THE INB DOUBLE WORD EXPONENT LDA F.DID FOR THE ADA B CONVERSION ROUTINE STA DXIDI LOCATION IN F.IDI ADB DF.ID LOCATION IN F.ID STB DXID JMP IN7.F,I RETURN * B1000 OCT 1000 DXIDI NOP SKP * *********************** * * INPUT DO NOT ASSIGN * * *********************** SPC 1 IDN.F NOP CLA STA BFLAG CLEAR 'B' (OCTAL) FLAG STA T2IDN T2=0 INDICATING REAL PART IDN02 JSB CID.F F.ID TO 0 RESTART HERE FOR IMAGINARY PART. JSB CDI.F CLEAR F.IDI STA T1IDN T1=0 EXPONENT BASE 10 STA T3IDN T3=0 0 OR + OR - SIGN (FROM FIRST CHAR.) STA F.IU F.IU=0 (ITEM USAGE) STA F.NT F.NT=0 (NAME TAG) STA OVFL OVFL=0 INDICATING NO OVERFLOW STA HFLAG HOLLERITH FLAG IDN04 CLA HERE AFTER [+!-] STA F.IM F.IM=0 (ITEM MODE) IDN06 CLA HERE AFTER '.' FOR FRACTION PART STA PCNT SET PACK COUNT TO 0 JSB IDS.F INPUT DIGIT STRING LDB F.IM [+!-]ND!ND.MD SZB WHICH IS IT? JMP IDN18 DIGITS AFTER . JUST INPUT [+!-]ND.MD * STB DCT SET NO. OF DIGITS TO 0 [+!-]ND LDA REA STA F.IM ASSUME REAL LDA F.TC CPA B56 TERMINATING CHAR. A '.' ? [+!-]ND.? JMP IDN06 YES. GET REST OF NUMBER [+!-]ND. * LDA F.NT WERE THERE ANY DIGITS? [+!-]ND SZA I.E. IS N>0? JMP IDN30 [+!-]ND (N>0) * LDA T3IDN PRECEDED BY + OR - ? [+!-] SZA JMP IDN12 YES +!- * LDA F.DLF h NOTHING INPUT - IS F.TC A LETTER? SZA JMP IDN16 NO. CHECK FOR SIGN. * LDB F.TC GET THE CHARACTER AND ADB BN101 USE IT TO INDEX CLE,ERB INTO THE ADB F.DTY IMPLICIT TYPE TABLE LDA B,I GET TYPE FORM THE TABLE SEZ ROTATE IT ALF,ALF IF REQUIRED AND B70K ISOLATE THE TYPE STA F.IM SET THE IMPLICIT TYPE JSB BNI.F CLEAR NID BUFFER TO BLANKS LDA KM6 STA T4IDN SET CHAR. COUNT TO -6 LDB F.DNI LOC. OF 1ST WORD OF NID BUFFER STB T5IDN LDA F.TC STORE CHAR. INTO NID BUFFER IDN10 STA T5IDN,I JSB ICH.F INPUT A CHAR. SEZ IS IT ALPHANUMERIC?? JMP IDN46 NO * ISZ T5IDN INCREMENT NID BUFFER POINTER ISZ T4IDN 6 CHARS INPUT? JMP IDN10 NO. GET ANOTHER * JMP IDN46 YES QUIT EVEN IF NOT DONE WITH SYMBOL * F.DTY DEF TYPET DEF TO TYPE TABLE T4IDN NOP T5IDN NOP CPX.K OCT 50000 DO NOT REARRANGE THESE DBL OCT 60000 CONSTANTS REA OCT 20000 F.IM=2 REAL INT OCT 10000 F.IM=1 INTEGER TPADD DEF INT+1 USED TO INDEX INTO ABOVE FOR HOLL. CONST. SPC 1 IDN12 STA F.TC STORE DELIMITER OPERATOR JSB UC.F UNINPUT COLUMN IDN14 CLA STA F.IM POSSIBLE ERROR (MISSING OPERAND) JMP IDN48 * IDN16 LDA F.TC FIRST CHARACTER IS NOT ALF-NUM. IS IT SIGN? STA T3IDN SAVE IN CASE CPA B53 JMP IDN04 F.TC=+ + * CPA B55 JMP IDN04 F.TC=- - * JMP IDN14 POSSIBLE ERROR (MISSING OPERAND) * IDN18 SZA DIGIT COUNT =0 ? [+!-]ND.MD JMP IDN30 NO THEN M>0 [+!-]ND.MD (M>0) * CPA F.NT IS IT A CONSTANT? (I.E. IS N>0) JMP IDN42 NO, IT IS A NAME [+!-]. * LDA F.DLF TERMINATOR ALPHANUMERIC? [+!-I]ND. SZA [+!-]ND.(?) JMP IDN54 NO [+!-]ND.(NON-ALF) * LDA F.TC CPA "E" F.TC=E? JMP IDN26 YES [+!-]ND.E * CPA "D" F.TC=D? JMP IDN20 YES [+!-]ND.D * IDN28 JSB ILG.F NEITHER; INPUT LOGICAL. [+!-]ND.((ALF)!EQ) JMP IDN32 * IDN26 JSB ICH.F CHECK FOR .EQ [+!-]ND.E(Q?) CPA "Q" F.TC=Q ? JMP IDN28 YES. NOT EXPONENT '.EQ.'? [+!-]ND.EQ * JMP IDN24 NO; MUST BE REAL. [+!-]ND.E * IDN20 LDA DBL SET F.IM=DOUBLE [+!-]ND[.MD]D ! [+!-]NDD STA F.IM IDN22 CLA CHECK 'B' FLAG [+!-]ND[.MD]D ! [+!-]ND[.MD]E CPA BFLAG IS IT SET?? RSS JMP IDN76 'B' FLAG SET * JSB ICH.F INPUT A CHAR IDN24 STA T0IDN SIGN OF EXPONENT [+!-]ND.E JOINS HERE CPA B55 "-"? RSS YES SKIP TO INPUT FIRST CHAR. CPA B53 "+"? JSB ICH.F + OR - SO INPUT CHARACTER SZB,RSS DIGIT? JMP IDN52 YES * LDB F.SID IF IN SCAN MODE SZB THEN JMP IDN05 GIVE HIM BENIFIT OF DOUBT * LDA K11 NO,ERROR (EXP NON DIGIT) JSB ER.F BITCH. * BN101 OCT -101 -"A" B70K OCT 70000 TYPE MASK K11 DEC 11 K12 DEC 12 B53 OCT 53 + B55 OCT 55 - "D" OCT 104 "D" "E" OCT 105 "E" "H" OCT 110 "H" "Q" OCT 121 "Q" SPC 1 IDN30 LDA F.TC DIGITS PRESENT.[+!-]ND.MD (M>0,DCT>0) OR CPA "E" F.TC=E ? [+!-]ND (N>0,DCT=0) JMP IDN22 YES [+!-]ND.MDE ! [+!-]NDE * CPA "D" F.TC='D' ? JMP IDN20 YES [+!-]ND.MDD ! [+!-]NDD * LDA DCT DIGIT COUNT 0? SZA JMP IDN76 NO [+!-]ND.MD (M>0) * IDN32 LDA INT [+!-]ND (N>0) STA F.IM SET F.IM=INTEGER LDA F.TC CPA "H" F.TC=H ? JMP IDN72 YES. HOLLERITH CONSTANT [+!-]NDH * IDN31 LDA F.ID+3 [+!-]ND (N>0) STA F.IDI LDB BFLAG 'B' SET? SZB JMP IDN33 YES, OCTAL NUMBER OVERFLOW CHECKED BY IDS.F * SSA,RSS JMP IDN35 F.IDI .GE. 0 * LDB T3IDN SIGN OF NUMBER CPB B55 '-' ? JMP IDN37 * IDN34 LDA K12 LDB F.SID SZB,RSS IN SCAN MODE? JSB ER.F NO. INTEGER CONST EXCEEDS MAX SIZE * JMP IDN50 * IDN35 LDA F.ID ANY BITS SET IN HIGH ORDER WORDS IOR F.ID+1 IOR F.ID+2 SZA JMP IDN34 YES INTEGER TOO LARGE. * IDN33 LDA T3IDN IF OCTAL OR INTEGER AND LDB F.ID+3 CMB,INB CPA B55 - ? STB F.IDI SET NEGATIVE JMP IDN48 * IDN37 CPA B100K =B100000 JMP IDN48 YES * JMP IDN34 NO, ERROR * "FA" ASC 1,FALSE "TR" ASC 1,TRUE B100K DEF 0,I LOG OCT 30000 F.IM=3 LOGICAL K8 DEC 8 BM60 OCT -60 K10 DEC 10 SPC 1 IDN42 LDA B17 [+!-]. LDB T3IDN WAS THERE A SIGN? SZB JSB WAR.F YES - ILLEGAL OPERATOR-OPERAND SEQUENCE JSB ILG.F NO - INPUT LOGICAL. CLB,CCE CPA "FA" F.TC='FA' ? .FA(LSE) JMP IDN44 YES * CPA "TR" F.TC='TR' ? .TR(UE) ERB,SLB YES. B=1.F.F0B; SKIP. JMP IDN14 F.TC # 'FA' NOR 'TR' (POSSIBLE ERROR) * IDN44 STB F.ID F.ID=0 (FALSE) OR =-0 (TRUE) LDA LOG JSB ESC.F ESTABLISH CONSTANT JSB ICH.F INPUT CHAR. IDN46 JSB IDID MOVE F.ID TO F.IDI IDN05 JSB FOP.F FINISH OPERATOR IDN48 LDA K8 LDB T2IDN REAL PART? SZB YES SKIP IDN51 JSB WAR.F ILL. IMAGINARY PART IDN50 CLA STA F.SXF LDA F.IM LDB HFLAG HOLLERITH FLAG TO B JMP IDN.F,I * IDN52 LDA T1IDN V INPUT Q<:6EXPONENT MPY K10 . LDB F.TC . T1=10*T1+F.TC ADB BM60 . ADA B . STA T1IDN V JSB ICH.F INPUT CHAR SZB,RSS DIGIT? JMP IDN52 YES. ACCUMULATE DECIMAL EXPONENT * IDN54 LDA F.SID CODE GEN.? SZA JMP IDN05 NO, SCAN * LDA F.ID A REAL OR DOUBLE NUMBER IS IN SO IOR F.ID+1 NOW CONVERT AND NORMALIZE IT. IOR F.ID+2 IOR F.ID+3 SZA,RSS JMP IDN64 MANTISSA IS 0 * LDA T1IDN LDB T0IDN IS SIGN OF EXP '-' ? CPB B55 CMA,INA YES, 2'S COMPLEMENT T1 ADA OVFL OVERFLOW COUNTER LDB DCT DIGIT COUNT CMB,INB ADB A ADJUST DECIMAL EXPONENT: STB T1IDN T1=T1+OVFL-DCT LDA K63 STA T0IDN T0=47 (NO. OF BITS FOR D-NUMBER) IDN56 JSB NOM.F NORMALIZE THE NUMBER LDA T1IDN CMA,SSA,INA,RSS JMP IDN68 EXP BASE 10 .LT. 0 * SZA JMP IDN70 EXP BASE 10 .GT. 0 * JSB CDI.F CLEAR F.IDI TO 0 LDB B200 ROUND FACTOR LDA F.IM IS IT A REAL NUMBER? XOR REA SZA,RSS STB F.IDI+1 YES SZA STB DXIDI,I NO, IT IS DOUBLE JSB IDADD F.ID=F.ID+F.IDI TO ROUND SSB,RSS OVERFLOW INTO SIGN BIT? JMP IDN01 NO. * CLE,ERB YES. RENORMALIZE HIGH WORD STB F.ID (OTHER WORDS ARE OK) ISZ T0IDN ADJUST EXPONENT NOP IDN01 SZA,RSS IF REAL NUMBER THEN JMP IDN57 GO DO REAL THING * LDA DXID,I GET THE DOUBLE EXPONENT WORD O< AND C377 ISOLATE THE NON EXPONENT BITS CLB AND DST DXID,I CLEAR THE WORD FOLLOWING DXID EQU *-1 IDN59 LDA T3IDN IS THE MANTI NEG.? (RETURN FROM REAL) CPA B55 RSS JMP IDN61 NO. * * * F.ID = -F.ID * SPC 1 LDB F.ID+3 CMB,CLE,INB 2'S COMPLEMENT F.ID+3 STB F.ID+3 LDB F.ID+2 CMB,SEZ,CLE INB STB F.ID+2 LDB F.ID+1 CMB,SEZ,CLE INB PROPAGATE CARRY STB F.ID+1 LDB F.ID CMB,SEZ,CLE INB STB F.ID JSB NOM.F RENORMALIZE IF NEEDED IDN61 LDA T0IDN .. RAL . FORM 8-BIT EXP (BASE 2) AND B377 . LDB F.IM CPB REA IS IT A REAL CONSTANT? JMP IDN60 YES * IOR DXID,I NO, IT IS DOUBLE JMP IDN62 * IDN57 LDA F.ID+1 CLEAR REAL EXPONENT AND BEYOND AND C377 CLEAR THE EXPONENT FIELD STA F.ID+1 CLA STA F.ID+2 STA F.ID+3 JMP IDN59 GO CHECK IF NEGATIVE * BM200 OCT -200 K63 DEC 63 B200 OCT 200 K14 DEC 14 C377 OCT 177400 B377 OCT 000377 SPC 1 NOM.F NOP LDA F.ID CHECK IF ALREADY NORMALIZED NOM01 RAL,SLA CMA SSA IF NORMALIZED JMP NOM.F,I RETURN * JSB LSID1 ELSE LEFT SHIFT CCB ADJUST THE EXPONENT ADB T0IDN STB T0IDN JMP NOM01 OK NOW? * IDN60 IOR F.ID+1 MERGE EXP FOR REAL STA F.ID+1 CLA IDN62 STA DXID,I LDB T0IDN CHECK BINARY EXPONENT MAGNITUDE SSB CMB,INB ADB BM200 FOR UNDERFLOW OR OVERFLOW. SSB JMP IDN64 # WITHIN RANGE * LDB T0IDN # DEFINITELY OUT OF RANGE SSB JSB CID.F SET F.ID=0, UNDERFLOW LDA K14 JSB WAR.F OVERFLOW OR UNDER FLOW IDN64 LDA F.SXF COMPLEX #? SZA,RSS JMP IDN46 NO *  LDA T2IDN IS IT REAL PART? SZA JMP IDN66 NO, IMAGINARY PART * LDA F.TC XOR B54 F.TC=',' ? SZA JMP IDN46 NO * LDA F.ID .. LDB F.ID+1 . STA IDB . SAVE REAL PART IN IDB STB IDB+1 .. CCA STA T2IDN SET T2 FOR IMAGINARY PART JMP IDN02 INPUT IMAGINARY PART * IDN66 LDA CPX.K STA F.IM SET F.IM TO COMPLEX LDA F.ID .. LDB F.ID+1 . IMAGINARY PART IN (F.IDI+2,F.IDI+3) STA F.IDI+2 STB F.IDI+3 LDA IDB .. LDB IDB+1 . REAL PART IN (F.IDI,F.IDI+1) WITH STA F.IDI . EXPS IN F.ID+3 & F.ID+1 RESPECTIVELY STB F.IDI+1 JSB RP.F )-INPUT OPERATOR JMP IDN50 * * NEGATIVE DECIMAL EXPONENT: DIVIDE BY 10 TO SCALE. * IDN68 ISZ T1IDN ADJUST DECIMAL EXPONENT NOP LDA KM50 =-50 STA CT DIVIDE LOOP COUNT LDA K3 SAVE THE LEAST BIT AND F.ID+3 FOR THE HIGH END STA T4IDN THE FINAL 15 BITS JSB RSID1 CLEAR THE LEAST BIT FOR RESULT JSB RSID1 SET FOR USE OF UNNORMALIZED -10 IDDB1 JSB LSID1 ARITH. LEFT SHIFT F.ID BY 1 LDA F.ID ADA KK29 =-10B5 TRIAL DIVIDE SSA,RSS GOES? STA F.ID YES. SSA,RSS ISZ F.ID+3 QUOTIENT BIT ISZ CT DIVIDE LOOP COUNTER JMP IDDB1 * LDA KM13 NOW DO FINAL 13 BITS STA CT LDB F.ID GET HIGH BITS FROM F.ID BRS,BRS CLEAR RESULT BITS FROM LOW END BLS,BLS SET BACK ADB T4IDN ADD IN THE SAVED LEAST BITS IDDB2 JSB LSID1 LEFT SHIFT ONE BIT (SAVES B) BLS SHIFT B ALSO LDA B DO TRIAL DIVIDE ADA KK29 =-10B5 SSA,RSS DID IT GO STA B YES UPDATE SSA,RSS THE ISZ F.ID+3 GOODIES ISZ CT AND م JMP IDDB2 AROUND WE GO * LDA KM3 ADDJUST THE BINARY EXPONENT ADA T0IDN BY -3 STA T0IDN * JMP IDN56 NORMALIZE * B54 OCT 54 K3 DEC 3 KM3 DEC -3 KM13 DEC -13 K4 DEC 4 KM50 DEC -50 KK29 OCT 154000 -10B5(FLOATING POINT SANS EXP.) IDB BSS 2 HOLDS REAL PART OF COMPLEX NUMBER CT BSS 1 DIVIDE LOOP COUNTER SPC 1 * POSITIVE DECIMAL EXPONENT: MULTIPLY BY 10 TO SCALE. * IDN70 CMA STA T1IDN ADJUST DECIMAL EXPONENT BY (-1) LDA T0IDN ADA K4 ADJUST BINARY EXPONENT STA T0IDN JSB RSID1 ARITH RIGHT SHIFT F.ID BY 1 JSB IDID F.IDI=F.ID=F.ID/2 JSB RSID1 JSB RSID1 F.ID=F.ID/8 JSB IDADD F.ID=F.ID+F.IDI=(5/8)*F.ID JMP IDN56 NORMALIZE F.ID SKP * * INPUT HOLLERITH CONSTANT * SPC 1 IDN72 LDB F.ID+3 [+/-]NDH LDA K20 CMB,INB,SZB,RSS SET HOLL. COUNT NEGATIVE JSB ER.F ERROR: EMPTY HOLLERITH STRING * STB F.ID+3 KEEP THE NEGATIVE COUNT LDA F.SID NOT CODE GEN.? SZA SCANING? JMP IDN03 YES. * ADB K8 LDA K65 SSB,RSS JMP IDN03 LESS THAN 9-CHAR. OK * LDB F.S2T,I GET THE CURRENT TOP OF STACK RBL,CLE,ERB CLEAR POSSIBLE SIGN BIT CPB SUBCL IF SUBROUTINE PRAM. JMP IHC00 GO INPUT A LONG STRING * JSB ER.F HOLLERITH COUNT .GT. 8 * IDN03 LDB F.ID+3 GET THE NEGATIVE COUNT BRS DIVIDE BY TWO STB HFLAG SET NEG. NO. WORDS FOR H FLAG ADB TPADD ADD THE BASE ADDRESS LDA B,I GET THE TYPE STA F.IM SET THE ITEM MODE LDB F.DID GET THE ADDRESS OF THE VALUE STB F.ID ARRAY AND SET IT LDA BLANK BLANK STA F.IDI+1 STA F.IDI+2 STA F.IDI+3 THE FIELD IHC03 JSB THS.F TEST HOLLERITH STRING ISZ F.IDNX+3 SETP THE COUNT JMP IHC04 COUNT WAS WAS ODD * LDA B40 PAD WITH A BLANK JSB PAK.F LDA F.PAK GET THE WORD STA F.ID,I STUFF IT JMP IHC06 GO FINISH * IHC04 JSB THS.F TEST HOLLERITH STRING LDA F.PAK PICK UP THE TWO CHARS STA F.ID,I AND PUT IN THE VALUE BUFFER LDA F.SID IF IN CODE GEN SZA,RSS ISZ F.ID STEP THE ADDRESS ISZ F.ID+3 DONE? JMP IHC03 NO GET THE NEXT CHAR. * IHC06 CLA CLEAR STA F.OPF THE PACK FLAG JSB ICH.F INPUT THE FOLLOWING CHAR. JMP IDN05 GO FINISH AND EXIT * IHC00 LDA TWPE IN THIS CASE WE ASSIGN AS JSB ESC.F WE NEED THE A.T. ADDRESS JSB AI.F TO POINT THE RECORD AT LDA F.RPL SAVE THE CURRENT STA T1IDN LOCATION COUNTER DLD F.LLO SAVE THE CURRENT LOAD ADDRESS STA T3IDN IN LOCAL TEMPS STB T2IDN LDA F.A SET UP THE CLB,CCE RAL,ERA ORG JSB OW.F SEND IT OCT 20000 R001 LDA K2 SET THE STA F.OPF PACKING FLAG ICH01 JSB THS.F TEST THE STRING ISZ F.ID+3 STEP THE CHARACTER COUNT JMP ICH01 MORE AND AROUND WE GO * LDA B40 FOURCE JSB PAK.F OUT ANY ODD CHAR. CLA CLEAR STA F.OPF THE PACK FLAG LDA F.RPL COMPUTE CMA,INA THE NO. OF WORDS ADA T1IDN USED STA F.RPL SET NEG. WORD COUNT IN A.T. JSB DL.F USING DEFINE LOCATION (ALSO SETS F.AT=REL) LDA T1IDN RESTORE STA F.RPL THE LOCATION COUNTER LDA T3IDN RESTOR LDB T2IDN THE SAVE LOCATION JSB OW.F OCT 20000 JSB ICH.F GET THE DELIMITER CPA B54 ',' ONLY LEGAL DELIM IS RSS CPA B51 ')' COMMA OR CLOSE PARN. JMP IDN50 GO SHOW GO EXIT * LDA uK65 ELSE SET UP AND SEND JSB ER.F THE ERROR * * SPC 1 IDN76 LDA F.IM [+/-]ND.MD(M>0)![+/-]ND.[MD](D!E)!?? CPA INT JMP IDN31 F.IM=INT * LDA K16 LDB F.SID IF STMT. SCAN SZB SKIP THE BFLAG TEST JMP IDN50 AND JUST EXIT * LDB BFLAG 'B' FLAG SET? SZB JSB ER.F YES. ILLEGAL OCTAL * JMP IDN54 * BFLAG NOP HFLAG NOP BLANK ASC 1, BLANKS TWPE OCT 40000 SUBCL BYT 32,1 OPCODE AND PRIORITY FOR STACKED SUB CALL B40 OCT 40 B15 OCT 15 K16 DEC 16 K20 DEC 20 K65 DEC 65 F.DID DEF F.IDI SPC 1 F.ID BSS 4 CAUTION F.IDI MUST FOLLOW F.ID OR F.IDI BSS 4 F.ID MUST BE 5 WORDS (DST DXIDI) T0IDN BSS 1 1. SIGN OF EXP, 2. EXP (POWER OF 2) T1IDN BSS 1 EXP. (POWER OF 10) T2IDN BSS 1 REAL(=0) OR IMAGINARY(NON-0) OF A CMPLX T3IDN BSS 1 1.TERMINATING OPR, 2.SIGN OF MANTISSA SPC 2 * TEST HOLLERITH STRING SPC 1 THS.F NOP JSB IC.F INPUT COLUMN JSB PAK.F PACK CHAR. INTO F.PAK CPA B15 'C/R' RSS HOLLERITH STRING TERMINATED JMP THS.F,I * LDB F.SID SZB,RSS JSB ER.F ERR 13: HOLLERITH STRING TERMINATED * JMP IDN50 EXIT IDN.F WITH F.TC=C/R * * * **************************** * *ARITH RIGHT SHIFT F.ID BY 1 * * **************************** * SPC 1 RSID1 NOP LDB F.ID WORK FROM THE HIGH END DOWN CLE,SSB SET UP TO PROP THE SIGN CCE ERB SHIFT THE HIGH BITS STB F.ID PUT AWAY LDA F.ID+1 GET THE MF.ID-BITS ERA SHIFT THEM STA F.ID+1 PUT AWAY LDB F.ID+2 NOW THE LOW ONES ERB SHIFT STB F.ID+2 PUT AWAY LDA F.ID+3 ERA STA F.ID+3 JMP RSID1,I SKP * ******̭********************* * *ARITH LEFT SHIFT F.ID BY 1 * * *************************** * RETURN A = F.ID B NOT CHANGED (USED IN NORM) SPC 1 LSID1 NOP LDA F.ID+3 START FROM LOW END CLE,ELA STA F.ID+3 LDA F.ID+2 START FORM LOW END ELA SHIFT IN A ZERO OUT THE CARRY STA F.ID+2 PUT THE LOW AWAY LDA F.ID+1 GET THE MF.ID BITS ELA SHIFT THEM STA F.ID+1 PUT AWAY LDA F.ID NOW THE HIGH ORDER BITS ELA,RAL BE SURE TO KEEP THE SIGN ERA OK STA F.ID PUT IT AWAY JMP LSID1,I SPC 2 * *********************** * * F.ID = F.ID + F.IDI * * ************************ * * RETURN B=F.ID, A NO CHANGE (USED IN DIV LOOP) SPC 1 IDADD NOP CLE LDB F.ID+3 ADB F.IDI+3 STB F.ID+3 CLB,SEZ,CLE INB ADB F.ID+2 ADB F.IDI+2 STB F.ID+2 CLB,SEZ,CLE INB ADB F.ID+1 ADB F.IDI+1 STB F.ID+1 CLB,SEZ INB ADB F.ID ADB F.IDI STB F.ID JMP IDADD,I * * * ******************* * * CLEAR F.ID TO 0 * * ******************* SPC 1 CID.F NOP CLA STA F.ID STA F.ID+1 STA F.ID+2 STA F.ID+3 JMP CID.F,I SPC 2 * ********************** * * MOVE F.ID TO F.IDI * * ********************** SPC 1 IDID NOP LDA DF.ID SET UP FOR LDB F.DID MOVE WORDS JSB .MVW MOVE WORDS DEF K4 NOP JMP IDID,I SPC 2 DF.ID DEF F.ID * * * ******************** * * CLEAR F.IDI TO 0 * * ******************** SPC 1 CDI.F NOP CLA STA F.IDI STA F.IDI+1 STA F.IDI+2 STA F.IDI+3 JMP CDI.F,I SPC 2 1 SKP * ********************** * * INPUT DIGIT STRING * * ********************** SPC 1 * EXIT: DCT=NUMBER OF DIGITS IN STRING * F.ID,F.ID+1,F.ID+2,F.ID+3 =DIGIT STRING IN BINARY SPC 1 IDS.F NOP CLA STA DCT INITIALIZE DIGIT COUNT TO 0 STA T1IDS BINARIZED OCTAL STRING STA T2IDS NON-OCTAL DIGIT FLAG STA T3IDS NON-VALID OCTAL NO. FLAG JSB ICH.F INPUT CHARACTER SZB DIGIT? JMP IDS10 NO. EXIT. * IDS03 LDA F.ID AND B74K 74000 COULD F.ID OVFL? SZA JMP IDS06 YES. DON'T MERGE NEW DIGIT. * JSB LSID1 PRIOR VALUE *10: F.ID=2*F.ID JSB IDID F.IDI=F.ID JSB LSID1 JSB LSID1 F.ID=8*F.ID JSB IDADD F.ID=F.ID+F.IDI JSB CDI.F CLEAR IDI TO 0 LDA F.TC DIGIT JUST INPUT AND B17 GET DIGIT VALUE STA F.IDI+3 AND K8 SZA ISZ T2IDS NOT OCTAL DIGIT. JSB IDADD ADD TO PRIOR LDA T1IDS AND KK14 17777 CPA T1IDS RSS ISZ T3IDS OCTAL NO. OVERFLOW. ALF,RAR ADA F.IDI+3 ADD NEW DIGIT VALUE STA T1IDS T1=T1*2**3+F.TC IDS04 ISZ DCT BUMP DIGIT COUNT LDA F.IM ITEM MODE JSB ESC.F SET F.NT=1, F.IU=VAR/CON, F.IM=(A) JSB ICH.F INPUT CHAR SZB,RSS DIGIT? JMP IDS03 YES. * CPA "B" DIGIT STRING ENDED BY "B"? JMP IDS12 YES. CHECK FOR VALID OCTAL. * IDS10 LDA DCT NUMBER OF DIGITS IN STRING LDB F.ID+3 GET RESULT TO B IN CASE JMP IDS.F,I * IDS06 ISZ OVFL BUMP OVERFLOW COUNTER JMP IDS04 * IDS12 ISZ BFLAG SET 'B' FLAG JSB CID.F CLEAR F.ID LDB INT LDA F.IM SZA,RSS STB F.IM SET F.IM=INT IF IT WAS 0 LDA K21 LDB T2IDS ANY NON-OCTAL DIGIT? SZB JMZLP IDS20 YES. ILLEGAL, MAYBE * CPB T3IDS OVERFLOW? JMP IDS14 NO, OCTAL IS VALID. * LDA K16 IDS20 LDB F.SID SZB,RSS SKIP IF SCAN OR STMNT F.ID. JSB WAR.F ILLEGAL OCTAL # JMP IDS15 * IDS14 LDA T1IDS OCTAL STRING STA F.ID+3 IDS15 JSB ICH.F INPUT CHAR. JSB FOP.F FINISH OPERATOR JMP IDS10 * T1IDS NOP OCTAL STRING T2IDS NOP NON-OCTAL DIGIT FLAG T3IDS NOP INVALID OCTAL NO. FLAG DCT NOP DIGIT COUNT OVFL NOP OVERFLOW COUNTER KM6 DEC -6 B17 OCT 17 K21 DEC 21 "B" OCT 102 'B' B74K OCT 74000 KK14 OCT 17777 SKP * ***************** * * INPUT LOGICAL * * ***************** SPC 1 * TO INPUT THE LOGICAL OR RELATIONAL OPERATOR FOLLOWING * EXIT: (A)=F.TC= THE FIRST TWO LETTERS OF THE OPERATOR SPC 1 ILG.F NOP LDA PCNT PACK COUNT CMA,INA ADA K2 (A)=2-PCNT CLE,SZA IF NONE TO BE INPUT JUST SKIP IT JSB IA.F INPUT (A) CHARACTERS.(OR TO DELIMETER) LDA F.PAK STA T0ILG STORE THE FIRST TWO CHARACTERS LDA F.SID STATEMENT ID FLAG SET? SZA JMP ILG01 YES. * LDA F.TC CPA B15 C/R? JMP ILG02 YES, ERROR 28 FOR ILLEGAL '.' * ILG01 LDA K4 4 SEZ,RSS IF DELIMETER NOT FOUND YET JSB IA.F GET 4 CHAR.(LONGEST LOGICAL IS .FALSE.) LDA F.SID STATEMENT ID FLAG SET? SZA JMP ILG.F,I YES, EXIT * ILG02 LDA B56 '.' JSB TCT.F F.TC MUST BE '.' LDA T0ILG STA F.TC FIRST 2 LETTERS OF THE OPERATOR JMP ILG.F,I * T0ILG OCT 0 TEMP CELL SAVING FIRST TWO CHARACTERS B56 OCT 56 . K2 DEC 2 SPC 2 * ******************* * * FINISH OPERATOR * * ******************* SPC 1 * ENTRY: F.TC=DELIMITER OPERATOR * EXIT: IF ENTRY F.TC IS '.', F.TC WILL BE SET TO CONTAIN * THE 1ST TWO LETTERS OF THE LOGICAL OR RELATIONAL * OPERATOR, ELSE F.TC IS UNCHANGED. SPC 1 FOP.F NOP LDA F.TC F.TC='.' ? CPA B56 CLA,RSS JMP FOP.F,I NO, EXIT * STA PCNT SET PACK COUNT TO 0 JSB ILG.F INPUT LOGICAL JMP FOP.F,I SKP * ******************** * * )-INPUT OPERATOR * * ******************** SPC 1 RP.F NOP LDA B51 F.TC MUST BE ')' JSB TCT.F F.TC-TEST JSB ICH.F INPUT CHARACTER JSB FOP.F FINISH OPERATOR JMP RP.F,I * B51 OCT 51 SPC 2 * ********************* * * PACK (A) TO F.PAK * * ********************* SPC 1 * TRANSFER F.PAK TO THE OBJECT OUTPUT BUFFER * OR THE EQUIVALENCE BUFFER SPC 1 PAK.F NOP LDB A LDA F.PAK AND B377 ALF,ALF (A)HI=CHAR. TO BE PACKED IOR B COMBINE NEW CHAR WITH PRIOR STA F.PAK ISZ PCNT INCREMENT PACK COUNT BY 1 CCA ADA F.OPF STA F.OPF OUTPUT F.PAK? SZA JMP PACK2 NO, NOT YET * LDB K2 STB F.OPF CLA,INA CPA F.SLF IN SPECIFICATION STMTS? JMP PACK4 YES. MUST BE EQUIV * LDA F.EQE ERROR IN EQUIV GROUP? SZA JMP PACK2 YES, DO NOT OUTPUT ASCII CHARACTER * LDA F.PAK JSB OW.F OUTPUT WORD R010 OCT 40000 R=2 FOR ASCII DATA. PACK2 LDA F.PAK AND B377 (A)=CHAR. JUST PACKED JMP PAK.F,I EXIT * PACK4 CCA ADA F.E STA F.E F.E=F.E-1 CPA F.LO AT END OF ASSIGNMENT TABLE? JMP PACK6 THEY OVERLAP. * CMA,INA ADA F.LO SSA,RSS JMP F.OFE DATA POOL FULL; BITCH. * PACK6 LDA SLINE IS PREVIOUS SOURCE LINE NO. SAME z<:6 CPA F.CIN AS CURRENT LINE NO.? JMP PACK8 YES- SKIP SPECIAL XREF PROCESS. * SSA IS SLINE<0 TO INDICATE OUT OF JMP PACK8 TABLE SPACE IN F4.0? YES, SKIP. * LDA F.LLT IF F.LLT=F..DP, WE ARE OUT OF CPA F.LLT+1 TABLE SPACE IN F4.0. XREF MUST CCA,RSS BE DISCONTINUED FOR EQUIVALENCE. JMP PACK7 NO- SET UP XREF INFO IN TABLE. * STA SLINE JMP PACK8 AND CONTINUE WITH PACK. * PACK7 LDB F.CIN CURRENT LINE NO. STB A,I STORE IT IN TABLE IN F4.0. STB SLINE INA BUMP POINTER TO TABLE. LDB F.E EQUIVALENCE TABLE POINTER STB A,I STORE IT IN TABLE IN F4.0. INA UPDATE F.LLT FOR NEXT LINE STA F.LLT OF EQUIVALENCE STATEMENTS. PACK8 LDA F.PAK 2 CHARACTERS TO BE PACKED IN LDB F.E MAKE SURE (B)=F.E STA B,I STORE INTO THE EQUIVALENCE BUFFER JMP PACK2 * F.PAK NOP FIRST 2 CHARS IN STRING PCNT NOP F.E NOP EQUIV TABLE POINTER F.LLT NOP BEGINING OF LINE LOCATION TABLE SET HERE NOP DON'T MOVE (INIT VIA F.LLT) SLINE NOP * * ************ * *TYPE TABLE* * ************ * * THIS TABLE CONTAINS THE DEFAULT OR IMPLICIT TYPE * FOR EACH OF THE TWENTY SIX INITIAL CHARACTERS * IT IT INITIALIZED BY THE INITIALIZE SEGMENT BEFORE * EACH NEW MODULE * TYPET ASC 4, A-H TYPE REAL OCT 10020,10020,10020 I-N TYPE INTEGER ASC 6, M-Z TYPE REAL * * THE TABLE IS CHANGED BY THE 'IMPLICIT' STATEMENT * END < ` 92060-18093 1726 S C0122 FTN4 SEGMENT ID SUB.              H0101 f|ASMB,L HED FTN4 - SEGMENT NAME ADDRESS FETCH * * *************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * * REPRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * *************************************************************** * NAM SEG.F,8 92060-16093 770531 REV. 1726 ENT SEG.F * * THIS ROUTINE FORMS A SEGMENT NAME, F4.N, WHERE N IS THE * SEGMENT NUMBER PASSED AS AN INPUT PARAMETER. UPON RETURN, * THE B-REGISTER CONTAINS THE ADDRESS OF THE SEGMENT NAME. * * CALLING SEQUENCE: JSB SEG.F * DEF SEG# SEGMENT NUMBER * * RETURNS: B = ADDRESS OF THE SEGMENT'S NAME * (5 CHARACTERS) * * SEG.F NOP ENTRY LDB SEG.F,I GET ADDRESS OF SEGMENT # LDB B,I GET THE SEGMENT NUMBER ADB ".0" ADD TO FORM ".N" STB NAM SAVE IN NAME ARRAY LDB NAMA GET ADDRESS ISZ SEG.F STEP RETURN JMP SEG.F,I RETURN * ".0" ASC 1,.0 NAMA DEF *+1 ASC 1,F4 NAME = F4.N NAM NOP ASC 1, A EQU 0 B EQU 1 END 5  92060-18094 1805 S C0422 FTN4 SEGMENT 0              H0104 #ASMB,Q,C HED ** 16K FTN4 COMPILER (SEG: F4.0) SPECIFICATION STATEMENTS ** NAM F4.0,5 92060-16094 780310 REV. 1805 * ***************************************** * FORTRAN-4 COMPILER OVERLAY 0 ***************************************** * * THIS OVERLAY PROCESSES COMMON, DIMENSION, AND * EQUIVALENCE STATEMENTS, PROGRAM AND DATA STATEMENTS, * AND TYPE DECLARATIONS. * * * *************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * * REPRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * *************************************************************** * * * * * * *************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * * REPRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * *************************************************************** * * * * * * EXT'S WITH A LEADING 'F.' ARE VARIABLES OR JUMP TARGETS * * THE COLUMN THE EXT STARTS IN DEFINES THE SUBROUTINE IT IS * DEFINED IN AS FOLLOWS * 2 -- OA.F (WRITE PASS FILE ROUTINES) * 3 -- NEX.F (STATEMEXTS THAT DON'T CONTAIN EXPRESSIONS) * 4 -- FA.F (THE ASSIGNMEXT TABLE ROUTINES) * 5 -- EX.F (STATEMEXTS USING THE EXPRESSION EVALUATOR) * 6 -- IC.F (THE CHARACTER INPUT ROUTINES) * 7 -- IDN.F (THE TOKEN INPUT ROUTINES) * 8 -- FTN4 ( THE MAIN) EXT F..DP BASE OF SYMBOL TABLE EXT F..E DIMENSIONS CONSTANT BIT FROM ASSIGNS TABLE EXT F.A ASSIGNMEXT TABLE ADDRESS (CURRENT ENTRY) EX JMP GRE01 NOT BLOCK COMMON SO OK * LDB T7GRE GET ADDRESS OF MASTER ENTRY CPB F.EMA EMA ENTRY? JMP GRE17 YES GO UP DATE SIZE IF NEEDED * LDA F.SFF GET 'WHAT WE ARE DOING' FLAG CPA K2 BLOCK DATA SUBPROGRAM?? INB,RSS YES SKIP TO SET JMP GRE16 NO SKIP THE WHOLE THING * GRE01 STB SAVE1 SET THE ADDRESS OF THE SIZE OF BLOCK COMMON LDA F.D0 SIZE OF 2ND ARRAY ADA T1GRE BASE OF 2ND ARRAY LDB A SAVE IN (B) CMA,INA ADA SAVE1,I (A)=COMSIZ-(D0+T1) SSA STB SAVE1,I NEW COMMON SIZE GRE16 LDA F.TC CPA B54 ',' JMP GRE14 F.TC=, JSB RP.F )-INPUT OPERATOR JSB BEG.F BLANK EQUIVALENCE GROUP SZA (A)=# OF EQUIV GROUPS LEFT JMP GRE04 GRE27 CCA ASSIGN SPECIFICATION STA F.EQF SET F.EQF=-1 LDA F.SCC _. STA F.CC . RESTORE F.CC CLA . STA F.EQE _. STA XRFLG TURN OFF CROSS REFERENCE. LDA SAVX1 RESTORE CURRENT LINE NO. STA F.CIN LDA SAVX2 RESTORE THIS LINE NO. TOO STA F.CLN JMP ASPEC ASSIGN SPECIFICATION SPC 1 GRE17 DLD F.D0 GET ARRAY SIZE ADA T1GRE ADD ITS OFFSET RAL,CLE,SLA,ERA IN EMA INB PROP THE CARRY ADB T6GRE NOW SAVE IN CASE STA T1GRE IT IS LARGER STB T6GRE DLD F.EMS GET THE CURRENT SIZE CMA,INA RAL,CLE,SLA,ERA PROP THE CARRY CMB,RSS CMB,INB IF NEEDED ADA T1GRE SUBTRACT FROM NEW RAL,CLE,SLA,ERA PROPOSED LENGTH INB ADB T6GRE AND TEST SSB THE SIGN JMP GRE16 CURRENT SIZE IS STILL TOPS * LDA T1GRE NEW TOP SIZE LDB T6GRE GET TO REG.S DST F.EMS AND SET IN MAIN FOR PASS II JMP GRE16 GO TEST FOR NEXT ELEMENT. * * 1 SAVX1 NOP SAVX2 NOP B50 OCT 50 B51 OCT 51 COMF NOP COMMON FLAG (0=NO COMMON IN GRP) DCSZ DEF F.CSZ DEF TO SIZE OF BLANK COMMON SPC 1 GRE28 JSB SEC.F F.EQF=F.DO-E,F.CC=121 JSB OLR.F OUTPUT LOAD ADDRESS=RPL LDA F.RPL STA SVRPL SAVE RPL CLA STA M # OF F.A PTRS IN EQUIV STACK TBL STA LLIM LOWER LIMIT CCA ADA F.E (A)=F.E-1 STA P BASE LOC. OF EQUV STACK TABLE JSB ICH.F INPUT CHARACTER CPA B50 '(' RSS JMP GRE03 EQUIV. GRP NOT START WITH '(' JSB LRP.F (A)=F.E+F.EQF-1 STA F.LPR '(' LOCATION JSB ILS.F INPUT LIST ELEMENT & SIZE LDA S1 STA T1GRE T1=S1 LDA F.A STA F F=F.A LDA F.D0 STA ULIM UPPER LIMIT CLA JSB SEP.F SEARCH EQU PTR STACK CLA JSB DAF.F DEFINE F.AF=0 LDA F.TC CPA B54 ',' CLA,RSS JMP GRE07 TOO MANY CHARS IN AN OPERAND STA COMF RESET COMMON FLAG GRE30 JSB ILS.F INPUT LIST ELEMENT & SIZE LDA F.D0 SIZE OF LIST ELEMENT STA T4GRE T4=D0 CLA JSB SEP.F SEARCH EQU PTR STACK SZA,RSS JMP GRE32 STA COMF SET COMMON FLAG NON ZERO LDA S1 CPA T1GRE JMP GRE32 T1=S1 LDA B50 JSB ER.F ERR 40: SAME NAME WITH DIFFERENT DISPL. SPC 1 NBAS BSS 1 NEW BASE OF EQUV GROUP T0GRE BSS 1 T1GRE BSS 1 T2GRE BSS 1 T3GRE BSS 1 T4GRE BSS 1 T5GRE BSS 1 T6GRE BSS 1 T7GRE BSS 1 SKP GRE32 LDA F.A STA T2GRE LDA F STA F.A JSB FA.F FETCH ASSIGN LDB S1 (A)=AF(F) CMB,INB ADA B ADA T1GRE STA NBAS NEW BASE LDB T2GRE RESTORE F.A STB F.A JSB DAF.F DEFINE F.AF=NBAS LDB A (A)=(B)=NBAS  CMA,INA ADA LLIM IS LLIM .LT. NBAS? SSA,RSS STB LLIM YES, SET LLIM=NBAS ADB T4GRE (B)=NBAS+D0(F.A) LDA B CMA,INA ADA ULIM IS ULIM .LT. NBAS+D0 ? SSA STB ULIM YES, SET ULIM=NBAS+D0 LDA F.TC CPA B54 ',' JMP GRE30 F.TC=, JSB RP.F )-INPUT OPERATOR LDA F.TC CPA B54 ',' JMP GRE34 CPA B15 C/R JMP GRE34 JMP GRE07 ERR 81: ILLEGAL GROUP SEPARATOR SPC 1 GRE34 JSB LRP.F (A)=F.E+F.EQF-1 STA F.RPR '(' LOCATION JSB BEG.F BLANK EQUIVALENCE GROUP SZA,RSS JMP GRE46 F.NEQ = 0. GRE36 LDA F.TC CPA B15 CLB,RSS F.TC=C/R JMP GRE38 LDA COMF COMMON FLAG SET? SZA,RSS JMP GRE46 NO STB COMF RESET COMMON FLAG LDA F.NEQ NO. OF EQUIV GROUPS SZA,RSS JMP GRE46 EMPTY JSB SEC.F F.EQF=F.DO-E, F.CC=121 GRE38 JSB ICH.F INPUT CHARACTER CPA B50 '(' RSS JMP GRE03 GROUP NOT START WITH '(' JSB LRP.F (A)=F.E+F.EQF-1 STA F.LPR '(' LOCATION LDA F.CC STA T3GRE T3=F.CC LDA F.EQF STA EPTR SAVE F.EQF GRE40 JSB ILS.F INPUT LIST ELEMENT & SIZE CLA,INA JSB SEP.F SEARCH EQU PTR SZA,RSS JMP GRE42 NOT IN EQU PTR TABLE STA F SAVE POINTER IN F STA COMF SET COMMON FLAG LDA S1 STA T1GRE T1=S1 LDA T3GRE STA F.CC RESTORE F.CC LDA EPTR STA F.EQF RESTORE F.EQF JMP GRE30 SPC 1 EPTR NOP SAVE F.EQF K84 DEC 84 SPC 1 GRE42 LDA F.TC CPA B54 ',' JMP GRE40 F.TC=, JSB RP.F )-INPUT OPERATOR JMP GRE36 SPC 1 GRE46 LDB LLIM CMB,INB ADB ULIM ADB F.RPL STB F.RPL X<:6 RPL=RPL+ULIM-LLIM LDA K84 SSB JMP F.ABT RPL OFLOW: FATAL ERR 84. LDB KM2 ADB F.E (B)=F.E-2 GRE48 STB P LDA M NO. OF PTRS IN STACK TABLE SZA,RSS JMP GRE26 LDA P,I PICK UP THE PTR & STORE IT IN F.A STA F.A JSB FA.F (A)=AF(F.A) LDB LLIM CMB,INB ADA B ADA SVRPL ADD RPL SAVED STA T1GRE JSB DAF.F AF(F.A)=AF(F.A)-LLIM+SVRPL LDA REL JSB DAT.F F.AT=REL CCA ADA M STA M M=M-1 CCB ADB P P=P-1 JMP GRE48 SPC 1 * DATA & TEMP CELLS FOR GROUP EQUIVALENCE SPC 1 SVRPL BSS 1 SAVE RPL M BSS 1 NO. OF F.A PTRS IN EQUV STACK TBL P BSS 1 BASE LOC OF EQUV STACK TABLE LLIM BSS 1 LOWER LIMIT OF EQUV GROUP ULIM BSS 1 UPPER LIMIT OF EQUV GROUP REL OCT 1000 F.AT=1, RELATIVE WITHIN PROGRAM )<KM1 DEC -1 KM2 DEC -2 SPC 1 B377 OCT 377 CMAB ASC 1,, SPC 2 * ***************** * * SET F.EQF & F.CC * * ***************** SPC 1 SEC.F NOP LDA F.E CMA,INA ADA F.DO STA F.EQF F.EQF=F.DO-E LDA K121 STA F.CC F.CC=121 JMP SEC.F,I SPC 1 K121 DEC 121 SKP * *************************** * * BLANK EQUIVALENCE GROUP * * *************************** SPC 1 * BLANK THE AREA F.RPR TO F.LPR SPC 1 BEG.F NOP LDB F.RPR ')' LOCATION LDA B,I CPA CMAB ', ' ADB KM1 BEG02 LDA BL2B 2 BLANKS INB STA B,I LDA B CMA ADA F.LPR '(' LOCATION SSA,RSS JMP BEG02 (B) .LE. F.LPR LDA F.TC CPA B15 JMP BEG06 F.TC=C/R BEG04 CCA ADA F.NEQ STA F.NEQ F.NEQ=F.NEQ-1 JMP BEG.F,I SPC 1 BEG06 LDA KK27 C/R,C/R STA F.LPR,I BEG08 LDA F.LPR CPA F.DO JMP BEG04 END OF MEMORY REACHED. ISZ F.LPR LDA F.LPR,I CPA BL2B 2 BLANKS JMP BEG08 AND B377 LDB KK28 ),C/R CPA B54 ',' STB F.LPR,I LDB KK27 C/R,C/R LDA F.LPR,I CPA CMAB ', ' STB F.LPR,I JMP BEG04 SPC 1 KK27 OCT 6415 C/R,C/R BL2B ASC 1, SKP * ************************************ * * SEARCH EQUIVALENCE POINTER STACK * * ************************************ SPC 1 * ENTRY: (A)=0 ENTER TO STACK IF NOT ALREADY IN TABLE * (A)=1 NEVER ENTER THE STACK * EXIT: (A)=0 IF NO MATCH, ELSE (A)=PTR OF ENTRY IN ASSI TABLE SPC 1 SEP.F NOP STA T0SEP SAVE ENTRY (A) LDA M NO. OF ITEMS IN STACK CMA,INA,SZA,RSS JMP SEP04 EMPTY STA T1SEP T1=-M LDB KM2 |-2 ADB F.E SEP02 LDA B,I CPA F.A JMP SEP.F,I MATCHED; RETURN. ADB KM1 (B)=NEXT STACK LOCATION ISZ T1SEP STACK EXHAUSTED? JMP SEP02 NO SEP04 LDB T0SEP TO ENTER INTO STACK? SZB JMP SEP06 NO, EXIT CCA ADA P STA P P=P-1 LDB F.LO LAST WD LOC OF ASSI TBLE +1 CMB,INB ADB A SSA P .GE. F.LO ? JMP F.OFE DATA POOL OVERFLOW LDA F.A STA P,I STORE F.A INTO STACK ISZ M M=M+1 SEP06 CLA JMP SEP.F,I SPC 1 T0SEP BSS 1 T1SEP BSS 1 SKP * ************************ * * ASSIGN SPECIFICATION * * ************************ SPC 1 * TO ASSIGN STORAGE TO THE REMAINDER OF THE VARIABLES * & ARRAYS MENTIONED IN THE SPECIFICATION STATEMENTS SPC 1 ASPEC LDA F.DP DATA POOL BASE ADDR. STA F.A ASPE4 JSB GNA.F GET NEXT F.A SSA,RSS JMP ASPE6 END OF ASSIGNMENT TABLE JSB FA.F FETCH ASSIGNS LDA F.AT IF CPA DUM A DUMMY JMP ASPE4 SKIP IT * LDA F.IU CPA ARR RSS F.IU=ARRAY JMP ASPE4 F.IU=VAR, DON'T ASSIGN UNTIL 'END' JSB NWI.F F.D0=# OF WDS FOR ITEM JSB AA.F ASSIGN ADDRESS JMP ASPE4 SPC 1 ASPE6 LDA F.SLF CHECK STATEMENT LEVEL FLAG ADA KM3 >2? SSA WELL? JMP F.S02 NO, GO TO 1ST NON-SPEC. CHECK LDA K2 SET IT STA F.SPF TO ONE JMP F.S03 GO TO F4.1. SPC 1 COM.. OCT 4000 F.IM=4, COMMON LDAI OCT 62000 STAI OCT 72000 K5 DEC 5 KM4 DEC -4 K68 DEC 68 K85 DEC 85 KM7 OCT -7 KM9 DEC -9 SPC 1 * ************************** * * (A)='(' OR ')' ADDRESS * * ************************** SPC 1 LRP.F NOP CCA ADA F.EQF ADA F.E } (A)=F.E+F.EQF-1 LDB A ADB KM7 STB F.RPR FOR ERROR PRINT-OUT PURPOSES JMP LRP.F,I SKP * ********************** * * ONE OF BAD 9 CHECK * * ********************** SPC 1 BAD9C NOP JSB NTI.F MOVE NID TO F.IDI LDA F.DID JSB MPN.F MOVE PROG NAME TO PBUF,ERBF,HEAD LDB F.A CNECK IF NEW SYMBOL CPB F.EMA IF ALREADY USED AS EMA NAME JMP COM09 GIVE ERROR 4 (CONFLICT WITH COMMON) * ADB F.NW SHOULD BE ADDRESS OF CPB F.S2B STACK 2 JMP BAD9C,I YES OK. * LDA F.TC SAVE THE CURRENT DELIMITER STA T1BAD LOCALLY CLA NOW ZAP IT STA F.TC SO IT WILL BE PROPERLY ENTERED IN THE TABLE STA F.IU MAKE SURE WE DON'T CARRY OVER A SUB FLAG JSB AI.F TRY AGAIN LDA T1BAD RESTOR THE STA F.TC DELIMETER LDB F.S2B SHOULD BE A NEW ENTRY NOW JMP BAD9C,I RETURN SPC 1 T1BAD NOP SKP * ********************** * * FUNCTION PROCESSOR * * ********************** SPC 1 F.FUN CLA,INA STA F.SFF SET FUNCTION FLAG SPC 1 * ************************ * * SUBROUTINE PROCESSOR * * ************************ SPC 1 F.SUB LDB F.LSF 1ST STATEMENT? SZB JMP SUBP1 YES * NFSTM LDA K43 JSB ER.F PROG/SUBR/FUNCTION NOT 1ST STATM SPC 1 K7 DEC 7 K43 DEC 43 K74 DEC 74 K76 DEC 76 SPC 1 SUBP1 CLA SET STMT. LEVEL BACK TO ZERO STA F.SPF INCASE IT IS A TYPED FUNCTION LDA K7 STA PROK1,I SUBR/FUNC = TYPE 7 ISZ F.DCF SET DIM,COM FLAG TO FOOL AI.F IN CASE OF '(' JSB INM.F INPUT NAME JSB BAD9C CHECK THE BAD9 TABLE LDB F.A STB F.SBF SET SUBPROGRAM FLAG LDA F.MFL MODE FLAG SET? LDB A IOR K8  SET EXPLICIT TYPE FLAG SZB TYPE BEING SET? JSB DIM.F YES. DEFINE F.IM LDA F.TC CPA B54 STRING AFTER? JMP SUBP6 YES GO HANDLE * CPA B15 JMP SUBP6 F.TC=C/R: NO ARGUMENTS. * LDA B50 CHECK FOR JSB TCT.F '(' SUB00 LDA F.A GET F.A FOR LINKING STA F SET FOR EXCHANGE LINKS JSB ISY.F INPUT THE DUMMY NAME JSB FXC.F CHECK IF IN FIX-EXT TABLE? CLA CLEAR WAR.F AS A FLAG STA WAR.F TO BE TESTED FOR WARNINGS LATER LDB F.NT IF NOT A NAME LDA K74 SZB SEND JSB WAR.F WARNING LDB F.A IF SAME AS NAME CPB F.SBF JSB WAR.F SEND ALSO LDA K76 IF ALREADY DUM LDB F.AT THEN CPB DUM DOUBLY DEFINED DUMMY JSB WAR.F SEND MESSAGE CLA CLEAR JSB DIU.F THE F.IU LDA DUM SET F.AT JSB DAT.F TO DUM LDA WAR.F IF NO WARNINGS SENT SZA THEN SKIP TO THE LINK JMP SUB01 ELSE SKIP LINKING IT IN * LDA F.A SET LINK OF CURRENT TO SELF LDB A INB SO STA B,I WE CAN LINK IN TO LIST JSB EL.F LINK IN THE CURRENT LIST SUB01 LDA F.TC ANY MORE?? CPA B54 ',' JMP SUB00 YES GO GET IT * LDA B51 ')' TEST FOR FINAL ')' JSB TCT.F JSB ICH.F PASS IT SUBP4 LDA F.DO INITIALIZE ????????????????????? STA F.D F.D=F.DO SUBP5 LDA F.TC JMP PROG9 C/R TEST SPC 1 LDA F.RPL SUBP6 LDB F.SFF FUNCTION? LDA B52 SZB JSB ER.F YES. ERR 42: NO ARGUMENT LIST STB F.ARF NO. OF ARGUMENTS =0 JMP SUBP4 SKP * ********************************** * * BLOCK DATA STATEMENT PROCESSOR * * ****************o,****************** * F.BLK LDA K2 SET PROGRAM TYPE SWITCH STA F.SFF TO 2 LDA F.LSF TEST IF FIRST STATEMENT SZA,RSS WELL? JMP NFSTM NO GO BITCH * LDA K7 SET UP TO INPUT STA PROK1,I PROGRAM NAME JSB IDN.F INPUT POSSIBLE BLOCK DATA NAME LDA F.NT GET ONE? SZA JMP PROG1 NO BITCH * JMP SUBP5 GO TEST FOR PRAM STRING. SKP * ******************************* * * PROGRAM STATEMENT PROCESSOR * * ******************************* * * READ "PROGRAM PNAME,(TYPE,PRIOR,RES,EMULT,HR,MIN,SEC,MS)" * TEXT FOLLOWING ")" TO EXTEND NAM RECORD SPC 1 F.PRO LDA F.LSF 1ST STATEMENT? SZA,RSS JMP NFSTM NO, ERROR LDA K3 STA PROK1,I DEFAULT BKGND DISK RESIDENT JSB EXN.F EXAMINE NEXT CHAR. SZB,RSS DIGIT? JMP PROG1 YES. LOSE. CPA B15 'C/R' CLA,INA,RSS JMP PROG4 STA F.CC F.CC=1 JMP PROG6 SPC 1 PROG1 LDA K18. JSB ER.F ILLEGAL CONSTANT. SPC 1 PROG4 ISZ F.DCF SET DIM,COM FLAG TO FOOL AI.F IN CASE '(' JSB IDN.F INPUT PROGRAM NAME SZA,RSS IF NO NAME F.IM=0 JMP PRO12 SO SKIP SYMBOL TEST * JSB AI.F ASSIGN TO SYMBOL TABLE JSB BAD9C CHECK THE BAD9 TABLE LDA F.A IF A NEW SYMBOL CPB F.S2B THEN RSS SKIP TO BACK OUT JMP PRO12 NOT NEW LEAVE IT IN * STA F.S2B DELETE IT TO ALLOW USAGE AS INTERNAL NAME STA F.LO STA F.S2T RESET ALL THE GOODIES PRO12 LDA F.TC CPA B50 '(' JMP PROG7 CPA B54 ',' JMP PROG7 PROG6 JMP CRT.F C/R TEST SPC 1 PROG7 LDA PROK1 ADDR OF PBUF+9 STA T1PRO PARAM POINTER PROG8 JSB EXN.F EXAMINE NEXT CHARACTER SZB,RSS DIGIT? JMP PROG2 YES.  ISZ F.CC STEP COLUMN COUNTER CPA B54 F.TC = ',' ? RSS JMP PROG3 ISZ T1PRO NO. NULL PARAM. PROGA LDB T2PRO LOC OF PBUF+17 CPB T1PRO ALL PARAMS READ? JMP PROG3 YES. JMP PROG8 SPC 1 PROG2 JSB IDN.F INPUT DO NOT ASSIGN LDA F.IDI DIGIT STRING JUST INPUT STA T1PRO,I STORE INTO PBUF CPA K5 IF PRAM IS 5 THEN JMP PROG0 IT IS A POSSIBLE SEGMENT * PROG5 ISZ T1PRO BUMP PBUF POINTER LDA F.TC CPA B54 ',' JMP PROGA PROG3 CPA B51 ")" ? JSB ICH.F GET THE NEXT CHARACTER PROG9 CPA B54 IF COMMA THEN RSS SET UP NAM RECORD COMMENT * JMP CRT.F NOT COMMA MUST BE CARRAGE RETURN * LDA PROK1 SET UP TO ACCESS THE NAM BUFFER ADA K8. STA T2PRO ADDRESS OF WORD 17 LDA K35 STA T3PRO CHARACTER COUNT PRO10 JSB IC.F CPA B15 JMP PRO11 END OF STMT. LDB T3PRO CPB K120 IF NO MORE ROOM JMP PRO11 TEST FOR ALL BLANKS * SLB,INB ALF,SLA,ALF XOR T2PRO,I XOR B40 INSERT/REMOVE BLANK STA T2PRO,I STUFF CHAR IN NAM REC STB T3PRO SLB,BRS ISZ T2PRO BUMP POINTER CPA BL2B UNLESS TRAILING BLANKS, JMP PRO10 * STB F.DNB,I UPDATE WORD COUNT JMP PRO10 * PROG0 LDA PROK1 IT IS A SEGMENT IF CPA T1PRO THIS IS THE FIRST PRAMETER CLA,RSS IT IS SO SKIP JMP PROG5 NOT A SEGMENT * STA F.RPL SET UP THE LOAD ADDRESS JSB OLR.F SEND IT JSB OAI.F SEND A 'NOP' TO KEEP LOADR HAPPY STA F.RPL RESET THE LOAD ADDRESS JMP PROG5 AND CONTINUE PROCESSING THE PRAMS * PRO11 CPA B40 IF BLANK THEN JSB EXN.F STRIP THE REST JMP CRT.F MUT NOW BE END OF STMT. SPC 1 T1PRO BSS 1 TO SAVE PBUF POINTER. T2PRO BSS 1 T3PRO BSS 1 K8. DEC 8 K18. DEC 18 K35 DEC 35 K120 DEC 120 K71 DEC 71 K72 DEC 72 COM.K OCT 4000 F.AT=COM SKP * ****************** * * DATA PROCESSOR * * ****************** SPC 1 F.DAT CLA STA T2DAT T2=0 CCA STA F.DEF SET 'DATA' FLAG ADA F.D STA II II=D-1 (END OF DO TABLE) DATA0 JSB ISY.F INPUT SYMBOL LDB F.AT LDA K72 CPB COM.K F.AT=COM? JSB ER.F YES. ERR: CAN'T INIT COMMON. LDB F.SFF CHEK IF BLOCK DATA SUBPROGRAM CPB K2 WELL?? JMP DAT00 YES TEST FURTHER * LDB F.AT NO CPB BCOM THEN JSB ER.F ERROR IF IN COMMON LDA K71 CPB DUM JSB ER.F DUMMY USED IN DATA LIST DAT01 LDA F.IU CPA ARR ARRAY NAME? JMP DAT10 YES. * DATA1 JSB ILD.F INPUT LIST ELEMENT FOR DATA LDA S1 DISPLACEMENT OF ARRAY ELEM OR 0 JMP DATA8 (II)=S1 SPC 1 DAT00 LDB F.AT IF BLOCK DATA PROGRAM AND CPB BCOM IN BLOCK COMMON JMP DAT01 IT IS OK * DAT02 JSB ER.F NOP ABANDON THE STATEMENT * DAT03 LDA K93 GET ERROR 93 JMP DAT02 GRIP * * DAT10 JSB NWI.F F.D0=# WDS FOR ITEM LDA F.TC CPA B50 '(' JMP DATA1 INITIALIZE SPECIFIED ELEMENT. CLA DO WHOLE ARRAY. LOC OF ARRAY BASE DATA8 STA II,I CCB ADB II (B)=II-1 LDA F.A STA B,I [II-1]=F.A ADB KM1 LDA F.D0 NUMBER OF WORDS PER ITEM STA B,I [II-2]=D0 ADB KM1 STB II II=II-3 STB G END OF DATA TABLE LDA F.TC CPA B54 , ? JMP DATA0 YES. GET MORE VARIABLES. LDA F.RPL STA T1DAT SAVE RPL LDA B57 '/' JSB TCT.F F.TC-TEST CLA START READING VALUES. STA KBAR LDA F.D ADA K2 STA II II=D+2 DATA4 JSB IDN.F INPUT DO NOT ASSIGN SZA JMP DATA5 F.IM .NE. 0 INA STA F.SXF SET COMPLEX FLAG LDA B50 '(' JSB TCT.F F.TC-TEST JMP DATA4 SPC 1 DAT08 LDA F.IDI # OF VALUES TO GET STA KBAR JSB ITS.F INTEGER TEST JMP DATA4 SPC 1 ERDAT LDA K73 DATA3 LDB T1DAT STB F.RPL RESTORE RPL STA G SAVE ERROR CODE JSB OLR.F SEND THE LOAD ADDRESS LDA G RESTORE THE ERROR NUMBER JSB ER.F SEND THE MESSAGE SPC 1 B52 OCT 52 K73 DEC 73 K93 DEC 93 KM3 DEC -3 SPC 1 HFLAG NOP * DATA5 LDA B54 STB HFLAG SAVE THE HOLLERITH FLAG LDB F.NT SZB,RSS JMP DATA3 ERR 44: NAME IN CONSTANT LIST. LDA F.IM STA T0DAT F.IM OF DATA ELEMENT LDA KBAR SZA JMP DATA6 LDA F.TC CPA B52 '*' JMP DAT08 SET VALUE MULTIPLICITY. CLA,INA STA KBAR GET SINGLE VALUE DATA6 LDA T2DAT ANYTHING LEFT TO BE OUTPUT? SZA JMP DATA7 YES, FINISH CURRENT ARRAY LDB II NO. GET NEXT DATA ELEMENT ADB KM3 STB II II=II-3 CPB G JMP DAT21 LDA B,I STA F.RPL RESTORE RPL ADB KM1 LDA B,I STA F.A ASSIGNMENT PTR OF DATA ELEMENT ADB KM1 LDA B,I STA T2DAT SIZE OF ARRAY OR VARIABLE JSB FA.F FETCH ASSIGN LDB F.IM STB T3DAT LDA F.AF GET THE BASE ADDRESS LDB F.SFF IF IN BLOCK DATA SUBPROGRAM CPB K2 THEN JMP DAT05 GO SEND SPECIAL HEADR RECORD * LDB F.IU IF ARRAY CPB ARR THEN JMP DAT07 GO SEND THE ACTUAL ADDRESS * JMP DAT09 ELSE GO SEND A SYMBOL TABLE ADDRESS * DAT07 ADA F.RPL ADD tBASE ADDRESS TO DISPLACEMENT STA F.RPL AND SET IT JMP DAT06 GO SEND THE LOAD ADDRESS * DAT09 CLB,CCE SET ZERO OFFSET LDA F.A,I SET THE IOR K8. SYMBOL USED BIT STA F.A,I TO FOURCE PRODUCTION IN PASS TWO LDA F.A GET THE A.T. ADDRESS RAL,ERA SET SIGN BIT JSB OW.F SEND THE LOAD ADDRESS OCT 20000 JMP DATA7 SEND THE DATA * DAT05 INA BLOCK DATA STEP TO MASTER POINTER LDB A,I TO B ADB F.RPL ADD BASE ADDRESS STB F.RPL AND RESET IT CCE,INA STEP TO THE MASTER ADDRESS LDA A,I GET IT CPA F.EMA IF IN EMA JMP DAT03 ILLEGAL MAY NOT INIT. EMA (AT THIS TIME) * RAL,ERA SET SIGN ON IT AND JSB OW.F OUTPUT AS A LOAD ADDRESS (B IS IT) OCT 20000 R001 AS FLAG FOR PASS TWO RSS SKIP THE OTHER ORG DAT06 JSB OLR.F OUTPUT LOAD ADDRESS=RPL DATA7 LDB T3DAT LDA HFLAG IF HOLLERITH FLAG SET ADA F.D0 CHECK IF TOO LARGE A HOLLERITH SSA IF TOO LARGE IN ANY CASE JMP ERDAT SEND ERROR * LDA HFLAG IF HOLLERITH SZA,RSS AND HERE IT IS OK CPB T0DAT ELSE MODES MUST MATCH RSS JMP ERDAT MODE ERROR JSB OC.F OUTPUT CONSTANT LDA F.D0 CMA,INA ADA T2DAT STA T2DAT T2=T2-D0 (# WDS REMAINING ) CCB ADB KBAR STB KBAR KBAR=KBAR-1 SZB JMP DATA6 MORE OF MULTIPLE TO OUTPUT. * SZA IF MORE LEFT OF THIS ARRAY JMP DAT20 GO CHECK FOR COMMA * LDA II ADA KM3 ADJUST FOR RIGHT ELEMENT CPA G JMP DAT21 * DAT20 LDA F.TC CPA B54 , ? JMP DATA4 YES. GET NEXT VALUE. DAT21 LDA B57 '/' JSB TCT.F F.TC-TEST LDA T1DAT STA F.RPL RESTORE RPL JSB ICH.F INPU.<:6T CHARACTER CPA B54 IS F.TC=',' ? JMP F.DAT YES. GET MORE VARIABLES JSB OLR.F OUTPUT LOAD ADDRESS=RPL JMP CRT.F C/R TEST SPC 2 SPC 1 T0DAT NOP SAVE F.IM OF DATA ELEMENT T1DAT NOP SAVE RPL T2DAT NOP SAVE # WORDS FOR DATA ELEMENT T3DAT NOP F.IM OF LIST ELEMENT II NOP DATA TABLE INDEX G BSS 1 POINTER TO END OF TBL BY DATA PROCESSOR KBAR BSS 1 REPEAT INDICATOR IN DATA PROCESSOR TYTBL OCT 114 'L' LOGICAL OCT 103 'C' COMPLEX OCT 111 'I' INTEGER OCT 122 'R' REAL OCT 104 'D' DOUBLE PRECISION DEF ASLOG DEF ASCOM DEF ASINT DEF ASREA DEF ASDBL ASLOG OCT 130003 TYPE LOG WITH SIGN 3 WORDS FOLLOW ASC 3,OGICAL REST OF WORD LOGICAL ASCOM OCT 150003 TYPE COMPLES WITH SIGN 3 WORDS FOLLOW ASC 3,OMPLEX REST OF WORD COMPLEX ASINT OCT 110003 TYPE INTEGER WITH SIGN 3 WORD FOLLOW ASC 3,NTEGER REST OF WORD INTEGER ASREA OCT 120002 TYPE REAL WITH SIGN 2 WORD FOLLOW ASC 2,EAL( CONTAINS FIRST ( OF IMPLICIT REAL(... ASDBL OCT 160007 TYPE DOUBLE PRECISION WITH SIGN 7 WORDS FOLLOW ASC 7,OUBLEPRECISION END F4.0 O< / 92060-18095 1805 S C0522 FTN4 SEGMENT 1              H0105 %ASMB,Q,C HED ** ** 16K FTN4 COMPILER (F4.1:EXPRESSION EVALUATOR) ** NAM F4.1,5 92060-16095 771128 REV. 1805 * *************************************** * FORTRAN-4 COMPILER OVERLAY 1 *************************************** * * THIS OVERLAY IS THE EXPRESSION EVALUATOR. * * * * *************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * * REPRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * *************************************************************** * * * * * * EXT'S WITH A LEADING 'F.' ARE VARIABLES OR JUMP TARGETS * * THE COLUMN THE EXT STARTS IN DEFINES THE SUBROUTINE IT IS * DEFINED IN AS FOLLOWS * 2 -- OA.F (WRITE PASS FILE ROUTINES) * 3 -- NEX.F (STATEMEXTS THAT DON'T CONTAIN EXPRESSIONS) * 4 -- FA.F (THE ASSIGNMEXT TABLE ROUTINES) * 5 -- EX.F (STATEMEXTS USING THE EXPRESSION EVALUATOR) * 6 -- IC.F (THE CHARACTER INPUT ROUTINES) * 7 -- IDN.F (THE TOKEN INPUT ROUTINES) * 8 -- FTN4 ( THE MAIN) EXT F..DP BASE OF SYMBOL TABLE EXT F..E DIMENSIONS CONSTANT BIT FROM ASSIGNS TABLE EXT F.A ASSIGNMEXT TABLE ADDRESS (CURRENT ENTRY) EXT F.ASS ASSIGNMEXT STATEMEXT PROCESSOR EXT F.ABT ABORT COMPILE EXTRY EXT F.ACC TEMP ACCUMULATOR FLAG EXT F.AF ADDRESS FIELD CURREXT F.A EXT F.ARF NO. OF SUB. FUN. ARGUMEXTS EXT F.ASP ASSIGN STMT. PROCESSOR EXT F.AT ADDRESS TYPE OF CURREXT F.A EXT F.AT. SUBSCRIPT INFO FLAG EXT F.BGN RETURN FROM F4.0 EXT F.BSP BACKSPACE STMT. PROCESSOR EXT F.BUF A BUFFER EXT F.C OFFSET FOR CURREg?NT MR INSTRUCTION EXT F.CAL CALL STATEMEXT PROCESSOR EXT F.CC CHARACTER COUNT EXT F.CCW FTN OPTION WORD EXT F.CIN CURREXT CI BUFFER LINE NUMBER EXT F.CLN INPUT ITEM CURREXT LINE # EXT F.CON CONTINUE STMT. PROCESSOR EXT F.CSZ COMMON SIZE EXT F.D DO TABLE POINTER EXT F.D.T ADDRESS OF '.' FUN. TABLE EXT F.D0 ARRAY ELEMEXT SIZE EXT F.D1 DIMENSION 1 EXT F.D2 DIMENSION 2 EXT F.D3 DIMENSION 3 EXT F.DCF DIM, COM FLAG EXT F.DEF DATA EXISTS FLAG EXT F.DID ADDRESS OF F.IDI EXT F.DLF DELIMETER FLAG EXT F.DNB DEF OF NBUF (NAM RECORD) EXT F.DNI ADDRESS OF NID EXT F.DO LWAM - END OF DO TABLE EXT F.DOP DO STATEMEXT PROCESSOR EXT F.DP BASE OF USER SYMBOL TABLE EXT F.DTY IMPLICIT TYPE TABLE EXT F.E EQUIVALENCE TABLE POINTER EXT F.EFG E - FLAG - SET IF SUBSCRIPT IS DUMMY EXT F.EFP ENDFILE STMT. PROCESSOR EXT F.EMA F.A OF EMA EXT ENTRY, WINDOW SIZE EXT F.EMS EMA SIZE DOUBLE WORD, (INTERNAL FORMAT) EXT F.END END FLAG EXT F.EQE EQUVALENCE ERROR FLAG EXT F.EQF EQUIVALENCE FLAG EXT F.ER0 'RX' OF ERRX LIB ERROR ROUTINE EXT F.ERF ERROR FLAG (# OF ER.F CALLS) EXT F.ERN ERROR ARRAY EXT F.EXF EXTERNAL STATEMEXT FLAG EXT F.FMT FORMAT STMT. PROCESSOR EXT F.GOP GO TO STATEMEXT PROCESSOR EXT F.IDI INPUT ARRAY NON-NUMERIC EXT F.IFF IF FLAG EXT F.IFP IF STATEMEXT PROCESSOR EXT F.IM CURREXT ITEM MODE (REAL, COMPLEX,ECT.) EXT F.INT TEMP VARIABLE ARRAY EXT F.IOF INDICATOR FOR I/O INDEX EVALUATOR EXT F.IU CURREXT ITEM USAGE (DUM., RELATIVE, ECT.) EXT F.HDL LENGTH OF HEAD MESSAGE EXT F.L # WORDS ON STACK 2 p EXT F.LFF LOCICAL IF FLAG EXT F.LLO CURRENT RELOCATAION ADDRESS(TWO WORDS) EXT F.LLT ADDRESS OF LINE LOCATION TABLE (SET BY INIT) EXT F.LO END OF ASSIGNMEXT TABLE+1 EXT F.LOP NO. LINES LEFT ON THIS PAGE. EXT F.LPR ( LOC OF EQUIVALENCE GROUP EXT F.LSF EXPECT FIRST STATEMEXT FLAG EXT F.LSN F.A OF LAST STATEMEXT NUMBER EXT F.LSP LAST OPERATION FLAG EXT F.MFL TYPE STMT. MODE FLAG EXT F.NC NAME CHANGE FLAG. EXT F.NCR NO CROSS REF FLAG EXT F.ND NUMBER OF DIMENSIONS EXT F.NEQ # OF EQUIVALENCE GROUPS EXT F.NT NAME TAG 0= VAR, 1=CONSTANT. EXT F.NTF NAME TAG FLAG EXT F.NW NO. WORDS THIS TABLE F.A EXTRY. EXT F.NXN NO INPUT FLAG EXT F.OFE DATA POOL OVERFLOW ERROR EXTRY. EXT F.OPF OUTPUT PACK FLAG EXT F.R JSB ERR0 FLAG EXT F.PAK PACK BUFFER WORD EXT F.PAP PAUSE STMT. PROCESSOR EXT F.RDP READ STATEMEXT PROCESSOR EXT F.REL SUB. PROG. RETURN LOCATION EXT F.RPL PROGRAM LOCATION COUNTER EXT F.RPR ) LOC OF EQUIVALENCE GROUP EXT F.RTN RETURN STMT. PROCESSOR EXT F.RWP REWIND STMT. PROCESSOR EXT F.S02 RETURN FORM RCOM F.1 EXT F.S03 LOAD F.1 AND PASS CONTROL EXT F.S1B BOTTOM OF STACK 1 EXT F.S1T TOP OF STACK 1 EXT F.S2B BOTTOM OF STACK 2 EXT F.S2T TOP OF STACK 2 EXT F.SBF 0= MAIN, ELSE SUBROUTINE EXT F.SCC SAVE F.CC EXT F.SEE RETURN FROM F4.1 EXT F.SEG LOAD A NEW SEGMENT EXT F.SFF SUBROUTINE/FUNCTION FLAG 0/1 EXT F.SFP STATEMEXT FUNCTION PROCESSOR EXT F.SID STATEMEXT ID PHASE FLAG EXT F.SLF STATEMEXT LEVEL FLAG EXT F.SPF SPECIFICATION FLAG SET TO CURREXT STMT. LEVEL EXT F.SPS STATEMEXT PROCESSOR SWITCH EXTK F.SRL SAVE RPL AT BEGINNING OF RECORD EXT F.STA FLAG THAT IS ZERO UNTIL THE FTN STATEMEXT IS READ EXT F.STB STRING BACK JUMP FLAG EXT F.STP STOP STMT. PROCESSOR EXT F.STS TO STATEMEXT SCAN EXT F.SVL SAVE # WORDS ON OPER STACK (F.L) EXT F.SXF COMPLEX CONSTANT FLAG EXT F.T # WORDS ON STACK 1 EXT F.TAC ? EXT F.TC NEXT CHARACTER EXT F.TIM TIME ARRAY ADDRESS IN HEAD EXT F.TRM TERMINATE COMPILE EXT F.TYP TYPE STATEMEXT FLAG EXT F.WRP WRITE STATEMEXT PROCESSOR EXT F.X1 F.A OF F.D1 EXT F.X2 F.A OF F.D2 EXT F.X3 F.A OF F.D3 * * EXT'S WITH A TRAILING '.F' ARE SUBROUTINES * EXT AA.F ASSIGN ADDRESS SUB. EXT AI.F ASSIGN ITEM EXT ASC.F CONVERT TO 4 ASCII DIGITS EXT BNI.F CLEAR NID TO BLANKS EXT BOM.F DISASTOR ERROR REPORT (NO RETURN) EXT CID.F CLEAR F.ID ARRAY EXT CDI.F CLEAR IDI ROUTINE EXT CRP.F CROSS REF PAIR SUB. EXT CRT.F TEST FOR CARRAGE RETURN EXT DAF.F DEFINE (F.AF) EXT DAT.F DEFINE (AT) EXT DIM.F DEFIND (F.IM) EXT DIU.F DEFINE (F.IU) EXT DL.F DEFINE LOCATION SUBROUTINE EXT EJP.F PAGE EJECT SUBROUTINE EXT ER.F ERROR PRINT SUBROUTINE EXT ESC.F ESTABLISH CONSTANT SUBROUTINE EXT ESD.F ESTABLISH DEF SUBROUTINE EXT EXN.F EXAMINE NEXT CHARACTER EXT FA.F FETCH ASSIGNS EXT FID.F FETCH (ID) TO NID (UNPACK) EXT FNS.F FIRST NOT SPEC. STMEXT CHECK EXT FXC.F CHECK IF SUB. IN FIX-EXT TABLE EXT GNA.F GET NEXT SYMBOL TABLE EXTRY EXT GPE.F GENERATE SUB. PROG. EXTRANCE EXT IA.F INPUT (A) CHARACTERS SUBROUTINE EXT IC.F GET NEXT CHARACTER EXT ICH.F GET NEXT NON BLANK CHAR. AND TYPE IT EXT IxDN.F INPUT DO NOT ASSIGN (GET NEXT OPERAND) EXT IDS.F INPUT DIGIT STRING EXT IFT.F IF GOTO COMPLETION EXT II.F INPUT ITEM EXT IIV.F INPUT INTEGER VARABLE EXT IN2.F INIT FOR OA.F MODULE EXT IN3.F INIT FOR ENX.F MODULE EXT IN4.F INIT FOR FA.F MODULE EXT IN5.F INIT FOR EX.F MODULE EXT IN6.F INIT FOR IC.F MODULE EXT IN7.F INIT FOR IDN.F MODULE EXT INM.F INPUT NAME EXT IOP.F INPUT OPERATOR EXT ISN.F INPUT STATEMEXT NUMBER EXT ISY.F INPUT SYMBOL EXT ITS.F INTEGER TEST EXT MCC.F RESET TO FIRST COLUMN OF STATEMEXT EXT MPN.F MOVE PROGRAM NAME (TO NAM RECORD ECT.) EXT NEW.F SUB TO CLEAR TEMPS FOR A NEW MODULE EXT NCT.F TEST FOR NOT A CONSTANT EXT NST.F TEST FOR NOT A SUBROUTINE NAME EXT NTI.F MOVE NID TO F.IDI (PACKS) EXT NWI.F SET F.D0 TO # WORDS IN ARRAY EXT OA.F OUTPUT ASSIGNMEXT TABLE OPERAND EXT OAI.F OUTPUT ABS. INSTRUCTION EXT OC.F OUTPUT CONSTANT EXT ODF.F OUTPUT DOT FUNCTION EXT OLR.F OUTPUT LOAD ADDRESS EXT OMR.F OUTPUT MEMORY REF. INSTRUCTION EXT OS.F OUTPUT SECTOR TO INTERPASS FILE EXT OW.F OUTPUT WORD EXT OZ.F OUTPUT ZREL (OP *+N) EXT PAK.F PACK SUBROUTINE EXT PDF.F PRODUCE DEF SUBROUTINE EXT PSL.F PRINT LINE ON PRINTER EXT PTM.F PROGRAM TERMINATION CODE GEN. EXT RTN.F SUBROUTINE RETURN HANDLER EXT RP.F INPUT ')' EXT SCC.F SAVE F.CC SUBROUTINE EXT SCP.F SAVE CURREXT STATPMEXT POSITION. EXT SKL.F SKIP LINES ON LIST EXT SNC.F START NEXT CARD SUBROUTINE EXT SOA.F STORE AND OUTPUT (OA.F) EXT TDO.F DO TERMINATION CODE GENERATOR EXT TCT.F TEST (A) = F.TC ELSE ER 28 EXT TS.F TAG SUBPROGRAM SUB. EXT TV.F TAG VARIABLE EXT UC.F UNINPUT COLUMN EXT WAR.F ERROR COMMEXT SUBROUTINE (WARNINGS) * * * SEGMENT ENTRY POINTS * ENT EA?.F TEST IF VAR. IS IN EMA * * * ENTRY POINTS FOR ROUTINES IN THIS SEGMENT * * ENT EE.F EXPRESSION ANALIZER (THE WHOLE REASON FOR EXISTANCE) ENT GIM.F GET IM OF ITEM ENT GST.F STORE REGISTER IN TEMP. ENT PU2.F PUSH ONTO OPERATOR STACK ENT MAP.F IF F.A POINTS TO EMA GEN. .EMAP CALL FOR IT ENT FER.F FORM PROGRAM ENTRANCE SPC 1 * * * * * * * OTHER LIB. UTILITIES * EXT .MVW MOVE WORDS MACRO * A EQU 0 A-REGISTER B EQU 1 B-REGISTER SUP SPC 1 .TBL EQU 0 FEDP EQU 0 DEC 1 OVERLAY NUMBER SKP * **************************** * FORM PROGRAM ENTRANCE CODE * * **************************** * * FER.F DEF DBSZ CALLED JUST BEFOR THE FIRST EXECUTABLE STMT. ISZ BENHR SKIP IF NOT BEEN HERE BEFORE JMP FER.F,I ALREADY DONE ONCE JUST EXIT * LDA F.SFF IF BLOCK DATA CPA K2 SUBPROGRAM JMP FER.F,I THERE IS NO ENTRY * JSB OLR.F PUT OUT LOAD ADDRESS LDA F.RPL SAVE THE ADDRESS OF STA F.SRL THE FIRST PRAM (FOR .ENTR) LDB F.SBF GET SUB ROUTINE F.A STB F.A AND SET IT SZB,RSS MAIN IF NONE JMP FER06 MAIN SKIP ENTRY CODE * JSB FA.F FETCH ASSIGNS FOR THIS GUY JSB CTYP CHECK IF IMPLICIT STMT CHANGED TYPE LDA F.SFF GET PROGRAM TYPE FLAG SZA,RSS IS IT A FUNCTION? JMP FER00 NO DO NOT MAKE SUB A DUM * LDB F.IM GET MODE OF FUNCTION CPB CPX IF COMPLEX RSS OR CPB DBL DOUBLE THEN JMP FER02 GO MAKE DUM AND PUT OUT NOP FOR IT * FER00 LDA zF.AF GET THE LINK TO THE FIRST DUMMY FER01 STA F.A SET LINK TO NEXT DUMMY CPA F.SBF IF END OF LIST JMP FER03 GO PRODUCE THE .ENTR CALL * JSB FA.F FETCH ASSIGNS JSB CTYP CHECK IF IMPLICIT STMT CHANGED TYPE FER02 LDA F.AF SET LINK TO NEXT ONE STA NXT IN TEMP LDA DUM MAKE SURE IT IS TYPED JSB DAT.F PROPERLY LDA F.RPL DEFINE ITS JSB DAF.F LOCATION CLA AND OUTPUT A JSB OAI.F NOP PLACE HOLDER LDA NXT GET NEXT F.A JMP FER01 AND GO DO IT * FER03 LDA F.RPL SAVE LOCATION OF ENTRY STA F.REL FOR RETURN CODE AND PASS TWO CLA PRODUCE JSB OAI.F A NOP PLACE HOLDER LDB .ENTR OUT PUT A JSB .ENTR JSB ODF.F LDB F.SRL DEF TO THE FIRST JSB OMR.F PRAM LDA F.L ANY DIMENSIONS FOR FER04 SZA,RSS DUMMY ARRAYS? JMP FER05 NO OR DONE * ISZ F.S2B YES LDB F.S2B,I GET F.A OF DUMMY LDA LDAI OUTPUT A JSB SOA.F LDA DUM,I LDA F.IM IF DUM IS CPA INT INTEGER JMP FER07 THEN SKIP ERROR REPORT * LDA F.CC ELSE REPORT STA TYPEX ERROR DUM USED AS LDA K5 DIMENSION CCB AND STB F.CC IT IS NOT JSB WAR.F INTEGER JSB FID.F JSB NTI.F MOVE SYMBOL TO F.IDI AND PAD LDA K3 NOW LDB F.DID SEND IT JSB PSL.F TO THE PRINTER LDA INT MAKE IT INTEGER JSB DIM.F NOW LDA TYPEX RESTOR STA F.CC THE CHARACTER COUNT (SET ZERO TO FLAG PRIOR LINE) FER07 LDA STAI AND A STA ISZ F.S2B LDB F.S2B,I IN THE LOCAL TEMP. JSB SOA.F LDA F.L INDEX TO THE NEXT ONE ADA KM2 AND STA F.L JMP FER04 GO TEST IF THERE IS ONE * FER05 LDA F.LO Y CUT BACK STA F.S2B THE STACK STA F.S2T JMP FER.F,I RETURN * FER06 LDA F.RPL SAVE THE ENTRY LOCATION STA F.REL FOR END PROCESSOR CLA PRODUCE MAIN PROGRAM JSB OAI.F ENTRY CODE LDA JSBI JSB CLRIO LDB CLRIO ADB F..DP JSB SOA.F AND CLA CLB,INB DEF *+1 JSB OZ.F JMP FER.F,I RETURN * CLRIO DEF FEDP+252B F.A OFFSET OF CLRIO .ENTR DEF .TBL+27 .TBL OFFSET OF .ENTR NXT NOP TEMP K5 DEC 5 BENHR OCT -1 BEEN HERE FLAG * CTYP NOP CHECK IF TYPE NOT EXPLICIT THEN SET IMPLICIT LDA F..E GET EXPLICIT TYPE FLAG SZA IF SET JMP CTYP,I RETURN * LDA F.A GET THE FIRST ADA K2 CHAR OF THE NAME LDA A,I TO A ALF,ALF ROTATE AND AND B377 ISOLATE ADA BM101 SUBTRACT 'A' CLE,ERA CONVERT TO CHAR ADDRESS ADA F.DTY ADD THE ADDRESS OF THE TYPE TABLE LDA A,I GET THE TYPE FROM THE TABLE SEZ USE RIGHT END ALF,ALF AND ADDR ISOLATE THE MODE JSB DIM.F DEFINE NEW IM JMP CTYP,I RETURN * BM101 OCT -101 SKP TABT DEF .IAND TABNO ABS .IAND-.END SPC 2 * *------------------* * * START HERE * * *------------------* * F4.1 LDA TABT,I ADD FIXED EXTERNAL TABLE BASE ADA F..DP ADDRESS TO DISPLACEMENTS IN STA TABT,I TABLE ABOVE AND REINSERT IN TABL ISZ TABT ISZ TABNO JMP F4.1 * LDA F.CCW GET THE Y- BIT AND B1000 AND LDB K3 SZA IF SET INB STB FER.F,I SET DOUBLE WORD SIZE TO 4 LDA .CFER IF SET CPB K4 FOR 4-WORD DOUBLE STA .DFER USE CFER FOR DOUBLE MOVES JMP F.SEE RETURN TO MAIN PROGRAM SPC 1 EQFLG NOP EQUALS FLAG L.INT DEF F.tpINT LT.IN DEF T.INT B1000 OCT 1000 SPC 2 * ************************ * * EXPRESSION EVALUATOR * * ************************ SPC 1 * PARAM IS TYPE OF INPUT EXPRESSION: SPC 1 * = 0, STATEMENT FUNCTION. * =-1, SUBROUTINE CALL STATEMENT. * =-2, DO INITIAL PARAMETER. * =-3, ARRAY ELEMENT IN I/O LIST. * =-4, DO STATEMENT TERMINAL OR STEP-SIZE PARAMETER. * =-5, COMPUTED GO TO INDEX EXPRESSION. * =-6, ASSIGNMENT STATEMENT. * =-7, IF EXPRESSION. SPC 1 * FLOW CHART OF THE EXPRESSION ANALIZER * * PRIOR,LASTC_-1,OPCOD_-1,T4_0 * ! * (-7)'IF' EXPRESSION? * 1! 0! * !<<<<<<<<<<<<<<<<<<<<<<< ------------ *(CPX FLG)SXF_#0 ! * PU2.F(21) STACK '(' C31P1 (0 )STMT. FUN. * II.F (-4)DO TERM. OR * F.IM=CPX (-5)GO TO INDX.? * & F.NT #0? 1! 0! * 1! 0! ! <<<<<<<<<<<<<<<< ! *PO2.F '(' ! ^------------O (-1)SUB.& *! ! ^ EXN.F F.TC#'(' *! ! ^ ! 0! 1! *! !<<<<<< ^ T4=0? ! OA.F (JSB) *! LASTC=')' ^ 1! 0! F.A_T5 ! OZ.F (DEF *+1) *! 0! 1! ^ F.TC='+' F.TC_T4,F.IM_T6 ! ! *! LASTC_'(' ER.F ^ OR '-' F.IM=0? ! RETURN *! F.IM=0? (53) ^ 1! 0! 0! 1! ! *! 0! 1! ^ LASTC= II.F FA.F ! ! *O<<<< ! ^ '=','(', ! ! ! ! *! F.TC='+'? ^ OR <0? ! O<<< F.CC ! *----------------------)!(------------------------------O * ! ! * ! F.IM=0? * ! 1! 0! * ! ! EMAFL_CLEAR * ! ! EQFLG<0?(LEFT OF '=') * ! ! 0! 1! * ! ! ! F.L=F.SVL& EMA? * ! ! ! 0! 1! * ! ! O<<<< PU1.F(-1) * ! ! ! PU2.F(INASS) * ! ! ! EMAFL_SET * ! ! O<<<<<<<<< F.TC_' ' F.TC='('? LASTC=')'& * ! 1! 0! F.TC='N0'? * ! T ! 0! 1! * ! (TOP LEFT)! ! ER.F(53) * ! ! F.TC='('? * ! ! 0! 1! * ! !<<<<<< F.IU=0? F.IU=ARR * ! ! 0! 1! OR SUB? * ! ! ! ER.F 1! 0! * ! ! ! (49) PU1.F ER.F * ! ! EMAFL? (F.A,I) (49) * ! ! 1! 0! PU2.F '[' * ! ! ! MAP.F (C33P1ORC32P1) * ! ! !>PU1.F(F.A) '<'OR '[' * ! ! ! ARR SUB * ! ! MAP.F? (P=0 IF (SIGN * ! ! 0! 1! EMA<'=') IF * ! O<<<<< EAC.F INT * ! ! ! ! FUN * ! O<<<<<<<<< * ! F.IM=0? ! * ! 1! 0! * ! F.TC='NO'? ! TOP CENTER * ! 1! 0! ! * ! LASTC='N0'? LASTC=')'?! * ! 0! 1! 0! 1!! * O<<<<<<< ER.F(53) -O * ! ! * ! F.TC=')'OR ','? * ! 0! 1! * ! F.TC='C/R'? CRPIO_3 <HFBEE12> * ! 0! 1! ! * ! F.TC='*'? CPRIO_0 ! * ! 1! 0!! ! * ! EXN.F F.TC='-'? ------O * ! F.TC='*'? 0! 1! ! * ! 0! 1! ! EXN.F CCODE_0 * ! F.TC_'*' ! ! F.TC=DELIM.? ! * ! ! F.TC_'**'! 1! 0! !------ * ! ! F.CC_F.CC+1! ! ! ! * ! ! ! ! ! T6_F.A ! * O<<<<<<< LOOK UP OPCODE ^ F.NT=0? ! * IN TABLE ^ 1! ! ! * =,+,-, ,*,/,**, ^<<<<<<<<F.TC='='? ! * 0! 1! ! * ! EQFLG_EQFLG+1 ! * ! EQFLG=0? ! * ! 0! 1! ! * O<<<<<< ER.!(53) ! * ! ! * GET CPRIO FROM TABLE ! * CCODE FROM TABLE ! * CPRIO>PRIOR? ! * 1! 0! ! * PU2.F ! ! * (OP) ! ! * LASTC_F.TC ! ! * ! ! * TOP CENTER ! ! * ! ! * ---------------------O ! * ^ ! ! * ^ OPCODE= '(' OR '['? ! * ^ 1! 0! ! * ^ ER.F(9) OPCODE= '<'? (ARRAY) ! * ^ MISMATCH PRN. 0! 1! ! * ^ ! LASTOP='='? ! * ^ ! 0! 1! ! * ^ ! F.ER(9) SUARC (GEN ARRAY CALL) ! * ^ ! MISMATCH ! * ^ ! PRN. -------------------------O * ^ PNUM_ #OPERANDS (1 IF '.NOT.' OR '-') ! * ^ ! ! * ^ PNUM=1 OR ! * ^ STK1-1=0? ! * ^ 0! 1! ! * ^ (GENERATE TEST IF ! ! * ^ ERR. IF SUBROUT. ! ! * ^ SUB. ) ! ! ! * ^ O<<<<<< ! * ^ ! ! * ^ STK1T=0? ! * ^ 0! 1! ! * $ ^ TEST IF ! ! * ^ SUBROUT. ! ! * ^ ! ! ! * ^ O<<<<<< ! * ^ ! ! * ^ CALL CODE GEN. ! * ^ FOR THIS OP. CODE POP OPERNAND,PUSH RESULT ! * ^ ! ! * ^ O<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< * ^ ! * ^ CPRIO > PRIOR? * ^ 0! 1! * O<<<<<<<<<<<<<<<<<< CCODE=O? * ^ 0! 1! * ^ STACK F.TC='C/R'? * ^ CURRENT 1! 0! * ^ OPCODE ! F.TC=')'? (IF NOT MUST BE ',') * ^ ! ! 0! 1! * ^ ! ! OPCODE='['OR'<' OPCODE='('? * ^ ! ! 1! 0! 1! 0! * ^ O<<<<<<)!(<< !STEP/TERM (-4)? ^ 0! 1! / BACK * ^ (TOP CENTER) ! 1! 0! ^<<<< ! / DOWN * ^ ! ! ERR.F # ! ! STACK * ^ !OPCODE < 0? (16)ILL. DELIM. ! ! UNTIL * ^ ! 0! 1O<<<<<<<<<<<<<<<<<<<<)!(< SUB * ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<)!(<< ! ! OR ARRY * ! ! ! NAME * O<<<<<<<< ! FOUND * ! ! (SIGN * !<<<<<<<<<<<<<<<<<<<<<<<<< ! BIT IS * ! ! SET ON * TYPE=DO INIT(-2) ! IT) * OR ASSIGNMENT(-6)? ! ! * 1! 0! ! ! * RETURN O<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< ! * ! ! * STK1T=0? ! * 0! 1! !<<<<<<<<<<<<<<<<<<<<< * NOT SUB ! ! * TEST ! WIPE SIGN BIT * ! ! ! * O<<<<<<< F.IU=ARR? * ! 0! 1! * TYPE=IF(-7)? GEN SUB GEN ARRAY * 0! 1! CALL ADDRESS CALC. * ! ! ! ! * ! STK1T=0? !---O<<<< * ! 0! 1! ! * ! GEN TACC=ADDR? (RESULT POP ARG AND * ! LDA 1'ST 0! 1! IS ADD.) PUSH RESULT * ! WORD RSLT. RETURN ! ! * ! ! GEN PRIOR<0 AND (OPSTKva EMPTY * ! ! LDA ADDR,I TYPE=I/O ARR OR NOT ARR * ! IM=CPX? ! OR SUB CALL? & NOT CALL) * ! 1! 0! RETURN 1! 0! * !ER.F RETURN ! LASTC * ! II.F (TOP CENTER) * TYPE=DO TERM/STP(-4) ! * OR GOTO INDEX(-5) F.IM=0? * 1! 0!(STMT. FUNCT.) 0! 1! * ! ! (MISSING ER.F RETURN * GT1.F (GET GT1.F (GET DELIM.) (53) * ! RSLT TYP) ! RESULT) * IM=LOG? IM=T1? (TYPES AGREE?) * 1! 0! 1! 0! * ER.F(55) IM=INT? ! IM=LOG? * 1! 0! ! 0! 1! * ! CON.F ! STYPE=0, CONTINUE GEN. CODE LDA CCODE SZA,RSS IF CCODE = 0 JMP EE41 THEN CURRENT OP IS ')',',' OR C/R ALF,ALF NO, STACK OPERATOR IOR CPRIO (A) = CCODE,CPRIO JMP EE06 STACK OPERATOR SPC 1 EE49 CLA,INA IF LAST OP WAS CPA LOPCD ASSIGN THEN THIS IS A HELD EMA RSS ARRAY CALL JMP EE44 ELSE IT IS AN ERROR * JSB SUARC GEN ARRAY CALL JMP EE40 CHECK PRIORITY * SOPPR OCT 31 LOPCD NOP LAST OPCODE SOP[ OCT 32 SOP< OCT 33 SKP EE41 LDA F.TC CPA B15 IF DELIMITER IS CARRIAGE RETURN, JMP EE60 GO TO END OF EXPRESSION EVAL. CPA B51 IF DELIMITER IS ')', JMP EE43 GO HANDLE IT. LDA OPCOD NO, MUST BE ',' CPA SOP[ IF TOP OPERATOR IS '['. JMP EE03 CONTINUE SCAN OF EXPRESSION. * CPA SOP< IF TOP OPERATOR IS '<' JMP EE03 CONTINUE SCAN OF EXPRESSION. LDB TYPEX CHECK TYPE OF INPUT EXPR. CPB KM4 DO TERM OR STEP-SIZE PARAMETER? JMP EE42 YES CPB KM2 DO INITIAL PARAMETER? JMP EE42 YES. [ELSE ILLEGAL COMMA] EE16 LDA K53 ERROR, ILLEGAL OP OR DELIMITER. JSB ER.F SPC 1 EE43 LDA OPCOD CPA SOPPR IS TOP OPERATOR '('? JMP EE45 YES * LDB PRIOR GET CURRENT PRIORITY TO B CPA SOP< IS IT AND ARRAY? RSS YES SAME AS SUB CPA SOP[ IS TOP OPERATOR '['? JMP EE46 YES * ~ LDA F.IOF I/O LIST PROCESSOR FLAG SET? SZA JMP EE60 YES. EE44 LDA K9 JSB ER.F ERROR - MISMATCHED PARENTHESIS. SPC 1 K9 DEC 9 K53 DEC 53 KM4 DEC -4 KM7 DEC -7 K1 DEC 1 SPC 1 EAC.F NOP ROUTINE TO CHECK IF CURRENT EMA LDA F.S2T,I REFERENCE IS NOT FLAGGED TO BE BY CPA KK42 VALUE AND IS IN SUB CALL LIST RSS TO AN UNKNOWN SUBROUTINE JMP EAC.F,I NOT IN SUB CALL OR IT IS FLAGGED * LDA K48 ERROR IS 48 IT IS IN A CALL LIST LDB F.TC IF THIS IS A CPB B54 ',' OR RSS CPB B51 ')' THEN JSB WAR.F SEND THE WARNING JMP EAC.F,I RETURN * K48 DEC 48 * EE45 JSB PO2.F POP OFF '(' LDA OPCOD SSA,RSS IF (A) <0, OPERATOR STACK EMPTY JMP EE03 NO, CONTINUE EXPRESSION SCAN LDA KM7 YES, CPA TYPEX IF INPUT EXPRESSION IS AN 'IF' JMP EE605 END OF IF STATEMENT EXPRESSION JMP EE03 NO, CONTINUE STATEMENT SCAN. SPC 1 * * * ******************************************** * * SUBROUTINE OR ARRAY CALL GENERATION CODE * * ******************************************** * * SUARC NOP CLB,INB STB PNUM AT LEAST THE SUBPROG NAME ON STACK LDB F.S1T EE47 STB S1LOC INITIALIZE LOCATION OF SUB NAME LDA B,I (A) = STACK CONTENTS SSA IF (A) <0, JMP EE48 NAME OF SUBPROG ON STACK FOUND. ISZ PNUM INCREMENT NUMBER OF OPERANDS INB POINTS TO NEXT STACK 1 ENTRY JMP EE47 CONTINUE SEARCH. * EE48 ELA,CLE,ERA WIPE OFF SIGN BIT. STA B,I REPLACE ON STACK. STA F.A SET F.A TO POINT TO NAME JSB FA.F FETCH ASSIGNS FOR SUB OR ARR. LDA F.IU CPA B600 NAME IS ARRAY? JMP EE07 YES. * JSB JTS.F NO, GEN. CALL TO SUBPROG. RSS EE07 JS2EB AEA.F GEN. ARRAY ELEMENT ADDR CALC. JSB PO1.F POP OPERANDS OFF STACK 1. LDA RESLT JSB PU1.F PUSH RESULT ON STACK 1 JSB PO2.F POP '<' OFF OPERATOR STACK 2. JMP SUARC,I RETURN * * EE46 SZB,RSS IF PRIORITY ZERO GEN. DO IT LATER JMP EE50 * JSB SUARC GENERATE SUB. OR ARRAY CALL JSB EXN.F GET NEXT CHAR. LDB F.RF IF THIS WAS AN EMA ARRAY CPB F.EMA THEN JSB EAC.F TEST FOR SIM VAR IN A CALL LDA B51 RESTORE ')' STA F.TC FOR LASTC EE50 LDA PRIOR IS TOP OPERATOR PRIORITY SSA,RSS -1? (THEN OPERATOR STK IS EMPTY) JMP EE03 NO. * LDA TYPEX YES CPA KM3 IS ARRAY ELEMENT IN I/O LIST? JMP EE71 YES, WRAP IT UP. * INA,SZA CALL STATEMENT? JMP EE03 NO. * EE71 JSB II.F INPUT TERMINATING CHARACTER SZA F.IM=0? JMP EE16 NO, MISSING DELIMITER. * STA F.ACC YES CLEAR THE REGISTER FLAG AND EXIT JSB SER.F IF IN REG. THEN SAVE IN TEMP LDA F.S1T,I RETURN A.T. PTR TO ADDRESS TEMP JMP EE.F,I TO ARRAY ELEMENT ADDRESS CELL. SPC 1 B600 OCT 600 KM3 DEC -3 SPC 1 EE60 LDB TYPEX CHECK TYPE OF INPUT EXPRESSION. CPB KM6 IF ASSIGNMENT STATEMENT, JMP EE.F,I FINISHED. CPB KM2 IF DO INITIAL PARAMENTR, JMP EE.F,I FINSIHED. EE605 LDB F.S1T,I RESULT IS IN REGISTERS? SZB,RSS JMP EE70 YES. STB F.A NO - IF RESULT IS AN JSB FA.F EXTERNAL NAME, FLAG AS JSB NST.F ERROR 25. OTHERWISE CONTINUE. EE70 LDB TYPEX TYPE OF INPUT EXPRESSION CPB KM7 IF IF EXPRESSION, JMP EE61 PROCESS SEPARATELY. CPB KM4 IF DO TERMINAL OR STEP PARAMETER, JMP EE63 PROCESS SEPARATELY. CPB KM5 IF GO TO INDEX EXPRESSION, JMP EE63 PROCESS WITH DO TERM OR STEP PAR JMP EE67 STATEMENT FUNCTION. SPC 1 KM5 DEC -5 SKP EE61 LDB F.S1T,I (B) = IF EXPRESSION RESULT. BRS < 2 THEN SZB RESULT IS IN REGISTERS. JMP EE62 NO. * * STB F.ACC CLEAR THE REGISTER FLAG. LDA F.TAC TYPE OF REGISTER CPA ADDR ADDRESS? RSS JMP EE.F,I NO, EXIT * LDA LDA0I ADA F.S1T,I INCLUDE REGISTER NUMBER (0=A,1=B) JSB OAI.F OUTPUT LDA A/B,I LDA .AF (A)= TYPE OF ARRAY JMP EE.F,I SPC 1 EE62 LDB F.S1T,I GET A.T. POINTER TO B LDA LDAI LDA TO A JSB SOA.F OUTPUT LDA FIRST WORD OF RESULT. JSB GT1.F GET RESULT TYPE. CPA CPX COMPLEX? RSS YES JMP EE.F,I NO, FINISHED. LDA K58 ERROR 58 JSB ER.F COMPLEX EXPRESSION IS ILLEGAL * EE63 JSB GT1.F GET RESULT TYPE CPA LOG IF LOGICAL, JMP AO02 ERROR - ILLEGAL LOGICAL CONVERSION. * CPA INT INTEGER? JMP EE64A YES * STA STYPE SET SOURCE TYPE OF CONVERSION. LDA INT OBJECT TYPE OF CONV. IS INTEGER LDB F.S1T POINTER TO CONVERSION SOURCE JSB CON.F CONVERT TO INTEGER EE64A LDA F.S1T,I GET RESULT TO A SZA IF ZERO OR ONE CPA K1 THEN IN REGS. RSS SO GO STORE JMP EE.F,I ELSE RETURN F.A OF RESULT * LDB A PUT REG. FLAG IN B FOR LD.F LDA F.TAC GET TYPE OF REG. RESULT CPA ADDR IF ADDRESS JSB LD.F LOAD TO A REG. LDA STAI STORE RESULT IN PRE ALLOCATED LDB T3EE TEMP JSB SOA.F OUTPUT STA IN FIRST INT. TEMP CELL STA F.ACC CLEAR THE REG. FLAG LDA T3EE RETURN WITH (A) = A.T. PTR. TO JMP EE.F,I TEMP CELL INTO WHICH STORE MADE. SKP EE67 JSB GT1.F GET TYPE OF RESU:|LT CPA T1EE RESULT IS SAME TYPE AS S.F.? JMP EE68 YES. OMIT CONVERSION CODE. CPA LOG IS RESULT LOGICAL? JMP AO02 YES. ERROR. STA STYPE SET SOURCE TYPE OF CONVERSION. LDA T1EE OBJECT TYPE OF CONVERSION. CPA LOG IF LOGICAL S.F. NAME, JMP AO02 ERROR, LOGICAL CONVERSION ILLEGAL. LDB F.S1T POINTS TO SOURCE OF CONVERSION JSB CON.F GENERATE CONVERSION CODE. EE68 LDB F.S1T,I JSB LD.F LOAD RESULT IF POSSIBLE LDA T1EE (A)= TYPE OF S.F. NAME. CPA INT IF INTEGER, JMP EE69 CPA LOG OR LOGICAL, JMP EE69 CPA REA OR REAL, JMP EE69 SAVE TEMP CELLS AND EXIT. LDB .DFER IN CASE DBL S.F. CPA CPX LDB .CFER IF COMPLEX S.F. JSB ODF.F OUTPUT JSB .DFER, OR JSB .CFER ERA SET A = DEF 0,I LDB T2EE JSB OMR.F OUTPUT DEF F.SRL,I OF HEAD OF SF CLA LDB F.S1T,I JSB SOA.F OUTPUT DEF TEMP CELL OF SOURCE EE69 LDA LTI.N FROM LOC. LDB LI.NT TO LOC. RBL,CLE,SLB,ERB LDB B,I JSB .MVW SAVE ALLOCATED TEMP CELLS DEF K7 NOP JMP EE.F,I SPC 1 K58 DEC 58 LDAI OCT 62000 LI.NT DEF F.INT LTI.N DEF T.INT .CFER DEF .TBL+25 COMPLEX TRANSFER .DFER DEF .TBL+24 DOUBLE PRECISION TRANSFER T0EE NOP T1EE NOP T2EE NOP T3EE NOP .AF NOP ARRAY TYPE RESLT NOP WHERE RESULT IS STK1N NOP NEXT TO TOP STACK LOCN TYPEX NOP TYPE OF INPUT EXPR. PRIOR NOP TOP OPERATOR PRIORITY OPCOD NOP TOP OPERATOR CODE PNUM NOP NUMBER OF OPERANDS TO BE POPPED SKP * CODE GENERATION ROUTINES SPC 1 * ******************** * * ASSIGN OPERATION * = * ******************** SPC 1 AO.F NOP CLA,INA COMPUTE THE ADDRESS OF THE ADA F.SVL THE FIRST OPERATOR ADA F.S2B AND LDA A,I GET IT TO A CPA INASS IF INVERSE ASSIGN JMP AO03 THEN THIS IS NOT A REAL ASSIGN * JSB GT2.F GET ITEM MODES OF TOP TWO OPER. JSB CIF.F CONVERT TO PROPER TYPE IF NEEDED AO01 JSB SCG.F LOAD SOURCE VARIABLE LDA STK1N,I A.T. POINTER OF STORING VAR. LDB F.S1T,I A.T. POINTER OF LOADING VAR. JSB ST.F IF IT IS DOUBLE OR COMPLEX. STORE JMP AO.F,I SPC 1 AO02 LDA K55 JSB ER.F ERROR - CONV. OF LOGICAL ILLEGAL * AO03 LDB KM2 GET TYPE OF ULTIMATE ADB F.S1B DESTINATION LDB B,I A.T. POINTER TO B RBL,CLE,ERB CLEAR POSSIBLE SIGN BIT JSB FT.F GET TYPE STA NTYPE SAVE IT JSB GT1.F GET THE TYPE OF TOS JSB CIF.F CONVERT TOS IF NEEDED JSB SEO.F STORE IN TEMP IF IN REG. LDA F.S1T,I GET RESULT AND CCB COMPUTE BOTTOM OF STACK ADDRESS ADB F.S1B STA B,I PUT OPERAND THERE LDA STK1N,I GET OTHER OPERAND STA RESLT AND SET AS RESULT ( UNIARY OP IN THIS CASE) JMP AO.F,I RETURN CONVERT ONLY FOR EMA DESTINATION * * * *************************************************************** * * INVERSE ASSIGN SAME AS ASSIGN EXCEPT FOR ORDER OF OPERANDS * * *************************************************************** * * IN.AS NOP INVERSE ASSIGN FOR EMA ONLY LDA F.S1T,I GET TARGET (SHOULD BE IN REG.) LDB A TO B ALSO CLE,ERB TEST SZB,RSS YES OK JMP IN.01 * STA F.A SET A.T. POINTER AND JSB MAP.F GO GET ADDRESS JSB PO1.F POP OLD LDA RESLT AND PUSH JSB PU1.F NEW ONE IN.01 JSB GT1.F GET MODE CPA INT IF INTEGER JMP IN.00 GO DO PROPER LOAD * CPA LOG SAME IF LOGICAL F/ JMP IN.00 * JSB SER.F SAVE ADDRESS IF REQUIRED LDB STK1N,I GET THE LOAD VAR. JSB LD.F LOAD IT LDA F.S1T,I FOR OTHER VAR. LDB STK1N,I JSB ST.F STORE THE RESULT JMP IN.AS,I RETURN * IN.00 LDA F.S1T,I GET DESTINATION SZA,RSS IF ADDRESS IN A REG JMP IN.02 GO DO A REG. CODE * LDA LDAI. ELSE USE A REG. LDB STK1N,I SEND LDA JSB SOA.F LDA STABI AND JMP IN.03 GO EXIT * IN.02 LDA LDBI. ADDRESS IS IN A REG. SO US B LDB STK1N,I SEND LDB JSB SOA.F LDA STBAI AND IN.03 JSB OAI.F STB A,I LDA F.S1T,I SET STA RESLT RESULT JMP IN.AS,I AND RETURN * STABI STA B,I STBAI STB A,I LDBI. OCT 66000 * * ************************* * * CONVERT TOS IF NEEDED * * ************************* * CIF.F NOP ENTER A= TYPE OF TOS, NTYPE=REQUIRED TYPE CPA NTYPE IS TTYPE = NTYPE? JMP CIF.F,I YES, JUST RETURN CPA LOG IF LOGICAL, JMP AO02 ERROR STA STYPE STYPE _ TTYPE (SOURCE TYPE) LDA NTYPE (A) _ OBJECT TYPE OF CONVERSION CPA LOG IF LOGICAL, JMP AO02 ERROR LDB F.S1T (B) _ POINTER TO STACK ENTRY JSB CON.F GENERATE CONVERSION CODE. JMP CIF.F,I RETURN SPC 1 SPC 2 * ******* * * ADD * * ******* SPC 1 ADD.F NOP ADD TWO TOP OPERANDS. JSB PO.F MATCH TYPES, COMMUTE IF NON INT. JSB CCO.F CHECK IF INT COMMUTE WOULD HELP JSB SCG.F START CODE GENERATION (LOAD) LDA TTYPE CPA INT IF INTEGER, JMP ADD01 HANDLE IT SEPARATELY. CPA REA SELECT ADD ROUTINE NAME. LDB .FAD CPA DBL LDB .XADD CPA CPX LDB .CADD JSB FCS.F COMPLETE CALLING SEQUENCE. JMP ADD.F,I SPC 1 K55 DEC 55 .FAD DEF .TBL+2 FLOATING ADD .XADD DEF .TBL+16 DOUBLE PRECISION ADD .CADD DEF .TBL+20 COMPLEX ADD SPC 1 ADD01 LDB STK1N,I LDA ADAI JSB SOA.F OUTPUT INTEGER ADD JMP ADD.F,I SPC 2 * ************ * * SUBTRACT * * ************ SPC 1 SUB.F NOP SUBTRACT TOP FROM NEXT TO TOP OP JSB PO.F MATCH TYPES, COMMUTE IF NON INT. LDA TTYPE CPA REA IF REAL OPERANDS JSB CO.F COMMUTE THEM JSB SCG.F START CODE GENERATION (LOAD) LDA TTYPE CPA INT JMP SUB01 HANDLE INTEGER SEPARATELY. CPA REA SELECT SUBTRACT ROUTINE NAME LDB .FSB CPA DBL LDB .XSUB CPA CPX LDB .CSUB JSB FCS.F COMPLETE CALLING SEQUENCE JMP SUB.F,I SPC 1 .FSB DEF .TBL+3 FLOATING SUB .XSUB DEF .TBL+17 DOUBLE PRECISION SUB .CSUB DEF .TBL+21 COMPLEX SUB SPC 1 SUB01 LDA NEGI JSB OAI.F OUTPUT 'CMA,INA' LDB STK1N,I LDA ADAI JSB SOA.F OUTPUT ADD NEXT-TO-TOP OPERAND JMP SUB.F,I SPC 1 NEGI CMA,INA ADAI OCT 42000 NTYPE NOP TTYPE NOP SKP * ********** * * NEGATE * * ********** SPC 1 NEG.F NOP GEN. CODE FOR UNARY MINUS. JSB GT1.F GET TOP OPERAND TYPE. CPA LOG IS TOP OPERAND LOGICAL? JMP PO01 YES, ERROR - ARITH. OP. REQUIRED JSB SCG.F NO, START CODE GENERATION (LOAD) LDA TTYPE CPA INT IS OPERAND INTEGER? JMP NEG01 CPA REA OR REAL? JMP NEG02 YES. HANDLE SEPARATELY JSB FA.F GET ITEM MODE OF OPERAND LDA F.IM CPA ADDR IF IT IS AN ADDRESS TEMP CELL, JMP NEG03 TRANSFER ARRAY ELEMENT TO TEMP. LDA F.A IF NOT, SEE IF IT IS A TEMP CELL ADA K2 OF TYPE DBL OR CPX RATHER THAN LDA A,I A SIMPLE VARIABLE.i SSAI SSA IF TEMP CELL, JMP NEG04 GENERATE JSB ..DCM OR ..CCM NEG03 LDA TTYPE JSB ATC.F ALLOCATE DBL OR CPX TEMP CELL. LDB F.S1T,I SOURCE OF JSB .DFER OR .CFER STA F.S1T,I SAVE TEMP DESTINATION ON STACK JSB ST.F GENERATE JSB .DFER OR .CFER NEG04 LDB ..DCM IN CASE DBL OPERAND LDA TTYPE (A)= TYPE OF OPERAND CPA CPX LDB ..CCM JSB ODF.F GENERATE JSB .ROUTINE LDB F.S1T,I OTHERWISE GENERATE DEF OPERAND STB RESLT CHANGE RESULT FROM REG. TO VAR. JSB DEF.F GENERATE DEF. JMP NEG.F,I SPC 1 ..DCM DEF .TBL+41 DOUBLE PRECISION NEGATION ..CCM DEF .TBL+42 COMPLEX NEGATION ..FCM DEF .TBL+4 COMPLEMENT FLOATING IN (A,B) K2 DEC 2 SPC 1 NEG01 LDA NEGI JSB OAI.F OUTPUT CMA,INA FOR INTEGER NEG. JMP NEG.F,I SPC 1 NEG02 LDB ..FCM GENERATE JSB ..FCM FOR JSB ODF.F REAL NEGATION. JMP NEG.F,I SKP * ************ * * MULTIPLY * * ************ SPC 1 MULTP NOP MULTIPLY TOP OPERANDS JSB PO.F MATCH TYPES,COMMUTE IF NONINT. JSB CCO.F CHECK IF INT COMMUTE WOULD HELP JSB SCG.F START CODE GENERATION (LOAD) LDA TTYPE CPA INT SELECT MPY ROUTINE NAME LDB .MPY CPA REA LDB .FMP CPA DBL LDB .XMPY CPA CPX LDB .CMPY JSB FCS.F COMPLETE CALLING SEQUENCE. JMP MULTP,I SPC 1 .MPY DEF .TBL+5 FIX-POINT MPY .FMP DEF .TBL FLOATING MPY .XMPY DEF .TBL+18 DOUBLE PRECISION MPY .CMPY DEF .TBL+22 COMPLEX MPY SPC 2 * *********** * * DIVIDE * * *********** SPC 1 DIV.F NOP DIVIDE NEXT-TO-TOP BY TOP OPRAND JSB PO.F MATCH TYPES, COMMUTE IF NON INT. LDA TTYPE CPA INT IF INT OR REAL OPERANDS RSS CPA REA JSB CO.F FO~RCE COMMUTATION JSB SCG.F START CODE GENERATION (LOAD) LDA TTYPE CPA INT IF INTEGER, JMP DIV01 HANDLE SEPARATELY CPA REA SELECT DIVIDE ROUTINE NAME LDB .FDV CPA DBL LDB .XDIV CPA CPX LDB .CDIV DIV02 JSB FCS.F COMPLETE CALLING SEQUENCE. JMP DIV.F,I SPC 1 .FDV DEF .TBL+1 FLOATING DIV .XDIV DEF .TBL+19 DOUBLE PRECISION DIV .CDIV DEF .TBL+23 COMPLEX DIV .DIV DEF .TBL+6 FIX-POINT DIV SKP DIV01 LDA CLBI JSB OAI.F OUTPUT 'CLB' LDA SSAI JSB OAI.F OUTPUT 'SSA' LDA CMBI JSB OAI.F OUTPUT 'CMB' LDB .DIV JMP DIV02 GO COMPLETE SPC 1 CMBI CMB SPC 2 * ****************** * * EXPONENTIATION * * ****************** SPC 1 EXP.F NOP JSB CO.F COMMUTE OPERANDS JSB SEO.F STORE TOP OP IF IN REGISTERS JSB GT2.F GET TYPES OF TOP 2 OPERANDS LDA NTYPE (A) _ TYPE OF POWER LDB TTYPE (B)_ TYPE OF BASE CPB INT IS BASE INTEGER? JMP EXP02 YES CPB CPX NO, IS BASE COMPLEX? JMP EXP03 YES CPB REA NO, IS BASE REAL? JMP EXP04 YES CPB DBL NO, IS BASE DOUBLE? JMP EXP05 YES EXP01 LDA K45 NO - ERROR - ILLEGAL EXPONENT. JSB ER.F SPC 1 K45 DEC 45 SPC 1 CLBI BSS 0 EXP02 CLB INTEGER BASE. CPA INT IS POWER INTEGER? LDB .ITOI YES JMP EXP06 SPC 1 .ITOI DEF .TBL+13 I**I SPC 1 EXP03 CLB COMPLEX BASE. CPA INT IS POWER INTEGER? LDB .CTOI YES JMP EXP06 SPC 1 .CTOI DEF .TBL+43 C**I .RTOI DEF .TBL+14 R**I .RTOR DEF .TBL+15 R**R SKP EXP04 CLB REAL BASE. CPA INT IS POWER INTEGER? LDB .RTOI YES CPA REA IS POWER REAL? eHFBLDB .RTOR YES CPA DBL IS POWER DOUBLE? LDB .RTOD YES JMP EXP06 SPC 1 .RTOD DEF .TBL+10 R**D .DTOI DEF .TBL+9 D**I .DTOR DEF .TBL+11 D**R .DTOD DEF .TBL+12 D**D SPC 1 EXP05 CLB DOUBLE BASE. CPA INT IS POWER INTEGER? LDB .DTOI YES CPA REA IS POWER REAL? LDB .DTOR YES CPA DBL IS POWER DOUBLE? LDB .DTOD YES EXP06 SZB,RSS IF (B) IS STILL 0,NO NAME WAS JMP EXP01 SELECTED - ERROR - ILLEGAL EXP. JSB ODF.F GENERATE JSB .ROUTINE LDA TTYPE CPA CPX IF COMPLEX, JMP EXP07 YES - ALLOCATE TEMP FOR DEF RESULT CPA DBL IF DOUBLE, JMP EXP07 YES, SAME AS ABOVE. LDA NTYPE NO CPA DBL IF DOUBLE, JMP EXP07 YES, SAME AS ABOVE CLA i*H STA RESLT RESULT WILL BE IN REGISTERS JMP EXP08 GENERATE REMAINDER OF CALL. SEQ. SPC 1 EXP07 JSB ATC.F ALLOCATE TEMP FOR DEF RESULT. STB RESLT SAVE F.A AS RESLT JSB DEF.F GENERATE DEF RESULT. EXP08 LDB F.S1T,I JSB DEF.F GENERATE DEF BASE. LDB STK1N,I JSB DEF.F GENERATE DEF POWER. LDA JSBI LDB .ERR0 JSB SOA.F GENERATE JSB ERR0 JMP EXP.F,I SKP * ******************* * * LOGICAL OR, AND * * ******************* SPC 1 L.OR BSS 0 .OR. TOP OPERANDS L.AND NOP .AND. TOP OPERANDS JSB CCO.F COMMUTE OPERANDS IF HELPFUL JSB GT2.F GET TYPES OF TOP TWO OPERANDS. LDB NTYPE GET TWO OPERAND TYPES CPB A BOTH MUST BE SAME TYPE RSS OK JMP NOT01 TOO BAD * CPA INT TEST OTHER OPERAND RSS YES CPA LOG IS IT LOGICAL? KK77 CLA,RSS YES, PROCESS. JMP NOT01 NO - ERROR - NEED LOG OR INT OPS. * JSB SCG.F START CODE GENERATION (LOAD) LDB OPCOD CPB K8 IS OPERATION .OR.? LDA IORI YES CPB K9 IS OPERATION .AND.? LDA ANDI YES LDB STK1N,I LOAD OPERAND. JSB SOA.F OUTPUT 'IOR L' OR 'AND L' JMP L.AND,I SPC 1 ANDI OCT 12000 IORI OCT 32000 K8 DEC 8 SPC 2 * *************** * * LOGICAL NOT * * *************** SPC 1 L.NOT NOP .NOT. TOP OPERAND. JSB GT1.F GET TYPE OF TOP OPERAND CPA INT TYPE MUST BE INT OR RSS CPA LOG IT MUST BE LOGICAL JMP NOT02 YES, GENERATE CODE. NOT01 LDA K56 NO, ERROR -OPERATOR REQUIRES JSB ER.F LOGICAL OPERAND. SPC 1 K56 DEC 56 SPC 1 NOT02 JSB SCG.F START CODE GENERATION(LOAD) LDA CMAI JSB OAI.F  OUTPUT CMA JMP L.NOT,I SKP * ************************* * * RELATIONAL LESS THAN * * ************************* SPC 1 R.LT NOP OUTPUT CODE FOR R1 .LT. R2 JSB SUB.F OUTPUT CODE FOR R1 - R2 LDA K58 LDB TTYPE CPB CPX JSB ER.F COMPLEX IS ILLEGAL. JSB LDT.F LOAD FIRST WORD OF DBL RESULT JSB SLR.F SET RESLT=0, TYPE OF REG.=LOG. JMP R.LT,I SPC 1 CPX OCT 50000 F.IM=5 COMPLEX SPC 2 * **************************** * * RELATIONAL LESS OR EQUAL * * **************************** SPC 1 R.LE NOP OUTPUT CODE FOR R1 .LE. R2 JSB CO.F COMMUTE OPERANDS JSB R.GE GEN. SAME CODE AS FOR R1 .GE. R2 JMP R.LE,I SPC 2 * ********************* * * RELATIONAL EQUALS * * ********************* SPC 1 R.EQ NOP OUTPUT CODE FOR R1 .EQ. R2. JSB BEN.F OUT. CODE THAT IS SAME FOR EQ,NE LDA TTYPE CPA INT IF INTEGER JMP R.EQ2 CPA LOG OR LOGICAL OPERANDS, JMP R.EQ1 HANDLE SEPARATELY. LDA KK77 OUTPUT 'CLA,RSS' JSB OAI.F OUTPUT INST. R.EQ1 LDA CMAI JMP R.EQ3 OUTPUT 'CMA' SPC 1 R.EQ2 LDA KK78 OUTPUT 'CCA,RSS' JSB OAI.F LDA CLAI OUTPUT 'CLA' R.EQ3 JSB OAI.F JSB SLR.F SET RESLT=0 AND REG. TYPE =LOG. JMP R.EQ,I SPC 1 LDA0I LDA A,I SKP * ************************ * * RELATIONAL NOT EQUAL * * ************************ SPC 1 R.NE NOP OUTPUT CODE FOR R1 .NE. R2 JSB BEN.F OUT. SAME CODE FOR EQ,NE LDA TTYPE CPA LOG ARE OPERANDS LOGICAL? JMP R.NE2 YES, DONE. CPA INT ARE OPERANDS INTEGER? KK78 CCA,RSS YES. 'CPA' HAS BEEN GENERATED JMP R.NE1 LDA KK77 OUTPUT 'CLA,RSmS' JSB OAI.F R.NE1 LDA CCAI OUTPUT 'CCA' JSB OAI.F R.NE2 JSB SLR.F SET RESLT=0, TYPE OF REG. = LOG. JMP R.NE,I SPC 1 CCAI CCA SPC 2 * *************************** * * RELATIONAL GREATER THAN * * *************************** SPC 1 R.GT NOP OUTPUT CODE FOR R1 .GT. R2. JSB CO.F COMMUTE OPERANDS JSB R.LT OUT. SAME CODE AS FOR R1.LT.R2 JMP R.GT,I SPC 2 * ****************************** * * RELATIONAL GREATER OR EQUAL * * ****************************** SPC 1 R.GE NOP OUTPUT CODE FOR R1 .GE. R2 JSB R.LT OUT. SAME CODE AS FOR R1.LT.R2 LDA CMAI JSB OAI.F OUTPUT 'CMA' JMP R.GE,I SPC 2 * ********************** * * SET LOGICAL RESULT * * ********************** SPC 1 SLR.F NOP CLA SO REGISTER RESULT WILL BE STACKED STA RESLT LDB LOG REGISTER TYPE LOGICAL STB TTYPE JMP SLR.F,I RETURN SKP * ******************* * * BASE OF EQ, NE * * ******************* SPC 1 BEN.F NOP OUT. FIRST PART OF EQ, NE CODE. JSB GT2.F GET TYPES OF TOP 2 OPERANDS. CPA NTYPE RSS JMP BEN01 IF TYPES NOT SAME, NOT LOG OR INT CPA INT IF INTEGER OPERANDS JMP BEN03 CPA LOG IF LOGICAL OPERANDS JMP BEN03 BEN01 JSB SUB.F OUTPUT CODE FOR R1 - R2 JSB LDT.F LOAD FIRST WORD CPX OR DBL TEMP LDA TTYPE CPA CPX COMPLEX? RSS JMP BEN02 NO ISZ F.C SET OFFSET ISZ F.C TO 2 LDA IORI OUTPUT 'IOR TEMP +2' LDB RESLT JSB SOA.F BEN02 LDA SZAI OUTPUT 'SZA' JSB OAI.F JMP BEN.F,I SPC 1 CMAI CMA SZAI SZA STAI OCT 72000 SPC 1 BEN03 JSB CCO.F CHECK TO SEE IF COMMaUTE HELPS JSB SCG.F START CODE GENERATION (LOAD) LDB TTYPE CPB INT IF INTEGER OERANDS, LDA CPAI OUTPUT 'CPA OPERAND' CPB LOG IF LOGICAL OPERANDS, LDA XORI OUTPUT 'XOR OPERAND' LDB STK1N,I OPERAND IS NEXT-TO-TOP ON STK1 JSB SOA.F OUTPUT INSTRUCTION JMP BEN.F,I RETURN SPC 1 B140 OCT 140 XORI OCT 22000 CPAI OCT 52000 LOG OCT 30000 F.IM=3 LOGICAL K26 DEC 26 SKP * ********************** * * JUMP TO SUBPROGRAM * * ********************** SPC 1 JTS.F NOP LDA F.IM SAVE F.IM OF SUBPROG NAME STA T0JTS LDA F.R STA T1JTS SAVE F.R FOR SUBPROG NAME LDA F.NC CPA B140 IF F.NC ='%', SPECIAL CALLING JMP JTS03 SEQUENCE. HANDLE SEPARATELY. * LDB F.S2T,I GET STACKED FLAG BIT SSB,RSS IF USER SUB JMP JTS00 SAVE EMA VARABLES IF ADDRESS IN REG. * JSB SER.F ELSE NEED NOT MOVE EMA VARS. RSS JTS00 JSB SEO.F MAKE SURE ALL REGISTERS ARE STORED LDA JSBI LDB S1LOC,I JSB SOA.F OUTPUT JSB TO SUBPROG NAME CLAI CLA LDB TYPEX (B) _ TYPE OF INPUT EXPRESSION. INB,SZB IF IT IS A SUBROUTINE CALL STMT JMP JTS15 NO TEST TYPE * LDB S1LOC YES CHECK IF PRAM INB CPB F.S1B IF ONLY ENTRY JMP JTS01 THEN IT IS NOT A PRAM * JTS15 LDB T0JTS CPB DBL FUNCTION IS DBL? JMP JTS02 YES CPB CPX FUNCTION IS CPX? JMP JTS02 YES JTS01 LDB PNUM NO - MUST BE INT LOG REA OR SUBR JSB OZ.F OUTPUT DEF *+N+1 JMP JTS07 OUTPUT ARGUMENT DEFS SPC 1 JTS02 LDB PNUM CALLS TO DBL OR CPX FUNCTIONS INB JSB OZ.F OUTPUT DEF *+N+2 LDA T0JTS JSB ATC.F ALLOCATE DBL OR CPX RESULT TEMP STB RESLT SAVE POINTER TO FUNCTION RESULT JSB DEF.F OUTPUT DEF RESULT JMP JTS08 OUTPUT ARGUMENT DEFS. SPC 1 JTS03 LDA K2JTS SEE IF CALL IS TO SIGN,ISIGN, JTS05 LDB A,I IOR OR IAND CPB .NOT IF NONE OF THESE JMP JTS09 PROCESS CALL BY VALUE. CPB S1LOC,I IF IT IS ONE OF THEM, JMP JTS35 GENERATE SPECIAL CALL SEQUENCE INA JMP JTS05 SPC 1 JTS35 LDA PNUM CHECK FOR PROPER NUMBER OF ARG. CPA K3 WELL JMP JTS36 YES ALL IS WELL * JTS04 LDA K59 OOPS! JSB ER.F WRONG NUMBER OF ARGUMENTS * JTS36 LDA K8 IF CPB .IOR IOR JMP JTS37 OR * INA CPB .IAND IAND JMP JTS37 DO IN LINE CODE * JSB SER.F MAKE SURE ARGUMENTS ARE STORED LDA JSBI LDB S1LOC,I OUTPUT JSB SOA.F JSB ISIGN, SIGN JTS07 CLA STA RESLT RESULT WILL BE IN REGISTERS JTS08 LDB S1LOC OUTPUT ARGUMENT DEFS JTS14 ADB KM1. STB S1LOC POINTS TO NEXT ARG IN STACK LDB B,I (B) _ A.T. POINTER TO ARG. JSB DEF.F OUTPUT DEF ARGUMENT LDB S1LOC CPB F.S1T IS ENTIRE ARG LIST OUTPUT? JMP JTS11 YES, FINISH UP. JMP JTS14 NO, OUTPUT NEXT ARGUMENT DEF. SPC 1 JTS37 STA OPCOD SET UP OPCODE FOR L.AND JSB L.AND PRODUCE IN LINE CODE JMP JTS.F,I RETURN * JTS09 LDA PNUM PROCESS CALL BY VALUE CALL. SEQ. CPA K2 IS THERE EXACTLY ONE ARG.? RSS YES JMP JTS04 NO - ERROR - INCORRECT NO. OF ARGS JSB GT1.F GET ARGUMENT TYPE. CPA INT ARGUMENT MUST BE INTEGER JMP JTS10 CPA REA OR REAL. JMP JTS10 LDA K60 ARGUMENT MODE ERROR JSB ER.F SPC 1 JTS10 JSB SCG.F OUTPUT LOAD ARGUMENT LDA JSBI LDB S1LOC,I CPB .NOT IF IT IS 'NOT' FUNCTION JMP JTS13 GENERATE IN-LINE CODING JSB SOA.F 3.OUTPUT JSB FUNCTION JTS11 LDB .ERR0 IN CASE NEEDED. LDA T1JTS F.R FOR FUNCTION NAME SZA,RSS JMP JTS12 IF 0, FINISH UP LDA JSBI IF NOT 0, JSB SOA.F OUTPUT JSB ERR0 JTS12 LDB T0JTS STB TTYPE TTYPE = TYPE OF FUNTION RESULT JMP JTS.F,I SPC 1 JTS13 LDA CMAI CODE IN-LINE FOR 'NOT' JSB OAI.F FUNCTION IS 'CMA'. JMP JTS12 FINISH UP. SPC 1 T0JTS NOP T1JTS NOP K2JTS DEF .IAND K59 DEC 59 K60 DEC 60 REA OCT 20000 F.IM=2 REAL DBL OCT 60000 F.IM=6 DOUBLE ADDR OCT 70000 F.IM=7 ADDRESS * * * ************************************************ * * ROUTINE TO GEN .EMAP CALL FOR SIMPLE VARABLE * * ************************************************ * * MAP.F NOP ENTER WITH F.A SET TO VARIABLES A.T. LDA F.A SET DEFAULT STA RESLT RESULT I.E. IT IS NOT IN EMA JSB EA?.F IS IT IN EA?.F JMP MAP00 NO EXIT * CLB,INB STB PNUM SET NUMBER OF VARIABLES FOR AEA.F CLB SET NO. OF DIMS. STB F.ND SET NUMBER OF DIMENSIONS JSB AEA.F AEA DOES THE REST MAP00 LDA RESLT LOAD RESULT TO A JMP MAP.F,I RETURN (RESULT IS IN REG) AND PTR. IN A * * ***************************************************** * * ROUTINE TO TEST IF F.A POINTS AT AND EMA VARIABLE * * ***************************************************** * * EA?.F NOP JSB FA.F FETCH ASSIGNS LDB F.AT CHECK IF IN BCOM CPB BCOM IF NOT THEN NOT IN EMA RSS SO FAR SO GOOD JMP EA?.F,I TAKE FALSE EXIT * ADA K2 INDEX TO THE BCOM MASTER POINTER LDA A,I GET IT CPA F.EMA WELL? ISZ EA?.F YES STEP THE RETURN TO INDICAT EMA JMP EA?.F,I RETURN P+1 NOT EMA, P+2 EMA * SKP * ************************* * * ARRAY ELEMENT ADDRESVS * * ************************* SPC 1 K25 DEC 25 K38 DEC 38 SUB OCT 200 F.IU=1 (SUBROUTINE) BCOM OCT 3000 F.AT=BCOM DBSZ OCT 3 # WORDS/ DOUBLE PRECISION ELEMENT SPC 1 AEA.F NOP LDA F.IM STA T6AEA SAVE ARRAY F.IM LDA F.A STA T1AEA SAVE ARRAY BASE ADDRESS WORD LDA F.X1 STA T2AEA SAVE POINTER TO FIRST DIMENSION LDA F.X2 STA T3AEA SAVE POINTER TO SECOND DIM. LDA F.AT GET LOCATION INFO. CCB AND STB T7AEA SET SIZE TO -1 FOR ZERO DIM CASE CPA DUM IF DUMMY LDB F.AF SET THE BASE ADDRESS STB T5AEA IN TEMP LDB PNUM CMB,INB ADB F.ND INB (B) = F.ND+1-PNUM LDA K38 SSB JSB ER.F ERR: MORE SUBS THAN DIMENSIONS * LDA F.ND IF NO DIMENSION SZA,RSS THEN MUST BE AN EMA VARABLE JMP AEA21 SO GO DO IT * LDB F.S1T LOCATION OF FIRST SUBSCRIPT, STB T4AEA SAVE IT. AEA15 LDB B,I SZB IF SUBSCRIPT IS IN REGISTERS, CPB K1 JMP AEA17 GO CHECK TYPE. STB F.A OTHERWISE MAKE SURE IT IS JSB FA.F NOT A SUBPROGRAM NAME. LDA K25 LDB F.IU CPB SUB JSB ER.F LDB T4AEA,I (B) = SUBSCRIPT POINTER AEA17 JSB FT.F GET ITS TYPE CPA INT IS IT INTEGER? JMP AEA18 YES. CONVERSION NOT NEEDED. CPA LOG IF LOGICAL SUBSCRIPT, JMP AO02 ERROR - LOGICAL CONV. ILLEGAL STA STYPE SOURCE TYPE OF CONVERSION LDA INT OBJECT TYPE OF CONVERSION LDB T4AEA LOCATION OF CONVERSION SOURCE JSB CON.F CONVERT IT TO INTEGER AEA18 ISZ T4AEA POINTS TO NEXT SUBSCRIPT LDB T4AEA CPB S1LOC HAVE ALL SUBSCRIPTS BEEN CHECKED? RSS YES. JMP AEA15 NO, CONTINUE CHECKING SUBSCRIPTS * KK82 CLA,INmA IF F.IM=INTEGER OR LOGICAL, LDB T6AEA ARRAY TYPE CPB REA IF F.IM=REA, LDA K2. CPB DBL IF F.IM=DBL, LDA DBSZ SIZE OF DOUBLE PRECISION CPB CPX IF F.IM=COMPLEX LDA K4 STA T7AEA SAVE # WORDS/ELEMENT * LDA T1AEA RESTORE STA F.A THE VARIABLES JSB EA?.F IN EA?.F RSS NO DO STANDARD ARRAY JMP AEA20 YES GO DO EMA ARRAY * LDA PNUM CPA K2. VECTOR CALCULATION? JMP AEA03 YES. * JSB SEO.F STORE REGISTERS IF FULL. LDA T7AEA GET #WORDS/ELEMENT STA F.IDI SET UP TO MAKE CONSTANT CPA K1 IF ONE JMP AEA07 THEN DO A CLB,INB INSTEAD * LDA INT INTEGER CONSTANT JSB ESC.F JSB AI.F LDA LDBI JSB OA.F OUTPUT LDB 2,3,OR 4 AEA08 LDA CLAI (A) = 'CLA' IF 2 DIM. LDB PNUM CPB K4 IF 3 DIM., LDA KK82 (A) = 'CLA,INA' JSB OAI.F OUTPUT 'CLA' OR 'CLA,INA' LDB ..MAP JSB ODF.F OUTPUT JSB ..MAP (RETURNS A=0) LDB T5AEA B=F.AF IF DUMMY ELSE 0 SSB,RSS IF DUMMY ARRAY JMP AEA01 PUT OUT DIRECT DEF * LDB T1AEA ELSE BUILD A DEF JSB ESD.F MAKE DEF TO THE ARRAY JSB OA.F PRODUCE DEF TO THE DEF RSS SKIP DUMMY DEF CODE AEA01 JSB OMR.F SEND DEF TO DUMMY (BAD CALL SEQUENCE FOR ..MAP) LDB S1LOC AEA02 ADB KM1. STB S1LOC POINTS TO STACK LOC FOR NEXT SUB LDB B,I JSB DEF.F OUTPUT DEF 2 OR 3 SUBSCRIPTS LDB S1LOC CPB F.S1T ARE ALL DEF SUBSCRIPTS OUTPUT? RSS JMP AEA02 NO, OUTPUT NEXT ONE LDB T2AEA JSB DEF.F OUTPUT DEF FIRST DIMENSION LDB T3AEA LDA PNUM CPA K4 IF 3 DIMENSIONAL JSB DEF.F OUTPUT DEF SECOND DIMENSION JMP AEA06 FINISH UP SPC 1 AEA07 4LDA CLBIN GET 'CLB,INB' INSTRUCTION JSB OAI.F SEND IT JMP AEA08 CONTINUE WITH CODE GEN. * S1LOC NOP CLBIN CLB,INB SET B TO 1 INSTRUCTION K4 DEC 4 KM1. DEC -1 ..MAP DEF .TBL+26 ARRAY ELEMENT ADDRESS CALCULATE. .EMAP DEF .TBL+51 EMA ARRAY ELEMENT ADDRESS CALCULATER LDBI OCT 66000 SPC 1 AEA03 JSB SCG.F HANDLE VECTOR ADDRESS CALCULATION LDA T5AEA GET SAVE F.AT OF SUBSCRIPT SSA JMP AEA10 NOT DUM SKIP -1 GARBAGE * LDA INT JSB ESC.F ESTABLISH INTEGER CONSTANT OF -1 CCA STA F.IDI JSB AI.F ASSIGN IT TO TABLE LDA ADAI. JSB OA.F GENERATE ADA -1 AEA10 LDB T7AEA CMB,INB SET NEGATIVE INB,SZB,RSS IF 1 WORD PER ELEMENT JMP AEA05 NO MPY NEEDED * LDA ALS2I ASSUME 4 WORDS PER (ALS,ALS) INB,SZB,RSS IF TWO WORDS PER LDA ALSI USE (ALS) INB,SZB,RSS IF THREE WORDS PER JMP AEA04 DO A MPY BY 3 * JSB OAI.F JMP AEA05 SPC 1 ADAI. OCT 42000 ALSI ALS ALS2I ALS,ALS KM3. DEC -3 I.MPY DEF .TBL+5 FIXED POINT MULTIPLY SPC 1 AEA04 LDB I.MPY OUTPUT JSB .MPY JSB ODF.F LDA INT JSB ESC.F ESTABLISH INTEGER CONSTANT LDA T7AEA OF 3 AND ASSIGN IT TO TABLE. STA F.IDI JSB AI.F LDB F.A F.A POINTS TO CONSTANT 3 JSB DEF.F OUTPUT DEF 3 AEA05 LDB T5AEA IF DUM ARRAY SSB,RSS THEN NO HELP JMP AEA11 * LDA T7AEA ELSE SET UP A CMA,INA BASE DEF THAT MAKES THE MOST SENSE LDB T1AEA F.A OF ARRAY JSB ESD.F ESTABLISH DEF ARRY-#WORDS/ELEMENT LDA ADAI. PUTOUT JSB OA.F AND ADD OF THIS DEF JMP AEA06 PICK UP REST OF CODE * AEA20 JSB SER.F FOR DIM. ARRAY SAVE ONLY ADDRESS AEA21 JSB SEO.F SAVE THE REGISTERS IF NEEDED LDB .EMAP GET '.EMAP' OFFSET JSB pODF.F SEND DOT FUNCTION CALL LDB PNUM COMPUTE THE DEF ERR RETURN ADDRESS ADB K2 *+NDIM+3 JSB OZ.F SEND IT LDB F.EMA USE EMA MASTER ADDRESS STB F.RF SHOW REGS CONTAIN AN 'EMA' ADDRESS JSB DEF.F SEND A DEF LDB T1AEA NOW SEND DEF INB TO THE DIM ENTRY LDB B,I IN THE A.T. (WILL BE TABLE ) ADB K2. INDEX TO THE LDA T7AEA F.DAY SLOT SSA,RSS IF ZERO DIM. CASE SKIP STORE STA B,I AND SAVE THE ELEMENT SIZE THERE ADB KM2. BACK TO THE BEGINING OF THE SYMBOL SSA IF NO DIMENSIONS LDA T1AEA,I CHECK IF ARRAY AND B600 ISOLATE IU CPA ARR IF SO INB,RSS MUST USE RSS LDB B,I THE BCOM ENTRY FOR THE DEF. JSB DEF.F LDA F.ND GET NO. DIMS. SZA,RSS IF NONE JMP AEA23 GO SEND THE ERR0. * LDB F.S1T SET UP TO SEND STB T4AEA THE DEFS TO THE INDEXES AEA22 LDB T4AEA THE DEF'S TO THE INDEXES CPB S1LOC END OF LIST? JMP AEA23 YES GO WRAP IT UP * ISZ T4AEA SET IT FOR NEXT TIME LDB B,I GET THE A.T. POINTER JSB DEF.F SEND A DEF JMP AEA22 TRY AGAIN * AEA23 LDB .ERR0 NOW SEND A JSB ERR0 LDA JSBI JSB SOA.F FOR THE ERROR RETURN CLA,INA SET FOR RESULT TO BE JMP AEA24 IN B-REG. AND GO EXIT * AEA11 LDA ADAI. JSB OMR.F GENERATE ADA BASE OF VECTOR AEA06 CLA SET RESULT FOR A-REG. AEA24 STA RESLT LDB ADDR SET RESULT TYPE STB TTYPE STB F.TAC LDB T6AEA SET MODE STB .AF OF RESULT JMP AEA.F,I NO, RETURN. * SPC 1 T1AEA NOP T2AEA NOP T3AEA NOP T4AEA NOP T5AEA NOP T6AEA NOP T7AEA NOP DUM OCT 5000 F.AT=DUM INT OCT 10000 F.IM=1 INTEGER KM2. DEC -2 F.RF NOP SKP * B@< ************************* * * LOAD TEMP FIRST WORD * * ************************* SPC 1 LDT.F NOP LOAD TEMP FIRST WORD IF CPX,DBL LDB TTYPE CPB DBL OPERAND DOUBLE OR JMP LDT01 CPB CPX COMPLEX? RSS JMP LDT.F,I NO, RETURN, LDT01 LDB RESLT GENERATE 'LDA TEMP' TO GET LDA LDAI. ITS FIRST WORD IN A REGISTER JSB SOA.F JMP LDT.F,I RETURN SPC 2 * ************************* * * START CODE GENERATION * * ************************* SPC 1 SCG.F NOP CLA STA RESLT RESLT=0 IF OPERATION RESULT IS LDB F.S1T,I JSB LD.F LOAD TOP OPERAND JMP SCG.F,I SKP * ******************** * * PREPARE OPERANDS * * ******************** SPC 1 PO.F NOP SET UP OPERANDS FOR OBJ CODE GEN JSB MAT.F MATCH OPERAND TYPES,GEN CONV COD |mB LDA TTYPE CPA LOG IF OPERANDS LOGICAL,ERROR. JMP PO01 CPA INT IF INTEGER, JMP PO.F,I EXIT. CPA REA IF REAL, JMP PO.F,I EXIT. JSB CO.F COMMUTE IF DBL OR CPX JMP PO.F,I SPC 1 PO01 LDA K57 ERROR - OPERATOR REQUIRES ARITH. JSB ER.F OPERANDS. SPC 1 K57 DEC 57 LDAI. OCT 62000 SPC 2 * *************************** * * FINISH CALLING SEQUENCE * * *************************** SPC 1 FCS.F NOP JSB ODF.F OUTPUT JSB .ROUTINE LDA TTYPE CPA REA IF OPERATION IS WITH REAL OPS, JMP FCS01 SKIP DEF TEMP, DEF OPERAND 1. CPA INT IF OPERATION IS INT MPY, DIV JMP FCS01 OUTPUT 'DEF J' JSB ATC.F ALLOCATE TEMP FOR DBL OR CPX STB RESLT CHANGE RESULT FROM 0 TO TEMP PTR JSB DEF.F OUTPUT DEF TEMP. LDB F.S1T,I JSB DEF.F DEF TOP OPERAND. FCS01 LDB STK1N,I JSB DEF.F DEF NEXT-TO-TOP OPERAND. JMP FCS.F,I SKP * ***************** * * GENERATE LOAD * * ***************** SPC 1 LD.F NOP (B) = A.T. POINTER TO LOADING VAR. STB T0LD SAVE IT CLE,ERB IF 1 SET TO ZERO SZB IS (B)=0? JMP LD02 NO - OPERAND NOT ALREADY IN REGISTER * LDA F.TAC CPA ADDR IS ADDRESS IN ACCUMULATOR? RSS JMP LD015 NO LDA .AF GET ARRAY TYPE CPA INT IF INTEGER JMP LD005 GO DO LDA * CPA LOG SAME IF LOG JMP LD005 * CPA REA IF REAL ARRAY JMP LD004 GO DO DLD * JSB GSA.F IF NONE OF THE ABOVE STORE THE ADDRESS JMP LD.F,I AND EXIT (NOT LOADABLE) * LD004 LDB .DLD OUTPUT JSB .DLD JSB ODF.F RETURNS A=0, E=1 ERA,SLA SET A=DEF A,I & SKIP. LD005 LDA LDA0I INT OR LOG; US@E LDA A,I ADA T0LD CHANCE TO B,I IF B REG. IS INVOLVED. JSB OAI.F LDA .AF LD01 STA F.TAC SET F.TAC = F.IM OF REGISTER(S) LD015 CLA STA F.ACC F.ACC=0 SINCE OPERAND NOW IN REGISTER STA F.RF CLEAR THE REG. CONTAINS FLAG JMP LD.F,I RETURN, OPERAND IN REGISTER(S). SPC 1 LD02 JSB SER.F STORE REG. IF NOT EMPTY LDB T0LD STB F.A RESTORE F.A JSB GIM.F GET ITEM MODE OF LOADING DATUM. CPA INT IF INTEGER, JMP LD03 OUTPUT LDA I CPA LOG IF LOGICAL, JMP LD03 OUTPUT LDA F.L CPA REA IF REAL, JMP LD04 OUTPUT DLD R JMP LD.F,I NOT ANY, NOT LOADABLE. EXIT. SPC 1 LD03 LDA LDAI. JSB OA.F OUTPUT LDA OPERATION. JMP LD05 SPC 1 LD04 LDB .DLD JSB ODF.F OUTPUT JSB .DLD LDB T0LD JSB DEF.F OUTPUT DEF R LD05 JSB GIM.F JMP LD01 SET F.ACC=0 AND RETURN. SPC 1 T0LD BSS 1 .DLD DEF .TBL+7 DOUBLE LOAD SKP * ****************** * * GENERATE STORE * * ****************** SPC 1 ST.F NOP ASSUME F.IM OF SOURE, DEST SAME. STA F.A STA T0ST SAVE A.T. PTR TO STORE DEST. STB T1ST SAVE A.T. PTR TO CPX,DBL SOURCE. JSB GIM.F GET F.IM OF DEST OF STORE STA T2ST SAVE F.IM OF DEST OF STORE CPA INT IF INTEGER, OR JMP ST01 CPA K.LOG IF LOGICAL JMP ST01 OUTPUT 'STA' INSTRUCTION. CPA REA IF REAL, LDB .DST CPA CPX OR COMPLEX TRANSFER, LDB CFER. .CFER CPA DBL OR DOUBLE TRANSFER LDB .DFER .DFER JSB ODF.F GENERATE JSB .ROUTINE LDB T0ST JSB DEF.F GENERATE DEF DESTINATION JMP ST02 SPC 1 K.LOG OCT 30000 K.STA OCT 72000 'STA' K.STB OCT 76000 'STB' .DST DEF .TBL+8 DOUBLE STORE CFER. DEF .TBL+25 COMPLEX TRANSFER SPC 1 ST01 LDA K.STA 'STA' LDB F.ACC,I GET THE REF. FROM THE STACK CPB K1 IF B-REG. LDA K.STB BETTER USE A STB JSB OA.F OUTPUT 'STA' INSTRUCTION ST02 LDB T0ST POINTER TO TEMP CELL. STB F.ACC,I IF F.ACC#0, STORE T0ST ON STACK 1 CLA SINCE REGISTERS EMPTY, STA F.ACC RESET F.ACC AND F.TAC =0. STA F.TAC STA F.RF CLEAR THE REFERENCE FLAG LDA T2ST IS F.IM OF DESTINATION LDB T1ST CPA CPX COMPLEX? RSS YES CPA DBL DOUBLE? JSB DEF.F GENERATE DEF SOURCE OF DBL OR CPX LDA T0ST RETURN A.T. OF DESTINATION JMP ST.F,I SPC 1 T0ST NOP T1ST NOP T2ST NOP SKP * ************************** * * GENERATE STORE IN TEMP * * ************************** SPC 1 GST.F NOP FOR STORING A AND A-B INTO TEMPS LDA F.ACC SAVE THE STA T2GST STACK ADDRESS IF ONE GST00 LDA F.TAC TYPE OF TEMP CELL NEEDED. CPA ADDR IF ADDRESS MUST CHECK FOR EMA JMP GST01 COULD BE * GST05 JSB ATC.F ALLOCATE TEMP CELL LDB T1GST IN CASE OF DBL/CPX FROM EMA JSB ST.F STORE INT, LOG OR REAL GST04 STA T2GST,I SET NEW A.T. POINTER IN STACK JMP GST.F,I RETURN * GST01 LDB F.RF GET THE REFERENCE FLAG CPB F.EMA EMA ARRAY ADDRESS? JMP GST02 YES GO DO SPECIAL * JSB GSA.F NOT EMA BUT ADDRESS ALLOCATE AND STORE LDA F.A GET A.T. OF ADDRESS TEMP JMP GST04 AND EXIT * GST02 LDB .AF GET TYPE OF VARIABLE CPB CPX MUST DO SPECIAL RSS IF COMPLEX CPB DBL OR DOUBLE JMP GST03 GO SET UP DBL/CPX * LDB F.ACC,I CAN BE LOADED INTO REG. SO DO IT JSB LD.F NOW JMP GST00 GO STORE IT IN A TEMP * GST03 JSB GSA.F DBL/CP X ALLOCATE A TEMP ADDRESS CELL LDB F.A SAVE THE ADDRESS LOCATION STB T1GST IN TEMP FOR MOVE JMP GST05 GO ALLOCATE TEMP AND MOVE VARIABLE TO IT * T1GST NOP T2GST NOP * * * ******************************************* * * ALLOCATE ADDRESS TEMP AND STORE INTO IT * * ******************************************* * * GSA.F NOP ROUTINE TO ALLOCATE AN ADDRESS TEMP AND LDA ADDR STORE INTO IT GET IM JSB ATC.F ALLOCATE THE TEMP LDA INT TEMPORARILY MAKE F.IM OF TEMP. INT JSB DIM.F LDA F.A STORE REGISTER CONTAINING JSB ST.F ADDRESS IN TEMP CELL. LDA ADDR JSB DIM.F CHANGE ITS F.IM BACK TO ADDRESS. LDA .AF INSERT F.IM OF ITEM BEING ADDRESSED JSB DAF.F INTO AF OF TEMP CELL A.T. ENTRY. JMP GSA.F,I RETURN .AF IN A SPC 2 * ***************************************** * * SAVE REG. BUT DON'T MOVE EMA VARIABLE * * ***************************************** * GSR.F NOP LDA F.TAC GET REG. TYPE CPA ADDR IF ADDRESS JMP GSR01 GO DO ADDRESS THING * JSB GST.F ELSE USE STD. SAVE JMP GSR.F,I RETURN * GSR01 JSB GSA.F ADDRESS TEMP SET UP JMP GSR.F,I RETURN * * * ******************************************************** * * ROUTINE TO SAVE REG. IF NEEDED BUT NOT MOVE EMA VAR. * * ******************************************************** * * SER.F NOP LDB F.ACC ANY THING IN REG? SZB IF NOT SKIP JSB GSR.F YES SAVE IT JMP SER.F,I RETURN * * **************** * * GENERATE DEF * * **************** SPC 1 DEF.F NOP OPERAND ASSUMED NOT TO BE IN REG CLA JSB SOA.F OUTPUT THE DEF JMP DEF.F,I SKP * *********************** * * MATCH OPERAND TYPES * * *********************** SPC 1 MAT.F NOP JSB GT2.F GET TYPES OF TWO TOP OPERANDS CPA NTYPE ARE TYPES ALREADY THE SAME? JMP MAT.F,I YES, RETURN. CPA K.LOG IF LOGICAL, JMP AO02 ERROR - LOG. CONV. ILLEGAL LDB NTYPE LOAD TYPE OF NEXT-TO-TOP OPERAND CPB K.LOG IF LOGICAL, JMP AO02 ERROR - LOG. CONV. ILLEGAL CPA INT IS TTYPE = INT? JMP MAT01 YES,THEN NTYPE > TTYPE. CPB INT IS NTYPE = INT? JMP MAT02 YES,THEN TTYPE > NTYPE. CPA REA IS TTYPE = REA? JMP MAT01 YES,THEN NTYPE > TTYPE. CPB REA IS NTYPE = REA? JMP MAT02 YES, THEN TTYPE > NTYPE. CPA CPX IS TTYPE = CPX? JMP MAT02 YES, THEN TTYPE > NTYPE = DBL. MAT01 STA STYPE NO,THEN NTYPE=CPX > TTYPE=DBL. STB A CONVERT TTYPE OPERAND TO NTYPE STB TTYPE MAKE TTYPE = NTYPE LDB F.S1T TOP OPERAND TO BE CONVERTED JMP MAT03 CALL CONVERSION SUBROUTINE. SPC 1 MAT02 STB STYPE CONVERT NTYPE OPERAND TO TTYPE STA NTYPE MAKE TTYPE = NTYPE LDB STK1N NEXT-TO-TOP OPERAND TO BE CONV. MAT03 JSB CON.F GENERATE CONVERSION CODE JMP MAT.F,I SPC 1 STYPE BSS 1 SKP * **************************** * * GENERATE CONVERSION CODE * * **************************** SPC 1 CON.F NOP STA OTYPE (A)=TYPE TO BE CONVERTED TO AND STB T4CON (B)=POINT. TO STK ENT CONT ELEM. LDB B,I (B)=POINT. TO A.T. ENT OF ELEM. CLB IN CASE CONV RESULT IS IN REGS. CPA DBL IS OBJECT OF TYPE DOUBLE? JMP CON01 YES * CPA CPX NO, IS OBJECT OF TYPE COMPLEX CON01 JSB ATC.F YES. ALLOCATE TEMP CELL FOR STB T3CON RESULT OF CONV., SAVE IT LDA STYPE (A)= SOURCE TYPE OF CONVERSION. LDB OTYPE (B) = OBJECT TYPE OF CONVERSION CPA REA IS SOURCE REAL? CPB INT YES, IS OBJECT INTEGER? JMP CON03 SOURCE NOT REAL OR ABOVE 2 TRUE * JSB SER.F STORE REAL IF IN REGISTERS JMP CON04 SPC 1 CON03 LDB T4CON,I LOAD CONVERSION SOURCE JSB LD.F IF POSSIBLE AND NEEDED. CON04 CLB B=0 AS FLAG UNTIL NAME SELECTED STB T1CON T1CON FOR DEF *+1+T1CON LDA STYPE (A)= TYPE OF SOURCE OF CONVER. CPA INT IS SOURCE TYPE INTEGER? JMP CON05 YES * CPA CPX NO, IS SOURCE TYPE COMPLEX JMP CON06 YES * CPA DBL NO, IS SOURCE TYPE DOUBLE PREC.? JMP CON07 YES * LDA OTYPE NO, IT MUST BE REAL. CPA INT IS OBJECT TYPE INTEGER? LDB .IFIX YES, CPA DBL NO, IS OBJECT TYPE DOUBLE? LDB .DBLE YES CPA CPX NO,IS IT COMPLEX? LDB .MPLX YES JMP CON08 GENERATE REST OF CALLING SEQ. SPC 1 CON05 LDA OTYPE SOURCE IS INTEGER. CPA REA OBJECT REAL? LDB .LOAT YES CPA CPX OBJECT COMPLEX? LDB .ICPX YES CPA DBL OBJECT DOUBLE? LDB .IDBL YES JMP CON08 GENERATE REST OF CALLING SEQ. SPC 1 .ICPX DEF .TBL+45 CONVERT INTEGER TO COMPLEX .IDBL DEF .TBL+44 CONVERT INTEGER TO DOUBLE .CINT DEF .TBL+48 CONVERT COMPLEX TO INTEGER SPC 1 CON06 LDA OTYPE SOURCE IS COMPLEX. CPA INT OBJECT INTEGER? LDB .CINT YES CPA DBL OBJECT DOUBLE? LDB .CDBL YES CPA REA OBJECT REAL? LDB .REAL YES JMP CON08 GENERATE REST OF CALLING SEQ. SPC 1 JSBI. OCT 16000 K2. DEC 2 .CDBL DEF .TBL+40 CONVERT COMPLEX TO DOUBLE .DINT DEF .TBL+47 CONVERT DOUBLE TO INTEGER .DCPX DEF .TBL+46 CONVERT DOUBLE TO COMPLEX SPC 1 CON07 LDA OTYPE SOURCE IS DOUBLE PREC. CPA INT OBJECT INTEGER? LDB .DINT YES k CPA CPX OBJECT COMPLEX? LDB .DCPX YES CPA REA OBJECT REAL? LDB .SNGL CON08 STB T2CON SAVE NAME SELECTED LDA K2. IF DEF *+N+1 IS NEEDED, CPB .REAL JMP CON09 DEF *+2 * CPB .SNGL JMP CON09 DEF *+2 * INA CPB .DBLE JMP CON09 DEF *+3 * INA CPB .MPLX JMP CON09 DEF *+4 * CPB .LOAT JMP CON12 * CPB .IFIX JMP CON12 * JMP CON11 SPC 1 CON09 STA T1CON CON12 LDA JSBI. 'JSB' JSB SOA.F OUTPUT NO-DOT CONV. ROUTINE CLA,RSS CON11 JSB ODF.F OUTPUT DOT CONV. ROUTINE (RTNS A=0) LDB T1CON SZB IF B#0, DEF *+N+1 IS NEEDED. JSB OZ.F LDB T3CON SZB IF B#0, DEF RESULT IS NEEDED. JSB DEF.F LDA STYPE CPA INT JMP CON10 CALLING SEQ. IS COMPLETE * LDA T2CON CPA .IFIX JMP CON10 CALLING SEQUENCE IS COMPLETE * LDB T4CON,I JSB DEF.F GENERATE DEF OF SOURCE LDA T2CON CPA .MPLX RSS GENERATE DEF 0 JMP CON10 * LDA REA JSB ESC.F ESTABLISH REAL CONSTANT JSB CDI.F CONSTANT IS 0. JSB AI.F ASSIGN 0 CONSTANT TO A.T. LDB F.A POINTER TO A.T. ENTRY FOR CONST. JSB DEF.F GENERATE DEF 0 CON10 LDA T3CON UPDATE POINTER IN OPERAND STA T4CON,I STACK TO POINT TO CONV. RESULT. SZA A=0 IF RESULT IS IN REGISTER(S) JMP CON.F,I RETURN * LDA T4CON STA F.ACC UPDATE F.ACC LDA OTYPE STA F.TAC UPDATE F.TAC JMP CON.F,I RETURN SPC 1 T1CON BSS 1 T2CON BSS 1 T3CON BSS 1 T4CON BSS 1 OTYPE BSS 1 SPC 2 * DISPLACEMENTS FROM BASE OF FIXED EXTERNAL SYMBOL TABLE * * THESE VALUES RELATE TO THE TABLE IN F4.0, AND ARE CONVERTED * INTO DEFS BY ADDING THE F4.0 TABLE BASeE ADDRESS. SPC 1 * THE ORDER OF .IAND,.IOR,..SIG,SIG..,AND .NOT MUST BE THIS SPC 1 .IAND OCT 263 IAND FUNCTION .IOR OCT 257 IOR FUNCTION OCT 226 SIGN FUNCTION OCT 313 ISIGN FUNCTION .NOT OCT 267 NOT FUNCTION .ERR0 OCT 242 ERROR SUBROUTINE ERR0 .IFIX OCT 307 IFIX CONVERSION FUNCTION .DBLE OCT 5 DBLE CONVERSION FUNCTION .MPLX OCT 105 CMPLX CONVERSION FUNCTION .LOAT OCT 221 FLOAT CONVERSION FUNCTION .REAL OCT 236 REAL CONVERSION FUNCTION .SNGL OCT 232 SNGL CONVERSION FUNCTION .EXEC OCT 246 EXEC (SYSTEM ENT) .END EQU * END OF TABLE SKP * ****************** * * CHECK COMMUTE * * ****************** SPC 1 * CALLED IF COMMUTATION IS NOT REQUIRED, BUT MAY BE * ADVANTAGEOUS TO GET REGISTER OPERAND ON TOP OF STACK. * CCO.F NOP LDA F.ACC SZA IF NOTHING IN REGISTERS, CPA F.S1T OR IF TOP OPND IS ALREADY IN REG., JMP CCO.F,I RETURN. JSB CO.F ELSE COMMUTE OPERANDS JMP CCO.F,I SPC 2 * ******************** * * COMMUTE OPERANDS * * ******************** SPC 1 CO.F NOP CALLED WHEN COMM. IS REQUIRED. LDA F.ACC SZA,RSS IF NO OPERAND IS IN REGISTERS, JMP CO01 GO COMMUTE TOP 2 OPERANDS * CPA STK1N IF NEXT-TO-TOP OPERAND IN REG, JMP CO02 GO CHANGE F.ACC TO F.S1T. * JSB GSR.F NO, STORE TOP OPERAND BEFORE COMM. CO01 LDA F.S1T,I (A)_TOP OPERAND ON STACK 1. LDB STK1N,I (B)_ NEXT-TO-TOP OPERAND ON STACK STB F.S1T,I TOP OPERAND _ (B) STA STK1N,I NEXT-TO-TOP OPERAND _ (A) JMP CO.F,I SPC 1 CO02 LDA F.S1T UPDATE F.ACC TO F.S1T SINCE STA F.ACC COMMUTATION PUTS REGISTER OPND JMP CO01 ON TOP OF STACK. SPC 2 * ************************ * * STORE EITHERlM OPERAND * * ************************ SPC 1 SEO.F NOP STORE EITHER OF TOP 2 OPERANDS. LDB F.ACC IF F.ACC # 0 THEN SOME OPERAND SZB IS IN REGISTERS JSB GST.F STORE THE OPERAND IN A TEMP CELL JMP SEO.F,I RETURN. REGISTERS NOW EMPTY. SKP * ********************************* * * GET TYPES OF TOP TWO OPERANDS * * ********************************* SPC 1 GT2.F NOP GET F.IM OF TWO TOP OPERANDS LDB STK1N,I JSB FT.F GET F.IM OF NEXT TO TOP OPERAND STA NTYPE AND SAVE IT IN NTYPE. JSB GT1.F GET F.IM OF TOP OPERAND. JMP GT2.F,I SPC 2 * *************************** * * GET TYPE OF TOP OPERAND * * *************************** SPC 1 GT1.F NOP LDB F.S1T,I JSB FT.F GET F.IM OF TOP OPERAND STA TTYPE AND SAVE IT IN TTYPE JMP GT1.F,I SPC 2 * ************* * * FIND TYPE * * ************* SPC 1 FT.F NOP ENTERED WITH (B) = A.T. PTR. STB F.A LDA F.TAC THIS IS F.IM IF OPER. IN REGISTERS CPA ADDR IS F.TAC = ADDR? LDA .AF YES, REPLACE F.TAC WITH .AF CLE,ERB FOURCE B-REG. REF TO ZERO SZB (B)=0 IF TOP OPERAND IN REGISTERS JSB GIM.F FETCH ITEM MODE OF CELL. STA F.IM SAVE F.IM OF TOP OPERAND IN TYPE. JMP FT.F,I SPC 2 * ***************** * * GET ITEM MODE * * ***************** SPC 1 GIM.F NOP IF F.IM=ADDR FOR F.A, CHANGE IT. JSB FA.F FETCH ASSIGNS LDB F.IM (B) _ F.IM OF F.A CPB ADDR IF F.IM=ADDRESS, STA F.IM SET F.IM=AF F.A LDA F.IM MAKE SURE UPDATED F.IM IS IN (A) JMP GIM.F,I SPC 1 VAR OCT 400 F.IU=2 (VARIABLE OR CONSTANT) TEMPS DEF T.INT-1 B377 OCT 377 SKP * ************************ * * ALLOCATE A TEMP CELL * * ************************ SPC 1 ATC.F NOP STA F.IM (A)=F.IM OF TEMP CELL NEEDED ALF MAKE F.IM A SMALL INTEGER ADA TEMPS (A)_ ADDRESS OF TEMP CELL NAME WORD CCB ADB A,I (B)_ TEMP CELL NAME -1 STB A,I TEMP CELL NAME UPDATED, NEXT NAME STB T0ATC SAVE TEMP CELL NAME CLA STA F.NT NAME TAG = 0 (VARIABLE) LDA VAR STA F.IU ITEM USAGE = VARIABLE JSB BNI.F CLEAR NAME TO BLANKS LDA T0ATC ALF,ALF AND B377 LDB F.DNI STA B,I NID=FIRST HALF OF NAME LDA T0ATC AND B377 INB STA B,I NID+1=SECOND HALF OF NAME JSB AI.F ASSIGN NAME TO A.T. LDA F.A RETURN ASSIGN TAB PTR TO TEMP CELL LDB F.A JMP ATC.F,I SPC 1 T0ATC BSS 1 SPC 2 * ****************************** * * SEPARATE CODE AND PRIORITY * * ****************************** SPC 1 SPC.F NOP LDA F.S2T,I (A) _ TOP WORD IN OPERATOR STACK AND B377 STA PRIOR PRIOR _ PRIORITY OF TOP OPERATOR XOR F.S2T,I RAL,CLE,ERA CLEAR POSSIBLE SIGN BIT ALF,ALF STA OPCOD OPCOD _ CODE OF TOP OPERATOR JMP SPC.F,I SKP * **************** * * PUSH STACK 1 * * **************** SPC 1 * STACK 1 IS THE OPERAND STACK. IT IS IN HIGH CORE, JUST * BELOW THE DO TABLE, AND GROWS TOWARD LOW CORE. THIS * ROUTINE IS ENTERED WITH (A) = WORD TO BE STACKED. * (A) = F.A GENERALLY EXCEPT THAT * (A) = F.A,I FOR SUB OR ARRAY WITH (LIST) * (A) = 0 OR 1 IF OPERAND IS IN REGISTER(S). SPC 1 * IF (A) = 0 OR 1, THEN TTYPE = F.IM OF REGISTERS SPC 1 * (B) IS NOT DESTROYED BY THIS SUBROUTINE SPC 1 PU1.F NOP T PUSH STACK 1 TO STACK OPERANDS. STB T0PU1 SAVE B REGISTER. CCB ADB F.T STB F.T T=T-1 ADB F.S1B STB F.S1T NEW PTR TO TOP OPERAND ON STK1. CPB F.S2T IF 2 TOP POINTERS THE SAME, JMP F.OFE DATA POOL OVERFLOW * SZA IF (A)=0 OR 1, OPERAND IS IN REGISTERS, CPA K1 STB F.ACC SO SET F.ACC TO POINT TO STACK ENTRY. INB STB STK1N NEW PTR TO NEXT-TO-TOP OPERAND. STA F.S1T,I STORE OPERAND ON STACK. LDB TTYPE SZA IF (A)=0 OR 1, OPERAND IS IN REGISTERS, CPA K1 STB F.TAC SO SET F.TAC = TYPE OF REG. CONTENT LDB F.ACC CMB,INB ADB STK1N (B)= STK1N-F.ACC. SSB IF (B) < 0, REG. CONTENTS BELOW JSB GST.F STK1N, SO GENERATE STORE IN TEMP ?? SHOULD THIS BE HERE???? LDB T0PU1 RESTORE B REGISTER. JMP PU1.F,I SPC 1 T0PU1 NOP SPC 2 * *************** * * POP STACK 1 * * *************** SPC 1 PO1.F NOP TO UNSTACK AND DISCARD OPERANDS. LDB F.T ADB PNUM ADD NO. OF ENTRIES TO BE POPPED STB F.T FROM STACK TO T. ADB F.S1B STB F.S1T NEW PTR TO TOP OPERAND ON STK1. INB STB STK1N NEW PTR TO NEXT-TO-TOP OPERAND. CLB IN CASE REGISTER OPERAND WAS STB F.ACC POPPED FROM STACK, SET F.ACC AND STB F.TAC F.TAC TO 0. JMP PO1.F,I SPC 2 * **************** * * PUSH STACK 2 * * **************** SPC 1 * STACK 2 IS THE OPERATOR STACK. IT IS IN LOWER CORE THAN * IS STACK 1, JUST ABOVE THE ASSIGNMENT TABLE, AND GROWS * TOWARD HIGH CORE. THIS ROUTINE IS ENTERED WITH (A) = * WORD TO BE STACKED. SPC 1 PU2.F NOP PUSH STACK 2 TO STACK OPERATORS ISZ F.L F.L=F.L+1 LDB F.S2B ADB F.L  STB F.S2T CPB F.S1T IF TOP TWO POINTERS SAME, JMP F.OFE DATA POOL OVERFLOW. STA F.S2T,I STACK OPERATOR JSB SPC.F UPDATE OPCOD, PRIOR OF TOP OP. JMP PU2.F,I SPC 2 * *************** * * POP STACK 2 * * *************** SPC 1 PO2.F NOP UNSTACK AND DISCARD OPERATORS CCB STB PRIOR REINITIALIZE OPCODE AND PRIOR TO 0. STB OPCOD ADB F.L STB F.L F.L=F.L-1 ADB F.S2B STB F.S2T NEW PTR TO TOP OPERATOR LDB F.L CPB F.SVL IS OPERATOR STACK EMPTY? RSS YES, EXIT JSB SPC.F NO, UPDATE OPCOD, PRIOR OF TOP OP. JMP PO2.F,I SKP * OPERATOR TABLE - 3 WORD ENTRIES SPC 1 * WORD 1: THE OPERATOR * WORD 2: ITS PRIORITY * WORD 3: ADDRESS OF ROUTINE TO GENERATE ITS CODE SPC 1 TABLE OCT 75 =, OCT 1 PRIORITY=1, CODE=1 DEF AO.F SPC 1 OCT 53 +, DEC 8 PRIORITY=8, CODE=2 DEF ADD.F SPC 1 OCT 55 -, DEC 8 PRIORITY=8, CODE=3 DEF SUB.F SPC 1 OCT 40 UNARY - (BLANK) DEC 9 PRIORITY=9, CODE=4 DEF NEG.F SPC 1 OCT 52 *, DEC 10 PRIORITY=10, CODE=5 DEF MULTP SPC 1 OCT 57 /, DEC 10 PRIORITY=10, CODE=6 DEF DIV.F SPC 1 ASC 1,** **, DEC 11 PRIORITY=11, CODE=7 DEF EXP.F SPC 1 ASC 1,OR LOGICAL OR, OCT 4 PRIORITY=4, CODE=8 DEF L.OR SPC 1 ASC 1,AN LOGICAL AND OCT 5 PRIORITY=5, CODE=9 DEF L.AND SPC 1 ASC 1,NO LOGICAL NOT, OCT 6 PRIORITY=6, CODE=10 DEF L.NOT SPC 1 LT. ASC 1,LT RELATIONAL LESS THAN, OCT 7 WSNLHPRIORITY=7, CODE=11 DEF R.LT SPC 1 ASC 1,LE RELATIONAL LESS OR EQUAL TO, OCT 7 PRIORITY=7, CODE=12 DEF R.LE SPC 1 ASC 1,EQ RELATIONAL EQUAL, OCT 7 PRIORITY=7, CODE=13 DEF R.EQ SPC 1 ASC 1,NE RELATIONAL NOT EQUAL, OCT 7 PRIORITY=7, CODE=14 DEF R.NE SPC 1 ASC 1,GE RELATIONAL GREATER OR EQUAL TO, OCT 7 PRIORITY=7, CODE=15 DEF R.GE SPC 1 ASC 1,GT RELATIONAL GREATER THAN, OCT 7 PRIORITY=7, CODE=17 DEF R.GT SPC 2 OCT -1 INVERSE ASSIGN OCT 0 PRIORITY =0, CODE=17 DEF IN.AS * EOPT EQU * * SPC 2 EF4.1 EQU * SPC 2 END F4.1 yN D 92060-18096 1805 S C0122 FTN4 SEGMENT 2              H0101 "ASMB,Q,C HED ** 16K FTN4 COMPILER (F4.2:PASS2) ** NAM F4.2,5 92060-16096 780310 REV. 1805 * *************************************** * FORTRAN-4 COMPILER OVERLAY 2 *************************************** * * THIS OVERLAY TRANSLATES THE PSEUDOCODE GENERATED BY * PASS 1 INTO RELOCATABLE BINARY, GENERATES THE ASSEMBLY * LISTING, AND LISTS THE ASSIGNMENT TABLE. * * * * *************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * * REPRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * *************************************************************** * * * * * * EXT'S WITH A LEADING 'F.' ARE VARIABLES OR JUMP TARGETS * * THE COLUMN THE EXT STARTS IN DEFINES THE SUBROUTINE IT IS * DEFINED IN AS FOLLOWS * 2 -- OA.F (WRITE PASS FILE ROUTINES) * 3 -- NEX.F (STATEMEXTS THAT DON'T CONTAIN EXPRESSIONS) * 4 -- FA.F (THE ASSIGNMEXT TABLE ROUTINES) * 5 -- EX.F (STATEMEXTS USING THE EXPRESSION EVALUATOR) * 6 -- IC.F (THE CHARACTER INPUT ROUTINES) * 7 -- IDN.F (THE TOKEN INPUT ROUTINES) * 8 -- FTN4 ( THE MAIN) EXT F..DP BASE OF SYMBOL TABLE EXT F..E DIMENSIONS CONSTANT BIT FROM ASSIGNS TABLE EXT F.A ASSIGNMEXT TABLE ADDRESS (CURRENT ENTRY) EXT F.ASS ASSIGNMEXT STATEMEXT PROCESSOR EXT F.ABT ABORT COMPILE EXTRY EXT F.ACC TEMP ACCUMULATOR FLAG EXT F.AF ADDRESS FIELD CURREXT F.A EXT F.ARF NO. OF SUB. FUN. ARGUMEXTS EXT F.ASP ASSIGN STMT. PROCESSOR EXT F.AT ADDRESS TYPE OF CURREXT F.A EXT F.AT. SUBSCRIPT INFO FLAG EXT F.BGN RETURN FROM F4.0 EXT F.BSP: BACKSPACE STMT. PROCESSOR EXT F.BUF A BUFFER EXT F.C OFFSET FOR CURRENT MR INSTRUCTION EXT F.CAL CALL STATEMEXT PROCESSOR EXT F.CC CHARACTER COUNT EXT F.CCW FTN OPTION WORD EXT F.CIN CURREXT CI BUFFER LINE NUMBER EXT F.CLN INPUT ITEM CURREXT LINE # EXT F.CON CONTINUE STMT. PROCESSOR EXT F.CSZ COMMON SIZE EXT F.D DO TABLE POINTER EXT F.D.T ADDRESS OF '.' FUN. TABLE EXT F.D0 ARRAY ELEMEXT SIZE EXT F.D1 DIMENSION 1 EXT F.D2 DIMENSION 2 EXT F.D3 DIMENSION 3 EXT F.DCF DIM, COM FLAG EXT F.DEF DATA EXISTS FLAG EXT F.DID ADDRESS OF F.IDI EXT F.DLF DELIMETER FLAG EXT F.DNB DEF OF NBUF (NAM RECORD) EXT F.DNI ADDRESS OF NID EXT F.DO LWAM - END OF DO TABLE EXT F.DOP DO STATEMEXT PROCESSOR EXT F.DP BASE OF USER SYMBOL TABLE EXT F.DTY IMPLICIT TYPE TABLE EXT F.E EQUIVALENCE TABLE POINTER EXT F.EFG E - FLAG - SET IF SUBSCRIPT IS DUMMY EXT F.EFP ENDFILE STMT. PROCESSOR EXT F.EMA F.A OF EMA EXT ENTRY, WINDOW SIZE EXT F.EMS EMA SIZE DOUBLE WORD, (INTERNAL FORMAT) EXT F.END END FLAG EXT F.EQE EQUVALENCE ERROR FLAG EXT F.EQF EQUIVALENCE FLAG EXT F.ER0 'RX' OF ERRX LIB ERROR ROUTINE EXT F.ERF ERROR FLAG (# OF ER.F CALLS) EXT F.ERN ERROR ARRAY EXT F.EXF EXTERNAL STATEMEXT FLAG EXT F.FMT FORMAT STMT. PROCESSOR EXT F.GOP GO TO STATEMEXT PROCESSOR EXT F.IDI INPUT ARRAY NON-NUMERIC EXT F.IFF IF FLAG EXT F.IFP IF STATEMEXT PROCESSOR EXT F.IM CURREXT ITEM MODE (REAL, COMPLEX,ECT.) EXT F.INT TEMP VARIABLE ARRAY EXT F.IOF INDICATOR FOR I/O INDEX EVALUATOR EXT F.IU CURREXT ITEM USAGE (DUM., RELAFTIVE, ECT.) EXT F.HDL LENGTH OF HEAD MESSAGE EXT F.L # WORDS ON STACK 2 EXT F.LFF LOCICAL IF FLAG EXT F.LLO CURRENT RELOCATAION ADDRESS(TWO WORDS) EXT F.LLT ADDRESS OF LINE LOCATION TABLE (SET BY INIT) EXT F.LO END OF ASSIGNMEXT TABLE+1 EXT F.LOP NO. LINES LEFT ON THIS PAGE. EXT F.LPR ( LOC OF EQUIVALENCE GROUP EXT F.LSF EXPECT FIRST STATEMEXT FLAG EXT F.LSN F.A OF LAST STATEMEXT NUMBER EXT F.LSP LAST OPERATION FLAG EXT F.MFL TYPE STMT. MODE FLAG EXT F.NC NAME CHANGE FLAG. EXT F.NCR NO CROSS REF FLAG EXT F.ND NUMBER OF DIMENSIONS EXT F.NEQ # OF EQUIVALENCE GROUPS EXT F.NT NAME TAG 0= VAR, 1=CONSTANT. EXT F.NTF NAME TAG FLAG EXT F.NW NO. WORDS THIS TABLE F.A EXTRY. EXT F.NXN NO INPUT FLAG EXT F.OFE DATA POOL OVERFLOW ERROR EXTRY. EXT F.OPF OUTPUT PACK FLAG EXT F.R JSB ERR0 FLAG EXT F.PAK PACK BUFFER WORD EXT F.PAP PAUSE STMT. PROCESSOR EXT F.RDP READ STATEMEXT PROCESSOR EXT F.REL SUB. PROG. RETURN LOCATION EXT F.RPL PROGRAM LOCATION COUNTER EXT F.RPR ) LOC OF EQUIVALENCE GROUP EXT F.RTN RETURN STMT. PROCESSOR EXT F.RWP REWIND STMT. PROCESSOR EXT F.S02 RETURN FORM RCOM F.1 EXT F.S03 LOAD F.1 AND PASS CONTROL EXT F.S1B BOTTOM OF STACK 1 EXT F.S1T TOP OF STACK 1 EXT F.S2B BOTTOM OF STACK 2 EXT F.S2T TOP OF STACK 2 EXT F.SBF 0= MAIN, ELSE SUBROUTINE EXT F.SCC SAVE F.CC EXT F.SEE RETURN FROM F4.1 EXT F.SEG LOAD A NEW SEGMENT EXT F.SFF SUBROUTINE/FUNCTION FLAG 0/1 EXT F.SFP STATEMEXT FUNCTION PROCESSOR EXT F.SID STATEMEXT ID PHASE FLAG EXT F.SLF STATEMEXT LEVEL FLAG EXT F.SPF SPsECIFICATION FLAG SET TO CURREXT STMT. LEVEL EXT F.SPS STATEMEXT PROCESSOR SWITCH EXT F.SRL SAVE RPL AT BEGINNING OF RECORD EXT F.STA FLAG THAT IS ZERO UNTIL THE FTN STATEMEXT IS READ EXT F.STB STRING BACK JUMP FLAG EXT F.STP STOP STMT. PROCESSOR EXT F.STS TO STATEMEXT SCAN EXT F.SVL SAVE # WORDS ON OPER STACK (F.L) EXT F.SXF COMPLEX CONSTANT FLAG EXT F.T # WORDS ON STACK 1 EXT F.TAC ? EXT F.TC NEXT CHARACTER EXT F.TIM TIME ARRAY ADDRESS IN HEAD EXT F.TRM TERMINATE COMPILE EXT F.TYP TYPE STATEMEXT FLAG EXT F.WRP WRITE STATEMEXT PROCESSOR EXT F.X1 F.A OF F.D1 EXT F.X2 F.A OF F.D2 EXT F.X3 F.A OF F.D3 * * EXT'S WITH A TRAILING '.F' ARE SUBROUTINES * EXT AA.F ASSIGN ADDRESS SUB. EXT AI.F ASSIGN ITEM EXT ASC.F CONVERT TO 4 ASCII DIGITS EXT BNI.F CLEAR NID TO BLANKS EXT BOM.F DISASTOR ERROR REPORT (NO RETURN) EXT CID.F CLEAR F.ID ARRAY EXT CDI.F CLEAR IDI ROUTINE EXT CRP.F CROSS REF PAIR SUB. EXT CRT.F TEST FOR CARRAGE RETURN EXT DAF.F DEFINE (F.AF) EXT DAT.F DEFINE (AT) EXT DIM.F DEFIND (F.IM) EXT DIU.F DEFINE (F.IU) EXT DL.F DEFINE LOCATION SUBROUTINE EXT EJP.F PAGE EJECT SUBROUTINE EXT ER.F ERROR PRINT SUBROUTINE EXT ESC.F ESTABLISH CONSTANT SUBROUTINE EXT ESD.F ESTABLISH DEF SUBROUTINE EXT EXN.F EXAMINE NEXT CHARACTER EXT FA.F FETCH ASSIGNS EXT FID.F FETCH (ID) TO NID (UNPACK) EXT FNS.F FIRST NOT SPEC. STMEXT CHECK EXT FXC.F CHECK IF SUB. IN FIX-EXT TABLE EXT GNA.F GET NEXT SYMBOL TABLE EXTRY EXT GPE.F GENERATE SUB. PROG. EXTRANCE EXT IA.F INPUT (A) CHARACTERS SUBROUTINE EXT I:C.F GET NEXT CHARACTER EXT ICH.F GET NEXT NON BLANK CHAR. AND TYPE IT EXT IDN.F INPUT DO NOT ASSIGN (GET NEXT OPERAND) EXT IDS.F INPUT DIGIT STRING EXT IFT.F IF GOTO COMPLETION EXT II.F INPUT ITEM EXT IIV.F INPUT INTEGER VARABLE EXT IN2.F INIT FOR OA.F MODULE EXT IN3.F INIT FOR ENX.F MODULE EXT IN4.F INIT FOR FA.F MODULE EXT IN5.F INIT FOR EX.F MODULE EXT IN6.F INIT FOR IC.F MODULE EXT IN7.F INIT FOR IDN.F MODULE EXT INM.F INPUT NAME EXT IOP.F INPUT OPERATOR EXT ISN.F INPUT STATEMEXT NUMBER EXT ISY.F INPUT SYMBOL EXT ITS.F INTEGER TEST EXT MCC.F RESET TO FIRST COLUMN OF STATEMEXT EXT MPN.F MOVE PROGRAM NAME (TO NAM RECORD ECT.) EXT NEW.F SUB TO CLEAR TEMPS FOR A NEW MODULE EXT NCT.F TEST FOR NOT A CONSTANT EXT NST.F TEST FOR NOT A SUBROUTINE NAME EXT NTI.F MOVE NID TO F.IDI (PACKS) EXT NWI.F SET F.D0 TO # WORDS IN ARRAY EXT OA.F OUTPUT ASSIGNMEXT TABLE OPERAND EXT OAI.F OUTPUT ABS. INSTRUCTION EXT OC.F OUTPUT CONSTANT EXT ODF.F OUTPUT DOT FUNCTION EXT OLR.F OUTPUT LOAD ADDRESS EXT OMR.F OUTPUT MEMORY REF. INSTRUCTION EXT OS.F OUTPUT SECTOR TO INTERPASS FILE EXT OW.F OUTPUT WORD EXT OZ.F OUTPUT ZREL (OP *+N) EXT PAK.F PACK SUBROUTINE EXT PDF.F PRODUCE DEF SUBROUTINE EXT PSL.F PRINT LINE ON PRINTER EXT PTM.F PROGRAM TERMINATION CODE GEN. EXT RTN.F SUBROUTINE RETURN HANDLER EXT RP.F INPUT ')' EXT SCC.F SAVE F.CC SUBROUTINE EXT SCP.F SAVE CURREXT STATPMEXT POSITION. EXT SKL.F SKIP LINES ON LIST EXT SNC.F START NEXT CARD SUBROUTINE EXT SOA.F STORE AND OUTPUT (OA.F) EXT TDO.F DO TERMINATION CODE GENERATOR EXT TCT.F TEST (A) = F.TC ELSE ER 28 EXT TS.F TAG SUBPROGRAM SUB. EXT TV.F TAG VARIABLE EXT UC.F UNINPUT COLUMN EXT WAR.F ERROR COMMEXT SUBROUTINE (WARNINGS) * * LIBRARY UTILITIES * EXT .MVW MOVE WORDS MACRO EXT IFBRK BREAK CHECK ROUTINE * * * OPSYSTEM INTERFACE: * EXT EOF.C EXT C.SC1 * COMPILER LIB ROUTINES * * * SUP SPC 1 A EQU 0 B EQU 1 SPC 1 C. BSS 0 .TBL EQU 0 SPC 1 DEC 2 OVERLAY # SKP * ***************** * * END PROCESSOR * * ***************** SPC 1 * ASSIGN ADDRESSES TO CONSTANTS * OUTPUT END RECORD FOR LOADER SPC 1 F4.2 ISZ F.END SET THE END FLAG LDB F.LFF LDA K88 88 SZB TRUE BRANCH OF LOGICAL "IF"? JSB ER.F YES. BITCH. * CCA SET UP TO STA F.A FLUSH THE JSB CRP.F FINAL CROSS REFERENCE PAIR LDB F.D LOC OF LAST DO ENTRY IN DO TABLE DTCK1 STB T2STF SAVE DO TABLE PTR CPB F.DO END OF DO TABLE SEARCH? JMP DTCK5 YES. LDA F.LSN IS THIS STATEMENT # A DO TERM? CPA B,I JMP DTCK3 YES. GRIPE. * LDB T2STF OTHERWISE IT IS LDB B,I SURLY UNDEFINED LDA B,I IOR K8 SO SET THE USED FLAG STA B,I SO IT IS REPORTED LATER DTCK2 LDB T2STF COMPUTE ADDRESS OF NEXT ENTRY ADB K5 JMP DTCK1 SPC 1 DTCK3 LDA K30. 30 JSB WAR.F ILLEGAL DO TERMINATOR JMP DTCK2 CONTINUE THE SCAN * DTCK5 LDB F.LSN STB F.A SET F.A INCASE STMT. NUMBER SZB JSB DL.F DEFINE AF=RPL FOR ST# LOC. CCA SET FLAG STA F.CC TO USE SHORT FORM ERROR MESSAGE LDB F.SPF GET CURRENT STMT. LEVEL ADB KM3 TEST IF MORE TfHAN JUST SPECS AND DATA LDA F.SFF IF BLOCK DATA SUBPROGRAM CPA K2 THEN CMB CHANGE SENSE OF TEST SSB IF PROGRAM AND NO EXECUTABLE OR BLOCK DATA WITH JMP ENDP1 THEN GO SEND ERROR * SZB,RSS IF JUST STMT. FUNCTIONS CPA K2 AND NOT BLOCK DATA JMP ENDP0 THEN * LDA K78 BITCH JSB WAR.F ERROR 78: NO EXECUTABLE STMTS ENDP0 CLA,INA JSB SKL.F SKIP TWO LINES LDB F.LSP IF NO PATH ADB F.LSN THEN SET B TO SHOW LDA F.SBF SUBPROGRAM FLAG SET? STA F.A SZA,RSS JMP ENDP8 NO, MAIN; GENERATE STOP CALL * SZB IF NO PATH TO HERE NO RETURN NEEDED JSB RTN.F RETURN HANDLER JSB FA.F FETCH ASSIGNS LDA F.IU LDB F.SFF IS IT A FUNCTION? SZB XOR VAR YES. THIS AREA (64 WORDS) USED FOR XREF BUFFER LDB A LDA K46 SZB JSB WAR.F FUNCTION NAME NOT USED OR JMP ENDP3 SUBROUTINE NAME USED SPC 1 ENDP8 LDA F.SFF IF BLOCK DATA SUBPROGRAM CPA K2 THEN JMP ENDX3 SKIP REST OF THE END STMT. PROCESSING * SZB IF NO PATH TO HERE SKIP TERM CALL JSB PTM.F GEN PROG TERMINATE EXEC CALL ENDP3 LDA F.DP STA F.A F.A=DATA POOL START ADDRESS ENDP4 CLA CLEAR STA IGNOR THE IGNOR SWITCH FOR LABEL GEN. JSB GNA.F GET NEXT F.A SSA,RSS JMP ENDP6 END OF ASSIGNMENT TABLE JSB FA.F FETCH ASSIGNS LDA F.NW # OF WORDS IN ENTRY ADA KM3 -3 SSA JMP ENDP4 1 OR 2-WORD ENTRIES * LDA F.A,I IF NOT USED AND K8 DON'T OUTPUT CMA,CLE,INA SET E IF NOT REFERENCED * LDA F.NT SZA JMP ENDP5 CONSTANT * LDB F.IU IF ARRAY CPB SUB IF SUB JMP ENDP4 THEN IT IS OK * ߇ CPB ARR THEN JMP ENDP4 ALREADY DEFINED * CPA F.IU JMP ENDP9 F.IU=0, STATEMENT # * LDA F.AT IF CPA REL ALREADY DEFINED ISZ IGNOR SET SWITCH SEZ,RSS IF REFERENCED JSB AA.F ASSIGN ADDR TO VARIABLES LDA F.AF GET CURRENT LOAD ADDRESS RAL,CLE,SLA,ERA THEN INA,RSS IT POINTS TO A SYMBOL WITH JMP ENDPI * LDA A,I OFFSET AS THE VALUE LDB F.A GET OFFSET ADB K2 FROM THE ENTRY LDB B,I AND RBL,CLE,ERB CLEAR THE SIGN ADA B PUT FINAL ADDRESS IN A JSB DAF.F DEFINE ADDRESS OF THIS SYMBOL ENDPI LDA F.IM IF CPA ADR ADDRESS RSS SKIP JMP ENDP4 SPC 1 LDA IGNOR IF ADDRESS AND ALREADY DEFINED SZA,RSS NO NOT ALREADY DEFINED JMP ENDP4 FORGET IT * LDA TWPE ELSE DEFINE AS A PGM TMP JSB DIM.F AND CCB GIVE IT ADB TWA A NAME STB TWA LDA F.A ADA K2 STB A,I JMP ENDP4 * K2 DEC 2 K5 DEC 5 KM3 OCT -3 TWA OCT -4000 ADR OCT 70000 K66 DEC 66 K88 DEC 88 T2STF NOP IGNOR NOP K8 DEC 8 K30. DEC 30 K78 DEC 78 K46 DEC 46 REL OCT 1000 AT =1 ARR OCT 600 SUB OCT 200 VAR OCT 400 INT OCT 10000 REA OCT 20000 DIM OCT 6000 AT=6=DIMENSION B20 OCT 20 SPC 1 END00 ADB KM3 IF EXECUTABLE OR STATMENT FUNCTION FOUND SSB THEN ERROR JMP ENDP0 OK CONTINUE * ENDP1 LDA K66 JSB WAR.F PROGRAM/FUNCTION WITHOUT BODY JMP ENDP0 OR BLOCK DATA WITH EXECUTABLE STATEMENTS SPC 1 ENDP5 LDA F.IU CPA VAR RSS JMP ENDP2 GO TEST IF DIM ENTRY * LDA F.AT SEZ,RSS IF NOT REFERENCED OR CPA REL ALREADY DEFINED JMP ENDP4 ALL IS OK ON TO THE NEXT ONE * LDA F.R IF ALREADY DEFINED SZA SKIP JMP ENDP4 REDEFINITION * JSB OLR.F OUTPUT L.A.=RPL LDA F.IM IF F.IM = 0 THEN A DEF SZA,RSS SO JMP END05 PROCESS AS SPECIAL * LDA F.A JSB OTC.F OUTPUT CONSTANT JMP ENDP4 CONTINUE SYMBOL TABLE SCAN. * * ******************************** * * ROUTINE TO OUTPUT A CONSTANT * * ******************************** * OTC.F NOP STA F.A SET THE A.T. ADDRESS JSB FA.F FETCH ASSIGNS LDA F.R HAS THIS CONSTANT ALREADY SZA,RSS BEEN ALLOCATED A LOCATION? JSB DL.F NO SO DO IT NOW LDA F.A,I FLAG IT DONE IOR B20 TO PREVENT STA F.A,I UN NEEDED DUPUPS LDA F.A MOVE THE CONSTANT ADA K2 TO LDB F.DID F.DID JSB .MVW FOR OUTPUT DEF F.D0+0 FOR OUTPUT NOP JSB OC.F SEND IT JMP OTC.F,I RETURN * * * ************************************************* * * ROUTINE TO ESTABLISH A CONSTANT AND OUTPUT IT * * ************************************************* * * * ENTER E=0 FOR REAL, E=1 FOR INT, A,B= VALUE * BIC.F NOP BUILD INTEGER CONSTANT DST F.IDI SET ITS VALUE LDA INT GET THE TYPE SEZ,RSS IF TO BE REAL LDA REA GET TYPE JSB ESC.F ESTABLISH CONSTANT JSB AI.F ASSIGN IT LDA F.A AND JSB OTC.F OUTPUT IT JMP BIC.F,I RETURN A=0,E=1 * * ENDP2 LDA F.AT IF THIS IS A DIM ENTRY CPA DIM THEN SEZ SKIP JMP ENDPE ELSE CONTINUE SEARCH * LDB F.AF SAVE THE ADDRESS OF THE BCOM ENDPF LDA B,I HAS THE BCOMI ENTRY BEEN REFORMATED YET? AND B20 YES IF NON ZERO CMA,CLE,INA PUT RESULT IN E (SET IF NEEDS TO BE REFORMATED LDA B,I SET BIT NOW IOR B20 IN STA B,I ANY CASE INB SET UP ADDRESS STB DAD IN ANY CASE SEZ,RSS WELL? JMP ENDPH YES DO NOT REARRANGE * DLD DAD,I GET THE TWO WORDS SWP SWITCH THEM DST DAD,I AND RESTORE DAD EQU *-1 ENDPH ISZ DAD POINT ADDRESS AT THE RIGHT WORDS LDA F.RPL REFERENCED DIM ENTRY JSB DAF.F MUST BE EMA- TABLE REFERENCE JSB OLR.F DEFINE LOAD ADDRESS (SETS E) LDA F.A SAVE DIM ADDRESS STA T2STF IN TEMP ADA KM1 COMPUTE ADDRESS ADA F.NW LAST DIMENSION ADDRESS STA T1STF AND SAVE IT ALSO LDA F.IM GET THE NUMBER ALF OF DIMENSIONS STA T3STF AND SAVE IT JSB BIC.F SEND FIRST WORD OF THE TABLE LDA T3STF GET DIMENSION COUNT CMA,INA,SZA,RSS SET NEGATIVE JMP ENDPG IF ZERO DIM CASE GO DO OFFSET * STA T3STF AND SET AS COUNTER ENDPB CCA,CCE START LOOP JSB BIC.F BUILD A -1 AND SEND IT ISZ T3STF ONLY ONE DIM.? JMP ENDPC NO GO SEND DIM VALUE. * LDA T2STF GET F.A OF DIM ENTRY ADA K2 INDEX TO F.DAY STA BIC.F SAVE THE ADDRESS LDA A,I SHOULD BE #WORDS PER ELEMENT LDB DAD CACULATE ADDRESS OF BCOMI ENDTRY ADB KM2 AND STB BIC.F,I SET IT IN F.DAY FOR SYMBOL TABLE LIST * * * NOTE WE ARE LOSING THE NO. WORDS/ELEMENT HERE BUT * WE MUST KEEP A POINTER TO THE BCOMI ENTRY SO * THAT THE OFFSET MAY BE PRINTED WITH THE SYMBOL TABLE * LIKE WISE THE POINTER TO THE BCOMI ENTRY SLOT IN * THE DIM ENTRY IS NOW THE LOAD ADDRESS OF THE TABLE * EVEN SO THE S.T. PRINT ROUTINE MUST BE CAREFUL IN * READING THIS INFORMATION AS THE F.AF CAN NOT * BE TRUSTED FOR ARRAYS IN LABELED COMMON. * TO MAKE IT WORST THE ENTRY IS CHANGED ONLY IF * THE ARRAY WAS REFERENCED AT SOME POINT AND THUS * REQUIRED A TABLE ENTRY. * * IS THAT CLEAR? * * JSB BIC.F PUT IT IN THE TABLE ENDPG DLD DAD,I GET THE OFFSET CLE,ERB PACK THE NUMBER RAL,ERA TO A DOUBLE INTEGER (CLEARS E) JSB BIC.F SEND THE DOUBLE WORD LDA T2STF RESTOR STA F.A F.A AND JMP ENDP4 CONTINUE THE SCAN. * BCOMI OCT 7000 * ENDPE CPA BCOMI IF BCOMI ENTRY CLA,SEZ AND REFERENCED JMP ENDP4 (NOPE CONTINUE) * STA F.IM SET TO USE ZERO DIM. LDB F.A GET ADDRESS TO B JMP ENDPF AND GO DO IT * * ENDPC CCA CACULATE DIMENSION ADDRESS ADA T1STF AND STA T1STF SAVE FOR NEXT TIME LDA A,I GET A.T. ADDRESS OF CONSTANT JSB OTC.F AND PRODUCE IT JMP ENDPB GO CONTINUE LOOP * * END05 JSB PDF.F PRODUCE A DEF JMP ENDP4 GO GET NEXT ENTRY SPC 1 ENDP6 LDA F.DP NOW SCANN FOR THE ASCII STRINGS STA F.A THEY WILL HAVE F.AF < 0. ENDX1 JSB GNA.F AND WILL BE EITHER SSA,RSS F.IM=TWPE,,OR 0 (STATEMENT # FOR FORMAT STMT.) JMP ENDX9 END OF TABLE DONE * JSB FA.F FETCH ASSIGNS. LDA F.AT IT WILL HAVE F.AT= CPA REL REL RSS GOOD JMP ENDX1 NOT THIS ONE TRY NEXT * LDA F.IM NOW TEST THE F.IM SZA ZERO OR CPA TWPE A TWO WORD ONE RSS GOOD JMP ENDX1 NO TRY NEXT ONE * LDA F.AF MUST BE <0 FOR WHAT WE WANT CMA,SSA,INA SET POS AND TEST JMP ENDX1 NOT THIS ONE TRY NEXT * ADA F.RPL UPDATE THE PROGRAM SIZE STA T1FBL SAVE IT LDA F.RPL SET JSB DAF.F THE AF FOR THIS GUY LDA T1FBL NOW STA F.RPL PUSH THE LOCATION COUNTER SSA,RSS IF OVERFLOW SKIP JMP ENDX1 TRY NEXT ENTRY * JMP ENDX2 ABORT THE COMPILE * T1FBL NOP T1STF NOP T3STF NOP B1000 OCT 1000 .BAD. DEF .TBL+50 KM1 DEC -1 KM2 DEC -2 * ENDX9 LDB .BAD. LDA F.ERF # OF ERRORS IN COMPILATION SZA JSB ODF.F 'JSB .BAD.' CLA JSB SKL.F YES, SKIP A LINE. ENDX3 LDA F..DP * RESET AF12 TO 0 IN FIX-EXT TBL STA F.A F.A=BASE LOC OF FIX-EXT-TBL SWAP0 JSB GNA.F GET NEXT F.A SSB,RSS IS IT IN FIX TBL?? JMP CRSEC NO. DONE. GO EXIT SEGMENT * LDB F.A ADB K2 LDA B,I (A)=1ST TWO CHARS. AND KK47 =B77577 STA B,I LDA F.CCW IF FOUR DOUBLE IS IN EFFECT AND B1000 THEN SZA,RSS WE MUST JMP SWAP0 (NOPE FORGET IT) * LDA B,I RENAME THE DOUBLE ROUTINES CPA "SN" IF SINGLE LDA ".N" CHANGE TO '.NGLE' STA T2STF SAVE FIRST TWO CHAR. AND C377 ISOLATE HIGH CHAR CPA "D" IS IT A 'D'? LDA "." YES CHANGE TO '.' XOR T2STF MUDLE BACK IN AND C377 THE LOW BYTE XOR T2STF THERE I THINK THAT IS RIGHT STA B,I SET IT BACK IN THE FIX-EXT TABLE JMP SWAP0 * KK47 OCT 77577 C377 BYT 377 T0STF NOP "SN" ASC 1,SN "D" OCT 42000 "." OCT 27000 ".N" ASC 1,.N TWPE OCT 40000 F.IM=4 DUMMY TWO WORD ENTRY * * ENDP9 LDA F.AT CHECK FOR UNDEFINED ITEMS. CPA REL JMP ENDP4 CPA DUM JMP ENDP4 LDA F.A CPA F.SBF JMP ENDPA SUBROUTINE NAME * JSB FID.F UNPACK THE SYMBOL JSB NTI.F NOW PACK IT BACK TO F.IDI LDA F.DNI,I GET FIRST CHAR. CPA K64 STMT # ? CLB,INB,RSS YES. JMP ENDP4 LDA F.DID 'qNLHADB ENDK3 JSB .MVW COPY ASCII STMT # DEF K3 NOP ISZ ER.F LOG AS AN ERROR LDA K32 INVALID STMT. NO. (UNDEFINED) JSB WAR.F SEND THE MESSAGE LDA K10.. LDB ENDK3 "UNDEFINED" JSB PSL.F PRINT OUT UNDEFINED MESSAGE ISZ F.ERF F.ERF=F.ERF+1 JMP ENDP4 SPC 1 K32 DEC 32 * ENDPA LDA VAR JSB DIU.F F.IU=VAR. JSB DL.F DEFINE LOC. LDA F.RPL ADA F.D0 STA F.RPL RPL=F.D0+RPL SSA,RSS JMP ENDP4 ALL OK * ENDX2 LDA K84 RPL OVER FLOW JMP F.ABT ABORT * SPC 2 ENDK3 DEF *+1 ASC 10, UNDEFINED K10.. DEC 10 K3 DEC 3 K36 DEC 36 K64 DEC 64 K84 DEC 84 DUM OCT 5000 SPC 2 SPC 1 * UPDATE THE FOLLOWING WHEN REVISING THE COMPILER: * ENDK5 DEF CMPID CMPID DEC 25 WORDCOUNT OF FOLLOWING TEXT ASC 18, FTN4 COMPILER: HP92060-16092 REV. ASC 7,1805 (780310) * * *------------------------* * * START HERE. * * *------------------------* * CRSEC JSB OS.F OUTPUT THE FINAL SECTOR JSB EOF.C END FILE I- FILE DEF C.SC1 JMP PASSE ERROR SEND 99 ERROR * LDB ENDK5 PRINT THE COMPILER ID LDA B,I NOW INB JSB PSL.F CLA JSB SKL.F SKIP A LINE LDB K5 PASS CONTROL TO SEGMENT 5 TO DO PASS2 JMP F.SEG THERE SHE GOES! * PASSE LDA K99 ERROR ON EOF JMP F.ABT ABORT THE COMPILE * K99 DEC 99 END F4.2 =N  92060-18097 1805 S C0222 FTN4 SEGMENT 3              H0102 $ASMB,Q,C HED ** 16K FTN4 COMPILER (F4/3:SYMBOL TABLE/XREF) ** NAM F4.3,5 92060-16097 771213 REV. 1805 * *************************************** * FORTRAN-4 COMPILER OVERLAY 3 *************************************** * * THIS OVERLAY GENERATES THE SYMBOL TABLE LIST AND CROSS REFERENCE * LISTING FROM THE CREF INFO IN THE INTER PASS FILE * * * * * * *************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * * REPRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * *************************************************************** * * * * * * EXT'S WITH A LEADING 'F.' ARE VARIABLES OR JUMP TARGETS * * THE COLUMN THE EXT STARTS IN DEFINES THE SUBROUTINE IT IS * DEFINED IN AS FOLLOWS * 2 -- OA.F (WRITE PASS FILE ROUTINES) * 3 -- NEX.F (STATEMEXTS THAT DON'T CONTAIN EXPRESSIONS) * 4 -- FA.F (THE ASSIGNMEXT TABLE ROUTINES) * 5 -- EX.F (STATEMEXTS USING THE EXPRESSION EVALUATOR) * 6 -- IC.F (THE CHARACTER INPUT ROUTINES) * 7 -- IDN.F (THE TOKEN INPUT ROUTINES) * 8 -- FTN4 ( THE MAIN) EXT F..DP BASE OF SYMBOL TABLE EXT F..E DIMENSIONS CONSTANT BIT FROM ASSIGNS TABLE EXT F.A ASSIGNMEXT TABLE ADDRESS (CURRENT ENTRY) EXT F.ASS ASSIGNMEXT STATEMEXT PROCESSOR EXT F.ABT ABORT COMPILE EXTRY EXT F.ACC TEMP ACCUMULATOR FLAG EXT F.AF ADDRESS FIELD CURREXT F.A EXT F.ARF NO. OF SUB. FUN. ARGUMEXTS EXT F.ASP ASSIGN STMT. PROCESSOR EXT F.AT ADDRESS TYPE OF CURREXT F.A EXT F.AT. SUBSCRIPT INFO FLAG EXT F.BGN RETURN FROM F4.0 EXT F.BSP BACKSPACE STMT`. PROCESSOR EXT F.BUF A BUFFER EXT F.C OFFSET FOR CURRENT MR INSTRUCTION EXT F.CAL CALL STATEMEXT PROCESSOR EXT F.CC CHARACTER COUNT EXT F.CCW FTN OPTION WORD EXT F.CIN CURREXT CI BUFFER LINE NUMBER EXT F.CLN INPUT ITEM CURREXT LINE # EXT F.CON CONTINUE STMT. PROCESSOR EXT F.CSZ COMMON SIZE EXT F.D DO TABLE POINTER EXT F.D.T ADDRESS OF '.' FUN. TABLE EXT F.D0 ARRAY ELEMEXT SIZE EXT F.D1 DIMENSION 1 EXT F.D2 DIMENSION 2 EXT F.D3 DIMENSION 3 EXT F.DCF DIM, COM FLAG EXT F.DEF DATA EXISTS FLAG EXT F.DID ADDRESS OF F.IDI EXT F.DLF DELIMETER FLAG EXT F.DNB DEF OF NBUF (NAM RECORD) EXT F.DNI ADDRESS OF NID EXT F.DO LWAM - END OF DO TABLE EXT F.DOP DO STATEMEXT PROCESSOR EXT F.DP BASE OF USER SYMBOL TABLE EXT F.DTY IMPLICIT TYPE TABLE EXT F.E EQUIVALENCE TABLE POINTER EXT F.EFG E - FLAG - SET IF SUBSCRIPT IS DUMMY EXT F.EFP ENDFILE STMT. PROCESSOR EXT F.EMA F.A OF EMA EXT ENTRY, WINDOW SIZE EXT F.EMS EMA SIZE DOUBLE WORD, (INTERNAL FORMAT) EXT F.END END FLAG EXT F.EQE EQUVALENCE ERROR FLAG EXT F.EQF EQUIVALENCE FLAG EXT F.ER0 'RX' OF ERRX LIB ERROR ROUTINE EXT F.ERF ERROR FLAG (# OF ER.F CALLS) EXT F.ERN ERROR ARRAY EXT F.EXF EXTERNAL STATEMEXT FLAG EXT F.FMT FORMAT STMT. PROCESSOR EXT F.GOP GO TO STATEMEXT PROCESSOR EXT F.IDI INPUT ARRAY NON-NUMERIC EXT F.IFF IF FLAG EXT F.IFP IF STATEMEXT PROCESSOR EXT F.IM CURREXT ITEM MODE (REAL, COMPLEX,ECT.) EXT F.INT TEMP VARIABLE ARRAY EXT F.IOF INDICATOR FOR I/O INDEX EVALUATOR EXT F.IU CURREXT ITEM USAGE (DUM., RELATIVE, ECT.) Z EXT F.HDL LENGTH OF HEAD MESSAGE EXT F.L # WORDS ON STACK 2 EXT F.LFF LOCICAL IF FLAG EXT F.LLO CURRENT RELOCATAION ADDRESS(TWO WORDS) EXT F.LLT ADDRESS OF LINE LOCATION TABLE (SET BY INIT) EXT F.LO END OF ASSIGNMEXT TABLE+1 EXT F.LOP NO. LINES LEFT ON THIS PAGE. EXT F.LPR ( LOC OF EQUIVALENCE GROUP EXT F.LSF EXPECT FIRST STATEMEXT FLAG EXT F.LSN F.A OF LAST STATEMEXT NUMBER EXT F.LSP LAST OPERATION FLAG EXT F.MFL TYPE STMT. MODE FLAG EXT F.NC NAME CHANGE FLAG. EXT F.NCR NO CROSS REF FLAG EXT F.ND NUMBER OF DIMENSIONS EXT F.NEQ # OF EQUIVALENCE GROUPS EXT F.NT NAME TAG 0= VAR, 1=CONSTANT. EXT F.NTF NAME TAG FLAG EXT F.NW NO. WORDS THIS TABLE F.A EXTRY. EXT F.NXN NO INPUT FLAG EXT F.OFE DATA POOL OVERFLOW ERROR EXTRY. EXT F.OPF OUTPUT PACK FLAG EXT F.R JSB ERR0 FLAG EXT F.PAK PACK BUFFER WORD EXT F.PAP PAUSE STMT. PROCESSOR EXT F.RDP READ STATEMEXT PROCESSOR EXT F.REL SUB. PROG. RETURN LOCATION EXT F.RPL PROGRAM LOCATION COUNTER EXT F.RPR ) LOC OF EQUIVALENCE GROUP EXT F.RTN RETURN STMT. PROCESSOR EXT F.RWP REWIND STMT. PROCESSOR EXT F.S02 RETURN FORM RCOM F.1 EXT F.S03 LOAD F.1 AND PASS CONTROL EXT F.S1B BOTTOM OF STACK 1 EXT F.S1T TOP OF STACK 1 EXT F.S2B BOTTOM OF STACK 2 EXT F.S2T TOP OF STACK 2 EXT F.SBF 0= MAIN, ELSE SUBROUTINE EXT F.SCC SAVE F.CC EXT F.SEE RETURN FROM F4.1 EXT F.SEG LOAD A NEW SEGMENT EXT F.SFF SUBROUTINE/FUNCTION FLAG 0/1 EXT F.SFP STATEMEXT FUNCTION PROCESSOR EXT F.SID STATEMEXT ID PHASE FLAG EXT F.SLF STATEMEXT LEVEL FLAG EXT F.SPF SPECIFICATION FLAG S_ET TO CURREXT STMT. LEVEL EXT F.SPS STATEMEXT PROCESSOR SWITCH EXT F.SRL SAVE RPL AT BEGINNING OF RECORD EXT F.STA FLAG THAT IS ZERO UNTIL THE FTN STATEMEXT IS READ EXT F.STB STRING BACK JUMP FLAG EXT F.STP STOP STMT. PROCESSOR EXT F.STS TO STATEMEXT SCAN EXT F.SVL SAVE # WORDS ON OPER STACK (F.L) EXT F.SXF COMPLEX CONSTANT FLAG EXT F.T # WORDS ON STACK 1 EXT F.TAC ? EXT F.TC NEXT CHARACTER EXT F.TIM TIME ARRAY ADDRESS IN HEAD EXT F.TRM TERMINATE COMPILE EXT F.TYP TYPE STATEMEXT FLAG EXT F.WRP WRITE STATEMEXT PROCESSOR EXT F.X1 F.A OF F.D1 EXT F.X2 F.A OF F.D2 EXT F.X3 F.A OF F.D3 * * EXT'S WITH A TRAILING '.F' ARE SUBROUTINES * EXT AA.F ASSIGN ADDRESS SUB. EXT AI.F ASSIGN ITEM EXT ASC.F CONVERT TO 4 ASCII DIGITS EXT BNI.F CLEAR NID TO BLANKS EXT BOM.F DISASTOR ERROR REPORT (NO RETURN) EXT CID.F CLEAR F.ID ARRAY EXT CDI.F CLEAR IDI ROUTINE EXT CRP.F CROSS REF PAIR SUB. EXT CRT.F TEST FOR CARRAGE RETURN EXT DAF.F DEFINE (F.AF) EXT DAT.F DEFINE (AT) EXT DIM.F DEFIND (F.IM) EXT DIU.F DEFINE (F.IU) EXT DL.F DEFINE LOCATION SUBROUTINE EXT EJP.F PAGE EJECT SUBROUTINE EXT ER.F ERROR PRINT SUBROUTINE EXT ESC.F ESTABLISH CONSTANT SUBROUTINE EXT ESD.F ESTABLISH DEF SUBROUTINE EXT EXN.F EXAMINE NEXT CHARACTER EXT FA.F FETCH ASSIGNS EXT FID.F FETCH (ID) TO NID (UNPACK) EXT FNS.F FIRST NOT SPEC. STMEXT CHECK EXT FXC.F CHECK IF SUB. IN FIX-EXT TABLE EXT GNA.F GET NEXT SYMBOL TABLE EXTRY EXT GPE.F GENERATE SUB. PROG. EXTRANCE EXT IA.F INPUT (A) CHARACTERS SUBROUTINE EXT IC.F GET NEXT CHARACTER EXT ICH.F GET NEXT NON BLANK CHAR. AND TYPE IT EXT IDN.F INPUT DO NOT ASSIGN (GET NEXT OPERAND) EXT IDS.F INPUT DIGIT STRING EXT IFT.F IF GOTO COMPLETION EXT II.F INPUT ITEM EXT IIV.F INPUT INTEGER VARABLE EXT IN2.F INIT FOR OA.F MODULE EXT IN3.F INIT FOR ENX.F MODULE EXT IN4.F INIT FOR FA.F MODULE EXT IN5.F INIT FOR EX.F MODULE EXT IN6.F INIT FOR IC.F MODULE EXT IN7.F INIT FOR IDN.F MODULE EXT INM.F INPUT NAME EXT IOP.F INPUT OPERATOR EXT ISN.F INPUT STATEMEXT NUMBER EXT ISY.F INPUT SYMBOL EXT ITS.F INTEGER TEST EXT MCC.F RESET TO FIRST COLUMN OF STATEMEXT EXT MPN.F MOVE PROGRAM NAME (TO NAM RECORD ECT.) EXT NEW.F SUB TO CLEAR TEMPS FOR A NEW MODULE EXT NCT.F TEST FOR NOT A CONSTANT EXT NST.F TEST FOR NOT A SUBROUTINE NAME EXT NTI.F MOVE NID TO F.IDI (PACKS) EXT NWI.F SET F.D0 TO # WORDS IN ARRAY EXT OA.F OUTPUT ASSIGNMEXT TABLE OPERAND EXT OAI.F OUTPUT ABS. INSTRUCTION EXT OC.F OUTPUT CONSTANT EXT ODF.F OUTPUT DOT FUNCTION EXT OLR.F OUTPUT LOAD ADDRESS EXT OMR.F OUTPUT MEMORY REF. INSTRUCTION EXT OS.F OUTPUT SECTOR TO INTERPASS FILE EXT OW.F OUTPUT WORD EXT OZ.F OUTPUT ZREL (OP *+N) EXT PAK.F PACK SUBROUTINE EXT PDF.F PRODUCE DEF SUBROUTINE EXT PSL.F PRINT LINE ON PRINTER EXT PTM.F PROGRAM TERMINATION CODE GEN. EXT RTN.F SUBROUTINE RETURN HANDLER EXT RP.F INPUT ')' EXT SCC.F SAVE F.CC SUBROUTINE EXT SCP.F SAVE CURREXT STATPMEXT POSITION. EXT SKL.F SKIP LINES ON LIST EXT SNC.F START NEXT CARD SUBROUTINE EXT SOA.F STORE AND OUTPUT (OA.F) EXT TDO.F DO TERMINATION CODE GENERATOR EXTI TCT.F TEST (A) = F.TC ELSE ER 28 EXT TS.F TAG SUBPROGRAM SUB. EXT TV.F TAG VARIABLE EXT UC.F UNINPUT COLUMN EXT WAR.F ERROR COMMEXT SUBROUTINE (WARNINGS) * * * * UTILITY LIBRARY ROUTINES * EXT .MVW EXT IFBRK BREAK CHECK ROUTINE * * OPSYSTEM INTERFACE: EXT RWN.C REWIND FILE ROUTINE EXT RED.C READ FILE ROUTINE EXT C.SC1 SCRATCH FCB * * COMPILER LIBRARY * EXT GMS.C GET MAIN MEMORY BOUNDS SPC 1 SUP A EQU 0 B EQU 1 SPC 1 C. BSS 0 SPC 1 DEC 3 OVERLAY # SKP * **************************************** * * SYMBOL FROM ASS. TBL. TO LIST BUFFER * * **************************************** * STOL NOP B IF ASS. TBL. ADDRESS LDA B,I GET COUNT AND K7 ADA B A IS ADDRESS OF LAST CHAR+1 STA STP SET AS STOP ADB K2 B IS ADDRESS OF FIRST CHARS. LDA STOL,I P+1 IS ADDRESS OF WHERE TO PUT IT STA ASSLC SET IT ISZ STOL STEP TO RETURN ADDRESS JSB STMV MOVE THE SYMBOL JMP STOL,I RETURN * * STMV NOP SYMBOL MOVE B=ADDRESS,STP= STOP ADDRESS STOL1 CPB STP DONE? JMP STMV,I YES EXIT * LDA B,I GET FIRST TWO CHAR. ALF,ALF ROTATE TO JSB PUT.F PUT FIRST OUT FIRST LDA B,I GET NEXT AND B177 ISOLATE CPA B40 IF BLANK JMP STMV,I QUIT NO BLANKS ALLOWED * JSB PUT.F ELSE PUT IT OUT INB STEP B JMP STOL1 GO GET NEXT CHAR. * STP NOP B177 OCT 177 B100 OCT 100 SKP F4.3 BSS 0 BEGIN HERE! LDA F.CCW PRINT TABLE IF T OPTION SET. AND K8 SZA,RSS JMP XREF NO, JUST XREF * JSB EJP.F OLOOP LDA F..DP (OUTER LOOP) STA F.A START OF SYMBOZL TABLE STA SAV.A SAVE AS A FLAG. LOOPI JSB GNA.F GET NEXT SYMBOL TABLE ENTRY. SSA,RSS IF TOP OF S.T. REACHED, JMP LOOPE END OF LOOP THRU ASSIGN. TABLE LDA F.A,I SSA IF ITEM IS MARKED OUT, A CONSTANT JMP LOOPI OR DIM. INFO., SKIP IT. JSB FID.F OTHERWISE, GET SYMBOL ID, TAGS. JSB FA.F LDA F.NW NUMBER OF WORDS FOR ENTRY. CPA K2 IF TWO, JMP LOOP GET NEXT ENTRY. CPA K1 IF ONE, JMP LOOP GET NEXT ENTRY. LDA F.A ADA K2 LDA A,I IF THIS IS A TEMP CELL ENTRY SSA JMP LOOP SKIP IT. LDB F.DNI STB T.DNI LDA B,I FIRST CHAR "@" ? CPA B100 JMP LOP6A YES. STATEMENT # LDA F.IU SZA,RSS IF F.IU = 0, SKIP THIS ITEM JMP LOOP LDB F.AF CPA B200 IF F.IU = SUBROUTINE, SZB OR ADDR FIELD # 0, JMP LOOP0 PROCESS ITEM LDA F.AT CPA DUM OTHERWISE, IF IT IS DUMMY JMP LOOP0 PROCESS ITEM LOOP LDA F.A,I SET NAME TAG OF ITEM TO 1 IOR KK01 TO MARK IT OFF. IT WON'T BE STA F.A,I LOOKED AT AGAIN. JMP LOOPI CONTINUE TO LOOK FOR PRINT ITEM. SPC 1 LOP6A LDA F.AT IF F.AT = 2000, UNDEFINED STMT #. CPA B2000 JMP LOOP SKIP IT LOOP0 LDA SAV.A IF THIS IS FIRST PRINTABLE CPA F..DP TIME FOUND IN A LOOP THRU A.T., JMP LOOPR THEN SET UP AS AN INITIAL SYMBOL LDB BSNID LOOPD LDA B,I CHARACTER FROM SNID CMA,INA ADA T.DNI,I CHARACTER FROM NID SZA,RSS IF 0, JMP LOOPF SAME CHAR, CHECK NEXT ONE. SSA,RSS JMP LOOPI POSITIVE, CURRENT LARGER. LOOPR LDA F.A FOR COMPARISON. STA SAV.A LDA F.DNI THIS IS ALPHABETICALLY THE LDB BSNID LOWEST NAME YET JSB .MVW .MVW TO SAVE AREA J DEF K6 NOP JMP LOOPI SPC 1 LOOPF INB COMPARE NEXT ISZ T.DNI CHARACTER JMP LOOPD * LOOPE LDA SAV.A IF NO ITEM FOUND FOR CPA F..DP PRINTING IN THIS LOOP JMP XREF DONE. TEST TO SEE IF XREF REQUESTED STA F.A SET F.A TO SAV.A JSB FID.F GET SYMBOL ID, TAGS FOR PRINT JSB FA.F LDA F.LOP PRINT A SYMBOL TABLE LINE. INA,SZA,RSS AT BOTTOM OF PAGE? JSB EJP.F YES. FORMFEED LDA F.LOP SZA AT TOP OF PAGE? JMP LOOP5 NO. LDA K7. YES; PRINT HEADER LDB LABLE AND TWO BLANK LINES JSB PSL.F THEN "SYMBOL TABLE" CLA JSB SKL.F THEN A BLANK LINE LDA K31 LDB HEADR JSB PSL.F THEN HEADER CLA,INA JSB SKL.F AND TWO MORE BLANK LINES. LOOP5 JSB CLR1 CLEAR OUT LIST BUFFER SPC 1 * TRANSFER NAME TO LINE. SPC 1 LDB F.A JSB STOL DBL LBUF+1 SPC 1 * TRANSFER ADDRESS TO LINE. SPC 1 LDB F.AF GET ADDRESS LDA F.AT CHECK IF LABELED COMMON CPA BCOM IF SO INB,RSS SKIP TO DO IT JMP ATL1 ELSE JMP * LDA F.IU CHECK IF ARRAY CPA ARR IF SO RSS SKIP JMP ATL0 NOT ARRAY * LDB F.A ARRAY CHECK INB THE DIM ENTRY LDB B,I TO SEE IF IT WAS LDA B,I (GET FIRST WORD OF DIM ENTRY) ADB K2 REFERENCED LDB B,I B HAS F.AF IT ARRAY TABLE WAS BUILT AND K8 ISOLATE REFERENCE BIT SZA IF TABLE BUILT STB F.AF RESET F.AF TO RIGHT VALUE LDB F.AF SET B TO THE PROPER F.AF IF NOT REFERENCED ATL0 LDA F.AF,I CHECK SIZE TO SEE AND K7 IF IT IS AN EMA CPA K4 INFO ENTRY JMP EMAAD IT IS GO FORMAT EMA * INB 4 STEP TO AND LDB B,I GET THE OFFSET ATL1 SSB CMB,INB LDA ADDR2 ADDRESS FIELD OF LINE. STA ASSLC SET LOCATION JSB ASCI5 CONVERT TO ASCII AND STORE. SPC 1 * RELOCATION INDICATOR TO LINE SPC 1 LDA "R" ASSUME PROGRAM RELOCATABLE. LDB F.AT CPB COM. IF COMMON, LDA "C" SET INDICATOR TO 'C'. CPB BCOM IF BCOM EMART LDA B53 USE "+" (RETURN FROM EMAAD) LDB F.IU CPB SUB RSS JMP LOOP1 NOT A SUBPROGRAM * LDB F.AF SSB LDA "X" EXTERNAL SUBPROGRAM. LOOP1 STA USE SAVE USE FOR LATER JSB PUT.F PUT THE CHAR IN THE LINE SPC 1 * TYPE TO LINE SPC 1 LDA IU1 ITEM USAGE = STATEMENT NUMBER? LDB SNID CPB B100 JMP LOOP3 YES, SKIP TYPE AND LOCATION. * LDA IM1 LDB F.IM CPB CPX LDA IM2 CPB INT LDA IM3 CPB LOG LDA IM4 CPB REA LDA IM5 LDB TYPE TYPE FIELD OF LINE JSB .MVW DEF K4 NOP SPC 1 * LOCATION TO LINE SPC 1 LDA LO4 ASSUME 'LOCAL' LDB USE CPB "X" IF EXTERNAL INDICATOR, LDA LO1 CHANGE TO 'EXTERNAL' LDB F.AT CPB COM. IF COMMON, LDA LO2 CHANGE TO 'COMMON' CPB DUM IF DUMMY, LDA LO3 CHANGE TO 'DUMMY'. CPB BCOM IF LABELED COMMON LDA LO5 CHANGE TO 'L COMMON' LDB LOCAT LOCATION FIELD OF LINE JSB .MVW DEF K4 NOP SPC 1 * USAGE TO LINE SPC 1 LDB F.IU CPB SUB RSS JMP LOOP2 NOT SUBPROGRAM * LDA IU2 ASSUME STATEMENT FUNCTION LDB LBUF+8 CPB A.X IF EXTERNAL LDA IU3 CHANGE TO SUBPROGRAM. LDB F.AT CPB DUM OR IF DUMMY, ؔLDA IU3 CHANGE TO SUBPROGRAM. CPB BCOMI IF BCOM INFO ENTRY LDA IU8 CHANGE TO BCOM LABEL JMP LOOP3 SPC 1 EMAAD LDA F.AF,I FORMAT AN EMA ADDRESS TO THE LINE AND B20 CHECK IF WORDS REARRANGED YET CMA,CLE,INA SET E IF NOT LDB F.AF GET ADDRESS OF INFO TABLE LDA B,I SET FLAG TO SHOW IOR B20 THEY ARE STA B,I REARRANGED NOW INB SET ADDRESS OF THE FIRST TWO WORDS STB DAD2 DLD B,I GET THE WORDS SEZ IF OK SWP THEN SKIP SWAP DST DAD2,I SET THE RESULT BACK DAD2 EQU *-1 * ISZ DAD2 STEP TO THE ADDRESS WORDS DLD DAD2,I GET THEM CLE,ERB FORMAT A DOUBLE INTEGER RAL,ERA ASL 6 SET PAGE NUMBER IN B LDA ADDR SET THE ADDRESS STA ASSLC FOR THE ADDRESS JSB ASCI4 THEN TO THE LINE LDA "P" NOW SEND THE 'P' TO INDICATE PAGE JSB PUT.F TO THE LINE LDA B40 AND A BLANK JSB PUT.F LDA DAD2,I GET THE OFFSET AND B1777 ISOLATE THE OFFSET STA B AND JSB ASCI4 SEND IT TO THE LINE JMP EMART GO SEND THE '+' * ASCI4 NOP ROUTINE TO CONVERT 4 OCTAL DIGITS FROM B LDA KM4 TO THE OUT PUT LINE BLF,RBL POSITION FIRST DIGIT IN RBL,RBL LEAST 3 BITS OF B JSB NUM.F CONVERT IT TO THE LINE JMP ASCI4,I RETURN * ARR OCT 600 "C" OCT 103 B53 OCT 53 "+" B1777 OCT 1777 B20 OCT 20 B200 OCT 200 "R" OCT 122 "P" OCT 120 KM4 DEC -4 "X" OCT 130 USE NOP BCOM OCT 3000 BCOMI OCT 7000 K31 DEC 31 * LOOP2 LDA IU4 CPB VAR IF VARIABLE. JMP LOOP3 LDB F.ND NUMBER OF DIMENSIONS CPB K1 LDA IU5 1 DIM CPB K2 LDA IU6 2 DIM CPB K3 LDA IU7 3 DIM LOOP3 LDB@ ULIST - PLIST, THEN * SET PLIST _ F.LO AND ULIST _ F.DO. SPC 1 LDA SIZ0 GET SIZE OF MEMORY POOL ZERO LSR 5 ROUND DOWN TO 32 BIT CHUNCKS LSL 5 AND ADA STM0 ADD THE BASE ADDRESS STA ENDM0 SET THE END ADDRESS JSB GMS.C FIND THE END OF THIS SEGMENT STA STMEM STMEM _ LOW MAIN CCB SET UP THE END OF THIS FREE AREA ADB F..DP AS THE START OF THE ASSIGNMENT TABLE CMA,INA ADA B KEEP EVEN 32 WORD PIECES ONLY LSR 5 LSL 5 ADA STMEM ADDRESS OF WORD AFTER LAST USABLE STA ENDM1 SAVE IT CCB NOW SET UP THE OTHER AREA ADB F.DO LDA F.LO CMA,INA ADA B LSR 5 LSL 5 ADA F.LO STA ENDM2 SET IT UP LDA F..DP SET UP TO CLEAR THE SYMBOL STA F.A TABLE COUNT WORDS (WORD TWO) CLOP JSB GNA.F GET AN ENTRY SSA,RSS IF END OF LIST JMP PAS1 GO READ IN THE XREF PAIRS * SZB,RSS IF FIRST USER ENTRY JMP CLOP GET NEXT ONE * LDA F.A ELSE INA CLB CLEAR THE STB A,I COUNT WORD JMP CLOP AND GO GET THE NEXT ENTRY * PAS1 JSB READ READ A PAIR BUFFER TO MEMORY LDB CREC GET THE CURRENT RECORD ADDRESS PAS11 LDA B,I GET THE A.T. ADDRESS SZA,RSS END OF LIST? JMP PAS2 YES START PASS 2 * INA NO STEP THE COUNT ON THIS ENTRY ISZ A,I ADB K2 STEP B ISZ PCOUN DONE WITH THIS RECORD? JMP PAS11 NO GET NEXT ENTRY * JSB NEXRC SET ADDRESS FOR NEXT RECORD JMP PAS1 READ THE NEXT ONE * SKP * ************************* * * ABORT CROSS REFERENCE * * ************************* SPC 1 *  ************************************** * * RETURN TO FTN4 * * ************************************** SPC 1 RETRN JSB EJP.F TO TOP OF PAGE LDB K4 RETURN TO JMP F.SEG THE INIT SEGMENT FOR NEXT PGM. SPC 2 DEC 23 * NEXTU NOP NEXTP NOP KM64 DEC -64 KM128 DEC -128 KM130 DEC -130 K6 DEC 6 K1 DEC 1 K4 DEC 4 K2 DEC 2 K7 DEC 7 SKP PAS2 JSB NEXRC RESERVE A BUFFER FOR PASS TWO LDA CREC SAVE ITS STA SADD ADDRESS ISZ XFLAG SET PASS TWO FLAG FOR READ ROUTINE LDA F..DP SET ORGION OF SYMBOL TABLE (WILL MOVE) INA STA SUTBL FOR FOLLOWING LOOPS CLA LDA F.S2B STA SYEND ALSO INITIALIZE END OF SYMBOL TABLE PAS22 LDA SUTBL SET TO FIND LOWEST ALF. SYMBOL STA F.A LDA DMAX SET CURRENT SYMBOL JSB SAVE TO MAX POSSIBLE CLA SET THE CURRENT A.T. SAVE POINTER STA NATPT TO SHOW WE DON'T HAVE ONE PAS23 LDB F.A GET CURRENT SYMBOL ADDRESS INB STEP TO ITS COUNT LDA B,I GET THE COUNT SZA,RSS IF NONE JMP PAS26 DON'T LOOK AT IT * LDA F.A SET POINTER STA LSYMB TO LAST SYMBOL WITH A COUNT JSB FID.F SET UP THE SYMBOL FOR COMPARE LDA F.DNI SET UP A DESTROYABLE COPY OF STA T.DNI F.DNI FOR USE AS A POINTER. LDA KM6 SET MAX CHAR COUNT STA SCOUN IN CASE OF EQUAL SYMBOLS LDB BSNID ADDRESS OF SMALLEST SYMBOL. LBL09 LDA B,I A CHARACTER FROM SNID CMA,INA ADA T.DNI,I CHARACTER FROM NID SZA,RSS IF 0, SAME CHARACTER; JMP LBL10 CHECK NEXT ONE. * SSA,RSS JMP PAS26 POSITIVE, CURRENT LARGER. * LDA F.DNI SAVE CURRENT SYMBOL AS JSB SAVE SMALLEST SO FAR. JMP PAS26 GO TEST NEXT SYMBOL * |LBL10 INB COMPARE NEXT CHARACTER ISZ T.DNI ISZ SCOUN SIX CHAR PROCESSED? JMP LBL09 NO TRY NEXT * PAS26 LDA F.A,I COMPUTE ADDRESS OF NEXT SYMBOL AND K7 CURRENT SYMBOL SIZE ADA F.A PLUS CURRENT ADDRESS LDB A,I IF ONE THEN RBL,CLE,ERB (REMOVE POSSIBLE SIGN FROM S.T. LIST) CPB K1 INA STEP ONE MORE LDB NATPT DID WE FIND AN ACTIVE SYMBOL YET? SZB,RSS IF NOT STA SUTBL SET NEW START ADDRESS CPA SYEND END OF TABLE? JMP PAS27 YES WE HAVE THE CURRENT LOW SYMBOL * STA F.A SET THE ADDRESS JMP PAS23 AND GO TEST IT * PAS27 LDA LSYMB,I END OF TABLE SET LAST SYMBOL AND K7 PLUS ONE ADA LSYMB AS THE NEW STOP STA SYEND JMP LBL14 GO PRINT THIS SYMBOL'S USAGE SPC 1 BSNID DEF SNID SCOUN NOP SNID BSS 6 T.DNI NOP TLIST NOP STMEM NOP ENDM1 NOP ENDM2 NOP FREC NOP NATPT NOP SUTBL NOP SYEND NOP LSYMB NOP SADD NOP DMAX DEF *+1 OCT 377,377,377,377,377,377 MAX POSSIBLE SYMBOL SPC 2 SAVE NOP SAVE A NEW MIN SYMBOL LDB BSNID GET THE SAVE ADDRESS TO B JSB .MVW MOVE DEF K6 SIX WORDS NOP LDA F.A SAVE THE CURRENT A.T. ADDRESS STA NATPT ALSO JMP SAVE,I RETURN SKP * ************* * * PHASE TWO * * ************* SPC 1 LBL14 JSB RWN.C REWIND XREF FILE DEF C.SC1 JMP FERR ERROR REPORT AND EXIT * CLA STA NEWCR LINE OF XREF FOR A SYMBOL. LDA NATPT GET A.T. ADDRESS OF SYMBOL SZA,RSS IF NONE THEN DONE JMP RETRN GO RETURN TO START NEXT MODULE * INA POINTS TO F.AF OF NATPT. LDB A,I GET REF COUNT OUT OF F.AF CMB,INB PART OF A.T. ENTRY AND STB COUNT NEGATE FOR COUNTERD CLB CLEAR COUNT IN A.T. STB A,I TO SHOW IT WAS PRINTED (WELL IT WILL BE!) STB REC SET RECORD COUNT TO ZERO LBL15 JSB READ GET NEXT SECTOR OF XREF PAIRS. LDA CREC GET CURRENT RECORD ADDRESS STA NEXTP AND SET IN VARABLE LBL16 LDA NEXTP,I (A)=NEXT A.T. POINTER TO CHECK CPA NATPT IF IT IS THE SAME AS THE CURRENT JMP LBL19 ELEMENT, ADD LINE NO. * ISZ NEXTP POINT TO LBL17 ISZ NEXTP NEXT PAIR IN PLIST. ISZ PCOUN BUMP PAIR COUNT. JMP LBL16 COMPARE AGAINST NEXT PAIR. * LDA NEXTP IF PCOUN=0, ADJUST NEXTP, JSB NEXRC GET NEXT RECORD OF PAIRS JMP LBL15 SPC 1 LBL19 LDA NREFS CPA K8 LINE FULL? JSB PLINE YES. PRINT IT. LDA NREFS REFS ON LINE ALS,ALS *4 ADA XRLOC START OF REFERENCES IN LINE STA RFLOC LOCATION IN LINE OF NEXT REF ISZ NREFS ISZ NEXTP POINT TO LINE NO. IN XREF PAIR LDA NEXTP,I LINE NO. IN BINARY JSB ASC.F CONVERT IT TO ASCII STB RFLOC,I FIRST 2 DIGITS ISZ RFLOC STA RFLOC,I 2ND TWO ISZ COUNT MORE REFS? JMP LBL17 YES. * JSB PLINE PRINT LAST LINE OF XREF LIST JMP PAS22 GO GET THE NEXT SYMBOL SPC 1 NEWCR NOP NXTAT NOP XRLOC DEF LINE+6 RFLOC NOP COUNT NOP K32 DEC 32 K8 DEC 8 STM0 DEF F4.3 START OF MEMORY POOL 0 ENDM0 DEF PAS1 END OF POOL 0 (REFINED BY CODE) CREC DEF F4.3 INITIAL FIRST BUFFER FRLOC DEF F4.3 AND FIRST RECORD SIZ0 ABS PAS1-F4.3 MAX SIZE OF POOL 0 * UPADD NOP COMPUTE NEXT ADDRESS IN CIRCULAR BUFFER LDA CREC GET CURRENT ADDRESS ADA K32 ADD BLOCK SIZE CPA ENDM0 END OF BLOCK ZERO? LDA STMEM YES START BLOCK 1 CPA ENDM1 END OF FIRST POOL? LDA F.LO YES SWITH TO NEXT POOL CPA ENDM2 END OF SECOND POoOL? LDA STM0 YES SET TO FIRST POOL JMP UPADD,I RETURN * * NEXRC NOP COMPUTE ADDRESS OF NEXT RECORD AND JSB UPADD KEEP TRACK OF OVERLAYS STA CREC SET NEW ADDRESS CPA STM0 OVER LAY ? ISZ OVER YES LDB OVER WERE THERE ANY OVER LAYS? SZB,RSS WELL? JMP NEXRC,I NO ALL IS WELL * LDB XFLAG PASS TWO? SZB WELL? JMP NEXRC,I YES ALL IS WELL ANY WAY * ISZ FREC STEP THE RECORD NUMBER OF THE FIRST RECORD IN JSB UPADD THE POOL AND GET ITS ADDRESS STA FRLOC SET ADDRESS IN ITS LOCATION. JMP NEXRC,I NOW ALL IS WELL * * SPC 2 * ************** * * PRINT LINE * * ************** SPC 1 PLINE NOP LDA NEWCR IF NEWCR=0, THIS IS THE FIRST SZA LINE FOR A NEW SYMBOL; JMP PL01 * LDB BSNID THEN PACK 2 CHARACTERS PER LDA B,I WORD AND TRANSFER NAME TO FIRST ALF,ALF THREE WORDS OF LINE BUFFER. INB IOR B,I STA LINE+1 INB LDA B,I ALF,ALF INB IOR B,I STA LINE+2 INB LDA B,I ALF,ALF INB IOR B,I STA LINE+3 SYMBOL NOW TRANSFERRED TO LINE. CLA JSB SKL.F SKIP A LINE. PL01 LDA F.LOP INA,SZA,RSS AT BOTTOM OF PAGE? JSB EJP.F YES. FORMFEED LDA F.LOP SZA AT TOP OF PAGE? JMP PL01B NO. * LDA K11 PRINT HEADER AND TWO BLANK LINES LDB LABLX "CROSS REFERENCE LIST" JSB PSL.F OUTPUT LINE CLA JSB SKL.F SKIP A LINE LDA K11 LDB HEADX "SYMBOL REFERENCES" JSB PSL.F OUTPUT LINE CLA,INA JSB SKL.F SKIP 2 LINES PL01B LDA NREFS COMPUTE LENGTH OF PORTION OF ALS,ALS LINE BUFFER TO BE PRINTED (ONLY ADA K5 OUހT TO END OF CROSS-REF INFO.) LDB BLINE JSB PSL.F PRINT THE LINE CLA SET NUMBER OF REFS IN LINE STA NREFS TO 0. LDA NEWCR NEW SYMBOL? SZA JMP PLINE,I YES. * LDA BLNKS NO; BLANK IT SO IT WON'T STA LINE+1 BE PRINTED AGAIN. STA LINE+2 STA LINE+3 STA NEWCR JMP PLINE,I SPC 1 K5 DEC 5 BLINE DEF LINE ADDRESS OF LINE BUFFER SPC 2 * LINE SET-UP: SPC 1 * 2 BLANKS (LINE PRINTER ONLY) * 6 CHAR NAME (FIRST LINE FOR SYMBOL) OR 6 BLANKS (OTHER LINES) * 4 BLANKS AND 4 DIGIT REFERENCE (REPEATED UP TO 8 TIMES) SPC 1 * MAX # CHARS/LINE: 70(TTY), 72(LINE PRINTER) SPC 1 * LINE IS INITIALIZED TO 72 BLANKS SPC 1 LINE ASC 18, ASC 18, ASC 18, ASC 18, BLNKS EQU LINE NREFS NOP MUST BE 0 INITIALLY SPC 1 LABLX DEF *+1 ASC 11, CROSS-REFERENCE LIST HEADX DEF *+1 ASC 11, SYMBOL REFERENCES K11 DEC 11 SKP * **************************************** * * READ CROSS REFERENCE PAIRS FROM DISC * * **************************************** SPC 1 * ON ENTRY, THE FOLLOWING VARIABLES ARE SET UP: SPC 1 * NEXTP = NEXT PAIR LOCATION. THE 64 WORD SECTOR * IS READ INTO THIS AREA OF THE LIST OF * CROSS REFERENCE PAIRS. THE 64 WORDS * WILL TAKE UP THE AREA ADDRESSED BY * NEXTP+0 TO NEXTP+63. AT LEAST 128 WORDS MUST * REMAIN BETWEEN PLIST AND NEXTU, THE * LOCATION OF THE NEXT UNIQUE ASSIGNMENT * TABLE POINTER IN THE LIST OF THOSE POINTERS. * IF NOT, A MESSAGE IS PRINTED ELSEWHERE IN * THIS SEGMENT AND THE CROSS REF. IS ABORTED. SPC 1 * NOTE: SPC 1 * THIS ROUTINE IS USED IN BOTH PHASES OF THIS SEGMENT. * IN PHASE 1, WHEN THE LIST OF UNIQUE ASSIGNMENT * TABLE POINTERS IhS BEING CONSTRUCTED (XFLAG=0), * THE SECTOR IS ALWAYS READ FROM THE DISC. IN PHASE 2, * WHEN THE CROSS REFERENCE LIST IS BEING PRINTED (XFLAG#0), * THE SECTOR IS READ ONLY IF IT IS NOT ALREADY IN CORE. * THE SECTOR IS NOT IN CORE WHEN NEXTP = OVLAY. OVLAY * IS THE ADDRESS WHERE THE SECTOR OVERLAY AREA BEGINS. SPC 1 * ON EXIT, THE FOLLOWING VARIABLES ARE SET UP: SPC 1 * PCOUN = PAIR COUNT. THIS IS THE NUMBER OF CROSS * REFERENCE PAIRS IN THE SECTOR. IT IS SET * NEGATIVE FOR LATER USE AS A COUNTER. PCOUN * ALWAYS HAS A VALUE OF -32. SPC 1 * WCOUN = WORD COUNT. THIS IS A COUNT OF THE NUMBER * OF WORDS THAT NEXTP MUST BE ADJUSTED BEFORE * THIS ROUTINE IS CALLED THE NEXT TIME. USUALLY * WCOUN IS SET TO 0. HOWEVER, WCOUN IS SET * NON-ZERO IF: SPC 1 * WCOUN = -64 IF THE SECTOR READ OVERLAYED A * PREVIOUS SECTOR. SPC 2 READ NOP JSB IFBRK CHECK FOR BREAK DEF *+1 SSA WELL? JMP BREAK * LDA XFLAG IF THIS FLAG IS 0, THE UNIQUE SZA,RSS A.T. POINTER IS BEING BUILT JMP READ1 IN PHASE 2. MUST READ SECTOR; * LDA FREC IN PASS TWO IF RECORD IS CMA,INA BELOW ONE IN ONE OF THE ADA REC BUFFERS SSA THEN JMP READ0 GO READ IT * SZA IT IS IN MEMORY JMP READ3 IF NOT FIRST ACCESS JUST GO SET IT UP * LDA FRLOC FIRST REC FROM MEM BUFFER STA CREC SET IT'S ADDRESS JMP READ3 GO DO IT * READ0 LDA SADD USE THE SAVED ADDRESS FOR PASS TWO STA CREC READS * READ1 CCB GET THE BUFFER ADDRESS ADB CREC LESS ONE STB BUFA AND SET AS THE READ ADDRESS LDA B,I GET THE WORD TO BE OVERLAYED AND STA SAV SAVE IT READ2 CLA SET TOB@< SAVE THE AREA JSB RED.C READ A LINE DEF C.SC1 OF SCRATCH BUFA DEF * CONFIGURED ABOVE DEF K33 TOTAL SIZE IS 33 (32+FLAG) JMP FERR READ ERROR GO ABORT * SSB IF EOF JMP EOF GO SET UP * LDA BUFA,I GET THE FLAG WORD CPA KM2 IF NOT AN XREF RECORD RSS JMP READ2 GO READ ANOTHER RECORD * READ4 LDA SAV RESTOR THE SAVED WORD STA BUFA,I AND READ3 LDA KM16 A FULL SECTOR WAS READ. STA PCOUN PCOUN=-16 INDICATES 16 PAIRS ISZ REC STEP THE RECORD COUNT JMP READ,I SPC 1 EOF CLA SET EOF FLAG STA CREC,I AND GO JMP READ4 RETURN * FERR LDA K98 PASS FILE READ ERROR JMP F.ABT * BREAK LDA K96 GET BREAK ERROR JMP F.ABT AND GO ABORT * K96 DEC 96 XFLAG NOP MUST BE 0 INITIALLY. K98 DEC 98 OVER NOP MUST BE 0 INITIALLY. REC NOP PCOUN NOP WCOUN NOP KM2 DEC -2 K33 DEC 33 KM16 DEC -16 SAV BSS 1 KM32 DEC -32 ORG * END F4.3 B  92060-18098 1805 S C0222 FTN4 SEGMENT 4              H0102 %ASMB,Q,C HED ** FTN4 COMPILER (SEG: F4.4) INITIALIZE THE COMPILER ** NAM F4.4,5 92060-16098 780203 REV. 1805 * ***************************************** * FORTRAN-4 COMPILER OVERLAY 4 ***************************************** * * THIS OVERLAY SETS UP THE SYMBOL TABLE AND ENTERS THE FIXED ENTRIES * IT ALSO INITIALIZES THE COMPILER AND READS THE FTN STATEMENT IF * SETTING UP FOR THE FIRST MODULE IN THIS COMPILE. * * * * *************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * * REPRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * *************************************************************** * * * * * * EXT'S WITH A LEADING 'F.' ARE VARIABLES OR JUMP TARGETS * * THE COLUMN THE EXT STARTS IN DEFINES THE SUBROUTINE IT IS * DEFINED IN AS FOLLOWS * 2 -- OA.F (WRITE PASS FILE ROUTINES) * 3 -- NEX.F (STATEMEXTS THAT DON'T CONTAIN EXPRESSIONS) * 4 -- FA.F (THE ASSIGNMEXT TABLE ROUTINES) * 5 -- EX.F (STATEMEXTS USING THE EXPRESSION EVALUATOR) * 6 -- IC.F (THE CHARACTER INPUT ROUTINES) * 7 -- IDN.F (THE TOKEN INPUT ROUTINES) * 8 -- FTN4 ( THE MAIN) EXT F..DP BASE OF SYMBOL TABLE EXT F..E DIMENSIONS CONSTANT BIT FROM ASSIGNS TABLE EXT F.A ASSIGNMEXT TABLE ADDRESS (CURRENT ENTRY) EXT F.ASS ASSIGNMEXT STATEMEXT PROCESSOR EXT F.ABT ABORT COMPILE EXTRY EXT F.ACC TEMP ACCUMULATOR FLAG EXT F.AF ADDRESS FIELD CURREXT F.A EXT F.ARF NO. OF SUB. FUN. ARGUMEXTS EXT F.ASP ASSIGN STMT. PROCESSOR EXT F.AT ADDRESS TYPE OF CURREXT F.A EXT F.AT. SUBSCRIPT INFO F3LAG EXT F.BGN RETURN FROM F4.0 EXT F.BSP BACKSPACE STMT. PROCESSOR EXT F.BUF A BUFFER EXT F.C OFFSET FOR CURRENT MR INSTRUCTION EXT F.CAL CALL STATEMEXT PROCESSOR EXT F.CC CHARACTER COUNT EXT F.CCW FTN OPTION WORD EXT F.CIN CURREXT CI BUFFER LINE NUMBER EXT F.CLN INPUT ITEM CURREXT LINE # EXT F.CON CONTINUE STMT. PROCESSOR EXT F.CSZ COMMON SIZE EXT F.D DO TABLE POINTER EXT F.D.T ADDRESS OF '.' FUN. TABLE EXT F.D0 ARRAY ELEMEXT SIZE EXT F.D1 DIMENSION 1 EXT F.D2 DIMENSION 2 EXT F.D3 DIMENSION 3 EXT F.DCF DIM, COM FLAG EXT F.DEF DATA EXISTS FLAG EXT F.DID ADDRESS OF F.IDI EXT F.DLF DELIMETER FLAG EXT F.DNB DEF OF NBUF (NAM RECORD) EXT F.DNI ADDRESS OF NID EXT F.DO LWAM - END OF DO TABLE EXT F.DOP DO STATEMEXT PROCESSOR EXT F.DP BASE OF USER SYMBOL TABLE EXT F.DTY IMPLICIT TYPE TABLE EXT F.E EQUIVALENCE TABLE POINTER EXT F.EFG E - FLAG - SET IF SUBSCRIPT IS DUMMY EXT F.EFP ENDFILE STMT. PROCESSOR EXT F.EMA F.A OF EMA EXT ENTRY, WINDOW SIZE EXT F.EMS EMA SIZE DOUBLE WORD, (INTERNAL FORMAT) EXT F.END END FLAG EXT F.EQE EQUVALENCE ERROR FLAG EXT F.EQF EQUIVALENCE FLAG EXT F.ER0 'RX' OF ERRX LIB ERROR ROUTINE EXT F.ERF ERROR FLAG (# OF ER.F CALLS) EXT F.ERN ERROR ARRAY EXT F.EXF EXTERNAL STATEMEXT FLAG EXT F.FMT FORMAT STMT. PROCESSOR EXT F.GOP GO TO STATEMEXT PROCESSOR EXT F.IDI INPUT ARRAY NON-NUMERIC EXT F.IFF IF FLAG EXT F.IFP IF STATEMEXT PROCESSOR EXT F.IM CURREXT ITEM MODE (REAL, COMPLEX,ECT.) EXT F.INT TEMP VARIABLE ARRAY EXT F.IOF INDICATOR FOR I/O INDEX EVpSALUATOR EXT F.IU CURREXT ITEM USAGE (DUM., RELATIVE, ECT.) EXT F.HDL LENGTH OF HEAD MESSAGE EXT F.L # WORDS ON STACK 2 EXT F.LFF LOCICAL IF FLAG EXT F.LLO CURRENT RELOCATAION ADDRESS(TWO WORDS) EXT F.LLT ADDRESS OF LINE LOCATION TABLE (SET BY INIT) EXT F.LO END OF ASSIGNMEXT TABLE+1 EXT F.LOP NO. LINES LEFT ON THIS PAGE. EXT F.LPR ( LOC OF EQUIVALENCE GROUP EXT F.LSF EXPECT FIRST STATEMEXT FLAG EXT F.LSN F.A OF LAST STATEMEXT NUMBER EXT F.LSP LAST OPERATION FLAG EXT F.MFL TYPE STMT. MODE FLAG EXT F.NC NAME CHANGE FLAG. EXT F.NCR NO CROSS REF FLAG EXT F.ND NUMBER OF DIMENSIONS EXT F.NEQ # OF EQUIVALENCE GROUPS EXT F.NT NAME TAG 0= VAR, 1=CONSTANT. EXT F.NTF NAME TAG FLAG EXT F.NW NO. WORDS THIS TABLE F.A EXTRY. EXT F.NXN NO INPUT FLAG EXT F.OFE DATA POOL OVERFLOW ERROR EXTRY. EXT F.OPF OUTPUT PACK FLAG EXT F.R JSB ERR0 FLAG EXT F.PAK PACK BUFFER WORD EXT F.PAP PAUSE STMT. PROCESSOR EXT F.RDP READ STATEMEXT PROCESSOR EXT F.REL SUB. PROG. RETURN LOCATION EXT F.RPL PROGRAM LOCATION COUNTER EXT F.RPR ) LOC OF EQUIVALENCE GROUP EXT F.RTN RETURN STMT. PROCESSOR EXT F.RWP REWIND STMT. PROCESSOR EXT F.S02 RETURN FORM RCOM F.1 EXT F.S03 LOAD F.1 AND PASS CONTROL EXT F.S1B BOTTOM OF STACK 1 EXT F.S1T TOP OF STACK 1 EXT F.S2B BOTTOM OF STACK 2 EXT F.S2T TOP OF STACK 2 EXT F.SBF 0= MAIN, ELSE SUBROUTINE EXT F.SCC SAVE F.CC EXT F.SEE RETURN FROM F4.1 EXT F.SEG LOAD A NEW SEGMENT EXT F.SFF SUBROUTINE/FUNCTION FLAG 0/1 EXT F.SFP STATEMEXT FUNCTION PROCESSOR EXT F.SID STATEMEXT ID PHASE FLAG Y EXT F.SLF STATEMEXT LEVEL FLAG EXT F.SPF SPECIFICATION FLAG SET TO CURREXT STMT. LEVEL EXT F.SPS STATEMEXT PROCESSOR SWITCH EXT F.SRL SAVE RPL AT BEGINNING OF RECORD EXT F.STA FLAG THAT IS ZERO UNTIL THE FTN STATEMEXT IS READ EXT F.STB STRING BACK JUMP FLAG EXT F.STP STOP STMT. PROCESSOR EXT F.STS TO STATEMEXT SCAN EXT F.SVL SAVE # WORDS ON OPER STACK (F.L) EXT F.SXF COMPLEX CONSTANT FLAG EXT F.T # WORDS ON STACK 1 EXT F.TAC ? EXT F.TC NEXT CHARACTER EXT F.TIM TIME ARRAY ADDRESS IN HEAD EXT F.TRM TERMINATE COMPILE EXT F.TYP TYPE STATEMEXT FLAG EXT F.WRP WRITE STATEMEXT PROCESSOR EXT F.X1 F.A OF F.D1 EXT F.X2 F.A OF F.D2 EXT F.X3 F.A OF F.D3 * * EXT'S WITH A TRAILING '.F' ARE SUBROUTINES * EXT AA.F ASSIGN ADDRESS SUB. EXT AI.F ASSIGN ITEM EXT ASC.F CONVERT TO 4 ASCII DIGITS EXT BNI.F CLEAR NID TO BLANKS EXT BOM.F DISASTOR ERROR REPORT (NO RETURN) EXT CID.F CLEAR F.ID ARRAY EXT CDI.F CLEAR IDI ROUTINE EXT CRP.F CROSS REF PAIR SUB. EXT CRT.F TEST FOR CARRAGE RETURN EXT DAF.F DEFINE (F.AF) EXT DAT.F DEFINE (AT) EXT DIM.F DEFIND (F.IM) EXT DIU.F DEFINE (F.IU) EXT DL.F DEFINE LOCATION SUBROUTINE EXT EJP.F PAGE EJECT SUBROUTINE EXT ER.F ERROR PRINT SUBROUTINE EXT ESC.F ESTABLISH CONSTANT SUBROUTINE EXT ESD.F ESTABLISH DEF SUBROUTINE EXT EXN.F EXAMINE NEXT CHARACTER EXT FA.F FETCH ASSIGNS EXT FID.F FETCH (ID) TO NID (UNPACK) EXT FNS.F FIRST NOT SPEC. STMEXT CHECK EXT FXC.F CHECK IF SUB. IN FIX-EXT TABLE EXT GNA.F GET NEXT SYMBOL TABLE EXTRY EXT GPE.F GENERATE SUB. PROG. EXTRANCE EXXT IA.F INPUT (A) CHARACTERS SUBROUTINE EXT IC.F GET NEXT CHARACTER EXT ICH.F GET NEXT NON BLANK CHAR. AND TYPE IT EXT IDN.F INPUT DO NOT ASSIGN (GET NEXT OPERAND) EXT IDS.F INPUT DIGIT STRING EXT IFT.F IF GOTO COMPLETION EXT II.F INPUT ITEM EXT IIV.F INPUT INTEGER VARABLE EXT IN2.F INIT FOR OA.F MODULE EXT IN3.F INIT FOR ENX.F MODULE EXT IN4.F INIT FOR FA.F MODULE EXT IN5.F INIT FOR EX.F MODULE EXT IN6.F INIT FOR IC.F MODULE EXT IN7.F INIT FOR IDN.F MODULE EXT INM.F INPUT NAME EXT IOP.F INPUT OPERATOR EXT ISN.F INPUT STATEMEXT NUMBER EXT ISY.F INPUT SYMBOL EXT ITS.F INTEGER TEST EXT MCC.F RESET TO FIRST COLUMN OF STATEMEXT EXT MPN.F MOVE PROGRAM NAME (TO NAM RECORD ECT.) EXT NEW.F SUB TO CLEAR TEMPS FOR A NEW MODULE EXT NCT.F TEST FOR NOT A CONSTANT EXT NST.F TEST FOR NOT A SUBROUTINE NAME EXT NTI.F MOVE NID TO F.IDI (PACKS) EXT NWI.F SET F.D0 TO # WORDS IN ARRAY EXT OA.F OUTPUT ASSIGNMEXT TABLE OPERAND EXT OAI.F OUTPUT ABS. INSTRUCTION EXT OC.F OUTPUT CONSTANT EXT ODF.F OUTPUT DOT FUNCTION EXT OLR.F OUTPUT LOAD ADDRESS EXT OMR.F OUTPUT MEMORY REF. INSTRUCTION EXT OS.F OUTPUT SECTOR TO INTERPASS FILE EXT OW.F OUTPUT WORD EXT OZ.F OUTPUT ZREL (OP *+N) EXT PAK.F PACK SUBROUTINE EXT PDF.F PRODUCE DEF SUBROUTINE EXT PSL.F PRINT LINE ON PRINTER EXT PTM.F PROGRAM TERMINATION CODE GEN. EXT RTN.F SUBROUTINE RETURN HANDLER EXT RP.F INPUT ')' EXT SCC.F SAVE F.CC SUBROUTINE EXT SCP.F SAVE CURREXT STATPMEXT POSITION. EXT SKL.F SKIP LINES ON LIST EXT SNC.F START NEXT CARD SUBROUTINE EXT SOA.F STORE AND OUTPUT (OA.F) EXT TDO.F DO TERMINATION CODE GENERATOR EXT TCT.F TEST (A) = F.TC ELSE ER 28 EXT TS.F TAG SUBPROGRAM SUB. EXT TV.F TAG VARIABLE EXT UC.F UNINPUT COLUMN EXT WAR.F ERROR COMMEXT SUBROUTINE (WARNINGS) * * COMPILER LIBRARY ENTS * EXT SUP.C COMP LIB SUPER EXT C.BIN BINARY FCB EXT RWN.C REWIND ROUTINE EXT C.SAU INPUT FCB EXT OPN.C OPEN ROUTINE EXT EOF.C EOF WRITE ROUTINE EXT END.C END ROUTINE EXT C.LST LIST FCB EXT GMM.C GET MAIN MEMORY EXT END.C TERMINATE EXT PRM.C GET PRAMETER EXT C.SC1 SCRATCH FILE FCB EXT C.SC0 SCRATCH FILE FCB EXT C.TTY TTY FCB EXT WRT.C WRITE TO FCB ROUTINE * * FTN UNIQUE SUB * EXT SEG.F GET SEGMENT ID SUB * * LIBRARY ROUTINES * * EXT .MVW MOVE WORDS MACRO * A EQU 0 B EQU 1 K4 DEC 4 SEGMENT NUMBER SUP * * WE BEGIN ************* * BEGIN LDB F.STA THE COMPILER LIB. FIRST ENTRY? CCA SET F.CC TO NOT PRINT STA F.CC CARD ON ERROR SZB F.STA =0 IF FIRST JMP NEW NO JUST A NEW MODULE * STB BOM.F CLEAR THE DISASTER FLAG LDA DFTM MAKE SURE THE DEF RAL,CLE,SLA,ERA IS DIRECT LDA A,I STA DFTM DLD F.IDI RESTORE THE REG'S AND JSB SUP.C CALL THE COMP LIB SUPER DFTM DEF F.TIM ADDRESS OF TIME ARRAY NOP ADB K10 ADD LENGTH OF PREAMBLE TO TIME LENGTH STB F.HDL SET HEAD LENGTH FOR MAIN * LDA PRMPT GET PROMPT CHAR. ']' JSB OPN.C OPEN THE INPUT FILE DEF C.SAU LIST FCB JMP INERR OPEN TRM * JSB OPN.C OPEN THE LIST DEVICE DEF C.LST JMP TRML IF ERROR JUST EXIT UNL IFN LST JSB PR=M.C DEF K4 STA DBLU SZA,RSS JMP XDBUG ADA N35 SSA,RSS JMP XDBUG JSB DBUG EXT DBUG DEF *+2 DEF DBLU * XDBUG EQU * XIF LST CLB WANT A RELOCATABLE JSB OPN.C OPEN THE BINARY OUTPUT FILE DEF C.BIN JMP BERR * BERX JSB OPN.C OPEN THE SCRATCH FILE DEF C.SC1 JMP ERROR * JSB OPN.C OPEN THE CARD FILE DEF C.SC0 JMP ERROR * CCB NEW SSB,RSS IF TERMINATE CALL JMP TRM GO TO TERM CODE * JSB GMM.C GET MAIN MENORY BOUNDS DEF K6 SIX SEGMENTS (NOW) DEF LSE.F NAME OF LOCAL SEG. NAME FINDER * STB F.DO SET TOP OF SYMBOL TABLE STA F.CRB SET ADDRESS OF CARD BUFFER JSB GMM.C NOW GET THE END OF SEGMENT 2 (IT DEF K1 DOESN'T USE THE CARD BUFFER) DEF LS2.F ROUTINE TO GET NAME OF SEGMENT 2 ONLY STA L..DP TENATIVE BASE OF SYMBOL TABLE LDB F.CRB SEE IF CARD ADB K90 BUFFER EXTENDS BEYOND CMA,INA IT ADA B IF SO SSA,RSS SET STB L..DP NEW BASE OF SYMBOL TABLE ABOVE THE CARD BUFFER LDA L..DP ADA LFIX CACULATE START OF USER TABLE ADA N1 STA L.DP USER DATA POOL CMA MAKE SURE THERE IS ROOM ADA F.DO IF NEGATIVE RESULT THEN NO ROOM FOR FIX-EXT SSA TABLE SO QUIT ON SYMBOL TABLE OVERFLOW JMP ERR3 THERE IS ROOM * LDA DK4 GET THE SIZE OF THIS SEGMENT STA DSNO AND JSB GMM.C DEF K1 DEF LS2.F STA T1 SAVE IT ADA LFIX CHECK IF ROOM ABOVE ADA K8 FOR FIX-EXT-TBL ADA K90 KEEP ROOM FOR CARD BUFFER TOO CMA ADA F.DO SSA IF NO ROOM JMP ERR3 ABORT * LDB F.DO SET UP TO MOVE Ѣ ADB KM8 FIX-EXT-TBL ADB MLFIX TO HIGH MEMORY STB F..DP ADB LFIX SET USER BASE FOR THIS LOCATION ADA N1 STA F.DP FOR NOW SEG F4.0 MOVES IT DOWN LDA F..DP SET ADA KM90 CARD BUFFER STA F.CRB LOCATION CLB NOW CLEAR THE CARD BUFFER STB A,I PLANT A ZERO INB AND ADB A JSB .MVW WATCH IT GROW DEF K90 (IT SLOPS OVER BY ONE BUT NOP WE DON'T HAVE THE FIX-EXT-TABLE THERE YET LDA F.CRB NOW PLANT THE REQUIRED BLANKS ADA K2 FOR BETWEEN THE LINE NUMBER LDB BLNK STB A,I ADA K45 DO FOR BOTH BUFFERS STB A,I JMP NEWMD GO FINISH UP * ERR3 LDA K3 03 SYMBOL TABLE OVERFLOW EREX JMP ABT REPORT ERROR AND EXIT * K2 DEC 2 T1 NOP MLFIX ABS DFIX+1-LFIX NEGATIVE OF FIX-EXT TBL LENGTH L..DP NOP L.DP NOP DK4 DEF K4 UNL IFN LST DBLU NOP XIF LST K3 DEC 3 K6 DEC 6 K10 DEC 10 K5 DEC 5 N1 DEC -1 RSAVE NOP NOLIN NOP NUMBER OF LINES/PAGE K90 DEC 90 KM90 DEC -90 KM8 DEC -8 K45 DEC 45 * NEWMD JSB NEW.F GO TO MAIN TO INITIALIZE DLD F.ERN+1 GET THE ERROR SUM ADA F.ERF ADD TOTALS FOR THIS MODULE ADB F.ERF+1 DST F.ERN+1 CLA CLEAR THE COUNTERS FOR CLB THE NEW MODULE DST F.ERF CLA LDB F.CRB SET TOP OF BUFFER ADDRESS FOR DST F.LLT SET EQUV LINE LOCATION TABLE JSB RWN.C REWIND THE SCRATCH FILE DEF C.SC1 JMP ERROR OPEN ERROR LDA F.STA GET STATUS FLAG SZA IF NOT FIRST MODULE JMP NOFTN SKIP READING THE FTN STATEMENT * JSB PRM.C GET THE NO LINES/PAGE DEF K4 SZA,RSS IF ZERO LDA K55 USE 55 LINES/ PAGE INA COMPENSATEj FOR CALCULATION METHOD STA NOLIN GET NUMBER TO A FOR INITIALIZE ADA KN10 IF LESS THAN CLB,CCE TEN SSA STB NOLIN USE INFINITE SIZE PAGE * JSB INIT INITIALIZE ALL THE FLAGS * * READ "FTN/FTN4,B,L,A/M,T" * * * ********************* * * COMPILER ENTRANCE * * ********************* SPC 1 * WHERE IN WE BUILD THE OPTION CONTROL WORD FROM THE 'FTN' CONTROL * STATEMENT. * * THE FORMAT OF THE WORD IS (ONE BIT PER LETTER LEAST BIT IS ZERO): * * Y EFD BCT AML * * Y = USE 64 BIT DOUBLE PRECISION (VS 48-BIT) * E = USE .EMAP ARRAY CALLING SEQUENCE (VS ..MAP) * F = DO FULL FORM FEEDS EVEN IF A TTY. * D = COMPILE LINES THAT START WITH 'D' (VS THEIR COMMENTS) * B = SET INTERNALLY IF BINARY OUTPUT FILE IS PRESENT * C = PRODUCE A CROSS REFERENCE * T = PRODUCE A SYMBOL TABLE LISTING * A = PRODUCE AN ASSEMBLY LISTING * M = PRODUCE A MIXED LISTING * L = PRODUCE A SOURCE LISTING * JSB IC.F FORCE A CARD READ IN CLA,INA SET TO GET FIRST STA F.CC CHAR CCA STA F.STA SET FTN STMNT. READ FLAG STA F.EQF NOT PROCESSING EQUIV STA F.NXN SET NO INPUT FLAG. JSB IDN.F INPUT DO NOT ASSIGN JSB NTI.F MOVE NID TO F.IDI DLD F.IDI CPA "FT" 'FT' JMP CME04 CME02 CLA,INA FTN4 CONTROL CARD MISSING JMP F.ABT EXIT TRANSLATOR. SPC 1 CME04 LDA B GET NEXT TWO CHAR. ALF,ALF TO LOW A AND B377 ISOLATE CPA "N" 'N' JMP CME06 JMP CME02 FTN CONTROL CARD MISSING SPC 1 CME06 LDB F.TC CPB B15 JMP PCONT CPB B54 ',' RSS JMP CME08 ERROR IN FTN CARD JSB ICH.F INPUT CHARACTER LDB A SAVE CHARACTER IN (B) LDA NLTEM CONTROL WORD BEING BUILT CPB "B." 'B' SW.B JMP CME14 SET OUTPUT BINARY BIT IN F.CCW CPB "L" 'L' SW.L JMP CME16 SET SOURCE LISTING BIT CPB "A" 'A' SW.A JMP CME18 SET ASSEM & TABLE LISTNG BITS CPB "M" 'M' SW.M JMP CME20 SET MIXED & TABLE LISTNG BITS CPB "T" 'T' SW.T JMP CME10 SET TABLE LISTING BIT CPB "C" 'C' SW.C JMP CME21 CROSS REF. CPB "D" 'D' SW.D JMP CME17 CPB "F" 'F'? SW.F JMP CME.F SET SPECIAL FORMS FOR TTY CPB "E" 'E'? SW.E JMP CME.E YES GO SET UP CPB "Y" 'Y'? SW.Y JMP CME.Y YES GO SET UP CPB B15 JMP PCONT ADB BM61 CHECK FOR DIGIT. SW.N SSB JMP CME08 ADB KM9. SSB,RSS JMP CME08 NONE OF THE ABOVE. ADB ERR0 DIGIT; BUILD ERR ROUTINE NAME STB F.ER0 CLB STB SW.N JMP CME12 SPC 1 CME08 LDA K2 JMP F.ABT ERROR IN FTN CONTROL CARD SPC 1 CME20 IOR K2 M: SET MIXED LISTING BIT CLB,CCE STB SW.M CME18 IOR K4 A: SET ASSEMBLY LISTING BIT CLB,SEZ,CCE,RSS "M" SET? STB SW.A NO. DISABLE "A" CME10 IOR K8 T: SET TABLE LISTING BIT CLB,SEZ,RSS "A" OR "M" SET? STB SW.T NO. DISABLE "T". CME12 STA NLTEM JSB ICH.F GET NEXT CHAR JMP CME06 SPC 1 CME14 IOR B40 B: SET LOAD-&-GO IND. CLB STB SW.B DISABLE "B" JMP CME12 SPC 1 CME16 CLB,CCE L: SET SOURCE LISTING BIT RAR,ELA [IOR =B1] STB SW.L JMP CME12 SPC 1 CME17 IOR B100 SET THE DBUG BIT CLB STB SW.D DISABLE THE OPTION JMP CME12 SPC 1 CME21 IOR O20 C: SET CROSS REF BIT. CLB STB SW.C JMP CME12 SPC 1 CME.F IOR B200 SET FORMS BIT CLB STB SW.F DISABLE THE OPTION JMP CME12 B@< ..TCM JMP CRSEC PAINFUL WASN'T IT? * * T2STF NOP B1000 OCT 1000 "T" ASC 1,T ".D" ASC 1,.D ".X" ASC 1,.X ".T" ASC 1,.T "TB" ASC 1,TB KM44 DEC -44 D.DTO DEF .DTOI DEF OF .DTOI IN '.' TABLE BLKM ASC 7, BLOCK COMMON SIZE = BLKN BSS 3 RESERVED FOR BLOCK N5DAME ASC 4, SIZE = BLKSZ BSS 3 SIZE DMBLK DEF BLKN DMBLM DEF BLKM * * CRSEC LDA F.CCW SET UP LOCAL FLAGS AND B40 ISOLATE THE BINARY FLAG STA BFLG SAVE IT LDA F.CCW NOW PUT RAR,RAR M BIT IN LOW PART OF STA CCW LOCAL WORD CLA NEWBL STA COMCO SET COUT OF CURRENT BLOCK COMMON MODULE CCA SET TO NOT IGNOR STA IGNOR ANY THING JSB RWN.C REWIND INT CODE FILE DEF C.SC1 JMP ERROR ERROR ON PASS FILE ACCESS SPC 1 LDA F.SFF IF CPA K2 NOT A BLOCK DATA CLA,RSS SUBPROGRAM JMP OTNAM GO SEND THE NAME RECORD * * ******************************************* * * BLOCK DATA SUBPROGRAM FIND MASTER ENTRY * * ******************************************* * STA T1FBL CLEAR THE LOCAL COUNT LDA F.DP SCAN THE STA F.A A.T. FBL00 JSB GNA.F FOR THE MASTER BLOCK ENTRY SSA,RSS IF END OF TABEL THEN JMP SYTBM DONE GO PRINT THE SYMBOL TABLE * LDA F.A,I GET THE FLAG ENTRY AND NTATI =B107600 ISOLATE NT,AT,IU FIELDS CPA B7200 IF NT=0 & AT=BCOMI & IU=SUB RSS THEN THIS IS A MASTER ENTRY JMP FBL00 ELSE TRY NEXT ONE] * LDA T1FBL IS THIS THE ONE WE CPA COMCO WANT? JMP FBL02 IF YES JUMP * ISZ T1FBL ELSE NOTE IT AND JMP FBL00 CONTINUE THE SCAN. * NTATI OCT 107600 B7200 OCT 7200 IGNOR NOP COMCO NOP T1FBL NOP COMMS NOP CURRENT MASTER ADDRESS K9 DEC 9 * FBL02 LDA F.A FOUND THE MASTER STA COMMS SET IT UP INA GET THE SIZE LDA A,I AND STA F.RPL SET FOR THE NAM RECORD JSB TTHOU CONVERT STB BLKSZ FOR THE MESSAGE JSB ASC.F STB BLKSZ+1 STA BLKSZ+2 AND SET  CLA CLEAR THE ENTRY POINT WORD STA F.REL AND STA IGNOR SET TO IGNOR DATA * * * ********************* * * OUTPUT NAM RECORD * * ********************* SPC 1 OTNAM LDA F.DNB MOVE NAM RECORD FROM NBUF LDB A,I GET NAM REC WORDCOUNT STB MC LDB WBP0 TO WBUF FOR CHECKSUM. JSB .MVW DEF MC NOP LDB WBP0 GET THE PROGRAM ADB K9 TYPE LDB B,I AND STB PGMTY SAVE IT CCA SET NAME FLAG STA T1EX FOR DUP NAME CHECK STA T4EX LDA F.SFF IF BLOCK DATA SUBPROGRAM CPA K2 THEN RSS JMP NAM2 * DLD BLNKS BLANK THE NAME WORD 2,3 DST WBUF+4 LDB F.A AND MOVE IN JSB STOL THE NAME FROM THE A.T. DBL WBUF+3 LDA WBP3 NOW JSB MPN.F SET UP THE NAME IN MOST OF THE OTHER PLACES LDA WBP3 MOVE IT LDB DMBLK INTO THE JSB .MVW THE DEF K3 MESSAGE NOP NAM2 LDA WBP5 GET ADDRESS OF NAME JSB EXLNC CHECK LENGTH LDA KK20 NAM REC TYPE IDENT STA WBP1,I LDA F.RPL STORE PROGRAM SIZE STA WBUF+6 LDA F.CSZ STORE COMMON SIZE STA WBUF+8 LDA MC RECORD SIZE JSB .WRIT OUTPUT NAM RECORD SKP * ********************* * * OUTPUT ENT RECORD * * ********************* SPC 1 * PROGRAM NAME IN NAM RECORD IS OUTPUT AS AN * ENTRY POINT. NEEDED FOR SEGMENT LINK BACK TO MAIN. * LDA F.REL PROGRAM ENTRY LOCATION STA WBUF+6 ENTRY INTO ENT RECORD LDA KK400 ENT REC TYPE IDENT INA STA WBP1,I LDA K7 7 WORD RECORD JSB .WRIT OUTPUT ENT LDA F.SFF IF BLOCK DATA SUBPROGRAM CPA K2 THEN JMP GETCW SKIP CHECK FOR USER EXTS. * } SPC 1 * ************************ * * OUTPUT EXT RECORD(S) * * ************************ SPC 1 * OUTPUT NAMES OF LIBRARY SUBRS USED * JSB SET LDA F.D.T EXT ORDINAL TABLE STA CWA LDA NOF. STA CTR1 CMA,INA SET POSITIVE ADA CWA STA E.TBL END OF IT LDA ADEXT STA PTEXT LPTBL LDB CWA,I WAS EXT ORDINAL ASSIGNED? SSB,RSS JMP ADVPT NO. THIS SYMBOL NOT USED. CMB,INB SET ORD POSITIVE LDA KM3 STA CTR2 CONTU ISZ WLOC LDA PTEXT,I COPY SYMBOL NAME TO BUFFER. STA WLOC,I ISZ PTEXT ISZ CTR2 JMP CONTU AND KK774 ADA B ATTACH ORD ISZ WORD STA WLOC,I JMP ADVCT * MC NOP PGMTY NOP K17 DEC 17 T1EX NOP T2EX NOP T3EX NOP T4EX NOP C377 OCT 177400 K91 DEC 91 K85 DEC 85 NOF. ABS -NO.F NEG. OF NUMBER OF DOT FUNCTIONS SKP ADVPT LDA PTEXT SET PTEXT TO NEXT ENTRY ADA B3 STA PTEXT ADVCT LDA WLOC CPA WBP59 RECORD FULL? JSB CLOSE YES. END IT. ISZ CWA ISZ CTR1 JMP LPTBL * * NOW DO NAMES OF USER'S SUBROUTNES. * ISZ T4EX CLEAR T4EX (IT IS -1) NOP THIS WORD SKIPPED LDA F..DP SET CWA FOR FIXED EXT INA CKLO STA CWA CURR WORD ADDRESS STA T1EX SET NEW TOP OF LIST CPA F.LO JMP FINAL DONE. * LDA CWA,I GET NEXT SYMBOL AND K7 ADDRESS ADA CWA AND STA SNE SAVE IT LDA CWA,I COMPUTE ITEM USAGE AND B600 CPA B200 USED AS SUBPROG? RSS YES. JMP NXENT ISZ CWA COMPUTE EXT ORD LDB CWA,I LDA T1EX GET SYMBOL ADDRESS CMB,SSB,INB CPA F.EMA IF ORDINAL OR IF EMA RSS THEN PROCESS FURTHER JMP NXENT NO ORDu: NOT EXTERNAL SYMBOL. * STB EXORD SAVE ORDINAL (POSITIVE) CPA F.EMA THIS EMA MASTER? CLA,RSS YES SKIP JMP NXEMA NO SKIP * LDA PGMTY YES CHECK IF PROGRAM TYPE ALLOWS CPA K5 EMA PRODUCTION JMP N.EMA NO GO CHECK FOR ZERO ORDINAL * LDA F.SBF NOT SEGMENT MAIN IS IT A MAIN? SZA,RSS WELL? JMP D.EMA YES GO SET UP EMA * N.EMA SZB,RSS IF SYMBOL ORDINAL IS ZERO THEN JMP NXENT DON'T NEED ANY EXT RECORD * JMP NXEMA ELSE JUST A STD. EXT RECORD * D.EMA LDB F.EMA SET EMA FLAG STB T5EX FOR LATER CPA WORD IF SOME DATA IN RECORD RSS THEN JSB CLOSE CLOSE IT NXEMA LDA KM3 STA TEMP ISZ CWA LDB SNE LDSYM LDA BLNKS CPB CWA ALL SYMBOL COPIED? JMP *+3 YES. PAD WITH BLANKS. LDA CWA,I ISZ CWA ISZ WLOC WLOC ADV IS LATE STA WLOC,I ISZ TEMP JMP LDSYM ISZ WORD LDA WLOC ADDRESS TO A JSB EXLNC CHECK FOR EXCESSIVE LENGTH AND KK774 177400 COMBINE LAST CHAR ADA EXORD WITH EXT ORD. STA WLOC,I LDA T1EX IF EMA CPA T5EX THEN JMP YEMA GO WRAP UP THE RECORD * NXEM1 LDA WLOC CPA WBP59 RECORD FULL? JSB CLOSE YES. DUMP IT. NXENT LDA SNE GO TO NEXT ENTRY CPA F.DP START OF USER TABLE? ISZ T4EX YES SET THE FLAG TO SO INDICATE JMP CKLO AND AROUND WE GO * YEMA ISZ WLOC STEP TO THE SEG SIZE WORD DLD F.EMA GET THE M-SEG. WORD STB WLOC,I AND SET IT DLD F.EMS GET THE EMA SIZE CLE,ERB RAL,ERA ADJUST TO STD. DOUBLE WORD INTEGER ADA B1777 ROUND UP TO NEXT HIGHER PAGE SEZ STEP B IF INB NEEDED ASR 7 DIVIDE BY 1024 CLB CLEAR HIGH THREE}:B@< BITS IN CASE ASR 3 FINISH DIVIDE IOR EMTYP ADD THE EMA TYPE BITS STA WBP1,I SET IN WORD TWO OF THE RECORD LDA K7 7 WORD RECORD 7B JSB .WRIT WRITE IT JSB SET SET UP TO CONTINUE THE EXT'S JMP NXENT CONTINUE EXT'S * * EMTYP OCT 140000 TEMP NOP T5EX NOP * ******************************************** * CHECK FOR 6 CHAR. EXT NAMES SHORTEN TO 5 * BY DROPING CHAR. 5. NOTE IN LISTING **************************************************** * EXLNC NOP STA EXTM SAVE ADDRESS OF NAME LDA A,I GET LAST TWO CHARS. STA ERM6 SAVE LAST TWO CHAR IN MESSAGE BUF LDA K3 SET STA SIZE SIZE UP FOR DUP. TEST LDB KM2 SET UP THE MESSAGE ADB EXTM ADDRESS OF NAME LDA B,I FIRST TWO CHAR TO A STA ERM1 SET IN THE MESSAGE STA ERM2 NEW NAME IS SAME HERE INB NEXT TWO CHAR LDA B,I GET THEM CPA DBNK IF BLANKS RSS SKIP INCREMENTING ISZ SIZE SIZE STA ERM3 STA ERM4 ALSO SAME LDA EXTM,I GET LAST CHAR CPA DBNK IF BLANKS RSS ISZ SIZE STA ERM5 FORM NAME AND B377 ISOLATE THE LAST CHAR CPA B40 IF BLANK JMP EXLNX NAME IS OK * LDA ER68 ELSE LDB T4EX IT IS NOT AN ERROR OR EVEN A WARNNING SZB TO SHORTEN AN ENTRY IN THE FIXEXT TABLE JSB WAR.F SEND ERROR MESSAGE LDA ERM5 NOW DELETE THE 5'TH CHAR. ALF,ALF MOVE 6'TH CHAR TO 5'TH SPOT AND KK774 ISOLATE IT IOR B40 ADD THE BLANK STA ERM6 SET IN MESSAGE STA EXTM,I AND IN THE PASSED BUFFER LDA K14 SENT THE MESSAGE LDB DERM LENGTH AND ADDRESS TO A,B JSB PSL.F PRINT IT EXLNX LDA F..DP A SYMBOL WAS OUTPUT, NOW STA F.A TEST FOR A DUPLICATE? * EX01 JSB GNA.F GET THE NEXT ASSIGN ENTRY SSA,RSS JMP EX09 END ALL OK OR REPORTED * LDA F.A,I GET THE TAG WORD AND B600 IS IT A CPA B200 SUB? RSS YES SKIP JMP EX01 NO TRY NEXT ENTRY * LDA F.A,I CHECK SIZE AND K7 MUST CPA SIZE HAVE THE SAME NO. OF WORDS TO MATCH CMA,INA,RSS YES SKIP JMP EX01 NO TOO SHORT * ADA K2 KEEP NUMBER OF WORDS IN SYM STA T3EX LDA F.A MUST HAVE AN INA ORDINAL (NEGATIVE) LDA A,I OR BE IN FIX-EXT PART SSB SKIP IF NOT IN FIX-EXT PART OF TABLE CCA ELSE FOURCE SSA,RSS FURTHER TEST JMP EX01 INTERNAL STMT. FUNCTION OK * STB T2EX SAVE FIX-EXT FLAG. (FROM GNA.F) LDB F.A GET ADDRESS EX03 CPB T1EX IF SAME ADDRESS THEN JMP EX01 IT IS THE SAME SYMBOL OK * ADB K2 OF THE SYMBOL LDA B,I GET 1'ST TWO CHAR. CPA ERM1 MATCH? INB,RSS YES JMP EX01 NO ALL OK TRY NEXT SYMB. * ISZ T3EX STEP COUNT DONE? RSS NO TRY NEXT TWO CHAR JMP EX05 MATCH GO CHECK FURTHER * LDA B,I GET 2'ED TWO CHARS. CPA ERM3 MATCH? CCE,INB,RSS YES SKIP JMP EX01 NO TRY NEXT SYMBOL * ISZ T3EX STEP COUNT DONE? RSS NO SKIP JMP EX05 YES A MATCH * LDA B,I GET LAST TWO CHARS. LDB A TO BOTH A AND B * AND B377 ISOLATE SIXTH CHAR CPA B40 IF LAST IS BLANK SKIP CLE,RSS ELSE BLF,BLF SWAP 5'TH AND 6'TH CHARS. LDA B NOW AND C377 MAKE SURE IOR B40 LEAST CHAR. IS CPA ERM6 BLANK AND TEST IT RSS BIG TROUBLE A DUPLICATE JMP EX01 MAKE IT BY SKIN OF TEETH! * * EX05 LDA T1EX CHECK IF NAM BUFFER INA,SZA,RSS IF SO ALWAYS JMP EX08 REPORT * LDA A,I IF ORDINALS LDB F.A ARE INB CPA B,I THE SAME JMP EX01 WE ALREADY REPORTED THIS ONE * EX08 LDA K91 ERROR 91 IF HIS SYMBOLS LDB T4EX IF ORGIONAL SYMBOL IN FIX-EXT TBL. SZB,RSS THEN JMP EX07 SET TO SEND 92 * LDB T2EX IF MATCHING SYMBOL IS IN FIX-EXT SSB,RSS WELL JMP EX02 NO REPORT ERR 91 * EX07 LDB F.A FIX-EXT INB DID HE LDB B,I USE IT? INA 92 IF HE DID SSB,RSS IF ORDINAL ASSIGNED HE DID USE IT LDA K85 NO USAGE CHANGE TO WARNING CPA K85 IF WARNING JMP EX04 SKIP ERROR FLAG SET * EX02 ISZ ER.F SET FLAG TO PRODUCE ERROR ISZ F.ERF STEP ERROR COUNT EX04 STA T3EX SAVE THE ERROR NUMBER JSB WAR.F SEND THE MESSAGE (CAN'T USE ER.F LDA K3 LDB DERM2 SEND THE NAME JSB PSL.F TO THE LIST DEVICE TOO LDA T3EX IF WARNING CPA K85 THEN JMP EX01 TEST NEXT SYMBOL * LDA T1EX IF IN NAM BUFFER INA,SZA,RSS THEN JMP EX01 DO NOT CHANGE * LDA A,I USE IT LDB F.A TO REPLACE INB THE CURRENT SYMBOLS STA B,I JMP EX01 TRY NEXT SYMBOL EX09 LDA EXTM,I RETURN WITH NAME IN A JMP EXLNC,I EXIT TO CALLER * * SIZE NOP DERM DEF *+1 DBNK ASC 1, ERM1 ASC 1, ERM3 ASC 1, ERM5 ASC 1, ASC 7, SHORTENED TO ERM2 ASC 1, ERM4 ASC 1, ERM6 ASC 1, K14 DEC 14 DERM2 DEF ERM2 CLOSE NOP FINISH & OUTPUT EXT RECORD. CCE LDA WORD RAL,ERA STA WBP1,I "EXT" RECORD DESIGNATOR CLE,ELA ADA WORD NO. OF SYMBOLS *3 ADA B3 JSB .WRIT JSB SET RE-INITIALIZE JMP CLOSE,I SPC 1 SET NOP LDA WBP2 'DEF WBUF+2' STA WLOC CLA SET WORD STA WORDk3 JMP SET,I * KM3 DEC -3 KM2 DEC -2 EXTM NOP ER68 DEC 68 KM5 DEC -5 K7 DEC 7 B100 OCT 100 B200 OCT 200 B600 OCT 600 ARR EQU B600 KK20 OCT 20000 KK774 OCT 177400 BLNKS ASC 2, EXORD NOP CTR1 NOP COUNTER FOR .TBL TABLE CTR2 NOP COUNTER FOR EXT ENTRY PTEXT NOP EXT POINTER CWA NOP CURRENT WORD ADDR. IN TABLES SNE NOP START NEXT ENTRY TEMP4 NOP MARKS WHEN SOURCE REC SPLIT NREC NOP ADDR OF NEXT RECORD IN RBUF RCYC NOP PHASE OF READ INDICATOR CYCLE RIIND NOP DATA INDICATOR FOR READ RSIND NOP DATA INDICATOR STRING FOR READ WBP1 DEF WBUF+1 WBP2 DEF WBUF+2 WBP3 DEF WBUF+3 WBP5 DEF WBUF+5 WBP59 DEF WBUF+59 TTHOU NOP PRODUCE TEN-THOUSANDS DIGIT. CLB DIV D10K DIVIDE BY 10,000 SWP ADJUST FOR RETURN ADB B2.60 ADD 'BLANK-0' IN ASCII JMP TTHOU,I A IS READY FOR FURTHER CONVERSION. * B2.60 ASC 1, 0 D10K DEC 10000 ASCNO ASC 1,NO NWAR ASC 8, ** NO WARNINGS (S REALLY ON NEXT LINE) NERR ASC 8,S ** NO ERRORS PRSIZ ASC 10,** PROGRAM = CMSIZ ASC 10, COMMON = ENDK4 DEF NWAR SPC 2 FINAL LDA WORD SZA JSB CLOSE CLA SKIP JSB SKL.F LINE ON THE LIST LDA F.RPL OUTPUT PROGRAM SIZE IN DECIMAL. JSB TTHOU STB PRSIZ+7 JSB ASC.F STB PRSIZ+8 STA PRSIZ+9 LDA F.CSZ OUTPUT COMMON SIZE IN DECIMAL. JSB TTHOU STB CMSIZ+7 JSB ASC.F STB CMSIZ+8 STA CMSIZ+9 GETCW LDA F.ERF # OF ERRORS SZA,RSS JMP ENDP7 NONE. JSB ASC.F MAKE ASCII, STORE IN ERBUF STA NERR+3 STB NERR+2 ENDP7 DLD F.ERF ANY WARNINGS?? CMA,INA ALL ERRORS ARE ALSO LOGED AS WARNINGS ADA B SO BACK THEM OUT SZA,RSS WELL?? JMP END10 NO SKIP CONVERSION * JSB AS*C.F YES CONVERT WARNNING NUMBER STA NWAR+3 SET IN MESSAGE STB NWAR+2 END10 LDA K36 LDB F.SFF IF DOING BLOCK DATA CPB K2 THEN LDA K17 OMIT THE LENGTH DATA LDB COMCO IF NOT THE FIRST BLOCK DATA BLOCK SZB THEN JMP END11 DON'T PRINT IT AT ALL * LDB ENDK4 JSB PSL.F PRINT SIZES & NO. OF ERRORS END11 LDA CCW SET CONTROL STMT. DATA SLA IF LISTING BINARY JSB EJP.F EJECT PAGE SKP * ********************************** * * PROCESS DBL RECORDS * * ********************************** SPC 1 PDBL JSB TERM INIT DBL RECORD OUTPUT LDB DLBUF SET SLBUF LDA CCW SLA,RSS IF NOT LISTING ADB B3 NO, ALTER SLBUF TO PUT ASSY STB SLBUF CODE AT LEFT MARGIN. JSB CLR1 CLB STB TEMP4 SPC 2 * * READ INTERMEDIATE CODE * SPC 1 READ JSB IFBRK CHECK FOR BREAK DEF *+1 SSA WELL? JMP BREAK YES GO HANG IT UP JSB RED.C READ A RECORD FROM THE FILE DEF C.SC1 SCRATCH FILE THAT IS DRBUF DEF RBUF BUFFER DEF B100 64 WORDS JMP ERROR READ ERROR GO REPORT AND EXIT * SSB IF EOF JMP END. GO SEND THE END RECORD * LDA DRBUF 'DEF RBUF' STA RLOC LDA RLOC,I EXAMINE FIRST WORD OF RECORD SZA,RSS SECTOR END? JMP READ YES, READ ANOTHER * SSA SOURCE OR XREF?? JMP SOURC YES GO HANDLE * STA CO SAVE COUNT ADA RLOC STA NREC BUFFER POSN OF NEXT RECORD JMP DPREP NO; GO TO DATA PREP ROUTN SPC 1 SOURC CPA KM2 IF XREF RECORD JMP READ IGNOR IT * RAL,CLE,ERA ELSE REMOVE THE FLAG BIT STA DRBUF,I AND RESTORE THE WORD LDA B RECORD SIZE TO A 6 LDB DRBUF ADDRESS TO B JSB PSL.F WRITE IT JMP READ AND GO READ THE NEXT RECORD * CCW NOP CO NOP KM1 DEC -1 * B40 DEC 32 * * PUT2 NOP PUT TWO CHAR IN A INTO THE BUFFER STA T2PUT ALF,ALF JSB PUT.F PUT FIRST ONE LDA T2PUT JSB PUT.F PUT SECOND ONE JMP PUT2,I RETURN * T2PUT NOP B3 DEC 3 K97 DEC 97 K98 DEC 98 K99 DEC 99 * ERROR LDA K98 READ ERROR ON PASS FILE JMP F.ABT ABORT COMPILE * BREAK LDA K96 SET BREAK ERROR JMP F.ABT AND ABORT THE COMPILE * K96 DEC 96 WERR LDA K97 WRITE ERROR ON BINARY FILE JMP F.ABT ABORT * * * * *************************** * * SUPPLY LABEL SUBROUTINE * * *************************** * * LAB.F NOP SCAN ASSIGNMENT TABLE LDA F.DP FOR NAMED SYMBOL STA F.A WITH CURRENT ADDRESS LAB00 JSB GNA.F GET ASSIGNMENT ENTRY SSA,RSS IF END OF TABLE JMP LAB.F,I THEN NO LABEL * LDA F.A,I CHECK OUT THIS ONE SSA IF NOT NAMED JMP LAB00 SKIP IT * AND K7 ISOLATE SIZE OF ENTRY ADA KM3 MUST BE AT LEAST SSA THREE WORDS JMP LAB00 NO TRY NEXT ONE * LDA F.A,I GET FLAG WORD AGAIN AND B7000 ISOLATE THE F.AT FIELD CPA REL MUST BE EITHER RSS REL CPA DUM OR DUM CLB,INB,RSS IF NOT JMP LAB00 REJECT IT * JSB FA.F FETCH F.AF CPA ASA MATCH?? RSS YES SKIP TO PRINT IT JMP LAB00 NO TRY NEXT ONE * LDB F.A GET ADDRESS OF JSB STOL SYMBOL AND GO PUT IT IN THE BUFFER DBL LBUF+12 AT THE LABEL LOCATION JMP LAB.F,I RETURN * B7000 OCT 7000 DUM OCT 5000 REL OCT 1000 SUB OCT 200 KK01 DEF 0,I K36 ܪ DEC 36 SKP SPC 1 TRANS NOP DSORG DEF SYORG DEF OF 'ORG' SYMBOL DSBSS DEF SYBSS DEF OF 'BSS' SYMBOL * * ** PREPARATION FOR DATA WORKING SEGMENT ** SPC 1 DPRE0 LDB F.SFF A.T. REFERENCE IS IT A BLOCK DATA FLAG? CPB K2 WELL CLB,RSS YES SKIP TO CHECK IF CURRENT ONE JMP DPR01 NO GO FETCH THE VALUE * CPA COMMS CURRENT MASTER? CCB YES SET FLAG STB IGNOR AS NEEDED CLA ORG IS IN THE ADDON JMP DPR02 GO SET IT UP * DPR01 INA STANDARD A.T. ORG LDA A,I GET THE VALUE JMP DPR02 AND CONTINUE * DPREP ISZ RLOC LDA RLOC,I COMPUTE NEW STORAGE ADDRESS IN A ISZ RLOC PUSH THE BUFFER POINTER RAL,CLE,SLA,ERA SKIPS IF FLAG, REMOVES JMP DPRE0 IF SYMBOL TABEL REF. GO CHECK * DPR02 ADA RLOC,I ADD ON TO ADDRESS CPA ASA IF NO CHANGE JMP CYCL SKIP THE BSS/ORG * LDB RLOC IF JUST AN INB ORG CPB NREC IGNOR THE RECORD (FROM DATA STMT. ECT.) JMP PNREC * LDB ASA B CONTAINS OLD ASA STA TRANS SAVE THE NEW ADDRESS CMB,INB ADA B STA TEMP2 SAVE THE DIFFERMENCE LDA IGNOR IF IGNORING SZA,RSS THEN JMP READ GO TO NEXT RECORD * LDA CCW IF LISTING NOT NEEDED SLA,RSS THEN JMP DPR00 SKIP THIS SET UP * JSB CLR1 CLEAR LIST BUFFER LDA TEMP2 GET THE NEW ADDRESS SSA,RSS IF BSS JSB LAB.F PUT LABEL ON IF REQUIRED LDA TEMP2 GET THE NEW ADDRESS LDB DSORG PREPARE FOR ORG SSA,RSS IF JUST A BSS LDB DSBSS SET FOR IT JSB ACOD2 SEND SYMBOL TO LIST BUFFER LDB TEMP2 NOW GET SIZE OR LOCATION SSB IF ORG LDB TRANS USE LOCATION JSB ASCI5 SEND THE SIZE OR L.OCATION THE BUFFER LDA "B" FLAG IT AS JSB PUT.F OCTAL JSB LIST SEND TO THE PRINTER DPR00 LDA TRANS GET THE NEW ADDRESS STA ASA AND SET IT JSB TERM OUTPUT THE OLD RECORD CYCL CCA CPA IGNOR IGNORING THIS DATA? RSS NO SKIP JMP READ YES GO READ THE NEXT RECORD * STA RCYC SKP PNREC ISZ RLOC ADVANCE READ PTR LDA RLOC READ PTR AT START OF NEXT REC? CPA NREC JMP READ YES; GO TO BEGINNING SEGMENT ISZ RCYC NO; ANY IND BYTES LEFT? JMP RIND LDA RLOC,I NO. FETCH NEW BYTE WORD. STA RSIND LDA KM5 RELOAD BYTE COUNTER STA RCYC ISZ RLOC LDA RLOC GO TO BEGINNING ROUTINE IF PTR CPA NREC AT START OF NEXT RECORD JMP READ RIND LDA RSIND ALF,RAR STA RSIND AND K7 STA RIIND LDB WLOC SET B TO WLOC + LGTH NEXT WORD -1 CPA K7 IF OFFSET ENTRY RSS TREAT AS MR FOR NOW CPA K5 INB HANDLES WORD LGTH=2 CMB,INB ADB WBP0 ADB K58 SSB OUTPUT BUFFER FULL? JSB TERM YES. ISZ WLOC JSB CLR1 BLANK THE LIST BUFFER SPC 2 * ** ALTER DATA WORD AND STORE ** SPC 1 LDA CCW SET E ERA IF LIST REQUIRED CLA STA EXTN SET EXT ID TO ZERO STA DI2 SET THE NO SYMBOL FLAG STA WIIND STA CX CLEAR OFFSET STA OPCOD LDA RLOC,I READ AND STORE DATA STA WLOC,I STA OFSET STORE FOR OBJECT LISTING LDB RIIND SZB,RSS JMP R0 CONSTANT. CPB K2 JMP R2 ASCII CHAR PAIR. CPB K6 JMP R6 ABSOLUTE INSTRUCTION. AND KK01 =B100000, CALCULATE DI1 STA DI1 MREXT LDA WLOC,I GET OPCODE AND KK076 =B76000  STA CODE CPB K4 JMP R4 EXT REF. * STB WIIND 2-WORD MEM REF; SET WIIND=5 ADA DI1 STA OPCOD SAVE OPCODE & INDIRECT LDA RLOC,I GET OPERAND RELOCATION BITS AND B3 STA MR ISZ RLOC ADV READ PTR LDB RLOC,I GET OPERAND RBL,CLE,SLB,ERB =0? CLEAR FLAG JMP INDRT NEGOF STB OPADD JMP CODE0 SPC 1 INDRT LDA RLOC,I GET THE WORD ADA K8 A NEGATIVE OFFSET OF 8 IS MAX SSA IF NOW NEGATIVE JMP ASTBR THEN ASSIGNMENT TABLE REF. * LDB RLOC,I ELSE IT IS A NEG. OFFSET SO JMP NEGOF RESTORE BE AND GO SET * ASTBR STB OPADD AREF LDA B,I GET FIRST WORD OF ENTRY AND B600 ISOLATE F.IU FIELD INB LDB B,I CPA ARR IF ARRAY JMP AREF GO ANOTHER LEVEL * ISZ DI2 SET THE SYMBOL USED FLAG CPA SUB EXTERNAL? JMP EXT? COULD BE GO CHECK * CODE0 LDA KK051 SET QUALIFIER='R ' STA QALST,I LDA K5 TEST THE RECORD TYPE CPA RIIND IF STD MR JMP MRIN GO TEST FOR DEF * STA WIIND ELSE SET TYPE TO MR ISZ RLOC GET THE OFFSET WORD LDA RLOC,I AND SET STA CX IT FOR FUTURE REF. ADB A SET PROPER ADDRESS MRIN LDA EXTN GET EXT NO. ADA CODE TEST IF INTERNAL DEF. SZA,RSS MUST NOT BE EXT REF. JMP DF YES. IT'S A DEF. * ISZ WLOC STB WLOC,I STORE ALTERED 2ND WORD ADB DI1 SET FULL ADDRESS IN B STB OFSET SET FOR LISTING CLA CLEAR A FOR FURTHER TESTS JMP MRTST * EXT? SSB,RSS IF ORDINAL IT WILL BE NEGATIVE JMP CODE0 NO MUST BE STMT. FUNCTION * CMB,INB SET THE EXT POSITIVE LDA K5 TEST IF STD. ONE WORD EXT CPA RIIND IS ALL THAT IS NEEDED JMP EXT1 YES ONE WORD ENT}RY GO DO IT * STB EXTN NO A MR WITH OFFSET IS REQUIRED RBL,RBL FORM THE INSTRUCTION ADB WLOC,I FIX THE INSTRUCTION BY ADDING ADB K3 SET 'MR' FIELD TO ABSOLUTE STB WLOC,I THE ORDINAL CLB NOW CONTINUE TO SET UP THE OFFSET JMP CODE0 * EXT1 ADB WLOC,I FIX UP THE INSTRUCTION STB WLOC,I IN THE OUTPUT BUFFER LDA CCW SET THE LISTING BIT ERA IN E LDB K4 SET THE MR TYPE JMP MREXT GO SET UP A AND DO THE MR * SPC 1 DF ADB DI1 COMPLETE ADDRESS STB WLOC,I STB OFSET FOR OBJECT LISTING LDB MR COMPUTE WIIND INB STB WIIND MRTST LDB CCW IF NOT PRINTING CLE,SLB,RSS JMP NOPRT DONE WITH IT * CPA EXTN EXTERNAL REF? JMP NOTEX NO SKIP * LDA CODE EXT REF GET CODE JMP EXTS GO PUT TOGETHER * NOTEX LDB KK041 SET QUALIFIER ='C ' CPA MR IF NOT IN COMMON RSS SKIP THE RESET OF THE QUALIFIER STB QALST,I R5 LDA CODE JSB ACOD1 PUT OPCODE INTO THE LIST BUFFER SKP * ** SUPPLY OPERAND SYMBOL ** SPC 1 SOSR LDB DI2 BIF BIT 15 IS ON THEN IT IS A SYMBOL SZB,RSS FROM THE SYMBOL TABLE WELL? JMP BRCH0 NOT IN TABLE SKP FURTHER CHECKS * LDA OPADD,I READ BASE WORD OF ENTRY SSA IF CONSTANT JMP SWTCH GO USE RELATIVE ADDRESS * AND K7 RETAIN, STORE SIZE OF ENTRY CPA K2 IF TWO WORD PSUDO ENTRY JMP SWTCH JUST USE THE ADDRESS * LDB OPADD IT IS A REAL ENTRY IS IT A TEMP? JMP TRSYM GO PUT OUT THE SYMBOL SPC 1 BRCH0 LDA MR SKIP * OPERAND LOGIC IF COMMON SZA LOCATION JMP CNVT LDA KK025 '*+' LDB ASA COMPUTE DISTANCE BETWEEN OPERAND CMB,INB h]B@< AND LOAD ADDRESSES ADB OPADD SSB IF NEGATIVE ADA K2 CHANGE TO '*-' SSB MAKE DISTANCE ABSOLUTE CMB,INB STA PUT2 SAVE THE PREFIX STB A $B AND KM8 =B177770, DISTANCE LESS THAN 8? SZA JMP CNVT NO. * ADB "0" =B60 YES CONVERT TO A CHARACTER LDA PUT2 SEND THE PREFIX JSB PUT2 LDA B GET THE OFFSET JSB PUT.F SEND TO THE BUFFER JMP TTDI1 SPC 1 SWTCH ISZ OPADD GET THE VALUE LDA OPADD,I FROM THE SYBMOL TABLE STA OPADD AND SAVE IT CNVT LDB OPLOC RESTORE STB ASSLC THE BUFFER POINTER LDB OPADD STORE ASCII ADDR SHIFTED LFT ONE JSB ASCI5 PUT ADDRESS INTO THE BUFFER LDA "B" FLAG AS OCTAL JSB PUT.F MR.F LDB MR MR.F ROUTINE ADDS COMMON SYMBOL LDA "C" GET "C" CPB K2 IF IN COMMON JSB PUT.F ADD THE "C" TTDI1 LDB CX GET THE OFFSET SZB,RSS IF NONE JMP ITST GO TEST FOR INDIRECT * LDA B53 "+" PUT PROPER CONECTOR SSB IN THE BUFFER ADA K2 "-" FROM "+" JSB PUT.F SEND TO THE BUFFER SSB MAKE ABSOLUTE CMB,INB JSB ASCI5 PUT OFFSET IN THE BUFFER LDA "B" NOW PUT IN JSB PUT.F THE OCTAL INDICATOR ITST LDA B54 "," LDB DI1 IF INDIRECT FLAG NOT SET SZB,RSS THEN JMP PRINT GO PRINT WHAT WE HAVE * JSB PUT.F ELSE SEND A "," LDA "I" AND A JSB PUT.F "I" JMP PRINT AND THEN GO PRINT IT * * OPLOC DBR LBUF+17 TEMP2 NOP B53 OCT 53 '+' "0" OCT 60 "C" OCT 103 "B" OCT 102 B54 OCT 54 ',' "I" OCT 111 KM8 DEC -8 K2 DEC 2 K3 DEC 3 K6 DEC 6 K8 DEC 8 K58 DEC 58 B377 OCT 377 KK025 ASC 1,*+ KK400 OCT 40000 CBLNK ASC 1,C CROSS REF FLAG KK041 EQU CBLNK KK051 ASC 1,R KK076 OCT 76000 MR NOP MRI AND ASCII PARAMETER CODE NOP OP CODE CX NOP COMPLEX FLAG DI1 NOP BIT 15 WOR2D 1 DI2 NOP BIT 15 WORD 2 OPADD NOP OPERAND ADDR / BASE ADDR OP ENTR * * ** GENERATE ASSEMBLY LISTING ** SPC 1 R0 SEZ,RSS IF NOT PRINTING JMP NOPRT SKIP REST LDB DSOCT ADDRESS OF 'OCT' JSB ACOD2 CONSTANT. LDB WLOC,I CONVERT DATA TO ASCII LDA OPLOC GET ADDRESS OF OPCODE JSB ASCI6 JMP PRINT SPC 1 R2 SEZ,RSS IF NOT PRINTING JMP NOPRT SKIP BUFFER SETUP * LDB A STORE ASCII CHARACTER PAIR AND B377 CPA B15 TRAILING CR? ADB B23 YES. SUBSTITUTE BLANK. STB TEMP2 LDB DSASC ADDRESS OF 'ASC 1,' JSB ACOD2 TO THE BUFFER LDA TEMP2 JSB PUT2 PUT IN THE ASCI JMP PRINT * DSASC DEF SYASC DSOCT DEF SYOCT B15 OCT 15 B23 OCT 23 B1777 OCT 1777 E.TBL NOP END OF .TBL + 1. ADEXT DEF EXTST BASE LOC. OF EXTST KK054 ASC 1,X EXTN NOP EXTERNAL ID # SKP R4 STB WIIND EXTERNAL REFERENCE; SET WIIND =4 SEZ,CLE,RSS IF NOT LISTING JMP NOPRT SKIP THE SET UP * EXTS LDB KK054 SET QUALIFIER ='X ' STB QALST,I JSB ACOD1 CONVERT AND STORE OPCODE LDA EXTN GET POSSIBLE EXT NO. SZA,RSS IF NONE THEN LDA WLOC,I PICK UP FROM THE INPUT STREAM AND B1777 =B1777 GET EXT ORDNL STA OFSET SET FOR PRINTING CMA,INA SET NEGATIVE FOR COMPARE STA EXTN LDA DI2 IS THE LDB OPADD SYMBOL ADDRESS SUPPLIED? SZA WELL JMP TRSYM YES GO MOVE IT * LDA EXTN GET THE SYMBOL NUMBER TO A LDB F.D.T SEARCH EXTERNAL TABLE FOR MATCH CONSR CPA B,I JMP FOND1 INB CPB E.TBL END OF .TBL REACHED? CLB,INB,RSS YES. JMP CONSR ADB F..DP SEARCH FIX EXTERNAL TABLE FIXT1 LDA B,I AND K7 GET ENTRY SIZEk ADA B STA PTR WHERE NEXT ENTRY BEGINS INB LDA B,I ID=EXTN? CPA EXTN JMP FOND2 YES. FOUND IT. LDB PTR NO; ALL TABLE CHECKED? CPB F.LO JMP FOND2 CPB F.DP INB YES; SAME ROUTINE NOW CHECKS JMP FIXT1 DATA POOL SPC 1 FOND2 ADB KM1 TRSYM JSB STOL COPY STRING TO ASSY LIST BUFF DOPAN DBR LBUF+17 JMP TTDI1 SPC 1 FOND1 LDA F.D.T COMPUTE LOCATION IN EXTERNAL CMA,INA SYMBOL TABLE OF ENTRY ADA B STA B ORDINAL. ADA B ADA B *3 ADA ADEXT STA B ADA B3 STA STP JSB STMV MOVE IN THE SYMBOL JMP TTDI1 GO TEST FOR INDIRECTS ETC. SKP * ** DETERMINE OPCODE FOR ASSEMBLY LISTING ** SPC 1 ACOD1 NOP ENTER HERE TO FIND OPCODE. LDB MRINS SEZ,SZA,RSS IF E=0 AND A=0 IT IS A DEF RSS SO SKIP TO MATCH MATCH CPA B,I SEARCH OPCODE VALUE TABLE JMP RLE FOUND IT; GO COPY INB JMP MATCH SPC 1 RLE LDA MRINS COMPUTE LOC WITHIN TABLE CMA,INA ADB A BLS ADB DSYM2 JSB ACOD2 MOVE THE SYMBOL JMP ACOD1,I RETURN * ACOD2 NOP LDA ASSBF INITIALIZE ASSLC PTR STA ASSLC TSW LDA B,I TRANSFER SYMBOL WORD TO ASSBF ALF,ALF ROTATE TO SEND FIRST CHAR. FIRST JSB PUT.F SEND IT LDA B,I GET NEXT CHAR. JSB PUT.F SEND IT LDA B,I GET THE FLAG BIT INB SSA,RSS IF FLAG NOT SET JMP TSW SEND THE NEXT WORD * JMP ACOD2,I FLAG SET END OF ENTRY SPC 2 MRINS DEF MLITB BASE ADDR OF MACHINE INSTRUCTION DSYM2 DEF SYMT2 NON-MEMORY REF. INSTRUCTIONS ASSBF DBR LBUF+15 DMODT DEF MODT BASE LOC. OF MODT (MODE OF TEMP) SPC 1 R6 SEZ,RSS IF NOT PRINTING  JMP NOPRT SKIP BUFFER SET UP * JSB ACOD1 ABSOLUTE INSTR: FIND MNEMONIC SPC 1 * ** FINISH AND PRINT ASSY LIST BUFFER ** SPC 1 PRINT LDB OFSET LDA ASSLC GET CURRENT LOCATION STA ACOD2 SAVE IT LDA OBJST PRINT JSB ASCI6 OBJECT CODE TO ASCII OCTAL LDB ASA LDA ADRST STA ASSLC SET ADDRESS FOR ADDRESS JSB ASCI5 ADDRESS TO ASCII OCTAL JSB LAB.F ADD ANY LABEL LDA ACOD2 RESTORE STA ASSLC THE CURRENT LOCATION JSB LIST OUTPUT LIST BUFFER LDB RIIND GET THE OFFSET IF ANY LDA EXTN IF EXTERNAL CPB K7 AND OFFSET SZA,RSS THEN SKIP TO PRINT IT JMP NOPRT NOPE SKIP THE EXTRA LINE * JSB CLR1 CLEAR THE BUFFER AND PRINT THE OFFSET LDA OBJST GET THE ADDRESS OF THE OFFSET LDB CX GET THE OFFSET JSB ASCI6 SEND IT TO THE BUFFER LDA B53 '+' JSB PUT.F SEND '+' TO THE BUFFER JSB LIST LIST IT SKP * ** POST RELOCATION BYTE ** SPC 1 NOPRT ISZ WORD ISZ ASA LDA WSIND ROTATE WSIND LEFT 1 IND ALF,RAR STORE AT RIGHT WIIND ADA WIIND STA WSIND ISZ WCYC BRANCH ONCE-IN-5 JMP PNREC LDA KM5. RESET WCYC=-5 STA WCYC LDA WSIND ROTATE WSIND LEFT 1 RAL STA STOWS,I CLA STA WSIND ISZ WLOC LDB WLOC STB STOWS JMP PNREC * OPCOD NOP OFSET NOP ASA NOP ACTUAL STORAGE ADDR. STOWS NOP STORG LOC OF NEXT WSIND WIIND NOP WCYC NOP WLOC NOP WRITE LOCATION POINTER WSIND NOP KM5. DEC -5 ADRST DBR LBUF+4 OBJST DBL LBUF+8 QALST DEF LBUF+11 ASSLC NOP SPC 1 * **************************************** * * SYMBOL FROM ASS. TBL. TO LIST BUFFER * * **************************************** '* STOL NOP B IF ASS. TBL. ADDRESS LDA B,I GET COUNT AND K7 ADA B A IS ADDRESS OF LAST CHAR+1 STA STP SET AS STOP ADB K2 B IS ADDRESS OF FIRST CHARS. LDA STOL,I P+1 IS ADDRESS OF WHERE TO PUT IT STA ASSLC SET IT ISZ STOL STEP TO RETURN ADDRESS LDA B,I GET THE FIRST ID WORD CMA,SSA,INA IF NEGATIVE SKIP JMP STOL0 IT IS >0 STD. SYMBOL * ADB KM2 GET THE ADDRESS OF THE LDB B,I IM AND GET IT ALF,ALF POSITION TO GET LEAST RAL,RAL THREE DIGITS (LEFT 1+(6-NO.DIGITS)*3) BLF POSITION THE IM FIELD TO LOW B STA STMV SAVE THE NUMBER LDA B IM TO A AND K7 ISOLATE ADA DMODT INDEX INTO TABLE LDA A,I FETCH TEMPCELL MODE SYMBOL JSB PUT2 PUT IT IN THE BUFFER LDA KM3 GET DIGIT COUNT LDB STMV GET THE NUMBER TO B JSB NUM.F CONVERT THREE DIGITS INTO THE BUFFER JMP STOL,I RETURN * STOL0 JSB STMV MOVE THE SYMBOL JMP STOL,I RETURN * * STMV NOP SYMBOL MOVE B=ADDRESS,STP= STOP ADDRESS STOL1 CPB STP DONE? JMP STMV,I YES EXIT * LDA B,I GET FIRST TWO CHAR. ALF,ALF ROTATE TO JSB PUT.F PUT FIRST OUT FIRST LDA B,I GET NEXT AND B177 ISOLATE CPA B40 IF BLANK JMP STMV,I QUIT NO BLANKS ALLOWED * JSB PUT.F ELSE PUT IT OUT INB STEP B JMP STOL1 GO GET NEXT CHAR. * STP NOP B177 OCT 177 SPC 1 SKP SPC 2 * ** FINISH AND OUTPUT DBL RECORD ** SPC 1 TERM NOP LDB WORD SZB,RSS JMP TERMX EMPTY RECORD. ADB KK601 =B60100 STB WBP1,I LDA WLOC IF A NEW CPA STOWS DBL FLAG WORD IS LAST JMP NORT SKIP THE R OTATE BIT * LDB WSIND ROTIN BLF,RBR ROTATE WSIND LEFT ONE IND ISZ WCYC JMP ROTIN * RBL COMPLETE PREPARATION OF WSIND STB STOWS,I ISZ WLOC NORT LDA WBP0 COMPUTE RECORD LENGTH CMA,INA ADA WLOC JSB .WRIT OUTPUT DBL RECORD * * INITIALIZE NEXT DBL RECORD * TERMX LDA KM5. =D-5 STA WCYC LDB WBP0 'DEF WBUF' ADB K4 STB WLOC STB STOWS CLA STA WORD WORDS OF OBJECT CODE STA WSIND LDA ASA SET RECORD ORIGIN STA WBP3,I JMP TERM,I * * ************************************ * * OUTPUT RELOCATABLE BINARY RECORD * * ************************************ SPC 1 .WRIT NOP LDB BFLG DOES HE WANT A SZB,RSS BINARY?? JMP .WRIT,I NO JUST EXIT * LDB WBP0 ALF,ALF WORD CNT TO LEFT HALF STA B,I POST WC IN BUFFER ALF,ALF CMA,INA ADA B3 STA WORD COUNTER INB LDA B,I GET TYPE WORD ADB K2. ADA B,I TALLY CHECKSUM INB ISZ WORD JMP *-3 STA WBP2,I POST IN BUFFER LDA WBP0,I ALF,ALF GET WORDCOUNT STA RECLN SET IT JSB WRT.C OUTPUT RECORD DEF C.BIN WBP0 DEF WBUF DEF RECLN JMP WERR WRITE ERROR REPORT IT * JMP .WRIT,I SPC 2 RECLN NOP BFLG NOP # 0 IF BINARY TO BE PRODUCED K2. DEC 2 KK601 OCT 60100 K4 DEC 4 DLBUF DEF LBUF BASE ADDRESS OF LIST BUFFER KK120 OCT 120000 RLOC NOP SLBUF NOP ADDR OF 1ST WORD IN LIST OUTPUT PTR NOP POINTER WORD NOP NUMBER OF ENTRIES SPC 2 * ************************* * * FINISH DBL PROCESSING * * ************************* SPC 1 END. LDA CCW IF PRINTING LDB ASA AND PROGRAM ENDS2E IN SLA A BSS CPB F.RPL SKIP TO DO FINAL BSS JMP END.. ONE OF THE ABOVE FALSE SKIP IT * JSB CLR1 CLEAR THE PRINT BUFFER JSB LAB.F MAKE A LABEL IF ONE MATCHES LDB DSBSS GET ADDRESS OF BSS JSB ACOD2 PUT IT IN THE BUFFER LDB ASA COMPUTE SIZE CMB,INB OF THE BSS ADB F.RPL JSB ASCI5 CONVERT TO THE BUFFER LDA "B" PUT THE FINAL JSB PUT.F "B" ON IT JSB LIST AND LIST IT END.. JSB TERM DUMP LAST DBL RECORD CLA SKIP A LINE JSB SKL.F ON THE LIST DEVICE LDA F.SFF IF BLOCK DATA SUB. PGM. CPA K2 THEN LDA K17 PRINT THE LDB DMBLM SIZE CPA K17 LINE JSB PSL.F LDA F.REL CONSTRUCT END RECORD STA WBP3,I XFER ADDR OR NOT, THIS IS IT. LDB F.SFF GET THE BLOCK DATA FLAG CLA CPB K2 IF SET CCA,RSS DO NOT SET THE XFER ADDRESS CPA F.SBF IF F.SBF=0, MAIN PROGRAM; INA SET TRANSFER ADDRESS INDICATOR. ADA KK120 RECORD IDENT = 101 IN BITS 15-13. STA WBP1,I LDA K4 JSB .WRIT WRITE END RECORD LDA BFLG ARE WE MAKING A BINARY? SZA,RSS WELL?? JMP SYMBL NO SKIP THE EOF * JSB WRT.C SEND SUB FILE MARK DEF C.BIN BINARY FCB DEF WBUF DEF ZERO JMP WERR BINARY WRITE ERROR * SKP SYMBL LDA COMCO GET THE COMMON COUNT INA INCREMENT IT LDB F.SFF IF CPB K2 BLOCK DATA SUBPROGRAM JMP NEWBL GO PROCESS THE NEXT BLOCK * SYTBM JSB EJP.F LDA F.CCW AND B30 IF SYMBOL TABLE OR XREF LDB K3 THEN GET S.T. & X-REF SEGMENT NO. SZA,RSS WELL? INB NO STEP TO INIT SEG JMP F.SEG GO GET THE SEGMENT SPC 2 B30 OCT 30 * * 3 *********************** * * OUTPUT LIST ROUTINE * * *********************** SPC 1 LIST NOP LDA SLBUF LDB A CMA,CCE,INA SET NEG. ELA DOUBLE AND ADD ONE OF ODD CHAR. ADA ASSLC CHAR COUNT +1 ARS FORM WORD COUNT JSB PSL.F PRINT IT. JMP LIST,I SPC 2 * * * CLEAR LIST BUFFER * SPC 1 CLR1 NOP LDA BLNKS 2 BLANKS LDB SLBUF SBBB STA B,I INB ADVANCE POINTER CPB LAST BUFFER ENDED? JMP CLR1,I JMP SBBB NO. * LAST DEF LBUF+41 PTR TO NEXT AFTER LAST OF LBUF SKP * ** DATA TO OCTAL ASCII CONVERSION ** SPC 1 * CALLING SEQUENCE: LDB (DATA WORD) * LDA (ADDRESS AT START OF STORAGE) * JSB ASCI6 SPC 1 ASCI6 NOP OUTPUT 6 DIGITS STA ASSLC SET THE ADDRESS LDA KM6 GET NO. OF DIGITS TO CONVERT RBL MOVE FIRST DIGIT TO LOW B JSB NUM.F CONVERT THE NUMBER JMP ASCI6,I RETURN SPC 2 ASCI5 NOP 5 DIGITS & BLANK LDA KM5 GET NO OF DIGITS TO CONVERT BLF POSITION FIRST DIGIT JSB NUM.F CONVERT THE NUMBER JMP ASCI5,I RETURN * * *********************************** * * CONVERT DIGITS TO ASCII BASE 8 * * *********************************** * * NUM.F NOP STA T1NUM SAVE THE DIGIT COUNT CPA KM6 IF 6 THEN CLA,INA,RSS USE 1 AS A MASK FOR FIRST DIGIT NUM00 LDA K7 ELSE USE 7 AND B ISOLATE THE DIGIT ADA "0" ADD 60 TO MAKE ASCII JSB PUT.F PUT IN THE BUFFER BLF,RBR POSITION THE NEXT DIGIT ISZ T1NUM DONE? JMP NUM00 NO DO NEXT DIGIT * JMP NUM.F,I YES RETURN * T1NUM NOP KM6 DEC -6 * SPC 2 * * r ******************************** * * PUT CHARACTER IN LIST BUFFER * * ******************************** * PUT.F NOP STB T1PUT SAVE B LDB ASSLC GET CURRENT BUFFER ADDRESS AND B177 ISOLATE THE CHARACTER CLE,ERB WORD ADDRESS TO B E=UPPER,LOWER FLAG SEZ,RSS IF UPPER CHAR ALF,SLA,ALF POSITION AND SKIP XOR B,I INCLUSION OF HIGHER CHAR. XOR B40 ADD,TAKE AWAY LOWER BLANK STA B,I SET THE WORD DOWN ISZ ASSLC STEP THE CHAR ADDRESS LDB T1PUT RESTORE B JMP PUT.F,I RETURN * T1PUT NOP ASCIM OCT 177440 SKP * ************************* * 2ND PASS TABLES & BUFFERS * ************************* SPC 1 * ** MACHINE LANGUAGE INSTRUCTION TABLE ** SPC 1 MLITB OCT -1,42000,62000,66000,72000,76000,12000,32000 OCT 22000,52000,26000,16000 DEF 0,I OCT -1 DEF 1,I OCT -1 CMA,INA OCT -1 SSB STA B,I OCT -1 STB A,I OCT -1 LDA B,I OCT -1 SSA,RSS OCT -1 CMA,SSA,INA,SZA,RSS OCT -1,-1 SZA,RSS OCT -1 CLB CLB,INB OCT -1 SSA LDA 0,I OCT -1 JMP 0,I OCT -1 CMB CMA CLA,RSS OCT -1 CCA,RSS RSS CLA CCA SZA CLA,INA OCT -1 ALS,ALS ALS ZERO NOP SPC 1 * ** ASSEMBLY AND PSEUDO-INSTRUCTION SYMBOL TABLE ** SPC 1 SYOCT ASC 1,OC OCT 152040 SYASC ASC 2,ASC OCT 130454 SYBSS ASC 1,BS OCT 151440 SYORG ASC 1,OR OCT 143440 SYMT2 ASC 1,DE OCT 143040 ASC 1,AD OCT 140440 ASC 1,LD OCT 140440 ASC 1,LD OCT 141040 ASC 1,ST OCT 140440 ASC 1,ST OCT 141040 LDB ASC 1,AN e OCT 142040 ASC 1,IO OCT 151040 ASC 1,XO OCT 151040 ASC 1,CP OCT 140440 ASC 1,JM OCT 150040 ASC 1,JS OCT 141040 ASC 3,DEF 0, OCT 144440 ASC 3,DEF 1, OCT 144440 DEF 1,I ASC 3,CMA,IN OCT 140440 ASC 1,SS OCT 141040 ASC 3,STA 1, OCT 144440 ASC 3,STB 0, OCT 144440 ASC 3,LDA 1, OCT 144440 ASC 3,SSA,RS OCT 151440 ASC 9,CMA,SSA,INA,SZA,RS OCT 151440 ASC 1,CL OCT 141040 ASC 3,CLB,IN OCT 141040 ASC 1,SS OCT 140440 ASC 3,LDA 0, OCT 144440 ASC 3,JMP 0, OCT 144440 ASC 1,CM OCT 141040 ASC 1,CM OCT 140440 ASC 3,CLA,RS OCT 151440 ASC 3,CCA,RS OCT 151440 ASC 1,CL OCT 140440 ASC 1,CC OCT 140440 ASC 1,SZ OCT 140440 ASC 3,CLA,IN OCT 140440 ASC 3,ALS,AL OCT 151440 ASC 1,NO OCT 150040 SKP * ** EXTERNAL FUNCTION SYMBOL TABLE ** SPC 1 TWO EQU 2 SYMCL EQU 3 WORD LENGTH OF THE FOLLOWING SYMBOLS * EXTST ASC 18,.FMP .FDV .FAD .FSB ..FCM .MPY .DTOI EQU *+SYMCL+SYMCL+SYMCL RTODX EQU *+SYMCL+SYMCL+SYMCL+SYMCL+TWO ASC 18,.DIV .DLD .DST .DTOI .RTOD .DTOR DTODX EQU *+TWO ASC 18,.DTOD .ITOI .RTOI .RTOR .XADD .XSUB ASC 18,.XMPY .XDIV .CADD .CSUB .CMPY .CDIV .DIO. EQU *+SYMCL+SYMCL+SYMCL+SYMCL ASC 18,.DFER .CFER ..MAP .ENTR .DIO. .BIO. ASC 18,.XIO. .RIO. .IIO. .XAY. .RAY. .IAY. CDBLX EQU *+SYMCL+SYMCL+SYMCL+SYMCL+1 .DCMX EQU *+SYMCL+SYMCL+SYMCL+SYMCL+SYMCL+1 .DTA. ASC 18,.DTA. .PAUS .STOP .TAPE .CDBL ..DCM IDBLX EQU *+SYMCL+SYMCL+1 ASC 18,..CCM .CTOI .IDBL .ICPX .DCPX .DINT ASC 18,.CINT .GOTO .BAD. .EMAP .XAE. .RAE. ASC 3,.IAE. * NO.F EQU 55 NUMBER OF ENTRIES IN ABOVE TABLE SPC HB@<1 * ** MODE OF TEMP CELL TABLE ** SPC 1 MODT NOP ASC 7,I.R.L.T.C.D.A. LBUF ASC 1, BSS 46 LIST BUFFER RBUF BSS 128 READ BUFFER WBUF BSS 60 WRITE BUFFER ORG * END F4.5 B ' 92061-18001 1634 S C0822 RTE MICORASSEMBLER              H0108 {ASMB,R,L,C HED RTE MICRO-ASSEMBLER -- PASS 1 NAM MICRO,3 RTE MICRO 92061-16001 REV.A 760818 SUP * * * ********************************************************* * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. * * * * * * THIS PROGRAM MAY BE USED WITH ONE COMPUTER SYSTEM AT * * * A TIME AND SHALL NOT OTHERWISE BE RECORDED, * * * TRANSMITTED OR STORED IN A RETRIEVAL SYSTEM. COPYING * * * OR OTHER REPRODUCTION OF THIS PROGRAM EXCEPT FOR * * * ARCHIVAL PURPOSES IS PROHIBITED WITHOUT THE PRIOR * * * WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * ********************************************************* * * HEADR ASC 15,PAGE .... RTE MICRO-ASSEMBLER ASC 6,REV.A 760818 BSS 15 * EXT EXEC,%WRIN,%WRIS,%WEOF,%READ EXT RMPAR,PURGE,CREAT,CLOSE,WRITF * * ****************************** * * PASS 1 STARTS HERE. * * HERE WE GET THE PARAMETERS, IF ANY, FROM THE * USER'S RUN COMMAND: * :RU,MICRO,,,,, * A "99" IS TREATED THE SAME AS NO SPECIFICATION... * COMPATIBLE WITH OTHER TRANSLATORS (ALTHO WE DO NOT * ASSEMBLE TO THE LG TRACKS). * MICRO NOP JSB RMPAR COLLECT :RU PARAMS DEF *+2 DEF PARMS+1 LDA PARMS+1 DEBUGGING? CMA,SSA,INA JMP D1 NO STA PARMS+1 ISZ DDT? JSB DDT D1 LDB PARMS JSB GETLU JMP D1.1 DEFAULT CPA =D2 JMP *+2 IOR =B400 SET ECHOPLEX IF NON-DISC (TTY) STA RDR D1.1 JSB GETLU JMP D2 DEFAULT STA LIST IOR =B200 HONESTY & ASCII MODE WITH CRLF STA PRCTL LDA =B1100 IOR LIST STA SPCTL D2 JSB GETLU JMP D3 DEFAULT STA PNCH IOR =B1000 STA PNCTL D3 INB LDA B,I  SZA CPA =D99 JMP D3.1 DEFAULT CMA -((LPP-3)+1): REMAINING STA LINE3 LINES+1 AFTER HEADER D3.1 JSB GETLU JMP D4 DEFAULT STA CONSL D4 JSB EJECT PRINT HEADER JSB EXEC SWAP WHOLE DISC PARTITION DEF *+3 DEF .22 DEF .3 JSB OPSYS GET FWA DEC 1 STA @SYMB STA @SYMT ADA =D4 STA @VAL INA STA @TAG JSB OPSYS GET LWA DEC 2 CMA STA LWA -LWA-1 LDA RDR INPUT FROM LS? CPA =D2 JMP INIT0 YES. JSB EOT RESET EOT CONDITION JSB %WRIN TRY TO GET WORK TRACKS JMP INIT1 CAN'T GET TRACKS STA LSTRK RTNS (15:8)=LU, (7:8)=TRK # CLA,INA SET "TRACKS AVAIL" FLAG STA LUN JMP INIT1 INIT0 JSB OPSYS LOGICAL SOURCE (LS) TRACK DEC 3 STA LSTRK SZA IS THERE ONE? JMP INIT1 YES, SO OK. LDA ERR20 JSB ERROR JMP ABORT * * INPUT AND EXAMINE A RECORD. * INIT1 JSB MIC GET MICMX OR MICMXE COMMAND INPUT JSB LSTR? LIST PRIOR LINE IF ERROR ISZ LINE# JSB RDCRD READ CARD LDB @FLD1 EXAMINE 1ST BYTE JSB LOADB CPA ASTER =*? JMP INPUT YES, IGNORE. CPA "$" =$? JMP CNTRL CONTROL STATE. LDA =D10 CHECK FOR EQU,ORG,ALGN LDB @FLD2 JSB $SRCH SSA JMP INP0 NOT PSEUDO-OP AND =B77 ADA *+2 JMP A,I DEF *,I ONE-ORIGINED BRANCH TABLE DEF INP4 EQU STMT DEF INP0 DEF STMT DEF INP0 ONES STMT DEF INP0 ZERO STMT DEF INP3 ALGN STMT DEF INP2 ORG STMT DEF END1 END STMT * * NORMAL STATEMENT. PROCESS LABEL IF ANY * INP0 JSB ORGD? ENSURE WE HAVE AN ORIGIN JSB LBL? JMP INP1 LDA PCNTR ENTER INTjrO SYMTAB CLE NON-EQU LABEL JSB SYMAD INP1 JSB POVF? LDA PCNTR INA JSB SETP JMP INPUT * * ORG STATEMENT * INP2 LDA @FLD2 DISALLOW LABEL LDB @FLD1 JSB BLNK? JMP *+2 LABEL PRESENT JMP INP21 LDA ERR24 JSB ERROR INP21 JSB ORIG JMP BAD.3 JMP INPUT * * ALGN STATEMENT * INP3 LDA @FLD2 DISALLOW LABEL LDB @FLD1 JSB BLNK? JMP *+2 LABEL PRESENT JMP INP31 LDA ERR24 JSB ERROR INP31 JSB ORGD? ENSURE WE HAVE ORIGIN JSB ALGN JMP INPUT * * EQU STATEMENT * INP4 LDA @FLD6 FIND ADDR EXPRESSION LDB @FLD3 JSB BLNK? NOP JSB NUM (CHECKED IN NUM) SOC JMP BAD.2 STA SAVA SAVE EXPR VALUE JSB LBL? JMP INPUT LDA SAVA RESTORE EXPR VALUE CCE EQU FLAG JSB SYMAD JMP INPUT * * CONTROL CARD PROCESSOR * B= BPTR TO COMMAND * CNTRL JSB PSRCH DBL CTBL DEC 10 CPA =D7 $CODE COMMAND? JMP FDESG YES SZA JMP INPUT NO: IGNORE COMMAND IN PASS1 * * BAD CONTROL STATEMENT OR PSEUDO-OP * BAD LDA ERR18 BAD COMMAND JMP *+2 BAD.2 LDA ERR19 BAD LABEL EXPRESSION BAD.3 JSB ERROR JMP INPUT * * PARSE $CODE PARAMETERS AS FOLLOWS: * $CODE=FNAME[:[SECURITY][:[CRLABEL]]][,REPLACE] * * WE DO NOT EMBEDDED BLANKS ANYWHERE. FILENAME SYNTAX * IS NOT CHECKED HERE...WE LET RTE DO THAT. EXTRA * CHARACTERS AFTER FIRST SIX ARE IGNORED. * * NOTE: B= BYTE POINTER TO CHARACTER FOLLOWING "=". * FDESG LDA CODE? DUPLICATE $CODE? SZA JMP $CERR YES: IGNORE THIS ISZ CODE? LDA =D-6 STA COUNT LDA @FNAM RAL STA @DEST JSB EOS? A=NEXT CHAR JMP F.ERR MISSING SUBPARAMETER F.NXT STB @INP MOVE FILENAME INTO "FNAME" LDB @DEST d JSB STORB STB @DEST LDB @INP JSB EOS? A=NEXT CHAR JMP SEC END OF SUBPARAMETER ISZ COUNT JMP F.NXT F.SKP JSB EOS? SKIP EXTRA CHARS JMP SEC JMP F.SKP * * SCAN SECURITY AND CR-LABEL CODES AND "REPLACE". * * NOTE: B= BYTE POINTER TO FIRST CHARACTER. * SEC CPA COLON CHECK FOR ":[SECURITY]" JMP *+2 JMP REPL JSB SUBP EVALUATE SECURITY DEF FSEC CPA COLON CHECK FOR ":[CRLABEL]" JMP *+2 JMP REPL JSB SUBP EVALUATE CR-LABEL DEF FCR REPL CPA BLNK CHECK FOR ",REPLACE" JMP F.FIN CPA COMMA JMP *+2 JMP F.ERR STB @INP LDA @REP JSB CMPB COMPARE ON "REPLACE" DEC 7 SZB,RSS ANY SUBSTRING MATCHED? JMP BAD NO: NO MATCH AT ALL ADB @INP YES: COMPUTE BPTR TO NEXT CHAR JSB LOADB TERMINATED BY BLANK? CPA BLNK JMP *+2 YES: ACCEPT SUBSTR OF "REPLACE" JMP BAD NO: BAD OPTION ISZ REP? SET REPLACE FLAG F.FIN ISZ FILE $CODE IS OK ISZ FILE? JMP INPUT F.ERR LDA ERR14 BAD SUBPARAMETER JMP *+2 $CERR LDA ERR32 DUPLICATE $CODE JSB ERROR JMP INPUT @REP DBL *+1 ASC 4,REPLACE * * ****************************** * * END STATEMENT * END1 LDA LUN YES, 'END'. IF WRITING SZA SOURCE ON DISC, WRITE JSB %WEOF END-OF-FILE. LDA SYFLG SYMBOL TABLE SZA,RSS WANTED? JMP PASS2 NO, SO GO TO PASS 2. LDA @SYMT YES. GET STA PNTR START OF TABLE CPA @SYMB END? JMP PASS2 YES. GO TO PASS2. LDA ANYER PAGE EJECT IF ERROR SZA JSB EJECT LDA =D2 JSB SPACE LDA =D-12 JSB PRINT DEF HED1 LDA =D2 JSB SPACE PR1 LDA =D9 FILL THE PERTINENT PART OF LDB @CoARD ASCII OUTPUT BUFFER WITH JSB CLEAN SPACES. ASC 1, * NOW WE STORE THE SYMBOL (LABEL) IN THE * INPUT BUFFER, WHICH WE ARE USING AS PART OF OUR * ASCII OUTPUT BUFFER. LDA PNTR,I STA CARD ISZ PNTR LDA PNTR,I STA CARD+1 ISZ PNTR LDA PNTR,I STA CARD+2 ISZ PNTR LDA PNTR,I STA CARD+3 * NOW PICK UP OCTAL LOCATION (IE., VALUE) OF SYMBOL. ISZ PNTR LDA PNTR,I ISZ PNTR * CONVERT TO ASCII AND STORE IN * NEXT LOCATION IN OUTPUT BUFFER. LDB @FLD1 ADB =D15 STB SAVB SAVE BYTE ADDRESS. JSB OCTAL DEC 6 LDA BLNK LDB PNTR,I PICK UP TAG SZB LDA "X" APPEND "X" FOR EXTERNAL (EQU) LDB SAVB GET BYTE ADDR OF VALUE. INB INC PAST VALUE JSB STORB STORE SPACE OR 'X' THERE. LDA BLNK2 STA CARD-1 LDA =D-18 JSB PRINT DEF CARD ISZ PNTR POINT LDA PNTR TO CPA @SYMB NEXT ENTRY. END? JMP *+2 JMP PR1 NO, GO DO NEXT. HED RTE MICRO-ASSEMBLER -- PASS 2 * * PASS 2 STARTS HERE. * * * * INITIALIZATION FOR PASS 2. * PASS2 JSB FINI PRINT END-PASS-1 MSG LDA FILE? OUTPUT TO FILE? SZA,RSS JMP OK NO. * * ATTEMPT TO OPEN $CODE * LDA FMT SET FILE TYPE & BLOCK SIZE SZA,RSS TO 3 & 13*128 FOR S-FORMAT JMP ALLOC LDA =D3 STA FTYPE LDA =D13 STA FSIZE ALLOC LDA @SYMB ALLOCATE DCB ABOVE SYMTAB STA @DCB ADA =D144 ADA LWA SSA @DCB+144>=LWA+1? JMP TRY LDA ERR12 NO: NO ROOM FOR BUFFER JMP NGOOD * TRY JSB CREAT DEF *+8 DEF @DCB,I DEF FMGR DEF FNAME DEF FSIZE DEF FTYPE DEF FSEC DEF FCR SSA,RSS JMP OK * PURGE OLD SO DESIRED LDB REP? CPA =D-2 DUPLICATE NAME? SZB,RSS "REPLACE" SPEC'D? JMP NOOP CLB YES: PURGE OLD STB REP? PREVENT 2ND RETRY JSB PURGE DEF *+6 DEF @DCB,I DEF FMGR DEF FNAME DEF FSEC DEF FCR SSA,RSS JMP TRY * FAILED TO BUILD FILE NOOP LDA ERR13 BUILD FAILED NGOOD JSB ERROR CLA IGNORE $CODE STA FILE STA FILE? * * INITIALIZE FLAGS, COUNTERS, ETC, FOR 2ND PASS. * GENERATE LEADER. * OK LDA BASE RESET ORIGINAL ORG STA PCNTR ISZ PASS# CLA STA LINE# LDA =D2 LDB LUN RE-USE LS TRACKS? SZB,RSS CPA RDR JMP P20 YES. JSB RLOAD RELOAD SOURCE JMP P20.1 GO READ INPUT. P20 STA RDR FORCES READ FROM DISC LDA LSTRK CLB STB LUN PREVENTS WRITE TO LS AFTER READ JSB %RDSC RESET LS STARTING TRACK # * * READ A SOURCE RECORD. * P20.1 JSB EJCT? JSB MIC P21 ISZ LINE# JSB RDCRD READ CARD LDB @FLD1 NO. CHECK JSB LOADB BYTE. CPA ASTER =*? JMP P21A YES,IGNORE BUT PRINT CPA "$" =$? JMP *+2 JMP P21C NO, GOOD CODE. JSB PSRCH DBL CTBL DEC 10 ADA *+2 JMP A,I DEF *+1,I ZERO-OPIGINED JUMP TABLE DEF P21A ERROR: IGNORE IN PASS2 DEF $PAGE DEF $TITL $PAGE= DEF $LST DEF $NOLS DEF $PNCH DEF $NOPN DEF P21A $CODE * * * $PAGE= AND $PAGE * $TITL LDA =D-60 STA COUNT MAX CHAR COUNT LDA @HFD2 STA @DEST P.GET JSB LOADB MOVE TITLE INTO HEADER SZA,RSS JMP P.EOL END OF LINE STB @INP LDB @DEST JSB STORB STB @DEST LDB @INP ISZ COUNT JMP P.GET * P.EOL LDA COUNT ADA =D62 CMA,INA TSTA COUNT - NUMBER OF CHARS JMP DBLK0 DBLNK ISZ COUNT IGNORE TRAILING BLANKS JMP *+2 JMP DBLK1 DBLK0 ADB =D-2 JSB LOADB CPA BLNK JMP DBLNK DBLK1 LDA COUNT ADA =D-10 ADD LENGTH OF FIXED PORTION STA HSIZE = BYTE LENGTH OF HEADER * $PAGE JSB EJCT? JMP P21 DON'T LIST COMMAND * * $NOLIST: LIST RECORD, THEN TURN OFF LISTING * $NOLS CLA JSB LSTR2 CLA STA LIST? JMP P21 * * $NOPUNCH: TURN OFF PUNCHING * $NOPN CLA STA PNCH? STA FILE? JMP P21A * * $LIST: TURN ON LISTING * $LST JSB $LIST ENABLE LISTING JMP P21A * * $PUNCH: TURN ON PUNCHING AND SET LEADER FLAG * $PNCH LDA PNCH STA PNCH? LDA FILE STA FILE? * P21A CLA LIST WITHOUT CODE JSB LSTR2 JMP P21 GO BACK. * * DETERMINE STATEMENT TYPE. * P21C LDB @FLD2 GET FIELD 2 STARTING BYTE ADR. CLA,INA GO GET AN JSB $SRCH 'OPCODE' BINARY OPCODE. SSA,RSS BAD CODE? JMP P21D NO. LDA ERR2 YES. OUTPUT JSB ERROR MESSAGE. JSB DEFLT DEC 1 P21D STA OPTKN AND =B77 ISOLATE OPCODE STA FLD2 LDA OPTKN ISOLATE INSTR TYPE AND =B170000 ALF ADA *+2 JMP A,I DEF *+1,I ZERO-ORIGINED BRANCH TABLE DEF P21E DEF TYPE1 DEF TYPE2 DEF TYPE3 DEF TYPE4 DEF TYPE0 * * DISTINGUISH TYPE3 & TYPE4 BY "CNDX" * P21E LDA =D2 GET SPECIAL FIELD LDB =D3 JSB CODE LDA FLD3 ALF,RAR CMA,SSA,SLA BIT 12 OR 13 SET? JMP TYP3A NO: WORD-TYPE-3 SPECIAL (CNDX) LDA OPTKN CPA RTN JMP TYP1A JMP TYP4A * * ****************************** 0.**0* * * PROCESS PSEUDO-OPS * TYPE0 LDA FLD2 ADA *+2 JMP A,I DEF *,I ONE-ORIGINED BRANCH TABLE DEF TY0.3 IGNORE EQU THIS PASS DEF DEFST DEF ONEST DEF ZERST DEF ALNST DEF ORGST DEF END2 * * ZERO STATEMENT * ZERST CLA STA INST1 JMP TY0.2 * * DEF STATEMENT * DEFST LDA @FLD6 FIND EXPRESSION LDB @FLD3 JSB BLNK? NOP JSB NUM SOS JMP TY0.1 LDA ERR19 JSB ERROR CLA TY0.1 STA INST1 CLA JMP TY0.2 * * ONES STATEMENT * ONEST CCB STB INST1 LDA =B377 * TY0.2 STA INST2 JSB OUTPT JMP P21 * * ALGN STATEMENT * ALNST JSB ALGN JMP TY0.3 * * ORG STATEMENT * ORGST JSB ORIG NOP * TY0.3 CLA JSB LSTR2 LIST WITHOUT CODE JMP P21 * * ****************************** * * * CREATE A WORD TYPE 1 INSTRUCTION. * * FIRST, CHECK MNEMONICS AND COLLECT THE BINARY * CODES FOR EACH FIELD. * TYPE1 LDA =D2 GO GET A 'SPECIAL' CODE LDB =D3 FROM FIELD 3. JSB CODE LDA FLD3 ALF,SLA ALLOWED IN TYPE-1 INSTRUCTION? JMP TYP1A YES. LDA ERR16 PRINT ERROR MESSAGE. JSB ERROR JSB DEFLT DEC 2 STA FLD3 TYP1A LDA =D4 GO GET AN 'ALU' CODE LDB =D4 FROM FIELD 4. JSB CODE LDA =D6 GO GET A 'STORE' CODE LDB =D5 FROM FIELD 5. JSB CODE LDA =D7 GO GET AN 'S-BUS' CODE LDB =D6 FROM FIELD 6. JSB CODE * * NOW PUT TOGETHER THE FIELDS OF THE TYPE 1 WORD. * LDB FLD3 SPECIAL FIELD LSR 5 LDB FLD5 STORE FIELD LSR 5 LDB FLD6 SBUS FIELD LSR 5 LDB FLD4 ALU FIELD LSR 1 JMP EMIT1 * * ****************************** * * * CREATE A WORD TYPE 2 INSTRUCTION. `* FIRST, CHECK MNEMONICS AND COLLECT BINARY CODES * FOR EACH FIELD. * TYPE2 LDA =D2 GET A 'SPECIAL' CODE LDB =D3 FROM FIELD 3. JSB CODE LDA FLD3 ALF,SLA ALLOWED IN TYPE-2 INSTRUCTION? JMP TY2.0 YES. LDA ERR16 JSB ERROR JSB DEFLT DEC 2 STA FLD3 TY2.0 LDA =D5 GO GET AN MODIFIER CODE LDB =D4 FROM FIELD 4. JSB CODE LDA =D6 GO GET A 'STORE' CODE LDB =D5 FROM FIELD 5. JSB CODE LDB @FLD6 GET FLD 6 STARTING BYTE ADDRESS. JSB NUM CONVERT FIELD TO BINARY. SOS ANY PROBLEMS? JMP TY2.2 NO. TY2.1 LDA ERR11 PRINT ERROR MESSAGE. JSB ERROR CLA MAKE FIELD 6 = 0. TY2.2 STA FLD6 AND =B177400 IS # 8 BITS OR LESS? SZA JMP TY2.1 NO, SO ERROR. * * NOW PUT TOGETHER THE FIELDS OF THE TYPE 2 WORD. * LDB FLD3 SPECIAL FIELD LSR 5 LDB FLD5 STORE FIELD LSR 5 LDB FLD6 OPND FIELD LSR 6 STA INST1 CLA LSR 2 HI BITS OF OPND IOR FLD4 MODIFIER RAR,RAR JMP EMIT2 * * ****************************** * * * CREATE A WORD TYPE 3 INSTRUCTION. * FIRST, CHECK MNEMONICS AND COLLECT BINARY CODES. * TYPE3 LDA =D2 GET SPECIAL FIELD LDB =D3 JSB CODE LDA FLD3 ALF,RAR CMA,SSA,SLA BIT 12 OR 13 SET? JMP TYP3A NO: WORD-TYPE-3 SPECIAL LDA ERR15 JSB ERROR JSB DEFLT DEC 2 STA FLD3 TYP3A LDA =D3 GO GET A 'CONDITION' CODE LDB =D4 FROM FIELD 4. JSB CODE LDA =D9 GET SENSE CODE (STORE FIELD) LDB =D5 FROM FIELD 5 JSB CODE LDA OPTKN CPA RTN JMP TY3.4 LDB @FLD6 GET ADDRESS FIELD JSB NUM SOS JMP TY3.2 LDA ERR19 TY3.0 JSB ERROR LLDA PCNTR DEFAULT TO ADDR 0 IN CURRENT BLK INA OR BLK+1 IF PCNTR=XXX777 AND =B177000 TY3.2 STA FLD6 LDB PCNTR IS IT IN SAME BLK OR INB BLK+1 IF PCNTR=XXX777 XOR B AND =B177000 SZA,RSS JMP TY3.3 YES LDA ERR23 OUT OF RANGE IN FIELD 6 JMP TY3.0 TY3.4 LDB @FLD6 ENSURE: NO EXPR FOR RTN OP JSB LOADB CPA BLNK JMP TY3.3 LDA ERR33 EXPR NOT ALLOWED JMP TY3.0 * * NOW PUT TOGETHER FIELDS OF TYPE 3 WORD * TY3.3 LDB FLD3 SPECIAL FIELD LSR 5 LDB FLD6 OPND FIELD LSR 9 MODULO 512 IOR FLD5 RJS SENSE RAR LDB FLD4 CONDITION FIELD LSR 1 JMP EMIT1 * * ****************************** * * * CREATE A WORD TYPE 4 INSTRUCTION. * WE ALREADY HAVE CODES FROM FIELDS 2 AND 3. * TYPE4 LDA =D8 LDB =D3 JSB CODE TYP4A LDA FLD3 GET SPECIAL FIELD LDB MX? CPA SPBLK+1 MX BLANK? SZB,RSS JMP TY4.3 LDA UNCD YES: CHANGE TO UNCD STA FLD3 TY4.3 ALF,RAR SLA BIT 13 SET? JMP TY4.0 YES: WORD-TYPE-4 SPECIAL LDA ERR17 JSB ERROR JSB DEFLT DEC 8 STA FLD3 TY4.0 LDA @FLD6 ENSURE: EMPTY FIELDS 4 & 5 LDB @FLD4 JSB BLNK? JMP *+2 JMP TY4.4 YES: B=@FLD6 LDA ERR25 JSB ERROR LDB @FLD6 TY4.4 JSB NUM SOS JMP TY4.1 LDA ERR19 JSB ERROR CLA DEFAULT TO 0 TY4.1 STA FLD6 AND MXAD1 SZA,RSS JMP TY4.2 XOR FLD6 MODULO MAX ADDR STA FLD6 LDA ERR23 OUT OF RANGE IN FIELD 6 JSB ERROR * * NOW PUT TOGETHER THE FIELDS OF THE TYPE 4 WORD. * TY4.2 LDB FLD3 LSR 5 LDB FLD6 LSR 11 EMIT1 STA INST1 CLA LSR 4 EMIT2 IOR FLD2 ALF STA INST2 JSB OUTPT h JMP P21 * * ****************************** * * * WE COME HERE AFTER READING AN '$END' RECORD * IN PASS 2. * END2 JSB $LIST ENABLE LISTING CLA LIST $END IF NOT OURS LDB NOEND SZB,RSS JSB LSTR2 JSB DONE CLEAN UP LDB =D-12 WRITE CONSOLE END MSG LDA ANYER SZA LDB =D-24 LDA CONSL JSB IOSUB DEC 2 OCT 200 HONESTY & ASCII MODES WITH CRLF DEF ENDMS LDA XREF? CROSS-REF OPTION? SZA,RSS JMP STOP JSB XREF YES: SCHEDULE MXREF JMP STOPX SKIP PAGE EJECT (DONE BY MXREF) * * ABORT MICRO-ASSEMBLER * ABORT JSB DONE CLEAN UP LDA CONSL PRINT ABORT MSG LDB =D-16 JSB IOSUB OCT 2 OCT 200 HONESTY & ASCII MODES WITH CRLF DEF AEND STOP JSB PEJCT EJECT PAGE STOPX JSB RT RELEASE TRACKS JSB EXEC TERMINATE DEF *+2 DEF .6 HED RTE MICRO-ASSEMBLER -- SUBROUTINES SKP ****************************** * * A L G N * * ENTRY: * JSB ALGN * * EFFECTS THE "ALGN" PSEUDO-OP BY ADJUSTING * PCNTR TO A HEX BOUNDARY. NOTE THAT WE * DO NOT FLAG P-OVERFLOW HERE (ANALOGOUS * TO "ORG" PROCESSING). * ALGN NOP LDA PCNTR ADA =B17 AND =B177760 JSB SETP JMP ALGN,I * * ****************************** * * B L N K ? * * ENTRY: * LDA * LDB * JSB BLNK? * * * * EXIT: * B= BPTR TO CHAR FOLLOWING LAST BLANK * * SKIPS CONTIGUOUS BLANKS UP TO (BUT NOT INCLUDING) * CHAR POINTED TO IN A-REG. IF ALL BLANKS, RETURNS * TO "TRUE" EXIT...OTHERWISE, RETURNS TO "FALSE" EXIT. * BLNK? NOP STA BTMP LDA BLNK JSB SKIP SKIP ALL BLANKS LDA BTMP @NEXT>=LIMIT? CMA,INA ADA B SSA JMP BLNK?,I NO: B=B%PTR TO NEXT LDB BTMP YES: SET B=BPTR TO LAST+1 ISZ BLNK? JMP BLNK?,I BTMP BSS 1 * * ****************************** * * C L E A N * * 'CLEAN' FILLS A BUFFER WITH A GIVEN CHAR. * * CALLING SEQUENCE: * LDB * * LDA <+ NO. OF WORDS IN BUFFER> * * JSB CLEAN * ASC 1, * CLEAN NOP CMA,INA STA COUNT LDA CLEAN,I BRING IN CHAR. CLE0 STA B,I INB ISZ COUNT JMP CLE0 ISZ CLEAN SET RETURN ADDRESS. JMP CLEAN,I * * ****************************** * * C M P B * * ENTRY: * LDA * LDB * JSB CMPB * DEC * * EXIT: * A<0 -- LEFT < RIGHT * =0 -- LEFT = RIGHT * >0 -- LEFT > RIGHT * B= NUMBER OF EQUAL CHARACTERS * * COMPARISON OF TWO STRINGS. * CMPB NOP STA CBINP STB CBDST LDA CMPB,I COMPUTE -COUNT CMA,INA STA COUNT SZA,RSS CHECK FOR ZERO LENGTH JMP CMPB2 CMPB1 LDB CBINP GET CHAR FROM LEFT STRING JSB LOADB STB CBINP STA CLFT LDB CBDST GET CHAR FROM RIGHT STRING JSB LOADB STB CBDST CMA,INA LEFT >= RIGHT? ADA CLFT SZA JMP CMPB2 ISZ COUNT LEFT=RIGHT JMP CMPB1 CMPB2 LDB CMPB,I MAX - RESIDUAL = # EQUAL CHARS ADB COUNT ISZ CMPB SKIP COUNT JMP CMPB,I CBDST BSS 1 CBINP BSS 1 CLFT BSS 1 * * ****************************** * * C N V R T * * ASCII TO BINARY CONVERSION ROUTINE. * * CALLING SEQUENCE: * A REG SHOULD BE 0 IF STRING OF OCTAL * ASCII DIGITS IS TO BE CONVERTED TO BINARY; * #0 IF STRING OF DECIMAL ASCII DIGITS. * B REG SHOULD CONTAIN THE STARTING BYTE ADDRESS * OF THE STRING OF ASCII DIGITS TO BE * CONVERTED. L * JSB CNVRT * * ON RETURN RESULT IN A REG. * OVERFLOW SET ON ERROR * B= BPTR TO NEXT CHAR (EXCEPT WHEN OVERFLOW IS SET). * CNVRT NOP STB TMPC1 SAVE BYTE ADDRESS LDB =D8 PUT OCTAL BASE IN B. SZA WAMT DECIMAL? LDB =D10 YES, PUT DECIMAL BASE INB. STB TMPC2 SAVE BASE. CLA CLEAR TEMPORARY STA TMPC3 STA CFLG CN1 LDB TMPC1 LOAD JSB LOADB BYTE. ADA =D-48 VALUE OF BYTE SSA <@60? JMP CN4 YES STA TMPC4 NO,SAVE BYTE. LDA TMPC2 IS CMA,INA BUTE ADA TMPC4 NON LEGAL SSA,RSS DIGIT? JMP CN4 YES LDA TMPC3 COMPUTE NEXT MPY TMPC2 TEMPORARY RESULT. SZB OVERFLOW? JMP CN2 YES CLO NO, CLEAR O-BIT. ADA TMPC4 ADD IN NEW DIGIT SOC OVERFLOW? JMP CNVRT,I YES RETURN STA TMPC3 SAVE INTERMEDIATE RESULT ISZ CFLG SET GOOD DIGIT FLAG. ISZ TMPC1 BUMP BYTE ADDRESS. JMP CN1 CN4 LDA CFLG ILLEGAL DIGIT FOUND LDB TMPC1 PUT BYTE ADDRESS IN B SZA,RSS DID WE GET ANYTHING? STO NO, SET ERROR CONDITION LDA TMPC3 PUT RESILT IN A-REG JMP CNVRT,I CN2 STO OVERFLOW JMP CNVRT,I * * ****************************** * * C O D E * * "CODE" OBTAINS THE BINARY CODE EQUIVALENT FOR * THE MNEMONIC IN A GIVEN FIELD, AND STORES IT IN * THE APPROPRIATE FIELD STORAGE LOCATION, EG. "FLD1", ETC. * IT PRINTS AN ERROR MESSAGE IF THE MNEMONIC WAS INVALID. * * CALLING SEQUENCE: * LDA * LDB * JSB CODE * * CALLED FOR TYPES 2 THROUGH 9. * UPON RETURN: THE CODE WILL BE IN THE FIELD STORAGE * LOCATION; A AND B REGS ARE NOT SIGNIFI:K*($CANT. * CODE NOP STA CSAVA STB CSAVB ADB @FADR GET STARTING BYTE ADDRESS OF LDB B,I FIELD. JSB $SRCH GO GET BINARY CODE. SSA JMP C06 LDB CSAVA MNEMONIC TYPE CPB =D6 JMP C01 CPB =D7 JMP *+2 JMP C07 * VERIFY THAT IT'S OK IN S-BUS FIELD LDB A BLF,SLB JMP C07 OK JMP C06 * VERIFY THAT IT'S OK IN STORE FIELD C01 LDB A BLF,RBR SLB JMP C07 OK C06 LDA CSAVA ADA CERR LDA A,I JSB ERROR PRINT ERROR MESSAGE. JSB DEFLT CSAVA BSS 1 TABLE TYPE C07 LDB CSAVB STORE CODE IN PROPER ADB @FLDS FIELD WORD. STA B,I JMP CODE,I CERR DEF *-1,I 2-ORIGINED TABLE DEF ERR3 DEF ERR4 DEF ERR5 DEF ERR6 DEF ERR7 DEF ERR8 DEF ERR3 DEF ERR9 * * ****************************** * * C O N ? * * ENTRY: * LDB * JSB CON? * * * * EXIT (OK EXIT): * A= VALUE * B= BPTR TO NEXT CHAR (AFTER NUMERIC STRING) * * ROUTINE CONVERTS A NUMERIC STRING OF THE FORM: * [+/-] [B] * CON? NOP CCA STA POS? JSB LOADB CPA MINUS ISZ POS? CLEAR FLAG & SKIP CPA PLUS JMP *+2 SKIP SIGN ADB =D-1 BACK-UP OVER FIRST CHAR JSB OCT? TRAILING "B"? JMP C.DEC NO n8* CLO YES: CONVERT B-FORM OCTAL JSB CNVRT SOC C JMP CON?,I INVALID NUMBER INB SKIP "B" JMP C.CV1 C.DEC CCA CONVERT DECIMAL VALUE CLO JSB CNVRT SOC C JMP CON?,I INVALID NUMBER C.CV1 STB CTMP SAVE POINTER LDB POS? CORRECT SIGN SZB,RSS CMA,INA POS?=0 ==> NEGATE LDB CTMP RESET B=BPTR TO NEXT CHAR ISZ CON? JMP CON?,I CTMP BSS 1 * * ******************** * * D D T * * ENTRY: * JSB DDT * * USE "Z" OPTION ON ASMB STATEMENT TO ACTIVATE * DEBUGGING CAPABILITY. OTHERWISE THIS ROUTINE * ACTS AS A NOP. NOTE THAT THE UTILIZE THE * SAME AMOUNT OF ADDRESS SPACE EITHER WAY... * THIS OBIATES THE NEED TO GET A LISTING WHEN * RECOMPILING TO ACTIVATE DEBUGGING. * DDT NOP DDT0 JMP DDT,I LDB =D-6 WRITE DDT MSG JSB IOSUB OCT 2 OCT 200 DEF DBMSG DDT1 NOP DEF *+1 JMP DDT,I DBMSG ASC 3,**DDT: IFZ EXT DBUG ORG DDT0 LDA CONSL ORG DDT1 JSB DBUG CALL DDT ORR XIF * * ****************************** * * D E C M L * * ENTRY: * LDA * LDB * JSB DECML * EXIT: * B= BYTE POINTER TO BYTE PRECEDING MOST-SIGNIFICANT * DIGIT * * ROUTINE CONVERTS NON-NEGATIVE NUMBER (IE., SIGN=0) * TO 4-DIGIT DECIMAL ASCII STRING * DECML NOP STA BINRY LDA =D-4 NUMBER OF DIGITS STA DGITS DEC0 STB @DEST CLB LDA BINRY DIV =D10 STA BINRY BINRY/10 LDA B BINRY MOD 10 ADA =B60 LDB @DEST JSB STORB ADB =D-2 BPTR TO NEXT MOST-SIG DIGIT ISZ DGITS JMP DEC0 JMP DECML,I * * ****************************** * * D E F L T * * ENTRY: * JSB DEFLT * DEC * 7* EXIT: * A= DEFAULT FIELD ENTRY FOR TABLE TYPE * * TABLE TYPE MUST BE ON [1,9] * DEFLT NOP LDA DEFLT,I ISZ DEFLT ADA @DFLT LDA A,I JMP DEFLT,I * @DFLT DEF *,I ONE-ORIGINED XE TABLE DEF OPBLK DEF SPBLK DEF ALZ DEF ALBLK DEF HIGH DEF STBLK DEF SBBLK DEF SPBLK DEF SNBLK @MXD DEF *,I ONE-ORIGINED MX TABLE DEF OPBLK+1 DEF SPBLK+1 DEF CDBLK+1 DEF ALBLK+1 DEF HIGH+1 DEF STBLK+1 DEF SBBLK+1 DEF UNCD DEF SNBLK+1 * * ****************************** * * D O N E * * ENTRY: * JSB DONE * * FOR PASS2 COMPLETION ONLY. DUMP CURRENT BUFFER AND * CLOSE OBJECT FILE. ALSO PRINT PASS-COMPLETION * MESSAGE. * DONE NOP ISZ END? LDA PNCH RESET PUNCH STATE STA PNCH? LDA FILE RESET FILE STATE LDB FMGR IGNORE IF FILE ERROR SZB,RSS STA FILE? JSB EMBUF DUMP RECORD & WRITE END RECORD LDA FILE CLOSE FILE IF OPEN SZA,RSS JMP DONE2 JSB CLOSE DEF *+4 DEF @DCB,I DEF FMGR DEF .0 DONE2 JSB FINI WRITE END-PASS MSG JMP DONE,I * * ****************************** * * E J E C T * E J C T ? * * ENTRY: * JSB EJECT -OR- JSB EJCT? * * EJECTS PAGE AND PRINTS HEADING. IF ENTRY IS THROUGH * EJCT?, WE IGNORE REQUEST IF LISTING IS NOT ENABLED. * WE DON'T PAGE EJECT IF WE ARE ALREADY POSITIONED AT * TOP OF FORM. * EJECT NOP LDA #LNS CPA LINE3 HAVE WE PUT TITLE OUT ALREADY? JMP EJECT,I YES: IGNORE REQUEST JSB PEJCT JSB TITLE JMP EJECT,I * * * EJCT? NOP LDA LIST? SZA,RSS JMP EJCT?,I LDA EJCT? STA EJECT JMP EJECT+1 * * ****************************** * * E M C D E * * ENTRY: * JSB EMCDE * * STUFFS MICROCODE INTO APPROPRIATE BUFFER FOR * BOTH RELOCATABLE AND SIMULATOR FORMATS. WE * BEWARE OF GAPS IN MICROCODE. IN THE CASE OF * RELOCATABLE FORMAT, THIS ENTAILS DUMPING THE * CURRENT BUFFER AND STARTING A NEW ONE (WITH A * NEW ORIGIN). FOR THE SIMULATOR, WE MUST PAD * BUFFER TO COMPLETE 48 MICROWORDS. * * NON-CONTIGUOUS CODE GROUPS (PCNTR<>LASTP+1) CAUSE * THE CURRENT BUFFER TO BE DUMPED (OR PADDED IN THE * CASE OF S-FORMAT). NOTE THAT THIS ALGORITHM ALSO * TAKES CARE OF INITIALIZING VIRGIN BUFFER (SINCE * LASTP=-2 INITIALLY). THIS MUST BE DONE HERE INSTEAD * OF AT THE BEGINNING OF PASS2 BECAUSE OF THE * POSSIBILITY OF CONSECUTIVE ORG'S INITIALLY (EITHER * VERBATUM OR DUE TO THE $NOPUNCH/$PUNCH FEATURE). * EMCDE NOP LDA FMT SZA JMP EC.S * * EMIT RELOCATABLE FORMAT. RECORD CONSISTS OF UP * TO 27 MICROWORDS. FORMAT IS AS FOLLOWS: * WORD1= RECORD LENGTH, SHIFTED INTO UPPER BYTE * WORD2= DBL IDENT, WITH BITS 7-6=01 AND BITS 5-0=0 * WORD3= CHECKSUM: SUM OF 16-BIT WORDS EXCLUDING * WORD1 AND WORD3 * WORD4= ORIGIN FOR RECORD * WORD5= MICRO/MDE FLAG (ZERO FOR MICRO) * WORD6= MICROCODE * : * WORD59 * * MICROCODE IS EMITTED AS PAIRS OF 16-BIT WORDS WITH * LSB IN 2ND WORD. SOR THAT ASSEMBLY OUTPUT MAY BE * LOADED UNDER DOS OR BCS, WE GENERATE MICRO-ADDRESS * MODULO 256 IN UPPER BYTE OF 1ST 16-BIT WORD. * LDA LASTP INA LDB PNLEN CPA PCNTR GAP IN EMITTED CODE... CPB =D27 ...OR FULL BUFFER? JSB EMBUF YES: DUMP BUFFER LDA PCNTR STA LASTP AND =B377 ALF,ALF FORM MSB WORD IOR INST2 STA PNBUF,I ISZ PNBUF LDB INST1 FORM LSB WORD STB PNBUF,I ISZ PNBUF ISZ PNLEN ADA B UPDATE CHECKSUM ADA CKSUM STA CKSUM JMP EMCDE,I * * EMIT SIMULATOR FORMAT. RECORD CONSISTS OF 32 * MICROWORDS. FORMAT IS A*DS FOLLOWS: * WORD1= RECORD LENGTH (ALWAYS 52), SHIFTED INTO * UPPER BYTE * WORD2= MICROCODE * : * WORD49 * WORD50= CHECKSUM: (16-BIT) SUM OF ALL BYTES * EXCLUDING WORD1 AND WORD50 * WORD51= ZERO * WORD52= ZERO * MICROCODE IS EMITTED AS CONTIGUOUS SEQUENCES OF 3 * BYTES. GAPS IN CODE (EG., DUE TO ALGN) ARE PADDED * WITH MICROWORDS OF ALL 1'S. DISJOINT CODE GROUPS * ARE SEPARATED BY LEADER. NOTE THAT THERE IS NO * INDICATION OF MICRO-ADDRESS INCLUDED IN RECORD. * * NOTE THAT AN EMPTY BUFFER WOULD CAUSE US TO PAD THE * ENTIRE BUFFER. WE MUST AVOID THIS BY CHECKING FOR * A MAX-FILL LENGTH OF EXACTLY 32 MICROWORDS. * EC.S EQU * LDA PCNTR LASTP=PCNTR-1? ADA =D-1 CPA LASTP JMP ECCHK YES CMA,INA NO: COMPUTE MINUS # FILL WORDS ADA LASTP = LASTP-PCNTR+1 STA FILL# CMA,INA FILL# > MAX (32-PNLEN)? ADA PNLEN ADA =D-33 IE.: FILL#-33+PNLEN >= 0? SSA JMP ECPAD NO: SIMPLY PAD BUFFER JSB EMBUF YES: DUMP (OR INITIALIZE) BUFFER LDA PNCH? PUNCH LEADER? SZA JSB LEADR YES LDA FILE? EMIT END-OF-FILE... LDB FRST? ...IF NOT FIRST BUFFER? SZA SZB,RSS JMP EC1 NO JSB WRITF DEF *+5 DEF @DCB,I DEF FMGR DEF PBASE,I DEF .0 ZERO-LENGTH=EOF SSA,RSS JMP EC1 LDA =D29 FILE ERROR! JSB FMERR CLA STA FILE? EC1 CLA STA FRST? JMP ECPAK * ECPAD LDA FILL2 PAD BUFFER WITH -1'S LDB FILL1 JSB STUFF ISZ FILL# JMP ECPAD ECCHK LDB PNLEN FULL BUFFER? CPB =D32 JSB EMBUF YES: DUMP IT ECPAK LDA INST2 LDB INST1 JSB STUFF LDA PCNTR STA LASTP JMP EMCDE,I * * ****************************** * * E M B U F * * ENTRY: * JSB EMBUF * * OSTENSIBLY USED TO DUMP CURRENT BUFFER. * WE TAKE CARE OF PADDING INCOMPLETE SIMULATOR * FORMAT BUFFER. WE ALSO HANDLE SUCH CONTROLS * AS WRITING LEADER AND TRAILER. ALSO, IF "END?" * IS SET, WE WILL GENERATE END RECORDS FOR * RELOCATABLE FORMAT. * * NOTE THAT WE ALSO HANDLE INITIALIZING THE BUFFER * HERE. SEE "EMCDE" FOR DETAILS. * EMBUF NOP LDA PNLEN VIRGIN BUFFER? SZA,RSS JMP EMCLR YES: SIMPLY INITIALIZE LDA FMT R-FMT? SZA,RSS JMP RFINI YES: COMPLETE R-BUFFER LDA PNLEN PAD S-FMT BUFFER? ADA =D-32 STA FILL# - #FILL WORDS SZA,RSS JMP SFINI NO: COMPLETE S-BUFFER EMPAD LDA FILL2 LDB FILL1 JSB STUFF ISZ FILL# JMP EMPAD * SFINI EQU * COMPLETE SIMULATOR BUFFER LDA CKSUM ALF,ALF CMA STA SCHEK LDA =D52 STA RLEN JMP EMOUT * RFINI EQU * COMPLETE RELOCATABLE RECORD LDA PNLEN ALS LENGTH*2 ADA =D5 STA RLEN PUNCH LENGTH ALF,ALF SHIFT INTO HIGH BYTE FOR STA PNLEN LENGTH WORD IN BUFFER * EMOUT EQU * LDA PNCH? SZA,RSS JMP EMFIO LDA FRST? FIRST PUNCH (R-FMT)? SZA JSB LEADR YES: PUNCH LEADER CLA STA FRST? LDA PNCH? LDB RLEN JSB IOSUB OCT 2 OCT 100 DEF PBASE,I * EMFIO LDA FILE? SZA,RSS JMP EMEND JSB WRITF DEF *+5 DEF @DCB,I DEF FMGR DEF PBASE,I DEF RLEN SSA,RSS JMP EMEND LDA ERR29 JSB FMERR CLA STA FILE? * EMEND LDA END? SZA,RSS JMP EMCLR LDA PNCH ANY PUNCHING? SZA,RSS JMP EMFEN NO: IGNORE END RECORD LDB FMT SZB JMP EMTRL NO END-RECORD FOR S-FMT LDB =D4 JSB IOSUB OCT 2 OCT 100 DEF ENDRC EMTRL JSB LEADR PUNCH TRAILER * EMFEN LDB FMT LDA FILE SZB,RSS SIMULATOR FORMAT OR... SZA,RSS ...NO FILE I/O? JMP EMCLR YES: SKIP END RECORD JSB WRITF DEF *+5 DEF @DCB,I DEF FMGR DEF ENDRC DEF .4 SSA,RSS JMP EMCLR LDA ERR29 JSB FMERR CLA STA FILE? * EMCLR EQU * LDA PCNTR STA ORIGN CLA STA PNLEN LDB FMT SZB,RSS JMP EMR0 STA CKSUM S-FORMAT INITIALIZATION LDA PBASE INA RAL STA PNBUF JMP EMBUF,I * EMR0 LDA DBL R-FORMAT INITIALIZATION ADA PCNTR STA CKSUM LDA PBASE ADA =D5 STA PNBUF JMP EMBUF,I RLEN BSS 1 * * ****************************** * * E O S ? * * ENTRY: * LDB * JSB EOS? * * * * EXIT: * A= NEXT CHAR * B= BPTR TO SUBSEQUENT CHAR * * ROUTINE GETS NEXT CHARACTER AND TESTS FOR SEPARATORS * (END OF SUBPARAMETER): BLANK, COLON OR COMMA. IF * FOUND, WE EXIT TO "TRUE" RETURN...ELSE WE EXIT TO * "FALSE" RETURN. * * W A R N I N G: NOTE THAT WE TAKE S E C O N D * EXIT ON ERROR (NOT END OF STRING) INSTEAD OF * FIRST (AS IS USUAL CONVENTION). * EOS? NOP JSB LOADB CPA BLNK JMP EOS1 CPA COLON JMP EOS?,I CPA COMMA JMP EOS?,I ISZ EOS? NOT A SEPARATOR JMP EOS?,I EOS1 ADB =D-1 BACK-UP OVER TERMINATOR JMP EOS?,I TO ALLOW REDUNDANT TESTS * * ******************** * * E O T * * ENTRY: * JSB EOT * * SETS END-OF-TAPE CONDITION ON SOURCE INPUT * DEVICE. THIS IS NECESSARY WHEN RE-READING * PAPER TAPE (EG., AFTER RELOAD) WITHOUT HAVING * REACHED AN END-OF-FILE. * EOT NOP LDA RDR IOR =B700 RESET EOT CONDITION STA CONWD JSB YEXEC DEF *+3 DEF .3 DEF CONWD JMP EOT,I CONWD BSS 1 * * ****************************** * * E R R O R * * ENTRY: * LDA * JSB ERROR * * PRINTS MESSAGE IN ONE OF FOLLOWING FORMATS: * **ERROR .... IN LINE ....: * ^ ^ ^ * : : : * @EFD1 @EFD2 @EFD4 * : : * V V * **ERROR .... IN LINE .... (SEE ....): * ^ ^ * : : * @EFD3 @EFD4 * * FIRST FORMAT IS USED ONLY FOR FIRST ERROR. "SEE..." * INDICATES LINE NUMBER OF PREVIOUS ERROR. WE SET UP * SECOND FORMAT AFTER PRINTING FIRST ERROR MESSAGE. * FIRST FORMAT IS RESTORED AT THE BEGINNING OF PASS #2 * (SEE FINI). @EFD4 IS A WORD POINTER; THE OTHERS ARE * BYTE POINTERS. * * THIS ROUTINE ALSO INCREMENTS ERR? AND #ERRS. ERR? IS * RESET IN LSTR2. #ERRS IS RESET IN FINI. * ERROR NOP STA @ERR STA ANYER LDB A,I ISOLATE ERROR # & MSG LEN CLA RRL 8 A=ERROR NUMBER BLF,BLF B=MESSAGE LENGTH STB ELEN CMB,INB STB ECNT LDB @EFD1 CONVERT ERROR & LINE NUMBERS JSB DECML LDA LINE# SZA,RSS INA LDB @EFD2 JSB DECML LDA LAST# FIRST ERROR OF PASS? LDB @EFD3 SZA JSB DECML NO: PUT IN "SEE..." PART * * MOVE IN ERROR MESSAGE * LDA @EFD4 WORD PTR TO MSG FIELD STA EPTR LDA @ERR GET PTR TO MSG ER0 INA LDB A,I NEXT WORD IN MSG STB EPTR,I ISZ EPTR ISZ ECNT JMP ER0 ISZ ERR? LDA ERR? CPA =D1 (NB: A=1 FOR SPACE) JSB SPACE YES: PRINT BLANK LINE LDA ELEN ADA MLEN JSB PRINT DEF EMSG G0.* LDA LAST# FIRST ERROR OF PASS? SZA hi0 JMP ER2 NO LDA =D-6 YES: APPEND "SEE..." PART STA CCNT LDA @SEE STA @INP LDA BLNK LDB @EFD2 INB JSB STORB ERB WORD-PTR TO "SEE..." PART ER1 LDA @INP,I STA B,I INB ISZ @INP ISZ CCNT JMP ER1 STB @EFD4 WORD-PTR TO MESSAGE PART LDA =D19 STA MLEN ER2 LDA LINE# SZA,RSS INA STA LAST# ISZ #ERRS JMP ERROR,I * ECNT BSS 1 @EFD0 DEF EMSG+14 PTR TO MSG W/O "SEE..."; SEE FINI @EFD1 DBR EMSG+5 @EFD2 DBL EMSG+12 @EFD3 DBL EMSG+17 BPTR TO "SEE..." @EFD4 DEF EMSG+14 ELEN BSS 1 EMSG ASC 14,**ERROR .... IN LINE ....: BSS 22 EPTR BSS 1 @ERR BSS 1 PTR TO ERROR DESCRIPTOR MLEN DEC 14 @SEE DEF *+1 ASC 6,(SEE ....): * * ERROR DESCRIPTORS. FORM IS AS FOLLOWS: * DEF *+1 * BYT , * ASC <# WORDS>, * THE "DEF" IS THE ERROR PTR PASSED AS ERROR * CODE. LENGTH OF ERROR MESSAGE MUST NOT EXCEED * 17 WORDS, SUCH THAT TOTAL MESSAGE LENGTH DOES * NOT EXCEED 72 BYTES. * ERR1 DEF *+1 BYT 1,15 ASC 13,DUPLICATE LABEL IN FIELD 1 ERR2 DEF *+1 BYT 2,13 ASC 11,INVALID OP IN FIELD 2 ERR3 DEF *+1 BYT 3,15 ASC 13,INVALID SPECIAL IN FIELD 3 ERR4 DEF *+1 BYT 4,16 ASC 14,INVALID CONDITION IN FIELD 4 ERR5 DEF *+1 BYT 5,13 ASC 11,INVALID ALU IN FIELD 4 ERR6 DEF *+1 BYT 6,16 ASC 14,INVALID MODIFIER IN FIELD 4 ERR7 DEF *+1 BYT 7,14 ASC 12,INVALID STORE IN FIELD 5 ERR8 DEF *+1 BYT 10,14 ASC 12,INVALID S-BUS IN FIELD 6 ERR9 DEF *+1 BYT 11,14 ASC 12,INVALID SENSE IN FIELD 5 ERR10 DEF *+1 BYT 12,6 ASC 6,MISSING ORG ERR11 DEF *+1 BYT 13,16 ASC 14,INVALID CONSTANT IN FIELD 6 ERR12 DEF *+1 BYT 14,17 ASC 15,$CODE IGNORED: NO BUFFER SPACE ERR13 DEF g*+1 BYT 15,20 ASC 16,$CODE IGNORED: CANNOT BUILD FILE ERR14 DEF *+1 BYT 16,13 ASC 11,INVALID FILE REFERENCE ERR15 DEF *+1 BYT 17,17 ASC 15,NOT TYPE-3 SPECIAL IN FIELD 3 ERR16 DEF *+1 BYT 20,20 ASC 16,NOT TYPE-1/2 SPECIAL IN FIELD 3 ERR17 DEF *+1 BYT 21,17 ASC 15,NOT TYPE-4 SPECIAL IN FIELD 3 ERR18 DEF *+1 BYT 22,14 ASC 12,INVALID CONTROL COMMAND ERR19 DEF *+1 BYT 23,17 ASC 15,INVALID EXPRESSION IN FIELD 6 ERR20 DEF *+1 BYT 24,5 ASC 5,NO SOURCE ERR21 DEF *+1 BYT 25,6 ASC 6,MISSING END ERR22 DEF *+1 BYT 26,13 ASC 11,SYMBOL TABLE OVERFLOW ERR23 DEF *+1 BYT 27,20 ASC 16,ADDRESS OUT OF RANGE IN FIELD 6 ERR24 DEF *+1 BYT 30,16 ASC 14,LABEL NOT ALLOWED IN FIELD 1 ERR25 DEF *+1 BYT 31,15 ASC 13,FIELDS 4 & 5 MUST BE BLANK ERR26 DEF *+1 BYT 32,13 ASC 11,ADDRESS SPACE OVERFLOW ERR27 DEF *+1 BYT 33,20 ASC 16,INVALID OR MISSING MICRO COMMAND ERR28 DEF *+1 BYT 34,17 ASC 15,DUPLICATE MICRO OPTION IGNORED ERR29 DEF *+1 BYT 35,10 ASC 8,FILE I/O ERROR ERR30 DEF *+1 BYT 36,13 ASC 11,INVALID MICRO OPTIONS ERR31 DEF *+1 BYT 37,14 ASC 12,INVALID LABEL IN FIELD 1 ERR32 DEF *+1 BYT 40,12 ASC 10,SECOND $CODE IGNORED ERR33 DEF *+1 BYT 41,21 ASC 17,EXPRESSION NOT ALLOWED IN FIELD 6 * * ****************************** * * F I N I * * ENTRY: * JSB FINI * * PRINTS END-OF-PASS MESSAGES. FORM IS AS FOLLOWS: * END OF PASS .: NO ERRORS * ^ * : * @F1FD * * END OF PASS .: .... ERRORS (SEE ....) * ^ ^ ^ * : : : * @F2F1 @F2F2 @F2F3 * * ALSO RESETS #ERRS, LAST#, @EFD4, AND MLEN. * FINI NOP 7 LDA =D2 JSB SPACE LDA #ERRS SZA,RSS JMP NOERR LDB @F2F2 JSB DECML LDA PASS# ADA =B60 LDB @F2F1 JSB STORB LDA LAST# LDB @F2F3 JSB DECML LDA =D-37 JSB PRINT DEF FIN2 JMP FINI2 NOERR LDA PASS# ADA =B60 LDB @F1FD JSB STORB LDA =D-24 JSB PRINT DEF FIN1 FINI2 CLA STA #ERRS STA LAST# LDB @EFD0 STB @EFD4 ELB ADB =D-3 RESET ": " IN ERROR MSG LDA COLON JSB STORB LDA BLNK JSB STORB LDA BLNK JSB STORB LDA =D14 STA MLEN JMP FINI,I * FIN1 ASC 12,END OF PASS .: NO ERRORS FIN2 ASC 19,END OF PASS .: .... ERRORS (SEE ....) @F1FD DBL FIN1+6 @F2F1 DBL FIN2+6 @F2F2 DBL FIN2+9 @F2F3 DBR FIN2+17 * * ****************************** * * F M E R R * * ENTRY: * LDA * JSB FMERR * * WRITES FMGR ERROR CODE AFTER FILE ERROR MESSAGE. * FMERR NOP JSB ERROR LDA BLNK LDB FMGR NEGATIVE ERROR CODE? CMB,SSB,INB JMP FM.0 NO: SIGN IS BLANK STB FMGR YES: SIGN=MINUS LDA MINUS FM.0 LDB @FM1 JSB STORB LDA FMGR APPEND ERROR CODE LDB @FM2 JSB DECML LDA =D-18 WRITE MSG JSB PRINT DEF FMSG JMP FMERR,I FMSG ASC 8,FMGR ERROR ..... @FM1 DBL FMSG+5 BPTR TO SIGN @FM2 DBL FMSG+7 BPTR TO LAST ERROR DIGIT * * ****************************** * * G E T L U * * ENTRY: * LDB * JSB GETLU * * * * EXIT: * A= LU# (LOW 6 BITS) * B= ADR OF PARAM * E= 0 -- LU<>99 * 1 -- LU=99 (RESET TO 0) * * GETS LU FROM :RU COMMAND, EXTRACTING ONLY LOW 6 BITS. * A "99" IS TREATED AS DEFAULT BUT E-REG IS SET. THUS, * WE ACCEPT "99" (AS DO OTHER TRANSLATORS) BUT IGNORE * IT (SINCE WE DO NOT ASSEMBLE TO THE LG TRACKS). NOTE * THAT "DEFAULT" IS INDICATED BY ALL 16 BITS BEING ZERO. * THIS PERMITS SPECIFICATION OF LU=0 BY %400 (AS IS TRUE * FOR OTHER TRANSLATORS). * GETLU NOP CLE,INB LDA B,I CPA =D99 CLA,CCE E=1 & LU=0 FOR PARM=99 SZA ISZ GETLU AND =B77 JMP GETLU,I * * ****************************** * * I O S U B * * ENTRY: * LDA * LDB * JSB IOSUB * OCT * OCT * DEF * * PERFORMS INPUT/OUTPUT. * IOSUB NOP STB IOLEN LDB IOSUB PTR TO REQUEST CODE STB I.RQ ISZ IOSUB IOR IOSUB,I COMBINE LU AND CTL WORD STA IOCTL ISZ IOSUB LDA IOSUB,I GET BUFFER ADDR STA I.BUF ISZ IOSUB JSB EXEC DEF *+5 I.RQ DEF * DEF IOCTL I.BUF DEF * DEF IOLEN JMP IOSUB,I IOCTL BSS 1 IOLEN BSS 1 * * ****************************** * * L B L ? * * ENTRY: * JSB LBL? * * * * EXIT (IF LABEL PRESENT): * A= FIRST CHAR OF LABEL * B= BYTE POINTER TO FIRST CHAR * * DETERMINES WHETHER LABEL IS PRESENT (COL 1 IS * NON-BLANK). IF COL 1 IS "%", OR COL 1 IS BLANK * BUT FIELD IS NOT ALL BLANK, WE REPORT ERROR AND * RETURN TO NO-LABEL EXIT. * LBL? NOP LDB @FLD1 GET CHAR IN COL 1 JSB LOADB CPA BLNK JMP LBL1 ADB =D-1 CPA "%" JMP LBL2 ISZ LBL? LABEL FOUND JMP LBL?,I LBL1 LDA @FLD2 ALL BLANK FIELD? JSB BLNK? JMP *+2 JMP LBL?,I YES: NO LABEL LBL2 LDA ERR31 NO: INVALID LABEL JSB ERROR JMP LBL?,I * * ****************************** * * L E A D R * * THIS ROUTINE GENERATES LEADR ON PUNCH DEVICE * * CALLING SEQUENCE: * JSB LEADR * LEADR NOP JSB EXeBEC PUNCH OUT THE LEADER. DEF *+3 DEF .3 DEF PNCTL JMP LEADR,I * * ******************** * * $ L I S T * * ENTRY: * JSB $LIST * * ENABLES LISTING (OBSTENSIBLY DUE TO A $LIST COMMAND) * IF "L" OPTION WAS SPECIFIED IN MIC COMMAND. * $LIST NOP LDA LIST LDB MICL SZB STA LIST? JMP $LIST,I * * ****************************** * * L O A D B * * 'LOADB' RETURNS IN THE A REG THE BYTE WHOSE * BYTE ADDRESS WAS SPECIFIED IN THE B REG. * BYTE ADDRESS IS UNCHANGED UPON EXIT. * * CALLING SEQUENCE: * B REG SHOULD CONTAIN BYTE ADDRESS OF * BYTE TO BE FETCHED. * JSB LOADB * UPON RETURN, THE BYTE WILL BE IN THE LOW BITS OF * THE A REG. B REG WILL CONTAIN ORIGINAL * BYTE ADDRESS. * LOADB NOP CLE,ERB E=0 FOR HIGH BYTE LDA B,I SEZ,RSS DESIRED CHAR IN LOW BYTE? ALF,ALF NOW IT IS! AND =B377 ELB B= ORIGINAL BYTE ADDR INB PLUS ONE JMP LOADB,I * * ****************************** * * L S T R 1 * L S T R ? * L S T R 2 * * ENTRY FOR LSTR?: * JSB LSTR1 -OR- JSB LSTR? * * ENTRY FOR LSTR2: * LDA <0=NO CODE, 1=LIST CODE> * JSB LSTR2 * * LISTS SOURCE LINES IN ONE OF TWO FORMATS, DEPENDING ON * PASS. * * LSTR1 AND LSTR? ARE CALLED IN PASS 1. FOR LSTR?, LINE IS * LIST ONLY IF THERE WAS AN ERROR IN THAT LINE. FORMAT IS: * NNNN * WHERE "NNNN" IS THE CURRENT LINE NUMBER. * * LSTR2 IS CALLED IN PASS 2. LINE IS LISTED IF LISTING IS * ENABLED OR THERE WAS AN ERROR IN THAT LINE. FORMAT IS: * NNNN PPPPP CCC CCCCCC * WHERE: * NNNN = CURRENT LINE NUMBER * PPPPP = CURRENT CONTROL STORE ADDRESS * CCC CCCCCC = ASSEMBLED INSTRUCTION. * IF A-REG IS ZERO, "P" AND "C" ARE LEFT BLANK (VIZ., FOR * COMMENT LINES AND ORG AND EQU STATEMENTS).=. * LSTR1 NOP CLA CLEAR ERROR FLAG STA ERR? LDA LINE# CONVERT LINE NUMBER LDB @LFD0 JSB DECML LDA CRLEN ADA =D-6 JSB PRINT DEF OUT0 JMP LSTR1,I * * * LSTR? NOP LDA ERR? ERROR? SZA,RSS JMP LSTR?,I NO: IGNORE REQUEST LDA LSTR? STA LSTR1 JMP LSTR1+1 * * * LSTR2 NOP LDB LIST? LISTING ENABLED OR ERR? SZB,RSS LDB ERR? SZB,RSS JMP LSTR2,I NO: IGNORE REQUEST SZA,RSS NO CODE? JMP L2.1 RIGHT: JUST CONVERT LINE NUMBER LDA PCNTR CONVERT CURRENT ADDRESS LDB @LFD2 JSB OCTAL DEC 5 LDA INST1 CONVERT LSB OF INSTRUCTION LDB @LFD3 JSB OCTAL DEC 6 LDA INST2 AND =B377 ADB =D-1 JSB OCTAL DEC 3 L2.1 LDA LINE# CONVERT LINE NUMBER LDB @LFD1 JSB DECML LDA CRLEN ADA =D-24 JSB PRINT DEF OUTBF CLA STA ERR? JMP LSTR2,I * @LFD0 DBR CARD-2 PTR TO LINE # IN FORMAT 1 @LFD1 DBR OUTBF+1 PTR TO LINE # IN FORMAT 2 @LFD2 DBR OUTBF+4 PTR TO PCNTR IN FORMAT 2 @LFD3 DBR OUTBF+10 PTR TO CODE IN FORMAT 2 * * ****************************** * * M I C * * ENTRY: * JSB MIC * * READS FIRST SOURCE RECORD FOR BOTH PASSES. * CHECKS FOR "MICMX" OR "MICXE" COMMAND. RESETS * CERTAIN POINTERS AND VALUES FOR "MICMX". * MIC NOP ISZ LINE# JSB RDCRD LDA PASS# CPA =D1 JMP MIC1 * PASS #2: SIMPLY LIST RECORD CLA JSB LSTR2 JMP MIC,I * * MIC1 LDB @FLD1 JSB PSRCH DBL MTBL DEC 10 ADA *+2 JMP A,I DEF *+1,I ZERO-ORIGINED JUMP TABLE DEF M.AB DEF M.MX DEF M.PRM MICMXE: PARSE PARAMETERS * M.AB1 LDA ERR30 BAD PARAMS JMP *+2 M.AB LDA ERR27 BAD MIC COMMAND JS*($B ERROR JSB LSTR? JMP ABORT * M.MX ISZ MX? LDA @MXD SET UP MX FIELD DEFAULTS "6* STA @DFLT LDA =B170000 SET MX MAX ADDRESS MASK STA MXAD1 LDA =B6000 MX DEFAULT ORIGIN STA DFORG ISZ TOFF * * PARSE PARAMETERS * M.PRM EQU * ADB =D-1 BACK-UP OVER SEPARATOR MPRM JSB LOADB CPA BLNK JMP M.LST CPA COMMA JMP *+2 JMP M.AB JSB LOADB CPA "B" JMP M.B CPA "C" JMP M.C CPA "L" JMP M.L CPA "R" JMP M.R CPA "S" JMP M.S CPA "T" JMP M.T JMP M.AB1 * M.B JSB TESTB OCT 1 LDA PNCH STA PNCH? JMP MPRM * M.C JSB TESTB OCT 2 ISZ XREF? JMP MPRM * M.L JSB TESTB OCT 4 LDA LIST STA LIST? ISZ MICL JMP MPRM * M.R JSB TESTB OCT 10 LDA MFLAG "S" SPECIFIED? AND =B20 SZA JMP M.AB1 YES: INCONSISTENT PARAMS JMP MPRM * M.S JSB TESTB OCT 20 LDA MFLAG "R" SPECIFIED? AND =B10 SZA JMP M.AB1 YES: INCONSISTENT PARAMS ISZ FMT LDA PBASE ADA =D4 STA PBASE INA RAL STA PNBUF LDA =B32000 STA PBASE,I JMP MPRM * M.T JSB TESTB OCT 40 ISZ SYFLG JMP MPRM * M.DUP LDA ERR28 DUPLICATE PARAMS STB MPTR JSB ERROR LDB MPTR RESET B=BPTR INTO COMMAND JMP MPRM * * LIST COMMAND * M.LST EQU * LDA PNCH? WON'T USE PUNCH AT ALL SZA,RSS STA PNCH JSB LSTR1 JMP MIC,I * TESTB NOP LDA MFLAG AND TESTB,I SZA JMP M.DUP LDA MFLAG IOR TESTB,I STA MFLAG ISZ TESTB JMP TESTB,I * MFLAG OCT 0 MPTR BSS 1 MTBL BYT 6,1 MIC-COMMANDS ASC 4,MICMX (SEE PSRCH FOR FORMAT) BYT 6,1 ASC 4,MICMX, BYT 7,2 ASC 4,MICMXE BYT 7,2 ASBBC 4,MICMXE, OCT 0 TERMINATOR * * ******************** * * M V B * * ENTRY: * LDA * LDB * JSB MVB * DEC <# BYTES> * * EXIT: * B= BPTR TO LAST+1 TARGET CHARACTER * MVINP= BPTR TO LAST+1 SOURCE CHARACTER * * COPIES FROM ONE CHARACTER STRING TO ANOTHER. * MVB NOP STA MVINP STB MVDST LDA MVB,I GET LENGTH CMA,INA STA MVCNT ISZ MVB * MVNXT LDB MVINP GET NEXT SOURCE CHARACTER JSB LOADB STB MVINP SAVE BPTR TO NEXT CHAR LDB MVDST STORE INTO NEXT TARGET CHAR JSB STORB STB MVDST SAVE BPTR TO NEXT TARGET CHAR ISZ MVCNT MOVED ALL BYTES? JMP MVNXT NO JMP MVB,I MVCNT BSS 1 #BYTES TO MOVE MVDST BSS 1 BPTR TO TARGET CHAR * * ****************************** * * N U M * * ENTRY: * LDB * JSB NUM * * EXIT: * A= VALUE OF EXPRESSION * O= 0 -- NO ERROR * 1 -- ERROR * * CONVERTS AN ADDRESS EXPRESSION TO ITS ADDRESS VALUE. * EXPRESSION MAY HAVE ONE OF THE FOLLOWING FORMS: * [+/-] NUMBER * * [+/- NUMBER] * SYMBOL [+/- NUMBER] * WHERE A NUMBER HAS ONE OF THE FOLLOWING FORMS: * % * B * * NUM NOP CCA STA POS? SET==>ASSUME POSITIVE CLA STA SYVAL * * LOOK FOR ASTERISK OR (OPTIONALLY SIGNED) NUMBER * JSB LOADB CPA ASTER JMP N.AST CPA "%" JMP N.E3 CPA PLUS JMP N.E1 CPA MINUS JMP N.E2 ADA .M"0" "0" <= CHAR <= "9"? SSA JMP N.SYM NO: CHAR < "0" ADA .M10 SSA JMP N.DIG YES: CHAR <= "9" * * PROCESS SYMBOL. SEARCH SYM TABLE FOR SYMBOL'S ADDR. B-REG * IS RESET TO ADDR OF CHAR FOLLOWING SYMBOL BY PICKING UP ADDR * LEFT BY "TLOAD" IN "TLINP". * N.3VSYM ADB =D-1 BACK-UP OVER CHAR JSB SERCH VALID SYMBOL? SSA JMP N.ERR NO ADA =D4 GET ADDRESS LDA A,I AND =B77777 MASK OFF EQU FLAG STA SYVAL LDB TLINP BYTE ADDR TO LAST+1 CHAR * * GET ANY SUBEXPRESSION FOLLOWING SYMBOL * N.EXP JSB LOADB CPA BLNK JMP N.END CPA MINUS N.E2 ISZ POS? SET POS=0 (NEGATE) & SKIP CPA PLUS N.E1 JSB LOADB GET NEXT CHAR CPA "%" OCTAL? N.E3 CLA,RSS JMP N.DIG JMP N.CVT YES: CONVERT TO OCTAL * SCAN DIGITS FOR TRAILING "B" N.DIG ADB =D-1 BACK-UP OVER CHAR JSB OCT? CCA,RSS NO: CONVERT DECIMAL JMP N.OCT * CONVERT NUMBER & COMPUTE ADDR N.CVT CLO JSB CNVRT SOC SKIP IF NO ERROR JMP NUM,I ERROR N.C1 STB SAVB BYTE ADDR OF NEXT CHAR LDB POS? NEGATE ADDR? SZB,RSS CMA,INA YES ADA SYVAL ADD ANY SYMBOLIC ADDR SOC JMP NUM,I ERROR STA SYVAL LDB SAVB VERIFY: EXPR ENDS WITH BLANK JSB LOADB CPA BLNK JMP *+2 YES JMP N.ERR N.END CLO NO ERROR LDA SYVAL JMP NUM,I N.ERR STO ERROR: SET OVERFLOW JMP NUM,I * * PROCESS B-TYPE OCTAL. DIFFERS IN THAT WE MUST SKIP TRAILING " * N.OCT CLA CLO JSB CNVRT SOC JMP NUM,I ERROR INB SKIP "B" JMP N.C1 * * PROCESS ASTERISK * N.AST STB SAVB JSB ORGD? ENSURE THAT "ORG" HAS BEEN SET LDA PCNTR STA SYVAL LDB SAVB JMP N.EXP * SYVAL BSS 1 * * ****************************** * * O C T ? * * ENTRY: * LDB * JSB OCT? * * * * EXIT: * B= BPTR TO FIRST CHAR (AS ON ENTRY) * * SCANS SEQUENCE OF DIGITS AND CHECKS FOR "B" * AT THE END. * OCT? NOP CLA STA COUNT } STB @OCT OCT1 JSB LOADB ADA .M"0" "0" <= CHAR <= "9"? SSA JMP OCT2 NO: CHAR < "0" ADA .M10 DIGIT < 10? SSA,RSS JMP OCT2 NO ISZ COUNT JMP OCT1 * OCT2 LDB COUNT SCANNED ANY CHARS? SZB,RSS JMP OCT3 NO CPA =B10 "B"-"0"-10? ISZ OCT? YES: TRAILING "B" OCT3 LDB @OCT RESTORE B-REG JMP OCT?,I @OCT BSS 1 * * ****************************** * * O C T A L * * ENTRY: * LDA * LDB * JSB OCTAL * DEC * EXIT: * B= BYTE POINTER TO BYTE PRECEDING MOST-SIGNIFICANT * DIGIT * * CONVERTS 16-BIT QUANTITY TO OCTAL ASCII STRING * OCTAL NOP STA BINRY LDA OCTAL,I NUMBER OF DIGITS CMA,INA STA DGITS ISZ OCTAL OCT0 STB @DEST CLA LDB BINRY LSR 3 ALF,RAR A=BINRY MOD 8 STB BINRY BINRY/8 ADA =B60 LDB @DEST JSB STORB ADB =D-2 BPTR TO NEXT MOST-SIG DIGIT ISZ DGITS JMP OCT0 JMP OCTAL,I * * ****************************** * * O P S Y S * * DETERMINES ALL SYSTEM-DEPENDENT FACTORS * CALLING SEQUENCE: * JSB OPSYS * DEC * ITEM NUMBERS ARE DEFINED AS FOLLOWS: * 1 -- FWA BEYOND PROGRAM IN PARTITION * 2 -- LWA OF PARTITION * 3 -- LS ADDR * RESULT IS RETURNED IN THE A-REG. * OPSYS NOP LDB OPSYS,I PICK UP ITEM NUMBER ISZ OPSYS ADB *+2 JMP B,I DEF *,I ONE-ORIGINED BRANCH TABLE DEF &FWA DEF &LWA DEF &LS * &FWA LDA &ID PTR TO ID SEG ADA =D23 LDA A,I JMP OPSYS,I * &LWA LDA &ID PTR TO ID SEG ADA =D14 PARTITION TYPE (2 OR 3) LDB A,I LDA &BLWA ASSUME TYPE 3 (BKGRND) PARTITION SLB,RSS LDA &FLWA  TYPE 2 (FOREGROUND) JMP OPSYS,I * * GET SYSTEM LS TRACK ADDR AND CONVERT TO USUAL * TRACK ADDR FORMAT. SYSTEM LS TRACK ADDR FORMAT: * BIT 15= 0 IF LU 2 * 1 IF LU 3 * BITS 14-7= TRACK # * BITS 6-0= SECTOR # (ALWAYS 0) * NB: IF TRACK=SECTOR=0, NO LS IS ASSIGNED. * NORMAL TRACK ADDR FORMAT: * BITS 15-8= LU # * BITS 7-0= TRACK # * &LS LDA &LSAD CLB LSL 1 B=LU INDICATOR SZA LS ASSIGNED? ADB =D2 YES: RESET INDICATOR TO LU# LSR 8 SHIFT INTO HI BYTE IN A-REG JMP OPSYS,I * &BLWA EQU 1777B BACKGROUND LWA IN BASE-PAGE &FLWA EQU 1751B FOREGROUND LWA IN BASE-PAGE &ID EQU 1717B PTR TO ID SEG IN BASE-PAGE &LSAD EQU 1767B LS ADDR IN BASE-PAGE * * ****************************** * * O R G D ? * * VERIFIES THAT FIRST "ORG" PSEUDO-OP HAS BEEN INPUT * ORGD? NOP LDA BASE SSA,RSS JMP ORGD?,I YES IT HAS LDA DFORG DEFAULT TO XE USER MODULE STA PCNTR STA BASE LDA ERR10 JSB ERROR JMP ORGD?,I * * ****************************** * * O R I G * * ENTRY: * JSB ORIG * * * * EXIT: * A= ERROR NUMBER (IFF ERROR EXIT) * * PROCESSES THE ORG PSEUDO-OP FOR BOTH PASSES * ORIG NOP LDA @FLD6 FIND ADDR EXPRESSION LDB @FLD3 JSB BLNK? NOP JSB NUM SOS OK? JMP ORG0 YES. LDA ERR19 BAD LABEL EXPR ORG3 LDB BASE FIRST TIME? SSB,RSS JMP ORIG,I NO: LEAVE PCNTR WHERE IT IS LDB DFORG STB PCNTR STB BASE JMP ORIG,I ORG0 LDB PCNTR ORG < CURRENT PCNTR? CMB,INB ADB A SSB JMP ORG1 YES: ADDR OUT OF RANGE STA B SAVE ORG ADDR AND MXAD1 ORG > MAX ADDR? SZA,RSS JMP ORG2 ORG1 LDA ERR23 YES: ADDR IS OUT OF RANGE JMP ORG3  LEAVE PCNTR ALONE ORG2 LDA B RESTORE ORG ADDR JSB SETP LDA PCNTR LDB BASE FIRST TIME? SSB STA BASE YES: SET BASE FOR PASS2 ISZ ORIG JMP ORIG,I * * ****************************** * * O U T P T * * 'OUTPT' LISTS A RECORD AFTER PASS 2 PROCESSING, AND * ALSO PUNCHES OUT THE BINARY OBJECT CODE, IF * PUNCH BUFFER IS FULL. * * CALLING SEQUENCE: * JSB OUTPT * OUTPT NOP EMIT CODEWORD WITH LISTING CLA,INA LIST LINE WITH OP CODES JSB LSTR2 LDA PNCH? PUNCHING OR GOING TO FILE? IOR FILE? SZA JSB EMCDE YES: STUFF INTO BUFFER LDA PCNTR INA JSB SETP INCREMENT PCNTR JMP OUTPT,I * * ******************** * * P E J C T * * ENTRY: * JSB PEJCT * * PAGE EJECT ON LIST DEVICE. * PEJCT NOP JSB EXEC DEF *+4 DEF .3 DEF SPCTL DEF .M1 PAGE EJECT JMP PEJCT,I * * ****************************** * * P O V F ? * * ENTRY: * JSB POVF? * * EXIT: * E=0 IF NO OVERFLOW (POVFL=0) * 1 IF OVERFLOW (POVFL=1) * POVFL=0 IF OVERFLOW * * PRINTS ERROR MESSAGE IF PCNTR HAS OVERFLOWED. * POVF? NOP LDA POVFL CLE,SZA,RSS JMP POVF?,I LDA ERR26 JSB ERROR CLA,CCE STA POVFL JMP POVF?,I * * ****************************** * * P R I N T * * ENTRY: * LDA * JSB PRINT * DEF * * WRITES LINE TO LIST FILE. ALSO CONTROLS PAGING. * COUNT IS MINUS NUMBER OF WORDS OR PLUS NUMBER OF BYTES. * PRINT NOP STA PSIZE ISZ #LNS TOP OF FORM? JMP PR.0 JSB EJECT YES: PRINT HEADING ISZ #LNS (CANNOT BE ZERO) PR.0 LDA PRINT,I STA P.BUF ISZ PRINT JSB EXEC DEF *+5 DEF .2 DEF PRCTL P.BUF DEF * DEF PSIZE JM*($P PRINT,I PSIZE BSS 1 * * ****************************** * * P S R C H * * ENTRY: * LDB * JSB PSRCH * DBL * DEC * * EXIT: * A= COMMAND TOKEN (0 IF ERROR) * B= BPTR TO NEXT CHARACTER (AS ENTERED IF ERROR) * * SEARCHES TABLE OF STRINGS UNTIL WE FIND A * MATCH. TABLE FORMAT MUST BE AS FOLLOWS: * * 1 * 5 8 7 0 * ******************* * * LENGTH : TOKEN * * ******************* * * BYTE 1 : * * ********** * * * * * * ********** * * : BYTE N * * ******************* * / : / * : ** / : / * ******************* * * 0 : 0 * * ******************* * * ENTRIES MAY HAVE ODD NUMBER OF BYTES. HOWEVER, * TABLE MUST CONTAIN FIXED-LENGTH ENTRIES. * PAIR OF ZEROES MUST TERMINATE TABLE. * PSRCH NOP STB @PRM SAVE PTR TO PARAM LDB PSRCH,I BPTR TO PARAM TABLE ISZ PSRCH PSCH1 STB @PTR GET PARAM LENGTH JSB LOADB STA CMDLN LDA @PRM COMPARE STRINGS INB JSB CMPB CMDLN BSS 1 SZA,RSS JMP PSCH2 OK: COMMAND MATCHES LDB @PTR ADB PSRCH,I NEXT COMMAND ENTRY JMP PSCH1 * PSCH2 ADB @PRM BPTR BEYOND COMMAND STB @PRM LDB @PTR GET COMMAND TOKEN INB JSB LOADB LDB @PRM ISZ PSRCH JMP PSRCH,I @PRM BSS 1 * * ****************************** * * R D C R D * * 'RDCRD' CONTROLS SOURCE INPUT. * * CALLING SEQUENCE: * JSB RDCRD * * RDCRD NOP LDA =D48 BLANK BUFFERS LDB @OUTB JSB CLEAN ASC 1, LDA KLUGE ***KLUDGE TO AVOID BUG IN %RDSC: SZA MUST DO OUR OWN LS READS IN JMP ?READ PASS 2 (SEE ?READ FOR DETAILS) RD1 JSB %READ READ DEF *+5 SOURCE DEF RDR INPUT DEF CARD FROM DISC OR DEVICE DEF .M72 JMP RD3 EOF RETURN SZB,RSS EOT? JMP RD1 YES TRY AGAIN. CMB,INB RD2 STB CRLEN LDA LUN CAN WE SZA,RSS SAVE SOURCE? JMP RDCRD,I NO,EXIT. JSB %WRIS WRITE DEF *+4 SOURCE DEF CARD TO DEF CRLEN DISC. CLA,RSS DISC FULL: CLEAR FLAG & SKIP CLA,INA SET "TRACKS AVAIL" FLAG STA LUN STORE FLAG FOR NEXT WRITE JMP RDCRD,I RD3 LDA ERR21 JSB ERROR LDA =A E FAKE END STA CARD+4 LDA =AND STA CARD+5 ISZ NOEND LDB =D-4 JMjP RD2 * * * * ? R E A D * * S U P E R K L U D G E !!!!!! * * WE DO OUR OWN READS OF LS TRACKS IN PASS 2 TO AVOID * BUG IN %RDSC. %RDSC RESETS LS PTR INTERNAL TO SREAD * (IE., %READ) BUT FAILS TO TURN OFF 'FIRST' FLAG. * SUBSEQUENT CALL TO %READ APPEARS TO BE FIRST ACCESS * TO LS TRACKS, SO %READ CALLS %JFIL WHICH RESETS INTERNAL * LS PTR TO THE SYSTEM LS PTR (ON BASE PAGE) -- THUS * UNDOING OUR %RDSC!! * * WHEN THIS IS REPAIRED IN THE RTE LIBRARY, THESE * ROUTINES (?READ, ?NSCT, ?RDSK, ?TKLU, AND %RDSC) SHOULD BE * DISCARDED (AS WELL AS THE 'KLUGE' TEST IN RDCRD). ALSO, * %RDSC SHOULD BE DECLARED EXTERNAL. * * WE BRANCH TO ?READ FROM RDCRD. THUS, RDCRD IS OUR * SUBROUTINE ENTRANCE. HERE, WE GET THE NEXT RECORD * FROM THE SECTOR BUFFER AND TRANSFER IT TO THE CARD * BUFFER. IF WE REACH THE END OF SECTOR, WE GO TO ?NSCT * TO LOCATE THE NEXT ONE. RECORDS ARE VARIABLE-LENGTH * AND PACKED ACROSS SECTOR BOUNDARIES. THE RECORD SIZE * IS CONTAINED IN THE UPPER BYTE OF THE NEXT WORD IN THE * SECTOR BUFFER. IF THIS WORD IS -1, WE HAVE THE END-OF- * FILE. * ?READ LDA @CARD STA @TBUF LDB SPTR ADDR OF NEXT WORD IN SECTOR ?RD0 LDA B,I NEXT WORD INB CPB @SEND END OF SECTOR? JSB ?NSCT YES CPA =D-1 END OF FILE? JMP RD3 YES: PROCESS EOF IN RDCRD ALF,ALF RECORD SIZE (WORDS) CMA STA RCNT -(ACTUAL RECORD SIZE+1) ADA =D37 WCNT<=36? SSA CLA NO: TRUNCATE TRANSFER ADA =D-36 STA WCNT ALS NEGATIVE BYTE COUNT STA CRLEN SZA BLANK RECORD (EOT)? JMP ?RD1 STB SPTR YES: IGNORE IT JMP ?RD0 ?RD1 LDA B,I XFER WORD TO CARD BUFFER INB CPB @SEND END OF SECTOR? JSB ?NSCT YES STA @TBUF,I ISZ @TBUF ISZ RCNT CANNOT GO TO 0 BEFORE WCNT ISZ WCNT END OF TRZANSFER? JMP ?RD1 NO ?RD2 ISZ RCNT END OF RECORD? INB,RSS (NOT IF XFER WAS TRUNCATED) JMP ?RD3 YES: WE'RE DONE CPB @SEND END OF SECTOR? JSB ?NSCT YES: GET NEXT ONE JMP ?RD2 ?RD3 STB SPTR PTR TO NEXT RECORD JMP RDCRD,I * * * * ? N S C T * * ENTRY: * LDA * JSB ?NSCT * EXIT: * A= LAST WORD IN SECTOR, OR FIRST WORD OF NEXT * TRACK (WHEN LAST WORD WAS TRACK POINTER) * B= POINTER TO NEXT WORD IN SECTOR (FIRST OR * SECOND DEPENDING ON A-REG RESPECTIVELY) * * WE UPDATE THE SECTOR NUMBER AND, IF NEED BE, THE TRACK * AND LU NUMBERS HERE. (?RDSK ACTUALLY DOES THE WORK OF * READING IN THE NEXT SECTOR.) * ?NSCT NOP LDB SECT# ADB =D2 CPB S/TRK LAST SECTOR? JMP ?NS0 YES STB SECT# STA LWORD SAVE LAST WORD JSB ?RDSK LDA LWORD RETURN LAST WORD JMP ?NSCT,I ?NS0 JSB ?TKLU UPDATE TRACK & LU NUMBERS CLA RESET SECTOR NUMBER TO ZERO STA SECT# JSB ?RDSK LDA B,I GET FIRST WORD OF TRACK INB POINT TO NEXT WORD JMP ?NSCT,I * * * * % R D S C * * ENTRY: * LDA * CLB * JSB %RDSC * * WHERE LS TRACK ADDR HAS THE LU # IN THE UPPER BYTE * AND THE TRACK # IN THE LOWER BYTE. "CLB" IS FOR * COMPATIBILITY WITH RTE LIBRARY. NB: THIS ROUTINE * BEARS NO RESEMBLANCE TO THE LIBRARY ROUTINE OF THE * SAME NAME. * * SETS UP LOCAL VALUES AND READS FIRST SECTOR. * %RDSC NOP ISZ KLUGE SET FLAG FOR RDCRD JSB ?TKLU SET UP TRACK & LU NUMBERS JSB ?RDSK JMP %RDSC,I * * * * ? T K L U * * ENTRY: * LDA * JSB ?TKLU * * WHERE LS TRACK ADDR HAS LU IN UPPER BYTE AND TRACK * NUMBER IN LOWER BYTE. * * WE SET UP TRK# AND DLUN. WE ALSO FETCH CORRESPONDING * S/TRK FRxOM BASE PAGE. * ?TKLU NOP CLB RRR 8 A=LU BLF,BLF B=TRK # STB TRK# LDB A GET S/TRK FROM B.P. ADB @SECT LDB B,I STB S/TRK IOR =B100 SET BINARY FLAG STA DLUN JMP ?TKLU,I * * * * ? R D S K * * ENTRY: * DLUN, TRK#, AND SECT# MUST POINT TO THE DESIRED * LOCATION. * EXIT: * B= POINTER TO FIRST WORD OF SECTOR. * * READS TWO (RTE) SECTORS FROM DISC (IE., 128 WORDS). * ALSO RESETS SPTR TO FIRST WORD OF SECTOR. * ?RDSK NOP JSB EXEC DEF *+7 DEF .1 DEF DLUN DEF SBUF DEF W/SCT DEF TRK# DEF SECT# * LDB @SBUF STB SPTR JMP ?RDSK,I * * * * LOCAL STORAGE FOR KLUDGE ROUTINES * * D O N O T R E F E R E N C E THESE IN OTHER PARTS * OF PROGRAM. THESE SHOULD DISAPPEAR WITH KLUDGE. * @SECT DEF 1757B-2 2-ORIGINED PTR TO B.P. S/TRK @SBUF DEF SBUF CONSTANT PTR TO SBUF @TBUF BSS 1 MOVING PTR INTO CARD BUFFER DLUN OCT 100 BINARY FLAG SET KLUGE DEC 0 SET IN %RDSC, USED IN RDCRD LWORD BSS 1 LAST WORD IN SECTOR RCNT BSS 1 ACTUAL RECORD SIZE SBUF BSS 128 SECTOR BUFFER @SEND DEF * PTR TO END+1 OF BUFFER SECT# OCT 0 SPTR DEF SBUF MOVING PTR INTO SBUF S/TRK BSS 1 64-WORD SECTORS PER TRACK TRK# BSS 1 WCNT BSS 1 EFFECTIVE RECORD SIZE W/SCT DEC 128 WORDS PER DISC TRACK * * ****************************** * * R L O A D * * ENTRY: * JSB RLOAD * * PROMPTS USER TO RELOAD SOURCE TAPE IN PAPER TAPE * READER AND PAUSES. USED BETWEEN PASSES AND BEFORE * CROSS-REF WHEN WE CANNOT GET LS TRACKS. * RLOAD NOP LDB =D-32 BETWEEN PASSES LDA CONSL PROMPT USER JSB IOSUB OCT 2 OCT 200 DEF RLMSG JSB EXEC PAUSE DEF *+2 DEF .7 JSB EOT JMP RLOAD,I RLMSG ASC 16, /MICRO: RE-INPUT SOURCE AND *GO * * ******************** * * R T * * ENTRY: * JSB RT * * ROUTINE RELEASES ANY PROGRAM TRACKS. * RT NOP JSB EXEC DEF *+3 DEF .5 DEF .M1 JMP RT,I * * ****************************** * * S E R C H * * 'SERCH' SEARCHES THE SYMBOL TABLE FOR THE * SYMBOL (IE, LABEL) WHOSE STARTING BYTE ADDRESS * IS IN THE B REG. * CALLING SEQUENCE: * B REG SHOULD CONTAIN STARTING BYTE ADDRESS * OF SYMBOL TO BE SEARCHED FOR. * JSB SERCH * * UPON RETURN, THE WORD ADDRESS OF THE START OF * THE SYMBOL TABLE ENTRY FOR THAT SYMBOL WILL BE IN A REG. * A REG < 0 IMPLIES SYMBOL NOT PRESENT IN SYMBOL * TABLE. * SERCH NOP LDA =D-8 PUT THE SYMBOL INTO THE JSB TLOAD BUFFER, 'TOKEN'. LDB @SYMT PICK UP HEAD TABLE ADDRESS SR0 CPB @SYMB END OF TABLE? CCA,RSS JMP *+2 JMP SERCH,I EXIT LDA B,I NO,COMPARE CPA @TOKN,I 1ST 2 CHARS THE SAME? JMP *+3 YES ADB =D6 NO, POINT JMP SR0 TO NEXT ENTRY GO BACK. LDA @TOKN COMPARE INA NEXT STA SR.00 2 INB CHARACTERS. LDA B,I CPA SR.00,I SAME? JMP *+3 ADB =D5 NO, POINT TO NEXT JMP SR0 ENTRY & TRY AGAIN ISZ SR.00 YES INB CHECK NEXT LDA B,I 2. CPA SR.00,I SAME? JMP *+3 ADB =D4 NO, POINT TO NEXT JMP SR0 ENTRY & TRY AGAIN. ISZ SR.00 YES. INB CHECK LAST LDA B,I 2 CHARS. CPA SR.00,I SAME? JMP SR1 ADB =D3 NO. POINT B REG. TO START OF JMP SR0 NEXT ENTRY. TRY AGAIN. SR1 LDA B YES, SUCCESS. ADA =D-3 SET A TO HEAD OF ENTRY. JMP SERCH,I & EXIT. * * ****************************** * * S E T P * * ENTRY: * LDA  * JSB SETP * * EXIT: * E= 0 IF NO OVERFLOW * 1 IF OVERFLOW THIS TIME * PCNTR=0 IF OVERFLOW * POVFL=1 IF OVERFLOW (THIS TIME OR PREVIOUSLY) * * ASSIGNS NEW PCNTR VALUE AND DOES BOUNDS CHECK. * "POVFL" IS SET FOR ERROR CHECK, DEFERRED UNTIL * WE (SIMULATE) ATTEMPT TO GENERATE MICROCODE INTO * THIS LOCATION. E-REG IS SET SO THAT WE CAN FLAG * INVALID ADDR EXPRESSION IN "ORG" PSEUDO-OP. * SETP NOP STA PCNTR AND MXAD1 OVERFLOW? CLE,SZA,RSS E=0 ==> NO OVERFLOW THIS TIME JMP SETP,I NO CLA YES: WRAP-AROUND ADDRESS STA PCNTR CCE,INA E=1 ==> OVERFLOW THIS TIME STA POVFL SET GLOBAL OVERFLOW FLAG JMP SETP,I * * ****************************** * * S K I P * * ENTRY: * LDA * LDB * JSB SKIP * * EXIT: * A= NEXT CHARACTER * B= BYTE POINTER TO NEXT CHARACTER * OV=0 IF NEXT CHARACTER IS NOT END OF CARD * 1 IF NEXT CHARACTER IS END OF CARD (ZERO) * * SCANS (A BYTE POINTER) UNTIL THE NEXT CHARACTER * IS NOT (UPPER BYTE MUST BE ZERO). * SKIP NOP STA CHAR CLO SCW JSB LOADB CPA CHAR JMP SCW ADB =D-1 BACK-UP OVER TERMINATOR SZA,RSS STO JMP SKIP,I * * ****************************** * * S K P T O * * THIS ROUTINE SKIPS TO SYMBOL IN A-REG * STARTING AT BYTE ADDRESS SPECIFIED IN B-REG. * IF END OF CARD IS REACHED BEFORE SYMBOL FOUND * OVERFLOW IS SET. * SKPTO NOP STA CHAR SAVE TEST CHAR CLO SCU JSB LOADB CPA CHAR JMP SCU1 SZA JMP SCU STO SCU1 ADB =D-1 BACK-UP OVER CHARACTER JMP SKPTO,I * * ****************************** * * S P A C E * S P A C ? * * ENTRY: * LDA <# SPACES> * JSB SPACE -OR- JSB SPAC? * * SPACES N LINES ON THE LIST FILE. SPAC? CALLED WHEN * WE ONLY WANT TO SPACE IF LISTING IS ENABLED. * SPACE NOP STA SLNS ENOUGH LINES ON PAGE? ADA #LNS SSA,RSS JMP SP1 NO: EJECT PAGE INSTEAD STA #LNS JSB EXEC THIS SPACES WITHOUT AUTO-EJECT. DEF *+4 THUS, WE CANNOT SPACE TO LAST DEF .3 LINE SINCE WE ASSUME AUTO-EJECT DEF SPCTL AFTER LAST LINE DEF SLNS JMP SPACE,I * SP1 JSB EJECT JMP SPACE,I * * * SPAC? NOP LDB LIST? SZB,RSS JMP SPAC?,I LDB SPAC? STB SPACE JMP SPACE+1 * SLNS BSS 1 * * ****************************** * * $ S R C H * * THIS ROUTINE SEARCHES THE OPCODE TABLE INDICATED BY * A-REG FOR MNEMONIC POINTED TO BY B-REG. * * ON ENTRY: A REG SHOULD CONTAIN NO. REFERENCING TABLE * TO BE SEARCHED, AS FOLLOWS: * A=1 REFERENCES 'OPCODE' TABLE. * A=2 " 'SPECIAL' " * A=3 " 'CONDITION' " * A=4 " 'ALU' " * A=5 " 'IMM' " * A=6 " 'STORE' " * A=7 " 'S-BUS' " * A=8 " 'JMP MOD' " * A=9 " 'SENSE' " * A=10 " 'PSEUDO-OP' " * * B= BYTE POINTER TO MNEMONIC STRING * * ON EXIT A= VALUE OF OPCODE ( >=0 ) * IF A<0, THEN THE MNEMONIC WASN'T FOUND. * * * TABLE LOOKS LIKE * * ***************** * * BYTE1 * BYTE2 * * ***************** * * BYTE3 * BYTE4 * * ***************** * * VALUE * * ***************** * $SRCH NOP STA S.001 STB S.000 SAVE BYTE ADDRESS ADA @OPS LDA A,I STA PNTR SAVE TABLE HEAD. LDA B MOVE OP-CODE: A=BPTR TO SOURCE LDB @TOKN GET BPTR TO TOKEN RBL &0.* JSB MVB MOVE ALL 4 CHARS DEC 4 LDB MVINP 5-TH CHAR IS BLANK? JSB LOADB CPA BLNK JMP *+2 JMP $SCH5 NO: INVALID MNEMONIC LDB PNTR $SCH0 LDA B,I 1ST 2 BYTES COMPARE? CPA TOKEN JMP $SCH2 YES. ADB =D4 NO. POINT TO $SCH1 LDA B,I NEXT ENTRY. SZA END OF TABLE? JMP $SCH0 NO. GO BACK. $SCH5 CCA YES SET ERROR JMP $SRCH,I EXIT $SCH2 INB DO 2ND LDA B,I 2 CPA TOKEN+1 BYTES COMPARE JMP $SCH3 YES. ADB =D3 NO. POINT TO NEXT MNEMONIC JMP $SCH1 AND GO TEST THAT ONE. $SCH3 ADB TOFF YES. LDA B,I PICK UP BINARY CODE. LDB MX? SZB,RSS JMP $SRCH,I LDB S.001 MODIFY RESULT FOR MX CPB =D7 S-BUS FIELD? JMP $SCH4 CPB =D8 JMP MODIFIER FIELD? JMP *+2 JMP $SRCH,I CPA SPBLK+1 LDA UNCD JMP $SRCH,I $SCH4 CPA STMEU+1 LDA SBMEU JMP $SRCH,I EXIT * @OPS DEF * DEF OPCOD DEF SPEC DEF COND DEF ALU DEF IMM DEF STORE DEF SBUS DEF SPEC DEF SENSE DEF PSEUD * s0* ****************************** * * S T O R B * * ENTRY: * LDA * LDB * JSB STORB * * EXIT: * B= BPTR TO DESTINATION+1 * BYTE= CHARACTER (LOW BYTE ONLY) * * THIS ROUTINE STORES LOW BYTE OF A IN * LOCATION IN B. ADDRESS INCREMENTED ON EXIT. * A-REG IS CLOBBERED ON RETURN. * STORB NOP AND =B377 ISOLATE LOW BYTE STA BYTE CLE,ERB E=0 FOR HIGH BYTE LDA B,I SEZ,RSS ALF,ALF ALIGN DESTINATION BYTE AND =B177400 STUFF BYTE IOR BYTE SEZ,RSS ALF,ALF RESTORE TO HIGH BYTE STA B,I ELB INCREMENT BYTE ADDR INB JMP STORB,I EXIT. * * ****************************** * * S T U F F * * ENTRY: * LDA * LDB * JSB STUFF * * PACKS 3 MICRO-INSTRUCTION BYTES INTO S-FORMAT * BUFFER. NOTE THAT IN MSB OF MICROWORD, UPPER * BYTE MUST BE ZERO. * STUFF NOP STA BYTE2 SAVE MSB OF MICROWORD RRL 8 ISOLATE 2 LSB BYTES BLF,BLF B=LOWER LSB AND =B377 A=HIGHER LSB STA BYTE1 STB BYTE0 ADA B UPDATE CHECKSUM ADA BYTE2 ADA CKSUM STA CKSUM LDB PNBUF LDA BYTE2 MOVE MICROWORD INTO BUFFER JSB STORB LDA BYTE1 JSB STORB LDA BYTE0 JSB STORB STB PNBUF ISZ PNLEN JMP STUFF,I BYTE0 BSS 1 MICROWORD BYTES BYTE1 BSS 1 BYTE2 BSS 1 * * ****************************** * * S U B P * * ENTRY: * LDB * JSB SUBP * DEF * * EXIT: * A= SEPARATOR * B= BPTR TO NEXT CHAR * * SCANS SECURITY AND CR-LABEL CODES OF THE FORM: * [+/-] * [+/-] B * CHAR [CHAR]... * NOTE THAT SEPARATOR MUST FOLLOW NU MERIC FORMS. IF * NOT (OR IF THERE IS ANY ERROR IN CONVERTING NUMBER), * "NUMERIC" STRING IS TAKEN AS CHAR STRING. NOTE THAT * THIS PERMITS "66X" TO BE TAKEN AS THE CHAR STRING "66" * INSTEAD OF THE NUMBER 66 (AS PER RTE DESIGN). EXTRA * CHARACTERS IN CHAR STRING ARE IGNORED. NOTE ALSO THAT * WE RECOGNIZE %-FORM NUMBERS AND "- CHAR" AS STRINGS * (AS PER RTE). * SUBP NOP STB @PTR LDA SUBP,I SAVE PTR TO RESULT STA STMP CLA CLEAR DESTINATION RESULT STA STMP,I ISZ SUBP JSB CON? NUMERIC STRING? JMP S.ABC NO: CONVERT CHAR STRING STA STMP,I JSB EOS? END OF PARAMETER? JMP SUBP,I YES. ELSE MAY BE LIKE "1C" S.ABC LDB @PTR GET FIRST CHAR AGAIN JSB EOS? JMP SUBP,I NULL SUBPARAMETER STA STMP,I JSB EOS? ANOTHER CHAR? JMP S.ONE NO. ALF,ALF COMBINE WITH FIRST ADA STMP,I ALF,ALF STA STMP,I JMP *+2 S.ONE ADB =D-1 BACK UP OVER SEPARATOR S.SKP JSB EOS? SKIP EXTRA CHARACTERS JMP SUBP,I JMP S.SKP STMP BSS 1 * * ****************************** * * S Y M A D * * 'SYMAD' ADDS THE SYMBOL(IE., THE LABEL) POINTED * TO BY B REG TO THE SYMBOL TABLE. * * CALLING SEQUENCE: * B REG MUST CONTAIN THE STARTING BYTE ADDRESS * OF THE SYMBOL TO BE ADDED; * A REG MUST CONTAIN THE VALUE OF THE SYMBOL * (IE., THE ADDRESS OF SYMBOL IN THE MICROPROGRAM). * JSB SYMAD * * ROUTINE CHECKS FOR DUPLICATE ENTRIES. ALSO * VERIFIES THAT LABEL IS VALID (IE., DOES NOT * CONTAIN "+-;," OR EMBEDDED BLANKS). * * E-REG IS SET FOR EQU LABELS. * * SYMBOL TABLE FORMAT: * * *************** * *BYTE1 * BYTE2* * *************** * *BYTE3 * BYTE4* * *************** * *BYTE5 * BYTE6* * *************** * *BYTE7 * BYTE8* * *************** * * b VALUE * * *************** * * TAG * * *************** * * TAG IS 1 FOR EQU LABELS * SYMAD NOP STB @INP LDB SYOVF SZB TABLE OVERFLOW? JMP SY4 YES STA @VAL,I SAVE @VALUE. CLA SET ELA FLAG IF EQU STA @TAG,I * * THIS SECTION HANDLES NON-EXTERNAL SYMBOLS. * LDA =D-8 STA COUNT LDB @SYMB RBL STB @DEST SYM1 JSB SMOVE MOVE CHAR TO SYMTAB CPA BLNK TRIALING BLANKS? JMP SY1.1 CPA PLUS CHECK FOR INVALID CHARS JMP SY5 CPA MINUS JMP SY5 ISZ COUNT JMP SYM1 JMP SY1.2 SY1.0 JSB SMOVE GET NEXT CHARACTER CPA BLNK JMP *+2 OKAY: TRAILING BLANK JMP SY5 BAD CHAR SY1.1 ISZ COUNT JMP SY1.0 SY1.2 LDB @INP B=BPTR TO AFTER FIELD 1 JSB LOADB IS IT BLANK? CPA BLNK JMP *+2 JMP SY5 NO: BAD LABEL LDB @SYMB RBL JSB SERCH IS CURRENT SYMBOL ALREADY SSA,RSS IN SYMBOL TABLE? JMP SY4.1 YES: DUPLICATE LDA @TAG BUMP PTRS TO END OF TABLE INA STA @SYMB ADA =D4 STA @VAL INA STA @TAG ADA LWA SSA IMPENDING TABLE OVERFLOW? JMP SYMAD,I CLA,INA YES: SET WARNING FLAG STA SYOVF JMP SYMAD,I EXIT. * SY4 CPB =D2 SYM TABLE OVERFLOW JMP SYMAD,I ALREADY REPORTED ISZ SYOVF LDA ERR22 JMP SY5.1 SY4.1 LDA ERR1 DUPLICATE LABEL JMP SY5.1 SY5 LDA ERR31 INVALID LABEL SY5.1 JSB ERROR JMP SYMAD,I * SMOVE NOP MOVE CHARS INTO SYMTAB LDB @INP JSB LOADB STB @INP LDB @DEST JSB STORB STB @DEST LDA BYTE A=CHARACTER STORED JMP SMOVE,I * * ****************************** * * T I T L E * * ENTRY: * JSB TITLE * * PRINTS TITLE AND SPACES 2 LINES. (WE ASSUME WE'RE AT * TOP OF FORM.) ALSO RESETS #LNS TO LINE 3 VALUE. * TITLE NOP ISZ PAGE# LDA PAGE# LDB @HFD1 JSB DECML JSB EXEC DEF *+5 DEF .2 DEF PRCTL DEF HEADR DEF HSIZE JSB EXEC DEF *+4 DEF .3 DEF SPCTL DEF .2 LDA LINE3 STA #LNS JMP TITLE,I @HFD1 DBL HEADR+4 @HFD2 DBL HEADR+5 HSIZE DEC 21 * * ****************************** * * T L O A D * * ENTRY: * LDA * LDB * JSB TLOAD * * EXIT: * TLINP= BPTR TO LAST+1 CHARACTER * * STUFFS STRING INTO "TOKEN" FOR COMPARISON * PURPOSES. * TLOAD NOP STA TLCNT CHAR IN CASE OF END OF STR STB TLINP LDA @TOKN RAL STA TLDST LDA =D4 BLANK TOKEN LDB @TOKN JSB CLEAN ASC 1, * TL1 LDB TLINP GET NEXT CHARACTER JSB LOADB CPA PLUS JMP TLOAD,I CPA MINUS JMP TLOAD,I CPA BLNK JMP TLOAD,I STB TLINP LDB TLDST XFER CHARACTER JSB STORB STB TLDST ISZ TLCNT JMP TL1 JMP TLOAD,I TLCNT BSS 1 TLDST BSS 1 * * ******************** * * X R E F * * ENTRY: * JSB XREF * * SETS UP PARAMETERS AND SCHEDULES MXREF. * WE SET BIT14 IN 1ST PARAMETER TO INDICATE THAT * MXREF IS SCHEDULED FROM MICRO. WE ALSO PACK * CONSOLE & LIST LU'S INTO LIST PARAMETER SO THAT * WE CAN PASS LAST PAGE# TO MXREF. NOTE THAT WE * MUST SUSPEND UNTIL MXREF IS COMPLETED SO THAT * WE CAN RELEASE TRACKS. * XREF NOP LDA PARMS+1 RESET INPUT PARAM LDB LSTRK USING TRACKS? SZB LDA =D2 YES: PASS LU 2 IOR =B40000 SET MICRO FLAG LDB DDT? DEBUGGING? SZB CMA,INA YES: NEGATE INPUT PARAM STA PARMS+1 CLB PACK CONSOLE LU INTO LIST PARAM LDA PARMS+2 LIST PARAM=0? SZA IOR =B200 NO: SET HI BIT TO DISTINGUISH RRR 8 NON-NULL PARAM -- SAVE IN B LDA PARMS+5 CONSOLE PARAM=0? SZA IOR =B200 NO: SET IT'S HI BIT, TOO RRL 8 HI=CONSOLE, LOW=LIST STA PARMS+2 JSB EXEC SCHEDULE MXREF DEF *+8 DEF .9 IMMEDIATELY WITH WAIT DEF MXREF DEF PARMS+1 INPUT DEV DEF PARMS+2 CONSOLE & LIST DEV DEF PARMS+4 LPP DEF PAGE# LAST PAGE# DEF LSTRK TRACK ADDR JMP XREF,I MXREF ASC 3,MXREF SKP HED OPCODE TABLES * * O P & P S E U D O - O P T A B L E S * * XE: FIRST ENTRY * MX: SECOND ENTRY * * * BITS 14-12 ==> INSTRUCTION FORMAT TYPE (0 MEANS WE CAN'T * TELL FROM THE OP FIELD ALONE) * OPCOD EQU * ASC 2,NOP OCT 010000 OCT 010000 ASC 2, OPBLK OCT 010000 OCT 010000 ASC 2,ARS OCT 010001 OCT 010001 ASC 2,CRS OCT 010002 OCT 010002 ASC 2,LGS OCT 010003 OCT 010003 ASC 2,NRM OCT 010004 OCT -1 ASC 2,DIV OCT 010005 OCT 010005 ASC 2,LWF OCT 010006 OCT 010006 ASC 2,MPY OCT 010007 OCT 010004 ASC 2,WRTE OCT 010010 OCT 010007 ASC 2,READ OCT 010011 OCT 010011 ASC 2,ENV OCT 010012 OCT 010012 ASC 2,ENVE OCT 010013 OCT 010013 ASC 2,JSB OCT 000014 OCT 040014 ASC 2,JMP OCT 000015 OCT 000015 ASC 2,IMM OCT 020016 OCT 020016 ASC 2,RTN RTN OCT 000017 OCT -1 ASC 2,ASG OCT -1 OCT 010010 * PSEUDO-OPS PSEUD EQU * ASC 2,EQU OCT 050001 OCT 050001 ASC 2,DEF OCT 050002 OCT 050002 ASC 2,ONES OCT 050003 OCT 050003 ASC 2,ZERO OCT 050004 OCT 050004 ASC 2,ALGN OCT 050005 OCT 050005 ASC 2,ORG OCT 050006 OCT 050006 ASC 2,END OCT 050007 OCT 050007 OCT 0 END OF 'OPCODE' TABLE. * * S P E C I A L T A B L E * * BIT 13 SET ==> OK IN TYPE4 FORMAT * BIT 12 SET ==> OK IN TYPE1 OR TYPE2 FORMATS * NEITHER SET ==> OK IN TYPE3 FORMAT * * BIT 11 SET DISTINGUISHES MX BLANK FIELD FROM * MX "NOP". THIS IS NECESSARY BECAUSE A BLANK IN * A TYPE4 INSTRUCTION DEFAULTS TO "UNCD", WHEREAS * IN A TYPE1 OR TYPE2 INSTRUCTION IT DEFAULTS TO * "NOP". HOWEVER, "NOP" IS ALSO A VALID SPECIAL * IN A TYPE4 INSTRUCTION. * SPEC EQU * ASC 2,NOP OCT 030007 OCT 010017 ASC 2, SPBLK OCT 030007 OCT 034017 ASC 2,ASG OCT 010030 OCT -1 ASC 2,IAK OCT 010031 OCT -1 ASC 2,MPP1 OCT 010032 OCT -1 ASC 2,FTCH OCT 010033 OCT 010012 ASC 2,INCI OCT 010034 OCT 010025 ASC 2,SHLT OCT 010035 OCT 010024 ASC 2,MPCK OCT 010036 OCT 010021 ASC 2,IOFF OCT 030037 OCT 030000 ASC 2,SRG2 OCT 010020 OCT 010001 ASC 2,SRG1 OCT 010021 OCT 010006 ASC 2,L1 OCT 010022 OCT 010002 ASC 2,L4 OCT 010023 OCT 010003 ASC 2,R1 OCT 010024 OCT 010004 ASC 2,DCNT OCT 010025 OCT -1 ASC 2,ICNT OCT 010026 OCT 010023 ASC 2,RPT OCT 030027 OCT 010015 ASC 2,SRUN OCT 010010 OCT 010027 ASC 2,MPP2 OCT 010011 OCT -1 ASC 2,MESP OCT 010012 OCT 030020 ASC 2,COV OCT 010013 OCT 010014 ASC 2,SOV OCT 010014 OCT 010013 ASC 2,PRST OCT 010015 OCT -1 *($ ASC 2,CLFL OCT 010016 OCT 010011 ASC 2,STFL OCT 030017 OCT 030010 ASC 2,RTN OCT 010000 OCT 010036 ASC 2,JTAB OCT 010001 OCT 010033 ASC 2,CNDX OCT 000002 OCT 000031 ASC 2,J30 OCT -1 OCT 020035 ASC 2,RJ30 OCT 030004 OCT -1 ASC 2,J74 OCT 020005 OCT 020034 ASC 2,IOG OCT 030006 OCT 030022 ASC 2,ION OCT 030003 OCT 010005 ASC 2,UNCD OCT -1 UNCD OCT 020030 ASC 2,SRGE OCT -1 OCT 010016 ASC 2,JIO OCT -1 OCT 020032 ASC 2,JEAU OCT -1 OCT 020037 ASC 2,RES1 OCT -1 OCT 010026 ASC 2,RES2 OCT -1 OCT 010007 2* OCT 0 END OF 'SPECIAL' TABLE. * * C O N D I T I O N T A B L E * COND EQU * ASC 2,ALZ ALZ OCT 0 OCT -1 ASC 2,ONES OCT 1 OCT 1 ASC 2,COUT OCT 2 OCT 2 ASC 2,AL0 OCT 3 OCT 3 ASC 2,L0 OCT 4 OCT -1 ASC 2,L15 OCT 5 OCT -1 ASC 2,RUN OCT 6 OCT 13 ASC 2,HOI OCT 7 OCT -1 ASC 2,CNT4 OCT 10 OCT 36 ASC 2,IR11 OCT 11 OCT -1 ASC 2,RUNE OCT 12 OCT 34 ASC 2,NMLS OCT 13 OCT 5 ASC 2,MPP OCT 14 OCT -1 ASC 2,CNT8 OCT 15 OCT 6 ASC 2,NSFP OCT 16 OCT 31 ASC 2,AL15 OCT 17 OCT 4 ASC 2,NLDR OCT 20 OCT 20 ASC 2,NSTB OCT 21 OCT 30 ASC 2,NINC OCT 22 OCT 22 ASC 2,NDEC OCT 23 OCT 23 ASC 2,NRT OCT 24 OCT 24 ASC 2,NLT OCT 25 OCT 25 ASC 2,NSTR OCT 26 OCT 26 ASC 2,NMDE OCT 27 OCT -1 ASC 2,FLAG OCT 30 OCT 10 ASC 2,E OCT 31 OCT 11 ASC 2,NINT OCT 32 OCT -1 ASC 2,OVFL OCT 33 OCT 12 ASC 2,NSNG OCT 34 OCT 21 ASC 2,SKPF OCT 35 OCT 15 ASC 2,IR8 OCT 36 OCT -1 ASC 2,MRG OCT 37 OCT -1 ASC 2,TBZ OCT -1 OCT 0 ASC 2,FPSP OCT -1 OCT 7 ASC 2,NHOI OCT -1 OCT 14 ASC 2,ASGN OCT -1 OCT 16 ASC 2,IR2 OCT -1 OCT 17 ASC 2,NRST OCT -1 OCT 27 ASC 2,INT OCT -1 OCT 32 ASC 2,SRGL OCT -1 OCT 33 ASC 2,NMEU OCT -1 OCT 37 ASC 2,NOP OCT -1 OCT 35 ASC 2, CDBLK OCT -1 OCT 35 OCT 0 END OF 'CONDITION' TABLE. * * S E N S E T A B L E * SENSE EQU * ASC 2,RJS OCT 1 OCT 0 ASC 2, SNBLK OCT 0 OCT 1 OCT 0 END OF 'SENSE' TABLE * * A L U T A B L E * ALU EQU * ASC 2,PASS OCT 20 OCT 37 ASC 2, ALBLK OCT 20 OCT 37 ASC 2,DEC OCT 0 OCT 17 ASC 2,OP11 OCT 1 OCT 16 ASC 2,OP10 OCT 2 OCT 15 ASC 2,DBLS OCT 3 OCT -1 ASC 2,OP9 OCT -1 OCT 14 ASC 2,OP8 OCT 4 OCT 13 ASC 2,OP7 OCT 5 OCT 12 ASC 2,ADD OCT 6 OCT 11 ASC 2,OP6 OCT 7 OCT 10 ASC 2,OP5 OCT 10 OCT 7 ASC 2,SUB OCT 11 OCT 6 ASC 2,OP4 OCT 12 OCT 5 ASC 2,OP3 OCT 13 OCT 4 ASC 2,ZERO OCT 14 OCT 3 ASC 2,OP2 OCT 15 OCT 2 ASC 2,OP1 OCT 16 OCT 1 ASC 2,INC OCT 17 OCT 0 ASC 2,IOR OCT 21 OCT 36 ASC 2,SONL OCT 22 OCT 35 ASC 2,ONE OCT 23 OCT 34 ASC 2,AND OCT 24 OCT 33 ASC 2,PASL OCT 25 OCT 32 ASC 2,XNOR OCT 26 OCT 31 ASC 2,NSOL OCT 27 OCT 30 ASC 2,SANL OCT 30 OCT 27 ASC 2,XOR OCT 31 OCT 26 ASC 2,CMPL OCT 32 OCT 25 ASC 2,NAND OCT 33 OCT 24 ASC 2,OP13 OCT 34 OCT 23 ASC 2,NSAL OCT 35 OCT 22 ASC 2,NOR OCT 36 OCT 21 ASC 2,CMPS OCT 37 OCT 20 OCT 0 END OF 'ALU' TABLE. * * I M M E D I A T E T A B L E * IMM EQU * ASC 2,HIGH HIGH OCT 1 OCT 0 ASC 2,LOW OCT 0 OCT 1 ASC 2,CMHI OCT 3 OCT 2 ASC 2,CMLO OCT 2 OCT 3 OCT 0 END OF 'IMM' TABLE. * * S B U S & S T O R E T A B L E S * * BIT 13 SET ==> STORE MNEMONIC * BIT 12 SET ==> S-BUS MNEMONIC * SBUS EQU * STORE EQU * ASC 2,NOP OCT 030017 OCT 030017 ASC 2, SBBLK OCT 030017 OCT 030017 ASC 2,TAB OCT 030000 OCT 030000 ASC 2,CAB OCT 030001 OCT 030001 ASC 2,MPPA OCT 030002 OCT -1 ASC 2,T OCT -1 OCT 030002 ASC 2,A OCT 030003 OCT 030013 ASC 2,B OCT 030004 OCT 030012 ASC 2,IOO OCT 020005 OCT 020004 ASC 2,IOI OCT 010005 OCT 010004 ASC 2,DSPL OCT 030006 OCT 030006 ASC 2,DSPI OCT 030007 OCT 030007 ASC 2,MPPB OCT 030010 OCT -1 ASC 2,MEU STMEU OCT 030011 OCT 020014 ASC 2,L OCT 020012 OCT 020003 ASC 2,CIR OCT 010012 OCT 010003 ASC 2,CNTR OCT 030013 OCT 030005 ASC 2,IRCM OCT 020014 OCT -1 ASC 2,LDR OCT 010014 OCT 010014 ASC 2,M OCT 030015 OCT 030011 ASC 2,PNM OCT 020016 OCT 020016 ASC 2,DES OCT 010016 OCT -1 ASC 2,S1 OCT 030020 OCT 030020 ASC 2,S2 OCT 030021 OCT 030021 ASC 2,S3 OCT 030022 OCT 030022 ASC 2,S4 OCT 030023 OCT 030023 ASC 2,S5 OCT 030024 OCT 030024 ASC 2,S6 OCT 030025 OCT 030025 ASC 2,S7 OCT 030026 OCT 030026 ASC 2,S8 OCT 030027 OCT 030027 ASC 2,S9 OCT 030030 OCT 030030 ASC 2,S10 OCT 030031 OCT 030031 ASC 2,S11 OCT 030032 OCT 030032 ASC 2,SP  OCT 030033 OCT -1 ASC 2,X OCT 030034 OCT 030034 ASC 2,Y OCT 030035 OCT 030035 ASC 2,P OCT 030036 OCT 030036 ASC 2,S OCT 030037 OCT 030037 ASC 2,IR OCT -1 OCT 020010 ASC 2,ADR OCT -1 OCT 010010 ASC 2,CM OCT -1 OCT 020015 ASC 2,RES2 OCT -1 OCT 010015 ASC 2,S12 OCT -1 OCT 030033 OCT 0 END OF 'STORE' TABLE. SBMEU OCT 010016 STBLK EQU SBBLK HED CONSTANTS, BUFFERS, MESSAGES "$" OCT 44 "%" OCT 45 "B" OCT 102 "C" OCT 103 "L" OCT 114 "R" OCT 122 "S" OCT 123 "T" OCT 124 "X" OCT 130 .M"0" OCT -60 .M72 DEC -72 .M10 DEC -10 .M1 DEC -1 .0 DEC 0 .1 DEC 1 .2 DEC 2 .3 DEC 3 .4 DEC 4 .5 DEC 5 .6 DEC 6 .7 DEC 7 .9 DEC 9 .22 DEC 22 ASTER OCT 52 BLNK OCT 40 BLNK2 ASC 1, COLON OCT 72 COMMA OCT 54 MINUS OCT 55 PLUS OCT 53 * * * A EQU 0 AEND ASC 8, /MICRO: ABORTED ANYER OCT 0 SET IF PASS1 OR PASS2 ERROR B EQU 1 BASE DEC -1 BINRY BSS 1 FOR DECML & OCTAL CONVERSION BYTE BSS 1 CARD EQU *+12 INPUT/OUTPUT BUFFER FOR SOURCE OUTBF BSS 12 FOR LINE# AND CODE OFFSET BSS 36 OCT 20000 TRAILING BLANK & END-OF-LINE @CARD DEF CARD CCNT DEC 0 CFLG OCT 0 CHAR BSS 3 CODE? OCT 0 SET IF $CODE ENCOUNTERED CONSL DEC 1 DEFAULT CONSOLE LU COUNT BSS 1 CRLEN BSS 1 CSAVB BSS 1 CTBL BYT 5,1 TABLE OF $COMMANDS ASC 4,PAGE (SEE PSRCH FOR FORMAT) BYT 5,2 ASC 4,PAGE= BYT 5,3 ASC 4,LIST BYT 7,4 ASC 4,NOLIST BYT 6,5 ASC 4,PUNCH BYT 10,6 ASC 4,NOPUNCH BYT 5,7 ASC 4,CODE= OCT 0 TERMINATOR @DCB DEF 0 PTR TO FILE BUFFER DDT? OCT 0 SET IF DEBUGGING @DEST BSS 1 DFORG OCT 27000 MXE USER MOQDULE ADDR DGITS BSS 1 FOR DECML & OCTAL CONVERSION END? OCT 0 ENDMS ASC 12, /MICRO: END WITH ERRORS ENDRC OCT 002000 'END RECORD' CODE OCT 120000 OCT 120000 OCT 0 ERR? DEC 0 #ERRS DEC 0 @FADR DEF * ONE-ORIGINED TABLE @FLD1 DBL CARD TABLE OF SOURCE FIELD BPTRS @FLD2 DBR CARD+4 @FLD3 DBL CARD+7 @FLD4 DBR CARD+9 @FLD5 DBL CARD+12 @FLD6 DBR CARD+14 FCR DEC 0 FILE DEC 0 FILE? DEC 0 FILL# BSS 1 FILL1 OCT 177777 LOW 16 BITS OF FILL FILL2 OCT 377 HIGH 8 BITS OF FILL @FLDS DEF *-1 TWO-ORIGINED TABLE FLD2 BSS 1 TABLE OF FIELD VALUES FLD3 BSS 1 FLD4 BSS 1 FLD5 BSS 1 FLD6 BSS 1 FMGR BSS 1 FMGR ERROR CODES FMT OCT 0 PUNCH FMT: R=0...S=1 @FNAM DEF FNAME FNAME ASC 3, FRST? OCT 1 CLEARED AFTER DUMPING 1ST BUFFER FSEC DEC 0 FSIZE DEC 29,128 BLOCK=29*128 & TYPE=5 FOR FTYPE DEC 5 R-FORMAT (59-WD RECORDS) HED1 ASC 6,SYMBOL TABLE @INP BSS 1 INST1 BSS 1 LOW 16 BITS OF MICROINSTR. INST2 BSS 1 HIGH 8 BITS AND REL ADDR OF " LAST# DEC 0 LINE # OF LAST ERROR LASTP DEC -34 CAUSES S-FMT BUFFER TO BE INIT'D LINE# DEC 0 LINE3 DEC -57 -((LPP-3)+1): LINES+1 AFTER TITLE LIST DEC 6 L.U. # OF LIST DEVICE LIST? DEC 0 #LNS DEC -1 CAUSES INITIAL PAGE EJECT LSTRK OCT 0 LS TRACK ADDR (0==>NONE USED) LUN DEC 0 1 ==> TRACKS AVAIL TO COPY SOURCE LWA BSS 1 MICL OCT 0 SET IF "MICMX,L" MVINP BSS 1 BPTR TO SOURCE CHAR (SEE MVB) MX? DEC 0 MXAD1 OCT 140000 XE LIMIT+1 MASK NOEND DEC 0 OPTKN BSS 1 TOKEN FOR FIELD 2 (FROM $SRCH) OUT0 EQU CARD-3 @OUTB DEF OUTBF PAGE# DEC 0 PARMS DEF * :RU PARAMETERS BSS 5 PASS# DEC 1 PBASE DEF *+1 OCT 0 PNLEN OCT 060100 DBL (WITH BIT 6 SET) OCT 0 CKSUM OCT 0 ORIGN OCT 0 MICRO/MDE FLAG (0==>MICRO) BSS 48 CODE BUFFER (FOR S-FM$"T) OCT 0 SCHEK OCT 0 OCT 0 BSS 3 REMAINDER BUFFER (FOR R-FMT) PNLEN EQU PBASE+1 DBL EQU PBASE+2 CKSUM EQU PBASE+3 ORIGN EQU PBASE+4 SCHEK EQU PBASE+54 S-FMT CHECKSUM PCNTR DEC 0 PROGRAM COUNTER PNBUF DEF PBASE+6 PTR TO CODE BUFFER PNCH DEC 4 L.U. # OF PUNCH DEVICE PNCH? DEC 0 PNCTL OCT 1004 PNTR BSS 1 POS? BSS 1 POVFL OCT 0 PCNTR OVERFLOW FLAG PRCTL OCT 206 @PTR BSS 1 RDR OCT 405 ECHOPLEX MODE, INPUT DEVICE REP? OCT 0 S.000 BSS 1 S.001 BSS 1 SAVA BSS 1 TEMPORARY STORAGE SAVB BSS 1 TEMP STORAGE SPCTL OCT 1106 SR.00 BSS 1 SYFLG DEC 0 SYMB TABLE FLAG. 0=NO,1=YES. @SYMB BSS 1 NEXT SYMBOL ENTRY @SYMT BSS 1 SYOVF OCT 0 SYM TAB OVFLOW FLG (IF < 0) @TAG BSS 1 ADDR OF NEXT 'EXTERNAL' FLAG TLINP BSS 1 BPTR TO AFTER LABEL (TLOAD) TMPC1 BSS 1 TMPC2 BSS 2 TMPC3 BSS 1 TMPC4 BSS 1 ASC 1, TOFF DEC 1 TOKEN BSS 4 @TOKN DEF TOKEN @VAL BSS 1 ADDR OF NEXT SYMBOL VALUE XREF? OCT 0 UNS END MICRO $ E 92061-18002 1813 S C0422 RTE MICROASSEMBLER XREF             H0104 ASMB,R,L,C HED RTE MICRO CROSS-REFERENCE GENERATOR NAM MXREF,3 92061-16002 REV.1813 771212 SUP * * * ********************************************************* * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. * * * * * * THIS PROGRAM MAY BE USED WITH ONE COMPUTER SYSTEM AT * * * A TIME AND SHALL NOT OTHERWISE BE RECORDED, * * * TRANSMITTED OR STORED IN A RETRIEVAL SYSTEM. COPYING * * * OR OTHER REPRODUCTION OF THIS PROGRAM EXCEPT FOR * * * ARCHIVAL PURPOSES IS PROHIBITED WITHOUT THE PRIOR * * * WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * ********************************************************* * * HEADR ASC 18,PAGE .... RTE MICRO CROSS-REFERENCE ASC 8,REV.1813 771212 * EXT EXEC,%READ,RMPAR * * ******************** * * INITIALIZATION PHASE * MXREF NOP JSB SYSIO SET UP SUBSYS I/O JSB EJECT PRINT HEADER JSB EXEC SWAP ALL OF MEMORY PARTITION DEF *+3 BECAUSE WE'RE USING IT FOR DEF .22 SYMBOL TABLE DEF .3 JSB OPSYS GET FWA DEC 1 STA SBASE BASE OF SYM TAB (GROWS UP) STA SNEXT JSB OPSYS GET LWM DEC 2 ADA =D-1 BASE OF REF TAB (GROWS DOWN) STA RNEXT CMA,INA SUFFICIENT MEMORY? ADA SNEXT RNEXT-6>SNEXT? ADA =D6 SSA,RSS ISZ SYMOV NO: ANTICIPATE OVERFLOW * * INITIATE I/O ON INPUT DEVICE * LDA INLU DISC INPUT? CPA =D2 JMP IDISC JSB EXEC NO: SET EOT CONDITION DEF *+3 DEF .3 DEF ETCTL LDA MICRO CALLED FROM MICRO? SZA JSB RLOAD YES: SUSPEND TO RELOAD INPUT JMP INIT * IDISC EQU * DISC INPUT LDA MICRO CALLED FROM MICRO? SZA JMP IRWND JSB OPSYS NO: USE LS TRACKS DEC 3 SZA B~ EMPTY TRACKS? JMP INIT LDA =D-20 YES: ABORT JSB PRINT DEF NOLS JMP ABORT IRWND LDA LSTRK REWIND MICRO TRACKS CLB JSB %RDSC * * * INIT EQU * JSB INPUT GET MIC CMD. LIMITED CHECKING LDA MIC1 "MICMX "? LDB CARD JSB CMP DEC 3 SZA,RSS JMP MX YES LDA MIC2 "MICMX,"? JSB CMP DEC 3 SZA,RSS JMP MX YES LDA MIC3 "MICMXE"? WE TAKE XE CLASSES JSB CMP REGARDLESS...BUT WE XREF 1ST DEC 3 RECORD IF NOT MIC COMMAND SZA,RSS JMP READ YES JMP READ2 NO: SCAN FOR SYMBOLS MX ISZ MX? SET MX STATE * * ******************** * * INPUT PHASE * READ JSB INPUT GET A SOURCE RECORD ISZ #REC READ2 LDB @FLD1 EXAMINE FIRST CHARACTER JSB LOADB CPA ASTER COMMENT? JMP READ YES: IGNORE RECORD CPA "$" CONTROL CARD? JMP READ YES: IGNORE RECORD JSB CLASS CLASSIFY OP-FIELD ADA *+2 JMP A,I DEF *+1,I ZERO-ORIGINED TABLE DEF SORT "END" PSEUDO-OP DEF CL1 OF CLASSES DEF CL2 DEF CL3 * CL1 EQU * LABEL ONLY JSB DFINE XFER LABEL SOC JMP NOMEM OUT OF MEMORY JMP READ * CL2 EQU * LABEL & FIXED-FIELD EXPR JSB DFINE XFER LABEL LDB @FLD6 XREF LABEL IN FIELD 6 SOS JSB REFER SOC JMP NOMEM OUT OF MEMORY JMP READ * CL3 EQU * LABEL & VARIABLE-FIELD EXPR JSB DFINE XREF LABEL LDB @FLD3 XREF LABEL BETWEEN FIELDS 3 & 6 SOS JSB REFER SOS JMP READ * * SYMBOL TABLE OVERFLOW. REPORT ERROR, THEN LIST * AS MUCH AS WE'VE GOT * NOMEM EQU * LDA #REC MOVE LINE# INTO ERROR MSG LDB @OV1 JSB DECML DEC 4 LDA =D-45 JSB PRINT DEWF OVMSG LDA =D2 JSB SPACE * * ******************** * * SORT PHASE * * SIMPLE IN-PLACE EXCHANGE SORT. DEFINE CONTINUALLY * DIMINISHING PARTITIONS OF SYMBOL TABLE AND MOVE * "SMALLEST" SYMBOL TO TOP OF PARTITION * SORT EQU * LDB SBASE * SPART EQU * NEXT PARTITION CPB SNEXT JMP LIST DONE STB TOP STB LEAST * SFIND EQU * FIND LEAST IN PARTITION ADB =D6 PTR TO NEXT SYMBOL CPB SNEXT JMP SXCH END OF PARTITION LDA LEAST LEAST<=NEXT SYMBOL? JSB CMP DEC 4 CMA,SSA,INA,SZA STB LEAST NO: NEXT SYMBOL BECOMES LEAST JMP SFIND * SXCH EQU * MOVE LEAST TO TOP IF NECESSARY LDB LEAST CPB TOP JMP SNXT TOP IS LEAST ALREADY LDA B TEMP<==LEAST LDB TEMP JSB MOVE DEC 6 LDA TOP LEAST<==TOP LDB LEAST JSB MOVE DEC 6 LDA TEMP TOP<==TEMP LDB TOP JSB MOVE DEC 6 SNXT EQU * ADB =D6 TOP+6: NEXT PARTITION JMP SPART * * ******************** * * LIST PHASE * LIST EQU * JSB SUMRY LDA =D1 JSB SPACE LDB SBASE * LNXTS EQU * GET NEXT SYMBOL CPB SNEXT JMP LDONE STB SYM CLA,INA SPACE ONE LINE... JSB SPAC? ...IF NOT AT TOP OF FORM LDA SYM MOVE SYMBOL TO OUTPUT LDB OUTBF JSB MOVE DEC 4 LDB SYM GET DEFINITION ADB =D4 LDA B,I SYMBOL DEFINED? SSA JMP LUND NO LDB @XR3 YES: MOVE DEFINITION INTO OUTPUT JSB DECML DEC 4 LDA @XR5 STA @XR LDA =D-14 STA XRLEN JMP LREF LUND LDA @UND UNDEFINED SYMBOL LDB @XR2 JSB MVB DEC 15 LDA @XR6 STA @XR LDA =D-26 STA XRLEN LREF EQU * LIST REFERENCES LDB SYM ANY REFERENCES? ADB =D5 LDA B,I (PTR TO LAST REF IF ANY) SSA,RSS JMP L1ST YES LDA @UNR NO REFERENCES LDB @XR4 JSB MVB DEC 18 LDA XRLEN ADA =D-20 STA XRLEN JMP LLAST L1ST LDA A,I PTR TO FIRST REF STA TOP * LNXTR EQU * LIST NEXT REFERENCE STA REF LDB @XR FULL LINE? CPB @XR7 JSB DUMP YES: WRITE LINE LDA REF GET LINE # INA LDA A,I JSB DECML DEC 4 ADB =D10 NEXT REFERENCE POSTION STB @XR IN OUTPUT LDB XRLEN ADB =D-6 STB XRLEN LDA REF,I PTR TO NEXT REFERENCE CPA TOP JMP *+2 END OF REFERENCES JMP LNXTR * LLAST JSB DUMP WRITE LAST LINE LDB SYM NEXT SYM TAB ENTRY ADB =D6 JMP LNXTS * * ******************** * * END OF CROSS-REFERENCE * LDONE EQU * LDA =D-12 JSB DSPLY DEF ENDMS JMP STOP * ABORT EQU * LDA =D-14 JSB DSPLY DEF ABMSG STOP JSB PEJCT JSB EXEC DEF *+2 DEF .6 HED RTE MICRO CROSS-REFERENCE GENERATOR -- SUBROUTINES * * ******************** * * C L A S S * * ENTRY: * JSB CLASS * * EXIT: * A= CLASSIFICATION * * CLASSIFY OP-MNEMONIC TO DETERMINE WHICH FIELDS TO * CROSS-REFERENCE. * * WE EXAMINE ONLY FIRST 4 CHARACTERS OF OP-FIELD. WE ALSO * ALLOW LABELS WHERE THEY ARE NORMALLY NOT PERMITTED AND TREAT * ILLEGAL OP-MNEMONICS AS CLASS-2. THIS IS TO MAXIMIZE * THE UTILITY OF THE XREF, BEING AS FORGIVING OF SYNTAX * ERRORS AS POSSIBLE. * * CLASSIFICATIONS ARE DEFINED AS FOLLOWS: * 0 -- NO XREF. TERMINATE SOURCE INPUT (END). * 1 -- NO EXPR. XREF LABEL (TYPE-1, ZERO AND ONES * OP-MNEMONICS -- ALSO ALGN). * 2 -- XREF LABEL AND FIXED-FMT EXPR (TYPES-2, -3 AND * -4 OP-MNEMONICS -- ALSO ILLEGAL OP-MNEMONICS). * ] 3 -- XREF LABEL AND VARIABLE-FMT EXPR (ORG, DEF AND EQU). * * ADDITIONAL INTERNAL CLASSIFICATIONS: * 377B -- "RTN" OP-CODE, MX-E ONLY. TREATED AS CLASS-2 * IS SPECIAL FIELD IS "CNDX". OTHERWISE, TREATED * AS CLASS-1. * * CLASSIFICATION TABLE HAS THE FOLLOWING FORMAT: * * 1 * 5 8 7 0 * *********************** * * MNEMONIC (2 WORDS) * END OF TABLE IS DENOTED * * * BY 4 BYTES OF ZEROES * *********************** * * MX CLASS : XE CLASS * * *********************** * CLASS NOP LDA @FLD2 GET OP-CODE FIELD LDB CODE JSB MVB DEC 4 LDA CLTAB INITIALIZE TABLE SEARCH STA CLPTR * CLNXT EQU * LDA CLPTR,I GET TABLE ENTRY ISZ CLPTR LDB CLPTR,I ISZ CLPTR POINTS TO CLASSIFICATION CPB CODE+2 NB: IF B=0, WE ALWAYS SKIP XOR CODE+1 SZA,RSS A=0 OR A=CODE JMP GOTCL FOUND MATCH OR END OF TABLE ISZ CLPTR JMP CLNXT * GOTCL EQU * LDA CLPTR,I GET CLASSIFICATION LDB MX? SZB ALF,ALF GET MX CLASSIFICATION AND =B377 CPA =B377 SPECIAL INTERNAL CLASS? JMP *+2 JMP CLASS,I LDA @FLD3 YES: "RTN" OP-CODE LDB CNDX SPECIAL FIELD IS "CNDX"? JSB CMPB DEC 4 SZA CLA,INA,RSS NO: TREAT AS CLASS-1 LDA =D2 YES: TREAT AS CLASS-2 JMP CLASS,I CLPTR BSS 1 CODE DBL *+1 HOLDS OP-CODE FOR COMPARISON BSS 2 CNDX DBL *+1 ASC 2,CNDX CLTAB DEF *+1 OP-CODE TABLE ASC 2, BYT 1,1 ASC 2,IMM BYT 2,2 ASC 2,JMP BYT 2,2 ASC 2,JSB BYT 2,2 ASC 2,RTN (NOT ON MX) BYT 2,377 ASC 2,EQU BYT 3,3 ASC 2,DEF BYT 3,3 ASC 2,ORG BYT 3,3 ASC 2,DIV BYT 1,1 ASC 2,MPY BYT 1,1 ASk$"C 2,WRTE BYT 1,1 ASC 2,READ BYT 1,1 ASC 2,ENV BYT 1,1 ASC 2,ENVE BYT 1,1 ASC 2,ALGN BYT 1,1 ASC 2,ARS BYT 1,1 ASC 2,CRS BYT 1,1 ASC 2,LGS BYT 1,1 ASC 2,NRM (NOT ON MX) BYT 2,1 ASC 2,LWF BYT 1,1 ASC 2,ASG BYT 1,1 ASC 2,NOP BYT 1,1 ASC 2,ONES BYT 1,1 ASC 2,ZERO $ BYT 1,1 ASC 2,END BYT 0,0 DEC 0,0 ILLEGAL OP-MNEMONIC BYT 2,2 JMP CLASS,I * * ******************** * * C M P * * ENTRY: * LDA * LDB * JSB CMP * DEC <# WORDS> * * EXIT: * A= -1 IF LEFTRIGHT * B= RIGHT PTR (AS ON ENTRY) * * COMPARE TWO WORD ARRAYS. "LEFT" AND "RIGHT" REFER * OPERANDS OF A RELATIONAL EXPR (EG., "LEFT < RIGHT"). * CMP NOP STA CLFT STB CRT LDA CMP,I CMA,INA STA CCNT ISZ CMP * CWORD EQU * COMPARE NEXT WORD LDA CRT,I CMA,INA ADA CLFT,I A>0 IF LEFT>RIGHT SZA JMP CDONE ISZ CLFT ISZ CRT ISZ CCNT JMP CWORD * CDONE EQU * COMPARISON COMPLETE SZA,RSS JMP CMP,I EQUAL SSA CCA,RSS INDICATE LEFTRIGHT JMP CMP,I CCNT BSS 1 CLFT BSS 1 CRT BSS 1 * * ******************** * * C M P B * * ENTRY: * LDA * LDB * JSB CMPB * DEC <# BYTES> * * EXIT: * A=-1 IF LEFTRIGHT * * SIMILAR TO "CMP", BUT FOR CHARACTER STRINGS. * CMPB NOP STA CBLFT STB CBRT LDA CMPB,I CMA,INA STA CBCNT ISZ CMP * CBYTE EQU * COMPARE NEXT BYTE LDB CBLFT JSB LOADB STB CBLFT STA CBCHR SAVE LEFT BYTE LDB CBRT JSB LOADB STB CBRT CMA,INA ADA CBLFT A>0 IF LEFT>RIGHT SZA JMP CBFIN ISZ CBCNT JMP CBYTE * CBFIN EQU * COMPARISON COMPLETE SZA,RSS JMP CMPB,I EQUAL SSA CCA,RSS INDICATE LEFTRIGHT JMP CMPB,I CBCHR BSS 1 LEFT CHARACTER CBCNT BSS 1 CHARACTER COUNTER EwCBLFT BSS 1 BPTR TO LEFT STRING CBRT BSS 1 BPTR TO RIGHT STRING * * ******************** * * D D T * * ENTRY: * JSB DDT * * NOTE: ASMB WITH "Z" OPTION TO ACTIVATE DEBUGGING * CAPABILITY. OTHERWISE ROUTINE ACTS AS NOP. * NOTE, HOWEVER, THAT WE UTILIZE THE SAME AMOUNT * OF ADDRESS SPACE. THIS OBVIATES THE NEED TO * GET A LISTING WHEN RECOMPILING WITH DEBUG OPTION * SINCE CODE OFFSETS WILL BE LEFT UNCHANGED. * DDT NOP DDT0 JMP DDT,I JSB DSPLY WRITE DDT MSG DEF DBMSG DDT1 NOP DEF *+1 JMP DDT,I DBMSG ASC 3,**DDT: IFZ EXT DBUG ORG DDT0 LDA =D-6 DDT MSG LENGTH ORG DDT1 JSB DBUG CALL DDT ORR XIF * * ******************** * * D E C M L * * ENTRY: * LDA * LDB * JSB DECML * DEC <# DIGITS> * * EXIT: * B= BPTR TO MOST-SIGNIFICANT DIGIT PLUS ONE * * CONVERT INTERNAL BINARY VALUE TO ASCII FORM OF * DECIMAL NUMBER. NOTE THAT RESULT MAY HAVE LEADING * ZEROES. * DECML NOP STA DVAL LDA DECML,I CMA,INA STA DCNT ISZ DECML * DNXT EQU * NEXT DIGIT STB DDEST CLB LDA DVAL SHIFT VALUE DIV =D10 STA DVAL ENTIER(VALUE/10) LDA B VALUE MOD 10 ADA "0" CONVERT DIGIT TO ASCII LDB DDEST STORE INTO STRING JSB STORB ADB =D-2 BPTR TO NEXT MOST-SIG DIGIT ISZ DCNT JMP DNXT JMP DECML,I DCNT BSS 1 # DIGITS DDEST BSS 1 BPTR TO NEXT POSITION DVAL BSS 1 VALUE * * ******************** * * D F I N E * * ENTRY: * JSB DFINE * * EXIT: * O= 1 IF SYMBOL TABLE OVERFLOW * * CROSS-REFERENCE SYMBOL IN LABEL FIELD. BUILDS * "DEFINED" SYMBOL ENTRY IN CASE SYMBOL DOES NOT * EXIST. * DFINE NOP LDA #REC STA DEFN LDA @FLD1 LABEL PRESENT? LDB LABL JSB MVLBL  SZA JSB XREF YES: UPDATE REF LIST JMP DFINE,I * * ******************** * * D S P L Y * * ENTRY: * LDA * JSB DSPLY * DEF * * WRITE MESSAGE TO CONSOLE DEVICE. * DSPLY NOP STA DLEN LDA DSPLY,I STA DBUF ISZ DSPLY JSB EXEC DEF *+5 DEF .2 DEF OPCTL DBUF DEF 0 DEF DLEN JMP DSPLY,I DLEN BSS 1 * * ******************** * * D U M P * * ENTRY: * JSB DUMP * * EXIT: * B= NEW @XR * * WRITES LINE OF REFERENCES (OUTBUF) TO LIST DEVICE. * RESETS FIELD INDICATORS FOR NEXT LINE. * DUMP NOP LDA XRLEN WRITE BUFFER JSB PRINT DEF OUTBF+1 LDA =D35 LDB OUTBF BLANK BUFFER JSB PAD LDB =D-10 RESET TO 1ST COLUMN STB XRLEN LDB @XR3 STB @XR JMP DUMP,I * * ******************** * * E J E C T * * ENTRY: * JSB EJECT * * EJECTS PAGE AND WRITES HEADER...ONLY IF WE'RE NOT * ALREADY AT THE TOP OF FORM (AND HEADER WRITTEN). * EJECT NOP LDA #LNS TOP OF FORM ALREADY? CPA LINE3 JMP EJECT,I YES: IGNORE REQUEST JSB PEJCT JSB TITLE WRITE HEADER JMP EJECT,I * * ******************** * * F I N D X * * ENTRY: * LDB * JSB FINDX * * EXIT: * B= BPTR TO EXPR (OR FIELD 6) * * SKIP BLANKS TO FIND FIRST CHARACTER OF EXPRESSION. * WON'T GO BEYOND FIELD 6. * FINDX NOP LDA BLNK JSB SKIP LDA @FLD6 PAST FIELD 6? CMA,INA B>=@FLD6? ADA B SSA,RSS LDB @FLD6 YES: RESET TO FIELD 6 JMP FINDX,I * * ******************** * * G E T L U * * ENTRY: * JSB GETLU * * EXIT: * A= -1 IF DEFAULT * LOW 6 BITS OTHERWISE * * ISOLATE LU FROM :RU PARAMETER, ALSO DETERMINING IF * DEFAULT (0 OR 99) WAS SPECIFIED. * GETLU NOP LDA PARMS,I SZA CPA =D99 CCxA,RSS DEFAULT: SET A=-1 & SKIP AND =B77 ISOLATE LOW 6 BITS JMP GETLU,I * * ******************** * * I N P U T * * ENTRY: * JSB INPUT * * READ SOURCE LINE FROM INPUT DEVICE. * INPUT NOP LDA =D36 LDB CARD JSB PAD LDA KLUGE ***KLUDGE: AVOID BUG IN %RDSC SZA MUST DO OUR OWN LS READS AFTER JMP ?READ REWINDING TRACKS (SEE ?READ) RETRY JSB %READ READ SOURCE FROM DISC OR DEVICE DEF *+5 DEF INCTL DEF CARD+1 DEF .M72 JMP INEOF SZB,RSS BLANK RECORD (EOT)? JMP RETRY YES: IGNORE JMP INPUT,I * INEOF EQU * FAKE "END" LDA =A E STA CARD+5 LDA =AND STA CARD+6 JMP INPUT,I * * * * ? R E A D * * S U P E R K L U D G E !!!!!! * * WE DO OUR OWN READS OF LS TRACKS TO AVOID BUG IN * %RDSC. %RDSC RESETS LS PTR INTERNAL TO SREAD (IE., * %READ) BUT FAILS TO TURN OFF 'FIRST' FLAG. * SUBSEQUENT CALL TO %READ APPEARS TO BE FIRST ACCESS * TO LS TRACKS, SO %READ CALLS %JFIL WHICH RESETS INTERNAL * LS PTR TO THE SYSTEM LS PTR (ON BASE PAGE) -- THUS * UNDOING OUR %RDSC!! * * WHEN THIS IS REPAIRED IN THE RTE LIBRARY, THESE * ROUTINES (?READ, ?NSCT, ?RDSK, ?TKLU, AND %RDSC) SHOULD BE * DISCARDED (AS WELL AS THE 'KLUGE' TEST IN INPUT). ALSO, * %RDSC SHOULD BE DECLARED EXTERNAL. * * WE BRANCH TO ?READ FROM INPUT. THUS, INPUT IS OUR * SUBROUTINE ENTRANCE. HERE, WE GET THE NEXT RECORD * FROM THE SECTOR BUFFER AND TRANSFER IT TO THE CARD * BUFFER. IF WE REACH THE END OF SECTOR, WE GO TO ?NSCT * TO LOCATE THE NEXT ONE. RECORDS ARE VARIABLE-LENGTH * AND PACKED ACROSS SECTOR BOUNDARIES. THE RECORD SIZE * IS CONTAINED IN THE UPPER BYTE OF THE NEXT WORD IN THE * SECTOR BUFFER. IF THIS WORD IS -1, WE HAVE THE END-OF- * FILE. * ?READ LDA CARD STA @TBUF LDB SPTR ADDR OF NEXT WORD IN SECTOR ?RD0 LDA B,I NEXT WORD INB CPB @SEND END O*5F SECTOR? JSB ?NSCT YES CPA =D-1 END OF FILE? JMP INEOF YES: PROCESS EOF IN INPUT ALF,ALF RECORD SIZE (WORDS) CMA STA RCNT -(ACTUAL RECORD SIZE+1) ADA =D37 WCNT<=36? SSA CLA NO: TRUNCATE TRANSFER ADA =D-36 STA WCNT SZA NULL RECORD (EOT)? JMP ?RD1 STB SPTR YES: IGNORE IT JMP ?RD0 ?RD1 LDA B,I XFER WORD TO CARD BUFFER INB CPB @SEND END OF SECTOR? JSB ?NSCT YES STA @TBUF,I ISZ @TBUF ISZ RCNT CANNOT GO TO 0 BEFORE WCNT ISZ WCNT END OF TRANSFER? JMP ?RD1 NO ?RD2 ISZ RCNT END OF RECORD? INB,RSS (NOT IF XREF WAS TRUNCATED) JMP ?RD3 YES: WE'RE DONE CPB @SEND JSB ?NSCT GET NEXT SECTOR JMP ?RD2 ?RD3 STB SPTR PTR TO NEXT RECORD JMP INPUT,I * * * * ? N S C T * * ENTRY: * LDA * JSB ?NSCT * EXIT: * A= LAST WORD IN SECTOR, OR FIRST WORD OF NEXT * TRACK (WHEN LAST WORD WAS TRACK POINTER) * B= POINTER TO NEXT WORD IN SECTOR (FIRST OR * SECOND DEPENDING ON A-REG RESPECTIVELY) * * WE UPDATE THE SECTOR NUMBER AND, IF NEED BE, THE TRACK * AND LU NUMBERS HERE. (?RDSK ACTUALLY DOES THE WORK OF * READING IN THE NEXT SECTOR.) * ?NSCT NOP C LDB SECT# ADB =D2 CPB S/TRK LAST SECTOR? JMP ?NS0 YES STB SECT# STA LWORD SAVE LAST WORD JSB ?RDSK LDA LWORD RETURN LAST WORD JMP ?NSCT,I * ?NS0 JSB ?TKLU UPDATE TRACK & LU NUMBERS CLA RESET SECTOR NUMBER TO ZERO STA SECT# JSB ?RDSK LDA B,I GET FIRST WORD OF TRACK INB POINT TO NEXT WORD JMP ?NSCT,I * * * * % R D S C * * ENTRY: * LDA * CLB * JSB %RDSC * * WHERE LS TRACK ADDR HAS THE LU # IN THE UPPER BYTE * AND THE TRACK # IN THE LOWER BYTE. "CLB" IS FOR * COMPATIBILITY WITH RTE LIBRARY. NB: THIS ROUTINE * BEARS NO RESEMBLANCE TO THE LIBRARY ROUTINE OF THE * SAME NAME. * * SETS UP LOCAL VALUES AND READS FIRST SECTOR. * %RDSC NOP ISZ KLUGE SET FLAG FOR RDCRD JSB ?TKLU SET UP TRACK & LU NUMBERS JSB ?RDSK JMP %RDSC,I * * * * ? R D S K * * ENTRY: * DLUN, TRK#, AND SECT# MUST POINT TO THE DESIRED * LOCATION. * * EXIT: * B= POINTER TO FIRST WORD OF SECTOR. * * READS TWO (RTE) SECTORS FROM DISC (IE., 128 WORDS). * ALSO RESETS SPTR TO FIRST WORD OF SECTOR. * ?RDSK NOP JSB EXEC DEF *+7 DEF ?1 DEF DLUN DEF SBUF DEF W/SCT DEF TRK# DEF SECT# LDB @SBUF STB SPTR JMP ?RDSK,I * * * * ? T K L U * * ENTRY: * LDA * JSB ?TKLU * * WHERE LS TRACK ADDR HAS LU IN UPPER BYTE AND TRACK * NUMBER IN LOWER BYTE. * * WE SET UP TRK# AND DLUN. WE ALSO FETCH CORRESPONDING * S/TRK FROM BASE PAGE. * ?TKLU NOP CLB RRR 8 A=LU BLF,BLF B=TRK # STB TRK# LDB A GET S/TRK FROM B.P. ADB @SECT LDB B,I STB S/TRK IOR =B100 SET BINARY FLAG STA DLUN JMP ?TKLU,I * * * * LOCAL STORAGE FOR KLUDGE ROUTINES * * D O N O T R E F E R E N C E THESE IN OTHER PARTS * OF PROGRAM. THESE SHOULD DISAPPEAR WITH KLUDGE. * ?1 DEC 1 @SECT DEF 1757B-2 2-ORIGINED PTR TO B.P. S/TRK @SBUF DEF SBUF CONSTANT PTR TO SBUF @TBUF BSS 1 MOVING PTR INTO CARD BUFFER DLUN OCT 100 BINARY FLAG SET KLUGE DEC 0 SET IN %RDSC, USED IN RDCRD LWORD BSS 1 LAST WORD IN SECTOR RCNT BSS 1 ACTUAL RECORD SIZE SBUF BSS 128 SECTOR BUFFER @SEND DEF * PTR TO END+1 OF BUFFER SECT# OCT 0 SPTR DEF SBUF MOVING PTR INTO SBUF S/TRK BSS 1 64-WORD SECTORS PER TRACK TRK# BSS 1 WCNT BSS 1 EFFECTIVE RECORD SIZE W/SCT DEC 128 WORDS PER DISC TRACK * * ******************** * * L O A D B * * ENTRY: * LDB * JSB LOADB * * EXIT: * A= CHARACTER * B= BPTR TO NEXT CHARACTER * * LOAD CHARACTER FROM INTO A-REGISTER. * LOADB NOP CLE,ERB LDA B,I SEZ,RSS ALF,ALF AND =B377 ELB INB JMP LOADB,I * * ******************** * * M O V E * * ENTRY: * LDA * LDB * JSB MOVE * DEC <# WORDS> * * EXIT: * B= PTR TO TARGET (AS ON ENTRY) * * MOVE WORDS FROM ONE ARRAY TO ANOTHER. * MOVE NOP STA MINP STB MDEST LDA MOVE,I CMA,INA STA MCNT ISZ MOVE * MWORD EQU * NEXT WORD LDA MINP,I STA MDEST,I ISZ MINP ISZ MDEST ISZ MCNT JMP MWORD JMP MOVE,I MCNT BSS 1 MDEST BSS 1 MINP BSS 1 * * ******************** * * M V B * * ENTRY: * LDA * LDB * JSB MVB * DEC <# BYTES> * * MOVE CHARACTERS FROM ONE STRING TO ANOTHER. * MVB NOP STA MVINP STB MVDST LDA MVB,I CMA,INA STA MVCNT ISZ MVB * MVNXT EQU * LDB MVINP JSB LOADB STB MVINP LDB MVDST JSB STORB STB MVDST ISZ MVCNT JMP MVNXT JMP MVB,I MVCNT BSS 1 MVDST BSS 1 MVINP BSS 1 * * ******************** * * M V L B L * * ENTRY: * LDA * LDB * JSB MVLBL * * EXIT: * A= # CHARACTERS MOVED * MLINP= BPTR TO LAST+1 CHAR * * MOVE A LABEL (IF FOUND) INTO THE "LABL" BUFFER. * ENSURES THAT FIRST CHARACTER IS NOT "%", "*" * OR DIGIT (IE., VALID CONSTANT). THEN MOVES * STRING UNTIL WE FIND A BLANK, "+", OR "-" UP TO * 8 CHARACTERS. NOTE THAT WE ACCEPT LABEL WITH * INITIAL "$" HERE (CONSISTENT WITH WEAK DIAGNOSTIC * PHILOSOPHY). * MVLBL NOP STA MLINP STB MLDST LDA =D4 JSB PAD LDA MLDST GET BPTR TO TARGET RAL STA MLDST LDA =D-8 STA MLCNT LDB MLINP JSB LOADB CPA ASTER STARTS WITH "*" OR "%"? JMP MLFIN YES: NO LABEL CPA "%" JMP MLFIN YES: NO LABEL ADA .M"0" SSA JMP MLNXT NO: POSSIBLY A LABEL ADA =D-10 SSA JMP MLFIN YES: NOT A LABEL * MLNXT EQU * LDB MLINP JSB LOADB CPA PLUS "+", "-" OR BLANK? JMP MLFIN YES: END OF LABEL CPA MINUS JMP MLFIN CPA BLNK JMP MLFIN STB MLINP LDB MLDST JSB STORB STB MLDST ISZ MLCNT JMP MLNXT * MLFIN EQU * LDA MLCNT ADA =D8 # CHARACTERS MOVED JMP MVLBL,I MLCNT BSS 1 MLDST BSS 1 * * ****************************** * * O P S Y S * * ENTRY: * JSB OPSYS * DEC * EXIT: * A= RESULT * * DETERMINES SYSTEM-DEPENDENT FACTORS. ITEM NUMBERS * ARE DEFINED AS FOLLOWS: * 1 -- FWA BEYOND PROGRAM IN PARTITION * 2 -- LWA OF PARTITION * 3 -- LS ADDR * OPSYS NOP LDB OPSYS,I PICK UP ITEM NUMBER ISZ OPSYS ADB *+2 JMP B,I DEF *,I ONE-ORIGINED BRANCH TABLE )M DEF &FWA DEF &LWA DEF &LS * &FWA LDA &ID PTR TO ID SEG ADA =D23 LDA A,I JMP OPSYS,I * &LWA LDA &ID PTR TO ID SEG ADA =D14 PARTITION TYPE (2 OR 3) LDB A,I LDA &BLWA ASSUME TYPE 3 (BKGRND) PARTITION SLB,RSS LDA &FLWA TYPE 2 (FOREGROUND) JMP OPSYS,I * &LS LDA &LSAD CLB LSL 1 SZA ADB =D2 LSR 8 JMP OPSYS,I * &BLWA EQU 1777B BACKGROUND LWA IN BASE-PAGE &FLWA EQU 1751B FOREGROUND LWA IN BASE-PAGE &ID EQU 1717B PTR TO ID SEG IN BASE-PAGE &LSAD EQU 1767B LS ADDR IN BASE-PAGE * * ******************** * * P A D * * ENTRY: * LDA <# WORDS> * LDB * JSB PAD * * PROPAGATE BLANKS INTO THE BUFFER. * PAD NOP CMA,INA STA PCNT LDA BLNK2 * PANXT EQU * STA B,I INB ISZ PCNT JMP PANXT JMP PAD,I PCNT BSS 1 * * ******************** * * P E J C T * * ENTRY: * JSB PEJCT * * EJECT PAGE ON LIST DEVICE. * PEJCT NOP JSB EXEC DEF *+4 DEF .3 DEF SPCTL DEF .M1 PAGE EJECT JMP PEJCT,I * * ******************** * * P R I N T * * ENTRY: * LDA * JSB PRINT * DEF * PRINT NOP STA PLEN ISZ #LNS TOP OF FORM? JMP PR0 JSB EJECT YES: PRINT HEADER ISZ #LNS (CANNOT BE ZERO) PR0 LDA PRINT,I STA PBUF ISZ PRINT JSB EXEC DEF *+5 DEF .2 DEF PRCTL PBUF DEF 0 DEF PLEN JMP PRINT,I PLEN BSS 1 * * ******************** * * R A D D * * ENTRY: * LDB * JSB RADD * * EXIT: * O= 1 IF SYM TAB OVERFLOW * * ALLOCATE AND SET-UP REFERENCE ENTRY. ADD ENTRY * TO REFERENCE LIST. * * REFERENCE ENTRY HAS THE FOLLOWING FORMAT: * * ******************** * * REFERENCE LINK * * ******************** * * REFERENCE LINE # * * ******************** * * REFERENCE LIST IS CIRCULAR WITH HEAD POINTER IN SYMBOL * TABLE. THUS, INSERTIONS ARE EASY AND THE REFERENCE HAS * A FIFO ORDER, OBVIATING A LIST SORT. NOTE THAT THE * LINE # IN WHICH SYMBOL IS DEFINED APPEARS IN SYMBOL * TABLE, NOT REFERENCE LIST (ALTHO ANY DUPLICATE * DEFINITION WILL APPEAR AS REFERENCES TO THE FIRST). * REFERENCE LIST HAS THE FOLLOWING FORM: * * **************** * * SYMBOL TABLE * * * ENTRY * * * ---*-----------------+ * **************** : * : * : * *********** *********** +--> *********** * +--> * ---*--> * ---*-----> * ---*--+ * : * * * * * * : * : *********** *********** *********** : * : FIRST REF LAST REF : * +--------------------------------------------------+ * RADD NOP STB SYM LDA SYMOV REF TAB OVERFLOW? STO SZA JMP RADD,I YES LDB RNEXT "ALLOCATE" REF TAB ENTRY STB REF ADB =D-2 STB RNEXT NEXT AVAIL ENTRY CMB,INB RNEXT-6<=SNEXT? ADB SNEXT ADB =D4 NET: ADD 6 SSB,RSS ISZ SYMOV YES: ANTICIPATE OVERFLOW * LDA SYM,I PTR TO LAST ENTRY LDB REF LINK ENTRY INTO CIRC LIST STB SYM,I LINK NEW ENTRY TO SYM TAB SSA FIRST REF? JMP RA1ST YES LDB A,I PTR TO FIRST ENTRY STB REF,I LINK FIRST TO NEW ENTRY LDB REF STB A,I LINK LAST TO NEW ENTRY JMP *+2 RA1ST STB REF,I FIRST ENTRY PTS TO SELF ISZ REF PUT LINE# INTO NEW ENTRY LDA #REC STA REF,I CLO NO OVERFLOW ISZ #REF JMP RADD,I * * ******************** * * R E F E R $" * * ENTRY: * LDB * JSB REFER * * EXIT: * O= 1 IF SYM TAB OVERFLOW * * CROSS-REFERENCE SYMBOL (IF ANY) ENCOUNTERED IN EXPR. * BUILDS "FWD REFERENCE" ENTRY IN CASE SYMBOL IS NOT * ALREADY DEFINED. * REFER NOP LDA =B100000 SET UP ENTRY STA DEFN JSB FINDX LOCATE EXPR LDA B LABEL PRESENT? LDB LABL JSB MVLBL SZA JSB XREF YES: UPDATE REF LIST JMP REFER,I * * ****************************** * * R L O A D * * ENTRY: * JSB RLOAD * * PROMPTS USER TO RELOAD SOURCE TAPE IN PAPER TAPE * READER AND PAUSES. USED WHEN MICRO COULDN'T GET * TRACKS TO COPY SOURCE FROM DEVICE. * RLOAD NOP LDA =D-32 JSB DSPLY DEF RLMSG JSB EXEC PAUSE DEF *+2 DEF .7 JMP RLOAD,I RLMSG ASC 16, /MXREF: RE-INPUT SOURCE AND *GO * * ******************** * * S A D D * * ENTRY: * JSB SADD * * EXIT: * B= PTR TO SYM TAB ENTRY * O= 1 IF OVERFLOW (IN WHICH CASE B IS INVALID) * * ALLOCATE AND SET-UP SYMBOL TABLE ENTRY. ENTRY * TEMPLATE IS IN "LABL". * V$* SYMBOL TABLE ENTRY HAS THE FOLLOWING FORMAT: * * ********************* * * SYMBOL (4 WORDS) * * * * * ********************* * * DEFINITION LINE # * 100000B IF UNDEFINED * ********************* * * REF LIST HEAD * -1 IF NO REFERENCES * ********************* * * SYMBOL AND REFERENCE ENTRIES ARE ALLOCATED IN A FREE * SPACE. THE TWO TABLES GROW TOGETHER. THE FORM IS: * * *********** * * SYM TAB * <-- SBASE (FWA) * * ENTRY * * *---------* * * * <-- SNEXT * * * * * * <-- RNEXT (NB: PTS LOWER OF TWO WORDS) * * * * *---------* * * REF TAB * * * ENTRY * <-- LWM * *********** * * SEE "RADD" FOR RELATIONSHIP BETWEEN SYMBOL TABLE ENTRY AND * REFERENCE LIST. * SADD NOP LDA SYMOV SYM TAB OVERFLOW? STO SZA JMP SADD,I YES LDB SNEXT "ALLOCATE" SYM TAB ENTRY LDA RNEXT ANTICIPATE OVERFLOW CMA,INA RNEXT-6<=SNEXT? ADA B ADA =D6 SSA,RSS ISZ SYMOV YES: SET OVERFLOW FLAG ADA RNEXT NEXT SYMTAB ENTRY (SNEXT+6) STA SNEXT * LDA LABL SET UP SYMTAB ENTRY JSB MOVE DEC 6 CLO ISZ #SYM JMP SADD,I * * ******************** * * S E R C H * * ENTRY: * JSB SERCH * DEF * * EXIT: * B= -1 IF NOT FOUND * SYM TAB ENTRY ADDR IF FOUND * * SEARCH SYMBOL TABLE FOR LABEL POINTED TO AT P+1 IN * CALLING SEQUENCE. * SERCH NOP LDB SBASE * SRNXT EQU * CPB SNEXT JMP SRNO LDA SERCH,I JSB CMP DEC 4 SZA,RSS JMP SRYES FOUND IT ADB =D6 JMP SRNXT * SRNO CCB NOT FOUND SRYES ISZ SERCH JMP SERCH,I * * ******************** * * S K I P * * ENTRY: * LDA * LDB * JSB SKIP * * EXIT: , * A= LAST CHARACTER * B= BPTR TO LAST CHARACTER * * SKIP CONTIGUOUS SEQUENCE OF SPECIFIED CHARACTER. * SKIP NOP STA SKCHR * SK1 JSB LOADB CPA SKCHR JMP SK1 ADB =D-1 JMP SKIP,I SKCHR BSS 1 * * ******************** * * S P A C ? * S P A C E * * ENTRY: * LDA <# BLANK LINES> * JSB SPACE * * PRINT A BLANK LINE ON LIST DEVICE. * SPAC? NOP LDB #LNS TOP OF FORM? CPB LINE3 JMP SPAC?,I YES: IGNORE REQUEST LDB SPAC? STB SPACE JMP SPACE+1 * SPACE NOP STA SLEN ADA #LNS ENOUGH LINES ON PAGE? SSA,RSS JMP SP1 NO: PAGE EJECT INSTEAD STA #LNS JSB EXEC DEF *+4 DEF .3 DEF SPCTL DEF SLEN JMP SPACE,I * SP1 EQU * JSB EJECT JMP SPACE,I SLEN BSS 1 * * ******************** * * S T O R B * * ENTRY: * LDA * LDB * JSB STORB * * EXIT: * B= BPTR TO NEXT CHARACTER * * STORE CHARACTER IN RIGHT BYTE OF B-REGISTER INTO * CHARACTER STRING. * STORB NOP AND =B377 STA SCHAR CLE,ERB LDA B,I SEZ,RSS ALF,ALF AND =B177400 IOR SCHAR SEZ,RSS ALF,ALF STA B,I ELB INB JMP STORB,I SCHAR BSS 1 * * ********************* * * S U M R Y * * ENTRY: * JSB SUMRY * * PRINT SUMMARY INFORMATION ON LIST DEVICE. * SUMRY NOP LDA #SYM LDB @SM1 JSB DECML DEC 4 LDA #REF LDB @SM2 JSB DECML DEC 4 LDA #REC LDB @SM3 JSB DECML DEC 4 LDA =D-48 JSB PRINT DEF SMMSG JMP SUMRY,I SMMSG ASC 15,SYMBOLS=.... REFERENCES=.... ASC 9, SOURCE LINES=.... @SM1 DBR SMMSG+5 #SYMBOLS IN SUMMARY MSG @SM2 DBL SMMSG+14 #REFERENCES IN SUMMARY MSG @SM3 DBR SMMSG+23 #LINES IN SUMMARY MSG * * 7 ******************** * * S Y S I O * * ENTRY: * JSB SYSIO * * RUN COMMAND FORMAT: * :RU,MXREF,,,, * * EFFECTIVE RUN COMMAND WHEN SCHEDULED FROM MICRO: * :RU,MXREF,40000B+,,,, * * GET :RU PARAMETERS AND INITIALIZE SUBSYSTEM I/O. * 5TH PARAMETER (LSTRK) IS EXAMINED ONLY IF "MICRO" FLAG * IS SET. IN OTHER PARAMETERS, "99" IS TREATED THE SAME * AS NO SPECIFICATION. THIS MAY BE PASSED TO US BY MICRO. * NOTE, HOWEVER, THAT WE CONTINUE TO EXAMINE PARAMETERS * TO THE RIGHT OF "99". DEBUGGING MAY BE ACTIVATED * BY NEGATING 1ST PARAMETER. (NOTE THAT THIS ACTS AS * NOP IF NOT ASMB'D WITH "Z" OPTION.) * SYSIO NOP JSB RMPAR COLLECT :RU PARAMS DEF *+2 DEF PARMS+1 LDA PARMS,I DEBUGGING? CMA,SSA,INA JMP SY1 STA PARMS,I YES JSB DDT SY1 LDA PARMS,I CALLED FROM MICRO? AND =B40000 SZA ISZ MICRO YES XOR PARMS,I ELIMINATE FLAG IF THERE STA PARMS,I LDA MICRO SEE IF SCHEDULED BY MICRO SZA,RSS SKIP IF SO JMP SY1A JUMP IF NOT LDA PARMS+4 GET THE LAST PAGE NUMBER AND STA PAGE# STORE IN MY COUNTER LDA PARMS+2 GET ALF,ALF CONSOLE IN LOW 8 BYTE AND =B377 STRIP OFF LIST LU STA PARMS+4 PUT IN 4TH PARM LDA PARMS+2 GET THE LIST LU AND =B377 STA PARMS+2 * SY1A JSB GETLU GET INPUT LU SSA JMP SY2 DEFAULT STA INLU STA INCTL STORE DISC LU... CPA =D2 JMP SY2 IOR =B400 ...OR SET ECHOPLEX FOR DEV (TTY) STA INCTL IOR =B700 EOT CONTROL STA ETCTL * SY2 ISZ PARMS GET LIST LU JSB GETLU SSA JMP SY3 DEFAULT STA LSTLU IOR =B200 HONESTY & ASCII MODES WITH CRLF STA PRCTL NORMAL PRINT CONTROL ADA =B700 NET: IOR 1100B STA SPCTL SPACE CONTROL * SY3 ISZ PARMS GET LINES PER PAGE LDA PARMS,I SZA CPA =D99 JMP SY4 DEFAULT CMA -((LPP-3)+1): REMAINING LINES+1 STA LINE3 AFTER HEADER * SY4 ISZ PARMS GET CONSOLE LU JSB GETLU SSA JMP SY5 DEFAULT STA OPLU IOR =B200 HONESTY & ASCII MODES WITH CRLF STA OPCTL * SY5 ISZ PARMS GET LSTRK (MICRO TO MXREF) LDA PARMS,I LDB MICRO IGNORE IF NOT FROM MICRO SZB STA LSTRK JMP SYSIO,I * * ******************** * * T I T L E * * ENTRY: * JSB TITLE * * PRINT HEADER, ASSUMING WE'RE AT TOP OF FORM. * TITLE NOP ISZ PAGE# LDA PAGE# PUT PAGE# INTO HEADER LDB @HDF1 JSB DECML DEC 4 JSB EXEC WRITE TITLE... DEF *+5 DEF .2 DEF PRCTL DEF HEADR DEF HLEN JSB EXEC ...FOLLOWED BY 2 BLANK LINES DEF *+4 DEF .3 DEF SPCTL DEF .2 LDA LINE3 RESET LINE COUNTER STA #LNS JMP TITLE,I @HDF1 DBL HEADR+4 PAGE# IN HEADER HLEN DEC 26 PAGE# OCT 0 * * ******************** * * X R E F * * ENTRY: * JSB XREF * * EXIT: * O= 1 IF SYM TAB OVERFLOW * * CROSS-REFERENCE SYMBOL. SYM TAB TEMPLATE MUST BE * SET-UP IN "LABL". IF LABEL DOES NOT EXIST IN SYM * TAB, THEN WE MUST BUILD SYM TAB ENTRY -- IF THIS * IS NOT LABEL DEFINITION, WE MUST ALSO BUILD REF * LIST. IF LABEL DOES EXIST IN SYM TAB, THEN THIS * IS EITHER DEFINITION OF "FORWARD REFERENCE" (IN * WHICH CASE WE SIMPLY UPDATE SYM TAB ENTRY) OR THIS * IS DUPLICATE DEFINITION (IN WHICH CASE WE ADD TO * REF LIST). * XREF NOP JSB SERCH SYMBOL FOUND? DEF LABL+1 SSB,RSS JMP XF3 YES JSB SADD NO: ADD SYMBOL SOC JMP XREF,I OVERFLOW ADB =D4 PTR TO DEFINITION LDA B,I FWD REF? INB (PTR TO REF LINK) SSA JSB RADD YES: ALSO ADD REF TAB ENTRY JMP XREF,I * XF3 EQU * SYM FOUND. B=PTR TO ENTRY ADB =D4 PTR TO DEFINITION LDA B,I FWD SYM TAB ENTRY...? SSA,RSS JMP XF4 NO: ADD REF TAB ENTRY LDA DEFN ...AND DEFINING LABEL? SSA JMP XF4 NO: ADD REF TAB ENTRY STA B,I YES: SIMPLY UPDATE SYM TAB CLO JMP XREF,I * XF4 EQU * ADD REF TAB ENTRY INB PTR TO REF LINK JSB RADD JMP XREF,I HED RTE MICRO CROSS-REFERENCE GENERATOR -- GLOBAL DATA "$" OCT 44 "%" OCT 45 "0" OCT 60 .M"0" OCT -60 .M72 DEC -72 .M1 DEC -1 .2 DEC 2 .3 DEC 3 .6 DEC 6 .7 DEF 7 .22 DEC 22 ASTER OCT 52 BLNK OCT 40 BLNK2 BYT 40,40 MINUS OCT 55 PLUS OCT 53 * * * A EQU 0 A-REGISTER ABMSG ASC 8, /MXREF: ABORTED B EQU 1 B-REGISTER CARD DEF *+1 INPUT BUFFER BSS 36 BYT 40,0 TERMINATED BY BLANK AND "EOL" ENDMS ASC 6, /MXREF: END ETCTL OCT 705 SET EOT STATE, INPUT DEV @FLD1 DBL CARD+1 LABEL FIELD @FLD2 DBR CARD+5 OP-CODE FIELD @FLD3 DBL CARD+8 VARIABLE-FORMAT EXPR FIELD @FLD6 DBR CARD+15 FIXED-FORMAT EXPR FIELD INCTL OCT 405 ECHOPLEX MODE, INPUT DEV INLU OCT 5 DEFAULT INPUT DEV LABL DEF *+1 SYM TAB TEMPLATE BSS 4 LABEL FIELD DEFN BSS 1 DEFINITION LINE NUMBER DEC -1 CONSTANT: NULL REF LIST LEAST BSS 1 PTR TO LEAST IN SYM PARTITION LINE3 DEC -57 -((LPP-3)+1): LINES AFTER HEADER #LNS DEC -1 -(LINES+1) REMAINING ON PAGE LSTLU OCT 6 DEFAULT LIST DEV LSTRK OCT 0 TRACKS PASSED FROM MICRO MIC1 DEF *+1 MIC COMMANDS ASC 3,MICMX MIC2 DEF *+1 ASC 3,MICMX, MIC3 DEF *+1 ASC 3,MICMXE MICRO OCT 0 SET IF CALLED FROM MICRO MLINP BSS 1 BPTR TO CHAR AFTER LABEL (MVLBL) MX? OCT 0 SE$"ET IF "MICMX" NOLS ASC 10,**ERROR 2: NO SOURCE OPCTL OCT 201 HONESTY & ASCII MODES, CONSL DEV OPLU OCT 1 DEFAULT CONSOLE DEV OUTBF DEF *+1 OUTPUT BUFFER ASC 18, ASC 18, @OV1 DBL OVMSG+22 LINE# IN OVMSG OVMSG ASC 16,**ERROR 1: SYMBOL TABLE OVERFLOW ASC 7, IN LINE .... PARMS DEF *+1 :RU PARAMETERS BSS 5 PCNTR DEC 0 MICROPROGRAM ADDR COUNTER PRCTL OCT 206 HONESTY & ASCII MODES, LIST DEV #REC DEC 1 SOURCE CNTR (ASSUME MIC CMD) REF BSS 1 PTR INTO REF LIST #REF DEC 0 SYMBOL REF CNTR, EXCL #SYM RNEXT BSS 1 PTR TO NEXT AVAIL REF ENTRY SBASE BSS 1 PTR TO BASE OF SYM TAB SNEXT BSS 1 PTR TO NEXT AVAIL SYM TAB ENTRY SPCTL OCT 1106 "SPACE" CTL WORD, LIST DEV SYM BSS 1 PTR INTO SYM TAB #SYM DEC 0 SYMBOL (DEFINITION) COUNTER SYMOV OCT 0 SET JUST BEFORE SYM TAB OVERFLOW TEMP DEF *+1 TEMP FOR SWAP IN SORT PHASE BSS 7 TOP BSS 1 PTR TO 1ST SYM OR REF ENTRY @UND DBL *+1 ASC 8,**NOT DEFINED** @UNR DBL *+1 ASC 9,**NOT REFERENCED** @XR DBL OUTBF+10 NEXT LINE# IN REF LINE @XR2 DBL OUTBF+6 "NOT DEFINED" IN REF LINE @XR3 DBR OUTBF+7 DEF LINE# IN REF LINE @XR4 DBL OUTBF+9 "NOT REF'D" IN REF LINE @XR5 DBR OUTBF+10 NORMAL FIRST LINE# IN REF LINE @XR6 DBR OUTBF+16 FIRST LINE# IN "UNDEF'D" REF LINE @XR7 DBR OUTBF+37 BEYOND RIGHT MARGIN OF REF LINE XRLEN BSS 1 LENGTH OF REF LINE UNS END MXREF <$  92061-18003 1813 S C0722 RTE PROM TAPE GENERATOR              H0107 ASMB,R,L,C HED PROM TAPE GENERATOR NAM PTGEN,3 RTE PTGEN 92061-16003 REV.1813 771216 SUP * * * ********************************************************* * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. * * * * * * THIS PROGRAM MAY BE USED WITH ONE COMPUTER SYSTEM AT * * * A TIME AND SHALL NOT OTHERWISE BE RECORDED, * * * TRANSMITTED OR STORED IN A RETRIEVAL SYSTEM. COPYING * * * OR OTHER REPRODUCTION OF THIS PROGRAM EXCEPT FOR * * * ARCHIVAL PURPOSES IS PROHIBITED WITHOUT THE PRIOR * * * WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * ********************************************************* * * HEADR ASC 12,RTE PROM TAPE GENERATOR ASC 8,REV.1813 771216 * EXT %READ,EXEC,RMPAR EXT CREAT,OPEN,PURGE,RWNDF,WRITF,READF,CLOSE * * ******************** * * I N I T I A L I Z A T I O N P H A S E * PTGEN NOP JSB SYSIO GET :RU PARAMETERS JSB TITLE JSB EXEC SWAP ENTIRE PARTITION DEF *+3 DEF .22 DEF .3 JSB OPSYS GET FWA DEC 1 STA FWA JSB OPSYS GET LWM DEC 2 STA LWM * * GET PROM TAPE OPTIONS * OPTS LDA MSG11 WORDS PER PROM? JSB NUM SZA,RSS ZERO SPECIFIED? JMP ST13 YES: DISALLOW STA WPP # 24-BIT MICROWORDS ALS # 16-BIT WORDS CLB,INB ALLOCATE ONE BUFFER JSB ALLOC STA PROM PTR TO BUFFER SZB SUFFICIENT MEMORY? JMP ST12 LDA ERR14 NO: ABORT JSB ERROR JMP ABORT ST13 LDA ERR5 INVALID NUMERIC RESPONSE JSB ERROR JMP OPTS * ST12 LDA MSG12 #BITS PER WORD JSB NUM STA BPW CLB 24 MOD BPW = 0? LDA =D24 DIV BPW B=REMAINDER SOS C BPW=0...? SZB ...OR BPW>24 OR NOT DIVISOR OF i24? JMP *+2 JMP ST10 LDA ERR5 YES JSB ERROR JMP ST12 * ST10 LDA MSG10 FILL CHAR? JSB CHAR SZA NULL...? CPA "H" ...OR HI-LEVEL? JMP ST11 YES: ONE BY DEFAULT CPA "L" LO-LEVEL? JMP ST10A LDA ERR4 NO: MUST BE H OR L JSB ERROR JMP ST10 ST10A CLA FILL WITH ZEROES STA FILL STA FILL+1 * ST11 LDA MSG1 PUNCH TAPE ID? JSB YESNO STA PNID? * LDA MSG2 SPECIFY VENDOR NAME? JSB VDFLT SZA JMP LPOS0 YES: DEFAULTS TAKEN * LDA MSG3 NUMBER OF COMMENT LINES? JSB NUM STA #REM SZA JSB GETRM * LDA MSG4 PUNCH RUBOUTS? JSB YESNO STA RUB? * LDA MSG5 PUNCH CHECKSUM? JSB YESNO STA CKSM? * LDA MSG6 START/END TABLE CHARS? JSB CHAR2 (0 ==> NONE) STA STABL STB ETABL * LDA MSG7 START/END WORD CHARS? JSB CHAR2 (0 ==> NONE) STA SWORD STB EWORD * LDA MSG8 HIGH/LOW CHARS? JSB CHAR2 SZA,RSS NULL? JMP ST9 YES: KEEP DEFAULTS STA HICHR STB LOCHR * ST9 LDA MSG9+1 PROM ADDR FORMAT? JSB PRMPT A=MSG LENGTH DEF MSG9+2 JSB ENTER GET RESPONSE STA PNAD? PNAD?=0 IF NO RESPONSE SZA,RSS JMP LPOS3 DON'T PUNCH ADDR LDA "OCT" "OCTAL" SPECIFIED? LDB INBUF JSB CMPB DEC 5 SZB JMP PNOCT YES: SUBSET MATCHES LDA "DEC" "DECIMAL" SPECIFIED? LDB INBUF JSB CMPB DEC 7 SZB,RSS JMP PNERR NO: SYNTAX ERROR LDA =D10 DECIMAL ADDRESS RADIX JMP *+2 PNOCT LDA =D8 OCTAL ADDRESS RADIX STA PNRAD ADB INBUF BPTR TO NEXT CHARACTER JSB LOADB SEPARATOR=COMMA? CPA COMMA JMP *+2  JMP PNERR NO: SYNTAX ERROR JSB LOADB GET DIGIT ADA =B-60 CONVERT TO BINARY CPA =D1 IS IT A ONE OR TWO? JMP *+2 CPA =D2 JMP *+2 JMP PNERR NO: SYNTAX ERROR STA PNAD? JSB LOADB TERMINATING BLANK? CPA BLNK JMP LPOS4 PNERR LDA ERR4 NO: SYNTAX ERROR JSB ERROR JMP ST9 * * SET UP TRUTH-TABLE OUTPUT FORMAT * LPOS0 LDA PNAD? PUNCHING T-T ADDRESSES? SZA,RSS JMP LPOS3 NO LPOS4 LDA WPP DETERMINE MAGNITUDE OF WPP LPOS1 CLB = LOG(WPP) + 1 DIV PNRAD ISZ #ADR ACCUMULATE MAGNITUDE SZA JMP LPOS1 LDA #ADR SUBTRACT ADDRESS CHARS FROM USABLE LDB PNAD? PART OF LINE... CPB =D1 DISPLAY FIRST & LAST ADDRS? JMP LPOS2 NO: LCNT=72 - #ADR - 2 ALS YES: LCNT=72 - (2 * #ADR + 3) INA FOR SEPARATING DASH LPOS2 ADA =D2 FOR 2 TRAILING BLANKS STA B CMA,INA ADA LCNT STA LCNT ADB LINE ALSO COMPUTE BPTR TO 1ST COL STB LCOL1 LDA LINE SET UP BPTRS TO 1ST/2ND ADDR STRINGS ADA #ADR ADA =D-1 STA LADR1 BPTR TO 1ST ADDR ADA #ADR COMPUTE BPTR TO 2ND ADDR INA (NB: NOT USED IF DISPLAYING STA LADR2 ONLY ONE ADDRESS) * LPOS3 LDB SWORD COMPUTE PROM WORD STRING SIZE SZB =BWP + 1 + (IF SWORD THEN 2) LDB =D2 ADB BPW INB LDA LCNT LCNT=72 - (PROM ADDR SIZE ABOVE) STB LCNT (TEMPORARY) CLB COMPUTE # PROM WORDS PER LINE DIV LCNT =ENTIER(LINE SIZE / PROM WORD SIZE) CMA,INA LDB =D8 NO MORE THAN 8...FOR THE ADB A HP PROM WRITER KLUDGE SSB A-REG > 8? LDA =D-8 YES: REVERT TO 8 STA LCNT * * OPEN OBJECT CODE DISC FILE OR BUILD TEMPORARY FILE. * IF THE LATTER, COPY OBJECT CODE FROM INPUT DoJEVICE * TO DISC FILE AND SWITCH OBJECT INPUT TO NEW FILE. * IF A FILE ERROR OCCURS DURING TRANSFER, WE IGNORE * TEMPORARY FILE AND USE ORIGINAL OBJECT CODE INPUT * DEVICE THROUGHOUT. * LDA OBJLU OBJ CODE ON DISC? CPA =D2 JMP *+2 YES JMP TDISC JSB FOPEN OPEN DISC FILE SZA JMP PHAS2 LDA ERR3 NO OBJ CODE JSB ERROR JMP ABORT TDISC JSB TBILD BUILD TEMPORARY STA TEMP? SZA,RSS COPY TO TEMP FILE? JMP PHAS2 NO COPY JSB INPUT YES: GET OBJ RECORD SZA,RSS END RECORD? ISZ CPEND YES: SET FLAG LDA CODE+1 GET RECORD LENGTH ALF,ALF STA CPLEN JSB WRITF COPY OBJ RECORD TO FILE DEF *+5 DEF DCB DEF FMGR DEF CODE+1 DEF CPLEN SSA FILE I/O ERROR? JMP CPERR YES LDA CPEND LAST RECORD? SZA,RSS JMP COPY NO LDA =D2 YES: REDIRECT OBJ INPUT TO DISC STA OBJLU LDA OSTAT+1 RESET DEVICE STATE IN CASE WE STA OSTAT SHARED PROM INPUT DEVICE JSB REWND JMP PHAS2 CPERR LDA ERR15 FILE I/O ERROR JSB FMERR JSB TPURG PURGE FILE * * ******************** * * P U N C H P H A S E * PHAS2 LDA MSGP GET PUNCH RANGE CLB DISALLOW "COMMENTS" OPTION JSB RNGE JMP PHAS3 NULL INPUT: END PUNCH PHASE STA NUADR SAVE REQUEST ADDR... STA XADDR STB XBIT ...AND LEFT BIT# SSA,RSS "ALL" SPECIFIED? JMP PH2.3 NO JSB RESET YES: REWIND OBJ & CLEAR PROM PH2.1 JSB INPUT GET NEXT RECORD SZA,RSS END RECORD? JMP PHAS2 YES: RANGE IS COMPLETE LDA ORIGN NORMALIZE ADDR (PROM BASE ADDR) CLB =ADDR - (ADDR MOD WPP) DIV WPP CMB,INB ADB ORIGN STB NUADR "REQUESTED ADDR" PH2.3 LDA XBIT "ALL BITS" SPECIFIED? SS8A LDA =D23 YES: START WITH MSB STA BIT# * PH2.4 JSB FILLP FILL PROM BUFFER SZA,RSS RANGE FOUND? JMP PH2ER NO PH2.5 JSB PNTT PUNCH PROM TAPE LDA XBIT PUNCH ALL BITS? SSA,RSS JMP PHAS2 NO: RANGE IS COMPLETE LDA BPW YES: COMPUTE NEXT BIT# CMA,INA =BIT# - BPW ADA BIT# STA BIT# SSA,RSS LAST FIELD? JMP PH2.5 NO: USE SAME PROM BUFFER LDA XADDR PUNCH ALL OBJ CODE? SSA,RSS JMP PHAS2 NO: RANGE IS COMPLETE LDA OADDR YES: NEXT PROM IN OBJ RECORD? STA NUADR CPA OLAST JMP PH2.1 NO: GET NEXT OBJ RECORD JMP PH2.3 YES: USE CURRENT RECORD * PH2ER LDA ERR12 RANGE NOT FOUND JSB ERROR JMP PHAS2 * * ******************** * * V E R I F Y P H A S E * PHAS3 CCA CLEAR "FORCED RELOAD" STATE? LDB PSTAT,I CPB =D-2 STA PSTAT,I YES LDA MSGV GET VERIFY RANGE CLB,INB ALLOW "COMMENTS" OPTION JSB RNGE JMP FINI NULL INPUT: TERMINATE STA NUADR SAVE REQUESTED ADDR... STA XADDR STB XBIT ...AND LEFT BIT# SOC C "COMMENTS" PRESENT? CLB,INB,RSS YES: SET VERIFY FLAG & SKIP CLB NO: RESET FLAG STB VRCOM SSA,RSS "ALL" SPECIFIED JMP PH3.3 NO JSB RESET YES: REWIND OBJ & CLEAR PROM PH3.1 JSB INPUT GET NEXT OBJ RECORD SZA,RSS END RECORD? JMP PHAS3 YES: RANGE IS COMPLETE LDA ORIGN NORMALIZE ADDR (PROM BASE ADDR) CLB =ADDR - (ADDR MOD WPP) DIV WPP CMB,INB ADB ORIGN STB NUADR "REQUESTED ADDR" PH3.3 LDA XBIT "ALL BITS" SPECIFIED? SSA LDA =D23 YES: START WITH MSB STA BIT# * PH3.4 JSB FILLP FILL PROM BUFFER SZA,RSS RANGE FOUND? JMP PH3ER NO PH3.5 JSB VRTT VERIFY PROM TAPE  SZA,RSS VERIFY ERRORS? JSB PNTT YES: REPUNCH PROM TAPE LDA XBIT VERIFY ALL BITS? SSA,RSS JMP PHAS3 NO: RANGE IS COMPLETE LDA =D-2 SET "FORCED RELOAD" STATE STA PSTAT,I LDA BPW COMPUTE NEXT LEFT BIT# CMA,INA =BIT# - BPW ADA BIT# STA BIT# SSA,RSS LAST FIELD? JMP PH3.5 NO: USE CURRENT PROM BUFFER LDA XADDR VERIFY ALL OBJ CODE? SSA,RSS JMP PHAS3 NO: RANGE IS COMPLETE LDA OADDR NEXT PROM IN OBJ RECORD? STA NUADR CPA OLAST JMP PH3.1 NO: GET NEXT OBJ RECORD JMP PH3.3 YES: START WITH CURRENT OBJ RECORD * PH3ER LDA ERR12 RANGE NOT FOUND JSB ERROR JMP PHAS3 * * ********************* * * T E R M I N A T I O N * FINI LDA =D6 PRINT END MESSAGE JSB LIST DEF ENMSG STOP LDA OBJLU OBJECT CODE FILE OPEN? CPA =D2 JMP *+2 JMP STOP2 LDA TEMP? YES: TEMPORARY? SZA,RSS JMP STOP1 JSB TPURG YES: PURGE IT JMP STOP2 STOP1 JSB CLOSE NO: JUST CLOSE IT DEF *+3 DEF DCB DEF FMGR STOP2 JSB EXEC TERMINATE DEF *+2 DEF .6 * ABORT LDA =D8 PRINT ABORT MESSAGE JSB LIST DEF ABMSG JMP STOP HED PROM TAPE GENERATOR -- SUBROUTINES * * ******************** * * A L L ? * * ENTRY: * LDB * JSB ALL? * * EXIT: * A= 0 IF NO CHARACTERS MATCH * BPTR TO FOLLOWING CHARACTER IF PARTIAL MATCH * * MATCHES ANY SUBSTRING OF "ALL", RECOGNIZED WHEN * SPECIFYING RANGES IN PUNCH AND VERIFY PHASES. * ALL? NOP STB A?PTR LDA "ALL" JSB CMPB DEC 3 SZB SOME CHARS MATCH? ADB A?PTR YES: RETURN BPTR TO NEXT CHAR JMP ALL?,I A?PTR BSS 1 BPTR TO STRING "ALL" DBL *+1 ASC 2,ALL * * **********%********** * * A L L O C * * ENTRY: * LDA <#WORDS PER BUFFER> * LDB <#BUFFERS> * JSB ALLOC * * EXIT: * A= PTR TO FIRST BUFFER * B= #BUFFERS ALLOCATED * * DYNAMICALLY ALLOCATES SPACE IN THE AREA BETWEEN FWA AND * LWM ABOVE THE PROGRAM. NOTE THAT WE DON'T ALLOW FWA TO * BECOME LWM+1, ALTHO THIS WOULD NOT CONSTITUTE MEMORY * OVERFLOW. THIS IS TO PREVENT FWA<0 IN THE CASE OF LWM * EQUALS 77777B. * ALLOC NOP STA BSIZE STB BREQ CMB,INB B=LOOP COUNTER LDA FWA PTR TO FIRST BUFFER STA BBASE * ALLC1 ADA BSIZE SUFFICIENT MEMORY? CMA,INA FWA + BUFFER SIZE <= LWM? ADA LWM SSA JMP ALLC2 NO: OUT OF MEMORY LDA FWA ADVANCE FWA ADA BSIZE STA FWA INB,SZB JMP ALLC1 * ALLC2 LDA BBASE RETURN PARAMETERS ADB BREQ BREQ - COUNTER = #ALLOCATED JMP ALLOC,I BBASE BSS 1 INITIAL FWA & BASE OF ALLOCATED SPACE BREQ BSS 1 #REQUESTED BUFFERS BSIZE BSS 1 #WORDS PER BUFFER * * ******************** * * A L T E R * * ENTRY: * JSB ALTER * * THIS IS THE "REPLACE COMMENT" SEQUENCE PERMITTED IN * THE PUNCH AND VERIFY PHASES. HERE WE SIMPLY PROMPT * FOR INPUT AND REPLACE SELECTED COMMENT BUFFERS. * PUNCHING OF THE COMMENTS IS DONE ELSEWHERE. * ALTER NOP JSB TAPID DBR MSGR+18 LDA MSGR REPLACE COMMENTS? JSB YESNO SZA,RSS JMP ALTER,I NO LDA #REM YES: SET UP TO CYCLE THRU COMMENTS CMA,INA STA ALCNT LDA REM PTR TO 1ST COMMENT BUFFER STA ALPTR CLA,INA COMMENT LINE# STA ALINE * ALOOP LDA ALINE DISPLAY COMMENT LINE# LDB ALLN# JSB DECML DEC 2 LDA =D-16 JSB LIST DEF ALLN LDA ALPTR DISPLAY CURRENT COMMENT INA PTR TO COMMENT ITSELF STA AL.1 0.**0 STA AL.2 LDA ALPTR,I GET COMMENT LENGTH CMA,INA JSB LIST AL.1 DEF 0 JSB ENTER GET NEW COMMENT SZA,RSS NULL RESPONSE? JMP ALNXT YES: LEAVE COMMENT AS IS STB ALPTR,I STORE LINE LENGTH LDA B COMPUTE MOVE LENGTH (IN WORDS) INA =(LENGTH + 1) / 2 ARS LDB INBUF COMPUTE WORD PTR TO INPUT CLE,ERB JSB MOVE STORE NEW COMMENT AL.2 DEF 0 ALNXT LDA ALPTR FIND NEXT COMMENT BUFFER ADA =D37 STA ALPTR ISZ ALINE ISZ ALCNT ALL COMMENTS PROCESSED? JMP ALOOP NO: DO THE NEXT ONE JMP ALTER,I MSGR DEF *+1 DEC -37 MSG LENGTH ASC 19,REPLACE COMMENTS FOR TAPE 00000,00? __ ALCNT BSS 1 ALPTR BSS 1 PTR TO NEXT COMMENT BUFFER ALINE BSS 1 CURRENT COMMENT LINE# ALLN ASC 8,COMMENT LINE 00: ALLN# DBL ALLN+7 * * ******************** * * A S C I I * * ENTRY: * LDA * LDB * JSB ASCII * DEF * DEF * * CONVERTS BIT PATTERN TO HICHR AND LOCHR. * ASCII NOP STA INSTR+1 LDA ASCII,I LDA A,I STA ADEST ISZ ASCII LDA ASCII,I LDA A,I CMA,INA STA ACNT ISZ ASCII LDA INSTR+1 RESET A-REGISTER * ANXT EQU * STB INSTR STA INSTR+1 ERA GET LSB LDA HICHR LOAD APPROPRIATE CHAR SEZ,RSS LDA LOCHR LDB ADEST STORE INTO STRING JSB STORB ADB =D-2 BPTR TO CHAR TO LEFT STB ADEST LDB INSTR ROTATE BITS LDA INSTR+1 LSR 1 ISZ ACNT JMP ANXT JMP ASCII,I INSTR BSS 2 24-BIT MICROWORD ADEST BSS 1 ACNT BSS 1 #BITS * * ********************* * * C H A R * * ENTRY: * LDA * JSB CHAR * * EXIT: * A= 0 IF NULL INPUT * FIRST C)>HARACTER IF NOT NULL INPUT * * PROMPTS WITH MESSAGE AND RETURNS ONE CHARACTER FROM INPUT. * CHAR NOP STA C1MSG ISZ C1MSG LDA A,I MSG LENGTH STA C1LEN C1TRY JSB PRMPT PROMPT FOR INPUT C1MSG DEF 0 JSB ENTER READ A LINE SZA,RSS NULL INPUT? JMP CHAR,I YES: RETURN A=0 CLB LDA INBUF+1 NO: ISOLATE FIRST CHARACTER RRR 8 CPB =B20000 JMP CHAR,I LDA ERR4 JSB ERROR LDA C1LEN JMP C1TRY C1LEN BSS 1 * * ******************** * * C H A R 2 * * ENTRY: * LDA * JSB CHAR2 * * EXIT: * A= 0 IF NULL INPUT * FIRST CHARACTER IF NOT NULL INPUT * B= 0 IF NULL INPUT * SECOND CHARACTER OTHERWISE * * PROMPTS FOR INPUT AND EXPECTS TWO CHARACTERS SEPARATED * BY COMMA. * CHAR2 NOP STA C2MSG ISZ C2MSG LDA A,I MSG LENGTH STA C2LEN C2TRY JSB PRMPT REPROMPT FOR INPUT C2MSG DEF 0 JSB ENTER READ A LINE CLB SZA,RSS NULL INPUT? JMP CHAR2,I YES: RETURN A=B=0 LDA INBUF+1 ISOLATE 1ST CHAR & COMMA RRR 8 CPB =B26000 COMMA? JMP *+2 JMP C2ERR NO STA C2CHR CLB LDA INBUF+2 ISOLATE 2ND CHAR LSL 8 CPA =B20000 CPB BLNK ENSURE IT'S NOT BLANK JMP C2ERR LDA C2CHR JMP CHAR2,I C2ERR LDA ERR4 SYNTAX ERROR JSB ERROR LDA C2LEN JMP C2TRY REPROMPT FOR INPUT C2LEN BSS 1 PROMPT MESSAGE LENGTH C2CHR BSS 1 * * ******************** * * C H E C K * * ENTRY: * JSB CHECK * * EXIT: * A=-1 IF END-RECORD IS OKAY * 0 IF ERROR IN OBJ RECORD * 1 IF DBL-RECORD IS OKAY * * PERFORMS VARIOUS AND SUNDRY CHECKS ON RECENTLY INPUT * OBJ RECORD, INCLUDING CHECKSUM. ALSO ENSURES THAT * RECORD WAS PUNCHED BY MICRO-ASSEMBLER, NOT THE MICRO- * DEBUG/ED?ITOR. * CHECK NOP LDA RECLN ISOLATE CHECKSUM LENGTH ALF,ALF =RECORD LENGTH - 3 ADA =D-3 CMA,INA STA CKCNT SSA,RSS RECLEN<0?... JMP CKERR YES: BAD RECORD ADA =D60 ...OR RECLEN>60? SSA JMP CKERR YES: BAD RECORD LDA CODE GET PTR TO 2ND WORD INCLUDED IN ADA =D3 CHECKSUM (ORIGIN) LDB IDENT INITIAL CHECKSUM SUBTOTAL CK1 ADB A,I COMPUTE CHECKSUM INA ISZ CKCNT JMP CK1 CPB CKSUM CHECKSUM ERROR? JMP *+2 JMP CKERR YES LDA IDENT END RECORD? CPA =B120000 JMP CKEND YES LDB MFLAG CPA =B060100 DBL RECORD?... SZB ...PUNCHED BY MICRO? JMP CKERR NO CLA,INA,RSS YES: RETURN A=1 & SKIP CKEND CCA RETURN A=-1 FOR END-RECORD JMP CHECK,I CKERR CLA RETURN A=0 FOR ERROR JMP CHECK,I CKCNT BSS 1 * * ******************** * * C L E A R * * ENTRY: * LDA <# WORDS> * JSB CLEAR * DEF * * PROPAGATES BLANKS THROUGHOUT BUFFER. * CLEAR NOP CMA,INA STA CLCNT LDB CLEAR,I BUFFER ADDR ISZ CLEAR LDA BLNK2 CLNXT EQU * STA B,I INB ISZ CLCNT JMP CLNXT JMP CLEAR,I CLCNT BSS 1 * * ******************** * * C M P B * * ENTRY: * LDA * LDB * JSB CMPB * DEC <# BYTES> * * EXIT: * A<0: LEFT0: LEFT>RIGHT * B= NUMBER OF EQUAL CHARACTERS * * COMPARES TWO STRINGS. "LEFT" & "RIGHT" REFER TO POSITION * OF STRING OPERANDS (POINTERS) WITH RESPECT TO RELATIONAL * OPERATOR (EG., LEFT > RIGHT). * CMPB NOP STA CBLFT SAVE PTRS STB CBRT LDA CMPB,I GET LENGTH CMA,INA STA CBCNT SZA,RSS ZERO LENGTH? JMP CMPB2 YESuO: ALWAYS RETURN "EQUAL" * CMPB1 EQU * COMPARE NEXT BYTE LDB CBLFT GET "LEFT" BYTE JSB LOADB STB CBLFT STA CBCHR SAVE IT LDB CBRT GET "RIGHT" BYTE JSB LOADB STB CBRT CMA,INA ADA CBCHR A>0 IF LEFT>RIGHT SZA EQUAL? JMP CMPB2 NO: COMPARISON COMPLETE ISZ CBCNT JMP CMPB1 * CMPB2 EQU * COMPARISON COMPLETE: A=SENSE LDB CMPB,I GET ORIGINAL LENGTH ADB CBCNT B=# EQUAL CHARACTERS ISZ CMPB JMP CMPB,I CBCHR BSS 1 CBCNT BSS 1 CBLFT BSS 1 CBRT BSS 1 * * ******************** * * C N V A D * * ENTRY: * LDA * LDB * JSB CNVAD * * EXIT: * A= LEFT DIGIT * B= BPTR TO LEFT-1 DIGIT * THAT IS, THE SAME AS FOR THE OCTAL AND DECML * SUBROUTINES. * * CONVERTS PROM ADDRESS (A-REGISTER) TO OCTAL OR DECIMAL * ACCORDING TO PUNCH OPTION SELECTED. * CNVAD NOP STA CNADR SAVE PROM ADDR LDA #ADR "CONFIGURE" CONVERSION JSB'S STA CNV.1 STA CNV.2 LDA PNRAD SET E TO INDICATE RADIX ERA,ERA 0==>OCTAL(10B), 1==>DECIMAL(12B) LDA CNADR RESTORE A-REG SEZ OCTAL CONVERSION? JMP CNV2 JSB OCTAL YES CNV.1 DEC 0 # DIGITS IN ADDR JMP CNVAD,I CNV2 JSB DECML NO: DECIMAL CONVERSION CNV.2 DEC 0 # DIGITS IN ADDR JMP CNVAD,I CNADR BSS 1 PROM ADDRESS * * ******************** * * C N V R T * * ENTRY: * LDA * LDB * JSB CNVRT * * EXIT: * A= VALUE (IF O-REG=0) * B= BPTR TO RIGHT+1 DIGIT (IF O-REG=0) * O= 1 IF OVERFLOW OR MISSING NUMBER * * CONVERTS ASCII STRING TO BINARY. NOTE THAT OCTAL VALUE * CANNOT HAVE SIGN BIT SET (EG., 177777B). * CNVRT NOP STA CNRAD CCA STA CNVAL VALUE<0 ==> MISSING NUMBER CLO _e CNNXT EQU * NEXT DIGIT JSB LOADB ADA .M"0" "0"<=CHAR? STA CNDIG (DIGIT=CHAR-"0") CMA,SSA,RSS (A=-DIGIT-1) JMP CNEND NO: END OF NUMBER ADA CNRAD DIGIT<=RADIX-1? SSA JMP CNEND NO: END OF NUMBER STB CNPTR BPTR TO NEXT CHAR LDA CNVAL ACCUMULATE VALUE SSA FIRST DIGIT? CLA YES: RESET ACCUMULATOR MPY CNRAD SHIFT ACCUMULATOR ADA CNDIG SZB,RSS OVERFLOW? SOC JMP CNOVF YES STA CNVAL LDB CNPTR BPTR TO NEXT CHAR JMP CNNXT * CNEND LDA CNVAL LDB CNPTR BPTR TO RIGHT+1 DIGIT SSA VALUE<0? CNOVF STO YES: MISSING NUMBER JMP CNVRT,I CNDIG BSS 1 CNPTR BSS 1 CNRAD BSS 1 CNVAL BSS 1 * * ******************** * * C O N ? * * ENTRY: * LDB * JSB CON? * * * * EXIT: * A= VALUE (IF "CONSTANT" RETURN) * B= BPTR TO RIGHT+1 DIGIT (IF "CONSTANT" RETURN) * BPTR TO LEFT DIGIT (IF "NONCONSTANT" RETURN) * * CONVERTS NUMBERS OF THE FOLLOWING FORM: * [+/-] NUMBER [B] * CON? NOP STB CPTR CCA ASSUME POSITIVE STA CPOS? JSB LOADB GET FIRST "DIGIT" CPA MINUS MINUS SIGN? ISZ CPOS? YES: RESET FLAG & SKIP CPA PLUS PLUS SIGN? JMP *+2 YES: SKIP SIGN ADB =D-1 BACK-UP OVER CHAR JSB OCT? TRAILING "B"? JMP CDEC NO: CONVERT DECIMAL NUMBER LDA =D8 YES: CONVERT OCTAL NUMBER JSB CNVRT INB SKIP "B" JMP CNXT * CDEC LDA =D10 CONVERT DECIMAL NUMBER JSB CNVRT CNXT SOC C OVERFLOW OR ILLEGAL DIGIT? JMP CERR YES: NOT A CONSTANT STB CPTR SAVE BPTR TO RIGHT+1 DIGIT LDB CPOS? NEGATE VALUE? SZB,RSS CMA,INA YES ISZ CON? TAKE "CONSTANT" EXIT CERR LDB CPTR RESTORE BPTR JMP CON?,I CPOS? BSS 1 CPTR BSS 1 * * ******************** * * D D T * * ENTRY: * JSB DDT * * ACTIVE ONLY WHEN DEBUGGING (ASMB'D WITH "Z" OPTION). * ACTS AS A NOP OTHERWISE. WE ENTER DDT WHEN THE FIRST * :RU PARAMETER IS NEGATIVE. NOTE THAT WE USE THE SAME * THE SAME AMOUNT OF CODE SPACE REGARDLESS OF THE "Z" * OPTION. THUS, WE DO NOT NEED TO GET A LISTING WHEN * RECOMPILING TO ACTIVATE DEBUGGING SINCE THE CODE * OFFSETS ARE NOT CHANGED. * DDT NOP DDT0 JMP DDT,I JSB LIST WRITE DDT MSG DEF DBMSG DDT1 NOP CALL DDT DEF *+1 JMP DDT,I DBMSG ASC 3,**DDT: IFZ EXT DBUG ORG DDT0 LDA =D-6 DDT MSG LENGTH ORG DDT1 JSB DBUG CALL DDT ORR XIF * * ******************** * * D E C M L * * ENTRY: * LDA * LDB * JSB DECML * DEC <# BYTES> * * EXIT: * A= LEFT DIGIT * B= BPTR TO LEFT-1 DIGIT * * CONVERTS VALUE TO ASCII STRING. MAY PRODUCE LEADING * ZEROES. * DECML NOP STA DVAL LDA DECML,I # CHARACTERS DESIRED CMA,INA STA DCNT ISZ DECML * DEC0 EQU * CONVERT NEXT DIGIT STB DDEST CLB LDA DVAL DIV =D10 STA DVAL ENTIER(VALUE/10) LDA B VALUE MOD 10 ADA "0" CONVERT TO ASCII LDB DDEST JSB STORB ADB =D-2 BPTR TO DIGIT TO LEFT ISZ DCNT JMP DEC0 JMP DECML,I DCNT BSS 1 DDEST BSS 1 DVAL BSS 1 * * ******************** * * D E V N O * * ENTRY: * LDA * JSB DEVNO * * EXIT: * A= SELECT CODE (I/O CHANNEL) NUMBER * * DETERMINES SELECT CODE CORRESPONDING TO * SPECIFIED LU NUMBER. * DEVNO NOP STA DEVLU JSB EXEC STATUS REQUEST DEF *+5 DEF .1*($3 DEF DEVLU DEF DEVST DEF DEVSC LDA DEVSC EQT-4 ENTRY AND =B77 ISOLATE SELECT CODE JMP DEVNO,I DEVLU BSS 1 DEVSC BSS 1 DEVST BSS 1 * * ******************** * * E N T E R * * ENTRY: * JSB ENTER * * EXIT: * A= 0 IF 1ST CHAR IS BLANK ("NULL" INPUT) * B= #CHARACTERS INPUT * INBUF= INPUT RECORD V** * READS (ASCII) INPUT FROM USER INPUT DEVICE. * ECHOES INPUT TO LIST DEVICE IF NECESSARY. * ENTER NOP LDA =D36 CLEAR INPUT BUFFER JSB CLEAR DEF INBUF+1 EN0 JSB %READ (WE ACCEPT INPUT FROM LS TRACKS) DEF *+5 DEF INCTL DEF INBUF+1 DEF .M72 JMP ENEOF END-OF-FILE SZB,RSS END-OF-TAPE? JMP EN0 YES: REREAD JMP ENLST ENEOF LDA ERR13 I/O ERROR JSB ERROR JMP ABORT * ENLST STB ENLOG SAVE XMISSION LOG LDA ECHO ECHO TO LIST DEVICE? SZA,RSS JMP ENNUL LDA B YES CMA,INA -XMISSION LOG JSB LIST DEF INBUF+1 ENNUL LDA INBUF+1 BLANK IN COL #1? AND =B177400 XOR =B20000 YES ==> SET A=0 ("NULL" INPUT) LDB ENLOG JMP ENTER,I ENLOG BSS 1 * * ******************** * * E O T * * ENTRY: * LDA * JSB EOT * * SETS END-OF-TAPE STATE ON SPECIFIED LU. * EOT NOP IOR =B700 STA ETCTL JSB EXEC DEF *+3 DEF .3 DEF ETCTL JMP EOT,I ETCTL BSS 1 * * ******************** * * E R R O R * * ENTRY: * LDA * JSB ERROR * * WRITES ERROR MESSAGE ON LIST DEVICE. NOTE THAT MESSAGE * ITSELF (EXCL "**ERROR..." PREPENDAGE) MUST NOT EXCEED 58 * CHARACTERS TO KEEP COMPLETE ERROR MESSAGE UNDER 73 BYTES. * * ERROR TABLE ENTRY HAS THE FOLLOWING FORM: * DEF *+1 * BYT , * ASC <#WORDS>, * ERROR NOP STA EPTR SAVE MSG PTR LDA A,I GET MSG DESCRIPTOR ALF,ALF ISOLATE ERROR CODE AND =B377 LDB ENUM INCL CODE IN ERROR LINE JSB DECML DEC 2 LDA EPTR,I GET MSG LENGTH AND =B377 LDB EPTR MOVE MSG INTO ERROR LINE INB JSB MOVE DEF EMSG+7 LDA EPTR,I COMPUTE TOTAL LENGTH AND =B37 7 =MSG LENGTH + 7 ADA =D7 JSB LIST WRITE MESSAGE DEF EMSG JMP ERROR,I EMSG ASC 7, **ERROR 00: BSS 29 ENUM DBL EMSG+5 ERROR CODE IN MSG EPTR BSS 1 ERR1 DEF *+1 BYT 1,25 ASC 21,INVALID FILE SPECIFICATION OR EXTRA INPUT ERR2 DEF *+1 BYT 2,12 ASC 10,INVALID VENDOR NAME ERR3 DEF *+1 BYT 3,7 ASC 7,NO OBJECT CODE ERR4 DEF *+1 BYT 4,20 ASC 16,INVALID RESPONSE OR EXTRA INPUT ERR5 DEF *+1 BYT 5,17 ASC 15,INVALID NUMBER OR EXTRA INPUT ERR6 DEF *+1 BYT 6,17 ASC 15,I/O ERROR READING OBJECT CODE ERR7 DEF *+1 BYT 7,16 ASC 14,CANNOT CREATE TEMPORARY FILE ERR8 DEF *+1 BYT 10,16 ASC 14,CANNOT PURGE TEMPORARY FILE ERR9 DEF *+1 BYT 11,16 ASC 14,CANNOT OPEN OBJECT CODE FILE ERR10 DEF *+1 BYT 12,15 ASC 13,INVALID OBJECT CODE RECORD ERR11 DEF *+1 BYT 13,26 ASC 22,INVALID ADDRESS SPECIFICATION OR EXTRA INPUT ERR12 DEF *+1 BYT 14,20 ASC 16,ADDRESS NOT FOUND IN OBJECT CODE ERR13 DEF *+1 BYT 15,15 ASC 13,I/O ERROR READING RESPONSE ERR14 DEF *+1 BYT 16,12 ASC 10,INSUFFICIENT MEMORY ERR15 DEF *+1 BYT 17,22 ASC 18,VERIFY ERROR -- PROM TAPE REPUNCHED * * ******************** * * E X F * * ENTRY: * LDA * LDB * JSB EXF * DEF * DEF <# BITS> * * EXIT: * A= LOW WORD * B= HIGH WORD * * EXTRACTS UP TO 24 BITS FROM TWO-WORD VALUE AND RETURNS * FIELD RIGHT-JUSTIFIED IN B/A-REGISTERS. * EXF NOP STA XLOW LDA EXF,I ISZ EXF LDA A,I LEFT BIT # ADA =D-31 -SHIFT COUNT (32-BIT#-1) STA XCNT LDA XLOW RESTORE A-REG XLSL LSL 1 SHIFT OFF LEFT BITS ISZ XCNT JMP XLSL STA XLOW LDA EXF,I ISZ EXF LDA A,I # BIT^S ADA =D-32 - SHIFT COUNT (32-#BITS) STA XCNT LDA XLOW RESTORE A-REG XLSR LSR 1 SHIFT OFF RIGHT BITS ISZ XCNT JMP XLSR JMP EXF,I XLOW BSS 1 XCNT BSS 1 * * ******************** * * F D E S G * * ENTRY: * LDA * LDB * JSB FDESG * * EXIT: * A=0: NULL DESIGNATOR * 1: DESIGNATOR OK * * PROMPTS FOR AND PARSES FILE DESIGNATOR. REPROMPTS IF * ERROR. * FDESG NOP STB REPOK SAVE "REPLACE" FLAG STA FDMSG ISZ FDMSG LDA A,I MSG LENGTH STA FDLEN FDTRY JSB PRMPT PROMPT FOR INPUT FDMSG DEF 0 JSB ENTER SZA,RSS NULL INPUT? JMP FDESG,I CLA RESET FILE DESCRIPTORS STA REP? STA FSEC STA FCR LDA BLNK2 CLEAR FNAME STA FNAME+1 STA FNAME+2 STA FNAME+3 LDA =D-6 ACCEPT 1ST 6 CHARS STA FDCNT LDA FNAME STA FDDST LDB INBUF JSB NXTC? END OF DESIGNATOR? JMP FDERR YES: MISSING FILENAME * FDNXT EQU * NEXT CHAR OF FILENAME STB FDINP LDB FDDST JSB STORB STB FDDST LDB FDINP JSB NXTC? END OF FILENAME? JMP FDSEC ISZ FDCNT JMP FDNXT NO FDSKP JSB NXTC? YES: SKIP EXTRA CHARS JMP FDSEC JMP FDSKP * FDSEC EQU * SECURITY SUBPARAMETER? CPA COLON JMP *+2 JMP FDREP JSB SUBP YES DEF FSEC CPA COLON CR LABEL SUBPARAMETER? JMP *+2 JMP FDREP JSB SUBP YES DEF FCR * FDREP EQU * CHECK FOR "REPLACE" CPA COMMA JMP *+2 JMP FDEOS NO STB FDINP LDA @REP JSB CMPB DEC 7 LDA REPOK ACCEPTABLE?... SZA SZB,RSS ...AND PARTIAL MATCH? JMP FDERR ISZ REP? YES ADB FDINP CHECK FOR" TRAILING BLANK JSB LOADB FDEOS EQU * CPA BLNK CLA,INA,RSS JMP FDERR JMP FDESG,I * FDERR EQU * LDA ERR1 JSB ERROR LDA FDLEN REPROMPT FOR DESIGNATOR JMP FDTRY FDCNT BSS 1 FDDST BSS 1 FDLEN BSS 1 FDINP BSS 1 @REP DBL *+1 ASC 4,REPLACE REPOK BSS 1 SET IF "REPLACE" ACCEPTABLE * * ******************** * * F I L L P * * ENTRY: * JSB FILLP * * EXIT: * A=0 IF PROM RANGE NOT FOUND * 1 IF PROM BUFFER LOADED * * LOADS OBJECT CODE INTO PROM BUFFER. HOW WE * PROCEED DEPENDS ON THE CURRENT STATE OF THE * PROM AND OBJECT CODE BUFFERS: * 1) IF PBASE=NUADR, THEN USE CURRENT PROM BUFFER * 2) IF ORIGN<=NUADR * JSB FMERR * * WRITES ERROR MESSAGE AND FMGR ERROR CODE ON LIST DEVICE. * FMERR NOP JSB ERROR LDA FMGR GET FMGR ERROR CODE CMA,SSA,INA NEGATIVE? JMP FM1 STA FMGR YES... LDA MINUS PREPEND "-" LDB @FM1 JSB STORB FM1 LDA FMGR CONVERT FMGR CODE LDB @FM2 JSB DECML DEC 3 LDA =D-18 MSG LENGTH JSB LIST DEF FMSG JMP FMERR,I FMSG ASC 9, FMGR ERROR 000 @FM1 DBL FMSG+7 @FM2 DBR FMSG+8 * * ******************** * * F O P E N * * ENTRY: * JSB FOPEN * * EXIT: * A= 0 IF NO FILE OPENED * 1 IF OPENED * * OPEN (EXISTING) OBJECT CODE FILE. * FOPEN NOP FPTRY LDA MSGF1 PI*($ROMPT FOR DESIGNATOR CLB DISALLOW "REPLACE" JSB FDESG SZA,RSS NULL? JMP FOPEN,I YES: RETURN A=0 JSB OPEN OPEN FILE DEF *+7 DEF DCB DEF FMGR DEF FNAME+1 DEF .0 DEF FSEC DEF FCR SSA ANY ERROR? JMP FOOPS CLA,INA NO JMP FOPEN,I FOOPS LDA ERR9 CANNOT ACCESS FILE JSB FMERR JMP FPTRY MSGF1 DEF *+1 DEC -24 ASC 12,OBJECT CODE FILE NAME? _ * * ******************** * * G E T L U * * ENTRY: * LDA * JSB GETLU * * EXIT: * A= -1 IF DEFAULT * LOW 6 BITS OF PARAMETER (LU) * * ISOLATES LU FROM PARAMETER AND DETERMINES IF DEFAULT IS * INDICATED (PARAMETER=0 OR 99). * GETLU NOP SZA DEFAULT? CPA =D99 CCA,RSS YES: SET A=-1 & SKIP AND =B77 ISOLATE LU JMP GETLU,I * * ******************** * * G E T R M * * ENTRY: <** JSB GETRM * * ALLOCATES NECESSARY SPACE FOR COMMENT BUFFERS. 37 WORDS * ARE ALLOCATED FOR EACH COMMENT LINE. IF INSUFFICIENT * MEMORY IS AVAILABLE, WE REPORT THE ERROR AND THE NUMBER * OF USABLE COMMENT LINES. * GETRM NOP LDA =D37 SIZE OF EACH BUFFER LDB #REM NUMBER OF BUFFERS JSB ALLOC STA REM PTR TO FIRST BUFFER CPB #REM ALL BUFFERS ALLOCATED? JMP GET2 YES STB #REM NO: SAVE ACTUAL NUMBER OF LINES LDA ERR14 JSB ERROR LDA #REM INCL #AVAILABLE LINES IN MSG SZA,RSS JMP GET1 LDB #GIVN JSB DECML DEC 2 LDA =D-29 JSB LIST DEF AVAIL GET2 LDA #REM INITIALIZE ALL COMMENTS TO CMA,INA ONE BLANK STA GRCNT LDA REM PTR TO FIRST BUFFER GET3 STA GRPTR ISZ GRPTR PTR TO MSG ITSELF CLB,INB INITIALIZE MSG LENGTH=1 STB A,I LDA =D36 BLANK BUFFER JSB CLEAR GRPTR DEF 0 LDA GRPTR COMPUTE PTR TO NEXT BUFFER ADA =D36 ISZ GRCNT JMP GET3 JMP GETRM,I GET1 LDA =A N NO COMMENT LINES AVAILABLE STA AVAIL+1 LDA =AO STA AVAIL+2 LDA =D-29 JSB LIST DEF AVAIL JMP GETRM,I AVAIL ASC 15, 00 COMMENT LINES AVAILABLE #GIVN DBL AVAIL+2 GRCNT BSS 1 * * ******************** * * G C N V T * * ENTRY: * LDA * LDB * JSB GCNVT * DEC <# BYTES> * * GRAPHICALLY PUNCHES DECIMAL OR OCTAL VALUE. * CHARACTERS ARE PRODUCED RIGHT-TO-LEFT (SEE "GRAPH" * FOR DISPLAY DETAILS). RADIX INDICATOR IS: * 0 -- OCTAL * 1 -- DECIMAL * GCNVT NOP ERB SAVE INDICATOR IN E-REG LDB GCNVT,I GET LENGTH CMB,INB STB GCNT ISZ GCNVT SEZ OCTAL CONVERSION? JMP GCV10 NO * GCV8 EQU * OCTAL CONVERSION STA GVAL AND s`=B7 NEXT OCTAL DIGIT JSB GRAPH CLB SHIFT VALUE LDA GVAL LSR 3 ISZ GCNT JMP GCV8 JMP GCNVT,I * GCV10 EQU * DECIAML CONVERSION CLB DIV =D10 STA GVAL ENTIER(VALUE/10) LDA B VALUE MOD 10 JSB GRAPH LDA GVAL ISZ GCNT JMP GCV10 JMP GCNVT,I GCNT BSS 1 GVAL BSS 1 * * ******************** * * G R A P H * * ENTRY: * LDA * JSB GRAPH * * GRAPHICALLY PUNCHES SPECIFIED CHARACTER. CODES ARE: * -4: LEFT PARENTHESIS * -3: RIGHT PARENTHESIS * -2: DASH * -1: BLANK SPACE * 0: ZERO * : * 9: NINE * * CHARACTERS ARE GENERATED SUCH THAT THEY READ CORRECTLY * WHEN THE TAPE IS FIRST HELD CORRECTLY FOR INPUT (IE. * BIT15 EDGE ON THE BOTTOM WITH THE DIRECTION OF TRAVEL TO * THE RIGHT) AND THEN FLIPPED (RETAINING THE DIRECTION OF * TRAVEL). THUS, THE LSB OF A BYTE REPRESENTS THE BASE OF * A CHARACTER, BUT THE RIGHT-EDGE OF THE CHARACTER IS * PUNCHED FIRST. EACH CHARACTER INCLUDES A PRECEDING * BLANK FRAME (IE., TO THE LEFT OF THE RESULTING CHARACTER). * NOTE THAT NOT ALL CHARACTERS ARE THE SAME WIDTH, ALTHO * A 5-BY-7 MATRIX IS RULE. * GRAPH NOP ALS,ALS CODE*4 ADA MATRX STA XBUF PTR TO GRAPHICS MATRIX ISZ XBUF LDA A,I LENGTH OF MATRIX JSB PNCHB XBUF DEF 0 JMP GRAPH,I MATRX DEF XZERO OCT -6 LEFT PAREN BYT 000,101,076,000,000,000 OCT -6 RIGHT PAREN BYT 000,000,076,101,000,000 OCT -5 DASH BYT 030,030,030,030,000,000 OCT -6 SPACE BYT 000,000,000,000,000,000 XZERO OCT -6 ZERO BYT 076,121,111,105,076,000 OCT -5 ONE BYT 001,177,141,021,000,000 OCT -6 ɡ TWO BYT 061,111,105,103,041,000 OCT -6 THREE BYT 076,111,111,101,042,000 OCT -6 FOUR BYT 177,104,044,024,014,000 OCT -6 FIVE BYT 106,111,111,111,172,000 OCT -6 SIX BYT 006,111,111,111,076,000 OCT -6 SEVEN BYT 170,104,102,101,100,000 OCT -6 EIGHT BYT 066,111,111,111,066,000 OCT -6 NINE BYT 077,110,110,110,060,000 * * ******************** * * I N P U T * * ENTRY: * JSB INPUT * * EXIT: * A= 0 IF END-RECORD * 1 IF DBL-RECORD * * READS OBJ RECORD FROM DEVICE OR DISC FILE INTO MEMORY. * ALSO VALIDATES RECORD CONTENTS AND ABORTS IF THERE IS * IS AN ERROR. RESETS OBJ BUFFER DESCRIPTORS IF NO ERROR. * THIS ROUTINE HANDLES THE GRUBBY DETAILS INVOLVED WHEN * BOTH THE OBJ CODE AND THE PUNCHED PROM TAPES ARE READ * FROM THE SAME DEVICE IN VERIFY PHASE. WE ALSO HANDLE * OTHER RELOAD SITUATIONS (ESP., AFTER REWIND). THIS IS * CONTROLLED BY DEVICE STATE FLAG WHICH IS MODIFIED HERE * AND IN (PROM TAPE) "READ" ROUTINE, AS WELL AS "REWND". * STATES ARE AS FOLLOWS: * -99: NOT IN USE. THUS WE DO NOT SUSPEND FOR RELOAD. * -2: "FORCED RELOAD" STATE FOR READING PROM TAPE * DURING "VERIFY ALL" PHASE. TREATED SAME AS -1. * -1: LAST USED FOR PROM TAPE READ. THUS WE SUSPEND * WHILE USER RELOADS OBJ TAPE * 0: DEVICE REWOUND. THUS WE SUSPEND WHILE USER * RELOADS OBJ TAPE. * 1: LAST USED FOR OBJ RECORD READ. WE ASSUME TAPE * IS STILL PROPERLY POSITIONED. * 2: END-RECORD READ FROM OBJ DEVICE * TO ALLOW FOR THE FACT THAT TAPE MAY HAVE BEEN REPOSITIONED, * WE CONTINUE SKIPPING OBJ RECORDS UNTIL WE FIND ONE THAT * "FOLLOWS" CURRENT CONTENTS OF OBJ BUFFER (LAST RECORD READ). * WE TREAT END-RECORD ON FIRST READ AS FATAL ERROR * (NO OBJECT CODE). * INPUT NOP LDB OSTAT,I GET DEVICE STATE STB INST SAVE ORIGINAL STATE CPB =D2 "END" STATE? JMP IN2 YES: RETURN SAME STATE CLA,INA SET "OBJ CODE" STATE STA OSTAT,I LDA OBJLU INPUT FROM DISC? CPA =D2 JMP INDSC YES CLA (IN CASE WE CALL RLOAD) CPB =D-99 NOT IN USE? JMP IN1 YES: ASSUME TAPE IS IN READER SZB REWOUND DEVICE?... SSB ...OR LAST READ WAS FOR PROM? JSB RLOAD YES: REQUIRE RELOAD IN1 CCA SET MASK TO RECOGNIZE BAD I/O STA CODE+1 JSB EXEC READ RECORD DEF *+5 DEF .1 DEF OBCTL DEF CODE+1 DEF .59 SZB,RSS END OF TAPE? JMP IN1 YES: REREAD CCA I/O ERROR (IE., NO XFER)? CPA RECLN JMP INER1 YES JMP INCHK * INDSC JSB READF READ DISC RECORD DEF *+5 DEF DCB DEF FMGR DEF CODE+1 DEF .59 SSA FILE ERROR? JMP INER1 YES * INCHK JSB CHECK VALID RECORD INPUT? SZA,RSS JMP INER2 NO SSA END-RECORD? JMP INEND STA INST SET TO "NON-FIRST READ" STATUS LDA RECLN COMPUTE NEW LAST+1 ADDR ALF,ALF =(REC LENGTH - 5)*2 ADA =D-5 ARS # MICROWORDS ADA CODE+4 LAST+1 ADDR STA INLST CMA,INA OLD LAST < NEW LAST? ADA OLAST SSA,RSS JMP IN1 NO: READ NEXT RECORD LDA INLST STA OLAST LDA CODE+4 RECORD ORIGIN STA ORIGN STA OADDR CLA,INA RETURN A=1 FOR DBL-RECORD JMP INPUT,I * INEND LDA =D2 SET "END" STATE STA OSTAT,I LDA INST FIRST RECORD? SSA JMP INER4 YES: NO OBJ CODE IN2 CCA RESET DESCRIPTORS TO NULL BUFFER STA OLAST STA ORIGN STA OADDR CLA JMP INPUT,I * INER1 LDA ERR6 JMP *+2 INER2 LDA ERR10 JMP *+2 INER3 LDA ERR6 JMP *+2 INER4 LDA ERR3 JSB ERROR JMP ABORT INLST BSS 1 INST BSS 1 * * ******************** * * K S R C H * * ENTRY: * LDB * JSB KSRCH * DBL * DEC * * EXIT: * A= 0 IF NOT FOUND * KEYWORD TOKEN OTHERWISE * B= BPTR TO NEXT CHARACTER * * SEARCHES KEYWORD TABLE FOR A MATCH WITH KEY SPECIFIED. * * THE FORMAT EACH ENTRY IS: * BYT <#BYTES>,,..., * EACH ENTRY MUST BE A FIXED N+2 BYTES LONG (PASSED IN * P+2 OF THE CALL). <#BYTES> INDICATES NUMBER OF * CHARACTERS TO BE COMPARED. TABLE MUST BE TERMINATED * BY TWO ZEROES. * KSRCH NOP STB KKEY BPTR TO KEYWORD LDB KSRCH,I BPTR TO KEYWORD TABLE ISZ KSRCH * KSCH1 STB KPTR GET KEYWORD LENGTH JSB LOADB STA KLEN INB COMPARE STRINGS LDA KKEY (NB: THIS ALWAYS "COMPARES" JSB CMPB IF #BYTES=0) KLEN DEC 0 SZA,RSS MATCH? JMP KSCH2 YES LDB KPTR COMPUTE BPTR TO NEXT KEYWORD ENTRY ADB KSRCH,I JMP KSCH1 * KSCH2 ADB KKEY COMPUTE BPTR TO AFTER KEYWORD SPECIFIED STB KKEY LDB KPTR GET KEYWORD TOKEN (INTO A-REG) INB JSB LOADB LDB KKEY ISZ KSRCH JMP KSRCH,I KKEY BSS 1 KPTR BSS 1 * * ******************** * * L E A D R * * ENTRY: * JSB LEADR * * PUNCHES LEADR ON PUNCH DEVICE. * LEADR NOP JSB EXEC DEF *+3 DEF .3 DEF PNCTL JMP LEADR,I * * ******************** * * L I S T * * ENTRY: * LDA * JSB LIST * DEF * * WRITES MESSAGE ONTO LIST DEVICE. * LIST NOP STA LLEN LDA LIST,I STA LBUF ISZ LIc^ST JSB EXEC DEF *+5 DEF .2 DEF PRCTL LBUF DEF 0 DEF LLEN JMP LIST,I LLEN BSS 1 * * ******************** * * L O A D B * * ENTRY: * LDB * JSB LOADB * * EXIT: * A= CHARACTER * B= BPTR TO NEXT CHARACTER * * LOADS BYTE FROM STRING. * LOADB NOP CLE,ERB CONVERT BPTR TO WORD PTR LDA B,I GET WORD SEZ,RSS WANT LEFT BYTE? ALF,ALF YES AND =B377 ISOLATE BYTE ELB RESET BPTR INB BPTR TO NEXT CHARACTER JMP LOADB,I * * ******************** * * M O V E * * ENTRY: * LDA <# WORDS> * LDB * JSB MOVE * DEF * * EXIT: * A= PTR TO NEXT TARGET WORD * B= PTR TO NEXT SOURCE WORD * * MOVES ONE WORD ARRAY TO ANOTHER. * MOVE NOP CMA,INA STA MLEN LDA MOVE,I TARGET PTR STA MDEST ISZ MOVE * MV0 EQU * LDA B,I NEXT SOURCE WORD STA MDEST,I INB ISZ MDEST ISZ MLEN JMP MV0 LDA MDEST JMP MOVE,I MDEST BSS 1 MLEN BSS 1 * * ******************** * * N U M * * ENTRY: * LDA * JSB NUM * * EXIT: * A= 0 IF "NULL" INPUT * VALUE * * PROMPTS FOR AND INPUTS NON-NEGATIVE NUMERIC VALUE. * NUM NOP STA NMSG ISZ NMSG LDA A,I MSG LENGTH STA NLEN NTRY JSB PRMPT PROMPT FOR INPUT NMSG DEF 0 JSB ENTER READ SZA,RSS NULL INPUT? JMP NUM,I YES: RETURN A=0 LDB INBUF CONVERT NUMBER JSB CON? JMP NERR INVALID NUMBER SSA NUMBER<0 NOT ALLOWED JMP NERR STA NVAL JSB LOADB FOLLOWED BY BLANK? CPA BLNK JMP *+2 JMP NERR NO: SYNTAX ERROR LDA NVAL JMP NUM,I NERR LDA ERR5 JSB ERROR *($LDA NLEN JMP NTRY REPROMPT FOR INPUT NLEN BSS 1 NVAL BSS 1 * * ******************** * * N X T C ? * * ENTRY: * LDB * JSB NXTC? * * * * EXIT: * A= CHARACTER * B= BPTR TO NEXT CHARACTER (EXCEPT IF END-OF-STRING) * * DETERMINES WHETHER NEXT CHARACTER TERMINATES SUBPARAMETER. * NXTC? NOP JSB LOADB CPA COLON JMP NXTC?,I CPA COMMA JMP NXTC?,I CPA BLNK JMP NXT1 END-OF-STRING ISZ NXTC? NOT END OF STRING JMP NXTC?,I NXT1 ADB =D-1 JMP NXTC?,I * * ******************** * * O C T ? * * ENTRY: * LDB * JSB OCT? * * * * EXIT: * B= PTR TO CHARACTER (AS ON ENTRY) * * DETERMINES IF NUMERIC STRING IS OCTAL (TRAILING "B"). * OCT? NOP STB OPTR CLA MASK CLOBBERS "B" IF NO DIGITS STA OFLG SCANNED OCT1 EQU * JSB LOADB SCAN DIGITS ADA .M"0" "0"<=CHAR? SSA (A=CHAR-"0") JMP OCT2 NO ADA =D-10 DIGIT<10? SSA,RSS JMP OCT2 NO CCA SET MASK TO COPY LAST CHAR STA OFLG (TO INDICATE THAT DIGIT SCANNED) $* JMP OCT1 * OCT2 EQU * AND OFLG RESET A=0 IF NO DIGITS SCANNED CPA =B10 "B"-"0"-10B? ISZ OCT? YES: TRAILING "B" PRESENT LDB OPTR ORIGINAL BPTR JMP OCT?,I OFLG BSS 1 OPTR BSS 1 * * ******************** * * O C T A L * * ENTRY: * LDA * LDB * JSB OCTAL * DEC <# BYTES> * * EXIT: * A= LEFT DIGIT * B= BPTR TO LEFT-1 DIGIT * * CONVERTS VALUE TO ASCII STRING. MAY PRODUCE LEADING * ZEROES. * OCTAL NOP STA OCVAL LDA OCTAL,I NUMBER OF DIGITS CMA,INA STA OCCNT ISZ OCTAL * OCT0 STB OCDST CLA SHIFT RIGHT OCTAL DIGIT LDB OCVAL INTO A-REG LSR 3 ALF,RAR A=VALUE MOD 8 STB OCVAL B=VALUE/8 ADA =B60 CONVERT TO ASCII LDB OCDST JSB STORB STORE INTO STRING ADB =D-2 BPTR TO LEFT DIGIT ISZ OCCNT JMP OCT0 JMP OCTAL,I OCCNT BSS 1 OCDST BSS 1 OCVAL BSS 1 * * ********************* * * O P S Y S * * ENTRY: * JSB OPSYS * DEC
* JSB FD&MV * DEF * DEF * * FD&MV NOP STA SAVE1 SAVE TABLE BIT PATTERN AND B37 GET FIELD BIT PATTERN STA SAVE0 SAVE BIT PATTERN LDB .3 ASSUME 21MX INITIALLY JSB CKTYP 21MX? LDB .2 NO.XE CBX SAVE TABLE INDEX VALUE IN X LDB FD&MV,I GET POINTER TO START OF TABLE ISZ FD&MV BUMP RETURN ADDRESS FD&02 EQU * LAX B,I GET TABLE BIT PATTERN CAY SAVE IT CPA M1 NOT VALID FOR THIS MACHINE? JMP FD&03 RIGHT.SKIP IT AND B37 MASK OFF EXTRA INFORMATION CPA SAVE0 FOUND IT? JMP FD&01 YES FD&03 EQU * ADB .4 NO.BUMP TABLE POINTER QTO NEXT ENTRY JMP FD&02 CONTINUE LOOKING FD&01 EQU * LDA SAVE1 ANY INFORMATION AND M100 BIT IN THE TABLE SZA BIT PATTERN? JMP FD&04 YES.GO CHECK FOR MATCH FD&05 EQU * LDA B POSITION SOURCE LDB FD&MV,I AND DESTINATION ISZ FD&MV ADDRESSES FOR MOVE MVW .2 MOVE MNEMONIC INTO OUTPUT LINE BUFFER CYA GET INFORMATION ALF BITS RIGHT HAND AND .7 JUSTIFIED IN A JMP FD&MV,I FD&04 EQU * STA SAVE1 SAVE INFORMATION BIT CYA GET TABLE ENTRY AND SAVE1 HAVE DESIRED SZA BIT? JMP FD&05 YES.GO MOVE JMP FD&03 NO.KEEP LOOKING SKP * F D R E G * * FINDS CURRENT REGISTER'S INDEX VALUE. * * * JSB FDREG * P+1 * P+2 * * FDREG NOP LDB FDREG,I GET POINTER TO SAVEABLE REGISTERS TABLE ISZ FDREG BUMP RETURN CLA,INA INITIALIZE INDEX CAX COUNTER FDR02 EQU * LDA B,I GET 1ST 2 CHARACTERS OF REGISTER CPA PRAM GOT A MATCH? JMP FDR01 YES.GO SEE IF COMPLETE MATCH SZA,RSS NO.DID TABLE END? JMP FDREG,I YES.COULDN'T FIND IT ADB .2 BUMP POINTER TO NEXT REGISTER IN TABLE FDR04 EQU * ISX BUMP INDEX COUNTER JMP FDR02 CONTINUE FDR01 EQU * LDA PRAM+1 GET 2ND 2 CHARACTERS OF REGISTER INB POINT TO 2ND WORD OF TABLE ENTRY CPA B,I GOT A 2ND MATCH? JMP FDR03 YES.THIS IS IT INB NO.POINT TO NEXT ENTRY JMP FDR04 CONTINUE LOOKING FDR03 EQU * CXA GET INDEX IN A JSB CKREG REGISTER OK FOR COMPUTER TYPE? ISZ FDREG YES.BUMP RETURN JMP FDREG,I SKP * F I N D * * FINDS CURRENT ERROR'S EXPANSION MESSAGE ADDRESS AND * DETERMINES ITS LENGTH. USED EXCLUSIVELY BY COMMAND * ROUTINE "QUEST". * * LDY * JSB FIND * <(A)=ADDRESS OF ERROR MESSAGE> * <(B)=LENGTH OF EXPANSION MESSAGE(+WORDS)> * * FIND NOP CYB GET ERROR NUMBER IN B LDA PNT07 GET ADDRESS OF DEF ADA B TO EXPANSION MESSAGE STA SAVE0 SAVE ERROR TABLE ENTRY CMA,INA MAKE IT NEGATIVE ADA PNT09 IS IT GREATER THAN SSA THE END OF THE ERROR TABLE? JMP FIN01 YES.UNDEFINED ERROR NUMBER-OVERFLOW LDA SAVE0 NO.RESTORE ERROR TABLE ENTRY TO A LDB A,I B=-ADDRESS OF CMB,INB ERROR EXPANSION MESSAGE INA A=ADDRESS OF DEF TO NEXT EXPANSION ADB A,I CALCULATE MESSAGE LENGTH SSB POSITIVE WORD COUNT? FIN01 EQU * CLB NO.END OF ERROR TABLE ADA M1 YES.POINT BACK TO LAST TABLE ENTRY LDA A,I GET ADDRESS OF EXPANSION MESSAGE JMP FIND,I SKP * F I X I T * * USED EXCLUSIVELY BY SUBROUTINE "PICK". REPLACES LAST CHARACTER * MOVED TO BUFFER "PRAM"(DELIMITING CHARACTER) WITH A BLANK. * * JSB FIXIT * FIXIT NOP LDB XDADR MOVE LDA XDCNT BACK ONE SLA,RSS CHARACTER ADB M1 IN SUBROUTINE ADA M1 "XPUT" STA XDCNT STB XDADR LDA BLANK MOVE A JSB XPUT BLANK IN OVER NOP LAST CHARACTER JMP FIXIT,I SKP * F M P E R * * REPORTS FMP ERROR. * * LDA <-FMP ERROR CODE> * JSB FMPER * FMPER NOP CAX SAVE ERROR CODE LDA .6 INITIALIZE SUBROUTINE "XPUT" LDB PNT14 FOR 6 CHARACTERS TO ERROR CODE 8 JSB XPUTI AREA OF ERROR MESSAGE "EM018" CXA CONVERT ERROR CMA,INA CODE TO POSITIVE JSB XDCAS CONVERT TO ASCII JSB ERROR MDE DEF .18 ERROR 018 JMP FMPER,I SKP * F X B R K * * WRITES THE MICROINSTRUCTION BROKEN ON AND AN * UNCONDITIONAL JUMP IN THE MDE MICROCODE IN ORDER * TO RESUME MICROEXECUTION CORRECTLY. * * LDA * LDB * JSB FXBRK * P+1 * P+2 * P+3 * FXBRK NOP CAX SAVE CBY ADDRESSES LDA FXBRK,I GET ADDRESS TO BE LDA A,I WRITTEN IN MICROCODE ISZ FXBRK BUMP RETURN STA ADDRS SAVE IT LDB .3583 GET UPPER LIMIT OF 21MX JSB CKTYP 21MX? LDB UP.XE NO.USE XE UPPER LIMIT STB ADRS2 SET UPPER LIMIT OF RANGE JSB GETLU FIND THE WCS LU NOP # CONTAINING THE ADDRESS STA SAVE4 SAVE LU # CXA RESTORE CYB ADDRESSES INA SAVE THE BREAKPOINT STA SAVE5 ADDRESS + 1 LDA B,I MOVE MICROINSTRUCTION STA SBUF1 AT BREAKPOINT INB ADDRESS INTO LDA B,I WRITE BUFFER STA SBUF2 "SBUFF" LDA SAVE4 GET WCS LU # JSB WRIT1 WRITE MICROINSTRUCTION IN MICROCODE JMP FXBRK,I ERROR OCCURRED ISZ ADDRS POINT TO UNCONDITIONAL JUMP TO RESUME JSB GETLU FIND THE WCS LU NOP # CONTAINING THE LAST ADDRESS STA SAVE4 SAVE IT JSB GTJMP GET JMP UNCD IN WRITE BUFFER SKP LDA SBUF1 GET MICRO-OBJECT LDB SBUF2 CODE OF UNCOND. JUMP RRL 11 MASK OUT AND M40K OLD JUMP  IOR SAVE5 PUT RRR 11 IN STA SBUF1 NEW STB SBUF2 ONE LDA SAVE4 WRITE NEW UNCONDITIONAL JSB WRIT1 JUMP IN THE MDE MICROCODE JMP FXBRK,I ERROR OCCURRED LDA SAVE5 GET THE BREAKPOINT ADA M1 ADDRESS BACK IN A ISZ FXBRK BUMP RETURN JMP FXBRK,I SKP * F X D A T * * FIXES UP CURRENT RECORD FOR TRANSMISSION. * * LDA <# OF WORDS TO BE TRANSFERRED> * LDB * JSB FXDAT * FXDAT NOP ADA .5 COMPUTE STA XFER RECORD ALF,ALF LENGTH STA IOBUF FORM 1ST WORD OF RECORD LDA MASK2 PUT IN STA IOBUF+1 MICROCODE IDENTIFIER STB IOBUF+3 PUT IN ORG STB SAVE0 SAVE IT LDA .1 PUT IN MDE STA IOBUF+4 IDENTIFIER LDA WLOG ARS OR IN STB SAVE5 THE MODULO CAX 256 ADDRESS LDB PNT21 IN EACH FXD02 EQU * UPPER BYTE LDA SAVE5 OF FIRST AND B377 DATA WORD ALF,ALF FOR EACH IOR B,I MICROINSTRUCTION STA B,I ADB .2 ISZ SAVE5 DSX JMP FXD02 LDB SAVE0 COMPUTE INB THE ADB MASK2 CHECKSUM LDX WLOG LDA PNT21 FXD01 EQU * ADB A,I INA DSX JMP FXD01 STB IOBUF+2 JMP FXDAT,I SKP * F X R E G * * GETS RID OF DON'T CARE BITS IN REGISTERS LESS THAN 16 * BITS BY REPLACING THEM WITH ZEROS. * * JSB FXREG * DEF <1ST REGISTER IN BUFFER "SVREG" LESS THAN 16 BITS> * FXREG NOP LDB FXREG,I GET POINTER TO DSPI LDA B,I GET RID AND B77 OF DON'T CARES STA B,I FOR DSPI INB LDA B,I GET RID AND B377 OF DON'T CARES STA B,I ǸFOR CNTR INB LDA B,I GET RID AND .1 OF DON'T CARES STA B,I FOR FLAG LDA O.REG GET RID AND .1 OF DON'T CARES STA O.REG FOR O-REGISTER LDA E.REG GET RID AND .1 OF DON'T CARES STA E.REG FOR E-REGISTER ISZ FXREG BUMP RETURN JMP FXREG,I SKP * G E T L U * * SEARCHES THE WCSLT FOR A WCS LU ASSOCIATED WITH CURRENT * WCS ADDRESS LIMITS. * * * * JSB GETLU * P+1 * P+2 * GETLU NOP LDA PNT01 INITIALIZE A POINTER STA SAVE2 TO THE WCSLT LDA SAVE2,I GET ENTRY GET04 EQU * SZA,RSS ENTRY THERE? JMP GETLU,I NO.NO LU'S ON CURRENT RANGE ISZ SAVE2 YES.BUMP WCSLT POINTER STA SAVE3 SAVE LU # JSB STATE READ LOGICAL STATE LDA SBUF1 GET AND B7 SUBCHANNEL LDB .511 DETERMINE LU'S CPA .2 ENDING WCS LDB .255 ADDRESS ADB SBUF2 STB SBUF1 SAVE IT LDA ADDRS IS THE CURRENT CMA,INA WCS ADDRESS LESS THAN ADA ADRS2 OR EQUAL TO THE SSA UPPER WCS ADDRESS? JMP GETLU,I NO.DONE LDA ADDRS IS THE CURRENT CMA,INA WCS ADDRESS LESS THAN ADA SBUF1 OR EQUAL TO THIS SSA LU'S UPPER WCS ADDRESS? JMP GET02 NO LDA SBUF2 YES.IS THE CURRENT CMA,INA WCS ADDRESS GREATER THAN ADA ADDRS OR EQUAL TO THIS SSA LU'S LOWER WCS ADDRESS? JMP GET02 NO ISZ GETLU LU CONTAINS THE CURRENT WCS ADDRESS LDB ADDRS DETERMINE THE # OF CMB,INB MICROINSTRUCTIONS LEFT BETWEEN ADB SBUF1 CURRENT ADDRESS & LAST ADDRESS ON LU LDA M.27 MORE THAN 27 ADA B MICROINSTRUCTIONS SSA,RSS LEFT? LDB .27 YES SKP BLS SAVE (# OF MICROINSTRUCTIONS) X 2 STB SAVE0 FOR READ REQUEST LDA ADDRS DETERMINE # OF MICROINSTRUCTIONS CMA,INA LEFT BETWEEN CURRENT WCS ADDRESS ADA ADRS2 AND LAST ADDRESS OF REQUEST ALS TIMES 2 FOR COMPARISON STA SAVE4 SAVE IT CMA,INA IS IT GREATER THAN ADA SAVE0 THE CURRENT READ SSA REQUEST VALUE? JMP GET01 YES LDA SAVE4 NO.MAKE IT THE STA SAVE0 NEW READ REQUEST VALUE GET01 EQU * LDA SAVE3 A= AND B77 LU # LDB SAVE0 B=READ REQUEST VALUE JMP GETLU,I GET02 EQU * LDA SAVE2,I GET NEXT ENTRY IN WCSLT CPA M1 END OF TABLE? JMP GETLU,I YES.DONE JMP GET04 NO.GO SEE IF ITS GOT CURRENT WCS ADDRESS SKP * G S T O R * * REPLACES THE OLD STORE MICROFIELD OBJECT CODE WITH * THE NEW STORE. * * <"XGET" SUBROUTINES POINTING TO THE NEXT PARAMETER> * JSB GSTOR * GSTOR NOP JSB GTNXT GET STORE MNEMONIC JMP GST01 GOT IT.GO ON LDA SBUF2 DEFAULTED.GET RRR 5 STORE MICROFIELD AND B37 BITS IOR B20K SET STORE TABLE BIT JSB FD&MV FIND DEF STORE STORE DEF PRAM MNEMONIC GST01 EQU * LDA B20K SET STORE BIT FOR SEARCH JSB SRCH GO FIND STORE DEF STORE BIT PATTERN JSB MICER COULDN'T FIND IT.INVALID DEF .7 MNEMONIC.REPORT MDE DEF STNOP ERROR 020(MICRO ERROR 7) AND B37 GET STORE BIT PATTERN STA SAVE0 SAVE IT  LDA SBUF2 REPLACE OLD RRR 5 STORE BIT AND M40 PATTERN WITH IOR SAVE0 THE NEW RRL 5 BIT PATTERN STA SBUF2 JMP GSTOR,I SKP * G T 1 6 B * * ACCEPTS A 6 BIT OCTAL(16 BIT BINARY) NUMBER AS AN * INPUT BY CONVERTING TO THE APPROPRIATE NUMBER OR * LETTING SUBROUTINE "PICK" PARSE IT IF LESS THAN * 6 DIGITS. * * JSB GT16B * * * * GT16B NOP CLA CLEAR END OF STA SAVE5 PARAMETERS FLAG JSB SVSUB SAVE STATE OF "XGET" SUBROUTINES LDA .6 INITIALIZE SUBROUTINE LDB PNT03 "XPUT" FOR 6 CHARACTERS JSB XPUTI TO BUFFER "XBUFF" JSB XGETN GET NEXT NON-BLANK CHARACTER JMP GT101 END OF INPUT.<6 CHARACTERS GT103 EQU * JSB XPUT MOVE TO BUFFER "XBUFF" JMP GT102 END OF BUFFER.GO CHECK FOR "B" CPA "B" CURRENT CHARACTER A "B"? JMP GT101 YES.<6 CHARACTERS CPA COMMA IS IT A COMMA? JMP GT101 YES.<6 CHARACTERS CPA COLON IS IT A COLON? JMP GT101 YES.<6 CHARACTERS JSB XGET GET NEXT CHARACTER JMP GT101 END OF INPUT.<6 CHARACTERS JMP GT103 CONTINUE GT102 EQU * CPA "B" 7TH CHARACTER A "B"? RSS YES.OK JMP MDE10 NO.ILLEGAL JSB XGETN SET "XGET" SUBROUTINES TO NEXT NON-BLANK CHAR. ISZ SAVE5 END OF INPUT.SET FLAG LDA .6 INITIALIZE "XGET" LDB PNT03 SUBROUTINES JSB XGETI FOR CONVERSION JSB XASOC MAKE OCTAL CONVERSION STA NUMB MOVE RESULTS TO LOCATION "NUMB" LDB SAVE5 DID THE SZB INPUT END? CLB,RSS YES CLB,INB NO JMP GT16B,I GT101 EQU B<:6* JSB RSSUB RESTORE STATE OF "XGET" SUBROUTINES CCE NON-COMMAND INPUT JSB GTNUM USE NORMAL PARSE TO GET # JMP GT16B,I SKP * G T C H R * * GETS NEXT NON-NUMERIC PARAMETER.MAY BE DEFAULTED. * * JSB GTCHR * * * GTCHR NOP CCE NON-COMMAND INPUT JSB PICK GET PARAMETER JMP MDE10 ILLEGAL PARAMETER CPA B100K FILE NAME? JMP MDE10 YES.ILLEGAL CPB .1 NUMERIC PARAMETER? JMP MDE10 YES.ILLEGAL SZB PARAMETER DEFAULTED? CLB,INB NO.SET B=1 SZA YES.MORE PARAMETERS LEFT? CLA,INA YES.SET A=1 SWP EXCHANGE REGISTERS JMP GTCHR,I SKP * G T E Q T * * GETS EQUIPMENT TYPE(DVR #). <* * LDA * JSB GTEQT * * GTEQT NOP AND B77 SET UP STA CONWD CONTROL WORD JSB EXEC GET I/O DEF GTE01 STATUS DEF .13 DEF CONWD DEF SBUF1 GTE01 EQU * LDA SBUF1 EXTRACT AND MASK1 DVR # ALF,ALF JMP GTEQT,I SKP * G T J M P * * GETS AN UNCONDITIONAL JUMP TO CONTROL MEMORY ADDRESS * 0 IN THE WRITE BUFFER "SBUFF". * * JSB GTJMP * GTJMP NOP LDB PNT37 INITIALLY ASSUME 21MX JSB CKTYP 21MX? LDB PNT38 NO.XE.USE XE TABLE ADB .228 POINT TO ADB M2 UNCONDITIONAL JUMP LDA B,I MOVE 8 MSB OF UNCONDITIONAL STA SBUF1 JUMP TO HIGH BYTE OF WRITE BUFFER INB NOW MOVE THE 16 LDA B,I LSB OF UNCONDITIONAL JUMP STA SBUF2 TO THE LOW 2 BYTES OF WRITE BUFFER JMP GTJMP,I SKP * G T M A C * * DETERMINES IF THERE IS A WCS LU WHICH CONTAINS THE * RE-ENTRY ADDRESS AND IF IT IS A VALID MAP DESTINATION. * A MACRO CALL TO THAT ADDRESS IS THEN FORMED. * * * JSB GTMAC * P+1 * P+2 * GTMAC NOP LDA ADRS1 MOVE RE-ENTRY ADDRESS STA ADDRS TO LOCATION "ADDRS" JSB GETLU FIND WCS LU # CONTAINING ADDRESS JMP GTM01 COULDN'T FIND ANY.ERROR LDA ADRS1 YES.IS IT AND B360 A VALID SZA MAP DESTINATION? JMP GTM01 NO.ERROR JSB CKTYP YES.21MX? JMP GTM02 NO.XE LDA ADRS1 SET UP MODULE AND M20 ADDRESS STA SAVE0 SAVE IT LDB PNT41 POINT TO MX MAP JMP GTM07 GO SEARCH FOR MACRO GTM04 EQU * LDB A SAVE MACRO IN B LDA ADRS1 FORM AND B17 MACLJRO IOR B IN A ISZ GTMAC BUMP RETURN GTM01 EQU * JMP GTMAC,I GTM02 EQU * LDA ADRS1 SET UP MODULE AND M20 ADDRESS STA SAVE0 SAVE IT LDB PNT39 POINT TO XE MAP TABLE GTM07 EQU * LDA B,I FOUND CPA SAVE0 ADDRESS? JMP GTM06 YES SZA,RSS NO.TABLE END? JMP GTM01 YES.ERROR ADB .2 NO.BUMP POINTER TO NEXT ADDRESS JMP GTM07 CONTINUE GTM06 EQU * INB GET LDA B,I MACRO JMP GTM04 SKP * G T N U M * * GETS NEXT PARAMETER IN THE INPUT ASCII STRING. PARAMETER MUST * BE A NUMBER ONLY. * * CLE * CCE * JSB GTNUM * * * * GTNUM NOP JSB PICK GET PARAMETER JMP MDE10 ILLEGAL PARAMETER CPB M1 NON-NUMERIC PARAMETER? JMP MDE10 YES.ILLEGAL CPB B100K FILE NAME? JMP MDE10 YES.ILLEGAL CLE,SZB,RSS DEFAULT PARAMETER? CCE YES.SET E SZB DEFAULT PARAMETER? LDB NUMB NO CPA M1 MORE PARAMETERS LEFT IN INPUT STRING? CLA,INA YES SWP EXCHANGE REGISTERS JMP GTNUM,I SKP * G T N X T * * GETS NEXT NON-NUMERIC PARAMETER IF NOT DEFAULTED. * * * JSB GTNXT * P+1 * P+2 * GTNXT NOP LDA FLAG5 DEFAULT THIS SZA MICROFIELD? JMP *+5 YES.GO RETURN P+2 JSB GTCHR NO.GET NEXT NON-NUMERIC PARAMETER SZB,RSS ANY MORE PARAMETERS? ISZ FLAG5 NO.SET END OF PARAMETERS FLAG SZA,RSS DEFAULT THIS PARAM7ETER? ISZ GTNXT YES.RETURN P+2 JMP GTNXT,I SKP * G T O P R * * GETS NEXT PARAMETER WHICH SHOULD BE AN OPERAND. * * * JSB GTOPR * P+1 * P+2 * P+3 * GTOPR NOP LDA FLAG5 DEFAULT THIS SZA,RSS PARAMETER? JMP GTO01 NO.GO GET IT GTO02 EQU * ISZ GTOPR YES.BUMP JMP GTOPR,I RETURN GTO01 EQU * JSB PICK GET OPERAND JMP MDE10 ILLEGAL PARAMETER SZA ANY PARAMETERS LEFT? JMP MDE10 YES.ILLEGAL CPB B100K FILE NAME? JMP MDE10 YES.ILLEGAL SZB,RSS DEFAULTED? JMP GTO02 YES.RETURN P+2 CPB M1 NON-NUMERIC PARAMETER? JMP GTOPR,I YES.RETURN LDA NUMB NO.RETURN ISZ GTOPR BUMP RETURN JMP GTO02 P+3 SKP * G T P A R * * GETS PARAMETERS FROM CALLING PROGRAM AND PUTS THEM IN A * PARAMETERS BUFFER. DOES SAME THING AS .ENTR,BUT NEED NOT BE * CALLED IMMEDIATELY AFTER THE ROUTINE ENTRY POINT. * * JSB GTPAR * DEF * GTPAR NOP LDA GTPAR,I GET POINTER TO STA SAVE0 PARAMETERS BUFFER ISZ GTPAR BUMP GTPAR RETURN LDB MDES GET MDES RETURN LDA B,I ADDRESS FROM CALLING STA MDES PROGRAM IN MDES GTP01 EQU * INB POINT TO PARAMETER CPB MDES AT MDES RETURN? JMP GTPAR,I YES.DONE LDA B,I NO.MOVE A PARAMETER STA SAVE0,I INTO THE PARAMETERS BUFFER ISZ SAVE0 BUMP BUFFER POINTER JMP GTP01 CONTINUE SKP * G T R E G * * GETS CURRENT REGISTER MNEMONIC & CONTENTS BASED ON * INPUT REGISTERS TABLE ENTRY AND MOVES THEM TO THE * APPROPRIATE POSITION IN THE OUTPUT LINE BUFFER. * *  * JSB GTREG * P+1 * P+2 * P+3 * P+4 * * GTREG NOP LDA GTREG,I GET POINTER TO OUTPUT LINE BUFFER ISZ GTREG BUMP RETURN STA SAVE0 SAVE IT LDB SAVE6,I GET INPUT REGISTERS TABLE ENTRY ADB M1 OFFSET -1 RBL TIMES 2 ADB GTREG,I POINT TO REGISTER MNEMONIC ISZ GTREG BUMP RETURN LDA B,I MOVE STA SAVE0,I THE INB REGISTER ISZ SAVE0 MNEMONIC = LDA B,I TO THE STA SAVE0,I OUTPUT ISZ SAVE0 LINE BUFFER LDA "=.S" STA SAVE0,I ISZ SAVE0 BUMP OUTPUT LINE POINTER LDA .6 INITIALIZE SUBROUTINE LDB PNT03 "XPUT" FOR 6 CHARACTERS JSB XPUTI TO BUFFER "XBUFF" LDA SAVE6,I GET INPUT REGISTERS TABLE ENTRY ADA M1 OFFSET -1 LDB GTREG,I GET ADB A REGISTER LDA B,I CONTENTS ISZ GTREG BUMP RETURN LDB SAVE0 GET DESTINATION OF CONVERSION STB GTR01 STORE IT FOR SUBROUTINE "MBTS" CALL JSB XOCAS CONVERT IT TO ASCII JSB MBTS MOVE CONTENTS TO GTR01 BSS 1 OUTPUT LINE BUFFER ISZ SAVE6 IS NEXT INPUT REGISTER LDA SAVE6,I ENTRY INDICATE THE SZA END OF REGISTERS? CLA,RSS NO CLA,INA YES JMP GTREG,I SKP * G T V A L * * GETS CURRENT PARAMETER VALUE FROM OPERATOR INPUT. * * USER RESPONSE: / * R * XXXXX * DEF.YY * A * * / LEAVES THE CURRENT] PARAMETER UNCHANGED AND MOVES TO * THE NEXT PARAMETER. * * R DESIGNATES THE CURRENT POSITION AS A VALID RETURN POINT. * * XXXXX IS ANY VALID NUMBER TO BE USED AS A PARAMETER. * * DEF.YY CREATES A DEF TO PARAMETER POSITION P+YY. * * A ABORTS THE PR COMMAND. * * * JSB GTVAL * P+1 * P+2 * P+3 * GTVAL NOP CCE GET OPERATOR JSB PICK INPUT JMP MDE10 ILLEGAL PARAMETER CPB B100K FILE NAME? JMP MDE10 YES.ILLEGAL SZA MORE PARAMETERS? JMP MDE10 YES.ILLEGAL SZB,RSS PARAMETER DEFAULTED? JMP MDE10 YES.ILLEGAL CPB M1 NO.NON-NUMERIC? JMP GTV01 YES.GO ANALYZE FURTHER LDB GTVAL,I NO.MUST BE A NUMBER ADB SAVE6 FORM TABLE POINTER ISZ GTVAL BUMP RETURN CLA MAKE PARAMETER TABLE STA B,I ENTRY NUMERIC LDB GTVAL,I GET MICROPROGRAM ADB SAVE6 CALL POINTER ISZ GTVAL BUMP RETURN LDA NUMB MOVE NEW NUMERIC STA B,I PARAMETER TO CURRENT POSITION JMP GTVAL,I RETRY THE GET SKP GTV01 EQU * LDA PRAM GET 1ST 2 CHARACTERS CPA "A.S" IS IT ABORT? JMP GTV02 YES ALF,ALF GET 1ST AND B377 CHARACTER RHJ CPA "/" IS IT SLASH? JMP GTV03 YES.GO BUMP AND RETURN TO NEXT POSITION CPA "R" IS IT R? JMP GTV04 YES LDA PRAM NO.SHOULD BE DEF CPA "DE" 1ST 2 CHARACTERS OK? RSS YES JMP MDE10 NO.ILLEGAL LDA PRAM+1 2ND 2 CPA "F.P" CHARACTERS OK? RSS YES JMP MDE10 NO.ILLEGAL LDA .2 INITIALIZE "XGET" LDB PNT10 SUBROUTINu3ES FOR ADB .2 2 CHARACTERS FROM JSB XGETI PARAMETERS POSITION DEF JSB XASDC CONVERT TO INTEGER JMP MDE10 NON-NUMERIC.ILLEGAL CPB BLANK DELIMITED BY A BLANK? JMP GTV05 YES.OK SZB NO.END OF BUFFER? JMP MDE10 NO.ILLEGAL GTV05 EQU * STA NUMB IS POSITION ADA M.11 POINTER SSA,RSS <=10? JMP MDE10 NO.ILLEGAL ADA .10 IS POSITION SSA POINTER <0? JMP MDE10 YES.ILLGAL LDA .2 MAKE LDB GTVAL,I PARAMETER ISZ GTVAL TABLE ENTRY ADB SAVE6 A DEF STA B,I LDB GTVAL,I MOVE ISZ GTVAL NEW LDA NUMB DEF TO ADA M1 CURRENT ADA B PARAMETER ADB SAVE6 POSITION STA B,I JMP GTVAL,I RETRY THE GET SKP GTV04 EQU * LDB GTVAL,I MAKE ISZ GTVAL PARAMETER ADB SAVE6 TABLE CLA,INA ENTRY A STA B,I RETURN LDB GTVAL,I MOVE NEW ISZ GTVAL RETURN TO ADB SAVE6 CURRENT LDA BRTN PARAMETER STA B,I POSITION JMP GTVAL,I GTV02 EQU * LDA .9 CAUSE CURRENT POSITION STA SAVE6 TO = END OF PARAMETERS GTV03 EQU * LDA GTVAL RETURN ADA .3 WITHOUT JMP A,I RETRY SKP * I N M A S * * INVERSE MICROASSEMBLES THE MICROINSTRUCTION AT THE CURRENT * WCS ADDRESS. * * CCE * CLE * LDA * JSB INMAS * P+1 * INMAS NOP LDB .19 INITIALLY ASSUME NO OBJECT CODE SEZ DISPLAY OBJECT CODE? LDB .25 YES.INCREASE WORD COUNT OF DISPLAY STB SAVE6 SAVE WORD COUNT R JSB READ1 READ ADDRESS JMP INMAS,I AN ERROR OCCURRED.DON'T GO ON LDA .46 INITIALIZE SUBROUTINE LDB PNT04 "XPUT" TO 46 CHARACTERS JSB XPUTI TO BUFFER "OBUFF" INM01 EQU * LDA BLANK FILL OUTPUT JSB XPUT LINE BUFFER RSS WITH BLANKS JMP INM01 LDA .6 INITIALIZE SUBROUTINE LDB PNT03 "XPUT" TO 6 CHARACTERS JSB XPUTI TO BUFFER "XBUFF" LDA ADDRS CONVERT CURRENT WCS JSB XOCAS ADDRESS TO ASCII LDA PNT03 MOVE 5 LEAST RAL SIGNIFICANT INA DIGITS OF ADDRESS LDB PNT04 COLUMNS 1-6 RBL OF OUTPUT LINE MBT .5 LDA SBUF1 GET ALF,ALF MICROINSTRUCTION ALF OPCODE AND B17 BITS JSB FD&MV FIND OPCODE MNEMONIC DEF OPCOD AND MOVE IT TO COLUMNS DEF OBUFF+4 9-12 OF OUTPUT LINE CPA .1 WORD TYPE I? JMP INM02 YES CPA .2 WORD TYPE II? JMP INM03 YES CPA .3 WORD TYPE III? JMP INM04 YES CPA .4 WORD TYPE IV? JMP INM05 YES SKP LDA SBUF2 GET SPECIAL AND B37 MICROFIELD BITS JSB FD&MV FIND SPECIAL MNEMONIC DEF SPEC AND MOVE IT TO COLUMNS DEF OBUFF+7 15-18 OF OUTPUT LINE LDA OBUFF+4 GET 1ST 2 CHARACTERS OF OPCODE MNEMONIC CPA "RT" IS IT RTN? JMP INM06 YES.TREAT DIFFERENT FROM JSB OR JMP LDA OBUFF+7 GET 1ST 2 CHARACTERS OF SPECIAL MNEMONIC CPA "CN" IS IT CNDX? JMP INM04 YES.WORD TYPE III JMP INM05 NO.WORD TYPE IV INM06 EQU * LDA OBUFF+7 GET 1ST 2 CHARACTERS OF SPECIAL MNEMONIC CPA "CN" IS IT CNDX? JMP INM04 YES.WORD TYPE III INM02 EQU * LDA SBUF2 GET SPECIAL AND B37 MICROkFIELD BITS JSB FD&MV FIND SPECIAL MNEMONIC DEF SPEC AND MOVE IT TO COLUMNS DEF OBUFF+7 15-18 OF OUTPUT LINE LDA SBUF1 GET LDB SBUF2 ALU RRL 1 MICROFIELD AND B37 BITS JSB FD&MV FIND ALU MNEMONIC DEF ALU AND MOVE IT TO COLUMNS DEF OBUFF+10 21-24 OF OUTPUT LINE LDA SBUF2 GET ALF,ALF STORE ALF,RAR MICROFIELD AND B37 BITS IOR B20K SET STORE TABLE BIT JSB FD&MV FIND STORE MNEMONIC DEF STORE AND MOVE IT TO COLUMNS DEF OBUFF+13 27-30 OF OUTPUT LINE LDA SBUF2 GET ALF S-BUS RAL,RAL MICROFIELD AND B37 BITS IOR B10K SET S-BUS TABLE BIT JSB FD&MV FIND S-BUS MNEMONIC DEF S.BUS AND MOVE IT TO COLUMNS DEF OBUFF+16 33-36 OF OUTPUT LINE JMP INM07 GO SEE ABOUT OBJECT CODE SKP INM03 EQU * LDA SBUF2 GET SPECIAL AND B37 MICROFIELD BITS JSB FD&MV FIND SPECIAL MNEMONIC DEF SPEC AND MOVE IT TO COLUMNS DEF OBUFF+7 15-18 OF OUTPUT LINE LDA SBUF1 GET IMMEDIATE RAR,RAR MODIFIER AND .3 MICROFIELD BITS JSB FD&MV FIND IMMEDIATE MODIFIER DEF IMM MNEMONIC AND MOVE IT TO DEF OBUFF+10 COLUMNS 21-24 OF OUTPUT LINE LDA SBUF2 GET ALF,ALF STORE ALF,RAR MICROFIELD AND B37 BITS IOR B20K SET STORE TABLE BIT JSB FD&MV FIND STORE MNEMONIC DEF STORE AND MOVE IT TO COLUMNS DEF OBUFF+13 27-30 OF OUTPUT LINE LDA SBUF1 GET LDB SBUF2 IMMEDIATE RRL 6 MICROFIELD AND B377 OPERAND STA SAVE0 SAVE IT LDA .6 INITIALIZE SUBROUTINE LDB PNT03 "XPUT" FOR 6 CHARACTERS ~` JSB XPUTI TO BUFFER "XBUFF" LDA SAVE0 CONVERT OPERAND JSB XOCAS TO ASCII IN OUTPUT LINE JSB MBTS MOVE OPERAND INTO DEF OBUFF+16 COLUMNS 33-35 OF OUTPUT LINE JMP INM07 GO SEE ABOUT OBJECT CODE SKP INM04 EQU * LDA SBUF1 GET LDB SBUF2 CONDITION RRL 1 MICROFIELD AND B37 BITS JSB FD&MV FIND CONDITION MNEMONIC DEF COND AND MOVE IT TO COLUMNS DEF OBUFF+10 21-24 OF OUTPUT LINE LDA SBUF2 GET JUMP RAL,RAL SENSE AND .1 MICROFIELD BITS JSB FD&MV FIND JUMP SENSE MNEMONIC DEF SENSE AND MOVE IT TO COLUMNS DEF OBUFF+13 27-30 OF OUTPUT LINE LDA OBUFF+4 IS THIS CPA "RT" A RTN? JMP INM07 YES.SKIP OPERAND ADDRESS LDA ADDRS NO.DETERMINE MODULO AND M.512 512 ADDRESS 0 LDB A FROM CURRENT WCS ADDRESS LDA SBUF2 GET ALF,ALF CONDITION ALF,RAR OPERAND AND B777 ADDRESS IOR B FORM OPERAND CONTROL STORE ADDRESS INM08 EQU * STA SAVE0 SAVE IT LDA .6 INITIALIZE SUBROUTINE LDB PNT03 "XPUT" FOR 6 CHARACTERS JSB XPUTI TO BUFFER "XBUFF" LDA SAVE0 CONVERT OPERAND JSB XOCAS ADDRESS TO ASCII JSB MBTS MOVE OPERAND INTO DEF OBUFF+16 COLUMNS 33-38 OF OUTPUT LINE JMP INM07 GO SEE ABOUT OBJECT CODE INM05 EQU * LDA SBUF2 GET MODIFIER AND B37 MICROFIELD BITS JSB FD&MV FIND MODIFIER(SPECIAL) MNEMONIC DEF SPEC AND MOVE IT TO COLUMNS DEF OBUFF+7 15-18 OF OUTPUT LINE LDA SBUF1 GET LDB SBUF2 OPERAND RRL 11 ADDRESS AND UP.XE JMP INM08 GO CONVERT IT INTO OUTPUT LINE SKP INM07 EQU * LDA SAVE6 DISPLAY OBJECT CPA D<:6.19 CODE ALSO? JMP INM09 NO.GO OUTPUT LINE LDA .6 YES.INITIALIZE SUBROUTINE LDB PNT03 "XPUT" FOR 6 CHARACTERS JSB XPUTI TO BUFFER "XBUFF" LDA SBUF1 CONVERT 1ST 8 BITS JSB XOCAS OF MICROINSTRUCTION TO ASCII LDA PNT03 SET UP BYTE ADDRESS OF 1ST 3 CHARACTERS RAL OF LAST 3 CHARACTERS ADA .3 OF CONVERSION RESULTS LDB PNT20 SET UP DESTINATION BYTE RBL ADDRESS FOR BYTE MOVE MBT .3 MOVE CHAR'S TO COLUMNS 41-43 OF OUTPUT LDA .6 INITIALIZE SUBROUTINE LDB PNT22 "XPUT" FOR 6 CHARACTERS JSB XPUTI TO COLUMNS 45-50 OF OUTPUT LINE LDA SBUF2 CONVERT 2ND 16 BITS OF JSB XOCAS MICROINSTRUCTION TO ASCII INM09 EQU * JSB M.OUT WRITE OUTPUT DEF OBUFF LINE TO DEF SAVE6 CONSOLE ISZ INMAS RETURN JMP INMAS,I P+2 SKP * I O C H K * * CHECKS ERROR STATUS CONTAINED IN A & B. THIS SUBROUTINE MUST * BE CALLED IMMEDIATELY FOLLOWING A RETURN FROM A "WLOAD" CALL. * <* CLE * CCE * * JSB IOCHK * IOCHK NOP SZA,RSS EVERYTHING GO OK? JMP IOCHK,I YES.DONE CPA .1 INPUT ERROR? JMP IOC01 YES CPA .2 WCS I/O ERROR? JMP IOC02 YES * * NOTE----------EXTERNAL SUBROUTINE "WLOAD" ERRORS 1 * (ILLEGAL WLOAD PARAMETERS) OR 3(ILLEGAL * LU) CANNOT OCCUR IN MDES SINCE THOSE * CONDITIONS ARE CHECKED AND REPORTED IF * INCORRECT WHEN BUILDING THE WCSLT. * CPB .2 MUST BE WLOAD ERROR.LU# OK? JMP IOC03 NO JSB ERROR YES.MUST BE CHECKSUM OR DEF .10 RECORD FORMAT ERROR.MDE ERROR 010 JMP IOCHK,I IOC03 EQU * JSB ERROR ILLEGAL LU# DEF .11 MDE ERROR 011 JMP IOCHK,I IOC02 EQU * LDA B GET EQT WORD 5 STATUS BITS IN A JSB STAT1 CHECK STATUS JMP IOCHK,I IOC01 EQU * SEZ FILE INPUT? JMP IOC04 NO.DEVICE LDA B YES.GET -FMP ERROR CODE IN A JSB FMPER GO REPORT ERROR JMP IOCHK,I SKP IOC04 EQU * LDA B GET INPUT DEVICE ALF,ALF EQUIPMENT TYPE AND B37 IN A-REGISTER SZA,RSS PAPER TAPE READER? JMP IOCHK,I YES.IGNORE IT CPA .1 JMP IOCHK,I YES.IGNORE IT CPA .5 2644 CTU? JMP IOC05 YES CPA B22 MAG TAPE? JMP IOC05 YES CPA B23 JMP IOC05 YES JSB ERROR NO.MDE DEF .7 ERROR 007 JMP IOCHK,I IOC05 EQU * LDA B GET STATUS AND B200 END OF SZA,RSS FILE? JMP IOCHK,I NO.IGNORE OTHER ERROR CONDITIONS LDB DRT POINT TO ADB NUMB DRT ENTRY ADB M1 FOR INPUT LU LDA B,I GET DRT ENTRY  AND B77 GET EQT CAY NUMBER IN Y LDX PNT18 CONVERT EQT# TO ASCII JSB STUFF IN MESSAGE "EM020" JSB ERROR MDE DEF .19 ERROR 019 JMP IOCHK,I SKP * L E A D R/T R A I L * * ISSUES A GENERATE LEADER/TRAILER REQUEST TO THE OUTPUT * LOGICAL UNIT. * * LDA * JSB LEADR/TRAIL * LEADR EQU * TRAIL EQU * OUT NOP IOR B1000 FORM LEADER/TRAILER STA CONWD CONTROL WORD JSB EXEC ISSUE REQUEST.IF DEF OUT01 A PAPER TAPE PUNCH DEF .3 LEADER/TRAILER IS GENERATED DEF CONWD OTHERWISE IT IS IGNORED OUT01 EQU * JMP OUT,I SKP * L O C K * * LOCKS ALL LOGICAL UNITS IN WCSLT. IF ANY LU'S * HAVE BEEN LOCKED PREVIOUSLY BY THE CALLING PROGRAM, * THE LOCK ATTEMPT IS IGNORED. * * JSB LOCK * LOCK NOP CLA INITIALIZE STA SAVE0 LU COUNT LDB PNT01 POINT TO 1ST ENTRY IN WCSLT LOC02 EQU * LDA B,I HAVE A SZA,RSS LU ENTRY? JMP LOC01 NO.END OF ENTRIES CPA M1 REACHED END OF TABLE? JMP LOC01 YES INB NO.BUMP TABLE POINTER ISZ SAVE0 BUMP LU COUNT JMP LOC02 CONTINUE LOC01 EQU * LDA SAVE0 WCSLT SZA,RSS EMPTY? JMP LOCK,I YES.DONE JSB LURQ NO.ATTEMPT DEF LOC03 TO LOCK DEF CW02 LU'S IN THE DEF WCSLT WCSLT DEF SAVE0 LOC03 EQU * SZA,RSS SUCCESSFUL LOCK? JMP LOCK,I YES.DONE SSA NO.ANALYZE JMP LOC04 ERROR JSB ERROR MDE DEF .3 ERROR 003 JMP LOCK,I LOC04 EQU * JSB ERROR MDE DEF .4 ERROR 004 JMP LOCK,I SKP * M . I N * * TAKES INPUT FROM CONSOLE. * * JSB M.IN * DEF * DEF * P+3 <(B)=CHARACTER COUNT> * M.IN NOP LDA M.IN,I GET INPUT ISZ M.IN BUFFER ADDRESS LDB M.IN,I GET INPUT LENGTH ISZ M.IN BUMP RETURN POINTER STA MIADR PUT ADDRESS STB MILTH AND LENGTH INTO EXEC CALL JSB REIO TAKE DEF M.I01 INPUT DEF .1 DEF CW04 MIADR BSS 1 MILTH BSS 1 M.I01 JMP M.IN,I SKP * M . O U T * * WRITES MESSAGE ON CONSOLE. * * JSB M.OUT * DEF * DEF * M.OUT NOP LDA M.OUT,I GET MESSAGE ISZ M.OUT ADDRESS LDB M.OUT,I GET MESSAGE ISZ M.OUT LENGTH STA MOADR PUT IN STB MOLTH EXEC CALL JSB EXEC WRITE DEF M.O01 MESSAGE DEF .2 DEF CW01 MOADR BSS 1 MOLTH BSS 1 M.O01 EQU * JMP M.OUT,I SKP * M B T S * * MOVES BYTES IN BUFFER "XBUFF" TO DESIRED LOCATIONS, * SUPPRESSING LEADING ZEROS. * * * JSB MBTS * DEF * MBTS NOP LDA .6 INITIALIZE "XGET" SUBROUTINES LDB PNT03 FOR 6 CHARACTERS FROM JSB XGETI BUFFER "XBUFF" LDA .6 INITIALIZE "XPUT" SUBROUTINE LDB MBTS,I FOR 6 CHARACTERS TO JSB XPUTI DESTINATION ADDRESS ISZ MBTS BUMP RETURN MBT02 EQU * JSB XGET GET CHARACTER JMP MBT01 CHARACTERS RAN OUT CPA ZERO IS CHARACTER=0? JMP MBT02 YES.SUPPRESS IT MBT03 EQU * JSB XPUT NO.MOVE IT NOP CAN'T OCCUR JSB XGET GET NEXT CHARACTER JMP MBTS,I END OF CHARACTERS.DONE JMP MBT03 CONTINUE MBT01 EQU * LDA ZERO MOVE JSB XPUT A ZERO NOP CAN'T OCCUR JMP MBTS,I SKP * M I C E R * * REPORTS MICROASSEMBLER ERROR IN MDE ERROR 020 AND MOVES * CURRENT MICROFIELD DEFAULT TO BUFFER "PRAM". * * JSB MICER * DEF * DEF * P+3 * * MICER NOP LDA MICER,I GET MICROASSEMBLER ISZ MICER ERROR LDA A,I NUMBER CAY PUT ERROR # IN Y LDX PNT23 CONVER ERROR # TO ASCII JSB STUFF AND STUFF IN MESSAGE "EM020" JSB ERROR MDE DEF .20 ERROR 020 LDB MICER,I GET POINTER TO DEFAULT MNEMONIC ISZ MICER BUMP RETURN LDA B,I MOVE FOUR STA PRAM CHARACTER DEFAULT INB MNEMONIC TO LDA B,I BUFFER "PRAM" STA PRAM+1 ADB .2 POINT TO MX TABLE BIT ENTRY JSB CKTYP 21MX? ADB M1 NO.POINT BACK TO XE TABLE BIT ENTRY LDA B,I GET TABLE BIT PATTERN IN A JMP MICER,I SKP * M I C R O * * MICROASSEMBLES INPUT IN THE INPUT BUFFER. * * USER RESPONSE: / * NN * A * NFIELD2,NFIELD3,NFIELD4,NFIELD5,NFIELD6 * WWW,WWWWWW * * / LEAVES THE CURRENT MICROINSTRUCTION UNCHANGED AND * MOVES TO THE NEXT MICROINSTRUCTION IN RANGE. * * NN IS A DECIMAL NUMBER FROM 1 TO 99 AND IT CAUSES * THE REPLACE POINTER TO MOVE NN POSITIONS. * * A WILL ABORT THE REPLACE. * * NFIELD2,NFIELD3,ETC. ARE THE MNEMONICS OF THE DESIRED * MICROFIELDS TO BE MICROASSEMBLED INTO THE NEW * MICROINSTRUCTION. * * WWW,WWWWWW IS THE NEW MICROINSTRUCTION IN OCTAL. THE * LOW 16 BITS MAY BE DEFAULTED BUT MUST BE ACCOUNTED * FOR WITH A COMMA. * * LDA * JSB MICRO * Ϧ P+1 * P+2 * MICRO NOP STA SAVE6 SAVE LU # JSB READ1 GET CURRENT MICROINSTRUCTION IN BUFFER JMP MICRO,I ERROR OCCURRED.TERMINATE MICROASSEMBLY CLA CLEAR END OF STA FLAG5 PARAMETERS FLAG CCE GET 1ST JSB PICK PARAMETER JMP MDE10 ILLEGAL PARAMETER CPB B100K FILE NAME? JMP MDE10 YES.ILLEGAL CPB M1 NON-NUMERIC? JMP MIC01 YES.GO ANALYZE FURTHER SZB DEFAULT PARAMETER? JMP MIC05 NO SZA YES.END OF PARAMETERS? JMP MIC07 NO.MUST BE REPLACE MIC06 EQU * ISZ MICRO YES.BUMP JMP MICRO,I RETURN SKP MIC05 EQU * SZA NUMERIC PARAMETER.END OF PARAMETERS? JMP MIC02 NO.MUST BE OBJECT CODE REPLACE ISZ FLAG5 YES.SET END OF PARAMETERS FLAG LDA NUMB MUST BE A MOVE POINTER CMA,INA IS ADA .99 NUMBER SSA >99? JMP MDE10 YES.ILLEGAL LDA ADDRS NO.BUMP CURRENT ADA NUMB ADDRESS BY ADA M1 MOVE POINTER STA ADDRS VALUE MINUS 1 CMA,INA IS THE TOTAL ADA ADRS2 >UPPER WCS SSA,RSS ADDRESS? JMP MIC39 NO.RETURN TO ECHO NEXT LINE MIC04 EQU * LDA ADRS2 YES.MAKE STA ADDRS THEM EQUAL JMP MIC39 GO RETURN MIC02 EQU * LDA NUMB CHECK UPPER AND M400 BITS OF MICROINSTRUCTION SZA FOR >256 JMP MDE10 TO BIG.ILLEGAL LDA NUMB OK.MOVE TO STA SBUF1 WRITE BUFFER MIC12 EQU * JSB GT16B GET LOWER 16 BITS OF MICROINSTRUCTION SZB MORE PARAMETERS LEFT? JMP MDE10 YES.ILLEGAL SZA,RSS LOWER 16 SEZ,RSS BITS DEFAULTED? STA SBUF2 NO.MOVE TO WRITE BUFFER ] LDA SAVE6 WRITE NEW JSB WRIT1 MICROINSTRUCTION JMP MICRO,I ERROR OCCURRED.TERMINATE REPLACE JMP MIC03 GOOD RETURN SKP MIC01 EQU * SZA,RSS MORE PARAMETERS LEFT? ISZ FLAG5 NO.SET END OF PARAMETERS FLAG LDA PRAM GET 1ST 2 CHARACTERS CPA "A.S" IS IT ABORT? JMP MIC04 YES ALF,ALF GET 1ST AND B377 CHARACTER RHJ CPA "/" IS IT SLASH? JMP MIC39 YES.JUST GO RETURN & BUMP WCS ADDRESS JSB SRCH GO FIND OPCODE DEF OPCOD BIT PATTERN JSB MICER COULDN'T FIND IT.INVALID DEF .2 MNEMONIC.REPORT MDE DEF OPNOP ERROR 020(MICRO ERROR 2) STA SAVE1 SAVE TABLE BIT PATTERN AND B17 GET BIT PATTERN LDB A REPLACE OLD LDA SBUF1 OPCODE BIT AND B17 PATTERN WITH BLF THE NEW IOR B PATTERN STA SBUF1 LDA SAVE1 RESTORE TABLE BIT PATTERN AND M.1K GET INFORMATION ALF BITS MIC11 EQU * CPA .1 WORD TYPE I? JMP MIC10 YES CPA .2 WORD TYPE II? JMP MIC2 YES CPA .3 WORD TYPE III? JMP MIC15 YES CPA .4 WORD TYPE IV? JMP MIC29 YES LDA PRAM SAVE 1ST 2 CHARACTERS STA SAVE4 OF OPCODE JSB GTNXT GET SPECIAL MNEMONIC JMP MIC13 GOT IT.GO ON LDA SBUF2 DEFAULTED.GET AND B37 SPECIAL BITS JSB FD&MV FIND DEF SPEC SPECIAL DEF PRAM MNEMONIC MIC13 EQU * LDA SAVE4 GET 1ST 2 CHARACTERS OF OPCODE CPA "RT" IS IT RTN? JMP MIC14 YES.TREAT DIFFERENT FROM JSB OR JMP LDA PRAM GET 1ST 2 CHARACTERS OF SPECIAL MNEMONIC CPA "CN" IS IT CNDX? JMP MIC3 YES.WORD TYPE III JMP MIC4 NO.WORD TYPE IV SK FP MIC14 EQU * LDA PRAM GET 1ST 2 CHARACTERS OF SPECIAL MNEMONIC CPA "CN" IS IT CNDX? JMP MIC3 YES.WORD TYPE III MIC1 EQU * JSB ASPEC GO ACCEPT SPECIAL REPLACE JSB GTNXT GET ALU MNEMONIC JMP MIC17 GOT IT.GO ON LDA SBUF1 DEFAULTED.GET LDB SBUF2 ALU RRL 1 MICROFIELD AND B37 BITS JSB FD&MV FIND DEF ALU ALU DEF PRAM MNEMONIC MIC17 EQU * JSB SRCH GO FIND ALU DEF ALU BIT PATTERN JSB MICER COULDN'T FIND IT.INVALID DEF .5 MNEMONIC.REPORT MDE DEF ALNOP ERROR 020(MICRO ERROR 5) AND B37 GET ALU BIT PATTERN STA SAVE0 SAVE IT LDA SBUF1 REPLACE OLD LDB SBUF2 ALU BIT RRL 1 PATTERN WITH AND M40 THE NEW IOR SAVE0 BIT PATTERN RRR 1 STA SBUF1 STB SBUF2 JSB GSTOR GO REPLACE STORE MICROFIELD JSB GTNXT GET S-BUS MNEMONIC JMP MIC16 GOT IT.GO ON LDA SBUF2 DEFAULTED.GET RRR 10 S-BUS AND B37 MICROFIELD BITS IOR B10K SET S-BUS TABLE BIT JSB FD&MV FIND DEF S.BUS S-BUS DEF PRAM MNEMONIC SKP MIC16 EQU * LDA B10K SET S-BUS BIT FOR SEARCH JSB SRCH GO FIND S-BUS PNT19 DEF S.BUS BIT PATTERN JSB MICER COULDN'T FIND IT.INVALID DEF .8 MNEMONIC.REPORT MDE DEF SBNOP ERROR 020(MICRO ERROR 8) AND B37 GET S-BUS BIT PATTERN STA SAVE0 SAVE IT LDA SBUF2 REPLACE OLD RRR 10 S-BUS BIT AND M40 PATTERN WITH IOR SAVE0 THE NEW RRL 10 BIT PATTERN STA SBUF2 LDA FLAG5 ANY MORE SZA,RSS PARAMETERS? JMP MDE10 YES.ILLEGAL MIC03 EQU * LDA SAVE6 WRITE 5NEW JSB WRIT1 MICROINSTRUCTION JMP MDE03 ERROR OCCURRED.TERMINATE MICROASSEMBLY JMP MIC06 GO BUMP & RETURN SKP MIC2 EQU * JSB GTNXT GET SPECIAL MNEMONIC JMP MIC19 GOT IT.GO ON LDA SBUF2 DEFAULTED.GET AND B37 SPECIAL BITS JSB FD&MV FIND DEF SPEC SPECIAL DEF PRAM MNEMONIC MIC19 EQU * JSB ASPEC GO ACCEPT SPECIAL REPLACE JSB GTNXT GET MODIFIER MNEMONIC JMP MIC21 GOT IT.GO ON LDA SBUF1 DEFAULTED.GET RAR,RAR IMMEDIATE AND .3 MODIFIER BITS JSB FD&MV FIND DEF IMM MODIFIER DEF PRAM MNEMONIC MIC21 EQU * JSB SRCH FIND IMMEDIATE DEF IMM MODIFIER BIT PATTERN JSB MICER COULDN'T FIND IT.INVALID DEF .6 MNEMONIC.REPORT MDE DEF IMNOP ERROR 020(MICRO ERROR 6) AND .3 REPLACE OLD LDB A MODIFIER BIT LDA SBUF1 PATTERN WITH RAR,RAR THE NEW AND M4 BIT PATTERN IOR B RAL,RAL STA SBUF1 JSB GSTOR GO REPLACE STORE MICROFIELD LDA FLAG5 DEFAULT THE SZA IMMEDIATE OPERAND JMP MIC03 YES.DONE JSB GTOPR GET THE OPERAND JMP MIC25 NON-NUMERIC.ERROR JMP MIC03 DEFAULTED.DONE AND M400 OPERAND SZA,RSS > 377B? JMP MIC23 NO.OK.GO ON SKP MIC25 EQU * JSB MICER MDE ERROR DEF .11 020(MICRO DEF OPNOP ERROR 11) CLA MAKE OPERAND STA NUMB = ZERO MIC23 EQU * LDA SBUF1 REPLACE OLD LDB SBUF2 OPERAND RRL 6 WITH THE AND M400 NEW IOR NUMB OPERAND RRR 6 STA SBUF1 STB SBUF2 JMP MIC03 SKP MIC15 EQU * JSB GTNXT GET SPECIAL MNEMONIC JMP MIC3 GOT IT.GO ON LDA SBUF2 DEFAULTED.GET AND B37 SPECIAL BITS JSB FD&MV FIND DEF SPEC SPECIAL DEF PRAM MNEMONIC MIC3 EQU * JSB SRCH FIND SPECIAL DEF SPEC BIT PATTERN JSB MICER COULDN'T FIND IT.INVALID DEF .3 MNEMONIC.REPORT MDE PNT25 DEF SPNOP ERROR 020(MICRO ERROR 3) AND B37 REPLACE OLD LDB A SPECIAL BIT LDA SBUF2 PATTERN WITH AND M40 THE NEW IOR B BIT PATTERN STA SBUF2 JSB GTNXT GET CONDITION MNEMONIC JMP MIC20 GOT IT.GO ON LDA SBUF1 GET LDB SBUF2 CONDITION RRL 1 BITS AND B37 JSB FD&MV FIND DEF COND CONDITION DEF PRAM MNEMONIC MIC20 EQU * LDB PNT24 GET POINTER TO NOP JSB CKTYP 21MX? ADB .4 NO.POINT TO ALZ INSTEAD STB MIC22 SET UP CORRECT NOP FOR CONDITION JSB SRCH FIND CONDITION DEF COND BIT PATTERN JSB MICER COULDN'T FIND IT.INVALID DEF .4 MNEMNONIC.REPORT MDE MIC22 BSS 1 ERROR 020(MICRO ERROR 4) STA SAVE0 SAVE BIT PATTERN LDA SBUF1 REPLACE OLD LDB SBUF2 CONDITION BIT RRL 1 PATTERN WITH AND M40 THE NEW IOR SAVE0 BIT PATTERN RRR 1 STA SBUF1 STB SBUF2 JSB GTNXT GET JUMP SENSE MNEMONIC JMP MIC24 GOT IT.GO ON LDA SBUF2 DEFAULTED.GET RAL,RAL SENSE AND .1 BIT JSB FD&MV FIND DEF SENSE SENSE DEF PRAM MNEMONIC SKP MIC24 EQU * JSB SRCH FIND SENSE DEF SENSE BIT PATTERN JSB MICER COULDN'T FIND IT.INVALID DEF .9 MNEMONIC.REPORT MDE DEF SENOP ERROR 020(MICRO ERROR 9) ?<:66< AND .1 REPLACE OLD LDB A SENSE BIT LDA SBUF2 PATTERN WITH RAL,RAL THE NEW AND M2 BIT PATTERN IOR B RAR,RAR STA SBUF2 JSB GTOPR GET THE OPERAND JMP MIC26 NON-NUMERIC.ERROR JMP MIC03 DEFAULTED.DONE AND M.512 OPERAND BASE LDB A ADDRESS AND LDA ADDRS CURRENT BASE AND M.512 ADDRESS CPA B EQUAL? JMP MIC27 YES.OK.GO ON JSB MICER NO.MDE DEF .23 ERROR 020 DEF OPNOP (MICRO ERROR 23) MIC28 EQU * CLA MAKE STA NUMB OPERAND=0 MIC27 EQU * LDA NUMB GET MODULO AND B777 512 ADDRESS STA NUMB IN LOCATION "NUMB" LDA SBUF2 REPLACE OLD RRR 5 OPERAND AND M.512 WITH NEW IOR NUMB OPERAND RRL 5 STA SBUF2 JMP MIC03 SKP MIC26 EQU * JSB MICER MDE ERROR DEF .19 020(MICRO DEF OPNOP ERROR 19 JMP MIC28 MIC29 EQU * LDB PNT25 GET POINTER TO SPECIAL NOP JSB CKTYP 21MX? RSS NO.XE.LEAVE POINTER ADB B204 YES.POINT TO UNCD STB MIC31 SET UP POINTERS STB MIC32 IN CASE OF ERRORS JSB GTNXT GET SPECIAL JUMP MODIFIER MNEMONIC JMP MIC4 GOT IT.GO ON LDA SBUF2 DEFAULTED.GET AND B37 SPECIAL JUMP MODIFIER BITS JSB FD&MV FIND DEF SPEC JUMP MODIFIER DEF PRAM MNEMONIC MIC4 EQU * LDB PNT25 GET POINTER TO SPECIAL NOP JSB CKTYP 21MX? RSS NO.XE.LEAVE POINTER ADB B204 YES.POINT TO UNCD STB MIC31 SET POINTERS IN STB MIC32 CASE OF ERROR JSB SRCH FIND JUMP MODIFIER DEF SPEC BIT PATTERN JSB MICER COULDN'T FIND IT.INVALID DEF .3 MNEMONIC.REPORT MDE MIC31 BSS 1 ERROR 020(MICRO ERROR 3) STA SAVE1 SAVE TABLE BIT PATTERN AND M.1K GET INFORMATION ALF BITS RHJ AND .2 OK FOR SZA WORD TYPE IV? JMP MIC30 YES.GO ON JSB MICER NO.MDE ERROR DEF .17 020(MICRO MIC32 BSS 1 ERROR 17) STA SAVE1 SAVE TABLE BIT PATTERN SKP MIC30 EQU * LDA SAVE1 REPLACE OLD AND B37 SPECIAL BIT LDB A PATTERN WITH LDA SBUF2 THE NEW AND M40 BIT PATTERN IOR B STA SBUF2 JSB GTNXT ANYTHING IN FIELD 4? JMP MIC18 YES.ERROR FOR WORD TYPE IV MIC38 EQU * JSB GTNXT ANYTHING IN FIELD 5? JMP MIC36 YES.ERROR FOR WORD TYPE IV MIC37 EQU * JSB GTOPR GET OPERAND ADDRESS JMP MIC35 NON-NUMERIC.ERROR JMP MIC03 DEFAULTED.DONE LDB B10K INITIALLY CMB,INB ASSUME A 21MX JSB CKTYP 21MX? LDB M40K NO.XE LDA NUMB GET OPERAND ADDRESS AND B OPERAND ADDRESS SZA,RSS >UPPER CONTROL MEMORY ADDRESS? JMP MIC34 NO.OK.GO ON JSB MICER YES.MDE ERROR DEF .26 020(MICRO DEF OPNOP ERROR 26) MIC33 EQU * CLA MAKE STA NUMB OPERAND=0 MIC34 EQU * LDA SBUF1 REPLACE OLD LDB SBUF2 OPERAND RRL 11 WITH NEW AND B100K OPERAND IOR NUMB RRR 11 STA SBUF1 STB SBUF2 JMP MIC03 MIC35 EQU * JSB MICER MDE ERROR DEF .19 020(MICRO DEF OPNOP ERROR 19) JMP MIC33 SKP MIC07 EQU * LDA SBUF1 GET ALF,ALF MICROINSTRUCTION ALF OPCODE AND B17 BITS JSB FD&MV FIND WORD TYPE DEF OPCOD THRU A DUMMY CALL, DEF PRAM TO SUBROUTINE "FD&MV" STA SAVE5 SAVE INFORMATION BITS JSB SVSUB SAVE STATE OF "XGET" SUBROUTINES JSB XGETN GET NEXT NON-BLANK CHARACTER JMP MIC03 END OF PARAMETERS.NO CHANGE CAY SAVE CHARACTER JSB RSSUB RESTORE STATE OF "XGET" SUBROUTINES CYA IS THE NEX NON-BLANK JSB CKNUM CHARACTER A NUMBER? JMP MIC12 YES.OBJECT CODE REPLACE LDA SAVE5 NO.RESTORE WORD TYPE INFORMATION JMP MIC11 GO DO SYMBOLIC REPLACE MIC10 EQU * JSB GTCHR GET NEXT NON-NUMERIC PARAMETER SZB,RSS MORE PARAMETERS LEFT? ISZ FLAG5 NO.SET END OF PARAMETERS FLAG SZA DEFAULT PARAMETER? JMP MIC1 NO.GO ON TO WORD TYPE I LDA SBUF2 YES.GET CURRENT SPECIAL AND B37 OBJECT CODE BITS JSB FD&MV FIND DEF SPEC SPECIAL DEF PRAM MNEMONIC JMP MIC1 GO ON TO WORD TYPE I MIC18 EQU * JSB MICER MDE ERROR DEF .25 020(MICRO DEF ALNOP ERROR 25) JMP MIC38 MIC36 EQU * JSB MICER MDE ERROR DEF .25 020(MICRO DEF STNOP ERROR 25) JMP MIC37 MIC39 EQU * ISZ MICRO BUMP RETURN JMP MIC06 SKP * M V V A L * * GETS VALUE OF CURRENT PARAMETER POSITION AND MOVES IT * TO VALUES IN MESSAGE "PMSG". * * * JSB MVVAL * P+1 * P+2 * MVVAL NOP LDB MVVAL,I GET LINK TO PARAMETERS TABLE ISZ MVVAL BUMP RETURN ADB SAVE6 INDEX IT BY CURRENT POSITION LDA B,I GET ENTRY LDB MVVAL,I GET LINK TO LOCATION "MACRO" ISZ MVVAL BUMP RETURN SZA,RSS NUMBER? JMP MVV01 YES SLA RETURN? JMP MVV02 YES G CMB,INB NO.MUST BE DEF.SAVE STB SAVE0 -MACRO ADDRESS CMB,INB GET ADB SAVE6 CURRENT LDA B,I PARAMETER ADA SAVE0 SUBTRACT MACRO ADDRESS INA ALLOW FOR OFFSET CAY CONVERT POSITION LDX PNT28 DEF TO ASCII JSB STUFF IN MESSAGE "PMSG" LDB PNT27 MOVE LDA "DE" DEF P+ STA B,I TO PARAMETER INB VALUE IN LDA "F.S" MESSAGE "PMSG" STA B,I INB LDA PMSG STA B,I JMP MVVAL,I SKP MVV01 EQU * ADB SAVE6 GET CURRENT LDA B,I PARAMETER STA SAVE0 SAVE IT LDA .6 INITIALIZE SUBROUTINE LDB PNT03 "XPUT" FOR 6 CHARACTERS JSB XPUTI TO BUFFER "XBUFF" LDA SAVE0 CONVERT NUMBER JSB XOCAS TO ASCII JSB MBTS MOVE TO PARAMETER DEF PNUM VALUE IN MESSAGE "PMSG" JMP MVVAL,I MVV02 EQU * LDA PNT29 MOVE RETURN TO LDB PNT27 PARAMETER VALUE MVW .3 IN MESSAGE "PMSG" JMP MVVAL,I SKP * N O P * * DELETES THE MICROINSTRUCTION AT THE CURRENT WCS ADDRESS BY * REPLACING IT WITH A MICRO-NOP. * * LDA * JSB NOP * P+1 * NOP NOP CAY SAVE LU # JSB CKTYP 21MX? JMP NOP01 NO.XE LDA B17 SET UP MX LDB MASK3 MICRO-NOP JMP NOP02 NOP01 EQU * LDA B10 SET UP XE LDB MASK4 MICRO-NOP NOP02 EQU * STA SBUF1 MOVE MICRO-NOP STB SBUF2 TO WRITE BUFFER CYA GET LU # JSB WRIT1 WRITE IT JMP NOP,I ERROR OCCURRED ISZ NOP RETURN JMP NOP,I P+2 SKP * O P R N D * * INSTALLS NEW OPERAND IN THE WORD TYPE IV MICROINSTRUCTION * c INDICATED. * * LDA * LDB * JSB OPRND * P+1 * P+2 * P+3 * OPRND NOP STB SAVE1 SAVE MASK LDB OPRND,I GET LDB B,I DESIRED STB ADDRS ADDRESS ISZ OPRND BUMP RETURN LDB OPRND,I GET LDB B,I NEW OPERAND STB SAVE0 VALUE ISZ OPRND BUMP RETURN JSB READ1 READ MICROINSTRUCTION JMP OPR01 ERROR OCCURRED LDA SBUF1 GET LDB SBUF2 CURRENT RRL 11 MICROINSTRUCTION AND SAVE1 MASK OUT OLD OPERAND IOR SAVE0 PUT RRR 11 IN STA SBUF1 NEW STB SBUF2 VALUE LDA CONWD REWRITE JSB WRIT1 MICROINSTRUCTION JMP OPRND,I ERROR OCCURRED OPR01 EQU * ISZ OPRND BUMP RETURN JMP OPRND,I SKP * P I C K * * PICKS UP CURRENT PARAMETER IN INPUT ASCII STRING,STRIPS OFF * BLANKS ON EITHER SIDE OF PARAMETER AND MOVES THE PARAMETER TO * BUFFER "PRAM" FOR NON-NUMERIC INPUT OR CONVERTS IT AND STORES * ITS VALUE IN LOCATION "NUMB" FOR NUMERIC INPUT. REQUIRES THAT * SUBROUTINES "XGET" AND "XGETN" BE INITIALIZED TO THE INPUT * ASCII STRING. * * * CLE * CCE * JSB PICK * P+1 * P+2 <(A)=0 END OF BUFFER OR =-1 MORE PARAMETERS LEFT> * <(B)=0 PARAMETER DEFAULTED > * < =1 NUMERIC PARAMETER,VALUE IN LOCATION "NUMB" > * < =-1 NON-NUMERIC PARAMETER. PARAMETER ASCII STRING > * < IN BUFFER "PRAM". STATE OF SUBROUTINE "XPUT" > * < INDICATES NUMBER OF CHARACTERS > S * < =100000 PARAMETER IS A FILE NAME IN BUFFER "PRAM" > * < WITH SUBPARAMETERS IN LOCATIONS "SECOD" > * < (SECURITY CODE) AND "CRLBL" (CARTRIDGE > * < LABEL) > * PICK NOP SEZ COMMAND INPUT? JMP PIC01 NO.GO GET 1ST PARAMETER LDA XSCNT HAVE A PARAMETER FROM THIS SZA COMMAND INPUT YET? JMP PIC01 YES.GO ON TO CURRENT PARAMETER PIC02 EQU * JSB XGETN GET NEXT NON-BLANK CHARACTER JMP PIC03 PARAMETER DEFAULTED CPA COMMA GONE PAST COMMAND CHARACTERS YET? JMP PIC01 YES.GO TO 1ST PARAMETER JMP PIC02 NO.CONTINUE PIC03 EQU * CLA END OF PARAMETERS PIC04 EQU * CLB PARAMETER DEFAULTED PIC13 EQU * ISZ PICK RETURN P+2 JMP PICK,I SKP PIC01 EQU * JSB XGETN GET NEXT NON-BLANK CHARACTER JMP PIC03 PARAMETER DEFAULTED CPA COMMA IS IT A COMMA? CCA,RSS YES.MORE PARAMETERS LEFT RSS NO JMP PIC04 CAX SAVE CHARACTER IN X CPA PLUS IS CURRENT CHARACTER A PLUS? JMP PIC05 YES.GO CLEAR SIGN FLAG CPA MINUS NO.IS IT A MINUS? JMP PIC06 YES.GO SET SIGN FLAG JSB CKNUM IS IT NUMERIC? JMP PIC07 YES LDA .6 NO.INITIALIZE SUBROUTINE LDB PNT10 "XPUT" FOR 6 CHARACTERS JSB XPUTI TO BUFFER "PRAM" PIC42 EQU * LDA BLANK INITIALIZE JSB XPUT BUFFER "PRAM" RSS WITH BLANKS JMP PIC42 CLA INITIALIZE SUBPARAMETERS STA SECOD TO THEIR DEFAULT STA CRLBL VALUES OF ZERO JSB CKSUB SUBPARAMETERS PRESENT? JMP PIC08 YES.GO GET FILE NAME & SUBPARAMETERS JMP PIC09 NO.GO GET NON-NUMERIC PARAMETER PIC06 EQU * CCA,RSS NEGATIVE(5 NUMBER PIC05 EQU * CLA POSITIVE NUMBER CAY SAVE SIGN FLAG IN Y JSB XGET GET NEXT CHARACTER JMP PICK,I END OF PARAMETERS CAX GET 1ST CHARACTER IN A JMP PIC10 PIC07 EQU * CLA ASSUME A CAY POSITIVE NUMBER PIC10 EQU * LDA PNT06 RESULTS OF CONVERSION IN LOCATION "NUMB" JSB CNVRT DO CONVERSION CPA .1 ERROR OCCUR? JMP PICK,I YES CPA .2 ILLEGAL PARAMETER? JMP PICK,I YES SZB DID PARAMETERS END? JMP PIC11 YES CCA MORE PARAMETERS LEFT PIC12 EQU * LDB .1 NUMERIC PARAMETER JMP PIC13 PIC11 EQU * CLA NO MORE PARAMETERS JMP PIC12 SKP PIC09 EQU * LDA .6 INITIALIZE SUBROUTINE "XPUT" LDB PNT10 FOR A MAXIMUM OF 6 CHARACTERS JSB XPUTI TO BE PUT IN BUFFER "PRAM" CXA GET CURRENT CHARACTER IN A PIC14 EQU * JSB XPUT MOVE CHARACTER TO BUFFER "PRAM" JMP PIC15 END OF BUFFER CPA COMMA IS CURRENT CHARACTER A COMMA? JMP PIC16 YES JSB XGETN GET NEXT NON-BLANK CHARACTER CLA,RSS END OF PARAMETERS JMP PIC14 CONTINUE GETTING PARAMETERS PIC17 EQU * CCB NON-NUMERIC PARAMETER JMP PIC13 PIC15 EQU * CPA COMMA IS NEXT NON-BLANK CHARACTER A COMMA? JMP PIC18 YES JMP PICK,I NO.ERROR PIC16 EQU * JSB FIXIT MOVE BLANK OVER DELIMITING CHARACTER PIC18 EQU * CCA MORE PARAMETERS LEFT JMP PIC17 SKP PIC08 EQU * LDA .6 INITIALIZE SUBROUTINE "XPUT" LDB PNT10 FOR A MAXIMUM OF 6 CHARACTERS JSB XPUTI TO BE PUT IN BUFFER "PRAM" CXA GET CURRENT CHARACTER IN A PIC19 EQU * JSB XPUT MOVE CHARACTER TO BUFFER "PRAM" JMP PIC20 END OF BUFLFER CPA COLON IS CURRENT CHARACTER A COLON? JMP PIC21 YES.DONE WITH FILE NAME JSB XGETN NO.GET NEXT NON-BLANK CHARACTER NOP SHOULDN'T HAPPEN JMP PIC19 CONTINUE GETTING FILE NAME PIC20 EQU * ISZ XDCNT BUMP COUNT FOR DECREMENT CPA COLON CURRENT CHARACTER A COLON? RSS YES JMP PICK,I NO.ERROR PIC21 EQU * JSB FIXIT MOVE BLANK OVER DELIMITING CHARACTER LDA XDLNG SAVE STATE OF STA SAVE5 SUBROUTINE "XPUT" LDA XDCNT AFTER GETTING ADA M1 FILE NAME STA SAVE6 STA XDCNT SET COUNT BACK ONE JSB XGETN GET NEXT NON-BLANK CHARACTER JMP PIC22 END OF PARAMETERS CPA COMMA IS CHARACTER A COMMA? JMP PIC23 YES.DEFAULT SUBPARAMETERS CPA COLON IS CHARACTER A COLON? JMP PIC24 YES.DEFAULT SECURITY CODE CPA PLUS IS CHARACTER A PLUS SIGN? JMP PIC25 YES CPA MINUS IS CHARACTER A MINUS SIGN? JMP PIC26 YES JSB CKNUM IS CHARACTER NUMERIC? JMP PIC27 YES ALF,ALF NO.MOVE CHARACTER TO UPPER STA SECOD BYTE OF LOCATION "SECOD" JSB XGET GET NEXT CHARACTER JMP PIC28 END OF PARAMETERS CPA COMMA IS CHARACTER A COMMA? JMP PIC29 YES CPA COLON IS CHARACTER A COLON? JMP PIC30 YES IOR SECOD NO.FORM THE STA SECOD SECURITY CODE SKP PIC31 EQU * JSB XGETN GET NEXT NON-BLANK CHARACTER JMP PIC32 END OF PARAMETERS CPA COMMA IS CHARACTER A COMMA? JMP PIC36 YES CPA COLON IS CHARACTER A COLON? JMP PIC34 YES JMP PIC31 NO.DEFAULT ADDITIONAL CHARACTERS PIC22 EQU * CLA DEFAULT SECURITY STA SECOD CODE AND CARTRIDGE STA CRLBL LABEL SUBPARAMETERS PIC39 EQU * CLA n NO MORE PARAMETERS PIC35 EQU * LDB B100K SUBPARAMETERS PRESENT JMP PIC13 PIC23 EQU * CLA DEFAULT SECURITY STA SECOD CODE AND CARTRIDGE STA CRLBL LABEL SUBPARAMETERS JMP PIC36 PIC24 EQU * CLA DEFAULT SECURITY STA SECOD CODE SUBPARAMETER JMP PIC34 PIC25 EQU * CLA,RSS CLEAR SIGN FLAG(+) PIC26 EQU * CCA SET SIGN FLAG(-) CAY SET UP SIGN FOR SUBROUTINE "CNVRT" JSB XGETN GET NEXT NON-BLANK CHARACTER JMP PICK,I END OF PARAMETER.ERROR PIC37 EQU * CAX DO CONVERSION LDA PNT11 TO LOCATION JSB CNVRT "SECOD" CPA .2 PICK UP A NON-NUMERIC CHARACTER? JMP PIC38 YES.GO USE 1ST 2 CHARACTERS CPA .1 ERROR OCCUR DURING CONVERSION? JMP PICK,I YES CPA .3 SUBPARAMETERS LEFT? JMP PIC34 YES.GO ON TO CARTRIDGE LABEL LDA SAVE5 RESTORE STATE STA XDLNG OF SUBROUTINE LDA SAVE6 "XPUT" TO INDICATE STA XDCNT # OF CHARACTERS PIC33 EQU * SZB PARAMETERS END DURING CONVERSION? JMP PIC39 YES JMP PIC36 NO.GO ON TO CARTRIDGE LABEL SKP PIC27 EQU * CLB CLEAR SIGN FLAG(+) CBY SET UP SIGN FOR SUBROUTINE "CNVRT" JMP PIC37 PIC28 EQU * LDA BLANK USE A BLANK IOR SECOD TO FORM LOWER STA SECOD BYTE OF SECURITY CODE PIC32 EQU * CLA DEFAULT STA CRLBL CARTRIDGE LABEL JMP PIC39 PIC29 EQU * LDA BLANK USE A BLANK IOR SECOD TO FORM LOWER STA SECOD BYTE OF SECURITY CODE PIC36 EQU * CLA DEFAULT STA CRLBL CARTRIDGE LABEL PIC41 EQU * CCA MORE JMP PIC35 PARAMETERS LEFT PIC30 EQU * LDA BLANK USE A BLANK TO IOR SECOD <:6 FORM LOWER BYTE STA SECOD OF SECURITY CODE JMP PIC34 GO ON TO CARTRIDGE LABEL PIC38 EQU * LDA XBUF1 USE 1ST 2 CHARACTERS STA SECOD AS THE SECURITY CODE JMP PIC33 PIC34 EQU * JSB XGETN GET NEXT NON-BLANK CHARACTER JMP PIC32 END OF PARAMETERS CPA COMMA IS CHARACTER A COMMA? JMP PIC36 YES CPA COLON IS CHARACTER A COLON? JMP PICK,I YES.ERROR CPA PLUS IS CHARACTER A PLUS SIGN? JMP PIC43 YES CPA MINUS IS CHARACTER A MINUS SIGN? JMP PIC44 YES JSB CKNUM IS CHARACTER NUMERIC? JMP PIC45 YES ALF,ALF NO.MOVE TO UPPER BYTE STA CRLBL OF LOCATION "CRLBL" JSB XGET GET NEXT CHARACTER JMP PIC46 END OF PARAMETERS CPA COMMA IS CHARACTER A COMMA? JMP PIC47 YES CPA COLON IS CHARCTER A COLON? JMP PICK,I YES.ERROR IOR CRLBL FORM CARTRIDGE STA CRLBL LABEL SUBPARAMETER SKP PIC48 EQU * JSB XGETN GET NEXT NON-BLANK CHARACTER JMP PIC39 END OF PARAMETERS CPA COMMA IS CHARACTER A COMMA? JMP PIC41 YES < CPA COLON IS CHARACTER A COLON? JMP PICK,I YES.ERROR JMP PIC48 NO.CONTINUE GETTING CHARACTERS PIC43 EQU * CLA,RSS CLEAR SIGN FLAG(+) PIC44 EQU * CCA SET SIGN FLAG(-) CAY SET UP SIGN FOR SUBROUTINE "CNVRT" JSB XGETN GET NEXT NON-BLANK CHARACTER JMP PICK,I END OF PARAMETER.ERROR PIC50 EQU * CAX DO CONVERSION LDA PNT12 TO LOCATION JSB CNVRT "CRLBL" CPA .2 PICK UP A NON-NUMERIC CHARACTER? JMP PIC49 YES CPA .1 ERROR OCCUR DURING CONVERSION? JMP PICK,I YES CPA .3 SUBPARAMETERS LEFT? JMP PICK,I YES.ILLEGAL LDA SAVE5 RESTORE STATE STA XDLNG OF SUBROUTINE LDA SAVE6 "XPUT" TO INDICATE STA XDCNT # OF CHARACTERS PIC40 EQU * SZB PARAMETERS END DURING CONVERSION JMP PIC39 YES JMP PIC41 NO PIC45 EQU * CLB CLEAR SIGN FLAG(+) CBY SET UP SIGN FOR SUBROUTINE "CNVRT" JMP PIC50 PIC46 EQU * LDA BLANK USE A BLANK TO IOR CRLBL FORM LOWER BYTE STA CRLBL OF CARTRIDGE LABEL JMP PIC39 PIC47 EQU * LDA BLANK USE A BLANK TO IOR CRLBL FORM LOWER BYTE STA CRLBL OF CARTRIDGE LABEL JMP PIC41 PIC49 EQU * LDA XBUF1 USE 1ST 2 CHARACTERS STA CRLBL AS THE CARTRIDGE LABEL JMP PIC40 SKP * R A N G E * * PICKS UP RANGE OF MICROINSTRUCTIONS DEFINED BY 1ST TWO * PARAMETERS OF CURRENT COMMAND INPUT. * * <"XGET" SUBROUTINES POINT TO 1ST PARAMETER(LOWER LIMIT)> * JSB RANGE * * * * RANGE NOP CCA SET END OF STA FLAG4 PARAMETERS FLAG k CLE COMMAND INPUT JSB GTNUM GET LOWER STA ADRS1 WCS ADDRESS SZA,RSS DEFAULT FIRST PARAMETER? JMP MDE10 YES.ILLEGAL SZB,RSS DEFAULT THE REMAINING PARAMETERS? JMP RAN01 YES JSB GTNUM NO.GET THE STA ADRS2 UPPER WCS ADDRESS SZB DEFAULT THE REMAINING PARAMETER? ISZ FLAG4 NO.CLEAR END OF PARAMETERS FLAG NOP ALLOW FOR SKIP LDB ADRS1 GET LOWER WCS ADDRESS SZA DEFAULT UPPER WCS ADDRESS? JMP RAN02 NO.GO ON SZB YES.DEFAULT LOWER WCS ADDRESS? JMP RAN04 NO.GO SAVE AS UPPER WCS ADDRESS LDB .3583 YES.SET UPPER LIMIT JSB CKTYP TO THE COMPUTER'S LDB UP.XE UPPER LIMIT RAN04 EQU * STB ADRS2 SAVE UPPER WCS ADDRESS RAN02 EQU * LDA ADRS2 CHECK UPPER JSB CKADR WCS ADDRESS LDA ADRS1 CHECK LOWER WCS STA ADDRS ADDRESS AND INITIALIZE JSB CKADR CURRENT WCS ADDRESS LDA ADRS1 IS THE LOWER CMA,INA WCS ADDRESS ADA ADRS2 >THE UPPER SSA WCS ADDRESS? JMP MDE10 YES.ILLEGAL LDA FLAG4 GET END OF PARAMETERS FLAG JMP RANGE,I RAN01 EQU * LDB ADRS1 SET UPPER LIMIT=LOWER LIMIT JMP RAN04 SKP * R E A D 1 * * READS THE CURRENT WCS ADDRESS. * * * LDA * JSB READ1 * P+1 * P+2 * * READ1 NOP STA CONWD FORM CONTROL WORD FOR READ JSB EXEC READ DEF REA01 THE DEF .1 CURRENT DEF CONWD WCS DEF SBUFF ADDRESS DEF .2 DEF (ADDRS REA01 EQU * SLA,RSS ERROR OCCUR? ISZ READ1 NO.RETURN P+2 JSB STAT1 YES.GO ANALYZE ERROR JMP READ1,I SKP * R S S U B * * RESTORES STATE OF SUBROUTINES "XGET" & "XGETN". * * * * JSB RSSUB * RSSUB NOP LDA SAVE2 STA XSLNG LDA SAVE3 STA XSCNT LDA SAVE4 STA XSADR JMP RSSUB,I SKP * S C A N * * SCANS INPUT ASCII STRING FOR CORRECT SYNTAX AND RETURNS * FIRST 2 NON-BLANK CHARACTERS IN A. * * CLE * LDB * JSB SCAN * P+1 * P+2 <(A)=1ST 2 NON-BLANK CHARACTERS OR 0> * SCAN NOP STB SAVE2 SAVE CHARACTER COUNT CLA,INA SET UP CLB FLAG VALUES SEZ COMMAND INPUT? STB A YES STA FLAG1 FLAG1=1 COMMAND,FLAG1=0 NON-COMMAND STB SAVE0 INITIALIZE UPPER OR LOWER BYTE COUNTER LDA PNT04 INITIALIZE CHARACTER STA SAVE1 WORD POINTER SCA01 EQU * JSB CHAR GET CURRENT CHARACTER XOR BLANK IS IT SZA A BLANK? JMP SCA02 NO JSB BUMP YES.BUMP CHARACTER POINTER & COUNT JMP SCAN,I ERROR JMP SCA01 CONTINUE AND IGNORE BLANKS SCA02 EQU * LDA SAVE0 GET CHARACTER COUNT CPA SAVE2 DONE? JMP SCA03 YES.CHECK IF 1 CHARACTER IS OK JSB CHAR GET CURRENT CHARACTER CPA COMMA IS IT A COMMA? JMP SCA04 YES.CHECK IF DEFAULT 1ST PARAMETER IS OK ALF,ALF NO.SAVE CURRENT CAX CHARACTER LHJ LDA SAVE0 IS THE CURRENT LDB SAVE1 CHARACTER IN THE SLA LOW BYTE(BITS 0-7)? INB YES.NEED TO POINT TO NEXT WORD LDB B,I (?GET CORRECT WORD IN B SLA CURRENT CHARACTER IN LOW BYTE? BLF,BLF YES.HAVE UPPER BYTE OF NEXT WORD-ROTATE STB A GET NEXT AND B377 CHARACTER RHJ IN A CXB FORM 1ST 2 IOR B CHARACTERS IN A SCA05 EQU * STA SAVE3 SAVE A 1ST 2 CHARACTERS WORD SKP SCA08 EQU * JSB BUMP BUMP CHARACTER POINTER & COUNT JMP SCA06 DONE JSB CHAR GET CURRENT CHARACTER CPA BLANK IS IT A BLANK? JMP SCA08 YES.IGNORE BLANKS CPA COMMA NO.IS IT A COMMA? JMP SCA08 YES.DEFAULTED PARAMETER.CONTINUE CPA COLON IS IT A COLON? JMP SCA08 YES.DEFAULTED PARAMETER.CONTINUE SCA07 EQU * JSB BUMP HAVE A PARAMETER CHARACTER.BUMP JMP SCA06 DONE JSB CHAR GET CURRENT CHARACTER CPA BLANK IS IT A BLANK? JMP SCA09 YES.CHECK FOR ANOTHER CHAR. BEFORE END CPA COMMA NO.IS IT A COMMA? JMP SCA08 YES.GO ON TO NEXT PARAMETER CPA COLON IS IT A COLON? JMP SCA08 YES.GO ON TO NEXT PARAMETER JMP SCA07 NO.CONTINUE IN THIS PARAMETER SCA09 EQU * JSB BUMP BUMP CHARACTER POINTER & COUNT JMP SCA06 DONE JSB CHAR GET CURRENT CHARACTER CPA BLANK IS IT A BLANK? JMP SCA09 YES.IGNORE BLANKS UNTIL END OF PARAMETER CPA COMMA NO.IS IT A COMMA? JMP SCA08 YES.OK.GO ON TO NEXT PARAMETER CPA COLON IS IT A COLON? JMP SCA08 YES.GO ON TO NEXT PARAMETER JMP SCAN,I NO.ERROR SCA03 EQU * LDA FLAG1 IS THIS A SLA COMMAND INPUT? JMP SCAN,I YES.ERROR JSB CHAR NO.GET CURRENT CHARACTER CPA COMMA IS IT A COMMA? CLA YES.MAKE CHARACTER=0 STA SAVE3 SAVE AS 1ST 2 CHARACTERS WORD SCA06 EQU * LDA SAVE3 A=1ST 2 NON-BLANK CHARACTERS IN INPUT ISZ SCAN mRETURN JMP SCAN,I P+2 SCA04 EQU * LDA FLAG1 IS THIS A SLA COMMAND INPUT? JMP SCAN,I YES.ERROR CLA NO.MAKE CHARACTER=0 JMP SCA05 GO SAVE AS 1ST 2 CHARACTERS WORD SKP * S R C H * * SEARCHES THE APPLICABLE MNEMONIC TABLE FOR THE * CURRENT FIELD MICROINSTRUCTION. * * * LDA * JSB SRCH * DEF * P+2 * P+3 * P+4 * P+5 * SRCH NOP LDB SRCH,I GET TABLE POINTER CPB PNT19 IS IT STORE OR S-BUS? RSS YES CLA NO.CLEAR TABLE MASK CAY SAVE TABLE MASK IN Y LDB .3 ASSUME 21MX INITIALLY JSB CKTYP 21MX? LDB .2 NO.XE CBX SAVE TABLE INDEX VALUE LDB SRCH,I GET TABLE POINTER ISZ SRCH BUMP RETURN SRC02 EQU * LDA B,I GET 1ST 2 CHARACTERS OF TABLE ENTRY CPA PRAM FIND A MATCH? JMP SRC01 YES SZA,RSS NO.END OF TABLE? JMP SRCH,I YES.ERROR SRC03 EQU * ADB .4 NO.BUMP POINTER TO NEXT ENTRY JMP SRC02 CONTINUE SRC01 EQU * INB GET 2ND 2 CHARACTERS LDA B,I OF TABLE ENTRY CPA PRAM+1 GOT A MATCH? JMP SRC04 YES SAILOR.THIS IS IT SRC05 EQU * ADB M1 NO.DECREMENT POINTER BACK DOWN JMP SRC03 CONTINUE SKP SRC04 EQU * ADB M1 POINT BACK TO 1ST ENTRY LAX B,I GET TABLE BIT PATTERN CPA M1 ALLOWED FOR THIS MACHINE? JMP SRC05 NO.KEEP LOOKING STA SAVE0 YES.SAVE TABLE ENTRY CYA GET TABLE MASK SZA IS IT NEEDED? JMP SRC06 YES.GO SEE IF ENTRY IS ACCEPTABLE SRC07 EQU * LDA SAVE0 NO.RESTORE TABLE ENTRY LDB SRCH RETURN ADB .3 P+5 JMP B,I SRC06 EQU * AND SAVE0 HAVE RIGHT SZA,RSS FIELD BIT? JMP SRC05 NO.KEEP LOOKING JMP SRC07 YES.DONE SKP * S T A T 1 * * CHECKS THE STATUS BITS IN EQT WORD 5 AFTER A WCS I/O OPERATION. * * LDA * JSB STAT1 * STAT1 NOP SLA,RSS DID AN ERROR OCCUR? JMP STAT1,I NO.DONE AND B77 YES.VERIFY CPA B41 ERROR ONLY? JMP STA01 YES RAR NO.IS AND .7 IT A WCS CPA .1 ADDRESS ERROR? JMP STA02 YES CPA .2 DATA OVERRUN JMP STA03 YES CPA .3 WCS ADDRESS CONFLICT? JMP STA04 YES CPA .4 SUBCHANNEL PSEUDO-DISABLED? JMP STA05 YES * * NOTE----------THE STATE BUFFER TO SMALL ERROR CANNOT * OCCUR IN MDES. * CPA .6 I/O REQUEST ON DOWNED SUBCHANNEL? JMP STA05 YES JSB ERROR NO.MUST BE NO DMA DEF .13 RESPONSE.MDE ERROR 013 JMP STAT1,I STA01 EQU * JSB ERROR MDE DEF .12 ERROR 012 JMP STAT1,I STA02 EQU * JSB ERROR MDE DEF .14 ERROR 014 JMP STAT1,I STA03 EQU * JSB ERROR MDE DEF .16 ERROR 016 JMP STAT1,I STA04 EQU * JSB ERROR MDE DEF .15 ERROR 015 JMP STAT1,I STA05 EQU * JSB ERROR MDE DEF .17 ERROR 017 JMP STAT1,I SKP * S T A T E * * READS LOGICAL STATE OF WCS. * * LDA * JSB STATE * * STATE NOP IOR B100 FORM CONTROL STA CONWD WORD FOR REQUEST JSB EXEC READ  DEF *+5 LOGICAL DEF .1 STATE DEF CONWD DEF SBUFF DEF .2 JMP STATE,I SKP * S T R E G * * DOES ACTUAL MODIFICATION OF CURRENT REGISTER. * * USER RESPONSE: / * XXXXX * A * * / LEAVES THE CURRENT REGISTER UNCHANGED AND MOVES TO * THE NEXT REGISTER TO BE MODIFIED. * * XXXXX IS AN OCTAL NUMBER FROM -77777 TO 77777 OR DECIMAL * NUMBER FROM -32767 TO 32767. * * A CAUSES THE SET COMMAND TO ABORT. * * * JSB STREG * P+1 * P+2 * STREG NOP CCE GET OPERATOR'S JSB PICK INPUT JMP MDE10 ILLEGAL PARAMETER SZA MORE PARAMETERS? JMP MDE10 YES.ILLEGAL SZB,RSS PARAMETER DEFAULTED? JMP MDE10 YES.ILLEGAL CPB B100K FILE NAME? JMP MDE10 YES.ILLEGAL CPB M1 NON-NUMERIC? JMP STR01 YES.ANALYZE FURTHER LDB SAVE6 NO.MUST BE REGISTER MODIFY LDA B,I GET REGISTER INDEX VALUE LDB STREG,I FORM ISZ STREG ADDRESS ADA B OF ADA M1 REGISTER LDB NUMB PUT IN NEW STB A,I VALUE FOR REGISTER JMP STREG,I SKP STR01 EQU * LDA PRAM GET 1ST 2 CHARACTERS OF INPUT CPA "A.S" IS IT ABORT? JMP STR02 YES ALF,ALF GET 1ST AND B377 CHARACTER RHJ CPA "/" IS IT SLASH? JMP STR03 YES JMP MDE10 NO.ILLEGAL STR02 EQU * ISZ FLAG2 SET END OF REGISTERS FLAG STR03 EQU * ISZ STREG RETURN ISZ STREG P+3 JMP STREG,I SKP * S T U F F * * CONVERTS CURRENT DECIMAL NUMBER TO ASCII AND MOVES THE * RESULTS TO THE LAST 2 DIGITS OF THE # cTO THE DESIRED LOCATION. * * LDY * LDX * JSB STUFF * STUFF NOP LDA .6 SET UP "XPUT" LDB PNT03 SUBROUTINE FOR JSB XPUTI 6 CHARACTERS CYA GET DECIMAL NUMBER JSB XDCAS CONVERT ERROR # TO ASCII LDA XBUF2 EXTRACT LAST AND B377 2 ASCII DIGITS ALF,ALF OF CONVERSION STA SAVE0 AND MERGE THEM LDA XBUF3 TO FORM 2 ALF,ALF DIGIT DECIMAL AND B377 NUMBER IOR SAVE0 CXB MOVE 2 ASCII DIGITS STA B,I TO DESIRED LOCATION JMP STUFF,I SKP * S V S U B * * SAVES THE STATE OF SUBROUTINES "XGET" & "XGETN". * * JSB SVSUB * SVSUB NOP LDA XSLNG USE TEMPORARY STA SAVE2 STORAGE LOCATIONS LDA XSCNT SAVE2,SAVE3 & SAVE4 STA SAVE3 LDA XSADR STA SAVE4 JMP SVSUB,I SKP * W H O Z T * * USED EXCLUSIVELY BY SUBROUTINE "CHKLU". DETERMINES IF SUBROUTINE * "CHKLU" WAS CALLED FROM THE COMMAND ROUTINE "LUNIT"(LU COMMAND) * OR NOT. * * JSB WHOZT * P+1 * P+2 * WHOZT NOP LDA CHKLU CALLED FROM CPA PNT02 1ST "CHKLU" CALL? JMP WHO01 YES CPA PNT13 CALLED FROM 2ND "CHKLU" CALL? JMP WHO01 YES JMP WHOZT,I NO.RETURN WHO01 EQU * ISZ WHOZT RETURN JMP WHOZT,I P+2 SKP * W R I F L * * WRITES THE CURRENT RECORD TO FILE OPENED BY CREAT CALL. * * <# OF WORDS TO BE TRANSFERRED MUST BE IN LOCATION "XFER"> * * JSB WRIFL * WRIFL NOP JSB WRITF WRITE DEF *+5 RECORD DEF IOBUF+60 TO DEF SAVE0 FILE . DEF IOBUF DEF XFER LDA SAVE0 ERROR SSA,RSS OCCUR? JMP WRIFL,I NO.DONE JSB FMPER YES.REPORT FMP ERROR JMP MDE03 TAKE NEXT COMMAND SKP * W R I T 1 * * WRITES A MICROINSTRUCTION AT THE CURRENT WCS ADDRESS. * * * * LDA * JSB WRIT1 * P+1 * WRIT1 NOP IOR B100 FORM CONTROL WORD STA CONWD FOR WRITE/VERIFY JSB EXEC WRITE DEF *+6 AND VERIFY DEF .2 THE DEF CONWD MICROINSTRUCTION DEF SBUFF DEF .2 DEF ADDRS SLA,RSS ERROR OCCUR? ISZ WRIT1 NO.RETURN P+2 JSB STAT1 YES.GO ANALYZE ERROR JMP WRIT1,I SKP * W R I T E * * WRITES CURRENT RECORD ON OUTPUT LU. * * * LDA * JSB WRITE * WRITE NOP IOR B100 FORM CONTROL STA CONWD WORD FOR A WRITE JSB EXEC WRITE DEF WRI01 DATA DEF .2 ON DEF CONWD OUTPUT DEF IOBUF LU DEF XFER WRI01 EQU * JMP WRITE,I HED XLIB ROUTINES-XASCV * X A S C V * * DO ASCII TO CONVERSION(UNSIGNED). IGNORE LEADING * BLANKS OR ZEROS. FIRST NON-RADIX CHARACTER TERMINATES THE * CONVERSION. FUNCTIONALLY IDENTICAL TO HP PART # 25311- * 80043. SUBROUTINES "XGET" AND "XGETN" MUST BE SET UP TO * BE POINTING AT THE DESIRED ASCII NUMBER STRING. * * XASBN CALL: ASCII/BINARY * * JSB XASBN * P+1 <(O)=0 FIELD NON-NUMERIC, (O)=1 FIELD OVERFLOW> * P+2 * * XASOC CALL: ASCII/OCTAL :<:66<* * JSB XASOC * P+1 <(O)=0 FIELD NON-NUMERIC, (O)=1 FIELD OVERFLOW> * P+2 * * XASDC CALL: ASCII/DECIMAL * * JSB XASDC * P+1 <(O)=0 FIELD NON-NUMERIC, (O)=1 FIELD OVERFLOW> * P+2 * * XASCV CALL: ASCII/ * * LDA * JSB XASCV * P+1 <(O)=0 FIELD NON-NUMERIC, (O)=1 FIELD OVERFLOW> * P+2 * * R.FAJARDO, 730127 * XASBN NOP CLA,INA RADIX=2 LDB XASBN JMP XAS * XASOC NOP LDA .7 RADIX=8 LDB XASOC JMP XAS * XASDC NOP LDA .9 RADIX=10 LDB XASDC XAS STB XASCV JMP XASCV+1 SKP XASCV NOP STA RDXM1 (A)=RADIX-1 CLA CLEAR: STA VAL ACCUMULATOR STA NUMF # OCCURANCE FLAG JSB XGETN GET NON-BLANK CHARACTER JMP XASX1 EOB!, EMPTY BUFFER JMP XAS2 XAS1 JSB XGET FETCH A CHARACTER JMP XASEX EOB! XAS2 ADA M60 CONVERT IT CMA,SSA,INA,RSS JMP XASEX NOT # ADA RDXM1 CMA,SSA,INA,RSS JMP XASEX >RADIX ADA RDXM1 CLO CLEAR THE OVERFLOW BIT STA XATMP SAVE DIGIT LDA RDXM1 GET RADIX - 1 INA MAKE RADIX MPY VAL DO RADIX*VAL ADA XATMP ADD IN NEW DIGIT SZB,RSS IF B NOT 0, OVERFLOW JMP *+3 EVERYTHING OK STO SET OVERFLOW JMP XASCV,I ERROR RETURN STA VAL ISZ NUMF JMP XAS1 XASEX LDA NUMF SZA # SEEN? ISZ XASCV YES, P+2 EXIT XASX1 LDA VAL (A)=VALUE LDB XCHAR (B)=DELIMITING CHARACTER CLO JMP XASCV,I & LEAVE XATMP NOP A TEMP STORAGE HED XLIB ROUTINES-XCHAR * X C H $A R * * CHARACTER MANIPULATION AND INITIALIZATION ROUTINES. * FUNCTIONALLY IDENTICAL TO SUBROUTINES "XPUT" & "XGET" * IN HP PART # 25311-80041. * * FETCH CHARS FROM SOURCE BUFFER: * * INIT CALL: INIT SOURCE BUFFER * LDA * LDB * JSB XGETI * * XGET CALL: FETCH NEXT CHAR * JSB XGET * P+1 * P+2 * * XGETN CALL: FETCH NEXT NON-BLANK CHAR * JSB XGETN * P+1 * P+2 * * R.FAJARDO, 730125 * XGETI NOP STA XSLNG STB XSADR CLA STA XSCNT JMP XGETI,I * XGET NOP CLA STA XCHAR LDB XSCNT CPB XSLNG EOB ? JMP XGET,I YES, LEAVE LDA XSADR,I NO, FETCH CURRENT WORD SLB,RSS EVEN COUNT ? ALF,ALF YES, POSITION AND B377 EXTRACT CHARACTER STA XCHAR SLB,INB ODD COUNT ? ISZ XSADR YES, BUMP ADDRESS STB XSCNT BUMP CHARACTER COUNT ISZ XGET JMP XGET,I * XGETN NOP JSB XGET GET A CHARACTER JMP XGETN,I EOB, EXIT CPA B40 BLANK ? JMP *-3 YES, IGNORE ISZ XGETN JMP XGETN,I SKP * PACK CHARACTERS IN DESTINATION BUFFER: * * INIT CALL: INIT DESTINATION BUFFER * LDA * LDB * JSB XPUTI * * XPUT CALL: STUFF A CHAR * LDA * JSB XPUT * P+1 * P+2 * XPUTI NOP STA XDLNG STB XDADR CLA STA XDCNT JMP XPUTI,I * XPUT NOP LDB XDCNT CPB XDLNG EOB ? JMP XPUT,I YES, LEAVE <STA XPUTI LDA XDADR,I GET CURRENT WORD SLB,RSS EVEN COUNT ? ALF,ALF YES, POSITION AND M400 CLEAR EXCESS IOR XPUTI MERGE CHARACTER SLB,RSS EVEN COUNT ? ALF,ALF YES, POSITION STA XDADR,I SLB,INB ODD COUNT ? ISZ XDADR YES, BUMP ADDRESS STB XDCNT BUMP COUNT LDA XPUTI ISZ XPUT JMP XPUT,I HED XLIB ROUTINES-XCVAS * X C V A S * * INTEGER TO ASCII CONVERSION ROUTINES. FUNCTIONALLY * SIMILAR TO HP PART # 25311-80045. * * XCVAS CALL: TO ASCII * * LDA * LDB <+/- RADIX> * +RADIX: UNSIGNED 16 BIT INTEGER * -RADIX: SIGNED 15 BIT INTEGER * CLE * CCE * JSB XCVAS * P+1 * P+2 * * XBNAS CALL: BINARY TO ASCII, UNSIGNED * * GENERATE LEADING ZEROES. * LDA * JSB XBNAS * P+1 * * XOCAS CALL: OCTAL TO ASCII, UNSIGNED * * GENERATE LEADING ZEROES. * LDA * JSB XOCAS * P+1 * * XDCAS CALL: DECIMAL TO ASCII, UNSIGNED * * GENERATE LEADING ZEROES. * LDA * JSB XDCAS * P+1 * * R.FAJARDO, 731214 * XBNAS NOP LDB .2 RADIX=2, UNSIGNED # CCE GENERATE LEADING 0'S JSB XCVAS NOP JMP XBNAS,I * XOCAS NOP LDB .8 RADIX=8, UNSIGNED # CCE GENERATE LEADING 0'S JSB XCVAS NOP JMP XOCAS,I SKP XDCAS NOP LDB .10 RADIX=10, UNSIGNED # CCE GENERATE LEADING 0'S JSB XCVAS NOP JMP XDCAS,I * XCVAS NO}P SEZ SUPPRESS LEADING 0'S ? ISZ LDING NO, GIVE THEM TOO STA VAL STB RADIX SSB,RSS SIGNED ? JMP XCV2 CMB,INB YES, FORCE STB RADIX + RADIX SSA,RSS + VALUE? JMP XCV2 CMA,INA NO, FORCE + STA VAL LDA B55 & GIVE "-" JSB XPUT JMP XCVAS,I EOB, EXIT P+1 SKP XCV2 LDA RADIX FIND LARGEST MPY RADIX DIGIT POSITION SZB,RSS JMP *-3 DIV RADIX SAVE AS DIVISOR STB FDIG XCV3 STA DIVSR LDA VAL EXTRACT NEXT DIGIT CLB DIV DIVSR STB VAL SZA ISZ LDING WORRY ABOUT LEADING 0'S LDB LDING SZB,RSS JMP XCV4 IGNORE THEM ISZ FDIG SSA IN CASE OF -DIVISOR CMA,INA ADA B60 MAKE ASCII CHARACTER JSB XPUT JMP XCVAS,I EOB, LOSE EXIT XCV4 CLB LDA DIVSR FIND NEXT DIGIT POSITION DIV RADIX SZA JMP XCV3 STA LDING LDA FDIG SZA JMP *+4 LDA B60 JSB XPUT JMP XCVAS,I ISZ XCVAS JMP XCVAS,I HED TABLES AND BUFFERS IN ALPHANUMERIC ORDER * A L U * * TABLE CONTAINS THE MX AND XE ALU MNEMONICS AND BIT PATTERNS. * * TABLE ENTRY FORMAT: * * ASC 2,MNEM(ALU MNEMONIC) * OCT X(XE BIT PATTERN) * OCT Y(MX BIT PATTERN) * ALU EQU * ALNOP ASC 2,PASS OCT 20 OCT 37 ASC 2, OCT 20 OCT 37 "DE" ASC 2,DEC OCT 0 OCT 17 ASC 2,OP11 OCT 1 OCT 16 ASC 2,OP10 OCT 2 OCT 15 ASC 2,DBLS OCT 3 OCT -1 ASC 2,OP9 OCT -1 OCT 14 ASC 2,OP8 OCT 4 OCT 13 ASC 2,OP7 OCT 5 OCT 12 ASC 2,ADD OCT 6 OCT 11 ASC 2,OP6 OCT 7 OCT 10  SKP ASC 2,OP5 OCT 10 OCT 7 ASC 2,SUB OCT 11 OCT 6 ASC 2,OP4 OCT 12 OCT 5 ASC 2,OP3 OCT 13 OCT 4 ASC 2,ZERO OCT 14 OCT 3 ASC 2,OP2 OCT 15 OCT 2 ASC 2,OP1 OCT 16 OCT 1 ASC 2,INC OCT 17 OCT 0 ASC 2,IOR OCT 21 OCT 36 ASC 2,SONL OCT 22 OCT 35 ASC 2,ONE OCT 23 OCT 34 ASC 2,AND OCT 24 OCT 33 ASC 2,PASL OCT 25 OCT 32 ASC 2,XNOR OCT 26 OCT 31 ASC 2,NSOL OCT 27 OCT 30 SKP ASC 2,SANL OCT 30 OCT 27 ASC 2,XOR OCT 31 OCT 26 ASC 2,CMPL OCT 32 OCT 25 ASC 2,NAND OCT 33 OCT 24 ASC 2,OP13 OCT 34 OCT 23 ASC 2,NSAL OCT 35 OCT 22 ASC 2,NOR OCT 36 OCT 21 ASC 2,CMPS OCT 37 OCT 20 OCT 0 END OF 'ALU' TABLE. SKP * B K T B L * * CONTAINS THE BREAKPOINT ADDRESSES AND THE MICRO- * OBJECT CODE OF THE MICROINSTRUCTIONS AT THE BREAKPOINTS. * * TABLE ENTRY FORMAT: * * BREAKPOINT CONTROL STORE ADDRESS OR 0 * 8 HIGH(MSB) BITS OF MICROINSTRUCTION * 16 LOW(LSB) BITS OF MICROINSTRUCTION * BKTBL EQU * OCT 0 TABLE BSS 2 INITIALLY OCT 0 EMPTY BSS 2 OCT 0 BSS 2 OCT -1 END OF TABLE SKP * C M N D S * * CONTAINS ALL THE MDE COMMANDS AND THEIR ROUTINE ADDRESSES. * * TABLE ENTRY FORMAT: * * ASC 1,XX(XX=TWO CHARACTER COMMAND) * DEF * CMNDS EQU * ASC 1,?? DEF QUEST ASC 1,BR DEF BREAK ASC 1,CL DEF CLEAR ASC 1,DE DEF DELET ASC 1,DU DEF DUMP ASC 1,EX DEF EXIT ASC 1,LC DEF LOCAT ASC 1,LD DEF LOAD ASC 1,LU DEF LUNIT ASC 1,PR DEF PARAM ASC 1,RE DEF REPLC ASC 1,RU DEF RUN ASC 1,SE DEF SET ASC 1,SH DEF SHOW OCT -1 SKP * C O N D * * TABLE CONTAINS MX AND XE CONDITIONAL MNEMONICS AND BIT PATTERNS. * * TABLE ENTRY FORMAT: * * ASC 2,MNEM(CONDITIONAL MNEMONIC) * OCT X(XE BIT PATTERN) * OCT Y(MX BIT PATTERN) * COND EQU * CNNOP ASC 2, M1 OCT -1 OCT 35 ASC 2,ALZ OCT 0 OCT -1 ASC 2,ONES .1 OCT 1 OCT 1 ASC 2,COUT .2 OCT 2 OCT 2 ASC 2,AL0 .3 OCT 3 OCT 3 ASC 2,L15 .5 OCT 5 OCT -1 ASC 2,RUN .6 OCT 6 OCT 13 ASC 2,HOI .7 OCT 7 OCT -1 ASC 2,CNT4 .8 OCT 10 .30 OCT 36 ASC 2,IR11 .9 OCT 11 OCT -1 ASC 2,RUNE .10 OCT 12 OCT 34 ASC 2,NMLS .11 OCT 13 OCT 5 ASC 2,MPP .12 OCT 14 OCT -1 ASC 2,CNT8 .13 OCT 15 OCT 6 SKP ASC 2,NSFP .14 OCT 16 OCT 31 ASC 2,AL15 .15 OCT 17 .4 OCT 4 ASC 2,NLDR .16 OCT 20 OCT 20 ASC 2,NSTB .17 OCT 21 OCT 30 ASC 2,NINC .18 OCT 22 OCT 22 ASC 2,NDEC .19 OCT 23 OCT 23 ASC 2,NRT .20 OCT 24 OCT 24 ASC 2,NLT .21 OCT 25 OCT 25 ASC 2,NSTR .22 OCT 26 OCT 26 ASC 2,NMDE .23 OCT 27 OCT -1 ASC 2,FLAG .24 OCT 30 OCT 10 ASC 2,E .25 OCT 31 OCT 11 ASC 2,NINT .26 OCT 32 OCT -1 ASC 2,OVFL .27 OCT 33 OCT 12 ASC 2,NSNG .28 OCT 34 OCT 21 ASC 2,SKPF OCT 35 OCT 15 ASC 2,TBZ OCT -1 OCT 0 *($ ASC 2,FPSP OCT -1 OCT 7 SKP ASC 2,NHOI OCT -1 OCT 14 ASC 2,ASGN OCT -1 OCT 16 ASC 2,IR2 OCT -1 OCT 17 ASC 2,NRST OCT -1 OCT 27 ASC 2,INT OCT -1 OCT 32 z}* ASC 2,SRGL OCT -1 OCT 33 ASC 2,NMEU OCT -1 .31 OCT 37 ASC 2,IR8 OCT 36 OCT -1 ASC 2,MRG OCT 37 OCT -1 ASC 2,L0 OCT 4 OCT -1 ASC 2,NOP OCT -1 OCT 35 OCT 0 END OF 'CONDITION' TABLE. SKP * E T A B L * * ERROR TABLE. CONTAINS DEF'S TO ALL THE ERROR EXPANSION * MESSAGES. TERMINATED BY A DEF TO A LOCATION CONTAINING * ALL ONES. * ETABL EQU * PNT35 DEF EM000 DEF EM001 DEF EM002 DEF EM003 DEF EM004 DEF EM005 DEF EM006 DEF EM007 DEF EM008 DEF EM009 DEF EM010 DEF EM011 DEF EM012 DEF EM013 DEF EM014 DEF EM015 DEF EM016 DEF EM017 DEF EM018 DEF EM019 DEF EM020 DEF EM021 DEF EM022 DEF EM023 DEF EM024 ENTAB EQU *-1 DEF MEND DEF M1 SKP * I O B U F/I B U F F/O B U F F * * I/O OPERATIONS BUFFER, CONSOLE INPUT BUFFER(HOLDS THE * INPUT ASCII STRING) AND OUTPUT LINE BUFFER. * IBUFF EQU * IOBUF EQU * OBUFF EQU * BSS 204 SKP * I M M * * TABLE CONTAINS MX AND XE IMMEDIATE MNEMONICS AND BIT PATTERNS. * * TABLE ENTRY FORMAT: * * ASC 2,MNEM(IMMEDIATE MNEMONIC) * OCT X(XE BIT PATTERN) * OCT Y(MX BIT PATTERN) * IMM EQU * IMNOP ASC 2,HIGH OCT 1 OCT 0 ASC 2,LOW OCT 0 OCT 1 ASC 2,CMHI OCT 3 OCT 2 ASC 2,CMLO OCT 2 OCT 3 OCT 0 END OF 'IMM' TABLE. SKP * M X C O D * * CONTAINS THE 21MX MDE BREAKPOINT MICROCODE. ALSO SEE * THE IMS FOR FURTHER DETAILS. * MXCOD EQU * OCT 300,000630 BREAK1 JSB REGSAVE OCT 357,175017 IMM CMLO S1 376B OCT 320,000430 JMP r EXIT OCT 300,000630 BREAK2 JSB REGSAVE OCT 357,173017 IMM CMLO S1 375B OCT 320,000430 JMP EXIT OCT 300,000630 BREAK3 JSB REGSAVE OCT 357,171017 IMM CMLO S1 374B OCT 000,074717 EXIT INC PNM P OCT 177,140117 WRTE PASS T S1 OCT 237,174457 READ M P OCT 017,105736 RTN PASS P T SKP OCT 344,000417 REGSAVE IMM LOW IR 0 OCT 017,110457 M IOI OCT 177,174117 WRTE PASS T P OCT 357,175717 IMM CMLO P 376B OCT 017,174457 M P OCT 015,037717 PASL P OCT 177,174117 WRTE PASS T P OCT 354,001717 IMM CMLO P 0 OCT 017,174157 L P OCT 350,001717 IMM CMHI P 0 OCT 017,075717 IOR P P OCT 000,074717 INC PNM P OCT 177,140117 WRTE PASS T S1 OCT 000,074717 INC PNM P OCT 177,142117 WRTE PASS T S2 OCT 000,074717 INC PNM P OCT 177,144117 WRTE PASS T S3 OCT 000,074717 INC PNM P OCT 177,146117 WRTE PASS T S4 OCT 000,074717 INC PNM P OCT 177,150117 WRTE PASS T S5 OCT 000,074717 INC PNM P OCT 177,152117 WRTE PASS T S6 OCT 000,074717 INC PNM P OCT 177,154117 WRTE PASS T S7 OCT 000,074717 INC PNM P OCT 177,156117 WRTE PASS T S8 OCT 000,074717  INC PNM P OCT 177,160117 WRTE PASS T S9 OCT 000,074717 INC PNM P OCT 177,162117 WRTE PASS T S10 OCT 000,074717 INC PNM P OCT 177,164117 WRTE PASS T S11 OCT 000,074717 INC PNM P OCT 177,166117 WRTE PASS T S12 OCT 000,074717 INC PNM P SKP OCT 000,074717 INC PNM P OCT 177,176117 WRTE PASS T S OCT 000,074717 INC PNM P OCT 177,116117 WRTE PASS T DSPI OCT 000,074717 INC PNM P OCT 177,112117 WRTE PASS T CNTR OCT 000,074717 INC PNM P OCT 141,137002 LWF L1 ZERO S1 OCT 177,140117 WRTE PASS T S1 OCT 357,175017 IMM CMLO S1 376B OCT 237,140457 READ M S1 OCT 007,141017 DEC S1 S1 OCT 017,105057 PASS S2 T OCT 237,140457 READ M S1 OCT 017,105117 PASS S3 T OCT 000,074717 INC PNM P OCT 177,142117 WRTE PASS T S2 OCT 000,074717 INC PNM P OCT 177,144117 WRTE PASS T S3 OCT 357,161017 IMM CMLO S1 370B OCT 017,140157 L S1 OCT 004,175736 RTN ADD P P SKP OCT 237,174457 RESTORE READ PASS M P OCT 017,105717 PASS P T OCT 220,074717 READ INC PNM P OCT 017,105017 PASS S1 T OCT 220,074717 READ INC PNM P OCT 017,105057 PASS S2 T OC\T 220,074717 READ INC PNM P OCT 017,105117 PASS S3 T OCT 220,074717 READ INC PNM P OCT 017,105157 PASS S4 T OCT 220,074717 READ INC PNM P OCT 017,105217 PASS S5 T OCT 220,074717 READ INC PNM P OCT 017,105257 PASS S6 T OCT 220,074717 READ INC PNM P OCT 017,105317 PASS S7 T OCT 220,074717 READ INC PNM P OCT 017,105357 PASS S8 T OCT 220,074717 READ INC PNM P OCT 017,105417 PASS S9 T OCT 220,074717 READ INC PNM P OCT 017,105457 PASS S10 T OCT 220,074717 READ INC PNM P OCT 017,105517 PASS S11 T OCT 220,074717 READ INC PNM P OCT 017,105557 PASS S12 T OCT 000,074717 INC PNM P OCT 220,074717 READ INC PNM P OCT 017,105757 S T OCT 220,074717 READ INC PNM P OCT 017,104357 DSPI T OCT 220,074717 READ INC PNM P OCT 017,104257 CNTR T OCT 220,074717 READ INC PNM P OCT 157,104744 LWF R1 PASS T OCT 220,074717 READ INC PNM P OCT 017,104157 L T OCT 237,174457 READ M P OCT 017,105717 PASS P T OCT 017,136757 PASS OCT 017,136757 PASS OCT 017,136757 PASS OCT 017,136757 PASS OCT 320,000030 JMP 0 SKP * M X (M A P * * CONTAINS ALL THE ENTRY POINTS IN CONTROL MEMORY * FOR THE 21MX AND THEIR ASSOCIATED MACROINSTRUCTIONS. * * TABLE ENTRY FORMAT: * * ENTRY POINT ADDRESS * MACRO TO THAT ADDRESS * MXMAP EQU * B1000 OCT 1000 OCT 105720 OCT 1400 OCT 105160 B2000 OCT 2000 OCT 105220 OCT 2400 OCT 105260 OCT 3000 OCT 105320 OCT 3400 OCT 105360 OCT 4000 OCT 105420 OCT 4400 OCT 105460 OCT 5000 OCT 105520 OCT 5400 OCT 105560 OCT 6000 OCT 105620 OCT 6400 OCT 105660 OCT 0 END OF TABLE SKP * O P C O D * * TABLE CONTAINS MX AND XE OPCODE MNEMONICS AND BIT PATTERNS. * * TABLE ENTRY FORMAT: * * ASC 2,MNEM(OPCODE MNEMONIC) * OCT X(XE OPCODE & WORD TYPE) * OCT Y(MX OPCODE & WORD TYPE) * NOTE-BITS 12-14 -> WORD TYPE * IF BITS 12-14 = 0 -> CAN'T TELL FROM OPCODE ALONE * OPCOD EQU * ASC 2, OCT 010000 OCT 010000 OPNOP ASC 2,NOP OCT 010000 OCT 010000 ASC 2, OCT -1 OCT 010017 ASC 2,ARS OCT 010001 OCT 010001 ASC 2,CRS OCT 010002 OCT 010002 ASC 2,LGS OCT 010003 OCT 010003 ASC 2,NRM OCT 010004 OCT -1 ASC 2,DIV OCT 010005 OCT 010005 ASC 2,LWF OCT 010006 OCT 010006 ASC 2,MPY OCT 010007 OCT 010004 ASC 2,WRTE OCT 010010 OCT 010007 ASC 2,READ OCT 010011 OCT 010011 ASC 2,ENV OCT 010012 OCT 010012 SKP ASC 2,ENVE OCT 010013 OCT 010013 ASC 2,JSB OCT 000014 OCT 040014 ASC 2,JMP OCT 000015 OCT 000015 ASC 2,IMM OCT 020016 OCT 020016 ASC 2,RTN OCT 000017 OCT SA-1 ASC 2,ASG OCT -1 OCT 010010 OCT 0 END OF 'OPCODE' TABLE SKP * P R A M * * HOLDS NON-NUMERIC ASCII PARAMETER EXTRACTED FROM THE * INPUT ASCII STRING. * PRAM EQU * BSS 3 SKP * P T A B L * * CONTAINS A LIST CHARACTERIZING THE PARAMETERS USED WITH * THE INSTRUCTION IN THE RUN COMMAND USED TO CALL THE * DESIRED MICROPROGRAM. * * TABLE ENTRY FORMAT: * * ENTRY = 0 NO PARAMETER OR NUMERIC PARAMETER * ENTRY = 1 RETURN POINT * ENTRY = 2 DEF * PTABL EQU * OCT 1,1,1,1,1 INITIALLY OCT 1,1,1,1,1 NO PARAMETERS SKP * S B U F F * * BUFFER SPACE FOR WCS STATE REQUEST STATUS INFORMATION * AND SINGLE MICROINSTRUCTION READS OR WRITES. * SBUFF EQU * SBUF1 BSS 1 WORD 1 SBUF2 BSS 1 WORD 2 SKP * S E N S E * * TABLE CONTAINS THE MX AND XE SENSE MNEMONICS AND BIT PATTERNS. * * TABLE ENTRY FORMAT: * * ASC 2,MNEM(SENSE MNEMONIC) * OCT X(XE SENSE BIT PATTERN) * OCT Y(MX SENSE BIT PATTERN) * SENSE EQU * SENOP ASC 2, OCT 0 OCT 1 ASC 2,NOP OCT 0 OCT 1 ASC 2,RJS OCT 1 OCT 0 OCT 0 END OF 'SENSE' TABLE SKP * S P E C * * TABLE CONTAINS THE MX AND XE SPECIAL MNEMONICS AND BIT PATTERNS. * * TABLE ENTRY FORMAT: * * ASC 2,MNEM(SPECIAL MNEMONIC) * OCT X(XE BIT PATTERN & WORD TYPE) * OCT Y(MX BIT PATTERN & WORD TYPE) * NOTE-IF BIT 12 SET -> TYPE 1 OR 2 FORMATS ALLOWED * IF BIT 13 SET -> TYPE 4 FORMAT ALLOWED * IF BIT 14 SET -> TYPE 3 FORMAT ALLOWED * SPEC EQU * ASC 2, OCT 030007 OCT 010017 SPNOP ASC 2,NOP OCT 030007 OCT 010017 ASC 2,ASG OCT 010030 OCT -1 ASC 2,IAK OCT 010031 OCT -1 \ASC 2,MPP1 OCT 010032 OCT -1 ASC 2,FTCH OCT 010033 OCT 010012 ASC 2,INCI OCT 010034 OCT 010025 ASC 2,SHLT OCT 010035 OCT 010024 ASC 2,MPCK OCT 010036 OCT 010021 ASC 2,IOFF OCT 030037 OCT 030000 ASC 2,SRG2 OCT 010020 OCT 010001 ASC 2,SRG1 OCT 010021 OCT 010006 ASC 2,L1 OCT 010022 OCT 010002 SKP ASC 2,L4 OCT 010023 OCT 010003 ASC 2,R1 OCT 010024 OCT 010004 ASC 2,DCNT OCT 010025 OCT -1 ASC 2,ICNT OCT 010026 OCT 010023 ASC 2,RPT OCT 030027 OCT 010015 ASC 2,SRUN OCT 010010 OCT 010027 ASC 2,MPP2 OCT 010011 OCT -1 ASC 2,MESP OCT 010012 OCT 030020 ASC 2,COV OCT 010013 OCT 010014 ASC 2,SOV OCT 010014 OCT 010013 ASC 2,PRST OCT 010015 OCT -1 ASC 2,CLFL OCT 010016 OCT 010011 ASC 2,STFL OCT 030017 OCT 030010 "RT" ASC 2,RTN OCT 010000 OCT 010036 ASC 2,JTAB OCT 010001 OCT 010033 "CN" ASC 2,CNDX OCT 040002 OCT 040031 ASC 2,RJ30 OCT 030004 OCT -1 SKP ASC 2,J30 OCT -1 OCT 020035 ASC 2,J74 OCT 020005 OCT 020034 ASC 2,IOG OCT 030006 OCT 030022 ASC 2,ION OCT 030003 OCT 010005 ASC 2,UNCD OCT -1 OCT 020030 ASC 2,SRGE OCT -1 OCT 010016 ASC 2,JIO OCT -1 OCT 020032 ASC 2,JEAU OCT -1 OCT 020037 ASC 2,RES1 OCT -1 OCT 010026 ASC 2,RES2 OCT -1 OCT 010007 OCT 0 END OF 'SPECIAL' TABLE. SKP * S R T B L * * SAVEABLE REGISTERS TABLE.CONTAINS ALL THE ACCEPT0.*ABLE * MNEMONICS FOR THE SAVEABLE REGISTERS. * * TABLE ENTRY FORMAT: * * ASC 2,MNEM(REGISTER MNEMONIC) * SRTBL EQU * ASC 2,S1 ASC 2,S2 ASC 2,S3 ASC 2,S4 ASC 2,S5 ASC 2,S6 ASC 2,S7 ASC 2,S8 ASC 2,S9 ASC 2,S10 ASC 2,S11 ASC 2,S12 ASC 2,SP ASC 2,S ASC 2,DSPI ASC 2,CNTR ASC 2,FLAG ASC 2,L ASC 2,P ASC 2,O ASC 2,E ASC 2,DSPL ASC 2,A ASC 2,B ASC 2,X ASC 2,Y OCT 0 END OF TABLE SKP * S T O R E & S . B U S * * TABLE CONTAINS MX AND XE S-BUS AND STORE MNEMONICS AND * BIT PATTERNS. * * TABLE ENTRY FORMAT: * * ASC MNEM(S-BUS OR STORE MNEMONIC) * OCT X(XE BIT PATTERN) * OCT Y(MX BIT PATTERN) * NOTE-IF BIT 12 SET -> S-BUS * IF BIT 13 SET -> STORE * STORE EQU * S.BUS EQU * SBNOP ASC 2, OCT 030017 OCT 030017 STNOP ASC 2,NOP OCT 030017 OCT 030017 ASC 2,TAB OCT 030000 OCT 030000 ASC 2,CAB OCT 030001 OCT 030001 ASC 2,MPPA OCT 030002 0 OCT -1 ASC 2,T OCT -1 OCT 030002 "A.S" ASC 2,A OCT 030003 OCT 030013 ASC 2,B OCT 030004 OCT 030012 ASC 2,IOO OCT 020005 OCT 020004 ASC 2,IOI OCT 010005 OCT 010004 ASC 2,DSPL OCT 030006 OCT 030006 ASC 2,DSPI OCT 030007 OCT 030007 ASC 2,MPPB OCT 030010 OCT -1 SKP ASC 2,MEU OCT 030011 OCT 020014 ASC 2,L OCT 020012 OCT 020003 ASC 2,CIR OCT 010012 OCT 010003 ASC 2,CNTR OCT 030013 OCT 030005 ASC 2,IRCM OCT 020014 OCT -1 ASC 2,LDR OCT 010014 OCT 010014 ASC 2,M OCT 030015 OCT 030011 ASC 2,PNM OCT 020016 OCT 020016 ASC 2,DES OCT 010016 OCT -1 ASC 2,S1 OCT 030020 OCT 030020 ASC 2,S2 OCT 030021 OCT 030021 ASC 2,S3 OCT 030022 OCT 030022 ASC 2,S4 OCT 030023 OCT 030023 ASC 2,S5 OCT 030024 OCT 030024 ASC 2,S6 OCT 030025 OCT 030025 ASC 2,S7 OCT 030026 OCT 030026 SKP ASC 2,S8 OCT 030027 OCT 030027 ASC 2,S9 OCT 030030 OCT 030030 ASC 2,S10 OCT 030031 OCT 030031 ASC 2,S11 OCT 030032 OCT 030032 ASC 2,SP OCT 030033 OCT -1 ASC 2,X OCT 030034 OCT 030034 ASC 2,Y OCT 030035 OCT 030035 ASC 2,P OCT 030036 OCT 030036 ASC 2,S OCT 030037 OCT 030037 ASC 2,IR OCT -1 OCT 020010 ASC 2,ADR OCT -1 OCT 010010 ASC 2,CM OCT -1 OCT 020015 ASC 2,RES2 OCT -1 OCT 010015 ASC 2,S12 OCT -1 OCT 030033 ASC 2,MEU OCT -1  OCT 010016 .0 OCT 0 END OF 'STORE' & 'S-BUS' TABLE. SKP * S V R E G * * SAVEABLE REGISTERS CONTENTS TABLE. CONTAINS VALUES FOR * THE SAVEABLE REGISTERS AT MACRO CALL TIME. * SVREG EQU * BSS 1 S1 BSS 1 S2 BSS 1 S3 BSS 1 S4 BSS 1 S5 BSS 1 S6 BSS 1 S7 BSS 1 S8 BSS 1 S9 BSS 1 S10 BSS 1 S11 BSS 1 S12 BSS 1 SP BSS 1 S DSPI BSS 1 DSPI BSS 1 CNTR BSS 1 FLAG BSS 1 L BSS 1 P O.REG BSS 1 O E.REG BSS 1 E S.REG BSS 1 DSPL A.REG BSS 1 A B.REG BSS 1 B X.REG BSS 1 X Y.REG BSS 1 Y BRK# BSS 1 BREAKPOINT # STUFFED HERE DEF BRTN RETURN ADDRESS FOR BREAKPOINTS SKP * W C S L T * * CONTAINS A CURRENT LIST OF WCS LU'S USED BY MDES. * AN ENTRY=0 IS NO ENTRY. TABLE IS ALWAYS FILLED * FROM BOTTOM TO TOP WITH A -1 END OF TABLE FLAG. * * * * * MAXIMUM OF * . * 12(DECIMAL) * . * ENTRIES * * * <-1> * WCSLT EQU * OCT 0,0,0,0 TABLE OCT 0,0,0,0 INITIALLY OCT 0,0,0,0 EMPTY OCT -1 END OF TABLE SKP * X B U F F * * BUFFER SPACE FOR ASCII TO INTEGER,INTEGER TO ASCII * CONVERSIONS. * XBUFF EQU * XBUF1 BSS 1 1ST AND 2ND BYTES XBUF2 BSS 1 3RD AND 4TH BYTES XBUF3 BSS 1 5TH AND 6TH BYTES ASC 1,BB OCTAL DELIMITERS FOR 6 CHARACTERS SKP * X E C O D * * CONTAINS 21MX E-SERIES MDE BREAKPOINT MICROCODE. SEE * IMS FOR FURTHER DETAILS. * XECOD EQU * OCT 300,000707 BREAK1 JSB REGSAVE OCT 353,175007 IMM CMLO S1 ў 376B OCT 320,000407 JMP EXIT OCT 300,000707 BREAK2 JSB REGSAVE OCT 353,173007 IMM CMLO S1 375B OCT 320,000407 JMP EXIT OCT 300,000707 BREAK3 JSB REGSAVE OCT 353,171007 IMM CMLO S1 374B OCT 007,174707 EXIT INC PNM P OCT 210,040007 WRTE PASS TAB S1 OCT 230,074647 READ M P OCT 010,001707 PASS P TAB OCT 227,174707 READ INC PNM P OCT 320,000007 JMP 0 SKP OCT 340,000607 REGSAVE IMM LOW IRCM 0 OCT 010,012655 PRST M IOI OCT 210,074007 WRTE PASS TAB P OCT 353,175707 IMM CMLO P 376B OCT 010,074647 M P OCT 012,137715 PRST PASL P OCT 210,074007 WRTE PASS TAB P OCT 350,001707 IMM CMLO P 0 OCT 010,074507 L P OCT 354,001707 IMM CMHI P 0 OCT 010,175707 IOR P P OCT 007,174707 INC PNM P OCT 210,040007 WRTE PASS TAB S1 OCT 007,174707 INC PNM P OCT 210,042007 WRTE PASS TAB S2 OCT 007,174707 INC PNM P OCT 210,044007 WRTE PASS TAB S3 OCT 007,174707 INC PNM P OCT 210,046007 WRTE PASS TAB S4 OCT 007,174707 INC PNM P OCT 210,050007 WRTE PASS TAB S5 OCT 007,174707 INC PNM P OCT 210,052007 WRTE PASS TAB S6 OCT 007,174707 INC PNM P OCT 210,054007 WRTE PASS TAB S7 OCT 007,174707 INC PNM P OCT 210,056007 WRTE PASS TAB S8 OCT 007,174707 INC PNM P OCT 210,060007 WRTE PASS TAB S9 OCT 007,174707 INC PNM P OCT 210,062007 WRTE PASS TAB S10 OCT 007,174707 INC PNM P OCT 210,064007 WRTE PASS TAB S11 OCT 007,174707 INC PNM P OCT 007,174707 INC PNM P OCT 210,066007 WRTE PASS TAB SP OCT 007,174707 INC PNM P SKP OCT 210,076007 WRTE PASS TAB S OCT 007,174707 INC PNM P OCT 210,016007 WRTE PASS TAB DSPI OCT 007,174707 INC PNM P OCT 210,026007 WRTE PASS TAB CNTR OCT 007,174707 INC PNM P OCT 146,037022 LWF L1 ZERO S1 OCT 210,040007 WRTE PASS TAB S1 OCT 353,175007 IMM CMLO S1 376B OCT 230,040647 READ M S1 OCT 000,041015 PRST DEC S1 S1 OCT 010,001047 PASS S2 TAB OCT 230,040655 READ PRST M S1 OCT 010,001107 PASS S3 TAB OCT 007,174707 INC PNM P OCT 210,042007 WRTE PASS TAB S2 OCT 007,174707 INC PNM P OCT 210,044007 WRTE PASS TAB S3 OCT 353,161007 IMM CMLO S1 370B OCT 010,040507 L S1 OCT 003,075700 RTN ADD P P SKP OCT 230,036747 RESTORE READ OCT 010,001707 PASS P TAB OCT 227,174707 READ INC PNM P OCT 010,001007 , PASS S1 TAB OCT 227,174707 READ INC PNM P OCT 010,001047 PASS S2 TAB OCT 227,174707 READ INC PNM P OCT 010,001107 PASS S3 TAB OCT 227,174707 READ INC PNM P OCT 010,001147 PASS S4 TAB OCT 227,174707 READ INC PNM P OCT 010,001207 PASS S5 TAB OCT 227,174707 READ INC PNM P OCT 010,001247 PASS S6 TAB OCT 227,174707 READ INC PNM P OCT 010,001307 PASS S7 TAB OCT 227,174707 READ INC PNM P OCT 010,001347 PASS S8 TAB OCT 227,174707 READ INC PNM P OCT 010,001407 PASS S9 TAB OCT 227,174707 READ INC PNM P OCT 010,001447 PASS S10 TAB OCT 227,174707 READ INC PNM P OCT 010,001507 PASS S11 TAB OCT 007,174707 INC PNM P OCT 227,174707 READ INC PNM P OCT 010,001547 PASS SP TAB OCT 227,174707 READ INC PNM P OCT 010,001747 PASS S TAB OCT 227,174707 READ INC PNM P OCT 010,000347 DSPI TAB OCT 227,174707 READ INC PNM P OCT 010,000547 CNTR TAB OCT 227,174707 READ INC PNM P OCT 150,000764 LWF R1 PASS TAB OCT 227,174707 READ INC PNM P OCT 010,000507 L TAB OCT 230,074647 READ M P OCT 010,001707 PASS P TAB OCT 010,036747 PASS OCT 010,036747 g PASS OCT 320,000007 JMP 0 SKP * X E M A P * * CONTAINS ALL THE ENTRY POINTS IN CONTROL MEMORY FOR * THE 21XE AND THEIR ASSOCIATED MACROINSTRUCTIONS. * * TABLE ENTRY FORMAT: * * ENTRY POINT ADDRESS * MACRO TO THAT ADDRESS * XEMAP EQU * B20K OCT 20000 OCT 105700 OCT 21000 OCT 105200 OCT 21400 OCT 105220 OCT 22000 OCT 105240 OCT 22400 OCT 105260 OCT 23000 OCT 105300 OCT 23400 OCT 105460 OCT 24000 OCT 105320 OCT 26000 OCT 105340 OCT 26400 OCT 105360 OCT 27000 OCT 105440 OCT 27400 OCT 105500 OCT 30000 OCT 105520 OCT 30400 OCT 105540 OCT 31000 OCT 105560 OCT 34000 OCT 105600 OCT 34400 OCT 105620 OCT 35000 OCT 105640 OCT 35400 OCT 105660 OCT 36000 OCT 105140 OCT 37000 OCT 105160 OCT 0 END OF TABLE HED MESSAGES E.MSG ASC 2,MDE0 ERROR ERR# ASC 1,00 MESSAGE OCT 20137 SPACE AND BACK ARROW EHEAD OCT 6412 CR LF ASC 08,MDE ERROR CODES CRLF OCT 6412 CR LF OCT 6412 CR LF ASC 08,ERROR MEANING OCT 6412 CR LF EM000 ASC 05,MDE BREAK EM001 ASC 05,WCSLT FULL EM002 ASC 09,ILLEGAL PARAMETER EM003 ASC 07,WCS LU LOCKED EM004 ASC 08,NO RN AVAILABLE EM005 ASC 06,INPUT ERROR EM006 ASC 05,ILLEGAL LU EM007 ASC 07,ILLEGAL DEVICE EM008 ASC 09,ERROR # UNDEFINED EM009 ASC 07,LU # UNDEFINED EM010 ASC 15,CHECKSUM OR REC. FORMAT ERROR EM011 ASC 04,NO LU'S EM012 ASC 06,VERIFY ERROR EM013 ASC 04,NO DCPC EM014 ASC 08,INVALID ADDRESS EM015 ASC 08,ADDRESS CONFLICT EM016 ASC 06,DATA OVERRUN EM017 ASC 06,LU DISABLED EM018 ASC 06,FMP ERROR - MFMP ASC 02,0000 FMP ERROR CODE STUFFED HERE OCT 30040 ASCII ZERO  SPACE EM019 ASC 04,I/O ERR ASC 02,EOF ASC 02,EQT EQT# BSS 1 EQT NUMBER STUFFED HERE EM020 ASC 05,MICRO ERR MCERR BSS 1 MICRO ERROR # STUFFED HERE EM021 ASC 08,ILLEGAL REGISTER EM022 ASC 04,NO MACRO EM023 ASC 07,USER MICRO ERR EM024 ASC 05,BKTBL FULL MEND EQU * END OF EXPANSION MESSAGES SKP HEADR OCT 6412 CR LF ASC 19,COMPUTER TYPE: 1=21MX,2=21MX E-SERIES OCT 6412 CR LF ASC 06,TYPE(1 OR 2) OCT 37537 ASCII ? AND BACK ARROW M.LU OCT 6412 CR LF ASC 12,LU# RANGE STATUS MLU NOP LU NUMBER ASC 1, 2 SPACES MADR1 BSS 3 ASC 1,-- ASCII DASH DASH MADR2 BSS 3 ASC 1, 2 SPACES MSTAT OCT 20000 ASCII SPACE IN UPPER BYTE EPRMT ASC 1,$$ EDIT COMMANDS PROMPT "BAR" OCT 57400 AND BACK ARROW PMSG ASC 1,P+ PARAMETERS MESSAGE PPOS BSS 1 POSITION NUMBER STUFFED HERE "=.S" ASC 1,= PNUM BSS 4 PARAMETER VALUE STUFFED HERE RMSG ASC 05,RETURN= P+ RNUM BSS 1 POSITION NUMBER STUFFED HERE HED CONSTANTS,LINKS AND STORAGE "/" OCT 57 ASCII SLASH "B" OCT 102 ASCII LETTER B "D" OCT 104 ASCII LETTER D "E" OCT 105 ASCII LETTER E "F.S" OCT 43040 ASCII LETTER F AND SPACE "F.P" OCT 43056 ASCII LETTER F AND PERIOD "O" OCT 117 ASCII LETTER O "P" OCT 120 ASCII LETTER P "R" OCT 122 ASCII LETTER R $ OCT 22137 ASCII $ AND BACK ARROW .228 DEC 228 .255 DEC 255 .256 DEC 256 .3583 DEC 3583 .46 DEC 46 .511 DEC 511 .99 DEC 99 ADDRS BSS 1 CURRENT WCS ADDRESS ADRS1 BSS 1 LOWER WCS ADDRESS ADRS2 BSS 1 UPPER WCS ADDRESS B1 EQU .1 B10 EQU .8 B100 OCT 100 B10K OCT 10000 B100K OCT 100000 B101 OCT 101 B105 EQU "E" B106 OCT 106 B11 EQU .9 B120K OCT 120000 B14 EQU .12 B160 OCT 160 B17 EQU .15 B177 OCT 177 B200 OCT 200 B204 OCT 204 B22 P EQU .18 B23 EQU .19 B300 OCT 300 B36 EQU .30 B360 OCT 360 B37 EQU .31 B377 EQU .255 B40 OCT 40 B41 OCT 41 B55 OCT 55 B60 OCT 60 B61 OCT 61 B62 OCT 62 B66 OCT 66 B6777 EQU .3583 B7 EQU .7 B77 OCT 77 B777 EQU .511 BLANK EQU B40 ASCII SPACE COLON OCT 72 ASCII COLON COMMA OCT 54 ASCII COMMA CONWD BSS 1 TEMPORARY CONTROL WORD FOR EXEC CALLS COUNT BSS 1 INPUT CHARACTER COUNT CRLBL BSS 1 CARTRIDGE LABEL CTYPE NOP COMPUTER TYPE: 1=MX,100000=MX-E CW01 OCT 200 EXEC WRITE REQUEST CODE(NEEDS LU) CW02 OCT 100001 LOCK LU'S REQUEST CW04 OCT 400 EXEC READ REQUEST CODE(NEEDS LU) DIVSR BSS 1 DIVISOR FOR XCVAS DRT EQU 1652B LINK TO B.P. LINK TO DRT FDIG BSS 1 HOLDS DIGITS FOR XCVAS FIRST BSS 1 FIRST ADDRESS OF MDE MICROCODE FLAG1 BSS 1 STORAGE FOR FLAG VALUES FLAG2 BSS 1 STORAGE FOR FLAG VALUES FLAG3 BSS 1 STORAGE FOR FLAG VALUES FLAG4 BSS 1 STORAGE FOR FLAG VALUES FLAG5 BSS 1 STORAGE FOR FLAG VALUES LAST2 BSS 1 LINK TO LAST 2 INSTR'S IN MDE MICROCODE LDING NOP LEADING ZEROS FOR XCVAS LU BSS 1 CURRENT LU NUMBER LU# BSS 1 NUMBER OF LU'S IN THE WCSLT M.11 DEC -11 M.1K DEC -1024 M.27 DEC -27 M.512 DEC -512 M.80 DEC -80 M100 OCT -100 M160 OCT -160 M2 OCT -2 M20 OCT -20 M3 OCT -3 M30 OCT -30 M4 OCT -4 M40 OCT -40 M400 OCT -400 M40K OCT -40000 M60 OCT -60 M7 OCT -7 M72 OCT -72 MASK1 OCT 37400 MASK FOR MODULO 256 ADDRESSING MASK2 OCT 60100 MICRO-OBJECT CODE FORMAT IDENTIFIER MASK3 OCT 136757 16 LSB OF MX MICRO-NOP MASK4 OCT 036747 16 LSB OF XE MICRO-NOP MINUS EQU B55 ASCII MINUS SIGN NUMB BSS 1 RESULTS OF ASCII TO INTEGER CONVERSIONS NUMF BSS 1 COUNTER FOR XASCV ONE EQU B61 ASCII NUMBER 1 OUTLU BSS 1 LU OF OUTPUT DEVICE PLUS OCT 53 [ ASCII PLUS SIGN PNT02 DEF LUN11+1 LINK TO "CHKLU" CALL FROM LU COMMAND PNT03 DEF XBUFF LINK TO CONVERSION BUFFER PNT05 DEF CMNDS LINK TO COMMANDS TABLE PNT07 DEF ETABL LINK TO ERROR TABLE PNT08 DEF ERR# LINK TO ERROR NUMBER IN ASCII PNT09 DEF ENTAB LINK TO END OF ERROR TABLE PNT13 DEF LUN13+1 LINK TO "CHKLU" CALL FROM LU COMMAND PNT14 DEF MFMP LINK TO FMP CODE AREA IN MSG. "EM018" PNT15 DEF MADR1 LINK TO BASE ADDRESS IN MESSAGE "MLU" PNT16 DEF MADR2 LINK TO LAST ADDRESS IN MESSAGE "MLU" PNT18 DEF EQT# LINK TO EQT # IN MESSAGE "EM020" PNT20 DEF OBUFF+20 LINK TO 8 MSB OF OBJECT CODE PNT22 DEF OBUFF+22 LINK TO 16 LSB OF OBJECT CODE PNT23 DEF MCERR LINK TO MICRO ERROR # IN MSG EM020 PNT24 DEF CNNOP LINK TO CONDITION NOP PNT26 DEF PPOS LINK TO PARAMETER POSTION IN MSG "PMSG" PNT27 DEF PNUM LINK TO PARAMETER VALUE IN MSG "PMSG" PNT28 DEF PNUM+3 LINK TO POSITION DEF IN MSG "PMSG" PNT29 DEF RMSG LINK TO RETURN MESSAGE "RMSG" PNT30 DEF OBUFF+40 LINK TO INPUT REGISTERS TABLE PNT31 DEF RUN02 LINK TO BREAKPOINT RETURN POINT PNT33 DEF RNUM LINK TO RETURN POSITION IN MSG "RMSG" PNT34 DEF BKTBL LINK TO BREAKPOINTS TABLE PNT37 DEF MXCOD LINK TO 21MX BREAKPOINT MICROCODE PNT38 DEF XECOD LINK TO 21XE BREAKPOINT MICROCODE PNT39 DEF XEMAP LINK TO XE MAP TABLE PNT41 DEF MXMAP LINK TO MX MAP TABLE RADIX BSS 1 NUMBER BASE FOR XCVAS RDXM1 BSS 1 RADIX-1 FOR XASCV RENTR BSS 1 RE-ENTRY ADDRESS IN CONTROL STORE SAVE0 BSS 1 TEMPORARY STORAGE SAVE1 BSS 1 TEMPORARY STORAGE SAVE2 BSS 1 TEMPORARY STORAGE SAVE3 BSS 1 TEMPORARY STORAGE SAVE4 BSS 1 TEMPORARY STORAGE SAVE5 BSS 1 TEMPORARY STORAGE SAVE6 BSS 1 TEMPORARY STORAGE SECOD BSS 1 SECURITY CODE TWO EQU B62 ASCII NUMBER 2 UP.XE OCT 37777 UPPER LIMIT OF CONTROL MEMORY ON XE VAL BSS 1 ACCUMULATOR FOR XASCV & <:6XCVAS WLOG BSS 1 (# OF MICROINSTRUCTIONS) X 2 XFER BSS 1 TRANSFER LENGTH XCHAR BSS 1 CURRENT CHARACTER XDADR BSS 1 DESTINATION BUFFER ADDRESS XDCNT BSS 1 DESTINATION CHARACTER COUNT XDLNG BSS 1 DESTINATION CHARACTER LENGTH XSADR BSS 1 SOURCE BUFFER ADDRESS XSCNT BSS 1 SOURCE CHARACTER COUNT XSLNG BSS 1 SOURCE CHARACTER LENGTH ZERO EQU B60 ASCII ZERO ZEROS ASC 1,00 ASCII 00 END R< u 92062-18009 1805 S 0122 &LP31 SUBROUTINE FOR 2631/2635 PRINTER             H0101 w^ASMB,X,L,C * * * FILE NAME: %LP31 (RELOCATABLE) &LP31 (SOURCE) * BINARY: 92062-16003 * SOURCE: 92062-18009 * NAM LPCON,7 92062-16003 REV. 1805 5-19-77 * * CONSTANT DEFINITION AND TEMPORARAY STORAGE * .A. EQU 0 .B. EQU 1 ENT LPCON EXT .ENTR EXT .MPY EXT .DST EXT EXEC BUFFR BSS 245 LEN BSS 1 DTYPE BSS 1 BAL OCT 057400 BAR OCT 000137 TEMP BSS 1 DEFLT OCT 015532 OCT 015446 OCT 062100 OCT 015463 OCT 015450 OCT 040033 OCT 024501 OCT 015446 OCT 065460 OCT 051433 OCT 023154 OCT 033104 NCHR OCT 000030 DCNT OCT 000014 R BSS 2 M1 OCT 177777 M9 OCT 177767 B11 OCT 000011 BPNTR DEF BUFFR LESC OCT 015400 PNTR BSS 1 CNT BSS 1 I BSS 1 .1 OCT 000001 .240 OCT 000360 M241 OCT 177417 ESC3 OCT 015463 .2 OCT 000002 CRSP OCT 006440 SPSP OCT 020040 M5 OCT 177773 ONECR OCT 030415 .4 OCT 000004 ESC1 OCT 015461 .3 OCT 000003 CRLFT OCT 006400 M3 OCT 177775 B130 OCT 000130 M2 OCT 177776 B50 OCT 000050 B40K OCT 040000 B51 OCT 000051 .5 OCT 000005 B46 OCT 000046 LDC OCT 062103 .6 OCT 000006 LK0 OCT 065460 SLFT OCT 051400 .7 OCT 000007 LL0 OCT 066060 DLFT OCT 042000 .8 OCT 000010 DFPTR DEF DEFLT B1652 OCT 001652 CHAN BSS 1 B37 OCT 000037 EQT BSS 1 B77 OCT 000077 B17 OCT 000017 B1650 OCT 001650 CMDW BSS 1 B12 OCT 000012 B2K OCT 002000 MLEN BSS 1 BM.5K OCT 177400 XTEM BSS 1 B377 OCT 377 TFLAG NOP SKP * THIS SUBROUTINETAKES SIMPLE COMMANDS FROM CALLING PROGRAM * AND CONVERTS THEM TO ESCAPE SEQUENCES TO CONTROL THE AUXIALLARY * FUNCTIONS OF THE 2631A NOT SUPPORTED BY DVA12. * * * * * * CALLING SEQUENCE FOR THE SUBROUTINE IS * CALL LPCON(LU,CODE,DATA) * * WHERE CODE IS AN INTEGER SPECIFYING FUNCTION * LU IS THE LOGICAL UNIT NUMBER OF THE DEVICE * DATA IS THE PROPER DATA FOR THE CODE * SKP * LEGAL VALUES FOR CODE AND DATA ARE * * CODE DATA ACTION * !-------------------------------------------! * ! 1 +N SET TAB AT ! * ! COLUMN N ! * ! 1 -N CLEAR TAB AT ! * ! COLUMN N ! * ! 1 0 CLEAR ALL TABS ! * ! ! * ! 2 1 ENABLE DISPLAY ! * ! FUNCTIONS ! * ! 2 2 DISABLE DISPLAY ! * ! FUNCTIONS ! * ! 3 0 SELECT PRIMARY CHAR ! * ! SET 0 ! * ! 3 1 SELECT PRIMARY CHAR ! * ! SET 1 ! * ! 4 0 SELECT SECONDARY CHAR ! * ! SET 0 ! * ! 4 1 SELECT SECONDARY CHAR ! * ! 5 0 DISABLE UNDERLINING ! * ! ! * ! 5 1 ENABLE UNDERLINING ! * ! ! * ! 6 0 PRINT NORMAL SIZE ! * ! ! * ! 6 1 PRINT EXPANDED SIZE ! * ! ! * ! 6 2 PRINT COMPRESSED ! * ! ! * ! 7 0 SELECT 12 LINES PER IN. ! * ! ! * ! 7 1 SELECT 1 LINE PER IN. ! * ! ! * ! 7 2 SELECT 2 LINES PER IN. ! * ! ! * ! 7 3 SELECT 3 LINES PER IN. ! * ! ! * ! 7 4 SELECT 4 LINES PER IN. ! * ! ! * ! 7 6 SELECT 6 LINES PER IN. ! * ! ! * ! 7 8 SELECT 8 LINES PER IN. ! * ! ! * ! 8 - SET PRINTER TO 6 LPI, ! * ! NORMAL PRINT, PRIMARY ! * ! SET 0, SECONDARY SET 1 ! * ! DISABLE DISPLAY FUNC., ! * ! DISABLE UNDERLINING ! * ! CLEAR ALL TABS ! * !-------------------------------------------! * * SKP LU NOP CODE NOP DATA NOP LPCON NOP JSB .ENTR DEF LU CLA CLEAR TAB FLAG STA TFLAG LDA CODE,I CHECK TO SEE IF ADA M1 CODE IS WITHIN LDB CODE,I BOUNDS ADB M9 SSB CLB,RSS CCB SSA,RSS CLA,RSS CCA IOR .B. SZA,RSS IS CODE IN BOUNDS JMP OKB YES, GO ON LDA B11 NO, SET ERROR FLAG STA CODE,I JMP REJCT TELL THE CALLING PROGRAM OKB LDA LESC INITIALIZE THE BUFFER STA BPNTR,I * * SET AND CLEAR TABS * LDA CODE,I IS CODE = 1? CPA .1 RSS YES, SET UP TAB COMMAND JMP CH2 NO, LOOK AT NEXT VALUE LDA DATA,I PICK UP DATA VALUE ADA .240 IS IT WITHIN LDB DATA,I LEGAL BOUNDS ADB M241 (LEGAL = -2400 CMA,INA SSA,RSS ? JMP SKP1 NO, SKIP BUFFER FILL CLA,INA SET LOOP INDEX STA I TO ONE JMP FILL AND START TO FILL BUFFER LP1 LDA I INCREMENT COUNTER INA STA I FILL CMA,INA CHECK TO SEE ADA CNT IF WE ARE DONE SSA ? JMP SKP1 YES, EXIT LOOP LDA I CALCULATE STORAGE LOCATION ADA BPNTR LDB SPSP AND STORE SPACES IN IT STB .A.,I JMP LP1 LOOP BACK SKP1 LDA PNTR IS POINTER = 0 SZA ? JMP SKP2 NO, LEAVE EXTRA SPACE LDA CNT YES, TURN LAST SPACE INTO ESCAPE ADA BPNTR FIND ADDRESS OF LAST SPACE LDB .A.,I PICK UP VALUE ADB M5 MAKE AN ESCAPE STB .A.,I PUT IT BACK LDB LEN PICK UP CLEAR FLAG BLF,BLF ROTATE INTO POSITION ADB ONECR MAKE TAB COMMAND INA IN THE ARRAY STB .A.,I LDA DATA,I SET THE MESS9 AGE LENGTH ADA .4 AND STORE STA LEN FOR OUTPUT JMP OUT GO TO OUTPUT SKP2 LDA ESC1 SET UP TAB COMMAND ADA LEN LDB CNT AND STORE FOR OUTPUT INB ADB BPNTR STA .B.,I LDA CRLFT APPEND CARRIAGE RETURN INB STA .B.,I AND SAVE IN BUFFER LDA DATA,I SAVE OUTPUT COUNT ADA .4 STA LEN JMP OUT GO OUTPUT IT CH2 LDA CODE,I CHECK FOR A CODE OF 2 CPA .2 IS IT 2 RSS YES,SET UP DISPLAY FUNCTIONS JMP CH3 NO, GO CHECK FOR 3 LDA DATA,I IS DATA VALID ADA M1 I.E. EITHER 1 OR 2 LDB DATA,I ADB M3 SSB CLB,RSS CCB SSA,RSS CLA,RSS CCA IOR .B. SZA ? JMP REJCT NO, GO TELL CALLING PROGRAM LDA B130 YES, CONSTRUCT ESCAPE SEQUENCE ADA DATA,I IOR BPNTR,I STA BPNTR,I SAVE FOR OUTPUT LDA .2 SET LENGTH STA LEN FOR OUTPUT JMP OUT GOT OUTPUT LINE CH3 LDA CODE,I CHECK FOR CODE = 3 CPA .3 IS IT EQUAL RSS YES, SET UP PRIMARY CHARACTER SET COMMAND JMP CH4 NO,CHECK FOR 4 LDA DATA,I CHECK FOR DATA WITHIN BOUNDS LDB DATA,I ADB M2 SSB CLB,RSS CCB SSA,RSS CLA,RSS CCA IOR .B. SZA IS IT IN BOUNDS JMP REJCT NO, GO TELL CALLING PROGRAM LDA BPNTR,I YES, SET UP COMMAND IOR B50 STA BPNTR,I LDA DATA,I CONSRUCT SET SELECTION ALF,ALF ADA B40K LDB BPNTR SAVE IT FOR OUTPUT INB STA .B.,I LDA .3 SET MESSAGE LENGTH STA LEN AND SAVE JMP OUT GO OUTPUT IT CH4 LDA CODE,I IS IT A 4 CPA .4 RSS YES, LOOKS GOOD JMP CH5 NO, GO CHECK FOR 5 LDA DATA,I IS DATA WITHIN BOUNDS LDB DATA,I ADB M2 SSB CLB,RSS CCB SSA,RSS CLA,RSS CCA IOR .B. SZA CHECK IT JMP REJCT NO, GO TELL THE WORLD LDA BPNTR,I YES, SET UP COMMAND IOR B51 STA BPNTR,I AND SAVE IT LDA DATA,I CONSTRUCT SET COMMAND ALF,ALF ADA B40K LDB BPNTR AND SAVE IT INB STA .B.,I LDA .3 SET UP COUNT VALUE STA LEN AND SAVE IT JMP OUT GO OUTPUT IT CH5 LDA CODE,I LET'S CHECK FOR 5 CPA .5 ? RSS YEP, SET UP UNDERLINE COMMAND JMP CH6 NO, GO CHECK FOR 6 LDA DATA,I IS DATA WITHIN BOUNDS LDB DATA,I ADB M2 SSB CLB,RSS CCB SSA,RSS CLA,RSS CCA IOR .B. SZA WELL IS IT JMP REJCT NO, GO TELL THE WORLD LDA BPNTR,I YES, SET UP COMMAND IOR B46 STA BPNTR,I LDA LDC SET REST OF COMMAND ADA DATA,I IN BUFFER LDB BPNTR INB STA .B.,I LDA .4 SET UP COUNT STA LEN FOR OUTPUT JMP OUT GO DUMP IT CH6 LDA CODE,I LET'S LOOK FOR 6 CPA .6 IS IT? RSS YES, SET UP PRINT SIZE JMP CH7 NO, GO LOOK AT 7 LDA DATA,I IS DATA WITHIN BOUNDS LDB DATA,I ADB M3 SSB CLB,RSS CCB SSA,RSS CLA,RSS CCA IOR .B. SZA WELL IS IT JMP REJCT NO, GO TELL THE WORLD LDA BPNTR,I YES, SET UP SIZE COMMAND IOR B46 STA BPNTR,I AND SAVE IT LDA LK0 SET SECOND WORD ADA DATA,I LDB BPNTR INB STA .B.,I AND STORE IT INB LDA SLFT SET THIRD WORD STA .B.,I AND STORE IT LDA .5 SET COUNT STA LEN AND STORE sIT JMP OUT OUTPUT IT CH7 LDA CODE,I CHECK FOR 7 CPA .7 IS IT RSS YES, SET IT UP JMP CH8 NO, GO CHECK FOR 8 LDA DATA,I IS DATA IN BOUNDS LDB DATA,I CPB .5 CCB,RSS CLB SSA,RSS CLA,RSS CCA IOR .B. LDB DATA,I CPB .7 CCB,RSS CLB IOR .B. LDB DATA,I ADB M9 SSB CLB,RSS CCB IOR .B. SZA IS IT JMP REJCT NO, GO TELL THE WORLD LDA BPNTR,I YES, SET UP LINE DENSITY COMMAND IOR B46 STA BPNTR,I SAVE IT LDA LL0 PICK UP SECOND WORD ADA DATA,I SELECT WHICH ONE LDB BPNTR INB STA .B.,I SAVE IT LDA DLFT PICK UP THIRD WORD INB STA .B.,I SAVE IT LDA .5 SAVE LENGTH STA LEN JMP OUT OUTPUT IT CH8 LDA CODE,I ARE WE AT 8 CPA .8 RSS YES SET DEFAULT JMP OUT NO GO AWAY CLA,INA INITILIZE COUNTER STA I LDA DFPTR SET UP DEFAULT POINTER STA PNTR LDB BPNTR INITIALIZE BUFFER POINTER JMP XFR START TRANSFER LP5 LDA I INCREMENT COUNTER INA STA I XFR LDA I CMA,INA ARE WE THROUGH ADA DCNT SSA JMP SLN YES, SET LENGTH AND EXIT LDA PNTR,I PICK UP DEFAULT VALUE STA .B.,I AND SAVE IN BUFFER ISZ PNTR MOVE POINTERS INB JMP LP5 GO FINISH SLN LDA NCHR SET COUNT STA LEN OUT LDA LEN CALCULATE WORD COUNT ARS,ALS CHECK FOR ODD COUNT CMA,INA ADA LEN STA CNT SAVE ODD-EVEN FLAG LDA LEN CALCULATE WORD COUNT ARS DIVIDE BY 2 STA TEMP SAVE FOR FUTURE USE LDA B1652,I FIND DEVICE TYPE AND CHANNEL STA PNTR ADA -LU,I FIND DRT ENTRY ADA M1 STA PNTR SAVE POINTER TO DRT ENTRY LDA PNTR,I PICK UP DRT ENTRY ALF,RAL SELECT SUBCHANNEL AND B37 AND MASK IT OFF STA CHAN SAVE IT FOR LATER LDA PNTR,I PICK UP DRT WORD AGAIN AND B77 MASK OF EQT NUMBER STA EQT AND SAVE FOR LATER CCA CALULATE EQT LOCATION ADA EQT JSB .MPY DEF B17 ADA B1650,I ADD IN EQT STARTING ADDRESS ADA .4 LOOK AT 5TH WORD STA PNTR AND SAVE ADDRESS LDA PNTR,I PICKUP UP EQT WORD 5 ALF,ALF SELECT DEVICE TYPE AND B77 AND ISOLATE IT STA DTYPE AND SAVE FOR FUTURE REFERENCE LDA LU,I SET COMMAND WORD FOR EXEC CALL STA CMDW AND SAVE LDA DTYPE CHECK DEVICE TYPE CPA B12 IS IT TYPE 12 RSS YES, SELECT HONESTY MODE JMP CH12 NO,GO CHECK FOR ANOTHER TYPE LDA B2K PICKUP HONESTY BIT ADA LU,I ADD LU STA CMDW AND SAVE COMMAND WORD CH12 LDA DTYPE CHECK DEVICE TYPE FOR CHARRIAGE SUPPRESSION LDB DTYPE STA MLEN LDA CHAN SZA IS SUBCHANNEL = 0 CLA,RSS NO, FAIL TEST CCA YES, PASS TEST CPB .5 IS THIS TYPE 5 CCB,RSS YES, PASS TEST CLB NO, FAIL TEST AND .B. BOTH TRUE? LDB MLEN KEEP CHECKIN SZB,RSS DEVICE TYPE 0? CCB,RSS YES, PASS TEST CLB NO, FAILS TEST IOR .B. DEVICE TYPE 0 OR DEVICE TYPE 5 SUBCHANNEL 0 LDB DTYPE ONE MORE CHECK CPB B37 LET'S CHECK FOR DEVICE TYPE 37 CCB,RSS YES, THAT'S FINE CLB NO, FORGET IT IOR .B. ANY ONE OF THE 3 SZA,RSS CHECK TO SEE IF IT IS JMP VAL NO, GO CHECK FOR VALID TYPE AT ALL LDA CNT DO WE HAVE CPA r.1 AND ODD COUNT RSS YES, PUT BACK ARROW IN RIGHT BITE JMP ABA NO, APPEND BACK ARROW LDB TEMP PICK UP BUFFER ADDRESS ADB BPNTR ADD BUFFER BASE ADDRESS LDA .B.,I PICK UP CURRENT VALUE AND BM.5K MASK OFF LOWER BITE ADA BAR PUT ON BACKARROW STA .B.,I SAVE BACK IN BUFFER LDA LEN INCREMENT LENGTH TO REFLECT ADDITION INA STA LEN AND SAVE JMP RITE GO OUTPUT IT ABA LDA TEMP SET BACK ARROW ADA BPNTR INTO BUFFER LDB BAL FOR CARRIAGE STB .A.,I CONTROL LDA LEN AND INCREMENT INA LENGTH TO REFLECT STA LEN ADDITION JMP RITE GO WRITE IT OUT VAL LDA DTYPE LET'S SEE LDB DTYPE IF WE HAVE STA XTEM A VALID DEVICE AT ALL LDA CHAN CHECK FOR TYPE 5 SUB CHANNEL CPA .4 4 OR CCA,RSS TYPE 12 CLA CPB .5 CCB,RSS IT'S A 5 CLB AND .B. IF WE HAVE ALL ONES LDB XTEM IT'S A 5-4 CPB B12 OTHERWISE IT'S GOT CCB,RSS TO BE A 12 CLB IOR .B. OR WE ARE NOT TALKING SZA HOW DID WE DO? JMP RITE ALL RIGHT GO OUTPUT IT LDA B11 TO BAD FLAG IT NO-CAN-DO STA CODE,I AND TELL THE WORLD JMP REJCT RITE LDA TFLAG PICK UP TAB FLAG SSA,RSS IS IT SET? JMP NORM NO, GO DO THINGS NORMALLY LDA CHAN YES, WHAT INTERFACE ARE WE USING CPA .4 SUBCHANNEL 4 CCA,RSS YES, SET A REGISTER CLA NO, RESET A REG. LDB DTYPE DEVICE TYPE 5? CPB .5 LET'S LOOK CCB,RSS YES, SET B CLB NO, RESET B AND .B. ARE BOTH SATISFIED? SZA,RSS EITHER ONE HERE? JMP NORM NO, GO DO THE NORMAL THING LDA BPNTR,I YES, CLEAR I<:6NITIAL CARRIAGE RETURN AND B377 STA BPNTR,I AND SAVE IT BACK JSB EXEC NO, PUT CR OUT TO DVRO5 SUB 4 DEF *+5 DEF .2 DEF CMDW DEF CRLFT DEF M1 JMP NORM NORM LDA LEN SET UP THE WRITE COUNT CMA,INA STA MLEN AND SAVE IT JSB EXEC GO WRITE IT OUT DEF *+5 DEF .2 DEF CMDW DEF BUFFR DEF MLEN JSB .DST LOOK AT THE TRANSMISSION LOG DEF R CLA SET NORMAL COMPLETION STA CODE,I INTO CODE VALUE JMP LPCON,I AND GO BACK REJCT LDA CODE,I SET REJECTION CODE CMA,INA COMPLEMENT IT STA CODE,I AND SEND IT BACK JMP LPCON,I GO TELL THEM THEY BLEW IT END <  92062-18010 1840 S 0122 &DVB12              H0101 C`ASMB,R,L,C,N 2608A RTE DRIVER NAM DVB12,0 92062-16004 REV. 1840 780707 ENT IB12,CB12,BLAB EXT $UPIO * EXT $DDT ************************************************************ * THE ASMB STATEMENT NEED ONLY CHANGE TO THE "Z" OPTION TO * SUPPORT THE OPTIONAL IFORM PARAMETER * * * 2608 DRIVER DVB12 BY G C GAPP * * * IB12 NOP INITIATION ENTRY JSB SETIO CONFIGURE WITH CURRENT CHAN. # JSB TMOUT SET TIMEOUT VALUE CLA,INA JSB STAT CHECK PRINTER STATUS JMP NREDI NOT READY--GO REPORT IT * LDA EQT4,I EXTRACT THE SUBCHANNEL NUM AND M3700 CPA M300 DOES SUBCHANNEL = 3? RSS YES - CONTINUE FOR CHAR READ ON SC2 JMP RCODX NO - GO LOOK AT REQ CODE LDA EQT6,I NOW LOOK FOR CHAR SET READ AND M3777 CPA D1 READ CHAR SET? JMP CBSC3 YES - CHAR RD + SC3 IS OK CPA M201 NO - THEN IS IT READ STATUS? JMP PSTAT YES - RD STAT + SC3 IS OK JMP EXREJ ALLOW ONLY RD STAT & RD CHAR ON SC3 RCODX CCB SETUP TO CLEAR TOF BIT6 IN STATUS LDA EQT6,I GET FUNCTION AND REQUEST CODE AND M77 SAVE REQUEST CODE CPA D1 IS IT A READ REQUEST? JMP CBACK READ - GO GET CHARACTER SET CPA D2 WRITE REQUEST? JMP WRITE YES--GO PROCESS CPA D3 CONTROL REQUEST? JMP CNTRL YES--GO PROCESS EXREJ LDA D1 ILLEGAL REQUEST CODE, SET A=1 JMP IB12,I EXIT * CLRB8 ISZ EQT8,I TLOG = 1 FOR CHAR READ OF 0 CLRBX CLA XLOG OF XERO STA EQT8,I CLRBF LDA CLBUF BUFFER CLEAR COMMAND LDB DCLR RETURN ADDRESS JMP EXITI DCLR DEF EXIT5 * NREDI JSB VSTAT UPDATE PRINTER STATUS LDA D3 SET NOT READY RETURN JMP IB12,I EXIT SKP * * READ IN CHAR SET CBACK LDA EQT6,I GET CWD ALF,ALF GET PING/PONG TO BIT15 RAL AND ST RD/CHAR RD TO BIT0 SSA PING/PONG? JMP PINPO YES - DO P/P SLA NO - THEN IS IT A STAT READ? JMP PSTAT YES - DO STATUS READ CBSC3 LDA EQT6,I IOR M100 FORCE BIT6 SET FOR PACKED FLAG LDB EQT8,I BUFFER LENGTH SZB,RSS BUF LENGTH = 0? ISZ EQT8,I YES - SET LENGTH 0 = 1 SSB,RSS PACKED OR UPPACKED REQUEST? JMP CBA UNPACKED - CLEAR BIT6 & BUFL IS OK CMB,INB PACKED -BIT6 OK BUT NEED POS BUFL STB EQT8,I EQT8 IS FOR XLOG(MAYBE) RSS BYPASS CLEAR OF BIT6 CBA XOR M100 FORCE BIT6 CLEAR FOR UNPACKED STA EQT6,I LDA EQT9,I IPRAM ALF MOVE CHAR SET CODE TO BITS0-3 AND M17 EXTRACT THEM XOR CHARB MERGE IN THE READBACK CONTROL WORD LDB CBI A=CMND B=RET ADDRESS JMP EXITI CBI DEF CBR CBR LDA M1153 MAX EVER OF # OF BYTES AVAILABLE STA EQT13,I JSB INTOA READ THE ACTUAL CHAR SET CODE ALF,ALF CHAR SET CODE TO BOTTOM LDB EQT7,I BUFFER ADDRESS STA B,I 1ST WORD RIGHT JUSTIFIED IN BUFF ISZ EQT7,I ADJUST ADDRESS FOR 1ST DOT DATA LDB EQT8,I USE B INSTEAD OF EQT8 TO SAVE SZB,RSS BUFF LENGTH = ZERO? JMP CLRB8 YES - GO SET TLOG =1 FOR ZERO ADB ND1 DECREASE BY ONE SZB,RSS BUFF LENGTH = ONE? JMP CLRBF YES - DO CLEAR BUFFER & EXIT LDA EQT9,I EXTRACT 1ST REQED CHAR CODE AND M177 RANGE IS 0 THRU 177B SZA,RSS WAS A CODE SUPPLIED? JMP CBX NO - READ STARTING WITH FIRST CMA,INA YES - MAKE CODE FOR 1ST CHAR NEG STA EQT12,I CB1 LDB ND9 9 BYTES PER CHAR CB2 JSB INTOA GET A BYTE ISZ EQT13,I LAST POSSIBLE BYTE? RSS NO - CONTINUE JMP CLRBX YES - EJECT ISZ B 9T-nH BYTE? JMP CB2 NO - GET NEXT ISZ EQT12,I YES - DONE WITH DUMP? JMP CB1 NO - LOOP FOR 9 MORE BYTES * IF NECESSARY - ADJUST USER BYTE COUNT TO REMAIN BYTES CBX LDA EQT13,I # OF BYTES YET POSSIBLE(NEG) LDB EQT8,I # OF BYTES REQUESTED (POS) ADB A CMA,INA MAKE BYTES LEFT POS IN CASE SKIP SSB,RSS ADJUST EQT13 IF REM CNT > REQUEST JMP CBX1 NOT NECESSARY LDA EQT8,I NEGATE USER COUNT CMA,INA STA EQT13,I USE AS REMAINING COUNT RSS CBX1 STA EQT8,I WILL BE XLOG * * CBCON LDA EQT11,I IOR M4 SET CHAR READBACK FLAG IN EQT11 STA EQT11,I LDB EQT13,I ANY READBACK LEFT? SZB,RSS JMP EXIT5 NO - EXIT CLE TOP OF WORD CB4 LDA EQT7,I SET UP USER BUFFER ADDRESS STA EQT10,I LDA ND9 GET DOT ROWS/CHAR COUNTER STA EQT12,I SAVE IT CB5 JSB INTOA READ FROM THE PRINTER LDB EQT6,I LOOK AT BIT6 OF EQT6 FOR BLF,BLF UNPACKED/PACKED FLAG(0/1) RBL BIT6 TO SIGN SSB IS IT PACKED? JMP PDATA YES - PROCESS PACKED DATA ALF,ALF NO - MOVE TO BOTTOM OF WORD CCE SET E FOR EXIT LDB EQT10,I B = BUFFER ADDRESS JMP UNPAK UNPACKED READ * * PDATA LDB LOBYT A=CHAR IN TOP - B=MASK IN BOTTOM SEZ,RSS TOP OF WORD? JMP PD1 YES - THEN A & B OK! ALF,ALF NO - MOVE CHAR TO BOTTOM BLF,BLF & MASK TO TOP PD1 STA STAT CHARACTER STB BUFL MASK LDB EQT10,I BUFFER ADDRESS LDA B,I GET ITS CONTENTS AND BUFL SAVE OLD DATA IOR STAT MERGE IN NEW DATA * UNPAK STA B,I RESTORE IN USERS BUFFER ISZ EQT13,I ANY CHARS LEFT? RSS YES JMP CLRBF NO - EXIT READBACK ISZ EQT10,I UPDATE BUFFER INDEX ISZ EQT12,I JDONE WITH 9 DATA BYTES? JMP CB5 NO - GET NEXT DATA BYTE SEZ,CME,RSS CHECK IF STILL NEED BOTTOM OF PACKED DATA JMP CB4 YES- GET 9 MORE BYTES INB NO - UPDATE USER BUFF POINTER FOR STB EQT7,I NEXT CHARACTER(IF ANY) JMP EXIT1 RETURN TO SYS * PSTAT LDA EQT8,I # OF BYTES OF STATUS REQED SSA DID IT COME AS POS COUNT? JMP EXREJ NO - REJECT IT! SZA,RSS LENGTH = ZERO? INA YES - CONVERT TO 1 STA EQT8,I SAVE FOR XLOG LDB D127 CMA,INA MAKE COUNT NEGATIVE ADA D127 ADD 127 SSA IS USER COUNT>127 STB EQT8,I YES-RESET WITH MAX LDA EQT8,I GET DESIRED # OF STATUS WORDS IOR STATR BUILD STAT RDBK CNWD LDB SRBKI A=CNWD B=RET ADD JMP EXITI SRBKI DEF SRBKR SRBKR LDB EQT8,I # OF BYTES TO RETURN CMB,INB USE AS BYTE COUNT YET TO GO STB EQT9,I LDB EQT7,I BUFFER ADDRESS RSTA2 JSB INTOA GET A BYTE OF THE ROCK ALF,ALF TO THE BOTTOM STA B,I PUT IN USERS BUFFER ISZ B UPDATE ADDRESS ISZ EQT9,I DONE? JMP RSTA2 NO - GO BACK JMP EXIT5 YES - EXIT * * PINPO LDA EQT8,I GET USERS BUFFER LENGTH CPA D1 BUFFER LENGTH = 1 ? JMP P1 YES-CONTINUE CPA M401 BUFFER LENGTH = 257 ? RSS YES-CONTINUE JMP EXREJ NO-REJECT REQUEST P1 LDA PING "PING" CONTROL WORD LDB PIADD A=CWD B=RET ADDRESS JMP EXITI PIADD DEF PIRET PIRET CLA INITIALIZE CHARACTER COUNT OUTCH JSB OUTA OUTPUT CHARACTER TO PRINTER INA INCREMENT CHARACTER COUNT CPA M400 A = 256 ? JMP PON YES-PING DONE, NOW PONG JMP OUTCH NO-OUTPUT ANOTHER CHARACTER PON LDA PONG "PONG" CONTROL WORD LDB POADD A=CWD B=RET ADDRESS nJMP EXITI POADD DEF PORET PORET CLA STA EQT12,I INITIALIZE PASS/FAIL CODE WORD STA EQT13,I INITIALIZE CHARACTER COUNTER LDA EQT7,I GET USERS BUFFER ADDRESS STA SETIO STORE TEMPORARILY INCH JSB INTOA INPUT CHARACTER FROM PRINTER ALF,ALF CHARACTER TO BOTTOM AND LOBYT SAVE LOWER BYTE LDB EQT8,I GET USERS BUFFER LENGTH CPB D1 BUFFER LENGTH = 1 ? JMP P2 YES-DONT SAVE CHARACTER ISZ SETIO NO-PUT CHARACTER IN USERS BUFFER STA SETIO,I P2 CPA EQT13,I IS RETURNED CHARACTER CORRECT ? RSS YES-CONTINUE ISZ EQT12,I NO-INCREMENT ERROR COUNT LDA EQT13,I GET CHARACTER COUNTER CPA LOBYT = 255 ? JMP EXIT6 YES-PONG DONE,FINISH UP ISZ EQT13,I NO-INCREMENT CHARACTER COUNTER JMP INCH GO INPUT ANOTHER CHARACTER EXIT6 LDA EQT12,I GET PASS/FAIL CODE WORD SZA DID PONG FAIL ? IOR M100K YES-TURN ON BIT 15 LDB EQT7,I GET USERS BUFFER ADDRESS STA B,I PUT CODE WD IN 1ST WORD OF BUFFER JMP CLRBF CLEAR BUFFER AND EXIT * * ************************************************************ * * WRITE PROCESSOR * * WRITE LDA EQT6,I GET ICNWD AND B1000 EXTRACT VFC DEFINE BIT9 DEF BITS SZA VFC DEFINE? JMP VDEF YES - PROCESS IT! JSB TOFB6 CLEAR TOF STATUS (B=-) JSB BUFL CONVERT IBUFL TO CHARACTER COUNT LDA EQT11,I SEE IF MODE = GRAPHICS ALF,ALF AND M17 EXTRACT MODE CPA M2 GRAPHICS? RSS YES - THEN PROCESS IFORM JMP WRITR NO * IFZ LDA EQT9,I AND LOBYT EXTRACT BITS 0 THRU 7 OF IFORM SZA,RSS ANYTHING SUPPLIED? CLA,INA NO - DEFAULT IS SLEW 1 DOT ROW IOR CALPH CONTROL WORD FOR GRAPHICS PRINT XIF * IFN LDA M1001 GRAPHICS DEFAULT = 1DOT ROW SLEW XIF * JMP WRIT3 WRITR LDB CALPH SLEW 0 COMMAND LDA EQT11,I AND M200 ISOLATE SUPPRESS SPACE BIT SZA,RSS IS IT REQUESTED? JMP WRITT NO - GO CHECK FOR AUTO EJECT XOR EQT11,I YES - CLEAR THE FLAG STA EQT11,I JMP WRITU WRITT ADB M202 BUILD VFC CH3 CMND LDA EQT11,I BIT1 OF EQT11 IS AUTO EJECT FLAG RAR,SLA IS IT ON(=0) OR OFF(=1) LDB M1001 OFF - USE SLEW 1 FLAG WRITU STB EQT10,I * IFZ LDA EQT9,I GET IFORM SZA,RSS DID USER SUPPLY IFORM? JMP WRITW NO AND LOBYT ISOLATE LOW 8 BITS IOR CALPH ADD BIT15 TO FORM CMND JMP WRIT3 BYPASS FURTHER CHECKS XIF * WRITW LDA EQT6,I GET ICNWD ALF,ALF MOVE V-BIT TO HIGH BIT BLAB SSA SKIP IF NOT SET JMP WRIT5 GO PROCESS REQULAR PRINT * * LDA EQT13,I SZA,RSS ARE THERE ANY CHARACTERS? JMP WRIT5 NO - GO PRINT LDB EQT7,I GET FIRST WORD LDA B,I AND HIBYT SAVE FIRST BYTE CPA EJCT JMP FF GO DO FORM FEED (CC=1) CPA DSPAC JMP DBLE GO DO DOUBLE SPACE (CC=0) CPA ASTR JMP SUP GO DO SUPPRESS SPACE (CC=*) JMP VB2 DEFAULT TO BLANK OR ANY OTHER CHAR FF LDA TOF GET VFC CH3 CMND LDB EQT13,I LOAD CHARACTER COUNT INB AND INCREMENT SZB WAS THERE ONLY ONE CHARACTER JMP DBLE+1 NO - CONTINUE STB EQT13,I YES - UPDATE CHARACTER COUNT JSB TOFB6 SET TOF ON LAST CMND STATUS(B=+) JMP EXOTA AND GO DUMP COMMAND DBLE LDA EQT10,I VFC CH3 OR SLEW 1(AUTO EJECT?) LDB DVBIT RETURN ADDRESS JMP EXITI DVBIT DEF VB2 SUP LDA M100K SLEW 0 CMND STA EQT10,I VB2 ISZ EQT13,I BUMP CHAR. CNTR. RSS SKIP IF NOT ZERO JMP WRIT5 ONLY O NE CHAR. LDA B,I GET FIRST WORD OF USER'S DATA AND LOBYT SAVE SECOND WORD JSB OUTA GIVE IT TO PRINTER INB BUMP ADDRESS STB EQT7,I RETURN IT ISZ EQT13,I BUMP CHAR COUNT NOP JMP WRIT5 SKP * * * * ROUTINE TO DUMP VFC DEF. DATA TO PRINTER * * VDEF LDA EQT8,I GET IBUFR AND LOBYT STA B STORE TEMPORARILY AND M177 SAVE LOWER 7 BITS STA EQT8,I USE AS FORMS LENGTH SZA,RSS FORMS LENGTH = 0? JMP EXREJ YES - REJECT THE REQUEST JSB BUFL SET EQT13 TO # 0F BYTES LDA B RELOAD ORIGINAL IBUFL IOR VFCRS MERGE IN COMMAND BYTE LDB VD1AD CMND IN A - RTN ADD IN B JMP EXITI VD1AD DEF VD1 VD1 JSB BUFL CONVERT # OF LINES TO # OF WORDS LDA CLBUF SET UP TERMINATION COMMAND JMP WRIT3 WRAP IT UP * * * WRIT5 LDA EQT10,I GET COMPUTED COMMAND WRIT3 STA EQT9,I SAVE RESULT IN EQT9 LDB EQT7,I GET USER BUFFER ADDR. JMP PRNT GO DUMP LINE EXIT0 LDA EQT9,I GET COMMAND BYTE JSB OUTA DUMP IT EXIT1 LDA EQT11,I GET PROG STATUS EXIT3 SSA CHECK FOR CONTINUATION EXIT JMP EXITC GO TO CONTINUATION EXIT CLA CLEAR A FOR INITIATION RETURN JMP IB12,I * * EXITI STB EQT12,I SAVE TIME OUT RTN ADD LDB EQT11,I SET FLAG FOR OUTPUT OF COMMAND SLB,RSS INB STB EQT11,I EXOTA JSB OUTA JMP EXIT1 MAKE APPROP RETURN * * SKP **************************************************************** * * * ROUTINE TO PROCESS CONTROL REQUEST * * CNTRL LDA EQT6,I GET ICNWD AND M3700 EXTRACT FUNCTION CODE * SZA,RSS CLEAR REQUEST? JMP CLR YES - PROCESS IT! * CPA B600 DYNAMIC STATUS JMP DYNAM YES * CPA B1100 VFC FORMS REQUEST? JMP VCNTR  YES * CPA B1500 CHARACTER SET CHANGE? JMP XCHAR YES * CPA B1600 VFC RESET? JMP VFCR YES * * CPA B2000 SELF TEST? JMP STEST YES * CPA B2100 DEFINE COLUMN 1? JMP PCOL1 YES * CPA B3000 PRINT MODE CHANGE? JMP CPMOD YES - PROCESS IT! * * CPA B1000 START DEBUG? * JMP DEBUG YES GO DO IT * * EXIT2 LDA D2 ERROR - ILLEGAL FUNCTION CODE JMP IB12,I * *EBUG JSB $DDT * NOP * JMP EXIT4 * * FORCE 2608A UNBUFFERED TO INSURE DYN STATUS * DYNAM LDA ND1 NEG OF # OF BYTES TO READ IN A JSB RSTAT ON RETURN BYTE IS IN TOP OF A JMP EXIT5 COMPLETION EXIT(NOT IMMED FOR 2608) * VCNTR LDA CALPH STA EQT10,I STORE ALPHA PRINT TO GO WITH FORMS CONTROL JSB TOFB6 CLEAR TOF STATUS (B=-) CLB SET B=+ IN CASE TOF REQUESTED LDA EQT7,I GET IPRAM SZA SUPPRESS SPACE ON NEXT OP? JMP VCNTX NO LDA EQT11,I YES - SET BIT7 OF EQT11 IOR M200 STA EQT11,I JMP EXIT4 DO IMMEDIATE EXIT! VCNTX SSA IS IT NEGATIVE? LDA D63 SET UP FOR PAGE EJECT (VFC CHAN 1) ADA ND74 ADD -74 * SSA,RSS LEGAL CODE? JMP EXIT2 NO-- ERROR RETURN * ADA D8 CHECK FOR CHANNELS 9-16(66-73) SSA,RSS JMP VFC PROCESS CHAN 9-16 REQUEST * ADA D2 CHECK FOR AUTO PAGE CHANGE(64-65) SSA,RSS JMP AUTO PROCESS AUTO EJECT ON OFF * ADA D2 CHECK FOR CHANNELS 1-2 SSA SKIP IF IT IS CHANNEL 1 OR 2 JMP VFC2 GO CHECK CHANNELS 3-8 * XOR D1 63TO0(TOF) 62TO1(BOF) SZA,RSS TOF COMMAND? JSB TOFB6 YES - SET TOF BIT IN STATUS WD(B=+) JMP VFC1 GO TO EXECUTE CHANNEL * VFC2 ADA D6 CHECK FOR CHANNELS 3-8 SSA SJMP SLEW NOPE--MUST BE SLEW * ADA D2 INCREMENT 2 TO GET CHAN. # * JMP VFC1 VFC CPA D3 CHAN 12? JSB TOFB6 YES - SET TOF IN STATUS (B=+) ADA D8 ADD 8 TO GET CHANNELS 9-16 VFC1 XOR M200 REVERSE BIT 7 RSS SLEW ADA D56 ADD 56 TO GET # LINES TO SLEW * IOR EQT10,I MERGE COMMAND BYTE JMP EXOTA GO DUMP IT AND CONTINUE * AUTO STA B LDA EQT11,I IOR M2 FORCE BIT1 SET(ASSUME P EJ OFF) SZB,RSS AUTO EJECT ON OR OFF? XOR M2 ON - CLEAR BIT1 STA EQT11,I * EXIT4 LDA D4 IMMEDIATE COMPLETION CODE IN REG.A JMP IB12,I EXIT * XCHAR LDA ND16 NEG OF # OF BYTE REQUESTED JSB RSTAT ON RETURN THE BYTE IS IN TOP OF A STA B LDA EQT7,I GET PRIM/SEC LANG CODE(S) AND LOBYT INSURANCE IOR B MERGE: TOP=F. PANEL BOTTOM= REQ STA EQX2,I SAVE FOR POWER FAIL/RESET AND LOBYT GET USER REQUEST BACK IOR CCHAR BUILD PRIM/SEC MODIFY CNWD LDB M100K STB EQX3,I SET "CHANGED PRIM/SEC" FLAG JMP EXOTA SEND CONTROL WORD * PCOL1 LDA EQT7,I REQED NUMBER OF SHIFTS AND M17 INSURE ONLY 4 BITS STA EQX1,I SAVE PROG COLUMN 1 STATUS IOR CLBUF MERGE INTO BUFFER CLEAR COMMAND JMP EXOTA SEND IT THEN EXIT * VFCR LDA VFCRS RESET VFC LDB EQT7,I 0 FOR 6LPI 1 FOR 8LPI RESET SZB 6LPI? ADA M200 NO - SET BIT7 FOR 8LPI RESET JMP EXOTA * CLR LDA EQT11,I CLEAR MODE BITS 8 THRU 11 AND CMODX AND TRANSPARITY(BIT12) STA EQT11,I AND PAGE EJECT(BIT 1) CLA STA EQX1,I CLEAR PROG COL 1 STATUS STA EQX3,I CLEAR "PRIM/SEC MODIFIED" FLAG LDA TOF DO A TOP OF FORM LDB TOFAD RET ADDRESS JMP EXITI TOFAD DEF TOFRT TOFRT CLB STB EQT13,I CLEAR CHARACTER OUTPUTU COUNTER JSB TOFB6 SET TOF IN STATUS (B=+) LDA MCLR THEN DO A MASTER CLEAR JMP EXOTA * CPMOD LDA EQT7,I GET IPRAM AND M37 MODE=BITS0-3: TRANSPARITY=BIT4 STA B STA TOFB6 LDA EQT11,I UPDATE MODE AND T IN EQT11 AND CMODE EXCLUDE BITS 8 THRU 12 BLF,BLF MOVE REQUEST TO BITS 8 THRU 12 ADA B MERGE OLD FLAGS AND NEW MODE + T STA EQT11,I SAVE FOR RESTORE IF POWER FAIL LDA TOFB6 LOOKING FOR MODE AND T BIT IOR CSTND INCLUDE CONTROL WORD BITS LDB UPADD A=CWD B=RET ADDRESS JMP EXITI UPADD DEF EXIT5 EXIT * STEST LDA M1700 RESET TIMEOUT VALUE FOR SELFTEST STA EQT15,I LDA SLFTS SELF TEST CONTROL WORD LDB EQT7,I 0/1 = PRINT/NO PRINT FLAG SLB PRINT? INA NO PRINT SELECTED! JMP EXOTA * SKP *************************************************************** * * CONTINUATION/COMPLETION SECTION * ON ENTRY A=PRINTER SUBCHANNEL * * CB12 NOP JSB SETIO CONFIGURE FOR CURRENT SC LDA EQT1,I SPURIOUS INTERRUPT? SZA,RSS JMP AUTUP YES SCRAM JSB TMOUT SET TIMEOUT VALUE LDA EQT11,I GET DRIVER STATUS WORD IOR M100K TURN ON BIT15 STA EQT11,I REPLACE SLA,RSS COMMAND WORD OUTPUT? JMP XCONT NO - CHECK FOR CONTINUATION RETURN XOR D1 YES - CLEAR FLAG AND RESTORE STA EQT11,I LDA EQT12,I RESUME PROCESS LDB EQT7,I BUFFER ADD IF COMMAND OUTPUT JMP A,I XCONT RAR,RAR CHECK FOR CLE,SLA CHAR READBACK CONT JMP CBCON LDB EQT13,I ANY CHARACTERS LEFT TO DUMP? SZB,RSS JMP EXIT5 NO -- SCRAM LDB EQT7,I GET BUFFER ADDR. JMP PRNT CONTINUE DUMPING LINE EXIT5 LDA EQT11,I AND CONTU TURN OFF ALL CONTINUATION BITS  STA EQT11,I REPLACE WORD JSB VSTAT UPDATE PRINTER STATUS LDB EQT8,I GET IBUFL * SSB SKIP IF POSS. WORD COUNT CMB,INB CLF2 CLF 0 CLEAR FLAG CLA JMP CB12,I COMPLETION RETURN * * EXITC ISZ CB12 CONTINUATION EXIT JMP CB12,I * * * * AUTUP JSB STAT CHECK STATUS JMP NREDC NOT READY- NO AUTO UP SPCLF CLF 0 CLEAR FLAG FOR SPURIOUS INT JMP $UPIO * * ROUTINE TO ADJUST USER BUFFER LENGTH TO NEG. CHAR. COUNT * BUFL NOP LDA EQT8,I GET IBUFL SSA SKIP IF POS. WRD CNT JMP BUFX ALS CONVERT WORD COUNT TO CMA,INA NEGATIVE CHAR. COUNT BUFX STA EQT13,I RESTORE JMP BUFL,I RETURN * * * ON ENTRY B = NEG = CLEAR BIT6 * = POS = SET BIT6 * TOFB6 NOP STA BUFL TEMP SAVE OF A REG LDA EQT5,I IOR M100 FORCE BIT6 SET SSB SET OR CLEAR BIT6? XOR M100 CLEAR IT! STA EQT5,I LDA BUFL RESTORE A REG JMP TOFB6,I * * ******************************************************************** * * ROUTINE TO DUMP USER BUFFER TO LINE PRINTER * ON ENTRY "B" IS BUFFER ADDRESS * * * PRNT LDA EQT13,I CHECK FOR ANY CHAR. SZA,RSS YES--CONTINUE JMP EXIT0 NO--RETURN LDA ND40 SET UP MAX CHAR. DUMP CNT. STA EQT12,I FOR 80 BYTES PRTA LDA B,I GET WORD AND HIBYT SAVE HIGH BYTE ALF,ALF MOVE TO LOW BYTE JSB OUTA WRITE TO THE PRINTER ISZ EQT13,I BUMP CHAR. COUNT RSS JMP EXIT0 LAST CHAR.--RETURN LDA B,I GET WORD AGAIN AND LOBYT SAVE LOW BYTE JSB OUTA WRITE TO THEPRINTER INB INCREMENT WORD ADDR. ISZ EQT13,I BUMP CHAR. COUNT RSS JMP EXIT0 DONE RETURN ISZ EQT1dy2,I CHECK FOR LAST CHAR. PER PASS JMP PRTA STB EQT7,I SAVE BUFF. ADDR. JMP EXIT1 GO TO NEXT BLOCK SKP * * * ROUTINE TO CHECK PRINTER STATUS * IF A = 0 THEN ENTRY FROM SPURIOUS INTERRUPT * IF A NOT 0 THEN INITIATOR/CONTINUATOR ENTRY * P+1=BAD STATUS * P+2=GOOD STATUS * * STAT NOP CHECK FOR ON LINE/READY STA B SAVE INTERRUPT TYPE FLAG S1 LIA 0 GET STATUS FROM PRINTER STA VSTAT TEMP SAVE OF STATUS ALF,ALF POWER FAIL STATUS TO BIT0 SLA,RSS POWER FAIL SET? JMP S2 NO - GO CHECK IF SPUR. INT. ENTRY SZB,RSS SPURIOUS INTERRUPT? JMP S4 YES - RET VIA $UPIO TO SEE IF SCHED LDA ON.OF INA "ON LINE" CONTROL WORD LDB S4ADD A = CWD B = RET ADDRESS JMP EXITI S4ADD DEF S4RET S4RET LDA MCLR THEN DO A "MASTER CLEAR" LDB MCADD A = CWD B = RET ADDRESS JMP EXITI MCADD DEF MCRET MCRET LDA EQT11,I THEN RESTORE MODE AS PER EQT11 ALF,ALF AND M37 EXTRACT MODE AND TRANSPARITY BITS IOR CSTND CONTROL WORD LDB MODAD A = CWD B = RET ADDRESS JMP EXITI MODAD DEF MODRT MODRT LDA EQX1,I GET PROG COL 1 STATUS IOR CLBUF ADD CLEAR BUFFER CNWD LDB CL1AD A = CWD B = RET ADD JMP EXITI CL1AD DEF CL1RT CL1RT LDB EQX3,I GET "MODIFIED P/S" FLAG SSB,RSS WAS IT MODIFIED? JMP SCHN1 NO - THEN LOCAL FRONT PANEL OK LDA ND16 YES - NEG OF # OF REQ'ED BYTE JSB RSTAT ON RET TOP OF A IS FRONT PANEL STA TOFB6 TEMP SAVE LDA EQX2,I GET LAST VALUE AND HIBYT IN TOP OF WORD CPA TOFB6 EQUAL? JMP GETPS YES - INSTALL LAST REQ'ED VALUE CLA NO - LET CURRENT DEFINITION STAND STA EQX3,I CLEAR "PRIM/SEC MODIFIED" FLAG JMP SCHN1 GETPS LDA EQX2,I AND LOBYT  GET LAST REQ'ED PRIM/SEC VALUE IOR CCHAR LDB PSADD A = CNWD B = RET ADD JMP EXITI PSADD DEF SCHN1 * SCHN1 LDA EQT4,I FINALLY LOOK AT SUBCHANNEL AND M3700 MASK=3700B CPA M100 SC = 1? RSS YES - RETURN WITH NOT READY JMP S1 NO - IGNORE THE POWER FAIL LDA ON.OF NOT READY SO GO OFFLINE LDB OFADD A=CWD B=RET ADDRESS JMP EXITI OFADD DEF S3 * S2 SZB,RSS SPURIOUS INTERRUPT? JMP S4 YES - ENTRY FROM "ON LINE" INT! LDA VSTAT NO - ENTRY FROM INITIATOR! AND M1401 SAVE BITS 15,14,0 CPA M1001 SKIP IF STATUS NOT GOOD JMP S4 GOOD STATUS S3 CLF 0 CLEAR FLAG JMP STAT,I AND GIVE P+1 RETURN S4 ISZ STAT P+2 FOR GOOD STATUS JMP STAT,I RETURN * * * * ROUTINE TO RETURN DYNAMIC STATUS * * VSTAT NOP LDA EQT5,I GET OLD STATUS WORD AND HIBX1 DUMP OLD STATUS WORD STA B SAVE VS1 LIA 0 GET NEW STATUS ALF TOP 4 BITS TO BOTTOM STA STAT TEMP SAVE AND M17 SAVE ONLY LOW 4 BITS(WERE TOP 4) IOR B APPEND TO EQT5 REMNENT LDB STAT RECALL OLD STATUS SSB VFC INITILIZED? IOR M20 YES - SET BIT4 IN EQT5 RBL 6/8LPI TO SIGN SSB 8LPI? IOR M40 YES - SET BIT5 IN EQT5 LDB STAT FOR THE LAST TIME BLF POWER FAIL TO BIT0 SLB DID POWER FAIL? IOR M200 YES - SET BIT7 IN EQT5 STA EQT5,I FINALLY SAVE THE UPDATED STATUS JMP VSTAT,I EXIT * * * ROUTINE TO OUTPUT CONTENTS OF REG. A * OUTA NOP O0 SFS 0 SKIP IF FLAG SET JSB TIME CHECK FOR TIME OUT O1 OTA 0 DUMP WORD O2 STC 0,C JMP OUTA,I RETURN * * * ROUTINE TO INPUT DATA FROM THE PRINTER INTO * TOP 8 BITS OF A REGISTER * * INTOA NOP INA1 SFS 0 JSB TIME CHECK FOR TIME OUT! INA2 LIA 0 READ DATA BYTE AND HIBYT CLEAR DEMAND BIT INA3 STC 0,C GET READY FOR NEXT DATA JMP INTOA,I RETURN * * TIME NOP STA VSTAT SAVE CHARACTER TEMPORARILY LDA ND100 PICK UP LOOP COUNTER TIM1 SFC 0 SKIP IF CHAR NOT ACCEPTED JMP TIM2 SSA,INA SKIP IF DELAY TIME EXCEEDED JMP TIM1 JMP EXIT1 TIME-OUT RETURN THROUGH IB12 OR CB12 TIM2 LDA VSTAT RESTORE CHARACTER TO A REG. JMP TIME,I RETURN TO CALLING CODE * * DETERMINE TIMEOUT DELAY FOR DRIVER. THIS OVERRIDES EITHER THE * TO VALUE AT GEN TIME OR AN OPERATOR SUPPLIED VALUE. * TMOUT NOP LDB DM250 2SEC DELAY EXCEPT FOR 2X & SELFTEST LDA EQT11,I ALF,ALF CURRENT PRINT MODE TO BITS 0 THRU 3 AND M17 EXTRACT THEM CPA D1 IN DOUBLE SIZE? BLS YES - DOUBLE THE DELAY (5 SEC) STB EQT15,I TIMEOUT FOR DVB12(UNLESS SELT TEST) JMP TMOUT,I EXIT * * THIS SUBROUTINE WILL RETURN A SPECIFIC STATUS BYTE * AS REQUESTED BY THE A REGISTER. PROVIDE THE COMPLEMENT * TO THE REQUESTED VALUE. VALUE IS IN TOP OF A REG. * RSTAT NOP STA TOFB6 NEG OF # OF BYTES TO READ CMA,INA MAKE IT POSITIVE IOR STATR MERGE IN CNWD LDB STATA A = CNWD B = RET ADD JMP EXITI STATA DEF STATX STATX JSB INTOA GET A BYTE JSB TIME WAIT FOR FLAG TO SET ISZ TOFB6 DONE? JMP STATX NO - KEEP TRYING JMP RSTAT,I YES - EXIT WITH BYTE IN TOP OF A SKP ************************************************************ SETIO NOP IOR STF BUILD & EXECUTE STF CH INST STA *+1 NOP AND M77 RETAIN JUST SC CPA SC SKIP IF DVR NOT PROPERLY CONFIG. JMP SETIO,I RECONFIGURATION NOT NECESSARY STA SC SAVE NEW CHANNEL NUMBER IOR SFC FORM SFC INSTRUCTION STA TIM1 ADA M100 FORM SFS INSTRUCTION STA INA1 STA O0 ADA M200 FORM LIA INSTRUCTION STA VS1 STA INA2 STA S1 ADA M100 FORM OTA INSTRUCTION STA O1 ADA M300 FORM CLF INSTRUCTION STA S3 STA CLF2 STA SPCLF ADA B600 FORM STC,C INSTRUCTION STA INA3 STA O2 * SETUP POINTERS FOR ACCESS TO VALUES IN EXT'ED EQT LDA EQA13,I ADDRESS OF EXTENDED EQT STA EQT12 INA STA EQT13 INA STA EQX1 INA STA EQX2 INA STA EQX3 JMP SETIO,I SPC 2 NREDC JSB VSTAT UPDATE STATUS CLA,INA SET REG A TO 1 JMP CB12,I RETURN * * * *********************************************************** * * DATA BASES * STF STF 0 SFC SFC 0 SC OCT 0 * * MASK VALUES * M2 OCT 2 M3 OCT 3 M4 OCT 4 M10 OCT 10 M17 OCT 17 M20 OCT 20 M37 OCT 37 M40 OCT 40 M77 OCT 77 M100 OCT 100 M177 OCT 177 M200 OCT 200 M201 OCT 201 M202 OCT 202 M300 OCT 300 M400 OCT 400 M401 OCT 401 LOBYT OCT 377 M3700 OCT 3700 M3777 OCT 3777 CONTU OCT 17602 M100K OCT 100000 M1001 OCT 100001 M1401 OCT 140001 CMODE OCT 160377 CMODX OCT 160375 HIBYT OCT 177400 HIBX1 OCT 177500 * * CONSTANTS * * D1 DEC 1 D2 EQU M2 D3 EQU M3 D4 EQU M4 D6 DEC 6 D8 EQU M10 D56 DEC 56 D63 EQU M77 D127 EQU M177 B600 OCT 600 B1000 OCT 1000 B1100 OCT 1100 B1500 OCT 1500 B1600 OCT 1600 B2000 OCT 2000 B2100 OCT 2100 B3000 OCT 3000 ND1 OCT -1 ND9 DEC -9 ND16 DEC -16 ND40 DEC -40 ND74 DEC -74 ND100 DEC -100 DM250 DEC -250 M1700 DEC -1700 M1153 DEC -1153 * * * * * VFC/SLEW CONSTANTS * TOF OCT 100200 * * * COMMAND BYTE VALUES * * CALPH EQU M100K ALPHA 4`^ZPRINT CSTND OCT 130000 STANDARD PRINT MODE CHARB OCT 120200 CHARACTER READ-BACK COMMAND CLBUF OCT 70000 CLEAR INPUT BUFFER COMMAND MCLR OCT 50000 MASTER CLEAR SLFTS OCT 40000 CCHAR OCT 10000 CHANGE CHAR. SET VFCRS OCT 20000 VFC RE-SET ON.OF OCT 30000 ON/OFF LINE STATR OCT 120000 STATUS READ REQUEST PING OCT 60000 PING COMMAND PONG OCT 60001 PONG COMMAND * * * * ASCII CONSTANTS * * ASTR OCT 25000 HIGH BYTE "*" DSPAC EQU ON.OF HIGH BYTE "0" (OCT 30000) EJCT OCT 30400 HIGH BYTE "1" EQT12 NOP EQT13 NOP EQX1 NOP EQX2 NOP EQX3 NOP * * * A EQU 0 B EQU 1 EQT1 EQU 1660B EQUIPMENT TABLE ADDRESSES EQT4 EQU 1663B EQT5 EQU 1664B EQT6 EQU 1665B EQT7 EQU 1666B EQT8 EQU 1667B EQT9 EQU 1670B EQT10 EQU 1671B EQT11 EQU 1672B EQA12 EQU 1771B EQA13 EQU 1772B EQT15 EQU 1774B END `  92063-18001 1840 S 3522 IMAGE LIBRARY SOURCE              H0135 uASMB,R,L,C HED SUBROUTINE DBOPN NAM DBOPN,7 92063-12001 REV.1840 780829 * * ************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * * PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ************************************************************** * * * LISTING: 92063-19001 * SOURCE: 92063-18001 * RELOC: 92063-12001 * * ************************************************************* * * CALLING SEQUENCE : * * CALL DBOPN(IBASE,DBILV,DBSCD,MODE,ISTAT) * * PARAMETER DESCRIPTION : * * IBASE - AN ASCII ARRAY WHICH CONTAINS THE NAME OF * THE DATA BASE. * ILEV - AN ASCII ARRAY WHICH CONTAINS THE LEVEL * WORD FOR THE DATA BASE. * ISCOD - AN INTEGER WHICH IS THE FMP SECURITY CODE * FOR THIS DATA BASE. * IMODE - AN INTEGER WHICH IS THE MODE IN WHICH THE * DATA BASE IS OPEN. * ISTAT - AN INTEGER USED TO RETURN STATUS * INFORMATION TO THE USER. * * FUNCTION : * * DBOPN VALIDATES THE VALUE OF IMODE. IT MAKES A * DISK FILE READ FROM THE FILE WHOSE NAME MATCHES * THE VALUE OF IBASE FOR THE PURPOSE OF VERIFYING 1) * THAT THE FILE READ FROM IS THE ROOT DATA-SET OF AN * IMAGE DATA-BASE AND 2) THAT THE VALUE IN ISCOD IS * CORRECT. NEXT, DBOPN CONTINUES TO READ THE ROOT * DATA-SET AND DEVELOPS THE RUN TABLE IN THE IPNTR * AREA(IN COMMON) PREPARATORY TO ACCEPTING OTHER * USER REQUESTS RELATIVE TO THIS DATA-BASE. * * A SUCCESSFUL OPEN IS SIGNALLED TO THE CALLER BY A * RETURN OF A BINARY ZERO TO THE FIRST WORD OF ISTAT * AND A BINARY LEVEL NUMBER BETWEEN 0 AND 15 IN THE * SECOND WORD OF ISTAT. * * TO MODIFY THE CONTENT OF A DATA-BASE, THE USER * MUST ASK FOR THE OUTPUT CAPABILITY. TO SIMPLY READ * ,HE SHOULD ASK FOR THE INPUT CAPABILITY. THREE * MODES ARE AVAILABLE AS SHOWNh BY THE FOLLOWING * TABLE: * * IMODE ACCESS CAPABILITIES * * 1 READ ONLY * 2 READ AND WRITE (DEL AND PUT WITH LOCK) * 3 READ, WRITE, DELETE AND PUT * * A USER WHO NEEDS ONLY TO ACCESS THE DATA-BASE AND * WHO WILL NOT ALTER ITS CONTENTS IN ANY WAY SHOULD * SELECT MODE 1. A USER WHO INTENDS TO UPDATE THE * CONTENTS OF THE DATA-BASE SHOULD SELECT MODE 2. * THE USER CANNOT ADD OR DELETE DATA-ENTRIES IN THIS * MODE: HOWEVER,HE MAY UPDATE NON-CRITICAL DATA-ITEM * VALUES OF EXISTING DATA-ENTRIES. IN OTHER WORDS, * THIS MODE DOES NOT ALLOW LINKAGE MAINTENANCE. * * A USER WHO INTENDS TO ADD OR DELETE DATA-ENTRIES, * OR TO MODIFY SEARCH ITEMS MUST REQUEST MODE 3. * * AN UNSUCCESSFUL COMPLETION IS SIGNALLED TO THE * CALLER BY THE RETURN OF A NON-ZERO INTEGER IN THE * FIRST WORD OF ISTAT IDENTIFYING THE NATURE OF THE * ERROR. * * EXT PHIS1,AIDCB,.ENTR,CMPCT,PHICM,SFILL,DCBAN EXT $LIBR,$LIBX,EXEC,RNRQ,.DBRN,AIRUN,READF,SMOVE,OPEN,D%DCB EXT POST,WRITF,RWNDF ENT DBOPN * * SUP PRESS * ACSUB BSS 1 1ST BYTE : ACTIVITY FLAG * 2ND BYTE : SUBCHANNEL # DBSTA BSS 1 DATA BASE STATUS DBSCD BSS 1 DATA BASE SECURITY CODE(FMP) DBICT BSS 1 DATA BASE ITEM COUNT DCRUN BSS 1 RUN TABLE ADDRESS DCNAM BSS 1 FILE NAMES THAT ARE OPEN DBSCT BSS 1 DATA BASE DATA SET COUNT DBITB BSS 1 ADDRESS OF ITEM TABLE DBSTB BSS 1 ADDRESS OF DATA SET TABLE DBLVL BSS 1 1ST BYTE: ACCESS LEVEL GRANTED BY 'DBOPN' DBILV BSS 1 DATA BASE ITEM LEVEL WORDS - 3 WORDS/LEVEL * * PARS BSS 5 DBOPN NOP JSB .ENTR PICK UP PARAMETERS DEF PARS * LDA AIRUN SZA,RSS HAS DBINT BEEN CALLED YET? JMP E130 NO! STA DCRUN ADA .2 STA ACSUB TABLE OF ADDRESSES INA STA DBSTA FOR INA STA DBSCD ACCESS TO INA STA DBICT RUN INA STA DBSCT TABLE INA STA DBITB INA STA DBSTB INA STA DBLVL INA STA DBILV LDA DCBAN STA DCNAM * *** *** CHANGE REV 1840 * * MAKE SURE THERE IS NOT A DATA BASE ALREADY OPENED TO THE USER * IN AVAILABLE MEMORY. IF SO, WE CANNOT OPEN A NEW ONE. * LDA DBSTA,I IF DB STATUS IS CPA =ALB EQUAL TO "LB" JMP E103 A DATA BASE IS ALREADY OPEN. *** *** * CLA SET ENTRY ADDRESS POINTER/FLAG STA ENTAD TO ZERO FOR INITIAL VALUE. * LDA AIDCB SET UP POINTER STA DCB TO DATA CONTROL BLOCK FOR RUNTABLE * LDA PARS+2,I CONVERT SECURITY CODE TO CMA,INA STA SC NEGATIVE JSB SFILL FILL DEF *+5 DEF DCNAM,I DATA NAME DEF .1 DEF .36 TABLE WITH BLANKS DEF .32 * LDA PARS+3,I IF MODE BETWEEN 1 AND 3 SZA RANGE SSA JMP E115 BAD MODE LDB .3 SET FOR ******* CPA .3 EXCLUSIVE LDB .2 OPEN IF ******* STB IOPTN MODE=3 CMA,INA ADA .3 SSA JMP E115 BAD MODE JSB OPEN OPEN DEF *+6 DEF DCB,I THE DEF IERR DEF PARS,I ROOT FILE DEF IOPTN DEF SC CPA M8 LOCKED OR OPEN ROOT FILE? JMP E129 YES! CPA M7 SECURITY VIOLATION? JMP E117 YES! SSA ANY OTHER ERROR? JMP FMER1 YES! * *** *** CHANGE REV 1840 * * IF OPEN MODE IS 2, LOOK FOR DATA BASE IN ACTIVE TABLE. IF THE ENTRY * IS FOUND, TURN OFF INTERRUPTS AND CHECK THE ENTRY AGAIN FOR VALIDITY. * IF ENTRY STILL VALID, INCREMENT THE USER COUNT. THEN TURN OF THE IN- * TERRUPT SYSTEM AGAIN. * * IF THE ENTRY WAS FOUND WE SET ITS ADDRESS IN ENTAD. IF NOT, ENTAD IS * SET TO ZERO * LDA PARS+3,I CPA .2 RSS JMP C4 * LDA ADBRN THIS CODE GETS THE TRUE RSS ADDRESS OF .DBRN LDA 0,I BY CHASING DOWN INDIRECTS. RAL,CLE,SLA,ERA JMP *-2 STA ADBRN * LDB 0,I GET THE TABLE SIZE AND CMB,INB NEGATE IT FOR A STB TABCT LOOP COUNTER. * INA GET ACTIVE TABLE C1 STA TABAD ENTRY ADDRESS LDB .3 STB CMPCT SEARCH ACTIVE TABLE LDB PARS FOR EXISTING ENTRY. JSB PHICM ARE NAMES THE SAME? RSS JMP C2 YES - GO ALTER ENTRY. LDA TABAD NO - CHECK NEXT ENTRY ADA .6 ISZ TABCT IF THERE IS ONE. JMP C1 JMP C4 * C2 NOP WE MUST GO PRIVELEDGED JSB $LIBR TO ASSURE THAT WE NOP HAVE THE CORRECT INFO. LDB TABAD IF FIRST WORD OF ENTRY LDA 1,I IS NEGATIVE ONE, SSA SOMEONE HAS REMOVED ENTRY. JMP C3 STB ENTAD ADB .5 ISZ 1,I C3 NOP JSB $LIBX DEF *+1 DEF *+1 * C4 NOP *** *** * JSB READF READ DEF *+6 DEF DCB,I THE ROOT DEF IERR DEF DCRUN,I FILE DEF .9999 DEF LEN INTO 'IRUN' SSA ERROR? JMP FMERR YES! * * JSB SMOVE MOVE ROOT DCB DEF *+6 DEF DCB,I TO DATA DEF .1 DEF .32 BASE SYSTEM DEF D%DCB DEF .1 BUFFER * LDA =ALB IS DBSTATUS EQUAL CPA DBSTA,I TO "LB" ? JMP *+2 JMP E116 NO,GO TO ERROR * LDA .1 STA ACSUB,I LDA DBSCD,I IS SECURITY CODE = ISCOD? CPA SC JMP *+2 JMP E117 NO,GO TO ERROR  LDA DBILV STA ILEV3 LDA M15 STA TEMP1 LDA .3 IF LEVEL WORD STA CMPCT IS ALL BLANK,ZERO LDA PARS+1 FIRST 2 CHARACTERS LDB BLANP TO RENDER IT GARBAGE JSB PHICM JMP *+3 CLA STA PARS+1,I LOOP1 LDA .3 LOOP ON ITEM TABLE AND COMPARE STA CMPCT AGAINST ITEM LEVEL FOR A MATCH LDA ILEV3 LDB PARS+1 JSB PHICM JMP *+2 JMP DBOP2 LDA ILEV3 ADA .3 STA ILEV3 ISZ TEMP1 JMP LOOP1 * LOOP ON ITEM FROM BOTTOM TO TOP AND CHECK FOR * FIRST NON-BLANK ENTRY. WHEN THIS IS ENCOUNTERED * ADD 15 TO THE INDEX AND USE THAT AS ALEVL. IF * ITEM TABLE IS ALL BLANKS,SET DBLVL TO 15. LDA M15 STA TEMP1 LDA DBILV LOOP2 STA ILEV3 LDA .3 STA CMPCT LDA ILEV3 LDB BLANP JSB PHICM JMP *+7 LDA ILEV3 ADA .3 ISZ TEMP1 JMP LOOP2 LDB .15 JMP DBOP3 LDB TEMP1 ADB .15 JMP DBOP3 DBOP2 LDB TEMP1 STORE LEVEL NUMBER IN ALEVL AND ADB .16 ISTAT(2) DBOP3 LDA PARS+4 INA STB 0,I BLF,BLF ADB PARS+3,I MERGE IN IMODE STB DBLVL,I LDA PARS+3,I IS IMODE = 1 OR 2 ADA M3 SSA JMP DBOP4 LDA DBLVL,I NO,CHECK FOR ALEVL EQUAL TO 15 ALF,ALF AND B377 ADA M15 SZA ILLEGAL ACCESS LEVELFOR THIS MODE JMP E118 DBOP4 CLA CLEAR FIRST WORD OF ILEVL FOR STA DBILV,I SUBROUTINE PHIL LDA DBILV STORE IBASE IN STA ILEV3 ILEV(2)-ILEV(4) LDA PARS STA TEMP1 LDB M3 LDA TEMP1,I ISZ ILEV3 STA ILEV3,I ISZ TEMP1 ISZ 1 JMP *-5 LDA ACSUB,I SET ACTIVITY FLAG TO "1" IOR ACMSK STA ACSUB,I LDA DBSCT,I LOOP ON DSET COUNT TO CREATE CMA,INA DATA-SETS AND INZITIALIZE INFO STA DINX WITHIN THESE DATA-SETS. LDB DBSTB,I ALSO,REGARDLESS OF MODE, SET ADB DCRUN READ AND WRITE LEVEL BITS OF ADB M1 * RECORD DEFINITION TABLES AS TO JMP DBOP8 ACCESSIBILITY(0= NON-ACCESSIBLE) DBOP7 LDB DSET CALCULATE THE ADDRESS OF THE ADB .3 NEXT DATA-SET. LDA 1,I LDB 0 AND B377 RAL SWP ALF,ALF AND B377 ADB 0 DSET=2*PATHCT+FIELDCT+16+DSET ADB .16 ADB DSET DBOP8 STB DSET LDB DSET PICK UP FIELD COUNT, NEGATE ADB .3 AND STORE IN TEMP1 LDA 1,I ALF,ALF AND B377 CMA,INA STA TEMP1 LDA DSET INITIALIZE TEMP3 TO POINT TO ADA .16 RECORD DEFINITION TABLES FOR STA TEMP3 THIS DATA-SET DBO12 LDB DBITB,I ADB DCRUN ADB M1 LDA TEMP3,I PICK UP INUM(I),NEGATE IT, * INDEX ITEM TABLE WITH IT, AND ALF,ALF STORE THIS VALUE IN TEMP2 AND B377 CMA,INA ISZ 0 JMP *+2 JMP *+3 ADB .5 JMP *-4 STB TEMP2 ADB .3 PICK UP READLEVEL FROM ITEM LDA 1,I TABLE FOR THIS DATA-ITEM ALF,ALF AND B377 CMA,INA LDB DBLVL,I SWP ALF,ALF AND B377 IF ALEVL-READLEVEL IS NEGATIVE ADB 0 THEN DON'T SET THE READ BIT SSB JMP *+4 LDB .1 SET READ BIT ADB TEMP3,I STB TEMP3,I LDB TEMP2 PICK UP WRITE LEVEL FROM ITEM ADB .3 TABLE FOR THIS DATA-ITEM LDB 1,I SWP AND B377 IF ALEVL-WRITELEVEL IS NEGATIVE CMA,INA THEN DON^T SET THE WRITE BIT ADB 0 SSB JMP *+4 LDB .2 SET WRITE BIT ADB TEMP3,I STB TEMP3,I ISZ TEMP3 INCREMENT TEMP3 FOR NEXT INUM ISZ TEMP1 JMP DBO12 tISZ DINX JMP DBOP7 * LDA PARS+3,I IS THIS A CPA .2 MODE=2 OPEN? JMP MODE2 YES! * EXIT CLB NO! STB PARS+4,I JMP ERR1 FMERR CMA,INA STA 1 ERROR CLA STA DBSTA,I * *** *** CHANGE REV 1840 * * ON AN ERROR, WE MUST CHECK TO SEE IF WE ALTERED AN ENTRY IN THE ACTIVE * TABLE. ENTAD WILL BE A NON-ZERO ENTRY ADDRESS, IF SO. WE MUST GO * PRIVELEDGED AGAIN AND DECREMENT THE USER COUNT THEN WE CAN TURN THE * INTERRUPT SYSTEM BACK ON. IF THE COUNT BECOMES ZERO, WE ASK CLNUP * TO DO THE JOB OF A DBCLS WHEN THE COUNT BECOMES ZERO. IF NON-ZERO, * WE JUST RETURN THE ERROR TO THE USER. * STB PARS+4,I SAVE ERROR CODE LDA ENTAD SZA,RSS JMP ERR1 NO ENTRY ALTERED. * JSB $LIBR GO PRIVELEDGED. NOP LDB ENTAD LDA 1,I IS ENTRY STILL OKAY? SSA JMP C10 NO - SOMEONE HAS REMOVED IT. ADB .5 YES - DECREMENT USER COUNT. CCA ADA 1,I STA 1,I * SZA IF COUNT IS NON-ZERO OR C10 CLB,RSS ENTRY REMOVED, ZERO ENTAD RSS STB ENTAD JSB $LIBX THEN TURN INTERRUPTS ON AGAIN. DEF *+1 DEF *+1 * LDA ENTAD IF ENTAD NON-ZERO SZA WE NEED TO REMOVE ENTRY JMP CLNUP ELSE JUST RETURN. *** *** * ERR1 LDA ACSUB,I CLEAR ACTIVITY FLAG AND B377 STA ACSUB,I * *** *** CHANGE REV 1840 * * CLEAR OUT REMAINS OF ROOT DCB * JSB SFILL DEF *+5 DEF DCB,I DEF .1 DEF .32 DEF .0 JMP DBOPN,I * * SET UP ACTIVE TABLE * *** *** CHANGE REV 1840 * * IF WE HAVE ALREADY FOUND THE ENTRY FOR THE DATA BASE IN THE ACTIVE TABLE * ITS ADDRESS IS IN ENTAD, ELSE ENTAD IS ZERO. * IF ENTAD IS NON-ZERO: * GO PRIVELEDGED AND CHECK THAT THE ENTRY IS STILL VALID. IF NOT, ZERO * ENTAD. TURN ON INTERRUPT yS AGAIN AND IF ENTAD IS ZERO JUMP TO THE CODE * TO BUILD AN ENTRY, ELSE JUST RETURN TO USER. * MODE2 LDA ENTAD SZA,RSS JMP C20 * JSB $LIBR NOP LDA ENTAD,I IF FIRST WORD OF ENTRY CLB SSA IS NEGATIVE, ENTRY HAS STB ENTAD BEEN REMOVED. JSB $LIBX DEF *+1 DEF *+1 * LDA ENTAD SZA JMP EXIT * * * ENTAD IS ZERO, THEREFORE WE MUST BUILD A NEW ENTRY IN THE ACTIVE TABLE. * FIRST, WE NEED TO GET A RESOURCE NUMBER. THEN WE WILL PUT TOGETHER * THE VOLATILE DATA IN THE RUN TABLE INTO THE TEMPORARY BUFFER AND WRITE * IT OUT TO SAM, THUS ALLOCATING A CLASS NUMBER. * C20 NOP JSB RNRQ ALLOCATE AN RN DEF *+4 GLOBALLY. DEF B20 DEF RN DEF IERR * LDA IERR DID WE SUCCEED? CPA .4 JMP E132 NO. * LDA DBSCT,I YES - SET UP VOLATILE DATA. CMA,INA USE NEGATIVE OF DATA SET STA TEMP2 COUNT FOR A LOOP COUNTER LDA TEMPS GET ADDRESS OF TEMP. STA TEMP3 STORAGE AREA CLA,INA START WITH DATA SET STA TEMP1 NUMBER ONE. C21 LDA TEMPP STORE FREE LIST COUNT AND JSB PHIS1 HEAD OF EACH DATA SET INTO JMP C29 TEMPORARY BUFFER STB DSET PRIOR TO OUTPUTTING ADB .6 TO SAM. LDA 1,I STA TEMP3,I ISZ TEMP3 INB LDA 1,I STA TEMP3,I ISZ TEMP3 ISZ TEMP1 ISZ TEMP2 CONTINUE FOR ALL DATA SETS JMP C21 IN DATA BASE. * LDA DBSCT,I SET UP LENGTH RAL FOR CLASS WRITE/READ STA TABCT = DATA SET COUNT * 2. * CLA ZERO OUT CLASS NUMBER STA CLASS FOR ALLOCATION * JSB EXEC PERFORM CLASS WRITE/READ. DEF *+8 DEF .20 DEF .0 DEF TEMPS,I DEF TABCT DEF .0 ܆ DEF .0 DEF CLASS * INA,SZA,RSS CLASS NUMBER AVAILABLE? JMP E133 NO! INA,SZA,RSS MEMORY AVAILABLE? JMP E140 NO! * * * NOW WE HAVE EVERYTHING WE NEED TO BUILD THE ENTRY. SO, SEARCH THROUGH * TABLE TO SEE IF SOMEONE ELSE BEAT US TO THE PUNCH AND TO GET THE FIRST * FREE ENTRY IF NOT. IF THERE IS AN ENTRY WE PUT ITS ADDRESS IN ENTAD * IF NOT WE PUT THE FIRST FREE ADDRESS IN EMPAD. LESE, EITHER OR BOTH * ARE SET TO ZERO. * CLA STA ENTAD STA EMPAD * LDB ADBRN,I USE NEGATIVE OF # OF CMB,INB ENTRIES IN TABLE STB TABCT AS LOOP COUNTER. * LDA ADBRN GET 1ST ENTRY ADDRESS AGAIN INA C22 STA TABAD LDB 0,I IF FIRST WORD OF ENTRY IS SSB NEGATIVE, IT IS EMPTY. JMP C23 LDB .3 ELSE COMPARE NAMES. STB CMPCT LDB PARS JSB PHICM ARE NAMES THE SAME? JMP C24 NO LDA TABAD YES STA ENTAD SAVE ENTRY ADDRESS. JMP C24 * C23 LDA TABAD HERE WHEN EMPTY ENTRY FOUND. LDB EMPAD IS IT THE FIRST? SZB,RSS STA EMPAD YES - SAVE ITS ADDRESS * C24 LDA TABAD CONTINUE SEARCH FOR ADA .6 ALL ENTRIES IN THE ISZ TABCT ACTIVE TABLE. JMP C22 * * * IF ENTAD AND EMPAD ARE BOTH ZERO, ALL WE DID WAS FOR NAUGHT. ELSE * GO PRIVELEDGED. IF ENTAD NON-ZERO, CHECK IF THE ENTRY IS STILL VALID. * IF SO, JUST INCREMENT THE COUNT. IF NOT USE ENTAD AS NEW ENTRY. JOIN * THE BUILDING OF AN ENTRY PROCESS. TO BUILD THE ENTRY IN EMPAD, WE MOVE * THE DATA BASE NAME, CLASS NUMBER AND RN INTO THE ENTRY THEN SET THE * USER COUNT TO ONE. * LDA ENTAD SZA JMP C25 LDA EMPAD SZA,RSS JMP E131 * C25 NOP JSB $LIBR NOP LDB ENTAD SZB,RSS JMP C27 LDA 1,I 1ST WORD= OF ENTRY IS SSA NEGATIVE IF ENTRY JMP C26 NOLONGER EXISTS. ADB .5 ISZ 1,I JMP C28 * C26 LDB ENTAD BUILD NEW ENTRY RSS C27 LDB EMPAD LDA PARS,I MOVE IN NAME, STA 1,I INB ISZ PARS LDA PARS,I STA 1,I INB ISZ PARS LDA PARS,I STA 1,I INB LDA CLASS CLASS NUMBER STA 1,I INB LDA RN AND RESOURCE NUMBER. STA 1,I INB CLA,INA SET USER COUNT TO ONE. STA 1,I * C28 NOP JSB $LIBX DEF *+1 DEF *+1 JMP EXIT * * * WE WANT TO CLEAN UP SOMEWHAT IF AN ERROR OCCURS AFTER ALLOCATING THE * RN. THIS CLEANUP JUST INVOLVES DEALLOCATING THE RN AND CLASS NUMBER * IF ALLOCATED. * * FIRST THE CLASS NUMBER THEN THE RN. * E131 LDB .131 NO ROOM IN ACTIVE TABLE STB PARS+4,I * C30 NOP JSB EXEC DEF *+5 DEF .21 DEF CLASS DEF DCB,I DEF .0 JMP C31 * E133 LDB .133 NO CLASS AVAILABLE. RSS E140 LDB .140 NO MEMORY AVAILABLE. C29 STB PARS+4,I C31 NOP JSB RNRQ DEF *+4 DEF B40 DEF RN DEF IERR JMP ERR1 *** *** * FMER1 CMA,INA LDB 0 RSS E103 LDB .103 A DATA BASE OPEN ALREADY RSS E115 LDB .115 ILLEGAL MODE RSS E117 LDB .117 BAD SECURITY CODE RSS E129 LDB .129 DATA BASE LOCKED OR OPEN RSS E130 LDB .130 DBINT NOT CALLED. STB PARS+4,I JMP ERR1 * * E116 LDB .116 BAD ROOT FILE RSS E118 LDB .118 BAD ACCESS LEVEL RSS E132 LDB .132 NO RESOURCE NUMBER JMP ERROR * *** *** CHANGE REV 1840 * * THIS ROUTINE PERFORMS THE REMOVAL OF THE DATA BASE FROM THE ACTIVE * TABLE. THIS INVOLVES READING THE ROOT FILE INTO MEMORY AGAIN, STORING * THE VOLATILE 8DATA IN SAM INTO THE ROOT FILE IN MEMORY AND WRITING THE * ROOT FILE BACK TO DISC. THEN, WE GO PRIVELEDGED, CHECK THE ENTRY FOR * VALIDITY AND IF THE ENTRY CONTAINS A ZERO USER COUNT, RENDERING THE * DATA BASE NAME TO GARBAGE BY SETTING THE FIRST WORD OF THE ENTRY TO * A MINUS ONE. THEN, WE PICK UP THE CLASS NUMBER AND RN, TURN THE IN- * TERRUPT SYSTEM BACK ON AND RELEASE THOSE RESOURCES. IF THE USER COUNT * IS NOT STILL ZERO, WE DO NOT RELEASE THE RESOURCES BUT MERELY RETURN * TO THE USER. * CLNUP NOP LDB ENTAD GET CLASS NUMBER AND RN ADB .3 FROM ENTRY IN ACTIVE TABLE. LDA 1,I STA CLASS SET SAVE BUFFER AND IOR B6000 SAVE CLASS BITS STA CLAS2 IN CLASS WORD. * INB LDA 1,I STA RN * JSB EXEC BRING THE VOLATILE DATA IN SAM DEF *+5 INTO A TEMP. BUFFER. DEF .21 DEF CLAS2 DEF TEMPS,I DEF .100 * JSB RWNDF REREAD THE ROOT FILE. DEF *+2 DEF DCB,I * SSA JMP ERR1 * JSB READF DEF *+6 DEF DCB,I DEF IERR DEF DCRUN,I DEF .9999 DEF LEN * SSA JMP ERR1 * CLA,INA SET UP LOOP FOR MOVE OF STA TEMP1 VOLATILE DATA FROM LDA DBSCT,I SAM INTO ROOT FILE. CMA,INA STA TEMP2 LDA TEMPS STA TEMP3 * C50 LDA TEMPP STORE FREE COUNT AND HEAD JSB PHIS1 OF EACH DATA SET IN DATA JMP ERR1 BASE INTO ITS RESPECTIVE ADB .6 DSCB IN THE ROOT FILE. LDA TEMP3,I STA 1,I ISZ TEMP3 INB LDA TEMP3,I STA 1,I ISZ TEMP3 ISZ TEMP1 ISZ TEMP2 JMP C50 * JSB RWNDF WRITE THE ROOT FILE DEF *+2 BACK OUT DEF DCB,I * SSA JMP ERR1 * JSB WRITF DEF *+5 DEF DCB,I DEF IERR D/EF DCRUN,I DEF LEN * SSA JMP ERR1 * JSB POST AND MAKE SURE IT DEF *+2 GETS ONTO THE DISC. DEF DCB,I JSB $LIBR GO PRIVELEDGED AGAIN. NOP LDB ENTAD IF ENTRY STILL OKAY LDA 1,I SSA JMP C51 ADB .5 LDA 1,I THEN IF USER COUNT STILL ZERO, SZA JMP C51 STA ENTAD ZERO OUT ENTAD ADB M1 RN STA 1,I ADB M1 AND CLASS NUMBER STA 1,I ADB M3 THEN PUT A MINUS ONE CCA IN 1ST WORD OF ENTRY. STA 1,I * C51 NOP JSB $LIBX TURN INTERRUPTS ON AGAIN. DEF *+1 DEF *+1 * LDA ENTAD DID WE REMOVE ENTRY? SZA JMP ERR1 NO - JUST RETURN TO USER. JMP C30 YES - RELEASE RESOURCES. *** *** * ADBRN DEF .DBRN ADDRESS OF ACTIVE TABLE TABAD NOP ADDRESS OF CURRENT ENTRY IN ACTIVE TABLE TABCT NOP NUMBER OF CURRENT ENTRY IN ACTIVE TABLE CLASS NOP CLASS NUMBER RN NOP RESOURCE NUMBER DCB NOP RUNTABLE DATA CONTRL BLK ADDRESS CLAS2 NOP ENTAD NOP EMPAD NOP TEMPS DEF *+1 BSS 100 BLANK ASC 3, BLANP DEF BLANK ILEV3 NOP ACMSK OCT 400 ACTIVITY FLAG MASK .0 DEC 0 .1 DEC 1 .2 DEC 2 .3 DEC 3 .4 DEC 4 .5 DEC 5 .6 DEC 6 .15 DEC 15 .16 DEC 16 .20 DEC 20 .21 DEC 21 .32 DEC 32 .36 DEC 36 .100 DEC 100 .103 DEC 103 .115 DEC 115 .116 DEC 116 .117 DEC 117 .118 DEC 118 .129 DEC 129 .130 DEC 130 .131 DEC 131 .132 DEC 132 .133 DEC 133 .140 DEC 140 .9999 DEC 9999 M1 DEC -1 M3 DEC -3 M7 DEC -7 M8 DEC -8 M15 DEC -15 B20 OCT 20 B40 OCT 40 B377 OCT 377 B6000 OCT 6000 SC NOP SECURITY CODE DINX BSS 1 DSET BSS 1 IERR BSS 1 LEN BSS 1 IOPTN BSS 1 OPEN MODE TEMPP DEF *+1 TEMP1 BSS 1 TEMPNLH2 BSS 1 TEMP3 BSS 1 END /NASMB,R,L,C HED SUBROUTINE DBINT VERSION 1 NAM DBINT,7 92063-12001 REV.1840 780712 * * ************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * * PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ************************************************************** * * * LISTING: 92063-19001 * SOURCE: 92063-18001 * RELOC: 92063-12001 * * ************************************************************* * * * CALLING SEQUENCE : * * CALL DBINT(IBASE,DBSCD,ILIST,ISTAT) * * PARAMETER DESCRIPTION : * * IBASE - AN ASCII ARRAY WHICH CONTAINS THE NAME OF * THE DATA BASE. * * ISCOD - AN INTEGER WHICH IS THE FMP SECURITY CODE * FOR THIS DATA BASE. * * ILIST - A LIST OF ASCII NAMES OF THE MAIN PROGRAM * AND/OR SEGMENTS OF THE DATA BASE PROGRAM. * THERE MUST BE THREE WORDS PER NAME WITH THE * NUMBER OF THE NAMES AS THE FIRST WORD IN * LIST. * * ISTAT - AN INTEGER USED TO RETURN STATUS * INFORMATION TO THE USER. * * * FUNCTION : * * DBINT ALLOCATES SPACE TO BE USED AS BUFFERS FOR * THE USER WRITTEN DATA BASE PROGRAMS. TO DO THIS * IT DETERMINES THE LENGTH OF THE LONGEST SEGMENT * OR MAIN AND THE USES THE SPACE AFTER AS BUFFERS. * IT ALSO DETERMINES WHETHER THERE IS ENOUGH ROOM * TO LOAD THE SPECIFIED ROOT FILE INTO THE BUFFER * AREA AND STILL LEAVE ROOM FOR THE FILE DATA CONTROL * BLOCKS. ALSO THIS ROUTINES DETERMINES THE OPTIMUM * SIZE FOR THE DCB'S WITH THE SPACE AVAILABLE. * * THE DCB'S CAN BE FOUR POSSIBLE COMBINATIONS OF * SIZES WHICH ARE: * * 1. SIX DCB'S OF 272 WORDS EACH. ISIZE SET TO +272 * 2. SIX DCB'S OF 144 WORDS EACH. ISIZE SET TO +144 * 3. ONE DCB OF 272 WORDS. ISIZE SET TO -272 * 4. ONE DCB OF 144 WORDS. INSIZE SET TO -144 * * NOTE: AS MIGHT BE EXPECTED THIS ROUTINE MUST BE * PRIOR TO ANY OTHER DATA BASE SUBROUTINE CALLS. * * * EXTERNALS AND ENTRY POINTS: * ENT DBINT EXT CLOSE,DBSPC,.ENTR,AIRUN,AIDCB,ISIZE,OPEN,LOCF * * IBASE NOP ISCOD NOP ILIST NOP ISTAT NOP * DBINT NOP JSB .ENTR DEF IBASE * *** *** CHANGE REV 1840 * * CHECK TO SEE THAT A DATA BASE IS NOT ALREADY OPEN TO USER IN * AVAILABLE MEMORY. IF SO, WE CANNOT INITIALIZE AVAILABLE MEM- * MORY FOR A NEW DBOPN. * LDB AIRUN IS AIRUN = ZERO? SZB,RSS JMP INT1 YES - NO DATA BASE THERE. * ADB .3 NO - IS STATUS OF RUN TABLE LDA 1,I EQUAL TO "LB"? CPA =ALB JMP E103 YES - A DATA BASE OPEN! * *** *** * INT1 CLA STA ISTAT,I LDA ISCOD,I CMA,INA STA SC MAKE SECURITY CODE NEGATIVE JSB OPEN OPEN DEF *+6 DEF DCB DATA BASE DEF IERR DEF IBASE,I ROOT FILE DEF .1 DEF SC TO DETERMINE SIZE * LDA IERR CPA M7 ILLEGAL SECURITY CODE? JMP E117 YES! CPA M8 JMP E129 LOCKED OR OPEN ERROR SSA ERROR? JMP EFMR YES! * JSB LOCF GET DEF *+7 DEF DCB DEF IERR FILE DEF FWAM DEF FWAM DEF FWAM LENGTH DEF LEN * JSB CLOSE CLOSE DEF *+2 DEF DCB * JSB DBSPC DETERMINE DEF *+4 DEF ILIST,I MAXIMUM DEF FWAM DEF LWAM FREE SPACE AVIALABLE * LDA FWAM FIND ALL SZA,RSS NAMES? JMP E127 NO! * LDA LEN MPY .64 COMPUTE LENGTH STA LEN IN WORDS LDA FWAM SET UP STA AIRUN RUN TABLE ADDRESS * *** *** CHANGE REV 1840 * * ZERO OUT DB STATUS WORD TO RENDERY IT GARBAGE SO IT CANNOT BE MISTAKEN * FOR "LB". * CLB ADA .3 STB 0,I * LDA AIRUN *** *** * CMA,INA ADA LWAM COMPUTE SPACE STA LENF CMA,INA ADA LEN SSA,RSS ENOUGH SPACE FOR RUN TABLE? JMP E128 NO! LDA FWAM COMPUTE ADA LEN ADDRESS FOR DCB'S STA AIDCB CMA,INA ADA LWAM STA LENF CMA,INA ENOUGH ADA .144 SPACE SSA,RSS FOR 1X144? JMP E128 NO! * LDA LENF ADA M1632 SSA,RSS ENOUGH FOR 6X272? JMP A6272 YES! ADA .768 SSA,RSS ENOUGH FOR 6X144? JMP A6144 YES! * LDA LENF ADA M272 SSA,RSS ENOUGH FOR A272? JMP A272 YES! JMP A144 NO! * A6272 LDA .272 RSS A6144 LDA .144 RSS A272 LDA M272 RSS A144 LDA M144 STA ISIZE JMP DBINT,I RETURN * E103 LDA .103 RSS E117 LDA .117 RSS E127 LDA .127 RSS E128 LDA .128 RSS E129 LDA .129 ERROR STA ISTAT,I JMP DBINT,I EFMR CMA,INA FMGR EXIT JMP ERROR * * * CONSTANTS AND TEMPORARY STORAGE * .1 DEC 1 .3 DEC 3 .64 DEC 64 .103 DEC 103 .117 DEC 117 .127 DEC 127 .128 DEC 128 .129 DEC 129 .144 DEC 144 .272 DEC 272 .768 DEC 768 M7 DEC -7 M8 DEC -8 M144 DEC -144 M272 DEC -272 M1632 DEC -1632 FWAM BSS 1 LWAM BSS 1 SC EQU FWAM LEN BSS 1 LENF BSS 1 IERR EQU LENF DCB BSS 144 * END STA ISTAT,I ASMB,R,L,C HED SUBROUTINE DBGET NAM DBGET,7 92063-12001 REV.1826 770601 * * ************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * * PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ************************************************************** * * * LISTING: 92063-19001 * SOURCE: 92063-18001 * RELOC: 92063-12001 * * ************************************************************* * * CALLING SEQUENCE : * * CALL DBGET(IDSET,IMODE,ISTAT,IBUF,IARG) * * PARAMETER DESCRIPTION : * * IDSET - AN ASCII ARRAY WHICH CONTAINS THE NAME OF * A MASTER OR DETAIL DATA-SET. * IMODE - AN INTEGER BETWEEN 1 AND 4 INCLUSIVE WHICH * INDICATES THE TYPE OF GET BEING PERFORMED. * ISTAT - AN INTEGER ARRAY USED TO RETURN STATUS * INFORMATION TO THE USER(MUST BE AT LEAST 4 * WORDS LONG). * IBUF - AN INTEGER ARRAY IN WHICH THE RECORD READ * IS RETURNED TO THE USER. THIS ARRAY MUST * BE OF SUFFICIENT SIZE TO HOLD ONE RECORD * FROM IDSET. * IARG - AN INTEGER ARRAY WHICH CONTAINS EITHER A * RELATIVE RECORD NUMBER (AN INTEGER * OCCUPYING THE FIRST POSITION OF THE ARRAY) * OR A SEARCH ITEM VALUE. * * FUNCTION : * * DBGET IS THE DBMS INTRINSIC WHICH ENABLES THE USER * TO "READ" RECORDS OF THE VARIOUS DATA-SETS OF A * DATA-BASE. HOWEVER,BEFORE READING THESE RECORDS, * DBMS DETERMINES IF THE DATA-SET TO BE REDD IS OPEN * ,AND IF IT IS NOT,OPENS IT. * * DBGET MAY BE EMPLOYED IN VARIOUS MODES AS * DETERMINED BY THE USER PROVIDED VALUE OF IMODE. * EACH OF THESE IS DESCRIBED BELOW. * * IMODE = 1: CHAIN READ * * IN THIS MODE,THE VALUE OF IARG IS IGNORED. IF * IDSET REFERENCES A DETAIL DATA-SET,THE SUCCESSOR * TO THE CURRENT ENTRY,ON THE CURRENT CH(rAIN,IS READ. * IF IDSET IS NOT A DETAIL, AN ERROR IS RETURNED. * * IMODE = 2: SERIAL READ * * IN THIS MODE,THE VALUE OF IARG IS IGNORED. DBGET * SEARCHES THE DATA-SET FROM THE CURRENT ADDRESS * (RECNUM)+1 AND CONTINUES IN THE DIRECTION OF * INCREASING ADDRESSES UNTIL ANOTHER ENTRY IS FOUND * AND THEN "READ". * * IMODE = 3: DIRECTED READ * * IN THIS MODE,IARG IS TREATED AS A POSITIVE INTEGER * .DBGET LOADS THE RECORD LOCATED AT THE RECORD * ADDRESS SPECIFIED BY THE VALUE OF IARG. IF THE * ENTRY IS NOT EMPYT,IT IS "READ". * * NOTE: IF IARG = 0,A PHYSICAL READ WILL NOT BE * PERFORMED,BUT THE CURRENT RECORD BEING ACCESSED * FOR THIS DATA-SET WILL BE RESET TO ZERO. * * IN THE SENSE USED HERE,A RECORD IS A PHYSICAL * LOCATION IN WHICH AN ENTRY RESIDES OR IT IS A * PHYSICAL LOCATION WHICH IS EMPTY. THE DBMS * MAINTAINS EMPTY RECORDS IN A FORMAT WHICH DIFFERS * FROM THOSE WHICH CONTAIN ENTRIES. * * IMODE =4: KEYED READ * * NOTE: THIS MODE IS APPLICABLE TO MASTER DATA-SETS * ONLY. * * IN THIS MODE, THE VALUE REFERENCED BY IARG IS USED * AS A SEARCH ARGUMENT TO DETERMINE A PRIMARY RECORD * ADDRESS. IF THE ADDRESS IS EMPTY OR IF IT CONTAINS * AN ENTRY WHICH IS A SYNONYM, AN ERROR RETURN * OCCURS. OTHERWISE ITS SEARCH ITEM VALUE IS * COMPARED WITH THE VALUE OF IARG. IF IT DOES NOT * MATCH, DBMS SEARCHES ALL OTHER ENTRIES,IF ANY) IN * THE SYNONYM CHAIN UNTIL A MATCH IS FOUND OR UNTIL * THE CHAIN IS EXHAUSTED. IF THE CHAIN IS EXHAUSTED * AN ERROR RETURN OCCURS,OTHERWISE THE MATCHING * ENTRY IS "READ". * * IN ALL MODES,4 VALUES ARE RETURNED IN ISTAT. * * 1. CONDITION WORD A WORD REFLECTING SUCCESSOR * ERROR RESULTING FROM THE * SUBROUTINE CALL. * * 2. RECORD ADDRESS A WORD ADDRESS OF THE * ACCESSED RECORD. * * 3. CHAIN LENGTH A WORD COUNT OF THE NUMBER * OF ENTRIES IN THE CURRENT * CHAIN. * * 4. FhORWARD ADDRESS A WORD ADDRESS OF NEXT * RECORD IN CHAIN IN FORWARD * DIRECTION. * * FOR A DETAIL DATA-SET,THE CHAIN LENGTH IS SET ONLY * AT DBFND TIME AND THE FORWARD ADDRESS APPLIES ONLY * AFTER DBFND AND CHAINED READS. * * * SKP EXT .ENTR,PHIL,PHICM,CMPCT,HASH,PHIS1 EXT AIRUN,PHIRW ENT DBGET * * DSET BSS 1 HOLDS BASE ADDRESS OF DATA-SET DBSTA DEC 3 DSEP1 DEF DSET TEMP1 BSS 1 TEMPORARY STORAGE TEMP3 BSS 1 TEMP4 BSS 1 LSPTR DEF *+1 READ PARAMETER LIST DEF TEMP1,I FILE NAME TEMP2 NOP RECORD NUMBER DEF PARS+3,I BUFFER ADDRESS * .107 DEC 107 .123 DEC 123 .115 DEC 115 .114 DEC 114 .122 DEC 122 .111 DEC 111 .120 DEC 120 .103 DEC 103 .1 DEC 1 .2 DEC 2 .3 EQU DBSTA .4 DEC 4 .8 DEC 8 .11 DEC 11 .12 DEC 12 .15 DEC 15 .16 DEC 16 B104 OCT 104 B377 OCT 377 * * PARS BSS 5 DBGET NOP JSB .ENTR PICK UP PARAMETERS IDSET,IMODE, DEF PARS ISTAT,IBUF,IARG LDA AIRUN ADA DBSTA IS DBSTATUS = "LB" LDA 0,I LDB .103 CPA =ALB JMP *+2 JMP ERROR NO,GO TO ERROR LDA PARS PICK UP BASE ADDRESS JSB PHIS1 OF DATA-SET AND STORE JMP ERROR IT IN DSET STB DSET CLA,INA A REG IS COUNT OF DATA-SETS TO LDB DSEP1 BE OPENED;B-REG IS A POINTER JSB PHIL TO THE BASE ADDRESS OF THE DSET JMP ERROR LDA PARS+1,I IS MODE =1? CPA .1 JMP *+2 JMP DBGT8 NO CHECK FOR IMODE = 2 LDA DSET,I IS DATA-SET TYPE DETAIL? CPA B104 B104 IS AN ASCII "D". JMP *+3 LDB .120 DSET NOT A DETAIL JMP ERROR LDB DSET IS NEXT RECORD # IN CHAIN =0? ADB .11 LDA 1,I LDB .111 SZA,RSS JMP ERROR YES, GO TO ERROR LDB DSET TEMP1 IS POINTER TO DATA-SET ADB .12 NAME STB TEMP1 STA TEMP2 TEMP2 CONTAINS NEXT RECORD # LDA LSPTR READ LIST PTR CLB * JSB PHIRW READ NEXT RECORD # IN THE CHAIN JMP ERR1 ERROR LDA PARS+3,I CHECK FOR EMPTY DETAIL RECORD CPA .1 JMP *+3 LDB .114 JMP ERROR LDB DSET STORE NEXT RECORD NUMBER IN ADB .8 CURRENT RECORD NUMBER LDA TEMP2 STA 1,I LDB DSET PICK UP PATH NUMBER FOR CURRENT ADB .4 CHAIN AND,IF IT IS ZERO, THEN GO LDA 1,I TO ERROR. AND B377 LDB .122 SZA,RSS JMP ERROR ALS USE PATH NUMBER OF CURRENT CHAIN ADA PARS+3 TO INDEX MEDIA RECORD OF IBUF * PICKING UP THE FORWARD POINTER LDB DSET IN CHAIN AND STORING IT IN NEXT ADB .11 RECORD # TO BE ACCESSED. LDA 0,I STA 1,I CLA ISTAT(1)= 0 STA PARS+2,I ISTAT(2)= ACCESSED RECORD# ISZ PARS+2 ISTAT(3)= PATH LENGTH OF CURRENT LDB DSET CHAIN ADB .8 ISTAT(4)= NEXT RECORD # TO BE LDA 1,I ACCESSED STA PARS+2,I ISZ PARS+2 ISZ 1 LDA 1,I STA PARS+2,I ISZ PARS+2 ADB .2 LDA 1,I STA PARS+2,I DBGT5 LDB DSET TEMP2 = IBUF+MEDIA LENGTH FOR ADB .1 THIS RECORD AND THUS POINTS TO LDA 1,I FIRST WORD IN LOGICAL RECORD. ADA PARS+3 STA TEMP2 LDB DSET PICK UP THE NUMBER OF FIELDS IN ADB .3 THE RECORD,NEGATE IT AND STORE LDA 1,I IN TEMP3 ALF,ALF AND B377 CMA,INA STA TEMP3 LDB DSET TEMP4 POINTS TO FIRST WORD OF ADB .16 RECORD DEFINITION TABLE STB TEMP4 DBGT6 LDA TEMP4,I IS READ BIT OF THIS FIELD SET? LDB 0 AND B377 ARS,ARS SLB JMP DBGT7 YES,PROCES &S NEXT FIELD CMA,INA NO,ZERO OUT THIS FIELD CLB STB TEMP2,I ISZ TEMP2 ISZ 0 JMP *-3 DBGT7 ADA TEMP2 STA TEMP2 ISZ TEMP4 ISZ TEMP3 JMP DBGT6 JMP DBGET,I RETURN DBGT8 CPA .2 IS IMODE = 2? JMP *+2 YES JMP DBG11 NO LDB DSET TEMP2 IS EQUAL TO THE NEXT ADB .8 SERIAL RECORD TO BE ACCESSED CLA,INA ADA 1,I STA TEMP2 DBGT9 LDB DSET IS NEXT RECORD NUMBER TO BE READ ADB .15 > THAN THE CAPACITY OF THIS DATA LDA TEMP2 -SET ? CMA,INA ADA 1,I SSA,RSS JMP *+4 CLA YES,SET THE RECORD # TO BE STA TEMP2 RETURNED IN ISTAT(2)=0 JMP DBG10-4 LDB DSET TEMP1 = POINTER TO DATA-SET NAME ADB .12 STB TEMP1 LDA LSPTR READ LIST PTR CLB * JSB PHIRW READ RECORD TEMP2 FROM DATA SET JMP ERR1 LDA PARS+3,I IF FIRST WORD OF RECORD BUFFER SZA IS 0 THEN ATTEMPT TO READ NEXT JMP *+3 SERIAL RECORD; OTHERWISE RETURN ISZ TEMP2 TO USER. JMP DBGT9 LDB DSET STORE NON-EMPTY RECORD ADDRESS ADB .8 INTO CURRENT RECORD BEING LDA TEMP2 ACCESSED. STA 1,I DBG10 CLA ISTAT(1)= 0 LDB TEMP2 ISTAT(2)= CURRENTLY ACCESSED STA PARS+2,I RECORD NUMBER ISZ PARS+2 ISTAT(3)= 0 STB PARS+2,I ISTAT(4)= 0 ISZ PARS+2 STA PARS+2,I ISZ PARS+2 STA PARS+2,I SZB JMP DBGT5 JMP DBGET,I DBG11 CPA .3 IS IMODE = 3 ? JMP *+2 YES JMP DBG12 NO LDA PARS+4,I TEMP2 = RECORD # STA TEMP2 IF IARG IS LESS THAN LDB .111 ZERO OR GREATER THAN THE SZA,RSS CAPACITY OF THIS DATA-SET THEN JMP DBG10-4 IF = TO ZERO,THEN RESET SSA JMP ERROR CMA,INA LDB DSET ADB .15 ADA 1,I LDB .111 SSA JMP ERROR LDB DSET TEMP1 = POINTER TO DATA-SET NAME ADB .12 STB TEMP1 LDA LSPTR READ LIST PTR CLB * JSB PHIRW READ RECORD FROM TEMP2 FROM DATA SET JMP ERR1 ERROR LDA PARS+3,I IF IBUF(1) =0 THEN GO TO ERROR( LDB .114 EMPTY RECORD). SZA,RSS JMP ERROR JMP DBG10-4 DBG12 CPA .4 IS IMODE =4? JMP *+3 LDB .115 NO,GO TO ERROR JMP ERROR LDA DSET,I LDB .123 IF DATA-SET IS A DETAIL THEN GO CPA B104 TO ERROR ROUTINE. JMP ERROR LDB DSET USING THE VALUE OF CRITCT, INDEX ADB .4 THE RECORD DEFINITION TABLE TO LDA 1,I PICK UP THE ITEM LENGTH OF THE ALF,ALF SEARCH FIELD AND STORE IT IN AND B377 TEMP3 ADB .11 ADB 0 LDA 1,I AND B377 ARS,ARS STA TEMP3 JSB HASH PICK UP THE HASH VALUE AND DEF *+3 DEF PARS+4,I RETURN THE POSITIVE INTEGER IN DEF TEMP3 THE A-REGISTER. LDB DSET ADB .15 LDB 1,I STB TEMP2 CLB DIV TEMP2 TEMP2 = A-REGISTER MOD(CAPACITY INB STB TEMP2 OF THIS DATA-SET,I.E. THE # OF LDB DSET RECORDS)+1 ADB .12 STB TEMP1 TEMP1 IS POINTER TO DSET NAME LDA LSPTR READ LIST PTR CLB * JSB PHIRW READ RECORD TEMP2 FROM DATA SET JMP ERR1 LDA PARS+3,I CHECK FOR NON-PRIMARY HASH CPA .1 JMP *+3 LDB .107 JMP ERROR LDB DSET CALCULATE ADDRESS OF FIRST WORD INB OF SEARCH FIELD IN IBUF LDA 1,I ADA PARS+3 TEMP4 = POINTER TO 1ST WORD PAST STA TEMP4 THE MEDIA RECORD IN IBUF LDA TEMP3 COMPCT IS A LOCATION IN PHICM STA CMPCT WHICH INDICATED THE# OF X*($ LDB DSET CHARACTERS TO COMPARE ADB .4 LDA 1,I USING THE VALUE IN CRITCT AS AN ALF,ALF INDEX, BUMP THE TEMP4 POINTER AND B377 AHEAD UNTIL IT IS POINTING AT CMA,INA THE FIRST WORD OF THE SEARCH LDB DSET FIELD. ADB .16 STB TEMP3 TEMP3 IS USED TO POINT TO THE LDB 0 RECORD DEFINITION TABLE JMP *+7 LDA TEMP3,I AND B377 ARS,ARS ADA TEMP4 STA TEMP4 ISZ TEMP3 ISZ 1 JMP *-7 DBG13 LDA PARS+4 IARG ADDRESS LDB TEMP4 POINTER TO 1ST WORD OF SEARCH * FIELD IN IBUF JSB PHICM PHICM COMPARES THE STRINGS JMP *+2 POINTED TO BY THE A+B REGISTERS. JMP DBG10-4 IF THE STRINGS MATCH, THEN P+2, LDA PARS+3 OTHERWISE P+1. ADA .2 LDA 0,I IF FORWARD SYNONYM POINTER = 0, LDB .107 THEN GO TO ERROR SZA,RSS JMP ERROR STA TEMP2 LDA LSPTR READ LIST PTR CLB * JSB PHIRW READ RECORD INDICATED BY SYNONYM RSS ERROR! JMP DBG13 ERR1 CMB,INB ERROR STB PARS+2,I JMP DBGET,I END *ASMB,R,L,C HED IMAGE-RTE NAM FMERR,7 92063-12001 REV.1826 771027 * * ************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * * PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ************************************************************** * * * LISTING: 92063-19001 * SOURCE: 92063-18001 * RELOC: 92063-12001 * * ************************************************************* * * * * ENTRY POINTS AND EXTERNS * ENT FMERR * * EXT REIO,.ENTR * SUP PRESS LISTING * * CALLING SEQUENCE: * * CALL FMERR(FMP ERROR #,LOGICAL UNIT #) * * WHERE: ERROR # IS NEG # RETURNED BY FMP * LOG UNIT # IS THE DEVICE THE ERROR MESSAGE * IS TO BE PRINTED ON * * * * * ERNUM NOP LU NOP FMERR NOP JSB .ENTR DEF ERNUM * LDA ERNUM,I GET ERROR NUMBER STA LCNTR SAVE ERROR NUMBER FOR COUNTER LDB FMESA GET ADDRESS OF FMP ERRORS PRMS1 LDA 1,I GET LENGTH OF MESSAGE INB MOVE PNTR TO MESSAGE ISZ LCNTR INDEX ERROR CNTR, IS IT = 0? RSS NO, MOVE PNTR TO NEXT MESSG JMP PRMS2 YES - GO PRINT MESSAGE SLA IF CHAR COUNT ODD, INA MAKE EVEN ARS CONVERT TO WORDS ADB 0 MOVE PNTR TO NEXT MESSG JMP PRMS1 GO INDEX ERROR COUNTER PRMS2 STB BUF SET UP MESSAGE ADDRESS CMA,INA STA IL SET UP MESSAGE LENGTH * LDA LU,I IOR B200 STA LIST JSB REIO PRINT DEF *+5 DEF .2 THE ERROR DEF LIST DEF BUF,I MESSAGE DEF IL * JMP FMERR,I * * .2K!   DEC 2 B200 OCT 200 LIST NOP LCNTR NOP MESSAGE COUNTER BUF NOP ADDRESS OF MESSAGE IL NOP LENGTH OF MESSAGE *********************** * * * ERROR MESSAGE TABLE * * * *********************** * FMESA DEF *+1 DEC 9 ASC 5,DISK DOWN DEC 14 ASC 7,DUPLICATE NAME DEC 0 DEC 32 ASC 16,MORE THAN 32,767 RECORDS IN FILE DEC 37 ASC 19,READ OR WRITE TO A RECORD NOT WRITTEN DEC 48 ASC 24,FILE NOT FOUND OR CARTRIDGE NOT FOUND OR NO ROOM DEC 21 ASC 11,INVALID SECURITY CODE DEC 49 ASC 25,FILE CURRENTLY OPEN OR EXCLUSIVE OR LOCK REJECTED DEC 0 DEC 0 DEC 12 ASC 6,DCB NOT OPEN DEC 25 ASC 13,SOF OR EOF READ OR SENSED DEC 16 ASC 8,CARTRIDGE LOCKED DEC 14 ASC 7,DIRECTORY FULL DEC 12 ASC 6,ILLEGAL NAME DEC 24 ASC 12,ILLEGAL TYPE OR SIZE = 0 DEC 31 ASC 16,ILLEGAL READ OR WRITE ON TYPE 0 * END  ASMB,R,L,C HED 'DBPUT' SUBROUTINE OF 'DBMS' NAM DBPUT,7 92063-12001 REV.1826 771027 * * ************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * * PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ************************************************************** * * * LISTING: 92063-19001 * SOURCE: 92063-18001 * RELOC: 92063-12001 * * ************************************************************* * * * * * * * ************************************************************************ * * * * DBPUT SUBROUTINE OF THE DBMS * * * * * * INPUT: * * * IDSET - LABEL OF A FIELD WHOSE CONTENT IS THE * * * DATA SET NAME * * * * * * ISTAT - LABEL OF A ONE WORD FIELD WHICH IS TO * * * BE USED TO RETURN STATUS INFORMATION * * * * * * INBR - LABEL OF A FIELD WHERE THE FIRST WORD * * * OF THE FIELD IS A COUNT OF THE NUMBER * * * OF ITEMS TO UPDATE AND THE REMAINING * * * WORDS ARE THE ITEM NUMBERS TO UPDATE * * * * * * IVALU - LABEL OF A FIELD WHOSE CONTENTS ARE * * * THE CONCATENATED VALUES OF THE ITEMS * * * SPECIFIED IN 'INBR' * * * * * * IBUF - LABEL OF A FIELD WHICH IS TO BE USED * * * TO HOLD THE RECORD BEING UPDATED * * * * * * * * * OUTPUT: * * * NO ERROR - 1) ISTAT =0 * * * 2) RECORD IS WRITTEN AND ANY AND * * * ALL CHAINS AND/OR LINKAGES ARE * * * UPDATED. * * * * * * ERROR - ISTAT = ERROR NUMBER * * * * * * * * FUNCTION: * * 'DBPUT' ADDS A NEW DATA ENTRY TO THE DATA * * SET IDENTIFIED BY 'IDSET'. * * * * 'DBPUT' APPLIES TO BOTH DETAIL AND MANUAL * * MASTER DATA SETS * * * * 'DBPUT' TO A DETAIL DATA SET CAUSES: * * * * 1) A DATA ENTRY TO BE BUILT IN 'IBUF' * * FROM THE FIELDS SPECIFIED IN 'INBR' * * AND VALUES SPECIFIED IN 'IVALU'. m; * * 2) THE DATA ENTRY IN 'IBUF' TO BE * * WRITTEN AT THE HEAD OF THE FREE * * RECORD CHAIN * * 3) THE FREE COUNT OF THE DETAIL TO BE * * DECREMENTED BY 1 * * 4) THE MASTER DATA SET(S) ASSOCIATED * * WITH THE DETAIL TO HAVE THEIR * * RESPECTIVE CHAIN(S) UPDATED. IF NO * * ENTRY EXISTS FOR AN ASSOCIATED * * AUTOMATIC MASTER AN ENTRY IS CREATED * * AND THE FREE COUNT OF THE AUTOMATIC * * MASTER IS DECREMENTED BY 1. AN ERROR * * OCCURS IF NO ENTRY EXISTS IN AN * * ASSOCIATED MANUAL MASTER * * * * 'DBPUT' TO A MANUAL MASTER CAUSES: * * * * 1) A DATA ENTRY TO BE BUILT IN 'IBUF' * * FROM THE FIELDS SPECIFIED IN 'INBR' * * AND VALUES SPECIFIED IN 'IVALU' * * 2) THE DATA ENTRY IN 'IBUF' TO BE * * WRITTEN AT THE HASHED RECORD NUMBER. * * AND ERROR RESULTS IF A DATA ENTRY * * EXISTS WITH A DUPLICATE SEARCH * * FIELD VALUE. * * * ************************************************************************ * * * *  * * ENT DBPUT EXT .ENTR,PHIL,PHIS1,PHIZR,PHIRP,PHIRW EXT PTFRE,GTFRE,HASH,AIRUN EXT PHIMV,PHIMC EXT PHICM,CMPCT SKP * * * * ***** EQUATES ***** * * * * A EQU 0 A REGISTER B EQU 1 B REGISTER * ***** CONSTANTS * * M5 DEC -5 DEC -5 M4 DEC -4 DEC -4 M3 DEC -3 DEC -3 M1 DEC -1 DEC -1 B377 OCT 377 OCTAL '000377' HIMSK OCT 177400 OCTAL '177400' B400 OCT 400 SKP ************************************************************************ * * * * RUN TABLE FOR IMAGE 1000 * * * * * * THE RUN TABLE IS COMPRISED OF THE FOLLOWING SECTIONS: * * * * * * 1) DATA BASE CONTROL BLOCK * * * 2) ITEM TABLE * * * 3) DATA SET TABLE * * * * * * THESE SECTIONS APPEAR IN THE ORDER DESCRIBED. * * * DETAILS OF EACH SECTION FOLLOW. * * * * * ************************************************************************ ***** ********* * * * * DATA BASE CONTROL BLOCK & * * * * * ***** ********* DBLNG DEC 55 DATA BASE CONTROL BLOCK LENGTH DBZ DEC 0 DATA BASE LOCK FLAG .1 DEC 1 ACSUB DEC 2 1ST BYTE : ACTIVITY FLAG * 2ND BYTE : SUBCHANNEL # DBSTA DEC 3 DATA BASE STATUS DBSCD DEC 4 DATA BASE SECURITY CODE(FMP) DBICT DEC 5 DATA BASE ITEM COUNT DBSCT DEC 6 DATA BASE DATA SET COUNT DBITB DEC 7 ADDRESS OF ITEM TABLE DBSTB DEC 8 ADDRESS OF DATA SET TABLE DBLMD DEC 9 DATA BASE ACCESS LEVEL AND MODE DBLVL EQU DBZ+9 1ST BYTE: ACCESS LEVEL GRANTED BY 'DBOPN' DBMOD EQU DBZ+9 2ND BYTE: MODE GRANTED BY 'DBOPN' DBILV DEC 10 DATA BASE ITEM LEVEL WORDS - 3 WORDS/LEVEL DBOCT EQU DBZ+10 DATA SET OPEN COUNT ***** ********* * * * * ITEM TABLE - ONE FIVE-WORD ENTRY PER ITEM * * * * * ***** ***** ITLNG EQU DBZ+5 ITEM ENTRY LENGTH ITNME EQU DBZ ITEM NAME(LEFT JUSTIFIED) ITRWL EQU DBZ+3 ITEM READ/WRITE MINIMUM ACCESS LEVEL ITRDL EQU DBZ+3 1ST BYTE: MINIMUM ACCESS LEVEL TO READ ITEM ITWRL EQU DBZ+3 2ND BYTE: MINIMUM ACCESS LEVEL TO WRITE ITEM ITTDN EQU DBZ+4 ITEM TYPE AND DATASET NUMBER ITTYP EQU DBZ+4 1ST BYTE: ITEM TYPE ITDSN EQU DBZ+4 2ND BYTE: ITEM DATASET NUMBER ***** ********* * * * * DATA SET TABLE - COMPRISED OF THE FOLLOWING SECTIONS IN * * * THE ORDER PRESENTED: * * *  * * * 1) DATA SET CONTROL BLOCK * * * 2) RECORD DEFINITION TABLE * * * 3) MASTER PATH TABLE, DETAIL PATH TABLE, * * * OR NO PATH TABLE * * * * * ***** ********* * * * * * * ***** DATA SET CONTROL BLOCK ***** * * * * * * DSLNG DEC 16 DATA SET CONTROL BLOCK LENGTH DSTYP EQU DBZ DATA SET TYPE DSMDL DEC 1 DATA SET MEDIA RECORD LENGTH DSENL EQU DBZ+2 DATA SET LOGICAL RECORD LENGTH DSFPC EQU DBZ+3 DATA SET FIELDS/ENTRY AND PATHS/ENTRY DSFCT EQU DBZ+3 1ST BYTE: FIELDS/ENTRY DSPCT EQU DBZ+3 2ND BYTE: PATHS/ENTRY DSCPN EQU DBZ+4 DATA SET SRCH FIELD NO. AND PATH NO. OF CURR. CHAIN DSCCT EQU DBZ+4 1ST BYTE: FIELD NUMBER OF SRCH ITEM(0 IF DETAIL) DSPAN EQU DBZ+4 2ND BYTE: PATH NUMBER OF CURRENT CHAIN DSPAT EQU DBZ+5 ADDRESS OF PATH TABLE DSFRC EQU DBZ+6 FREE CHAIN COUNT(DETAIL)/FREE RECORD COUNT(MASTER) DSFRH EQU DBZ+7 0 OR RECORD NO.OF 1ST FREE RECORD IN CHAIN DSRCN EQU DBZ+8 LAST ACCESSED RECORD NUMBER DSPAL EQU DBZ+9 0 OR PATH LENGTH OF CURRENT CHAIN DSCHF EQU DBZ+10 0 OR RECORD NUMBER OF CURRENT CHAIN FOOT DSFWN DEC 11 0 OR NEXT RECORD NUMBER IN CHAIN DSNME DEC 12 DATA SET NAME(LEFT JUSTIFIED) DSCAP DEC 15 CAPACITY(MAXIMUM NUMBER OF RECORDS) * * * * b * * ***** RECORD DEFINITION TABLE - ONE ONE-WORD ENTRY PER FIELD ********* * * * * * * RDLNG EQU DBZ+1 RECORD DEFINITION TABLE ENTRY LENGTH RDINF EQU DBZ ITEM NUMBER OF FIELD,ITEM LENGTH AND ACCESSABILITY RDITN EQU DBZ 1ST BYTE: ITEM NUMBER OF FIELD RDILA EQU DBZ 2ND BYTE: ITEM LENGTH AND R/W ACCESSABILITY RDITL EQU DBZ 1ST 6 BITS: ITEM LENGTH RDWRA EQU DBZ 7TH BIT: ITEM WRITE ACCESSABILITY RDRDA EQU DBZ 8TH BIT: ITEM READ ACCESSABILITY * * * * ***** PATH TABLE(MASTER) - ONE TWO-WORD ENTRY PER PATH ***** * * * * * PTMLG EQU DBZ+2 MASTER PATH TABLE ENTRY LENGTH PTMSD EQU DBZ DETAIL DATASET SRCH ITEM NO. AND DATA SET NO. PTMSN EQU DBZ 1ST BYTE: DETAIL DATA SET SEARCH ITEM NUMBER PTMDN EQU DBZ 2ND BYTE: DETAIL DATA SET NUMBER PTMPS EQU DBZ+1 DETAIL DATA SET PATH NUMBER AND SCRATCH PTMPN EQU DBZ+1 1ST BYTE: DETAIL DATA SET PATH NUMBER PTMSC EQU DBZ+1 2ND BYTE: SCRATCH * * * * * * ***** PATH TABLE(DETAIL) - ONE TWO-WORD ENTRY PER PATH ********* * * * * * * PTDLG EQU DBZ+2 DETAIL PATH TABLE ENTRY LENGTH PTDSM EQU DBZ SEARCH FIELD NO. IN DETAIL AND MASTER DATA SET NO. PTDSF EQU DBZ 1ST BYTE: SEARCH FIELD NUMBER IN DETAIL PTDMN EQU DBZ 2ND BYTE: MASTER DATA SET NUMBER PTDPS EQblU DBZ+1 MASTER DATA SET PATH NUMBER AND SCRATCH PTDPN EQU DBZ+1 1ST BYTE: MASTER DATA SET PATH NUMBER PTDSC EQU DBZ+1 2ND BYTE: SCRATCH SKP ******************************************************************** * * * PICK UP PARAMETERS AND CHECK THAT DATA BASE IS OPEN, * * THE ACCESS MODE IS EQUAL TO OR GREATER THAN 3 AND WHETHER THE* * PUT REQUEST IS FOR A DETAIL OR MASTER DATA SET * * * ******************************************************************** IDSET BSS 1 ADDR OF DATA SET NAME ISTAT BSS 1 ADDR OF STATUS WORD INBR BSS 1 ADDR OF ITEM COUNT AND ITEM NO'S IVALU BSS 1 ADDR OF CONCATENATED ITEM VALUES IBUF BSS 1 ADDR OF BUFFER DBPUT NOP JSB .ENTR PICK UP THE PARAMETERS DEF IDSET LDB AIRUN SET ACTIVITY FLAG TO "1" ADB ACSUB LDA B,I IOR B400 STA B,I LDA AIRUN GET ADDR OF RUN TABLE ADA DBSTA GET STATUS LDB LEEBO CPB A,I IS DATA BASE OPEN ? RSS YES JMP ER1 NO ADA .6 INCREMENT TO MODE LDA A,I GET MODE AND B377 CPA .3 IS IT MODE 3 ? JMP MODE3 YES, OK! CPA .2 IF MODE 2 CHECK FOR LOCKING FLAG SET RSS YES! JMP ER2 NOT A LEGAL MODE * * IS OPEN LEVEL =15 AND MODE =2? IF NOT ERROR 109. * LDA AIRUN ADA DBLVL GET LDA A,I ACCESS ALF,ALF LEVEL AND B377 CPA .15 LEVEL = 15? RSS YES! JMP ER9 NO, ERROR 109 * JSB GTFRE GET FREE LIST SET UP IN RUN TABLE FROM SYS AV MEME JMP ERROR NOT FOUND ERROR EXIT LDA AIRUN IS LOCKING FLAG LDA 0,I SZA,RSS SET? JMP ER8 NO LOCKING FLAG SET! MODE3 LDA IDSET JSB PHIS1 JMP ERRTN STB DSPT1 STORE DSCB ADDR STA DSET# STORE DSCB NO. LDA B,I GET DATA SET TYPE CPA DETAL DETAIL DATA SET ? RSS YES JMP MAMEC NO ADB DSFRC INCREMENT TO FREE COUNT FIELD CLA CPA B,I IS FREE COUNT 0 ? JMP ER4 YES ADB M3 DECREMENT TO PATH COUNT FIELD LDA B,I GET PATH COUNT AND B377 SZA,RSS PATH COUNT 0 ? JMP BBUF1 YES SPC 3 ******************************************************************* * * * * THE FOLLOWING CODE VERIFIES THAT THE ITEM NUMBER OF EACH * * * SEARCH FIELD IN THE PATH TABLE IS PRESENT IN THE 'INBR' * * * LIST OF ITEM NUMBERS SUPPLIED BY THE CALLER. * * * * ******************************************************************* * STA PTCT1 SAVE PATH COUNT LDA DSPT1 GET DSCB ADDR JSB PHIRP CALC RCD DEFN AND PATH TBL ADDR STA RDPT1 SAVE RCD DEFN TBL ADDR STB PTPT1 SAVE PATH TABLE ADDR VSFLD EQU * LDA PTPT1,I GET THE SEARCH FIELD NUMBER AND HIMSK ALF,ALF LDB DSPT1 DSCB ADDR JSB PHISI SRCH FLD ITEM NO. IN 'INBR' ? JMP ERRTN NO LDB PTPT1 CALC. ADDR OF NEXT PATH ENTRY ADB PTDLG STB PTPT1 SAVE NEW ADDR LDB PTCT1 DECREMENT PATH COUNT ADB M1 STB PTCT1 SAVE NEW COUNT SZB HAVE ALL PATHS BEEN VERIFIED ? JMP VSFLD NO SPC 3 * * * * ***** BUILD THE OUTPUT RECORD ***** *  * * * BBUF1 EQU * JSB PHIBB BUILD THE OUTPUT RECORD JMP ERRTN NO, INVALID ITEM NUMBER SPC 3 ******************************************************************** * * * THE FOLLOWING CODE BUILDS A LIST OF ADDRESSES OF DATA SET * * * CONTROL BLOCKS THAT MUST BE OPEN BEFORE 'DBPUT CAN PROCEED. * * * ONCE THE LIST IS BUILT CONTROL IS GIVEN TO 'PHIL' TO OPEN * * * THE DATA SETS IN THE LIST. * * * * ******************************************************************* * LDA AOPLS INIT. ADDR AT START OF OPEN LIST STA OPLCA LDA DSPT1 CALC. ADDR OF PATH TABLE JSB PHIRP CALC. PATH TABLE ADDR STB PTPT1 SAVE PATH TABLE ADDR CLA,INA STA OPCNT OPEN COUNT IS 1(DETAIL DATA SET) LDA DSPT1 STA OPLCA,I STORE DETAIL DSCB ADDR IN LIST ADA DSPCT GET PATH COUNT LDA A,I AND B377 STA PTCT1 STORE PATH COUNT GNMAS EQU * SZA,RSS PATH COUNT = 0 ? JMP OPDST YES LDA PTPT1,I GET MASTER DATA SET NUMBER AND B377 STA MDST# SAVE MASTER DATA SET NUMBER LDA AMDS# ADDR OF DSCB NO. FOR CALC. JSB PHIS1 GET DSCB ADDR AND DATA SET NO. JMP ERRTN BRANCH NEVER OCCURS ISZ OPLCA INCR. TO NEXT OPEN LIST ENTRY STB OPLCA,I STORE ADDR IN OPEN LIST ISZ OPCNT INCREMENT OPEN LIST COUNT LDA PTCT1 DECREMENT PATH COUNT ADA M1 STA PTCT1 STORE NEW COUNT LDB PTPT1 INCR. TO NEXT TBL ENTRY ADB PTDLG STB PTPT1 JMP GNMAS CONTINUE OPDST EQU * LDA OPCNT GET OPEN COUNT LDB AOPLS GET OPEN LIST ADDR. JSB PHIL ALL DATA SETS IN LIST OPEN ? JMP ERRTN NO SPC 3 * * * * ***** CHECK IF THERE ARE ANY ASSOCIATED MASTERS TO UPDATE ***** * * * * LDA DSPT1 GET PATH COUNT ADA DSPCT LDA A,I AND B377 SZA,RSS IS IT 0 ? JMP WRREC YES STA PTCT1 STORE PATH COUNT LDA DSPT1 GET DSCB ADDR JSB PHIRP CALC. RCD DEFN AND PATH TBL ADDR STA RDPT1 STORE RCD DEFN TBL ADDR STB PTPT1 STORE PATH TABLE ADDR LDA AMASE STORE START. ADDR OF MASTER TBL STA CMASE SPC 3 SKP ******************************************************************** * * * CHECK THE MASTER DATA SET ASSOCIATED WITH EACH PATH IN THE * * DETAIL FOR THE TYPE OF LINKAGE MAINTENANCE THAT IS * * REQUIRED TO ADD THE NEW RECORD TO THE DETAIL DATA SET * * * ******************************************************************** CNXMA EQU * LDA DSPT1 GET DSCB ADDR LDB PTPT1 ADDR OF CURR. PATH TBL ENTRY JSB PHIRM HASH RCD NO. ENTRY READ ? JMP ERRTN NO LDA CMASE GET CURR. MSTR DSCB ADDR ADA M4 LDB A,I STB CMDSC SAVE CURR. MSTR DSCB ADDR ADA M1 RESET CURR. MSTR TABLE ENTRY STA CMASE LDA AICBF,I GET ENTRY INIDCATOR SZA,RSS DOES AN ENTRY ALREADY EXIST ? JMP CKMAN NO SSA,RSS DOES AN ENTRY ALREADY EXIST ? JMP CKSYN YES CKMAN EQU * LDB MANUL CPB CMDSC,I MANUAL MASTER ? JMP ER3 YES HFBLDB PTPT1 GET PATH TABLE ADDR ADB PTDSC LDA B,I AND HIMSK INA STA B,I SET SCRATC FLAG TO 1 CMFCT EQU * LDA CMDSC GET MASTER FREE COUNT ADA DSFRC LDA A,I SZA,RSS ANY RECORD NO. AVAILABLE ? JMP ER5 NO JMP DPTCT YES CKSYN EQU * JSB PHISY DUPLICATE ENTRY EXIST ? JMP ERRTN ERROR RSS YES JMP CKMN1 NO LDB PTPT1 GET PATH TABLE ADDR ADB PTDSC LDA B,I AND HIMSK STA B,I SET SCRATCH FLAG TO 0 JMP DPTCT CKMN1 EQU * LDB MANUL CPB CMDSC,I IS TYPE MANUAL ? JMP ER3 YES LDB PTPT1 GET PATH TABLE ADDR ADB PTDSC LDA B,I AND HIMSK ADA .2 STA B,I SET SCRATCH FLAG TO 2 JMP CMFCT DPTCT EQU * LDA CMASE INCR. TO NEXT MSTR TBL ENTRY ADA .5 STA CMASE ISZ PTPT1 INCR. TO NEXT PATH TABLE ENTRY ISZ PTPT1 LDA PTCT1 DECR. PATH COUNT ADA M1 STA PTCT1 SZA ALL PATHS EXHAUSTED ? JMP CNXMA NO GH SKP ******************************************************************** * * * UPDATE EACH ASSOCIATED MASTER DATA SET WITH THE LINKAGES * * NEEDED TO REFLECT THE ADDITION OF THE NEW RECORD * * * ******************************************************************** LDA DSPT1 GET PATH COUNT ADA DSPCT LDA A,I AND B377 STA PTCT1 STORE PATH COUNT LDA DSPT1 JSB PHIRP GET RCD DEFN TBL & PATH TBL ADDR STA RDPT1 SAVE RCD DEFN TABLE ADDR STB PTPT1 STORE PATH TABLE ADDR LDA IBUF CALC. ADDR OF 1ST CHN IN DETAIL INA STA DTMDA LDA AMASE STA CMASE GET START OF MASTER TABLE UPNMS EQU * LDA CMASE GET CURR. MSTR DSCB ADDR INA LDA A,I STA CMDSC SAVE CURR. MSTR DSCB ADDR LDA PTPT1 GET SCRATCH FLAG ADA PTDSC LDA A,I AND B377 SZA DOES AN ENTRY EXIST IN MASTER ? JMP CRENT NO LDA CMDSC GET RCD NO. OF MASTER ENTRY ADA DSRCN LDB A,I STB RWRCN RECORD NO. FOR READ ADA .4 STA RWFNM ADDR OF DATA SET NAME FOR READ CLB READ FLAG LDA ARWPL PARM LIST ADDR FOR READ JSB PHIRW SYNONYM READ JMP ERRTN NO * * * * * UPDATE THE RESPECTIVE CHAIN ENTRY IN THE MASTER DATA SET * * MEDIA RECORD. UPDATE THE FOOT OF THE CHAIN IN THE DETAIL * * DATA SET WITH A FORWARD SYNONYM POINTER TO THE NEW FOOT * * * * * WNMEN EQU * LDA PTPT1 GET PATH NO. FOR MASTER DATA SET ADA PTDPN LDA A,I AND HIMSK ALF,ALF ADA M1 MPY .3 CALC. CHAIN ENTRY OFFSET LDB AICBF ADB .3 ADB A CALC. ADDR OF CHAIN ENTRY STB CHNPT ISZ B,I INCR. CHAIN COUNT INB LDA B,I SZA,RSS ANY ENTRIES ON CHAIN ? JMP NLCHN NO STA TBWDA SAVE RECORD NO. OF OLD FOOT LDB DSPT1 GET RECORD NUMBER OF NEW FOOT ADB DSFRH LDB B,I LDA CHNPT INA STB A,I LDA ARWPL PUT NEW FOOT IN MSTR CHAIN ENTRY CLB,INB JSB PHIRW UPDATED MASTER RECORD WRITTEN ? JMP ERRTN NO LDA PTPT1 GET SCRATCH FLAG ADA PTDSC LDA A,I AND B377 SZA,RSS WAS A NEW RCD ADDED TO MSTR ? JMP UPDET NO LDB CMDSC DECR. MSTR FREE COUNT ADB DSFRC LDA B,I ADA M1 STA B,I STORE NEW FREE COUNT UPDET EQU * LDA DSPT1 GET DETAIL DSNAME FOR READ ADA DSNME STA RWFNM LDA TBWDA GET RCD NO. TO READ(OLD FOOT) STA RWRCN LDA ARWPL ADDR OF R/W PARM LIST CLB READ FLAG JSB PHIRW OLD FOOT RECORD READ ? JMP ERRTN NO LDA DSPT1 SET FORWARD PTR IN OLD FOOT TO ADA DSFRH RECORD NO. OF NEW FOOT LDA A,I LDB IBUF CMB,INB ADB DTMDA ADB AICBF INB STA B,I STORE FWD SYN PTR LDA ARWPL ADDR OF PARM LIST FOR R/W CLB,INB WRITE FLAG JSB PHIRW RECORD WRITTEN ? JMP ERRTN NO LDA TBWDA STORE OLD FOOT IN BACKWARD PTR STA DTMDA,I OF NEW DETAIL MEDIA ENTRY JMP CKPTE CONTINUE NLCHN EQU * LDA DSPT1 GET DETAIL FREE RECORD NO. ADA DSFRH LDA A,I LDB CHNPT INB STA B,I STORE RCD NO. AS CHAIN FOOT INB STA B,I STORE RCD NO. AS CHAIN HEAD LDA ARWPL ADDR OF R/W PARM LIST CLB,INB WRITE FLAG JSB PHIRW MASTER RECORD WRITTEN JMP ERRTN NO LDA PTPT1 GET SCRATCH FLAG ADA PTDSC LDA A,I AND B377 SZA,RSS WAS A NEW RCD ADDED TO MSTR ? JMP CKPTE NO LDB CMDSC DECR. MSTR FREE COUNT ADB DSFRC LDA B,I ADA M1 STA B,I STORE NEW FREE COUNT CKPTE EQU * ISZ DTMDA INCR TO NEXT DETAIL MEDIA ENTRY ISZ DTMDA ISZ PTPT1 INCR. TO NEXT PATH TBL ENTRY ISZ PTPT1 LDA CMASE INCR. TO NEXT MSTR TBL ENTRY ADA .5 STA CMASE LDA PTCT1 DECR. PATH COUNT ADA M1 STA PTCT1 SZA ALL PATHS EXHAUSTED ? JMP UPNMS NO JMP WRREC YES SPC 3 CRENT EQU * CPA .2 SYNONYM CREATION ? JMP SYNCR YES * * * * * CREATE A PRIMARY ENTRY * * * * * LDA CMDSC ADA DSRCN RECORD NO. FOR READ LDB A,I STB RWRCN ADA .4 STA RWFNM FILE NAME FOR READ LDA ARWPL ADDR OF READ PARM LIST CLB JSB PHIRW PRIMARY ENTRY RECORD READ ? JMP ERRTN NO CLB CPB AICBF,I IS THE ENTRY AVAILABLE ? JMP ZICBF GO ZERO THE BUFFER JSB PHISM SYNONYM MOVED ? JMP ERRTN NO ZICBF EQU * LDB CMDSC GET MEDIA LENGTH OF MSTR RCD ADB DSMDL LDA B,I INB GET DATA LENGTH OF MSTR RCD ADA B,I CALC.WORDS TO ZERO LDB AICBF ADDR OF BUFFER TO ZERO JSB PHIZR ZERO NEEDED TO CORE BUFFER CLB,INBaB STORE PRIMARY ENTRY FLAG IN BUFF STB AICBF,I JMP BLMSE GO BUILD A MASTER ENTRY SPC 3 * * * * * CREATE A SYNONYM * * * * * SYNCR EQU * JSB PHICS UPDATE FOR NEW SYN. DONE ? JMP ERRTN NO LDB CMDSC GET MEDIA LENGTH OF MSTR RCD INB LDA B,I INB GET DATA LENGTH OF MSTR RCD ADA B,I CALC. WORDS TO ZERO LDB AICBF ADDR OF BUFFER TO ZERO JSB PHIZR ZERO NEEDED IN CORE BUFFER LDA RWRCN GET LAST SYN. RCD LDB AICBF STORE LAST SYN RCD NO. AS BWD INB SYN IN NEW LAST SYN RECORD STA B,I CCB STB AICBF,I SET SYNONYM FLAG SPC 3 * * * * * * WRITE THE UPDATED MASTER DATA SET RECORD * * * * * BLMSE EQU * LDA CMDSC GET RCD NO. OF NEW ENTRY ADA DSRCN LDA A,I STA RWRCN NEXT RECORD NO. TO WRITE LDA CMDSC GET MEDIA LENGTH OF MSTR RCD INA LDA A,I ADA AICBF CALC. ADDR OF DATA IN MSTR RCD STA AIVAL SAVE DATA ADDR OF MSTR LDA DSPT1 GET MEDIA LENGTH OF DETAIL INA LDB A,I ADB IBUF CALC ADDR OF DATA IN DETAIL RCD STB AIBUF SAVE DATA ADDR OF DETAIL ADA DSCAP CALC. START OF RCD DEFN TBL STA RDPT1 SAVE ADDR OF RCD DGFN TBL LDA PTPT1,I GET SRCH FIELD,FIELD NO. AND HIMS]K ALF,ALF LDB A SAVE FIELD NO. CSRCH EQU * ADB M1 DECR. FIELD NO. SZB,RSS IS THIS DESIRED FIELD NO.? JMP MVSRC YES LDA RDPT1,I GET FIELD LENGTH AND B377 ARS,ARS ADA AIBUF CALC. ADDR OF NEXT DATA STA AIBUF SAVE NEW ADDR ISZ RDPT1 INCR TO NEXT RCD DEFN TBL ENTRY JMP CSRCH CONTINUE MVSRC EQU * LDA RDPT1,I GET FIELD LENGTH FOR MOVE AND B377 ARS,ARS STA PHIMC MOVE LENGTH LDA AIBUF SOURCE ADDR LDB AIVAL DESTINATION ADDR JSB PHIMV MOVE ARCH FIELD TO MSTR DATA JMP WNMEN GO WRITE NEW MSTR ENTRY SKP ******************************************************************** * * * WRITE THE NEW RECORD TO THE DETAIL DATA SET * * * ******************************************************************** WRREC EQU * LDA DSPT1 READ 1ST FREE RCD IN DETAIL ADA DSFRH LDB A,I STB RWRCN READ RCD NO (1ST FREE RCD) ADA .5 STA RWFNM LDA AICBF READ BUFFER STA RWBUF LDA ARWPL ADDR OF PARM LIST FOR READ CLB READ FLAG JSB PHIRW 1ST FREE DETAIL RECORD READ ? JMP ERRTN NO LDA AICBF GET RCD NO. OF NEXT FREE ENTRY INA LDB A,I STB NSREC SAVE RCD NO. OF NEXT FREE ENTRY CLB,INB SET ENTRY INDICATOR TO USED STB IBUF,I LDA IBUF STA RWBUF BUFFER FOR WRITE(NEW RECORD) LDA ARWPL ADDR OF PARM LIST FOR WRITE CLB,INB WRITE FLAG JSB PHIRW NEW RECORD WRITTEN IN DETAIL ? JMP ERRTN NO LDA DSPT1 DECREMENT DETAIL FREE COUNT ADA DSFRC LDB A,I ADB M1 STB A,I STORE NEW FREE COUNT INA V LDB NSREC GET RCD NO. OF NEXT FREE ENTRY STB A,I STORE RCD NO. OF NEXT FREE ENTRY RETRN EQU * CLB STB ISTAT,I STATUS IS 0 RET LDB AIRUN CLEAR ACTIVITY FLAG ADB ACSUB LDA B,I AND B377 STA B,I JSB PTFRE PUT FREE LIST INFO BACK INTO SYS AV MEM NOP SHOULD NEVER HAVE ERROR JMP DBPUT,I SKP ******************************************************************** * * * CREATE AN ENTRY IN A MANUAL MASTER DATA SET * * * ******************************************************************** MAMEC EQU * CPA MANUL MANUAL MASTER ? RSS YES JMP ER6 NO LDB DSPT1 GET FREE COUNT ADB DSFRC LDA B,I SZA,RSS ANY RCD'S AVAILABLE ? JMP ER5 NO * * * * * VERIFY THAT THE SEARCH ITEM NUMBER IS IN THE 'INBR' LIST. * * OPEN THE MASTER DATA SET AND BUILD THE OUTPUT RECORD IN * * 'IBUF' * * * * * LDB DSPT1 GET SEARCH FIELD NO. ADB DSCCT LDA B,I AND HIMSK ALF,ALF LDB DSPT1 GET DSCB ADDR JSB PHISI SRCH ITEM NO. IN 'INBR' LIST JMP ERRTN NO CLA,INA OPEN COUNT LDB ADSPT ADDR OF OPEN LIST FOR 'PHIL' JSB PHIL MASTER DATA SET OPEN ? JMP ERRTN NO JSB PHIBB MASTER OUTPUT RECORD BUILT ? JMP ERRTN NO SPC 3 * * *  * * DETERMINE WHAT TYPE OF ENTRY MUST BE BUILT * * * * * LDA AMASE GET MASTER TABLE ADDR STA CMASE STORE CURR MSTR TBL ENTRY ADDR LDA DSET# GET DATA SET NO. STA CMASE,I STORE DATA SETNO. IN MSTR TBL ISZ CMASE INCR MSTR TABLE ADDR LDA DSPT1 GET DSCB ADDR STA CMDSC CURR. MSTR DSCB ADDR STA CMASE,I STORE DSCB ADDR IN MSTR TBL ISZ CMASE INCR MSTR TABLE ADDR JSB PHIRM MASTER RCD AT HASH NO. READ ? JMP ERRTN NO LDA CMASE GET ADDR OF CURR. MSTR TBL ENTRY ADA M5 STA CMASE LDB AICBF,I GET ENTRY FLAG SSB IS RECORD A SYNONYM ? JMP MPESY YES SZB,RSS IS ENTRY AVAILABLE ? JMP INRCH YES JSB PHISY DOES A SYNONYM EXIST FOR ARG. ? JMP ERRTN READ ERROR IN MASTER JMP ER7 YES SPC 3 * * * * * UPDATE MASTER FOR CREATION OF A NEW SYNONYM * * * * * JSB PHICS MASTER UPDATED FOR NEW SYNONYM ? JMP ERRTN NO LDA RWRCN GET BWD SYN RCD NO. LDB IBUF INCR TO BWD SYN PTR IN NEW SYN INB STA B,I STORE BWD SYN RCD NO. CCA SYNONYM FLAG STA IBUF,I STORE SYNONYM FLAG SPC 3 * * * * * CREATE THE NEW ENTRY IN THE MASTER DATA SET * * O * * * WNMRC EQU * LDA DSPT1 GET RECD NO. TO WRITE ADA DSRCN LDA A,I STA RWRCN RECORD NO. FOR WRITE LDA IBUF BUFFER ADDR STA RWBUF BUFFER FOR WRITE LDA ARWPL ADDR OF PARM LIST FOR WRITE CLB,INB WRITE FLAG JSB PHIRW NEW ENTRY WRITTEN ? JMP ERRTN NO LDA DSPT1 DECR. MASTER DATA SET FREE COUNT ADA DSFRC LDB A,I ADB M1 STB A,I STORE NEW FREE COUNT JMP RETRN SPC 3 * * * * * MOVE THE SYNONYM * * * * * MPESY EQU * JSB PHISM SYNONYM MOVED JMP ERRTN NO INRCH EQU * CLB,INB PRIMARY ENTRY FLAG STB IBUF,I STORE ENTRY FLAG JMP WNMRC GO WRITE NEW RECORD * * SKP ******************************************************************** * * * PHIBB - BUILD THE RECORD TO BE WRITTEN * * * * * ENTRY: * * * DSET# = DATA SET NUMBER * * DSPT1 = DSCB ADDRESS * * * * EXIT: * * * P+1 - ERROR(B = 101) * * P+2 - OUTPUT RECORD BUILT IN 'IBUF' * * f * ******************************************************************** SPC 3 PHIBB NOP LDB DSPT1 GET DATA SET RECORD LENGTH ADB DSMDL LDA B,I INB ADA B,I LDB IBUF START OF BUFFER TO ZERO JSB PHIZR ZERO THE RECORD BUFFER LDA INBR,I GET ITEM NO. COUNT OF 'INBR' STA INOCT LDA INBR GET ADDR OF START OF 'INBR' LIST INA STA INOPT INIT. ADDR OF CURR. ENTRY LDA IVALU INIT 'IVALU' ADDR STA AIVAL LDA AIRUN GET ADDR OF START OF ITEM TABLE ADA DBLNG STA AITMT NXITM EQU * LDA INOPT,I GET ITEM NO. FROM LIST SSA POSITIVE ? JMP RET1 NO SZA,RSS ZERO ? JMP RET1 YES CMA,INA LDB AIRUN ADB DBICT ADA B,I SSA ITEM NO EQ TO LT ITEM COUNT ? JMP RET1 NO LDA INOPT,I GET ITEM NO. ADA M1 CALC. OFFSET IN ITEM TABLE MPY .5 ADA AITMT ADA ITDSN GET DATA SET NO. OF ITEM LDA A,I AND B377 CPA DSET# EQUAL TO DATA SET NUMBER ? JMP FDFLD YES RET1 EQU * LDB .101 ERROR 101 JMP PHIBB,I RETURN P+1 FDFLD EQU * LDA DSPT1 GET MEDIA LENGTH ADA DSMDL LDB IBUF INIT. OUTPUT BUFFER ADDR ADB A,I STB AIBUF INIT. OUTPUT BUFFER ADDR LDA DSPT1 CALC. START OF RCD DEFN TBL ADA DSLNG STA CRDPT NXRDE EQU * LDA A,I GET ITEM NO. FROM RCD DEFN ENTRY AND HIMSK ALF,ALF CPA INOPT,I ITEM NO.'S EQUAL ? JMP MVFLD YES LDA CRDPT,I GET ITEM SIZE AND B377 ARS,ARS ADA AIBUF STA AIBUF ISZ CRDPT INCR. TO NXT RCD DEFN TBL ENTRY LDA CRDPT GET NEXT RCD DEFN TBL ENTRY ADDR JMP NXRDE CONTINUE MVFLD EQU * LDA CRDPT,I GET ITEM SIZE AND B377 'k<:6 ARS,ARS STA PHIMC MOVE LENGTH STA SITMN SAVE ITEM SIZE LDA AIVAL GET SOURCE ADDR LDB AIBUF GET DESTINATION ADDR JSB PHIMV MOVE DATA LDA SITMN GET ITEM SIZE ADA AIVAL STA AIVAL STORE NEW SOURCE ADDR LDA INOCT DECR ITEM COUNT ADA M1 STA INOCT SZA HAS ITEM LIST BEEN EXHAUSTED ? JMP INXIT NO ISZ PHIBB P+2 JMP PHIBB,I RETURN INXIT EQU * ISZ INOPT INCR. TO NXT ITEM NO. IN 'INBR' JMP NXITM CONTINUE Tl< SKP ******************************************************************** * * * * PHISR - SEARCH FOR AN AVAILABLE ENTRY IN A MASTER DATA SET * * * * * * ENTRY: * * * A = DSCB ADDRESS * * * * * EXIT: * * * P+1 - ERROR(B = FMP ERROR CODE) * * P+2 - ENTRY FOUND(A = RECORD NUMBER OF ENTRY) * * * * ******************************************************************** SPC 3 PHISR NOP ADA DSNME GET THE DATA SET NAME STA RWFNM DATA SET NAME FOR READ ADA M4 GET START. RCD NO. LESS 1 LDB A,I STB RWRCN START. RCD NO. LESS 1 ADA .7 GET MAX. RCD NO. LDB A,I STB MAXCP SAVE MAXIMUM RCD NO. RDNXR EQU * LDA RWRCN GET RECORD NO. CPA MAXCP HIGHEST RECORD JUST READ ? JMP INRCN YES INA INCR TO NEXT RECORD RSS INRCN EQU * CLA,INA NEXT RECORD NO. IS 1 STA RWRCN STORE NEXT RECORD NO. LDA ARWPL ADDR PARM LIST FOR READ CLB READ FLAG JSB PHIRW ENTRY READ ? JMP PHISR,I NO, RETURN P+1 LDA RWBUF,I GET ENTRY STATUS SZA IS ENTRY AVAILABLE ? JMP RDNXR NO LDA RWRCN GET RCD NO. OF ENTRY ISZ PHISR P+2 JMP PHISR,I RETURN MAXCP BSS 1 MAXIMUM RCD NO. SKP ******************************************************************** * * * PHISI - VERIFY THAT SEARCH FIELD ITEM NUMBER IS IN THE * * 'INBR' LIST. * * ENTRY: * * A = SEARCH FOELD NUMBER * * B = DSCB ADDRESS * * * * EXIT: * * P+1 - ERROR(B = 102) * * P+2 - SEARCH FIELD ITEM NUMBER IS IN 'INBR' * * * ******************************************************************** SPC 3 PHISI NOP ADB DSCAP GET SRCH FIELD ITEM NO. ADB A LDA B,I AND HIMSK ALF,ALF STA SITMN SAVE ITEM NUMBER OF SEARCH FIELD LDA INBR GET ITEM NO. COUNT FORM 'INBR' LDB A,I STB INOCT SAVE COUNT OF ITEM NUMBERS INA GET ADDR OF 1ST ITEM NO. IN INBR STA INOPT CKVSF EQU * LDA INOPT,I GET ITEM NUMBER FROM 'INBR' LIST CPA SITMN IS IT = SRCH FIELD ITEM NO. ? RSS YES JMP GTNXN NO ISZ PHISI P+2 JMP PHISI,I RETURN GTNXN EQU * LDB INOCT DECREMENT COUNT OF ITEM NO.'S ADB M1 STB INOCT SAVE NEW COUNT ISZ INOPT GET ADDR OF NEXT ITEM NO. SZB HAVE ALL ITEM NO. 'S BEEN USED ? JMP CKVSF NO LDB .102 ERROR 102 JMP PHISI,I RETURN P+1 SKP ******************************************************************** * * * PHISM - MOVE A SYNONYM * * * * ENTRY: * * CMASE = ADDRESS OF CURRENT MASTER TABLE ENTRY * * CMDSC = ADDRESS OF CURRENT MASTER DSCB * * IN CORE BUFFER = SYNONYM TO MOVE * * MASTER DSCB RECORD NO. = RECORD NO. OF * * SYNONYM TO MOVE * * * * EXIT: * * P+1 - ERROR(B = CODE) * * P+2 - SYNONYM HAS BEEN MOVED * * * ******************************************************************** SPC 3 PHISM NOP LDA AICBF GET BWD SYN RECORD NO. INA LDB A,I STB TBWDA SAVE BWD SYN RECORD NO. INA LDB A,I GET FWD SYN RECORD NO. STB TFWDA SAVE FWD SYN RECORD NO. LDA CMDSC GET MASTER DSCB ADDRESS JSB PHISR AVAILABLE RECORD NO. FOUND ? JMP PHISM,I NO STA NSREC STORE AVAILABLE RECORD NO. LDA CMASE GET RCD NO. OF SYNONYM ADA .4 LDA A,I STA RWRCN RCD NO. FOR READ LDA ARWPL READ PARM LIST ADDR CLB READ FLAG JSB PHIRW SYNONYM TO MOVE REREAD ? JMP PHISM,I NO, RETURN P+1 LDA NSREC GET NEW RECORD NO. FOR SYNONYM STA RWRCN NEW RECORD NO. FOR WRITE LDA ARWPL PARM LIST FOR WRITE CLB,INB WRITE FLAG JSB PHIRW SYNONYM WRITTEN AT NEW RCD NO. ? JMP PHISM,I NO, RETURN P+1 LDA TBWDA GET BWD SYNONYM RECORD NO. STA RWRCN RECORD NO. FOR READ LDA ARWPL PARM LIST FOR READ CLB READ FLAG JSB PHIRW BWD SYNONYM RECORD READ ? JMP PHISM,I NO, RETURN P+1 LDA AICBF GET ADDR OF FWD SYN RECORD NO. ADA .2 LDB NSREC GET NEW FWD SYN RECORD NXmO. STB A,I NEW FWD SYN IN BWD SYN RECORD LDA ARWPL PARM LIST FOR WRITE CLB,INB WRITE FLAG JSB PHIRW UPDATED BWD SYN RCD REWRITTEN ? JMP PHISM,I NO, RETURN P+1 LDA TFWDA GET FWD SYN RECORD NO. SZA,RSS END OF SYNONYM CHAIN JMP SMRT2 YES STA RWRCN RECORD NO. FOR READ LDA ARWPL PARM LIST FOR READ CLB READ FLAG JSB PHIRW FWD SYN RECORD READ ? JMP PHISM,I NO, RETURN P+1 LDA AICBF GET ADDR OF BWD SYN RECORD NO. INA LDB NSREC GET NEW BWD SYN RECORD NO. STB A,I NEW BWD SYN IN FWD SYN RECORD LDA ARWPL RARM LIST FOR WRITE CLB,INB WRITE FLAG JSB PHIRW UPDATED FWD SYN RCD REWRITTEN ? JMP PHISM,I NO, RETURN P+1 SMRT2 EQU * ISZ PHISM P+2 JMP PHISM,I RETURN SKP ******************************************************************** * * * PHISY - SEARCH FOR AN ENTRY WITH A DUPLICATE KEY * * * * ENTRY: * * CMASE = ADDRESS OF CURRENT MASTER TABLE ENTRY * * CMDSC = ADDRESS OF CURRENT MASTER DSCB * * IN CORE BUFFER = PRIMARY ENTRY * * DSCB RECORD NO. = RECORD NO. OF PRIMARY ENTRY * * * * EXIT: * * P+1 - ERROR(B = CODE) * * P+2 - DUPLICATE ENTRY EXISTS * * IN CORE BUFFER = DUPLICATE ENTRY * * DSCB RCCORD NO. = RECD NO. OF DUPLICATE * * P+3 - NO DUPLICATE EXISTS  * * IN CORE BUFFER = LAST SYNONYM ON CHAIN * * DSCB RECORD NO. = RECD NO. OF LAST SYN * * * ******************************************************************** SPC 3 PHISY NOP LDB CMDSC GET MASTER DSCB ADDR ADB DSMDL GET MEDIA LENGTH LDA B,I ADA AICBF CALC. ADDR TO BEGIN ARGMNT SRCH STA SARGA STORE INIT. SRCH ARG ADDR ADB .3 GET MASTER SRCH FIELD NO. LDA B,I AND HIMSK ALF,ALF STA RDCTR STORE MASTER SRCH FIELD NO. ADB .12 GET ADDR OF MSTR RCD DEFN TBL STB CRDPT INIT. ADDR OF CURR. RCD DEFN ENT NXMRD EQU * LDB RDCTR DECR. MASTER SRCH FIELD NO. ADB M1 STB RDCTR SZB,RSS IS THIS SRCH ARG RCD DEFN ENTR ? JMP CMPSG YES LDA CRDPT,I GET FIELD LENGTH AND B377 ARS,ARS ADA SARGA ADD FIELD LENGTH TO SRCH ARG ADDR STA SARGA STORE NEW SRCH ARG ADDR ISZ CRDPT INCR. TO NEXT RCD DEFN TBL ENTRY JMP NXMRD CONTINUE CMPSG EQU * LDA CRDPT,I GET LENGTH OF SRCH ARG AND B377 ARS,ARS STA CMPCT STORE LENGTH FOR COMPARE LDA CMASE ADDR OF NEW SRCH ARG FIELD ADA .2 LDA A,I LDB SARGA ADDR OF EXISTING SRCH ARG FIELD JSB PHICM TWO SRCH ARG'S EQUAL ? JMP CKMSY NO ISZ PHISY P+2 JMP PHISY,I RETURN CKMSY EQU * LDA AICBF GET FWD SYNDNYM PTR ADA .2 LDA A,I SZA MORE SYNONYMS ? JMP RDNXS YES ISZ PHISY P+3 ISZ PHISY JMP PHISY,I RETURN RDNXS EQU * STA RWRCN RECORD NO. FOR READ LDA ARWPL ADDR OF PARM LIST FOR READ CLB READ FLAG JSB PHIRW SYNONYM READ ? JMP PHISY,I NO, RETURN P+1 LDA CMDSC =UPDATE RCD NO. IN DSCB ADA DSRCN LDB RWRCN GET NEW RECORD NO. STB A,I STORE NEW RCD NO. IN DSCB JMP CMPSG YES SKP ******************************************************************** * * * PHICS - UPDATE LAST SYNONYM IN CHAIN SO THAT THE NEW SYNONYM * * CAN BE WRITTEN * * * * ENTRY: * * CMASE = ADDRESS OF CURRENT MASTER TABLE ENTRY * * CMDSC = ADDRESS OF CURRENT MASTER DSCB * * DSCB RECORD NO. = RECD NO. OF LAST SYNONYM * * * * EXIT: * * P+1 - ERROR(B = CODE) * * P+2 - LAST SYNONYM UPDATED * * RWRCN = RECORD NO. OF LAST SYNONYM * * DSCB RECORD NO. = RECD NO. OF NEW SYN * * * ******************************************************************** SPC 3 PHICS NOP LDA CMDSC GET CURR. MSTR DSCB ADDR JSB PHISR AVAILABLE RECORD NO. FOUND ? JMP PHICS,I NO STA NSREC SAVE RCD NO. FOR NEW SYNONYM LDA CMDSC GET LAST SYNONYM RCD NO. ADA DSRCN LDB A,I STB RWRCN RECORD NO. FOR READ ADA .4 STA RWFNM FILE NAME FOR READ LDA ARWPL PARM LIST FOR READ CLB READ FLAG JSB PHIRW LAST SYNONYM READ ? JMP PHICS,I NO, RETURN P+1 LDA AICBF INCR. TO FWD SYN IN LAST SYN ADA .2 LDB NSREC GET REC. NO. OF NEW LAST SYN STB A,I STORE FWD SYN IN LAST SYN RE/CORD LDA ARWPL PARM LIST FOR WIRTE CLB,INB WRITE FLAG JSB PHIRW UPDATED LAST SYN RCD REWRITTEN ? JMP PHICS,I NO, RETURN P+1 LDB CMDSC RCD NO. OF NEW SYN TO DSCB ADB DSRCN LDA NSREC GET NEW SYN RCD NO. STA B,I STORE NEW REC NO. IN DSCB ISZ PHICS P+2 JMP PHICS,I RETURN SKP ******************************************************************** * * * PHIRM - READ THE HASHED RECORD NO. ENTRY INTO THE IN CORE * * BUFFER * * * * ENTRY: * * A = DSCB ADDR * * B = ADDR OF PATH TABLE ENTRY(DETAIL ONLY) * * CMASE = ADDR OF MASTER TABLE ENTRY(DETAIL) * * CMASE = ADDR OF MASTER TABLE ENTRY+2(MASTER) * * WHERE CMASE+1 = MSTR DATA SET NO. * * CMASE-2 = MSTR DSCB ADDR * * * * EXIT: * * P+1 - ERROR(B = CODE) * * P+2 - HASHED RECORD NO. ENTRY IS IN THE IN * * CORE BUFFER * * DSCB RECORD NO. = RCD NO. OF HASH ENTRY * * MASTER TABLE ENTRY HAS BEEN BUILT AS * * FOLLOWS: * * 1ST WORD = MSTR DATA SET NO. * * 2ND WORD = MSTR DSCB ADDR * * 3RD WORD = SRCH ARG ADDR * * 4TH WORD Yr= SRCH ARG LENGTH * * 5TH WORD = HASH RECORD NO. * * * ******************************************************************** SPC 3 PHIRM NOP STA DSPTR SAVE DSCB ADDR STB PTHTA SAVE PATH TABLE ENTRY ADDR ADA DSMDL GET MEDIA LENGTH OF RECORD LDA A,I ADA IBUF CALC. ADDR TO BEGIN ARGMNT SRCH STA SARGA STORE INITIAL SRCH ARG ADDR LDA DSPTR CALC. ADDR OF RCD DEFN TABLE ADA DSLNG STA CRDPT LDB DSPTR,I GET DATA SET TYPE CPB DETAL DETAIL DATA SET ? JMP GDPTN YES LDB DSPTR GET SEARCH FIELD NO. ADB DSCCT LDA B,I AND HIMSK ALF,ALF JMP SSAFN GDPTN EQU * LDA PTHTA,I GET SRCH ARGUMENT FIELD NO. AND HIMSK ALF,ALF SSAFN EQU * STA RDCTR STORE SRCH ARG FIELD NO. CSSRG EQU * ADA M1 DECREMENT FIELD NO. STA RDCTR SZA,RSS IS THIS SEARCH ARG FIELD NO. JMP CHASH YES LDA CRDPT,I ADD FIELD LNGTH TO SRCH ARG ADDR AND B377 ARS,ARS ADA SARGA STA SARGA STORE NEW SRCH ARG ADDR ISZ CRDPT INCR. TO NEXT RCD DEFN TBL ENTRY LDA RDCTR JMP CSSRG CONTINUE CHASH EQU * LDB DSPTR,I GET DATA SET TYPE CPB DETAL DETAIL DATA SET RSS YES JMP SAMTB NO LDA PTHTA,I GET MASTER DATA SET NO. AND B377 STA CMASE,I SAVE NO. IN MASTER TABLE LDA CMASE JSB PHIS1 CALC. MASTER DATA SET DSCB ADDR JMP ERRTN BRANCH DOES NOT OCCUR ISZ CMASE INCR. TO NEXT MASTER TBL ENTRY STB CMASE,I SAVE DSCB ADDR IN MASTER TBL ISZ CMASE INCR TO NEXT MASTER TBL ENTRY SAMTB EQU * LDA SARGA SAVE SRCH ARG ADDR IN MASTER TBL STA CMASE,I STA HARRY STORE SRCH ARG AQDDR FOR HASH ISZ CMASE INCR TO NEXT MASTER TBL ENTRY LDA CRDPT,I GET FIELD LENGTH AND B377 ARS,ARS STA CMASE,I SAVE FIELD LENGTH IN MASTER TBL LDA CMASE GET ADDR OF FIELD LENGTH STA HLGTH STORE FIELD LGTH ADDR FOR HASH ISZ CMASE INCR TO NEXT MASTER TBL ENTRY JSB HASH DEF *+3 HARRY BSS 1 HLGTH BSS 1 LDB CMASE GET MASTER DATA SET CAPACITY ADB M3 LDB B,I ADB DSCAP LDB B,I STB DVSOR STORE CAPACITY AS DIVISOR CLB DIV DVSOR CALCULATE RECORD NUMBER INB STB CMASE,I SAVE REC NO. IN MASTER TABLE ISZ CMASE INCR. TO NEXT MASTER TABLE ENTRY LDA CMASE GET DSCB ADDR FROM MASTER TABLE ADA M4 LDB A,I ADB DSNME GET MASTER DSNAME FOR READ STB RWFNM STORE NAME FOR READ ADA .3 GET RECORD NO. TO READ LDA A,I STA RWRCN STORE RECORD NO. FOR READ LDA AICBF STORE BUFF. ADDR FOR READ STA RWBUF LDA ARWPL ADDR OF PARM LIST FOR READ CLB READ FLAG JSB PHIRW RECORD READ ? JMP PHIRM,I NO, RETURN P+1 LDB CMASE GET MASTER DSCB ADDR ADB M4 LDA B,I ADA DSRCN LDB RWRCN GET RECORD NO. STB A,I STORE NEW CURR. REC NO. IN DSCB ISZ PHIRM P+2 JMP PHIRM,I RETURN SKP * * * * ***** ERROR ***** * * * * ER1 EQU * DATA BASE NOT OPEN LDB .103 JMP ERROR ER2 EQU * MODE NOT 3 OR DB NOT LOCKED FOR MODE 2 LDB .104 JMP ERROR ER3 EQU * MANUAL MASTER ENTRY NON EXISTANT LDB .107 JMP ERROR ER4 EQU * FREE COUNT IS 0(NO SPACE IN LDB .105 DETAIL AVAILABLE) JMP ERROR ER5 EQU * FREE COUNT IS 0(NO SPACE IN LDB .106 MASTER AVAILABLE) JMP ERROR ER6 EQU * 'DBPUT' TO AUTOMATIC MASTER LDB .108 JMP ERROR ER7 EQU * ENTRY ALREADY EXISTS IN MASTER LDB .110 JMP ERROR ER8 EQU * DATA BASE NOT LOCKED IN MODE2 LDB .135 JMP ERROR ER9 EQU * LEVEL NOT 15 FOR PUT LDB .109 ERRTN EQU * CODE ALREADY ESTABLISHED ERROR EQU * STB ISTAT,I JMP RET SKP * * * * ***** STORAGE ***** * * * * PTCT1 BSS 1 PATH COUNT RDPT1 BSS 1 ADDR OF RECORD DEFINITION TABLE PTPT1 BSS 1 ADDR OF PATH TABLE DVSOR BSS 1 DIVISOR SARGA BSS 1 SEARCH ARGUMENT ADDRESS CRDPT BSS 1 CURR. RECD DEFN TABLE ADDR RDCTR BSS 1 RECD DEFN TABLE ENTRY COUNTER CHNPT BSS 1 ADDR OF CHAIN ENTRY IN MSTR RCD DTMDA BSS 1 ADDR OF ENTRY IN DETAIL MEDIA TBWDA BSS 1 BWD SYNONYM RECORD NO. TFWDA BSS 1 FWD SYNONYM RECORD NO. NSREC BSS 1 NEXT AVAILABLE RECORD NUMBER SITMN BSS 1 SEARCH FIELD ITEM NUMBER INOCT BSS 1 ITEM NUMBER COUNT OF 'INBR' INOPT BSS 1 ADDR OF CURRENT 'INBR' ENTRY DSPTR BSS 1 DSCB ADDR CMDSC BSS 1 CURRENT MASTER DSCB ADDR PTHTA BSS 1 PATH TABLE ENTRY ADDR AITMT BSS 1 CURR. ITEM LIST ADDR RWFNM BSS 1 ADDR OF FILE NAME FOR I/O RWRCN BSS 1 RECORD NUMBER FOR I/O RWBUF BSS 1 ADDR OF BUFFER FOR I/O DSET# BSS 1 B@< NUMBER OF 'DBPUT' DATA SET DSPT1 BSS 1 ADDR OF CURRENT DSCB MDST# BSS 1 MASTER DATA SET NO. AIBUF BSS 1 ADDR OF 'IBUF' AIVAL BSS 1 ADDR OF 'INVALU' OPLST BSS 6 ADDR LIST OF DATA SETS TO OPEN OPCNT BSS 1 COUNT OF DATA SETS TO OPEN OPLCA BSS 1 ADDR OF CURR. OPEN LIST ENTRY CMASE BSS 1 CURR. MASTER DATA SET TRL ENTRY MASTB BSS 25 MASTER DATA SET TABLE ICBUF BSS 256 IN CORE BUFFER SKP * * * * ***** CONSTANTS ***** * * * * ADSPT DEF DSPT1 ADDR OF DSCB ADDR AOPLS DEF OPLST ADDR OF START OF OPEN LIST AMDS# DEF MDST# ADDR OF MSTR DATA SET NO. AMASE DEF MASTB ADDR OF MASTER DATA SET TABLE ARWPL DEF RWFNM ADDR OF READ/WRITE PARM LIST AICBF DEF ICBUF ADDR OF IN CORE BUFFER LEEBO ASC 1,LB OPEN INDICATOR DETAL OCT 104 DETAIL DATA SET INDICATOR MANUL OCT 115 MASTER DATA SET FLAG .0 EQU DBZ .2 EQU DBZ+2 .3 EQU DBZ+3 .4 EQU DBZ+4 .5 EQU DBZ+5 .6 EQU DBZ+6 .7 EQU DBZ+7 .12 DEC 12 DEC 12 .15 EQU DSCAP .103 DEC 103 DEC 103 .104 DEC 104 DEC 104 .107 DEC 107 DEC 107 .108 DEC 108 DEC 108 .109 DEC 109 .105 DEC 105 DEC 105 .106 DEC 106 DEC 106 .110 DEC 110 DEC 110 .101 DEC 101 DEC 101 .102 DEC 102 DEC 102 .134 DEC 134 .135 DEC 135 END cBASMB,R,L,C HED 'DBDEL' SUBROUTINE OF 'DBMS' NAM DBDEL,7 92063-12001 REV.1826 771027 * * ************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * * PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ************************************************************** * * * LISTING: 92063-19001 * SOURCE: 92063-18001 * RELOC: 92063-12001 * * ************************************************************* * SPC 3 ******************************************************************** * * * DBDEL SUBROUTINE OF DBMS * * * * INPUT: * * IDSET - LABEL OF A FIELD WHOSE CONTENT IS THE * * DATA SET NAME * * * * ISTAT - LABEL OF A ONE WORD FIELD WHICH IS TO * * BE USED TO RETURN STATUS INFORMATION * * * * * * OUTPUT: * * NO ERROR - 1) ISTAT = 0 * * 2) RECORD IS DELETED * * * * ERROR - ISTAT = ERROR NUMBER * * * * * * FUNCTION: P * * 'DBDEL' DELETES THE CURRENTLY ACCESSED DATA * * ENTRY(I.E. THE RECORD OF THE PRECEDING 'DBGET')* * IN THE DATA SET IDENTIFIED BY 'IDSET'. * * * * 'DBDEL' APPLIES TO BOTH DETAIL AND MANUAL * * MASTER DATA SETS. * * 'DBDEL' TO A DETAIL DATA SET CAUSES: * * * * 1) THE CURRENT RECORD TO BE DELETED IN * * THE DETAIL * * 2) THE FREE COUNT OF THE DETAIL * * TO BE INCREMENTED BY 1 * * 3) THE RECORD DELETED TO BE PUT AT THE * * HEAD OF THE FREE CHAIN * * 4) THE MASTER DATA SET(S) ASSOCIATED * * WITH THE DETAIL TO HAVE THEIR * * RESPECTIVE CHAINS(S) UPDATED. * * IF THE CHAIN COUNT OF ALL THE CHAINS * * IN AN AUTOMATIC MASTER IS ZERO THE * * RECORD IS DELETED FROM THE AUTOMATIC * * MASTER AND ITS FREE COUNT IS * * INCREMENTED BY 1. * * * * 'DBDEL' TO A MANUAL MASTER DATA SET CAUSES: * * * * 1) THE CURRENT RECORD TO BE DELETED IN * * THE MANUAL MASTER * * 2) THE FREE COUNT OF THE MANUAL MASTER * * TO BE INCREMENTE D BY 1. * * NOTE: THE CHAIN COUNT OF ALL CHAINS OF * * A MANUAL MASTER MUST BE ZERO TO * * DELETE THE RECORD. * * * ******************************************************************** SPC 3 ENT DBDEL EXT .ENTR,GTFRE,PTFRE EXT PHIS1,PHIRP,PHIRW,PHIZR,PHIL,HASH EXT AIRUN EXT PHICM,CMPCT EXT PHIMV,PHIMC SKP * * * * ***** EQUATES ***** * * * * A EQU 0 A REGISTER B EQU 1 B REGISTER M4 DEC -4 M1 DEC -1 M2 DEC -2 B377 OCT 377 HIMSK OCT 177400 B400 OCT 400 SKP ************************************************************************ * * * * RUN TABLE FOR IMAGE 1000 * * * * * * THE RUN TABLE IS COMPRISED OF THE FOLLOWING SECTIONS: * * * * * * 1) DATA BASE CONTROL BLOCK * * * 2) ITEM TABLE * * * 3) DATA SET TABLE * * * * * * THESE SECTIONS APPEAR IN THE ORDER DESCRIBED. * * * DETAILS OF EACH SECTION FOLLOW. * * * * * ************************************************************************ ***** ********* * * * * DATA BASE CONTROL BLOCK * * * * * ***** ********* DBLNG DEC 55 DATA BASE CONTROL BLOCK LENGTH DBZ DEC 0 DATA BASE LOCK FLAG DEC 1 ACSUB DEC 2 1ST BYTE : ACTIVITY FLAG * 2ND BYTE : SUBCHANNEL # DBSTA DEC 3 DATA BASE STATUS DBSCD DEC 4 DATA BASE SECURITY CODE(FMP) DBICT DEC 5 DATA BASE ITEM COUNT DBSCT DEC 6 DATA BASE DATA SET COUNT DBITB DEC 7 ADDRESS OF ITEM TABLE DBSTB DEC 8 ADDRESS OF DATA SET TABLE DBLMD DEC 9 DATA BASE ACCESS LEVEL AND MODE DBLVL EQU DBZ+9 1ST BYTE: ACCESS LEVEL GRANTED BY 'DBOPN' DBMOD EQU DBZ+9 2ND BYTE: MODE GRANTED BY 'DBOPN' DBILV DEC 10 DATA BASE ITEM LEVEL WORDS - 3 WORDS/LEVEL DBOCT EQU DBZ+10 DATA SET OPEN COUNT ***** ********* * * * * ITEM TABLE - ONE FIVE-WORD ENTRY PER ITEM * * * * * ***** ***** ITLNG EQU DBZ+5 ITEM ENTRY LENGTH ITNME EQU DBZ ITEM NAME(LEFT JUSTIFIED) ITRWL EQU DBZ+3 ITEM READ/WRITE MINIMUM ACCESS LEVEL ITRDL EQU DBZ+3 1ST BYTE: MINIMUM ACCESS LEVEL TO READ ITEM ITWRL EQU DBZ+3 2ND BYTE: MINIMUM ACCESS LEVEL TO WRITE ITEM ITTDN EQU DBZ+4 ITEM TYPE AND DATASET NUMBER ITTYP EQU DBZ+4 1ST BYTE: ITEM TYPE ITDSN EQU DBZ+4 2ND BYTE: ITEM DATASET NUMBER ***** s ********* * * * * DATA SET TABLE - COMPRISED OF THE FOLLOWING SECTIONS IN * * * THE ORDER PRESENTED: * * * * * * 1) DATA SET CONTROL BLOCK * * * 2) RECORD DEFINITION TABLE * * * 3) MASTER PATH TABLE, DETAIL PATH TABLE, * * * OR NO PATH TABLE * * * * * ***** ********* * * * * * * ***** DATA SET CONTROL BLOCK ***** * * * * * * DSLNG DEC 16 DATA SET CONTROL BLOCK LENGTH DSTYP EQU DBZ DATA SET TYPE DSMDL DEC 1 DATA SET MEDIA RECORD LENGTH DSENL EQU DBZ+2 DATA SET LOGICAL RECORD LENGTH DSFPC EQU DBZ+3 DATA SET FIELDS/ENTRY AND PATHS/ENTRY DSFCT EQU DBZ+3 1ST BYTE: FIELDS/ENTRY DSPCT EQU DBZ+3 2ND BYTE: PATHS/ENTRY DSCPN EQU DBZ+4 DATA SET SRCH FIELD NO. AND PATH NO. OF CURR. CHAIN DSCCT EQU DBZ+4 1ST BYTE: FIELD NUMBER OF SRCH ITEM(0 IF DETAIL) DSPAN EQU DBZ+4 2ND BYTE: PATH NUMBER OF CURRENT CHAIN DSPAT EQU DBZ+5 ADDRESS OF PATH TABLE DSFRC EQU DBZ+6 FREE CHAIN COUNT(DETAIL)/FREE RECORD COUNT(MASTER) DSFRH EQU DBZ+7 0 OR RECORD NO.OF 1ST FREE RECORD IN CHAIN DSRCN EQU DBZ+8 LAST ACCESSED RECORD NUMBER DSPAL EQU DBZ+9 0 OR PATH LENGTH OF CURRENT CHAIN DSCHF EQU DBZ+10 0 OR RECORD NUMBER OF CURRENT CHAIN FOOT DSFWN DEC 11 0 OR NEXT RECO<RD NUMBER IN CHAIN DSNME DEC 12 DATA SET NAME(LEFT JUSTIFIED) DSCAP DEC 15 CAPACITY(MAXIMUM NUMBER OF RECORDS) * * * * * * ***** RECORD DEFINITION TABLE - ONE ONE-WORD ENTRY PER FIELD ********* * * * * * * RDLNG EQU DBZ+1 RECORD DEFINITION TABLE ENTRY LENGTH RDINF EQU DBZ ITEM NUMBER OF FIELD,ITEM LENGTH AND ACCESSABILITY RDITN EQU DBZ 1ST BYTE: ITEM NUMBER OF FIELD RDILA EQU DBZ 2ND BYTE: ITEM LENGTH AND R/W ACCESSABILITY RDITL EQU DBZ 1ST 6 BITS: ITEM LENGTH RDWRA EQU DBZ 7TH BIT: ITEM WRITE ACCESSABILITY RDRDA EQU DBZ 8TH BIT: ITEM READ ACCESSABILITY * * * * ***** PATH TABLE(MASTER) - ONE TWO-WORD ENTRY PER PATH ***** * * * * * PTMLG EQU DBZ+2 MASTER PATH TABLE ENTRY LENGTH PTMSD EQU DBZ DETAIL DATASET SRCH ITEM NO. AND DATA SET NO. PTMSN EQU DBZ 1ST BYTE: DETAIL DATA SET SEARCH ITEM NUMBER PTMDN EQU DBZ 2ND BYTE: DETAIL DATA SET NUMBER PTMPS EQU DBZ+1 DETAIL DATA SET PATH NUMBER AND SCRATCH PTMPN EQU DBZ+1 1ST BYTE: DETAIL DATA SET PATH NUMBER PTMSC EQU DBZ+1 2ND BYTE: SCRATCH * * * * * * ***** PATH TABLE(DETAIL) - ONE TWO-WORD ENTRY PER PATH ********* * * * * 9 * * PTDLG EQU DBZ+2 DETAIL PATH TABLE ENTRY LENGTH PTDSM EQU DBZ SEARCH FIELD NO. IN DETAIL AND MASTER DATA SET NO. PTDSF EQU DBZ 1ST BYTE: SEARCH FIELD NUMBER IN DETAIL PTDMN EQU DBZ 2ND BYTE: MASTER DATA SET NUMBER PTDPS EQU DBZ+1 MASTER DATA SET PATH NUMBER AND SCRATCH PTDPN EQU DBZ+1 1ST BYTE: MASTER DATA SET PATH NUMBER PTDSC EQU DBZ+1 2ND BYTE: SCRATCH SKP ******************************************************************** * * * PICK UP PARAMETERS AND CHECK THAT DATA BASE IS OPEN, * * THE ACCESS MODE IS EQUAL TO OR GREATER THAN 3, THAT THE * * DELETET DATA SET IS NOT AN AUTOMATIC MASTER, THAT THE * * RECORD NUMBER TO DELETE IS NOT ZERO. BUILD A LIST OF DSCB'S * * TO OPEN AND CALL 'PHIL' TO OPEN THE DATA SETS. DETERMINE * * WHETHER A MASTER DATA SET, A DETAIL DATA SET WITH NO RELATED * * MASTERS OR A DETAIL DATA SET WITH RELATED MASTERS IS HAVING * * A RECORD DELETED. * * * ******************************************************************** IDSET BSS 1 ISTAT BSS 1 DBDEL NOP JSB .ENTR PICK UP THE PARAMETERS DEF IDSET LDB AIRUN GET DATA BASE STATUS CODE ADB DBSTA LDA LEEBO CPA B,I IS DATA BASE OPEN ? RSS YES JSB ER1 NO ADB M1 SET LDA B,I ACTIVITY FLAG IOR B400 STA B,I ADB .7 GET DATA BASE MODE LDA B,I AND B377 CPA .3 IS IT MODE 3? JMP MODE3 YES, OK! CPA .2 IS IT MODE 2, IF SO CHECK LOCK FLAG RSS YES, MODE 2! JMP ER2 NOT LEGAL MODE! * * IF MODE =2 AND LEVEL NOT = 15 THEN ERROR 109 * LDA AIRUN ADA DBLVL GET LDA A,I ACCESS ALF,ALF LEVEL AND B377 CPA .15 LEVEL = 15? RSS YES! JMP ER9 NO, ERROR 109 * JSB GTFRE GET FREE LIST FROM SY AV MEM AND PUT IN RUN TBL JMP ERROR NOT FOUND ERROR LDA AIRUN IS LDA 0,I SZA,RSS MODE FLAG SET! JMP ER8 NO! MODE3 LDA IDSET JSB PHIS1 DSCB ADDR & DATA SET NO. FOUND ? JMP ERRTN NO STA DSET# SAVE DATA SET NO. STB DSPT1 SAVE DSCB ADDR ADB DSRCN GET RECORD NO. LDA B,I SZA,RSS RCD NO. TO DELETE = 0 ? JMP ER3 YES SSA RCD NO. NEGATIVE ? JMP ER3 YES LDB DSPT1 GET MAX RCD NO. ADB DSCAP CMA,INA ADA B,I SSA RCD NO. TOO LARGE ? JMP ER3 LDA DSPT1,I GET DATA SET TYPE CPA AUTOM AUTOMATIC MASTER ? JMP ER4 YES LDB AOPLS INIT START OF OPEN LIST ? STB OPLCA LDB DSPT1 STB OPLCA,I STORE 1ST ENTRY CLB,INB STB OPCNT INIT. COUNT TO 1 CPA MANUL MANUAL DATA SET JMP OPDST YES LDA DSPT1 JSB PHIRP CALC. RCD DEFN & PATH TBL ADDR'S STB PTPT1 SAVE PATH ADDR LDA DSPT1 GET PATH COUNT ADA DSPCT LDA A,I AND B377 STA PTCT1 SAVE PATH COUNT GNMAS EQU * SZA,RSS ANY RELATED MASTERS ? JMP OPDST NO LDA PTPT1,I GET MASTER DATA SET NO. AND B377 STA MDST# LDA AMDS# JSB PHIS1 CALC. MASTER DSCB ADDR JMP ERRTN BRANCH NEVER OCCURS ISZ OPLCA INCR TO NEXT OPEN LIST ENTRY STB OPLCA,I STORE MASTER DSCB ADDR ISZ OPCNT INCR. OPEN COUNT LDA PTCT1 DECR. PATH COUNT ADA M1 STA PTCT1 STORE NEW PATH COUNT LDB PTPT1 INCR. TO NEXT PATH TABLE ENTRY ADB PTDLG STB PTPT1 STORE NEW PATH TABLE ENTRY ADDR JMP GNMAS CONTINUE OPDST EQU * LDA OPCNT COUNT OF OPEN LIST LDB AOPLS ADDR OF OPEN LIST JSB PHIL ALL FILES OPEN ? JMP ERRTN NO LDA DSPT1,I GET DATA SET TYPE CPA MANUL MANUAL MASTER ? JMP DMREC YES LDA DSPT1 JSB PHIRP CALC. RCD DEFN & PATH TBL ADDR'S STA RDPT1 SAVE RCD DEFN TABLE ADDR STB PTPT1 SAVE PATH TABLE ADDR LDA DSPT1 GET PATH COUNT ADA DSPCT LDA A,I AND B377 STA PTCT1 SAVE PATH COUNT SZA,RSS ANY RELATED MASTERS ? JMP DDREC NO SKP ******************************************************************** * * * FIND THE SEARCH ARGUMENT IN THE DETAIL RECORD FOR EACH * * RELATED MASTER AND UPDATE THE MASTER DATA SET FOR THAT * * MASTER DATA SET. * * * ******************************************************************** LDA DSPT1 GET RCD NO. TO DELETE ADA DSRCN LDA A,I STA DDLRN SAVE RCD NO. TO DELETE LDA AOPLS GET ADDR OF ADDR OF CURRENT INA MASTER DSCB ADDR STA OPLCA LDA AICBF INIT. ADDR OF CURRENT CHAIN INA ENTRY IN DETAIL MEDIA RECORD STA DCHNP UPNMS EQU * * * * * ***** READ THE DETAIL RECORD TO DELETE AND SAVE ITS FORWARD ***** ***** AND BACKWARD RECORD NUMBERS ***** * * * * LDA DSPT1 ADA DSNME STA RWFNM DATA SET NAME FOR READ I ADA M4 LDA A,I STA RWRCN RCD NO. FOR READ LDA AICBF STA RWBUF BUFFER FOR READ LDA ARWPL ADDR OF PARM LIST FOR READ CLB READ FLAG JSB PHIRW RECORD TO BE DELETED READ ? JMP ERRTN NO LDA AICBF,I GET RECORD FLAG SZA,RSS IS THE RECORD EMPTY ? JMP ER7 YES LDA DCHNP GET CURR DETAIL CHN ADDR. LDB A,I GET BWD PTR OF CURR. CHAIN STB TBWDA SAVE BWD PTR INA LDB A,I GET FWD PTR OF CURR. CHAIN STB TFWDA SAVE FWD PTR * * * * ***** GET THE SEARCH ARGUMENT FIELD NUMBER OF THE CURRENT ***** ***** MASTER AND SCAN THE DETAIL RECORD TO BE DELETED FOR THE ***** **** SEARCH ARGUMENT OF THE MASTER DATA SET. ***** * * * * LDA RDPT1 INIT CURR RCD DEFN TBL ENTRY PTR STA CRDPT LDA PTPT1,I GET SEARCH FIELD NO. AND HIMSK ALF,ALF STA FLDNO SAVE SEARCH FIELD NO LDA DSPT1 INIT SRCH ARG STARTING ADDR. ADA DSMDL LDB AICBF ADB A,I STB SARGA GNRDE EQU * LDA FLDNO DECR SRCH ARG COUNT ADA M1 STA FLDNO STORE NEW COUNT SZA,RSS IS THIS THE SEARCH FIELD ? JMP MSARG YES LDA CRDPT,I NO, GET FIELD LENGTH AND B377 ARS,ARS ADA SARGA CALC. NEW SRCH ARG ADDR STA SARGA STORE NEW SRCH ARG ADDR ISZ CRDPT INCR TO NXT RCD DEFN TBL ENTRY JMP GNRDE CONTINUE * * * * ***** SAVE THE CURRENT MASTER DATA SET SEARCH ARGUMENT AND HASH*L**** ***** A RECORD NUMBER FOR THE MASTER DATA SET. ***** * * * * MSARG EQU * LDA CRDPT,I GET SRCH ARG LENGTH AND B377 ARS,ARS STA PHIMC MOVE LENGTH STA SARGS SAVE SRCH ARG LENGTH LDA ASRGS ADDR OF HASH LENGTH STA HLGTH LENGTH FOR HASH LDA SARGA SOURCE ADDR LDB ASARG DESTINATION ADDR JSB PHIMV SAVE THE SRCH ARG. JSB HASH HASH THE SRCH ARG DEF *+3 ASARG DEF SARG HLGTH BSS 1 LDB OPLCA,I GET MASTER DATA SET CAPACITY ADB DSCAP LDB B,I STB DVSOR STORE CAPACITY AS DIVISOR CLB DIV DVSOR CALCULATE RECORD NO. INB STB MRCDN SAVE MASTER DATA RCD NO. LDA OPLCA,I GET START OF MSTR RCD DEFN TABLE ADA DSLNG STA CRDPT STORE CURR RCD DEFN ENTRY ADDR * * * * ***** CALCULATE THE ADDRESS OF THE SEARCH ARGUMENT IN THE ***** ***** CURRENT MASTER DATA SET RECORD. ***** * * * * LDA OPLCA,I GET SEARCH FIELD NO. OF MASTER ADA DSCCT LDA A,I AND HIMSK ALF,ALF STA FLDNO STORE MSTR FIELD COUNT LDA OPLCA,I GET MSTR RECORD MEDIA LENGTH INA LDB A,I ADB AICBF CALC. SRCH ARG STARTING ADDR STB SARGA SAVE SRCH ARG STARTING ADDR GNMRD EQU * LDA FLDNO DECR FIELD COUNT ADA M1 STA FLDNO STORE NEW COUNT SZA,RSS IS THIS SEARCH FIELD ? JMP RDNMR YES LDA CRDPT,I GET FIELD LENGTH AND B377 ARS,ARS ADA [HFBSARGA CALC. NEW SRCH ARG ADDR STA SARGA STORE NEW SRCH ARG ADDR ISZ CRDPT INCR TO NEXT RCD DEFN TBL ENTRY JMP GNMRD CONTINUE H* * * * ***** READ THE MASTER RECORD AT THE HASHED RECORD NUMBER. ***** ***** CHECK IF ITS SEARCH ARGUMENT IS EQUAL TO THE SEARCH ***** ***** ARGUMENT IN THE DETAIL RECORD TO DELETE. IF SEARCH ***** ***** ARGUMENTS ARE NOT EQUAL READ THE NEXT SYNONYM UNTIL A ***** ***** MATCH IS FOUND. ***** * * * * RDNMR EQU * LDB MRCDN GET MASTER DATA RCD NO. STB RWRCN RECORD NO. FOR READ LDA OPLCA,I ADA DSNME STA RWFNM DATA SET NAME FOR READ LDA ARWPL ADDR OF PARM LIST FOR READ CLB READ FLAG JSB PHIRW MASTER RECORD READ ? JMP ERRTN NO LDB OPLCA,I UPDATE RCD NO. IN MSTR DSCB ADB DSRCN LDA RWRCN STA B,I LDA SARGS GET SEARCH FIELD SIZE STA CMPCT COMPARE COUNT LDA ASARG ADDR OF SRCH ARG OF RCD TO DEL. LDB SARGA ADDR OF SRCH ARG OF CURR MSTR JSB PHICM SRCH ARG'S EQUAL ? RSS NO JMP UPCHN YES LDA AICBF GET FWD SYN RCD NO. ADA .2 LDA A,I SZA,RSS END OF SYNONYMS ? JMP ER5 YES STA MRCDN STORE NEXT RCD NO. TO WRITE JMP RDNMR CONTINUE * * * * ***** GET ADDRESS OF CURRENT CHAIN ENTRY IN MASTER MEDIA RECORD***** ***** AND UPDATE THE HEAD AND/OR FOOT OF THE CHAIN IF THEIR ***** ***** RECORD NUMBER IS EQUAL TO THE RECORD OF THE DETAIL RECORD***** ***** TO DELETE. DECREMENT THE CHAIN COUNT. ***** * u * * * UPCHN EQU * LDA PTPT1 GET MSTR DATA SET PATH NO. ADA PTDPN LDA A,I AND HIMSK ALF,ALF CLB CALC. CURRENT CHAIN ENTRY IN MPY .3 MASTER DATA SET ADA AICBF INA LDB A,I GET RCD NO. OF CHAIN FOOT CPB DDLRN RCD NO. = RCD NO. TO DELETE ? RSS YES JMP CKHDC NO LDB TBWDA UPDATE MASTER CHAIN ENTRY WITH STB A,I RCD NO. OF NEW FOOT CKHDC EQU * INA LDB A,I GET RCD NO. OF CHAIN HEAD CPB DDLRN RCD NO. = RCD NO. TO DELETE ? RSS YES JMP DCHNC NO LDB TFWDA UPDATE MASTER CHAIN ENTRY EITH STB A,I RCD NO. OF NEW HEAD DCHNC EQU * ADA M2 DECREMENT THE CHAIN COUNT LDB A,I ADB M1 STB A,I STORE NEW CHAIN COUNT LDA OPLCA,I LDA A,I GET DATA SET TYPE CPA MANUL MANUAL MASTER ? JMP WUPMR YES * * * * ***** DETERMINE IF THE MASTER RECORD CAN BE DELETED. ***** * * * * * * LDA OPLCA,I GET MSTR DATA SET PATH COUNT ADA DSPCT LDA A,I AND B377 STA FLDNO STORE PATH COUNT LDB AICBF GET ADDR OF 1ST CHAIN ENTRY ADB .3 CZLCH EQU * LDA B,I LENGTH OF CHAIN 0 ? SZA YES JMP WUPMR NO LDA FLDNO DECR PATH COUNT ADA M1 STA FLDNO STORE NEW PATH COUNT ADB .3 INCR TO NEXT CHAIN ENTRY SZA ALL CHAINS CHECKED ? JMP CZLCH NO a LDA OPLCA,I MASTER DSCB ADDR FOR 'PHIMD' JSB PHIMD MASTER RECORD DELETED ? JMP ERRTN NO JMP UPDET YES * * * * ***** REWRITE THE UPDATED MASTER RECORD. ***** * * * * WUPMR EQU * LDA ARWPL PARM LIST ADDR FOR WRITE CLB,INB WRITE FLAG JSB PHIRW UPDATED MSTR RCD WRITTEN ? JMP ERRTN NO * * * * ***** DELETE THE DETAIL RECORD FROM THE CURRENT CHAIN. ***** * * * * UPDET EQU * LDA TBWDA GET BWD RCD NO. OF DELETE RCD SZA,RSS 1ST RCD IN DETAIL CHAIN ? JMP CFWDA YES STA RWRCN RCD NO. FOR READ LDA DSPT1 ADA DSNME STA RWFNM DATA SET NAME FOR READ LDA ARWPL PARM LIST ADDR FOR READ CLB READ FLAG JSB PHIRW BWD RECORD READ ? JMP ERRTN NO LDA DCHNP GET CURR DETAIL CHAIN ENTRY INA LDB TFWDA UPDATE BWD RCD WITH RCD NO. OF STB A,I ITS NEW FWD RCD LDA ARWPL PARM LIST FOR WRITE CLB,INB WRITE FLAG JSB PHIRW UPDATED BWD RCD REWRITTEN ? JMP ERRTN NO CFWDA EQU * LDA TFWDA GET FWD RCD NO. OF DELETE RCD SZA,RSS LAST RCD IN DETAIL CHAIN ? JMP DPTCT YES LDA TFWDA GET FWD RCD NO. OF DELETE RCD STA RWRCN RECORD NO. FOR READ LDA DSPT1 ADA DSNME STA RWFNM DATA SET NAME FOR READ LDA ARWPuL PARM LIST ADDR FOR READ CLB READ FLAG JSB PHIRW FWD RECORD READ ? JMP ERRTN NO LDA TBWDA UPDATE FWD RCD WITH RCD NO. OF STA DCHNP,I IT'S NEW BWD RCD LDA ARWPL PARM LIST ADDR FOR WRITE CLB,INB WRITE FLAG JSB PHIRW UPDATED FWD RCD REWRITTEN ? JMP ERRTN NO * * * * ***** DECREMENT THE PATH COUNT ***** * * * * DPTCT EQU * ISZ OPLCA INCR TO NEXT MSTR DSCB ADDR ISZ DCHNP INCR DETAIL CHAIN ENTRY ADDR ISZ DCHNP ISZ PTPT1 INCR TO NEXT DETAIL PATH TABLE ISZ PTPT1 ENTRY LDA PTCT1 DECR PATH COUNT ADA M1 STA PTCT1 STORE NEW PATH COUNT SZA ALL MASTERS UPDATED JMP UPNMS NO SKP ******************************************************************** * * * DELETE THE DETAIL RECORD FROM THE DETAIL DATA SET AND * * INCREMENT THE FREE COUNT. * * * ******************************************************************** DDREC EQU * LDB DSPT1 GET MEDIA LENGTH OF DETAIL INB LDA B,I INB GET DATA LENGTH OF DETAIL ADA B,I CALC. LENGTH TO ZERO LDB AICBF BUFFER TO ZERO JSB PHIZR ZERO THE BUFFER LDA DSPT1 GET RCD NO. OF CURRENT FREE RCD ADA DSFRH LDA A,I LDB AICBF INB STORE CURR FREE RCD NO. IN STA B,I BUFFER OF DELETED RECORD LDB DSPT1 SET DATA SET CURRENT RCD NO.Y ADB DSRCN EQUAL TO DATA SET FREE LDA B,I RCD NO. ADB M1 STA B,I LDA DSPT1 ADA DSNME STA RWFNM DATA SET NAME FOR WRITE LDA AICBF STA RWBUF BUFFER FOR WRITE LDA DSPT1 ADA DSRCN LDA A,I STA RWRCN RECORD NO. FOR WRITE LDA ARWPL PARM LIST ADDR FOR WRITE CLB,INB WRITE FLAG JSB PHIRW RECORD DELETED ? JMP ERRTN NO LDA DSPT1 INCREMENT FREE COUNT ADA DSFRC ISZ A,I DLRET EQU * CLB STB ISTAT,I SET 'ISTAT' TO 0 RET LDB AIRUN CLEAR ACTIVITY FLAG ADB ACSUB LDA B,I AND B377 STA B,I JSB PTFRE PUT FREELIST INFO BACK INTO SYS AV MEM NOP SHOULD NEVER HAVE ANY ERRORS JMP DBDEL,I * SKP ******************************************************************** * * * DELETE THE MASTER RECORD IF NO LINKAGES EXIST. * * * ******************************************************************** DMREC EQU * LDA DSPT1 ADA DSNME STA RWFNM DATA SET NAME FOR READ ADA M4 LDA A,I STA RWRCN RCD NO. FOR READ LDA AICBF STA RWBUF BUFFER FOR READ LDA ARWPL PARM LIST FOR READ CLB READ FLAG JSB PHIRW RECORD TO BE DELETED READ ? JMP ERRTN NO LDA AICBF,I GET RECORD FLAG SZA,RSS EMPTY RECORD ? JMP ER7 YES LDA DSPT1 GET MSTR PATH COUNT ADA DSPCT LDA A,I AND B377 STA FLDNO SAVE PATH COUNT LDB AICBF GET ADDR OF 1ST CHAIN ENTRY IN ADB .3 MASTER MEDIA RCD * * *  * ***** CHECK IF ALL LINKAGES HAVE A CAHIN COUNT OF ZERO ***** * * * * CPATH EQU * SZA,RSS PATH COUNT 0 ? JMP CDMRR YES LDA B,I GET CHAIN COUNT SZA CHAIN EMPTY ? JMP ER6 NO ADB .3 INCR TO NEXT MSTR CHAIN LDA FLDNO DECR PATH COUNT ADA M1 STA FLDNO STORE NEW PATH COUNT JMP CPATH CONTINUE CDMRR EQU * LDA DSPT1 DSCB ADDR FOR 'PHIMD' JSB PHIMD MASTER RECORD DELETED ? JMP ERRTN NO JMP DLRET YES SKP ******************************************************************** * * * PHIMD - DELETE A RECORD FROM A MASTER DATA SET * * * * ENTRY: * * A = MASTER DSCB ADDRESS * * IN CORE BUFFER = MASTER RECORD TO DELETE * * DSCB RECORD NO. = RECORD NO. TO DELETE * * * * EXIT: * * P+1 - ERROR(B = CODE) * * P+2 - MASTER RECORD DELETED * * * ******************************************************************** SPC 3 PHIMD NOP STA MDSCB SAVE MASTER DSCB ADDR LDA AICBF,I GET ENTRY FLAG SSA,RSS PRIMARY ENTRY ? JMP CFWDS YES LDA AICBF INA LDB A,I GET BWD SYN RCD NO. STB MBWD1 SAVE BWD SYN RCD NO. STB RWRCN RCD NO. FOR READ ! INA LDB A,I GET FWD SYN RCD NO. STB MFWD1 SAVE FWD SYN RCD NO. LDA ARWPL PARM LIST ADDR FOR READ CLB READ FLAG JSB PHIRW BWD SYN RCD READ ? JMP PHIMD,I NO LDA AICBF UPDATE BWD RECORD WITH NEW ADA .2 FWD SYNONYM RECORD NO. LDB MFWD1 STB A,I LDA ARWPL PARM LIST FOR WRITE CLB,INB WRITE FLAG JSB PHIRW UPDATED BWD SYN WRITTEN ? JMP PHIMD,I NO LDA MFWD1 SZA,RSS DELETED RCD END OF SYN CHAIN ? JMP MSDRC YES STA RWRCN RECORD NO. FOR READ LDA ARWPL PARM LIST ADDR FOR READ CLB READ FLAG JSB PHIRW FWD SYN RCD READ ? JMP PHIMD,I NO LDA AICBF UPDATE FWD RECORD WITH NEW INA BWD SYNONYM RECORD NO. LDB MBWD1 STB A,I LDA ARWPL PARM LIST ADDR FOR WRITE CLB,INB WRITE FLAG JSB PHIRW UPDATED FWD SYN WRITTEN ? JMP PHIMD,I NO MSDRC EQU * LDA MDSCB GET RECORD NO. TO DELETE ADA DSRCN LDA A,I STA RWRCN RECORD NO. TO WRITE LDB MDSCB GET MASTER MEDIA LENGTH INB LDA B,I INB GET MASTER DATA LENGTH ADA B,I CALC. LENGTH TO ZERO LDB AICBF BUFFER TO ZERO JSB PHIZR ZERO THE BUFFER LDA ARWPL PARM LIST ADDR FOR WRITE CLB,INB WRITE FLAG JSB PHIRW RECORD DELETED ? JMP PHIMD,I NO LDA MDSCB INCR MASTER FREE COUNT ADA DSFRC ISZ A,I ISZ PHIMD P+2 JMP PHIMD,I RETURN CFWDS EQU * LDA AICBF GET FWD SYN RCD NO. ADA .2 LDB A,I SZB,RSS ANY SYNONYMS ? JMP MSDRC NO STB MFWD1 SAVE FWD SYN ADDR STB RWRCN RCD NO. FOR READ LDA ARWPL PARM LIST ADDR FOR READ CLB READ FLAG JSB PHIRW G1ST SYNONYM READ ? JMP PHIMD,I NO LDA AICBF GET ENTRY FLAG ADDR CLB,INB PRIMARY FLAG STB A,I CHANGE FLAG FROM SYN TO PRIMARY CLB INA INCR TO BWD SYN FIELD STB A,I ZERO BWD SYN RCD NO. LDA MDSCB GET RCD NO. OF PRIMARY ENTRY ADA DSRCN TO DELETE LDA A,I STA RWRCN RCD NO. FOR WRITE LDA ARWPL PARM LIST FOR WRITE CLB,INB WRITE FLAG JSB PHIRW UPDATED SYN MOVED ? JMP PHIMD,I LDA MDSCB UPDATE DSCB WITH RCD NO. OF ADA DSRCN RECORD TO DELETE LDB MFWD1 STB A,I LDB RWRCN STB MBWD1 SAVE RCD NO. OF NEW PRIMARY RCD LDA AICBF GET FWD SYN RCD NO. OF NEW ADA .2 PRIMARY ENTRY LDA A,I SZA,RSS ANY MORE SYN'S ON CHAIN ? JMP MSDRC NO STA RWRCN RCD NO. FOR READ LDA ARWPL PARM LIST ADDR FOR READ CLB READ FLAG JSB PHIRW SYNONYM READ ? JMP PHIMD,I NO LDA AICBF GET ADDR OF BWD SYN RCD NO. FLD INA LDB MBWD1 GET NEW BWD SYN STB A,I STORE NEW BWD SYN RCD NO. LDA ARWPL PARM LIST ADDR FOR WRITE CLB,INB WRITE FLAG JSB PHIRW UPDATED SYNONYM WRITTEN ? JMP PHIMD,I NO JMP MSDRC YES SKP * * * * ***** ERROR ***** * * * * ER1 EQU * DATA BASE NOT OPEN LDB .103 JMP ERROR ER2 EQU * MODE NOT EQ. TO OR GT. 3 LDB .104 JMP ERROR ER3 EQU * DELETE RECORD NO. IS 0 LDB .111 JMP ERROR ER4 EQU * 4C DELETE TO AUTOMATIC DATA SET LDB .108 JMP ERROR ER5 EQU * NO ENTRY FOUND IN ASSOCIATED LDB .107 MASTER WITH EQUAL SEARCH ARG JMP ERROR ER6 EQU * LINKAGES EXIST FOR A MANUAL LDB .113 RECORD THAT IS TO BE DELETED JMP ERROR ER7 EQU * DELETE RECORD IS EMPTY LDB .114 JMP ERROR ER8 EQU * DATA BASE NOT LOCKED IN MODE 2 LDB .135 JMP ERROR ER9 EQU * LEVEL NOT 15 FOR DEL LDB .109 ERRTN EQU * CODE ALREADY ESTABLISHED ERROR EQU * STB ISTAT,I STORE ERROR CODE JMP RET SKP * * * * ***** STORAGE ***** * * * * DSET# BSS 1 'DBDEL' DATA SET NO. DSPT1 BSS 1 ADDR OF 'DBDEL' DSCB RDPT1 BSS 1 ADDR OF RECORD DEFINITION TABLE PTPT1 BSS 1 ADDR OF PATH TABLE CRDPT BSS 1 CURR. RECD DEFN TABLE ADDR PTCT1 BSS 1 PATH COUNT TBWDA BSS 1 BWD RECORD NO. TFWDA BSS 1 FWD RECORD NO. DCHNP BSS 1 DETAIL CURRENT CHAIN ENTRY ADDR SARGA BSS 1 SEARCH ARGUMENT ADDR SARGS BSS 1 SEARCH ARGUMENT LENGTH FLDNO BSS 1 FIELD COUNT MDST# BSS 1 MASTER DATA SET NO. DDLRN BSS 1 DELETE RCD NO. OF DETAIL DVSOR BSS 1 DIVISOR MRCDN BSS 1 CURRENT MASTER RECORD NUMBER. MDSCB BSS 1 MASTER DSCB ADDRESS MFWD1 BSS 1 MASTER DATA SET FWD SYN RCD NO. MBWD1 BSS 1 MASTER DATA SET BWD SYN RCD NO. RWFNM BSS 1 ADDR OF FILE NAME FOR I/O RWRCN BSS 1 RECORD NO. FOR I/O RWBUF BSS 1 ADDR OF BUFFER FOR I/O OPCNT BSS 1 COUNT OF DATA SETS TO OPEN OPLCA BSS 1 ADDR OF CURRENT OPEN LIST ENTRY OPLST BSS 6 ADDR LIST OF DATA SETS TO OPEN SARG BSS 100 SEARCH ARGUMENT ICBUF BSS 25<:66 IN CORE BUFFER SKP * * * * ***** CONSTANTS ***** * * * * AOPLS DEF OPLST ADDRESS OF START OF OPEN LIST ARWPL DEF RWFNM ADDRESS OF READ/WRITE PARM LIST AICBF DEF ICBUF ADDRESS OF IN CORE BUFFER ASRGS DEF SARGS ADDRESS OF SEARCH ARG LENGTH AUTOM OCT 101 AUTOMATIC MASTER DATA SET FLAG MANUL OCT 115 MANUAL MASTER DATA SET FLAG AMDS# DEF MDST# ADDR OF MASTER DATA SET NO. LEEBO ASC 1,LB OPEN INDICATOR .2 EQU DBZ+2 .3 EQU DBZ+3 .7 EQU DBZ+7 .15 EQU DSCAP .103 DEC 103 DEC 103 .104 DEC 104 DEC 104 .107 DEC 107 DEC 107 .108 DEC 108 DEC 108 .109 DEC 109 .111 DEC 111 DEC 111 .113 DEC 113 DEC 113 .114 DEC 114 DEC 114 .134 DEC 134 .135 DEC 135 END E<ASMB,R,L,C HED SUBROUTINE DBINF NAM DBINF,7 92063-12001 REV.1826 770601 * * ************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * * PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ************************************************************** * * * LISTING: 92063-19001 * SOURCE: 92063-18001 * RELOC: 92063-12001 * * ************************************************************* * * CALLING SEQUENCE : * * CALL DBINF(ITYPE,IMODE,ID,IBUF) * * PARAMETER DESCRIPTION : * * ITYPE - AN INTEGER WHOSE CONTENTS IS A PAIR OF * ASCII CHARACTERS WHICH TAKE ON THE VALUES * "I"(I FOLLOWED BY A BLANK) WHEN * REFERENCING ITEMS OR "S "(S FOLLOWED BY A * BLANK) WHEN REFERENCING DATA-SETS. * * IMODE - AN INTEGER WHICH CAN TAKE ON THE VALUES 1 * TO 5 INCLUSIVE REFECTING THE TYPE OF * INFORMATION THE USER WISHES RETURNED. * * ID - AN INTEGER ARRAY WHICH CAN TAKE ON 4 * DIFFERENT VALUES AS FOLLOWS: * * 1- AN INTEGER ITEM # OCCUPYING THE FIRST * POSITION OF THE ARRAY. * * 2- AN INTEGER DATA-SET # OCCUPYING THE * FIRST POSITION OF THE ARRAY. * * 3- AN ASCII ITEM NAME * * 4- AN ASCII DATA-SET NAME * * IBUF - AN INTEGER ARRAY IN WHICH IS RETURNED THE * REQUESTED INFORMATION. * * FUNCTION : * * IN ALL CASES, DBINF RETURNS A CONDITION WORD AS * THE FIRST WORD OF IBUF FOLLOWED BY THE DATA * DESCRIBED BELOW FOR THE VARIOUS MODES. A NEGATIVE * CONDITION WORD IS USED WHENEVER ONE OF THE * PARAMETERS HAS AN INCORRECT "VALUE". A ZERO * CONDITION WORD DENOTES A SUCCESSFUL CALL WITH NO * EXCEPTIONAL CONDITION RESULTING. A POSITIVE * CONDITION WORD DENOTES AN EFMP ERROR. * * * IMODOE = 1 * * ITYPE ="I " RETURNS DATA-ITEM COUNT AND DATA-ITEM * NUMBERS OF A SPECIFIED DATA-SET. IN * THIS CASE,ID IS A POINTER TO THE DATA * -SET NUMBER. * * :NOTE - THE DATA ITEM NUMBERS ARE POSITIVE IF THEY * ARE READABLE BUT NOT WRITEABLE,NEGATIVE IF * READABLE AND WRITEABLE. INACCESSIBLE DATA * ITEMS ARE EXCLUDED FROM THIS ARRAY. * * IMODE = 2 * * ITYPE ="I " RETURNS: * * 1- ITEM NAME - 6 BYTE ASCII STRING * 2-SEARCH TYPE-1 BYTE;IF THIS BYTE IS A * SEARCH ITEM OF ITS DATA-SET,IT IS SET TO 1 * OTHERWISE 0 * 3- ITEM TYPE - 1 BYTE;"I","R",OR"U" * 4- ITEM LEVEL - 2 BYTES; READ LEVEL IN * HIGH ORDER BYTE,WRITE LEVEL IN SECOND BYTE * 5- ITEM LENGTH - 1 WORD; THE ITEM LENGTH IN * WORDS * 6- ITEM OFFSET - 1 WORD; THE WORD OFFSET * FROM THE BEGINNING OF THE RECORD. * 7- DATA-SET # - 1 WORD; THE DATA-SET THIS * ITEM IS LOCATED IN. * * ITYPE ="S " RETURNS: * * 1- DATA-SET NAME - 6 BYTE ASCII STRING * 2- DATA-SET TYPE - 1BYTE;"A","M" OR "D" * 3- CAPACITY - 1 WORD; # OF RECORDS * 4- ENTRY LENGTH - 1 WORD; PHYSICAL RECORD * LENGTH IN WORDS * * :NOTE - IN THIS MODE ID IS A DATA-SET OR DATA-ITEM * NUMBER. * * IMODE = 3 * * ITYPE ="I " RETURNS DATA-ITEM COUNT AND DATA-ITEM * NUMBERS OF ALL DATA-ITEMS SERVING AS * SEARCH FIELDS OF A DATA-SET WHOSE * NUMBER IS SUPPLIED BY ID. * * * IMODE = 4 * * ITYPE ="S " RETURNS DATA-SET COUNT AND DATA-SET * NUMBER/ITEM NUMBER PAIRS OF THOSE * DATA-SETS RELATED TO A SPECIFIED DATA * -SET VIA A SPECIFIED DATA-ITEM. IN * THIS MODE,ID REFERENCES A DATA-ITEM * NUMBER. * * IMODE = 5 * * ITYPE ="I " RETURNS DATA-ITEM NUMBER OF A DATA- * ITEM SPECIFIED BY NAME. IN {THIS MODE * ID REFERENCES A WORD ARRAY WHOSE * CONTENTS IS A DATA-ITEM NAME. * * ITYPE ="S " RETURNS DATA-SET NUMBER OF A DATA-SET * SPECIFIED BY NAME. IN THIS MODE ID * REFERENCES A WORD ARRAY WHOSE * CONTENTS IS A DATA-SET NAME. * * * IMODE = 6 * * * ITYPE = "S " RETURNS VALUES NECESSARY FOR USER TO * RESUME A CHAIN OR SERIAL READ : * 1 - LAST RECORD ACCESSED - 1 WORD REC # * 2 - PATH LENGTH OF CHAIN - 1 WORD # RECORDS * 3 - NEXT RECORD # IN CHAIN - 1 WORD REC # * 4 - REC # OF CHAIN FOOT - 1 WORD REC # * 5 - PATH NUMBER OF CHAIN - 1 BYTE PATH NO. * IN THIS MODE, ID REFERENCES A DATA SET NO. * * * ITYPE ="R " RESTORES VALUES NECESSARY FOR RESUMPTION * OF A CHAIN OR SERIAL READ : * ( 1 THRU 5 SAME AS FOR ITYPE "S " ) * * * EXT .ENTR,EXEC,PHIS1,CMPCT,PHICM,AIRUN ENT DBINF * TEMP1 BSS 1 TEMPORARY STORAGE TEMP2 BSS 1 TEMP3 BSS 1 TEMP4 BSS 1 DSET BSS 1 BASE ADDRESS OF CURRENT DATA-SET .103 DEC 103 .124 DEC 124 .125 DEC 125 .115 DEC 115 M4 DEC -4 M3 DEC -3 M2 DEC -2 M1 DEC -1 .1 DEC 1 .2 DEC 2 .3 DEC 3 .4 DEC 4 .5 DEC 5 .6 DEC 6 .7 DEC 7 .8 DEC 8 .12 DEC 12 .13 DEC 13 .15 DEC 15 B377 OCT 377 B7400 OCT 177400 BLANK OCT 40 ITEM BSS 1 BASE ADDRESS OF CURRENT ITEM TEMPP DEF TEMP2 * * DBSTA EQU .3 DATA BASE STATUS DBICT EQU .5 DATA BASE ITEM COUNT DBSCT EQU .6 DATA BASE SET COUNT DBITB EQU .7 DATA BASE ITEM TABLE * * * * * PARS BSS 4 DBINF NOP JSB .ENTR PICK UP PARAMETERS ITYPE,IMODE, DEF PARS ID,IBUF LDA AIRUN IF DBSTATUS # "LB" THEN GO TO ADA DBSTA LDA 0,I CPA =ALB ERROR JMP DBIN0 LDB .103 ERROR STB PARS+3,I JMP DBINF,I DBIN0 LDA PARS+1,I IS MODE = 1? CPA .1 JMP *+2 JMP DBIN2 NO,CHECK FOR MODE = 2 LDA PARS,I IF ITYPE # "I ", THEN GO TO LDB .124 ERROR CPA =AI JMP *+2 JMP ERROR JSB SUB1 SET UP DSET CLB LDA PARS+3 TEMP1 IS ADDRESS OF DATA-ITEM INA COUNT STA TEMP1 STB TEMP1,I INA TEMP2 IS ADDRESS WHERE DATA-ITEM STA TEMP2 NUMBERS WILL BE STORED LDB DSET ADB .3 LDA 1,I ALF,ALF TEMP3 EQUALS MINUS THE FIELD AND B377 COUNT FOR THIS DATA-SET CMA,INA STA TEMP3 ADB .13 TEMP4 IS POINTER TO RECORD STB TEMP4 DEFINITION TABLE DBIN1 LDB TEMP4,I DATA ITEM NUMBERS ARE STORED LDA 1 POSITIVE IF THEY ARE READABLE ALF,ALF AND NOT WRITABLE,NEGATIVE IF AND B377 READABLE AND WRITEABLE,OTHERWISE RBR INACCESSIBLE. SSB,SLB,RSS JMP *+6 CMA,INA STA TEMP2,I ISZ TEMP2 ISZ TEMP1,I JMP *+4 RBL SLB JMP *-6 ISZ TEMP4 ISZ TEMP3 JMP DBIN1 CLB JMP ERROR DBIN2 CPA .2 IS IMODE = 2? JMP *+2 JMP DBIN8 NO,CHECK FOR IMODE = 3 LDA PARS,I IF ITYPE # "I " THEN CHECK FOR CPA =AI "S " JMP DBIN3 CPA =AS IF ITYPE # "S " THEN GO TO ERROR JMP *+3 LDB .124 JMP ERROR JSB SUB1 SET UP DSET LDA PARS+3 TEMP1 IS POINTER TO IBUF INA STA TEMP1 ADB .12 IBUF(2-4) = DSETNAME LDA M2 STA TEMP2 LDA 1,I STA TEMP1,I ISZ 1 ISZ TEMP1 ISZ TEMP2 JMP *-5 LDA 1,I AND B7400 ADA BLANK STA TEMP1,I ISZ TEMP1 ISZ 1 LDA DSET,I IBUF(5) = SETTYPE STA TEMP1,I ISZ TEMP1 LDA 1,I Y IBUF(6) = CAPACITY STA TEMP1,I ISZ TEMP1 LDB DSET INB LDA 1,I INB ADA 1,I STA TEMP1,I IBUF(7) = MEDIALGTH + ENTRYLGTH JMP DBIN2-2 DBIN3 JSB SUB2 ITYPE = "I "; PICK UP BASE LDA PARS+3 ADDRESS OF THIS ITEM IN ITEM INA TABLE STA TEMP1 TEMP1 IS POINTER TO IBUF LDA M3 STA TEMP2 LDA 1,I IBUF(2-4) = ITEM NAME STA TEMP1,I ISZ 1 ISZ TEMP1 ISZ TEMP2 JMP *-5 ISZ 1 LDA 1,I ALF,ALF AND B377 STA TEMP1,I IBUF(5) = TYPE IN LOW BYTE LDA 1,I AND B377 STA TEMP2 TEMP2 = DATA-SET # LDA TEMPP TEMPP IS POINTER TO TEMP2 JSB PHIS1 PICK UP BASE ADDRESS OF THIS JMP ERROR DATA-SET STB DSET ADB .4 IF DATA-SET IS A MASTER THEN LDA 1,I CRITCT IS THE FIELD # OF THE ALF,ALF SEARCH ITEM;IF CRITCT IS ZERO AND B377 THEN DATA-SET IS A DETAIL. SZA,RSS JMP *+6 CLB SET TEMP3 TO ZERO SO NO SKIPS IN STB TEMP3 LOOP DBIN4 CCB EXECUTE LOOP DBIN4 ONLY ONCE STB TEMP4 SINCE THIS IS MASTER JMP DBIN4+3 ISZ 1 DETAIL,SO CHECK FOR PATHS LDA 1,I SZA,RSS JMP DBIN5-1 NO PATHS,SO STORE ZERO IN SEARCH ADA DSET TYPE ADA M1 STA TEMP3 TEMP3 POINTS TO PATH TABLE ADB M2 LDA 1,I AND B377 CMA,INA STA TEMP4 TEMP4 IS NEGATIVE OF PATH COUNT DBIN4 LDA TEMP3,I PICK UP SEARCH ITEM FIELD ALF,ALF AND B377 LDB DSET INDEX RECORD DEFINITION TABLE ADB .15 WITH SEARCH FIELD AND PICK UP ADB 0 SEARCH ITEM # LDA 1,I ALF,ALF AND B377 LDB .1 BLF,BLF CPA PARS+2,I IF SEARCH ITEM # MATCHES ITEM # JMP DBIN5 CONTAINED IN PARAMETER "ID",THEN  ISZ TEMP3 SET SEARCH TYPE = 1 ISZ TEMP3 ISZ TEMP4 JMP DBIN4 CLB NO MATCHES,STORE ZERO IN SEARCH DBIN5 ADB TEMP1,I TYPE STB TEMP1,I IBUF(5) = SEARCH TYPE IN HIGH LDB ITEM BYTE/ITEM TYPE IN LOW BYTE ADB .3 LDA 1,I ISZ TEMP1 IBUF(6) = READ LEVEL IN HIGH STA TEMP1,I BYTE/WRITE LEVEL IN LOW BYTE LDB DSET ADB .3 LDA 1,I ALF,ALF AND B377 CMA,INA STA TEMP4 TEMP4 = NEGATIVE OF FIELD COUNT ADB M2 LDA 1,I INA STA TEMP3 TEMP3 = ITEM OFFSET ADB .15 DBIN6 LDA 1,I ALF,ALF AND B377 CPA PARS+2,I IF INUM EQUALS ITEM # CONTAINED JMP DBIN7 IN PARAMETER "ID", THEN STORE LDA 1,I ITEM LENGTH AND ITEM OFFSET IN AND B377 IBUF ARS,ARS ADA TEMP3 INCREMENT ITEM OFFSET BY LENGTH STA TEMP3 OF INUM ISZ 1 ISZ TEMP4 JMP DBIN6 LDB M4 THIS IS IN FOR DEBUG PURPOSES JMP ERROR DBIN7 LDA 1,I AND B377 ARS,ARS ISZ TEMP1 IBUF(7) = ITEM LENGTH FROM INUM STA TEMP1,I ISZ TEMP1 LDA TEMP3 STA TEMP1,I IBUF(8) = ITEM OFFSET ISZ TEMP1 LDA TEMP2 STA TEMP1,I IBUF(9) = DATA-SET # JMP DBIN2-2 DBIN8 CPA .3 IS IMODE = 3? JMP *+2 JMP DBI11 NO,CHECK FOR IMODE = 4 LDA PARS,I IF ITYPE # "I " THEN GO TO ERROR CPA =AI JMP *+3 LDB .124 JMP ERROR JSB SUB1 IF CRITCT # 0 FOR THIS DATA-SET ADB .4 THEN IT IS A MASTER,AND LDA 1,I THEREFORE CAN ONLY HAVE 1 SEARCH ALF,ALF ITEM;OTHERWISE,IF IT IS A DETAIL AND B377 ,IT MAY HAVE MULTIPLE SEARCH SZA,RSS ITEMS. JMP DBIN9 LDB DSET ADB .15 ADB 0 LDA 1,I PICK UP INUM(CRITCT) ALF,ALF AND B377 Ԣ LDB PARS+3 INB STB TEMP1 TEMP1 POINTS TO IBUF(2) LDB .1 STB TEMP1,I IBUF(2)=1 ISZ TEMP1 STA TEMP1,I IBUF(3)= INUM(CRITCT) JMP DBIN2-2 DBIN9 LDA PARS+3 TEMP1 POINTS TO IBUF(2) INA STA TEMP1 CLA STA TEMP1,I INB LDA 1,I IF PATH = 0,RETURN A ZERO IN SZA,RSS IBUF(2) JMP DBIN2-2 ADA DSET ADA M1 STA TEMP3 TEMP3 POINTS TO PATH TABLE ADB M2 LDA 1,I AND B377 CMA,INA STA TEMP4 TEMP4 IS NEGATIVE OF PATH COUNT LDB TEMP1 INB B-REGISTER POINTS TO IBUF(3) DBI10 LDA TEMP3,I PICK UP SEARCH ITEM FIELD ALF,ALF AND B377 ADA DSET INDEX RECORD DEFINITION TABLE ADA .15 WITH SEARCH FIELD AND PICK UP LDA 0,I SEARCH ITEM #; THEN STORE IT IN ALF,ALF IBUF AND INCREMENT IBUF(2) BY 1 AND B377 STA 1,I ISZ TEMP1,I INB ISZ TEMP3 ISZ TEMP3 ISZ TEMP4 JMP DBI10 JMP DBIN2-2 DBI11 CPA .4 IS IMODE = 4? JMP *+2 JMP DBI16 NO,CHECK FOR IMODE = 5? LDA PARS,I IF ITYPE # "S " THEN GO TO ERROR CPA =AS JMP *+3 LDB .124 JMP ERROR JSB SUB2 PICK UP BASE ADDRESS OF THE ADB .4 ITEM IN ITEM TABLE LDA 1,I AND B377 STA TEMP2 LDA TEMPP JSB PHIS1 JMP ERROR STB DSET DSET CONTAINS BASE ADDRESS IN LDA PARS+3 DSET TABLE PERTAINING TO THIS INA ITEM STA TEMP1 TEMP1 POINTS TO IBUF(2) ADB .5 IF PATH =0 THEN ZERO IBUF(2) AND LDA 1,I RETURN SZA JMP *+3 DB12 STA TEMP1,I JMP DBIN2-2 ADB M1 IF CRITCT =0 THEN DSET IS A LDA 1,I DETAIL,SO RETURN RELATED MASTER ALF,ALF DATA-SET/SEARCH ITEM PAIR IN AND B377 DS IBUF(3) AND IBUF(4) IF ID IS A SZA SEARCH ITEM JMP DBI14 ADB M1 LDA 1,I IF CRITCT #0 AND = ID THEN DSET AND B377 IS A MASTER, SO RETURN PATHCT CMA,INA NUMBER OF RELATED DETAIL DATA- STA TEMP2 SET/SEARCH ITEM PAIRS IN ARRAY ADB .2 IBUF AND SET IBUF(2) TO PATH LDA 1,I COUNT. ADA DSET ADA M1 TEMP2 = NEGATIVE OF PATH COUNT STA TEMP3 TEMP3 = POINTER TO PATH TABLE DBI12 LDA TEMP3,I PICK UP SEARCH FIELD AND INDEX ALF,ALF RECORD DEFINITION TABLE FOR THIS AND B377 DATA-SET ADA DSET ADA .15 LDA 0,I DOES INUM = ID? ALF,ALF AND B377 CPA PARS+2,I JMP DBI13 YES ISZ TEMP3 NO,TRY NEXT PATH ISZ TEMP3 ISZ TEMP2 JMP DBI12 CLA PATH TABLE EXHAUSTED,ID NOT A JMP DB12 SEARCH ITEM SO ZERO IBUF(2) DBI13 LDA .1 ID = INUM,SO SET TEMP1=1 STA TEMP1,I LDA TEMP3,I AND B377 ISZ TEMP1 STA TEMP1,I IBUF(3) = MASTER DATA-SET # LDA TEMP1 JSB PHIS1 JMP ERROR STB DSET DSET EQUALS BASE ADDRESS OF ADB .4 MASTER DATA-SET LDA 1,I ALF,ALF USE CRITCT TO INDEX RECORD AND B377 DEFINITION TABLE ,PICK UP ITEM ADA DSET NUMBER,AND STORE IT IN IBUF(4) ADA .15 LDA 0,I ALF,ALF AND B377 ISZ TEMP1 STA TEMP1,I JMP DBIN2-2 DBI14 ADA DSET USE CRITCT TO INDEX RECORD ADA .15 DEFINITION TABLE, AND PICK UP LDA 0,I ITEM NUMBER ALF,ALF AND B377 CPA PARS+2,I IF INUM # ID THEN ZERO IBUF(2) JMP *+2 AND RETURN JMP DBI13-2 ADB M1 LDA 1,I AND B377 STA TEMP1,I IBUF(2) = PATH COUNT CMA,INA STA TEMP2 TEMP2 = NEGATIVE OF PATH COUNT ADB .2 LDA 1,<I ADA DSET ADA M1 STA TEMP3 TEMP3 = POINTER TO PATH TABLE DBI15 LDA TEMP3,I AND B377 ISZ TEMP1 STA TEMP1,I IBUF(I) = DETAILNUM LDA TEMP3,I ALF,ALF AND B377 ISZ TEMP1 STA TEMP1,I IBUF(I+1) = DSRCHNUM ISZ TEMP3 ISZ TEMP3 ISZ TEMP2 JMP DBI15 JMP DBIN2-2 RETURN DBI16 CPA .5 IS IMODE = 5 ? JMP *+2 JMP DBI22 NO,CHECK FOR IMODE=6 LDA PARS,I "S " CPA =AI JMP DBI17 CPA =AS IF ITYPE # "S " THEN GO TO ERROR JMP *+3 LDB .124 JMP ERROR LDA PARS+2 JSB PHIS1 JMP ERROR DB16 LDB PARS+3 INB STA 1,I IBUF(2) = DATA-SET # OR ITEM # JMP DBIN2-2 DBI17 LDA AIRUN GET ADDRESS ADA DBITB OF LDA 0,I ITEM ADA AIRUN TABLE ADA M1 STA TEMP1 TEMP1 = BASE ADDRESS OF ITEM LDA AIRUN TABLE ADA DBICT LDA 0,I ITEM COUNT CMA,INA STA TEMP2 TEMP2 = NEGATIVE OF ITEM COUNT DBI20 LDA .3 STA CMPCT LDA TEMP1 LDB PARS+2 JSB PHICM JMP *+2 JMP DBI21 LDA TEMP1 ADA .5 STA TEMP1 ISZ TEMP2 JMP DBI20 LDB .125 JMP ERROR DBI21 LDA TEMP2 LDB AIRUN ADB DBICT ADA 1,I INA JMP DB16 DBI22 CPA .6 IF MODE DOES NOT EQUAL 6, JMP *+3 THEN A MODE ERROR EXISTS LDB .115 JMP ERROR LDA PARS,I IF TYPE DOES NOT EQUAL CPA =AS AN "S" OR AN "R",THEN JMP DBI24 A TYPE ERROR EXISTS CPA =AR JMP *+3 LDB .124 JMP ERROR JSB SUB1 SET UP TEMP1 TO POINT ADB .8 TO DATA-SET CONTROL STB TEMP1 BLOCK;SET UP TEMP2 TO LDA PARS+3 POINT TO SECOND WORD INA OF IBUF STA TEMP2 DBI23 LDB M4 62 SAVE OR RESTORE: LDA TEMP2,I (1) LAST RECORD ACCESSED STA TEMP1,I (2) PATH LENGTH OF CHAIN ISZ TEMP1 (3) NEXT RECORD # IN CHAIN ISZ TEMP2 (4) RECORD # OF CHAIN FOOT ISZ 1 JMP DBI23+1 JSB SUB1 STORE AND RESTORE ADB .4 CURRENT PATH LDA PARS,I CPA =AS JMP *+8 LDA 1,I RESTORE PATH NO ALF,ALF AND B377 ALF,ALF ADA TEMP2,I STA 1,I JMP DBIN2-2 LDA 1,I AND B377 SAVE PATH NO STA TEMP1,I JMP DBIN2-2 DBI24 JSB SUB1 SET UP TEMP2 TO POINT ADB .8 TO DATA-SET CONTROL STB TEMP2 BLOCK; SET UP TEMP1 TO LDA PARS+3 POINT TO SECOND WORD INA OF IBUF STA TEMP1 JMP DBI23 * IF ID LESS THEN OR EQUAL TO ZERO OR GREATER THAN * DSETCT,THEN GO TO ERROR, OTHERWISE SET UP BASE * ADDRESS FOR DATA-SET AND STORE IN DSET SUB1 NOP LDA PARS+2,I LDB .125 SSA JMP ERROR SZA,RSS JMP ERROR CMA,INA LDB AIRUN ADB DBSCT LDA 1,I LDB .125 SSA JMP ERROR LDA PARS+2 JSB PHIS1 JMP ERROR STB DSET JMP SUB1,I * IF ID LESS THAN OR EQUAL TO ZERO OR GREATER THAN * ITEM COUNT,THEN GO TO ERROR, OTHERWISE SET UP BASE * ADDRESS FOR ITEM AND STORE IN ITEM SUB2 NOP LDA PARS+2,I LDB .125 SSA JMP ERROR SZA,RSS JMP ERROR CMA,INA LDB AIRUN ADB DBICT ADA 1,I LDB .125 SSA JMP ERROR LDA PARS+2,I CMA,INA LDB AIRUN ADB DBITB LDB 1,I ADB AIRUN ADB M1 JMP *+2 ADB .5 ISZ 0 JMP *-2 STB ITEM JMP SUB2,I END eB@< * * * * SUP PRESS EXT $LIBR,$LIBX,$CVT1,.DBRN,EXEC,.ENTR * ENT DBSTA * * * * PARM BSS 1 DBSTA NOP JSB .ENTR DEF PARM * LDA PARM,I IF SZA,RSS LU IS ZERO SET TO 1 CLA,INA STA PARM * LDA STARS LDB .10 JSB WRITE WRITE STARS * LDA HEADR LDB .10 JSB WRITE WRITE HEADER LDA LINE LDB .10 JSB WRITE LDA ADBRN CHASE RSS CHASE INDIRECTS LDA 0,I GET NEXT VALUE RAL,CLE,SLA,ERA JMP *-2 NOT GOT IT YET STA ADBRN LDB 0,I GET ACTIVE TABLE SIZE CMB,INB STB TABCT STA 1 INB BACK LDA 1,I SET SSA IS THIS A VALID NAME JMP NOTNM NO! STA NAM UP INB DATA LDA 1,I NAME STA NAM+1 INB LDA 1,I STA NAM+2 ADB .3 LDA 1,I GET NUMBER OF USERS INB INCREMENT TO NEXT ENTRY IN ACTIVE TABLE JSB $LIBR NOP CCE JSB $CVT1 JSB $LIBX l   DEF *+1 DEF *+1 STB TEMP STA COUNT LDA ASTAT LDB .6 JSB WRITE WRITE OUT STATUS LDB TEMP * ENDIT ISZ TABCT DONE JMP BACK NO! * LDA STARS LDB .10 JSB WRITE WRITE STARS LDA SPACE LDB .2 JSB WRITE WRITE SPACE JMP DBSTA,I RETURN * NOTNM ADB .6 INCREMENT JMP ENDIT TO NEXT SLOT * * WRITE NOP STA ADDR STB CNT JSB EXEC DEF *+5 DEF .2 DEF PARM ADDR NOP DEF CNT JMP WRITE,I * * * * .2 DEC 2 .3 DEC 3 .6 DEC 6 .10 DEC 10 ADBRN DEF .DBRN STARS DEF *+1 ASC 10,******************** HEADR DEF *+1 ASC 20,DB NAME - #USERS ASC 15, LINE DEF *+1 ASC 10,-------------------- ASTAT DEF *+1 NAM BSS 3 DON'T SP ASC 2, COUNT BSS 1 RE-ORDER THESE TABAD BSS 1 TABCT BSS 1 TEMP NOP SPACE DEF SP CNT NOP END F ASMB,R,L,C NAM GTSIZ,7 92063-12001 REV.1826 770601 * * * * * ************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * * PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ************************************************************** * * * LISTING: 92063-19001 * SOURCE: 92063-18001 * RELOC: 92063-12001 * * ************************************************************* * * * ENTRY POINTS AND EXTERNALS * ENT GTSIZ EXT .ENTR,PHIS1,AIRUN * * * * THIS ROUTINE EXTRACTS THE NUMBER OF DATA SETS FROM THE * DATA BASE ROOT FILE AND STORES IT INTO ISIZE. IT ALSO EXTRACTS * THE DATA SET CAPACITY AND NUMBER OF FREE RECORDS IN A DATA SET * AND STORES THAT INFO WITH THE DATA SET NAME INTO THE BUFFER 'IBUF' * * * * CALLING SEQUENCE: * * CALL GTSIZ(IBUF,ISIZE) * * WHERE: IBUF IS 500 WORD BUFFER * ISIZE IS 1 WORD * * THE FORMAT OF IBUF ON RETURN IS AS FOLLOWS: * * WORD 1 : CAPACITY FIRST DATASET * WORD 2 : DATASET NAME(CHAR 1&2) * WORD 3 : DATASET NAME(CHAR 3&4) * WORD 4 : DATASET NAME(CHAR 5) * WORD 5 : NUMBER OF FREE RECORDS FOR 1ST DATASET * WORD 6 : CAPACITY OF NEXT DATASET * WORD 7 : ETCETERA ETCETERA * * IBUF NOP ISIZE NOP GTSIZ NOP JSB .ENTR DEF IBUF * * SET UP BUFFER WITH SIZE AND DATA SET NAME * LDA AIRUN GET ADA .6 DATA SET LDA 0,I COUNT STA ISIZE,I SET DATA SET COUNT CMA,INA STA TEMP2 LDA IBUF STA TEMP3 CLA,INA INITIALIZE DATA SET COUNTER STA TEMP1 DBCL0 LDA TEMPP STORE FREECT AND FREEHD d   JSB PHIS1 OF EACH DATA SET JMP GTSIZ,I INTO TEMPORARY ADB .6 TO SYSTEM AVAILABLE MEMORY LDA 1,I STA TEMP3,I FREE SPACE ISZ TEMP3 ADB .6 LDA 1,I *DATA SET NAME * STA TEMP3,I CHARACTERS 1 AND 2 ISZ TEMP3 INB LDA 1,I STA TEMP3,I CHARACTERS 3 AND 4 ISZ TEMP3 INB LDA 1,I AND MASK ADA B40 STA TEMP3,I CHARACTER 5 ISZ TEMP3 INB LDA 1,I STA TEMP3,I SET CAPACITY ISZ TEMP3 ISZ TEMP1 INCREMENT DATA SET COUNTER ISZ TEMP2 JMP DBCL0 JMP GTSIZ,I CONTINUE * TEMPP DEF *+1 TEMP1 NOP TEMP2 NOP TEMP3 NOP .3 DEC 3 .6 DEC 6 MASK OCT 177400 B40 OCT 40 END A ASMB,R,L,C HED SUBROUTINE GTFRE AND PTFRE NAM GTFRE,7 92063-12001 REV.1826 780510 * * ************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * * PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ************************************************************** * * * LISTING: 92063-19001 * SOURCE: 92063-18001 * RELOC: 92063-12001 * * ************************************************************* * * * * DATA BASE PUT AND GET FREE LIST SUBROUTINES * * THE PURPOSE OF THESE SUBROUTINES IS TO EXTRACT AND STORE THE * INFORMATION REGARDING THE DATA SET FREE LIST POINTER AND * COUNTER INFO FOR THE DATA SETS. * * THIS INFO IS STORED IN THE SYSAV MEMORY AREA OF RTE BY THE * DBOPN ROTINE AND MAY BE MODIFIED BY A DBPUT OR DBDEL THEREFORE * EITHER A DBPUT OR DBDEL ROUTINE MAY BE THE CALLER. * * * * * * CALLING SEQUENCE: * * JSB GTFRE GET FREELIST INFO FROM SYS AV MEM * AND STORE IN RUN TABLE * (ERROR RETURN P+2 , B=ERROR NUMBER) * * OR * * JSB PTFRE EXTRACT FREE LIST INFO FROM RUN TABLE * AND STORE IN SYS AVAILABLE MEMORY * (ERROR RETURN P+2 , B=ERROR NUMBER) * * * * * ENT PTFRE,GTFRE EXT PHIS1,EXEC,CMPCT,PHICM,.DBRN,AIRUN EXT ISIZE,AIDCB,POST * * * GTFRE NOP LDA AIRUN IS MODE ADA DBMOD EQUAL TO LDA 0,I AND B377 TWO OR THREE? CPA .3 IF THREE IGNORE! JMP EXITG P+2 RETURN * JSB FDACT FIND ACTIVE TABLE ENTRY JMP ERRGT NOT FOUND ERROR * JSB EXEC GET VOLATILE DEF *+5 DATA DEF .2|91 DEF CLASS TEMPB DEF BUF DEF .100 * CLA,INA STA TEMP1 SET UP DATA SET COUNTER LDA AIRUN GET DATA SET ADA DBSCT COUNT LDA 0,I CMA,INA STA TEMP2 LDA TEMPB STA TEMP3 DBCL2 LDA TEMPP RESTORE FREECT AND FREEHD JSB PHIS1 IN RUN TABLE FROM BUF JMP ERRGT ADB .6 LDA TEMP3,I STA 1,I ISZ TEMP3 ISZ 1 LDA TEMP3,I STA 1,I ISZ TEMP3 ISZ TEMP1 INCREMENT TO NEXT DATA SET ISZ TEMP2 JMP DBCL2 JSB DPOST POST ALL DATA SETS!!!! * EXITG ISZ GTFRE P+2 RETURN ERRGT JMP GTFRE,I EXIT NORMALLY * * * PTFRE NOP LDA AIRUN IS ADA DBMOD MODE EQUAL LDA 0,I AND B377 TWO OR THREE? CPA .3 IGNORE MODE = 3! JMP EXITP P+2 RETURN * JSB FDACT JMP ERRPT NOT FOUND ERROR * * POST ALL VOLATILE FREELIST FROM RUN * TABLE TO SYSTEM AVAILABLE MEMORY. * * CLA,INA STA TEMP1 SET DATA SET COUNTER FOR START LDA AIRUN GET DATA ADA DBSCT SET COUNT LDA 0,I CMA,INA STA TEMP2 LDA TEMPB STA TEMP3 DBCL1 LDA TEMPP STORE FREECT AND FREEHD JSB PHIS1 OF EACH DATA SET JMP ERRPT INTO TEMPORARY ADB .6 BUFFER PRIOR TO LDA 1,I OUTPUTING TO SYS AV MEMORY STA TEMP3,I ISZ TEMP3 ISZ 1 LDA 1,I STA TEMP3,I ISZ TEMP3 ISZ TEMP1 INCREMENT TO NEXT DATA SET ISZ TEMP2 DONE? JMP DBCL1 NO! * LDA AIRUN YES! ADA DBSCT SETUP LDA 0,I VOLATILE DATA SIZE RAL STA TABCT NOMEM JSB EXEC WRITE OUT DEF *+8 DEF .20 VOLATILE DATA DEF .0 DEF BUF DEF TABCT DEF .0 DEF .0 DEF CLASS 2CPA M2 MEMORY AVAILABLE JMP NOMEM NO! JSB DPOST POST ALL DATA SETS!!!! * ERRPT ISZ PTFRE P+2 RETURN EXITP JMP PTFRE,I * * * * POST THE DATA SETS * DPOST NOP LDA M6 LDB ISIZE ONE DCB SSB ONLY? LDA M1 YES! STA TEMP2 NO! SSB SIX DCB'S? CMB,INB NO! LDA .144 144 WORD CPA 1 DCB'S? RSS YES! LDA .272 NO! STA TEMP3 LDA AIDCB STA DCB POSTX JSB POST POST ALL DEF *+2 DCB'S DEF DCB,I DATA SETS LDA DCB GOTO ADA TEMP3 NEXT DCB STA DCB ISZ TEMP2 END? JMP POSTX NO! JMP DPOST,I RETURN * * * FIND ENTRY FOR THE DATA BASE IN ACTIVE TABLE * FDACT NOP LDA ADBRN RSS CHASE INDIRECTS LDA 0,I GET NEXT VALUE RAL,CLE,SLA,ERA JMP *-2 NOT GOT IT YET LDB 0,I GET CMB,INB ACTIVE TABLE SIZE AND SETUP COUNTER STB TABCT INA STA 1 SETUP ACTIVE TABLE ADDRESS STA TABAD NXENT LDA .3 STA CMPCT COMPARE LDA AIRUN ADA .11 GET PTR TO DATA BASE NAME JSB PHICM DB NAME TO NAME IN RSS ACTIVE TABLE JMP TABST FOUND LDB TABAD ADB .6 STB TABAD ISZ TABCT DONE? JMP NXENT NOT FOUND LDB .134 NO ACTIVE ENTRY IN TABLE JMP FDACT,I ERROR EXIT P+1 * TABST ADB .3 SET UP LDA 1,I IOR B20K CLASS NUMBER STA CLASS ISZ FDACT JMP FDACT,I RETURN * * M1 DEC -1 M2 DEC -2 M6 DEC -6 .0 DEC 0 .3 DEC 3 .6 DEC 6 DBSCT EQU .6 DBMOD DEC 9 .11 DEC 11 .20 DEC 20 .21 DEC 21 .100 DEC 100 .134 DEC 134 .144 DEC 144 .272 DEC 272 TABAD NOP ADDRESS OF MeEMORY RESIDENT ACTIVE TABLE DCB NOP DATA SET CONTROL BLOCK ADDRESS TABCT NOP COUNT OF ACTIVE TABLE SIZE CLASS NOP BUF BSS 100 VOLATILE DATA BUFFER ADBRN DEF .DBRN ACTIVE TABLE ADDRESS B377 OCT 377 B20K OCT 20000 TEMPP DEF *+1 TEMP1 BSS 1 TEMP2 BSS 1 TEMP3 BSS 1 END YcASMB,R,L,C NAM PHIZR,7 92063-12001 REV.1826 770601 * * ************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * * PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ************************************************************** * * * LISTING: 92063-19001 * SOURCE: 92063-18001 * RELOC: 92063-12001 * * ************************************************************* * ENT PHIZR ******************************************************************** * * * * PHIZR - ZERO AN AREA IN CORE * * * * * * ENTRY: * * * A = LENGTH TO ZERO (IN WORDS) * * * B = ADDR OF START OF AREA TO ZERO * * * * * * EXIT: * * * P+1 - AREA ZERO'D * * * * * ******************************************************************** SPC 3 PHIZR NOP STB AARTZ STORE ADDR OF 1ST WORD TO ZERO CLB ZRNXT EQU * STB AARTZ,I ZERO THE WORD ADA M1 DECR WORD COUNT SZA,RSS ALL WORDS ZERO'D ? JMP PHIZR,I YES ISZ AARTZ INCR TO NEXT WORD JMP ZRNXT NO AARTZ BSS 1 ADDR OF WORD TO ZERO M1 DEC -1 DEC -1 END   ASMB,R,L,C HED SUBROUTINE DBLCK AND DBUNL NAM DBLCK,7 92063-12001 REV.1826 780510 * * ************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * * PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ************************************************************** * * * LISTING: 92063-19001 * SOURCE: 92063-18001 * RELOC: 92063-12001 * * ************************************************************* * * * * DATA BASE LOCK SUBROUTINE * * THE PURPOSE OF THIS SUBROUTINE IS TO TEMPORARILY LOCK DATA BASES * TO ALLOW THE USER TO PERFORM DELETES, PUTS AND UPDATES WITH * OUT INTERFERENCE FROM OTHER USERS OF DATA BASE. THE USER MUST BE * IN MODE 2 TO LOCK THE DATA BASE. * * DATA BASE UNLOCK SUBROUTINE * THE PURPOSE OF THIS SUBROUTINE IS TO UNLOCK THE DATA BASE * * * * CALLING SEQUENCE: * * CALL DBLCK(IMODE,ISTAT) * * PARAMETER DESCRIPTION: * * * IMODE = AN INTEGER VARIABLE THE VALUE OF WHICH IS EITHER * 1 OR 2 * * IMODE = 1 IN THIS MODE CONTROL RETURNS ONLY AFTER * EXECLUSIVE CONTROL OF THE DATA BASE HAS BEEN ACQUIRED. * THIS WILL OCCUR AFTER THE USER CURRENTLY LOCKING * THE DATA BASE RELEASES CONTROL OF IT. * * IMODE = 2 IN THIS MODE CONTROL IS RETURNED IMMEDIATELY * TO THE USER WHETHER HE HAS GAINED CONTROL OR NOT. IF * HE HAS GAINED CONTROL ISTAT IS SET TO 0. IF HE HAS NOT * GAINED CONTROL THEN ISTAT IS SET TO AN ERROR NUMBER. * * ISTAT = 0 IF THE USER HAS LOCKED THE DATA BASE. * ISTAT = 103 IF THE DATA BASE IS NOT OPEN * ISTAT = 104 IF THE USER IS NOT IN MODE 2 OR 3. * ISTAT = 134 NO ACTIVE TABLE ENTRY * ISTAT = 137 ILLEGAL RN USAGE BY SOMEBODY ELSE * ISTAT = 138 ALREADY LOCKED : * ISTAT = 136 IF DATA BASE IS ALREADY LOCKED ON A NO WAIT REQUEST. * * * CALLING SEQUENCE: * * CALL DBUNL(ISTAT) * * PARAMETER DESCRIPTION: * * * * ISTAT = 0 IF USER HAS UNLOCKED THE DATA BASE. * = 103 IF THE DATA BASE IS NOT OPEN * = 137 IF AN ERROR OCCURED IN UNLOCKING * = 139 NOT YET LOCKED * * ENT DBLCK,DBUNL EXT RNRQ,CMPCT,PHICM,.DBRN,.ENTR,AIRUN EXT ISIZE,AIDCB,POST * * IMODE NOP ISTAT NOP * DBLCK NOP JSB .ENTR DEF IMODE * CLA SET LOCK STA LKFLG FLAG LDA AIRUN GET RUN TABLE ADDRESS ADA .3 GET DATA BASE STATUS LDB LEEBO CPB 0,I IS DATA BASE OPEN? RSS YES JMP E103 NO, ERROR RETURN CLA CLEAR STA ISTAT,I STATUS * LDA AIRUN IS MODE STA RUNAD ADA DBMOD EQUAL TO LDA 0,I AND B377 TWO OR THREE? CPA .1 JMP E104 MODE =1 IS ILLEGAL MODE! CPA .3 IF THREE IGNORE! JMP DBLCK,I * LCK LDA ADBRN RSS CHASE INDIRECTS LDA 0,I GET NEXT VALUE RAL,CLE,SLA,ERA JMP *-2 NOT GOT IT YET LDB 0,I GET CMB,INB ACTIVE TABLE SIZE AND SETUP COUNTER STB TABCT INA STA 1 SETUP ACTIVE TABLE ADDRESS STA TABAD NXENT LDA .3 STA CMPCT COMPARE LDA AIRUN ADA .11 GET PTR TO DATA BASE NAME JSB PHICM DB NAME TO NAME IN RSS ACTIVE TABLE JMP TABST FOUND LDB TABAD ADB .6 STB TABAD ISZ TABCT DONE? JMP NXENT NOT FOUND JMP E134 NO ACTIVE ENTRY IN TABLE * TABST ADB .3 SET UP LDA 1,I IOR B20K CLASS NUMBER STA CLASS INB LDA 1,I STA RN SETUP RESOURCE NUMBER ADDRESS LDA LKFLG LO9CK? SZA JMP UNLK UNLOCK! * CLA,INA SET FOR STA ICODE NO WAIT LDA RUNAD,I IS RUN TABLE ALREADY SZA LOCKED? JMP E138 YES! * LDB IMODE,I IS CPB .1 MODE = 1(WAIT REQUEST)? JMP WAIT YES! CPB .2 NO WAIT REQUEST? JMP NOWAT YES! JMP E104 BAD MODE ERROR! * WAIT JSB RNRQ SET DEF *+4 RESOURCE DEF ICODE NUMBER DEF RN DEF TEMP1 LDA TEMP1 IS IT CPA .2 LOCKED LOCALLY? JMP DBLC1 YES! CPA .6 JMP E136 LOCKED LOCALLY TO SOMEONE ELSE JMP E137 ILLEGAL USAGE OF RESOURCE NUMBER BY SOMEBODY * DBLC1 CLA,INA SET LOCK FLAG IN STA RUNAD,I RUN TABLE * JSB DPOST POST ALL DATA SETS!!!! * CLB JMP ERROR EXIT NORMALLY * * * * UNLOCK ENTRY * * STAT NOP DBUNL NOP JSB .ENTR DEF STAT * CCA SET FLAG FOR STA LKFLG UNLOCK ENTRY LDA AIRUN GET RUN TABLE ADDRESS ADA .3 GET DATA BASE STATUS LDB LEEBO CPB 0,I IS DATA BASE OPEN? RSS YES JMP E103 NO, ERROR RETURN CLA CLEAR STA STAT,I STATUS * LDA AIRUN IS STA RUNAD ADA DBMOD MODE EQUAL LDA 0,I AND B377 TWO OR THREE? CPA .1 JMP E104 MODE = 1 IS ILLEGAL CPA .3 IGNORE MODE = 3! JMP DBUNL,I JMP LCK SET UP * UNLK LDA RUNAD,I HAS DB BEEN LOCKED SZA,RSS YET? JMP E139 NO! * * * JSB DPOST POST ALL THE DATA SETS * * JSB RNRQ CLEAR DEF *+4 RESOURCE DEF .4 NUMBER DEF RN DEF TEMP1 LDA TEMP1 CPA .1 GOOD RETURN? RSS YES! JMP E137 NO! | CLB STB RUNAD,I CLEAR LOCK FLAG IN RUN TABLE UNXIT STB STAT,I SET STATUS JMP DBUNL,I * * NOWAT LDA ICODE MASK IN IOR WAITB STA ICODE NOWAIT BIT JMP WAIT * E103 LDB .103 DATA BASE NOT OPEN RSS E104 LDB .104 WRONG MODE RSS E134 LDB .134 NO ACTIVE TABLE ENTRY RSS E137 LDB .137 ILLEGAL RN USAGE BY SOMEONE RSS E138 LDB .138 ALREADY LOCKED TO ITSELF RSS E139 LDB .139 NOT LOCKED YES RSS E136 LDB .136 LOCKED LOCALLY TO SOMEONE ELSE ON NOWAIT LDA LKFLG SZA LOCK? JMP UNXIT UNLOCK! ERROR STB ISTAT,I STUFF ERROR NO. JMP DBLCK,I * * * * * POST THE DATA SETS * DPOST NOP LDA M6 LDB ISIZE ONE DCB SSB ONLY? LDA M1 YES! STA TEMP2 NO! SSB SIX DCB'S? CMB,INB NO! LDA .144 144 WORD CPA 1 DCB'S? RSS YES! LDA .272 NO! STA TEMP3 LDA AIDCB STA DCB POSTX JSB POST POST ALL DEF *+2 DCB'S DEF DCB,I DATA SETS LDA DCB GOTO ADA TEMP3 NEXT DCB STA DCB ISZ TEMP2 END? JMP POSTX NO! JMP DPOST,I RETURN * * * M1 DEC -1 M6 DEC -6 .1 DEC 1 .2 DEC 2 .3 DEC 3 .4 DEC 4 .6 DEC 6 DBMOD DEC 9 .11 DEC 11 .103 DEC 103 .104 DEC 104 .134 DEC 134 .136 DEC 136 .137 DEC 137 .138 DEC 138 .139 DEC 139 .144 DEC 144 .272 DEC 272 WAITB OCT 100000 LEEBO ASC 1,LB OPEN INDICATOR ICODE NOP TABAD NOP ADDRESS OF MEMORY RESIDENT ACTIVE TABLE DCB NOP DATA SET CONTROL BLOCK ADDRESS TABCT NOP COUNT OF ACTIVE TABLE SIZE LKFLG NOP RN NOP RESOURCE NUMBER CLASS NOP ADBRN DEF .DBRN ACTIVE TABLE ADDRESS B377 OCT 377 B20K OCT 20000 TEMP1 BSS 1 TEMP2 BSS 1 TEMP3 BSS 1 RUNAD BSS 1 END FASMB,R,L,C NAM CATI,7 92063-12001 REV.1826 770601 * * ************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * * PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ************************************************************** * * * LISTING: 92063-19001 * SOURCE: 92063-18001 * RELOC: 92063-12001 * * ************************************************************* * SPC 1 * CALL CATI(IFLD,IBYT,ILTH,INT,ISTAT) * * CONVERT A NUMERIC ASCII FIELD OF LENGTH * "ILTH" BEGINNING AT "IBYT" OF "IFLD" * TO AN INTEGER "INT" * * CONVERSION IS TERMINATED BY A NON-NUMERIC * CHARACTER OR EXHAUSTION OF "ILTH" * * NUM-CHAR = BLANK,+,-,NUMBER . * * "ISTAT" 0 => NORMAL * -1 => OVERFLOW OR NON-ASCII SPC 1 EXT .ENTR ENT CATI SPC 1 A EQU 0 B EQU 1 SPC 1 IFLD BSS 1 BUFFER ADDRESS (WORD) IBYTE BSS 1 REL. NUM. FIELD ADDRESS (BYTE) ILTH BSS 1 CHARACTER IN IFLD INT BSS 1 BINARY INTEGER RETURNED ISTAT BSS 1 STATUS CATI NOP ENTER AND GET JSB .ENTR ARGUMENT DEF IFLD ADDRESSES SPC 1 LDA IBYTE,I STA IEND ADA ILTH,I STA ILTH SPC 1 CLO CLA STA INT,I ALL BLANK FIELD => 0 STA SIGN STA SAVE JSB GETC GET A CHARACTER CPA =B53 + SIGN? JMP C1 YES CPA =B55 - SIGN? CCB,RSS YES JMP C5 NO STB SIGN SPC 1 C1 JSB GETC GET A NUMBER C5 JSB CHECK CHECK IT STA INT,I t   LDA SAVE ADA A STA B ADA A ADA A ADA B ADA INT,I STA SAVE JMP C1 SPC 1 SAVE BSS 1 SIGN BSS 1 IEND BSS 1 SPC 1 DONE CLA SET SOC STATUS ERR CCA STA ISTAT,I LDA SAVE LDB SIGN INSERT THE SZB SIGN CMA,INA STA INT,I JMP CATI,I EXIT SPC 1 GETC NOP GETC1 LDB IEND CPB ILTH IF DONE JMP DONE THEN EXIT ADB M1 GET AND CLE,ERB ISOLATE THE ADB IFLD BYTE POINTED LDA B,I AT BY IBYT SEZ,RSS ALF,ALF AND B377 ISZ IEND CPA =B40 JMP GETC1 JMP GETC,I SPC 1 CHECK NOP ADA =B177720 CHECK FOR SSA ASCII NUMBER JMP ERR ( >57B, ADA M10 <72B) SSA,RSS JMP ERR ADA .10 JMP CHECK,I * M1 DEC -1 .10 DEC 10 M10 DEC -10 B377 OCT 377 END  FTN4,L,C C C C************************************************************* C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * C RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * C PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * C OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C************************************************************* C C C LISTING: 92063-19001 C SOURCE: 92063-18001 C RELOC: 92063-12001 C C C************************************************************ C CSUBROUTINE CRTA CFUNCTION-CONVERTS THE WHOLE PORTION OF A REAL VARIABLE,VAR,TO CINTEGER NUMBER,HALF-ADJUSTING AS SPECIFIED.AND PLACES THE RES CDECIMAL POINT ALIGNMENT,IN AN ARRAY. AN 11-ZONE IS PLACED OVER CLOW-ORDER,RIGHTMOST POSITION IN THE ARRAY IF VAR IS NEGATIVE. C CCALLING SEQUENCE- C CCALL CRTA(JCARD,J,JLAST,VAR,ADJST,N) SUBROUTINE CRTA(JCARD,J,JLAST,VAR,ADJST,N),92063-12001 REV. 1826 DIMENSION JCARD(1) CDISCARD FRACTIONAL PORTION OF NUMBER DIGT=ABS(VAR)+ADJST DIGS=WHOLE(DIGT) CIF THE NUMBER OF PLACES TO TRUNCATE IS GREATER THAN ZERO,TRUN CACCORDINGLY IF (N)2,2,1 1 JNOW=1 3 DIGS=WHOLE(DIGS/10.0) IF(JNOW-N)9,2,2 9 JNOW=JNOW+1 GO TO 3 2 JNOW=JLAST 4 DIGT=WHOLE(DIGS/10.0) CCALCULATE EBCDIC INTEGER ICHAR=IFIX(DIGS-10.0*DIGT)+60B CALL SPUT(JCARD,JNOW,ICHAR) DIGS=DIGT IF(JNOW-J)6,6,5 5 JNOW=JNOW-1 GO TO 4 6 IF(VAR)7,8,8 7 CALL SZONE(JCARD,JLAST,2,JNOW) 8 RETURN END $ ASMB,R,L,C NAM CITA,7 92063-12001 REV.1826 770601 * * ************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * * PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ************************************************************** * * * LISTING: 92063-19001 * SOURCE: 92063-18001 * RELOC: 92063-12001 * * ************************************************************* * SPC 1 EXT .ENTR ENT CITA SPC 1 A EQU 0 B EQU 1 SPC 1 * CALL CITA(INT,IA) * * CONVERT AN INTEGER (INT) TO ITS * DECIMAL EQUIVALENT IN ASCII * FORMAT IN THE 3 WORD ARRAY (IA) SPC 1 INT BSS 1 IA BSS 1 CITA NOP ENTER AND JSB .ENTR GET ARGUMENT DEF INT ADDRESSES LDA TA SET UP NUMBER TABLE STA IPICK POINTER LDA INT,I GET THE INTEGER LDB MINUS GENERATE SSA THE SIGN CMA,INA,RSS AND THE LDB BLANK FIRST NUMBER JSB ONEN STB IA,I CLB GENERATE JSB ONEN THE NEXT BLF,BLF TWO NUMBERS JSB ONEN ISZ IA STB IA,I CLB GENERATE JSB ONEN THE LAST BLF,BLF TWO NUMBERS ADB =B60 ADB A ISZ IA STB IA,I JMP CITA,I SPC 1 ONEN NOP ENTER CONVERSION ROUTINE ADB =B60 ON1 ADA IPICK,I SSA JMP ON2 INB JMP ON1 ON2 CMA,INA ADA IPICK,I CMA,INA ISZ IPICK JMP ONEN,I SPC 1 TA DEF NBUF NBUF DEC -10000 DEC -1000 DEC -100 DEC -10 BLANK OCT 20  000 MINUS OCT 26400 SPC 1 IPICK BSS 1 END 3 ASMB,R,L,C NAM CATR,7 92063-12001 REV.1826 770601 * * ************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * * PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ************************************************************** * * * LISTING: 92063-19001 * SOURCE: 92063-18001 * RELOC: 92063-12001 * * ************************************************************* * ENT CATR EXT SGET,.PACK,.ENTR ****************************** * * * ASCII TO REAL CONVERSION * * * ****************************** * * * CALLING SEQUENCE: * * A=CATR(IARRY,J,K,ISTAT) * * WHERE: IARRY IS SINGLE DIMENSION ARRAY OF CHARACTERS * CONTAINING THE NUMBER TO BE CONVERTED. TWO CHARS * PER WORD. * * J IS THE NUMBER OF THE FIRST CHARACTER IN THE * STRING. * * K IS THE NUMBER OF THE LAST CHARACTER IN THE STRING * * ISTAT IS SET TO 0 FOR GOOD CONVERSION AND -1 FOR * INVALID CONVERSION. * * BUFR NOP J NOP JLAST NOP ISTAT NOP CATR NOP JSB .ENTR DEF BUFR CLB STB EXP ZERO STB MANT1 ALL STB MANT2 COMPONENTS STB EXPON OF NUMBER STB SIGN STB TEMP3 SET 'NUMBER' FLAG FALSE STB ISTAT,I CLEAR ERROR FLAG CCB SET 'DECIMAL POINT' STB DPFLG FLAG FALSE LDA J,I SET STA CHRCT CHAR COUNTER JSB GETCR GET A CHAR JMP NUMER CPA .43 (+)? JMP NUMC0 YES! CPA .45 (-)? JMP NUM16 YES! JMP NUMC1 NO! NUMC0 JSB GETCR GET A CHAR JMP {NUMER NO CHAR ERROR! NUMC1 CPA .46 DECIMAL POINT? ISZ DPFLG YES, SET FLAG TRUE JMP NUMC2 NO CLA INITIALIZE POST-DECIMAL DIGIT STA EXPON DIGIT COUNTER TO ZERO JMP NUMC3+1 FETCH A CHARACTER * NUM16 CCB STB SIGN SET FOR NEGATIVE NUMBER JMP NUMC0 * NUMC2 JSB DIGCK DIGIT? JMP NUMC7 NO ISZ EXPON YES, COUNT DIGIT ALF,ALF LEFT-JUSTIFY ALF,RAR DIGIT AND STA TEMP4 SAVE IT JSB MBY10 MULTIPLY PREVIOUS NUMBER BY 10 LDB EXP SZB ZERO EXPONENT? JMP NUMC4 NO LDA .4 YES, SET STA EXP EXPONENT TO 4 LDA TEMP4 LOAD CLB NUMBER NUMC3 JSB NORML NORMALIZE THE NUMBER ISZ TEMP3 SET 'NUMBER OCCURRED' FLAG JSB GETCR ANOTHER CHARACTER? JMP NUM12 NO JMP NUMC1 YES NUMC4 ADB M4 COMPUTE CMB EXPONENT LDA TEMP4 BIAS AND STB TEMP4 SAVE IT CLB NUMC5 ISZ TEMP4 DIGIT POSITIONED? JMP NUMC6 NO CLE YES, ADD IN ADB MANT2 LOW PART CLO OF NUMBER SEZ OVERFLOW? INA YES, BUMP (A) ADA MANT1 ADD IN HIGH PART OF NUMBER SOS OVERFLOW? JMP NUMC3 NO CLE,ERA YES, ROTATE ERB DOWN AND ISZ EXP BUMP NOP EXPONENT JMP NUMC3 NUMC6 CLE,ERA SHIFT ERB DIGIT JMP NUMC5 RIGHT NUMC7 CLB DECIMAL POINT STB TEMP4 CPB TEMP3 OR DIGIT FOUND? JMP NUMER NO, EXIT VIA ERROR CPA E YES, 'E' ? RSS YES JMP NUM12 NO, NO EXPONENT PART JSB GETCR JMP NUMER CPA .43 '+' ? JMP NUMC8 YES CPA .45 NO, '-' ? CCA,RSS YES JMP NUMC9 NO STA TEMP4 NOTE MINUS SIGN NUMC8 JSB GETCR JMP NUMER NUMC9 JSB DIGCK DIGIT? JMP NUMER NO STA TEMP3 YES, SAVE IT JSB GETCR JMP NUM10 SECOND JSB DIGCK DIGIT? JMP NUM10 NO LDB TEMP3 YES BLS,BLS MULTIPLY ADB TEMP3 PRIOR DIGIT BLS BY 10 ADA 1 ADD NEW DIGIT STA TEMP3 SAVE EXPONENT JSB GETCR JMP NUM10 THIRD JSB DIGCK DIGIT? RSS NO JMP NUMER YES NUM10 LDA TEMP3 LOAD EXPONENT ISZ TEMP4 POSITIVE? CMA,INA YES, COMPLEMENT IT RSS NO NUM12 CLA CLEAR IF NO EXPONENT PART ISZ DPFLG DECIMAL POINT? ADA EXPON YES, CORRECT EXPONENT SZA,RSS ZERO EXPONENT? JMP NUM14 YES SKP SSA NO, NEGATIVE EXPONENT? JMP NUM13 NO CMA,INA YES, SET STA EXPON COUNTER JSB DBY10 DIVIDE NUMBER BY 10 ISZ EXPON DONE? JMP *-2 NO JMP NUM14 YES NUM13 STA EXPON SET COUNTER JSB MBY10 MULTIPLY BY 10 ISZ EXPON DONE? JMP *-2 NO NUM14 LDA MANT1 YES, LOAD LDB MANT2 NUMBER ISZ SIGN POSITIVE? JMP NUM15 YES CMA NO, CMB,INB,SZB,RSS COMPLEMENT INA IT NUM15 JSB .PACK PACK NUMBER INTO (A) AND (B) EXP BSS 1 EXPONENT JMP CATR,I * NUMER CCB STB ISTAT,I SET ERROR FLAG JMP CATR,I SKP ********************************** * * * MULTIPLY UNPACKED NUMBER BY 10 * * * ********************************** MBY10 NOP LDA MANT1 RETURN ON SZA,RSS ZERO JMP MBY10,I MANTISSA LDB EXP f MULTIPLY ADB .3 BY STB EXP 8 LDB MANT2 LOAD MANTISSA CLE,ERA DIVIDE ERB BY CLE,ERA 4 ERB,CLE ADB MANT2 DOUBLE SEZ ADD TO INA PRODUCE ADA MANT1 1.25 * MANTISSA SSA,RSS CORRECT JMP *+5 CLE,ERA ON ERB ISZ EXP OVERFLOW NOP STA MANT1 STB MANT2 JMP MBY10,I ******************************** * * * DIVIDE UNPACKED NUMBER BY 10 * * * ******************************** DBY10 NOP MULTIPLY BY DOUBLE-LENGTH TENTH LDA MANT1 RETURN SZA,RSS ON ZERO JMP DBY10,I MANTISSA LDB M2 ADD EXPONENT OF ADB EXP 'TENTH' TO STB EXP MANTISSA EXPONENT LDA MANT2 JUSTIFY CLE,ERA LOWER MANTISSA MPY TENTH MULITPLY BY ONE-TENTH (63416) CLE,ELA SHIFT ELB,CLE BACK ADA 1 ADD IN LOWER MANTISSA* SEZ TENTH*(2)-16 INB AND ROUND STB MANT2 TO 16 BITS LDA MANT1 DO MPY TENTH SAME FOR CLE HIGH ADA 1 MANTISSA ADA MANT2 (EFFECTIVELY) SUM SEZ DOUBLE-LENGTH INB PRODUCTS STB MANT1 EXCHANGE STA 1 (A) AND (B) LDA MANT1 REGISTERS JSB NORML NORMALIZE RESULT JMP DBY10,I ******************************* * * * NORMALIZE (A), (B) AND EXP * * * ******************************* NORML NOP STA TEMP3 SET LEFT-SHIFT CLA COUNTER STA FERR TO ZERO LDA TEMP3 SZA,RSS ON SZB ZERO H JMP NORM3 CLEAR STA EXP EVERYTHING STA MANT1 STORE NORM1 STB MANT2 MANTISSA JMP NORML,I AND RETURN NORM2 ISZ FERR COUNT LEFT SHIFTS NORM3 CLE,ELB ROTATE (A) AND ELA (B) LEFT INTO (E) SEZ,SSA,RSS TWO HIGHEST BITS 0? JMP NORM2 YES, + UNNORMALIZED SEZ,SSA NO, TWO HIGHEST BITS 1? JMP NORM2 YES, - UNNORMALIZED ERA SHIFT TO ERB,CLE NORMALIZE MANTISSA STA MANT1 NO, LDA FERR COMPUTE CMA,INA CORRECTED ADA EXP EXPONENT STA EXP VALUE LDA MANT1 JMP NORM1 ******************* * * * CHECK FOR DIGIT * * * ******************* ****************************** * * * GET CHAR FROM INPUT BUFFER * * * ****************************** GETCR NOP JSB SGET GET DEF *+4 DEF BUFR,I A DEF CHRCT CHAR DEF CHAR FROM BUFFER LDA CHAR LDB CHRCT IS ADB M1 CPB JLAST,I END OF STRING? JMP GETCR,I YES! CPA B40 SPACE? JMP GET1 YES! ISZ GETCR NO! ISZ CHRCT JMP GETCR,I EXIT * GET1 ISZ CHRCT GET NEXT CHAR JMP GETCR+1 SKP DIGCK NOP CHARACTER IN (A) LDB 0 ADB D72 ASCII 72B SSB,RSS OR GREATER? JMP DIGCK,I YES, RETURN WITH CHARACTER ADB .10 NO, ASCII 60B SSB OR GREATER? JMP DIGCK,I NO ISZ DIGCK YES, SET 'SUCCESS' EXIT, LDA 1 LOAD DIGIT INTO (A), JMP DIGCK,I AND RETURN MANT1 BSS 1 MANT2 BSS 1 EXPON BSS 1 TEMP3 BSS 1 TEMP4 BSS 1 CHRCT BSS 1 FERR BSS 1 CHAR BSS 1 DPFLG BSS 1 SIGN BSS 1 .3 DEC 3 .4 DEC 4 .10 DEC 10 .43 DEC 43 .45 w $"DEC 45 .46 DEC 46 M1 DEC -1 M2 DEC -2 M4 DEC -4 D72 OCT -72 B40 OCT 40 TENTH OCT 63146 E OCT 105 END $ASMB,R,L,C NAM WHOLE,7 92063-12001 REV.1826 770601 * * ************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * * PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ************************************************************** * * * LISTING: 92063-19001 * SOURCE: 92063-18001 * RELOC: 92063-12001 * * ************************************************************* * *FUNCTION WHOLE * *FUNCTION-TRUNCATES THE FRACTIONAL PORTION OF A *REAL INTEGER * *FORMAT-WHOLE(EXPRS) * * * * ************************************************************* * ENT WHOLE EXT .ENTR PARS BSS 1 WHOLE NOP JSB .ENTR PICK UP PARAMETERS DEF PARS LDA PARS,I ISZ PARS LDB PARS,I STA MANTH HIGH PORTION OF MANTISSA LDA 1 AND =B177400 STA MANTL LOW PORTION OF MANTISSA LDA 1 AND =B377 SLA JMP CLAB IF EXPONENT ZERO OR NEGATIVE SZA,RSS RETURN ZERO VALUE FOR EXPRE JMP CLAB ARS DIVIDE BY 2 TO REMOVE SIGN STA EXP EXP=EXPONENT ADA =D-23 IF THE EXPONENT IS 23 OR GR SZA,RSS ,TRUNCATION IS UNNECESSARY JMP NORM SSA,RSS JMP NORM LDA EXP DETERMINE IF THE BINARY POI ADA =D-15 IN THE HIGH OR LOW MANTISSA SZA JMP WHOL1 WHOL0 STA INDEX LDA EXP SHIFT EXPONENT LEFT ALS 1 MAKING SIGN 0 ADA INDEX *BINARY POINT AT RIGHT OF BIT 0 LDB 0 IN HIGH MANTISSA;NO SHIFTS LDA MANTH REQUIRED;ZERO LOW MANTISSA JMP WHOLE,I RESTORE EXPONENT WHOL1 SSA,RSS JMP WORD2 BINARY POINT IN LOW MANTISSA LDB MANTH PERFORM NECESSARY SHIFTING 0  JSB WHOL2 HIGH MANTISSA STB MANTH STORE TRUNCATED HIGH MANTISSA CLA ZERO LOW MANTISSA AND RETURN JMP WHOL0 WORD2 LDA EXP PERFORM NECESSARY SHIFTING ADA =D-31 LOW MANTISSA LDB MANTL JSB WHOL2 LDA 1 LOW MANTISSA IS TRUNCATED,H JMP WHOL0 MANTISSA REMAINS THE SAME CLAB CLA ZERO LOW AND HIGH MANTISSAS CLB RETURN JMP WHOLE,I NORM LDA MANTL NO TRUNCATION NECESSARY,SO JMP WHOL0 RETURN UNCHANGED *SUBROUTINE WHOL2 *THE PURPOSE OF WHOL2 IS TO TRUNCATE THE FRACTIONAL *PORTION OF A REAL NUMBER BY FIRST SHIFTING THE *NUMBER RIGHT UNTIL THE FRACTIONIS DISCARDED AND *THEN SHIFTING LEFT,THUS FILLING THE FRACTIONAL PART *OF THE NUMBER WITH ZEROS WHOL2 NOP STA INDEX SET INDEX TO NEGATIVE OF # BRS SHIFTS REQUIRED ISZ INDEX JMP *-2 STA INDEX BLS ISZ INDEX JMP *-2 JMP WHOL2,I MANTH NOP MANTL NOP EXP NOP INDEX NOP END r ASMB,R,L,C HED SUBROUTINE DBCRT NAM DBCRT,7 92063-12001 REV.1826 770601 * * ************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * * PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ************************************************************** * * * LISTING: 92063-19001 * SOURCE: 92063-18001 * RELOC: 92063-12001 * * ************************************************************* * * CALLING SEQUENCE : * * CALL DBCRT(AROOT,BUFF,IMODE,ISTAT) * * PARAMETER DESCRIPTION : * * AROOT - AN INTEGER WORD CONTAINING THE ADDRESS OF * THE RUN TABLE. * BUFF - AN ARRAY FOR USE AS A FILE DATA CONTROL BLOCK. * IMODE - INTEGER = 1 FOR PURGE DATA SETS AND 0 FOR NO PURGE * ISTAT - AN INTEGER USED TO RETURN STATUS * INFORMATION TO THE USER. * * FUNCTION : * * DBCRT CREATES ALL DATA SET FILES AND INITIALIZES * THEM WITH THE RECORD LINKAGES AND POINTERS. * EXT PURGE,.ENTR,SMOVE,CREAT,CLOSE,WRITF ENT DBCRT * * SUP PRESS * ACSUB BSS 1 1ST BYTE : ACTIVITY FLAG * 2ND BYTE : SUBCHANNEL # DBSTA BSS 1 DATA BASE STATUS DBSCD BSS 1 DATA BASE SECURITY CODE(FMP) DBICT BSS 1 DATA BASE ITEM COUNT DBSCT BSS 1 DATA BASE DATA SET COUNT DBITB BSS 1 ADDRESS OF ITEM TABLE DBSTB BSS 1 ADDRESS OF DATA SET TABLE * * PARS BSS 4 DBCRT NOP JSB .ENTR PICK UP PARAMETERS DEF PARS * LDA PARS,I SET UP ADA .2 STA ACSUB TABLE OF ADDRESSES INA STA DBSTA FOR INA STA DBSCD ACCESS TO INA STA DBICT RUN INA STA DBSCT TABLE INA STA DBITB INA STA DBSTB * 5 LDA DBSCT,I LOOP ON DSET COUNT TO CREATE CMA,INA DATA-SETS AND INITIALIZE INFO STA DINX WITHIN THESE DATA-SETS FOR MODE LDB DBSTB,I SET UP ADB PARS,I DATA SET ADB M1 ADDRESS JMP DBOP8 DBOP7 LDB DSET CALCULATE THE ADDRESS OF THE ADB .3 NEXT DATA-SET. LDA 1,I LDB 0 AND B377 RAL SWP ALF,ALF AND B377 ADB 0 DSET=2*PATHCT+FIELDCT+16+DSET ADB .16 ADB DSET DBOP8 STB DSET ADB .12 YES,CREATE THIS DATA-SET AND STB FNAME INITIALIZE ALL ITS RECORDS JSB SMOVE MAKE THIS DEF *+6 DEF FNAME,I FIVE CHARACTER DEF .1 DEF .5 NAME DEF NAME DEF .1 INTO A 6 CHARACTER NAME LDB DSET FNAME IS ADDRESS OF DSET NAME ADB .15 LDA 1,I STA FLGTH FLGTH IS MAXIMUM NUMBER OF LDB DSET ENTRIES ADB .1 RLGTH IS RECORD LENGTH(IN WORDS) LDA 1,I ISZ 1 ADA 1,I STA RLGTH MPY FLGTH RECORD HEADER DIV .128 AND CALC. NUMBER OF 128 WORD BLOCKS INA STA ISIZE LDB DSET PICK UP CART NUMBER ADB .14 FROM DATA SET CONTROL LDA 1,I BLOCK AND STORE IN AND B377 PAKNO STA PAKNO LDA PARS+2,I PURGE SZA DATA SETS? JMP DBOP5 YES! DBOP4 JSB CREAT CREATE DEF *+8 DEF PARS+1,I FILE DEF IERR DEF NAME DEF ISIZE FOR DEF .2 DEF DBSCD,I THIS DEF PAKNO SSA ERROR? JMP ERRX YES! LDB DSET SET FREECT = TO RECORD COUNT ADB .6 FOR THIS DATA SET LDA FLGTH STA 1,I CMA,INA SET UP INA RECORD STA TEMP2 COUNTER FOR WRITE LDA ABUFF INITIALIZE BUFF TO ALL ZEROES STA TEMP1 CLA LDB RLGTH CMB,INB STA TEMP1,I ISZ TEMP1 ISZ 1 JMP *-3 LDA DSET,I CHECK WHETHER THIS DATA-SET IS A CMA,INA DETAIL OR A MASTER ADA D SZA JMP DBO10 DATA-SET IS A MASTER,SO BRANCH LDB DSET DATA-SET IS A DETAIL SO SET ADB .7 FREEHD EQUAL TO 1ST RECORD IN LDA .1 DATA-SET STA 1,I LDA ABUFF SET UP WORD 2 OF RECORD TO INA CONTAIN EMPTY RECORD CHAIN STA TEMP1 LDB .2 STB 0,I SET TEMP1 TO ADDRESS OF 2ND WORD STB TEMP3 INITIALIZE TEMP3 TO HOLD NEXT JMP DBOP6 FREE RECORD POINTER. * * PURGE DATA SETS * DBOP5 JSB PURGE DEF *+6 DEF PARS+1,I DEF IERR DEF NAME DEF DBSCD,I DEF PAKNO CPA M6 NOT FOUND ERROR? JMP DBOP4 YES! SSA,RSS ERROR? JMP DBOP4 NO! JMP ERRX YES * DBO10 CLA MASTER STA TEMP3 RECORDS ARE COMPLETELY EMPTY DBOP9 ISZ TEMP3 LDA TEMP3 STORE NEXT FREE RECORD POINTER STA TEMP1,I IN 2ND WORD OF BUFF DBOP6 JSB WRITE WRITE OUT RECORD ISZ TEMP2 JMP DBOP9 * CLA LAST RECORD STA TEMP1,I IS ALL ZEROES JSB WRITE WRITE RECORD * JSB CLOSE CLOSE DEF *+2 DEF PARS+1,I DATA SET ISZ DINX END OF DATA SETS? JMP DBOP7 NO! CLA ERRX STA PARS+3,I SET STAT FLAG JMP DBCRT,I * * * * * WRITE OUT RECORD * * WRITE NOP JSB WRITF DEF *+6 DEF PARS+1,I DEF IERR DEF BUFF DEF .0 DEF .0 SSA ERROR? JMP ERRX YES! JMP WRITE,I * * PAKNO BSS 1 .0 DEC 0 .1 DEC 1 .2 DEC 2 .3 DEC 3 .5 DEC 5 .6 DEC 6 .7 DEC 7 .12 DEC 12 .14 DEC 14 .15 DEC 15 .16 aF DEC 16 .128 DEC 128 M1 DEC -1 M6 DEC -6 B377 OCT 377 SC NOP SECURITY CODE DINX BSS 1 DSET BSS 1 FNAME BSS 1 NAME ASC 3, DATA SET FILE NAME BUFFER D OCT 104 FLGTH BSS 1 ISIZE BSS 1 THESE TWO RLGTH BSS 1 MUST STAY TOGETHER IERR BSS 1 BUFF BSS 256 DATA SET BUFFER(MAX SIZE =256 WORDS) ABUFF DEF BUFF TEMP1 BSS 1 TEMP2 BSS 1 TEMP3 BSS 1 END ASMB,R,L,C HED <> NAM DBBUF,7 92063-12001 REV.1826 770601 * * ************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * * PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ************************************************************** * * * LISTING: 92063-19001 * SOURCE: 92063-18001 * RELOC: 92063-12001 * * ************************************************************* * * * * ENT D%DCB,ISIZE,AIRUN,DCBAN,AIDCB * * * AIRUN NOP ADDRESS OF DATA BASE RUN TABLE AIDCB NOP ADDRESS OF DCB'S DCBAN DEF *+1 BSS 18 DATA SET OPENED NAME TABLE ISIZE NOP D%DCB BSS 16 ROOT FILE DCB INFO STORED HERE END a8ASMB,R,L,C NAM .DBRN,14 92063-12001 REV.1826 770601 * * * DATA BASE ACTIVE TABLE: * * THE DATA BASE ACTIVE TABLE IS USED TO INDICATE THE NAME * OF THE DATA BASE CURRENTLY OPEN, THE CLASS NUUMBER OF THE * VOLATILE DATA (FROM THE ROOT FILE) STORED IN SYSTEM AVAILABLE * MEMORY, THE RESOURCE NUMBER USED BY'DBLCK' AND 'DBUNLK' TO * LOCK AND UNLOCK DATA BASES AND A COUNT TO INDICATE THE NUMBER * OF USERS CURRENTLY USING THE DATA BASE. * * THERE ARE 6 WORDS FOR EACH ENTRY. THRE IS A MAXIMUM OF 4 ENTRIES * IN THIS TABLE. THE MEANING OF EACH ENTRY IS AS FOLLOWS: * * ***************************** * ! ! ! DATA BASE * ***************************** * ! ! ! ROOT FILE * ***************************** * ! ! ! NAME * ***************************** * ! CLASS NUMBER ! * ***************************** * ! RESOURCE NUMBER ! * ***************************** * ! DATA BASE OPEN COUNT ! * ***************************** * * NOTE: THE DATA BASE ROOT FILE NAME IS NOT ACTIVE * IF THE FIRST TWO CHARRACTERS OF THE NAME IS * MINUS ONE. * * * ENT .DBRN * * .DBRN DEC 4 * DBAS1 OCT 177777 NOP NOP NOP NOP NOP DBAS2 OCT 177777 NOP NOP NOP NOP NOP DBAS3 OCT 177777 NOP NOP NOP NOP NOP DBAS4 OCT 177777 NOP NOP NOP NOP NOP * END   92063-18002 1840 S C2022 DBDS              H0120 e]FTN,L,C PROGRAM DBDS(3,90) C C C************************************************************* C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * C RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * C PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * C OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C************************************************************* C C C LISTING: 92063-19002 C SOURCE: 92063-18002 C RELOC: 92063-16002 C C C************************************************************ C C*********************************************************************** C DATA BASE DEFINITION SYSTEM FOR IMAGE/1000 C BUILDS THE ROOT FILE AND DATA SETS FOR IMAGE/1000 C CALLING SEQUENCE C :RU,DBDS,INPUT,LIST C C OR C C :RU,DBDS,FI,LE,NM,LIST,SC C C WHERE THE DEFAULTS ARE: C C LIST = 6 C INPUT = 5 C SECURITY CODE = 0 C C FILENM IS THE NAME OF THE FILE CONTAINING THE SCHEMA C C C*********************************************************************** C C MAIN PROGRAM C INTEGER CARTN,CRDPR,CARD,SYSTY,LIST,INPT,TRAIL,PRE,CHAR,FNAM, 1CODE,ERROR,TYPE,RESNO,RFILE,FWAM,LWAM,SMAX,STYPE,FLDCN,ENLTH, 2CAPTA,BUFF,PTHCT,CURPA,PTHPT,RECDF,CRIT,PTHTA DIMENSION ITRANS(5) DIMENSION INAM1(3) COMMON SYSTY,LIST,INPT,LINCT,CARTN,CRDPR,CARD(40),TRAIL,PRE,CHAR, 1BUFF(144),INFO(5),FNAM(3),CODE,ERROR,LGLOB,IGLOB(10),TYPE, 2RESNO,NORES,LFLAG,RFILE(3),LROOT,FWAM,LWAM,IMAX,MAXLN,SMAX, 3ISPEC(128),IPACK(50), 4NATAB(150),STYPE(50),FLDCN(50),ENLTH(50),MEDIA(50),CAPTA(50), 5PTHCT(50),CURPA(50),PTHPT(50),KEYTA(50),RECDF(255),CRIT(50), 6PTHTA(500),NPACK,CPACK(50),NSETS(50),KPACK(50) DATA IRCD1,INAM1/8,2HIN,2HIT,2H / CALL RMPAR(ITRANS) INPT=ITRANS(1) LIST=ITRANS(2) SYSTY=ITRANS(3) PRE=ITRANS(4) CARTN=ITRANS(5) CALL EXEC(IRCD1,INAM1) %   END END$ z FTN,L,C PROGRAM INIT(5,90) C C C************************************************************* C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * C RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * C PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * C OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C************************************************************* C C C LISTING: 92063-19002 C SOURCE: 92063-18002 C RELOC: 92063-16002 C C C************************************************************ C C*********************************************************************** C INIT READS IN SCHEMA FILE AND INITIALIZES PARAMETERS C*********************************************************************** C C INIT SEGMENT C INTEGER BUFF,CARTN,CRDPR,CARD,SYSTY,LIST,INPT,TRAIL,PRE,CHAR,FNAM, 1MES1,MES2,ROOTA,CODE,ERROR,TYPE,RESNO,RFILE,FWAM,LWAM, 1SMAX,ROTMAX DIMENSION INAM2(3) DIMENSION MES1(12),MES2(32) EXTERNAL ROOTA DIMENSION ILIST(28) COMMON SYSTY,LIST,INPT,LINCT,CARTN,CRDPR,CARD(40),TRAIL,PRE,CHAR, 1BUFF(144),INFO(5),FNAM(3),CODE,ERROR,LGLOB,IGLOB(10),TYPE, 2RESNO,NORES,LFLAG,RFILE(3),LROOT,FWAM,LWAM,IMAX,MAXLN,SMAX DATA IRCD2,INAM2/8,2HCN,2HTR,2H / DATA I3,N1/3,-1/ DATA MES1/2H S,2HCH,2HEM,2HA ,2HFI,2HLE,2H N,2HOT,2H O,2HPE,2HNE, 12HD / DATA MES2/2H ,2H ,2H ,2HHE,2HWL,2HET,2HT-,2HPA,2HCK,2HAR, 12HD ,2HIM,2HAG,2HE/,2H10,2H00,2H D,2HAT,2HA ,2HBA,2HSE,2H D, 22HEF,2HIN,2HIT,2HIO,2HN ,2HPR,2HOC,2HES,2HSO,2HR / DATA MES3/2H / DATA ILIST/9,2HIN,2HIT,2H ,2HCN,2HTR,2H ,2HHE,2HAD,2H , 12HLE,2HVE,2HL ,2HIT,2HEM,2HS ,2HSE,2HTS,2H ,2HRA,2HPU,2HP , 22HSU,2HMR,2HY ,2HRO,2HOT,2H / ISC=CARTN IF (INPT.GT.1000) GOTO 100 IF (INPT.EQ.0) GOTO 140 INPT=INPT+400B 200 IF (LIST.EQ.0) GOTO 150 GOTO 3 C SCHEMA ON DISC FILE C GET FILE NAME ANy  D OPEN FILE 300 CALL OPEN(BUFF,IERR,FNAM,0,ISC) IF (IERR.GE.0) GOTO 3 CALL FMERR(IERR,LIST) CALL EXEC(2,LIST,MES1,-24) STOP C 100 FNAM(1)=INPT IF (LIST.EQ.0) GOTO 110 FNAM(2)=LIST 102 IF (SYSTY.EQ.0) GOTO 120 FNAM(3)=SYSTY 104 IF (PRE.EQ.0) GOTO 130 LIST = PRE GOTO 300 C 110 FNAM(2)=20040B GOTO 102 120 FNAM(3)=20040B GOTO 104 130 LIST=6 GOTO 300 140 INPT=401B GOTO 200 150 LIST=6 GOTO 3 C C C SKIP TO TOP OF PAGE 3 ISWD=1100B+LIST CALL EXEC(I3,ISWD,N1) CALL EXEC(2,LIST,MES2,-64) CALL EXEC(2,LIST,MES3,-2) NORES=27 LFLAG=0 ERROR=0 CRDPR=72 CALL DBSPC(ILIST,FWAM,LWAM) IF (FWAM.NE.0) GOTO 490 CALL EMESS(151) STOP 490 DO 500 J=1,5 500 INFO(J)=0 INFO(5)=100 IMAX=255 MAXLN=63 SMAX=50 TRAIL=0 ROTMAX=LWAM-FWAM C INITIALIZE ROOT TABLE TO ALL ZEROES DO 4 J=1,ROTMAX C STORE INTO ROOT TABLE 4 CALL SROOT(J,0) C GET 1ST CHAR AND 1ST GLOB - WILL ALWAYS POINT TO NEXT CHAR AND GLOB CALL GCHAR CALL GGLOB CALL EXEC(IRCD2,INAM2) END END$ _ FTN,L,C PROGRAM CNTR(5,90) C C C************************************************************* C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * C RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * C PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * C OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C************************************************************* C C C LISTING: 92063-19002 C SOURCE: 92063-18002 C RELOC: 92063-16002 C C C************************************************************ C C*********************************************************************** C CNTRL PROCESSES THE CONTROL CARD. IT PUTS THE RESULTS IN INFO TABLE C AS FOLLOWS: C LIST - INFO(1)=0 NOLIST - INFO(1)=1 LIST DEFAULT C ROOT - INFO(2)=0 NOROOT - INFO(2)=1 ROOT DEFAULT C NOTABLE - INFO(3)=0 TABLE - INFO(3)=1 NOTABL DEFAULT C NOSETS - INFO(4)=0 SETS - INFO(4)=1 SETS DEFAULT C ERRORS - INFO(5)=MAX # OF ERRORS ,100 DEFAULT C*********************************************************************** C C CNTRL SEGMENT C INTEGER CARTN,CRDPR,CARD,SYSTY,INPT,TRAIL,PRE,CHAR,BUFF,FNAM, 1ROOTA,CODE,ERROR,TYPE,RESNO,RFILE,FWAM,SMAX,ROTMAX,SYSTY DIMENSION NFONX(9),NFO(9) EXTERNAL ROOTA DIMENSION INAM3(3),INAM4(3) COMMON SYSTY,LIST,INPT,LINCT,CARTN,CRDPR,CARD(40),TRAIL,PRE,CHAR, 1BUFF(144),INFO(5),FNAM(3),CODE,ERROR,LGLOB,IGLOB(10),TYPE, 1RESNO,NORES,LFLAG,RFILE(3),LROOT,FWAM,LWAM,IMAX,MAXLN,SMAX C NFO CONTAINS VALUES FOR CONTROL CARD OPTIONS. IT IS INDEXED INTO THE C SAME AS RESTA DATA NFO/0, 1, 100, 0, 1, 1, 0, 0, 1/ DATA IRCD3,INAM3/8,2HHE,2HAD,2H / DATA INAM4/2HLE,2HVE,2HL / C LIST,NOLIST,ERRORS,ROOT,NOROOT,TABLE,NOTABL,SETS,NOSETS C NFONX HAS THE INDEXES INTO INFO INFO FOR CONTROL CARD OPTIONS. IT IS C INDEXED INTO THE SAME AS RESTA. A   DATA NFONX/ 1, 1, 5, 2, 2, 3, 3, 4, 4/ C CHAR=$? IF (IGLOB(1).NE.44B) GO TO 400 CALL GGLOB C CONTROL? IF (RESNO.EQ.10) GO TO 44 C IF NOT "ILLEGAL CONTROL CARD" 45 N=1 CALL EMESS(N) C SCAN TO NEXT KEY WORD OR SEMICOLON C 'LEVELS '? 451 IF (RESNO.EQ.16) CALL EXEC(IRCD3,INAM4) C 'END'? IF(RESNO.NE.15) GO TO 452 C " 'END' FOUND WHERE NOT EXPECTED" N=148 CALL EMESS(N) 452 IF (TYPE.EQ.10) GO TO 47 CALL GGLOB GO TO 451 47 CALL GGLOB 400 CALL EXEC(IRCD3,INAM3) C WE HAVE A CONTROL CARD 44 CALL GGLOB C ;? 46 IF (TYPE.EQ.10) GO TO 47 48 IF ((RESNO.LT.1).OR.(RESNO.GT.9)) GO TO 45 C PUT CORRECT VALUE IN INFO NDX=NFONX(RESNO) INFO(NDX)=NFO(RESNO) 49 CALL GGLOB C ,? IF (TYPE.NE.9) GO TO 50 CALL GGLOB GO TO 48 C =? 50 IF (TYPE.NE.5) GO TO 46 CALL GGLOB C INTEGER? IF (TYPE.NE.1) GO TO 45 C CONVERT AND ENTER MAX ERRORS CALL ATOD(ERRNO) INFO(5)=ERRNO IF (INFO(5).GT.999) GOTO 45 GO TO 49 END END$ f5 FTN,L,C PROGRAM HEAD(5,90) C C C************************************************************* C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * C RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * C PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * C OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C************************************************************* C C C LISTING: 92063-19002 C SOURCE: 92063-18002 C RELOC: 92063-16002 C C C************************************************************ C C*********************************************************************** C HEAD PROCESSES THE BEGIN DATA BASE STATEMENT C SPECIFIES THE CARTRIDGE NUMBER WHERE THE ROOT FILE IS STORED C ENTERS THE SECURITY CODE IN ROOT TABLE C SAVES ROOT FILE NAME IN RFILE C*********************************************************************** C C HEAD SEGMENT C INTEGER CARTN,CRDPR,CARD,SYSTY,INPT,TRAIL,PRE,CHAR,BUFF,FNAM, 1ROOTA,CODE,ERROR,TYPE,RESNO,RFILE,FWAM,LWAM,SMAX DIMENSION INAM4(3) EXTERNAL ROOTA COMMON SYSTY,LIST,INPT,LINCT,CARTN,CRDPR,CARD(40),TRAIL,PRE,CHAR, 1BUFF(144),INFO(5),FNAM(3),CODE,ERROR,LGLOB,IGLOB(10),TYPE, 1RESNO,NORES,LFLAG,RFILE(3),LROOT,FWAM,LWAM,IMAX,MAXLN,SMAX DATA IRCD4,INAM4/8,2HLE,2HVE,2HL / C ENTER "LB"IN ROOTA - DBSTATUS CALL SROOT(4,46102B) C "BEGIN"? IF (RESNO.EQ.12) GO TO 63 C "BEGIN DATA BASE" EXPECTED 64 N=5 652 CALL EMESS(N) C SCAN TO NEXT KEY WORD OR SEMICOLON C 'LEVELS:'? 657 IF (RESNO.EQ.16) GO TO 655 C 'END'? IF (RESND.NE.15) GO TO 658 C " 'END' FOUND WHERE NOT EXPECTED' 521 N=148 CALL EMESS(N) 658 IF (TYPE.EQ.10) GO TO 61 CALL GGLOB GO TO 657 63 CALL GGLOB C "DATA"? IF (RESNO.NE.13) GO TO 64 CALL GGLOB C"BASE"? IF (RESNO.NE.14) GO TO 64 C GET LFLAG=2 CALL GGLOB LFLAG=0 IF (TYPE   .EQ.4) GO TO 651 C "BAD DATA BASE NAME OR TERMINATOR" 659 N=6 GO TO 652 C SAVE IN RFILE. IT IS ROOT FILE NAME. 651 DO 66 J=1,6 CALL SPUT(RFILE,J,IGLOB(J)) 66 CONTINUE CALL GGLOB C ";"? IF (TYPE.NE.10) GO TO 659 61 CALL GGLOB C "CRNNN"? IF((TYPE.NE.2).OR.(LGLOB.NE.5)) GOTO 80 IF((IGLOB(1).NE.103B).OR.(IGLOB(2).NE.122B)) GOTO 70 CARTN=0 DO 67 J=3,5 IF((IGLOB(J).LT.60B).OR.(IGLOB(J).GT.71B)) GOTO 70 67 CARTN=10*CARTN+(IGLOB(J)-60B) IF((CARTN.GE.256).OR.(CARTN.LE.0))GOTO 70 CALL GGLOB C "; "? IF (TYPE.NE.10) GOTO 70 CALL GGLOB C GET SECURITY CODE IF (TYPE.EQ.1) GO TO 59 C "ILLEGAL SECURITY CODE" 62 N=4 60 CALL EMESS(N) C SCAN TO NEXT KEY WORD OR SEMICOLON C 'LEVELS:'? 611 IF (RESNO.EQ.16) GO TO 655 C 'END'? IF (RESNO.EQ.15) GO TO 521 IF (TYPE.EQ.10) GO TO 65 CALL GGLOB GO TO 611 C ENTER SECURITY CODE IN ROOT TABLE - ISCOD 59 CALL ATOD(SCOD) C SECURITY CODE>2(15)-1? IF (SCOD.GT.32767.) GO TO 62 IF (SCOD.LE.0.) GO TO 62 N=-SCOD CALL SROOT(5,N) CALL GGLOB C ";"? IF (TYPE.EQ.10) GO TO 65 C "BAD TERMINATOR - ';' EXPECTED" N=21 C BAD CARTRIDGE NO. 70 N=3 GOTO 60 80 N=2 GOTO 60 65 CALL GGLOB 655 CALL EXEC(IRCD4,INAM4) END END$ /i FTN,L,C PROGRAM LEVEL(5,90) C C C************************************************************* C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * C RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * C PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * C OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C************************************************************* C C C LISTING: 92063-19002 C SOURCE: 92063-18002 C RELOC: 92063-16002 C C C************************************************************ C C*********************************************************************** C PROCESSES LEVELS PART OF SCHEMA AND ENTERS THE LEVELS IN THE C ROOT TABLE C*********************************************************************** C C LEVEL SEGMENT C INTEGER CARTN,CRDPR,CARD,SYSTY,INPT,TRAIL,PRE,CHAR,BUFF,FNAM, 1ROOTA,CODE,ERROR,TYPE,RESNO,RFILE,FWAM,LWAM,SMAX DIMENSION INAM5(3),LEVNM(3),LEV(3) EXTERNAL ROOTA COMMON SYSTY,LIST,INPT,LINCT,CARTN,CRDPR,CARD(40),TRAIL,PRE,CHAR, 1BUFF(144),INFO(5),FNAM(3),CODE,ERROR,LGLOB,IGLOB(10),TYPE, 1RESNO,NORES,LFLAG,RFILE(3),LROOT,FWAM,LWAM,IMAX,MAXLN,SMAX DATA IRCD5,INAM5/8,2HIT,2HEM,2HS / IBLNK=40B LEVCT=0 C FILL LEVEL WORDS IN ROOT TABLE WITH BLANKS DO 50 J=21,110 50 CALL RSPUT(J,IBLNK) C "LEVELS:"? IF (RESNO.EQ.16) GO TO 75 C "SCHEMA PROCESSING TERMINATED" I107=107 CALL EMESS(I107) STOP 75 CALL GGLOB 76 CALL GGLOB C "ITEMS:"? IF (RESNO.NE.17) GO TO 77 C IF SO, ENTER WORD PTR TO ITEM TABLE AND RETURN TO PROCESS ITEM PART IF (LEVCT.EQ.0) GO TO 772 IF (LEVCT.EQ.15) GO TO 772 C LEVEL 15 WORD NOT PRESENT 764 IER=46 GO TO 80 772 CALL SROOT(8,56) CALL EXEC(IRCD5,INAM5) C PROCESS LEVEL NUMBER 77 IF (TYPE.EQ.1) GO TO 79 78 IER=11 C "BAD LEVEL NUMBER OR TERMINATOR" 80 CALL EMESS(IER) C SCAN TO   NEXT KEY WORD OR SEMICOLON C 'ITEMS:'? 765 IF (RESNO.EQ.17) GO TO 772 C 'END'? IF (RESNO.NE.15) GO TO 766 C " 'END' FOUND WHERE NOT EXPECTED' NIER=148 CALL EMESS(NIER) 766 IF (TYPE.EQ.10) GO TO 76 CALL GGLOB GO TO 765 79 CALL ATOD(RLEV) ICNT=RLEV C LEVEL NUMBER BETWEEN 1 AND 15? IF((ICNT.LT.LEVCT).OR.(ICNT.GT.15)) GO TO 78 LEVCT=ICNT C PROCESS LEVEL WORD LFLAG=1 CALL GGLOB LFLAG=0 IF (TYPE.EQ.3) GO TO 762 IF (TYPE.EQ.10) GO TO 763 IF (LGLOB.LE.6) GO TO 78 C "LEVEL WORD TOO LONG" IER=10 GO TO 80 C ENTER LEVEL WORD IN ROOT TABLE 762 LNDX=LEVCT*6+15 C C CHECK FOR DUPLICATE LEVELS C DO 83 J=11,45,3 DO 84 K=1,3 84 LEVNM(K)=ROOTA(10+K) DO 86 K=1,6 86 CALL SPUT(LEV,K,IGLOB(K)) IF (JSCOM(LEV,1,6,LEVNM,1).EQ.0) GOTO 85 83 CONTINUE DO 82 J=1,6 CALL RSGET(LNDX,LEV) IF (LEV.NE.40B) GOTO 85 CALL RSPUT(LNDX,IGLOB(J)) 82 LNDX=LNDX+1 81 CALL GGLOB C ";"? 761 IF (TYPE.EQ.10) GO TO 76 IER=9 GO TO 80 85 IER=53 GOTO 80 763 IF (LEVCT.NE.15) GO TO 76 GO TO 764 END END$ TB FTN,L,C PROGRAM ITEMS(5,90) C C C************************************************************* C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * C RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * C PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * C OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C************************************************************* C C C LISTING: 92063-19002 C SOURCE: 92063-18002 C RELOC: 92063-16002 C C C************************************************************ C C*********************************************************************** C PROCESSES ITEM PART OF THE SCHEMA C ENTERS ITEM NAMES IN ROOT TABLE C ENTERS READ AND WRITE LEVELS AND ITEM TYPE IN ROOT TABLE C ENTERS ITEM WORD LENGTH IN ISPEC C*********************************************************************** C C ITEMS SEGMENT C INTEGER CARTN,CRDPR,CARD,SYSTY,INPT,TRAIL,PRE,CHAR,BUFF,FNAM, 1ROOTA,CODE,ERROR,TYPE,RESNO,RFILE,FWAM,LWAM,SMAX,DFLT,RLEV,WLEV DIMENSION INAM6(3) COMMON SYSTY,LIST,INPT,LINCT,CARTN,CRDPR,CARD(40),TRAIL,PRE,CHAR, 1BUFF(144),INFO(5),FNAM(3),CODE,ERROR,LGLOB,IGLOB(10),TYPE, 1RESNO,NORES,LFLAG,RFILE(3),LROOT,FWAM,LWAM,IMAX,MAXLN,SMAX, 1ISPEC(128) DATA IRCD6,INAM6/8,2HSE,2HTS,2H / ICONT=0 CALL SROOT(6,1) CALL GGLOB 83 CALL GGLOB C "SET:"? IF (RESNO.NE.18) GO TO 84 C IF SO, ENTER ITEM COUNT AND SET TABLE PTR IN ROOT TABLE AND RETURN 872 CALL SROOT(6,ICONT) CALL SROOT(9,56+5*ICONT) C SET FLAG TO INDICATE ITMES COMPLETED SO TO TO STOP ITEM # PRINT OUT TRAIL=1 CALL EXEC(IRCD6,INAM6) 84 IF (TYPE.EQ.2) GO TO 85 C "ILLEGAL ITEM NAME OR TERMINATOR NIER=12 86 CALL EMESS(NIER) C SCAN TO NEXT KEY WORD OR SEMICOLON C 'SETS:'? 861 IF (RESNO.EQ.18) GO TO 872 C 'END'? IF (RESNO.NE.15) GO TO 862 C ' "END" FOUND WHERE NOT EXPECTED' NIER=148 CALL EMESS(NIER) 862 IF (TYPE.EQ.10) GO TO 83 CALL GGLOB GO TO 861 C SEARCH FOR DUPLICATE ITEM NAME 85 CALL ISRCH(ICONT,INUM) IF (INUM.EQ.0) GO TO 87 C IF FOUND, "DUPLICATE ITEM NAME" NIER=13 GO TO 86 C INCREMENT ITEM COUNT 87 ICONT=ICONT+1 CALL SROOT(6,ICONT+1) C MAX # OF ITEMS EXCEEDED? IF (ICONT.LE.IMAX) GO TO 88 NIER=15 CALL EMESS(NIER) GOTO 88 C SCAN TO "SETS:" 871 CALL GGLOB IF (RESNO.NE.18) GO TO 871 ICONT=100 GO TO 872 C ENTER ITEM NAME IN ROOT TABLE - WE HAVE A LEGAL ITEM NAME 88 IPTR=101+10*ICONT DO 89 J=1,6 CALL RSPUT(IPTR,IGLOB(J)) 89 IPTR=IPTR+1 CALL GGLOB C ","? IF (TYPE.EQ.9) GO TO 90 C IF NOT, "ILLEGAL ITEM NAME OR TERMINATOR" 102 NIER=12 GO TO 86 C PROCESS SPEC PART 90 CALL GGLOB IF (TYPE.EQ.2) GO TO 91 C ILLEGAL SPECS 94 NIER=45 GO TO 86 C ENTER ITEM TYPE IN ROOT TABLE 91 CALL RSPUT((IPTR+2),IGLOB(1)) C R2? IF ( (IGLOB(1).EQ.122B).AND.(IGLOB(2).EQ.62B).AND.(LGLOB.EQ.2) ) 1GO TO 92 C I1? IF ( (IGLOB(1).EQ.111B).AND.(IGLOB(2).EQ.61B).AND.(LGLOB.EQ.2) ) 1GO TO 93 C U? IF (IGLOB(1).NE.125B) GO TO 94 IF (LGLOB.LE.1) GO TO 94 LGLOB=LGLOB-1 DO 95 J=1,LGLOB IGLOB(J)=IGLOB(J+1) IF ( (IGLOB(J).LT.60B).OR.(IGLOB(J).GT.71B) ) GO TO 94 95 CONTINUE CALL ATOD(RLEN) LENTH=RLEN IF (LENTH.LT.1) GOTO 94 IF (LENTH.LE.(2*MAXLN)) GO TO 96 C ITEM TOO LONG NIER=17 GO TO 86 96 IF (LENTH.EQ.(2*(LENTH/2))) GO TO 97 C ITEM NOT INTEGRAL WORD LENGTH NIER=18 GO TO 86 C CALCULATE WORD LENGTH FOR BYTE TYPE 97 LENTH=LENTH/2 GO TO 98 92 LENTH=2 GO TO 98 93 LENTH=1 C SAVE ITEM LENGTH IN ISPEC TABLE 98 CALL SPUT(ISPEC,ICONT,LENTH) CALL GGLOB RLEV=0 WLEV=15 C READ-WRITE LEVELS PRESENT? -"(?? IFh (TYPE.NE.11) GO TO 99 CALL GGLOB IF (TYPE.EQ.1) GO TO 100 C IF NON-INTEGER, "BAD READ LEVEL OR TERMINATOR" 101 NIER=19 GO TO 86 100 CALL ATOD(RRLEV) RLEV=RRLEV IF (RLEV.GT.15) GO TO 101 C WE HAVE A LEGAL READ LEVEL,NOW PROCESS ";" CALL GGLOB IF (TYPE.NE.9) GO TO 101 CALL GGLOB IF (TYPE.EQ.1) GO TO 104 C "BAD WRITE LEVEL OR TERMINATOR" 103 NIER=20 GO TO 86 104 CALL ATOD(RRLEV) WLEV=RRLEV IF (RLEV.GT.WLEV) GO TO 103 IF (WLEV.GT.15) GO TO 103 C WE HAVE A VALID WRITE LEVEL CALL GGLOB C ")"? IF (TYPE.NE.12) GO TO 103 CALL GGLOB C ENTER READ AND WRITE LEVELS IN ROOT TABLE 99 CALL RSPUT(IPTR,RLEV) CALL RSPUT((IPTR+1),WLEV) C ";"? IF (TYPE.EQ.10) GO TO 83 C "BAD TERMINATOR - ';' EXPECTED NIER=21 GO TO 86 END END$ jFTN4,L,C PROGRAM SETS(5,90),92063-16002 REV. 1840 780801 C C C************************************************************* C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * C RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * C PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * C OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C************************************************************* C C C LISTING: 92063-19002 C SOURCE: 92063-18002 C RELOC: 92063-16002 C C C************************************************************ C C*********************************************************************** C PROCESSES SET PART C BUILDS ARRAYS FOR: C SETTYPE,MEDIA LENGTH,ENTRY LENGTH,FIELD COUNT, C PATH COUNT, SEARCH FIELD, INDEX TO PATH TABLE, C SET NAME, CAPACITY, CART NO. C RECORD DEFINITION TABLE C PATH TABLE C*********************************************************************** C C SETS SEGMENT C INTEGER CARTN,CRDPR,CARD,SYSTY,INPT,TRAIL,PRE,CHAR,BUFF,FNAM, 1CODE,ERROR,TYPE,RESNO,RFILE,FWAM,LWAM,SMAX,STYPE,FLDCN,ENLTH, 1CAPTA,PTHCT,CURPA,PTHPT,RECDF,CRIT,PTHTA,SETCT,RPTR,PPTR,SPTR, 1ERR1,ERR2,ROOTA,PBPTR,TFLAG,PFLAG,FLDCT,ENLEN,SETNO INTEGER DSET EXTERNAL ROOTA INTEGER SETRF DIMENSION IND(7),INAM7(3),INAM8(3) DIMENSION ERR1(24),ERR2(23) DIMENSION SETRF(5) COMMON SYSTY,LIST,INPT,LINCT,CARTN,CRDPR,CARD(40),TRAIL,PRE,CHAR, 1BUFF(144),INFO(5),FNAM(3),CODE,ERROR,LGLOB,IGLOB(10),TYPE, 1RESNO,NORES,LFLAG,RFILE(3),LROOT,FWAM,LWAM,IMAX,MAXLN,SMAX, 1ISPEC(128),IPACK(50), 1NATAB(150),STYPE(50),FLDCN(50),ENLTH(50),MEDIA(50),CAPTA(50), 1PTHCT(50),CURPA(50),PTHPT(50),KEYTA(50),RECDF(255),CRIT(50), 1PTHTA(500) DATA IRCD7,INAM7/8,2HRA,2HPU,2HP / DATA INAM8/2HSU,2HMR,2HY / DATA IZERO/0/ DATA ERR1/2H *,2H*E,2HRR,2HOR,2H: ,2HMA,2HST,2HER,2H D, 12HAT,2HA ,2HSE,2HT ,2HLA,2HCK,2HS ,2HEX,2HPE,2HCT,2HED, 22H D,2HET,2HAI,2HLS/ DATA ERR2/2H *,2H*E,2HRR,2HOR,2H: ,2HIT,2HEM,2H(S,2H) , 12HNO,2HT ,2HDE,2HCL,2HAR,2HED,2H I,2HN ,2HA ,2HDA,2HTA, 22HSE,2HET,2H: / DATA IND/2H ,2H ,2H ,2H ,2H ,2H ,2H / C INITIALIZE SET COUNTER, RECORD DEF TAB PTR, PATH TAB PTR SETCT=0 RPTR=1 PPTR=1 CALL GGLOB 105 CALL GGLOB IF (RESNO.NE.15) GO TO 106 1051 IF (CODE.EQ.6) GO TO 107 NERR=122 108 CALL EMESS(NERR) STOP C "END." FOUND - SET PART COMPLETED 107 IF (SETCT.GT.0) GO TO 109 C "DATA BASE HAS NO DATA SETS" NERR=143 GO TO 108 C ENTER SET COUNT IN ROOT TABLE C CLOSE THE SCHEMA INPUT FILE 109 CALL CLOSE(BUFF) CALL SROOT(7,SETCT) 410 IF (ERROR.NE.0) CALL EXEC(IRCD7,INAM8) C CHECK WHETHER ALL MASTER PATHS ARE FULL DO 110 J=1,SETCT IF (STYPE(J).EQ.104B) GO TO 110 IF (CURPA(J).EQ.PTHCT(J)) GO TO 110 C FOUND ONE WHOSE PATHS ARE NOT FULL - "MASTER DATA SET LACKS DETAILS" ERROR=ERROR+1 CALL EXEC(2,LIST,ERR1,24) C CHECK WHETHER EVERY ITEM IS IN A SET GO TO 410 110 CONTINUE TFLAG=0 DO 1101 J=1,ROOTA(6) INDX=110+10*J CALL RSGET(INDX,ISET) IF (ISET.NE.0) GO TO 1101 IF (TFLAG.NE.0) GO TO 1102 TFLAG=1 CALL EXEC(2,LIST,ERR2,23) 1102 INDX=51+5*J IND(1)=ROOTA(INDX) IND(2)=ROOTA(INDX+1) IND(3)=ROOTA(INDX+2) CALL EXEC(2,LIST,IND,7) ERROR=ERROR+1 1101 CONTINUE C SETS COMPLETED CALL EXEC(IRCD7,INAM7) 106 IF (RESNO.EQ.19) GO TO 111 C "'NAME:' OR 'END.' EXPECTED" NERR=22 112 CALL EMESS(NERR) C SCAN TO "NAME:" OR "END" 1121 IF (RESNO.EQ.15) GO TO 109 IF (RESNO.EQ.19) GO TO 111 CALL GGLOB GO TO 1121 111 CALL GGLOB LFLAG = 2 CALL GGLOB LFLAG = 0 C GET SET NAME IF (TYPE.EQ.4) GO TO 114 C "BAD'SET NAME OR TERMINATOR" NERR=23 GOߟ TO 112 C SEARCH FOR DUPLICATE SET NAME 114 CALL SSRCH(SETCT,SETNO) IF (SETNO.EQ.0) GO TO 115 C "DUPLICATE'SET NAME NERR=24 GO TO 112 115 SETCT=SETCT+1 IF (SETCT.LE.SMAX) GO TO 116 C "TOO MANY DATA SETS" - MAX # OF SETS EXCEEDED NERR=125 CALL EMESS(NERR) STOP 116 SPTR=6*SETCT-5 C SET NAME OK - ENTER IT IN NAME TABLE DO 117 J=1,6 CALL SPUT(NATAB,SPTR,IGLOB(J)) 117 SPTR=SPTR+1 CALL GGLOB IF (TYPE.EQ.9) GO TO 118 C IF NO COMMA "BAD SET NAME OR TERMINATOR" NERR=23 GO TO 112 118 CALL GGLOB C PROCESS SET TYPE IF ((RESNO.NE.25).AND.(RESNO.NE.26)) GO TO 119 C DETAIL SET FOUND; ENTER TYPE IN STYPE,INITIALIZE PATH COUNT C AND PATH TABLE BYTE PTR STYPE(SETCT)=104B TFLAG=3 PTHCT(SETCT)=0 PBPTR=2*PPTR-1 GO TO 120 119 IF ((RESNO.NE.24).AND.(RESNO.NE.27)) GO TO 121 C WE HAVE A MANUAL SET - ENTER TYPE IN STYPE STYPE(SETCT)=115B TFLAG=1 GO TO 120 121 IF ((RESNO.EQ.22).OR.(RESNO.EQ.23)) GO TO 122 C "BAD TYPE DESIGNATOR" NERR=16 GO TO 112 C WE HAVE AN AUTOMATIC SET - ENTER TYPE IN STYPE 122 STYPE(SETCT)=101B TFLAG=2 C GET COMMA 120 CALL GGLOB IF (TYPE.EQ.9) GO TO 1171 C IF NO COMMA "BAD TERMINATOR - ',' OR ';' EXPECTED" NERR=14 GO TO 112 C GET CARTRIDGE NUMBER 1171 CALL GGLOB IF ((TYPE.EQ.2).AND.(LGLOB.EQ.5)) GO TO 1201 C "BAD CART NUMBER" 1200 NERR=3 GO TO 112 C CR? 1201 IF ((IGLOB(1).NE.103B).OR.(IGLOB(2).NE.122B)) GO TO 1200 C CONVERT CART# AND ENTER IN IPACK ARRAY IPACK(SETCT)=0 DO 1202 J=3,5 IF ((IGLOB(J).LT.60B).OR.(IGLOB(J).GT.71B)) GO TO 1200 1202 IPACK(SETCT)=10*IPACK(SETCT)+(IGLOB(J)-60B) IF ((IPACK(SETCT).GE.256).OR.(IPACK(SETCT).LE.0)) GO TO 1200 CALL GGLOB C ";"? IF (TYPE.EQ.10) GO TO 113 C "BAD TERMINATOR - ';' EXPECTED" NERR=21 GO TO 112 113 CALL GGLOB ! IF (RESNO.EQ.20) GO TO 123 C "'ENTRY:' EXPECTED" NERR=26 GO TO 112 123 CALL GGLOB C PROCESS ENTRY PART C INITIALIZE CURRENT PATH CTR,PFLAG(WHICH INDICATES WHETHER A PATH HAS C BEEN ENCOUNTERED)FIELD COUNT,ENTRY LENTH, SET PATH TABLE PTR CURPA(SETCT)=0 PFLAG=0 FLDCT=0 ENLEN=0 PTHPT(SETCT)=PPTR C PROCESS ITEM NAME OF ENTRY 134 CONTINUE CALL GGLOB IF(FLDCT .LT. 127) GOTO 1341 NERR = 15 GO TO 112 1341 CONTINUE IF (TYPE.EQ.2) GO TO 127 C "ILLEGAL ITEM NAME OR TERMINATOR" NERR=12 GO TO 112 127 CALL ISRCH(ROOTA(6),INUM) IF (INUM.NE.0) GO TO 128 C "UNDEFINED ITEM REFERENCED" NERR=27 GO TO 112 128 IPTR=10*INUM+110 CALL RSGET(IPTR,DSET) IF (DSET.EQ.0) GO TO 129 C "ITEM SPECIFIED IN PREVIOUS SET" NERR=28 GO TO 112 C WE HAVE A VALID ITEM NAME C PUT DATA SET # IN ITEM PART OF ROOT TABLE 129 CALL RSPUT(IPTR,SETCT) C ADD ITEM LENGTH TO ENTRY LENGTH CALL SGET(ISPEC,INUM,ILEN) ENLEN=ENLEN+ILEN C ENTER ITEM# IN RECORD DEFINITION TABLE CALL SPUT(RECDF,RPTR,INUM) RPTR=RPTR+1 C ENTER ITEM LENGTH IN RECORD DEFINITION TABLE C SHIFT LEFT 2 IILEN=4*ILEN CALL SPUT(RECDF,RPTR,IILEN) RPTR=RPTR+1 C INCREMENT FIELD COUNT FLDCT=FLDCT+1 C "("? CALL GGLOB IF (TYPE.NE.11) GO TO 130 C WE HAVE A PATH - GO TO PROCESS PATH IF (TFLAG.EQ.3) GO TO 132 GO TO 131 C RETURN HERE FROM PATH PROCESS 133 IPTR=10*INUM+108 CALL RSGET(IPTR,IWLEV) IF (IWLEV.EQ.15) GO TO 1333 C "SEARCH ITEM DOES NOT HAVE WRITE LEVEL 15" NERR=47 GO TO 112 1333 CALL GGLOB C END OF ENTRY PART? - DO WE HAVE "," OR ";" 130 IF (TYPE.EQ.9) GO TO 134 IF (TYPE.EQ.10) GO TO 135 C "BAD TERMINATOR ',' OR ';' EXPECTED NERR=14 GO TO 112 C END OF ENTRY -ENTER FIELD COUNT AND ENTRY LENGTH IN THEIR RESPECTIVE C ARRAYS 135 xwFLDCN(SETCT)=FLDCT ENLTH(SETCT)=ENLEN IF (TFLAG.NE.3) GO TO 136 C CALCULATE MEDIA RECORD LENGTH AND NULL CRITCT FOR DETAIL SET MEDIA(SETCT)=2*PTHCT(SETCT)+1 CRIT(SETCT)=0 C UPDATE THE PATH TABLE POINTER. 137 PPTR=PPTR+2*PTHCT(SETCT) IF ((ENLEN+MEDIA(SETCT)).LE.255) GO TO 126 C "ENTRY TOO BIG" NERR=40 GO TO 112 136 IF (PFLAG.NE.0) GO TO 138 C "MASTER DATA SET LACKS SEARCH FIELD NERR=38 GO TO 112 138 IF (TFLAG.NE.2) GO TO 137 IF (FLDCT.EQ.1) GO TO 139 C "AUTOMATIC MASTER MUST HAVE KEY ITEM ONLY" NERR=39 GO TO 112 139 IF (PTHCT(SETCT).NE.0) GO TO 137 C "BAD PATH COUNT OR TERMINATOR" NERR=29 GO TO 112 C END OF ENTRY PART,BEGINNING OF CAPACITY PART 126 CALL GGLOB C "CAPACITY:"? IF (RESNO.EQ.21) GO TO 140 C "'CAPACITY:' EXPECTED" NERR=41 GO TO 112 140 CALL GGLOB CALL GGLOB IF (TYPE.EQ.1) GO TO 142 C "BAD CAPACITY COUNT OR TERMINATOR" 143 NERR=42 GO TO 112 142 CALL ATOD(CAPAC) IF ((CAPAC.LE.0.).OR.(CAPAC.GT.32767.)) GO TO 143 C WE HAVE A LEGAL CAPACITY COUNT - ENTER IN CAPACITY TABLE CAPTA(SETCT)=CAPAC CALL GGLOB IF (TYPE.EQ.10) GO TO 105 C ";"? NERR=21 GO TO 112 C*********************************************************************** C PROCESS MASTER PATH COUNT C*********************************************************************** 131 CALL GGLOB IF (TYPE.EQ.1) GO TO 144 C "BAD PATH COUNT OR TERMINATOR" 145 NERR=29 GO TO 112 144 CALL ATOD(PATHC) IF (PATHC.GT.5.) GO TO 145 IF(PFLAG.EQ.0) GO TO 146 C "MORE THAN ONE KEY FIELD" NERR=30 GO TO 112 C WE HAVE A VALID PATH COUNT 146 PFLAG=1 C ENTER PATH COUNT AND MEDIA RECORD LENGTH IN THEIR RESPECTIVE TABLES PTHCT(SETCT)=PATHC MEDIA(SETCT)=3*PATHC+3 C ENTER SEARCH FIELD # IN CRIT CRIT(SETCT)=FLDCT C ENTER SEARCH ITEM # IN KEYTA KEYT3A(SETCT)=INUM 147 CALL GGLOB C ")"? IF (TYPE.EQ.12) GO TO 133 GO TO 145 C*********************************************************************** C PROCESS DETAIL PATH C*********************************************************************** 132 LFLAG = 2 CALL GGLOB LFLAG = 0 C PROCESS SET NAME IF (TYPE.EQ.4) GO TO 148 C "BAD SET NAME OR TERMINATOR IN REFERENCE" 1481 NERR=31 GO TO 112 148 CALL SSRCH(SETCT,SETNO) IF (SETNO.NE.0) GO TO 149 C "UNDEFINED SET REFERENCED" NERR=32 GO TO 112 149 IF ((STYPE(SETNO).EQ.101B).OR.(STYPE(SETNO).EQ.115B)) GO TO 1490 C "REFERENCED SET NOT MASTER" NERR=33 GO TO 112 C CHECK FOR DUPLICATE SET NAME IN SET REFERENCE 1490 J=0 1491 IF (J.GE.PTHCT(SETCT)) GO TO 150 J=J+1 IF (SETNO.NE.SETRF(J)) GO TO 1491 C DUPLICATE SET NAME IN REFERENCE NERR=50 GO TO 112 150 MINUM=KEYTA(SETNO) IPTR=109+10*INUM MPTR=109+10*MINUM CALL RSGET(IPTR,ITYPE) CALL RSGET(MPTR,MTYPE) IF (MTYPE.EQ.ITYPE) GO TO 151 C "SEARCH ITEMS NOT OF SAME TYPE" NERR=35 GO TO 112 C WE HAVE A VALID SET NAME FOR SEARCH ITEM C INCREMENT PATH COUNT OF DETAIL AND CURRENT PATH # OF MASTER 151 CALL SGET(ISPEC,MINUM,MLEN) IF (MLEN.EQ.ILEN) GO TO 152 C "SEARCH ITEMS NOT OF SAME LENGTH" NERR=34 GO TO 112 152 PTHCT(SETCT)=PTHCT(SETCT)+1 CURPA(SETNO)=CURPA(SETNO)+1 IF (CURPA(SETNO).LE.PTHCT(SETNO)) GO TO 153 C "SET HAS NO PATHS AVAILABLE" -MASTER PATH COUNT EXCEEDED NERR=36 GO TO 112 153 IF (PTHCT(SETCT).LE.5) GO TO 154 C "TOO MANY PATHS IN DATA SET" NERR=37 GO TO 112 C ENTER REFERENCE SET# IN SETRF 154 IPATH=PTHCT(SETCT) SETRF(IPATH)=SETNO C CALCULATE INDEX TO MASTER PATH TABLE MBPTR=PTHPT(SETNO)+2*(CURPA(SETNO)-1) PTHTA(MBPTR+1)=0 MBPTR=2*MBPTR-1 C BUILD PATH TABLE C ENTER DETAIL SEARCH ITEM # IN x*($MASTER PATH TABLE CALL SPUT(PTHTA,MBPTR,INUM) MBPTR=MBPTR+1 C ENTER DETAIL DATA SET # IN MASTER PATH TABLE CALL SPUT(PTHTA,MBPTR,SETCT) MBPTR=MBPTR+1 C ENTER DETAIL PATH # IN MASTER PATH TABLE CALL SPUT(PTHTA,MBPTR,PTHCT(SETCT)) C ENTER SEARCH FIELD # IN DETAIL PATH TABLE CALL SPUT(PTHTA,PBPTR,FLDCT) PBPTR=PBPTR+1 C ENTER MASTER SET # IN DETAIL PATH TABLE CALL SPUT(PTHTA,PBPTR,SETNO) PBPTR=PBPTR+1 C ENTER MASTER PATH # IN DETAIL PATH TABLE CALL SPUT(PTHTA,PBPTR,CURPA(SETNO)) PBPTR=PBPTR+1 CALL SPUT(PTHTA,PBPTR,IZERO) PBPTR=PBPTR+1 CALL GGLOB IF (TYPE.NE.12) GO TO 1481 GO TO 133 END END$ *FTN4,L,C PROGRAM RAPUP(5,90) C C C************************************************************* C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * C RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * C PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * C OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C************************************************************* C C C LISTING: 92063-19002 C SOURCE: 92063-18002 C RELOC: 92063-16002 C C C************************************************************ C C*********************************************************************** C RAPUP BUILDS THE SET PART OF THE ROOT TABLE FROM THE TABLES C GENERATED BY SETS: C NATAB,STYPE,FLDCN,ENLTH,MEDIA,CAPTA,PTHCT,RECDF,CRIT,PTHTA C LEN,IPACK C DETERMINES: C NPACK - # OF CARTS IN DATA BASE C KPACK - AN ARRAY CONTAINING EACH CART # IN DATA BASE C CPACK - AN ARRAY CONTAINING THE SECTOR LENGTH OF EACH CART C NSETS - THE # OF SETS IN EACH CART C*********************************************************************** C C RAPUP SEGMENT C C C C INTEGER CARTN,CRDPR,CARD,SYSTY,INPT,TRAIL,PRE,CHAR,BUFF,FNAM, 1CODE,ERROR,TYPE,RESNO,RFILE,ROOTA,SMAX,STYPE,FLDCN,ENLTH,CAPTA, 1FWAM,LWAM,PTHCT,CURPA,PTHPT,RECDF,CRIT,PTHTA,SPTR,PPTR, 2RPTR,SBPTR EXTERNAL ROOTA DIMENSION INAM9(3) DIMENSION IA(3),IPN(2) DIMENSION SLEN(50) COMMON SYSTY,LIST,INPT,LINCT,CARTN,CRDPR,CARD(40),TRAIL,PRE,CHAR, 1BUFF(144),INFO(5),FNAM(3),CODE,ERROR,LGLOB,IGLOB(10),TYPE, 1RESNO,NORES,LFLAG,RFILE(3),LROOT,FWAM,LWAM,IMAX,MAXLN,SMAX, 1ISPEC(128),IPACK(50), 1NATAB(150),STYPE(50),FLDCN(50),ENLTH(50),MEDIA(50),CAPTA(50), 1PTHCT(50),CURPA(50),PTHPT(50),KEYTA(50),RECDF(255),CRIT(50), 1PTHTA(500), 1NPACK,CPACK(50),NSETS(50),KPACK(50) DATA IRCD9,INAM9/8,2HSU,2HMR,2HY / DATA IPN(1),IPN(2)/2H C,2HR / IF (INaFO(3).EQ.0) GO TO 160 C TABLE OPTION ON - LIST TABLES WRITE (LIST,1017) 1017 FORMAT(//" DATA SET NAME TYPE FLD CNT PATH CNT ENTR LGTH MED 1REC CAPAC CT CART NO.") WRITE(LIST,10171) 10171 FORMAT(1H ,1H ,) NANDX=1 DO 161 J=1,ROOTA(7) C CONVERT CART# TO ASCII AND ENTER IN IA CALL CITA(IPACK(J),IA) CALL SMOVE(IPN,1,3,IA,1) WRITE(LIST,1018) (NATAB(K),K=NANDX,(NANDX+2)),STYPE(J),FLDCN(J), 1PTHCT(J),ENLTH(J),MEDIA(J),CAPTA(J),IA 161 NANDX=NANDX+3 1018 FORMAT(1H ,3X,3A2,7X,R1,6X,I3,7X,I1,8X,I4,6X,I4,5X,I5,5X,3A2) C CALCULATE SET LENGTHS IN WORDS C CONVERT TO SECTOR LENGTH AND ENTER IN SLEN ARRAY 160 DO 163 J=1,ROOTA(7) RCAP=CAPTA(J) RECLN=ENLTH(J)+MEDIA(J) WLEN=RCAP*RECLN 163 SLEN(J)=AINT(((WLEN-1.)/128.)+1.) C INITIALIZE SET PART OF ROOT TABLE PTR, PATH TABLE PTR,REC DEF TAB PTR, C NAME TABLE PTR SPTR=ROOTA(9) PPTR=1 RPTR=1 NANDX=1 DO 162 J=1,ROOTA(7) C ENTER TYPE IN ROOT TABLE CALL SROOT(SPTR,STYPE(J)) SPTR=SPTR+1 C ENTER MEDIA REC LEN IN ROOT TABLE CALL SROOT(SPTR,MEDIA(J)) SPTR=SPTR+1 C ENTER ENTRY LENGTH IN ROOT TABLE CALL SROOT(SPTR,ENLTH(J)) SPTR=SPTR+1 C ENTER FIELD COUNT IN ROOT TABLE SBPTR=2*SPTR-1 CALL RSPUT(SBPTR,FLDCN(J)) SBPTR=SBPTR+1 C ENTER PATH COUNT IN ROOT TABLE CALL RSPUT(SBPTR,PTHCT(J)) SBPTR=SBPTR+1 C ENTER SEARCH FIELD # IN ROOT TABLE CALL RSPUT(SBPTR,CRIT(J)) SPTR=SPTR+2 CALL SROOT(SPTR,0) C ENTER INDEX TO PATH TABLE IN ROOT TABLE IF (PTHCT(J).NE.0) CALL SROOT(SPTR,17+FLDCN(J)) SPTR=SPTR+7 C ENTER SET NAME IN ROOT TABLE DO 164 K=1,3 CALL SROOT(SPTR,NATAB(NANDX)) NANDX=NANDX+1 164 SPTR=SPTR+1 C ENTER CART# IN ROOT TABLE . CALL RSPUT(2*SPTR-2,IPACK(J)) C ENTER CAPACITY IN ROOT TABLE CALL SROOT(SPTR,CAPTA(J)) SPTR=SPTR+1 C ENTER REC DEF TAB FOR SEC T IN ROOT TABLE DO 165 K=1,FLDCN(J) CALL SROOT(SPTR,RECDF(RPTR)) RPTR=RPTR+1 165 SPTR=SPTR+1 C ENTER PATH TABLE FOR SET IN ROOT TABLE K=0 166 IF (K.GE.PTHCT(J)) GO TO 162 K=K+1 CALL SROOT(SPTR,PTHTA(PPTR)) CALL SROOT(SPTR+1,PTHTA(PPTR+1)) PPTR=PPTR+2 SPTR=SPTR+2 GO TO 166 162 CONTINUE C C ENTER NUMBER OF CARTS IN NPACK C CART NUMBERS IN KPACK C SECTOR LENGTH OF EACH PACK IN CPACK C NUMBER OF SETS IN EACH CART IN NSETS NPACK=0 DO 100 J=1,ROOTA(7) MPTR=0 9 IF (MPTR.GE.NPACK) GO TO 10 MPTR=MPTR+1 IF (IPACK(J).NE.KPACK(MPTR)) GO TO 9 CPACK(MPTR)=CPACK(MPTR)+SLEN(J) NSETS(MPTR)=NSETS(MPTR)+1 GO TO 100 10 NPACK=NPACK+1 KPACK(NPACK)=IPACK(J) CPACK(NPACK)=SLEN(J) NSETS(NPACK)=1 100 CONTINUE C C ENTER LENGTH OF ROOT TABLE IN LROOT LROOT=SPTR CALL EXEC(IRCD9,INAM9) END END$ FTN4,L,C PROGRAM SUMRY(5,90),92063-16002 REV. 1826 780418 C C C************************************************************* C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * C RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * C PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * C OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C************************************************************* C C C LISTING: 92063-19002 C SOURCE: 92063-18002 C RELOC: 92063-16002 C C C************************************************************ C C*********************************************************************** C SUMRY PRINTS DATA SCHEMA INFORMATION C AND CALCULATES THE LENGTH OF EACH DATA BASE C*********************************************************************** C C SUMRY SEGMENT C C C INTEGER CARTN,CRDPR,CARD,SYSTY,INPT,TRAIL,PRE,CHAR,BUFF,FNAM, 1SMAX,CODE,ERROR,TYPE,RESNO,RFILE,ROOTA,FWAM,LWAM INTEGER STYPE,FLDCN,ENLTH,CAPTA,PTHCT,CURPA,PTHPT,RECDF,CRIT,PTHTA DIMENSION INAMA(3) EXTERNAL ROOTA DIMENSION IA(3),IPN(3) COMMON SYSTY,LIST,INPT,LINCT,CARTN,CRDPR,CARD(40),TRAIL,PRE,CHAR, 1BUFF(144),INFO(5),FNAM(3),CODE,ERROR,LGLOB,IGLOB(10),TYPE, 1RESNO,NORES,LFLAG,RFILE(3),LROOT,FWAM,LWAM,IMAX,MAXLN,SMAX, 1ISPEC(128),IPACK(50), 4NATAB(150),STYPE(50),FLDCN(50),ENLTH(50),MEDIA(50),CAPTA(50), 5PTHCT(50),CURPA(50),PTHPT(50),KEYTA(50),RECDF(255),CRIT(50), 6PTHTA(500),NPACK,CPACK(50),NSETS(50),KPACK(50) DATA IRCDA,INAMA/8,2HRO,2HOT,2H / DATA IPN(1),IPN(2),IPN(3)/2HCR,2H ,2H / C SKIP 2 LINES WRITE(LIST,1013) ERROR 1013 FORMAT(//,1H ,"NUMBER OF ERROR MESSAGES ",I3) J=ROOTA(6) WRITE(LIST,1014) J 1014 FORMAT(1H ,"ITEM NAME COUNT: ",I3) J=ROOTA(7) WRITE(LIST,1015) J 1015 FORMAT(1H ,"DATA SET COUNT: ",I2) IF (ERROR.NE.0) GO TO 200 C CALCULATE # OF SECTORS IN ROOT FT  ILE ISECT=(LROOT+127)/128 1016 FORMAT(1H ,"ROOT LENGTH: ",I2," BLOCKS,",I4," WORDS") WRITE(LIST,1016) ISECT,LROOT 1018 FORMAT(//1H ,7X,"CARTRIDGE REFERENCE NUMBER",7X, 1"NUMBER OF BLOCKS REQ'D") WRITE(LIST,1018) WRITE(LIST,1019) 1019 FORMAT(1H ,1H ) C PRINT EACH FILE NAME AND ITS LENGTH IN BLOCKS DO 20 J=1,NPACK CALL CITA(KPACK(J),IA) CALL SMOVE(IA,4,6,IPN,3) WRITE(LIST,1017) IPN,CPACK(J) 1017 FORMAT(1H ,16X,3A2,22X,F8.0) 20 CONTINUE 200 IF (INFO(2).EQ.0) CALL EXEC(IRCDA,INAMA) CALL CLOSE(BUFF) STOP END END$ FTN,L,C PROGRAM ROOT(5,90) C C C************************************************************* C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * C RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * C PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * C OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C************************************************************* C C C LISTING: 92063-19002 C SOURCE: 92063-18002 C RELOC: 92063-16002 C C C************************************************************ C C*********************************************************************** C ROOT WRITES THE ROOT FILE ON THE DISK C AND CREATES ALL THE DATA SET FILES C*********************************************************************** C C ROOT SEGMENT C INTEGER CARTN,CRDPR,CARD,SYSTY,INPT,TRAIL,PRE,CHAR,FNAM,BUFF, 1SMAX,CODE,ERROR,TYPE,RESNO,RFILE,ROOTA,FWAM,LWAM,ERR1,ERR2, 2ERR3,MES1,STYPE,FLDCN,ENLTH,CAPTA,PTHCT,CURPA,PTHPT,RECDF, 3CRIT,PTHTA,MES2 EXTERNAL ROOTA DIMENSION ERR1(24),ERR2(11),ERR3(21),MES1(19),MES2(9) COMMON SYSTY,LIST,INPT,LINCT,CARTN,CRDPR,CARD(40),TRAIL,PRE,CHAR, 1BUFF(144),INFO(5),FNAM(3),CODE,ERROR,LGLOB,IGLOB(10),TYPE, 2RESNO,NORES,LFLAG,RFILE(3),LROOT,FWAM,LWAM,IMAX,MAXLN,SMAX, 3ISPEC(128),IPACK(50), 4NATAB(150),STYPE(50),FLDCN(50),ENLTH(50),MEDIA(50),CAPTA(50), 5PTHCT(50),CURPA(50),PTHPT(50),KEYTA(50),RECDF(255),CRIT(50), 6PTHTA(500),NPACK,CPACK(50),NSETS(50),KPACK(50) C DATA ERR1/2H R,2HOO,2HT ,2HFI,2HLE,2H N,2HOT,2H C,2HRE, 12HAT,2HED,2H D,2HUE,2H T,2HO ,2HER,2HRO,2HR(,2HS),2H I, 22HN ,2HSC,2HHE,2HMA/ DATA ERR2/2H R,2HOO,2HT ,2HFI,2HLE,2H N,2HOT,2H C,2HRE, 12HAT,2HED/ DATA ERR3/2H R,2HOO,2HT ,2HFI,2HLE,2H A,2HND,2H D,2HAT, 12HA ,2HSE,2HT ,2HFI,2HLE,2HS ,2HNO,2HT ,2HCR,2HEA, 22HTE,2HD / DATA MES1/2H R,2HOO,2HT ,2HFI,2HLE,2H A,2HND,2H D, 1l  2HAT,2HA ,2HSE,2HT ,2HFI,2HLE,2HS ,2HCR,2HEA,2HTE,2HD / DATA MES2/2HRO,2HOT,2H F,2HIL,2HE ,2HCR,2HEA,2HTE,2HD / C IF THERE ARE ANY ERRORS IN SCHEMA, WRITE MESSAGE AND EXIT IF (ERROR .EQ.0) GO TO 73 CALL EXEC(2,LIST,ERR1,-48) STOP C CREATE DATA SET FILES 73 IF (INFO(4).EQ.1) GOTO 74 CALL DBCRT(FWAM,BUFF,0,IERR) IF (IERR.LT.0) GOTO 200 C C WRITE OUT ROOT FILE C C CREATE ROOT FILE C 74 CALL CREAT(BUFF,IERR,RFILE,(LROOT/128)+1,11,ROOTA(5),CARTN) IF (IERR.GE.0) GOTO 72 CALL FMERR(IERR,LIST) CALL EXEC(2,LIST,ERR2,-22) STOP 72 CALL WRITR(IERR) IF (IERR.LT.0) GOTO 200 IF (INFO(4).EQ.0) GOTO 145 CALL EXEC(2,LIST,MES2,9) GOTO 150 145 CALL EXEC(2,LIST,MES1,-38) 150 CALL CLOSE(BUFF) STOP 200 CALL EXEC(2,LIST,ERR3,-42) CALL FMERR(IERR,LIST) C GOTO 150 END END$ FTN,L,C SUBROUTINE GCHAR C C C************************************************************* C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * C RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * C PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * C OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C************************************************************* C C C LISTING: 92063-19002 C SOURCE: 92063-18002 C RELOC: 92063-16002 C C C************************************************************ C C*********************************************************************** C GCHAR RETURNS THE NEXT CHARACTER IN CHAR AND THE CODE FOR THE C CHARACTER IN CODE. GCHAR SKIPS COMMENTS. C CALLING SEQUENCE C CALL GCHAR C*********************************************************************** C C GCHAR SUBROUTINE C INTEGER CARTN,CRDPR,CARD,SYSTY,INPT,TRAIL,PRE,CHAR,BUFF,FNAM, 1CODE,CODTA(128) COMMON SYSTY,LIST,INPT,LINCT,CARTN,CRDPR,CARD(40),TRAIL,PRE,CHAR, 1BUFF(144),INFO(5),FNAM(3),CODE C CODTA IS THE TABLE OF CODES FOR ASCII CHARS, INDEXED INTO BY C THE ASCII CODE+1 DATA CODTA/13,9*4,13,4,4,13,5*4,13,12*4,8,4,4,3, 14,3,3,3,11,12,3,3,9,3,6,3,10*1,7,10,13,5,4,3,3, 126*2,32*4,5*13/ C GET NEXT CHAR 13 CALL GCARD C GET CODE FOR CHAR CODE=CODTA(CHAR+1) IF (CHAR.NE.74B) RETURN C IF CHAR='<' SCAN PAST COMMENT CALL GCARD IF (CHAR.EQ.74B) GO TO 14 CODE=14 RETURN 14 CALL GCARD C CHAR='>'? IF (CHAR.NE.76B) GO TO 14 CALL GCARD IF (CHAR.NE.76B) GO TO 14 GO TO 13 END END$ kFTN,L,C SUBROUTINE GGLOB,92063-16002 REV. 1826 780420 C C C************************************************************* C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * C RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * C PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * C OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C************************************************************* C C C LISTING: 92063-19002 C SOURCE: 92063-18002 C RELOC: 92063-16002 C C C************************************************************ C C*********************************************************************** C GGLOB GETS THE NEXT GLOB C A GLOB IS A LEVEL WORD,INTEGER,NAME,RESERVED WORD,FILE NAME,OR C SPECIAL CHARACTER(= . : ,;()) C CGLOB SCANS PAST LEADING BLANKS C GGLOB PUTS THE GLOB IN IGLOB, LENGTH OF GLOB IN LGLOB, C NUMBER OF RESERVED WORD IN RESNO,(RESNO=0 IF NOT RESERVED.) C GGLOB SETS TYPE ACC. THE THE TYPE OF THE GLOB AS FOLLOWS> C C RESNO=1 FOR LIST C RESNO=2 FOR NOLIST C RESNO=3 FOR ERROR C RESNO=4 FOR ROOT C RESNO=5 FOR NOROOT C RESNO=6 FOR TABLE C RESNO=7 FOR NOTABLE C RESNO=8 FOR SET C RESNO=9 FOR NOSET C RESNO=10 CONTROL C RESNO=11 FOR ID C RESNO=12 FOR BEGIN C RESNO=13 FOR DATA C RESNO=14 FOR BASE C RESNO=15 FOR END C RESNO=16 FOR LEVELS C RESNO=17 FOR ITEMS C RESNO=18 FOR SETS C RESNO=19 FOR NAME C RESNO=20 FOR ENTRY C RESNO=21 FOR CAPACITY C RESNO=22 FOR A C RESNO=23 FOR AUTOMATIC C RESNO=24 FOR M C RESNO=25 FOR DETAIL C RESNO=26 FOR D C RESNO=27 FOR MANUAL C C TYPE=1 FOR INTEGER C TYPE=2 FOR NAME C TYPE=3 FOR LEVEL WORD C TYPE=4 FOR ROOT FILE NAME (DATA BASE NAME) C TYPE=5 FOR '=' C TYPE=6 FOR '.' C TYPE=7 FOR ':' C {> TYPE=9 FOR ',' C TYPE=10 FOR ';' C TYPE=11 FOR '(' C TYPE=12 FOR ')' C TYPE=0 FOR ILLEGAL GLOB C CALLING SEQUENCE C CALL GGLOB C*********************************************************************** C C GGLOB SUBROUTINE C INTEGER CARTN,CRDPR,CARD,SYSTY,INPT,TRAIL,PRE,CHAR,BUFF,FNAM, 1CODE,ERROR,TYPE,RESNO,RESTA DIMENSION RESTA(81) COMMON SYSTY,LIST,INPT,LINCT,CARTN,CRDPR,CARD(40),TRAIL,PRE,CHAR, 1BUFF(144),INFO(5),FNAM(3),CODE,ERROR,LGLOB,IGLOB(10),TYPE, 1RESNO,NORES,LFLAG C RESTA IS THE TABLE OF RESERVED WORDS DATA RESTA/2HLI,2HST,2H ,2HNO,2HLI,2HST, 12HER,2HRO,2HRS,2HRO,2HOT,2H , 12HNO,2HRO,2HOT,2HTA,2HBL,2HE , 12HNO,2HTA,2HBL,2HSE,2HT ,2H , 12HNO,2HSE,2HT ,2HCO,2HNT,2HRO, 12HID,2H ,2H ,2HBE,2HGI,2HN , 12HDA,2HTA,2H ,2HBA,2HSE,2H , 12HEN,2HD ,2H ,2HLE,2HVE,2HLS, 12HIT,2HEM,2HS ,2HSE,2HTS,2H , 12HNA,2HME,2H ,2HEN,2HTR,2HY , 12HCA,2HPA,2HCI,2HA ,2H ,2H , 12HAU,2HTO,2HMA,2HM ,2H ,2H , 12HDE,2HTA,2HIL,2HD ,2H ,2H , 12HMA,2HNU,2HAL/ DATA I9,I10,I6/9,10,6/ LGLOB=0 RESNO=0 TYPE=0 L1=0 21 IF (CODE.NE.8) GO TO 20 C SCAN PAST LEADING BLANKS CALL GCHAR L1=1 GO TO 21 C BLANK-FILL IGLOB 20 DO 22 J=1,6 22 IGLOB(J)=40B IF (LFLAG.NE.1) GO TO 23 C PROCESS LEVEL WORD IF (CODE.EQ.10) GO TO 351 IF (L1.NE.1) RETURN 26 IF (CODE.GT.7) GO TO 24 LGLOB=LGLOB+1 IF (LGLOB.GT.6) RETURN IGLOB(LGLOB)=CHAR CALL GCHAR GO TO 26 24 TYPE=3 RETURN C PROCESS ROOT FILE NAME 23 IF(LFLAG.NE.2) GO TO 28 C FIRST CHAR = INTEGER? IF (CODE .EQ. 1) RETURN C SEMICOLN? 31 IF (CODE.EQ.10) GO TO 29 C COMMA? IF (CODE .EQ. 9) GO TO 29 C RIGHT PAREN? IF (CODE .EQ. 12) GO TO 29 C COLN? IF (CODE .EQ. 7) RETURN C BLANK? IF (CODE.EQ.8) GOTO 30 C MINUS? IF (CHAR .EQ. 55B) RETURN C PLUS? IF (CHAR.EQ.53B) RETURN C CARRAIGE CONTROL? IF (CODE.EQ.13) RETURN C PUT CHARACTER IN RETURN BUFFER LGLOB=LGLOB+1 C TOO MANY CHARACTERS? IF (LGLOB.GT.5) RETURN IGLOB(LGLOB)=CHAR 30 CALL GCHAR GO TO 31 C IF THERE WERE ANY CHARACTERS RETURN GOOD TYPE 29 IF (LGLOB.EQ.0) RETURN TYPE=4 RETURN 28 IF (CODE.NE.1) GO TO 32 C PROCESS INTEGER 34 LGLOB=LGLOB+1 IGLOB(LGLOB)=CHAR CALL GCHAR IF (CODE.NE.1) GO TO 33 IF (LGLOB.GT.10) RETURN GO TO 34 33 TYPE=1 RETURN 32 IF (CODE.NE.2) GO TO 35 C PROCESS NAME 37 LGLOB=LGLOB+1 IF (LGLOB.GT.9) GO TO 36 IGLOB(LGLOB)=CHAR CALL GCHAR IF (CODE.LE.3) GO TO 37 C TEST WHETHER NAME IS A RESERVED WORD DO 38 J=1,NORES M=3*(J-1)+1 DO 39 I=1,6 CALL SGET(RESTA(M),I,ICOMP) IF(ICOMP.NE.IGLOB(I)) GO TO 38 39 CONTINUE C NAME IS A RESERVED WORD C TEST FOR '.' AFTER 'END' IF (J.EQ.15) GO TO 40 IF ( (J.LT.16) .OR. (J.GT.21) ) GO TO 400 C TEST FOR ':' AFTER CERTAIN RESERVED WORDS IF (CODE.NE.7) GO TO 42 C ASSIGN RESERVED WORD # 400 TYPE=2 40 RESNO=J RETURN 38 CONTINUE 41 IF (LGLOB.GT.6) GO TO 36 C VALID NAME, ASSIGN TYPE 42 TYPE=2 RETURN 35 IF ((CODE.LT.5).OR.(CODE.GT.12)) GO TO 43 C VALID SPECIAL CHAR 351 TYPE=CODE 43 LGLOB=1 IGLOB(1)=CHAR 36 CALL GCHAR RETURN END END$ vFTN,L,C SUBROUTINE GCARD C C C************************************************************* C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * C RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * C PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * C OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C************************************************************* C C C LISTING: 92063-19002 C SOURCE: 92063-18002 C RELOC: 92063-16002 C C C************************************************************ C C*********************************************************************** C GCARD SCANS THE NEXT CHARACTER AND PUTS IT IN CHAR C READS AND LISTS NEXT CARD; IGNORES COLUMNS 73-80 C IF INPT > 63 SCHEMA IS READ FROM DISK C CALLING SEQUENCE C CALL GCARD C*********************************************************************** C C GCARD SUBROUTINE C INTEGER CARTN,CRDPR,CARD,SYSTY,INPT,TRAIL,PRE,CHAR,BUFF,FNAM, 1FWAM,LWAM,CODE,ERROR,TYPE,RESNO,RFILE,ROOTA,SMAX,ROTMAX EXTERNAL ROOTA COMMON SYSTY,LIST,INPT,LINCT,CARTN,CRDPR,CARD(40),TRAIL,PRE,CHAR, 1BUFF(144),INFO(5),FNAM(3),CODE,ERROR,LGLOB,IGLOB(10),TYPE, 2RESNO,NORES,LFLAG,RFILE(3),LROOT,FWAM,LWAM,IMAX,MAXLN,SMAX DIMENSION ISETS(2) DIMENSION INUM(4) DATA IBLNK/2H / DATA ICR/6412B/ DATA ICOMT/2H< / DATA ISETS/2HSE,2HTS/ IF(CRDPR.GE.72) GO TO 6 CRDPR=CRDPR+1 GO TO 12 C BLANK FILE CARD BUFFER 6 DO 70 IMOVE=1,40 70 CARD(IMOVE)=IBLNK IF (INPT.GT.1000) GOTO 7 C READ NEW CARD CALL EXEC(1,INPT,CARD,-80) GOTO 8 C GET NEW CARD FROM DISK FILE BUFFER 7 CALL READF(BUFF,IERR,CARD) C "END OF FILE ENCOUNTERED" IF (IERR.NE.-12) GOTO 8 N=149 CALL EMESS(N) STOP 8 CRDPR=1 IF (INFO(1).NE.0) GO TO 12 C IF LIST IS TURNED ON , LIST NEXT CARD IF((TRAIL.EQ.0).AND.(ROOTA(6).{  NE.0)) GOTO 14 10 CALL EXEC(2,LIST+200B,CARD,-80) C PUT NEXT CHARACTER IN CHAR 12 CALL SGET(CARD,CRDPR,CHAR) RETURN C C C PRINT ITEM WITH ITEM NUMBER C 14 DO 15 J=1,80 IF (JSCOM(ISETS,1,4,CARD,J,N).EQ.0) GOTO 10 15 IF (JSCOM(ICOMT,1,1,CARD,J,N).EQ.0) J=80 16 CALL CITA(ROOTA(6),INUM(2)) INUM(1)=IBLNK INUM(2)=IBLNK CALL EXEC(2,LIST+2200B,INUM,4) CALL EXEC(2,LIST+2200B,CARD,36) CALL EXEC(2,LIST+2200B,ICR,1) GOTO 12 END END$ FTN,L,C SUBROUTINE ATOD(AV) C C C************************************************************* C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * C RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * C PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * C OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C************************************************************* C C C LISTING: 92063-19002 C SOURCE: 92063-18002 C RELOC: 92063-16002 C C C************************************************************ C C*********************************************************************** C CONVERTS THE VALUE IN IGLOB FROM ASCII TO DECIMAL AND STORES THE C RESULT IN AV C CALLING SEQUENCE C CALL ATOD(AV) C WHERE AV=THE CONVERTED REAL NUMBER C*********************************************************************** C C ATOD SUBROUTINE C INTEGER CARTN,CRDPR,CARD,SYSTY,INPT,TRAIL,PRE,CHAR,BUFF,FNAM, 1CODE,ERROR,TYPE,RESNO,RFILE,ROOTA,SMAX,STYPE,FLDCN,ENLTH,CAPTA, 1FWAM,LWAM,PTHCT,CURPA,PTHPT,RECDF,CRIT,PTHTA,ACTR COMMON SYSTY,LIST,INPT,LINCT,CARTN,CRDPR,CARD(40),TRAIL,PRE,CHAR, 1BUFF(144),INFO(5),FNAM(3),CODE,ERROR,LGLOB,IGLOB(10),TYPE, 1RESNO,NORES,LFLAG,RFILE(3),LROOT,FWAM,LWAM,IMAX,MAXLN,SMAX AV=0 DO 67 ACTR=1,LGLOB 67 AV=10*AV+(IGLOB(ACTR)-60B) RETURN END END$ NNFTN,L,C SUBROUTINE ISRCH(LAST,INUM) C C C************************************************************* C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * C RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * C PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * C OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C************************************************************* C C C LISTING: 92063-19002 C SOURCE: 92063-18002 C RELOC: 92063-16002 C C C************************************************************ C C*********************************************************************** C ISRCH COMPARES EACH SUCCESSIVE ITEM IN THE ITEM TABLE WITH THE C CONTENTS OF IGLOB. THE ITEM LIST IS SEARCHED THROUGH ITEM C NUMBER LAST. IF A MATCH IS FOUND, INUM IS SET TO THE ITEM C NUMBER OF THE MATCHING ITEM. IF NO MATCH IS FOUND, INUM C IS SET TO 0. C CALLING SEQUENCE C CALL ISRCH(LAST,INUM) C WHERE LAST IS THE ITEM # OF THE LAST ITEM TO BE SEARCHED C INUM IS SET TO THE ITEM # OF THE MATCHING ITEM OR 0 C*********************************************************************** C C ISRCH SUBROUTINE C INTEGER CARTN,CRDPR,CARD,SYSTY,INPT,TRAIL,PRE,CHAR,BUFF,FNAM, 1CODE,ERROR,TYPE,RESNO,RFILE,ROOTA,SMAX,STYPE,FLDCN,ENLTH,CAPTA, 1FWAM,LWAM,PTHCT,CURPA,PTHPT,RECDF,CRIT,PTHTA,COMP EXTERNAL ROOTA COMMON SYSTY,LIST,INPT,LINCT,CARTN,CRDPR,CARD(40),TRAIL,PRE,CHAR, 1BUFF(144),INFO(5),FNAM(3),CODE,ERROR,LGLOB,IGLOB(10),TYPE, 1RESNO,NORES,LFLAG,RFILE(3),LROOT,FWAM,LWAM,IMAX,MAXLN,SMAX ICTR=0 INUM=0 69 IF (ICTR.GE.LAST) RETURN ICTR=ICTR+1 IPTR=101+(10*ICTR) DO 68 J=1,6 CALL RSGET(IPTR,COMP) IF (COMP.NE.IGLOB(J)) GO TO 69 68 IPTR=IPTR+1 INUM=ICTR RETURN END END$   FTN4,L,C SUBROUTINE SSRCH(ISCT,SETNO) C C C************************************************************* C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * C RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * C PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * C OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C************************************************************* C C C LISTING: 92063-19002 C SOURCE: 92063-18002 C RELOC: 92063-16002 C C C************************************************************ C C*********************************************************************** C SSRCH COMPARES EACH SUCCESSIVE SET NAME IN THE SET TABLE WITH C THE CONTENTS OF IGLOB. THE SET TABLE IS SEARCHED THROUGH ENTRY C NUMBER ISCT. IF A MATCH IS FOUND, SETNO IS SET TO THE SET C NUMBER OF THE MATCHING SET NAME. IF NO MATCH IS FOUND, SETNO C IS SET TO 0. C CALLING SEQUENCE C CALL SSRCH(ISCT,SETNO) C WHERE ISCT IS THE SET # OF THE LAST SET TO BE SEARCHED C SETNO IS SET TO THE SET# OF THE MATCHING SET OR 0 C*********************************************************************** C C SSRCH SUBROUTINE C INTEGER CARTN,CRDPR,CARD,SYSTY,INPT,TRAIL,PRE,CHAR,BUFF,FNAM, 1CODE,ERROR,TYPE,RESNO,RFILE,ROOTA,SMAX,STYPE,FLDCN,ENLTH,CAPTA, 1FWAM,LWAM,PTHCT,CURPA,PTHPT,RECDF,CRIT,PTHTA,COMP,SETNO, 1SPTR,SCTR EXTERNAL ROOTA COMMON SYSTY,LIST,INPT,LINCT,CARTN,CRDPR,CARD(40),TRAIL,PRE,CHAR, 1BUFF(144),INFO(5),FNAM(3),CODE,ERROR,LGLOB,IGLOB(10),TYPE, 1RESNO,NORES,LFLAG,RFILE(3),LROOT,FWAM,LWAM,IMAX,MAXLN,SMAX, 1ISPEC(128),IPACK(50),NATAB(150) SCTR=0 SETNO=0 70 IF (SCTR.GE.ISCT) RETURN SCTR=SCTR+1 SPTR=6*SCTR-5 DO 71 J=1,5 CALL SGET(NATAB,SPTR,COMP) IF (COMP.NE.IGLOB(J)) GO TO 70 71 SPTR=SPTR+1 SETNO=SCTR RETURN END END$   FTN,L,C SUBROUTINE EMESS(N),92063-16002 REV. 1826 780419 C C C************************************************************* C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * C RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * C PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * C OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C************************************************************* C C C LISTING: 92063-19002 C SOURCE: 92063-18002 C RELOC: 92063-16002 C C C************************************************************ C C*********************************************************************** C EMESS PRINTS OUT ERROR MESSAGES AND SCANS TO THE NEXT SEMICOLON C IF LISTING IS TURNED OFF,PRINTS THE RECORD ON WHICH THE ERROR C OCCURRED. C CALLING SEQUENCE C CALL EMESS(N) C WHERE N=ERROR MESSAGE NUMBER C*********************************************************************** C C EMESS SUBROUTINE C INTEGER CARTN,CRDPR,CARD,SYSTY,INPT,TRAIL,PRE,CHAR,BUFF,FNAM, 1ERR,CODE,ERROR,EFLAG,TYPE,RESNO DIMENSION MESS(20) DIMENSION ERR(6) COMMON SYSTY,LIST,INPT,LINCT,CARTN,CRDPR,CARD(40),TRAIL,PRE,CHAR, 1BUFF(144),INFO(5),FNAM(3),CODE,ERROR,LGLOB,IGLOB(10),TYPE, 1RESNO,NORES,LFLAG DATA ERR/2H ,2H**,2HER,2HRO,2HR:,2H / DATA ICR/6412B/ EFLAG=0 IF (INFO(1).NE.1) GO TO 15 C IF LIST IS TURNED OFF, PRINT ERROR LINE CALL EXEC(2,LIST+200B,CARD,-80) 15 IF (N.LE.100) GO TO 16 C COME HERE FOR TERMINAL ERRORS AND SET EFLAG (TERMINATION FLAG) N=N-100 EFLAG=1 C PICK UP ERROR MESSAGE 16 CALL GMESS(N,MESS) C WRITE ERROR MESSAGE CALL EXEC(2,LIST+2200B,ERR,-12) CALL EXEC(2,LIST+2200B,MESS,-40) CALL EXEC(2,LIST+2200B,ICR,-2) C INCREMENT ERROR COUNTER ERROR=ERROR+1 IF (ERROR.LE.INFO(5)) GO TO 17 C TERMINATE IF MAX# OF ERRORS EXCEEDED N=44    GO TO 18 17 IF (EFLAG.EQ.0) RETURN C PRINT TERMINATION MESSAGE AND EXIT N=8 18 CALL GMESS(N,MESS) CALL EXEC(2,LIST+2200B,ERR,-12) CALL EXEC(2,LIST+2200B,MESS,-40) CALL CLOSE(BUFF) STOP END END$ 3v ASMB,R,L,C NAM GMESS,7 92063-16002 REV. 1621 * * ************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * * PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ************************************************************** * * * LISTING: 92063-19002 * SOURCE: 92063-18002 * RELOC: 92063-16002 * * ************************************************************* * ************************************************************ * GMESS RETURNS AN ERROR MESSAGE * CALLING SEQUENCE * CALL GMESS(N,MESS) * WHERE N=ERROR MESSAGE # * MESS IS AN ARRAY WHERE GMESS WILL STORE THE MESSAGE ************************************************************ * * GMESS SUBROUTINE * ENT GMESS EXT .ENTR SUP PRESS PARAM BSS 2 GMESS NOP JSB .ENTR TRANSFER PARAMETERS DEF PARAM CCA ADA PARAM,I ENDX=20*(N-1) MPY T20 ADA EADDR STA ENDX CLA STA J J=0 OVER LDA PARAM+1 MESS(J)=ERTAB(ENDX) ADA J LDB ENDX,I STB 0,I LDA J ADA NEG19 SSA,RSS IF J<19,RETURN JMP GMESS,I ISZ J J=J+1 ISZ ENDX ENDX=ENDX+1 JMP OVER T20 DEC 20 NEG19 DEC -19 ENDX BSS 1 J BSS 1 EMESJ BSS 1 EADDR DEF ERTAB ERTAB ASC 20,ILLEGAL CONTROL CARD. ASC 20,CARTRIDGE NUMBER EXPECTED. ASC 20,ILLEGAL CARTRIDGE NUMBER. ASC 20,ILLEGAL SECURITY CODE. ASC 20,'BEGIN DATA BASE' EXPECTED. ASC 20,BAD DATA BASE NAME OR TERMINATOR. ASC 20,'LEVELS:' NOT FOUND. ASC 20,SCHEMA PROCESSING TERMINATED. ASC 20,BAD LEVEL WORD OR TERMINATOR. ASC 20,LEVEL WORD TOO LONG. ASC 20,BAD LEVEL NUMBER OR TERMINATOR. ASC 20,ILLEGAL ITEM NAwy  ME OR TERMINATOR. ASC 20,DUPLICATE ITEM NAME. ASC 20,BAD TERMINATOR - ',' OR ';' EXPECTED. ASC 20,TOO MANY DATA ITEMS. ASC 20,BAD TYPE DESIGNATOR. ASC 20,ITEM TOO LONG. ASC 20,ITEM LENGTH NOT INTEGRAL WORDS. ASC 20,BAD READ LEVEL OR TERMINATOR. ASC 20,BAD WRITE LEVEL OR TERMINATOR. ASC 20,BAD TERMINATOR - ';' EXPECTED. ASC 20,'NAME:' OR 'END.' EXPECTED. ASC 20,BAD SET NAME OR TERMINATOR. ASC 20,DUPLICATE SET NAME. ASC 20,TOO MANY DATA SETS. ASC 20,'ENTRY:' EXPECTED. ASC 20,UNDEFINED ITEM REFERENCED. ASC 20,ITEM SPECIFIED IN PREVIOUS SET. ASC 20,BAD PATH COUNT OR TERMINATOR. ASC 20,MORE THAN ONE KEY ITEM. ASC 20,BAD SET NAME OR TERMINATOR IN REFERENCE. ASC 20,UNDEFINED SET REFERENCED. ASC 20,REFERENCED SET NOT MASTER. ASC 20,KEY ITEMS NOT OF SAME LENGTH. ASC 20,KEY ITEMS NOT OF SAME TYPE. ASC 20,TOO MANY PATHS. ASC 20,ALL PATHS IN DATA SET USED. ASC 20,MASTER DATA SET LACKS KEY ITEM. ASC 20,AUTOMATIC MASTER MUST HAVE KEY ITEM ONLY ASC 20,ENTRY TOO BIG. ASC 20,'CAPACITY:' EXPECTED. ASC 20,BAD CAPACITY COUNT OR TERMINATOR. ASC 20,DATA BASE HAS NO DATA SETS. ASC 20,MAX ERRORS-SCHEMA PROCESSING TERMINATED. ASC 20,ILLEGAL SPECS. ASC 20,LEVEL 15 WORD NOT SPECIFIED. ASC 20,KEY ITEM DOES NOT HAVE WRITE LEVEL 15. ASC 20,'END' FOUND WHERE NOT EXPECTED. ASC 20,END OF FILE ENCOUNTERED. ASC 20,DUPLICATE SET NAME IN REFERENCE. ASC 20,MISSING PROGRAM SEGMENTS. ASC 20,NOT ENOUGH SPACE TO CREATE ROOT FILE. ASC 20,DUPLICATE LEVEL NAME OR NUMBER. END Q ASMB,R,L,C NAM RMOVE,7 92063-16002 REV. 1621 * * ************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * * PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ************************************************************** * * * LISTING: 92063-19002 * SOURCE: 92063-18002 * RELOC: 92063-16002 * * ************************************************************* * ***************************************************************** * THESE ROUTINES MOVE INFORMATION TO AND FROM THE ROOT TABLE * WHICH IS LOCATED IN THE SPACE AFTER THE LONGEST PROGRAM SEGMENT ***************************************************************** * * * SROOT * * CALLING SEQUENCE: * * CALL SROOT(I,VALUE) * * WHERE: I = OFFSET IN THE TABLE * VALUE = WORD TO BE STORED IN THE TABLE * * * ENT SROOT,RSGET,RSPUT,ROOTA EXT SGET,SPUT,.ENTR,EMESS,EXEC * COM SYSTY,LIST,INPT,LINCT,CARTN,CRDPR,CARD(40),TRAIL COM PRE,CHAR,BUFF(144),INFO(5),FNAM(3),CODE,ERROR COM LGLOB,IGLOB(10),TYPE,RESNO,NORES,LFLAG,RFILE(3) COM LROOT,FWAM,LWAM * ************************************************************ OFFST NOP VALUE NOP SROOT NOP JSB .ENTR DEF OFFST * LDA OFFST,I COMPUTE ADA FWAM ADDRESS STA 1 OF ROOT CMB,INB TABLE ENTRY ADB LWAM SSB ENOUGH ROOM? JMP ERR NO! ADA M1 LDB VALUE,I GET DATA STB 0,I AND STORE IT JMP SROOT,I AND RETURN * ERR JSB EMESS ERROR DEF *+2 DEF .152 JSB EXEC DEF *+2 DEF .6 **************************************************************** * * GET * GET RETRIEVES A CHl  ARACTER FROM ROOT TABLE * * CALLING SEQUENCE: * * CALL RSGET(INDEX,CHRX) * * WHERE: INDX = CHARACTER INDEX IN ROOT TABLE * CHRX = THE CHARACTER * **************************************************************** * INDEX NOP CHRX NOP RSGET NOP JSB .ENTR DEF INDEX * JSB SGET DEF *+4 DEF FWAM,I DEF INDEX,I DEF CHRX,I JMP RSGET,I * **************************************************************** * * PUT * PUT STORES A CHARACTER INTO THE ROOT TABLE * * CALLING SEQUENCE: * * CALL RSPUT(INDX,CHR) * * WHERE INDX = CHARACTER INDEX IN THE ROOT TABLE * CHR = IS THE CHARACTER * **************************************************************** * INDX NOP CHR NOP RSPUT NOP JSB .ENTR DEF INDX * JSB SPUT DEF *+4 DEF FWAM,I DEF INDX,I DEF CHR,I JMP RSPUT,I * **************************************************************** * * ROOTA * ROOTA IS A FUNCTION THAT RETURNS A SPECIFIED WORD OF THE * ROOT TABLE. * * CALLING SEQUENCE: * * A=ROOTA(X) * * WHERE: X = THE WORD OFFSET IN THE ROOT TABLE * **************************************************************** * X NOP ROOTA NOP JSB .ENTR DEF X * LDA X,I ADA FWAM ADA M1 LDA 0,I JMP ROOTA,I VALUE IS IN A REGISTER * M1 DEC -1 .6 DEF 6 .152 DEC 152 END o` ASMB,R,L,C NAM WRITR,7 92063-16002 REV. 1621 * * ************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * * PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ************************************************************** * * * LISTING: 92063-19002 * SOURCE: 92063-18002 * RELOC: 92063-16002 * * ************************************************************* * ***************************************************************** * WRITR WRITES THE ROOT TABLE TO THE DISC * THE ROOT TABLE IS LOCATED IN THE SPACE AFTER THE LONGEST * PROGRAM SEGMENT * * CALLING SEQUENCE: * * CALL WRITR(IERR) * WHERE IERR = FMGR ERROR CODE * ***************************************************************** * * ENT WRITR EXT WRITF,.ENTR * COM SYSTY,LIST,INPT,LINCT,CARTN,CRDPR,CARD(40),TRAIL COM PRE,CHAR,BUFF(144),INFO(5),FNAM(3),CODE,ERROR COM LGLOB,IGLOB(10),TYPE,RESNO,NORES,LFLAG,RFILE(3) COM LROOT,FWAM,LWAM * * IERR NOP WRITR NOP JSB .ENTR DEF IERR * JSB WRITF WRITE OUT THE ROOT FILE DEF *+5 DEF BUFF DEF IERR,I DEF FWAM,I DEF LROOT JMP WRITR,I END Dk +Dp 92063-18003 1840 S 0822 DBBLD SOURCE              H0108 FTN,L,C PROGRAM DBBLD(3,90),92063-16003 REV.1840 780717 C C C************************************************************* C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * C RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * C PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * C OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C************************************************************* C C C LISTING: 92063-19003 C SOURCE: 92063-18003 C RELOC: 92063-16003 C C C************************************************************ C C*********************************************************************** C DBBLD LOADS A DATA BASE FROM CARDS,MAG TAPE,PAPER TAPE, OR DISK FILE C CALLING SEQUENCE C :RU,DBBLD,P1,P2,P3,P4,P5 C WHERE C P1=THE LOGICAL UNIT NUMBER OF THE CONSOLE, DEFAULT=1 C P2=THE LOGICAL UNIT NUMBER OF THE LIST DEVICE, DEFAULT=6 C P3=1 FOR ONLY AN ERROR CHECK C --PROCESS ALL DATA C =3 TO STORE DATE IN A DATA BASE C --PROCESS ALL DATA C =11 FOR ONLY AN ERROR CHECK - STOP PROCESSING ON C ENCOUNTERING FIRST ERROR C =13 STORE DATA ON A DATA BASE - STOP PROCESSING C ON ENCOUNTERING AN ERROR C DEFAULT FOR P3 = 3 C P4=0 IF THE USER WISHED A LISTING C =1 IF HE DOES NOT WANT A LISTING C DEFAULT FOR P4 = 0 C P5=THE # OF COLUMNS USED FOR DATA ON THE INPUT RECORD C (USED WHEN INPUT LU IS NOT DISK) DEFAULT=72 C C C EACH DATA SET MUST BE PROCEEDED WITH THIS CARD: C $SET: C WHERE $ IS IN COLUMN1 AND THE NAME OF THE DATA SET C THE DATA BASE MUST BE FOLLOWED BY THIS CARD: C $END C WHERE $ IS IN COLUMN 1 C THE DATA BASE MUST BE PRECEEDED BY THIS CARD: C ,; C OR THIS CARD: C ,,; C EACH $SET CARD IS FOLLOWED BY THE RECORDS TO BE PUT IN THAT SET C EACH RECORD MUST START ON A NEW CARD C U-TYPE ITEMS MUST BE CONTAINED IN THE EXACT NUMBER OF COLUMNS C SPECIFIED IN THE SCHEMA;ITEMS ARE CONCATONATED C I-TYPE ITEMS MUST BE RIGHT-JUSTIFIED IN 5 COLUMNS C R-TYPE ITEMS MUST BE RIGHT-JUSTIFIED IN 10 COLUMNS AS INTEGERS C RECORDS ARE PUT IN P5 COLUMNS; REMAINING COLS CAN BE C USED FOR SEQUENCING C IF AN ITEM WERE TO RUN PAST THE LAST SPECIFIED COLUMN, C IT MUST INSTEAD START ON THE NEXT RECORD C IF A U-TYPE ITEM IS SPECIFIED MORE THAN P5 COLS IN THE SCHEMA, C IT MUST START ON A NEW CARD, BE WRITTEN THRU P5 COLS C AND BE CONTINUED ON THE NEXT CARD,(AND THE NEXT). C NULL ITEMS MUST BE REPRESENTED AS ALL BLANKS C*********************************************************************** C C INTEGER ERROR,P,CARD,CONWD,COL,BUFPR,TRAIL,BUFF,FNAM,SECT INTEGER FWAM,LWAM,CHAR,BATCH,SYSTY,SCODE,BPUT INTEGER CHAR,PRE INTEGER BBLD INTEGER CONRD INTEGER QTFLG COMMON FWAM,LWAM,ERROR,P(5),CARD(255),LOG,CONWD,COL,BUFPR COMMON TRAIL,BUFF(144) COMMON PRE,FNAM(3),SECT COMMON L,CHAR COMMON QTFLG DIMENSION BBLD(3) DATA BBLD/2HBB,2HLD,2H / DATA I8/8/ C C C CALL FIRST SEGMENT OF DATA BASE BUILD C CALL RMPAR(P) CALL EXEC(I8,BBLD) CALL AIDCB END END$ FTN,L,C PROGRAM BBLD(5,90) C C C************************************************************* C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * C RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * C PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * C OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C************************************************************* C C C LISTING: 92063-19003 C SOURCE: 92063-18003 C RELOC: 92063-16003 C C C************************************************************ C C*********************************************************************** C DBBLD LOADS A DATA BASE FROM CARDS,MAG TAPE,PAPER TAPE, OR DISK FILE C CALLING SEQUENCE C :RU,DBBLD,P1,P2,P3,P4,P5 C WHERE C P1=THE LOGICAL UNIT NUMBER OF THE CONSOLE C P2=THE LOGICAL UNIT NUMBER OF THE LIST DEVICE C P3=1 FOR ONLY AN ERROR CHECK C --PROCESS ALL DATA C =3 TO UPDATE A DATA BASE C --PROCESS ALL DATA C =11 FOR ONLY AN ERROR CHECK - STOP PROCESSING ON C ENCOUNTERING FIRST ERROR C =13 UPDATE A DATA BASE - STOP PROCESSING ON ENCOUNTERING C FIRST ERROR C P4=0 IF THE USER WISHED A LISTING C =1 IF HE DOES NOT WANT A LISTING C P5=THE # OF COLUMNS USED FOR DATA ON THE INPUT RECORD C (USED WHEN P2 IS NOT DISK) DEFAULT=72 C C C EACH DATA SET MUST BE PROCEEDED WITH THIS CARD: C $SET: C WHERE $ IS IN COLUMN1 AND THE NAME OF THE DATA SET C THE DATA BASE MUST BE FOLLOWED BY THIS CARD: C $END C WHERE $ IS IN COLUMN 1 C THE DATA BASE MUST BE PRECEEDED BY THIS CARD: C ,; C OR THIS CARD: C ,,; C EACH $SET CARD IS FOLLOWED BY THE RECORDS TO BE PUT IN THAT SET C EACH RECORD MUST START ON A NEW CA.RD C U-TYPE ITEMS MUST BE CONTAINED IN THE EXACT NUMBER OF COLUMNS C SPECIFIED IN THE SCHEMA;ITEMS ARE CONCATONATED C I-TYPE ITEMS MUST BE RIGHT-JUSTIFIED IN 5 COLUMNS C R-TYPE ITEMS MUST BE RIGHT-JUSTIFIED IN 10 COLUMNS AS INTEGERS C RECORDS ARE PUT IN P5 COLUMNS; REMAINING COLS CAN BE C USED FOR SEQUENCING C IF AN ITEM WERE TO RUN PAST THE LAST SPECIFIED COLUMN, C IT MUST INSTEAD START ON THE NEXT RECORD C IF A U-TYPE ITEM IS SPECIFIED MORE THAN P5 COLS IN THE SCHEMA, C IT MUST START ON A NEW CARD, BE WRITTEN THRU P5 COLS C AND BE CONTINUED ON THE NEXT CARD,(AND THE NEXT). C NULL ITEMS MUST BE REPRESENTED AS ALL BLANKS C*********************************************************************** C C INTEGER ERROR,P,CARD,CONWD,COL,BUFPR,TRAIL,BUFF,FNAM,SECT INTEGER FWAM,E1,E2,E3,E4,E5,CHAR,SYSTY,SCODE,BPUT INTEGER CHAR,PRE INTEGER BCLOS INTEGER CONRD INTEGER QTFLG DIMENSION E1(16),M1(8),E2(10),E4(11),IBASE(3),SCODE(3),ILEVL(3) DIMENSION ISEGN(10),E3(8),E5(11) EQUIVALENCE (ISEGN(5),BPUT),(ISEGN(8),BCLOS) COMMON FWAM,LWAM,ERROR,P(5),CARD(255),LOG,CONWD,COL,BUFPR COMMON TRAIL,BUFF(144) COMMON PRE,FNAM(3),SECT COMMON L,CHAR COMMON QTFLG DATA E1/2HWH,2HAT,2H I,2HS ,2HTH,2HE ,2HIN,2HPU,2HT ,2HLO,2HGI 1,2HCA,2HL ,2HUN,2HIT,2H? / DATA M1/2HEN,2HTE,2HR ,2HFI,2HLE,2H N,2HAM,2HE./ DATA E2/2HIL,2HLE,2HGA,2HL ,2HLO,2HGI,2HCA,2HL ,2HUN,2HIT/ DATA E5/2HIL,2HLE,2HGA,2HL ,2HSE,2HCU,2HRI,2HTY,2H C,2HOD,2HE / DATA E4/2HWH,2HAT,2H I,2HS ,2HSE,2HCU,2HRI,2HTY,2H C,2HOD,2HE?/ DATA E3/2HFI,2HLE,2H N,2HOT,2H O,2HPE,2HNE,2HD / DATA ICOMA,ISEMI/54B,73B/ DATA I1,I2,I201,I202,I203,I218/1,2,201,202,203,218/ DATA N16,N20,N32/-16,-20,-32/ DATA I3/3/ DATA I8/8/ DATA N1,N2/-1,-2/ DATA N6/-6/ DATA IBLNK/2H g{ / C SEGMENT NAME LIST (DO NOT MODIFY THE FOLLOW 3 STMTS) DATA ISEGN/3,2HBB,2HLD,2H ,2HBP,2HUT,2H ,2HBC 2,2HLO,2HS / C C C IF (P(1).EQ.0) P(1)=1 IF (P(2).EQ.0) P(2)=6 IF (P(3).EQ.0) P(3)=1 C SET P(5) DEFAULT IF(P(5).EQ.0) P(5)=72 C IF MODE IS GT THAN 10, SET QTFLG TO 0 TO STOP ON ENCOUNTERING C ERRORS; ELSE SET TO 1 QTFLG=0 IF (P(3).LT.10) QTFLG=1 IF (P(3).GT.10)P(3)=P(3)-10 IF ((P(3).EQ.1).OR.(P(3).EQ.3)) GOTO 99 GOTO 111 99 IF ((P(5).LT.1).OR.(P(5).GT.510))GOTO 111 C SET UP INPUT AND LIST DEVICES IF(P(1).EQ.0) P(1)=1 IF(P(2).EQ.0) P(2)=6 SYSTY=P(1) C GET INPUT LOGICAL UNIT NUMBER CALL REIO(I2,SYSTY,E1,N32) CALL REIO(I1,SYSTY+400B,CHAR,N2) CALL CATI(CHAR,1,2,CONWD,ISTAT) IF (ISTAT.EQ.0) GOTO 101 CALL REIO(I2,SYSTY,E2,N20) STOP 101 IF (CONWD.EQ.2) GO TO 102 GO TO 104 C INPUT FROM DISK,GET FILE NAME, CHECK IF FILE PRESENT 102 CALL REIO(I2,SYSTY,M1,N16) P(1)=2 FNAM(1)=IBLNK FNAM(2)=IBLNK FNAM(3)=IBLNK CALL REIO (I1,SYSTY+400B,FNAM,N6) CALL REIO(I2,SYSTY,E4,11) CALL REIO(I1,SYSTY+400B,SCODE,-6) CALL CATI(SCODE,1,6,ISC,ISTAT) CALL OPEN(BUFF,IERR,FNAM,0,ISC) IF (IERR.GE. 0) GOTO 104 CALL REIO(I2,SYSTY,E3,N16) CALL ERROT(IERR) STOP C INITIALIZE ERROR FLAG 104 ERROR=0 C SKIP TO TOP OF PAGE ISWD=1100B+P(2) CALL EXEC(I3,ISWD,N1) C GET FIRST CARD CALL CRDIM C GET DATA BASE NAME CALL KEYWD(IBASE) C IF NEXT CHAR NOT COMMA PRINT ERROR 201, C "BAD DATA BASE NAME OR TERMINATOR" IF (CHAR.EQ.ICOMA) GO TO 105 CALL ERROT(I201) STOP C GET SECURITY CODE AND CONVERT TO INTEGER 105 CALL KEYWD(SCODE) ISTAT=0 CALL CATI(SCODE,I1,(L-1),ISCOD,ISTAT) IF (ISTAT.GE.0) GO TO 106 C  IF ERROR IN SECURITY CODE, WRITE ERR NO. 202, C "BAD SECURITY CODE OR TERMINATOR" CALL ERROT(I202) STOP C IF NEXT CHAR COMMA, GET LEVEL WORD, ELSE SET ILEVL TO 0 106 ILEVL(3)=0 IF (CHAR.NE.ICOMA) GO TO 107 CALL KEYWD(ILEVL) C OPEN THE DATA BASE 107 MODE=P(3) CALL DBINT(IBASE,ISCOD,ISEGN,ISTAT) IF (ISTAT.NE.0) GOTO 110 CALL DBOPN(IBASE,ILEVL,ISCOD,MODE,ISTAT) C IF ERROR IN DBOPN, PUT OUT APRROPRIATE ERR NO. AND EXIT IF (ISTAT.NE.0) GO TO 110 C GET NEXT CARD. IF NOT "$SET:", WRITE ERROR NO. 203 AND EXIT C "NON-EXISTANT DATA BASE" IVAL=0 CALL SETD(IVAL) IF (IVAL.EQ.0) GO TO 109 CALL ERROT(I203) CALL EXEC(I8,BCLOS) C CALL BPUT, NEXT SEGMENT OF DBILD, TO PROCESS DATA BASE 109 CALL EXEC(I8,BPUT) 110 CALL ERROT(ISTAT) STOP 111 CALL ERROT(I218) END END$ oFTN4,L,C PROGRAM BPUT(5,90) C C C************************************************************* C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * C RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * C PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * C OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C************************************************************* C C C LISTING: 92063-19003 C SOURCE: 92063-18003 C RELOC: 92063-16003 C C C************************************************************ C C*********************************************************************** C BPUT IS THE SEGMENT OF DBBLD WHICH READS THE DATA RECORDS AND C PUTS THEM IN THE DATA BASE C*********************************************************************** C INTEGERS AND REALS ARE CONVERTED FROM ASCII C INTEGER ERROR,P,CARD,CONWD,COL,BUFPR,TRAIL,BUFF,FNAM,SECT INTEGER PRE,FWAM,LWAM INTEGER SETNM,S,SETNO,COLBG,TYPE,RTYPE,COLED,BLANK,BUF,BPTR INTEGER PUTBF INTEGER UTYPE,BCLOS INTEGER TTYPE INTEGER CHAR,QTFLG DIMENSION SETNM(3),IBUF(2),ITEM(129),INFO(9),TYPE(127),LENTH(127) DIMENSION M2(24),IA(3),BCLOS(3) DIMENSION BUF(511),PUTBF(512) DIMENSION NUM(40) COMMON FWAM,LWAM,ERROR,P(5),CARD(255),LOG,CONWD,COL,BUFPR COMMON TRAIL,BUFF(144) COMMON PRE,FNAM(3),SECT COMMON L,CHAR,QTFLG DATA UTYPE/125B/ DATA N48,N2,N72/-48,-2,-72/ DATA N80/-80/ DATA IBLNK/2H / DATA S/2HS / DATA I1,I2,I4,I5,I8,I10,I72/1,2,4,5,8,10,72/ DATA I204,I206,I207/204,206,207/ DATA IB/2HI / DATA ITYPE/111B/ DATA RTYPE/122B/ DATA M2/2H ,2H ,2H ,2H ,2H I,2HN ,2HCO,2HLU,2HMN,2HS ,2H , 12H ,2H T,2HHR,2HOU,2HGH,2H ,2H ,2H ,2H I,2HS ,2HTY,2HPE,2H / DATA BLANK/40B/ DATA NUM/2H12,2H34,2H56,2H78,2H90, 12H12,2H34,2H56,2H78,2H90, 1L72H12,2H34,2H56,2H78,2H90, 12H12,2H34,2H56,2H78,2H90, 12H12,2H34,2H56,2H78,2H90, 12H12,2H34,2H56,2H78,2H90, 12H12,2H34,2H56,2H78,2H90, 12H12,2H34,2H56,2H78,2H90/ DATA BCLOS/2HBC,2HLO,2HS / C GET 100 COL=6 CALL KEYWD(SETNM) C GET DATA SET NUMBER CALL DBINF (S,I5,SETNM,IBUF) C IF AN ERROR IN DBINF CALL,WRITE DBINF ERROR NO AND C SCAN TO NEXT $SET: OR $END CARD IF (IBUF(1).EQ.0) GO TO 103 IERNO=IBUF(1) 101 CALL ERROT(IERNO) QTFLG=-1 GO TO 122 C IF LIST OPTION ON, SKIP A LINE ON LISTING DEVICE 103 IF(P(4).EQ.0) CALL REIO(I2,P(2),IBLNK,N2) C GET DATA ITEM COUNT AND DATA ITEM NUMBERS IN ITEM SETNO=IBUF(2) CALL DBINF(IB,I1,SETNO,ITEM) IF (ITEM(1).EQ.0) GO TO 1031 IERNO=ITEM(1) GO TO 101 C ICNT IS DATA ITEM COUNT 1031 ICNT=ITEM(2) C INITIALIZE PTR TO BEGINNING OF NEXT DATA ITEM ON RECORD COLBG=1 C START LOOP TO GET TYPE AND LENGTH OF EACH ITEM AND C CALCULATE BEGINNING AND ENDING COLUMNS OF EACH ITEM AND C PRINT THIS INFORMATION DO 107 I=1,ICNT C GET INFO ABOUT ITEM AND PUT IN INFO (DATA ITEM NO IS ITMNO) ITEM(I+2)=-ITEM(I+2) ITMNO=ITEM(I+2) CALL DBINF(IB,I2,ITMNO,INFO) IF (INFO(1).EQ.0) GO TO 1032 IERNO=INFO(1) GO TO 101 C GET ITEM TYPE AND ITEM LENGTH 1032 CALL SGET(INFO,I10,TYPE(I)) LENTH(I)=INFO(7)*2 IF (TYPE(I).EQ.ITYPE)LENTH(I)=5 IF (TYPE(I).EQ.RTYPE)LENTH(I)=10 C CALCULATE BEGINNING AND ENDING COLUMNS OF EACH ITEM COLED=COLBG+LENTH(I)-1 C ITEM ON SAME CARD? IF (COLED.LE.P(5)) GO TO 104 C START ITEM ON NEW CARD COLBG=1 IF (LENTH(I).GT.P(5)) GO TO 1033 COLED=LENTH(I) GO TO 104 1033 COLED=MOD(LENTH(I),P(5)) IF (COLED.EQ.0) COLED=P(5) C %] IF LIST TURNED ON WRITE ITEM NAMES AND THEIR COLUMNS 104 IF(P(4).NE.0) GO TO 105 M2(2)=INFO(2) M2(3)=INFO(3) M2(4)=INFO(4) CALL CITA(COLBG,IA) M2(11)=IA(2) M2(12)=IA(3) CALL CITA(COLED,IA) M2(18)=IA(2) M2(19)=IA(3) TTYPE=TYPE(I) CALL SPUT(TTYPE,I1,BLANK) M2(24)=TTYPE CALL REIO(I2,P(2),M2,N48) C INCREMENT COLUMN BEG PTR TO POINT TO BEG COL OF NEXT ITEM 105 IF (COLED.EQ.P(5)) GO TO 106 COLBG=COLED+1 GO TO 107 106 COLBG=1 107 CONTINUE C IF LIST ON SKIP A LINE AND WRITE COL NOS ACROSS PAGE IF (P(4).NE.0) GO TO 108 CALL REIO(I2,P(2),IBLNK,N2) CALL REIO(I2,P(2)+200B,NUM,N80) C GET NEXT CARD 108 IVAL=2 CALL SETD(IVAL) C IF $SET: OR $END WRITE ERR NO 204 C "CARD PRESENT WHERE RECORD EXPECTED" IF (IVAL.EQ.2) GO TO 110 109 CALL ERROT(I204) GO TO 121 C INITIALIZE DBPUT BUFFER PTR 110 BPTR=1 IEFLG=0 C START LOOP TO ENTER EACH ITEM IN DBPUT BUFFER,BUF DO 119 I=1,ICNT C CALCULATE LAST COLUMN OF ITEM COLED=COL+LENTH(I)-1 C IF ITEM STARTS ON A NEW CARD,READ NEXT CARD AND CALCULATE C NEW ENDING COLUMN. IF ITEM>P(5) COLS,MOVE THE WHOLE CARD C INTO DBPUT BUFFER,BUF,(AND NEXT CARD) LEN=LENTH(I) IF (COLED.LE.P(5)) GO TO 113 IVAL=2 111 CALL SETD(IVAL) IF (IVAL.NE.2) GO TO 109 IF (LEN.GT.P(5)) GO TO 112 COLED=LEN GO TO 113 112 CALL SMOVE(CARD,I1,P(5),BUF,BPTR) BPTR=BPTR+P(5) LEN=LEN-P(5) GO TO 111 C IF ITEM TYPE IS U MOVE ITEM TO BUF AND UPDATE BPTR (BUF PTR) 113 IF (TYPE(I).NE.UTYPE) GO TO 114 CALL SMOVE(CARD,COL,COLED,BUF,BPTR) BPTR=BPTR+LEN e GO TO 118 C IF ITEM TYPE IS INTEGER,CONVERT TO INTEGER,MOVE TO BUF, C AND INCREMENT BPTR 114 IF (TYPE(I).NE.ITYPE) GO TO 116 C CONVERT ZONE CHAR TO INTEGER,GET SIGN IN NOZ CALL SZONE(CARD,COLED,I4,NOZ) CALL CATI(CARD,COL,LENTH(I),INT,ISTAT) IF (ISTAT.GE.0) GO TO 115 C IF ILLEGAL WRITE ERROR NO 206 C "NON-NUMERIC INTEGER IN FIELD" CALL ERROT(I206) IF (QTFLG.EQ.0) GO TO 122 IEFLG=1 GO TO 1151 C IF SIGN NEGATIVE, COMPLEMENT INTEGER 115 IF (NOZ.EQ.2) INT=-INT 1151 CONTINUE CALL SMOVE(INT,I1,I2,BUF,BPTR) BPTR=BPTR+2 GO TO 118 C CONVERT TYPE REAL TO A REAL NUMBER,MOVE TO BUF,INCREMENT BPTR 116 REAL=CATR(CARD,COL,COLED,ISTAT) IF (ISTAT.GE.0) GO TO 117 C IF ILLEGAL REAL, WRITE ERROR NO. 207 C "NON-NUMERIC IN REAL FIELD" CALL ERROT(I207) IF (QTFLG.EQ.0) GO TO 122 IEFLG=1 117 CALL SMOVE(REAL,I1,I4,BUF,BPTR) BPTR=BPTR+4 C SET UP BEGINNING COLUMN OF NEXT ITEM 118 COL=COLED+1 119 CONTINUE C*****IF UPDATE OR CREATE IS SPECIFIED AND THERE ARE NO ERRORS, C*****PUT RECORD IN DATA BASE IICNT=ICNT+2 IF (P(3).EQ.1) GO TO 120 IF (IEFLG.EQ.1) GO TO 120 CALL DBPUT(SETNO,ISTAT,ITEM(2),BUF,PUTBF) C IF ERROR IN PUTTING WRITE DBPUT ERROR NO. IF (ISTAT.EQ.0) GO TO 120 CALL ERROT(ISTAT) IF (QTFLG.EQ.0) GO TO 122 C GET NEXT CARD. IF NOT $SET: OR $END GO TO ENTER NEXT RECORD 120 IVAL=2 CALL SETD(IVAL) IF (IVAL.EQ.2) GO TO 110 C IF $SET: GO TO PROCESS NEXT SET 121 IF (IVAL.EQ.0) GO TO 100 C IF $END OR AN ERROR WAS ENCOUNTERED WITH P C POSITIVE MODE, CALL NEXT SEGMENT TO CLOSE DATA SET 122 CONTINUE CALL EXEC(I8,BCLOS) END END$ FTN4,L,C PROGRAM BCLOS(5,90) C C C************************************************************* C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * C RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * C PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * C OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C************************************************************* C C C LISTING: 92063-19003 C SOURCE: 92063-18003 C RELOC: 92063-16003 C C C************************************************************ C C*********************************************************************** C BCLOS PERFORMS TERMINATION ACTIONS C THE DATA BASE IS CLOSED C IF NO ERRORS OCCURRED, THE MESSAGE IS PRINTED OUT: C DATA BASE SUCCESSFULLY BUILT OR UPDATED C*********************************************************************** INTEGER ERROR,P,CARD,CONWD,COL,BUFPR,TRAIL,BUFF,FNAM,SECT INTEGER PRE,FWAM,LWAM INTEGER CHAR,QTFLG DIMENSION M3(11),M4(22),M5(22),IA(3),M6(24),M7(36),M8(22),M9(29) COMMON FWAM,LWAM,ERROR,P(5),CARD(255),LOG,CONWD,COL,BUFPR COMMON TRAIL,BUFF(144) COMMON PRE,FNAM(3),SECT COMMON L,CHAR,QTFLG DATA I0,I1/0,1/ DATA I2,I208/2,208/ DATA N22,N40,N44,N48,N58,N72/-22,-40,-44,-48,-58,-72/ DATA M3/2H N,2HUM,2HBE,2HR ,2HOF,2H E,2HRR,2HOR,2HS:,2H ,2H / DATA M4/2H D,2HAT,2HA ,2HBA,2HSE,2H S,2HUC,2HCE,2HSS,2HFU, 12HLL,2HY ,2HBU,2HIL,2HT ,2HOR,2H U,2HPD,2HAT,2HED/ DATA M5/2H F,2HAT,2HAL,2H E,2HRR,2HOR,2H. ,2HTH,2HE ,2HDA,2HTA, 12H B,2HAS,2HE ,2HHA,2HS ,2HBE,2HEN,2H P,2HUR,2HGE,2HD./ DATA M6/2H O,2HNL,2HY ,2HER,2HRO,2HR-,2HFR,2HEE,2H E,2HNT,2HRI, 12HES,2H W,2HER,2HE ,2HPU,2HT ,2HIN,2H D,2HAT,2HA ,2HBA,2HSE,2H. / DATA M7/2H O,2HNL,2HY ,2HTH,2HOS,2HE ,2HEN,2HTR,2HIE,2HS , 12HEN,2HCO,2HUN,2HTE,2HRE,2HD ,2HBE,2HFO,2HRE,2H T,2HHE,2H E, 12HRR,2HOR,2H W,2HER,2HE ,2HPU,2H  T ,2HIN,2H D,2HAT,2HA , 12HBA,2HSE,2H. / DATA M8/2H C,2HAN,2HNO,2HT ,2HPR,2HOC,2HES,2HS ,2HTH,2HIS,2H S, 12HET,2H. ,2HON,2HLY,2H T,2HHO,2HSE,2H E,2HNT,2HRI,2HES/ DATA M9/2H E,2HNC,2HOU,2HNT,2HER,2HED,2H B,2HEF,2HOR,2HE ,2HTH, 12HIS,2H E,2HRR,2HOR,2H W,2HER,2HE ,2HPU,2HT ,2HIN,2H T,2HHE, 12H D,2HAT,2HA ,2HBA,2HSE,2H. / C WRITE "NUMBER OF ERRORS:" ERROR CALL CITA(ERROR,IA) M3(10)=IA(2) M3(11)=IA(3) CALL REIO(I2,P(2),M3,N22) C CLOSE THE DATA BASE 103 CALL DBCLS(I0,ISTAT) IF (ISTAT.NE.0) GO TO 101 IF (P(3).EQ.1) GOTO 110 IF (ERROR.NE.0) GO TO 105 C WRITE "DATA BASE SUCCESSFULLY BUILT OR UPDATED" CALL REIO(I2,P(2),M4,N40) GOTO 110 C IF AN ERROR IN DBCLS,WRIT DBCLOS ERROR NO. AND PURGE DATA BASE 101 CALL ERROT(ISTAT) C PURGE DATA BASE 102 CALL DBCLS(I1,ISTAT) IF (ISTAT.NE.0) GO TO 107 C WRITE "FATAL ERROR - THE DATA BASE HAS BEEN PURGED" CALL REIO(I2,P(2),M5,N22) GOTO 110 C IF AN ERROR IN DBCLS, WRITE ERROR NO 208 C "UNABLE TO PURGE DATA BASE" 107 CONTINUE CALL ERROT(I208) GOTO 110 105 IF (QTFLG.EQ.0) GO TO 106 IF (QTFLG.EQ.-1) GO TO 108 C WRITE "ONLY ERROR-FREE ENTRIES WERE PUT IN DATA BASE" CALL REIO(I2,P(2),M6,N48) GOTO 110 C WRITE "ONLY THOSE ENTRIES ENCOUNTERED BEFORE THE ERROR WERE C PUT IN THE DATA BASE" 106 CALL REIO(I2,P(2),M7,N72) GOTO 110 C WRITE "CANNOT PROCESS THIS SET. ONLY THOSE ERROR-FREE ENTRIES C ENCOUNTERED BEFORE THIS ERROR WERE PUT IN THE DATA BASE" 108 CALL REIO(I2,P(2),M8,N44) CALL REIO(I2,P(2),M9,N58) 110 CALL CLOSE(BUFF) STOP END END$ ʟ FTN4,L,C SUBROUTINE SETD(IVAL) C C C************************************************************* C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * C RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * C PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * C OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C************************************************************* C C C LISTING: 92063-19003 C SOURCE: 92063-18003 C RELOC: 92063-16003 C C C************************************************************ C C*********************************************************************** C SETD GETS THE NEXT CARD IMAGE AND C RETURNS IVAL=0 IF '$SET:' FOUND STARTING IN COL 1 C IVAL=1 IF '$END' FOUND STARTING IN COL 1 C C IF IVAL=1 SCANS TO THE NEXT '$SET:' OR '$END' CARD C AND SETS IVAL AS ABOVE C IF IVAL=0 PRINTS ERROR MESSAGE IF NEITHER '$SET:' OR '$END' C IS FOUND ON NEXT CARD, AND C SCANS TO THE NEXT '$SET:' OR '$END' CARD C AND SETS IVAL AS ABOVE. C IF IVAL=2 AND NEITHER '$SET:' OR '$END' IS PRESENT ON THE C NEXT CARD, IVAL IS SET TO 2. C C CALLING SEQUENCE C CALL SETD(IVAL) C*********************************************************************** C C INTEGER ERROR,P,CARD,CONWD,COL,BUFPR,TRAIL,BUFF,PRE,FNAM,SECT INTEGER FWAM,LWAM,PRINT,SET,END INTEGER PRE DIMENSION SET(3),END(2) COMMON FWAM,LWAM,ERROR,P(5),CARD(255),LOG,CONWD,COL,BUFPR,TRAIL COMMON BUFF(144) COMMON PRE,FNAM(3),SECT DATA I1,I4,I5,I205/1,4,5,205/ DATA SET/2H$S,2HET,2H: / DATA END/2H$E,2HND/ IERR=0 C INITIALIZE PRINT FLAG PRINT=0 C GET NEXT CARD 103 CALL CRDIM C IF "$SET:", SET IVAL TO 0 AND RETURN IF ( JSCOM(CARD,I1,I5,SET,I1,IERR).NE.0) GO TO 101 b  IVAL=0 RETURN C IF "$END", SET IVAL TO 1 AND RETURN 101 IF ( JSCOM(CARD,I1,I4,END,I1,IERR).NE.0 ) GO TO 102 IVAL=1 RETURN C IF IVAL=2, NEITHER FOUND, RETURN 102 IF (IVAL.EQ.2) RETURN C SCAN TO NEXT CARD AND.CHECK AGAIN C IF IVAL=0 AND FIRST TIME AROUND, PRINT ERROR MESSAGE 205, C "$SET: OR $END EXPECTED." IF (IVAL.NE.0) GO TO 103 IF (PRINT.NE.0) GO TO 103 CALL ERROT(I205) PRINT=1 GO TO 103 END END$ 9@ FTN4,L,C SUBROUTINE KEYWD(IARAY) C C C************************************************************* C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * C RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * C PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * C OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C************************************************************* C C C LISTING: 92063-19003 C SOURCE: 92063-18003 C RELOC: 92063-16003 C C C************************************************************ C C*********************************************************************** C KEYWD SCANS A DATA BASE NAME, SECURITY CODE, OR SET NAME C AND ENTERS IT IN IARAY, LEFT-JUSTIFIED,BLANK-FILLED,IN A2 C SCANS PAST ALL LEADING BLANKS C TERMINATES AT THE FIRST SEMICOLON,COMMA,OR BLANK C SETS L TO LENGTH C SETS COL TO POINT TO TERMINATING COMMA,SEMICOLON,OR BLANK C CALLING SEQUENCE C CALL KEYWD(IARAY) C*********************************************************************** C C INTEGER CARD,P,CONWD,COL,BUFPR,TRAIL,BUFF,PRE,FNAM,SECT,CHAR,ERROR INTEGER FWAM,LWAM DIMENSION IARAY(3) COMMON FWAM,LWAM,ERROR,P(5),CARD(255),LOG,CONWD,COL,BUFPR,TRAIL COMMON BUFF(144) COMMON PRE,FNAM(3),SECT COMMON L,CHAR DATA IBLNK,ICOMA,ISEMI,I1,I6/40B,54B,73B,1,6/ C BLANK-FILL IARAY CALL SFILL(IARAY,I1,I6,IBLNK) C SCAN PAST LEADING BLANKS C CHAR=CARD(COL) 101 CALL SGET(CARD,COL,CHAR) COL=COL+1 IF (CHAR.EQ.IBLNK) GO TO 101 C HAVE FOUND FIRST NON-BLANK, ENTER GLOB IN IARAY L=1 C COMMA, SEMICOLON OR BLANK? 102 IF ( (CHAR.EQ.ICOMA).OR.(CHAR.EQ.ISEMI).OR.(CHAR.EQ.IBLNK) )RETURN C IARAY(L)=CHAR CALL SPUT(IARAY,L,CHAR) L=L+1 C CHAR=CARD(COL) CALL SGET(CARD,COL,CHAR) COL=COL+1 C GLOB TOO LONG? IF SO, STOP AT 6 IF (L.GT.6) RETURN GO TO 10}  2 END END$ - FTN4,L,C SUBROUTINE CRDIM C C C************************************************************* C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * C RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * C PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * C OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C************************************************************* C C C LISTING: 92063-19003 C SOURCE: 92063-18003 C RELOC: 92063-16003 C C C************************************************************ C C*********************************************************************** C CRDIM GETS A CARD IMAGE FROM CARDS, PAPER TAPE, MAG TAPE, OR DISK FILE C AND RETURNS IT IN CARD. C COL IS SET TO 1. C IF THE LIST OPTION IS TURNED ON, IT LISTS CARD ON THE LIST DEVICE. C PARAMETERS SET BY CALLER: C P(1)=INPUT DEVICE # C P(2)=DEVICE # OF LISTING DEVICE C P(4)=0 IF LIST OPTION REQUESTED C FNAM CONTAINS DISK FILE NAME IN A2 IF P(1)=2 C CALLING SEQUENCE C CALL CRDIM C*********************************************************************** C C INTEGER CARD,P,CONWD,COL,BUFPR,TRAIL,BUFF,PRE,FNAM,SECT,ERROR INTEGER FWAM,LWAM,OUTCHR DIMENSION IOBUF(41),IAB(2) EQUIVALENCE (AB,IA,IAB(1)),(IB,IAB(2)) COMMON FWAM,LWAM,ERROR,P(5),CARD(255),LOG,CONWD,COL,BUFPR,TRAIL COMMON BUFF(144) COMMON PRE,FNAM(3),SECT DATA IBLNK/2H / DATA I1/1/ DATA I2/2/ DATA I13/13/ DATA I209/209/ C BLANK-FILL CARD BUFFER DO 100 IMOVE=1,255 100 CARD(IMOVE)=IBLNK C INPUT FROM DISK? IF (P(1).EQ.2) GO TO 104 C READ A RECORD FROM CARDS, PAPER TAPE, MAG TAPE INTO CARD 101 NCHAR=-P(5) AB = REIO(I1,CONWD+400B,CARD,NCHAR) NCHAR=IAB(2) LOG=NCHAR CALL EXEC(I13,CONWD,ISTAT) C END OF FILE? IF (IAND(ISTAT,40B).NE.0) GO TO 108 C IF LIST OPTION TURNED ON, LIST CARD ON LIST DEVICE 10.p  2 IF (P(4).NE.0) GO TO 103 C MOVE CARD IMAGE TO OUTPUT BUFFER AND LIST LINE BY LINE ICHAR=1 1020 JCHAR=NCHAR IF (NCHAR.GT.80) JCHAR=80 OUTCHR=JCHAR CALL SMOVE(CARD,ICHAR,(ICHAR+JCHAR-1),IOBUF,I1,OUTCHR) OUTCHR=-OUTCHR CALL REIO(I2,P(2)+200B,IOBUF,OUTCHR) IF (NCHAR.LE.80) GO TO 103 NCHAR=NCHAR-80 ICHAR=ICHAR+80 GO TO 1020 C INITIALIZE COLUMN POINTER 103 COL=1 RETURN C GET CARD IMAGE FROM DISK 104 CALL READF(BUFF,IERR,CARD,(P(5)/2)+1,ILEN) NCHAR=ILEN*2 LOG=NCHAR IF (IERR .EQ.0) GOTO 102 C IF ERROR DETECTED WRITE ERROR MESSAGE CALL ERROT(IERR) STOP 108 CALL ERROT(I209) STOP END END$ Y FTN4,L,C SUBROUTINE ERROT(N) C C C************************************************************* C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * C RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * C PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * C OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C************************************************************* C C C LISTING: 92063-19003 C SOURCE: 92063-18003 C RELOC: 92063-16003 C C C************************************************************ C C*********************************************************************** C ERROT GENERATES THE ERROR MESSAGE:*****ERROR NO. XXXXXX C WHERE XXX IS THE ERROR MESSAGE NO. C IF LIST OPTION IS TURNED OFF (P(4)=0), IT LISTS THE ERROR LINE C IT INCREMENTS THE ERROR COUNT,ERROR C CALLING SEQUENCE C CALL ERROT(N) C N IS THE MESSAGE NO. C*********************************************************************** C C INTEGER FWAM,LWAM,ERROR,P,CARD INTEGER OUTCHR DIMENSION MESS(10),IA(3) DIMENSION IOBUF(41) COMMON FWAM,LWAM,ERROR,P(5),CARD(255),LOG DATA I2,N20/2,-20/ DATA MESS/2H *,2H**,2H**,2HER,2HRO,2HR ,2HNO,2H. / C IF END OF FILE DO NOT LIST IF (N.LT.0) N=-N IF (N.LT.100) GOTO 101 IF (N.EQ.209) GO TO 101 C IF LISTING TURNED OFF, LIST ERROR LINE IF (P(4).EQ.0) GO TO 101 C MOVE RECORD TO OUTPUT BUFFER AND LIST, LINE BY LINE NCHAR=LOG ICHAR=1 100 JCHAR=NCHAR IF (NCHAR.GT.80) JCHAR=80 OUTCHR=JCHAR+1 CALL SMOVE(CARD,ICHAR,(ICHAR+JCHAR-1),IOBUF,I2,OUTCHR) OUTCHR=-OUTCHR CALL REIO (I2,P(2),IOBUF,OUTCHR) IF (NCHAR.LE.80) GO TO 101 NCHAR=NCHAR-80 ICHAR=ICHAR+80 GO TO 100 C CONVERT N TO ASCII AND ENTER N IN MESS (ERROR MESSAGE) 101 CALL CITA(N,IA) MESS(9)=IA(2) MESS(10)=IA(3) C WRITE ERROR MESSAGE ON LIST :  DEVICE CALL REIO(I2,P(2),MESS,N20) C INCREMENT ERROR COUNT ERROR=ERROR+1 RETURN END END$  3 T 92063-18004 1645 S 0222 DBSTR SOURCE              H0102 ASMB,R,L,C HED 'DBSTR' ROUTINE OF 'DBUS' NAM DBSTR,3 92063-16004 REV. 1645 * * ************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * * PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ************************************************************** * * * LISTING: 92063-19004 * SOURCE: 92063-18004 * RELOC: 92063-16004 * * ************************************************************* * * * * * ******************************************************************** * * * DBSTR ROUTINE OF DBUS * * * * TURN ON SEQUENCE: * * * * :RU,DRSTR,CONSOLE LU,MAG TAPE LU * * WHERE CONSOLE DEFAULTS TO LU1 * * MAG TAPE DEFAULTS TO LU8 * * * * OUTPUT: * * NO ERROR - 1) SPECIFIED ROOT FILE AND DATA * * BASE STORED ON MAGNETIC TAPE * * 2) COMPLETION MESSAGE WRITTEN TO * * SYSTEM CONSOLE * * * * ERROR - ERROR NUMBER WRITTEN TO SYSTEM * * CONSOLE S * * * * * * FUNCTION: * * 'DBSTR' PROMPTS THE USER FOR INFORMATION * * ABOUT THE ROOT FILE AND DATA BASE TO STORE. * * IF THE INFORMATION IS VALID 'DBSTR' STORES * * THE ROOT FILE AND DATA BASE ON THE MAGNETIC * * TAPE SECTOR BY SECTOR. THE ROOT FILE IS * * STORED FIRST AND IS IDENTIFIED BY A TAPE * * HEADER. THE DATA BASE FOLLOWS AND IS WRITTEN * * IN ONE OR MORE FILE HEADERS. * * * ******************************************************************** * * * * ENT DBSTR EXT EXEC,OPEN,READF,FMERR,PHIMV,PHIMC,PHICM,CMPCT EXT FSTAT,CLOSE,LOCF,DBSPC,RMPAR SPC 3 SUP PRESS ******************************************************************** * * * EQUATES * * * ******************************************************************** A EQU 0 A REGISTER B EQU 1 B REGISTER MD3 DEC -3 MD1 DEC -1 MD12 DEC -12 D1 DEC 1 D3 DEC 3 D4 DEC 4 D6 DEC 6 D7 DEC 7 D2 DEC 2 D9 DEC 9 D10 DEC 10 D12 DEC 12 D14 DEC 14 D15 DEC 15 D16 DEC 16 H8BTA OCT 17 H8BT OCT 377 B40 OCT 40 WCODE DEC 2 WRITE CODE = 2 RCODE DEC 1 READ CODE = 1 L8BT OCT 177400 QCODE DEC 6 EFCDE DEC 3 DSCWD DEC 2 ERRML EQU D7 LENGTHd OF ERROR MESSAGE DBNML DEC 8 NAME MSG. LENGTH DSPKN DEC 14 DATA SET PACK NO. SKP ************************************************************************ * * * * RUN TABLE FOR IMAGE-DBMS * * * * * * THE RUN TABLE IS COMPRISED OF THE FOLLOWING SECTIONS: * * * * * * 1) DATA BASE CONTROL BLOCK * * * 2) ITEM TABLE * * * 3) DATA SET TABLE * * * * * * THESE SECTIONS APPEAR IN THE ORDER DESCRIBED. * * * DETAILS OF EACH SECTION FOLLOW. * * * * * ************************************************************************ ***** ********* * * * * DATA BASE CONTROL BLOCK * * * * * ***** ********* DBLNG DEC 55 DATA BASE CONTROL BLOCK LENGTH DBZ DEC 0 DBSTA EQU EFCDE DBSCD EQU D4 DATA BASE SECURITY CODE(EFMP) DBICT DEC 5 DATA BASE ITEM COUNT DBSCT EQU D6 DATA BASE DATA SET COUNT DBITB DEC 7 ADDRESS OF ITEM TABLE DBSTB DEC 8 ADDRESS OF DATA SET TABLE DBLMD EQU D9 DATA BASE ACCESS LEVEL AND MODE DBLVL EQU DBZ+9 1ST BYTE: ACCESS LEVEL GRANTED BY 'DBOPN' DBMOD EQU DBZ+9 2ND BYTE: MODE GRANTED BY 'DBOPN' DBILV EQU D10 DATA BASE ITEM LEVEL WORDS - 3 WORDS/LEVEL DBOCT EQU DBZ+10 DATA SET OPEN COUNT ***** ********* * * * * ITEM TABLE - ONE FIVE-WORD ENTRY PER ITEM * * * * * ***** ***** ITLNG EQU DBZ+5 ITEM ENTRY LENGTH ITNME EQU DBZ ITEM NAME(LEFT JUSTIFIED) ITRWL EQU DBZ+3 ITEM READ/WRITE MINIMUM ACCESS LEVEL ITRDL EQU DBZ+3 1ST BYTE: MINIMUM ACCESS LEVEL TO READ ITEM ITWRL EQU DBZ+3 2ND BYTE: MINIMUM ACCESS LEVEL TO WRITE ITEM ITTDN EQU DBZ+4 ITEM TYPE AND DATASET NUMBER ITTYP EQU DBZ+4 1ST BYTE: ITEM TYPE ITDSN EQU DBZ+4 2ND BYTE: ITEM DATASET NUMBER ***** ********* * * * * DATA SET TABLE - COMPRISED OF THE FOLLOWING SECTIONS IN * * * THE ORDER PRESENTED: * * * * * * 1) DATA SET CONTROL BLOCK * * * 2) RECORD DEFINITION TABLE * * * 3) MASTER PATH TABLE, DETAIL PATH TABLE, * * * OR NO PATH TABLE * * * * * ***** ********* * * * * * * ***** DATA SET CONTROL BLOCK ***** * * * * * * DSLNG DEC 16 DATA SET CONTROL BLOCK LENGTH DSTYP EQU DBZ DATA SET TYPE DSMDL EQU DBZ+1 DATA SET MEDIA RECORD LENGTH DSENL EQU DBZ+2 DATA SET LOGICAL RECORD LENGTH DSFPC EQU DBZ+3 DATA SET FIELDS/ENTRY AND PATHS/ENTRY DSFCT EQU DBZ+3 1ST BYTE: FIELDS/ENTRY DSPCT EQU DBZ+3 2ND BYTE: PATHS/ENTRY DSCPN EQU DBZ+4 DATA SET SRCH FIELD NO. AND PATH NO. OF CURR. CHAIN DSCCT EQU DBZ+4 1ST BYTE: FIELD NUMBER OF SRCH ITEM(0 IF DETAIL) DSPAN EQU DBZ+4 2ND BYTE: PATH NUMBER OF CURRENT CHAIN DSPAT EQU DBZ+5 ADDRESS OF PATH TABLE DSFRC EQU DBZ+6 FREE CHAIN COUNT(DETAIL)/FREE RECORD COUNT(MASTER) DSFRH EQU DBZ+7 0 OR RECORD NO.OF 1ST FREE RECORD IN CHAIN DSRCN EQU DBZ+8 LAST ACCESSED RECORD NUMBER DSPAL EQU DBZ+9 0 OR PATH LENGTH OF CURRENT CHAIN DSCHF EQU DBZ+10 0 OR RECORD NUMBER OF CURRENT CHAIN FOOT DSFWN DEC 11 0 OR NEXT RECORD NUMBER IN CHAIN DSNME DEC 12 DATA SET NAME(LEFT JUSTIFIED) DSCAP DEC 15 CAPACITY(MAXIMUM NUMBER OF RECORDS) * * * * * * ***** RECORD DEFINITION TABLE - ONE ONE-WORD ENTRY PER FIELD ********* * * * * * * RDLNG EQU DBZ+1 RECORD DEFINITION TABLE ENTRY LENGTH RDINF EQU DBZ ITEM NUMBER OF FIELD,ITEM LENGTH AND ACCESSABILITY RDITN EQU DBZ 1ST BYTE: ITEM NUMBER OF FIELD RDILA EQU DBZ 2ND BYTE: ITEM LENGTH AND R/W ACCESSABILITY RDITL EQU DBZ 1ST 6 BITS: ITEM LENGTH RDWRA EQU DBZ 7TH BIT: ITEM WRITE ACCESSABILITY RDRDA EQU DBZ 8TH BIT: ITEM READ ACCESSABILITY * * * * ***** PATH TABLE(MASTER) - ONE TWO-WORD ENTRY PER PATH ***** * g * * * * PTMLG EQU DBZ+2 MASTER PATH TABLE ENTRY LENGTH PTMSD EQU DBZ DETAIL DATASET SRCH ITEM NO. AND DATA SET NO. PTMSN EQU DBZ 1ST BYTE: DETAIL DATA SET SEARCH ITEM NUMBER PTMDN EQU DBZ 2ND BYTE: DETAIL DATA SET NUMBER PTMPS EQU DBZ+1 DETAIL DATA SET PATH NUMBER AND SCRATCH PTMPN EQU DBZ+1 1ST BYTE: DETAIL DATA SET PATH NUMBER PTMSC EQU DBZ+1 2ND BYTE: SCRATCH * * * * * * ***** PATH TABLE(DETAIL) - ONE TWO-WORD ENTRY PER PATH ********* * * * * * * PTDLG EQU DBZ+2 DETAIL PATH TABLE ENTRY LENGTH PTDSM EQU DBZ SEARCH FIELD NO. IN DETAIL AND MASTER DATA SET NO. PTDSF EQU DBZ 1ST BYTE: SEARCH FIELD NUMBER IN DETAIL PTDMN EQU DBZ 2ND BYTE: MASTER DATA SET NUMBER PTDPS EQU DBZ+1 MASTER DATA SET PATH NUMBER AND SCRATCH PTDPN EQU DBZ+1 1ST BYTE: MASTER DATA SET PATH NUMBER PTDSC EQU DBZ+1 2ND BYTE: SCRATCH SKP ******************************************************************** * * * VERIFY THAT THE LOGICAL UNIT IS VALID AND PROMPT THE USER * * FOR THE DATA BASE NAME, SECURITY CODE, AND LEVEL 15 WORD. * * * ******************************************************************** DBSTR NOP JSB RMPAR GET PARAMETERS DEF *+2 DEF CONSL * JSB DBSPC GET FREE DEF *+4 DEF PNAME SPACE DEF FWAM DEF LWAM LIMITS * LDA MT SZA,RSS LDA D8 STA MT  CMA,INA ADA D63 SSA VALID LOG. UNIT NO. ? JSB ER1 NO LDA CONSL SZA,RSS CLA,INA IOR B400 STA TECWD SET LU CONTROL WORD LDA MT STA TPCNW BUILD TAPE CONTROL WORD JSB IACVT CONVERT LOGICAL UNIT TO ASCII LDA CELL STA LUNIT SAVE ASCII LOGICAL UNIT LDA TPCNW BUILD TAPE REWIND CONTROL WORD IOR RWMSK STA RWCNW LDA TPCNW BUILD DYNAMIC TAPE STATUS CONTROL WORD IOR DYMSK STA DYCNW ISZ TSEQ INCREMENT TAPE SEQUENCE NO. LDA TPCNW IOR EF CREATE TAPE EOF CONTROL WORD STA EFCWD SAVE TAPE EOF CONTROL WORD JSB BLNKB BLANK RESPONSE BUFFER LDA ADBNM GET DATA BASE NAME LDB DBNML JSB TERMW JSB TERMR LDA ADBSM GET DATA BASE SECURITY CODE LDB DBSML JSB TERMW JSB TERMR LDA ASCDE STA ATSCD LDA A,I ALF,ALF AND H8BTA STA SCODE LDA ASCDE,I JSB COMP JMP GLVLW ISZ ATSCD LDA ATSCD,I ALF,ALF JSB COMP JMP GLVLW LDA ATSCD,I JSB COMP JMP GLVLW ISZ ATSCD LDA ATSCD,I ALF,ALF JSB COMP JMP GLVLW GLVLW EQU * LDA ADBLM GET DATA BASE LEVEL WORD LDB DBLML JSB TERMW JSB TERMR SPC 3 ******************************************************************** * * * SEARCH FOR AND READ THE ROOT FILE THEN VERIFY THE SECURITY * * CODE AND LEVEL 15 WORD * * * ******************************************************************** * LDA D3 STA PHIMC LDA ANAME LDB TNAM JSB PHIMV LDA SCODE CMA,INA STA SC COMPLEMENT SECURTITY CODE CLA SET FOR TOTAL STA CARNO CARTRIDGE SEARCH LDA ANAME JSB FOPEN OPEN ROOT FILE * JSB FSTAT GET DEF *+2 DEF FWAM,I CARTRIDGE LABEL INFO LDB FWAM NOW NXLU LDA B,I FIND CPA LU CARTRIDGE JMP LUFND LABEL ADB D4 JMP NXLU LUFND ADB D2 GET THE LABEL LDA B,I FOR THIS DISC LU STA LU LDA SECCT MPY D64 COMPUTE ROOT SIZE STA RTSIZ ADA FWAM AND CHECK FOR ADA D9 ENOUGH CMA,INA ROOM ADA LWAM SSA ENOUGH ROOM? JMP ER4 NO! * LDA FWAM ADA D9 STA AROOT JSB FILRD READ ROOT FILE LDB FWAM PLACE ADB D6 ROOT LDA LEN FILE SIZE STA RTSIZ AND SECURITY STA B,I CODE IN HEADER LDA SC INB STA B,I INB LDA LU STORE CARTRIDGE STA B,I IN HEADER LDA D6 MOVE STA PHIMC HEADER LDA ATPHD LDB FWAM JSB PHIMV LDA AROOT GET SECURITY CODE IN ROOT FILE ADA DBSCD LDB A,I CPB SC CORRECT SECURITY CODE ? RSS YES JSB ER2 NO LDA AROOT GET LEVEL 15 WORD ADA DBLNG ADA MD3 LDB A,I GET 1ST WORD OF LEVEL 15 CPB BLNKD ANY LEVEL WORDS ? JMP RINGA NO LDB D3 STB CMPCT LEVEL WORD LENGTH LDB ALEVL ADDR OF USER SUPPLIED WORD JSB PHICM LEVEL WORDS EQUAL ? JSB ER3 NO SPC 3 RINGA EQU * JSB TSTAT CHECK TAPE I/O STATUS LDA STATS AND MASK2 WRITE RING OUT ? SZA,RSS JMP WTHDR JSB RING REQUEST WRITE RING JMP RINGA TRY AGAIN WTHDR EQU * X LDB FWAM ADDR OF BUFFER TO WRITE LDA D9 JSB TAPEW WRITE HEADER * LDA RTSIZ LENGTH OF RECORD TO WRITE LDB AROOT JSB TAPEW WRITE ROOT FILE SKP 3 ******************************************************************** * * * BUILD THE FILE HEADER * * * ******************************************************************** LDB AROOT ADB DBSCT LOOP ON DSET COUNT TO CREATE LDA B,I CMA,INA DATA-SETS AND INITIALIZE INFO STA DINX WITHIN THESE DATA-SETS FOR MODE ADB D2 SET UP LDB B,I ADB AROOT ADB MD1 JMP SBST8 NEXST LDB DSET CALCULATE THE ADDRESS OF THE ADB D3 NEXT DATA-SET. LDA B,I LDB 0 AND H8BT RAL SWP ALF,ALF AND H8BT ADB 0 DSET=2*PATHCT+FIELDCT+16+DSET ADB D16 ADB DSET SBST8 STB DSET ADB D12 YES,OPEN THIS DATA-SET AND LDA B,I STA FNAM PLACE INB LDA B,I NAME STA FNAM+1 INB LDA B,I IN HEADER AND L8BT ADA B40 STA FNAM+2 LDA D4 MOVE STA PHIMC HEADER LDA APNHD INTO LDB AHDR PLACE JSB PHIMV LDB DSET FNAM IS ADDRESS OF DSET NAME ADB D15 LDA B,I STA FLGTH FLGTH IS MAXIMUM NUMBER OF STA FLEN LDB DSET ENTRIES ADB D1 RLGTH IS RECORD LENGTH(IN WORDS) LDA B,I ISZ 1 ADA B,I STA RLGTH STA RLEN LDB DSET PICK UP CART NUMBER ADB D14 FROM DATA SET CONTROL LDA B,I BLOCK AND STORE IN AND H8BT CART NO STA CARNO LDA AFNAM JSB FOPEN O OPEN WFHDR EQU * LDA D10 LENGTH OF RECORD TO WRITE LDB AHDR ADDR OF BUFFER TO WRITE JSB TAPEW WRITE FILE HEADER JSB TSTAT CHECK TAPE I/O STATUS LDA STATS AND MASK5 END OF TAPE ? SZA,RSS JMP FWD JSB EOT END OF TAPE JMP WFHDR TRY AGAIN FWD EQU * SPC 3 ******************************************************************** * * * BUILD THE DATA HEADER AND READ THE DATA SET INTO MEMORY * * * ******************************************************************** CLB LDA D1300 COMPUTE DIV RLGTH NUMBER OF RECORDS/BLOCK STA R/BLK CMA,INA STA RINX SET UP INDEX ADA FLGTH IS THIS SSA,RSS A SHORT BLOCK? JMP SHTBL NO! LDA FLGTH YES! STA R/BLK USE CMA,INA ACTUAL STA RINX LENGTH SHTBL LDA FLGTH CMA,INA SBST2 STA FINX SET UP FILE CTR INDEX LDA AHDR STA DBUF SBST1 JSB READF READ DEF *+4 DEF DCB A DEF IERR DBUF BSS 1 RECORD CPA MD12 EOF? JMP WDHDR YES SSA ERROR? JMP FILER YES! LDA DBUF COMPUTE ADA RLGTH NEXT STA DBUF ADDRESS ISZ RINX END OF BLOCK? JMP SBST1 NO! WDHDR EQU * LDA D1300 RCD. LENGTH TO WRITE LDB AHDR ADDR OF BUFFER TO WRITE JSB TAPEW WRITE TAPE RECORD JSB TSTAT CHECK TAPE I/O STATUS LDA STATS AND MASK5 END OF TAPE ? SZA,RSS JMP PROC JSB EOT END OF TAPE JMP WDHDR TRY AGAIN PROC EQU * LDA FINX END ADA R/BLK SSA,RSS OF FILE? JMP SBST3 YES! _B@] ALL[,'CHAR'] 1 OPERANDS - 'REPORT PROCEDURE' - CONSIST OF ONE OR MORE OF THE REPORT STATEMENT TYPES 1. DETAIL 2. EDIT 3. GROUP 4. HEADER 5. SORT 6. TOTAL 'PROCEDURE NAME' - 1 TO 6 CHARACTER PROCEDURE NAME STORED IN A RTE FMGR DISC FILE. - ANY ASCII CHARACTER WILL LIST REPORT PROCEDURE DEFAULT: NO LIST ALL - LISTS ALL FOUND RECORDS WITHOUT ANY FORMATTING 'CHAR' - ANY ASCII CHARACTER - WILL LIST ALL FOUND RECORDS WITHOUT ANY FORMATTING OR DATA-ITEM NAME 1 %% HELP FIND 1 FUNCTION - THE FIND COMMAND WILL RETRIEVE DATA RECORDS FROM THE DATA-BASE AS SPECIFIED IN THE FIND STATEMENT 1 SYNTAX - FIND 'RETRIEVE PROCEDURE' END/ NAME = 'PROCEDURE NAME' 1 OPERANDS - 'RETRIEVE PROCEDURE' - CONSISTS OF 'DATA ITEM NAME' 'RELATIONAL OPERATOR''DATA ITEM PHRASE' 'LOGICAL CONNECTOR' 'PROCEDURE NAME' - 1 TO 6 CHARACTER PROCEDURE NAME STORED IN SPEC-FILE 'DATA ITEM NAME' - 1 TO 6 CHARACTER STRING 'RELATIONAL OPERATOR' . - IS/IE/ISNOT/INE/ILT/ INLT/IGT/INGT 'DATA ITEM PHRASE' - ''DATA ITEM VALUE'' 'LOGICAL CONNECTOR' - AND/OR 1 %% HELP UPDATE 1 FUNCTION - THE UPDATE COMMAND ALLOWS THE USER TO ALTER DATA-BASE ITEMS BY DELETING, REPLACING, OR ADDING 1 SYNTAX - UPDATE 'UPDATE PROCEDURE' END/ NAME = 'PROCEDURE NAME' 1 OPERANDS - 'UPDATE PROCEDURE' - 'UPDATE STATEMENT' 'PROCEDURE NAME' - 1 TO 6 CHARACTER PROCEDURE NAME STORED AN RTE FMGR DISC FILE. 'UPDATE STATEMENT' - 'ADD STATEMENT'/ 'DELETE STATEMENT'/ 'REPLACE STATEMENT' 'ADD STATEMENT' - A,'DATA SET NAME' 'DELETE STATEMENT' - K 'REPLACE STATEMENT' - R,'DATA ITEM NAME'=''VALUE'' 'DATA SET NAME' - 1 TO 6 CHARACTER STRING 'DATA ITEM NAME' - 1 TO 6 CHARACTER STRING ''VALUE'' - CHARACTER STRING 1 %% **  =F 92063-18011 1840 S 1422 QUERY SOURCE #1              H0114 'FTN4,L,C PROGRAM QUERY(3,90),REV.1826 771018 C C C************************************************************* C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * C RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * C PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * C OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C************************************************************* C C C LISTING: 92063-19011 C SOURCE: 92063-18011 C RELOC: 92063-16011 C C C************************************************************ C COMMON ITTY,ILP,IDCB(144),JDCB(144) COMMON DBNAM,DSNAM,DINAM,SELECT,SNAM COMMON DSNUM,DINUM,INTIAL,IMA,IB,IEND,ISCAN COMMON IPFLAG COMMON IRRCNT C COMMON S,R3,TRKNM,IDILU,R5 COMMON R6 COMMON V COMMON STRA COMMON STRC COMMON STRD COMMON P1,P2 COMMON J1 COMMON KSORT(256) COMMON T,U COMMON STRE,STRF,STRG,STRH,STRI COMMON L,ATOTAL COMMON ISELD,IRSE,IPTR COMMON RCOUNT,N C INTEGER DBNAM(3),DSNAM(3),DINAM(3) INTEGER SELECT(3),SNAM(3) INTEGER DSNUM,DINUM DIMENSION IPRAM(5),IMA(36),IB(349) INTEGER V(8) INTEGER T(5) INTEGER U(7,5) INTEGER R3,S(6,100),R5,TRKNM INTEGER R6 INTEGER STRA(37) INTEGER STRC(67) INTEGER STRD(37) INTEGER STRE(37) INTEGER STRF(37) INTEGER STRG(37) INTEGER STRH(37) INTEGER STRI(37) INTEGER P1,P2 DIMENSION L(6) INTEGER ATOTAL(60,5) DIMENSION ISELD(128) INTEGER RCOUNT C INTEGER SPACE DIMENSION IMSG(15) C DATA SPACE/2H / C CR/LF/LF/LF QUERY/1000 (X.Y) READY CR/LF/LF/LF DATA IMSG/6412B,5012B,2HQU,2HER,2HY/,2H10,2H00, 12H (,2H8.,2H2),2H R,2HEA,2HDY,6412B,5012B/ C CALL RMPAR(IDCB) IF (IDCB.EQ.0) GOTO 5 ITTY=IDCB+400B {  GO TO 7 5 ITTY=401B 7 ILP =IDCB(2) IF (ILP.EQ.0) ILP=6 DO 10 I=1,3 DBNAM(I) = SPACE DSNAM(I) = SPACE DINAM(I) = SPACE SELECT(I) = SPACE 10 CONTINUE DSNUM = 0 DINUM = 0 IRRCNT = 0 SNAM(1) = 2HQS SNAM(2) = SPACE SNAM(3) = SPACE CALL REIO(2,ITTY,IMSG,15) INTIAL = 0 CALL EXEC(8,SNAM) CALL AIDCB END $ t FTN4,L,C PROGRAM QS(5,90),92063-16011 REV. 1826 771027 C C C************************************************************* C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * C RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * C PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * C OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C************************************************************* C C C LISTING: 92063-19011 C SOURCE: 92063-18011 C RELOC: 92063-16011 C C C************************************************************ C C C QUERY SUBSYSTEM MAIN MODULE C COMMAND INTERPRETER C COMMON ITTY,ILP,IDCB(144),JDCB(144) COMMON DBNAM,DSNAM,DINAM,SELECT,SNAM COMMON DSNUM,DINUM,INTIAL,IMA,IB,IEND,ISCAN COMMON IPFLAG COMMON IRRCNT COMMON S,R3,TRKNM,IDILU C INTEGER DBNAM(3),DSNAM(3),DINAM(3) INTEGER SELECT(3),SNAM(3) INTEGER DSNUM,DINUM INTEGER S(12,50),R3,TRKNM DIMENSION IMA(36),IB(349) INTEGER SPACE DIMENSION INVAL(9) DIMENSION ILIST(55) DIMENSION NDEF(6) DIMENSION ISTAT(2) INTEGER FIND(2) INTEGER REPO(3) INTEGER IEDIT(3) INTEGER UPDA(3) INTEGER CREA(3) INTEGER DEST(4) INTEGER DISP(4) INTEGER FORM(2) INTEGER EXIT(2) INTEGER HELP(2) INTEGER LIST(2) INTEGER EXECT(4) INTEGER DATAB(5) INTEGER SELTF(6) INTEGER MODE(4) INTEGER LEVEL(5) INTEGER SECD(6) DIMENSION ILEV(3) INTEGER ERROR(8) INTEGER IERR1(16) INTEGER IERR2(9) INTEGER IERR3(11) INTEGER IERR4(12) INTEGER YES DIMENSION NEXT(3) INTEGER IWAIT(25) C DATA SPACE/2H / DATA INVAL(1)/2H I/ DATA INVAL(2)/2HNV/ DATA INVAL(3)/2HAL/ DATA INVAL(4)/2HID/ DATA INVAL(5)/2H C/ DATA INVAL(6)/2HOM/ C DATA INVAL(7)/2HMA/ DATA INVAL(8)/2HND/ DATA INVAL(9)/6412B/ C DATA ILIST/17,2HQS,2H ,2H ,2HQS,2H00,2H ,2HQS,2H01,2H 1,2HQS,2H02,2H ,2HQS,2H03,2H ,2HQS,2H04,2H 2,2HQS,2H05,2H ,2HQS,2H06,2H ,2HQS,2H07,2H 3,2HQS,2H08,2H ,2HQS,2H09,2H ,2HQS,2H10,2H 4,2HQS,2H11,2H ,2HQS,2H12,2H 5,2HQS,2H13,2H ,2HQS,2H14,2H ,2HQS,2H15,2H 6,2HQS,2H16,2H / C CR/LF DATA NDEF/2HNO,2HT ,2HDE,2HFI,2HNE,2HD / DATA FIND/2HFI,2HND/ DATA REPO/2HRE,2HPO,2HRT/ DATA IEDIT/2HED,2HIT,2HR / DATA UPDA/2HUP,2HDA,2HTE/ DATA CREA/2HCR,2HEA,2HTE/ DATA DEST/2HDE,2HST,2HRO,2HY / DATA DISP/2HDI,2HSP,2HLA,2HY / DATA FORM/2HFO,2HRM/ DATA EXIT/2HEX,2HIT/ DATA HELP/2HHE,2HLP/ DATA LIST/2HLI,2HST/ DATA EXECT/2HEX,2HEC,2HUT,2HE / DATA DATAB/2HDA,2HTA,2H-B,2HAS,2HE / DATA SELTF/2HSE,2HLE,2HCT,2H-F,2HIL,2HE / DATA MODE/2HMO,2HDE,2H =,2H _/ DATA LEVEL/2HLE,2HVE,2HL ,2H= ,2H_ / DATA SECD/2HSE,2HCU,2HRI,2HTY,2H =,2H _/ DATA IMODE/0/ DATA ISCOD/0/ DATA ERROR/2HER,2HRO,2HR ,2HNO,2H. ,2HXX,2HXX,2HXX/ DATA IERR1/2HIL,2HLE,2HGA,2HL ,2HSE,2HLE,2HCT,2H F,2HIL, 12HE ,2HSI,2HZE,2H O,2HR ,2HTY,2HPE/ DATA IERR2/2HIN,2HVA,2HLI,2HD ,2HRE,2HQU,2HES,2HT ,2H / DATA IERR3/2H I,2HLL,2HEG,2HAL,2H L,2HOG,2HIC,2HAL,2H U, 12HNI,2HT / DATA IERR4/2H I,2HLL,2HEG,2HAL,2H L,2HU ,2HLO,2HCK,2H R, 12HEQ,2HUE,2HST/ DATA NEXT/2HNE,2HXT,2H? / DATA YES/2HYE/ DATA IWAIT/2H D,2HAT,2HA ,2HBA,2HSE,2H I,2HS ,2HLO,2HCK,2HED, 12H O,2HR ,2HOP,2HEN,2H, ,2HDO,2H Y,2HOU,2H W,2HAN,2HT ,2HTO, 22H W,2HAI,2HT?/ C C C C PROMPT WITH "NEXT?" 20 CALL REIO(2,ITTY,NEXT,3) IPFLAG = 0 CALL LURQ(140000B,ILP,1) GOTO 19 18 I=0 C READ COMMAND FROM USER'S TERMINAL 19 CALL INPUT C SCAN FOR VALID COMMAND CALL LSCAN(IB,I,J,K)4 LEN = J - I IF(LEN.LT.3) GOTO 44 C FIND IF(LEN.GT.3) GOTO 23 IF(JSCOM(IB,I,J,FIND,1,IERR).NE.0) GOTO 23 SNAM(2) = 2H00 C LOAD SERVICE MODULE 22 CALL EXEC(8,SNAM) C C LIST - CHANGE LIST LOGICAL UNIT NUMBER C 23 IF (LEN.NE.3) GOTO 24 IF (JSCOM(IB,I,J,LIST,1,IERR).NE.0) GOTO 24 CALL LSCAN(IB,I,J,K) IF (K.NE.6) GOTO 44 CALL LSCAN(IB,I,J,K) IF (J-I.GT.1) GOTO 170 CALL CATI(IB,I,J-I+1,K,ISTAT) IF (ISTAT.LT.0) GOTO 44 IF (K.LE.0) GOTO 170 CALL REIO(100002B,K,LIST,0) GO TO 170 171 ILP=K GOTO 20 C C REPORT 24 IF(LEN.NE.5) GOTO 30 IF(JSCOM(IB,I,J,REPO,1,IERR).NE.0) GOTO 26 CALL LURQ(140001B,ILP,1) GOTO 240 17 SNAM(2) = 2H02 GOTO 22 C UPDATE 26 IF(JSCOM(IB,I,J,UPDA,1,IERR).NE.0) GOTO 28 SNAM(2) = 2H07 GOTO 22 C CREATE 28 IF(JSCOM(IB,I,J,CREA,1,IERR).NE.0) GOTO 30 SNAM(2) = 2H09 GOTO 22 C DESTROY 30 IF(LEN.NE.6) GOTO 34 IF(JSCOM(IB,I,J,DEST,1,IERR).NE.0) GO TO 32 SNAM(2) = 2H11 GOTO 22 C DISPLAY 32 IF(JSCOM(IB,I,J,DISP,1,IERR).NE.0) GOTO 34 CALL LURQ(140001B,ILP,1) GOTO 240 16 SNAM(2) = 2H10 GOTO 22 C FORM 34 IF(LEN.NE.3) GOTO 37 IF(JSCOM(IB,I,J,FORM,1,IERR).NE.0) GOTO 36 CALL LURQ(140001B,ILP,1) GOTO 240 15 SNAM(2) = 2H08 GOTO 22 C EXIT 36 IF(JSCOM(IB,I,J,EXIT,1,IERR).NE.0) GOTO 39 35 SNAM(2) = 2H16 GOTO 22 C HELP 39 IF(JSCOM(IB,I,J,HELP,1,IERR).NE.0) GOTO 37 SNAM(2) = 2H13 GOTO 22 C EXECUTE 37 IF(LEN.NE.6) GOTO 38 IF(JSCOM(IB,I,J,EXECT,1,IERR).NE.0) GOTO 38 ICMND = 2 CALL CLOSE(IDCB) GO TO 50 C DATA-BASE 38 IF(LEN.NE.8) GOTO 42 IF(JSCOM(IB,I,J,DATAB,1,IERR).NE.0) GOTO 42 ICMND = 1 GOTO 50 C SELECT-FILE 42 IF(LEN.NE.10) GOTO 44 IF(JSCOM(IB,I,J,SELTF,1,IERR).NE.0) GOTO 44 O+ ICMND = 3 GOTO 50 C INVALID COMMAND 44 CALL REIO(2,ITTY,INVAL,9) GO TO 20 C C SCAN FOR = 50 CALL LSCAN(IB,I,J,K) IF((K.EQ.5).AND.(ICMND.EQ.2)) GOTO 83 IF(K.NE.6) GOTO 44 C SCAN FOR NAME CALL LSCAN(IB,I,J,K) IF(K.NE.2) GOTO 44 IF(J-I.GT.5) GOTO 44 DO 55 K=1,3 55 IMA(K) = SPACE GOTO (60,80,80), ICMND 60 IF(DBNAM.EQ.SPACE) GOTO 62 C DATA-BASE OPEN - CLOSE CURRENT BASE CALL DBCLS(0,ISTAT) 62 DO 64 N=1,3 64 DBNAM(N) = SPACE CALL SMOVE(IB,I,J,DBNAM,1) C GET LEVEL WORD CALL REIO(2,ITTY,LEVEL,-9) CALL INPUT CALL LSCAN(IB,I,J,K) J = IEND - 1 IF(J-I.GT.5) GOTO 70 DO 66 K=1,3 66 ILEV(K) = SPACE CALL SMOVE(IB,I,J,ILEV,1) C GET SECURITY CALL REIO(2,ITTY,SECD,6) CALL INPUT CALL LSCAN(IB,I,J,K) IF(J-I.GT.4) GOTO 70 CALL CATI(IB,I,J-I+1,ISCOD,ISTAT) IF(ISTAT.LT.0) GOTO 70 C GET MODE CALL REIO(2,ITTY,MODE,4) CALL INPUT CALL LSCAN(IB,I,J,K) IF(I.NE.J) GOTO 70 CALL SGET(IB,I,IMODE) IMODE = IMODE - 60B IF(IMODE.LT.1 .OR. IMODE.GT.5) GOTO 70 C EVERY THING SET - OPEN DATA-BASE CALL DBINT(DBNAM,ISCOD,ILIST,ISTAT) IF (ISTAT.EQ.129) GOTO 75 IF (ISTAT.NE.0) GOTO 67 77 CALL DBOPN(DBNAM,ILEV,ISCOD,IMODE,ISTAT) IF (ISTAT.EQ.129) GOTO 75 IF(ISTAT.EQ.0) GOTO 20 C OUTPUT ERROR CODE 67 CALL CITA(ISTAT,ERROR(6)) CALL REIO(2,ITTY,ERROR,8) DBNAM = SPACE GOTO 20 70 DBNAM = SPACE GOTO 44 C IF DATA BASE IS LOCKED OR OPEN(MODE=3) THEN WAIT OR NO WAIT 75 CALL REIO(2,ITTY,IWAIT,25) CALL REIO(1,ITTY,IANS,1) IF (JSCOM(YES,1,2,IANS,1,IERR).NE.0) GOTO 20 C C RESCHEDULE QUERY TO SEE IF DATA BASE IS AVAILABLE(EVERY 10SECS) C 76 CALL EXEC(12,0,2,0,-10) CALL DBINT(DBNAM,ISCOD,ILIST,ISTAT) IF (ISTAT.EQ.129) GOTO 76 IF (ISTAT.NE.0) c1GOTO 67 CALL DBOPN(DBNAM,ILEV,ISCOD,IMODE,ISTAT) IF (ISTAT.EQ.129) GOTO 76 IF (ISTAT.NE.0) GOTO 67 GOTO 20 C 80 CALL SMOVE(IB,I,J,IMA,1) IF (ICMND.EQ.3) GOTO 81 IF (ICMND.EQ.2) GOTO 84 CALL OPEN(IDCB,ISTAT,IMA) GOTO 82 C C SCHEDULE 'EDITR' C 83 CALL EXEC(23+100000B,IEDIT,ITTY) GO TO 900 901 GOTO 20 C C SCHEDULE USER NAMED 'EDITR' C 84 CALL EXEC(23+100000B,IMA,ITTY,ITTY,ITTY) GO TO 900 902 GOTO 20 81 CALL OPEN(JDCB,ISTAT,IMA) 82 IF (ISTAT.LT.0) GOTO 110 CALL LOCF(JDCB,ISTAT,ISTAT,ISTAT,ISTAT,JSEC,ISTAT,JTYP,JREC) IF((JSEC.LT.6) .OR.(JTYP.NE.2).OR.(JREC.NE.128))GOTO 160 IF(ICMND.EQ.3) GOTO 100 C GOTO 44 100 CALL SMOVE(IMA,1,6,SELECT,1) GO TO 20 C 110 DO 115 K=1,6 115 IMA(K+3) = NDEF(K) C ISSUE "NOT DEFINED" ERROR CALL FMERR(ISTAT,ITTY) CALL REIO(2,ITTY,IMA,9) GO TO 20 C C C FILE MANAGER ERROR C 150 CALL FMERR(ISTAT,ITTY) ISTAT=-ISTAT GOTO 67 C C ILLEGAL LOCK REQUEST C 240 CALL REIO(2,ITTY,IERR4,12) GOTO 20 C 160 CALL REIO(2,ITTY,IERR1,16) GOTO 70 170 CALL REIO(2,ITTY,IERR3,11) GOTO 20 900 CALL REIO(2,ITTY,IERR2,11) GO TO 20 END $ FTN4,L,C PROGRAM QS00(5,90),92063-16011 REV. 1826 771027 C C C************************************************************* C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * C RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * C PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * C OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C************************************************************* C C C LISTING: 92063-19011 C SOURCE: 92063-18011 C RELOC: 92063-16011 C C C************************************************************ C C C FIND COMMAND SERVICE MODULE C QS00 C QS01 C C THE PURPOSE OF THIS MODULE IS TO BREAK DOWN C A FIND PROCEDURE (IN DISJUNCTIVE NORMAL FORM) C INTO A TABLE OF ELEMENTARY CONJUNCTS AND C DISJUNCTS. THIS TABLE WILL BE USED BY A C 'SEARCH' MODULE TO RETRIEVE RECORDS FROM A C DATA BASE. C COMMON ITTY,ILP,IDCB(144),JDCB(144) COMMON DBNAM,DSNAM,DINAM,SELECT,SNAM COMMON DSNUM,DINUM,INTIAL,IMA,IB,IEND,ISCAN COMMON IPFLAG COMMON IRRCNT COMMON S,R3,TRKNM,IDILU C INTEGER DBNAM(3),DSNAM(3),DINAM(3) INTEGER SELECT(3),SNAM(3) INTEGER DSNUM,DINUM DIMENSION IMA(36),IB(349),ISORT(384) DIMENSION IBUF(10) INTEGER S(12,50),R3,TRKNM DIMENSION FIND(2) DIMENSION NAME(2) INTEGER AND(2),OR,END(2) DIMENSION INE(2),ILT(2),INLT(2),IGT(2),INGT(2) DIMENSION INA(3) DIMENSION IREG(2) EQUIVALENCE (REG,IREG,IA),(IREG(2),LEN) INTEGER ERR1(14) INTEGER ERR2(12) INTEGER ERR3(15) INTEGER ERR4(14) INTEGER ERR6(22) INTEGER ERR7(16) INTEGER ERR8(14) INTEGER ERR9(13) INTEGER ERR10(19) INTEGER ERR11(12) INTEGER ERR12(19) INTEGER ERR13(13) INTEGER ERR14(12) INTEGER ERR15(7) INTEGER ERR16(19) INTEGER ERR17(11)  INTEGER R,U INTEGER FIND INTEGER VALUE(11) C DATA ISPACE/2H / DATA AND(1),AND(2)/2HAN,2HD / DATA OR/2HOR/ DATA END/2HEN,2HD;/ DATA IS/2HIS/ DATA IE/2HIE/ DATA INE(1),INE(2)/2HIN,2HE / DATA ILT(1),ILT(2)/2HIL,2HT / DATA INLT(1),INLT(2)/2HIN,2HLT/ DATA IGT(1),IGT(2)/2HIG,2HT / DATA INGT(1),INGT(2)/2HIN,2HGT/ DATA INA(1),INA(2),INA(3)/2HIS,2HNO,2HT / DATA ERR1/2HRE,2HLE,2HAS,2HE ,2HTR,2HAC,2HKS/ DATA ERR2/2H F,2HIN,2HD ,2HPR,2HOC, 1 2HED,2HUR,2HE ,2HTO,2HO ,2HLO,2HNG/ DATA ERR3/2H I,2HLL,2HEG,2HAL,2H D, 1 2HAT,2HA ,2HIT,2HEM,2H N,2HAM,2HE , 2 2HXX,2HXX,2HXX/ DATA ERR4/2H R,2HEL,2HAT,2HIO,2HNA,2HL , 1 2HOP,2HER,2HAT,2HOR,2H I,2HNV,2HAL,2HID/ DATA ERR6/2H I,2HNV,2HAL,2HID,2H #,2H O, 1 2HF ,2HVA,2HLU,2HES,2H F,2HOR,2H R,2HEL, 2 2HAT,2HIO,2HNA,2HL ,2HOP,2HER,2HAT,2HOR/ DATA ERR7/2HIN,2HVA,2HLI,2HD ,2HLO,2HGI, 1 2HCA,2HL ,2HCO,2HNN,2HEC,2HTO,2HR , 2 2HXX,2HXX,2HXX/ DATA ERR8/2H N,2HOT,2H E,2HNO,2HUG,2HH ,2HSE,2HCT,2HOR,2HS ,2HIN, 12H Q,2HSK,2HIB/ DATA ERR9/2H S,2HEL,2HEC,2HT-,2HFI,2HLE, ERR9 1 2H N,2HOT,2H D,2HEC,2HLA,2HRE,2HD / ERR9 DATA ERR10/2H R,2HET,2HRI,2HEV,2HAL, ERR10 1 2H F,2HRO,2HM ,2HMO,2HRE,2H T,2HHA, ERR10 2 2HN ,2HON,2HE ,2HDA,2HTA,2H-S,2HET/ ERR10 DATA ERR11/2H D,2HAT,2HA-,2HBA,2HSE, 1 2H N,2HOT,2H D,2HEC,2HLA,2HRE,2HD / DATA ERR12/2H N,2HON,2H-N,2HUM,2HER,2HIC,2H I, 1 2HN ,2HRE,2HAL,2H O,2HR ,2HIN,2HTE,2HGE,2HR , 1 2HVA,2HLU,2HE / DATA ERR13/2H D,2HAT,2HA ,2HIT,2HEM,2H V,2HAL, 1 2HUE,2H T,2HOO,2H L,2HON,2HG / DATA ERR14/2H I,2HNV,2HAL,2HID,2H P,2HRO, 1 2HCE,2HDU,2HRE,2H N,2HAM,2HE / DATA ERR15/2H F,2HIN,2HD ,2HEX,2HPE,2HCT,2HED/ a DATA ERR16/2H I,2HNV,2HAL,2HID,2H D,2HAT, 1 2HA ,2HIT,2HEM,2H V,2HAL,2HUE,2H O,2HR , 1 2HTE,2HRM,2HIN,2HAT,2HOR/ DATA ERR17/2H P,2HRO,2HCE,2HDU,2HRE,2H N,2HOT, 12H D,2HEF,2HIN,2HED/ DATA NAME/2HNA,2HME/ DATA FIND/2HFI,2HND/ DATA U/125B/ DATA R/122B/ DATA VALUE/2HWH,2HAT,2H I,2HS ,2HTH, 1 2HE ,2HVA,2HLU,2HE ,2HOF,2H _/ DATA IQSEC/6/ DATA ISIZE/384/ DATA MAXLN/126/ C DO 1 J=1,50 DO 1 I=1,12 S(I,J) = 0 1 CONTINUE IRRCNT = 0 IF(DBNAM.NE.2H ) GOTO 5 C ERROR DATA-BASE NOT DECLARED CALL REIO(2,ITTY,ERR11,12) GOTO 10 5 CONTINUE C RELEASE ANY PREVIOUS QSKIB TRACKS CALL EXEC(100005B,1,TRKNM,IDILU) I=I C GET A NEW TRACK FOR QSKIB 6 CALL EXEC(4,1,TRKNM,IDILU,NSEC) NSEC=NSEC/2 IF (TRKNM.GT.0)GOTO15 C ERROR - NOT ANY TRACKS AVAILABLE FOR QSKIB CALL REIO(2,ITTY,ERR1,14) 10 IPFLAG=0 SNAM(2)=2H CALL EXEC(8,SNAM) 15 IF(SELECT.NE.2H ) GOTO 110 C ERROR - SELECT-FILE NOT DECLARED CALL REIO(2,ITTY,ERR9,13) GO TO 10 C GET PROCEDURE NAME 20 CALL LSCAN(IB,I,J,K) IF(K.EQ.2) GO TO 21 IF(J-I.LE.5) GO TO 21 C ERROR - INVALID PROCEDURE NAME CALL REIO(2,ITTY,ERR14,12) GO TO 10 21 DO 30 N=1,3 30 IMA(N) = 2H CALL SMOVE(IB,I,J,IMA,1) IPFLAG = 1 CALL OPEN(IDCB,IERR,IMA,1) IF (IERR.NE.-6) GOTO 23 CALL REIO(2,ITTY,ERR17,-22) GOTO 10 23 IF (IERR.GE.0) GOTO 24 CALL FMERR(IERR,ITTY) 24 CALL INPUT C SCAN ACROSS "FIND" CALL LSCAN(IB,I,J,K) IF (J-I+1.NE.4) GO TO 22 IF (JSCOM(FIND,1,4,IB,I,IERR).EQ.0) GO TO 110 C ERROR - FIND EXPECTED 22 CALL REIO(2,ITTY,ERR15,7) GO TO 10 110 CONTINUE IOFF=1 NOWSEC=0 ICFLG=0 R3 = 1 DSNUM = 0 200 CONTINUE IF (R3.LE.50) GO TO 230 C ERROR - FIND PROCEDURE TOO LONG CALL REIO(2,ITTY,ERR2,ITTY2) GO TO 10 230 CALL LSCAN(IB,I,J,K) I1=I J1=J IF (K.EQ.2) GO TO 280 C ERROR - ILLEGAL DATA ITEM NAME 250 DO 251 M=13,15 251 ERR3(M)=2H IF ((J1-I1+1).GT.6) J1=I1+5 CALL SMOVE(IB,I1,J1,ERR3,25) CALL REIO (2,ITTY,ERR3,15) GO TO 10 C ERROR - RETRIEVAL FROM MORE THAN ONE DATA-SET 260 CALL REIO(2,ITTY,ERR10,19) GO TO 10 C C VERIFY VALID DATA-ITEM 280 CALL SFILL(DINAM,1,6,40B) IF(J-I.GT.5) GOTO 250 CALL SMOVE(IB,I,J,DINAM,1) NLEN=J-I+1 C CHECK FOR PROCEDURE C "NAME="? C SCAN FOR "=" CALL LSCAN(IB,I,J,K) IF (R3.NE.1) GO TO 281 IF (NLEN.NE.4) GO TO 281 IF (JSCOM(NAME,1,4,DINAM,1,IERR).NE.0) GO TO 281 IF (K.EQ.6) GO TO 20 281 ITYPE=2HI CALL DBINF(ITYPE,5,DINAM,IBUF) IF (IBUF(1).NE.0) GO TO 250 S(1,R3) = IBUF(2) DINUM = IBUF(2) CALL DBINF(2HI ,2,DINUM,IBUF) IF(DSNUM.EQ.0) DSNUM=IBUF(9) IF(DSNUM.NE.IBUF(9)) GOTO 260 C DATA-ITEM TYPE CALL SGET(IBUF,10,ITYPE) S(8,R3)=ITYPE C DATA-ITEM LENGTH S(9,R3) = IBUF(7) C DATA-ITEM OFFSET S(10,R3) = IBUF(8) C KEYED DATA-ITEM (=0 NO; =1 YES) CALL SGET(IBUF,9,IKEY) S(12,R3)=IKEY C DATA-SET CAPACITY (-CAP FOR DETAIL) IF (ICFLG.EQ.1) GO TO 284 CALL DBINF(2HS ,2,IBUF(9),IBUF) IF(IBUF(5).EQ.104B) GOTO 282 ICAPAC=IBUF(6) GOTO 284 282 ICAPAC=-IBUF(6) 284 CONTINUE 285 S(11,R3)=ICAPAC ICFLG=1 C C DECODE RELATIONAL OPERATOR 290 GO TO (291,292,293,294,295) (J-I+1) C ERROR - RELATIONAL OPERATOR INVALID 291 CALL REIO(2,ITTY,ERR4,14) GO TO 10 292 S(2,R3)=1 IF(JSCOM(IB,I,J,IS,1,IERR).EQ.0) GO TO 300 IF(JSCOM(IB,I,J,IE,1,IERR).EQ.0) GO TO 300 GO TO 291 293 S(2,R3)=2 IF(JSCOM(IB,I,J,INE,1,IERR).EQ.0) GO TO 300 S (2,R3) = 3 IF(JSCOM(IB,I,J,ILT,1,IERR).EQ.0) GO TO 300 S(2,R3) = 5 IF(JSCOM(IB,I,J,IGT,1,IERR).EQ.0) GO TO 300 GO TO 291 294 S(2,R3)=4 IF(JSCOM(IB,I,J,INLT,1,IERR).EQ.0) GO TO 300 S(2,R3) = 6 IF(JSCOM(IB,I,J,INGT,1,IERR).EQ.0) GO TO 300 GO TO 291 295 S(2,R3)=2 IF (JSCOM(IB,I,J,INA,1,IERR).NE.0) GO TO 291 C GET DATA ITEM VALUE AND PUT IN QSKIB FILE C ENTER SECTOR AND WORD OFFSET OF VALUE 300 S(3,R3)=IOFF S(6,R3)=NOWSEC 350 CALL LSCAN(IB,I,J,K) IF (K.EQ.3) GO TO 400 C ERROR - ILLEGAL DATA ITEM VALUE OR TERMINATOR CALL REIO(2,ITTY,ERR16,19) GO TO 10 400 LEN=J-I+1 IF (LEN.EQ.0) GO TO 405 C MOVE VALUE FOR CONVERSION IF (LEN.LE.MAXLN) GO TO 421 C DATA ITEM VALUE TOO LONG CALL REIO(2,ITTY,ERR13,13) GO TO 10 421 CALL SMOVE(IB,I,J,IMA,1) GO TO 410 C REQUEST VALUE FORM USER 405 CALL REIO(2,ITTY,VALUE,11) CALL REIO(2,ITTY,DINAM,3) CALL REIO(2,ITTY,2H?_,1) CALL REIO(1,ITTY,IMA,-72) REG=CLRIO(J) CALL SGET(IMA,LEN,ICHAR) IF (ICHAR.EQ.73B)LEN=LEN-1 C INPUT IS NULL IF (LEN.EQ.0) GO TO 405 C FILL LAST BYTE WITH BLANK 410 CALL SPUT(IMA,(LEN+1),ISPACE) C CONVERT REAL OR INTEGER VALUE FORM ASCII IF (ITYPE.EQ.U) GO TO 416 IF (ITYPE.EQ.R) GO TO 417 C CONVERT TO INTEGER CALL SZONE(IMA,LEN,4,NOZ) CALL CATI(IMA,1,LEN,INT,ISTAT) IF (ISTAT.EQ.0) GO TO 418 C NON-NUMERIC IN REAL OR INTEGER VALUE 419 CALL REIO (2,ITTY,ERR12,19) GO TO 10 418 IF (NOZ.EQ.2) INT=-INT IMA(1)=INT LEN=2 GO TO 416 C CONVERT TO REAL 417 REAL=CATR(IMA,1,LEN,ISTAT) IF (ISTAT.NE.0) GO TO 419 CALL SMOVE (REAL,1,4,IMA,1) LEN=4 C ENTER VALUE 416 LENFLG=0 C LENGTH IN WORDS LEN=(LEN+1)/2 DO 411 MOVE=0,LEN IF (LENFLG.EQ.1) GO TO 414 ISORT(IOFF)=LEN LENFLG=1 GO TO 415 414 ISORT(IOFF)=IMA(MOVE) 415 IOFF=IOFF+1 IF (IOFF.LE.ISC$"IZE) GO TO 411 C BUFFER FULL - WRITE TO QSKIB IF ((NOWSEC+IQSEC).LE.NSEC) GO TO 412 C NOT ENOUGH SECTORS IN QSKIB 413 CALL REIO(2,ITTY,ERR8,14) GO TO 10 412 CALL EXEC (2,IDILU,ISORT,ISIZE,TRKNM,NOWSEC) NOWSEC=NOWSEC+IQSEC IOFF=1 411 CONTINUE S(4,R3)=S(4,R3)+1 S(7,R3)=S(7,R3)+1 CALL LSCAN (IB,I,J,K) IF (K.EQ.4) GO TO 350 IF (K.EQ.2) GO TO 500 C ERROR - ILLEGAL DATA ITEM VALUE OR TERMINATOR CALL REIO (2,ITTY,ERR16,19) GO TO 10 500 IF (S(2,R3).LT.3) GO TO 620 IF (S(4,R3).EQ.1) GO TO 620 C ERROR - INVALID # OF VALUES FOR RELATIONAL OPERATOR CALL REIO(2,ITTY,ERR6,22) GO TO 10 C ERROR - INVALID LOGICAL CONNECTOR 610 DO 611 M=14,16 611 ERR7(M)=2H M=J IF((M-I+1).GT.6) M=I+5 CALL SMOVE(IB,I,M,ERR7,27) C ERROR - ILLEGAL DATA ITEM VALUE OR TERMINATOR CALL REIO(2,ITTY,ERR7,16) GO TO 10 620 IF (J-I+1.NE.3) GO TO 640 IF (JSCOM(IB,I,J,AND,1,IERR).NE.0) GO TO 650 S(5,R3) = 1 630 R3 = R3 + 1 GO TO 200 640 IF (J-I+1.NE.2) GO TO 610 IF (JSCOM(IB,I,J,OR,1,IERR).NE.0) GO TO 610 S(5,R3) = 2 GO TO 630 650 IF(JSCOM(END,1,4,IB,I,IERR).NE.0) GO TO 610 S(5,R3) = 3 C C MOVE VALUES ARRAY, ISORT, TO IMA DO 720 J=1,(IOFF-1) IMA(J)=ISORT(J) 720 CONTINUE IF (NOWSEC.EQ.0) GO TO 750 C WRITE LAST SECTORS TO QSKIB FILE IF ((NOWSEC+IQSEC).GT.NSEC) GO TO 413 CALL EXEC (2,IDILU,ISORT,ISIZE,TRKNM,NOWSEC) C SAVE CURRENT SECTOR NUMBER OF QSKIB 750 IMA(ISIZE+1)=NOWSEC C CALL SEARCH TO RETRIEVE RECORDS SNAM(2) = 2H01 CALL EXEC(8,SNAM) END $ sH$FTN4,L,C PROGRAM QS01(5,90),92063-16011 REV. 1840 780731 C C C************************************************************* C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * C RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * C PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * C OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C************************************************************* C C C LISTING: 92063-19011 C SOURCE: 92063-18011 C RELOC: 92063-16011 C C C************************************************************ C C C*********************************************************************** C C SEARCH SERVICE MODULE C C QS01 ENTERS RECORD NUMBERS OF RECORDS WHICH SATISFY THE FIND C IN THE SELECT FILE, AND PRINTS ON TTY THE TOTAL NUMBER OF C QUALIFYING RECORDS. QS01 OBTAINS INFORMATION ABOUT THE C FIND FROM THE S-ARRAY, WHICH IS BUILT BY QS00 C S IS A 12,50 ARRAY. EACH ROW CONTAINS THE FOLLOWING C INFORMATION ABOUT A RELATION: C 1. DATA ITEM NUMBER C 2. RELATION CODE C 1-IS,IE C 2-INE,ISNOT C 3-ILT C 4-INLT C 5-IGT C 6-INGT C 3. QSKIB WORD OFFSET. QSKIB IS A RTE DISC TRACK C WHICH CONTAINS ALL DATA ITEM VALUES IN A FIND, C IN A2 FORMAT, 2 CHARACTERS PER WORD, EACH VALUE C PRECEEDED BY ITS CHARACTER LENGTH. THIS PARAMETER C POINTS TO THE WORD OFFSET OF THE FIRST VALUE C FOR THIS RELATION, FROM THE BEGINNING OF A BLOCK. C 4. NUMBER OF DATA ITEM VALUES FOR THIS RELATION C 5. LOGICAL CONNECTOR CODE C NEXT CONNECTOR IS: C 1-AND C  2-OR C 3-END C 6. QSKIB SECTOR OFFSET. CONTAINS THE SECTOR NUMBER, C OF THE FIRST SECTOR IN THE BLOCK, OF THE FIRST C VALUE FOR THIS RELATION C 7. NUMBER OF DATA ITEM VALUES FOR THIS RELATION, C LESS VALUES FOR DUPLICATE KEYS. QS00 SETS THIS C PARAMETER TO NUMBER OF DATA ITEM VALUES (SAME C AS ROW 4). IF A CHAINED OR KEYED READ IS C POSSIBLE, QS01 SEARCHES FOR DUPLICATE KEYS C WITH DUPLICATE ITEM VALUES. WHEN ONE IS FOUND, C THIS PARAMETER IS DECREMENTED. C 8. DATA ITEM TYPE. ASCII CODE IN R1 FORMAT: C "I"-INTEGER C "R"-REAL C "U"-ASCII C 9. LENGTH OF DATA ITEM IN WORDS C 10. OFFSET IN WORDS OF THIS ITEM FROM BEGINNING OF C RECORD. C 11. DATA SET CAPACITY C POSITIVE FOR MASTERS,NEGATIVE FOR DETAILS C 12. KEY CODE C 0-ITEM IS NOT A KEY C 1-ITEM IS A KEY C C STRATEGY C ASSUME AN "AND STRING" IS THE LONGEST STRING OF PRECEEDING ANY "OR" OR "END" . C IF THERE IS AT LEAST ONE KEY ITEM WITH AN "IS" RELATION C IN EVERY "AND STRING" C 1. A KEYED READ WILL BE PERFORMED IF THE SET IS MASTER C 2. CHAIN READ(S) WILL BE PERFORMED IF THE SET IS DETAIL C AND IF THE # OF CHAIN DOES NOT EXCEED A SPECIFIED MAXIMUM. C THE CHAIN OR KEYED READ WILL BE PERFORMED FOR EACH VALUE C OF THE KEY SPECIFIED IN THE RELATION C NOTE: THE KEY WILL BE THE FIRST KEY ENCOUNTERED ON KEY "IS" C IN THE "AND STRING". FOR MAX EFFICIENCY, THE USER SHOULD C SPECIFY THE KEY WHOSE VALUES HAVE @THE SHORTEST CHAIN(S) C AS THE FIRST KEY IN AN "AND STRING" C C IF THERE IS AT LEAST ONE "AND STRING" WHICH DOES NOT CONTAIN C AT LEAST ONE KEY ITEM WITH AN "IS" RELATION, A SERIAL C READ IS PERFORMED. C A KEYED READ GETS ONLY ONE RECORD WITH THE SPECIFIED C KEY ITEM VALUE IN THE MASTER SET. C A CHAIN READ GETS EVERY RECORD WITH THE KEY ITEM C VALUE IN THE DETAIL SET. C A SERIAL READ GETS EVERY RECORD IN THE DATA SET. C EVERY RECORD IS EVALUATED FOR THE ENTIRE . C IF IT QUALIFIES, THE RECORD # IS PLACED IN THE SELECT FILE. C IF CHAIN OR CERTAIN KEYED READS ARE BEING PERFORMED, THE C QUALIFYING RECORD # IS ORED INTO A BITMAP TO PREVENT C DUPLICATION. UPON COMPLETION OF ALL RECORD READS, C QUALIFYING RECORD NUMBERS IN THE BIT MAP ARE PLACED IN C THE SELECT FILE. C C DEFINITION OF VARIABLES C KEYS-ARRAY OF INDICES TO S-ARRAY FOR ITEMS IN CHAIN OR KEYED C READS C NKEYS-COUNT OF KEY ITEMS FOR CHAIN READS C BITFLG IS SET TO 1 IF BITMAP WILL NOT BE USED, 2 IF IT C WILL BE USED. C 1-SERIAL READ, C KEYED OR CHAIN READ, ONLY 1 KEY C KEYED READ, ALL VALUES IN CORE, SO DUPLICATES C HAVE BEEN RESOLVED C 2-CHAIN READ, MORE THAN 1 KEY C KEYED READ, MORE THAN 1 KEY, ALL VALUES NOT IN CORE C SELBUF-128-WORD BUFFER CONTAINING QUALIFYING RECORD #S. C WHEN FULL, IT IS WRITTEN TO NEXT SECTOR OF SELECT BUFFER C SELPTR-POINTER TO SELBUF C IRSEC-SECTOR POINTER TO SELBUF C IRRCNT-NUMBER OF RECORDS RETRIEVED C QSKIB-FILE CONTAINING ALL DATA ITEM VALUES IN FIND C IMA-CORE BUFFER CONTAINING VALUES (BLOCK FROM QSKIB) C ISIZE-SIZE OF CORE BUFFER CONTAINING VALUES C IMA(ISIZE+@1)-SECTOR # SPECIFYING QSKIB BLOCK CURRENTLY IN IMA C ISORT-BUFFER INTO WHICH RECORD IS READ C BUFPTR-ISORT POINTER. POINTS TO HALF OF ISORT INTO WHICH C RECORD IS READ C KEYPTR-IF A KEY "IS" IS FOUND IN "AND STRING", KEYPTR C IS COLUMN NDX TO S-ARRAY FOR THAT RELATION, ELSE C KEYPTR IS 0 C MAXCHN-MAX # OF CHAINS FOR CHAIN READS IN DETAILS C DSNUM-DATA SET #, SET BY QS00 C DINUM-DATA ITEM # C ITYPE-DATA ITEM TYPE C *LOOP1* KEYNDX-NDX IN DO LOOP FOR CHAIN OR KEYED READS. POINTS TO C KEY ENTRY IN KEY ARRAY, ONE PASS THRU LOOP FOR EVERY KEY C I-NDX TO S-ARRAY FOR CURRENT KEY ON KEY OR CHAIN READ, C POINTED TO BY KEYNDX C *LOOP2* VALPTR-NDX IN DO LOOP FOR VALUES IN CHAIN OR KEY READS. C ONE PASS FOR EACH VALUE IN RELATION. C NVAL-TERMINAL VALUE FOR DO LOOP. # OF VALUES FOR KEY IN C RELATION. C IOFF1-WORD OFFSET IN QSKIB FILE OF VALUE ARGUEMENT IN C CHAIN OR KEYED READ C ISEC1-SECTOR OFFSET IN QSKIB FILE OF VALUE ARGUEMENT IN C CHAIN OR KEYED READ C IARG1-ARRY CONTAINING DATA ITEM VALUE USED AS VALUE ARG C IN CHAIN OR KEYED READ. ENTERED BY VALUE SUBROUTINE C *LOOP3* ITEM-NDX IN DO LOOP WHICH READS AND EVALUATES: C 1.EACH RECORD IN CHAIN ON A CHAIN READ C 2.1 RECORD ON A KEYED READ C 3.EACH RECORD IN THE DATA SET ON A SERIAL READ C LOOP-TERMINAL VALUE FOR LOOP. C 1.ON CHAIN READ-# OF RECORDS IN CHAIN C 2.ON KEYED READ-1 C 3.ON SERIAL READ-CAPACITY OF DATA SET C RECNO-RECORD # OF CURRENT RECORD BEING EVALUATED C AND-0 IF "AND STRING" FALSE C 1 IF "AND STRING" TRUE C *LOOP4* RDB-NDX TO DO LOOP FOR EVALUATING CURRENT RECORD FOR C EVERY RELATION IN S-ARRAY. RDB IS COLUMN ND2/X C TO S-ARRAY C R3-TERMINAL VALUE IN DO LOOP. # OF ENTRIES IN S-ARRAY. C SET BY QS00. C LOGIC-0 IF RELATION FALSE IN C (RELATION) IN CURRENT RECORD C 1 IF RELATION TRUE IN CURRENT RECORD C FOR MULTIVALUE: IS OR IE-SET TO 1 IF TRUE FOR AT LEAST C 1 DATA ITEM VALUE C INE OR ISNOT-SET TO 1 IF TRUE FOR EVERY C DATA ITEM VALUE C *LOOP5* IVAL-NDX TO DO LOOP FOR EVALUATING RECORD FOR EVERY C VALUE IN THE RELATIONAL. VALUE COUNTER C IARG2-ARRAY CONTAINING DATA ITEM VALUE FOR EVALUATION C OF RELATION. ENTERED BY VALUE SUBROUTINE. C *LOOP5* END C *LOOP4* END C *LOOP3* END C *LOOP2* END C *LOOP1* END C BITMAP-BITMAP OF RETRIEVED RECORDS.CORRESPONDING BIT SET TO 1 C IF RECORD QUALIFIES. C C*********************************************************************** C COMMON ITTY,ILP,IDCB(144),JDCB(144) COMMON DBNAM,DSNAM,DINAM,SELECT,SNAM COMMON DSNUM,DINUM,INTIAL,IMA,IB,IEND,ISCAN COMMON IPFLAG COMMON IRRCNT COMMON S,R3,TRKNM,IDILU C INTEGER DBNAM(3),DSNAM(3),DINAM(3) INTEGER SELECT(3),SNAM(3),PROCED INTEGER DSNUM,DINUM INTEGER S(12,50),R3,TRKNM INTEGER SELPTR,BITFLG,BUFPTR,SELSEC INTEGER RDB INTEGER YES INTEGER RC8 INTEGER ERROR INTEGER VALPTR INTEGER SPTR1,SPTR2,VALNDX INTEGER CHANCT INTEGER VALSIZ INTEGER RECNO INTEGER AND INTEGER OFFSET INTEGER COMP1,COMP2 INTEGER DISK,SELBUF,OVFLO INTEGER WORD,BIT,BITMAP,BITVAL INTEGER QUALFY INTEGER RECORD,QUAL INTEGER R,WRDPTR,BITPTR,GBIT C DIMENSION IMA(36),IB(349),ISORT(512) DIMENSION KEYS(50) DIMENSION PROCED(27) DIMENSION IANS(2),YES(2) DIMENSION ERROR(8) DIMENSION IARG1(64),IARG2(64) DIMENSION SELBUF(128),OVFLO(11) DIMENSION BITMAP(2048),BITVAL(16) DIMENSION QUALFY(13) DIMENSION ISTAT(4) DIMENSION ITEMP(2) C EQUIVALENCE(ITEMP(1),RSORT),(IARG2(2),RARG) C DATA PROCED/2H S,2HER,2HIA,2HL ,2HRE,2HAD,2H M,2HUS,2HT , 1 2HBE,2H P,2HER,2HFO,2HRM,2HED,2H, ,2HCO,2HNT,2HIN,2HUE, 1 2H (,2HYE,2HS ,2HOR,2H N,2HO),2H? / DATA YES/2HYE,2HS / DATA NO/2HNO/ DATA RC8/8/ DATA ERROR/2HER,2HRO,2HR ,2HNO,2H. ,2HXX,2HXX,2HXX/ DATA ISIZE /384/ DATA MAXCHN/5/ DATA VALSIZ/64/ DATA ISPACE/2H / DATA DISK/2/ DATA R/122B/ C SELECT FILE OVERFLOW DATA OVFLO/2H S,2HEL,2HEC,2HT ,2HFI,2HLE,2H O,2HVE,2HRF,2HLO,2HW / DATA BITVAL/1,2,4,8,16,32,64,128,256,512, 11024,2048,4096,8192,16384,100000B/ DATA QUALFY/2H ,2HXX,2HXX,2HXX,2H E,2HNT,2HRI,2HES,2H Q, 12HUA,2HLI,2HFI,2HED/ C C INITIALIZE PARAMETERS NKEYS=0 SELPTR=0 IRSEC=1 BITFLG=1 IRRCNT=0 BUFPTR=1 C PICK UP # OF SECTORS IN SELECT FILE IN SELSEC SELSEC=JDCB(6)/2 C IF MASTER SET, ISORT BUFFER PTR WILL POINT TO 2ND HALF OF ISORT, C SINCE DBMS USES 1ST HALF; FOR DETAILS, VICE-VERSA. IF (S(11,1).GT.0) BUFPTR=257 C C DETERMINE WHETHER CHAIN OR KEY READ POSSIBLE, AND SAVE KEY PTRS C IN KEYS ARRAY KEYPTR=0 DO 100 RDB=1,R3 C IS ITEM A KEY? IF (S(12,RDB).EQ.0) GO TO 1 C IS RELATION 'IS'? IF (S(2,RDB).NE.1) GO TO 1 C KEY "IS" ENCOUNTERED YET? IF NOT, SAVE PTR TO KEY ENTRY IN S. IF(KEYPTR.EQ.0) KEYPTR=RDB C AND CONNECTOR? 1 IF (S(5,RDB).EQ.1) GO TO 100 C IF NO KEY "IS" IN "AND STRING" GO TO SERIAL READ. IF(KEYPTR.EQ.0) GO TO 2 C ENTER S-ARRAY NDX OF KEY IN KEYS ARRAY NKEYS=NKEYS+1 KEYS(NKEYS)=KEYPTR KEYPTR=0 100  CONTINUE C KEYED OR CHAIN READ POSSIBLE GO TO 7 C C SERIAL READ C "SERIAL READ MUST BE PERFORMED, CONTINUE (YES OR NO)? 2 CALL REIO(2,ITTY,PROCED,27) CALL REIO(1,ITTY,IANS,2) IF(JSCOM(YES,1,3,IANS,1,IERR).EQ.0) GO TO 6 IF (IANS.NE.NO) GO TO 2 C SET RETRIEVE COUNT TO ZERO 3 IRRCNT=0 C RETURN TO NEXT? 4 SNAM(2)=2H CALL EXEC(RC8,SNAM) C ERROR - DBMS WRITE ERROR NO. XXXXXX 5 CALL CITA(ISTAT,ERROR(6)) CALL REIO(2,ITTY,ERROR,8) GO TO 3 C DO DIRECTED READ TO RESET RECORD PTR 6 IMODE=2 CALL DBGET(DSNUM,3,ISTAT,ISORT(BUFPTR),0) IF (ISTAT.NE.0) GO TO 5 C INITIALIZE DO-LOOP PARAMETERS TO GO THRU KEYED READ LOOPS ONCE C SET LOOP COUNT TO CAPACITY LOOP=IABS(S(11,1)) KEYNDX=0 NKEYS=0 VALPTR=1 NVAL=1 GO TO 14 C C SEARCH FOR DUPLICATE KEYS IF # OF KEYS>1 AND ALL VALUES IN CORE 7 IF (NKEYS.EQ.1) GO TO 9 IF (IMA(ISIZE+1).NE.0) GO TO 9 C LOOP FOR EACH KEY IN KEYS ARRAY DO 600 KEYPT1=1,(NKEYS-1) SPTR1=KEYS(KEYPT1) ITEM1=S(1,SPTR1) C LOOP FOR ALL FOLLOWING KEYS IN KEYS ARRAY DO 500 KEYPT2=(KEYPT1+1),NKEYS SPTR2=KEYS(KEYPT2) ITEM2=S(1,SPTR2) IF (ITEM1.NE.ITEM2) GO TO 500 C TWO KEYS HAVE SAME ITEM #, NOW SEE IF VALUES MATCH IOFF1=S(3,SPTR1) C LOOP FOR ALL VALUES OF 1ST ITEM DO 400 IVAL1=1,S(4,SPTR1) LEN1=IABS(IMA(IOFF1)) IOFF2=S(3,SPTR2) C LOOP FOR ALL VALUES OF 2ND ITEM DO 300 IVAL2=1,S(4,SPTR2) LEN2=IABS(IMA(IOFF2)) IF (LEN1.NE.LEN2) GO TO 8 IPTR1=IOFF1+1 IPTR2=IOFF2+1 C COMPARE VALUES DO 200 VALNDX=1,LEN1 " IF (IMA(IPTR1).NE.IMA(IPTR2)) GO TO 8 IPTR1=IPTR1+1 IPTR2=IPTR2+1 200 CONTINUE C***** IDENTICAL VALUES HAVE BEEN FOUND - NEGATE C LENGTH FOR 2ND VALUE AND DECREMENT # OF VALUES C IN S ARRAY IMA(IOFF2)=-IMA(IOFF2) S(7,SPTR2)=S(7,SPTR2)-1 8 IOFF2=IOFF2+LEN2+1 300 CONTINUE IOFF1=IOFF1+LEN1+1 400 CONTINUE 500 CONTINUE 600 CONTINUE C C IF DETAIL SET AND CHAIN READS CAN BE PERFORMED, CHECK WHETHER C TOTAL # OF CHAINS EXCEEDS MAX. IF SO, DO SERIAL READ. 9 IF (S(11,1).GT.0) GO TO 10 CHANCT=0 DO 700 KEYCNT=1,NKEYS RDB=KEYS(KEYCNT) CHANCT=CHANCT+S(7,RDB) IF (CHANCT.GT.MAXCHN) GO TO 2 700 CONTINUE C C SET BITFLG TO 2 IF MORE THAN 1 KEY AND C A. DETAIL OR C B. MASTER WITH ALL VALUES NOT IN CORE (IN WHICH CASE C DUPLICATE KEY VALUES NOT ELIMINATED) C BITFLG=2 MEANS RETRIEVAL OF DUPLICATE RECORDS POSSIBLE. 10 IF (NKEYS.EQ.1) GO TO 12 IF (S(11,1).LT.0) GO TO 11 IF (IMA(ISIZE+1).EQ.0) GO TO 12 11 BITFLG=2 C C C THE FOLLOWING SERIES OF LOOPS READS RECORDS,EVALUATES THEM C FOR THE FIND, AND PUTS THEM IN SELECT FILE OR BITMAP IF C THEY QUALIFY C C LOOP TO PERFORM CHAIN OR KEYED READS FOR EACH KEY IN KEYS ARRAY 12 DO 1500 KEYNDX=1,NKEYS I=KEYS(KEYNDX) IOFF1=S(3,I) ISEC1=S(6,I) NVAL=S(4,I) C C LOOP TO PERFORM CHAIN OR KEYED READS FOR EACH VALUE C ASSOCIATED WITH KEY ITEM DO 1400 VALPTR=1,NVAL DO 800 J1=1,VALSIZ 800 IARG1(J1)=ISPACE C PICK UP VALUE OF KEY ITEM IN IARG1 CALL VALUE(IARG1,ISEC1,IOFF1) C % IF KEY VALUE DUPLICATE, LOOP TO GET NEXT VALUE IF (IARG1(1).LT.0) GO TO 1400 IF (S(11,I).LT.0) GO TO 13 C FOR MASTER, CHAIN COUNT IS ALWAYS 1, SET MODE FOR KEYED C READ IMODE=4 LOOP=1 GO TO 14 13 IMODE=1 DINUM=S(1,I) C FOR DETAIL,SET UP FOR CHAIN READ AND PICK UP CHAIN COUNT CALL DBFND(ISTAT,DSNUM,DINUM,IARG1(2)) IF (ISTAT.NE.0) GO TO 5 LOOP=ISTAT(3) IF(LOOP .EQ. 0) GOTO 1400 C C LOOP TO READ EACH RECORD IN A CHAIN OR, ON SERIAL READ, C EACH RECORD IN THE DATA SET 14 DO 1300 ITEM=1,LOOP C READ RECORD INTO ISORT(BUFPTR) IF (IFBRK(IDUM).NE.0) GOTO 4 CALL DBGET(DSNUM,IMODE,ISTAT,ISORT(BUFPTR),IARG1(2)) IF (ISTAT.NE.0) GO TO 5 C END OF SERIAL READ? IF (ISTAT(2).EQ.0) GO TO 25 C RECORD # RECNO=ISTAT(2) C INITIALIZE EVALUATOR FOR "AND STRING" AND=1 C C LOOP TO EVALUATE ALL RELATIONS FOR THIS RECORD DO 1200 RDB=1,R3 C INITIALIZE RELATION INDICATOR LOGIC=0 OFFSET=S(10,RDB) LEN=S(9,RDB) IOFF2=S(3,RDB) ISEC2=S(6,RDB) C C LOOP FOR MULTI-VALUE RELATION DO 1100 IVAL=1,S(4,RDB) DO 900 J2=1,VALSIZ 900 IARG2(J2)=ISPACE C PICK UP VALUE IN IARG2 CALL VALUE(IARG2,ISEC2,IOFF2) COMP1=BUFPTR+OFFSET-1 IF (S(8,RDB).EQ.R) GO TO 170 p COMP2=2 C C LOOP TO COMPARE RECORD VALUE WITH FIND VAL DO 1000 ICOMP=1,LEN IF (ISORT(COMP1).EQ.IARG2(COMP2)) 1 GO TO 17 IF (ISORT(COMP1).GT.IARG2(COMP2)) 1 GO TO 16 C IF REC VALFIND VAL AND INLT,IGT-TRUE 16 GO TO (1100,1100,1100,18,18,1100) 1 S(2,RDB) 17 COMP1=COMP1+1 COMP2=COMP2+1 1000 CONTINUE GO TO 171 C COMPARE REAL RECORD VAL WITH REAL FIND VAL 170 ITEMP(1)=ISORT(COMP1) ITEMP(2)=ISORT(COMP1+1) IF (RSORT.LT.RARG) GO TO 15 IF (RSORT.GT.RARG) GO TO 16 C C REC VAL=FIND VAL---IS,INLT,INGT-TRUE; C ILT,IGT,ISNOT-FALSE 171 GO TO (18,19,19,18,19,18) S(2,RDB) C TRUE FOR AT LEAST 1 VALUE,JUMP OUT OF LOOP 18 LOGIC=1 GO TO 19 C NOT TRUE FOR THIS VALUE 1100 CONTINUE C C RELATION FALSE FOR ALL VALUES, SO TRUE IF ISNOT IF (S(2,RDB).EQ.2) LOGIC=1 C SUCCESSIVELY EVALUATE "AND STRING" 19 AND=AND*LOGIC IF (S(5,RDB).EQ.1) GO TO 1200 C END OF "AND STRING". t IF TRUE FOR 1 "AND STRING" C RECORD QUALIFIES, SO JUMP OUT OF LOOP IF (AND.EQ.1) GO TO 20 AND=1 1200 CONTINUE C ALL RELATIONS FALSE FOR THIS RECORD GO TO 1300 C C RECORD QUALIFIES, SAVE RECORD 20 IF (BITFLG.EQ.2) GO TO 23 C SAVE RECORD # IN SELECT FILE SELPTR=SELPTR+1 IF (SELPTR.LT.129) GO TO 22 CALL WRITF(JDCB,ISTAT,SELBUF,128,IRSEC) IF (ISTAT.LT.0) GOTO 24 IRSEC=IRSEC+1 SELPTR=1 IF (IRSEC.LE.(SELSEC-1)) GO TO 22 C SELECT FILE OVERFLOW 21 CALL REIO(2,ITTY,OVFLO,11) GO TO 3 24 CALL FMERR(ISTAT,ITTY) GOTO 3 22 SELBUF(SELPTR)=RECNO C INCREMENT RECORD COUNT IRRCNT=IRRCNT+1 GO TO 1300 C ENTER RECORD # IN BITMAP C GET APPROPRIATE WORD 23 WORD=RECNO/16 C GET BIT # BIT=RECNO-(WORD*16) C ADJUST WORD FOR ARRAY WORD=WORD+1 C SET CORRESPONDING BIT IN BITMAP BITMAP(WORD)=IOR(BITMAP(WORD),BITVAL(BIT+1)) 1300 CONTINUE C 1400 CONTINUE C 1500 CONTINUE C C C FINAL WRAPUP - ALL RECORDS HAVE BEEN COMPARED 25 IF (BITFLG.EQ.2) GO TO 27 C IF ANY RECORDS QUALIFY WRITE BUFFER TO SELECT FILE 26 IF (SELPTR.NE.0) CALL WRITF(JDCB,ISTAT,SELBUF,SELPTR,IRSEC) IF((SELPTR.NE.0).AND.(ISTAT.LT.0))GOTO 24 CALL CITA(IRRCNT,QUALFY(2)) C WRITE # OF QUALIFYING RECORDS AND CALL QS TO PRINT NEXT? CALL REIO(2,ITTY,QUALFY,13) GO TO 4 C C GET RECORD #'S FROM BITMAP (HFB27 RECORD=0 DO 1700 WRDPTR=1,2048 IF (BITMAP(WRDPTR).NE.0) GO TO 28 RECORD=RECORD+16 GO TO 1700 28 DO 1600 BITPTR=1,16 QUAL=GBIT(BITMAP(WRDPTR)) IF(QUAL.EQ.0) GO TO 30 SELPTR=SELPTR+1 IF (SELPTR.LT.129) GO TO 29 CALL WRITF(JDCB,ISTAT,SELBUF,128,IRSEC) IF (ISTAT.LT.0) GOTO 24 IRSEC=IRSEC+1 SELPTR=1 IF (IRSEC.GT.SELSEC) GO TO 21 29 SELBUF(SELPTR)=RECORD C INCREMENT RECORD COUNT IRRCNT=IRRCNT+1 30 RECORD=RECORD+1 1600 CONTINUE 1700 CONTINUE GO TO 26 END END$ HFTN4,L,C PROGRAM QS02(5,90),92063-16011 REV. 1826 771027 C C C************************************************************* C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * C RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * C PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * C OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C************************************************************* C C C LISTING: 92063-19011 C SOURCE: 92063-18011 C RELOC: 92063-16011 C C C************************************************************ C C C REPORT SERVICE ROUTINE C MADE UP OF C 1. QS02 C 2. QS03 C 3. QS04 C 4. QS05 C 5. QS06 C 6. QS15 C 7. QS12 C COMMON ITTY,ILP,IDCB(144),JDCB(144) COMMON DBNAM,DSNAM,DINAM,SELECT,SNAM COMMON DSNUM,DINUM,INTIAL,IMA,IB,IEND,ISCAN COMMON IPFLAG COMMON IRRCNT,S,R3,TRKNM,IDILU,R5 COMMON R6 C INTEGER DBNAM(3),DSNAM(3),DINAM(3) INTEGER SELECT(3),SNAM(3) INTEGER DSNUM,DINUM DIMENSION IMA(36),IB(349),ISORT(385) C C ANY CHANGE IN SIZE OF 'IB' - MUST CHANGE CORRESPONDING SIZE C IN 'IF' STATEMENT IN LINE # 555 AND 5555 C DIMENSION IBUF(10) INTEGER S(6,100),R3,R6,R7,Z,Z1,R5,TRKNM INTEGER PAGE(3) INTEGER A,B,D,E,F,G,H,T,ASTER,DOLLAR INTEGER ERR1(15) INTEGER ERR2(20) INTEGER ERR3(12) INTEGER ERR4(7) INTEGER ERR5(13) INTEGER ERR6(16) INTEGER ERR7(11) DIMENSION NAME(2) INTEGER END(2) INTEGER ALL(2) INTEGER REPORT(3) C DATA PAGE/2HPA,2HGE,2HNO/ DATA A/101B/ DATA B/102B/ DATA D/104B/ DATA E/105B/ DATA F/106B/ DATA G/107B/ DATA H/110B/ DATA N/116B/ DATA IS/123B/ DATA T/124B/ DATA IZ/132B/ DATA DOLLAR/44B/ DATA ASTER/52B/ DASTA NINE/71B/ DATA ERR1/2H R,2HEC,2HOR,2HD ,2HHA,2HS ,2HNO, 1 2HT ,2HYE,2HT ,2HBE,2HEN,2H F,2HOU,2HND/ DATA ERR2/2H C,2HOM,2HMA,2HND,2H T,2HAB, 1 2HLE,2H O,2HVE,2HRF,2HLO,2HW,,2H R, 2 2HEI,2HSS,2HUE,2H C,2HOM,2HMA,2HND/ DATA ERR3/2H I,2HLL,2HEG,2HAL,2H D, 1 2HAT,2HA ,2HIT,2HEM,2H N,2HAM,2HE / DATA ERR4/2H S,2HYN,2HTA,2HX ,2HER,2HRO,2HR / DATA ERR5/2H E,2HDI,2HT ,2HMA,2HSK,2H T, 1 2HAB,2HLE,2H O,2HVE,2HRF,2HLO,2HW / DATA ERR6/2H C,2HON,2HST,2HAN, 1 2HT ,2HLI,2HTE,2HRA,2HL ,2HTA, 2 2HBL,2HE ,2HOV,2HER,2HFL,2HOW/ DATA ERR7/2H P,2HRO,2HCE,2HDU,2HRE,2H N,2HOT, 12H D,2HEF,2HIN,2HED/ DATA NAME/2HNA,2HME/ DATA END/2HEN,2HD;/ DATA ALL/2HAL,2HL / DATA REPORT/2HRE,2HPO,2HRT/ C C IRRCNT IS RETRIEVED RECORD COUNT C C THIS PROGRAM IS A REPORT GENERATOR. THE C SELECT-FILE CONTAINS THE RECORD NUMBERS C OF THE RECORDS WHICH ARE TO BE REPORTED. C C THE ARRAY S IS A 6*100 ARRAY WHICH C CONTAINS ENCODED REPORT COMMANDS. C IF (IRRCNT.NE.0) GO TO 10 C ERROR - NO RECORD FOUND YET CALL REIO(2,ITTY,ERR1,15) GO TO 350 C 10 DO 1 J=1,100 DO 1 I=1,6 S(I,J) = 0 1 CONTINUE C C R3 - IS THE COUNTER FOR THE NUMBER OF C COMMANDS ENTERED C R6 - IS THE CONSTANT LITERAL AND C EDIT MASK DISK STORAGE INDEX C R7 - IS THE EDIT MASK COUNT C R3 = 1 R6 = 1 R7 = 0 IOFLAG = 0 C CHECK FOR PROCEDURE 20 CALL LSCAN(IB,I,J,K) IF(J-I.NE.3) GOTO 190 IF(JSCOM(NAME,1,4,IB,I,IERR).NE.0) GO TO 190 C SCAN ACROSS = CALL LSCAN(IB,I,J,K) IF(K.NE.6) GO TO 270 C GET PROCEDURE NAME CALL LSCAN(IB,I,J,K) IF(K.NE.2) GO TO 270 IF(J-I.GT.5) GO TO 270 DO 30 N=1,3 30 IMA(N) = 2H CALL SMOVE(IB,I,J,IMA,1) IPFLAG = 1 CALL LSCAN(IB,I,J,K) IF(K.EQ.5) GOTO 40 IOFLAG = 1 IPFLAG = 35 40 CONTINUE CALL OPEN(IDCB,IERR,IMA,1) IF (IERR.NE.-6) GOTO 45 CALL REIO(2,ITTY,ERR7,-22) GOTO 390 45 IF (IERR.GE.0) GOTO 46 CALL FMERR(IERR,ITTY) 46 CALL INPUT C SCAN ACROSS "REPORT" CALL LSCAN(IB,I,J,K) IF(J-I.NE.5) GOTO 270 IF(JSCOM(IB,I,J,REPORT,1,IERR).NE.0) GOTO 270 180 CALL LSCAN(IB,I,J,K) 190 CALL SGET(IB,I,ICHAR) IF(J-I.NE.2) GOTO 200 IF(JSCOM(IB,I,J,END,1,IERR).EQ.0) GO TO 850 IF(JSCOM(IB,I,J,ALL,1,IERR).EQ.0) GO TO 870 200 CONTINUE IF(J-I.GT.1) GO TO 270 C C SORT STATEMENT C C IS ICHAR AN "S"? C IF (ICHAR.NE.IS) GO TO 440 IF (I.NE.J) GO TO 240 S(1,R3) = 10 GO TO 330 240 CALL SGET(IB,J,ICHAR) ICHAR = ICHAR - 60B IF (ICHAR.LT.1 .OR. ICHAR.GT.5) GO TO 270 S(1,R3) = 10 + ICHAR C SCAN FOR COMMA 330 CALL LSCAN(IB,I,J,K) IF (K.NE.4) GO TO 270 C GET DATA ITEM NAME CALL LSCAN(IB,I,J,K) IF (K.NE.2) GO TO 270 IF (J-I.GT.5) GO TO 270 C CHECK DATA ITEM NAME CALL SFILL(DINAM,1,6,40B) CALL SMOVE(IB,I,J,DINAM,1) ITYPE = 2HI CALL DBINF(ITYPE,5,DINAM,IBUF) IF(IBUF.NE.0) GOTO 380 S(2,R3) = IBUF(2) C SCAN TO ; CALL LSCAN(IB,I,J,K) IF (K.NE.5) GO TO 270 340 R3 = R3 +1 IF (R3.NE.100) GO TO 180 C ERROR - COMMAND TABLE OVERFLOW CALL REIO(2,ITTY,ERR2,20) 350 SNAM(2) = 2H CALL EXEC(8,SNAM) C C ERROR - CONSTANT LITERAL OVERFLOW 360 CALL REIO(2,ITTY,ERR6,16) GO TO 350 C ERROR - ILLEGAL DATA ITEM NAME 380 CALL REIO(2,ITTY,IB,-IEND) CALL REIO(2,ITTY,ERR3,12) C RETURN TO TTY FOR INPUT 390 IPFLAG = 0 CALL INPUT IOFLAG = 0 GO TO 180 C ERROR - SYNTAX ERROR 270 DO 275 K=1,36 275 IMA(K) = 2H IF (IOFLAG.EQ.0) CALL REIO(2,ITTY,IB,-IEND) LEN = I+1 CALL SPUT(IMA(2),LEN,136B) IMA(1) = (LEN+1)/2 CALL REIO(2,ITG*TY,IMA(2),IMA) CALL REIO(2,ITTY,ERR4,7) IF(R3.EQ.1) GOTO 350 GO TO 390 C C HEADER STATEMENT C 440 IF (ICHAR.NE.H) GO TO 630 C HEADER NUMBER CALL SGET(IB,J,ICHAR) ICHAR = ICHAR - 60B IF (ICHAR.LT.1 .OR. ICHAR.GT.5) GO TO 270 S(1,R3) = 20 + ICHAR C SCAN FOR COMMA CALL LSCAN(IB,I,J,K) IF (K.NE.4) GO TO 270 C GET HEADER DATA TYPE CALL LSCAN(IB,I,J,K) IF (K.EQ.3) GO TO 500 IF(J-I.NE.5) GOTO 270 IF (JSCOM(PAGE,1,6,IB,I,IERR).NE.0) GO TO 270 S(2,R3) = 1 C SCAN FOR COMMA 450 CALL LSCAN(IB,I,J,K) IF (K.NE.4) GO TO 270 C END PRINT POSITION CALL LSCAN(IB,I,J,K) CALL CATI(IB,I,J-I+1,INT,ISTAT) IF(ISTAT.LT.0) GOTO 270 IF (INT.LT.1 .OR. INT.GT.132) GO TO 270 S(4,R3) = INT C C CHECK FOR SEMI-COLON C CALL LSCAN(IB,I,J,K) IF (K.EQ.5) GO TO 340 C C FORM REPORT OPTIONS C CALL REPOP(I) IF (R5) 270,340 C C HEADER LITERAL C 500 LEN = J - I + 1 IF(LEN.GT.0) GOTO 510 I=J+2 GOTO 270 510 CONTINUE IF(LEN.GT.72) GOTO 270 C MOVE LITERAL TO BUFFER ISORT(R6) = LEN CALL SMOVE(IB,I,J,ISORT,R6+R6+1) LEN = FLOAT(LEN)/2.0 + 0.5 S(3,R3) = R6 R6 = R6 + LEN + 1 555 IF (R6.GT.349) GO TO 360 GO TO 450 C C TOTAL STATEMENT C 630 K2 = 30 IF (ICHAR.NE.T) GO TO 820 CALL SGET(IB,J,ICHAR) IF (ICHAR.NE.F) GO TO 680 C SET ICHAR TO 6 ICHAR = 6 GO TO 730 680 ICHAR = ICHAR - 60B IF (ICHAR.LT.1 .OR. ICHAR.GT.5) GO TO 270 730 S(1,R3) = K2 + ICHAR C SCAN ACROSS TERMINATOR CALL LSCAN(IB,I,J,K) IF (K.NE.4) GO TO 270 C GET TOTAL DATA TYPE CALL LSCAN(IB,I,J,K) C TOTAL LITERAL IF (K.EQ.3) GO TO 500 C DATA ITEM IF (J-I.GT.5) GO TO 270 CALL SFILL(DINAM,1,6,40B) CALL SMOVE(IB,I,J,DINAM,1) ITYPE = 2HI CALL DBINF(ITYPE,5,DINAM,IBUF) IF(IBUF.NE.0) GOTO 380 S(2,R3) = IBUF(2) GO TO 450 C C C GROUP STATEMENT 820 K2 = 40 IF (ICHAR.NE.G) GO TO 830 CALL SGET(IB,J,ICHAR) GO TO 680 C C DETAIL STATEMENT C 830 IF(ICHAR.NE.D) GO TO 880 K2 = 50 ICHAR = 0 GO TO 730 C C CHECK FOR ; 850 CALL LSCAN(IB,I,J,K) IF (K.NE.5) GO TO 270 R3 = R3 - 1 IF(R3.LE.0) GOTO 350 C C WRITE ISORT TO QSKIB C CALL EXEC(2,IDILU,ISORT,R6,TRKNM,0) C C CALL LOGIC C SNAM(2) = 2H04 860 CALL EXEC(8,SNAM) C C CALL REPALL TO LIST ALL RETRIEVED DATA RECORDS C 870 SNAM(2) = 2H03 GO TO 860 C C EDIT STATEMENT C 880 IF(ICHAR.NE.E) GO TO 270 CALL SGET(IB,J,ICHAR) ICHAR = ICHAR - 60B IF (ICHAR.LT.0 .OR. ICHAR.GT.9) GO TO 270 S(1,R3) = 60 + ICHAR C SCAN PAST COMMA CALL LSCAN(IB,I,J,K) IF (K.NE.4) GO TO 270 C GET EDIT MASK CALL LSCAN(IB,I,J,K) IF (K.NE.3) GO TO 270 Z = 0 DO 5265 Z1=J,I,-1 CALL SGET (IB,Z1,ICHAR) C CHAR AN X - THEN ALPHA EDIT MASK IF(ICHAR.EQ.130B) GOTO 5266 C CHECK FOR 'Z' IF (ICHAR.NE.IZ) GO TO 5190 IF (Z.NE.1 .AND. Z.NE.0) GO TO 270 Z = 1 GO TO 5265 C C CHECK FOR '*' 5190 IF (ICHAR.NE.ASTER) GO TO 5230 IF (Z.NE.2 .AND. Z.NE.0) GO TO 270 Z = 2 GO TO 5265 C C CHECK FOR '$' 5230 IF (ICHAR.NE.DOLLAR) GO TO 5255 IF (Z.NE.3 .AND. Z.NE.0) GO TO 270 Z = 3 GO TO 5265 C C CHECK FOR '9' 5255 IF (ICHAR.NE.NINE) GO TO 5265 IF (Z.NE.0) GO TO 270 5265 CONTINUE C NUMERIC EDIT MASK C CHECK FOR NO MORE THAN 20 CHARACTERS IF(J-I.GT.19) GOTO 270 IF(J-1.LT.0) GOTO 270 GOTO 5269 C C ALPHA EDIT MASK - MAX 72 CHARS 5266 IF(J-I.GT.71) GOTO 270 C C EDIT MASK C 5269 CONTINUE LEN = J Xb$"- I + 1 C MOVE MASK TO BUFFER ISORT(R6) = LEN CALL SMOVE(IB,I,J,ISORT,R6+R6+1) LEN = FLOAT(LEN)/2.0 + 0.5 S(3,R3) = R6 R6 = R6 + LEN + 1 5555 IF (R6.GT.349) GO TO 360 R7 = R7 + 1 IF (R7.LE.10) GO TO 5270 C ERROR - EDIT MASK OVERFLOW CALL REIO(2,ITTY,ERR5,13) GO TO 350 C SCAN TO ';' 5270 CALL LSCAN(IB,I,J,K) IF (K.EQ.5) 340,270 END $ O$FTN4,L,C PROGRAM QS03(5,90),92063-16011 REV. 1826 771027 C C C************************************************************* C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * C RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * C PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * C OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C************************************************************* C C C LISTING: 92063-19011 C SOURCE: 92063-18011 C RELOC: 92063-16011 C C C************************************************************ C C C THIS MODULE WILL REPORT "ALL" DATA RECORDS C WITHOUT REPORT FORMATING OR EDITING C C NULL ASCII DATA-ITEMS WILL BE FILLED C WITH " "S; INTEGER AND REAL DATA-ITEMS WILL C PRINT AS ZEROS(0). C C IRRCNT IS A COUNT OF RETRIEVED RECORDS C WITHIN SELECT-FILE. C COMMON ITTY,ILP,IDCB(144),JDCB(144) COMMON DBNAM,DSNAM,DINAM,SELECT,SNAM COMMON DSNUM,DINUM,INTIAL,IMA,IB,IEND,ISCAN COMMON IPFLAG COMMON IRRCNT C INTEGER DBNAM(3),DSNAM(3),DINAM(3) INTEGER SELECT(3),SNAM(3) INTEGER DSNUM,DINUM DIMENSION IMA(36),IB(349) DIMENSION ISORT(256) DIMENSION ISELD(128) DIMENSION ITEMS(256) DIMENSION INFO(10) INTEGER ISTAT(4) INTEGER RECORD INTEGER ERROR(8) C C ERROR NO. XXXXXX DATA ERROR/2HER,2HRO,2HR ,2HNO,2H. ,2HXX,2HXX,2HXX/ DATA LIST/0/ C CALL LSCAN(IB,I,J,K) C C IF NOT A ';' - THEN DO NOT LIST C IF(K.NE.5) LIST=1 5 CALL EXEC(3,ILP+1100B,-1) IRSE = 1 IPTR = 130 DO 200 NUMBER=1,IRRCNT IF(IPTR.LT.129) GO TO 10 CALL READF(JDCB,ISTAT,ISELD,128,IL,IRSE) IF (ISTAT.GE.0) GOTO 1 CALL FMERR(ISTAT,ITTY) GOTO 300 1 IRSE = IRSE + 1 IPTR = 1 10 RECORD = ISELD(IPTR) IPTR = IPTR + 1 C C GET RECORD VIA DIRECTED READ C CALL DBGeET(DSNUM,3,ISTAT,ISORT,RECORD) IF(ISTAT.NE.0) GOTO 400 CALL REIO(2,ILP,2H ,-1) C C GET DATA-ITEM NUMBERS FOR THIS SET C CALL DBINF(2HI ,1,DSNUM,ITEMS) IF(ITEMS.NE.0) GO TO 300 C C DISPLAY ALL USER ACCESSIBLE ITEMS C DO 150 IT=1,ITEMS(2) DINUM = IABS(ITEMS(IT+2)) C C GET ITEM CHARACTERISTICS C CALL DBINF(2HI ,2,DINUM,INFO) IF(INFO.NE.0) GOTO 150 IOFF = INFO(8) C C LIST = 0 DISPLAY D-I NAMES C = 1 DO NOT DISPLAY NAMES C IF(LIST.EQ.0) GOTO 30 C C BLANK NAME = C DO 20 I=1,4 20 IMA(I) = 2H GOTO 40 C C FORMAT = C 30 CONTINUE IMA = 2H IMA(4) = 2H = CALL SMOVE(INFO,3,8,IMA,2) C C GET ITEM TYPE (I,R,U) C 40 CONTINUE CALL SGET(INFO,10,ITYPE) C INTEGER? IF(ITYPE.NE.111B) GO TO 50 CALL CITA(ISORT(IOFF),IMA(5)) CALL SPUT(IMA,9,40B) LEN = 7 IF(ISORT(IOFF).LT.0) CALL SZONE(IMA,14,2,I) GO TO 120 C C REAL? 50 IF(ITYPE.NE.122B) GO TO 60 CALL CRTA(IMA(5),1,8,ISORT(IOFF),0.5,0) LEN = 8 GO TO 120 C C MUST BE ASCII 60 LEN = INFO(7) IF (ISORT(IOFF).NE.0) GO TO 70 LEN = MOD(LEN,32) CALL SFILL(IMA(5),1,LEN+LEN,40B) LEN = LEN + 4 GO TO 120 C 70 IF(LEN.LE.32) GO TO 100 DO 80 I=1,32 IMA(I+4) = ISORT(IOFF) 80 IOFF = IOFF + 1 CALL REIO(2,ILP,IMA,36) IF (IFBRK(IDUM).NE.0) GOTO 300 LEN = LEN - 32 DO 90 I=1,4 90 IMA(I) = 2H GO TO 70 C 100 DO 110 I=1,LEN IMA(I+4) = ISORT(IOFF) IOFF = IOFF + 1 110 CONTINUE LEN = LEN + 4 120 CALL REIO(2,ILP,IMA,LEN) IF (IFBRK(IDUM).NE.0) GOTO 300 150 CONTINUE CALL REIO(2,ILP,2H ,-1) 200 CONTINUE 300 CALL REIO(2,ILP,2H ,-1) GOTO 301 C C OUTPUT LU LOCK ERROR MESSAGE C C C OUTPUT DBMS ERROR CODE 400 CALL CITA(ISTAT,ERROR(6)) CALL' REIO(2,ITTY,ERROR,8) GOTO 300 C C RETURN TO CONTROL SEGMENT C 301 SNAM(2)=2H CALL EXEC(8,SNAM) C END $ FTN4,L,C PROGRAM QS04(5,90),92063-16011 REV. 1826 780518 C C C************************************************************* C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * C RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * C PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * C OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C************************************************************* C C C LISTING: 92063-19011 C SOURCE: 92063-18011 C RELOC: 92063-16011 C C C************************************************************ C C C THIS PROGRAM PERFORMS ALL THE LOGIC C CHECKING FOR REPORT PROCEDURE C COMMON ITTY,ILP,IDCB(144),JDCB(144) COMMON DBNAM,DSNAM,DINAM,SELECT,SNAM COMMON DSNUM,DINUM,INTIAL,IMA,IB,IEND,ISCAN COMMON IPFLAG COMMON IRRCNT,S,R3,TRKNM,IDILU,R5 COMMON R6 C INTEGER DBNAM(3),DSNAM(3),DINAM(3) INTEGER SELECT(3),SNAM(3) INTEGER DSNUM,DINUM DIMENSION IMA(36),IB(349) INTEGER S(6,100),R3,X(6),Q(255),R5,TRKNM INTEGER R6 INTEGER ERR1(19) INTEGER ERR2(13) INTEGER ERR3(14) INTEGER ERR4(13) INTEGER ERR5(25) INTEGER ERR6(22) INTEGER ERR7(17) INTEGER ERR8(20) INTEGER ERR9(21) C DATA ERR1/2H S,2HOR,2HT ,2HLE,2HVE, 1 2HL ,2HXX,2H I,2HS ,2HMI,2HSS,2HIN, 2 2HG ,2HOR,2H D,2HUP,2HLI,2HCA,2HTE/ DATA ERR2/2H D,2HUP,2HLI,2HCA,2HTE,2H D, 1 2HAT,2HA ,2HIT,2HEM,2H N,2HAM,2HES/ DATA ERR3/2H C,2HON,2HTR,2HOL,2H B,2HRE, 1 2HAK,2H I,2HNC,2HON,2HSI,2HST,2HEN,2HCY/ DATA ERR4/2H D,2HUP,2HLI,2HCA,2HTE,2H E, 1 2HDI,2HT ,2HST,2HAT,2HEM,2HEN,2HTS/ DATA ERR5/2H I,2HNC,2HON,2HSI, 1 2HST,2HEN,2HCY,2H B,2HET,2HWE,2HEN, 2 2H O,2HPT,2HIO,2HNS,2H A,2HND,2H E, 3 2HDI,2HT ,2HST,2HAT,2HEM,2HEN,2HTS/ DATA ERR6/2H S,2HAM,2HE ,2HLI,2HNE,2HS , 1 2HHA,2HVE,2H C,2HON,2HFL,2HIC,2-5HTI,2HNG, 2 2H R,2HEP,2HOR,2HT ,2HOP,2HTI,2HON,2HS / DATA ERR7/2H C,2HON,2HST,2HAN,2HT , 1 2HLI,2HTE,2HRA,2HL ,2HHA,2HS , 2 2HED,2HIT,2H O,2HPT,2HIO,2HN / DATA ERR8/2H M,2HOR,2HE ,2HTH,2HAN,2H 5, 1 2H F,2HIE,2HLD,2HS ,2HAR,2HE ,2HBE, 2 2HIN,2HG ,2HTO,2HTA,2HLE,2HD ,2HON/ DATA ERR9/2H R,2HEP,2HOR,2HT ,2HCA,2HNN, 1 2HOT,2H B,2HE ,2HGE,2HNE,2HRA,2HTE,2HD , 2 2HDU,2HE ,2HTO,2H E,2HRR,2HOR,2HS / C IE = 0 C C SORT ARRAY S(6 * 100) BY REPORT STATEMENT C INDEX AND END PRINT POSITION C IF(R3.EQ.1) GOTO 65 DO 60 N = 1,R3-1 DO 50 I = N+1,R3 DO 10 J=1,6 X(J) = S(J,N) 10 CONTINUE IF (X(1) - S(1,I)) 50,20,30 20 IF (X(4) - S(4,I)) 50,50,30 30 DO 40 J=1,6 S(J,N) = S(J,I) S(J,I) = X(J) X(J) = S(J,N) 40 CONTINUE 50 CONTINUE 60 CONTINUE C C CHECK TO SEE IF SORT LEVELS ARE C 1) CONTIGUOUS, C 2) ONLY ONE STATEMENT APPEARS FOR C A NON-EMPTY SORT LEVEL, AND C 3) DATA ITEM NAMES DISTINCT C 65 R5 = 0 N = 11 DO 70 I=1,255 Q(I) = 0 70 CONTINUE DO 78 I=1,R3 IF(S(1,I).GT.15) GO TO 80 IF (S(1,I).EQ.10) GO TO 74 IF (S(1,I).EQ.N) GO TO 72 IN = N - 10 C ERROR - SORT LEVEL MISSING OR DUPLICATE CALL CITA(IN,IMA) ERR1(7) = IMA(3) CALL REIO(2,ITTY,ERR1,19) IE = 1 N = S(1,I) 72 N = N + 1 74 J = S(2,I) IF (Q(J).EQ.0) GO TO 76 C ERROR - DUPLICATE DATA ITEM NAMES CALL REIO(2,ITTY,ERR2,13) IE = 1 76 Q(J) = 1 R5 = R5 + 1 78 CONTINUE C C CHECK FOR A MATCH BETWEEN SORT LEVELS, C GROUPS, AND TOTALS (OTHER THAN FINAL) C 80 N = N - 11 DO 85 I=1,R3 IF (S(1,I).LT.30) GO TO 85 IF (S(1,I).GT.45) GO TO 90 J = S(1,I) - S(1,I)/10 * 10 IF (J.EQ.6) GO TO 85 IF (J.LE.N) GO TO 85 C ERROR - CONTROL BREAK INCONSISTENCY  CALL REIO(2,ITTY,ERR3,14) IE = 1 85 CONTINUE C C CHECK THAT EDIT MASKS ARE SEPARATE AND C DISTINCT, AND THAT EDIT MASKS SPECIFIED C IN A DETAIL, GROUP, OR TOTAL STATEMENT C APPEAR AS REPORT STATEMENTS C 90 DO 91 I=1,255 Q(I) = 0 91 CONTINUE DO 95 I=1,R3 IF (S(1,I).LT.30) GO TO 95 IF (S(1,I).LE.50) GO TO 94 IF (S(1,I).NE.Q(11))GO TO 92 C ERROR - DUPLICATE EDIT STATEMENTS CALL REIO(2,ITTY,ERR4,13) IE = 1 92 Q(11) = S(1,I) DO 93 J=1,10 IF (Q(11).NE.Q(J))GO TO 93 Q(J) = 0 GO TO 95 93 CONTINUE GO TO 97 94 J = S(6,I) - S(6,I)/100 * 100 IF (J.LT.60) GO TO 95 N = J - 59 Q(N) = J 95 CONTINUE DO 96 I=1,10 IF (Q(I).NE.0) GO TO 97 96 CONTINUE GO TO 100 C ERROR - INCONSISTENCY BETWEEN OPTION AND EDIT STATEMENTS 97 CALL REIO(2,ITTY,ERR5,25) IE = 1 C C CHECK THAT THE SAME LINES DO NOT HAVE C DUPLICATE REPORT OPTIONS (SAME LINES C ARE ALSO WHERE ALL GROUPS AND DETAILS C WOULD CONFLICT OR TOTALS AT THE SAME C LEVEL WOULD CONFLICT). C C NOTE: C 1. EDIT STATEMENTS MAY BE IN CONFLICT C ON THE SAME LINE SINCE THEY APPLY TO C DIFFERENT FIELDS. C C 2. CONSTANT LITERALS AND EDIT MASKS C CANNOT APPEAR IN THE SAME STATEMENT. C 100 N = 0 DO 118 J=1,R3 IF (S(1,J).LT.20 .OR. S(1,J).GT.50) GO TO 118 IF (S(1,J).EQ.N) GO TO 104 IF (N.GT.40) GO TO 104 DO 102 I=1,10 Q(I) = 0 102 CONTINUE N = S(1,J) 104 IF (S(5,J).EQ.0) GO TO 110 I = S(5,J) C DO 108 I4=1,5 DO 108 I4=1,4 IF (I.EQ.0) GO TO 110 IFAC = 10**I4 I7 = I - I/IFAC * IFAC IF (I7.EQ.0) GO TO 108 I = I - I7 IF (Q(I4).EQ.0) GO TO 106 C ERROR - CONFILICTING REPORT OPTIONS CALL REIO(2,ITTY,ERR6,22) IE = 1 106 Q(I4) =1 108 CONTINUE 110 IF (S(6,J).EQ.0) GO TO 118 I3 = S(6,J) DO 116 I4=2,3 IF (I3.EQ.0) GO TO 118 IFAC = 10**I4 I7 = I3 - I3/IFAC * IFAC IF (I7.EQ.0) GO TO 116 I3 = I3 - I7 IF (I4.NE.2) GO TO 112 IF (S(3,J).EQ.0) GO TO 116 C ERROR - LITERAL HAS EDIT OPTION CALL REIO(2,ITTY,ERR7,17) IE = 1 GO TO 116 112 IF (Q(I4+4).EQ.0) GO TO 114 C ERROR - CONFLICTING REPORT OPTIONS CALL REIO(2,ITTY,ERR6,22) IE = 1 114 Q(I4+4) = I3 116 CONTINUE 118 CONTINUE C C CHECK TO SEE THAT NOT MORE THAN 5 C FIELDS ARE BEING TOTALED ON. C DO 120 I=1,255 Q(I) = 0 120 CONTINUE DO 122 J=1,R3 IF (S(1,J).LT.30) GO TO 122 IF (S(1,J).GT.40) GO TO 124 IF (S(2,J).EQ.0) GO TO 122 N = S(2,J) Q(N) = 1 122 CONTINUE 124 N = 0 DO 126 J=1,255 IF (Q(J).NE.0) N = N + 1 126 CONTINUE IF (N.LE.5) GO TO 130 C ERROR - > 5 FIELDS TOTALED ON CALL REIO(2,ITTY,ERR8,20) IE = 1 130 IF (IE.EQ.0) GO TO 140 C ERROR - NO REPORT GENERATED CALL REIO(2,ITTY,ERR9,21) C CALL MAIN PROGRAM (QS) SNAM(2) = 2H GO TO 150 140 IF(R5.NE.0) GO TO 160 C CALL REPORT GENERATOR PROGRAM SNAM(2) = 2H06 150 CALL EXEC(8,SNAM) C CALL PRE-SORT 160 SNAM(2) = 2H05 GO TO 150 END $ ZFTN4,L,C PROGRAM QS05(5,90),92063-16011 REV. 1826 771027 C C C************************************************************* C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * C RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * C PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * C OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C************************************************************* C C C LISTING: 92063-19011 C SOURCE: 92063-18011 C RELOC: 92063-16011 C C C************************************************************ C C C C THIS IS A MAIN PROGRAM MODULE THAT IS CALLED BY QS04 UPON THE C RECOGNITION OF SORT STATEMENT(S) IN THE REPORT. QS05 WILL BUILD THE C WORK AREA WITH RECORD NUMBERS AND THEIR ASSOCIATED SORT KEYS IN C ACCORDANCE WITH THE REQUIREMENTS OF THE SORT SUBROUTINE.(IF THE WORK C AREA IS NOT OF SUFFICIENT SIZE, QS05 WILL PRINT AN ERROR MESSAGE AND C RETURN TO QS) C C IMPORTANT VARIABLES AND ARRAYS USED: C C R5 IS AN INTEGER VARIABLE,PASSED IN COMMON,WHICH CONTAINS C THE # OF DATA-ITEMS TO BE SORTED. C C IRRCNT IS AN INTEGER VARIABLE,PASSED IN COMMON,WHICH CONTAINS C THE RETRIEVED RECORD COUNT. C C SAVE IS AN INTEGER ARRAY WHICH CONTAINS A 5-WORD GROUP OF C INFORMATION FOR EACH DATA-ITEM TO BE SORTED(THERE ARE R5 C NUMBER OF THESE GROUPS). A GROUP CONSISTS OF : C C 1- DATA ITEM NUMBER C 2- DATA ITEM TYPE(ASCII,REAL, OR INTEGER) C 3- DATA ITEM LENGTH(IN WORDS) C 4- DATA ITEM OFFSET(OFFSET,IN WORDS,IN THE RECORD) C 5- DATA SET NUMBER C C NOTE: THE DATA ITEM NUMBER IS OBTAINED FROM THE SECOND C WORD OF THE S ARRAY. SINCE THE S ARRAY IS SORTED, THE C FIRST R5 ENTRIES IN THE ARRAY PERTAIN TO SORT STATEMENTS. C A CALL TO DBINFO WILL GET THE REST OF THE INFORMAv,TION C THAT IS STORED IN SAVE. C C COMMON ITTY,ILP,IDCB(144),JDCB(144) COMMON DBNAM,DSNAM,DINAM,SELECT,SNAM COMMON DSNUM,DINUM,INITAL,IMA,IB,IEND,ISCAN COMMON IPFLAG COMMON IRRCNT,S,R3,TRKNM,IDILU,R5,IR6 C INTEGER DBNAM(3),DSNAM(3),DINAM(3) INTEGER SELECT(3),SNAM(3) INTEGER DSNUM,DINUM DIMENSION IMA(36),IB(349),ISORT(1024) INTEGER S(6,100) INTEGER R3,R5,TRKNM DIMENSION IQUAL (8) DIMENSION ISELD(128) DIMENSION INFO(10) INTEGER RECORD INTEGER DATA(512) INTEGER SAVE(30) DIMENSION ISTAT(4) INTEGER FILLER INTEGER ERR1(16) INTEGER ERR2(9) INTEGER ERR3(21) INTEGER ERR4(24) INTEGER ERR5(11) C EQUIVALENCE(IMA,IQUAL) EQUIVALENCE(IB,SAVE) C DATA FILLER/75172B/ DATA ERR1/2H I,2HNS,2HUF,2HFI, ERR1 1 2HCI,2HEN,2HT ,2HWO,2HRK,2H A, ERR1 2 2HRE,2HA ,2HFO,2HR ,2HSO,2HRT/ ERR1 DATA ERR2/2H S,2HOR,2HT ,2HER, ERR2 1 2HRO,2HR ,2HXX,2HXX,2HXX/ ERR2 DATA ERR3/2H D,2HAT,2HA ,2HIT,2HEM,2H V,2HAL,2HUE,2HS ,2HSI,2HZE, ERR3 12H E,2HXC,2HEE,2HD ,2HSO,2HRT,2H L,2HIM,2HIT,2HS / ERR3 DATA ERR4/2H D,2HAT,2HA ,2HIT,2HEM, ERR4 12H T,2HO ,2HBE,2H S,2HOR,2HTE,2HD , ERR4 22HNO,2HT ,2HIN,2H R,2HET,2HRI,2HEV, ERR4 32HED,2H R,2HEC,2HOR,2HDS/ ERR4 DATA ERR5/2H S,2HEL,2HEC,2HT ,2HFI,2HLE,2H O,2HVE,2HRF,2HLO,2HW / C C C BUILD THE IQUAL PARAMETER; THE IQUAL PARAMETER CONSISTS OF THE C FOLLOWING : C IQUAL(1) = THE # OF RECORDS TO BE SORTED(IRRCNT) C IQUAL(2) = THE # OF DATA ITEMS TO BE SORTED(R5) C IQUAL(3 TO N) = THTNE LENGTHS,IN BYTES, OF THE DATA ITEMS C C C JSECT = NUMBER OF SECTORS PER BLOCK. C JWORD = NUMBER OF WORDS PER BLOCK. (MUST NOT BE GREATER THAN 512). C JSECT=6 JWORD=341 IQUAL(1) = IRRCNT IQUAL(2) = R5 LENGTH = 0 ISAVE = 1 C C C FILL THE SAVE ARRAY C DO 10 I = R5,1,-1 DINUM = S(2,I) CALL DBINF(2HI ,2,DINUM,INFO) SAVE(ISAVE) = DINUM ISAVE = ISAVE + 1 CALL SGET(INFO,10,ITYPE) SAVE(ISAVE) = ITYPE ISAVE = ISAVE + 1 SAVE(ISAVE) = INFO(7) ISAVE = ISAVE + 1 SAVE(ISAVE) = INFO(8) ISAVE = ISAVE + 1 SAVE(ISAVE) = INFO(9) ISAVE = ISAVE + 1 C C C IF THE DATA ITEM TYPE IS INTEGER,LEN MUST BE SET TO 3 WORDS(WHEN THE C INTEGER TO ASCII CONVERSION TAKES PLACE,THE DATA ITEM VALUE WILL C OCCUPY 6 BYTES),IF REAL,LEN MUST BE SET TO 4;OTHERWISE IT IS ASCII AND C LEN IS SET TO THE DATA ITEM LENGTH. C IF(ITYPE.EQ.111B) LEN = 3 IF(ITYPE.EQ.122B) LEN = 4 IF(ITYPE.EQ.125B) LEN = INFO(7) IQUAL(I + 2) = LEN + LEN 10 LENGTH = LENGTH +LEN C C C INCREMENT LENGTH BY 1 TO LEAVE SPACE FOR THE RECORD # C KEY=LENGTH LENGTH = LENGTH + 1 C C C IF LENGTH EXCEEDS 40 WORDS THEN PRINT ERROR MESSAGE: C "DATA ITEM VALUES SIZE EXCEED SORT LIMITS" C IF (LENGTH.LE.40) GO TO 15 CALL REIO(2,ITTY,ERR3,21) GO TO 25 C C C GET WORK AREA LIMITS AND DETERMINE THE # OF GOOD TRACKS AVAILABLE. C THEN CALCULATE THE # OF SECTORS THIS IS EQUIVALENT TO BY MULTIPLYING C THE # OF SORT BUFFERS (4 SECTORS EACH) AVAILABLE IN THE WORK AREA. NEXT, C CALCULATE THE NUMBER OF SORT BUFFERS NEEDED TO HOLD THE SORT KEYS FOR C ALL THE RECORDS TO BE SORTED; CONVERT THIS TO SECTORS AND IF THIS IS C GREATER THAN THE # OF SECTORS IN THE WORK AREA, PRINT THE ERROR C MESSAGE: C C "INSUFFICIENT WORK AREA FOR SORT" C C AND RETURN TO MA IN MODULE; OTHERWISE, CONTINUE PROCESSING. C 15 IW=100060B 17 CALL EXEC(4,IW,IFTRK,ILU,ISIZE) IW=IW-1 IF (IW.EQ.0) GOTO 20 IF (IFTRK.LT.0) GOTO 17 IW=IAND(IW+1,77777B) NTRAK=IW ITRK=IFTRK ISIZE=(ISIZE/JSECT)*JSECT C C C CALCULATE THE NUMBER OF 512-WORD BLOCKS AVAILABLE IN WORK AREA. C IW=(ISIZE/JSECT)*IW IZ = 0 IX=JWORD/LENGTH DO 16 IY = 1,IRRCNT,IX 16 IZ = IZ + 1 IF (IZ.LE.IW) GO TO 30 20 CALL REIO(2,ITTY,ERR1,16) 25 SNAM(2) = 2H 27 CALL EXEC(8,SNAM) C 21 IF (ISTAT.EQ.-12) GOTO 22 CALL FMERR(ISTAT,ITTY) GOTO 25 22 CALL REIO(2,ITTY,ERR5,11) GOTO 25 C C C C C C SET UP FOR DIRECTED GETS. IF THE RECORD COMES FROM A DETAIL DATA-SET, C READ IT INTO ISORT + 512; IF THE RECORD COMES FROM A MASTER, READ IT C INTO ISORT C 30 IY = 0 IV = 513 CALL DBINF(2HS ,2,DSNUM,INFO) IF(INFO(5).EQ.104B) IV = 1 LENBUF = 0 ISECT = 0 IRSE = 1 IPTR = 130 IOFF = 1 C C C SET UP THE OUTER LOOP TO WRITE SORT BUFFERS TO THE WORK AREA,THE NEXT C INNER LOOP TO RETIEVE RECORDS FROM THE SELECT FILE, AND THE MOST C INNER LOOP TO EXTRACT SORT KEYS FROM RECORDS, DO ANY NECESSARY C CONVERSIONS,AND STORE THEM IN THE CURRENT SORT BUFFER. C DO 110 N1 = 1,IZ DO 100 N2 = 1,IX C C C IF IPTR IS LESS THAN 129,READ IN NEXT SECTOR FROM SELECT FILE AND C RESET POINTERS C IF(IPTR.LT.129) GO TO 40 CALL READF(JDCB,ISTAT,ISELD,128,IL,IRSE) IF (ISTAT.LT.0) GOTO 21 IRSE = IRSE + 1 IPTR = 1 40 RECORD = ISELD(IPTR) IPTR = IPTR + 1 IY = IY + 1 IF(IY.GT.IRRCNT) GO TO 105 C C C DO DBMS DIRECTED GET TO PICK UP THE RECORD. C CALL DBGET(DSNUM,3,ISTAT,ISORT(IV),RECORD) IU = R5 * 5 DO 90 IT = 1,IU,5 IF (IFBRK(IDUM).NE.0) GOTO 420 IF(SAVE(IT + 4).NE.DSNUM) GO TO 210 ITYPE = SAVE(IT + 1) INDEX = SAVE(IT + 3)+IV-1 IF(ITYPE.NE.111B) GO TO 58 CALL CITA(ISORT(INDEX),DATA(IOFF)) IOFF = IOFF + 3 GO TO 90 58 IF(ITYPE.NE.122B) GO TO 60 CALL CRTA(DATA,IOFF + IOFF -1,IOFF + IOFF +6, 1 ISORT(INDEX),0.5,0) IOFF = IOFF + 4 GO TO 90 60 LEN = SAVE(IT + 2) IF(ISORT(INDEX).NE.0) GO TO 70 CALL SFILL(DATA(IOFF),1,LEN+LEN,FILLER) IOFF = IOFF + LEN GO TO 90 70 DO 80 I = 1,LEN DATA(IOFF) = ISORT(INDEX) IOFF = IOFF + 1 INDEX = INDEX + 1 80 CONTINUE 90 CONTINUE DATA(IOFF)=RECORD IOFF=IOFF+1 100 CONTINUE 105 IF(ISECT.LT.ISIZE) GO TO 109 ITRK = ITRK + 1 ISECT = 0 109 CALL EXEC(2,ILU,DATA,JWORD,ITRK,ISECT) ISECT=ISECT+JSECT IOFF = 1 110 CONTINUE C C C SORT THE WORK AREA FILE USING MICROCODE. C C INITIALIZE THE WORK AREA TRANSFER ROUTINE. C CALL INITX(IFTRK,ISIZE,JSECT,ILU) C C C DETERMINE THE NUMBER OF RECORDS IN THE LAST BLOCK. C N2=N2-1 IF (N2.NE.0) GO TO 300 IZ=IZ-1 N2=IX 300 N1=N2*LENGTH IU=N2 C C C CHECK THE NUMBER OF BLOCKS IN WORK AREA. IF LESS THAN THREE C THEN HANDLE SPECIAL. C IF (IZ.LT.2) GO TO 350 IWRDS=LENGTH*IX MID=IWRDS+1 IU=IU+IX CALL WORKX(1,ISORT,IWRDS,1) I=2 IF (IZ.LT.3) GO TO 360 IEND=MID+IWRDS IU=IU+IX I=1 J=IZ C C C SORT FOLLOWS FOR 3 OR MORE BLOCKnS. C 310 CALL WORKX(1,ISORT(IEND),N1,J) K=J GO TO 330 320 CALL WORKX(2,ISORT(MID),IWRDS,K) 330 K=K-1 CALL WORKX(1,ISORT(MID),IWRDS,K) CALL QSORT(ISORT,1,IU,KEY,LENGTH,ISTAT) IF (IFBRK(IDUM).NE.0) GOTO 420 IF (K.NE.I+1) GO TO 320 CALL WORKX(2,ISORT,IWRDS,I) CALL WORKX(2,ISORT(IEND),N1,J) J=J-1 IF (K.EQ.J) GO TO 385 DO 340 L=1,IWRDS 340 ISORT(L)=ISORT(L+IWRDS) IF (K+1.EQ.J) GO TO 380 N1=IWRDS I=I+1 N2=IX*3 IU=N2 GO TO 310 C C C SORT FOR WORK FILES WHICH ARE LESS THAN 3 BLOCKS LONG. C 350 MID=1 I=1 360 CALL WORKX(1,ISORT(MID),N1,I) CALL QSORT(ISORT,1,IU,KEY,LENGTH,ISTAT) IF (IZ.LT.2) GO TO 370 CALL WORKX(2,ISORT(MID),N1,2) I=1 370 J=0 ISECT=1 N1=IX GO TO 400 C C C MOVE SORTED RECORD NUMBERS ONLY TO SELECT FILE FROM WORK AREA. C 380 IU=IX+IX CALL WORKX(1,ISORT(MID),IWRDS,J) CALL QSORT(ISORT,1,IU,KEY,LENGTH,ISTAT) CALL WORKX(2,ISORT,IWRDS,K) 385 CALL WORKX(2,ISORT(MID),IWRDS,J) J=0 ISECT=1 N1=IX I=1 390 CALL WORKX(1,ISORT,IWRDS,I) 400 IF (I.EQ.IZ) N1=N2 DO 410 K=1,N1 J=J+1 IF (J.LT.129) GO TO 410 CALL WRITF(JDCB,ISTAT,ISELD,128,ISECT) IF (ISTAT.LT.0) GOTO 21 ISECT=ISECT+1 J=1 410 ISELD(J)=ISORT(K*LENGTH) I=I+1 IF (I.LE.IZ) GO TO 390 CALL WRITF(JDCB,ISTAT,ISELD,128,ISECT) IF (ISTAT.LT.0) GOTO 21 C C C CALL REPORT GENERATOR C C C RELEASE TRACKS C CALL EXEC(5,NTRAK,IFTRK,ILU) C SNAM(2) = 2H06 GO TO 27 420 CALL EXEC(5,NTRAK,IFTRK,ILU) GO TO 25 C C C SORT ERROR - RETURN TO MAIN MODULE C 200 CALL CITA(ISTAT,ERR2(7)) CALL REIO(2,ITTY,ERR2,9) GO TO 25 210 CALL REIO(2,ITTY,ERR4,24) GO TO 25 END $ **($$*FTN4,L,C PROGRAM QS06(5,90),92063-16011 REV. 1826 771027 C C C************************************************************* C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * C RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * C PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * C OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C************************************************************* C C C LISTING: 92063-19011 C SOURCE: 92063-18011 C RELOC: 92063-16011 C C C************************************************************ C C C REPORT GENERATION MODULE #1 C C THIS IS THE INITIALIZATION MODULE C C C REPORT GENERATION IS MADE UP OF THREE MODULES: C 1) QS06 - INITIALIZATION C 2) QS15 - CONTROL BREAKS AND GROUP/DETAILS C 3) QS12 - TOTALS C C THE PURPOSE OF THESE MODULES IS TO C GENERATE A REPORT BASED ON THE S TABLE. C IT IS ASSUMED THAT ALL LOGIC AND SYNTAX C ERRORS HAVE BEEN CORRECTED. C C REPORT TABLE FORMAT IN ARRAY S(6,100). C THIS TABLE IS BUILT BY QS02, LOGIC C CHECKED BY QS04, AND SORTED (IF NEEDED) C BY QS05. C C EACH ROW OF ARRAY S CONTAINS INFORMATION C ABOUT EACH REPORT STATEMENT: C C 1. REPORT STATEMENT TYPE C 10-15 SORT STATEMENT C 21-25 HEADER STATEMENT C 31-36 TOTAL STATEMENT C 41-46 GROUP STATEMENT C 50 DETAIL STATEMENT C 60-69 EDIT MASKS C C 2. DATA-ITEM NUMBER C C 3. LITERAL POINTER TO QSKIB. QSKIB IS AN RTE TRACK C WHICH CONTAINS ALL LITERALS OR EDIT C MASKS IN A2 FORMAT, PRECEDED BY IT'S C CHARACTER LENGTH. C C 4. END PRINT POSITION C C 5. REPORT OPTION 1 C UNITS PLACE = SPACE BEFORE (0-5) C TENS PLACE = SPACE AFTER (0-5) C HUNDREDS PLACE = SKIP BEFORE (0-1) C THOUSANDS PLACE = SKIP AFTER (0-1) C TEN THOUSANDS = ADD (0-1) C C 6. REPORT OPTION 2 C H> UNITS PLACE = O NO EDIT = 1 ZERO SUPPRESS C 60 - 69 EDIT MASK C HUNDREDS PLACE = COUNT (0-1) C THOUSANDS PLACE = AVERAGE (0-1) C C COMMON ITTY,ILP,IDCB(144),JDCB(144) COMMON DBNAM,DSNAM,DINAM,SELECT,SNAM COMMON DSNUM,DINUM,INTIAL,IMA,IB,IEND,ISCAN COMMON IPFLAG COMMON IRRCNT,S,R3,TRKNM,IDILU,R5 COMMON R6 COMMON V COMMON STRA COMMON STRC COMMON STRD COMMON P1,P2 COMMON J1 COMMON ISORT(256) COMMON T,U COMMON STRE,STRF,STRG,STRH,STRI COMMON L,ATOTAL COMMON ISELD,IRSE,IPTR COMMON RCOUNT,N C INTEGER DBNAM(3),DSNAM(3),DINAM(3) INTEGER SELECT(3),SNAM(3) INTEGER DSNUM,DINUM DIMENSION IMA(36),IB(349) INTEGER V(8) INTEGER T(5) INTEGER U(7,5) INTEGER R3,S(6,100),R5,TRKNM INTEGER R6 INTEGER STRA(37) INTEGER STRC(67) INTEGER STRD(37) INTEGER STRE(37) INTEGER STRF(37) INTEGER STRG(37) INTEGER STRH(37) INTEGER STRI(37) INTEGER AS(36) INTEGER CS(66) INTEGER DS(36) INTEGER ES(36) INTEGER FS(36) INTEGER GS(36) INTEGER HS(36) INTEGER IS(36) INTEGER P1,P2 DIMENSION L(6) INTEGER ATOTAL(60,5) DIMENSION ISELD(128) INTEGER RCOUNT C EQUIVALENCE (STRA(1),LAS), (STRA(2),AS) EQUIVALENCE (STRC(1),LCS), (STRC(2),CS) EQUIVALENCE (STRD(1),LDS), (STRD(2),DS) EQUIVALENCE (STRE(1),LES), (STRE(2),ES) EQUIVALENCE (STRF(1),LFS), (STRF(2),FS) EQUIVALENCE (STRG(1),LGS), (STRG(2),GS) EQUIVALENCE (STRH(1),LHS), (STRH(2),HS) EQUIVALENCE (STRI(1),LIS), (STRI(2),IS) C C C T ARRAY IS USED TO HOLD SORT FIELDS C C U ARRAY IS USED TO FOR TOTAL COUNT C 1. FIELD MAP (1,I) C 2. ACCUMULATE COUNTS (2,I) - (7,I) C C ATOTAL ARRAY IS FOR TOTAL ADD (10*6)*5 IN ASCIo"I C C IRRCNT IS RETRIEVED RECORD COUNT C RCOUNT = IRRCNT DO 1 I=1,8 V(I) = 0 1 CONTINUE DO 2 J=1,5 DO 2 I=1,60 2 ATOTAL(I,J) = 2H00 C C CHECK IF "PAGENO" EXISTS AMONG HEADERS C P1 = -1 DO 160 J=1,R3 IF (S(1,J).LT.20) GO TO 160 IF (S(1,J).GT.30) GO TO 170 IF (S(2,J).EQ.0) GO TO 160 P1 = 0 GOTO 170 160 CONTINUE 170 DO 171 J=1,5 T(J) = -1 U(1,J) = 0 DO 171 I=2,7 U(I,J) = 0 171 CONTINUE C C INITIALIZE STRINGS TO NULL C LES = 0 LFS = 0 LGS = 0 LHS = 0 LIS = 0 C C PUT SORT DATA-ITEM # IN "T" C R5 = 0 DO 330 J=1,R3 IF (S(1,J).GT.20) GO TO 240 IF (S(1,J).EQ.10) GO TO 330 N = S(1,J) - 10 T(N) = S(2,J) GO TO 330 240 IF (S(1,J).GT.40) GO TO 335 IF (S(1,J).LT.30) GO TO 330 IF (S(2,J).EQ.0) GO TO 330 C C PUT TOTAL DATA-ITEM # IN "U" C DO 310 J1=1,5 IF(U(1,J1).EQ.0) GO TO 320 IF(IABS(U(1,J1)).EQ.S(2,J)) GO TO 320 310 CONTINUE 320 IF(U(1,J1).LT.0) GO TO 330 IDATA = S(2,J) C C IF OPTION IS ADD,SET S(2,J) NEGATIVE C IF(S(5,J).GT.1155) IDATA = -IDATA C C SAME FOR AVERAGE OPTION C IF(S(6,J).GT.169) IDATA = -IDATA U(1,J1) = IDATA C C R5 IS A FLAG - TOTALS EXISTS C R5 = R5 + 1 330 CONTINUE C C N IS A SWITCH WHICH IS SET TO NOT RECOGNIZE C A CONTROL BREAK ON FIRST DETAIL RECORD READ C (TOTAL PRINTING SUPPRESSION). C C L(1) TO L(5) ARE RESET WHEN A CONTROL BREAK C OCCURS AT THAT LEVEL. C L(6) IS RESET WHEN THE LAST RECORD C IS ENCOUNTERED. C 335 N = -1 DO 340 I=1,6 L(I) = -1 340 CONTINUE C C READ QSKIB INTO 'IB' C CALL EXEC(1,IDILU,IB,R6,TRKNM,0) C C PAGE EJECT C CALL EXEC(3,ILP+1100B,-1) LCS = 132 C C PRINT HEADER INFO C CALL PHDRI  IRSE = 1 IPTR = 130 R6 = 0 C C LOAD REPORT MODULE QS15 C SNAM(2) = 2H15 CALL EXEC(8,SNAM) END $ zFTN4,L,C PROGRAM QS07(5,90),92063-16011 REV. 1840 780801 C C C************************************************************* C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * C RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * C PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * C OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C************************************************************* C C C LISTING: 92063-19011 C SOURCE: 92063-18011 C RELOC: 92063-16011 C C C************************************************************ C C C UPDATE SERVICE MODULE (PART I) C HAS BEEN SPLIT INTO TWO (2) MODULES C IN ORDER TO FIT INTO 16K MEMORY C C QS07 CONTAINS THE ADD ROUTINE C QS14 CONTAINS THE REPLACE AND DELETE ROUTINES C COMMON ITTY,ILP,IDCB(144),JDCB(144) COMMON DBNAM,DSNAM,DINAM,SELECT,SNAM COMMON DSNUM,DINUM,INTIAL,IMA,IB,IEND,ISCAN COMMON IPFLAG COMMON IRRCNT COMMON ICHAR COMMON IPROC C INTEGER DBNAM(3),DSNAM(3),DINAM(3) INTEGER SELECT(3),SNAM(3) INTEGER DSNUM,DINUM DIMENSION IMA(36),IB(349) INTEGER ERR1(7) INTEGER ERR2(11) INTEGER ERR3(8) INTEGER ERR4(14) INTEGER ERR5(19) INTEGER ERR6(11) DIMENSION NAME(2) INTEGER A,R INTEGER RC2,RC8 DIMENSION INFO(10) DIMENSION ITEMS(256) DIMENSION INBR(256) DIMENSION IVALU(256) DIMENSION ISORT(256) INTEGER U INTEGER P2 DIMENSION ISTAT(4) INTEGER ERROR(8) INTEGER UPDATE(3) C C NAME DATA NAME/2HNA,2HME/ C SYNTAX ERROR DATA ERR1/2H S,2HYN,2HTA,2HX ,2HER,2HRO,2HR / C ILLEGAL DATA SET NAME DATA ERR2/2H I,2HLL,2HEG,2HAL, 1 2H D,2HAT,2HA ,2HSE,2HT ,2HNA,2HME/ C ILLEGAL ACCESS DATA ERR3/2H I,2HLL,2HEG, 1 2HAL,2H A,2HCC,2HES,2HS / C INPUT TOO LONG - TRUNCATED DATA ERR4/2H I՚,2HNP,2HUT,2H T,2HOO,2H L, 1 2HON,2HG ,2H- ,2HTR,2HUN,2HCA,2HTE,2HD / C INTEGER VALUE OR REAL VALUE ERROR - ITEM IGNORED DATA ERR5/2H N,2HON,2H-N,2HUM,2HER,2HIC,2H I, 1 2HN ,2HRE,2HAL,2H O,2HR ,2HIN,2HTE,2HGE,2HR , 1 2HVA,2HLU,2HE / DATA ERR6/2H P,2HRO,2HCE,2HDU,2HRE,2H N,2HOT, 12H D,2HEF,2HIN,2HED/ DATA A/101B/ DATA KCHAR/113B/ DATA R/122B/ DATA U/125B/ DATA RC8/8/ DATA ERROR/2HER,2HRO,2HR ,2HNO,2H. ,2HXX,2HXX,2HXX/ C UPDATE DATA UPDATE/2HUP,2HDA,2HTE/ C C UPDATE NAME = ; C A,; C K; C R,=""; C IPROC=0 INBR = 0 P2 = 1 C C CHECK FOR PROCEDURE C CALL LSCAN(IB,I,J,K) IF(J-I.NE.3) GOTO 30 IF(JSCOM(NAME,1,4,IB,I,IERR).NE.0) GOTO 30 C SCAN ACROSS = CALL LSCAN(IB,I,J,K) IF(K.NE.6) GOTO 40 C GET PROCEDURE NAME CALL LSCAN(IB,I,J,K) IF(K.NE.2) GOTO 40 IF(J-I.GT.5) GOTO 40 DO 20 N=1,3 20 IMA(N) = 2H CALL SMOVE(IB,I,J,IMA,1) IPFLAG=3 IPROC=11 CALL OPEN(IDCB,IERR,IMA,1) IF (IERR.NE.-6) GOTO 21 CALL REIO(2,ITTY,ERR6,-22) GOTO 50 21 IF (IERR.GE.0) GOTO 22 CALL FMERR(IERR,ITTY) 22 CALL INPUT C SCAN ACROSS "UPDATE" CALL LSCAN(IB,I,J,K) IF(J-I.NE.5) GOTO 40 IF(JSCOM(IB,I,J,UPDATE,1,IERR).NE.0) GOTO 40 CALL LSCAN(IB,I,J,K) C GET UPDATE TYPE 30 CALL SGET(IB,I,ICHAR) C ADD UPDATE IF(ICHAR.EQ.A) GOTO 100 C DELETE UPDATE IF(ICHAR.EQ.KCHAR) GOTO 70 C REPLACE UPDATE IF(ICHAR.EQ.R) GOTO 70 C ERROR - SYNTAX ERROR 40 DO 45 K=1,36 45 IMA(K) = 2H LEN = I+1 CALL SPUT(IMA(2),LEN,136B) IMA(1) = (LEN+1)/2 CALL REIO(2,ITTY,IMA(2),IMA) CALL REIO(2,ITTY,ERR1,7) C C RETURN TO NEXT? 50 SNAM(2) = 2H CALL EXEC(RC8,SNAM) C C ERROR - DBMS C 60 CALL CITA(ISNbTAT,ERROR(6)) CALL REIO(2,ITTY,ERROR,8) GO TO 50 C C LOAD MODULE QS14 FOR REPLACE AND DELETE UPDATES C 70 SNAM(2) = 2H14 CALL EXEC(RC8,SNAM) C C ADD STATEMENT C C SCAN ACROSS "," 100 IF(IPFLAG.NE.0 .OR. IPROC.NE.0) CALL REIO(2,ITTY,IB,-IEND) CALL LSCAN(IB,I,J,K) IF(K.NE.4) GOTO 40 CALL LSCAN(IB,I,J,K) C GET DATA SET NAME IF(J-I.GT.5) GOTO 40 DO 105 K=1,3 105 DSNAM(K) = 2H CALL SMOVE(IB,I,J,DSNAM,1) C VERIFY DATA SET NAME CALL DBINF(2HS ,5,DSNAM,INFO) IF(INFO.EQ.0) GOTO 110 C ERROR - ILLEGAL DATA SET NAME CALL REIO(2,ITTY,ERR2,11) GOTO 50 110 DSNUM = INFO(2) IPFLAG = 0 C GET ALL DATA ITEM #S FOR THIS SET CALL DBINF(2HI ,1,DSNUM,ITEMS) C ITEM COUNT = 0 - ERROR IF(ITEMS.EQ.0) GOTO 120 C ERROR - ILLEGAL ACCESS CALL REIO(2,ITTY,ERR3,8) GO TO 50 C C LOOP ON ITEM COUNT AND GET VALUE 120 DO 170 LOOP=1,ITEMS(2) C SET NEXT DATA ITEM # DINUM = IABS(ITEMS(LOOP+2)) C GET ITEM CHARACTERISTICS CALL DBINF(2HI ,2,DINUM,INFO) IF(INFO.NE.0) GOTO 170 DO 130 N=2,4 130 IMA(N) = INFO(N) IMA(5) = 2H=_ CALL REIO(2,ITTY,IMA(2),4) CALL INPUT C GET INPUT VALUE CALL LSCAN(IB,I,J,K) C IS THIS A KEY ITEM CALL SGET(INFO,9,KEY) IF(K.EQ.5 .AND. KEY.EQ.1) GOTO 130 C CHECK FOR NULL VALUE IF(K.EQ.5) GOTO 170 C GET ITEM TYPE - MAY HAVE TO CONVERT CALL SGET(INFO,10,ITYPE) LEN = INFO(7) IF(ITYPE.EQ.U) GOTO 150 IF(ITYPE.EQ.R) GOTO 140 C INTEGER FIELD C REMOVE SIGN OF INPUT STRING CALL SZONE(IB,J,4,NSIGN) C CONVERT DATA TO INTEGER CALL CATI(IB,I,J-I+1,INT,ISTAT) IF(ISTAT.EQ.0) GOTO 135 C C INTEGER VALUE ERROR - ITEM IGNORED C 145 CALL REIO(2,ITTY,ERR5,19) GOTO 170 135 CONTINUE C REPLACE SIGN TO STRING CALL SZONE(IB,J,NSIGN,I) C PLACE CORRECT SIGN IN INTEGER VAR IF(NSIGN.EQ.2) INT = -INT IVALU(P2) = INT P2 = P2 + LEN GOTO 160 140 VAR = CATR(IB,I,J,ISTAT) IF (ISTAT.NE.0) GOTO 145 CALL SMOVE(VAR,1,4,IVALU,P2+P2-1) P2 = P2 + LEN GOTO 160 C C SET J FOR ASCII INPUT ONLY! C 150 IF(K.EQ.2) J = IEND-1 IF(K.EQ.3) J = IEND-2 DO 155 N=0,LEN-1 155 IVALU(P2+N) = 2H IF(J-I.LT.LEN+LEN) GOTO 159 C ERROR - INPUT TOO LONG CALL REIO(2,TTY,ERR4,14) J = LEN+LEN+I-1 159 CONTINUE CALL SMOVE(IB,I,J,IVALU,P2+P2-1) P2 = P2 + LEN 160 INBR = INBR + 1 INBR(INBR+1) = DINUM 170 CONTINUE CALL DBLCK(1,ISTAT) IF (ISTAT.NE.0) GOTO 60 CALL DBPUT(DSNUM,ISTAT,INBR,IVALU,ISORT) CALL DBUNL(ISTAT2) C C CHECK STATUS ON PUT AND REPORT ERROR WHEN NECESSARY C IF (ISTAT.NE.0) GOTO 60 C C CHECK STATUS ON UNLOCK AND REPORT ERROR WHEN NECESSARY C ISTAT=ISTAT2 IF( ISTAT .NE. 0) GOTO 60 GOTO 50 END $ MpFTN4,L,C PROGRAM QS08(5,90),92063-16011 REV. 1826 771027 C C C************************************************************* C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * C RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * C PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * C OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C************************************************************* C C C LISTING: 92063-19011 C SOURCE: 92063-18011 C RELOC: 92063-16011 C C C************************************************************ C C C FORM SERVICE MODULE C C DISPLAYS DATA-SET AND C DATA-ITEM NAMES C COMMON ITTY,ILP,IDCB(144),JDCB(144) COMMON DBNAM,DSNAM,DINAM,SELECT,SNAM COMMON DSNUM,DINUM,INTIAL,IMA,IB,IEND,ISCAN COMMON IPFLAG COMMON IRRCNT C INTEGER DBNAM(3),DSNAM(3),DINAM(3) INTEGER SELECT(3),SNAM(3) INTEGER DSNUM,DINUM DIMENSION IMA(36),IB(349) INTEGER SET(9),D DIMENSION IBUF(256) C DATA D/104B/ C C IMAGE/1000 SCHEMA C C MAX SETS - 50 C MAX ITEMS - 255 C MAX NAMES - 6 CHARS C MAX LENGTH - 100 C C LOOP ON DATA-SET NUMBER (MAX=50) CALL EXEC(3,ILP+1100B,-1) WRITE(ILP,150) DO 70 IDSET=1,50 C GET DATA-ITEM NUMBERS WITHIN THIS SET DO 10 ICTR=1,256 10 IBUF(ICTR)=0 ITYPE = 2HI CALL DBINF(ITYPE,1,IDSET,IBUF) IF(IBUF.NE.0) GOTO 70 ITYPE = 2HS CALL DBINF(ITYPE,2,IDSET,SET) IF(SET.NE.0) GOTO 70 IF (SET(5).EQ.D) GO TO 20 CALL REIO(2,ILP,2H ,-1) CALL REIO(2,ILP,2H ,-1) WRITE (ILP,100) (SET(IX),IX=2,4),SET(5),SET(6) GO TO 30 20 CALL REIO(2,ILP,2H ,-1) CALL REIO(2,ILP,2H ,-1) WRITE (ILP,110) (SET(IX),IX=2,4),SET(6) 30 CALL REIO(2,ILP,2H ,-1) WRITE (ILP,120) ITYPE = 2HI DO 60 L  I=1,IBUF(2) ITEM = IABS(IBUF(I+2)) CALL DBINF(ITYPE,2,ITEM,SET) IF(SET.NE.0) GOTO 60 C ITEM TYPE CALL SGET(SET,10,ITY) IF (ITY.EQ.125B) SET(7)=SET(7)*2 C KEY ITEM CALL SGET(SET,9,KEY) IF(KEY.EQ.1) GO TO 50 WRITE (ILP,130) (SET(IX),IX=2,4),SET(5),SET(7) GO TO 60 50 WRITE (ILP,140) (SET(IX),IX=2,4),SET(5),SET(7) 60 CONTINUE 70 CONTINUE C RETURN TO NEXT? SNAM(2) = 2H CALL EXEC(8,SNAM) C 100 FORMAT (" MASTER DATA SET - ",3R2,",",R1," CAPACITY = ",I5) 110 FORMAT (" DETAIL DATA SET - ",3R2,2X," CAPACITY = ",I5) 120 FORMAT (5X,"ITEM",3X,"ITEM",3X,"ITEM",/ 1 5X,"NAME",3X,"TYPE",2X,"LENGTH",/) 130 FORMAT (5X,3R2,3X,R1,5X,I3) 140 FORMAT (5X,3R2,3X,R1,5X,I3,4X,"<>") 150 FORMAT (15X,"* * * * IMAGE/1000 SCHEMA * * * *") END $ {w FTN4,L,C PROGRAM QS09(5,90),92063-16011 REV. 1826 771027 C C C************************************************************* C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * C RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * C PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * C OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C************************************************************* C C C LISTING: 92063-19011 C SOURCE: 92063-18011 C RELOC: 92063-16011 C C C************************************************************ C C C CREATE SERVICE ROUTINE C COMMON ITTY,ILP,IDCB(144),JDCB(144) COMMON DBNAM,DSNAM,DINAM,SELECT,SNAM COMMON DSNUM,DINUM,INTIAL,IMA,IB,IEND,ISCAN COMMON IPFLAG COMMON IRRCNT C INTEGER DBNAM(3),DSNAM(3),DINAM(3) INTEGER SELECT(3),SNAM(3) INTEGER DSNUM,DINUM DIMENSION IMA(36),IB(349) INTEGER END(2) DIMENSION NAME(2),INAME(3) INTEGER DATA(128) INTEGER ERR1(12) INTEGER ERR2(17) INTEGER ERR3(7) INTEGER ERR4(20) INTEGER ERR5(19) INTEGER SPACE(3) INTEGER SECTOR(7) C DATA NAME/2HNA,2HME/ DATA END/2HEN,2HD;/ DATA INAME/2H ,2H ,2H / DATA ERR1/2H S,2HPE,2HC-,2HFI,2HLE, 1 2H N,2HOT,2H D,2HEC,2HLA,2HRE,2HD / DATA ERR2/2H D,2HUP,2HLI,2HCA,2HTE, 1 2H P,2HRO,2HCE,2HDU,2HRE,2H N, 2 2HAM,2HE ,2H= ,2HXX,2HXX,2HXX/ DATA ERR3/2H S,2HYN,2HTA, 1 2HX ,2HER,2HRO,2HR / DATA ERR4/2H D,2HIR,2HEC, 2HTO,2HRY,2H O, 1 2HVE,2HRF,2HLO,2HW,,2H P,2HRO,2HCE, 2 2HDU,2HRE,2H R,2HEJ,2HEC,2HTE,2HD / DATA ERR5/2H S,2HPE,2HC-,2HFI,2HLE, 1 2H O,2HVE,2HRF,2HLO,2HW,,2H I,2HNP, 2 2HUT ,2H T,2HER,2HMI,2HNA,2HTE,2HD / DATA SPACE/2HSP,2HAC,2HE / DATA SECTOR/2HXX,2HXX,2HXX,2H S,2HEC,2HTO,2HRS/ C C CREATE NAME = ; C C w`   C RETURN TO NEXT? C GOTO 20 10 SNAM(2) = 2H CALL EXEC(8,SNAM) C C ERROR - DUPLICATE PROCEDURE NAME 15 CALL REIO(2,ITTY,ERR2,ITTY7) GO TO 10 C C SCAN FOR NAME C 20 CALL LSCAN(IB,I,J,K) IF (JSCOM(NAME,1,4,IB,I,ISTAT).EQ.0) GO TO 35 GOTO 30 C 30 DO 32 K=1,36 32 IMA(K) = 2H LEN = I + 1 CALL SPUT(IMA(2),LEN,136B) IMA(1) = (LEN+1)/2 CALL REIO(2,ITTY,IMA(2),IMA) C ERROR - SYNTAX CALL REIO(2,ITTY,ERR3,7) GO TO 10 C C SCAN ACROSS = C 35 CALL LSCAN(IB,I,J,K) IF (K.NE.6) GO TO 30 C C GET PROCEDURE NAME (6 CHARS MAX) C CALL LSCAN(IB,I,J,K) IF (K.NE.2) GO TO 30 IF (J-I.GT.5) GO TO 30 CALL SMOVE(IB,I,J,INAME,1) CALL CREAT(IDCB,ISTAT,INAME,4,4) IF (ISTAT.LT.0) GOTO 85 IF (ISTAT.EQ.-2) GOTO 15 C C C NEXT CHAR = ';' C CALL LSCAN(IB,I,J,K) IF (K.NE.5) GO TO 30 C C GET NEXT WORD OR INPUT C 50 CALL LSCAN(IB,I,J,K) C C COMPUTE SIZE OF INPUT IN WORDS C K = (IEND-I+2)/2 J = ((IEND-I+1)/2)-K IF (K.NE.0) CALL SPUT(IB,IEND+1,40B) CALL WRITF(IDCB,ISTAT,IB,K) IF (ISTAT.LT.0) GOTO 85 IF (JSCOM(IB,IEND-3,IEND,END,1,ISTAT).EQ.0) GO TO 90 CALL INPUT GO TO 50 C C FMGR ERROR C 85 CALL FMERR(ISTAT,ITTY) GOTO 10 C 90 CALL CLOSE(IDCB) C C EXIT C GO TO 10 END $ FTN4,L,C PROGRAM QS10(5,90),92063-16011 REV. 1826 771027 C C C************************************************************* C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * C RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * C PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * C OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C************************************************************* C C C LISTING: 92063-19008 C SOURCE: 92063-18008 C RELOC: 92063-16008 C C C************************************************************ C C C DISPLAY SERVICE ROUTINE C COMMON ITTY,ILP,IDCB(144),JDCB(144) COMMON DBNAM,DSNAM,DINAM,SELECT,SNAM COMMON DSNUM,DINUM,INTIAL,IMA,IB,IEND,ISCAN COMMON IPFLAG COMMON IRRCNT C INTEGER DBNAM(3),DSNAM(3),DINAM(3) INTEGER SELECT(3),SNAM(3) INTEGER DSNUM,DINUM DIMENSION IMA(36),IB(349),ISORT(36) INTEGER END(2) DIMENSION NAME(2),INAME(3) INTEGER ERR2(16) INTEGER ERR3(7) C DATA NAME/2HNA,2HME/ DATA INAME/2H ,2H ,2H / DATA ERR2/2H P,2HRO,2HCE,2HDU, 1 2HRE,2H N,2HAM,2HE ,2HXX,2HXX, 2 2HXX,2H N,2HOT,2H F,2HOU,2HND/ DATA ERR3/2H S,2HYN,2HTA, 1 2HX ,2HER,2HRO,2HR / C C DISPLAY NAME = C GOTO 20 C C RETURN TO NEXT? C 10 SNAM(2) = 2H CALL EXEC(8,SNAM) C C SCAN FOR NAME C 20 CALL LSCAN(IB,I,J,K) IF(J-I.NE.3) GO TO 30 IF (JSCOM(NAME,1,4,IB,I,IERR).EQ.0) GO TO 35 C C 30 DO 32 K=1,36 32 IMA(K) = 2H LEN = I + 1 CALL SPUT(IMA(2),LEN,136B) IMA(1) = (LEN+1)/2 CALL REIO(2,ITTY,IMA(2),IMA) C ERROR - SYNTAX CALL REIO(2,ITTY,ERR3,7) GO TO 10 C C SCAN ACROSS = C 35 CALL LSCAN(IB,I,J,K) IF (K.NE.6) GO TO 30 C C GET PROCEDURE NAME (6 CHARS MAX) C CALL LSCAN(IB,I,J,K) IF (K.NE.2) GO TO 30 V   IF (J-I.GT.5) GO TO 30 CALL SMOVE(IB,I,J,INAME,1) C C OPEN PROCEDURE FILE C CALL OPEN(IDCB,IERR,INAME) IF (IERR.EQ.-6) GOTO 40 39 CALL READF(IDCB,IERR,ISORT,36,IL) IF (IL.EQ.-1) GOTO 10 IF (IERR.LT.0) GOTO 90 CALL REIO(2,ITTY,ISORT,IL) GOTO 39 40 CONTINUE DO 42 K=1,3 42 ERR2(K+8) = INAME(K) C ERROR - PROCEDURE NOT FOUND CALL REIO(2,ITTY,ERR2,16) GO TO 10 C C C FMGR ERROR C 90 CALL FMERR(IERR,ITTY) GOTO 10 END $ FTN4,L,C PROGRAM QS11(5,90),92063-16011 REV. 1826 771027 C C C************************************************************* C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * C RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * C PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * C OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C************************************************************* C C C LISTING: 92063-19011 C SOURCE: 92063-18011 C RELOC: 92063-16011 C C C************************************************************ C C C DESTROY SERVICE ROUTINE C COMMON ITTY,ILP,IDCB(144),JDCB(144) COMMON DBNAM,DSNAM,DINAM,SELECT,SNAM COMMON DSNUM,DINUM,INTIAL,IMA,IB,IEND,ISCAN COMMON IPFLAG COMMON IRRCNT C INTEGER DBNAM(3),DSNAM(3),DINAM(3) INTEGER SELECT(3),SNAM(3) INTEGER DSNUM,DINUM DIMENSION IMA(36),IB(349) INTEGER END(2) DIMENSION NAME(2),INAME(3) INTEGER DATA(128) INTEGER ERR2(16) INTEGER ERR3(7) C DATA NAME/2HNA,2HME/ DATA END/2HEN,2HD;/ DATA INAME/2H ,2H ,2H / DATA ERR2/2H P,2HRO,2HCE,2HDU, 1 2HRE,2H N,2HAM,2HE ,2HXX,2HXX, 2 2HXX,2H N,2HOT,2H F,2HOU,2HND/ DATA ERR3/2H S,2HYN,2HTA, 1 2HX ,2HER,2HRO,2HR / C GOTO 20 C C DESTROY NAME = C C RETURN TO NEXT? C 10 SNAM(2) = 2H CALL EXEC(8,SNAM) C C SCAN FOR NAME C 20 CALL LSCAN(IB,I,J,K) IF(J-I.NE.3) GO TO 30 IF (JSCOM(NAME,1,4,IB,I,IERR).EQ.0) GO TO 35 30 DO 32 K=1,36 32 IMA(K) = 2H LEN = I + 1 CALL SPUT(IMA(2),LEN,136B) IMA(1) = (LEN+1)/2 CALL REIO(2,ITTY,IMA(2),IMA) C ERROR - SYNTAX CALL REIO(2,ITTY,ERR3,7) GO TO 10 C C FMGR ERROR C 25 CALL FMERR(IERR,ITTY) GOTO 10 C C PROCEDURE NOT FOUND C 40 CONTINUE DO 42 K=1,3 42 ERR2f  (K+8) = INAME(K) C ERROR - PROCEDURE NOT FOUND CALL REIO(2,ITTY,ERR2,16) GO TO 10 C C SCAN ACROSS = C 35 CALL LSCAN(IB,I,J,K) IF (K.NE.6) GO TO 30 C C GET PROCEDURE NAME (6 CHARS MAX) C CALL LSCAN(IB,I,J,K) IF (K.NE.2) GO TO 30 IF (J-I.GT.5) GO TO 30 CALL SMOVE(IB,I,J,INAME,1) C C PURGE FILE C CALL PURGE(IDCB,IERR,INAME) IF (IERR.EQ.-6) GOTO 40 IF (IERR.LT.0) GOTO 25 GOTO 10 C END $ _  KN 92063-18012 1840 S 1422 QUERY SOURCE #2              H0114 )FTN4,L,C PROGRAM QS12(5,90),92063-16012 REV. 1826 771027 C C C************************************************************* C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * C RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * C PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * C OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C************************************************************* C C C LISTING: 92063-19012 C SOURCE: 92063-18012 C RELOC: 92063-16012 C C C************************************************************ C C REPORT GENERATION MODULE #3 C C THIS MODULES PROCESSES C TOTAL REPORT STATEMENTS C C C REPORT GERERATION IS MADE UP OF THREE MODULES: C 1) QS06 - INITIALIZATION C 2) QS15 - CONTROL BREAKS AND GROUP/DETAILS C 3) QS12 - TOTALS C C THE PURPOSE OF THESE MODULES IS TO C GENERATE A REPORT BASED ON THE S TABLE. C IT IS ASSUMED THAT ALL LOGIC AND SYNTAX C ERRORS HAVE BEEN CORRECTED. C C REPORT TABLE FORMAT IN ARRAY S(6,100) C THIS TABLE IS BUILT BY QS02, LOGIC C CHECKED BY QS04, AND SORTED (IF NEEDED) C BY QS05. C C EACH ROW OF ARRAY S CONTAINS INFORMATION C ABOUT EACH REPORT STATEMENT: C C 1. REPORT STATEMENT TYPE C 10-15 SORT STATEMENT C 21-25 HEADER STATEMENT C 31-36 TOTAL STATEMENT C 41-46 GROUP STATEMENT C 50 DETAIL STATEMENT C 60-69 EDIT MASKS C C 2. DATA-ITEM NUMBER C C 3. LITERAL POINTER TO QSKIB. QSKIB IS A DISC TRAK C WHICH CONTAINS ALL LITERALS OR EDIT C MASKS IN A2 FORMAT, PRECEDED BY IT'S C CHARACTER LENGTH. C C 4. END PRINT POSITION C C 5. REPORT OPTION 1 C UNITS PLACE = SPACE BEFORE (0-5) C TENS PLACE = SPACE AFTER (0-5) C HUNDREDS PLACE = SKIP BEFORE (0-1) C THOUSANDS PLACE = SKIP AFTER (0-1) C TEN THOUSANDS = ADD (0-1) C C 6. REPORT OPdjTION 2 C UNITS PLACE = O NO EDIT = 1 ZERO SUPPRESS C 60 - 69 EDIT MASK C HUNDREDS PLACE = COUNT (0-1) C THOUSANDS PLACE = AVERAGE (0-1) C C COMMON ITTY,ILP,IDCB(144),JDCB(144) COMMON DBNAM,DSNAM,DINAM,SELECT,SNAM COMMON DSNUM,DINUM,INTIAL,IMA,IB,IEND,ISCAN COMMON IPFLAG COMMON IRRCNT,S,R3,TRKNM,IDILU,R5 COMMON R6 COMMON V COMMON STRA COMMON STRC COMMON STRD COMMON P1,P2 COMMON J1 COMMON ISORT(256) COMMON T,U COMMON STRE,STRF,STRG,STRH,STRI COMMON L,ATOTAL COMMON ISELD,IRSE,IPTR COMMON RCOUNT,N C INTEGER DBNAM(3),DSNAM(3),DINAM(3) INTEGER SELECT(3),SNAM(3) INTEGER DSNUM,DINUM DIMENSION IMA(36),IB(349) INTEGER V(8) INTEGER T(5) INTEGER U(7,5) INTEGER R3,S(6,100),R5,TRKNM INTEGER R6 INTEGER STRA(37) INTEGER STRC(67) INTEGER STRD(37) INTEGER STRE(37) INTEGER STRF(37) INTEGER STRG(37) INTEGER STRH(37) INTEGER STRI(37) INTEGER AS(36) INTEGER CS(66) INTEGER DS(36) INTEGER ES(36) INTEGER FS(36) INTEGER GS(36) INTEGER HS(36) INTEGER IS(36) INTEGER P1,P2 DIMENSION L(6) INTEGER ATOTAL(60,5) DIMENSION ISELD(128) INTEGER RCOUNT C EQUIVALENCE (STRA(1),LAS), (STRA(2),AS) EQUIVALENCE (STRC(1),LCS), (STRC(2),CS) EQUIVALENCE (STRD(1),LDS), (STRD(2),DS) EQUIVALENCE (STRE(1),LES), (STRE(2),ES) EQUIVALENCE (STRF(1),LFS), (STRF(2),FS) EQUIVALENCE (STRG(1),LGS), (STRG(2),GS) EQUIVALENCE (STRH(1),LHS), (STRH(2),HS) EQUIVALENCE (STRI(1),LIS), (STRI(2),IS) C C T ARRAY IS USED TO HOLD SORT FIELDS C C U ARRAY IS USED FOR TOTAL COUNT C 1. FIELD MAP (1,I) C 2. ACCUMULATE COUNTS (2,I) - (7,I) C C ATOTAL ARRAY IS FOR TOTAL ADD (10*6)*5 IdN ASCII C C N IS A SWITCH WHICH IS SET TO NOT RECOGNIZE C A CONTROL BREAK ON FIRST DETAIL RECORD READ C (TOTAL PRINTING SUPPRESSION). C C L(1) TO L(5) ARE RESET WHEN A CONTROL BREAK C OCCURS AT THAT LEVEL. C L(6) IS RESET WHEN THE LAST RECORD C IS ENCOUNTERED. C C TOTAL C 1070 J3 = 0 DO 1390 J1=1,R3 IF(S(1,J1).LT.30) GOTO 1390 IF(S(1,J1).GT.40) GOTO 1400 J2 = S(1,J1) - 10*(S(1,J1)/10) IF (L(J2).NE.0) GO TO 1390 IF (J2.EQ.J3) GO TO 1200 IF (J3.EQ.0) GO TO 1190 C LINE SPACING AND SKIPPING BEFORE PRINTING CALL CSBP DO 1072 I=LCS,1,-1 CALL SGET(CS,I,ICHAR) IF(ICHAR.NE.40B) GOTO 1074 1072 CONTINUE GOTO 1076 1074 CALL REIO(2,ILP,CS,-I) P2=P2+1 IF (IFBRK(IDUM).NE.0) GOTO 1470 1076 CONTINUE C LINE SPACING AND SKIPPING AFTER PRINTING CALL CSAP 1190 J3 = J2 1200 IF (S(2,J1).NE.0) GO TO 1230 C BUFFER PART OF LINE 1220 CALL BUFLN GO TO 1390 C SPLIT APART REPORT OPTIONS (INTO "V") 1230 CALL SPLIT DO 1260 J4=1,5 IF(S(2,J1).EQ.IABS(U(1,J4))) GO TO 1270 1260 CONTINUE GO TO 1390 C 1270 IF (V(5).EQ.0) GO TO 1300 C C ADD J5 = (J2-1)*10 + 1 KBEG = 1 KEND = 20 DO 1280 IX=KBEG,KEND C SCAN FIELD AND SUSPRESS LEADING ZERO'S CALL SGET(ATOTAL(J5,J4),IX,ICHAR) IF(ICHAR.NE.60B) GOTO 1290 1280 CONTINUE C FIELD IS ALL ZERO'S - SET LENGTH TO 1 IX = KEND - 1 1290 KBEG = IX LDS = KEND-KBEG+1 CALL SMOVE(ATOTAL(J5,J4),KBEG,KEND,DS,1) V(5) = 0 GO TO 1340 C 1300 IF (V(7).EQ.0) GO TO 1330 C C COUNT J8 = U(J2+1,J4) CALL CITA(J8,DS) DO 1310 I=2,5 CALL SGET(DS,I,ICHAR) IF(ICHAR.NE.60B) GOTO 1320 1310 CONTINUE 1320 LDS = 7 - I CALL SMOVE(DS,I,6,DS,1) V(7) = 0 GO TO 1340 C 1330 CONTINUE C C AVERAGE IF(V(8).EQ.0) GO TO 1220 J8 = U(J2+1,J4) IM IF(J8.LE.0) GOTO 1336 CALL CITA(J8,DS) C SUPPRESS LEADING ZERO'S FROM DIVISOR DO 1332 I=2,5 CALL SGET(DS,I,ICHAR) IF(ICHAR.NE.60B) GOTO 1335 1332 CONTINUE 1335 JBEG = I LDS = 6 DO 1331 I=1,26 1331 IMA(I) = 2H00 J5 = (J2-1)*10 + 1 DO 1333 I=27,36 C MOVE ATOTAL(J5,J4) TO RH END OF IMA IMA(I) = ATOTAL(J5,J4) 1333 J5 = J5 + 1 C SUPPRESS LEADING ZERO'S KBEG = 52 KEND = 72 DO 1334 IX=KBEG,KEND CALL SGET(IMA,IX,ICHAR) IF(ICHAR.NE.60B) GOTO 1337 1334 CONTINUE 1336 CONTINUE DS = 2H00 JBEG = 1 LDS = 2 GO TO 1339 1337 CONTINUE KBEG = IX JEND = LDS IERR = 0 CALL SDIV(DS,JBEG,JEND,IMA,KBEG,KEND,IERR) C IF ERROR FROM SDIV - DIVISOR > QUOTIENT IF(IERR) 1336,1338,1336 1338 CONTINUE LDS = JEND-JBEG+1 JBEG = KBEG - LDS JEND = KEND - LDS LDS = JEND - JBEG + 1 CALL SMOVE(IMA,JBEG,JEND,DS,1) 1339 V(8) = 0 C 1340 CONTINUE JBEG = 1 IF (V(6).EQ.0) GO TO 1370 C C EDIT RETURNS EDITED FIELD IN DS C CALL EDIT 1370 LEN = S(4,J1) - LDS + 1 IF(LEN.GT.0) GOTO 1380 LEN = 1 JBEG = LDS - S(4,J1) + 1 1380 CALL SMOVE(DS,JBEG,LDS,CS,LEN) 1390 CONTINUE C 1400 CONTINUE DO 1404 I=LCS,1,-1 CALL SGET(CS,I,ICHAR) IF (ICHAR.NE.40B) GO TO 1410 1404 CONTINUE GOTO 1420 1410 CONTINUE C LINE SPACING AND SKIPPING BEFORE PRINTING CALL CSBP CALL REIO(2,ILP,CS,-I) P2=P2+1 IF (IFBRK(IDUM).NE.0) GOTO 1470 C LINE SPACING AND SKIPPING AFTER PRINTING CALL CSAP 1420 CONTINUE C C CLEAR COUNT AND TOTAL FIELDS IF(L(6).EQ.0) GOTO 1470 DO 1460 J1=1,R3 IF(S(1,J1).LT.30) GOTO 1460 IF(S(1,J1).GT.40) GOTO 780 J2 = S(1,J1) - 10*(S(1,J1)/10) IF(L(J2).NE.0) GOTO 1460 DO 1430 J4=1,5 IF(S(2,J1).EQ.IABS(U(1,J4))) GO TO 1440 143;0 CONTINUE GOTO 1460 1440 CONTINUE C ZERO COUNT U(J2+1,J4) = 0 C ZERO TOTAL J5 = (J2-1)*10 + 1 DO 1450 I=J5,J5+9 1450 ATOTAL(I,J4) = 2H00 1460 CONTINUE C C LOAD QS15 MODULE FOR GROUP/DETAIL C 780 SNAM(2) = 2H15 GOTO 1475 C C RETURN TO MAIN MODULE (QS) C 1470 CONTINUE SNAM(2) = 2H 1475 CONTINUE CALL EXEC(8,SNAM) END $ /FTN4,L,C PROGRAM QS13(5,90),92063-16012 REV. 1826 771027 C C C************************************************************* C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * C RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * C PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * C OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C************************************************************* C C C LISTING: 92063-19012 C SOURCE: 92063-18012 C RELOC: 92063-16012 C C C************************************************************ C C C HELP SERVICE ROUTINE C COMMON ITTY,ILP,IDCB(144),JDCB(144) COMMON DBNAM,DSNAM,DINAM,SELECT,SNAM COMMON DSNUM,DINUM,INTIAL,IMA,IB,IEND,ISCAN COMMON IPFLAG COMMON IRRCNT C INTEGER DBNAM(3),DSNAM(3),DINAM(3) INTEGER SELECT(3),SNAM(3) INTEGER DSNUM,DINUM DIMENSION IMA(36),IB(349) DIMENSION KDCB(144) INTEGER CMND(2),FILE(3),DIR(128) DIMENSION IBUF(128) C DATA FILE/2HHE,2HLP,2HF / DATA CMND/2H ,2H / C LIST = 0 C SCAN FOR ; OR NAME CALL LSCAN(IB,I,J,K) IF(K-5) 10,60 C C MOVE NAME TO CMND C 10 CALL SMOVE(IB,I,I+3,CMND,1) 15 CALL LSCAN(IB,I,J,K) IF(K-5) 20,60 20 IF (JSCOM(IB,I,I+1,2HAL,1,IERR).NE.0) GO TO 30 LIST = 111 GO TO 60 30 IF (JSCOM(IB,I,I+1,2HFU,1,IERR).NE.0) GO TO 40 LIST = LIST + 100 GO TO 15 40 IF (JSCOM(IB,I,I+1,2HSY,1,IERR).NE.0) GO TO 50 LIST = LIST + 10 GO TO 15 50 IF (JSCOM(IB,I,I+1,2HOP,1,IERR).NE.0) GO TO 15 LIST = LIST + 1 GO TO 15 60 IF (LIST.EQ.0 .OR. LIST.EQ.111) LIST = 111 C C GET DIRECTORY C CALL OPEN(KDCB,IERR,FILE) 61 IF (IERR.GE.0) GOTO 65 CALL FMERR(IERR,ITTY) GOTO 120 65 CALL READF(KDCB,IERR,DIR,128,ILEN,1) IF (IERR.LT.0) GOTO 61 C C LSEC DATA FILE SECTOR LIMIT ]  C NWDS NO OF WORDS/DIRENTRY ENTRY C NEXT NO OF DIRECTORY ENTRIES C ILIM IDRECTORY LIMIT IN WORDS C IPNT POINTER TO REL SECTOR OF DATA C LSEC=DIR(2) NENT=DIR(3) - 1 NWDS=DIR(4) ILIM=NWDS*NENT + 7 IF (CMND(1).NE.2H ) GO TO 80 70 IOUT=1 ISEC=DIR(7) GO TO 170 80 DO 110 J=8,ILIM,NWDS IF (DIR(J)-CMND(1)) 110,90,110 90 IF (DIR(J+1)-CMND(2)) 110,100,110 100 IPNT=J+2 GO TO 130 110 CONTINUE C C ERROR C 120 CALL CLOSE(KDCB) SNAM(2)=2H CALL EXEC(8,SNAM) C 130 IF (LIST.LT.100) GO TO 140 ISEC=DIR(IPNT) LIST=LIST-100 GO TO 160 140 IF (LIST.LT.10) GO TO 150 ISEC=DIR(IPNT+1) LIST=LIST-10 GO TO 160 150 IF (LIST.LT.1) GO TO 120 ISEC=DIR(IPNT+2) LIST=LIST-1 160 IOUT=2 C C READ 128 WORDS FROM THE DISC INTO IBUF AND C RESET THE POINTER TO THE START OF THE BUFFER C 170 IPNTR=1 CALL READF(KDCB,IERR,IBUF,128,ILEN,ISEC) IF(IERR.LT.0) GOTO 61 C C PICK UP RECORD LENGTH (WORDS) AND C SUBSTITUTE BLANKS C 180 ILGTH=IBUF(IPNTR) IBUF(IPNTR)=2H C C OUTPUT THE RECORD AND UPDATE THE POINTER C TO THE NEXT RECORD COUNT WORD C ILGTH=ILGTH+1 CALL REIO(2,ITTY,IBUF(IPNTR),ILGTH) IPNTR=IPNTR+ILGTH C C IF NEXT WORD COUNT = -1 INPUT NEXT SECTOR C 0 END OF DATA C + OUTPUT NEXT RECORD C IF (IBUF(IPNTR)) 190,200,180 190 ISEC=ISEC+1 GO TO 170 200 GO TO (120,130), IOUT END $ FTN4,L,C PROGRAM QS14(5,90),92063-16012 REV. 1840 780807 C C C************************************************************* C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * C RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * C PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * C OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C************************************************************* C C C LISTING: 92063-19012 C SOURCE: 92063-18012 C RELOC: 92063-16012 C C C************************************************************ C C C UPDATE SERVICE MODULE (PART II) C REPLACE AND DELETE ROUTINES C SEE QS07 FOR ADD ROUTINE C COMMON ITTY,ILP,IDCB(144),JDCB(144) COMMON DBNAM,DSNAM,DINAM,SELECT,SNAM COMMON DSNUM,DINUM,INTIAL,IMA,IB,IEND,ISCAN COMMON IPFLAG COMMON IRRCNT COMMON ICHAR COMMON IPROC C INTEGER DBNAM(3),DSNAM(3),DINAM(3) INTEGER SELECT(3),SNAM(3) INTEGER DSNUM,DINUM DIMENSION IMA(36),IB(349) INTEGER ERR1(15) INTEGER ERR2(7) INTEGER ERR3(12) INTEGER ERR4(12) INTEGER ERR5(9) INTEGER ERR6(14) INTEGER ERR7(19) INTEGER ERR8(19) INTEGER END(2) INTEGER A,R INTEGER RC2,RC8,RC14 DIMENSION INFO(10) DIMENSION INBR(100) DIMENSION IVALU(256) DIMENSION ISORT(256) INTEGER U INTEGER P2 INTEGER RECORD DIMENSION ISELD(128) DIMENSION ISTAT(4) INTEGER ERROR(8) C C END; DATA END/2HEN,2HD;/ C RECORD HAS NOT YET BEEN FOUND DATA ERR1/2H R,2HEC,2HOR,2HD ,2HHA,2HS ,2HNO, 1 2HT ,2HYE,2HT ,2HBE,2HEN,2H F,2HOU,2HND/ C SYNTAX ERROR DATA ERR2/2H S,2HYN,2HTA,2HX ,2HER,2HRO,2HR / C ILLEGAL DATA ITEM NAME DATA ERR3/2H I,2HLL,2HEG,2HAL,2H D, 1 2HAT,2HA ,2HIT,2HEM,2H N,2HAM,2HE / C DATA ITEM NOT RETRIEVED DATA ERR4/2H DB,2HAT,2HA ,2HIT,2HEM, 1 2H N,2HOT,2H R,2HET,2HRI,2HEV,2HED/ C MIXED MODE UPDATE DATA ERR5/2H M,2HIX,2HED,2H M, 1 2HOD,2HE ,2HUP,2HDA,2HTE/ C INPUT TOO LONG - TRUNCATED DATA ERR6/2H I,2HNP,2HUT,2H T,2HOO,2H L, 1 2HON,2HG ,2H- ,2HTR,2HUN,2HCA,2HTE,2HD / C INTEGER VALUE ERROR - UPDATE ABORTED DATA ERR7/2H I,2HNT,2HEG,2HER, 1 2H V,2HAL,2HUE,2H E,2HRR,2HOR,2H -, 2 2H U,2HPD,2HAT,2HE ,2HAB,2HOR,2HTE,2HD / DATA ERR8/2H N,2HON,2H-N,2HUM,2HER,2HIC,2H I, 1 2HN ,2HRE,2HAL,2H O,2HR ,2HIN,2HTE,2HGE,2HR , 1 2HVA,2HLU,2HE / DATA A/101B/ DATA KCHAR/113B/ DATA R/122B/ DATA U/125B/ DATA RC2/2/ DATA RC8/8/ DATA RC14/14/ DATA ERROR/2HER,2HRO,2HR ,2HNO,2H. ,2HXX,2HXX,2HXX/ C C UPDATE NAME = ; C A,; C K; C R,=""; C INBR = 0 P2 = 1 IF(IPFLAG.EQ.0 .AND. IPROC.EQ.0) GOTO 37 IPFLAG=3 37 CONTINUE C C DELETE UPDATE IF(ICHAR.EQ.KCHAR) GOTO 200 C REPLACE UPDATE IF(ICHAR.EQ.R) GOTO 300 C C ERROR - SYNTAX ERROR C 40 DO 45 K=1,36 45 IMA(K) = 2H LEN = I+1 CALL SPUT(IMA(2),LEN,136B) IMA(1) = (LEN+1)/2 CALL REIO(2,ITTY,IMA(2),IMA) CALL REIO(RC2,ITTY,ERR2,7) C C RETURN TO NEXT? 50 SNAM(2) = 2H CALL EXEC(RC8,SNAM) C C ERROR - DBMS C 60 CALL CITA(ISTAT,ERROR(6)) CALL REIO(2,ITTY,ERROR,8) GO TO 50 C C FMGR ERROR C 70 CALL FMERR(ISTAT,ITTY) GOTO 50 C C DELETE STATEMENT C 200 CALL LSCAN(IB,I,J,K) IF(K.NE.5) GOTO 40 IF(IRRCNT.NE.0) GOTO 400 C ERROR - NO RECORD FOUND YET 210 CALL REIO(RC2,ITTY,ERR1,15) GOTO 50 C C REPLACE STATEMENT C 300 CALL LSCAN(IB,I,J,K) IF(K.NE.4) GOTO 40 IF(IRRCNT.EQ.0) GOTO 210 C GET DATA ITEM NAME. CALL LSCAN(IB,I,J,K) IF(J-I.GT.5) GOTO 40 DO 302^W K=1,3 302 DINAM(K) = 2H CALL SMOVE(IB,I,J,DINAM,1) C GET DATA ITEM NUMBER CALL DBINF(2HI ,5,DINAM,INFO) IF(INFO.EQ.0) GOTO 310 C ERROR - ILLEGAL DATA ITEM NAME 305 CONTINUE CALL REIO(RC2,ITTY,ERR3,12) GOTO 50 310 DINUM = INFO(2) C GET DATA ITEM CHARACTERISTICS CALL DBINF(2HI ,2,DINUM,INFO) IF(INFO.NE.0) GOTO 305 IF(DSNUM.EQ.INFO(9)) GOTO 320 C ERROR - D-I NOT RETRIEVED (IN ANOTHER D-S) CALL REIO(RC2,ITTY,ERR4,12) GOTO 50 320 CALL LSCAN(IB,I,J,K) C SCAN ACROSS "=" IF(K.NE.6) GOTO 40 C GET VALUE CALL LSCAN(IB,I,J,K) C MUST BE LITERAL VALUE (I.E. "") IF(K.NE.3) GOTO 40 C GET ITEM TYPE CALL SGET(INFO,10,ITYPE) LEN = INFO(7) IF(ITYPE.EQ.U) GOTO 340 IF(ITYPE.EQ.R) GOTO 330 C INTEGER FIELD INT = 0 IF(J-I.LT.0) GOTO 327 C REMOVE SIGN OF INPUT STRING CALL SZONE(IB,J,4,NSIGN) C CONVERT DATA TO INTEGER CALL CATI(IB,I,J-I+1,INT,ISTAT) IF(ISTAT.EQ.0) GOTO 325 C C INTEGER VALUE ERROR - UPDATE ABORTED C CALL REIO(RC2,ITTY,ERR7,19) GOTO 50 325 CONTINUE C REPLACE SIGN TO STRING CALL SZONE(IB,J,NSIGN,I) C PLACE CORRECT SIGN IN INTEGER VAR IF(NSIGN.EQ.2) INT = -INT 327 CONTINUE IVALU(P2) = INT P2 = P2 + LEN GOTO 360 C REAL VARIABLE 330 VAR = 0.0 IF(J-I.LT.0) GOTO 335 VAR = CATR(IB,I,J,ISTAT) IF (ISTAT.EQ.0) GOTO 335 CALL REIO(2,ITTY,ERR8,19) GOTO 50 335 CONTINUE CALL SMOVE(VAR,1,4,IVALU,P2+P2-1) P2 = P2 + LEN GOTO 360 340 DO 350 N=0,LEN-1 350 IVALU(P2+N) = 2H IF(J-I.LT.0) GOTO 357 IF(J-I.LT.LEN+LEN) GOTO 355 C ERROR - INPUT TOO LONG CALL REIO(RC2,ITTY,ERR6,14) J = LEN+LEN+I-1 355 CONTINUE CALL SMOVE(IB,I,J,IVALU,P2+P2-1) 357 CONTINUE P2 = P2 + LEN 360 INBR = INBR + 1 INBR(INBR+1) = DINUM CALL LSCAN(IB,I,J,K) IF(K.NE.5) GOTO 40 CALL LSCAN(IB,I,J,K) C CHECK FOR "END;" IF(JSCOM(END,1,3,IB,I,IERR).EQ.0) GOTO 400 IF(JSCOM(ICHAR,2,1,IB,I,IERR).EQ.0) GOTO 300 C ERROR - MIXED MODE UPDATE CALL REIO(RC2,ITTY,ERR5,9) GOTO 50 400 IRSE = 1 IPTR = 130 DO 500 NUMBER=1,IRRCNT IF(IPTR.LT.129) GOTO 410 CALL READF(JDCB,ISTAT,ISELD,128,IL,IRSE) IRSE = IRSE + 1 IPTR = 1 410 RECORD = ISELD(IPTR) IPTR = IPTR + 1 C C GET RECORD VIA DIRECTED READ C CALL DBGET(DSNUM,3,ISTAT,ISORT,RECORD) IF(ISTAT.NE.0) GOTO 60 IF(ICHAR.EQ.KCHAR) GOTO 420 C C UPDATE RECORD C CALL DBUPD(DSNUM,ISTAT,INBR,IVALU,ISORT) IF(ISTAT.NE.0) GOTO 60 GOTO 500 C C DELETE RECORD C 420 CALL DBLCK(1,ISTAT) IF (ISTAT.NE.0) GOTO 60 CALL DBDEL(DSNUM,ISTAT) CALL DBUNL(ISTAT2) C C CHECK THE STATUS OF THE DELETE C IF(ISTAT .NE. 0) GOTO 60 C C CHECK THE STATUS OF THE UNLOCK C ISTAT= ISTAT2 IF(ISTAT .NE. 0) GOTO 60 500 CONTINUE GOTO 50 END END$ CFTN4,L,C PROGRAM QS15(5,90),92063-16012 REV. 1826 771027 C C C************************************************************* C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * C RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * C PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * C OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C************************************************************* C C C LISTING: 92063-19012 C SOURCE: 92063-18012 C RELOC: 92063-16012 C C C************************************************************ C C C REPORT GENERATION MODULE #2 C C THIS MODULE READS RECORDS FROM C THE DATA-BASE VIA DBGET, C DETERMINDES CONTROL BREAKS, AND C PROCESSES GROUP AND DETAIL C REPORT STATEMENTS C C C REPORT GERERATION IS MADE UP OF THREE MODULES: C 1) QS06 - INITIALIZATION C 2) QS15 - CONTROL BREAKS AND GROUP/DETAILS C 3) QS12 - TOTALS C C THE PURPOSE OF THESE MODULES IS TO C GENERATE A REPORT BASED ON THE S TABLE. C IT IS ASSUMED THAT ALL LOGIC AND SYNTAX C ERRORS HAVE BEEN CORRECTED. C C REPORT TABLE FORMAT IN ARRAY S(6,100) C THIS TABLE IS BUILT BY QS02, LOGIC C CHECKED BY QS04, AND SORTED (IF NEEDED) C BY QS05. C C EACH ROW OF ARRAY S CONTAINS INFORMATION C ABOUT EACH REPORT STATEMENT: C C 1. REPORT STATEMENT TYPE C 10-15 SORT STATEMENT C 21-25 HEADER STATEMENT C 31-36 TOTAL STATEMENT C 41-46 GROUP STATEMENT C 50 DETAIL STATEMENT C 60-69 EDIT MASKS C C 2. DATA-ITEM NUMBER C C 3. LITERAL POINTER TO QSKIB. QSKIB IS A C DISC TRK WHICH CONTAINS ALL LITERALS OR EDIT C MASKS IN A2 FORMAT, PRECEDED BY IT'S C CHARACTER LENGTH. C C 4. END PRINT POSITION C C 5. REPORT OPTION 1 C UNITS PLACE = SPACE BEFORE (0-5) C TENS PLACE = SPACE AFTER (0-5) C HUNDREDS PLACE = SKIP BEFORE (J0-1) C THOUSANDS PLACE = SKIP AFTER (0-1) C TEN THOUSANDS = ADD (0-1) C C 6. REPORT OPTION 2 C UNITS PLACE = O NO EDIT = 1 ZERO SUPPRESS C 60 - 69 EDIT MASK C HUNDREDS PLACE = COUNT (0-1) C THOUSANDS PLACE = AVERAGE (0-1) C C COMMON ITTY,ILP,IDCB(144),JDCB(144) COMMON DBNAM,DSNAM,DINAM,SELECT,SNAM COMMON DSNUM,DINUM,INTIAL,IMA,IB,IEND,ISCAN COMMON IPFLAG COMMON IRRCNT,S,R3,TRKNM,IDILU,R5 COMMON R6 COMMON V COMMON STRA COMMON STRC COMMON STRD COMMON P1,P2 COMMON J1 COMMON ISORT(256) COMMON T,U COMMON STRE,STRF,STRG,STRH,STRI COMMON L,ATOTAL COMMON ISELD,IRSE,IPTR COMMON RCOUNT,N C INTEGER DBNAM(3),DSNAM(3),DINAM(3) INTEGER SELECT(3),SNAM(3) INTEGER DSNUM,DINUM DIMENSION IMA(36),IB(349) INTEGER V(8) INTEGER T(5) INTEGER U(7,5) INTEGER R3,S(6,100),R5,TRKNM INTEGER R6 INTEGER STRA(37) INTEGER STRC(67) INTEGER STRD(37) INTEGER STRE(37) INTEGER STRF(37) INTEGER STRG(37) INTEGER STRH(37) INTEGER STRI(37) INTEGER AS(36) INTEGER CS(66) INTEGER DS(36) INTEGER ES(36) INTEGER FS(36) INTEGER GS(36) INTEGER HS(36) INTEGER IS(36) INTEGER P1,P2 DIMENSION L(6) INTEGER ATOTAL(60,5) DIMENSION ISELD(128) INTEGER ISTAT(4) INTEGER RECORD INTEGER RCOUNT INTEGER ERROR(8) INTEGER ERR1(9) INTEGER ERR2(7) INTEGER ERR3(8) C EQUIVALENCE (STRA(1),LAS), (STRA(2),AS) EQUIVALENCE (STRC(1),LCS), (STRC(2),CS) EQUIVALENCE (STRD(1),LDS), (STRD(2),DS) EQUIVALENCE (STRE(1),LES), (STRE(2),ES) EQUIVALENCE (STRF(1),LFS), (STRF(2),FS) EQUIVALENCE (STRG(1),LGS), (STRG(2),GS) EQUIVALENCE (STRH(1),LHS), (STRH(2),HS) EQUIVALENCE (S*TRI(1),LIS), (STRI(2),IS) C DATA ERROR/2HER,2HRO,2HR ,2HNO,2H. ,2HXX,2HXX,2HXX/ C ADD FIELD ILLEGAL DATA ERR1/2H A,2HDD,2H F,2HIE,2HLD,2H I,2HLL,2HEG,2HAL/ C ADD OVERFLOW DATA ERR2/2H A,2HDD,2H O,2HVE,2HRF,2HLO,2HW / DATA ERR3/2H F,2HMG,2HR ,2HIN,2H R,2HEP,2HOR,2HT / C C C T ARRAY IS USED TO HOLD SORT FIELDS C C U ARRAY IS USED FOR TOTAL COUNT C 1. FIELD MAP (1,I) C 2. ACCUMULATE COUNTS (2,I) - (7,I) C C ATOTAL ARRAY IS FOR TOTAL ADD (10*6)*5 IN ASCII C C N IS A SWITCH WHICH IS SET TO NOT RECOGNIZE C A CONTROL BREAK ON FIRST DETAIL RECORD READ C (TOTAL PRINTING SUPPRESSION). C C L(1) TO L(5) ARE RESET WHEN A CONTROL BREAK C OCCURS AT THAT LEVEL. C L(6) IS RESET WHEN THE LAST RECORD C IS ENCOUNTERED. C C RCOUNT IS RETRIEVED RECORD COUNT C C IF R6=1 ENTRY FROM QS12 C IF(R6.NE.0) GOTO 780 360 IF (RCOUNT.EQ.0) GO TO 760 IF(IPTR.LT.129) GOTO 365 CALL READF(JDCB,ISTAT,ISELD,128,IL,IRSE) IF (ISTAT.LT.0) GOTO 1091 IRSE = IRSE + 1 IPTR = 1 C GET RECORD # FROM SELECT-FILE 365 RECORD = ISELD(IPTR) IPTR = IPTR + 1 C C GET RECORD VIA DIRECTED READ CALL DBGET(DSNUM,3,ISTAT,ISORT,RECORD) IF (ISTAT.NE.0) GOTO 1480 IF (T(1).EQ.-1) GO TO 742 DINUM = T(1) C C FIELD RETURNS AN ASCII STRING IN DS C CALL FIELD IF(LDS.NE.LES) GO TO 450 IF (JSCOM(DS,1,LDS,ES,1,IERR).EQ.0) GO TO 470 450 LES = LDS CALL SMOVE(DS,1,LDS,ES,1) L(1) = 0 470 IF (T(2).EQ.-1) GO TO 742 DINUM = T(2) CALL FIELD IF (LDS.NE.LFS) GO TO 520 IF (JSCOM(DS,1,LDS,FS,1,IERR).EQ.0) GO TO 540 520 LFS = LDS CALL SMOVE(DS,1,LDS,FS,1) L(2) = 0 540 IF (T(3).EQ.-1) GO TO 742 DINUM = T(3) CALL FIELD IF (LDS.NE.LGS) GO TO 590 IF (JSCOM(DS,1,LDS,GS,1,IERR).EQ.0) GO TO 610 590 LGS = LDS CALL SMOVE(DS,1,LDS,GS,1) L(3) = 0 610 IF (T(4).EQ.-1) GO TO 742 DINUM = T(4) CALL FIELD IF (LDS.NE.LHS) GO TO 660 IF (JSCOM(DS,1,LDS,HS,1,IERR).EQ.0) GO TO 680 660 LHS = LDS CALL SMOVE(DS,1,LDS,HS,1) L(4) = 0 680 IF (T(5).EQ.-1) GO TO 742 DINUM = T(5) CALL FIELD IF (LDS.NE.LIS) GO TO 730 IF (JSCOM(DS,1,LDS,IS,1,IERR).EQ.0) GO TO 742 730 LIS = LDS CALL SMOVE(DS,1,LDS,IS,1) L(5) = 0 742 DO 754 J1=5,1,-1 IF (L(J1).EQ.-1) GO TO 754 744 DO 750 J2=J1,1,-1 L(J2) = 0 750 CONTINUE GO TO 770 754 CONTINUE GO TO 770 760 DO 765 I=1,6 L(I) = 0 765 CONTINUE R5 = 1 770 IF (N.EQ.0) GO TO 1070 N = 0 R6 = 1 C 780 DO 880 J1=1,5 IF(U(1,J1).EQ.0) GO TO 890 C ACCUMULATE COUNTS DO 790 J=2,7 U(J,J1) = U(J,J1) + 1 790 CONTINUE C ACCUMULATE TOTALS IF(U(1,J1).GT.0) GO TO 880 DINUM = IABS(U(1,J1)) CALL FIELD DO 870 J3=1,60,10 KBEG = 1 KEND = 20 IERR = 0 CALL SADD(DS,1,LDS,ATOTAL(J3,J1),KBEG,KEND,IERR) IF(IERR) 1500,870,1510 870 CONTINUE 880 CONTINUE 890 DO 892 I=1,66 892 CS(I) = 2H DO 900 I=1,8 900 V(I) = 0 C C DETAIL AND GROUP C 980 DO 1000 J1=1,R3 IF(S(1,J1).EQ.50) GOTO 990 960 IF (S(1,J1).LT.40 .OR. S(1,J1).GT.49) GO TO 1000 J2 = S(1,J1) - 10*(S(1,J1)/10) IF (L(J2).NE.0) GO TO 1000 C BUFFER PART OF LINE 990 CALL BUFLN 1000 CONTINUE C LINE SPACING AND SKIPPING BEFORE PRINTING CALL CSBP DO 1024 I=LCS,1,-1 CALL SGET(CS,I,ICHAR) IF (ICHAR.NE.40B) GO TO 1030 1024 CONTINUE GO TO 1040 1030 CALL REIO(2,ILP,CS,-I) P2=P2+1 IF (IFBRK(IDUM).NE.0) GOTO 1470 C LINE SPACING AND SKIPPING AFTER PRINTING 1040 CALL CSAP DO 1050 I=1,6 L(I) = -1 1050 CONTINUE RCOUNT = RCOUNT - 1 GO TO 360 C C TOTALS - LOAD0] QS12 MODULE C C IF R5=0 - NO TOTALS C 1070 IF(R5.EQ.0) GOTO 780 DO 1080 I=1,6 IF(L(I).EQ.0) GOTO 1090 1080 CONTINUE GOTO 780 1090 CONTINUE SNAM(2) = 2H12 GOTO 1475 C C RETURN TO MAIN MODULE (QS) C 1470 CONTINUE 1471 SNAM(2) = 2H 1475 CONTINUE CALL EXEC(8,SNAM) C C OUTPUT DBMS ERROR CODE 1480 CALL CITA(ISTAT,ERROR(6)) CALL REIO(2,ITTY,ERROR,8) GOTO 1470 C C ERROR - ADD FIELD ILLEGAL 1500 CALL REIO(2,ITTY,ERR1,9) GOTO 1471 C C ERROR - ADD OVERFLOW 1510 CALL REIO(2,ITTY,ERR2,7) GOTO 1470 C C ERROR FILE MANAGER C 1091 CALL REIO(2,ITTY,ERR3,8) GOTO 1470 C END $ ɯFTN4,L,C PROGRAM QS16(5,90),92063-16012 REV. 1826 771027 C C C************************************************************* C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * C RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * C PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * C OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C************************************************************* C C C LISTING: 92063-19012 C SOURCE: 92063-18012 C RELOC: 92063-16012 C C C************************************************************ C C C EXIT SERVICE MODULE C CLOSE DATA-BASE AND RETURN TO SYSTEM C COMMON ITTY,ILP,IDCB(144),JDCB(144) COMMON DBNAM INTEGER DBNAM(3) DIMENSION ISTAT(2) INTEGER ERROR(8) C DATA ERROR/2HER,2HRO,2HR ,2HNO,2H. ,2HXX,2HXX,2HXX/ C IF(DBNAM.EQ.2H ) GOTO 100 CALL DBCLS(0,ISTAT) IF(ISTAT.EQ.0) GOTO 100 CALL CITA(ISTAT,ERROR(6)) CALL REIO(2,ITTY,ERROR,8) C RELEASE 'QSKIB' TRACK 100 CALL EXEC(5,-1) CALL CLOSE(JDCB) CALL CLOSE(IDCB) CALL EXEC(6) END $ FTN4,L,C SUBROUTINE LSCAN(KARS,I,J,K),92063-16012 REV. 1826 771027 C C C************************************************************* C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * C RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * C PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * C OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C************************************************************* C C C LISTING: 92063-19012 C SOURCE: 92063-18012 C RELOC: 92063-16012 C C C************************************************************ C C COMMON ITTY,ILP,IDCB(144),JDBCB(144) COMMON DBNAM,DSNAM,DINAM,SELECT,SNAM COMMON DSNUM,DINUM,INTIAL,IMA,IB,IEND,ISCAN COMMON IPFLAG COMMON IRRCNT C INTEGER DBNAM(3),DSNAM(3),DINAM(3) INTEGER SELECT(3),SNAM(3) INTEGER DSNUM,DINUM DIMENSION IMA(36),IB(349) DIMENSION KARS(1) C C VALUE OF K INDICATES ROUTINE IS PROCESSING C BLANKS(1), SYMBOLS(2), LITERALS(3), TERMINATORS(4) C K = 1 80 CONTINUE J = ISCAN - 1 99 J = J + 1 C GET CHARACTER FROM KARS STRING IF (J.GT.IEND) 60,70 60 CONTINUE IF (K.NE.3) GO TO 65 C PROCESSING LITERAL - SET INTIAL IF READING SPEC-FILE IF (IPFLAG.NE.0) INTIAL = -1 65 CALL INPUT GO TO 80 70 CALL SGET(KARS,J,KAR) KAR = KAR - 37B GO TO (1,5,6,3,3,3,3,3, C ! " # $ % & ' C 1 5,5,3,3,4,3,3,3, C ( ) * + , - . / C 2 3,3,3,3,3,3,3,3, C 0 1 2 3 4 5 6 7 C 3 3,3,3,4,5,4,5,3, C 8 9 : ; < = > ? C 4 3,2,2,2,2,2,2,2, C @ A B C D E F G C 5 2,2,2,2,2,2,2,2, C H I J K L M N O C 6 2,2,2,2,2,2,2,2, C P Q R S T U V W C 7 2,2,2,5,5,5,5,5), KAR C X YaZ [ \ ] ^ _ C C BLANK 1 GO TO (99,24   ,99), K C LETTER 2 GO TO (21,99,99), K C DIGIT OR B-CHAR 3 GO TO (21,99,99), K C TERMINATOR ,/;/= 4 GO TO (23,24,99), K C OTHER CHARACTR 5 GO TO (25,25,99), K C QUOTE 6 GO TO (22,25,26), K C START OF SYMBOL 21 I = J K = 2 GO TO 99 C START OF LITERAL VALUE 22 I = J + 1 K = 3 GO TO 99 C TERMINATOR 23 I = J ISCAN = J + 1 C COMMA IF (KAR.EQ.13) K = 4 C SEMI-COLON IF (KAR.EQ.28) K = 5 C EQUALS IF (KAR.EQ.30) K = 6 RETURN C TERMINATE SYMBOL 24 J = J - 1 ISCAN = J + 1 RETURN C ILLEGAL CHARACTER 25 I = J ISCAN = J + 1 K = -1 RETURN C TERMINATE LITERAL VALUE 26 ISCAN = J + 1 CALL SGET(KARS,ISCAN,KAR) IF(KAR.EQ.42B) GO TO 30 J = J - 1 RETURN 30 CALL SMOVE(KARS,ISCAN+1,IEND,KARS,ISCAN) IEND = IEND - 1 GO TO 99 END $ FTN4,L,C SUBROUTINE INPUT,92063-16012 REV. 1826 771027 C C C************************************************************* C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * C RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * C PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * C OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C************************************************************* C C C LISTING: 92063-19012 C SOURCE: 92063-18012 C RELOC: 92063-16012 C C C************************************************************ C C COMMON ITTY,ILP,IDCB(144),JDCB(144) COMMON DBNAM,DSNAM,DINAM,SELECT,SNAM COMMON DSNUM,DINUM,INTIAL,IMA,IB,IEND,ISCAN COMMON IPFLAG COMMON IRRCNT C INTEGER DBNAM(3),DSNAM(3),DINAM(3) INTEGER SELECT(3),SNAM(3) INTEGER DSNUM,DINUM DIMENSION IMA(36),IB(349) DIMENSION IREG(2) EQUIVALENCE (REG,IREG,IA),(IREG(2),INLEN) INTEGER SCOLON INTEGER ERR1(8) INTEGER ERR2(6) C DATA ISIZE/349/ DATA SCOLON/73B/ DATA ERR1/2H I,2HNP,2HUT,2H T, 1 2HOO,2H L,2HON,2HG / DATA ERR2/2H E,2HND,2H O,2HF ,2HFI,2HLE/ C IEND = 1 IF(IPFLAG.NE.0) GO TO 30 C READ RECORD FROM TTY 10 CALL REIO(2,ITTY,2H?_,1) REG= REIO (1,ITTY,IMA,-72) C COMPLETE MESSAGE IF LAST CHAR = ";" 11 CALL SGET(IMA,INLEN,ICHAR) C MOVE STRING (AND BUFFER) IF (IEND+INLEN.LE.ISIZE) GO TO 15 CALL REIO(2,ITTY,ERR1,8) 12 SNAM(2) = 2H IPFLAG = 0 CALL EXEC(8,SNAM) C C FMGR ERROR C 13 CALL FMERR(ISTAT,ITTY) GOTO 12 C C ERROR - SPEC-FILE NOT DECLARED 15 CONTINUE CALL SMOVE(IMA,1,INLEN,IB,IEND) IEND = IEND + INLEN IF (ICHAR.EQ.SCOLON) GO TO 20 IF (IPFLAG.NE.0) GOTO 30 GOTO 10 C C READ RECORD FROM SPEC-FILE 30 IF (IPFLAG.EQ.3) IOFLAG = 1 CALL READF(IDCB,IEz  RR,IMA, 36 ,INLEN) IF (INLEN.NE.-1) GOTO 31 CALL REIO(2,ITTY,ERR2,6) GOTO 12 31 IF (IERR.LT.0) GOTO 13 IF(IOFLAG.EQ.0) GOTO 60 CALL REIO(2,ITTY,IMA,INLEN) 60 INLEN=INLEN*2 CALL SGET(IMA,INLEN,ICHAR) IF (ICHAR.EQ.40B) INLEN=INLEN-1 GOTO 11 20 ISCAN=1 IEND = IEND - 1 RETURN C END $ FTN4,L,C SUBROUTINE REPOP(I),92063-16012 REV. 1826 771027 C C C************************************************************* C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * C RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * C PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * C OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C************************************************************* C C C LISTING: 92063-19012 C SOURCE: 92063-18012 C RELOC: 92063-16012 C C C************************************************************ C C COMMON ITTY,ILP,IDCB(144),JDCB(144) COMMON DBNAM,DSNAM,DINAM,SELECT,SNAM COMMON DSNUM,DINUM,INTIAL,IMA,IB,IEND,ISCAN COMMON IPFLAG COMMON IRRCNT,S,R3,TRKNM,IDILU,R5 C INTEGER DBNAM(3),DSNAM(3),DINAM(3) INTEGER SELECT(3),SNAM(3) INTEGER DSNUM,DINUM DIMENSION IMA(36),IB(349) INTEGER R5,S(6,100),R8,R3,R9,TRKNM INTEGER SPACE(3),SKIP(2),ADD(2),COUNT(3),AVER(4) INTEGER A1,A2,A3,A4,A5,B1,B2,B3,B4,B5 INTEGER EZ,E0,E1,E2,E3,E4,E5,E6,E7,E8,E9 INTEGER A,B C DATA SPACE/2HSP,2HAC,2HE / DATA SKIP/2HSK,2HIP/ DATA ADD/2HAD,2HD / DATA COUNT/2HCO,2HUN,2HT / DATA AVER/2HAV,2HER,2HAG,2HE / DATA A1/2HA1/ DATA A2/2HA2/ DATA A3/2HA3/ DATA A4/2HA4/ DATA A5/2HA5/ DATA B1/2HB1/ DATA B2/2HB2/ DATA B3/2HB3/ DATA B4/2HB4/ DATA B5/2HB5/ DATA EZ/2HEZ/ DATA E0/2HE0/ DATA E1/2HE1/ DATA E2/2HE2/ DATA E3/2HE3/ DATA E4/2HE4/ DATA E5/2HE5/ DATA E6/2HE6/ DATA E7/2HE7/ DATA E8/2HE8/ DATA E9/2HE9/ DATA A/101B/ DATA B/102B/ C C FORM REPORT OPTIONS C C R5 = 0 NORMAL RETURN C R5 =-1 ERROR RETURN C I2 = 0 I3 = 0 I4 = 0 I5 = 0 I6 = 0 I7 = 0 I8 = 0 I9 = 0 R8 = 0 C C GET OPTION 10 CALL LSCAN(IB,I,J,K) C IF SEMI-COLON - WRAPUP IF (K.EQ.5) GO TO 55 20 IF(J-I.NE.4) GOTO 90 IF (JSCOM(SPACE,1,5,IB,I,IERR).NE.0) GO TO 90 C C SPACE OPTION C C GET SPACE CONTROL CALL LSCAN (IB,I,J,K) C C ONE OR TWO CHARACTERS IF (I.NE.J) GO TO 80 C C ONE CHARACTER C IS IT A "B" C CALL SGET(IB,I,ICHAR) IF (ICHAR.NE.B) GO TO 60 IF (I2.NE.0) GO TO 70 I2 = 1 50 R8 = 1 C GET TERMINATOR CHAR (, OR ;) CALL LSCAN(IB,I,J,K) C COMMA IF (K.EQ.4) GO TO 10 C SEMI-COLON IF (K.NE.5) GO TO 70 55 I2 = I2+I3+I4+I5+I6 S(5,R3) = I2 I7 = I7+I8+I9 S(6,R3) = I7 R5 = 0 RETURN C C IS IT AN "A" C 60 IF (ICHAR.NE.A) GO TO 70 IF (I3.NE.0) GO TO 70 I3 = 10 GO TO 50 C C ERROR RETURN 70 R5 = -1 RETURN C C TWO CHARACTERS - THEN "AX" OR "BX" 80 R9 = 10 IF(J-I.NE.1) GOTO 70 IF (JSCOM(A1,1,2,IB,I,IERR).EQ.0) GO TO 82 R9 = R9 + 10 IF (JSCOM(A2,1,2,IB,I,IERR).EQ.0) GO TO 82 R9 = R9 + 10 IF (JSCOM(A3,1,2,IB,I,IERR).EQ.0) GO TO 82 R9 = R9 + 10 IF (JSCOM(A4,1,2,IB,I,IERR).EQ.0) GO TO 82 R9 = R9 + 10 IF (JSCOM(A5,1,2,IB,I,IERR).EQ.0) GO TO 82 R9 = 1 IF (JSCOM(B1,1,2,IB,I,IERR).EQ.0) GO TO 84 R9 = R9 +1 IF (JSCOM(B2,1,2,IB,I,IERR).EQ.0) GO TO 84 R9 = R9 + 1 IF (JSCOM(B3,1,2,IB,I,IERR).EQ.0) GO TO 84 R9 = R9 + 1 IF (JSCOM(B4,1,2,IB,I,IERR).EQ.0) GO TO 84 R9 = R9 + 1 IF (JSCOM(B5,1,2,IB,I,IERR).EQ.0) GO TO 84 81 IF (R8.EQ.1) GO TO 20 GO TO 70 82 IF (I3.NE.0) GO TO 70 I3 = R9 GO TO 50 84 IF (I2.NE.0) GO TO 70 I2 = R9 GO TO 50 C C SKIP OPTION C 90 IF(J-I.NE.3) GOTO 100 IF (JSCOM(SKIP,1,4,IB,I,IERR).NE.0) GO TO 100 C C ɴERROR IF HEADER STATEMENT IF (S(1,R3).GT.20 .AND. S(1,R3).LT.30) GO TO 70 R8 = 0 C C GET SKIP CONTROL ("A" OR "B") CALL LSCAN(IB,I,J,K) IF(I.NE.J) GOTO 70 CALL SGET (IB,I,ICHAR) C IS IT "B" IF (ICHAR.NE.B) GO TO 92 IF (I4.NE.0) GO TO 70 I4 = 100 GO TO 50 C C MUST BE "A" OR ELSE ERROR 92 IF (ICHAR.NE.A) GO TO 81 IF (I5.NE.0) GO TO 70 I5 = 1000 GO TO 50 C C ADD OPTION C 100 IF(J-I.NE.2) GOTO 110 IF (JSCOM(ADD,1,3,IB,I,IERR).NE.0) GO TO 110 IF (I6.NE.0) GO TO 70 IF (S(1,R3).LT.30 .OR. S(1,R3).GT.40) GO TO 70 C MUST BE TOTAL OR ELSE ERROR I6 = 10000 GO TO 50 C C COUNT OPTION C 110 IF(J-I.NE.4) GOTO 120 IF (JSCOM(COUNT,1,5,IB,I,IERR).NE.0) GO TO 120 IF (I8.NE.0) GO TO 70 IF (S(1,R3).LT.30 .OR. S(1,R3).GT.40) GO TO 70 I8 = 100 GO TO 50 C C AVERAGE OPTION C 120 IF(J-I.NE.6) GOTO 130 IF (JSCOM(AVER,1,7,IB,I,IERR).NE.0) GO TO 130 IF(I9.NE.0) GO TO 70 IF (S(1,R3).LT.30 .OR. S(1,R3).GT.40) GO TO 70 I9 = 1000 GO TO 50 C C EDIT OPTION C 130 IF (S(1,R3).LT.30 .OR. S(1,R3).GT.50) GO TO 70 IF (J-I.GT.1) GO TO 70 R9 = 1 CALL SMOVE (IB,I,J,ID,1) IF (ID.EQ.EZ) GO TO 132 R9 = 60 IF (ID.EQ.E0) GO TO 132 R9 = R9 + 1 IF (ID.EQ.E1) GO TO 132 R9 = R9 + 1 IF (ID.EQ.E2) GO TO 132 R9 = R9 + 1 IF (ID.EQ.E3) GO TO 132 R9 = R9 + 1 IF (ID.EQ.E4) GO TO 132 R9 = R9 + 1 IF (ID.EQ.E5) GO TO 132 R9 = R9 + 1 IF (ID.EQ.E6) GO TO 132 R9 = R9 + 1 IF (ID.EQ.E7) GO TO 132 R9 = R9 + 1 IF (ID.EQ.E8) GO TO 132 R9 = R9 + 1 IF (ID.EQ.E9) GO TO 132 GO TO 70 132 IF (I7.NE.0) GO TO 70 I7 = R9 GO TO 50 END $ FTN4,L,C SUBROUTINE VALUE(IARG,ISEC,IOFF),92063-16012 REV. 1826 771027 C C C************************************************************* C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * C RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * C PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * C OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C************************************************************* C C C LISTING: 92063-19012 C SOURCE: 92063-18012 C RELOC: 92063-16012 C C C************************************************************ C C*********************************************************************** C VALUE RETURNS A DATA ITEM VALUE IN THE IARG ARRAY. C IF THE VALUE IS IN THE PART OF QSKIB THAT IS CURRENTLY C IN CORE (IN IMA AND IB BUFFERS) THEN THE VALUE IS TRANSFERRED C DIRECTLY FROM IMA STARTING AT POSITION IOFF. IF THE VALUE C IS NOT IN THE PART OF QSKIB CURRENTLY IN CORE, THEN THE C PART OF QSKIB CONTAINING THE VALUE IS READ INTO IMA, AND C THE TRANSFER EFFECTED. C C CALLING PARAMETERS: C IARG - THE ARRAY IN WHICH THE DATA ITEM VALUE WILL BE RETURNED C ISEC - THE STARTING SECTOR NUMBER OF THE QSKIB BLOCK WHICH C CONTAINS THE VALUE. ISEC RETURNS THE SECTOR OF THE NEXT VALUE. C IOFF - THE WORD OFFSET OF THE VALUE,FROM THE BEGINNING OF ISEC C IOFF RETURNS THE OFFSET OF THE NEXT VALUE C C DEFINITION OF SYMBOLS C QSKIB - THE TRACK CONTAINING DATA ITEM VALUES. EACH VALUE IS C PRECEEDED BY ITS WORD LENGTH.(IF THE LENGTH IS NEGATIVE, THE C VALUE IS A DUPLICATE KEY ITEM VALUE) C ISIZE - THE SIZE OF THE IN-CORE BUFFER CONTAINING (PART OF) QSKIB C IQSEC - THE NUMBER OF SECTORS OF THIS IN-CORE BUFFER C IMA - THE BUFFER CONTAINING PART OF QSKIB. IF QSKIB IS NO LONGER C TRKNM- THE TRACK NUMBER OF QSKIB. C THAN ISIZE, ALL VALUES ALWAYS REMAIN CORE IN IMA AND THE C VALUES ARE NEVER REA@  LLY IN QSKIB. (NOTE:THE BUFFER CONSISTS OF C THE IMA AND IB ARRAYS WHICH MUST ALWAYS BE ADJACENT) C NOTE: THE STARTING SECTOR NUMBER OF THE CURRENT BLOCK OF C QSKIB PRESENTLY IN CORE IS CONTAINED IN IMA(ISIZE+1) C*********************************************************************** C COMMON ITTY,ILP,IDCB(144),JDCB(144) COMMON DBNAM,DSNAM,DINAM,SELECT,SNAM COMMON DSNUM,DINUM,INTIAL,IMA,IB,IEND,ISCAN COMMON IPFLAG COMMON IRRCNT COMMON S,R3,TRKNM,IDILU C INTEGER DBNAM(3),DSNAM(3),DINAM(3) INTEGER SELECT(3),SNAM(3) INTEGER DSNUM,DINUM DIMENSION IMA(36),IB(349) INTEGER S(12,50),R3,TRKNM DIMENSION IARG(64) INTEGER RC1 C DATA RC1/1/ DATA ISIZE/384/ DATA IQSEC/6/ C C IF BLOCK CONTAINING VALUE NOT IN CORE, READ IT INTO IMA IF (ISEC.EQ.IMA(ISIZE+1)) GO TO 20 CALL EXEC(RC1,IDILU,IMA,ISIZE,TRKNM,ISEC) IMA(ISIZE+1)=ISEC C LEN IN WORDS 20 LEN=IABS(IMA(IOFF)) C MOVE VALUE INTO IARG LENALL=LEN+1 DO 30 MOVE=1,LENALL IARG(MOVE)=IMA(IOFF) IOFF = IOFF + 1 C IF END OF BUFFER, READ NEXT BLOCK FROM QSKIB IF (IOFF.LE.ISIZE) GO TO 30 ISEC=ISEC+IQSEC CALL EXEC (RC1,IDILU,IMA,ISIZE,TRKNM,ISEC) IOFF = 1 30 CONTINUE END $ ASMB,R,L,C HED REPORT GENERATION SUBROUTINES NAM RPG,7 92063-16012 REV. 1826 771027 * * ************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * * PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ************************************************************** * * * LISTING: 92063-19012 * SOURCE: 92063-18012 * RELOC: 92063-16012 * * ************************************************************* * SPC 1 ENT BUFLN ENT FIELD ENT LIT ENT SPLIT ENT CSBP ENT CSAP ENT PHDRI ENT EDIT SPC 1 EXT REIO EXT CITA EXT CRTA EXT EXEC EXT DBINF EXT SGET EXT SPUT EXT SMOVE EXT SFILL EXT SZONE EXT SEDIT EXT ..MAP SPC 3 * COMMON DECLARATION SPC 2 COM ITTY,ILP,IDCB(144),JDCB(144) COM DBNAM(3),DSNAM(3),DINAM(3) COM SELEC(3),SNAM(3) COM DSNUM,DINUM,INTIL COM IMA(36),IB(349) COM IEND,ISCAN,IPFLG,RRCNT COM S(600),R3,TRKNM,IDILU,R5,R6 COM V(8) COM LAS,AS(36) COM LCS,CS(66) COM LDS,DS(36) COM P1,P2,J1 COM ISORT(256) COM T(5),U(35) COM LES,ES(36) COM LFS,FS(36) COM LGS,GS(36) COM LHS,HS(36) COM LIS,IS(36) COM L(6) COM ATOT(300) COM ISELD(128) COM IRSE,IPTR,RCNT COM N HED BUFLN - BUFFER PART OF LINE * BUFLN WILL CALL 'FIELD' FOR A DATA-ITEM VALUE OR * 'LIT' FOR A LITERAL FROM THE QSKIB FILE. * * INPUT: * J1 - INDEX INTO THE S ARRAY * OUTPUT: * VALUE OR LITERAL IN CS (RIGHT JUSTIFIED * AT END PRINT POSITION) SPC 2 BUFLN NOP ISZ BUFLN INCREMRNT DFOR RETURN * JBEG = 1 LDA D1 INITIALIZE JBEG = 1 STA JBEG * CALL SPLIT JSB SPLIT SPLIT REPORT OPTIONS DEF *+1 * IF(S(2,J1).EQ.0) GOTO 1620 LDA D2 COMPUTE ADDRESS JSB ..SS OF S(2,J1) * DATA-ITEM NUMBER LDA AREG,I CPA D0 = 0 JMP BUFL3 YES * DINUM = S(2,J1) STA DINUM PUT INTO DINUM * CALL FIELD JSB FIELD GET D-I VALUE DEF *+1 * IF(V(6).EQ.0) GOTO 1600 LDA D5 ADA VBASE LDA AREG,I VALUE OF V(6) CPA D0 = ZERO JMP BUFL1 YES * CALL EDIT JSB EDIT NO - EDIT D-I VALUE DEF *+1 SPC 1 BUFL1 EQU * *1600 LEN = S(4,J1)-LDS+1 LDA D4 COMPUTE ADDRESS JSB ..SS OF S(4,J1) * END PRINT POSITION LDA LDS CMA,INA COMPUTE LEN - ADA ATEMP,I CS STARTING ADA D1 POSITION STA LEN * IF(LEN.GT.0) GOTO 1610 LDA LEN CMA,INA IF LEN <= 0 ADA D0 MUST SET SSA JMP BUFL2 * LEN = 1 LDA D1 LEN = 1 STA LEN * JBEG = LDS - S(4,J1) + 1 LDA ATEMP,I JBEG = TRUNCATE LH END CMA,INA OF DS ADA LDS ADA D1 STA JBEG SPC 1 BUFL2 EQU * *1610 CALL SMOVE(DS,JBEG,LDS,CS,LEN) JSB SMOVE MOVE DS TO CS DEF *+6 DEF DS DEF JBEG DEF LDS DEF CS DEF LEN * RETURN JMP BUFLN,I RETURN SPC 1 BUFL3 EQU * *1620 CALL LIT JSB LIT GET LITERAL VALUE DEF *+1 * LEN = S(4,J1)-LAS+1 LDA D4 COMPUTE ADDRESS JSB ..SS OF S(4,J1) * END PRINT POSITION LDA LAS CMA,INA COMPUTE LEN - ADA ATEMP,I CS STARTING ADA D1 POSITION STA LEN * IF(LEN.GT.0) GOTO 1630 LDA LEN CMA,INA IF LITERAL MAKES LEN <=0 ADA D0 MUST SET SSA JMP BUFL4 * LEN = 1 LDA D1 LEN = 1, AND STA LEN * JBEG = LAS-S(4,J1)+1 LDA ATEMP,I JBEG TO TRUNCATED CMA,INA LITERAL ADA LAS ADA D1 STA JBEG SPC 1 BUFL4 EQU * *1630 CALL SMOVE(AS,JBEG,LAS,CS,LEN) JSB SMOVE MOVE AS TO CS DEF *+6 DEF AS DEF JBEG DEF LAS DEF CS DEF LEN * RETURN JMP BUFLN,I RETURN HED FIELD - GET DATA-ITEM VALUE * FIELD GETS A DATA-ITEM VALUE FROM THE RECORD * IN 'ISORT' AND RETURNS THE DATA-ITEM FIELD * IN DS IN ASCII (R2) FORMAT. SPC 2 FIELD NOP ISZ FIELD INCREMENT RETURN ADDRESS * CALL DBINF(2HI ,2,DINUM,INFO) JSB DBINF GET ITEM CHARACTERISTICS DEF *+5 DEF .2HI DEF D2 DEF DINUM DEF INFO * IOFF = INFO(8) LDA D7 ITEM OFFSET ADA AINFO LDA AREG,I STA IOFF * CALL SGET(INFO,10,ITYPE) JSB SGET GET ITEM TYPE DEF *+4 (I,R,U) DEF INFO DEF D10 DEF ITYPE * IF(ITYPE.NE.111B) GO TO 10 LDA ITYPE INTEGER ITEM? CPA B111 RSS JMP FLD2 NO * CALL CITA(ISORT(IOFF),DS) LDA IOFF ADA ASORT STA ATEMP JSB CITA CONVERT INTEGER DEF *+3 TO ASCII DEF ATEMP,I DEF DS * LDS = 6 LDA D6 ASCII LENTH OF 6 STA LDS * CALL SPUT(DS,1,40B) JSB SPUT BLANK SIGN DEF *+4 DEF DS DEF D1 DEF B40 * IF(ISORT(IOFF).LT.0) CALL SZONE(DS,6,2,I) LDA D0 CMA,INA IF INTEGER CALUE ADA ATEMP,I .LT. 0 (I.E. NEGATIVE) SSA,RSS JMP FLD1 JSB SZONE PUT IN ZONE PUNCH DEF *+5 DEF DS DEF D6 DEF D2 DEF I SPC 1 FLD1 EQU * * RETURN JMP FIELD,I EXIT SPC 1 FLD2 EQU * * 10 IF (ITYPE.NE.122B) GOTO 20 CPA B122 REAL ITEM? RSS JMP FLD3 NO * CALL CRTA(DS,1,8,ISORT(IOFF),0.5,0) LDA IOFF ADA ASORT STA ATEMP JSB CRTA CONVERT REAL DEF *+7 TO ASCII DEF DS DEF D1 DEF D8 DEF ATEMP,I DEF D.5 DEF D0 * LDS = 8 LDA D8 ASCII LENGTH OF 8 STA LDS * RETURN JMP FIELD,I SPC 1 FLD3 EQU * * 20 LEN = INFO(7) LDA D6 MUST BE ASCII ITEM. ADA AINFO LDA AREG,I GET ITEM LENGTH STA LEN * IF(LEN.GT.36) LEN=36 LDA LEN MAXIMUN STRING IS 72 CMA,INA CHARS (36 WORDS) ADA D36 SSA,RSS TRUNCATE IF JMP FLD4 NECESSARY LDA D36 STA LEN SPC 1 FLD4 EQU * * IF(ISORT(IOFF).NE.0) GOTO 30 LDA IOFF IF ASCII STRING ADA ASORT IS NULL LDA AREG,I CPA D0 RSS JMP FLD5 * CALL SFILL(DS,1,LEN+LEN,52B) LDA LEN ADA LEN STA TEMP FILL STRING WITH JSB SFILL "*" CHARACTERS DEF *+5 DEF DS DEF D1 DEF TEMP DEF B52 JMP FLD7 SPC 1 FLD5 EQU * * 30 DO 40 I=1,LEN LDA LEN MOVE ASCII STRING CMA,INA STA LOOP LDA ADS FROM ISORT(IOFF) STA ATEMP TO DS LDA IOFF ADA ASORT STA TEMP SPC 1 FLD6 EQU * * DS(I) = ISORT(IOFF) LDA TEMP,I STA ATEMP,I * 40 IOFF = IOFF + 1 ISZ TEMP ISZ ATEMP ISZ LOOP JMP FLD6 SPC 1 FLD7 EQU * * 50 LDS = LEN+LEN LDA LEN CHANGE WORD LENGTH ADA LEN TO CHARACTERS STA LDS * RETURN JMP FIELD,I EXIT HED LIT - RETRIEVES LITERAL CONSTANT * LIT RETURNS A LITERAL CONSTANT * IN AS SPC 2 LIT NOP ISZ LIT INCREMENT RETURN ADDRESS * I = S(3,J1) LDA D3 COMPUTE ADDRESS JSB ..SS OF S(3,J1) * LITERAL OFFET LDA AREG,I STA I * LAS = IB(I) ADA AIB LITERAL LENGTH LDA AREG,I IN CHARACTERS STA LAS * IJK = 1 LDA AAS STA ATEMP * DO 3600 K=I+1,I+((LAS+1)/2) LDA I ADA D1 ADA AIB STA TEMP LDA LAS ADA D1 ARS CMA,INA STA LOOP SPC 1 LIT1 EQU * * AS(IJK) = IB(K) LDA TEMP,I MOVE LITERAL FROM STA ATEMP,I IB(I+1) TO AS * IJK = IJK + 1 ISZ ATEMP *3600 CONTINUE ISZ TEMP ISZ LOOP JMP LIT1 * RETURN JMP LIT,I EXIT HED SPLIT - SPLIT REPORT OPTIONS * SPLIT BREAKS DOWN REPORT OPTION * 1 AND 2 INTO 'V' ARRAY. * * ADD,EDIT,COUNT, AND AVERAGE * ARE ALWAYS CLEARED. SPC 2 SPLIT NOP ISZ SPLIT INCREMENT RETURN ADDRESS * V(5) = 0 LDA D4 ADA VBASE STA ATEMP CLA ZERO ADD OPTION STA ATEMP,I V(5) * V(6) = 0 ISZ ATEMP ZERO EDIT OPTION STA ATEMP,I V(6) * V(7) = 0 ISZ ATEMP ZERO COUNT OPTION STA ATEMP,I V(7) * V(8) = 0 ISZ ATEMP ZERO AVERAGE OPTION STA ATEMP,I V(8) * I = S(5,J1) LDA D5 COMPUTE ADDRESS JSB ..SS R OF S(5,J1) * REPORT OPTION 1 LDA AREG,I STA I * IF(I.EQ.0) GOTO 3470 CPA D0 OPTION 1 ZERO JMP SLIT3 CHECK OPTION 2 * DO 3460 I1=1,4 LDA D1 BREAK DOWN SPACE STA I1 AND SKIP OPTIONS STA IFAC LDA DM4 STA LOOP SPC 1 SLIT1 EQU * * IFAC = 10**I1 LDA IFAC MPY D10 STA IFAC * IF(I-IFAC*(I/IFAC).EQ.0) GOTO 3460 LDA I CLB DIV IFAC MPY IFAC CMA,INA ADA I STA EXP THIS OPTION ZERO? CPA D0 JMP SLIT2 YES - DO NEXT ONE * V(I1) = I-IFAC*(I/IFAC) LDA I1 ADA DM1 ADA VBASE PUT OPTION INT0 STA ATEMP V(I1) LDA EXP STA ATEMP,I * I = I-V(I1) CMA,INA DECREMENT REPORT ADA I OPTION 1 BY STA I CURRENT OPTION SPC 1 SLIT2 EQU * *3460 CONTINUE ISZ I1 ISZ LOOP JMP SLIT1 * IF(I.EQ.0) GOTO 3470 LDA I I = 0 CPA D0 JMP SLIT3 NO ADD OPTION * V(5) = 10000 LDA D4 SET ADD OPTION ADA VBASE V(5) STA ATEMP LDA D1 STA ATEMP,I SPC 1 SLIT3 EQU * *3470 I = S(6,J1) LDA D6 COMPUTE ADDRESS JSB ..SS OF S(6,J1) * REPORT OPTION 2 LDA AREG,I STA I * IF(I.EQ.0) RETURN CPA D0 IF OPTION 2 ZERO JMP SPLIT,I EXIT * DO 3520 I1=2,4 LDA D2 BREAK DOWN EDIT AND STA I1 COUNT OPTIONS LDA D10 STA IFAC LDA DM3 STA LOOP SPC 1 SLIT4 EQU * * IFAC = 10**I1 LDA IFAC MPY D10 STA IFAC * IF(I-IFAC*(I/IFAC).EQ.0) GOTO 3520 LDA I CLB u DIV IFAC MPY IFAC CMA,INA ADA I STA EXP CPA D0 THIS OPTION ZERO? JMP SLIT5 YES - DO NEXT * V(I1+4) = I-IFAC*(I/IFAC) LDA I1 ADA D3 PUT OPTION INTO ADA VBASE V(I1+4) STA ATEMP LDA EXP STA ATEMP,I * I = I - V(I1+4) CMA,INA DECREMENT REPORT ADA I OPTION 2 BY STA I CURRENT OPTION SPC 1 SLIT5 EQU * *3520 CONTINUE ISZ I1 ISZ LOOP JMP SLIT4 * RETURN JMP SPLIT,I EXIT HED CSBP - LINE CONTROL BEFORE PRINTING * CSBP CHECKS FOR LINE SPACING AND * SKIPPING BEFORE PRINTING SPC 2 CSBP NOP ISZ CSBP INCREMENT RETURN ADDRESS * IF (V(3).EQ.0) GOTO 3760 LDA D2 ADA VBASE STA ATEMP LDA AREG,I CPA D0 SKIP? JMP CSBP4 * V(3) = 0 CLA YES - CLEAR OPTION STA ATEMP,I SPC 1 CSBP1 EQU * *3710 DO 3720 I=P2+1,60 *3720 CALL REIO(2,6,2H ,-1) JSB SKIP SPACE TO TOP OF PAGE * DO 3730 I=1,66 LDA DM66 STA LOOP LDA ASAVE ADDRESS OF 'SAVE' STA ATEMP LDA ACS ADDRESS OF 'CS' STA TEMP SPC 1 CSBP2 EQU * *3730 SAVE(I) = AS(I) LDA TEMP,I STA ATEMP,I ISZ TEMP ISZ ATEMP ISZ LOOP JMP CSBP2 * CALL PHDRI JSB PHDRI PRINT HEADERS DEF *+1 * DO 3740 I=1,66 LDA DM66 STA LOOP LDA ACS RESTORE 'CS' STA ATEMP (CS USED BY PHDRI) LDA ASAVE STA TEMP SPC 1 CSBP3 EQU * *3740 AS(I) = SAVE(I) LDA TEMP,I STA ATEMP,I ISZ ATEMP ISZ TEMP ISZ LOOP JMP CSBP3 SPC 1 CSBP4 EQU * *3760 IF(V.LE.0) RETURN * CALL REIO(2,6,2H ,-1) * V(1) = V(1) - 1 * IF(P2.EQ.54) G2p0.*OTO 3710 * GOTO 3760 JSB SPBP SPACE BEFORE CONTROL JMP CSBP,I NORMAL RETURN JMP CSBP1 TOP OF PAGE RETURN HED CSAP - LINE CONTROL AFTER PRINTING * CSAP CHECKS FOR LINE SPACING AND * SKIPPING AFTER PRINTING SPC 2 CSAP NOP ISZ CSAP INCREMENT RETURN ADDRESS * DO 3840 I=1,36 *3840 CS(I) = 2H JSB BLKCS BLANK PRINT LINE 'CS' * IF(P2.EQ.54) GOTO 3870 LDA P2 END OF PAGE? CPA LNPPG JMP CSAP2 YES SPC 1 CSAP1 EQU * *3850 IF (V(4).EQ.0) GOTO 3920 LDA D3 ADA VBASE STA ATEMP SKIP AFTER LDA AREG,I REPORT OPTION CPA D0 JMP CSAP3 * V(4) = 0 CLA CLEAR OPTION STA ATEMP,I SPC 1 CSAP2 EQU * *3870 DO 3890 I=P2+1,60 *3890 CALL REIO(2,6,2H ,-1) JSB SKIP SPACE TO TOP OF PAGE * CALL PHDRI JSB PHDRI PRINT HEADERS DEF *+1 * GOTO 3850 JMP CSAP1 SPC 1 CSAP3 EQU * *3920 IF(V(2).LE.0) RETURN * CALL REIO(2,6,2H ,-1) * V(2) = V(2) - 10 * IF(P2.EQ.54) GOTO 3870 * GOTO 3920 JSB SPAP SPACE AFTER CONTROL JMP CSAP,I NORMAL RETURN JMP CSAP2 TOP OF PAGE RETURN SKP V;0 HED PHDRI - PRINT HEADERS * PHDRI PRINTS HEADER INFORMATION SPC 2 PHDRI NOP ISZ PHDRI INCREMENT RETURN ADDRESS * DO 4020 I=1,8 LDA DM8 STA LOOP LDA ASAVV STA ATEMP LDA VBASE STA TEMP SPC 1 PHD1 EQU * *4020 SAVEV(I) = V(I) LDA TEMP,I SAVE REPORT OPTIONS STA ATEMP,I (V) IN SAVV ISZ TEMP ISZ ATEMP ISZ LOOP JMP PHD1 * DO 4030 I=1,8 * 4030 V(I) = 0 * ZERO CURRENT OPTION IN "V" LDA DM8 STA LOOP LDA VBASE STA TEMP CLB PHD1A EQU * STB TEMP,I ISZ TEMP ISZ LOOP JMP PHD1A * XI = J1 LDA J1 SAVE J1 INDEX STA IJK * DO 4060 I=1,36 JSB BLKCS BLANK PRINT LINE 'CS' *4060 CS(I) = 2H * P2 = 0 CLA RESET LINE COUNT STA P2 STA DSNAM * P1 = P1 +1 ISZ P1 INCREMENT PAGE NUMBER *4070 J4 = 0 CLA CLEAR HEADER BREAK STA J4 SWITCH * DO 4230 J1=1,R3 LDA D1 STA J1 SPC 1 PHD2 EQU * * IF(S(1,J1).LT.20 .OR. S(1,J1).GT.30) GOTO 4230 LDA D1 COMPUTE ADDRESS JSB ..SS OF S(1,J1) * STATEMENT TYPE LDA D20 CMA,INA ADA ATEMP,I STA TEMP LDA ATEMP,I CMA,INA ADA D30 IOR TEMP PROCESS ONLY HEADER SSA STATEMENTS JMP PHD9 NO * IF(J4.EQ.S(1,J1)) GOTO 4170 LDA ATEMP,I SAME HEADER LEVEL CPA J4 JMP PHD4 YES * IF(J4.EQ.0) GOTO 4160 LDA J4 FIRST TIME CPA D0 JMP PHD3 YES JSB PHBP CHECK HEADER SPACE BEFORE * DO 4100 I=LCS,1,-1 * CALL SGET(CS,I,ICHAR) * IF(ICHAR.NE.40B) GOTO 4110 *4100 CONTINUE * GOTO 4120 *4110 CALL RVEIO(2,6,CS,-I) *4120 CONTINUE JSB SCAN SCAN OFF BLANKS FROM PRINT LINE JSB PHAP CHECK SPACE AFTER *4160 J4 = S(1,J1) LDA D1 COMPUTE ADDRESS JSB ..SS OF S(1,J1) * STATEMENT TYPE SPC 1 PHD3 EQU * LDA ATEMP,I SAVE HEADER LEVEL STA J4 IN J4 SPC 1 PHD4 EQU * *4170 IF(S(2,J1).EQ.0) GOTO 4220 LDA D2 COMPUTE ADDRESS JSB ..SS OF S(2,J1) * DATA-ITEM NUMBER LDA AREG,I NO "PAGENO" CPA D0 JMP PHD8 * CALL CITA(P1,INFO) JSB CITA CONVERT PAGE NUMBER P1 DEF *+3 DEF P1 DEF INFO * DO 4180 I=2,5 LDA D2 STA I SPC 1 PHD5 EQU * * CALL SGET(INFO,I,ICHAR) JSB SGET SCAN AND SUPPRESS DEF *+4 LEADING ZEROS DEF INFO DEF I DEF ICHAR * IF(ICHAR.NE.60B) GOTO 4190 LDA ICHAR CPA B60 RSS JMP PHD6 *4180 CONTINUE ISZ I LDA I CMA,INA ADA D5 SSA,RSS JMP PHD5 SPC 1 PHD6 EQU * *4190 LJS = 7 - I LDA I SET LENGTH OF CMA,INA 'PAGENO' ADA D7 STA LJS * JBEG = I LDA I JBEG = FIRST NON-ZERO STA JBEG * LEN = S(4,J1)-LJS+1 LDA D4 COMPUTE ADDRESS JSB ..SS OF S(4,J1) * END PRINT POSITION LDA LJS FIRST POSITION WITHIN CMA,INA 'CS' FOR PAGE NO. ADA ATEMP,I ADA D1 STA LEN * IF(LEN.GT.0) GOTO 4200 LDA LEN CMA,INA IF .GT. 0 ADA D0 EVERYTHING OK SSA ELSE * PAGE NO. LENGTH JMP PHD7 .GT. END:s PRINT POS * LEN = 1 LDA D1 SET FIRST CHAR STA LEN POSITION TO 1 * JBEG = LJS-S(4,J1)+1 LDA ATEMP,I CMA,INA TRUNCATE PAGE NO. ADA LJS ON LH END ADA D1 STA JBEG SPC 1 PHD7 EQU * *4200 CALL SMOVE(INFO,JBEG,6,CS,LEN) JSB SMOVE MOVE PAGE NO. DEF *+6 TO "CS" DEF INFO AT POSITION DEF JBEG 'LEN' DEF D6 DEF CS DEF LEN * CALL SPLIT JSB SPLIT SPLIT REPORT OPTIONS DEF *+1 * GOTO 4230 JMP PHD9 SPC 1 PHD8 EQU * *4220 CALL BUFLN JSB BUFLN BUFFER LINE DEF *+1 SPC 1 PHD9 EQU * *4230 CONTINUE ISZ J1 DO ALL HEADER STATEMENTS LDA J1 CMA,INA ADA R3 DONE? SSA,RSS JMP PHD2 NO - LOOP AGAIN JSB PHBP CHECK BEFORE PRINT CONTROL * DO 4244 I=LCS,1,-1 * CALL SGET(CS,I,ICHAR) * IF(ICHAR.NE.40B) GOTO 4250 *4244 CONTINUE * GOTO 4290 *4250 CONTINUE * CALL REIO(2,6,CS,-I) JSB SCAN SCAN OFF BLANKS FROM PRINT LINE *4290 J1 = IX JSB PHAP CHECK AFTER PRINT CONTROL LDA IJK RESTORE J1 INDEX STA J1 * DO 4300 I=1,8 LDA DM8 STA LOOP LDA VBASE STA ATEMP LDA ASAVV STA TEMP SPC 1 PHD10 EQU * *4300 V(I) = SAVEV(I) LDA TEMP,I RESTORE REPORT OPTIONS STA ATEMP,I ISZ TEMP ISZ ATEMP ISZ LOOP JMP PHD10 * RETURN JMP PHDRI,I EXIT SPC 1 PHD11 EQU * *5000 CALL REIO(2,1,ERROR,21) JSB REIO PRINT 'ERROR' DEF *+5 TO USER DEF D2 DEF ITTY TTY DEF ERROR DEF LERR * SNAM(2) = 2H15 LDA D1 SET SEGMENT TO ADA BSNAM MODULE 15 gLDB .2H15 STB AREG,I * CALL EXEC(8,SNAM) JSB EXEC LOAD EXIT DEF *+3 (DBCLS) MODULE DEF D8 DEF SNAM SPC 2 * PHPB - SUBROUTINE TO CHECK FOR SPACING * BEFORE PRINTING FOR HEADERS * IF HEADERS OVERFLOW PAGE FOUND * THEN TERMINATE QUERY SPC 1 PHBP NOP * IF(V.LE.0) RETURN * CALL REIO(2,6,2H ,-1) * V = V-1 * IF(P2.GE.54) GOTO 5000 JSB SPBP SPACE BEFORE CONTROL JMP PHBP,I NORMAL RETURN JMP PHD11 TOP OF PAGE - ERROR SPC 2 * PHAP - SUBROUTINE TO CHECK FOR SPACING * AFTER PRINTING FOR HEADERS * IF HEADERS OVERFLOW PAGE BOUNT * THEN TERMINATE QUERY SPC 1 PHAP NOP * DO 4130 I=1,36 JSB BLKCS BLANK PRINT LINE 'CS' *4130 CS(I) = 2H * P2 = P2 + 1 ISZ P2 INCREMENT PAGE COUNT *4140 IF(V(2).LE.0) RETURN * CALL REIO(2,6,2H ,-1) * V(2) = V(2) - 10 * IF(P2.GE.54) GOTO 5000 * GOTO 4140 JSB SPAP SPACE AFTER CONTROL JMP PHAP,I NORMAL RETURN JMP PHD11 TOP OF PAGE - ERROR SPC 2 SUP LERR DEF ENDER-ERROR ERROR ASC 13, HEADERS OVERFLOW A PAGE, ASC 8,QUERY TERMINATED ENDER EQU * UNS HED EDIT - EDIT DATA-ITEM VALUE * EDIT WILL PERFORM SEDIT ON AN ASCII FIELD * IN 'DS' WITH EDIT MASK IN 'AS' AND * RETURN EDITTED FIELD IN 'DS'. SPC 1 * THE PRUPOSE OF THIS ROUTINE IS TO EDIT * A DATA-ITEM VALUE (IN ASCII) ACCORDING * TO A PREVIOUSLY DEFINED EDIT MASK OR * BY DOING ZERO SUPPRESSION. SPC 2 EDIT NOP ISZ EDIT INCREMENT RETURN ADDRESS * IF(V(6).NE.1) GO TO 2030 LDA D5 ADA VBASE ZERO SUPPRESS LDA AREG,I EDIT OPTION CPA D1 RSS JMP EDIT1 NO * LAS = LDS LDA LDS SET LENGTH AS = LDS  STA LAS * IF(LAS.LE.1) RETURN CMA,INA IF LENGTH = 1 ADA D1 CMA CAN NOT ZERO SSA SUPPRESS JMP EDIT,I EXIT * CALL SFILL(AS,1,LAS-1,132B) LDA LAS ADA DM1 STA LEN JSB SFILL FILL MASK (AS) WITH DEF *+5 'Z' CHARACTERS DEF AS DEF D1 DEF LEN DEF B132 * CALL SPUT(AS,LAS,71B) JSB SPUT EXCEPT LAST CHAR DEF *+4 IT'S A '9' DEF AS DEF LAS DEF B71 * GOTO 2270 JMP EDIT4 GO EDIT FIELD IN 'DS' SPC 1 EDIT1 EQU * *2030 J1SAVE = J1 LDA J1 SAVE J1 INDEX STA LJS * DO 2050 J1=1,R3 LDA D1 STA J1 LDA R3 CMA,INA STA LOOP SPC 1 EDIT2 EQU * * IF(S(1,J1).EQ.V(6)) GOTO 2060 LDA D1 COMPUTE ADDRESS JSB ..SS OF S(1,J1) * STATEMENT TYPE * SCAN STATEMENT NO. * = EDIT MASK NO. LDA D5 ADA VBASE LDA AREG,I CPA ATEMP,I FOUND IT? JMP EDIT3 YES - GO GET MASK *2050 CONTINUE ISZ J1 SCAN ALL S TABLE ISZ LOOP JMP EDIT2 SPC 1 EDIT3 EQU * *2060 CALL LIT JSB LIT GET EDIT MASK IN 'AS' DEF *+1 * J1 = J1SAVE LDA LJS STA J1 SPC 1 EDIT4 EQU * *2270 CALL SEDIT(DS,1,LDS,AS,1,LAS) JSB SEDIT EDIT FIELD (DS) DEF *+7 BY MASK (AS) DEF DS DEF D1 SEDIT PUTS EDITED DEF LDS FIELD IN 'AS' DEF AS DEF D1 DEF LAS * LDS = LAS LDA LAS SET LENGTH OF DS = LAS STA LDS * CALL SMOVE(AS,1,LAS,DS,1) JSB SMOVE DEF *+6 MOVE EDITTED FIELD DEF ~AS IN AS BACK INTO DS DEF D1 DEF LAS DEF DS DEF D1 * RETURN JMP EDIT,I EXIT HED - MISCELLANEOUS SUPPORT SUBROUTINES * SPACE - SPACE OUTPUT DEVICE LU=6 * ONE LINE SPC 1 SPACE NOP JSB REIO DEF *+5 DEF D2 RCODE = 2 DEF ILP LU = 6 DEF BLANK BLANKS DEF DM1 1 CHARACTER * P2 = P2 + 1 ISZ P2 INCREMENT LINE COUNT JMP SPACE,I RETURN SPC 2 * ..SS - SUBSCRIPT CALCULATION FOR S ARRAY * FOR ELEMENT S(SS.1,J1) * * CALLING SEQUENCE: * LDA X * JSB ..SS * * INPUT: * AREG = FIRST SUBSCRIPT VALUE * SPC 1 ..SS NOP STA SS.1 LDB D1 CLA JSB ..MAP DEF SBASE S ARRAY BASE DEF SS.1 FIRST SUBSCRIPT DEF J1 SECOND SUBSCRIPT (J1) DEF D6 LENGTH OF FIRST SS (6) STA ATEMP SAVE ADDR IN ATEMP JMP ..SS,I EXIT SPC 2 * BLKCS - BLANK PRINT LINE 'CS' SPC 1 BLKCS NOP LDA DM66 STA TEMP LDA ACS STA ATEMP LDB BLANK STB ATEMP,I ISZ ATEMP ISZ TEMP JMP *-3 JMP BLKCS,I SKP * SCAN - WILL SCAN FOR TRAILING BLANKS * IN PRINT LINE 'CS' AND * PRINT 'CS' IF NOT ALL BLANKS SPC 1 SCAN NOP * DO 10 I=LCS,1,-1 LDA LCS STA I SPC 1 SCAN1 EQU * * CALL SGET(CS,I,ICHAR) JSB SGET SUPPRESS TRAILING DEF *+4 DEF CS BLANKS FROM PRINT DEF I LINE DEF ICHAR * IF(ICHAR.NE.40B) GOTO 20 LDA ICHAR CPA B40 RSS JMP SCAN2 * 10 CONTINUE LDA I ADA DM1 STA I CMA,INA ADA D1 SZA SSA JMP SCAN1 * RETURN JMP SCAN,I SPC 1 SCANlQ2 EQU * * 20 CALL REIO(2,6,CS,-I) LDA I CMA,INA PRINT -I CHARACTERS STA LEN OF 'CS' JSB REIO PRINT HEADER LINE DEF *+5 DEF D2 RCODE = 2 DEF ILP LU = 6 DEF CS CS DEF LEN -I CHARACTERS * RETURN JMP SCAN,I SPC 2 * SPBP - SPACE BEFORE PRINTING CONTROL SPC 1 SPBP NOP SPC 1 SPBP1 EQU * * 10 IF(V.LE.0) RETURN 1 LDA V CMA,INA ADA D0 CMA SPACE BEFORE SSA PRINT REQUESTED? JMP SPBP,I NO - EXIT ISZ DSNAM * CALL REIO(2,6,2H ,-1) JSB SPACE YES - SPACE * V=V-1 LDA V DECREMENT SPACE ADA DM1 BEFORE OPTION COUNT STA V * IF(P2.GE.54) RETURN 2 LDA LNPPG CMA,INA PAGE OVERFLOW ADA P2 CMA SSA,RSS * GOTO 10 JMP SPBP1 NO ISZ SPBP JMP SPBP,I SPC 2 * SPAP - SPACE AFTER PRINTING CONTROL SPC 1 SPAP NOP LDA D1 ADA VBASE STA ATEMP SPACE AFTER SPC 1 SPAP1 EQU * * 10 IF(V(2).LE.0) RETURN 1 LDA ATEMP,I COUNT ZERO? CMA,INA ADA D0 CMA SSA JMP SPAP,I ISZ DSNAM * CALL REIO(2,6,2H ,-1) JSB SPACE SPACE ONE LINE * V(2) = V(2) - 10 LDA ATEMP,I DECREMENT SPACE ADA DM10 AFTER COUNT STA ATEMP,I * IF(P2.GE.54) RETURN 2 LDA LNPPG CMA,INA ADA P2 CMA SSA,RSS * GOTO 10 JMP SPAP1 ISZ SPAP JMP SPAP,I SPC 3 SKIP NOP LDA ILP ADA B1100 STA B1106 JSB EXEC DEF *+4 DEF D3 DEF B1106 DEF DM1 JMP SKIP,I HED EQUATES AND CONSTANTS AREG EQU 0 D0 DEC 0 D1 DEk0.*C 1 D2 DEC 2 D3 DEC 3 D4 DEC 4 D5 DEC 5 D6 DEC 6 D7 DEC 7 D8 DEC 8 D10 DEC 10 DM1 DEC -1 DM3 DEC -3 DM4 DEC -4 DM8 DEC -8 DM10 DEC -10 SPC 1 AAS DEF AS AS ARRAY BASE ACS DEF CS CS ARRAY BASE ADS DEF DS DS ARRAY BASE AIB DEF IB-1 IB ARRAY BASE - 1 AINFO DEF INFO INFO ARRAY BASE ASAVE DEF SAVE ADDRESS OF SAVE BUFFER ASAVV DEF SAVEV ADDRESS OF SAVEV ASORT DEF ISORT-1 ISORT ARRAY BASE - 1 BSNAM DEF SNAM SNAM ARRAY BASE SBASE DEF S S ARRAY BASE VBASE DEF V V ARRAY BASE SPC 1 .2HI ASC 1,I ASCII I .2H15 ASC 1,15 ASCII '15' BLANK ASC 1, SPC 1 B40 OCT 40 ASCII BLANK B52 OCT 52 ASCII * B60 OCT 60 B71 OCT 71 ASCII 'Z' B111 OCT 111 ASCII I B122 OCT 122 ASCII R B132 OCT 132 ASCII '9' B1106 NOP B1100 OCT 1100 SPC 1 D.5 DEC 0.5 D20 DEC 20 D30 DEC 30 D36 DEC 36 DM66 DEC -66 LNPPG DEC 58 ACTUAL # LINES/PAGE PGSIZ DEC 59 STD # LINES/PAGE SPC 1 ATEMP BSS 1 EXP BSS 1 I BSS 1 I1 BSS 1 ICHAR BSS 1 IFAC BSS 1 REPORT OPTION FACTOR IJK BSS 1 INFO BSS 9 IOFF BSS 1 ITYPE BSS 1 JBEG BSS 1 J4 BSS 1 LEN BSS 1 LJS BSS 1 LOOP BSS 1 DO LOOP COUNT SAVE BSS 66 SAVE BUFFER FOR 'CS' SAVEV BSS 8 SAVE BUFFER FOR 'V' ARRAY SS.1 BSS 1 TEMP BSS 1 SPC 1 END I0ASMB,R,L,C NAM GBIT,7 92063-16012 REV. 1826 770601 * * ************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * * PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ************************************************************** * * * LISTING: 92063-19012 * SOURCE: 92063-18012 * RELOC: 92063-16012 * * ************************************************************* * SPC 1 ENT GBIT EXT .ENTR SPC 1 WORD BSS 1 GBIT NOP JSB .ENTR GET PARAMETER DEF WORD CLA SET RESULT FALSE LDB WORD,I GET WORD SLB IS LSB = 0 INA SET RESULT TRUE RBR YES -ROTATE BIT STB WORD,I RESTORE WORD JMP GBIT,I EXIT END ]ASMB,R,L,C NAM WORKR,7 92063-16012 REV. 1826 771018 * * ************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * * PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ************************************************************** * * * LISTING: 92063-19012 * SOURCE: 92063-18012 * RELOC: 92063-16012 * * ************************************************************* * ENT INITX,WORKX EXT .ENTR,EXEC FTRK BSS 1 FIRST TRACK OF WORK AREA. SIZE BSS 1 SECTORS PER TRACK JSECT BSS 1 SECTORS PER BLOCK. CONWD BSS 1 DISC LU INITX NOP JSB .ENTR DEF FTRK LDA FTRK,I STA FTRK LDA SIZE,I STA SIZE LDA JSECT,I STA JSECT LDA CONWD,I SET DISC IOR =B100 LOGICAL UNIT STA CONWD JMP INITX,I * RORW BSS 1 1=READ; 2=WRITE. BUF BSS 1 BUFFER ADDRESS. WORDS BSS 1 POSITIVE NUMBER OF WORDS. BLKNO BSS 1 BLOCK NUMBER. WORKX NOP JSB .ENTR DEF RORW LDA BLKNO,I CONVERT BLOCK NUMBER TO ADA NEG1 WORK AREA TRACK AND SECTOR. MPY JSECT CLB DIV SIZE ADA FTRK STA TRK STB SECT JSB EXEC START TRANSFER TO/FROM DEF *+7 THE WORK AREA. DEF RORW,I DEF CONWD DEF BUF,I DEF WORDS,I DEF TRK DEF SECT JMP WORKX,I * TRK BSS 1 SECT BSS 1 NEG1 DEC -1 END z  ASMB,R,L,C NAM QSORT,7 92063-16012 REV. 1826 771027 * * ************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * * PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ************************************************************** * * * LISTING: 92063-19012 * SOURCE: 92063-18012 * RELOC: 92063-16012 * * ************************************************************* * ENT QSORT EXT .ENTR AA BSS 1 L1 BSS 1 U1 BSS 1 KEY BSS 1 REC BSS 1 STAT BSS 1 QSORT NOP JSB .ENTR DEF AA LDA REC,I STA REC LDA L1,I ADA NEG1 MPY REC ADA AA STA L1 LDA U1,I ADA NEG1 MPY REC ADA AA STA U1 LDA REC CMA,INA STA RECN LDA KEY,I CMA,INA STA KEY CLA STA STAT,I STA K REENT ISZ K LDA L1 STA L LDA U1 STA U * * * PART *************** * PART LDA L STA P LDA U STA Q LDB Z JSB MOVE LDA P LDB X JSB MOVE LDB AA ADB RECN STB II LDA P CMA,INA ADA Q ADA RECN STA JJ LDA X LDB Z JSB COMP JMP LA60 X = Z JMP LA60 X < Z LDA Q X > Z STA M LDA P STA J LDA X LDB Z JSB SWICH LA60 LDA L CMA,INA ADA U ADA RECN ADA NEG1 SSA JMP LA370 LDA X LDB XX JSB MOVE LDA Z LDB ZZ JSB MOVE  LDA P STA IX LDA Q STA IZ * * * LEFT *************** * LEFT LDA P ADA REC STA P LDA Q CMA,INA ADA P SSA,RSS JMP LA100 LDA P LDB X JSB MOVE LDA X LDB XX JSB COMP RSS X = XX JMP LEFT X < XX * X > XX * * RIGHT *************** * RIGHT LDA Q ADA RECN STA Q CMA,INA ADA P SSA,RSS JMP LA140 LDA Q LDB Z JSB MOVE LDA Z LDB ZZ JSB COMP JMP DIST Z = ZZ JMP DIST Z < ZZ JMP RIGHT Z > ZZ LA140 LDA P STA Q ADA RECN STA P LDA X LDB Z JSB MOVE LDA P LDB X JSB MOVE * * * DIST *************** * DIST LDA X LDB Z JSB COMP JMP LA200 X = Z JMP LA200 X < Z LDA Q X > Z STA M LDA P STA J LDA X LDB Z JSB SWICH LA200 LDA X LDB XX JSB COMP JMP LA240 X = XX JMP LA240 X < XX LDA X X > XX LDB XX JSB MOVE LDA II ADA REC STA II LDA P STA IX LA240 LDA ZZ LDB Z JSB COMP JMP LEFT ZZ = Z JMP LEFT ZZ < Z LDA Z ZZ > Z LDB ZZ JSB MOVE LDA II ADA REC STA II LDA Q STA IZ JMP LEFT LA100 LDA Q ADA RECN STA P * * * OUT *************** * OUT LDA P CPA IX JMP LA320 LDA X LDB XX JSB CHECK JMP LA320 X = XX LDA XX X # XX LDB P JSB MOVE LDA X LDB IX JSB MOVE LA320 LDA Q CPA IZ JMP LA348 LDA Z LDB ZZ JSB CHECK JMP LA348 Z = ZZ LDA ZZ Z # ZZ LDB Q JSB MOVE LDA Z LDB IZ JSB MOVE LA348 LDA Q CMA,INA ADA U CMA,INA ADA P LDB L CMB,INB ADA B SSA,RSS JMP LA350 LDA L STA L1 LDA P ADA RECN STA U1 LDA Q ADA REC STA L JMP LA360 LA350 LDA U STA U1 LDA Q ADA REC STA L1 LDA P ADA RECN STA U LA360 LDA II CPA JJ JMP LA370 LDB U1 CMB,INB ADB L1 SSB JMP RECUR POP LDA U CMA,INA ADA L SSA JMP PART LA370 LDA K CPA ONE JMP QSORT,I ADA NEG1 STA K ADA BA LDB A,I STB L LDA K ADA CA LDB A,I STB U JMP POP RECUR LDA K ADA BA LDB L STB A,I LDA K ADA CA LDB U STB A,I JMP REENT * * * SUBROUTINES FOLLOW. * MOVE NOP STA TEMP1 STB TEMP2 LDB RECN LOOPA LDA TEMP1,I STA TEMP2,I ISZ TEMP1 ISZ TEMP2 INB,SZB JMP LOOPA JMP MOVE,I * COMP NOP STA TEMP1 STB TEMP2 LDB KEY LOOPB LDA TEMP1,I CMA,INA ADA TEMP2,I SZA JMP NOTEQ ISZ TEMP1 ISZ TEMP2 INB,SZB JMP LOOPB JMP COMP,I NOTEQ SSA ISZ COMP ISZ COMP JMP COMP,I * CHECK NOP STA TEMP1 STB TEMP2 LDB KEY LOOPC LDA TEMP1,I CPA TEMP2,I JMP PASS ISZ CHECK JMP CHECK,I PASS ISZ TEMP1 ISZ TEMP2 INB,SZB JMP LOOPC JMP CHECK,I * SWICH NOP STA TEMP1 STB TEMP2 LDB RECN LOOPD LDA TEMP1,I STA Y LDA TEMP2,I STA J,I STA TEMP1,I LDA Y STA M,I STA TEMP2,I ISZ TEMP1 ISZ TEMP2 ISZ J ISZ M INB,SZB JMP LOOPD JMP SWICH,I * * * BUFFER AREA. * X DEF XM Z DEF ZM XX DEF XXM ZZ DEF ZZM XM BSS 40 ZM BSS 40 XXM BSS 40 ZZM BSS 40 I BSS 1 J BSS 1 L BSS 1 M BSS 1 P BSS 1 Q BSS 1 U BSS 1 Y BSS 1 II BSS 1 IX BSS 1 JJ BSS 1 IZ BSS 1 TEMP1 BSS 1 TEMP2 BSS 1 RECN BSS 1 K BSS 1 CA DEF * CC BSS 30 BA DEF * BB BSS 30 NEG1 DEC -1 ONE DEC 1 A EQU 0 B EQU 1 END ݐ YC 92063-18013 1645 S 0122 RECOVERY UTILITY              H0101 L}FTN,L,C PROGRAM RECOV(3,90) C C C************************************************************* C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * C RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * C PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * C OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C************************************************************* C C C C C************************************************************ C C C RELOC. 92063-16013 C SOURCE 92063-18013 C C C*********************************************************************** C RECOV ALLOWS THE USER TO RECOVER A DATA BASES VOLATILE DATA C WHICH IS STORED IN SYSTEM AVAILABLE MEMORY. RECOV SHOULD C BE USED IN THE EVENT OF A MEMORY PROTECT, OR ANY OTHER C ABNORMAL TERMINATION OF THE DATA BASE PROGRAM WHERE THE C DATA BASE DID NOT GET CLOSED PROPERLY. C C C CALLING SEQUENCE C :RU,RECOV,P1 C C WHERE: P1 IS CONSOLE INTEGER P(5),FNAME(3),ISTAT(4),YES DATA IBLNK/2H / DATA YES/2HYE/ CALL RMPAR(P(1)) ITTY=P(1) IF (ITTY.EQ.0) ITTY=1 C PRINT STATUS 5 CALL DBSTA(ITTY) C WANT TO RECOVER ANY? WRITE(ITTY,40) 40 FORMAT("DO YOU WANT TO CLOSE A DATA BASE?") READ(ITTY,60)FNAME 60 FORMAT(3A2) IF (FNAME(1).NE.YES) STOP C GET DATA BASE NAME WRITE(ITTY,10) 10 FORMAT(" DATA BASE NAME? _") FNAME(1)=IBLNK FNAME(2)=IBLNK FNAME(3)=IBLNK READ(ITTY,20)FNAME 20 FORMAT(3A2) C GET SECURITY CODE C WRITE(ITTY,50) 50 FORMAT("DATA BASE SECURITY CODE? _") READ(ITTY,*)ISC C CHECK FOR OPEN ACTIVE TABLE AND POST VOLATILE DATA IF NECESSARY CALL CKACT(FNAME,ISC,ISTAT) IF (ISTAT.EQ.1) GOTO 130 IF (ISTAT.EQ.2) GOTO 140 IF (ISTAT.NE.0) GOTO 110 WRITE(ITTY,165) 165 FORMAT("DATA BASE RECOVERED!!") GOTO 5 110 WRITE(ITTY,120)ISTAT(1) 120 FORMAT("*   ERROR ",I6) 150 WRITE(ITTY,125) 125 FORMAT(" DATA BASE NOT PROPERLY RECOVERED!!") GOTO 5 130 WRITE(ITTY,135)FNAME 135 FORMAT(3A2," NOT FOUND") GOTO 150 140 WRITE(ITTY,145) 145 FORMAT(" RESOURCE NUMBER IS IN USE") GOTO 150 END END$ r  Za 92063-18014 1805 S 0122 SPACE UTILITY              H0101 0FTN,L,C PROGRAM DBSPA(3,90),REV. 1805 771027 C C C************************************************************* C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * C RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * C PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * C OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C************************************************************* C C C C C************************************************************ C C C RELOC. 92063-16014 C SOURCE 92063-18014 C C C*********************************************************************** C SPACE PRINTS THE NUMBER OF RECORDS REMAINING IN C A DATA BASES DATA SETS. C C CALLING SEQUENCE C :RU,DBSPA,P1,P2 C C WHERE: P1 IS CONSOLE C P2 IS LIST DEVICE INTEGER P(5),FNAME(3),ISTAT(4) INTEGER E1,E2,E3 DIMENSION IBUF(500),IREC(100) DIMENSION ILEVL(3),ITEMP(256) DIMENSION ISEGN(4) DATA I1,I2/1,2/ DATA N16,N20,N28/-16,-20,-28/ DATA N1,N2/-1,-2/ DATA N6/-6/ DATA IBLNK/2H / DATA ISEGN/1,2HDB,2HSP,2HA / C C CALL RMPAR(P) ITTY=P(1) ILP=P(2) IF (ITTY.EQ.0) ITTY=1 IF (ILP .EQ.0) ILP=6 WRITE(ITTY,10) 10 FORMAT("DATA BASE NAME? _") FNAME(1)=IBLNK FNAME(2)=IBLNK FNAME(3)=IBLNK READ(ITTY,20)FNAME 20 FORMAT(3A2) C GET LEVEL WRITE(ITTY,30) 30 FORMAT("DATA BASE LEVEL? _") ILEVL(1)=IBLNK ILEVL(2)=IBLNK ILEVL(3)=IBLNK READ(ITTY,40)ILEVL 40 FORMAT(3A2) C GET SECURITY CODE WRITE(ITTY,50) 50 FORMAT("DATA BASE SECURITY CODE? _") READ(ITTY,*)ISC C OPEN THE DATA BASE 107 MODE=1 CALL DBINT(FNAME,ISC,ISEGN,ISTAT) IF (ISTAT.NE.0) GOTO 110 CALL DBOPN(FNAME,ILEVL,ISC,MODE,ISTAT) C IF ERROR IN DBOPN, PUT OUT APRROPRIATE ERR NO. AND EXIT IF (ISTAT.NE.0) GO TO 11y  0 C GET DATA SET CAPACITIES WRITE(ILP ,140) 140 FORMAT(" DATA SET NAME CAPACITY FREE RECORDS RECORDS USED 1DIFFERENCE") WRITE(ILP ,150) 150 FORMAT(" ------------- -------- ------------ ------------ 1----------") CALL GTSIZ(IBUF,ISIZE) K=5 DO 205 J=1,ISIZE IREC(J)=0 DO 200 I=1,IBUF(K) CALL DBGET(J,3,ISTAT,ITEMP,I) IF (ISTAT(1).EQ.114) GOTO 200 IF (ISTAT(1).NE.0) GOTO 111 IREC(J)=IREC(J)+1 200 CONTINUE C K=K+5 205 CONTINUE 210 I=1 DO 300 J=1,ISIZE IDIFF=IBUF(I+4)-(IBUF(I)+IREC(J)) C C IF NUMBER OF RECORDS USED PLUS NUMBER OF FREE RECORDS DON'T ADD UP TO C THE CAPACITY OF THE DATA SET THEN SET A FLAG INDICATING POSSIBLE C NON-INTACT DATA BASE C IF (IDIFF.NE.0) IFLG=1 WRITE(ILP,130)IBUF(I+1),IBUF(I+2),IBUF(I+3),IBUF(I+4),IBUF(I), 1IREC(J),IDIFF 130 FORMAT(1X,3A2,12X,I5,10X,I5,8X,I5,8X,I5) I=I+5 300 CONTINUE C IF(IFLG.EQ.1) WRITE(ILP,400) 400 FORMAT(///" DATA BASE MAY NOT BE GOOD - TRY PROGRAM 'RECOV' 1TO RECOVER IT") C CALL DBCLS(I0,ISTAT) IF (ISTAT.NE.0) GOTO 110 STOP 110 WRITE(ITTY,120)ISTAT(1) 120 FORMAT(" ERROR ",I4) STOP 111 WRITE(ITTY,120)ISTAT(1) CALL DBCLS(I0,ISTAT) STOP END END$ w#  [b 92064-18001 1740 S C0322 &MSC10 MI SCHEDULE             H0103 8<ASMB,R,L,C ** RTE-M I SCHEDULER MODULE ** * * NAME : $MSC1 * SOURCE: 92064-18001 * RELOC: 92064-16001 * PROGMR: E.J.W. BASED ON RTE-III VERSIONS G.A.A.,L.W.A.,D.L.S. * * **************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT * * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * **************************************************************** * * NAM $MSC1,0 92064-16001 REV.1740 770811 * SUP * SCHED ENTRY POINT NAMES * ENT $LIST,$MESS,$CVT3,$CVT1,$ABRT,$TYPE ENT $MPT2,$PRAM,$TNAM ENT $PARS,$STRT,$SCD3,$INER,$ASTM ENT $MPT8,$WORK,$WATR ENT $MSEX,$MSBF,$LCTU,$RCTU * * SCHED EXTERNAL REFERENCE NAMES * EXT $XSIO,$IOUP,$IODN,$ERMG EXT $IOCL,$LUPR,$EQST,$SCLK EXT $ZZZZ,$CHTO,$PVCN EXT $ERIN,$NOPG,$OPER,$ILST EXT $XEQ,$ONTM,$ALC,$RTN EXT $SYMG,.MVW EXT $BLRQ,$ITRQ,$TIRQ,$TMRQ EXT $SABR,$STRQ,$PRRQ * * ******************************************************************* * * THE SCHED MODULE OF HP2100 REAL TIME EXECUTIVE CONSISTS OF * * 1. LIST PROCESSORS * 2. LINK PROCESSORS * 3. OPERATOR INPUT MESSAGE PROCESSORS * 4. SYSTEM START UP AND OPER INPUT REQUEST ACKNOWLEDGE * 5. MEMORY PROTECT VIOLATION SCHEDULER PREPROCESSORS * 6. ABORT AND TERMINATION PROCESSORS * ******************************************************************* * * --BUFFERS, CONSTANTS, POINTERS, ETC * $STRT EQU * SYSTEM INITIALIZATION ENTRY POINT * T4 JMP RECON ***TRY RESTART * T0 JMP TEMPP -NOP- BECOMES NOP AFTER STARTUP ST2 JSB $RTN RE-INITIALIZE MEMORY T1 NOP WITH MAX T2 NOP ST3 JMP TEMP5 ^-NOP- BECOMES NOP AFTER STARTUP * EXT $CLCH,$ETEQ LDA EQT# ***TRY RESTART*** CMA,INA ***TRY RESTART*** STA TEMP1 ***TRY RESTART*** LDA EQTA ***TRY RESTART*** STA TEMP2 ***TRY RESTART*** EQLOP STA TEMP2 ***TRY RESTART*** JSB $ETEQ ***TRY RESTART*** CLA ***TRY RESTART*** STA EQT1,I ***TRY RESTART*** STA EQT15,I ***TRY RESTART*** LDA EQT5,I ***TRY RESTART*** AND C140K ***TRY RESTART*** STA EQT5,I ***TRY RESTART*** JSB $CLCH ***TRY RESTART*** LDA TEMP2 ***TRY RESTART*** ADA D15 ***TRY RESTART*** ISZ TEMP1 ***TRY RESTART*** JMP EQLOP ***TRY RESTART*** * LDB KEYWD ***TRY RESTART*** STB TEMP2 ***TRY RESTART*** RSLOP LDB TEMP2,I ***TRY RESTART*** SZB,RSS ***TRY RESTART*** JMP RSDON ***TRY RESTART*** ADB D20 ***TRY RESTART*** LDA B,I ***TRY RESTART*** AND CLRPA ***TRY RESTART*** STA B,I ***TRY RESTART*** LDA TEMP2,I ***TRY RESTART*** JSB $ABRT ***TRY RESTART*** ISZ TEMP2 JMP RSLOP ***TRY RESTART*** RSDON NOP ***TRY RESTART*** JSB $SCLK CLA ***TRY RESTART*** STA FLG ***TRY RESTART*** STA SKEDD ***TRY RESTART*** STA OPATN ***TRY RESTART*** INA ***TRY RESTART*** STA $LIST ***TRY RESTART*** JMP $TYPE ***TRY RESTART*** * * SKEDD EQU 1711B ***TRY RESTART*** OPATN EQU 1734B ***TRY RESTART*** CLRPA OCT 6400 ***TRY RESTART*** KEEP ONLY RM,RE,RN C140K OCT 37777 * TEMPP LDA AVMEM ***TEMPORARY WORKING STORAGE AREA TEMP STA T1 * DO NOT REARRANGE! TEMP1 CMA,INA * TEMP2 ADA BKORG * TEMP3 STA T2 * TEMP4 JMP ST2 * THESE TEMPS ARE USED TO INITIALIZE TEMP5 CLA *** SYSTEM AVALILABLE MEMORY. TEMP6 STA T0 * AND ALSO TMP STA ST3 * USED BY $PARS AS CONTIGUOUS BUFFER SPACE TEMPH JMP $ALC * TBUF DEF TEMP5 $WORK JSB $ZZZZ * TBUFS DEF TEMP5+7 WORK EQU $WORK WPRIO NOP * ASCI NOP * ASCI1 NOP * ASCI2 JMP $ERMG *** WSTAT NOP DM5 DEC -5 * D2 DEC 2 D4 DEC 4 D5 DEC 5 D6 DEC 6 D9 DEC 9 D15 DEC 15 * D1 OCT 1 D3 DEC 3 B77 OCT 77 B377 OCT 377 * ZERO REP 5 NOP DEF0 DEF ZERO HED ID-SEGMENT MAP ID-SEGMENT MAP ID-SEGMENT MAP * WORD USE * 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 0 * ! ! ! ! ! ! * 1 LIST LINKAGE * ! ! ! ! ! ! * 2-6 5 WORD TEMPORARY AREA USED FOR SPECIAL FLAGS IN QUEUES ETC. * ! ! ! ! ! ! * 7 PRIORITY * ! ! ! ! ! ! * @ 8 PRIMARY ENTRY POINT * ! ! ! ! ! ! * 9 POINT OF SUSPENSION (XSUSP) * ! ! ! ! ! ! * 10 A REGISTER AT SUSPENSION (XA) * ! ! ! ! ! ! * 11 B REGISTER AT SUSPENSION (XB) * ! ! ! ! ! ! * 12 E/O REGISTERS AT SUSPENSION (XEO) * ! ! ! ! ! ! * @ 13 NAME ( FIRST AND SECOND CHARACTERS ) * ! ! ! ! ! ! * @ 14 NAME (THIRD AND FOURTH CHARACTERS) * ! ! ! ! ! ! * @ 15 NAME (FIFTH CHARACTER)---- TM CL AM SS --- TYPE --- * ! ! ! ! ! ! * 16 NA NP W A O  R D --- STATUS- * ! ! ! ! ! ! * 17 TIME LIST LINKAGE WORD * ! ! ! ! ! ! * @ 18 RESOLUTION T -------MULTIPLE----------------------- * ! ! ! ! ! ! * @ 19 LOW ORDER 16 BITS OF EXECUTE TIME LESS 24 HRS IN 10'S MS. * ! ! ! ! ! ! * @ 20 HIGH ORDER 16 BITS OF EXECUTE TIME * ! ! ! ! ! ! * 21 BA FW AT RM RE PW RN --FATHER ID-SEG. NUMBER-- * ! ! ! ! ! ! * 22 RP ---# OF PAGES---,--MPFTI-- .. ----PARTITION #---- * ! ! ! ! ! ! * @ 23 LOW MAIN ADDRESS * ! ! ! ! ! ! * @ 24 HI MAIN ADDRESS + 1 * ! ! ! ! ! ! * @ 25 LOW BASE PAGE ADDRESS * ! ! ! ! ! ! * @ 26 HI BASE PAGE ADDRESS + 1 * ! ! ! ! ! ! * @ 27 DISC ADDRESS (LU (15),TRACK (14-7),SECTOR(6-0) * ! ! ! ! ! ! * 28 SWAP DISC ADDRESS (LU (15),TRACK (14-7),#TRACKS(6-0) * ! ! ! ! ! ! * 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 0 * * @ WORDS USED IN SHORT ID SEGMENTS SKP * WHERE THE FLAG BITS MEAN: * TM = TEMP LOAD (COPY OF ID-SEG NOT ON DISC) * CL = CORE LOCK (MAY NOT SWAP) * AM = ALL MEMORY (PROGRAM USES ALL OF ITS AREA) * SS = SHORT SEGMENT (INDICATES A 9-WORD ID-SEGMENT) * NA = NO ABORT (PASS ABORT ERRORS TO THE PROGRAM INSTEAD) * NP = NO PRAMS ALLOWED ON RESCHEDULE. * W = WAIT BIT (WAITING FOR PROG.Ֆ WHOES ID-SEG ADD. IS IN WD.2) * A = ABORT ON NEXT LIST ENTRY FOR THIS PGM. * O = OPERATOR SUSPEND ON NEXT SCHEDULE ATTEMPT * R = RESOURCE SAVE (SAVE RESOURCES WHEN SETING DORMANT) * D = DORMANT BIT (SET DORMANT ON NEXT SCHEDULE ATTEMPT) * T = TIME LIST ENTRY BIT (PROG IS IN THE TIME LIST) * BA = BATCH (PROGRAM IS RUNNING UNDER BATCH) * FW = FATHER IS WAITING (HE SCHEDULE WITH WAIT) * AT = ATTENTION BIT (OPERATOR HAS REQUESTED ATTENTION) * RM = RE-ENTRENT MEMORY MUST BE MOVED BEFORE DISPATCHING PGM. * RE = RE-ENTRENT ROUTINE IN CONTROL NOW * PW = PROGRAM WAIT (SOME PROGRAM WANTS TO SCHEDULE THIS ONE ) * RN = RESOURCE NUMBER EITHER OWNED OR LOCKED BY THIS PGM. * RP = RESERVED PARTITION FOR REQUESTING PROGRAMS ONLY. * * * $LIST STATE TRANSITION TABLE: * THE FOLLOWING TABLE DETAILS THE STATE TRANSITIONS EFFECTED BY * $LIST. THE MAJOR STATES ARE 0 THRU 6 (DORMANT THRU OP-SUSP) * AND THE STATE MODIFIERS ARE THE ADDITIONAL BITS SET FROM TIME * TO TIME IN THE STATUS WORD. THE BITS WHICH AFFECT OR ARE * MODIFIED BY $LIST ARE (SEE ABOVE DESCRIPTION): * BIT WEIGHT POSITION * O 10 9 * W 4 12 * R 2 7 * D 1 6 * * THESE BITS ARE COMBINED TO FORM 16 SUBSTATES AS PER THE TABLE BELOW * THE ENTRYS IN EACH SQUARE OF THE TABLE DEFINE THE NEXT STATE AS * FOLLOWS: * * THE FIRST DIGIT IS THE REQUESTED MAJOR TRANSITION (FROM * THE $LIST CALL). * THE SECOND TWO NUMBERS (SEPERATED BY A ".") DEFINE THE NEXT * MAJOR STATE . SUBSTATE. THUS 62.10 INDICATES A OP-SUSPEND * REQUEST (6) CAUSES A MOVEMENT TO I/O SUSPEND (2) SUBSTATE 10 * (THE O BIT IS SET). * A "*" AS THE DESTINATION INDICATES THE CURRENT STATE/SUB- * STATE I.E. NO CHANGE. * ILLEGAL OR UNEXPECTED STATES ARE MARKED WITH "X" * * ONLY EXPECTED CALLS ARE PLOTTED. * * IN GENERAL CODE EXTERNN\AL TO $LIST MOVES PROGRAMS FROM SUB-STATE * TO SUB-STATE WHILE ONLY $LIST CAN MOVE A PROGRAM FROM ONE * MAJOR STATE TO ANOTHER. HED SYSTEM STATE TABLE******SYSTEM STATE TABLE*** *MAJOR STATE 0 1 2 3 4 5 6 *SUB-STATES *---------!-----!-------!-------!-------!-------!-------!------ * 0 11.0 00.0 02.1 00.0 00.0 00.0 00.0 * 22.0 11.0 11.0 11.0 11.0 11.0 * 33.0 62.10 66.0 66.0 66.0 * 44.0 * 55.0 * 66.0 *---------!-----!-------!-------!-------!-------!-------!------ * 1 D X X 02.1 X X X X * 10.0 * 62.11 *---------!-----!-------!-------!-------!-------!-------!------ * 2 R 11.0 00.2 02.3 00.2 00.2 00.2 06.3 * 66.3 *---------!-----!-------!-------!-------!-------!-------!------ * 3 RD X X 0* X X X 0* * 10.2 10.2 *---------!-----!-------!-------!-------!-------!-------!------ * 4 W 00.0 33.4 00.0 00.0 00.0 00.0 00.0 * 1* 13.4 * 66.4 *---------!-----!-------!-------!-------!-------!-------!------ * 5 WD X X X X X X X *---------!-----!-------!-------!-------!-------!-------!------ * 6 WR 0* X X 00.6 X X 06.7 * 13.4 * 66.7 *---------!-----!-------!-------!-------!-------!-------!------ * 7 WRD X X X X X X 0* * 10.6 *---------!-----!-------!-------!-------!-------!-------!------ * 10 O X X 02.11 X X X X * 16.0 * 6* *---------!-----!-------!-------!-------!-------!-------!------ * 11 OD X X 0* X X X X * 10.0 * 6* *---------!-----!-------!-------!-------!-------!-------!------ * 12 OR X X 02.13 X X X X *---------!-----!-------!-------!-------!-------!-------!------ * 13 ORD X X 0* X X X X * 16.3 * 6* *---------!-----!-------!-------!-------!-------!-------!------ * 14 OW X X X X X X X *---------!-----!-------!-------!-------!-------!-------!------ * 15 OWD X X X X X X X *---------!-----!-------!-------!-------!-------!-------!------ * 16 OWR X X X X X X X *---------!-----!-------!-------!-------!-------!-------!------ * 17 OWRD X X X X X X X *---------!-----!-------!-------!-------!-------!-------!------ HED REAL TIME SCHEDULER---LIST PROCESSOR SECTION--- * * THE $LIST PROCESSOR SECTION OF THE HP-2100 REAL TIME * EXECUTIVE PROCESSES THE FOLLOWING LIST REQUESTS * 1. DORMANT * 2. SCHEDULE * 3. OPERATOR SUSPEND * 4. NON-OPERATOR SUSPEND * A. I/O * B. MEMORY AVAILABLE * C. DISC AVAILABLE * 5. SEGMENT LOADING * * * * CALLING SEQUENCE * * JSB $LIST * OCT (ADDRESS CODE)(FUNCTION CODE) * DEF (ADDRESS) * * IF A = 0, THEN NO MESSAGE * A NOT 0, THEN ADDR OF MESSAGE * IF ERROR, (B) CONTAINS ASCII ERR CODE * WHERE * FUNCTION CODE * 0 = DORMANT REQUEST * 1 = SCHEDULE REQUEST * 2 = I/O SUSPEND REQUEST * 3 = GENERAL WAIT LIST REQUEST * 4 = MEMORY AVAILABEL REQUEST * 5 = DISK ALLOCATION REQUEST * 6 = OPERATOR SUSPEND REQUEST * 17 = RELINK PROGRAM REQUEST * 10 THRU 16 ARE NOT ASSIGNED * * * * ADDRESS CODE * 0 = ID SEGMENT NAME FOLLOWED BY 5 OPTIONAL * PARAMETERS TO GO INTO TEMPORARY AREA OF ID SEG. * 1 = ID SEGMENT ADDRESS * 2 = ASCII PROGRAM NAME ADDRESS * 3 = ID SEGMENT ADDRESS IN WORK * 4 = ID SEGMENT ADDRESS IN B-REG * 5 = ID SEGMENT ADDRESS IN XEQT * 6 = ID SEG ADD FOLLOWED BY CONTENTS TO BE PUT * INTO "B-REG @ SUSP" WORD OF ID SEG. * 7 = ID SEG NAME FOLLOWED BY 5 PARAMETERS TO GO * INTO ID'S TEMPORARY AREA. * * * ADDRESS * KEYWORD, ID SEGMENT, OR * PROGRAM NAME ADDRESS AS SPECIFIED BY CODE * MUST NOT BE SUPPLIED FOR * ADDRESS CODES 3 AND 4. * SKP $LIST OCT 1 ENTRY/EXIT (INIT.#0 FOR DISPATCHER) LDA $LIST,I WORD 1 AND D15 STA L0091 STORE AWAY REQUEST CODE XOR $LIST,I FORM ADDR CODE ALF,ALF RAL,RAL CPA D4 ADDRESS IN B-REG? JMP L0021 YES GO SET UP CPA D3 ADDRESS IN WORK? JMP L0060 YES GO SET UP LDB XEQT PRESET FOR CURRENT EXECUTING PGM. CPA D5 CURRENT PGM? JMP L0021 YES GO SET IT UP ISZ $LIST STEP TO ADDRESS WORD LDB $LIST,I GET IT TO B CPA D1 IS ADDRESS NOW IN B? JMP L0021 YES GO SET IT UP SPC 1 CPA D2 DOES B POINT TO AN ASCII NAME? JMP DL02 YES, SO GO SEE IF PROGRAM EXISTS. CPA D6 JMP DL06 * STB RETRN B-REG MUST BE A RETURN ADDRESS, SO SAVE. ISZ $LIST BUMP POINTER TO EITHER PROG.NAME OR ADD. LDB $LIST,I GET THE ID ADD. OR PROG.NAME ADDRESS. SZA,RSS IF ADDRESS = 0 THEN ID ADDRESS. JMP DL00 IF NON ZERO, THEN PROCESS AS ADDRESS * JSB $TNAM OF PROGRAM NAME. GO GET ID ADDRESS. SEZ IF PROGRAM DOES NOT JMP NPRG EXIST, THEN TELL FOLKS. * DL00 JSB DORM? SETUP THE $LIST PRAMS & SEE IF DORMANT. SZA IS THE PROGRAM DORMANT? JMP L0075 NO, GO TELL CALLER TO FORGET IT. * * THE FOLLOWING ROUTINE IS USED FOR ADDRESS CODES 0 AND 7 * TO STUFF PARAMETERS INTO THE PROGRAM'S ID SEGMENT. CODES * 0 AND 7 ARE PROVIDED FOR DRIVERS WHICH WISH TO SCHEDULE * PROGRAMS. * * ASSUMPTIONS * 1) AT LEAST ONE PARAMETER MUST BE SUPPLIED(I.E. ONE DEF). * 2) THE RETURN ADDRESS MUST END THE PARAMETERLIST. * 3) 5 PARAMETERS ARE THE MAXIMUM. * 4) ABSOLUTELY NO ERROR CHECKING IS DONE. * ISZ $LIST BUMP $LIST TO POINT TO FIRST PARAMETER. LDB RETRN USE RETURN ADDRESS CMB,INB TO DETERMINE HOW MANY ADB $LIST PARAMETERS TO PASS. STB DM5 SAVE TO FAKE OUT SUBROUTINE *PRAM*. * LDA WORK SET A-REG TO ID ADDRESS. LDB $LIST SET B-REG TO PARAMETER'S ADDRESS. ADB SIGN SET SIGN BIT OF B-REG. JSB $PRAM GO STUFF THE ID ADDRESS. * LDA DMM5 RESET -5 CONSTANT STA DM5 TO MINUS 5. CCA SET UP THE RETURN ADA RETRN ADDRESS FOR $LIST'S STA $LIST REURN. JMP L0290 NOW GO SCHEDULE THE PROGRAM. * DL06 ISZ $LIST BUMP TO FUTURE B-REG @ SUSP. LDA $LIST,I SET A-REG TO "B-REG @ SUSP". DL062 STA TEMPX AND SAVE TEMPORRIALLY. JSB DORM ? SET UP LIST PARAMETERS & CHECK FOR DORMANT. SZA IF PROGRAM IS DORMANT, JMP L0075 THEN TELL CALLER TO FORGET IT. LDB WORK PUT "B-REG @ SUSP" ADB D10 VALUE INTO THE LDA TEMPX PROPER ID STA B,I SEGMENT JMP L0290 WORD.GO SCHEDULE. * DL02 JSB $TNAM NOW ITS IN B SEZ,RSS SKIP IF NOT FOUND OR SHORT ID SEG. JMP L0021 PROG FOUND, SO GO PROCESS * NPRG LDA $NOPG NO SUCH PROG ERROR MESSAGE LDB D5 NO SUCH PROG ERROR CODE JMP L0015 GO TO RETURN * * PROCESS ID SEGMENT ACCORDING TO REQUEST CODE * L0060 LDB WORK SET B-REG TO ID ADDRESS. * L0021 JSB DORM? GET CURRENT PROGRAM LDB L0091 REQUEST CODE. SZB,RSS CHECK IF DORMANT REQUEST JMP L0100 DORMANT REQUEST CPB D1 CHECK IF SCHEDULE REQUEST JMP L0200 YES CPB D6 CHECK IF OPERATOR SUSPEND REQUEST JMP L0300 YES CPB D15 CHECK IF LINKAGE UPDATE REQUEST JMP L0135 YES JMP L0400 MUST BE A SIMPLE LIST MOVE * L0075 LDA $ILST ILLEGAL STATUS MESSAGE ADDRESS LDB D3 ILLEGAL STATUS ERROR CODE JMP L0015 GO TO EXIT RETRN NOP DMM5 DEC -5 TEMPX NOP SIGN OCT 100000 SKP * ************************************************************ * * THE DORM? SUBROUTINE IS CALLED BY THE $LIST PROCESSOR * FOR ALL CALLS. IT'S PRIMARY PURPOSE IN LIFE IS TO SET * UP WORK, WPRIO, WSTAT AND L0090. IN ADDITION, IT RETURNS * L0090, THE PROGRAM'S CURRENT STATUS, IN THE A REGISTER. * $LIST FUNCTION CODES OF 0, 6 AND 7(THE DRIVER $LIST CALLS) * USE THIS SUBROUTINE TO SEE IF THE PROGRAM IS DORMANT. * * CALLING SEQUENCE: * LDB ID-ADDRESS * JSB DORM? * * RETURN: * A-REG = CURRENT STATUS(BITS 0-6) * ************************************************************* * DORM? NOP STB $WORK SET UP THE ID ADDRESS FOR LATER. ADB D6 AND STB WPRIO THE PRIORITY WORD ADB D9 AND STB WSTAT THE STATUS WORD. LDA B,I GET THE OLD STATUS AND D15 AND KEEP ONLY LOWER STA L0090 STATUS BITS. JMP DORM?,I RETURN TO USER. HED LIST PROCESSOR--DORMANT REQUEST * * DORMANT REQUEST * * THE DORMANT REQUEST IS PROCESSED AS FOLLOWS: * IF ABORT BIT SET, MAKE PROGRAM DORMANT * IF ALREADY DORMANT, RETURN * IF SCHEDULED, THEN ENTERED INTO DORMANT LIST, POINT * OF SUSPENSION CLEARED. * IF ID SEGMENT ADDRESS IS SAME AS RESIDING * BACKGROUND DISC RESIDENT PROGRAM, THEN BKRES * FLAGS ARE CLEARED SO ANOTHER PROGRAM MAY BE * LOADED INTO THE AREA. * IF ID SEGMENT ADDRESS IS SAME AS RESIDING REAL * TIME DISC RESIDENT PROGRAM, THEN RDISK FLAGS * ARE CLEARED SO ANOTHER PROGRAM MAY BE LOADED * INTO THE AREA. * IF NOT ONE OF ABOVE, THEN DORMANT BIT SET IN STATUS SPC 1 L0100 LDB WSTAT,I CHECK IF ABORT BIT SET BLF RBL,SLB,BLF JMP L0115 YES, SO GO MAKE DORMANT CPA D2 IF I/O SUSPENDED L0103 ALF,SLA,RAL SET DORMANT BIT JMP L0350 ELSE GO CHECK RESOURCE BIT * L0105 IOR WSTAT,I IF I-O SUSP., MERGE CURR STATUS, SET NP JMP L0375 IF DOER IS NOT CURRENT PROG * L0350 EQU * NO RESOURCES IN RTE-M I L0115 LDA $WORK CLEAR ID SEG TEMP AND SET B LDB DEF0 JSB $PRAM LDB $WORK SET FLAG FOR DISPATCHER CLA CPB XEQT STA $PVCN ADB D8 LINK THROUGH XSUSP LDA $ZZZZ SO RESIDENT FLAGS STB $ZZZZ ARE STA B,I CLEARED CLA STA XEQT CLEAR CURRENT PGM FLAGHFB IN CASE IT IS SPC 1 L0130 STA WSTAT,I SET THE NEW STATUS AND D15 GET THE ADDITION CODE L0135 LDB L0090 SET B FOR LINK JSB LINK RELINK THE PROG L0014 CLA SET FOR NORMAL RETURN L0015 ISZ $LIST STEP TO RETURN ADDRESS JMP $LIST,I LOOK MA! NO LABEL! SPC 1 * L0355 LDA WSTAT,I GET OLD STATUS AND CLD.R CLEAR "R" AND "D" (BITS 7,6) L0375 LDB $WORK IF NOT CURRENT CPB XEQT PROGRAM THEN RSS IOR B20K SET THE NO PRAMS BIT. JMP L0130 GO PUT IN THE DORM LIST SPC 2 L0090 NOP L0091 NOP SPC 1 ^H HED LIST PROCESSOR--SCHEDULE REQUEST * SCHEDULE REQUEST * THE SCHEDULE REQUEST IS PROCESSED AS FOLLOWS: * IF ABORT BIT SET, STORE ID SEGMENT ADDRESS SUCH THAT * PROGRAM WILL BE ABORTED AT NEXT ENTRY FROM XEQ * IF DORMANT BIT SET, GO TO DORMANT REQUEST * IF OPERATOR-SUSPEND BIT SET, GO TO OPERATOR-SUSPEND REQUEST * IF SCHEDULED, THEN STATUS ERROR EXIT * IF CURRENT STATUS NOT ONE OF ABOVE, THE PROGRAM IS * ENTERED INTO THE SCHEDULE LIST. * L0200 CPA D6 IF OP-SUSP JMP L0250 GO CHECK FOR DORMANT BIT LDB WSTAT,I GET WHOLE STATUS WORD CPA D2 IF I/O SUSP. THEN BLF,SLB,BLF ROTATE AND SKIP JMP L0255 ELSE GO CHECK WAIT BIT * RBR,SLB,RBL IF OP-SUSP BIT SET JMP L0220 GO CHECK FURTHER * L0270 CLA,INA SET A FOR SCHEDULE RBL DORM BIT TO 15 SSB IF DORM BIT SET JMP L0100 GO SET DORMANT L0290 CLA,INA JMP L0130 SCHEDULE * L0220 RBL CHECK RESOURCE BIT (EXCEPT IN M-I) SSB IF DORM BIT SET JMP L0100 GO MAKE DORMANT * L0230 LDA B1004 CLEAR THE OP-SUSP BIT AND JMP L0280 GO OP-SUSP THE PGM. * L0250 LDA WSTAT,I IF OP-SUSP BIT SET AND B100 AND DORM BIT SET SZA JMP L0355 GO CLEAR BIT AND SET DORMENT * L0255 LDA WSTAT,I IF WAIT BIT SET ALF,SLA,ALF THEN ALF,SLA,ALF GO MOVE TO WAIT LIST (SKIPS) JMP L0270 ELSE, SCHEDULE THE PROGRAM * XOR D3 CHANGE STATUS TO 3 AND D15 L0280 XOR WSTAT,I AND JMP L0130 GO RELINK HED LIST PROCESSOR--SUSPEND REQUESTS * * OPERATOR SUSPEND REQUEST * * THE OPERATOR-SUSPEND REQUEST IS PROCESSED AS FOLLOWS: * IF DORMANT OR OPERATOR SUSPENDED, STATUS ERROR! * IF SCHEDULED, ADD TO OPERATOR SUSPEND LIST * IF NOT ONE OF A*BOVE, SET OPERATOR-SUSPEND BIT * L0300 LDB WSTAT,I GET THE FULL STATUS WORD SZB IF ZERO (DORMANT) CPA D6 OR OP-SUSP JMP L0075 REJECT THE REQUEST * CPA D2 IF I/O SUSP JMP L0310 GO SET TO "O" BIT * JMP L0400 ELSE GO RELINK I.E. SET OP-SUSP. * L0310 LDA B1000 SET OPER-SUSP BIT IN STATUS JMP L0105 GO SET BIT AND EXIT SPC 1 * * NON-OPERATOR SUSPEND REQUEST * * THE NON-OPERATOR SUSPEND REQUEST IS PROCESSED AS FOLLOWS: * THE PROGRAM IS ENTERED INTO THE REQUESTED LIST AND * THE NEW STATUS REPLACES THE 4 LOW ORDER BITS OF THE * PROGRAM STATUS-THUS SAVING THE DORMANT OR OPERATOR- * SUSPEND BITS THAT MAY BE PRESENT. * * L0400 LDA WSTAT,I UPDATE STATUS SAVING ALL AND C17 BUT LOW 4 BITS IOR L0091 JMP L0130 GO TO EXIT SPC 1 C17 OCT 177760 B100 OCT 100 B1004 OCT 1004 CLD.R OCT 57460 CLEARS STATUS, R, D, NP, AND NA BITS HED LINK UPDATE PROCESSOR * * THE LINK PROCESSOR OF THE REAL TIME EXECUTIVE. * 1. REMOVES A PROGRAM FROM A LIST * 2. ENTERS THE PROGRAM INTO ANOTHER LIST AT THE PROPER PLACE * ACCORDING TO PRIORITY LEVEL. * * * * CALLING SEQUENCE * * LDB CODE1 * LDA CODE2 * JSB LINK * * WHERE * CODE1 = CODE OF REMOVAL LIST * CODE2 = CODE OF INSERTION LIST * THE ID SEGMENT IS ASSUMED TO BE LOCATED IN WORK * AND WPRIO SET * * * THE REMOVAL OF PROGRAM FROM A LIST CONSISTS OF: * 1. IF I/O LIST (CODE 2), THEN THIS IS SPECIAL CASE * AND DOES NOT REQUIRE REMOVAL. * 2. IF NULL LIST, THEN ERROR EXIT TAKEN. * 3. IF FIRST AND ONLY PROGRAM IN LIST, THEN LIST * VALUE SET TO ZERO. * 4. IF FIRST PROGRAM IN LIST, BUT NOT THE ONLY * q PROGRAM IN LIST(LINKAGE NOT ZERO), THEN SET LIST * VALUE TO THE LINKAGE VALUE. * 5. IF IN MIDDLE OF LIST, THE LINKAGE OF THE ID SEG * MENT WHICH POINTS TO THE PROGRAM TO BE REMOVED * IS SET TO THE LINKAGE VALUE OF THE PROGRAM THAT * IS REMOVED. * 6. IF LAST PROGRAM IN LIST, THE LINKAGE VALUE OF * PREVIOUS PROGRAM IN LIST IS SET TO ZERO. * LINK NOP ENTRY/EXIT SZB IGNOR DORMANT AND CPB D2 I/O LIST REQUESTS JMP LK100 YES, SEE IF ADDITION. ADB LLIST ADD TOP OF LIST POINTER * LK010 STB TEMP TOP OF REMOVAL LIST LDB B,I GET TOP OF LIST POINTER SZB,RSS END OF LIST? JMP LK150 YES, RETURN CPB $WORK MATCHES PROGRAM? RSS YES JMP LK010 NO, KEEP SEARCHING LDB B,I UPDATE LINKAGE TO BYPASS STB TEMP,I THE DELETED ID SEG HED LINK PROCESSOR--ADDING PROGRAM TO A LIST * * ADD A PROGRAM TO A LIST * * THE ADDITION OF PROGRAM TO A LIST CONSISTS OF: * 1. IF I/O LIST (CODE 2), THEN THIS IS SPECIAL CASE * AND NO ADDITION MADE TO LIST. * 2. IF NULL LIST, THEN LIST VALUE SET TO POINT TO ID * SEGMENT OF PROGRAM TO BE ADDED AND THE LINKAGE * SET TO ZERO. * 3. IF NOT NULL LIST, THE PROGRAM IS INSERTED INTO * LIST ACCORDING TO PRIORITY LEVEL AND LINKAGES * CHANGED TO REFLECT THIS INSERTION. * 4. IF OF LOWER PRIOR. THAN ANY PROGRAM IN LIST, THEN * LAST LINKAGE IS SET TO POINT TO THE PROGRAM TO * BE ADDED AND THE PROGRAM LINKAGE IS CLEARED. * LK100 SZA IGNOR DORMANT AND CPA D2 I/O LIST REQUESTS JMP LINK,I YES, RETURN ADA LLIST ADD TOP OF LIST POINTER * LK110 STA TEMP SAVE TOP;. OF LIST POINTER LDA A,I GET POINTER SZA,RSS END OF LIST? JMP LK140 YES, LINK IN NEW PROG CPA $WORK IS IT A DUPLIC. PROG? JMP LK150 YES, DUPLIC SO RETURN STA B NOT DUPLIC, COMPARE PRIORITY ADB D6 OF WORK ID SEG LDB B,I AGAINST CMB,INB CURRENT ADB WPRIO,I ID SEG SSB,RSS WORK < CURRENT? JMP LK110 NO, SEE NEXT ONE * LK140 STA $WORK,I LINK THIS TO FOLLOW WORK LDA $WORK LINK WORK TO FOLLOW STA TEMP,I PREVIOUS PROG * LK150 JMP LINK,I RETURN * * LLIST DEF DORMT TOP OF LIST ADDRESS DM32 DEC -32 B1000 OCT 1000 B4000 OCT 4000 COM OCT 54 TBUF DEF TEMP5 TBUFS DEF TEMP5+7 DM58 DEC -58 HED OPERATOR INPUT MESSAGE PROCESSOR * * THE $MESS PROCESSOR SECTION OF HP-2116 REAL TIME EXECUTIVE * PROCESSES THE FOLLOWING OPERATOR INPUT REQUESTS: * 1. TURN ON A PROGRAM * ON,XXXXX * ON,XXXXX,NOW * ON,XXXXX,P1,...,P5 * ON,XXXXX,NOW,P1,...,P5 * 2. TURN OFF A PROGRAM * OF,XXXXX,P * 3. OPERATOR SUSPEND A PROGRAM * SS,XXXXX * 4. CONTINUE A OPERATOR SUSPENDED PROGRAM * GO,XXXXX * GO,XXXXX,P1,...,P5 * 5. CURRENT STATUS OF A PROGRAM * ST,XXXXX * 6. CHANGE PROGRAM ID SEGMENT TIME PARAMETERS. * IT,XXXXX,R,MMM * IT,XXXXX,R,MMM,HR,MN * IT,XXXXX,R,MMM,HR,MN,SC * IT,XXXXX,R,MMM,HR,MN,SC,MS * 7. CHANGE PROGRAM PRIORITY * PR,XXXXX,ZZ * 8. SET REAL TIME CLOCK AND START TIME BASE GENERATOR * TM,DAY,HR,MN,SC * 9. CURRENT REAL TIME CLOCK VALUES * TI * 10. SET A EQUIPMENT DOWN * DN,NN * 11. SET A EQUIPMENT UP * UP,NN * 12. LOGICAL UNIT * LU,N1 * LU,N1,N2 * LU,N1,N2,N3 * 13. EQUIPMENT STATUS * EQ,NN * 14. SET SOURCE FILE * LS,P1,P2 * 15. SELECT LOAD-AND-GO * LG,P * 16. CHANGE DEVICE TIME-OUT PARAMETER * TO,N1 * TO,N1,N2 * 17. RELEASE PROGRAM'S TRACKS * RT,XXXXX * 19. SET BREAK FLAG * BR,XXXXX * 20. ABORT JOB REQUEST * AB * 21. RUN REQUEST * RU,XXXXX * RU,XXXXX,P1,...,P5 * 22. BUFFER LIMIT PRINT/CHANGE * BL OR BL,N1,N2 HED OPERATOR INPUT MESSAGE DECIPHER ROUTINE * * CALLING SEQUENCE * JSB $MESS * B CONTAINS NUMBER OF CHARACTERS * A IS THE BUFFER ADDRESS * * * * INPUT DECIPHER ROUTINE ROUTINE SCANS THE ASCII OPERATOR * INPUT AND STORES THE DATA INTO PARAMETERS. * THIS ROUTINE ASSUMES THE CHARACTER COUNT IN B ON ENTRY AND * DATA IN BUFFR. COMMA IS USED TO SEPARATE PARAMETERS. A PARA- * METER MAY BE UP TO 6 ASCII CHARACTERS- EXCEPT FOR OP CODE * WHICH MUST BE 2 CHARACTERS. A MAXIMUM OF 40 CHARACTERS MAY BE * INPUT. A COUNT IS KEPT OF THE NUMBER OF PARAMETERS INPUT AND * A CHARACTER COUNT IS KEPT FOR EACH PARAMETER. THE VALUES ARE * STORED LEFT ADJUSTED IN THE BUFFERS. * * $MESS NOP ENTRY/EXIT SZB,RSS IS COUNT ZERO JMP M0150 YES, SO EXIT JSB $PARS GO PARSE THE REQUEST BUFAD DEF PRAMS ADDRESS OF PRAMETER BUFFER SPC 2 * * THIS SECTION CHECKS THE OPERATOR REQUEST CODE AGAINST THE * LEGAL REQUEST CODES AND JUMPS TO THE PROPER PROCESSOR. ******************************************************************* * TO ADD NEW REQUEST ONE MERELY, * A. ADDS ASCII OPERATION CODE TO TABLE -LDOPC- * B. ADDS PROCESSOR START ADDRESS TO TABLE -LDJMP- * C. ADDS PROCESSOR CODING TO PROCESS THE REQUEST. ******************************************************************* * LDB OP OPERATION CODE INTO B STB OPP SET STOP FLAG LDA LDOPC E SET OPERATION TABLE POINTER STA TEMP1 LDA LDJMP SET OPERATION PROC. JUMP ADDRESS STA TEMP2 LDA P1 SEND P1 IN A REG. * UNL * CPB DBUG **********DEBUG********** * CLB,RSS **********DEBUG********** * JMP M0030 **********DEBUG********** * STB FLG **********DEBUG********** * ENT $JDDT **********DEBUG********** *JDDT JSB $DDT **********DEBUG********** * DEF $TYPE+2 **********DEBUG********** *BUG ASC 1,DB **********DEBUG********** * EXT $DDT **********DEBUG********** REP 7 NOP LST * M0030 CPB TEMP1,I COMPARE WITH TABLE VALUE JMP TEMP2,I COMPARES GO DO IT ISZ TEMP1 DOES NOT COMPARE-INCREMENT OP TABLE ISZ TEMP2 INCREMENT JUMP ADR. JMP M0030 GO TO COMPARE NEXT OP CODE * OPER LDA $OPER ILLEGAL OPERATION CODE REQUEST $MSEX EQU * JMP $MESS,I RETURN * * ****NOTE THAT $MEU IS THE STATUS OF MEU AT LAST*** ****INTERRUPT---IT IS SAVED IN $CIC BEFORE A ***** ****INTERRUPT FROM THE DUMMY CARD CAN COME IN***** ****AND CHANGE THE STATUS************************ * * * LDOPC DEF *+1 OPERATION CODE TABLE ADDRESS ASC 7,ONOFSSGOSTPRIT $ASTM ASC 7,TMDNUPLUEQTOTI ASC 4,BRRUBLRC ASC 2,PLLO OPP NOP OPCODE FOR CURRENT REQUEST LDJMP DEF *+1,I JUMP ADDRESS FOR EACH OPER. CODE DEF M0100 ON REQUEST DEF M0200 OF REQUEST DEF M0300 SS REQUEST DEF M0400 GO REQUEST DEF M0500 ST REQUEST DEF M0650 PR REQUEST DEF M0600 IT REQUEST DEF $TMRQ TM REQUEST DEF IODN DN REQUEST DEF $IOUP UP REQUEST DEF $LUPR LU REQUEST DEF $EQST EQ REQUEST DEF $CHTO TO REQUEST DEF $TIRQ TI REQUEST DEF M0725 BR REQUEST DEF M0408 RU REQUEST DEF $BLRQ BL REQUEST DEF RCOP RCqk REQUEST DEF AP000 PL REQUEST DEF AP010 LO REQUEST DEF OPER OPERATOR ERROR HED PARSE SUBROUTINE FOR OPERATOR MESSAGES * CALLING SEQUENCE: * LDA BUFFER ADDRESS * LDB CHARACTER COUNT * JSB $PARS * DEF PRAM BUFFER * -RETURN- * * THE PRAM BUFFER IS 33 WORDS LONG AND CONTAINS UP TO 8 * PRAMETER DESCRIPTERS FOLLOWED BY THE PRAMETER COUNT. * * EACH PARAMETER DESCRIPTER CONSISTS OF FOUR WORDS: * * WORD MEANING * 1 FLAG WORD 0=NULL PRAMETER * 1=NUMERIC PRAMETER * 2=ASCII PRAMETER * 2 0 IF NULL,VALUE IF NUMERIC,ASCII(1,2) IF ASCII * 3 0 IF NOT ASCII ELSE ASCII(3,4) * 4 0 IF NOT ASCII ELSE ASCII(5,6) * * TEMP USAGE IN PARSE SECTION: * * TEMPP = CHARACTER ADDRESS * TEMP = PARAMETER FLAG ADDRESS * TEMP1 = TEMP BUFFER FETCH ADD. * TEMP2 = TEMP BUFFER STORE ADD. * TEMP3 = LAST INPUT CHAR.+1 ADD. * TEMP4 = PARAMETER VALUE ADDRESS. * TBUF = DEF TEMP5 (6 LOCATIONS) * TEMP5 * TEMP6 * TMP * TEMPH * $WORK * WPRIO * ASCI * ASCI1 * TBUFS = DEF TEMP5+7 * ASCI2 = LAST CHARACTER OF PARAMETER * WSTAT = PARAM COUNT * $PARS NOP ENTRY/EXIT CLE,ELA MAKE CHARACTER ADD. STA TEMPP SET BUFFER CHAR ADD. ADA B COMPUTE END ADDRESS. STA TEMP3 AND SET IT. LDB DM32 CLEAR PARAMETER AREA STB TEMP LDB $PARS,I CLA MES1 STA B,I INB ISZ TEMP JMP MES1 * STA B,I CLEAR THE PRAM COUNT STB WSTAT SET ADDRESS OF PRAM COUNT DEC09 LDA TBUF INITIALIZE TEMP BUFFER ADDRESS STA TEMP1 STA TEMP2 * DEC10 LDB TEMPP GET THE BUFFER CHAR ADDRESS CPB TEMP3 IF NO MORE CHARACTERS JMP DEC60 GO PROCESS PRAM ISZ TEMPP STEP INPUT POINTER  CLE,ERB CONVERT TO WORD SET UP LOW IN E LDA B,I GET WORD FROM THE BUFFER SEZ,RSS CHECK IF TO EXAMINE UPPER/LOWER ALF,ALF UPPER, SO ROTATE TO LOWER BITS AND B377 MASK OFF ALL BUT LOW ORDER CPA COM SEE IF A COMMA JMP DEC60 YES CPA LASCI CHECK IF BLANK CHARACTER JMP DEC10 YES, SO SKIP CHARACTER LDB TEMP2 CHECK IF 6 CHARACTERS IN PRAM CPB TBUFS IF SO JMP DEC10 SKIP STORE STA TEMP2,I STORE THE CHARACTER STA ASCI2 SAVE THE LAST CHARACTER ISZ TEMP2 STEP FOR NEXT CHAR. * JMP DEC10 GO TO PROCESS NEXT CHARACTER * * ATTEMPT NUMERIC CONVERSION OF PRAM. * DEC60 LDA WSTAT,I FIRST SET UP POINTERS RAL,RAL TAKE 4 TIMES THE PRAM NUMBER ADA $PARS,I PLUS THE OP CODE ADDRESS-1 STA TEMP SET FLAG ADDRESS CLE,INA ONE MORE AND WE HAVE STA VALOC THE PRAMETER VALUE LOCATION LDA TEMP2 IF NO CHARACTERS CPA TBUF INPUT JMP DEC75 GO TRY NEXT ONE * * NOW TRY FOR A NUMBER * LDB TEMP1,I GET FIRST CHAR CPB DASH MINUS SIGN? ISZ TEMP1 YES, INCRE TO NEXT CHAR CPA TEMP1 (A) STILL = TEMP2 JMP DEC80 IF "-" WAS ONLY CHAR, THEN ASCII * LDB D10 SET UP CONVERSION BASE LDA ASCI2 CPA "B" IF B SUFFIX LDB D8 SET FOR BASE 8 STB TEMP4 SET BASE ISZ TEMP,I SET FLAG TO 1 FOR NUMBER DEC65 MPY VALOC,I BUMP THE CURRENT VALUE VALOC EQU *-1 LDB TEMP1,I GET THE NEXT CHAR. ADB DM58 IF GREATER THAN "9" SEZ,CLE,RSS THEN NOT A NUMBER ADB D10 IF LESS THAN "0" SEZ,CLE,RSS THEN JMP DEC80 NOT A NUMBER ADA B ACCUMULATE THE STA VALOC,I NUMBER ISZ TEMP1 STEP THE BUFFER ADDRESS Y LDA TEMP4 GET THE BASE TO A LDB TEMP1 AND THE NEXT CHAR. LOC. TO B CPB TEMP2 IF END THEN JMP DEC70 GO TO NEXT PRAM * INB IF BASE 8 CONVERSION CPB TEMP2 AND LAST CPA D10 CHAR. THEN DONE SO SKIP JMP DEC65 ELSE GO GET THE NEXT ONE * SPC 1 DEC70 LDB VALOC,I GET VALUE LDA TBUF,I IF NEG NUMBER, CPA DASH CMB,INB NEGATE VALUE STB VALOC,I STORE VALUE * DEC75 ISZ WSTAT,I COUNT THE PRAMETER LDA WSTAT,I IF LDB TEMP3 EOL OR CPB TEMPP 8 PRAMS LINE RSS THEN CPA D8 JMP DEC90 GO PROCESS JMP DEC09 ELSE GO GET NEXT CHARACTER SPC 1 DEC80 ISZ TEMP,I SET NOT NUMBER FLAG LDA AASCI FILL THE PRAM WITH BLANKS LDB VALOC PRAM ADDRESS TO B INB DON'T WORRY ABOUT FIRST WORD STA B,I SET SECOND WORD CLE,INB STEP TO THIRD WORD STA B,I SET THIRD WORD TO DOUBLE BLANK. LDB TBUF GET THE TEMP BUFFER POINTER DEC85 CPB TEMP2 END OF INPUT? JMP DEC70 YES GO PROCESS NEXT PRAM CPB STOP SIXTH CHAR YET? JMP DEC75 YES, END PARAM LDA B,I GET THE CHARACTER SEZ,RSS IF UPPER CHARACTER ALF,SLA,ALF ROTATE AND SKIP XOR VALOC,I LOWER ADD THE UPPER CHAR. XOR LASCI ADD/DELETE THE LOWER BLANK STA VALOC,I STORE THE PACKED WORD SEZ,CME,INB STEP B,SKIP IF UPPER ISZ VALOC ELSE STEP STORE ADDRESS. JMP DEC85 GO GET OTHER CHAR. SPC 2 DEC90 ISZ $PARS STEP RETURN ADDRESS JMP $PARS,I RETURN SPC 2 "B" OCT 102 ASCII "B" DASH OCT 55 ASCII "-" STOP DEF TEMP5+6 ASCII 6TH CHAR STOP HED MESSAGE PROCESSOR--ON,XXXXX COMMAND * * ON,XXXXX * ON,XXXXX,NOW * ON,XXXXX,P1,...,P5 * ON,XXXXX,NOW,P1,...,P5 * *  THE ON REQUEST FUNCTIONS AS FOLLOWS: * IF NO RESOLUTION CODE, THEN PROGRAM SCHEDULED. * IF -NOW- OPTION, THEN ENTER PROGRAM INTO TIME LIST * AND SET TIME VALUES TO CURRENT TIME PLUS 10 MSC * IF NOT ONE OF ABOVE, AND TIME VALUES ARE ZERO THEN * PROGRAM FUNCTIONS SAME AS -NOW- OPTION. * IF NOT ONE OF ABOVE, AND TIME VALUES ARE PRESENT, * THEN PROGRAM IS ADDED TO TIME LIST. * NOTE: ALL THE ABOVE OPTIONS ALLOW PARAMETERS TO BE * PASSED TO THE PROGRAM. THESE MUST BE ASCII * DECIMAL NUMBERS WHICH ARE CONVERTED TO BINARY * AND STORED IN ID SEGMENT TEMP AREA. UPON * EXECUTION, THE B REGISTER WILL POINT TO TEMP. * UP TO 5 PARAMETERS MAY BE INPUT. IF NO PARA- * METERS ARE INPUT, THE TEMP AREA ARE ZEROS BUT * B REGISTER WILL STILL POINT TO TEMP. AREA * M0100 JSB TTNAM FIND ID SEGMENT ADDR SZA CHECK IF PROGRAM DORMANT JMP M0405 ILLEGAL STATUS ERROR JSB PLOAD GO TO PROCESS CONTROL PRAMETERS LDB $WORK INDEX TO WORD 29 OF ADB D28 SCHEDULED PROGRAM LDA NRFL1 SET NEW-RUN FLAG AND STA B,I SET CONSOLE = LU 1 JMP $ONTM COMPLETE IN TIME MODULE, RETURN $MSEX HED MESSAGE PROCESSOR--OF,XXXXX COMMAND * OF,XXXXX * OF,XXXXX,1 "ABORT" * OF,XXXXX,8 "ABORT AND REMOVE FROM SYSTEM" * * THE OF REQUEST FUNCTIONS AS FOLLOWS: * IF PROGRAM DORMANT, IT MAY STILL BE IN TIME LIST SO REMOVE IT. * IF ABORT OPTION 1, CALL $ABRT PROCESSOR . * IF ABORT OPTION 8, CALL $ABRT AND CLEAR ID SEGMENT NAME. * IF PROGRAM SCHEDULED OR OPERATOR-SUSPENDED, THEN * DORMANT REQUEST MADE VIA LIST PROCESSOR AND PROCEED AS ABOVE. * IF PROGRAM STATUS NOT ONE OF ABOVE: * IF NOT ABORT OPTION, SET DORMANT BIT. * IF A76BORT OPTION, CHECK IF AVAILABLE MEMORY SUSPEND-- * IN WHICH CASE THE ABORT BIT IS SET AND $ABRT CALLED. * IF STATUS IS I/O SUSPEND, SET THE ABORT BIT. * IF INPUT SUSPENSION, SET ABORT BIT AND CALL $IOCL TO CLEAR I O * M0200 JSB TTNAM GO TO FIND ID SEG ADDR LDB $WORK GET ID SEG ADDRESS AND STB TEMPH SAVE IT IN LOCAL STORE LDA P2 GET PRAM TWO SZA IF NOT ZERO GO DO POWER THING JMP M0250 * JSB $SABR GO DO SOFT ABORT JMP $XEQ EXIT DONE * M0250 LDA WSTAT,I POWER ABORT SO AND D15 GET CURRENT STATUS SWP PUT ID-SEG. ADDRESS IN A,STAT IN B CPB D2 IF I/O SUSP THEN JMP $IOCL GO ABORT THE I/O * JSB $ABRT GO TO ABORT ROUTINE LDA P2 RELEASE PROG'S ID SEG? CPA D8 IF P = 8, RSS YES JMP $XEQ NO-SO RETURN * M0227 LDB TEMPH ADB D12 CLA STA B,I INB STA B,I INB LDA B,I SAVE THE OLD SHORT/LONG AND B77 FLAG STA B,I JMP $XEQ GO EXIT SPC 1 D12 DEC 12 HED MESSAGE PROCESSOR--SS,XXXXX COMMAND * * SS,XXXXX PROCESSOR * * THE SUSPEND REQUEST FUNCTIONS AS FOLLOWS: * IF PROGRAM DORMANT OR OPERATOR SUSPENDED, THEN * ILLEGAL STATUS ERROR * IF SCHEDULED, THEN OPERATOR SUSPEND VIA $LIST * IF OTHER THAN ABOVE, SET THE OPERATOR-SUSPEND BIT * IN STATUS. AND ALL THESE WONDERS ARE * BY $LIST. * M0300 JSB $LIST OCT 206 SCHED TO OPER-SUSP DEFP1 DEF P1 BY NAME SZA IF ERROR JMP $MSEX EXIT * LDA WSTAT,I SET THE NO PRAMS IOR B20K BIT STA WSTAT,I TO PREVENT PRAMS ON RESTART JMP M0150 EXIT SPC 2 B20K OCT 20000 HED MESSAGE PROCESSOR--GO COMMAND * * [rHFB GO,XXXXX * GO,XXXXX,P1,...,P5 * * THE CONTINUE FROM POINT OF SUSPENSION FUNCTIONS AS * FOLLOWS: * IF NOT OPERATOR SUSPEND: * BIT SET - REMOVE OPER-SUSP BIT IN STATUS * BIT NOT SET - ERROR EXIT FOR MESSAGE * IF OPERATOR SUSPEND, SCHEDULE PROGRAM * M0400 JSB TTNAM GO TO FIND ID SEG ADDR CPA D6 CHECK IF PROGRAM OPERATOR-SUSPEND JMP M0410 OPERATOR-SUSPEND--SO GO TO PROCESS LDA WSTAT,I NOT OPER SUSP - AND B1000 IS BIT SET? SZA,RSS ID FOUND? JMP M0405 NO, ERROR- XOR WSTAT,I YES, CLEAR BIT STA WSTAT,I M0150 CLA EXIT JMP $MSEX * M0405 LDA $ILST ILLEGAL STATUS MESSAGE ADDRESS JMP $MSEX EXIT * M0408 JSB TTNAM RUN COMMAND ROUTINE SZA IF NOT DORMANT JMP M0405 GIVE THE MESSAGE,ELSE DO IT * LDB $WORK INDEX TO WORD 29 OF ADB D28 SCHEDULED PROGRAM LDA NRFL1 SET NEW-RUN FLAG AND STA B,I SET CONSOLE = LU 1 * M0410 LDA D2 CHECK IF CONTROL PARAMETERS FOLLOW CPA PARAM RSS NO JSB PLOAD GO TO PROCESS CONTROL PARAMETERS JSB $LIST SCHEDULE PROGRAM OCT 301 JMP $MSEX * D28 DEC 28 NRFL1 OCT 100001 NEW-RUN FLAG SET AND LU 1 7H HED MESSAGE PROCESSOR--ST,XXXXX COMMAND * * ST,XXXXX PROCESSOR * * IF XXXXX = 0 NAME AND PARTITION# OF CURRENT PGM IS PRINTED * IF XXXXX > 0 NAME OF THE PGM IN PARTITION #XXXXX IS PRINTED * THE STATUS REQUEST OUTPUTS THE REQUESTED PROGRAM STATUS * IN THE FOLLOWING FORMAT: * PRPRP S R MMMM HR MN SC MS T * * PRPRP =PRIORITY * S = STATUS (0 THRU 6 * R = RESOLUTION CODE (0 THRU 4) * MMM = MULTIPLE VALUE * HR = NEXT START TIME -HR * MN = NEXT START TIME -MIN * SC = NEXT START TIME -SEC * MS = NEXT START TIME -10 MSEC * T = PRESENT IF PROGRAM IN TIME LIST * M0500 JSB TTNAM GO TO FIND ID SEGMENT ADDR JSB $CVT1 CONVERT STATUS TO ASCII. ALF,ALF MOVE TO HIGH HALF WORD STA BUFF4 STORE STATUS IN BUFFER. LDB DM28 STB BUFFR STORE CHARACTER COUNT IN BUFFER LDB $WORK ADB D6 PRIORITY ADDRESS LDA B,I JSB $CVT1 CONVERT PRIORITY TO ASCII LDB ASCI1 GET DIGITS 23-45 TO B-A RRL 8 34-52 IN B-A STB BUFF2 SET 34 LDB ASCI 1-52 IN B-A ALF,ALF 1-25 IN B-A RRL 8 12-5 IN B-A STB BUFF1 SET 12 STA BUFF3 SET 5 BLANK LDB TEMP6 RESTORE B TO PRIOR ADDRESS JMP $STRQ GO DO REST OF STATUS REQUEST SPC 1 DM28 DEC -28 SPC 1 SPC 2 INBUF BSS 22 MESSAGE INPUT BUFFER BUFFL EQU *-INBUF+*-INBUF LENGTH IN #CHARS SPC 2 * SYSTEM OUTPUT BUFFER & PARAMETER STORAGE * BUFFR EQU * SHOULD BE AT LEAST 15 WORDS LONG BUFF1 EQU BUFFR+1 BUFF2 EQU BUFFR+2 BUFF3 EQU BUFFR+3 BUFF4 EQU BUFFR+4 BUFF5 EQU BUFFR+5 BUFF6 EQU BUFFR+6 BUFF7 EQU BUFFR+7 BUFF8 EQU BUFFR+8 BUFF9 EQU BUFFR+9 BUF10 EQU BUFFR+10 BUF11 EQU BUFFR+11 BUF12 _EQU BUFFR+12 BUF13 EQU BUFFR+13 BUF14 EQU BUFFR+14 $MSBF EQU * ENTRY POINT TO THIS BUFFER PRAMS BSS 1 CHARACTER COUNT-OP CODE OP BSS 3 OPERATION CODE CP1 BSS 1 CHAR COUNT-PARAM 1 P1 BSS 3 PARAM 1 (UP TP 3 WORDS-6CHAR.) CP2 BSS 1 CHAR COUNT-PARAM 2 P2 BSS 3 PARAMETER 2 CP3 BSS 1 CHAR COUNT-PARAM 3 P3 BSS 3 PARAMETER 3 CP4 BSS 1 CHAR COUNT-PARAM 4 P4 BSS 3 PARAMETER 4 CP5 BSS 1 CHAR COUNT -PARAM 5 P5 BSS 3 PARAMETER 5 CP6 BSS 1 CHAR COUNT-PARAM 6 P6 BSS 3 PARAMETER 6 CP7 BSS 1 CHAR COUNT-PARAM 7 P7 BSS 3 PARAMETER 7 PARAM BSS 1 PARAMETER COUNTER * ENDT EQU * * ORG INBUF FORCE START-UP RECONFIGURATION CODE RECON STB RCNFB TO BE IN MESSAGE INPUT BUFFER LDA KEYWD AFTER SAVING POSSIBLE FLOPPY I/O CHANNEL STA KEY PREPARE TO SEARCH FOR MRCNF'S ID SEG * RCNLP LDA KEY,I SZA,RSS END OF KEYWORD LIST? JMP RCNEN YES, DIDN'T FIND MRCNF * ADA D12 INDEX TO NAME WORDS LDB A,I CPB RCNM CHAR1,2 MATCH? INA,RSS YES, SKIP JMP RCNID NO, TRY NEXT ID * LDB A,I CPB RCNM1 CHAR3,4 MATCH? INA,RSS YES, SKIP JMP RCNID NO, TRY NEXT ID * LDA A,I AND MASKU CPA RCNM2 CHAR5 MATCH? JMP RCNFD YES, FOUND MRCNF * RCNID ISZ KEY BUMP KEYWORD TABLE ADDR JMP RCNLP TO LOOK AT NEXT ID SEG * RCNFD LDA KEY,I ADA D7 INCR UP TO PRIM ENTRY ADDR LDB A,I STB RCNFA LDB RCNFB (B)=POSSIBLY THE FLOPPY I/O CHANNEL # JSB RCNFA,I CALL MRCNF (A)=PRIM ENT WORD ADDR IN ID SEG RCNEN CLA DONE RECONF OR NO MRCNF STA $STRT JMP $STRT JMP TO NOP (MIGHT SAVE A BP LINK) * RCNFA NOP RCNFB NOP RCNM ASC 1,MR M-R RCNM1 ASC 1,CN C-N RCNM2 OCT 43000 F-NULL D7 DEC 7 ENDO EQU ENDT-* NUMBER OF OVERLAYABLE WORDS LEFT ORR HED MORE OPERATOR COMMANDS * * * MESSAGE PROCESSOR--IT,XXXXX COMMAND * * IT,XXXXX * IT,XXXXX,R,MMM * IT,XXXXX,R,MMM,HR,MN * IT,XXXXX,R,MMM,HR,MN,SC * IT,XXXXX,R,MMM,HR,MN,SC,MS * * R=RESOLUTION CODE * 1= TEN MILLISECOND CODE * 2= SECONDS CODE * 3= MINUTES CODE * 4= HOURS CODE * MM= MULTIPLICATION FACTOR * HR= START HOURS * MN= START MINUTES * SC= START SECONDS * MS= START TENS OF MILLISECONDS * M0600 JSB TTNAM GO FIND ID SEG ADDR SZA PROG MUST BE DORMANT TO CONTINUE JMP M0405 ILLEGAL STATUS ERROR JMP $ITRQ GO TO OPTIONAL CLOCK MODULE SPC 2 * * RC,X COMMAND * RCOP AND C377 KEEP LEFT BYTE CLB,INB CPA ASL RC,L ? JMP RCL YES, SET $LCTU=1 * CPA ASR RC,R ? CLA,RSS JMP OPER NO, OPERATOR ERROR * STB $RCTU YES, SET $RCTU=1 JMP $MSEX RETURN * RCL STB $LCTU SET LEFT CTU INVALID CLA JMP $MSEX RETURN * C377 OCT 177400 ASL OCT 046000 "L" IN LEFT BYTE ASR OCT 051000 "R" IN LEFT BYTE $LCTU OCT 1 INIT TO INVALID DIRECTORY $RCTU OCT 1 INIT TO INVALID DIRECTORY * * PR,XXXXX,ZZ PROCESSOR * * THE PRIORITY CHANGE ROUTINE FUNCTIONS AS FOLLOWS: * IF PROGRAM STATUS OTHER THAN DORMANT, STATUS ERROR. * IF DORMANT, THEN PRIORITY VALUE CHANGED AND PROGRAM * LIST UPDATED VIA LINK PROCESSOR. * M0650 JSB TTNAM GO TO FIND ID SEG ADDR JMP $PRRQ CONTINUE IF WE HAVE OPTIONAL MODULE SPC 5 * MESSAGE PROCESSOR -- BR,XXXX REQUEST * * SET BREAK BIT IN PROGRAMS ID-SEGMENT * M0725 JSB TTNAM LOOK UP THE PROGRAM ADB D20 INDEX TO BREAK WORD LDA B,I GET WORD IOR B10K SET BREAK BIT STA B,I RESTORE THE WORD JMP M0150 EXIT SPC 5 IODN LDB CP2 SZB,RSS IS THERE A SECOND PARAM? CCB,RSS NO, SET (B)= -1 LDB P2 YES, SET (B)= PARAM JMP $IODN SPC 5 * PL,LU,OPT PROGRAM LIST COMMAND * AP000 CLB (A) = LU STB TEMPP SET FUNC = 0 LDB P2 STB P4 MOVE OPT TO P4 FOR LATER JMP AP100 GO SCHEDULE APLDR * * * LO,XXXXX,SC,CR-LU,PTTN#,SIZE * AP010 CLA,INA SET FUNC = 1 LDB P4 SZB INA SET FUNC = 2 IF PTTN# NOT ZERO CMB,SZB,RSS STB P4 CHANGE PTTN# TO 0 IF GIVEN -1 STA TEMPP SAVE FUNC * LDA P5 GET PTTN SIZE PARAM ALF,ALF SHIFT (EVENTUALLY) TO BITS 10:14 RAL,RAL IOR P4 FILL PTTN# IN BITS 0:5 STA P4 CLA NO LU PARAM IF 'LO' * AP100 ALF PUT LU IN BITS 4:9 IOR TEMPP MERGE FUNCTION TO BITS 0:3 STA TEMPP * LDB APLDR JSB $TNAM FIND APLDR'S ID SEG SZA,RSS JMP OPER CAN'T FIND APLDR, SO OPER ERR * LDA WSTAT,I STATUS OF APLDR AND D15 MUST BE DORMANT SZA JMP M0405 IT'S NOT * INB BUMP TO PARAM AREA OF APLDR'S ID SEG LDA TEMPP STA B,I SET LU/FUNC INB LDA P4 STA B,I SET SIZE/PTTN# OR OPT INB LDA P1 STA B,I SET NAM12 INB LDA P1+1 STA B,I SET NAM34 INB LDA P1+2 STA B,I SET NAM56 ADB D5 INCRE TO XB WORD IN ID SEG LDA $WORK INA STA B,I SET XB TO POINT TO TEMP1 ADB B20 INDEX TO WORD 27 LDA P2 STA B,I SET SC FOR 'LO' INB LDA P3 STA B,I SET CR-LU FOR 'LO' k{ INB LDA NRFL1 STA B,I SET NEW-RUN FLAG JSB $LIST SCHEDULE APLDR OCT 301 JMP $MSEX EXIT * APLDR DEF *+1 ASC 3,APLDR SPC 5 * * INPUT ERROR MESSAGE OUTPUT * * $INER LDA $ERIN INPUT ERROR MESSAGE JMP $MSEX RETURN SPC 2 * MESSAGE PROCESSOR CONSTANTS ETC. LASCI OCT 000040 ASCII BLANK IN LOW CHARACTER AASCI OCT 020040 ASCII BLANK IN BOTH CHAR MASKU OCT 177400 UPPER CHARACTER MASK (AND) KEY NOP TEMPORARY STORAGE NO ASC 1,NO ASCII NO FOR 'NOW' TEST * DEFP2 DEF *+1,I DEF P2 DEF P3 DP4 DEF P4 DP5 DEF P5 DP6 DEF P6 DP7 DEF P7 HED CONTROL PARAMETER STORE IN ID SEGMENT * * PLOAD NOP ENTRY/EXIT LDB DEFP2 GET INDIRECT DEF TO PRAMS LDA CP2 GET PRAM FLAG RAR,SLA IF ASCII "NO" LDA P2 ENTERED CPA NO THEN STEP PRAM ADDRESS FIRST TIME INB STEP PRAM ADDRESS LDA $WORK GET ID-SEGMENT ADDRESS JSB $PRAM GO SET PRAMS. JMP PLOAD,I RETURN * * SUBROUTINE TO SET UP THE PRAMETERS IN A PROGRAMS * ID-SEGMENT. PRAM SETS FIVE PRAMETERS AND THE B * REGISTER. IF THE NO PRAMETER FLAG IS SET NO * ACTION IS TAKEN. * * CALLING SEQUENCE: * * LDB PRAM ADDRESS (OR INDIRECT TO LIST OF ADDRESSES) * LDA ID-SEGMENT ADDRESS * JSB PRAM * * RETURN REGISTERS MEANING LESS. * $PRAM NOP INA STEP TO THE PRAM AREA STA TEMP SET IN TEMP ADA D9 STEP TO THE B-REGISTER STA TEMP1 ADDRESS AND SAVE ADA D5 STEP TO THE STATUS ADDRESS LDA A,I GET THE STATUS AND CHECK RAL,RAL THE NO PRAM ALLOWED BIT SSA IF SET THEN JMP $PRAM,I JUST EXIT * LDA TEMP GET THE PRAM AREA ADDRESS AND STA TEMP1,I SET IT IN THE B REG. SAVE AREA LDA DM5 $SET UP THE STA TEMP1 COUNTER PRAM1 CLA ZERO ADDRESS GETS A ZERO LDA B,I GET PRAM STA TEMP,I STUFF IT ISZ TEMP STEP STORE ADDRESS INB STEP SOURCE ADDRESS ISZ TEMP1 DONE? JMP PRAM1 NO- CONTINUE JMP $PRAM,I YES-EXIT HED MESSAGE PROCESSOR NAME SEARCH * * CALL TO NAME SEARCH ROUTINE * * CALLING SEQUENCE: * JSB TTNAM NAME ASSUMED TO BE IN P1 * * ON RETURN: * WORK CONTAINS THE ID-SEG. ADDRESS * WSTAT AND B CONTAIN THE STATUS ADDRESS * A CONTAINS THE LEAST 4 STATUS BITS. * E = 0 IF STANDARD ID SEGMENT * TTNAM NOP ENTRY/EXIT LDB DEFP1 ADDRESS OF ASCII PROG NAME JSB $TNAM CALL TO NAME SEARCH ROUTINE SZA,RSS IF ZERO, THEN PROG NOT FOUND JMP NXPRG SO TAKE GAS! LDA WSTAT,I GET STATUS TO A AND D15 MASK IT AND JMP TTNAM,I RETURN SPC 2 NXPRG LDA $NOPG NO SUCH PROG ERROR JMP $MSEX EXIT SPC 3 * SEARCH KEYWORD LIST FOR PROGRAM NAME * * ON ENTRY * B IS ADDRESS OF ASCII PROGRAM NAME * ON RETURN * A IS 0 IF PROGRAM NOT FOUND (E=1) * B IS ID SEGMENT ADDRESS OF REQUESTED PROGRAM * E = 0 IF STANDARD ID SEGMENT * E = 1 IF ID SEGMENT NOT FOUND * $TNAM NOP ENTRY/EXIT STB TEMP3 ADDRESS OF NAME 1 AND 2 INB INCR TO CHAR 3 AND 4 ADDR STB TEMP4 SAVE IT INB INCR TO CHAR 5 ADDR LDA B,I ASCII NAME CHAR 5 AND X AND MASKU MASK OFF X STA TEMP5 SZA IF NULL CHAR. FOURCE ERROR RETURN LDA KEYWD STA KEY TOP OF KEYWORD LIST TN005 LDA KEY,I CHECK IF AT END OF LIST CCE,SZA,RSS JMP $TNAM,I END OF LIST ERROR RETURN ADA D12 LDB A,I ID SEG ASCII NAME CHARS 1 AND 2 CPB TEMP3,I COMPARE WITH REQUESTED CHAR 1s,2 INA,RSS COMPARES JMP TN030 DOES NOT COMPARE-GO TO NEXT PROG LDB A,I ID SEG ASCII NAME CHARS 3 AND 4 CPB TEMP4,I COMPARE WITH REQUESTED CHARS 3,4 CLE,INA,RSS COMPARES JMP TN030 DOES NOT COMPARE-GO TO NEXT PROG STA WSTAT SET UP WSTAT IN CASE LDA A,I ID SEG ASCII NAME CHARS 5,X AND MASKU MASK OFF X CPA TEMP5 COMPARE CHARACTER 5 JMP TN040 COMPARES-SO PROGRAM FOUND * TN030 ISZ KEY INCREMENT KEYWORD ADDRESS JMP TN005 GO TO COMPARE CHARACTERS TN040 LDB KEY,I LOAD B WITH ID SEGMENT ADDRESS STB $WORK SET IN WORK ISZ WSTAT STEP TO STATUS ADDRESS AND JMP $TNAM,I EXIT HED CVT3 (BINARY TO ASCII CONVERSION) * BINARY TO ASCII CONVERSION ROUTINE * CALLING SEQUENCE * SET E TO 0 IF OCTAL CONVERSION OR * E TO 1 FOR DECIMAL CONVERSION * LDA NUMBER TO BE CONVERTED * JSB $CVT3 * RETURNS ADDRESS OF ASCI IN A AND E=1. * RESULTS IN ASCI, ASCI+1, ASCI+2 * LEADING 0'S SUPPRESSED * $CVT3 NOP ENTRY/EXIT STB TEMP6 SAVE B REGISTER LDB PTTE INIT LOCATION OF BUFFER STB TMP LDB AASCI SET BUFFER=ASCII BLANK'S STB ASCI STB ASCI1 STB ASCI2 LDB DF10 ASSUME BASE TEN SEZ,CLE,RSS IF BASE EIGHT INB SET UP FOR BASE EIGHT STB BASE SET CONVERSION BASE ADDRESS DPCRL CLB START CONVERSION DIV BASE DIVIDE BY BASE BASE EQU *-1 DEFINE BASE ADDRESS ADB B20 CONVERT TO ASCII-BLANK SEZ IF HIGH DIGIT BLF,BLF ROTATE ADB TMP,I ADD CURRENT VALUE STB TMP,I STORE THE CONVERTED VALUE CCB,SEZ PREPARE FOR SUBTRACT ADB TMP IF HIGH CHAR. BACKUP SEZ,CME BUFFER POINTER STB TMP AND RESET SZA IF MORE DIjGITS JMP DPCRL GO SET THE NEXT ONE * CCE SET E FOR NEXT CALL (ASSUME BASE 10) LDA PTT LOAD A WITH ASCI BUFFER ADDRESS LDB TEMP6 RESTORE B JMP $CVT3,I RETURN * B20 OCT 20 DF10 DEF D10 D10 DEC 10 D8 DEC 8 PTT DEF ASCI PTTE DEF ASCI2 * * $CVT1 CALLING SEQUENCE: SAME AS $CVT3 * RETURN RESULTS LEAST TWO DIGITS IN A, REST SAME AS $CVT3 * $CVT1 NOP JSB $CVT3 GO CONVERT THE NUMBER LDA ASCI2 GET LEAST TWO DIGITS JMP $CVT1,I RETURN HED OUTPUT *_ ON SYSTEM TELETYPE ******************************************************************* * THE $TYPE SECTION FUNCTIONS AS FOLLOWS: * ENTRY IS MADE BY STRIKING ANY SYSTEM TELETYPE KEY. * IF TELETYPE FLAG NOT BUSY, THEN * IS OUTPUT AND A * REQUEST IS MADE FOR INPUT. IF FLAG IS SET THEN * IGNORE REQUEST. UPON COMPLETION OF INPUT (LF), * THE MESSAGE PROCESSOR ROUTINE IS CALLED. * UPON RETURN, IF A REGISTER IS ZERO THEN NO * MESSAGE TO BE OUTPUT. IF A NON-ZERO, THEN A IS * ADDRESS OF MESSAGE TO OUTPUT WITH CHARACTER * COUNT THE FIRST WORD IN BUFFER. ******************************************************************* * $TYPE LDA FLG CHECK SYSTEM TTY FLAG SZA JMP $XEQ BUSY, SO RETURN TO $XEQ * JSB $XSIO CALL TO OUTPUT ASTERISK(*) OCT 1 ON SYSTEM TELETYPE NOP NOP OCT 2 DEF ASTRK DM4 DEC -4 OUTPUT CHARACTER COUNT OCT 0 SAYS DON'T NEED USER MAP * JSB $XSIO CALL TO REQUEST OPERATOR INPUT OCT 1 DEF TYP10 INPUT COMPLETION ADDRESS NOP OCT 401 INPUT WITH TYPEOUT IBUF DEF INBUF ABS -BUFFL DETERMINED BY $STRT ROUTINE OCT 0 DONT NEED USER MAP ISZ FLG SET SYSTEM TTY BUSY FLkAG JMP $XEQ GO TO $XEQ * TYP10 CLA CLEAR THE COM FLAG STA FLG LDA IBUF GET BUFFER ADDRESS TO A JSB $MESS GO TO MESSAGE PROCESSOR ROUTINE SZA,RSS CHECK IF MESSAGE TO BE OUTPUT JMP TYP30 NO MESSAGE-SO GO RETURN * ISZ FLG SET THE COM FLAG LDB A,I STB TYP26 BRS CONVERT CHARACTER COUNT TO NEG. WORDS CMB,INB STB TYPCO SAVE WORD COUNT LDB IBUF GET DEST. ADDR INA GET SOURCE ADDR * JSB .MVW MOVE THE MESSAGE DEF TYPCO NOP * JSB $XSIO CALL TO OUTPUT ERR MESSAGE OCT 1 DEF TYP30 COMPLETION ADDRESS TYPCO NOP OCT 2 DEF INBUF TYP26 NOP OCT 0 DONT NEED USER MAP JMP $XEQ GO TO $XEQ * TYP30 CLA CLEAR SYSTEM FLAG FOR NEXT STA FLG REQUEST JMP $XEQ * * ASTRK OCT 006412 CR, LF ASC 1,*_ ASTERISK, LEFT ARROW HED $ABRT ROUTINE TO ABORT A PROGRAM * ROUTINE: < $ABRT > * * PURPOSE: THIS ROUTINE PROVIDES FOR REMOVING * A USER PROGRAM FROM EXECUTION USUALLY * AFTER AN ERROR CONDITION IS DETECTED * WHICH PROHIBITS CONTINUED EXECUTION. * THE PROGRAM IS SET TO THE DORMANT * STATE, TIME INTERVAL REMOVED AND ANY * DISC TRACKS ASSIGNED TO THE PROGRAM * RELEASED. * * THE PROGRAM NAME IS SET IN THE MESSAGE * "XXXXX ABORTED" WHICH IS PRINTED * ON THE SYSTEM TELETYPE. * * CALL: (A) = ID SEGMENT ADDRESS * (P) JSB ABORT * (P+1) -RETURN- (REGISTERS MEANINGLESS) * $ABRT NOP SET ID SEGMENT ADDRESS STA TEMPH FOR $SABR CALL ADA D15 INDEX TO THE STATUS WORD LDB A,I GET THE WORD ADB B4000 SET THE ABORT BIT STB A,I RESET THE STATUS WORD LDB TEMPH SET B AND CALL isJSB $SABR THE SOFT ABORT ROUTINE LDB TEMPH SET (B) = ADDRESS OF 3-WORD ADB D12 PROGRAM NAME IN ID SEGMENT. LDA B,I SET STA ABM PROGRAM INB NAME LDA B,I IN STA ABM+1 MESSAGE INB LDA B,I AND MASKU MASK OUT THE LOWER CHARACTER IOR LASCI REPLACE WITH A BLANK STA ABM+2 LDA ABMA PRINT MESSAGE: JSB $SYMG "XXXXX ABORTED" JMP $ABRT,I -EXIT- * ABMA DEF *+1 DM13 DEC -13 ABM ASC 7,EDIT ABORTED SPC 1 HED MEMORY PROTECT VIOLATION SCHEDULER PREPROCESSORS D20 DEC 20 * $WATR NOP LDA B ADB D20 LDB B,I BLF,BLF RBR,SLB JSB $SCD3 SCHEDULE IF ANY WAITING JMP $WATR,I RETURN SPC 2 * * PROGRAM SUSPEND REQUEST * $MPT2 EQU * JSB $LIST OCT 506 OPERATOR SUSPEND REQUEST * $MPT8 EQU * MEM15 LDA RQRTN STA XSUSP,I SET RETURN POINT JMP $XEQ * SPC 3 * * * $SCD3 SCHEDULES PROGRAMS IN THE WAIT LIST (STATUS-3) * WHICH ARE WAITING FOR THE GIVEN RESOURCE. * * CALLING SEQUENCE: * * LDA RESOURCE FLAG (CONTENTS OF XTEMP OF WAITER) * JSB $SCD3 * RETURN - B,E = 0 A = ? * $SCD3 NOP STA TEMPR SAVE THE RESOURCE ID FLAG LDB SUSP2 GET THE LIST HEAD SCD31 CLE,SZB,RSS IF END OF LIST JMP $SCD3,I RETURN * LDA B GET THIS ENTRIES INA FLAG FROM LDA A,I HIS ID-SEGMENT CPA TEMPR THIS ONE?? JMP SCD32 YES GO RESCHEDULE * LDB B,I NO GET NEXT ENTRY TO B JMP SCD31 AND GO TEST IT. * SCD32 LDA B,I GET THE NEXT ID IN LIST STA TEMPQ AND SAVE IT JSB $LIST SCHEDULE THE PROGRAM OCT 401 WHOSE ID-SEGMENT ADDRESS IS IN B LDB TEMPQ GET NEXT ID TO B JMP SCD31 SCAN THE REST OF THE LIST * TEMPR NOcB@

lB ^) 92064-18002 1726 S C0122 &MEX10 MI EXECUTIVE             H0101 JwASMB,R,L,C ** RTE-M I EXECUTIVE MODULE ** * * NAME : $MEX1 * SOURCE: 92064-18002 * RELOC: PART OF 92064-16001 * PROGMR: E.J.W. BASED ON RTE-III VERSIONS G.A.A.,L.W.A.,D.L.S. * * **************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT * * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * **************************************************************** * * NAM $MEX1 92064-16001 REV.1726 770512 * * ENT EXEC,$ERMG,$RQST ENT $LIBR,$LIBX ENT $ERAB,$PVCN,$REIO,$RSRE,$ABRE ENT $PWR5 * EXT $CVT3,$SYMG,$LIST,$XEQ,$IRT EXT $RENT,$ABRT,$SCD3 EXT $SCLK,$MPFT SUP A EQU 0 B EQU 1 MIC SVR,105620B,2 MIC RSR,105621B,2 * ***** < EXEC > PROGRAM DESCRIPTION ***** * * THE PRIMARY FUNCTION OF THIS PROGRAM IS * TO PROVIDE GENERAL CHECKING AND EXAMINATION * OF SYSTEM SERVICE REQUESTS AND TO CALL THE * APPROPRIATE PROCESSING ROUTINE IN OTHER * SECTIONS OF THE REAL-TIME EXECUTIVE. * * THIS PROGRAM IS CALLED DIRECTLY FROM THE * CENTRAL INTERRUPT CONTROL SECTION * WHEN A MEMORY PROTECT VIOLATION IS ACKNOWLEDGED. * ALL SYSTEM REQUESTS BY A USER PROGRAM CAUSE A * PROTECT VIOLATION. * * SYSTEM REQUEST FORMAT: * ---------------------- * * THE GENERAL FORMAT OF A SYSTEM REQUEST IS * A BLOCK CONTAINING AN EXECUTABLE INSTRUCTION * TO GAIN ENTRY TO THE EXECUTIVE AND AN ADDRESS * LIST OF PARAMETERS. THE FIRST PARAMETER IS * A NUMERIC CODE IDENTIFYING THE REQUEST TYPE. * THE LENGTH OF THE PARAMETER LIST VARIES * ACCORDING TO THE AMOUNT OF INFORMATION RE- * QUIRED FOR EACH REQUEST (OR VARIATIONS WITHIN * A SINGLE REQUEST). THIS FORMAT ALLOWS SYSTEM * REQUESTS TO BE SPECIFIIED IN A FORTRAN CALL * STATEMENT IN ADDITION TO ASSEMBLY LANGUAGE FORMAT. * * CALL EXEC (P1,P2,...PN) * * OR * * EXT EXEC * JSB EXEC (CAUSES MEMORY PROTECT VIOLATION) * DEF *+1+N DEFINE EXIT POINT, N= # PARAMETERS * DEF RCODE DEFINE REQUEST CODE * DEF P1 DEFINE PARAMETER LIST, 1 TO N * . * . (PARAMETERS MAY BE INDIRECTLY * . REFERENCED, E.G. DEF P3,I) * DEF PN * - EXIT POINT - * * RCODE DEC N * P1 DEC/OCT/DEF,ETC TO DEFINE A VLAUE * * * RE-ENTRANT LIBRARY REQUEST * -------------------------- * * THE SYSTEM LIBRARY (RESIDENT) CONTAINS * PROGRAMS STRUCTURED IN 'RE-ENTRANT' FORMAT * OR IN 'PRIVILEGED' EXECUTION FORMAT. * * - RE-ENTRANT FORMAT ALLOWS A LIBRARY * PROGRAM TO BE RE-ENTERED BY A CALL FROM * A HIGHER-PRIORITY PROGRAM DURING THE * PROCESSING OF A CALL FROM A LOWER-PRIORITY * PROGRAM. * * - PRIVILEGED EXECUTION FORMAT ALLOWS A * SHORT-RUNNING LIBRARY PROGRAM TO BE EXECUTED * WITH THE INTERRUPT SYSTEM DISABLED. * * * * MEMORY PROTECT ERROR: * --------------------- * * IF THE INSTRUCTION CAUSING THE PROTECT VIOLATION * IS NOT A JSB EXEC OR A JSB TO LIBRARY * PROGRAM, THEN A USER PROGRAM ERROR IS * ASSUMED. A DIAGNOSTIC IS OUTPUT TO THE SYSTEM * TELETYPE LISTING THE PROGRAM NAME AND ADDRESS * OF VIOLATING INSTRUCTION AND THE PROGRAM IS * SET DORMANT IN THE PROGRAM ABORT PROCEDURE. * SKP ************DMS INSTRUCTIONS***************** * $RQST LIB 5 GET ADDRESS OF VIOLATION. LIA 4 DO NOT REARRANGE!!! CPA D4 POWER FAIL? LDB $PWR5 YES, USE LAST INTERRUPT ADDR. STF 5 REENABLE PARITY ERROR OPTION. STB XSUSP,I SET POSSIBLY DIFFERENT ADDR HLT 5 SIGNAL MP OR PARITY ERROR JMP $IRT PRESSED 'RUN' TO IGNORE IT * RQP2A DElF RQP2 VADR NOP $PWR5 NOP ADDR OF INTERRUPT BEFORE POWER FAIL DM9 DEC -9 $SGAF NOP * EXEC NOP ENTRY-EXIT CLF 0 DISABLE INTERRUPT SYSTEM STA XA,I CLA,INA JSB PRVIO ALLOW PRIV-I/O, SAVE REGS. LDB EXEC SAVE RETURN STB $LIBR ADDRESS ADB DM1 SAVE CALL ADDRESS STB XSUSP,I AS POINT OF SUSPENSION * * * ANALYZE SYSTEM REQUEST * R0 LDA $LIBR,I (A) = RETURN ADDRESS OF JSB EXEC. ISZ $LIBR SET $LIBR TO FIRST PRAM. (RQ) ADDRESS. STA RQRTN SAVE IN BASE PAGE LDB $LIBR CACULATE THE NUMBER OF CMB,CLE PARAMETERS IN REQUEST ADB A LESS THE REQUEST CODE. STB RQCNT AND SAVE # OF ACTUAL PARAMETERS. STB A STB CNT CMB,SEZ,CME SKIP IF RETURN IS BAD (< JSB +2) * ADA DM9 CLA,SEZ JMP RQERR ERROR IF >8. * STA RQP2 ZERO STA RQP3 PARAMETER STA RQP4 STA RQP5 ADDRESS STA RQP6 STA RQP7 AREA STA RQP8 STA RQP9 * * * CHECK LEGALITY OF REQUEST CODE * LDA $LIBR GET ADDR OF THE REQ PARAM LDA A,I RAL,CLE,SLA,ERA REMOVE INDIRECTS JMP *-2 LDA A,I GET ACTUAL REQ CODE LDB XEQT COMPUTE ADB D15 THE STATUS WORD STB TEMP3 ADDRESS AND SAVE LDB B,I GET STATUS RAL,CLE,ERA PUT ABORT OPTION BIT RBL,ERB IN SIGN OF STATUS STB TEMP3,I AND RESET IN ID-SEG. SSB IF OPTION SELECTED ISZ RQRTN STEP RETURN ADDRESS. STA RQP1 SAVE THE REQUEST CODE. SZA IF ZERO SKIP TO REJECT ADA CODE# IF RQUEST CODE IF NOT DEFINED SSA,RSS -THEN JMP RQERR TOUGH LUCK, YOU'RE A DEAD DUCK! * ADA RQTBL GET ADDRESS OF PROCESSOR TO A LDA A,I GET ADDRESS SZA,RSS +IF NOT LOADED JMP RQERR THEN REQUEST CODE ERROR * STA VADR SAVE THE ADDRESS * * TEST EACH PRAMETER FOR BEING BELOW THE FENCE IF * THE CALL CAUSES A STORE TO THE AREA DEFINED. * LDB RQP1 USE REQUEST CODE CLE,ERB TO INDEX INTO ADB RQTBL THE BY NAME TABLE LDA B,I GET THE FLAG WORD SEZ,RSS IF EVEN REQUEST, ROTATE BITS ALF,ALF TO USE HIGH HALF STA FLAGS * ISZ $LIBR LDA $LIBR GET ADDR OF 2ND PARAM LDB RQP2A GET ADDR OF 2ND BP PARAM MIC1 JMP NOMC2 -LRR- IF HAVE MICROCODE * OCT 105622 MACRO CALL FOR LRR CNT OCT 0 COUNT OF PARAMS LEFT FLAGS OCT 0 BITS FOR PARAM ADDR CHECK DEF FENCE ADDR OF FENCE WORD RSS ERROR RETURN JMP VADR,I SUCCESSFUL RETURN * SZB,RSS JMP $ERAB JMP RQERR * NOMC2 STB TEMP2 SAVE BP PTR LDA CNT CMA,INA,SZA,RSS NEGATE COUNT JMP VADR,I DO REQ. IF 0 PARAMS STA CNT * R3 LDA $LIBR GET ADDR OF PARAM ADDR R1D1 LDA A,I GET ACTUAL PARAM ADDR SZA CPA D1 IS IT POINTING TO A OR B REGS? JMP RQERR YES, ERROR. RAL,CLE,SLA,ERA INDIRECT? JMP R1D1 GO GET DIRECT ADDR * STA TEMP2,I SAVE DIRECT ADDR ON BP CMA,CLE READY TO SUBTR FROM FENCE LDB FLAGS SLB,RBR NEED TO TEST AGAINST MP FENCE? ADA FENCE YES, SUBTRACT STB FLAGS SAVE SHIFTED FLAG BITS CLB,SEZ PARAM ADDR < FENCE? JMP ER1 YES, RQ00 ERROR * ISZ $LIBR INCRE TO NEXT USER PARAM ISZ TEMP2 INCRE TO NEXT BP LOC ISZ CNT DONE YET? JMP R3 NO JMP VADR,I YES, DO THE REQUEST * ER1 LDA RQ1 SET A FOR ERROR JMP $ERAB GO SEND 'RQ00' ERROR SPC 1 D1 DEC 1 D2 DEC 2 D15 DEC 15 DM1 DEC -1 CODE# ABS TBL-kTBLE-1 NEGATIVE OF NUMBER OF REQUEST+1 RQTBL DEF TBLE ADDRESS INDIRECT OF LAST + 1. HED ** SUPERVISORY CONTROL OF LIBRARY PROGRAM EXECUTION ** * * SUPERVISORY CONTROL OF PROGRAM LIBRARY EXECUTION * * ALL LIBRARY PROGRAMS REFERENCED BY USER PROGRAMS * IN THE SYSTEM ARE COMBINED IN A BLOCK OF MEMORY * WHICH IS PROTECTED FROM THE REAL-TIME AREA. THE * LIBRARY AREA IS IMMEDIATELY BELOW THE RT AREA * AND JUST ABOVE THE SYSTEM AREA. * * A USER LIBRARY CALL CAUSES A PROTECT VIOLATION. * THIS SECTION FACILITATES ENTRY INTO THE LIBRARY * PROGRAM BY PERFORMING THE NECESSARY PROCESSING * FOR RE-ENTRANCY OR OPERATING THE PROGRAM WITH H= * THE INTERRUPT SYSTEM TURNED OFF FOR A 'PRIVILEGED' * EXECUTION PROGRAM. * * RE-ENTRANT OR PRIVILEGED PROGRAM FORMAT: * ---------------------------------------- * * ENTRY NOP * JSB $LIBR * DEF TDB (OR 'NOP' IF PRIVILEGED) * - FIRST INSTRUCTION FOR FUNCTION - * - CODE * - TO * - PERFORM * - PROGRAM FUNCTION * EXIT JSB $LIBX * DEF TDB (OR DEF ENTRY IF PRIVILEGED) * DEC N RETURN ADJUSTMENT FOR RE-ENTRANT * - * TDB NOP HOLDS SYSTEM POINTER TO ID-EXTENSION. * DEC N LENGTH OF TEMPORARY DATA BLOCK * NOP RETURN ADDRESS OF CALL. * - BLOCK USED FOR * HOLDING TEMPORARY * VALUES GENERATED * BY THE ROUTINE. * * * < $LIBR> IS ENTERED WHEN A LIBRARY * PROGRAM IS CALLED. IF THE CALLED * PROGRAM IS 'RE-ENTRANT' AND IS CALLED * DURING THE PROCESSING OF A PREVIOUS * CALL, THE TEMPORARY-DATA-BLOCK IS * MOVED INTO A BLOCK IN AVAILABLE MEMORY * BEFORE THE ROUTINE IS ENTERED. * * * * *CALLING SEQUENCES: ENTRY TERMINATION * *PRIVILEGED: JSB $LIBR JSB $LIBX * NOP DEF (PROGRAM ENTRY PT) * *RE-ENTRANT: JSB $LIBR JSB $LIBX * DEF TDB DEF TDB * DEC 0 OR 1 * * BASIC ASSUMPTION: PRIVILEGED ROUTINES MAY NOT CALL * RE-ENTRANT ROUTINES * * $LIBR NOP CLF 0 TURN OFF INTERRUPTS STA XA,I SAVE A-REG LDA $LIBR,I GET TYPE OF $LIBR CALL IN (A) JSB PRVIO LET PRIV-I/O CONTINUE LDA $LIBR,I ALL REGS SAVED FOR $LIBR RENT ISZ $LIBR STEP TO RETURN ADDR SZA WHAT KIND OF $LIBR CALL? JMP LRRNT RE-ENTRANT, TDB ADDR IN A * LDA XA,I PRIVILEGED CALL ISZ $PVCN BUMP DEPTH COUNTER JMP $LIBR,I ENTER PRIVILEGED SUBROUTINE * LRRNT STA TEMP1 SAVE TDB ADDR LDA $PVCN SZA TRY TO GO RE-ENTRANT WHILE PRIVILEGED? JMP ERE01 YES, ABORT PROG * LDB TEMP1,I GET TDB WORD 1 SZB,RSS WAS SUBR ALREADY ENTERED? JMP LRENT NO, ENTER NOW * LDA XEQT IF SUBR ENTERED BY THIS PROG EARLIER, ADA D20 THEN IGNORE BUSY FLAG CPA B THIS ALLOWS A PROG TO COMMIT RECURSION JMP LRENT (FORBIDDEN, BUT NO CHECK IS MADE) * LDA B,I GET TDB OWNER'S ID SEG WORD 21 AND B2000 SZA IS IT STILL IN RE-ENTRANT CODE? JMP LRWAT YES, WAIT TILL IT'S DONE * LRENT LDB XEQT ADB D20 STB TEMP1,I SET TDB OWNER'S ID ADDR WORD 21 LDA B,I IOR B2000 SET REENTRANT BIT (BIT 10) STA B,I IN OWNER'S ID STATUS WORD LDB TEMP1 ADB D2 (B) = ADDR OF TDB WORD 3 LDA $LIBR ADA N3 LDA A,I (A) = RETURN ADDR FROM SUBR STA B,I SAVE RETURN ADDR IN TDB LDA $LIBR CHANGE POINT OF SUSPENSION STA XSUSP,I TO EXECUTE SUBR JMP $RENT * LRWAT LDA $LIBR CALCULATE ADDR OF CALL TO ADA N3 THE BUSY RE-ENTRANT SUBROUTINE CCB ADB A,I P STB XSUSP,I AND SET AS POINT OF SUSPENSION LDA TEMP1,I FOR NEW-COMERS TO WAIT FOR STA XTEMP,I CURRENT TDB OCCUPANT TO FINISH JSB $LIST SUSPENSION IN THE GENERAL WAIT LIST OCT 503 (1ST TEMP = ID WORD 21 OF OCCUPANT) JMP $XEQ * * * $LIBX NOP CLF 0 TURN OFF INTERRUPTS STA XA,I SAVE A-REG LDA $PVCN SZA,RSS EXIT FROM PRIV-SUB MODE? JMP LXRNT NO, EXIT REENTRANT MODE. * CLA EXIT PRIV-SUB JSB PRVIO LET PRIV I/O GO LDA $PVCN SUBTRACT ONE FROM COUNT CMA,INA WITH OUT AFFECTING CMA,SZA,RSS "E" ($PVCN >0 ) JMP LXPRX IF NOT STILL PRIV. JMP * STA $PVCN STILL PRIV. SET THE COUNTER BACK LDA $LIBX,I TRACK DOWN THE RETURN LDA A,I ADDRESS STA $LIBX AND SET IT LDA XA,I RESTORE A AND JMP $LIBX,I RETURN TO LIBRARY AREA * LXPRX STA $PVCN RETURN NON PRIV. SET COUNTER LDA $LIBX,I GET THE LDA A,I RETURN ADDRESS STA XSUSP,I AND SAVE IT LDA XA,I JSB SAVER SAVE REGISTERS JMP $RENT RETURN TO USER * * * RE-ENTRANT PROGRAM RETURNING TO USER CALL. * LXRNT CLA,INA (A)#0 FOR SAVE REGS JSB PRVIO AND LET PRIV-I/O CONTINUE. LDB $LIBX,I SET -TDB- ADDRESS. STB TEMP1 IN TEMP1. ISZ $LIBX SET TO (P+2) OF CALL TO -$LIBX-. ADB D2 GET LDA B,I RETURN POINT ADJUSTMENT. ADA $LIBX,I ADD TO (P+1) OF LIBRARY CALL STA XSUSP,I AND SET FOR RETURN TO USER. * LDB TEMP1,I GET OWNER'S ID WORD 21 ADDR CMA,CLE,INA ADA $SGAF SEZ IS RETURN TO RES.LIB. AREA? JMP LXAGN YES, DON'T CLEAR RENT BIT * LDA B,I NO, CLEAR RENT BIT, GO BACK TO USER XOR B2000 CLEAR REENTRANT BIT OF STA B,I OWNER'S ID STATUS WORD * LXAGN CLA )STA TEMP1,I CLEAR CURRENT TDB OCCUPANT WORD LDA B JSB $SCD3 RESCHEDULE WAITERS JMP $XEQ RETURN VIA DISPATCHER * * $PVCN NOP TEMP1 NOP TEMP2 NOP TEMP3 NOP N3 DEC -3 D20 DEC 20 B2000 OCT 2000 * * * SUBROUTINES: AND USED FOR * SAVING AND RESTORING REGISTERS * IN LIBRARY PROGRAM PROCESSING. * SAVER NOP MIC3 JMP MIC4 OR STA XA,I IF NO MICRO STB XB,I ERA,ALS SOC INA STA XEO,I MX3 JMP SAVER,I RETURN IF NOT MX, CXA IF MX DST XI,I JMP SAVER,I * MIC4 SVR XA,I XI,I SAVE REGS MICRO CALL JMP SAVER,I RETURN * RSTR NOP MIC5 JMP MIC6 OR LDA XEO,I IF NO MICRO CLO SLA,ELA STF 1 MX4 JMP NMX4 IF NOT MX, DLD IF MX DEF XI,I CAX CBY NMX4 LDA XA,I LDB XB,I JMP RSTR,I RETURN * MIC6 RSR XA,I XI,I RESTORE REGS MICRO CALL JMP RSTR,I RETURN * * PRVIO CALLING SEQUENCE * CLF 0 TURN OFF INTERRUPTS * STA XA,I SAVE A-REG * LDA OPT =0 NO SAVE REGS, #0 SAVE ALL REGS * JSB PRVIO CALL PRVIO * (A) AND (B) MEANINGLESS ON RETURN * PRVIO NOP ENABLE PRIV-I O AND SZA,RSS SAVE REGS IF (A)#0 JMP SW1 JUST TURN OFF INTERRUPTS * LDA XA,I SAVE ALL REGS JSB SAVER * SW1 JMP PRVIO,I OR STC DUMMY CLC 6 CLC 7 STF 0 REENABLE INTS FOR PRIV-I/O CARDS JMP PRVIO,I RETURN * * $REIO NOP DUMMY $REIO ROUTINE FOR RTIOC CALL JMP $REIO,I * $RSRE NOP DUMMY $RSRE ROUTINE FOR DISPA CALL JMP $RSRE,I * $ABRE NOP CLEAN UP RE-ENTRANT STUFF WHEN ADB D20 A PROGRAM IS ABORTED LDA B,I GET WORD 21 OF ID SEG AND B2000 SZA,RSS WAS PROG IN RE-ENTRANT CODE? JMP $ABRE,I NO, RETURN * LDA B  YES, RESCHEDULE WAITERS FOR TDB JSB $SCD3 IF THERE ARE ANY JMP $ABRE,I RETURN * HED * EXEC - ERROR MESSAGE SECTION * * * ERROR SECTION * * THE FOLLOWING DIAGNOSTICS ARE OUTPUT ON THE * SYSTEM TELETYPEWRITER ON DETECTION OF: * * 1) REQUEST CODE UNDEFINED OR ILLEGAL * NUMBER OF PARAMETERS * * RQ -PNAME- -PADDR- * * THE ROUTINE -$ERMG- IS USED TO FORMAT * THE DIAGNOSTIC AND CALL FOR ITS OUTPUT. * * ERE01 LDA RE (A) = 'RE' RSS RQERR LDA RQ1 (A) 'RQ' LDB BLANK (B) = BLANKS JSB $ERMG JMP $XEQ * AS00 ASC 1,00 RQ1 ASC 1,RQ RE ASC 1,RE * $ERAB ADB AS00 ADD ASC "00" JSB $ERMG PRINT ERROR DIAG.,ABORT PROG JMP $XEQ -EXIT- SPC 3 * SUBROUTINE: <$ERMG> * * PURPOSE: THIS ROUTINE FORMATS A DIAGNOSTIC * MESSAGE WHICH CONTAINS A FOUR * CHARACTER MNEMONIC DESCRIBING THE * ERROR WITH THE PROGRAM NAME AND * LOCATION OF THE ERROR. IT THEN * CALLS THE ROUTINE <$SYMG> TO * OUTPUT THE MESSAGE. * * CALL: (A),(B) CONTAIN A 4 ASCII CHARACTER * MNEMONIC OR CODE DESCRIBING THE ERROR * * (P) JSB $ERMG * (P+1) - RETURN - (REGISTERS MEANINGLESS) SPC 2 * $ERMG JMP $I.EX DO INIT STUFF * STA MSG+1 SET ERROR MNEMONIC IN STB MSG+2 FIRST 4 CHARACTERS OF MESSAGE. * LDB XEQT SET (B) = ADDRESS OF POINT OF ADB D8 SUSPENTION IN ID-SEG. STB PRVIO AND SAVE FOR ABORT OPTION ADB D4 SET (B) = ADDRESS OF 3-WORD NAME LDA B,I AND SET STA MSG+4 PROGRAM INB NAME LDA B,I IN STA MSG+5 MESSAGE. CLE,INB (E=0 FOR ASCII CONVERSION) LDA B,I AND C377 IOR B40 STA MSG+6 INB GET THE STATUS LDA B,I WORD AND IF RAL,CLE,SLA,ERA ABORT OPTIN IN EFFECT P JMP NOABT GO SET IT UP. * ERM LDA XSUSP,I GET LOCATION OF ERROR JSB $CVT3 CONVERT TO OCTAL/ASCII FORMAT LDB A,I MAKE STB MSG+7 5-DIGIT MEMORY ADDRESS. INA SET DLD A,I GET THE OTHER TWO WORDS DST MSG+8 AND SET IN THE MESSAGE * LDA MSGA CALL TO JSB $SYMG OUTPUT DIAGNOSTIC. * LDA XEQT NOW GO JSB $ABRT ABORT THE PROGRAM * JMP $ERMG,I D4 DEC 4 D8 DEC 8 C377 OCT 177400 * NOABT ADB DM6 SET A,B ADDRESS STB DSTAD SET DOUBLE STORE ADDRESS DLD MSG+1 GET THE ERROR CODE DST DSTAD,I SET A,B TO THE ERROR CODE DSTAD EQU *-1 DOUBLE STORE ADDRESS * CCA,CLE USE THE RETURN ADDR - 1 FOR CPB BLANK (BUT IF "MP","RQ", OR "RE" JMP ERM ABORT ANYWAY) ADA RQRTN STA PRVIO,I THE RETURN ADDRESS TO THE PGM. JSB $LIST OCT 501 JMP $ERMG,I RETURN * DM6 DEC -6 B40 OCT 40 * MSGA DEF *+1 MSG DEC -18 ASC 2, BLANK ASC 7, SPC 2 EXT $MIC $I.EX EQU * SYSTEM INITIALIZATION CODE LDA DUMMY GET DUMMY CARD ADDR SZA,RSS JMP NOPRV NO PRIVILEGED I/O IOR CLC STA SW1 SET CONFIGURED CLC INSTRUCTION NOPRV EQU * LIA 6 SZA,RSS WHAT KIND OF CPU? JMP NMX NOT MX OR XE. LDA .CXA IT IS MX OR XE STA MX3 LDA .DLD STA MX4 * NMX LDA $MIC SZA,RSS IS THERE MICROCODE? JMP NMC0 =0, NO MICRO LDA .LRR #0, YES, MICRO STA MIC1 JMP $SCLK DONE NMC0 LDB SAXAI NO MICRO STB MIC3 LDB LAEOI STB MIC5 LDA $MPFT SET ADDR OF SSGA ADA D4 LDA A,I ADA DM1 STA $SGAF JMP $SCLK DONE * .DLD DLD 0 .CXA CXA .LRR OCT 105622 CLC CLC 0 SAXAI STA XA,I LAEOI LDA XEO,I * HED * EXEC -- REQUEST CODE TABLE * *** REQUEST CODE TABLE *** * * THIS DEFINES THE RELATION FOR SYSTEM * REQUEST CODES AND CORRESPONDING PROCESSORS. * THE TABLE CONSISTS OF ONE-WORD ENTRIES IN * NUMERIC ORDER CORRESPONDING TO THE DEFINED * SYSTEM REQUEST CODES. THE CONTENTS OF EACH * ENTRY IS THE BASE PAGE LINKAGE ADDRESS OF * THE WORD CONTAINING THE ENTRY POINT ADDRESS * * OF THE PROCESSOR. AN -EXT- MUST BE USED * WITH THE -DEF- IN DEFINING THE TABLE. * * THE WORD LABELED -CODE#- CONTAINS THE NEGATIVE OF * ONE + THE TOTAL # OF REQUEST CODES. * EXT $IORQ TBL DEF $IORQ CODE 1 I/O READ DEF $IORQ CODE 2 I/O WRITE DEF $IORQ CODE 3 I/O CONTROL NOP CODE 4 DISC TRACK ALLOCATION NOP CODE 5 DISC TRACK RELEASE * EXT $MPT1 DEF $MPT1 CODE 6 PROGRAM COMPLETION * EXT $MPT2 DEF $MPT2 CODE 7 OPERATOR SUSPENSION NOP CODE 8 LOAD PROGRAM SEG$MNT * EXT $MPT4 DEF $MPT4 CODE 9 SCHEDULE WITH WAIT * EXT $MPT5 DEF $MPT5 CODE 10 SCHEDULE PROGRAM * EXT $MPT6 DEF $MPT6 CODE 11 REAL TIME/DATE * EXT $MPT7 DEF $MPT7 CODE 12 TIME SCHEDULE DEF $IORQ CODE 13 I/O DEVICE STATUS NOP CODE 14 NO SUCH CALL NOP CODE 15 GLOBAL TRACK ASSIGNMENT NOP CODE 16 GLOBAL TRACK RELEASE NOP CODE 17 READ CLASS I/O NOP CODE 18 WRITE CLASS I/O NOP CODE 19 CONTROL CLASS I/O NOP CODE 20 WRITE-READ CLASS I/O NOP CODE 21 GET CLASS I/O * EXT $MPT8 DEF $MPT8 CODE 22 SWAP/CORE USAGE REQUEST DEF $MPT4 CODE 23 SCHEDULE WITH WAIT/WAIT DEF $MPT5 CODE 24 SCHEDULE NO WAIT/WAIT * * * DEFINE END OF TABLE AND # ENTRIES IN TABLE. * -ADDITIONAL REQUESTS MAY BE INSERTED *  AT THIS POINT. * TBLE EQU * * * THE NAMTB WHICH FOLLOWS CONTAINS A BIT FOR EACH PRAMETER * IN AN EXEC CALL WHICH SHOULD BE CALLED BY NAME...THAT IS * THE SYSTEM WILL NORMALLY STORE INTO THE LOCATION DEFINED * BY THE PRAMETER. THIS TABLE IS USED TO CHECK SUCH * PRAMETERS TO SEE IF THEY ARE ABOVE THE CURRENT * FENCE ADDRESS. * * 8 BITS ARE DEVOTED TO EACH CALL. THE LEAST BIT REFERS * TO PRAMETER NUMBER TWO AND SO ON. * THE 'L' AND 'H' NUMBERS ARE SET UP TO REFER TO EACH * PRAMETER BY NUMBER WHERE L REFERS TO THE LOW OR ODD * CALL FOR EACH WORD AND H REFERS TO THE HIGH OR EVEN CALL. * H = HIGH(EVEN CALL) * L = LOW(ODD CALL) * NAMTB ABS L3 0/1 (READ BUFFER) ABS 0 2/3 ABS H3+H4+H5 4/5 (ALLOCATE PRAMS) ABS 0 6/7 ABS 0 8/9 ABS L2+L3 10/11 (TIME VALUES) ABS L3+L4+L5 12/13 (STAT RETURN) ABS L3+L4+L5 14/15 (GLOBAL ALLOCATE PRAMETERS) ABS L7 16/17 (CLASSWORD FOR 17,18,20) ABS H7+L4 18/19 (CLASSWORD) ABS H7+L3+L5+L6+L7 20/21 (CLASSWORD,BUFFER,AND OPT PRAMS) ABS 0 22/23 ABS L3+L4+L5 24/25 SPC 2 L2 EQU 1 L3 EQU 2 L4 EQU 4 L5 EQU 10B L6 EQU 20B L7 EQU 40B L8 EQU 100B H2 EQU 400B H3 EQU 1000B H4 EQU 2000B H5 EQU 4000B H6 EQU 10000B H7 EQU 20000B H8 EQU 40000B HED * * SYSTEM BASE PAGE COMMUNICATION AREA * * XI EQU 1647B . EQU 1650B ESTABLISH ORIGIN OF AREA * * SYSTEM TABLE DEFINITION * * * * SYSTEM REQUEST PROCESSOR /'EXEC' COMMUNICATION * * RQCNT EQU .+22 # OF REQUEST PARAMETERS -1 RQRTN EQU .+23 RETURN POINT ADDRESS RQP1 EQU .+24 ADDRESSES RQP2 EQU .+25 RQP3 EQU .+26 OF REQUEST RQP4 EQU .+27 RQP5 EQU .+28 PARAMETERS RQP6 EQU .+29 RQP7 EQU .+30 (SET FOR MAXIMUM OF RQP8 EQU .+31 9 PARAMETERS) RQP9 EQU .+n`NLH32 * * DEFINITION OF EXECUTING PROGRAM ID SEGMENT' * * XEQT EQU .+39 ID SEGMENT ADDR. OF CURRENT PROG. XTEMP EQU .+41 'TEMPORARY (5-WORDS) XSUSP EQU .+48 'POINT OF SUSPENSION' XA EQU .+49 'A REGISTER' AT SUSPENSION XB EQU .+50 'B REGISTER' XEO EQU .+51 'E AND OVERFLOW * * SYSTEM MODULE COMMUNICATION FLAGS * * DUMMY EQU 1737B DUMMY CARD FOR PRIV-I/O * * UTILITY PARAMETERS * FENCE EQU .+85 MEM PROTECT FENCE ADDRESS * ORG * PROGRAM LENGTH END EXEC N _q 92064-18003 1805 S C0622 &MIO10 MI RTIOC              H0106  ASMB,R,N,L,C * * USE ASSEMBLY OPTION 'N' * * NAME : $MIO1 * SOURCE: 92064-18003 * RELOC: PART OF 92064-16001 * PROGMR: E.J.W. BASED ON RTE-III VERSIONS G.A.A.,L.W.A.,D.L.S. * * **************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT * * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * **************************************************************** * * NAM $MIO1 92064-16001 REV.1805 771028 * ENT $CIC,$XSIO,$SYMG,$IORQ,$IOUP,$IODN ENT $ETEQ,$IRT,$XCIC,$DEVT,$EQCK ENT $UPIO,$CVEQ,$YCIC ENT $BLLO,$BLUP,$OPSY ENT $CLCH,$DLFL ENT $BITB,$DMEQ,$UNLK,$XXUP,$DLAY,$CKLO * EXT $RQST,$CLCK,$XEQ,$TYPE,$LIST,$ALC,$RTN EXT $SCD3,$ERMG EXT $CVT1,$REIO,$ABRT,$INER,$ZZZZ EXT $ERAB,$CVT3,$QCHK,$MIC *M1 EXT $RNTB,$S.CL,$I.CL,$C.CL EXT .MVW * MIC SVR,105360B,2 SAVE REGISTERS MIC RSR,105361B,2 RESTORE REGISTERS MIC STR,105363B,1 SEQUENTIAL STORE VALUE MIC INT,105364B,1 INTERRUPT TABLE SEARCH MIC LNK,105365B,2 I/O REQUEST LINK * * ORB $BLLO DEC -100 $BLUP DEC -300 ORR SPC 1 * * MODULE OF THE R E A L - T I M E E X E C U T I V E * * * THIS INCLUDES THE FOLLOWING MAJOR SECTIONS: * * 1) CENTRAL INTERRUPT CONTROL * * 2) INPUT / OUTPUT CONTROL * - I/O REQUEST PROCESSING * - I/O COMPLETION PROCESSING * - GENERAL I/O ERROR PROCESSING * * 3) SYSTEM ERROR DIAGNOSTIC PRINT ROUITNE * * 4) PROCESSOR FOR OPERATOR I/O STATEMENTS * HED < CENTRAL INTERRUPT CONTROL > * *** C E N T R A L I N T E R R U P T C O N T R O L *** * * THE PROCESSING OF SYSTEM INTERRUPTS IS CONTROLLED *  BY DIRECTING ALL SOURCES TO THE ENTRY POINT < $CIC>. * < $CIC> IS RESPONSIBLE FOR SAVING AND RESTORING * THE CURRENT STATE OF THE MACHINE, ANALYSING THE * SOURCE OF THE INTERRUPT, AND ACTIVATING THE * APPROPRIATE PROCESSOR. THIS ROUTINE IS TABLE-DRIVEN * BY THE *INTERRUPT TABLE*. * * SPECIAL PROCESSING FOR A "PRIVILEGED" CLASS OF * INTERRUPTS IS PROVIDED BY $CIC. THIS IS DESCRIBED * FULLY IN SECTION III BELOW. BRIEFLY, A SPECIAL * I/O CARD CAN BE USED TO SEPARATE SPECIAL INTERRUPTS * FROM NORMAL SYSTEM CONTROLLED INTERRUPTS. THE * PRESENCE AND LOCATION OF THE SPECIAL CARD IS * NOTED AT SYSTEM CONFIGURATION TIME. IF IT IS * PRESENT, THE EXEC OPERATIONS ARE NOT PERFORMED * WITH THE INTERRUPT SYSTEM DISABLED BUT RATHER * WITH THE CONTROL SET ON THE SPECIAL CARD TO * HOLD OFF SYSTEM I/O INTERRUPTS. * * I. INTERRUPT TABLE (INTBL) * * A TABLE, ORDERED BY HARDWARE INTERRUPT PRIORITY, * DESIGNATES THE ASSOCIATED SOFTWARE PROCESSOR AND * THE PROCEDURE FOR INITIATING THE PROCESSOR. THIS * TABLE IS CONSTRUCTED BY *RTGEN* ON INFORMATION * SUPPLIED BY THE USER IN CONFIGURING THE SYSTEM. * THE TABLE CONSISTS OF ONE ENTRY PER INTERRUPT * SOURCE: EACH ENTRY CONTAINS ONLY ONE WORD. THE * CONTENTS OF EACH VALID ENTRY IS THE IDENTIFIER * OF THE PROCESSOR. SYSTEM PROCESSORS ARE NOTED * BY POSITIVE VALUES, USER PROCESSORS BY NEGATIVE * VALUES: * * 1. SYSTEM - THE IDENTIFIER IS THE ADDRESS OF * THE EQT ENTRY IDENTIFYING THE I/O DEVICE. * * 2. USER - THE ADDRESS OF THE PROGRAM * IDENTIFICATION SEGMENT IS IN 2-S COMPLEMENT * FORM IN THE ENTRY. * * 3. ILLEGAL - AN ENTRY CORRESPONDING TO AN * ILLEGAL INTERRUPT SOURCE CONTAINS ZERO. * * A PROCESSOR IS CALLED DIRECTLY IF IT RESPONDS * TO STANDARD SYSTEM INTERRUPT (E.G., $CLCK, * MEMORY PROTECT, I/O DEVICE CONTROLLED BY A * SYSTEM DRIVER) OR IS SCHEDULED IN THE NORMAL * PRIORITY ORDER IFzJ IT RESPONDS TO A USER * CONTROLLED DEVICE OR INTERRUPT SOURCE. SKP * II. INTERRUPT PROCESSING * * INTERRUPT ACKNOWLEDGEMENT BY THE CPU CAUSES * THE INSTRUCTION IN THE WORD CORRESPONDING * TO THE I/O CHANNEL ADDRESS TO BE EXECUTED. * FOR ALL ACTIVE I/O CHANNELS ( PLUS LOCATIONS * 5-7 ) CONTROLLED BY THE SYSTEM, THE INSTRUCTION * SET IN EACH INTERRUPT LOCATION IS A JUMP * SUBROUTINE INDIRECTLY TO < $CIC>. * SKP * <$CIC> PERFORMS THE FOLLOWING: * * 1. DISABLES THE INTERRUPT SYSTEM. * * 2. SAVES ALL REGISTERS PLUS THE INTERRUPT * RETURN POINT IN THE EXECUTING * ID SEGMENT. * * 3. CLEARS THE FLAG OF THE INTERRUPT SOURCE. * * 4. SETS 'MPTFL' = 1 TO MEAN MEMORY PROTECT * IS OFF - FLAG FOR PRIVILEGED PROCESSORS. * * 5. CHECKS FOR SPECIAL INTERRUPT PROCESSING. * IF 'DUMMY' IN BASE PAGE COMMUNICATION * AREA = 0, THEN LEAVE THE INTERRUPT SYSTEM * DISABLED AND GO TO STEP 6. * * 'DUMMY' > 0 - PRIVILEGED INTERRUPTS: * -THE CONTENTS OF 'DUMMY' IS THE I/O * ADDRESS OF THE CARD; THIS IS USED TO * SET THE CONTROL FF ON THE CARD (FLAG * IS ALREADY SET) TO HOLD OFF LOWER * PRIORITY INTERRUPTS (SYSTEM INTERRUPTS) * -CLEARS THE CONTROL FLIP-FLOP OF * EACH DMA CHANNEL TO PROHIBIT POSSIBLE * INTERRUPTS FROM OCCURRING. * -ENABLE THE INTERRUPT SYSTEM. * * 6. TRANSFERS DIRECTLY TO THE INTERRUPT * PROCESSOR FOR SOURCES OF: * * 5 - MEMORY PROTECT VIOLATION * (TBG) - TIME BASE GENERATOR * * FOR OTHER SOURCES, THE INTERRUPT SOURCE * CODE IS USED TO INDEX THE INTERRUPT TABLE. * THE CONTENTS OF THE INTBL ENTRY DETERMINES * THE MANNER IN INITIATING THE PROCESSOR: * * A. +, THE CONTENTS OF THE ENTRY IS * ASSUMED TO BE THE FWA OF AN EQT EXNTRY. * THE ADDRESSES OF THE 15-WORD ENTRY * ARE SET IN AND CONTROL * TRANSFERRED DIRECTLY TO THE COMPLETION * SECTION ADDRESS (WORD 3 OF EQT ENTRY). * * B. -, THE VALUE IS SET POSITIVE AND IS * SET IN A CALL TO <$LIST> IN THE * SCHEDULING MODULE- THE CALL IS MADE IF * THE USER PROGRAM IS DORMANT- CONTROL IS * TRANSFERRED TO $XEQ. IF THE PROGRAM IS * NOT DORMANT, IT IS NOT SCHEDULED AND THE * DIAGNOSTIC "SC03 INT XXXXX" IS OUTPUT * TO THE SYSTEM TTY- XXXXX IS THE PROGRAM * NAME. CONTROL IS RETURNED TO THE INTER- * RUPTED SEQUENCE. * * C. 0, ILLEGAL OR UNDEFINED INTERRUPTS ARE * NOT PROCESSED BUT THE DIAGNOSTIC * "ILL INT XX" IS OUTPUT TO THE SYSTEM * TTY. XX IS THE INTERRUPT CODE. * * 7. I/O DRIVER RETURNS INDICATE CONTINUATION * OR COMPLETION OF THE OPERATION BY THE * DRIVER OR DEVICE: * * A. RETURN AT (P+1): COMPLETION OF THE * OPERATION. $CIC TRANS- * FERS DIRECTLY TO THE * IOC COMPLETION SECTION * AT < IOCOM >. CONTROL * IS NOT RETURNED TO * < $CIC>. * * B. RETURN AT (P+2): CONTINUATION OF THE * OPERATION. $CIC RETURNS * TO THE INTERRUPTED * SEQUENCE AS DESCRIBED * IN STEP 8 FOLLOWING. * * 8. RESTORING INTERRUPT CONDITIONS AND RETURN * TO POINT OF INTERRUPTION. AN ENTRY POINT * CALLED '$IRT' IS PROVIDED FOR USE BY * OTHER MODULES OF THE R/T EXEC TO RESET * FLAGS AND THE DMA CHANNELS AND RETURN TO * THE USER PROGRAM. * * THE CALLING SEQUENCE IS JUST: * * - JMP $IRT - * * $IRT PERFORMS THE FOLLOWING: * 1 - DISABLES THE INTERRUPT SYSTEM * 2 - SETS 'MPTFL' = 0 TO MEAN THAT MEMORY * PROTECT IS ON (ENABLED). * 3 - SKIP TO 6 IF NOT A PRIVILEGED SYSTEM * 4 - ISSUES A CLC TO CLEAR THE CONTROL * FF ON THE SPECIAL CARD. * 5 - SETS THE CONTROL FF ON EITHER DMA * CHANNEL IF BIT 15 OF THE INTBL WORD * =1 TO MEAN IT IS ACTIVE. THIS * ENABLES DMA INTERRUPTS ONLY. * 6 - RESTORES THE REGISTERS AND * 7 - EXECUTES THE CURRENT PROGRAM AT XSUSP. * * * SKP * III. SPECIAL (PRIVILEGED) INTERRUPTS * * THIS PROVISION ALLOWS INTERRUPTS FROM SPECIAL * DEVICES TO BE RECOGNIZED WITHIN 100 MICRO SECONDS * AND TO BE PROCESSED BY SPECIAL, COMPLETELY * INDEPENDENT ROUTINES CLASSIFIED AS SYSTEM TYPE * PROGRAMS. INTERRUPTS ARE CHANNELED DIRECTLY * TO THE ENTRY POINT OF A ROUTINE BY A JSB INDIRECT * IN THE CORRESPONDING CORE LOCATION. $CIC IS * NOT AWARE OF THESE SPECIAL INTERRUPTS OCCURRING; * IT ONLY ALLOWS THE INTERRUPT SYSTEM TO BE * ENABLED AND A SOFTWARE FLAG SET TO INDICATE * THE STATUS OF MEMORY PROTECT. THE JSB TO THE * ENTRY POINT FOR A ROUTINE IS SET BY USING THE * "ENT,XXXXX" STATEMENT IN RTGEN WHEN CONFIGURING * A REAL-TIME SYSTEM. * THE SPECIAL PROCESSING ROUTINES CANNOT USE * ANY FEATURES OR REQUESTS OF THE STANDARD * R/T EXEC. THESE ARE INDEPENDENT ROUTINES. * COMMUNICATION BETWEEN A NORMAL PROGRAM UNDER * THE CONTROL OF THE R/T EXEC AND A SPECIAL * INTERRUPT PROCESSOR CAN BE DONE THROUGH * THE APPROPRIATE COMMON REGION: I.E. FLAGS OR * INDICATORS CAN BE SET IN PRE-DEFINED WORDS * IN COMMON TO INITIATE PROCESSING. THE NORMAL * USER PROGRAM CAN BE SCHEDULED TO RUN AT A * PERIODIC TIME INTERVAL TO SCAaN THE INDICATORS. * THIS FACILITY IS PROVIDED TO ACCOMODATE HIGH- * SPEED PROGRAM CONTROLED DATA TRANSMISSION * WHICH REQUIRES QUICK RESPONSE. * THE SPECIAL INTERRUPT PROCESSORS ARE * RESPONSIBLE FOR SAVING AND RESTORING ALL * REGISTERS USED AND FOR RESTORING MEMORY * PROTECT TO ITS STATE BEFORE THE SPECIAL * INTERRUPT OCCURRED. MEMORY PROTECT IS * AUTOMATICALLY DISABLED AT THE OCCURRENCE * OF ANY INTERRUPT. THE WORD 'MPTFL' IN THE * BASE PAGE COMMUNICATION AREA IS SET BY THE * R/T EXEC TO INDICATE THE STATUS OF THE * MEMORY PROTECT: * * 'MPTFL' = 0 MEANS MEMORY PROTECT IS 'ON'. * THE SPECIAL ROUTINE MUST ISSUE * A STC 5 IMMEDIATELY BEFORE * RETURNING TO THE INTERRUPTED * SEQUENCE BY A JMP -,I * * = 1 MEANS THAT THE R/T EXEC ITSELF * WAS EXECUTING WHEN THE INTERRUPT * OCCURRED AND THAT MEMORY * PROTECT IS 'OFF'. THE ROUTINE * MUST NOT ISSUE THE STC 5 IN * THIS CASE. * * IF A SPECIAL INTERRUPT ROUTINE MUST EXECUTE * WITH THE INTERRUPT SYSTEM DISABLED, THE * STC 0 TO RE-ENABLE INTERRUPTS JUST PRIOR TO * EXITING MUST BE IN THE FOLLOWING SEQUENCE IF * MEMORY PROTECT IS ALSO TO BE TURNED ON: * * - STF 0 - * - STC 5 - * - JMP -,I - SKP $CIC NOP * CLF CLF 0 DISABLE INTERRUPT SYSTEM * * PRESERVE CURRENT STATUS OF MACHINE * SPC 1 IFZ ***** BEGIN DMS CODE ************** SSM $MEU SAVE MEU STATUS AT INTERRUPT FOR $MESS UJP *+2 DO ASAP TO PREVENT PFR FROM STEALING ******* END DMS CODE ************** XIF SPC 1 MIC JMP MIC1 STA XA,I IF NO MICRO TO SAVE REGS STB XB,I SAVE REGISTERS ERA,ALS A,B SOC E AND YINA OVERFLOW STA XEO,I MX1 JMP LIA4 CXA IF MX CYB DST XI,I SAVE X AND Y * LIA4 LIA 4 GET INTERRUPT CODE STA INTCD SAVE INTERRUPT CODE CPA .5 MP? JMP ZCIC YES, AVOID CLF. IOR CLF STA CLFXX CONFIGURE CLEAR FLAG CLFXX NOP LET PRIVILEGED I-O INTERRUPT * ZCIC EQU * MTFL=1 IN M1, MP IS ALWAYS OFF *M1 ISZ MPTFL MPTFL=1 (WE'RE IN SYSTEM) MP IS OFF SW1 JMP CIC.0 (STC DUMMY IF PRIVILEDGED OPTION) * CLC 6 STOP DMA FROM INTERRUPTING, CLC 7 SO THAT ONLY PRIVILEGED DRIVERS CAN. STF 0 RE-ENABLE INTERRUPTS * CIC.0 EQU * LDB $CIC SAVE P-REGISTER A POSSIBLE STB XSUSP,I POINT OF SUSPENSION. LDB INTCD RESTORE INT CODE * * CHECK FOR TRANSFER TO NON-I/O SYSTEM PROCESSOR * CPB .5 IF MEMORY PROTECT VIOLATION, JMP $RQST GO TO EXAMINE MP VIOLATION. * CPB TBG IF TIME BASE GENERATOR, JMP $CLCK GO TIME PROCESSOR. * * CHECK LEGALITY OF INTERRUPT * MIC2 JMP MIC3 OR NOP IF NO MICRO ADB N6 CODE - 6. STB A (SAVE FOR TABLE INDEX) ADB INTBA INDEX TO PROPER ENTRY CMA,CLE,SSA - ERROR IF CODE ADA INTLG LESS THAN 6 OR BEYOND * * GET PROCESSOR IDENT FROM INTERRUPT TABLE * LDA B,I CODE. GET CONTENTS OF ENTRY SEZ SKIP IF OUT OF INTBL RANGE. CLE,SZA,RSS UNDEFINED INTERRUPT JMP CIC.4 IF VALUE = 0, ISSUE DIAG. * * LDB INTCD REMOVE ERB BIT 15 OF INTBL WORD CPB .3 IF DMA CHANNEL RAL,CLE,ERA INTERRUPT. * SSA,RSS SYSTEM PROCESSOR IS TO BE CALLED JMP CIC.2 IF VALUE IS POSITIVE. * ** INTERRUPT PROCESSOR IS USER ROUTINE TO BE ** SCHEDULED FOR PRIORITY EXECUTION * CMA,INA SET POSITIVE TO GET ID SEGMENT STA B Z ADDRESS, SET IN B TO <$LIST>. * CIC.3 ADA .15 CHECK STATUS OF PROGRAM. LDA A,I IF STATUS IS ZERO (DORMANT), SZA SCHEDULE PROGRAM, OTHERWISE JMP CIC.5 ISSUE DIAGNOSTIC. * JSB $LIST CALL SCHEDULER TO LINK PROGRAM OCT 401 INTO SCHEDULE LIST. JMP $XEQ SPC 1 N6 DEC -6 * * * ASSUME PROCESSOR FOR CODE GT= 6 IS A * SYSTEM I/0 DRIVER. VALUE OF INTERRUPT * TABLE ENTRY IS THE STARTING ADDRESS * OF THE EQUIPMENT TABLE ENTRY CORRESPONDING * TO THE INTERRUPTING DEVICE. * CIC.2 JSB $ETEQ SET EQT ENTRY ADDRESSES. SPC 1 IFZ ***** BEGIN DMS CODE ************** CIC.6 JSB $DVM GO SET RIGHT MAP ******* END DMS CODE *************** XIF SPC 1 LDA INTCD (A) INTERRUPT I-O SELECT CODE CIC.8 LDB EQT14,I SET DEVICE STB EQT15,I TIME-OUT CLOCK * * CALL I/O PROCESSOR, COMPLETION SECTION * * P+1 RETURN: INDICATES COMPLETION OF THE REQUEST. * P+2 RETURN: INDICATES CONTINUATION OF THE REQUEST. * P+3 RETURN: INDICATES THAT THE DRIVER NEEDS A DMA * CHANNEL BEFORE IT CAN CONTINUE. REENTRY * TO THE DRIVER WILL BE THROUGH THE * INITIATION POINT OF THE DRIVER WHEN A * DMA CHANNEL IS AVAILABLE. THE DRIVER MUST * KEEP A FLAG INDICATING HE WAS ENTERED AT * THE INITIATION POINT FOR A DMA REQUEST FROM * THE CONTINUATOR. ON EXIT FROM THE INITIATOR * THE A-REG MUST EQUAL ZERO. RETURN WILL THEN * WILL BE MADE HERE FOR NORMAL CONTINUATION * PROCESSING. * LDB EQT3,I CALL DRIVER AT JSB B,I *COMPLETION* SECTION. * JMP IOCOM (P+1): *COMPLETION RETURN* JMP IOCON (P+2): *CONTINUATION RETURN* IFZ ***** BEGIN DMS CODE *************** JSB $RSM (P+3): RESTORE USER MAP. ***** END DMS CODE *************** XIF ISZ CONFL (P+3): *REQ.DMA RETURN*SET=1 INCASE WE GET LDA DIOCR TO *REXIT* VIA SUBROUTINE *DRIVR*. STA DRIVR SETUP RETURN ADDRESS FOR SUBROUTINE JMP DVR0 *DRIVR* AND JUMP INTO IT TO ALLOCATE IOCRT JMP IOCO1 (P+1) A DMA CHANNEL. WILL REENTER DRIVER AT JMP NOTRD (P+2) INITIATION. OK, RETURN TO (P+1). * IOCON EQU * IFZ ***** BEGIN DMS CODE *************** JSB $RSM GO RESTORE USER MAP. ***** END DMS CODE *************** XIF IOCO1 CLA LDB OPATN CHECK FOR OPERATOR ATTENTION. STA OPATN -CLEAR OPERATOR FLAG- SZB IF FLAG SET, JMP $TYPE ACKNOWLEDGE. * LDA $LIST ANY SCHEDULE ACTIVITY? SZA,RSS YES, SKIP JMP $IRT NO, RETURN TO POINT OF INTERRUPT * JMP $XEQ SCHEDULE NOW, NOT 10MS LATER!! * * * $XCIC LIA 4 ### SPECIAL CLUDGE TO SKIP CLF ### $YCIC STA INTCD SPC 1 IFZ ***** BEGIN DMS CODE *************** UJP *+2 ******* END DMS CODE *************** XIF SPC 1 MIC4 JMP MIC5 OR NOP IF NO MICRO, CXA IF MX MX4 JMP ZCIC CYB IF MX DST XI,I SAVE X,Y IF MX JMP ZCIC SNEAK TO FRONT DOOR FROM REAR ENTRANCE SPC 2 MIC1 SVR XA,I XI,I MICRO FOR SAVE REGS JMP LIA4 * MIC5 SVR DUM XI,I MICRO SAVE X,Y ONLY JMP ZCIC * MIC3 INT INTBA SEARCH INTERRUPT TABLE JMP CIC.4 ERROR RETURN JMP CIC.2 CALL DRIVER JMP CIC.3 CALL PROGRAM * * * * ILLEGAL OR UNDEFINED INTERRUPT * CIC.4 LDA INTCD GET THE INTERRUPT CODE. JSB $CVT1 CONVERT. STA CICM1+6 STUFF IN THE MESSAGE LDA CICM1 PRINT JMP CIC.7 "ILL INT XX" * * ISSUE DIAGNOSTIC FOR BEING UNABLE TO * SCHEDULE USER PROGRAM ON INTERRUPT. * CIC.5 ADB .12 SET (B) TO ADDRESS OF NAME IN LDA B,I PROGRAM ID SEGMENT. STA CICM2+7  STORE INB PROGRAM DLD B,I NAME IN DST CICM2+8 DIAGNOSTIC AND PRINT LDA CICM2 "SC03 INT XXXXX" CIC.7 JSB $SYMG * * ***** NOTE FALL THROUGH TO $IRT ***** SKP * * RESET INTERRUPT CONDITIONS - RETURN TO SEQUENCE * * * ROUTINE: '$IRT' * * THIS ROUTINE RETURNS TO THE CURRENT USER PROGRAM. * IT DOES THE PRIV. INTERRUPT SYSTEM EXIT THING AND * RESTORES THE PROGRAMS REGISTERS AND THE INTERRUPT * AND MEMORY PROTECT SYSTEM. * * CALLING SEQUENCE: * * SET UP XEQT AREA ON THE BASE PAGE FOR THE PROGRAM * * JMP $IRT * $IRT JSB $CLCK OR -CLA- IF TBG INCLUDED LDB XSUSP,I (A) = 0 AT THIS POINT STB INTCD (B) = RETURN ADDR. SAVE IT SPC 1 IFZ ***** BEGIN DMS CODE ************** UJP *+2 ******* END DMS CODE ************** XIF SPC 1 CLF 0 TURN OFF INT.SYS *M1 STA MPTFL SET 'MPTFL' = 0 TO MEAN INT.SYS IS OFF SW2 JMP MIC6 CLC IF PRIV. ELSE RETURN STF1 STF 12B DLD INTBA,I CHECK CONDITION OF DMA CHANNELS SSA IF BIT=1, DMA #1 IS ACTIVE SO STC 6 STC TO ENABLE DMA INTERRUPT SSB IF USER WANTED IT STC 7 SAME FOR DMA #2 MIC6 JMP MIC7 NOP IF NO MICRO, DLD IF MX * MX6 JMP NMIC6 DEF XI,I IF MX CAX CBY * NMIC6 LDA XEO,I RESTORE E AND CLO O REGS. SLA,ELA PRIOR TO INTERRUPT TURN OFF STF 1 TO KEEP TIME DOWN * DLD XA,I RESTORE THE A AND B REGS IRT3 STF 0 TURN ON THE INTERRUPT SYSTEM *M1 STC 5 AND MEMORY PROTECT JMP INTCD,I RETURN * SPC 1 IFZ ***** BEGIN DMS CODE *************** $MEU NOP MEU STATUS (DMS) AT INTERRUPT ******* END DMS CODE ************** XIF SPC 1 MIC7 RSR XA,I XI,I MICRO FOR RESTORE REGS JMP IRT3 SPC 4 CICM1 DEF *+1 N10 DEC -10 ASC 5,ILL INT XX * CICM2 DEF *+1 N15 DEC -15 ASC 8,SC03 INT XXXXX DUM EQU *-3 DUMMY BUFFER (3 WORDS) * INTCD NOP HOLDS INTERRUPT SOURCE CODE B37 OCT 37 DIOCR DEF IOCRT N2 DEC -2 * $OPSY EQU * SYSTEM ID DEC -7 * IFN * BEGIN NON-DMS CODE *************** * DEC -15 *** END NON-DMS CODE *************** * XIF * SPC 1 * IFZ ***** BEGIN DMS CODE *************** * DEC -5 ******* END DMS CODE *************** * XIF * SPC 1 HED < RT EXECUTIVE INPUT/OUTPUT CONTROL > *** I N P U T / O U T P U T C O N T R O L *** * * THE I/O SCHEDULING AND CONTROL MODULE < IOC > * IS RESPONSIBLE FOR ALLOCATING THE USE OF ALL * STANDARD I/O DEVICES AND THE TWO DMA CHANNELS. * I/O DRIVERS OPERATE UNDER CONTROL OF AND * <$CIC> FOR INITIATION AND COMPLETION OF SYSTEM * AND USER DIRECTED I/O OPERATIONS. I/O DRIVERS * ARE INDEPENDENT PROGRAMS IDENTIFIED TO * BY THE DEVICE ASSOCIATED EQUIPMENT TABLE. DRIVERS * ARE COMPOSED TO TWO SECTIONS: *INITIATION* AND * *COMPLETION*. THE *INITIATION* SECTION IS * CALLED BY TO EXAMINE AND INITIATE AN I/O * OPERATION. THE *COMPLETION* SECTION IS CALLED * BY <$CIC> TO CONTINUE OR COMPLETE THE OPERATION. * DRIVERS PROVIDE FOR SIMULTANEOUS MULTI-DEVICE * CONTROL BY USING THE DEVICE EQT ENTRY FOR * VARIABLE STORAGE. * * I. * EQUIPMENT TABLE * (EQT) * * EACH I/O DEVICE CONTROLLED BY THE IOC/DRIVER * RELATIONSHIP IS DEFINED BY STATIC AND DYNAMIC * INFORMATION IN THE EQUIPMENT TABLE. THE EQT * IS A SYSTEM RESIDENT TABLE WHICH IS CONSTRUCTED * FROM USER DIRECTIVES BY . EACH EQT * ENTRY IS COMPOSED OF 15-WORDS IN THE FOLLOWING FORMAT: * SKP * * WORD CONTENTS * ---- ---------------------------- * 1 * I/O LIST . LINK POINTER * * 2 *DRIVER *INITIATION ADDRESS* * 3 *DRIVER *COMPLETION ADDRESS* * 4 *DBPOT/----UNIT#--CHANNEL #* * 9= 5 *AV-TYPE CODE- UNIT STATUS* * 6 *REQUEST CONTROL WORD * * 7 *REQUEST BUFFER ADDRESS * * 8 *REQUEST BUFFER LENGTH * * 9 *TEMPORARY OR DISC TRACK # * * 10 *TEMPORARY OR DISC SECTOR #* * 11 *DRIVER TEMPORARY STORAGE* * 12 * " " " * * 13 * " " " * * 14 * DEVICE CLOCK RESET VALUE * * 15 * " " WORKING " * * * D: =1 IF A DMA CHANNEL REQUIRED FOR TRANSFER * B: =1 IF AUTOMATIC OUPUT BUFFERING DESIRED * P: =1 IF DRIVER TO HANDEL POWER FAIL RECOVERY. * O: =1 IF DRIVER TO HANDEL TIME OUT. * T: DEVICE TIME-OUT BIT - CLEARED BEFORE EACH * IO INITIATION; SET IF DEVICE TIMES-OUT. * UNIT#: OPTIONAL FOR DEVICES REQUIRING * SUB-CHANNEL DESIGNATION * CHANNEL#: I/O SELECT CODE (LOWER # IF * MULTI-BOARD INTERFACE) * AV (AVAILABILITY INDICATOR): * =0, UNIT AVAILABLE FOR OPERATION * =1, UNIT DISABLED * =2, UNIT CURRENTLY IN OPERATION * =3, UNIT WAITING FOR DMA CHANNEL * TYPE CODE: CODE IDENTIFYING TYPE OF I/O DEVICE * UNIT STATUS: ACTUAL OR SIMULATED UNIT STATUS * AT END OF OPERATION * * II. * DEVICE REFERENCE TABLE * (DRT) * * THE DEVICE REFERENCE TABLE PROVIDES FOR * LOGICAL DEVICE ADDRESSING OF PHYSICAL I-O * SLOTS DEFINED IN THE *EQT*. THE *DRT* CONSISTS * OF TWO SEQUENTIAL TABLES EACH TABLE CONSISTING * OF 1-WORD ENTRIES CORRESPONDING TO THE RANGE * OF USER-SPECIFIED "LOGICAL" UNITS, 1 TO N * WHERE N IS LT OR = TO 63(10). THE CONTENTS OF * EACH LOGICAL UNIT'S WORD ONE IS AS FOLLOWS: * BITS 5-0 DEVICE'S EQT NUMBER * BITS 6-10 THE LOCKING RESOURCE NUMBER * BITS 11-15 THE DEVICE'S SUBCHANNEL ON THE EQT. * THE CONTENTS OF EACH LOGICAL UNIT'S DEVICE * REFERENCE TABLE WORD TWO CONTAINS A * POINTER TO THE I/O QUEUE OF THE I/O REQUESTS * FOR THIS DEVICE WHEN THE DEVICE IS DOWN: * BIT 15=0 FOR AN UP LU. * =1 FOR A DOWN LU. * BITS 14-CNLH0=0 FOR AN UP LU. * #0 FOR A DOWN LU WHERE * = ADDRESS OF THE I/O QUEUE IF THIS * IS THE FIRST LU(MAJOR LU)POINTING * TO THE DEVICE. * = 1 TO 1777(8). THE LU NUMBER OF * DEVICE(MAJOR LU)ON WHICH THE I/O * IS QUEUED. * RN* CERTAIN LOGICAL UNIT #S ARE PERMANENTLY * ASSIGNED TO FACILITATE SYSTEM, USER AND * SYSTEM SUPPORT I/O OPERATIONS. THESE ARE: * * 0 - BIT BUCKET(DUMMY LU)(NO ENTRY IN DRT) * 1 - SYSTEM TELETYPEWRITER * 2 - SYSTEM DISC * 3 - AUXILIARY DISC * 4 - 'STANDARD' PUNCH UNIT * 5 - 'STANDARD' INPUT UNIT * 6 - 'STANDARD' LIST UNIT * 7 - ASSIGNED * . BY * . USER * 63 - * * III. INPUT/OUTPUT REQUESTS * * I/O REQUESTS INCLUDE COMMANDS FOR * READ, WRITE, CONTROL(FUNCTIONS) AND STATUS. * THE FORMAT OF THESE REQUESTS CONFORM TO * THE GENERAL SYSTEM REQUEST FORMAT. THE * NUMBER OF PARAMETERS VARIES DEPENDING * ON THE TYPE OF REQUEST AND THE CHARAC- * TERISTICS OF THE REFERENCED DEVICE. * * A USER I/O REQUEST IS DIRECTED TO * AT -$IORQ- BY THE EXECUTIVE REQUEST * PROCESSOR <$RQST>. SYSTEM I/O REQUESTS * ARE IN A DIFFERENT FORMAT AND ARE PROCESSED * AT THE SECTION -$XSIO- IN . REFER TO * THAT SECTION FOR DETAILED DESCRIPTION. * * A *STATUS* REQUEST IS PROVIDED * FOR USER AND SYSTEM SUPPORT PROGRAMS * WHICH REQUIRE KNOWLEDGE OF DEVICE * CONDITIONS OR TYPE BEFORE A READ/WRITE/ * CONTROL REQUEST IS MADE. THE PROGRAM * IS NOT SUSPENDED ON THIS CALL. * A PARAMETER WORD IS INCLUDED IN THE * REQUEST TO CONTAIN THE DEVICE STATUS ON * RETURN TO THE USER. THIS STATUS IS FROM WORD * 5 OF THE EQT ENTRY FOR THE DEVICE. * ALSO, AN ADDITIONAL PARAMETER WORD CAN BE * INCLUDED IN THE REQUEST- WORD 4 OF THE * EQT ENTRY IS RETURNED IF THE ADDITIONAL * PARAMETER WORD IS INCLUDED. * * A DYNAMIC STATUS REQUEST CAN BE MADE BY * MEANS OF A CONTROL REQUEST, THE FORMAT * OF WHICH IS DEFINED BELOW. IN THIS CASE, * THE REQUEST IS QUEUED, THE DRIVER IS ENTERED, * AND THE STATUS IS RETURNED TO THE CALLING * PROGRAM IN THE A REGISTER. * SKP * * A. READ/WRITE REQUEST FORMAT * * EXT EXE:C * JSB EXEC * DEF EXIT (DEFINE EXIT POINT) * DEF RCODE (DEFINE READ (1) OR WRITE(2)) * DEF CONWD (DEFINE CONTROL WORD) * DEF BUFFR (DEFINE BUFFER LOCATION) * DEF BUFFL (DEFINE BUFFER LENGTH) * DEF DTRAK (OPTIONAL - DISC TRACK #) * DEF DSECT (OPTIONAL - DISC SECTOR #) * EXIT --- * . * . * RCODE DEC 1 OR 2 * CONWD OCT NNNNN CONTROL INFO/LOGICAL UNIT # * BUFFL DEC N OR -N WORD OR CHARACTER LENGTH * DTRAK DEC N DISC TRACK # * DSECT DEC N STARTING SECTOR # * * BIT 12 OF THE CONTROL WORD SET ON NON-DISC REQUESTS * INDICATES A DOUBLE BUFFER FOR THIS OPERATION. * IN THIS CASE THE CONTROL BUFFER IS AT "DTRAK" AND IT'S * LENGTH IN WORDS IS AT "DSECT". * * * B. CONTROL REQUEST FORMAT * * EXT EXEC * JSB EXEC * DEF EXIT (DEFINE EXIT POINT) * DEF RCODE (DEFINE REQUEST CODE) * DEF CONWD (DEFINE CONTROL WORD) * DEF PARAM (DEFINE OPTIONAL PARAMETER) * EXIT --- * . * . * RCODE DEC 3 * CONWD OCT NNNNN CONTROL CODE/LOGICAL UNIT # * PARAM DEC N PARAMETER REQUIRED BY TYPE OF CODE * * CONTROL CODES (FIELD 10-06 OF CONTROL WORD): * * 01 - WRITE END-OF-FILE --/ PRIMARILY * 02 - BACKSPACE 1 RECORD / FOR * 03 - FORWARD SPACE 1 RECORD / MAGNETIC * 04 - REWIND / TAPE * 05 - REWIND STANDBY / UNITS * 06 - DYNAMIC STATUS --/ * 07 - SET EOT STATUS (FOR PAPER TAPE INPUT) * 10 - GENERATE LEADER FOR PAPER TAPE * 11 - LIST OUTPUT LINE SPACING * 12 - WRITE FILE GAP --/ PRIMARILY * 13 - FORWARD SPACE FILE/ FOR MAGNETIC * 14 - BACKWARD SPACE FILE/ TAPE UNITS SKP * C. DEVICE STATUS REQUEST FORMAT * * EXT EXEC * JSB EXEC * DEF EXIT (DEFINE EXIT POINT) * DEF RCODE (DEFINE REQUEST CODE) * DEF CONWD (DEFINE CONTROL WORD) * DEF STAT1 (DEFINE STATUS WORD 1) * DEF STAT2 (DEFINE STATUS WORD 2 -- OPTIONAL) * DEF STAT3 (DEFINE STATUS WORD 3 -- OPTIONAL) * EXIT --- * . * . * RCODE DEC 13 STATUS REQUEST CODE = 13 * CONWD OCT NN LOGICAL UNIT # * STAT1 NOP WORD 5 OF EQT ENTRY FOR * DEVICE STORED IN THIS WORD. * STAT2 NOP WORD 4 OF EQT ENTRY FOR * DEVICE STORED IN THIS WORD * IF PRESENT IN REQUEST. * STAT3 NOP IF PRESENT, THEN BIT 15 INDICATES * THE LU IS UP(0) OR DOWN(1) AND BITS * 0-4 GIVE THE LU'S SUBCHANNEL. * * * IV. GENERAL OPERATION * * ALL INPUT/OUTPUT OPERATIONS ARE PERFORMED * CONCURRENTLY WITH PROGRAM COMPUTATION IN THE * OVERALL SYSTEM. AN I/O OPERATION IS CONSIDERED * TO BE NON-BUFFERED TO THE REQUESTING USER * PROGRAM AS THE PROGRAM IS SUSPENDED UNTIL * THE TRANSMISSION OR OPERATION IS COMPLETED. * THE EXCEPTION TO THIS IS IN PROVIDING FOR * AUTOMATIC BUFFERING OF OUTPUT TO USER- * DESIGNATED DEVICES. IN THIS CASE, THE USER * BUFFER IS MOVED TO SYSTEM AVAILABLE MEMORY * AND THE USER PROGRAM IS NOT SUSPENDED. * * V. CLASS I/O OPERATIONS * * CLASS I/O REFERS TO NO-WAIT I/O IN WHICH THE USER * DIRECTS THE COMPLETION INFORMATION TO A 'CLASS' BY * NUMBER. LEGAL CLASSES ARE DEFINED AT GENERATION TIME * AND QUEUES ARE KEPT FOR EACH CLASS IN A TABLE CALLED * THE CLASS TABLE. THIS TABLE IS LOCATED AT $CLAS * AND CONSISTS OF A LENGTH WORD (DEFINING THE NUMBER * OF WORDS (CLASSES) IN THE TABLE (SYSTEM)) FOLLOWED * BY ONE WORD FOR EACH DEFINED CLASS. * * IN OPERATION THE USER REQUESTS I/O ON A CLASS, * RTIOC REQUESTS BUFFER MEMORY FOR THE REQUEST * i MOVES THE REQUEST TO THE BUFFER MEMORY * QUEUES THE REQUEST ON THE SPECIFIED EQT AND * NOTES IN THE CLASS QUEUE THAT A REQUEST IS * PENDING. * * ON COMPLETION THE COMPLETED REQUEST IS QUEUED IN THE CLASS * QUEUE AND ANY PROGRAM WAITING FOR THE CLASS * IS RESTARTED. * SKP $IORQ EQU * WE ARE ALREADY IN USER MAP. CLA SET CONTROL FLAG=0 TO MEAN STA CONFL *REQUEST* SECTION ENTERED STA TEMP5 CLEAR LU FLAG FOR LU 0 STA TEMPL CLEAR DISC FLAG * CPA RQCNT INSURE AT LEAST ONE PRAMETER JMP ERR01 - NO, ISSUE DIAGNOSTIC. * * LOGICAL UNIT REFERENCE VALIDITY CHECK * CCA,CCE TRANSLATE BY -1 ADA RQP2,I EXTRACT LOGICAL UNIT # FROM AND B77 PARAMETER 1 STA TEMP1 SAVE FOR STATUS CALL LDB A CPB B77 IF 0 SPECIFIED JMP L.00X GO DO IMMEDIATE COMPLETION THING * CMA,CLE CHECK FOR ZERO AND ADA LUMAX FOR A VALUE GT THE LARGEST SEZ,RSS DEFINED #. JMP ERR02 - ERROR, OUTSIDE OF RANGE. * * DRT ENTRY: ---------------------------- * : SUBCH :LU LOCK: EQT# : * ---------------------------- * 15 11 10 6 5 0 * ADB DRT INDEX TODEVICE-REFERENCE-TABLE LDA B,I GET EQT ASSIGNMENT. STA TEMP5 SAVE FOR 'WORD2' ROUTINE. AND B77 MASK OUT SUBCHANNEL CCE,SZA,RSS IF ZERO (SET E=1 FOR L.02 CHECK) JMP L.00X THEN DO IMMEADIATE COMPLETION THING JSB $CVEQ CONVERT TO ABSOLUTE EQT ADDRESSES * * REQUEST CODE ANALYSIS * L.000 LDA RQP1 GET REQUEST CODE (PARAMETER 1). AND .15 KEEP LOW PART STA RQPX SAVE IT CPA .13 TRANSFER IF JMP L.15 * STATUS * REQUEST. * M LDA TEMP1 GET LU-1 AND DETERMINE JSB STADV IF THE LU OR EQT IS DOWN JMP L.014 IF DOWN, SUSPEND PROGRAM * LDA RQPX UP, CONTINUE LDB XPRIO,I SET THE PRIORITY STB TEMP2 FOR LINK AND STB TEMP6 FOR BUFFERING CPA .3 IF REQUEST IS JMP L.02 SKIP FURTHER ANALYSIS. * LDB RQCNT CHECK # OF ADB N3 PARAMETERS SUPPLIED SSB FOR READ OR WRITE. JMP ERR01 -ERROR, LT 3. * * BUFFER LEGALITY CHECK FOR INPUT. * LDB RQP4,I GET THE LENGTH CLE,SSB,RSS CONVERT TO JMP BFCK1 WORDS IF BRS CHARACTERS CMB,INB SET POSITIVE AND BFCK1 STB TMP8 SAVE. SPC 1 *M1 CPA RQP1 IF CLASS REQUEST CPA .2 OR IF WRITE REQUEST, JMP L.01 SKIP BUFFER CHECK. SPC 1 ADB RQP3 CHECK IF AREA EXTENDS ABOVE THE CMB,SEZ,CLE,INB,RSS LAST WORD ADB BKLWA OF MEMORY INB CLB,SEZ,RSS IF SO THEN JMP ERR04 ERROR 4 DIAGNOSTIC JMP L.01 * * * L.014 LDB .4 L.013 STB XTEMP,I SET 4 IN FIRST WORD OF TEMP AREA. L.015 JSB $LIST PUT PGM IN WAIT LIST OCT 503 UNTIL DEVICE COMES UP. JMP $XEQ EXIT TO DISPATCHER SPC 1 ICOMX NOP DUMMY EQT FOR LU=0 B3700 OCT 3700 DO NOT REARRANGE NEXT 6 LINES .12 DEC 12 B14K OCT 14000 EQT4 OF DUMMY .13 DEC 13 EQT5 OF DUMMY TEMP1 NOP EQT6 OF DUMMY WORD2 NOP * N3 DEC -3 N5 DEC -5 C100K OCT 77777 $DMEQ DEF ICOMX ADDRESS OF DUMMY EQT SPC 2 L.00X LDA $DMEQ SET UP DUMMY EQT FOR LU=0 JSB $ETEQ ON BASE PAGE JMP L.000 CONTINUE PROCESSING * L.01 CLE LDB RQCNT SET (E)=1 IF 5 OR MORE PARAMS ADB N5 * LDA EQT5,I AND B36K CHECK FOR DISC CPA B14K DISC? RSS Ȁ YES JMP L.02 NOT DISC. * STA TEMPL SET DISC FLAG INDICATOR SSB DOES DISC CALL HAVE 5 PARAMS? JMP ERR01 NO, ERROR * L.02 CLA,SEZ,RSS IF BIT 12 OF CONWORD LDA RQP2,I SET AND ALF,SLA NOT FIVE OR MORE PRAMS JMP ERR01 TAKE GAS! * *M1 LDA TEMP5 CHECK FOR LU LOCK *M1 RRR 6 GET LOCK BITS TO LOW A *M1 AND B37 ISOLATE THEM *M1 SZA,RSS IF NOT LOCKED *M1 JMP WORD1 FORGET CHECK *M1* *M1 STA TEMP3 SAVE RN# FOR LULOCK PASSING *M1 LDB C100K SET 77777 FOR LINK PRIORITY *M1 STB TEMP2 AND *M1 CLB,INB ONE FOR *M1 STB TEMP6 BUFFERING PRIORITY. *M1 ADA D$RN ELSE INDEX INTO RN TABLE *M1 STA XTEMP,I SAVE RN ADDR IN ID SEG *M1 LDA A,I GET THE ENTRY *M1 AND B377 CHECK IF *M1 STA TEMPW SAVE OWNER'S ID *M1 ADA KEYWD CURRENT PROGRAM *M1 ADA N1 IS THE *M1 LDA A,I ONE THAT OWNS THE LOCK *M1 CPA XEQT ? *M1 JMP WORD1 YES CONTINUE THE REQUEST *M1* *M1 LDA RQPX COMPUTE ADDRESS OF THE *M1 LDB .3 POSSIBLE RN NUMBER *M1 CPB A IF CONTROL RQ SUBRTACT 3 *M1 CLB *M1 CPA RQP1 IF NOT CLASS *M1 ADB N1 SUBTRACT ONE *M1 ADB DRQP5 ADD ADDRESS OF FIFTH PRAM *M1 CLA USE ZERO IF NONE PASSED AND *M1 LDA B,I GET THE PASSED VALUE *M1 XOR TEMP3 CONSTRUCT AND *M1 ALF,ALF COMPARE WITH THE LOCKER'S *M1 XOR TEMPW RN *M1 CLE,SZA SKIP IF EQUAL. CLE FOR WORD2 BUILD *M1 JMP L.015 NO GO SUSPEND THE CURRENT CALLER * * * *WORD2 ASSEMBLE CONTROL WORD * * CONTROL WORD IS BUILT AS FOLLOWS: * ******************************************************** * T * S * X * U * S FUN * SUB CHAN * REQUEST CODE * * 15/14*13 *12 *11 * 10----6* 5------2 * 1/0 < * ******************************************************** * * WHERE: * T= 0 FOR STD USER REQUEST CODE = 1 FOR READ (CLASS OR NORMAL) * = 1 FOR BUFFERED RQ. = 2 FOR WRITE " * = 2 FOR SYSTEM = 3 FOR CONTROL " * = 3 FOR CLASS RQ. * * 'SUB CHAN' IS THE LOW 4 BITS AND 'S' IS THE 5'TH BIT OF THE * SUB CHANNEL. * * 'X' IS THE DOUBLE BUFFER BIT * 'U' IS CURRENTLY UNUSED * 'S FUN' IS THE USER SUB FUNCTION * * IF THE DEVICE IS A DISC THEN THE 'X' BIT IS CLEARED AND BITS * 8,9 IN 'S FUN' ARE SET TO THE LU IF 2 OR 3 ,ELSE THEY ARE * ZEROED. * * THIS ROUTINE DOES NOT BUILD THE 'T' FIELD. *** CALL WITH E=0 *** * WORD1 CLE LDB RQPX IF CLASS WRITE-READ *M1 CPB .4 THEN CHANGE *M1 CLB,CLE,INB CHANGE TO READ REQUEST LDA RQP2,I COMBINE REQUEST CODE WITH AND B137C CONTROL INFORMATION ADB A TEMPORARILY STORE IT- LDA TEMP5 GET DRT ENTRY FOR THIS LU AND B174K GET SUBCHANNEL ELA,RAL SAVE HIGH BIT AND ALF,RAL POSITON REST ADA B ADD IT TO THE WORD SEZ IF HIGH BIT SET ADA B20K SET IT IN THE WORD STA WORD2 * LDB RQPX GET THE MASKED REQUEST LDA TEMPL SZA,RSS IS IT DISC CALL? JMP L.027 NO * LDA WORD2 IT IS A DISC, AND C114C SO CLEAR BITS 12,9, AND 8 STA WORD2 AND SAVE AGAIN JMP L.10 DO DISC I/O UNBUFFERED * *M1 CPB RQP1 IF STANDARD I/O *M1 JMP L.027 SKIP THE CLASS CODE *M1* *M1* CLASS I/O INITIATION *M1* *M1* LDA WORD2 (A) = CONTROL WORD *M1 LDB TEMP6 (B) = BUFFER PRIORITY *M1 JSB $I.CL CALL INITIATE CLASS I/O *M1 JMP L.10 FORCE NORMAL UNBUFFERED I/O *M1 STA TEMP1 SAVE ADDR OF NEW I/O BLOCK *M1 JMP L.132 DO I/O, CLASS QUEUED UP * * * * CHECK ,FOR AUTOMATIC BUFFERING REQUIREMENT * L.027 CPB .1 SKIP CHECK IF REQUEST JMP L.10 IS INPUT. * LDA EQT4,I CHECK THE UNIT DESCRIPTOR RAL WORD IN ITS EQT ENTRY,BIT 14, SSA,RSS FOR BUFFERING. JMP L.10 -NO * LDA RQP2,I DYNAMIC STATUS AND B3700 REQUESTS ADA B ARE NEVER CPA B603 BUFFERED JMP L.10 DYNAMIC STATUS DO STD. USER RQ. * * * AUTOMATIC BUFFERING SECTION * CLA STA TMP6 INITIALIZE 2ND BUFF SIZE TO ZERO LDA N2 USE 5 WORDS FOR CONTROL REQUEST CPB .3 IF REQUEST IS FOR -CONTROL-, JMP L.03 SKIP BUFFER SIZE CHECK. * LDA TMP8 GET THE XFER LENGTH STA TEMP3 -SET AS MOVE INDEX- LDB RQP2,I IF DOUBLE BUFFER REQUEST BLF,SLB THEN RSS JMP L.03 NO, SKIP SECOND BUFFER SIZE * CLA CLEAR (A) IN CASE RQP6=0 LDB RQP6,I YES, GET SECOND BUFFER SIZE SSB,RSS NEGATIVE CHAR COUNT? JMP L.029 NO, SET WORD COUNT * BRS YES, CONVERT TO +WORDS CMB,INB L.029 LDA B GET SECOND BUFFER SIZE ADA TMP8 ADD TO FIRST BUFFER SIZE STB TMP6 SAVE 2ND BUFF SIZE L.03 ADA .8 ADD 8 FOR BLOCK CONTROL WORDS. ADA N1 THEN SUBTRACT 1 STA L.04 AND SET UP IN CALL * LDA N41 IF PRIORITY ADA XPRIO,I LT 41 THEN SSA DO NOT DO BUFFER LIMIT JMP L.031 TEST * * LDB $BLUP CHECK IF BEYOND THE LIMIT IN WORDS JSB $QCHK ON THIS DEVICE JMP L.013 BUFFER LIMITED! * * ALLOCATE BLOCK IN TEMPORARY STORAGE * L.031 JSB $ALC CALL AT SYSTEM ENTRY POINT L.04 NOP - REQUESTED LENGTH OF BLOCK - JMP L.10 NEVER ANY MEMORY SO GO UNBUFFERED JMP L.042 NO MEMORY NOW, SUSPEND. JMP L.06 ALLOCATION OK. * * * NO MEMORY AVAILABLE FOR BLOCK - CALLING USER * PROGRAM IS TO BE LINKED INTO MEMORY SUSPENSION * $LIST AND RE-SCHEDULED AT POINT OF REQUEST * WHEN A PREVIOUSLY ALLOCATED BLOCK IS RELEASED. * L.042 JSB $LIST CALL TO LINK PROGRAM INTO OCT 504 MEMORY SUSPENSION LIST. JMP $XEQ * * DRQP5 DEF RQP5,I B603 OCT 603 N41 DEC -41 B137C OCT 13700 B20K OCT 20000 C114C OCT 166377 CLEAR BITS 12,9,8 * * SET REQUEST PARAMETERS, PROGRAM PRIORITY AND * USER BUFFER INTO TEMPORARY BLOCK. * L.06 STB L.04 SET ACTUAL BLOCK LENGTH. STA TEMP1 SAVE BLOCK CCE,INA STA B SAVE ADDRESS OF WORD 2 LDA WORD2 GET CONTROL WORD IOR B40K SET = 1 FOR BUFFERING. SPC 1 IFN * BEGIN NON-DMS CODE ************** STA B,I AND SET IN WORD 2 OF BLOCK. *** END NON-DMS CODE ************** XIF SPC 1 IFZ ***** BEGIN DMS CODE ************** XSA B,I AND SET IN WORD 2 OF BLOCK. ******* END DMS CODE ************** XIF SPC 1 INB BUMP TO WORD 3 LDA TEMP6 SET REQUESTING PROGRAM PRIORITY SPC 1 IFN * BEGIN NON-DMS CODE ************** STA B,I IN WORD 3. *** END NON-DMS CODE ************** XIF SPC 1 IFZ ***** BEGIN DMS CODE ************** XSA B,I IN WORD 3. ******* END DMS CODE ************** XIF SPC 1 INB BUMP TO WORD 4 LDA L.04 SET BLOCK LENGTH IN SPC 1 IFN * BEGIN NON-DMS CODE ************** STA B,I WORD 4. *** END NON-DMS CODE ************** XIF SPC 1 IFZ ***** BEGIN DMS CODE ************** XSA B,I WORD 4. ******* END DMS CODE ************** XIF SPC 1 INB BUMP TO WORD 5 LDA .3 IF REQUEST CPA RQPX IS -CONTROL-, SKIP JMP L.08 BUFFER MOVE * LDA RQP4,I o SET USER BUFFER LENGTH SPC 1 IFN * BEGIN NON-DMS CODE ************** STA B,I IN WORD 5. *** END NON-DMS CODE ************** XIF SPC 1 IFZ ***** BEGIN DMS CODE ************** XSA B,I IN WORD 5. ******* END DMS CODE ************** XIF SPC 1 CMA,CLE,INA SET E IF ZERO LENGTH BUFFER CLA IN CASE RQP5 IS 0 LDA RQP5,I GET FIRST OPTIONAL WORD INB BUMP TO WORD 6 STB TEMPW SAVE THE ADDRESS OF THE LOCATION SPC 1 IFN * BEGIN NON-DMS CODE ************** STA B,I SET IT *** END NON-DMS CODE ************** XIF SPC 1 IFZ ***** BEGIN DMS CODE ************** XSA B,I SET IT ******* END DMS CODE ************** XIF SPC 1 INB BUMP TO WORD 7 CLA IN CASE RQP6 IS 0 LDA RQP6,I GET SECOND OPTIONAL WORD SPC 1 IFN * BEGIN NON-DMS CODE ************** STA B,I SET IT IN THE BUFFER *** END NON-DMS CODE ************** XIF SPC 1 IFZ ***** BEGIN DMS CODE ************** XSA B,I SET IT IN THE BUFFER ******* END DMS CODE ************** XIF SPC 1 SEZ,CLE,INB IF BUFFER LENGTH = 0, JMP L.075 SKIP BUFFER MOVE. * LDA RQP3 SET USER BUFFER ADDR L.065 EQU * FOR MOVE TO TEMP. BLOCK SPC 1 IFN * BEGIN NON-DMS CODE ************** JSB .MVW DEF TEMP3 NOP *** END NON-DMS CODE ************** XIF SPC 1 IFZ ***** BEGIN DMS CODE ************** LDX TEMP3 GET # WORDS TO MOVE MWI MOVE INTO SYSTEM MAP ******* END DMS CODE ************** XIF SPC 1 * L.075 LDA TMP6 GET LENGTH OF SECOND BUFFER STA TEMP3 SET FOR MOVE LDA RQP2,I GET THE REQUEST CONTROL WORD ALF,SLA IF FIRST TIME AND DOUBLE BUFFER h SEZ,CCE SKIP JMP L.13 ELSE CONTINUE * SPC 1 IFN * BEGIN NON-DMS CODE ************** STB TEMPW,I SET BUFFER ADDRESS IN REQUEST *** END NON-DMS CODE ************** XIF SPC 1 IFZ ***** BEGIN DMS CODE ************** XSB TEMPW,I SET BUFFER ADDRESS IN REQUEST ******* END DMS CODE ************** XIF SPC 1 LDA RQP5 GET USER BUFFER ADDRESS JMP L.065 GO MOVE THE BUFFER * L.08 CLA IN CASE RQP3=0 LDA RQP3,I FOR CONTROL REQUEST, SET WORD 3 SPC 1 IFN * BEGIN NON-DMS CODE ************** STA B,I (PARAM) IN PLACE OF RECORD *** END NON-DMS CODE ************** XIF SPC 1 IFZ ***** BEGIN DMS CODE ************** XSA B,I (PARAM) IN PLACE OF RECORD ******* END DMS CODE ************** XIF SPC 1 JMP L.13 LENGTH. SPC 2 *M1D$RN DEF $RNTB ADDRESS OF RN TABLE SPC 2 * * REQUEST IS A NORMAL WRITE, CONTROL OR READ. * THE PARAMETERS OF THE REQUEST ARE MOVED * INTO THE ID SEGMENT OF THE REQUESTING * PROGRAM. THE ID SEGMENT IS THEN LINKED * INTO THE I/O LIST FOR THE REFERENCED DEVICE. * THE -SCHEDULER- IS THEN CALLED TO REMOVE * THE PROGRAM FROM THE SCHEDULED LIST AND TO * CHANGE THE PROGRAM STATUS TO I/O SUSPENSION. * L.10 CLA IN CASE RQP3=0 LDB RQP3,I SET CONTROL WORD LDA RQP1 (A) = REQUEST CODE CPA .3 IF CONTROL GO JMP L.101 SET IT UP * *M1 LDB XTEMP+4 GET THE ADDRESS OF THE RENT *M1 ADB .15 BIT IN THE ID-SEG. *M1 LDA B,I GET THE WORD TO A *M1 ALF,RAL PUT THE BIT IN SIGN OF A LDB RQP3 BUFFER ADDRESS TO B *M1 CLE,SSA IF BIT SET *M1 JSB $REIO GO MOVE THE TDB (IF NEEDED) *M1* *M1 SPC 1 *M1 IFZ *M1***** BEGIN DMS CODE *************** *M1 CLA,CCE *M1 CPA $MVBF WAS TDBH MOVED *M1 RSS NO *M1 RBL,ERB YES,SET SIGN IN ID SEG BUFFER TMP *M1 STA $MVBF CLEAR TDB MOVED FLAG *M1******* END DMS CODE *************** XIF SPC 1 STB XTEMP+1,I SET BUFFER ADDRESS OR CONTROL WORD LDA RQP4,I BUFFER STA XTEMP+2,I LENGTH AND LDA RQP2,I GET THE CON WORD CMA,CME SET COMPLEMENT IOR TEMPL MERGE WITH DISC FLAG (FLIPS BIT 12) LDB RQP5 GET SECOND BUFFER ADDRESS ALF,SLA IF NONE SZB,RSS RSS LDB B,I GET THE OPTION WORD SEZ,SLA,RSS IF RENT AND DOUBLE BUFFER JSB $REIO GO CHECK OUT THE BUFFER ADDRESS STB XTEMP+3,I SET THE PRAMETER IN THE ID-SEGMENT * CLA IN CASE RQP6=0 LDA RQP6,I SET THE FINAL OPTIONAL WORD STA XTEMP+4,I IN THE ID-SEGMENT * CLE,RSS SKIP CONTROL SET UP L.101 STB XTEMP+1,I SET CONTROL WORD LDA WORD2 GET CONTROL WORD STA XTEMP,I SAVE IN TEMPORARY #1 LDB XEQT SET ADDRESS OF LINK WORD STB TEMP1 IN TEMP1. * JSB $LIST CALL SCHEDULER TO SUSPEND PROG. OCT 402 - ID SEG. ADDR./I/O SUSPEND - * * CALL -LINK- TO PERFORM THE LINKING OF THE NEW * BLOCK INTO THE DEVICE QUEUE OF * WAITING OPERATIONS. * L.13 LDB XSUSP,I SET THE SUSP POINT STB XA,I IN XA FOR THE ABORT ROUTINE L.132 LDA RQRTN AND SET THE RETURN ADDRESS STA XSUSP,I IN THE ID-SEG. JSB LINK LINK SETS E=0 IF EMPTY QUEUE LDB EQT1 IF DUMMY EQT FOR LU=0 CPB $DMEQ THEN JMP L.135 GO TO COMPLETE * * SEZ,RSS IF QUEUE WAS EMPTY CALL DRIVR. * * EMPTY LIST, CALL TO INITIATE CURRENT REQUEST. * JSB DRIVR JMP $XEQ - OPERATION INITIATED - JMP NOTRD - OPERATION REJECTED OR COMPLETED - * L.135 LDB RQP4,I GET THE REQUEST LENGTH L.136 SSB AND SET UP NLHHN CMB,INB THE TLOG LDA .2 SET A FOR IMMEDIATE COMPLETION SPC 1 IFN * BEGIN NON-DMS CODE ************** JMP R00 AND GO TO COMPLETION SECTION *** END NON-DMS CODE ************** XIF SPC 1 IFZ ***** BEGIN DMS CODE ************** SJP R00 AND GO TO COMPLETION SECTION ******* END DMS CODE ************** XIF SPC 1 * * STATUS REQUEST SECTION * L.15 LDA RQCNT INSURE THAT AT LEAST 2 ADA N2 PARAMETERS PROVIDED - ONE SSA TO STORE STATUS WORD. JMP ERR01 -NO, ERROR '01'. * LDB EQT5,I STORE WORD 5 OF EQT ENTRY IN STB RQP3,I 'STAT1' LDA EQT4,I STORE WORD 4 OF EQT ENTRY IN STA RQP4,I 'STAT2' IF CODED. * LDB TEMP1 ADB DRT LDA B,I GET SUBCHANNEL FOR DRT WORD#1 AND B174K ALF,RAL PUT INTO LOW 5 BITS ADB LUMAX LDB B,I GET UP/DOWN BIT OF LU CLE,ELB (DRT WORD#2) RAL,ERA ADD TO SUBCHANNEL BITS STA RQP5,I STORE IN 'STAT3' * LDA RQRTN UPDATE THE STA XSUSP,I RETURN ADDRESS JMP $XEQ AND EXIT SPC 3 RQPX NOP * * **************************************************************** * * SUBROUTINE STADV: * * STADV WILL RETURN AT THE UP EXIT IF LU=0. IT THEN * CHECKS TO DETERMINE IF THE CURRENT EQT IS DOWN(BIT 14 * EQT WORD 5) OR IF THE LU IS DOWN(BIT 15 DRT WORD 2). IF * DOWN, RETURN IS MADE AT P+1. IF UP, RETURN IS MADE AT P+2. * * CALLING SEQUENCE: * :=ADDRESS OF STATUS WORD FOR THIS EQT. * :=LU#-1. * JSB STADV * * RETURN: * (P+1) EQT OR LU DOWN. * (P+2) EQT AND LU UP. * ALL REGISTERS ARE VIOLATED. * ****************************************************************** * STADV NOP CPA B77 IF LU=0 (LESS 1, SO 77B), G JMP STAD9 THEN GO TO UP EXIT. ADA DRT GET DRT WORD ADA LUMAX 2 AND CHECK LDA A,I IF THE LU IS SSA UP OR DOWN. JMP STADV,I LU IS DOWN. * LDB EQT5,I LU IS UP, SO RBL,SLB CHECK IF THE JMP STAD9 EQT IS UP OR SSB DOWN. JMP STADV,I EQT IS DOWN. * STAD9 ISZ STADV LU AND EQT JMP STADV,I ARE UP. SKP * SUBROUTINE: -LINK- * * PURPOSE: THIS ROUTINE PROVIDES FOR ADDING * AN I/O REQUEST INTO THE SUSPENDED * LIST (QUEUE) CORRESPONDING TO THE * REFERENCED DEVICE. THE PROCEDURE * OF ADDING AN ENTRY INTO THE LIST * INVOLVES ONLY THE ALTERATION OF * THE LINKAGE VALUE IN THE NEW ENTRY * AND IN THE ENTRY PRECEDING THE * NEW ONE IN THE PRIORITY CHAIN. * THE NEW ENTRY IS LINKED ACCORDING * TO ITS PRIORITY AND ON A FIFO * BASIS WITHIN THE SAME PRIORITY * LEVEL. THE END OF A LIST IS MARKED * BY A LINKAGE VALUE OF ZERO. THE * FIRST ENTRY IN A LIST IS SKIPPED * BECAUSE IT IS ASSUMED TO BE THE * REQUESTOR FOR THE CURRENT I/O * OPERATION. IF THE LIST IS EMPTY, * THE LINK WORD IN THE EQT ENTRY * IS SET TO POINT TO THE NEW ENTRY * AND AN INDICATION IS GIVEN TO * THE CALLER OF -LINK- THAT THE * NEW REQUEST MAY BE INITIATED. * * CALL: THE FOLLOWING LOCATIONS MUST BE * SET TO THE INDICATED VALUES * BEFORE THE CALL IS MADE: * * TEMP1 = LOCATION OF NEW REQUEST * TO BE LINKED INTO THE * I/O LIST DEFINED BY THE * CURRENT EQT ENTRY. THE * ADDRESS OF THE LINKAGE * WORD IN THE EQT ENTRY * IS IN -EQT1-. * * TEMP2 = PRIORITY OF THE NEW * REQUEST. * * TEMPL = DISC QUEUE FLAG (# 0 MEkANS DISC) * * - JSB LINK * - (RETURN) (E) = 0 IF THE NEW * REQUEST IS THE ONLY ENTRY * IN THE I/O LIST, I.E. THE * DRIVER MAY BE CALLED TO * INITIATE THE NEW OPERATION. * * THERE ARE NO ERROR CONDITIONS * DETECTED OR DIAGNOSED BY THIS * ROUTINE. * * SKP LINK NOP SPC 1 IFZ ***** BEGIN DMS CODE ************** RSA RAL,RAL STA QCKST SJP *+2 ******* END DMS CODE ************** XIF SPC 1 MIC8 JMP MIC9 OR LDB EQT1 IF NO MICRO CLE,RSS SET FIRST FLAG AND SKIP * * FIRST ENTRY IN LIST IS SKIPPED BECAUSE IT * IS THE CALLER FOR THE CURRENT OPERATION * ACTIVE ON THE I/O DEVICE. * ************************************************* **WILL ENTER IN EITHER MAP,BUT THIS IS OK BECAUSE **THE LIND WORD WILL BE IN THE ENABLED MAP AREA** ************************************************* LINK1 SEZ,CCE,RSS IF NOT FIRST SKIP JMP LINK7 GO START THE SCAN * STB TEMP3 TEMP3 = ADDRESS OF CURRENT ENTRY. CCE,INB EXAMINE THE LDA B,I TYPE FIELD IN WORD 2 OF BLOCK INB TO DETERMINE LOCATION RAL OF PRIORITY. SSA IF BUFFERED REQUEST JMP LINK8 B POINTS AT PRIORITY * SLA,RSS IF USER REQUEST JMP LINK5 GO BUMP BY 4 * CLA USE PRIORITY 0 FOR SYSTEM JMP LINK2 NO USE ZERO PRIORITY * LINK5 ADB .4 IS IN WORD 7 OF ID SEGMENT. LINK8 LDA B,I GET PRIORITY OF CURRENT ENTRY. LINK2 LDB TEMP3 CMA,INA SUBTRACT CURRENT PRIORITY FROM ADA TEMP2 PRIORITY OF NEW REQUEST. SSA IF CURRENT IS LOWER PRIORITY JMP LINK3 (HIGHER #), GO TO LINK NEW. * LINK7 STB TEMP5 SAVE PREVIOUS ENTRY POINTER LDB B,I GET NEXT ENTRY ELB,CLE,ERB CLEAR POSSIBLE SIG+N BIT SZB IF END-OF-LIST, SKIP. JMP LINK1 -CONTINUE SCAN. * * PROPER POSITION (BY PRIORITY) IS FOUND IN LIST, * OR ELSE THE SCAN OF THE LIST IS FINISHED AND * THE NEW REQUEST IS ADDED AS THE LAST ENTRY. * LINK3 LDA TEMP1 SET ADDRESS OF NEW ENTRY IN STB TEMP1,I SET ADDRESS OF NEXT OR 0 IF LAST XOR TEMP5,I KEEP SIGN OF OLD WORD AND C100K IF IT WAS SET XOR TEMP5,I STA TEMP5,I SET THE POINTER TO THE NEW REQUEST SPC 1 LINK9 EQU * IFN * BEGIN NON-DMS CODE ************** JMP LINK,I -EXIT TO CALLER. *** END NON-DMS CODE ************** XIF SPC 1 IFZ ***** BEGIN DMS CODE ************** JRS QCKST LINK,I - EXIT TO CALLER. ******* END DMS CODE ************** XIF SPC 1 SPC 1 MIC9 LDA TEMP2 (A)=PRIORITY OF NEW REQ. LDB TEMP1 (B)=ADDR OF NEW REQUEST LNK EQT1 0B DO MICRO CALL JMP LINK9 RETURN * A SYSTEM REQUEST HAS BEEN FOUND IN THE QUE * SYSTEM DISC REQUESTS ARE QUED BY THE PRIORITY IN * WORD 7 OF THE CALL. OTHER SYSTEM REQUEST ARE AT * PRIORITY ZERO. SKP SPC 1 IFZ ***** BEGIN DMS CODE ************** ************************************************** *******THIS ROUTINE SETS UP THE APPROPRIATE MAP *******FOR THE DRIVER WHICH IS BEING CALLED******* ****************************** ******************* * * ************************************************ ************************************************* ***********WARNING WARNING WARNING************* ***********NO EXTERNAL ROUTIN SHOULD CALL********** ************$DVM OR $RSM EXCEPT SPOOL DRIVER**** ************************************************** ************************************************* * * * $DVM NOP SJP *+2 CLA STA DVMPS LDB EQT1,I GET DRIVER LINK WORD SSB,RSS IF SIGN SET, EXIT IN SYSTEM MAP SZB,RSS LEAVE IN SYS MAP NJMP $DVM,I * LDA B INA LDA A,I CHECK T FIELD IN CONTROL WORD RAL SSA T=1 0R 3 IF S=1 JMP $DVM,I LEAVE SYSTEM MAP ENABLED * SLA,RSS JMP DVUSR T=0,GO SET USER MAP * ADB .4 T=2,GET ID WORD IN SYS CALL LDB B,I SZB,RSS IS IT 0 JMP $DVM,I YES,USE SYSTEM MAP * DVUSR LDA EQT1,I ADA .2 LDA A,I GET USER BUFFER ADR FROM ID TMP WORDS CCE,SSA WAS BUFFER MOVED TO SAM? JMP $DVM,I YES,STAY IN SYS MAP * ISZ DVMPS SET THE 'MAPS SWITCHED FLAG' LDA ASVUI GET THE LOCAL SAVE ADDRESS USA AND SAVE THE CURRENT USER MAP ADB .14 IS CURRENT USER LDA B,I CORE RESIDENT? AND .15 CPA .1 WELL? JMP MEMRS YES GO SET MEM RES MAP * ADB .7 STEP TO THE MAP ADDRESS LDA B,I GET MAPID WORD STB DTMP AND B77 GET PARTITION NUMVER STA B MULTIPLY BY 6 ADB B THE FAST WAY *2 ADB A *3 ADB B *6 ADB $MATA GET MAT ENTRY ADR LDA DTMP,I ALF RAL,RAL GET # PAGES AND B37 ISOLATE JSB $SMAP GO SET UP USER MAP UJP $DVM,I ENABLE USER MAP * * MEMRS LDA $MRMP USA UJP $DVM,I MEM RES MAP ENABLED * * DTMP NOP .14 DEC 14 ASVUI DEF SVUSR,I ASVUS DEF SVUSR SVUSR BSS 32 DVMPS BSS 1 DRIVER MAP FLAG * ********RESTORE USER MAP TO PRE-****** ********DRIVER STATE****************** * * $RSM NOP CLA CPA DVMPS WAS USER MAP CHANGED JMP RSEX NO,RETURN * STA DVMPS YES,CLEAR CHANGE MAP FLAG LDA ASVUS USA RESTORE ORIGINAL USER MAP RSEX SJP $RSM,I ENABLE SYSTEM MAP ******* END DMS CODE ************** XIF SPC 1 SPC 4 * SUBROUTINE: D/ -DRIVR- * * PURPOSE: THIS ROUTINE PROVIDES A CENTRAL POINT * FOR CALLING AN I/O DRIVER TO INITIATE * A NEW OPERATION. THIS ROUTINE, BEFORE * CALLING A DRIVER, SETS THE REQUEST * PARAMETERS INTO THE APPROPRIATE WORDS * IN THE EQT ENTRY CORRESPONDING TO THE * REFERENCED DEVICE AND ASSIGNS A DMA * CHANNEL IF REQUIRED. * IT ALSO SETS THE DEVICE TIME-OUT CLOCK. * * REQUIREMENTS: THE ADDRESSES OF THE EQUIPMENT * TABLE ENTRY (15 WORDS) MUST BE SET * IN EQT1 TO EQT15 BEFORE THE ROUTINE * IS CALLED. * * CALLING SEQUENCE: - PARAMETER SET UP AS ABOVE- * - (REGISTERS MEANINGLESS) - * * (R) JSB DRIVR * (P+1) -OPERATION INITIATED OR STACKED * (P+2) -OPERATION REJECTED OR COMPLETED- * * ERRORS/DIAGNOSTICS: A DRIVER IS CALLED ONLY * IF THE UNIT IS AVAILABLE * AND NOT BUSY; OTHERWISE, * RETURN IS MADE TO THE * CALLER. IF THE DRIVER * FINDS THE UNIT UNAVAILABLE * OR THE REQUEST ILLEGAL FOR * THE UNIT, THE INDICATION IS * RETURNED TO THE CALLER FOR * FURTHER ACTION. * DRIVR NOP LDA EQT5,I CHECK AVAILABILITY RAL OF DEVICE SSA,SLA IF DMA WAIT JMP DVR00 GO DO DMA WAIT THING. * CMA,SSA,SLA,RSS IF DOWN OR BUSY JMP DRIVR,I EXIT * * * DEVICE IS AVAILABLE - CHECK FOR DMA REQUIREMENT * LDA EQT4,I SKIP DMA CHANNEL ASSIGNMENT IF SSA,RSS NOT REQUIRED ( D FIELD = 0 ) JMP DRV02 IN WORD 4 OF EQT ENTRY. SPC 1 * DMA CHANNEL REQUIRED - ATTEMPT TO ASSIGN CHANNEL * DVR0 LDA DMACF IF DMA QUEUE IS NOT EMPTY B2002 SZA JMP DVR1 THEN JUST ADD THIS EQT TO QUEP. * DVR00 LDA .6 INITIALIZE FOR STA CHAN CHANNEL 6 (DMA # 1 ) LDB INTBA ADDR. OF DMA 1 IN INTERRUPT TABLE CLA IF DMA CHANNEL # 1 CPA B,I AVAILABLE (INTBL ENTRY = 0), JMP DRV01 GO TO ASSIGN IT TO THIS UNIT. * INB SET FOR CHANNEL 7, ISZ CHAN DMA CHANNEL # 2. CPA B,I IF THIS CHANNEL AVAILABLE, JMP DRV01 GO TO ASSIGN IT. * * NO CHANNEL AVAILABLE - SET FLAGS AND RETURN * DVR1 LDA EQT5,I IF DEVICE RAL SSA,SLA IS ALREADY WAITING FOR DMA, JMP DRIVR,I EXIT. * RAR IOR B140K SET AVAIL TO SAY WAITING FOR STA EQT5,I DMA, ADD 1 TO ISZ DMACF # DEVICES WAITING. JMP DRIVR,I - EXIT TO CALLER - * DRV03 SEZ,CLE,INB STEP OVER PRIORITY AND INB IF CLASS REQUEST OVER CLASS WORD AND .6 ISOLATE REQUEST (A IS SHIFTED REMEMBER) CPA .6 IF CONTROL REQUEST JMP DRV2 GO SET IT UP * STB A SET BUFFER ADDRESS ADA .4 IN A (SKIP LENGTH AND TWO OPTION WDS) JMP DRV3 GO FINISH SET UP. * * ASSIGN AVAILABLE CHANNEL * DRV01 LDA EQT1 SET EQT ENTRY ADDRESS IN INTER- STA B,I RUPT TABLE ENTRY FOR CHANNEL. LDB DMACF IF UNIT WAS LDA EQT5,I PREVIOUS WAITING RAL SSA,SLA FOR A DMA ADB N1 CHANNEL, SUBTRACT 1 FROM # OF STB DMACF UNITS WAITING. RAR ALR,RAR CLEAR STA EQT5,I FIELD. SPC 1 IFZ ***** BEGIN DMS CODE ************** JSB $DVM GO SET MAP LDA DVMPS DVMPS=0 SYS, 1=USER RAR PUT INTO BIT15 IOR CHAN 0=PORTA, 1=PORTB XMA INTO BIT0, IGNORE 1-14 JMP DV02C ******* END DMS CODE ************** XIF SPC 1 * * TRANSFER REQUEST PARAMETERS TO EQT ENTRY * DRV02 EQU * IFZ ***** BEGIN ^DMS CODE ************** JSB $DVM GO SET MAP ******* END DMS CODE ************** XIF SPC 1 DV02C LDB EQT1,I GET CURRENT REQUEST ADDRESS INB FROM LINK WORD OF EQT ENTRY. LDA B,I GET REQUEST CONTROL WORD, AND NTSUB SET SUBCHANNEL BITS TO ZERO STA EQT6,I SET IN EQT 6. XOR B,I SET SUBCHANNEL RAL,RAL NUMBER INTO RAL,SLA,RAL BITS 10-6 OF WORD XOR B2002 SET HIGH BIT, CLEAR LOW BIT STA TEMPL SAVE FOR EQT4 LDA B,I CLE,ELA IF REQUEST IS DRV2 INB SSA HELD AS A TEMPORARY BLOCK FOR JMP DRV03 BUFFERING, JUMP. SPC 1 IFN * BEGIN NON-DMS CODE *************** LDA B,I *** END NON-DMS CODE *************** XIF SPC 1 SPC 1 IFZ ***** BEGIN DMS CODE *************** AND .6 CPA .6 CCA,RSS THIS IS A CONTROL CALL LDA C100K AND B,I ******* END DMS CODE *************** XIF SPC 1 DRV3 STA EQT7,I ADDRESS. INB LDA B,I SET BUFFER STA EQT8,I LENGTH. INB DLD B,I SET ADDITIONAL 2 DST EQT9,I PARAMETERS IF SUPPLIED. * * CALL DRIVER -INITIATION- SECTION * LDA EQT14,I SET DEVICE LDB EQT15,I TIME OUT CLOCK ONLY SZB,RSS IF NOT CURRENTLY RUNNING STA EQT15,I LDA EQT4,I ZERO TIME-OUT AND C7700 BIT AND SET IOR TEMPL IN SUBCHANNEL STA EQT4,I SET (A) = CHANNEL AND B77 # OF I/O DEVICE. LDB EQT2,I CALL DRIVER *INITIATION* JSB B,I SECTION. SKP * DRIVER RETURNS AN INDICATION OF THE ACCEPTANCE * OR REJECTION OF THE REQUESTED OPERATION: * (A) = 0, OPERATION SUCCESSFULLY INITIATED * (A) NOT = 0, OPERATION REJECTED AND (A) * CONTAINS A NUMERIC CODE * IDENTIFYING THE CAUSE OF * THE REJEC10T. * * = 1 READ OR WRITE REQUEST ILLEGAL FOR DEVICE * = 2 CONTROL REQUEST ILLEGAL OR NOT DEFINED * = 3 EQUIPMENT MALFUNCTION OR NOT READY * = 4 IMMEDIATE COMPLETION OF OPERATION * = 5 DRIVER REQUIRES DMA BUT FLAG IS NOT SET IN EQT * STA TEMP6 SAVE DRIVER CODE. SPC 1 IFZ ***** BEGIN DMS CODE ************** JSB $RSM GO RESTORE USER MAP LDA TEMP6 RESTORE DRIVER CODE ******* END DMS CODE ************** XIF SPC 1 CCE,SZA IF REJECTED, JMP DRV06 EXAMINE REASON * * OPERATION INITIATED * LDB EQT5,I SET RBL,ERB = 2 TO SAY DEVICE LDA EQT1,I SZA STB EQT5,I IN OPERATION. JMP DRIVR,I EXIT. * * OPERATION REJECTED * DRV06 STB TLOG SAVE (B) CLA CLEAR DEVICE STA EQT15,I TIME-OUT CLOCK JSB CLDMA CLEAR DMA IF ALLOCATED LDA TEMP6 (A) = REJECT CODE. CPA .5 IF DMA REQUIRED JMP DVR0 GO ATTEMPT ASSIGNMENT ISZ DRIVR SET RETURN TO (P+2). CPA .3 IF NOT READY THEN JMP DRIVR,I -EXIT. JMP ILLCD ELSE GO TO SEND THE MESSAGE SPC 1 C7700 OCT 170077 NTSUB OCT 153703 INCLUDE Z BIT B174K OCT 174000 HED < I/O MODULE SUBSECTION - SYSTEM REQUEST PROCESSOR > * SYSTEM I/O REQUEST PROCESSOR - $XSIO- * * A PRIVATE ENTRY IS PROVIDED AT ENTRY POINT * < $XSIO> TO ALLOW MODULES OF THE REAL TIME * EXECUTIVE TO CALL FOR I/O OPERATIONS WITHOUT * INCURRING THE OVERHEAD AND PROCEDURES * INVOLVED WITH USER I/O REQUESTS. NO ERROR * CHECKING IS PERFORMED, THE REQUEST IS LINKED * INTO THE APPROPRIATE I/O LIST AT A PRIORITY * LEVEL OF ZERO (HIGHEST PRIORITY), AND CONTROL * IS RETURNED TO THE FIRST WORD FOLLOWING THE * REQUEST CALL. * REQUEST FORMAT: A SYSTEM I/O REQUEST DIFFERS * FROM THE USER I/O REQUEST IN * FORMAT AND POWER. SPECIFICALLY, * A SYSTEM DISC CALL CAN SPECIFY A * SERIES OF TRANSFERS TO BE * PERFORMED BEFORE THE NEXT * OPERATION IS INITIATED. A * COMPLETION ADDRESS CAN BE * SPECIFIED FOR OPERATION OF * AN OPEN SUBROUTINE AT THE * END OF THE OPERATION. THIS * FACILITY IS ONLY AVAILABLE * TO SYSTEM ROUTINES AND IS * USED TO RESET FLAGS, ETC. * BECAUSE AN OPERATION IS * ALWAYS BUFFERED TO THE * SYSTEM. A ZERO COMPLETION * ADDRESS INDICATES ABSENCE * OF A COMPLETION ROUTINE. * WORD * ---- EXT $XSIO * 1 JSB $XSIO * 2 OCT * 3 DEF * 4 NOP * 5 OCT * 6 DEF * 7 DEC OR * * DISC VERSION OF REQUEST: * WORD 6 OF REQUEST POINTS TO AN ARRAY * CONTAINING -N- SETS OF TRIPLETS * DECLARING BUFFER ADDRESS, LENGTH AND * TRACK/SECTOR ADDRESS FOR EACH TRANSFER. * THE SET OF TRIPLETS IS OPEN-ENDED AND * TERMINATED BY A ZERO WORD: * * 1 DEF < BUFFER ADDRESS> * 2 DEC < BUFFER LENGTH > * 3 OCT < TRACK/SECTOR #> * . ETC * . . * N DEC 0 (END OF TRIPLETS) * FOR DISC REQUEST THE 7'TH WORD IS THE REQUEST PRIORITY. * * $XSIO NOP CCB ADB $XSIO,I GET LOGICAL UNIT #. STB $CKLO SAVE FOR *STADV* ADB DRT INDEX INTO DRT. LDA B,I GET ASSIGNED EQT ENTRY #. STA TEMPL AND SAVE IT JSB $CVEQ CONVERT TO ABSOLUTE EQT ADDRESSES * LDB $XSIO SET eADDRESS ADB .2 OF LIST POINTER WORD IN STB TEMP1 REQUEST FOR . * LDA TEMPL GET THE SUBCHANNEL WORD AND B174K ISOLATE SUBCHANNEL CLE,INB P+4 IS ADDR OF CONWORD ELA,ALF SIGN TO E ELA,SLA,RAL ADA B20K ADA SIGN ADD 'SYSTEM REQUEST' BIT XOR B,I ADD CONWORD INFO AND SUBCH =B120074 REMOVE EXCESS XOR B,I STA B,I PUT THE RESULT BACK IN THE QUE CLA SET PRIORITY OF REQUEST = 0 STA TEMP2 FOR , STA CONFL SET CONTROL FLAG = 0 (REQUEST). ADB .3 M1 BUMP RETURN ADDR STB $XSIO FOR REGULAR RETURN JSB LINK CALL TO LINK REQUEST IN I/O LIST. * SEZ IF DEVICE NOT BUSY JMP $XSIO,I * LDA $CKLO NOT BUSY, JSB STADV LU OR EQT DOWN? RSS YES, GO COMPLETE. * JSB DRIVR CALL DRIVER TO INITIATE OPERATION JMP $XSIO,I -GOOD REQUEST,EXIT * LDB $XSIO BAD NEWS SO TRANSFER THE STB XSIOE RETURN ADDRESS FOR NR ROUTINE * JMP NOTRD PRINT DIAGNOSTIC. SPC 1 XSIOE NOP SUBCH OCT 120074 SUBCHANNEL MASK PLUS SYSTEM RQ CODE HED < I/O CONTROL MODULE - COMPLETION SUBSECTION > * * I/O COMPLETION SUBSECTION * * THIS SECTION IS RESPONSIBLE FOR THE INITIATION * OF STACKED I/O OPERATIONS, PLACING A USER * PROGRAM BACK IN A SCHEDULED STATE WHEN ITS * I/O OPERATION IS COMPLETED, DYNAMIC ALLOCATION * OF THE TWO DMA CHANNELS AMONG SYNCHRONOUS * DEVICES, AND CALLING FOR OPERATOR NOTIFICATION * OF EQUIPMENT MALFUNCTION. * * IS ENTERED DIRECTLY FROM INTERRUPT CONTROL * WHEN AN I/O OPERATION IS TERMINATED AND ALL * ERROR RECOVERY PROCEDURES HAVE BEEN ATTEMPTED. * ON ENTRY TO THIS SECTION, (B) CONTAINS THE * NUMBER OF WORDS TRANSFERRED. THE ADDRESSES OF * THE EQUIPMENT TABLE ENTRY ARE SET IN -EQT1- TO * - EQT 15-. * * HFB REQUESTS ARE STACKED IN LISTS FOR EACH DEVICE * ACCORDING TO PRIORITY. THE REQUESTS ARE EITHER * USER (NORMAL), USER (AUTOMATIC OUTPUT BUFFERING) * OR SYSTEM - IDENTIFICATION OF REQUEST TYPE * THE CODE IN BITS 15-14 OF THE * IN EACH REQUEST CALL. THE FORMATS OF THE THREE * TYPES OF REQUESTS AS THEY APPEAR IN THE I/O * LISTS ARE: * * 1) USER (NORMAL OPERATION) T=0 * 8H* THE PARAMETERS FROM THE REQUEST ARE STORED * IN THE TEMPORARY AREA OF THE PROGRAM ID * SEGMENT. THE LINK WORD OF THE SEGMENT IS * USED TO LINK INTO THE I/O LIST. * * WORD CONTENTS * ---- -------- * 1 < LINKAGE WORD > * 2 * 3 * 4 * 5 * 6 * 7 * . -REMAINDER OF ID SEGMENT . * * SKP * 2) USER (AUTOMATIC OUTPUT BUFFERING) T=1 * * REQUESTS OF THIS TYPE ARE CONSTRUCTED * IN THE SECTION OF SYSTEM AVAILABLE MEMORY. * * WORD CONTENTS * ---- -------- * 1 < LINKAGE WORD > * 2 * 3 * 4 * 5 * 6 * 7 * 8 * . . . . * . . . . * N+7 * * 3) USER (CLASS INPUT/OUTPUT) T=3 * * REQUESTS OF THIS TYPE ARE CONSTRUCTED * IN THE SECTION OF SYSTEM AVAILABLE MEMORY. * * WORD CONTENTS * ---- -------- * 1 < LINKAGE WORD > * 2 * 3 (CHANGED TO STATUS AT COMP.) * 4 * 5 * 6 (CHANGED TO TLOG AT COMP.) * 7 * 8 * 9 * . . . . * . . . . c* N+8 * * * 4) SYSTEM REQUEST T=2 * * THE SYSTEM REQUEST IS LINKED INTO * THE I/O LIST BY USING WORD 4 OF THE * CALL AS A LINK WORD. A SYSTEM * REQUEST ASSUMES THE PRIORITY LEVEL * OF ZERO (HIGHEST PRIORITY). * * WORD CONTENTS * ---- -------- * 1 < JSB $XSIO > * 2 < LOGICAL UNIT # > * 3 * 4 < LINKAGE WORD > * 5 * 6 * 7 * 8 * * THE FIELD (BITS 15-14 IN CONTROL WORD) * IDENTIFIES THE REQUEST TYPE AS: * * 00 USER (NORMAL OPERATION) * 01 USER (AUTOMATIC BUFFERING) * 10 SYSTEM * 11 CLASS I/O * * SKP IOCOM RAL,CLE,ERA CLEAR THE SIGN BIT AND SAVE IN E STA TEMP3 SAVE STATUS FROM DRIVER AND STB TLOG TRANSMISSION LOG STB XLOG SPC 1 IFZ ***** BEGIN DMS CODE ************** JSB $RSM GO RESTORE USER MAP IF NECESSARY ******* END DMS CODE ************** XIF SPC 1 * CLA CLEAR STA EQT15,I CLEAR TIME-OUT CLOCK * LDA EQT4,I SET THE COMPLETION SECTION FLAG STA CONFL AND TEST FOR DMA RETURN SEZ,RSS SIGN OF A IS EXPLICID RETURN OF SSA DMA CHANNEL, CALL TO JSB CLDMA RELEASE ITS ASSIGNMENT. * L.49 LDB EQT1,I GET CONTROL WORD FROM CLE,SZB,RSS IF ILLEGAL ENTRY JMP CIC.4 SEND ERROR MESSAGE * SSB,INB JMP L.502 CLEAN UP IF CLEAR COMPLETION * STB IOE11 SAVE ADDR OF CONTROL WORD FOR *IOERR* LDA B,I EXTRACT FIELD. STA TEMP0 SAVE CONTROL WORD. LDB EQT1,I LDOA TEMP3 CPA .1 ERROR? JMP NOTRD YES, GO PROCESS * LDA B,I STA EQT1,I UNLINK CURRENT I/O REQUEST LDA TEMP0 RAL,SLA,ELA IF BIT 15 = 1 ( = 2 OR 3) JMP L.53 PROCESS AS SYSTEM REQUEST. * SEZ,RSS IF = 0, PROCESS JMP L.51 AS NORMAL USER REQUEST. * * RELEASE AUTOMATIC BUFFERING BLOCK * LDA TEMP3 BY PASS RELEASE OF SZA BUFFER IF MALFUNCTION STB EQT1,I SZA JMP L.70 * STB L.50 ADB .3 LDB B,I BLOCK LENGTH AND STB L.50+1 SET IN RELEASE CALL. * JSB $RTN RELEASE BLOCK TO AVAILABLE MEM. L.50 NOP - BLOCK ADDRESS - NOP - BLOCK LENGTH - L.501 JSB $CKLO CHECK IF BELOW THE LIMIT JMP L.54 THEN GO START THE NEXT REQUEST * L.502 ADB C100K SUBTRACT ONE AND SIGN BIT STB EQT1,I RESET IN THE EQT AND JMP L.55 GO START THE NEXT RQ. * * NORMAL USER OPERATION COMPLETION * L.51 STB L.52 SET CURRENT ADDR. FOR SCHEDULER. ADB .9 SET (B) = ADDR. OF XA IN ID SEG. LDA TEMP3 GET COMPLETION STATUS CLE,SZA SET BIT 14 CCE IN STATUS WORD LDA EQT5,I IF THE STATUS RAL,RAL IS NON-ZERO ERA,CLE,ERA AND SAVE IN USER A-REG. STA B,I CONTENTS OF PROGRAM. INB STB TEMP9 SAVE TRANSMISSION LOG ADDRESS LDA TLOG SET TRANSMISSION LOG AS STA B,I SAVED B-REGISTER. * ADB .5 INDEX TO THE STATUS WORD LDA B,I AND SAVE FOR STA TEMPX DISC ERROR ROUTINE * JSB $LIST CALL SCHEDULER MODULE TO PLACE OCT 101 USER PROGRAM INTO L.52 NOP LIST. JMP L.54 * * SYSTEM REQUEST COMPLETION * L.53 EQU * *M1 SEZ,CLE COMPLETION FOR *M1 JMP L.56 CLASS I/O REQUEST * ADB N1 GET WOaRD 3 OF REQUEST LDA B,I . STA COMPL SAVE COMPLETION ADDR. OR ZERO. * SKP * < L.54 > : AT THIS POINT: * 1) A TEMPORARY BUFFER HAS BEEN RELEASED, * 2) A NORMAL OPERATION HAS CAUSED THE * REQUESTING PROGRAM TO BE LINKED * BACK INTO THE LIST, OR * 3) A SYSTEM REQUEST COMPLETION ADDRESS * HAS BEEN SAVED. * L.54 LDA TEMP3 DON'T START NEXT OPER. IF ERROR CMA,SSA,INA,SZA OCCURRED ON COMPLETION OR JMP L.70 ON CLASS I/O INITIATION * * L.55 LDA EQT5,I CHECK FIELD. RAL SSA IF AV SAYS DOWN JMP IOCX GO EXIT * * SECTION <60> PROVIDES FOR INITIATING THE NEXT * OPERATION WAITING FOR THE COMPLETED DEVICE. * L.60 LDA EQT5,I SET ALR,RAR FIELD STA EQT5,I = 0 TO SAY AVAILABLE. JMP L.68 GO START THE NEXT REQUEST * *M1L.56 LDA TLOG (A) = TRANSMISSION LOG *M1 JSB $C.CL (B) = CLASS QUEUE PTR, CALL CLASS COMPLETION *M1 JMP L.501 GO DO NEXT ONE * * .1 DEC 1 .2 DEC 2 .4 DEC 4 .6 DEC 6 .7 DEC 7 .15 DEC 15 .11 DEC 11 * * CHECK IF BELOW THE BUFFER LIMIT ON THE CURRENT EQT. * $CKLO NOP LDB $BLLO CHECK IF BELOW THE LIMIT. JSB $QCHK JMP $CKLO,I NO, SO RETURN. * LDA B YES, SO SCHEDULE ANY WAITERS JSB $SCD3 AND JMP $CKLO,I RETURN. SKP * * THIS DEVICE IS COMPETING WITH OTHER DEVICES FOR * THE USE OF THE AVAILABLE DMA CHANNEL. THE * FIELD IN THE CURRENT ENTRY IS SET = 3 TO MEAN * WAITING FOR DMA. THE EQT IS THEN SCANNED FROM * FIRST TO LAST ORDER (#1 TO N) TO FIND THE FIRST * UNIT WAITING FOR DMA. THEREFORE, THE ORDER OF * THE EQT DETERMINES PRIORITY FOR DYNAMIC ASSIGN- * MENT OF DMA CHANNELS - THE SYSTEM DISC SHOULD * BE THE FIRST ENTRY IN THE EQT. * L.63 LDA EQT#  SET # OF CMA,INA EQT ENTRIES STA TEMP1 AS AN INDEX VALUE. LDB EQTA INITIALIZE TO FIRST EQT ENTRY. * L.64 STB TEMP2 SAVE CURRENT ENTRY ADDR. ADB .4 EXTRACT LDA B,I FIELD FROM RAL WORD 5. SSA,SLA IF A = 3, GO TO JMP L.66 ASSIGN DMA. * L.65 ADB .11 SET (B) FOR NEXT ENTRY. ISZ TEMP1 END OF EQT? JMP L.64 - NO, CONTINUE SCAN * CCA DECREMENT THE DMA COUNT ADA DMACF (MUST HAVE ABORTED A DMA STA DMACF WAIT WITH 'OF,XXX,1' REQUEST) JMP IOCX EXIT * L.66 CLA,INA IF ONLY 1 DEVICE WAITING CPA DMACF FOR DMA, GO TO JMP L.67 ASSIGN TO THIS DEVICE. * LDA TEMP2 IF CURRENT UNIT IS CPA EQTA FIRST IN EQT (I.E SYSTEM DISC) JMP L.67 ASSIGN ANYWAY. * CPA EQT1 IF SAME DEVICE JUST COMPLETED, JMP L.65 ALLOW OTHER DEVICES DMA TIME. * L.67 LDA TEMP2 IF DEVICE TO BE INITIATED IS CPA EQT1 SAME AS INTERRUPTING DEVICE, RSS SKIP SETTING EQT ADDRESSES. * JSB $ETEQ SET EQT ADDRESSES. * * CALL IF A REQUEST IS STACKED OR A * WAITING UNIT IS ASSIGNED A DMA CHANNEL. * L.68 LDA EQT1 GO CLEAN OUT ANY CPA $DMEQ I/O REQUESTS IF THIS JMP IOCX7 IS THE BIT BUCKET * LDB EQT1,I IF NO REQUEST SZB,RSS WAITING, JMP IOCX EXIT. * JSB DRIVR CALL RSS IF GOOD REQUEST THEN SKIP JMP NOTRD DIAGNOSTIC IF NOT AVAILABLE. SKP * **************************************************************** * * I/O COMPLETION - EXIT SECTION. * * THIS ROUTINE FIRST CHECKS FOR A DMA QUEUE AND IF ANY AND IF A * CHANNEL IS AVAILABLE, THEN THE CHANNEL ASSIGNMENT ROUTINE * IS ENTERED. IF THIS CONDITION DOES NOT EXIST, THEN * IF THE "BIT BUCKE{T FLAG" IS SET, THEN THE BIT BUCKET * I/O REQUEST ARE CLEANED OUT. IF THE FLAG IS NOT SET, THEN * IF THE REQUEST IS A SYSTEM REQUEST WITH A COMPLETION ADDRESS, * THEN CONTROL IS TRANSFERED TO THE COMPLETION ADDRESS. IF * NEITHER OF THESE CONDITIONS EXITS, THEN THE OPERATOR ATTENTION * FLAG IS CHECKED. IF SET, THEN THE OPERATOR ACKNOWLEDGEMENT * ROUTINE IS ENTERED. IF NOT SET, THEN CONTROL IS RETURNED * TO THE SYSTEM. * ***************************************************************** * IOCX LDA DMACF GET THE DMA QUEUE FLAG SZA,RSS IF EMPTY QUE THEN JMP IOCX1 GO EXIT * DLD INTBA,I ELSE GET THE DMA FLAGS SZA IF ANY SZB,RSS AVAILABLE JMP L.63 GO ALLOCATE IT. * IOCX1 LDB $BITB CHECK THE "BIT BUCKET FLAG" TO SEE SZB TO SEE IF THE BIT BUCKET MUST BE JMP IOCX0 CLEANED OUT. * LDA COMPL IF SYSTEM REQUEST STB COMPL CLEAR COMPLETION SPECIFICATION. LDB XLOG SZA COMPLETION ROUTINE SPECIFIED, JMP A,I OPERATE IT. * LDB OPATN GET OPERATOR ATTENTION FLAG STA OPATN - CLEAR FLAG - SZB IF OPERATOR DESIRES CONTROL, JMP $TYPE ACKNOWLEDGE. JMP $XEQ OTHERWIZE, RETURN TO THE DISPATCHER. * XLOG NOP SKP * * * CLEAN OUT BIT BUCKET REQUESTS. * * IOCX0 LDA $DMEQ SET UP THE BIT JSB $ETEQ BUCKET EQT ADDRESSES. IOCX7 LDB EQT1,I CHECK IF THERE IS ANY SZB,RSS I/O REQUEST TO BE JMP IOCX9 INITIATED ON THE BIT BUCKET. * LDB EQT1,I YES, SO GET THE REQUEST'S ADB .3 SIZE AND DO AN IMMEDIATE LDB B,I COMPLETION. JMP L.136 * IOCX9 STB $BITB NO, SO CLEAR BIT BUCKET FLAG AND JSB $CKLO CHECK BUFFER LIMITS AND SCHED.WAITERS. JMP IOCX1 * $BITB NOP BIT BUCKET FLAG. DO NOT TfOUCH. SKP * * I/O DEVICE COMPLETION ERROR FROM DRIVER * (A) = ERROR CODE * L.70 LDA TEMP3 CPA .3 IF PARITY ERROR, CCE,RSS CHECK FOR DISC. JMP IOERR - OTHER ERROR CONDITION - * LDA EQT5,I IF AND B36K DEVICE CPA B14K IS DISC, PUT JMP DISCE OUT SPECIAL MESSAGE. * LDA .3 PARITY ERROR ON JMP IOERR OTHER DEVICE, PRINT DIAG. * * * DISC ERROR PROCESSING (SYSTEM/USER) * DISCE LDA TLOG (A) = ERROR TRACK ADDRESS. JSB $CVT3 CONVERT TO DECIMAL ASCII. INA DLD A,I SET DECIMAL TRACK DST DMSG+1 IN ERROR MESSAGE. JSB CPEQT COMPUTE EQT ENTRY # (SETS E). JSB $CVT1 STA DMSG+5 SET IN ERROR MESSAGE. * LDA EQT4,I GET SUBCHANNEL ALF,ALF AND CONVERT RAL,RAL TO ASCII AND B37 JSB $CVT1 STA DMSG+7 * * LDA EQT1 SAVE DISC STA TEMP7 -EQT- ADDRESS LDA COMPL SAVE REQUEST (SYSTEM) STA TEMP8 COMPLETION ADDRESS * LDA DMSGA PRINT DIAGNOSTIC: JSB $SYMG "TRNNNN EQTXX,UYY S(OR U)" * * LDA L.52 (A)= ID SEGMENT ADDRESS LDB TEMPX GET THE SAVED STATUS AND IF NO-ABORT SET SSB,RSS SKIP THE ABORT JSB $ABRT -- ABORT PROGRAM -- * STB TLOG SET TLOG FOR SYSTEM EXIT LDA TEMP8 RESET "COMPLETION" STA COMPL ADDRESS. LDA TEMP7 RESET EQT STA CONFL SET FLAG FOR COMPLETION. JSB $ETEQ ADDRESSES JMP L.60 * * DMSGA DEF *+1 DEC -18 DMSG ASC 9,TRNNNN EQTXX,UYY U BLS ASC 1, S B36K OCT 36000 HED < I/O CONTROL MODULE - ERROR SECTION > * * I/O REQUEST ERROR SECTION * * PART 1: ERRORS ENCOUNTED IN ANALYSING A * USER REQUEST CAUSE A DIAGNOSTIC * TO BE PRINTED ON THE SYSTEM * TELETYPEWRITER AND THE USER * PROGRAM ABORTED\H. THE FORMAT OF * THE DIAGNOSTIC IS: * * 'IONN PNAME RADDR' * * AS CONSTRUCTED AND SET * BY THE ROUTINE -$ERMG- IN * THE PROGRAM <$RQST>. -NN- IS A * CODE IDENTIFYING THE ERROR TYPE. * ERR01 CLB,INB INSUFFICIENT # OF PARAMETERS RSS ERR02 LDB .2 ILLEGAL LOGICAL UNIT REFERENCE, RSS = 0 OR UNDEFINED. ERR04 LDB .4 USER BUFFER VIOLATES SYSTEM * LDA ERIO (A) = ASCII * IO *. JMP $ERAB WRITE DIAGONISTIC AND EXIT TO DISPATCHER * ERIO ASC 1,IO SKP * PART 2: ILLEGAL REQUEST DETECTED BY * I/O DRIVER. THE REASON IS A READ OR * WRITE OPERATION IS ILLEGAL FOR THE * DEVICE OR A CONTROL REQUEST IS * MEANINGLESS FOR THE DEVICE. * AN ADDITIONAL REASON FOR TRANSFER TO THIS * SECTION IS AN "IMMEDIATE COMPLETION" (CODE 4) * RETURN FROM THE DRIVER; PROCESSED AS A * CONTROL REJECT. * * * ERROR PROCEDURE IS: * 1. IF THE REQUEST IS PROCESSED AS * BUFFERED OUTPUT, THE TEMPORARY * BLOCK IS RELEASED TO AVAILABLE * MEMORY. * * 2. THE REJECT IS IGNORED IF A SYSTEM * PROGRAM GENERATED THE REQUEST - * HOWEVER, A COMPLETION ROUTINE, * IF SPECIFIED IN THE REQUEST, IS * OPERATED. (NOTE: THIS PHILOSOPHY * IS BASED ON THE ASSUMPTION THAT * THIS CONDITION SHOULD NEVER OCCUR.) * * 3. A USER CONTROL REQUEST WHICH IS * REJECTED IS TREATED AS IF IT * WAS PERFORMED. THE PROGRAM IS * LINKED BACK INTO THE SCHEDULE LIST. * * 4. A USER READ OR WRITE REQUEST REJECT * CAUSES A DIAGNOSTIC TO BE ISSUED * AND THE PROGRAM ABORTED. SKP ILLCD CLB CPA .4 IF CODE =4 FOR IMMEDIATE RAR,SLA COMPLETION, TREAT AS CONTROL R00 STB TLOG | ELSE SET TLOG TO 0. STA TEMP4 REJECT, SAVE CODE. CPA .2 SET ERROR FLAG FOR CLA CLASS COMPLETION = 0 CMA,INA NEGATE STATUS TO SKIP STA TEMP3 MESSAGE FOR CONT.REJ LDB EQT1,I GET LOCATION OF LDA B,I ILLEGAL REQUEST (LINK ADDR.) STA TEMP0 SAVE NEXT REQUEST ADDRESS. INB GET CONTROL WORD LDA B,I OF REQUEST BLOCK STA EQT6,I SAVE FOR REXIT RAL CHECK FIELD SSA,RSS FOR TYPE OF REQUEST BLOCK. JMP R02 -USER OR SYSTEM- * *M1 CCE,SLA IF CLASS REQUEST (SET E=1) *M1 JMP L.49 GO DO CLASS COMPLETION. * ADB .2 BUFFERED BLOCK. LDB B,I GET TOTAL BLOCK LENGTH. STB R01+1 SET IN RELEASE CALL. LDA EQT1,I SET FWA OF BLOCK STA R01 IN RELEASE CALL. JSB $RTN RELEASE BLOCK. R01 NOP - FWA - NOP - # WORDS - JMP REXIT * R02 SLA,RSS CHECK FIELD AGAIN. JMP R03 -USER PROGRAM REQUEST- * ADB N2 GET WORD IN SYSTEM REQUEST LDA B,I CONTAINING -COMPLETION ROUTINE- STA COMPL ADDRESS OR 0 AND SAVE IT. JMP REXIT * R03 LDA TEMP4 USER REQUEST- CPA .2 CONTINUE IF CONTROL REQUEST JMP R04 REJECTED. * LDA EQT1,I SET ID SEGMENT ADDRESS OF PROGRAM STA XEQT CONTAINING ERROR. ADA .8 GET POINT OF SUSPENSION ADDRESS LDB A,I GET RETURN ADDRESS STB RQRTN AND SAVE ON BASE PAGE CCE,INA SET XSUSP STA XSUSP TO POINT TO SAVED INITIAL CALL ADDRESS LDA EQT1 SAVE CURRENT STA TEMP9 EQT ENTRY ADDRESS. LDA CONFL SAVE CURRENT STA SCONF *CONTROL FLAG* LDA TEMP4 ALLOW FOR FUTURE ERROR CODES CPA .1 WHICH MAY BE >4 LDA .7 ALL OTHER CODES CHANGED TO 7 JSB $CVT1  AND CONVERTED TO ASCII LDB A LDA ERIO (A) = ASCII * IO * JSB $ERMG PRINT DIAGNOSTIC CLA SET XEQT STA XEQT TO ZERO TO FOURCE RELOAD LDA SCONF RESTORE STA CONFL *CONTROL FLAG* LDA TEMP9 RESTORE UNIT JSB $ETEQ EQT ENTRY ADDRESSES. JMP REXIT * R04 LDA EQT1,I SET PROGRAM ID SEGMENT STA R05+2 ADDR. IN LIST CALL. ADA .9 (A) = ADDR. OF XA IN ID SEGMENT. LDB EQT5,I SET DEVICE STATUS STB A,I WORD IN XA. LDB TLOG STORE INA TRANSMISSION LOG STB A,I IN XB. R05 JSB $LIST CALL SCHEDULER OCT 101 TO LINK PROGRAM BACK NOP INTO SCHEDULE LIST. * REXIT LDA TEMP0 SET NEXT LIST STA EQT1,I ENTRY ADDRESS. LDA EQT6,I GET CONWORD REXI2 CLB STB TEMP3 CLEAR ERROR FLAG CPB CONFL COMPLETION SECTION SSA,RSS OR NON-$XSIO CALL? JMP L.501 YES, GO TO L.60 TO DO NEXT REQUEST * JMP $XSIO,I $XSIO ERROR RETURN * * SKP * ********************************************************************** * * I/O DEVICE ERROR SECTION * * THIS SECTION IS ENTERED WHEN A DEVICE IS UNAVAILABLE FOR * INITIATION OF AN OPERATION OR WHEN AN ERROR IS DETECTED AT THE * END OF AN OPERATION. A DIAGNOSTIC MESSAGE IS PRINTED ON THE * SYSTEM CONSOLE IN THE FOLLOWING FORMAT: * * I/O MN LXX EYY SZZ * * WHERE: XX = THE LOGICAL UNIT NUMBER OF THE DEVICE * YY = THE EQT NUMBER OF THE DEVICE * ZZ = THE SUBCHANNEL NUMBER OF THE DEVICE * MN = A MNEMONIC DESCRIBING ONE OF THE FOLLOWING CONDITIONS: * 1. NR - DEVICE IS NOT READY * 2. ET - END-OF-TAPE OR TAPE SUPPLY LOW ON THE DEVICE * 3. PE - TRANSMISSION PARITY ERROR TO/FROM THE DEVICE * 4. TO - THE DEVZICE TIMED OUT * -- NEW CODES MAY BE ADDED HERE -- * * GIVEN A BAD I/O REQUEST, IOERR WILL DOWN ALL LU'S ASSOCIATED WITH * THE DEVICE(DEFINED BY THE EQT AND SUBCHANNEL). ALL I/O CHANNELS * ASSOCIATED WITH THE EQT ARE CLEARED. ALL I/O REQUESTS ASSOCIATED * WITH THE DEVICE ARE UNSTACKED FROM THE EQT'S I/O REQUEST QUEUE AND * RELINKED IN THE LOWEST LU'S(MAJOR LU) I-O REQUEST QUEUE(DRT ENTRY * WORD 2)BY THE SUBROUTINE UNLNK. DRT ENTRY WORD 2 OF OTHER DOWNED * LU'S ARE SET TO THE LU NUMBER OF THE MAJOR LU. THE LU DOWN BIT(BIT * 15 OF DRT ENTRY WORD 2)FOR EACH DOWNED LU IS SET. THE EQT ENTRY IS * NOT SET DOWN. I/O ERROR MESSAGES ARE ISSUED FOR ALL LU'S SET DOWN. * * ON ENTRY, CONTAINS A NUMBER CORRESPONDING TO THE ASSOCIATED * MNEMONIC AND EQT1 CONTAINS THE ADDRESS OF WORD ONE OF THE ASSOCIATED * DEVICE'S EQT ENTRY. * * THE FOLLOWING TEMPORARY LOCATIONS ARE USED FOR TEMPORARY STORAGE BY * IOERR: * :=SUBCHANNEL-EQT WORD FOR THE BAD I-O REQUEST GIVING THE * SUBCHANNEL IN BITS 11-15 AND THE EQT IN BITS 0-5(USED BY * LUERR). * :=WORD 2 OF THE BAD I-O REQUEST. * ********************************************************************** * SKP NOTRD LDB EQT1,I LU NOT READY ENTRY. INB GET BAD I/O REQ.CONTROL WORD STB IOE11 & SAVE ADDR FOR *IOERR* CLA,INA NOT READY, SET (A)=1 * IOERR LDB EQT1 STB HEAD REMOVE ALL RELATED ENTRIES IN QUEUE * ADA ERTBL INDEX TO ERROR CODE TABLE. LDA A,I GET MNEMONIC AND SET STA IOMSG+2 IN DIAGNOSTIC MESSAGE. * LDA BLL SET UP STA IOMSG+3 "L" AND LDA BLS "S" IN THE STA IOMSG+7 DIAGNOSTIC MESSAGE. * JSB CPEQT GET EQT NUMBER(SETS E=1). STA TEMP8 SAVE EQT NUMBER. JSB $CVT1 CONVERT TO ASCII STA IOMSG+6 AND SAVE(E MUST = 1). SHFB* LDA EQT4,I GET LAST SUBCH USED FROM EQT4 ALF,RAL AND POSITION TO HIGH 5 BITS AND B174K MASK OUT LOWER 11 BITS IOR TEMP8 AND ADD IN EQT NUMBER. STA TEMP8 SAVE AS SUBCHANNEL-EQT WORD. * ALF,RAL GET SUBCHANNEL AND B37 NUMBER. JSB $CVT1 CONVERT TO ASCII(ON ENTRY,E MUST=1) STA IOMSG+8 AND SAVE. * JSB LUERR DOWN THE LOGICAL UNITS(ENTRY A#0). LDA EQT5,I SET AVAIL TO 0 AFTER LUERR CALL ALR,RAR SO WE WON'T ENTER DRIVER TO PRINT STA EQT5,I ERROR IF DRIVER STILL BUSY (IF SAME) SEZ CHECK IF WE TRIED TO JMP IOER9 DOWN LU 1. IGNORE ATTEMPT. * * LDA EQT1 LDB A,I CHECK IF WE MUST SZB INITIATE AN JSB $DLAY I/O REQUEST OF THIS EQT. * LDB IOE11,I GET SAVED WORD 2(CONWORD) LDA CONFL FOR THE BAD I/O REQUEST. SZA IF COMPLETION SECTION IS IN JMP IOCX CONTROL, THEN EXIT IOC. * RBL,SLB IF REQUEST SECTION IN CONTROL, SSB CHECK IF USER OR SYSTEM I/O REQUEST. JMP IOCX IF USER, GO TO EXECUTION SECTION. JMP XSIOE,I IF SYSTEM, RETURN TO SYSTEM CALLER. * IOER9 LDA CONFL SAVE CONTROL 2H STA SCONF FLAG. CLA,INA SET JSB $CVT1 ASC11 1 STA IOMSG+4 INTO MESSAGE. JSB $SYMG ISSUE MESSAGE. LDA SCONF RESTORE FLAG. STA CONFL JMP L.60 * * * IOMSA DEF *+1 DEC -18 IOMSG ASC 9,I/O MN LXX EYY SZZ * * * * I/O DEVICE ERROR MNEMONIC TABLE--ORDERED BY * ERROR CODE DESCRIBING CONDITION. * ERTBL DEF * ASC 1,NR - NOT READY - ASC 1,ET - END OF TAPE (INFORMATION) - ASC 1,PE - TRANSMISSION PARITY ERROR - ASC 1,TO - TIMED-OUT - * * NEW CODES MAY BE ADDED AT THIS POINT * SBMSK OCT 20074 MASK TO SAVE SUBCHANNEL BITS BLL ASC 1, L HEAD NOP IOE11 NOP * SKP * ***************************************************************** * * SUBROUTINE LUERR * * THIS SUBROUTINE IS USED TO DOWN ALL LU'S CORRESPONDING TO A * SPECIFIC EQT AND SUBCHANNEL. IT WILL OPTIONALLY PRINT AN * ERROR MESSAGE FOR EACH DOWNED LU. * * CALLING SEQUENCE: * :=0 DO NOT PRINT I/O ERROR MESSAGES * :#0 PRINT I/O ERROR MESSAGES(ASSUMES ASCII EQT AND * SUBCHANNEL ALREADY SET) * := POINTER TO I/O REQUEST LIST TO SCAN. * :=SUBCHANNEL-EQT WORD FROM THE BAD I-O REQUEST. * JSB LUERR * * RETURN: * :=1 TRIED TO DOWN LU 1 * :=0 DID NOT TRY TO DOWN LU 1 * NO REGISTERS ARE SAVED. * SUBROUTINE UNLNK USES TEMP0 AND OTHERS. * USES THE FOLLOWING REGISTERS: * :=FLAG AS TO WHETHER TO PRINT(#0) OR NOT PRINT(=0) * I/O ERROR MESSAGES. * :=USED TO STORE THE MAJOR LU. * :=COUNTER FOR SCAN THROUGH DRT. * :=USED TO SAVE POINTER INTO DRT. * :=USED TO SAVE EQT1. * :=USED TO STORE LU TEMPORARILY. * ****************************G************************************** * LUERR NOP STA TMP1 * LDA CONFL SAVE CURRENT STA SCONF CONTROL FLAG. * CLA SET MAJOR LU STA TMP2 TO ZERO. * LDA LUMAX SET CMA,INA UP STA TMP3 COUNTER. LDB DRT GET FIRST DRT ENTRY. * SKP D.00 LDA B,I GET DRT WORD 1 STB TMP4 SAVE POINTER IN DRT. AND C3700 COMPARE DRT WORD 1 TO THE SUBCHANNEL- CPA TEMP8 EQT WORD(LESS THE LOCK FLAG). RSS IF EQUAL,FOUND A LU,SO GO PROCESS. JMP D.04 OTHERWIZE,GO CONTINUE SCAN OF DRT. * LDA LUMAX FOUND A LU MATCH SO PROCESS IT. CCE,INA COMPUTE THE(SET E=1 FOR POSSIBLE LU=1) ADA TMP3 LU NUMBER. STA TMP8 SAVE LU NUMBER FOR LATER. CPA .1 CHECK TO SEE IF SYSTEM CONSOLE. IF SO, JMP D.06 DO NOT SET THE DEVICE DOWN. ADB LUMAX POSITION POINTER TO DRT WORD 2. LDA TMP2 CHECK TO SEE IF A MAJOR SZA LU HAS BEEN FOUND JMP D.02 IF SO,THEN STORE THE MAJOR LU # IN WORD * 2,SET THIS LU BUZY,ISSUE MESSAGE. * STB A SAVE DRT WORD 2 ADDRESS. LDB EQT1 SAVE EQT1 ADDRESS STB TMP6 FOR RESTORATION. LDB HEAD GO UNLINK ANY I/O REQUESTS JSB $UNLK FROM GIVEN I-O QUEUE DEF TEMP8 LDA TMP8 SAVE THIS LU STA TMP2 AS MAJOR LU. LDB TMP4 RESTORE POINTER TO DRT WORD 2. ADB LUMAX LDA B,I D.02 CCE RAL,ERA SET THE(E MUST=1) STA B,I LU BUZY. LDB TMP1 CHECK IF WE ARE TO PRINT ERROR CCE,SZB,RSS MESSAGES(SET E=1 FOR $CVT1). JMP D.025 NO, SO SKIP. * LDA TMP8 JSB $CVT1 CONVERT LU TO STA IOMSG+4 ASCII AND SAVE. LDA IOMSA GET LU I/O ERROR MESSAGE JSB $SYMG AND ISSUE TO USER. LDA TMP6 RESTORE JSB $ETEQ EQT POINTERS. D.025 LDB TMP4 * D.04 INB INCREMENT POINTER TO NEXT DRT ENTRY. ISZ TMP3 JMP D.00 GO SCAN NEXT ENTRY. * JSB $CKLO CHECK BUFFER LIMITS AND SCHED WAITERS. CLE D.06 LDA SCONF RESTORE CONTROL STA CONFL FLAG. JMP LUERR,I IF NO MORE LU ENTRIES, RETURN. SKP * *********************************************************************** * * SUBROUTINE $UNLK * * THIS SUBROUTINE IS USED TO UNLINK I/O REQUESTS FROM THE EQT I/O * REQUEST QUEUE POINTED TO BY EQT1. IT MAY BE USED IN ONE OF TWO * MODES: * MODE I. IF ON ENTRY THE A REGISTER EQUALS ZERO, NORMAL USER * (UNBUFFERED)I-O REQUESTS ARE UNLINKED WITH THE CALLING * PROGRAMS SUSPENDED IN THE GENERAL WAIT LIST. IT IS * ASSUMED THAT THE EQT WILL BE SET DOWN BY THE CALLER. * MODE II. IF ON ENTRY THE A REGISTER IS NONZERO, THEN ONLY I/O * REQUESTS MATCHING THE SUBCHANNEL GIVEN IN SUEQT ARE * UNLINKED. UNBUFFERED I/O REQUESTS ON THIS SUBCHANNEL ARE * HANDLED AS IN MODE I. BUFFERED, CLASS AND SYSTEM * I/O REQUESTS ARE STACKED UPON AN LU I/O REQUEST QUEUE AFTER * THE I/O REQUEST POINTED TO BY THE A REGISTER IN THE ORDER * THAT THEY APPEARED IN THE EQT QUEUE. * * CALLING SEQUENCE: * :=THE SUBCHANNEL-EQT WORD DEFINING THE DEVICE(MODE II * ONLY, UNUSED WITH MODE I). * :=EQT1(HEAD OF THE I-O REQUEST QUEUE)OF THE DEVICE'S * EQT(USED WITH MODE I AND II). * :=0 INDICATES MODE I PROCESSING. * :#0 INDICATES MODE II PROCESSING. POSITION IN LU I/O REQUEST * QUEUE AFTER WHICH ALL UNLINKED I-O REQUESTS ARE * TO BE RELINKED. * JSB $UNLK * DEF SUEQT * * RETURN: * NO REGI7ISTERS ARE SAVED. * USES UNLK3,UNLK8,UNLK9,TEMPX,TEMP0 * ************************************************************************ SKP $UNLK NOP STA UNLK8 SET UP POINTER TO THIS I/O REQUEST QUEUE. SPC 1 IFZ ***** BEGIN DMS CODE *************** RSA SAVE MEU RAL,RAL STATUS. STA UNLKS ******* END DMS CODE *************** XIF SPC 1 LDA $UNLK,I GET LDA A,I SPC 1 IFZ ***** BEGIN DMS CODE *************** SJP *+2 ******* END DMS CODE *************** XIF SPC 1 AND B174K SUBCHANNEL CLE,ELA AND SHIFT RAL,RAL UPPER BIT ALF TO BIT 13 SEZ ADD IN LOWER 4 BITS ADA B20K AT BITS 2-5 STA TEMP0 AND SAVE. RSS * UNLK0 LDB TEMPX,I GET NEXT ENTRY. STB TEMPX SAVE POINTER TO PREVIOUS REQUEST. UNLK2 LDB TEMPX,I GET POINTER TO THIS REQUEST. RBL,CLE,ERB STRIP OFF POSSIBLE SIGN BIT. SZB,RSS IF END, JMP UNLK6 THEN GO EXIT. * STB UNLK3 SAVE POINTER TO THIS REQUEST. INB STEP TO CONTROL WORD OF THIS REQUEST. LDA UNLK8 CHECK IF MODE I OR II PROCESSING. SZA,RSS JMP UNL25 MODE I SO SKIP SUBCHANNEL CHECK. * LDA B,I GET CONTROL WORD OF THIS REQUEST. AND SBMSK PICK OFF SUBCHANNEL INFORMATION AND CPA TEMP0 COMPARE TO THE SUBCHANNEL INFO OF RSS THE BAD I/O REQUEST. IF NOT EQUAL, JMP UNLK0 GO CHECK THE NEXT I-O REQUEST. * UNL25 LDA B,I GET CONTROL WORD OF THIS I/O RAL REQUEST AND ROTATE IT. CMA,SSA,SLA,RSS IF NOT STANDARD USER REQUEST, JMP UNLK4 GO PROCESS AS OTHER TYPES. * LDA .4 STANDARD USER, SO SUSPEND PROGRAM STA B,I IN GENERAL WAIT LIST. ADB .8 SET TEMP WORD #1 IN ID-S:EG.TO 4. LDA B,I STEP TO SAVE A REG., GET SAVED ADB N1 POINT OF SUSPENSION, AND STORE STA B,I IT IN XSUSP FOR THIS PROGAM. LDA UNLK3,I UNLINK THIS I/O REQUEST STA TEMPX,I JSB $LIST LINK THIS PROGRAM INTO THE OCT 103 GENERAL WAIT LIST. UNLK3 NOP UNL35 JMP UNLK2 GO TRY NEXT ENTRY. * UNLK4 LDA UNLK8 CHECK IF MODE I OR II. SZA,RSS IF MODE I, DO NOT UNLINK JMP UNLK0 THIS REQUEST. GO TRY NEXT ONE. * LDB UNLK8,I IF MODE II, CLEAR RBL,CLE,ERB POSSIBLE SIGN BIT LDA UNLK3,I AND LINK THIS I-O STB UNLK3,I REQUEST TO THE LDB UNLK3 END OF THE DOWN STB UNLK8,I I/O REQUEST QUEUE. STB UNLK8 SET UNLK8 TO POINT TO THE LAST REQUEST. STA TEMPX,I (DO STA LAST, JUST IN CASE) JMP UNL35 GO TRY NEXT ENTRY. * UNLK6 ISZ $UNLK SPC 1 IFN * BEGIN NON-DMS CODE *************** JMP $UNLK,I INITIATE THE I/O REQUEST. *** END NON-DMS CODE *************** XIF SPC 1 IFZ ***** BEGIN DMS CODE *************** JRS UNLKS $UNLK,I INITIATE THE I/O REQUEST. * UNLKS NOP ******* END DMS CODE *************** XIF SPC 1 * UNLK8 NOP TEMPX NOP SKP * ****************************************************************** * * SUBROUTINE $DLAY: * * $DLAY IS USED TO SET UP A SHORT TIMEOUT(10 MSEC)WHICH, WHEN IT * OCCURS, SIGNALS THAT AN I/O OPERATION MUST BE INITIATED ON THE * TIMED-OUT EQT(SEE $DEVT). * * CALLING SEQUENCE: * LDA * JSB $DLAY * * RETURN: * ALL REGISTERS ARE MODIFIED. * ***************************************************************** * $DLAY NOP CCE,INA SET THE SIGN BIT LDB A,I ON TO INDICATE RBL,ERB WE MUST INITIATE AN STB A,I OPERATION. ADA .3 CCE LD6B A,I SET THE RBL,ERB EQT STB A,I BUZY. ADA .10 LDB N1 SET A STB A,I TIMEOUT ISZ $DLFL INCREMENT I/O DELAY INIT COUNT NOP IN CASE THERE IS NO TBG IN THE SYSTEM JMP $DLAY,I OF 10 MSEC. * $DLFL NOP HED < IO-DEVICE TIME-OUT PROCESSOR > * * * AFTER A DEVICE IS DISCOVERED TO HAVE TIMED-OUT * BY RTIME'S $CLCK PROCESSOR,THIS * ROUTINE IS ENTERED. ITS PURPOSE IS TO * CLEAR THE PENDING IO TRANSFER AND ENTER * IOCOM IN SUCH A WAY AS TO SIMULATE AN IO * COMPLETION RETURN FROM THE DRIVER ITSELF. * * IF THE TIMEOUT WAS DUE TO THE NEED TO INITIATE AN * I/O OPERATION(BIT 15 EQT2 SET)THEN THIS BIT * IS CLEARED AND IOCOM IS ENTERED(AT L.60) TO * INITIATE THE I/O OPERATION. * * * ENTER FROM SCHEDULER MODULE: * * (A)

* * $DEVT ADA N14 POINT TO EQT JSB $ETEQ SET EQT ADDRESSES LDA EQT1,I GET THE CLEAR BIT SSA IF CLEAR TIME OUT JMP CLTIM JUST CLEAR * LDA EQT2,I CHECK IF THE TIMEOUT SSA IS FOR INITIATING I/O JMP INTDL ON THIS EQT. * LDA EQT4,I IOR B4K SET TIME-OUT BIT STA EQT4,I STA B SAVE WORD IN B FOR TEST AND B77 SELECT CODE TO A BLF,SLB IF DRIVER TO HANDLE TIME-OUT SPC 1 IFN * BEGIN NON-DMS CODE *************** JMP CIC.8 CALL DRIVER. I/O SELECT CODE IN (A) *** END NON-DMS CODE *************** XIF SPC 1 IFZ ***** BEGIN DMS CODE *************** STA INTCD JMP CIC.6 CALL DRIVER. I/O SELECT CODE IN 'INTCD' ******* END DMS CODE *************** XIF SPC 1 * CLTIM JSB $CLCH CLEAR ALL CHANNELS LDA .4 SERVICED BY THIS ENTRY CLB SIMULATE COMPLETION JMP IOCOM RETURN FROM DRIVER * INTDL RAL,CLE,ERA CLEAR INITIATION STA EQT2,I BIT. ISZ CONFL SET CONTROL FLAG TO NONZERO. JMP L.60 GO INITIATE. * N14 DEC -14 HED < I/O CONTROL MODULE - DATA SECTION > * ***************************************************************** * * CONSTANT AND VARIABLE STORAGE AREA * ******************************************************************* * A EQU 0 DEFINE SYMBOLIC REFERENCES B EQU 1 FOR A AND B REGISTERS. .3 DEC 3 .5 DEC 5 .8 DEC 8 .9 DEC 9 N1 DEC -1 * B77 OCT 77 B377 OCT 377 B140K OCT 140000 B40K OCT 40000 B4K OCT 4000 SIGN OCT 100000 * MIC0 EQU * TEMP2 LIA 6 TEMP3 SZA,RSS MX OR XE? TEMP4 JMP NMX0 NO TEMP5 LDA .CXA TEMP6 SZB,RSS MICRO? TEMP7 STA MIC4 NO, B=0 TEMP8 SZB,RSS MICRO? TEMP9 STA MX1 NO TEMP0 LDA .CYB TEMPL STA MX4 TEMPW LDA .DLD TLOG SZB,RSS TMP1 STA MIC6 TMP2 LDA DFXII TMP3 SZB,RSS TMP4 STA MX6 TMP5 JMP NMX0 TMP6 DLD XI,I TMP8 EQU TMP6+1 .DLD EQU TMP6 DFXII EQU TMP6+1 DMACF NOP COMPL NOP MUST BE 0 AT INIT TIME * CONFL CXA .CXA EQU CONFL SCONF CYB .CYB EQU SCONF HED ** I/O CONTROL - OPERATOR COMMUNICATION ** * * I/O MODULE // OPERATOR COMMUNICATION * * * THE SYSTEM PES FOR COMMANDS FROM THE * OPERATOR TO CONTROL THE OVERALL STATUS OF * I/O EQUIPMENT, CHANGE ASSIGNMENT OF LOGICAL * UNITS AND TO INTERROGATE THE STATUS AND * PROPERITES OF THE DEVICES IN THE EQUIPMENT * TABLE. * * OPERATOR STATEMENTS ARE PROCESSED ONLY * FROM THE DESIGNATED SYSTEM TELETYPE. THE * ROUTINE IN THE SCHEDULING MODULE * IS RESPONSIBLE FOR STATEMENT DECODE AND * PARAMETER SEPARATION AND CONVERSION. THE * ASSOCIATED STATEMENT PROCESSOR IS CALLED * TO PERFORM THE REQUESTED ACTION. THE * STATEMENT PROCESSING IS ALL TABLE-DRIVEN * AS DESCRIBED IN THE LISTING AND DOCUMENTATION * OF THE SCHEDULING MODULE. * * * TWOR OF THE FOLLOWING STATEMENT PROCESSORS * MUST BE INCLUDED IN THE BASIC SYSTEM PACKAGE. * THESE ARE THE 'UP' AND 'DOWN' STATEMENTS * CONCERNING THE OVERALL STATUS OF I/O DEVICES. * THE OTHER THREE STATEMENT PROCESSORS ( LOGICAL * UNIT ASSIGNMENT, TIME-OUT, AND EQT STATUS) * ARE OPTIONAL AND MAY BE REMOVED BY DELETING * THE SECTIONS AND RE-ASSEMBLING THIS MODULE. * SKP * **************************************************************** * * 'DOWN' STATEMENT (REQUIRED) * * FORMAT: DN,N1 OR DN,,N2 * WHERE N1 IS THE EQT # OF THE I/O SLOT TO BE SET DOWN * OR N2 IS THE LU # OF THE I/O DEVICE TO BE SET DOWN. * * ACTION: WHEN SETTING THE EQT DOWN, THE AVAILABILITY FIELD OF THE * REFERENCED SLOT IS SET = 1(SLOT DISABLED). * WHEN SETTING THE LU DOWN, BIT 15 OF DRT WORD 2 IS SET AND * ANY I/O FOR THIS DEVICE IS REMOVED FROM THE EQT I/O * QUEUE AND ADDED TO THE LU I/O QUEUE HEADED AT DRT * WORD 2. * * CALL (FROM MESSAGE PROCESSOR): * * := N1 (EQT #) IN BINARY OR 0 * :=-1 OR N2 (LU #) IN BINARY * JMP $IODN * * RETURN IS TO <$XEQ> IF ACTION TAKEN OR TO -MESS.I- TO PRINT * * INPUT ERROR * IF N1 OR N2 ARE ILLEGAL OR IF BOTH ARE PRESENT. * **************************************************************** * $IODN SZA,RSS CHECK IF DN,0,LU OR DN,EQ JMP DNLU IT IS DOWN LU INB,SZB IT IS DOWN EQT. IF BOTH LU AND EQT ARE JMP $INER GIVEN, ISSUE INPUT ERROR MESSAGE. * JSB $EQCK CHECK LEGALITY OF EQT & SET EQT ADDRESSES. LDA EQT1 IF ATTEMPT TO DOWN EQT OF SYSTEM CPA SYSTY CONSOLE, ISSUE INPUT ERROR MESSAGE. JMP $INER * LDA EQT5,I SET AVAILABITY FIELD ALR,RAR TO 1 IOR B40K TO SET STA EQT5,I DOWN. * JSB XUPIO SET ANY DOWNED LU'S UP. * LDB EQT1,I GO PUT ALL WAITERS(UNBUFFERED RBL,CLE,ERB I/O)INTO THE BENERAL WAIT SZB,RSS LDB EQT1 CLA LIST. SKIP FIRST REQUEST. JSB $UNLK DEF A (DUMMY DEF FOR THIS MODE). JMP $XEQ RETURN. * DNLU STB A SAVE LU NUMBER. CMB,CLE,INB,SZB,RSS ISSUE AN ERROR MESAGE JMP $INER IF THE LU IS LESS THEN ADB LUMAX 1 OR IS GREATER THEN CCB,SEZ,RSS LUMAX. JMP $INER * ADB A USE LU NUMBER ADB DRT TO POSITION TO LDA B,I WORD 1 OF THE AND C3700 DRT ENTRY. STA TEMP8 SET UP SUBCHANNEL-EQT WORD. AND B77 INPUT SZA,RSS ERROR IF JMP $INER DOWNING BIT BUCKET DEVICE. * STB TEMP9 SAVE ADDRESS OF DRT WORD 1. JSB $CVEQ SET EQT ENTRY ADD(WILL MASK SUBCH.). * LDB EQT5,I CHECK IF RBL,SLB EQT IS JMP DNLU5 UP OR IS * SSB DOWN. JMP DNLU9 EQT IS DOWN. * DNLU5 LDB EQT1,I SKIP FIRST EQT I/O REQ QUEUE SZB,RSS ENTRY UNLESS QUEUE IS EMPTY LDB EQT1 STB HEAD * CLA SET FOR NO ERROR MESSAGES. JSB LUERR GO DOWN ALL LU'S POINTING TO DEVICE. SEZ ERROR IF ATTEMPT JMP $INER TO DOWN LU 1. * JMP $XEQ NO, RETURN TO SYSTEM. * DNLU9 LDB TEMP9 IF EQT IS DOWN, THEN ADB LUMAX GET DRT WORD 2 LDA B,I AND SET THE LU IOR SIGN DOWN. STA B,I JMP $XEQ RETURN. * C3700 OCT 174077 * * *$EQCK* SUBROUTINE TO CHECK LEGALITY OF AN * EQT # (IN A-REGISTER) AND TO CALL * A SUBROUTINE TO CONSTRUCT THE EQT * ENTRY ADDRESSES. * $EQCK NOP STA B ERROR CMB,INB,SZB IF EQT NO. IS ZERO SSA OR NEGATIVE CCB,RSS SKIP ADB EQT# CHECK FOR LIMITS SSB IF ANY ERROR, JMP $I݂NER GO TO $MESS ERROR EXIT. * JSB $CVEQ SET EQT ENTRY ADDRESSES. CLB STB CONFL CLEAR FLAGS JMP $EQCK,I * * SKP * **************************************************************** * * ' UP ' STATEMENT (REQUIRED) * * FORMAT: UP,NN WHERE NN IS THE EQT # * OF THE I/O DEVICE * * ACTION: THE AVAILABILITY FIELD OF THE REFERENCED SLOT(EQT ENTRY * #)IS SET = 0 (UNIT AVAILABLE). THE AVAILABILITY FIELD OF * ANY DEVICES(BIT 15 DRT WORD 2) REFERENCING THIS EQT ARE * SET = 0 AND THE LU'S' I/O QUEUES ARE ADDED TO THE EQT'S * I/O QUEUE. IF THE EQT WAS AVAILABLE OR DOWN, THEN THE * *IOCOM* SECTION(AT *L.68*)IS ENTERED TO INITIATE ANY * WAITING I/O REQUESTS. * * CALL (FROM MESSAGE PROCESSOR): * * := NN (EQT #) IN BINARY * JMP $IOUP * * RETURN IS MADE TO *IOCOM* OR TO *$XEQ* IF ANY ACTION * IS TAKEN. IF NN IS ILLEGAL, THEN RETURN IS MADE TO * *MESS,I* TO PRINT 'INPUT ERROR'. * ****************************************************************** * $IOUP JSB $EQCK CHECK 'NN' AND SET EQT ADDRESSES. $UPIO EQU * *** CAUTION - SOMEBODY DOES 'JMP $IOUP+1' FROM OUTSIDE SPC 1 IFZ ***** BEGIN DMS CODE ************** JSB $RSM GO RESTORE USER MAP IN CASE DRIVER CALL ******* END DMS CODE ************** XIF SPC 1 JSB CPEQT GET EQT# OF CURRENT EQT1 STA TMP1 LDA .4 RESCHEDULE ALL WAITING PGMS. JSB $SCD3 JSB CLDMA HELP POWER FAIL OUT WITH DMA. * JSB XUPIO SET RELATED LU'S UP * LDA EQT5,I GET AVAILABILITY ISZ CONFL SET THE CONTROL FLAG SSA,RSS IF DOWN OR AVAIL. JMP L.60 GO TRY TO OPERATE JMP $XEQ ELSE JUST FORGIT IT. SKP * ************************************************************************* * * SUBROUTINE XUPIO: a* * XUPIO IS USED TO UP ANY LU'S ASSOCIATED WITH THIS EQT. * * CALLING SEQUENCE: * :=THE ADDRESS OF THE FIRST WORD OF THIS EQT. * :=THE EQT NUMBER. * JSB XUPIO * * RETURN: * ALL REGISTERS ARE DISTROYED. * USES TMP2,TMP4,TMP6. * CALLS SUBROUTINE XXUP. * ************************************************************************* * XUPIO NOP LDA LUMAX SET CMA,INA UP STA TMP2 COUNTER. LDB DRT POSITION TO FIRST STB TMP6 DRT ENTRY. * UPIO1 LDA TMP6,I CHECK IF THIS AND B77 DRT ENTRY POINTS CPA TMP1 TO THE EQT. JMP UPIO5 YES. UPIO3 ISZ TMP6 NO. SO ISZ TMP2 GO CHECK JMP UPIO1 NEXT DRT ENTRY. JMP XUPIO,I RETURN. * UPIO5 LDB TMP6 POSITION TO DRT ADB LUMAX WORD2. STB TMP4 GO PLACE LDB B,I ENTRIES LDA EQT1 INTO EQT JSB $XXUP I/O QUEUE(RETURN B=0). STB TMP4,I SET THE LU 'UP'. JMP UPIO3 GO CHECK NEXT DRT ENTRY. SKP **************************************************************** * * SUBROUTINE $XXUP: * * $XXUP TAKES AN I/O QUEUE AND(USING LINK)POSITIONS THE I/O * REQUESTS IN THE CURRENT EQT QUEUE ACCORDING TO THEIR PRIORITY. * IT RETURNS A FLAG IF AN I/O OPERATION SHOULD BE INITIATED. * * CALLING SEQUENCE: * := EQT1 OF OLD DEVICE. * :=ADDRESS OF FIRST STACKED I/O REQUESTS TO BE LINKED ON * THE CURRENT EQT(SIGN BIT WILL BE STRIPPED). * JSB $XXUP * * RETURN: * :=0 * :#0 A NEW I/O OPERATION IS AT THE HEAD OF THE CURRENT * EQT I/O QUEUE SO IT MUST BE INITIATED. = * THE ADDRESS OF THE FIRST WORD OF THE EQT. * USES TEMP1,TEMP2,UNLK8,TEMP4,XXUP7 * ******************************31HFB*********************************** * $XXUP NOP H STA TEMP4 SAVE OLD DEVICE EQT1. SPC 1 IFZ ***** BEGIN DMS CODE *************** RSA SAVE MEU RAL,RAL STATUS. STA UNLKS SJP *+2 ******* END DMS CODE *************** XIF SPC 1 CLA CLEAR STA XXUP7 INITIATION FLAG. RBL,CLE,ERB STRIP OFF POSSIBLE SIGN BIT. XXUP9 SZB,RSS RETURN WHEN END OF I/O JMP XXUP2 REQUEST QUEUE IS FOUND. * STB TEMP1 ADB B176K SSB IF PTR<2000B THEN I/O STACKED JMP XXUP2 SO, EXIT WITH B=0 * LDB TEMP1 ELSE GET I/O REQ ADDR LDA B,I UNLINK THIS STA UNLK8 I/O REQUEST. INB LDA B,I GET INB PRIORITY RAL OF THE SSA I-O REQUEST JMP XXUP8 * SLA,RSS BUFFERED AND CLASS I-O REQUESTS. JMP XXUP5 NORMAL USER REQUEST. * LDA TEMP4 SYSTEM REQUEST. ADA .5 LDA A,I AND B36K CHECK IF THE OLD DEVICE CPA B14K IS A DISK OR NOT. JMP XXUP1 * .CLA CLA IF OLD DEVICE IS NOT A DISK, STA TEMPL SET TEMPL=0 AND USE JMP XXUP3 ZERO PRIORITY. * XXUP1 STA TEMPL IF OLD DEVICE IS A DISK, THEN INB,RSS SET TEMPL#0 AND USE PRIORITY. XXUP5 ADB .4 XXUP8 LDA B,I XXUP3 STA TEMP2 SAVE PRIORITY FOR LINK. JSB LINK LINK THIS REQUEST ONTO THE EQT. LDA EQT1 SEZ,RSS IF ONLY REQUEST ON THE EQT, THEN STA XXUP7 STORE INTO THE INITIATION FLAG. LDB UNLK8 LOOP FOR NEXT JMP XXUP9 I/O REQUEST. * * XXUP2 CLB LDA XXUP7 GET INITIATION FLAG SPC 1 IFN * BEGIN NON-DMS CODE *************** JMP $XXUP,I AND RETURN. *** END NON-DMS CODE *************** XIF SPC 1 IFZ ***** BEGIN DMS CODE *************** JRS UNLKS $XXUP,I AND RETURN. ******* END DMS CODE *************** XIF SPC 1 * XXUP7 NOP B176K OCT -2000 HED < I/O CONTROL MODULE - SUBROUTINE SECTION > * * SUBROUTINE: < $SYMG > (SYSTEM MESSAGE) * * PURPOSE: THIS ROUTINE PROVIDES FOR THE * OUTPUT OF SYSTEM MESSAGES AND * ERROR DIAGNOSTICS ON THE SYSTEM * TELETYPEWRITER. THE ROUTINE * MAINTAINS A 'ROTATING' BUFFER * AREA CONSISTING OF 5 10-WORD * BLOCKS - I.E., THE MAXIMUM * LENGTH OF A MESSAGE IS 18 * CHARACTERS (9-WORDS) PLUS 1 * WORD PRECEDING THE MESSAGE * WHICH CONTAINS THE CHARACTER * COUNT. * * CALL: (A) = ADDRESS OF FIRST WORD OF * MESSAGE BLOCK - THIS WORD * CONTAINS THE CHARACTER * LENGTH OF THE MESSAGE AS * A NEGATIVE VALUE. * * (P) JSB $SYMG * (P+1) -RETURN- * * ON RETURN: * (A) = 0 - MESSAGE ACCEPTED AND * MOVED TO BUFFER. * (A) NOT = 0 - BUFFER FILLED, * MESSAGE REJECTED * (E) = 0 * * $SYMG NOP JMP SBUF CHANGED TO CLE ON FIRST ENTRY * LDB SY# IF BUFFER CPB .5 IS FILLED, JMP $SYMG,I REJECT EXIT. * LDB SYC SET CURRENT STB SYT1 SPC 1 IFN * BEGIN NON-DMS CODE *************** JSB .MVW DEF .10 NOP *** END NON-DMS CODE *************** XIF SPC 1 IFZ ***** BEGIN DMS CODE *************** MVW .10 ******* END DMS CODE *************** XIF SPC 1 ISZ SY# INCRE COUNT ENTRY LDA SYT1 ADA .10 (A) = NEXT ENTRY ADDR LDB SYC (B) = CURRENT ENTRY ADDRESS. CPA SBL IF NEXT EXCEEDS BUFFER, LDA SBF RESET TO FWA BUFFER STA SYC AND SAVE. * LDA SY# IF ENTRY. CPA .1 COUNT = 1, JSB SYSCL INITIATE OUTPUT. * CLA,CLE (A) = 0 FOR EXIT WITH JMP $SYMG,I MESSAGE ACCEPTED. * * CALL <$XSIO> TO INITIATE OUTPUT * SYSCL NOP LDA B,I GET THE MESSAGE LENGTH STA SYS7 SET IN THE CALL INB STEP TO BUFFER ADDRESS STB SYS6 SET IN THE CALL JSB $XSIO OCT 1 - LOGICAL UNIT 1 - SYS TTY DEF SYS8 - COMPLETION ROUTINE ADDRESS NOP OCT 2 - ASCII WRITE - SYS6 NOP MESSAGE ADDRESS SYS7 NOP MESSAGE LENGTH *M1 OCT 0 SAYS DO NOT NEED USER MAP JMP SYSCL,I * * COMPLETION ROUTINE FROM I/O CALL * SYS8 CCA SUBTRACT 1 FROM ADA SY# ENTRY COUNT FOR STA SY# MESSAGE JUST OUTPUT. SZA,RSS IF NO MORE IN BUFFER, JMP $XEQ EXIT. * LDB SYS6 SET ADB .9 NEXT ENTRY CPB SBL ADDRESS LDB SBF JSB SYSCL INITIATE OUTPUT JMP $XEQ -EXIT. * SY# NOP SYT1 NOP SYC DEF SBUF SBF DEF SBUF .10 DEC 10 SKP * SUBROUTINE: <$CVEQ> * * PURPOSE: THIS ROUTINE CONVERTS AN EQT * ENTRY # TO AN EQT DISPLACEMENT * AND CALLS <$ETEQ> TO SET THE * ENTRY ADDRESSES. * * CALLING SEQUENCE: * * (A) = EQT ENTRY # * * (P) JSB $CVEQ * (P+1) -RETURN- REGISTERS MEANINGLESS * * $CVEQ NOP AND B77 MASK TO LOW BITS ADA N1 SUBTRACT 1 AND MPY .15 MULTIPLY BY 15 ADA EQTA ABSOLUTE ADDRESS. * JSB $ETEQ SET ALL 15 ADDRESSES. * JMP $CVEQ,I -RETURN- * * SUBROUTINE: * * PURPOSE: THIS ROUTINE COMPUTES THE ENTRY # * OF THE ENTRY DESCRIBED BY -EQT1-. * THE # IS CONVERTED TO DECIMAL ASCII. * * CALLING SEQUENCE: (P) JSB CPEQT * (P+1) - RETURN - iz * ON RETURN, (A) = EQT# * (E) = 1 * * CPEQT NOP LDA EQTA SUBTRACT DEVICE CMA,INA EQT ENTRY ADDRESS ADA EQT1 FROM FWA OF EQT. CLB CLEAR B FOR DIVIDE DIV .15 DIVIDE BY 15 CCE,INA SET E FOR CONVERSION/ADJUST COUNT. JMP CPEQT,I EQT# NOT CONVERTED TO ASCII! SPC 1 SKP * SUBROUTINE: < $ETEQ > * * PURPOSE: THIS ROUTINE SETS THE ADDRESSES * OF THE 15 WORDS OF AN * EQUIPMENT TABLE ENTRY IN THE * 15 WORDS IN BASE PAGE COMMUNICATION * AREA LABELLED -EQT1- TO -EQT15-. * * CALLING SEQUENCE: * * (A) - STARTING ADDRESS OF THE EQT * ENTRY FOR THE REFERENCED * I/O UNIT. * * (P) JSB $ETEQ * (P+1) - RETURN - (A),(B) MEANINGLESS * * THERE ARE NO ERROR RETURNS OR * ERROR CONDITIONS DETECTED. * * $ETEQ NOP MIC10 JMP MIC11 OR STA EQT1 IF NO MICRO INA STA EQT2 INA STA EQT3 INA STA EQT4 INA STA EQT5 INA STA EQT6 INA STA EQT7 INA STA EQT8 INA STA EQT9 INA STA EQT10 INA STA EQT11 INA * STA EQT12 INA STA EQT13 INA STA EQT14 INA STA EQT15 JMP $ETEQ,I * MIC11 LDB AEQ1 (A)=VALUE OF FIRST ENTRY STR 11 (B)=ADDR OF FIRST ENTRY, DO 11 WORDS LDB AEQ12 STR 4 DO LAST 4 WORDS JMP $ETEQ,I RETURN * AEQ1 DEF EQT1 AEQ12 DEF EQT12 * SKP * * SPECIAL SECTION "I/O CLEAR " * ENTRY POINT IS "$IOCL" * * PURPOSE: THE FUNCTION OF THIS ROUTINE * IS TO REMOVE A PROGRAM FROM AN * I/O HANG-UP CONDITION RESULTING * FROM AN INPUT REQUEST NOT BEING * COMPLETED BY THE DEVICE. * * j THIS "CLEARING" PROCEDURE IS * INITIATED BY THE OPERATOR IN * USING THE I/O ABORT VERSION OF THE * "OF,XXXXX,1" COMMAND. THE "OF" * STATEMENT PROCESSOR IN 'SCHED' * CALLS THIS SECTION IF THE REF- * ERENCED PROGRAM IS SUSPENDED * FOR AN I/O INPUT REQUEST. * * PROCESS: THE LIST OF EACH EQT ENTRY * IS SEARCHED TO FIND THE QUEUED * REQUEST CORRESPONDING TO THE * ID SEGMENT OF THE REFERENCED * PROGRAM. THE ENTRY IS REMOVED * FROM THE LIST AND THE LIST IS * APPROPRIATELY LINKED TO REFLECT * THE CHANGE. * * IF THE ENTRY WAS THE FIRST ONE * IN THE LIST (I.E. THE ACTIVE * REQUEST), THE DEVICE'S CHANNELS * AND DMA CHANNEL, IF ASSIGNED,ARE * CLEARED. THE DEVICE'S TIME-OUT * CLOCK IS CLEARED. $ABRT IS * CALLED TO ABORT THE PROGRAM AND * CONTROL IS TRANSFERRED TO "$XEQ" * IF THE DEVICE WAS NOT CLEARED * OR TO "L.55" IN "IOCOM" TO * INITIATE THE NEXT STACKED * REQUEST (OR TO ALLOCATE THE * DMA CHANNEL). * * CALLING SEQUENCE: * * (A)= ID SEGMENT ADDRESS OF PROGRAM * * (P) JMP $IOCL * * -NO RETURN - * * SKP ENT $IOCL * $IOCL STA TEMP1 SAVE ID SEGMENT ADDRESS. SPC 1 IFZ ***** BEGIN DMS CODE ************** SJP *+2 ******* END DMS CODE ************** XIF SPC 1 LDA EQT# SET TEMP2 = NEGATIVE CMA,INA NUMBER OF EQT STA TEMP2 ENTRIES. LDA EQTA INITIALIZE FOR * IOCL STA IOCL5 EQT ENTRY WORD IOCL0 STA IOCL6 1 ADDRESS. LDA A,I GET LINK ADDRESS. RAL,CLE,ERA CLEAR SIGN, SET E IF SET * CPA TEMP1 JUMP IF A JMP IOCL2 MATCH TO PROGRAM. * SZA IF NOT END OF LIST, JMP IOCL0 CONTINUE SCAN_. * LDA IOCL5 SET (A) = ADDRESS OF ADA .15 NEXT EQT ENTRY. ISZ TEMP2 IF NOT END OF EQT, GO JMP IOCL TO SCAN NEXT ENTRY LIST. * * SCAN ALL DRT WORD 2 I/O QUEUES * LDA LUMAX SET TEMP2 = NEGATIVE CMA,INA NUMBER OF DRT STA TEMP2 ENTRIES. LDA DRT INITIALIZE ADA LUMAX FOR FIRST STA IOC50 DRT WORD IOC41 STA IOC51 TWO. LDA A,I .GET LINK * RAL,CLE,ERA CLEAR SIGN, SET E IF SIGN SET. CPA TEMP1 JUMP IF A MATCH JMP IOC62 TO A PROGRAM. * SZA IF NOT END OF LIST, JMP IOC41 CONTINUE SCAN. * ISZ IOC50 SET = NEXT ADDRESS OF LDA IOC50 ISZ TEMP2 NEXT DRT WORD 2. JMP IOC41 IF NOT END OF DRT, CONTINUE SCAN. * LDA TEMP1 NOT FOUND SO JUST JMP IOC63 ABORT THE PROGRAM. SKP * * PROGRAM REQUEST FOUND IN DRT, UNLINK REQUEST. * IOC62 LDB A,I GET NEXT LINK, PROPOGATE RBL,ERB SIGN IF SIGN WAS SET AND STB IOC51,I STORE IN PREVIOUS LINK. * LDA TEMP1 CHECK IF THIS ISZ TEMP1 IS A SYSTEM LDB TEMP1,I REQUEST. SSB,RSS IF SO SKIP ABORT. IOC63 JSB $ABRT 'ABORT PROGRAM' JMP $XEQ RETURN. * * PROGRAM REQUEST ENTRY FOUND, UNLINK REQUEST. * IOCL2 LDB A,I GET NEXT LINK AND SET RBL,ERB PASS OLD SIGN TO NEXT LINK STB IOCL6,I IN PREVIOUS LINK. * LDA TEMP1 "ABORT ISZ TEMP1 CHECK IF THIS IS A LDB TEMP1,I SYSTEM REQUEST SSB,RSS IF SO SKIP ABORT JSB $ABRT PROGRAM" * LDA IOCL5 IF PROGRAM REQUEST LDB IOCL6,I CPA IOCL6 WAS CURRENT ENTRY, SSB AND NOT NOW CLEARING, SKIP. JMP $XEQ -EXIT TO $XEQ. * JSB $ETEQ * * JSB CLDMA CLEAR ANY DMA CHANNEL ASSIGNED LDA B3.I GET CLEAR REQUEST (100003B) STA EQT6,I SET IN EQT LDA EQT5,I GET CURRENT STATUS RAL,CLE IF DOWN OR IN DMA SSA WAIT JMP $XEQ JUST LEAVE IT ALONE * ERA ELSE SET NOT BUSY STA EQT5,I AND PLANT LDA EQT4,I GET THE SELECT CODE LDB EQT2,I AND THE I.XX ADDRESS AND B77 ISOLATE THE SELECT CODE AND JSB B,I RUN THE DRIVER * * IF REQUEST ACCEPTED THEN WE MUST SET UP FOR AN INTERRUPT BY * * A) SETTING THE DEVICE BUSY * B) SETTING A TIME OUT (1 SEC. IS ARBITRARILY USED) * * IF REQUEST IS NOT ACCEPTED OR IS COMPLETED THEN: * * A) ZAP TIME OUT AND * B) GO TO IOCOM TO GET THE NEXT REQUEST * CLB,CCE FIRST ZAP TIME OUT STB EQT15,I LDB EQT1,I SET THE SIGN BIT IN EQT1 RBL,ERB FOR IOCOM (NOW OR LATER) STB EQT1,I CCE,SZA INTERRUPT EXPECTED? JMP IOCOM NO SO JUST GO TO IOCOM * LDA EQT5,I YES SO SET RAL,ERA BUSY STA EQT5,I AND LDA N100 SET UP STA EQT15,I A REASONABLE TIME OUT JMP $XEQ GO TO THE DISPATCHER * SPC 1 IOCL5 CLE IOCL6 NOP IOC50 NOP IOC51 NOP * .CLE EQU IOCL5 SKP * * ROUTINE TO CLEAR DMA CHANNEL IF ASSIGNED TO DEVICE * CLDMA NOP LDB INTBA GET THE INTERRUPLE ADDRESS TO B LDA B,I AND DMA 6 ENTRY TO A RAL,CLE,ERA CLEAR THE SIGN BIT CPA EQT1 THIS CHANNEL ASSIGNED? CLA,RSS YES- SKIP JMP IOCL3 NO TRY NEXT CHANNEL * CLC 6 CLEAR CHANNEL STF 6 6. STA B,I SET IT AVAILABLE IN INTBA SPC 1 IOCL3 INB STEP TO DMA 7 ENTRY LDA B,I GET TO A AND RAL,CLE,ERA CLEAR THE SIGN BIT CPA EQT1 THIS CHANNEL ASSIGNED? CLA,RSS YES - SKIP JMP CLDMA,I NO - EvXIT CHANNELS CLEARED * CLC 7 CLEAR CHANNEL 7 STF 7 AND STA B,I MAKE IT AVAILABLE. JMP CLDMA,I * * ROUTINE TO CLEAR ALL CHANNELS SERVICED BY EQT ENTRY * $CLCH NOP JSB CLDMA CLEAR DMA CHANNEL IF ASSIGNED LDA INTLG STORE INTERRUPT CMA,INA TABLE LENGTH- ADA .2 RELATED INDEX STA TEMPW LDA CLR10 STORE INITIAL STA .CLC CLC S.C. LDA INTBA INSTRUCTION ADA .2 CLRNX LDB A,I GET NEXT TABLE ENTRY- CPB EQT1 DOES IT REFERENCE THIS EQT? .CLC CLC 00B YES-GO CLEAR IT ISZ TEMPW THRU TABLE? INA,RSS NO-INDEX TO NEXT ENTRY JMP $CLCH,I YES-EXIT * ISZ .CLC JMP CLRNX * CLR10 CLC 10B B3.I OCT 100003 N100 DEC -100 HED * $SYMG BUFFER AND PRIVLEDGE I/O CONFIGURE SECTION * * SBUF BSS 50 ORG SBUF PUT IOC CONFIGURING ROUTINE IN BUFFER STA SBUF SAVE THE A REG. CLA STA $ZZZZ ZERO THE ABORT LIST STA DUMMY,I ZAP THE PRIV. TRAP CELL. LDA DUMMY GET THE DUMMY I/O ADDRESS SZA,RSS IF NONE JMP NOPRV GO EXIT ADA .CLC CONFIGURE THE DUMMY ADDRESSES STA SW2 XOR STCP STA SW1 STC STA STCP XOR STFP AND STA STF1 AND STF STA STFP STCP OCT 4000 STFP OCT 600 NOPRV LDA .CLE REPLACE CALL TO HERE STA $SYMG+1 WITH A CLE *M1 LDA DRN GET DIRECT ADDRESS *M1 LDA A,I FOR THE RN TABLE *M1 RAL,CLE,SLA,ERA *M1 JMP *-2 *M1 STA DRN,I SET ADDRESS *M1 JSB $S.CL INITIALIZE CLASS I/O MODULE * LDB $MIC SZB DO WE HAVE MICRO? JMP MIC0 YES STB MIC2 STB MIC4 STB MIC6 LDA SAXAI STA MIC LDA LBEQ1 STA MIC8 LDA SAEQ1 STA MIC10 JMP MIC0 * NMX0 LD1MA TBG LDB .CLA SZA IS THERE A TBG IN SYSTEM? STB $IRT YES, OVERLAY JMP WITH CLA LDA SBUF RESTORE A SZA DUMMY ADDR FOR NO TIMER MODULE JMP $SYMG+1 NO, CONTINUE THE MESSAGE BIT JMP $SYMG,I YES, RETURN NOW SPC 2 SAXAI STA XA,I LBEQ1 LDB EQT1 SAEQ1 STA EQT1 *M1DRN DEF D$RN SPC 1 L EQU 50+SBUF-* ERROR HERE MEANS WE RAN OUT OF BUFFER ORR LEAVE THE BUFFER SBL DEF * * ORG * SIZE OF MODULE HED ** SYSTEM BASE PAGE COMMUNICATION AREA ** XI EQU 1647B . EQU 1650B ESTABLISH ORIGIN OF AREA * * SYSTEM TABLE DEFINITION * * EQTA EQU .+0 FWA OF EQUIPMENT TABLE EQT# EQU .+1 # OF EQT ENTRIES DRT EQU .+2 FWA OF DEVICE REFERENCE TABLE LUMAX EQU .+3 # OF LOGICAL UNITS (IN DRT) INTBA EQU .+4 FWA OF INTERRUPT TABLE INTLG EQU .+5 # OF INTERRUPT TABLE ENTRIES KEYWD EQU .+7 FWA OF KEYWORD BLOCK * * I/O MODULE/DRIVER COMMUNICATION * EQT1 EQU .+8 ADDRESSES EQT2 EQU .+9 EQT3 EQU .+10 OF EQT4 EQU .+11 EQT5 EQU .+12 CURRENT EQT6 EQU .+13 EQT7 EQU .+14 15-WORD EQT8 EQU .+15 EQT9 EQU .+16 EQT EQT10 EQU .+17 EQT11 EQU .+18 ENTRY EQT12 EQU .+81 EQT13 EQU .+82 EQT14 EQU .+83 EQT15 EQU .+84 * CHAN EQU .+19 CURRENT DMA CHANNEL # TBG EQU .+20 I/O ADDRESS OF TIME-BASE CARD SYSTY EQU .+21 EQT ENTRY ADDRESS OF SYSTEM TTY * * SYSTEM REQUEST PROCESSOR /'EXEC' COMMUNICATION * * RQCNT EQU .+22 # OF REQUEST PARAMETERS -1 RQRTN EQU .+23 RETURN POINT ADDRESS RQP1 EQU .+24 ADDRESSES RQP2 EQU .+25 RQP3 EQU .+26 OF REQUEST RQP4 EQU .+27 RQP5 EQU .+28 PARAMETERS RQP6 EQU .+29 RQP7 EQU .+30 (SET FOR MAXIMUM OF RQP8 EQU .+31 8 PARAMETERS) * * DEFINITION OF SYSTEM LISTS (QUEUES) * * * * DEFINITION OF EXECUTING PROGRAM ID SEGMENT' * * XEQT EQU .+39 ID SEGMENu<:6T ADDR. OF CURRENT PROG. XTEMP EQU .+41 'TEMPORARY (5-WORDS) XPRIO EQU .+46 'PRIORITY' WORD XSUSP EQU .+48 'POINT OF SUSPENSION' XA EQU .+49 'A REGISTER' AT SUSPENSION XB EQU .+50 'B REGISTER' XEO EQU .+51 'E AND OVERFLOW * * SYSTEM MODULE COMMUNICATION FLAGS * * OPATN EQU .+52 OPERATOR/KEYBOARD ATTENTION FLAG DUMMY EQU .+55 I/O ADDRESS OF DUMMY INT. CARD * * DEFINITION OF MEMORY ALLOCATION BASES * * * * UTILITY PARAMETERS * MPTFL EQU .+80 MEMORY PROTECT ON/OFF FLAG (0/1) BKLWA EQU .+87 LWA OF MEMORY IN BACKGROUND * ORG * LENGTH OF RTIOC END $CIC S< eQ 92064-18004 1726 S C0122 &MDI10 MI DISP             H0101 ASMB,R,L,C ** RTE-M DISPATCHER MODULE ** * * NAME : $MDI1 * SOURCE: 92064-18004 * RELOC: PART OF 92064-16001 * PROGMR: E.J.W. BASED ON RTE-III VERSIONS G.A.A.,L.W.A.,D.L.S. * * **************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT * * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * **************************************************************** * * NAM $MDI1,0 92064-16001 REV.1726 770512 * SUP * * DISPATCHER ENTRY POINT NAMES * ENT $RENT,$ZZZZ,$XEQ ENT $MPFT,$EMRP,$CON * * DISPATCHER EXTERNAL REFERENCE NAMES * EXT $WATR,$IRT,$ABRE,$LIST EXT $MIC MIC STR,105623B,1 SEQUENTIAL STORE VALUE SKP * THE DISPA MODULE OF THE HP-2100 REAL TIME EXECUTIVE * * PERFORMS THE FOLLOWING FUNCTIONS: * * 1. IDLE LOOP WHEN NO PROGRAMS ARE SCHEDULED OR CANNOT BE * * EXECUTED. * * 2. SWITCHES PROGRAM EXECUTION SUCH THAT THE HIGHEST * * PRIORITY EXECUTABLE PROGRAM EXECUTES. * * 3. SETS THE FENCE REGISTER ACCORDING TO PROGRAM TYPE. * * 4. LOADS, SWAPS, AND EXECUTES DISC RESIDENT PROGRAMS * * * CALLING SEQUENCE * JMP $XEQ * * $XEQ LDB $ZZZZ CHECK IF PROGRAM TO BE ABORTED SZB JMP ABORT YES GO HANDLE IT LDB $LIST IF LIST NOT ENTERED SZB,RSS THEN NOTHING NEW SO JMP $IRT GO CONTINUE CURRENT PGM * LDA SKEDD LOAD TOP OF SCHEDULE LIST CLB STB $LIST PREVENT NEEDLESS LIST SCANS RSS SKIP FIRST TIME LDA ZWORK,I GET THE NEXT PGM IN THE LIST SZA IF ZERO, THEN NO PROG SCHED JMP X0010 GO TO PROCESS SCHED LIST * * NO PROGRAM SCHEDULED--SETUP FOR IDLE LOOP * * * THE IDLE LOOP SECTION CONSISTS OF: * * CLEARING XEQT WORD TO SIGNIFY THAT NO PROGRAM * * CURRENTLY EXECUTING. * * STORE ADDRESS OF 4 DUMMY WORDS INTO XSUSP-XSUSP+3 * * DUE TO I/O PROCESSING. * * SET MEMORY PROTECT REGISTER TO ZERO. * * CALL INTERRUPT RESTORE ROUTINE, $IRT * JUMP TO * * * * STA XEQT SET BP POINTERS TO DUMMY ID LDB VSUSP STB XSUSP INB STB XA SET POINTERS TO DUMMY REGS STB XB STB XEO STB XI SET X,Y REG POINTER TO DUMMY JMP X0029 SET UP MP FENCE, EXIT * IDLE JMP * IDLE LOOP * VSUSP DEF *+1 DEF IDLE NOP NOP SKP ABORT LDA B,I GET POSSIBLE NEXT PGM STA $ZZZZ AND SET IT FOR ABORT CLA CLEAR THE XSUSP ADDRESS STABI STA B,I FOR THE NEXT START ADB DM8 BACK UP TO ID-SEG ADDRESS STB A SAVE THE ID-SEG. ADDRESS STB TMP A FEW TIMES JSB $ABRE RELEASE ANY RE-ENTRANT MEMORY. * LDB TMP JSB $WATR SCHEDULE ANYONE WAITING LDB TMP ADB D20 CLA STA B,I CLEAR ID WORD 21 JMP $XEQ ABORTION DONE. * SKP * THE SWITCHING SECTION USES THE SCHEDULE LIST TO DETERMINE * * WHICH PROGRAM TO EXECUTE-STARTING FROM TOP OF LIST. * * IF PROGRAM FROM LIST OF LOWER OR EQUAL PRIORITY, * * THEN EXECUTION OF CURRENT PROGRAM CONINUES. * * IF PROGRAM FROM LIST OF HIGHER PRIORITY AND * * TYPE EITHER REAL TIME RESIDENT OR BACKGROUND * * RESIDENT, EXECUTION SWITCHING TAKES PLACE.* * TYPE IS BACKGROUND DISC RESIDENT, * * GO TO BACKGROUND DISC PROCESSING. * * TYPE IS REAL TIME DISC RESIDENT, GO TO REAL * * TIME DISC RESIDENT PROCESSING * * X0010 STA ZWORK SCHED LIST PROG ID SEG ADDRESS ADA D6 STA ZPRIO PRIORITY ADDRESS ADA D8 STA ZTYPE TYPE ADDRESS ADA D7 STA ZMPID MAP WORD ADDRESS * LDA XEQT ANY PROGRAM CURRENTLY EXECUTING? SZA,RSS YES, TEST FOR HIGHEST PRIORITY JMP X0030 NO, EXECUTE NEW SCHEDULED PROG ADA D15 CHECK STATUS OF XEQT ID SEGMENT LDA A,I AND D15 MASK TO MAJOR STATUS CPA D1 RSS SCHEDULED-SO GO TO CHECK PRIORITY JMP X0030 NOT SCHEDULED -SO GO SWITCH LDA XPRIO,I LOAD TEST PROGRAM PR CMA,INA MAKE NEGATIVE ADA ZPRIO,I SUPTRACT FROM CURRENT PGM PR. SSA,RSS IF SIGN A=0 THEN PROG OF HIGHER PR JMP RNOLD CURR PROG HIGHER PRIOR THAN SCHED PROG * * * * X0030 EQU * CLA STA MPN STORE MPFT INDEX LDA ZWORK ADA MI GET ADR FOR INDEX REGISTERS STA XI SET POINTER TO INDEX REGISTERS ADA D30 STA $CON SET POINTER TO CONSOLE LU (WORD 29) * LDA ZWORK IF SAME AS CURRENT PGM CPA XEQT THEN JMP $RENT SKIP BASE PAGE SET UP. JSB $X041 SET UP BASE PAGE ID SEG PTRS LDB XSUSP,I CHECK IF PROGRAM SUSPENDED CMB,INB,SZB IF SO THEN JMP $RENT GO SET IT UP LDB XPENT,I GET PRIMARY ENTRY PT. STB XSUSP,I SET ENTRY ADDRESS * * CHECK IF PT OF SUSPENSION IN LIBRARY AREA * $RENT EQU * LDB XTEMP+4 GET THE RENT BIT ADB D15 LDB B,I GET THE WORD BLF,RBL ROTATE TO PUT RENT BIT IN SIGN SSB,RSS IF RENT NOT IN CONTROL JMP X0028 GO SET FENCE LDA LBORG SET THE LIBRARY FENCE JMP X0029 GO SET IT UP * * * $X041 NOP SET UP B.P. ID SEG PTRS LDB DM12 (12 WORDS) STB TMP LDB XQDEF PUT THEM AT XEQT STA XEQT X0041 JMP MIC OR STA B,I IF NO MICRO INA INB ISZ TMP JMP X0041 JMP $X041,I RETURN WHEN DONE * XQDEF DEF XLINK * MIC STR 12 CALL MICROCODE JMP $X041,I RETURN * RNOLD LDA XEQT RESET POINTERS FOR CURR PROG STA ZWORK SINCE WE WILL NOT RUN SCHED PROG ADA D14 STA ZTYPE ADA D7 STA ZMPID JMP $RENT * * * * SET MEMORY PROTECT ACCORDING TO PROG TYPE * * X0028 LDA MPN GET MPFT INDEX ADA $MPFT LDA A,I GET FENCE X0029 STA FENCE * * RESTORE REGISTERS, MEMORY PROTECT, AND TURN ON INTERRUPT SYSTEM * JMP $IRT GO EXECUTE THE PROGRAM SPC 3 * XEQ PROCESSOR--BUFFERS, CONSTANTS, POINTERS, ETC * * ZWORK NOP SCHED LIST ID SEGMENT ADDRESS ZPRIO NOP SCHED LIST PRIORITY LIST ZTYPE NOP SCHED LIST TYPE ADDRESS ZMPID NOP SCHED LIST MAP & MPFTI WORD TMP NOP TEMPORARY WORKING STORAGE * D1 DEC 1 D6 DEC 6 D7 DEC 7 D8 DEC 8 D14 DEC 14 D15 DEC 15 D20 DEC 20 D30 DEC 30 DM8 DEC -8 DM12 DEC -12 * $EMRP NOP FWA SAM-1 (SET BY GENERATOR) $MPFT NOP ADDR M.P. FENCE TABLE (SET BY GENERATOR) MPN NOP INDEX TO MPFT, BP FLAG MI DEC -2 NEG # OF INDEX REGS SPC 2 * MPFT INDEX * * BUILT BY THE GENERATOR AS FOLLOWS: * 0 ON-LINE ADDED PROGRAM, NO COMMON * 1 SYSTEM GENERATED PROGRAM, NO COMMON * 2 RT COMMON, ANY PROGRAM * 3 --lp NOT USED -- * 4 SSGA, ANY PROGRAM * * HED SYSTEM START UP ******************************************************************** * THE START SECTION: * * CLEARS INTERRUPT SYSTEM * * INITIALIZES MAPS IN RTE-M III * ******************************************************************** * $ZZZZ NOP CLC 0 CLEAR INTERRUPT SYSTEM LDB STABI LDA $MIC SZA,RSS ANY MICRO? STB X0041 NO, PUT STA B,I THERE JMP $ZZZZ,I END DISPATCHER INITIALIZE * ORG * SIZE OF MODULE HED ** SYSTEM BASE PAGE COMMUNICATION AREA ** * * *** SYSTEM BASE PAGE COMMUNICATION AREA *** * XI EQU 1647B . EQU 1650B ESTABLISH ORIGIN OF AREA * * SYSTEM TABLE DEFINITION * * * DEFINITION OF SYSTEM LISTS (QUEUES) * * SKEDD EQU .+33 'SCHEDULE' LIST, * * DEFINITION OF EXECUTING PROGRAM ID SEGMENT' * * XEQT EQU .+39 ID SEGMENT ADDR. OF CURRENT PROG. XLINK EQU .+40 'LINKAGE' XTEMP EQU .+41 'TEMPORARY (5-WORDS) XPRIO EQU .+46 'PRIORITY' WORD XPENT EQU .+47 'PRIMARY ENTRY POINT' XSUSP EQU .+48 'POINT OF SUSPENSION' XA EQU 1731B XB EQU 1732B XEO EQU 1733B * * * DEFINITION OF MEMORY ALLOCATION BASES * * LBORG EQU .+61 FWA OF RESIDENT LIBRARY AREA * * UTILITY PARAMETERS * $CON EQU 1736B POINTER TO CURRENT SESSION TABLE FENCE EQU .+85 MEM PROTECT FENCE ADDRESS * * * * A EQU 0B LOCATION OF A REGISTER B EQU 1B LOCATION OF B REGISTER * ORG * PROGRAM LENGTH END $ZZZZ 8f f p 92064-18005 1650 S C0122 &MER RTE-M ERROR MESSAGES             H0101 ASMB,R,L ** RTE-M ERROR MESSAGE MODULE ** * NAME : $MER * SOURCE: 92064-18005 * RELOC: PART OF 92064-16013 * PROGMR: E.J.W. * * **************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT * * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * **************************************************************** * * NAM $MER,0 92064-16013 REV.1650 761020 * SUP ENT $OPER,$ERIN,$NOPG,$ILST,$NOOP * ******************************************************************** * * THE RTE MESSAGE MODULE CONTAINS ALL THE FIXED MESSAGES THE * SYSTEM OUTPUTS TO THE USER. * * THESE MESSAGES CONSISTS OF A CHARACTER COUNT (NEGATIVE) * FOLLOWED BY THE ASCII MESSAGE. * * THE ENTRY POINT IS ON A DEF TO THE ABOVE MESSAGE. * ******************************************************************** * $ILST DEF *+1 ILLEGAL STATUS ERROR MESSAGE DEC -14 ASC 7,ILLEGAL STATUS * $OPER DEF *+1 OPERATION CODE ERROR MESSAGE DEC -12 ASC 6,OP CODE ERR * $NOPG DEF *+1 NO SUCH PROGRAM ERROR MESSAGE DEC -12 NO ASC 6,NO SUCH PROG * $ERIN DEF *+1 INPUT ERROR MESSAGE DEC -12 ASC 6,INPUT ERROR * $NOOP DEF *+1 NO OPTION ERROR MESSAGE DEC -10 ASC 5,NO OPTION * BSS 0 SIZE OF MODULE END $ERIN 7 gm 92064-18006 1805 S C0422 &MSC00 MII,MIII SCHEDULE             H0104 ASMB,R *USE 'ASMB,R,N' (RTE-M I/RTE-M II) OR 'ASMB,R,Z' (RTE-M III) * * IFN OPTION * NAME: $MSC2 * SOURCE: 92064-18006 * RELOC: PART OF 92064-16002 * PROGMR: E.J.W. BASED ON RTE-III VERSIONS G.A.A.,L.W.A.,D.L.S. * * IFZ OPTION * NAME : $MSC3 * SOURCE: 92064-18006 * RELOC: PART OF 92064-16003 * PROGMR: E.J.W. BASED ON RTE-III VERSIONS G.A.A.,L.W.A.,D.L.S. * * **************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT * * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * **************************************************************** * * HED RTE SCHEDULER/MESSAGE PROCESSOR IFN * BEGIN NON-DMS CODE *************** NAM $MSC2,0 92064-16002 REV.1805 771031 *** END NON-DMS CODE *************** XIF IFZ ***** BEGIN DMS CODE *************** NAM $MSC3,0 92064-16003 REV.1805 771031 ******* END DMS CODE *************** XIF SPC 1 * SUP * SCHED ENTRY POINT NAMES * ENT $LIST,$MESS,$CVT3,$CVT1,$ABRT,$TYPE ENT $MPT1,$MPT2,$MPT4,$MPT5 ENT $PARS,$STRT,$SCD3,$INER,$MPT7,$ASTM ENT $MPT8,$IDNO,$WORK,$WATR ENT $MSEX,$MSBF,$LCTU,$RCTU SPC 1 IFZ ***** BEGIN DMS CODE ********** ENT $MPSA ******* END DMS CODE ********** XIF SPC 1 * * SCHED EXTERNAL REFERENCE NAMES * EXT $XSIO,$IOUP,$IODN,$ERMG EXT $IOCL,$LUPR,$EQST,$SCLK EXT $ERAB,$ZZZZ,$CHTO,$PVCN EXT $ERIN,$NOPG,$OPER,$ILST EXT $XEQ,$ONTM,$ALC,$RTN EXT $TIMR,$TREM EXT $RNTB,$SYMG EXT $BLRQ,$ITRQ,$TIRQ,$TMRQ EXT $STRQ,$PRRQ SPC 1 IFN * BEGIN NON-DMS CODE *************** EXT .MVW *** END NON-DMS CODE *****f********** XIF IFZ ***** BEGIN DMS CODE ********** EXT $MATA,$MEU ******* END DMS CODE ********** XIF SPC 1 * * ******************************************************************* * * THE SCHED MODULE OF HP2100 REAL TIME EXECUTIVE CONSISTS OF * * 1. LIST PROCESSORS * 2. LINK PROCESSORS * 3. OPERATOR INPUT MESSAGE PROCESSORS * 4. SYSTEM START UP AND OPER INPUT REQUEST ACKNOWLEDGE * 5. MEMORY PROTECT VIOLATION SCHEDULER PREPROCESSORS * 6. ABORT AND TERMINATION PROCESSORS * ******************************************************************* * * --BUFFERS, CONSTANTS, POINTERS, ETC * $STRT EQU * SYSTEM INITIALIZATION ENTRY POINT * JMP RECON ***TRY RESTART * T0 JMP T9 -NOP- BECOMES NOP AFTER STARTUP ST2 JSB $RTN RE-INITIALIZE MEMORY T1 NOP WITH MAX T2 NOP ST3 JMP TEMP5 -NOP- BECOMES NOP AFTER STARTUP * EXT $CLCH,$ETEQ LDA EQT# ***TRY RESTART*** CMA,INA ***TRY RESTART*** STA TEMP1 ***TRY RESTART*** LDA EQTA ***TRY RESTART*** STA TEMP2 ***TRY RESTART*** EQLOP STA TEMP2 ***TRY RESTART*** JSB $ETEQ ***TRY RESTART*** CLA ***TRY RESTART*** STA EQT1,I ***TRY RESTART*** STA EQT15,I ***TRY RESTART*** LDA EQT5,I ***TRY RESTART*** AND C140K ***TRY RESTART*** STA EQT5,I ***TRY RESTART*** JSB $CLCH ***TRY RESTART*** LDA TEMP2 ***TRY RESTART*** ADA D15 ***TRY RESTART*** ISZ TEMP1 ***TRY RESTART*** JMP EQLOP ***TRY RESTART*** * LDB KEYWD ***TRY RESTART*** STB TEMP2 ***TRY RESTART*** RSLOP LDB TEMP2,I ***TRY RESTART*** SZB,RSS ***TRY RESTART*** JMP RSDON ***TRY RESTART*** ADB D20 ***TRY RESTART*** LDA B,I ***TRY RESTART*** %  AND CLRPA ***TRY RESTART*** STA B,I ***TRY RESTART*** LDA TEMP2,I ***TRY RESTART*** JSB $ABRT ***TRY RESTART*** ISZ TEMP2 JMP RSLOP ***TRY RESTART*** * RSDON NOP ***TRY RESTART*** JSB $SCLK ***TRY RESTART*** CLA STA SKEDD WIPE OUT ANY SCHEDULED REQUESTS STA FLG STA OPATN INA STA $LIST THEN FORCE ENTRANCE TO IDLE LOOP JMP $TYPE * * OPATN EQU 1734B CLRPA OCT 6400 ***TRY RESTART*** KEEP ONLY RM,RE,RN C140K OCT 37777 * T9 EQU * SPC 1 IFZ ***** BEGIN DMS CODE *************** TBL JSB SYSMP LDA $MPSA AND B76K STA T2 SET #WORDS IN SAM LDA AVMEM STA T1 SET FWA SAM AND B1777 CMA,INA SUBTRACT OFFSET INTO PAGE ADA T2 FROM #WORDS IN FULL PAGES STA T2 JMP ST2 * B76K OCT 76000 ******* END DMS CODE *************** XIF SPC 1 TEMPP LDA AVMEM ***TEMPORARY WORKING STORAGE AREA TEMP STA T1 * DO NOT REARRANGE! TEMP1 CMA,INA * TEMP2 ADA BGORG * TEMP3 STA T2 * TEMP4 JMP ST2 * THESE TEMPS ARE USED TO INITIALIZE TEMP5 CLA *** SYSTEM AVAILABLE MEMORY. TEMP6 STA T0 * AND ALSO TMP STA ST3 * USED BY $PARS AS CONTIGUOUS BUFFER SPACE TEMPH JMP $ALC * TBUF DEF TEMP5 $WORK JSB $ZZZZ * TBUFS DEF TEMP5+7 WORK EQU $WORK WPRIO LDA WSTAT * ASCI RAL,CLE,SLA,ERA ASCI1 LDA A,I * ASCI2 JMP $ERMG *** WSTAT DEF $RNTB DM5 DEC -5 * D2 DEC 2 D4 DEC 4 D5 DEC 5 D6 DEC 6 D9 DEC 9 D15 DEC 15 * D1 OCT 1 D3 DEC 3 B77 OCT 77 B377 OCT 377 * ZERO REP 5 NOP DEF0 DEF ZERO HED ID-SEGMENT MAP ID-SEGMENT MAP ID-SEGMENT MAP * WORD USE * 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 0 * ! ! ! !  ! ! * 1 LIST LINKAGE * ! ! ! ! ! ! * 2-6 5 WORD TEMPORARY AREA USED FOR SPECIAL FLAGS IN QUEUES ETC. * ! ! ! ! ! ! * 7 PRIORITY * ! ! ! ! ! ! * @ 8 PRIMARY ENTRY POINT * ! ! ! ! ! ! * 9 POINT OF SUSPENSION (XSUSP) * ! ! ! ! ! ! * 10 A REGISTER AT SUSPENSION (XA) * ! ! ! ! ! ! * 11 B REGISTER AT SUSPENSION (XB) * ! ! ! ! ! ! * 12 E/O REGISTERS AT SUSPENSION (XEO) * ! ! ! ! ! ! * @ 13 NAME ( FIRST AND SECOND CHARACTERS ) * ! ! ! ! ! ! * @ 14 NAME (THIRD AND FOURTH CHARACTERS) * ! ! ! ! ! ! * @ 15 NAME (FIFTH CHARACTER)---- TM CL AM SS --- TYPE --- * ! ! ! ! ! ! * 16 NA NP W A O R D --- STATUS- * ! ! ! ! ! ! * 17 TIME LIST LINKAGE WORD * ! ! ! ! ! ! * @ 18 RESOLUTION T -------MULTIPLE----------------------- * ! ! ! ! ! ! * @ 19 LOW ORDER 16 BITS OF EXECUTE TIME LESS 24 HRS IN 10'S MS. * ! ! ! ! ! ! * @ 20 HIGH ORDER 16 BITS OF EXECUTE TIME * ! ! ! ! ! ! * 21 BA FW AT RM RE PW RN --FATHER ID-SEG. NUMBER-- * ! ! ! ! ! ! * 22 RP ---# OF PAGES---,--MPFTI-- .. ----PARTITION #---- * ! ! ! ! ! ! * @ 23 LOW MAIN ADDRESS * ! ! ! ! ! ! * @ 24 HI MAIN ADDRESS + 1 * ! ! ! ! ! ! * @ 25 LOW BASE PAGE ADDRESS * ! ! ! ! ! ! * @ 26 HI BASE PAGE ADDRESS + 1 * ! ! ! ! ! ! * @ 27 DISC ADDRESS (LU (15),TRACK (14-7),SECTOR(6-0) * ! ! ! ! ! ! * 28 SWAP DISC ADDRESS (LU (15),TRACK (14-7),#TRACKS(6-0) * ! ! ! ! ! ! * 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 0 * * @ WORDS USED IN SHORT ID SEGMENTS SKP * WHERE THE FLAG BITS MEAN: * TM = TEMP LOAD (COPY OF ID-SEG NOT ON DISC) * CL = CORE LOCK (MAY NOT SWAP) * AM = ALL MEMORY (PROGRAM USES ALL OF ITS AREA) * SS = SHORT SEGMENT (INDICATES A 9-WORD ID-SEGMENT) * NA = NO ABORT (PASS ABORT ERRORS TO THE PROGRAM INSTEAD) * NP = NO PRAMS ALLOWED ON RESCHEDULE. * W = WAIT BIT (WAITING FOR PROG. WHOES ID-SEG ADD. IS IN WD.2) * A = ABORT ON NEXT LIST ENTRY FOR THIS PGM. * O = OPERATOR SUSPEND ON NEXT SCHEDULE ATTEMPT * R = RESOURCE SAVE (SAVE RESOURCES WHEN SETING DORMANT) * D = DORMANT BIT (SET DORMANT ON NEXT SCHEDULE ATTEMPT) * T = TIME LIST ENTRY BIT (PROG IS IN THE TIME LIST) * BA = BATCH (PROGRAM IS RUNNING UNDER BATCH) * FW = FATHER IS WAITING (HE SCHEDULE WITH WAIT) * AT = ATTENTION BIT (OPERATOR HAS REQUESTED ATTENTION) * RM = RE-ENTRENT MEMORY MUST BE MOVED BEFORE DISPATCHING PGM. * RE = RE-ENTRENT ROUTINE IN CONTROL NOW * PW = PROGRAM WAIT (SOME PROGRAM WANTS TO SCHEDULE THIS ONE ) * RN = RESOURCE NUMBER EITHER OWNED OR LOCKED BY THIS PGM.i * RP = RESERVED PARTITION FOR REQUESTING PROGRAMS ONLY. * * * $LIST STATE TRANSITION TABLE: * THE FOLLOWING TABLE DETAILS THE STATE TRANSITIONS EFFECTED BY * $LIST. THE MAJOR STATES ARE 0 THRU 6 (DORMANT THRU OP-SUSP) * AND THE STATE MODIFIERS ARE THE ADDITIONAL BITS SET FROM TIME * TO TIME IN THE STATUS WORD. THE BITS WHICH AFFECT OR ARE * MODIFIED BY $LIST ARE (SEE ABOVE DESCRIPTION): * BIT WEIGHT POSITION * O 10 9 * W 4 12 * R 2 7 * D 1 6 * * THESE BITS ARE COMBINED TO FORM 16 SUBSTATES AS PER THE TABLE BELOW * THE ENTRYS IN EACH SQUARE OF THE TABLE DEFINE THE NEXT STATE AS * FOLLOWS: * * THE FIRST DIGIT IS THE REQUESTED MAJOR TRANSITION (FROM * THE $LIST CALL). * THE SECOND TWO NUMBERS (SEPERATED BY A ".") DEFINE THE NEXT * MAJOR STATE . SUBSTATE. THUS 62.10 INDICATES A OP-SUSPEND * REQUEST (6) CAUSES A MOVEMENT TO I/O SUSPEND (2) SUBSTATE 10 * (THE O BIT IS SET). * A "*" AS THE DESTINATION INDICATES THE CURRENT STATE/SUB- * STATE I.E. NO CHANGE. * ILLEGAL OR UNEXPECTED STATES ARE MARKED WITH "X" * * ONLY EXPECTED CALLS ARE PLOTTED. * * IN GENERAL CODE EXTERNAL TO $LIST MOVES PROGRAMS FROM SUB-STATE * TO SUB-STATE WHILE ONLY $LIST CAN MOVE A PROGRAM FROM ONE * MAJOR STATE TO ANOTHER. HED SYSTEM STATE TABLE******SYSTEM STATE TABLE*** *MAJOR STATE 0 1 2 3 4 5 6 *SUB-STATES *---------!-----!-------!-------!-------!-------!-------!------ * 0 11.0 00.0 02.1 00.0 00.0 00.0 00.0 * 22.0 11.0 11.0 11.0 11.0 11.0 * 33.0 62.10 66.0 66.0 66.0 * 44.0 * 55.0 * 66.0 *---------!-----!-------!-------!-------!-------!-------!------ * 1 D X X 02.1 X X X X *  10.0 * 62.11 *---------!-----!-------!-------!-------!-------!-------!------ * 2 R 11.0 00.2 02.3 00.2 00.2 00.2 06.3 * 66.3 *---------!-----!-------!-------!-------!-------!-------!------ * 3 RD X X 0* X X X 0* * 10.2 10.2 *---------!-----!-------!-------!-------!-------!-------!------ * 4 W 00.0 33.4 00.0 00.0 00.0 00.0 00.0 * 1* 13.4 * 66.4 *---------!-----!-------!-------!-------!-------!-------!------ * 5 WD X X X X X X X *---------!-----!-------!-------!-------!-------!-------!------ * 6 WR 0* X X 00.6 X X 06.7 * 13.4 * 66.7 *---------!-----!-------!-------!-------!-------!-------!------ * 7 WRD X X X X X X 0* * 10.6 *---------!-----!-------!-------!-------!-------!-------!------ * 10 O X X 02.11 X X X X * 16.0 * 6* *---------!-----!-------!-------!-------!-------!-------!------ * 11 OD X X 0* X X X X * 10.0 * 6* *---------!-----!-------!-------!-------!-------!-------!------ * 12 OR X X 02.13 X X X X *---------!-----!-------!-------!-------!-------!-------!------ * 13 ORD X X 0* X X X X * 16.3 * 6* *---------!-----!-------!-------!-------!-------!-------!------ * 14 OW X X X X X X X *---------!-----!-------!-------!-------!-------!-------!------ * 15 OWD X X X ԯX X X X *---------!-----!-------!-------!-------!-------!-------!------ * 16 OWR X X X X X X X *---------!-----!-------!-------!-------!-------!-------!------ * 17 OWRD X X X X X X X *---------!-----!-------!-------!-------!-------!-------!------ HED REAL TIME SCHEDULER---LIST PROCESSOR SECTION--- * * THE $LIST PROCESSOR SECTION OF THE HP-2100 REAL TIME * EXECUTIVE PROCESSES THE FOLLOWING LIST REQUESTS * 1. DORMANT * 2. SCHEDULE * 3. OPERATOR SUSPEND * 4. NON-OPERATOR SUSPEND * A. I/O * B. MEMORY AVAILABLE * C. DISC AVAILABLE * 5. SEGMENT LOADING * * * * CALLING SEQUENCE * * JSB $LIST * OCT (ADDRESS CODE)(FUNCTION CODE) * DEF (ADDRESS) * * IF A = 0, THEN NO MESSAGE * A NOT 0, THEN ADDR OF MESSAGE * IF ERROR, (B) CONTAINS ASCII ERR CODE * WHERE * FUNCTION CODE * 0 = DORMANT REQUEST * 1 = SCHEDULE REQUEST * 2 = I/O SUSPEND REQUEST * 3 = GENERAL WAIT LIST REQUEST * 4 = MEMORY AVAILABEL REQUEST * 5 = DISK ALLOCATION REQUEST * 6 = OPERATOR SUSPEND REQUEST * 17 = RELINK PROGRAM REQUEST * 10 THRU 16 ARE NOT ASSIGNED * * * ADDRESS CODE * 0 = ID SEGMENT NAME FOLLOWED BY 5 OPTIONAL * PARAMETERS TO GO INTO TEMPORARY AREA OF ID SEG. * 1 = ID SEGMENT ADDRESS * 2 = ASCII PROGRAM NAME ADDRESS * 3 = ID SEGMENT ADDRESS IN WORK * 4 = ID SEGMENT ADDRESS IN B-REG * o 5 = ID SEGMENT ADDRESS IN XEQT * 6 = ID SEG ADD FOLLOWED BY CONTENTS TO BE PUT * INTO "B-REG @ SUSP" WORD OF ID SEG. * 7 = ID SEG NAME FOLLOWED BY 5 PARAMETERS TO GO * INTO ID'S TEMPORARY AREA. * * * * ADDRESS * KEYWORD, ID SEGMENT, OR * PROGRAM NAME ADDRESS AS SPECIFIED BY CODE * MUST NOT BE SUPPLIED FOR * ADDRESS CODES 3 AND 4. * SKP $LIST OCT 1 ENTRY/EXIT (INIT.#0 FOR DISPATCHER) LDA $LIST,I WORD 1 AND D15 STA L0091 STORE AWAY REQUEST CODE XOR $LIST,I FORM ADDR CODE ALF,ALF RAL,RAL CPA D4 ADDRESS IN B-REG? JMP L0021 YES GO SET UP CPA D3 ADDRESS IN WORK? JMP L0060 YES GO SET UP LDB XEQT PRESET FOR CURRENT EXECUTING PGM. CPA D5 CURRENT PGM? JMP L0021 YES GO SET IT UP ISZ $LIST STEP TO ADDRESS WORD LDB $LIST,I GET IT TO B CPA D1 IS ADDRESS NOW IN B? JMP L0021 YES GO SET IT UP SPC 1 CPA D2 DOES B POINT TO AN ASCII NAME? JMP DL02 YES, SO GO SEE IF PROGRAM EXISTS. CPA D6 JMP DL06 * STB RETRN B-REG MUST BE A RETURN ADDRESS, SO SAVE. ISZ $LIST BUMP POINTER TO EITHER PROG.NAME OR ADD. LDB $LIST,I GET THE ID ADD. OR PROG.NAME ADDRESS. SZA,RSS IF ADDRESS = 0 THEN ID ADDRESS. JMP DL00 IF NON ZERO, THEN PROCESS AS ADDRESS * JSB TNAME OF PROGRAM NAME. GO GET ID ADDRESS. SEZ IF PROGRAM DOES NOT JMP NPRG EXIST, THEN TELL FOLKS. * DL00 JSB DORM? SETUP THE $LIST PRAMS & SEE IF DORMANT. SZA IS THE PROGRAM DORMANT? JMP L0075 NO, GO TELL CALLER TO FORGET IT. * * THE RFOLLOWING ROUTINE IS USED FOR ADDRESS CODES 0 AND 7 * TO STUFF PARAMETERS INTO THE PROGRAM'S ID SEGMENT. CODES * 0 AND 7 ARE PROVIDED FOR DRIVERS WHICH WISH TO SCHEDULE * PROGRAMS. * * ASSUMPTIONS * 1) AT LEAST ONE PARAMETER MUST BE SUPPLIED(I.E. ONE DEF). * 2) THE RETURN ADDRESS MUST END THE PARAMETERLIST. * 3) 5 PARAMETERS ARE THE MAXIMUM. * 4) ABSOLUTELY NO ERROR CHECKING IS DONE. * ISZ $LIST BUMP $LIST TO POINT TO FIRST PARAMETER. LDB RETRN USE RETURN ADDRESS CMB,INB TO DETERMINE HOW MANY ADB $LIST PARAMETERS TO PASS. STB DM5 SAVE TO FAKE OUT SUBROUTINE *PRAM*. * LDA WORK SET A-REG TO ID ADDRESS. LDB $LIST SET B-REG TO PARAMETER'S ADDRESS. ADB SIGN SET SIGN BIT OF B-REG. JSB PRAM GO STUFF THE ID ADDRESS. * LDA DMM5 RESET -5 CONSTANT STA DM5 TO MINUS 5. CCA SET UP THE RETURN ADA RETRN ADDRESS FOR $LIST'S STA $LIST REURN. JMP L0290 NOW GO SCHEDULE THE PROGRAM. * DL06 ISZ $LIST BUMP TO FUTURE B-REG @ SUSP. LDA $LIST,I SET A-REG TO "B-REG @ SUSP". DL062 STA TEMPX AND SAVE TEMPORRIALLY. JSB DORM? SET UP LIST PARAMETERS & CHECK FOR DORMANT. SZA IF PROGRAM IS DORMANT, JMP L0075 THEN TELL CALLER TO FORGET IT. LDB WORK PUT "B-REG @ SUSP" ADB D10 VALUE INTO THE LDA TEMPX PROPER ID STA B,I SEGMENT JMP L0290 WORD.GO SCHEDULE. * DL02 JSB TNAME NOW ITS IN B SEZ,RSS SKIP IF NOT FOUND OR SHORT ID SEG. JMP L0021 PROG FOUND, SO GO PROCESS * NPRG LDA $NOPG NO SUCH PROG ERROR MESSAGE LDB D5 NO SUCH PROG ERROR CODE JMP L0015 GO TO RETURN * * PROCESS ID SEGMENT ACCORDING TO REQUEST CODE * L0060 LDB WORK SET B-REG TO ID ADDRESS. * L0021 JSB DORM? I GET CURRENT PROGRAM LDB L0091 REQUEST CODE. SZB,RSS CHECK IF DORMANT REQUEST JMP L0100 DORMANT REQUEST CPB D1 CHECK IF SCHEDULE REQUEST JMP L0200 YES CPB D6 CHECK IF OPERATOR SUSPEND REQUEST JMP L0300 YES CPB D15 CHECK IF LINKAGE UPDATE REQUEST JMP L0135 YES JMP L0400 MUST BE A SIMPLE LIST MOVE * L0075 LDA $ILST ILLEGAL STATUS MESSAGE ADDRESS LDB D3 ILLEGAL STATUS ERROR CODE JMP L0015 GO TO EXIT RETRN NOP DMM5 DEC -5 TEMPX NOP SKP * ************************************************************ * * THE DORM? SUBROUTINE IS CALLED BY THE $LIST PROCESSOR * FOR ALL CALLS. IT'S PRIMARY PURPOSE IN LIFE IS TO SET * UP WORK, WPRIO, WSTAT AND L0090. IN ADDITION, IT RETURNS * L0090, THE PROGRAM'S CURRENT STATUS, IN THE A REGISTER. * $LIST FUNCTION CODES OF 0, 6 AND 7(THE DRIVER $LIST CALLS) * USE THIS SUBROUTINE TO SEE IF THE PROGRAM IS DORMANT. * * CALLING SEQUENCE: * LDB ID-ADDRESS * JSB DORM? * * RETURN: * A-REG = CURRENT STATUS(BITS 0-6) * ************************************************************* * DORM? NOP STB $WORK SET UP THE ID ADDRESS FOR LATER. ADB D6 AND STB WPRIO THE PRIORITY WORD ADB D9 AND STB WSTAT THE STATUS WORD. LDA B,I GET THE OLD STATUS AND D15 AND KEEP ONLY LOWER STA L0090 STATUS BITS. JMP DORM?,I RETURN TO USER. HED LIST PROCESSOR--DORMANT REQUEST * * DORMANT REQUEST * * THE DORMANT REQUEST IS PROCESSED AS FOLLOWS: * IF ABORT BIT SET, MAKE PROGRAM DORMANT * IF ALREADY DORMANT, RETURN * IF SCHEDULED, THEN ENTERED INTO DORMANT LIST, POINT * OF SUSPENSION CLEARED. * IF ID SEGMENT ADDRESS IS S6AME AS RESIDING * BACKGROUND DISC RESIDENT PROGRAM, THEN BKRES * FLAGS ARE CLEARED SO ANOTHER PROGRAM MAY BE * LOADED INTO THE AREA. * IF ID SEGMENT ADDRESS IS SAME AS RESIDING REAL * TIME DISC RESIDENT PROGRAM, THEN RDISK FLAGS * ARE CLEARED SO ANOTHER PROGRAM MAY BE LOADED * INTO THE AREA. * IF NOT ONE OF ABOVE, THEN DORMANT BIT SET IN STATUS SPC 1 L0100 LDB WSTAT,I CHECK IF ABORT BIT SET BLF RBL,SLB,BLF JMP L0115 YES, SO GO MAKE DORMANT CPA D2 IF I/O SUSPENDED L0103 ALF,SLA,RAL SET DORMANT BIT JMP L0350 ELSE GO CHECK RESOURCE BIT * L0105 IOR WSTAT,I IF I-O SUSP. MERGE CURRENT STATUS, SET NP JMP L0375 IF DOER IS NOT CURRENT PROG * L0115 LDA $WORK CLEAR ID SEG TEMP AND SET B LDB DEF0 JSB PRAM LDB $WORK SET FLAG FOR DISPATCHER CLA CPB XEQT STA $PVCN ADB D8 LINK THROUGH XSUSP LDA $ZZZZ SO RESIDENT FLAGS STB $ZZZZ ARE STA B,I CLEARED CLA STA XEQT CLEAR CURRENT PGM FLAG IN CASE IT IS SPC 1 L0130 STA WSTAT,I SET THE NEW STATUS AND D15 GET THE ADDITION CODE L0135 LDB L0090 SET B FOR LINK JSB LINK RELINK THE PROG L0014 CLA SET FOR NORMAL RETURN L0015 ISZ $LIST STEP TO RETURN ADDRESS JMP $LIST,I LOOK MA! NO LABEL! SPC 1 SPC 1 L0350 SLB,RSS IF RESOURCE BIT NOT SET JMP L0115 GO MAKE DORMANT CPA D6 IF OPERATOR SUSPENDED JMP L0103 GO SET DORMANT BIT TOO. * L0355 LDA WSTAT,I GET OLD STATUS AND CLD.R CLEAR THE "R" AND "D" BITS L0375 LDB $WORK IF NOT CURRENT CPB XEQT PROGRAM THEN RSS IOR B20K SET THE NO PRAMS BIT. JMP L0130 GO PUT IN THE DORM LIST SPC 2 L0090 NOpP L0091 NOP SPC 1 HED LIST PROCESSOR--SCHEDULE REQUEST * SCHEDULE REQUEST * THE SCHEDULE REQUEST IS PROCESSED AS FOLLOWS: * IF ABORT BIT SET, STORE ID SEGMENT ADDRESS SUCH THAT * PROGRAM WILL BE ABORTED AT NEXT ENTRY FROM XEQ * IF DORMANT BIT SET, GO TO DORMANT REQUEST * IF OPERATOR-SUSPEND BIT SET, GO TO OPERATOR-SUSPEND REQUEST * IF SCHEDULED, THEN STATUS ERROR EXIT * IF CURRENT STATUS NOT ONE OF ABOVE, THE PROGRAM IS * ENTERED INTO THE SCHEDULE LIST. * L0200 CPA D6 IF OP-SUSP JMP L0250 GO CHECK FOR DORMANT BIT LDB WSTAT,I GET WHOLE STATUS WORD CPA D2 IF I/O SUSP. THEN BLF,SLB,BLF ROTATE AND SKIP JMP L0255 ELSE GO CHECK WAIT BIT * RBR,SLB,RBL IF OP-SUSP BIT SET JMP L0220 GO CHECK FURTHER * L0270 CLA,INA SET A FOR SCHEDULE RBL DORM BIT TO 15 SSB IF DORM BIT SET JMP L0100 GO SET DORMANT L0290 CLA,INA JMP L0130 SCHEDULE * L0220 RBL,SLB CHECK RESOURCE BIT JMP L0230 IF SET GO CLEAR OP-SUSP SSB IF DORM BIT SET JMP L0100 GO MAKE DORMANT * L0230 LDA B1004 CLEAR THE OP-SUSP BIT AND JMP L0280 GO OP-SUSP THE PGM. * L0250 LDA WSTAT,I IF OP-SUSP BIT SET AND B100 AND DORM BIT SET SZA JMP L0355 GO CLEAR BIT AND SET DORMENT * L0255 LDA WSTAT,I IF WAIT BIT SET ALF,SLA,ALF THEN ALF,SLA,ALF GO MOVE TO WAIT LIST (SKIPS) JMP L0270 ELSE, SCHEDULE THE PROGRAM * XOR D3 CHANGE STATUS TO 3 AND D15 L0280 XOR WSTAT,I AND JMP L0130 GO RELINK HED LIST PROCESSOR--SUSPEND REQUESTS * * OPERATOR SUSPEND REQUEST * * THE OPERATOR-SUSPEND REQUEST IS PROCESSED AS FOLLOWS: * IF DORMANT, THEN ENTER INTO OPERATOR SUSPEND LIST * IF ALREADY OPTRNERATOR SUSPEND, THEN STATUS ERROR EXIT * IF SCHEDULED, THEN ENTER INTO OPERATOR SUSPEND LIST * IF NOT ONE OF ABOVE, THEN OPERATOR-SUSPEND BIT SET * L0300 LDB WSTAT,I GET THE FULL STATUS WORD SZB IF ZERO CPA D6 OR OP-SUSP JMP L0075 REJECT THE REQUEST * CPA D2 IF I/O SUSP JMP L0310 GO SET TO "O" BIT * SZA IF DORM WITH RESOURCES SKIP JMP L0400 ELSE GO RELINK I.E. SET OP-SUSP. * LDA B306 ELSE SET "R" AND "D" BITS AND IOR B PUT IN OP-SUSP LIST JMP L0130 * L0310 LDA B1000 SET OPER-SUSP BIT IN STATUS JMP L0105 GO SET BIT AND EXIT SPC 1 * * NON-OPERATOR SUSPEND REQUEST * * THE NON-OPERATOR SUSPEND REQUEST IS PROCESSED AS FOLLOWS: * THE PROGRAM IS ENTERED INTO THE REQUESTED LIST AND * THE NEW STATUS REPLACES THE 4 LOW ORDER BITS OF THE * PROGRAM STATUS-THUS SAVING THE DORMANT OR OPERATOR- * SUSPEND BITS THAT MAY BE PRESENT. * * L0400 LDA WSTAT,I UPDATE STATUS SAVING ALL AND C17 BUT LOW 4 BITS IOR L0091 JMP L0130 GO TO EXIT SPC 1 C17 OCT 177760 B100 OCT 100 B306 OCT 306 B1004 OCT 1004 CLD.R OCT 57460 T HED LINK UPDATE PROCESSOR * * THE LINK PROCESSOR OF THE REAL TIME EXECUTIVE. * 1. REMOVES A PROGRAM FROM A LIST * 2. ENTERS THE PROGRAM INTO ANOTHER LIST AT THE PROPER PLACE * ACCORDING TO PRIORITY LEVEL. * * * * CALLING SEQUENCE * * LDB CODE1 * LDA CODE2 * JSB LINK * * WHERE * CODE1 = CODE OF REMOVAL LIST * CODE2 = CODE OF INSERTION LIST * THE ID SEGMENT IS ASSUMED TO BE LOCATED IN WORK * AND WPRIO SET * * * THE REMOVAL OF PROGRAM FROM A LIST CONSISTS OF: * 1. IF I/O LIST (CODE 2), THEN THIS IS SPECIAL CASE * AND DOES NOT REQUIRE REMOVAL. * 2. IF NULL LIST, THEN ERROR EXIT TAKEN. * 3. IF FIRST AND ONLY PROGRAM IN LIST, THEN LIST * VALUE SET TO ZERO. * 4. IF FIRST PROGRAM IN LIST, BUT NOT THE ONLY * PROGRAM IN LIST(LINKAGE NOT ZERO), THEN SET LIST * VALUE TO THE LINKAGE VALUE. * 5. IF IN MIDDLE OF LIST, THE LINKAGE OF THE ID SEG * MENT WHICH POINTS TO THE PROGRAM TO BE REMOVED * IS SET TO THE LINKAGE VALUE OF THE PROGRAM THAT * IS REMOVED. * 6. IF LAST PROGRAM IN LIST, THE LINKAGE VALUE OF * PREVIOUS PROGRAM IN LIST IS SET TO ZERO. * LINK NOP ENTRY/EXIT SZB IGNOR DORMANT AND CPB D2 I/O LIST REQUESTS JMP LK100 YES, SEE IF ADDITION. ADB LLIST ADD TOP OF LIST POINTER * LK010 STB TEMP TOP OF REMOVAL LIST LDB B,I GET TOP OF LIST POINTER SZB,RSS END OF LIST? JMP LK150 YES, RETURN CPB $WORK MATCHES PROGRAM? RSS YES JMP LK010 NO, KEEP SEARCHING LDB B,I UPDATE LINKAGE TO BYPASS STB TEMP,I THE DELETED ID SEG HED LINK PROCESSOR--ADDING PROGRAM TO :}A LIST * * ADD A PROGRAM TO A LIST * * THE ADDITION OF PROGRAM TO A LIST CONSISTS OF: * 1. IF I/O LIST (CODE 2), THEN THIS IS SPECIAL CASE * AND NO ADDITION MADE TO LIST. * 2. IF NULL LIST, THEN LIST VALUE SET TO POINT TO ID * SEGMENT OF PROGRAM TO BE ADDED AND THE LINKAGE * SET TO ZERO. * 3. IF NOT NULL LIST, THE PROGRAM IS INSERTED INTO * LIST ACCORDING TO PRIORITY LEVEL AND LINKAGES * CHANGED TO REFLECT THIS INSERTION. * 4. IF OF LOWER PRIOR. THAN ANY PROGRAM IN LIST, THEN * LAST LINKAGE IS SET TO POINT TO THE PROGRAM TO * BE ADDED AND THE PROGRAM LINKAGE IS CLEARED. * LK100 SZA IGNOR DORMANT AND CPA D2 I/O LIST REQUESTS JMP LINK,I YES, RETURN ADA LLIST ADD TOP OF LIST POINTER * LK110 STA TEMP SAVE TOP OF LIST POINTER LDA A,I GET POINTER SZA,RSS END OF LIST? JMP LK140 YES, LINK IN NEW PROG CPA $WORK IS IT A DUPLIC. PROG? JMP LK150 YES, DUPLIC SO RETURN STA B NOT DUPLIC, COMPARE PRIORITY ADB D6 OF WORK ID SEG LDB B,I AGAINST CMB,INB CURRENT ADB WPRIO,I ID SEG SSB,RSS WORK < CURRENT? JMP LK110 NO, SEE NEXT ONE * LK140 STA $WORK,I LINK THIS TO FOLLOW WORK LDA $WORK LINK WORK TO FOLLOW STA TEMP,I PREVIOUS PROG * LK150 JMP LINK,I RETURN * * LLIST DEF DORMT TOP OF LIST ADDRESS DM32 DEC -32 B1000 OCT 1000 B4000 OCT 4000 COM OCT 54 TBUF DEF TEMP5 TBUFS DEF TEMP5+7 DM58 DEC -58 HED OPERATOR INPUT MESSAGE PROCESSOR * * THE $MESS PROCESSOR SECTION OF HP-2116 REAL TIME EXECUTIVE * PROCESSES THE FOLLOWING OPERATOR INPUT REQUESTS: * 1. TURN ON A PROGRAM * ON,XXXXX * ON,XXXXX,NOW * ON,XXXXX,P1,J...,P5 * ON,XXXXX,NOW,P1,...,P5 * 2. TURN OFF A PROGRAM * OF,XXXXX,P * 3. OPERATOR SUSPEND A PROGRAM * SS,XXXXX * 4. CONTINUE A OPERATOR SUSPENDED PROGRAM * GO,XXXXX * GO,XXXXX,P1,...,P5 * 5. CURRENT STATUS OF A PROGRAM * ST,XXXXX * 6. CHANGE PROGRAM ID SEGMENT TIME PARAMETERS. * IT,XXXXX,R,MMM * IT,XXXXX,R,MMM,HR,MN * IT,XXXXX,R,MMM,HR,MN,SC * IT,XXXXX,R,MMM,HR,MN,SC,MS * 7. CHANGE PROGRAM PRIORITY * PR,XXXXX,ZZ * 8. SET REAL TIME CLOCK AND START TIME BASE GENERATOR * TM,DAY,HR,MN,SC * 9. CURRENT REAL TIME CLOCK VALUES * TI * 10. SET A EQUIPMENT DOWN * DN,NN * 11. SET A EQUIPMENT UP * UP,NN * 12. LOGICAL UNIT * LU,N1 * LU,N1,N2 * LU,N1,N2,N3 * 13. EQUIPMENT STATUS * EQ,NN * 14. SET SOURCE FILE * LS,P1,P2 * 15. SELECT LOAD-AND-GO * LG,P * 16. CHANGE DEVICE TIME-OUT PARAMETER * TO,N1 * TO,N1,N2 * 17. RELEASE PROGRAM'S TRACKS * RT,XXXXX * 19. SET BREAK FLAG * BR,XXXXX * 20. ABORT JOB REQUEST * AB * 21. RUN REQUEST * RU,XXXXX * RU,XXXXX,P1,...,P5 * 22. BUFFER LIMIT PRINT/CHANGE * BL OR BL,N1,N2 HED OPERATOR INPUT MESSAGE DECIPHER ROUTINE * * CALLING SEQUENCE * JSB $MESS * B CONTAINS NUMBER OF CHARACTERS * A IS THE BUFFER ADDRESS * * * * INPUT DECIPHER ROUTINE ROUTINE SCANS THE ASCII OPERATOR * INPUT AND STORES THE DATA INTO PARAMETERS. * THIS ROUTINE ASSUMES THE CHARACTER COUNT IN B ON ENTRY AND * DATA IN BUFFR. COMMA IS USED TO SEPARATE PARAMETERS. A PARA- * METER MAY BE UP TO 6 ASCII CHARACTERS- EXCEPT FOR OP CODE * WHICH MUST BE 2 CHARACTERS. A MAXIMUM OF 40 CHARACTERS MAY BE * INPUT. A (COUNT IS KEPT OF THE NUMBER OF PARAMETERS INPUT AND * A CHARACTER COUNT IS KEPT FOR EACH PARAMETER. THE VALUES ARE * STORED LEFT ADJUSTED IN THE BUFFERS. * * $MESS NOP ENTRY/EXIT SZB,RSS IS COUNT ZERO JMP M0150 YES, SO EXIT JSB $PARS GO PARSE THE REQUEST BUFAD DEF PRAMS ADDRESS OF PRAMETER BUFFER SPC 2 * * THIS SECTION CHECKS THE OPERATOR REQUEST CODE AGAINST THE * LEGAL REQUEST CODES AND JUMPS TO THE PROPER PROCESSOR. ******************************************************************* * TO ADD NEW REQUEST ONE MERELY, * A. ADDS ASCII OPERATION CODE TO TABLE -LDOPC- * B. ADDS PROCESSOR START ADDRESS TO TABLE -LDJMP- * C. ADDS PROCESSOR CODING TO PROCESS THE REQUEST. ******************************************************************* * SPC 1 IFZ ***** BEGIN DMS CODE ********** SJP *+2 ENABLE SYSTEM MAP ******* END DMS CODE ********** XIF SPC 1 LDB OP OPERATION CODE INTO B STB OPP SET STOP FLAG LDA LDOPC SET OPERATION TABLE POINTER STA TEMP1 LDA LDJMP SET OPERATION PROC. JUMP ADDRESS STA TEMP2 LDA P1 SEND P1 IN A REG. * UNL * CPB DBUG **********DEBUG********** * CLB,RSS **********DEBUG********** * JMP M0030 **********DEBUG********** * STB FLG **********DEBUG********** * ENT $JDDT **********DEBUG********** *JDDT JSB $DDT **********DEBUG********** * DEF $TYPE+2 **********DEBUG********** *BUG ASC 1,DB **********DEBUG********** * EXT $DDT **********DEBUG********** REP 7 NOP LST * M0030 CPB TEMP1,I COMPARE WITH TABLE VALUE JMP TEMP2,I COMPARES GO DO IT ISZ TEMP1 DOES NOT COMPARE-INCREMENT OP TABLE ISZ TEMP2 INCREMENT JUMP ADR. JMP M0030 GO TO COMPARE NEXT OP CODE * OPER LDA $OPER ILLEGAL OPERATION CODE REQUEST $MSEX EQU * SPC 1 IFN * BEGIN NON-DMS CODE ********** JMP $MESS,I RETURN *** END NON-DMS CODE ********** XIF SPC 1 IFZ ***** BEGIN DMS CODE ********** JRS $MEU $MESS,I RETURN AND RESTORE MEU STATUS ******* END DMS CODE ********** XIF SPC 1 * * ****NOTE THAT $MEU IS THE STATUS OF MEU AT LAST*** ****INTERRUPT---IT IS SAVED IN $CIC BEFORE A ***** ****INTERRUPT FROM THE DUMMY CARD CAN COME IN***** ****AND CHANGE THE STATUS************************ * * * LDOPC DEF *+1 OPERATION CODE TABLE ADDRESS ASC 7,ONOFSSGOSTPRIT $ASTM ASC 7,TMDNUPLUEQTOTI ASC 4,BRRUBLRC ASC 2,PLLO OPP NOP OPCODE FOR CURRENT REQUEST LDJMP DEF *+1,I JUMP ADDRESS FOR EACH OPER. CODE DEF M0100 ON REQUEST DEF M0200 OF REQUEST DEF M0300 SS REQUEST DEF M0400 GO REQUEST DEF M0500 ST REQUEST DEF M0650 PR REQUEST DEF M0600 IT REQUEST DEF $TMRQ TM REQUEST DEF IODN DN REQUEST DEF $IOUP UP REQUEST DEF $LUPR LU REQUEST DEF $EQST EQ REQUEST DEF $CHTO TO REQUEST DEF $TIRQ TI REQUEST DEF M0725 BR REQUEST DEF M0408 RU REQUEST DEF $BLRQ BL REQUEST DEF RCOP RC REQUEST DEF AP000 PL REQUEST DEF AP010 LO REQUEST DEF OPER OPERATOR ERROR HED PARSE SUBROUTINE FOR OPERATOR MESSAGES * CALLING SEQUENCE: * LDA BUFFER ADDRESS * LDB CHARACTER COUNT * JSB $PARS * DEF PRAM BUFFER * -RETURN- * * THE PRAM BUFFER IS 33 WORDS LONG AND CONTAINS UP TO 8 * PRAMETER DESCRIPTERS FOLLOWED BY THE PRAMETER COUNT. * * EACH PARAMETER DESCRIPTER CONSISTS OF FOUR WORDS: * * WORD MEANING * 1 FLAG WORD 0=NULL PRAMETER * 1=NUMERIC PRAMETER *  2=ASCII PRAMETER * 2 0 IF NULL,VALUE IF NUMERIC,ASCII(1,2) IF ASCII * 3 0 IF NOT ASCII ELSE ASCII(3,4) * 4 0 IF NOT ASCII ELSE ASCII(5,6) * * TEMP USAGE IN PARSE SECTION: * * TEMPP = CHARACTER ADDRESS * TEMP = PARAMETER FLAG ADDRESS * TEMP1 = TEMP BUFFER FETCH ADD. * TEMP2 = TEMP BUFFER STORE ADD. * TEMP3 = LAST INPUT CHAR.+1 ADD. * TEMP4 = PARAMETER VALUE ADDRESS. * TBUF = DEF TEMP5 (6 LOCATIONS) * TBUFS = DEF TEMP5+7 * WSTAT = PARAM COUNT * $PARS NOP ENTRY/EXIT CLE,ELA MAKE CHARACTER ADD. STA TEMPP SET BUFFER CHAR ADD. ADA B COMPUTE END ADDRESS. STA TEMP3 AND SET IT. LDB DM32 CLEAR PARAMETER AREA STB TEMP LDB $PARS,I CLA MES1 STA B,I INB ISZ TEMP JMP MES1 * STA B,I CLEAR THE PRAM COUNT STB WSTAT SET ADDRESS OF PRAM COUNT DEC09 LDA TBUF INITIALIZE TEMP BUFFER ADDRESS STA TEMP1 STA TEMP2 * DEC10 LDB TEMPP GET THE BUFFER CHAR ADDRESS CPB TEMP3 IF NO MORE CHARACTERS JMP DEC60 GO PROCESS PRAM ISZ TEMPP STEP INPUT POINTER CLE,ERB CONVERT TO WORD SET UP LOW IN E LDA B,I GET WORD FROM THE BUFFER SEZ,RSS CHECK IF TO EXAMINE UPPER/LOWER ALF,ALF UPPER, SO ROTATE TO LOWER BITS AND B377 MASK OFF ALL BUT LOW ORDER CPA COM SEE IF A COMMA JMP DEC60 YES CPA LASCI CHECK IF BLANK CHARACTER JMP DEC10 YES, SO SKIP CHARACTER LDB TEMP2 CHECK IF 6 CHARACTERS IN PRAM  CPB TBUFS IF SO JMP DEC10 SKIP STORE STA TEMP2,I STORE THE CHARACTER STA SABRT SAVE THE LAST CHARACTER ISZ TEMP2 STEP FOR NEXT CHAR. * JMP DEC10 GO TO PROCESS NEXT CHARACTER * * ATTEMPT NUMERIC CONVERSION OF PRAM. * DEC60 LDA WSTAT,I FIRST SET UP POINTERS RAL,RAL TAKE 4 TIMES THE PRAM NUMBER ADA $PARS,I PLUS THE OP CODE ADDRESS-1 STA TEMP SET FLAG ADDRESS CLE,INA ONE MORE AND WE HAVE STA VALOC THE PRAMETER VALUE LOCATION LDA TEMP2 IF NO CHARACTERS CPA TBUF INPUT JMP DEC75 GO TRY NEXT ONE * * NOW TRY FOR A NUMBER * LDB TEMP1,I GET FIRST CHAR CPB DASH MINUS SIGN? ISZ TEMP1 YES, INCRE TO NEXT CHAR CPA TEMP1 (A) STILL = TEMP2 JMP DEC80 IF "-" WAS ONLY CHAR, THEN ASCII * LDB D10 SET UP CONVERSION BASE LDA SABRT CPA "B" IF B SUFFIX LDB D8 SET FOR BASE 8 STB TEMP4 SET BASE ISZ TEMP,I SET FLAG TO 1 FOR NUMBER DEC65 MPY VALOC,I BUMP THE CURRENT VALUE VALOC EQU *-1 LDB TEMP1,I GET THE NEXT CHAR. ADB DM58 IF GREATER THAN "9" SEZ,CLE,RSS THEN NOT A NUMBER ADB D10 IF LESS THAN "0" SEZ,CLE,RSS THEN JMP DEC80 NOT A NUMBER ADA B ACCUMULATE THE STA VALOC,I NUMBER ISZ TEMP1 STEP THE BUFFER ADDRESS LDA TEMP4 GET THE BASE TO A LDB TEMP1 AND THE NEXT CHAR. LOC. TO B CPB TEMP2 IF END THEN JMP DEC70 GO TO NEXT PRAM * INB IF BASE 8 CONVERSION CPB TEMP2 AND LAST CPA D10 CHAR. THEN DONE SO SKIP JMP DEC65 ELSE GO GET THE NEXT ONE * SPC 1 DEC70 LDB VALOC,I GET VALUE LDA TBUF,I IF NEG NUMBER, CPA DASH CMB,INB NEGATE JVALUE STB VALOC,I STORE VALUE * DEC75 ISZ WSTAT,I COUNT THE PRAMETER LDA WSTAT,I IF LDB TEMP3 EOL OR CPB TEMPP 8 PRAMS LINE RSS THEN CPA D8 JMP DEC90 GO PROCESS JMP DEC09 ELSE GO GET NEXT CHARACTER SPC 1 DEC80 ISZ TEMP,I SET NOT NUMBER FLAG LDA AASCI FILL THE PRAM WITH BLANKS LDB VALOC PRAM ADDRESS TO B INB DON'T WORRY ABOUT FIRST WORD STA B,I SET SECOND WORD CLE,INB STEP TO THIRD WORD STA B,I SET THIRD WORD TO DOUBLE BLANK. LDB TBUF GET THE TEMP BUFFER POINTER DEC85 CPB TEMP2 END OF INPUT? JMP DEC70 YES GO PROCESS NEXT PRAM CPB STOP SIXTH CHAR YET? JMP DEC75 YES, END PARAM LDA B,I GET THE CHARACTER SEZ,RSS IF UPPER CHARACTER ALF,SLA,ALF ROTATE AND SKIP XOR VALOC,I LOWER ADD THE UPPER CHAR. XOR LASCI ADD/DELETE THE LOWER BLANK STA VALOC,I STORE THE PACKED WORD SEZ,CME,INB STEP B,SKIP IF UPPER ISZ VALOC ELSE STEP STORE ADDRESS. JMP DEC85 GO GET OTHER CHAR. SPC 2 DEC90 ISZ $PARS STEP RETURN ADDRESS JMP $PARS,I RETURN SPC 2 "B" OCT 102 ASCII "B" DASH OCT 55 ASCII "-" STOP DEF TEMP5+6 ASCII 6TH CHAR STOP HED MESSAGE PROCESSOR--ON,XXXXX COMMAND * * ON,XXXXX * ON,XXXXX,NOW * ON,XXXXX,P1,...,P5 * ON,XXXXX,NOW,P1,...,P5 * * THE ON REQUEST FUNCTIONS AS FOLLOWS: * IF NO RESOLUTION CODE, THEN PROGRAM SCHEDULED. * IF -NOW- OPTION, THEN ENTER PROGRAM INTO TIME LIST * AND SET TIME VALUES TO CURRENT TIME PLUS 10 MSC * IF NOT ONE OF ABOVE, AND TIME VALUES ARE ZERO THEN * PROGRAM FUNCTIONS SAME AS -NOW- OPTION. * IF NOT ONE OF ABOVE, AND TIME VALUES ARE PRESENT, * U THEN PROGRAM IS ADDED TO TIME LIST. * NOTE: ALL THE ABOVE OPTIONS ALLOW PARAMETERS TO BE * PASSED TO THE PROGRAM. THESE MUST BE ASCII * DECIMAL NUMBERS WHICH ARE CONVERTED TO BINARY * AND STORED IN ID SEGMENT TEMP AREA. UPON * EXECUTION, THE B REGISTER WILL POINT TO TEMP. * UP TO 5 PARAMETERS MAY BE INPUT. IF NO PARA- * METERS ARE INPUT, THE TEMP AREA ARE ZEROS BUT * B REGISTER WILL STILL POINT TO TEMP. AREA * M0100 JSB TTNAM FIND ID SEGMENT ADDR SZA CHECK IF PROGRAM DORMANT JMP M0405 ILLEGAL STATUS ERROR JSB PLOAD GO TO PROCESS CONTROL PRAMETERS LDB $WORK INDEX TO WORD 29 OF ADB D28 SCHEDULED PROGRAM LDA NRFL1 SET NEW-RUN FLAG AND STA B,I SET CONSOLE = LU 1 JMP $ONTM COMPLETE IN TIME MODULE, RETURN $MSEX HED MESSAGE PROCESSOR--OF,XXXXX COMMAND * * OF,XXXXX * OF,XXXXX,1 "ABORT" * OF,XXXXX,8 "ABORT AND REMOVE FROM SYSTEM" * * THE OF REQUEST FUNCTIONS AS FOLLOWS: * IF PROGRAM DORMANT, IT MAY STILL BE IN TIME LIST SO * A CALL IS MADE TO REMOVE PROGRAM FROM TIME LIST * IF ABORT OPTION 1, THEN $ABRT PROCESSOR IS * CALLED. IF ABORT OPTION 8, IN ADDITION TO * $ABRT PROCESSOR BEING CALLED, IF BIT 7 OF THE * TYPE FIELD IS SET, THEN TRACK(S) WHERE PROGRAM * IS STORED IS ALSO RELEASED BY $DREL. THE NAME * FIELD IN THE ID SEGMENT IS CLEARED SO THAT THE * PROGRAM CANNOT BE CALLED AGAIN. * IF PROGRAM SCHEDULED OR OPERATOR-SUSPENDED, THEN * DORMANT REQUEST MADE VIA LIST PROCESSOR AND * PROCEED AS ABOVE. * IF PROGRAM STATUS NOT ONE OF ABOVE, THE DORMANT BIT * IS SETJ6 IN STATUS, IF NOT ABORT OPTION. IF ABORT * OPTION, CHECK IF AVAILABLE MEMORY OR UNAVAILABL * DISC TRACK SUSPENSION-IN WHICH CASE THE ABORT * BIT IS SET AND $ABRT CALLED. IF STATUS IS I/O * SUSPENSION, SET ABORT BIT AND RETURN. * IF INPUT SUSPENSION, CHECK IF * PROGRAM BEING READ IN FROM DISC. IF YES, THEN * SET ABORT BIT AND RETURN. IF NOT BEING READ IN * FROM DISC, SET ABORT BIT AND CALL $IOCL TO * CLEAR THE I/O REQUEST * M0200 JSB TTNAM GO TO FIND ID SEG ADDR LDB $WORK GET ID SEG ADDRESS AND STB TEMPH SAVE IT IN LOCAL STORE LDA P2 GET PRAM TWO SZA IF NOT ZERO GO DO POWER THING JMP M0250 * M0240 JSB SABRT GO DO SOFT ABORT JMP $XEQ EXIT DONE * M0250 LDA WSTAT,I POWER ABORT SO AND D15 GET CURRENT STATUS SWP PUT ID-SEG. ADDRESS IN A,STAT IN B CPB D2 IF I/O SUSP THEN JMP $IOCL GO ABORT THE I/O * JSB $ABRT GO TO ABORT ROUTINE LDA P2 RELEASE PROG'S ID SEG? CPA D8 IF P = 8, RSS YES JMP $XEQ NO-SO RETURN * LDB TEMPH ADB D12 CLA STA B,I INB STA B,I INB LDA B,I SAVE THE OLD SHORT/LONG AND B77 FLAG STA B,I JMP $XEQ GO EXIT SPC 1 * * THE SOFT ABORT ROUTINE CLEARS ANY RESOURCE FLAGS * CALLS THE TERMINATION ROUTINE AND REMOVES A PROGRAM FROM * THE TIME LIST. * * IT ALSO SETS THE ABORT FLAG (100000) IN THE FATHERS ID-SEG. * (IF THERE IS A FATHER AND HE IS WAITING) SO THAT RMPAR * MAY RECOVER THE PRAMETER. * * IF THE PROGRAM IS WAITING FOR A SON IT CLEARS THE SONS * "FATHER IS WAITING" FLAG. * * CALLING SEQUENCE: * * LDB ID-SEG. ADDRESS * JSB SAJB@ 0 NAME OF THE PGM IN PARTITION #XXXXX IS PRINTED * THE STATUS REQUEST OUTPUTS THE REQUESTED PROGRAM STATUS * IN THE FOLLOWING FORMAT: * PRPRP S R MMMM HR MN SC MS T * * PRPRP =PRIORITY * S = STATUS (0 THRU 6 * R = RESOLUTION CODE (0 THRU 4) * MMM = MULTIPLE VALUE * HR = NEXT START TIME -HR * MN = NEXT START TIME -MIN * SC = NEXT START TIME -SEC * MS = NEXT START TIME -10 MSEC * T = PRESENT IF PROGRAM IN TIME LIST * M0500 LDB XEQT IF ZERO SZA,RSS GIVE STATUS OF SPC 1 IFN * BEGIN NON-DMS CODE ********** JMP M0550 CURRENT PGM *** END NON-DMS CODE ********** XIF SPC 1 IFZ ***** BEGIN DMS CODE ********** JMP M0540 CURRENT PGM ******* END DMS CODE ********** XIF SPC 1 SSA JMP M0505 IF NEG, ASSUME WANT PRG STATUS SPC 1 IFZ ***** BEGIN DMS CODE ********** CCB $MATA-1 IS ADDR OF ADB $MATA COUNT OF PTTNS LDB B,I CMB IF (A) .LE. TOTAL ADB A NUMBER OF PTTNS SSB THEN GIVE PTTN STATUS JMP M0530 ******* END DMS CODE ********** XIF SPC 1 * M0505 JSB TTNAM GO TO FIND ID SEGMENT ADDR JSB $CVT1 CONVERT STATUS TO ASCII. ALF,ALF MOVE TO HIGH HALF WORD STA BUFF4 STORE STATUS IN BUFFER. LDB DM28 STB BUFFR STORE CHARACTER COUNT IN BUFFER LDB $WOR82K ADB D6 PRIORITY ADDRESS LDA B,I JSB $CVT1 CONVERT PRIORITY TO ASCII LDB ASCI1 GET DIGITS 23-45 TO B-A RRL 8 34-52 IN B-A STB BUFF2 SET 34 LDB ASCI 1-52 IN B-A ALF,ALF 1-25 IN B-A RRL 8 12-5 IN B-A STB BUFF1 SET 12 STA BUFF3 SET 5 BLANK LDB TEMP6 RESTORE B TO PRIOR ADDRESS JMP $STRQ PRINT NEXT-TIME IF HAVE TIME MODULE SPC 1 B7777 OCT 7777 DM28 DEC -28 DM1 DEC -1 ASC00 ASC 1,00 SPC 1 SPC 1 IFZ ***** BEGIN DMS CODE ********** DM8 DEC -8 D21 DEC 21 * M0530 ADA DM1 MPY D6 (PTTN#-1)*6 IS ADA $MATA ADDR OF ENTRY IN MATA ADA D2 +2 FOR ID SEG ADDR WORD LDB A,I (B)=ID SEG ADDR JMP M0550 GO PRINT PRG NAME * M0540 SZB,RSS ANY PRG RUNNING? JMP M0550 NO PRINT 0 ADB D21 GET PARTITION # LDA B,I FROM ID SEG WORD 22 AND B77 INA GET USERS ACTUAL PART NUMBER JSB $CVT1 CONVERT TO DECIMAL STA BUFF4 SET IN MESSAGE LDB XEQT (B)=ID SEG ADDR LDA DM8 (A)=COUNT 8 CHARS JMP M0560 GO PRINT ******* END DMS CODE ********** XIF SPC 1 M0550 CCA SET A FOR ZERO PRINT SZB SKIP IF NO PROGRAM LDA DM5 ELSE RESET A FOR PGM PRINT M0560 STA BUFFR SET MESSAGE LENGTH LDA ASC00 GET UPPER ASCII "0" TO A SZB SKIP IF NO PGM ADB D12 ELSE STEP TO NAME ADDRESS LDA B,I STA BUFF1 SET NAM12 INB STEP TO NEXT NAME WORD DLD B,I GET THE NEXT WORDS STA BUFF2 SET NAM34 LDA AASCI FILL RIGHT BLANK BLF,BLF INTO NAM5 RRL 8 STB BUFF3 SET NAM5 LDA BUFAD JMP $MSEX GO EXIT SPC 2 INBUF BSS 22 MESSAGE INPUT BUFFER BUFFL EQU *-INBUF+*-INBUF LENGTH IN #CHARS SPC 2 * SYSTEM OUTPUT BUFFER & PARAMETER STORAGE * BUFFR EQU * SHOULD BE AT LEAST 15 WORDS LONG BUFF1 EQU BUFFR+1 BUFF2 EQU BUFFR+2 BUFF3 EQU BUFFR+3 BUFF4 EQU BUFFR+4 BUFF5 EQU BUFFR+5 BUFF6 EQU BUFFR+6 BUFF7 EQU BUFFR+7 BUFF8 EQU BUFFR+8 BUFF9 EQU BUFFR+9 BUF10 EQU BUFFR+10 BUF11 EQU BUFFR+11 BUF12 EQU BUFFR+12 BUF13 EQU BUFFR+13 BUF14 EQU BUFFR+14 $MSBF EQU * ENTRY POINT TO THIS BUFFER PRAMS BSS 1 CHARACTER COUNT-OP CODE OP BSS 3 OPERATION CODE CP1 BSS 1 CHAR COUNT-PARAM 1 P1 BSS 3 PARAM 1 (UP TP 3 WORDS-6CHAR.) CP2 BSS 1 CHAR COUNT-PARAM 2 P2 BSS 3 PARAMETER 2 CP3 BSS 1 CHAR COUNT-PARAM 3 P3 BSS 3 PARAMETER 3 CP4 BSS 1 CHAR COUNT-PARAM 4 P4 BSS 3 PARAMETER 4 CP5 BSS 1 CHAR COUNT -PARAM 5 P5 BSS 3 PARAMETER 5 CP6 BSS 1 CHAR COUNT-PARAM 6 P6 BSS 3 PARAMETER 6 CP7 BSS 1 CHAR COUNT-PARAM 7 P7 BSS 3 PARAMETER 7 PARAM BSS 1 PARAMETER COUNTER * ENDT EQU * * ORG INBUF FORCE START-UP RECONFIGURATION CODE RECON STB RCNFB TO BE IN MESSAGE INPUT BUFFER LDA KEYWD AFTER SAVING POSSIBLE FLOPPY I/O CHANNEL STA KEY PREPARE TO SEARCH FOR MRCNF'S ID SEG * RCNLP LDA KEY,I SZA,RSS END OF KEYWORD LIST? JMP RCNEN YES, DIDN'T FIND MRCNF * ADA D12 INDEX TO NAME WORDS LDB A,I CPB RCNM CHAR1,2 MATCH? INA,RSS YES, SKIP JMP RCNID NO, TRY NEXT ID * LDB A,I CPB RCNM1 CHAR3,4 MATCH? INA,RSS YES, SKIP JMP RCNID NO, TRY NEXT ID * LDA A,I AND MASKU CPA RCNM2 CHAR5 MATCH? JMP RCNFD YES, FOUND MRCNF * RCNID ISZ KEY BUMP KEYWORD TABLE ADDR JMP RCNLP TO LOOK AT =NEXT ID SEG * RCNFD LDA KEY,I ADA D7 INCR UP TO PRIM ENTRY ADDR LDB A,I STB RCNFA LDB RCNFB (B)=POSSIBLY THE FLOPPY I/O CHANNEL # JSB RCNFA,I CALL MRCNF (A)=PRIM ENT WORD ADDR IN ID SEG RCNEN CLA DONE RECONF OR NO MRCNF STA $STRT JMP $STRT JMP TO NOP (MIGHT SAVE A BP LINK) * RCNFA NOP RCNFB NOP RCNM ASC 1,MR M-R RCNM1 ASC 1,CN C-N RCNM2 OCT 43000 F-NULL D7 DEC 7 ENDO EQU ENDT-* NUMBER OF OVERLAYABLE WORDS LEFT ORR HED ROUTINE TO SET UP SYSTEM MAP SPC 1 IFZ ***** BEGIN DMS CODE ********** SYSMP NOP CLA START REGISTER 0 CLB START VALUE 0 LDX D32 LENGTH OF SYSTEM XMS LOAD SYSTEM MAP LDA $MPSA GET START PAGE SYS AV AND B1777 STA TBL B HAS START VALUE LDA AVMEM GET LOGICAL ADDR OF S.A.M. AND B1777 XOR AVMEM KEEP ONLY PAGE ALF RAL,RAL GET IN LOW 5 BITS STA NWDS1 START PAGE OF SAM LDA TBL XOR $MPSA GET LENGTH ALF RAL,RAL A HAS LENGTH STA MADR1 TEMPORORY STORE CAX PUT IN XREG LDB TBL START PAGE NUMBER LDA NWDS1 START REGISTER XMS LOAD MAP LDA NWDS1 YES ADA MADR1 TOTAL NUMBER REGISTERS MAPPED LDB A IOR WRTPR STA WRTPR LDA B CMB,INB ADB D32 SEE HOW MANY LEFT CBX LDB WRTPR GET WRITE PROTECT XMS SJP SYSMP,I ENABLE SYSTEM MAP SPC 2 $MPSA BSS 1 0-9,STARTING PAGE SYS AV MEM * 10-15,NUMBER PAGES SAM WRTPR OCT 100000 B1777 OCT 1777 D32 DEC 32 NWDS1 NOP MADR1 NOP ******* END DMS CODE ********** XIF SPC 1 * * * MESSAGE PROCESSOR--IT,XXXXX COMMAND * * IT,XXXXX * IT,XXXXX,R,MMM * IT,XXXXX,R,MMM,HR,MN * IT,XXXXX,R,MMM,HR,MN,SC * IT,XXXXX,R,MMM,HR,MN,SC,MS * * R=RESOLUTION CODE * 1= TEN MILLISECOND CODE * 2= SECONDS CODE * 3= MINUTES CODE * 4= HOURS CODE * MM= MULTIPLICATION FACTOR * HR= START HOURS * MN= START MINUTES * SC= START SECONDS * MS= START TENS OF MILLISECONDS * M0600 JSB TTNAM GO FIND ID SEG ADDR SZA PROG MUST BE DORMANT TO CONTINUE JMP M0405 ILLEGAL STATUS ERROR JMP $ITRQ GO TO OPTIONAL CLOCK MODULE SPC 2 * RC,X COMMAND * RCOP AND C377 KEEP LEFT BYTE CLB,INB CPA ASL RC,L ? JMP RCL YES, SET $LCTU=1 * CPA ASR RC,R ? CLA,RSS JMP OPER NO, OPERATOR ERROR * STB $RCTU YES, SET $RCTU=1 JMP $MSEX RETURN * RCL STB $LCTU SET LEFT CTU INVALID CLA JMP $MSEX RETURN * C377 OCT 177400 ASL OCT 046000 "L" IN LEFT BYTE ASR OCT 051000 "R" IN LEFT BYTE $LCTU OCT 1 INIT TO INVALID DIRECTORY $RCTU OCT 1 INIT TO INVALID DIRECTORY HED MESSAGE PROCESSOR--PR,XXXXX,ZZ COMMAND * * PR,XXXXX,ZZ PROCESSOR * * THE PRIORITY CHANGE ROUTINE FUNCTIONS AS FOLLOWS: * IF PROGRAM STATUS OTHER THAN DORMANT, STATUS ERROR. * IF DORMANT, THEN PRIORITY VALUE CHANGED AND PROGRAM * LIST UPDATED VIA LINK PROCESSOR. * M0650 JSB TTNAM GO TO FIND ID SEG ADDR JMP $PRRQ CONTINUE IF WE HAVE OPTIONAL MODULE SPC 5 * MESSAGE PROCESSOR -- BR,XXXX REQUEST * * SET BREAK BIT IN PROGRAMS ID-SEGMENT * M0725 JSB TTNAM LOOK UP THE PROGRAM ADB D20 INDEX TO BREAK WORD LDA B,I GET WORD IOR B10K SET BREAK BIT STA B,I RESTORE THE WORD JMP M0150 EXIT SPC 5 IODN LDB CP2 SZB,RSS IS THERE A SECOND PARAM? CCB,RSS / NO, SET (B)= -1 LDB P2 YES, SET (B)= PARAM JMP $IODN SPC 5 * PL,LU,OPT PROGRAM LIST COMMAND * AP000 CLB (A) = LU STB TEMPP SET FUNC = 0 LDB P2 STB P4 MOVE OPT TO P4 FOR LATER JMP AP100 GO SCHEDULE APLDR * * * LO,XXXXX,SC,CR-LU,PTTN#,SIZE * AP010 CLA,INA SET FUNC = 1 LDB P4 SZB INA SET FUNC = 2 IF PTTN# NOT ZERO CMB,SZB,RSS STB P4 CHANGE PTTN# TO 0 IF GIVEN -1 STA TEMPP SAVE FUNC * LDA P5 GET PTTN SIZE PARAM ALF,ALF SHIFT (EVENTUALLY) TO BITS 10:14 RAL,RAL IOR P4 FILL PTTN# IN BITS 0:5 STA P4 CLA NO LU PARAM IF 'LO' * AP100 ALF PUT LU IN BITS 4:9 IOR TEMPP MERGE FUNCTION TO BITS 0:3 STA TEMPP * LDB APLDR JSB TNAME FIND APLDR'S ID SEG SZA,RSS JMP OPER CAN'T FIND APLDR, SO OPER ERR * LDA WSTAT,I STATUS OF APLDR AND D15 MUST BE DORMANT SZA JMP M0405 IT'S NOT * INB BUMP TO PARAM AREA OF APLDR'S ID SEG LDA TEMPP STA B,I SET LU/FUNC INB LDA P4 STA B,I SET SIZE/PTTN# OR OPT INB LDA P1 STA B,I SET NAM12 INB LDA P1+1 STA B,I SET NAM34 INB LDA P1+2 STA B,I SET NAM56 ADB D5 INCRE TO XB WORD IN ID SEG LDA $WORK INA STA B,I SET XB TO POINT TO TEMP1 ADB B20 INDEX TO WORD 27 LDA P2 STA B,I SET SC FOR 'LO' INB LDA P3 STA B,I SET CR-LU FOR 'LO' INB LDA NRFL1 STA B,I SET NEW-RUN FLAG JSB $LIST SCHEDULE APLDR OCT 301 JMP $MSEX EXIT * APLDR DEF *+1 ASC 3,APLDR SPC 5 * * INPUT ERROR MESSAGE OUTPUT * * $INER LDA $ERIN INPUT ERROR MESSAGE JMP $MSEX RETURN SPC 2 * MESSAGE PROCESSOR CONSTANTS ETC. * LASCI OCT 000040 ASCII BLANK IN LOW CHARACTER AASCI OCT 020040 ASCII BLANK IN BOTH CHAR MASKU OCT 177400 UPPER CHARACTER MASK (AND) KEY NOP TEMPORARY STORAGE NO ASC 1,NO ASCII NO FOR 'NOW' TEST * DEFP2 DEF *+1,I DEF P2 DEF P3 DP4 DEF P4 DP5 DEF P5 DP6 DEF P6 DP7 DEF P7 HED CONTROL PARAMETER STORE IN ID SEGMENT * * PLOAD NOP ENTRY/EXIT LDB DEFP2 GET INDIRECT DEF TO PRAMS LDA CP2 GET PRAM FLAG RAR,SLA IF ASCII "NO" LDA P2 ENTERED CPA NO THEN STEP PRAM ADDRESS FIRST TIME INB STEP PRAM ADDRESS LDA $WORK GET ID-SEGMENT ADDRESS JSB PRAM GO SET PRAMS. JMP PLOAD,I RETURN * * SUBROUTINE TO SET UP THE PRAMETERS IN A PROGRAMS * ID-SEGMENT. PRAM SETS FIVE PRAMETERS AND THE B * REGISTER. IF THE NO PRAMETER FLAG IS SET NO * ACTION IS TAKEN. * * CALLING SEQUENCE: * * LDB PRAM ADDRESS (OR INDIRECT TO LIST OF ADDRESSES) * LDA ID-SEGMENT ADDRESS * JSB PRAM * * RETURN REGISTERS MEANING LESS. * PRAM NOP INA STEP TO THE PRAM AREA STA TEMP SET IN TEMP ADA D9 STEP TO THE B-REGISTER STA TEMP1 ADDRESS AND SAVE ADA D5 STEP TO THE STATUS ADDRESS LDA A,I GET THE STATUS AND CHECK RAL,RAL THE NO PRAM ALLOWED BIT SSA IF SET THEN JMP PRAM,I JUST EXIT * SPC 1 IFZ ***** BEGIN DMS CODE ********** RSA GET MEU STATUS RAL,RAL GET CURRENT STATUS STA PRSTM UJP *+2 ENABLE USER MAP ******* END DMS CODE ********** XIF SPC 1 LDA TEMP GET THE PRAM AREA ADDRESS AND STA TEMP1,I SET IT IN ,THE B REG. SAVE AREA LDA DM5 SET UP THE STA TEMP1 COUNTER PRAM1 CLA ZERO ADDRESS GETS A ZERO LDA B,I GET PRAM STA TEMP,I STUFF IT ISZ TEMP STEP STORE ADDRESS INB STEP SOURCE ADDRESS ISZ TEMP1 DONE? JMP PRAM1 NO- CONTINUE SPC 1 IFN * BEGIN NON-DMS CODE ********** JMP PRAM,I YES-EXIT *** END NON-DMS CODE ********** XIF SPC 1 IFZ ***** BEGIN DMS CODE ********** JRS PRSTM PRAM,I YES-EXIT PRSTM NOP ******* END DMS CODE ********** XIF SPC 1 HED MESSAGE PROCESSOR NAME SEARCH * * CALL TO NAME SEARCH ROUTINE * * CALLING SEQUENCE: * * JSB TTNAM NAME ASSUMED TO BE IN P1 * * ON RETURN: * WORK CONTAINS THE ID-SEG. ADDRESS * WSTAT AND B CONTAIN THE STATUS ADDRESS * A CONTAINS THE LEAST 4 STATUS BITS. * E = 0 IF STANDARD ID SEGMENT * E = 1 IF SHORT (9 WORD ) ID SEGMENT * IF A SHORT ID SEGMENT A WILL BE SET TO 9. * TTNAM NOP ENTRY/EXIT LDB DEFP1 ADDRESS OF ASCII PROG NAME JSB TNAME CALL TO NAME SEARCH ROUTINE SZA,RSS IF ZERO, THEN PROG NOT FOUND JMP NXPRG SO TAKE GAS! LDA WSTAT,I GET STATUS TO A AND D15 MASK IT AND JMP TTNAM,I RETURN SPC 2 NXPRG LDA $NOPG NO SUCH PROG ERROR JMP $MSEX EXIT HED SEARCH KEYWORD LIST FOR PROGRAM NAME * ON ENTRY * B IS ADDRESS OF ASCII PROGRAM NAME * ON RETURN * A IS 0 IF PROGRAM NOT FOUND (E=1) * B IS ID SEGMENT ADDRESS OF REQUESTED PROGRAM * E = 0 IF STANDARD ID SEGMENT * E = 1 IF SHORT (9 WORD ) ID SEGMENT OR NOT FOUND * TNAME NOP ENTRY/EXIT STB TEMP3 ADDRESS OF NAME 1 AND 2 INB INCR TO CHAR 3 AND 4 ADDR STB TEMP4 SAVE IT INB INCR TO CHAR 5 ADDR LDA B,I ASCII NAME 6<:6CHAR 5 AND X AND MASKU MASK OFF X STA TEMP5 SZA IF NULL CHAR. FOURCE ERROR RETURN LDA KEYWD STA KEY TOP OF KEYWORD LIST TN005 LDA KEY,I CHECK IF AT END OF LIST CCE,SZA,RSS JMP TNAME,I END OF LIST ERROR RETURN ADA D12 LDB A,I ID SEG ASCII NAME CHARS 1 AND 2 CPB TEMP3,I COMPARE WITH REQUESTED CHAR 1,2 INA,RSS COMPARES JMP TN030 DOES NOT COMPARE-GO TO NEXT PROG LDB A,I ID SEG ASCII NAME CHARS 3 AND 4 CPB TEMP4,I COMPARE WITH REQUESTED CHARS 3,4 CLE,INA,RSS COMPARES JMP TN030 DOES NOT COMPARE-GO TO NEXT PROG STA WSTAT SET UP WSTAT IN CASE LDA A,I ID SEG ASCII NAME CHARS 5,X AND MASKU MASK OFF X CPA TEMP5 COMPARE CHARACTER 5 JMP TN040 COMPARES-SO PROGRAM FOUND * TN030 ISZ KEY INCREMENT KEYWORD ADDRESS JMP TN005 GO TO COMPARE CHARACTERS TN040 LDB KEY,I LOAD B WITH ID SEGMENT ADDRESS STB $WORK SET IN WORK ISZ WSTAT STEP TO STATUS ADDRESS AND JMP TNAME,I EXIT < HED CVT3 (BINARY TO ASCII CONVERSION) * * BINARY TO ASCII CONVERSION ROUTINE * * CALLING SEQUENCE * * SET E TO 0 IF OCTAL CONVERSION OR * SET E TO 1 FOR DECIMAL CONVERSION * LDA NUMBER TO BE CONVERTED * JSB $CVT3 * * RETURN ADDRESS OF ASCI IN A AND E=1. * RESULTS IN ASCI, ASCI+1, ASCI+2 * LEADING 0'S SUPPRESSED * $CVT3 NOP ENTRY/EXIT STB TEMP6 SAVE B REGISTER LDB PTTE INIT LOCATION OF BUFFER STB TMP LDB AASCI SET BUFFER=ASCII BLANK'S STB ASCI STB ASCI1 STB ASCI2 LDB DF10 ASSUME BASE TEN SEZ,CLE,RSS IF BASE EIGHT INB SET UP FOR BASE EIGHT STB BASE SET CONVERSION BASE ADDRESS DPCRL CLB START CONVERSION DIV BASE DIVIDE BY BASE BASE EQU *-1 DEFINE BASE ADDRESS ADB B20 CONVERT TO ASCII-BLANK SEZ IF HIGH DIGIT BLF,BLF ROTATE ADB TMP,I ADD CURRENT VALUE STB TMP,I STORE THE CONVERTED VALUE CCB,SEZ PREPARE FOR SUBTRACT ADB TMP IF HIGH CHAR. BACKUP SEZ,CME BUFFER POINTER STB TMP AND RESET SZA IF MORE DIGITS JMP DPCRL GO SET THE NEXT ONE * CCE SET E FOR NEXT CALL (ASSUME BASE 10) LDA PTT LOAD A WITH ASCI BUFFER ADDRESS LDB TEMP6 RESTORE B JMP $CVT3,I RETURN * B20 OCT 20 DF10 DEF D10 D10 DEC 10 D8 DEC 8 PTT DEF ASCI PTTE DEF ASCI2 HED $CVT1 (BINARY TO ASCII CONVERSION) * CALLING SEQUENCE: SAME AS $CVT3 * * RETURN RESULTS LEAST TWO DIGITS IN A. * OTHERS AS PER $CVT3 * $CVT1 NOP JSB $CVT3 GO CONVERT THE NUMBER LDA ASCI2 GET LEAST TWO DIGITS JMP $CVT1,I RETURN HED OUTPUT *_ ON SYSTEM TELETYPE ******************************************************************* * 2 THE $TYPE SECTION FUNCTIONS AS FOLLOWS: * ENTRY IS MADE BY STRIKING ANY SYSTEM TELETYPE KEY. * IF TELETYPE FLAG NOT BUSY, THEN * IS OUTPUT AND A * REQUEST IS MADE FOR INPUT. IF FLAG IS SET THEN * IGNORE REQUEST. UPON COMPLETION OF INPUT (LF), * THE MESSAGE PROCESSOR ROUTINE IS CALLED. * UPON RETURN, IF A REGISTER IS ZERO THEN NO * MESSAGE TO BE OUTPUT. IF A NON-ZERO, THEN A IS * ADDRESS OF MESSAGE TO OUTPUT WITH CHARACTER * COUNT THE FIRST WORD IN BUFFER. ******************************************************************* * $TYPE LDA FLG CHECK SYSTEM TTY FLAG SZA JMP $XEQ BUSY, SO RETURN TO $XEQ * JSB $XSIO CALL TO OUTPUT ASTERISK(*) OCT 1 ON SYSTEM TELETYPE NOP NOP OCT 2 DEF ASTRK DM4 DEC -4 OUTPUT CHARACTER COUNT OCT 0 SAYS DON'T NEED USER MAP * JSB $XSIO CALL TO REQUEST OPERATOR INPUT OCT 1 DEF TYP10 INPUT COMPLETION ADDRESS NOP OCT 401 INPUT WITH TYPEOUT IBUF DEF INBUF ABS -BUFFL DETERMINED BY $STRT ROUTINE OCT 0 DONT NEED USER MAP ISZ FLG SET SYSTEM TTY BUSY FLAG JMP $XEQ GO TO $XEQ * TYP10 CLA CLEAR THE COM FLAG STA FLG LDA IBUF GET BUFFER ADDRESS TO A JSB $MESS GO TO MESSAGE PROCESSOR ROUTINE SZA,RSS CHECK IF MESSAGE TO BE OUTPUT JMP TYP30 NO MESSAGE-SO GO RETURN * ISZ FLG SET THE COM FLAG LDB A,I STB TYP26 BRS CONVERT CHARACTER COUNT TO NEG. WORDS CMB,INB STB TYPCO SAVE WORD COUNT LDB IBUF GET DEST. ADDR INA GET SOURCE ADDR * SPC 1 IFN * BEGIN NON-DMS CODE *************** JSB .MVW MOVE THE MESSAGE DEF TYPCO  NOP *** END NON-DMS CODE *************** XIF SPC 1 IFZ ***** BEGIN DMS CODE *************** MVW TYPCO ******* END DMS CODE *************** XIF SPC 1 * JSB $XSIO CALL TO OUTPUT ERR MESSAGE OCT 1 DEF TYP30 COMPLETION ADDRESS TYPCO NOP OCT 2 DEF INBUF TYP26 NOP OCT 0 DONT NEED USER MAP JMP $XEQ GO TO $XEQ * TYP30 CLA CLEAR SYSTEM FLAG FOR NEXT STA FLG REQUEST JMP $XEQ * * ASTRK OCT 006412 CR, LF ASC 1,*_ ASTERISK, LEFT ARROW HED $ABRT ROUTINE TO ABORT A PROGRAM * ROUTINE: < $ABRT > * * PURPOSE: THIS ROUTINE PROVIDES FOR REMOVING * A USER PROGRAM FROM EXECUTION USUALLY * AFTER AN ERROR CONDITION IS DETECTED * WHICH PROHIBITS CONTINUED EXECUTION. * THE PROGRAM IS SET TO THE DORMANT * STATE, TIME INTERVAL REMOVED AND ANY * DISC TRACKS ASSIGNED TO THE PROGRAM * RELEASED. * * THE PROGRAM NAME IS SET IN THE MESSAGE * "XXXXX ABORTED" WHICH IS PRINTED * ON THE SYSTEM TELETYPE. * * CALL: (A) = ID SEGMENT ADDRESS * (P) JSB ABORT * (P+1) -RETURN- (REGISTERS MEANINGLESS) * $ABRT NOP SET ID SEGMENT ADDRESS STA TEMPH FOR SABRT CALL ADA D15 INDEX TO THE STATUS WORD LDB A,I GET THE WORD ADB B4000 SET THE ABORT BIT STB A,I RESET THE STATUS WORD LDB TEMPH SET B AND CALL JSB SABRT THE SOFT ABORT ROUTINE LDB TEMPH SET (B) = ADDRESS OF 3-WORD ADB D12 PROGRAM NAME IN ID SEGMENT. LDA B,I SET STA ABM PROGRAM INB NAME LDA B,I IN STA ABM+1 MESSAGE INB LDA B,I AND MASKU MASK OUT THE LOWER CHARACTER IOR LASCI REPLACE WITH A BLANK STA ABM+2 LDA ABMA PRINT MESSAGE: JSB $SYMG "XXXXX ABORTED" JMP $ABRT,I -EXIT- * ABMA DEF *+1 DM13 DEC -13 ABM ASC 7,EDIT ABORTED SPC 1 HED MEMORY PROTECT VIOLATION SCHEDULER PREPROCESSORS ******************************************************************* * THE $MPT1 THRU $MPT7 PREPROCESSORS CONSIST OF MEMORY * PROTECT VIOLATION CALLS FROM EXEC THAT INVOLVE LIST * PROCESSING. * THE FOLLOWING REQUESTS ARE HANDLED: * PROGRAM COMPLETION (DORMANT) * SUSPEND (OPERATOR) * BACKGROUND SEGMENT LOAD * SCHEDULE WITH WAIT * SCHEDULE WITHOUT WAIT * CURRENT SYSTEM TIME (TIME ROUTINE CALL) * SET ID SEGMENT TIME VALUES (TIMER ROUTINE CALL) ******************************************************************* SPC 3 * * DORMANT REQUEST - PROGRAM HAS RUN TO COMPLETION * $MPT1 JSB GETID GET THE ID-SEGMENT ADDRESS OF AFFECTED STB P2 PROGRAM - SAVE THE ID ADDRESS FOR PRAM MOVE CPB XEQT IF CURRENT PGM. SKIP JMP MPT1A FATHER CHECKS * ADB D20 CHECK FOR FATHER KILLING SON CCA ADA B,I AND B377 STEP TO FATHER PTR ADA KEYWD ADDRESS OF FATHER'S ID IN A LDA A,I CPA XEQT CURRENT PROGRAM? RSS YES SKIP JMP ESC04 NO GO FLUSH * LDB $WORK RESTORE THE ID-SEGMENT ADDRESS TO B * MPT1A LDA RQRTN UPDATE RETURN (B)= ID ADDR STA XSUSP,I CLA SET A TO ZERO IN CASE LDA RQP3,I PRAMETER NOT SUPPLIED CMA,SZA,RSS (-1) SERIALLY REUSABLE? JMP MPT1E YES, GO DO IT INA,SZA,RSS JMP MPT1B (0) STANDARD TERMINATION CALL. * INA,SZA,RSS JMP MPT1C (1) SAVE RESOURCES * INA,SZA,RSS JMP M0240 (2) SOFT ABORT * INA,SZA,RSS (3) HARD ABORT (LAST CHANCE) JMP M0250 WOW THAT WAS CoTLOSE! * ESC02 LDB D2 YOU LOSE - UNRECOGNIZED PRAMETER. JMP ESCXX GO ABORT HIM * MPT1C EQU * LDA WSTAT,I B=WORK SET IOR B200 RESOURCE BIT IN THE STATUS STA WSTAT,I AND THEN CPB XEQT IF CURRENT PROGRAM JMP MPT1D SKIP DORMANT REQUEST JSB $LIST OCT 400 JMP $XEQ GO TO DISPATCHER * MPT1E CPB XEQT TERM SON AS REUSABLE RSS JMP MPT1B GO DO NORMAL TERMINATE JSB TERM CALL TERMINATE ROUTINE ISZ TMP,I IF OK, SET FLAG FOR SERIAL REUSE JMP MPT1F GO FINISH PROCESSING * MPT1D JSB $WATR FIND WAITERS LDB XEQT MPT1B JSB TERM CALL TERMINATION ROUTINE MPT1F LDA DM3 IF REQUEST PRAMS ADA RQCNT THEN SSA SKIP JMP $XEQ ELSE GO TO THE DISPATCHER * LDB DEFR4 GET DEF TO PRAMS LDA P2 GET ID-ADDRESS JSB PRAM TRANSFER THE PRAMETERS JMP $XEQ GO TO THE DISPATCHER SPC 1 DM3 DEC -3 SPC 3 * THE TERM SUBROUTINE PERFORMS THE FOLLOWING FUNCTIONS: * * 1. CALL $LIST TO PUT THE PROGRAM IN THE DORMANT LIST * 2. IF THE PROGRAM HAS A FATHER WHO IS WAITING THE * FATHER IS RESCHEDULED * 3. CHECKS TO SEE IF ANOTHER PROGRAM IS WAITING FOR THIS ONE * AND SCHEDULES IT IF SO. * * CALLING SEQUENCE: * * LDB ID ADDRESS * JSB TERM * * ON RETURN THE FATHER POINTER (IF ANY) IS IN POP. * AND IF HE WAS WAITING E WILL BE SET ELSE E=0. * TERM NOP JSB $LIST PUT PGM. IN DORMANT OCT 400 LIST LDB $WORK GET ID SEG ADDRESS * ADB D20 INDEX TO THE PA POINTER LDA B,I GET THE WORD STB TMP SAVE THE ADDRESS RAL,ELA SET E IF FATHER IS WAITING CCB,SEZ,CME,RSS E=0 IF FATHER/1 IF NO FATHER JMP TERM2 IF NO FATHER GO SET -1. ADB KEYWD KEYWD-1 TO B (SETS E) RAR,CLE,RAR CRESTORE A AND SET E TO FATHER WAITING. AND B377 GET THE FATHER ID NUMBER ADB A ID ADDRSS TO B LDB B,I GET THE ID-SEG ADDRESS TERM2 STB POP SAVE THE ADDRESS ADB D15 REMOVE THE POP'S WAIT BIT LDA B,I GET POP'S STATUS AND B7777 KNOCK OUT THE WAIT BIT SEZ,RSS IF WAITING STA B,I RESTORE THE WORD AND D15 IF POP'S CPA D3 IN THE WAIT LIST SEZ AND WAITING JMP TERM3 JSB $LIST THEN RESCHEDULE OCT 101 THE FATHER POP DEF POP * TERM3 LDA TMP,I GET THE FLAG WORD AND B7400 AND KEEP ONLY RE,RM,RN FLAGS STA TMP,I IN WORD JMP TERM,I RETURN * * D20 DEC 20 SIGN OCT 100000 B200 OCT 200 B7400 OCT 7400 DEFR4 DEF RQP4,I SPC 2 $WATR NOP LDA B ADB D20 LDB B,I BLF,BLF RBR,SLB JSB $SCD3 SCHEDULE IF ANY WAITING JMP $WATR,I RETURN SPC 2 * * PROGRAM SUSPEND REQUEST * $MPT2 EQU * JSB $LIST OCT 506 OPERATOR SUSPEND REQUEST JMP MEM15 GO UPDATE XSUSP SPC 3 * PRAMO PASSES PRAMETERS FORM RQP3,4,5,6,AND 7 TO * THE ID-SEGMENT POINTED TO BY WORK. * *** ONLY CALLED BY IDCKK *** * * CALLING SEQUENCE: * * SET UP $WORK * JSB PRAMO * * ID-SEGMENT MUST NOT HAVE NO PRAM BITS SET IN IT'S STATUS. * PRAMO NOP CLB,INB IF NO PRAMS CPB RQCNT THEN JMP PRAMO,I JUST EXIT * LDA $WORK SET ADDRESS IN A LDB DEFR3 PRAM ADDRESS IN B AND JSB PRAM GO MOVE THE PRAMS. JMP PRAMO,I RETURN. SKP * * $SCD3 SCHEDULES PROGRAMS IN THE WAIT LIST (STATUS-3) * WHICH ARE WAITING FOR THE GIVEN RESOURCE. * * CALLING SEQUENCE: * * LDA RESOURCE FLAG (CONTENTS OF XTEMP OF WAITER) * JSB $SCD3 * RETURN - B,E = 0 A = ? * $SCD3 NOOP STA $IDNO SAVE THE RESOURCE ID FLAG LDB SUSP2 GET THE LIST HEAD SCD31 CLE,SZB,RSS IF END OF LIST JMP $SCD3,I RETURN * LDA B GET THIS ENTRIES INA FLAG FROM LDA A,I HIS ID-SEGMENT CPA $IDNO THIS ONE?? JMP SCD32 YES GO RESCHEDULE * LDB B,I NO GET NEXT ENTRY TO B JMP SCD31 AND GO TEST IT. * SCD32 LDA B,I GET THE NEXT ID IN LIST STA PRAMO AND SAVE IT JSB $LIST SCHEDULE THE PROGRAM OCT 401 WHOSE ID-SEGMENT ADDRESS IS IN B LDB PRAMO GET NEXT ID TO B JMP SCD31 SCAN THE REST OF THE LIST SKP * SCHEDULE REQUEST WITH WAIT * $MPT4 JSB IDCKK CHECK IF PROGRAM DORMANT LDB XEQT GET THE ADDRESS ADB D20 OF THE BATCH FLAG LDB B,I AND SET IT RBL,SLB,ERB INTO THE RAL,ERA THE NEW PROGRAM IOR B40K SET THE FATHER IS WAITING BIT STA $IDNO,I SET THE WORD IN THE SON'S ID. JSB $LIST PUT CURRENT PGM IN OCT 503 THE WAIT LIST LDB XEQT ADB D15 LDA B,I IOR B10K SET STATUS WAIT REQUEST BIT STA B,I INTO CURRENT EXEC PROGRAM RSS * * SCHEDULE REQUEST WITHOUT WAIT * $MPT5 JSB IDCKK CHECK IF PROGRAM DORMANT LDB $SCD3 GET SAVED A-REG AT SCHED.QUEUED CALL LDA RQP1 AND RESTORE BEFORE RETURN AND B20 ONLY IF QUEUED CALL. SZA STB XA,I * MEM15 LDA RQRTN STA XSUSP,I POINT JMP $XEQ * $MPT8 EQU MEM15 * ESC01 CLB,INB,RSS ILLEGAL PARAMETER COUNT ESC03 LDB D3 RSS ESC04 LDB D4 ESCXX LDA ASY OUTPUT SC ERROR CODE JMP $ERAB CALL SYSTEM ERROR MESSAGE ROUTINE * ESC05 LDB D5 NO SUCH PROG ERROR CODE JMP ESCXX SPC 1 B40K OCT 40000 DM7 DEC -7 SKP * * GETID IS A SUBROUTINE TO GET THE ID-SEGMENT ADDRESS * FROM PRAMETER NUMBER TWO WHERE THE USER MAY * SUPPLY ZERO (HIS ID) OR NOTHING (HIS ID) OR * AN ASCII NAME. * * CALLING SEQUENCE: * * JSB GETID * RETURN B= THE ID-SEGMENT ADDRESS. * IF NOT FOUND THEN ERROR "SC05"IS GENERATED * E=0 * A=0 ON ALL RETURNS * WORK = THE ID-ADDRESS * WSTAT = THE ID-STATUS ADDRESS * GETID NOP CLA IF NOT SUPPLIED PRESET TO ZERO LDB XEQT AND CURRENT PGM ADB D12 SET B TO POINT TO CURRENT NAME LDA RQP2,I GET THE PRAMETER SZA IF ZERO OR NOT SUPPLIED SKIP LDB RQP2 GET ADDRESS OF NAME JSB TNAME GO SEARCH FOR IT CLA,SEZ IF FOUND SKIP JMP ESC05 ELSE FLUSH HIM OUT OF THE SYSTEM * JMP GETID,I RETURN SPC 2 * $IDNO COMPUTES THE ID-SEGMENT NUMBER OF A PROGRAM * *** CALLED BY IDCKK, MTDB, CLASS I/O *** * * CALLING SEQUENCE * LDB ID-SEGMENT ADDRESS * JSB $IDNO * RETURN ID NUMBER IN B * $IDNO NOP STB GETID SAVE THE REQUESTED ID-ADDRESS LDB KEYWD IDNO LDA B,I GET KEYWORD BLOCK ENTRY INB STEP FOR NEXT ONE CPA GETID THIS IT? CMB,INB,RSS YES NEGATE AND SKIP JMP IDNO NO CONTINUE LOOP * ADB KEYWD NEGATIVE OF NUMBER TO B CMB,INB SET POSITIVE AND JMP $IDNO,I RETURN SKP * * SCHEDULE BY TIME * $MPT7 LDA DM7 CHECK PARAM COUNT FOR 7 ADA RQCNT SZA,RSS JMP MPT7A ADA D3 CHECK FOR 4 PARAM SZA JMP ESC01 ERROR IN PARAM COUNT LDA RQP5,I 4 PARAM OK - CHECK FOR INITIAL OFFSET SSA,RSS NEGATIVE JMP ESC02 NOT NEGATIVE PARAM ERROR * MPT7A LDA RQP3,I IF RESOLUTION CODE LDB D6 SZA ZERO OR ADA DM5 GREATER THAN 4 SSA,RSS THEN JMP ESCXX ABORT * JSB GETID GO GET THE ID-SEGMENT ADDRESS TO B LDA RQRTN PUT RETURN STA XSUSP,I ADDRESS IN THE ID SEG. JMP $TIMR GO CONTINUE REQUEST IN TIME ROUTINE SPC 1 * CHECK IF PROGRAM DORMANT AND THEN SCHEDULE * *** CALLED BY $MPT4, $MPT5 *** * IDCKK NOP LDB RQP2 GET ID SEGMENT ADDRESS JSB TNAME SEZ JMP ESC05 NO SUCH PROGRAM ERROR * LDA XA,I SAVE A-REG IN CASE OF QUEUED CALL STA $SCD3 LDB XEQT COMPUTE THE ID NUMBER JSB $IDNO AND STB GETID SAVE IT LDA $WORK ALSO COMPUTE THE ADA D20 FATHER POINTER WORD ADDRESS STA $IDNO AND SAVE IT LDA WSTAT,I CHECK PROGRAM STATUS FOR DORMANT AND S&NP KEEP JUST THE IMPORTANT BITS STA XA,I RETURN PROG STATUS IN A REG SZA DORMANT? JMP IDCK2 NO - CHECK FURTHER * IDCK3 JSB PRAMO PASS THE PRAMETERS IF ANY LDB XEQT INDEX TO WORD 29 OF ADB D28 FATHER'S ID SEG LDA B,I AND B77 GET CONSOLE LU IOR SIGN AND SET NEW-RUN FLAG LDB $WORK ADB D28 STORE INTO WORD 29 OF STA B,I SON'S ID SEG JSB $LIST THEN - SCHEDULE OCT 301 STA XA,I SHOW THAT IT WAS DONE LDA $WORK SET UP THE WAIT POINTER STA XTEMP,I INCASE IT IS A 9 REQUEST LDA $IDNO,I GET THE CURRENT FLAG BITS IOR GETID ADD THE FATHER NUMBER STA $IDNO,I AND RESET IT. JMP IDCKK,I RETURN SPC 1 IDCK2 RAL,ALR IF JUST THE NO PRAMS CMA,CLE,INA SET E LDA $IDNO,I CHECK TO SEE AND B377 IF THIS GUY IS THE FATHER CPA B IF NOT RSS THEN JMP MPT15 GO TEST FOR QUEING * SEZ IF JUST "NP" BIT THEN JMP IDCK3 GO SCHEDULE HIM * LDA WSTAT,I IF "R" AND "D" BITS BOTH SET AND B300 THEN JUST CPA B300 CLEAR THEM ELSE CLB,RSS JMP MPT15 GO CHECK FOR QUEUEING * XOR WSTAT,I CLEAR THE "R" AND "D" BITS STA WSTAT,I AND RESET IN SON'S ID STB XA,I INDICATE SUCESS. JMP MEM15 AND EXIT. * *SCHEDULE WITH WAIT WITH WAIT REQUEST * * IF REQUESTED PROGRAM IS NOT DORMANT THE REQUESTER IS * SUSPENDED UNTIL IT IS. * MPT15 LDA RQP1 HERE AFTER FINDING REQUESTED PGM BUSY CPA D9 IF NO WAIT RSS THEN JUST DO CPA D10 THE OLD JMP MEM15 THING * LDB $WORK ELSE SET THE SUSPEND REASON STB XTEMP,I IN REQUESTERS ID-SEGMENT LDA $IDNO,I TO INDICATE IOR B1000 WE WERE HERE STA $IDNO,I JSB $LIST PUT REQUESTER IN WAIT LIST OCT 503 LDA $SCD3 RESTORE A-REG FOR QUEUED CALL STA XA,I JMP $XEQ GO TRY SOMEBODY ELSE. SPC 2 ASY ASC 1,SC ASCII -SC- FOR SCHED ERROR DEFR3 DEF RQP3,I B10K OCT 10000 S&NP OCT 20017 STATUS PLUS NO PRAMS BIT MASK B300 OCT 300 HED ** SYSTEM BASE PAGE COMMUNICATION AREA ** * * *** SYSTEM BASE PAGE COMMUNICATION AREA *** * . EQU 1650B ESTABLISH ORIGIN OF AREA * * SYSTEM TABLE DEFINITION * * EQTA EQU .+0 FWA OF EQUIPMENT TABLE EQT# EQU .+1 # OF EQT ENTRIES * KEYWD EQU .+7 FWA OF KEYWORD BLOCK * * I/O MODULE/DRIVER COMMUNICATION * EQT1 EQU .+8 ADDRESSES EQT5 EQU 1665B EQT15 EQU .+84 * * SYSTEM REQUEST PROCESSOR /'EXEC' COMMUNICATION * * RQCNT EQU .+22 # OF REQUEST PARAMETERS -1 RQRTN EQU .+23 RETURN POINT ADDRESS RQP1 EQU .+24 ADDRESSES RQP2 EQU .+25 RQP3 EQU .+26 OF REQUEST RQP4 EQU .+27 RQP5 EQU .+28 * * DEFINITION OF SYSTEM LISTS (QUEUES) * * DORMT EQU .+32 ADDRESS OF 'DORMANT' LIST, SKEDD EQU 1711B SUSP2 EQU .+35 'WAIT' LIST, * * DEFINITION OF EXECUTING PROGRAM ID SEGMENT' * * XEQT EQU .+39 ID SEGMENT ADhB@ PROGRAM DESCRIPTION ***** * * THE PRIMARY FUNCTION OF THIS PROGRAM IS * TO PROVIDE GENERAL CHECKING AND EXAMINATION * OF SYSTEM SERVICE REQUESTS AND TO CALL THE * APPROPRIATE PROCESSING ROUTINE IN OTHER * SECTIONS OF THE REAL-TIME EXECi#UTIVE. * * THIS PROGRAM IS CALLED DIRECTLY FROM THE * CENTRAL INTERRUPT CONTROL SECTION * WHEN A MEMORY PROTECT VIOLATION IS ACKNOWLEDGED. * ALL SYSTEM REQUESTS BY A USER PROGRAM CAUSE A * PROTECT VIOLATION. * * SYSTEM REQUEST FORMAT: * ---------------------- * * THE GENERAL FORMAT OF A SYSTEM REQUEST IS * A BLOCK CONTAINING AN EXECUTABLE INSTRUCTION * TO GAIN ENTRY TO THE EXECUTIVE AND AN ADDRESS * LIST OF PARAMETERS. THE FIRST PARAMETER IS * A NUMERIC CODE IDENTIFYING THE REQUEST TYPE. * THE LENGTH OF THE PARAMETER LIST VARIES * ACCORDING TO THE AMOUNT OF INFORMATION RE- * QUIRED FOR EACH REQUEST (OR VARIATIONS WITHIN * A SINGLE REQUEST). THIS FORMAT ALLOWS SYSTEM * REQUESTS TO BE SPECIFIED IN A FORTRAN CALL * STATEMENT IN ADDITION TO ASSEMBLY LANGUAGE FORMAT. * * CALL EXEC (P1,P2,...PN) * * OR * * EXT EXEC * JSB EXEC (CAUSES MEMORY PROTECT VIOLATION) * DEF *+1+N DEFINE EXIT POINT, N= # PARAMETERS * DEF RCODE DEFINE REQUEST CODE * DEF P1 DEFINE PARAMETER LIST, 1 TO N * . * . (PARAMETERS MAY BE INDIRECTLY * . REFERENCED, E.G. DEF P3,I) * DEF PN * - EXIT POINT - * * RCODE DEC N * P1 DEC/OCT/DEF,ETC TO DEFINE A VLAUE * * * RE-ENTRANT LIBRARY REQUEST * -------------------------- * * THE SYSTEM LIBRARY (RESIDENT) CONTAINS * PROGRAMS STRUCTURED IN 'RE-ENTRANT' FORMAT * OR IN 'PRIVILEGED' EXECUTION FORMAT. * * - RE-ENTRANT FORMAT ALLOWS A LIBRARY * PROGRAM TO BE RE-ENTERED BY A CALL FROM * A HIGHER-PRIORITY PROGRAM DURING THE * PROCESSING OF A CALL FROM A LOWER-PRIORITY * PROGRAM. * * - PRIVILEGED EXECUTION FORMAT ALLOWS A * SHORT-RUNNING LIBRARY PROGRAM TO BE EXECUTED * WITH THE INTERRUPT SYSTEM DISABLED. * * * * MEMORY PROTECT ERROR: * --------------------- * * IF THE INSTRUCTION MCAUSING THE PROTECT VIOLATION * IS NOT A JSB EXEC OR A JSB TO LIBRARY * PROGRAM, THEN A USER PROGRAM ERROR IS * ASSUMED. A DIAGNOSTIC IS OUTPUT TO THE SYSTEM * TELETYPE LISTING THE PROGRAM NAME AND ADDRESS * OF VIOLATING INSTRUCTION AND THE PROGRAM IS * SET DORMANT IN THE PROGRAM ABORT PROCEDURE. * SKP ************DMS INSTRUCTIONS***************** EXEC NOP HLT 0 PROTECTION AGAINST DIRECT CALL. * $RQST LIB 5 GET ADDRESS OF VIOLATION. LIA 4 DO NOT REARRANGE!!! CPA D4 POWER FAIL? LDB $PWR5 YES, USE LAST INTERRUPT ADDR. STF 5 REENABLE PARITY ERROR OPTION. STB VADR SAVE VIOLATION ADDRESS. STB XSUSP,I SET AS POINT OF SUSPENSION. STB $LIBR SAVE (P+1) OF ISZ $LIBR CALL. WE ARE IN USER MAP! SPC 1 IFZ ******* BEGIN DMS CODE ******** SFC 5 IF FLAG CLEAR,NOT DMS VIOL JMP DMSER ******* END DMS CODE ********** XIF SPC 1 RBL,CLE,SLB,ERB CHECK FOR PARITY ERROR. HLT 5 HALT IF PARITY ERROR! LDA B,I GET WORD. AND B074K ISOLATE INSTR. CODE. CPA JSBI IF INSTRUCTION IS JSB RSS CHECK OPERAND ADDRESS. JMP MPERR -MEMORY PROTECT ERROR- LDA B,I CHECK FOR EFFECTIVE AND B2000 ADDRESS SZA LINK THRU CURRENT PAGE? LDA VADR YES, USE CURRENT PAGE BITS XOR VADR,I MIRGE THE PAGE OFFSET AND G76 UNDER THE RULES OF WOO. XOR VADR,I NOW HAVE THE ADDRESS RAL,CLE,SLA,ERA IF INDIRECT INDR LDA A,I GET NEXT LEVEL RAL,CLE,SLA,ERA WATCH OUT FOR JTS'S INDIRECTS JMP INDR * CPA EXECA -EXEC-. JMP R0 YES, REQUEST TO BE ANALYSED. CPA LIBRA -LIBRARY ROUTINE CALLING FOR JMP LIBRC RE-ENTRANT OR PRIVILEGED RUN. CPA LIBXA -LIBRARY ROUTINE RETURNING JMP LIBXC TO CALLER.I * * CHECK FOR USER CALL TO LIBRARY PROGRAM * STA B SAVE OPERAND ADDRESS. LDA LBORG SUBTRACT LIBRARY CMA,CLE,INA AREA ORIGIN FROM ADA B OPERAND ADDRESS. LDA B (E = 0 IF SYSTEM VIOLATION ) CMA,SEZ,CLE,INA SKIP IF VIOLATION ALREADY ELSE ADA $SGAF TEST FOR ABOVE LIB. SEZ,RSS IF NOT CALL TO LIBRARY RESIDENT, JMP MPERR THEN VALID MEMORY PROTECT ERROR. LDA $LIBR -CALL TO LIBRARY. STA B,I SET (P+1) ADDRESS IN ENTRY POINT ADB D2 SET (P+1) OF STB $LIBR JSB $LIBR IN -$LIBR-. JMP LIBRC - TRANSFER TO $LIBR SECTION SPC 1 $SGAF NOP SSGA START ADR JSBI JSB 0 B074K OCT 074000 G76 OCT 76000 EXECA DEF EXEC RQP2A DEF RQP2 VADR NOP $PWR5 NOP ADDR OF INTERRUPT BEFORE POWER FAIL DM9 DEC -9 * * ANALYZE SYSTEM REQUEST * R0 LDA $LIBR,I (A) = RETURN ADDRESS OF JSB EXEC. ISZ $LIBR SET $LIBR TO FIRST PRAM. (RQ) ADDRESS. STA RQRTN SAVE IN BASE PAGE LDB $LIBR CACULATE THE NUMBER OF CMB,CLE PARAMETERS IN REQUEST ADB A LESS THE REQUEST CODE. STB RQCNT AND SAVE # OF ACTUAL PARAMETERS. STB A STB CNT CMB,SEZ,CME SKIP IF RETURN IS BAD (< JSB +2) * ADA DM9 CLA,SEZ JMP RQERR ERROR IF >8. * STA RQP2 ZERO STA RQP3 PARAMETER STA RQP4 STA RQP5 ADDRESS STA RQP6 STA RQP7 AREA STA RQP8 STA RQP9 * * * CHECK LEGALITY OF REQUEST CODE * LDA $LIBR GET ADDR OF THE REQ PARAM LDA A,I RAL,CLE,SLA,ERA REMOVE INDIRECTS JMP *-2 LDA A,I GET ACTUAL REQ CODE LDB XEQT COMPUTE ADB D15 THE STATUS WORD STB TEMP3 ADDRESS AND SAVE LDB B,I GET STATUS RAL,CLE,ERA PUT ABORT OPTION BIT RBL,ERB IN SIGN OFܬ STATUS STB TEMP3,I AND RESET IN ID-SEG. SSB IF OPTION SELECTED ISZ RQRTN STEP RETURN ADDRESS. STA RQP1 SAVE THE REQUEST CODE. SZA IF ZERO SKIP TO REJECT ADA CODE# IF RQUEST CODE IF NOT DEFINED SSA,RSS -THEN JMP RQERR TOUGH LUCK, YOU'RE A DEAD DUCK! * ADA RQTBL GET ADDRESS OF PROCESSOR TO A LDA A,I GET ADDRESS SZA,RSS IF NOT LOADED JMP RQERR THEN REQUEST CODE ERROR * STA VADR SAVE THE ADDRESS * * TEST EACH PRAMETER FOR BEING BELOW THE FENCE IF * THE CALL CAUSES A STORE TO THE AREA DEFINED. * LDB RQP1 USE REQUEST CODE CLE,ERB TO INDEX INTO ADB RQTBL THE BY NAME TABLE LDA B,I GET THE FLAG WORD SEZ,RSS IF EVEN REQUEST, ROTATE BITS ALF,ALF TO USE HIGH HALF STA FLAGS * ISZ $LIBR LDA $LIBR GET ADDR OF 2ND PARAM LDB RQP2A GET ADDR OF 2ND BP PARAM MIC1 JMP NOMC2 -LRR- IF HAVE MICROCODE * OCT 105622 MACRO CALL FOR LRR CNT OCT 0 COUNT OF PARAMS LEFT FLAGS OCT 0 BITS FOR PARAM ADDR CHECK DEF FENCE ADDR OF FENCE WORD RSS ERROR RETURN JMP VADR,I SUCCESSFUL RETURN * SZB,RSS JMP ER1 JMP RQERR * NOMC2 STB TEMP2 SAVE BP PTR LDA CNT CMA,INA,SZA,RSS NEGATE COUNT JMP VADR,I DO REQ. IF 0 PARAMS STA CNT * R3 LDA $LIBR GET ADDR OF PARAM ADDR R1D1 LDA A,I GET ACTUAL PARAM ADDR SZA CPA D1 IS IT POINTING TO A OR B REGS? JMP RQERR YES, ERROR. RAL,CLE,SLA,ERA INDIRECT? JMP R1D1 GO GET DIRECT ADDR * STA TEMP2,I SAVE DIRECT ADDR ON BP CMA,CLE READY TO SUBTR FROM FENCE LDB FLAGS SLB,RBR NEED TO TEST AGAINST MP FENCE? ADA FENCE YES, SUBTRACT STB FLAGS SAVE SHIFTED FLAG BITS CLB,SEZ PARAM ADDR < FENCE? JMP ER1 YES, RQ00 ERROR * ISZ $LIBR INCRE TO NEXT USER PARAM ISZ TEMP2 INCRE TO NEXT BP LOC ISZ CNT DONE YET? JMP R3 NO JMP VADR,I YES, DO THE REQUEST * ER1 LDA RQ1 SET A FOR ERROR JMP $ERAB GO SEND 'RQ00' ERROR SPC 1 D1 DEC 1 D2 DEC 2 D15 DEC 15 CODE# ABS TBL-TBLE-1 NEGATIVE OF NUMBER OF REQUEST+1 RQTBL DEF TBLE ADDRESS INDIRECT OF LAST + 1. HED ** SUPERVISORY CONTROL OF LIBRARY PROGRAM EXECUTION ** * * SUPERVISORY CONTROL OF PROGRAM LIBRARY EXECUTION * * ALL LIBRARY PROGRAMS REFERENCED BY USER PROGRAMS * IN THE SYSTEM ARE COMBINED IN A BLOCK OF MEMORY * WHICH IS PROTECTED FROM THE REAL-TIME AREA. THE * LIBRARY AREA IS IMMEDIATELY BELOW THE RT AREA * AND JUST ABOVE THE SYSTEM AREA. * * A USER LIBRARY CALL CAUSES A PROTECT VIOLATION. * THIS SECTION FACILITATES ENTRY INTO THE LIBRARY * PROGRAM BY PERFORMING THE NECESSARY PROCESSING * FOR RE-ENTRANCY OR OPERATING THE PROGRAM WITH H= * THE INTERRUPT SYSTEM TURNED OFF FOR A 'PRIVILEGED' * EXECUTION PROGRAM. * * RE-ENTRANT OR PRIVILEGED PROGRAM FORMAT: * ---------------------------------------- * * ENTRY NOP * JSB $LIBR * DEF TDB (OR 'NOP' IF PRIVILEGED) * - FIRST INSTRUCTION FOR FUNCTION - * - CODE * - TO * - PERFORM * - PROGRAM FUNCTION * EXIT JSB $LIBX * DEF TDB (OR DEF ENTRY IF PRIVILEGED) * DEC N RETURN ADJUSTMENT FOR RE-ENTRANT * - * TDB NOP HOLDS SYSTEM POINTER TO ID-EXTENSION. * DEC N LENGTH OF TEMPORARY DATA BLOCK * NOP RETURN ADDRESS OF CALL. * - BLOCK USED FOR * HOLDING TEMPORARY * VALUES GENERATED * BY THE ROUTINE. * * * < $LIBR> IS ENTERED WHEN A LIBRARY * PRU!OGRAM IS CALLED. IF THE CALLED * PROGRAM IS 'RE-ENTRANT' AND IS CALLED * DURING THE PROCESSING OF A PREVIOUS * CALL, THE TEMPORARY-DATA-BLOCK IS * MOVED INTO A BLOCK IN AVAILABLE MEMORY * BEFORE THE ROUTINE IS ENTERED. * * PVEXC JSB RSTR JMP LIBRX * LIBRA DEF $LIBR * $LIBR NOP DIRECT ENTRY HAS TO BE PRIV. STA XA,I AND GOING DEEPER LDA $LIBR,I MAKE SURE SZA AND IF GOING RENT JMP MPERR SEND SOUTH INSTEAD. * LIBRX LDA XA,I RESTORE AND RETURN ISZ $LIBR SET RIGHT ADDRESS ISZ $PVCN AND STEP THE DEPTH COUNTER JMP $LIBR,I RETURN TO USER * LIBRC LDB $LIBR,I GET (P+2) OF -$LIBR- CALL. SZB,RSS IF (P+2) = 0, THEN CALLED PROGRAM JMP PVEXC IS IN 'PRIVILEGED' FORMAT. * * STB TEMP1 SAVE -TDB- ADDRESS. LDA B,I GET WORD 1 OF DATA BLOCK. LDA A,I GET ID SEG ADDRESS OR ZERO RAL,CLE,ERA REMOVE POSSIBLE SIGN BIT CPA XEQT RECURSIVE ENTRY? JMP ERE01 YES GO ABORT HIM INB STEP TO LENGTH WORD IN TDB SZA IF BLOCK IN USE GET LENGTH LDA B,I ELSE ADA D4 USE JUST FOUR WORDS STA TEMP4 SAVE LENGTH FOR ALLOCATE CALL LDB DHED GET POINTER TO HEAD OF RENT LDA XEQT LIST ADA D20 CHECK IF ALREADY IN LIST STA TEMP3 SAVE ID-SEG POINTER LDA A,I GET THE STATUS WORD ALF,RAL BIT 10 IS RENT BIT SSA,RSS IF CLEAR THEN THIS IS FIRST ENTRY JMP RE2 SO GO SET UP * LDB XEQT NOT FIRST ENTRY SO FIND OTHERS JSB FINDL USING FINDL ROUTINE JMP ERE01 LIST ERROR ABORT THE PGM ADB D3 STEP TO SUB QUE HED RE2 STB TEMP2 SET POINTER TO LIST HEAD * JSB $ALC ALLOCATE THE MEMORY TEMP4 NOP NUMBER OF WORDS REQUIRED JMP NVRM IF NEVER ANY MEMORY, TRY 4 ONLY JMP LB05 NO MEM8ORY NOW, SUSPEND. CCE ALLOC DONE. * CPB TEMP4 DID WE GET THE REQUESTED NUMBER? B40 CLE YES CLEAR E AS A FLAG * SPC 1 IFN ******* BEGIN NON-DMS CODE **** LDB TEMP2,I GET OLD POINTER STA TEMP2,I SET NEW BLOCK ADDRESS STB A,I LINK OLD BLOCKS INTO THE LIST ******* END NON-DMS CODE ****** XIF SPC 1 SPC 1 IFZ ******* BEGIN DMS CODE ******** XLB TEMP2,I GET OLD POINTER XSA TEMP2,I SET NEW BLOCK ADDRESS XSB A,I LINK OLD BLOCKS INTO THE LIST ******* END DMS CODE ********** XIF SPC 1 LDB XEQT GET THE ID-SEG ADDRESS SEZ,INA STEP A AND SKIP IF EXACT ALLOCATION ADB SIGN ELSE ADD SIGN BIT TO ID-ADDRESS SPC 1 IFN ******* BEGIN NON-DMS CODE **** STB A,I SET IN WORD 2 ******* END NON-DMS CODE ****** XIF SPC 1 SPC 1 IFZ ******* BEGIN DMS CODE ******** XSB A,I SET IN WORD 2 ******* END DMS CODE ********** XIF SPC 1 STA TEMP4 SET TDB ADDRESS POINTER INA SET TO WORD 3 ADDRESS LDB TEMP1 SET TDB ADDRESS IN WORD THREE SPC 1 IFN ******* BEGIN NON-DMS CODE **** STB A,I ******* END NON-DMS CODE ****** XIF SPC 1 SPC 1 IFZ ******* BEGIN DMS CODE ******** XSB A,I ******* END DMS CODE ********** XIF SPC 1 INA CLEAR CLB WORD SPC 1 IFN ******* BEGIN NON-DMS CODE **** STB A,I FOUR ******* END NON-DMS CODE ****** XIF SPC 1 SPC 1 IFZ ******* BEGIN DMS CODE ******** XSB A,I FOUR ******* END DMS CODE ********** XIF SPC 1 * LDB TEMP1,I IF BLOCK AVAILABLE THEN SZB,RSS SKIP THE JMP RE4 MOVE * SEZ,INA SET A TO SAVE lBLOCK ADDRESS INA (EXTRA WORD USED IN ID-EXTENSION) LDB TEMP1 DIG THE TDB SIZE OUT CLE,INB OF THE TDB LDB B,I AND SET IN B JSB MTDB MOVE OUT THE TDB RE4 LDA TEMP4 GET THE ADDRESS OF THE ID-SEG. ADDRESS STA TEMP1,I AND SET IN THE TDB LDA TEMP3,I GET THE ID-STATUS WORD IOR B2000 SET THE RENT BIT STA TEMP3,I RESTORE THE WORD LDB TEMP1 (B) = ADDR. OF TDB. ADB D2 SET LDA $LIBR (P+1) ADA DM2 OF ORIGINAL LDA A,I CALL IN STA B,I WORD 3 OF TDB IN PROGRAM. ISZ $LIBR SET TO FIRST INSTR IN LIB. PROG. * LDB $LIBR SET RETURN ADDRESS STB XSUSP,I IN THE ID-SEG. JMP $RENT RETURN TO THE DISPATCHER $PVCN NOP * * REJECT SECTION CAUSED BY NO MEMORY * AVAILABLE FOR -TDB-. CALLING USER PROGRAM * IS SUSPENDED BACK TO POINT OF CALL AND * LINKED INTO MEMORY SUSPENSION LIST. * NVRM LDA D4 NEVER ENOUGH MEMORY, REQUEST 4 NEXT TIME STA XTEMP,I LB5 JSB $LIST SUSPEND OCT 504 PROGRAM JMP $XEQ TRANSFER TO EXECUTE SECTION. * LB05 LDA $LIBR NO MEMORY ON SECOND LEVEL ADA DM2 REENTRANT CALL, GET PROPER RETURN CCB ADDRESS SO THAT WE REMAKE CALL ADB A,I STB XSUSP,I JMP LB5 * * * * $LIBX EXIT PROCESSOR FOR RENT/PRIV LIB ROUTINES * * < $LIBX> IS ENTERED WHEN A LIBRARY * PROGRAM TERMINATES ITS EXECUTION. A * TEMPORARY DATA BLOCK IS MOVED BACK * INTO THE LIBRARY PROGRAM, IF REQUIRED, * BEFORE RETURN TO THE ORIGINAL CALLER. * * LIBXA DEF $LIBX * $LIBX NOP NON MP ENTRY - MUST BE STA XA,I RETURNING FORM PRIV. SUB. LDA $PVCN SUBTRACT ONE FORM THE COUNT CMA,INA WITH OUT AFFECTING CMA,SZA,RSS "E" ($PVCN >0 ) JMP LB10 IF NOT STILL PRIV. JMP * STA $PVCN STILL PRIV. SET THE COUNTER BACK LDA $LIBX,I TRACK DOWN THE RETURN LDA A,I ADDRESS STA $LIBX AND SET IT LDA XA,I RESTORE A AND JMP $LIBX,I RETURN * LB10 STA $PVCN RETURN NON PRIV. SET COUNTER STB XB,I TO ZERO AND FINISH THE REG. SAVE ERA,ALS E SOC O INA STA XEO,I LDA $LIBX,I GET THE LDA A,I RETURN ADDRESS STA XSUSP,I AND SAVE IT IFN SAVXY JMP $RENT (CXA IF MX CPU) XIF IFZ CXA XIF CYB SAVE THE X,Y REGS. DST XI,I IN THE X,Y SAVE AREA JMP $RENT NOW GO SET THE FENCE * * * RE-ENTRANT PROGRAM RETURNING TO USER CALL. * LIBXC LDB $LIBR,I SET -TDB- ADDRESS. STB TEMP1 IN TEMP1. ISZ $LIBR SET TO (P+2) OF CALL TO -$LIBX-. ADB D2 GET LDA B,I RETURN POINT ADJUSTMENT. ADA $LIBR,I ADD TO (P+1) OF LIBRARY CALL STA XSUSP,I AND SET FOR RETURN TO USER. * LDB XEQT GET ID EXTENSION JSB FINDL ADDRESS JMP MPERR NOT FOUND??? JMP LB14 START SEARCH * LB15 SEZ,CCE,RSS FIND NEXT ENTRY ADDRESS ADB D3 STB TEMP5 SAVE POINTER SPC 1 IFN ******* BEGIN NON-DMS CODE **** LDB B,I GET ADDRESS ******* END NON-DMS CODE ****** XIF SPC 1 IFZ ******* BEGIN DMS CODE ******** XLB B,I GET ADDRESS ******* END DMS CODE ********** XIF SPC 1 LB14 STB A GET ADDRESS OF INA ID WORD CPA TEMP1,I THIS ONE?? RSS YES GO DO IT JMP LB15 NO TRY NEXT ONE * STB TEMP2 SAVE BLOCK ADDRESS SPC 1 IFN ******* BEGIN NON-DMS CODE **** LDB B,I RELINK THE BLOCKS STB TEMP5,I ******* END NON-DMS CODE ****** XIF SPC 1 IFZ ******* BEGIN DMS CODE ******** XLB B,I RELINK THE BLOCKS XSB TEMP5,I ******* END DMS CODE ********** XIF SPC 1 JSB RTN4 RETURN THE ID-EXTENSION JMP $RENT TDB = 0, GO TO CHECK RETURN. * SKP * SUBROUTINES: AND USED FOR * SAVING AND RESTORING REGISTERS * IN LIBRARY PROGRAM PROCESSING. * SAVER NOP MIC3 JMP MIC4 OR STA XA,I IF NO MICRO STB XB,I ERA,ALS SOC INA STA XEO,I SPC 1 IFN * BEGIN NON-DMS CODE *************** MX3 JMP SAVER,I RETURN IF NOT MX, CXA IF MX *** END NON-DMS CODE *************** XIF SPC 1 IFZ ***** BEGIN DMS CODE *************** CYB ******* END DMS CODE *************** XIF SPC 1 DST XI,I JMP SAVER,I * MIC4 SVR XA,I XI,I SAVE REGS MICRO CALL JMP SAVER,I RETURN * RSTR NOP MIC5 JMP MIC6 OR LDA XEO,I IF NO MICRO CLO SLA,ELA STF 1 SPC 1 IFN * BEGIN NON-DMS CODE *************** MX4 JMP NMX4 IF NOT MX, DLD IF MX DEF XI,I *** END NON-DMS CODE *************** XIF SPC 1 IFZ ***** BEGIN DMS CODE *************** DLD XI,I ******* END DMS CODE *************** XIF SPC 1 CAX CBY NMX4 LDA XA,I LDB XB,I JMP RSTR,I RETURN * MIC6 RSR XA,I XI,I RESTORE REGS MICRO CALL JMP RSTR,I RETURN * HED RENT SUBROUTINES * MTDB MOVES A TDB TO SYSTEM MEMORY AND UPDATES THE LINKAGES * AS REQUIRED. * * CALLING SEQUENCE: * * TEMP6 = NUMBER OF WORDS REQUIRED (IF ALLOCATION) * TEMP1 = ADDRESS OF TDB TO BE MOVED * A = CORE ADDRESS (FROM $ALC ) * B = NUMBER OF WORDS ALLOCATED (FROM $ALC ) * E = 0 IF MEMORY IS ALREADY ALLOCATED * = 1 IF TEMP6 IS SET AND A AND B ARE NOT. * * THE SECOND WORD OF THE SAVE AREA IS SET TO THE CONTENTS * OF B WHILE THE SECOND WORD OF THE TDB DETERM.INS HOW * MANY WORDS TO MOVE. * * TEMP USAGE IN THIS ROUTINE IS: * AHLD DESTINATION ADDRESS * TEMP6 COUNTER (USED ONLY IFN) * TEMP7 ID-EXTENSION ADDRESS(CONTENTS OF TEMP1,I) * * FORBIDDEN TEMPS FOR MTDB: * TEMP3 USED BY $REIO * TEMP4 USED BY $REIO * MTDB NOP SPC 1 IFN * BEGIN NON-DMS CODE *************** SEZ,RSS IF NO ALLOC OPTION JMP MTDB2 SKIP ALLOC CALL *** END NON-DMS CODE *************** XIF SPC 1 SPC 1 IFZ ******* BEGIN DMS CODE ******** STA AHLD RSA SAVE DMS STATUS RAL,RAL STA MVSTS UJP *+2 SEZ,RSS IF NO ALLOC. OPTION JMP MTDB3 SKIP ALLOC CALL ******* END DMS CODE ********** XIF SPC 1 * JSB $ALC GET THE MEMORY TEMP6 NOP JMP MTDB0 NEVER ANY MEMORY JMP LB5 NO MEMORY NOW, SUSPEND PROG MTDB2 STA AHLD SET UP DEST. PTR * MTDB3 LDA TEMP1,I SAVE THE ID-EXTENSION ADDRESS STA TEMP7 LDA TEMP1 GET THE TDB ADDRESS SPC 1 IFN * BEGIN NON-DMS CODE *************** STA AHLD,I SET TDB ADDR IN SAVE AREA ISZ AHLD STEP TO WORD 2 STB AHLD,I SET ACTUAL COUNT ADB DM2 ADJUST COUNT FOR MOVE STB TEMP6 SET COUNT FOR MVW ADA D2 ADJUST 'FROM' ADDR LDB AHLD GET 'TO' ADDR INB ADJUST 'TO' ADDR JSB .MVW MOVE WORDS TO S.A.M. DEF TEMP6 NOP *** END NON-DMS CODE *************** XIF SPC 1 SPC 1 IFZ ***** BEGIN DMS CODE *************** XSA AHLD,I SET TDB ADDR IN SAVE AREA ISZ AHLD STEP TO WORD 2 XSB AHLD,I SET ACTUAL COUNT ADB DM2 ADJUST COUNT FOR MOVE CBX SET UP FOR MWI ADA D2 ADJUST 'FROM' ADDR LDB AHLD GET THE 'TO' ADDR INB bADJUST 'TO' ADDR MWI MOVE TDB BLOCK TO S.A.M. ******* END DMS CODE *************** XIF SPC 1 CLA DONE NOW, STA TEMP1,I SET THE TDB "FREE" SPC 1 IFN ******* BEGIN NON-DMS CODE **** LDB TEMP7,I GET THE ID-SEGMENT ADDRESS FOR ******* END NON-DMS CODE ****** XIF SPC 1 IFZ ******* BEGIN DMS CODE ******** XLB TEMP7,I GET THE ID-SEGMENT ADDRESS FOR ******* END DMS CODE ********** XIF SPC 1 RBL,CLE,ERB THE OWNING PROGRAM ADB D20 INDEX TO THE STATUS WORD LDA B,I FETCH IT AND SET IOR B4000 THE RENT MEMORY MOVED STA B,I BIT ISZ TEMP7 STEP TO THE TDB POINTER ADDRESS LDA AHLD GET THE NEW LOCATION ADA C100K SUBTRACT 1 AND SET SIGN SPC 1 IFN ******* BEGIN NON-DMS CODE **** STA TEMP7,I AND SET IN THE EXTENSION. JMP MTDB,I RETURN ******* END NON-DMS CODE ****** XIF SPC 1 IFZ ******* BEGIN DMS CODE ******** XSA TEMP7,I AND SET IN THE EXTENSION. MTDBX JRS MVSTS MTDB,I MVSTS BSS 1 ******* END DMS CODE ********** XIF SPC 1 * MTDB0 CLA NEVER ANY MEMORY CLB RETURN (A)=0, (B)=0 SPC 1 IFN ******* BEGIN NON-DMS CODE **** JMP MTDB,I RETURN ******* END NON-DMS CODE ****** XIF SPC 1 IFZ ******* BEGIN DMS CODE ******** JMP MTDBX ******* END DMS CODE ********** XIF SPC 1 AHLD NOP C100K OCT 77777 SPC 2 * FINDL FINDS A ID-EXTENSION GIVEN THE ID-SEGMENT ADDRESS * * CALLING SEQUENCE: * * LDB ID-SEG ADDRESS * JSB FINDL * NOT FOUND RETURN * FOUND RETURN B = ADDRESS OF EXTENSION,TEMP5 = ADDRESS OF * PREVIOUS BLOCK IN THE LIST (FOR UNLINKING). * E = 0. * * TEMP USAGE: * * TEMP5 = LAST POINTER * TEMP6 = ID-SEGMENTDTRN ADDRESS * NT* FINDL NOP STB TEMP6 SAVE THE ID-SEGMENT ADDRESS LDB DHED GET THE HED OF THE LIST ADDRESS FIND1 STB TEMP5 SET LAST POINTER SPC 1 IFN ******* BEGIN NON-DMS CODE **** LDB B,I GET THE ADDR OF EXTENSION ******* END NON-DMS CODE ****** XIF SPC 1 IFZ ******* BEGIN DMS CODE ******** XLB B,I GET THE ADDRESS OF THE EXTENSION ******* END DMS CODE ********** XIF SPC 1 SZB,RSS END OF LIST? JMP FINDL,I YES- MAKE NOT FOUND RETURN LDA B ADDRESS TO A INA STEP TO THE ID-ADDRESS SPC 1 IFN ******* BEGIN NON-DMS CODE **** LDA A,I GET THE ADDRESS ******* END NON-DMS CODE ****** XIF SPC 1 IFZ ******* BEGIN DMS CODE ******** XLA A,I GET THE ADDRESS ******* END DMS CODE ********** XIF SPC 1 RAL,CLE,ERA CLEAR POSSIBLE SIGN BIT CPA TEMP6 THIS IT? CLE,RSS YES RETURN E = 0 JMP FIND1 NO TRY NEXT ENTRY ISZ FINDL STEP TO TRUE RETURN JMP FINDL,I RETURN SPC 3 * RTN4 RETURNS THE FOUR WORD ID-EXTENSION AND CAN CLEAR * THE PROGRAMS RENT BIT * * CALLING SEQUENCE: * * TEMP2 = ADDRESS OF THE FOUR WORD BLOCK * E = 0 IF THE RENT BIT IS TO BE CLEARED. * TEMP1 = ADDRESS OF THE TDB (TO SET FIRST WORD TO ZERO) * JSB RTN4 * * TEMP USAGE: * TEMP2 AS ABOVE * TEMP3 NUMBER OF WORDS TO RETURN * TEMP1 AS ABOVE * RTN4 NOP LDA TEMP2 GET BLOCK ADDRESS INA INDEX TO ID SEG ADDRESS SPC 1 IFN ******* BEGIN NON-DMS CODE **** LDB A,I GET ID-SEG ADDRESS ******* END NON-DMS CODE ****** XIF SPC 1 IFZ ******* BEGIN DMS CODE ******** XLB A,I GET ID-SEG ADDRESS ******* END DMS CODE ********** XIF SPC 1 LDA D4 SET A TO THE REQUESST LENGTH RBL,SLB,ERB IF WE GOT 4 SKIP INA ELSE SET TO 5. STA TEMP3 SET RETURN LENGTH SSB IS RENT BIT CLEAR REQUESTED? JMP RTNA NO SKIP ADB D20 YES INDEX TO THE BIT LDA B,I GET THE WORD XOR B2000 ZAP THE BIT STA B,I RESET THE WORD RTNA CLA CLEAR THE TDB FLAG STA TEMP1,I JSB $RTN RETURN THE MEMORY TEMP2 NOP TEMP3 NOP JMP RTN4,I RETURN SPC 2 DHED DEF *+1 NOP HED OF ID-EXTENSION LIST DM3 DEC -3 DM2 DEC -2 D3 DEC 3 TEMP1 NOP D20 DEC 20 B4000 OCT 4000 B2000 OCT 2000 SIGN DEF 0,I HED $REIO RENT I/O PROCESSOR ROUTINE * $REIO MOVES TO SYSTEM MEMORY THE TDB CONTAINING THE * REFERENCED ADDRESS - IF ANY. THIS ROUTINE IS CALLED * BY RTIOC TO ALLOW I/O FROM A RE-ENTRENT ROUTINE. * * CALLING SEQUENCE * * LDB BUFAD BUFFER ADDRESS IN B. * JSB $REIO * ON RETURN B IS THE NEW BUFFER ADDRESS, E IS SET. * * TEMP USAGE: * * TEMP1 = TDB ADDRESS * TEMP3 = NEG. OF PASSED BUFFER ADDRESS * TEMP4 = NEXT ENTRY POINTER. * TEMP5 = TDB PTR ADDRESS IN ID-EXTENSION * $REIO NOP CMB,INB SET BUFFER ADDRESS NEGATIVE FOR TESTS. STB TEMP3 TEST AND SAVE IT SPC 1 IFZ ***** BEGIN DMS CODE *************** CLB STB $MVBF CLEAR MOVE TO REENT MEM FLAG ******* END DMS CODE *************** XIF SPC 1 LDB XEQT GET THE ID-ADDRESS JSB FINDL AND SO THE ID-EXTENSION JMP REIO2 NOT FOUND - EXIT * REIO1 LDA B SET ADDRESS IN A TOO SZB,RSS IF END OF LIST JMP REIO2 EXIT WITH SAME ADDRESS * SEZ,RSS FIRST POINTER IS ADA D3 + 3 STA TEMP4 REST ARE STANDARD LINK ADB D2 INDEX TO THE TDB ADDRESS STB TEMP5 SAVE THE TDB ADDRESS SPC 1 IFN ******* BE6GIN NON-DMS CODE **** LDA B,I TDB ADDRESS TO A ******* END NON-DMS CODE ****** XIF SPC 1 IFZ ******* BEGIN DMS CODE ******** XLA B,I TDB ADDRESS TO A ******* END DMS CODE ********** XIF SPC 1 RAL,CLE,SLA,ERA CLEAR MOVED FLAG, SKIP IF NOT RSS JMP REIO3 SPC 1 IFN ******* BEGIN NON-DMS CODE **** LDA A,I IF MOVED, GET TRUE TDB ADDR ******* END NON-DMS CODE ****** XIF SPC 1 IFZ ******* BEGIN DMS CODE ******** XLA A,I IF MOVED,GET TRUE TDB ADDRSS ******* END DMS CODE ********** XIF SPC 1 REIO3 STA TEMP1 SAVE FOR MTDB ROUTINE LDB A PUT IN A TOO SO CLE,INA WE CAN INDEX TO LENGTH ADB TEMP3 ADD NEG OF BUFFER ADDRESS SEZ,CLE,RSS E SET =>BELOW TDB SO SKIP ADB A,I ADD TDB LENGTH SPC 1 IFN ******* BEGIN NON-DMS CODE **** LDB TEMP4,I GET NEXT ENTRY TO B ******* END NON-DMS CODE ****** XIF SPC 1 IFZ ******* BEGIN DMS CODE ******** XLB TEMP4,I GET THE NEXT ENTRY TO B ******* END DMS CODE ********** XIF SPC 1 SEZ,CCE,RSS E=0 IF NOT IN THE TDB. JMP REIO1 TRY NEXT TDB HE OWNS. * LDB A,I GET LENGTH OF TDB AND SET STB TEMP6 FOR MTDB SPC 1 IFN ******* BEGIN NON-DMS CODE **** LDA TEMP5,I IF ALREADY MOVED ******* END NON-DMS CODE ****** XIF SPC 1 IFZ ******* BEGIN DMS CODE ******** XLA TEMP5,I IF ALREADY MOVED ******* END DMS CODE ********** XIF SPC 1 LDB TEMP1,I THEN SKIP SZB MOVE AND USE CURRENT POINTER JSB MTDB GO MOVE THE TDB RAL,CLE,ERA CLEAR THE SIGN BIT SPC 1 IFN ******* BEGIN NON-DMS CODE **** LDB A,I OLD TDB ADDR TO B ******* END NON-DMS CODE ****** XIF SPC 1  IFZ ******* BEGIN DMS CODE ******** XLB A,I OLD TDB ADDRESS TO B ******* END DMS CODE ********** XIF SPC 1 CMA,INA NEG. OF NEW ADDRESS TO A SPC 1 IFZ ***** BEGIN DMS CODE *************** STA $MVBF SET MOVED TDB TO SAM FOR RTIOC ******* END DMS CODE *************** XIF SPC 1 ADB A NEG. OF OFFSET TO B REIO2 ADB TEMP3 NEG OF NEW BUFFER ADDRESS TO B CMB,CCE,INB SET POSITIVE AND SET E. JMP $REIO,I RETURN TO CALLER SPC 1 IFZ ***** BEGIN DMS CODE *************** $MVBF NOP MOVED TDB TO SAM FLAG FOR RTIOC ******* END DMS CODE *************** XIF SPC 1 HED RESTORE MOVED TDB'S FOR CURRENT PROGRAM * $RSRE MOVES BACK ANY TDB MOVED OUT BY CONTENDING PROGRAMS * THIS ROUTINE IS CALLED BY THE DISPATCHER WHEN IT IS * ABOUT TO DISPATCH A PROGRAM AND THE RENT MEMORY * MOVED BIT IS SET IN THE PROGRAMS ID-SEGMENT. * * CALLING SEQUENCE: * * SET UP BASE PAGE (XEQT ETC.) * JSB $RSRE * * ON RETURN THE PROGRAM IS READY TO RUN * * IF MEMORY IS NEEDED BUT NOT AVAILABLE THE PROGRAM IS * MEMORY SUSPENDED AND RETURN IS TO $XEQ. * * TEMP USAGE: * * TEMP1 = TDB POINTER * TEMP3 = THE FROM ADDRESS * TEMP6 = # WORDS FOR ALLOCATION * TEMP4 = MOVE COUNTER * TEMP5 = RETURN MEMORY ADDRESS * TEMP9 = RETURN # WORDS * $RSRE NOP SPC 1 IFZ ******* BEGIN DMS CODE ******** RSA SAVE DMS STATUS RAL,RAL STA RESTS UJP *+2 ******* END DMS CODE ********** XIF SPC 1 RSRE1 LDB XEQT GET THE ID-SEGMENT EXTENSION JSB FINDL JMP RSRE3 NOT FOUND GO EXIT * RSRE2 ADB D2 INDEX TO THE TDB ADDRESS SPC 1 IFN ******* BEGIN NON-DMS CODE **** LDA B,I GET TDB ADDR TO A ******* END NON-DMS CODE ****** XIF SPC 1 IFZ ܊ ******* BEGIN DMS CODE ******** XLA B,I GET THE TDB ADDRESS TO A ******* END DMS CODE ********** XIF SPC 1 SSA IF NOT MOVED OUT THEN SKIP JMP RSRE4 ELSE GO MOVE BACK * SEZ,CCE,INB GET ADDRESS OF NEXT BLOCK ADB DM3 TO B SPC 1 IFN ******* BEGIN NON-DMS CODE **** LDB B,I ******* END NON-DMS CODE ****** XIF SPC 1 IFZ ******* BEGIN DMS CODE ******** XLB B,I ******* END DMS CODE ********** XIF SPC 1 SZB IF ZERO THEN DONE JMP RSRE2 ELSE GO TEST NEXT ONE * RSRE3 LDB XEQT GET THE ID-ADDRESS ADB D20 AND REMOVE LDA B,I THE MEMORY XOR B4000 MOVE REQUIRED BIT STA B,I RESET THE WORD SPC 1 IFN ******* BEGIN NON-DMS CODE **** JMP $RSRE,I RETURN ******* END NON-DMS CODE ****** XIF SPC 1 IFZ ******* BEGIN DMS CODE ******** JRS RESTS $RSRE,I RETURN AND RESTORE DMS STATUS ******* END DMS CODE ********** XIF SPC 1 * RSRE4 RAL,CLE,ERA CLEAR THE SIGN BIT AND STA TEMP5 SAVE THE ADDRESS STB TEMP3 SET 'FROM' ADDR SPC 1 IFN ******* BEGIN NON-DMS CODE **** LDB A,I GET TDB ADDR STB TEMP1 SET TDB ADDR INA STEP TO ALLOC'D COUNT LDA A,I ******* END NON-DMS CODE ****** XIF SPC 1 IFZ ******* BEGIN DMS CODE ******** XLB A,I GET THE TDB ADDRESS STB TEMP1 SET IT IN TEMP1 AND INA STEP TO THE WORD COUNT XLA A,I ******* END DMS CODE *************** XIF SPC 1 STA TEMP9 SET WORD COUNT FOR RETURN LDA B,I GET CURRENT OWNER AND INB LDB B,I ACTUAL COUNT STB TEMP6 SET COUNT FOR ALLOC ADB DM2 STB TEMP4 SAVE MOVE COUNT CCE,SZA SKIP IF SUBROU~TINE IS FREE JSB MTDB MOVE OTHER USER TO S.A.M. SPC 1 IFZ ***** BEGIN DMS CODE *************** LDB TEMP4 PUT MOVE COUNT IN X-REG CBX ******* END DMS CODE *************** XIF SPC 1 CCB ADB TEMP3 BACK UP TO ID ADDR IN EXTENSION STB TEMP1,I SET IN TDB TO SHOW OWNER LDB TEMP1 SET UP ID-EXTENSION SPC 1 IFN * BEGIN NON-DMS CODE *************** STB TEMP3,I *** END NON-DMS CODE *************** XIF SPC 1 IFZ ***** BEGIN DMS CODE *************** XSB TEMP3,I ******* END DMS CODE *************** XIF SPC 1 LDA TEMP5 GET ADDR OF MEMORY ADA D2 ADJUST 'FROM' ADDR FOR MOVE ADB D2 ADJUST 'TO' ADDR TOO SPC 1 IFN * BEGIN NON-DMS CODE *************** JSB .MVW MOVE WORDS DEF TEMP4 COUNT NOP ******* END NON-DMS CODE ****** XIF SPC 1 IFZ ******* BEGIN DMS CODE ******** MWF MOVE FROM SYS TO USER ******* END DMS CODE ********** XIF SPC 1 * JSB $RTN RETURN THE MEMORY TEMP5 NOP TEMP9 NOP JMP RSRE1 GO TRY AGAIN SPC 1 IFZ ******* BEGIN DMS CODE ******** RESTS BSS 1 ******* END DMS CODE ********** XIF SPC 1 HED ABORT PROCESSOR FOR PROGRAM ABORTED IN A RENT SUBROUTINE * $ABRE CLEANS UP MEMORY ALLOCATION AND OWNERSHIP FLAGS * FOR A PROGRAM ABORTED (OR TERMINATED) WHILE IN A REENTRENT * SUBROUTINE. * * CALLING SEQUENCE: * * A IS IGNORED IN RTE-M * * LDB ID-SEG ADDRESS * JSB $ABRE * * TEMP USAGE: * * TEMP4 = NEXT ID-SEG EXTENSION * TEMP1 = TDB ADDRESS * TEMP7 = MEMORY ADDRESS * TEMP8 = # WORDS TO RETURN * SAVER = ID-SEGMENT ADDRESS SAVE WHILE RN RELEASE CALLED * $ABRE NOP SPC 1 IFZ ******* BEGIN DMS CODE ******** RSA o GET DMS STATUS RAL,RAL UJP *+2 STA ABSTS SAVE CURRENT DMS STATUS ******* END DMS CODE ********** XIF SPC 1 LDA B ADA D20 ADVANCE TO FATHER PTR LDA A,I ALF,RAL TEST REENTRANT BIT SSA SEARCH ONLY IF NEED TO. JSB FINDL DOES HE HAVE ANY? JMP ABRX NO EXIT * SPC 1 IFN ******* BEGIN NON-DMS CODE **** LDA B,I YES, UNLINK FROM LIST STA TEMP5,I ******* END NON-DMS CODE ****** XIF SPC 1 IFZ ******* BEGIN DMS CODE ******** XLA B,I YES UNLINK FROM LIST XSA TEMP5,I ******* END DMS CODE ********** XIF SPC 1 ABRE1 STB TEMP2 SET ID-EXTENTION ADDRESS CLA,SEZ,RSS COMPUTE ADDRESS LDA D3 OF NEXT ENTRY ADA B IN THE PROGRAMS LIST SPC 1 IFN ******* BEGIN NON-DMS CODE **** LDA A,I AND SAVE ******* END NON-DMS CODE ****** XIF SPC 1 IFZ ******* BEGIN DMS CODE ******** XLA A,I AND SAVE ******* END DMS CODE ********** XIF SPC 1 STA TEMP4 IT * ADB D2 INDEX TO THE TDB ADDRESS SPC 1 IFN ******* BEGIN NON-DMS CODE **** LDA B,I FETCH IT ******* END NON-DMS CODE ****** XIF SPC 1 IFZ ******* BEGIN DMS CODE ******** XLA B,I FETCH IT ******* END DMS CODE ********** XIF SPC 1 RAL,CLE,SLA,ERA CLEAR MOVED BIT, SKIP IF NOT JMP ABRE2 NOT MOVED CONTINUE * STA TEMP1 SET THE TDB ADDRESS FOR CLEAR * IFN ******* BEGIN NON-DMS CODE **** JMP ABRE4 GO RELEASE HEADER ******* END NON-DMS CODE ****** XIF * * EITHER RESIDENT OR TRUE LIB. IFZ ******* BEGIN DMS CODE ******** LDA RSTUS IOR SIGN USA SAVE CURRENT USER MAP LDA $MRMP alSET UP MEM RES MAP USA JSB RTN4 RELEASE 4 WORD EXT LDA RSTUS RESTORE CURRENT USER MAP USA JMP ABRE6 EXIT * RSTUS DEF $MSBF+0 EXTERNAL WITH OFFSET FOR CORRECT ADDRESS * ******* END DMS CODE ******** XIF * * ABRE2 STA TEMP7 SET UP TO RETURN IT INA STEP TO THE LENGTH SPC 1 IFN ******* BEGIN NON-DMS CODE **** LDA A,I GET IT ******* END NON-DMS CODE ****** XIF SPC 1 IFZ ******* BEGIN DMS CODE ******** XLA A,I GET IT ******* END DMS CODE ********** XIF SPC 1 STA TEMP8 SET FOR RETURN CALL JSB $RTN RETURN THE SAVE AREA TEMP7 NOP TEMP8 NOP * ABRE4 JSB RTN4 RETURN THE 4 WORD EXTENSION ABRE6 LDB TEMP4 GET ADDRESS OF NEXT CCE,SZB EXTENSION JMP ABRE1 GO DO IT IF IT EXISTS ABRX EQU * SPC 1 IFN ******* BEGIN NON-DMS CODE **** JMP $ABRE,I RETURN ******* END NON-DMS CODE ****** XIF SPC 1 IFZ ******* BEGIN DMS CODE ******** JRS ABSTS $ABRE,I RETURN,RESET DMS ABSTS BSS 1 ******* END DMS CODE ********** XIF SPC 1 HED EXEC CALL FOR PARTITION STATUS SPC 1 IFZ ******* BEGIN DMS CODE ******** * * CALLING SEQUENCE : JSB EXEC * DEF *+6 RETURN * DEF D25 CODE=25 * DEF PART# PARTITION NUMBER * DEF PAGE# RETURNED STARTING PAGE # * DEF #PGS RETURNED NUMBER OF PAGES * DEF PSTA RETURNED PARTITION STATUS * BIT15 = BG/RT 0/1 * BIT14 = FREE FOR ALL/RESERVED 0/1 * BIT 0-7 OCCUPANT ID SEG NUMB * * #PGS = -1 ON RETURN IF PARTITION NUMBER IS ERRONEOUS * $PTST CLA CLEAR OUT USER'S RETURN WORDS STA RQP3,I STA RQP4,I STA RQP5,I LDA RQP2,I (A) = PTTN# CMA,INA SSA,RSS JMP PT.ER ERROR IF <= 0 * CCB ADB $MATA SET # PARTITION ADA B,I FROM $MATA-1 SSA PARTITION# > COUNT? JMP PT.ER YES,ERROR * CCA ADA RQP2,I MPY D6 (PART#-1)*6 IS ADA $MATA THE ADDR OF THE ENTRY LDB A,I IS PARTITION DEFINED ? SSB JMP PT.ER NO - PRINT ERROR * ADA D2 STA RQP6 SAVE ADDR OF ENTRY'S LDB A,I THIRD WORD SZB JSB $IDNO STB RQP7 SAVE ID SEG # IN TEMP * ISZ RQP6 BUMP ADDR IN ENTRY LDA RQP6,I GET FOURTH WORD AND B1777 START PAGE IN BITS 0-9 STA RQP3,I RETURN PARTITION START PAGE * ISZ RQP6 BUMP ADDR IN ENTRY LDA RQP6,I GET FIFTH WORD CLE,ELA PUT RESERVED FLAG IN (E) RAR AND B1777 #PAGES IN BITS 0-9 STA RQP4,I RETURN #PAGES LDA RQP7 FETCH ID SEG ADDR RAL,RAL ERA PUT INTO BIT14 WITH ID SEG ADDR ISZ RQP6 BUMP ADDR LDB RQP6,I GET LAST WORD CLE,ELB PUT RT FLAG IN (E) ERA PUT INTO BIT15 WITH ID SEG STA RQP5,I RETURN ID SEG ADDR,ETC * PT.RT LDA RQRTN STA XSUSP,I SET RETURN ADDRESS JMP $XEQ RETURN TO PROGRAM * PT.ER CCA STA RQP4,I RETURN -1 FOR ERROR JMP PT.RT * D6 DEC 6 B1777 OCT 1777 ******* END DMS CODE ********** XIF SPC 1 HED * EXEC - ERROR MESSAGE SECTION * * * ERROR SECTION * * THE FOLLOWING DIAGNOSTICS ARE OUTPUT ON THE * SYSTEM TELETYPEWRITER ON DETECTION OF: * * 1) VALID MEMORY PROTECT VIOLATION (I.E THE * INSTRUCTION CAUSING THE VIOLATION IS * NOT JSB EXEC. * * MP -PNAME- -PADDR- * * 2) REQUEST CODE UNDEFINED OR ILLEGAL * NUMBER OF PARAMETERS * * RQ -PNAME- -PADDR- * * THE ROUTINE -$ERMG- IS USED TO FORMAT * THE DIAGNOSTIC AND CALL FOR ITS OUTPUT. * * ERE01 LDA RE (A) = 'RE' RSS MPERR LDA MP (A) = 'MP' RSS SPC 1 IFZ ******* BEGIN DMS CODE ******** DMSER LDA DM (A) = 'DM' RSS ******* END DMS CODE ********** XIF SPC 1 * RQERR LDA RQ1 (A) 'RQ' LDB BLANK (B) = BLANKS JSB $ERMG JMP $XEQ * AS00 ASC 1,00 MP ASC 1,MP RQ1 ASC 1,RQ RE ASC 1,RE SPC 1 IFZ ******* BEGIN DMS CODE ******** DM ASC 1,DM DYNAMIC MAPPING SYSTEM ******* END DMS CODE ********** XIF SPC 1 * $ERAB ADB AS00 ADD ASC "00" JSB $ERMG PRINT ERROR DIAG.,ABORT PROG JMP $XEQ -EXIT- SPC 3 * SUBROUTINE: <$ERMG> * * PURPOSE: THIS ROUTINE FORMATS A DIAGNOSTIC * MESSAGE WHICH CONTAINS A FOUR * CHARACTER MNEMONIC DESCRIBING THE * ERROR WITH THE PROGRAM NAME AND * LOCATION OF THE ERROR. IT THEN * CALLS THE ROUTINE <$SYMG> TO * OUTPUT THE MESSAGE. * * CALL: (A),(B) CONTAIN A 4 ASCII CHARACTER * MNEMONIC OR CODE DESCRIBING THE ERROR * * (P) JSB $ERMG * (P+1) - RETURN - (REGISTERS MEANINGLESS) SPC 2 * $ERMG JMP $I.EX DO INIT STUFF (A) HAS RN ADDR * STA MSG+1 SET ERROR MNEMONIC IN STB MSG+2 FIRST 4 CHARACTERS OF MESSAGE. * LDB XEQT SET (B) = ADDRESS OF POINT OF ADB D8 SUSPENTION IN ID-SEG. STB $SDSK AND SAVE FOR ABORT OPTION ADB D4 SET (B) = ADDRESS OF 3-WORD NAME LDA B,I AND SET STA MSG+4 PROGRAM INB NAME LDA B,I IN STA MSG+5 MESSAGE. CLE,INB (E=0 FOR ASCII CONVERSION) LDA B,I AND C377 IOR B40 STA MSG+6 m INB GET THE STATUS LDA B,I WORD AND IF RAL,CLE,SLA,ERA ABORT OPTIN IN EFFECT JMP NOABT GO SET IT UP. * ERM LDA XSUSP,I GET LOCATION OF ERROR JSB $CVT3 CONVERT TO OCTAL/ASCII FORMAT LDB A,I MAKE STB MSG+7 5-DIGIT MEMORY ADDRESS. INA SET DLD A,I GET THE OTHER TWO WORDS DST MSG+8 AND SET IN THE MESSAGE * LDA MSGA CALL TO JSB $SYMG OUTPUT DIAGNOSTIC. * LDA XEQT NOW GO JSB $ABRT ABORT THE PROGRAM * JMP $ERMG,I D4 DEC 4 D8 DEC 8 C377 OCT 177400 $SDSK NOP * NOABT ADB DM6 SET A,B ADDRESS STB DSTAD SET DOUBLE STORE ADDRESS DLD MSG+1 GET THE ERROR CODE DST DSTAD,I SET A,B TO THE ERROR CODE DSTAD EQU *-1 DOUBLE STORE ADDRESS * CCA,CLE USE THE RETURN ADDR - 1 FOR CPB BLANK (BUT IF "MP","RQ", OR "RE" JMP ERM ABORT ANYWAY) ADA RQRTN STA $SDSK,I THE RETURN ADDRESS TO THE PGM. JSB $LIST OCT 501 JMP $ERMG,I RETURN * DM6 DEC -6 * * MSGA DEF *+1 * MSG DEC -18 ASC 2, BLANK ASC 7, SPC 2 EXT $MIC $I.EX EQU * SYSTEM INITIALIZATION CODE SPC 1 IFN * BEGIN NON-DMS CODE *************** LIB 6 (A) STILL HAS RN ADDR SZB,RSS WHAT KIND OF CPU? JMP NMX NOT MX OR XE. LDB .CXA IT IS MX OR XE STB MX3 LDB .DLD STB MX4 *** END NON-DMS CODE *************** XIF SPC 1 * NMX LDB $MIC SZB,RSS IS THERE MICROCODE? JMP NMC0 =0, NO MICRO LDB .LRR #0, YES, MICRO STB MIC1 JMP $CGRN DONE (A)=RN ADDR FOR $CGRN NMC0 LDB SAXAI NO MICRO STB MIC3 LDB LAEOI STB MIC5 JMP $CGRN DONE (A)=RN ADDR FOR $CGRN * SPC 1 IFN V* BEGIN NON-DMS CODE *************** .DLD DLD 0 .CXA CXA *** END NON-DMS CODE *************** XIF SPC 1 .LRR OCT 105622 SAXAI STA XA,I LAEOI LDA XEO,I * HED * EXEC -- REQUEST CODE TABLE * *** REQUEST CODE TABLE *** * * THIS DEFINES THE RELATION FOR SYSTEM * REQUEST CODES AND CORRESPONDING PROCESSORS. * THE TABLE CONSISTS OF ONE-WORD ENTRIES IN * NUMERIC ORDER CORRESPONDING TO THE DEFINED * SYSTEM REQUEST CODES. THE CONTENTS OF EACH * ENTRY IS THE BASE PAGE LINKAGE ADDRESS OF * THE WORD CONTAINING THE ENTRY POINT ADDRESS * * OF THE PROCESSOR. AN -EXT- MUST BE USED * WITH THE -DEF- IN DEFINING THE TABLE. * * THE WORD LABELED -CODE#- CONTAINS THE NEGATIVE OF * ONE + THE TOTAL # OF REQUEST CODES. * EXT $IORQ TBL DEF $IORQ CODE 1 I/O READ DEF $IORQ CODE 2 I/O WRITE DEF $IORQ CODE 3 I/O CONTROL * DEF RQERR CODE 4 DISC TRACK ALLOCATION DEF RQERR CODE 5 DISC TRACK RELEASE * EXT $MPT1 DEF $MPT1 CODE 6 PROGRAM COMPLETION * EXT $MPT2 DEF $MPT2 CODE 7 OPERATOR SUSPENSION * DEF RQERR CODE 8 LOAD PROGRAM SEG$MNT * EXT $MPT4 DEF $MPT4 CODE 9 SCHEDULE WITH WAIT * EXT $MPT5 DEF $MPT5 CODE 10 SCHEDULE PROGRAM * EXT $MPT6 DEF $MPT6 CODE 11 REAL TIME/DATE * EXT $MPT7 DEF $MPT7 CODE 12 TIME SCHEDULE * DEF $IORQ CODE 13 I/O DEVICE STATUS * DEF RQERR CODE 14 NO SUCH CALL * DEF RQERR CODE 15 GLOBAL TRACK ASSIGNMENT DEF RQERR CODE 16 GLOBAL TRACK RELEASE * DEF $IORQ CODE 17 READ CLASS I/O DEF $IORQ CODE 18 WRITE CLASS I/O DEF $IORQ CODE 19 CONTROL CLASS I/O DEF $IORQ CODE 20 WRITE-READ CLASS I/O * EXT $G.CL DEF $G.CL CODE 21 GET CLASS I/O * EXT $MPT8 DEF $MPT8 CODE 22 SWAP/CORE USAGE REQUEST * DEF $MIPT4 CODE 23 SCHEDULE WITH WAIT/WAIT * DEF $MPT5 CODE 24 SCHEDULE NO WAIT/WAIT SPC 1 IFN ******* BEGIN NON-DMS CODE **** DEF RQERR ******* END NON-DMS CODE ****** XIF SPC 1 IFZ ******* BEGIN DMS CODE ******** DEF $PTST CODE 25 PARTITION STATUS ******* END DMS CODE ********** XIF SPC 1 * * * * DEFINE END OF TABLE AND # ENTRIES IN TABLE. * -ADDITIONAL REQUESTS MAY BE INSERTED * AT THIS POINT. * TBLE EQU * * * THE NAMTB WHICH FOLLOWS CONTAINS A BIT FOR EACH PRAMETER * IN AN EXEC CALL WHICH SHOULD BE CALLED BY NAME...THAT IS * THE SYSTEM WILL NORMALLY STORE INTO THE LOCATION DEFINED * BY THE PRAMETER. THIS TABLE IS USED TO CHECK SUCH * PRAMETERS TO SEE IF THEY ARE ABOVE THE CURRENT * FENCE ADDRESS. * * 8 BITS ARE DEVOTED TO EACH CALL. THE LEAST BIT REFERS * TO PRAMETER NUMBER TWO AND SO ON. * THE 'L' AND 'H' NUMBERS ARE SET UP TO REFER TO EACH * PRAMETER BY NUMBER WHERE L REFERS TO THE LOW OR ODD * CALL FOR EACH WORD AND H REFERS TO THE HIGH OR EVEN CALL. * H = HIGH(EVEN CALL) * L = LOW(ODD CALL) * NAMTB ABS L3 0/1 (READ BUFFER) ABS 0 2/3 ABS H3+H4+H5 4/5 (ALLOCATE PRAMS) ABS 0 6/7 ABS 0 8/9 ABS L2+L3 10/11 (TIME VALUES) ABS L3+L4+L5 12/13 (STAT RETURN) ABS L3+L4+L5 14/15 (GLOBAL ALLOCATE PRAMETERS) ABS L7 16/17 (CLASSWORD FOR 17,18,20) ABS H7+L4 18/19 (CLASSWORD) ABS H7+L3+L5+L6+L7 20/21 (CLASSWORD,BUFFER,AND OPT PRAMS) ABS 0 22/23 ABS L3+L4+L5 24/25 SPC 2 L2 EQU 1 L3 EQU 2 L4 EQU 4 L5 EQU 10B L6 EQU 20B L7 EQU 40B L8 EQU 100B H2 EQU 400B H3 EQU 1000B H4 EQU 2000B H5 EQU 4000B H6 EQU 10000B H7 EQU 20000B H8 EQU 40000B HED * * SYSTEM BASE PAGE COMMUNICATION AREA * * \TRNXI EQU 1647B . EQU 1650B ESTABLISH ORIGIN OF AREA * * SYSTEM TABLE DEFINITION * * * * SYSTEM REQUEST PROCESSOR /'EXEC' COMMUNICATION * * RQCNT EQU .+22 # OF REQUEST PARAMETERS -1 RQRTN EQU .+23 RETURN POINT ADDRESS RQP1 EQU .+24 ADDRESSES RQP2 EQU .+25 RQP3 EQU .+26 OF REQUEST RQP4 EQU .+27 RQP5 EQU .+28 PARAMETERS RQP6 EQU .+29 RQP7 EQU .+30 (SET FOR MAXIMUM OF RQP8 EQU .+31 9 PARAMETERS) RQP9 EQU .+32 * * DEFINITION OF SYSTEM LISTS (QUEUES) * * SKEDD EQU .+33 'SCHEDULE' LIST, SUSP3 EQU .+36 'AVAILABLE MEMORY' LIST, SUSP4 EQU .+37 'DISC ALLOCATION' LIST, SUSP5 EQU .+38 'OPERATOR SUSPEND' LIST * * DEFINITION OF EXECUTING PROGRAM ID SEGMENT' * * XEQT EQU .+39 ID SEGMENT ADDR. OF CURRENT PROG. XTEMP EQU .+41 'TEMPORARY (5-WORDS) XSUSP EQU .+48 'POINT OF SUSPENSION' XA EQU .+49 'A REGISTER' AT SUSPENSION XB EQU .+50 'B REGISTER' XEO EQU .+51 'E AND OVERFLOW * * SYSTEM MODULE COMMUNICATION FLAGS * * * * DEFINITION OF MEMORY ALLOCATION BASES * * LBORG EQU .+61 FWA OF RESIDENT LIBRARY AREA RTORG EQU .+62 FWA OF REAL-TIME AREA * * UTILITY PARAMETERS * FENCE EQU .+85 MEM PROTECT FENCE ADDRESS * ORG * PROGRAM LENGTH END EXEC iT m! 92064-18008 1808 S C0622 &MIO00 MII,III RTIOC             H0106 AASMB,R *USE 'ASMB,R,N' (RTE-M II) OR 'ASMB,R,Z' (RTE-M III) * * IFN OPTION * NAME: $MIO2 * SOURCE: 92064-18008 * RELOC: PART OF 92064-16002 * PROGMR: E.J.W. BASED ON RTE-III VERSIONS G.A.A.,L.W.A.,D.L.S. * * IFZ OPTION * NAME : $MIO3 * SOURCE: 92064-18008 * RELOC: PART OF 92064-16003 * PROGMR: E.J.W. BASED ON RTE-III VERSIONS G.A.A.,L.W.A.,D.L.S. * * **************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT * * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * **************************************************************** * * IFN * BEGIN NON-DMS CODE *************** NAM $MIO2 92064-16002 REV.1808 771028 *** END NON-DMS CODE *************** XIF IFZ ***** BEGIN DMS CODE *************** NAM $MIO3 92064-16003 REV.1808 771028 ******* END DMS CODE *************** XIF * * * * ENT $CIC,$XSIO,$SYMG,$IORQ,$IOUP,$IODN ENT $ETEQ,$IRT,$XCIC,$DEVT,$EQCK ENT $UPIO,$CVEQ,$YCIC ENT $BLLO,$BLUP,$OPSY ENT $CLCH,$DLFL ENT $BITB,$DMEQ,$UNLK,$XXUP,$DLAY,$CKLO SPC 1 IFZ ***** BEGIN DMS CODE ************** ENT $DVM,$RSM,$MEU EXT $MRMP,$MVBF,$SMAP,$MATA ******* END DMS CODE ************** XIF SPC 1 * EXT $RQST,$CLCK,$XEQ,$TYPE,$LIST,$ALC,$RTN EXT $SCD3,$RNTB,$ERMG EXT $CVT1,$REIO,$ABRT,$INER,$ZZZZ EXT $ERAB,$CVT3,$QCHK,$MIC SPC 1 IFN * BEGIN NON-DMS CODE *************** EXT .MVW *** END NON-DMS CODE *************** XIF SPC 1 EXT $S.CL,$I.CL,$C.CL * MIC SVR,105360B,2 SAVE REGISTERS MIC RSR,105361B,2 RESTORE REGISTERS MIC STR,105363B,1 SEQUENTIAL STORE VALUE MIC INT,105364B,1 INTERRUPT TABLE SEARCH MIC LNK,105365B,2 I/O REQUEST LINK * * ORB $BLLO DEC -100 $BLUP DEC -300 ORR SPC 1 * * MODULE OF THE R E A L - T I M E E X E C U T I V E * * * THIS INCLUDES THE FOLLOWING MAJOR SECTIONS: * * 1) CENTRAL INTERRUPT CONTROL * * 2) INPUT / OUTPUT CONTROL * - I/O REQUEST PROCESSING * - I/O COMPLETION PROCESSING * - GENERAL I/O ERROR PROCESSING * * 3) SYSTEM ERROR DIAGNOSTIC PRINT ROUITNE * * 4) PROCESSOR FOR OPERATOR I/O STATEMENTS * HED < CENTRAL INTERRUPT CONTROL > * *** C E N T R A L I N T E R R U P T C O N T R O L *** * * THE PROCESSING OF SYSTEM INTERRUPTS IS CONTROLLED * BY DIRECTING ALL SOURCES TO THE ENTRY POINT < $CIC>. * < $CIC> IS RESPONSIBLE FOR SAVING AND RESTORING * THE CURRENT STATE OF THE MACHINE, ANALYSING THE * SOURCE OF THE INTERRUPT, AND ACTIVATING THE * APPROPRIATE PROCESSOR. THIS ROUTINE IS TABLE-DRIVEN * BY THE *INTERRUPT TABLE*. * * SPECIAL PROCESSING FOR A "PRIVILEGED" CLASS OF * INTERRUPTS IS PROVIDED BY $CIC. THIS IS DESCRIBED * FULLY IN SECTION III BELOW. BRIEFLY, A SPECIAL * I/O CARD CAN BE USED TO SEPARATE SPECIAL INTERRUPTS * FROM NORMAL SYSTEM CONTROLLED INTERRUPTS. THE * PRESENCE AND LOCATION OF THE SPECIAL CARD IS * NOTED AT SYSTEM CONFIGURATION TIME. IF IT IS * PRESENT, THE EXEC OPERATIONS ARE NOT PERFORMED * WITH THE INTERRUPT SYSTEM DISABLED BUT RATHER * WITH THE CONTROL SET ON THE SPECIAL CARD TO * HOLD OFF SYSTEM I/O INTERRUPTS. * * I. INTERRUPT TABLE (INTBL) * * A TABLE, ORDERED BY HARDWARE INTERRUPT PRIORITY, * DESIGNATES THE ASSOCIATED SOFTWARE PROCESSOR AND * THE PROCEDURE FOR INITIATING THE PROCESSOR. THIS * TABLE IS CONSTRUCTED BY *RTGEN* ON INFORMATION * SUPPLIED BY THE USER IN CONFIGURING THE SYSTEM. * THE TABLE CONSISTS OF ONE ENTRY PER INTERRUPT * SOURCE: EACH ENTRY CONTAINS ONLY ONE WORD. THE * CONTENTS OF EACH VALID ENTRY IS THE IDENTIFIER * OF THE PROCESSOR. SYSTEM PROCESSORS ARE NOTED * BY POSITIVE VALUES, USER PROCESSORS BY NEGATIVE * VALUES: * * 1. SYSTEM - THE IDENTIFIER IS THE ADDRESS OF * THE EQT ENTRY IDENTIFYING THE I/O DEVICE. * * 2. USER - THE ADDRESS OF THE PROGRAM * IDENTIFICATION SEGMENT IS IN 2-S COMPLEMENT * FORM IN THE ENTRY. * * 3. ILLEGAL - AN ENTRY CORRESPONDING TO AN * ILLEGAL INTERRUPT SOURCE CONTAINS ZERO. * * A PROCESSOR IS CALLED DIRECTLY IF IT RESPONDS * TO STANDARD SYSTEM INTERRUPT (E.G., $CLCK, * MEMORY PROTECT, I/O DEVICE CONTROLLED BY A * SYSTEM DRIVER) OR IS SCHEDULED IN THE NORMAL * PRIORITY ORDER IF IT RESPONDS TO A USER * CONTROLLED DEVICE OR INTERRUPT SOURCE. SKP * II. INTERRUPT PROCESSING * * INTERRUPT ACKNOWLEDGEMENT BY THE CPU CAUSES * THE INSTRUCTION IN THE WORD CORRESPONDING * TO THE I/O CHANNEL ADDRESS TO BE EXECUTED. * FOR ALL ACTIVE I/O CHANNELS ( PLUS LOCATIONS * 5-7 ) CONTROLLED BY THE SYSTEM, THE INSTRUCTION * SET IN EACH INTERRUPT LOCATION IS A JUMP * SUBROUTINE INDIRECTLY TO < $CIC>. * SKP * <$CIC> PERFORMS THE FOLLOWING: * * 1. DISABLES THE INTERRUPT SYSTEM. * * 2. SAVES ALL REGISTERS PLUS THE INTERRUPT * RETURN POINT IN THE EXECUTING * ID SEGMENT. * * 3. CLEARS THE FLAG OF THE INTERRUPT SOURCE. * * 4. SETS 'MPTFL' = 1 TO MEAN MEMORY PROTECT * IS OFF - FLAG FOR PRIVILEGED PROCESSORS. * * 5. CHECKS FOR SPECIAL INTERRUPT PROCESSING. * IF 'DUMMY' IN BASE PAGE COMMUNICATION * AREA = 0, THEN LEAVE THE INTERRUPT SYSTEM * DISABLED AND GO TO STEP 6. * * 'DUMMY' > 0 - PRIVILEGED INTERRUPTS: * -THE CONTENTS OF 'DUMMY' IS THE I/O * ADDRESS OF THE CARD; THIS IS USED TO * SET THE CONTROL FF ON THE CARD (FLAG * IS ALREADY SET) TO HOLD OFF LOWER * PRIORITY INTERRUPTS (SYSTEM INTERRUPTS) * -CLEARS THE CONTROL FLIP-FLOP OF * EACH DMA CHANNEL TO PROHIBIT POSSIBLE * INTERRUPTS FROM OCCURRING. * -ENABLE THE INTERRUPT SYSTEM. * * 6. TRANSFERS DIRECTLY TO THE INTERRUPT * PROCESSOR FOR SOURCES OF: * * 5 - MEMORY PROTECT VIOLATION * (TBG) - TIME BASE GENERATOR * * FOR OTHER SOURCES, THE INTERRUPT SOURCE * CODE IS USED TO INDEX THE INTERRUPT TABLE. * THE CONTENTS OF THE INTBL ENTRY DETERMINES * THE MANNER IN INITIATING THE PROCESSOR: * * A. +, THE CONTENTS OF THE ENTRY IS * ASSUMED TO BE THE FWA OF AN EQT ENTRY. * THE ADDRESSES OF THE 15-WORD ENTRY * ARE SET IN AND CONTROL * TRANSFERRED DIRECTLY TO THE COMPLETION * SECTION ADDRESS (WORD 3 OF EQT ENTRY). * * B. -, THE VALUE IS SET POSITIVE AND IS * SET IN A CALL TO <$LIST> IN THE * SCHEDULING MODULE- THE CALL IS MADE IF * THE USER PROGRAM IS DORMANT- CONTROL IS * TRANSFERRED TO $XEQ. IF THE PROGRAM IS * NOT DORMANT, IT IS NOT SCHEDULED AND THE * DIAGNOSTIC "SC03 INT XXXXX" IS OUTPUT * TO THE SYSTEM TTY- XXXXX IS THE PROGRAM * NAME. CONTROL IS RETURNED TO THE INTER- * RUPTED SEQUENCE. * * C. 0, ILLEGAL OR UNDEFINED INTERRUPTS ARE * NOT PROCESSED BUT THE DIAGNOSTIC * "ILL INT XX" IS OUTPUT TO THE SYSTEM * TTY. XX IS THE INTERRUPT CODE. * * 7. I/O DRIVER RETURNS INDICATE CONTINUATION * OR COMPLETION OF THE OPERATION BY THE * DRIVER OR DEVICE: * * A. RETURN AT (P+1): COMPLETION OF THE * OPERATION. $CIC TRANS- * FERS DIRECTLY TO THE *  IOC COMPLETION SECTION * AT < IOCOM >. CONTROL * IS NOT RETURNED TO * < $CIC>. * * B. RETURN AT (P+2): CONTINUATION OF THE * OPERATION. $CIC RETURNS * TO THE INTERRUPTED * SEQUENCE AS DESCRIBED * IN STEP 8 FOLLOWING. * * 8. RESTORING INTERRUPT CONDITIONS AND RETURN * TO POINT OF INTERRUPTION. AN ENTRY POINT * CALLED '$IRT' IS PROVIDED FOR USE BY * OTHER MODULES OF THE R/T EXEC TO RESET * FLAGS AND THE DMA CHANNELS AND RETURN TO * THE USER PROGRAM. * * THE CALLING SEQUENCE IS JUST: * * - JMP $IRT - * * $IRT PERFORMS THE FOLLOWING: * 1 - DISABLES THE INTERRUPT SYSTEM * 2 - SETS 'MPTFL' = 0 TO MEAN THAT MEMORY * PROTECT IS ON (ENABLED). * 3 - SKIP TO 6 IF NOT A PRIVILEGED SYSTEM * 4 - ISSUES A CLC TO CLEAR THE CONTROL * FF ON THE SPECIAL CARD. * 5 - SETS THE CONTROL FF ON EITHER DMA * CHANNEL IF BIT 15 OF THE INTBL WORD * =1 TO MEAN IT IS ACTIVE. THIS * ENABLES DMA INTERRUPTS ONLY. * 6 - RESTORES THE REGISTERS AND * 7 - EXECUTES THE CURRENT PROGRAM AT XSUSP. * * * SKP * III. SPECIAL (PRIVILEGED) INTERRUPTS * * THIS PROVISION ALLOWS INTERRUPTS FROM SPECIAL * DEVICES TO BE RECOGNIZED WITHIN 100 MICRO SECONDS * AND TO BE PROCESSED BY SPECIAL, COMPLETELY * INDEPENDENT ROUTINES CLASSIFIED AS SYSTEM TYPE * PROGRAMS. INTERRUPTS ARE CHANNELED DIRECTLY * TO THE ENTRY POINT OF A ROUTINE BY A JSB INDIRECT * IN THE CORRESPONDING CORE LOCATION. $CIC IS * NOT AWARE OF THESE SPECIAL INTERRUPTS OCCURRING; * IT ONLY ALLOWS THE INTERRUPT SYSTEM TO BE * ENA=lBLED AND A SOFTWARE FLAG SET TO INDICATE * THE STATUS OF MEMORY PROTECT. THE JSB TO THE * ENTRY POINT FOR A ROUTINE IS SET BY USING THE * "ENT,XXXXX" STATEMENT IN RTGEN WHEN CONFIGURING * A REAL-TIME SYSTEM. * THE SPECIAL PROCESSING ROUTINES CANNOT USE * ANY FEATURES OR REQUESTS OF THE STANDARD * R/T EXEC. THESE ARE INDEPENDENT ROUTINES. * COMMUNICATION BETWEEN A NORMAL PROGRAM UNDER * THE CONTROL OF THE R/T EXEC AND A SPECIAL * INTERRUPT PROCESSOR CAN BE DONE THROUGH * THE APPROPRIATE COMMON REGION: I.E. FLAGS OR * INDICATORS CAN BE SET IN PRE-DEFINED WORDS * IN COMMON TO INITIATE PROCESSING. THE NORMAL * USER PROGRAM CAN BE SCHEDULED TO RUN AT A * PERIODIC TIME INTERVAL TO SCAN THE INDICATORS. * THIS FACILITY IS PROVIDED TO ACCOMODATE HIGH- * SPEED PROGRAM CONTROLED DATA TRANSMISSION * WHICH REQUIRES QUICK RESPONSE. * THE SPECIAL INTERRUPT PROCESSORS ARE * RESPONSIBLE FOR SAVING AND RESTORING ALL * REGISTERS USED AND FOR RESTORING MEMORY * PROTECT TO ITS STATE BEFORE THE SPECIAL * INTERRUPT OCCURRED. MEMORY PROTECT IS * AUTOMATICALLY DISABLED AT THE OCCURRENCE * OF ANY INTERRUPT. THE WORD 'MPTFL' IN THE * BASE PAGE COMMUNICATION AREA IS SET BY THE * R/T EXEC TO INDICATE THE STATUS OF THE * MEMORY PROTECT: * * 'MPTFL' = 0 MEANS MEMORY PROTECT IS 'ON'. * THE SPECIAL ROUTINE MUST ISSUE * A STC 5 IMMEDIATELY BEFORE * RETURNING TO THE INTERRUPTED * SEQUENCE BY A JMP -,I * * = 1 MEANS THAT THE R/T EXEC ITSELF * WAS EXECUTING WHEN THE INTERRUPT * OCCURRED AND THAT MEMORY * PROTECT IS 'OFF'. THE ROUTINE * MUST NOT ISSUE THE STC 5 IN * THIS CASE. * * IF A SPECIAL INTERRUPT ROUTINE MUST EXECUTE * WITH THE RINTERRUPT SYSTEM DISABLED, THE * STC 0 TO RE-ENABLE INTERRUPTS JUST PRIOR TO * EXITING MUST BE IN THE FOLLOWING SEQUENCE IF * MEMORY PROTECT IS ALSO TO BE TURNED ON: * * - STF 0 - * - STC 5 - * - JMP -,I - SKP $CIC NOP * CLF CLF 0 DISABLE INTERRUPT SYSTEM * * PRESERVE CURRENT STATUS OF MACHINE * SPC 1 IFZ ***** BEGIN DMS CODE ************** SSM $MEU SAVE MEU STATUS AT INTERRUPT FOR $MESS UJP *+2 SAVE REGISTERS IN USER MAP ******* END DMS CODE ************** XIF SPC 1 MIC JMP MIC1 STA XA,I IF NO MICRO TO SAVE REGS STB XB,I SAVE REGISTERS ERA,ALS A,B SOC E AND INA OVERFLOW STA XEO,I MX1 JMP LIA4 CXA IF MX CYB DST XI,I SAVE X AND Y * LIA4 LIA 4 GET INTERRUPT CODE STA INTCD SAVE INTERRUPT CODE CPA .5 MP? JMP ZCIC YES, AVOID CLF. IOR CLF STA CLFXX CONFIGURE CLEAR FLAG CLFXX NOP LET PRIVILEGED I-O INTERRUPT * ZCIC ISZ MPTFL MPTFL=1 (WE'RE IN SYSTEM) MP IS OFF SW1 JMP CIC.0 (STC DUMMY IF PRIVILEDGED OPTION) * CLC 6 STOP DMA FROM INTERRUPTING, CLC 7 SO THAT ONLY PRIVILEGED DRIVERS CAN. STF 0 RE-ENABLE INT.SYS, LET DUMMY INTERRUPT * CIC.0 EQU * LDB $CIC SAVE P-REGISTER A POSSIBLE STB XSUSP,I POINT OF SUSPENSION. LDB INTCD RESTORE INT CODE * * CHECK FOR TRANSFER TO NON-I/O SYSTEM PROCESSOR * CPB TBG IF TIME BASE GENERATOR, JMP $CLCK GO TO TIME PROCESSOR SPC 1 IFZ ***** BEGIN DMS CODE **************** UJP *+2 USER MAP FOR PRAMS, DUMMY SET SYS MAP ******* END DMS CODE **************** XIF SPC 1 CPB .5 IF MEMORY PROTECT VIOLATION, JMP $RQST GO TO EXAMINE MP VIOLATION. * * M0CHECK LEGALITY OF INTERRUPT * MIC2 JMP MIC3 OR NOP IF NO MICRO ADB N6 CODE - 6. STB A (SAVE FOR TABLE INDEX) ADB INTBA INDEX TO PROPER ENTRY CMA,CLE,SSA - ERROR IF CODE ADA INTLG LESS THAN 6 OR BEYOND * * GET PROCESSOR IDENT FROM INTERRUPT TABLE * LDA B,I CODE. GET CONTENTS OF ENTRY SEZ SKIP IF OUT OF INTBL RANGE. CLE,SZA,RSS UNDEFINED INTERRUPT JMP CIC.4 IF VALUE = 0, ISSUE DIAG. * * LDB INTCD REMOVE ERB BIT 15 OF INTBL WORD CPB .3 IF DMA CHANNEL RAL,CLE,ERA INTERRUPT. * SSA,RSS SYSTEM PROCESSOR IS TO BE CALLED JMP CIC.2 IF VALUE IS POSITIVE. * ** INTERRUPT PROCESSOR IS USER ROUTINE TO BE ** SCHEDULED FOR PRIORITY EXECUTION * CMA,INA SET POSITIVE TO GET ID SEGMENT STA B ADDRESS, SET IN B TO <$LIST>. * CIC.3 ADA .15 CHECK STATUS OF PROGRAM. LDA A,I IF STATUS IS ZERO (DORMANT), SZA SCHEDULE PROGRAM, OTHERWISE JMP CIC.5 ISSUE DIAGNOSTIC. * JSB $LIST CALL SCHEDULER TO LINK PROGRAM OCT 401 INTO SCHEDULE LIST. JMP $XEQ SPC 1 N6 DEC -6 * * * ASSUME PROCESSOR FOR CODE GT= 6 IS A * SYSTEM I/0 DRIVER. VALUE OF INTERRUPT * TABLE ENTRY IS THE STARTING ADDRESS * OF THE EQUIPMENT TABLE ENTRY CORRESPONDING * TO THE INTERRUPTING DEVICE. * CIC.2 JSB $ETEQ SET EQT ENTRY ADDRESSES. SPC 1 IFZ ***** BEGIN DMS CODE ************** CIC.6 JSB $DVM GO SET RIGHT MAP ******* END DMS CODE *************** XIF SPC 1 LDA INTCD (A) INTERRUPT I-O SELECT CODE CIC.8 LDB EQT14,I SET DEVICE STB EQT15,I TIME-OUT CLOCK * * CALL I/O PROCESSOR, COMPLETION SECTION * * P+1 RETURN: INDICATES COMPLETION OF THE REQUEST. * P+2 RETURN: INDICATES CONTINUATION OF THE REQUEST. * P+3 RETURN: INDICATES THAT THE DRIVER NEEDS A DMA * CHANNEL BEFORE IT CAN CONTINUE. REENTRY * TO THE DRIVER WILL BE THROUGH THE * INITIATION POINT OF THE DRIVER WHEN A * DMA CHANNEL IS AVAILABLE. THE DRIVER MUST * KEEP A FLAG INDICATING HE WAS ENTERED AT * THE INITIATION POINT FOR A DMA REQUEST FROM * THE CONTINUATOR. ON EXIT FROM THE INITIATOR * THE A-REG MUST EQUAL ZERO. RETURN WILL THEN * WILL BE MADE HERE FOR NORMAL CONTINUATION * PROCESSING. * LDB EQT3,I CALL DRIVER AT JSB B,I *COMPLETION* SECTION. * JMP IOCOM (P+1): *COMPLETION RETURN* JMP IOCON (P+2): *CONTINUATION RETURN* IFZ ***** BEGIN DMS CODE *************** JSB $RSM (P+3): RESTORE USER MAP. ***** END DMS CODE *************** XIF ISZ CONFL (P+3): *REQ.DMA RETURN*SET=1 INCASE WE GET LDA DIOCR TO *REXIT* VIA SUBROUTINE *DRIVR*. STA DRIVR SETUP RETURN ADDRESS FOR SUBROUTINE JMP DVR0 *DRIVR* AND JUMP INTO IT TO ALLOCATE IOCRT JMP IOCO1 (P+1) A DMA CHANNEL. WILL REENTER DRIVER AT JMP NOTRD (P+2) INITIATION. OK, RETURN TO (P+1). * IOCON EQU * IFZ ***** BEGIN DMS CODE *************** JSB $RSM GO RESTORE USER MAP. ***** END DMS CODE *************** XIF IOCO1 CLA LDB OPATN CHECK FOR OPERATOR ATTENTION. STA OPATN -CLEAR OPERATOR FLAG- SZB IF FLAG SET, JMP $TYPE ACKNOWLEDGE. * LDA $LIST ANY SCHEDULE ACTIVITY? SZA,RSS YES, SKIP JMP $IRT NO, RETURN TO POINT OF INTERRUPT * JMP $XEQ SCHEDULE NOW, NOT 10MS LATER!! * * * $XCIC LIA 4 ### SPECIAL CLUDGE TO SKIP CLF ### $YCIC STA INTCD SPC 1 IFZ ***** BEGIN DMS CODE *************** UJP *+2 ******* END DMS CODE *************** ނ XIF SPC 1 MIC4 JMP MIC5 OR NOP IF NO MICRO, CXA IF MX MX4 JMP ZCIC CYB IF MX DST XI,I SAVE X,Y IF MX JMP ZCIC SNEAK TO FRONT DOOR FROM REAR ENTRANCE SPC 2 MIC1 SVR XA,I XI,I MICRO FOR SAVE REGS JMP LIA4 * MIC5 SVR DUM XI,I MICRO SAVE X,Y ONLY JMP ZCIC * MIC3 INT INTBA SEARCH INTERRUPT TABLE JMP CIC.4 ERROR RETURN JMP CIC.2 CALL DRIVER JMP CIC.3 CALL PROGRAM * * * * ILLEGAL OR UNDEFINED INTERRUPT * CIC.4 LDA INTCD GET THE INTERRUPT CODE. JSB $CVT1 CONVERT. STA CICM1+6 STUFF IN THE MESSAGE LDA CICM1 PRINT JMP CIC.7 "ILL INT XX" * * ISSUE DIAGNOSTIC FOR BEING UNABLE TO * SCHEDULE USER PROGRAM ON INTERRUPT. * CIC.5 ADB .12 SET (B) TO ADDRESS OF NAME IN LDA B,I PROGRAM ID SEGMENT. STA CICM2+7 STORE INB PROGRAM DLD B,I NAME IN DST CICM2+8 DIAGNOSTIC AND PRINT LDA CICM2 "SC03 INT XXXXX" CIC.7 JSB $SYMG * * ***** NOTE FALL THROUGH TO $IRT ***** SKP * * RESET INTERRUPT CONDITIONS - RETURN TO SEQUENCE * * * ROUTINE: '$IRT' * * THIS ROUTINE RETURNS TO THE CURRENT USER PROGRAM. * IT DOES THE PRIV. INTERRUPT SYSTEM EXIT THING AND * RESTORES THE PROGRAMS REGISTERS AND THE INTERRUPT * AND MEMORY PROTECT SYSTEM. * * CALLING SEQUENCE: * * SET UP XEQT AREA ON THE BASE PAGE FOR THE PROGRAM * * JMP $IRT * $IRT JSB $CLCK OR -CLA- IF TBG INCLUDED LDB XSUSP,I (A) = 0 AT THIS POINT STB INTCD (B) = RETURN ADDR. SAVE IT SPC 1 IFZ ***** BEGIN DMS CODE ************** UJP *+2 ******* END DMS CODE ************** XIF SPC 1 CLF 0 TURN OFF INT.SYS STA MPTFL SET 'MPTFL' = 0 TO MEAN INT.SYS IS OFF SW2 JMP MIC6 CLC IF PRIV. ELSE RETURN STF1 STF 12B DLD INTBA,I CHECK _CONDITION OF DMA CHANNELS SSA IF BIT=1, DMA #1 IS ACTIVE SO STC 6 STC TO ENABLE DMA INTERRUPT SSB IF USER WANTED IT STC 7 SAME FOR DMA #2 MIC6 JMP MIC7 NOP IF NO MICRO, DLD IF MX * MX6 JMP NMIC6 DEF XI,I IF MX CAX CBY * NMIC6 LDA XEO,I RESTORE E AND CLO O REGS. SLA,ELA PRIOR TO INTERRUPT TURN OFF STF 1 TO KEEP TIME DOWN * DLD XA,I RESTORE THE A AND B REGS IRT3 STF 0 TURN ON THE INTERRUPT SYSTEM STC 5 AND MEMORY PROTECT JMP INTCD,I RETURN * SPC 1 IFZ ***** BEGIN DMS CODE *************** $MEU NOP MEU STATUS (DMS) AT INTERRUPT ******* END DMS CODE ************** XIF SPC 1 MIC7 RSR XA,I XI,I MICRO FOR RESTORE REGS JMP IRT3 SPC 4 CICM1 DEF *+1 N10 DEC -10 ASC 5,ILL INT XX * CICM2 DEF *+1 N15 DEC -15 ASC 8,SC03 INT XXXXX DUM EQU *-3 DUMMY BUFFER (3 WORDS) * INTCD NOP HOLDS INTERRUPT SOURCE CODE B37 OCT 37 DIOCR DEF IOCRT N2 DEC -2 * $OPSY EQU * SYSTEM ID IFN * BEGIN NON-DMS CODE *************** DEC -15 *** END NON-DMS CODE *************** XIF SPC 1 IFZ ***** BEGIN DMS CODE *************** DEC -5 ******* END DMS CODE *************** XIF SPC 1 HED < RT EXECUTIVE INPUT/OUTPUT CONTROL > *** I N P U T / O U T P U T C O N T R O L *** * * THE I/O SCHEDULING AND CONTROL MODULE < IOC > * IS RESPONSIBLE FOR ALLOCATING THE USE OF ALL * STANDARD I/O DEVICES AND THE TWO DMA CHANNELS. * I/O DRIVERS OPERATE UNDER CONTROL OF AND * <$CIC> FOR INITIATION AND COMPLETION OF SYSTEM * AND USER DIRECTED I/O OPERATIONS. I/O DRIVERS * ARE INDEPENDENT PROGRAMS IDENTIFIED TO * BY THE DEVICE ASSOCIATED EQUIPMENT TABLE. DRIVERS * ARE COMPOSED TO TWO SECTIONS: *INITIATION* AND * *COMPLETIOnN*. THE *INITIATION* SECTION IS * CALLED BY TO EXAMINE AND INITIATE AN I/O * OPERATION. THE *COMPLETION* SECTION IS CALLED * BY <$CIC> TO CONTINUE OR COMPLETE THE OPERATION. * DRIVERS PROVIDE FOR SIMULTANEOUS MULTI-DEVICE * CONTROL BY USING THE DEVICE EQT ENTRY FOR * VARIABLE STORAGE. * * I. * EQUIPMENT TABLE * (EQT) * * EACH I/O DEVICE CONTROLLED BY THE IOC/DRIVER * RELATIONSHIP IS DEFINED BY STATIC AND DYNAMIC * INFORMATION IN THE EQUIPMENT TABLE. THE EQT * IS A SYSTEM RESIDENT TABLE WHICH IS CONSTRUCTED * FROM USER DIRECTIVES BY . EACH EQT * ENTRY IS COMPOSED OF 15-WORDS IN THE FOLLOWING FORMAT: * SKP * * WORD CONTENTS * ---- ---------------------------- * 1 * I/O LIST . LINK POINTER * * 2 *DRIVER *INITIATION ADDRESS* * 3 *DRIVER *COMPLETION ADDRESS* * 4 *DBPOT/----UNIT#--CHANNEL #* * 5 *AV-TYPE CODE- UNIT STATUS* * 6 *REQUEST CONTROL WORD * * 7 *REQUEST BUFFER ADDRESS * * 8 *REQUEST BUFFER LENGTH * * 9 *TEMPORARY OR DISC TRACK # * * 10 *TEMPORARY OR DISC SECTOR #* * 11 *DRIVER TEMPORARY STORAGE* * 12 * " " " * * 13 * " " " * * 14 * DEVICE CLOCK RESET VALUE * * 15 * " " WORKING " * * * D: =1 IF A DMA CHANNEL REQUIRED FOR TRANSFER * B: =1 IF AUTOMATIC OUPUT BUFFERING DESIRED * P: =1 IF DRIVER TO HANDEL POWER FAIL RECOVERY. * O: =1 IF DRIVER TO HANDEL TIME OUT. * T: DEVICE TIME-OUT BIT - CLEARED BEFORE EACH * IO INITIATION; SET IF DEVICE TIMES-OUT. * UNIT#: OPTIONAL FOR DEVICES REQUIRING * SUB-CHANNEL DESIGNATION * CHANNEL#: I/O SELECT CODE (LOWER # IF * MULTI-BOARD INTERFACE) * AV (AVAILABILITY INDICATOR): * =0, UNIT AVAILABLE FOR OPERATION * =1, UNIT DISABLED * =2, UNIT CURRENTLY IN OPERATION * =3, UNIT WAITING FOR DMA CHANNEL * TYPE CODE: CODE IDENTIFYING TYPE OF I/O DEVICE * UNIT NLHSTATUS: ACTUAL OR SIMULATED UNIT STATUS * AT END OF OPERATION * * II. * DEVICE REFERENCE TABLE * (DRT) * * THE DEVICE REFERENCE TABLE PROVIDES FOR * LOGICAL DEVICE ADDRESSING OF PHYSICAL I-O * SLOTS DEFINED IN THE *EQT*. THE *DRT* CONSISTS * OF TWO SEQUENTIAL TABLES EACH TABLE CONSISTING * OF 1-WORD ENTRIES CORRESPONDING TO THE RANGE * OF USER-SPECIFIED "LOGICAL" UNITS, 1 TO N * WHERE N IS LT OR = TO 63(10). THE CONTENTS OF * EACH LOGICAL UNIT'S WORD ONE IS AS FOLLOWS: * BITS 5-0 DEVICE'S EQT NUMBER * BITS 6-10 THE LOCKING RESOURCE NUMBER * BITS 11-15 THE DEVICE'S SUBCHANNEL ON THE EQT. * THE CONTENTS OF EACH LOGICAL UNIT'S DEVICE * REFERENCE TABLE WORD TWO CONTAINS A * POINTER TO THE I/O QUEUE OF THE I/O REQUESTS * FOR THIS DEVICE WHEN THE DEVICE IS DOWN: * BIT 15=0 FOR AN UP LU. * =1 FOR A DOWN LU. * BITS 14-0=0 FOR AN UP LU. * #0 FOR A DOWN LU WHERE * = ADDRESS OF THE I/O QUEUE IF THIS N* IS THE FIRST LU(MAJOR LU)POINTING * TO THE DEVICE. * = 1 TO 1777(8). THE LU NUMBER OF * DEVICE(MAJOR LU)ON WHICH THE I/O * IS QUEUED. * * CERTAIN LOGICAL UNIT #S ARE PERMANENTLY * ASSIGNED TO FACILITATE SYSTEM, USER AND * SYSTEM SUPPORT I/O OPERATIONS. THESE ARE: * * 0 - BIT BUCKET(DUMMY LU)(NO ENTRY IN DRT) * 1 - SYSTEM TELETYPEWRITER * 2 - SYSTEM DISC * 3 - AUXILIARY DISC * 4 - 'STANDARD' PUNCH UNIT * 5 - 'STANDARD' INPUT UNIT * 6 - 'STANDARD' LIST UNIT * 7 - ASSIGNED * . BY * . USER * 63 - * * III. INPUT/OUTPUT REQUESTS * * I/O REQUESTS INCLUDE COMMANDS FOR * READ, WRITE, CONTROL(FUNCTIONS) AND STATUS. * THE FORMAT OF THESE REQUESTS CONFORM TO * THE GENERAL SYSTEM REQUEST FORMAT. THE * NUMBER OF PARAMETERS VARIES DEPENDING * ON THE TYPE OF REQUEST AND THE CHARAC- * TERISTICS OF THE REFERENCED DEVICE. * * A USER I/O REQUEST IS DIRECTED TO * AT -$IORQ- BY THE EXECUTIVE REQUEST * PROCESSOR <$RQST>. SYSTEM I/O REQUESTS * ARE IN A DIFFERENT FORMAT AND ARE PROCESSED * AT THE SECTION -$XSIO- IN . REFER TO * THAT SECTION FOR DETAILED DESCRIPTION. * * A *STATUS* REQUEST IS PROVIDED * FOR USER AND SYSTEM SUPPORT PROGRAMS * WHICH REQUIRE KNOWLEDGE OF DEVICE * CONDITIONS OR TYPE BEFORE A READ/WRITE/ * CONTROL REQUEST IS MADE. THE PROGRAM * IS NOT SUSPENDED ON THIS CALL. * A PARAMETER WORD IS INCLUDED IN THE * REQUEST TO CONTAIN THE DEVICE STATUS ON * RETURN TO THE USER. THIS STATUS IS FROM WORD * 5 OF THE EQT ENTRY FOR THE DEVICE. * ALSO, AN ADDITIONAL PARAMETER WORD CAN BE * INCLUDED IN THE REQUEST- WORD 4 OF THE * EQT ENTRY IS RETURNED IF THE ADDITIONAL * PARAMETER WORD IS INCLUDED. * * A DYNAMIC STATUS REQUEST CAN BE MADE BY * MEANS OF A CONTROL REQUEST, THE FORMAT * OF WHICH IS DEFINE5D BELOW. IN THIS CASE, * THE REQUEST IS QUEUED, THE DRIVER IS ENTERED, * AND THE STATUS IS RETURNED TO THE CALLING * PROGRAM IN THE A REGISTER. * SKP * * A. READ/WRITE REQUEST FORMAT * * EXT EXEC * JSB EXEC * DEF EXIT (DEFINE EXIT POINT) * DEF RCODE (DEFINE READ (1) OR WRITE(2)) * DEF CONWD (DEFINE CONTROL WORD) * DEF BUFFR (DEFINE BUFFER LOCATION) * DEF BUFFL (DEFINE BUFFER LENGTH) * DEF DTRAK (OPTIONAL - DISC TRACK #) * DEF DSECT (OPTIONAL - DISC SECTOR #) * EXIT --- * . * . * RCODE DEC 1 OR 2 * CONWD OCT NNNNN CONTROL INFO/LOGICAL UNIT # * BUFFL DEC N OR -N WORD OR CHARACTER LENGTH * DTRAK DEC N DISC TRACK # * DSECT DEC N STARTING SECTOR # * * BIT 12 OF THE CONTROL WORD SET ON NON-DISC REQUESTS * INDICATES A DOUBLE BUFFER FOR THIS OPERATION. * IN THIS CASE THE CONTROL BUFFER IS AT "DTRAK" AND IT'S * LENGTH IN WORDS IS AT "DSECT". * * * B. CONTROL REQUEST FORMAT * * EXT EXEC * JSB EXEC * DEF EXIT (DEFINE EXIT POINT) * DEF RCODE (DEFINE REQUEST CODE) * DEF CONWD (DEFINE CONTROL WORD) * DEF PARAM (DEFINE OPTIONAL PARAMETER) * EXIT --- * . * . * RCODE DEC 3 * CONWD OCT NNNNN CONTROL CODE/LOGICAL UNIT # * PARAM DEC N PARAMETER REQUIRED BY TYPE OF CODE * * CONTROL CODES (FIELD 10-06 OF CONTROL WORD): * * 01 - WRITE END-OF-FILE --/ PRIMARILY * 02 - BACKSPACE 1 RECORD / FOR * 03 - FORWARD SPACE 1 RECORD / MAGNETIC * 04 - REWIND / TAPE * 05 - REWIND STANDBY / UNITS * 06 - DYNAMIC STATUS --/ * 07 - SET EOT STATUS (FOR PAPER TAPE INPUT) * 10 - GENERATE LEADER FOR PAPER TAPE * 11 - LIST OUTPUT LINE SPACING * 12 - WRITE FILE۰ GAP --/ PRIMARILY * 13 - FORWARD SPACE FILE/ FOR MAGNETIC * 14 - BACKWARD SPACE FILE/ TAPE UNITS SKP * C. DEVICE STATUS REQUEST FORMAT * * EXT EXEC * JSB EXEC * DEF EXIT (DEFINE EXIT POINT) * DEF RCODE (DEFINE REQUEST CODE) * DEF CONWD (DEFINE CONTROL WORD) * DEF STAT1 (DEFINE STATUS WORD 1) * DEF STAT2 (DEFINE STATUS WORD 2 -- OPTIONAL) * DEF STAT3 (DEFINE STATUS WORD 3 -- OPTIONAL) * EXIT --- * . * . * RCODE DEC 13 STATUS REQUEST CODE = 13 * CONWD OCT NN LOGICAL UNIT # * STAT1 NOP WORD 5 OF EQT ENTRY FOR * DEVICE STORED IN THIS WORD. * STAT2 NOP WORD 4 OF EQT ENTRY FOR * DEVICE STORED IN THIS WORD * IF PRESENT IN REQUEST. * STAT3 NOP IF PRESENT, THEN BIT 15 INDICATES * THE LU IS UP(0) OR DOWN(1) AND BITS * 0-4 GIVE THE LU'S SUBCHANNEL. * * * IV. GENERAL OPERATION * * ALL INPUT/OUTPUT OPERATIONS ARE PERFORMED * CONCURRENTLY WITH PROGRAM COMPUTATION IN THE * OVERALL SYSTEM. AN I/O OPERATION IS CONSIDERED * TO BE NON-BUFFERED TO THE REQUESTING USER * PROGRAM AS THE PROGRAM IS SUSPENDED UNTIL * THE TRANSMISSION OR OPERATION IS COMPLETED. * THE EXCEPTION TO THIS IS IN PROVIDING FOR * AUTOMATIC BUFFERING OF OUTPUT TO USER- * DESIGNATED DEVICES. IN THIS CASE, THE USER * BUFFER IS MOVED TO SYSTEM AVAILABLE MEMORY * AND THE USER PROGRAM IS NOT SUSPENDED. * * V. CLASS I/O OPERATIONS * * CLASS I/O REFERS TO NO-WAIT I/O IN WHICH THE USER * DIRECTS THE COMPLETION INFORMATION TO A 'CLASS' BY * NUMBER. LEGAL CLASSES ARE DEFINED AT GENERATION TIME * AND QUEUES ARE KEPT FOR EACH CLASS IN A TABLE CALLED * THE CLASS TABLE. THIS TABLE IS LOCATED AT $CLAS * AND CONSISTS OF A LENGTH WORD (DEFINING THE NUMBER o~* OF WORDS (CLASSES) IN THE TABLE (SYSTEM)) FOLLOWED * BY ONE WORD FOR EACH DEFINED CLASS. * * IN OPERATION THE USER REQUESTS I/O ON A CLASS, * RTIOC REQUESTS BUFFER MEMORY FOR THE REQUEST * MOVES THE REQUEST TO THE BUFFER MEMORY * QUEUES THE REQUEST ON THE SPECIFIED EQT AND * NOTES IN THE CLASS QUEUE THAT A REQUEST IS * PENDING. * * ON COMPLETION THE COMPLETED REQUEST IS QUEUED IN THE CLASS * QUEUE AND ANY PROGRAM WAITING FOR THE CLASS * IS RESTARTED. * SKP $IORQ EQU * WE ARE ALREADY IN USER MAP. CLA SET CONTROL FLAG=0 TO MEAN STA CONFL *REQUEST* SECTION ENTERED STA TEMP5 CLEAR LU FLAG FOR LU 0 STA TEMPL CLEAR DISC FLAG * CPA RQCNT INSURE AT LEAST ONE PRAMETER JMP ERR01 - NO, ISSUE DIAGNOSTIC. * * LOGICAL UNIT REFERENCE VALIDITY CHECK * CCA,CCE TRANSLATE BY -1 ADA RQP2,I EXTRACT LOGICAL UNIT # FROM AND B77 PARAMETER 1 STA TEMP1 SAVE FOR STATUS CALL LDB A CPB B77 IF 0 SPECIFIED JMP L.00X GO DO IMMEDIATE COMPLETION THING * CMA,CLE CHECK FOR ZERO AND ADA LUMAX FOR A VALUE GT THE LARGEST SEZ,RSS DEFINED #. JMP ERR02 - ERROR, OUTSIDE OF RANGE. * * DRT ENTRY: ---------------------------- * : SUBCH :LU LOCK: EQT# : * ---------------------------- * 15 11 10 6 5 0 * ADB DRT INDEX TODEVICE-REFERENCE-TABLE LDA B,I GET EQT ASSIGNMENT. STA TEMP5 SAVE FOR 'WORD2' ROUTINE. AND B77 MASK OUT SUBCHANNEL CCE,SZA,RSS IF ZERO (SET E=1 FOR L.02 CHECK) JMP L.00X THEN DO IMMEADIATE COMPLETION THING JSB $CVEQ CONVERT TO ABSOLUTE EQT ADDRESS9ES * * REQUEST CODE ANALYSIS * L.000 LDA RQP1 GET REQUEST CODE (PARAMETER 1). AND .15 KEEP LOW PART STA RQPX SAVE IT CPA .13 TRANSFER IF JMP L.15 * STATUS * REQUEST. * LDA TEMP1 GET LU-1 AND DETERMINE JSB STADV IF THE LU OR EQT IS DOWN JMP L.014 IF DOWN, SUSPEND PROGRAM * LDA RQPX UP, CONTINUE LDB XPRIO,I SET THE PRIORITY STB TEMP2 FOR LINK AND STB TEMP6 FOR BUFFERING CPA .3 IF REQUEST IS JMP L.02 SKIP FURTHER ANALYSIS. * LDB RQCNT CHECK # OF ADB N3 PARAMETERS SUPPLIED SSB FOR READ OR WRITE. JMP ERR01 -ERROR, LT 3. * * BUFFER LEGALITY CHECK FOR INPUT. * LDB RQP4,I GET THE LENGTH CLE,SSB,RSS CONVERT TO JMP BFCK1 WORDS IF BRS CHARACTERS CMB,INB SET POSITIVE AND BFCK1 STB TMP8 SAVE. SPC 1 CPA RQP1 IF CLASS REQUEST CPA .2 OR IF WRITE REQUEST, JMP L.01 SKIP BUFFER CHECK. SPC 1 ADB RQP3 CHECK IF AREA EXTENDS ABOVE THE CMB,SEZ,CLE,INB,RSS LAST WORD ADB BKLWA OF MEMORY INB CLB,SEZ,RSS IF SO THEN JMP ERR04 ERROR 4 DIAGNOSTIC JMP L.01 GO CHECK 5 PARAMS, ETC. * * * L.014 LDB .4 L.013 STB XTEMP,I SET 4 IN FIRST WORD OF TEMP AREA. L.015 JSB $LIST PUT PGM IN WAIT LIST OCT 503 UNTIL DEVICE COMES UP. JMP $XEQ EXIT TO DISPATCHER SPC 1 ICOMX NOP DUMMY EQT FOR LU=0 B3700 OCT 3700 DO NOT REARRANGE NEXT 6 LINES .12 DEC 12 B14K OCT 14000 EQT4 OF DUMMY .13 DEC 13 EQT5 OF DUMMY TEMP1 NOP EQT6 OF DUMMY WORD2 NOP * N3 DEC -3 N5 DEC -5 C100K OCT 77777 $DMEQ DEF ICOMX ADDRESS OF DUMMY EQT SPC 2 L.00X LDA $DMEQ SET UP DUMMY EQT FOR LU=0 %> JSB $ETEQ ON BASE PAGE JMP L.000 CONTINUE PROCESSING * L.01 CLE LDB RQCNT SET (E)=1 IF 5 OR MORE PARAMS ADB N5 * LDA EQT5,I AND B36K CHECK FOR DISC CPA B14K DISC? RSS YES JMP L.02 NOT DISC, PROCEED ON DBL BUF TEST * STA TEMPL SAVE DISC FLAG INDICATOR SSB DOES DISC CALL HAVE 5 PARAM? JMP ERR01 NO, ERROR. * L.02 CLA,SEZ,RSS IF BIT 12 OF CONWORD LDA RQP2,I SET AND ALF,SLA NOT FIVE OR MORE PRAMS JMP ERR01 TAKE GAS! * LDA TEMP5 CHECK FOR LU LOCK RRR 6 GET LOCK BITS TO LOW A AND B37 ISOLATE THEM SZA,RSS IF NOT LOCKED JMP WORD1 FORGET CHECK * STA TEMP3 SAVE RN# FOR LULOCK PASSING LDB C100K SET 77777 FOR LINK PRIORITY STB TEMP2 AND CLB,INB ONE FOR STB TEMP6 BUFFERING PRIORITY. ADA D$RN ELSE INDEX INTO RN TABLE STA XTEMP,I SAVE RN ADDR IN ID SEG LDA A,I GET THE ENTRY AND B377 CHECK IF STA TEMPW SAVE OWNER'S ID ADA KEYWD CURRENT PROGRAM ADA N1 IS THE LDA A,I ONE THAT OWNS THE LOCK CPA XEQT ? JMP WORD1 YES CONTINUE THE REQUEST * LDA RQPX COMPUTE ADDRESS OF THE LDB .3 POSSIBLE RN NUMBER CPB A IF CONTROL RQ SUBRTACT 3 CLB CPA RQP1 IF NOT CLASS ADB N1 SUBTRACT ONE ADB DRQP5 ADD ADDRESS OF FIFTH PRAM CLA USE ZERO IF NONE PASSED AND LDA B,I GET THE PASSED VALUE XOR TEMP3 CONSTRUCT AND ALF,ALF COMPARE WITH THE LOCKER'S XOR TEMPW RN CLE,SZA SKIP IF EQUAL. CLE FOR WORD2 BUILD JMP L.015 NO GO SUSPEND THE CURRENT CALLER * * * *WORD2 ASSEMBLE CONTROL WORD * * CONTROL WORD IS BUILET AS FOLLOWS: * ******************************************************** * T * S * X * U * S FUN * SUB CHAN * REQUEST CODE * * 15/14*13 *12 *11 * 10----6* 5------2 * 1/0 * ******************************************************** * * WHERE: * T= 0 FOR STD USER REQUEST CODE = 1 FOR READ (CLASS OR NORMAL) * = 1 FOR BUFFERED RQ. = 2 FOR WRITE " * = 2 FOR SYSTEM = 3 FOR CONTROL " * = 3 FOR CLASS RQ. * * 'SUB CHAN' IS THE LOW 4 BITS AND 'S' IS THE 5'TH BIT OF THE * SUB CHANNEL. * * 'X' IS THE DOUBLE BUFFER BIT * 'U' IS CURRENTLY UNUSED * 'S FUN' IS THE USER SUB FUNCTION * * IF THE DEVICE IS A DISC THEN THE 'X' BIT IS CLEARED AND BITS * 8,9 IN 'S FUN' ARE SET TO THE LU IF 2 OR 3 ,ELSE THEY ARE * ZEROED. * * THIS ROUTINE DOES NOT BUILD THE 'T' FIELD. *** CALL WITH E=0 *** * WORD1 CLE LDB RQPX IF CLASS WRITE-READ CPB .4 THEN CHANGE CLB,CLE,INB CHANGE TO READ REQUEST LDA RQP2,I COMBINE REQUEST CODE WITH AND B137C CONTROL INFORMATION ADB A TEMPORARILY STORE IT- LDA TEMP5 GET DRT ENTRY FOR THIS LU AND B174K GET SUBCHANNEL ELA,RAL SAVE HIGH BIT AND ALF,RAL POSITON REST ADA B ADD IT TO THE WORD SEZ IF HIGH BIT SET ADA B20K SET IT IN THE WORD STA WORD2 * LDB RQPX GET THE MASKED REQUEST LDA TEMPL SZA,RSS IS IT DISC CALL? JMP CL? NO * LDA WORD2 IT IS DISC, AND C114C SO CLEAR BITS 12,9, AND 8 STA WORD2 AND SAVE AGAIN CPB RQP1 IS DISC CALL CLASS I/O? JMP L.10 NO, DO UNBUFFERED I O JMP ERR02 YES, ERROR BUFFER DISC * CL? CPB RQP1 IF STANDARD I/O JMP L.027 SKIP THE CLASS CODE * * CLASS I/O INITIATION * LDA WORD2 (A) = CONTROL WORD LDB TEMP6 (B) = BUFF,ER PRIORITY JSB $I.CL CALL INITIATE CLASS I/O JMP L.10 FORCE NORMAL UNBUFFERED I/O STA TEMP1 SAVE ADDR OF NEW I/O BLOCK JMP L.132 DO I/O, CLASS QUEUED UP * * * * CHECK FOR AUTOMATIC BUFFERING REQUIREMENT * L.027 CPB .1 SKIP CHECK IF REQUEST JMP L.10 IS INPUT. * LDA EQT4,I CHECK THE UNIT DESCRIPTOR RAL WORD IN ITS EQT ENTRY,BIT 14, SSA,RSS FOR BUFFERING. JMP L.10 -NO * LDA RQP2,I DYNAMIC STATUS AND B3700 REQUESTS ADA B ARE NEVER CPA B603 BUFFERED JMP L.10 DYNAMIC STATUS DO STD. USER RQ. * * * AUTOMATIC BUFFERING SECTION * CLA STA TMP6 INITIALIZE 2ND BUFF SIZE TO ZERO LDA N2 USE 5 WORDS FOR CONTROL REQUEST CPB .3 IF REQUEST IS FOR -CONTROL-, JMP L.03 SKIP BUFFER SIZE CHECK. * LDA TMP8 GET THE XFER LENGTH STA TEMP3 -SET AS MOVE INDEX- LDB RQP2,I IF DOUBLE BUFFER REQUEST BLF,SLB THEN RSS JMP L.03 NO, SKIP SECOND BUFFER SIZE * CLA CLEAR (A) IN CASE RQP6=0 LDB RQP6,I YES, GET SECOND BUFFER SIZE SSB,RSS NEGATIVE CHAR COUNT? JMP L.029 NO, SET WORD COUNT * BRS YES, CONVERT TO +WORDS CMB,INB L.029 LDA B GET SECOND BUFFER SIZE ADA TMP8 ADD TO FIRST BUFFER SIZE STB TMP6 SAVE 2ND BUFF SIZE L.03 ADA .8 ADD 8 FOR BLOCK CONTROL WORDS. ADA N1 THEN SUBTRACT 1 STA L.04 AND SET UP IN CALL * LDA N41 IF PRIORITY ADA XPRIO,I LT 41 THEN SSA DO NOT DO BUFFER LIMIT JMP L.031 TEST * * LDB $BLUP CHECK IF BEYOND THE LIMIT IN WORDS JSB $QCHK ON THIS DEVICE JMP L.013 BUFFER LIMITED! * * ALLOCATE BLOCK IN TEMPORARY STORAGE * L.031 JSB $ALC CALL AT SYSTEM ENTRY POINT L.04 NOP - REQUESTED LENGTH OF BLOCK - JMP L.10 NEVER ANY MEMORY SO GO UNBUFFERED JMP L.042 NO MEMORY NOW, SUSPEND. JMP L.06 ALLOCATION OK. * * * NO MEMORY AVAILABLE FOR BLOCK - CALLING USER * PROGRAM IS TO BE LINKED INTO MEMORY SUSPENSION * $LIST AND RE-SCHEDULED AT POINT OF REQUEST * WHEN A PREVIOUSLY ALLOCATED BLOCK IS RELEASED. * L.042 JSB $LIST CALL TO LINK PROGRAM INTO OCT 504 MEMORY SUSPENSION LIST. JMP $XEQ * * DRQP5 DEF RQP5,I B603 OCT 603 N41 DEC -41 B137C OCT 13700 B20K OCT 20000 C114C OCT 166377 CLEAR BITS 12,9,8 * * SET REQUEST PARAMETERS, PROGRAM PRIORITY AND * USER BUFFER INTO TEMPORARY BLOCK. * L.06 STB L.04 SET ACTUAL BLOCK LENGTH. STA TEMP1 SAVE BLOCK CCE,INA STA B SAVE ADDRESS OF WORD 2 LDA WORD2 GET CONTROL WORD IOR B40K SET = 1 FOR BUFFERING. SPC 1 IFN * BEGIN NON-DMS CODE ************** STA B,I AND SET IN WORD 2 OF BLOCK. *** END NON-DMS CODE ************** XIF SPC 1 IFZ ***** BEGIN DMS CODE ************** XSA B,I AND SET IN WORD 2 OF BLOCK. ******* END DMS CODE ************** XIF SPC 1 INB BUMP TO WORD 3 LDA TEMP6 SET REQUESTING PROGRAM PRIORITY SPC 1 IFN * BEGIN NON-DMS CODE ************** STA B,I IN WORD 3. *** END NON-DMS CODE ************** XIF SPC 1 IFZ ***** BEGIN DMS CODE ************** XSA B,I IN WORD 3. ******* END DMS CODE ************** XIF SPC 1 INB BUMP TO WORD 4 LDA L.04 SET BLOCK LENGTH IN SPC 1 IFN * BEGIN NON-DMS CODE ************** STA B,I WORD 4. *** END NON-DMS CODE ************** XIF SPC 1 IFZ ***** BEGIN DMS CODE ************** XSA B,I WORD 4. ****?*** END DMS CODE ************** XIF SPC 1 INB BUMP TO WORD 5 LDA .3 IF REQUEST CPA RQPX IS -CONTROL-, SKIP JMP L.08 BUFFER MOVE * LDA RQP4,I SET USER BUFFER LENGTH SPC 1 IFN * BEGIN NON-DMS CODE ************** STA B,I IN WORD 5. *** END NON-DMS CODE ************** XIF SPC 1 IFZ ***** BEGIN DMS CODE ************** XSA B,I IN WORD 5. ******* END DMS CODE ************** XIF SPC 1 CMA,CLE,INA SET E IF ZERO LENGTH BUFFER CLA IN CASE RQP5 IS 0 LDA RQP5,I GET FIRST OPTIONAL WORD INB BUMP TO WORD 6 STB TEMPW SAVE THE ADDRESS OF THE LOCATION SPC 1 IFN * BEGIN NON-DMS CODE ************** STA B,I SET IT *** END NON-DMS CODE ************** XIF SPC 1 IFZ ***** BEGIN DMS CODE ************** XSA B,I SET IT ******* END DMS CODE ************** XIF SPC 1 INB BUMP TO WORD 7 CLA IN CASE RQP6 IS 0 LDA RQP6,I GET SECOND OPTIONAL WORD SPC 1 IFN * BEGIN NON-DMS CODE ************** STA B,I SET IT IN THE BUFFER *** END NON-DMS CODE ************** XIF SPC 1 IFZ ***** BEGIN DMS CODE ************** XSA B,I SET IT IN THE BUFFER ******* END DMS CODE ************** XIF SPC 1 SEZ,CLE,INB IF BUFFER LENGTH = 0, JMP L.075 SKIP BUFFER MOVE. * LDA RQP3 SET USER BUFFER ADDR L.065 EQU * FOR MOVE TO TEMP. BLOCK SPC 1 IFN * BEGIN NON-DMS CODE ************** JSB .MVW DEF TEMP3 NOP *** END NON-DMS CODE ************** XIF SPC 1 IFZ ***** BEGIN DMS CODE ************** LDX TEMP3 GET # WORDS TO MOVE MWI MOVE INTO SYSTEM MAP ******* END DMS CODE ************** XIF SPC 1 * L.075 LDA TMP6 GET LENGTH OF SECOND BUFFER STA TEMP3 SET FOR MOVE LDA RQP2,I GET THE REQUEST CONTROL WORD ALF,SLA IF FIRST TIME AND DOUBLE BUFFER SEZ,CCE SKIP JMP L.13 ELSE CONTINUE * SPC 1 IFN * BEGIN NON-DMS CODE ************** STB TEMPW,I SET BUFFER ADDRESS IN REQUEST *** END NON-DMS CODE ************** XIF SPC 1 IFZ ***** BEGIN DMS CODE ************** XSB TEMPW,I SET BUFFER ADDRESS IN REQUEST ******* END DMS CODE ************** XIF SPC 1 LDA RQP5 GET USER BUFFER ADDRESS JMP L.065 GO MOVE THE BUFFER * L.08 CLA IN CASE RQP3=0 LDA RQP3,I FOR CONTROL REQUEST, SET WORD 3 SPC 1 IFN * BEGIN NON-DMS CODE ************** STA B,I (PARAM) IN PLACE OF RECORD *** END NON-DMS CODE ************** XIF SPC 1 IFZ ***** BEGIN DMS CODE ************** XSA B,I (PARAM) IN PLACE OF RECORD ******* END DMS CODE ************** XIF SPC 1 JMP L.13 LENGTH. SPC 2 D$RN DEF $RNTB ADDRESS OF RN TABLE SPC 2 * * REQUEST IS A NORMAL WRITE, CONTROL OR READ. * THE PARAMETERS OF THE REQUEST ARE MOVED * INTO THE ID SEGMENT OF THE REQUESTING * PROGRAM. THE ID SEGMENT IS THEN LINKED * INTO THE I/O LIST FOR THE REFERENCED DEVICE. * THE -SCHEDULER- IS THEN CALLED TO REMOVE * THE PROGRAM FROM THE SCHEDULED LIST AND TO * CHANGE THE PROGRAM STATUS TO I/O SUSPENSION. * L.10 CLA IN CASE RQP3=0 LDB RQP3,I SET CONTROL WORD LDA RQP1 (A) = REQUEST CODE CPA .3 IF CONTROL GO JMP L.101 SET IT UP * LDB XTEMP+4 GET THE ADDRESS OF THE RENT ADB .15 BIT IN THE ID-SEG. LDA B,I GET THE WORD TO A ALF,RAL PUT THE BIT IN SIGN OF A LDB RQP3 BUFFER ADDRESS TO B HFB CLE,SSA IF BIT SET JSB $REIO GO MOVE THE TDB (IF NEEDED) * SPC 1 IFZ ***** BEGIN DMS CODE *************** CLA,CCE CPA $MVBF WAS TDB MOVED RSS NO RBL,ERB YES,SET SIGN IN ID SEG BUFFER TMP STA $MVBF CLEAR TDB MOVED FLAG ******* END DMS CODE *************** XIF SPC 1 STB XTEMP+1,I SET BUFFER ADDRESS OR CONTROL WORD LDA RQP4,I BUFFER STA XTEMP+2,I LENGTH AND LDA RQP2,I GET THE CON WORD CMA,CME SET COMPLEMENT IOR TEMPL MERGE DISC FLAG (FLIPS BIT 12) LDB RQP5 GET SECOND BUFFER ADDRESS ALF,SLA IF NONE SZB,RSS RSS LDB B,I GET THE OPTION WORD SEZ,SLA,RSS IF RENT AND DOUBLE BUFFER JSB $REIO GO CHECK OUT THE BUFFER ADDRESS STB XTEMP+3,I SET THE PRAMETER IN THE ID-SEGMENT * CLA IN CASE RQP6=0 LDA RQP6,I SET THE FINAL OPTIONAL WORD H STA XTEMP+4,I IN THE ID-SEGMENT * CLE,RSS SKIP CONTROL SET UP L.101 STB XTEMP+1,I SET CONTROL WORD LDA WORD2 GET CONTROL WORD STA XTEMP,I SAVE IN TEMPORARY #1 LDB XEQT SET ADDRESS OF LINK WORD STB TEMP1 IN TEMP1. * JSB $LIST CALL SCHEDULER TO SUSPEND PROG. OCT 402 - ID SEG. ADDR./I/O SUSPEND - * * CALL -LINK- TO PERFORM THE LINKING OF THE NEW * BLOCK INTO THE DEVICE QUEUE OF * WAITING OPERATIONS. * L.13 LDB XSUSP,I SET THE SUSP POINT STB XA,I IN XA FOR THE ABORT ROUTINE L.132 LDA RQRTN AND SET THE RETURN ADDRESS STA XSUSP,I IN THE ID-SEG. JSB LINK LINK SETS E=0 IF EMPTY QUEUE LDB EQT1 IF DUMMY EQT FOR LU=0 CPB $DMEQ THEN JMP L.135 GO TO COMPLETE * * SEZ,RSS IF QUEUE WAS EMPTY CALL DRIVR. * * EMPTY LIST, CALL TO INITIATE CURRENT REQUEST. * JSB DRIVR JMP $XEQ - OPERATION INITIATED - JMP NOTRD - OPERATION REJECTED OR COMPLETED - * L.135 LDB RQP4,I GET THE REQUEST LENGTH L.136 SSB AND SET UP CMB,INB THE TLOG LDA .2 SET A FOR IMMEDIATE COMPLETION SPC 1 IFN * BEGIN NON-DMS CODE ************** JMP R00 AND GO TO COMPLETION SECTION *** END NON-DMS CODE ************** XIF SPC 1 IFZ ***** BEGIN DMS CODE ************** SJP R00 AND GO TO COMPLETION SECTION ******* END DMS CODE ************** XIF SPC 1 * * STATUS REQUEST SECTION * L.15 LDA RQCNT INSURE THAT AT LEAST 2 ADA N2 PARAMETERS PROVIDED - ONE SSA TO STORE STATUS WORD. JMP ERR01 -NO, ERROR '01'. * LDB EQT5,I STORE WORD 5 OF EQT ENTRY IN STB RQP3,I 'STAT1' LDA EQT4,I STORE WORD 4 OF EQT ENTRY IN STA RQP4,I 'STAT2' IF CODED. * LDB TEMP1 ADB DRT LDA GB,I GET SUBCHANNEL FOR DRT WORD#1 AND B174K ALF,RAL PUT INTO LOW 5 BITS ADB LUMAX LDB B,I GET UP/DOWN BIT OF LU CLE,ELB (DRT WORD#2) RAL,ERA ADD TO SUBCHANNEL BITS STA RQP5,I STORE IN 'STAT3' * LDA RQRTN UPDATE THE STA XSUSP,I RETURN ADDRESS JMP $XEQ AND EXIT SPC 3 RQPX NOP * * **************************************************************** * * SUBROUTINE STADV: * * STADV WILL RETURN AT THE UP EXIT IF LU=0. IT THEN * CHECKS TO DETERMINE IF THE CURRENT EQT IS DOWN (BIT 14 * EQT WORD 5) OR IF THE LU IS DOWN(BIT 15 DRT WORD 2). IF * DOWN, RETURN IS MADE AT P+1. IF UP, RETURN IS MADE AT P+2. * * CALLING SEQUENCE: * :=ADDRESS OF STATUS WORD FOR THIS EQT. * :=LU#-1. * JSB STADV * * RETURN: * (P+1) EQT OR LU DOWN. * (P+2) EQT AND LU UP. * ALL REGISTERS ARE VIOLATED. * ****************************************************************** * STADV NOP CPA B77 IF LU=0 (LESS 1, SO 77B), JMP STAD9 THEN GO TO UP EXIT. * ADA DRT GET DRT WORD ADA LUMAX 2 AND CHECK LDA A,I IF THE LU IS SSA UP OR DOWN. JMP STADV,I LU IS DOWN. * LDB EQT5,I LU IS UP, SO RBL,SLB CHECK IF THE JMP STAD9 EQT IS UP OR SSB DOWN. JMP STADV,I EQT IS DOWN. * STAD9 ISZ STADV LU AND EQT JMP STADV,I ARE UP. SKP * SUBROUTINE: -LINK- * * PURPOSE: THIS ROUTINE PROVIDES FOR ADDING * AN I/O REQUEST INTO THE SUSPENDED * LIST (QUEUE) CORRESPONDING TO THE * REFERENCED DEVICE. THE PROCEDURE * OF ADDING AN ENTRY INTO THE LIST * INVOLVES ONLY THE ALTERATION OF * THE LINKAGE VALUE IN THE NEW ENTRY * AND IN THE ENTRY PRECEDING THE *  NEW ONE IN THE PRIORITY CHAIN. * THE NEW ENTRY IS LINKED ACCORDING * TO ITS PRIORITY AND ON A FIFO * BASIS WITHIN THE SAME PRIORITY * LEVEL. THE END OF A LIST IS MARKED * BY A LINKAGE VALUE OF ZERO. THE * FIRST ENTRY IN A LIST IS SKIPPED * BECAUSE IT IS ASSUMED TO BE THE * REQUESTOR FOR THE CURRENT I/O * OPERATION. IF THE LIST IS EMPTY, * THE LINK WORD IN THE EQT ENTRY * IS SET TO POINT TO THE NEW ENTRY * AND AN INDICATION IS GIVEN TO * THE CALLER OF -LINK- THAT THE * NEW REQUEST MAY BE INITIATED. * * CALL: THE FOLLOWING LOCATIONS MUST BE * SET TO THE INDICATED VALUES * BEFORE THE CALL IS MADE: * * TEMP1 = LOCATION OF NEW REQUEST * TO BE LINKED INTO THE * I/O LIST DEFINED BY THE * CURRENT EQT ENTRY. THE * ADDRESS OF THE LINKAGE * WORD IN THE EQT ENTRY * IS IN -EQT1-. * * TEMP2 = PRIORITY OF THE NEW * REQUEST. * * TEMPL = DISC QUEUE FLAG (# 0 MEANS DISC) * * - JSB LINK * - (RETURN) (E) = 0 IF THE NEW * REQUEST IS THE ONLY ENTRY * IN THE I/O LIST, I.E. THE * DRIVER MAY BE CALLED TO * INITIATE THE NEW OPERATION. * * THERE ARE NO ERROR CONDITIONS * DETECTED OR DIAGNOSED BY THIS * ROUTINE. * * SKP LINK NOP SPC 1 IFZ ***** BEGIN DMS CODE ************** RSA RAL,RAL STA LNKST SJP *+2 ******* END DMS CODE ************** XIF SPC 1 MIC8 JMP MIC9 OR LDB EQT1 IF NO MICRO CLE,RSS SET FIRST FLAG AND SKIP * * FIRST ENTRY IN LIST IS SKIPPED BECAUSE IT * IS THE CALLER FOR THE CURRENT OPERATION * ACTIVE ON THE I/O DEVICE. * **************************x*********************** **WILL ENTER IN EITHER MAP,BUT THIS IS OK BECAUSE **THE LIND WORD WILL BE IN THE ENABLED MAP AREA** ************************************************* LINK1 SEZ,CCE,RSS IF NOT FIRST SKIP JMP LINK7 GO START THE SCAN * STB TEMP3 TEMP3 = ADDRESS OF CURRENT ENTRY. CCE,INB EXAMINE THE LDA B,I TYPE FIELD IN WORD 2 OF BLOCK INB TO DETERMINE LOCATION RAL OF PRIORITY. SSA IF BUFFERED REQUEST JMP LINK8 B POINTS AT PRIORITY * SLA,RSS IF USER REQUEST JMP LINK5 GO BUMP BY 4 * CLA USE PRIORITY 0 FOR SYSTEM JMP LINK2 NO USE ZERO PRIORITY * LINK5 ADB .4 IS IN WORD 7 OF ID SEGMENT. LINK8 LDA B,I GET PRIORITY OF CURRENT ENTRY. LINK2 LDB TEMP3 CMA,INA SUBTRACT CURRENT PRIORITY FROM ADA TEMP2 PRIORITY OF NEW REQUEST. SSA IF CURRENT IS LOWER PRIORITY JMP LINK3 (HIGHER #), GO TO LINK NEW. * LINK7 STB TEMP5 SAVE PREVIOUS ENTRY POINTER LDB B,I GET NEXT ENTRY ELB,CLE,ERB CLEAR POSSIBLE SIGN BIT SZB IF END-OF-LIST, SKIP. JMP LINK1 -CONTINUE SCAN. * * PROPER POSITION (BY PRIORITY) IS FOUND IN LIST, * OR ELSE THE SCAN OF THE LIST IS FINISHED AND * THE NEW REQUEST IS ADDED AS THE LAST ENTRY. * LINK3 LDA TEMP1 SET ADDRESS OF NEW ENTRY IN STB TEMP1,I SET ADDRESS OF NEXT OR 0 IF LAST XOR TEMP5,I KEEP SIGN OF OLD WORD AND C100K IF IT WAS SET XOR TEMP5,I STA TEMP5,I SET THE POINTER TO THE NEW REQUEST SPC 1 LINK9 EQU * IFN * BEGIN NON-DMS CODE ************** JMP LINK,I -EXIT TO CALLER. *** END NON-DMS CODE ************** XIF SPC 1 IFZ ***** BEGIN DMS CODE ************** JRS LNKST LINK,I - EXIT TO CALLER. LNKST NOP ******* END DMS CODE ************** XIF SPC 1 o SPC 1 MIC9 LDA TEMP2 (A)=PRIORITY OF NEW REQ. LDB TEMP1 (B)=ADDR OF NEW REQUEST LNK EQT1 0B DO MICRO CALL JMP LINK9 RETURN * A SYSTEM REQUEST HAS BEEN FOUND IN THE QUE * SYSTEM DISC REQUESTS ARE QUED BY THE PRIORITY IN * WORD 7 OF THE CALL. OTHER SYSTEM REQUEST ARE AT * PRIORITY ZERO. SKP SPC 1 IFZ ***** BEGIN DMS CODE ************** ************************************************** *******THIS ROUTINE SETS UP THE APPROPRIATE MAP *******FOR THE DRIVER WHICH IS BEING CALLED******* ****************************** ******************* * * ************************************************ ************************************************* ***********WARNING WARNING WARNING************* ***********NO EXTERNAL ROUTIN SHOULD CALL********** ************$DVM OR $RSM EXCEPT SPOOL DRIVER**** ************************************************** ************************************************* * * * $DVM NOP SJP *+2 CLA STA DVMPS LDB EQT1,I GET DRIVER LINK WORD SSB,RSS IF SIGN SET, EXIT IN SYSTEM MAP SZB,RSS LEAVE IN SYS MAP JMP $DVM,I * LDA B INA LDA A,I CHECK T FIELD IN CONTROL WORD RAL SSA T=1 0R 3 IF S=1 JMP $DVM,I LEAVE SYSTEM MAP ENABLED * SLA,RSS JMP DVUSR T=0,GO SET USER MAP * ADB .4 T=2,GET ID WORD IN SYS CALL LDB B,I SZB,RSS IS IT 0 JMP $DVM,I YES,USE SYSTEM MAP * DVUSR LDA EQT1,I ADA .2 LDA A,I GET USER BUFFER ADR FROM ID TMP WORDS CCE,SSA WAS BUFFER MOVED TO SAM? JMP $DVM,I YES,STAY IN SYS MAP * ISZ DVMPS SET THE 'MAPS SWITCHED FLAG' LDA ASVUI GET THE LOCAL SAVE ADDRESS USA AND SAVE THE CURRENT USER MAP ADB .14 IS CURRENT USER LDA B,I CORE RESIDENT? AND .15 CPA .1 WELL? JMP MEMRS YES GO SET MEM RES MAP * ADB .7 STEP TO THE MAP ADDRESS LDA B,I GET MAPID WORD STB DTMP AND B77 GET PARTITION NUMVER STA B MULTIPLY BY 6 ADB B THE FAST WAY *2 ADB A *3 ADB B *6 ADB $MATA GET MAT ENTRY ADR LDA DTMP,I ALF RAL,RAL GET # PAGES AND B37 ISOLATE JSB $SMAP GO SET UP USER MAP UJP $DVM,I ENABLE USER MAP * * MEMRS LDA $MRMP USA UJP $DVM,I MEM RES MAP ENABLED * * DTMP NOP .14 DEC 14 ASVUI DEF SVUSR,I ASVUS DEF SVUSR SVUSR BSS 32 DVMPS BSS 1 DRIVER MAP FLAG * ********RESTORE USER MAP TO PRE-****** ********DRIVER STATE****************** * * $RSM NOP CLA CPA DVMPS WAS USER MAP CHANGED JMP RSEX NO,RETURN * STA DVMPS YES,CLEAR CHANGE MAP FLAG LDA ASVUS USA RESTORE ORIGINAL USER MAP RSEX SJP $RSM,I ENABLE SYSTEM MAP ******* END DMS CODE ************** XIF SPC 1 SPC 4 * SUBROUTINE: -DRIVR- * * PURPOSE: THIS ROUTINE PROVIDES A CENTRAL POINT * FOR CALLING AN I/O DRIVER TO INITIATE * A NEW OPERATION. THIS ROUTINE, BEFORE * CALLING A DRIVER, SETS THE REQUEST * PARAMETERS INTO THE APPROPRIATE WORDS * IN THE EQT ENTRY CORRESPONDING TO THE * REFERENCED DEVICE AND ASSIGNS A DMA * CHANNEL IF REQUIRED. * IT ALSO SETS THE DEVICE TIME-OUT CLOCK. * * REQUIREMENTS: THE ADDRESSES OF THE EQUIPMENT * TABLE ENTRY (15 WORDS) MUST BE SET * IN EQT1 TO EQT15 BEFORE THE ROUTINE * IS CALLED. * * CALLING SEQUENCE: - PARAMETER SET UP AS ABOVE- * - (REGISTERS MEANINGLESS) - * * (R) JSB DRIVR * (P+1) -OPERATION INITIATED OR STACKED * (P+2) -OPERATION REJECTED OR COMPLETED- * * ERRORS/DIAGNOSTICS: A DRIVER IS CALLED ONLY * IF THE UNIT IS AVAILABLE * AND NOT BUSY; OTHERWISE, * RETURN IS MADE TO THE * CALLER. IF THE DRIVER * FINDS THE UNIT UNAVAILABLE * OR THE REQUEST ILLEGAL FOR * THE UNIT, THE INDICATION IS * RETURNED TO THE CALLER FOR * FURTHER ACTION. * DRIVR NOP LDA EQT5,I CHECK AVAILABILITY RAL OF DEVICE SSA,SLA IF DMA WAIT JMP DVR00 GO DO DMA WAIT THING. * CMA,SSA,SLA,RSS IF DOWN OR BUSY JMP DRIVR,I EXIT * * * DEVICE IS AVAILABLE - CHECK FOR DMA REQUIREMENT * LDA EQT4,I SKIP DMA CHANNEL ASSIGNMENT IF SSA,RSS NOT REQUIRED ( D FIELD = 0 ) JMP DRV02 IN WORD 4 OF EQT ENTRY. SPC 1 * DMA CHANNEL REQUIRED - ATTEMPT TO ASSIGN CHANNEL * DVR0 LDA DMACF IF DMA QUEUE IS NOT EMPTY B2002 SZA JMP DVR1 THEN JUST ADD THIS EQT TO QUE. * DVR00 LDA .6 INITIALIZE FOR STA CHAN CHANNEL 6 (DMA # 1 ) LDB INTBA ADDR. OF DMA 1 IN INTERRUPT TABLE CLA IF DMA CHANNEL # 1 CPA B,I AVAILABLE (INTBL ENTRY = 0), JMP DRV01 GO TO ASSIGN IT TO THIS UNIT. * INB SET FOR CHANNEL 7, ISZ CHAN DMA CHANNEL # 2. CPA B,I IF THIS CHANNEL AVAILABLE, JMP DRV01 GO TO ASSIGN IT. * * NO CHANNEL AVAILABLE - SET FLAGS AND RETURN * DVR1 LDA EQT5,I IF DEVICE RAL SSA,SLA IS ALREADY WAITING FOR DMA, JMP DRIVR,I EXIT. * RAR IOR B140K SET AVAIL TO SAY WAITING FOR STA EQT5,I DMA, ADD 1 TO ISZ DMACF # DEVICES WAITING. JMP DRIVR,I - EXIT TO CALLER - * DRV03 SEZ,CLE,INB STEP OVER PRIORITY AND INB IF CLASS REQUEST OVER CLASS WORD AND .6 ISOLATE REQUEST (A IS SHIFTED REMEMBER) CPA .6 IF CONTROL REQUEST JMP DRV2 GO SET IT UP * STB A SET BUFFER ADDRESS ADA .4 IN A (SKIP LENGTH AND TWO OPTION WDS) JMP DRV3 GO FINISH SET UP. * * ASSIGN AVAILABLE CHANNEL * DRV01 LDA EQT1 SET EQT ENTRY ADDRESS IN INTER- STA B,I RUPT TABLE ENTRY FOR CHANNEL. LDB DMACF IF UNIT WAS LDA EQT5,I PREVIOUS WAITING RAL SSA,SLA FOR A DMA ADB N1 CHANNEL, SUBTRACT 1 FROM # OF STB DMACF UNITS WAITING. RAR ALR,RAR CLEAR STA EQT5,I FIELD. SPC 1 IFZ ***** BEGIN DMS CODE ************** JSB $DVM GO SET MAP LDA DVMPS DVMPS=0 SYS, 1=USER RAR PUT INTO BIT15 IOR CHAN 0=PORTA, 1=PORTB XMA INTO BIT0, IGNORE 1-14 JMP DV02C ******* END DMS CODE ************** XIF SPC 1 * * TRANSFER REQUEST PARAMETERS TO EQT ENTRY * DRV02 EQU * IFZ ***** BEGIN DMS CODE ************** JSB $DVM GO SET MAP ******* END DMS CODE ************** XIF SPC 1 DV02C LDB EQT1,I GET CURRENT REQUEST ADDRESS INB FROM LINK WORD OF EQT ENTRY. LDA B,I GET REQUEST CONTROL WORD, AND NTSUB SET SUBCHANNEL BITS TO ZERO STA EQT6,I SET IN EQT 6. XOR B,I SET SUBCHANNEL RAL,RAL NUMBER INTO RAL,SLA,RAL BITS 10-6 OF WORD XOR B2002 SET HIGH BIT, CLEAR LOW BIT STA TEMPL SAVE FOR EQT4 LDA B,I CLE,ELA IF REQUEST IS DRV2 INB SSA HELD AS A TEMPORARY BLOCK FOR JMP DRV03 BUFFERING, JUMP. SPC 1 IFN * BEGIN NON-DMS CODE *************** LDA B,I *** END NON-DMS CODE *************** XIF SPjC 1 SPC 1 IFZ ***** BEGIN DMS CODE *************** AND .6 CPA .6 CCA,RSS THIS IS A CONTROL CALL LDA C100K AND B,I ******* END DMS CODE *************** XIF SPC 1 DRV3 STA EQT7,I ADDRESS. INB LDA B,I SET BUFFER STA EQT8,I LENGTH. INB DLD B,I SET ADDITIONAL 2 DST EQT9,I PARAMETERS IF SUPPLIED. * * CALL DRIVER -INITIATION- SECTION * LDA EQT14,I SET DEVICE LDB EQT15,I TIME OUT CLOCK ONLY SZB,RSS IF NOT CURRENTLY RUNNING STA EQT15,I LDA EQT4,I ZERO TIME-OUT AND C7700 BIT AND SET IOR TEMPL IN SUBCHANNEL STA EQT4,I SET (A) = CHANNEL AND B77 # OF I/O DEVICE. LDB EQT2,I CALL DRIVER *INITIATION* JSB B,I SECTION. SKP * DRIVER RETURNS AN INDICATION OF THE ACCEPTANCE * OR REJECTION OF THE REQUESTED OPERATION: * (A) = 0, OPERATION SUCCESSFULLY INITIATED * (A) NOT = 0, OPERATION REJECTED AND (A) * CONTAINS A NUMERIC CODE * IDENTIFYING THE CAUSE OF * THE REJECT. * * = 1 READ OR WRITE REQUEST ILLEGAL FOR DEVICE * = 2 CONTROL REQUEST ILLEGAL OR NOT DEFINED * = 3 EQUIPMENT MALFUNCTION OR NOT READY * = 4 IMMEDIATE COMPLETION OF OPERATION * = 5 DRIVER REQUIRES DMA BUT FLAG IS NOT SET IN EQT * STA TEMP6 SAVE DRIVER CODE. SPC 1 IFZ ***** BEGIN DMS CODE ************** JSB $RSM GO RESTORE USER MAP LDA TEMP6 RESTORE DRIVER CODE ******* END DMS CODE ************** XIF SPC 1 CCE,SZA IF REJECTED, JMP DRV06 EXAMINE REASON * * OPERATION INITIATED * LDB EQT5,I SET RBL,ERB = 2 TO SAY DEVICE LDA EQT1,I SZA STB EQT5,I IN OPERATION. JMP DRIVR,I EXIT. * * OPERATION REJECTED f* DRV06 STB TLOG SAVE (B) CLA CLEAR DEVICE STA EQT15,I TIME-OUT CLOCK JSB CLDMA CLEAR DMA IF ALLOCATED LDA TEMP6 (A) = REJECT CODE. CPA .5 IF DMA REQUIRED JMP DVR0 GO ATTEMPT ASSIGNMENT ISZ DRIVR SET RETURN TO (P+2). CPA .3 IF NOT READY THEN JMP DRIVR,I -EXIT. JMP ILLCD ELSE GO TO SEND THE MESSAGE SPC 1 C7700 OCT 170077 NTSUB OCT 153703 INCLUDE Z BIT B174K OCT 174000 HED < I/O MODULE SUBSECTION - SYSTEM REQUEST PROCESSOR > * SYSTEM I/O REQUEST PROCESSOR - $XSIO- * * A PRIVATE ENTRY IS PROVIDED AT ENTRY POINT * < $XSIO> TO ALLOW MODULES OF THE REAL TIME * EXECUTIVE TO CALL FOR I/O OPERATIONS WITHOUT * INCURRING THE OVERHEAD AND PROCEDURES * INVOLVED WITH USER I/O REQUESTS. NO ERROR * CHECKING IS PERFORMED, THE REQUEST IS LINKED * INTO THE APPROPRIATE I/O LIST AT A PRIORITY * LEVEL OF ZERO (HIGHEST PRIORITY), AND CONTROL * IS RETURNED TO THE FIRST WORD FOLLOWING THE * REQUEST CALL. * REQUEST FORMAT: A SYSTEM I/O REQUEST DIFFERS * FROM THE USER I/O REQUEST IN * FORMAT AND POWER. SPECIFICALLY, * A SYSTEM DISC CALL CAN SPECIFY A * SERIES OF TRANSFERS TO BE * PERFORMED BEFORE THE NEXT * OPERATION IS INITIATED. A * COMPLETION ADDRESS CAN BE * SPECIFIED FOR OPERATION OF * AN OPEN SUBROUTINE AT THE * END OF THE OPERATION. THIS * FACILITY IS ONLY AVAILABLE * TO SYSTEM ROUTINES AND IS * USED TO RESET FLAGS, ETC. * BECAUSE AN OPERATION IS * ALWAYS BUFFERED TO THE * SYSTEM. A ZERO COMPLETION * ADDRESS INDICATES ABSENCE * OF A COMPLETION ROUTINE. * WORD * ---- EXT $XSIO * 1 JSB $XSIO * 2 OCT Q * 3 DEF * 4 NOP * 5 OCT * 6 DEF * 7 DEC OR * * DISC VERSION OF REQUEST: * WORD 6 OF REQUEST POINTS TO AN ARRAY * CONTAINING -N- SETS OF TRIPLETS * DECLARING BUFFER ADDRESS, LENGTH AND * TRACK/SECTOR ADDRESS FOR EACH TRANSFER. * THE SET OF TRIPLETS IS OPEN-ENDED AND * TERMINATED BY A ZERO WORD: * * 1 DEF < BUFFER ADDRESS> * 2 DEC < BUFFER LENGTH > * 3 OCT < TRACK/SECTOR #> * . ETC * . . * N DEC 0 (END OF TRIPLETS) * FOR DISC REQUEST THE 7'TH WORD IS THE REQUEST PRIORITY. * * $XSIO NOP CCB ADB $XSIO,I GET LOGICAL UNIT #. STB $CKLO SAVE FOR *STADV* ADB DRT INDEX INTO DRT. LDA B,I GET ASSIGNED EQT ENTRY #. STA TEMPL AND SAVE IT JSB $CVEQ CONVERT TO ABSOLUTE EQT ADDRESSES * LDB $XSIO SET ADDRESS ADB .2 OF LIST POINTER WORD IN STB TEMP1 REQUEST FOR . * LDA TEMPL GET THE SUBCHANNEL WORD AND B174K ISOLATE SUBCHANNEL CLE,INB P+4 IS ADDR OF CONWORD ELA,ALF SIGN TO E ELA,SLA,RAL ADA B20K ADA SIGN ADD 'SYSTEM REQUEST' BIT XOR B,I ADD CONWORD INFO AND SUBCH =B120074 REMOVE EXCESS XOR B,I STA B,I PUT THE RESULT BACK IN THE QUE CLA SET PRIORITY OF REQUEST = 0 STA TEMP2 FOR , STA CONFL SET CONTROL FLAG = 0 (REQUEST). SPC 1 IFN * BEGIN NON-DMS CODE *************** ADB .3 BUMP RETURN ADDR *** END NON-DMS CODE *************** XIF SPC 1 IFZ ***** BEGIN DMS CODE *******-HFB******** ADB .4 BUMP RETURN ADDR ******* END DMS CODE *************** XIF SPC 1 STB $XSIO FOR REGULAR RETURN dH JSB LINK CALL TO LINK REQUEST IN I/O LIST. * SEZ IF DEVICE NOT BUSY JMP $XSIO,I * LDA $CKLO NOT BUSY, JSB STADV LU OR EQT DOWN? RSS YES, GO COMPLETE. * JSB DRIVR CALL DRIVER TO INITIATE OPERATION JMP $XSIO,I -GOOD REQUEST,EXIT * LDB $XSIO BAD NEWS SO TRANSFER THE STB XSIOE RETURN ADDRESS FOR NR ROUTINE * JMP NOTRD PRINT DIAGNOSTIC. SPC 1 XSIOE NOP SUBCH OCT 120074 SUBCHANNEL MASK PLUS SYSTEM RQ CODE HED < I/O CONTROL MODULE - COMPLETION SUBSECTION > * * I/O COMPLETION SUBSECTION * * THIS SECTION IS RESPONSIBLE FOR THE INITIATION * OF STACKED I/O OPERATIONS, PLACING A USER * PROGRAM BACK IN A SCHEDULED STATE WHEN ITS * I/O OPERATION IS COMPLETED, DYNAMIC ALLOCATION * OF THE TWO DMA CHANNELS AMONG SYNCHRONOUS * DEVICES, AND CALLING FOR OPERATOR NOTIFICATION * OF EQUIPMENT MALFUNCTION. * * IS ENTERED DIRECTLY FROM INTERRUPT CONTROL * WHEN AN I/O OPERATION IS TERMINATED AND ALL * ERROR RECOVERY PROCEDURES HAVE BEEN ATTEMPTED. * ON ENTRY TO THIS SECTION, (B) CONTAINS THE * NUMBER OF WORDS TRANSFERRED. THE ADDRESSES OF * THE EQUIPMENT TABLE ENTRY ARE SET IN -EQT1- TO * - EQT 15-. * * REQUESTS ARE STACKED IN LISTS FOR EACH DEVICE * ACCORDING TO PRIORITY. THE REQUESTS ARE EITHER * USER (NORMAL), USER (AUTOMATIC OUTPUT BUFFERING) * OR SYSTEM - IDENTIFICATION OF REQUEST TYPE * THE CODE IN BITS 15-14 OF THE * IN EACH REQUEST CALL. THE FORMATS OF THE THREE * TYPES OF REQUESTS AS THEY APPEAR IN THE I/O * LISTS ARE: * * 1) USER (NORMAL OPERATION) T=0 * * THE PARAMETERS FROM THE REQUEST ARE STORED * IN THE TEMPORARY AREA OF THE PROGRAM ID * SEGMENT. THE LINK WORD OF THE SEGMENT IS * USED TO LINK INTO THE I/O LIST. * * WORD CONTENTS * ---- -------- * 1 < LINKAGE WORD A > * 2 * 3 * 4 * 5 * 6 * 7 * . -REMAINDER OF ID SEGMENT . * * SKP * 2) USER (AUTOMATIC OUTPUT BUFFERING) T=1 * * REQUESTS OF THIS TYPE ARE CONSTRUCTED * IN THE SECTION OF SYSTEM AVAILABLE MEMORY. * * WORD CONTENTS * ---- -------- * 1 < LINKAGE WORD > * 2 * 3 * 4 * 5 * 6 * 7 * 8 * . . . . * . . . . * N+7 * * 3) USER (CLASS INPUT/OUTPUT) T=3 * * REQUESTS OF THIS TYPE ARE CONSTRUCTED * IN THE SECTION OF SYSTEM AVAILABLE MEMORY. * * WORD CONTENTS * ---- -------- * 1 < LINKAGE WORD > * 2 * 3 (CHANGED TO STATUS AT COMP.) * 4 * 5 * 6 (CHANGED TO TLOG AT COMP.) * 7 * 8 * 9 * . . . . * . . . . * N+8 * * * 4) SYSTEM REQUEST T=2 * * THE SYSTEM REQUEST IS LINKED INTO * THE I/O LIST BY USING WORD 4 OF THE * CALL AS A LINK WORD. A SYSTEM * REQUEST ASSUMES THE PRIORITY LEVEL * OF ZERWNO (HIGHEST PRIORITY). * * WORD CONTENTS * ---- -------- * 1 < JSB $XSIO > * 2 < LOGICAL UNIT # > * 3 * 4 < LINKAGE WORD > * 5 * 6 * 7 * 8 * * THE FIELD (BITS 15-14 IN CONTROL WORD) * IDENTIFIES THE REQUEST TYPE AS: * * 00 USER (NORMAL OPERATION) * 01 USER (AUTOMATIC BUFFERING) * 10 SYSTEM * 11 CLASS I/O * * SKP IOCOM RAL,CLE,ERA CLEAR THE SIGN BIT AND SAVE IN E STA TEMP3 SAVE STATUS FROM DRIVER AND STB TLOG TRANSMISSION LOG STB XLOG SPC 1 IFZ ***** BEGIN DMS CODE ************** JSB $RSM GO RESTORE USER MAP IF NECESSARY ******* END DMS CODE ************** XIF SPC 1 * CLA CLEAR STA EQT15,I CLEAR TIME-OUT CLOCK * LDA EQT4,I SET THE COMPLETION SECTION FLAG STA CONFL AND TEST FOR DMA RETURN SEZ,RSS SIGN OF A IS EXPLICID RETURN OF SSA DMA CHANNEL, CALL TO JSB CLDMA RELEASE ITS ASSIGNMENT. * L.49 LDB EQT1,I GET CONTROL WORD FROM CLE,SZB,RSS IF ILLEGAL ENTRY JMP CIC.4 SEND ERROR MESSAGE * SSB,INB JMP L.502 CLEAN UP IF CLEAR COMPLETION * STB IOE11 SAVE ADDR OF CONTROL WORD FOR *IOERR* LDA B,I EXTRACT FIELD. STA TEMP0 SAVE CONTROL WORD. LDB EQT1,I LDA TEMP3 CPA .1 ERROR? JMP NOTRD YES, GO PROCESS * LDA B,I STA EQT1,I UNLINK CURRENT I/O REQUEST LDA TEMP0 RAL,SLA,ELA IF BIT 15 = 1 ( = 2 OR 3) JMP L.53 PROCESS AS SYSTEM REQUEST. * SEZ,RSS IF = 0u, PROCESS JMP L.51 AS NORMAL USER REQUEST. * * RELEASE AUTOMATIC BUFFERING BLOCK * LDA TEMP3 BY PASS RELEASE OF SZA BUFFER IF MALFUNCTION STB EQT1,I SZA JMP L.70 * STB L.50 ADB .3 LDB B,I BLOCK LENGTH AND STB L.50+1 SET IN RELEASE CALL. * JSB $RTN RELEASE BLOCK TO AVAILABLE MEM. L.50 NOP - BLOCK ADDRESS - NOP - BLOCK LENGTH - L.501 JSB $CKLO CHECK IF BELOW THE LIMIT JMP L.54 THEN GO START THE NEXT REQUEST * L.502 ADB C100K SUBTRACT ONE AND SIGN BIT STB EQT1,I RESET IN THE EQT AND JMP L.55 GO START THE NEXT RQ. * * NORMAL USER OPERATION COMPLETION * L.51 STB L.52 SET CURRENT ADDR. FOR SCHEDULER. ADB .9 SET (B) = ADDR. OF XA IN ID SEG. LDA TEMP3 GET COMPLETION STATUS CLE,SZA SET BIT 14 CCE IN STATUS WORD LDA EQT5,I IF THE STATUS RAL,RAL IS NON-ZERO ERA,CLE,ERA AND SAVE IN USER A-REG. STA B,I CONTENTS OF PROGRAM. INB STB TEMP9 SAVE TRANSMISSION LOG ADDRESS LDA TLOG SET TRANSMISSION LOG AS STA B,I SAVED B-REGISTER. * ADB .5 INDEX TO THE STATUS WORD LDA B,I AND SAVE FOR STA TEMPX DISC ERROR ROUTINE * JSB $LIST CALL SCHEDULER MODULE TO PLACE OCT 101 USER PROGRAM INTO L.52 NOP LIST. JMP L.54 * * SYSTEM REQUEST COMPLETION * L.53 SEZ,CLE COMPLETION FOR JMP L.56 CLASS I/O REQUEST * ADB N1 GET WORD 3 OF REQUEST LDA B,I . STA COMPL SAVE COMPLETION ADDR. OR ZERO. * SKP * < L.54 > : AT THIS POINT: * 1) A TEMPORARY BUFFER HAS BEEN RELEASED, * 2) A NORMAL OPERATION HAS CAUSED THE * REQUESTING PROGRAM TO BE LINKED * [ BACK INTO THE LIST, OR * 3) A SYSTEM REQUEST COMPLETION ADDRESS * HAS BEEN SAVED. * L.54 LDA TEMP3 DON'T START NEXT OPER. IF ERROR CMA,SSA,INA,SZA OCCURRED ON COMPLETION OR JMP L.70 ON CLASS I/O INITIATION * * L.55 LDA EQT5,I CHECK FIELD. RAL SSA IF AV SAYS DOWN JMP IOCX GO EXIT * * SECTION <60> PROVIDES FOR INITIATING THE NEXT * OPERATION WAITING FOR THE COMPLETED DEVICE. * L.60 LDA EQT5,I SET ALR,RAR FIELD STA EQT5,I = 0 TO SAY AVAILABLE. JMP L.68 GO START THE NEXT REQUEST * L.56 LDA TLOG (A) = TRANSMISSION LOG JSB $C.CL (B) = CLASS QUEUE POINTER DEF TEMP3 DEVICE STATUS JMP L.501 GO DO NEXT ONE * * .1 DEC 1 .2 DEC 2 .4 DEC 4 .6 DEC 6 .7 DEC 7 .15 DEC 15 .11 DEC 11 * * CHECK IF BELOW THE BUFFER LIMIT ON THE CURRENT EQT. * $CKLO NOP LDB $BLLO CHECK IF BELOW THE LIMIT. JSB $QCHK JMP $CKLO,I NO, SO RETURN. * LDA B YES, SO SCHEDULE ANY WAITERS JSB $SCD3 AND JMP $CKLO,I RETURN. SKP * * THIS DEVICE IS COMPETING WITH OTHER DEVICES FOR * THE USE OF THE AVAILABLE DMA CHANNEL. THE * FIELD IN THE CURRENT ENTRY IS SET = 3 TO MEAN * WAITING FOR DMA. THE EQT IS THEN SCANNED FROM * FIRST TO LAST ORDER (#1 TO N) TO FIND THE FIRST * UNIT WAITING FOR DMA. THEREFORE, THE ORDER OF * THE EQT DETERMINES PRIORITY FOR DYNAMIC ASSIGN- * MENT OF DMA CHANNELS - THE SYSTEM DISC SHOULD * BE THE FIRST ENTRY IN THE EQT. * L.63 LDA EQT# SET # OF CMA,INA EQT ENTRIES STA TEMP1 AS AN INDEX VALUE. LDB EQTA INITIALIZE TO FIRST EQT ENTRY. * L.64 STB TEMP2 SAVE CURRENT ENTRY ADDR. ADB .4 EXTRACT LDA B,I FIELD FROM RAL WORD 5. SSA,SLA IFz8 A = 3, GO TO JMP L.66 ASSIGN DMA. * L.65 ADB .11 SET (B) FOR NEXT ENTRY. ISZ TEMP1 END OF EQT? JMP L.64 - NO, CONTINUE SCAN * CCA DECREMENT THE DMA COUNT ADA DMACF (MUST HAVE ABORTED A DMA STA DMACF WAIT WITH 'OF,XXX,1' REQUEST) JMP IOCX EXIT * L.66 CLA,INA IF ONLY 1 DEVICE WAITING CPA DMACF FOR DMA, GO TO JMP L.67 ASSIGN TO THIS DEVICE. * LDA TEMP2 IF CURRENT UNIT IS CPA EQTA FIRST IN EQT (I.E SYSTEM DISC) JMP L.67 ASSIGN ANYWAY. * CPA EQT1 IF SAME DEVICE JUST COMPLETED, JMP L.65 ALLOW OTHER DEVICES DMA TIME. * L.67 LDA TEMP2 IF DEVICE TO BE INITIATED IS CPA EQT1 SAME AS INTERRUPTING DEVICE, RSS SKIP SETTING EQT ADDRESSES. * JSB $ETEQ SET EQT ADDRESSES. * * CALL IF A REQUEST IS STACKED OR A * WAITING UNIT IS ASSIGNED A DMA CHANNEL. * L.68 LDA EQT1 GO CLEAN OUT ANY CPA $DMEQ I/O REQUESTS IF THIS JMP IOCX7 IS THE BIT BUCKET * LDB EQT1,I IF NO REQUEST SZB,RSS WAITING, JMP IOCX EXIT. * JSB DRIVR CALL RSS IF GOOD REQUEST THEN SKIP JMP NOTRD DIAGNOSTIC IF NOT AVAILABLE. SKP * **************************************************************** * * I/O COMPLETION - EXIT SECTION. * * THIS ROUTINE FIRST CHECKS FOR A DMA QUEUE AND IF ANY AND IF A * CHANNEL IS AVAILABLE, THEN THE CHANNEL ASSIGNMENT ROUTINE * IS ENTERED. IF THIS CONDITION DOES NOT EXIST, THEN * IF THE "BIT BUCKET FLAG" IS SET, THEN THE BIT BUCKET * I/O REQUEST ARE CLEANED OUT. IF THE FLAG IS NOT SET, THEN * IF THE REQUEST IS A SYSTEM REQUEST WITH A COMPLETION ADDRESS, * THEN CONTROL IS TRANSFERED TO THE COMPLETION ADDRESS. IF * NEITHER OF THESE CONDITIONS EXITS, THEN THE OPERATOR ATTENTION _ * FLAG IS CHECKED. IF SET, THEN THE OPERATOR ACKNOWLEDGEMENT * ROUTINE IS ENTERED. IF NOT SET, THEN CONTROL IS RETURNED * TO THE SYSTEM. * ***************************************************************** * IOCX LDA DMACF GET THE DMA QUEUE FLAG SZA,RSS IF EMPTY QUE THEN JMP IOCX1 GO EXIT * DLD INTBA,I ELSE GET THE DMA FLAGS SZA IF ANY SZB,RSS AVAILABLE JMP L.63 GO ALLOCATE IT. * IOCX1 LDB $BITB CHECK THE "BIT BUCKET FLAG" TO SEE SZB TO SEE IF THE BIT BUCKET MUST BE JMP IOCX0 CLEANED OUT. * LDA COMPL IF SYSTEM REQUEST STB COMPL CLEAR COMPLETION SPECIFICATION. LDB XLOG SZA COMPLETION ROUTINE SPECIFIED, JMP A,I OPERATE IT. * LDB OPATN GET OPERATOR ATTENTION FLAG STA OPATN - CLEAR FLAG - SZB IF OPERATOR DESIRES CONTROL, JMP $TYPE ACKNOWLEDGE. JMP $XEQ OTHERWIZE, RETURN TO THE DISPATCHER. * XLOG NOP SKP * * * CLEAN OUT BIT BUCKET REQUESTS. * * IOCX0 LDA $DMEQ SET UP THE BIT JSB $ETEQ BUCKET EQT ADDRESSES. IOCX7 LDB EQT1,I CHECK IF THERE IS ANY SZB,RSS I/O REQUEST TO BE JMP IOCX9 INITIATED ON THE BIT BUCKET. * LDB EQT1,I YES, SO GET THE REQUEST'S ADB .3 SIZE AND DO AN IMMEDIATE LDB B,I COMPLETION. JMP L.136 * IOCX9 STB $BITB NO, SO CLEAR BIT BUCKET FLAG AND JSB $CKLO CHECK BUFFER LIMITS AND SCHED.WAITERS. JMP IOCX1 * $BITB NOP BIT BUCKET FLAG. DO NOT TOUCH. SKP * * I/O DEVICE COMPLETION ERROR FROM DRIVER * (A) = ERROR CODE * L.70 LDA TEMP3 CPA .3 IF PARITY ERROR, CCE,RSS CHECK FOR DISC. JMP IOERR - OTHER ERROR CONDITION - * LDA EQT5,I IF AND B36K DEVICE CPA B14K 8IS DISC, PUT JMP DISCE OUT SPECIAL MESSAGE. * LDA .3 PARITY ERROR ON JMP IOERR OTHER DEVICE, PRINT DIAG. * * * DISC ERROR PROCESSING (SYSTEM/USER) * DISCE LDA TLOG (A) = ERROR TRACK ADDRESS. JSB $CVT3 CONVERT TO DECIMAL ASCII. INA DLD A,I SET DECIMAL TRACK DST DMSG+1 IN ERROR MESSAGE. JSB CPEQT COMPUTE EQT ENTRY # (SETS E). JSB $CVT1 STA DMSG+5 SET IN ERROR MESSAGE. * LDA EQT4,I GET SUBCHANNEL ALF,ALF AND CONVERT RAL,RAL TO ASCII AND B37 JSB $CVT1 STA DMSG+7 * * LDA EQT1 SAVE DISC STA TEMP7 -EQT- ADDRESS LDA COMPL SAVE REQUEST (SYSTEM) STA TEMP8 COMPLETION ADDRESS * LDA DMSGA PRINT DIAGNOSTIC: JSB $SYMG "TRNNNN EQTXX,UYY U" * * LDA L.52 (A)= ID SEGMENT ADDRESS LDB TEMPX GET THE SAVED STATUS AND IF NO-ABORT SET SSB,RSS SKIP THE ABORT JSB $ABRT -- ABORT PROGRAM -- * STB TLOG SET TLOG FOR SYSTEM EXIT LDA TEMP8 RESET "COMPLETION" STA COMPL ADDRESS. LDA TEMP7 RESET EQT STA CONFL SET FLAG FOR COMPLETION. JSB $ETEQ ADDRESSES JMP L.60 * * DMSGA DEF *+1 DEC -18 DMSG ASC 9,TRNNNN EQTXX,UYY U BLS ASC 1, S B36K OCT 36000 HED < I/O CONTROL MODULE - ERROR SECTION > * * I/O REQUEST ERROR SECTION * * PART 1: ERRORS ENCOUNTED IN ANALYSING A * USER REQUEST CAUSE A DIAGNOSTIC * TO BE PRINTED ON THE SYSTEM * TELETYPEWRITER AND THE USER * PROGRAM ABORTED. THE FORMAT OF * THE DIAGNOSTIC IS: * * 'IONN PNAME RADDR' * * AS CONSTRUCTED AND SET * BY THE ROUTINE -$ERMG- IN * THE PROGRAM <$RQST>. -NN- IS A * CODE IDENTIFYING THE ERROR TYPE. * ERR01 CLB,INB INSUFFICIENT # OF PARAMETERS RSS ERR02 LDB .2 ILLEGAL LOGICAL UNIT REFERENCE, RSS = 0 OR UNDEFINED. ERR04 LDB .4 USER BUFFER VIOLATES SYSTEM * LDA ERIO (A) = ASCII * IO *. JMP $ERAB WRITE DIAGONISTIC AND EXIT TO DISPATCHER * ERIO ASC 1,IO SKP * PART 2: ILLEGAL REQUEST DETECTED BY * I/O DRIVER. THE REASON IS A READ OR * WRITE OPERATION IS ILLEGAL FOR THE * DEVICE OR A CONTROL REQUEST IS * MEANINGLESS FOR THE DEVICE. * AN ADDITIONAL REASON FOR TRANSFER TO THIS * SECTION IS AN "IMMEDIATE COMPLETION" (CODE 4) * RETURN FROM THE DRIVER; PROCESSED AS A * CONTROL REJECT. * * * ERROR PROCEDURE IS: * 1. IF THE REQUEST IS PROCESSED AS * BUFFERED OUTPUT, THE TEMPORARY * BLOCK IS RELEASED TO AVAILABLE * MEMORY. * * 2. THE REJECT IS IGNORED IF A SYSTEM * PROGRAM GENERATED THE REQUEST - * HOWEVER, A COMPLETION ROUTINE, * IF SPECIFIED IN THE REQUEST, IS * OPERATED. (NOTE: THIS PHILOSOPHY * IS BASED ON THE ASSUMPTION THAT * THIS CONDITION SHOULD NEVER OCCUR.) * * 3. A USER CONTROL REQUEST WHICH IS * REJECTED IS TREATED AS IF IT * WAS PERFORMED. THE PROGRAM IS * LINKED BACK INTO THE SCHEDULE LIST. * * 4. A USER READ OR WRITE REQUEST REJECT * CAUSES A DIAGNOSTIC TO BE ISSUED * AND THE PROGRAM ABORTED. SKP ILLCD CLB CPA .4 IF CODE =4 FOR IMMEDIATE RAR,SLA COMPLETION, TREAT AS CONTROL R00 STB TLOG ELSE SET TLOG TO 0. STA TEMP4 REJECT, SAVE CODE. CPA .2 SET ERROR FLAG FOR CLA CLASS COMPLETION = 0 CMA,INA NEGATE STATUS TO SKIP STA TEMP3 MESSAGE FOR CONT.REJ LDB EQT1,I GET LOCATION OF LDA B,I ILLEGAL REQUEST (LINK ADDR.) STA TEMP0 SAVE NEXT REQUEST ADDRESS. INB GET CONTROL WORD LDA B,I OF REQUEST BLOCK STA EQT6,I SAVE FOR REXIT RAL CHECK FIELD SSA,RSS FOR TYPE OF REQUEST BLOCK. JMP R02 -USER OR SYSTEM- * CCE,SLA IF CLASS REQUEST (SET E=1) JMP L.49 GO DO CLASS COMPLETION. * ADB .2 BUFFERED BLOCK. LDB B,I GET TOTAL BLOCK LENGTH. STB R01+1 SET IN RELEASE CALL. LDA EQT1,I SET FWA OF BLOCK STA R01 IN RELEASE CALL. JSB $RTN RELEASE BLOCK. R01 NOP - FWA - NOP - # WORDS - JMP REXIT * R02 SLA,RSS CHECK FIELD AGAIN. JMP R03 -USER PROGRAM REQUEST- * ADB N2 GET WORD IN SYSTEM REQUEST LDA B,I CONTAINING -COMPLETION ROUTINE- STA COMPL ADDRESS OR 0 AND SAVE IT. JMP REXIT * R03 LDA TEMP4 USER REQUEST- CPA .2 CONTINUE IF CONTROL REQUEST JMP R04 REJECTED. * LDA EQT1,I SET ID SEGMENT ADDRESS OF PROGRAM STA XEQT CONTAINING ERROR. ADA .8 GET POINT OF SUSPENSION ADDRESS LDB A,I GET RETURN ADDRESS STB RQRTN AND SAVE ON BASE PAGE CCE,INA SET XSUSP STA XSUSP TO POINT TO SAVED INITIAL CALL ADDRESS LDA EQT1 SAVE CURRENT STA TEMP9 EQT ENTRY ADDRESS. LDA CONFL SAVE CURRENT STA SCONF *CONTROL FLAG* LDA TEMP4 ALLOW FOR FUTURE ERROR CODES CPA .1 WHICH MAY BE >4 LDA .7 ALL OTHER CODES CHANGED TO 7 JSB $CVT1 AND CONVERTED TO ASCII LDB A LDA ERIO (A) = ASCII * IO * JSB $ERMG PRINT DIAGNOSTIC CLA SET XEQT STA XEQT TO ZERO TO FOURCE RELOAD LDA SCONF RESTORE STA CONFL *CONTROL FLAG* LDA TEMP9 RESTORE UNIT JSB $ETEQ EQT ENTRY ADDRESSES. JMP REXIT * R04 LDA EQT1,I SET PROGRAM ID SEGMENT STA R05+2 ADDR. IN LIST CALL. ADA .9 (A) = ADDR. OF XA IN ID SEGMENT. LDB EQT5,I SET DEVICE STATUS STB A,I WORD IN XA. LDB TLOG STORE INA TRANSMISSION LOG STB A,I IN XB. R05 JSB $LIST CALL SCHEDULER OCT 101 TO LINK PROGRAM BACK NOP INTO SCHEDULE LIST. * REXIT LDA TEMP0 SET NEXT LIST STA EQT1,I ENTRY ADDRESS. LDA EQT6,I GET CONWORD REXI2 CLB STB TEMP3 CLEAR ERROR FLAG CPB CONFL COMPLETION SECTION SSA,RSS OR NON-$XSIO CALL? JMP L.501 YES, GO TO L.60 TO DO NEXT REQUEST * JMP $XSIO,I $XSIO ERROR RETURN * * SKP * ********************************************************************** * * I/O DEVICE ERROR SECTION * * THIS SECTION IS ENTERED WHEN A DEVICE IS UNAVAILABLE FOR * INITIATION OF AN OPERATION OR WHEN AN ERROR IS DETECTED AT THE * END OF AN OPERATION. A DIAGNOSTIC MESSAGE IS PRINTED ON THE * SYSTEM CONSOLE IN THE FOLLOWING FORMAT: * * I/O MN LXX EYY SZZ * * WHERE: XX = THE LOGICAL UNIT NUMBER OF THE DEVICE * YY = THE EQT NUMBER OF THE DEVICE * ZZ = THE SUBCHANNEL NUMBER OF THE DEVICE * MN = A MNEMONIC DESCRIBING ONE OF THE FOLLOWING CONDITIONS: * 1. NR - DEVICE IS NOT READY * 2. ET - END-OF-TAPE OR TAPE SUPPLY LOW ON THE DEVICE * 3. PE - TRANSMISSION PARITY ERROR TO/FROM THE DEVICE * 4. TO - THE DEVICE TIMED OUT * -- NEW CODES MAY BE ADDED HERE -- * * GIVEN A BAD I/O REQUEST, IOERR WILL DOWN ALL LU'S ASSOCIATED WITH * THE DEVICE(DEFINED BY THE EQT AND SUBCHANNEL). ALL I/O CHANNELS * ASSOCIATED WITH THE EQT ARE CLEARED. ALL I/O REQUESTS ASSOCIATED * WITH THE DEVICE ARE BHFBUNSTACKED FROM THE EQT'S I/O REQUEST QUEUE AND * RELINKED IN THE LOWEST LU'S(MAJOR LU) I-O REQUEST QUEUE(DRT ENTRY * WORD 2)BY THE SUBROUTINE UNLNK. DRT ENTRY WORD 2 OF OTHER DOWNED * LU'S ARE SET TO THE LU NUMBER OF THE MAJOR LU. THE LU DOWN BIT(BIT * 15 OF DRT ENTRY WORD 2)FOR EACH DOWNED LU IS SET. THE EQT ENTRY IS * NOT SET DOWN. I/O ERROR MESSAGES ARE ISSUED FOR ALL LU'S SET DOWN. * * ON ENTRY, CONTAINS A NUMBER CORRESPONDING TO THE ASSOCIATED * MNEMONIC AND EQT1 CONTAINS THE ADDRESS OF WORD ONE OF THE ASSOCIATED * DEVICE'S EQT ENTRY. * * THE FOLLOWING TEMPORARY LOCATIONS ARE USED FOR TEMPORARY STORAGE BY * IOERR: * :=SUBCHANNEL-EQT WORD FOR THE BAD I-O REQUEST GIVING THE * SUBCHANNEL IN BITS 11-15 AND THE EQT IN BITS 0-5(USED BY * LUERR). * :=WORD 2 OF THE BAD I-O REQUEST. * ********************************************************************** * SKP NOTRD LDB EQT1,I LU NOT READY ENTRY. INB GET BAD I/O REQ.CONTROL WORD STB IOE11 & SAVE ADDR FOR *IOERR* CLA,INA NOT READY, SET (A)=1 * IOERR LDB EQT1 STB HEAD REMOVE ALL RELATED ENTRIES IN QUEUE * WUH ADA ERTBL INDEX TO ERROR CODE TABLE. LDA A,I GET MNEMONIC AND SET STA IOMSG+2 IN DIAGNOSTIC MESSAGE. * LDA BLL SET UP STA IOMSG+3 "L" AND LDA BLS "S" IN THE STA IOMSG+7 DIAGNOSTIC MESSAGE. * JSB CPEQT GET EQT NUMBER(SETS E=1). STA TEMP8 SAVE EQT NUMBER. JSB $CVT1 CONVERT TO ASCII STA IOMSG+6 AND SAVE(E MUST = 1). * LDA EQT4,I GET LAST SUBCH USED FROM EQT4 ALF,RAL AND POSITION TO HIGH 5 BITS AND B174K MASK OUT LOWER 11 BITS IOR TEMP8 AND ADD IN EQT NUMBER. STA TEMP8 SAVE AS SUBCHANNEL-EQT WORD. * ALF,RAL GET SUBCHANNEL AND B37 NUMBER. JSB $CVT1 CONVERT TO ASCII(ON ENTRY,E MUST=1) STA IOMSG+8 AND SAVE. * JSB LUERR DOWN THE LOGICAL UNITS(ENTRY A#0). LDA EQT5,I SET AVAIL TO 0 AFTER LUERR CALL ALR,RAR SO WE WON'T ENTER DRIVER TO PRINT STA EQT5,I ERROR IF DRIVER STILL BUSY (IF SAME) SEZ CHECK IF WE TRIED TO JMP IOER9 DOWN LU 1. IGNORE ATTEMPT. * * LDA EQT1 LDB A,I CHECK IF WE MUST SZB INITIATE AN JSB $DLAY I/O REQUEST OF THIS EQT. * LDB IOE11,I GET SAVED WORD 2(CONWORD) LDA CONFL FOR THE BAD I/O REQUEST. SZA IF COMPLETION SECTION IS IN JMP IOCX CONTROL, THEN EXIT IOC. * RBL,SLB IF REQUEST SECTION IN CONTROL, SSB CHECK IF USER OR SYSTEM I/O REQUEST. JMP IOCX IF USER, GO TO EXECUTION SECTION. JMP XSIOE,I IF SYSTEM, RETURN TO SYSTEM CALLER. * IOER9 LDA CONFL SAVE CONTROL STA SCONF FLAG. CLA,INA SET JSB $CVT1 ASC11 1 STA IOMSG+4 INTO MESSAGE. JSB $SYMG ISSUE MESSAGE. LDA SCONF RESTORE FLAG. STA CONFL JMP L.60 * * * IOMSA DEF *+1 `; DEC -18 IOMSG ASC 9,I/O MN LXX EYY SZZ * * * * I/O DEVICE ERROR MNEMONIC TABLE--ORDERED BY * ERROR CODE DESCRIBING CONDITION. * ERTBL DEF * ASC 1,NR - NOT READY - ASC 1,ET - END OF TAPE (INFORMATION) - ASC 1,PE - TRANSMISSION PARITY ERROR - ASC 1,TO - TIMED-OUT - * * NEW CODES MAY BE ADDED AT THIS POINT * SBMSK OCT 20074 MASK TO SAVE SUBCHANNEL BITS BLL ASC 1, L HEAD NOP IOE11 NOP * SKP * ***************************************************************** * * SUBROUTINE LUERR * * THIS SUBROUTINE IS USED TO DOWN ALL LU'S CORRESPONDING TO A * SPECIFIC EQT AND SUBCHANNEL. IT WILL OPTIONALLY PRINT AN * ERROR MESSAGE FOR EACH DOWNED LU. * * CALLING SEQUENCE: * :=0 DO NOT PRINT I/O ERROR MESSAGES * :#0 PRINT I/O ERROR MESSAGES(ASSUMES ASCII EQT AND * SUBCHANNEL ALREADY SET) * := POINTER TO I/O REQUEST LIST TO SCAN. * :=SUBCHANNEL-EQT WORD FROM THE BAD I-O REQUEST. * JSB LUERR * * RETURN: * :=1 TRIED TO DOWN LU 1 * :=0 DID NOT TRY TO DOWN LU 1 * NO REGISTERS ARE SAVED. * SUBROUTINE UNLNK USES TEMP0 AND OTHERS. * USES THE FOLLOWING REGISTERS: * :=FLAG AS TO WHETHER TO PRINT(#0) OR NOT PRINT(=0) * I/O ERROR MESSAGES. * :=USED TO STORE THE MAJOR LU. * :=COUNTER FOR SCAN THROUGH DRT. * :=USED TO SAVE POINTER INTO DRT. * :=USED TO SAVE EQT1. * :=USED TO STORE LU TEMPORARILY. * ****************************************************************** * LUERR NOP STA TMP1 * LDA CONFL SAVE CURRENT STA SCONF CONTROL FLAG. * CLA SET MAJOR LU STA TMP2 TO ZERO. * LDA LUMAX SET CMA,INnA UP STA TMP3 COUNTER. LDB DRT GET FIRST DRT ENTRY. * SKP D.00 LDA B,I GET DRT WORD 1 STB TMP4 SAVE POINTER IN DRT. AND C3700 COMPARE DRT WORD 1 TO THE SUBCHANNEL- CPA TEMP8 EQT WORD(LESS THE LOCK FLAG). RSS IF EQUAL,FOUND A LU,SO GO PROCESS. JMP D.04 OTHERWIZE,GO CONTINUE SCAN OF DRT. * LDA LUMAX FOUND A LU MATCH SO PROCESS IT. CCE,INA COMPUTE THE(SET E=1 FOR POSSIBLE LU=1) ADA TMP3 LU NUMBER. STA TMP8 SAVE LU NUMBER FOR LATER. CPA .1 CHECK TO SEE IF SYSTEM CONSOLE. IF SO, JMP D.06 DO NOT SET THE DEVICE DOWN. ADB LUMAX POSITION POINTER TO DRT WORD 2. LDA TMP2 CHECK TO SEE IF A MAJOR SZA LU HAS BEEN FOUND JMP D.02 IF SO,THEN STORE THE MAJOR LU # IN WORD * 2,SET THIS LU BUZY,ISSUE MESSAGE. * STB A SAVE DRT WORD 2 ADDRESS. LDB EQT1 SAVE EQT1 ADDRESS STB TMP6 FOR RESTORATION. LDB HEAD GO UNLINK ANY I/O REQUESTS JSB $UNLK FROM GIVEN I-O QUEUE DEF TEMP8 LDA TMP8 SAVE THIS LU STA TMP2 AS MAJOR LU. LDB TMP4 RESTORE POINTER TO DRT WORD 2. ADB LUMAX LDA B,I D.02 CCE RAL,ERA SET THE(E MUST=1) STA B,I LU BUZY. LDB TMP1 CHECK IF WE ARE TO PRINT ERROR CCE,SZB,RSS MESSAGES(SET E=1 FOR $CVT1). JMP D.025 NO, SO SKIP. * LDA TMP8 JSB $CVT1 CONVERT LU TO STA IOMSG+4 ASCII AND SAVE. LDA IOMSA GET LU I/O ERROR MESSAGE JSB $SYMG AND ISSUE TO USER. LDA TMP6 RESTORE JSB $ETEQ EQT POINTERS. D.025 LDB TMP4 * D.04 INB INCREMENT POINTER TO NEXT DRT ENTRY. ISZ TMP3 JMP D.00 GO SCAN NEXT ENTRY. * JSB $CKLO CHECK BUFFER LIMITS AND SCHED WAITERS. CLE D.06 LDA SCONF RESTORE CONTROL STA CONFL FLAG. JMP LUERR,I IF NO MORE LU ENTRIES, RETURN. SKP * *********************************************************************** * * SUBROUTINE $UNLK * * THIS SUBROUTINE IS USED TO UNLINK I/O REQUESTS FROM THE EQT I/O * REQUEST QUEUE POINTED TO BY EQT1. IT MAY BE USED IN ONE OF TWO * MODES: * MODE I. IF ON ENTRY THE A REGISTER EQUALS ZERO, NORMAL USER * (UNBUFFERED)I-O REQUESTS ARE UNLINKED WITH THE CALLING * PROGRAMS SUSPENDED IN THE GENERAL WAIT LIST. IT IS * ASSUMED THAT THE EQT WILL BE SET DOWN BY THE CALLER. * MODE II. IF ON ENTRY THE A REGISTER IS NONZERO, THEN ONLY I/O * REQUESTS MATCHING THE SUBCHANNEL GIVEN IN SUEQT ARE * UNLINKED. UNBUFFERED I/O REQUESTS ON THIS SUBCHANNEL ARE * HANDLED AS IN MODE I. BUFFERED, CLASS AND SYSTEM * I/O REQUESTS ARE STACKED UPON AN LU I/O REQUEST QUEUE AFTER * THE I/O REQUEST POINTED TO BY THE A REGISTER IN THE ORDER * THAT THEY APPEARED IN THE EQT QUEUE. * * CALLING SEQUENCE: * :=THE SUBCHANNEL-EQT WORD DEFINING THE DEVICE(MODE II * ONLY, UNUSED WITH MODE I). * :=EQT1(HEAD OF THE I-O REQUEST QUEUE)OF THE DEVICE'S * EQT(USED WITH MODE I AND II). * :=0 INDICATES MODE I PROCESSING. * :#0 INDICATES MODE II PROCESSING. POSITION IN LU I/O REQUEST * QUEUE AFTER WHICH ALL UNLINKED I-O REQUESTS ARE * TO BE RELINKED. * JSB $UNLK * DEF SUEQT * * RETURN: * NO REGISTERS ARE SAVED. * USES UNLK3,UNLK8,UNLK9,TEMPX,TEMP0 * ************************************************************************ SKP $UNLK NOP STA UNLK8 SET UP POINTER TO THIS I/O REQUEST QUEUE. SPC 1 IFZ j****** BEGIN DMS CODE *************** RSA SAVE MEU RAL,RAL STATUS. STA UNLKS ******* END DMS CODE *************** XIF SPC 1 LDA $UNLK,I GET LDA A,I SPC 1 IFZ ***** BEGIN DMS CODE *************** SJP *+2 ******* END DMS CODE *************** XIF SPC 1 AND B174K SUBCHANNEL CLE,ELA AND SHIFT RAL,RAL UPPER BIT ALF TO BIT 13 SEZ ADD IN LOWER 4 BITS ADA B20K AT BITS 2-5 STA TEMP0 AND SAVE. RSS * UNLK0 LDB TEMPX,I GET NEXT ENTRY. STB TEMPX SAVE POINTER TO PREVIOUS REQUEST. UNLK2 LDB TEMPX,I GET POINTER TO THIS REQUEST. RBL,CLE,ERB STRIP OFF POSSIBLE SIGN BIT. SZB,RSS IF END, JMP UNLK6 THEN GO EXIT. * STB UNLK3 SAVE POINTER TO THIS REQUEST. INB STEP TO CONTROL WORD OF THIS REQUEST. LDA UNLK8 CHECK IF MODE I OR II PROCESSING. SZA,RSS JMP UNL25 MODE I SO SKIP SUBCHANNEL CHECK. * LDA B,I GET CONTROL WORD OF THIS REQUEST. AND SBMSK PICK OFF SUBCHANNEL INFORMATION AND CPA TEMP0 COMPARE TO THE SUBCHANNEL INFO OF RSS THE BAD I/O REQUEST. IF NOT EQUAL, JMP UNLK0 GO CHECK THE NEXT I-O REQUEST. * UNL25 LDA B,I GET CONTROL WORD OF THIS I/O RAL REQUEST AND ROTATE IT. CMA,SSA,SLA,RSS IF NOT STANDARD USER REQUEST, JMP UNLK4 GO PROCESS AS OTHER TYPES. * LDA .4 STANDARD USER, SO SUSPEND PROGRAM STA B,I IN GENERAL WAIT LIST. ADB .8 SET TEMP WORD #1 IN ID-SEG.TO 4. LDA B,I STEP TO SAVE A REG., GET SAVED ADB N1 POINT OF SUSPENSION, AND STORE STA B,I IT IN XSUSP FOR THIS PROGAM. LDA UNLK3,I UNLINK THIS I/O REQUEST STA TEMPX,I JSB $LIST LINK+ THIS PROGRAM INTO THE OCT 103 GENERAL WAIT LIST. UNLK3 NOP UNL35 JMP UNLK2 GO TRY NEXT ENTRY. * UNLK4 LDA UNLK8 CHECK IF MODE I OR II. SZA,RSS IF MODE I, DO NOT UNLINK JMP UNLK0 THIS REQUEST. GO TRY NEXT ONE. * LDB UNLK8,I IF MODE II, CLEAR RBL,CLE,ERB POSSIBLE SIGN BIT LDA UNLK3,I AND LINK THIS I-O STB UNLK3,I REQUEST TO THE LDB UNLK3 END OF THE DOWN STB UNLK8,I I/O REQUEST QUEUE. STB UNLK8 SET UNLK8 TO POINT TO THE LAST REQUEST. STA TEMPX,I (DO STA LAST, JUST IN CASE) JMP UNL35 GO TRY NEXT ENTRY. * UNLK6 ISZ $UNLK SPC 1 IFN * BEGIN NON-DMS CODE *************** JMP $UNLK,I INITIATE THE I/O REQUEST. *** END NON-DMS CODE *************** XIF SPC 1 IFZ ***** BEGIN DMS CODE *************** JRS UNLKS $UNLK,I INITIATE THE I/O REQUEST. * UNLKS NOP ******* END DMS CODE *************** XIF SPC 1 * UNLK8 NOP TEMPX NOP SKP * ****************************************************************** * * SUBROUTINE $DLAY: * * $DLAY IS USED TO SET UP A SHORT TIMEOUT(10 MSEC)WHICH, WHEN IT * OCCURS, SIGNALS THAT AN I/O OPERATION MUST BE INITIATED ON THE * TIMED-OUT EQT(SEE $DEVT). * * CALLING SEQUENCE: * LDA * JSB $DLAY * * RETURN: * ALL REGISTERS ARE MODIFIED. * ***************************************************************** * $DLAY NOP CCE,INA SET THE SIGN BIT LDB A,I ON TO INDICATE RBL,ERB WE MUST INITIATE AN STB A,I OPERATION. ADA .3 CCE LDB A,I SET THE RBL,ERB EQT STB A,I BUZY. ADA .10 LDB N1 SET A STB A,I TIMEOUT ISZ $DLFL INCREMENT I/O DELAY INIT COUNT NOP IN CASE THERE IS NO TBG IN THE SYSTEM JMP $DLAY,I OF 10 MSEC. * $DLFL NOP HED < IO-DEVICE TIME-OUT PROCESSOR > * * * AFTER A DEVICE IS DISCOVERED TO HAVE TIMED-OUT * BY RTIME'S $CLCK PROCESSOR,THIS * ROUTINE IS ENTERED. ITS PURPOSE IS TO * CLEAR THE PENDING IO TRANSFER AND ENTER * IOCOM IN SUCH A WAY AS TO SIMULATE AN IO * COMPLETION RETURN FROM THE DRIVER ITSELF. * * IF THE TIMEOUT WAS DUE TO THE NEED TO INITIATE AN * I/O OPERATION(BIT 15 EQT2 SET)THEN THIS BIT * IS CLEARED AND IOCOM IS ENTERED(AT L.60) TO * INITIATE THE I/O OPERATION. * * * ENTER FROM SCHEDULER MODULE: * * (A)
* * $DEVT ADA N14 POINT TO EQT JSB $ETEQ SET EQT ADDRESSES LDA EQT1,I GET THE CLEAR BIT SSA IF CLEAR TIME OUT JMP CLTIM JUST CLEAR * LDA EQT2,I CHECK IF THE TIMEOUT SSA IS FOR INITIATING I/O JMP INTDL ON THIS EQT. * LDA EQT4,I IOR B4K SET TIME-OUT BIT STA EQT4,I STA B SAVE WORD IN B FOR TEST AND B77 SELECT CODE TO A BLF,SLB IF DRIVER TO HANDLE TIME-OUT SPC 1 IFN * BEGIN NON-DMS CODE *************** JMP CIC.8 CALL DRIVER. I/O SELECT CODE IN (A) *** END NON-DMS CODE *************** XIF SPC 1 IFZ ***** BEGIN DMS CODE *************** STA INTCD JMP CIC.6 CALL DRIVER. I/O SELECT CODE IN 'INTCD' ******* END DMS CODE *************** XIF SPC 1 * CLTIM JSB $CLCH CLEAR ALL CHANNELS LDA .4 SERVICED BY THIS ENTRY CLB SIMULATE COMPLETION JMP IOCOM RETURN FROM DRIVER * INTDL RAL,CLE,ERA CLEAR INITIATION STA EQT2,I BIT. ISZ CONFL SET CONTROL FLAG TO NONZERO. JMP L.60 GO INITIATE. * N14 DEC -14 HED < I/O CONTROL MODULE - DATA SECTION > * ***************************************************************** * * CONSTANT AND VARIABLE STORAGE AREA * ******************************************************************* * A EQU 0 DEFINE SYMBOLIC REFERENCES B EQU 1 FOR A AND B REGISTERS. .3 DEC 3 .5 DEC 5 .8 DEC 8 .9 DEC 9 N1 DEC -1 * B77 OCT 77 B377 OCT 377 B140K OCT 140000 B40K OCT 40000 B4K OCT 4000 SIGN OCT 100000 * MIC0 EQU * TEMP2 LIA 6 TEMP3 SZA,RSS MX OR XE? TEMP4 JMP NMX0 NO TEMP5 LDA .CXA TEMP6 SZB,RSS MICRO? TEMP7 STA MIC4 NO, B=0 TEMP8 SZB,RSS MICRO? TEMP9 STA MX1 NO TEMP0 LDA .CYB TEMPL STA MX4 TEMPW LDA .DLD TLOG SZB,RSS TMP1 STA MIC6 TMP2 LDA DFXII TMP3 SZB,RSS TMP4 STA MX6 TMP5 JMP NMX0 TMP6 DLD XI,I TMP8 EQU TMP6+1 .DLD EQU TMP6 DFXII EQU TMP6+1 DMACF NOP COMPL NOP MUST BE 0 AT INIT TIME * CONFL CXA .CXA EQU CONFL SCONF CYB .CYB EQU SCONF HED ** I/O CONTROL - OPERATOR COMMUNICATION ** * * I/O MODULE // OPERATOR COMMUNICATION * * * THE SYSTEM PES FOR COMMANDS FROM THE * OPERATOR TO CONTROL THE OVERALL STATUS OF * I/O EQUIPMENT, CHANGE ASSIGNMENT OF LOGICAL * UNITS AND TO INTERROGATE THE STATUS AND * PROPERITES OF THE DEVICES IN THE EQUIPMENT * TABLE. * * OPERATOR STATEMENTS ARE PROCESSED ONLY * FROM THE DESIGNATED SYSTEM TELETYPE. THE * ROUTINE IN THE SCHEDULING MODULE * IS RESPONSIBLE FOR STATEMENT DECODE AND * PARAMETER SEPARATION AND CONVERSION. THE * ASSOCIATED STATEMENT PROCESSOR IS CALLED * TO PERFORM THE REQUESTED ACTION. THE * STATEMENT PROCESSING IS ALL TABLE-DRIVEN * AS DESCRIBED IN THE LISTING AND DOCUMENTATION * OF THE SCHEDULING MODULE. * * * TWO OF THE FOLLOWING STATEMENT PROCESSORS * MUST BE INCLUDED IN THE BASIC SYSTEM PACKAGE. * THESE ARE THE 'UP' AND 'DOWN' STATEMENTS * CONCERNING THE OVERALL STATUS OF I/O DEVICES. * THE OTHER THREE STATEMENT PROCESSORS ( LOGICAL * UNIT ASSIGNMENT, TIME-%OUT, AND EQT STATUS) * ARE OPTIONAL AND MAY BE REMOVED BY DELETING * THE SECTIONS AND RE-ASSEMBLING THIS MODULE. * SKP * **************************************************************** * * 'DOWN' STATEMENT (REQUIRED) * * FORMAT: DN,N1 OR DN,,N2 * WHERE N1 IS THE EQT # OF THE I/O SLOT TO BE SET DOWN * OR N2 IS THE LU # OF THE I/O DEVICE TO BE SET DOWN. * * ACTION: WHEN SETTING THE EQT DOWN, THE AVAILABILITY FIELD OF THE * REFERENCED SLOT IS SET = 1(SLOT DISABLED). * WHEN SETTING THE LU DOWN, BIT 15 OF DRT WORD 2 IS SET AND * ANY I/O FOR THIS DEVICE IS REMOVED FROM THE EQT I/O * QUEUE AND ADDED TO THE LU I/O QUEUE HEADED AT DRT * WORD 2. * * CALL (FROM MESSAGE PROCESSOR): * * := N1 (EQT #) IN BINARY OR 0 * :=-1 OR N2 (LU #) IN BINARY * JMP $IODN * * RETURN IS TO <$XEQ> IF ACTION TAKEN OR TO -MESS.I- TO PRINT * * INPUT ERROR * IF N1 OR N2 ARE ILLEGAL OR IF BOTH ARE PRESENT. * **************************************************************** * $IODN SZA,RSS CHECK IF DN,0,LU OR DN,EQ JMP DNLU IT IS DOWN LU INB,SZB IT IS DOWN EQT. IF BOTH LU AND EQT ARE JMP $INER GIVEN, ISSUE INPUT ERROR MESSAGE. * JSB $EQCK CHECK LEGALITY OF EQT & SET EQT ADDRESSES. LDA EQT1 IF ATTEMPT TO DOWN EQT OF SYSTEM CPA SYSTY CONSOLE, ISSUE INPUT ERROR MESSAGE. JMP $INER * LDA EQT5,I SET AVAILABITY FIELD ALR,RAR TO 1 IOR B40K TO SET STA EQT5,I DOWN. * JSB XUPIO SET ANY DOWNED LU'S UP. * LDB EQT1,I GO PUT ALL WAITERS(UNBUFFERED RBL,CLE,ERB I/O)INTO THE BENERAL WAIT SZB,RSS LDB EQT1 CLA LIST. SKIP FIRST REQUEST. JSB $UNLK DEF A (DUMMY DEF FOR THIS MODE). JMP $XEQ RETURN. * DNLU STB A SA7VE LU NUMBER. CMB,CLE,INB,SZB,RSS ISSUE AN ERROR MESAGE JMP $INER IF THE LU IS LESS THEN ADB LUMAX 1 OR IS GREATER THEN CCB,SEZ,RSS LUMAX. JMP $INER * ADB A USE LU NUMBER ADB DRT TO POSITION TO LDA B,I WORD 1 OF THE AND C3700 DRT ENTRY. STA TEMP8 SET UP SUBCHANNEL-EQT WORD. AND B77 INPUT SZA,RSS ERROR IF JMP $INER DOWNING BIT BUCKET DEVICE. * STB TEMP9 SAVE ADDRESS OF DRT WORD 1. JSB $CVEQ SET EQT ENTRY ADD(WILL MASK SUBCH.). * LDB EQT5,I CHECK IF RBL,SLB EQT IS JMP DNLU5 UP OR IS * SSB DOWN. JMP DNLU9 EQT IS DOWN. * DNLU5 LDB EQT1,I SKIP FIRST EQT I/O REQ QUEUE SZB,RSS ENTRY UNLESS QUEUE IS EMPTY LDB EQT1 STB HEAD * CLA SET FOR NO ERROR MESSAGES. JSB LUERR GO DOWN ALL LU'S POINTING TO DEVICE. SEZ ERROR IF ATTEMPT JMP $INER TO DOWN LU 1. * JMP $XEQ NO, RETURN TO SYSTEM. * DNLU9 LDB TEMP9 IF EQT IS DOWN, THEN ADB LUMAX GET DRT WORD 2 LDA B,I AND SET THE LU IOR SIGN DOWN. STA B,I JMP $XEQ RETURN. * C3700 OCT 174077 * * *$EQCK* SUBROUTINE TO CHECK LEGALITY OF AN * EQT # (IN A-REGISTER) AND TO CALL * A SUBROUTINE TO CONSTRUCT THE EQT * ENTRY ADDRESSES. * $EQCK NOP STA B ERROR CMB,INB,SZB IF EQT NO. IS ZERO SSA OR NEGATIVE CCB,RSS SKIP ADB EQT# CHECK FOR LIMITS SSB IF ANY ERROR, JMP $INER GO TO $MESS ERROR EXIT. * JSB $CVEQ SET EQT ENTRY ADDRESSES. CLB STB CONFL CLEAR FLAGS JMP $EQCK,I * * SKP * **************************************************************** * * ' UP ' STATEMENT (REQUIRED) * * FORMAT: UP,NN WHERE NN IS THE EQT # * OF THE I/O DEVICE * * ACTION: THE AVAILABILITY FIELD OF THE REFERENCED SLOT(EQT ENTRY * #)IS SET = 0 (UNIT AVAILABLE). THE AVAILABILITY FIELD OF * ANY DEVICES(BIT 15 DRT WORD 2) REFERENCING THIS EQT ARE * SET = 0 AND THE LU'S' I/O QUEUES ARE ADDED TO THE EQT'S * I/O QUEUE. IF THE EQT WAS AVAILABLE OR DOWN, THEN THE * *IOCOM* SECTION(AT *L.68*)IS ENTERED TO INITIATE ANY * WAITING I/O REQUESTS. * * CALL (FROM MESSAGE PROCESSOR): * * := NN (EQT #) IN BINARY * JMP $IOUP * * RETURN IS MADE TO *IOCOM* OR TO *$XEQ* IF ANY ACTION * IS TAKEN. IF NN IS ILLEGAL, THEN RETURN IS MADE TO * *MESS,I* TO PRINT 'INPUT ERROR'. * ****************************************************************** * $IOUP JSB $EQCK CHECK 'NN' AND SET EQT ADDRESSES. $UPIO EQU * *** CAUTION - SOMEBODY DOES 'JMP $IOUP+1' FROM OUTSIDE SPC 1 IFZ ***** BEGIN DMS CODE ************** JSB $RSM GO RESTORE USER MAP IN CASE DRIVER CALL ******* END DMS CODE ************** XIF SPC 1 JSB CPEQT GET EQT# OF CURRENT EQT1 STA TMP1 LDA .4 RESCHEDULE ALL WAITING PGMS. JSB $SCD3 JSB CLDMA HELP POWER FAIL OUT WITH DMA. * JSB XUPIO SET RELATED LU'S UP * LDA EQT5,I GET AVAILABILITY ISZ CONFL SET THE CONTROL FLAG SSA,RSS IF DOWN OR AVAIL. JMP L.60 GO TRY TO OPERATE JMP $XEQ ELSE JUST FORGIT IT. SKP * ************************************************************************* * * SUBROUTINE XUPIO: * * XUPIO IS USED TO UP ANY LU'S ASSOCIATED WITH THIS EQT. * * CALLING SEQUENCE: * :=THE ADDRESS OF THE FIRST WORD OF THIS EQT. * :=THE EQT NUMBER. * JSB XUPIO * * RETURN: * ALL REGISHFBTERS ARE DISTROYED. * USES TMP2,TMP4,TMP6. * CALLS SUBROUTINE XXUP. * ************************************************************************* * HXUPIO NOP LDA LUMAX SET CMA,INA UP STA TMP2 COUNTER. LDB DRT POSITION TO FIRST STB TMP6 DRT ENTRY. * UPIO1 LDA TMP6,I CHECK IF THIS AND B77 DRT ENTRY POINTS CPA TMP1 TO THE EQT. JMP UPIO5 YES. UPIO3 ISZ TMP6 NO. SO ISZ TMP2 GO CHECK JMP UPIO1 NEXT DRT ENTRY. JMP XUPIO,I RETURN. * UPIO5 LDB TMP6 POSITION TO DRT ADB LUMAX WORD2. STB TMP4 GO PLACE LDB B,I ENTRIES LDA EQT1 INTO EQT JSB $XXUP I/O QUEUE(RETURN B=0). STB TMP4,I SET THE LU 'UP'. JMP UPIO3 GO CHECK NEXT DRT ENTRY. SKP **************************************************************** * * SUBROUTINE $XXUP: * * $XXUP TAKES AN I/O QUEUE AND(USING LINK)POSITIONS THE I/O * REQUESTS IN THE CURRENT EQT QUEUE ACCORDING TO THEIR PRIORITY. * IT RETURNS A FLAG IF AN I/O OPERATION SHOULD BE INITIATED. * * CALLING SEQUENCE: * := EQT1 OF OLD DEVICE. * :=ADDRESS OF FIRST STACKED I/O REQUESTS TO BE LINKED ON * THE CURRENT EQT(SIGN BIT WILL BE STRIPPED). * JSB $XXUP * * RETURN: * :=0 * :#0 A NEW I/O OPERATION IS AT THE HEAD OF THE CURRENT * EQT I/O QUEUE SO IT MUST BE INITIATED. = * THE ADDRESS OF THE FIRST WORD OF THE EQT. * USES TEMP1,TEMP2,UNLK8,TEMP4,XXUP7 * ***************************************************************** * $XXUP NOP STA TEMP4 SAVE OLD DEVICE EQT1. SPC 1 IFZ ***** BEGIN DMS CODE *************** RSA SAVE MEU RAL,RAL STATUS. STA UNLKS SJP *+2 ******* END DMS CODE *************** XIF SPC 1 CLA CLEAR STA XXUP7 INITIATION FLAG. RBL,CLE,ERB STRIP OFF POSSIBLE SIGN BIBT. XXUP9 SZB,RSS RETURN WHEN END OF I/O JMP XXUP2 REQUEST QUEUE IS FOUND. * STB TEMP1 ADB B176K SSB IF PTR<2000B THEN I/O STACKED JMP XXUP2 SO, EXIT WITH B=0 * LDB TEMP1 ELSE GET I/O REQ ADDR LDA B,I UNLINK THIS STA UNLK8 I/O REQUEST. INB LDA B,I GET INB PRIORITY RAL OF THE SSA I-O REQUEST JMP XXUP8 * SLA,RSS BUFFERED AND CLASS I-O REQUESTS. JMP XXUP5 NORMAL USER REQUEST. * LDA TEMP4 SYSTEM REQUEST. ADA .5 LDA A,I AND B36K CHECK IF THE OLD DEVICE CPA B14K IS A DISK OR NOT. JMP XXUP1 * .CLA CLA IF OLD DEVICE IS NOT A DISK, STA TEMPL SET TEMPL=0 AND USE JMP XXUP3 ZERO PRIORITY. * XXUP1 STA TEMPL IF OLD DEVICE IS A DISK, THEN INB,RSS SET TEMPL#0 AND USE PRIORITY. XXUP5 ADB .4 XXUP8 LDA B,I XXUP3 STA TEMP2 SAVE PRIORITY FOR LINK. JSB LINK LINK THIS REQUEST ONTO THE EQT. LDA EQT1 SEZ,RSS IF ONLY REQUEST ON THE EQT, THEN STA XXUP7 STORE INTO THE INITIATION FLAG. LDB UNLK8 LOOP FOR NEXT JMP XXUP9 I/O REQUEST. * * XXUP2 CLB LDA XXUP7 GET INITIATION FLAG SPC 1 IFN * BEGIN NON-DMS CODE *************** JMP $XXUP,I AND RETURN. *** END NON-DMS CODE *************** XIF SPC 1 IFZ ***** BEGIN DMS CODE *************** JRS UNLKS $XXUP,I AND RETURN. ******* END DMS CODE *************** XIF SPC 1 * XXUP7 NOP B176K OCT -2000 HED < I/O CONTROL MODULE - SUBROUTINE SECTION > * * SUBROUTINE: < $SYMG > (SYSTEM MESSAGE) * * PURPOSE: THIS ROUTINE PROVIDES FOR THE * OUTPUT OF SYSTEM MESSAGES AND * ERROR DIAGNOSTICS ON THE SYSTEM * TELETYPEWRITER. THE ROUTINE * MAINTAINS A 'ROTATING' BUFFER * AREA CONSISTING OF 5 10-WORD * BLOCKS - I.E., THE MAXIMUM * LENGTH OF A MESSAGE IS 18 * CHARACTERS (9-WORDS) PLUS 1 * WORD PRECEDING THE MESSAGE * WHICH CONTAINS THE CHARACTER * COUNT. * * CALL: (A) = ADDRESS OF FIRST WORD OF * MESSAGE BLOCK - THIS WORD * CONTAINS THE CHARACTER * LENGTH OF THE MESSAGE AS * A NEGATIVE VALUE. * * (P) JSB $SYMG * (P+1) -RETURN- * * ON RETURN: * (A) = 0 - MESSAGE ACCEPTED AND * MOVED TO BUFFER. * (A) NOT = 0 - BUFFER FILLED, * MESSAGE REJECTED * (E) = 0 * * $SYMG NOP JMP SBUF CHANGED TO CLE ON FIRST ENTRY * LDB SY# IF BUFFER CPB .5 IS FILLED, JMP $SYMG,I REJECT EXIT. * LDB SYC SET CURRENT STB SYT1 SPC 1 IFN * BEGIN NON-DMS CODE *************** JSB .MVW DEF .10 NOP *** END NON-DMS CODE *************** XIF SPC 1 IFZ ***** BEGIN DMS CODE *************** MVW .10 ******* END DMS CODE *************** XIF SPC 1 ISZ SY# INCRE COUNT ENTRY LDA SYT1 ADA .10 (A) = NEXT ENTRY ADDR LDB SYC (B) = CURRENT ENTRY ADDRESS. CPA SBL IF NEXT EXCEEDS BUFFER, LDA SBF RESET TO FWA BUFFER STA SYC AND SAVE. * LDA SY# IF ENTRY. CPA .1 COUNT = 1, JSB SYSCL INITIATE OUTPUT. * CLA,CLE (A) = 0 FOR EXIT WITH JMP $SYMG,I MESSAGE ACCEPTED. * * CALL <$XSIO> TO INITIATE OUTPUT * SYSCL NOP LDA B,I GET THE MESSAGE LENGTH STA SYS7 SET IN THE CALL INB STEP TO BUFFER ADDRESS STB SYS6 SET IN THE CALL JSB $XSIO OCT 1 - LOGICAL UNIT 1 - SYS TTY DEF SYS8 - COMPLETION ROUTINE ADDRESS NOP OCT 2 - ASCII WRITE - SYS6 NOP MESSAGE ADDRESS SYS7 NOP MESSAGE LENGTH SPC 1 IFZ ***** BEGIN DMS CODE *************** OCT 0 SAYS DO NOT NEED USER MAP ******* END DMS CODE *************** XIF SPC 1 JMP SYSCL,I * * COMPLETION ROUTINE FROM I/O CALL * SYS8 CCA SUBTRACT 1 FROM ADA SY# ENTRY COUNT FOR STA SY# MESSAGE JUST OUTPUT. SZA,RSS IF NO MORE IN BUFFER, JMP $XEQ EXIT. * LDB SYS6 SET ADB .9 NEXT ENTRY CPB SBL ADDRESS LDB SBF JSB SYSCL INITIATE OUTPUT JMP $XEQ -EXIT. * SY# NOP SYT1 NOP SYC DEF SBUF SBF DEF SBUF .10 DEC 10 SKP * SUBROUTINE: <$CVEQ> * * PURPOSE: THIS ROUTINE CONVERTS AN EQT * ENTRY # TO AN EQT DISPLACEMENT * AND CALLS <$ETEQ> TO SET THE * ENTRY ADDRESSES. * * CALLING SEQUENCE: * * (A) = EQT ENTRY # * * (P) JSB $CVEQ * (P+1) -RETURN- REGISTERS MEANINGLESS * * $CVEQ NOP AND B77 MASK TO LOW BITS ADA N1 SUBTRACT 1 AND MPY .15 MULTIPLY BY 15 ADA EQTA ABSOLUTE ADDRESS. * JSB $ETEQ SET ALL 15 ADDRESSES. * JMP $CVEQ,I -RETURN- * * SUBROUTINE: * * PURPOSE: THIS ROUTINE COMPUTES THE ENTRY # * OF THE ENTRY DESCRIBED BY -EQT1-. * THE # IS CONVERTED TO DECIMAL ASCII. * * CALLING SEQUENCE: (P) JSB CPEQT * (P+1) - RETURN - * ON RETURN, (A) = EQT# * (E) = 1 * * CPEQT NOP LDA EQTA SUBTRACT DEVICE CMA,INA EQT ENTRY ADDRESS ADA EQT1 FROM FWA OF EQT. CLB CLEAR B FOR DIVIDE DIV .15 DIVIDE BY 15 CCE,INA SET E FOR CONVERSION/ADJUST COUNT. JMP CPEQT,I EQT# NOT CONVERTED TO ASCII! SPC 1 SKP * SUBROUTINE: < $ETEQ > * * PURPOSE: THIS ROUTINE SETS THE ADDRESSES * OF THE 15 WORDS OF AN * EQUIPMENT TABLE ENTRY IN THE * 15 WORDS IN BASE PAGE COMMUNICATION * AREA LABELLED -EQT1- TO -EQT15-. * * CALLING SEQUENCE: * * (A) - STARTING ADDRESS OF THE EQT * ENTRY FOR THE REFERENCED * I/O UNIT. * * (P) JSB $ETEQ * (P+1) - RETURN - (A),(B) MEANINGLESS * * THERE ARE NO ERROR RETURNS OR * ERROR CONDITIONS DETECTED. * * $ETEQ NOP MIC10 JMP MIC11 OR STA EQT1 IF NO MICRO INA STA EQT2 INA STA EQT3 INA STA EQT4 INA STA EQT5 INA STA EQT6 INA STA EQT7 INA STA EQT8 INA STA EQT9 INA STA EQT10 INA STA EQT11 INA * STA EQT12 INA STA EQT13 INA STA EQT14 INA STA EQT15 JMP $ETEQ,I * MIC11 LDB AEQ1 (A)=VALUE OF FIRST ENTRY STR 11 (B)=ADDR OF FIRST ENTRY, DO 11 WORDS LDB AEQ12 STR 4 DO LAST 4 WORDS JMP $ETEQ,I RETURN * AEQ1 DEF EQT1 AEQ12 DEF EQT12 * SKP * * SPECIAL SECTION "I/O CLEAR " * ENTRY POINT IS "$IOCL" * * PURPOSE: THE FUNCTION OF THIS ROUTINE * IS TO REMOVE A PROGRAM FROM AN * I/O HANG-UP CONDITION RESULTING * FROM AN INPUT REQUEST NOT BEING * COMPLETED BY THE DEVICE. * * THIS "CLEARING" PROCEDURE IS * INITIATED BY THE OPERATOR IN * USING THE I/O ABORT VERSION OF THE * "OF,XXXXX,1" COMMAND. THE "OF" * STATEMENT PROCESSOR IN 'SCHED' * CALLS THIS SECTION IF THE REF-  * ERENCED PROGRAM IS SUSPENDED * FOR AN I/O INPUT REQUEST. * * PROCESS: THE LIST OF EACH EQT ENTRY * IS SEARCHED TO FIND THE QUEUED * REQUEST CORRESPONDING TO THE * ID SEGMENT OF THE REFERENCED * PROGRAM. THE ENTRY IS REMOVED * FROM THE LIST AND THE LIST IS * APPROPRIATELY LINKED TO REFLECT * THE CHANGE. * * IF THE ENTRY WAS THE FIRST ONE * IN THE LIST (I.E. THE ACTIVE * REQUEST), THE DEVICE'S CHANNELS * AND DMA CHANNEL, IF ASSIGNED,ARE * CLEARED. THE DEVICE'S TIME-OUT * CLOCK IS CLEARED. $ABRT IS * CALLED TO ABORT THE PROGRAM AND * CONTROL IS TRANSFERRED TO "$XEQ" * IF THE DEVICE WAS NOT CLEARED * OR TO "L.55" IN "IOCOM" TO * INITIATE THE NEXT STACKED * REQUEST (OR TO ALLOCATE THE * DMA CHANNEL). * * CALLING SEQUENCE: * * (A)= ID SEGMENT ADDRESS OF PROGRAM * * (P) JMP $IOCL * * -NO RETURN - * * SKP ENT $IOCL * $IOCL STA TEMP1 SAVE ID SEGMENT ADDRESS. SPC 1 IFZ ***** BEGIN DMS CODE ************** SJP *+2 ******* END DMS CODE ************** XIF SPC 1 LDA EQT# SET TEMP2 = NEGATIVE CMA,INA NUMBER OF EQT STA TEMP2 ENTRIES. LDA EQTA INITIALIZE FOR * IOCL STA IOCL5 EQT ENTRY WORD IOCL0 STA IOCL6 1 ADDRESS. LDA A,I GET LINK ADDRESS RAL,CLE,ERA CLEAR SIGN, SET E IF SET * CPA TEMP1 JUMP IF A JMP IOCL2 MATCH TO PROGRAM. * SZA IF NOT END OF LIST, JMP IOCL0 CONTINUE SCAN. * LDA IOCL5 SET (A) = ADDRESS OF ADA .15 NEXT EQT ENTRY. ISZ TEMP2 IF NOT END OF EQT, GO JMP IOCL TO SCAN NEXT ENTRY LIST. * * SCAN ALL DRT WORD 2 I/O QUEUES * LDA LUMAX SET TEMP2 = IINEGATIVE CMA,INA NUMBER OF DRT STA TEMP2 ENTRIES. LDA DRT INITIALIZE ADA LUMAX FOR FIRST STA IOC50 DRT WORD IOC41 STA IOC51 TWO. LDA A,I GET LINK * RAL,CLE,ERA CLEAR SIGN, SET E IF SIGN SET. CPA TEMP1 JUMP IF A MATCH JMP IOC62 TO A PROGRAM. * SZA IF NOT END OF LIST, JMP IOC41 CONTINUE SCAN. * ISZ IOC50 SET = NEXT ADDRESS OF LDA IOC50 ISZ TEMP2 NEXT DRT WORD 2. JMP IOC41 IF NOT END OF DRT, CONTINUE SCAN. * LDA TEMP1 NOT FOUND SO JUST JMP IOC63 ABORT THE PROGRAM. SKP * * PROGRAM REQUEST FOUND IN DRT, UNLINK REQUEST. * IOC62 LDB A,I GET NEXT LINK, PROPOGATE RBL,ERB SIGN IF SIGN WAS SET AND STB IOC51,I STORE IN PREVIOUS LINK. * LDA TEMP1 CHECK IF THIS ISZ TEMP1 IS A SYSTEM LDB TEMP1,I REQUEST. SSB,RSS IF SO SKIP ABORT. IOC63 JSB $ABRT 'ABORT PROGRAM' JMP $XEQ RETURN. * * PROGRAM REQUEST ENTRY FOUND, UNLINK REQUEST. * IOCL2 LDB A,I GET NEXT LINK AND SET RBL,ERB PASS OLD SIGN TO NEXT LINK STB IOCL6,I IN PREVIOUS LINK. * LDA TEMP1 "ABORT ISZ TEMP1 CHECK IF THIS IS A LDB TEMP1,I SYSTEM REQUEST SSB,RSS IF SO SKIP ABORT JSB $ABRT PROGRAM" * LDA IOCL5 IF PROGRAM REQUEST LDB IOCL6,I CPA IOCL6 WAS CURRENT ENTRY, SSB AND NOT NOW CLEARING, SKIP. JMP $XEQ -EXIT TO $XEQ. * JSB $ETEQ * * JSB CLDMA CLEAR ANY DMA CHANNEL ASSIGNED LDA B3.I GET CLEAR REQUEST (100003B) STA EQT6,I SET IN EQT LDA EQT5,I GET CURRENT STATUS RAL,CLE IF DOWN OR IN DMA SSA WAIT JMP $XEQ JUST LEAVE IT ALONE * ERA ELSE SET NOTZ& BUSY STA EQT5,I AND PLANT LDA EQT4,I GET THE SELECT CODE LDB EQT2,I AND THE I.XX ADDRESS AND B77 ISOLATE THE SELECT CODE AND JSB B,I RUN THE DRIVER * * IF REQUEST ACCEPTED THEN WE MUST SET UP FOR AN INTERRUPT BY * * A) SETTING THE DEVICE BUSY * B) SETTING A TIME OUT (1 SEC. IS ARBITRARILY USED) * * IF REQUEST IS NOT ACCEPTED OR IS COMPLETED THEN: * * A) ZAP TIME OUT AND * B) GO TO IOCOM TO GET THE NEXT REQUEST * CLB,CCE FIRST ZAP TIME OUT STB EQT15,I LDB EQT1,I SET THE SIGN BIT IN EQT1 RBL,ERB FOR IOCOM (NOW OR LATER) STB EQT1,I CCE,SZA INTERRUPT EXPECTED? JMP IOCOM NO SO JUST GO TO IOCOM * LDA EQT5,I YES SO SET RAL,ERA BUSY STA EQT5,I AND LDA N100 SET UP STA EQT15,I A REASONABLE TIME OUT JMP $XEQ GO TO THE DISPATCHER * SPC 1 IOCL5 CLE IOCL6 NOP IOC50 NOP IOC51 NOP * .CLE EQU IOCL5 SKP * * ROUTINE TO CLEAR DMA CHANNEL IF ASSIGNED TO DEVICE * CLDMA NOP LDB INTBA GET THE INTERRUPLE ADDRESS TO B LDA B,I AND DMA 6 ENTRY TO A RAL,CLE,ERA CLEAR THE SIGN BIT CPA EQT1 THIS CHANNEL ASSIGNED? CLA,RSS YES- SKIP JMP IOCL3 NO TRY NEXT CHANNEL * CLC 6 CLEAR CHANNEL STF 6 6. STA B,I SET IT AVAILABLE IN INTBA SPC 1 IOCL3 INB STEP TO DMA 7 ENTRY LDA B,I GET TO A AND RAL,CLE,ERA CLEAR THE SIGN BIT CPA EQT1 THIS CHANNEL ASSIGNED? CLA,RSS YES - SKIP JMP CLDMA,I NO - EXIT CHANNELS CLEARED * CLC 7 CLEAR CHANNEL 7 STF 7 AND STA B,I MAKE IT AVAILABLE. JMP CLDMA,I * * ROUTINE TO CLEAR ALL CHANNELS SERVICED BY EQT ENTRY * $CLCH NOP JSB CLDMA CLEAR &DMA CHANNEL IF ASSIGNED LDA INTLG STORE INTERRUPT CMA,INA TABLE LENGTH- ADA .2 RELATED INDEX STA TEMPW LDA CLR10 STORE INITIAL STA .CLC CLC S.C. LDA INTBA INSTRUCTION ADA .2 CLRNX LDB A,I GET NEXT TABLE ENTRY- CPB EQT1 DOES IT REFERENCE THIS EQT? .CLC CLC 00B YES-GO CLEAR IT ISZ TEMPW THRU TABLE? INA,RSS NO-INDEX TO NEXT ENTRY JMP $CLCH,I YES-EXIT * ISZ .CLC JMP CLRNX * CLR10 CLC 10B B3.I OCT 100003 N100 DEC -100 HED * $SYMG BUFFER AND PRIVLEDGE I/O CONFIGURE SECTION * * SBUF BSS 50 ORG SBUF PUT IOC CONFIGURING ROUTINE IN BUFFER STA SBUF SAVE THE A REG. CLA STA $ZZZZ ZERO THE ABORT LIST STA DUMMY,I ZAP THE PRIV. TRAP CELL. LDA DUMMY GET THE DUMMY I/O ADDRESS SZA,RSS IF NONE JMP NOPRV GO EXIT ADA .CLC CONFIGURE THE DUMMY ADDRESSES STA SW2 XOR STCP STA SW1 STC STA STCP XOR STFP AND STA STF1 AND STF STA STFP STCP OCT 4000 STFP OCT 600 NOPRV LDA .CLE REPLACE CALL TO HERE STA $SYMG+1 WITH A CLE LDA DRN GET DIRECT ADDRESS LDA A,I FOR THE RN TABLE RAL,CLE,SLA,ERA JMP *-2 STA DRN,I SET ADDRESS JSB $S.CL INITIALIZE CLASS I/O MODULE * LDB $MIC SZB DO WE HAVE MICRO? JMP MIC0 YES STB MIC2 STB MIC4 STB MIC6 LDA SAXAI STA MIC LDA LBEQ1 STA MIC8 LDA SAEQ1 STA MIC10 JMP MIC0 * NMX0 LDA TBG LDB .CLA SZA IS THERE A TBG IN SYSTEM? STB $IRT YES, OVERLAY JMP WITH CLA LDA SBUF RESTORE A SZA DUMMY ADDR FOR NO TIMER MODULE JMP $SYMG+1 NO, CONTINUE THE MESSAGE BIT JMP $SYMG,I  YES, RETURN NOW SPC 2 SAXAI STA XA,I LBEQ1 LDB EQT1 SAEQ1 STA EQT1 DRN DEF D$RN SPC 1 L EQU 50+SBUF-* ERROR HERE MEANS WE RAN OUT OF BUFFER ORR LEAVE THE BUFFER SBL DEF * * ORG * SIZE OF MODULE HED ** SYSTEM BASE PAGE COMMUNICATION AREA ** XI EQU 1647B . EQU 1650B ESTABLISH ORIGIN OF AREA * * SYSTEM TABLE DEFINITION * * EQTA EQU .+0 FWA OF EQUIPMENT TABLE EQT# EQU .+1 # OF EQT ENTRIES DRT EQU .+2 FWA OF DEVICE REFERENCE TABLE LUMAX EQU .+3 # OF LOGICAL UNITS (IN DRT) INTBA EQU .+4 FWA OF INTERRUPT TABLE INTLG EQU .+5 # OF INTERRUPT TABLE ENTRIES KEYWD EQU .+7 FWA OF KEYWORD BLOCK * * I/O MODULE/DRIVER COMMUNICATION * EQT1 EQU .+8 ADDRESSES EQT2 EQU .+9 EQT3 EQU .+10 OF EQT4 EQU .+11 EQT5 EQU .+12 CURRENT EQT6 EQU .+13 EQT7 EQU .+14 15-WORD EQT8 EQU .+15 EQT9 EQU .+16 EQT EQT10 EQU .+17 EQT11 EQU .+18 ENTRY EQT12 EQU .+81 EQT13 EQU .+82 EQT14 EQU .+83 EQT15 EQU .+84 * CHAN EQU .+19 CURRENT DMA CHANNEL # TBG EQU .+20 I/O ADDRESS OF TIME-BASE CARD SYSTY EQU .+21 EQT ENTRY ADDRESS OF SYSTEM TTY * * SYSTEM REQUEST PROCESSOR /'EXEC' COMMUNICATION * * RQCNT EQU .+22 # OF REQUEST PARAMETERS -1 RQRTN EQU .+23 RETURN POINT ADDRESS RQP1 EQU .+24 ADDRESSES RQP2 EQU .+25 RQP3 EQU .+26 OF REQUEST RQP4 EQU .+27 RQP5 EQU .+28 PARAMETERS RQP6 EQU .+29 RQP7 EQU .+30 (SET FOR MAXIMUM OF RQP8 EQU .+31 8 PARAMETERS) * * DEFINITION OF SYSTEM LISTS (QUEUES) * * * * DEFINITION OF EXECUTING PROGRAM ID SEGMENT' * * XEQT EQU .+39 ID SEGMENT ADDR. OF CURRENT PROG. XTEMP EQU .+41 'TEMPORARY (5-WORDS) XPRIO EQU .+46 'PRIORITY' WORD XSUSP EQU .+48 'POINT OF SUSPENSION' XA EQU .+49 'A REGISTER' AT SUSPENSION XB EQU .+50 'B REGISTER' XEO EQU .+51 'E AND OVERFLOW * @B@<* SYSTEM MODULE COMMUNICATION FLAGS * * OPATN EQU .+52 OPERATOR/KEYBOARD ATTENTION FLAG DUMMY EQU .+55 I/O ADDRESS OF DUMMY INT. CARD * * DEFINITION OF MEMORY ALLOCATION BASES * * * * UTILITY PARAMETERS * MPTFL EQU .+80 MEMORY PROTECT ON/OFF FLAG (0/1) BKLWA EQU .+87 LWA OF MEMORY IN BACKGROUND * ORG * LENGTH OF RTIOC END $CIC B sQ 92064-18009 1726 S C0122 &MDIO0 MII,III DISP             H0101 {)*USE 'ASMB,R,N' (RTE-M II) OR 'ASMB,R,Z' (RTE-M III) * * IFN OPTION * NAME: $MDI2 * SOURCE: 92064-18009 * RELOC: PART OF 92064-16002 * PROGMR: E.J.W. BASED ON RTE-III VERSIONS G.A.A.,L.W.A.,D.L.S. * * IFZ OPTION * NAME : $MDI3 * SOURCE: 92064-18009 * RELOC: PART OF 92064-16003 * PROGMR: E.J.W. BASED ON RTE-III VERSIONS G.A.A.,L.W.A.,D.L.S. * * **************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT * * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * **************************************************************** * * IFN * BEGIN NON-DMS CODE *************** NAM $MDI2,0 92064-16002 REV.1726 770512 *** END NON-DMS CODE *************** XIF IFZ ***** BEGIN DMS CODE *************** NAM $MDI3,0 92064-16003 REV.1726 770512 ******* END DMS CODE *************** XIF * SUP * * DISPATCHER ENTRY POINT NAMES * ENT $RENT,$ZZZZ,$XEQ ENT $MPFT,$EMRP,$CON SPC 1 IFZ ***** BEGIN DMS CODE *************** ENT $MRMP,$ENDS,$MATA ENT $SMAP ENT $LPSA,$XDMP ******* END DMS CODE *************** XIF SPC 1 * * DISPATCHER EXTERNAL REFERENCE NAMES * EXT $RSRE,$WATR,$TRRN,$IRT,$ABRE,$LIST EXT $MIC,$SGAF * MIC STR,105623B,1 SEQUENTIAL STORE VALUE SKP * THE DISPA MODULE OF THE HP-2100 REAL TIME EXECUTIVE * * PERFORMS THE FOLLOWING FUNCTIONS: * * 1. IDLE LOOP WHEN NO PROGRAMS ARE SCHEDULED OR CANNOT BE * * EXECUTED. * * 2. SWITCHES PROGRAM EXECUTION SUCH THAT THE HIGHEST * * PRIORITY EXECUTABLE PROGRAM EXECUTES. yk * * 3. SETS THE FENCE REGISTER ACCORDING TO PROGRAM TYPE. * * 4. LOADS, SWAPS, AND EXECUTES DISC RESIDENT PROGRAMS * * * CALLING SEQUENCE * JMP $XEQ * * $XEQ LDB $ZZZZ CHECK IF PROGRAM TO BE ABORTED SZB JMP ABORT YES GO HANDLE IT LDB $LIST IF LIST NOT ENTERED SZB,RSS THEN NOTHING NEW SO JMP $IRT GO CONTINUE CURRENT PGM * LDA SKEDD LOAD TOP OF SCHEDULE LIST CLB STB $LIST PREVENT NEEDLESS LIST SCANS RSS SKIP FIRST TIME X0035 LDA ZWORK,I GET THE NEXT PGM IN THE LIST SZA IF ZERO, THEN NO PROG SCHED JMP X0010 GO TO PROCESS SCHED LIST * * NO PROGRAM SCHEDULED--SETUP FOR IDLE LOOP * * * THE IDLE LOOP SECTION CONSISTS OF: * * CLEARING XEQT WORD TO SIGNIFY THAT NO PROGRAM * * CURRENTLY EXECUTING. * * STORE ADDRESS OF 4 DUMMY WORDS INTO XSUSP-XSUSP+3 * * DUE TO I/O PROCESSING. * * SET MEMORY PROTECT REGISTER TO ZERO. * * CALL INTERRUPT RESTORE ROUTINE, $IRT * JUMP TO * * * * STA XEQT SET BP POINTERS TO DUMMY ID LDB VSUSP STB XSUSP INB STB XA SET POINTERS TO DUMMY REGS STB XB STB XEO STB XI SET X,Y REG POINTER TO DUMMY JMP X0029 SET UP MP FENCE, EXIT * IDLE JMP * IDLE LOOP * VSUSP DEF *+1 DEF IDLE NOP NOP SKP ABORT LDA B,I GET POSSIBLE NEXT PGM STA $ZZZZ AND SET IT FOR ABORT CLA CLEAR THE XSUSP ADDRESS STABI STA B,I FOR THE NEXT START ADB DM8 a BACK UP TO ID-SEG ADDRESS STB A SAVE THE ID-SEG. ADDRESS STB TMP A FEW TIMES JSB $ABRE RELEASE ANY RE-ENTRANT MEMORY. * LDB TMP JSB $WATR SCHEDULE ANYONE WAITING LDB TMP LDA B ADA D12 SPC 1 IFZ ***** BEGIN DMS CODE *************** STA CNT SAVE ADDR OF NAME WORD ******* END DMS CODE *************** XIF SPC 1 ADA D8 INDEX TO FLAG WORD STA TEMP SAVE ADDR OF FLAG WORD LDA A,I ALF,ALF GET FLAG WORD SLA ANY RESOURCES HELD? JSB $TRRN YES, RELEASE THEM * CLA IF CURRENTLY STA TEMP,I (CLEAR FLAG WORD) SPC 1 IFZ ***** BEGIN DMS CODE *************** LDA CNT,I SZA OF,PROG,8? JMP $XEQ NO * LDA TMP YES ADA D14 LDA A,I GET PROG TYPE AND D15 CPA D1 IF IT IS MEM RES TYPE JMP $XEQ SKIP ALL THE PTTN JAZZ * LDA TMP OF,PROG,8 IN PTTN JSB MATEN GO SET UP POINTERS CLB STB MID,I CLEAR RESIDENT WORD IN PART ******* END DMS CODE *************** XIF SPC 1 JMP $XEQ ABORTION DONE. * D12 DEC 12 SKP * THE SWITCHING SECTION USES THE SCHEDULE LIST TO DETERMINE * * WHICH PROGRAM TO EXECUTE-STARTING FROM TOP OF LIST. * * IF PROGRAM FROM LIST OF LOWER OR EQUAL PRIORITY, * * THEN EXECUTION OF CURRENT PROGRAM CONINUES. * * IF PROGRAM FROM LIST OF HIGHER PRIORITY AND * * TYPE EITHER REAL TIME RESIDENT OR BACKGROUND * * RESIDENT, EXECUTION SWITCHING TAKES PLACE.* * TYPE IS BACKGROUND DISC RESIDENT, * * GO TO BACKGROUND DISC PROCESSING. * * TYPE IS REAL TIME DISC RESIDENT, GO TO REAL * * TIME DISC RESIDENT PROCESSING * * X0010 STA ZWORK SCHED LIST PROG ID SEG ADDRESS ADA D6 STA ZPRIO PRIORITY ADDRESS ADA D8 STA ZTYPE TYPE ADDRESS ADA D7 STA ZMPID MAP WORD ADDRESS * LDA XEQT ANY PROGRAM CURRENTLY EXECUTING? SZA,RSS YES, TEST FOR HIGHEST PRIORITY JMP X0030 NO, EXECUTE NEW SCHEDULED PROG ADA D15 CHECK STATUS OF XEQT ID SEGMENT LDA A,I AND D15 MASK TO MAJOR STATUS CPA D1 RSS SCHEDULED-SO GO TO CHECK PRIORITY JMP X0030 NOT SCHEDULED -SO GO SWITCH LDA XPRIO,I LOAD TEST PROGRAM PR CMA,INA MAKE NEGATIVE ADA ZPRIO,I SUPTRACT FROM CURRENT PGM PR. SSA,RSS IF SIGN A=0 THEN PROG OF HIGHER PR JMP RNOLD CURR PROG HIGHER PRIOR THAN SCHED PROG * X0030 EQU * IFN * BEGIN NON-DMS CODE *************** CLA FORCE MPFT INDEX TO ZERO STA MPN STORE MPFT INDEX *** END NON-DMS CODE *************** XIF SPC 1 IFZ ***** BEGIN DMS CODE *************** LDA ZMPID,I GET MAP ID WORD AND B1700 AND SAVE MPFT INDEX ALF,ALF RAL STA MPN LDA ZTYPE,I SCHED PROG HIGHER PRIOR THAN CURR PROG AND D15 STA TMP CPA D1 CHECK IF REAL TIME RESIDENT JMP X0F40 YES CPA D2 CHECK IF REAL TIME PTTN RESIDENT JMP X0200 YES JMP X0035 NOT LEGAL TYPE, IGNOR * X0200 JSB FND SET UP PTTN, RETURNS (A) = #PGS LDB MLNK SET (B) = PTTN ENTRY ADDR JSB $SMAP GO SET UP USER MAP JMP X0N40 NOW SET UP USER PROG PTRS * * X0F40 LDA $MRMP GET ADR MEM RES MAP USA LDA $EMRP SET PTRS FOR MEMORY RESIDENT PROG INA INCREMENT FOR LAST WORD PROG + 1 STA RTDRA STA AVMEM STA BKDRA STA BKLWA  LDA ADMEM STA MID ******* END DMS CODE *************** XIF SPC 1 X0N40 LDA ZWORK STA MEMID SET ID FOR MEM RES PROG ADA MI GET ADR FOR INDEX REGISTERS STA XI SET POINTER TO INDEX REGISTERS ADA D30 STA $CON SET POINTER TO CONSOLE LU (WORD 29) * * LOAD PROGRAM ID SEG ADR IN XEQT AREA * LDA ZWORK IF SAME AS CURRENT PGM CPA XEQT THEN JMP $RENT SKIP BASE PAGE SET UP. JSB $X041 SET UP BASE PAGE ID SEG PTRS LDB XSUSP,I CHECK IF PROGRAM SUSPENDED CMB,INB,SZB IF SO THEN JMP $RENT GO SET IT UP LDB XPENT,I GET PRIMARY ENTRY PT. STB XSUSP,I SET ENTRY ADDRESS * * CHECK IF PT OF SUSPENSION IN LIBRARY AREA * $RENT EQU * IFZ ***** BEGIN DMS CODE *************** LDA ZWORK GET PROG TRYING DISPATCH CPA MID,I HAS SETUP CHANGED? (TRY TO SAVE TIME) RSS NO,GO TO IT JSB FIX GO SET BACK UP ******* END DMS CODE *************** XIF SPC 1 LDB XTEMP+4 GET THE RENT BIT ADB D15 LDB B,I GET THE WORD BLF,RBL ROTATE TO PUT RENT BIT IN SIGN SSB,RSS IF RENT NOT IN CONTROL JMP X0028 GO SET FENCE SLB IF MEMORY MOVED JSB $RSRE GO RESTORE IT LDA LBORG SET THE LIBRARY FENCE JMP X0029 GO SET IT UP * * * $X041 NOP SET UP B.P. ID SEG PTRS LDB DM12 (12 WORDS) STB TMP LDB XQDEF PUT THEM AT XEQT STA XEQT X0041 JMP MIC OR STA B,I IF NO MICRO INA INB ISZ TMP JMP X0041 JMP $X041,I RETURN WHEN DONE * XQDEF DEF XLINK * RNOLD LDA XEQT RESET POINTERS FOR CURR PROG STA ZWORK SINCE WE WILL NOT RUN SCHED PROG ADA D14 STA ZTYPE ADA D7 STA ZMPID JMP $RENT * MIC STR 12 CALL MICROCODE * JMP $X041,I RETURN * SPC 1 IFZ ***** BEGIN DMS CODE *************** FIX NOP ROUTINE TO RESET MAT POINTERS FOR CURRENT PROG LDA ZTYPE,I GET PROG TYPE AND D15 CPA D1 JMP X0F40 GO RESET MEM RES INFO * LDA ZMPID,I AND B1700 RAL ALF,ALF GET MP FENCE INDEX STA MPN JSB FND GO SET MAT POINTERS, BNDRY WORDS JMP FIX,I ******* END DMS CODE *************** XIF SPC 1 * * * SET MEMORY PROTECT ACCORDING TO PROG TYPE * * X0028 LDA MPN GET MPFT INDEX ADA $MPFT LDA A,I GET FENCE X0029 STA FENCE OTA 5B * * RESTORE REGISTERS, MEMORY PROTECT, AND TURN ON INTERRUPT SYSTEM * JMP $IRT GO EXECUTE THE PROGRAM SPC 3 * XEQ PROCESSOR--BUFFERS, CONSTANTS, POINTERS, ETC * * ZWORK NOP SCHED LIST ID SEGMENT ADDRESS ZPRIO NOP SCHED LIST PRIORITY LIST ZTYPE NOP SCHED LIST TYPE ADDRESS ZMPID NOP SCHED LIST MAP & MPFTI WORD TEMP NOP TEMPORARY WORKING STORAGE AREA TMP NOP TEMPORARY WORKING STORAGE * D1 DEC 1 D2 DEC 2 D3 DEC 3 D4 DEC 4 D6 DEC 6 D7 DEC 7 D8 DEC 8 D14 DEC 14 D15 DEC 15 D30 DEC 30 D22 DEC 22 DM1 DEC -1 DM8 DEC -8 DM12 DEC -12 * $EMRP NOP FWA SAM-1 (SET BY GENERATOR) $MPFT NOP ADDR M.P. FENCE TABLE (SET BY GENERATOR) ADMEM DEF MEMID MEMID NOP ID SEG ADDR OF CUR MEM.RES. PROG MPN NOP INDEX TO MPFT, BP FLAG B1700 OCT 1700 MASK FOR MP INDEX MID NOP ID SET ADDR MI DEC -2 NEG # OF INDEX REGS SPC 2 * MPFT INDEX * * BUILT BY THE GENERATOR AS FOLLOWS: * 0 PARTITION RESIDENT PROGRAM, NO COMMON * 1 MEMORY RESIDENT PROGRAM, NO COMMON * 2 RT COMMON, ANY PROGRAM * 3 -- NOT USED -- * 4 SSGA, ANY PROGRAM * * * 0v MAT ENTRY * *EACH MAT ENTRY WILL BE AS FOLLOWS: * * WORD PURPOSE * 0 LINKAGE (ADR NEXT ENTRY IN LIST) (-1 IF NOT DEFINED) * 1 - NOT USED- * 2 ID SEG ADR * 3 BEGINNING PAGE ADR OF PARTITION * BITS 0-9 * 4 NUMBER PAGES OCCUPIED BY PARTITION * BITS 0-9,RESERVED FLAG BIT 15 * 5 STATUS ,REAL TIME FLAG BIT 15 * * *THE FOLLOWING ARE SET AT GENERATION TIME: * BEGINNING PAGE ADR (WORD 3) * NUMBER PAGES IN PART (WORD 4) * REAL TIME FLAG (WORD 5) * RESERVED FLAG (WORD 4) * SPC 2 IFZ ***** BEGIN DMS CODE *************** PGN NOP PROG LENGTH MLNK NOP LINKAGE WORD CNT NOP PARTITION # B77 OCT 77 B2000 OCT 2000 BIT 10 SET B76K OCT 76000 D21 DEC 21 $LPSA NOP LAST PAGE SAM (SET BY GENERATOR) $MRMP NOP ADDR MEM RES MAP (SET BY GENERATOR) $ENDS NOP #PAGES OCCUPIED BY SYSTEM ,LIBR (SET BY GENERATOR) $MATA NOP ADR FIRST ENTRY MAT (SET BY GENERATOR) * *ROUTINE TO SET USER MAP *CALL: AREG=LENGTH IN PAGES * BREG=ADR MAT ENTRY * * $SMAP NOP STB XADR MAT ENTRY ADR STA XPGN JPROG LENGTH IN PAGES ADB D2 LDA B,I GET ID ADR ADA D22 LDA A,I GET LOW MAIN AND B76K GET START PAGE ALF RAL,RAL GET IN LOW 5 BITS LDB $ENDS GET PAGE # USER STARTS ON STB STUSR START USER WITH NO COMMON CMB,INB ADB A SZB,RSS B=0,NO COMMON JMP MAPUS NO COMMON * STA STUSR SAVE START REG USER LDA $ENDS A REG START COMMON ADA D32 GET TO USER MAP CBX BREG HAS # REGISTERS LDB $ENDS ADR OF START REG VALUE XMS MAP COMMON * MAPUS CLA,INA CAX SET TO MAP BASE PAGE REGISTER LDA D32 FIRST REG IN USER MAP LDB XADR ADB D3 ^IGET TO START PARTITION WORD LDB B,I ELB,BRS GET TO START PARTITION WORD STB STVAL STORE START VALUE LDB STVAL GET ADR START VALUE XMS MAP BASE PAGE * SEZ,RSS E=1,DONT INCREMENT START VALUE ISZ STVAL LDA D32 ADA STUSR START REG IN USER MAP LDX XPGN GET LENGTH PROG LDB STVAL XMS MAP * LDB STUSR PROTECT REST OF MAP ADB XPGN STB STUSR CMB,INB ADB D32 SZB,RSS IF B=0,FINISHED JMP $SMAP,I * CBX GET # REGISTERS IN X LDA STUSR GET START REGISTER ADA D32 LDB PRTCT GET PROTECT VALUE XMS JMP $SMAP,I YES,RETURN * PRTCT OCT 140000 READ & WRITE PROTECT STVAL NOP XADR NOP XPGN NOP STUSR NOP D32 DEC 32 * * * EXTERNAL ROUTINE TO SET USER MAP * * CALL: LDA IDADR AREG HAS ID SEG ADR * JSB $PVMP * --RETURN * AREG=0 ON RETURN IS ERROR--SAYS PROGRAM * NOT IN PARTITION * * $XDMP NOP STA XADR TEMP SAVE OF ID ADR LDB A ADB D14 LDA B,I AND D15 IS PROG MEM RES CPA D1 JMP MRPV YES,GO SET MEM RES MAP ADB D7 GET MPID WORD LDA B,I STA XPGN TEMP SAVE AND B77 MPY D6 ADA $MATA GET PART ADR LDB A B HAS MAT ENTRY ADA D2 LDA A,I CPA XADR IS PROG STILL IN PARTITION JMP *+3 YES ,CONTINUE CLA NO,ERROR JMP $XDMP,I ERROR RETURN LDA XPGN AND B76K ALF RAL,RAL GET LENGTH JSB $SMAP GO SET MAP CCA MAKE SURE A NOT 0 JMP $XDMP,I RETURN MRPV LDA $MRMP USA SET MEM RES MAP JMP $XDMP,I SKP * JSB FND TO SET UP PTTN POINTERS * (A) = # OF PAGES OF PTTN * FND NOP PARTITION FOUND SO SET IT UP LDA ZWORK JSB MATEN GO SET UP MAT POINTERS LDB MID,I GET OWNER OF PART * FNDR ADB D21 LDA B,I GET PROG LENGTH AND B76K STA PGN SAVE PAGE ADDR TEMPORARILY ADA DM1 FILL OUT PAGE INB LDB B,I STB RTDRA ADA B STA AVMEM STA BKDRA STA BKLWA LDA PGN GET PAGE ADDR AND B76K MASK AND SHIFT TO GET #PGS ALF RAL,RAL JMP FND,I RETURN * * * * SET UP POINTERS TO ENTRY IN MAT * AREG HAS ID ADR ON ENTRY * MATEN NOP ADA D21 GET MAP ID WORD LDA A,I AND B77 GET PARTITION # STA CNT MPY D6 MULTIPLY BY MAT ENTRY LENGTH ADA $MATA STA MLNK (1) SET MAT ENTRY POINTER ADA D2 STA MID (3) ID SEG ADR JMP MATEN,I ******* END DMS CODE *************** XIF SPC 1 HED SYSTEM START UP ******************************************************************** * THE START SECTION: * * CLEARS INTERRUPT SYSTEM * * INITIALIZES MAPS IN RTE-M III * ******************************************************************** * $ZZZZ NOP CLC 0 CLEAR INTERRUPT SYSTEM LDB STABI LDA $MIC SZA,RSS ANY MICRO? STB X0041 NO, PUT STA B,I THERE * LDA $MPFT ADA D4 LDA A,I GET START OF SSGA ADA DM1 STA $SGAF SPC 1 IFZ ***** BEGIN DMS CODE *************** LDA $MRMP GET ADDRESS MEM RES MAP USA LOAD USER MAP CLA XMA SET DMA1 FROM SYS MAP INA XMA SET DMA2 FROM SYS MAP LDA BPA2 GET LAST USER LINK INA INCREASE T4<:6O FIRST SYSTEM LINK IOR B2000 SET BIT 10 TO SHOW LOWER MAPPED LFA SET FENCE FOR BP ******* END DMS CODE *************** XIF SPC 1 JMP $ZZZZ,I END DISPATCHER INITIALIZE * ORG * SIZE OF MODULE HED ** SYSTEM BASE PAGE COMMUNICATION AREA ** * * *** SYSTEM BASE PAGE COMMUNICATION AREA *** * XI EQU 1647B . EQU 1650B ESTABLISH ORIGIN OF AREA * * SYSTEM TABLE DEFINITION * * * DEFINITION OF SYSTEM LISTS (QUEUES) * * SKEDD EQU .+33 'SCHEDULE' LIST, * * DEFINITION OF EXECUTING PROGRAM ID SEGMENT' * * XEQT EQU .+39 ID SEGMENT ADDR. OF CURRENT PROG. XLINK EQU .+40 'LINKAGE' XTEMP EQU .+41 'TEMPORARY (5-WORDS) XPRIO EQU .+46 'PRIORITY' WORD XPENT EQU .+47 'PRIMARY ENTRY POINT' XSUSP EQU .+48 'POINT OF SUSPENSION' XA EQU 1731B XB EQU 1732B XEO EQU 1733B * * * DEFINITION OF MEMORY ALLOCATION BASES * * BPA2 EQU .+59 LWA R/T DISC RES. BP LINK AREA LBORG EQU .+61 FWA OF RESIDENT LIBRARY AREA RTDRA EQU .+64 FWA OF R/T DISC RESIDENT AREA AVMEM EQU .+65 FWA OF SYSTEM AVAILABLE MEMORY BKDRA EQU .+68 FWA OF BKG DISC RESIDENT AREA * * UTILITY PARAMETERS * $CON EQU 1736B POINTER TO CURRENT SESSION TABLE FENCE EQU .+85 MEM PROTECT FENCE ADDRESS * BKLWA EQU .+87 LWA OF MEMORY IN BACKGROUND * * * A EQU 0B LOCATION OF A REGISTER B EQU 1B LOCATION OF B REGISTER * ORG * PROGRAM LENGTH END $ZZZZ Ei< t 92064-18010 1650 S C0122 &MBU I/O BURRERING             H0101 f>*USE 'ASMB,R,N' (RTE-M I/RTE-M II) OR 'ASMB,R,Z' (RTE-M III) * * IFN OPTION * NAME: $MBU * SOURCE: 92064-18010 * RELOC: 92064-16005 AND ALSO PART OF 92064-16002 * PROGMR: E.J.W. BASED ON RTE-III VERSIONS G.A.A.,L.W.A.,D.L.S. * * IFZ OPTION * NAME : $MBU3 * SOURCE: 92064-18010 * RELOC: PART OF 92064-16003 * PROGMR: E.J.W. BASED ON RTE-III VERSIONS G.A.A.,L.W.A.,D.L.S. * * **************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT * * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * **************************************************************** * * IFN * BEGIN NON-DMS CODE *************** NAM $MBU,0 92064-16005 REV.1650 761020 *** END NON-DMS CODE *************** XIF IFZ ***** BEGIN DMS CODE *************** NAM $MBU3,0 92064-16003 REV.1650 761020 ******* END DMS CODE *************** XIF SPC 1 ENT $QCHK ENT $ALC,$RTN EXT $LIST,$WORK,$MIC * * REQUESTS MAY BE MADE TO ALLOCATE AND RELEASE BUFFERS * FROM THE MEMORY AVAILABLE AFTER LOADING. * * 1. ALLOCATE: CALLING SEQUENCE - * (P) JSB $ALC * (P+1) (# OF WORDS NEEDED) * (P+2) -RETURN NO MEMORY EVER (A)=-1, (B)=MAX EVER * (P+3) -RETURN NO MEMORY NOW (A)=0, (B)=MAX NOW * (P+4) -RETURN OK (A)=ADDR , (B)=SIZE OR SIZE+1 * * 2. RELEASE BUFFER TO AVAILABLE MEMORY * (P) JSB $RTN * (P+1) (FWA OF BUFFER) * (P+2) (# OF WORDS RETURNED) * (P+3) -RETURN- (ALL REGISTERS DESTROYED) * * IF A REQUEST FOR A BUFFER OF LENGTH X CANNOT BE FILLED * DURING A GIVEN CALL, RETURN IS MADE WITH: * (A) = 0 * IF, WHEN BUFFER REQUESTED, - (SMEM ) - SHOWS INSUFFICIENT CORE * AVAILABLE TO CONTAIN A BUFFER OF THE LENGTH REQUESTED, * THEN RETURN IS MADE WITH: * (A) = -1 * (B) = MAXIMUM LENGTH BUFFER THAT THE PROGRAM MAY ALLOCATE. * TO FIND OUT HOW LARGE A BUFFER MAY BE ALLOCATED, USE THE CALL * JSB $ALC * DEC 32767 * BLOCKS OF MEMORY AVAILABLE FOR OUTPUT BUFFERING ARE LINKED THROUGH * THE FIRST TWO WORDS OF EACH BLOCK - * WORD1 - LENGTH OF BLOCK * WORD2 - ADDRESS OF NEXT BLOCK (OR 77777 IF THIS IS LAST BLOCK) * THE ALLOCATOR 'TRANSFERS' THE UPPER END OF A BLOCK TO IOC AND * SHORTENS THE LENGTH OF THE BLOCK BY THE AMOUNT 'TRANSFERRED' * REGISTERS ARE NOT PRESERVED SKP SKP 2 $ALC JMP ALCIN INIT (FROM $STRT, RETURNS TO $WORK) SPC 1 IFZ ***** BEGIN DMS CODE *************** RSA STORE MEU STATUS IN MEM RAL,RAL STA DMSST SJP *+2 ******* END DMS CODE *************** XIF SPC 1 LDA $ALC,I GET THE LENGTH OF THE REQUEST STA ADX AND SAVE IT STA XTEMP,I SAVE IN ID SEG IN CASE SUSPEND LDB A ADA SMEM ENOUGH MEMORY NOW SSA TO HONOR THE REQUEST? JMP .A1 YES, GO ALLOCATE. ADB MAXEV SSB,RSS WHAT ABOUT LATER? JMP ERETN NEVER! ISZ $ALC MAYBE, BUT NOT NOW. REJ CLA,CLE,RSS A=0, E=0 NOT NOW ERETN CCA,CLE A=-1,E=0 NOT EVER JMP SETB RETURN * .A1 ISZ $ALC TRY AN ALLOCATION CCA SET CORE AVAIL. NOW TO 0 STA ALCIN LDB PNTRA START THE SEARCH LOOP WITH .A2 STB BAD SET LAST BUFFER ADDRESS CLE,INB STEP TO THE NEXT ADDRESS LDB B,I GET THE NEXT SEGMENT ADDRESS CPB M7 IF 77777 THEN END OF LIST AND NO JMP NOMOR MEMORY SO REJECT LDA B,I CHECK TO SEE IF THIS IS THE (, ADA ALCIN LARGEST LENGTH SO FAR LDA B,I GET THE LENGTH CMA,SEZ SET NEG(-1) AND IF STA ALCIN LARGEST SO FAR SAVE ADA ADX WILL IT SATISFY THE REQUEST? CMA,SSA IF ZERO OR NEGATIVE USE IT JMP .A2 ELSE GO TRY NEXT ONE ADA DM2 IS BLOCK AT LEAST 2 WORDS CCE,SSA LARGER THAN REQUEST? JMP .A4 NO-ALLOCATE WHOLE BLOCK ADA D2 (A)=LENGTH(I)-L(X) STA B,I SET NEW L(I) ADA B (A)=BUFFER ADDRESS JMP SETA RETURN TO USER * .A4 LDA B,I ALLOCATE ENTIRE BLOCK. STA ADX SET BUFFER LENGTH STB A BUFFER ADDRESS TO A .INB CCE,INB SET E FOR ACCEPTED RETURN LDB B,I GET THE POINTER TO THE NEXT BLOCK ISZ BAD STEP TO POINTER ADDRESS IN LAST STB BAD,I BLOCK AND SET THE POINTER SETA ISZ $ALC SETB LDB MAXEV SET B FOR REJECT SZA,RSS IF JUST FOR NOW RESET TO MAX LDB SMEM AVAILABLE NOW CMB,SEZ SET POSITIVE AND IF REQUEST LDB ADX SATISFIED SET TO LENGTH ISZ $ALC STEP RETURN ADDRESS SPC 1 IFN * BEGIN NON-DMS CODE *************** JMP $ALC,I RETURN *** END NON-DMS CODE *************** XIF SPC 1 IFZ ***** BEGIN DMS CODE *************** JRS DMSST $ALC,I RETURN, RESTORE STATUS TO MEU DMSST NOP ******* END DMS CODE *************** XIF SPC 1 * NOMOR LDA ALCIN PICK UP MAX LEFT DURING SEARCH STA SMEM UPDATE MAX AVAILABLE NOW JMP REJ NOW RETURN * * $RTN NOP ENTRY POINT FOR BUFFER RETURN SPC 1 IFZ ***** BEGIN DMS CODE *************** RSA STORE MEU STATUS RAL,RAL STA DMSST SJP *+2 ******* END DMS CODE *************** XIF SPC 1 LDA $RTN,I (A) = FWA RETURN BUFFER (ADX) STA ADX CMA,INA SET NEG AND STA SAVA SAVE ISZ $RTN * LDB $RTN,I # OF WORDS RETURNED (X) ADB DM2 SSB <2? JMP RETNR BUFFER TOO SMALL - IGNORE MIC1 JMP NMIC1 LDB PNTRA GET THE STARTING POINTER OCT 105627 CALL MICRO. (A)=-ADDR,(B)=PNTRA STB BAD JMP .R12 * NMIC1 LDA PNTRA GET STARTING POINTER .R11 STA BAD BAD _ AAD NMIC3 INA LDB A,I AAD _ NEXTBUFAD STB A A _ PNTR ADB SAVA AAD -ADX CMB,SSB,INB,SZB ADX-AAD>=0? RSS SKIP IF FOUND JMP .R11 ELSE CONTINUE * * * LDB BAD GET LOWER BUFFER ADDRESS .R12 CPB PNTRA IF LOCATE POINTER JMP .R3 ASSUME NO OVERLAP ADB B,I ADD LENGTH AND ADB SAVA SUBTRACT NEW BLOCK ADDRESS CMB,SSB,INB,RSS IF NEG NO OVERLAP SO JMP .R3 JUMP ADB $RTN,I ELSE COMPUTE NEW LENGTH ADB BAD,I NOW HAVE NEW +OLD-OVERLAP .R4 STB BAD,I SET LENGTH ;CHECK FOR HIGH OVER- ADB BAD LAP COMPUTE END OF BLOCK CMB,CLE,INB AND SUBTRACT FROM THE HIGH BLOCK ADB A A HAS HIGH BLOCK ADDRESS SEZ,CLE,SZB IF RESULT POSITIVE JMP .R5 JUMP ADB A,I ADD OLD UPPER LENGTH ADB BAD,I CURRENT LENGTH STB BAD,I NEW+OLD-OVERLAP CLE,INA GET POINTER AND BRING LDA A,I DOWN TO NEW BLOCK .R5 LDB BAD,I SAVE MAX LENGTH THIS RETURN ISZ BAD STEP TO POINTER ADRRESS STA BAD,I SET THE POINTER LDA SMEM CHECK TOO SEE IF THIS LENGTH ADA B ADD CURRENT MAX CMB,SEZ,CLE SET NEG; NEW MAX? STB SMEM YES; SET IT RETNR ISZ $RTN MEM16 LDB SUSP3 GET SUSPENSION LIST PTR SZB,RSS IF END OF LIST JMP MPRTN RETURN. * LDA B INA PICK UP XTEMP,I FOR LDA A,I BLOCK SIZE REQUESTED. ADA SMEM| COMPARE TO MAX NOW CMA,SSA,INA,SZA ENOUGH YET? JMP MPRTN NO, TOO BAD. JSB $LIST YES, SCHEDULE PROGRAM. OCT 401 JMP MEM16 TRY NEXT PROGRAM TOO. * .R3 ISZ BAD NO LOW OVERLAP SET NEW BLOCK LDB ADX ADDRESS IN LOW BLOCK STB BAD,I TO LINK THE BLOCKS STB BAD SET POINTER FOR HIGH BLOCK CHECK LDB $RTN,I SET B TO THE LENGTH OF RETURN JMP .R4 CHECK FOR HIGH OVERLAP * MPRTN EQU * SPC 1 IFN * BEGIN NON-DMS CODE *************** JMP $RTN,I RETURN *** END NON-DMS CODE *************** XIF SPC 1 IFZ ***** BEGIN DMS CODE *************** JRS DMSST $RTN,I RETURN, RESTORE DMS STATUS ******* END DMS CODE *************** XIF SPC 1 * * PNTRA DEF SMEM DUMMY BLOCK ADDRESS(DON'T MESS!) SMEM OCT -1 DUMMY BLOCK LENGTH (NOT USED) PNTR OCT 77777 DUMMY BLOCK END (DON'T MESS!) BAD NOP SAVA NOP M7 OCT 77777 DM2 OCT -2 D2 OCT 2 ADX NOP * ALCIN LDA SMEM INITIALIZATION CODE MAXEV STA * MAX SIZE BLOCK EVER AVAILABLE TEMP1 CLB TEMP2 LDA $MIC SZA DO WE HAVE MICROCODE? STB MIC1 YES JMP $WORK JMP TO NEXT STARTUP ROUTINE * A EQU 0 B EQU 1 SUSP3 EQU 1714B XTEMP EQU 1721B * * * THE QUEUE CHECK ROUTINE CHECKS TO SEE IF THE QUEUE ON * THE CURRENT EQT HAS MORE THEN THE 'LIMIT' NUMBER OF WORDS * OF BUFFER MEMORY ON IT AT THE CURRENT TIME. * THE LIMIT IS PASSED IN THE B-REG. SO THE ROUTINE CAN * CAN BE USED FOR BOTH UPPER AND LOWER LIMIT CHECKS. * CALLING SEQUENCE: * LDB NEGATIVE OF LIMIT * JSB QCHK * --- MORE THAN LIMIT WORDS ON QUEUE * --- LESS THAN LIMIT WORDS ON QUEUE * EQT1 ADDRESS IS IN B ON EXIT * $QCHK NOP SPC 1 IFZ ***** BEGIN DMS CODE *************** RSA RAL,RAL SJP *+2 SJP SO WE CAN ('$"SEE S.A.M. STA DMSST SAVE DMS STATUS ******* END DMS CODE *************** XIF SPC 1 STB TEMP1 SET LIMIT LDA EQT1,I START AT EQT HEAD RAL,CLE,ERA CLEAR POSSIBLE SIGN BIT CLE,SZB INIT E=0, SKIP CHECK IF 0 LIMIT QCHK1 SZA,RSS END OF QUEUE? JMP QCHK3 YES GO EXIT * STA TEMP2 SET CURRENT ELEMEMT INA GET THE CON WORD LDB A,I TO B RBL CHECK IF A BUFFERED SSB,RSS REQUEST? JMP QCHK2 NO TRY NEXT ONE * ADA D2 YES STEP TO THE COUNT LDB A,I GET COUNT TO B ADB TEMP1 ADD TO LIMIT STB TEMP1 AND RESET QCHK2 LDA TEMP2,I GET NEXT ELEMENT JMP QCHK1 GO CHECK THIS ELEMENT * QCHK3 LDB EQT1 GET SUSPEND POINTER SEZ,RSS OVERFLOW? ISZ $QCHK NO STEP RETURN SPC 1 IFN * BEGIN NON-DMS CODE *************** JMP $QCHK,I RETURN *** END NON-DMS CODE *************** XIF SPC 1 IFZ ***** BEGIN DMS CODE *************** JRS DMSST $QCHK,I RETURN ******* END DMS CODE *************** XIF SPC 1 SPC 4 EQT1 EQU 1660B * BSS 0 SIZE OF MODULE END $ u  92064-18016 1650 S C0122 &MMESS RTE-M MESSS             H0101 $ASMB,R,L,C * NAME : $MMES * SOURCE: 92064-18016 * RELOC: 92064-16004 * PROGMR: E.J.W. * * **************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT * * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * **************************************************************** * * NAM $MMES,7 92064-16004 REV.1650 761020 ENT MESSS EXT $LIBR,$LIBX,$MESS,.ENTP,$WORK,$PVCN SPC 2 A EQU 0 B EQU 1 SPC 2 BUFFR NOP LNGTH NOP P1 NOP LU OF MTM TERMINAL MESSS NOP JSB $LIBR GO PRIVILEGED CNTR NOP JSB .ENTP GET PARAMETERS DEF BUFFR LDA MESSS LDB HERE SZB DON'T HANDLE MORE THAN ONE REQUEST JMP EXIT2 AT A TIME, IGNORE OTHERS TIL DONE * THERE STA RTN STA HERE LDA DEFEF STA MESSS CLA STA $PVCN LDA BUFFR LDB LNGTH,I JSB $MESS PASS MESSAGE TO SYSTEM ISZ $PVCN SZA,RSS ANY MESSAGES RETURNED? JMP ONRU NO, CHECK FOR SPECIAL COMMANDS * LDB A,I YES, PROCESS MESSAGE STB LNGTH BRS STB CNTR LOOP INA LDB A,I STB BUFFR,I ISZ BUFFR ISZ CNTR JMP LOOP * LDA LNGTH EXIT CLB ALL DONE. CLEAR MESSS BUSY FLAGS STB HERE STB P1 EXIT1 JSB $LIBX EXIT DEF DEF RTN * RTN NOP HERE NOP DEFEF DEF DEF SPC 2 ONRU EQU * LDA BUFFR,I TEST FOR ON,RUN CPA =AON COMMANDS JMP DP1 TEST 1ST PRAM CPA =ARU JMP DP1 CPA =ALO TEST ALSO FOR LO,PL JMP DP2 TO SET UP MTM TABLE CPA =APL JMP DP2 JMP EXIT2 NEITHER RUN N  OR ON-EXIT2 SPC 2 DP1 EQU * LDB $WORK GET ID SEG ADDR OF SCHEDULED PROG INB LDA B,I SZA,RSS IS FIRST PARAM = 0? LDA P1,I YES, FILL IN MTM LU STA B,I * DP2 LDB $WORK ADB D28 SET UP MTM TABLE LDA B,I AT ID SEG WORD 29 AND C77 MERGE MTM LU IOR P1,I INTO BITS 0-5 STA B,I KEEPING OTHERS UNCHANGED * EXIT2 CLA ZERO OUT 'A' REG FOR RETURN JMP EXIT SPC 2 D28 DEC 28 C77 OCT 177700 END h  v} 92064-18017 1805 S C0122 &.MBT MOVE BYTES SUBROUTINE             H0101 2ASMB,R,L,C EIG FOR HP2100 BY E.J.W. JULY 1975 * MODIFIED BY G.L.M OCT 1977 * * EXTENDED INSTRUCTION GROUP OF THE 21MX SERIES * EMULATED ON THE 2100 INSTRUCTION SET * BY EUGENE J. WONG * JULY 1975 * * NAM .CBT 92064-16037 REV. 1805 771108 ENT .CBT,.LBT,.MBT,.SBT,.SFB * * * SOURCE - 92064-18017 * RELOCATABLE - 92064-16037 .A NOP A-REGISTER .B NOP B-REGISTER .EO NOP E,O REGISTERS * * COMPARE BYTES ROUTINE * * (A) = STRING1 BYTE ADDRESS * (B) = STRING2 BYTE ADDRESS * P JSB .CBT * P+1 DEF COUNT NUMBER OF BYTES * P+2 NOP TEMP. STORAGE FOR ROUTINE * P+3 (A)=STRING1 BYTE ADDR + COUNT * P+4 (A)=STRING1 BYTE ADDR WHERE STOPPED * P+5 STRING2> (A)=STRING1 BYTE ADDR WHERE STOPPED * (B)=STRING2 BYTE ADDR + COUNT * .CBT NOP DST .A SAVE A,B REGS ERA,ALS SAVE E,O REGS SOC C INA STA .EO LDA .CBT,I GET COUNT ADDR LDA 0,I GET COUNT ADA 1 CALC. ADDR+1 OF LAST STA STOP BYTE IN STRING2 LDA .CBT,I GET COUNT ADDR AGAIN LDA 0,I NEGATE BYTE COUNT CMA,INA,SZA,RSS FOR LOOP JMP RTN RETURN EQUAL IF ZERO COUNT ISZ .CBT GET ADDR OF USER TEMP WORD STA .CBT,I SAVE NEGATIVE COUNT * LOOP LDB .A GET ADDR OF STRING1 BYTE JSB LBT GET THE BYTE STB .A SAVE ADDR OF NEXT STRING1 BYTE CMA,INA STA TEST NEGATE AND SAVE LDB .B GET ADDR OF STRING2 BYTE JSB LBT GET THE BYTE STB .B SAVE ADDR OF NEXT STRING1 BYTE ADA TEST SUBTRACT STRING1 BYTE SSA JMP MORE STRING1 > STRING2 SZA JMP LESS STRING1 < STRING2 ISZ .CBT,I JMP LOOP NOT DONE YET * JMP RTN IF FALL THROUGH, EQUAL! MORE ISZ .CBT LESS ISZ .CBT RTN CCA SUBTRACT ONE FOR BYTE ADDR ADA .A (A)=BYTE ADDR OF LAST COMPARE ISZ .CBT OR ADDR OF NEXT IF EQUAL STRINGS LDB .EO RESTORE E,O REGS SLB,ELB STO LDB STOP SET UP B-REG JMP .CBT,I RETURN * * LOAD BYTE ROUTINE * .LBT NOP ERA,ALS SAVE E,O REGS SOC C INA STA .EO JSB LBT CALL LOCAL ROUTINE TO DO IT STB .B SAVE B-REG TEMPORARILY LDB .EO RESTORE E,O REGS SLB,ELB STO LDB .B RESTORE B-REG JMP .LBT,I RETURN * * MOVE BYTES ROUTINE * * (A) = SOURCE ADDRESS * (B) = DESTINATION ADDRESS * P JSB .MBT * P+1 DEF N BYTE COUNT * P+2 NOP TEMP FOR .MBT * P+3 * (A) = ADDR+1 OF LAST SOURCE BYTE * (B) = ADDR+1 OF LAST DESTINATION WORD * .MBT NOP DST .A SAVE A,B REGS ERA,ALS SAVE E,O REGS SOC C INA STA .EO * LDA .MBT,I GET ADDR OF COUNT ISZ .MBT LDA 0,I GET BYTE COUNT CMA,INA,SZA,RSS JMP RMBT EXIT IF COUNT=0 STA .MBT,I ELSE SAVE NEGATIVE COUNT * MBTL LDB .A GET SOURCE ADDR JSB LBT GET THE BYTE STB .A SAVE NEW SOURCE ADDR LDB .B GET DESTINATION ADDR JSB SBT STORE THE BYTE STB .B SAVE NEW DESTINATION ADDR ISZ .MBT,I INCREMENT THE COUNT JMP MBTL MOVE SOME MORE IF NOT DONE. * RMBT ISZ .MBT INCREMENT RETURN ADDR LDA .EO RESTORE E,O REGS SLA,ELA STO DLD .A SET NEW BYTE ADDRS IN A,B REGS JMP .MBT,I RETURN * * STORE BYTE {ROUTINE * .SBT NOP STA .A SAVE A-REG ERA,ALS SAVE E,O REGS SOC C INA STA .EO LDA .A KEEP ONLY LOW HALF AND B377 JSB SBT CALL LOCAL ROUTINE TO DO IT LDA .EO RESTORE E,O REGS SLA,ELA STO LDA .A RESTORE A-REG JMP .SBT,I RETURN * * SEARCH FOR BYTES ROUTINE * * A=STOP BYTE-TEST BYTE * B=FIRST BYTE ADDRESS OF SEARCH * P JSB .SFB * P+1 (B)=BYTE ADDR OF MATCH * P+2 (B)=BYTE ADDR+1 OF STOP * .SFB NOP STA .A SAVE A-REG ERA,ALS SAVE E,O REGS SOC C INA STA .EO * LDA .A AND B377 STA TEST SAVE TEST BYTE XOR .A ALF,ALF STA STOP SAVE STOP BYTE * SFBL LDA .A SET A IN CASE OF WRAP-AROUND JSB LBT FETCH A BYTE CPA TEST DOES IT MATCH TEST BYTE? JMP MATCH YES, EXIT CPA STOP MATCH STOP BYTE? RSS YES JMP SFBL NO, KEEP SEARCHING * * IF WRAP-AROUND OCCURRED, A-REG ISZ .SFB WOULD MATCH STOP BYTE. INCRE RETURN RSS MATCH ADB N1 ADJUST BYTE ADDRESS FOR MATCH LDA .EO RESTORE E,O REGS SLA,ELA STO LDA .A RESTORE A-REG JMP .SFB,I RETURN * TEST NOP STOP NOP N1 OCT -1 * * * ************************************** * LOCAL ROUTINES FOR BYTE LOAD/STORE * LBT NOP CLE,ERB SET (B) TO WORD ADDR LDA 1,I GET WORD AND SHIFT ACCORDING TO ELB (SLB) CONTAINING EVEN/ODD POSITION SLB,INB,RSS ALSO BUMP BYTE COUNT ALF,ALF IT WAS EVEN. AND B377 KEEP BYTE JMP LBT,I RETURN BYTE IN (A) * B377 OCT 377 C377 OCT 177400 CHAR NOP * SBT NOP STA CHAR SAVE NEW BYTE TEMPORARILY RB CLE,ERB SET (B) TO WORD ADDR LDA 1,I GET WORD ANDSHIFT ACCORDING TO SEZ,RSS ROTATE IF ODD CHAR ALF,ALF IT WAS EVEN. AND C377 KEEP HALF WHICH IS STAYING IOR CHAR FILL IN NEW BYTE SEZ,RSS ALF,ALF SHIFT IF NEEDED STA 1,I SAVE NEW WORD ELB RESTORE BYTE ADDR INB INCREMENT TO NEXT BYTE ADDR JMP SBT,I RETURN * * END ( w 92064-18018 1805 S C0122 &MMP MI SCHED OPTION             H0101 OASMB,R,L,C * * NAME : $MMP * SOURCE: 92064-18018 * RELOC: 92064-16006 * PROGMR: E.J.W. * * **************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT * * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * **************************************************************** * * NAM $MMP,0 92064-16006 REV.1805 771031 * ENT $SABR,$MPT1,$MPT4,$MPT5,$MPT7 EXT $TREM,$WORK,$LIST,$XEQ,$WATR,$PRAM,$TIMR,$TNAM EXT $ERAB,$IOCL * SPC 1 * * THE SOFT ABORT ROUTINE CLEARS ANY RESOURCE FLAGS * CALLS THE TERMINATION ROUTINE AND REMOVES A PROGRAM FROM * THE TIME LIST. * * IT ALSO SETS THE ABORT FLAG (100000) IN THE FATHERS ID-SEG. * (IF THERE IS A FATHER AND HE IS WAITING) SO THAT RMPAR * MAY RECOVER THE PRAMETER. * * IF THE PROGRAM IS WAITING FOR A SON IT CLEARS THE SONS * "FATHER IS WAITING" FLAG. * * CALLING SEQUENCE: * * LDB ID-SEG. ADDRESS * JSB $SABR * * RETURN REGISTERS MEANING LESS. * * THIS ROUTINE DOES NOT GENERATE AN ABORT MESSAGE NOR DOES IT * PULL A PROGRAM OUT OF AN I/O LIST. ($LIST DOES SET A FLAG * WHICH WILL PUT THE PROGRAM DORMANT ON I/O COMPLETION. * $SABR NOP STB TEMPH SAVE THE ID ADDRESS ADB D16 GET ADDR OF TIME LIST WORD JSB $TREM REMOVE PGM FROM THE TIME LIST LDB TEMPH RESTORE THE ID ADDRESS AND ADB D15 INDEX TO THE STATUS WORD LDB B,I AND FETCH IT BLF,SLB IF PROGRAM'S WAITING FOR SON JMP SABT2 GO CLEAR THE SON'S FLAG * SABT1 LDB TEMPH RESTORE THE ID-SEG. ADDRESS AND JSB TERM CALL THE TERMINATION PROCESSOR ISZ POP STEP TO THE FATHER'S FIRST PRAM WORD RSS  JMP $SABR,I LDA SIGN SET SIGN BIT FOR FATHER ABORT FLAG STA POP,I SET THE ABORT FLAG LDB POP CACULATE THE B-REG ADDRESS ADB D9 AND LDA POP SET IT TO STA B,I POINT TO THE ABORT WORD JMP $SABR,I DONE RETURN * SABT2 LDB TEMPH GET THE SONS ID ADDRESS INB FROM WORD TWO LDB B,I OF THE ID-SEGMENT ADB D20 INDEX TO THE FATHER WAIT FLAG WORD LDA B,I GET THE WORD RAL,CLE,RAL CLEAR BIT 14 ERA,RAR AND STA B,I RESTORE THE WORD JMP SABT1 GO TERMINATE THE PROGRAM SPC 2 D12 DEC 12 D14 DEC 14 SPC 1 * MEMORY PROTECT VIOLATION SCHEDULER PREPROCESSORS ******************************************************************* * THE $MPT1 THRU $MPT7 PREPROCESSORS CONSIST OF MEMORY * PROTECT VIOLATION CALLS FROM EXEC THAT INVOLVE LIST * PROCESSING. * THE FOLLOWING REQUESTS ARE HANDLED: * PROGRAM COMPLETION (DORMANT) * SUSPEND (OPERATOR) * BACKGROUND SEGMENT LOAD * SCHEDULE WITH WAIT * SCHEDULE WITHOUT WAIT * CURRENT SYSTEM TIME (TIME ROUTINE CALL) * SET ID SEGMENT TIME VALUES (TIMER ROUTINE CALL) ******************************************************************* SPC 3 * * DORMANT REQUEST - PROGRAM HAS RUN TO COMPLETION * $MPT1 JSB GETID GET THE ID-SEGMENT ADDRESS OF AFFECTED STB P2 PROGRAM - SAVE THE ID ADDRESS FOR PRAM MOVE CPB XEQT IF CURRENT PGM. SKIP JMP MPT1A FATHER CHECKS * ADB D20 CHECK FOR FATHER KILLING SON CCA ADA B,I AND B377 STEP TO FATHER PTR ADA KEYWD ADDRESS OF FATHER'S ID IN A LDA A,I CPA XEQT CURRENT PROGRAM? RSS YES SKIP JMP ESC04 NO GO FLUSH * LDB $WORK RESTORE THE ID-SEGMENTw ADDRESS TO B * MPT1A LDA RQRTN UPDATE RETURN (B)= ID ADDR STA XSUSP,I CLA SET A TO ZERO IN CASE LDA RQP3,I PRAMETER NOT SUPPLIED CMA,SZA,RSS (-1) SERIALLY REUSABLE? JMP MPT1E YES, GO DO IT INA,SZA,RSS JMP MPT1B (0) STANDARD TERMINATION CALL. * INA,SZA,RSS JMP MPT1C (1) SAVE RESOURCES * INA,SZA,RSS JMP M0240 (2) SOFT ABORT * INA,SZA,RSS (3) HARD ABORT (LAST CHANCE) JMP M0250 WOW THAT WAS CLOSE! * LDB D2 JMP ESCXX GO ABORT HIM * M0240 JSB $SABR DO SOFT ABORT JMP $XEQ * M0250 LDA WSTAT,I AND D15 GET STATUS STA B LDA $WORK CPB D2 JMP $IOCL * * MPT1C EQU * CPB XEQT IF CURRENT PROGRAM JMP MPT1D SKIP DORMANT REQUEST JSB $LIST OCT 400 JMP $XEQ GO TO DISPATCHER * MPT1E CPB XEQT TERM SON AS REUSABLE RSS JMP MPT1B GO DO NORMAL TERMINATE JSB TERM CALL TERMINATE ROUTINE ISZ TMP,I IF OK, SET FLAG FOR SERIAL REUSE JMP MPT1F GO FINISH PROCESSING * MPT1D JSB $WATR FIND WAITERS LDB XEQT MPT1B JSB TERM CALL TERMINATION ROUTINE MPT1F LDA DM3 IF REQUEST PRAMS ADA RQCNT THEN SSA SKIP JMP $XEQ ELSE GO TO THE DISPATCHER * LDB DEFR4 GET DEF TO PRAMS LDA P2 GET ID-ADDRESS JSB $PRAM TRANSFER THE PRAMETERS JMP $XEQ GO TO THE DISPATCHER SPC 1 DM3 DEC -3 TEMPH NOP P2 NOP SPC 3 * THE TERM SUBROUTINE PERFORMS THE FOLLOWING FUNCTIONS: * * 1. CALL $LIST TO PUT THE PROGRAM IN THE DORMANT LIST * 2. IF THE PROGRAM HAS A FATHER WHO IS WAITING THE * FATHER IS RESCHEDULED * 3. CHECKS TO SEE IF ANOTHER PROGRAM IS WAITING FOR THIS ONE * AND SCHEDULES IT IF SO. * * CALLING SEQUENCE: * * LDB ID ADDRESSާ * JSB TERM * * ON RETURN THE FATHER POINTER (IF ANY) IS IN POP. * AND IF HE WAS WAITING E WILL BE SET ELSE E=0. * TERM NOP JSB $LIST PUT PGM. IN DORMANT OCT 400 LIST LDB $WORK GET ID SEG ADDRESS * ADB D20 INDEX TO THE PA POINTER LDA B,I GET THE WORD STB TMP SAVE THE ADDRESS RAL,ELA SET E IF FATHER IS WAITING CCB,SEZ,CME,RSS E=0 IF FATHER/1 IF NO FATHER JMP TERM2 IF NO FATHER GO SET -1. ADB KEYWD KEYWD-1 TO B (SETS E) RAR,CLE,RAR RESTORE A AND SET E TO FATHER WAITING. AND B377 GET THE FATHER ID NUMBER ADB A ID ADDRSS TO B LDB B,I GET THE ID-SEG ADDRESS TERM2 STB POP SAVE THE ADDRESS ADB D15 REMOVE THE POP'S WAIT BIT LDA B,I GET POP'S STATUS AND B7777 KNOCK OUT THE WAIT BIT SEZ,RSS IF WAITING STA B,I RESTORE THE WORD AND D15 IF POP'S CPA D3 IN THE WAIT LIST SEZ AND WAITING JMP TERM3 JSB $LIST THEN RESCHEDULE OCT 101 THE FATHER POP DEF POP * TERM3 LDA TMP,I GET THE FLAG WORD AND B7400 AND KEEP ONLY RE,RM,RN FLAGS STA TMP,I IN WORD JMP TERM,I RETURN * * D2 DEC 2 D3 DEC 3 D4 DEC 4 D5 DEC 5 D6 DEC 6 D7 DEC 7 D9 DEC 9 D10 DEC 10 D15 DEC 15 D16 DEC 16 D20 DEC 20 DM4 DEC -4 DM5 DEC -5 DM7 DEC -7 SIGN OCT 100000 B377 OCT 377 B7777 OCT 7777 TMP NOP WSTAT NOP B7400 OCT 7400 DEFR4 DEF RQP4,I SPC 2 SPC 3 * PRAMO PASSES PRAMETERS FORM RQP3,4,5,6,AND 7 TO * THE ID-SEGMENT POINTED TO BY WORK. * *** ONLY CALLED BY IDCKK *** * * CALLING SEQUENCE: * * SET UP $WORK * JSB PRAMO * * ID-SEGMENT MUST NOT HAVE NO PRAM BITS SET IN IT'S STATUS. * PRAMO NOP CLB,INB IF NO PRAMS CPB RQCNT THEN JMP PRAMO,I JUST EXIT * LDA $WORK SET ADDRESS IN A LDB DEFR3 PRAM ADDRESS IN B AND JSB $PRAM GO MOVE THE PRAMS. JMP PRAMO,I RETURN. * * SCHEDULE REQUEST WITH WAIT * $MPT4 JSB IDCKK CHECK IF PROGRAM DORMANT LDB XEQT GET THE ADDRESS ADB D20 OF THE BATCH FLAG LDB B,I AND SET IT RBL,SLB,ERB INTO THE RAL,ERA THE NEW PROGRAM IOR B40K SET THE FATHER IS WAITING BIT STA $IDNO,I SET THE WORD IN THE SON'S ID. JSB $LIST PUT CURRENT PGM IN OCT 503 THE WAIT LIST LDB XEQT ADB D15 LDA B,I IOR B10K SET STATUS WAIT REQUEST BIT STA B,I INTO CURRENT EXEC PROGRAM RSS * * SCHEDULE REQUEST WITHOUT WAIT * $MPT5 JSB IDCKK CHECK IF PROGRAM DORMANT LDB TMP GET SAVED A-REG AT SCHED QUEUED CALL LDA RQP1 AND RESTORE BEFORE RETURN AND D16 ONLY IF QUEUED CALL SZA STB XA,I * MEM15 LDA RQRTN STA XSUSP,I POINT JMP $XEQ * * ESC01 CLB,INB,RSS ILLEGAL PARAMETER COUNT ESC03 LDB D3 RSS ESC04 LDB D4 ESCXX LDA ASY OUTPUT SC ERROR CODE JMP $ERAB CALL SYSTEM ERROR MESSAGE ROUTINE * ESC05 LDB D5 NO SUCH PROG ERROR CODE JMP ESCXX * ESC02 LDB D2 .TOO FEW PARAMETERS ? JMP ESCXX SPC 1 B40K OCT 40000 B77 OCT 77 D28 DEC 28 SKP * * GETID IS A SUBROUTINE TO GET THE ID-SEGMENT ADDRESS * FROM PRAMETER NUMBER TWO WHERE THE USER MAY * SUPPLY ZERO (HIS ID) OR NOTHING (HIS ID) OR * AN ASCII NAME. * * CALLING SEQUENCE: * * JSB GETID * RETURN B= THE ID-SEGMENT ADDRESS. * IF NOT FOUND THEN ERROR "SC05"IS GENERATED * E=0 * A=0 ON ALL RETURNS * WORK = THE ID-ADDRESS * WSTAT = THE ID-STATUS ADDRESS * GETID NOP CLA IF NOT SUPPLIED PRESET TO ZERO ; LDB XEQT AND CURRENT PGM ADB D12 SET B TO POINT TO CURRENT NAME LDA RQP2,I GET THE PRAMETER SZA IF ZERO OR NOT SUPPLIED SKIP LDB RQP2 GET ADDRESS OF NAME JSB $TNAM GO SEARCH FOR IT LDA $WORK SET UP ADDR OF STATUS WORD ADA D15 STA WSTAT CLA,SEZ IF FOUND SKIP JMP ESC05 ELSE FLUSH HIM OUT OF THE SYSTEM * JMP GETID,I RETURN SPC 2 * $IDNO COMPUTES THE ID-SEGMENT NUMBER OF A PROGRAM * *** CALLED BY IDCKK, MTDB, CLASS I/O *** * * CALLING SEQUENCE * LDB ID-SEGMENT ADDRESS * JSB $IDNO * RETURN ID NUMBER IN B * $IDNO NOP STB GETID SAVE THE REQUESTED ID-ADDRESS LDB KEYWD IDNO LDA B,I GET KEYWORD BLOCK ENTRY INB STEP FOR NEXT ONE CPA GETID THIS IT? CMB,INB,RSS YES NEGATE AND SKIP JMP IDNO NO CONTINUE LOOP * ADB KEYWD NEGATIVE OF NUMBER TO B CMB,INB SET POSITIVE AND JMP $IDNO,I RETURN SKP * * SCHEDULE BY TIME * $MPT7 LDA DM7 CHECK PARAM COUNT FOR 7 ADA RQCNT SZA,RSS JMP MPT7A 7 OK ADA D3 CHECK FOR 4 PARAMETERS SZA JMP ESC01 ERROR IN PARAM COUNT LDA RQP5,I 4 PARAM OK - CHECK FOR NEGATIVE SSA,RSS INITIAL OFFSET JMP ESC02 NOT NEGATIVE AN ERROR * MPT7A LDA RQP3,I IF RESOLUTION CODE LDB D6 SZA ZERO OR ADA DM5 GREATER THAN 4 SSA,RSS THEN JMP ESCXX ABORT * JSB GETID GO GET THE ID-SEGMENT ADDRESS TO B LDA RQRTN PUT RETURN STA XSUSP,I ADDRESS IN THE ID SEG. JMP $TIMR GO CONTINUE REQUEST IN TIME ROUTINE SPC 1 * CHECK IF PROGRAM DORMANT AND THEN SCHEDULE * *** CALLED BY $MPT4, $MPT5 *** * IDCKK NOP LDB RQP2 GET ID SEGMENT ADDRESS JSB $TNAM SE;Z JMP ESC05 NO SUCH PROGRAM ERROR * LDA XA,I SAVE A-REG IN CASE OF STA TMP QUEUED CALL * LDB XEQT COMPUTE THE ID NUMBER JSB $IDNO AND STB GETID SAVE IT LDA $WORK ALSO COMPUTE THE ADA D15 STA WSTAT STATUS WORD ADDR ADA D5 AND FATHER WORD ADDR STA $IDNO AND SAVE IT LDA WSTAT,I CHECK PROGRAM STATUS FOR DORMANT AND S&NP KEEP JUST THE IMPORTANT BITS STA XA,I RETURN PROG STATUS IN A REG SZA DORMANT? JMP IDCK2 NO - CHECK FURTHER * IDCK3 JSB PRAMO PASS THE PRAMETERS IF ANY LDB XEQT INDEX TO WORD 29 OF ADB D28 FATHER'S ID SEG LDA B,I AND B77 GET CONSOLE LU IOR SIGN AND SET NEW-RUN FLAG LDB $WORK ADB D28 STORE INTO WORD 29 OF STA B,I SON'S ID SEG JSB $LIST THEN - SCHEDULE OCT 301 STA XA,I SHOW THAT IT WAS DONE LDA $WORK SET UP THE WAIT POINTER STA XTEMP,I INCASE IT IS A 9 REQUEST LDA $IDNO,I GET THE CURRENT FLAG BITS IOR GETID ADD THE FATHER NUMBER STA $IDNO,I AND RESET IT. JMP IDCKK,I RETURN SPC 1 IDCK2 RAL,ALR IF JUST THE NO PRAMS CMA,CLE,INA SET E LDA $IDNO,I CHECK TO SEE AND B377 IF THIS GUY IS THE FATHER CPA B IF NOT RSS THEN JMP MPT15 GO TEST FOR QUEING * SEZ IF JUST "NP" BIT THEN JMP IDCK3 GO SCHEDULE HIM * LDA WSTAT,I IF "R" AND "D" BITS BOTH SET AND B300 THEN JUST CPA B300 CLEAR THEM ELSE CLB,RSS JMP MPT15 GO CHECK FOR QUEUEING * XOR WSTAT,I CLEAR THE "R" AND "D" BITS STA WSTAT,I AND RESET IN SON'S ID STB XA,I INDICATE SUCESS. JMP MEM15 AND EXIT. * *SCHEDULE WITH WAIT WITH WAIT REQUEST A * * IF REQUESTED PROGRAM IS NOT DORMANT THE REQUESTER IS * SUSPENDED UNTIL IT IS. * MPT15 LDA RQP1 HERE AFTER FINDING REQUESTED PGM BUSY CPA D9 IF NO WAIT RSS THEN JUST DO CPA D10 THE OLD JMP MEM15 THING * LDB $WORK ELSE SET THE SUSPEND REASON STB XTEMP,I IN REQUESTERS ID-SEGMENT LDA $IDNO,I TO INDICATE IOR B1000 WE WERE HERE STA $IDNO,I JSB $LIST PUT REQUESTER IN WAIT LIST OCT 503 LDA TMP RESTORE A-REG FOR QUEUED CALL STA XA,I JMP $XEQ GO TRY SOMEBODY ELSE. SPC 2 ASY ASC 1,SC ASCII -SC- FOR SCHED ERROR DEFR3 DEF RQP3,I B10K OCT 10000 S&NP OCT 20017 STATUS PLUS NO PRAMS BIT MASK B300 OCT 300 B1000 OCT 1000 HED ** SYSTEM BASE PAGE COMMUNICATION AREA ** * * *** SYSTEM BASE PAGE COMMUNICATION AREA *** * . EQU 1650B ESTABLISH ORIGIN OF AREA * * SYSTEM TABLE DEFINITION * * KEYWD EQU .+7 FWA OF KEYWORD BLOCK * * SYSTEM REQUEST PROCESSOR /'EXEC' COMMUNICATION * * RQCNT EQU .+22 # OF REQUEST PARAMETERS -1 RQRTN EQU .+23 RETURN POINT ADDRESS RQP1 EQU .+24 ADDRESSES RQP2 EQU .+25 RQP3 EQU .+26 OF REQUEST RQP4 EQU .+27 RQP5 EQU .+28 * * DEFINITION OF SYSTEM LISTS (QUEUES) * * * * DEFINITION OF EXECUTING PROGRAM ID SEGMENT' * * XEQT EQU .+39 ID SEGMENT ADDR. OF CURRENT PROG. XTEMP EQU .+41 'TEMPORARY (5-WORDS) XSUSP EQU .+48 'POINT OF SUSPENSION' XA EQU .+49 'A REGISTER' AT SUSPENSION * * SYSTEM MODULE COMMUNICATION FLAGS * * * * DEFINITION OF MEMORY ALLOCATION BASES * * * A EQU 0B LOCATION OF A REGISTER B EQU 1B LOCATION OF B REGISTER ORG * PROGRAM LENGTH END l64006 x  92064-18020 1650 S C0122 &MTI RTE-M TIME OPTION             H0101 ~ASMB,R,L,C ** RTE-M TIME MODULE - TIMER ** * NAME : $MTI * SOURCE: 92064-18020 * RELOC: 92064-16008 * PROGMR: E.J.W. BASED ON RTE-III VERSIONS G.A.A. * * **************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT * * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * **************************************************************** * * NAM $MTI,0 92064-16008 REV.1650 761020 * SUP ENT $CLCK,$TIME,$TIMV,$SCLK,$MPT6 * * $MTI EXTERNAL REFERENCE NAMES * EXT $DEVT,$XEQ EXT $SYMG,$MIC EXT $TLST * ******************************************************************** * * THE $MTI MODULE OF THE RTE-M SYSTEM CONSISTS OF * * * 1. TIME PROCESSOR ROUTINES * * 2. CLOCK START UP ROUTINE. * * ******************************************************************** HED REAL TIME CLOCK-TIME LIST PROCESSING ******************************************************************** * THE REAL TIME CLOCK PROCESSOR SECTION OF HP REAL TIME* * EXECUTIVE HANDLES ALL TIME DEPENDENT FUNCTIONS: * * 1. INCREMENT REAL TIME CLOCK VALUES EVERY 10 MILLISECOND. * * 2. SCHEDULE PROGRAMS AT THE REQUESTED TIME AND COMPUTE ITS* * NEXT START TIME. * * 3. ADD PROGRAMS TO THE TIME LIST. * * 4. REMOVE PROGRAMS FROM THE TIME LIST. * * 5. OUTPUT CURRENT SYSTEM TIME TO USER ARRAY. * * 6. SET ID SEGMENT VALUES AS REQUESTED BY USER. * ******************************************************************** SPC 1 * THE $CLCK ROUTINE FUNCTIONS AS FOLLOWS: * * THE ROUTINE IS ENTERED EVERY 10 MILLISECOND DUE * * TO TIME BASE GENERATOR INTERRUPTS. * * THE TIME VALUE IS INCREMENTED BY 10 MILLISECONDS. * * THE TIME VALUES OF EACH PROGRAM IN TIME LIST IS * * COMPARED TO THE CURRENT TIME. IF THE TIMES * * COMPARE AND THE PROGRAM IS DORMANT, A SCHEDULE * * REQUEST IS MADE VIA LIST PROCESSOR. REGARDLESS * * OF PROGRAM STATUS, THE NEXT START TIME IS * * COMPUTED UNLESS THE MULTIPLE VALUE IS ZERO- * * WHICH MEANS THAT THE PROGRAM IS TO BE REMOVED * * FROM TIME LIST. * * THE TIME-OUT CLOCKS FOR ALL ACTIVE DEVICES ARE * UPDATED. IF ANY DEVICE HAS TIMED-OUT, * RTIOC IS ENTERED TO PROCESS THE CONDITION. * * $CLCK ISZ $TIME STEP THE LOW ORDER TIME VALUE JMP CL010 GO TO PROCESS LISTS ISZ $TIME+1 STEP THE HIGH ORDER TIME VALUE JMP CL010 GO TO PROCESS LISTS LDA RS1 RESET THE COUNTER LDB RS2 TO THE FULL STA $TIME DAYS WORTH OF STB $TIME+1 OF TENS OF MS. ISZ $TIME+2 STEP THE DAYS/YEARS COUNTER * * CHECK IF TIME TO SCHEDULE PROGRAM * CL010 JSB $TLST DO TIME LIST THING * * * PROCESS DEVICE TIME-OUT CLOCKS * IOTOP JMP NMIC1 OR 105626 IF HAVE MICRO DEF EQTA JMP $DEVT TIMED OUT EQT JMP $XEQ ALL DONE * NMIC1 LDA EQT# SET NEGATIVE OF CMA,INA NUMBER OF EQT STA $TIMV ENTRIES FOR INDEX LDA EQTA POINT TO WORD 15 IOTO2 ADA D14 OF FIRST EQT ENTRY LDB A,I LOAD WORKING CLOCK- SZB IS IT ACTIVE? ISZ A,I YES: INCREMENT IT INTXA,RSS IT HAS NOT TIMED-OUT JMP $DEVT GO TO TIME-OUT PROCESSOR ISZ $TIMV THRU? JMP IOTO2 NO: GO DO NEXT ONE JMP $XEQ YES; NO TIME-OUTS-RETURN SPC 1 RS1 OCT 25000 RS2 OCT 177574 PRS1 OCT 153000 PRS2 OCT 203 D2 DEC 2 D14 DEC 14 SPC 4 * * SYSTEM START TBG ROUTINE * * THE $SCLK ROUTINE STARTS THE CLOCK PROVIDES * AN ENTRY POINT TO AID THE POWERFAIL ROUTINE. * * ON FIRST ENTRY THIS ROUTINE: * * 1. CONFIGURES IT SELF * 2. STARTS THE TBG. * 3. PRINTS "SET TIME" * 4. EXITS TO THE DISPATCHER. * * ON SUBSEQUENT ENTRIES IT IS A SUBROUTINE TO RESTART * TIME BASE GENERATOR. * $SCLK JMP CONFI GO CONFIGURE ON FIRST ENTRY LDA D2 PROGRAM THE TBG FOR 10'S OF MS. OTATB OTA 0 STCTB OCT 1100 CONFIGURED TO A STC TBG,C STFTB OCT 1600 CONFIGURED TO A STF TBG JMP $SCLK,I RETURN SPC 2 CONFI LDA TBG CONFIGURE THE TBG TEMP IOR OTATB MAKE AN OTA TBG TEMP1 STA OTATB SET IT TEMP2 IOR STCTB FORM AN STC TBG,C TCC STA STCTB SET THE STC XOR STFTB SET UP THE STF STA STFTB LDB .IOT LDA $MIC SZA ANY MICRO? STB IOTOP YES, MAKE CALL TLINC JSB $SCLK START THE TBG POINT LDA TUDAT SEND THE JSB $SYMG SET TIME JMP $XEQ MESSAGE AND GO TO THE DISPATCHER SPC 2 .IOT OCT 105626 TUDAT DEF SETMS SETMS DEC -10 LENGTH OF SET TIME MESSAGE OCT 6412 PUT CR/LF OUT FIRST ASC 4,SET TIME SPC 4 $MPT6 DLD $TIME JSB $TIMV LDA RQRTN STA XSUSP,I JMP $XEQ SPC 4 * $TIMV ROUTINE TO GET CURRENT SYSTEM TIME * THE $TIMV ROUTINE CONVERTS THE CURRENT REAL TIME VALUES * * AND STORES THE VALUES INTO A USER SPECIFIED BUFFER. * * * * ROUTINE TO PROVIDE CURRENz&T TIME IS CALLED BY SCHED AND TMVAL * CALLING SEQUENCE * DLD TIME PUT TIME IN A AND B REGS. * JSB $TIMV * RQP2 CONTAINS BEGIN ADDRESS OF 5 WORD BUFFER * RQP3 (OPTIONAL) CONTAINS ADDRESS OF YEAR BUFFER * ON RETURN, * ARRAY(1) = TENS OF MILLISECOND * ARRAY(2) = SECONDS * ARRAY(3) = MINUTES * ARRAY(4) = HOURS * ARRAY(5) = DAYS * RQP3,I = YEAR (197X) * * E IS SET * A IS THE YEAR * $TIMV ASC 1,ME ENTRY/EXIT (END OF SET TIME MSS.) CLE CLE FOR ADDITION ADA PRS1 ADD POSITIVE 24 HRS. SEZ TO GET A POSITIVE INB TIME ADB PRS2 DIV TTAB3 DIVIDE BY 6000 STA RQP4 SAVE MIN/HR ASR 16 POSITION B (SEC/10MS) FOR DIVIDE DIV TTAB2 DIVIDE BY 100 TO GET SEC/10MS STB RQP2,I SET 10MS VALUE ISZ RQP2 STEP ADDRESS POINTER STA RQP2,I SET SEC. VALUE ISZ RQP2 STEP TO MIN. ADDRESS. CLB SET UP FOR DIVIDE LDA RQP4 FETCH MIN/HR DIV D60 SEPERATE STB RQP2,I SET MINUTES ISZ RQP2 STEP TO HR. ADDRESS STA RQP2,I SET HRS ISZ RQP2 STEP ADDRESS CLB SET B FOR DIVIDE LDA $TIME+2 GET DAYS FORM THE TIME DIV D365 SEPERATE DAYS AND YEARS CCE,INB STEP DAYS TO 1-365 FROM 0-364 STB RQP2,I SET DAYS ADA D1970 ADD THE BASE YEAR TO YEAR STA RQP3,I SET YEAR JMP $TIMV,I RETURN SPC 2 D60 DEC 60 D365 DEC 365 D1970 DEC 1970 BASE YEAR $TIME OCT 16000 OCT 177650 OCT 3573 TTAB2 DEC 100 TTAB3 DEC 6000 * * * ** SYSTEM BASE PAGE COMMUNICATION AREA ** * * *** SYSTEM BASE PAGE COMMUNICATION AREA *** * . EQU 1650B ESTABLISH ORIGIN OF AREA * * SYSTEM TABLE DEFINITION * * EQTA EQU .+0 FWA OF EQUIPMENT TABLE EQT# EQU .+1 # OF EQT ENTRIES * TBG EQU .+20 I/O ADDRESS OF TIME-BASE CARD * * SYSTEM REQUEST PROCESSOR /'EXEC' COMMUNICATION * * RQRTN EQU 1677B RQP2 EQU .+25 RQP3 EQU .+26 OF REQUEST RQP4 EQU .+27 XSUSP EQU 1730B A EQU 0B LOCATION OF A REGISTER B EQU 1B LOCATION OF B REGISTER ORG * PROGRAM LENGTH END $SCLK nS y  92064-18021 1650 S C0122 &MTS RTE-M TI SCH OPT             H0101 cASMB,R,L,C ** RTE-M TIME MODULE -SCHEDULING **** * NAME : $MTS * SOURCE: 92064-18021 * RELOC: 92064-16009 *_ PROGMR: E.J.W. BASED ON RTE-III VERSIONS G.A.A. * * **************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT * * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * **************************************************************** * * NAM $MTS,0 92064-16009 REV.1650 761020 * SUP ******************************************************************** * ENT $TADD,$TREM,$TLST ENT $ETTM,$TIMR ENT $ITRQ,$TMRQ,$ONTM,$TIRQ,$CHTO,$STRQ * EXT $LIST,$XEQ,$INER,$MSEX,$EQCK EXT $TIME,$TIMV,$WORK,$MSBF,$CVT1,$CVT3 SKP $TLST NOP SUBROUTINE TO SEARCH TIME LIST LDB TLIST TIME LIST CL011 CLE,SZB,RSS IF THRU PROCESSING IT, GO JMP $TLST,I RETURN TO PROCESS TIME-OUTS STB TEMP3 SAVE TIME LINK ADB D2 B NOW PTS TO IDSEG TIME VAULE DLD B,I GET THE SCHEDULE TIME CPA $TIME IF BOTH WORDS MATCH CCE THEN CPB $TIME+1 THE SEZ,RSS TIME IS JMP CH010 LDB TEMP3 JSB $TMSC NOW SO SCHEDULE THE PROG. * * INCREMENT TO NEXT PROGRAM IN LIST * CH010 LDB TEMP3,I GET ADDR OF NEXT PROG IN LIST JMP CL011 GO TO COMPARE NEXT PROG IN LIST * * * * * PROGRAM TO BE SCHEDULED * * THE $TMSC ROUTINE SCHEDULES THE PROGRAM IF DORMANT * THEN COMPUTES ITS NEXT SCHEDULE TIME FROM ITS * RES CODE AND MULT FACTOR IN ITS ID-SEGMENT. * IF THE RES CODE IS ZERO THE PROGRAM IS REMOVED FROM * THE TIME LIST. * * THE CALLING SEQUENCE IS: * (B) = POINTER TO ADDRESS OF THE TIME LINK WORD * JSB $TMSC R * $TMSC NOP STB TLINC COMPUTE THE STATUS ADDRESS ADB N1 LDA B,I GET THE STATUS AND D15 GET THE LOW BITS CCE,SZA IF NOT DORMANT JMP CH026 FORGIT IT * ADB D13 INDEX TO WORD 29 LDA B,I AND SET NEW-RUN FLAG RAL,ERA PRESERVING CONSOLE LU INFO STA B,I ADB DM28 SET (B) TO ID SEG ADDR JSB $LIST CALL LIST PROCESSOR TO SCHED PROG OCT 401 THE PROGRAM * * CHECK IF NEXT SCHEDULE TIME TO BE COMPUTED * CH026 LDB TLINC INB LDA B,I RES CODE/MULT FACTOR AND B7777 SZA,RSS IF ZERO, THEN NO NEW START TIME JMP CH040 GO REMOVE PROG FROM LIST STA TEMP SAVE MULTIPLICATION FACTOR JSB TUDAT GO UPDATE THE SCHEDULE TIME JMP $TMSC,I RETURN * * REMOVE PROGRAM FROM TIME LIST * CH040 LDA B10K CLEAR THE RESOLUTION TOO. STA B,I AND RESET IN THE ID-SEGMENT. LDB TLINC VALUE OF TLINK JSB $TREM GO TO REMOVE PROGRAM JMP $TMSC,I GO TO PROCESS NEXT PROGRAM HED REAL TIME CLOCK PROCESSING ID-TIME UPDATE * TUDAT USES THE RES AND MULT FROM THE ID-SEGMENT TO * UPDATE THE EXECUTE TIME OF THE PROGRAM WHOSE ID- * SEGMENT RESOLUTION CODE ADDRESS IS IN B. * * CALLING SEQUENCE: * * SET TEMP TO THE MULT FACTOR * SET B TO THE RES CODE ADDRESS * JSB TUDAT * TUDAT NOP ENTRY POINT LDA B,I GET THE RES CODE TO A INB SET STB TEMP1 TEMPS TO THE TIME INB ADDRESSES STB TEMP2 IN THE ID-SEGMENT RAL,CLE,SLA,RAL IF HOURS JMP HR GO DO SPECIAL HOURS UPDATE RAL,CLE ELSE SET UP AND D7 FOR THE APPROPIATE ADA TTAB BASE LDA A,I AND MULTIPLY BY THE MULT. CH030 MPY TEMP CH031 ADA TEMP1,I ADD THE CURRENT VALUE SEZ IF OVERFLOW INB STEP B ADB TEMP2,I ADD THE HIGH BITS. STA TEMP1,I RESTORE THE NEW TIME STB TEMP2,I TO THE ID-SEG. CLE,SSB IF NEGATIVE RESULT THEN JMP TUDAT,I EXIT * LDA RS1 POSITIVE RESULT SO ADD NEG. OF LDB RS2 DAY TO MAKE NEGATIVE JMP CH031 * HR LDA TEMP FOR HOURS FIRST CLB INSURE LESS THAN DIV D24 ONE DAY LDA B RESULT IS MODULO 24 MPY D15 NOW SET UP TO MULTIPLY BY 60,000 STA TEMP IN TWO STEPS TO PREVENT OVERFLOW LDA D24K FIRST BY 15, JMP CH030 AND NEXT BY 24,000 * TLIST NOP TOP OF TIME SCHEDULE LIST TTAB DEF * TTAB1 DEC 1 TTAB2 DEC 100 TTAB3 DEC 6000 D24K DEC 24000 D2 DEC 2 D7 DEC 7 D13 DEC 13 D15 DEC 15 D16 DEC 16 D24 DEC 24 DM28 DEC -28 N1 DEC -1 B7777 OCT 7777 TCC NOP DO NOT REARRANGE THESE 6 WORDS !! TEMP NOP TEMP1 NOP TEMP2 NOP TEMP3 NOP TEMP4 NOP DTCC DEF TCC RS1 OCT 25000 RS2 OCT 177574 D60 DEC 60 TLINC NOP SPC 4 HED $TIMR ROUTINE SETS UP ID SEGMENT TIME VALUES * THE $TIMR ROUTINE WHICH ALLOWS USER TO ENTER TIME VALUES * * INTO AN ID SEGMENT FUNCTIONS AS FOLLOWS: * * IF PROG VALUE IS ZERO, THEN CURRENT EXECUTING PROG. * * AND IF NON-ZERO, THEN SEARCH FOR ID SEGMENT * * ADDRESS. * * IF RESOLUTION CODE IS NON-ZERO, THEN RES/MULT WORD * * STORED. THE NEXT VALUE IS CHECKED FOR + OR -. * * IF PLUS, THEN NEXT START TIME VALUES GIVEN AND * * ARE STORED AND PROGRAM ENTERED INTO TIME LIST. * * IF MINUS, THEN THE COMPLEMENT OF VALUE IS ADDED* * TO THE CURRENT TIME AND ENTERED INTO THE ID * * SEGMENT. IF PROG VALUE IS ZERO, THIS IS TO BE A* * TIME DELAY OF CURRENT PROGRAM AND THUS PROGRAM * * IS SET DORMANT VIA LINK PROCESSOR BUT POINT OF * * SUSPENSION IS NOT CLEARED. IF PROG VALUE IS NON* * ZERO, THEN PROGRAM IS ENTERED INTO TIME LIST. * * THIS IS METHOD FOR SPECIFYING AN INITIAL OFFSET* * TIME. * * * ROUTINE TO SET ID SEGMENT TIME VALUES * CALLING SEQUENCE * JSB EXEC * DEF *+6 OR DEF *+9 * DEF REQUEST CODE ADDRESS RQP1 * DEF PROG RQP2 * DEF RES RQP3 * DEF MULT RQP4 * DEF OFFSET OR DEF HRS RQP5 * DEF MINS RQP6 * DEF SECS RQP7 * DEF TENS OF MSEC RQP8 * WHERE * PROG = 0 IF CURRENTLY EXECUTING * = ADDRESS OF PROGRAM NAME * RES = 1 FOR 10 MILLISECOND RESOLUTION * = 2 FOR SECONDS RESOLUTION LIST * = 3 FOR MINUTES RESOLUTION LIST * = 4 FOR HOURS RESOLUTION LIST * MULT = 0 FOR N0 MULTIPLE VALUE * = N A POSITIVE INTEGER FOR COMPUTING * NEXT SCHEDULE TIME * OFFSET= M A NEGATIVE INTEGER FOR COMPUTING INITIAL * OFFSET TIME * HRS= START TIME HOURS * MINS= START TIME MINUTES * SECS= START TIME SECONDS * TENS= START TIME TENS OF MILLISECONDS * * EXEC PRE-PROCESSOR CHECKS FOR RESOLUTION CODE * ERRORS AND FINDS THE ID-SEGMENT ADDRESS. * * CALLING SEQUENCE: * * LDB ID-SEGMENT ADDRESS * JMP $TIMR r SKP $TIMR ADB D16 GET ADDRESS OF TIME LINK STB TCC AND SAVE IT INB STEP TO RESOLUTION ADDRESS STB TEMP1 AND SAVE LDA B,I GET RESOLUTION CODE/T/MULT INB STEP TO TIME LOCATION STB DSTAD SAVE THE ADDRESS * ALF,ERA SAVE BIT 12 SINCE PROGRAM MAY LDA RQP4,I ALREADY BE IN THE TIME LIST ALF,ERA COMBINE MULT AND SAVED T-BIT LDB RQP3,I RESOLUTION TO B LSR 3 SHIFT RESULT TO A STA TEMP1,I SET IT IN THE ID-SEG. LDA RQP5,I NEGATIVE IF OFFSET SSA,RSS POSITIVE IF START TIME JMP TI100 CMA,INA SET POSITIVE AND STA TEMP SAVE IN TEMP LDA RQP2,I CHECK IF CURRENT XEQ PROGRAM SZA JMP TI012 NO * LDB XEQT YES, SET THE ADB D15 SAVE RESOURCES LDA B,I BIT IN THE IOR B200 PROGRAMS STA B,I STATUS WORD JSB $LIST MAKE PROGRAM DORMANT OCT 500 TI012 LDA $TIME GET THE CURRENT TIME LDB $TIME+1 AND SET DST DSTAD,I IT IN THE ID-SEG DSTAD EQU *-1 LDB TEMP1 GET THE RES. CODE ADDRESS TO B JSB TUDAT UPDATE THE TIME * TI015 LDB TCC JSB $TADD ENTER PROG INTO TIME LIST JMP $XEQ DONE - EXIT TO DISPATCHER * * GIVEN START TIME * TI100 LDB DSTAD SET B TO THE TIME ADDRESS AND JSB $ETTM GO TO STORE VALUES IN ID SEGMENT JMP TI015 GO PUT PROG IN TIME LIST * B200 OCT 200 HED REAL TIME CLOCK PROCESSOR SET TIME IN ID-SEG * $ETTM SETS A TIME IN THE REFERENCED ID-SEGMENT. * * CALLING SEQUENCE * * RQP5,I=HOURS * RQP6,I=MINUTES * RQP7,I=SECONDS * RQP8,I=TENS OF MS. * * B=TIME ADDRESS IN THE ID-SEG. * $ETTM NOP ENTRY POINT STB DSTA2 SAVE THE ID-SEG. ADDRESS LDA RQP7,I GET SECONDS MPY TTAB2 CONVERT TO MS (MPY D100)  ADA RQP8,I ADD THE MS VALUE AND STA RQP8 AND SAVE LDA RQP5,I GET HOURS MPY D60 CONVERT TO MINUTES ADA RQP6,I ADD MINUTES MPY TTAB3 CONVERT MINUTES TO MS (MPY D6000) CLE PREPARE FOR ADD ADA RQP8 ADD MS VALUE SEZ IF OVERFLOW INB STEP HIGH PART SET01 CLE,SSB IF POSITIVE JMP SET02 ADA RS1 SUBTRACT 24 HRS SEZ,CLE UNTIL INB ADB RS2 IT IS JMP SET01 NEGATIVE SET02 DST DSTA2,I SET THE VALUE IN THE ID-SEG. DSTA2 EQU *-1 JMP $ETTM,I RETURN HED ADDITION OF PROGRAM TO TIME RESOLUTION CODE LIST * THE $TADD ROUTINE FUNCTIONS AS FOLLOWS: * * IF RESOLUTION CODE IS ZERO, THEN EXIT * * IF NON-ZERO RESOLUTION, AND PROGRAM NOT IN TIME LIST* * (BIT 12 OF RES/T/MULT 0), THEN SET BIT 12 OF * * MULT WORD TO SIGNIFY THAT IT IS IN TIME LIST. * * IF TIME LIST IS NULL, THEN SET IT TO POINT TO * * PROGRAM TIME LINK AND SET TLINK TO ZERO. * * IF PROGRAM NOT IN LIST, THEN IT IS ADDED TO * * TOP OF TIME LIST AND ITS TLINK VALUE MADE * * TO POINT TO THE PREVIOUS TOP OF LIST * * PROGRAM. * * * * * ADDING A PROGRAM TO A TIME RESOLUTION CODE LIST * CALLING SEQUENCE * LDB ADDRESS OF ID SEGMENT TLINK VALUE * JSB $TADD * $TADD NOP STB TLINC SAVE TLINK ADDRESS INB INCR TO RES CODE/MULT FACTOR ADD LDA B,I ALF,CLE,ERA AND D7 SZA,RSS JMP $TADD,I EXIT SEZ PROG IN TIME LIST? JMP $TADD,I YES, SO EXIT * LDA B,I IOR B10K X; SET T BIT STA B,I LDB TLIST LOAD VALUE OF TOP OF LIST LDA TLINC SET LINK OF NEW PROG TO PREVIOUS STB A,I OF TIME LIST STA TLIST SET TOP OF TIME LIST TO NEW PROG TLINK ADDRESS JMP $TADD,I RETURN HED REMOVE A PROGRAM FROM TIME LIST * * * THE $TREM ROUTINE FUNCTIONS AS FOLLOWS: * * IF PROGRAM NOT IN TIME LIST, THEN EXIT * * IF PROGRAM IN TIME LIST, THEN CLEAR BIT 12 OF * * RES/T/MULT TO INDICATE NOT IN TIME LIST. * * A SEARCH IS MADE OF THE TIME LIST PROGRAMS * * UNTIL PROGRAM FOUND OR END OF LIST. THE * * TLINK VALUES ARE CHANGED AS NECESSARY. * * * * * CALLING SEQUENCE * LDB TLINK ADDRESS OF ID SEGMENT * JSB $TREM * $TREM NOP ENTRY/EXIT STB TLINC COMPUTE LIST ADDRESS INB LDA B,I CHECK IF PROGRAM IS IN TIME LIST AND B10K SZA,RSS JMP $TREM,I NO, SO EXIT XOR B,I CLEAR T-BIT STA B,I LDA DTLST GET ADDR OF TOP OF LIST PNTR * TR010 LDB A,I GET CURRENT TOP OF LIST CPB TLINC IS THIS THE PROG? JMP TR030 YES SZB,RSS END OF LIST? JMP $TREM,I YES, RETURN STB A SAVE ADDR OF CURRENT LINKWORD JMP TR010 GO CHECK NEXT PROG * TR030 LDB B,I LINK NEXT PROG STB A,I TO PREV PROG TO REMOVE JMP $TREM,I RETURN SPC 1 DTLST DEF TLIST B10K OCT 10000 HED TIMER OPERATOR COMMANDS * IT,XXXXX * IT,XXXXX,R,MMM * IT,XXXXX,R,MMM,HR,MN * IT,XXXXX,R,MMM,HR,MN,SC * IT,XXXXX,R,MMM,HR,MN,SC,MS * * R=RESOLUTION CODE * 1= TEN MILLISECOND CODE * _ 2= SECONDS CODE * 3= MINUTES CODE * 4= HOURS CODE * MM= MULTIPLICATION FACTOR * HR= START HOURS * MN= START MINUTES * SC= START SECONDS * MS= START TENS OF MILLISECONDS * $ITRQ LDA $WORK SET ADA D17 UP THE TIME PRAMETER STA TEMP STARTING ADDRESS. LDB $MSBF+9 GET THE RESOLUTION ADB DM5 CODE AND TEST SSB,RSS FOR MORE THAN 4. JMP $INER GREATER THAN 4-ILLEGAL CODE LDA $MSBF+13 GET THE MULT. FACTOR. LDB TEMP,I GET THE OLD TIME PRAM. BLF,ERB IF IN TIME LIST ALF,ERA SET BIT IN NEW WORD. LDB $MSBF+9 GET RESOLUTION TO B SZB,RSS IF ZERO RESOLUTION JMP M0605 GO REMOVE FROM TIME LIST LSR 3 SHIFT THE WHOLE MESS TO A M0604 STA TEMP,I SET NEW RESOLUTION MULT. ISZ TEMP INCR TO TMS ADDRESS LDA $MSBF+29 GET TENS OF MS. ADA DM100 SSA,RSS MINUS, IF LEGAL VALUE JMP $INER INPUT ERROR LDA $MSBF+25 GET SECONDS VALUE ADA DM60 SSA,RSS MINUS, IF LEGAL VALUE JMP $INER INPUT ERROR LDA $MSBF+21 GET MINUTES. ADA DM60 SSA,RSS YES, SO CONVERT TO DECIMAL JMP $INER INPUT ERROR LDA $MSBF+17 GET HOURS ADA DM24 SSA,RSS MINUS, IF LEGAL VALUE JMP $INER INPUT ERROR LDA DP4 SET DEFS TO THE PRAMS STA RQP5 ON THE BASE LDA DP5 PAGE FOR STA RQP6 $ETTM LDA DP6 THE SET TIME STA RQP7 SUBROUTINE LDA DP7 IN THE STA RQP8 RTIME MODULE LDB TEMP GET ID-SEG ADDRESS AND JSB $ETTM GO SET VALUES IN ID-SEG CLA JMP $MSEX EXIT $MESS SPC 2 M0605 CCB REMOVE PGM FROM TIME ADB TEMP LIST JSB $TREM CLA AND CONTINUE JMP M0604 SETTING UP THE ID-SEG L SPC 1 DP4 DEF $MSBF+17 DP5 DEF $MSBF+21 DP6 DEF $MSBF+25 DP7 DEF $MSBF+29 DM100 DEC -100 DM60 DEC -60 DM24 DEC -24 DM5 DEC -5 D17 DEC 17 * * * CONTINUATION OF STATUS REQUEST * $STRQ EQU * ADB D11 RESOL CODE/MULT ADDRESS STB TLINC LDA B,I ALF,RAR AND D7 JSB $CVT1 CONVERT RESOLUTION CODE TO ASCII ALF,ALF ROTATE TO HIGH HALF WORD STA $MSBF+5 STORE RESOLUTION CODE IN BUFFER LDA B,I AND B7777 JSB $CVT3 CONVERT MULTIPLE TO ASCII INA DLD A,I DST $MSBF+6 STORE MULTIPLE IN BUFFER LDA TLINC,I CHECK IF PROG IN TIME LIST ALF,SLA TEST BIT 12 (T) BIT JMP M0510 YES LDA BLANK PROGRAM NOT IN TIME LIST RSS M0510 LDA TZERO PROG IN TIME LIST STA $MSBF+14 STORE ASCII BLANK OR T IN BUFFER ISZ TLINC SET B TO TIME ADDRESS LDA DTEMP SET UP TO GET TIME TO STA RQP2 TEMP AREA CLA STA RQP3 DLD TLINC,I GET TIME FROM ID-SEG JSB $TIMV CONVERT THE TIME LDA TEMP3 GET HOURS JSB $CVT1 CONVERT LDB BLANK GET VALUE RRR 8 ROTATE TO BLANK ON EACH SIDE DST $MSBF+8 SET IN MESSAGE LDA TEMP2 GET MIN. VALUE JSB $CVT1 CONVERT STA $MSBF+10 STUFF IN BUFFER LDA TEMP1 AND AGAIN FOR SEC JSB $CVT1 LDB BLANK VALUE TO A BLANK TO B RRR 8 ROTATE DST $MSBF+11 SET IN BUFFER LDA TEMP ONE MORE TIME FOR 10'S OF MS. JSB $CVT1 STA $MSBF+13 STORE TENS OF MSEC IN BUFFER LDA BUFAD LOAD A WITH OUTPUT BUFFER ADDRESS JMP $MSEX RETURN SPC 1 TZERO ASC 1, T D11 DEC 11 DTEMP DEF TEMP SPC 2 SKP * MESSAGE PROCESSOR--TI COMMAND * * * THE REQUEST TO GET CURRENT SYSTEM TIME OUTPUTS CURRENT * YEAR, DAY NUMBER, HOUR, MINUTES, AND SECONDS IN THE * FOLLOWING FORMAT: * YEAR.DAY..HR..MN..SC * WHERE THE .'S ARE BLANKS * $TIRQ LDA DM20 STA $MSBF SET OUTPUT CHARACTER COUNT LDA DTCC SET UP TO GET THE TIME STA RQP3 SET YEAR WORD ADDR INA STA RQP2 SET 5 WORD TIME ADDR DLD $TIME JSB $TIMV GO GET TIME JSB $CVT3 CONVERT YEARS INA DLD A,I DST $MSBF+1 SET LEAST 4 DIGITS LDA TEMP4 GET DAYS JSB $CVT3 CONVERT AND STORE DAYS INA DLD A,I DST $MSBF+3 SET LEAST 4 DIGITS LDA BLANK STUFF NECESSARY WORDS WITH STA $MSBF+5 BLANKS STA $MSBF+7 STA $MSBF+9 LDA TEMP3 GET HOURS JSB $CVT1 CONVERT AND STORE HOURS STA $MSBF+6 LDA TEMP2 JSB $CVT1 CONVERT AND STORE MINUTES STA $MSBF+8 LDA TEMP1 JSB $CVT1 CONVERT AND STORE SECONDS STA $MSBF+10 LDA BUFAD JMP $MSEX GO SET A AND EXIT SPC 1 BLANK ASC 1, BUFAD DEF $MSBF DM20 DEC -20 * * ON REQUEST CONTINUATOR * * IF CURRENT TIME VALUES ARE ZERO OR NOW IS CODED THEN * THE CURRENT TIME IS PUT IN THE ID-SEG. AND R/M USED * TO COMPUTE THE NEXT TIME. * * IF CURRENT TIME VALUES ARE NOT ZERO THE PROGRAM IS * JUST PUT IN THE TIME LIST. * * CALLING SEQUENCE * * A=-1 IF NOW OPTION * A#-1 IF NOT NOW BUT PUT IN TIME LIST * B=ID-SEGMENT TIME ADDRESS. * * JMP $ONTM * $ONTM EQU * LDB $WORK ADB D17 COMPUTE RES/T/MULT ADDR LDA B,I ALF,RAR AND D7 CHECK RESOLUTION CODE SZA NONE, SO GO TO SCHED NOW JMP M0110 * JSB $LIST SCHEDULE PROGRAM OCT 301 JMP $MSEX RETURN * M0110 INB SET B FOR $ONTM LDA $MSBF+8 IF ASCII RAR,SLA "NO" ENTERED LDA $MSBF+9 THEN CPA NO GO PUT CCA IN THE TIME LIST FOR NOW+10MS. STB DLDAD SET LOAD ADDRESS STA TCC SET NOW FLAG FOR LATER INA,SZA,RSS IF NOW SKIP LOAD JMP NOW DLD DLDAD,I GET THE CURRENT TIME VALUES DLDAD EQU *-1 SZA,RSS IF TIME NOT ZERO SZB THEN JMP TIMIN THEN GO PUT IN TIME LIST NOW DLD $TIME GET CURRENT TIME DST DLDAD,I AND SET IN THE ID-SEG TIMIN LDB DM2 COMPUTE TIME LIST ADDRESS ADB DLDAD AND STB TEMP3 AND SET FOR LIST ROUTINE JSB $TADD ADD PROG TO TIME LIST. LDB TEMP3 SET (B) FOR $TMSC CALL ISZ TCC SKIP IF NOW RSS JSB $TMSC SCHEDULE THE PROG. AND UPDATE MESEX CLA SET A FOR NO ERROR JMP $MSEX GET RETURN ADDRESS * * NO ASC 1,NO HED MESSAGE PROCESSOR TM REQUEST COMPLETION * THIS ROUTINE COMPLETES THE SET TIME REQUEST * * CALLING SEQUENCE: * * LDB DEFP1 SET B TO ADDRESS OF PRAM LIST * JMP $TMRQ * $TMRQ EQU * LDB DEFP1 LDA DM6 SET UP PRAM ADDRESSES ON STA TEMP THE BASE PAGE LDA DRQP3 TM1 STB A,I ADB D4 PRAMS SEPERATED BY FOUR WORDS INA ISZ TEMP DONE? JMP TM1 NO * LDA RQP3,I GET YEAR ADA DM197 SUBTRACT THE BASE MPY D365 MULTIPLY BY DAYS PER YEAR ADA RQP4,I ADD THE DAY CMB SET B TO -1 IF LEGAL RESULT ADA B SUBRTACT ONE FROM DAY INB,SZB IF B WAS NOT ZERO AFTER MULT. THEN JMP $INER INPUT ERROR STA $TIME+2 SET DAY COUNTER * LDB DTIME GET TIME ADDRESS TO B JSB $ETTM SET THE TIME JMP MESEX EXIT TO MESSAGE PROCESSOR SPC 2 DM2 DEC -2 DM6 DEC -6 DM197 DEC -1970 BASE YEAR D365 DEC 365 DRQP3 DEF RQP3 D4 DEC 4 DTIME DEF $TIME DEFP1 DEF $MSBF+5 SPC 4 * * '# DEVICE TIME-OUT PARAMETER ' STATEMENT (OPTIONAL) * * FORMAT: TO,N1,N2 WHERE * N1 = EQT # * N2 = TIME-OUT PARAMETER OR NOT SPECIFIED * ACTION: IF N2 WASN'T SPECIFIED, PRINT CURRENT TIME-OUT OF DEVICE N1 * IF BOTH N1 AND N2 PRESENT, ASSIGN N2 AS THE * NEW TIME-OUT PARAMETER FOR DEVICE N1. * * CALL (FROM MESSAGE PROCESSOR): * (A) = N1 * (P) JMP $CHTO * - RETURN IS TO MESS,I WITH (A) = ADDRESS OF REPLY * OR ADDRESS OF ERROR MESSAGE IF N1 IS ILLEGAL. * $CHTO STA TEMP1 SAVE 'N1' JSB $EQCK CHECK VALIDITY OF 'N1' LDB $MSBF+8 SZB,RSS JUST ONE PARAM? CCB,RSS YES, SET (B)=-1 LDB $MSBF+9 NO, GET PARAM 'N2' SZB,RSS IF N2 ZERO, DISABLE JMP CHTO2 TIME-OUT FOR DEVICE * INB,SZB IF N2 = -1, OUTPUT T-O PARAMETER JMP CHTO1 OTHERWISE, ENTER NEW T-O VALUE * LDA EQT14,I CONVERT T-O PARAMETER CCE,SZA TO DECIMAL ASCII B3000 CMA JSB $CVT3 LDB A,I GET THE HIGH WORD ADB B164C ADD '=' - 'BLANK' STB TOMS1+1 CCE,INA DLD A,I STORE IN MESSAGE DST TOMS1+2 * LDA TEMP1 CONVERT EQT # JSB $CVT1 TO DECIMAL ASCII STA TOMS1 STORE INTO MESSAGE LDA TOMSA JMP $MSEX * TOMSA DEF *+1 N12 DEC -12 ASC 2,TO# TOMS1 NOP ASC 1, = NOP NOP * .500 DEC 500 B164C OCT 16400 * CHTO1 CMB,INB ERROR IF ATTEMPT LDA EQT5,I TO SET TYPE 0 OR 5 AND B374C DEVICE TIME-OUT SZA VALUE TO LESS THAN CPA B2400 FIVE SECONDS. RSS JMP CHTO2 OTHERWISE, STORE * LDA .500 NEW TIME-OUT ADA B VALUE. SSA,RSS JMP $INER * CHTO2 STB EQT14,I JMP $XEQ * * B2400 OCT 2400 B374C OCT 37400 * * ** SYSTEM BASE PAGE COMMUNNLHICATION AREA ** * . EQU 1650B ESTABLISH ORIGIN OF AREA * RQP2 EQU .+25 RQP3 EQU .+26 OF REQUEST RQP4 EQU .+27 RQP5 EQU .+28 PARAMETERS RQP6 EQU .+29 RQP7 EQU .+30 (SET FOR MAXIMUM OF RQP8 EQU .+31 8 PARAMETERS) * EQT5 EQU 1664B EQT14 EQU 1773B * XEQT EQU .+39 ID SEGMENT ADDR. OF CURRENT PROG. * A EQU 0B LOCATION OF A REGISTER B EQU 1B LOCATION OF B REGISTER * ORG * PROGRAM LENGTH END N z 92064-18022 1650 S C0222 &MOP RTE-M OP CMD OPT             H0102 eASMB,R,L,C * * NAME: $MOP * SOURCE: 92064-18022 * RELOC: 92064-16010 * PROGMR: E.J.W. * * **************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT * * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * **************************************************************** * * NAM $MOP 92064-16010 REV.1650 761118 * ENT $LUPR,$EQST,$BLRQ,$PRRQ EXT $EQCK,$CVT1,$CVT3,$INER,$XEQ,$MSEX EXT $BLUP,$BLLO,$MSBF,$WORK,$LIST EXT $UNLK,$XXUP,$DLAY,$DMEQ,$SCD3,$ETEQ EXT $CKLO,$BITB * A EQU 0 B EQU 1 * * 'LOGICAL UNIT' STATEMENT (OPTIONAL) * * FORMAT: LU,N1(,N2(,N3)) WHERE: * * N1 = LOGICAL UNIT # * N2 = 0, EQT ENTRY #, OR NOT PRESENT * N3 = SUBCHANNEL # OR NOT PRESENT IN WHICH * CASE IT DEFAULTS TO ZERO * * ACTION: 1) N2 AND N3 NOT INPUT; THE ASSIGNMENT OF * LOGICAL UNIT N1 IS PRINTED AS: * ' LU #N1 = #XX,U Y' XX = EQT * ENTRY # OF ASSIGNED DEVICE. * Y = SUBCHANNEL #; ,U Y PRINTED IF Y NON-ZERO * * 2) N2 = 0; THE ASSIGNMENT IS RELEASED, * I.E, THE CORRESPONDING * WORD IN THE DEVICE * REFERENCE TABLE (DRT) * IS SET = 0. * * 3) N2 = EQT ENTRY # OF I/O DEVICE TO * BE ASSIGNED TO LOGICAL UNIT N1; * IF N2 IS A LEGITIMATE EQT #, * THEN N2 AND N3 ARE STORED IN WORD N1 * IN THE DRT - ASSIGNMENT OF * LOGICAL UNIT TO PHYSICAL UNIT * IS MADE. * * CALL (FROM MESSAGE PROCESSOR): * * (A) = N1 (LOGICAL UNIT) IN BINARYL * (P) JMP $LUPR * * RETURN IS TO MESS,I WITH A=0 FOR ACTION * TAKEN OR (A) = ADDRESS OF MESSAGE IN 1). * * THE FOLLOWING LOCATIONS ARE USED AS TEMPORARIES BY LUPR: * := LU NUMBER := P3,P2 NEW SUBCH-EQT WORD * :=DRT WORD 1 ADDRESS :=DRT WORD 2 ADDRESS * :=EQT1 ADDRESS OF OLD :=NEW DEVICE'S EQT NUMBER * DEVICE * :="NEW DEVICE'S EQT IS :=NEW DEVICE SPLIT SUB. * DOWN" FLAG. * :=NEW DEVICE'S MAJOR LU * :#0 INITIATE REQUEST :#0 MORE THAN ONE LU FOR * ON NEW DEVICE UP OLD DEVICE * :=SEE SUB. SDRT2 * :=OLD SUBCH-EQT WORD :=OLD DEVICE MAJOR-LU * :=OLD DEVICE MAJOR-LU :=OLD DEVICE MAJOR-LU * DRT WORD 1 ADDRESS DRT WORD 2 ADDRESS * :=NEW DEVICE MAJOR-LU :=NEW DEVICE MAJOR-LU * DRT WORD 1 ADDRESS DRT WORD 2 ADDRESS * * * $LUPR STA P1 SAVE 'N1' CMA,CLE,INA,SZA,RSS JMP $INER ERROR IF N1<0 ADA LUMAX OR N1>DRT CCA,SEZ,RSS JMP $INER YES, UNDEFINED N1. * ADA P1 LOCATION OF N1 ADA DRT IN DRT. STA DRT1A (SAVE DRT ADDRESS) ADA LUMAX STA DRT2A (SAVE DRT SECOND WORD ADDR) * LDB $MSBF+8 SZB,RSS ONLY 1 PARAM? JMP LUPR3 YES, PRINT CURR ASSIGNMENT * LDA $MSBF+9 NO, GET 'N2' AND B377 STA TEMP2 LDA $MSBF+13 GET 'N3' AND B37 ALF,ALF PUT 'N3' IN BITS 11-15 ALF,RAR ADA TEMP2 PUT 'N2' IN BITS 0-7 STA P2 * * ASSIGN L.U. TO PHYSICAL DEVICE * * CLE CLEAR (E) FOR LATER LDA P2 CONSTRUCT I/O AND B174K SUBCHANNEL WORD ELA,RAL FOR NEW DEVICE(E WAS ALF,RAL CLEARED)WITH LOWER =A CLB,SEZ BITS IN BITS 2-5 ADA B20K AND UPPER BIT IN STA WORD2 BIT 13(CLEAR B REG). * STB NINTF CLEAR "NEW DEVICE I/O INITIATE" FLAG. STB TTEMP CLEAR "NEW DEVICE EQT IS DOWN" FLAG. * LDA DRT1A,I SAVE AND C3700 OLD SUBCH-EQT STA OSBEQ WORD AND AND B77 EQT1 SZA,RSS JMP LUP25 ADA M1 OF MPY .15 OLD(CLEAR B REG.) ADA EQTA DEVICE'S LUP05 STA OEQT1 EQT. * LDA P2 CHECK LEGALITY OF AND B77 N2(NEW EQT)AND STA NEQT# SZA,RSS SET THE EQT JMP LUPR2 JSB $EQCK ADDRESSES. * * SPECIAL TEST TO SEE IF MOVING I/O TO A DISK. ERROR IF SO. * LDA EQT1 ADA .4 LDA A,I AND B36K CPA B14K IS NEW DEVICE A DISK? JMP LU100 YES, CHECK MORE. * **************************************************************** * DETERMINE IF THE OLD DEVICE IS UP OR DOWN. **************************************************************** * LUPR1 LDA DRT2A,I CHECK IF OLD SSA DEVICE IS JMP DNXX UP OR DOWN. SKP **************************************************************** * OLD DEVICE IS UP. IS THERE MORE THAN ONE LU FOR IT? **************************************************************** UPXX LDA LUMAX SET UP TO SCAN THE LUS CMA,INA STA XLUS IF COUNT GOES TO ZERO THERE IS BUT ONE. LDB DRT GET ADDRESS OF THE FIRST ONE LUCO LDA B,I GET AN ENTRY AND C3700 DROP POSSIBLE LOCK BITS CPA OSBEQ IF NOT THE SAME CPB DRT1A OR IF SAME ENTRY INB,RSS SKIP TO GO ROUND AGAIN JMP MLUS ELSE THERE ARE MORE THAN ONE * ISZ XLUS COUNT DOWN THE ENTRIES JMP LUCO AROUND WE GO *************************************************************** * IF THE DEVICE IS UP AND HAS MORE THAN ONE LU THEN ITS * QUEUE IS NOT MOVED. THIS PREVENTS UNWANTED LOSS OF DATA * CAUSED BY UNRELATED LU CHANGES. *************************************************************** * * DETERMINE IF THE NEW DEVICE IS UP OR DOWN. **************************************************************** MLUS LDA NEQT# CHECK IF NEW SZA,RSS DEVICE IS THE JMP UPBIT BIT BUCKET. * JSB CKNLU CHECK IF NEW DEVICE IS UP OR DOWN. JMP UPDN NEW DEVICE IS DOWN. ISZ TTEMP NEW DEVICE'S EQT IS DOWN. **************************************************************** * THE OLD AND NEW DEVICE ARE UP OR THE OLD DEVICE IS UP * AND THE NEW DEVICE'S EQT IS DOWN. SKP ******************************************************************* UPUP LDA P1 NEW DEVICE IS UP. CPA .1 CHECK IF OLD JMP UPLU1 DEVICE IS LU 1. * UPUP5 LDA XLUS IF ANOTHER LU EXISTS SZA THEN JMP UPMU DON'T MOVE THE QUEUE * LDB OEQT1,I UNLINK I/O REQUESTS FROM THE RBL,CLE,ERB OLD DEVICE. SKIP THE SZB,RSS LDB OEQT1 LDA DRT2A FIRST I-O REQUEST. JSB $UNLK DEF OSBEQ * LDB DRT2A,I RESET WORD 2 OF THE I/O REQUESTS JSB FXWD2 TO THE SUBCHANNEL OF THE NEW DEVICE. LDA OEQT1 LDB DRT2A,I LINK THE I/O REQUESTS JSB $XXUP ON THE NEW DEVICE. STB DRT2A,I CLEAR UP THE CURRENT LU STA NINTF SET THE MUST START NEW I/O FLAG UPMU LDA TTEMP IS THE NEW DEVICE'S SZA,RSS EQT DOWN? JMP LUP50 NO, SO CONTINUE. * LDB EQT1,I YES, SO RBL,CLE,ERB UNSTACK SZB,RSS NORMAL USER LDB EQT1 I/O(SKIP FIRST JMP DNDE5 ENTRY)AND CONTINUE. * XLUS NOP SKP UPLU1 LDA EQT5,I GET DEVICE AND B374C TYPE OF THE SZA,RSS NEW DEVICE AND SEE JMP UPLU2 IF IT IS LEGAL CPA B2400 (00 OR 05 SUB 0) RSS FOR A SYSTEM JMP $INER CONSOLE. LDA WORD2 SZA JMP $INER * UPLU2 LDA TTEMP MAKE SURE NEW DEVICE'S SZA EQT IS NOT DOWN. JMP $INER LDA EQT1 SET NEW SYSTEM CONSOLE STA SYSTY ADDRESS IN BASE PAGE. JMP UPUP5 GO TRANSFER I/O. * UPBIT LDA P1 CHANGING AN UP DEVICE TO CPA .1 THE BIT BUCKET. ERROR JMP $INER IF THE OLD DEVICE IS JMP UPUP5 THE SYSTEM CONSOLE. * * B374C OCT 37400 SKP ****************************************************************** * THE OLD DEVICE IS UP AND THE NEW DEVICE IS DOWN. ********************************************************************* UPDN STB TTEMP SAVE LU# OF FIRST LU(MAJOR LU)OF NEW DEVICE. STA NDML2 SAVE DRT WORD 2 ADDRESS OF NEW-MAJOR-LU. ADB M1 COMPUTE NEW- ADB DRT MAJOR-LU STB NDML1 DRT WORD 1. * LDB P1 CHECK IF THIS CPB .1 WILL SET LU JMP $INER 1 DOWN. * LDB TTEMP CHECK IF LU IS CMB,INB LOWER THEN THE ADB P1 MAJOR LU FOR SSB,RSS THE NEW DOWNED JMP UPDN5 DEVICE. * LDB A,I LU IS BELOW NEW DEVICE'S MAJOR LU. STB DRT2A,I MOVE I/O FROM MAJOR LU TO LU. LDB XLUS IF CURRENT DEVICE STILL HAS AN LU SZB THEN SKIP THE MOVE JMP DNDN6 * LDB DRT2A CHASE DOWN ENTRIES IN THE JSB CHASE DOWNED I/O QUEUE TO ITS END LDA B * LDB OEQT1,I UNLINK I/O REQUESTS FOR THE RBL,CLE,ERB OLD DEVICE AND ADD TO SZB,RSS LDB OEQT1 JSB $UNLK THE I-O QUEUE. SKIP FIRST ENTRY. DEF OSBEQ JMP DNDN6 GO MODIFY LU'S FOR THE NEW DEVICE. * * UPDN5 LDB XLUS IF STILL HAVE AN LU FOR THIS DEVICE XSZB THEN SKIP THE MOVE JMP UPDN6 * LDB NDML2 NEW DEVICE'S MAJOR LU IS BELOW LU. JSB CHASE CHASE DOWN THIS I-O QUEUE LDA B TO ITS END. * LDB OEQT1,I UNLINK I/O REQUESTS RBL,CLE,ERB FOR THE OLD DEVICE SZB,RSS (SKIP FIRST REQUEST)AND LDB OEQT1 ADD TO DOWNED LU I/O JSB $UNLK QUEUE. DEF OSBEQ * UPDN6 LDA TTEMP SET ADA MSIGN THE LU STA DRT2A,I DOWN. JMP LUP50 GO FINISH. SKP **************************************************************** * THE OLD DEVICE IS DOWN. ******************************************************************* * DETERMINE IF THE NEW DEVICE IS UP OR DOWN. * DNXX LDA NEQT# CHECK IF SZA,RSS NEW DEVICE JMP DNUP IS BIT BUCKET. * JSB CKNLU CHECK IF NEW DEVICE IS UP OR DOWN. JMP DNDN NEW DEVICE IS DOWN. JMP DNDNE NEW DEVICE'S EQT IS DOWN. **************************************************************** * THE OLD DEVICE IS DOWN AND THE NEW DEVICE IS UP(OR BIT BUCKET) ********************************************************************** DNUP JSB DETOL DETERMINE THE OLD-MAJOR-LU. LDB ODML2,I RESET WORD 2 OF I/O REQUESTS JSB FXWD2 TO THE SUBCHANNEL OF THE NEW DEVICE. * LDA OEQT1 LDB ODML2,I LINK OLD DEVICE'S I/O REQUESTS JSB $XXUP ON THE NEW DEVICE. STA NINTF * JSB FOLDD FIX ALL OLD DOWNED LU'S THAT NEED IT. JMP LUP52 ****************************************************************** * THE OLD DEVICE IS DOWN AND THE NEW DEVICE'S EQT IS DOWN. ********************************************************************* DNDNE JSB DETOL DETERMINE OLD DEVICE'S MAJOR-LU LDA OEQT1 LINK OLD DEVICE'S I/O REQUESTS ON THE LDB ODML2,I NEW DEVICE'S EQT. JSB $XXUP STA NINTF * JSB FOLDD FIX OLD DOWNED DEVICE'S LU'S THAT NEED IT. * LDB EQT1 UNLINK ANY NORMAL USER DNDE5 CLA I/O FROM THE NEW DEVICE'S EQT. JSB $UNLK DEF P2 JMP LUP50 SKP **************************************************************** * THE OLD AND NEW DEVICES ARE DOWN. ********************************************************************* DNDN STB TTEMP SAVE NEW DEVICE MAJOR-LU AND STA NDML2 ITS DRT WORD 2 ADDRESS. ADB M1 SAVE ITS ADB DRT DRT WORD STB NDML1 2 ADDRESS. * JSB DETOM DETERMINE THE OLD DEVICE'S MAJOR LU * LDB TTEMP CHECK IF NEW CMB,INB NEW DEVICE'S MAJOR ADB P1 LU IS < LU. SSB,RSS LU < NEW DEVICE'S MAJOR LU. JMP DNDN5 * DNDN9 LDB DRT2A LU IS BELOW NEW DEVICE'S MAJOR LU. JSB CHASE CHASE DOWN THE LU'S I/O LDA NDML2,I QUEUE TO ITS END AND RAL,CLE,ERA ADD THERE THE NEW DEVICE'S STA B,I MAJOR-LU I/O QUEUE. * LDA OMJLU IF OLD MAJOR LU EQUALS TO CPA P1 LU, THEN FIX UP OLD DEVICE'S RSS LU'S TO INCLUDE THE NEW OLD- JMP DNDN6 MAJOR-LU. OTHERWIZE, CONTINUE. * LDA OSBEQ A=OLD SUBCHANNEL-EQT WORD. LDB DRT1A INB B=LU WORD 1 ADDRESS + 1. JSB FXOLD GO FIX OLD DEVICE'S LU'S. * DNDN6 LDA P2 MODIFY ALL LU'S STA SSBEQ FOR NEW DEVICE LDA P1 TO POINT TO IOR MSIGN LU. LDB NDML1 CLE JSB SDRT2 JMP LUP50 SKP DNDN5 SZB,RSS CASE WHERE OLD AND NEW DEVICES ARE JMP LUP60 BOTH DOWN AND EQUAL. * LDB NDML2 LU > NEW DEVICE MAJOR-LU. JSB CHASE CHASE DOWN THE NEW MAJOR-LU'S. CCA I/O QUEUE TO ITS END. * ADA DRT CALCULATE DRT ADA OMJLU WORD 2 OF STA ODML1 OLD MAJOR-LU. * ADA LUMAX  LINK OLD MAJOR LU I/O LDA A,I RAL,CLE,ERA QUEUE TO END OF NEW STA B,I MAJOR I/O QUEUE. * LDA TTEMP MAKE LU POINT TO IOR MSIGN NEW DEVICE MAJOR-LU. STA DRT2A,I * LDA OMJLU IF LU = OLD CPA P1 MAJOR-LU, RSS THEN CONTINUE, JMP LUP50 ELSE DONE. * LDA OSBEQ FIX OLD LDB ODML1 DEVICE'S INB LU'S. JSB FXOLD SKP ****************************************************************** * FINISH SWITCHING LU ******************************************************************* LUP50 LDA DRT1A,I SET UP DRT AND B3700 WORD 1 WITH ADA P2 NEW DEVICE AND STA DRT1A,I OLD LOCK FLAG. * LUP52 LDA NINTF CHECK IF AN I/O SZA,RSS OPERATION MUST BE JMP LUP55 INITIATED ON THE NEW EQT. CPA $DMEQ YES, IF THE NEW DEVICE IS THE BIT BUCKET, JMP LUP80 THEN SET A FLAG FOR IOCX. JSB $DLAY IF NOT,SET A TIMEOUT FOR INITIATION. * LUP55 LDA .4 SCHEDULE ANY WAITERS ON JSB $SCD3 DOWNED DEVICES. LDA OEQT1 SET UP THE OLD DEVICE'S JSB $ETEQ EQT ADDRESSES, CHECK BUFFER JSB $CKLO LIMITS AND SCHED WAITERS. * LDA P1 IF LU CHANGED WAS CPA .1 SYSTEM CONSOLE THEN JMP LUP70 ISSUE A MESSAGE. * LUP60 CLA JMP EXT2 OTHERWIZE, RETURN. * LUP70 LDA NSYSM ISSUE '**' MESSAGE. JMP EXT2 * LUP80 ISZ $BITB SET A FLAG FOR IOCX SO THAT JMP LUP55 IT WILL CLEAN OUT THE BIT BUCKET. * LUPR2 LDA $DMEQ SET UP DUMMY JSB $ETEQ EQT ADDRESES FOR JMP LUPR1 THE BIT BUCKET. * LUP25 LDA $DMEQ JMP LUP05 SKP * * SPECIAL TEST TO DISALLOW SWTCHING AN LU TO A DISK IF THE * LU HAS I/O STACKED ON IT(OR IT'S EQT). * LU100 LDA DRT2A,I DOES THE LU RAL,CLE,ERA HwfAVE ANY I/O SZA HUNG ON IT? JMP $INER YES, ISSUE ERROR MESSAGE. * SEZ IF NO I/O AND LU IS DOWN, JMP LUPR1 THEN ALLOW SWTCH. LDA OEQT1,I OTHERWIZE, IF UP AND I/O IS SZA,RSS HUNG ON THE OLD EQT, THEN JMP LUPR1 ALLOW SWITCH. * LDA OEQT1 OTHERWISE, IF UP WITH I/O HUNG ON ADA .4 OLD EQT AND OLD EQT IS A DISC, LDA A,I THEN ALLOW SWITCH. AND B36K OTHERWISE, OLD EQT IS UP WITH I/O HUNG CPA B14K ON IT AND IT ISN'T A DISC. THEREFORE, JMP LUPR1 CAN'T ALLOW SWITCH SINCE WE CAN'T JMP $INER ALLOW ANY CLASS I/O TO A DISC. * * ****************************************************************** * DISPLAY LU AND IT'S STATUS ****************************************************************** * LUPR3 LDA P1 GET AND JSB $CVT1 SAVE THE STA LUMSG+2 ASCII LU #. LDA DRT1A,I GET AND AND B77 SAVE JSB $CVT1 THE ASCII STA LUMSG+5 EQT #. LDA DRT1A,I CHECK IF AND B174K A SUBCHANNEL CCE,SZA IS SPECIFIED. JMP LUP14 LDA DBLBK IF SUBCHANNEL=0, STA LUMSG+6 THEN DO NOT DISPLAY JMP LUP15 THE SUBCHANNEL. * LUP14 LDB BLS IF SUBCHANNEL#0, STB LUMSG+6 THEN DISPLAY ALF,RAL THE ASCII JSB $CVT1 SUBCHANNEL. LUP15 STA LUMSG+7 LDB DBLBK CHECK IF LDA DRT2A,I THE DEVICE SSA IS UP OR LDB EQBD DOWN. IF STB LUMSG+8 DOWN, LDA LUMGA PRINT A "D". EXT2 JMP $MSEX RETURN * SKP * * VARIABLES, CONSTANTS AND BUFFERS FOR LUPR * NSYSM DEF *+1 DEC -2 ASC 1,** * LUMGA DEF *+1 DEC -18 LUMSG ASC 9,LU #N1 = EXX SYY * B174K OCT 174000 B176K OCT 176000 B20K OCT 20000 B14K OCT 14000 B36K OCT 36000 B77 m<:6OCT 77 B377 OCT 377 B3700 OCT 3700 C3700 OCT 174077 MSIGN OCT 100000 .1 DEC 1 .4 DEC 4 .15 DEC 15 M1 DEC -1 * DBLBK ASC 1, BLS ASC 1, S * DRT1A NOP DRT2A NOP NINTF NOP TTEMP NOP OEQT1 NOP NEQT# NOP WORD2 NOP OSBEQ NOP OMJLU NOP OLD DEVICE MAJOR LU. ODML1 NOP OLD DEVICE MAJOR-LU DRT WORD 1 ADDRESS. ODML2 NOP OLD DEVICE MAJOR-LU DRT WORD 2 ADDRESS. NDML1 NOP NEW DEVICE MAJOR-LU DRT WORD 1 ADDRESS. NDML2 NOP NEW DEVICE MAJOR-LU DRT WORD 2 ADDRESS. * P1 NOP P2 NOP B37 OCT 37 >< SKP ***************************************************************** * * SUBROUTINE CKNLU: * * CKNLU DETERMINES IF THE DEVICE(LU) OR THE EQT POINTED TO BY * THE SUBCHANNEL-EQT WORD IS UP OR DOWN. * * CALLING SEQUENCE: * := SUBCHANNEL IN BITS 11-15, EQT IN BITS 0-5. * :=ADDRESS OF FIFTH EQT WORD. * JSB CKNLU * * RETURN: * (P+1) DEVICE IS DOWN. * (P+2) EQT IS DOWN. * (P+3) DEVICE IS UP OR NO DEVICE FOUND. * ALL REGISTERS ARE VIOLATED. * AT (P+1): :=MAJOR LU # OF DOWNED DEVICE. * :=MAJOR LU DRT WORD 2 ADDRESS. * USES SDRT2 AS A TEMPORARY. * **************************************************************** * CKNLU NOP LDA EQT5,I CHECK IF RAL,SLA THE EQT JMP CKNL0 IS UP OR SSB DOWN. JMP CKNL2 THE EQT IS DOWN. * CKNL0 LDB LUMAX CMB,INB STB SDRT2 LDB DRT CKNL1 LDA B,I DETERMINE AND C3700 IF THE CPA P2 NEW JMP CKNL7 DEVICE INB EXISTS. ISZ SDRT2 JMP CKNL1 JMP CKNL9 THE DEVICE DOES NOT EXIST. * CKNL7 ADB LUMAX DETERMINE IF THE DEVICE LDA B,I IS UP OR DOWN. SSA JMP CKNL8 CKNL9 ISZ CKNLU THE DEVICE IS UP, RETURN TO P+3. CKNL2 ISZ CKNLU THE EQT IS DOWN, RETURN TO P+2. JMP CKNLU,I RETURN. * CKNL8 STB A THE DEVICE IS DOWN. LDB LUMAX SET =DRT WORD 2 ADDRESS. ADB SDRT2 SET =LU #. INB JMP CKNLU,I RETURN TO P+1. SKP **************************************************************** * SUBROUTINE SDRT2: * * SDRT2 WILL STORE THE A REG IN DRT WORD 2 FOR ANY DRT ENTRIES * WHICH CORRESPOND TO THE SUBCHANNEL AND EQT GIVEN IN P2. IF * ON ENTRY E=1, THEN SDRT2 WILL SCAN ONLY TO THE FIRST ENTRY * SCORRESPONDING TO P2. IF E=0, THEN SDRT2 WILL SCAN THE ENTIRE * DRT FROM THE GIVEN ENTRY TO ITS END. * * CALLING SEQUENCE: * :=SUBCHANNEL-EQT WORD FOR THE LU'S TO SCAN FOR: * BITS 5-0=EQT * BITS 15-11=SUBCHANNEL * :=DRT WORD 1 ADDRESS FROM WHICH TO BEGIN SCAN. * :=CONTENTS TO STORE INTO DRT WORD 2. * :=0 SCAN TO END OF DRT. * :=1 SCAN ONLY FOR FIRST ENTRY. * JSB SDRT2 * USES TEMPORARY LOCATIONS CKNLU,SDRT8,SDRT9 * RETURN: * NO REGISTERS ARE SAVED ON EXIT. * ON EXIT: * :=NEXT DRT WORD 1 ADDRESS TO BE SCANNED. * := LUMAX - LAST LU# SCANNED. ***************************************************************** * SDRT2 NOP STA CKNLU SAVE CONTENTS TO STORE INTO DRT WORD 2. LDA LUMAX SET ADA DRT CMA,INA UP ADA B STA SDRT9 COUNTER. STB SDRT8 SAVE ADDRESS OF FIRST DRT ENTRY TO SCAN. SZA,RSS JMP SDRT2,I * SDR29 LDA SDRT8,I SET CONTENTS AND C3700 OF DRT WORD 2 CPA SSBEQ AND COMPARE TO JMP SDR22 SUBCHANNEL-EQT WORD. SDR25 ISZ SDRT8 INCREMENT DRT ADDRESS. ISZ SDRT9 INCREMENT COUNT. JMP SDR29 CLA JMP SDRT2,I NO MORE ENTRIES, SO RETURN. * SDR22 LDB CKNLU FOUND AN ENTRY, LDA SDRT8 POSITION TO ADA LUMAX WORD 2 AND STB A,I STORE NEW CONTENTS. SEZ,RSS IF E=1, JMP SDR25 THEN CONTINUE SCAN. ISZ SDRT8 OTHERWIZE, INCREMENT DRT LDA SDRT9 ADDRESSES AND RETURN. INA JMP SDRT2,I * SDRT8 NOP SDRT9 NOP SSBEQ NOP * ********************************************************************* * * SUBROUTINE CHASE: * * CHASE WILL FIND THE END OF AN I/O QUEUE GIVEN IT'S HEAD. * * CALLING SEQUENCE: i* :=ADDRESS OF HEAD OF I/O QUEUE. * JSB CHASE * * RETURN: * ALL REGISTERS ARE MODIFIED. * :=ADDRESS OF LINK WORD OF LAST I/O REQUEST. * :=0 * ******************************************************************** * CHASE NOP CHASE CHAS1 EQU * LDA B,I DOWN RAL,CLE,ERA THE LU'S SZA,RSS I/O QUEUE JMP CHASE,I TO ITS LDB A END. JMP CHAS1 SKP * ***************************************************************** * * SUBROUTINE FXWD2: * * FXWD2 CHANGES THE SUBCHANNEL IN WORD 2 OF EACH I/O REQUEST * IN THE GIVEN I/O QUEUE. * * CALLING SEQUENCE: * :=NEW SUBCHANNEL: BITS 2-5=LOWER 4 BITS * BIT 13 =UPPER BIT. * :=POINTER TO FIRST I-O REQUEST =0 IF NO REQUESTS. * JSB FXWD2 * * RETURN: * ALL REGISTERS ARE VIOLATED. * ****************************************************************** * FXWD2 NOP RBL,CLE,ERB STRIP POSSIBLE SIGN BIT. FWD21 SZB,RSS IF END OF I/O QUEUE, JMP FXWD2,I THEN EXIT. STB SDRT2 INB POSITION TO I/O LDA B,I CONTROL WORD. AND WD2SB STRIP OFF OLD SUBCHANNEL IOR WORD2 AND ADD IN NEW SUBCHANNEL. STA B,I LDB SDRT2,I JMP FWD21 * WD2SB OCT 157703 SKP * **************************************************************** * * SUBROUTINE DETOL * * DETOL DETERMINES WHAT THE OLD DEVICE'S MAJOR-LU IS AND SETS * UP LOCATIONS DMJLU, ODML1, ODML2. * * CALLING SEQUENCE: * JSB DETOL * * RETURN: * ALL REGISTERS ARE MODIFIED. * :=OLD DEVICE'S MAJOR-LU. * :=OLD DEVICE'S MAJOR-LU DRT WORD 1 ADDRESS. * :=OLD DEVICE'S MAJOR-LU DRT WORD 2 ADDRESS. **************************************X************************** * DETOL NOP JSB DETOM DETERMINE OLD MAJOR LU ADA M1 COMPUTE THE ADA DRT OLD DEVICE'S STA ODML1 MAJOR-LU'S ADA LUMAX DRT WORD 1 STA ODML2 AND 2 ADDRESSES. JMP DETOL,I RETURN. * ********************************************************************* * * SUBROUTINE DETOM * * DETOM RETURNS THE OLD DEVICE'S MAJOR LU * * CALLING SEQUENCE: * JSB DETOM * * RETURN: * := OLD DEVICE'S MAJOR LU. * ********************************************************************* * DETOM NOP LDA DRT2A,I DETERMINE IF LU IS THE OLD MAJOR LU RAL,CLE,ERA CLE,SZA,RSS IF NO QUEUE, THE LU IS CCE OLD MAJOR LU (SET E=1) STA B IF QUEUE ELEMENT < 2000, THEN ADB B176K QUEUE ELEMENT IS OLD MAJOR LU # SEZ LDA P1 IF QUEUE ELEMENT >= 2000, THEN IT IS AN ADDR STA OMJLU AND THE GIVEN LU IS OLD MAJOR LU JMP DETOM,I RETURN SKP * ***************************************************************** * * SUBROUTINE FOLDD: * * FOLDD WILL FIX THE DRT WORD 2'S OF THE OLD DEVICE'S LU'S. * * CALLING SEQUENCE: * :=THE OLD DEVICE'S MAJOR-LU. * :=THE OLD DEVICE'S MAJOR-LU DRT WORD 1 ADDRESS. * JSB FOLDD * * RETURN: * ALL REGISTERS ARE MODIFIED. ***************************************************************** * FOLDD NOP LDA DRT1A,I SET UP DRT WORD 1 AND B3700 OF LU WITH THE NEW ADA P2 DEVICE AND OLD STA DRT1A,I LOCK FLAG. * CLA SET DRT WORD 2 OF STA DRT2A,I LU TO UP STATE. * LDA OMJLU IF LU=OLD DEVICE MAJOR-LU CPA P1 THEN FIX LU'S FOR THE RSS OLD DEVICE. JMP FOLDD,I OTHERWIZE, RETURN. LDA OSBEQ OLD MAJOR LU. LDB ODML1 INB JSB FXOLD FIX LU'S FOR THE OLD DEVICE. JMP FOLDD,I RETURN. SKP * ***************************************************************** * * SUBROUTINE FXOLD: * * FXOLD WILL CREATE A NEW MAJOR-LU FOR THE OLD DEVICE, POINT * ANY OTHER LU'S FOR THIS DEVICE TO THE MAJOR-LU, AND SET ALL * THESE LU'S DOWN. * * CALLING SEQUENCE: * :=SUBCHANNEL-EQT WORD OF THE LU TO SCAN FOR. * :=DRT WORD 1 ADDRESS TO BEGIN SCAN. * JSB FXOLD * CALLS SUBROUTINE SDRT2 * * REUTRN: * NO REGISTERS ARE SAVED. * ***************************************************************** * FXOLD NOP STA SSBEQ LDA MSIGN CREATE A NEW CCE OLD-MAJOR- JSB SDRT2 LU. SZA,RSS IF A=0, THEN NO OTHER JMP FXOLD,I LU'S ON OLD DEVICE. * ADA LUMAX OTHERWIZE, POINT IOR MSIGN ALL OTHER LU'S LDB SDRT8 FOR OLD DEVICE CLE TO THE NEW JSB SDRT2 OLD-MAJOR-LU. JMP FXOLD,I RETURN. * SKP * * ' EQT DEVICE STATUS ' STATEMENT (OPTIONAL) * * FORMAT: EQ,NN WHERE NN = EQT ENTRY # * FOR I/O DEVICE * * ACTION: THIS STATEMENT REQUESTS THE CURRENT * STATUS OF EQT ENTRY #NN. THE PRINTED * REPLY IS: * * ' SC DVRNN D B UN AV' WHERE: * * SC = I/O CHANNEL # (SELECT CODE) * DVRNN = DRIVER NAME, EQUIP TYPE NN. * D, IF DMA CHANNEL REQUIRED- 0 IF NOT * B, IF BUFFERING SELECTED - 0 IF NOT * UN = UNIT N (FOR SUB-UNIT ADDRESSING) * AV = 0 UNIT AVAILABLE * 1 UNIT DISABLED (DOWN) * 2 UNIT IN OPERATION * 3 UNIT WAITING FOR A DMA CHANNEL * * CALL (FROM MESSAGE PROCESSOR): * * (A) = NN (EQT #) IN BINARY * * (P) JMP $EQST * º -RETURN IS TO MESS,I WITH (A) = ADDRESS OF * REPLY OR ADDRESS OF ERROR MESSAGE IF NN * IS ILLEGAL. * * $EQST JSB $EQCK CHECK NN AND SET EQT ADDRESSES LDA EQT4,I GET CHANNEL WORD LDB $MSBF+8 CLE,SZB WAS SECOND PARAM SPECIFIED? JMP EQST1 YES, SET BUFFERING SELECTION * JSB $CVT1 NO, CONVERT NN (E=0 FOR OCTAL) STA EQMS1 AND SET UP DISPLAY * LDA EQT4,I CONVERT ASR 6 UNIT #. AND B37 JSB $CVT1 STA EQMS5 LDA EQT4,I SET LDB EQBLK D (FOR DMA CHANNEL) RAL,SLA OR LDB EQBD 0 STB EQMS3 LDB EQBLK SET SSA B (FOR AUTOMATIC BUFFERING) LDB EQBB OR STB EQMS4 0 LDA EQT5,I SET RAL,RAL AVAILABILITY AND D3 STATUS ADA EQBLK (0,1,2,OR3) STA EQMS6 LDA EQT5,I CONVERT ALF,CLE,ALF EQUIPMENT ADA B3000 TYPE (SET HIGH BITS TO JSB $CVT1 FOOL LEADING BLANK GENERATOR) STA EQMS2 DVRNN. LDA EQMSA (A) = ADDRESS OF REPLY JMP EXT2 * EQST1 LDB $MSBF+9 GET PARAM #2 ERB ROTATE BIT 1 TO E RAL,RAL AND PUT IN ERA,RAR 14 OF EQT4 STA EQT4,I AND RESTORE JMP $XEQ * EQMSA DEF *+1 DEC -20 ASC 1, EQMS1 NOP I/O CHANNEL # ASC 2, DVR EQMS2 NOP EQUIP TYPE CODE EQMS3 NOP D OR 0 EQMS4 NOP B OR 0 ASC 1, U EQMS5 NOP UNIT # EQMS6 NOP AVAILABILITY * EQBLK ASC 1, 0 EQBD ASC 1, D EQBB ASC 1, B * B3000 OCT 3000 HED BUFFER LIMITS OPERATOR COMMAND SPC 2 $BLRQ CLB,CCE,INB CHECK TO SEE IF EXAMINE CPB $MSBF+32 ONE PRAM? JMP BLIMP YES GO PRINT LIMITS * LDB $MSBF+9 GET THE SECOND PRAMETER CMB,SSB,INB,RSS GET NEW UPPER LIMIT JMP $INER ҧ ERROR IF NEGATIVE STB $BLUP CMA,SSA,INA,RSS GET NEW LOWER LIMIT JMP $INER ERROR IF NEGATIVE STA $BLLO CLA JMP $MSEX GO EXIT DONE SPC 1 BLIMP LDA $BLLO GET THE LOWER LIMIT CMA,INA SET POSITIVE JSB $CVT3 CONVERT TO ASCII OCTAL STA TEMP3 ADA D2 LDA A,I STA $MSBF+3 SET AT BUFF3 DLD TEMP3,I DST $MSBF+1 SET HIGH 4 DIGITS AT BUFF1 LDA $BLUP GET THE UPPER LIMIT CMA,CCE,INA SET POSITIVE JSB $CVT3 CONVERT STA TEMP3 ADA D2 LDA A,I STA $MSBF+7 SET AT BUFF7 DLD TEMP3,I DST $MSBF+5 SET HIGH 4 DIGITS AT BUFF5 LDA AASCI GET A DOUBLE BLANK STA $MSBF+4 SET BETWEEN THE NUMBERS LDA DM14 GET RECORD LENGTH STA $MSBF SET IN THE BUFFER AND LDA BUFAD JMP $MSEX GO SEND THE MESSAGE SPC 3 * * MESSAGE PROCESSOR--PR,XXXXX,ZZ COMMAND * * PR,XXXXX,ZZ PROCESSOR * * THE PRIORITY CHANGE ROUTINE FUNCTIONS AS FOLLOWS: * IF PROGRAM STATUS OTHER THAN DORMANT, STATUS ERROR. * IF DORMANT, THEN PRIORITY VALUE CHANGED AND PROGRAM * LIST UPDATED VIA LINK PROCESSOR. * $PRRQ LDA $MSBF+9 GET PRIORITY SSA,RSS SZA,RSS CHECK IF ZERO PRIORITY REQ JMP $INER ERROR-ILLEGAL VALUE LDB $WORK ADB D6 STA B,I STORE NEW PRIORITY VALUE JSB $LIST RELINK THE PROGRAM OCT 317 BY NEW PRIORITY CLA JMP $MSEX RETURN DM14 DEC -14 BUFAD DEF $MSBF AASCI EQU EQMSA+2 D2 DEC 2 D3 DEC 3 D6 DEC 6 B2400 OCT 2400 TEMP2 NOP TEMP3 NOP ORG * SIZE OF MODULE HED ** SYSTEM BASE PAGE COMMUNICATION AREA ** . EQU 1650B ESTABLISH ORIGIN OF AREA * * SYSTEM TABLE DEFINITION * * EQTA EQU 1650B DRT EQU .+2 FWA OF DEVICE REFERENCE TABLE LU,U0.*MAX EQU .+3 # OF LOGICAL UNITS (IN DRT) * * I/O MODULE/DRIVER COMMUNICATION * EQT1 EQU .+8 ADDRESSES EQT4 EQU .+11 EQT5 EQU .+12 CURRENT * SYSTY EQU .+21 EQT ENTRY ADDRESS OF SYSTEM TTY ORG * LENGTH OF MODULE END T0 | 92064-18023 1808 S C0122 &MCL MII/III CL I/O OPTION             H0101 ASMB,R *USE 'ASMB,R,N' (RTE-M II) OR 'ASMB,R,Z' (RTE-M III) * * IFN OPTION * NAME: $MCL * SOURCE: 92064-18023 * RELOC: 92064-16011 * PROGMR: E.J.W. * * IFZ OPTION * NAME : $MCL3 * SOURCE: 92064-18023 * RELOC: 92064-16015 * PROGMR: E.J.W. * * **************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT * * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * **************************************************************** * * IFN * BEGIN NON-DMS CODE *************** NAM $MCL,0 92064-16011 REV.1808 771028 *** END NON-DMS CODE *************** XIF IFZ ***** BEGIN DMS CODE *************** NAM $MCL3,0 92064-16015 REV.1808 771028 ******* END DMS CODE *************** XIF * * ENT $S.CL,$I.CL,$C.CL,$G.CL EXT $IDNO,$CLAS,$BLUP,$QCHK,$ALC,$LIST,$XEQ EXT $SCD3,$RTN,$ERAB SPC 1 IFN * BEGIN NON-DMS CODE *************** EXT .MVW *** END NON-DMS CODE *************** XIF SPC 1 * A EQU 0 B EQU 1 * * $S.CL NOP START-UP INITIALIZATION LDA DCLAS GET DIRECT ADDR RAL,CLE,SLA,ERA OF SYSTEM POINTERS LDA A,I STA DCLAS CLASS TABLE POINTER CMA,INA STA MCLAS NEGATIVE OF CLASS TABLE PTR JMP $S.CL,I DONE HED ** RTE-M CLASS I/O MODULE - INITIATION CALL ** * * * CLASS I/O ALLOCATE CLASS FROM HIGH END OF TABLE * IF HE DID NOT SPECIFY A CLASS. * * LDA WORD2 (A) = CONTROL WORD * LDB TEMP6 (B) = BUFFER PRIORITY OF REQUEST * JSB $I.CL CALL FROM $MIO MODULE * P+1: DO NORMAL UNBUFFERED I/O * P+2: (A) = ADDR OF NEW I/OY BLOCK * JMP L.132 DO THE I/O, CLASS QUEUED ALREADY * $I.CL NOP CALLED BY $MIO MODULE STA WORD2 SAVE CONTROL WORD STB BPRIO LDA RQP1 GET ORIGINAL REQUEST CODE AND B17 KEEP ONLY LOW 4 BITS STA RQPX SAVE CLASS REQUEST CODE STA B CLA,CLE E=0 IF USE OLD CLASS NUMBER STA XA,I A=0 FOR INIT.GOOD RETURN LDA RQP7 ADDR FROM THE REQUEST CPB .3 IF CONTROL REQUEST (19) LDA RQP4 USE THE CONTROL CLASS WORD SZA,RSS IF CLASS WORD ADDR = 0 JMP ERR01 FLUSH IT OUT. STA TEMP3 SAVE ADDR OF CLASS WORD LDA B160K GET BITS 15,14, AND 13 FROM AND TEMP3,I USER'S CLASS WORD STA SECCD L.025 LDA TEMP3,I GET CLASS WORD STA CLASS SET THE CLASS WORD AND B377 MASK TO THE CLASS DEF. STA B SAVE CLASS NUMBER IN B CMA,INA,SZA IF SUPPLIED JMP L.021 SKIP ALLOCATION CODE * * * ALLOCATE A CLASS FROM THE HIGH END OF THE TABLE * LDB XEQT GET ID SEG ADDR JSB $IDNO CONVERT TO ID # LDA B37 FOR USE AS SECURITY CODE AND B ALF,ALF IOR SECCD FILL IN USER'S BIT15,14,13 STA TEMP3,I FOR RETURN AS CLASS NUMBER * LDA $CLAS GET THE LENGTH OF THE TABLE SZA,RSS IF NO CLASSES DEFINED JMP ERR00 REJECT THE CALL ADA DCLAS ADD THE TABLE ADDRESS * L.022 LDB A,I GET THE ENTRY TO B CCE,SZB,RSS IF FREE (0) JMP L.023 GO USE IT ADA N1 NO STEP TO NEXT ONE CPA DCLAS END OF TABLE? CCA,RSS YES SKIP (A = -1) JMP L.022 NO - GO TEST NEXT ONE. * L.026 STA XA,I SET REASON FOR REJECT IN A REG. LDB DCLAS SET B=CLASS TABLE ADDR LDA CLASS FOR L.013 IN CASE OF SUSPEND SSA NO-WAIT REQUESTED? JMP L.16 NO, GIVE NO CLASS STAѝTUS JMP L.013 YES, SUSPEND UNTIL CLASS AVAILABLE * L.023 LDB A SET B TO ADR OF CLASS QUEUE WORD ADA MCLAS SUBTRACT THE CLASS TABLE ADDRESS IOR TEMP3,I ADD SECURITY CODE AND USER BIT STA TEMP3,I RETURN NEW CLASS WORD TO USER AND B174C GET SECURITY CODE FOR CLASS QUEUE-HEAD RAL,ERA SET THE ALLOCATED BIT STA B,I PUT INTO CLASS QUEUE CCE SET E=1 AGAIN FOR NEW ALLOC JMP L.025 GO SET UP * L.021 ADB DCLAS USE CLASS# (IN B) TO INDEX AND STB PTR SET POINTER TO TABLE STA B LDA CLASS GET CLASS WORD AND B174C SAVE REAL SECURITY CODE STA SECCD LDA PTR,I GET CONTENTS SEZ,CLE,RSS IF NOT NEW ALLOCATION SZA AND NOT ALLOCATED, FORCE ERROR ADB $CLAS IF OUTSIDE OF TABLE CLB,SEZ,RSS THEN JMP ERR00 SEND ERROR 'IO00' * LDA PTR L.13A STA B SET B TO ADDR OF QUEUE ENTRY SPC 1 IFN * BEGIN NON-DMS CODE ************** LDA B,I *** END NON-DMS CODE ************** XIF SPC 1 IFZ ***** BEGIN DMS CODE ************** XLA B,I ******* END DMS CODE ************** XIF SPC 1 SSA,RSS A POINTER? JMP L.13A YES, TRACE IT MORE * AND B174C GET SECURITY CODE FROM QUEUE CPA SECCD COMPARE IT WITH USER'S RSS DOES IT MATCH? JMP ERR00 NO, ERROR 'IO00' * STB SECCD SAVE QUEUE ENTRY ADDR IN SECCD * * AUTOMATIC BUFFERING SECTION * CLA STA TMP6 CLEAR 2ND BUFF SIZE LDB RQP4,I CLE,SSB,RSS BUFFER HAS -CHAR SIZE ? JMP L.028 NO, SKIP BUFF SIZE CONVERT * BRS YES, CONVERT TO +WORDS CMB,INB L.028 STB TMP8 SAVE +WORDS BUFF SIZE * LDB RQPX GET THE MASKED REQUEST CODE * USE 5 WORDS FOR CONTROL REQUEST h CPB .3 IF REQUEST IS FOR -CONTROL-, JMP L.03 SKIP BUFFER SIZE CHECK. * LDA TMP8 GET THE XFER LENGTH STA TEMP3 -SET AS MOVE INDEX- LDB RQP2,I IF DOUBLE BUFFER REQUEST BLF,SLB THEN RSS JMP L.03 * CLA CLEAR (A) IN CASE RQP6=0 LDB RQP6,I SSB,RSS 2ND BUFFER SIZE NEGATIVE? JMP L.029 NO, SKIP 2ND BUFF SIZE CONVERT * BRS YES, CONVERT TO +WORDS CMB,INB L.029 LDA B ADA TMP8 ADD 1ST BUFF SIZE STB TMP6 SAVE 2ND BUFF SIZE L.03 ADA .8 ADD 8 FOR BLOCK CONTROL WORDS. STA L.04 AND SET UP IN CALL * LDA N41 IF PRIORITY LT 41, ADA BPRIO SSA JMP L.031 THEN SKIP BUFFER LIMIT TEST * LDB $BLUP CHECK IF BEYOND THE LIMIT IN WORDS JSB $QCHK ON THIS DEVICE JMP L.040 YES GO CHECK FOR CLASS RQ * * ALLOCATE BLOCK IN TEMPORARY STORAGE * L.031 JSB $ALC CALL AT SYSTEM ENTRY POINT L.04 NOP - REQUESTED LENGTH OF BLOCK - JMP ERR04 NEVER ANY MEMORY, REJECT. JMP L.042 NO MEMORY NOW, SUSPEND. JMP L.06 ALLOCATION OK. * L.040 LDA CLASS IF CLASS AND NO SUSP. SSA,RSS ON BUFFER LIMIT SKIP TO EXIT JMP L.013 ELSE GO SUSPEND * * NO MEMORY AVAILABLE FOR BLOCK - CALLING USER * PROGRAM IS TO BE LINKED INTO MEMORY SUSPENSION * $LIST AND RE-SCHEDULED AT POINT OF REQUEST * WHEN A PREVIOUSLY ALLOCATED BLOCK IS RELEASED. * L.042 LDA N2 IF CLASS I/O CHECK LDB CLASS FOR NO SUSP OPTION SSB IF SET JMP L.026 GO SET FLAG AND EXIT * JSB $LIST CALL TO LINK PROGRAM INTO OCT 504 MEMORY SUSPENSION LIST. JMP $XEQ * * SECCD NOP N41 DEC -41 * * * SET REQUEST PARAMETERS, PROGRAM PRIORITY AND * USER BUFFER INTO TEMPORARY BLOCK. * L.06 STB L.04 SET ACTUAL BLOCK LENGTH. 2P STA BADDR SAVE BLOCK FOR USE IN LINK CALL CCE,INA STA B SAVE ADDRESS LDA WORD2 GET CONTROL WORD IOR B140K SET THE FIELD TO 3 SPC 1 IFN * BEGIN NON-DMS CODE ************** STA B,I AND SET IN WORD 2 OF BLOCK. *** END NON-DMS CODE ************** XIF SPC 1 IFZ ***** BEGIN DMS CODE ************** XSA B,I AND SET IN WORD 2 OF BLOCK. ******* END DMS CODE ************** XIF SPC 1 INB LDA BPRIO SET REQ PRIORITY (=1 IF LU LOCKED) SPC 1 IFN * BEGIN NON-DMS CODE ************** STA B,I IN WORD 3. *** END NON-DMS CODE ************** XIF SPC 1 IFZ ***** BEGIN DMS CODE ************** XSA B,I IN WORD 3. ******* END DMS CODE ************** XIF SPC 1 INB LDA L.04 SET BLOCK LENGTH IN SPC 1 IFN * BEGIN NON-DMS CODE ************** STA B,I WORD 4. *** END NON-DMS CODE ************** XIF SPC 1 IFZ ***** BEGIN DMS CODE ************** XSA B,I WORD 4. ******* END DMS CODE ************** XIF SPC 1 INB LDA CLASS SET THE CLASS SPC 1 IFN * BEGIN NON-DMS CODE ************** STA B,I WORD 5. *** END NON-DMS CODE ************** XIF SPC 1 IFZ ***** BEGIN DMS CODE ************** XSA B,I WORD 5. ******* END DMS CODE ************** XIF SPC 1 INB THE BUFFER * L.061 LDA RQP4,I SET USER BUFFER LENGTH SPC 1 IFN * BEGIN NON-DMS CODE ************** STA B,I IN WORD 6. *** END NON-DMS CODE ************** XIF SPC 1 IFZ ***** BEGIN DMS CODE ************** XSA B,I IN WORD 6. ******* END DMS CODE ************** XIF SPC 1 CMA,CLE,INA SET E IF ZERO LENGTH BUFFEoR LDA RQP5,I GET FIRST OPTIONAL WORD INB STEP TO STORE LOCATION STB TEMPW SAVE THE ADDRESS OF THE LOCATION SPC 1 IFN * BEGIN NON-DMS CODE ************** STA B,I SET IT *** END NON-DMS CODE ************** XIF SPC 1 IFZ ***** BEGIN DMS CODE ************** XSA B,I SET IT ******* END DMS CODE ************** XIF SPC 1 INB SET FOR NEXT WORD LDA RQP6,I GET SECOND OPTIONAL WORD SPC 1 IFN * BEGIN NON-DMS CODE ************** STA B,I SET IT IN THE BUFFER *** END NON-DMS CODE ************** XIF SPC 1 IFZ ***** BEGIN DMS CODE ************** XSA B,I SET IT IN THE BUFFER ******* END DMS CODE ************** XIF SPC 1 LDA RQP1 CPA B23 IF CLASS CONTROL,GO JMP L.078 FINISH ITS SET UP CPA B21 IF CLASS READ ADB TMP8 ADJUST BUFF ADDR FOR DOUBLE BUF. SEZ,CLE,INB,RSS IF LENGTH = 0, CPA B21 OR CLASS READ JMP L.075 SKIP BUFFER MOVE. * * MOVE USER BUFFER TO TEMPORARY BLOCK. * LDA RQP3 SET USER BUFFER L.065 EQU * ADDRESS FOR MOVE. SPC 1 IFN * BEGIN NON-DMS CODE ************** JSB .MVW DEF TEMP3 NOP *** END NON-DMS CODE ************** XIF SPC 1 IFZ ***** BEGIN DMS CODE ************** LDX TEMP3 GET # WORDS TO MOVE MWI MOVE INTO SYSTEM MAP ******* END DMS CODE ************** XIF SPC 1 * L.075 LDA TMP6 GET LENGTH OF SECOND BUFFER STA TEMP3 SET FOR MOVE LDA RQP2,I GET THE REQUEST CONTROL WORD ALF,SLA IF FIRST TIME AND DOUBLE BUFFER SEZ,CCE SKIP JMP L.13 ELSE CONTINUE * SPC 1 IFN * BEGIN NON-DMS CODE ************** STB TEMPW,I SET BUFFER ADDRESS IN REQUEST *** dEND NON-DMS CODE ************** XIF SPC 1 IFZ ***** BEGIN DMS CODE ************** XSB TEMPW,I SET BUFFER ADDRESS IN REQUEST ******* END DMS CODE ************** XIF SPC 1 LDA RQP5 GET USER BUFFER ADDRESS JMP L.065 GO MOVE THE BUFFER L.078 ADB N2 CORRECT B REG * L.08 LDA RQP3,I FOR CONTROL REQUEST, SET WORD 3 SPC 1 IFN * BEGIN NON-DMS CODE ************** STA B,I (PARAM) IN PLACE OF RECORD *** END NON-DMS CODE ************** XIF SPC 1 IFZ ***** BEGIN DMS CODE ************** XSA B,I (PARAM) IN PLACE OF RECORD ******* END DMS CODE ************** XIF SPC 1 * * CLASS I/O SO SET THE CLASS QUEUE TO SHOW * ANOTHER REQUEST IS PENDING. * L.13 EQU * SPC 1 IFN * BEGIN NON-DMS CODE ************** ISZ SECCD,I *** END NON-DMS CODE ************** XIF SPC 1 IFZ ***** BEGIN DMS CODE ************** XLA SECCD,I INA INCREMENT CLASS QUEUE COUNT BY 1 XSA SECCD,I ******* END DMS CODE ************** XIF SPC 1 LDA BADDR RETURN ADDR OF NEW BLOCK ISZ $I.CL INCRE RETURN FOR CLASS I/O INIT. L.10 JMP $I.CL,I RETURN TO $MIO * L.013 STB XTEMP,I SET 4 IN WORD1 OF TEMPS JSB $LIST PUT PROG IN WAIT OCT 503 UNTIL DEVICE COMES UP JMP $XEQ EXIT THROUGH $MDI * L.16 LDA RQRTN UPDATE THE STA XSUSP,I RETURN ADDR JMP $XEQ AND EXIT VIA $MDI * SKP SPC 3 * WORD2 NOP RQPX NOP CLASS NOP DCLAS DEF $CLAS CONFIGURED TO BE DIRECT. MCLAS NOP CONFIGURED TO BE NEGATIVE OF ABOVE. B174C OCT 17400 BITS 8-12 N8 DEC -8 N2 DEC -2 N1 DEC -1 .2 DEC 2 .3 DEC 3 .5 DEC 5 .8 DEC 8 B17 OCT 17 B21 OCT 21 B23 OCT 23 B37 OCT 37 B377 OCT 377 B140K OCT 140000 B160K OCT 160000 * BArQDDR NOP TEMP3 NOP TEMP4 NOP BPRIO NOP TEMPW NOP TLOG NOP STAT NOP TMP6 NOP TMP8 NOP SPC 2 SKP HED ** RTE-M CLASS I/O MODULE - COMPLETION CALL ** * CLASS REQUEST COMPLETION * * CLASS COMPLETION IS HANDLED AS FOLLOWS: * * 1. THE EXCESS BUFFER IS RETURNED ON WRITE COMPLETION * 2. IF THE CLASS QUEUE IS NOT EXPECTING A REQUEST * THE WHOLE BUFFER IS RELEASED AND WE EXIT. * 3. IF A PROGRAM IS WAITING FOR THE REQUEST IT IS * RESCHEDULED. * 4. THE REQUEST IS MODIFIED TO PUT THE STATUS WORD * AND THE TRANSMISSION LOG (TLOG) IN WORDS * 3 (PRIORITY) AND 6 (USER LENGTH WORD) * 5. THE CLASS QUEUE IS UPDATED AND WE EXIT. * * SEE DESCRIPTION OF CLASS QUEUE IN COMMENTS AT BEGINNING * OF SECTION ON USER REQUESTS. * * LDA TLOG (A) = TRANSMISSION LOG * LDB XXXXX (B) = CLASS QUEUE POINTER * JSB $C.CL CALL FROM $MIO * DEF TEMP3 DRIVER STATUS RETURN * RETURN. EITHER DO NEXT OR RETURN * * * $C.CL NOP STA TLOG SAVE TRANSMISSION LOG STB PTR INB LDA B,I GET THE CON WORD ADB .2 STEP TO LENGTH WORD STB CLTMP SET LENGTH ADDRESS SLA IF READ JMP C.03 SKIP RETURN * LDA B,I GET BLOCK SIZE TO A. ADB .5 STEP TO RETURN BUFFER ADDRESS ADA N8 SUBTRACT SIZE OF OVERHEAD STA CLRTN SET RETURN SIZE ADA N2 IF LESS THAN TWO WORDS SSA THEN SKIP JMP C.03 THE RETURN * STB CARTN SET THE BUFFER ADDRESS JSB $RTN RETURN THE WRITE BUFFER CARTN NOP BUFFER ADDRESS CLRTN NOP BUFFER LENGTH * LDA CLRTN SET THE CMA,INA NEW BLOCK SIZE ADA CLTMP,I IN THE BLOCK STA CLTMP,I SET THE NEW SIZE * C.03 ISZ CLTMP STEP TO CLASS WORD  LDA CLTMP,I GET THE CLASS AND B377 COMPUTE THE ADA DCLAS CLASS HEAD ADDRESS * C.04 LDB A,I GET THE CONTENTS OF CLASS HEAD. * CLE,SSB,RSS IF POSITIVE JMP C.08 GO TRACK DOWN THE QUE. * STA CLASS SAVE THE CLASS QUEUE ADDRESS RBL,CLE,ELB IF PROGRAM WAITING SEZ,CLE,RSS JMP C.05 SKIP,ELSE GO LINK IN THE RQ. * * PROGRAM IS WAITING, CLEAR THE WAIT FLAG * AND RESCHEDULE THE PROGRAM * ERB,RBR CLEAR THE WAIT FLAG STB A,I AND RESET IN THE QUEUE. * JSB $SCD3 SCHEDULE ANY PROGRAMS WAITING C.05 LDB CLASS,I GET CURRENT END OF LIST ADB N1 SUBTRACT ONE PENDING REQUEST STB PTR,I SET IN NEW END OF LIST LDB PTR SET NEW ELEMENT IN STB CLASS,I THE LIST. * ISZ PTR STEP TO ISZ PTR PRIORITY ADDRESS ISZ CLTMP STEP TO BUFFER LENGTH WORD LDA EQT5,I GET CURRENT STATUS ALR,RAL CLEAR DOWN/BUSY BITS. LDB $C.CL,I GET WHERE -FROM FLAG AND STAT LDB B,I * CMB,CLE,INB IF BAD COM CODE CME SET BIT 14 ERA,CLE,RAR ROTATE TO CORRECT POSITION LDB TLOG GET THE TRANSMISSION LOG. STA PTR,I SET THE STATUS WORD STB CLTMP,I AND THE TLOG ISZ $C.CL ADJUST RETURN JMP $C.CL,I RETURN TO $MIO MODULE * C.08 LDA B TRACK DOWN JMP C.04 THE END OF THE LIST * SKP HED ** RTE-M CLASS I/O MODULE - GET CALL ** * $G.CL IS THE ENTRY POINT FOR A 'GET' EXEC CALL * * JMP $G.CL CALL FROM $MEX * * $G.CL EQU * SPC 1 IFZ ***** BEGIN DMS CODE ************** UJP *+2 ENABLE USER MAP ******* END DMS CODE ************** XIF SPC 1 LDA RQP2,I GET THE CLASS AND B377 MASK STA B SAVE AND CMA,CLE,INA,SZA,RSS IF CLASS=0 CLE,RSS *C SEND "IO00" * ADA $CLAS IF GREATER THAN MAX THEN CLA,SEZ,RSS SEND JMP ERR00 'IO00' ERROR * ADB DCLAS SET THE STB CLASS CLASS TABLE ADDRESS * BFCK LDB RQP4,I GET THE LENGTH CLE,SSB,RSS CONVERT TO JMP BFWDS WORDS IF BRS CHARACTERS CMB,INB SET POSITIVE AND BFWDS STB TMP8 SAVE. SPC 1 ADB RQP3 CHECK IF AREA EXTENDS ABOVE THE CMB,SEZ,CLE,INB,RSS LAST WORD ADB BKLWA OF MEMORY INB CLB,SEZ,RSS IF SO THEN JMP ERR04 ERROR 4 DIAGNOSTIC * * * G.01 LDA RQP2,I GET SECURITY CODE AND B174C BITS FROM CLASS WORD STA SECCD LDB CLASS,I GET QUEUE HEAD SSB IF A COUNTER JMP G.06 GO SUSPEND THE PROGRAM SZB,RSS IF QUEUE-HEAD = 0 JMP ERR00 ERROR "IO00" * STB PTR SAVE THE ADDRESS INB GET THE CON WORD SPC 1 IFN * BEGIN NON-DMS CODE ************** LDA B,I AND *** END NON-DMS CODE ************** XIF SPC 1 IFZ ***** BEGIN DMS CODE ************** XLA B,I AND ******* END DMS CODE ************** XIF SPC 1 AND .3 ISOLATE THE REQUEST CODE STA RQP7,I RETURN IT TO USER'S IRCLS INB STEP TO STATUS WORD SPC 1 IFN * BEGIN NON-DMS CODE ************** LDA B,I GET COMPLETION STATUS. *** END NON-DMS CODE ************** XIF SPC 1 IFZ ***** BEGIN DMS CODE ************** XLA B,I GET COMPLETION STATUS. ******* END DMS CODE ************** XIF SPC 1 STA XA,I AND SET IT IN THE A REG. INB GET THE BUFFER LENGTH SPC 1 IFN * BEGIN NON-DMS CODE ************** LDA B,I AND SET IT *** END NON-DMS CODE ************** XIF SPC 1 IFZ ***** BEGIN DMS CODE ************** XLA B,I AND SET IT ******* END DMS CODE ************** XIF SPC 1 STA CLTMP FOR RETURN INB STEP TO USER CLASS WORD SPC 1 IFN * BEGIN NON-DMS CODE ************** LDA B,I GET IT *** END NON-DMS CODE ************** XIF SPC 1 IFZ ***** BEGIN DMS CODE ************** XLA B,I GET IT ******* END DMS CODE ************** XIF SPC 1 AND B174C KEEP SECURITY CODE CPA SECCD MATCHES CALLER'S? RSS JMP ERR00 NO, ERROR IO00 * INB INDEX TO THE SPC 1 IFN * BEGIN NON-DMS CODE ************** LDA B,I TLOG AND *** END NON-DMS CODE ************** XIF SPC 1 IFZ ***** BEGIN DMS CODE ************** XLA B,I TLOG AND ******* END DMS CODE ************** XIF SPC 1 STA XB,I SET IT IN THE 'B' REG INB INDEX TO THE SPC 1 IFN * BEGIN NON-DMS CODE ************** LDA B,I FIRST OPTIONAL WORD AND *** END NON-DMS CODE ************** XIF SPC 1 IFZ ***** BEGIN DMS CODE ************** XLA B,I FIRST OPTIONAL WORD AND ******* END DMS CODE ************** XIF SPC 1 STA RQP5,I SET IT IN THE USERS BUFFER INB NOW DO THE SECOND OPTIONAL WORD SPC 1 IFN * BEGIN NON-DMS CODE ************** LDA B,I *** END NON-DMS CODE ************** XIF SPC 1 IFZ ***** BEGIN DMS CODE ************** XLA B,I ******* END DMS CODE ************** XIF SPC 1 STA RQP6,I * STB TEMP4 SAVE THE BUFFER ADDRESS LDA .8 GET THE BUFFER LENGTH CMA,INA SET NEGATIVE ADA CLTMP LOP OFF THE HEAD WORDS STA TEMP3 SET THE MOVE COUNT LDB TMP8 GET THE USUPPLIED LENGTH CMA,INA SET MOVE COUNT NEG ADA TMP8 USE LESSOR OF THE TWO SSA,RSS COUNTS LDB TEMP3 USE QUEUE COUNT IF SMALLER SSB IF COUNT LESS THAN ZERO THEN JMP G.05 THEN SKIP MOVE * G.03 ISZ TEMP4 STEP THE BUFFER ADDRESS. LDA TEMP4 (A)= SOURCE SPC 1 IFN * BEGIN NON-DMS CODE ************** STB WORD2 SAVE COUNT LDB RQP3 (B)= DESTINATION JSB .MVW DEF WORD2 NOP *** END NON-DMS CODE ************** XIF SPC 1 IFZ ***** BEGIN DMS CODE ************** CBX GET MOVE COUNT LDB RQP3 GET DESTINATION MWF MOVE FROM SYSTM TO USER ******* END DMS CODE ************** XIF SPC 1 G.05 LDA RQP2,I IF SAVE RAL,RAL QUEUE OPTION SLA,ELA THEN JMP L.16 THEN EXIT * SPC 1 IFN * BEGIN NON-DMS CODE ************** LDA PTR,I ELSE *** END NON-DMS CODE ************** XIF SPC 1 IFZ ***** BEGIN DMS CODE ************** XLA PTR,I ELSE ******* END DMS CODE ************** XIF SPC 1 STA CLASS,I UPDATE THE LIST SSA IF POINTER, SKIP COUNT CHECK AND B37 GET # PENDING REQUESTS LEFT SEZ,SZA,RSS NO REQUESTS LEFT STA CLASS,I AND IF DEALLOCATE WANTED, DO IT. JSB $RTN RETURN THE MEMORY PTR NOP AND CLTMP NOP THEN JMP G.08 SCHEDULE WAITERS AND EXIT * G.06 LDA B174C GET SECURITY CODE AND B FROM QUEUE CPA SECCD MATCH? RSS JMP ERR00 NO, ERROR IO00 * RBL,CLE,ELB MOVE BIT14 (SOMEONE WAITING) TO E G.065 LDA CLASS,I GET CLASS WORD AND B377 CMA,SEZ ANYONE WAITING? (SET ONES COMP) JMP SCEDT YES,SORRY SOMEBODY BEAT YOU TO IT * STA XA,I SET A FOR POSSIBLE RETURN INA GET CORRECT 2'S COMPLEMENT STA B LDA RQP2,I GET THE OPTION FLAG ELA,RAL SET E=BIT15 NO-WAIT OPT. SZB,RSS IF QUEUE-HEAD = 0 SSA AND BIT14 SET, JMP G.07 DON'T DEQUEUE * STB CLASS,I IF Q-H=0 AND BIT14=0 DEQUEUE! G.08 LDA DCLAS NOW SCHEDULE ALL THOSE WAITING JSB $SCD3 FOR AN AVAILABLE CLASS NUMBER. JMP L.16 RETURN * G.07 SEZ,CCE JMP L.16 BIT15=1 FOR NO-WAIT. RETURN. LDB CLASS GET CLASS ADDR IN B FOR L.013 LDA B,I SET "SOMEONE IS WAITING" FLAG RAL,RAL ERA,RAR STA B,I AND JMP L.013 PUT IT BACK INTO WAIT LIST * * SCEDT ERB,RBR CLEAR THE BIT AND STB CLASS,I RESET THE CLASS HEAD LDA CLASS GET HEAD ADDRESS TO A AND JSB $SCD3 RESCHEDULE THE WAITER IF ANY LDA $LIST WAS THERE ONE?? CLE,SZA JMP ERR10 YES ERROR GO ABORT * JMP G.065 NO. MUST HAVE BEEN ABORTED, CONTINUE SPC 1 SKP ERR00 CLB,RSS ILLEGAL CLASS# OR SECURITY CODE ERR01 CLB,INB INSUFFICIENT # OF PARAMETERS RSS ERR04 LDB .4 ILLEGAL BUFFER ADDRESS RSS ERR10 LDB B400 DOUBLE REQUEST ON SAME CLASS LDA ERIO (A) = ASCII "IO" JMP $ERAB WRITE MESSAGE AND EXIT TO $MDI * ERIO ASC 1,IO .4 DEC 4 B400 OCT 400 SKP . EQU 1650B ESTABLISH ORIGIN OF AREA * * SYSTEM TABLE DEFINITION * * * * I/O MODULE/DRIVER COMMUNICATION * EQT1 EQU .+8 ADDRESSES EQT5 EQU .+12 CURRENT * * * SYSTEM REQUEST PROCESSOR /'EXEC' COMMUNICATION * * RQRTN EQU .+23 RETURN POINT ADDRESS RQP1 EQU .+24 ADDRESSES RQP2 EQU .+25 RQP3 EQU .+26 OF REQUEST RQP4 EQU .+27 RQP5 EQU .+28 PARAMETERS RQP6 EQU .+29 RQP7 EQU .+30 (SET FOR MAXIMUM OF RQP8 EQU .+31 8 PARAMETERS) * * DEFINITION OF SYSTEM L TRNISTS (QUEUES) * * * * DEFINITION OF EXECUTING PROGRAM ID SEGMENT' * * XEQT EQU .+39 ID SEGMENT ADDR. OF CURRENT PROG. XTEMP EQU .+41 'TEMPORARY (5-WORDS) XSUSP EQU .+48 'POINT OF SUSPENSION' XA EQU .+49 'A REGISTER' AT SUSPENSION XB EQU .+50 'B REGISTER' * BKLWA EQU .+87 LWA OF MEMORY IN BACKGROUND * * ORG * LENGTH OF MODULE END $I.CL T } 92064-18027 1726 S C0222 &MAP00 RTE-M ABS PROGRAM LOADER             H0102 !*USE 'ASMB,R,N' (RTE-M I/RTE-M II) OR 'ASMB,R,Z' (RTE-M III) * * IFN OPTION * NAME: APLDR * SOURCE: 92064-18027 * RELOC: 92064-16012 * PROGMR: E.J.W. * * IFZ OPTION * NAME : APLDR * SOURCE: 92064-18027 * RELOC: 92064-16016 * PROGMR: E.J.W. * * **************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT * * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * **************************************************************** * * IFN * BEGIN NON-DMS CODE *************** NAM APLDR,1,40 92064-16012 REV.1726 770512 *** END NON-DMS CODE *************** XIF IFZ ***** BEGIN DMS CODE *************** NAM APLDR,1,40 92064-16016 REV.1726 770512 ******* END DMS CODE *************** XIF SPC 1 EXT $LIBR,$LIBX,EXEC,$CVT3 EXT IDCB1,OPEN,READF,LOCF,CLOSE,IMESS,$CON SPC 1 IFN * BEGIN NON-DMS CODE *************** EXT .MVW *** END NON-DMS CODE *************** XIF IFZ ***** BEGIN DMS CODE *************** EXT $MATA,$ENDS ******* END DMS CODE *************** XIF SPC 1 * A EQU 0 B EQU 1 KEYWD EQU 1657B BPA1 EQU 1742B BPA2 EQU 1743B RTORG EQU 1746B RTCOM EQU 1747B AVMEM EQU 1751B BKLWA EQU 1777B SUP * * * APLDR IS SCHEDULED BY THE SYSTEM WHEN OPERATOR INPUTS * ONE OF THE FOLLOWING: * PL,LU#,OPT * (1)(0) * LO,PNAME,SC,DRN-LU,PTTN#,SIZE * LU# * (4) (0) (0) (0) (0) * * THE SCHEDULE CALL PASSES THE PARAMETERS IN THE FOLLOWING * ORDER: * P1 - LU 4:9 / FUNC 0:3 * P2 - #PAGES 10:14 / PTTN# 0:5 OR LIST OPTION * P3 - CHAR1 8:15 / CHAR2 0:7 * P4 i- CHAR3 8:15 / CHAR4 0:7 * P5 - CHAR5 8:15 / CHAR6 0:7 * * WHERE FUNCTION CODE IS: * 0 - PROGRAM LIST * 1 - LOAD PROGRAM INTO MEMORY RESIDENT AREA * 2 - LOAD PROGRAM INTO A PARTITION SKP APLDR NOP LDA DPARM GET ADDR OF BUFFER STA TEMP1 SAVE TEMPORARILY LDA MD5 STA TEMP2 RMPLP LDA B,I GET PARAM FROM ID SEG STA TEMP1,I SAVE IN BUFFER INB ISZ TEMP1 ISZ TEMP2 JMP RMPLP * ADB D20 INDEX TO WORD 27 STB DFSC SAVE ADDR OF SECURITY CODE INB STB DFCR SAVE ADDR OF CART.REF.OR NEG.LU# LDA ERLUF ALF,ALF ALF AND B77 STA LU SAVE LU FOR LISTING * * LDA ERLUF GET FUNCTION FROM BITS 0-3 AND B17 STA FUNC SZA,RSS IS IT LIST? 0 JMP LIST CPA D1 IS IT LOAD? 1 JMP LOAD IFZ ***** BEGIN DMS CODE *************** CPA D2 IS IT PARTITION LOAD? 2 JMP LOAD ******* END DMS CODE *************** XIF * UNL * EXT DBUG *** DEBUGGING *** * JSB DBUG *** DEBUGGING *** * DEF *+1 *** DEBUGGING *** * NOP *** DEBUGGING *** NOP *** DEBUGGING *** LST * JMP ABORT NO, IT IS ERROR. * DPARM DEF ERLUF MD5 DEC -5 B77 OCT 77 D3 OCT 3 D20 DEC 20 FUNC NOP FUNCTION CODE HED L0: LOAD PROGRAM DMAGI DEF MAGIC ADDR OF MAGIC LU FILENAME MAGIC BSS 3 * DFNAM DEF MAGLU ADDR OF DEFAULT FILENAME MAGLU ASC 3,LU..04 WHICH IS MAGIC LU FILENAME FOR LU 4 * * LOAD EQU * SPC 1 IFZ ***** BEGIN DMS CODE *************** CLA STA PT#PG STA PTTN# ******* END DMS CODE *************** XIF SPC 1 JSB IHILO INIT HI,LO ADDRS LDA DWRD1 INIT SPEC REC STA WORD1 DUMMY ID AD+DR. LDA DWRD2 STA WORD2 LDA RSS INITIALIZE SWITCH STA AB12D FOR SPEC. REC. CLA STA ABS12 STA ABSCT INDICATE NO ABS YET. * LOAD1 LDA NAM12 IF NO NAME GIVEN LDB DFNAM USE DEFAULT INPUT FILE SZA LDB DNM12 STB NAM * LDA B,I GET FIRST WORD OF NAME AND B77 CPA B,I LEGAL NUMERIC LU? RSS YES, SKIP JMP LOAD3 NO, ASSUME IT'S ASCII NAME * LDB DMAGI CONVERT NUMERIC LU TO MAGIC LU FILENAME STB NAM (A) STILL HAS LU# JSB CVDEC DLD MAGLU DST MAGIC LDA MAGIC+2 GET DIGITS PORTION IOR A00 INSURE ASCII ZEROES IF ANY STA MAGIC+2 * LOAD3 JSB STRID LOAD2 JSB SRCID FIND A BLANK DEF ZERO ID SEG. JMP LOADD NO BLANK ID SEG. JMP LOAD2 KEEP LOOKING. STA CURID GOT IT, SAVE ADDR. * JSB OPEN OPEN THE ABS INPUT FILE DEF *+7 DEF IDCB1 DEF ERR NAM DEF * FILE NAME ADDR DEF OPT OPT = 2300B FOR ABS DFSC DEF * SECURITY CODE DFCR DEF * CARTRIDGE NUMBER OR NEG.LU# SSA ANY ERRORS? JMP NOFIL NO SUCH FILE * JSB LOCF GET FILE INFO DEF *+9 DEF IDCB1 DEF ERR DEF TEMP1 DEF TEMP1 DEF TEMP1 DEF TEMP1 DEF TEMP1 DEF TEMP LDA TEMP SZA,RSS TYPE 0 FILE? STA NAM12 FORCE USE OF TRAILER RECORD SZA,RSS JMP ABS0 YES, SKIP DUP NAME CHECK NOW * JSB DUPID CHECK FOR DUPLICATE NAME DNM12 DEF NAM12 CHANGE TO ..NAME IF POSSIBLE * * READ AN ABSOLUTE RECORD * * ABS0 JSB READF READ ABS RECORD DEF *+6 DEF IDCB1 DEF ERR DABS DEF ABSBF DEF D64 DEF LEN LDB LEN CPB M1 EOF? JMP LOAD5 YES. SSeA JMP ABSCK ANY ERROR, CHECKSUM ERROR * LDA ABSCT GET WORD COUNT AND LHALF ALF,ALF SHIFT TO LOW BITS STA ABSSZ SAVE REC SIZE CMA,INA STA TEMP1 SAVE NEG COUNT LDB ABSAD GET ADDR, START CKSM. LDA DABSD STA TEMP2 SET DATA ADDR. ABS0B LDA TEMP2,I GET A WORD ADB A ADD TO CKSM ISZ TEMP2 BUMP TO NEXT ISZ TEMP1 BUMP COUNT JMP ABS0B REPEAT TIL DONE. * LDA TEMP2,I CPA B COMPARE CKSMS JMP ABS1 MATCHES * ABSCK LDB ERR10 CHECKSUM ERROR- JMP ERPR4 ERR MSG THEN ABORT * NOFIL CMA,INA FMP ERROR CODE IN (A) LDB DABS GET DEF TO TEMP BUFFER JSB CVDEC CONVERT ERR CODE TO ASCII LDA LDASH IOR ABSAD FILL IN "- " STA ABSAD FOR " APLDR: -###" LDB DABS INB SET ADDR OF 4 CHARS JMP ERPR4 PRINT ERROR, THEN ABORT * * FIND WHERE ABSOLUTE RECORD FITS IN CORE * * ABS1 LDA ABSAD LDB ABSCT CPB HI2 ONLY 2 WORDS IN REC? RSS JMP ABS1A NO, CHECK NORMAL RECORD CPA D2 IS IT SPECIAL RECORD? JMP ABS12 YES ABS1A AND BPMSK IS IT BASE PAGE? CPA ABSAD JMP ABS2 YES, BASE PAGE. * SPC 1 IFZ ***** BEGIN DMS CODE *************** LDA FUNC CPA D2 LOAD PTTN? JMP PTMN YES, SET BOUNDS FOR ADDR CHECKS * ******* END DMS CODE *************** XIF SPC 1 LDA RTORG GET DEFAULT LOWEST ADDR STA TEMP LDA AVMEM GET DEFAULT HIGHEST ADDR STA TEMP1 LDA DMAIN GET PTRS TO MAIN HI/LO LDB D22 SET OFFSET FOR MAIN JMP ABS3 ADDRS IN ID SEG. * ABS2 EQU * SPC 1 IFZ ***** BEGIN DMS CODE *************** LDA FUNC CPA D2 LOAD PTTN? JMP PTBP YES, SET BOUNDS FOR ADDR CHECKS * ******* END DMS CODE *************** XIF SPC 1 LDA BPA1 GET DEFAULT LOWEST ADDR STA TEMP LDA BPA2 GET DEFAULT HIGHEST ADDR INA STA TEMP1 LDA DBASE GET PTRS TO BASE HI/LO LDB D24 SET OFFSET FOR BASE PAGE * * * * FIND THE HI AND LO MEMORY BOUNDS OF FREE CORE * * ABS3 STB IDOFS SAVE OFFSET TO GET ADDRS STA TEMP4 SAVE ADDR OF LFREE ADA D2 STA TEMP5 SAVE ADDR OF HFREE LDA TEMP CMA,INA CHECK IF ABS REC < FWABP USER LINKS ADA ABSAD SSA JMP ABS14 ABS < FWABP, ERROR LDA ABSAD ADA ABSSZ CMA,INA CHECK IF ABS REC > LWAM USER SPACE ADA TEMP1 SSA JMP ABS14 ABS > LWAM, ERROR LDA TEMP4,I CPA TEMP RSS ADDRS ALREADY SET? JMP ABS6 YES, SKIP SEARCH FOR HI/LO * JSB STRID INIT ID SEARCH. ABS4 JSB SRCID SEARCH EACH ID DEF ZERO EXCEPT BLANK ONES, JMP ABS6 FOR THE HI/LO RSS RSS ADDRS WHICH JMP ABS4 DEFINE FREE CORE. CPA CURID IS THIS ID FOR PRG? JMP ABS4 YES, IGNORE THIS ID BOUNDS ADA IDOFS STA TEMP SET ADDR OF ID ADDR. * LDA B (B) STILL HAS ADDR OF NAME ADA D2 BUMP TO TYPE LDA A,I AND B17 GET TYPE FROM ID SEG CPA D1 MEMORY RESIDENT TYPE? RSS YES, CHECK ADDRS JMP ABS4 NO, IGNORE ID * CLA STA TEMP1 CLEAR OVERLAP FLAG * LDA TEMP,I GET ID LOW CMA,INA ADA ABSAD IS ID LOW > ABS REC? SSA JMP ABS4B LOW>ABS, CHECK MORE ISZ TEMP1 LOW<=ABS, CHECK IF OVERLAP JMP ABS5 BY CHECKING IF HI>=ABS * ABS4B LDA TEMP,I GET ID LOW AGAIN CMA SUBTRACT IT ADA TEMP5,I FROM LAST HFREE SSA tr AND JMP ABS5 IF IT IS LDA TEMP,I LOWER THEN KEEP IT DST TEMP5,I AS NEW HFREE * ABS5 ISZ TEMP LDA TEMP,I GET ID HIGH ADDR CMA,INA ADA ABSAD SSA,RSS ID HIGH < ADDR OF REC? JMP ABS5B HI<=ABS, CHECK MORE CLA,INA HI>ABS, MIGHT OVERLAP CPA TEMP1 DOES ABS OVERLAP? JMP ABS13 YES, GIVE OF ERR JMP ABS4 NO, IGNORE * ABS5B LDA TEMP,I GET ID HI CMA,INA SUBTRACT IT ADA TEMP4,I FROM LAST LFREE SSA,RSS AND IF IT IS JMP ABS4 LDA TEMP,I HIGHER, WE KEEP IT DST TEMP4,I AS NEW LFREE JMP ABS4 REPEAT FOR EACH ID * * * * ALREADY GOT MEMORY BOUNDS; SEE IF ABS CAN FIT * * ABS6 LDA ABSAD GET ADDR OF ABS REC LDB ABSSZ ADB A GET ADDR OF END OF ABS REC JSB CKBND CHECK BOUNDS WITH LFREE,HFREE JMP ABS13 ERROR. * * * * COPY ABS RECORD TO CORE IF WITHIN BOUNDS SPC 1 IFZ ***** BEGIN DMS CODE *************** LDA FUNC CPA D1 LOAD MEMORY RESIDENT? JMP LDMRP YES * REMAP LDA ABSAD NO, LOAD PARTITION RESIDENT JSB PGNO GET PAGE OF RECORD STA PAGE1 SZA,RSS RECORD FOR BASE PAGE? JMP BPMAP YES * LDA ABSAD ADA ABSSZ GET ADDR OF LAST WORD IN RECORD ADA M1 STA ABSEN SAVE ADDR OF LAST WORD IN REC JSB PGNO FIND PAGE OF THAT WORD STA B STB PAGE2 SAVE ENDING PAGE NUMBER CPB PAGE1 RECORD FITS WITHIN ONE PAGE? JMP SAMEP YES * BLF,BLF NO, CROSSES ONE PAGE RBL,RBL ASSUMING RECORD SIZE < 128 WORDS STB PADDR SAVE PAGE BOUNDARY ADDR LDA ABSAD CMA,INA ADA PADDR CALCULATE #WORDS ON THIS PAGE CAX STA WDS1 LDA PTFWA JSB PGNO STA B CMB,INB  SUBTRACT PTTN PAGE# ADB PAGE1 TO GET #PAGES OFFSET ADB PTSPG AND OFFSET FROM FIRST PAGE OF PTTN INB (B) = PHYSICAL PAGE # AFTER COUNTING BP * LDA ABSAD CAY (Y) = LOGICAL ADDR FOR RECORD LDA DABSD (A) = ADDR OF RECORD IN INPUT BUFFER JSB MAPMV PERFORM MAPPING WORD MOVE * LDA PAGE2 SET UP TO MOVE SECOND PART ALF,ALF RAL,RAL CONVERT PAGE# TO ADDR CMA,INA SUBTRACT FROM END ADDR ADA ABSEN TO GET # WORDS INA CAX (X) = # WORDS TO MOVE LDA PTFWA JSB PGNO STA B CMB,INB SUBTRACT FIRST PAGE OF PTTN ADB PAGE2 TO GET #PAGES OFFSET ADB PTSPG ADD TO PTTN FIRST PAGE INB (B) = PAGE # LDA PADDR CAY (Y) = LOGICAL ADDR FOR RECORD LDA DABSD ADA WDS1 (A) = ADDR OF ABS REC IN INPUT BUFFER JSB MAPMV DO MAPPED MOVE JMP ABS0 GO READ MORE * SAMEP LDA PTFWA JSB PGNO STA B CMB,INB ADB PAGE1 INB ADB PTSPG SAMEM LDA ABSSZ CAX (X) = #WORDS LDA ABSAD CAY (Y) = LOGICAL ADDR IN PTTN LDA DABSD (A) = ADDR OF REC IN INPUT BUFFER JSB MAPMV DO MAPPED MOVE JMP ABS0 GO READ MORE * BPMAP LDB PTSPG JMP SAMEM * * PGNO NOP CONVERT ADDR TO PAGE # AND B76K ALF,RAL RAL JMP PGNO,I RETURN (A)=PAGE # (B)=UNCHANGED * * (A) = ADDR OF ABS REC IN INPUT BUFFER * (B) = PAGE # OF PARTITION * (X) = # WORDS TO MOVE * (Y) = LOGICAL ADDR FOR ABS IN PTTN * MAPMV NOP MAPPED MOVE ROUTINE STA MAPFR TO MOVE ABS RECS TO PTTN CYA STA LOGSA SAVE LOGICAL ADDR CXA STA NWDS SAVE # WORDS * CLA,INA CAX (X) = 1 REGISTER TO SET UP LDA MAPPG (A) = MAP REGISTER # JSB $LIBR TURN OFF MEM PROT NOP SO WE CAN CHANGE MAP, ALSO MOVE TO BP XMS (B) = PTTN'S PAGE # LDA LOGSA CONVERT LOG ADDR TO PAGE# AND B76K CMA,INA ADA LOGSA OFFSET INTO PAGE ADA PAGBF MAKE LOGICAL ADDR FOR MAPPED MOVE STA B (B) = ADDR OF DUMMY BUFFER FOR MOVE LDA NWDS CAX (X) = #WORDS TO MOVE LDA MAPFR (A) = ADDR OF ABS REC IN BUFFER MWI MOVE WORDS VIA DUMMY BUFFER IN SYS MAP JSB $LIBX DEF MAPMV RETURN * MAPFR NOP ADDR OF ABS REC IN BUFFER LOGSA NOP LOGICAL ADDR OF ABS REC IN PTTN MAPPG DEC 31 LAST PAGE IN SYSTEM MAP PAGBF OCT 76000 ADDR OF DUMMY BUFFER FOR CROSS MAP STORE NWDS NOP #WORDS TO MOVE PADDR NOP PAGE BOUNDARY ADDR B1777 OCT 1777 B76K OCT 76000 C100K OCT 77777 CURPT NOP ADDR OF CURRENT PTTN OWNER PTR PAGE1 NOP PAGE # OF FIRST PART OF REC PAGE2 NOP PAGE # OF SECOND PART OF REC ABSEN NOP ADDR OF LAST WORD IN REC PT#PG NOP #PAGES IN PTTN PTFWA NOP LOGICAL ADDR OF FIRST WORD IN MAIN OF PTTN PTLWA NOP LOGICAL ADDR OF LAST WORD IN MAIN OF PTTN PTSPG NOP PAGE # OF FIRST PAGE IN PTTN PTTN# NOP PTTN # WDS1 NOP # WORDS IN FIRST PAGE OF REC DCRID DEF CURID * * PTMN LDA DMAIN GET PTRS TO MAIN HI/LO RSS GO CHECK BOUNDS OF REC * PTBP LDA DBASE GET PTRS TO BP HI/LO STA TEMP4 JMP ABS6 GO CHECK BOUNDS OF REC * ******* END DMS CODE *************** XIF SPC 1 * * LDMRP LDA DABSD SET UP BUFFER LDB ABSAD SET UP CORE ADDR. JSB SYSET PUT INTO CORE. DEF ABSSZ JMP ABS0 GO GET ANOTHER RECORD * * * * PROCESS SPECIAL TRAILER RECORDS. * * ABS12 NOP RSS-ED AFTER SSGA SET UP. JMP AB12C  AB12D RSS NOP-ED AFTER 1ST ENTRY.! JMP AB12B SO ONLY DO THIS ONCE. LDA MD28 STA TEMP1 SET COUNTER LDB DDMID TO CLEAR OUT CLA AB12A STA B,I SPECIAL RECORDS INB ISZ TEMP1 JMP AB12A STA AB12D NOP SWITCH * AB12B LDA WORD1 CPA DWRD2 ALL DONE ALREADY? JMP IDERR ERROR ON TRAILER RECORDS DLD ABSD1 PICK UP 2 DATA WORDS STA WORD1,I PUT 1ST INTO DUMMY ID. STB WORD2,I PUT 2ND INTO DUMMY ID. ISZ WORD1 BUMP DUMMY ID ISZ WORD2 LOCATIONS. JMP ABS0 * * MPFT# 0-PRP NO COM, 1-MRP NO COM, 2-RT COM, 3-XXX, 4-SSGA * AB12C LDA RSS STA ABS12 SET RSS IN THE SSGA SWITCH CLB,INB PREPARE FOR FUNC=1 FOR MRP LDA ABSD1 FIRST SPECIAL RECORD RAL,CLE,ERA SIGN BIT 0-MRP, 1-PRP STA MPFT# HAS MPFT INDEX SEZ IS IT MEMORY RESIDENT? INB NO, SET FUNC=2 FOR PTTN LOAD STB FUNC OVERRIDE FUNC WITH ABS TYPE SEZ,RSS IS IT MEMORY RESIDENT? JMP ABS0 YES, READ NEXT RECORD SPC 1 IFN * BEGIN NON-DMS CODE *************** JMP IDERR M1 OR M2 DOESN'T ALLOW PRP *** END NON-DMS CODE *************** XIF IFZ ***** BEGIN DMS CODE *************** LDA PGPT JSB PGNO CMA,INA INA STA PT#PG SAVE NEG #PAGES-1 CCB ADB $MATA (B) = ADDR OF #PTTNS LDA PGPT AND B77 GET PTTN # SZA,RSS SPECIFIC PTTN# WANTED? JMP PTFND NO, FIND A FREE ONE * ADA M1 SAVE PTTN# - 1 STA PTTN# CMA ADA B,I SUBTRACT FROM #PTTNS CMA SSA,RSS ANY ERROR? JMP ER.PT YES, NO SUCH PTTN * LDA PTTN# 6*(PTTN#-1)+$MATA MPY D6 IS ADDR OF ENTRY IN MAP TABLE ADA $MATA ADA D2 INDEX TO ID OF PTTN OWNER g  LDB A,I SZB IS PTTN FREE? JMP PTTNO NO, PTTN IS OCCUPIED * LDB A ADB D2 INDEX TO RESERVED FLAG LDB B,I AND PTTN SIZE WORD RBL,CLE,ERB KEEP RESERVE FLAG IN (E) ADB PT#PG CCE,SSB PTTN LARGE ENOUGH? JMP PT.SZ * PTFR LDB PTTN# RBL,ERB SET SIGN BIT FROM (E) STB PTTN# FOR PARTITION REQUESTED STA CURPT SAVE CURR PTTN OWNER PTR LDB A ADB M2 BACK UP TO LINK WORD LDB B,I SSB IS PTTN DEFINED? JMP ER.PT NO. GIVE 'PTN' ERROR * INA LDB A,I STB PTSPG SAVE PTTN START PAGE # INA LDB A,I STB PT#PG SAVE #PAGES IN PTTN JMP PTADR NOW FIND HI ADDR OF PTTN * PTTNO ADB D12 INDEX B TO ADDR OF NAME LDA ERR14 PTTN OCCUPIED JSB ERROR -PTN XXXXX- ERROR MESSAGE JMP ABORT * PTFND CLA STA PTTN# INIT PTTN# TO 0 LDA B,I GET #PTTNS CMA,INA STA TEMP NEGATE FOR PTTN SCAN LDA $MATA ADA D2 LOOK AT EACH PTTN OWNER ID * PTNX LDB A,I SZB IS PTTN FREE? JMP PTNFD NO, PTTN NOT FOUND * LDB A ADB D2 INDEX TO SIZE WORD IN MAT ENTRY LDB B,I RBL,CLE,ERB SEZ RESERVED? JMP PTNFD YES, KEEP LOOKING ADB PT#PG CLE,SSB,RSS ENOUGH PAGES IN THIS PTTN? JMP PTFR YES, USE THIS (E=0 TOO) * PTNFD ADA D6 NO, TRY NEXT ONE ISZ PTTN# BUMP PTTN# ISZ TEMP LOOKED AT ALL OF THEM YET? JMP PTNX NO, KEEP LOOKING * ER.PT LDB ERR14 NO SUCH PTTN OR NONE FREE JMP ERPR4 -PTN- ERROR AND ABORT * PT.SZ LDB ERR15 NOT ENOUGH PAGES IN PTTN JMP ERPR4 -PTSZ- ERROR AND ABORT * * PTADR LDA MPFT# SZA IS COMMON OR SSGA NEEDED? JMP USECM YES *  LDA $ENDS GET LAST PAGE OF SYSTEM ALF,ALF RAL,RAL JMP STFWA SET UP FWA FOR USER * USECM LDA RTORG ADA RTCOM ADA B1777 AND B76K * STFWA STA PAGE1 SAVE TEMPORARILY CMA,INA LOWEST POSSIBLE LOGICAL ADDR STA B LDA ABSD2 AND B76K GET START PAGE OF USER ABS ADB A SSB USER ADDR < LOWEST LOGICAL ADDR? JMP ABS14 YES "ERR MEM" * STA PTFWA SAVE FWA OF PARTITION USER STA LMAIN SAVE FOR BOUNDS CHECK LDB PT#PG #PAGES - 1 IN PARTITION BLF,BLF RBL,RBL ADB PAGE1 COMPUTE LWA PTTN OR 77777 CMA,INA ADA B JSB PGNO STA PT#PG SAVE ACTUAL #PAGES USED ADB M1 SSB ADDR > 77777? LDB C100K YES, SET LWA = 77777 STB PTLWA LWA OF PARTITION AREA STB HMAIN SAVE FOR BOUNDS CHECK LDA D2 STA LBASE SET LOW BASE ADDR FOR BOUNDS CHECK LDA BPA2 INA STA HBASE SET HI BASE ADDR FOR BOUNDS CHECK JMP ABS0 DONE WITH 1ST SPECIAL, GO READ ABS * ******* END DMS CODE *************** XIF SPC 1 * * * * * REACHED END-OF-FILE ON PROGRAM INPUT * * LOAD5 LDB ABSCT CHECK IF ANY ABS SZB,RSS WAS READ YET. JMP IDERR ERROR IF NONE. LDA WORD1 SPEC REC MUST BE AT END CPA DWRD2 WAS IT ALL THERE? JMP LOAD6 YES. IDERR LDB ERR13 NO SPECIAL RECORDS, JMP ERPR4 PRINT ERR MSG/ABORT * LOAD6 DLD NAM12 NAME GIVEN IN COMMAND? SZA,RSS JMP LOAD7 NO, USE NAME FROM SPEC REC DST PNM12 YES, USE NAME FROM COMMAND LDA NAM50 GET 5TH CHAR AND LHALF STA PNM50 JMP LOAD8 WE DID DUP.CHECK ALREADY. LOAD7 JSB DUPID NAME GIVEN IN SPECIAL RECORD, DEF PNM12 CHECK FOR DUPLICATE. * LOAD8 LDB SZCOM GET SIZE OF COMMONHFB SZB,RSS JMP LOD8A SKIP CHECK IF NO COMMON LDA FWAC GET FWA COMMON CMA SUBTR FROM ADA RTORG FWA REAL-TIME COMMON SSA,RSS FWACAVMEM? JMP LOADE YES, ERROR. * 'H* LOD8A LDA DMAIN GET FREE AREA POINTERS STA TEMP4 FOR THE MAIN AREA DLD PRGMN GET FINAL BOUNDS OF PROG JSB CKBND SEE IF FIT. (IN CASE BSS USED) JMP LOADC ERROR. * LDA DBASE GET FREE AREA POINTERS STA TEMP4 FOR THE BASE PAGE AREA DLD PRGBP GET FINAL BOUNDS OF PROG JSB CKBND SEE IF FIT. (IN CASE BSS USED) JMP LOADC ERROR. * * * * MOVE ID SEGMENT TO SYSTEM AREA * * LOD8B LDA PNM50 GET 5TH CHAR AND LHALF MASK OUT TYPE INA SET TO TYPE 1 IF MEM.RES. STA PNM50 SPC 1 IFN * BEGIN NON-DMS CODE *************** LDA MPFT# ALF,ALF PUT MPFT INDEX IN BITS 7-9 RAR FOR ID SEG WORD 22 STA MPFT *** END NON-DMS CODE *************** XIF SPC 1 IFZ ***** BEGIN DMS CODE *************** LDB FUNC CPB D1 JMP LOD8C ISZ PNM50 SET TYPE 2 IF PTTN.RES. * LDA DCRID LDB CURPT SET NEW PTTN OWNER ID JSB SYSET DEF D1 LOD8C LDA PT#PG GET #PAGES IN PTTN ALF,RAR IOR MPFT# SET MPFT INDEX IN BITS 7-9 ALF,ALF RAR IOR PTTN# SET PTTN# (BITS 0-5) AND RP (BIT 15) STA MPFT PUT WORD IN ID SEG WORD 22 ******* END DMS CODE *************** XIF SPC 1 LDB CURID INB SET UP ID SEG B-REG TO STB XB POINT TO PARAMS AREA * LDA DDMID SET UP ADDR INA FOR DATA WORDS. LDB CURID SET ADDR FOR CORE LOC. INB DON'T MOVE LINKAGE WORD JSB SYSET MOVE ID SEG DEF D27 * LDA MSG1+1 SET UP DONE STA BUF MESSAGE WITH LDA MSG1+2 PROG NAME STA BUF+1 LDA MSG1+3 STA BUF+2 LDB DWRD1+1 GET ADDR OF PROG NAME LDA LINE2 GET ADDR IN MSG FOR NAME INA JSB MVNAM MOVE NϣAME TO MSG LDA D10 STA TEMP3 JSB DSPLA DISPLAY MESSAGE JMP STOP END APLDR. * * * ERROR RETURNS FROM LOADING SECTION * ABS13 JSB REMER MEMORY ERROR JSB IHILO CLEAR HI,LO ADDR JMP ABS1 GO RE-ESTABLISH HI/LO. * ABS14 LDB ERR12 ABSLWAM JMP ERPR4 SO ABORT * LOADC LDA B,I GET NAM12 FROM ID SZA,RSS PROG REMOVED YET? JMP LOD8B YES. JSB REMER FINAL MEMORY ERROR JMP LOD8A CHECK AGAIN * LOADD LDA DBLNK NO BLANK STA MT.ID+1 ID SEG LDA A00 SET ZEROES IN MSG STA MT.ID+2 LDA D11 LDB MT.ID SET UP MESSAGE ERMPR JSB STUFP PRINT MESSAGE JMP ABORT THEN ABORT. * LOADE LDB ERR11 ABS USED TOO MUCH COMMON ERPR4 LDA D2 GET COUNT TO JMP ERMPR PRINT ERR MSG, ABORT SKP * **************************** * SUBROUTINES USED IN LOAD AND ABSOLUTE RECORD PROCESSORS * **************************** * * DUPID CHECKS FOR DUPLICATE PROGRAM NAME, ISSUES ERROR * MESSAGE AND ATTEMPTS TO CHANGE PROGRAM NAME. ABORTS IF * STILL NOT UNIQUE. * JSB DUPID * DEF PNAME * * DUPID NOP SEARCH FOR DUPLICATE LDA DUPID,I ID NAME. STA DUPNM SAVE ID NAME. ISZ DUPID DUP1 JSB STRID INIT ID SCANNER. DUP2 JSB SRCID FIND ID SEG DUPNM NOP WITH SAME NAME JMP DUPID,I NO DUPLICATE. JMP DUP2 REPEAT TIL DONE. LDA ERR02 DUPLIC. PROG ERR LDB DUPNM JSB ERROR * LDA C.. CHANGE NAME ONLY ONCE CPA DUPNM,I IF NAME ALREADY CHANGED, JMP ABORT THEN ABORT, STA DUPNM,I ELSE SEARCH AGAIN. JMP DUP1 * * **************************** * * SYSET SETS WORDS INTO CORE LOCATIONS * LDA ADDFR * LDB ADDTO * JSB SYSET * i} DEF COUNT * * SYSET NOP SYSTEM WORD SETTER. JSB $LIBR TURN OFF THE NOP INTER. SYS. STA IHILO SAVE (A) TEMPORARILY LDA SYSET,I GET ADDR OF COUNT STA SYSCT SET COUNT ADDR LDA IHILO RESTORE (A) SPC 1 IFN * BEGIN NON-DMS CODE *************** JSB .MVW STORE WORD INTO SYS. DEF SYSCT NOP *** END NON-DMS CODE *************** XIF SPC 1 IFZ ***** BEGIN DMS CODE *************** MVW SYSCT ******* END DMS CODE *************** XIF SPC 1 SYSCT EQU *-2 ISZ SYSET JSB $LIBX RESTORE INTER SYS DEF SYSET AND RETURN. * * *********************************** * * IHILO INITIALIZES DEFAULT HIGH AND LOW BOUNDS * OF FREE MEMORY. * JSB IHILO * * IHILO NOP INITIALIZE HI/LO ADDRS LDA BKLWA TO FIND HIGHEST STA HMAIN AND LOWEST LDA B1647 STA HBASE ADDRS OF UNUSED LDA RTORG CORE WHICH MAY BE STA LMAIN USED FOR LOADING LDA BPA1 STA LBASE ABS PROGRAMS CLA STA LMID STA HMID STA LBID STA HBID JMP IHILO,I RETURN * * ******************************* * * CKBND CHECKS PROGRAM BOUNDS AGAINST THAT OF FREE * CORE (TEMP4 POINTS TO FREE CORE POINTERS). * LDA PRGLO LOW ADDR OF CORE USED * LDB PRGHI HI ADDR * JSB CKBND * * * CKBND NOP CHECK BOUNDS OF PROG DST TEMP AGAINST BOUNDS OF FREE CORE DLD TEMP4,I GET LFREE CMA,INA SUBTR FROM ADA TEMP LOW ADDR SSA ADDR>=LFREE? JMP CKBND,I NO, ERROR * LDA TEMP4 ADA D2 DLD A,I GET HFREE CMA SHUBTR FROM ADA TEMP1 HI ADDR SSA ADDR<=HFREE? ISZ CKBND RETURN TO P+2 IF NO ERROR JMP CKBND,I RETURN TO P+1 IF ERROR * * ************************** * * REMER ISSUES "REM XXX" ERROR MESSAGE IF NEED TO REMOVE * A PROGRAM TO GET SPACE IN CORE, THEN SUSPENDS APLDR. * IF SPACE BELONGS TO THE SYSTEM, APLDR IS ABORTED. * LDB PNAME PROG WHICH MUST BE REMOVED * JSB REMER * * REMER NOP -REM XXXXX- ERROR SZB,RSS MEMORY ERROR. JMP ABS14 OUTSIDE AVAILABLE MEM LDA ERR01 GIVE -REM XXXXX- MESSAGE JSB ERROR JSB EXEC CALL EXEC DEF *+2 TO SUSPEND DEF D7 THE APLDR. JMP REMER,I RETURN * * ****************************** * * MD28 DEC -28 * B17 OCT 17 B1647 OCT 1647 * * D24 DEC 24 D27 DEC 27 D64 DEC 64 * BPMSK OCT 1777 C.. ASC 1,.. NAME CHANGE CHAR. * HI2 OCT 1000 ABSSZ NOP CURID NOP IDOFS NOP WORD1 NOP WORD2 NOP * * DO NOT CHANGE ORDER OF FOLLOWING * LMAIN NOP LMID NOP HMAIN NOP HMID NOP LBASE NOP LBID NOP HBASE NOP HBID NOP DMAIN DEF LMAIN ADDR OF HI/LO ADDR FOR MAIN DBASE DEF LBASE ADDR OF HI/LO ADDR FOR BASE PAGE * * DWRD2 DEF DWR2,I DWRD1 DEF *+1,I DUMMY ID ADDRESSES DEF PNM12 NAM12 DEF PNM50 NAM50/TYPE DEF RESML RESOL/MULT DEF HTIME HIGH BITS OF TIME DEF SPAR2 - SPARE - DEF PRGMN LOW MAIN DEF PRGBP LOW BASE DEF FWAC FWA COMMON DEF JMPXF JMP XFER * DWR2 DEF PNM34 NAM34 DEF PRIOR PR DEF SPAR1 - SPARE - DEF LTIME LOW BITS OF TIME DEF SEGMX SEGMX DEF PRGM2 HMAIN DEF PRGD2 HBASE DEF SZCOM SIZE COMMON DEF XFER XFER ADDR * HED PL: PROGRAM LIST * LIST PROGRAMS. * LIST LDA $CON,I AND B77 GET DEFAULT CONSOLE LU LDB LU GET LU PARAM. SZB,RSS IF ZERO, STA LU USE DEFAULT CONSOLE * SPC 1 IFZ ***** BEGIN DMS CODE *************** LDA PGPT SZA LIST PARTITIONS OPTION CHOSEN? JMP PTLST YES ******* END DMS CODE *************** XIF SPC 1 JSB SPACE PRINT LDA D19 HEADING. LDB HEAD1 JSB PRINT JSB SPACE * LDA DBLNK SET UP OUTPUT BUFFER. STA BUF STA BUF+7 * CLA CLEAR OUT BLANK ID SEG. STA TEMP5 COUNTER. * JSB STRID INIT ID SCANNER. LIST2 JSB SRCID SEARCH ID SEGS DEF ZERO JMP LIST7 EOF JMP LIST3 NON BLANK ID SEG ISZ TEMP5 BLANK ID SEG JMP LIST2 GO SEE NEXT ONE. * LIST3 STB TEMP1 SAVE NAME ADDR STA TEMP SAVE ID ADDR LDA LINE PUT PROG NAME INA INTO LINE JSB MVNAM * LDB TEMP ADB D6 GET PRIORITY LDA B,I WORD LDB .PR JSB CVDEC CONVERT AND STUFF * LDB TEMP ADB D22 GET PROG ADDRS. STB TEMP LDA M2 SET -2 TO GET STA TEMP4 MAIN AND BASE PAGE. LDB LINE INITIALIZE ADDR ADB D7 FOR NUMBER STUFFING. LIST4 LDA TEMP,I GET LOW ADDR. JSB CVOCT CONVERT TO ASCII. ISZ TEMP LDA TEMP,I GET HIGH ADDR. ADA M1 -1 TO GET REAL HIGH ADDR JSB CVOCT CONVERT TO ASCII. * ISZ TEMP ISZ TEMP4 JMP LIST4 GO GET NEXT PAIR OF ADDRS. * LDA D19 LDB LINE JSB PRINT PRINT PROG INFO. * JMP LIST2 GO GET NEXT ID SEG. * LIST7 LDA TEMP5 GET # OF BLANK ID SEGS LDB DNM12 JSB CVDEC CONVERT AND STUFF INTO DUMMY PLACE LDA NAM50 PICK UP JUST 2 DIGITS  STA MT.ID+2 AND MOVE TO MESSAGE LDA D11 LDB MT.ID JSB PRINT PRINT "# BLANK ID SEGMENTS" * DONE LDA D2 PRINT "DONE" LDB MSG1 AFTER THE "APLDR:" JMP STOP1 * ABORT LDA D4 PRINT "ABORTED" LDB ERR99 AFTER THE "APLDR:" STOP1 JSB STUFP STOP JSB CLOSE CLOSE INPUT FILE IF ANY DEF *+3 DEF IDCB1 DEF ERR JSB EXEC CALL EXEC DEF *+2 TO END DEF D6 APLDR. * SPC 1 IFZ ***** BEGIN DMS CODE *************** HED PL: PARTITION LIST PTLST JSB SPACE PRINT HEADING FOR PTTN LIST LDA D16 LDB PTHED JSB PRINT JSB SPACE LDA DBLNK STA BUF+12 * CLA,INA STA PTTN# INITIALIZE FOR PTTN SCAN LDA $MATA STA CURPT SAVE ADDR OF CURR MAT ENTRY ADA M1 GET # PTTNS LDA A,I SZA,RSS CHECK - JUST IN CASE ...! JMP DONE MPY D6 ADA $MATA STA PTLWA SAVE ADDR OF LAST ENTRY * PNXPT LDA PTTN# LDB .PTN# CONVERT PTTN# AND PUT IN BUFFER JSB CVDEC LDA CURPT,I GET LINK OF MAT ENTRY SSA,RSS IS PTTN DEFINED? JMP CKRES YES, CHECK RESERVE STATUS * LDA PUNDF LDB .PTNS MVW D6 MOVE 'NOT DEFINED' MESSAGE LDA D9 JMP PRPTL AND THEN GO ON TO NEXT * CKRES LDB CURPT ADB D4 CALC ADDR OF RESERVE/SIZE WORD LDA B,I CLE,ELA (E) = RESERVE STATUS RAR AND B1777 KEEP 10 BITS #PAGES STA PT#PG LDB DBLNK USE ' ' SEZ OR LDB ASCR ' R' IF RESERVED STB PADDR INA ADD 1 TO #PAGES FOR B.P. LDB .PTNS JSB CVDEC CONVERT PTTN SIZE * LDA PADDR STA BUF+3 SET RESERVE STATUS * LDB CURPT ADB D3 ADDR OF START PAGE LDA B,I  AND B1777 PAGE # IN LOW 10 BITS STA PAGE1 LDB .PTNF CONVERT FIRST PAGE# JSB CVDEC AND PUT IN MESSAGE * LDA PAGE1 ADA PT#PG LDB .PTNL CONVERT LAST PAGE# JSB CVDEC LDA DASH STA BUF+9 * LDB CURPT ADB D2 INDEX TO OWNER ID SEG LDB B,I SZB,RSS EMPTY? JMP PTEMT YES * ADB D12 NO, INDEX TO NAME LDA .PTNP JSB MVNAM MOVE PROGRAM NAME PRPTN LDA D16 PRPTL LDB LINE JSB PRINT PRINT THE INFO ABOUT THIS PTTN * ISZ PTTN# LDA CURPT ADA D6 INDEX TO NEXT MAT ENTRY STA CURPT CPA PTLWA LAST ONE? JMP DONE YES, DONE JMP PNXPT NO, DUMP INFO ON NEXT PTTN * PTEMT LDA PTNON LDB .PTNP NO PROGRAM IN PTTN MVW D3 JMP PRPTN * D16 DEC 16 DASH ASC 1, - ******* END DMS CODE *************** XIF SPC 1 * HED SUBROUTINES FOR APLDR. * * ***************************** * * SPACE PRINTS A BLANK LINE ON LIST DEVICE. * JSB SPACE * * SPACE NOP PRINT BLANK CLA,INA LINE. LDB DFBLK (B)=ADDR OF BLANK JSB PRINT JMP SPACE,I * * ***************************** * * PRINT PRINTS A LINE ON LIST DEVICE. * LDA WORDS NO. OF WORDS * LDB ADDR ADDR OF TEXT * JSB PRINT * * PRINT NOP STA TEMP1 STB MADDR JSB EXEC CALL EXEC DEF *+5 TO PRINT DEF D2 ON LIST DEVICE DEF LU MADDR NOP DEF TEMP1 JMP PRINT,I * * ******************************** * * STUFP STUFFS A MESSAGE WITH THE IDENTIFIER "APLDR:" AND * PRINTS IT ON CONSOLE. * LDA WORDS * LDB ADDR * JSB STUFP * * STUFBP NOP STUFF MESSAGE INTO STB TEMP SPECIAL IDENTIFIER LDB D4 ADD 4 TO ADB A MESSAGE LENGTH STB TEMP3 FOR TOTAL LENGTH CMA,INA STA TEMP2 NEGATIVE COUNT. LDB MSG0 STFLP LDA TEMP,I STA B,I INB ISZ TEMP ISZ TEMP2 JMP STFLP JSB DSPLA DISPLAY MESSAGE JMP STUFP,I RETURN * * ****************************** * * DSPLA PRINTS A MESSAGE ON THE CONSOLE. THE MESSAGE * ADDRESS IS IN MSG AND THE WORD LENGTH IS IN TEMP3. * JSB DSPLA * * DSPLA NOP JSB IMESS DEF *+4 DEF D2 WRITE DEF MSG MESSAGE ON DEF TEMP3 OPERATOR CONSOLE. JMP DSPLA,I RETURN * * ****************************** * * MVNAM MOVES A PROGRAM NAME (3 WORDS) AND FILLS AN * ASCII BLANK IN THE DESTINATION NAME. * LDA DEST ADDR OF DESTINATION FOR NAME * LDB SORC ADDR OF SOURCE NAME * JSB MVNAM * * MVNAM NOP MOVE PROG NAME STA TEMP4 TO GIVEN DESTINATION LDA B,I STA TEMP4,I MOVE CHAR1,2 ISZ TEMP4 INB LDA B,I STA TEMP4,I MOVE CHAR3,4 ISZ TEMP4 INB LDA B,I AND LHALF PUT ASCII BLANK IOR B40 IN CHAR6 STA TEMP4,I THEN MOVE JMP MVNAM,I RETURN * * ******************************* * * ERROR PUTS A PROGRAM NAME INTO AN ERROR MESSAGE * THEN PRINTS IT ON THE CONSOLE. * LDA ERRAD ADDR OF ERROR MESSAGE * LDB PNAME ADDR OF PROGRAM NAME * JSB ERROR * * ERROR NOP PUT NAME INTO STB TEMP5 ERR MSG THEN DLD A,I PRINT IT DST BUF MOVE ERR MSG TO OUTPUT AREA LDB TEMP5 GET ADDR OF NAME LDA LINE2 TO PUT INTO MSGZ JSB MVNAM LDA D9 STA TEMP3 SET LENGTH FOR JSB DSPLA DISPLAY JMP ERROR,I RETURN * * ***************************** * * STRID INITIALIZES ID SEGMENT SEARCH ROUTINE. * * STRID NOP INITIALIZE ID SCANNER. LDA KEYWD GET KEYWORD ADDRESS STA ADRID STORE AS ID ADDRESS. JMP STRID,I RETURN * * ***************************** * * SRCID FETCHS AN ID SEGMENT AND SEES IF MATCH/NO MATCH/BLANK. * JSB SRCID * DEF PNAME ADDR OF NAME TO SEARCH FOR * * * * A CONTAINS ADDR OF ID SEGMENT * B CONTAINS ADDR OF NAME IN ID SEGMENT * SRCID NOP SEARCH ID SEGMENTS LDA SRCID,I FOR A CERTAIN NAME. STA TEMP1 SAVE ADDR OF NAME ISZ SRCID SET RETURN AT P+2 LDB ADRID,I PICK UP AN ID ADDR SZB,RSS IS IT END OF ID SEGS? JMP EOFID YES ADB D12 BUMP TO NAME IN ID STB TEMP2 SAVE ADDR OF NAME LDA B,I CPA TEMP1,I CHECK NAME 1,2 INB,RSS MATCHES. JMP NOMAT NO MATCH. ISZ TEMP1 LDA B,I CPA TEMP1,I CHECK NAME 3,4 INB,RSS MATCHES. JMP NOMAT NO MATCH. ISZ TEMP1 LDA B,I AND LHALF STA STRID SAVE TEMPORARILY LDA TEMP1,I AND LHALF CPA STRID COMPARE NAME 5 ISZ SRCID MATCHES, SET RETURN P+4 * NOMAT ISZ SRCID NO MATCH, RETURN P+3 LDA ADRID,I READY FOR RETURN. ISZ ADRID LDB TEMP2 EOFID JMP SRCID,I RETURN. * * ***************************** * SUBROUTINE: CVOCT (CONVERT 15-BIT BINARY NUMBER * TO 6-CHAR (LEADING BLANK) ASCII FORM OF OCTAL NUMBER * CALLING SEQUENCE: * (A)-BINARY VALUE FOR CONVERSION * (B)-ADDRESS OF 3-WORD AREA FOR * STORING ASCII/OCTAL CHARACTERS * (P) JSB CVOCT * (P+1) (RETURN): * (A) DESTROYED. * (B) ADDRESS OF NEXT STORAGE * CVOCT NOP CLE (E) = 0 FOR OCTAL JSB CVT CALL CONVERSION AND STUFF ASCII JMP CVOCT,I RETURN * * SUBROUTINE: CVDEC CONVERTS BINARY TO DECIMAL ASCII * CALLING SEQUENCE: SAME AS CVOCT * * CVDEC NOP CCE (E) = 1 FOR DECIMAL CONVERSION JSB CVT CONVERT AND STUFF ASCII JMP CVDEC,I RETURN * * CVT NOP JSB $LIBR GO PRIVILEGED NOP STB ADDR SAVE ADDR JSB $CVT3 CALL SYSTEM'S ROUTINE LDB A,I RETURNS WITH (A)=ADDR OF ASCII STB ADDR,I SO MOVE ASCII ISZ ADDR INA LDB A,I STB ADDR,I ISZ ADDR INA LDB A,I STB ADDR,I LDB ADDR INB SET (B) TO NEXT STORAGE LOCATION JSB $LIBX RETURN DEF CVT * ADDR NOP SKP * CONSTANTS AND STORAGE. * UNS M2 OCT -2 M1 OCT -1 * D1 OCT 1 D2 OCT 2 D4 OCT 4 D6 OCT 6 D7 OCT 7 B40 OCT 40 * D9 DEC 9 D10 DEC 10 D11 DEC 11 D12 DEC 12 D19 DEC 19 D22 DEC 22 * A00 ASC 1,00 LHALF OCT 177400 ZERO OCT 0,0,0 OPT OCT 2300 ADRID NOP LU NOP ERR NOP MPFT# NOP MEMORY PROTECT FENCE INDEX VALUE * TEMP NOP TEMP1 NOP TEMP2 NOP TEMP3 NOP TEMP4 NOP TEMP5 NOP LEN NOP * ERLUF NOP 5-WORD TABLE. PGPT NOP DO NOT RE-ARRANGE! NAM12 NOP NAM34 NOP NAM50 NOP * SKP * MESSAGES FROM APLDR WITH LOVE. * * ERR01 DEF *+1 REMOVE PROGRAM TO BE OVERLAYED ASC 2,REM * ERR02 DEF *+1 DUPLICATE PROGRAM NAME ASC 2,DUP * ERR10 DEF *+1 CHECKSUM ERROR ASC 2,CKSM * ERR11 DEF *+1 COMMON AREA OVERFLOW ASC 2,COM * ERR12 DEF *+1 MEMORY OVERFLOB@ PTHED DEF *+1 ASC 16, PTN# R SIZE PAGES PROGRAM ASCR EQU PTHED+4 .PTN# DEF BUF .PTNS DEF BUF+3 .PTNF DEF BUF+6 .PTNL DEF BUF+9 .PTNP DEF BUF+13 ******* END DMS CODE *************** XIF SPC 1 .PR DEF BUF+4 * DABSD DEF ABSBF+2 DDMID DEF DMYID LINE DEF MSG+4 LINE2 DEF MSG+6 MSG0 EQU LINE * MSG ASC 9, APLDR: BUF EQU MSG+4 * ABSBF BSS 64 * ABSCT EQU ABSBF ABSAD EQU ABSBF+1 ABSD1 EQU ABSBF+2 ABSD2 EQU ABSBF+3 * DMYID EQU ABSBF+35 SPAR2 EQU DMYID-5 JMPXF EQU DMYID-4 SPAR1 EQU DMYID-3 FWAC EQU DMYID-2 SZCOM EQU DMYID-1 PRIOR EQU DMYID+6 XFER EQU DMYID+7 XB EQU DMYID+10 PNM12 EQU DMYID+12 PNM34 EQU DMYID+13 PNM50 EQU DMYID+14 RESML EQU DMYID+17 HTIME EQU DMYID+18 LTIME EQU DMYID+19 FATHR EQU DMYID+20 MPFT EQU DMYID+21 PRGMN EQU DMYID+22 PRGM2 EQU DMYID+23 PRGBP EQU DMYID+24 PRGD2 EQU DMYID+25 SEGMX EQU DMYID+26 SPARX EQU DMYID+27 * * BSS 0 SIZE OF APLDR * * END APLDR DB  92064-18028 1650 S C0122 &SGPRP SEGMENT PREPARATION             H0101 &ASMB,R,L,C RTE-M SEGMENTED PROGRAM PREPARATION PROGRAM * * NAME: RTE-M SGPRP * SOURCE: 92064-18028 * RELOC: 92064-16034 * PROGMR: E.J.W. * * **************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT * * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * **************************************************************** * * NAM SGPRP,3,90 92064-16034 REV.1650 761020 EXT $LIBR,$LIBX,EXEC,$CVT1,$CVT3,$PARS,$CON EXT OPEN,READF,WRITF,CLOSE,POSNT,IDCB1,IDCB2 * A EQU 0 B EQU 1 * * SGPRP NOP LDA B,I SZA LU = 0? JMP MAGLU YES, SET UP DEFAULT * LDA $CON,I GET DEFAULT LU AND B77 * MAGLU JSB $LIBR CONVERT LU TO MAGIC FILENAME NOP CCE (E) = 1 FOR DECIMAL JSB $CVT1 JSB $LIBX DEF *+1 DEF *+1 IOR A00 FORCE LEADING ZERO IN ASCII STA MAGIC+2 SAVE ASCII CHARACTERS * JSB OPEN OPEN THE INTERACTIVE LU 'FILE' DEF *+5 DEF IDCB1 DEF ERR DEF MAGIC IGNORE ERRORS ON THIS FILE DEF ECHO * JSB WRITF WRITE "SGPRP STARTED" DEF *+5 ON INTERACTIVE LU DEF IDCB1 NO ERROR CHECKS ON THIS FILE DEF ERR DEF MESS1 DEF D7 * JSB WRITF PROMPT "MAIN PROGRAM NAME?" DEF *+5 DEF IDCB1 DEF ERR DEF ASKMP DEF D10 * JSB READF READ FILE NAME OF MAIN DEF *+6 AND SAVE FOR MUCH LATER. DEF IDCB1 DEF ERR DMBUF DEF MBUF DEF MD20 DEF MLEN * CLA CLEAR OUT WORDS TO SAVE STA HMAIN HIGHEST MAIN AND HIGHEST BASE PAGE STA HBASE LOCATaiIONS USED BY ANY SEGMENT * NXSEG JSB WRITF PROMPT "/E OR SEGMENT NAME?" DEF *+5 DEF IDCB1 DEF ERR DEF ASKSG DEF MD21 * JSB READF READ SEGMENT NAME DEF *+6 DEF IDCB1 DEF ERR DIBUF DEF IBUF DEF MD20 DEF LEN * LDA DIBUF (A)=INPUT STRING ADDR LDB LEN (B)=CHARACTER LENGTH OF INPUT STRING JSB PARSE PARSE INTO FNAME, SC, AND CR COMPONENTS LDA FNAME CPA /E NO MORE SEGMENTS? JMP UPDAT RIGHT, GO UPDATE MAIN'S BOUNDS * JSB OPEN OPEN SEGMENT FILE (ABSOLUTE) DEF *+7 DEF IDCB2 DEF ERR DEF FNAME DEF ABS DEF SC DEF CR SSA JMP FMPER * CLA INITIALIZE SPECIAL RECORD COUNT STA SRECN TO COUNT TIE-OFF RECORDS * NXREC JSB READF READ AN ABSOLUTE RECORD DEF *+6 INTO ABUF DEF IDCB2 DEF ERR DEF ABUF DEF D128 DEF LEN SSA JMP FMPER * CCA END-OF-FILE? CPA LEN JMP SGEOF YES, * JSB ABSCK PERFORM CHECKSUM CHECK LDA ABSAD COULD IT BE SPECIAL RECORD? CPA D2 IE., ADDR=2? RSS JMP NXREC NO, TRY NEXT RECORD * LDA LEN IT MIGHT BE SPECIAL RECORD CPA D5 SO CHECK ABSOLUTE RECORD LENGTH RSS JMP NXREC NOT SPECIAL RECORD. * ISZ SRECN IT IS A SPECIAL RECORD. LDA SRECN CPA D7 IS IT PROG'S MAIN ADDR BOUNDS? JMP SGMAN YES, SEE IF THESE ARE THE HIGHEST. * CPA D8 IS IT PROG'S BASE PAGE ADDR BOUNDS? JMP SGBAS YES, SEE IF THESE ARE THE HIGHEST. JMP NXREC * SGMAN LDA WORD2 GET HIGH ADDR BOUND STA B CMA,INA ADA HMAIN IS CURRENT SEGMENT HIGH ADDR SSA HIGHER THAN PREVIOUS HIGH? STB HMAIN YESƎ, SAVE NEW HIGH JMP NXREC * SGBAS LDA WORD2 GET HIGH BASE PAGE BOUND STA B CMA,INA ADA HBASE IS CURRENT SEGMENT HIGH BASE ADDR SSA HIGHER THAN PREVIOUS HIGH? STB HBASE YES, SAVE NEW HIGH BASE * SGEOF JSB CLOSE DONE NOW. SO, CLOSE FILE DEF *+3 DEF IDCB2 DEF ERR JMP NXSEG DONE WITH THIS SEGMENT, MORE SEGMENTS? * UPDAT LDA DMBUF GET ORIGINAL INPUT STRING LDB MLEN FOR MAIN PROGRAM FILE NAME JSB PARSE AND PARSE INTO FNAME,SC,CR COMPONENTS * JSB OPEN OPEN THE MAIN PROGRAM FILE DEF *+7 DEF IDCB2 DEF ERR DEF FNAME DEF UPDTA UPDATE ABSOLUTE DEF SC DEF CR SSA JMP FMPER * CLA STA SRECN INIT SPECIAL RECORD COUNT * NXMRC JSB READF DEF *+6 DEF IDCB2 DEF ERR DEF ABUF DEF D128 DEF LEN SSA JMP FMPER * CCA CPA LEN END-OF-FILE? JMP MNEOF YES * JSB ABSCK PERFORM CHECKSUM CHECK LDA ABSAD IS IT SPECIAL RECORD CPA D2 ORIGINED AT 2? RSS MAYBE JMP NXMRC DEFINITELY NO. * LDA LEN CPA D5 IS IT THE RIGHT SIZE (5 WORDS)? RSS YES JMP NXMRC NO * ISZ SRECN LDA SRECN CPA D7 IS IT MAIN'S MAIN ADDR BOUNDS? JMP MNMAN YES * CPA D8 IS IT MAIN'S BASE PAGE ADDR BOUNDS? JMP MNBAS YES JMP NXMRC * MNMAN LDA HMAIN SET UP NEW HIGH MAIN SZA,RSS ANY CHANGE? JMP NXMRC NO, IGNORE STA WORD2 ADA WORD1 AND COMPUTE NEW CHECKSUM ADA ABSAD STA CKSUM * JSB POSNT BACK UP ONE RECORD DEF *+4 DEF IDCB2 DEF ERR DEF MD1 SSA JMP FMPER * JSB WRITF REWRITE RECORDgK DEF *+5 DEF IDCB2 DEF ERR DEF ABUF DEF LEN SSA JMP FMPER JMP NXMRC * MNBAS LDA HBASE FIX UP HIGH BASE PAGE WORD SZA,RSS ANY CHANGE? JMP MNEOF NO, IGNORE STA WORD2 AND RECOMPUTE THE CHECKSUM ADA WORD1 ADA ABSAD STA CKSUM * JSB POSNT BACK UP ONE RECORD DEF *+4 DEF IDCB2 DEF ERR DEF MD1 * JSB WRITF REWRITE RECORD IN MAIN FILE DEF *+5 DEF IDCB2 DEF ERR DEF ABUF DEF LEN SSA JMP FMPER * MNEOF JSB WRITF WRITE "SGPRP DONE" DEF *+5 DEF IDCB1 DEF ERR DEF MESS2 DEF D5 * EXIT JSB CLOSE CLOSE ALL FILES BEFORE TERMINATING DEF *+3 DEF IDCB2 DEF ERR IGNORE ERROR RETURNS JSB CLOSE CLOSE INTERACTIVE LU FILE TOO DEF *+3 DEF IDCB1 DEF ERR * JSB EXEC ALL DONE! DEF *+2 DEF D6 * * PARSE NOP JSB $LIBR NOP JSB $PARS DEF PBUF JSB $LIBX DEF PARSE * ABSCK NOP ROUTINE FOR CHECKSUM VERIFY LDA ABSCT IF BAD CHECKSUM THEN AND LHALF EXIT VIA 'FMP ERROR' ALF,ALF SHIFT WORD COUNT TO LOW BITS CMA,INA STA ERR SAVE NEGATIVE COUNT LDB ABSAD GET ADDR, START CKSM LDA DABSD STA TEMP2 SET DATA ADDR * ABSC2 LDA TEMP2,I GET A WORD ADB A AND ADD TO CKSM ISZ TEMP2 BUMP TO NEXT WORD ISZ ERR BUMP COUNT JMP ABSC2 REPEAT TILL DONE * LDA TEMP2,I CPA B COMPARE CHECKSUMS JMP ABSCK,I MATCH, SO RETURN. * LDA D7 ERROR, SO FALL THROUGH 'FMP ERROR 007' * FMPER LDB PLUS SSA IF NEGATIVE NUMBER LDB MINUS GET ASCII "-" STB SIGN SSA CMA,INA MAKE ERROR CODE POSITIVE JSB $LIBR BEFORE CONVERTING TO ASCII NOP FOR ERROR MESSAGE CCE (E)=1 FOR DECIMAL CONVERSION JSB $CVT3 JSB $LIBX DEF *+1 DEF *+1 INA DLD A,I GET LAST 4 DIGITS OF ERROR CODE DST ERMNO INTO ERROR MESSAGE DLD FNAME MOVE CURRENT FILENAME DST ERMNM INTO ERROR MESSAGE LDA FNAME+2 STA ERMNM+2 JSB WRITF WRITE ERROR MESSAGE DEF *+5 DEF IDCB1 DEF ERR DEF ERMSG DEF D12 JMP EXIT * * * * MESS1 ASC 7,SGPRP STARTED MESS2 ASC 5,SGPRP DONE ASKMP ASC 10,MAIN PROGRAM NAME? _ ASKSG ASC 11,/E OR SEGMENT NAME? __ ERMSG ASC 12, FMP ERROR -#### FNAMEX SIGN EQU ERMSG+5 ERMNO EQU ERMSG+6 ERMNM EQU ERMSG+9 MINUS ASC 1, - PLUS ASC 1, DABSD DEF WORD1 LHALF OCT 177400 MAGIC ASC 3,LU..01 ECHO OCT 410 /E ASC 1,/E ABS OCT 2310 UPDTA OCT 2312 LEN NOP ERR NOP SRECN NOP TEMP2 NOP * A00 ASC 1,00 B77 OCT 77 D2 DEC 2 D5 DEC 5 D6 DEC 6 D7 DEC 7 D8 DEC 8 D10 DEC 10 D12 DEC 12 D128 DEC 128 MD1 DEC -1 MD20 DEC -20 MD21 DEC -21 * HMAIN NOP HBASE NOP MLEN NOP MBUF BSS 10 IBUF BSS 10 ABUF BSS 128 ABSCT EQU ABUF ABSAD EQU ABUF+1 WORD1 EQU ABUF+2 WORD2 EQU ABUF+3 CKSUM EQU ABUF+4 PBUF BSS 33 FNAME EQU PBUF+1 SC EQU PBUF+5 CR EQU PBUF+9 * * BSS 0 SIZE OF MODULE END SGPRP    92064-18029 1650 S C0122 &MDTI RTE-M DUMMY MTI             H0101 ?ASMB,R,L ** RTE-M DUMMY TIME MODULE ** * NAME : $MDTI * SOURCE: 92064-18029 * RELOC: PART OF 92064-16013 * PROGMR: E.J.W. * * **************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT * * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * **************************************************************** * * NAM $MDTI,0 92064-16013 REV.1650 761020 * ENT $CLCK,$TIME,$TIMV,$SCLK,$MPT6 EXT $XEQ,$SYMG,$DLFL,$DEVT A EQU 0 * $TIME OCT 16000 OCT 177650 OCT 3573 * $CLCK NOP LDA $DLFL CMA,INA,SZA,RSS ANY DELAYED I/O INITIATIONS? JMP $CLCK,I NO, SO RETURN TO $IRT * CMA YES, SUBTRACT 1 FROM COUNT STA $DLFL * LDA EQT# CMA,INA STA $TIMV SAVE NEG COUNT OF EQTS LDA EQTA INA GET ADDR OF EQT WORD 2 * IOTO2 LDB A,I GET EQT WORD 2 SSB DELAYED I/O INITIATION FLAG SET? JMP DLYIO YES, PRETEND TIME-OUT HAPPENED * ADA D15 NO, BUMP ADDR TO NEXT EQT ISZ $TIMV DONE YET? JMP IOTO2 NO HLT 3 NEVER GET HERE, UNLESS $DLFL WRONG. * DLYIO ADA D13 GET READY FOR FAKE TIME-OUT JMP $DEVT * $TIMV NOP JMP *-1,I * $SCLK NOP CLA DUMMY MESSAGE WHEN NO TIMER STA TBG INSURE NO INTERRUPTS LDA DMESG NEED TO PRINT TO ENABLE TERMINAL JSB $SYMG NEED TO INITIALIZE MIO MODULE JMP $XEQ * $MPT6 LDA RQRTN STA XSUSP,I JMP $XEQ * DMESG DEF *+1 DEC -2 OCT 6412 D13 DEC 13 D15 DEC 15 EQTA EQU 1650B EQT# EQU 1651B TBG EQU 1674B RQRTN EQU 1677B XSUSP EQU 1730B END     92064-18030 1740 S C0122 &MDTS RTE-M DUMMY MTS MODULE             H0101 dASMB,R,L,C ** RTE-M DUMMY TIME MODULE ** * NAME : $MDTS * SOURCE: 92064-18030 * RELOC: PART OF 92064-16013 * PROGMR: E.J.W. * * **************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT * * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * **************************************************************** * * NAM $MDTS,0 92064-16013 REV.1740 770812 * ENT $TADD,$TREM,$TLST,$ETTM,$TIMR ENT $ITRQ,$TMRQ,$ONTM,$TIRQ,$CHTO,$STRQ EXT $MSEX,$MSBF,$LIST,$NOOP,$ERMG,$XEQ * $TADD EQU * $TREM EQU * $ETTM EQU * $TLST EQU * NOP JMP *-1,I * $TIMR LDA ARQ LDB ABLNK JSB $ERMG JMP $XEQ * ARQ ASC 1,RQ ABLNK ASC 1, $ITRQ EQU * $TIRQ EQU * $TMRQ EQU * $CHTO EQU * LDA $NOOP JMP $MSEX * $ONTM JSB $LIST SCHEDULE PROG OCT 301 JMP $MSEX * $STRQ LDA BUFAD JMP $MSEX BUFAD DEF $MSBF * ORG * PROGRAM LENGTH END j  92064-18031 1650 S C0122 &MDOP RTE-M DUMMY MOP             H0101 6ASMB,R,L * NAME : $MDOP * SOURCE: 92064-18031 * RELOC: PART OF 92064-16013 * PROGMR: E.J.W. * * **************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT * * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * **************************************************************** * * NAM $MDOP,0 92064-16013 REV.1650 761020 ENT $LUPR,$EQST,$BLRQ,$PRRQ EXT $MSEX,$NOOP * $LUPR EQU * $EQST EQU * $BLRQ EQU * $PRRQ EQU * LDA $NOOP JMP $MSEX END   92064-18032 1650 S C0122 &MDMI RTE-M DUMMY MMI             H0101 2ASMB,R,L * NAME : $MDMI * SOURCE: 92064-18032 * RELOC: PART OF 92064-16013 * PROGMR: E.J.W. * * **************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT * * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * **************************************************************** * * NAM $MDMI,0 92064-16032 REV.1650 761020 ENT $MIC $MIC NOP END j  92064-18033 1650 S C0122 &MDCL RTE-M DUMMY MCL             H0101 ASMB,R,L * NAME : $MDCL * SOURCE: 92064-18033 * RELOC: PART OF 92064-16013 * PROGMR: E.J.W. * * **************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT * * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * **************************************************************** * * NAM $MDCL,0 92064-16013 REV.1650 761020 ENT $S.CL,$I.CL,$C.CL,$G.CL * $S.CL EQU * $I.CL EQU * $C.CL EQU * $G.CL NOP JMP *-1,I * END L  92064-18034 1650 S C0122 &MDRN RTE-M DUMMY MRN             H0101 <ASMB,R,L * NAME : $MDRN * SOURCE: 92064-18034 * RELOC: PART OF 92064-16013 * PROGMR: E.J.W. * * **************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT * * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * **************************************************************** * * NAM $MDRN,0 92064-16013 REV.1650 761020 ENT $CGRN,$TRRN EXT $SCLK * $TRRN NOP JMP *-1,I $CGRN JMP $SCLK GO START CLOCK JMP *-1,I * END V  92064-18035 1650 S C0122 &MDBU RTE-M DUMMY MBU             H0101 ASMB,R,L * NAME : $MDBU * SOURCE: 92064-18035 * RELOC: PART OF 92064-16013 * PROGMR: E.J.W. * * **************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT * * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * **************************************************************** * * NAM $MDBU,0 92064-16013 REV.1650 761020 ENT $QCHK,$ALC,$RTN EXT $WORK * $ALC JMP $WORK DO NOTHING ON INITIALIZATION ISZ $ALC CCA (A) = -1 FOR NO MEMORY EVER CLB (B) = 0 FOR MAXIMUM MEMORY = 0 JMP $ALC,I RETURN * $RTN NOP DO NOTHING ON MEMORY BLOCK RETURN ISZ $RTN ISZ $RTN JMP $RTN,I RETURN * $QCHK NOP ISZ $QCHK NO OVERFLOW, RETURN OK JMP $QCHK,I RETURN * BSS 0 SIZE OF MODULE END   92064-18036 1650 S C0122 &MDMP RTE-M DUMMY MMP             H0101 2ASMB,R,L,C * NAME : $MDMP * SOURCE: 92064-18036 * RELOC: PART OF 92064-16013 * PROGMR: E.J.W. * * **************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT * * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * **************************************************************** * * NAM $MDMP,0 92064-16013 REV.1650 761020 ENT $SABR,$MPT1,$MPT4,$MPT5,$MPT7 EXT $TREM,$WORK,$XEQ,$LIST,$ERMG,$ABRT,$IOCL * A EQU 0 B EQU 1 * $SABR NOP STB TEMPH SAVE ID SEG ADDR ADB D16 INDEX TO TIME-LIST WORD JSB $TREM REMOVE FROM TIME-LIST LDB TEMPH JSB TERM TERMINATE PROG JMP $SABR,I RETURN * TERM NOP JSB $LIST MOVE PROG TO DORMANT STATE OCT 400 LDB $WORK ADB D20 INDEX TO FATHER WORD LDA B,I AND B7400 KEEP ONLY RE,RM,RN FLAGS STA B,I JMP TERM,I RETURN * * $MPT1 CLA EXEC (6) TERMINATION LDA RQP2,I SZA OPTION WORD = 0? JMP ERQ1 NO, ERROR 'RQ' * LDB XEQT (B) = ID SEG ADDR LDA RQRTN STA XSUSP,I SET RETURN ADDR CLA IN CASE RQP3 NOT GIVEN. LDA RQP3,I ADA M2 SSA OPTION < 2 ? JMP MPT1B YES, TREAT AS NORMAL * CMA,INA,SZA,RSS JMP SOFT (2) SOFT ABORT * INA,SZA,RSS JMP HARD (3) HARD ABORT * MPT1B JSB TERM DO TERMINATE STUFF JMP $XEQ RETURN TO DISPATCHER * SOFT JSB $SABR DO SOFT ABORT JMP $XEQ RETURN TO DISPATCHER * HARD LDA D15 (B) STILL HAS ID SEG ADDR ADA B INDEX TO STATUS WORD LDA A,I AND D15 JUST KEEP STATUS P&  ART STA B LDA XEQT CPB D2 I/O SUSPENDED? JMP $IOCL YES, KILL I/O * JSB $ABRT FINISH THE ABORT JMP $XEQ RETURN TO DISPATCHER * SPC 4 $MPT4 EQU * DUMMY ENTRY $MPT5 EQU * DUMMY ENTRY $MPT7 EQU * DUMMY ENTRY ERQ1 LDA RQ1 NONE OF ABOVE LDB BLANK JSB $ERMG JMP $XEQ * RQ1 ASC 1,RQ BLANK ASC 1, D2 DEC 2 D15 DEC 15 D16 DEC 16 D20 DEC 20 TEMPH NOP B7400 OCT 7400 M2 DEC -2 * RQRTN EQU 1677B RQP2 EQU 1701B RQP3 EQU 1702B XEQT EQU 1717B XSUSP EQU 1730B * ORG * SIZE OF MODULE * END $   92064-18040 1650 S C0222 &FMGC0 CRTG FMGR MAIN             H0102 \ASMB,R,L,C * NAME: FMGR * SOURCE: 92064-18040 * RELOC: 92064-16017 * PGMR: G.L.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM FMGR,1,80 92064-16017 REV.1650 761204 * ENT FMGR,N.OPL,O.BUF,ELOG.,AB.FM ENT .E.R,TMP.,MSS.,LODCB EXT OPEN,READF,DTTY,RMPAR,WRITF,.MVW EXT $CON,EXEC,.ENTR,IDCB1,IDCB2,IDCB3 EXT CONV.,OPEN.,CLO,.DRCT,MGLU,IMESS SUP * * CON1 NOP N20K OCT 160000 * ONP1 NOP ONP2 NOP ONP3 NOP ONP4 NOP ONP5 NOP * FMGR JSB RMPAR FETCH DEF *+2 THE ONP1A DEF ONP1 5 TURN ON PARMS * * LDA $CON,I FETCH TERMINAL LU AND B77 ISOLATE IT STA CON1 AND SAVE IT * * 1ST PARM CHECKS * LDA ONP1 FETCH PARM1 LDB N20K FETCH MIN ASCII WD ADB A IS THIS A ANSWER FILE? SSB,RSS WELL? JMP ITNME YES--CONTINUE * SZA,RSS IF DEFAULT USEC LDA CON1 USE CORRECT CONSOLE STA ONP1 SAVE CORRECT VALUE FOR OTHER CHECKS JSB DTTY INTERACTIVE? STA INT. SAVE RESULT (0=NO, NON ZERO = YES) * * GET MAGIC NAME FOR THIS LU * JSB MGLU DEF *+3 DEF ONP1 OBF DEF O.BUF * LDA OBF FETCH ADDRESS OF NAME JSB OPIN GO TRY TO OPEN IT(ERRORS RETURN TO USEC) * JMP USEC BAD RETURN FROM OPEN--USE CONSOLE * LDA ONP2 FETCH LOG (NORMAL RETURN) SZA,RSS DEFAULT? JMP W2K YEP--GO FIND SOMETHING TO USE * * LOG GIVEN--MUST BE INTERACTIVE * JSB DTTY VERIFY] THAT IT IS INTERACTIVE LDB ONP2 FETCH LOG IN CASE IT OK SZA WELL? JMP W3K ----IT'S INTERACTIVE----CONTINUE * * LOG NOT INTERACTIVE * ISSUE BAD PARM ERROR CODE * THEN USE CORRECT TERMINAL * LDA .56 FETCH ERROR CODE STA .E.R SET IT JSB ONER USE IMESS FOR BOOT UP ERROR * * * LOG NOT GIVEN OR NOT INTERACTIVE * W2K LDA INT. WAS INPUT INTERACTIVE? LDB ONP1 FETCH IT IN CASE IT WAS SZA,RSS WELL? WKFL LDB CON1 NOPE--USE CONSOLE W3K STB ONP2 SET NEW LOG LU JSB MGLU GO GET MAGIC NAME FOR IT DEF *+3 DEF ONP2 ADDRESS OF NUMBER TO BE CONVERTED DEF O.BUF TEMP AREA FOR RESULT * * GO OPEN HER UP * JSB OPEN DEF O.2R DLO$ DEF LODCB DEF .E.R DEF O.BUF DEF OPOPT * O.2R SSA,RSS ANY PROBLEMS? JMP LSTWK * * ISSUE ERROR MESSAGE THEN TRY AGAIN USING CONSOLE * JSB ONER JMP WKFL * * * OPIN OPENS THE INPUT FILE/DEVICE * LDA ADDR ADDRESS OF NAME TO BE OPENED * JSB OPIN * * P+1=OPEN ERROR WAS FOUND--ERROR HAS BEEN ISSUED * P+2=NORMAL RETURN * OPIN NOP STA INME JSB OPEN DEF O.1R DIN$ DEF INDCB DEF .E.R INME NOP ADDRESS OF BUF HOLDING NAME GOES HERE DEF OPOPT OPEN OPTION * O.1R SSA,RSS ANY ERRORS? JMP GDD NOPE--GO EXIT P+2 * JSB ONER ISSUE ERROR CODE JMP OPIN,I RETURN P+1 (BAD RETURN) * GDD ISZ OPIN ADVANCE TO GOOD RETURN JMP OPIN,I RETURN * * ONER NOP LDA .E.R JSB STER GO SET UP ERROR MESS JSB IMESS DEF RTRN DEF .2 DEF ERMES DEF .5 RTRN JMP ONER,I * * * * SPC 5 * * INPUT IS A FILE NAME * ITNME LDA ONP1A FETCH ADDRESS OF NAME JSB OPIN GO OPEN IT JMP NOGD ERROR FROM O<PEN--SET UP TO USE DEFAULTS * LDA DIN$ OPEN WAS OK--NOW ADA .3 SEE IF IT'S INTERACTIVE LDA A,I FETCH LU -DTTY ISOLATES IT STA EX! SAVE THE LU JSB DTTY STINT STA INT. LDB ONP5 FETCH LIST PARM STB ONP3 SET FOR NORMAL LIST PROCESSING SZA,RSS IF INPUT IS INTERACTIVE---SKIP JMP WKFL GO SET CONSOLE AS LOG DEVICE * LDB EX! FETCH INPUT LU JMP W3K GO SET IT AS LOG ALSO * * * * NOGD LDA CON1 FETCH CONSOLE LU STA ONP2 SET AS LOG LDA ONP5 STA ONP3 SET LIST JMP USEC GO DO EVERYTHING DEFAULT * * LSTWK LDA ONP3 FETCH LIST LU SZA,RSS SKIP IF NOT DEFAULT LDA .6 DEFAULT TO LU 6 STA TMP. SAVE IT FOR USE BY SUBS * LDA DIN$ ADDRESS OF INPUT DCB STA IN$ SET AS CURRENT INPUT FILE * JSB CLOAL CLOSE ALL FILES * WHICH MAY HAVE BEEN LEFT OPEN SPC 10 * * COMMAND INPUT FILE OPEN-- * FETCH AND PARSE NEXT COMMAND * NXCM JSB RE.C GO GET A COMMAND CLA CLEAR COMMAND ADDRESS IN CASE STA CMAD ONLY BLANK OR CONTROL IS ENTERED * JSB PARS GO PARSE IT * * LDA CMAD FETCH COMMAND ADDRESS SZA,RSS IF ZERO THEN 0 NON-BLANK CHARS HAVE BEEN ENTERED JSB CMND? ERROR-- * * COMMAND HAS BEEN IDENTIFIED AND ADDRESS IS IN CMAD * CLA STA .E.R CLEAR THE ERROR PARM JSB CMAD,I CALL THE ACTION ROUTINE DEF CALR DEF P.CNT DEF P.RAM DEF .E.R * CALR LDA .E.R SZA,RSS JMP SHUT JMP ELOG. SPC 5 * * INDCB BSS 16 LODCB BSS 16 .E.R NOP * * * TMP. NOP TMP.2 OCT 0,0 SC.L NOP CRLU NOP SPC 10 AB.FM LDA .E.R JMP ELOG. SPC 5 MSCD NOP MSS. NOP JSB .ENTR DEF MSCD LDA MSCD,I * ‡* * ELOG. JSB STER GO SET UP ERROR MESS JSB WRITF DEF ERMS DEF LODCB DEF .E.R DEF ERMES DEF .5 ERMS LDA DLO$ STA IN$ SWITCH TO LOG DEVICE FOR INPUT STA INT. SET INTERACTIVE FLAG * JSB CLO CLOSE THE INPUT FILE DEF INDCB * CLO2 CLB LDA MSS. STB MSS. SZA JMP A,I SHUT JSB CLOAL CLOSE ALL LIBRARY DCBS * CLRTN JMP NXCM GO GET NEXT COMMAND * * * STER NOP LDB BLK IF NOT NEG USE BLANK SSA LDB BSGN STB ESGN SSA CMA,INA STA OLDER SAVE ERROR CODE JSB CONV. DEF CVTN DEF OLDER DEF ECDE DEF .3 CVTN JMP STER,I * * * ZERO NOP ERMES ASC 3,FMGR ESGN NOP ECDE NOP * * * * BSGN ASC 1,- BLK ASC 1, OLDER NOP SPC 5 ERR? CLA LDB IBP FETCH CURRENT BYTE ADDRESS CLE,SLB,ERB DETERMINE WHICH BYTE TO ZAP LDA HBTE SAVE HIGH BYTE AND B,I ELSE USE 0 * IOR B77 INCLUDE "?" SEZ,RSS IF CURRENT BYTE=HIGH RE-POSITION ALF,ALF STA B,I SET BACK INTO INPUT BUFFER * * DETERMINE ECHO LENGTH * ERB SET CHAR FLAG INTO SIGN OF B LDA DNFLG FETCH REMAINING COUNT (1'S COMP & BYTE) SZA SKIP COMP IF ZERO CMA MAKE IT POSITIVE CLE,ERA MAKE IT WORDS CMA,INA SET COUNT NEG ADA ECH ADD TO ORGINIAL COUNT CLE,ELA MAKE IT BYTES SSB,RSS IF IT WAS HIGH BYTE INA BUMP CHAR COUNT CMA,INA SET IT NEG FOR CHAR COUNT STA ECH STORE PRINT LENGHT JSB ECHO GO PRINT IT LDA .10 STA .E.R JMP AB.FM * * HBTE OCT 177400 * SKP * * EX! NOP * JSB CLO DEF INDCB CLOSE THE INPUT FILE * * EXR1 JSB WRITF DEF EXR3 DEF LODCB DEF .E.R DEF ENDM ISSUE END FMGR MESSAGE DEF .5 DON'T NEED TO CLOSE LOG AS IT MUST BE LU * EXR3 JSB CLOAL CLOSE ALL LIBRARY DCBS EXR4 JSB EXEC DEF *+2 DEF .6 TERMINATE * * * CLOAL NOP THIS SUBROUTIONE CLOSES ALL LIBRARY DCBS JSB CLO DEF IDCB1 JSB CLO DEF IDCB2 JSB CLO DEF IDCB3 JMP CLOAL,I * ENDM ASC 5,$END FMGR * * * * SPC 10 * LLTMP NOP LLST NOP LLER NOP * LL! NOP JSB .ENTR DEF LLTMP ISZ LLST JSB OPEN. DEF BKLL DEF IDCB1 DEF LLST,I DEF N.OPL DEF B411 * BKLL LDA LLST,I STA TMP. ISZ LLST DLD LLST,I DST TMP.2 JSB .DRCT DEF N.OPL ASSURE DIRECT ADDRESS LDB A,I STB SC.L INA LDB A,I STB CRLU CLA STA LLER,I JMP LL!,I * B411 OCT 411 OPOPT EQU B411 * * B100 OCT 100 BFAD NOP TIT ASC 3,TITLE> OCT 37137 * * ********WRITE EOF************ * * CODE NOP USE FIRST PARM AS TEMP LST NOP ER NOP * * * WE! NOP JSB .ENTR DEF CODE * LDA LST,I FETCH FIRST PARM TYPE FLAG CPA .1 MUST BE NUMERIC CLA,RSS CLEAR ERROR CODE JMP ERR56 BAD PARAMETER * STA ER,I * ISZ LST ADVANCE TO LU LDA LST,I AND FETCH IT SSA ALLOW POS CMA,INA AND NEG. * IOR B100 INCLUDE EOF CONTROL STA CODE SAVE FOR CONTROL REQUEST * JSB EXEC DEF WE1 DEF CNTRL DON'T ALLOW ABORT DEF CODE WE1 RSS BAD LU JMP WE!,I ALL DONE EXIT * LDA N17 BAD LU STA ER,I SET IT JMP WE!,I GET OUT * * CNTRL OCT 100003 N17 DEC -17 SPC 5 * ******FETCH DIRECT ADDR******** * .ADDR NOP  RAL,CLE,ERA SEZ LDA A,I JMP .ADDR,I * ERR56 LDA .56 FETCH ERROR CODE JMP ELOG. GO ISSUE MESSAGE * .56 DEC 56 * * * *********WRITE DIRECTORY ENTRY************* * * * B77 OCT 77 .77 DEC 77 LU NOP USE FIRST AS TEMP LSTD NOP ADDRESS OF PARSE RESULT FIELD ER. NOP * * * WD! NOP JSB .ENTR DEF LU * ISZ LSTD ADVANCE TO NAME PARM EXT NAM.. JSB NAM.. GO SEE IF VALID NAME DEF RTN.. DEF LSTD,I * * RTN.. STA ER.,I SET RETURN CODE(-15 IF BAD NAME) SZA IF ZERO,OK JMP WD!,I NOPE--BAD NAME * * LEGAL FILE NAME * ****BOOT UP SHOULD FETCH DIRECT ADDRS * LDA O.BFA JSB .ADDR FETCH DIRECT ADDR STA BFAD SET ADDRESS OF OUTPUT BUFFER LDB BLNK FETCH ASCII BLANKS STB A,I SET INTO FIRST WORD OF OUTPUT BUFFER STA B INB SET (A)+1 AS DEST OF MOVE * JSB .MVW BLANK OUT -OUTPUT BUFFER DEF .77 NOP * * LDA LSTD,I FETCH FIRST 2 CHARS STA BFAD,I SET INTO BUFFER ISZ BFAD BUMP DEST ADDR ISZ LSTD BUMP SOURCE ADDR DLD LSTD,I FETCH REST OF NAME DST BFAD,I SET REST OF NAME * LDB .2 ADVANCE TO ADB LSTD LU PARM LDA B,I FETCH PARM TYPE FLAG CPA .3 DON'T ALLOW JMP ERR56 BAD PARAMETER * INB LDA B,I FETCH LU SZA,RSS DEFAULT TO THE LEFT CTU LDA .4 SSA ALLOW POS CMA,INA AND NEG LU'S STA LU SAVE FOR EXEC CALL * ADB .4 ADVANCE TO TYPE WORD LDA B,I AND B377 ISOLATE 2ND CHAR CPA ZS ASCII SOURCE? JMP HERE YEP CPA ZR BINARY RELOCATABLE? JMP HERE YEP CPA ZA BINARY ABS? JMP HERE  YEP CPA ZD BINARY DATA? JMP HERE YEP CPA ZC AMD CASSETTE? JMP HERE YEP LDB .56 PRE-SET ERROR CODE STB ER.,I FOR BAD PARM SZA DEFAULT? JMP WD!,I NOPE--BAD INPUT * LDA ZS DEFAULT = SOURCE HERE LDB BFAD FETCH OUTPUT BUFFER ADDRESS ADB .2 ADVANCE TO TYPE ADDRESS IOR HBLK ADD A BLANK CHAR TO LEFT BYTE STA B,I AND SET TYPE INTO BUFFER ADB .2 ADVANCE TO COMMENTS FIELD STB BFAD AND SAVE IT'S ADDRESS * * * ISSUE MESSAGE TO LOG DEVICE * REQUESTING COMMENTS * JSB WRITF DEF RTNT DEF LODCB DEF .E.R DEF TIT DEF .4 * RTNT JSB READF DEF RTNR DEF IN$,I DEF ER.,I DEF BFAD,I DEF .36 DEF LEN * RTNR SZA JMP WD!,I IF ANY ERRORS EXIT * LDA LEN FETCH COMMENTS LEGNTH ADA .5 INCLUDE DIRECTORY INFORMATION STA LEN SET WRITE LEGNTH * * * JSB EXEC DEF WRT1 DEF .2 DEF LU DEF O.BUF DEF LEN * WRT1 JMP WD!,I * * .2 OCT 2 .3 OCT 3 .4 OCT 4 .5 OCT 5 .6 OCT 6 .10 DEC 10 .36 DEC 36 HBLK OCT 20000 ZS OCT 123 ZA OCT 101 ZD OCT 104 ZC OCT 103 ZR OCT 122 * * * SPC 10 TCNT NOP TLST NOP TER NOP * TR! NOP JSB .ENTR DEF TCNT ISZ TLST ADVANCE TO NAME/LU * LDA TLST,I FETCH IT SZA,RSS * * TRANSFER BACK TO THE LOG DEVICE * JMP ERMS * * OPITR JSB OPEN. GO OPEN NEW TRANSFER FILE DEF BACK XX DEF INDCB DEF TLST,I DEF N.OPL DEF OPOPT * BACK LDA XX FORCE INPUT DCB TO BE USED STA IN$ ADA .3 ADVANCE TO LU WORD LDA A,I FETCH IT JSB DTTY STA INT. SET INTERACTIVE FLAG 0.*JMP TR!,I * SKP * * * * RE.C SHOULD DO THE FOLLOWING: * 1- DETERMINE IF INPUT FROM INTERACTIVE DEVICE * IF SO, PROMPT ON THAT DEVICE * 2- READ FROM INPUT FILE/DEVICE * 3- IF ECHO REQUIRED-DO IT TO LOG * * * GLOBALS * * ECH CMND INPUT LEGNTH * INT. INTERACTIVE FLAG * CAM.I CMND INPUT BUFFER * INDCB INPUT DCB * .1 OCT 1 * RE.C NOP LDA INT. IF NOT INTERACTIVE SZA,RSS JMP WR.1R DON'T PROMPT * JSB WRITF DEF WR.1R DEF IN$,I DEF .E.R DEF PRM DEF .1 * WR.1R JSB READF DEF WR.2R DEF IN$,I DEF .E.R DEF CAM.I DEF .36 DEF ECH LEGNTH PARM * WR.2R SSA IF ANY ERROR JMP WR.1R RETRY * * LDA ECH IF EOF CPA N1 TRANSFER TO JMP ERMS LOG DEVICE * * * DO ECHO IF IN FROM NON INT WORK * * LDA INT. FETCH INTERACTIVE FLAG SZA,RSS JSB ECHO GO DO ECHO JMP RE.C,I IT'S INTERACTIVE SO EXIT * SPC 5 ECHO NOP JSB WRITF DEF ECRT DEF LODCB DEF .E.R DEF CAM.I DEF ECH ECRT JMP ECHO,I IN$ NOP PRM OCT 35137 BACK SPACE AND BACK ARROW * SKP 0* * ********************************************** ********************************************** *******THE*PARSE*ROUTINE*MAY*BECOME*A*SEPERATE* ****************SUBROUTINE******************** * * * * PARSE ROUTINE * PARS NOP LDA ECH RESET COMMAND LEGNTH CLE,ELA CONVERT TO CHAR COUNT CMA SET NEGATIVE FOR GTCHR STA DNFLG LDA CAM.A RESET CHARACTER ADDRESS STA IBP FOR INBUF SCAN * * * LDB INT. FETCH INTERACTIVE FLAG SZB IF NOT INTERACTIVE-SKIP JMP OK: --ELSE CONTINUE * JSB GTCHR JMP ERR? * * CPA CLN MUST HAVE : FOR FIRST CHAR JMP OK: GOT IT-CONTINUE * JMP ERR? ELSE ISSUE ERROR AND TRANSFER TO LOG DEVICE * SPC 5 OK: CLA ZERO OUT POINTERS,BUFFERS STA MRSLT WORK FIELDS AND FLAGS LDA MADDR FETCH START ADDRESS (DEF MRSLT STA B AND FORM INB RESULT FIELD ADDRESS * JSB .MVW GO DEF .56 CLEAR NOP THE WORLD * LDA MADDR FETCH ADDRESS OF MAIN RESULT STA NXBUF FIELD AND SET IT AS FIRST BUFFER LDA .9 FETCH MAIN BUF CODE STA NXBC SET AS NEXT BUF FLAG LDA N2 SET FIRST FLAG FOR CMND CHECK STA FIRST * SKP * TOP ISZ FIRST GOT CMND READY? RSS NOPE JSB CMND? DOES NOT RETURN IF BAD CMND * LDA WORKA RESET WORK BUF ADDRESS STA TMP1 FOR THIS PASS LDA NXBUF FETCH NEXT BUFFER ADDRESS STA CBUF SET IT AS CURRENT BUFFER LDA NXBC SET CURRENT STA CXBC BUFFER FLAG CLA STA FNDCT CLEAR CHAR FOUND THIS PARM COUNT * * * LDB DNFLG FETCH DONE FLAG SSB,RSS IF MORE CHAR --SKIP JMP PARS,I ELSE GO TO EXIT * * NEXT  JSB GTCHR FETCH NEXT NON-BLANK CHAR JMP CONV -ALL DONE--SEE IF CONVERSION NEEDED * CPA CMA IS IT A COMMA? JMP GTCMA YES-GO PROCESS IT * CPA CLN IS IT A COLON? JMP GTCLN YES- GO PROCESS IT * * NOT SURE ON THIS COUNT * LDB .8 CHECK FOR TOO MANY CHARS CPB FNDCT COMPARE AGAINST #FOUND JMP NEXT YES--DON'T SAVE EXTRAS * STA TMP1,I =LOCATION TO SAVE CHAR ISZ FNDCT BUMP CHAR FOUND COUNT ISZ TMP1 BUMP SAVE LOCATION * JMP NEXT GO GET NEXT CHAR * * FIRST NOP * * SPC 5 * * GOT A CMND--SEE IF IT IS LEGIT * * * DETERMINE CMND TYPE * CMND? NOP LDB MADDR FETCH FLAG FOR LDA B,I COMMAND-- CPA .3 MUST BE ASCII INB,RSS YEP-- IT'S OK * JMP ERR? NOPE--BAD INPUT * * LDA B,I FETCH COMMAND STA OPP SET STOP WORD LDB TABP SET TABLE STB TMP1 POINTER FOR SEARCH LDB ACTP SET ACTION ADDRESS STB TMP2 FOR SEARCH * SCH CPA TMP1,I THIS IT? JMP CALL YES--GO TO IT ISZ TMP1 BUMP COMMAND POINTER ISZ TMP2 BUMP ACTION POINTER JMP SCH TRY AGAIN-- * * SPC 2 CALL LDA TMP2 FETCH CMND ADDRESS CPA ERC IF EQUAL TO ERROR ADDRESS JMP ERR? THEN GO NO FURTHER * STA CMAD SET COMMAND ADDRESS JMP CMND?,I * CMAD NOP * TABP DEF *+1 ASC 8,COCLDCDLDULLLIMC ASC 9,PKPURNEXCNVEWDWETR OPP NOP SET TARGET HERE * * ACTP DEF *+1,I EXT CO.. DEF CO.. CO@ EXT CL.. DEF CL.. EXT DC.. DC@ DEF DC.. DC@ EXT DL.. DEF DL.. DL@ EXT DU.. DEF DU.. DU@ DEF LL! LL@ EXT LI.. DEF LI.. LI@ EXT MC.. DEF MC.. MC@ EXT PK.. DEF PK.. PK@ EXT PU.. DEF PU.. PU@ EXT RN.. DEF RN.. RN@ DEF EX! EX@ EXT CNT. DEF CNT. CNT@ EXT VE.. DEF VE.. VE@ DEF WD! WD@ DEF WE! WE@ DEF TR! TR@ ERC DEF *,I NOT FOUND --BAD INPUT * * .8 DEC 8 .9 DEC 9 * SKP * * * FOUND A COMMA * GTCMA ISZ P.CNT INC MAIN PARM COUNT LDA P.CNT FETCH MAIN PARM COUNT RAL,RAL MULT BY 4 ADA MADDR AND ADD BUFFER START ADDRESS STA NXBUF TO GET RESULT STARTING ADDRESS * LDA .9 FETCH # MAX PARMS+1 STA NXBC SET AS NEXT BUF FLAG CPA P.CNT ALSO CHECK FOR TOO MANY PARAMETERS JMP ERR? --TOO MANY BYE BYE * CLA RESET SUB PARM COUNT STA SPCNT JMP CONV GO CONVERT PARM * SPC 5 * * FOUND A COLON * GTCLN LDA P.CNT FETCH MAIN PARM COUNT ADA N2 BUT NO MORE THAN 2 LDB SPADR FETCH SUB PARM BUFFER ADDRESS SSA IF FOR FIRST MAIN PARM JMP SET GO SET BUFFER ADDRESS * SZA IF MORE THAN 2ND PARM JMP ERR? --TAKE ERROR EXIT ADB .5 ELSE ADVANCE TO 2ND MAIN FIELD * * (B)= START OF SUB PARM FIELD * DETERMINE OFSET * SET ADB SPCNT ADD CURRENT SUB PARM COUNT STB NXBUF SET AS NEXT RESULT BUFFER ADDRESS ISZ SPCNT BUMP SUB PARM COUNT LDA .6 MAX # SUB PARMS +1 STA NXBC SET SUB PARM AS NEXT RESULT FIELD CPA SPCNT SEE IF WE'VE GOT TOO MANY JMP ERR? YEP--TAKE ERROR EXIT * * THIS FALLS THRU TO CONVERT * * SPC 5 * * * CONVERT ROUTINE * CONV LDA FNDCT IF NO CHARS FOUND SZA,RSS THEN EITHER DONE OR NULL JMP NONE GO CHECK *  LDB WORKA SET ADDRESS OF WORK STB TMP1 BUFFER FOR CONVERSION LDA B,I FETCH FIRST CHAR * CPA DASH IF "-" GO SEE IF THATS ALL JMP C. * CPA PLUS DO THE SAME JMP C. FOR "+" * LSTT ADB FNDCT ADVANCE TO LAST CHAR ADDRESS ADB N1 LDA B,I FETCH IT CPA AS.B CHECK FOR BASE INDICATOR JMP .B YES IT'S BASE 8 INB ADVANCE PAST LAST CHAR LDA .10 FETCH FOR BASE 10 CONVERSION * STBS STA BASE SET BASE FOR CONVERSION STB STOP SET STOP ADDRESS CLB,CLE CLEAR THE RESULT STB VALUE BUFFER * CMPY MPY VALUE LDB TMP1,I FETCH CURRENT CHARACTER ADB DM58 IF GREATER THAN "9" SEZ,CLE,RSS THEN NOT A NUMBER ADB .10 IF LESS THAN "0" SEZ,CLE,RSS THEN NOT JMP ASCII A NUMBER * ADA B INCLUDE PREVIOUS RESULT STA VALUE AND SAVE IT * ISZ TMP1 BUMP WORK BUFFER POINTER LDA BASE FETCH BASE FOR NEXT LOOP LDB STOP FETCH STOP ADDRESS CPB TMP1 IF EQUAL TO CURRENT WORK POINTER JMP CDNE THEN CONVERSION COMPLETE JMP CMPY ELSE--CONTINUE CONVERSION * * * SPC 5 C. ISZ TMP1 LDA FNDCT CPA .1 JMP ASCII JMP LSTT SPC 5 .B LDA .8 FETCH CONVERSION BASE JMP STBS * * * * * * * CONVERSION DONE * NUMERIC RESULT * IN "VALUE" * CDNE LDA WORKA,I FETCH FIRST CHAR LDB VALUE FETCH CONVERTED VALUE CPA DASH IF ="-" THEN NEGATE CMB,INB RESULT * * * DETERMINE WHERE RESULT GOES * LDA CXBC FETCH CURRENT BUFFER CODE CPA .9 MAIN PARM BUF? JMP MAIN YEP * * GOES IN SUB PARM BUF * STB CBUF,I SAVE RESULT IN BUFFER  JMP TOP GET NEXT PARAMETER * * * GOES IN MAIN PARM BUF * * MAIN CLA,INA STA CBUF,I SET NUMERIC FLAG INTO BUFFER ISZ CBUF ADVANCE PAST FLAG WORD STB CBUF,I SET CONVERTED VALUE INTO BUFER JMP TOP FETCH NEXT PARAMETER * * SPC 10 * * * ASCII PARAMETER * * ASCII LDA CXBC FETCH CURRENT BUFFER FLAG CPA .9 MAIN BUFFER?? JMP AMAIN YEP--MOVE TO MAIN BUFFER * * * MOVE TO SUB PARM BUFFER * LDA SPCNT IF SUB CNT >4 THEN ADA N4 CAN'T HAVE SSA,RSS ASCII PARM JMP ERR? SO ERROR EXIT * * LDA .2 FETCH MAX # CHAR TO BE MOVED JMP MASC GO DO IT * * * * MAIN BUF MOVE * AMAIN LDA .3 FLAG CODE FOR ASCII STA CBUF,I SET FLAG INTO BUFFER ISZ CBUF ADVANCE PAST FLAG WORD LDA .6 SET A MAX OF 6 MASC CMA,INA CHARS FOR MOVE STA CCNT SET IN COUNTER * * LDB WORKA FETCH ADDRESS OF WK BUFFER ADB FNDCT ADD # CHARS FOUND STB STOP SET AS STOP ADDRESS * * LDB WORKA FETCH WK BUF ADDR STB TMP1 SET AS FROM ADDRES CLE,RSS CLEAR BYTE FLAG AND SKIP ADDR FETCH * MNXT LDB TMP1 FETCH FROM ADDRESS CPB STOP IS THAT ALL FROM HERE JMP GTBLK YES--PAD WITH BLANKS * LDA B,I FETCH CHAR FROM WORK FIELD ISZ TMP1 BUMP FROM ADDRESS POSN SEZ,CME,RSS NEED TO POS CHAR? ALF,ALF YES-SHIFT TO HIGH BYTE LDB CBUF,I FETCH CURRENT RESULT WORD IOR B INCLUDE CURRENT CHAR STA CBUF,I SAVE BACK INTO RESULT BUFFER SEZ,RSS INCREMENT RESULT BUFFER ADDR ISZ CBUF ONLY IF NEW WORD IS NEEDED ISZ CCNT BUMP MOVE COUNT-DONE? JMP MNXT NOPE-GO SEE ABOUT NEXT CHAR JMP TOP ALL DONE--GET NEXT PARAMETER * * GTBLK LDA B40 FETCH ASCI8I LOW " " JMP POSN GO PAD FIELD * * * SPC 5 * NONE LDB DNFLG FETCH DONE FLAG SSB,RSS IF SIGN NOT SET JMP PARS,I DONE * JMP TOP ELSE GET NEXT PARAMETER(O=NULL ) * * * * GTCHR NOP * * NOBK LDA IBP FETCH INPUT CHAR ADDRESS ISZ DNFLG BUMP CHAR COUNTER SKIP IF DONE RSS SKIP EXIT JMP GTCHR,I DONE EXIT CLE,ERA GET WORD ADDR AND SET BYTE FLAG LDA A,I FETCH INPUT WORD SEZ,RSS POSITION FOR REQUESTED BYTE ALF,ALF IF NEEDED AND B377 ISOLATE IT ISZ IBP BUMP CHAR ADDRESS CPA B40 IF BLANK JMP NOBK GET NEXT ONE ISZ GTCHR ELSE BUMP RETURN ADDRESS JMP GTCHR,I RETURN * * ******************************************** *******THE FOLLOWING SECTION IS ZEROED****** *******EACH TIME THE PARSE ROUTINE IS ****** *******INVOKED****************************** * * * DON'T REMOVE ANY OF THESE AS LIST * USES THIS SECTION AS A BUFFER * * ************ MRSLT BSS 4 MAX OF 9 MAIN PARMS,ENOUGH? P.RAM BSS 32 MRSLT AND P.RAM FORM THE RESULT FIELD ************ WORK BSS 8 TEMP BUFFER FOR CONVERSION SPBUF BSS 10 RESULT FIELD FOR SUB PARMS P.CNT NOP FNDCT NOP SPCNT NOP ********************************************************* ********************************************************* NXBC NOP CXBC NOP NXBUF NOP N.OPL EQU SPBUF CBUF NOP TMP1 NOP TMP2 NOP WORKA DEF WORK CAM.I BSS 37 CAM.A DBL CAM.I IBP NOP MADDR DEF MRSLT SPADR DEF SPBUF DASH OCT 55 AS.B OCT 102 DM58 DEC -58 ECH NOP * INT. NOP CLN OCT 72 CMA OCT 54 DNFLG NOP N1 OCT -1 N2 OCT -2 N4 OCT -4 B40 OCT 40 B377 OCT 377 * * * ********************LEAVE O.BUF AND BLNK TOGETHER*********** O.BUF BSS 129 BLNK ASC 1, THE ROUTINE WHICH BLANKS O.BUF * SPI*($LLS OVER TO HERE SO BE CAREFULL ********************************** O.BFA DEF O.BUF * * PLUS OCT 53 ASCII + BASE NOP STOP NOP VALUE NOP CCNT NOP * A EQU 0 B EQU 1 LEN EQU * * END FMGR D*  92064-18041 1650 S C0122 &C1..C CRTG CRTG LOGICAL UNIT SUBROUTINE             H0101 ASMB,R,L,C * NAME: CL.. * SOURCE: 92064-18041 * RELOC: 92064-16017 * PGMR: G.L.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM CL..,7 92064-16017 REV.1650 761010 * * EXT TMP.,.DRCT,OPEN.,IDCB3,.ENTR EXT $CRLK,WRITF,CONV.,.MVW * ENT CL..,PNAM * SUP * CNT NOP LST NOP ER NOP * CL.. NOP JSB .ENTR DEF CNT * * OPEN LIST FILE * JSB .DRCT DEF TMP. FETCH DIRECT ADDR OF LIST INFO * * ADA .3 STA TMP1 SET ADDRESS OF LIST FILE LU JSB OPEN. DEF RTN DEF IDCB3 DEF TMP. DEF TMP1,I DEF ZERO OPTION * RTN JSB .DRCT FETCH DIRECT DEF $CRLK ADDRESS OF MASTER LOCK STA DIRAD SAVE ADDRESS FOR SEARCH LDA A,I FETCH MASTER LOCK SZA,RSS IS IT LOCKED? JMP HEAD NOPE--SKIP MASTER LOCK INFO * LDB MLKAD DESTINATION ADDRESS OF LOCKER'S NAME JSB PNAM A=IDSEG ADDRESS,MOVE PROG NAME TO PRINT BUF * * PRINT "MASTER LOCK BY PNAME" WHERE PNAME=LOCKER * JSB WRITF DEF HEAD1 DEF IDCB3 DEF ER,I DEF MLOK DEF .11 * HEAD1 SZA ANY PROBLEMS? JMP CL..,I HEAD JSB SPACE SKIP A LINE * * WRITE LIST HEAD * JSB WRITF DEF RT2 DEF IDCB3 WRITE " LU VALID LOCK" DEF ER,I DEF CLHD DEF .8 * RT2 JSB SPACE LDA DIRAD ADVANCE INA TO STOP ADDRESS LDB A,I FETCH STOP ADDRESS STB STOP  AND SAVE IT INA .5 ADVANCE TO FWA OF CRDIR STA DIRAD SPC 5 * * BLANK OUT PRINT BUFFER * NEXT LDA BLNKA ADDRESS OF ASCII BLANK WHICH STA B PPRECEDES BUFFER INB B NOW EQUALS PRINT BUFFER ADDRESS JSB .MVW DEF .8 BLANK IT OUT NOP * * FETCH LU OR END * LDA DIRAD FETCH CURRENT DIR ENTRY CPA STOP END? CLA,RSS FORCE EXIT LDA A,I FETCH ENTRY SZA IF ZERO THEN MUST BE DONE JMP COV NO CONTINUE * STA ER,I CLEAR ERROR WORD CLRTN JMP CL..,I EXIT * * * COV JSB CONV. DEF RTN3 CONVERT LU DEF DIRAD,I AND SET RESULT DEF LUA INTO PRINT BUFFER DEF .2 2 DIGITS * RTN3 ISZ DIRAD ADVANCE TO VALIDITY ADDRESS LDA DIRAD,I FETCH VALIDITY WORD ADDRESS(WD2 OF ENTRY) LDA A,I FETCH ACTUAL VALIDITY WORD SZA,RSS IF INVALID--SKIP JMP VAL1 GO MOVE YES IN LDA NO ELSE SET STA VAL "NO" INTO BUF * LK? ISZ DIRAD ADVANCE TO ISZ DIRAD LOCK WORD(THIS UNIT) LDA DIRAD,I FETCH IT SZA,RSS IF NOT LOCKED--GO PRINT LINE JMP PRNT * LDB LKNM FETCH DEST ADDR JSB PNAM GO MOVE NAME IN * * PRINT A LINE * PRNT JSB WRITF DEF RTN4 DEF IDCB3 DEF ER,I DEF BLNK DEF .9 * RTN4 ISZ DIRAD ADVANCE TO NEXT ENTRY JMP NEXT GO DO NEXT ONE * * * * * TRY AND AVOID EXTRA LINKS * * .1 OCT 1 .2 OCT 2 .3 OCT 3 .8 DEC 8 .9 DEC 9 .11 DEC 11 TMP1 NOP TMP2 NOP ZERO NOP DIRAD NOP STOP NOP * * * PRINT BUFFERS AND POINTERS * MLKAD DEF MK MLOK ASC 8, MASTER LOCK BY MK BSS 3 * CLHD ASC 8, LU VALID LOCK * BLNKA DEF BLNK BLNK ASC 1, PBUF BSS 8 LUA EQU PBUF VAL EQU PBUF+2 LKNM DEF PBUF +5 * YES ASC 2,YES NO ASC 1,NO * * VAL1 DLD YES DST VAL JMP LK? * * SPACE NOP JSB WRITF DEF RTN5 DEF IDCB3 DEF ER,I DEF BLNK DEF .1 RTN5 SZA JMP CL..,I JMP SPACE,I * * * * PNAM----MOVES PROGRAM NAME (IDSEG ADDRESS IN A) * TO PRINT BUFFER(ADDRESS IN B) * PNAM NOP STB TMP1 ADA .12 ADVANCE TO NAME STA TMP2 DLD A,I FETCH FIRST TWO CHARS DST TMP1,I LDB .2 ADB TMP2 ADVANCE TO THIRD WORD LDA B,I FETCH IT AND HBYTE ISOLATE LEFT BYTE ADA B40 ADD BLANK ISZ TMP1 ISZ TMP1 STA TMP1,I SET 3RD WORD JMP PNAM,I * B40 OCT 40 .12 DEC 12 HBYTE OCT 177400 * A EQU 0 B EQU 1 PLEN EQU * END   92064-18042 1650 S C0122 &CNT. RTE-M DEVICE CONTROL SUB             H0101 *SPL,L,O,M,C ! NAME: CNT. ! SOURCE: 92064-18042 ! RELOC: 92064-16063 ! PGMR: G.A.A. ! MOD: G.L.M. ! ! *************************************************************** ! * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * ! * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * ! * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* ! * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ! *************************************************************** ! ! NAME CNT.(7) " 92064-16063 REV.1650 761020" ! ! ! ! THE FOLLOWING IMPLEMENTS THE CONTROL COMMAND. ! ! :CN [[[,NAMR][,FUNCTION][,SUB-FUNCTION]]] ! LET OPEN.,FCONT,EXEC BE SUBROUTINE,EXTERNAL LET IDCB1,N.OPL BE INTEGER,EXTERNAL ! LET PTR,EQWD5,NAMR,FUNC,FUNCT BE INTEGER LET SUBF,SUBFN,FTAB,FTAB1 BE INTEGER LET FTAB2 BE INTEGER (3) LET FTAB3 BE INTEGER LET FTAB4 BE INTEGER (9) LET FTAB5,FTAB6 BE INTEGER ! INITIALIZE FTAB,FTAB1,FTAB2,FTAB3,FTAB4,FTAB5,\ FTAB6 TO "RW",400K,"EO",100K,"TO",1100K, \ "FF",1300K,"BF",1400K,"FR",300K,"BR",200K, \ "LE",1000K,0 ! ! CNT.: SUBROUTINE(NUM,PLIST,ERR) GLOBAL LET NUM,PLIST,ERR BE INTEGER SUBFN _ [SUBF _ [FUNCT _ [FUNC _ \SET UP POINTERS [NAMR _ @PLIST + 1] + 3] + 1] \AND, IF NECESSARY, + 3] + 1 IFNOT PLIST THEN $NAMR _ 8 !THE DEFAULT FOR NAMR. CALL OPEN.(IDCB1,$NAMR,N.OPL,10K) !OPEN THE FILE OR LU. IFNOT $FUNC THEN GOTO DEFLT !WAS FUNCTION SUPPLIED? IF $FUNC = 3 THEN GOTO DCODE !FUNCTION SUPPLIED. IF FUNC _ $FUNCT <- 6 !NUMERIC, SHIFT TO GOTO SUBFU !PROPER POSITION. DCODE: NAMR _ @SUBF !IF ASCII, DECODE IT. TLOOP: IFNOT $[NAMR _ NAMR + 2] THEN [ \END OF TABLE? PRMER: ERR _ z  56; RETURN] !PARAMETER ERROR. IF ($FUNCT - $NAMR) THEN GOTO TLOOP !MATCH? FUNC _ $(NAMR+1) !YES - GET FUNCTION CODE. SUBFU: IFNOT $SUBF THEN $SUBFN _ -2 !DEFAULT SUBFN IF NEC. CALL FCONT(IDCB1,ERR,FUNC,$SUBFN) !SEND THE CONT. FUNC. IF ERR = -12 THEN ERR _ 0 RETURN DEFLT: PTR _ @IDCB1 + 2 !FUNCTION NOT SUPPLIED. IFNOT PLIST = 3 THEN GOTO DELF1 !FIND DEFAULT. FOR FILE IF $PTR THEN GOTO PRMER !NAME, CHECK IF TYPE 0. $NAMR _ $(PTR+1) !GET LOGICAL UNIT #. DELF1: CALL EXEC(100015K,$NAMR,EQWD5,EQ4,SC)!GET DEVICE TYPE. GOTO PRMER !ERROR RET. FROM EXEC IF [EQ4_ (EQWD5 AND 37400K)] > \IF DEV. TYPE > 16, 7000K THEN[FUNC_FTAB1;GOTO SUBFU] !THEN DEFAULT = REWND. FUNC _ [IF EQ4 = 2400K AND \ !IF CTU THEN DEFAULT (SC=1 OR SC=2) THEN FTAB1,ELSE $(PTR+2)]! = REWIND GOTO SUBFU END END END$ |   92064-18043 1650 S C0122 &DC..C CRTG DISMOUNT CRTG. SUB             H0101 'ASMB,R,L,C * NAME: DC.. * SOURCE: 92064-18043 * RELOC: 92064-16017 * PGMR: G.L.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM DC..,7 92064-16017 REV.1650 760802 * EXT CLD.R,.P1,.P2,.P3,.P4,.P5,LODCB,WRITF EXT .ENTR,$CDIR,.DRCT,PMOVE,.PDCV * ENT DC.. SPC 2 CNT NOP LST NOP ER NOP * DC.. NOP JSB .ENTR FETCH CALL DEF CNT PARMS * ISZ LST ADVANCE PAST FLAG WORD LDA LST,I FETCH LU SSA,RSS -LU ONLY,CART REF JMP ER10 NOT ALLOWED * STA .P2 SET FOR CALL TO D.R LDA XEQT SET PROG ID STA .P4 FOR LOCK LDA .11 SET FUNCTION STA .P1 CODE FOR MASTER LOCK * * CALL TO D.R SETUP * SO GO REQUEST MASTER LOCK * JSB CLD.R CALL D.R LDA B,I FETCH ERROR PARAMETER SZA OK? JMP EREX NOPE--EXIT(ERROR CODE IN A) * * * NOW GO LOCK REQUESTED UNIT * LDA .3 FETCH CARTRIDGE LOCK CODE STA .P1 SAVE FOR D.R JSB CLD.R LDA B,I ANY ERRORS ? SZA OK? JMP ELOK YES--GO CLEAR MASTER LOCK STA .P4 CLEAR LOCK ID PARM(THIS VALUE IS SET AS LOCK) * ADB .2 ADVANCE RETURN PARM ADDRESS(POINT AT DIRECTORY ADDR) LDB B,I FETCH CART DIR ADDR OF NEXT ENTRY * * THIS LOCATION IS REQUESTED LU+4 * STB .P5 SAVE IN TEMP * * CLEAR WORD 1 OF DIRECTORY HEADER--CLEAR IT FOR USE * ADB N2 BACK UP DIRECTORY ADDRESS LDB B,I FETCH THAT ADDRESS ADB N3 NOW BACK UP TO "ASSIGNED" WORD CLA USE A REG AS FROM ADDRESS JSB PMOVE GO PRIV AND CLEAR IT OCT 1 * LDB .P5 RESTORE POINTER TO CARTRIDGE DIRECTORY * * FETCH DIRECT ADDRESS OF CARTRIDGE DIRECTORY * (B) IN NOT CHANGED * JSB .DRCT DEF $CDIR ADA N1 BACKUP TO END OF SEARCH WORD LDA A,I WORD AND FETCH IT STA CNT SAVE STOP ADDRESS CPA B IF CARTRIDGE TO BE DISMOUNTED IS LAST, JMP CLR SKIP CLOSE UP OF GAP * * CALCULATE TO,FROM AND LEGNTH WORDS FOR * MOVE(CLOSE UP GAP) * * A=STOP ADDRESS, B=NEXT DIR ADDRESS * CMB,INB SET NEXT ADDR NEGATIVE ADA B ADD TO END OF TABLE STA LN1 SAVE LEGNTH FOR MOVE CMB,INB SET NEXT ADDR POSITIVE LDA B SET "FROM" ADDRESS ADB N4 CALCULATE "TO" ADDRESS * JSB PMOVE GO PRIV AND CLOSE UP GAP LN1 NOP # OF WORDS TO MOVE * * CLEAR LAST ENTRY IN TABLE * CLR LDA ZBUF FETCH FROM ADDRESS(4 NOP'S) LDB CNT CALCULATE "TO" ADDRESS ADB N4 (END OF SEARCH -4) JSB PMOVE GO PRIV AND MOVE IT IN .4 OCT 4 * * CARTRIDGE ENTRY CLEARED AND * POSSIBLE GAP HAS BEEN CLOSED * LDA LST,I FETCH LU AGAIN CMA,INA MAKE IT POS JSB .PDCV GO CONVERT IT TO DEC ASCII * STA LU AND SET IT FOR MESSAGE * JSB WRITF DEF ELOK DEF LODCB DEF ER,I DEF DCMES DEF .14 * * ELOK STA ER,I SET ERROR CODE * CLA STA .P2 CLEAR CR/LU WORD LDA .11 STA .P1 RESET CODE FOR MASTER LOCK SET/CLEAR JSB CLD.R GO CLEAR IT JMP DC..,I ER10 LDA .10 BAD INPUT ERROR EREX STA ER,I SET ERROR RETURN JMP DC..,I EXIT * N2 OCT -2 N3 OCT -3 SKP .2 OC  T 2 .3 OCT 3 .10 DEC 10 .11 DEC 11 .14 DEC 14 N1 OCT -1 N4 OCT -4 * * DON'T CHANGE THIS ZBUF DEF *+1 NOP NOP NOP NOP * DCMES ASC 13,CARTRIDGE DISMOUNTED > LU LU NOP * XEQT EQU 1717B A EQU 0 B EQU 1 LEN EQU * END =  92064-18044 1650 S C0122 &DU..C CRTG DUMP SUB             H0101 {=SPL,L,O,M,C ! NAME: DU.. ! SOURCE: 92064-18044 ! RELOC: 92064-16017 ! PGMR: G.A.A. ! MOD: G.L.M. ! ! *************************************************************** ! * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * ! * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * ! * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* ! * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ! *************************************************************** ! ! NAME DU..(7) " 92064-16017 REV.1650 761010" ! ! THIS IS THE RTE FMP FMGR ROUTINE TO STORE ! AND DUMP FILES. ! ! DU,NAME,LU,OP1,OP2,OP3 ! ! O R ! ! ST,LU,NAME,OP1,OP2,OP3,OP4 ! ! ! W H E R E: ! ! ST IS STORE. ! DU IS DUMP. ! ! NAME ! NAME IS THE FILE TO BE DUMPED. ! ! LU IS EITHER THE SOURCE OR DESTINATION ! DEVICE AND MAY BE A FILE REFERENCE. ! ! OP1 IS A MEDIUM ASC CODE AS FOLLOWS: ! AS ASCII DATA ! BR BINARY RELOCATABLE DATA ! BA BINARY ABSOLUTE DATA ! MT MAG TAPE NORMAL FORMAT ! MS MAG TAPE SIO FORMAT ! ! OP2 IS AN END OF FILE OPTION ! FLAG -- TWO ASC CHARACTERS: ! SA SAVE END OF FILES IN THE ! NEW FILE. ! IN INHIBIT ALL LEADER, TRAILER, ! END OF FILE TRANSFERS; ! DOES NOT APPLY TO FINAL ! EOF ON A DISC FILE. ! ! OP3 IS THE NUMBER OF THE FIRST FILE ! TO BE TRANSFERRED (APPLIES TO ! FILES OF TYPE ZERO) (DEFAULT=1) ! ! OP4 IS THE NUMBER OF FILES TO BE ! TRANSFERRED (APPLIES TO FILES !  OF TYPE ZERO) (DEFAULT= ) ! ! N O T E: OP3 AND OP4 ARE RELATIVE TO CURRENT POSITION. ! ! DEFINE EXTERNALS ! LET IDCB1,IDCB2,BUF. BE INTEGER,EXTERNAL ! LET N.OPL,.E.R BE INTEGER,EXTERNAL ! LET OPEN.,LOCF,\ EXEC,READF,WRITF,\ MSS.,\ IER.,CK.SM,CLOSE BE SUBROUTINE,EXTERNAL ! LET IFBRK BE FUNCTION,EXTERNAL ! LET DU.. BE SUBROUTINE ! LET SECT2 BE CONSTANT(1757K) LET AS BE CONSTANT (40523K) LET BR BE CONSTANT (41122K) LET BN BE CONSTANT (41116K) LET BA BE CONSTANT (41101K) LET MT BE CONSTANT (46524K) LET MS BE CONSTANT (46523K) LET IH BE CONSTANT (44510K) LET SA BE CONSTANT (51501K) LET B.A BE CONSTANT (20101K) LET B.R BE CONSTANT (20122K) ! ! ! DU..: SUBROUTINE(NPS,LISTS,ERS) GLOBAL LI12_[LIS8_[LIS4_@LISTS+4]+4]+4 ! LIS21_[LIS17_[LIS13_[LIS9_[LIS5_[LIS1_\ @LISTS+1]+4]+4]+4]+4]+4 ! ! PRESET DEFAULT OPTIONS ! O2BF,SPDCB_@IDCB2 !SET DCB ADDRESS FOR SPACING IDCBA_@IDCB1 !SET INPUT DCB ADDRESS BUFF,BUFA,BF_@BUF. DO[F1,SIOI,EOFF,CK,SIO,FLG_0;LDR_0] DO[SUBF_400K;F2,TYP_1] IF NPS<2 THEN [ERS_55;RETURN] DT_3 !SET DEFAULT TYPE ! ! ANALYZE OPTIONS ! ! FIRST THE TYPE FLAG ! IFNOT $LIS8 THEN GO TO ST3 !OPTION IS NULL GO TO CHECK NEXT IF $LIS9 = MS THEN [SIO_1;BUFA_BF+1;\ LIS9_LIS9+1] IF $LIS9=" " THEN GO TO ST3 IF $LIS9 = AS THEN [SUBF_410K;GO TO ST3] IF $LIS9 = BR THEN[CK,SUBF_310K;\ DT_5; GO TO ST3] IF $LIS9 = BN THEN[SUBF_310K; \ GO TO ST3] IF $LIS9 = BA THEN[CK,SUBF_2310K;TYP_0;\ DT_7;GO TO ST3] IF $LIS9 = MT THEN GO TO ST3 B IF $LIS9 = SA THEN[EOFF_1;GO TO ST2] IF $LIS9 = IH THEN[LDR_20000K;GO TO ST2] ! STER1:DO[ERS_56; RETURN] ! ! CHECK FOR OP2 ! ST3: IF $LI12#3 THEN GO TO ST2 ! IF $LIS13 = SA THEN[EOFF_1;GO TO ST5] IF $LIS13 = IH THEN[LDR_20000K;GO TO ST5] ! GO TO STER1 !ILLEGAL OPTION ! OPT2 WAS FOUND IN OP1 LOCATION SO ! ADJUST ADDRESSES AND SKIP ! OPT2 CHECK. ! ! ST2: DO[LIS21_[LIS17_LIS13]+4] ST5: OPEN.(IDCB1,$LIS1,N.OPL ,SUBF+1) ! ! SEE IF CHECK SUM REQUIRED ! IF [ID_ $ ( IDCBA +1)] =B.A THEN [TYP_0;CK_1;SUBF_2310K],\ ELSE[IF ID=B.R THEN [CK_1;SUBF_310K]] IF $LIS17>0 THEN F1_$LIS17-1 IF $LIS21>0 THEN F2_$LIS21 ! ST6: SUBF_(SUBF AND 100K)+LDR !SET OUTPUT FUNCTION IF $LIS9=AS THEN SUBF_SUBF AND 177677K ST10: OPEN.(IDCB2,$LIS5,$(@N.OPL+5),SUBF) ! ! BOTH IN AND OUT ARE OPEN -- ! LEADER HAS BEEN PUNCHED IF NOT SUPPRESSED. ! ! UNTIL F1=0 DO[READF($SPDCB,.E.R ,$BUFA,128,ALN);IER.;\ IF ALN<1 THEN[F1_F1- 1; IF IFBRK() THEN GO TO BRK]] ST15: READF(IDCB1,.E.R ,$BUFA,128,ALN) IF IFBRK() THEN[\ IF BREAK THEN BRK: MSS.(0);GO TO KILL] ! SEND BREAK ERROR AND GO FLUSH THE FILE IER. IF ALN>0 THEN GO TO ST20 ! DATA? ! ! NO DATA -- EITHER EOF OR ZERO REG ! ! ! END OF XFER? ! ! IF [F2_F2-1] THEN [IF EOFF THEN[ALN_-1;\ GO TO ST22],ELSE GO TO ST25] ST18: ALN_-1 IFNOT LDR THEN GO TO ST22 ! IF INHIBIT BIT SET-DONE ! GO TO KILL !DONE - NO EOF REQUIRED ! ST20: DO [IF SIOI THEN [ALN_[\ IF $BUFA<0 THEN-$BUFA,ELSE\ ($BUFA+1)>-1];ID_BUFA+1],ELSE\ ID_BUFA ;IF CK THEN[\ CK.SM($ID,TYP)?[GO TO ABO];ALN_($ID-<8)+(1-TYP)*3]] FLG_1 !SET FLAG TO SAY WE WROTE A RECORD ST22: IF ALN>0 THEN[IF SIO THEN[$BUFF_-ALN;ALN_ALN+1]] WRITF(IDCB2,.E.R ,$BUFF,AL?zN) IER. IF ALN= -1 THEN[IFNOT F2 THEN GOTO KILL,\ ELSE GO TO ST25 ] IF ALN THEN GO TO ST15 ST25: EXEC (13,$(IDCBA+3),EQT5) IF(EQT5 AND 37400K)=400K THEN [MSS.(6);\ EXEC(7)] GO TO ST15 ! ABO: ERS_7 !SEND CHECK SUM ERROR KILL: RETURN !EXIT END ! ! END END$ w  92064-18045 1650 S C0122 &CO.PK CRTG COPY-PACK SUB             H0101 οSPL,L,O,M,C ! NAME: CO.PK ! SOURCE: 92064-18045 ! RELOC: 92064-16017 ! PGMR: G.L.M. ! ! *************************************************************** ! * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * ! * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * ! * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* ! * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ! *************************************************************** ! ! NAME CO.PK(7) " 92064-16017 REV.1650 761104" ! ! ! LET OPEN.,FCONT,READF,WRITF,MSS. BE SUBROUTINE,EXTERNAL LET .P1,.P2,IDCB1,IDCB2,I.BUF \ BE INTEGER,EXTERNAL LET CLD.R BE SUBROUTINE,DIRECT,EXTERNAL ! ! LET IFBRK BE FUNCTION,EXTERNAL ! LET PK.. BE SUBROUTINE LET WRIT,DCHCK BE SUBROUTINE,DIRECT ! LET DIR BE INTEGER LET BL.S BE CONSTANT (20123K) !BLANK B LET A BE CONSTANT (0) LET B BE CONSTANT (1) ! ! ! ! PK..: SUBROUTINE(NO,LIS,ER) GLOBAL CO..: ASSEMBLE "EQU PK.." ASSEMBLE "ENT CO.." ! ! DIR2_0 !THIS PREVENTS WRITING OVER SOME !WHERE UNKNOWN IN THE KILL SECT. ! ! ! SETUP CMND ADDRESSES AND USE RESULT BUFFER(LIS) ! AS FILE# & TYPE TABLE ! C2_[C2T_[C1_[C1T,FTAB_ @LIS]+1]+3]+1 ! ! SET ADDRESS OF FILE TYPE WORD AND I.BUF ! TYPE_[I,IBUF_@I.BUF]+3 ! ! DETERMINE "FROM,TO, OR DEFAULT LU'S" ! CHECK FOR BAD PARM,IF SO EXIT-ERR 56 ! ALLOW POS AND NEG LU ! ! IF $C1T=3 THEN GO TO ER56 ,\ ELSE [IFNOT $C1T THEN C1_4 ,\ !DEFAULT TO 4 ELSE [IF [C1_ $C1] < 0 THEN C1_ - C1]] ! ! IF $C2T=3 THEN [\ ER56: ER_56 ;RETURN] , \ ELSE [IFNOT $C2T THEN C2_5 , \ !DEFAULT TO 5 fh ELSE [IF [C2_ $C2] < 0 THEN C2_ - C2]] ! ! IF C1=C2 THEN GO TO ER56 !FROM AND TO MUST BE DIFFERENT ! ! ! ! ! ! LOCK FROM UNIT ! VIA A CALL TO D.R ! .P2_ - C1 !SET NEG LU FOR CALL .P1_ 3 !FUNCTION CODE FOR LOCK CLD.R ! GO SCHED D.R ! ! ! CHECK FOR D.R ERRORS ! IF [ER_ $[TEMP_ $B]] THEN RETURN !ERROR CHECK AND SAVE B ! ! ! CALCULATE DIRECTORY ADDRESS ! FOR THIS UNIT ! AND REJECT IF DIRECTORY NOT VALID ! ! IF ($$[T2_$(TEMP+2)-3]) THEN [ER_24;GOTO KILL] DIR_$(T2+1) ! ! ! ! ! ! ! ! ! ! ! LOCK "TO" UNIT ! CHECK FOR LOCK ERRORS ! PK.2: .P2_ - C2 ! SET NEG LU FOR CALL CLD.R ! CALL D.R ! IF[ER_ $[TEMP_ $B]] THEN GO TO KILL ! ! SET CARTRIDGE DIR ADDRESS ! DIR2_ $ ( TEMP+2 ) ! ! OPEN BOTH UNITS IN ASCII MODE ! CALL OPEN.(IDCB1, C1,0,400K) CALL OPEN.(IDCB2, C2,0,400K) ! ! REWIND BOTH UNITS ! CALL FCONT(IDCB1,ER,400K) CALL FCONT(IDCB2,ER,400K) ! ERROR CHECK NEEDED HERE? ! ! FILEX_ 1 !PRESET FILE# PAST DIR ! ! STP_ $(DIR-1) DIR_DIR-4 !ADJUST FOR PACK LOOP ! ! START LOOP FOR PACK DIRECTORY UPDATE ! THIS ROUTINE ALSO BUILDS A FILE# AND TYPE TABLE ! FOR ALL NON PURGED FILES ! ! SIGN SET=BINARY,LOW 4 BITS GIVE FILE # ON FROM DEVICE ! 0=END OF TABLE ! ! ! ! AGAIN: $FTAB_0 !SET END OF TABLE AG2: DIR_DIR+4 FILEX_FILEX+1 ! CALL READF(IDCB1,ER,I.BUF,128,LEN) !READ DIRECTORY ENTRY IF ER THEN GO TO KILL IFNOT (LEN= -1) THEN GO TO MORE !IF NOT EOF,CONTINUE ! ! FOUND EOF--MUST BE AT END OF DIRECTORY ! IF ($DIR=0) OR (DIR=STP) THEN \ [WRIT ;GO TO CPY],\ OK-WRITE EOF ELSE [ER_ 24 ;GO TO KILL] ! ! ! MORE: CALL DCHCK !GO CHECK DIRECTORY JUST READ IF $DIR=0 THEN [ ER_ 24 ; GO TO KILL] !CHECK MEM COPY IF $DIR < 0 THEN GO TO AG2 ! PURGED SO SKIP IT $FTAB_ [IF [I_ $(DIR+3)]= BL.S THEN \ FILEX,\ ELSE FILEX OR 100000K ] ! ! FTAB_FTAB+1 !BUMP TABLE POINTER ! ! TYPES MUST COMPARE ! IF I # $TYPE THEN [ER_ 24 ; GO TO KILL] ! ! MOVE IN MEMORY RESIDENT PORTION OF ENTRY ! ! TEMP_ DIR FOR I_@I.BUF TO @I.BUF+3 DO\ [ $I_ $TEMP;TEMP_ TEMP+1] ! CALL WRIT !WRITE NEW ENTRY ! ERROR CHECK?? ! GO TO AGAIN ! ! ! ! ! CPY: FTAB_ @LIS !RESET TABLE POINTER OUT_ @IDCB2 +3 IN1_ @IDCB1 +3 ! CPY2: IFNOT $FTAB THEN GO TO KILL ! ! SET OR CLEAR BINARY(M) BIT IN DCB--SUB FUNCTION ! $IN1_ [IF $FTAB < 0 THEN $IN1 OR 100K ,\ ELSE $IN1 AND 177677K ] ! $OUT_ [IF $FTAB < 0 THEN $OUT OR 100K ,\ ELSE $OUT AND 177677K] ! ! LOCATE ABS FILE# ON FROM DEVICE ! CALL FCONT(IDCB1,ER,2700K,($FTAB AND 17K)) ! CPY3: CALL READF(IDCB1,ER,I.BUF,128,LEN) CALL WRIT IF ER THEN GO TO KILL ! IF IFBRK THEN [MSS.(0);GO TO KILL] IF LEN= -1 THEN [FTAB_ FTAB+1;GO TO CPY2],\ ELSE GO TO CPY3 ! ! ! ! KILL: .P1_5 !FUNCTION CODE FOR LOCK CLEAR .P2_- C1 CLD.R !GO CLEAR LOCK ON FROM DEVICE ! .P2_- C2 ! ! MARK "TO" UNIT INVALID ASSEMBLE "LDA DIR2 FETCH CRDIR POINTER" ASSEMBLE "SZA,RSS IF ZERO-- " ASSEMBLE "JMP ALMST THE WORK WAS ABORTED" ASSEMBLE "ADA N3 BACK UP TO VALIDITY ADDRESS" ASSEMBLE "LDB 0,I FETCH IT" ! ASSEMBLE "LDA DEFX ADDRESS OF NON-ZERO WORD" ASSEMBLE "EXT PMOVE" ASSEMBLE "JSB PMOVE" ASSEMBLE "OCT 1" ALMST: CLD.R !GO CLEAR "TO" DEVICE LOCK RETURN ! ! ! ! ! ! DEFX: ASSEMBLE "DEF *" N3: ASSEMBLE "OCT -3" END ! ! WRIT: SUBROUTINE DIRECT CALL WRITF(IDCB2,ER,I.BU>F,LEN) RETURN END ! DCHCK: SUBROUTINE DIRECT IF LEN<4 THEN GO TO BDIR !MUST HAVE AT LEAST 4 WORDS IF ($( @ I.BUF+3) AND 177400K) # 20000K \ !CHAR 7 MUST BE THEN [\ !ASCII BLANK BDIR: ER_24;GO TO KILL] RETURN END ! ! END END$   92064-18046 1650 S C0122 &DL..C CRTG DIRECTORY LIST SUB             H0101 !,ASMB,R,L,C * NAME: DL.. * SOURCE: 92064-18046 * RELOC: 92064-16017 * PGMR: G.L.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM DL..,7 92064-16017 REV.1650 760808 * * EXT TMP.,.DRCT,OPEN.,IDCB1,IDCB3,.ENTR,$CDIR EXT PNAM,READF,CLD.R,.P1,.P2,.P3,I.BUF EXT WRITF,CONV.,.MVW,RWNDF,RMPAR * ENT DL.. * SUP * CNT NOP LST NOP ER NOP * DL.. NOP JSB .ENTR DEF CNT * * OPEN LIST FILE * JSB .DRCT DEF TMP. FETCH DIRECT ADDR OF LIST INFO * * ADA .3 STA TMP1 SET ADDRESS OF LIST FILE LU JSB OPEN. DEF RTN OPEN LIST DEVICE\LU DEF IDCB3 DEF TMP. DEF TMP1,I DEF ZERO OPTION * RTN LDB BLNK,I JSB .DRCT IBUFA DEF I.BUF DEFINE INPUT BUFFER STB A,I SET FIRST WD BLANK INA ALLOW FIRST WORD FOR BLANK STB A,I ALSO SECOND WORD INA STA IBUF ADDRESSES ADA .3 STA IBUF2 * LDA LST,I FETCH PARM TYPE FLAG SZA,RSS IF NULL THEN JMP ALL COMPLETE LIST REQUESTED * CPA .3 ALPH NOT ALLOWED JMP ER56 * ISZ LST ADVANCE TO REQUESTED LU LDA LST,I FETCH IT SZA,RSS IF ZERO JMP ALL THEN DO EVERYTHING * SSA,RSS ALLOW BOTH POS AND NEG CMA,INA STA .P2 SAVE FOR D.R CALL JSB LUTNG GO DO LU THING JMP DL..,I GET OUT * SKP * * * .5 DEC 5 .3 OCT 3 .2 OC+6T 2 * * * N2 OCT -2 N3 OCT -3 N4 OCT -4 N13 DEC -13 .4 OCT 4 .6 OCT 6 .10 DEC 10 .18 DEC 18 .128 DEC 128 LUAD NOP LUST NOP IBUF NOP IBUF2 NOP TMP1 NOP VAL NOP DIRAL NOP LEN NOP HBTE OCT 177400 HBLK OCT 20000 ZERO NOP N1 OCT -1 * * * SKP WLEN NOP WRIT NOP STA WBUF STB WLEN JSB WRITF DEF WRITN DEF IDCB3 DEF ER,I WBUF NOP DEF WLEN WRITN LDA ER,I SZA JMP CLEAR JMP WRIT,I * SPC 5 * * SPACE NOP CLB,INB LDA BLNK ADDR OF BLANK WORD JSB WRIT JMP SPACE,I * * STOP NOP SKP * * LIST TYPE ZERO TABLE AND ALL MOUNTED CARTRIDGES * ALL JSB .DRCT DEF $CDIR FETCH DIRECT ADDR OF CARTRIDGE DIR ADA N1 BACK UP TO STOP ADDRESS LDB A,I FETCH IT STB STOP SET STOP ADDR INA ADVANCE TO FIRST ENTRY NXT STA DIRAL SAVE ADDRESS CPA STOP END?? CLA,RSS YES --FORCE EXIT LDA A,I FETCH NEXT ENTRY SZA,RSS IF ZERO- JMP DL..,I ALL DONE CMA,INA SET LU NEG STA .P2 AND SAVE FOR D.R * JSB LUTNG GO DO THIS LU LIST * LDA DIRAL FETCH CART DIR ADDR ADA .4 ADVANCE TO NEXT ENTRY/END STA CNT INDICATE LOCK CLEAR JMP NXT CONTINUE SKP * * DIRECTORY LIST OF MOUNTED CARTRIDGE * LUTNG NOP CMA,INA MAKE LU POS STA TMP1 SAVE IT FOR CONVERSION JSB SPACE JSB CONV. DEF RTNC CONVERT DIRECTORY DEF TMP1 LU DEF LUXA FOR DEF .2 HEADING * RTNC LDA .3 SET FUNCTION CODE STA .P1 FOR LOCK JSB CLD.R VIA D.R * JSB RMPAR DEF *+2 DEF .P1 FETCH RETURN PARMS * LDA .P1 FETCH ER}ROR WORD SZA EVERYTHING OK? JMP OK? GO CHECK FOR EXISTING LOCK * STA CNT INDICATE LOCK SET JSB OPEN. DEF LSTRT GO OPEN DEF IDCB1 LU TO BE DEF TMP1 LISTED DEF ZERO * LSTRT JSB RWNDF REWIND IT DEF RWNDT DEF IDCB1 DEF ER,I * RWNDT LDB .10 ITLK LDA LUHDA ADDR OF HEAD MESS JSB WRIT WRIT IT * CLA LDB .P1 FETCH ERROR RETURN SZB IF IT WAS LOCKED JMP LUTNG,I ALL DONE * * FETCH ADDRESSES * LDA .P3 FETCH CRDIR ENTRY+4(NEXT UNIT) ADA N2 BACK UP TO ACTUAL DIRAD(CARTRIDGE) LDB A,I FETCH ACTUAL DIRECTORY ADDRESS * * THIS DEPENDS ON MC DOING THE RIGHT THING * STB LUAD SAVE IT ADB N1 BACK UP LDB B,I TO STOP ADDRESS AND FETCH STB LUST SAVE IT ADA N1 BACK UP CARTRIDGE DIR POINTER TO VALIDITY ADDR LDA A,I FETCH IT STA VAL SAVE IT * * READ JSB READF DEF LURTR DEF IDCB1 DEF ER,I DEF IBUF,I SKIP BLANK WORD DEF .128 DEF LEN * * LURTR LDB LEN CPB N1 CHECK FOR EOF JMP EOF GOT IT * * * CHECK VALIDITY OF DIRECTORY * LDA LUAD FETCH CURRENT DIR ADDR CPA LUST END OF DIR? JMP ER24 DIRECTORY MIS-MATCH ERROR * * LDA LEN FETCH READ LENGTH ADA N4 MUST HAVE READ AT LEAST 4 WORDS SSA OK? JMP ERN29 NO--BAD DIRECTORY ON TAPE LDA IBUF2,I FETCH WORD 4 OF ENTRY AND HBTE HIBTE LEFT BYTE CPA HBLK MUST CONTAIN ASCII BLANK RSS IT'S OK JMP ERN29 NOPE--BAD DIRECTORY * * DIRECTORY ENTRY ON TAPE IS OK * LDA VAL,I IF MEMORY COPY SZA IS INVALID JMP PDIR JUST LIST FROM CARTRIDGE * * LDA LUAD,I FETCH NEXT ENTRY SZA,RSS END?? JMP ER24 END BUT NO EOF * SSA THIS ENTRY PURGED? JMP WRTN2 YES GO BUMP MEM POINTER AND GET NEXT * * MOVE IN MEM RES PORTION * * LDA LUAD FETCH MEM POINTER LDB IBUF DESTINATION ADDRESS JSB .MVW DEF .4 NOP * * PDIR JSB SPACE LDA IBUFA WRITE FIRST FOUR LDB .6 WORDS OF ENTRY (PLUS 2 BLANK WORDS) JSB WRIT * * LDA BLNK,I STA IBUF2,I LDA IBUF2 FETCH BUFFER ADDR FOR COMMENT FIELD LDB LEN FETCH READ LEN ADB N3 COMPENSATE FOR NAME JSB WRIT GO WRIT COMMENTS * WRTN2 LDA LUAD FETCH MEM DIR ADDR ADA .4 STA LUAD ADVANCE TO NEXT ENTRY/END JMP READ * SKP OK? CPA N13 RSS JMP CLEAR NOT LOCK ERROR --GET OUT * LDA .P3 FETCH CART DIR POINTER ADA N1 BACK UP TO LOCK WORD LDA A,I FETCH IDSEG ADDR OF LOCKING PROG LDB PGNMA ADDRESS FOR PROGRAM NAME JSB PNAM GO MOVE NAME IN LDB .18 FETCH LENGTH FOR HEAD TO INCLUDE LOCKERS NAME JMP ITLK * * * LUHDA DEF LUHD LUHD ASC 13, LU DIRECTORY LOCK ASC 2,BY PGNM BSS 3 PGNMA DEF PGNM LUXA EQU LUHD+3 BLNK DEF LUHD * * CLEAR STA ER,I JSB OFLK JMP DL..,I * * * OFLK NOP LDA CNT SZA CONTINUE IF LOCK WAS SET JMP OFLK,I LDA TMP1 CMA,INA STA .P2 LDA .5 FETCH FUNCTION CODE FOR LOCK CLEAR STA .P1 JSB CLD.R JMP OFLK,I * * * EOF JSB OFLK JMP LUTNG,I * * ERN29 LDA N29 RSS ER24 LDA .24 RSS ER56 LDA .56 JMP CLEAR * .24 DEC 24 N29 DEC -29 .56 DEC 56 * * A EQU 0 B EQU 1 * END    92064-18047 1650 S C0122 &LI..C CRTG FILE LIST SUB             H0101 SPL,L,O,M,C ! NAME: LI.. ! SOURCE: 92064-18047 ! RELOC: 92064-16017 ! PGMR: G.A.A. ! MOD: G.L.M. ! ! *************************************************************** ! * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * ! * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * ! * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* ! * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ! *************************************************************** ! ! NAME LI..(7) " 92064-16017 REV.1650 761010" ! ! ! LI.. IS THE RTE FMGR FILE LIST MODULE ! IT IS ENTERED ON COMMAND ! ! LI,NAMR,TY ! ! WHERE: ! ! ! NAMR IS THE NAME REFERENCE INCLUDING ! SECURITY CODE AND DISC ID ! ! TY IS THE LISTING TYPE AND IS ASCII: ! ! S OR A OR NULL SOURCE WITH LINE NUMBERS ! B BINARY DUMP ! D DIRECTORY HEAD ONLY ! ! ! EACH LISTING WILL BE PROCEEDED BY THE HEAD: ! ! NAMEL T=XXXXX IS ON PK XXXXX USING XXXX BLKS R=XXXX ! ! ! ! ! ! S FORMAT IS A BLANK FOLLOWED BY 4 DIGIT ! LINE NUMBER FOLLOWED BY TWO BLANKS FOLLOWED ! BY THE RECORD. ! ! B FORMAT IS : ! A)THE RECORD HEAD: REC# XXXXX ! B)N LINES FORMATED AS FOLLOWS ! 8 5-DIGIT OCTAL NUMBERS SEPERATED BY BLANKS ! AND FOLLOWED BY A "*" FOLLOWED BY THE ! 16 ASCII CHARACTERS THE DIGITS REP. ! NON-PRINTING CHARACTERS WILL BE FILLED ! WITH BLANKS ! ! D FORMAT IS THE HEAD ONLY ! ! ! ! DEFINE EXTERNALS ! LET .TTY BE FUNCTION,EXTERNAL LET JER. BE SUBROUTINE,EXTERNAL,DIRECT ! LET IDCB1,IDCB3,BUF.,.E.R ,\ TMP.,N.OPL BE INTEGER,EXTERNAL LET OPEN.,LOCF,WRITF,READF,EXEC,\ CONV.,JER. \ BE SUBROUTINE,EXTERNAL ! ! DEFINE INTERNAL ROUTINES ! LET SETA,WRIT,SPACE,DOIT,TCDE BE SUBROUTINE,DIRECT LET XEXTL BE SUBROUTINE,GLOBAL ! ! DEFINE CONSTANTS ! HL LET BL.T BE CONSTANT (20124K)! T LET EQ.BL BE CONSTANT (36440K)!= LET BL.I BE CONSTANT (20111K)! I LET S.BL BE CONSTANT (51440K)!S LET O.N BE CONSTANT (47516K)!ON LET BL.C BE CONSTANT (20103K)! C LET R.BL BE CONSTANT (51040K)!R LET BL.L BE CONSTANT (20114K)! L LET U.BL BE CONSTANT (52440K)!U LET BL.U BE CONSTANT (20125K)! U LET S.I BE CONSTANT (51511K)!SI LET N.G BE CONSTANT (47107K)!NG LET BL.B BE CONSTANT (20102K)! B LET L.K BE CONSTANT (46113K)!LK LET R.EQ BE CONSTANT (51075K)!R= LET A.BL BE CONSTANT (40440K)!A LET B.BL BE CONSTANT (41040K)!B LET D.BL BE CONSTANT (42040K)!D LET R.E BE CONSTANT (51105K)!RE LET C.NO BE CONSTANT (41443K)!C# LET DST BE CONSTANT (25052K)!** ! ! DEFINE BUFFER SET UP ! LET LSTBF(2),LNNO,BLWD,I.BUF(128) BE INTEGER,GLOBAL LI..: SUBROUTINE(NOC,LIS ,ER) GLOBAL ! OPFL_401K !SET DEFAULT OPEN OPTION NUL_0 !PRESET NULL PRAM FLAG TYPF_($([LIS1_@LIS +1]+4) AND 177400K)+40K IF TYPF=A.BL THEN GO TO STYP !CHECK FOR IF TYPF=40K THEN[NUL_1;GO TO STYP]!LEGAL IF TYPF=D.BL THEN GO TO TYPOK !OPTIONS IF TYPF=B.BL THEN[OPFL_311K;GO TO TYPOK]!NULL,A,S,B,D IF TYPF#S.BL THEN [ER_56;RETURN]!NO; RETURN 56 ! STYP: TYPF_S.BL !FOURCE NULL,ATOS ! TYPOK:OPLS_ @TMP.+3 !GET LIST UNIT OP LIST ! CALL OPEN.(IDCB3,TMP.,$OPLS, 0) !OPEN LIST FILE ! CALL OPEN.(IDCB1,$LIS1,N.OPL,OPFL) !OPEN FILE TO BE LISTED ! CALL LOCF(IDCB1,.E.R ,LP,LP,LP,LP,FLU,FTYP) IFNOT NUL THEN GO TO OK !IF NULL THEN CHOSE THE RIGHT OPTION IF $(@IDCB1+3) AND 100K THEN[TYPF_ B.BL; GO TO OK] ! OK: TCDE !GO GET LIST DEVICE TYPE CODED P36_[P3_@LIS +4]+33 !SET UP LIST ADDRESSES ! FOR T_ P3 TO P36 DO[$T_20040K] ! BLANK THE BUFFER P_P3-1 SETA(BL.T) !SET BLANK T SETA(EQ.BL) !SET = BLANK P_P+2 CONV.(FTYP,$P,5) !SET TYPE SETA(BL.I) !SET BLANK I SETA(S.BL) !SET S BLANK SETA (O.N) !SET ON ! DO SETA(BL.L);SETA(U.BL);T_FLU ;N_2 ! ! P_P + N/2 CONV.(T,$P,N) N_13 ! WRHD: TB_[BF_[IF TYPF=S.BL THEN @LSTBF,ELSE @BUF.]]+1 $BF_20040K !BLANK FIRST WD P_LIS1 FOR T_TB TO TB+N DO [$T_$P;P_P+1] !MOVE LINE IF LIS #3 THEN[$([P_TB+1]+1)_DST;\IF FACK FILE REPLACE NAME $P_DST;$TB_DST]! WITH "******" WRIT ! WRITE THE HEAD ! IF TYPF=D.BL THEN GOTO EOF !DONE IF HEAD ONLY SPACE !SPACE A LINE RC_1 NEXT: READF(IDCB1,.E.R ,I.BUF,128,L) ! READ RECORD ! JER. !CHECK FOR ERRORS IF L <0 THEN GO TO EOF !SOFT EOF? N_L+3 IF TYPF=S.BL THEN[CONV.(RC,LNNO,4);BLWD_20040K;\ WRIT;RC_RC+1;GO TO NEXT] !JUST LISTING - GO WRIT ! F_@I.BUF CALL DOIT GO TO NEXT ! ! ! EOF: WRITF(IDCB3,E.R,$BF,-1) !WRITE EOF JER. RETURN END ! ! DOIT: SUBROUTINE DIRECT P_BF !INITILIZE BUFFER POINTER SETA(R.E) ! SET UP SETA(C.NO) ! REC# XXXXX SETA(20040K) P_P+2 CONV.(RC,$P,5)! SET NUMBER SPACE !SPACE A LINE N_5 !WRITE THE RECORD NUMBER WRIT ! SPACE !SPACE A LINE ! NEXTL:IFNOT L THEN [RC_RC+1;RETURN] !IF NO DATA GET NEXT P_[ST_[WP,T_TB]+27]+1 !INITILIZE POINTERS REPEAT 36 TIMES DO[ $T_20040K; T_T+1] UP_ t-1 !SET UPPER FLAG TRUE REPEAT 8 TIMES DO THRU PTSTP IF[T2_ [T_$F]AND 77400K]>57400K THEN GOTO BLANK IF T2>17777K THEN GOTO OKUP ! BLANK:T_ (T AND 177K)+20000K ! OKUP: IF [T2_($F AND 177K)]<140K THEN[IF T2> 37K THEN\ GO TO OKLOW] ! T_ (T AND 77400K) +40K ! OKLOW:DO[ $P_T AND 77577K;P_P+1] ! T2_ [T_$F-<1] AND 1 ! $WP_[IF UP THEN (T2-<8)+([T_T-<3] AND 7)+30060K,\ ELSE T2 + 20060K] ! REPEAT 2 TIMES DO[ \ $[WP_WP+1]_(([T_T-<3] AND 7)-<8)+\ ([T_T-<3] AND 7)+ 30060K] ! IF UP THEN GOTO PTSTP ! $[WP_WP+1]_(((T-<3) AND 7)-<8)+30040K ! PTSTP:DO[WP_WP+1;UP_NOT UP;F_F+1;IFNOT [L_L-1] THEN\ GO TO PREPR] ! ! PREPR:IF $[P_P-1]=20040K THEN GO TO PREPR !FIND LAST !NON BLANK N_ P-TB+1 !PRINT LENGTH ! $ST_ $ST +12K !SET THE STAR SEPERATOR ! WRTIT:WRIT !TRANSMIT THE LINE ! GOTO NEXTL !GO DO NEXT LINE ! ! END ! ! SETA: SUBROUTINE(PRA)DIRECT !STEP P AND SET PRA IN P INDIRECT $[P_P+1]_PRA RETURN END ! ! WRIT: SUBROUTINE DIRECT!WRITE ON LIST BUFFER AT BF IF LP !OR TB IF NOT LP WITH LENGTH N+LP !IF TTY -LIMIT LENGTH TO 72. IF TTY THEN[IF N>36 THEN N_36] WRITF(IDCB3,.E.R ,$(TB-LP),N+LP) JER. RETURN END ! ! SPACE:SUBROUTINE DIRECT !SPACE THE LIST DEVICE N_1 !SET LENGTH TO ONE WORD DO[T_$TB;$TB_ 20040K]!SET BLANK IN BUFFER WRIT !WRIT BLANK LINE $TB_T !RESTORE OLD CONTENTS RETURN !RETURN END ! ! TCDE: SUBROUTINE DIRECT CALL LOCF(IDCB3,.E.R ,LP,LP,LP,LP,LLU) !GET LIST LU ! CALL EXEC(13,LLU,EQT5,DUM,SPC)!GET LIST LU TYPE CODED ! ! ! SET LINE PRINTER FLAG ! ! ! CHECK FOR DVR12 OR GREATER ! IF[EQT5_EQT5 AND 374:H00K] > 4400K THEN [ LP_1;GO TO TT] LP_[IF EQT5=2400K AND (SPC#0) THEN 1, ELSE 0 ] TT: TTY_.TTY(LLU) RETURN END ! ! XEXTL:SUBROUTINE(XLEN,XBUF,XRC) GLOBAL TB_[BF_ @BUF. ] +1 L_XLEN F_XBUF RC_XRC TCDE !GET LIST DEVICE TYPE CODED CALL DOIT SPACE SPACE RETURN END END END$ Ð   92064-18048 1709 S C0122 &MC..C CRTG MOUNT CARTRIDGE SUB             H0101 ASMB,R,L,C * NAME: MC.. * SOURCE: 92064-18048 * RELOC: 92064-16017 * PGMR: G.L.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM MC..,7 92064-16017 REV.1709 770224 * EXT EXEC,CLD.R,.P1,.P2,.P4,.DRCT,$DIRS EXT PMOVE,.ENTR,$CDIR,$LCTU,$RCTU EXT $LIBR,$LIBX,OPEN,IDCB1 ENT MC.. * STOP NOP STAT OCT 100015 CHNL NOP SUBC NOP CDIR NOP N3 OCT -3 CNT NOP LST NOP ER NOP * MC.. NOP JSB .ENTR FETCH CALL DEF CNT PARMS * LDA LST,I FETCH TYPE PARM CPA .1 MUST BE NUMERIC RSS JMP ER56 NOT NUMERIC--EXIT * ISZ LST ADVANCE LDA LST,I TO LU AND FETCH IT SSA ALLOW POS CMA,INA AND NEG LU SZA,RSS JMP ER56 0 NOT ALLOWED STA LU SAVE IT FOR NOW * JSB EXEC DO DEF EXR1 STATUS DEF STAT ON THIS DEF LU LU DEF .P1 TEMP FOR WORD 5 DEF CHNL TEMP FOR WORD 4 DEF SUBC TEMP FOR NEW STATUS WORD * EXR1 JMP EX20 BAD LU LDA .P1 ISOLATE AND TYPE DRIVER TYPE CPA DV05 MUST BE 05? CCE,RSS SET E FOR LATER USE JMP ER56 ELSE INPUT ERROR * * DRIVER TYPE OK--MUST BE SUB CHANNEL 1 OR 2 * LDA SUBC FETCH WORD CONTAINING SUB CHNL AND B37 ISOLATE SUB CHNL SZA,RSS CONTINUE IF NON ZERO JMP ER56 BAD PARAMETER ADA N3 CAN'T BE GREATER THAN 2 SSA,RSS WE LL? JMP ER56 TOO LARGE * * * REQUEST CARTRIDGE DIRECTORY LOCK * FROM D.R * CLA SET LU PARM=0 STA .P2 FOR D.R CALL LDA XEQT SET ID STA .P4 FOR CALL--THIS WORD IS USED AS LOCK LDA .11 SET FUNCTION STA .P1 CODE FOR MASTER LOCK JSB CLD.R CALL D.R FOR LOCK * LDA B,I FETCH ERROR RETURN SZA SKIP IF OK JMP EREX ELSE EXIT(ERROR CODE IN A) * * CALCULATE ADDRESSES FOR SEARCH OF DIRECTORY * JSB .DRCT FETCH DIRECT DEF $CDIR ADDRESS OF CARTRIDGE DIRECTORY STA CDIR SAVE DIRECT ADDRESS CCB BACK UP ADB A TO LEGNTH(A-1) STB STOP SAVE ADDRESS OF STOP WORD * * SEARCH FOR DUPLICATE LU AND FOR ROOM * A=START ADDRESS,B=STOP ADDRESS * SRCH LDB A,I FETCH LU WORD FOR THIS CARTRIDGE CPB LU THIS CARTRIDGE--DUPLICATE? JMP DUPID YES--ERROR EXIT * SZB,RSS ROOM HERE?? JMP ROOM YEP--GO MOUNT IT ADA .4 NOPE--ADVANCE TO NEXT ENTRY CPA STOP,I --END OF SEARCH? JMP DIRFL YES--DIR FULL EXIT(ERROR 25) JMP SRCH NOPE--CONTINUE SEARCH * * FOUND ROOM A=FWA B=0 * ROOM STB ER,I CLEAR ERROR RETURN STA CNT SAVE ADDRESS OF FWA OF CARTRIDGE DIRECTORY * * * GO PRIV--FIND FREE DIRECTORY SPACE--ASSIGN IT TO THIS LU * * JSB .DRCT DEF $DIRS FETCH ADDRESS OF DIRECTORY HEAD INA ADVANCE TO FIRST ASSIGNED WORD CCB SET (B) NON ZERO--IN CASE 0 DIRECTORY SPACE ALLOCATED * JSB $LIBR GO NOP PRIV * NEXT CPA $DIRS END OF SEARCH? JMP OUT YES * LDB A,I FETCH CURRENT ASSIGNED FLAG SZB,RSS SKIP IF ASSIGNED JMP GOTIT FOUND A FREE ONE--USE IT * STA .P4 SAVE A WHILE CHECKING TO SEE IF REALLY ASS2bIGNED * * SEE IF THERE IS A MOUNTED CARTRIDGE WITH SAME LU-- * IF NOT---THEN THIS ONE CAN BE USED * LDA CDIR DIRECT ADDRESSES WERE SET EARLIER RE? LDB A,I FETCH FIRST ENTRY CPB .P4,I MATCH ASSISNED LU? JMP REAL YES SO THIS SPACE IS REALLY ASSIGNED--CONTINUE * SZB,RSS END? JMP FREE YES--USE LAST SPACE FOUND ADA .4 ADVANCE TO NEXT ENTRY CPA STOP,I END OF CARTRIDGE DIRECTORY JMP FREE THIS SHOULD BE IMPOSSIBLE(WOULD MEAN CRDIR FULL) JMP RE? GO CHECK THIS ONE * * REAL LDA .P4 RESTORE ADDRES FOR AVAILABLE DIR CHECK ADA .43 ADVANCE TO NEXT POSSIBLE SPACE JMP NEXT GO CHECK THIS ONE * .43 DEC 43 * * WERE STILL PRIV * FREE LDA .P4 RESTORE ADDRESS OF DIRECTORY SPACE GOTIT LDB LU FETCH REQUESTED LU STB A,I ASSIGN THIS DIRECTORY SPACE TO THIS LU INA ADVANCE TO VALIDITY WORD STB A,I SET DIRECTORY INVALID CLB B=0=OK EXIT * * OUT JSB $LIBX DEF *+1 DEF *+1 * SZB IF B=0 THEN CONTINUE JMP DIRFL ELSE NO ROOM * STA VALID SET ADDRESS OF VALIDITY WORD ADA .2 ADVANCE TO ADDRESS OF DIRECTORY SPACE STA DADD SETIT * * * DRIVER TYPE OK--SEE IF SAME CHNL * AS SYS CON. * LDA CHNL FETCH STATUS WD 4 AND B77 ISOLATE CHNL STA CHNL SAVE IT IN TEMP LDA .3 CALCULATE ADDRESS ADA SYSTY OF SYS TTY EQT WD 4 LDA A,I AND FETCH IT AND B77 NOW ISOLATE CHNL CPA CHNL SAME CHNL? JMP CONS YES--GO GET VALIDITY ADDRESS * * * SO---LU WORD SET * VALIDITY WORD SET * DIRECTORY WORD SET * * GO PRIV AGAIN AND WRITE NEW ENTRY * STVAL LDA LUAD ADDRESS OF BUF HOLDING ENTRY LDB CNT ADDRESS OF CARTRIDGE DIR FOR THIS ENTRY *  JSB PMOVE GO PRIV AND MOVE IT IN .4 OCT 4 * * SET VALIDITY WORD NON-ZERO * LDA LUAD FROM ADDRESS LDB VALID TO ADDRESS JSB PMOVE .1 OCT 1 * * SET UP NEG LU FOR OPEN CALL * LDA LU FETCH IT CMA,INA ZAP IT STA SUBC SAVE IN TEMP * * * BRING THE NEW DIRECTORY INTO MEMORY * IGNORE ALL ERRORS(EXCEPT BAD DIR -29) * * JSB OPEN DEF OPRTN DEF IDCB1 DEF CHNL DUMMY ERROR WORD DEF .25 DUMMY NAME PARM(ILLEGAL NAME) DEF Z.0 DEF Z.0 DEF SUBC * OPRTN CPA N29 IF NEG 29 THEN PASS IT ALONG STA ER,I * * * EREXZ CLA SET WORD USED FOR LOCK STA .P4 =0 LDA .11 SET UP STA .P1 FUNCTION CODE FOR DIRECTORY MANAGER JSB CLD.R GO CLEAR IT * * JMP MC..,I EXIT * * N29 DEC -29 .25 DEC 25 * * SPC 3 LUAD DEF LU SKP EX20 LDA .20 RSS ER56 LDA .56 EREX STA ER,I JMP MC..,I * DUPID LDA .12 RSS DIRFL LDA .25 STA ER,I JMP EREXZ GO CLEAR MASTER LOCK AND EXIT SPC 4 * N14 DEC -14 .56 DEC 56 .12 DEC 12 B37 OCT 37 * * CHECK SUB-CHANNEL FOR * 1=LCTU,2=RCTU * TDB4=WORD 3 OF STATUS REQUEST RETURN * E=1 * * * CONS LDA SUBC FETCH SPEC STATUS WORD AND B37 ISOLATE TRUE SUB CHNL LDB RCTU PRESET FOR RCTU CPA .1 LCTU???? LDB LCTU YES FETCH ADDRESS OF LCTU VALIDITY JSB .DRCT OCT 100001 USE THE B REG STA VALID JMP STVAL * * LCTU DEF $LCTU RCTU DEF $RCTU * LU NOP VALID NOP DADD NOP Z.0 NOP ***************** * TYPE OCT 37400 DV05 OCT 2400 SYSTY EQU 1675B .2 OCT 2 .3 OCT 3 .11 DEC 11 .20 DEC 20 B77 OCT 77 * A EQU 0 B EQU 1 XEQT EQU 1717B * LEN EQU * END    92064-18049 1650 S C0122 &PU..C CRTG PURGE SUB             H0101 WASMB,R,L,C * NAME: PU.. * SOURCE: 92064-18049 * RELOC: 92064-16017 * PGMR: G.L.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM PU..,7 92064-16017 REV.1650 760518 * EXT CLD.R,.P1,.P2,.P3,.P4,N.OPL EXT NAM..,.DRCT,.ENTR,PMOVE * ENT PU.. SPC 2 CNT NOP LST NOP ER NOP * PU.. NOP JSB .ENTR FETCH CALL DEF CNT PARMS * ISZ LST ADVANCE TO NAME PARM JSB NAM.. CHECK FOR DEF PU2 LEGAL DEF LST,I FILE NAME * PU2 STA ER,I SET ERROR RETURN SZA 0=OK,15=BAD NAME JMP PU..,I ERROR SO EXIT * * NAME OK- SETUP CALL TO D.R FOR * OPEN OF REQUESTED FILE. * LDA .10 SET FUNCTON STA .P1 CODE FOR D.R * JSB .DRCT FETCH DIRECT DEF N.OPL ADDRESS OF SUBPARAMETER STRING INA ADVANCE TO CR/LU PARM LDA A,I AND FETCH IT STA .P2 SET IT INTO CALL * LDA LST,I FETCH FIRST WORD STA .P3 OF NAME AND SET INTO CALL ISZ LST ADVANCE TO FINAL TWO WORDS DLD LST,I AND MOVE DST .P4 THEN INTO THE CALL * * CALL IS SETUP -SO DO IT * JSB CLD.R CALL D.R LDA B,I FETCH ERROR RETURN SZA,RSS OK? JMP OK YES--CONTINUE * CPA N130 CHECK FOR FOUND BUT LOCKED CCA,RSS YES--SET (A)=-1 AS UNLOCK FLAG JMP EREX NO--OTHER D.R ERROR--GO EXIT * OK STA CNT SAVE LOCK/UNLOCK FLAG IN TEMP INB f   ADVANCE RETURN PARM ADDRESS LDA B,I AND FETCH LU OF FILE SSA IF TYPE ZERO--NO LOCK TO CLEAR STA CNT SET -1 IN LOCK FLAG CMA,INA MUST HAVE BEEN NEG FOR NOW STA .P2 SAVE IT FOR UNLOCK * INB ADVANCE TO WORD HOLDING ADDRESS LDB B,I OF DIRECTORY ENTRY(FWA OF FILENAME) LDA N1A FETCH ADDRESS OF -1 JSB PMOVE GO PRIV AND SET FIRST WORD=-1 .1 OCT 1 MOVE 1 WORD * ISZ CNT NEED TO REMOVE LOCK? RSS YES-SET (A)=1 AND SKIP JMP PU..,I NO-EXIT ALL DONE(ERROR CODE CLEARED-RTN NAM..) * LDA .5 SET FUNCTION STA .P1 FOR UNLOCK JSB CLD.R CALL D.R FOR UNLOCK * LDA B,I FETCH ERROR RETURN EREX STA ER,I AND SET IT JMP PU..,I EXIT SKP .5 OCT 5 .10 DEC 10 * N1 OCT -1 N1A DEF N1 N130 DEC -130 * A EQU 0 B EQU 1 XEQT EQU 1717B END ,   92064-18050 1650 S C0122 &RN..C CRTG RENAME SUB             H0101 vASMB,R,L,C * NAME: RN.. * SOURCE: 92064-18050 * RELOC: 92064-16017 * PGMR: G.L.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM RN..,7 92064-16017 REV.1650 760709 * EXT CLD.R,.P1,.P2,.P3,.P4,NAM..,.ENTR EXT PMOVE,.DRCT,N.OPL ENT RN.. * SUP * * CNT NOP LST NOP ER NOP * RN.. NOP JSB .ENTR DEF CNT * * ENOUGH PARMS? * LDB .50 PRESET STB ER,I NOT ENOUGH PARMS ERROR LDA CNT,I FETCH NUMBER OF PARMS CPA .2 MUST HAVE AT LEAST 2 RSS YEP IT'S OK JMP RN..,I NOPE--GET OUT * LDA LST ADVANCE ADA .5 TO NEW-NAME STA TEMP SAVE IT'S ADDRESS JSB NAM.. NEW-NAME VALID NAME DEF RTN2 DEF TEMP,I * RTN2 STA ER,I SET ERROR CODE SZA CONTINUE IF OK JMP RN..,I ELSE EXIT * * SAVE WD27 OF IDSEG FOR PARM PASSING TO D.R * LDA XEQT IDSEG ADDRESS ADA .26 ADVANCE TO WD 27 STA CNT SAVE ADDRESS LDA A,I FETCH OLD VALUE STA W27 SAVE IT FOR EXIT LDA TEMP FETCH ADDRESS OF NEW-NAME ADA .2 ADVANCE TO THIRD WORD LDB CNT FETCH ADDR OF IDSEG WD27 JSB PMOVE GO PRIV AND MOVE WD3 (NUNAME) DOWN OCT 1 * * * SET UP REST OF PARAMETERS FOR D.R CALL * LDA .2 SET FUNCTION CODE STA .P1 FOR NAME CHANGE * JSB .DRCT FETCH DEF N.OPL SUBPARM INA ADDRESS LDA A,I m~   FETCH STA .P2 LU OF THIS NAME ISZ LST ADVANCE PAST FLAG WD(OLD NAME) LDA LST,I FETCH FIRST WORD STA .P3 SAVE FOR D.R ISZ LST ADVANCE TO 2ND WORD DLD LST,I FETCH LAST TWO WORDS DST .P4 SAVE THEM ALSO DLD TEMP,I SET A/B=WDS 1&2 OF NUNAME JSB CLD.R GO SCHED D.R,PASSING 8 PARMS * * LDA B,I FETCH ERROR RETURN STA ER,I SET ERROR CODE JMP RN..,I EXIT * * N2 OCT -2 .2 OCT 2 .5 OCT 5 .26 DEC 26 .50 DEC 50 TEMP NOP W27 NOP * * A EQU 0 B EQU 1 XEQT EQU 1717B PLEN EQU * END ,   92064-18051 1650 S C0122 &VE..C CRTG VERIFY SUB             H0101 SPL,M,O,C,L ! NAME: VE.. ! SOURCE: 92064-18051 ! RELOC: 92064-16017 ! PGMR: G.L.M. ! ! *************************************************************** ! * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * ! * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * ! * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* ! * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ! *************************************************************** ! ! NAME VE..(7) " 92064-16017 REV.1650 760807" ! ! ! ! ! LET OPEN.,CONV.,READF,WRITF,XEXTL BE SUBROUTINE,EXTERNAL LET IFBRK BE FUNCTION,EXTERNAL LET IDCB1,IDCB2,IDCB3,I.BUF,O.BUF BE INTEGER,EXTERNAL LET TMP.,N.OPL BE INTEGER,EXTERNAL LET AB.FM BE LABEL,EXTERNAL LET VE.. BE SUBROUTINE LET WEOF BE SUBROUTINE,DIRECT ! ! LET EOFM(2) BE INTEGER LET VECOM(8) BE INTEGER ! INITIALIZE ST. TO "ST" INITIALIZE GO. TO "GO" INITIALIZE LU. TO "LU" INITIALIZE EQ.BL TO "= " INITIALIZE EOFM TO "EOF " INITIALIZE VECOM TO "VERIFY COMPLETE " ! ! DEFINE RECORD COUNT AND ERROR TOTAL MESSAGE ! LET RCNT(2) BE INTEGER LET RECM(7) BE INTEGER INITIALIZE RECM TO " RECORDS READ " LET EROUT(2) BE INTEGER LET EREM(10) BE INTEGER INITIALIZE EREM TO " RECORDS WITH ERRORS" ! ! ! ! LET A.Z BE CONSTANT (40400K) LET B.Z BE CONSTANT (41000K) ! VE..: SUBROUTINE (NO,LIS,ER) GLOBAL ! ! SET ADDRESSES OF ON PARMS ! ! :VE,F1,F2,OPTION,#FILES,TYPE ! ! OP5_[OP4_[OP4T_[OP3_[NA2_[NA2T_[NA1_ @LIS+1]+3]+1]+4]+3]+1]+4 ! ! ! SETUP VERIFY OPTION FLAGS ! ! CHECK FOR ABORT/NO-ABORT ON VERIFY ERROR ! IF $OP3=ST. THEN [HT_1;GO TO O4] !ABORT ON ERROR? IF ($OP3=GO.) OR ($OP3=0) THEN HT_0,\ DEFAULT=DON'T ABORT ELSE> [ER_56;RETURN] !BAD PARM RETURN ! ! FETCH # FILES AND SET IT NEGATIVE ! NEGATIVE REQUEST NOT ALLOWED ! O4: IF $(OP5-1)=3 THEN GO TO RJCT ! DON'T ALLOW ASCII IFNOT [TEMP_ $OP5] THEN FCNT_ -1 ,\ DEFAULT USES 1 ELSE [IF [FCNT_ -TEMP] > 0 THEN[\ COMPLEMENT RJCT: ER_56;RETURN]] !REJECT ! ! ! CHECK FOR TYPE--AS/BI ! THIS IS NEEDED WHEN VERIFYING VIA LU'S ! ! IF NUMERIC OR DEFAULT USE VALUE ! IFNOT $OP4T=3 THEN [TYPE_$OP4;GO TO PONG] ! IF ASCII USE 0 IF [TEMP_$OP4 AND 177400K] =A.Z THEN\ [TYPE_0;GO TO PONG] ! ! IF BINARY USE 1OO (SET M BIT) ! IF TEMP=B.Z THEN TYPE_100K,\ ELSE [ER_56;RETURN] ! ! ! ALLOW POS/NEG AND SET DEFAULTS FOR LU'S ! ! ! PONG: $NA1,LU1_ [IF $NA1 < 0 THEN - $NA1,\ !IF NEG SET IT POS ELSE [ IFNOT $NA1 THEN 4,\ !IF DEFAULT USE 4(LCTU) ELSE $NA1 ]] ! ! CHECK 2ND PARM ! $NA2,LU2_ [IF $NA2 < 0 THEN - $NA2,\ IF NEG SET IT POS ELSE [ IFNOT $NA2 THEN 5,\ ! IF DEFAULT USE 5(RCTU) ELSE $NA2 ]] ! ! ! OPEN FILE1,FILE2,LIST ! CALL OPEN.(IDCB1,$NA1,N.OPL,TYPE)! OPEN FILE1 CALL OPEN.(IDCB2,$NA2,$(@N.OPL+5),TYPE) ! OPEN FILE2 CALL OPEN.(IDCB3,TMP.,(@TMP.+3),0)! OPEN LIST ! ! SET UP NAME OF FILE OR LU IN CASE OF VERIFY ERROR ! ! FIRST FILE WORK ! IF LIS=3 THEN GO TO CHNA2 !IF NAME,CONTINUE $NA1_LU. !SET "LU" INTO NAME BUF $(NA1+1)_EQ.BL !SET "= " INTO NAME BUF CONV.(LU1,$(NA1+2),2) !CONVERT LU AND SET INTO BUF ! ! 2ND FILE WORK ! CHNA2: IF $NA2T=3 THEN GO TO GORP !IF NAME, CONTINUE $NA2_LU. !SET "LU" IN BUF $(NA2+1)_EQ.BL ! SET "= " IN BUF CONV.(LU2,$(NA2+2),2) ! CONVERT LU AND SET INTO BUF ! ! RESET COUNTERS ! GORP: ERRCT,RC_0 ! NEXT: IF IFBRK THEN [ER_0;GO TO AB.FM] !CHECK BREi AK FLAG ! CALL READF(IDCB1,ER,I.BUF,128,LEN) !READ RECORD FILE 1 IF ER THEN RETURN ! CALL READF(IDCB2,ER,O.BUF,128,LEN2) !READ RECORD FILE 2 IF ER THEN RETURN ! IF LEN#LEN2 THEN [RC_RC+1;GO TO ERROR] IF LEN= -1 THEN GO TO EOF RC_RC+1 !BUMP RECORD COUNT ! ! DO VERIFY OPERATION ! ! SET UP POINTERS ! TEMP_@I.BUF TEMP2_@O.BUF COUN_ -LEN ! ! MATCH: IF $TEMP# $TEMP2 THEN GO TO ERROR TEMP_TEMP+1 TEMP2_TEMP2+1 IF [COUN_ COUN+1] THEN GO TO MATCH ! ! THIS RECORD OK--CONTINUE ! GO TO NEXT ! ! ! EOF: WEOF !!WRITE "EOF" ON LIST DEV. IF [FCNT_ FCNT+1] THEN GO TO NEXT CALL WRITF(IDCB3,ER,VECOM,8) !WRITE "VERIFY COMPLETE" CONV.(RC,$(@RCNT+1),4) !SET # RECORDS READ CONV.(ERRCT,$(@EROUT+1),4) ! SET TOTAL ERRORS FOUND WRITF(IDCB3,.E.R,RCNT,21) RETURN ! ! ! ERROR: ERRCT_ERRCT+1 !BUMP ERROR COUNT IFNOT HT THEN [IF LEN= -1 OR LEN2= -1 THEN\ GO TO EOF,\ ELSE GO TO NEXT] CALL WRITF(IDCB3,ER,$NA1,3) !WRITE FILE NAME/LU IF LEN = -1 THEN [WEOF;GO TO URRP] CALL XEXTL(LEN,@I.BUF,RC) !GO LIST RECORD ! URRP: CALL WRITF(IDCB3,ER,$NA2,3) !WRITE 2ND NAME LU IF LEN2= -1 THEN [WEOF;RETURN] CALL XEXTL(LEN2,@O.BUF,RC) !LIST 2ND BAD RECORD ! ! RETURN END ! ! WEOF: SUBROUTINE DIRECT CALL WRITF(IDCB3,ER,EOFM,2) RETURN END END END$ 3  92064-18052 1650 S C0122 &FMCMC CRTG FMGR UTILITY SUB             H0101 JSPL,L,O,M,C ! NAME: FM.CM ! SOURCE: 92064-18052 ! RELOC: 92064-16017 ! PGMR: G.A.A. ! MOD: G.L.M. ! ! *************************************************************** ! * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * ! * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * ! * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* ! * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ! *************************************************************** ! ! NAME FM.CM(7) " 92064-16017 REV.1650 761204" ! LET EXEC BE SUBROUTINE,EXTERNAL LET CLOSE,OPEN,MGLU BE SUBROUTINE,EXTERNAL LET OPEN. BE SUBROUTINE LET CLO BE SUBROUTINE,DIRECT LET IFBRK BE FUNCTION,EXTERNAL LET BUF.(129) BE INTEGER,GLOBAL LET MNAM(3) BE INTEGER LET JER.,CONV.,IER. BE SUBROUTINE LET .E.R BE INTEGER,EXTERNAL LET ELOG.,AB.FM BE LABEL,EXTERNAL LET XEQT BE CONSTANT (1717K) LET A BE CONSTANT(0) LET B BE CONSTANT(1) ! OPEN.:SUBROUTINE(DCBRF,LURF,PLIS,OPLST) GLOBAL OPN3: CLO (DCBRF) !CLOSE THE OLD ONE IF LURF<20000K THEN [MGLU(LURF,MNAM);FAD_@MNAM],\ IF FILE THEN ELSE FAD_@LURF OPEN(DCBRF,.E.R ,$FAD,\ !IF FILE THEN (OPLST AND 37777K),\ PLIS,$(@PLIS+1));IF .E.R <0 THEN GO TO ELOG.,\ ELSE RETURN END ! ! ! CLO: SUBROUTINE(DCB)DIRECT,GLOBAL !CLOSE SUBROUTINE FOR INTERNAL WORK IFNOT (DCB = 177400K) THEN CLOSE(DCB,.E.R ) !IF NOT FAKE CLOSE $(@DCB+9)_0 !ELSE KILL THE OPEN FLAG RETURN END ! CONV.:SUBROUTINE (NOO,BUF,NDIG) GLOBAL ! ROUTINE TO CONVERT NO WITH NDIG DIGITS TO ASC ! A T BUF ! ! BUF WILL CONTAIN THE LOWEST DIGITS BUF-1 THE NEXT ! LOWEST ETC. ! EV,BF_@BUF NUM_NOO FOR I_1 TO NDIG DO THRU COV DO[G  NUM_NUM/10;DI_$B+60K] $BF_[IF EV THEN ($BF AND 177400K)+DI,\ ELSE ($BF AND 377K)+(DI-<8)] COV: IF EV THEN EV_0, ELSE\ EV,BF_BF-1 RETURN END ! ! ! ! JER. SHOULD ONLY BE CALLED WHEN NO CLEAN UP IS REQUIRED ! AS IT EXITS TO AB.FM OR ELOG. ! JER.:SUBROUTINE GLOBAL,DIRECT IER. !GO CHECK FOR FMP ERROR .E.R_0 IF IFBRK THEN GO TO AB.FM RETURN END ! ! ! IER.:SUBROUTINE GLOBAL IF .E.R=>0 THEN RETURN,\ ELSE GO TO ELOG. END ! ! ! ! END END$ ?v   92064-18053 1650 S C0122 &DIRD RTE-M CRTG DIR READ SUB             H0101 ASMB,R,L,C * NAME: $DIRD * SOURCE: 92064-18053 * RELOC: 92064-16054 * PGMR: G.L.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM $DIRD,6 92064-16054 REV.1650 760806 * ENT $TBLS EXT $LIBR,$LIBX,EXEC * RWCW NOP HIBYT OCT 177400 UBLK OCT 020000 N29 DEC -29 FDIR NOP B400 OCT 400 B200 OCT 200 ALU NOP ADD1 NOP N1 OCT -1 .1 OCT 1 .3 OCT 3 .4 OCT 4 SUP * $TBLS NOP READ DIRECTORY FROM LU IN (B) * TO ADDRESS IN (A) * JSB $LIBR GO FAKE RE-ENTRANT--LOWER FENCE DEF TDB ??CAN THIS BE 0 OR 1 STB ALU SAVE LU# STA ADD1 SET DEST ADDR * * DETERMINE END OF DIRECTORY * ADA N1 BACK UP TO ADDRESS OF END OF DIRECTORY WORD STA FDIR SAVE IT FOR CHECK * ADB B400 CONFIGURE REWIND REQUEST STB RWCW SET INTO EXEC CALL * * RD1 JSB EXEC CALL DEF RW1 EXEC DEF .3 FOR DEF RWCW CONTROL * * RW1 CLA STA ADD1,I ASSURE END OF DIR. FOR NULL TAPE * JSB EXEC DEF RW2 DEF .1 READ DEF ALU ASCII FROM SPECIFIED LU DEF ADD1,I INTO DIRECTORY/TEMP AREA DEF .4 REQUEST ENTRY * RW2 AND B200 END OF FILE? SZA JMP DONE * SZB,RSS IF NOT EOF-TRANS LOG MUST>0 JMP ER29 DIRECTORY/DEVICE ERROR * * * CPB .4 MUST HAVE READ 4 WORDS RSS OK JMP ER29 NOPE--LESS THAN 4 WORDS READ-   * LDB ADD1 FETCH DEST ADDR ADB .3 INC TO NEXT ENTRY POS LDA B,I FETCH WORD 4 OF ENTRY AND HIBYT HIGH BYTE MUST BE ASCII BLANK CPA UBLK INB,RSS IT'S GOOD--CONTINUE JMP ER29 INVALID DIRECTORY STB ADD1 SET INTO CALL * * * CHECK FOR MAX DIR SIZE * CPB FDIR,I END OF DIRECTORY SPACE ? DONE CLA,RSS JMP RW1 NOT DONE--CONTINUE * LDB .1 WANT TO EXIT AT P+2 DO2 STB RET GOOD RETURN JSB $LIBX DEF TDB RET NOP * ER29 LDA N29 DEVICE\DIRECTORY ERROR * CLB INSURE ERROR RETURN JMP DO2 * * SPC 5 TDB NOP DEC 3 NOP A EQU 0 B EQU 1 END $TBLS SKP ȉ   92064-18054 1650 S C0122 &DRCR0 MI,MII/III CRTG DIR PROG             H0101 6 * USE ASMB,R,L,N FOR THE M1 VERSION\ ASMB,R,L,Z FOR M2&M3 * * * Z OPTION FOR M2/M3 VERSION * N OPTION FOR M1 VERSION * ************************************* * M2/M3 VERSION * ************************************* * * * NAME: D.RCR * SOURCE: 92064-18054 * RELOC: 92064-16018 * PGMR: G.L.M. * * ************************************ * M1 VERSION * ************************************ * * * NAME: $D.RC * SOURCE: 92064-18054 * RELOC: 92064-16021 * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * IFZ * ************************************** * BEGIN M2\3 VERSION CODE * ************************************** * NAM D.RCR,2,1 92064-16018 REV.1650 761129 * EXT PRTN,RMPAR,.MVW XIF * ************************************** * END M2\3 VERSION CODE * ************************************** * IFN * ************************************** * BEGIN M1 VERSION CODE * ************************************** * NAM $D.RC,6 92064-16021 REV.1650 761129 EXT .ENTP ENT $D.RC * XIF * ************************************** * END M1 VERSION CODE * ************************************** * EXT EXEC,$LIBR,$LIBX,$TBLS EXT $CDIR EXT $CRLK * * SUP * * THIS PROGRAM IS THE CENTRAL MANAGER OF THE RTE FILE MANAGEMENT * SYSTEM. IT OWNS THE DIRECTORY AND PERFORMS ALL WRITES * ON IT. * * PROGRAM WISHING TO ACCESS THE DIRECTORY * SCHEDULE (WITH WAIT) THIS PROGRAM. Z* * CALLS ARE AS FOLLOWS (P1,P2,P3,P4,P5 ARE THE PASSED PARAMETERS): * * * 1. OPEN * P1. FUNCTION CODE (10) * P2. -LU,+CARTRIDGE LABEL,0 IF ZERO, SEARCH ALL MOUNTED CARTRIDGES * P3. 0,NAME(1,2) * P4. S,NAME(3,4) S(BIT 15) INDICATES SCRATCH OPEN IF SET * P5. 0,NAME(5,6) * * 2. CLOSE * P1. FUNCTION CODE (0) * P2. LU * * * 4. CHANGE NAME * P1. FUNCTION CODE (2) * P2. -LU * P3. NAME (1,2) * P4. NAME (3,4) * P5. NAME (5,6) * P6. NEW-NAME (1,2) * P7. NEW-NAME (3,4) * P8. NEW-NAME (5,6) * * 6. SET,CLEAR LOCK ON CARTRIDGE TAPE UNIT * P1. FUNCTION CODE (3=SET, 5=CLEAR) * P2. -LU,+CARTRIDGE (0 NOT LEGAL) DEV. TO BE LOCKED * P3. * P4. * P5. * SKP * * RETURN PARAMETERS * R1. ERROR CODE * R2. LU * R3. DIRECTORY ADDRESS - * R4. FILE # * R5. FILE TYPE * * ERROR CODES * 0 OR POSITIVE -NO ERROR * -2 DUPLICATE NAME * -3 FILE NOT FOUND * -6 CARTRIDGE NOT FOUND * -8 FILE IS CURRENTLY OPEN (ALSO FOR REJECT LOCK) * -11 FILE NOT OPEN (CLOSE) * -13 CTU LOCKED * -14 DIRECTORY FULL * * -101 ILLEGAL PARAMETERS IN CALL * -102 ILLEGAL CALL SEQUENCE (LOCK NOT REQUESTED FIRST) SKP * FETCH DIRECT ADDRESSES FOR DIRECTORIES CRDIR JSB ADD1 FTYPE DEF $CDIR CRLK STA CRDIR DIRAD JSB ADD1 ALU DEF $CRLK DIRS STA CRLK DRSTP NOP TEMPX NOP MDSK CLA TMP2 STA BEGIN * FILE# JMP BG2 * * ID NOP * * ADD1 NOP FETCH DIRECT ADDRESSES LDA ADD1 LDA A,I RAL,CLE,SLA,ERA JMP *-2 ISZ ADD1 JMP ADD1,I * * N1 OCT -1 N2 OCT -2 N3 OCT -3 .1 OCT 1 .2 OCT 2 .3 OCT 3 .4 OCT 4 .6 OCT 6 B100 OCT 100 .20 DEC 20 B777 OCT 777 .9 DEC 9 .16 DEC 16 .26 DEC 26 * *  IFN * ************************************** * BEGIN M1 VERSION CODE * ************************************** * * .7 OCT 7 * TDB NOP DEC 12 NOP * XIF * ************************************** * END M1 VERSION CODE * ************************************** * * * P1 NOP ID P2 NOP FUNCTION P3 NOP CR\-LU\0 P4 NOP P5 NOP *-----------------^^^FROM SCHED REQUEST------------- P6 NOP FROM CALLERS ID SEG: XA P7 NOP XB P8 NOP W27 P9 NOP W28 * * IFN * ************************************** * BEGIN M1 VERSION CODE * ************************************** * * * $D.RC NOP JSB $LIBR RE-ENTRANT ENTRY DEF TDB JSB .ENTP FETCH CALL PARMS P1A DEF P1 STA TDB+2 SET RETURN ADDRESS * LDA P1 FETCH ADDRESS OF PARMS LDB P1A FETCH ADDRESS OF LOCAL AREA JSB .MVW MOVE EM IN DEF .7 NOP * * BEGIN JMP CRDIR GO DO BOOT UP THING BG2 LDA XEQT FETCH ID SEG ADDRESS STA ID SAVE IT ADA .26 ADVANCE TO WD27 OF IDSEG * XIF * ************************************** * END M1 VERSION CODE * ************************************** * * * * SPC 2 * * IFZ * ************************************** * BEGIN M2\3 VERSION CODE * ************************************** * BEGIN JMP CRDIR GO FETCH DIRECT ADDRS * BG2 JSB RMPAR FETCH ADDRESS OF TDB DEF *+2 DEF P1 LDA XEQT FETCH ID SEG ADDR ADA .20 ADVANCE TO FATHER INFO. LDA A,I AND FETCH IT RAL POSITION FATHER WAIT BIT TO SIGN SSA,RSS CONTINUE ONLY IF FATHER IS WAITING JMP EXIT2 1 NOT WAITING--ERROR EXIT * RAR REPOSITION ID SEG # OF FATHER AND B777 ISOLATE IT ADA N1 ADA KEYWD ADD TO TABLE OF ID SEGS LDA A,I FETCH ID SEG ADDRESS OF CALLER STA ID * ADA .9 ADVANCE TO XA LDB A,I AND FETCH IT STB P6 NOW SAVE INA ADVANCE TO XB LDB A,I FETCH IT STB P7 AND SAVE ADA .16 ADVANCE TO WORD 27 * XIF * ************************************** * END M2\3 VERSION CODE * ************************************** * * * DLD A,I FETCH WDS 27 & 28 DST P8 SAVE FOR PARMS P8 AND P9 SPC 2 CLB STB FIRST CLEAR THE FIRST FLAG STB MDSK * FETCH ADDRESS OF CARTRIDGE DIRECTORY. LDA CRDIR SET LOCK SEARCH FOR FIRST STA DIRAD ENTRY ADA N1 BACK UP TO STOP ADDRESS STA DRSTP SET STOP ADDRESS * * IF MASTER LOCK REQUEST SKIP "NEXT" WORK * LDA P1 CPA .11 JMP LCKER SKP * * NEXT LDA P2 FETCH THE LU CMA,CLE,INA SET LU POSITIVE SSA,SZA DONT' ALLOW JMP EX6 CARTRIDGE REFS AND B77 ISOLATE LU LDB MDSK GET PREVIOUS ID STA MDSK STORE ID CME,SZB IF NOT A ZERO, ID ON SECOND JMP EX6 CALL TAKE -6 EXIT SPC 1 LOCK6 STA TMP2 AND SET FOR COMPARE * * SET THE FOUND BIT IN E IF * CMA,CLE,INA A ZERO ID LDB DIRAD GET CURRENT DIRECTORY ADD. * LOCK2 CPB DRSTP,I END OF SEARCH? JMP EX6 YEP--EXIT LDA B,I GET FIRST WORD SZA,RSS IF 0 THEN END JMP EX6 NOT MOUNTED * STA ALU UPDATE; ELSE SAVE LU CPA TMP2 IS THIS THE REQUIRED CTU ? CCE YES SET E TO 1 TO INDICATE FOUND ADB .3 INDEX TO NEXT ENTRY SEJZ,INB,RSS IF SEARCHING ALL CTUS OR FOUND-SKIP JMP LOCK2 ELSE GET NEXT ONE. * * SPC 2 STB DIRAD FOUND - UPDATE CURRENT ADDRESS(FOR NEXT CALL) LDB CRLK FETCH MASTER LOCK ADDRESS LDA B,I FETCH CONTENTS CPA ID IF LOCKED TO SELF--DON'T CLEAR JMP DECOD CONTINUE JSB DORM GO SEE IF LOCKED-AND NOT DORMANT JMP EX31 YES LOCKED AND NOT DORMANT * SPC 2 DECOD LDA P1 FETCH FUNCTION SSA CHECK REQUEST CODE JMP EX101 NEGATIVE - EXIT ADA N12 SSA,RSS JMP EX101 GREATER THAN 11 - EXIT ADA TABAD INDEX INTO THE FUNCTION JMP A,I GO EXECUTE THE FUNCTION SPC 2 * * TABAD DEF TABA+12 TABA JMP CLOSE 0 JMP EX101 1 JMP CNAM 2 JMP RLOCK 3 JMP EX101 4 JMP ULOCK 5 JMP EX101 6 JMP EX101 7 JMP EX101 8 JMP EX101 9 JMP OPEN 10 JMP LCKER 11 * .11 DEC 11 SKP *****MASTER LOCK ROUTINE * LCKER LDA P4 FETCH ID/0 SZA IF RELEASE THEN CONTINUE JMP LKCK ELSE CHECK FOR ANY OPEN CARTRIDGES * LDB CRLK,I FETCH LOCKER'S ID CPB ID MUST BE SAME AS CALLER'S RSS YEP--IT'S OK JMP EX8 NO--REJECT CALL * LKOK LDB CRLK FETCH ADDRESS JSB SETIT GO SET/CLEAR LOCK CRAD LDA DIRAD STA ADD1 SET DIRECTORY ADDRESS FOR RETURN TO CALLER JMP C.X * * * * LKCK LDB CRDIR FETCH CARTRIDGE DIRECTORY ADDRESS LK? ADB .3 ADVANCE TO LOCK WORD STB LKTMP SAVE IN LOCAL TEMP LDA B,I FETCH LOCK WORD * CPA ID IF LOCKED TO SELF JMP NOLK LEAVE IT ALONE * JSB DORM GO SEE IF DORMANT OR NEW-RUN JMP EX8 NOPE-LOCKED--LOCK REJECT ERROR * NOLK LDB LKTMP FETCH CARTRIDGE DIR ADDR- INB ADVANCE TO NEXT ENTRY CPB DRSTP,I END?? JMP BLLK YES GO DO LOCK JMP LK? CONTINUE SEARCH * BLLK LDA P4 JMP LKOK GO LOCK IT * LKTMP NOP * SKP * *************************************************** * * OPEN ROUTINE ***** * ************************************************** * * * OPEN JSB SETDR SET UP TO READ THE DIRECTORY LDA P4 IF SIGN SET ON P4 SSA THEN SCRATCH OPEN REQUESTED JMP SCR GO FIND # OF FILES ON CTU * JSB N.SHR GO FIND THE FILE JMP NEXT NOT FOUND - TRY NEXT CARTRIDGE TAPE * * FOUND * LCKR STA ADD1 SET ADDRESS OF DIRECTORY FOR RETURN * * FOUND IT-- IS IT LOCKED? * LDB DIRAD FETCH DIRECTORY ADDRESS ADB N1 BACKUP TO LOCK WORD LDA B,I FETCH LOCK WORD CPA ID IF LOCKED TO SELF JMP EX13 REJECT OPEN ATTEMPT * JSB DORM GO SEE IF LOCKING PROG IS DORMANT * * JMP EX13 NOPE NOT DORMANT-CAN'T BUILD DCB * * * SET SUBFUNCTION BIT * LDA ADD1 FETCH DIRECTORY ADDRESS ADA .3 ADVANCE TO TYPE WORD LDB A,I AND FETCH IT STB FTYPE SAVE IT LDA ALU FETCH LU * CPB BS IF ASCII RSS SKIP IOR B100 ELSE-INCLUDE "M" BIT (BINARY) STA ALU RESTORE LU AND SUBFUNCTION * * LDB DIRAD FETCH ADDRESS ADB N1 OF LOCK WORD FOR THIS CARTRIDGE LDA ID FETCH ID SEG ADDRESS OF REQUESTING PROG JSB SETIT LOCK THIS UNIT * C.X CLA CLEAR ERROR CODE * CREX JSB RPRM GO SET RETURN PARAMETERS * IFZ * ************************************** * BEGIN M2\3 VERSION CODE * ************************************** * JSB PRTN PASS THE RETURN PRAMS DEF *+2 AND DEF R1 2 THEN EXIT2 JSB EXEC COMPLETE DEF *+2 DEF .6 * XIF * ************************************** * END M2\3 VERSION CODE * ************************************** * * IFN * ************************************** * BEGIN M1 VERSION CODE * ************************************** * LDA R1AD FETCH ADDRESS OF RETURN PARMS LDB XEQT FETCH IDSEG ADDR INB ADVANCE TO TEMP AREA * * * SET RETURN PARMS INTO ID TEMP AREA * JSB .MVW DEF .5 NOP * * * RESET B FOR RMPAR CALL BY CALLER * LDB XEQT INB JSB $LIBX DEF TDB NOP * * * * R1AD DEF R1 .5 OCT 5 * XIF * ************************************** * END M1 VERSION CODE * ************************************** * * SPC 2 * BS ASC 1, S * SCR JSB N.SHR GO COUNT THE FILES JMP LCKR GO TREAT AS NORMAL * JMP EX101 THIS SHOULD NEVER HAPPEN * SPC 2 .8 DEC 8 .14 DEC 14 SIGN OCT 100000 SPC 2 * RPRM NOP STA R1 SET ERROR RETURN/TYPE LDA ALU SET LU CODE STA R2 LDA ADD1 FETCH DIRECTORY ADDRESS STA R3 SET IN RETURN PARMS LDA FILE# FETCH ABS FILE # STA R4 RETURN TO CALLER LDA FTYPE FETCH FILE TYPE STA R5 SET IT * * JMP RPRM,I * * * R1 NOP R2 NOP R3 NOP R4 NOP R5 NOP SPC 2 * * EX2 LDA .2 RSS EX6 LDA .6 RSS EX8 LDA .8 RSS EX13 LDA .13 CMA,INA,RSS EX11 LDA N11 RSS EX31 LDA N31 * JMP CREX SPC 2 N31 DEC 31 EX101 LDA N101 JMP CREX * N101 DEC -101 SKP * SETDR ROUTINE TO SET UP TO READ A DIRECTORY * SETDR NOP * * LDB DIRAD FETCH POINTER TO CART. DIR ADB N2 BACKUP TO DIRECTORY >ADDRESS LDA B,I FETCH IT STA DIRS SAVE IT ADB N1 BACK UP TO VALIDITY WORD STB N.SHR SAVE LOCATION OF VALIDITY WORD LDB B,I * * CHECK VALIDITY OF DIRECTORY--0=GOOD,ELSE INVALID. * LDB B,I FETCH CONTENTS OF VALIDITY WORD SZB,RSS IF NOT ZERO--SKIP JMP SETDR,I ITS VALID--ALL DONE. * * LDA DIRS FETCH DESTINATION ADDR FOR INPUT * * * READ DIRECTORY ENTRY * * LDB ALU * JSB $TBLS GO RESTORE DIRECTORY * JMP CREX READ ERROR/DIRECTORY ERROR-CODE IN (A) * ROK CLA LDB N.SHR FETCH ADDRESS OF VALIDITY WORD ADB SIGN JSB SETIT GO CLEAR VALIDITY(STA B,I) ADB .2 ADVANCE TO LOCK WORD JSB SETIT GO REMOVE LOCK (NEW DIRECTORY HAS BEEN READ) * JMP SETDR,I * * SKP * N.SHR DIRECTORY SEARCH ROUTINE * TARGET NAME IN NAME * RETURNS: * P+1 END OF DIRECTORY A=NEXT ADDR.(IF A=STOP,NO SPACE) * "FILE#"=ABSOLUTE FILE# FOR NEXT FILE. * P+2 FOUND RETURN A=ENTRY ADDR. * "FILE#"=ABSOLUTE FILE# OF THIS FILE. * N.SHR NOP * * LDA DIRS ADDRESS OF DIRECTORY TO BE SEARCHED. ADA N1 DIR-1=END OF TABLE TO BE SEARCHED. LDB A,I FETCH THAT ADDRESS STB STOP AND SAVE IT INA POSITION TO BEGINING OF TABLE/DIRECTORY * * SETUP FOR SEARCH * CLB,INB SET FOR FILE STB FILE# COUNT -ADJUST FOR DIRECTORY * * SEARCH FOR REQUESTED NAME. * NSHR1 CCE SET FOUND FLAG (E=1) LDB ANAME SET THE NAME ADDRESS STB TMP2 IN TMP2 LDB N3 SET FOR 3-WORD NAME STB COUN2 ISZ FILE# INCREMENT FILE COUNT * NSHR2 CPA STOP END OF SEARCH ? JMP N.SHR,I YES EXIT--A=STOP LDB A,I GET A NAME WORD SZB,RSS IF ZERO - END OF DIRECTORY  JMP N.SHR,I SO EXIT * CPB TMP2,I MATCH? INA,RSS YES - SET FOR NEXT WORD SKIP CLE,INA NO - SET NOT FOUND - STEP NAME ISZ TMP2 STEP LOCATIONS ISZ COUN2 AND COUNT MORE NAME JMP NSHR2 YES; GO DO IT * CLB,SEZ,CCE,INB NO; FOUND? JMP NSHR3 YES; GO TAKE FOUND EXIT NSHR4 INA NO; SET FOR NEXT ENTRY JMP NSHR1 NO; DO NEXT ENTRY NSHR3 ADB N.SHR FOUND - STEP RETURN ADDRESS ADA N3 ADJUST TO START OF ENTRY JMP B,I RETURN * * STOP NOP ANAME DEF P3 * N11 DEC -11 N12 DEC -12 SPC 2 .13 DEC 13 B77 OCT 77 FIRST NOP COUN2 NOP SPC 10 * * * LOCAL MOVE WORDS SUBROUTINE * M1 VERSION ONLY * IFN * ************************************** * BEGIN M1 VERSION CODE * ************************************** * * * .MVW NOP STA .A LIA 6 SZA,RSS MX OR XE COMPUTER? JMP NMX0 NEITHER * CCA ADA .MVW GET P+1 STA .MVW CALCULATE P LDA MVW STA .MVW,I PATCH INSTRUCTION LDA .A RESTORE A JMP .MVW,I GO DO MVW THING * * NEITHER MX NOR XE * NMX0 LDA .MVW,I MICRO CODE MOVE REPLACEMENT LDA A,I GET THE COUNT ISZ .MVW STEP TO NOP (NOP IS RETURN) SZA,RSS JMP OUT SKIP MOVE IF ZERO COUNT * CMA,INA SET IT NEGATIVE STA COUNT SET COUNTER LOOP LDA .A,I GET WORD STA B,I SET IN DESTINATION INB STEP DESTINATION ISZ .A SOURCE ISZ COUNT AND COUNT JMP LOOP IF NOT DONE LOOP * OUT LDA .A PUT NEXT LOC IN A JMP .MVW,I AND RETURN * MVW MVW 0 .A EQU *-1 COUNT NOP * XIF * ************************************** * END M1 VERSION CODE * ************************************** * }SKP * CNAM JSB SETDR JSB N.SHR JMP NEXT * STA RPRM SAVE ADDRESS OF FILE LDA P6 STA P3 DLD P7 DST P4 * JSB N.SHR SEARCH FOR NEW NAME RSS JMP EX2 * LDB RPRM FETCH ADDRESS OF OLD NAME LDA ANAME * JSB $LIBR NOP JSB .MVW DEF .3 NOP JSB $LIBX DEF *+1 DEF C.X SKP * RLOCK LDB DIRAD FETCH CART.DIR POINTER STB ADD1 SAVE IT INCASE LOCKED ADB N1 BACK UP TO LOCK WORD LDA B,I FETCH LOCK CONTENTS CPA ID IF LOCKED TO SELF JMP EX8 REJECT LOCK REQUEST * * JSB DORM SEE IF LOCKING PROG IS DORMANT OR THIS ONE * JMP EX13 * * UNLOCKED OR DORMANT--GRANT LOCK REQUEST * OR LOCKED TO THIS PROG * LDA ID FETCH CALLERS ID JSB SETIT GO SET LOCK (STA B,I) * * CLEAR ERROR CODE JMP CRAD GO SET DIR ADDR FOR RETURN\EXIT SPC 5 * * * ULOCK LDB DIRAD ADB N1 LDA B,I FETCH LOCK CONTENTS CPA ID INSURE RELEASE OF OWN LOCK RSS YES --ITS OK JMP EX13 UNLOCK ERROR CLA JSB SETIT GO CLEAR LOCK (STA B,I) JMP CREX SKP * CLOSE LDA P2 FETCH LU CPA N1 IF -1, NO ACTION---DEVICE FILE JMP C.X GO EXIT(ERR CODE=0) * LDB DIRAD MIGHT BE SET ALREADY!!!!!!!! ADB N1 LDA B,I CPA ID ONLY CLOSE YOUR OWN FILES RSS --OK JMP EX11 FILE(DEVICE) NOT OPEN TO YOU CLA JSB SETIT GO REMOVE LOCK JMP CREX SPC 5 * * SET CONTENTS OF (A) BELOW THE FENCE--- * TO LOCATION POINTED AT BY (B) * * SETIT NOP JSB $LIBR NOP PRIV REQUEST STA B,I THATS ALL FOLKS * JSB $LIBX DEF SETIT SPC 5 * DORM CHECK TO SEEB@< IF PROGRAM IS DORMANT * * ID ADDRESS IN A * LOCATION TO BE SET TO ZERO'S ADDRESS INB * RETURN P+1 IF NOT DORMANT; ELSE P+2 DORM NOP STB TMP2 SAVE B REG CCE,SZA,RSS IF ZERO THEN JUST RETURN P+2 CLE,RSS SO SKIP ELSE CPA ID IF OPEN TO THIS PGM FORCE CLOSE JMP DORM1 SO GO EXIT LDB KEYWD MAKE SURE THE FLAG POINTS STB TEMPX TO A VALID DORM2 LDB TEMPX,I ID SEGMENT CPB A THIS ONE? JMP DORM3 YES CONTINUE ISZ TEMPX NO TRY THE NEXT ONE CCE,SZB IF END THEN JMP DORM2 JMP DORM1 NOT VALID GO CLEAR FLAG * DORM3 ADA .28 ADVANCE TO NEW-RUN INFO LDB A,I FETCH IT CCE,SSB SKIP IF CLEAR(NOT NEW-RUN) JMP DORM1 IT'S A NEW RUN--CLEAR LOCK ADA N20 BACK UP TO POINT OF SUSPENSION * * SHOULD ALSO CHECK TO SEE IF IN TIME LIST!!!!! * * LDB A,I TO B CMB,CLE,INB,SZB,RSS IF ZERO (DORMANT) E_1 DORM1 ISZ DORM ELSE SKIP LDB TMP2 RESTORE BREG CLA,SEZ CHANGE TO DORMANT JSB SETIT SET TO ZERO JMP DORM,I RETURN * .28 DEC 28 N20 DEC -20 SKP A EQU 0 B EQU 1 . EQU 1650B KEYWD EQU .+7 XEQT EQU .+39 LN EQU * ************************** * END BEGIN B  92064-18059 1650 S C0122 &TBLCR RTE-M CRTG DIR TABLES             H0101 JASMB,R,L,C,Z * NAME: $TBLCR * SOURCE: 92064-18059 * RELOC: 92064-16019 * PGMR: G.L.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM $TBLCR,6 92064-16019 REV.1650 760809 * * IFZ UNL XIF ENT $CDIR,$CRLK,$DIRS EXT $LCTU,$RCTU LST * * * MODIFY THE FOLLOWING INSTRUCTION IF MORE THAN 2 * CARTRIDGE TAPE UNITS ARE TO BE MOUNTED AT ANY ONE TIME. * * * #ENT EQU 0 NUMBER OF ADDITIONAL CTU'S OTHER * THAN FIRST 2. * IFZ UNL XIF $CRLK NOP * * DEF ENDIT $CDIR DEC 4 LU OF LEFT CTU DEF $LCTU DEF $LCDT NOP DEC 5 LU,OF RIGHT CTU DEF $RCTU DEF $RCDT REP #ENT+#ENT+#ENT+#ENT+1 NOP ENDIT EQU * SPC 10 * * LST * EACH UNIT OF DIRECTORY SPACE HAS THE FOLLOWING FORMAT * * NOP TELLS WHICH LU IS ASSIGNED THIS DIRECTORY * NOP VALIDITY WORD FOR THIS DIR * DEF *+41 IDENTIFIES THE END OF THE DIRECTORY * BSS 40 * * IFZ UNL XIF $DIRS DEF ENDIR IDENTIFIES END OF AVAIL--DIRS * OCT 4 NOP DEF *+41 $LCDT BSS 40 * OCT 5 NOP DEF *+41 $RCDT BSS 40 * LST * * * * * * ********* ADD THE ADDITIONAL 4 WORD ENTRIES HERE ********** * * * * * * * * * * * * * **************************************************** * * * THIS INSTRUCTION MUST FOLLOW THE ABOVE ENTRIES. * CAUTION! DO NOT MOVE OR MODIF*  Y THIS INSTRUCTION IN ANY WAY. * ENDIR EQU * * * IFZ UNL XIF ORG $DIRS+1 REP #ENT+2 BSS 43 CKEND EQU * BSS CKEND-ENDIR BSS ENDIR-CKEND LST * * END 9   92064-18061 1650 S C0122 >FC CRTG GTFIL SUB             H0101 dASMB,R,L,C,Z * * N OPTION FOR DISKETTE SYSTEM * * Z OPTION FOR CARTRIDGE SYSTEM * * * * NAME: GTFIL * SOURCE: 92064-18173 (DISKETTE SYSTEM) * RELOC: 92064-16058 (DISKETTE SYSTEM) * PGMR: G.L.M. * * NAME: GTFIL * SOURCE: 92064-18061 (CARTRIDGE SYSTEM) * RELOC: 92064-16061 (CARTRIDGE SYSTEM) * PGMR: G.L.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * IFN NAM GTFIL,7 92064-16058 REV.1650 761020 XIF * * * * IFZ NAM GTFIL,7 92064-16061 REV.1650 761020 XIF * ENT GTFIL * EXT .DRCT,CLOSE EXT CLD.R,.P1,.P2,.P3,.P4 EXT .ENTR,$PARS,$LIBR,MGLU EXT $LIBX,$CON,.MVW EXT DTTY,OPEN,READF,WRITF,GDCB * * * * SUP * ****** ZERO NOP ****** .5 OCT 5 DEFAULT LU'S .4 OCT 4 .6 OCT 6 OCT 6 .1 OCT 1 .2 OCT 2 ADRLU DEF * ******* * DON'T MESS WITH ANY OF THE ABOVE!!!!!!! * MSK1 OCT 140000 C.ARR NOP N6 OCT -6 * * * * * READ BSS 20 NOTE INPUT LENGTH OF 20 WORDS INAD ASC 3,INPUT OUAD ASC 3,OUTPUT LIAD ASC 3,LIST ERAD ASC 3,ERROR S1AD ASC 3,SCR1 S2AD ASC 3,SCR2 * * DO NOT CHANGE THE FOLLOWING DEF'S * THEY ARE A TABLE TO DERIVE THE PROPER ASCII MESSAGE * DEF INAD DEF OUAD DEF LIAD DEF ERAD ADSC1 DEF S1AD ADSC2 DEF S2AD * MUAD DEF * * * ***************************************************** * MESG BSS 3 ASC 2, ? OCT 3537 BELL / BACK ARROW * MESAD DEF MESG * MORE? NOP .3 OCT 3 PADDR DEF SCR2+1 RBUF BSS 33 RBUFA DEF RBUF WD5 NOP N10 DEC -10 N12 DEC -12 N20K OCT 157777 .9 DEC 9 B77 OCT 77 ODD OCT 52525 RZERO DEF DZERO OPOP OCT 411 OPEN OPTION CON1 NOP CLSE? NOP SKP * * GTFIL NOP LDA RZERO FETCH RESET VALUE ADDR. LDB A INB DESTINATION IS (A) +1 JSB .MVW GO RESET PARMS DEF .9 NOP * * IFN CLA STA T267F XIF * * LDA GTFIL STA DGTFL SET PARM ADDR FOR .ENTR JMP DUMMY GO GET PARMS * * ******************************************************** DZERO DEF ZERO DON'T MOVE THIS(USED IN RESET) * * * OPTN DEF ZERO * ERR DEF ZERO * ANSW DEF ZERO INPT DEF ZERO * OUTP DEF ZERO * LIST DEF ZERO * ELOG DEF ZERO * SCR1 DEF ZERO * SCR2 DEF ZERO * * * ******************************************************** DGTFL NOP * DUMMY JSB .ENTR TRANSFER PARAMETERS DEF OPTN TO LOCAL AREA * CLA CLEAR ERROR RETURN STA ERR,I * LDA $CON,I FETCH CONSOLE LU AND B77 ISOLATE IT STA CON1 SAVE IT * LDA OPTN,I STA OPTN STA CLSE? IF SIGN SET--DON'T CLOSE ANSW AND ODD ISOLATE BITS THAT WOULD CAUSE OP. RESPONSE SZA,RSS IF NONE SET, SKIP ANSW FILE OPEN JMP ADFL * * * OPEN INPUT FILE/LU * LDA ANSW,I FETCH ANSWER NAME/LU LDB N20K IS THIS A NAME ? ADB A OR AN LU ?? SSB,RSS JMP OP1 @IT'S A NAME--DO NORMAL OPEN * SZA,RSS IF DEFAULT LDA CON1 USE MTM TERMINAL STA TEMP SAVE FOR CONVERSION * * CALL ROUTINE TO CREATE MAGIC NAME * IF REQUESTED LU IS TOO LARGE OR NOT ASSIGNED * MAGIC NAME "LU..99" IS RETURNED. THIS WILL GENERATE * A ERROR -18 (BAD LU) IN THE OPEN ROUTINE. * JSB MGLU CALL ROUTINE TO BUILD MAGIC NAME DEF *+3 DEF TEMP ADDRESS OF LU TO BE CONVERTED READA DEF READ TEMP BUFFER FOR RESULT LDA READA FETCH ADDRESS OF MAGIC NAME STA ANSW SET IT FOR OPEN CALL * OP1 JSB OPEN DEF OP2 DEF GDCB DEF ERR,I DEF ANSW,I DEF OPOP * OP2 LDA ERR,I SSA JMP DGTFL,I * * SEE IF INTERACTIVE * JSB .DRCT FETCH DEF GDCB DIRECT ADDRESS OF DCB ADA .2 ADVANCE TO TYPE WORD LDB A,I FETCH IT SZB CONTINUE IF ZERO JMP DFILE NON-INTERACTIVE * INA ADVANCE TO LU LDA A,I FETCH IT JSB DTTY DETERMINE IF INTERACTIVE RSS DFILE CLA STA INT 0=NO,1=YES * * * * * * ADFL LDA N6 FETCH LOOP CNTR STA MORE? SET IT * NEXT LDA OPTN FETCH OPTION PARAMETER RAR,RAR POSITION OPTION BITS TO 15/14 STA OPTN UPDATE FOR NEXT PASS * AND MSK1 (B140000) ISOLATE BITS 15&14 SZA,RSS ANY WORK? JMP BMP2 NO-TRY NEXT PASS * * FETCH ADDRESS OF CURRENT ARRAY * LDB PADDR FETCH ADDR OF END OF PARMS ADB MORE? BACK UP TO CURRENT WORK LDB B,I FETCH ADDRESS OF THAT ARRAY CPB DZERO SEE IF PARM SUPPLIED JMP EX10 EXIT NOT ENOUGH PARMS * STB C.ARR SAVE AS CURRENT ADDRESS CLB STB WD5 CLEAR STATUS WORD * SPC 5 * * IF THIS IS DEFAULT REQUEST-GO DO IT. * ELSE OUTPUT PROPER OPERATOR QUESTION [ * FETCH INPUT AND PARSE** * LDA OPTN FETCH CURRENT OPTION SSA IF SIGN SET=ODD REQUEST=DEFAULT JMP DFLT * * -NOT DEFAULT- * MOVE IN PROPER MESSAGE * PNT LDA MORE? INDEX TO ADA MUAD PROPER MESSAGE TYPE LDA A,I FETCH ADDRESS(INDIRECT PROBLEM???) LDB MESAD OUTPUT BUFFER ADDRESS JSB MVIT3 MOVE MESSAGE TO BUFFER JSB WR/RE WRITE IT AND FETCH RESPONSE * * * SPC 5 * * THE INPUT BUFFER MUST BE PARSED*** * * * SET TRANS LOG TO CHAR * IF ZERO LOG, (CNTR D, OR ERROR) RETRY * LDB RLEN FETCH READ LENGTH SSB,RSS SZB,RSS JMP EX12 BAD INPUT ERROR--ABORT WORK--RETURN * CLE,ELB MAKE TRANS LOG CHAR STB RLEN SAVE IT FOR SYSTEM PARSE CMB,INB SET IT NEGATIVE STB RL2 SAVE IT TOO * LDA IBCH FETCH IBUF CHAR ADDRESS STA FBYTE SET FOR BUFFER SCAN STA TBYTE TO REPLACE ":" WITH "," * NX: JSB GTBYT FETCH BYTE CPA COLON BAD GUY? LDA COMMA YES--REPALACE IT JSB STBYT GO STORE BYTE ISZ RL2 DONE? JMP NX: NOPE --CONTINUE * LDB RLEN FETCH CHAR COUNT LDA READA FETCH ADDRESS OF INPUT BUFFER * * GO PRIV AND CALL SYSTEM PARSE ROUTINE * JSB $LIBR NOP REQUEST PRIV MODE JSB $PARS CALL SYSTEM PARSE ROUTINE DEF RBUF RESULT BUFFER JSB $LIBX RESTORE NORMAL USER MODE DEF *+1 DEF *+1 * * CHECK PARSE RESULTS * * LDB RBUFA FETCH ADDR OF RESULT BUF LDA B,I FETCH FLAG WORD 1 SZA,RSS NULL? JMP DFLT YES--THE OPERATOR DEFAULTED * CPA .2 ALPH? JMP ALPH? YES,NAME GIVEN * * NUMERIC VALUE GIVEN * INB ADVANCE TO VALUE LDA B,I FETCH IT GTMJ CLB * 3+ STB C.ARR,I CLEAR WD1 OF ARRAY * * STLU STA TEMP SAVE LU FOR CONVERSION * * JSB MGLU GO GET MAGIC LU NAME FOR THIS GUY DEF *+3 DEF TEMP LOCATION OF LU DEF READ LOCATION FOR RESULT LDA READA ADDRESS OF RESULT LDB C.ARR FETCH CURRENT ARRAY ADDRESS INB ADVANCE TO WD2 JSB MVIT3 MOVE MAGIC NAME IN * INB ADVANCE TO SECURITY ADDRESS CLA SET IT STA B,I EQUAL TO ZERO JMP BUMP * * * ALPH? INB ADVANCE TO FIRST WD OF NAME STB A SET AS FROM ADDRESS LDB C.ARR FETCH CURRENT ARRAY ADDRESS INB ADVANCE TO WD2 JSB MVIT3 GO MOVE NAME IN * * A=ADDRESS OF FLAG FOR SECURITY CODE * B=ADDRESS OF WORD 5 OF GTF ARRAY * INB ADVANCE TO SECURITY STB TEMP SAVE ADDRESS FOR SECURITY LDB A,I FETCH FLAG INA ADVANCE TO SECURITY VALUE SZB IF DEFAULT--USE ZERO LDB A,I FETCH IT STB TEMP,I SET IT INTO WD6-GTF ARRAY ADA .3 ADVANCE TO DRN/-LU/0 FLAG LDB A,I FETCH FLAG INA ADVANCE TO VALUE SZB IF DEFAULT--USE 0 LDB A,I FETCH IT STB C.ARR,I SET IT INTO WD1 JMP BUMP * * * * * TO GET HERE EITHER: 1-THE OPTION BIT WAS ODD. * OR 2-THE OPERATOR DEFAULTED. * * DFLT LDA WD5 FETCH TEMP WORD 4 OF ARRAY CCE SET E RAL,ERA SET DEFAULT BIT STA WD5 RESET TEMP FOR MORE UPDATES * LDB .2 CHECK FOR ADB MORE? SCRATCH REQUEST SSB,RSS IF SIGN BIT SET--NOT SCRATCH REQUEST JMP SCTCH SIGN BIT NOT SET--SCRATCH-- * LDA C.ARR,I LU SUPPLIED? SZA,RSS IF NOT-- JMP DLU --GO GET DEFAULT LU * * ALLOW BOTH POS AND N lEG LU'S TO BE PASSED FROM USER * MAY WANT TO ONLY ALLOW -LU * * SSA CMA,INA MAKE IT POS JMP GTMJ GO GET MAGIC NAME * SPC 5 * * TEMP EQU GTFIL * * * * FETCH DEFAULT LU FOR THIS PASS * DLU LDA MORE? FETCH PASS CNTR ADA ADRLU LOCATE ADDRESS OF DEFAULT LU LDA A,I FETCH LU JMP GTMJ GO SET THIS INTO MAGIC NAME * * SPC 5 MVIT3 NOP JSB .MVW DEF .3 NOP JMP MVIT3,I * SPC 5 * * PRINT/READ SUBROUTINE * INT NOP WR/RE NOP * * IF NOT INTERACTIVE-SKIP PROMPT * LDA INT SZA,RSS JMP RT1 * JSB WRITF DEF RT1 DEF GDCB DEF ERR,I DEF MESG DEF .6 * * FETCH REPLY * RT1 JSB READF DEF RT2 DEF GDCB DEF ERR,I DEF READ DEF .20 DEF RLEN READ LENGTH * RT2 LDA ERR,I SZA JMP DGTFL,I JMP WR/RE,I * .20 DEC 20 * * BUMP LDA C.ARR ADA .4 POINT AT WD 4 OF ARRAY LDB WD5 FETCH DFLT//SCRN INFORMATION STB A,I SET INTO USER ARRAY * BMP2 ISZ MORE? ALL DONE? JMP NEXT NOPE-- CONTINUE * * IFN * * * LDA T267F IF WDS 27&28 WERE MODIFIED SZA,RSS GO JMP EXCLS DLD T267 RESET JSB ST278 THEM * XIF * * * EXIT * * * IF SIGN WAS SET ON GETFIL OPTION THEN DON'T CLOSE ANSW FILE * EXCLS LDA CLSE? FETCH ORIGIONAL OPTION SSA IF SIGN CLEAR GO CLOSE ANSW FILE JMP EX.2 NOPE --HARVEY WANTS IT LEFT OPEN,BYE * JSB CLOSE DEF EX.2 DEF GDCB EX.2 LDA ERR,I LOAD ERROR CODE JMP DGTFL,I * * * SPC 5 * * EX10 LDA N10 RSS * EX12 LDA N12 * STA ERR,I SET MASTER ERROR CODE WD * * THIS WD WILL CONTAIN THE LAST ERROR CODE ONLY * K JMP EXCLS SEE ABOUT CLOOSING INPUT--EXIT !! * * SKP * * SCTCH ISZ WD5 SET SCRATCH BIT * * IFZ * * * ELSE--IF B=0 GIVE SCR1 ON LCTU * --IF B=1 GIVE SCR2 ON RCTU * (B WAS SETUP BEFORE CALL TO SCTCH) * * SZB,RSS SCR1 OR 2 LDA N4 SCR1! SZB LDA N5 SCR2! STA C.ARR,I JMP BUMP * N4 OCT -4 N5 OCT -5 * XIF IFN SKP * * * INB IF ZERO--GIVE SCR1 * IF 1---GIVE SCR2 ADB B60 FORM ACSII DIGIT STB TEMP FOR FIRST CHAR (1 =SCR1, 2=SCR2) * CLB STB .P2 CLEAR -LU/+DRN WORD FOR CALL TO D.RFP * * BUILD SRCATCH NAME * LDA XEQT FETCH ID SEG ADDRESS ADA .12 ADVANCE TO NAME CLE,ELA MAKE IT A BYTE ADDRESS STA FBYTE SAVE IT FOR MOVE LDA C.ARR FETCH ADDRESS INA OF RESULT BUF CLE,ELA MAKE IT BYTE ADDRESSABLE ALSO STA TBYTE SAVE FOR MOVE * LDA N5 SET COUNTER STA RL2 FOR 5 BYTES * LDA TEMP FETCH FIRST CHAR OF NAME JSB STBYT GO SET IT * * MOVE IN PROGRAM NAME * MNME JSB GTBYT GO GET BYTE FROM NAME JSB STBYT GO SET INTO BUF ISZ RL2 BUMP COUNT, DONE?? JMP MNME NOPE * * SETUP D.RFP CALL TO CREATE SCRATCH FILE * AGAIN JSB .DRCT DEF .P3 FETCH DIRECT ADDRESS FOR MOVE STA B LDA C.ARR FETCH INA ADDRESS OF NAME JSB MVIT3 GO MOVE INTO CALL FOR CREATE * LDA T267F SEE IF WDS 27&28 SAVED YET SZA IF DONE JMP GTDNE CONTINUE * ISZ T267F SET SAVED FLAG LDA XEQT ELSE ADA .26 SAVE EM STA W27 SAVE ADDRESS FOR RESTORE DLD A,I DST T267 * GTDNE CLA CLEAR RECORD SIZE CLB CLEAR SECURITY CODE JSB ST278 GO SET THEM INTO THE IDSEG WDS 27&28 * GTD2 CLA,INA SET STA .P1 FUNCTION CODE LDA .3 FETCH TYPE LDB .60 FETCH SIZE * JSB CLD.R GO DO IT * LDA B,I ANY ERRORS? SSA,RSS JMP OK: NOPE * CPA N2 IF DUPLICATE NAME JMP PGE GO PURGE IT OFF * SCERR LDB C.ARR FETCH RESULT BUFFER INB ADVANCE TO WD2 STA B,I SET ERROR CODE STA ERR,I SET MASTER CODE JMP BUMP GO DO NEXT GUY SPC 5 PGE LDA .P4 FETCH WORD 4 OF NAME CCE SET SIGN RAL,ERA TO INDICATE STA .P4 SCRATCH PURGE * * SET UP OPEN CALL TO D.RFP * LDA .11 SET FUNCTION CODE STA .P1 JSB CLD.R GO DOIT * LDA B,I ANY ERRORS? SSA,RSS WELL JMP AGAIN GO DO CREAT NOW JMP SCERR NOPE --SET ERROR * SPC 5 OK: INB LDA B,I LDA .P2 FETCH TR/LU AND B77 ISOLATE LU CMA,INA SET IT NEG STA C.ARR,I SAVE IT FOR CALLER * LDA C.ARR FETCH ADDRESS OF CALLER'S BUF ADA .5 ADVANCE TO SECURITY WORD CLB STB A,I SET ZERO SEC CODE JMP BUMP * * SPC 5 ST278 NOP JSB $LIBR N NOP DST W27,I JSB $LIBX DEF ST278 SPC 5 W27 NOP T267F NOP N2 OCT -2 N5 OCT -5 .11 DEC 11 .12 DEC 12 .60 DEC 60 B60 OCT 60 .26 DEC 26 T267 BSS 2 * XIF SKP * * * BYTE MOVE SUBS * * SET:FBYTE=BYTE ADDRESS OF DATA TO BE MOVED * TBYTE=BYTE ADDRESS OF RESULT FIELD * * JSB GTBYT TO FETCH BYTE--RETURNS IN LOW BYTE * * JSB STBYT SO SET BYTE--EXPECTED IN LOW BYTE * * GTBYT NOP LDA FBYTE FETCH ADDRESS CLE,ERA PUT BYTE*N640 FLAG INTO E LDA A,I FETCH WORD HOLDING BYTE SEZ,RSS IF HIGH BYTE ALF,ALF POSITION TO LOW] AND B377 ISOLATE REQUESTED BYTE ISZ FBYTE JMP GTBYT,I EXIT * * * * * STBYT NOP STA TEMP SAVE BYTE TO BE MOVED LDB TBYTE FETCH DESTINATION BYTE ADDRESS CLE,ERB PUT BYTE FLAG INTO E LDA B,I FETCH DESTINATION WORD SEZ,RSS REQUESTED BYTE POS TO LOW BYTE ALF,ALF AND HBYTE SAVE THE HIGH BYTE IOR TEMP INCLUDE NEW BYTE SEZ,RSS SHIFT TO HIGH BYTE IF NEEDED ALF,ALF STA B,I RESTORE DESTINATION WORD ISZ TBYTE BUMP DESTINATION ADDRESS JMP STBYT,I EXIT * * FBYTE NOP TBYTE NOP B377 OCT 377 RL2 NOP IBCH DBL READ RLEN NOP HBYTE OCT 177400 COMMA OCT 54 COLON OCT 72 * * A EQU 0 B EQU 1 XEQT EQU 1717B END 6   92064-18062 1650 S C0122 &GDCBC CRTG GTFIL DCB             H0101 BASMB,R,L * NAME: GDCB * SOURCE: 92064-18062 * RELOC: 92064-16061 * PGMR: G.L.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM GDCB,7 92064-16061 REV.1650 760504 * ENT GDCB GDCB BSS 16 END   92064-18063 1650 S C0122 &OPENC CRTG OPEN SUB             H0101 dASMB,R,L,C HED OPEN * NAME: OPEN * SOURCE: 92064-18063 * RELOC: 92064-16061 * PGMR: G.L.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM OPEN,7 92064-16061 REV.1650 760927 * ENT OPEN EXT EXEC,RMPAR,CLOSE,$CRLK,IMESS EXT .ENTR,.MVW,.DRCT,$CDIR EXT $LIBR,$LIBX EXT .PDCV,$CON EXT CLD.R,.P1,.P2,.P3,.P4,.P5 SUP * * OPEN IS THE FILE OPEN ROUTINE OF THE REAL TIME * FILE MANAGEMENT PACKAGE * * THE FORTRAN CALLING SEQUENCE IS: * * CALL OPEN(IDCB,IERR,NAME,IOP,IS,ILU,IBLK) * * W H E R E: * * IDCB IS A 144-WORD DATA CONTROL BLOCK (ARRAY) * TO BE USED WITH ALL ACCESS TO THE FILE * UNDER THIS OPEN. * * IERR IS THE RETURN ERROR CODE (ALSO RETURNED IN A) * * NAME IS THE 6-CHARACTER (3 WORD) NAME ARRAY. * * IOP (OPTIONAL); IS THE OPEN OPTION FLAG WORD * OPTIONS ARE: * BIT MEANING IF SET * 0 NON-EXCLUSIVE OPEN * 1 UPDATE OPEN * 2 FORCE TO TYPE 1 OPEN * 3 USE SUB FUNCTION IN BITS 6-11 * IF TYPE 0. * * IS (OPTIONAL); IS THE EXPECTED SECURITY CODE. * * ILU (OPTIONAL); IS THE DISC SPECIFIED. * IF ILU >0 THEN USE DISC LABELED ILU * IF ILU <0 THEN USE DISC AT LOGICAL UNIT (-ILU) * * * OPEN ERRORS ARE AS FOLLOWS: * * -1 DISC ERROR * -6 FILE NOT FOUND * -7 WRONG SECURITY CODE * -8 FILE IS CURRENTLY OPEN (IF EXCLUSIVE REQUEST) OR * IS CURRENTLY OPEN TO 7 OTHER PROGRAMS * -9 ATTEMPT TO OPEN TYPE 0 AS TYPE 1 * -10 NOT ENOUGH PARAMETERS * -13 DISC LOCKED * -18 ILLEGAL LU (LU TOO LARGE OR NOT DEFINED) * SKP OPEN NOP ENTRY POINT LDA DZERO RESET ENTRY PARMS STA NAME STA OP STA SC STA LU CLA STA ZERO STA EQT5 LDA SPC STA RW LDA OPEN SET PARM ADDR STA DPEN INTO DUMMY ENTRY POINT. JMP DPEN+1 * .4 OCT 4 N2 OCT -2 DCB NOP ERR NOP NAME DEF ZERO OP DEF ZERO SC DEF ZERO LU DEF ZERO IBLK DEF ZERO SPC 1 DPEN NOP ENTRY POINT JSB .ENTR TRANSFER PARAMETERS DEF DCB TO LOCAL AREA JSB NRUN GO CHECK IF NEW RUN LDB NAME DID WE GET CPB DZERO ENOUGH PARAMETERS? JMP EXN10 NO; ERROR - EXIT * LDA OP FETCH ADDRESS OF OPTION CPA DZERO IF NO OPTN WORD JMP NOPSE SKIP CHECK OF OPTN BITS LDA A,I FETCH OPTION * ELA SET PAUSE\NO PAUSE FLAG? SSA,RSS SCRATCH OPEN? JMP OP.1 NO--GO SEE IF PAUSE WAS REQUESTED * LDB DSCR FETCH ADDR. OF SCR. MESSAGAE LDA LU,I CAN'T HAVE 0 FOR LU SZA,RSS MUST HAVE LU ON SCRATCH OPENS JMP EXN10 ERROR-- NOT ENOUGH PARMS. STB NAME SET SCR. AS NAME TO BE PRINTED * OP.1 SEZ,RSS SEE IF PAUSE NEEDED. JMP NOPSE NO--CONTINUE * LDA LU FETCH LU PARM (AGAIN) CPA DZERO IF NO LU GIVEN-- CLA,RSS OUTPUT ZEROES LDA A,I ELSE FETCH GIVEN LU * SSA MAKE IT POS(MIGHT NEED TO INDICATE NEG FOR LU) CMA,INA IF NEG, FOR CONVERSION * * * CONVERT IT TO ASCII DECMIAL * JSB .PDCV GO PRIV AND CALL SYS ROUTINE * STA ODLU SET RESULT INTO PRINT BUFFER * * * FETCH PROG NAME AND SET INTO PRINT BUF * LDB XEQT FETCH ID SEG ADDR ADB .14 ADVANCE TO LAST WORD LDA B,I FETCH IT AND HBYTE NOW ISOLATE IT IOR B40 INCLUDE BLANK STA PG3 SAVE FOR PRINT ADB N2 BACKUP TO FIRST WD OF NAME DLD B,I FETCH 1ST TWO WORDS DST PG1 SAVE FOR PRINT * LDA NAME LDB NMEA MOVE FILE NAME INTO JSB .MVW PRINT BUFFER DEF .3 NOP * * * USE CORRECT TERMINAL FOR MESSAGE * JSB IMESS DEF PSR DEF .2 DEF PGNA,I DEF .12 * PSR JSB EXEC SUSPEND THE PROGRAM DEF NOPSE DEF .7 * * OPERATOR INTERACTION REQUIRED HERE * * NOPSE JSB CLOSE GO CLOSE THIS DCB DEF NO.2 DEF DCB,I * NO.2 SZA ANY ERRORS? CPA N11 IGNORE NOT OPEN RSS IT'S OK JMP EXIT * * CHECK FOR MAGIC NAME * LDB NAME FETCH ADDRESS OF NAME LDA B,I FETCH FIRST TWO CHARACTERS CPA MJ.. CHECK FOR MAGIC FILE NAME(LU) INB,RSS FIRST TWO CHARS MATCH -CONTINUE JMP NORM NOPE NOT MAGIC NAME--CONTINUE LDA B,I FETCH CHARS 3&4 CPA LU.. CHECK FOR NEXT TWO MAGIC CHARS(..) INB,RSS GOT EM--ADVANCE TO ASCII LU(2 DIGIT) JMP NORM NOPE--NORMAL CALL * * FOUND MAGIC NAME * BUILD DUMMY DCB INFO * LDA B,I FETCH ASCII LU STA TEMP1 SAVE IT ALF,ALF POSITION FIRST DIGIT TO LOW END AND B17 ISOLATE IT STA VALUE SAVE FOR MULT. LDA .10 FETCH BASE FOR CONVERSION MPY VALUE CONVERT TO BINARY STA VALUE SAVE RESULT LDA TEMP1 FETCH ORIGINAL ASCII VALUES AND B17 ISOLATE SECOND DIGIT m ADA VALUE INCLUDE CONVERTED VALUE JSB TYPER GO GET DEVICE TYPE AND SUB-CHNL * * DEVICE TYPE RETURNS IN (A) * SUB-CHNL IS IN "SUBC" * * IF LU WAS NOT ASSIGNED, A ERROR-18 (ILLEGAL LU) EXIT * IS TAKEN FROM TYPER * LDB B100 FETCH EOF CODE FOR MT TYPE DEVICES ADA N7K SEE IF TYPE GREATER THAN 17 SSA,RSS WELL? JMP STEOF YES IT IS--GO STORE THE EOF CODE * * CHECK FOR 2644\5\7 CTU'S * LDA EQT5 RESTORE TYPE CODE CPA B24K IS THIS DVR05 RSS YES--SKIP JMP BRF NOPE GO TRY SOMETHING ELSE LDA SUBC FETCH SUBCHANNEL CPA .1 LCTU? JMP STEOF YES --GO SET EOF CODE(B100) CPA .2 RCTU? JMP STEOF YES-- SEE ABOVE^^^^^^^^^^^^ * * BRF LDB B1000 EOF CODE FOR PUNCH CPB EQT5 IT'S ALSO TYPE CODE FOR DVR02 RSS YEP IT'S A PUNCH--USE EOF CODE IN B LDB B1100 EVERYONE ELSE DEFAULTS TO 1100B STEOF STB EOF SAVE CODE * * BUILD DCB INFO * LDA DUM SET DUMMY STA DCB,I DCB FLAG * LDA OP,I FETCH SUBFUNCTION AND B3700 ISOLATE GOOD BITS IOR VALUE INCLUDE LU STA WD3 SAVE IT LDA EOF INCLUDE EOF CODE NOW IOR VALUE STA WD4 SET FOR DCB MOVE * * NOT SURE IF THIS IS NEEDED * LDA VALUE FETCH LU AGAIN SZA IF ZERO LU--ALLOW WRITE ONLY JMP NOZRO NOT ZERO-CONTINUE INA SET FOR WRITE ONLY STA RW SAVE READ WRITE CODE NOZRO JMP RTN GO BUILD DUMMY DCB * * * MID-CONSTANTS * * MJ.. ASC 1,LU LU.. ASC 1,.. TEMP1 NOP VALUE NOP EQT5 NOP SUBC NOP EOF NOP B17 OCT 17 B100 OCT 100 N7K OCT 170777 B24K OCT 2400 .1 OCT 1 B1100 OCT 1100 B400 OCT 400 * * NORM LDA NAME CLE CLEAR E FOR SCRATCH TEST CPA DSCR IF SCRATCH OPEN-FORCE CLA,CME INVALID FILENAME LDA A,I * STA .P3 SET FOR CALL TO D.RTR ISZ NAME GET DLD NAME,I REST OF NAME * SZA,RSS PAD LDA BLNK WITH BLANKS SZB,RSS IF LDB BLNK NEEDED * RAL,ERA IF SCR- SET SIGN OF P4 DST .P4 NAME AND SET FOR D.RTR CALL LDA .10 SET FUNCTION STA .P1 FOR D.R LDA LU,I SET LU STA .P2 FOR D.R * JSB CLD.R GO CALL D.R * * * SCRTN JSB RMPAR YES; GET THE RETURN DEF *+2 CODES DEF .P1 TO LOCAL AREA * * LDA .P1 GET ERROR WORD SZA EVERY THING OK? JMP EXIT NO,ERROR--EXIT * * * NER LDA .P2 CHECK FOR DEVICE FILE STA DCB,I SET TYPE(DEVICE VS. USER FILE) * * STANDARD USER FILE -- BUILD DCB * STA WD3 SAVE LU AND B77 REMOVE SUBFUNCTION STA B IOR EFCO ADD EOF CODE STA WD4 SET FOR DCB * ADB LCODE CONFIGURE LOCATE STB XTMP CONTROL REQUEST * LDA .P4 FETCH ABSOLUTE FILE NUMBER STA IPRM1 SAVE FOR POSITION CALL JSB EXEC ISSUE CONTROL REQUEST TO LOC. ABS FILE # IPRM1 DEF RTN DEF .3 DEF XTMP DEF IPRM1 * * STATUS CHECK HERE?? MUST HAVE GOOD POS OR BAD OPEN-- * RTN LDB DCB BUILD DEFAULT USER BUFFER LDA EQT5 FETCH DEVICE CODE/0 SZA,RSS IF ZERO LDA .P5 THEN GET FILE TYPE INB ADVANCE TO DCB1 STA B,I SET DEVICE\FILE TYPE INTO DCB INB ADVANCE TO FILE TYPE CLA SET TYPE TO ZERO STA B,I LDA WD3A FETCH FROM ADDRESS FOR MOVE INB ADVANCE TO WD3 * JSB .MVW MOVE IN REST OF DCB INFO. DEF .4 NOP * * INB SEE ABOU}T USING SEC WORD LDA IPRM1 FETCH FILE # STA B,I SET INTO DCB * INB ADVANCE TO OPEN WORD LDA XEQT SET DCB OPEN TO STA B,I THIS PROGRAM * ADB .5 CLA,INA SET REC NUM TO 1 STA B,I * * SEE IF PRE-FUNCTION IS REQUIRED * LDB OP,I FETCH OPTION WORD BLF,BRS POSITION TO SLB THE INHIBIT BIT(#13) LDA EQT5 FETCH DEVICE TYPE/ZERO CPA B1000 PUNCH? JMP IH? GO SEE IF LEADER HAS BEEN INHIBITED CPA B400 PHOTO READR LDA B700 CONTROL CODE TO SET EOT SZA,RSS IF NOT ONE OF ABOVE SKIP CONTROL JMP SPCN1 SPCFN LDB VALUE FETCH LU IOR B COMBINE FOR CONTROL WORD STA VALUE DON'T NEED LU ANY MORE-- * JSB EXEC DEF SPCN1 DO DEF .3 SPECIAL PRE-FUNCTION--(SET EOT DEF VALUE IF PHOTO READR,PUNCH LEADER ON PUNCH) * * * SPCN1 LDB DCB CACULATE DCB SUB FUNCTION ADB .3 ADDRESS STB SC SAVE IT LDB OP GET THE OPTIN SUB FUNCTION CPB DZERO JMP NOOP NOT GIVEN--EXIT LDA B,I FETCH ACTUAL OPTION WORD AND .8 CHECK "F" BIT SZA,RSS IF NOT SET JMP NOOP USE FUNCTION CODE DEFINED AT CREATION * LDA B,I FETCH OPTN AGAIN AND B3700 ISOLATE FUNCTION CODE STA B AND SAVE IT LDA SC,I GET THE CURRENT WORD AND B77 SAVE THE LU ADA B ADD IN THE NEW SUB FUNCTION STA SC,I SET IT IN THE DCB NOOP CLA,RSS CLEAR A AND EXIT EXN10 LDA N10 RSS ERN18 LDA N18 SPC 1 EXIT STA ERR,I SET THE ERROR CODE JMP DPEN,I AND RETURN * SPC 2 IH? SLB IF INHIBIT BIT WAS SET JMP SPCN1 DON'T DO LEADER JMP SPCFN ELSE DO IT SPC 5 * * * * TYPER SUBROUTINE * FETCHES DEVICE TYP|E AND SUB-CHNL * LDA LU * JSB TYPER * RETURNS DEVICE TYPE IN (A) * * * * CDIR NOP * TYPER NOP STA VALUE * JSB EXEC DEF STRTN DEF STAT DEF VALUE DEF EQT5 DEF EOF DEF SUBC * STRTN JMP ERN18 BAD LU EXIT * * TYP2 LDA EQT5 AND TYPE ISOLATE TYPE CODE BITS STA EQT5 JMP TYPER,I * * STAT OCT 100015 TYPE OCT 37400 * * NRUN NOP LDB $CON,I SSB,RSS JMP NRUN,I * JSB $LIBR NOP ELB,CLE,ERB STB $CON,I * CLB LDA $CRLK FETCH MASTER LOCK CPA XEQT OPEN THIS GUY? STB $CRLK CLEAR IT IF IT WAS * JSB .DRCT DEF $CDIR STA CDIR ADA N1 STA STOP INA NXT1 CPA STOP,I JMP NRUNX ADA .3 LDB A,I CPB XEQT CLB STB A,I INARS INA JMP NXT1 * * NRUNX JSB $LIBX DEF NRUN * HBYTE OCT 177400 DUM EQU HBYTE BUM EQU HBYTE B40 OCT 40 .12 DEC 12 .14 DEC 14 * SPC 3 WD3A DEF WD3 WD3 NOP WD4 NOP SPC OCT 100001 RW OCT 100001 * LCODE OCT 2700 IPRM1 NOP EFCO OCT 100 SPC 3 DZERO DEF ZERO N11 DEC -11 N10 DEC -10 .5 OCT 5 .7 OCT 7 .8 DEC 8 .10 DEC 10 ZERO NOP .2 DEC 2 .3 DEC 3 N18 DEC -18 B3700 OCT 3700 B1000 OCT 1000 B700 OCT 700 B77 OCT 77 STOP NOP N1 OCT -1 * * PGNA DEF *+1 PG1 BSS 2 PG3 BSS 1 ASC 1,: OUT1 ASC 2,OPEN OCT 26407 ASCII "- BELL" NME BSS 3 ASC 1, > ODLU NOP * SCR ASC 3,SCR. BLNK EQU SCR+2 DSCR DEF SCR NMEA DEF NME XTMP EQU OPEN SPC 3 A EQU 0 B EQU 1 XEQT EQU 1717B SPC 3 END EQU * END 0.**0   92064-18064 1650 S C0122 &CLOSC CRTG CLOSE SUB             H0101 qASMB,R,L,C HED CLOSE * NAME: CLOSE * SOURCE: 92064-18064 * RELOC: 92064-16061 * PGMR: G.L.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM CLOSE,7 92064-16061 REV.1650 761010 * ENT CLOSE EXT EXEC,.ENTR,CLD.R,.P1,.P2 SUP * * THIS IS THE CLOSE SUBROUTINE--A PART OF THE * REAL-TIME FILE MANAGEMENT PACKAGE * * THE ASSEMBLY CALL TO CLOSE A FILE IS: * * JSB CLOSE * DEF RTN RETURN ADDRESS * DEF IDCB DATA CONTROL BLOCK ADDRESS * DEF IERR (OPTIONAL) ERROR CODE RETURNED HERE AND IN A REG * DEF IRX (OPTIONAL) NO. OF 128 WORD DOUBLE *RTN SECTORS TO BE DELETED FROM THE FILE * * ERRORS ARE: * 0 NONE * -1 DISC DOWN * -10 NOT ENOUGH PARAMETERS * -11 FILE NOT OPEN * -13 DISC LOCKED * * * SKP * CLOSE NOP LDA DZ RESET PARMS STA IDCB STA IERR STA IRX LDA CLOSE STA DLOSE SET PARM ADDR IN DUMMY ENT JMP DLOSE+1 * IDCB DEF CLOSE DCB ADDRESS IERR DEF CLOSE ERROR CODE ADDRESS IRX DEF CLOSE TRUNICATE CODE ADDRESS SPC 1 DLOSE NOP ENTRY POINT JSB .ENTR TRANSFER THE ADDRESSES DM DEF IDCB LDA IDCB IF NO PARAMETERS CPA DZ THEN JMP ER10 ERROR EXIT ADA .9 ADD 9 TO GET THE THE OPEN FLAG STA OPNFL SAVE THE OPEN FLAG ADDRESS LDB A,I GET THE OPEN FLAG CPB XEQT FILE OPEN? CLE,RSS YES SKIP JMP ER11 NO; ERROR EXIT * * I  * CLB SET FUNCTION STB .P1 CODE FOR CLOSE LDA IDCB,I SET LU/TYPE SSA IF DEVICE--DON'T JMP SKIP CALL D.R CMA,INA SET NEGATIVE STA .P2 FOR D.R JSB CLD.R GO CALL D.R * CLA STA OPNFL,I CLEAR THE OPEN FLAG STB IDCB,I CLEAR M FLAG LDA B,I FETCH ERROR CODE EXIT STA IERR,I SET ERROR CODE JMP DLOSE,I * SKIP LDA IDCB INA LDB A,I FETCH DEVICE TYPE CPB B1000 PUNCH?? RSS YEP JMP SSCC ADA .3 ADVANCE TO EOF CODE STA CNT * JSB EXEC GO DEF SSCC DO DEF .3 IT CNT NOP SPC 2 * SSCC CLA 0 FOR ERROR RETURN JMP EXIT SPC 3 ER11 CCA FILE NOT OPEN - ERROR 11 ER10 ADA N10 NOT ENOUGH PRAMS - ERROR 10 JMP EXIT GO EXIT SPC 3 N10 DEC -10 .3 OCT 3 B1000 OCT 1000 .9 DEC 9 OPNFL NOP DZ DEF CLOSE SPC 2 A EQU 0 B EQU 1 XEQT EQU 1717B SPC 1 END EQU * SPC 1 END V   92064-18065 1650 S C0122 &READC CRTG READ SUB             H0101 fbASMB,R,L,C HED READF * NAME: READF * SOURCE: 92064-18065 * RELOC: 92064-16061 * PGMR: G.L.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM READF,7 92064-16061 REV.1650 761115 * ENT READF,WRITF EXT EXEC,.ENTR SUP UNL * * * THIS IS THE RTE FILE MANAGEMENT PACKAGE * READ/WRITE SUBROUTINE. * * THIS ROUTINE WILL READ OR WRITE ANY TYPE FILE. * * * CALLING SEQUENCE: * * CALL READF(IDCB,IERR,IBUF,IL,L,N) * * O R * * IER = READF(IDCB,IERR,IBUF,IL,L,N) * * TO READ, O R * * CALL WRITF(IDCB,IERR,IBUF,IL,N) * * O R * * IER = WRITF(IDCB,IERR,IBUF,IL,N) * * TO WRITE. * * * W H E R E: * * IDCB IS THE 16 WORD DATA CONTROL BLOCK * FOR THE REFERENCED FILE. * LST * IERR IS THE ERROR RETURN LOCATION * ERRORS ARE AS FOLLOWS: * * CODE ERROR CONDITION * 0 OR >0 NO ERROR * -5 ILLEGAL RECORD NUMBER OR * ATTEMPT TO READ A RECORD NOT WRITTEN * -10 A REQUIRED PARAMETER IS MISSING * -11 THE DCB IS NOT OPEN * -12 SOF OR EOF SENSED ON READ * -17 ILLEGAL REQUEST TO A TYPE ZERO FILE * * IER SEE IERR - RETURNED AS FUNCTION * UNL * IBUF IS THE BUFFER TO BE USED TO READ OR WRITE. * * IL IS THE REQUESTED TRANSFER LENGTH IN WORDS. * * L IS THE LENGTH AS READ IN WORDS. * * sN IS THE REQUESTED RECORD NUMBER * IF N>0 OR IF N<0 THE RELATIVE RECORD * NUMBER FROM THE CURRENT POSITION. * N IS LEGAL ON TYPE 1 AND 2 FILES ONLY. * * * O P T I O N S: * * IL IS OPTIONAL ON TYPE 1 AND 2 FILES. * ON TYPE 1 FILES, 128 IS USED; * ON TYPE 2 FILES THE RECORD LENGTH IS USED. * * L IS OPTIONAL AT ALL TIMES. * * N IS OPTIONAL AND IS IGNORED ON FILES * OF TYPES OTHER THAN 1 AND 2. IF NOT * SUPPLIED, ZERO IS USED. * THE FIRST RECORD IN A FILE IS RECORD #1. * * * E X T E R N A L S: * * RW$UB IS USED TO READ OR WRITE WORDS * FROM OR TO FILES OF TYPE 2 OR * ABOVE. IT HANDLES ALL SECTOR, * TRACK, AND EXTENT SWITCHING FOR * THESE FILES AND ALSO WRITES AND/OR * READS BLOCKS FROM THE FILE AS * REQUIRED. READS ARE CONDITIONAL * ON RFLG$. A GLOBAL FLAG WHICH * MUST BE NON-ZERO BEFORE A READ * IS EXECUTED. * * RW$UB CALLING SEQUENCE IS: * * LDB #WORDS * LDA DCB ADDRESS * CLE/CCE WRITE/READ * JSB RW$UB CALL * DEF UBUF ADDRESS OF USER'S BUFFER * JMP ERROR ERROR RETURN (A = CONDITION) * -- NORMAL RETURN SKP LST WRITF NOP WRITE ENTRY POINT LDA WRITF TRANSFER RETURN ADDRESS STA DEADF TO READ ENTRY JMP RST GO RESET ENTRY PARMS * READF NOP READ ENTRY POINT LDA READF TRANSFER RETURN ADDRESS STA DEADF TO DUMMY ENTRY POINT CCA SET ENTRY FLAG RST STA ENTFG SET ENTRY FLAG * LDA DZERO RESET STA BUF ENTRY STA IL PARMS STA L FOR M-SYSTEM JMP DEADF+1 GO FETCH ENTRY PARMS * SSPC 3 DCB NOP DCB POINTER IERR NOP ERROR BOX BUF DEF ZER0 USER BUFFER ADDRESS IL DEF ZER0 REQUEST LENGTH L DEF ZER0 RETURN LENGTH N DEF ZER0 RECORD NUMBER DEADF NOP READ ENTRY POINT JSB .ENTR TRANSFER THE DEF DCB PARAMETERS LDB DCB SET ADB .3 UP STB LU0 NEEDED INB DCB STB EOF0 POINTERS ADB .2 STB RL ADB .3 STB OCFLG ADB .5 STB RC * SPC 2 LDA N10 PRESET FOR MISSING PRAM ERROR LDB BUF BUFFER MUST BE CPB DZERO SUPPLIED JMP EXIT ELSE MISSING PRAM LDB OCFLG,I IF NOT OPEN ADA N1 CPB XEQT THEN JMP TYP00 SPC 5 EXIT STA IERR,I SET THE ERROR CODE JMP DEADF,I RETURN SPC 2 EOFT0 CCA SET RETURN LEGNTH STA L,I FOR EOF SPC 2 EXIOK ISZ RC,I STEP RECORD COUNT CLA DONE - OK SO JMP EXIT EXIT SKP TYP00 LDB ENTFG IF READ STB TMP SET READ WRITE FLAG FOR EOF TEST LDA RL,I GET THE READ WRITE LEGAL FLAG SSB,RSS IF WRITE RAR SHIFT THE WRITE FLAG TO BIT 15 SSA,RSS TEST THE FLAG JMP EX17 ILLEGAL REQUEST GO EXIT SPC 1 CCA IF READ SSB THEN JMP TYP01 SKIP * CPA IL,I EOF? JMP EOFW0 YES; GO MAKE CONTROL RQ SPC 1 TYP01 CLA,INA SET UP THE REQUEST CODE SSB,RSS FOR THE CALL INA AND ELA,RAR (PREVENT ABORTS) STA RQ SET IT FOR THE CALL. JSB EXEC CALL DEF RTN THE DEF RQ EXEC DEF LU0,I FOR DEF BUF,I I/O DEF IL,I TO/FROM USER BUFFER. RTN JMP EX17 CALL REJECTED BY DRIVER p ISZ TMP TEST READ WRITE JMP EXIOK GO EXIT IF WRITE STB L,I SET THE RETURN LENGTH SPC 1 RAL,CLE,ELA PUT THE DOWN BIT IN E ALF,RAL SHIFT THE EOF BIT RAL TO BIT 15 SSA IF EOF BIT SET JMP EOFT0 GO DO EOF THING * SZB IF ZERO WORDS READ THEN SKIP JMP EXIOK ELSE GO EXIT GOOD XFER * AND B70 MASK THE HIGH ORDER TYPE BIT SEZ,CCE,SZA IF NOT DOWN OR IF TYPE<10 THEN EOF JMP TYP00 ELSE RETRY THE XFER * JMP EOFT0 * * * * * * SPC 2 EOFW0 JSB EXEC WRITE TYPE ZERO EOF DEF EOFRT RETURN ADDRESS DEF .3 DEF EOF0,I DEF N1 EOFRT JMP EXIOK SPC 3 EX17 LDA N17 SET UP ILLEGAL REQUEST FLAG JMP EXIT GO EXIT SPC 2 * * * C O N S T A N T S N1 OCT -1 N10 DEC -10 N17 DEC -17 .2 OCT 2 .3 OCT 3 .5 OCT 5 B70 OCT 70 DZERO DEF ZER0 TMP EQU READF ENTFG EQU WRITF ZER0 NOP * LU0 NOP EOF0 NOP RL NOP OCFLG NOP RC NOP SPC 5 RQ NOP SPC 3 A EQU 0 B EQU 1 XEQT EQU 1717B SPC 1 PLENG EQU * END W  92064-18066 1650 S C0122 &CLDRC CRTG DIR PRG CALL SUB             H0101 ASMB,R,L,C * NAME: CLD.R * SOURCE: 92064-18066 * RELOC: 92064-16061 * PGMR: G.L.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM CLD.R,7 92064-16061 REV.1650 761018 * HED CALL ROUTINE FOR D.RC 761018 ENT CLD.R,.P1,.P2,.P3,.P4,.P5 EXT EXEC,$D.RC,$OPSY,$CON * * * THIS ROUTINE PROVIDES A CENTRAL * CALLING POINT FOR THE SCHEDULING * OF D.R. * * * RTE-M1 MAY NOT HAVE THE SCHEDULING * ABILITY FOUND IN M2 & M3. THEREFORE * THIS ROUTINE WILL DO A DIRECT ENTRY * IN THE M1 ENVIRONMENT IF THE DIRECTORY * MANAGER ($D.RC1) WAS RELOCATED INTO * THE RESIDENT LIBRARY. * * * * .P1 NOP .P2 NOP .P3 NOP .P4 NOP .P5 NOP TMPA NOP TMPA2 NOP * CLD.R NOP ENTRY POINT DST TMPA SAVE THE A AND B REGS LDA $D.RC FETCH THE SUBROUTINE FLAG SSA,RSS WAS M1 VERSION LOADED?(DUMMY ENT =-1) JMP M1 YES--GO DO DIRECT ENTRY IF M1 * LDA TMPA RESTORE A JSB EXEC NOW SCHED DEF BACK D.R WITH DEF SCED WAIT AND QUEUE DEF D.RC PASSING DEF .P1 THE FIVE TEMPS IN THE CALL. DEF .P2 FOUR MORE PARMS MAY BE PASSED BY DEF .P3 USING WDS 27&28 OF CALLERS ID SEG DEF .P4 ALONG WITH THE A AND B REGS. D.R CAN THEN DEF .P5 DETERMINE HIS FATHERS ID ADDRESS AND PROCEDE * TO FETCH ANY EXTRA PARMS AS REQUIRED * BACK JMP ERR8 SCHEDULE ERROR * EXIT TO CALL  ING PROG. * RETURN PARMS MAY BE FETCHED BY RMPAR * * JMP CLD.R,I * * M1 LDA $OPSY FETCH OP SYS TYPE CPA N7 ALLOW RE-ENTRANT CALL ONLY IN M1 RSS OK---SKIP JMP ERR26 NO!!!! GIVE ERROR AND ABORT * JSB $D.RC DIRECT ENTRY TO D.R IN LIBRARY DEF M1BK DEF .P1 * M1BK JMP CLD.R,I EXIT, SEE ABOVE FOR INFO ON RETURN PARMS * * N7 DEC -7 * SCED OCT 100027 D.RC ASC 3,D.RCR * * ERR8 LDA E8 SCHEDULE ERROR RSS ERR26 LDA E26 ATTEMPT TO USE M1 SUB IN 2/3 SYS STA CPE SET THE ERROR CODE * LDA $CON,I FETCH LU FOR MESSAGE AND B77 ISOLATE LU STA LU SAVE IT FOR CALL * JSB EXEC DEF P1TN DEF .2 DEF LU DEF EBUF DEF .5 * P1TN LDB XEQT FETCH IDSEG ADDRESS ADB .12 ADVANCE TO NAME LDA B,I MOVE STA PN1 FIRST WORD INB DLD B,I FETCH NEXT TWO STA PN2 SET WORD 2 SWP GET LAST WORD TO A AND HBYTE ISOLATE HIGH BYTE IOR B40 INCLUDE BLANK STA PN3 SET INTO BUF * JSB EXEC DEF P2TN DEF .2 DEF LU DEF ABUF DEF .8 * P2TN JSB EXEC DEF *+2 DEF .6 * * .2 OCT 2 .5 OCT 5 .6 OCT 6 .12 DEC 12 B40 OCT 40 B77 OCT 77 HBYTE OCT 177400 LU NOP E8 ASC 1,08 E26 ASC 1,26 EBUF ASC 4, FMGR 0 CPE BSS 1 ABUF ASC 1, PN1 NOP PN2 NOP PN3 NOP ASC 4, ABORTED .8 DEC 8 * * XEQT EQU 1717B B EQU 1 * * END EQU * END b   92064-18067 1650 S C0122 &DD.RC CRTG DUMMY ENT             H0101 gASMB,R,L,C * NAME: DD.RC * SOURCE: 92064-18067 * RELOC: 92064-16061 * PGMR: G.L.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM DD.RC,7 92064-16061 REV.1650 761005 * ENT $D.RC * * THIS ROUTINE SUPPLIES A DUMMY ENTRY POINT FOR CLD.R * ONLY IF WE ARE NOT IN A M1 SYSTEM. IN WHICH CASE, THE * DIRECTORY MANAGER MUST HAVE BEEN RELOCATED INTO THE MEM- * RESIDENT LIBRARY. IF THIS WAS NOT DONE, THIS ENTRY POINT * WILL CAUSE THE PROGRAM TO BE ABORTED (FMGR 026). * * * * * * $D.RC OCT -1 * END   92064-18068 1650 S C0122 &IMESS RTE-M FMP IMESS SUB             H0101 ASMB,R,L,C * NAME: IMESS * SOURCE: 92064-18068 * RELOC: 92064-16064 * PGMR: G.L.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM IMESS,7 92064-16064 REV.1650 760628 * * IMESS READS/WRITES TO THE CONSOLE FROM WHICH THE PROGRAM * WAS SCHEDULED. IF NOT SCHEDULED BY OPERATOR, LU 1 IS USED. * AFTER DETERMINING THE CORRECT LU (FROM $CON) THIS CALL MAPS * DIRECTLY INTO AN EXEC READ/WRITE CALL. * * * CALLING SEQUENCE: * JSB IMESS * DEF RETURN * DEF IO 1=READ/2=WRITE * DEF BUFAD BUFFER ADDRESS * DEF COUNT BUFFER LENGTH * * ON RETURN A AND B ARE AS EXEC LEFT THEM * EXT .ENTR,EXEC,$CON * ENT IMESS * IO NOP BUFAD NOP CCNT NOP * * IMESS NOP JSB .ENTR DEF IO * LDA $CON,I AND B77 ISOLATE LU IOR ECHO STA LU * * JSB EXEC DEF MESSR DEF IO,I DEF LU DEF BUFAD,I DEF CCNT,I * MESSR JMP IMESS,I * ECHO OCT 400 LU NOP B77 OCT 77 END * @  92064-18069 1650 S C0122 &LIMEN RTE-M MEMORY LIMITS SUB             H0101 "eASMB,R,L,C * NAME: LIMEM * SOURCE: 92064-18069 * RELOC: 92064-16065 * PGMR: G.L.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM LIMEM,7 92064-16065 REV.1650 760927 * EXT .ENTR,$LIBR,$LIBX * ENT LIMEM * * .1 OCT 1 .3 OCT 3 .8 DEC 8 .9 DEC 9 .13 DEC 13 .14 DEC 14 .15 DEC 15 * CURLO NOP TMP1 NOP W24 NOP W27 NOP TP24 NOP DLIM DEF LIMEM * * * WHEN 0 WORDS AVAIL-- * RETURN= * IFW=0 * IWAS=0 * A,B AND SEG PARMS ARE UNDEFINED * * * SKP * * THIS ROUTINE LOCATES AVAILABLE MEMORY AND CHANGES * THE HIGH MAIN ADDRESS OF THE CALLING PROGRAMS * ID-SEGMENT TO ASSIGN AVAILABLE MEMORY TO THE PROG. * THIS ROUTINE ALSO RESETS THE THE ABOVE MODIFIED * ADDRESS IF REQUESTED TO DO SO. * * * CALLING SEQUENCE: * * JSB LIMEM * DEF RTN * DEF WHICH <0=RELEASE \ >=0 =FETCH * * DEF FWAM FIRST WORD AVAIL * DEF NUM NUMBER OF WORDS AVAIL * * DEF FWAMS FIRST WORD AVAIL PAST CURRENT SEG * DEF NUMS NUMBER OF WORDS AVAIL PAST CURR. SEG. * * RTN XXX * * NOTE! ONLY "WHICH" IS REQUIRED * * SPC 5 LIMEM NOP * LDB DLIM STB IWH STA IFW STB IWDS STB IFWAS STB IWS LDA LIMEM STA DIMEN JMP DIMEN+1 * * IWH DEF LIMEM IFW DEF LIMEM IWDS DEF LIMEM * *OPTIONAL PARAMETERS * IFWAS DEF LIMEM IWS DEF LIMEM * DIMEN NOP JSB .ENTR FETCH PARMS DEF IWH * LDA XEQT INITIALIZE ADA .14 STA TMP1 CURRENT ADA .9 STA W24 ID ADA .3 STA W27 * LDB TP24 SEE IF MEMORY ASSIGNED CLA SZB JSB SETIT YES IT WAS, GO RESET( STA TP24 --STB W24,I) * * * LDA IWH,I FETCH TYPE WORD SSA CHECK RELEASE OR FETCH JMP EXIT IT'S RELEASE--ALL DONE * * * FETCH AVAILABLE MEMORY * * DETERMINE PROGRAM TYPE * LDA TMP1,I FETCH WORD CONTAINING TYPE AND .15 ISOLATE TYPE CPA .1 CHECK FOR FOREGROUND TYPE(1) JMP SRCH YES IT IS--GO FIND FREE MEMORY * * COULD THERE EVER BE A CONFLICT WHERE APLDR * MIGHT TAKE THE FREE AREA BEFORE THE IDSEG * COULD BE FUDGED? -- IF SO THIS WHOLE ROUTINE * SHOULD BE PRIV. * * * WE ARE IN A PARTITION-- ALLOCATE THE REST OF IT. * TOP LDB AVMEM HIGH LDA W24,I FETCH START ADDRESS(MAIN) * * GO SET INTO IDSEG * JSB SETIT (STA TP24 ---STB W24,I) * RSS SKIP 0 WORD ENTRY * BAD CLB BAD IS USED WHEN 0 WORDS ARE AVAIL (A=0) STA IFW,I SET AS FWAM FOR CALLER * CMA,INA CALCULATE ADA B NUMBER OF WORDS AVAILABLE STA IWDS,I SET FOR CALLER * * LDA W27,I FETCH CURRENT SEGMENT HIGH SZA ANY SEGS LOADED?S INA,RSS BUMP PAST LAST WORD IN SEG LDA IFW,I NO SEGMENTS HAVE BEEN LOADED STA IFWAS,I CURRENT SEG HIGH OR PROG. CMA,INA CALCULATE # WORDS ADB A AVAILABLE STB IWS,I RETURN VALUE TO USER * * EXIT JMP DIMEN,I * * * IF PROG IS NON-SEGMENTED(WD 27 OF IDSEG =0) * * ON RETURN--A=FWA * B=#WDS * IF SEGMENTED-- * A=FWA PAST SEG * B=#WDS AVAIL PAST SEG * * * * SKP * * SRCH UkLDA INDB FIRST TIME,INDIRECT THRU (B) STA CURLO LDB KEYWD STB SETIT SAVE IDSEG POINTER * SR2 LDB SETIT,I FETCH ADDRESS OF ID SEG SZB,RSS IF END OF KEYWD TABLE JMP END * ADB .13 ADVANCE TO TYPE WD. LDA B,I FETCH TYPE SZA,RSS THIS IDSEG ASSIGNED JMP NO NOPE--TRY NEXT ONE INB ADVANCE TO TYPE WORD LDA B,I FETCH IT AND .15 ISOLATE TYPE CPA .1 ONLY CHECK TYPE 1 PROGS JMP FG IT'S TYPE 1--CONTINUE * NO ISZ SETIT DIDN'T LIKE LAST ONE--GET NEXT ONE JMP SR2 CONTINUE SEARCH * * FG ADB .8 ADVANCE TO LOW MAIN WORD LDA B,I FETCH LOW MAIN CMA,INA NEGATE STA TMP1 SAVE FOR SECOND TEST ADA W24,I IS THIS LOW MAIN > CALLERS HIGH MAIN? SZA,RSS IF EQUAL JMP BAD THEN EXIT 0 WORDS AVAILABLE SSA,RSS LOW > CALLER HIGH? JMP NO NO--TRY NEXT ONE * * FIRST TIME THRU-- * B=ADDR OF LOW MAIN &CURLO POINTS AT (B),I * SO RESULT WILL BE ZERO AND ADDRESS WILL BE SAVED. * * LDA TMP1 FETCH CURRENT -LOW MAIN ADA CURLO,I SEE IF THIS LOWEST FOUND * VERIFY THAT SGN WILL WORK IN ALL CASES!!!!???? * SSA,RSS STB CURLO YES IT'S THE LOWEST YET-SAVE IT * JMP NO NOT LOWEST--TRY NEXT ONE * * END LDB CURLO SEE IF ANY BODY IS ABOVE CALLER CPB INDB CHECK AGAINST RESET VALUE JMP TOP NO ONE ABOVE--ALLOCATE REST OF MEMORY LDB B,I GOT ADDRESS -- FETCH VALUE JMP HIGH GOT IT--GO SET THIS AS NEW HIGH MAIN * * * SETIT NOP JSB $LIBR NOP STA TP24 STB W24,I JSB $LIBX DEF SETIT * INDB OCT 100001 FIRST TIME ADD INDIRECT THRU (B) KEYWD EQU 1657B XEQT EQU 1717B AVMEM EQU 1751B A EQU 0 B EQU 1 * END * '   92064-18070 1709 S C0122 &FAKER CRTG DUMMY SUBS             H0101 ASMB,R,L,C * NAME: FAKER * SOURCE: 92064-18070 * RELOC: 92064-16061 * PGMR: G.L.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM FAKER,7 92064-16061 REV.1709 770316 * * * ENT DCMC,CREAT,APOSN,POST,PURGE,NAMF,SEGLD,IDCBS * EXT .ENTR CREAT NOP APOSN EQU CREAT POST EQU CREAT PURGE EQU CREAT NAMF EQU CREAT SEGLD EQU CREAT * * LDA DZERO STA ERR PRE-SET ERROR WORD FOR POST CALL LDA CREAT STA DUMMY JMP DUM2 * * DBUF NOP ERR NOP BSS 6 DUMMY NOP DUM2 JSB .ENTR DEF DBUF * LDA N200 FETCH ERROR CODE STA ERR,I JMP DUMMY,I * * * * * DZERO DEF CREAT N200 DEC -200 * * * IDCBS NOP CLA LDB IDCBS,I JMP B,I * * DCMC NOP MOUNT/DISMOUNT CARTRIDGE DUMMY ROUTINE LDA N200 LDB DCMC,I JMP B,I B EQU 1 END hF  92064-18071 1650 S C0122 &LOCFC CRTG LOCF SUB             H0101 z[ASMB,R,L,C HED LOCF * NAME: LOCF * SOURCE: 92064-18071 * RELOC: 92064-16061 * PGMR: G.L.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM LOCF,7 92064-16061 REV.1650 761115 * ENT LOCF EXT .ENTR SPC 2 * * * LOCF RETURNS THE CURRENT STATUS OF A * RTE FILE TO THE CALLER. * SPC 1 * * THE FORTRAN CALLING SEQUENCE IS: * SPC 1 * CALL LOCF(IDCB,IERR,IREC,IRS,IOFF,JSEC,JLU,JTY,JREC) * SPC 1 * * W H E R E: * SPC 1 * IDCB IS THE DATA CONTROL BLOCK FOR THE FILE. * * IERR IS THE ERROR CODE RETURN. * POSSIBLE CODES ARE: * 0 - NO ERROR * -11 - DCB NOT OPEN * -10 - NOT ENOUGH PARAMETERS * * IREC IS THE RECORD NUMBER OF THE NEXT RECORD. * * IRS IS THE RELATIVE SECTOR OF THE NEXT RECORD./2 * * IOFF IS THE OFFSET IN THE SECTOR OF THE NEXT RECORD. * * JSEC IS THE NO. OF SECTORS IN THE FILE (OR EXTENT). * * JLU IS THE FILE'S LOGICAL UNIT. * * JTY IS THE FILE'S TYPE. * * JREC IS THE RECORD SIZE. * SPC 1 * ALL PARAMETERS AFTER IREC ARE OPTIONAL. * SKP LOCF NOP LDA DFDM RESET PARMS STA IREC STA JLU STA JTY LDA LOCF STA DOCF JMP DOCF+1 * DCB NOP IER DEF DM IREC DEF DM IRS DEF DM IOFF DEF DM JSEC DEF DM JLU DEF DM JTY DEF DM JREC DEF DM DOCF NOP ENTRY JSB .ENTR GET DFDCB DEF DCB PARAMETERS ADDRESSES LDA N10 +   NOT ENOUGH LDB IREC PRAM CPB DFDM TEST JMP EXIT NOT ENOUGH - EXIT LDA DCB SET A TO GET DCB ADA .3 STA LU ADA .6 STA OPCLS ADA .5 STA REC * * LDB OPCLS,I IS LDA N11 FILE CPB XEQT OPEN? JMP OK YES; JUMP EXIT STA IER,I NO; SET EXIT CODE JMP DOCF,I EXIT SPC 3 OK LDB REC,I GET AND STB IREC,I SET RECORD NO. LDA LU,I FETCH LU AND B77 ISOLATE LU STA JLU,I CCB PRESET FOR CARTRIDGE TAPE FILE LDA DCB,I FETCH TYPE CPA DUMMY IF LU OPEN(A=177400B) THEN CLB RETURN A ZERO STB JTY,I * *ALL DONE--EXIT * CLA JMP EXIT * SKP LU NOP OPCLS NOP REC NOP DM NOP DFDM DEF DM * B77 OCT 77 DUMMY OCT 177400 N10 DEC -10 N11 DEC -11 .3 OCT 3 .5 OCT 5 .6 OCT 6 A EQU 0 B EQU 1 XEQT EQU 1717B SPC 1 END EQU * SPC 1 END j   92064-18072 1650 S C0122 &FCONC CRTG FCONT SUB             H0101 SASMB,R,L,C HED FCONT * NAME: FCONT * SOURCE: 92064-18072 * RELOC: 92064-16061 * PGMR: G.A.A. * MOD: G.L.M * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM FCONT,7 92064-16061 REV.1650 760806 * ENT FCONT EXT .ENTR,EXEC * * THIS IS THE TYPE ZERO CONTROL ROUTINE OF * THE RTE FILE MANAGEMENT PACKAGE. * * A STANDAD RTE CONTROL REQUEST IS ISSUED * TO THE DEVICE VIA THE EXEC IF THE * PCB IS OPEN TO A TYPE ZERO FILE. * CALLING SEQUENCE * CALL FCONT(IDCB,IERR,ICON1,ICON2) * WHERE: * IDCB IS THE DATA CONTROL BLOCK FOR * THE FILE. * IERR IS THE LOCATION FOR RETURNED * ERRORS. * POSSIBLE ERRORS ARE: * 0 NO ERRORS * -11 DCB NOT OPEN * -12 EOF SENSED * >0 NOT A TYPE ZERO FILE (IERR=TYPE) * ICON1 IS CONTROL WORD #1 - THE DEVICE * LU IS MURGED INTO THE LOW * 6 BITS OF THIS WORD * ICON2 IS CONTROL WORD TWO - OPTIONAL * ZERO IS USED IF NOT SPECIFIED * ON RETURN A = IERR SPC 3 * PRE CONSTANT AREA .3 OCT 3 SPC 3 FCONT NOP LDB DZERO RESET ONLY OPTIONAL STB ICON2 PARAMETER ?????????? STB ICON1 STB IERR STB IDCB CLB STB ZERO MUST CLEAR AS ICON2 IS DEFAULTED TO HERE LDA FCONT STA DCONT JMP DCONT+1 * IDCB DEF ZERO PARAMETER IERR DEF ZERO ADDRESS ICON1 DEF ZERO AREA ICON2 DEF ~ZERO * * CODES OF 12,13 OR 14 WILL ZAP RECORD COUNTER * SPC 1 DCONT NOP ENTRY POINT JSB .ENTR FETCH PARAMETERS DEF IDCB LDB IDCB GET DCB ADB .3 ADDRESS STB LU OF LU WORD INB AND STB EOFCD OF EOF CODE ADB .4 AND STB FILE# FILE# INB AND LDA B,I OPEN FLAG CPA XEQT OPEN? JMP OK YES, CONTINUE LDA N11 NO; SEND NOT OPEN ERROR EXIT STA IERR,I TO CALLER JMP DCONT,I RETURN SPC 2 * MID CONSTANT AREA SPC 1 N11 DEC -11 DZERO DEF ZERO ZERO NOP B77 OCT 77 SPC 1 * * THIS PREVENTS REQUESTS (10 AND 11) DIRECTED * AT CTU'S FROM WRITING EOF'S * * 10 AND 11 ARE SPACING REQUESTS FOR LINE PRINTER * OK ADB .5 STB RC ADDRESS OF RECORD COUNT * LDA ICON1,I FETCH FUNCTION CODE AND B7700 ISOLATE FUNCTION CODE ADA EOFMT CHECK FOR 10 SZA ADA N1 NOPE--HOW ABOUT 11? SZA JMP OK2 NOPE--GO CHECK IF REWIND AND FILE. * * MUST NOT BE MAG TAPE TYPE DEVICE * LDA EOFCD FETCH EOF CODE AND B3700 ISOLATE CODE ADA N100K IF MAG TAPE(CTU) SZA,RSS JMP EXIT GET OUT * OK2 LDA IDCB,I IF NOT DEVICE SSA,RSS JMP FILE GO TRAP REWIND REQUESTS * * * GOT A MT TYPE DEVICE SPC 3 OK3 LDA LU,I GET LU AND B77 AND ISOLATE THEN STA B SAVE LDA ICON1,I GET THE FUNCTION AND B1777 MAKE SURE THE LOW END IS ZERO IOR B PUT THEM TOGETHER STA ICON1 SET FOR CALL JSB EXEC CALL EXEC TO DEF EXRTN DO DEF .3 THE DEF ICON1 CONTROL DEF ICON2,I FUNCTION EXRTN CLA JMP EXIT GO; EXIT SPC 3 FILE LDA ICON1,I FE| TCH FUNCTION CODE AND B7700 ISOLATE FUNCTION CODE ADA N400K CHECK FOR REWIND SZA ADA N1 BOTH 4 AND 5 SZA JMP OK3 NOPE --GO DO IT * CLA,INA STA RC,I SET RECORD COUNT TO 1 LDA FILE# ADDRESS OF FILE# STA ICON2 FOR LOCATE CALL LDA ALOCA ADDRESS OF LOCATE FUNCTION STA ICON1 SET FOR LOCATE CALL JMP OK3 GO DO IT * * POST CONSTANT AREA SPC 1 FILE# NOP B2700 OCT 2700 ALOCA DEF B2700 N400K OCT -400 N1 OCT -1 B7700 OCT 7700 EOFMT OCT -1000 .4 OCT 4 .5 OCT 5 N100K OCT -100 LU NOP RC NOP EOFCD NOP B1777 OCT 177700 B3700 OCT 3700 B200 OCT 200 BS1R EQU B200 BACK SPACE 1 RECORD FS1R OCT 300 N12 DEC -12 FS1RA DEF FS1R SPC 2 A EQU 0 B EQU 1 XEQT EQU 1717B SPC 1 END EQU * SPC 1 END ؀  92064-18073 1650 S C0122 &RWNDC CRTG REWIND SUB             H0101 ASMB,R,L,C * NAME: RWNDF * SOURCE: 92064-18073 * RELOC: 92064-16061 * PGMR: G.A.A. * MOD: G.L.M * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM RWNDF,7 92064-16061 REV.1650 760427 * ENT RWNDF EXT .ENTR,EXEC * THE MODULE OF THE RTE FILE MANAGER PERFORMS * THE REWIND OR RESET FUNCTION * * A FILE IS RESET TO EXTENT 0 RECORD 1 VIA RWND$ * A TYPE ZERO UNIT IS REWOUND VIA AND EXEC CALL * * * CALLING SEQUENCE * * CALL RWNDF(IDCB,IER) * * WHERE: * * IDCB IS THE FILES DATA CONTROL BLOCK ARRAY * * IER IS THE ERROR RETURN LOCATION. * ERRORS ARE RETURNED IN THE A REG * ALSO. * ERRORS CODES ARE: * 0 NO ERROR * -11 DCB NOT OPEN * * SPC 2 * PRE CONSTANT AREA SPC 1 .3 DEC 3 TYPE NOP .5 DEC 5 * * RWNDF NOP LDB DFDM RESET ENTRY PARMS STB DCB STB IER LDB RWNDF STB DWNDF JMP DWNDF+1 SPC 3 DCB DEF DCB IER DEF DCB SPC 1 DWNDF NOP ENTRY POINT JSB .ENTR FETCH DFDM DEF DCB PRAM ADDRESSES SPC 1 LDB DCB GET DCB ADDRESS ADB .3 INDEX TO LU AND STB LU SET ADDRESS ADB .5 INDEX TO FILE# STB FILE# AND SAVE IT'S ADDRESS INB INDEX TO OPEN FLAG AND LDA B,I FETCH CPA XEQT OPEN? CLA,INA,RSS YES; SET AWRWND RECORD COUNT/SKIP JMP NOOPN NO; TAKE ERROR EXIT 3   ADB .5 INDEX TO RECORD COUNT AND STA B,I SET RECORD COUNT * LDB B2700 FETCH LOCATE CODE LDA DCB,I FETCH TYPE SSA IF SIGN SET(-1) LDB B400 IT'S A DEVICE-REWIND * HERE STB TEMP1 SAVE FUNCTION CODE * LDA LU,I GET LU AND B77 ISOLATE IT THEN ADA TEMP1 ADD THE FUNCTION BIT STA TYPE AND SAVE FOR EXEC SPC 1 AGAIN JSB EXEC CALL EXEC TO DEF EX1 REWIND\LOCATE DEF .3 TYPE DEF TYPE ZERO FILE FILE# NOP * EX1 CLA,RSS NO--PRERARE TO EXIT NOOPN LDA N11 NOT OPEN- EXIT -11 EXIT STA IER,I SET ERROR CODE JMP DWNDF,I RETURN * * * SPC 2 * MID CONSTANT AREA SPC 1 B77 OCT 77 B300 OCT 300 B400 OCT 400 B200 OCT 200 B2700 OCT 2700 TEMP1 NOP N11 DEC -11 LU EQU RWNDF SPC 3 * POST CONSTANT AREA SPC 1 A EQU 0 B EQU 1 XEQT EQU 1717B SPC 1 END EQU * SPC 1 END   92064-18074 1650 S C0122 &POSNC CRTG POSNT SUB             H0101 mASMB,L,R,C * NAME: POSNT * SOURCE: 92064-18074 * RELOC: 92064-16061 * PGMR: G.A.A. * MOD: G.L.M * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM POSNT,7 92064-16061 REV.1650 760426 * ENT POSNT EXT EXEC,.ENTR,READF,DSTAT * * POSNT IS THE FILE POSITION ROUTINE FOR THE * RTE FILE MANAGEMENT PACKAGE * * CALLING SEQUENCE: * CALL POSNT (IDCB,IERR,NP,IR) * WHERE: * IDCB IS THE FILES DATA CONTROL BLOCK * ADDRESS * IERR IS THE ERROR RETURN ADDRESS * POSNT ERRORS ARE: * 0 NONE * -1 DISC DOWN * -5 AN ILLEGAL RECORD WASENCOUNTERED * (LENGTHS AT EACH END DID NOT MATCH * -10 NOT ENOUGH PARAMETERS * -11 DCB NOT OPEN * -12 EOF OR SOF SENSED * NP IF >0 THEN SKIP NP RECORDS * IF <0 THEN BACK SPACE NP RECORDS * IF =0 THEN NO OPERATION * IR (OPTIONAL) IF NOT CODED OR ZERO * NP IS RELATIVE OTHERWIZE * NP IS ABSOLUTE (NP MUST BE>0) SPC 3 * PRE STORAGE SPC 1 .2 OCT 2 .4 OCT 4 .5 OCT 5 N10 DEC -10 N11 DEC -11 DFZER DEF ZERO ZERO NOP * * POSNT NOP LDA DFZER RESET ENTRY PARMS STA NP STA IR LDA POSNT STA DOSNT JMP DOSNT+1 * * DCB NOP ER NOP NP DEF ZERO IR DEF ZERO SPC 1 DOSNT NOP ENTRY POINT JSB .ENTR FETCH DEF DCB ADDRESSES R LDA N10 ENOUGH LDB NP PRAMS CPB DFZER SUPPLIED? JMP EXIT NO,EXIT * * * SETUP REQUIRED DCB ADDRESSES * * LDA DCB ADA .3 STA LU ADA .2 STA SPACE ADA .4 STA OPEN ADA .5 STA RC * LDA N11 GET NOT OPEN ERROR.CODE TO A LDB OPEN,I GET OPEN FLAG TO B CPB XEQT OPEN RSS * JMP EXIT NO; EXIT OPEN ERROR * LDA IR,I GET RELATIVE /ABSOLUTE FLAG CLB ASSUME ABSOLUTE SZA,RSS RELATIVE? LDB RC,I YES; GET CURRENT RECORD NO. ADB NP,I ADD THE REQUESTED MOVEMENT STB ABRC SAVE NEW ABSOLUTE ADDRESS CMB,INB SET NEGATIVE AND ADB RC,I COMPUTE RELATIVE RECORD NUMBER CMB,INB,SZB,RSS SET TO RIGHT SIGN - ZERO? JMP EXOK YES - GO EXIT STB RCOU NO; SET COUNT SPC 1 JMP TYP0 YES; GO TO TYPE ZERO ROUTINE * FORWARD SPACE TYPE ZERO AND 3 AND ABOVE FILES * FSRC STB RCOU SET COUNT FSRC1 JSB READF READ DEF REART A DEF DCB,I RECORD DEF ER,I TO DEF DUM LOCAL DUMMY DEF .1 ONE WORD BUFFER DEF LN REART SSA IF ERROR JMP EXIT EXIT LDB LN SSB JMP EOFEX ISZ RCOU JMP FSRC1 JMP EXIT SPC 2 N3 DEC -3 SPC 2 * TYPE ZERO SPACE ROUTINE SPC 1 TYP0 CMB,SSB,INB IF FORWARD SPACE JMP FSRC GO TO READ ROUTINE SPC 1 LDA N3 PRESET FOR ERROR LDB SPACE,I BACK SPACE GET SSB,RSS LEGAL CODE JMP EXIT BACK SPACE NOT LEGAL-EXIT SPC 1 LDA LU,I GET AND AND B77 ISOLALE LU ADA B200 ADD BACK SPACE FUNCTION STA CONND SET FOR CALL CCA SET FIRST EOF RECORD FLAG SPC0 STA OPEN Ag IN OPEN JSB EXEC CALL EXEC DEF EXRTN TO DEF .3 BACK DEF CONND SPACE * EXRTN LDA LU,I FETCH LU JSB DSTAT FOR DYNAMIC STATUS CALL * * RETURNS EQT 5-(A) 4-(B) * AND B200 MASK EOF BIT CCB DECREMENT ADB RC,I THE RECORD COUNT STB RC,I CCB SET B TO FORWARD SPACE 1 SZA,RSS IF EOF TEST FOR FIRST JMP *+3 ELSE SKIP TO COUNT THE RECORD ISZ OPEN SKIP IF EOF ON FIRST RECORD JMP FSRC ELSE GO FORWARD SPACE ISZ RCOU DONE? JMP SPC0 NO; DO NEXT ONE JMP EXOK YES; GO EXIT SPC 2 N5 DEC -5 B200 OCT 200 B77 OCT 77 SPC 2 EXOK CLA,RSS GOOD EXIT EOFEX LDA N12 EOF/SOF EXIT SPC 1 EXIT STA ER,I SET ERROR AND JMP DOSNT,I RETURN SPC 2 N12 DEC -12 * POST STORAGE SPC 2 .1 DEC 1 .3 DEC 3 RCOU NOP OPEN NOP RC NOP CONND NOP LU NOP SPACE NOP LN NOP DUM NOP ABRC NOP SPC 2 A EQU 0 B EQU 1 XEQT EQU 1717B SPC 1 END EQU * SPC 1 END   92064-18075 1650 S C0122 &DSTAT RTE-M DYNAMIC STATUS SUB             H0101 ASMB,R,L,C * NAME: DSTAT * SOURCE: 92064-18075 * RELOC: 92064-16066 * PGMR: G.L.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM DSTAT,7 92064-16066 REV.1650 760421 * * DSTAT RETURNS DEVIICE STATUS IN A&B * * BUFFERED REQUESTS ARE ALLOWED TO CLEAR OUT * BY REQUESTING A DYNAMIC STATUS REQUEST FIRST. * * CALLING SEQUENCE: * LDA LU * JSB DSTAT * * ON RETURN: * A=EQT5 * B=EQT4 * * EXT EXEC ENT DSTAT * * DSTAT NOP AND B77 STA LU IOR DYST STA CNWD * JSB EXEC DEF RT1 DEF .3 DEF CNWD * * RT1 JSB EXEC DEF RT2 DEF .13 DEF LU DEF EQ5 DEF EQ4 * * RT2 DLD EQ5 JMP DSTAT,I * * EQ5 NOP EQ4 NOP LU NOP B77 OCT 77 .13 DEC 13 CNWD NOP .3 DEC 3 DYST OCT 600 END   92064-18076 1650 S C0122 &DTTY RTE-M INTERACTIVE LU SUB             H0101 | ASMB,R,L,C * NAME: DTTY * SOURCE: 92064-18076 * RELOC: 92064-16067 * PGMR: G.L.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM DTTY,7 92064-16067 REV.1650 760524 * * DTTY/.TTY DETERMINE IF THE REFERENCED LU IS ASSOCIATED * WITH A INTERACTIVE DEVICE (DVR00 OR DVR05 SC 0). * * .TTY CALLING SEQUENCE: * * JSB .TTY * DEF RTN * DEF LU OF DEVICE TO BE CHECKED * * * DTTY CALLING SEQUENCE: * * LDA LU OF DEVICE TO BE CHECKED * JSB DTTY * * * COMMON RETURN * * A=0 IF NOT INTERACTIVE * A#0 IF INTERACTIVE * * * EXT EXEC,.ENTR ENT DTTY,.TTY * * * LU NOP .TTY NOP JSB .ENTR DEF LU LDA .TTY STA DTTY LDA LU,I JMP DTTY2 * DTTY NOP DTTY2 SSA CMA,INA STA LU * JSB EXEC REQUEST STATUS DEF RT1 DEF .13 DEF LU DEF EQ5 DEF EQ4 DEF SPC * * RT1 LDA EQ5 CHECK FOR DVR00 AND TYPE SZA,RSS JMP GOOD YEP--TAKE GOOD EXIT * ADA NDVR5 CHECK FOR DVR05 SZA,RSS JMP SBCNL YEP--SO FAR SO GOOD--GO CHECK FOR SUB CHNL 0 * BAD CLA TAKE FALSE EXIT JMP DTTY,I * SBCNL LDA SPC FETCH SUB CHNL AND B77 SZA JMP BAD NOT ZERO GOOD CLA,INA ALL RIGHT--TAKE INTERACTIVE EXIT JMP DTTY,I * * * * SPC NOP .13 DEC 13 EQ5 NOP EQ4 NOP TYPE OCT 37400 NDVR5 OCT -2400 B77 OCT 77 * END * m    92064-18077 1650 S C0122 &NAM..RTE-M FILE NAME SUB             H0101 ʔASMB,R,L,C * NAME: NAM.. * SOURCE: 92064-18077 * RELOC: 92064-16068 * PGMR: G.A.A. * MOD: G.L.M * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM NAM..,7 92064-16068 REV.1650 760927 * ENT NAM.. EXT .ENTR SPC 3 * THIS ROUTINE CHECK FOR A LEGAL FILE NAME * CALLING SEQUENCE: * * JSB NAM.. * DEF *+2 * DEF NAME * * ON RETURN A=0 IF A LEGAL NAME -15 IF NOT LEGAL * * LEGAL NAMES MUST START WITH A NON NUMERIC NON BLANK * ASCII CHARACTER * AND MUST NOT CONTAIN +, OR - AS ANY CHARACTER * * FILE NAMES BEGINNING "LU.." ARE ILLEGAL * SPC 3 LU@@ ASC 1,LU @@ ASC 1,.. NAME NOP ADDRESS OF THE NAME NAM.. NOP ENTRY POINT JSB .ENTR GET THE PRAMS DEF NAME * DLD NAME,I FETCH 1ST 4 CHARS OF NAME CPA LU@@ CAN'T ALLOW RSS JMP NAM2 REFERENCES CPB @@ TO JMP ER15 LU.. * NAM2 LDB N6 SET TO CHECK STB COUNT 6 CHARACTERS LDB NAME RBL LDA NAME,I DO SPECIAL EXTRA CHECK ALF,CLE,ALF ON AND B377 FIRST CHARACTER ADA N60B IF NUMERIC OR BLANK SEZ,CME THEN ADA N10 TAKE SEZ THE CPA N20B ERR JMP ER15 EXIT CREA1 CLE,ERB GET THE NAME ADDRESS LDA B,I GET A NAME WORD ELB RESTORE ADDRESS FOR NEXT TIME SLB,INB,RSS INCREMENT SKIP IF ODD ELSE ALF,ALF ROTATE AND B3>'  77 MASK IT CPA COLON IF COLON CLA FOURCE ERROR ADA N40B BETWEEN " " SZA,RSS IF BLANK THEN JMP BLNK TAKE NOTE SEZ,CME AND ADA N13B "*" SEZ,CLE,RSS INCLUSIVE? JMP CREA2 YES - OK ADA N3 NO; BETWEEN SEZ,CME "." AND ADA N62B "_" CREA2 ISZ NAME CHARACTER AFTER BLANK?? SEZ NO; LEGAL OTHER WISE?? JMP ER15 NO GO TAKE ERROR EXIT CREA3 ISZ COUNT DONE? JMP CREA1 NO; DO NEXT CHARACTER CLA,RSS GOOD NAME EXIT ER15 LDA N15 ERROR EXIT JMP NAM..,I SPC 1 BLNK CCA SET BLANK FLAG STA NAME SO WE CAN DETECT JMP CREA3 INBEDDED BLANKS SPC 2 COUNT NOP COLON OCT 72 N62B OCT -62 N3 DEC -3 N13B OCT -13 N40B OCT -40 B377 OCT 377 N20B OCT -20 N60B OCT -60 N6 DEC -6 N10 DEC -10 N15 DEC -15 A EQU 0 B EQU 1 END ֮   92064-18078 1650 S C0122 &PMOVE RTE-M PRIV MOVE WORDS SUB             H0101 ngASMB,R,L,C * NAME: PMOVE * SOURCE: 92064-18078 * RELOC: 92064-16069 * PGMR: G.L.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM PMOVE,7 92064-16069 REV.1650 760512 * ENT PMOVE EXT $LIBR,$LIBX,.MVW * PMOVE NOP JSB $LIBR NOP JSB .MVW DEF PMOVE,I NOP ISZ PMOVE JSB $LIBX DEF PMOVE END   92064-18079 1650 S C0122 &CDCBO CRTG LIBR DCB             H0101 jKASMB,R,L * NAME: IDCB0 * SOURCE: 92064-18079 * RELOC: 92064-16062 * PGMR: G.L.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM IDCB0,7 92064-16062 REV.1650 761214 * ENT IDCB0 IDCB0 NOP REP 15 NOP END ʶ  92064-18080 1650 S C0122 &CDCB1 CRTG LIBR DCB             H0101 a.ASMB,R,L * NAME: IDCB1 * SOURCE: 92064-18080 * RELOC: 92064-16062 * PGMR: G.L.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM IDCB1,7 92064-16062 REV.1650 761214 * ENT IDCB1 IDCB1 NOP REP 15 NOP END   92064-18081 1650 S C0122 &CDCB2 CRTG LIBR DCB             H0101 b/ASMB,R,L * NAME: IDCB2 * SOURCE: 92064-18081 * RELOC: 92064-16062 * PGMR: G.L.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM IDCB2,7 92064-16062 REV.1650 761214 * ENT IDCB2 IDCB2 NOP REP 15 NOP END   92064-18082 1650 S C0122 &CDCB3 CRTG LIBR DCB             H0101 c0ASMB,R,L * NAME: IDCB3 * SOURCE: 92064-18082 * RELOC: 92064-16062 * PGMR: G.L.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM IDCB3,7 92064-16062 REV.1650 761214 * ENT IDCB3 IDCB3 NOP REP 15 NOP END Ϸ  92064-18083 1650 S C0122 &CDCB4 CRTG LIBR DCB             H0101 d1ASMB,R,L * NAME: IDCB4 * SOURCE: 92064-18083 * RELOC: 92064-16062 * PGMR: G.L.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM IDCB4,7 92064-16062 REV.1650 761214 * ENT IDCB4 IDCB4 NOP REP 15 NOP END   92064-18084 1650 S C0122 &CDCB5 CRTG LIBR DCB             H0101 e2ASMB,R,L * NAME: IDCB5 * SOURCE: 92064-18084 * RELOC: 92064-16062 * PGMR: G.L.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM IDCB5,7 92064-16062 REV.1650 761214 * ENT IDCB5 IDCB5 NOP REP 15 NOP END   92064-18085 1650 S C0122 &CDCB6 CRTG LIBR DCB             H0101 f3ASMB,R,L * NAME: IDCB6 * SOURCE: 92064-18085 * RELOC: 92064-16062 * PGMR: G.L.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM IDCB6,7 92064-16062 REV.1650 761214 * ENT IDCB6 IDCB6 NOP REP 15 NOP END   92064-18086 1650 S C0122 &CDCB7 CRTG LIBR DCB             H0101 g4ASMB,R,L * NAME: IDCB7 * SOURCE: 92064-18086 * RELOC: 92064-16062 * PGMR: G.L.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM IDCB7,7 92064-16062 REV.1650 761214 * ENT IDCB7 IDCB7 NOP REP 15 NOP END ×  92064-18087 1650 S C0122 &CDCB8 CRTG LIBR DCB             H0101 h5ASMB,R,L * NAME: IDCB8 * SOURCE: 92064-18087 * RELOC: 92064-16062 * PGMR: G.L.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM IDCB8,7 92064-16062 REV.1650 761214 * ENT IDCB8 IDCB8 NOP REP 15 NOP END ȗ  92064-18088 1650 S C0122 &CDCB9 CRTG LIBR DCB             H0101 i6ASMB,R,L * NAME: IDCB9 * SOURCE: 92064-18088 * RELOC: 92064-16062 * PGMR: G.L.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM IDCB9,7 92064-16062 REV.1650 761214 * ENT IDCB9 IDCB9 NOP REP 15 NOP END ͗  92064-18090 1650 S C0122 &IPUT RTE-M INTEGER STORE             H0101 HASMB,R,L,C HED IPUT * NAME: IPUT * SOURCE: 92064-18090 * RELOC: 92064-16070 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * * NAM IPUT,7 92064-16070 REV.1650 761024 B EQU 1 ENT IPUT EXT $LIBR,$LIBX ADDR BSS 1 VALUE BSS 1 IPUT NOP JSB $LIBR NOP ISZ IPUT DLD IPUT,I DST ADDR ISZ IPUT ISZ IPUT LDA VALUE,I LDB ADDR,I STA B,I JSB $LIBX DEF IPUT END   92064-18091 1650 S C0122 &MGLU RTE-M LU-FILENAME SUB             H0101 &ASMB,R,L,C * NAME: MGLU * SOURCE: 92064-18091 * RELOC: 92064-16072 * PGMR: G.L.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM MGLU,7 92064-16072 REV.1650 760805 * * THIS ROUTINE IS USED BY THE FMP TO SET UP A SPECIAL * NAME FOR THE REFERENCED LU WHICH ALLOWS AN LU TO * BE TREATED AS A TYPE ZERO FILE (YOU CAN DO OPEN\CLOSE ETC.) * * THIS NAME IS LU..XX WHERE XX IS THE ASCII LU. * * CALLING SEQUENCE: * * JSB MGLU * DEF RTN * DEF LU * DEF RESULT BUFFER * *RTN * * ENT MGLU EXT .ENTR,.PDCV SUP * .99 DEC 99 B77 OCT 77 * * LURX NOP MNAX NOP MGLU NOP JSB .ENTR FETCH PARMS DEF LURX * LDA LURX,I FETCH LU AND B77 ISOLATE GOOD PART CPA LURX,I THIS GUY OK? RSS YEP---CONTINUE LDA .99 NOPE--FORCE OPEN ERROR(BAD LU) * * JSB .PDCV GO CONVERT IT TO ASCII IOR BIT12 FORCE A BLANK TO A ZERO STA MJ.2 SET RESULT INTO MAGIC NAME LDA MJNM FETCH FIRST WORD STA MNAX,I SET RESULT IN CALLER'S BUFFER ISZ MNAX BUMP BUFFER POINTER DLD MJNM2 FETCH LAST TWO WORDS DST MNAX,I JMP MGLU,I GET OUT * BIT12 OCT 10000 * MJNM ASC 1,LU MJNM2 ASC 1,.. MJ.2 NOP END ENT IMESS * IO NOP BUFAD NOP CCNT NOP * * IMESS NOP JSB .ENTR DEF IO * LDA $CON,I AND B77 ISOLATE LU IOR ECHO STA LU * * JSB EXEC DEF MESSR 6   DEF IO,I DEF LU DEF BUFAD,I DEF CCNT,I * MESSR JMP IMESS,I * ECHO OCT 400 LU NOP B77 OCT 77 END * 2   92064-18092 1650 S C0122 &CK.SM RTE-M CHECKSUM SUB             H0101 SPL,L,O,M,C ! NAME: CK.SM ! SOURCE: 92064-18092 ! RELOC: 92064-16071 ! PGMR: G.A.A. ! ! *************************************************************** ! * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * ! * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * ! * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* ! * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ! *************************************************************** ! ! NAME CK.SM(7) " 92064-16071 REV.1650 761024" ! ! CK.SM:SUBROUTINE(BF,TYP)GLOBAL,FEXIT !CHECKSUM ROUTINE ! ! A CHECKSUM IS DONE ON BUFFER BF FOR ! RECORD TYPE TYP(1=RELOCATABLES, 0=>ABS) ! FEXIT IF BAD CHECKSUM ! IF [TT_BF-<8]>377K THEN GO TO RTNF DO[CSS_$(@BF+2);CS_$(@BF+1)] !INITIALIZE CHECKSUM IF TYP THEN BFBP_ -1,ELSE[\ !SET OFFSET AND IF ABS BFBP_1;CS_CSS+CS] !ADD WD THREE TO CS CLN_TT +@BF+BFBP !SET LAST WORD ADDRESS AND IFNOT TYP THEN CSS_$(CLN+1) !IF ABS. SET CHECKSUM FOR BFPT_@BF+3 TO CLN DO[CS_CS+$BFPT] !SUM IF CS=CSS THEN RETURN !CHECK & RETURN RTNF: FRETURN END END END$   92064-18093 1650 S C0122 &.PDCV RTE-M PRIV DEC CONV SUB             H0101 /ASMB,R,L,C * NAME: .PDCV * SOURCE: 92064-18093 * RELOC: 92064-16073 * PGMR: G.L.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM .PDCV,7 92064-16073 REV.1650 760725 * EXT $LIBR,$LIBX,$CVT1 ENT .PDCV .PDCV NOP JSB $LIBR NOP CCE JSB $CVT1 JSB $LIBX DEF .PDCV END   92064-18094 1650 S C0122 &MPRMP RTE-M PROMPT             H0101 qASMB,L,C * NAME : PRMPT * SOURCE: 92064-18094 * RELOC: 92064-16035 * PROGMR: E.J.W. BASED ON RTE-III VERSIONS G.A.A. * * **************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT * * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * **************************************************************** * * NAM PRMPT,1,10 92064-16035 REV.1650 761020 SUP PRESS ALL EXTRANEOUS LISTING EXT EXEC,EQLU A EQU 0 B EQU 1 * THIS INTERRUPT ROUTINE REPLACES (AUXTY IN RTE) WITH (PRMPT IN RTE II). * IT IS SCHEDULED ON INTERRUPT BY DVR00 IF THAT TERMINAL HAS BEEN * PROPERLY ENABLED (ON,CNTRL,LU,20) * PRMPT : DETERMINES LU IN ASCII & BINARY * OUTPUTS A ZERO LENGTH RECORD * OUTPUTS "LU>_" * REQUESTS A CLASS READ TO THE INTERRUPTING LU * SCHEDULES R$PN$,2,10 WITH :CLASS #,EQT4,LU,ASCII LU * W/O WAIT * TERMINATES,SAVING RESOURCES SPC 2 PRMPT EQU * STB EQT4 SAVE INTERRUPTING DEVICE'S EQT WORD 4 ADDRESS JSB EQLU OBTAIN LU IN BINARY & ASCII DEF *+1 SZA,RSS FOUND ONE ? JMP EXIT NO,TERMINATE. STA LU YES,SAVE LU IOR B400 READY PRINT BACK STA RLU SAVE READ LU + CNTRL IN RLU STB ASCLU SAVE ASCII LU XOR B2500 STA CONWD JSB EXEC DEF *+1+2 DEF D3 DEF CONWD CRLF JSB EXEC RESPOND WITH DEF *+1+4 ZERO LENGTH RECORD DEF DS2 DEF LU DEF BUFF DEF D0 NOP PROMT JSB EXEC RESPOND WITH DEF *+1+4 "LU>_" DEF DS2 DEF LU DEF BUFF DEF D2 NOP SPC 1 INPUT JSB EXEC PERFORM CLASS I/O RE"  AD DEF *+1+7 DEF DS17 DEF RLU DEF * DEF DM52 DEF LU DEF EQT4 DEF CLASS NOP SSA ERROR RETURN? JMP EXIT YES-BEAT IT ! SPC 1 SCHED JSB EXEC SCHEDULE R$PN$ W/O WAIT DEF *+1+3 DEF D10 DEF R$PN$ DEF CLASS * * IGNORE NOT SCHEDULED ERRORS SINCE R$PN$ IS CLASS GET SUSPENDED * EXIT JSB EXEC TERMINATE DEF *+1+3 & SAVE DEF D6 RESOURCES DEF D0 DEF D1 JMP PRMPT RESTART HERE ON INTERRUPT SPC 2 EQT4 BSS 1 LU BSS 1 B400 OCT 400 B2500 OCT 2500 RLU BSS 1 DS2 OCT 100002 D2 OCT 2 D3 DEC 3 CONWD NOP BUFF EQU * ASCLU ASC 2,00>_ PROMPT MESSAGE D6 DEC 6 D0 DEC 0 D1 DEC 1 CLASS NOP DM52 DEC -52 D10 DEC 10 R$PN$ ASC 3,R$PN$ DS17 OCT 100021 EOP EQU * SPC 2 END PRMPT ^   92064-18095 1650 S C0122 &MRSPN RTE-M R$PN$             H0101 tASMB,R,L,C * NAME : $MRSPS * SOURCE: 92064-18095 * RELOC: 92064-16036 * PROGMR: E.J.W. BASED ON RTE-III VERSIONS G.A.A. * * **************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT * * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * **************************************************************** * * NAM R$PN$,1,10 92064-16036 REV.1650 761020 SUP PRESS EXTRANEOUS LISTING EXT MESSS,EXEC,EQLU * A EQU 0 B EQU 1 * * * R$PN$ : DESCRIPTION * PROGRAM DESCRIPTION * FTN,L * PROGRAM R$PN$(1,10) * INTEGER BUFFER(22),PRAM(5),IREG(2),P1,P2,CLASS * EQUIVALENCE (PRAM(1),CLASS), * & (PRAM(2),IREG,REG,IA), * & (PRAM(3),IB), * & (PRAM(4),LU), * & (PRAM(5),ID) * CALL RMPAR(PRAM) * 1 REG = EXEC(21,CLASS,BUFFER,22,LU,ID,LULAS) * LU = MESSS(BUFFER,IB,LU) * * * GO TO 1 * END SPC 2 R$PN$ EQU * ENTRY POINT,SCHED BY PRMPT SPC 2 LDA B,I GET CLASS # AND C160K MASK OFF CLASS NO ONLY STA RQCLS & SAVE IT IOR B20K SET FOR SAVE CLASS STA CLASS & SAVE IT ! SPC 2 WAIT JSB EXEC CLASS I/O GET DEF *+1+7 DEF D21 DEF CLASS DEF BUFF DEF DM52 DEF LU DEF ID DEF RCLAS * LDA RCLAS RAR,SLA WAS THIS A READ RETURN? JMP WAIT NO, WAIT STB IB YES, SAVE XFER LOG CHARS SZB,RSS IF ZERO-LENGTH JMP ENABL SKIP PROCESSING CODE. SPC 2 TEST EQU * LDA BUFF TEST FOR FLUSH COMMAND CPA ASCF>  L JMP FL YES-FLUSH THIS LU'S BUFFER SPC 2 PROCS EQU * NO-PROCESS REQUEST JSB MESSS GIVE REQUEST DEF *+1+3 DEF BUFF DEF IB TO SYSTEM DEF LU SPC 2 SZA,RSS ANY MESSAGES ? JMP ENABL NO,WAIT FOR NEXT INPUT SPC 2 STA IA SAVE 'A'REG JSB EXEC & DISPLAY DEF *+1+7 SYSTEM DEF D18 MESSAGE DEF LU DEF BUFF DEF IA DEF LU DEF ID DEF RQCLS SPC 2 JMP ENABL NOW WAIT SPC 2 FL EQU * LDA B2300 SET UP CNWRD IOR LU TO FLUSH STA CONWD JSB EXEC PERFORM DEF *+1+4 I/O DEF D3 CONTROL DEF CONWD DEF CONWD DEF RQCLS SPC 2 ENABL EQU * LDB ID RETRANSLATE JSB EQLU INCASE LU WAS REASSIGNED DEF *+1 IOR B2000 STA CONWD JSB EXEC DEF *+1+2 DEF D3 REENABLE THE TERMINAL DEF CONWD JMP WAIT SPC 2 PRAM NOP BEGIN 5 WORD PRAM BUFFER CLASS EQU PRAM IA NOP PLEASE IB NOP DO NOT LU NOP RE-ARRANGE ID NOP THESE CONSTANTS D21 DEC 21 D3 DEC 3 C160K OCT 17777 KEEP BITS 0-12 DM52 DEC -52 BUFF BSS 26 D18 DEC 18 RCLAS NOP ASCFL ASC 1,FL CONWD NOP B2300 OCT 2300 B2000 OCT 2000 B20K OCT 20000 RQCLS NOP EOP EQU * SPC 2 END R$PN$ N*   92064-18098 1709 S C0122 &STRTM SYSTEM START-UP             H0101 FTN4,L C C C C NAME: STRTM C SOURCE: 92064-18098 REV 1709 770310 C RELOC: 92064-16080 C PGMR: R.K.J. C C *************************************************************** C * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * C * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * C * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* C * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C *************************************************************** C C C PROGRAM STRTM,1,1 C DIMENSION IBUF(105),IBUF2(33),NAPLD(3),NFIL(4) 1, IDCB(144),NAM(3),NERR(6),MERR(10),NMOFF(5) C EQUIVALENCE (NAM,IBUF2(2)),(NERR2,NERR(2)) 1,(K1,IBUF2(1)),(IC1,IBUF2(2)),(IC2,IBUF2(3)),(IC3,IBUF2(4)) 2,(K2,IBUF2(5)),(IP1,IBUF2(6)),(K3,IBUF2(9)),(IP2,IBUF2(10)) 3,(K4,IBUF2(13)),(IP3,IBUF2(14)),(K5,IBUF2(17)),(IP4,IBUF2(18)) 4,(K6,IBUF2(21)),(IP5,IBUF2(22)),(MERR,NFIL),(MERR(5),NERR) C DATA NAPLD/2HAP,2HLD,2HR /, NFIL/2H&S,2HTR,2HCM,2H / 1, ISCD/-2/, NERR/2HFM,2HP ,2HER,2HR ,2*2H /,MXCD/+1/ 2, NMOFF/2HOF,2H,S,2HTR,2HTM,2H,8/,IBUF/100*0/ C C CHECK FOR REEXECUTION TRY, AND REJECT IT C IF(MXCD.NE.1) GOTO 990 MXCD=-1 C C OPEN "&STRCM" FILE C CALL OPEN(IDCB,IERR,NFIL,0,ISCD) IF(IERR.LT.0) GOTO 800 C C SCHEDULE "APLDR" TO LOAD PROGRAMS SPECIFIED IN THE "&STRCM" FILE C 100 CALL READF(IDCB,IERR,IBUF,20,LEN) IF(IERR.NE.0) GOTO 800 IF(IBUF.EQ.2H/E) GOTO 200 C CALL PARSE(IBUF,LEN*2,IBUF2) IF(K1.NE.2) GOTO 870 C 110 LP1=1 LP2=0 IF((K2.EQ.1).AND.(IP1.EQ.2)) LP1=2 IF(K3.EQ.1) LP2=IP2 IF(K4.EQ.1) LP2=512*IP3 + IP2 C 120 CALL EXEC(9,NAPLD,LP1,LP2,IC1,IC2,IC3) IF(IFBRK(I)) 900,100 C C EXECUTE PROGRAMS SPECIFIED IN THE "&STRCM" FILE C 200 DO 290 I=1,86,21 CALL READF(IDCB,IERR,IBUF(I),20,IBUF(I+20))    IF(IERR.NE.0) GOTO 800 IF(IBUF(I).EQ.2H/E) GOTO 299 290 CONTINUE 299 CALL CLOSE(IDCB,IERR) C 300 DO 399 I=1,86,21 IF(IBUF(I).EQ.2H/E) GOTO 990 CALL PARSE(IBUF(I),2*IBUF(I+20),IBUF2) C IF(K1.NE.2) GOTO 870 CALL EXEC(10,NAM,IP1,IP2,IP3,IP4,IP5) IF(IFBRK(I)) 900,399 399 CONTINUE GOTO 990 C C ERROR PROCESSING SECTION C 800 IF(IERR.GE.0) GOTO 805 IERR=-IERR NERR(5)=2H - 805 NERR(6)=KCVT(IERR) IWD=10 810 CALL EXEC(2,1,MERR,IWD) GOTO 900 C 870 NERR=2HIN NERR2=2HP IWD=8 GOTO 810 C 900 CALL CLOSE(IDCB,IERR) 990 I=MESSS(NMOFF,10) END END$ b   92064-18099 1805 S C0122 &MFMGF FLEX. DISC FILE MANAGER             H0101 &ASMB,R,L * NAME: MFMGF * SOURCE: 92064-18099 * RELOC: 92064-16055 * PGMR: H.L.C. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM MFMGF,7 92064-16055 REV.1805 771019 END 7  92064-18100 1805 S C0122 &MFMGC CRTG FILE MANAGER             H0101 śASMB,R,L * NAME: MFMGC * SOURCE: 92064-18100 * RELOC: 92064-16017 * PGMR: H.L.C. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM MFMGC,7 92064-16017 REV.1805 771019 END '  92064-18101 1709 S C0122 &DCMCF FLEX DISC MC/DC             H0101 \ASMB,R,L,C * NAME: DCMCF * SOURCE: 92064-18101 * RELOC: 92064-16058 * PGMR: G.L.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM DCMCF,7 92064-16058 REV.1709 770323 * * ENT DCMC EXT EXEC,.ENTR,CLD.R,.P1,.P2,.P3,.P4,.P5 EXT $CDIR * * MOUNT/DISMOUNT SUBROUTINE * * CALLING SEQUENCE: JSB DCMC * DEF RTN * DEF WHICH * DEF LUDRN * DEF LSTRK (OPTIONAL) * RTN SZA * * ON RETURN A=OPERATION STATUS * A=0: GOOD OPERATION * A#0: FMP ERROR CODE * * WHICH=0: FOR MOUNT OPERATION * #0: FOR DISMOUNT OPERATION * * LUDRN= +DRN/-LU (ON MOUNT: +-LU) * * LSTRK= OPTIONAL LAST TRACK INFORMATION * USED IN MOUNT CALL * DCMC NOP CLA STA CALL STA LSTRK STA SECTR STA SEC.T LDA DCMC STA EXIT JMP EXIT+1 * CALL NOP LUDRN NOP LSTRK NOP EXIT NOP JSB .ENTR DEF CALL LDA LUDRN,I SSA CMA,INA STA LU LDB CALL,I FETCH CALL TYPE SZB JMP DISM DO DISMOUNT WORK * * NOTE FALL THRU TO MOUNT WORK * SKP * MOUNT CARTRIDGE SUBROUTINE * THIS ROUTINE PERFORMS THE FOLLOWING: * -CHECK DRIVER TYPE (MUST BE DISC) * -DETERMINE MAX LAST TRACK * -DOES VALIDITY CHECK ON DISK * PASSES CONTROL TO DIRECTORY MANAGER (D.RFP) WHO THEN: * -FINDS DIRECTORY SPACE * -CHECKS FLOR DUPLICATE DRN OR LU * -WRITES DIRECTORY ENTRY IN MEMORY RESIDENT LIBRARY (%TBLFP) * JSB EXEC GET STATUS ON LU DEF STRTN TO DETERMINE DRIVER TYPE DEF STCOD (100015B) DEF LU DEF EQT5 STRTN JMP BADLU IF LU IS UNDEFINED, EXIT LDA EQT5 AND DTYPE (36000B) CPA DISC (14000B) JMP GDLU BADLU LDA =D-18 JMP EXIT,I * CHECK FOR DVR30, IF SO, SKIP THIS SECTION GDLU LDA EQT5 AND TFLD TYPE CODE FIELD (37400B) CPA DISC TYPE 30 ? JMP DVR30 YES LDA =D9999 STA TRACK REQUEST READ FROM TRACK 9999 JSB RD128 RETURNS ACTUAL LAST TRACK IN B CCA ADB A * IF LAST TRACK NOT GIVEN, USE MAX LAST TRACK LDA LSTRK,I PASSED LAST TRACK SZA,RSS IF ZERO JMP DVR30+1 USE MAX LAST TRACK * LAST TRACK CANNOT BE > MAX LAST TRACK CMA,INA ADB A SUBTRACT FROM MAX LDA =D56 SSB JMP EXIT,I (LAST TRACK IS > MAX) DVR30 LDB LSTRK,I LDA =D55 SZB,RSS JMP EXIT,I STB TRACK * READ CARTRIDGE DIRECTORY JSB RD128 READ SECTOR 0 OF DIRECTORY TRACK * DO VALIDITY CHECK ON DIRECTORY * LDA DBUF FIRST WORD SSA,RSS MUST HAVE SIGN SET JMP NOINT (NOT INITIALIZED) LDA DBF3 WORD 3 (DRN) MUST BE POS NON-ZERO SSA,RSS SZA,RSS JMP NOINT LDA DBF8 WORD 8(# OF DIRECTORY TRACKS MUST BE NEG) SSA,RSS JMP NOINT LDA DBF7 FETCH LOWEST DIRECTORY TRACK CMA,INA SET IT NEG ADA DBF4 FIRST AVAIL. MUST BE < DIRECT. SSA,RSS JMP NOINT LDB DBF9 NEXT AVAIL. FMP TRACK SSB MUST BE A POSITIVE VALUE JMP NOINT CMB,INB ADB DBF7 AND--MUST BE LESS THAN OR EQUAL SSB TO LOWEST DIRECTORY TRACK JMP NOINT * IT IS OK!, SET UP DIRECTORY MANAGER CALL LDA =D7 P1=7 STA .P1 LDA LU P2=-LU STA .P3 CMA,INA P3=LU STA .P2 LDA TRACK P4=LAST TRACK STA .P4 LDA DBF3 P5=DISC REFERENCE STA .P5 CLA LDB =D-2 JSB CLD.R GOTO DIRECTORY MANAGER * FETCH ERROR RETURN LDA B,I (B IS POINTING TO ERROR) JMP EXIT,I * * DISC WAS NOT INITIALIZED SO RETURN -100 IN (A) * NOINT LDA =D-100 JMP EXIT,I * * STCOD OCT 100015 EQT5 EQU CALL LU NOP LUD EQU CALL SECTR NOP TRACK NOP SEC.T NOP CNT NOP * XEQT EQU 1717B CDIR DEF $CDIR * .1 DEC 1 .128 DEC 128 DTYPE OCT 36000 DISC OCT 14000 TFLD OCT 37400 DBUF BSS 128 DBF3 EQU DBUF+3 DBF4 EQU DBUF+4 DBF7 EQU DBUF+7 DBF8 EQU DBUF+8 DBF9 EQU DBUF+9 * A EQU 0 B EQU 1 * DISM - DISMOUNT SUBROUTINE PERFORMS THE FOLLOWING* * CHECKS FOR ANY FILES ON THIS LU OPEN TO THIS PROGRAM - * CALLS THE DIRECTORY MANAGER TO PLACE A LOCK ON THE * REQUESTED DISC - THIS ASSURES THAT NO ACTIVE OPEN * FILES EXIST ON THE DISC. * * CALLS THE DIRECTORY MANGER TO CLEAR THE DIRECTORY * ENTRY FOR THE DISC & CLOSE UP ANY GAPS IN THE * DIRECTORY CAUSED BY THE DISMOUNT. * * ON RETURN (EXIT VIA EXIT,I) * A=0: ALL IS OK * A#0: A=FMP ERROR CODE * DISM LDB =D2 STB SKIP1 STB SKIP2 LDA LUDRN,I SSA,RSS JMP CR CARTRIDGE REFERENCE GIVEN CLA STA SKIP1 LDA =D4 STA SKIP2 CR LDA CDIR STA LUD LDB A,I SZB,RSS JMP NOTFN END OF CARTRIDGE DIRECTORY ADA SKIP1 LDB A,I CPB LU JMP FOUND LU/CR FOUND IN DIRECTORY ADA SKIP2 JMP CR+1 * * NOTFN LDA =D54 NOT MOUNTED JMP EXIT,I ILLEGAL TO DISMOUNT * FOUND LDA LUD,I STA LU ISZ N1LUD LDA LUD,I STA TRACK LAST TRACK CCA STA CNT JSB RD16 READ SECTOR 0 OF DIRECTORY TRACK LDA DBUF+6 CMA,INA STA SEC.T - SECTORS PER TRACK FLP JSB RD16 READ DIRECTORY ENTRY FOR FILE LDB A,I A= ADDRESS OF DIRECTORY ENTRY SZB,RSS JMP OK END OF DIRECTORY - NO OPEN FILES CMB,SZB,RSS JMP FLP PURGED FILE - SKIP TO NEXT ADA =D9 LDB A,I OPEN FLAG ELB,CLE,ERB CLEAR 'EXCLUSIVE' BIT LDA =D-8 CPB XEQT JMP EXIT,I LOCK REJECTED - OPEN FILE JMP FLP SEARCH ALL OF DIRECTORY * * RD128 NOP READ A BLOCK JSB EXEC DEF R128X DEF .1 DEF LU BUFAD DEF DBUF DEF .128 DEF TRACK DEF SECTR R128X JMP RD128,I * * RD16 NOP GET ADDRESS OF NEXT DIRECTORY ENTRY ISZ CNT JMP RD.SK SKIP READ - ALREADY IN BUFFER LDA =D-8 STA CNT JSB RD128 READ A BLOCK LDA SECTR ADA =D14 LDB A ADB SEC.T NEXT SECTOR = (BLOCK*14) MOD SEC.T SSB LDB A STB SECTR CCA ADA TRACK SZB,RSS IF SECTOR ZERO STA TRACK GO TO NEXT DIRECTORY TRACK RD.SK LDA =D8 ADA CNT MPY =D16 ADA BUFAD ADDRESS OF ENTRY IN 'A' JMP RD16,I * * OK LDA =D3 SET FUNCTION CODE STA .P1 FOR DISC LOCK LDA LUDRN,I FETCH THE -LU/DRN STA .P2 SET FOR DIRECTORY MANAGER JSB CLD.R GOTO CLD.R LDA B,I FETCH ERROR CODE SZA JMP EXIT,I ERROR EXIT * DISC IS LOCKED SO NO OPEN FILES EXIST * SET UP DISMOUNT CALL TO DIRECTORY MANAGER * LDA =D7 SET FUNCTION CODE STA .P1 FOR DIRECTORY MODIFICATION * * .P2 STILL CONTAINS THE -LU/DRN * CLB SET P3=0 & SUBFUNCTION (P7 WHICH STB .P3  IS PASSED VIA B) =0 FOR DISMOUNT JSB CLD.R LDA B,I FETCH ERROR CODE JMP EXIT,I * SKIP1 EQU RD128 SKIP2 EQU RD16 END S   92064-18103 1740 S 0122 &MSY1R RTE-MI OP SYTEM             H0101 ASMB,R,L * * NAME: MSY1R * SOURCE: 92064-18103 * RELOC: 92064-16001 * PROGMR: E.J.W. * * **************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT * * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * **************************************************************** * * NAM MSY1R 92064-16001 REV.1740 770812 END   92064-18120 1740 S C0522 %RTMG0 SYSTEM GENERATOR             H0105 ASMB,R,L,C RTMGN HED RTMGN RTM SYSTEM GENERATOR NAM RTMGN,3,90 92064-16022 REV. 1740 770718 ************************************************** * * NAME: RTM GENERATOR MAIN CONTROL * PROGRAMMER: MIKE SCHOENDORF * DATE OF ORIGINAL ISSUE: OCTOBER 13, 1976 * * SOURCE: 92064-18120 * RELOCATEABLE: 92064-16022 ************************************************** A EQU 0 B EQU 1 ***************** - HIGH CORE - ****************** * * * - IDENTS - * * * ************************************************** * - FIXUP TABLES - * * ---------- * * * * * * ------- * * - LST - * ************************************************** * * * * * PROGRAM LOADING CONTROL * * * * * ************************************************** * * * * I/O TABLE GENERATION * * * * ************************************************** * * * * * PARAMETER INPUT * * * * * ************************************************** * * * SKP * * * * * * RTMGN PROGRAM TABLE FORMAT (IDENTS) * * WORD 1: IP1 - NAME 1,2 * WORD 2: IP2 - NAME 3,4 * WORD 3: IP3 - NAME 5,SC * * SC = 0 PROGRAM HAS BEEN LOADED * = XX (OCTAL) INT PRG * * * LST FORMAT * * WORD 1: LST1 - NAME 1,2 * WORD 2: LST2 - NAME 3,4 * WORD 3: LST3 - NAME 5, ORDINAL * WORD 4: LST4 - IDENT ADDRESS * WORD 5: LST5 - BP LINK ADDRESS * * * * ENTERNS AND EXTERNS * * * EXT ADDRS,ABRT1,BPAGA,BPLOC,CLBPL,CLFL2,CONSO,CRTIN EXT DCB2,EKHOS,ENTPT,ERROR,EXEC6 EXT FIXUP,FUT1,FUT4,FUTI,FUTS,KONSO EXT IDCB1,INACT,LDGEN,LENGT,LGUNT EXT LNKDR,LOCC,LST,LSTUL,LST1,LST4 EXT LST5,MAPS,.MEM1,.MEM2 EXT .MEM3,.MEM4,.MEM5,.MEM6,OPT.3 EXT PLK,PLK4,PLKS,PRCMD,PRINT EXT RDFL1,SSTBL,TIMES,TYPRO EXT UEXFL,UNDEF,?XFER,ZPRIV,ZRENT * ENT PNAME,PNAMA,PRAMS * * * * * .MEM. TABLE DEFINITIONS * * .MEM1 = FWABP * .MEM2 = LWABP * .MEM3 = FWAM * .MEM4 = LWAM * .MEM5 = FWAC * .MEM6 = LWAC * * * * ERROR CODES * * AD: INVALID ENTRY POINT * CH: INVALID CHANNEL NUMBER * DR: INVALID DRIVER NAME * DU: DUPLICATE PROGRAM NAME * EQ: INVALID EQT. NO. IN INT. RECORD * IN: PARAMETER INTERVAL EXECUTION ERROR * LU: INVALID DEVICE REFERENCE NUMBER * ON: INVALID ON PARAMETER * NA: PARAMETER NAME ERROR * PA: PARAMETER ERROR * PD: PARTITION ALREADY DEFINED * PR: PARAMETER PRIORITY ERROR * PS: NOT ENOUGH MEMORY LEFT FOR PARTITION * PT: PARTITION DEFINITION ERROR * SO: SYSTEM OVERFLOW * TB: SYMBOL TABLE/ID SEGMENT OVERFLOW * * SUP SKP * * THE SPACE SUBROUTINE IS USED TO SPACE UP THE TELEPRINTER. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB SPACE * * RETURN: CONTENTS OF A AND B ARE DESTROYED. * SPACE NOP CLA STA FTIME CLEAR FIRST TIME THRU FLAG LDB ZBUFF OUTPUT BLANK LINE CLA,INA JSB PRIN1 JMP SPACE,I RETURN * ZBUFF DEF *+1 ASC 1,* FTIME NOP xFIRST TIME THRU FLAG SKP * * ROUTINE TO RESERVE AND SET CORE ON THE * LOADER PRODUCED ABSOLUTE OUTPUT. * * CALLING SEQUENCE: * A = FINAL STARTING ADDRES * B = FINAL ENDING ADDRESS * * SETAD = ADDRESS OF THE OUTPUT DATA BUFFER * * JSB SETCR * * RETURN: A AND B ARE DESTROYED * SETCR NOP STA TEMP1 CMA,INA ADA ALBUF BUFFER ADDRESS STA PLKS OFFSET ADDRESS LDA TEMP1 STARTING ADDRESS STA PLK4 JSB PLK OUTPUT ROUTINE IN THE LOADER JMP SETCR,I * ALBUF DEF LBUF LBUF BSS 64 * * * SUBROUTINE TO DETERMINE IF ANSWER IS YES OR NO * MAYBE NOP JSB READ PRINT MESSAGE, GET REPLY LDA N2 GET FIRST TWO ASCII CHARACTERS JSB GETNA CCB CPA NO NO? CLB YES CPA YE YES? CLB,INB YES SSB,RSS ISZ MAYBE SSB JSB INERR PARMETER ERROR JMP MAYBE,I * NO ASC 1,NO YE ASC 1,YE SKP * * * * THE BUFCL SUBROUTINE STUFFS A 64 WORD BUFFER WITH CALL+1 * * CALLING SEQUENCE: * A = IGNORED * B = ADDRESS OF BUFFER * JSB BUFCL * CALL+1 = DATA TO BE STUFFED * * RETURN: CONTENTS OF A AND B ARE DESTROYED. * BUFCL NOP LDB ALBUF LDA N64 STA WDCNT SET BUFFER LENGTH = 64 LDA BUFCL,I GET STUFF DATA STA B,I CLEAR BUFFER WORD INB ISZ WDCNT ALL WORDS CLEAR? JMP *-3 NO - CONTINUE CLEARING ISZ BUFCL JMP BUFCL,I RETURN * N64 DEC -64 WDCNT NOP TEMPORARY WORD COUNTER SPC 5 * * SUBROUTINE TO CLEAR THE OUTPUT BUFFER * BUFC NOP JSB BUFCL OCT 0 JMP BUFC,I SKP * * ROUTINE TO COMPARE TWO NAME BUFFERS * * * CALLING SEQUENCE: * A = ADDRESS OF SOURCE NAME- 3 ENTRIES * B = ADDRESS OF TABLE 3 ENTRIES * JSB NACMP * * RETURN: A AND B ARE DESTROYED * (N+1) NAMES DO NOT COMPARE * (N+2) NAMES COMPARE * NACMP NOP STA TEMP1 SAVE SOURCE ADDRESS STB TEMP2 SAVE TABLE ADDRESS LDA N2 LOOP COUNT STA TEMP3 NACM1 LDA TEMP1,I SOURCE ENTRY CPA TEMP2,I TABLE COMPARE RSS YES,COMPARE, LOOK NEXT JMP NACMP,I NO IT DOESN'T RETURN ISZ TEMP1 BUMP SOURCE ISZ TEMP2 BUMP TABLE ISZ TEMP3 JMP NACM1 TRY AGAIN LDA TEMP2,I FIRST TWO COMPARE, LOOK LAST AND M400 LOOK UPPER ONLY STA B LDA TEMP1,I AND M400 CPA B ISZ NACMP BUMP RETURN FOR COMPARE! JMP NACMP,I * M400 OCT -400 TEMP1 NOP TEMP2 NOP TEMP3 NOP LWAM NOP * * HED ** SYSTEM BASE PAGE COMMUNICATION AREA ** *** SYSTEM BASE PAGE COMMUNICATION AREA *** * * * SYSTEM TABLE DEFINITION * * . EQU 1650B XI DEF .-1 ADDRESS OF INDEX REGISTER SAVE AREA EQTA DEF .+0 FWA OF EQUIPMENT TABLE INTLG DEF .+5 # OF INTERRUPT TABLE ENTRIES KEYWD DEF .+7 FWA OF KEYWORD BLOCK TBG DEF .+20 I/O ADDRESS OF TIME-BASE CARD SYSTY DEF .+21 EQT ENTRY ADDRESS OF SESSION CONSOLE * * DEFINITION OF SYSTEM LISTS (QUEUES) * * SKEDD DEF .+33 'SCHEDULE' LIST, * * DEFINITION OF MEMORY ALLOCATION BASES * * DUMMY DEF .+55 I/O ADDRESS OF DUMMY INT. CARD BPA1 DEF .+58 FWA USER BP LINK AREA LBORG DEF .+61 FWA OF RESIDENT LIBRARY AREA RTORG DEF .+62 FWA OF REAL-TIME COMMON RTCOM DEF .+63 LENGTH OF REAL TIME COMMON AREA AVMEM DEF .+65 LWA+1 MEMORY REAL TIME PARTITION BGORG DEF .+66 FWA OF BACKGROUND COMMON * * UTILITY PARAMETERS * BGLWA DEF .+87 LWA MEMORY BACKGROUND PARTITION BPCLR DEF .+43 HED RTMGN INITIALIZATION * * INITIAL TRANSFER IS MADE TO RTMGN BY INPUTTING * "ON,RTMGN,FI,LE,NM,E", WHERE "FILENM" IS THE INPUT * FILE NAME. IF NO FILE NAME, THE FIRST PARAMETER IS * THE LU OF THE INPUT. NO PARAMETERS 2 AND 3. PARA- * METER 4 IS THE ERROR LOG DEVICE LU. * * * THE FOLLOWING MESSAGES ARE PRINTED DURING THE INITIALIZATION * PHASE, WITH THE SPECIFICATIONS FOR EACH VALID RESONSE. * * * MESSAGE RESPONSE * * DEFINE OUTPUT DEVICES ENTER DEVICE LU, OR FILE NAME * FOR OUTPUT AND ECHO * * TYPE OF SYSTEM? ENTER 1 OCTAL DIGIT * * TBG CHNL? ENTER 2 OCTAL DIGITS * * PRIV. INT? ENTER 2 OCTAL DIGITS * * MEM SIZE? ENTER UP TO 3 DECIMAL DIGITS * * LWAM? ENTER UP TO 5 OCTAL DIGITS * * PRIV. DRIV. ACC. COM? ENTER YES OR NO * * FWA BP? ENTER UP TO 4 OCTAL DIGITS * * * RTMGN CLA GENERATOR CALLING STA KONSO STA LDGEN JSB LGUNT GET LOGICAL UNIT NUMBERS LDA OPT.3 STA LWAM CCA SET LINK DIRECTION FLAG STA LNKDR TO SYSTEM LINKS LDA P7 LDB MES01 RTMGN JSB PRIN2 PRINT MESSAGE * * DEFINE OUTPUT DEVICES * JSB SPACE NEW LINE OTPUT JSB INTER INTERACTIVE INPUT LDA P23 LDB MES31 DEFINE OUTPUT DEVICES JSB PRIN1 JSB PRCMD CALL LOADER SUBCONTROL JMP OTPUT ERROR, REPEAT INPUT * * SET TYPE OF SYSTEM * JSB SPACE NEW LINE TPSYS JSB INTER INTERACTIVE INPUT LDA P17 LDB MES14 TYPE OF SYSTEM? JSB READ PRINT MESSAGE, GET REPLY CLA,INA SET FOR 1 OCTAL DIGIT INPUT JSB DOCON GET DIGIT JMP TPSYS REPEAT INPUT STA SYSTM SAVE SYSTEM TYPE SZA,RSS MUST BE EITHER A 1, 2, OR 3 JMP ERRP1 INVALID PARAMETER CMA,INA ADA P3 SSA,RSS JMP TBG1 VALID PARAMETER ERRP1 JSB INERR ERROR JMP TPSYS REPEAT INPUT * * SET TIME BASE GENERATOR CHANNEL * TBG1 JSB SPACE NEW LINE CHNLT JSB INTER INTERACTIVE IN0HPUT LDA P11 LDB MES30 TBG CHNL? JSB READ PRINT MESSAGE, GET REPLY LDA P2 SET FOR 2 OCTAL DIGITS INPUT JSB DOCON GET DIGITS, RETURN OCTAL JMP CHNLT REPEAT INPUT STA TBCHN SET TBG CHANNEL NO. * * GET PRIV. INT. CARD ADDR. * JSB SPACE NEW LINE DUMY JSB INTER INTERACTIVE INPUT LDA P12 LDB MES41 PRIV. INT? JSB READ PRINT MESSAGE, GET REPLY LDA P2 SET FOR 2 OCTAL DIGITS INPUT JSB DOCON GET DIGITS JMP DUMY ERROR, REPEAT INPUT STA PIOC SET ADDR. OF DUMMY CARD. * * DETERMINE IF PRIV. DRIVERS ACCESS COMMON * LDA SYSTM GET SYSTEM TYPE CPA P3 RTE-M-III? RSS JMP LWSAM NO JSB SPACE NEW LINE PRCOM JSB INTER INTERACTIVE INPUT LDA P30 LDB MES15 PRIV. DRIVERS ACCESS COMMON? JSB MAYBE JMP PRCOM ERROR, REPEAT INPUT STB PCOM SAVE IF PRIV. DIRVERS ACCESS COMMON * * SET MEMORY SIZE * JSB SPACE NEW LINE MEMSZ JSB INTER LDA P11 LDB MES16 MEM SIZE? JSB READ PRINT MESSAGE, GET REPLY LDA N3 SET FOR 3 DECIMAL DIGITS INPUT JSB DOCON GET DIGITS JMP MEMSZ ERROR, REPEAT INPUT STA MSIZE SAVE MEMORY SIZE JMP FWENT-1 * * SET LAST WORD OF AVAILABLE MEMORY * LWSAM JSB SPACE NEW LINE JSB INTER INTERACTIVE INPUT LDA P7 LDB MES24 LWAM? JSB READ PRINT MESSAGE, GET REPLY LDA P5 SET FOR 5 OCTAL DIGITS JSB DOCON GET DIGITS JMP LWSAM+1 ERROR, REPEAT INPUT CPA UDFE =77777? ADA N1 YES STA .MEM4 LWAM STA LWSA1 LAST WORD SAM SKP * * SET FWABP LINKAGE * JSB SPACE NEW LINE FWENT JSB INTER INTERACTIVE INPUT LDA P9 LDB MES27 FWA BP? JSB READ PRINT MESSAGE,z GET REPLY LDA P4 JSB DOCON GET 4 OCTAL DIGITS, CONVERT JMP FWENT ERROR, REPEAT INPUT STA .MEM1 SAVE FWA BP SZA VALID (NON-ZERO) FWA BP SSA JMP FWERR ADA N8 SSA JMP FWERR CMA,INA ADA B1636 SSA,RSS JMP FWEN1 FWERR JSB INERR INVALID PARAMETER FWABP=0 JMP FWENT REPEAT FWABP LINKAGE INPUT FWEN1 LDA .MEM1 ADA N1 STA LWABP SAVE FOR INT PROCESSOR JSB SPACE NEW LINE JMP CLBUF SKP * B1636 OCT 1636 N1 DEC -1 N3 DEC -3 P2 DEC 2 P3 DEC 3 P4 DEC 4 P7 DEC 7 P9 DEC 9 P10 DEC 10 P17 DEC 17 P23 DEC 23 P32 DEC 32 * LWABP NOP LWSA1 NOP MSIZE NOP MEMORY SIZE OCTNO NOP OCTAL DIGIT PCOM NOP PRIV. DRIVERS ACCESS COMMON PIOC NOP ADDR. OF PRIV. I/O CARD SYSTM NOP SYSTEM TYPE TBCHN NOP TIME BASE GENERATOR CHANNEL * MES01 DEF *+1 ASC 4,* RTMGN MES14 DEF *+1 ASC 9,* TYPE OF SYSTEM? MES15 DEF *+1 ASC 15,* PRIV. DRIVERS ACCESS COMMON? MES16 DEF *+1 ASC 6,* MEM SIZE? MES24 DEF *+1 ASC 4,* LWAM? MES27 DEF *+1 ASC 5,* FWA BP? MES30 DEF *+1 ASC 6,* TBG CHNL? MES31 DEF *+1 ASC 12,* DEFINE OUTPUT DEVICES MES41 DEF *+1 ASC 6,* PRIV. INT? * * SKP CLBUF JSB BUFC CLEAR BUFFER TO OCTAL ZEROS LDA XI START ADDR OF AREA TO BE CLEARED LDB BPCLR END ADDRESS JSB SETCR CLEAR LOWER HALF LDA BPCLR LDB BGLWA JSB SETCR CLEAR UPPER HALF * LDA PIOC PRIV INT CARD ADD LDB DUMMY JSB STCR1 * * * LDA SYSTM RTE-M-I SYSTEM? CPA P1 JMP ENTRX YES LDB D$CLS ADDRESS OF ENTRY JSB ENTPT PUT IN LST LDA UDFE STA LST4,I SET TO UNDEFINED ISZ UNDEF DON'T OUTPUT AS UNDEF Zz LDB D$RNT ADDRESS OF ENTRY JSB ENTPT PU IN LST LDA UDFE STA LST4,I SET TO UNDEFINED ISZ UNDEF DON'T OUTPUT AS UNDEF SKP * * CHANGE ENTRY POINTS * ENTRX JSB SPACE NEW LINE ENTRY JSB INTER INTERACTIVE INPUT LDA P14 LDB MES17 CHANGE ENTS? JSB READ PRINT MESSAGE, GET REPLY CLA STA CHRCT LDA N2 JSB GETNA GET FIRST 2 CHARACTERS CPA EN END? JMP END? YES,CHECK TO SEE IF NOT ENTRY ENTRI JSB GINIT REINITIALIZE INPUT CCA STA CMFLG ENTLN JSB GETAL GET NEXT CHARACTER CPA BLANK REACHED COMMA YET? JMP ENTFN YES ISZ CHRCT CHARACTER COUNTER JMP ENTLN ENTFN LDA N2 MOVE 2 CHARACTERS TO TBUF JSB GETNA CLB CPA RP MICROCODE REPLACEMENT? JMP RP1 YES CPA AB ABSOLUTE? JMP AB1 YES ENTER JSB INERR NEITHER MICROCODE RELACEMENT NOR ABSOLUTE JMP ENTRY ERROR, REPEAT INPUT RP1 INB AB1 ADB P3 STB TBUF+4 CCA STA CMFLG JSB GETAL GET NEXT CHAR. IN RESPONSE CPA BLANK REACHED COMMA YET? RSS JMP ENTER ERROR LDA BBLNK INITIALIZE TBUF STA TBUF WITH BLANKS STA TBUF+1 STA TBUF+2 LDA P6 SET FOR 6 OCTAL DIGITS INPUT JSB DOCON GET VALUE OF RP OR AB JMP ENTRY REPEAT INPUT STA TBUF+3 JSB GINIT BUFFER INITIALIZE LDA CHRCT GET NO. OF CHAR. IN ENTRY POINT CMA,INA JSB GETNA PUT ENTRY POINT IN TBUF LDA TBUF+2 IOR TBUF+4 STA TBUF+2 LDB ATBUF SET BUFFER FOR ENTRY CALL JSB ENTPT SET ENTRY POINT IN LST CLA STA FTIME JMP ENTRY GET NEXT CHANGE END? LDA N2 JSB GETNA GET NEXT 2 CHARACTERS CPA D D? RSS YES, DONE JMP ENTRYI NO, MUST BE ENTRY POINT SKP * * RELOCATE SYSTEM MODULES * LDA LST SET LST TABLE TO PROPER # OF ENTRIES STA LSTSV JSB SPACE NEW LINE JSB INTER INTERACTIVE INPUT LDA P14 LDB MES02 REL SYS MODS JSB RELOC RELOCATE SYSTEM MODULES DEC 1 MODULE TYPE NEEDED JMP ABRT1 ERROR FROM LOADER, EXIT LDA UNDEF WERE THERE ANY UNDEFINED? CMA,INA ADA UEXFL SZA,RSS JMP REL1 NO CONTINUE RELSE LDA AD YES JSB ERRER ERROR JMP ABRT1 EXIT REL1 LDB A$STR JSB SSTBL WAS $STRT LOADED? JMP RELSE NO, ERROR, LDA LST4,I YES, GET STARTING ADDRESS STA STRAD SAVE IT FOR CLEAN-UP AT END OF RTMGN LDB A$CIC $CIC NAME JSB SSTBL WAS $CIC LOADED? JMP RELSE NO, ERROR, START OVER LDA LST4,I BUILD A BP LINK FOR $CIC LDB .MEM2 FOR $CIC STB A$CIA SAVE FOR JSB INSTRUCTION STB LST5,I JSB STCR1 CCA ADA .MEM2 BUMP TO NEXT LINK STA .MEM2 JMP TBGEN YES, GO BUILD I/O TABLES * * ERRER NOP CLB JSB ERROR CALL ERROR SUBROUTINE JMP ERRER,I SKP * A$CIA NOP ADDRESS OF $CIC ROUTINE A$CIC DEF *+1 ASC 3,$CIC A$STR DEF *+1 ASC 3,$STRT ATBUF DEF TBUF TBUF BSS 5 * MES02 DEF *+1 ASC 7,* REL SYS MODS MES17 DEF *+1 ASC 7,* CHANGE ENTS? * AB ASC 1,AB AD ASC 1,AD INVALID ENTRY POINT IN INT REC D ASC 1,D RP ASC 1,RP * P6 DEC 6 P12 DEC 12 B1777 OCT 1777 BBLNK OCT 20040 UDFE OCT 77777 * BLANK EQU P32 * CHRCT NOP CMFLG NOP COMMA FLAG = -1/0 = NOT IN/IN LSTSV NOP LST COUNT SAVE FOR REL UPDATE STRAD NOP $STRT START ADDRESS * SKP * * THE DOCON SUBROUTINE ANALYZES THE INPUT FOR THE * CHANNEL NO., TBG CHANNEL NO., A9ND LAST * WORD OF AVAILABLE MEMORY. * * CALLING SEQUENCE: * A = MAX NO. OF CHARACTERS PERMITTED IN RESPONSE. * THE SIGN OF A DETERMINES THE CONVERSION FROM * ASCII TO OCTAL (POS.) OR DECIMAL (NEG.). * B = IGNORED * JSB DOCON * * RETURN: * (N+1): CONTENTS OF A AND B ARE DESTROYED. AN INVALID * CHARACTER HAS BEEN DETECTED IN THE RESPONSE, OR * THE RESPONSE CONTAINS AN INVALID NO. CHARACTERS. * THE MESSAGE IS TO BE REPEATED ON RETURN. * (N+2): A = CONVERTED RESULT * DOCON NOP JSB GETOC GET OCTAL/DECIMAL, RETURN OCTAL JMP *+4 INVALID DIGIT JSB GETAL GET NEXT CHAR FROM LBUF CPA ZERO CHAR = ZERO? (END OF BUFFER) JMP *+3 YES - CONTINUE JSB INERR INVALID DIGIT ENTRY JMP DOCON,I RETURN ISZ DOCON INCR RETURN ADDRESS LDA OCTNO GET CONVERTED NUMBER JMP DOCON,I RETURN * ZERO DEC 0 SKP * * SUBROUTINE TO RELOCATE ALL MODULES (SYSTEM AND USER PROGRAMS). * * CALLING SEQUENCE: * * A = MESSAGE LENGTH * B = MESSAGE ADDRESS * JSB RELOC * * RETURN: * (N+1): CONTENTS OF A AND B ARE DESTROYED. LOADER * WAS NOT ABLE TO RELOCATE MODULE (ERROR EXIT). * (N+2): CONTENTS OF A AND B DESTROYED. LOADER RELOCATION * WORKED. * * RELOC NOP JSB PRIN1 PRINT MESSAGE LDA P2 STA ?XFER NON-ZERO TO LOAD MODULES JSB CLBPL CLEAR BASE PAGE LINKS STA PNAME CLEAR NAME FLAG STA LOCC CLEAR LOCC IN LOADER STA BPLOC SAME FOR BPLOC STA OPT.3,I CLEAR FIXUP TABLE LENGTH LDA LST,I SAVE LST LENGTH STA LSTCT LDA LSTSV RESTORE SYMBOL TABLE COUNT STA LST IN THE LOADER LDA RELOC,I GET MODULE TYPE STA TYPRO SAVE FOR LOADER SUB CONTROL SZA,RSS STA ?XFER ISZ RELOC SET RETURN ADDRESS JSB PRCMD GO RELOCATOE MODULES JMP RELOC,I ERROR EXIT LDA .MEM2 SAVE LWABP STA BPFIX LDB LNKDR GET LINK DIRECTION FLAG CPB P1 USER LINKS ? JMP REL02 YES LDA LOCC UPDATE FWAM SZA,RSS LDA .MEM3 STA .MEM3 LDA BPLOC UPDATE FWABP SZA STA .MEM2 SYSTEM LINKS, UPDATE LWABP LDA LST STA LSTSV SAVE FOR RELOCATION ERROR REL03 ISZ RELOC JMP RELOC,I * REL02 LDA LSTCT RESTORE LST LENGTH STA LST,I JMP REL03 * BPFIX NOP LWABP TEMP STORE LSTCT NOP LST LENGTH SKP * * SUBROUTINE TO RESERVE AND SET CORE * * CALLING SEQUENCE: * A = DATA TO BE OUTPUT * B = ADDRESS OF DATA * JSB STCR1 * * RETURN: * A = DATA WORD OUTPUTTED * STCR1 NOP STA LBUF SAVE DATA TO BE OUTPUT LDA 1 SET A REG TO ADDRESS JSB SETCR GO OUTPUT IT LDA LBUF GET DATA JMP STCR1,I SPC 5 * SUBROUTINE TO OUTPUT MESSAGE * PRIN2 NOP JSB PRINT GO OUTPUT MESSAGE LDA LENGT LDB ADDRS JSB EKHOS GO ECHO IF NEEDED JMP PRIN2,I * * * SUBROUTINE TO OUTPUT MESSAGE ONLY IF ECHO, INTERACTIVE * INPUT, OR SESSION CONSOLE NEEDED OR USED. * * PRIN1 NOP STA LENGT MESSAGE LENGTH LDA CONSO OUTPUT TO SESSION CONSOLE? SZA JMP PRINA YES LDA INACT INTERACTIVE INPUT? SZA JMP PRINA YES LDA READX OUTPUT TO SESSION CONSOLE? SZA,RSS JMP PRINB NO, JUST ECHO IF NEEDED PRINA LDA LENGT JSB PRINT GO OUTPUT MESSAGE LDB ADDRS PRINB LDA LENGT JSB EKHOS GO ECHO IF NEEDED JMP PRIN1,I SKP * * THE INERR SUBROUTINE PRINTS THE DIAGNOSTIC FOR INVALID * RESPONSES DURING THE INITIALIZATION SECTION. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB INERR * * RETURN: CONTENTHFBS OF A AND B ARE DESTROYED. * INERR NOP LDA PA SET INVALID DEVICE ERROR CODE JSB ERRER PRINT ERROR MESSAGE JMP INERR,I RETURN * PA ASC 1,PA PARAMETER ERROR SPC 5 * P24 DEC 24 P27 DEC 27 * MES20 DEF *+1 ASC 10,* # OF I/O CLASSES? MES21 DEF *+1 ASC 12,* # OF RESOURCE NUMBERS? MES22 DEF *+1 ASC 14,* BUFFER LIMITS (LOW,HIGH)? D$CLS DEF $CLS $CLS ASC 3,$CLAS D$RNT DEF $RNTB $RNTB ASC 3,$RNTB * $BLLO ASC 3,$BLLO $BLHI ASC 3,$BLUP HED RTMGN GENERATE I/O TABLES fH* * GENERATE I/O TABLES * * THIS SECTION OF CODE GENERATES THE I/O TABLES * FOR THE SYSTEM. THESE INCLUDE THE EQUIPMENT TABLE (EQT), * STANDARD DEVICE REFERENCE TABLE (DRT), AND INTERRUPT TABLE. * * THE EQT RECORDS HAVE THE FOLLOWING FORMAT: * * N1,DVRN2<,D><,B><,T=><,X=> * * N1 = CHANNEL NO. (2 OCTAL DIGITS) * N2 = DRIVER CLASS. CODE (2 OCTAL DIGITS) * D = DMA FLAG (OPTIONAL) * B = BUFFERING FLAG (OPTIONAL) * T = TIME-OUT VALUE TO BE ENTERED * X = # WORDS OF EQT EXTENSION * * IF T= IS ENTERED, A VALUE FOR THE DEVICE'S TIME-OUT * CLOCK MUST NEXT BE ENTERED. * THE OPERATOR MUST ENTER A POSITIVE DECIMAL NUMBER * OF UP TO FIVE DIGITS. THIS IS THEN THE NUMBER OF * TIME BASE GENERATOR INTERRUPTS (10 MSEC INTERVALS) * BETWEEN THE TIME IO IS INITIATED ON THE DEVICE AND * THE TIME AFTER WHICH THE DEVICE SHOULD HAVE INTERRUPTED. * IF THE DEVICE HAS NOT INTERRUPTED BY THIS TIME, IT * IS CONSIDERED TO HAVE TIMED-OUT. * * * EACH DRT RECORD CONSISTS OF A 2-DIGIT NO. SPECIFYING THE * CORRESPONDING ENTRY IN THE EQUIPMENT TABLE * AND AN OPTIONAL 1-DIGIT NO. SPECIFYING A * SUBCHANNEL WITHIN THAT ENTRY. FOR EXAMPLE, IN * RESPONSE TO THE MESSAGE: 5 = ?, THE RESPONSE 6 INDICATES THAT * THE LOGICAL UNIT NO. 5 IS TO USE DEVICE 6 IN EQT. * WHEREAS THE RESPONSE 6,2 INDICATES THAT THE * LOGICAL UNIT NO. 5 IS TO USE SUBCHANNEL 2 OF * DEVICE 6 IN EQT. * * * THE INT RECORDS HAVE ONE OF THE FOLLOWING FORMATS: * * N1,EQT,N2 * N1,PRG,NAME * N1,ENT,ENTRY * N1,ABS,N3 * * N1 = CHANNEL NO. (2 OCTAL DIGITS - MUST BE IN INCREASING ORDER) * EXCEPTION: IF N1 = 04 (POWER - FAIL), * THIS ENTRY DOES NOT HAVE TO BE IN ORDER. ALSO, * ONLY AN ENT OR AN ABS TYPE ENTRY IS ACCEPTED * FOR N1 = 04. * N2 = EQT NO. * NAME = PROGRAM NAME TO BE SCHEDULED * ENTRY = ENTRY POINT TO WHICH TRANSFER IS TO BE MADE * N3 = ABSOLUTE VALUE (6 OCTApL DIGITS) * * # OF I/O CLASSES * TBGEN LDA .MEM3 SET PROGRAM COUNTER TO FWAM STA PPREL LDA SYSTM GET SYSTEM TYPE CPA P1 TYPE 1? JMP BLMT YES, GET BUFFER LIMITS LDA .MEM2 RESET LWABP LDB BPFIX STA BPFIX STB .MEM2 JSB BUFC JSB SPACE NEW LINE IOCLS JSB INTER INTERACTIVE INPUT LDA P19 LDB MES20 # OF I/O CLASSES? JSB TABLE PRINT MESSAGE, ANALYZE REPLY JMP IOCLS ERROR, REPEAT INPUT LDB D$CLS ADDRESS OF ENT NAME JSB ENPNT FIND ENTRY IN LST * * # OF RESOURCE NUMBERS * JSB SPACE NEW LINE RNUMB JSB INTER INTERACTIVE INPUT LDA P24 LDB MES21 # OF RESOURCE NUMBERS? JSB TABLE PRINT MESSAGE, ANALYZE REPLY JMP RNUMB ERROR, REPEAT INPUT LDB D$RNT ADDRESS OF ENTRY NAME JSB ENPNT FIND ENTRY IN LST LDA BPFIX RESET LWABP STA .MEM2 * * BUFFER LIMITS (LOW,HIGH) * BLMT JSB SPACE NEW LINE BLMTS JSB INTER INTERACTIVE INPUT LDA P27 LDB MES22 BUFFER LIMITS (LOW,HIGH)? JSB READ PRINT MESSAGE, GET REPLY JSB BLSET SET UP DEF $BLLO LOWER LIMIT JMP BLMT0 ERROR JSB BLSET NOW SET UP THE UPPER LIMIT DEF $BLHI JMP BLMT0 ERROR JMP GEN00 * BLMT0 JSB INERR ERROR JMP BLMTS REPEAT INPUT SKP * * GENERATE I/O TABLES * GEN00 LDA PPREL STA .MEM3 SET FWAM JSB SPACE NEW LINE GENIO JSB INTER INTERACTIVE INPUT CLA STA UNDEF SET TO PRINT ALL UNDEFS STA OPT.3,I ZERO FIXUP COUNTER STA IDNOS ID'S MADE STA STRPN START UP PROGRAM FLAG STA CEQT NOS OF EQT'S STA PROCT NOS OF INT PROG ENTRIES STA START START UP PROGRAM USED * * EQT TABLE * JSB SPACE NEW LINE JSB FUTI INITIA1qLIZE FIXUP TABLE LDA .MEM3 FWAM STA AEQT EQT STARTING ADDRESS STA PPREL LDA P9 PRINT: LDB MES25 "EQT TBL" JSB PRIN1 JSB SPACE NEW LINE * SEQT JSB INTER INTERACTIVE INPUT JSB SPACE NEW LINE SEQT1 JSB INTER INTERACTIVE INPUT LDA CEQT EQT COUNT INA LDB MES6A STUFF INTO PRINT BUFFER JSB STFNM LDA P11 LDB MES06 EQT XX =? JSB READ PRINT MESSAGE, GET REPLY LDA N2 JSB GETNA MOVE 2 CHARS TO TBUF CPA EN CHARS= END ? JMP SSQTI YES, TRY TO END CPA RE REPEAT? JMP GENIO YES * JSB GINIT INITIALIZE BUFFER SCAN LDA P2 JSB GETOC GET 2 OCTAL DIGITS, CONVERT JMP IOERR INVALID DIGIT JSB GETAL GET NEXT CHAR FROM LBUF CPA BLANK CHAR = COMMA? JMP CLDBU YES - SET CHNL NO., CLEAR D,B,T,X IOERR LDA CH SET CODE = INVALID CHNL IN EQT JSB ERRER ERROR JMP SEQT1 REPEAT INPUT SKP * CLDBU LDB OCTNO GET I/O CHANNEL NO. STB IOADD SET I/O ADDRESS ADB N8 IS CHAN EQ. LESS THAN 10? SSB,RSS JMP GOOD ADB P4 SZB JMP IOERR YES, CHANNEL ERROR GOOD CLA STA TIMWD CLEAR TIME WORD STA IODMA CLEAR DMA FLAG STA IOBUF CLEAR AUTOMATIC BUFFERING FLAG STA EXTWD CLEAR EQT EXTENSION WORD CCA STA TFLAG CLEAR TIME-OUT FLAG STA XFLAG SET EQT EXTENSION FLAG STA DFLAG SET DMA-IN FLAG STA BFLAG SET BUFFERING-IN FLAG LDA CDEC RESTORE C. STA ASCDR+1 ADA B3000 AND I. STA ASIDR+1 LDA N2 JSB GETNA MOVE 2 CHARS TO TBUF CPA DV CHAR = DV? RSS JMP DVERR NO CLA,INA GET NEXT CHARACTER JSB GETNA CPA CHARR CHARACTER = R? zJMP STYPE YES IOR C0 NO STA ASCDR+1 PUT IN PLACE OF "." ADA B3000 IN C. AND I. STA ASIDR+1 JMP STYPE DVERR LDA DR SET CODE = INVALID DRIVER NAME JSB ERRER PRINT DIAGNOSTIC JMP SEQT1 GET NEXT EQT RECORD STYPE LDA N2 JSB GETNA MOVE 2 CHARS TO TBUF STA ASTYP SAVE 2 ASCII CHARS FOR I.XX,C.XX STA ASCYP SAVE FOR C.XX COMPARE CCA ADA CURAL ADJUST CURRENT LBUF ADDR STA CURAL RESET CURAL TO CONVERT TYPE LDA P2 JSB GETOC GET 2 OCTAL CHARS, CONVERT JMP DVERR INVALID DRIVER NAME ALF,ALF ROTATE TO UPPER 8 STA IOTYP SET DRIVER TYPE JSB GETAL GET NEXT CHAR FROM LBUF CPA ZERO END OF BUFFER? JMP LISCN SCAN FOR I.XX, C.XX CPA BLANK CHAR = COMMA? RSS YES - CONTINUE JMP DVERR NO - INVALID DRIVER NAME * * INDBU CCA STA CMFLG SET COMMA FLAG = NO COMMA IN JSB GETAL GET NEXT CHAR FROM LBUF CPA CHARD CHAR = D? JMP SEDMA YES - SET DMA CODE CPA CHARB CHAR = B? JMP SETBU YES - SET BUFFERING CODE CPA CHART CHAR = T? JMP SETIM YES - SET TIME-OUT FLAG CPA CHARX CHAR = X? JMP SEEXT YES - SET EXTENSION LENGTH UNERR JSB INERR SET CODE = INVALID D,B,T JMP SEQT1 GET NEXT EQT RECORD SETIM ISZ TFLAG SKIP - FIRST T ENTERED JMP UNERR DUPLICATE T'S ENTERED JSB GETAL GET NEXT CHAR CPA AEQUL IS IT "=" ? RSS YES ACCEPT TIME VALUE JMP UNERR NO, ITS AN ERROR LDA N5 5 CHAR VALUE JSB GETOC FETCH TIME OUT TIME JMP UNERR NUMBER IS NO GOOD SZA WAS ZERO INPUT? CMA ONE'S COMPLEMENT FOR THAT RTM STA TIMWD SAVE FOR OUTPUT EQTST JSB GETAL GET NEXT CHAR FROM LBUF CPA ZERO EN)D OF BUFFER? JMP LISCN SCAN FOR I.XX, C.XX CPA BLANK CHAR = COMMA? JMP INDBU YES - GET NEXT D,B,U, ENTRY JMP UNERR NO - INVALID D,B,U CHARACTER * SEDMA ISZ DFLAG SKIP - FIRST D ENTERED JMP UNERR DUPLICATE D'S ENTERED LDA MSIGN SET BIT 15 = 1 FOR DMA FLAG STA IODMA SET DMA CODE JMP EQTST TEST FOR NEXT OPERAND * SETBU ISZ BFLAG SKIP - FIRST B ENTERED JMP UNERR DUPLICATE B'S ENTERED LDA B40K SET BIT14 = 1 STA IOBUF SET AUTOMATIC BUFFERING CODE JMP EQTST TEST FOR NEXT OPERAND * SEEXT ISZ XFLAG SKIP - FIRST X ENTERED JMP UNERR DUPLICATE X'S ENTERED JSB GETAL CPA AEQUL IS IT "=" ? RSS YES ACCEPT EXTENSION VALUE JMP UNERR NO, ITS AN ERROR LDA N3 JSB GETOC GET EXTENSION JMP UNERR NUMBER IS NO GOOD STA EXTWD SAVE LENGTH OF EXTENSION SSA,RSS JMP EQTST JMP UNERR * LISCN LDB ASIDR ADDRESS OF I.XX BUFFER JSB SSTBL IS IT IN THE SYMBOL TABLE? JMP DVERR NO LDA LST4,I YES, GET THE ADDRESS STA I.XX SAVE FOR OUTPUT LDB ASCDR ADDRESS OF C.XX BUFFER JSB SSTBL IS IT IN SYMBOL TABLE? JMP NOCXX NO, USE ADDRESS OF I.XX LDA LST4,I YES, GET ADDRESS STCXX STA C.XX SAVE DRIVER EXIT POINT * JSB BUFC LDA IODMA GET DMA CODE IOR IOBUF ADD BUFFERING CODE IOR IOADD ADD CHANNEL NO. STA LBUF+3 OUTPUT BUFFER LDA I.XX STA LBUF+1 INT. ADDRESS LDA C.XX STA LBUF+2 COMPLETE ADDRESS * LDA IOTYP GET EQUIPMENT TYPE CODE AND M1000 ISOLATE UPPER 7 BITS SZA SKIP - TYPE = 0,I CLA,RSS SET STATUS = 0, SKIP LDA BLANK SET STATUS = 40(8) IOR IOTYP ADD EQUIPMENT TYPE CODE STA LBUF+4 LDA TIMWD WAS _VA TIME INPUT ? SZA STA LBUF+13 YES, SAVE IT IN EQT LDA EXTWD GET EXTENSION LENGTH SZA,RSS JMP NOEXT NO EXTENSION JSB FUTS GET FIXUP FOR EQT EXTENSION NOP LDA EXTWD STA LBUF+11 SAVE EXTENSION LENGTH STA FUT1,I SAVE FOR FIXUP LDA PPREL SAVE CURRENT EQT ADDRESS ADA P12 STA FUT4,I SAVE FOR FIXUP ISZ OPT.3,I INCREMENT NO. OF FIXUP ENTRIES LDA LSTUL CMA ADA FUT4 SSA CHECK FOR MEMORY OVERFLOW JMP LER5 NOEXT LDA PPREL GET CURRENT EQT ADDRESS LDB A ADB P14 ADDRESS OF END OF EQT STB PPREL JSB SETCR OUTPUT IN ABS ISZ PPREL BUMP TO NEXT EQT ENTRY ISZ CEQT INCR EQT ENTRY COUNT CLA STA FTIME JMP SEQT PROCESS NEXT EQT RECORD * SPC 1 NOCXX LDA I.XX C.XX NOT FOUND SO USE JMP STCXX I.XX ADDRESS * SSQTI LDA CEQT ANY EQT'S BEEN LOADED? SZA JMP SSQT YES, CAN END JSB INERR NO, AT LEAST ONE REQUIRED JMP SEQT1 START OVER LER5 LDA SO SYSTEM OVERFLOW JSB ERRER JMP GENIO START OVER * * DO FIXUPS FOR EQT EXTENSIONS * SSQT JSB FUTI INITIALIZE FIXUP FOR EQT EXTENSION FUTNT JSB FUTS GET NEXT FIXUP JMP FUTED JSB BUFC CLEAR BUFFER LDA PPREL GET NEXT ADDRESS FOR EQT EXTENSION STA LBUF LDB FUT1,I GET EQT EXTENSION LENGTH STB COUNT LDB FUT4,I START ADDRESS LDA FUT4,I END ADDRESS JSB OUTCR OUTPUT ADDRESS AND LENGTH JMP FUTNT SKP * N5 DEC -5 N8 DEC -8 P14 DEC 14 M1000 OCT -1000 B3000 OCT 3000 B40K OCT 40000 C0 OCT 41400 MSIGN OCT 100000 * AEQUL OCT 75 CHARB OCT 102 CHARD OCT 104 CHARR OCT 122 CHART OCT 124 CHARX OCT 130 * CDEC ASC 1,C. DV ASC 1,DV CH ASC 1,CH INVALID CHANNEL NO. IN EQT REC DR ASC 1,DR INVALID DRIVER NAME RE ASC 1,RE SO ASC 1,SO SYSTEM OVERFLOW * ASCDR DEF *+1 ASC 1,C. ASCYP NOP OCT 20000 ASIDR DEF *+1 ASC 1,I. ASTYP NOP OCT 20000 * MES6A DEF MES6I MES06 DEF *+1 ASC 3,* EQT MES6I NOP ASC 2, =? MES25 DEF *+1 ASC 5,* EQT TBL * AEQT NOP ADDRESS OF EQUIPMENT TABLE BFLAG NOP BUFFERING-IN FLAG FOR EQT CEQT NOP NO. ENTRIES IN EQUIPMENT TABLE C.XX NOP DRIVER EXIT POINT DFLAG NOP DMA-IN FLAG FOR EQT EXTWD NOP EQT EXTENSION LENGTH IDNOS NOP ACTUAL IDS FILLED IOADD NOP I/O ADDR (CHANNEL NO.) IN EQT IOBUF NOP I/O BUFFERINF FLAG IN EQT IODMA NOP I/O DMA FLAG IN EQT I.XX NOP DRIVER ENTRY OINT IOTYP NOP I/O DRIVER TYPE IN EQT (OCTAL) PPREL NOP REL ADDRESS PROCT NOP NO. OF INT. ENTRIESS START NOP START UP PROGRAM USED TFLAG NOP TIME-OUT ENTRY FLAG FOR EQT TIMWD NOP TIME WORD XFLAG NOP EQT EXTENSION FLAG SKP * * SET DEVICE REFERENCE TABLE (SQT) * FUTED JSB SPACE NEW LINE FUTE JSB INTER INTERACTIVE INPUT LDA PPREL UPDATE REL ADDRESS STA ASQT SAVE SQT ADDRESS CLA,INA STA CSQT SET SQT COUNT = 1 LDA P9 LDB MES26 DRT TBL JSB PRIN1 PRINT MESSAGE JSB SPACE NEW LINE LDA P6 LDB MS26A LU #: JSB PRIN1 PRINT MESSAGE * DEVRE JSB INTER INTERACTIVE INPUT LDA CSQT GET CURRENT DEV REF NO. LDB MS28I JSB STFNM STUFF NUM IN BUFFER JSB SPACE NEW LINE DEVER JSB INTER INTERACTIVE INPUT LDA P13 LDB MES28 XX = EQT #? JSB READ PRINT MESSAGE, GET REPLY LDA N2 JSB GETNA MOVE 2 CHARS TO TBUF CPA EN CHARS = EN? JMP SINTI YES - SET INTE7RRUPT TABLE CPA RD REPEAT DRT? JMP DRT01 YES, START OVER CPA RE REPEAT EQT? JMP GENIO YES, GO BACK JSB GINIT RE-INITIALIZE LBUF SCAN LDA N3 JSB GETOC GET 2 DECIMAL DIGITS, CONVERT JMP DRERR INVALID DIGIT ENTERED STA TEMPL SAVE DEV. REF. NO. SZA,RSS IF NO CHANNEL JMP NOSUB IGNOR SUBCHANNEL LDA CMFLG COMMA ENCOUNTERED? SZA YES - GO GET SUBCHANNEL JMP NOSUB NO - DEFAULT IT TO ZERO LDA N2 JSB GETOC GET TWO DECIMAL DIGITS JMP DRERR JSB GETAL GET NEXT CHAR CPA ZERO END OF BUFFER? RSS YES JMP DRERR NO, SHOULD BE BUT ISN'T LDA OCTNO GET SUB CHANNEL RSS SKIP OVER DEFAULT NOSUB CLA DEFAULT TO ZERO ALF,ALF SET SUBCHANNEL NO. ALF,RAR INTO BITS 13 - 11 STA TEMPH SAVE SUBCHANNEL NO. LDA TEMPL GET DEV. REF. NO. CMA,INA COMPLEMENT ADA CEQT ADD NO. EQT ENTRIES SSA SKIP IF VALID DEV. REF NO. JMP DRERR INVALID DEV. REF. NO. (NO EQT) LDA TEMPL GET DEV. REF NO. LDB CSQT GET CURRENT SQT NO. CPB P1 FIRST ENTRY? RSS YES - CONTINUE JMP SETQT PUT OUT DEV REF NO. TO SQT SZA,RSS SKIP IF DEV REF IS NOT ZERO JMP DRERR INVALID DEV. REF. NO. ADA N1 LDB 0 CMA,INA BLF MULTIPLY BY ADB 0 15 ADB AEQT ADD ADDRESS OF EQT STB LBUF+1 SET EQT ADDR IN TTY CHANNEL LDA TBCHN TBG CHANNEL STA LBUF PUT IN OUT PUT BUFFER LDA TBG ADDRESS WHERE TO GO LDB SYSTY JSB SETCR OUTPUT IN ABSOLUTE * SETQT LDA TEMPL GET DEV. REF. NO. IOR TEMPH SET IN SUBCHANNEL NO. LDB PPREL ABS ADDRESS JSB STCR1 GO BUILD AmBS DATA ISZ PPREL INCR CURRENT RELOC ADDRESS ISZ CSQT INCR CURRENT SQT COUNT CLA STA FTIME JMP DEVRE GET NEXT SQT ENTRY * DRERR LDA LU SET CODE = INVALID DEV. REF. NO. JSB ERRER ERROR JMP DEVER REPEAT INPUT SKP * SINTI LDA CSQT HAVE ANY DRT'S BEEN ENTERED? ADA N1 STA CSQT SZA SSA JMP DRERR NO, ERROR, START OVER JSB BUFC LDA PPREL CCB ADB 0 ADB CSQT STB PPREL JSB SETCR ISZ PPREL JMP SINTT YES, GO TO INT PROCESSING * DRT01 JSB SPACE NEW LINE JSB INTER INTERACTIVE INPUT JMP FUTE SPC 3 * ASQT NOP ADDRESS OF DRT COUNT NOP CSQT NOP NO. OF ENTRIES IN DRT CURAL NOP TEMPH NOP SUBCHANNEL NO. (BITS 11-13) TEMPL NOP DEV. REF. NO. EN ASC 1,EN LU ASC 1,LU INVALID DEV. REF. NO. RD ASC 1,RD * P11 DEC 11 * MES26 DEF *+1 ASC 5,* DRT TBL MS26A DEF *+1 ASC 3,* LU#: MS28I DEF MS28A MES28 DEF *+1 ASC 1,* MS28A ASC 6, = EQT #? SKP * * SUBROUTINE TO ANALYZE INPUT * TABLE NOP JSB READ PRINT MESSAGE, GET REPLY LDA N3 SET FOR 3 DECIMAL DIGITS JSB DOCON JMP TABLE,I ERROR EXIT, REPEAT INPUT STA LBUF STA COUNT AND M400 CHECK FOR VALUE >=0 AND <=255 SZA,RSS ISZ TABLE OK SZA JSB INERR ERROR JMP TABLE,I SPC 5 * * SUBROUTINE TO FIND ENTRY POINT IN LST * ENPNT NOP JSB SSTBL FIND ENTRY POINT JMP RELSE NOT THERE, START OVER LDB PPREL GET CURRENT ADDRESS STB LST4,I SAVE IN LST LDA LST5,I POST VALUE IN LINKS TABLE SZA,RSS JMP ENP1 ONLY IF LINK EXISTS ADA BPAGA STB 0,I ENP1 LDA 1 ISZ PPREL JSB OUTCR OUTPUT JSB FIXUP FIXUP ALL LOCATIONS NEEDED JSB BUFC LDA LST4,I LINK VALUE LDB LST5,I LINK ADDRESS SZB,RSS JMP ENPNT,I NO LINK JSB STCR1 OUTPUT LINK JMP ENPNT,I SKP * * SUBROUTINE TO OUTPUT ABSOLUTE CODE * OUTCR NOP JSB SETCR OUTPUT IN ABS JSB BUFC CLEAR OUTPUT BUFFER NEXT LDB COUNT BUFFER LENGTH SZB,RSS 0 LENGTH JMP OUTCR,I LDA PPREL NEXT OUPUT ADDRESS ADB N64 SZB SSB JMP LAST LAST OUTPUT STB COUNT LDB 0 ADB P63 STB PPREL JSB SETCR OUTPUT IN ABS ISZ PPREL JMP NEXT LAST CCB ADB 0 ADB COUNT STB PPREL NEW OUTPUT ADDRESS JSB SETCR OUTPUT IN ABS ISZ PPREL JMP OUTCR,I * P63 DEC 63 * * THE BLSET SUBROUTINE SETS UP THE BUFFER LIMITS. * * CALLING SEQUENCE: * * JSB BLSET * DEF ENT NAME ENTRY POINT NAME ADDRESS * JMP RETRY ERROR RETURN * * --- NORMAL RETURN * BLSET NOP LDB BLSET,I GET THE ENTRY POINT ISZ BLSET STEP RETURN ADDRESS JSB SSTBL SEARCH FOR THE ENTRY JMP FGET IF NOT FOUND JUST EXIT LDA N5 CONVERT A FIVE DIGIT DECIMAL JSB GETOC JMP BLSET,I LDB LST4,I GET THE LIST ADDRESS CMA,INA SET THE LIMIT NEGATIVE JSB STCR1 GO OUTPUT THE LIMIT FGET ISZ BLSET STEP TO OK RETURN JMP BLSET,I SKP * * GET PAGE NUMBER * PAGE NOP AND B76K GET PAGE BITS ALF SHIFT TO BITS 0 - 5 RAL,RAL JMP PAGE,I * B76K OCT 76000 SPC 5 * * SUBROUTINE TO GET THE ADDRESS OF THE FOLLOWING ENTRIES * IN THE LST, TO SET THEM TO THEIR PROPER VALUE, AND TO * OUTPUT THEM. * STUFF NOP STA LBUF SAVE VALUE OF ENTRY JSB SSTBL FIND IN LST JMP RELSE ISN'T THERE, START OVER LDA LST4,I 2 GET ADDRESS LDB 0 JSB SETCR GO OUTPUT VALUE JMP STUFF,I HED READ INPUT FILES * * * SUBROUTINE TO READ INPUT FILES * * CALLING SEQUENCE * * A = MESSAGE LENGTH * B = MESSAGE ADDRESS * JSB READ * * RETURN: * A = DATA LENGTH * B = DESTROYED * * * READ NOP JSB PRIN1 PRINT MESSAGE READ2 LDB ALBUF DATA INPUT ADDRESS LDA CONSO GET INPUT FROM SESSION CONSOLE? SZA JMP READ1 YES LDA READX INTERACTIVE INPUT? SZA JMP READ1 NO, GET INPUT FROM SYSTEM CONSOLE LDA DCB1 DCB BUFFER ADDRESS JSB RDFL1 READ FROM INPUT FILE CPA N1 END OF FILE? JMP READA YES, GET NEXT INPUT FROM SESSION CONSOLE READ3 STA PARNO SAVE DATA LENGTH INA PUT ZERO AT END OF CLE,ERA DATA BUFFER ADA ALBUF CLB STB A,I JSB GINIT INITIALIZE INPUT LDA ALBUF,I CHECK IF FIRST CHARACTER CPA EX EXIT? JMP ABRT1 YES ALF,ALF IS AN ASTERISK AND B177 CPA B52 JMP READ2 YES, READ NEXT RECORD LDB ALBUF DATA ADDRESS LDA PARNO DATA BUFFER JSB EKHOS CHECK IF ECHO NEEDED LDA PARNO RETURN WITH DATA LENGTH IN A REG. JMP READ,I * READ1 CLA,INA LDB PRPTA JSB PRIN2 PROMPT LDA P72 LDB ALBUF JSB CRTIN JMP READ3 * READA CLA,INA STA CONSO STA KONSO JMP READ1 * DCB1 DEF IDCB1 PRPTA DEF *+1 ASC 1,- * PARNO NOP PARAMETER RECORD LENGTH READX NOP INTERACTIVE INPUT 0=YES, 1=NO * B52 OCT 52 P72 DEC 72 * EX ASC 1,EX HED RTMGN I/O TABLE GENERATION SUBROUTINES * * THE FOLLOWING SUBROUTINE SUPPLIES THE CHARACTERS FOR * GETNA AND GETOC. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB GETAL * * RETURN: * A =t4HFB CURRENT CHARACTER * B = DESTROYED * GETAL NOP LDA CMFLG CMFLG = COMMA-IN FLAG SZA,RSS SKIP IF NO COMMA IN JMP BLRET RETURN BLANK LDB BUFUL GET U/L FLAG IGNOR LDA CURAL,I GET CHAR FROM LBUF SZB SKIP IF LOWER CHAR ALF,ALF ROTATE TO LOWER AND B377 ISOLATE LOWER CHAR CPA ZERO END OF BUFFER? JMP GETAL,I YES - RETURN WITH ZERO CMB,SZB RESET U/L, SKIP IF UPPER CHAR ISZ CURAL INCR LBUF ADDRESS CPA BLANK CHAR = BLANK? JMP IGNOR IGNORE BLANKS STB BUFUL SAVE U/L FLAG CPA B54 CHAR = COMMA? ISZ CMFLG RESET FLAG TO SHOW COMMA IN JMP GETAL,I RETURN WITH NON-BLANK CHAR BLRET LDA BLANK REPLACE WITH BLANK CHAR JMP GETAL,I RETURN WITH BLANK * B54 OCT 54 B377 OCT 377 BUFUL NOP BUFFER U/L FLAG SKP (H* * THE FOLLOWING SUBROUTINE MOVES THE CHARACTERS FROM LBUF * TO TBUF. * * CALLING SEQUENCE: * A = MAX. NO. OF CHARACTERS TO BE MOVED. THE SIGN OF A * DESIGNATES THE POSITION OF THE FIRST CHARACTER. * IF THE SIGN OF A IS POSITIVE, THE FIRST CHAR. IS TO * BE MOVED TO THE LOW CHAR IN TBUF. IF A IS NEGATIVE, THE * FIRST CHARACTER IS TO BE MOVED TO THE UPPER CHAR IN TBUF. * B = IGNORED * JSB GETNA * * RETURN: * A = FIRST CHARACTER (IF ONLY 1 CHARACTER) OR FIRST 2 CHARS * MOVED. * B = DESTROYED * GETNA NOP CCE,SSA,RSS SET E = 1 (EVEN) POSITION CMA,CLE,INA SET E = 0 (ODD) POSITION - COMP STA MAXC MAXC = MAXIMUM NO. OF CHARACTERS LDA ATBUF ATBUF = ADDR OF TBUF STA CURAT SET CURRENT TBUF ADDRESS CLB STB TBUF CLEAR WORD 1 OF TBUF CCA STA CMFLG SET COMMA-IN FLAG SEZ,RSS SKIP - ODD POSITION JMP OCHAR BEGIN WITH ODD CHARACTER NEXTC JSB GETAL GET CHAR FROM LBUF CPA ZERO END OF BUFFER? LDA BLANK YES - REPLACE CHAR WITH BLANK ALF,ALF ROTATE TO UPPER A STA CURAT,I SET CHARACTER IN TBUF ISZ MAXC CHECK FOR ALL CHARS IN JMP OCHAR GET ODD CHAR FROM LBUF LDA TBUF GET FIRST 2 TRANSFERRED CHARS JMP GETNA,I YES - RETURN OCHAR JSB GETAL GET CHAR FROM LBUF CPA ZERO END OF BUFFER? LDA BLANK REPLACE ZERO CHAR WITH BLANK IOR CURAT,I ADD TO UPPER CHAR IN TBUF STA CURAT,I SET CHARS IN TBUF ISZ CURAT INCR TBUF ADDRESS ISZ MAXC CHECK FOR ALL CHARS IN JMP NEXTC NO - TRY NEXT UPPER CHAR LDA TBUF GET FIRST 2 TRANSFERRED CHARS JMP GETNA,I RETURN * CURAT NOP CURRENT TBUF ADDRESS MAXC NOP MAX CHARACTER COUNT SKP * * THIS ROUTINE WILL OUTPUT A 31 WORD BLOCK FROM THE * I/O BUFFER AREA. * * CALLING SEQUENCE:@ * A = ABS STARTING ADDR * B = IGNORED * JSB GENID * * RETURN: A AND B ARE DESTROYED * OUTID NOP LDB A ADB P30 SET LAST ADDRESS JSB SETCR GO SET CORE JMP OUTID,I RETURN * SKP * THIS ROUTINE WILL BUILD AN ID SEGMENT IN THE OUTPUT * BUFFER (LBUF) AREA. THE BUFFER IS CLEARED AND STUFFED * WITH DATA (FROM THE PNAME TABLE) BEFORE BEING OUTPUT * BY THE OUTID ROUTINE. * * CALLING SEQUENCE: * A = ABSOLUTE ADDRESS OF SEGMENT * B = LIST LINK ADDREESS TO NEXT SEGMENT * JSB GENID * * * RETURN: A AND B ARE DESTROYED * GENID NOP STA IDSAV STB LNKSV JSB BUFC CLEAR BUFFER LDA LNKSV GET LINK ADDRESS STA LBUF PUT IN BUFFER LDA PNAME+7 GET PRIORITY SZA,RSS LDA P9999 DEFAULT TO 9999 STA LBUF+6 LDA ?XFER ENTRY POINT STA LBUF+7 LDA IDSAV ADDRESS OF WORD 2 OF INA ID SEGMENT STA LBUF+10 LDA PNAME NAME 1,2 STA LBUF+12 LDA PNAME+1 NAME 3,4 STA LBUF+13 LDA PNAME+2 NAME 5, BLNK AND M400 MASK OUT BLANK INA MAKE TYPE 1 STA LBUF+14 LDA PNAME+8 RESOLUTION ALF,ALF ALF,RAL SHIFT INTO PLACE IOR PNAME+9 MERGE EXEC MULT STA LBUF+17 PUT IN BUFFER JSB TIMES PROCESS TIME PARAMETERS STA LBUF+18 STB LBUF+19 LDA .MEM3 LOW MAIN STA LBUF+22 LDA LOCC HIGH MAIN STA LBUF+23 LDA .MEM1 LOW BASE STA LBUF+24 LDA BPLOC HIGH BASE STA LBUF+25 LDA LOCC UPDATE FWAM STA .MEM3 FWAM LDA BPLOC UPDATE FWABP STA .MEM1 FWABP LDA IDSAV ABS ADDRESS JSB OUTID GO OUTPUT ID SEGMEMT JMP GENID,I RETURN * IDSAV NOP ABSOLUTE ADDRESS OF SEGMENT LNKSV NOP LINK ADDRESS TO NEXT SEGMENT * P9999 DEKC 9999 * PNAME NOP REP 5 NOP PRAMS DEC 3 DEC 9999 REP 6 NOP SKP * * THE GETOC SUBROUTINE CONVERTS THE NEXT CHARACTERS IN LBUF FROM * ASCII (DECIMAL OR OCTAL) TO THEIR BINARY VALUE. * * CALLING SEQUENCE: * A = MAX. NO. OF CHARS IN CONVERSION REQUEST. IF A IS * POSITIVE, THE REQUEST IS FOR OCTAL; IF A IS NEGATIVE, * THE REQUEST IS FOR DECIMAL. * B = IGNORED * JSB GETOC * * RETURN: * (N+1): INVALID DIGIT OR OVERFLOW IN CONVERSION * (N+2): A = CONVERTED NO. * B = DESTROYED * GETOC NOP LDB N8 GET OCTAL RANGE SSA SKIP IF OCTAL REQUEST LDB N10 GET DECIMAL RANGE STB DRANG SET DIGIT RANGE SSA,RSS SKIP IF DECIMAL REQUEST CMA,INA SET REQUEST COUNT TO NEGATIVE STA MAXC SET MAX NO. OF DIGITS CCA STA DIFLG SET DATA-IN FLAG = NO DATA IN STA CMFLG SET COMMA-IN FLAG CLA STA OCTNO OCTNO = OCTAL NUMBER GETNX JSB GETAL GET CHAR FROM LBUF CPA ZERO CHAR = ZERO? (END OF BUFFER) JMP ENDOC YES - RETURN CPA BLANK CHAR = BLANK? (COMMA IN) JMP ENDOC YES - RETURN ADA M60 SUBTRACT 60B FROM CHAR STA TCHAR SAVE CHAR SSA SKIP IF VALID LOWER LIMIT JMP DGERR INVALID DIGIT ADA DRANG ADD DIGIT RANGE CLE,SSA,RSS CLEAR E - SKIP IF VALID DIGIT JMP DGERR INVALID DIGIT ISZ DIFLG INCR DATA-IN FLAG, SKIP NOP LDA OCTNO GET PREVIOUS OCTAL NO. ADA A SET A = OCTNO X 2 ADA A SET A = OCTNO X 4 LDB DRANG GET DIGIT RANGE CPB N10 RANGE = DECIMAL? ADA OCTNO SET A = OCTNO X 5 ADA A SET A = OCTNO X 10/8 ADA TCHAR SET A = NEW OCTAL NO. STA OCTNO SAVE NEW OCTAL NO. SEZ TEST FOR OVERFLOW JMP DGERR m INVALID NO. ISZ MAXC SKIP IF ALL DIGITS PROCESSED JMP GETNX GET NEXT DECIMAL DIGIT ISZ GETOC INCR RETURN ADDRESS LDA OCTNO GET OCTAL EQUIVALENT DGERR JMP GETOC,I RETURN ENDOC ISZ DIFLG SKIP - NO DATA IN JMP *-4 DATA IN - NORMAL RETURN JMP GETOC,I RETURN - ERROR * DIFLG NOP DATA IN FLAG = -1/0 = NOT IN/IN DRANG NOP DIGIT RANGE TCHAR NOP TEMPORARY CHARACTER SAVE AREA * M60 OCT -60 N10 DEC -10 SKP * * ROUTINE TO CONVERT THE OCTAL NUMBER IN A TO * ASCII AND STUFF THE 2 LOW ORDER DIGITS INTO A BUFFER * ADDRESSED BY B. LEADING ZEROS ARE SUPPRESED * * CALLING SEQUENCE: * * A = OCTAL NUMBER * B = BUFFER ADDRESS * * RETURN: A AND B ARE DESTROYED * STFNM NOP STB STFAD SAVE FINAL ADDRESS LDB ATBUF TEMP BUFFER ADDRESS CMA,INA NEG FOR DECIMAL CONVERT JSB CONVD LDA TBUF+2 LEAST 2 DIGITS AND M400 ISOLATE UPPER CHAR CPA B30K CHAR = ASCII ZERO? LDA B20K YES, REPLACE WITH BLANK STA B SAVE UPPER CHAR LDA TBUF+2 GET ORIG DIGITS AND B177 ISOLATE LOWER CHAR IOR B MERGE STA STFAD,I STORE IN BUFFER JMP STFNM,I * STFAD NOP B177 OCT 177 B20K OCT 20000 B30K OCT 30000 * SKP * * THE 3 WORD PROGRAM NAME IS PUT INTO THE RTMGN PROG * TABLE. THE NAMES ARE LOADED FROM THE TOP DOWN. * * CALLING SEQUENCE: * A = ADDRESS OF PROGRAM NAME * B = IGNORED * JSB LDIPX * * RETURN: A AND B ARE DESTROYED * LDIPX NOP STA IPXSV SAVE PROG NAME ADDRESS JSB INIPX INITIALIZE TO START OF TABLE LDA PROCT NUMBER OF ENTRIES ALS MULT X2 ADA PROCT PLUS ONE TO MAKE IT X3 CMA,INA ADA BIDNT BUILD NEXT NAME ADDRESS STA BIDNT FOR SAVE JSB IPX INITIALIZE IP POINTERS LDA 4IPXSV,I GET N1-N2 STA IP1,I PUT IN TABLE ISZ IPXSV BUMP POINTER LDA IPXSV,I GET N3-N4 STA IP2,I SAVE ISZ IPXSV LDA IPXSV,I GET N5-XX STA IP3,I SAVE ISZ PROCT BUMP NUMBER OF NAMES JMP LDIPX,I RETURN * IPXSV NOP PROGRAM NAME ADDRESS * SKP * * INIPX SETS THE ADDRESS OF THE FIRST ENTRY IN THE * PROGRAM IDENT TABLE AS THE CURRENT ADDRESS. * * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * * RETURN: A AND B DESTROYED * INIPX NOP LDA LWAM ADA N2 STA BIDNT JMP INIPX,I * N2 DEC -2 * * * THE IPX ROUTINE ADDRESSES THE CURRENT 3 WORD ENTRY * IN THE INTERRUPT PROGRAM TABLE FROM THE ADDRESS OF * THE CURRENT ENTRY (BIDNT). THE TABLE START ADDRESS * IS LWAM. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB IPX * * RETURN, CONTENTS OF A AND B ARE DESTROYED * IPX NOP LDA BIDNT BUILD POINTERS STA IP1 INA STA IP2 INA STA IP3 ADA N5 STA BIDNT JMP IPX,I * BIDNT NOP ADDRESS OF FIRST IDENT IP1 NOP IP2 NOP IP3 NOP SKP * * SEARCH RTMGN PROG TABLE * * THIS IS A MULTIPLE ENTRY ROUTINE WHICH WILL EITHER * SEARCH FOR A NAME OR CONTINUE FROM THE LAST FIND. * * CALLING SEQUENCE: * A = ADDRESS OF NAME (3WORD) * B = IGNORED * JSB SRIPX * * RETURN: * (N+1) PROGRAM NAME WAS FOUND IN TABLE, IN IP1-3 * (N+2) REACHED THE END OF THE PROGRAM TABLE * SRIPX NOP LDB WDCNT SEARCH OR CONTINUE? SZB JMP SRIP1 CONTINUE STA SRISV INIT SEARCH JSB INIPX SET UP IP POINTERS LDA PROCT NUMBER OF ENTRIES CMA STA WDCNT SAVE FOR LOOPING SRIP1 ISZ WDCNT ALL DONE? JMP *+3 NO, GO COMPARE NAMES ISZ SRIPX YES, BUMP RETURN JMP SRIPX,I JSB IPX SET POINTERSCn LDB IP1 NAME IN TABLE LDA SRISV,I LOOK FOR NAME JSB NACMP GO COMPARE JMP SRIP1 DOSN'T COMPARE, LOOK NEXT JMP SRIPX,I DOES COMPARE, RETURN * SRISV NOP * * INITIALIZE CHAR TRANSFER * * THE GINIT SUBROUTINE SETS THE CURRENT ADDRESS AND UPPER/LOWER * FLAG FOR SCANNING LBUF. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB GINIT * * RETURN : CONTENTS OF A AND B ARE DESTROYED * GINIT NOP LDA ALBUF ALBUF = ADDR OF LBUF STA CURAL SET CURRENT LBUF ADDRESS CCB STB BUFUL BUFUL = BUFFER U/L FLAG JMP GINIT,I RETURN * SKP * CONVERT A TO ASCII AT B * * THE CONVD SUBROUTINE CONVERTS THE CONTENTS OF A * INTO ASCII (DECIMAL OR OCTAL) AT THE LOCATION SPECIFIED * BY B. THE CONVERTED RESULT REQUIRES 3 WORDS, AND IS * IN THE FORMAT: XXXXX, WITH A SPACE IN THE FIRST POSITION. * * CALLING SEQUENCE: * A = NO. TO BE CONVERTED. IF THE SIGN OF A IS POS., * THE CONVERSION IS TO BE IN OCTAL; IF NEGATIVE, * IN DECIMAL. * B = ADDRESS OF CORE LOCATION FOR CONVERTED RESULT * JSB CONVD * * RETURN: CONTENTS OF A AND B ARE DESTOYED. * CONVD NOP STB CURAT SET MESSAGE ADDRESS LDB OPWRS GET ADDR OF OCTAL POWERS SSA SKIP IF OCTAL CONV REQUIRED LDB DPWRS GET ADDRESS OF DECIMAL POWERS STB RANAD SET POWER RANGE ADDRESS SSA,RSS SKIP IF NEGATIVE (DECIMAL) CMA,INA CONVERT NUMBER TO NEGATIVE STA B PUT NUMBER IN B (REMAINDER) LDA N2 STA TCNT SET CONVERSION COUNTER JSB GETD GET FIRST DIGIT IOR B20K ADD BLANK TO FIRST CHAR STA CURAT,I SAVE FIRST BLANK, CHARACTER ISZ CURAT INCR MESSAGE ADDRESS NEXTD JSB GETD GET NEXT DIGIT ALF,ALF ROTATE TO UPPER STA CURAT,I SAVE UPPER CHARACTER JSB GETD GET NEXT DIGIT IOR CURAT,I ADD UPPER CHAR STA CURAT,I SAVE NEXT 2 CHARACTERS ISZ CURAT INCR MESSAGE ADDRESS ISZ TCNT SKIP - 5 DIGITS IN JMP NEXTD NO - CONTINUE WITH NEXT DIGIT JMP CONVD,I YES - RETURN SKP * RANAD NOP POWER RANGE ADDRESS TCNT NOP CURRENT TBUF COUNT * DPWRS DEF *+1 DEC 10000 DEC 1000 DEC 100 DEC 10 P1 DEC 1 OPWRS DEF *+1 OCT 10000 OCT 1000 OCT 100 OCT 10 OCT 1 * IDAA DEF *+1 ID5 NOP PRIORTY ID6 NOP RESOLUTION CODE ID7 NOP EXEC. MULTIPLE ID8 NOP HOURS ID9 NOP MINUTES ID10 NOP SECONDS ID11 NOP TENS OF MILLISECONDS * M20K OCT -20000 * SET PARAMETERS SKP * * THE PARAMETER INPUT SECTION PERMITS ALTERATION (OR INTRODUCTION) * OF THE NAME, PRIORITY, AND EXECUTION INTERVAL FOR EACH PROGRAM. * EACH PARAMETER RECORD HAS ONE OF THE FOLLOWING FORMATS: * * NAME * NAME,PRIORITY * NAME,PRIORITY,EXECUTION INTERVAL * * PRIORITY = 5 DECIMAL DIGITS (1-32767) * EXECUTION INTERVAL = 6 OPERANDS * 1 - RESOLUTION CODE (2 DECIMAL DIGITS) * 2 - EXECUTION MULTIPLE (5 DECIMAL DIGITS) * 3 - HOURS (2 DECIMAL DIGITS) * 4 - MINUTES (2 DECIMAL DIGITS) * 5 - SECONDS (2 DECIMAL DIGITS) * 6 - 10'S MULLISECONDS (2 DECIMAL DIGITS) * * * RETURN: A AND B ARE DESTROYED * (N+1): SOME PARAMETERS WERE ENTERED * (N+2): NO PARAMETERS WERE ENTERED * * TBUF CONTAINS THE ENTERED NAME * * PARAM NOP PAR00 JSB READ GET ASCII PARAMETER RECORD SZA,RSS SKIP IF CHARS INPUT JMP PAR01 REPEAT PARAMETER INPUT STA PARNO SAVE PARAMETER RECORD LENGTH CLA STA ID5 STA ID6 STA ID7 STA ID8 STA ID9 STA ID10 STA ID11 JSB GETAL 9 CPA B60 JMP PARAM,I STA 1 CMA,INA CHECK TO SEE IF ASCII ADA B132 IS < = TO OCT 132 SSA JMP PAR05 NO CMA,INA ADA B71 AND > = TO OCT 41 SSA JMP PAR05 NO ADB M56 OCT 47 TO OCT 55 SSB,RSS NOT ALLOWED JMP PAR02 > = OCT 56 CMB,INB ADB N8 SSB JMP PAR05 > = OCT 47 AND < = OCT 55 PAR02 ISZ PARAM JSB GINIT INITIALIZE BUFFER SCAN LDA N5 JSB GETNA MOVE CHARS FROM LBUF TO TBUF JSB GETAL GET NEXT CHAR FROM LBUF CPA BLANK CHAR = BLANK?(DELIMITER = COMMA) JMP SETYP YES - CONTINUE CPA ZERO JMP PARAM,I * PAR05 LDA PA PARAMETER NAME ERROR JMP PARER PAR01 JSB INTER JSB SPACE LDA LENGT LDB ADDRS JMP PAR00 * * SET NEW PROGRAM PRIORITY SETYP LDA N5 SET COUNT FOR DECIMAL CONVERSION JSB GETOC CONVERT TO OCTAL JMP PAPER PRIORITY ERROR JSB GETAL GET NEXT CHAR FROM LBUF CPA ZERO CHAR = ZERO ? (END OF BUFFER) RSS YES - CONTINUE CPA BLANK CHAR = BLANK?(DELIMITER = COMMA) JMP SETNR SET PRIORITY PAPER LDA PR PARAMETER PRIORITY ERROR JMP PARER * SETNR LDB OCTNO GET PRIORITY STB ID5 SET NEW PRIORITY JSB GETAL GET NEXT CHAR FROM LBUF CPA ZERO CHAR = ZERO ? (END OF BUFFER) JMP PARAM,I YES,RETURN * * GET RESOLUTION CODE LDA N2 SET FOR 2 DECIMAL DIGITS JSB EXINT GET DIGITS FROM LBUF STA ID6 SET IN IDENT 6 * * GET EXECUTION MULTIPLE LDA N5 SET COUNT FOR DECIMAL CONVERSION JSB EXINT GET DIGITS FROM LBUF AND M20K ISOLATE UPPER 3 BITS IN A SZA SKIP IF VALID MULTIPLE GJMP PAIER INVALID EXECUTION INTERV FORMAT LDA OCTNO GET CONVERTED NUMBER STA ID7 * * GET HOURS LDA N2 SET FOR 2 DECIMAL DIGITS JSB EXINT GET DIGITS FROM LBUF ADA N24 STA ID8 * * GET MINUTES LDA N2 SET FOR 2 DECIMAL DIGITS JSB EXINT GET DIGITS FROM LBUF ADA N60 STA ID9 * * GET SECONDS LDA N2 SET FOR 2 DECIMAL DIGITS JSB EXINT GET DIGITS FROM LBUF ADA N60 STA ID10 * * GET TENS OF MILLISECONDS LDA N2 SET FOR DECIMAL CONVERSION JSB GETOC CONVERT TO OCTAL JMP PAIER INVALID DIGIT JSB GETAL GET NEXT CHAR FROM LBUF CPA ZERO CHAR = 0? (END OF BUFFER) RSS YES - CONTINUE JMP PAIER NO - INVALID DELIMITER LDA OCTNO ADA N100 STA ID11 JMP PARAM,I * * EXECUTION INTERVAL INPUT CONTROL EXINT NOP JSB GETOC CONVERT TO OCTAL JMP PAIER INVALID DIGIT JSB GETAL GET NEXT CHAR FROM LBUF CPA BLANK CHAR = BLANK? (DELIMITER=COMMA) RSS YES - CONTINUE JMP PAIER NO - INVALID DELIMITER LDA OCTNO GET CONVERTED NUMBER JMP EXINT,I RETURN WITH NUMBER IN A PAIER LDA IN PARAMETER INTERVAL ERROR * PARER JSB ERRER ERROR JMP PAR01 REPEAT INPUT * IN ASC 1,IN PARAMETER INTERVAL ERROR NA ASC 1,NA PARAMETER NAME ERROR PR ASC 1,PR PARAMETER PRIORITY ERROR * M56 OCT -56 N24 DEC -24 N60 DEC -60 N100 DEC -100 B60 OCT 60 B71 OCT 71 B132 OCT 132 * SKP * * GETD PROVIDES THE ASCII CHARACTERS FOR CONVD. * * CALLING SEQUENCE: * A = IGNORED * B = REMAINDER * JSB GETD * * RETURN: * A = ASCII DIGIT * BQ = IGNORED * GETD NOP CLA INCRA ADB RANAD,I ADD POWER CMB,SSB,INB,SZB SKIP - TRY NEXT HIGHER DIGIT JMP *+4 DIGIT FOUND INA INCR DIGIT CMB,INB RESTORE REMAINDER TO NEGATIVE JMP INCRA TRY HIGHER DIGIT ADB RANAD,I ADD POWER CMB,INB RESTORE REMAINDER ISZ RANAD INCR POWER LIST ADDRESS IOR B60 CONVERT TO ASCII JMP GETD,I RETURN WITH DIGIT IN A SPC 5 * * * SUBRROUTINE TO DETERMINE IF INPUT DEVICE IS INTERACTIVE * * INTER NOP CLA STA READX SET FOR INTERACTIVE INPUT LDA FTIME FIRST TIME FLAG SZA JMP INT1 NOT FIRST TIME CLA,INA FIRST TIME, SET FLAG STA FTIME JMP INTER,I INT1 LDA INACT INPUT INTERACTIVE? CPA P1 JMP INTER,I YES, RETURN ISZ READX JMP INTER,I * SKP * THIS ROUTINE WILL UPDATE THE PARAMETERS IN THE * PNAME TABEL. THE SOURCE WILL BE FROM THE * "ENTR PRAMS" TABLE * * CALLING SEQUENCE: * A = SOURCE ADDRESS * B = IGNORED * JSB UPNAM * * RETURN: A AND B ARE DESTROYED * UPNAM NOP STA TEMP1 SAVE SOURCE ADDRESS LDA TEMP1,I GET PRIORITY STA PNAME+7 YES ISZ TEMP1 LDA TEMP1,I GET RESOLUTION SZA STA PNAME+8 UPDATE ISZ TEMP1 LDA TEMP1,I EXEC MULT. SZA STA PNAME+9 ISZ TEMP1 LDA TEMP1,I HOURS SZA STA PNAME+10 ISZ TEMP1 LDA TEMP1,I MINUTES SZA STA PNAME+11 ISZ TEMP1 LDA TEMP1,I SECONDS SZA STA PNAME+12 ISZ TEMP1 LDA TEMP1,I TENS OF MILLISECONDS SZA STA PNAME+13 JMP UPNAM,I RETURN HED RTMGN INTERRUPT TABLE PROCESSOR SKP yB@< 0 CMA,INA STA NMAX ADA P64 SSA,RSS JMP PAROK NUMBER OF PARTITIONS >=1 AND <=64 PTERR JSB INERR JMP PARTN REPEAT INPUT PAROK LDA PPREL OUTPUT FOR HEADER OF LDB 0 MEMORY ALLOCATIO8N TABLE JSB SETCR ISZ PPREL JSB BUFC CCA STA LBUF SET FIRST WORD TO -1 NXMAT LDA PPREL LEAVE ROOM FOR PARTITION DEFINITIONS LDB 0 IN MAT. 6 WORD ENTRIES FOR EACH ADB P5 STB PPREL JSB SETCR ISZ PPREL ISZ NMAX JMP NXMAT HED BUILD ID'S AND KEY WORD TABLE * * GET ID'S AND BUILD KEY WORD TABLE * JSB SPACE NEW LINE ID JSB BUFC LDA PPREL KEY WORD TABLE ADDRESS LDB KEYWD ABS ADDRESS JSB STCR1 LDA PPREL STA KEYAD KEY WORD ADDRESS KEYID JSB INTER LDA P10 LDB MES42 # ID SEGS? JSB READ PRINT MESSAGE, GET REPLY LDA N2 GET TWO DECIMAL JSB GETOC JMP IDWER BAD NUMBER STA KEYCN # OF ID SEGS TO KEY COUNT SZA,RSS JMP IDWER DO NOT ACCEPT ID COUNT OF ZERO! CMA,INA ADA P99 OR > 99 SSA JMP IDWER LDA KEYCN RESTORE A ADA PPREL ADD TO PRESENT LOCATION ADA P3 FOR ZERO END STA PPREL UPDATE PPREL STA SYSAD INITIAL ID SEG ADDRESS STA IDSAD FIRST ID SEG ADDRESS JMP *+3 IDWER JSB INERR ERROR JMP KEYID REPEAT INPUT JSB GETAL SZA JMP IDWER NO, ERROR LDA KEYCN NO. OF KEY WORDS CMA,INA STA WDCNT LDA SYSAD STA TEMP2 LDA KEYAD STA TEMP3 KYBLD LDA TEMP2 ADDRESS OF NEXT ID LDB TEMP3 KEY WORD ADDRESS ISZ TEMP3 BUMP TO NEXT KEY WORD ADDR JSB STCR1 OUTPUT TO ABS LDA TEMP2 UPDATE ID ADDRESS ADA P31 SEG SIZE STA TEMP2 ISZ WDCNT ALL DONE? JMP KYBLD NOT DONE YET STA PPREL NEW RELOCATE ADDRESS JSB BUFC CLA ZERO LDB TEMP3 LAST KEYWORD ADDRESS JSB STCR1 LDA KEYCN GET ID SEG COUNT CMA,INA   STA WDCNT SAVE NEG LDA SYSAD ADDRESS OF FIRST ID SEG STA TEMP3 ADA N2 LDB 0 INB CLEAR 1ST TWO WORDS OF ID SEGMENT JSB SETCR CLOOP LDA TEMP3 STARTING ADDRESS LDB A ADB P30 BUMP TO LAST ADDR STB TEMP3 UPDATE STB LBUF ISZ LBUF POINT TO NEXT ID SEG ISZ TEMP3 TO NEXT ADDR JSB SETCR CLEAR ID SEGMENT ISZ WDCNT ALL DONE? JMP CLOOP NO, DO MORE LDB TEMP3 CLEAR LAST LINK POINTER ADB N31 CLA JSB STCR1 * * RESERVE SPACE FOR IDENTS * LDA KEYCN # OF ID SEGMENTS ALS ADA KEYCN MULTIPLY BY 3 CMA,INA ADA OPT.3 STA OPT.3 SET FOR START OF FIXUP TABLE LDB LSTUL HIGHEST LST ENTRY CMB ADA 1 SSA,RSS JMP STUPG GET START UP PROGRAM LSERR LDA TB IDENTOLST OVERFLOW JSB ERRER IRRECOVERABLE ERROR JMP ABRT1 EXIT TO SYSTEM SKP * B2001 OCT 2001 N31 DEC -31 P30 DEC 30 P99 DEC 99 * KEYAD NOP ADDRESS OF KEYWORD TABLE KEYCN NOP TOTAL KEYWORD COUNT MATA NOP ADDRESS OF $MATA MAXPT NOP MAXIMUM NUMBER OF PARTITIONS MPFT NOP ADDRESS OF $MPFT MRMP NOP ADDRESS OF $MRMP NMAX NOP - MAXIMUM NO. OF PARTITIONS SSGAP NOP FWAM SYSAD NOP ID SEGMENT ADDRESS * $MATA DEF *+1 ASC 3,$MATA $MPFT DEF *+1 ASC 3,$MPFT $MRMP DEF *+1 ASC 3,$MRMP .ZPRV DEF *+1 ASC 3,.ZPRV .ZRNT DEF *+1 ASC 3,.ZRNT * MES18 DEF *+1 ASC 14,* MAX NUMBER OF PARTITIONS? MES42 DEF *+1 ASC 5,* #ID SEG? * TB ASC 1,TB IDENT/LST OVERFLOW HED GET START-UP PROGRAM * * GET START-UP PROGRAM * STUPG JSB SPACE NEW LINE JSB INTER LDA P16 LDB MES05 START-UP PROG JSB PARAM GO GET PARAMETERS  JMP RESLB NO PARAMS WERE INPUT LDA TBUF MOVE NAME 1,2 STA STRPN STA START START-UP PROGRAM USED LDA TBUF+1 NAME 3,4 STA STRPN+1 LDA TBUF+2 NAME 5 AND UPCR IOR BLANK STA STRPN+2 LDA SYSAD SEG ONE ADDRESS LDB SKEDD ADDRESS IN BASE PAGE JSB STCR1 TO ABSOLUTE LDA SYSAD SEG ONE ADDRESS STA SG1AD ADA P31 UPDATE TO NEXT STA SYSAD ISZ IDNOS BUMP NOS OF ID'S * SPC 3 * * PUT .ZPRV AND .ZRNT IN LST AS MICROCODE REPLACEMENT RSS'S. * RESLB LDB .ZPRV PUT .ZPRV IN LST JSB ENTPT LDA LST1 SAVE LST ADDRESS STA ZPRIV LDA N4 STA LST5,I SET .ZPRV FOR MICROCODE REPLACEMENT LDA B2001 "RSS" STA LST4,I LDB .ZRNT PUT .ZRNT IN LST JSB ENTPT LDA LST1 SAVE LST ADDRESS STA ZRENT LDA N4 STA LST5,I SET .ZRNT FOR MICROCODE REPLACEMENT LDA B2001 "RSS" STA LST4,I HED RELOCATE RESIDENT LIBRARY * * RELOCATE RESIDENT LIBRARY * JSB SPACE NEW LINE RESL1 JSB INTER INTERACTIVE INPUT LDA PPREL UP LOCC FOR RELOCATE STA .MEM3 LDB LBORG JSB STCR1 LDA P13 PRINT: LDB MES04 REL RES LIB JSB RELOC RELOCATE MODULE DEC 2 JMP RESL1 LOADER ERROR, TRY AGAIN LDA .MEM3 STA PLIB SAVE ADD JUST PAST RES LIB STA SSGAP ADA N1 STA ELIB ADDRESS AT END OF RES LIB JSB PAGE GET PAGE NO. STA PGLIB PAGE NO. AT END OF RES LIB SPC 5 * * RELOCATE SSGA MODULES * JSB SPACE NEW LINE RSSGA JSB INTER INTERACTIVE INPUT LDA P10 LDB MES19 REL SSGA JSB RELOC RELOCATE MODULE DEC 3 JMP RSSGA LOADER ERROR, TRY AGAIN LDB $SSGA JSB ENTPT LDA .MEM3 CC STA LST4,I LDB RTORG BASE PAGE LOCATION JSB STCR1 OUTPUT TO ABS JSB BUFC LDA .MEM1 SET BASE PAGE LOWER LIMIT STA LBUF LDA .MEM2 SET BASE PAGE UPPER LIMIT STA LBUF+1 LDA BPA1 FIRST BP ADDRESS LDB A INB LAST BP ADDRESS JSB SETCR SET TO BP COMMON AREA SKP * * SET UP COMMON AREA * JSB SPACE NEW LINE WDSCM JSB INTER INTERACTIVE INPUT LDA P16 LDB MES07 # WDS IN COMM? JSB READ PRINT MESSAGE, GET REPLY LDA N5 JSB DOCON GET 5 DIGITS JMP WDSCM ERROR, REPEAT INPUT LDA .MEM3 UPDATE FWAC STA .MEM5 ADA OCTNO UPDATE LWAC * * ADJUST COMMON AREA TO PAGE BOUNDARY * JSB SIZE PRINT LAST WORD OF COMMON JSB SPACE NEW LINE ALIGN JSB INTER INTERACTIVE INPUT LDA P21 LDB MES23 ALIGN AT NEXT PAGE? JSB MAYBE PRINT MESSAGE, GET REPLY JMP ALIGN ERROR, REPEAT INPUT SZB,RSS JMP MPFTI NO LDA .MEM6 YES, ADJUST LWAC TO END OF PAGE AND M2000 ADA B2000 JSB SIZE PRINT LAST WORD OF COMMON MPFTI LDA .MEM6 SAVE LWAC STA LWAC LDA .MEM5 GET FWAC CMA,INA ADA .MEM6 DETERMINE COMMON LENGTH INA LDB RTCOM COMMON SIZE TO BASE PAGE JSB STCR1 * * STUFF MEMORY PROTECT FENCE TABLE AND OUTPUT IT * JSB BUFC CLEAR OUTPUT BUFFER LDA PLIB 1ST ENTRY IN MPFT STA LBUF ADD JUST PAST RES LIB STA LBUF+3 STA LBUF+4 LDA .MEM3 ADDRESS JUST PAST COMMON STA LBUF+1 LDA .MEM5 ADDRESS AT START OF COMMON STA LBUF+2 LDA MPFT LDB 0 ADB P4 JSB SETCR OUTPUT TABLE JMP REL00 SKP * APNAM DEF PNAMA PNAMA DEF PNAME * M2000 OCT -2000 B1001 OCT 100001 B2000 OCT 2000 P13 DEC 13 P15 I<:6 DEC 15 P16 DEC 16 P19 DEC 19 P21 DEC 21 P28 DEC 28 * ELIB NOP ADDRESS AT END OF LIBRARY IDSAD NOP SEGMENT ADDRESS LWAC NOP LAST WORD OF AVAILABLE COMMON PGLIB NOP PAGE NO. AT END OF RES. LIB. SG1AD NOP SEG 1 ADDRESS PLIB NOP ADD. JUST PAST END OF LIB. * DU ASC 1,DU DUPLICATE ENTRY * MES3I DEF MES3A MES03 DEF *+1 ASC 9,* LWA OF COMMON = MES3A BSS 3 MES04 DEF *+1 ASC 7,* REL RES LIB MES05 DEF *+1 ASC 8,* START-UP PROG? MES07 DEF *+1 ASC 8,* # WDS IN COMM? MES19 DEF *+1 ASC 5,* REL SSGA MES23 DEF *+1 ASC 11,* ALIGN AT NEXT PAGE? $SSGA DEF *+1 ASC 3,$SSGA * * * * DISPLAY LWA OF COMMON * * SIZE NOP STA .MEM3 SET FWAM ADA N1 STA .MEM6 LDB MES3I JSB CONVD STUFF LWAC TO OUTPUT BUFFER LDA P24 LDB MES03 LWA OF COMMON = JSB PRIN1 JMP SIZE,I HED RELOCATE CORE RESIDENT PROGRAMS <* * RELOCATE CORE RESIDENT PROGRAMS * REL00 CLA,INA SET LINK DIRECTION FLAG STA LNKDR TO USER LINKS REL01 JSB SPACE NEW LINE RELRS JSB INTER INTERACTIVE INPUT LDA IDNOS GET # OF ID SEGMENTS LEFT CMA,INA ADA KEYCN LDB STRPN START-UP PROGRAM REQUESTED? SZB INA YES STA IDS SZA,RSS ANY ID SEGMENTS LEFT? JMP IDZER NO LDA P16 LDB MES08 REL USER PROGS JSB RELOC DEC 0 JMP RELRS LOADER ERROR, TRY AGAIN LDA ?XFER WAS ZERO INPUT? SZA,RSS JMP SNAPO YES, GO DO SNAPSHOT * * CHANGE PARAMETERS * JSB SPACE NEW LINE SRFIN JSB INTER INTERACTIVE INPUT LDA P13 LDB MES10 ENTER PRAMS JSB PARAM GO GET PARAMS JMP SRFI5 NO PARAMS INPUT, NO CHANGE LDA TBUF NAME 1,2 STA PNAME LDA TBUF+1 NAME 3,4 STA PNAME+1 LDA TBUF+2 NAME 5 STA PNAME+2 LDA IDAA ADDRESS OF PARAMETERS JSB UPNAM UPDATE PARAMETERS SRFI5 CLA STA WDCNT CLEAR FOR FIRST TIME LDA APNAM JSB SRIPX SEARCH FOR DUPS JMP *+7 FOUND ONE LDA PNAME+2 MASK OUT LOWER BLANK AND M400 STA PNAME+2 AND RESTORE LDA PNAMA THIS NAME NOT IN TABLE JSB LDIPX SO, PUT IT THERE JMP SRFI6 CONTINUE PROCESSING LDA IP3,I IS THIS AN INT PRG? AND B77 SZA JMP SRFI6 YES, ITS OK LDA DU NO, LOOKS LIKE A DUP ENTRY JSB ERRER JMP SRFIN ERROR, REPEAT INPUT * SRFI6 LDA STRPA ADDRESS OF START UP NAME LDB PNAMA JUST LOADED NAME JSB NACMP COMPARE NAMES JMP SRFI2 NO COMPARE CLA DOES COMPARE STA STRPN CLR STRT FLAG LDA IDSAD SEGMENT ADDRESS CLB POINTS TO ADDRESS JSB GENID GO BUILD>r ID SEGMENT LDA IDSAD GET ID SEG ADDRESS INA POINT TO TEMPORARY STORAGE LDB 0 ADB P9 WORD 11 IN SEG JSB STCR1 ADD WORD TO SEG CLA,INA STA LBUF LDA IDSAD ADA P15 PUT A 1 INTO WORD 16 OF THE SEG LDB A JSB SETCR LDA IDSAD GET CORRECT ID SEG ADDRESS JSB SRFI3 "PROGS" WERE ENTERED, GO LOOK FOR IT JMP REL01 GO RELOCATE NEXT * SRFI2 ISZ IDNOS ENTERED PROGS EXCEEDED ID SEGS? LDA IDNOS CMA,INA ADA KEYCN SSA JMP LSERR IRRECOVERABLE ERROR YES!! LDA SYSAD GET CORRECT ID SEG ADDRESS JSB SRFI3 GO CHECK FOR INT-PRGS LDA SYSAD BUILD SEG IN THIS ADDRESS LDB A ADB P31 LOOK TO NEXT SEGMENT STB SYSAD DYNAMIC SEG POINTER JSB GENID BUILD ID SEG LDA IDNOS NO. OF ID SEGMENTS USED CPA KEYCN ON LAST ONE? RSS JMP REL01 NO, GO GET NEXT LDB SYSAD DON'T LINK TO NEXT ID SEGMENT ADB N31 CLA JSB STCR1 JMP REL01 GO GET NEXT * SRFI3 NOP STA PPREL SAVE ID SEG ADDRESS CLA STA WDCNT CLEAR FOR INITIAL ENTRY LDA APNAM ADDRESS OF INPUTTED PROG NAME SRFI4 JSB SRIPX GO SEARCH RSS FOUND NAME JMP SRFI3,I END OF TABLE LDA IP3,I COMPARES,GET SC AND B77 SZA,RSS JMP SRFI4 ADA AINT ADDRESS OF INTERRUPT TABLE ADA N6 LDB A LDA PPREL SET NEG OF ID ADDRESS CMA,INA INTO THE INTERRUPT TABLE JSB STCR1 LDA IP3,I AND M400 STA IP3,I SHOW ENTRY AS USED JMP SRFI4 LOOK AGAIN SKP * N6 DEC -6 N30 DEC -30 P5 DEC 5 P22 DEC 22 P36 DEC 36 P38 DEC 38 B77 OCT 77 * ESAM NOP END OF SAM FPSAM NOP FIRST PAGE OF SAM LPMRP NOP LAST PAGE OFH MEMORY RESIDENT PROGRAMS LWAMR NOP LWA OF MEM RES PROG AREA NOSAM NOP SAM NOP * STRPA DEF *+1 STRPN BSS 3 START-UP PROGRAM NAME * MES08 DEF *+1 ASC 8,* REL USER PROGS MES10 DEF *+1 ASC 7,* ENTER PRAMS ME35I DEF ME35A MES35 DEF *+1 ASC 10,* LWA MEM RES PROG = ME35A BSS 3 OCT 20040 ASC 4,CHANGE? ME36I DEF ME36A MES36 DEF *+1 ASC 4,* SAM = ME36A BSS 3 OCT 20040 ASC 3,WORDS ME37I DEF ME37A MES37 DEF *+1 ASC 16,* NO. ADD. PAGES FOR SAM? MAX = ME37A BSS 3 SKP HED CHANGE CORE BOUNDARIES * * START-UP PROGRAM REQUESTED? * IDZER LDA P21 LDB MES48 NO ID SEGMENTS LEFT JSB PRIN1 PRINT MESSAGE SNAPO LDA STRPN WAS START-UP PRG REQUESTED? SZA,RSS BUT NOT LOADED JMP MRPA NO LDA IDS SZA,RSS ANY ID SEGMENTS LEFT? JMP LSERR NO, IRRECOVERABLE ERROR JSB SPACE NEW LINE LDA P16 LDB MES05 START-UP PROG? JSB PRIN2 PRINT MESSAGE JSB INTER INTERACTIVE INPUT JSB SPACE NEW LINE LDA P5 LDB STRPA START-UP PROG NAME JSB PRINT PRINT MESSAGE LDA P5 LDB STRPA JSB MAPS JSB SPACE NEW LINE JSB INTER INTERACTIVE INPUT CLA STA FTIME CLA,INA STA CONSO INPUT TO SESSION CONSOLE JMP RELRS RELOCATE START-UP PROGRAM * MRPA LDA KONSO STA CONSO CLA STA PPREL HEADER FLAG STA WDCNT LDA P1 NAME ADDRESS SNAP6 JSB SRIPX GO SEARCH RSS FOUND SOMETHING JMP SNAP7 END OF TABLE LDA IP3,I IS IT AN INT PRG NAME? AND B77 SZA,RSS JMP SNAP6 NO, LOOK NEXT LDA PPREL HEADER BEEN PRINTED? SZA JMP *+7 YES JSB SPACE NO, PRINT IT LDA P10 LDB MES12 INT PRGS STA PPREƫL SET HEADER FLAG JSB PRIN2 JSB SPACE NEW LINE LDA IP3,I PUT BLANK IN LAST CHARACTER AND UPCR IOR P32 STA IP3,I LDA P5 LDB IP1 PRG NAME JSB PRINT LDA LENGT LDB ADDRS JSB MAPS JMP SNAP6 LOOK NEXT * SNAP7 JSB SPACE NEW LINE SNAP9 JSB INTER INTERACTIVE INPUT LDA PPREL ANY INT PRGS PRINTED? SZA,RSS JMP MRPA4 NO, CONTINUE CLA,INA STA CONSO LDA P9 LDB MES13 IGNORE? JSB MAYBE PRINT MESSAGE, GET REPLY JMP SNAP9 ERROR, REPEAT INPUT SZB,RSS JMP RELRS MRPA4 LDA KONSO STA CONSO LDA START SZA,RSS ANY START-UP PROGRAM? JMP MRPA0 NO JSB BUFC LDB SG1AD ADB P28 LDA B1001 JSB STCR1 MRPA0 JSB SPACE NEW LINE MRPA1 JSB INTER INTERACTIVE INPUT CCA ADA .MEM3 GET LWA MEM RES PROG STA LWAMR LDB ME35I JSB CONVD PUT IN OUTPUT BUFFER LDA P36 LDB MES35 LWA MEM RES PROG = XXXXX CHANGE? JSB READ PRINT MESSAGE, GET REPLY LDA P5 JSB DOCON GET NEW LWA MEM RES PROG JMP MRPA1 REPEAT INPUT SZA,RSS LDA LWAMR NO CHANGE STA LWMRP CMA,INA CHECK IF LWAMR IS SMALLER THAN BEFORE ADA LWAMR CMA,INA SSA,RSS JMP MRPA3 NEW LWAMR IS > OR = OLD LWAMR JSB INERR ERROR, TRY AGAIN JMP MRPA1 MRPA3 LDA LWMRP STA LWAMR JSB SPACE NEW LINE ALSAM JSB INTER INTERACTIVE INPUT LDA P21 LDB MES23 ALIGN AT NEXT PAGE? JSB MAYBE PRINT MESSAGE, GET REPLY JMP ALSAM ERROR, REPEAT INPUT SZB,RSS JMP MRPA2 NO LDA LWAMR YES, ADJUST LWAMR TO END OF PAGE AND M2000 ADA B1777 STA LWAMR MRPA2 LDA LWAMR STA .MEM4 NO, RESET LWAMy AND M2000 ADJUST SYS AV. MEM. TO END ADA B1777 OF PAGE CLB CPA LWAMR CLB,INB MEM RES PROGS EXTEND TO END OF PAGE STA ESAM END OF SAM JSB PAGE GET PAGE NO. STA LPMRP LAST PAGE OF MEM RES PROGS ADA 1 STA FPSAM FIRST PAGE OF SAM CMB,INB STB NOSAM LDA LWSA1 LDB SYSTM CPB P3 LDA ESAM LDB LWAMR CMB,INB ADA 1 SSA JMP MRERR SAM NEGATIVE, ERROR EXIT STA SAMSZ SAVE SAM SIZE CMA,INA LDB ME36I JSB CONVD PUT SAM SIZE IN OUTPUT BUFFER LDA P22 LDB MES36 SAM = JSB PRIN1 PRINT MESSAGE LDB SYSTM GET SYSTEM TYPE CPB P3 TYPE 3 SYSTEM? RSS JMP SNAP5 NO LDA ELIB ADDRESS AT END OF LIB LDB PCOM PRIV. DRIVERS ACCESS COMMON? SZB LDA .MEM6 YES, USE LAST WORD OF COMMON JSB PAGE GET PAGE NUMBER STA ECLIB SAVE PAGE AT END OF COMMON/LIB ADA N30 # PAGES FOR SAM = 31 - # OF STA SAM PAGES THRU COMMON OR LIBRARY LDB ME37I JSB CONVD PUT IN OUTPUT BUFFER JSB SPACE NEW LINE PSYM JSB INTER INTERACTIVE INPUT LDA P38 LDB MES37 NO. ADD. PAGES FOR SAM? JSB READ PRINT MESSAGE, GET REPLY LDA N3 JSB DOCON JMP PSYM ERROR, REPEAT INPUT STA 1 MAX. ADD. PAGES ADA SAM CMA,INA SSA JMP MRERR MORE PAGES THAN ALLOWED STB SAM SAVE ADD. PAGES LDB FPSAM 1ST PAGE OF SAM ADB NOSAM ADB SAM ADDITIONAL PAGES STB LPSAM LAST PAGE OF SAM CMB ADB MSIZE MEMORY SIZE STB PAGES NO. OF PAGES REMAINING HED DEFINE PARTITIONS * * * PARTITION DEFINITION * * CLA STA FTIME PAR0A JSB INTER INTERACTIVE INPUT? # LDA N4 CLEAR PARTITION DEFINITION TABLE STA KOUNT CLA PARCL LDB PATBL 4 WORDS = MAXIMUM 64 PARTITIONS STA 1,I WORD 1 BIT 0 = PARTITION 1, ETC. INB IF BIT = 1 PARTITION DEFINED ISZ KOUNT JMP PARCL LDA PAGES NO. OF PAGES REMAINING STA PAGE0 SAVE FOR RESTORE JSB SPACE NEW LINE LDA P31 LDB MES45 LARGEST ADDRESSABLE PARTITION JSB PRIN1 PRINT MESSAGE JSB SPACE NEW LINE CCA ADA SSGAP GET NUMBER OF PAGES USED W/O JSB PAGE COMMON CMA,INA FIND NUMBER OF PAGES LEFT ADA P32 LDB ME46I CMA,INA SET FOR DECIMAL JSB CONVD PUT IN MESSAGE LDA P22 LDB MES46 W/O COMMON XX PAGES JSB PRIN1 PRINT MESSAGE LDA LWAC LAST WORD OF AVAILABLE COMMON JSB PAGE GET NO. OF PAGES USED WITH COMMON CMA,INA FIND NO. OF PAGES LEFT ADA P32 STA MXPTL MAXIMUM PARTITION LENGTH CMA,INA SET FOR DECIMAL LDB ME47I JSB CONVD PUT IN MESSAGE LDA P22 LDB MES47 W/ COMMON XX PAGES JSB PRIN1 PRINT MESSAGE JSB SPACE NEW LINE JSB PTPAG OUTPUT NO. OF PAGES REMAINING JSB INTER INTERACTIVE INPUT LDA P19 LDB MES43 DEFINE PARTITIONS JSB PRIN1 PRINT MESSAGE JSB SPACE NEW LINE PAR04 JSB INTER INTERACTIVE INPUT LDA P3 LDB QUEST ? JSB READ PRINT MESSAGE, GET REPLY LDA N2 JSB GETNA GET FIRST 2 CHARACTERS CPA EN END? JMP PAREN YES, PARTITIONS ALL DEFINED CPA RE REPEAT ALL DEFINITIONS? JMP PAR0A YES JSB GINIT REINITIALIZE INPUT LDA N2 GET PARTITION NO. JSB GETOC JMP PARE4 ERROR STA PANUM SAVE PARTITION NO. CMA,INA ADA MAXPT EXCEEDS MAXIMUM PARTITION NO.? SSA,RSS NO JMP PAR03 PARE1 LDA PT PARTITION DEFINITION ERROR RSS PARE2 LDA PD PARTITION ALREADY DEFINED RSS PARE3 LDA PS NOT ENOUGH MEMORY LEFT JSB ERRER ERROR RSS PARE4 JSB INERR ERROR JMP PAR04 REPEAT INPUT PAR03 JSB GETAL CHECK FOR COMMA CPA BLANK RSS YES, COMMA JMP PARE4 NO, ERROR LDA N2 GET PARTITION SIZE JSB GETOC JMP PARE4 INPUT ERROR, TRY AGAIN STA PARSZ SAVE PARTITION SIZE CMA,INA STA 1 CHECK IF GREATER THAN MAXIMUM ADA MXPTL ALLOWED SSA JMP PARE1 YES LDA 1 CHECK IF GREATER THAN NUMBER OF ADA PAGE0 PAGES REMAINING SSA JMP PARE3 YES, ERROR STA PAGE1 SAVE NO. OF PAGES REMAINING LDA PARSZ ADA N2 SSA JMP PARE4 MUST BE AT LEAST 2 PAGES JSB BUFC CLEAR OUTPUT BUFFER LDA PANUM GET PARTITION NO. RAR,RAR CHECK TABLE TO SEE IF RAR,RAR ALREADY DEFINED AND P15 ADA PATBL STA KOUNT LDA 0,I STA TEMP1 LDA PANUM AND P15 CMA,INA LDB MNEG RBL ISZ 0 JMP *-2 LDA 1 IOR TEMP1 CPA TEMP1 JMP PARE2 PARTITION ALREADY DEFINED STA KOUNT,I UPDATE TABLE LDA PAGE0 FIND BEGINNING PAGE ADDRESS CMA,INA ADA MSIZE STA LBUF+3 LDA PAGE1 STA PAGE0 UPDATE NO. OF PAGE REMAINING CCA ADA PARSZ PARTITION SIZE STA LBUF+4 CCA ADA PANUM OUTPUT SIZE AND RAL BEGINNING PAGE STA 1 ADDRESS OF RAL PARTITION ADA 1 TO CORRECT INA ADA MATA ENTRY IN LDB 0 MEMORY ADB P5 ALLOCATION JSB SETCR  TABLE JSB PTPAG OUTPUT NO. OF PAGES LEFT CLA STA FTIME JMP PAR04 GET NEXT PARTITION DEFINITION HED OUTPUT MRMP AND STUFF ENTRIES * * STUFF MEMORY RESIDENT PROG. MAP AND OUTPUT IT * PAREN JSB BUFC LDA LPMRP GET LAST PAGE OF MEM RES PROGS CMA STA MRMPG ADA P32 CMA STA WRPOT LDA ALBUF SET 0,1,2.....N IN OUTPUT CLB BUFFER, WHERE N = PAGE # STB 0,I OF ADJUSTED END OF MEM RES PROGS INB INA ISZ MRMPG JMP *-4 CCB ISZ WRPOT RSS JMP *+4 STB 0,I SET REMAINING PAGES TO -1 INA FOR WRITE PROTECT JMP *-5 LDA MRMP GET ADDRESS OF TABLE LDB 0 ADB P31 JSB SETCR GO OUTPUT VALUES * *STUFF $ENDS, $LPSA, $MPSA * LDA PGLIB PAGE # AT END OF RES LIB INA # OF PAGES SYS + LIB LDB $ENDS JSB STUFF PUT IN $ENDS LDB $LPSA LDA LPSAM LAST PAGE OF SAM JSB STUFF PUT IN $LPSA LDA SAM GET # OF ADD PAGES OF SAM INA ADD 1 FOR 1ST PAGE ADA NOSAM ADJUST IF SAM DOESN'T SHARE PAGE ALF,ALF WITH MEM RES PROGS RAL,RAL SHIFT TO BITS 10 - 15 IOR FPSAM MERGE WITH 1ST PAGE OF SAM LDB $MPSA JSB STUFF PUT IN $MPSA SNAP5 LDB $EMRP LDA LWAMR LAST WORD OF MEM RES PROGS JSB STUFF PUT IN $EMRP JMP *+3 MRERR JSB INERR ERROR JMP MRPA1 REPEAT INPUT * LDA JMP3I SET STARTING JMP STA LBUF LDA STRAD SET STARTING ADDRESS STA LBUF+1 LDA P2 LDB P3 JSB SETCR HED SNAPSHOT OUTPUT FOR LOADER RELOCATION LDB SYSTM CPB P3 RTE-M-3? JMP SNAP1 YES LDA LWAMR SET AVMEM TO NEXT WORD PAST INA MEM RES PROGS. (SAM) SNAP0 LDB AVMEM BP ADDRESS  JSB STCR1 SET FWA SYS MEM INTO RTM BP LDA SAM GET NO. OF PAGES OF SAM ALF,ALF RAL,RAL CONVERT TO WORDS ADA SAMSZ ADD WORDS ON FIRST PAGE ADA SAMST ADD START OF SAM-1 LDB SYSTM GET SYSTEM TYPE CPB P1 LDA LWSA1 USE LWAM INSTEAD FOR RTE-M-1 CPB P2 LDA LWSA1 USE LWAM INSTEAD FOR RTE-M-2 LDB BGORG FWA OF BACKGROUND COMMON JSB STCR1 LDB BGLWA LWA MEMORY BACKGROUND PARTITION JSB STCR1 CLB,INB JSB CLFL2 WRITE EOF FOR ABSOLUTE JSB SPACE NEW LINE SNAP2 JSB INTER INTERACTIVE INPUT LDA P11 LDB MES09 SNAPSHOT? JSB PRIN1 JSB PRCMD JMP SNAP2 JSB SPACE NEW LINE LDA DCB2 IS OUTPUT A TYPE 0 FILE? SSA,RSS JMP SNAPX AND UDFE LDA 0,I JMP *-4 SNAPX ADA P2 LDB 0,I SZB,RSS JMP SNAP3 YES INA LDB 0,I GET TRACK NUMBER CMB,INB STB TRACK INA LDB 0,I GET SECTOR NUMBER CMB,INB STB SECTR LDA TRACK PUT TRACK # IN MESSAGE LDB ME49I JSB CONVD LDA SECTR PUT SECTOR # IN MESSAGE LDB ME50I JSB CONVD LDA P46 MESSAGE LENGTH LDB MES49 MESSAGE ADDRESS JSB PRIN1 JSB SPACE SNAP3 LDA P16 LDB MES11 RTMGN FINISHED JSB PRIN2 JMP EXEC6 SNAP1 LDB ECLIB LIBRARY ON SAME PAGE AS SAM? CPB FPSAM JMP SNAP0 YES BLF,BLF SET AVMEM TO NEXT PAGE WITH SAME RBL,RBL OFFSET THAT SAM HAS WHERE IT STARTS LDA LWAMR AND B1777 CPA B1777 EXTENDS TO END OF PAGE? RSS ADB B2000 NO, ADD ONE PAGE ADA 1 STA SAMST SAVE START OF SAM-1 INA JMP SNAP0 * * * SUBROUTINE TO OUTPUT NO. OF PAGES REMAINING * * PTPAG NOP LDA PAGE0 NO. OF PAGES REMAINING LDB ME44I CMA,INA SET FOR DECIMAL JSB CONVD PUT IN MESSAGE LDA P26 LDB MES44 PAGES REMAINING = JSB PRIN1 PRINT MESSAGE JMP PTPAG,I * * * UPCR OCT 77400 MNEG OCT 100000 P26 DEC 26 P31 DEC 31 P46 DEC 46 * ECLIB NOP IDS NOP # OF ID SEGMENTS LEFT KOUNT NOP TEMP STORE LPSAM NOP LAST PAGE OF SAM LWMRP NOP LAST WORD OF MEM RES PROGS. MRMPG NOP MXPTL NOP MAXIMUM PARTITION LENGTH PAGE0 NOP TEMP STORE FOR NO. OF PAGES LEFT PAGE1 NOP " " " " PAGES NOP # PAGES AFT REL CORE RES PROG PANUM NOP PARTITION NO. PARSZ NOP PARTITION SIZE SAMSZ NOP SAM SIZE ON FIRST PAGE SAMST NOP START OF SAM-1 SECTR NOP SECTOR NUMBER TRACK NOP TRACK NUMBER WRPOT NOP * PATBL DEF *+1 REP 4 OCT 0 $EMRP DEF *+1 ASC 3,$EMRP $ENDS DEF *+1 ASC 3,$ENDS $LPSA DEF *+1 ASC 3,$LPSA $MPSA DEF *+1 ASC 3,$MPSA * PT ASC 1,PT PARTITION DEFINITION ERROR PD ASC 1,PD PARTITION ALRADY DEFINED ERROR PS ASC 1,PS PARTITION SIZE ERROR * JMP3I JMP 3,I * MES09 DEF *+1 ASC 6,* SNAPSHOT? MES11 DEF *+1 ASC 8,* RTMGN FINISHED MES12 DEF *+1 ASC 5,* INT PRGS MES13 DEF *+1 ASC 5,* IGNORE? MES43 DEF *+1 ASC 10,* DEFINE PARTITIONS ME44I DEF ME44A MES44 DEF *+1 ASC 10,* PAGES REMAINING = ME44A BSS 3 MES45 DEF *+1 ASC 16,* LARGEST ADDRESSABLE PARTITION ME46I DEF ME46A MES46 DEF *+1 ASC 5,* W/O COM ME46A BSS 3 ASC 3, PAGES ME47I DEF ME47A MES47 DEF *+1 ASC 5,* W/ COM ME47A BSS 3 ASC 3, PAGES MES48 DEF *+1 ASC 11,* NO ID SEGMENTS LEFT ME49I DEF ME49A ME50I DEF ME50A MES49 DEF *+1 ASC 13,* SYSTEM STARTS AT TRACK ME49A BSS 3 ASC 4, SECTOR ME50B@65K? JMP SNGLP DIV .10K WORK ON EXCESS FIRST STB READ SAVE REMAINDER FOR NEXT PASS. CLB JSB DEC4 LDA READ CCE SKIP DIV .10K THIS TIME SNGLP JSB DEC4 JMP DEC,I * SKP SPC 1 * NAME:DEC4 LEVEL:3 * SUBROUTINE TO CONVERT THE DECIMAL NUMBER IN THE * A-REGISTER TO A CHARACTER STRING IN THE TERMINAL * OUTPUT BUFFER. IF E-REG=0, THE NUMBER IS ASSUMED * TO BE A SINGLE PRECISION INTEGER OR THE MOST * SIGNIFICANT BITS OF A DOUBLE PRECISION INTEGER. * IF E-REG=1, THE NUMBER IS ASSUMED TO BE THE * SECOND WORD OF A DOUBLE PRECISION INTEGER. * CALLING SEQUENCE: * SET E-REG * LDA NUMBER TO BE CONVERTED * JSB DEC4 * ADDITIONAL ROUTINES: * CONVT * VARIABLES ON RETURN: * OCCNT:OCCNT+#DIGITS IN THE NUMBER * REGISTERS ON RETURN: * A:ZERO * B:ZERO * SUBORDINATE TO: * DEC DEC4 NOP SEZ IF NUMBER >65K, SKIP JMP THOU FIRST DIVIDE, PASS 2. DIV .10K OUTPUT TEN THOUSANDS JSB CONVT DIGIT THOU DIV .1000 OUTPUT THOUSANDS JSB CONVT DIGIT DIV .100 OUTPUT HUNDREDS JSB CONVT DIGIT DIV .10 OUTPUT TENS JSB CONVT DIGIT AND JSB CONVT ONES DIGIT JMP DEC4,I SPC 1 1 SKP * NAME:DIRCT * SUBROUTINE TO FIND THE DIRECT ADDRESS * BY ELIMINATING THE INDIRECT BIT * CALLING SEQUENCE: * LDB ADDRESS * JSB DIRCT * ADDITIONAL ROUTINES: * NONE * VARIABLES ON RETURN: * NO CHANGE * REGISTERS ON RETURN: * A:UNCHANGED * B:DIRECT ADDRESS DIRCT NOP SSB,RSS JMP DIRCT,I DONE ELB,CLE,ERB MASK OFF INDIRECT BIT LDB B,I JMP DIRCT+1 SKP SPC 1 * NAME:DOUTP LEVEL:2 * SUBROUTINE TO MOVE THE HEAD RECORD OF THE * DESTINATION CHAIN TO THE DESTINATION PERIPHERAL. * DELETE THAT BLOCK FROM THE DEST CHAIN AND ADD * IT TO THE AV MEM CHAIN. * CALLING SEQUENCE: * JSB DOUTP * NORMAL RETURN HERE * BUFFER EMPTY RETURN HERE * ADDITIONAL ROUTINES: * WRITF * FMPER * GETHD * PUTTL * EZFL * STAT * ERROR * VARIABLES ON RETURN: * SAME * REGISTERS ON RETURN: * A:MEANINGLESS * B:MEANINGLESS DOUTP NOP JSB GETHD FETCH THE HEAD OF THE DEST CHAIN DEF DHEAD JMP DOUT1 NULL CHAIN-BUMP AND RETURN SSA TEST FOR EOF RECORD JMP *+3 NO LENGTH CONVERSION FOR -1 INA ROUND UP ARS CONVERT CHARS TO WORD COUNT STA ECH MOVE PARAMETERS STB PURG TO FILE WRITE ROUTINE JSB PUTTL PUT BUFFER IN AVAILABLE CHAIN DEF ATAIL DEF PURG DEF RUBSH *!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! JSB WRITF ! DEF *+5 ! WRITE DEF DCBO,I ! SOURCE DEF RUBSH ! RECORD DEF PURG,I ! DEF ECH ! *!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! CPA M7 JMP FMPE BAD SECURITY CODE - WRITE PROTECTED CPA M17 JMP FMPE READ ONLY DEVICE CPA M14 JMP EZFAL DIRECTORY FULL - EXTENT CANNOT BE MADE CPA M6 JMP EZFAL NO ROOM ON DISC JSB FMPER PRINT ANY ERRORS JMP DOUTP,I DOUT1 ISZ DOUTP NULL RETURN-BUMP RETURN ADDRESS JMP DOUTP,I EZFAL JSB EZFL PRINT FILE NAMES JSB STAT PRINT STATUS OF EDIT JSB ERROR TELL OPERATOR 'DISC FULL' DEF MS007 DEF .9 JMP OUT ABORT * MS007 ASC 09,EDITM 7-DISC FULL * SKP SPC 1 * NAME:ECH LEVEL:2 * SUBROUTINE TO RETURN NEXT COMMAND CHARACTER * IN LOWER BYTE OF A-REGISTER. ERROR RETURN * IF EBUFF IS EMPTY. * CALLING SEQUENCE: * JSB ECH * END OF BUFFER RETURN HERE * CHARACTER FOUND RETURN HERE * ADDITIONAL ROUTINES: * CH * VARIABLES ON RETURN: * CASE 1: * ECCNT:UNCHANGED * CASE 2:ECCNT:ECCNT+1 * REGISTERS ON RETURN: * CASE 1: * A:ECCNT BEFORE INCREMENT * B:UNCHANGED * CASE 2: * A:NEXT COMMAND CHARACTER * B:UNCHANGED ECH NOP LDA ECCNT # CHARACTERS ALREADY READ CPA ELNG # CHARACTERS IN BUFFER JMP ECH,I END OF VALID DATA ISZ ECCNT ISZ ECH BUMP TO NORMAL RETURN CLE,ERA CONVERT TO WORDS ADA EBUFF ADD BASE ADDRESS JSB CH FETCH CHARACTER FROM BUFFER JMP ECH,I * SKP * * NAME: E.P * SUBROUTINE TO EXCHANGE EBUFF AND PBUFF BY * SWAPPING BUFFER POINTERS AND LENGTHS. * CALLING SEQUENCE: * JSB E.P * ADDITIONAL ROUTINES: * NONE * VARIABLES ON RETURN: * E/PBUFF SWAPPED * E/PLNG SWAPPED * REGISTERS ON RETURN: * MEANINGLESS * E.P NOP SWAP COMMAND BUFFER AND PENDING LINE LDA EBUFF LDB PBUFF STA PBUFF STB EBUFF LDA ELNG LDB PLNG STA PLNG STB ELNG JMP E.P,I * SKP * * NAME: ENDFL * SUBROUTINE TO CLOSE MERGE OR HELP * FILE AND RESET DCB POINTERS. * DCB DURING MERGE: * ****************************** * * INPUT FILE HEADER * * * * * ****************************** * * MERGE FILE HEADER * * * * * ****************************** * * * * * * * * DCB BUFFER SPACE * * * * * ****************************** * CALLING SEQUENCE: * JSB ENDFL * ADDITIONAL ROUTINES: * CLSI * VARIABLES ON RETURN: * DCBI=DCBI-16 * LINES=LINE NO. BEFORE MERGE * REGISTERS ON RETURN: * MEANINGLESS ENDFL NOP CLOSE MERGE OR HELP FILE AND REPOSITION SOURCE JSB CLSI CLOSE FILE LDA DCBI ADA M16 STA DCBI DLD PLINE DST LINES RESTORE PREVIOUS LINE NO. JMP ENDFL,I * * SKP SPC 1 * NAME:ERR LEVEL:2A * SUBROUTINE TO HANDLE OPERATOR ERROR MESSAGES. * EXECUTION CONTINUES AT NODE1. * PROGRAM IS ABORTED IF COMMAND INPUT * IS NOT FROM A TERMINAL. * CALLING SEQUENCE: * JMP ERXXX WHERE XXX IS THE ERROR NUMBER * ADDITIONAL ROUTINES: * ERROR * VARIABLES ON RETURN: * SAME * REGISTERS ON RETURN: * A:MEANINGLESS * B:MEANINGLESS ER006 ISZ ERR ER005 ISZ ERR ER004 ISZ ERR ER003 ISZ ERR ER002 ISZ ERR ER001 ISZ ERR ER000 LDA TABAD FETCH LENGTH OF MESSAGE ADA ERR STA PRT+2 SAVE COUNT ADA TABLN LDA A,I STA PRT+1 SAVE ADDRESS CLA STA ERR CLEAR DISPLACEMENT PRT JSB ERROR WRITE THE ERROR MESSAGE NOP ADDRESS OF MESSAGE NOP COUNT JMP NODE1 * * CONSTANTS FOR ERR * * * ERR NOP DISPLACEMENT WITHIN JUMP TABLES FOR THIS ERROR TABAD DEF TABLE BASE ADDRESS FOR JUMP TABLES TABLN DEC 7 NUMBER OF ERROR MESSAGES TABLE DEC 13 LENGTH OF MESSAGES DEC 12 DEC 15 DEC 11 DEC 13 DEC 8 DEC 13 DEF MS000 ADDRESSES OF MESSAGES DEF MS001 DEF MS002 DEF MS003 DEF MS004 DEF MS005 DEF MS006 MS000 ASC 13,EDITM 0-INVALID PARAMETER MS001 ASC 12,EDITM 1-INVALID COMMAND MS002 ASC 15,EDITM 2-COMMAND FILE NOT FOUND MS003 ASC 11,EDITM 3-FILE TOO LARGE MS004 ASC 13,EDITM 4-DELIMITER MISSING MS005 ASC 08,EDITM 5-NO ROOM MS006 ASC 13,EDITM 6-PARAMETER MISSING * SKP SPC 1 * NAME:ERROR LEVEL:2 * SUBROUTINE TO PRINT AN ERROR MESSAGE ON THE CONSOLE. * PROGRAM IS ABORTED IF COMMAND INPUT * IS BNOT FROM A TERMINAL. * CALLING SEQUENCE: * JSB ERROR * DEF BUFFER * DEF MESSAGE LENGTH IN WORDS * ADDITIONAL ROUTINES: * WRITF IMESS * VARIABLES ON RETURN: * ERMEC:LENGTH OF MESSAGE * ERMEP:ADDRESS OF MESSAGE * REGISTERS ON RETURN: * A:RETURN ADDRESS * B:MEANINGLESS ERROR NOP LDA ERROR,I ISZ ERROR STA ERMEP SAVE ADDRESS STA ERMEQ LDA ERROR,I ISZ ERROR STA ERMEC SAVE COUNT STA ERMEN LDA TTY SSA INTERACTIVE DEVICE AVAILABLE? JMP IMEX NO, ABORT JSB WRITF PRINT ERROR MESSAGE DEF *+5 GDCB. DEF GDCB DEF RUBSH ERMEP NOP ADDRESS ERMEC NOP COUNT SSA,RSS JMP ERROR,I * IMEX JSB IMESS PRINT ERROR ON SESSION CONSOLE DEF *+4 DEF .2 ERMEQ NOP ADDRESS ERMEN NOP COUNT JMP OUT ABORT EDITM SKP * * NAME: EZFL * SUBROUTINE TO PRINT SCRATCH FILE NAMES * CALLING SEQUENCE: * JSB EZFL * ADDITIONAL ROUTINES: * MVW * LST * VARIABLES ON RETURN: * SAME * REGISTERS ON RETURN: * MEANINGLESS * EZFL NOP OUTPUT FILE NAMES JSB MVW MOVE INFILE NAME TO MESSAGE DEC 3 DEF NAMI,I DEF MSG+4 JSB MVW MOVE OUTFILE NAME TO MESSAGE DEC 3 DEF NAMO,I DEF MSG+12 JSB LST PRINT MESSAGE DEF MSG DEF .15 JMP EZFL,I * NOP MSG ASC 15,INFILE= OUTFILE= SKP SPUC 1 * NAME:FMPER LEVEL:2 * SUBROUTINE TO PRINT OUT ALL FILE MANAGER ERRORS. * ERROR NUMBER PASSED IN A-REGISTER. * CALLING SEQUENCE: * LDA ERROR CODE * LDB GETFIL OPTION WORD (OPTIONAL STEP) * JSB FMPER * ADDITIONAL ROUTINES: * ERROR * DEC * VARIABLES ON RETURN: * OPT: GETFIL OPTION WORD * REGISTERS ON RETURN: * A:ERROR CODE * B:MEANINGLESS FMPER NOP STB OPT STA INFIL SAVE ERROR CODE SSA,RSS JMP FMPER,I NO ERROR, RETURN CLB,INB STB OCCNT SET UP OUTPUT BUFFER COUNT CMA,INA COMPLEMENT ERROR NUMBER CLB JSB DEC CONVERT TO ASCII LDB TBUFF INB LDA B,I GET FIRST DIGIT XOR B1640 CHANGE '0' TO '-' STA MSGP+5 INB LDA B,I STA MSGP+6 PUT LAST TWO DIGITS IN MESSAGE JSB ERROR PRINT ERROR MESSAGE DEF MSGP DEF .7 LDA INFIL FETCH ERROR CODE JMP FMPER,I * MSGP ASC 7,FMP ERROR -XXX SPC 1 1 FMPA NOP CPA M11 FMGR -011 ERROR RSS JSB FMPER PRINT ANY OTHERS JMP FMPA,I SPC 1 1 FMPC JSB FMPER PRINT FILE MANAGER ERROR LDA NAMI JSB OPENI RE-OPEN INPUT SCRATCH FILE JSB FMPER PRINT ANY ERRORS JMP READ1 THEN GET NEXT COMMAND SPC 1 1 FMPD NOP CPA M6 FMGR-06 ERROR RSS IF SO- DON'T PRINT IT JSB FMPER IF NOT- PRINT ERROR JMP FMPD,I * FMPE JSB FMPER PRINT THE ERROR LDA NAMO JSB OPENO RE-OPEN THE OUTPUT FILE JSB FMPER PRINT ANY ERRORS JMP RWND READ FIRST LINE * :0.**0 SKP SPC 1 * NAME:GETHD LEVEL:2 * SUBROUTINE TO RETURN THE ADDRESS OF THE FIRST BLOCK * OF ONE OF THE MEMORY MANAGER CHAINS AND ADJUST * THE CHAIN HEAD POINTER TO THE NEXT BLOCK. * THE NULL RETURN IS TAKEN IF THE CHAIN IS EMPTY AT * THE TIME OF THE CALL. * CALLING SEQUENCE: * JSB GETHD * DEF HEAD POINTER FOR THE CHAIN * NULL CHAIN RETURN HERE * BLOCK FOUND RETURN HERE * ADDITIONAL ROUTINES: * NONE * VARIABLES ON RETURN: * CHAIN POINTERS:REFLECT NEW CHAIN HEAD AND LENGTH * REGISTERS ON RETURN: * A:LENGTH OF RECORD RETRIEVED * B:ADDRESS OF BLOCK REQUESTED * GETHD NOP LDA GETHD,I FETCH ADDRESS OF HEAD POINTER LDB A,I FETCH ADDRESS OF FIRST BLOCK STB FMPER MOVE ADDRESS TO TEMPORARY STORAGE ISZ GETHD BUMP TO NULL RETURN SSB WAS A RECORD ACTUALLY FOUND? JMP GETHD,I NO-(NULL CHAIN)-EXIT ISZ GETHD BUMP TO NORMAL RETURN ADB M3 STEP TO FORWARD POINTER LDB B,I FETCH ADDRESS OF SECOND BLOCK STB A,I MAKE IT THE FIRST BLOCK INA STEP TO TAIL POINTER FOR THIS CHAIN SSB WAS END OF CHAIN DETECTED? STB A,I YES-DENOTE NULL CHAIN INA STEP TO CHAIN LENGTH OF THIS CHAIN LDB A,I FETCH LENGTH ADB M1 DECREMENT CHAIN LENGTH SSB NEGATIVE CHAIN LENGTH IS IMPOSSIBLE HLT 1 FREEZE THE CPU STB A,I REPORT NEW CHAIN LENGTH ADA M2 STEP TO CHAIN'S HEAD POINTER LDB A,I FETCH ADDRESS OF RECORD #1 SSB NULL CHAIN? JMP *+4 d YES-NO BACKWARD POINTER TO MODIFY ADB M2 STEP TO ITS BACKWARD POINTER CCA STA B,I SET ITS BACKWARD POINTER TO SIGNAL START-OF-CHAIN LDB FMPER RECALL BLOCK ADDRESS FROM STORAGE LDA B FETCH BLOCK ADDRESS ADA M1 STEP TO LENGTH WORD LDA A,I FETCH LENGTH OF RECORD JMP GETHD,I SKP SPC 1 * NAME:GETTL LEVEL:2 * SUBROUTINE TO RETURN THE ADDRESS AND LENGTH OF THE * LAST RECORD IN ANY OF THE MEMORY MANAGER CHAINS * AND ADJUST THE CHAIN POINTERS ACCORDINGLY. * THE NULL RETURN IS TAKEN IF THE CHAIN IS EMPTY * AT THE TIME OF THE CALL. * CALLING SEQUENCE: * JSB GETTL * DEF TAIL POINTER FOR THE CHAIN * NULL CHAIN RETURN HERE * BLOCK FOUND RETURN HERE * ADDITIONAL ROUTINES: * NONE * VARIABLES ON RETURN: * CHAIN POINTERS:REFLECT NEW TAIL AND LENGTH * REGISTERS ON RETURN: * A:LENGTH OF RECORD RETRIEVED * B:ADDRESS OF RECORD RETRIEVED * GETTL NOP LDA GETTL,I FETCH ADDRESS OF TAIL POINTER LDB A,I FETCH ADDRESS OF LAST BLOCK STB FMPER MOVE ADDRESS TO TEMPORARY STORAGE ISZ GETTL BUMP TO NULL RETURN SSB WAS A RECORD ACTUALLY FOUND? JMP GETTL,I NO-(NULL CHAIN)-EXIT ISZ GETTL BUMP TO NORMAL RETURN ADB M2 STEP TO BACKWARD POINTER LDB B,I FETCH ADDRESS OF SECOND TO LAST BLOCK STB A,I MAKE IT THE LAST BLOCK ADA M1 STEP TO HEAD POINTER FOR THIS CHAIN SSB WAS END OF CHAIN DETECTED? STB A,I YES-DENOTE NULL CHAIN ADA .2 STEP TO CHAIN LENGTH OF THIS CHAIN LDB A,I FETCH LENGTH ADB M1 DECREMENT CHAIN LENGTH SSB NEGATIVE CHAIN LENGTH IS IMPOSSIBLE HLT 1 FREEZE THE CPU STB A,I REPORT NEW CHAIN LENGTH ADA M1 STEP TO CHAIN'S TAIL POINTER LDB A,I FETCH LAST RECORD'S ADDRESS SSB NULL CHAIN? JMP *+4 NO FP TO MODIFY ADB M3 STEP TO ITS FORWARD POINTER CCA STA B,I SET TO DENOTE END-OF-CHAIN LDB FMPER RECALL BLOCK ADDRESS FROM STORAGE LDA B FETCH BLOCK ADDRESS ADA M1 STEP TO LENGTH WORD LDA A,I FETCH LENGTH OF RECORD JMP GETTL,I SKP SPC 1 * NAME:INSRC LEVEL:2 * SUBROUTINE TO POST THE INPUT DCB, * SAVE THE CURRENT LINE NO., AND OPEN * THE MERGE (OR HELP) FILE. * CALLING SEQUENCE: * JSB INSRC * ERROR ON OPEN RETURN HERE * GOOD OPEN RETURN HERE * ADDITIONAL ROUTINES: * POST * FMPER * OPEN * VARIABLES ON RETURN: * PLINE=LINE NO. BEFORE MERGE * DCBI=DCBI+16 * (INPUT FILE HEADER NOT CHANGED) * REGISTERS ON RETURN: * A:ERROR CODE ON OPEN * B:MEANINGLESS INSRC NOP DLD LINES SAVE CURRENT LINE NO. DST PLINE JSB POST CLEAR DCB DEF *+2 DEF DCBI,I JSB FMPER PRINT ANY ERRORS LDA DCBI SET TO MERGE DCB LOCATION ADA .16 TO NOT DESTROY INPUT DCB STA DCBI JSB OPEN OPEN HELP OR MERGE FILE DEF *+8 DEF DCBI,I DCB ADDRESS DEF RUBSH ERROR DEF FNAME FILE NAME | DEF ECHO DEF FSECR SECURITY DEF FCART CART. REF. DEF DCBSZ DCB SIZE SSA,RSS ISZ INSRC BUMP TO GOOD RETURN JMP INSRC,I * SKP * * NAME: INFIL * SUBROUTINE TO SET UP DEFAULT FILE NAME * FOR MERGE (M AND S COMMANDS) * CALLING SEQUENCE: * JSB INFIL * ADDITIONAL ROUTINES: * MVW * VARIABLES ON RETURN: * 'FCART' NAME BLOCK = 'NAMI' NAME BLOCK * BLOCK STRUCTURE: * 1-CARTRIDGE REF(+) OR LU(-) * 2-FIRST 2 CHARS OF FILE NAME * 3-THIRD & FOURTH CHARS OF NAME * 4-LAST 2 CHARS OF FILE NAME * 5-MSB=DEFAULT BIT, LSB=SCRATCH FILE BIT * 6-FILE SECURITY CODE * REGISTERS ON RETURN: * MEANINGLESS * INFIL NOP SET UP DEFAULT FILE NAME LDA NAMI ADA M1 STA NAM SET UP ADDRESS JSB MVW MOVE INPUT FILE NAME DEC 6 NAM NOP DEF FCART JMP INFIL,I SKP SPC 1 * NAME:LST LEVEL:2 * SUBROUTINE TO LIST A BUFFER ON * THE CURRENT LIST DEVICE. * CALLING SEQUENCE: * JSB LST * DEF BUFFER ADDRESS * DEF COUNT * ADDITIONAL ROUTINES: * WRITF * FMPER * DIRCT * EXEC * VARIABLES ON RETURN: * LSTB2:RECORD LENGTH * LSTB3:FIRST WORD OF BUFFER * REGISTERS ON RETURN: * A:MEANINGFwLESS * B:MEANINGLESS LST NOP LDB LST,I GET ADDRESS ISZ LST JSB DIRCT GET DIRECT ADDRESS ADB M1 BACK UP ONE STB LSTB1 LDB LST,I GET COUNT ISZ LST LDB B,I INB ADD ONE TO COUNT STB LSTB2 LDB LIST SSB JMP LST,I NO LIST DEVICE LDB LSTB1,I SAVE WORD PRECEDING MESSAGE STB LSTB3 LDB SPSP REPLACE WITH 2 SPACES STB LSTB1,I JSB WRITF PRINT MESSAGE DEF *+5 LDCB. NOP DCB OF LIST DEVICE DEF RUBSH ERROR LSTB1 NOP BUFFER ADDRESS DEF LSTB2 COUNT LDB LSTB3 STB LSTB1,I RESTORE WORD PRECEDING MESSAGE JSB FMPER PRINT ANY ERRORS JMP LST,I * LSTB2 NOP LSTB3 NOP SKP SPC 1 * NAME:LSTSB LEVEL:2 * SUBROUTINES TO LIST THE PENDING LINE * CALLING SEQUENCE: * JSB LSTSB * (OR) * JMP DISPL * (OR) * JMP EOFPR * ADDITIONAL ROUTINES: * LST * VARIABLES ON RETURN: * SAME * REGISTERS ON RETURN: * A:MEANINGLESS * B:MEANINGLESS LSTSB NOP LDB PLNG SSB,INB JMP EOFPR BRS CONVERT TO WORD COUNT STB MCH JSB LST PERFORM LIST DEF PBUFF,I DEF MCH JMP LSTSB,I * EOFPR JSB LST PRINT "EOF" AND FETCH NEXT COMMAND DEF EOF BUFFER ADDRESS DEF .2 WORD COUNT JMP NODE1 * NOP EOF ASC 2,EOF SKP * * NAME: M.T * SUBROUTINE TO EXCHANGE MBUFF AND TBUFF * BY SWAPPING POINTERS * CALLING SEQU6ENCE: * JSB M.T * ADDITIONAL ROUTINES: * NONE * VARIABLES ON RETURN: * CASE 1: (TBUFF EMPTY) * SAME * CASE 2: * M/TBUFF SWAPPED * MLNG=LENGTH OF NEW MATCH BUFFER * OCCNT=0 * * M.T NOP SWAP TBUFF AND MATCH BUFFER LDA OCCNT SZA,RSS JMP M.T,I TBUFF EMPTY - DO NOT SWAP STA MLNG CLA STA OCCNT LDA MBUFF LDB TBUFF STA TBUFF STB MBUFF JMP M.T,I SKP SPC 1 * NAME:MCH LEVEL:2 * SUBROUTINE TO RETURN NEXT FIND FIELD CHARACTER * IN LOWER BYTE OF A-REGISTER. ERROR RETURN IF * MBUFF IS EMPTY. * CALLING SEQUENCE: * JSB MCH * END OF VALID DATA RETURN HERE * CHARACTER FOUND RETURN HERE * ADDITIONAL ROUTINES: * CH * VARIABLES ON RETURN: * MCCNT:SAME * MCCNT:MCCNT+1 * REGISTERS ON RETURN: * CASE 1: * A:MCCNT BEFORE INCREMENT * B:UNCHANGED * CASE 2: * A:NEXT MATCH CHARACTER * B:UNCHANGED MCH NOP LDA MCCNT # CHARACTERS ALREADY READ CPA MLNG # CHARACTERS IN BUFFER JMP MCH,I END OF VALID DATA ISZ MCCNT ISZ MCH BUMP TO NORMAL RETURN CLE,ERA CONVERT TO WORDS ADA MBUFF ADD BASE ADDRESS JSB CH FETCH CHARACTER FROM BUFFER JMP MCH,I SKP SPC 1 * NAME:MVW LEVEL:2 * SUBROUTINE TO MOVE WORDSI*($ FROM ONE BUFFER * TO ANOTHER. * CALLING SEQUENCE: * JSB MVW * DEC #OF WORDS * DEF FROM ADDRESS * DEF TO ADDRESS * ADDITIONAL ROUTINES: * DIRCT * VARIABLES ON RETURN: * SAME * REGISTERS ON RETURN: * A:MEANINGLESS * B:MEANINGLESS MVW NOP LDA MVW,I FETCH PARM1 CMA,INA STA PCH SET AS COUNTER ISZ MVW STEP TO NEXT PARM LDB MVW,I FETCH POINTER TO STRING JSB DIRCT FETCH STRING ADDRESS STB DOUTP SAVE FOR MOVE POINTER ISZ MVW STEP TO PARM3 LDB MVW,I FETCH DEST ADDRESS JSB DIRCT MAKE SURE IT IS DIRECT ISZ MVW STEP TO RETURN ADDRESS LDA DOUTP,I FETCH A WORD STA B,I MOVE IT ISZ DOUTP STEP TO NEXT WORD INB ISZ PCH END OF STRING? JMP *-5 NO-CONTINUE JMP MVW,I YES RETURN * SKP SPC 1 * NAME:NLSLU LEVEL:2 * SUBROUTINE TO SET UP A NEW LIST UNIT * FOR THE LIST COMMAND. FETCHES PARAMETER * AND OPENS LIST DCB. * CALLING SEQUENCE: * JSB NLSLU * ADDITIONAL ROUTINES: * SC.CR * OPEN * FMPER * VARIABLES ON RETURN: * CASE 1: VALID OPEN * LIST POSITIVE * LDCB.=LIST DCB POINTER * CASE 2: OPEN ERROR * LDCB.=COMMAND INPUT DCB POINTER * REGISTERS ON RETURN: * A:MEANINGLESS * B:MEANINGLESS NLSLU NOP JSB SC.CR GET FILE NAME JMP NLSLU,I NO NAME ENTERED JSB OPEN DEF *+7 LDCB2 DEF IDCB9 DEF RUBSH ERROR CODE DEF FNAME NAME DEF ECHO DEF FSECR DEF FCART SSA JMP NOLST JSB WRITF WRITE ZERO-LENGTH RECORD DEF *+5 DEF IDCB9 DEF RUBSH DEF RUBSH DEF ZERO SSA JMP NOLST JSB RWNDF DEF *+2 DEF IDCB9 SSA JMP NOLST STA LIST SET LIST FLAG POSITIVE (DEVICE AVAIL.) LDA LDCB2 STA LDCB. JMP NLSLU,I * NOLST JSB FMPER PRINT ERROR JMP NODE1 SKP SPC 1 * NAME:NUMIN LEVEL:2 * SUBROUTINE TO RETURN A NUMERIC PARAMETER FROM * THE COMMAND BUFFER. CALLS ERROR IF ANY OTHER * TYPE IS ENCOUNTERED. * CALLING SEQUENCE: * JSB NUMIN * ADDITIONAL ROUTINES: * PARAM * VARIABLES ON RETURN: * NUM1:MEANINGLESS *  NUM10:MEANINGLESS * NEGFL:SET (0)-POSITIVE (1)-NEG OR ALPHA * COMND:MEANINGLESS * ECCNT:ECCNT+PARAMETER LENGTH * REGISTERS ON RETURN: * A:NUMBER IN BINARY OR MEANINGLESS * B:MEANINGLESS NUMIN NOP JSB PARAM FETCH NEXT INPUT PARAMETER JMP ER000 ALPHA OR NEGATIVE IS INVALID JMP NUMIN,I ELSE RETURN SKP SPC 1 * NAME:NXCHR LEVEL:2 * SUBROUTINE TO FETCH NEXT COMMAND CHARACTER IN * LOWER BYTE OF A-REGISTER. SKIPS ALL BLANKS. * ERROR RETURN IF EBUFF EMPTY, CHARACTER IS A * COMMA, CHARACTER IS A COLON, OR EBUFF * CONTAINS ONLY BLANKS. * CALLING SEQUENCE: * JSB NXCHR * DELIMITER OR END OF BUFFER RETURN HERE * CHARACTER FOUND RETURN HERE * ADDITIONAL ROUTINES: * ECH * VARIABLES ON RETURN: * CASE 1: * ECCNT:POSITIO OF NEXT COMMA OR COLON OR EO BUFFER * PART:PARAMETER SEPARATOR (COMMA IF END OF BUFFER) * CASE 2: * ECCNT:POSITION OF NEXT COMMAND CHARACTER * PART:NEXT COMMAND CHAR * REGISTERS ON RETURN: * CASE 1: * A:MEANINGLESS * B:UNCHANGED * CASE 2: * A:NEXT COMMAND CHARACTER * B:UNCHANGED NXCHR NOP LDA B54 STA PART FCR1 JSB ECH FETCH NEXT COMMAND CHAR. JMP NXCHR,I NO MORE CHARS.? RETURN CPA B40 IGNORE ALL JMP FCR1 SPACES STA PART SAVE TERMINATOR CPA B54 0IF EITHER A JMP NXCHR,I COMMA OR CPA ":" A COLON IS JMP NXCHR,I FOUND, RETURN ISZ NXCHR BUMP RETURN ADDRESS JMP NXCHR,I SPC 1 1 SKP SPC 1 * NAME:O/PSB LEVEL:2 * SUBROUTINE TO MOVE THE PENDING LINE TO THE * DESTINATION BUFFER PERFORMING ANY PATTERN * EXCHANGES THAT MAY BE REQUIRED AND LISTING * THESE EXCHANGES IF REQUESTED. * CALLING SEQUENCE: * JSB O/PSB * ADDITIONAL ROUTINES: * CXT * LSTSB * WRITE * VARIABLES ON RETURN: * SAME * REGISTERS ON RETURN: * A:MEANINGLESS * B:MEANINGLESS O/PSB NOP LDA PLNG IF EOF-NO PATTERNS SSA TO BE CHECKED OR JMP OPSB2 LINES TO BE DISPLAYED LDA EXFLG PATTERN REPLACEMENT SZA,RSS FLAG SET? JMP OPSB2 NO, MOVE CURRENT SOURCE LINE JSB CXT YES, PERFORM REPLACEMENT LDA MATCH LIST PATTERN SZA,RSS MATCH? JMP OPSB1 NO LDA LSTFG THIS PREVENTS DOUBLE LIST SZA,RSS WHEN PATTERN MATCH OCCURS JSB LSTSB LIST NEW LINE OPSB1 LDA PLNG IF RECORD HAS BEEN REDUCED SZA,RSS TO ZERO LENGTH, DON'T JMP O/PSB,I OUTPUT TO DEST. OPSB2 JSB WRITE CALL OUTPUT ROUTINE JMP O/PSB,I SKP * * NAME: OPENI / OPENO * SUBROUTINE TO OPEN THE INPUT/OUTPUT FILE. * CALLING SEQUENCE: * LDA POINTER TO FILE NAME * JSB OPENI / OPENO * ERROR ON OPEN RETURN HERE * GOOD OPEN RETURN HERE * ADDITIONAL ROUTINES: *  OPEN * VARIABLES ON RETURN: * NAMI: POINTER TO INPUT FILE * (NAMO: POINTER TO OUTPUT FILE) * REGISTERS ON RETURN: * A:OPEN ERROR CODE * B:GETFIL OPTION WORD TO GET * INPUT (OUTPUT) FILE NAME * OPENI NOP OPEN INPUT FILE STA NAMI ADA M1 STA CRI ADA .5 STA SECI JSB OPEN OPEN FILE DEF *+8 DEF DCBI,I DEF RUBSH DEF NAMI,I DEF ECHO SECI NOP CRI NOP DEF DCBSZ LDB INFL SSA,RSS ISZ OPENI JMP OPENI,I * SKP * OPENO NOP OPEN OUTPUT FILE STA NAMO ADA M1 STA CRO SAVE CART. REF. ADA .5 STA SECO SAVE SECURITY JSB OPEN DEF *+8 DEF DCBO,I DEF RUBSH DEF NAMO,I DEF ECHO SECO NOP CRO NOP DEF DCBSZ LDB SCR1 SSA,RSS ISZ OPENO JMP OPENO,I * SKP SPC 1 * NAME:OUTCR LEVEL:2 * SUBROUTINE TO STORE CHARACTER IN LOWER BYTE * OF A-REGISTER INTO TBUFF. BLANKS LOWER * BYTE OF WORD IN TBUFF IF A-REGISTER IS TO * BE STORED IN HIGH BYTE. ERROR RETURN IF * TBUFF IS FULL. * CALLING SEQUENCE: * LOAD A-REGISTER * JSB OUTCR * TBUFF FULL-CHARACTER STORED RETURN HERE * ADDITIONAL ROUTINES: * NONE * VARIABLES ON RETURN: * CASE 1: * OCCNT:UNCHANGED * CASE 2: * OCCNT:OCCNT+1 * REGISTERS ON RETURN: * CASE 1: * A:UNCHA<NGED * B:OCCNT BEFORE INCREMENT * CASE 2: * A:WORD STORED * B:ADDRESS WHERE WORD WAS STORED OUTCR NOP LDB OCCNT # CHARACTERS ALREADY IN BUFFER CPB .150 MAX ALLOWED IN BUFFER JMP OUTCR,I BUFFER ALREADY FULL CLE,ERB CONVERT TO WORDS ADB TBUFF ADD BASE ADDRESS SEZ,RSS MOVE CHARACTER TO PROPER BYTE ALF,SLA,ALF FOR INSERTION XOR B,I IF LOW BYTE, OR-TIE HIGH BYTE FROM BUFFER XOR B40 FORCE LOWER BYTE TO SPACE IF NOT PROVIDED STA B,I MOVE CREATED WORD TO BUFFER ISZ OCCNT BUMP COUNTER JMP OUTCR,I SKP SPC 1 * NAME:PARAM LEVEL:2 * SUBROUTINE TO FETCH ONE-WORD PARAMETERS * FROM COMMAND BUFFER (SEPERATED BY COMMAS OR * COLONS) AND RETURN VALUE IN A-REGISTER. * NUMERIC PARAMETERS ARE CONVERTED TO BINARY. * ASCII PARAMETERS HAVE TWO CHARACTERS * PACKED IN THE A-REGISTER. * CALLING SEQUENCE: * JSB PARAM * NEGATIVE OR ASCII RETURN HERE * NUMERIC RETURN HERE * ADDITIONAL ROUTINES: * NXCHR * ASCII * VARIABLES ON RETURN: * NUM1:MEANINGLESS * NUM10:MEANINGLESS * NEGFL:SET (0)-POSITIVE (1)-NEG OR ALPHA * COMND:MEANINGLESS * ECCNT:ECCNT+PARAMETER LENGTH * REGISTERS ON RETURN: * CASE 1: * A:2-CHAR PACKED PARM OR ABSOLUTE VALUE * B:MEANINGLESS * CASE 2: * A:NUMBER IN BINARY * B:MEANINGLESS PARAM NOP CLB RESET STB NUM1 NUMBER STB NUM10 ACCUMULATORS STB NEGFL AND NEGATIVE FLAG JSB NXCHR FETCH FIRST CHAR JMP ENDPR NULL PARAM, END JSB ASCII IF CHARACTER IS NON-NUMERIC JMP CHAR GO TO ASCII PARAM. ROUTINE NUMN1 ADA NUM10 ADD NUMBER TO PREVIOUS TOTAL SSA OVERFLOW ENCOUNTERED JMP ER001 YES, ER001 IN PARAM. STA NUM1 SAVE NEW TOTAL MPY .10 COMPUTE NEXT PARTIAL SUM SZB,RSS IF OVERFLOW FROM SSA MULTIPY, SET PARTIAL TO VALUE WHICH LDA M10 WILL CAUSE OVERFLOW WITH NEXT CHAR. STA NUM10 SAVE PARTIAL SUM PARM1 JSB NXCHR FETCH NEXT CHARACTER JMP ENDPR LAST CHAR.? GO TO END JSB ASCII ASCII TO NUMERIC JMP ER001 NON-NUMERIC, GO TO ER001!!! JMP NUMN1 GO TO TOTALIZE SPC 1 1 ENDPR LDA NUM1 LOAD TOTAL LDB NEGFL IF NEGATIVE SZB FLAG IS SET CMA,INA,RSS COMPLEMENT TOTAL, SKIP ISZ ISZ PARAM BUMP ADDRESS FOR POS. NUMBER JMP PARAM,I RETURN SPC 1 1 CHAR ISZ NEGFL BUMP NEGATIVE FLAG LDA COMND FETCH FIRST CHARACTER CPA MINUS IF MINUS SIGN JMP PARM1 COMPUTE NUMBER ALF,ALF LEFT JUSTIFY IOR B40 BLANK FILL STA NUM1 AND SAVE JSB NXCHR FETCH NEXT CHARACTER JMP ENDCR LAST CHARACTER RETURN XOR NUM1 INSERT LAST CHARACTER XOR B40 IN LOWER BYTE OF PARAM STA NUM1 AND SAVE JSB NXCHR SEARCH FOR RSS NEXT DELIMITER JMP *-2 OR END ENDCR LDA NUM1 LOAD PARAMETER JMP PARAM,I AND RETURN SKP SPC 1 * NAME:PASS1 LEVEL:2 * SUBROUTINE TO OPEN SCRATCH FILE 2 AND * CLEAR ANY PREVIOUS DATA. * L& CALLING SEQUENCE * JSB PASS1 * OPEN/WRITE ERROR RETURN HERE * GOOD OPEN RETURN HERE * ADDITIONAL ROUTINES * OPENI * WRITF * RWNDI * VARIABLES ON RETURN: * SAME * REGISTERS ON RETURN: * CASE 1: * A:ERROR CODE * B:GETFIL CODE TO GET SCRATCH FILE * CASE 2: * A:0 * B:MEANINGLESS PASS1 NOP LDA SFP2 *!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! JSB OPENI OPEN SECOND SCRATCH FILE JMP P1F2 ERROR JSB WRITF WRITE END OF FILE DEF *+5 DEF DCBI,I DEF RUBSH DEF RUBSH DEF M1 P1F2 LDB SCR2 SSA JMP PASS1,I ISZ PASS1 JSB RWNDI REWIND INPUT FILE JMP PASS1,I * * SKP SPC 1 * NAME:PCH LEVEL:2 * SUBROUTINE TO FETCH NEXT SOURCE CHARACTER * ERROR RETURN IF NONE LEFT. CHARACTER IN * LOWER BYTE OF A-REGISTER. * CALLING SEQUENCE: * JSB PCH * ERROR RETURN HERE * NORMAL RETURN HERE * ADDITIONAL ROUTINES: * NONE * VARIABLES ON RETURN: * CASE 1: * PCCNT:UNCHANGED * CASE 2: * PCCNT:PCCNT+1 * REGISTERS ON RETURN: * CASE 1: * A:MEANINGLESS * B:UNCHANGED * CASE 2: * A:NEXT CHAR FROM PENDING LINE * B:UNCHANGED PCH NOP 0.* ENTER WITH CHARACTER COUNT IN LDA PCCNT PCCNT AND SOURCE BUFFER START CPA PLNG ADDRESS IN PBUFF. JMP PCH,I ISZ PCCNT IF AT END OF SOURCE RECORD, ISZ PCH EXIT TO P+1. CLE,ERA ADA PBUFF IF NOT AT END OF SOURCE RECORD, JSB CH FETCH CHARACTER FROM BUFFER JMP PCH,I / 0 SKP SPC 1 * NAME:PURG LEVEL:2 * SUBROUTINE TO PURGE SCRATCH 1. * NO ACTION IF OPERATOR ENTERED FILE NAME. * CALLING SEQUENCE: * JSB PURG--TO PURGE SCRATCH 1 * JSB PURGO-TO PURGE SCRATCH 2 * ADDITIONAL ROUTINES: * PURGE * FMPER * VARIABLES ON EXIT: * SAME * REGISTERS ON EXIT: * A:MEANINGLESS * B:MEANINGLESS PURG NOP LDA SF1+4 SSA,SLA,RSS JMP PURG,I PERMANENT FILE, DO NOT PURGE *!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! JSB PURGE ! PURGE THE INPUT FILE DEF PER1 ! DEF DCBI,I ! DEF RUBSH ! DEF SF1+1 ! DEF SF1+5 ! DEF SF1 ! *!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! PER1 JSB FMPER PRINT ANY ERRORS JMP PURG,I * PURGO NOP LDA SF2+4 SSA,SLA,RSS JMP PURGO,I PERMANENT FILE, DO NOT PURGE *!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! JSB PURGE ! PURGE THE OUTPUT SCRATCH FILE DEF PER2 ! DEF DCBO,I ! DEF RUBSH ! DEF SF2+1 ! DEF SF2+5 ! DEF SF2 ! *!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! PER2 JSB FMPER PRINT ANY ERRORS JMP PURGO,I RETURN SKP SPC 1 * NAME:PUTTL LEVEL:2 * SUBROUTINE TO APPEND A RECORD ONTO THE TAIL * OF ONE OF THE MEMORY MANAGER CHAINS. * CALLING SEQUENCE: * JSB PUTTL * DEF TAIL POINTER FOR THIS CHAIN * DEF ADDRESS OF RECORD BUFFER §* DEF ADDRESS OF RECORD LENGTH * ADDITIONAL ROUTINES: * NONE * VARIABLES ON RETURN: * CHAIN POINTERS FEFLECT NEW TAIL AND LENGTH * REGISTERS ON RETURN: * A:MEANINGLESS * B:MEANINGLESS PUTTL NOP LDA PUTTL,I FETCH TAIL POINTER'S ADDRESS ISZ PUTTL STEP TO "NEW" RECORD'S ADDRESS LDB A,I FETCH ADDRESS OF "LAST" RECORD IN CHAIN STA ./R$ SAVE TAIL POINTER ADDRESS FOR LATER SSB,RSS NULL CHAIN DETECTED? JMP PUT1 NO-SKIP NULL CHAIN PROCESS LDB PUTTL,I FETCH "NEW" RECORD'S ADDRESS ISZ PUTTL STEP TO LENGTH ADDRESS LDB B,I STB A,I MAKE TAIL POINT TO IT ADA M1 STEP TO HEAD POINTER FOR THIS CHAIN STB A,I MAKE HEAD POINT TO IT ALSO ADA .2 STEP TO CHAIN LENGTH OF THE CHAIN STB PURG SAVE "NEW" RECORD'S ADDRESS CLB,INB STB A,I SET CHAIN LENGTH TO ONE RECORD CCA LDB PURG RECALL "NEW" RECORD'S ADDRESS ADB M3 STEP TO "NEW" RECORD'S FORWARD POINTER STA B,I SET TO DENOTE LAST RECORD IN CHAIN INB STEP TO BACKWARD POINTER STA B,I SET TO DENOTE FIRST RECORD IN CHAIN LDA PUTTL,I FETCH ADDRESS OF RECORD LENGTH WORD LDA A,I FETCH LENGTH OF RECORD INB STEP TO LENGTH WORD IN BLOCK STA B,I MOVE LENGTH TO BLOCK JMP PUT2 SKIP APPEND CHAIN PROCESS PUT1 ADB M3 STEP TO "LAST" RECORD'S FORWARD POINTER LDA PUTTL,I FETCH ADDRESS OF "NEW" RECORD ISZ PUTTL STEP TO LENGTH ADDRESS PARM LDA A,I STA B,I DENOTE "NEW" RECORD FOLLOWS "LAST" RECORD IN CHAIN ADB .3 STEP TO "LAST" RECORD'S DATA ADDRESS ADA M2 STEP TO "NEW" RECORD'S BACKWARD POINTER STB A,I DEiNOTE "LAST" RECORD IS BEFORE "NEW" * RECORD IN CHAIN CCB ADA M1 STEP TO "NEW" RECORD'S FORWARD POINTER STB A,I DENOTE "NEW" RECORD IS END-OF-CHAIN LDB PUTTL,I FETCH ADDRESS OF LENGTH LDB B,I FETCH RECORD LENGTH ADA .2 STEP TO "NEW" RECORD'S LENGTH WORD STB A,I MOVE RECORD LENGTH TO CHAIN INA STEP TO "NEW" RECORD'S DATA ADDRESS LDB ./R$ FETCH ADDRESS OF CHAIN'S TAIL POINTER STA B,I MAKE TAIL POINT TO "NEW" RECORD INB STEP TO LENGTH OF THIS CHAIN LDA B,I FETCH CHAIN LENGTH INA INCREMENT STA B,I AND RESTORE PUT2 ISZ PUTTL STEP TO RETURN ADDRESS JMP PUTTL,I SKP SPC 1 * NAME:PUTHD LEVEL:2 * SUBROUTINE TO PUSH A RECORD INTO THE FRONT * OF ONE OF THE MEMORY MANAGER CHAINS AND * ADJUST THE POINTERS ACCORDINGLY. * CALLING SEQUENCE: * JSB PUTHD * DEF HEAD POINTER FOR THE CHAIN * DEF ADDRESS OF THE RECORD TO BE PUT * DEF LENGTH OF THE RECORD TO BE PUT * ADDITIONAL ROUTINES: * NONE * VARIABLES ON RETURN: * CHAIN POINTERS:REFLECT NEW HEAD AND LENGTH * REGISTERS ON RETURN: * A:MEANINGLESS * B:MEANINGLESS PUTHD NOP LDA PUTHD,I FETCH HEAD POINTER'S ADDRESS ISZ PUTHD STEP TO "NEW" RECORD'S ADDRESS LDB A,I FETCH ADDRESS OF "FIRST" RECORD IN CHAIN STA ./R$ SAVE HEAD POINTER ADDRESS FOR LATER SSB,RSS NULL CHAIN DETECTED? JMP PUT3 NO-SKIP NULL CHAIN PROCESS LDB PUTHD,I FETCH "NEW" RECORD'S ADDRESS ISZ PUTHD STEP TO LENGTH ADDRESS LDB B, I STB A,I MAKE HEAD POINT TO IT INA STEP TO TAIL POINTER FOR THIS CHAIN STB A,I MAKE TAIL POINT TO IT ALSO INA STEP TO CHAIN LENGTH OF THE CHAIN STB PURG SAVE "NEW" RECORD'S ADDRESS CLB,INB STB A,I SET CHAIN LENGTH TO ONE RECORD CCA LDB PURG RECALL "NEW" RECORD'S ADDRESS ADB M3 STEP TO "NEW" RECORD'S FORWARD POINTER STA B,I SET TO DENOTE LAST RECORD IN CHAIN INB STEP TO BACKWARD POINTER STA B,I SET TO DENOTE FIRST RECORD IN CHAIN LDA PUTHD,I FETCH ADDRESS OF RECORD LENGTH WORD LDA A,I FETCH LENGTH OF RECORD INB STEP TO LENGTH WORD IN BLOCK STA B,I MOVE LENGTH TO BLOCK JMP PUT4 SKIP APPEND CHAIN PROCESS PUT3 ADB M2 STEP TO "FIRST" RECORD'S BACKWARD POINTER LDA PUTHD,I FETCH ADDRESS OF "NEW" RECORD ISZ PUTHD STEP TO LENGTH ADDRESS PARM LDA A,I STA B,I DENOTE "NEW" RECORD PRECEDES "FIRST" RECORD IN CHAIN ADB .2 STEP TO "FIRST" RECORD'S DATA ADDRESS ADA M3 STEP TO "NEW" RECORD'S FORWARD POINTER STB A,I DENOTE "FIRST" RECORD FOLLOWS "NEW" * RECORD IN CHAIN CCB INA STEP TO "NEW" RECORD'S BACKWARD POINTER STB A,I DENOTE "NEW" RECORD IS START-OF-CHAIN LDB PUTHD,I FETCH ADDRESS OF LENGTH LDB B,I FETCH RECORD LENGTH INA STEP TO "NEW" RECORD'S LENGTH WORD STB A,I MOVE RECORD LENGTH TO CHAIN INA STEP TO "NEW" RECORD'S DATA ADDRESS LDB ./R$ FETCH ADDRESS OF CHAIN'S HEAD POINTER STA B,I MAKE HEAD POINT TO "NEW" RECORD ADB .2 STEP TO LENGTH OF THIS CHAIN LDA B,I FETCH CHAIN LENGTH INA INCREMENT STA B,I AND RESTORE PUT4 ISZ PUTHD STEP TO RETURN ADDRESS JMP PUTHD,I SKP SPC 1 * NAME:RD LEVEL:2 * SUBROUTINE TO READ A RECORD FROM THE * CURRENT INPUT FILE AND STORE IT IN * THE PENDING LINE BUFFER. RECORD CHARACTER * COUNT RETURNED IN THE A-REGISTER. * CALLING SEQUENCE: * JSB READ * ADDITIONAL ROUTINES: * READF * FMPB * VARIABLES ON RETURN: * PLNG:LENGTH OF NEW RECORD * (-1 IF END OF FILE) * PCCNT:ZERO * REGISTERS ON RETURN: * A:RECORD LENGTH IN CHARACTERS * B:MEANINGLESS RD NOP *!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! JSB READF ! DEF *+6 ! DEF DCBI,I ! READ DEF RUBSH ! SOURCE DEF PBUFF,I ! RECORD DEF .75 ! DEF PLNG ! *!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! CPA M12 RSS END OF FILE JSB FMPER PRINT ANY OTHER ERRORS CCB SSA STB PLNG SET LINE LENGTH TO -1 CLB STB PCCNT CLEAR CHARACTER COUNT LDA PLNG SSA JMP RD,I END OF FILE ISZ LINES ONE MORE LINE READ RSS ISZ LINEM DOUBLE PRECISION ALR CONVERT COUNT TO CHARS STA PLNG JMP RD,I SKP SPC 1 * NAME:READ LEVEL:2 * SUBROUTINE TO FETCH THE NEXT SOURCE RECORD. * RECORD RETURNED IN BUFFER POINTED TO BY * PBUFF. LENGTH IN PLNG AND A-REG. * CALLING SEQUENCE: * JSB READ * ADDITIONAL ROUTINES: * GETHD * PUTTL * RD * VARAIBLES ON RETURN: * LINES/M:+1 * REGISTERS ON RETURN: * A:LENGTH OF RECORD READ * B:MEANINGLESS READ NOP JSB PUTTL PUT PRESENT PL BUFFER INTO A-CHAIN DEF ATAIL DEF PBUFF DEF RUBSH CLA RESET SOURCE CHARACTER COUNTER STA PCCNT STA INFIL CLEAR ERROR FLAG JSB GETHD TRY TO FETCH NEXT RECORD FROM SHP DEF SHEAD SOURCE CHAIN JMP *+4 RECORD NOT IN CHAIN GO READ STB PBUFF MOVE RECORD TO PENDING LINE STA PLNG MOVE LENGTH TO PENDING LINE JMP READ,I JSB GETHD FETCH A BLOCK FROM AV MEM CHAIN AHP DEF AHEAD HLT 2 NO MEM AVAILABLE STB PBUFF MOVE BLOCK ADRESS TO PL ADDRESS JSB RD FILL PBUFF FROM PERIPHERAL DEVICE JMP READ,I * * READE NOP READ AND CHECK FOR END OF FILE JSB READ READ NEXT RECORD SSA JMP EOFPR END OF FILE - PRINT MESSAGE JMP READE,I * SKP SPC 1 * NAME:RWNDI LEVEL:2 * SUBROUTINE TO REWIND THE CURRENT INPUT FILE * AND RESET THE CURRENT LINE COUNTER TO ZERO. * CALLING SEQUENCE: * JSB RWNDI * ADDITIONAL ROUTINES: * RWNDF * FMPER * VARIABLES ON RETURN: * LINES/M:ZERO * REGISTERS ON RETURN: * A:ZERO * B:MEANINGLESS RWNDI NOP *!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! JSB RWNDF ! REWIND DEF *+2 ! THE INPUT DEF DCBI,I ! FILE *!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! JSB FMPER PRINT ERRORS IF ANY CLA RESET THE LINE COUNTER*($ STA LINES STA LINEM JMP RWNDI,I SKP SPC 1 * NAME:RWNDO LEVEL:2 * SUBROUTINE TO REWIND THE CURRENT * OUTPUT FILE. * CALLING SEQUENCE: * JSB RWNDO * ADDITIONAL ROUTINES: * RWNDF * FMPER * VARIABLES ON RETURN: * T#REC/M:ZERO * T#WDS/+1:ZERO * REGISTERS ON RETURN: * A:MEANINGLESS * B:MEANINGLESS RWNDO NOP *!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! JSB RWNDF ! DEF *+2 ! DEF DCBO,I ! *!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! JSB FMPER PRINT ERRORS IF ANY CLA RESET DESTINATION FILE RECORD COUNTERS STA T#REC STA T#REM STA T#WDS STA T#WDS+1 RC JSB GETHD EMPTY ANY OUTPUT RECORDS DEF DHEAD JMP RWNDO,I NONE STB PURG SAVE ADDRESS OF BUFFER JSB PUTTL MOVE TO AVAILABLE MEMORY DEF ATAIL DEF PURG DEF RUBSH JMP RC CONTINUE q* SKP SPC 1 * NAME:SC.CR LEVEL:2 * SUBROUTINE TO MOVE FILE NAME TO 'FNAME' * BUFFER AND SET UP SECURITY CODE AND CARTRIDGE * NUMBER FOR MERGE FILE INPUT, LIST FILE CHANGES, * AND FINAL OUTPUT. SKIPS ALL BLANKS IN SEARCH * FOR FILE NAME IN COMMAND BUFFER. ERROR RETURN * IF COMMAND BUFFER CONTAINS ONLY BLANKS. * SECURITY CODE STORED IN "FSECR" * CARTRIDGE NUMBER STORED IN "FCART" * CALLING SEQUENCE: * JSB SC.CR * BLANK RETURN HERE * FILENAME RETURN HERE * ADDITIONAL ROUTINES: * NXCHR * ASCII * NUMIN * MVW * OUTCR * PARAM * VARIABLES ON RETURN: * ECCNT:+LENGTH OF NAME:SC:CR * OCCNT:+LENGTH OF NAME * REGISTERS ON RETURN: * A:MEANINGLESS * B:MEANINGLESS SC.CR NOP CLA STA FSECR STA FCART LDA ECCNT SAVE COMMAND BUFFER POSITION STA STAT JSB NXCHR FETCH FIRST CHARACTER OF NAME JMP SC.CR,I NONE, SO RETURN ISZ SC.CR NAME GIVEN SO BUMP RETURN ADRS JSB ASCII CHECK FOR DIGIT OR CHAR JMP ONAME-2 CHAR JSB NXCHR GET SECOND CHAR JMP LU NONE, LU ENTERED JSB ASCII DIGIT? JMP ONAME-2 NO LU LDA STAT STA ECCNT RESTORE INPUT CHARACTER COUNTER JSB NUMIN INPUT NUMERIC PARAMETER STA RWNDO AND B77 CPA RWNDO ERROR IF >63 SZA,RSS OR ZERO JMP ER001 CLB,INB STB OCCNT CLB SET UP DIVIDE JSB DEC CONVERT LU TO ASCII DLD LU.. DST TBUFF,I JMP ONAM2 * LDA STAT STA ECCNT RESTORE COMMAND CHAR COUNT ONAME JSB NXCHR FETCH NEXT CHAR. JMP *+3 JSB OUTCR SAVE IT JMP ONAME LDA M5 SPACE STA TR FILL ONAM1 LDA B40 NAME JSB OUTCR ISZ TR JMP ONAM1 ONAM2 JSB MVW MOVE NAME TO FNAME DEC 3 DEF TBUFF,I DEF FNAME LDB PART CHECK PARAMETER TERMINATOR CPB B54 JMP SC.CR,I NO SUBPARAMETERS JSB PARAM FETCH NOP SECURITY CODE STA FSECR AND SAVE. LDB PART CHECK PARAMETER TERMINATOR CPB B54 JMP SC.CR,I NO MORE SUBPARAMETERS JSB PARAM FETCH NOP CARTRIDGE NUMBER STA FCART AND SAVE. JMP SC.CR,I * LU.. ASC 2,LU.. * SKP * * NAME: STAT * SUBROUTINE TO DISPLAY STATUS OF EDIT: * N=CURRENT LINE NO. IN INPUT FILE * ^=BACKUP LIMIT FOR '^' COMMAND * W=NO. OF WORDS IN OUTPUT FILE * C=NO. OF CHARS IN PENDING LINE * CALLING SEQUENCE: * JSB STAT * ADDITIONAL ROUTINES: * OUTCR * DEC * LST * VARIABLES ON RETURN: * SAME * REGISTERS ON RETURN: * MEANINGLESS * STAT NOP OUTPUT STATUS OF EDIT CLA STA OCCNT RESET CHARACTER COUNT LDA B40 JSB OUTCR OUTPUT SPACE LDA "N" JSB OUTCR OUTPUT N LDA "=" JSB OUTCR OUTPUT = DLD LINES JSB DEC CONVERT LINE NUMBER TO ASCII LDA B40 JSB OUTCR OUTPUT SPACE LDA "^" JSB OUTCR OUTPUT ^ |LDA "=" JSB OUTCR OUTPUT = CLB LDA DLENG JSB DEC CONVERT BACKUP LIMIT TO ASCII LDA OCCNT INA ARS CONVERT CHARACTER COUNT TO WORDS STA OCCNT JSB LST PRINT LINE DEF TBUFF,I DEF OCCNT * CLA RESET TBUFF TO ACCEPT THE NEXT LINE OF OUTPUT STA OCCNT LDA B40 JSB OUTCR OUTPUT SPACE LDA "W" JSB OUTCR OUTPUT W LDA "=" JSB OUTCR OUTPUT = DLD T#WDS FETCH THE # WORDS IN THE DEST. FILE JSB DEC CONVERT TO AN ASCII STRING IN TBUFF LDA B40 JSB OUTCR OUTPUT SPACE LDA "C" JSB OUTCR OUTPUT C LDA "=" JSB OUTCR OUTPUT = CLB CLEAR MOST SIGNIFICANT BITS OF NUMBER LDA PLNG LOAD # CHARACTERS IN PENDING LINE SSA IF EOF, THEN PRINT "0" CLA JSB DEC CONVERT TO A CHARACTER STRING IN TBUFF LDA OCCNT INA ARS CONVERT TO WORDS STA OCCNT JSB LST PRINT THE LINE DEF TBUFF,I DEF OCCNT JMP STAT,I * SPC 1 1 SKP SPC 1 * NAME:SWPET LEVEL:2 * SUBROUTINE TO EXCHANGE TBUFF AND EBUFF BY * SWAPPING BUFFER POINTERS. * CALLING SEQUENCE: * JSB SWPET * ADDITIONAL ROUTINES: * NONE * VARIABLES ON RETURN: * TBUFF:POINTS TO NEW TERM OUTPUT BUFFER * EBUFF:POINTS TO NEW COMMAND BUFFER * OCCNT:ZERO * ELNG:LENGTH OF NEW COMMAND BUFFER * ECCNT:ZERO * REGISTERS ON RETURN: * A:LENGTH OF NEW COMMAND BUFFER * B:ZERO SWPET NOP LDA TBUFF SWAP LDB EBUFF ( EBUFF STA EBUFF AND STB TBUFF TBUFF LDA OCCNT STORE OUTPUT CHARACTER STA ELNG LENGTH IN COMMAND LENGTH CLB RESET COMMAND STB ECCNT AND OUTPUT STB OCCNT CHARACTER POINTERS JMP SWPET,I SPC 1 1 SKP SPC 1 * NAME:TAB LEVEL:2 * SUBROUTINE TO SCAN TEXT LINE IN COMMAND BUFFER (EBUFF) * MOVING IT TO THE TERMINAL OUTPUT BUFFER (TBUFF) * REPLACING TAB CHARACTERS WITH THE CORRECT NUMBER * OF TAB FILLER CHARACTERS (USUALLY SPACES) AND * COUNTING THE NON-CONTROL CHARACTERS. * CALLING SEQUENCE: * JSB TAB * ADDITIONAL ROUTINES: * ECH * OUTCR * VARIABLES ON RETURN: * OCCNT:#CHARACTERS IN EXPANDED LINE * ECCNT:MEANINGLESS * TBPNT:MEANINGLESS * REGISTERS ON RETURN: * A:MEANINGLESS * B:MEANINGLESS TAB NOP CLA RESET OUTPUT STA OCCNT CHARACTER COUNTER AND STA SWPET NON-CONTROL CHARACTER COUNTER LDA TABUF RESET STA TBPNT TAB POINTER TAB1 JSB ECH GET NEXT COMMAND CHARACTER JMP TAB,I END OF COMMAND CPA TABCR TAB CHARACTER ? JMP TBFND YES, GO TO TAB FOUND CPA INDE2 ALTERNATE ESCAPE? LDA INDEF YES REPLACE WITH STD. ASCII. LDB A IS CHARACTER CMB CONTROL ADB B40 CHARACTER SSB IF YES DO NOT INCREMENT ISZ SWPET NON-CONTROL CHARACTER COUNTER JSB OUTCR NO, OUTPUT CHARACTER JMP TAB1 TBFND CCB SET SPACE COUNTER STB TR TO -1 LDB TBPNT,I TAB POINTER SZB,RSS  ZERO? JMP SPACE YES, OUTPUT SPACE ISZ TBPNT BUMP TAB POINTER ADDRESS ADB SWPET PAST SSB,RSS TAB? JMP TBFND+2 YES, GET NEXT TAB STB TR STORE SPACE COUNTER SPACE LDA TBFIL LOAD SPACE JSB OUTCR OUTPUT SPACE ISZ SWPET BUMP NON-CONTROL CHAR. CNTR. ISZ TR LAST SPACE? JMP SPACE NO, CONTINUE SPACING JMP TAB1 GET NEXT CHARACTER SKP SPC 1 * NAME:TR LEVEL:2 * SUBROUTINE TO CONTROL PENDING LINE MOVES TO THE * DESTINATION FILE OPTIONALLY LISTING LINE DURING * MOVE. FETCHES NEXT LINE AFTER MOVE. ALSO * CHECKS FOR OPERATOR INTERRUPTS. * CALLING SEQUENCE: * JSB TR * ADDITIONAL ROUTINES: * O/PSB * READ * LSTSB * VARIABLES ON RETURN: * P/TBUFF-MAY BE SWITCHED * REGISTERS ON RETURN: * A:LENGTH OF NEW LINE * B:MEANINGLESS TR NOP LDA PLNG IF AT SSA EOF, JMP EOFPR PRINT MESSAGE LDB LSTFG LIST CURRENT SZB RECORD? JSB LSTSB YES, PERFORM LIST LDB TRFLG TRANSFER RECORD TO SZB DESTINATION FILE? JSB O/PSB YES-OUTPUT RECORD JSB READE GET NEXT RECORD JMP TR,I SKP * NAME:TTYIP LEVEL:2 * SUBROUTINE TO PRINT PROMPT CHARACTER * RING BELL, INPUT COMMAND, AND RESET * CHARACTER COUNTERS. * CALLING SEQUENCE: * JSB TTYIP * ADDITIONAL ROUTINES: * WRITF * FMPER * READF *  ECH * VARIABLES ON RETURN: * ELNG:LENGTH OF NEW COMMAND BUFFER * ECCNT:ZERO * PCCNT:ZERO * OCCNT:ZERO * REGISTERS ON RETURN: * A:ZERO * B:MEANINGLESS TTYIP NOP (ALSO USED AS TEMPORARY) LDA TTY SSA INTERACTIVE INPUT DEVICE? JMP NOTY NO JSB WRITF PROMPT DEF *+5 DEF GDCB DEF RUBSH DEF / DEF LN -4 OR -3 FOR BELL OR NO BELL JSB FMPER PRINT ANY ERRORS NOTY LDB M150 LDA TYPE FILE TYPE SZA LDB .75 NOT TYPE 0 - USE WORD COUNT STB FMPER JSB READF READ A RECORD FROM COMMAND INPUT DEVICE DEF *+6 DEF GDCB DEF RUBSH EBUFF NOP DEF FMPER WORD/CHAR COUNT DEF ELNG ACTUAL TRANSMISSION JSB FMPER PRINT ANY ERRORS LDA ELNG SSA,RSS SZA,RSS JMP ER001 ERROR IF END OF FILE OR ZERO LENGTH LDB TYPE SZB ALS IF NOT TYPE ZERO, CONVERT COUNT TO CHAR COUNT STA ELNG CLA STA ECCNT CLEAR COMMAND CHAR COUNTER JSB ECH SCAN COMMAND FOR TERMINATOR CHAR JMP NOTER NONE CPA TERM RSS TERMINATOR FOUND JMP *-4 CONTINUE SCAN LDA ECCNT ADA M1 BACK UP ONE STA ELNG SET COMMAND LENGTH NOTER CLA RESET STA ECCNT ALL STA PCCNT CHARACTER STA OCCNT COUNTERS JMP TTYIP,I SKP SPC 1 * NAME:WRITE LEVEL:2 * SUBROUTINE TO WRITE THE PENDING LINE * TO THE DESTINATION CHAIN AND KEEP * TRACK OF THE NUMBER OF RECORDS AND WORDS IN THE * DESTINATION FILE. * CALLING SEQU3*($ENCE: * JSB WRITE * ADDITIONAL ROUTINES: * PUTTL * DOUTP * GETHD * VARIABLES ON RETURN: * T#WDS:+#WORDS IN RECORD * T#REC/M:+1 * REGISTERS ON RETURN: * A:MEANINGLESS * B:MEANINGLESS WRITE NOP LDB PLNG FETCH NUMBER OF CHARACTERS IN LINE SSB DON'T ADD LENGTH OF EOF REC TO JMP WRIT1 #WDS IN DEST FILE INB CLE,BRS CONVERT TO WORDS LDA B CMA,INA ADA MAXOP CLE,SSA IF GREATER THAN MAX ALLOWED LDB MAXOP USE MAX STB TTYIP DLD T#WDS UPDATE # OF WORDS IN DEST CHAIN/FILE ADA TTYIP SEZ INB DST T#WDS LDB TTYIP BLS CONVERT TO CHARACTERS WRIT1 STB TTYIP JSB PUTTL APPEND PENDING LINE TO TAIL DEF DTAIL OF DESTINATION CHAIN DEF PBUFF DEF TTYIP LENGTH ISZ T#REC UPDATE # RECORDS IN DEST CHAIN/FILE RSS ISZ T#REM JSB GETHD REPLACE PENDING LINE B UFFER FROM FREE SPACE DEF AHEAD JMP *+3 STB PBUFF JMP WRITE,I JSB DOUTP MAKE ROOM BY MOVING OUT OLDEST RECORD JMP *-6 HLT 2 ALL RECORDS ARE LOST /* SKP SPC 1 * NAME:XCH LEVEL:2 * SUBROUTINE TO FETCH THE NEXT CHARACTER FROM * THE SEARCH STRING.(STRING TO BE REPLACED * BY THE STRING IN THE Y-HALF OF THE XYBUF). * CALLING SEQUENCE: * JSB XCH * END OF VALID DATA RETURN HERE * CHARACTER FOUND RETURN HERE * ADDITIONAL ROUTINES: * NONE * VARIABLES ON RETURN: * XCCNT:SAME * XCCNT:XCCNT+1 * REGISTERS ON RETURN: * CASE 1: * A:MEANINGLESS * B:UNCHANGED * CASE 2: * A:NEXT SEARCH CHARACTER * B:UNCHANGED XCH NOP LDA XCCNT # CHARACTERS ALREADY READ CPA XLNG # CHARACTERS IN BUFFER JMP XCH,I END OF VALID DATA ISZ XCCNT ISZ XCH BUMP TO NORMAL RETURN INA BUMP TO CHARACTER WANTED CLE,ERA CONVERT TO WORD COUNT ADA XYBUF ADD BASE ADDRESS JSB CH FETCH CHARACTER FROM BUFFER JMP XCH,I RETURN SKP SPC 1 * NAME:YCH LEVEL:2 * SUBROUTINE TO FETCH THE NEXT CHARACTER * FROM THE REPLACEMENT STRING. * CALLING SEQUENCE: * JSB YCH * END OF VALID DATA RETEUN HERE * CHARACTER FOUND RETURN HERE * ADDITIONAL ROUTINES: * NONE * VARIABLES ON RETURN: * YCCNT:SAME * YCCNT:YCCNT+1 * REGISTERS ON RETURN: * CASE 1: * A:MEANINGLESS * B:UNCHANGED * CASE 2: * A:NEXT REPLACEMENT CHARACTER * B:UNCHANGED YCH NOP LDA YCCNT # CHARACTERS ALREADY READ CPA YLNG # CHARACTERS IN BUFFER JMP YCH,I END OF VALID DATA ISZ YCCNT ISZ YCH BUMP TO NORMAL RETURN ADA YOFFS BUMP TO CHARACTER WANTED CLE,ERA CONVERT TO WORDS ADA XYBUF ADD BASE ADDRESS JSB CH FETCH CHARACTER FROM BUFFER JMP YCH,I RETURN SKP SPC 1 EXT CREAT,READF,WRITF,OPEN,CLOSE,PURGE,RWNDF EXT EXEC,RMPAR,LIMEM,IMESS,GTFIL,IFTTY EXT NAMF,IDCB9,GDCB,POST "!" OCT 41 "#" OCT 43 "$" OCT 44 "/" OCT 57 ":" OCT 72 PARAMETER SEPERATOR::ALTERNATE FOR COMMA ";" OCT 73 TAB CHARACTER "=" OCT 75 "=." OCT 36400 "?" OCT 77 "?." OCT 37400 "@" OCT 100 "A" OCT 101 "B" OCT 102 "C" OCT 103 "D" OCT 104 "E" OCT 105 "F" OCT 106 "G" OCT 107 "I" OCT 111 "K" OCT 113 "L" OCT 114 "M" OCT 115 "N" OCT 116 "O" OCT 117 "P" OCT 120 "R" OCT 122 "S" OCT 123 "T" OCT 124 "U" OCT 125 "V" OCT 126 "W" OCT 127 "X" OCT 130 "Y" OCT 131 "Z" OCT 132 "]" OCT 135 "^" OCT 136 %C OCT 3 SIGNAL TO TRUNCATE LINE %G OCT 7 BELL (CONTROL G) %I OCT 11 SIGNAL TO INSERT CHARACTERS %R OCT 22 SIGNAL TO REPLACE CHARACTERS %S OCT 23 SIGNAL TO INSERT CHARACTERS %T OCT 24 SIGNAL TO TRUNCATE THE LINE .1 DEC 1 .10 DEC 10 FOR DEFAULT LINE # INSERT::ASCII-DEC CONVERTION .100 DEC 100 FOR CONVERTING BINARY TO ASCII .1000 DEC 1000 FOR CONVERTING BINARY TO ASCII .10K DEC 10000 FOR CONVERTING BINARY TO ASCII .128 DEC 128 .15 DEC 15 .150 DEC 150 .152 DEC 152 .16 DEC 16 SIZE OF DCB CONSTANTS SECTION .2 DEC 2 CONSTANT .23 DEC 23 .234 DEC 234 CONSTANT .26 DEC 26 .3 EQU %C CONSTANT .4 DEC 4 CONSTANT FOR EXEC CALLS .5 DEC 5 CONSTANT .6 DEC 6 .64 EQU "@" .7 EQU %G .75 EQU "K" MAX LINE LENGTH .77 EQU "M" CONSTANT FOR CHAIN INITIALIZATION .78 EQU "N" CONSTANT FOR CHAIN INITIALIZATION .9 EQU %I / OCT 6457,0 "CR / BELL _" A EQU 0 A-REGISTER AHEAD BSS 1 HEAD POINTER FOR AVAILABLE MEMORY CHAIN ATAIL BSS 1 TAIL POINTER FOR AVAILABLE MEMORY CHAIN ALENG BSS 1 LENGTH OF AVAILABLE MEMORY CHAIN ALFIL OCT 102401 GTFIL OPTION WORD (ALL FILES) B EQU 1 B-REGISTER B133 OCT 133 CONSTANT FOR CONVERSION TO/FROM CAPS B1640 OCT 16400 B200 OCT 200 B3537 OCT 3537 "BELL - _" B40 OCT 40 B54 OCT 54 "," THE PARAMETER SEPERATOR B60 OCT 60 CONSTANT TO CONVERT OCTAL DIGIT TO ASCII B600 OCT 600 B77 EQU "?" BASE BSS 1 ALSO USED FOR JDEF$ BLOKS BSS 1 SIZE OF DEST. FILE IN BLOCKS BWIND BSS 1 WINDOW BIAS COMND BSS 1 ALSO TEMP TO STORE NAME COUNT BSS 1 LINE NUMBER COUNTER DCBI BSS 1 ADDRESS OF THE DCB DCBO BSS 1 ADDRESS OF THE DCB DCBSZ BSS 1 HOLDER FOR SIZE OF THE DCB DHEAD BSS 1 HEAD POINTER TO DESTINATION CHAIN DTAIL BSS 1 TAIL POINTER TO DESTINATION CHAIN DLENG BSS 1 LENGTH OF DESTINATION CHAIN DLMTR BSS 1 DEFAULT DELIMITER IS "/" ELNG BSS 1 ACTUAL LENGTH OF COMMAND BSS 3 BUFFER TO ALLOW FOR CHAINING EBUF0 BSS 75 EBUFP DEF EBUF0 ECCNT BSS 1 ECHO OCT 410 ECHO BITS FOR TELETYPE ENLN BSS 1 LAST LINE TO MERGE EXFLG BSS 1 DETECTS EXCHANGE TYPE COMMANDS FCART BSS 1 FILE CARTRIDGE REFERENCE NUMBER FNAME BSS 4 FILE NAME FSECR BSS 1 FILE SECURITY CODE FCHAR BSS 1 FIRST CHARACTER OF PATERN FOR MATCHING HLPNM NOP HELP FILE CART. REF. ASC 3,&MHELP HELP FILE NAME NOP NOP HELP FILE SECURITY CODE IDEF$ BSS 1 FIRST CHAR AFTER INDEF FLAG INCR EQU IDEF$ INDE2 BSS 1 ALTERNATE ESCAPE CHAR. INDEF OCT 33 INDEFINITE CHAR. IS ESCAPE. INFL OCT 100001 GTFIL OPTION WORD (INPUT FILE) INPP DEF INPUT+1 INPUT OCT 1 ASC 3,INPUT NOP NOP JDEF$ EQU BASE INDEFINITE PROCESSING FLAG KEY BSS 1 KEY FOR ?-COMMAND FILE SEARCH LBYTE OCT 377 LOWER BYTE MASK LINES BSS 1 LINE COUNTER LINEM BSS 1 LINE CTR MOST SIG BITS LIST BSS 1 FLAG - LIST DEVICE AVAILABLE IF ZERO LN BSS 1 (-)3 OR (-)4 CHARS FOR PROMPT LSTFG BSS 1 M1 DEC -1 CONSTANT M10 DEC -10 COUNTER FOR TABS:: ASCII-DEC CONVERTION M11 DEC -11 COMPARISON FOR FMGR -011 ERROR M12 DEC -12 CONSTANT FOR FMGR-012 ERROR M14 DEC -14 M150 DEC -150 M151 DEC -151 M156 DEC -156 CONSTANT FOR CHAIN INITIALIZATION M16 DEC -16 LENGTH OF DCB CONSTANTS SECTION M17 DEC -17 M2 DEC -2 CONSTANT M20 DEC -20 M3 DEC -3 CONSTANT M4 DEC -4 LENGTH OF TTY PROMPT MESSAGE M5 DEC -5 COUNTER TO APPEND SPACES TO FILENAME M58 DEC -58 TEST ASCII CHAR TO BE DECIMAL DIGIT M6 OCT -6 CONSTANT M7 DEC -7 M72 DEC -72 COUNTER FOR CHARACTER MOVES M78 DEC -78 CONSTANT FOR CHAIN INITIALIZATION MATCH BSS 1 ALSO * MATCH IS A FLAG USED FOR PTTERN RECOGNITION MAXOP BSS 1 OUTPUT MAX WORD COUNT (ALWAYS POS.) MLNG BSS 1 NUMBER OF CHARACTERS ACTUALLY IN MATCH BUFFER BSS 3 BUFFER TO ALLOW FOR CHAINING MBUF0 BSS 75 ONE OF THE HOLDING BUFFERS MBUFF BSS 1 CHANGES POINTS TO CURRENT MATCH BUFFER MBUFP DEF MBUF0 MCCN$ BSS 1 INPUT PATTERN LOCATION FOR INDEF SEARCH MCCNT BSS 1 POSITION IN THE MATCH BUFFER MINUS OCT 55 FOR COMMAND RECOGNITION N140 OCT -140 N33 OCT -33 CONSTANT FOR CONVERSION TO/FROM CAPS NAMI BSS 1 ADDRESS OF THE FILE NAME NAMO BSS 1 ADDRESS OF THE FILE NAME (OUTPUT FILE) * NEGFL EQU MATCH NOSCR OCT 105001 GETFIL OPTION WORD - DEFAULT SCRATCH NUM1 BSS 1 ALSO * NUM1 AND NUM10 ARE USED AS ACCUMULATORS FOT ASCII- * DECIMAL CONVERSION * T1 AND T2 ARE USED FOR PATTERN MATCHING NUM10 BSS 1 ALSO OPT BSS 1 OPTION BITS FOR GTFIL PART BSS 1 PARAMETER TERMINATOR PASS BSS 1 PASS COUNT BSS 3 SPACE FOR CHAIN HEADERS PBUF0 BSS 75 ONE OF THE HOLDING BUFFERS PBUFF BSS 1 CHANGES-POINTS TO THE PENDING LINE BUFFER PBUFP DEF PBUF0 PLINE BSS 2 PENDING LINE NUMBER PLNG BSS 1 LENGTH OF PENDING LINE PCCN$ BSS 1 HOLDER FOR CURRENT SOURCE POSITION PCCNT BSS 1 NUMBER OF CHARACTERS READ FROM PENDING PLUSS OCT 53 FOR COMMAND RECOGNITION PMODE BSS 1 KEEPS TRACK OF WHICH MODE EDITT IS IN RUBSH BSS 1 ANYTHING I DON'T WANT GOES HERE SAVL BSS 1 SAVE PARAMETER FOLLOWING /E SCR1 OCT 100400 GTFIL OPTION WORD (SCRATCH 1) SCR2 OCT 102000 GTFIL OPTION WORD (SCRATCH 2) SDLM BSS 1 DELIMITER FOR S-COMMAND SF1 NOP ASC 3,SF1 NOP NOP SF2 NOP ASC 3,SF2 NOP NOP SFP1 DEF SF1+1 POINTER TO SCRATCH FILE NAME SFP2 DEF SF2+1 POINTER TO SCRATCH FILE NAME SHEAD BSS 1 HEAD POINTER TO SOURCE CHAIN STAIL BSS 1 TAIL POINTER TO SOURCE CHAIN SLENG BSS 1 LENGTH OF SOURCE CHAIN STLN BSS 1 FIRST LINE FOR MERGE SPSP ASC 1, FOR OUTPUTTING SPACES TO THE LIST DEVICE T#WDS BSS 1 CURRENT # OF CHARACTERS IN DEST. FILE BSS 1 MOST SIGNIFICANT BITS FOR >65K T#REC BSS 1 CURRENT # OF REC IN DEST FILE T#REM BSS 1 MOST SIG BITS FOR >65K T1 EQU NUM1 T2 EQU NUM10 TAB0 BSS 11 ARRAY OF TAB STO[$"PS TABCR BSS 1 DEFAULT TAB CHARACTER = ";" TABUF DEF TAB0 POINTER TO THE TAB SETTINGS BUFFER TBFIL BSS 1 FILL CHARACTER FOR WHEN TAB IS USED TBPNT BSS 1 INDEX TO WHICH TAB SETTING BSS 3 SPACE FOR CHAIN HEADERS TBUF0 BSS 75 TBUFF BSS 1 CHANGES POINTS TO CURRENT CONSOLE TERM BSS 1 COMMAND INPUT LINE TERMINATOR TTY BSS 1 FLAG - INTERACTIVE COMMAND INPUT DEVICE IF 0 TYPE BSS 1 COMMAND INPUT FILE TYPE OCCNT BSS 1 NUMBER OF CHARACTERS ACTUALLY IN TBUFF TBUFP DEF TBUF0 TRFLG BSS 1 TTYLU BSS 5 PARAMETERS FROM 'ON' OR 'RU' UNCON BSS 1 WIND1 BSS 1 STARTING COLUMN OF THE WINDOW::DEFAULT=0 WIND2 BSS 1 END COLUMN OF THE WINDOW::DEFAULT=150 WINDF BSS 1 WINDOW FLAG XCCNT BSS 1 INDEX WITHIN SEARCH PATTERN XLIST BSS 1 LIST FLAG FOR EXCHANGE XLNG BSS 1 LENGTH OF SEARCH PATTERN BSS 3 XYBF0 BSS 75 EXCHANGE BUFFER * * * XYBUF BSS 1 CHANGES. POINTS TO CURRENT EXCHANGE XYBFP DEF XYBF0 * BUFFER YCCNT BSS 1 INDEX WITHIN REPLACEMENT PATTERN YLNG BSS 1 LENGTH OF THE REPLACEMENT PATTERN YOFFS BSS 1 START POSITION OF THE REPLACEMENT PATTERN %@ EQU * ZERO-LENGTH-LINE CONSTANT ZERO OCT 0 CONSTANT SIZE EQU *-1 SIZE OF THE EDITR END EDITM t$ T+ 92064-18126 1650 S C0122 &MHELP RTE-M EDITOR HELP FILE             H0101 9* * THIS FILE MUST BE STORED ON A MOUNTED DISC * TO ENABLE THE "?" COMMAND OF THE PROGRAM 'EDITM'. * * NAME : &MHELP * SOURCE: 92064-18126 * RELOC : NONE * PROGMR: H.L.CLAWSON * REV. : 1650 761214 * * **************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT * * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * **************************************************************** * * ?, COMMAND/ERROR SUMMARY ?, ?,A-ABORT T-SET TABS 0-INVALID PARAMETER ?,B-SEARCH FROM START U-EXCHANGE IN WINDOW 1-INVALID COMMAND ?,C-EDIT PL V-SAME AS "U" W/LIST 2-COMMAND FILE NOT FOUND ?,D-DELETE TO PATTERN W-SET WINDOW 3-FILE TOO LARGE ?,E-EXIT EDITM X-SAME AS "Z" W/LIST 4-DELIMITER MISSING ?,F-FIND PATTERN Y-EXCHANGE & FIND 5-NO ROOM ?,G-EXCHANGE IN PL Z-ENABLE EXCHANGE 6-PARAMETER MISSING ?,I-INSERT BEFORE PL #-ADD LINE NUMBERS 7-DISC FULL ?,K-TRAILING BLANKS +-ADVANCE N LINES ?,L-LIST N LINES /-ADVANCE N LINES ?,M-MERGE FILE --DELETE N LINES ?,N-LIST STATUS -INSERT AFTER PL ?,O-COPY & EDIT PL ^-BACK UP N LINES ?,P-EDIT PL !-LIST FILE NAMES ?,R-REPLACE PL $-LIST SPECIAL CHARS ?,S-SEARCH AND MERGE =-SET LINE LENGTH 'PL': PENDING LINE ?, ?,? FOLLOWED BY ANY CHARACTER LISTS MORE DETAILS. ?, ?ATHE "A" COMMAND CAUSES THE EDITOR TO ABORT. TEMPORARY ?ASCRATCH FILES ARE PURGED. ORIGINAL FILE UNCHANGED. ?A ?BTHE "B" COMMAND ROLLS OVER THE FILE, DISABLES ANY EXCHANGE ?BOPTION SET UP, AND THEN SEARCHES FOR THE FIND FIELD, ?BMOVING LINES TO THE DESTINATION FILE AS IT GOES. ?BIF THE FIND FIELD IS NOT FOUND, THE SEARCH ENDS AT THE EOF. ?B ?CTHE "C" COMMAND EDITS THE PENDING LINE, *DISPLAYS THE RESULTS ?CON THE CONSOLE, PASSES THE EDITED LINE TO THE DESTINATION FILE, ?CAND DISPLAYS THE NEXT LINE AS THE NEW PENDING LINE. ?C ?DTHE "D" COMMAND DELETES THE PENDING LINE AND ALL LINES DOWN ?DTO THE LINE CONTAINING THE FIND FIELD. IF THE FIND FIELD ?DIS NOT LOCATED, THE REMAINDER OF THE FILE IS DELETED. ?DTHE "M" OR "S" COMMAND CAN BE USED TO RECOVER FROM AN ?DACCIDENTAL DELETE. ?D ?ETHE END COMMANDS TERMINATE THE EDITOR AND PLACE ?ETHE EDIT FILE IN THE FILESPACE NAMED. ?E "EC" CREATES A NEW FILE. ?E "ER" REPLACES AN EXISTING FILE. ?E "EN" RENAMES THE DESTINATION SCRATCH FILE. ?E ?FTHE "F" COMMAND SEARCHES FROM THE PENDING LINE DOWN UNTIL ?FTHE FIND FIELD IS LOCATED, MOVING LINES TO THE DESTINATION ?FFILE AS IT GOES. IF NOT FOUND, THE SEARCH HALTS AT THE EOF. ?F SUBFUNCTIONS: ?F "ESCAPE"(OR ALTERNATE) -FIND FIELD MAY OCCUR ANYWHERE IN LINE ?F "/"(DELIMITER) -FIND FIELD MAY OCCUR ANYWHERE IN WINDOW ?F "CNTRL-@" -ZERO LENGTH LINE ?F ""(NULL) -PREVIOUS FIND FIELD IS USED ?F ?GTHE "G" COMMAND PERFORMS AN IMMEDIATE EXCHANGE ON THE ?GPENDING LINE AND LEAVES IT AS THE PENDING LINE. ?G ?G"CNTRL-G" TURNS THE BELL OFF (OR BACK ON AGAIN). ?G ?ITHE "I" COMMAND INSERTS TEXT BEFORE THE PENDING LINE. ?IIF NO TEXT IS GIVEN, THE NEW LINE WILL HAVE LENGTH ZERO. ?I ?KTHE "K" COMMAND DELETES ALL TRAILING BLANK WORDS FROM THE TEXT. ?K ?LTHE "L" COMMAND LISTS THE NEXT N LINES ON THE LIST DEVICE. ?L ?MTHE "M" COMMAND MERGES THE CONTENTS OF THE NAMED FILE ?MAFTER THE PENDING LINE AND BEFORE THE NEXT LINE. ?MPARTIAL FILES MAY BE MERGED BY SPECIFYING FIRST AND LAST LINES. ?MTHIS COMMAND CAN BE USED TO RECOVER FROM AN ACCIDENTAL DELETE. ?M ?NTHE "N" COMMAND LISTS THE FOLLOWING INFORMATION: ?N N-LINE NUMBER OF PENDING LINE ?N ^-BACKUP LIMIT FOR "^" COMMAND ?N W-NUMBER OF WORDS IN DESTINATION FILE ?N C-NUMBER OF CHARACTERS IN PENDING LINE ?N ?NA DECIMAL NUMBER CAUSES LINE NNN TO BE DISPLAYED. Y?N ?OTHE "O" COMMAND PLACES THE PENDING LINE IN THE DESTINATION ?OFILE, THEN PERFORMS A "P" COMMAND ON A COPY OF THAT LINE. ?O ?PTHE "P" COMMAND ENTERED BY ITSELF CAUSES THE PENDING LINE ?PTO BE DISPLAYED ON THE CONSOLE. ?PTHE "P" COMMAND EDITS THE PENDING LINE, DISPLAYS THE RESULTS ?POF THE EDIT, AND LEAVES THE ALTERED LINE AS THE PENDING LINE. ?P SUBFUNCTIONS: ?P "CNTRL-R" REPLACE CHARACTERS ?P "CNTRL-I" INSERT CHARACTERS ?P "CNTRL-S" INSERT CHARACTERS ?P "CNTRL-T" TRUNCATE REMAINDER OF LINE ?P ?RTHE "R" COMMAND REPLACES THE PENDING LINE WITH TEXT. ?R ?STHE "S" COMMAND MERGES A SEGMENT OF THE NAMED FILE ?SFROM START FIELD TO END FIELD AFTER THE PENDING LINE. ?SIF THE START FIELD IS NOT FOUND, NO LINES ARE MERGED. ?SIF THE END FIELD IS NOT FOUND, ALL LINES AFTER THE ?SSTART FIELD ARE MERGED. ?STHIS COMMAND CAN BE USED TO RECOVER FROM AN ACCIDENTAL DELETE. ?S ?TTHE "T" COMMAND CHANGES THE TAB CHARACTER AND SETS ?TTHE TAB STOPS. ?T ?UTHE "U" COMMAND SETS UP AN UNCONDITIONAL EXCHANGE OF THE ?UFIRST N CHARACTERS OF THE CURRENT WINDOW FOR THE NEW DATA. ?UTHE NEXT COMMAND DETERMINES THE RANGE. ?UCHANGED LINES ARE NOT LISTED. ?U ?VTHE "V" COMMAND SETS UP AN UNCONDITIONAL EXCHANGE OF THE ?VFIRST N CHARACTERS OF THE CURRENT WINDOW FOR THE NEW DATA. ?VTHE NEXT COMMAND DETERMINES THE RANGE. ?VCHANGED LINES ARE DISPLAYED ON THE LIST DEVICE. ?V ?WTHE "W" COMMAND CHANGES THE WINDOW BOUNDARIES. ?WTHE FIRST CHARACTER OF THE FIND FIELD OR EXCHANGE ?WPATTERN MUST BE WITHIN THE WINDOW. ?W ?XTHE "X" COMMAND ENABLES THE EXCHANGE OF OLD DATA FOR NEW DATA. ?XOLD DATA MUST START WITHIN THE WINDOW BOUNDARIES. THE NEXT ?XCOMMAND DETERMINES THE RANGE. CHANGED LINES ARE LISTED. ?X ?YTHE "Y" COMMAND ENABLES THE EXCHANGE OF OLD DATA FOR NEW DATA ?YIN THE PENDING LINE, THEN FINDS THE NEXT OCCURRANCE OF OLD ?YDATA. OLD DATA MUST START WITHIN THE WINDOW BOUNDARIES. ?Y ?ZTHE "Z" COMMAND ENABLES THE EXCHANGE OF OLD DATA FOR NEW DATA. ?ZOLD DATA MUST START WITHIN THE WINDOW BOUNDARIES. THE NEXT ?ZCOMMAND DETERMINES THE RANGE. CHANGED LINES ARE NOT LISTED. ?Z ?#THE "#" COMMAND ADDS A THREE CHARACTER LABEL AND SEQUENCE ?#NUMBERS IN COLUMNS 73-80. ?# ?=THE "=" COMMAND CHANGES THE MAXIMUM LENGTH OF OUTPUT LINES. ?=(2-150 CHARACTERS -- MUST BE EVEN) ?= ?+THE "+" COMMAND ADVANCES N LINES AND DISPLAYS THE NEW PENDING LINE ?+ ?/THE "/" COMMAND ADVANCES N LINES AND DISPLAYS THE NEW PENDING LINE ?/ ?-THE "-" COMMAND DELETES N LINES AND DISPLAYS THE NEXT. ?-THE "M" OR "S" COMMAND CAN BE USED TO RECOVER FROM AN ?-ACCIDENTAL DELETE. ?- ? THE " " COMMAND INSERTS TEXT AFTER THE PENDING LINE. ? ?^THE "^" COMMAND BACKS UP N LINES IN THE OUTPUT FILE. ?^INPUT AND OUTPUT FILES ARE EXCHANGED IF THE BACKUP LIMIT ?^IS EXCEDED. THE "N" COMMAND DISPLAYS THE BACKUP LIMIT. ?^ ?!THE "!" COMMAND LISTS THE NAMES OF THE FILE BEING EDITED ?!AND THE CURRENT SCRATCH FILES. ?! ?$THE "$" COMMAND WITHOUT PARAMETERS WILL DISPLAY FIVE ?$CURRENT SPECIAL CHARACTERS: ?$ T-TAB CHARACTER ?$ E-INDEFINATE FIND FIELD CHARACTER (ALTERNATE FOR ESCAPE) ?$ D-DELIMITER ?$ S-DELIMITER FOR "S" COMMAND ?$ L-LINE TERMINATOR FOR COMMAND INPUT ?$THE "$" COMMAND WITH T, E, D, S, OR L WILL CHANGE THAT CHARACTER. ?$ ?0EDITM 0-INVALID PARAMETER ?0-IN "=" COMMAND, ZERO (OR >150) IS NOT LEGAL ?0-IN MOST COMMANDS, NEGATIVE PARAMETERS ARE NOT VALID ?0-NON-NUMERIC CHARACTERS ARE NOT ?0 ALLOWED WITHIN NUMERIC FIELDS ?0-32,000 IS THE LARGEST NUMERIC PARAMETER ?0-NULL IS NOT A VALID FIRST ?0 PARAMETER FOR G, X, Y, OR Z ?0 ?1EDITM 1-INVALID COMMAND ?1-ONLY COMMANDS LISTED IN SUMMARY ARE VALID ?1-ONLY C, R, AND N ARE VALID AFTER "E" COMMAND ?1-CNTRL-D (EOF) IS NOT A VALID COMMAND. ?1 ?2EDITM 2-COMMAND FILE NOT FOUND ?2-'RU' STATEMENT WAS INCORRECT. ?2 ?3EDITM 3-FILE TOO LARGE ?3-THIS COMMAND REQUIRES LESS THAN 32000 RECORDS IN THE FILE. ?3 ?4EDITM 4-DELIMITER MISSING ?4-DELIMITER CHARACTER MUST SEPARATE FIELDS IN ?4 EXCHANGE COMMANDS. ?4-"S" DELIMITER M68UST SEPARATE FIELDS IN "S" COMMAND. ?4-COMMAS MUST SEPARATE PARAMETERS. ?4-COLONS (:) MUST SEPARATE SUBPARAMETERS IN FILE NAMES. ?4 ?5EDITM 5-NO ROOM ?5-MEMORY IS INSUFFICIENT FOR NECESSARY BUFFERS. ?5 ?6EDITM 6-PARAMETER MISSING ?6-NO VALUE ASSOCIATED WITH NAMED CHARACTER IN "$" COMMAND. ?6-FILENAME MUST BE SPECIFIED IN "EC" OR "EN" COMMAND. ?6 ?7EDITM 7-DISC FULL ?7-EDIT CANNOT CONTINUE WITHOUT MORE DISC SPACE. ?7 (FILE MANAGER ERROR -006) ?7-DIRECTORY FULL: EXTENT CANNOT BE CREATED ?7 (FILE MANAGER ERROR -014) ?7 6   92064-18127 1805 S C0422 &MAS00 RTE-M ASSEMBLER MAIN             H0104 ASMB,R HED ** RTE-M - ASMB MAIN ** * * * 10/21/76 * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * * NAME : ASMB * SOURCE: 92064-18127 * RELOC : 92064-16040 * PRGMR : C.H., H.C., S.K. * NAM ASMB,3,99 92064-16040 REV. 1805 771110 * * ********************************************* * * ASSEMBLER CONTROL STATEMENT OPTIONS * * * * * * A = ABSOLUTE ASSEMBLY * * * B = PUNCH BINARY OBJECT TAPE * * * C = SCHEDULE 'XREF' FOR XREF TABLE * * * F = FLOATING POINT HDWE. INSTRUCTIONS * * * L = LIST OUTPUT * * * N = ASSEMBLE STATEMENTS WITHIN 'IFN' * * * R = RELOCATABLE ASSEMBLY * * * T = LIST SYMBOL TABLE (END OF PASS 1) * * * X = NON-EAU INSTRUCTIONS * * * Z = ASSEMBLE STATEMENTS WITHIN 'IFZ' * * ********************************************* * SUP ENT ASMB * EXT ?HA3Z,?LITI,?AREC,?BREC,?ART,?LKLI * EXT ?CMQ,?ENP,?EXP,?INSR,?INS? ENT ?ASCN,?ASMB,?BNCN,?BPKU,?CHOP,?CHPI,?DCOD ENT ?ENDS,?ERPR,?MSYS,?GETC,?MOVE,?MSYM,?LWA ENT ?AFLG,?LSTL,?RFLG,?Z,?ASM1,?LABE ENT ?OKOL,?ORRP,?SETM,?SUP,?LPER,?PERL ENT ?LOUT,?LTFL,?LTSA,?LTSB,?ORGS,?CNTR ENT ?ASII,?ICSA,?FLGS,?LFLG,?TFLG ENT ?X,?MESX,?ASCI,?LINC,?LINS,?LIST ENT ?OPLK,?OPER,?PKUP,?PLIT,?PNCH,?PRNT,?RSTA ENT ?SEGM,?SYMK,?V,?ARTL,?LST,?PLIN,?PCOM ENT ?NEAU,?HA38,?XRFI,?FMPE,?POSN ENT ?FPT,?FP,?ENER,?PRPG ENT ?BPSV,?BASF,?GETA ENT ?NDOP,?NDSY,?SYML,?SYMT ENT AI,RTNXR,PRMXR,LSTLU,OUTLU,?FWA ENT B100,.M12 ENT AO ENT AL ENT DCBL ENT DCBI ENT DCBO ENT ?ERR ENT OPTNI ENT OPTNO ENT OPTNL ENT LENI * EXT RMPAR EXT .STOP EXT GTFIL EXT LIMEM EXT READF EXT WRITF EXT IMESS EXT SEGLD EXT FCONT EXT LOCF EXT OPEN EXT CLOSE EXT .PAUS EXT CREAT * COM TEMP(322B) ******************* * ****************************** * * OPCODE AND PSEUDO-OP TABLE * * ****************************** OPT OCT 40502,51421,0, 40504,40416,42001 ABS/ADA OCT 40504,41016,46001, 40514,43060,31700 ADB/ALF OCT 40514,51060,31400, 40514,51460,31000 ALR/ALS OCT 40516,42016,12001, 40522,51460,31100 AND/ARS OCT 40523,41407,0, 41114,43060,25700 ASC/BLF OCT 41114,51060,25400, 41114,51460,25000 BLR/BLS OCT 41122,51460,25100, 41123,51412,0 BRS/BSS OCT 41503,40461,53400, 41503,41061,47400 CCA/CCB OCT 41503,42463,42300, 41514,40461,52400 CCE/CLA OCT 41514,41061,46400, 41514,41450,106700 CLB/CLC OCT 41514,42463,0, 41514,43052,103100 CLE/CLF OCT 41515,40461,53000, 41514,47430,103101 CMA/CLO OCT 41515,41061,47000, 41515,42463,42200 CMB/CME OCT 41517,46403 COM DEF ?CMQ OCT 41520,40416,52001, 41520,41016,56001 CPA/CPB OCT 42105,41410,0, 42105,43020,0 DEC/DEF OCT 42105,54025,0, 41131,52043,0 DEX/BYT OCT 42514,40460,131600, 42516,52004 ELA/ENT DEF ?ENP OCT 42514,41060,125600, 42516,42014,0 ELB/END OCT 42522,40460,131500, 42521,52413,0 ERA/EQU OCT 42522,41060,125500, 42530,52005 ERB/EXT DEF ?EXP OCT 44114,52051,102000,46111,40450,102500 HLT/LIA  OCT 46111,41050,106500,46511,40450,102400 LIB/MIA SKP * ?FPT EQU * < FLOATING POINT SUBROUTINE/MACRO OPCODES > * OCT 43101,42006 FAD DEF ?HA38 OCT 43104,53006 FDV DEF ?HA38 OCT 43115,50006 FMP DEF ?HA38 OCT 43123,41006 FSB DEF ?HA38 * OCT 44516,40466,52004, 44516,41066,46004 INA/INB OCT 44517,51016,32001, 44523,55016,36000 IOR/ISZ OCT 45115,50016,26000, 45123,41016,16000 JMP/JSB OCT 46104,40416,62001, 46104,41016,66001 LDA/LDB OCT 46511,41050,106400, 47101,46415,0 MIB/NAM OCT 47117,50030,0, 47503,52011,0 NOP/OCT OCT 47524,40450,102600, 47522,43401 OTA/ORG DEF ORGP OCT 47524,41050,106600, 47522,51002 OTB/ORR DEF ORRP OCT 51101,46060,31200, 51101,51060,31300 RAL/RAR OCT 51102,46060,25200, 51102,51060,25300 RBL/RBR OCT 51120,46032,0 RPL OCT 51123,51470,42001, 51505,55062,42040 RSS/SEZ OCT 51506,41452,102200, 51506,51452,102300 SFC/SFS OCT 51514,40465,10010, 51514,41065,4010 SLA/SLB OCT 51517,41453,102201, 51517,51453,102301 SOC/SOS OCT 51523,40464,52020, 51523,41064,46020 SSA/SSB OCT 51524,40416,72000, 51524,41016,76000 STA/STB OCT 51524,41450,102700, 51524,43052,102100 STC/STF OCT 51524,47430,102101, 51532,40467,52002 STO/SZA OCT 51532,41067,46002, 54117,51016,22001 SZB/XOR OCT 47522,41000 ORB DEF ORBP OCT 46123,52024,0, 51513,50022,0 LST/SKP OCT 51525,50040,1, 44105,42017 SUP/HED DEF HEDSB OCT 52516,46024,1, 51105,50035 UNL/REP DEF REPSB OCT 52516,51440,0, 44506,47031,116 UNS/IFN OCT 54111,43031,0, 44506,55031,132 XIF/IFZ OCT 51520,41423,0, 46511,41500,0 SPC/MIC * SKP * * * * 21MX INSTRUCTION SET *` * * * OCT 41501,54030,101741, 41501,54430,101751 CAX/CAY OCT 41502,54030,105741, 41502,54430,105751 CBX/CBY OCT 54101,54030,101747, 54101,54430,101757 XAX/XAY OCT 54102,54030,105747, 54102,54430,105757 XBX/XBY OCT 44523,54030,105760, 44523,54430,105770 ISX/ISY OCT 42123,54030,105761, 42123,54430,105771 DSX/DSY OCT 46104,54110,105745, 46104,54510,105755 LDX/LDY OCT 45114,54511,105762, 45120,54513,105772 JLY/JPY OCT 46101,54111,101742, 46101,54511,101752 LAX/LAY OCT 46102,54111,105742, 46102,54511,105752 LBX/LBY OCT 51501,54111,101740, 51501,54511,101750 SAX/SAY OCT 51502,54111,105740, 51502,54511,105750 SBX/SBY OCT 51524,54111,105743, 51524,54511,105753 STX/STY OCT 40504,54110,105746, 40504,54510,105756 ADX/ADY OCT 41530,40430,101744, 41530,41030,105744 CXA/CXB OCT 41531,40430,101754, 41531,41030,105754 CYA/CYB OCT 46102,52030,105763, 51502,52030,105764 LBT/SBT OCT 51506,41030,105767, 52102,51515,105775 SFB/TBS OCT 51502,51515,105773, 41502,51515,105774 SBS/CBS OCT 41502,52114,105766, 46502,52114,105765 CBT/MBT OCT 46526,53514,105777, 41515,53514,105776 MVW/CMW OCT 42102,46041,0, 42102,51042,1 DBL/DBR * * * * * 21MX - MEU INSTRUCTIONS * * * * OCT 42112,50111,105732, 42112,51511,105733 DJP/DJS OCT 45122,51515,105715 JRS OCT 46106,40430,101727, 46106,41030,105727 LFA/LFB OCT 46502,43030,105703, 46502,44430,105702 MBF/MBI OCT 46502,53430,105704, 46527,43030,105706 MBW/MWF OCT 46527,44430,105705, 46527,53430,105707 MWI/MWW OCT 50101,40430,101712, 50101,41030,105712 PAA/PAB OCT 50102,40430,101713, 50102,41030,105713 PBA/PBB OCT 51123,40430,101730, 51123,41030,105730 RSA/RSB OCT 51126,40430,101731, 51126,41030,105731 RVA/RVB OCT 51512,50111,105734, 51512,51511,105735 SJP/SJS OCT 51523,46511,105714 SSM OCT 51531,40430,101710, 51531,41030,105710 SYA/SYB OCT 52512,50111,1057363, 52512,51511,105737 UJP/UJS OCT 52523,40430,101711, 52523,41030,105711 USA/USB OCT 54103,40511,101726, 54103,41111,105726 XCA/XCB OCT 54114,40511,101724, 54114,41111,105724 XLA/XLB OCT 54115,40430,101722, 54115,41030,105722 XMA/XMB OCT 54115,46430,105720, 54115,51430,105721 XMM/XMS OCT 54123,40511,101725, 54123,41111,105725 XSA/XSB * ?NEAU EQU * * START OF NON-EAU OPTABLE SWAP AREA * * OCT 42111,53026,100400, 42114,42026,104200 DIV/DLD OCT 42123,52026,104400, 46520,54426,100200 DST/MPY OCT 40523,46027,100020, 40523,51027,101020 ASL/ASR OCT 46123,46027,100040, 46123,51027,101040 LSL/LSR OCT 51122,46027,100100, 51122,51027,101100 RRL/RRR OCT 51527,50030,101100,51101,46451,105000 SWP/RAM * ?FP EQU * * OCT 0,54030,105100,43114,52030,105120 FIX/FLT OCT 0 ********* END OF OPCODE TABLE *********** SKP * ************************************* * * PUT OUT A MESSAGE TO THE OPERATOR * * ************************************* MESSX NOP STA MESS SET MESSAGE LOCN STB MESS+1 SET MESSAGE LENGTH JSB IMESS DEF *+4 DEF .2 OUTPUT ON SYSTEM TTY DEF MADDR MESSAGE ADDRESS DEF MSGLN MESSAGE LENGTH JMP MESSX,I EXIT SEGNM ASC 3,ASMB MADDR ASC 7, /ASMB: $END MESS ASC 2, MESSAGE EXTENSION MSGLN DEC 9 ?XRFI NOP CROSS REFERENCE INPUT FLAG. .X ASC 1,X * ******************************* * * GO TO LOAD THE NEXT SEGMENT * * ******************************* SEGMT STA SEGNM+2 SET CORRECT DIGIT (1,2,OR 3) JSB SEGLD DEF *+3 DEF SEGNM LOC'N OF 5 CHAR SEGM'T NAME DEF ?ERR ERROR CODE JSB ?FMPE ERROR-GO TO FILE MANAGER ERROR ROUTINE DEF SEGNM NAME OF SEGMENT SPC 1 * *********************** * * EXIT FROM ASSEMBLER * * *********************** ABORT LDA *+4 SET UP END MESSAGE FOR EOF ABORT LDB *+4 JSB MESSX GO PRINT KESSAGE JMP ASMEX GO TO COMPLETION ASC 2,XEND ASMBX LDA CFLAG SZA,RSS IS CROSS REF TABLE REQUESTED? JMP RTNXR NO LDA LINC1 GET CURRENT PAGE NUMBER. CMA,INA NEGATE FOR SIGNAL TO 'XREF'. STA PRMXR+1 SAVE: 'XREF' SCHED. PARAMETER. LDA PLINE GET THE NEGATED NO. LINES/PAGE. CMA,INA MAKE THE VALUE POSITIVE. STA PRMXR SAVE IT FOR 'XREF'. * JSB ?POSN POSITION SOURCE FILE TO THE BEGINNING * LDA .X JMP SEGMT LOAD XREF SEGMENT * RTNXR JSB CLOSE CLOSE INPUT FILE DEF *+3 DEF DCBI INPUT FILE DCB DEF ?ERR ERROR WORD SSA,RSS ERRORS? JMP EFLST NO, CLOSE LIST FILE JSB ?FMPE FMP ERROR ROUTINE DEF AI+1 INPUT FILE NAME * EFLST JSB FCONT WRITE AN EOF RECORD ON LIST FILE DEF *+4 DEF DCBL DEF ?ERR ERROR WORD DEF B100 SSA,RSS ERRORS? JMP CLLST NO CPA .M12 IS IT A -12 ERROR? JMP CLLST YES, THEN IGNORE IT JSB ?FMPE YES, DISPLAY ERROR AND ABORT ASMB DEF AL+1 LIST FILE NAME CLLST JSB CLOSE CLOSE LIST FILE DEF *+3 DEF DCBL LIST FILE DCB DEF ?ERR ERROR WORD SSA,RSS ERRORS? JMP ASMEX NO, EXIT ASMB JSB ?FMPE FMP ERROR MESSAGE DEF AL+1 LIST FILE NAME * JSB LIMEM RELEASE AVAILABLE MEMORY DEF *+2 DEF M1 * ASMEX LDA BLNS BLANK-OUT LDB BLNS MESSAGE EXTENSION, AND JSB MESSX PRINT: " /ASMB: $END " * * CLA JSB .STOP * .8 DEC 8 B100 OCT 100 PRMXR BSS 2 .M12 DEC -12 * SKP * ********************************************* * * OPLK: OPCODE! TABLE LOOKUP - WALDY HACCOU * * * CALLING SEQUENCE: L JSB OPLK,I * * * L+1 ERROR RETURN * * * L+2 NORMAL RETURN * * * OUTPUT VALUES: VALUE IN A REG. AND 'CODE'* * * INSTR.FORMAT IN B AND 'INST'* * ********************************************* DOPL DEF TEMP+5 DEF OPT LOC'N OF OPCODE TABLE OPLK NOP JSB BPKUP GET OPCODE POSN STB SCN1+1 CLA STA TEMP+6 CLEAR TEMP+6 STA MFLAG CLEAR SUPPLEMENTAL TABLE FLAG LDA 1 B REG TO A REG JSB GETA GET OPCODE ADDRESS STB *+4 LDA ...1+2 (3) LDB DOPL L(TEMP+5) JSB MOVE NOP MOVE ORIGIN HERE LDB DOPL+1 L(OPCODE TABLE) OPLGO LDA 1,I GET NEXT ENTRY INB CPA TEMP+5 CHECK 1ST 2 CHARS. JMP K J ADB ...1+1 (2) LDA 1,I SZA END OF TABLE? JMP OPLGO NO-PICK UP NEXT ENTRY LDA MFLAG YES- SZA REACHED END OF SUPPL. TABLE? JMP OPMIC YES-CHECK FOR 'MIC' LDB ?NDOP NO-SET POINTER TO TABLE STB MFLAG SET SUPPLEMENTAL TABLE FLAG CPB ?LWA ANY ENTRIES IN SUPPLEMENTAL TABLE? JMP OPMIC NO--INVALID OPCODE; CHECK 'MIC'. JMP OPLGO GO TO CHECK NEXT ENTRY OPMIC LDA CODE GET OPCODE I.D. NO. CPA B100 CODE =100B (MIC)? JMP OPLK,I YES-O.K., RETURN. * * * ERROR EXIT HERE * * LDA .OP 'OP' OPCODE ERROR JSB ERPR CLA FORCE A 'NOP' FOR STA INST INVALID OPCODE'S INSTRUCTION. JMP OPLK,I EXIT HERE ON 'OP' ERROR K LDA 1,I CHECK LAST CHAR OF OPCODE AND UMSK CPA TEMP+6 COMPARE IT JMP *+2 OPCODE FOUND ,SKIP JMP J NOT FOUND, TRY NEXT ENTRY LDA 1,I AND LMASK SET 'A' = UOPCODE TYPE INB LDB 1,I STB INST = INSTRUCTION FORMAT STA CODE = VALUE OF CODE ISZ OPLK JMP OPLK,I EXIT ALPHA+2 * * SKP * ****************************************************** * * EVALUATE OPERAND; TEST/PROCESS 'C' OR 'I' MODIFIER * * ****************************************************** * CLER DEF RELC START OF 5 WORD CLEAR AREA CHOP NOP * * * ON ENTRY A = MODIF.PARAMETER (I,C,0=NONE,2=ASC) * * * B= MASK NECESSARY FOR I OR C MODIFIER * * STA FLAG STB FLAQ SPC 1 * * CLEAR CHOP PARAMS IN T, RELC, SIGN, SUMP & TERM.. * LDA ...1+4 (5) LDB CLER START OF CLEAR AREA JSB SETM ZERO NOP TO SET MEMORY TO ZERO STA XORD INITIALIZE XORD =0. ISZ SIGN SET SIGN = + (+1=+,-1=-) LDA SCN1+2 OPER.POSN. STA PNTR SZA,RSS JMP HD22 ERROR**NO OPERAND * * * GET THE 1ST CHARACTER * JSB GETC CPA L+3 PLUS? JMP HD32+2 YES CPA L+5 MINUS? JMP HD32 YES JMP HD32+3 NO * * * PROCESS AN ASTERISK '*' * HD26 CLA,INA SET A=1 CPA SYMP IS THE '*' ALONE? RSS YES - GOOD JMP HD22 NO - IT'S AN ERROR ADA ?BASF SET A = CURRENT RELOCATION TYPE. LDB AFLAG GET ABS. ASSMBL. FLAG SZB IS THIS AN ABS. ASSEMBLY? CLA YES, CLEAR A(WILL BE RELOC. BIT) LDB PLCN PROG LOCN CNTR TO B REG STB SAVB SAVE PLCN VALUE-TEMPORARILY. JMP HD50A * * * CHOP LOOP PROCESSING HERE * HD30 LDA PEEK CPA L+4 TEST PEEK FOR A JMP HD36 COMMA, GO TO TEST MODIFIERS CPA BLNK JMP HD40 =BLNK CLB,INB SET 'SIGN' FOR + CPA L+3 PLUS? RSS YES * * * PROCESS SIGNS bHERE * HD32 CCB SET 'SIGN' FOR - STB SIGN (HD32+1) ISZ PNTR * * * PICK UP NEXT SET OF CHARS.IN BUFFER * JSB BPKUP GET POSN OF NXT NON-BLNK CHAR.HD32+3 STA PEEK STB PASCN SAVE PNTR FOR ASCN RTN JSB MSYMS MEAS.SYMBOL, SET SYMP/SYMN ADA PNTR STA PNTR * * * TEST FOR NUMERIC OR SYMBOLIC SET * LDA PEEK FIRST CHAR OF SET TO A FOR TESTING LDB TEST STB PEEK SAVE CHAR.FOR LATER TEST CPA L+2 ASTERISK? JMP HD26 TO '*' PROC ADA .M58 -58 SSA,RSS TEST FOR SYMBOLIC TERM JMP HD50 PROCESS THE SYMBOL ADA LPDG+3 (10) SSA JMP HD50 PROCESS THE SYMBOL * * * PROCESS NUMERIC SET HERE * LDB SYMP ADB ..M1 LDA LAST IS B LAST - CPA .B CHARACTER? JMP *+2 * * SET B REG FOR ASCN ROUTINE ADB .401B LDA PASCN JSB ASCN TO AXCII CONVERSION TO BINARY JMP CHOP,I ERROR EXIT FROM ASCII CONV. JMP HD61+1 A REG CONTAINS THE VALUE * * * TEST INFORMATION FOLLOWING COMMA, IF LEGAL * * -USES FLAG AND FLAQ * * -IF C OR I, SET CORRECT BIT IN INSTRUC. USING FLAQ AS MASK * HD36 LDB FLAG SZB,RSS IS COMMA LEGAL JMP HD37 -NO- ERROR CPB ...1+1 'ASC'? JMP HD40 -YES- ISZ PNTR POINT TO CHAR.FOLLOWING COMMA JSB BPKUP SEARCH FOR NON-BLANK JSB MSYM MEASURE SYMBOL CPA ...1 1 CHAR SYMBOL? JMP *+3 YES * * NO - ERROR HD37 JSB OPERR OPERAND ERROR JMP HD40 LDA TEST CPA BLNK BLANK TERMINATOR? JMP *+2 -YES- JMP HD37 -NO- ERROR LDA LAST CHAR TO A CPA FLAG =I/C? RSS YES, O.K. JMP HD37 ERROR: NOT 'I' OR 'C' MODIFIER! LDA INST IOR FLEAQ SET I OR C BIT STA INST LDA CODE CPA L+2 STF OR CLF? (52) JMP HD37 -YES- ERROR * * * CHOP TERMINATION PROCESSOR * * HD40 CLA INITIALIZE THE STA SIGN OFFSET FLAG TO ZERO. LDA RELC A=RELOCATION CODE LDB CODE B=INSTRUCTION I.D. SZA ABSOLUTE OPERAND? JMP RELOC NO, CHECK RELOCATABLE. HD40A LDA SUMP YES, GET OPERAND VALUE. SSA NEGATIVE? CPB .12+5 YES. IS IT ABS (21B)? JMP HD42 YES-OK- CPB .32B NO. IS IT RPL (32B)? JMP HD42 YES-OK- JMP HD22 NO. *ERROR* * * * VALUE IS RELOCATABLE, TEST FOR VALIDITY * * RELOC LDA T IS RELOC. NUMBER SZA CANCELLED? JMP HD40B NO. CHECK FOR LEGAL RELOC. STA RELC YES, SET RELOCATION CODE =0. JMP HD40A GO TO CHECK FOR NEGATIVE OPERAND. HD40B CPA ...1 LEGAL RELOC? (+1) RSS -YES- SKIP JMP HD22 NO,ERROR. CPB ...1 ORG? JMP E -YES * * * CHECK: EQU,END,ORG,DEF,HED,& I/O EXT * * ADB .M11 -11 SSB CODE <13B? JMP HD22 YES, ERROR ADB ..M1+5 -6 SSB CODE > 20B ? JMP E NO. CHECK FOR EXTERNAL. ADB .M27B YES. CODE LESS THAN SSB 50B ? JMP HD22 YES. ERROR: NOT I/O! ADB ..M1+2 CODE GREATER THAN SSB,RSS 52B ? JMP HD22 YES. ERROR: NOT I/O! CLB FORCE ERROR IF NON-EXT I/O. E LDA RELC GET RELOC. CODE. CPA ...1+3 EXTERNAL ? JMP HD41 YES. CHECK VALIDITY. LDA SUMP GET VALUE OF OPERAND. SSA,RSS ERROR, IF NEGATIVE. SZB,RSS RELOC. VALID FOR THIS OPCODE? JMP HD22 NO. * 'M' ERROR * JMP HD42 VALID RELOC. GO TO FINISH. * * {X* TEST FOR EXT W/OFFSET; SET SIGN & OFFSET VALUE * * HD41 LDA TERM GET NUMBER OF OPERAND TERMS. CPA .1 SINGLE EXTERNAL REFERENCE ? JMP HD42 YES, NO MORE CHECKING NEEDED. ADB .1+5 (6) TEST FOR EQU. SZB,RSS EQU TO EXTERNAL, WITH OFFSET ? JMP HD22 YES, *ERROR* LDA SUMP GET COMBINED OPERAND VALUE. LDB XORD GET EXTERNAL ORDINAL NUMBER. STB SIGN SET OFFSET FLAG = EXT ORDINAL #. CMB,INB NEGATE ORDINAL VALUE. ADA B SUBTRACT EXTERNAL ORDINAL VALUE. STA SUMP SAVE OFFSET VALUE. * * * NORMAL EXIT FROM CHOP, HERE * * HD42 LDA RELC RELOCATION CODE IN (A) AND LDB SUMP SUM IN (B) ON EXIT. ISZ CHOP JMP CHOP,I EXIT ALPHA+2 * * *CHOP ERROR EXIT* * HD22 LDA .MBLN 'M' FOR M TERM ERROR JSB ERPR ERROR PRINT CLA CLEAR THE STA SIGN OFFSET FLAG. JMP CHOP,I EXIT ALPHA+1 * * * PROCESS SYMBOLIC TERM HERE * * HD50 JSB SYMK GO TO SYMBOL TABLE LOOKUP JMP HD6 ERR0R STB SAVB SAVE VALUE FOUND IN B. LDB FLEX GET FIRST WORD OF SYMBOL ENTRY. SSB IS THIS AN UNDEFINED 'ENT' ? JMP HD6 YES * ERROR * HD50A AND .1+6 TYPE MASK SZA,RSS RELOCATABLE TYPE? JMP HD61 NO, ABSOLUTE. * SKP * * * TEST FOR EXTERNAL EQU (RELC=5) * CPA ...1+4 RELOC=5? LDA ...1+3 YES, SET FOR 4 * * * TEST FOR REPLACEMENT CODE SYMBOL (RELC=6) * * LDB CODE GET OPCODE I.D. CPA .1+5 REPLACEMENT CODE SYMBOL ? CPB .32B YES, IS OPCODE RPL ? RSS YES, CONTINUE. JMP HD22 NO *ERROR* LDB RELC GET OPERAND RELOC. CODE. SZB,RSS FIRST SYMBOL ENCOUNTERED ? STA RELC YES,SET OPERAND RELOC. CODE. CPA RELC } NO, TEST FOR SAME RELOC. TYPE. CPB .1+3 SAME. ANOTHER EXTERNAL ? JMP HD22 *ERROR* DIFFERENT OR 2 EXT'S. LDB SAVB GET SYMBOL'S VALUE. CPA .1+3 IF SYMBOL IS AN EXTERNAL, STB XORD SAVE THE ORDINAL NUMBER. * * *UPDATE SIGN SAVER * LDB SIGN COMPUTE ALGEBRAIC RUNNING SUM ADB T OF SYMBOLIC TERM'S SIGNS. STB T END RESULT=0/+1,ELSE 'M' ERROR. HD61 LDA SAVB VALUETO A ISZ TERM UPDATE NO OF TERMS LDB SIGN SSB IS SIGN NEGATIVE? CMA,INA -YES- COMPLEMENT ADA SUMP -UPDATE RUNNING SUM STA SUMP JMP HD30 * * * UNDEFINED SYMBOL EXIT * * HD6 LDA .UN 'UN' UNDEFINED SYMBOL JMP HD22+1 TO ERPR .M11 DEC -11 .M27B OCT -27 .401B OCT 401 .32B OCT 32 .50 DEC 50 .M58 DEC -58 * SKP * ******************** * * READ A STATEMENT * * ******************** RSTA NOP LDA REP SZA,RSS ARE WE REPEATING A STATE? JMP RXT NO - ISZ REP YES, ARE WE DONE? JMP RZP NO RXT LDB FBOI LDA .50 FOR 50 WORDS JSB SETM SET I/O BUFF TO BLANKS BLNS ASC 1, RXC JSB %READ GO READ A STATEMENT DEF *+4 FFUB DEF BUFF DEF D40 40 WORDS INPUTINPUT JMP ABORT EOF RETURN - NOT POSSIBLE STB SCN1 SAVE ACTUAL CHARACTER COUNT CMB,INB STB PNTR SAVE NEG. CHAR COUNT LDB SCN1 SZB,RSS END OF TAPE? (B=0?) JMP TAPN YES - GO SET PARAMETERS ISZ SEQN BUMP SEQ.NO. CLB,INB 1 TO B STB PNTR SET PNTR = 1 ADB SCN1 GET TOATL LENGTH * * SET CHARS FOLLOWING STATE.TO BLANKS * BRS ADB FFUB LDA BLNS STA 1,I RXL CLA (ENTER FOR REP PROCESSOR) STA BYFLG CLR PUNCH BYTE FLAG :NLH STA SCN1+3 STA TEST STA SIGN CLR EXT W/OFFSET FLAG. ISZ ASM1 CONTROL STATE.? JMP *+6 NO.. LDA ...1+4 YES, SET LIST CODE JSB LIST CLA,INA SET A = 1 STA TAPE SET TAPE COUNT = 1, IN CASE OF ? JMP RSTA,I EXIT N* * * CHECK LABEL AREA * JSB PKUP PICK UP NEXT CHAR; BUMP PNTR CPA L+2 *? JMP HI24 -YES- * * * IS LABEL PRESENT? * CPA BLNK LABEL PRESENT ? JMP HS50 NO. GO TO PROCESS OPCODE. CLB =0: SYMTS LABEL CHECK. JSB SYMTS GO TO CHECK FOR VALID LABEL. NOP ERRORS ALREADY NOTED; CONTINUE SCANNING. JMP HS49 GO TO LABEL POST-PROCESSOR. * * SYMTS - TEST FOR VALID CHARACTERS IN A LABEL/SYMBOL * * ENTER: CHAR. IN LOW & 'TEST';=0:LABEL OR NEG. CHAR. CNT.:OPERAND. * EXIT: P+1 INVALID (SY ERROR PRINTED); P+2 VALID; & MEANINGLESS. * SYMTS NOP STB SCNT SAVE NEGATIVE CHARACTER COUNT. JSB LBL GO TO TEST FOR ILLEGAL CHARACTER, LDA TEST GET CHAR.; TEST FOR NUMERIC 1RST CHAR. ADA .M48 SUBTRACT 60B (ASCII '0'). SSA FIRST CHARACTER <60B ? JMP HS20 YES - O.K. - GO GET NEXT CHARACTER. ADA .M15 NO. SUBTRACT 17B. SSA FIRST CHARACTER >= 77B (ASCII '?') ? JMP LBLER NO--ILLEGAL FIRST CHARACTER! HS20 JSB PKUP GET NEXT CHARACTER. CPA BLNK END OF LABEL (SYMBOL TERMINATOR) ? JMP SYMEX YES, GO TO COMPLETION. JSB LBL NO. GO TO TEST VALIDITY OF THIS CHAR. JMP HS20 GO TO GET THE NEXT CHARACTER. * SYMEX LDA SERR GET INVALID CHARACTER FLAG. SZA,RSS ANY INVALID CHARACTERS ? ISZ SYMTS NO. SET RETURN TO P+2. CLA CLEAR INVALID CHARACTER FLAG. STA SERR FOR NEXT USER. JMP SYMTS,I RETURN: P+1-ERROR; P+2-VALID SYMBOL. * * * TEST FOR ILLEGAL CHAR. IN SYMBOL * * * THEY ARE ' ( ) * + , - * * LBL NOP ADA .M46 SUBTRACT 56B (ASCII '.') SSA,RSS GREATER THAN 55B ? JMP LBLEX YES-O.K. ADA .1+6 NO. ADD BACK 7B.  SSA LESS THAN 47B (ASCII ' ) ? JMP LBLEX YES-O.K. LBLER LDA SERR GET ERROR FLAG. SZA ANY PREVIOUS ERRORS, THIS SYMBOL ? JMP LBLEX YES, AVOID ADDITIONAL ERROR MESSAGES. LDA .SY NO. GET 'SY' - ILLEGAL SYMBOL INDICATOR. JSB ERPR GO TO PRINT THE ERROR MESSAGE. ISZ SERR SET ILLEGAL CHARACTER FLAG. LBLEX ISZ SCNT DECREMENT COUNT. ALL CHARACTERS CHECKED? JMP LBL,I NO. GO BACK FOR MORE. JMP SYMEX YES, GO TO COMPLETION. * * * * 'REP' PROCESSING * RZP ISZ REQ 1ST REP PASS? JMP RXT YES,READ STATEMENT CCA STA REQ SET REQ = -1 CLA,INA STA PNTR SET PNTR=1 JMP RXL * * * LABEL POST-PROCESSOR * * HS49 LDA PNTR ADA ..M1+1 (-2) SET LABEL LENGTH STA SCN1+3 * * * PROCESS OPCODE * * HS50 JSB OPLK SEARCH FOR OPCODE JMP HSERR ERROR EXIT JSB PKUP GET NEXT CHAR (_*+5) CPA BLNK BLANK? JMP *+4 YES? CPA L+4 COMMA? JSB BPKUP YES-GET NEXT NON-BLANK JMP *-5 GET NEXT CHAR. * * * TEST FOR OPCODE LENGTH LEGAL * LDB PNTR CMB,INB (POINTS TO BLNK FOLLOWING OPCODE) ADB SCN1+1 CPB ..M1+3 (-4) JMP HS54 LENGTH OK (=3) LDA CODE ADA .M48 CODE-60B SSA,RSS MICRO-OP ? JMP HS54 YES * * * ERROR PROCESSOR FOR OPCODE * LDA .OP 'OP'= OPCODE HAS TOO MANY CHARS. JSB ERPR HSERR LDA ASM1 LDB IFUSE CPB .1 SKIP CODE BECAUSE OF IFZ/IFN? JMP IFPRN YES - GO PRINT THE STATEMENT. SSA IS THIS AN INITIAL READ REQUEST? JMP HI24 -IT'S FROM INIT, SKIP OUTPUT BELOW. LDA PASS SZA,RSS JSB ?LABE INSERT LABEL FOR OPCODE ERROR JSB LOUT TO BREC JSB LIST ISarZ PLCN BUMP LOCN.CNTR JMP RXT READ NEXT STATE. HI24 LDA ...1+2 (3) REMARK PROC. JSB LIST JMP RXT READ NEXT STATEMENT * * * PICK UP OPERAND LOCN, THEN EXIT * * HS54 LDB CODE CPB .31B IS THIS IFZ/IFN/XIF? JMP IFZN YES LDA IFUSE GET 'IF' USE FLAG CPA .1 SKIP ASSEMBLING? CPB .12 IS IT AN 'END'? RSS YES - DON'T SKIP IT JMP HI24+1 GO ON AND PRINT THE STATEMENT JSB BPKUP GO SKIP BLANKS IF NECESSARY. ADB .M81 (-81) TEST FOR PNTR< 81 CLA SET A=0 STA LTFLG CLEAR LITERAL FLAG SSB SKIP IF FIELD OUT OF RANGE LDA PNTR PNTR TO A STA SCN1+2 OPERND POSN SZA OPERAND PRESENT? * * * TEST FOR LITERAL * JSB PKUP YES - GET 1ST CHAR. LDB AFLAG GET FLAG FOR 'ABS' TEST CPA EQ IS THE OPERAND A LITERAL? SZB YES, BUT EXIT IF ABSOLUTE ASS'Y. JMP RSTA,I NO EXIT FROM READER HERE. JSB PKUP GET THE LITERAL TYPE, NOW. LDB SCN1+2 GET OPERAND PNTR ADB .1+1 ADD 2 STA LTFLG SET LIT.FLAG(=LITERAL TYPE) LDA CODE * NOW CHECK FOR LEGAL LITERAL * CPA .1+5 ARITHMETIC MACRO? STB SCN1+2 YES, SET OPERAND POINTER. CPA .12+2 MEMORY REFERENCE? STB SCN1+2 YES, SET OPERAND POINTER. CPA .26B MPY/DIV/DLD/DST ? STB SCN1+2 YES, SET OPERAND POINTER. CMA,INA NEGATE OPCODE I.D. NO. ADA .A (101B) SSA OPCODE >100B ? STB SCN1+2 RESET POINTER TO LITERAL VAALUE. JMP RSTA,I EXIT FROM RSTA HERE .26B OCT 26 * SPC 2 * * PROCESS 'IFZ', 'IFN', OR 'XIF' CODES..* SPC 1 IFZN LDA INST GET INSTR.FORMAT(HAS IF CHAR IN) CLB SZA,RSS IS INST = 0? (IS IT XIF) ? JMP IFZN3 YES r CPB IFUSE IFUSE = 0? JMP IFZN2 YES - GO ON WITH PROCESSING IFZNR LDA IF NO, ERROR, WE'RE IN IF OR REP JSB ERPR PRINT 'IF' ERROR JMP IFZN3+1 YES, GO ON WITH PROGRAM IFZN2 CLB,INB SET B = 1 CPA IFTST IS 'IF' CHARACTER MATCHED? CMB,INB YES - SET B = -1 IFZN3 STB IFUSE SET 'IFUSE' FLAG CLB CPB REP IN RANGE OF A REPEAT? JMP *+3 NO - OK STB REP YES - CLEAR 'REP' FLAG JMP IFZNR GO PRINT ERROR DIAG. IFPRN CLA,INA SET UP FOR NO INST, NO LOC'N PRNT JMP HI24+1 GO TO LIST AND CONTINUE SPC 1 IF ASC 1,IF ERROR IN IFZ OR IFN EQ OCT 75 EQUAL SIGN(=) .31B OCT 31 =IFZ,IFN,XIF TYPE D40 DEC 40 .M46 DEC -46 .M81 DEC -81 .SY ASC 1,SY HEDR DEF HEADP UMSK OCT 177400 MASK FOR UPPER CHARACTER LMASK OCT 377 MASK FOR LOWER CHARACTER SPC 1 * * SET SEQN TO ZERO, BUMP AND CONVERT SEQN. NO. * SPC 1 TAPN STB SEQN SET SEQ. NO. TO ZERO ISZ TAPE ADD 1 TO TAPE # LDA TAPE CCE CONVERT TO ASCII JSB BNCN CONVERT TO ASCII OCTAL LDA ASCI+2 STA ASCI+4 STORE IT INTO THE HEADER JMP RXC * SKP * * * TEST FOR LABEL PRESENT AND INSERT IN SYMBOL TABLE * * SET CORRECT RELOC.CODE BEFORE INSERTION. * ?LABE NOP LDA SCN1+3 GET LABEL LENGTH SZA,RSS LABEL PRESENT ? JMP ?LABE,I NO, DONE, EXIT.. STA SYMP SET CHAR COUNT LDB FFUB STB SYMP+1 SET LABEL ADDR. LDB LTFLG STB FLAQ SAVE LTFLG CLA STA LTFLG LTFLG_0 LDA AFLAG SZA IS THIS AN ABSOLUTE ASSEMBLY? JMP LABEX YES CLA,INA SET A = 1 LDB ?BASF SZB IN BASE PAGE ? INA YES, SET A = 2 LDB PLCN JSB ?INSR INSERT LABEL INTO SYMBOLO TABLE NOP ERROR EXIT LDB FLAQ STB LTFLG RESTORE LTFLG JMP ?LABE,I EXIT LABEX JSB ?INS? GO TO INSERT RTN IN ASMB3 NOP ERROR EXIT JMP ?LABE,I EXIT * SKP * ************************************** * * MOVE: MOVES A STRING OF CHARACTERS * * * LINKAGE: A = NO.OF CHARS TO MOVE * * * B = DESTINATION ADDRESS * * * L JSB MOVE,I * * * L+1 SOURCE ADDRESS * * * L+2 RETURN * * * ADDR.TRUE IF STARTS ON LEFT * * * 2'S COMPL.IF STARTS ON RIGHT * * ************************************** MOVE NOP SZA IS CHAR.COUNT = 0? JMP *+3 NO JSB OPERR YES JMP MOVX CMA,INA STA GTEM+3 =-A * * SET UP DESTINATION CLE,SSB CMB,CCE,INB ELB STB GTEM+1 LDB MOVE,I GET SOURCE ADDRESS * * SET UP SOURCE CLE,SSB CMB,CCE,INB ELB STB GTEM+2 * * NOW MOVE THE CHARACTERS * $ LDB GTEM+2 CLE,ERB E_BIT #0 LDA 1,I B,I TO A SEZ,RSS E=0? ALF,ALF ROTATE . AND LMASK MASK OUT UPPER 8 BITS * * LOWER 8 BITS OF A CONTAINS CHAR.TO BE MOVED.* STA GTEM LDB GTEM+1 DEST TO B CLE,ERB E_BIT #0 LDA 1,I B,I TO A SEZ,RSS E=0? ALF,ALF ROTATE AND UMSK IOR GTEM * * CHAR.NOW IN A, WITH OTHER HALF OF DEST.WORD.* * * SINCE IT'S ON RIGHT WE MAY HAVE TO ROTATE * SEZ,RSS E=0? ALF,ALF ROTATE STA 1,I A TO B,I * * NOW IT'S IN OK, BUMP COUNTERS AND PROCEED * ISZ GTEM+2 ISZ GTEM+1 ISZ GTEM+3 JMP $ MOVX ISZ MOVE JMP vMOVE,I RETURN TO L+2 OF LINKAGE * ********************************************* * * SYMK: LOOKUP SYMBOL TABLE ENTRY; W HACCOU * * * LINKAGE: INPUT; SYMP=NO CHARS;SYMN=FWA * * * OF NAME..OUTPUT;A=TYPE,B=VALUE* * * L JSB SYMK,I * * * L+1 UNDEF.SYMBOL EXIT * * * L+2 NORMAL RETN * * ********************************************* SYMK NOP CLA INITIALIZE NAME(4), STA NAME 0 TO 1ST, BLANKS TO LDA BLNS OTHER WORDS STA NAME+1 STA NAME+2 LDA SYMP NO.OF CHARS ADA ..M1+5 (-6) SSA JMP *+5 * * * SYMBOL TOO LONG, PRINT DIAG.; SET LENGTH = 5 * * LDA .SY 'SY' TOO MANY CHARS IN SYMBOL JSB ERPR LDA ...1+4 (5) STA SYMP LDA SYMP (FROM *-5) LDB SYMP+1 ADDR.OF 1ST CHAR. STB *+4 LDB NAMI CMB,INB JSB MOVE NOP (SET AT *-4) LDA SYMP NO.OF CHARS. ARS STORE NUMBER OF INA WORDS IN ENTRY-1 STA TEMP+2 INTO TEMP+2 INA STA TEMP+3 AND TEMP+3 ALF,ALF ALF ADA NAME SET NUMBER OF WORDS STA NAME TO COMPARE FIRST WORDS LDA X IN THE STA SYMI SYMBTAB ADDR.COUNTER LP2 LDA NAMI STA SALU RESET NAME ADDR. COUNTER LDA SYMI STA TEMP+4 SAVE FWA OF SYMB.TBL.ENTRY LDA SYMI,I SZA,RSS JMP SYMK,I UNDEFINED EXIT FROM HERE STA FLEX SAVE 1ST WORD OF ENTRY AND SMASK 70377B CPA NAME COMPARE 1ST WORDS JMP *+6 ALF AND .12+3 (17B)MASK NO.WRDS IN ENTRY ADA SYMI LP3 STA SYMI BUMP ADDR.CNTR JMP LP2 LDA TEMP+2 (FROM *-6) ADA SYMI SET LIMIT=LWA-1 STA VAL0 OF SYMTAB ENTRY ISZ SYMI BUMP ADDR CNTR (FROM *+7) LDA SYMI CPA VAL0 END OF ENTRY? JMP *+8 YES ISZ SALU NO LDA SYMI,I COMPARE NEXT 2 CHARS. CPA SALU,I JMP *-7 EQUAL; COMPARE NEXT TWO. LP4 LDA TEMP+3 ADA TEMP+4 SET FWA OF NEXT ENTRY JMP LP3 CHK NXT SYMTAB ENTRY LDA FLEX GET 1ST ENTRY WRD (FROM *-8) ALF,ALF AND .12+3 (17B) LDB LTFLG SZB,RSS LITERAL IN OPERAND? JMP *+6 NO CPB ...1 ARITH MACRO WITH LITERAL? JMP *+4 YES CPA ...1+6 RELC=7? JMP *+4 YES, DONE. JMP LP4 NO, GO BACK CPA ...1+6 LITERAL? JMP LP4 YES, GO BACK(OPERAND IS'NT LITERAL) LDB SYMI,I B=VALUE ISZ SYMK JMP SYMK,I EXIT ALPHA+2 HERE SMASK OCT 70377 .400B OCT 400 .M16 DEC -16 .M48 DEC -48 * SKP * ************************* * * PUNCH A BINARY RECORD * * ************************* PNCH NOP * * COMPUTE CHECKSUM * * LDB FUBP = ADDRESS OF PUNCH BUFFER. LDA PBUF GET RECORD LENGTH. ALF,ALF POSITION TO LOWER BYTE. STA CNTB SAVE FOR 'EXEC' CALL. CMA,INA NEGATE WORD COUNT AND INA -1 (LENGTH NOT IN CK.SUM). STA GTEM STORE CHKSUM CNTR CLA CLEAR STA PBUF+2 CHECKSUM BUFFER-WORD. ISZ 1 BUMP REC.ADDR. ADA 1,I ADD TO CHK SUM ISZ GTEM DONE? JMP *-3 -NO STA PBUF+2 -YES- STORE SUM * * * WRITE OUT BIN RECORD * JSB WRITF DEF *+5 DEF DCBO DEF ?ERR FUBP DEF PBUF BUFFER ADR DEF CNTB WORD COUNT SSA,RSS ERRORS? JMP PNCH1 NO JSB ?FMPE YES, DISPLAY ERROR MESSAGE DEF AO+1 OUTPUT FILE NAME PNCH1 CLA STA PBUF * *  * EXIT HERE * * JMP PNCH,I * SKP * ******************************************** * * ASCN - CONVERT AN ASCII NUMBER TO BINARY * * * -ENTRY: A CONTAINS POSITION OF 1ST CHAR. * * * B(LOWER) CONTAINS NO. OF CHARS. * * * B(UPPER): MODE(BELOW) * * * 0 = OCTAL * * * 1 = FIXED DECIMAL * * * 2 = FLOATING DECIMAL * * * 3 = EXTENDED FLTG. DECIMAL * * * -EXIT : L+1 = ERROR RETURN ON ILLEGAL * * * CHARACTER OR OVERFLOW. * * * L+2 = NORMAL RETURN * * * MODE=0 OR 1, VALUE IN A * * * MODE=2, VALUE IN A AND B * * * MODE=3, VALUE IN A, B AND VALU * * * NOTE: FOR MODES 2 AND 3 VALUES IN A AND * * * B ARE ALSO IN VAL0 AND VAL1 RESP. * * ******************************************** ASCNP NOP ASCN EQU ASCNP STA SYMI CHAR POS. IN SYMI LDA LMSK AND 1 CMA,INA STA DCNT CHAR COUNT IN DCNT LDA 1 ALF,CLE,ALF POSITION THE MODE AND LMSK STA MODE SET MODE IN MODE ERA,SLA INTEGER CONVERSION? JMP ASCN2 NO - GO TO FLOATING PT ROUTINE JSB INTEG GO TO INTEGER CONVERSION XNORM ISZ ASCNP SET UP FOR NORMAL RETURN JMP ASCNP,I EXIT * ***************************************** * * FLOATING POINT PROCESSING STARTS HERE * * ***************************************** ASCN2 CLA STA VAL0 CLEAR NUMBER SLOTS STA VAL1 STA VALU STA DEXP CLEAR DEC. OVERFLOW SLOT CCA STA DSIG SET SIGN(-1) FIR + STA CNVT SET FLAG FOR SIGN IN 1ST POSN. LDA BIT15 STA DFCNT SET DFCNT = 100000B FDCN1 JSB CNVRT CONVERT A CHARACTER  JMP FDCN3 NON DIGIT RETURN ISZ DFCNT BUMP FRAC. COUNT LDA DEXP SZA OVERFLOW? JMP DCOV YES LDA VALU NO, PROCESS DIGIT STA VALUS LDA VAL1 LDB VAL0 JSB SHFT1 JSB SHFT1 NUM TIMES 4 AT THIS POINT SEZ,SSB,RSS OVERFLOW? RSS NO JMP DCOV YES LDB VALU ADB VALUS JSB CHK OVERFLOW FROM VALU? STB VALUS LDB VAL0S ADA VAL1 JSB CHKB IF VAL1 OV, BUMP B ADB VAL0 NUM TIMES 5 AT THIS POINT JSB SHFT1 NUM TIMES 10 HERE SEZ,SSB,RSS OVERFLOW? JMP *+3 NO DCOV ISZ DEXP YES, BUMP OVERFLOW DIGIT COUNT JMP FDCN7 LDB VALUS ADB CNVT FINALLY ADD LATEST DIGIT TO NUM JSB CHK IF OV, BUMP VAL1 STB VALUS LDB VAL0S JSB CHKB IF VAL1 OV, BUMP VAL0 SEZ,SSB,RSS OVERFLOW? JMP FDCN6 NO JMP DCOV YES FDCN3 CPA L+6 DEC PNT? (NON DIG.FROM CNVRT) JMP FDCN5 YES CPA .E 'E'? JMP *+3 YES ILEX LDA .IL NO, GO GET 'IL' JMP OVEX+1 GO TO ERROR DIAG EXIT ISZ DCNT LAST CHARACTER? JMP FDHOP NO - GO TO PROCESS EXPONENT FDCN5 LDA DFCNT SSA,RSS IS THIS A SECOND DEC.PNT? JMP ILEX YES CLA STA DFCNT CLEAR COUNTER FOR DIGITS AFTER . JMP FDCN7 FDCN6 STB VAL0 SAVE NEW VALUE IN VAL0,VAL1,VALU STA VAL1 LDA VALUS STA VALU FDCN7 ISZ DCNT LAST CHARACTER? JMP FDCN1 NO- GET NEXT CHAR. * ************************************* * * PROCESS EXPONENT, IF PRESENT, AND * * * FINISH THE NUMBER(NORMALIZE, ETC)* * ************************************* FDHOP LDB DFCNT CMB,SSB,INB,RSS WAS A DEC POINT PRESENT? CLB NO, CLEAR B ADB DEXP STB DEXP SET CURRQENT COUNT FOR DEC EXPONENT LDA DSIG STA SDSIG SAVE SIGN OF MANTISSA CLA NO - CONTINUE PROCESSING LDB TEST CPB .E IS EXPONENT THERE? JSB INTEG YES - EVALUATE IT ADA DEXP A+OVERFLOW CHARS STA DEXP SET VALUE OF DECIMAL EXPONENT LDA VAL0 CHECK FOR A VALUE OF ZERO IOR VAL1 IOR VALU SZA,RSS IS THE VALUE=0? JMP UNDTF YES, NORMAL EXIT FROM ASCN RTN. LDA .47 STA FEXP SET BINARY EXPONENT = 47 * * NORMALIZE THE NUMBER(IN VAL0,VAL1,VALU) * FDHP2 LDB VAL0 LDA VAL1 SSB IS BIT 15=0? JMP FDHP3 NO- GO SHIFT THEM ALL BACK 1 LDB VALU CLE,ELB SHIFT FROM VALU TO VAL1 ELA STB VALU STA VAL1 LDB VAL0 ELB SHIFT FROM VAL1 TO VAL0 STB VAL0 CCA ADA FEXP JMP FDHP2-1 FEXP-1 TO 'A' FDHP3 CLE,ERB SHIFT THEM ALL 1 RIGHT ERA STB VAL0 LDB VALU ERB STA VAL1 STB VALU ISZ FEXP NOP * LDA DEXP CLE,SZA,RSS JMP FDHPX DONE IF EXPONENT=0 SSA IS EXPONENT POSITIVE? JMP FDHP6 NO - GO TO DIVIDE BY 10 ADA ..M1 YES - MULTIPLY NUMBER BY 10 HERE STA DEXP DEXP=DEXP-1 LDA .1+2 ADA FEXP STA FEXP FEXP=FEXP+3 LDA VAL0 STA VAL0S LDA VALU STA VALUS LDB VAL1 JSB SHFR1 SHIFT VAL0,VAL1,VALU - JSB SHFR1 -RIGHT 2 PLACES ADA VALUS STA VALU NEW VALU JSB CHKB IF OV, BUMP B REG. LDA VAL0S ADB VAL1 JSB CHK OVERFLOW? FDHP5 ADA VAL0 STA VAL0 NEW VAL0 STB VAL1 NEW VAL1 JMP FDHP2 GO BACK TO RE-NORMALIZE * * DIVIDE NUMBER IN VAL0,VAL1,VAL2 BY 10 * FDHP6 INA STA DEXP DEXP=DEXP+1 LDA ..M1+2 ADA FEXP K STA FEXP FEXP=FEXP-3 * * GO TO DIVIDE BY 10 HERE * LDA UVAL FDHP7 ADA ..M1+2 -3 CPA VSTOP LAST SECTION PROCESSED? JMP FDHP9 YES, LEAVE DIVIDE PROC NOW STA CNVT CONTAINS ADDR OF SECTION VEING DON * * DIVIDE 'A' BY 10 * * RESULT IN A AND B(=LEAST SIG.) LDB .M16 STB TEMP LDB TENTH CLA CLE,SLB CHECK FOR ANOTHER ADD ADA CNVT,I ERA ERB ISZ TEMP ALL DONE? JMP *-5 NO - CONTINUE STA CNVT,I SAVE 'A' VALUE ISZ CNVT BUMP ADDRESS STB CNVT,I SAVE 'B' VALUE LDA CNVT GET ADDRESS READY TO RESET JMP FDHP7 FDHP9 JSB COL45 PROCESS COL. 5 JSB COL45 PROCESS COLUMN 4 ADB VAL1 JSB CHK ADB VAL0S JSB CHK JSB COL32 PROCESS COLUMN 3 ADB VALU JSB CHK ADB VAL1S JSB CHK STB VALU VALU COMPUTED JSB COL32 PROCESS COLUMN 2 JMP FDHP5 GO STORE VAL0 AND VAL1. CONTINUE * ****************************** * * SET UP FLTG DECIMAL RESULT * * * FOR EXIT FROM CONVERSION * * ****************************** FDHPX LDA VAL1 LDB VAL0 JSB CHKM IS MODE EXT.DEC? JMP *+3 NO LDA VALU LDB VAL1 ADA .200B ROUND THE LEAST SIGNIF. WORD JSB CHKB BUMP B IF E=1 JSB CHKM MODE=EXT.DEC? JMP *+4 NO STB VAL1 YES LDB VAL0 JSB CHKB BUMP VAL0 IF E=1 SSB,RSS VAL0<0? JMP *+4 NO RBR,CLE IT WAS A POWER OF 2 ISZ FEXP BUMP EXPONENT NOP STB VAL0 SAVE MOST SIF. JSB CHKM MODE = EXTEN.DEC? JMP *+2 LDB VAL1 YES AND UMSK STA DSIG CLEAR LOW 8 BITS OF 'A' AND SAVE ISZ SDSIG IS SIGN OF MANTISSA=+ JMP FDHR4 NO, GO PROCESS NEG. MANTISSA FDHRT LDA FEXP GET FRACTIONAL EXPONENT IN A/B LDB FEXP AND .1776 CLEAR LOWER 7 BITS SZA POSITIVE OVERFLOW? CPA .1776 MAYBE, NEG. OVERFLOW? CPB .1776 MAYBE, IS EXPON,=-200B? JMP FDHR3 YES, ALSO OTHER OVERFLOWS.. LDA FEXP GET THE EXPONENET AGAIN RAL POSITION IT AND LMSK CLEAR BITS 15-8 ADA DSIG ADD IN THE LEAST SIG.PART JSB CHKM IS IT EXTEND.DEC? UNDTF STA VAL1 NO,SET VAL1=LEAST STA VALU YES, SET VALU=LEAST SIGN. LDB VAL1 GET WORD 2 LDA VAL0 GET MOST SIGNIF. JMP XNORM GO OUT THE NORMAL EXIT FDHR3 SSB,RSS IS IT REALLY AN UNDERFLOW? JMP OVEX NO CLA YES, SET NO. = ZERO STA VAL0 CLEAR VAL0 JMP UNDTF FDHR4 CMA,INA START GETTING COMPLEMENT CMB JSB CHKB AND UMSK STA DSIG SAVE LEAST SIGNIFICANT BITS JSB CHKM IS IT EXTEND.DEC? JMP *+5 NO STB VAL1 LDB VAL0 CMB JSB CHKB CLE,ELB LDA ..M1 SSB,RSS WAS N0. A POWER OF 2? JMP *+4 NO ADA FEXP YES STA FEXP SUBTRACT 1 FROM EXPONENT. RSS ERB RESET B STB VAL0 JMP FDHRT * ************************* * * CHECK MODE OF NUMBER * * * L+2 EXIT IF EXTENDED * * * ELSE L+1 * * ************************* CHKM NOP STB DEXP SAVE THE 'B' REG. LDB MODE CPB .1+2 IS MODE EXTEND.DEC? ISZ CHKM YES, BUMP RETURN ADDRESS LDB DEXP RESTORE THE 'B' REG. JMP CHKM,I * * PROCESS PARAMETERS FOR COLS. 4 AND 5 * COL45 NOP LDB 0 LOAD 'B' WITH 'A' (OVERFLOW BITS) CLA,CLE ADB VALU JSB CHK ADB VALUS JSB CHK ADB VAL1S JSB NLHCHK JMP COL45,I `N* * PROCESS PARAMETERS FOR COLS 2 AND 3 * COL32 NOP LDB 0 SET B=A(OVERFLOW FROM PREV COL.) CLA,CLE ADB VAL1 JSB CHK ADB VAL0 JSB CHK ADB VAL0S JSB CHK JMP COL32,I * * CHECK FOR OVERFLOW FROM 'B' * CHK NOP SEZ OVERFLOW? CLE,INA YES, BUMP 'A', CLEAR 'E' JMP CHK,I * * CHECK FOR OVERFLOW- IF TRUE, BUMP 'B' * CHKB NOP SEZ CLE,INB JMP CHKB,I * * SHIFT NUMBER IN VAL0,VAL1,VALU RIGHT U * SHFR1 NOP LDA VAL0 CLE,ERA VAL0 RIGHT 1 ERB VAL1 RIGHT 1 STA VAL0 LDA VALU ERA,CLE VALU RIGHT 1 STA VALU JMP SHFR1,I RETURN * * ********************************** * * CNVRT - CONVERT AN ASCII CHAR. * * * TO BINARY. * * * - MODE = 0,OCTAL; ELSE DECIMAL * * * - L+1 RETURN IF NON-NUMBERIC * * ********************************** * CNVRT NOP LDA SYMI GET POS'N.OF CHARACTER JSB GETC GET CHARACTER ISZ SYMI BUMP POS'N LDB MODE SZB OCTAL CONVERSION? LDB ..M1+1 NO - SET FOR DEC.CONV ADB .M8 B=-8 HERE, IF OCTAL CONVERSION ADA .M48 -60B + A SSA IS VALUE LESS THAN ZERO? JMP CNVR2 YES ADB 0 NO - ADD IN MAX DIGIT VALUE. SSB IS IT A VALID NUMBER? JMP CNVRX YES- GO TO EXIT WITH NO. IN A. CNVR2 LDA TEST NO - TEST FOR + OR - CPA L+3 PLUS? JMP CNVR4 YES CPA L+5 NO - IS IT MINUS ? CLA,RSS YES JMP CNVRT,I NO - TAKE L+1 EXIT STA DSIG CNVR4 CLA ISZ CNVT HAS SIGN BEEN ENCOUNTERED BEFOR? JMP ILEX YES- 'IL' EXIT FROM ASCN CNVRX STA CNVT ISZ CNVRT JMP CNVRT,I * SKP * i ************************************** * * INTEG - CONVERT A STRING OF ASCII * * * CHARS TO AN OCTAL(MODE=0) * * * OR DECIMAL INTEGER. * * *-IF OTHER THAN A LEADING SIGN OR * * * NUMBER IS FOUND 'IL' EXIT IS TAKEN * * *-'OV' EXIT IF OVERFLOW. * * ************************************** INTEG NOP CCB STB DSIG SET SIGN FLAG FOR PLUS STB CNVT SET 1ST CHAR FLAG(FOR SIGN CHK) * *ON ENTRY A=0(USED FOR THE INITIAL VALUE.) *** INTG2 STA VALUS SAVE CURRENT VALUE JSB CNVRT CONVERT A CHARACTER JMP ILEX ERROR - NON NUMERIC LDA VALUS CLE,ELA JSB OVTST TEST 4 TIMES A FOR OVERFLOW LDB MODE NO OVERFLOW SZB MODE = OCTAL ADA VALUS NO - 5 TIMES A(IT'S DECIMAL) JSB OVTST TEST 8(OR 10) TIMES A FOR OV ADA CNVT NO - ADD IN NEW DIGIT SEZ OVERFLOW? JMP OVEX YES ISZ DCNT LAST CHAR IN STRING? JMP INTG2 NO - GET ANOTHER SZB,RSS MODE = OCTAL? JMP INTG6 YES - OK CPA BIT15 IS NO. + OR - 32768? JMP INTG6 YES - OK SSA IS SIGN NEG? JMP OVEX YES - OVERFLOW INTG6 ISZ DSIG IS SIGN NEGATIVE? CMA,INA YES - COMPLEMENT A. JMP INTEG,I EXIT * *************************** * * SHIFT FOR MULTIPLY BY 2 * * *************************** SHFT1 NOP STB VAL0S SAVE VAL0S LDB VALUS GET VALUS CLE,ELB ELA SHIFT VAL1,VALUS STB VALUS SAVE VALUS LDB VAL0S GET VAL0S ELB SHIFT VAL0S,VAL1 STB VAL0S SAVE VAL0S JMP SHFT1,I RETURN * ****************************************** * * TEST ZERO BIT AND 'E' BIT FOR OVERFLOW * * G****************************************** OVTST NOP ELA 2 TIMES ENTRY VALUE OF 'A' SEZ,SLA,RSS OVERFLOW? JMP OVTST,I NO - RETURN OVEX LDA .OV GET 'OV' FOR ERROR DIAGNOSTIC. JSB ERPR JMP ASCNP,I LEAVE VIA RERROR EXIT * .UVAL DEF VALU+3 ASCN 1ST PICKUP FOR DVD BY 10 .VSTP DEF TEMP ASCN LAST PICKUP FOR DIV BY 10 UVAL NOP VSTOP NOP .47 DEC 47 .1776 OCT 177600 177600 TENTH OCT 146314 146314 .200B OCT 200 200B LMSK EQU LMASK LMDG DEF *+1 (ASCN) DEC -1000,-100,-10 LPDG DEF *+1 (ASCN) DEC 1000,100,10 * * ************************************** * * BINARY TO ASCII CONVERSION ROUTINE * * * A = NUMBER TO BE CONVERTED * * * E = 0 CONVERT TO OCTAL * * * E = 1 CONVERT TO DECIMAL * * ************************************** OCT 30060 PACKED ASCII '00'. BNCN NOP LDB ICSA GET LOC'N OF ACSI BUFFER STB SYMI CCB STB VALUS START UPPER LDB BNCN-1 SET BUFFER=ASCII ZERO'S STB ASCI STB ASCI+1 STB ASCI+2 SEZ TEST E BIT (=0,OCTAL =1,DECIMAL) JMP % DEC CONVERSION LDB ..M1+5 (-6) STB DCNT CLE,ELA STA VALU CLA ELA SIGN BIT IS SIXTH DIGIT JSB DPCK LDA VALU ALF,RAR STA VALU AND ...1+6 (7) MASK 1 DIGIT ISZ DCNT END ? JMP *-6 NO. CONTINUE. JMP BNCN,I YES, EXIT DPCK NOP ADA SYMI,I ISZ VALUS JMP *+4 ALF,ALF STA SYMI,I JMP DPCK,I STA SYMI,I ISZ SYMI CCA STA VALUS JMP DPCK,I EXIT % LDB ..M1+2 (-3) DEC. CONVERSION RTN STB DCNT LDB LMDG STB VAL0 LDB LPDG STB VAL1 LDB 0 A TO B ISZ SYMI DPCR CLA,RSS INA (FROM *+3) q ADB VAL0,I COUNT NO.OF TIMES GT 10**N SSB,RSS JMP *-3 ADB VAL1,I <10**N, RESTORE VALUE JSB DPCK PACK DIGIT ISZ VAL1 ISZ VAL0 ISZ DCNT JMP DPCR RETURN FOR 10**N-1 LDA 1 JSB DPCK JMP BNCN,I EXIT * SKP * ***************** * * ORR PROCESSOR * * ***************** ORRP NOP CLA STA OFLAG JSB OR$ TO PRE-PROC STA ORRSV 0 TO ORRSV LDA ORRS GET THE SAVED MAIN PLCN STA PLCN SET PLCN TO MAIN LOC CNT. JMP ORRP,I EXIT OFLAG NOP * * * ORG/ORR PRE-PROCESSOR * * OR$ NOP LDA ?BASF LDB PLCN SZA ARE WE IN BASE PAGE ? STB ?BPSV YES, SAVE B.P. LOCATION COUNTER. LDA ORRSV GET ORRSV SZA WERE WE IN MAIN PROG? JMP OR$1 ISZ OFLAG JMP ORRP,I EXIT IF ORRP STB ORRS SAVE LOC CNTR IF ORG OR$1 SSA WAS THIS SECTION SET BY AN ORG ? JSB ORGST GO SET HIGH PLCN VALUE IN PROG. CLA STA ?BASF CLEAR BASE PAGE FLAG. JMP OR$,I * ***************** * * ORG PROCESSOR * * ***************** ORGP NOP CCA STA OFLAG JSB OR$ CCA STA ORRSV SET ORRSV = -1 * * * GO TO EVALUATE OPERAND * * JSB CHOPI JMP ORGP,I ERROR EXIT STB PLCN LDB AFLAG SZB,RSS SKIP OUT, IF ABSOLUTE ASSEMBLY CPA ...1 RELOC? JMP ORGP,I YES,OK JSB OPERR NO, 'M' ERROR JMP ORGP,I EXIT * SKP * ******************************* * * LIST ROUTINE: PARAMETERS; * * * IF A=0,4,6,7 B=RELOC CODE * * * A=0 FULL LINE * * * A=1 NO INST OR LOCN * * * A=2 NO INST * * * A=3 COMMENT * * * ~ A=4 NO SEQ.NO., NO STATE.* * * A=5 PRINT 'ASMB' STATEMENT* * * A=6 INST ONLY(EXT OFFSET)* * * A=7 NO LOCN (RPL CODE) * * ******************************* LISTD DEC 60,-61 LISTK DEF IOBF+6 INSTRUCTION LOC'N DEF IOBF+3 LOCATION LOC'N DEF IOBF+2 LIST COMMENT LOC'N LIST NOP STB SAVB SAVE ASCII RELOC CODE STA SAVB+1 SAVE LIST PARAM. CPA ...1+4 CONTROL STATE.? JMP HI82 YES LDB LFLAG GET LIST FLAG SZB,RSS PUNCH ONLY? JMP LIST,I YES, EXIT LDB PASS SZB,RSS PASS 1 ? JMP LIST,I YES, EXIT LDA LST SZA LIST FLAG=0 ? JMP LIST,I NO, EXIT LDA LPDG+3 (10) LDB FBOI JSB SETM SET BUFFER TO ASC 1, BLANKS LDA SAVB+1 CPA ...1 A=1? JMP HI82 YES CPA ...1+1 A=2? JMP HI80 YES * * * CONVERT INSTRUCTION * LDB SAVB STB IOBF+9 SET RELOC INDIC LDA INST CLE E=0 JSB BNCN CONVERT TO ASCII OCTAL LDB LISTK L(IOBF+6) JSB V MOVE NO.TO BUFFER LDA SAVB+1 GET LIST PARAMETER. CPA .1+6 (7) NO LOCATION ? JMP HI82 YES, GO CONVERT SEQ. NUMBER. CPA .1+5 (6) INSTRUCTION ONLY ? JMP HX8 YES, CHECK FOR SUPPRESS. * SKP * * CONVERT LOCATION CNTR * * HI80 LDA PLCN CLE E=0 JSB BNCN CONVERT TO ASCII OCTAL LDB LISTK+1 L(IOBF+3) LDA ...1+4 (5) JSB MOVE LISTL NOP -ASCI GOES IN HERE LDA SAVB+1 CPA ...1+3 A=4? JMP HX8 YES * * * CONVERT SEQ.NO. * HI82 LDA SEQN CCE E=1 JSB BNCN CONVERT IT TO ASCII DECIMAL LDA ASCI+1 STA IOBF LDA ASCI+2 STA IOBF+1 * * * SET UP BUFFER LENGTH, ADJUST IF >80 CHARS * LDB SAVB+1 CPB ...1+4 CONTROL STATE.? STA ASCI+4 SET TAPE # =1 LDA SCN1 STATE.LENGTH CPB ...1+2 REMARK? JMP HI19 YES HI17 STA 1 H TO B ADA LISTD+1 -61 SSA,RSS LENGTH>60 ? LDB LISTD YES, SET B=60 ADB ...1+3 ADD 4 STB 0 NEW LENGTH TO A HI18 ADA .12+4 LENGTH+16 LDB FBOI JSB PRNT *PRINT THE LINE OF OUTPUT * JMP LIST,I EXIT * * * SET UP FOR LIST COMMENT * HI19 LDB LISTK+2 L(IOBF+2) JSB MOVE DEF BUFF LDA SCN1 ADA .M16 LENGTH-16 JMP HI17 * * * TEST FOR EXTENDED SUP * HX8 LDB SUP SZB SUPPRESS THE LISTING ? JMP LIST,I YES, EXIT LDA .1+3 INITIALIZE STATEMENT LENGTH =4. JMP HI18 GO TO PRINT THE LINE. FBOI DEF IOBF * SKP * ****************** * * SKIP 'A' LINES * * ****************** LINS NOP SZA,RSS DON'T GO TO DRIVER, JMP LINS,I IF COUNT =0 (IT'S NOT NECESSARY). STA DSIG SET LINES TO SKIP INTO CNTR. JSB FCONT SKIP LINES DEF *+5 DEF DCBL 'CONTROL' REQ CODE DEF ?ERR DEF .110B DEF DSIG LINE COUNT SSA,RSS ERROR? JMP LINS,I NO, RETURN CPA .M12 IS IT A -12 ERROR? JMP LINS,I YES, THEN IGNORE IT JSB ?FMPE FMP ERROR ROUTINE DEF AL+1 LIST FILE JMP LINS,I RETURN. * ********************************************************************** * * * * FIND NUM.OF CHARS IN A TERM * * * * * ENTER:=DON'T CARE; =RELATIVE POS'N IN 'BUFF' OF 1RST CHAR. * * EXIT: =NO. CHARS. IN TERM; B=STARTING MEMORY ADDRESS OF TERM * * 'TEST'=CONTINUATOR CHAR., FOLLOWING TERM * * 'LAST'=LAST CHARACTER IN TERM * ********************************************************************** * MSYM NOP STB SAVB STB PNTR CLA START WITH STA DSIG ZERO FOR CNTR STA TEST HI42 STA LAST LAST LDA SAVB JSB GETC CPA L+2 * ? JMP HI43 YES CPA BLNK END OF SYMBOL? JMP *+7 -YES- ADA .M46 -46 = -56B SSA,RSS >55B ? JMP HI44 -YES, NOT A TERMINATOR. ADA ...1+6 (7) NO. SSA >47B [TERMINATOR: ' ( ) * + , - ] ? JMP HI44 NO * * SET UP FOR EXIT * LDA PNTR JSB GETA LDA DSIG NO.OF SYMBOLS TO A JMP MSYM,I EXIT HI43 LDA DSIG CPA ...1 IS '*' ALONE? JSB OPERR NO, ERROR HI44 ISZ DSIG BUMP CNTR. ISZ SAVB LDA TEST JMP HI42 * * ******************************** * * PRINT OUTPUT AND COUNT LINES * * ******************************** PRNT NOP STB PRLOC GIVE THE BUFFER ORIGIN CLE,SLA,ERA DIVIDE # CHARS BY 2 ANS SKIP JMP ODDCN IF EVEN STWCN STA SAVB SAVE THE WORD COUNT ISZ LINC END OF PAGE ? JMP I - NO LDB PLINE STB LINC RESET THE LINE COUNTER LDA .1+6 SKIP SEVEN LINES ON TTY, CMA,INA OR GO TO TOP OF FORM JSB LINS ON LINEPRINTER. ISZ LINC1 BUMP PAGE NO. CCE SET FOR DECIMAL NO.CONVERSION. LDA LINC1 GET PAGE NO. JSB BNCN CONVERT TO ASCII OCTAL * * * SET UP PAGE HEADER * LDA RC 'E' STA ASCI LDA LPDG+3 OUTPUT 10 CHARS. LDB PASS SZB,RSS LIST PASS? JMP *+3 NO ADA ...1+3 (4) SET UP FOR HEADER ADA HED aCMA,INA STA DSIG SET CHAR COUNT JSB WRITF GO TO PRINT THE HEADER DEF *+5 DEF DCBL DEF ?ERR ERROR CODE .HEAD DEF HEADP HEADER LOC'N DEF DSIG COUNT SSA,RSS ERRORS? JMP SKPLN NO, SKIP LINES JSB ?FMPE FMP ERROR ROUTINE DEF AL+1 LIST FILE SKPLN LDA .2 PREPARE TO JSB LINS SKIP 2 LINES. I JSB WRITF GO OUTPUT A LINE DEF *+5 DEF DCBL DEF ?ERR ERROR CODE PRLOC NOP BUFFER ORIGIN DEF SAVB CHARACTER COUNT SSA,RSS ERRORS? JMP PRNT,I NO EXIT JSB ?FMPE FMP ERROR ROUTINE DEF AL+1 LIST FILE JMP PRNT,I PRINT EXIT * * ODDCN STA SAVB SAVE WORD COUNT ADB A POINT TO LAST WORD IN BUFFER LDA B,I AND GET CONTENTS AND B1774 MASK UPPER BYTE IOR BLNK INSERT BLANK IN LOW BYTE STA B,I RESTORE WORD LDA SAVB GET WORD COUNT INA BUMP UP JMP STWCN AND SET IT B1774 OCT 177400 SKP * ******************* * * SET UP A HEADER * * ******************** HEDSB NOP LDA SCN1+2 SZA,RSS HEADER PRESENT? JMP HXD NO-RETURN ADA ..M1 CMA,INA ADA SCN1 STA HED HEADER LENGTH IN 'HED' LDB .64 ADA .M65 -65 SSA,RSS IS HEADER TOO LONG (MORE THAN 64 CHARS) STB HED SET HEADER LENGTH TO 64 LDA SCN1+2 JSB GETA GET ADDRESS OF HEADER LDA HED STB *+3 LDB HXD. GET L(HEDR+9) JSB MOVE NOP ADDR OF HEADER LDA HED ADA ...1+1 SLA,ARS CONVERT TO WORD COUNT JMP ODCNT ODD # CHARS HXD STA HED JMP HEDSB,I ODCNT STA HED LDB .HEAD ADB A LDA B,I IOR BLNK STA B,I ISZ HED JMP HEDSB,I .64  DEC 64 .M65 DEC -65 HXD. DEF HXBUF LOCATION OF HEADER ICSA DEF ASCI LOC'N OF ASCI BUFFER * ************************** * * PRINT ERROR DIAGNOSTIC * * ************************** DEF IOBF+5 ERPR NOP ISZ ERRCN BUMP ERROR COUNTER LDB BLNS STA IOBF+5 ERROR DIAG. STB IOBF+6 BLANKS STB IOBF+9 BLANK OUT RELOC INDIC. LDA SEQN CCE JSB BNCN CONVERT TO ASCII OCTAL LDA ASCI+1 FOR USE IN STA IOBF+7 THE LDA ASCI+2 DIAGNOSTIC STA IOBF+8 JSB PRPAG GO PRINT PREVIOUS PAGE NO. LDA SCN1 GET STATEMENT LENGTH ADA LPDG+3 (+10) LDB ERPR-1 GET STATE,ORIGIN (IOBF+5) JSB PRNT PRINT THE MESSAGE. JMP ERPR,I EXIT SKP * *PRINT PREVIOUS PAGE CONTAINING ERROR ** * PRPAG NOP USED IN 'ERPR' AND 'ENDSB' LDA .2 SET UP TO EMIT A BLANK LINE LDB .SPCE ADDRESS OF SPACE JSB PRNT GO TO PRINT ROUTINE LDA LINC GET CURRENT LINE VALUE CPA ..M1 IS IT SET FOR A PAGE EJECT? JMP *-5 YES, GO OUTPUT ANOTHER BLANK LIN LDB PASS LDA TAPE GET SOURCE TAPE NO. SZB FIRST PASS? LDA PRERR GET PREVIOUS PAGE(=0 IF 1ST ERR) CCE JSB BNCN CONVERT PAGE OR TAPE TO DECIMAL LDA .TNO GET ' #' LDB PASS SZB FIRST PASS? LDA .PG GET "PG" FOR PAGE POINTER STA ASCI SET IN '**' LDA ASCI+1 AND .2077 MAKE 1ST DIGIT BLANK STA ASCI+1 LDA .1+5 GET PARAM FOR 6 CHARS LDB ICSA BUFFER ORG JSB PRNT GO PRINT "**PAGE" OR " #TAPE" LDA LINC1 GET CURRENT PAGE NUMBER. STA PRERR SET PREV. PAGE = CURRENT PAGE. JMP PRPAG,I EXIT .PG ASC 1,PG SPACE ASC 1, .SPCE DEF SPACE .2077 OCT 20077 * **************/************************ * * PRINT ERROR COUNT AT END OF A PASS * * * SPACE TO BOTTOM OF PAGE * * * INIT.LINE,ERROR AND SEQUENCE CNTRS* * * SET CONTROL STATEMENT FLAG = -1 * * ************************************** ENDSB NOP LDB PASS SZB,RSS FIRST PASS? JMP GETER YES, BYPASS MESSAGE CHANGE. DLD TOTAL NO. CHANGE MESSAGE DST PAU+7 FROM: LDA TOTAL+2 "PASS#1" STA PAU+9 TO: "*TOTAL". GETER LDA ERRCN GET CURRENT ERROR COUNT. ADA ?ENER INCLUDE ENTRY POINT ERRORS, IF ANY. STA ERRCN UPDATE TOTAL ERROR COUNT. SZA,RSS ANY ERRORS? JMP ENDSR NO ERRORS.. LDB PASS SZB FIRST PASS? JSB PRPAG NO, PUT OUT THE PAGE POINTER LDA ERRCN GET THE TOTAL ERROR COUNT CCE JSB BNCN CONVERT TO ASCII OCTAL LDA ASCI+1 LDB ASCI+2 JMP *+3 ENDSR LDA BLNS * * * 'NO'ERROR SETUP * * LDB .NO FOR 'NO' ERRORS STA PAU+1 STB PAU+2 LDA L1 (34) NO OF CHARS IN MESSG. LDB PAU-1 BUFF ADDR JSB PRNT PRINT DIAG. JSB OKOLE STA ASM1 SET CONT.STATE.FLG CLA,INA SET A=1 STA TAPE SET TAPE COUNTER = 1 JMP ENDSB,I EXIT END SUBROUTINE * DEF PAU LOC OF PASSOVER STATE. * PAU EQU * ESTABLISH START OF MESSAGE. * ASC 17,**0000 ERRORS PASS#1 - RTE ASMB** TOTAL ASC 3,*TOTAL * L1 DEC 34 * ?PERL DEF *+1 ?BASF NOP BASE PAGE FLAG. ?BPSV NOP HIGHEST BASE PAGE VALUE. REP NOP REPEAT COUNTER REQ NOP FLAG FOR 1ST STATE AFTER REP LST NOP LST/UNL FLAG LTFLG NOP LITERAL FLAG(0=NO LIT.) ORRSV NOP =0 IN REG. PROG;=-1 IN ORG SECTN ORRS NOP SAVE LAST PLCN VAL FOR ORR SET ORGSV NOP HIGHEST PLCN VAL IN AN ORG SECTN PRERR NOP PREV. PAGE # CONTAINING ERROR. SUP NOP SUP/UNS FLAG IFUSE NOP =1, SKIP ASSMBL.; =-1, IN 'IF' RANGE SEQN NOP SEQUENCE COUNTER ?LPER ABS *-?PERL-1 LENGTH OF AREA TO BE CLEARED * * SKP * *********************************** * * SPACE TO BOTTOM OF CURRENT PAGE * * * (USED BY HED AND PROC.ABOVE) * * *********************************** OKOLE NOP CLB SET B=0 LDA LINC LINE COUNT - INA,SZA =-1 ? LDB PLINE NO, SET B=STAN.LINE COUNT CPB PCOMP TTY OUT?(IF COUNT=-1, WON'T COMP) JSB LINS NO-GO TO PAGER CCA STA LINC SET LINC = -1 JMP OKOLE,I EXIT * * * PICK UP NEXT CHAR, ADD 1 TO PNTR * * PKUP NOP LDA PNTR JSB GETC ISZ PNTR JMP PKUP,I * * * SEARCH FOR NON-BLANK CHAR, SET PNTR AT IT * * BPKUP NOP JSB PKUP CPA BLNK BLANK? JMP *-2 YES - GET NEXT CHAR. LDB PNTR NO - SET PNTR TO LAST NON-BLANK ADB ..M1 STB PNTR JMP BPKUP,I * ***************************** * * PUNCH AND SET UP FOR LIST * * ***************************** LOUT NOP CLA 0 TO A CLB,INB 1 TO B CPB PASS SKIP PUNCH IF IN PASS 1 RSS PASS 2, SO PUNCH. JMP PLST PASS 1 SO PREPARE FOR LIST. CPA AFLAG ABSOLUTE ASSEMBLY ? JMP RLREC NO, GO PROCESS RELOC. RECORD. JSB ?AREC YES,GO TO ABS REC. PROCESSOR. RSS SKIP TO PREPARE FOR LIST. RLREC JSB ?BREC GO TO RELOC. REC PROCESSOR. PLST CLA 0 TO A LDB BLNS BLANKS TO B JMP LOUT,I EXIT * SKP * * GET HIGHEST CURRENT LOCATION VALUE FOR 'ORG' PROCESSING. * ORGST NOP LDA ORGSV LAST ADDR. GENERATED DURING [HFBORG CMA,INA ADA 1 "A" REGISTER _ LAST 'PLCN' VALUE SSA,RSS GREATER ? STB ORGSV NO. USE 'PLCN' VALUE FOR HI ORG CLA,INA "A" = 1 JMP ORGST,I RETURN. * * ***************** * * ORB PROCESSOR * * ***************** ORBP NOP LDA AFLAG SZA,RSS RELOCATABLE ASSEMBLY ? JMP XYZ YES. LDA .IL NO - 'IL ERROR ! JSB ERPR JMP ORBP,I RETURN. * XYZ LDB PLCN LDA ?BASF SZA ARE WE IN BASE PAGE ? JMP ORBP,I YES, EXIT. LDA ?BPSV NO, SET PLCN TO STA PLCN LATEST B.P. VALUE ISZ ?BASF SET B.P. FLAG. LDA ORRSV ARE WE IN SZA MAIN PROGRAM ? JSB ORGST NO, SET HIGH PLCN VALUE. SZA,RSS STB ORRS SAVE PLCN. CLA,INA STA ORRSV SET ORRSV = 1 JMP ORBP,I RETURN. * SKP H* **************************** * * PROCESS ARITHMETIC MACRO * * **************************** DEF TEMP+4 HA38 JSB ARTLT GO TO LITERAL PROCESSOR LDA L+6 (PERIOD) STA TEMP+4 LDB HA38-1 =L(TEMP+4) LOWER CMB,INB STB SYMP+1 LOC.OF SYMBOL LDA ...1+3 (4) EXT RELOC CODE STA SYMP NO.OF CHARS. LDB PASS SZB JMP ?ART GO TO ARITH('ART') ROUTINE LDB CNTR EXT.NUMBER JSB ?INSR INSERT INTO SYMBOL TABLE RSS ERROR- SKIP NEXT ISZ CNTR BUMP EXT CNTR LDA .1+1 2 JMP ?HA3Z * ************************** * * MEASURE LITERAL LENGTH * * ************************** MSYML NOP LDA SCN1+2 GET OPERAND POSITION STA SAVB SPC 1 * * SET UP AND TEST NEXR CHARACTER ISZ SAVB SAVB = OPDRND POS'N+1 LDA SAVB GET CURRENT POSITION JSB GETC GET THE CHATACTER CPA BLNK IS IT A SPACE? RSS YES, END OF LITERAL JMP *-5 NO, GO EXAMEINE THE NEXT CHARACT. LDB SCN1+2 GET STARTING POSITION CMB,INB COMPLEMENT IT. ADB SAVB RESULTS IN THE LITERAL LENGTH JMP MSYML,I EXIT * SKP * ******************** * * PROCESS LITERALS * * ******************** PLITS NOP LDA LTFLG LITERAL FLAG CPA .F =F ? JMP PER CPA .A =A ? JMP P.A CPA .L =L? JMP P.L JSB MSYML =B OR D; GET SYMB LNG. LDA LTFLG CPA .B =B? JMP *+6 YES CPA .D =D? JMP *+3 YES PER JSB OPERR 'M' ERROR JMP PLITS,I EXIT ADB .400B LDA SCN1+2 JSB ASCN CONVERT TO BINARY JMP PLITS,I ERROR RETURN P.1 STA ASCI LDA ...1+1 STA SYMP LDA PASS SZA PASS 1 ? JMP *+4 NO JSB ?LITI YES, INSERT LIT.INTO SYMBOL TABL JMP PLITS,I ERROR RETURN RSS JSB ?LKLI LOOKUP LITERAL IN SYMBOL TABLE ISZ PLITS JMP PLITS,I NORMAL RETURN P.L CLA EXPRESSION PROCESSOR STA LTFLG JSB CHOPI EVALUATE OPERAND JMP PLITS,I ERROR EXIT SZA ABSOL.VALUE? JMP PER NO-ERROR LDA 1 VALUE TO A REG JMP P.1 P.A LDA SCN1+2 JSB GETA STB *+4 ADDR OF OPERAND LDA ...1+1 2 CHARS LDB ICSA GET LOC'N OF ACSI BUFFER JSB MOVE NOP OPERAND ADDR. JMP P.1+1 .A OCT 101 ASCII 'A' .D OCT 104 'D' .F OCT 106 'F' .L OCT 114 'L' SKP * ************************* * * ARITH MACRO PROCESSOR * * ************************* ARTLT NOP LDA LTFLG GET LITERAL FLATG SZA,RSS LITERAL PRESENT? JMP ARTLT,I NO LITERAL, EXIT LDB TEMP+6 STB ARTSV+1 LDB TEMP+5 1ST 2 OPCODE CHARS FOR TEST STB ARTSV CPB .MP MPY? JMP LTAR YES CPB .DI DIV? JMP LTAR YES CPB .DS DST? JMP *+3 YES, ERROR CPA .F =F? FLTG PT LIT PROC JMP LERR+3 JSB OPERR NO,'M'ERROR LERR CLB B=0 CLA,INA A=1 JMP LTAR+2 JSB MSYML PROC.LIT.LNG. ADB .1000 2 TO 'B' UPPER LDA SCN1+2 OPERND PNTR JSB ASCN CONVRT ASCII TO FLTG.PT. JMP LERR ERROR RETURN STA ASCI STB ASCI+1 LDA ...1+3 (4) STA SYMP SET SYMK/INSR PARAMS. LDA PASS SZA,RSS PASS 1 ? JMP *+3 YES JSB ?LKLI NO, LOOKUP LIT. IN SYMBL TABLE JMP LTAR+2 EXIT JSB ?LITI INSERT LITERAL INTO SYMBOL TABLE JMP LTARZ ERz=ROR EXIT(OK) ISZ PLEN JMP LTARZ LTAR JSB PLITS JMP LERR ERROR RETURN STA LTSVA SAVE A STB LTSVB SAVE B LTARZ CLA,INA STA LTFLG SET LTFLG=1 FOR LIT.IN ARITH MACRO. LDA ARTSV SET OPCODE CHARS BACK STA TEMP+5 FOR FURTHER PROCESSING LDA ARTSV+1 STA TEMP+6 JMP ARTLT,I EXIT FROM LIT. PROC. HERE SPC 1 .MP ASC 1,MP .DI ASC 1,DI .DS ASC 1,DS ARTSV OCT 0,0 LTSVA NOP FOR ART USE LTSVB NOP * ******************** * * SETUP FOR REPEAT * * ******************** REPSB NOP LDA REP SZA IN 'REP' RANGE? JMP RXP YES, ERROR JSB CHOPI EVAL NO.OF REP'S JMP RXP+2 ERROR EXIT SZA VAL RELOC? JMP RXR YES, ERROR SZB,RSS VAL=0? JMP RXP+2 YES INB NO. CMB,INB -B TO B LDA ..M1+1 STA REQ SET REQ=-2(FOR SEQNO PROC) RXX STB REP B TO REP (NO.OF REPEATS) JMP REPSB,I RXP LDA .OP 'OP' ERROR(IN RANGE OF 'REP') JSB ERPR CLB 0 TO B (FOR NO REP) JMP RXX RXR JSB OPERR RELC.VAL(ERROR) 'M' JMP RXP+2 * * * SET UP FOR EVALUATION OF OPERAND IN WHICH A COMMA * * IS ILLEGAL. * CHOPI NOP CLA JSB CHOP JMP CHOPI,I ISZ CHOPI JMP CHOPI,I * ************************************* * * GET BREC CODE AND LIST RELOC CHAR * * BREC CODE IN A, LIST CHAR IN B. * ************************************* DCOD NOP LDB BLNS SZA,RSS ABSOLUTE REL.? JMP DCOD,I YES,DONE STA SAVB SAVE RELC CODE CPA ...1+4 IS IT EQU EXT ? ADA ..M1 YES, SET = 4. ADA RC-1 POINT TO CORR.RELC.CHAR. LDB 0,I PICK IT UP LDA BYFLG SZA,RSS LDA SAVB PICK UP RELCG CODE IF NECESSARY. JMP DCOD,I RETURN * * * MOVE CHARS.TO A BUFFER FROM ASCI * * * BUFFER ADDR.IN B REG. * * V NOP LDA ...1+5 JSB MOVE DEF ASCI JMP V,I * * * SET UP AND PRINT 'M' DIAG. FOR OPERAND ERROR * * OPERR NOP LDA .MBLN 'M'= OPERAND ERROR JSB ERPR JMP OPERR,I * ********************************************************************** * * * * GET BUFFER ADDRESS OF ITEM * * * * * ENTER: =CHARACTER POS'N. RELATIVE TO 'BUFF'; =DON'T CARE * * EXIT: =+-CHAR. MEMORY ADDR.; NEG-IN LOWER BYTE,POS-UPPER * * * ********************************************************************** * GETA NOP ADA ..M1 A-1 TO A CLE,ERA ADA FFUB SEZ UPPER ADDR? CMA,INA NO - COMPLEMENT IT. STA 1 A TO B JMP GETA,I * ********************************************************************** * * * * GET AN OPERAND CHAR. * * * * * ENTER: =CHAR. POS'N RELATIVE TO 'BUFF'; =DON'T CARE * * EXIT: =CHAR.(LOWER BYTE); =WORD ADDRESS OF 'TEST' * * 'TEST' = CHARACTER (LOWER BYTE) * * * ********************************************************************** * GETC NOP JSB GETA STB *+5 LDB TS ADDR OF 'TEST' TO B REG CMB,INB CLA,INA SET =1 JSB MOVE NOP (FROM *-5) LDA TEST Xi JMP GETC,I TS DEF TEST * * ************************************ * * MEASURE SYMBOL AND SET * * * SYMP = SYMBOL CHAR COUNT * * * SYMP+1 = SYMBOL POSITION * * ************************************ MSYMS NOP JSB MSYM STA SYMP STB SYMP+1 JMP MSYMS,I * * ***************************** * * SET MEMORY TO GIVEN VALUE * * ***************************** * SETM NOP CMA,INA SET VALUE FOR COUNTER STA DSIG LDA SETM,I GET PARAMETER TO BE STORED IN AREA STA 1,I - PLACE PARAMETER IN MEMORY ISZ 1 ISZ DSIG JMP *-3 ISZ SETM JMP SETM,I SKP *READS SOURCE FROM DISK (IF LUN= 2) OR OTHER DEVICE *CALLING SEQUENCE FOR %READ: JSB %READ * DEF *+4 * DEF BUFR FWA OF READ BUFFER * DEF RLEN -(NO OF CHARS) * EOF RETURN * NORMAL RETURN *RETURNS WITH: (B) = NO.OF CHARS. %READ NOP LDA %READ,I STA EXIT RETURN ADDRESS ISZ %READ LDA %READ LDA 0,I RAL,CLE,SLA,ERA TEST I-BIT AND CLEAR JMP *-2 INDIRECT, GO ON THRU INDIR.CHAIN STA RBFAD FWA OF READ-BUFFER ISZ %READ LDA %READ,I STA RLGTH RECORD-LENGTH ADDR ISZ %READ BUMP RETURN ADDR FOR EOF RETURN * READD EQU * JSB READF READ INPUT(SOURCE) FILE DEF *+6 DEF DCBI DEF ?ERR RBFAD NOP BUFFER ADR RLGTH NOP REC SIZE DEF LENI ACTUAL WORDS READ SSA,RSS TEST FOR READ ERRORS JMP TSTEF NO ERRORS JSB ?FMPE GO TO FMP ERROR ROUTINE DEF AI+1 FILE NAME TSTEF LDA LENI TEST FOR EOF CPA ..M1 -1 = EOF * JMP %READ,I * LDB 0 COUNT MUST BE IN B REG BLS z; CONVERT TO CHARS JMP EXIT,I EXIT * * ASSEMBLY OPTION FLAGS * * EXIT NOP FLAGS DEF *+1 POINTS AT LFLAG LFLAG NOP LIST RFLAG NOP RELOCATABLE ASMBLY(OPTIONAL FLG) TFLAG NOP SYMBOL TABLE PRINT REQ. IFTST NOP CONTAINS 'IF' FLAG(N,Z, OR 0) AFLAG NOP ABSOLUTE ASMBLY. CFLAG NOP CROSS REFERENCE TABLE FLAG ENFLG ABS *-FLAGS-1 END OF FLAGS LENI NOP .110B OCT 1100 HEADP ASC 2, PAG ASCI BSS 3 DEST. OF CONVRTED DEC. NOS. ASCI1 EQU ASCI+1 .TNO ASC 3, # PART OF HEADER HXBUF BSS 32 HEADER BUFFER GTEM BSS 4 TEMP STORAGE FOR 'MOVE' & 'PUNCH' SPC 1 .D. ASC 1,D * * * ?FMPE - ROUTINE TO DISPLAY FMP ERROR & ABORT ASMB * CALLING SEQUENCE: JSB ?FMPE * DEF AI FILE NAME OF FILE BEING ACCESSED * WHEN ERROR OCCURED * A REG = ERROR CODE * * ?FMPE NOP CMA,INA MAKE ERROR CODE +VE STA FMERR SAVE ERROR CODE CCE E REG = 1 FOR DECIMAL JSB BNCN CONVERT ERROR CODE TO ASCII LDA .4 ADDRESS OF SOURCE ASCII BUFFER LDB FMPAD ADDRESS OF TARGET BUFFER ADB .6 SET POINTER TO IT JSB MOVE MOVE ASCII ERROR CODE TO IT DEF ASCI+1 LDA ?FMPE,I GET FILE NAME BUFFER ADDRESS STA MVLOC STORE ADDRESS TO PASS TO MOVE ROUTINE LDA .6 MOVE FILE NAME TO OUTPUT BUFFER LDB FMPAD ADB .9 POINT TO LOC IN OUTPUT BUFFER JSB MOVE MVLOC NOP ADDRESS OF BUFFER JSB IMESS PRINT MESSAGE ON CONSOLE DEF *+4 FMP ERROR -NNNN FILENM DEF .2 DEF FMPER ERROR MESSAGE DEF .12 LENGTH OF MESSAGE JMP ASMEX ABORT THE ASMB * * FMERR NOP FMPER ASC 12,FMP ERROR - FMPAD DEF FMPER * ?POSN - ROUTINE TO POSITION INPUT DEVICE TO THE BEGINING OF * INPUT FILE * CALLING SEQUENCE: JSB ?POSN * * ?POSN NOP JSB CLOSE CLOSE INPUT FILE DEF *+3 DEF DCBI INPUT FILE DCB DEF ?ERR ERROR WORD SSA ERRORS? JMP POSN2 YES JSB OPEN NO, THEN OPEN INPUT FILE DEF *+7 DEF DCBI INPUT DCB DEF ?ERR ERROR WORD DEF AI+1 INPUT FILE DEF OPTNI OPTION WORD DEF AI+5 SECURITY CODE DEF AI DRN OR -LU SSA ERRORS? JMP POSN2 YES, THEN DISPLAY ERROR * JSB LOCF FIND LU# AND TYPE OF INPUT FILE DEF *+9 DEF DCBI SOURCE FILE DCB DEF ?ERR ERROR WORD DEF PTEMP TEMP LOC DEF PTEMP TEMP LOC DEF PTEMP TEMP LOC DEF PTEMP TEMP LOC DEF PTEMP TEMP LOC DEF JTY FILE TYPE SSA,RSS ERROR? JMP POSN1 NO POSN2 JSB ?FMPE FMP ERROR MESSAGE ROUTINE DEF AI+1 INPUT FILE NAME POSN1 LDA JTY SZA TYPE OF FILE = 0 ? JMP ?POSN,I NO, THEN FILE POSITIONED, RETURN * POSN DLD .PASS SEND MESSAGE JSB MESSX /ASMB : $END PASS JSB IMESS SEND MESSAGE DEF *+4 DEF .2 DEF POSIN /ASMB : RE-INPUT SOURCE DEF .12 CLA JSB .PAUS PAUSE FOR USER TO POSITION INPUT DEVICE TO JMP ?POSN,I BEGINING OF INPUT FILE - RETURN * * JTY NOP PTEMP NOP TEMP LOC POSIN ASC 12, /ASMB: RE-INPUT SOURCE .PASS ASC 2,PASS * * SKP * * MAIN ENTRY POINT * * * ASMB JSB RMPAR GET PARAMETERS PASSED BY USER DEF *+2 DEF AI USING FOR TEMP STORAGE DLD AI MOVE ANSWER FILE NAME IN ANSW DST ANSW LDA AI+2 STA ANSW+2 LDA AI+3 # OF LINES PER PAGE STA PLINE SAVE IT SZA,RSS IS IT 0? JMP DFLT YES, THEN USE DEFAULT VALUE ADA .M56 IS IT LESS THAN 55? SSA,RSS  JMP DFLT NO, THEN USE DEFAULT OF 55 LINES PER PAGE LDA PLINE YES, ADD 1 AND NEGATE IT CMA,INA STA PLINE PLINE HAS -(#LINES/PAGE+1) JMP ASMB3 DFLT LDA .M56 DEFAULT IS 55 LINES PER PAGE STA PLINE PLINE HAS -(56+1) * * INITIALIZATION SECTION ** * ASMB3 CCA STA LINC STA ASM1 ADA .VSTP VSTOP DEF VAL0S - 3 STA VSTOP NOT LEGAL TO ASSEMBLE,MUST BE COMPUTED LDA .UVAL STA UVAL LDA ENFLG # OF WORDS TO BE CLEARED LDB FLAGS STARTING ADDRESS OF BUFFER JSB SETM SET MEMORY TO 0 OCT 0 LDA ?LPER # OF WORDS TO BE CLEARED LDB ?PERL STARTING ADDRESS OF BUFFER JSB SETM SET MEMORY TO OCT 0 ZERO LDA ENCLR # OF WORDS TO BE CLEARED LDB .CLR BEGINNING OF AREA TO BE CLEARED JSB SETM SET MEMORY TO OCT 0 ZERO CLA LDB .NAMI CLEAR PART OF COMMON AREA COMCL STA B,I STORE 0 IN COMMON WORD CPB .ENTV DONE? JMP ASMB4 YES INB NO THEN CLEAR NEXT WORD JMP COMCL ASMB4 INA A REG = 1 STA CNTR STA TAPE * JSB GTFIL GET FILE NAMES DEF *+7 RETURN ADR DEF .25B OPTION WORD DEF ?ERR ERROR CODE DEF ANSW ANSWER FILE DEF AI INPUT FILE DEF AO OUTPUT FILE DEF AL LIST FILE SSA,RSS ERRORS? JMP ASMB1 NO JSB ?FMPE PRINT ERROR MESSAGE AND ABORT DEF ANSW ANSWER FILE NAME * ASMB1 LDA AL+1 LIST FILE IS AN LU#? CPA .LU "LU"? RSS YES JMP NOTLU NO LDA AL+2 COMPARE NEXT TWO CHARS CPA ... IS IT ".."? JMP LU YES, THEN LIST FILE IS LU# NOTLU CLA LSTLU FLAG IS 0 STA LSTLU JMP TSOUT TEST OUTPUT FILE LU CLA,INA LSTLU FLAG = 1 N STA LSTLU * TSOUT LDA AO+1 IS OUTPUT FILE AN LU#? CPA .LU IS IT "LU"? RSS YES JMP NOUTL NO, THEN NOT AN LU LDA AO+2 GET WORD 2 OF OUTPUT FILE NAME CPA ... IS IT ".."? JMP LUOUT YES, THEN OUTPUT FILE IS AN LU# NOUTL CLA OUTLU FLAG = 0 STA OUTLU JMP ASMB2 * LUOUT CLA,INA OUTLU FLAG = 1 STA OUTLU * ASMB2 CLB STB ANSW CLEAR ANSW BUFFER STB ANSW+1 STB ANSW+2 * LINE COUNT SET TO DEFAULT * SYMTB JSB LIMEM GET MEMORY LIMITS FOR SYMBOL TAB DEF *+4 RETURN ADR DEF IWHCH GET MEMORY OPTION DEF ?FWA FIRST WORD AVAIL MEMORY DEF IWRDS LENGTH OF AVAIL MEMORY * LDA IWRDS # OF WORDS AVAILABLE=0? SZA,RSS JMP SYMOV YES, SEND SO ERROR MESSAGE LDA ?FWA STA X STA Z ADA M1 -1 ADA IWRDS LAST WORD AVAIL = 1ST + LN - 1 STA ?LWA SAVE IT FOR USE IN SEGMENTS STA ?NDOP SET START OF SUPPLEMENTAL OPCODES. CLA STA ?NDOP,I CLEAR START OF SUPPLEMENTAL TABLE. LDA .D. GET CHAR TO LOAD THE DATA JMP SEGMT GO LOAD THE DATA SEGMENT * SYMOV LDA .SO 'SO' FOR SYMBOL TABLE OVERFLOW LDB BLNS BLANKS JSB MESSX SEND ERROR MESSAGE JMP ASMEX ABORT ASSEMBLER .25B OCT 25 .M56 DEC -56 M1 DEC -1 .SO ASC 1,SO IWHCH NOP IWRDS NOP ?FWA NOP ?LWA NOP LAST WORD ADDR. OF AVAIL. MEMORY PLINE NOP LINE COUNT ANSW BSS 3 .CLR DEF *+1 START OF AREA TO BE CLEARED X NOP Z NOP ?NDOP NOP POINTS TO SUPPLEMENTARY OPCODES ?NDSY NOP POINTS TO END OF SYMBOL TABLE AI BSS 6 AL BSS 6 AO BSS 6 MFLAG NOP SUPPLEMENTAL-OPCODE-TABLE FLAG XORD NOP TEMP STORAGE: EXTERNAL ORDN'L NO. SCNT NOP NAGATIVE CHARACTER COUNT FOR 'SYMTS' SERR NOP  ILLEGAL CHAR. FLAG (0=OK 1=INVALID CHAR.) SALU NOP TEMPORARY FOR NAME ADDR. COUNTER LINC1 NOP PAGE CNTR PCOMP NOP =0 IF PRINTER, =-56 IF TTY HED NOP HEADER FLAG (LENGTH) ?ENER NOP 'ENT' ERROR COUNT STORAGE ERRCN NOP ERROR COUNTER ENCLR ABS *-.CLR-1 END OF AREA TO BE CLEARED TAPE OCT 1 COUNT SOURCE TAPES CNTR OCT 1 EXT COUNTER, FOR PASS 1 LINC OCT -1 LINE CNTR ASM1 OCT -1 CONTROL STATE FLAG DCBI BSS 144 DCBO BSS 144 DCBL BSS 144 ?ERR NOP OPTNI OCT 410 OPTNO OCT 110 OPTNL OCT 210 LSTLU NOP OUTLU NOP .LU ASC 1,LU ... ASC 1,.. B EQU 1 * * SPC 1 ?AFLG EQU AFLAG ?ARTL EQU ARTLT ?ASCI EQU ASCI ?ASCN EQU ASCN ?ASII EQU ASCI1 ?ASM1 EQU ASM1 ?ASMB EQU ASMBX ?BNCN EQU BNCN ?BPKU EQU BPKUP ?CHOP EQU CHOP ?CHPI EQU CHOPI ?CNTR EQU CNTR ?DCOD EQU DCOD ?ENDS EQU ENDSB ?ERPR EQU ERPR ?FLGS EQU FLAGS ?GETA EQU GETA ?GETC EQU GETC ?HA38 EQU HA38 ?ICSA EQU ICSA ?LFLG EQU LFLAG ?LINC EQU LINC ?LINS EQU LINS ?LIST EQU LIST ?LOUT EQU LOUT ?LST EQU LST ?LSTL EQU LISTL ?LTFL EQU LTFLG ?LTSA EQU LTSVA ?LTSB EQU LTSVB ?MESX EQU MESSX ?MOVE EQU MOVE ?MSYM EQU MSYM ?MSYS EQU MSYMS ?OKOL EQU OKOLE ?OPER EQU OPERR ?OPLK EQU OPLK ?ORGS EQU ORGSV ?ORRP EQU ORRP ?PCOM EQU PCOMP ?PKUP EQU PKUP ?PLIN EQU PLINE ?PLIT EQU PLITS ?PNCH EQU PNCH ?PRNT EQU PRNT ?PRPG EQU PRPAG ?RFLG EQU RFLAG ?RSTA EQU RSTA ?SEGM EQU SEGMT ?SETM EQU SETM ?SUP EQU SUP ?SYMK EQU SYMK ?SYML EQU MSYML ?SYMT EQU SYMTS ?TFLG EQU TFLAG ?V EQU V ?X EQU X FWA AVAIL. FOR RELOCAT. ASS'YS. ?Z EQU Z FWA AVAIL. FOR ABSOLUTE ASS'YS. SKP * **************************** * * TEMPORARY AND FLAG REGION* * **************************** # EQU TEMP SAME AS DATA ORIGIN SPC 1 VAL0 EQU TEMP+1 ASCN - MOST SIGNIFICANT 1/3 VAL0S EQU TEMP+2 ʾ ASCN VAL1 EQU TEMP+3 ASCN - MIDDLE 1/3 VAL1S EQU TEMP+4 ASCN VALU EQU TEMP+5 ASCN - LEAST SIGNIFICANT 1/3 VALUS EQU TEMP+6 ASCN DCNT EQU VAL1S ASCN PASCN EQU TEMP+2 NUMBER PNTR SAVE(CHOP) ...1 EQU TEMP+7 .1 EQU ...1 .12 EQU .1+7 ..M1 EQU .12+6 L EQU ..M1+6 ..M2 EQU TEMP+21 ..M6 EQU TEMP+25 .13 EQU TEMP+15 .7 EQU TEMP+13 .6 EQU TEMP+12 .4 EQU TEMP+10 .2 EQU TEMP+8 .9 EQU #+41B .M8 EQU #+43B .M15 EQU #+44B BLNK EQU #+46B =40B(LOWER BLANK) .IL EQU #+47B .MBLN EQU #+50B .NO EQU #+51B .OP EQU #+52B .OV EQU #+53B .UN EQU #+54B .1000 EQU #+57B BIT15 EQU #+60B .E EQU #+61B .B EQU #+62B RC EQU #+64B .NAMI DEF NAMI NAMI EQU #+71B LOC'N FOR TEMP SYMBOL STORAGE NAME EQU #+72B FOR USE BY 'OPLK' * * FOLLOWING 5 LOC'S ARE CLEARED IN CHOP ROUTINES * RELC EQU #+76B RELOCATION FLAG SIGN EQU #+77B SUMP EQU #+100B RUNNING SUM FOR 'CHOP' TERM EQU #+101B NO. OF TERMS IN AN OPERAND T EQU #+102B BYFLG EQU #+104B BYTE FLAG FOR 'BREC' FLEX EQU #+105B 'ASCN' MODE EQU FLEX CNTB EQU #+106B CODE EQU #+107B OPCODE TYPE(FROM OPTABLE) DSIG EQU #+110B 'ASCN' FLAG EQU #+111B FLAQ EQU #+112B INST EQU #+113B OPCODE FORMAT LAST EQU #+114B PASS EQU #+115B PASS FLAG(0=PASS 1 AND 1=PASS2) PEEK EQU #+116B LAST CHAR PICKED UP PLCN EQU #+117B PROGRAM LOCATION COUNTER PLEN EQU #+120B LIT LENGTH PASS 1/LIT ORG PASS 2 PNTR EQU #+121B POINTS AT LAST OR CURRENT CHAR. SAVB EQU #+123B SCN1 EQU #+125B STATE LNG/OPCODE/OPERAND/LABEL(4) SYMI EQU #+132B ADDR CNTR FOR SYMBOL TBL (SYMK) FEXP EQU SYMI SYMP EQU #+133B SYMBOL LNG/ AND LOC'N TEST EQU #+135B TEST CHARACTER ENT. EQU #+137B ENTC EQU #+140B ENTV EQU #+141B .ENTV DEF ENTV DEXP EQU ENT. CNVT EQU ENTC ASCN SDSIG EQU ENTV ASCN - SAVE SIGN OF MANTISSA DFCNT EQU ENTV * * I/O STATEMENT BUFFER * IOBF EQU #+142B 50 WOR|HFBDS + END OF STATEMENT BUFF * * INPUT BUFFER 'BUFF' STARTS IN 11TH WORD * BUFF EQU IOBF+12B PBUF EQU #+225B 60 WORD PUNCH BUFFER A EQU 0 SPC 1 END ASMB yH 9 92064-18128 1650 S C0222 &MAS10 RTE-M ASSEMBLER SEGMENT 1             H0102 DASMB,R,L,C HED ** RTE-M ASMB - SEGMENT 1 ** * * * 9/24/76 * ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAME : ASMB1 * SOURCE: 92064-18128 * RELOC : 92064-16041 * PRGMR : C.H., H.C., S.K. * NAM ASMB1,5,99 92064-16041 REV.1650 761001 * SUP ENT ASMB1 ENT ?LITI,?CMQ,?INSR,?HA3Z,?ENP,?EXP * EXT ?RSTA,?ERPR,?MOVE,?CHPI,?OPER,?PLIT,?ORGS EXT ?ASCN,?BPKU,?MSYM,?PKUP,?SYMK,?CHOP,?ENDS EXT ?MSYS,?SEGM,?PNCH,?V,?X,?POSN EXT ?ICSA,?TFLG,?LTFL,?CNTR EXT ?ARTL,?ASM1,?ORRP,?BNCN,?DCOD,?PRNT EXT ?LABE EXT ?OPLK,?NDOP,?NDSY,?ENER,?PRPG EXT ?BPSV,?GETA,?GETC,?SYMT * COM TEMP(322B) **************************** * # EQU TEMP SAME AS DATA ORIGIN VAL0 EQU TEMP+1 'ASCN' AND 'SYMK' DCNT EQU TEMP+4 ...1 EQU TEMP+7 .1 EQU ...1 .4 EQU TEMP+10 .5 EQU TEMP+11 .12 EQU .1+7 ..M1 EQU .12+6 .M2 EQU TEMP+21 L EQU ..M1+6 .9 EQU #+41B .29 EQU #+42B .M8 EQU #+43B .M15 EQU #+44B .M29 EQU #+45B BLNK EQU #+46B =40B(LOWER BLANK) .IL EQU #+47B .MBLN EQU #+50B .NO EQU #+51B BLNS EQU #+55B BIT15 EQU #+60B .E EQU #+61B .B EQU #+62B NAMI EQU #+71B LOC'N FOR TEMP SYMBOL STORAGE NAME EQU #+72B FOR USE BY 'OPLK' SUMP EQU #+100B RUNNING SUM FOR 'CHOP' CFRA EQU #+105B 'ASCN' CNTB EQU #+106B CODE EQU #+107B OPCODE TYPE(FROM OPTABLE) FLEX EQU CFRA (ASCN) INST EQU #+113B OPCODE FORMAT LAST EQU #+114B PEEK EQU #+116B LAST CHAR PICKED UP PLCN EQU #+117B PROGRAM LOCATION COUNTER PLEN EQU #+120B LIT LENG{TH PASS 1/LIT ORG PASS 2 PNTR EQU #+121B POINTS AT LAST OR CURRENT CHAR. SCN1 EQU #+125B STATE LNG/OPCODE/OPERAND/LABEL(4) SYMI EQU #+132B ADDR CNTR FOR SYMBOL TBL (SYMK) SYMP EQU #+133B SYMBOL LNG/ AND LOC'N TEST EQU #+135B TEST CHARACTER ENT. EQU #+137B ENTC EQU #+140B ENTV EQU #+141B * * I/O STATEMENT BUFFER * IOBF EQU #+142B 50 WORDS + END OF STATEMENT BUFF * *(INPUT BUFFER 'BUFF' STARTS IN 11TH WORD)* BUFF EQU IOBF+12B PBUF EQU #+225B SAVES THE 'NAM' RECORD INFO. WCNT EQU PBUF WORD(BLK) CNT FOR BIN.RECRD. SPC 1 ASCN EQU ?ASCN BPKUP EQU ?BPKU CHOP EQU ?CHOP CHOPI EQU ?CHPI CNTR EQU ?CNTR ERPR EQU ?ERPR GETA EQU ?GETA GETC EQU ?GETC LTFLG EQU ?LTFL MOVE EQU ?MOVE MSYM EQU ?MSYM MSYMS EQU ?MSYS OPERR EQU ?OPER ORGSV EQU ?ORGS PKUP EQU ?PKUP PNCH EQU ?PNCH RSTA EQU ?RSTA SYMTS EQU ?SYMT X EQU ?X SPC 1 ASMB1 JSB RSTA LDA CODE CPA .12+3 'HED' STATE? JMP IXH YES STA ?ASM1 CLEAR 'CS' AND 'INIT' FLAGS CPA .12+1 (13) NAM ? JMP HI12 * * * NO NAM OR ORG * * LDA .NO 'NO'= NO ORG OR NAM STATEMENT JSB ERPR JMP HA32+1 IXH JSB INST,I GO TO HEDSB JMP ASMB1 * * * * PROCESS NAME FOR BINARY RECORD * * PNSAV OCT 0,0 FOR USE IN 'NAM' SETUP HI12 LDB SCN1+2 JSB MSYM MEASURE THE NAME STB HI14 STA PNSAV SAVE # OF CHARS IN THE PARAMETER LDB TEST GET CONTINUATOR STB PNSAV+1 AND SAVE IT LDB CSAD JSB MOVE MOVE IT TO THE 'NAM' RECORD HI14 NOP LDA PNSAV+1 GET THE CONTINUATOR CPA L+4 COMMA?(ANOTHER PARAMETER?) RSS YES JMP HI16 NO - GO TEST FOR END LDA PNSAV GET # OF CHARS IN CURRENT PARAME ADA PNTR INA STA PNTR SET POINTER TO NEXT PARAMETER JSB BPKUP SCAN TO NEXT PARAM. 0_ JSB MSYM MEASURE IT STA PNSAV SAVE # OF CHARS IN THE PARAMETER ALF,ALF INA FOR DECIMAL CONV ALF,ALF POSITION IT STA 1 PARAM. FOR 'ASCN' TO 'B' REG. LDA TEST GET CONTINUATOR STA PNSAV+1 AND SAVE IT LDA PNTR GET POSITION OF NUMBER JSB ASCN GO CONVERT THE NUMBER CLA ERROR RETURN, SET 'A' =0 STA PBF9,I ISZ PBF9 JMP HI14+1 PBF9 DEF PBUF+9 HI16 CPA BLNK LEGAL? RSS YES JSB OPERR NO - PRINT 'M' ERROR LDA PBUF+9 SZA,RSS IS TYPE=0(SYSTEM)? STA PBUF+10 YES, SET PRIORITY = 0. SPC 1 * * EXTENDED NAM RECORD PROCESSOR * SPC 1 LDA PNSAV GET # OF CHARS. IN CURRENT PARAM. ADA PNTR INA SET POINTER TO NEXT PARAMETER. STA PNTR SAVE FOR BUFFER MOVE. CMA,INA COMPUTE THE NUMBER OF ADA SCN1 ADDITIONAL CHARACTERS, IF ANY. SSA,INA MORE ? JMP HA32 NO. STA PNSAV YES. SAVE CHARACTER COUNT. LDA PNTR RELATIVE POINTER TO START JSB GETA OF NAM RECORD EXTENSION STB SRCAD SOURCE BUFFER. LDA PNSAV GET NUMBER OF CHARACTERS, LDB DSTAD AND DESTINATION ADDRESS JSB MOVE FOR DATA MOVE. SRCAD NOP LDA PNSAV CONVERT NUMBER OF INA CHARACTERS TO ARS NUMBER OF WORDS. ALF,ALF POSITION TO UPPER BYTE. ADA WCNT COMPUTE TOTAL NAM-REC WORD COUNT STA WCNT SAVE FOR PUNCH ROUTINE. * SKP HA32 JSB RSTA GO TO GET NEXT STATEMENT. LDA CODE GET OPCODE IDENTIFIER. CPA .12 IS IT THE 'END' STATEMENT ? JMP HB00 YES, GO TO 'END' PROCESSOR. CPA BLNK (40B) SUP/UNS? JMP HA32 IGNORE-PASS #1. CPA .32B REPLACEMENT CODE ? JMP HA71 YES, GO TVeO RPL PROCESSOR. CPA .100B USER MICROCODE (MIC)? JMP MIC YES, GO PROCESS. ADA ..M1+2 (-3) SSA ORR/ORB/ORG ? JMP HA64 YES, ROUTE TO PROCESSOR. CPA .12B NAM? JMP HA63 YES, ERROR ADA ..M1+2 (-3) SSA 'COM','ENT' OR 'EXT' ? JMP INST,I JUMP TO ROUTINE DESIGNATED IN INST CPA ...1+4 'EQU'? JMP HA56 TO EQU CPA .9 (11B) HED? JMP HA32 IGNORE-PASS #1. CPA .12 (14B) SKP? JMP HA32 IGNORE-PASS #1. CPA .12+1 (15B) SPC? JMP HA32 IGNORE-PASS #1. CPA .12+2 (16B) LST/UNL? JMP HA32 IGNORE-PASS #1. * * * TEST FOR LABEL FIELD * JSB LABEL LDA CODE OPCODE INDICATOR CPA DEX JMP HA40 IT'S A 'DEX' CPA BYT IS IT A 'BYT'? JMP HA40 YES, GO PROCESS. CPA .29 REP? JMP HA64 YES CPA ...1+6 (7) JMP HA54 TO ASC CPA .26B INTEGER ARITH(HARDWARE)? JMP HA70 YES.... CPA ...1+5 (6) ARITH MACRO? JMP INST,I YESM JUMP TO PROCESS IT.. ADA .M10 -10 SSA OCT OR DEC? JMP HA40 YES. SZA,RSS BSS? JMP HA3M TO BSS PROCESSOR. CPA ...1+3 (4) MEM REF? JMP HA3L YES,TEST FOR LITERAL LDA CODE GET OPCODE I.D. NUMBER. ADA M100B SUBTRACT 100 OCTAL. SSA,RSS CODE <100B ? JMP XMIC NO, IT'S A MICROCODE MACRO. HA3B CLA,INA TO ADD 1 TO PLCN * * * INCREMENT PROGRAM LOCN. CNTR. * * HA3Z ADA PLCN ADD CURRENT LOC'N. STA PLCN SAVE NEW PROG. LOC'N COUNT. JMP HA32 GO TO GET NEXT STATEMENT. .26B OCT 26 FOR HARDWARE ARITHMETIC SPC 1 * * PROCESS BSS * * HA3M JSB CHOPI EVALUATE OPERAND. JMP HA32 * ERROR *  LDA 1 B TO A JMP HA3Z GO UPDATE PROG. LOC'N COUNT. HA3L LDA LTFLG SZA,RSS LITERAL PRESENT ? JMP HA3B NO LDA INST SLA IS LITERAL LEGAL WITH INST? JMP *+3 YES JSB OPERR NO 'M' ERROR JMP HA3B JSB ?PLIT PROCESS LITERAL NOP IGNORE ERROR JMP HA3B * .12B OCT 12 .32B OCT 32 .100B OCT 100 M100B OCT -100 .M10 DEC -10 BYT OCT 43 OPCODE I.D. NO. FOR 'BYT' DEX OCT 25 OP TYPE FOR 'DEX' CSAD DEF PBUF+3 POINTS AT PUNCH BUFFER DSTAD DEF PBUF+17 ADDR: NAM EXTENSION BUFFER. ENFLG NOP FLAG FOR PROCESSING ENTRY POINTS S BSS 1 * SKP * * PROCESS 'COMMON' DECLARATION * * CMQ LDA SCN1+2 STA PNTR SET POINTER STA TEST SET TEST (U) = 0. CMQA LDB PNTR JSB SYMCK GO TO CHECK FOR VALID SYMBOL. JMP HA32 ** ERROR ! GO TO GET NEXT STATEMENT. LDB PBF10,I SAVE CURRENT COM. LOC'N STB S FOR SYMBOL TABLE VALUE. LDB TEST GET CHARACTER FOLLOWING THE SYMBOL. CPB L+4 COMMA? JMP HM2 YES CPB BLNK END OF OPERAND ? JMP HM2 YES, IT'S = BLANK CPB L LEFT PAREN? RSS YES, = ( JMP HA55+1 NO. ERROR: 1ST PASS JSB BPKUP SKIP BLANKS STB TEMP+1 SAVE POINTER JSB MSYM MEASURE COM LENGTH STA TEMP SAVE NUMBER OF CHARACTERS JSB SPNTR ALIGN POINTER LDA TEST CPA L+1 RT PAREN? RSS YES, = ) JMP HA55+1 NO. 1RST PASS ERROR! STA PEEK LDB TEMP LDA LAST ADB ..M1 LENGTH-1 TO B REG CPA .B =B? (OCTAL VALUE) RSS YES-SKIP ADB .401B NO, SET FOR DECIMAL LDA TEMP+1 JSB ASCN GO TO ASCII CONVERSION ROUTINE JMP HA32 ERROR EXIT ADA PBF10,I BUMP LENGTH OF OOMMON STA PBF10,I * * * INSERT 'COMMON' SYMBOL INTO TABLE * HM3 LDA ...1+2 SET RELOC=COMMON LDB S VALUE TO B JSB INSR INSERT SYMBOL NOP ERROR EXIT LDA PEEK CPA BLNK BLANK? JMP HA32 YES, EXIT TO HA32 CPA L+4 COMMA? RSS YES JSB PKUP GET NEXT CHAR JSB ENDTS TEST FOR TERMINATION JMP CMQA HM2 ISZ PBF10,I STB PEEK SAVE TEST JMP HM3 * * PROCESS 'EXT' DECLARATION * EXP LDA SCN1+2 STA PNTR SET POINTER EXPA LDB PNTR JSB SYMCK GO TO CHECK FOR VALID SYMBOL. JMP HA32 ** ERROR: INVALID SYMBOL ! LDB CNTR VALUE TO B LDA ...1+3 (4) EXT INDIC. JSB INSR GO TO INSERTION ROUTINE JMP *+2 ERROR EXIT ISZ CNTR BUMP EXT CNTR LDA TEST JSB ENDTS TEST FOR TERMINATION JMP EXPA GO BACK, THERE'S ANOTHER 'EXT'!! * * * PROCESS 'ENT' DECLARATION * ENP LDA .10B SET ENFLG = 10B STA ENFLG LDA SCN1+2 STA PNTR SET POINTER ENPA LDB PNTR JSB SYMCK GO TO CHECK FOR VALID SYMBOL. JMP HA32 ** ERROR: INVALID SYMBOL ! LDA .210B SET 'U' & 'E' FIELDS = 1 CLB JSB INSR INSERT INTO THE SYMBOL TABLE NOP LDA TEST JSB ENDTS TEST FOR TERMINATION JMP ENPA ENDTS NOP TEST FOR TERMINATION CPA BLNK OF COM,ENT OR EXT JMP HA55E CPA L+4 COMMA? RSS YES JMP HA55+1 NOT AN ERROR EXIT JSB BPKUP SCAN TO NEXT CHAR. JMP ENDTS,I * HA55E CLA STA ENFLG CLEAR 'ENT'FLAG JMP HA32 EXIT ON A BLANK SPC 1 * * PNTR+1+'A' TO PNTR * SPNTR NOP ADA PNTR INA STA PNTR JMP SPNTR,I * .10B OCT 10 .210B OCT 210 PBF10 DEF PBUF+10B ADDREESS: NAM-RECORD COMMON DECLARATION. SPC 1 HA63 LDA .IL NAM IS ILLEGAL AFTER START JMP HA55+2 TO ERPR * ************************************************* * * INSR: ADD ENTRY TO THE SYMBOL TABLE, W HACCOU * * * LINKAGE: A = TYPE B = VALUE ON INPUT * * * (OUTPUT) SYMP=NO.OF CHARS., SYMN=ENTRY FWA * * * L JSB INSR,I * * * L+1 ERROR RETN ('SO' OR 'DD'PRNTD)* * * L+2 NORMAL RETN * * ************************************************* .EN ASC 3,ENDDSO INSR NOP STA FLX1 SAVE TYPE STB NAME+3 SAVE VALUE JSB ?SYMK SYMBOL TABLE LOOKUP JMP INS1 NOT FOUND; GO TO INSERT. LDB ENFLG ALREADY THERE. SZB,RSS IN ENTRY PROC? JMP INSY NO ADA ..M1+3 (-4) CHECK SYMBOL TYPE: SSA IS IT ABS,REL,B.P.,OR COM ? JMP INSC YES ENERR LDA .EN 'EN' ERROR: WRONG TYPE, DUPLICATE OR JMP INSX REFERENCE TO EXT-DEFINED SYMBOL. INSY AND .1+6 ISOLATE SYMBOL TYPE. LDB FLEX GET CURRENT FW OF ENTRY. SSB,RSS UNDEFINED ENTRY POINT? JMP INSG NO LDB FLX1 YES, GET CURRENT SYMBOL TYPE CPB .1+3 EQUATING EXT TO ENT-DEFINED SYMBOL? JMP INSX-1 YES: 'DD' ERROR! ADA ..M1+3 NO, CHECK TYPE: SSA,RSS ABS,REL,B.P. REL,OR COM? JMP ENERR INVALID TYPE FOR ENT! LDA FLX1 GET SYMBOL TYPE. ALF,ALF POSITION TO BITS #8-11 IOR FLEX INCLUDE ORIGINAL DATA, ELA,CLE,ERA CLEAR UNDEFINED BIT. LDB NAME+3 SET VALUE INTO STB VAL0,I SYMBOL TABLE ENTRY. JMP INSEX-1 FINISH PROCESSING. INSG CPA .1+6 LITERAL? JMP INSR,I YES, EXIT CPA ...1+3 EXT? JMP *+4 YES, TEST LDA .EN+1 NO, 'DD' ERROR (MULTIPLE SYMBOL) INSX JSB ERPR C JMP INSR,I GET OUT HERE CPA FLX1 ARE BOTH EXT'S? JMP INSR,I YES, FAKE 'DD'EXIT (FOR ARITH. MACRO'S). JMP *-5 GO TO ERROR PRNT INS1 LDA FLX1 ALF,ALF ADA NAME TYPE IN FIRST WORD STA NAME OF ENTRY LDB NAMI ADB TEMP+2 STB VAL0 SET LIMIT LDA ?NDOP LWA-1 FOR SYMBOL TABLE CMA,INA ADA SYMI TEST FOR SYMBOL TBL ADA TEMP+2 OVERFLOW SSA JMP *+3 NO LDA .EN+2 'SO' SYMBOL TABLE OVERFLOW JMP INSX 'SO' ERROR LDA NAME+3 MOVE VALUE STA 1,I UP LDA NAMI LDB 0,I ADD ENTRY (FROM *+6) STB SYMI,I TO SYMBOL CPA VAL0 JMP INS5 GO SET NEW END OF SYMBOL TABLE. INA ISZ SYMI JMP *-6 INS5 LDB SYMI STB ?NDSY SET NEW END OF SYMBOL TABLE. JMP INSEX EXIT. INSC LDA .4000 IOR TEMP+4,I STA TEMP+4,I SET ENTRY POINT TYPE INSEX ISZ INSR BUMP EXIT POINT FOR A+2 EXIT JMP INSR,I EXIT HERE * * ************************************ * * INSERT LITERAL INTO SYMBOL TABLE * * ************************************ LITIN NOP LDA ?ICSA GET LOC'N OF ASCI BUFFER STA SYMP+1 LDA ...1+6 (7) STA LTFLG LDB PLEN JSB INSR INSERT SYMBOL JMP LITIN,I ERROR RETN. ISZ PLEN BUMP LITERAL LOC'N CNTR ISZ LITIN JMP LITIN,I EXIT(NORMAL) * SKP * *********************** * * PROCESS OCT AND DEC * * *********************** HA40 CLB,INB B=1 CPA DEX CHECK CODE FOR 'DEX' ADB .1+1 B=3 IF CODE IS 'DEX' STB DCNT SET LOCN COUNT BUMPER CLA STA CNTB STA TEMP LDA SCN1+2 STA PNTR SET POINTER * * * PICK UP AND EXAMINE A CHARACTER * * HA41 JSB PKUP LD+EB DCNT GET COUNT BUMPER CPA L+4 COMMA? JMP HA44 YES, GO SCAN FOR NEXT PARAM. CPB .1+2 IS IT=3(I.E. DEX)? JMP HA42 YES CPA L+6 PERIOD? JMP HA48 YES, GO TEST FLT. POINT. CPA .E 'E' ? JMP HA48 YES, GO SEE IF DECIMAL PT., ALSO HA42 CPA BLNK END OF STATEMENT? JMP HA49 YES JMP HA41 * * * RESET FLT PT FLAG, SKIP BLANKS FOR NEXT CHAR * HA44 CLA STA TEMP JSB BPKUP LDB DCNT GET 'BUMP' COUNT JMP HA48+4 * * * FLT PT TEST FOR NUMBER USING BOTH . AND E * HA48 LDA TEMP ISZ TEMP SZA E OR '.' COUNTED YET? CLB YES, SET B=0. * ADB CNTB (HA48+4) STB CNTB ADD TO WORD COUNT JMP HA41 * * * END OF NUMERIC PSEUDO-OP PROCESSOR * HA49 LDA DCNT ADA CNTB SET A=NO OF LOCNS TO BE USED LDB CODE GET OPCODE I.D. NO. CLE PREPARE FOR REMAINDER TEST. CPB BYT BYTE? ERA YES, DIVIDE BY 2 SEZ ODD BYTE REMAINING? INA YES, ADD 1 TO WORD COUNT. JMP HA3Z EXIT * ******************************** * * PROCESS ASC (GET VALUE OF N) * * ******************************** HA54 LDA ...1+1 (2) 'ASC' INDIC.FOR CHOP JSB ?CHOP JMP HA3B * ERROR * SZA JMP HA55 ERROR-NOT ABS.VAL. SZB,RSS ZERO WORDS? JMP HA55 YES - * ERROR * ADB .M29 -29 LDA SUMP SSB SKIP IF >28 WORDS JMP HA3Z HA55 ISZ PLCN * ERROR EXIT * LDA .MBLN 'M' ERROR(BAD OPERAND) JSB ERPR TO PRINT ERROR DIAG. JMP HA32 * * ******************************************************** * * * * * SYMCK: CHECK FOR A VALID SYMBOL % * * * ENTER: = DON'T CARE. * * * = 'PNTR' (RELATIVE POS'N 1RST CHAR.) * * * RETURN: P+1 - INVALID SYMBOL ('SY' ERROR PRINTED) * * * P+2 - VALID SYMBOL. * * * * * * * * ******************************************************** SYMCK NOP STB PNTSV SAVE 'PNTR' FOR LATER RESTORATION. JSB MSYMS GO TO MEASURE THE SYMBOL. STA SYMSZ SAVE CHARACTER COUNT. CMA,INA NEGATE THE COUNT, STA SMCNT AND SAVE FOR 'SYMTS' LOOP COUNT. LDA TEST GET CONTINUATOR CHARACTER AND STA SYTST SAVE FOR LATER RESTORATION. LDA PNTSV GET POINTER TO FIRST CHARACTER. JSB GETC GO TO GET THE CHARACTER. LDB SMCNT GET NEGATIVE SYMBOL SIZE. JSB SYMTS GO TO CHECK FOR LEGAL SYMBOL. RSS ** ERROR: SET RETURN TO P+1. ISZ SYMCK VALID: SET RETURN TO P+2. LDA PNTSV RESTORE FORMER CONTENTS STA PNTR OF CHARACTER POINTER. LDA SYMSZ GET SYMBOL MEASUREMENT. JSB SPNTR GO TO ALIGN 'PNTR' FOR NEXT USE. LDA SYTST RESTORE THE STA TEST ORIGINAL CONTINUATOR. JMP SYMCK,I RETURN: P+1=ERROR; P+2=O.K. * PNTSV NOP TEMP. STORAGE: 'PNTR'. SYMSZ NOP TEMP. STORAGE: SYMBOL SIZE. SMCNT NOP TEMP. STORAGE: -SYMSZ. SYTST NOP TEMP. STORAGE: 'TEST'. * * ********************** * * PROCESS EQU PSEUDO * * ********************** HA56 JSB LBCK CHECK FOR REQUIRED LABEL. JSB CHOPI EVALUATE OPERAND JMP HA32 * ERROR * CPA ...1+3 (4) EXT ? LDA ...1+4 (5) SET FOR NON-PNCH EXT STA TEMP NO STB TEMP+1 CLB,INB JSB MSYMS t GO TO MEAS.SYMBOL, SET SYMP/SYMN LDA TEMP LDB TEMP+1 * * * SEND LABEL TO TABLE * JSB INSR TO SYMBOL TABLE INSERTION RTN NOP JMP HA32 * ******************************* * * ORB ORG ORR PROCESSOR JUMPS * * ******************************* HA64 JSB INST,I GO TO SUBROUTINE JMP HA32 HA70 LDB LTFLG GET LITERAL FLAG SZB IS A LITERAL IN THE OPERAND? JSB ?ARTL GO PROCESS THE LITERAL LDA .1+1 A=2 JMP HA3Z * ********************************** * * PROCESS REPLACEMENT CODE (ENT) * * ********************************** HA71 JSB LBCK CHECK FOR REQUIRED LABEL. JSB CHOPI EVALUATE OPERAND. JMP HA32 *ERROR* GET NEXT STATEMENT. STB TEMP+1 SAVE OPERAND. CLB,INB POINT TO 1RST CHAR. OF LABEL. JSB MSYMS MEASURE SYMBOL,SET SYMP/SYMN LDA .12+2 (16B)CODE-REPLACEMENT ENT RECORD. LDB TEMP+1 GET REPLACEMENT CODE VALUE. JSB INSR INSERT SYMBOL & VALUE IN TABLE. NOP (ERRORS ARE ALREADY NOTED) JMP HA32 GO GET NEXT STATEMENT. * * * LABEL PRESENCE DETECTOR * * LBCK NOP LDA SCN1+3 GET LABEL LENGTH. SZA LABEL PRESENT ? JMP LBCK,I YES, RETURN. * LDA .LB NO. GET ASCII ERROR CODE. JMP HA55+2 GO TO NOTE THE ERROR. .LB ASC 1,LB * SKP * ************************ * * PASS 1 END PROCESSOR * * ************************ DEF BUFF HB00 LDA ?TFLG GET TABLE OUTPUT FLAG SZA,RSS JMP HB08 TABLE NOT REQUESTED - FINISH PASS LDA HB00-1 ADA .1+3 STA HB00-1 SET HB00-1 = L(BUFF+4) LDA X GET FWA OF AVAILABLE MEMORY STA ENTV TO ENTV HBX LDA ENTV,I TEST 1ST WORD OF ENTRY SZA,RSS COMPLETED? )JMP HB08 YES - GO TO FINISH PASS 1 JSB MBLNK SET UP BLANKS IN SYMBOL OUT AREA * * * GET RELOCATION INDIC. CHAR. LDA ENTV,I ALF,ALF AND ...1+6 (7) CPA ...1+6 LITERAL ENTRY? JMP HBY YES. CLB CPA .1+5 (6) REPLACEMENT CODE ENTRY ? LDB SBLN YES, GET ASCII S-BLNK. SZB,RSS SKIP IF INDICATOR PRESENT. JSB ?DCOD STB BUFF+3 * * * GET VALUE OF SYMBOL * LDB SUMP (NO.OF WORDS IN ENTRY) ADB ..M1 ADB ENTV STB ENTV LDA 1,I ISZ ENTV CLE SET E = 0 FOR OCTAL CONV. JSB ?BNCN * * * STORE ASCI VALUE INTO BUFF LDB HB00-1 GET L(BUFF+4) JSB ?V LDB FFUB SET PRINT PARAMETERS LDA .12+2 (14) JSB ?PRNT GO TO PRINT JMP HBX ENTRY DONE. HBY LDA SUMP NO.WDS IN ENTRY ADA ENTV + ADDR OF ENTRY STA ENTV = ADDR OF NEXT ENTRY JMP HBX SBLN ASC 1,S * SKP * * * ERRORS PRINTED * * HB08 JSB ?ENDS CLOSE OUT THE PASS SPC 1 * *********************** * * START PASS 2 HERE * * *********************** SPC 1 * * TEST FOR PUNCH OUTPUT * * JMP NMP YES - GO PUT OUT START OF BIN DK * HB11 JSB ?POSN POSITION SOURCE FILE TO BEGINNING * LDA *+2 PICK UP ENT CODE TO GET ASMB2 JMP ?SEGM GO TO GET NEXT SEGMENT ASC 1,2 * SKP * * MOVE ENT NAMES/ADDRESS TO PUNCH BUFFER. * * IF UNDEFINED, PRINT DIAGNOSTIC. HNP NOP LDA .10B FOR "ENT" TYPE = 10B STA ENFLG LDB .2000 FOR WORDS PER ENTRY = 4 LDA .M15 FOR 15 ENTRIES/RECORD JSB ENEXT CLA STA ENFLG JMP HNP,I 7NLHHN* * * PUNCH BINARY OUTPUT FOR RELOCATABLE PROGRAMS * * * (NAM,ENT, AND EXT RECORDS ONLY) * * * OUTPUT 'NAM' RECORD * OCT 1400,4400 * NMP JSB GNMP GO SET UP SOME PARAMETERS JSB PNCH GO TO PUNCH 'NAM' RECORD * * * OUTPUT 'ENT' RECORD * JSB HNP GO TO 'ENT' MOVE/TEST RTN. * * PROCESS 'EXT' RECORD HERE LDA CNTR CPA ...1 JMP HB11 EXIT ON CNTR=1 LDA .M20 -20 LDB NMP-2 1400B FOR EXT WCNT = 3/ENTRY JSB ENEXT JMP HB11 EXIT BLUP OCT 20000 BLANK UPPER .M20 DEC -20 SPC 1 ENEXT NOP STA ENT. SAVE SYMBOL COUNT STB ORBS+1 SAVE WORD COUNT PER ENTRY LDA X FWA OF AVAILABLE MEMORY STA ENTV ENTV=ORG ADDR OF ENTRY * * * INITIALIZE FOR NEXT BINARY OUTPUT IMAGE * * HX1 LDA CSAD STA ORBS ORBS=DEST ADDR IN BIN REC. LDA BIT15 100000B LDB ENFLG SZB ENT PROC? RAR YES, SET RIC = 2 STA PBUF+1 NO, EXT. SET RIC = 4. LDA NMP-2 1400B (FOR STARTING WORD COUNT) STA WCNT SET BLK CNT = 3 LDA ENT. STA ENTC ENTC = RECRD COUNTER HX2 LDA ENTV,I SZA,RSS END OF TABLE? JMP HX9 YES ALF,ALF NO-PICK UP SYMBOL TYPE CLB STB ORBS+2 CLR FLG FOR B.P.; SET IN ENT REC LDB ENFLG RAR,RAR SZB,RSS ARE WE PROCESSING THE ENT TABLE ENTRYS JMP HX3 NO... RAR,SLA,RAL CHECK FOR ENT JMP HX12 ENT; GO PROCESS. HXN RAR,RAR NO AND ...1+6 (7) ADD ENTRY ADA ENTV -LENGTH STA ENTV -TO ENTV JMP HX2 * * * PROCESS END OF TABLE * * HX9 LDA ENTC CPA ENT. ANY SYMBOLS LEFT? RSS NO JSB PNCH GO TO PUNCH CLA STA WCNT CLEAR WORD COUNT IF NO SYMBOL OUT JMP ENEXT,I EXIT HERE HX3 SLA,RSS IS THIS AN EXT ENTRY? JMP HXN NO.. RAL,SLA,RAL TYPE 6 (RPL) OR 7 (LITERAL) ? JMP *+3 YES, BYPASS THE SYMBOL. SLA,RSS TYPE 5 (EXT EQU) ? JMP *+3 NO, EXT. GO PROCESS. RAR,RAR PREPARE TO GET WORD COUNT. JMP HXN GO ADVANCE TO NEXT TABLE ENTRY. HX5 ISZ ENTC END OF BIN RECORD? JMP *+3 NO JSB PNCH GO TO PUNCH JMP HX1 * * * PLACE CURRENT EXT OR ENT SYMBOL INTO BINARY RECORD * * LDA ENTV CMA,INA STA HMOV5 ORG.ADDR.TO MOVE LINK LDB ORBS LDA BLNS STA ORBS,I SET DEST.AREA TO BLANKS ISZ ORBS STA ORBS,I LDA BLUP GET UPPER BLANK. LOWER HALF OF ISZ ORBS -DEST WORD = 0 ADA ORBS+2 STA ORBS,I LDA ENTV,I JSB MTABL MOVE CHARS TO BIN REC ISZ PBUF+1 BUMP NO. OF ENTRIES IN REC. LDA SUMP NO.WORDS IN SYMBOLIC ENTRY ADA ENTV STA ENTV UPDATE ENTV(SYMBOL PNTR) ADA ..M1 LDB 0,I ENTRY VALUE TO B LDA ENFLG SZA,RSS ENTRY POINT? ADB ORBS,I NO, SET EXT ORDINAL SZA ISZ ORBS STB ORBS,I STORE INTO RECORD ISZ ORBS UPDATE ORBS (RECRD PNTR) LDA WCNT ADA ORBS+1 STA WCNT UPDATE WORD COUNT JMP HX2 HX12 RAL,RAL RIGHT JUSTIFY AND AND ...1+6 ISOLATE SYMBOL TYPE. CPA ...1+5 TYPE 6 ? (CODE REPLACEMENT) ADA ..M1 YES,FORCE TO 5 (YIELDS TYPE 4) SZA,RSS CONVERT FROM INTERNAL REP- LDA ...1+3 RESENTATION OF TYPE TO ADA ..M1 PROPER TYPE CODE IN OBJECT. STA ORBS+2 SET IN TYPE FIELD. LDA ENTV,I GET THE FIRST WORD AGAIN SSA,RSS HAS THE ENTRY PT. BEEN DEFINED? JMP HX5 YES, GO PUT INTO THE PUNCH BUFFER * * * ENT ERROR DIAGNOSTIC ROUTINE * JSB MBLNK MOVE A SYMBOL TO BUFF THRU BUFF+2 LDA .EN 'EN' STA IOBF+5 SAVE 'EN' IN PRINT BUFFER LDB BLNS GET BLANKS FOR BUFFER STB IOBF+9 LDB ENUN SET UP ' UNDEF' STB IOBF+6 LDB ENUN+1 STB IOBF+7 LDB ENUN+2 STB IOBF+8 JSB ?PRPG GO PRINT PREVIOUS 'ERROR-PAGE' LDA .12+3 15 WORD OUTPUT LDB SNOB GET BUFFER ORIGIN JSB ?PRNT GO PRINT THE 'EN' ERROR ISZ ?ENER BUMP 'EN' ERROR COUNTER. LDA ENTV,I GET WORD #1 OF CURRENT ENTRY. ALF POSITION WORD COUNT TO BITS 0-2 JMP HXN+1 GO TO GET NEXT ENTRY. ENUN ASC 3, UNDEF SNOB DEF IOBF+5 BUFFER ORIGIN .20B OCT 20 .4000 OCT 4000 .2000 OCT 2000 FLX1 BSS 1 (ASCN) .401B OCT 401 ORBS BSS 3 * *********************************** * * PICK UP A SYMBOL TO BE PRINTED * * * 'A' HAS DESTINATION ADDRESS * * *********************************** MBLNK NOP LDB ENTV GET TBL ENTRY LOCATION CMB,INB * * SEND ADDR. TO MOVE LINKAGE STB HMOV5 * * MOVE BLANKS TO BUFFER LDB BLNS STB BUFF STB BUFF+1 STB BUFF+2 LDB FFUB ADDR. OF BUFF TO B JSB MTABL MOVE SYMBL TO PRINT BUFF JMP MBLNK,I EXIT HERE SPC 1 * * MOVE CHARS FROM SYMBOL TABLE * * -A CONTAINS 1ST WORD OF SYMBOL ENTRY * -B CONTAINS DESTINATION ADDR. * -HMOV5 CONTAINS ORIGIN ADDR. MTABL NOP ALF AND ...1+6 (7) FOR NO.OF WRDS. STA SUMP CPA ...1+1 (2) CLA IOR ...1 JSB MOVE HMOV5 NOP JMP MTABL,I * *************************************************** * * GNMP - SET UP BASE PAGE AND PROGRAM LENGTHS. * * * SET UP 'PLEN' FOR LITERALS(IF PRESENT). * * **********************************P***************** GNMP NOP JSB ?ORRP RESET PROG LOC'N COUNTERS LDA PLCN LDB ?BPSV STA PBUF+6 SET MAIN PROG. LENGTH STB PBUF+7 SET BASE PAGE LENGTH. * * * TEST FOR 'ORG' EXTENT BEYOND MAIN PROGRAM * LDB ORGSV GET ORG SECTION LWA CMA,INA ADA ORGSV SSA,RSS IS ORG VALUE GRTR? STB PBUF+6 YES, CHANGE MAIN PROG. LENGTH * * * TEST FOR LITERALS * LDA PBUF+6 LDB PLEN SZB LITERALS PRESENT? STA PLEN YES, SET START OF AREA ADA 1 ADD LENGTH OF REGION STA PBUF+6 TO PROG LENGTH. JMP GNMP,I EXIT FROM THE GNMP ROUTINE FFUB DEF BUFF * * ***************************************** * * PROCESS EXTENDED INSTRUCTION SET AND * * * USER MICROCODES * * ***************************************** XMIC STA SCODE SAVE CODE - 100B LDB LTFLG GET LITERAL FLAG SZB,RSS IS IT ON? JMP XMIC2 NO - OK CPA .10B TYPE 110B? JMP XMIC1 YES - OK CPA .12 TYPE 114B? JMP XMIC1 YES - OK CPA .12+1 TYPE 115B? JMP XMIC1 YES - OK JSB OPERR ILLEGAL FOR ALL OTHERS JMP XMIC2 XMIC1 JSB ?PLIT PROCESS LITERAL NOP IGNORE ERROR * XMIC2 LDB SCODE PICK UP CODE-100B LDA .1+1 A = 2 CPB .12 TYPE 114B? INA YES, A = 3 CPB .12+1 TYPE 115B? INA YES, A = 3 ADB .M8 (-8) SSB,RSS TYPE 101B TO 107B(USER CODES)? JMP HA3Z NO - USE VALUE NOW IN A ADB .1+6 ADA B A NOW CONTAINS MACRO INST. COUNT JMP HA3Z * * **************************************************** * * PROCESS A 'MIC' PSEUDO OPERATION(USER MICROCODE) * * * FORMAT: MIC MMM,CCCC,N * * * WHERE  * * * MMM = USER DESIGNATED MNEMONIC * * * CCCC = USER DESIGNATED FUNCTION CODE * * * N = NUMBER OF PARAMETERS IN USER OPERAND * * **************************************************** MIC LDA SCN1+2 STA PNTR MOVE POINTER TO OPERAND JSB ?OPLK CHECK FOR DUPLICATE OPCODE MNEM. JMP MIC01 NOT DUPLICATE MICOP JSB OPERR 'M' TERM(OPERAND) ERROR STA CODE SET CODE NOT EQUAL 100B JMP HA32 * MIC01 LDA TEMP+5 SAVE USER MNEMONIC STA SCODE SAVE 1ST 2 CHARACTERS LDA TEMP+6 STA MTEMP SAVE LAST CHARACTER * * * TEST MNEMONIC FOR ALPHA ONLY * * * BY CHECKING NEXT 3 CHARACTERS * LDA ..M1+2 (-3) STA TEMP MIC04 JSB PKUP CMA,INA ADA .100B SSA,RSS VALUE LESS THAN A? JMP MICOP YES - ERROR, NOT ALPHA ADA .32B SSA VALUE GRTR THAN Z? JMP MICOP YES - ERROR, NOT ALPHA ISZ TEMP DONE WITH MNEMONIC? JMP MIC04 NO - GO GET NEXT CHARACTER LDA .12+5 STA CODE CODE='ABS' FOR CHOP PROCESSING LDA .1+1 SET A FOR COMMA STOP JSB VMIC GO PICK UP MICRO CODE/TEST PART STA INST * CLA SET A FOR NO COMMA STOP JSB VMIC SSB VALUE PLUS? JMP MICOP NO, WE HAVE AN ERROR ADB .M8 VALUE IN A AND B SSB,RSS B LESS THAN 8? JMP MICOP NO - ERROR ADA .100B YES - SET UP CODE CPA .100B CODE = 100B? LDA .30B YES - NO PARAMS SO TYPE 30B STA CODE * ******************************************************** * * NOW ENTER NEW OPCODE INTO SUPPLEMENTARY OPCODE TABLE * * ******************************************************** LDA ?NDOP ADA ..M1+2 SET NEW SUPPL. OPCODE ORIGIN STA B  CMB,INB ADB ?NDSY SSB OPTABLE OVERFLOW? JMP MIC10 NO LDA .EN+2 YES 'SO' OPTABLE OVERFLOW JSB ERPR JMP HA32 MIC10 STA ?NDOP LDB SCODE STB A,I STORE 1ST 2 CHARS. INA LDB MTEMP PICK UP 3RD CHAR. ADB CODE INSERT CODE (101-107) STB A,I STORE INA LDB INST STORE MICROCODE STB A,I INTO TABLE JMP HA32 COMPLETE OPCODE ENTRY IN TABLE. * * ******************************************************* * * VMIC CHECKS FOR COMMAS, NUMERICS AND TYPE OF OUTPUT * * * FROM OPERAND PROCESSOR(MICROCODE AND PARAMETER #. * * ******************************************************* VMIC NOP STA CTM SAVE CHOP INPUT PARAMETER JSB PKUP CPA L+4 COMMA? RSS YES JMP MICOP NO - ERROR JSB BPKUP SKIP OVER ANY BLANKS STB SCN1+2 SET OPERAND AT NEW PARAMETER LDA CTM JSB CHOP GO EVALUATE PARAMETER JMP HA32 ERROR RETURN SZA IS VALUE ABSOLUTE? JMP MICOP NO - ERROR LDA SUMP A AND B = VALUE JMP VMIC,I EXIT CTM NOP SAVE A FOR CHOP INITIATION .30B OCT 30 A EQU 0 B EQU 1 SCODE NOP SAVE CODE TYPE/SAVE 1ST 2 OPCODE CHARS. MTEMP NOP SAVE 3RD OPCODE CHARACTER SPC 1 ******************************************************************** ********** CHANGE LOC'N. X IN ASMB IF THIS PROGS. LWA > 2310B ****** ******************************************************************** SPC 1 ?CMQ EQU CMQ ?ENP EQU ENP ?EXP EQU EXP ?HA3Z EQU HA3Z ?INSR EQU INSR LABEL EQU ?LABE ?LITI EQU LITIN SPC 1 END ASMB1 8:*($$*  92064-18129 1650 S C0222 &MAS20 RTE-M ASSEMBLER SEGMENT 2             H0102 GASMB,R,L,C HED ** RTE-M ASMB - SEGMENT 2 ** * * * 9/29/76 * * *************************************************************** * * (C) COPYRIGHT HEWLETT PACKARD COMPANY. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * * NAME : ASMB2 * SOURCE: 92064-18129 * RELOC : 92064-16042 * PRGMR : C.H., H.C., S.K. * NAM ASMB2,5,99 92064-16042 REV.1650 761007 * ENT ASMB2 ENT ?ART,?BREC,?LKLI * EXT ?DCOD,?GETC,?LINC,?LIST,?LOUT,?OKOL,?OPLK EXT ?SUP,?BPKU,?PKUP,?PNCH,?SYMK EXT ?LFLG,?LTFL,?LTSA,?LTSB,?RSTA,?ERPR,?CHOP EXT ?CHPI,?OPER,?PLIT,?ASCN,?MSYM,?ASM1,?ICSA EXT ?LINS,?ARTL,?LST,?LPER,?PERL,?SETM EXT ?BASF,?SYML EXT ?X,?MOVE,?PLIN,?PCOM EXT ?ASCI,?ASII,?ENDS,?ASMB,?FMPE EXT AI EXT AO EXT CLOSE EXT DCBI EXT DCBO EXT ?ERR EXT FCONT EXT B100 EXT .M12 * COM TEMP(322B) ***************************** * # EQU TEMP SAME AS DATA ORIGIN VALU EQU TEMP+5 ...1 EQU TEMP+7 .1 EQU ...1 .12 EQU .1+7 ..M1 EQU .12+6 L EQU ..M1+6 .9 EQU #+41B .M8 EQU #+43B .M29 EQU #+45B BLNK EQU #+46B =40B(LOWER BLANK) .IL EQU #+47B .NO EQU #+51B .OP EQU #+52B .OV EQU #+53B .UN EQU #+54B BLNS EQU #+55B TW10 EQU #+56B ADDRESS MASK .1000 EQU #+57B BIT15 EQU #+60B .E EQU #+61B RC EQU #+64B RELC EQU #+76B RELOCATION FLAG SIGN EQU #+77B SUMP EQU #+100B RUNNING SUM FOR 'CHOP' TERM EQU #+101B NO. OF TERMS IN AN OPERAND T EQU #+102B BYFLG EQU #+104B BYTE FLAG FOR 'BREC' CNTB EQU #+106B CODE EQU #+107B OPCODE TYPE(FROM OPTABLE) DSIG EQU #+110B 'ASCN' FLAG EQU #+111B FLAQ EQU #+112B INST}8 EQU #+113B OPCODE FORMAT LAST EQU #+114B PASS EQU #+115B PASS FLAG(0=PASS 1 AND 1=PASS2) PLCN EQU #+117B PROGRAM LOCATION COUNTER PLEN EQU #+120B LIT LENGTH PASS 1/LIT ORG PASS 2 PNTR EQU #+121B POINTS AT LAST OR CURRENT CHAR. RCNT EQU #+122B SAVB EQU #+123B SCN1 EQU #+125B STATE LNG/OPCODE/OPERAND/LABEL(4) SVST EQU #+131B SYMP EQU #+133B SYMBOL LNG/ AND LOC'N TEST EQU #+135B TEST CHARACTER PBUF EQU #+225B WCNT EQU PBUF WORD(BLK) CNT FOR BIN.RECRD. ASM1 EQU ?ASM1 CHOP EQU ?CHOP CHOPI EQU ?CHPI ERPR EQU ?ERPR GETC EQU ?GETC LINC EQU ?LINC LIST EQU ?LIST LOUT EQU ?LOUT LST EQU ?LST LTFLG EQU ?LTFL MSYML EQU ?SYML OKOLE EQU ?OKOL OPERR EQU ?OPER RSTA EQU ?RSTA SYMK EQU ?SYMK A EQU 0 B EQU 1 * * ASMBX JSB FCONT WRITE AN EOF RECORD ON OUTPUT FILE DEF *+4 DEF DCBO OUTPUT FILE DCB DEF ?ERR ERROR WORD DEF B100 SSA,RSS ERRORS? JMP CLOUT NO, THEN CLOSE OUTPUT FILE CPA .M12 IS IT -12 ERROR? JMP CLOUT YES,THEN IGNORE IT JSB ?FMPE YES DEF AO+1 OUTPUT FILE NAME CLOUT JSB CLOSE CLOSE BINARY FILE DEF *+3 DEF DCBO OUTPUT DCB DEF ?ERR ERROR WORD SSA,RSS TEST FOR ERRORS JMP ?ASMB JSB ?FMPE FMP ERROR ROUTINE DEF AO+1 OUTPUT FILE NAME * SKP * ******************* * * CONTINUE PASS 2 * * ******************* ASMB2 EQU * * CLA STA PBUF STA PBUF+1 STA PBUF+2 STA PBUF+3 * * * LDA ?LPER LENGTH OF'CLEAR' AREA LDB ?PERL GET ORIGIN OF 'CLEAR' AREA JSB ?SETM GO TO SET MEMORY ROUTINE OCT 0 TO SET MEMORY TO ZERO CLA STA PLCN INITIALIZE PROG LOC'N COUNTER CLA,INA STA PASS SET PASS FLAG JSB RSTA READ CONTROL STATEMENT LDA TW10 STA ASM1 SET FLAG FOR 'INIT' PORTION ASH JSB RSTA READ A SOURCE STATEMENT(NAM?) LDA CODE CPA .12+3 HED? JMP ASH YES, GO PICK UP THE NEXT STATEME STA ASM1 CLEAR 'CS' AND 'INIT' FLAG CPA .12+1 (13) NAM ? JMP HC02 YES, GO TO LIST IT. LDA .NO 'NO'= NO ORG OR NAM STATEMENT JSB ERPR JMP HC05 ERROR EXIT FROM INIT * SKP * ****************************** * * SKIP AND SPACE LIST OUTPUT * * ****************************** SKPR LDB LINC 'SKIP'ENTRY CMB,INB JMP SK2 SPCR JSB CHOPI EVALUATE SPACE COUNT CLB,INB ERROR - SET COUNT=1 SK2 SZB,RSS SPACES=0? JMP HC04 YES, EXIT TO HC04(START OF PASS) LDA ?LFLG NO, START LINE SKIPPING SZA,RSS LIST REQUESTED? JMP HC04 EXIT TO HC04(START OF PASS) LDA LST LST FLAG SZA SUPPRESS LISTING? JMP HC04 YES, EXIT TO HC04(START OF PASS) STB DSIG SET COUNTER LDA LINC CPA ..M1 ON LAST LINE? JMP HC04 YES - EXIT ADB LINC SSB,RSS WILL IT GO TO BOTTOM OF PAGE? JMP *+5 YES,GO TO SKIP TO BOTTOM. STB LINC NO, SAVE NEW LINE COUNT LDA DSIG GET NO. OF LINES TO BE SKIPPED JSB ?LINS GO TO LINE SKIPPER JMP HC04 EXIT TO GET NEXT STATEMENT JSB OKOLE SKIP TO BOTTOM OF PAGE. JMP HC04 EXIT TO GET NEXT STATEMENT * ************************* * * BINARY OUTPUT ROUTINE * * ************************* .M54 DEC -54 OCT 60100 RIC=5, CURRENT PAGE BREC NOP STA EXTFL SAVE FOR EXTERNAL CHECKS. CPA .10B TWO WORD EXTERNAL ? LDA ...1+4 YES, SET RELOC. INDICATOR TO 5 STA SAVB+1 SAVE RELOC'N BYTE LDA WCNT SZB RECORD OUT ? JMP HI66 NO. SZA,RSS WCNT=0? JMP BREC,I YES. * * * OUTPUT A RECORD * HI60 LDA WCNT ALF,ALF ROTATE 8 STA WCNT STORE WCNT IN UPPER PBUF LDA SVST,I POSITION REMAIN RELOCATION BYTES ALF,RAR ISZ RCNT JMP *-2 RAL STA SVST,I STORE RELOC.BYTES * * * SET REC.ID CODE (WORD 2) * LDB BREC-1 GET RIC/PAGE INDICATOR CLA,INA CPA ?BASF IF BASE PAGE RELOCATABLE, LDB MICRD+2 SET RIC = 060000 . ADB PBUF+1 SET REMAINDER STB PBUF+1 JSB ?PNCH GO TO 'PUNCH' JMP BREC,I AND EXIT * * * PROCESS A BINARY OUTPUT WORD * * DEF PBUF+4 HI66 LDA WCNT SZA FIRST WORD OF RECORD? JMP HI70 -NO- LDB PLCN PLCN TO BREG STB PBUF+3 SET DBL ADDR. STA PBUF+1 SET PBUF+1=0 LDB ...1+3 (4) STB WCNT SET WCNT = 4 LDB HI66-1 STB STOR SET STOR=L(PBUF+4) LDB ..M1+4 (-5) STB RCNT SET RCNT=-5 LDB .M54 -54 STB CNTB SET CNTB FOR WORD COUNT HI70 LDB RCNT CPB ..M1+4 RCNT= -5? JMP HI74 -YES-SET UP ADDRESSES * * * STORE RELOC.BYTE / UPDATE * * HI71 ISZ PBUF+1 UPDATE # OF DATA WRDS LDA SVST,I GET RELOC. BYTE WORD ALF,RAR POSITION FOR NEXT WORD IOR SAVB+1 GET THE NEW BYTE STA SVST,I STORE BACK IN BYTE WORD ISZ RCNT BYTE WORD FULL? JMP HI76 -NO- LDB ..M1+4 -YES- =-5 STB RCNT RESET RCNT TO -5 RAL STA SVST,I LDA CNTB CPA ..M1 RSS ISZ CNTB HI76 LDB INST ISZ WCNT ADVANCE WORD COUNT LDA EXTFL GET TWO-WORD EXT. FLAG. CPA .10B TWO-WORD EXTERNAL ? JMP EXT2 YES, GO TO PROCESS. STB STOR,I NO, STORE INSTRUCTION. ISZ STOR CCE PREPARE FOR BYTE ADDRESS WORD, IF ANY. CPA ...1+4 (5) 2 WORD INSERT? JMP HI77 YES, GO TO PROCESS. CPA .1+5 (6) BYTE ADDRESS ? JMP BYTAD YES, GO PROCESS. JMP HI78 TO EXIT TEST * * * PROCESS 2-WORD EXTERNAL (R = 5) OR BYTE ADDRESS (R = 6) * * EXT2 LDA SIGN GET OFFSET FLAG (EXT ORDN'L) CLE,SZA IS THIS AN EXT W/OFFSET? [E_0] CCE,RSS YES, SET =1 AND SKIP. LDA SUMP NO: I/O EXT. USE ORDN'L IN SUMP. ALS,ALS POSITION ORDINAL TO BITS 9-2. SEZ MEM. REF. EXTERNAL WITH OFFSET ? IOR INST YES, INCLUDE INSTRUCTION CODE. IOR .1+2 ADD ABSOLUTE 'MR' INDICATOR (3). STA STOR,I STORE FIRST WORD OF PAIR. ISZ STOR ADVANCE PUNCH-BUFFER POINTER. BYTAD LDA SUMP GET OFFSET VALUE, OR BYTE ADDRESS IF ANY. SEZ,RSS MEM. REF. EXT. W/OFFSET OR BYTE ? LDA INST NO,I/O. USE INSTRUCTION. STA STOR,I STORE SECOND WORD OF PAIR. JMP HI77A GO TO COMPLETE THE PROCESS. * HI77 LDA SUMP GET RELOCATABLE VALUE. STA STOR,I AND BRMSK CLEAR UPPER 6 BITS OF 'SUMP' BRS,BRS CLEAR LOWER 2 BITS OF INST BLS,BLS IOR 1 'OR' B TO A STA INST HI77A ISZ WCNT ADVANCE WORD COUNT. ISZ STOR ADVANCE PUNCH-BUFFER POINTER. ISZ CNTB BUMP CNTB RSS JMP HI60 HI78 ISZ CNTB IS THIS THE LAST WORD? JMP BREC,I NO- EXIT JMP HI60 YES- GO TO PUNCH HI74 LDB STOR STB SVST CLA STA SVST,I CLEAR RELOC BYTE WORD ISZ STOR ISZ WCNT JMP HI71 STOR BSS 1 BRMSK OCT 1777 .10B OCT 10 EXTFL NOP TWO-WORD EXTERNAL FLAG. SKP HC02 LDA ...1+1 LIST PARAMETER HC03 JSB LIST * * * READ NEXT STATEMENT * HC04 JSB RSTA READ NEXT STATEMENT * * * TEST MNEMONIC CODES FOR PROCESS TYPE * HC05 LDA CODE LDB INST SZA,RSS (0) ORB ? JMP HC42 YES. CPA .100B CODE = 'MIC' ? JMP X39 YES, GO LIST IT. ADA M100B SUBTRACT 100 OCTAL SSA,RSS CODE >100B ? JMP XMIC YES, ITS A MICROCODE MACRO. LDA CODE GET OPCODE I.D. NO. AGAIN. CPA L+3 (43) SOC OR SOS ? JMP HC28 YES AND .M8 (177770) CPA L I/O ? JMP IOPR YES ARS,ARS SHIFT A RIGHT 4 BITS ARS,ARS CPA .1+2 60/70(MICRO-OP?) JMP MICR YES LDA CODE GET JUMP TABLE ADDRESS ADA CODLC ADD OPCODE INCREMENT JMP A,I JUMP TO PROCESSOR .100B OCT 100 M100B OCT -100 * * * PROCESS MEMORY REFERENCE INSTRUCTIONS * MEMRY LDA INST LDB LTFLG SZB LITERAL PRESENT? JMP HCY YES AND ..M1+1 NO, CLEAR LDSB OF 'INST' STA INST LDA .I SET FOR INDIRECT BIT LDB BIT15 INDIRECT BIT MASK(100000B) JSB CHOP JMP HC17E ERROR EXIT HCX STB SUM. OPERND VALUE CLB LIST PARAMETER=0 HCXL STB TERM SAVE THE LIST PARAMETER LDB SUM. GET THE OPERAND VALUE * * * RELOC.CODE IS IN RELC * SZA ABS? JMP HC11 NO ADB TW10 YES, SUBTRACT 2000B. SSB,RSS IS THE OPERAND LESS THAN 2000B? JSB OPERR NO, IT'S AN "M" TERM ERROR HC11 LDA SUM. LDB CODE CPB .12+4 (16) DEF? JMP HC14A YES, GO CHECK FOR EXT W/OFFSET. LDA RELC CPA ...1+1 (2) B.P. RELOCATABLE ? JMP *+3 YES. SZA ABSOLUTE? JMP HC15 NO SPC 1 * * TEST FOR OPERAND >1023 * SPC 1 LDA SUM. ADA TW10 (176000) SSA,RSS JMP OI.SP LDA INST CLEAR AND CBIT CURRENT-PAGE BIT [MASK=175777] STA INST JMP HC14 SPC 1 *  * TEST FOR OPERAND & INSTR IN SAME PAGE * SPC 1 OI.SP LDA RELC CPA ...1+1 (2) B.P. RELOCATABLE ? JMP HC13 YES, ERROR. LDA PLCN AND TW10 CMA,INA ADA SUM. AND TW10 SZA,RSS JMP *+3 HC13 LDA .OV 'OV' ERROR. JSB ERPR LDA BRMSK STRIP UPPER SIX BITS. AND SUM. STA SUM. HC14 LDA RELC CPA ...1+1 (2) B.P. RELOCATABLE ? JMP HC15+2 HC14A LDA SIGN GET OFFSET FLAG (EXT ORDINAL). SZA IS OPERAND EXT W/OFFSET ? JMP HC17A YES, IGNORE ORDN'L FOR NOW. LDA SUM. NO, GET OPERAND VALUE. LDB CODE GET OPCODE ID NUMBER. CPB .12+4 ARE WE PROCESSING A 'DEF'(16B) ? JMP HC17 YES, SET UP ADDRESS FOR 'BREC'. HC14B LDA SUM. NO, GET OPERAND VALUE; AND BRMSK MASK TO FORM ADDRESS, AND JMP HC17 INSERT INTO INST. HC15 CPA .1+3 EXTERNAL ? (4) JMP HC14A YES, GO CHECK FOR OFFSET. LDB ...1+4 (5) STB BYFLG ADA ..M1 FORM 'MR' INDICATOR FOR OPERAND HC17 IOR INST STA INST SET LOADER FLAG LDA SIGN GET OFFSET FLAG. HC17A LDB .10B GET TWO-WORD EXT INDICATOR. SZA EXTERNAL W/OFFSET IN PROCESS ? STB BYFLG YES, SET FLAG FOR BREC. * * * SET UP FOR DCOD* LDA RELC HC19 JSB ?DCOD * * * OUTPUT A BINARY WORD * STB SAVB CLB,INB JSB BREC * * * OUTPUT A LINE FOR LISTING * LDA INST GET INSTRUCTION PATTERN. LDB SIGN GET OFFSET FLAG. SZB PROCESSING MEM. REF. W/OFFSET? IOR B YES, INCLUDE EXT ORDN'L NO. STA INST SAVE INSTRUCTION FOR LISTING. LDB SAVB GET RELOC. CHARACTER. LDA TERM GET THE LIST PARAMETER JSB LIST GO TO LIST THE LINE. LDA SIGN GET OFFSET FLAG. SZA,RSS PROCESSING MEM. 1REF. EXT W/OFFSET ? JMP HC20 NO, GO TO ADVANCE LOC'N COUNTER. LDA SUM. YES, GET OFFSET VALUE. STA INST SAVE IN INST FOR LISTING. LDB PLUS SET = ASCII: +BLANK. LDA .1+5 6=LIST CODE FOR INSTRUCTION ONLY. JSB LIST GO TO LIST OFFSET VALUE. HC20 ISZ PLCN ADVANCE LOCATION COUNTER. JMP HC04 GO TO READ NEXT STATEMENT. PLUS ASC 1,+ OFFSET LIST INDICATOR. * ***************** * * BSS PROCESSOR * * ***************** BSSP JSB CHOPI EVAL. OPERAND JMP HC02 ERROR SZB,RSS B=0? JMP HC02 YES CLB B=0 JSB BREC CLA A=0 LDB BLNS NO RELOC. INDIC. JSB LIST LDA SUMP PICK UP BLOCK LENGTH FOR PLCN ADA PLCN STA PLCN JMP HC04 EXIT * SKP * ************************ * * PROCESSOR JUMP TABLE * * ************************ * CODLC DEF *,I DEF HC42 ORG 1 DEF HC42 ORR 2 DEF X39 *COM 3 DEF X39 *ENT 4 DEF X39 *EXT 5 DEF INST,I *ARITH 6 DEF NUMP ASC 7 DEF NUMP DEC 10 DEF NUMP OCT 11 DEF BSSP BSS 12 DEF EQUP EQU 13 DEF FIN2 END 14 DEF X39 *NAM 15 DEF MEMRY MEMORY 16 DEF X50 HED 17 DEF MEMRY DEF 20 DEF HC26 ABS 21 DEF SKPR SKP 22 DEF SPCR SPC 23 DEF X54 LST/UNL 24 DEF NUMP DEX 25 DEF HC70 HDW ARITH 26 DEF HC80 HDW SHIFT 27 DEF HC30 CLO ETC 30 .I OCT 111 ASCII 'I' 31 DEF RPLP RPL 32 CBIT OCT 175777 33 M17 DEC -17 34 DEF X52 REP 35 .JSB OCT 16000 o 36 .C OCT 103 ASCII 'C' 37 DEF X56 SUP/UNS 40 DEF BYTE DBL 41 DEF BYTE DBR 42 DEF BYTEG BYT 43 SUM. BSS 1 DEX OCT 25 'DEX' OPCODE TYPE SKP * ****************************** * * ARITHMETIC MACRO PROCESSOR * * ****************************** ART JSB SYMK GO TO SYMBOL TABLE LOOKUP RSS ERROR RETN(UNDEF) JMP *+4 NORMAL RET'N LDA .UN 'UN'= UNDEFINED SYMBOL JSB ERPR CLB SET B = 0 ADB .JSB 'JSB' INSTRUCTION MASK STB INST LDA ...1+3 (4) A=EXT JSB BREC PUNCH LDB RC+4 ' X' CLA * ********************************************** * * PROCESS THE 'DEF' FOLLOWING THE FIRST WORD * * * OF AN ARITHMETIC PAIR * * ********************************************** ARTX JSB LIST GO TO LIST FIRST WORD LDA .12+4 (20B) STA CODE =DEF CLA STA INST CLEAR INST LDA LTFLG SZA LITERAL PRESENT? JMP ALTR YES LDA .I SET UP FOR INDIRECT BIT LDB BIT15 MASK= 100000B JSB CHOP NOP ALTZ ISZ PLCN BUMP LOCATION COUNT STB SUM. SAVE OPERAND VALUE LDB .1+3 LIST PARAMETER=4 JMP HCXL ALTR LDA ?LTSA PICK UP LDB ?LTSB LITERAL PARAMS. JMP ALTZ FROM LKLIT * * * LITERAL PROCESSING * * HCY SLA,RSS LSB OF INST INDIC LITERAL POSSIBLE JMP HCZ NO, ERROR AND ..M1+1 CLEAR LSB OF INST STA INST JSB ?PLIT JMP HCZ+1 ERROR EXIT JMP HCX HCZ JSB OPERR 'M' ERROR HC17E CLA LIST PARAMETER =0 STA TERM SAVE IT JMP HC17 * SKP * * * PROCESS 'ABS' OPCODE * * HC26 JSB CHOPI GO EVALUATE OPERAND JMP +HP2D ERROR STB INST JMP HP2D OK.. * * * OUTPUT BIN RECRD AND/OR LIST LINE * * HC30 JSB LOUT JSB LIST * * * ADD 1 TO PROG. LOCN. CNTR. * ISZ PLCN BUMP LOCATION CNTR JMP HC04 * X39 CLA,INA 1 TO A JMP HC03 * * * ORG,ORB,ORR PRE-PROCESSOR * * HC42 CLB OUTPUT A JSB BREC RECORD JSB INST,I JUMP TO CORRECT SUBROUT. JMP HC02 BACK TO START LIST X50 LDA ?LFLG GET THE LIST FLAG SZA,RSS IS LIST FLAG OFF? JMP HC04 YES - GO TO NEXT STATEMENT JSB INST,I TO HEADER SUBROUTINE LDA LST SZA,RSS IS LIST FLAG ON? JSB OKOLE YES, SPACE TO BOTTOM OF PAGE JMP HC04 GET NEXT STATEMENT X52 JSB INST,I TO REPSB JMP X39 X54 STB LST SET LST/UNL FLAG JMP HC04 BYPASS LISTING FOR 'LST/UNL' X56 STB ?SUP SET 'SUP/UNS' FLAG JMP X39 SPC 1 * * PASS 2 'EQU' PROCESSOR * * EQUP JSB CHOPI EVAL. OPERAND CLB ERROR EXITS LDA PLCN STA SUMP SAVE PLCN VALUE STB PLCN SET PLCN=0 LDA ...1+1 (2) LIST 'EQU' JSB LIST LDA SUMP REPLACE PLCN VALUE STA PLCN JMP HC04 HC70 LDA LTFLG GET LITERAL FLAG SZA ARE LITERALS PRESENT? JSB ?ARTL YES, GO TO LITERAL PROCESSOR JSB LOUT OUTPUT THE ARITH INSTRUCTION JMP ARTX GO PROCEESS THE 'DEF' PORTION.. HC80 JSB CHOPI GO EVALUATE THE COUNT JMP HC84 BAD COUNT EXIT ADB M17 B-17 SSB B GRTR THAN 16? CPB M17 NO. IS B=0? JSB OPERR YES, IT'S AN 'M' ERROR,. LDA SUMP GET THE SHIFT OR ROTATE COUNT.. AND .12+3 MASK OUT LOWEST 4 BITS HC82 ADA INST MAKE UP THE FINAL INSTRUCTION STA INST JMP HC30 GO AND OUTPUT THE INSTRUCTION HC84 hCLA SET COUNT FOR 16 BIT SHIFT ROTATE JMP HC82 SPC 1 * ************************ * * PASS 2 RPL PROCESSOR * * ************************ RPLP LDA SCN1+3 CHECK FOR LABEL. SZA PRESENT ? JMP *+4 YES, GO EVALUATE THE OPERAND. LDA .LB NO, GET ERROR MNEMONIC 'LB'. JSB ERPR GO TO INDICATE THE ERROR. RSS CLEAR THE INSTR. FIELD FOR LIST. JSB CHOPI GO TO EVALUATE THE OPERAND. CLB * ERROR * SET OPERAND =0. STB INST SAVE OPERAND VALUE FOR LIST. LDA .1+6 (7) LIST WITHOUT LOCATION. LDB SBLN ASCII:S-BLANK (SUBSTITUTION) JMP HC03 GO TO LIST THE STATEMENT. .LB ASC 1,LB ASCII 'LB' NO-LABEL ERROR CODE. SBLN ASC 1,S REPLACEMENT CODE INDICATOR: 'S'. * SKP * ************************* * * OCT/DEC/ASC PROCESSOR * * ************************* NUMP LDA SCN1+2 STA PNTR SET POINTER LDA ..M1 STA T+1 SET FPAS=-1 LDA CODE CPA ...1+6 (7) JMP ASCR HE06 LDB PNTR PNTS AT 1ST CH OF NUMBER STB SIGN CLB STB CNTC INB STB RELC * * * TEST CHARACTER FOR TERMINATOR * HE08 LDA PNTR JSB GETC STA TERM CPA L+4 COMMA? JMP HE12 YES CPA BLNK BLANK? JMP HE12 YES * * * UPDATE CHAR.CNTR(CNTC) AND POSN. PNTR(TLOC) * LDB CODE CPB .9 OCT? JMP HE10+1 YES CPB DEX 'DEX'? JMP HE11 YES LDB ...1+1 (2) NOT OCTAL CPA L+6 PERIOD? STB RELC YES, SET RELC = 2 CPA .E 'E' ? HE10 STB RELC YES, SET RELC FOR USE AS ASCN MD ISZ CNTC ISZ PNTR BUMP PNTR JMP HE08 HE11 LDB .1+2 SET B=3 FOR DEX MODE JMP HE10 * * * SET UP VALUE FOR LHFBIST AND/OR PUNCH * HE12 LDA CODE CLB CPA .9 OCT? JMP *+3 YES LDB RELC NOT OCT BLF,BLF ADB CNTC LDA SIGN JSB ?ASCN GO TO 'ASCI' CONVERSION CLA SET A=0 STA INST STB SUMP STORE VALUE LDA VALU SAVE LEAST SIG PART OF 'DEX' STA SIGN HE18 JSB NOUT LDA RELC ARS,SLA IS RELC = 0 OR 1? JMP HE20 NO, ITS 3 OR 2 LDA TERM CPA BLNK JMP HC04 EXIT ON BLANK ISZ PNTR BUMP PNTR JSB ?BPKU SCAN OVER BLANKS LDA PNTR TEST FOR EOL 1976-09-22-1500 CMA,INA ADA SCN1 THE RECORD CHARACTER COUNT SSA,RSS JMP HE06 MORE DATA FOLLOWS LDA .IL SOMETHING IS NOT GOOD JSB ?ERPR CLA MAKE A NOP STA INST AND JSB NOUT DUMP IT JMP HC04 DONE HE20 LDA SUMP STA INST VALUE TO INST LDB RELC CPB .1+2 IS RELC=3? JMP HE22 YES- SET SUMP FOR 3RD WORD CLA HE21 STA RELC SET RELC FOR NEXT TEST JMP HE18 * HE22 LDA SIGN STA SUMP VALU TO SUMP LDA .1+1 FOR SETTING RELC=2 JMP HE21 * *************************** * * OCT DEC ASC WORD OUTPUT * * *************************** NOUT NOP CLA SET A=0 FOR 1ST LINE OUTPUT ISZ T+1 SKIP FOR 1ST LINE OF OUTPUT. LDA ...1+3 (4) SET A=4 FOR LIST LDB BLNS JSB LIST CLA CLB,INB JSB BREC PUNCH ISZ PLCN BUMP LOCN CNTR. JMP NOUT,I EXIT * ******************** * * PROCESS ASC HERE * * ******************** :HASCR LDA ...1+1 (2) INDIC.'ASC' JSB CHOP GO EVALUATE WORD LENGTH JMP HC30 * ERROR EXIT SZA VALUE ABSOL.? JMP HP2D-1 NO; * ERROR * SZB,RSS ASKING FOR ZERO WORDS ? JMP HP2D-1 YES, * ERROR * ADB .M29 (-29)(VALUE IS IN SUMP TOO) SSB,RSS VAL.>28? JMP HP2D-1 YES; * ERROR * LDA PNTR STA T LDA SUMP CMA,INA STA CNTC VALUE(COMPL.) TO CNTC * * * PICK UP WORDS AND STORE INTO PROGRAM * SB ISZ T LDA T JSB GETC ALF,ALF STA TEST ISZ T LDA T JSB GETC STA INST * * * OUTPUT 2 ASCI CHARACTERS * JSB NOUT CLA STA TEST ISZ CNTC JMP SB JMP HC04 DONE, GO GET NEXT STATEMENT * ************************* * * PROCESS I/O GROUP HERE * * ************************** RAM OCT 105000 OCT 177400 I/O MASKS OCT 300 IOPR LDA SCN1+2 IS OPERAND SZA PRESENT? JMP P YES! LDA CODE NO OPERAND. CPA L+1 'HLT'? JMP HP2D * * * OPERAND ERROR EXIT HERE * JSB OPERR (HP2D-1) HP2D CLA STA TERM SAVE THE LIST PARAMETER JMP HC19 P LDA .C TEST FOR 'CLEAR FLAG'(C). LDB .1000 GET 'C' MASK FOR IO INSTR. JSB CHOP JMP Q ERROR EXIT SZA,RSS ABSOLUTE? JMP ABSL YES, GO PROCESS. CPA .1+3 EXTERNAL I/O OPERAND? ALS,SLA YES, SET TO 10 FOR BYFLAG. JMP R NO. ERROR! STA BYFLG SET BYFLG. LDA INST GET UNCONFIGURED INSTRUCTION. LDB SIGN GET THE OFFSET FLAG. SZB,RSS EXTERNAL I/O WITH OFFSET ? JMP IOEX NO, SINGLE EXTERNAL TERM. ADA SUMP YES. ADD OFFSET TO INSTRUCTION. STA INST SAVE THE MODIFIED INSTRUCTION. ni STB SUMP PUT EXT ORDN'L IN SUMP FOR BREC. IOEX CLB CLEAR LIST PARAMETER STB TERM TO LIST WHOLE LINE. STB SIGN SET EXT I/O FLAG FOR BREC. JMP HC19-1 OUTPUT BINARY; LIST LINE. ABSL LDA SUMP GET I/O OPERAND. LDB INST LOAD B WITH INSTRUCTION FORMAT ADA IOPR-2 MASK WITH 177300 CPB RAM IS IT A RAM INSTR RSS SKIP IF YES ADA IOPR-1 FINISH MASK IF NOT RAM LDB SUMP RESTORE B CONTENTS * * * TEST FOR VALUE>63 * SSA JMP *+4 VAL>64 LDA .OV 'OV' ADDRESS OVERFOLW JSB ERPR Q CLB ADB INST STB INST JMP HP2D R JSB OPERR 'M' ERROR - RELOC.I/O ADDR. JMP Q * * * PROCESS SOC OR SOS HC28 LDA SCN1+2 PNTR TO OPERAND LDB 0 A TO B JSB ?MSYM ADA ..M1 SZA JMP HP2D LDA LAST CPA .C IS 'C' PRESENT? JMP *+2 YES JMP HP2D NO * * * 'OR' 1 TO BIT 9 (C BIT) OF I/O INST * LDA INST IOR .1000 MASK IN CURRENT BIT STA INST JMP HP2D * ********************** * * MICRO-OP PROCESSOR * * ********************** CNTC BSS 1 INSV EQU SUM. MICRD OCT 7777,4000,60000,60,71,14000 * * * INITIALIZE FLAGS * MICR CLA STA CNTC =0 WHEN CLE APPEARS STA TERM BITS 12-11 = 1 IF B REG * BITS 12-11 = 2 IF A REG STA TEMP+4 BITS 14-13=1 IF SRG; =2 IF ASG STA INSV USED TO ACCUMULATE THE CODE STA FLAG STA TEST CLEAR CHAR TESTER * * START HERE FOR EACH NEW CODE * * F LDA INST UNPACK THE MICRO-OP CODE * *THE FORMAT IS: BITS 14-13=1 IF SRG,2 IF ASG, 0 IF EITHER. * BITS 12-11=1 IF BREG,2 IF AREG, 0 IF NEITHER. * BITS 11-0 = ACTUAL 12 BIT CODE AND MICRD EXTRACT OPCODE STA FLAQ SAVE IT (=+2) LDA CODE THIS IS THE GROUP NUMBER. CMA,INA MAKE SURE'IT'S BIGGER THAN THE LAST ADA FLAG A=(LAST GRP)-(PRESENT GRP) SSA JMP O SEQUENCE IS OK * * * IF PRES GRP IS GO WE CAN CHANGE IT AND MAY BE OK LDA CODE CPA MICRD+3 IS CODE TYPE = 60B (MICRO-OP)? JMP *+4 CHANGE ERROR GROUP AND OP CODE MERR LDA .OP 'OP' FOR OPCODE ERROR JSB ERPR RETURN JMP HP2D LDA MICRD+4 71B, CHANGE GROUP (FROM *-4) STA CODE TO 71 * * * MOVE BITS 8-5 OF OPCODE TO BITS 4 AND 2-0 * LDA FLAQ AND MICRD+1 SET A/B BIT STA 1 SAVE IN B. XOR FLAQ ALF,ALF MOVE TO BITS O AND 15-13 RAR,SLA MOVE BIT 0 TO INA BIT 1. ALF,RAR ROTATE LEFT 3 TO BITS 4,2-0 IOR 1 PUT IN THE A/B BIT JMP F+2 O LDA CODE STA FLAG SET LAST GRP TO PRESENT GRP * * * CHECK REGISTER CONSISTENCY * LDA INST AND MICRD+5 GET BITS 12-11 IOR TERM CPA MICRD+5 IF EQUAL, THERE'S A REGISTER JMP MERR INCONSISTENCY. STA TERM NEW REGS TO REGS, * * * OTHERWISE CHECK GROUP CONSISTENCY * LDA INST AND MICRD+2 BITS 14-13 IOR TEMP+4 CPA MICRD+2 IF EQUAL,THERE ARE 2 CODES JMP MERR FROM DIFFERENT GROUPS. STA TEMP+4 * * CHECK FOR CLE * LDA FLAQ SZA,RSS ISZ CNTC * * * NOW 'OR' THE CODE INTO CURRENT CODE SO FAR * IOR INSV STA INSV * * * GET THE NEXT CHARACTER * LDA SCN1+1 OPCODE PNTR ADA ...1+2 (3) STA PNTR POINTS AT POS'N FOLLOWING OPCODE JSB ?PKUP CPA BLNK IS THIS CHAR. A BLANK ? JMP *+7 IF SO, WE'RE DONE. CPA L+4 COMMA ? JMP *+2 JMP MERR INVALID CHAR.-'M' ERROR ! * * * GET THE NEXT OPCODE * JSB ?OPLK OPCODE LOOKUP JMP HP2D JMP F * * * TO FINISH TEST CLE; IF USED AND IN ASG SET, ADD 40 * * TO THE CODE. LDA TEMP+4 (FROM *-7) ALF,ALF SZA,RSS IOR BLNK (40B) LDB CNTC SZB,RSS CLA IOR INSV STA INST JMP HP2D * ******************************** * * SEARCH SYMBL TBL FOR LITERAL * * ******************************** LKLIT NOP LDA ?ICSA GET LOC'N OF ASCI BUFFER STA SYMP+1 STA LTFLG SET LTFLG#0 JSB SYMK SYMBOL TABLE LOOKUP ROUTINE CLB ERROR RETURN ADB PLEN ADDR OF LITERAL CLA,INA A=1 STB SUMP STA RELC JMP LKLIT,I LKLIT EXIT * * .13B OCT 13 SCODE NOP SAVE CODE-100B FOR XMIC PROCESS ROTFL OCT 125252 ODD/EVEN FLAG LMASK OCT 377 UMASK EQU RAM+1 177400B * * ************************************ * * GENERATE A STRING OF BYTES. * * * OCTAL NUMBERS ONLY * * * -377 >= NUMBER <=+377 * * ************************************ * BYTEG LDA SCN1+2 START INITIALIZATION STA PNTR SET PNTR TO 1ST BYTE LDA ..M1 STA T+1 SET FIRST LINE LIST OUTPUT FLAG LDA ROTFL STA SCODE SET RIGHT/LEFT ALTERNATOR * BYT01 LDB PNTR STB SIGN SAVE START OF BYTE CLB STB CNTC INITIALIZE CHARACTER COUNT * BYT03 LDA PNTR GET A CHARACTER JSB GETC STA TERM SAVE IT CPA L+4 COMMA? (END OF BYTE) JMP BYT05 YES GO PROCESS A BYTE CPA BLNK BLANK? (END OF BYTE AND STRING) JMP BYT05 YES GO PROCESS A BYTE * ISZ CNTC BUMP CHAR. COUNT ISZ PNTR BUMP CHAR. POINTER JMP BYT03 GO GET NEXT CHAR. * BYT05 LDB CNTC B=CHARACTER COUNY LDA SIGN A = POINTER TO BYTE JSB ?ASCN CONVERT BYTE TO OCTAL NUMBER CLA ERROR RETURN - SET A=0. STA B SAVE VALUE IN B AND UMASK SZA GRTR THAN 377B? CPA UMASK MAYBE - TEST FOR GOOD NEG. VALUE JMP *+3 NUMBER IS OK JSB OPERR ERROR CLB LDA B AND LMASK LDB SCODE RBR,SLB LEFT BYTE BEING PROCESSED? JMP BYT10 YES STB SCODE SAVE LEFT/RT FLAG ADA INST NO - SET UP TO GENERATE A WORD STA INST BYT06 JSB NOUT OUTPUT A WORD TO LIST/PUNCH LDA TERM GET LAST CHAR. TESTED CPA BLNK BLANK? (END OF STATEMENT) JMP HC04 YES - EXIT JMP BYT12 NO - GO START NEXT BYTE * SKP BYT10 ALF,ALF PROCESS LEFT BYTE STA INST PLACE IN UPPER 'INST' STB SCODE SAVE LEFT/RT FLAG LDB TERM CPB BLNK LAST TERM IN STRING? JMP BYT06 YES - GO OUTPUT IT BYT12 ISZ PNTR NO - START NEXT BYTE JSB ?BPKU JMP BYT01 * * ********************************************************** * * PROCESS BASE SET EXTENSION AND MEMORY EXPANSION CODES * * ********************************************************** * XMIC STA SCODE SAVE CODE-100B CMA,INA STA OPNUM START ON PARAMETER COUNT ADA .1+6 (7) SSA,RSS CODE GRTR THAN 107B? JMP PROCX NO - OPNUM OK LDB ..M1 B = -1 CPA ..M1+5 (-6) CODE = 115B? (BITS INSTRUCTION) ADB ..M1 B = -2 STB OPNUM PROCX JSB LOUT OUTPUT MICROCODE TO BINARY JSB LIST LIST MICRO SOURCE STATEMENT LDA PLCN SAVE LOCN CNTR AT INSTRUCTION STA STAR PSEUDO LOCN CNTR STA STARX ORIGINAL LOCATION ISZ STAR BUMP PSEUDO COUNTER ISZ PLCN BUMP PROGRAM LOCATIObN COUNTER PROC1 LDA .12+4 STA CODE SET CODE = 20B (DEF) LDA STARX RESET PLCN TO INSTRUC LOCN STA PLCN CLA STA INST CLEAR INSTRUCTION STA BYFLG AND BYFLG LDA SCODE A=ORIGINAL CODE(-100B) LDB LTFLG SZB LITERAL? JMP PROC7 YES CPA .13B NO - IS CODE = 113?(NO INDIRECT) JMP PROC2 YES LDB BIT15 NO LDA .I JSB CHOP EVALUATE OPERAND JMP PRERR+1 ERROR JMP *+3 PROC2 JSB CHOPI EVALUATE OPERAND WITH NO',I' JMP PRERR+1 ERROR SZA ABSOLUTE VALUE? JMP *+4 NO ADB TW10 YES (VAL-2000B) SSB,RSS GRTR THAN 1777B? JMP PRERR YES,ERROR CPA .1+3 (4) EXTERNAL SYMBOL? RSS YES JMP PROC4 NO LDB SCODE CPB .13B CODE = 113B? (JPY) JMP PRERR YES - ERROR * PROC4 LDA PNTR STA SCN1+2 RESET POINTER LDA SIGN SZA,RSS TEST FOR EXT WITH OFFSET JMP NOTSO LDB .10B SET UP BYFLG STB BYFLG JMP *+2 SKIP ONE BECAUSE OF EXT WITH OFFSET NOTSO LDA SUMP IOR INST 'OR' INST TO SUMP AND SAVE STA INST SET VALUE INTO INSTRUCTION SSA WAS ADDR INDIRECT? ISZ SCN1+2 YESM , BUMP OPERAND LOCATION LDA RELC JSB ?DCOD STB SAVB SAVE ASCII RELOC. CHARS. LDB STAR SET PLCN TO ACTUAL LOCN STB PLCN CLB,INB SET B=1 JSB BREC GO PUNCH THE WORD LDB SAVB B = ASCII RELOC CHARS. LDA .1+3 A = 4 JSB LIST LDA SIGN TEST FOR EXT WITH OFFSET SZA,RSS JMP NOOFF NONE LDA SUMP STA INST LDB PLUS LDA .1+5 JSB LIST LIST THE OFFSET NOOFF ISZ PLCN BUMP PROG.LOCATION COUNTER ISZ STAR BUMP PSEUDO CNTR CLA STA INST CLEAR INST FROR FINAL NOP(IF ANY) STA LTFLG CLEAR LITERAL FLAG. LDB SCODE CPB .12 CODE = 114B(NOP IN 3RD WORD?) JMP PROCA YES, EMIT A 'NOP' ISZ OPNUM NO - LAST PARAMETER? JMP PROC1 NO - GO PROCESS NEXT ONE JMP HC04 YES - DONE * PROC7 CPA .10B =110B CODE? JMP PROC8 YES CPA .12 =114B CODE? JMP PROC8 YES CPA .12+1 =113B CODE? JMP PROC8 YES PRERR JSB OPERR NO - ERROR CLA STA SUMP INA STA RELC LDB LTFLG SZB,RSS LITERAL? JMP PROC4 NO JMP *+3 YES PROC8 JSB ?PLIT JMP PRERR+1 ERROR JSB MSYML LDA SAVB STA PNTR JMP PROC4 * PROCA JSB LOUT LDA .1+3 (4) SET FOR RESTRICTED LISTING JMP HC30+1 * STAR NOP PSEUDO LOCN COUNTER STARX NOP LOCN OF INSTRUCTION * * ************************************** * * PROCESS DEFINITION OF BYTE ADDRESS * * * CODES ARE 'DBL' AND 'DBR' * * ************************************** * BYTE LDA .20B STA CODE SET CODE = 'DEF' JSB CHOPI GO EVALUATE OPERAND JMP BYERR+1 ERROR EXIT CLE,ELB ADDRESS*2, E=0 FOR ERROR CHECK SEZ VALID OPERAND? JMP BYERR NO, INFORM USER ERROR ADB INST STB SUMP SUMP = BYTE ADDRESS STA INST SZA ABSOLUTE? JMP BYEX NO ADB M200B YES SSB,RSS LESS THAN 200B? JMP BYERR NO, ERROR BYEX CPA .1+3 (4) EXT? JMP BYERR YES, ERROR BYOUT ADA ..M1 (-1) AND .1+2 (3) SET 'MR' CHARACTERS FOR LOADER STA INST LDA .1+5 (6) STA BYFLG SET FLAG FOR BREC RPROCESSING LDA RELC JSB ?DCOD GO SET UP LIST CHARACTERS STB SAVB SAVE RELOCATION ASCII CHARS. CLB,INB SET FOR INSERTING A WORD JSB BREC GO TO BINARY OUTPUT ROUTINE LDB SAVB LDA SUMP STA INST SET UP ADDRESS FOR LISTING CLA JMP HC30+1 CONTINUE TO LAST PART BYERR JSB OPERR CLA STA RELC JMP BYOUT M200B OCT -200 OPNUM NOP .20B EQU .12+4 (20B) * SKP * ****************************** * * PASS 2 END PROCESSOR * * ****************************** ENDRC OCT 120000 FOR RIC = 5 * FIN2 CLB JSB BREC PUNCH REST OF LAST DBL RECORD. CLA STA ?BASF CLEAR B.P. FLAG FOR CURRENT PAGE STA PBUF STA PBUF+1 STA PBUF+2 STA PBUF+3 LDA PLEN IF PLEN=0 THERE ARE NO LITERALS SZA,RSS LITERALS PRESENT ? JMP HC56 NO-BYPASS LITERAL PROCESSING. STA PLCN YES, SET PLCN=FWA AFTER PROGRAM LDA ?X NL01 STA ENTV ADDR OF SYMBOL TABLE LDA ENTV,I 1ST WRD OF ENTRY SZA,RSS END OF TABLE? JMP NL99 YES ALF STA 1 AND ...1+6 GET ENTRY LENGTH STA ENTC LDA 1 ALF AND .12+3 GET ENTRY TYPE CPA ...1+6 LITERAL? JMP NL20 YES NL10 LDA ENTV UPDATE TO NEXT ENTRY ADDRESS ADA ENTC JMP NL01 GO TO PROCESS NEXT ENTRY * * * PROCESS A LITERAL FOR OUTPUT * NL20 LDA ENTV CMA,INA SET UP ADDR OF LITRL CONSTANT LDB ?ICSA GET LOC'N OF ASCI BUFFER STA *+3 LDA ...1+3 4 TO A JSB ?MOVE LIT CONST TO ASCI/ASCI+1 NOP LDA ?ASII STA NLST SAVE 2ND WRD LDA ?ASCI PROCESS 1ST WORD STA INST JSB LOUT PUNCH LDA ...1+3 JSB LIST LDA ENTC CPA ...1+2 IS IT 2 WORD CONSTANT? JMP NL30 NO LDA NLST YES STA INST PROCESS 2ND WORD ISZ PLCN BUMP LOCN COUNTER JSB LOUT PUNCH LDA ...1+3 2U640 JSB LIST NL30 ISZ PLCN BUMP LOCN CNTR JMP NL10 * * EXIT HERE * NL99 CLB JSB BREC * * * PUNCH 'END' RECORD * HC56 LDA .2000 FOR WCNT = 4 STA WCNT SET WORD COUNT LDA SCN1+2 POINTS TO OPERAND (IF ANY) STA PBUF+3 CLEARED IF NO EXECUTION ADDRESS SZA EXEC.ADDR.PRSNT? * * * PROCESS EXEC.ADDR. * JSB ?CHPI GO EVALUATE OPERAND JMP HC54 ERROR, OR NO EXECUTION ADDRESS CPA ...1+1 (2) B.P. RELOCATABLE ? INA,RSS YES. SET R & T (3); SKIP. CPA .1 RELOCATABLE? JMP HC55 YES JSB ?OPER ERROR - NOT RELOCATABLE HC54 CLA CLB HC55 STB PBUF+3 STORE THE EXECUTION ADDRESS. ADA ENDRC SET RIC = 5 STA PBUF+1 JSB ?PNCH * ****************** * * OUTPUT TRAILER * * ****************** HC57 CLA,INA SET A=1 FOR LIST PARAMETER LDB BLNS BLANKS FOR RELOC,INDIC. JSB LIST JSB ?ENDS * PRINT ERROR COUNT * LDB ?PLIN CPB ?PCOM TTY OUTPUT ? JMP ASMBX YES, GO TO END OF ASSEMBLER CCA NO, SET FOR TOP OF FORM JSB ?LINS GO TO LINE SKIP ROUTINE JMP ASMBX EXIT FROM ASSEMBLER NLST NOP TEMPORARY ENTC NOP TEMPORARY ENTV NOP ENTBL COUNTER .2000 OCT 2000 SPC 1 ******************************************************************** ********** CHANGE LOC'N. X IN ASMB IF THIS PROGS. LWA > 2310B ****** ******************************************************************** SPC 1 ?ART EQU ART ?BREC EQU BREC ?LKLI EQU LKLIT SPC 1 END ASMB2 I6  92064-18130 1650 S C0122 &MAS30 RTE-M ASSEMBLER SEGMENT 3             H0101 ?ASMB,R,L,C HED ** RTE-M ASMB - SEGMENT 3 ** * * * 9/29/76 * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * * NAME : ASMB3 * SOURCE: 92064-18130 * RELOC : 92064-16043 * PRGMR : C.H., H.C., S.K. * NAM ASMB3,5,99 92064-16043 REV.1650 761001 SUP * ENT ASMB3,?INS? * EXT ?BPKU,?RSTA,?PKUP,?SYMK,?CHOP,?ENDS EXT ?MSYS,?ASMB,?SEGM,?ERPR,?X EXT ?MOVE,?TFLG,?CHPI EXT ?V,?ASM1,?BNCN,?PRNT,?NDOP EXT ?NDSY,?OPER,?OPLK,?POSN * COM TEMP(322B) ********************************* * # EQU TEMP SAME AS DATA ORIGIN VAL0 EQU TEMP+1 'ASCN' AND 'SYMK' DCNT EQU TEMP+4 ...1 EQU TEMP+7 .1 EQU ...1 .4 EQU TEMP+10 .7 EQU TEMP+13 .12 EQU .1+7 ..M1 EQU .12+6 .M2 EQU TEMP+21 L EQU ..M1+6 .9 EQU #+41B .29 EQU #+42B .M8 EQU #+43B .M29 EQU #+45B BLNK EQU #+46B =40B(LOWER BLANK) .IL EQU #+47B .MBLN EQU #+50B .NO EQU #+51B BLNS EQU #+55B .E EQU #+61B NAMI EQU #+71B LOC'N FOR TEMP SYMBOL STORAGE NAME EQU #+72B FOR USE BY 'OPLK' SUMP EQU #+100B RUNNING SUM FOR 'CHOP' CNTB EQU #+106B CODE EQU #+107B OPCODE TYPE(FROM OPTABLE) INST EQU #+113B OPCODE FORMAT PLCN EQU #+117B PROGRAM LOCATION COUNTER PNTR EQU #+121B POINTS AT LAST OR CURRENT CHAR. SCN1 EQU #+125B STATE LNG/OPCODE/OPERAND/LABEL(4) SYMI EQU #+132B ADDR CNTR FOR SYMBOL TBL (SYMK) SYMP EQU #+133B SYMBOL LNG/ AND LOC'N ENTV EQU #+141B * * I/O STATEMENT BUFFER * IOBF EQU #+142B 50 WORDS + END OF STATEMENT BUFF * * INPUT BUFFER 'BUFF' STARTS IN 11TH WORD * BUFF EQU IOBF+12B PBUF EQU #+225B SAVES THE 'NAM' RECORD INFO BPKUP EQU ?BPKU CHOPI EQU ?CHPI ERPR EQU ?ERPR MOVE EQU ?MOVE MSYMS EQU ?MSYS PKUP EQU ?PKUP RSTA EQU ?RSTA X EQU ?X SPC 3 * * ASMB3 JSB RSTA LDA CODE CPA .12+3 'HED' STATE? JMP IXH YES STA ?ASM1 CLEAR 'CS' AND 'INIT' FLAGS LDB .2000 STB PLCN INITIALIZE PROGRAM COUNTER CPA .1 IS OPCODE AN ORG? JMP HI12 LDA .NO 'NO'= NO ORG STATEMENT JSB ERPR JMP HA32+1 IXH JSB INST,I GO TO HEDSB JMP ASMB3 HI12 JSB ?CHOP PROCESS AN ORIGIN VALUE JMP HA32+1 ERROR RETURN STB PLCN SET INITIAL COUNTER VALUE JMP HA32 GO TO START PASS 1 * SKP HA32 JSB RSTA GO TO GET NEXT STATEMENT. LDA CODE GET OPCODE IDENTIFIER. CPA .12 IS IT THE 'END' STATEMENT ? JMP HB00 YES, GO TO THE 'END PROCESSOR. CPA BLNK (40B) SUP/UNS? JMP HA32 IGNORE-PASS #1. CPA .32B REPLACEMENT CODE ? JMP HA63 YES * ERROR * CPA .100B USER MICROCODE ('MIC')? JMP MIC YES, GO PROCESS. ADA ..M1+2 -3 SSA JMP HA64 ORR OR ORG FOUND CPA .12B NAM? JMP HA63 YES, ERROR ADA ..M1+2 (-3) SSA 'COM','ENT' OR 'EXT' ? JMP HA63 YES - ERROR CPA ...1+4 'EQU'? JMP HA56 TO EQU CPA .9 (11B) HED? JMP HA32 IGNORE-PASS #1. CPA .12 (14B) SKP? JMP HA32 IGNORE-PASS #1. CPA .12+1 IGNORE-PASS #1. JMP HA32 IGNORE-PASS #1. CPA .12+2 (16B) LST/UNL? JMP HA32 IGNORE-PASS #1. * * * TEST FOR LABEL FIELD LDA SCN1+3 GET LABEL LENGTH SZA,RSS LABEL PRESENT ? JMP HALB NO, DONE STA SYMP SET CHAR COUNT LDB FFUB STB SYMP+1 SEkGT LABEL ADDR. CLA SET A=0 FOR ABSOLUTE VALUE LDB PLCN JSB INSR INSERT LABEL INTO SYMBOL TABLE NOP ERROR EXIT HALB LDA CODE OPCODE INDICATOR CPA DEX JMP HA40 IT'S A 'DEX' CPA BYT IS IT A 'BYT'? JMP HA40 YES, GO PROCESS. CPA .29 REP? JMP HA64 YES CPA ...1+6 (7) JMP HA54 TO ASC CPA .26B INTEGER ARITH(HARDWARE)? JMP HA70 YES.... CPA ...1+5 (6) ARITH MACRO? JMP HA63 YES, ERROR ADA .M10 -10 SSA OCT OR DEC? JMP HA40 YES. SZA,RSS BSS? JMP HA3M TO BSS PROC. LDA CODE GET OPCODE I.D. NUMBER. ADA M100B SUBTRACT 100 OCTAL SSA,RSS CODE <100B ? JMP XMIC NO, IT'S A MICROCODE MACRO. HA3B CLA,INA TO ADD 1 TO PLCN * * * INCREMENT PROGRAM LOCN. CNTR. * HA3Z ADA PLCN (HA3B+1) STA PLCN JMP HA32 .26B OCT 26 FOR HARDWARE ARITHMETIC .32B OCT 32 RPL CODE. SPC 1 * * PROCESS BSS * HA3M JSB CHOPI EVAL.OPERAND JMP HA32 ERROR LDA 1 B TO A JMP HA3Z * .12B OCT 12 .M10 DEC -10 .100B OCT 100 M100B OCT -100 DEX OCT 25 OP TYPE FOR 'DEX' BYT OCT 43 OPCODE I.D. NO. FOR 'BYT' * SKP * ************************************************* * * INSR: ADD ENTRY TO THE SYMBOL TABLE, W HACCOU * * * LINKAGE: B = VALUE ON INPUT * * * (OUTPUT) SYMP=NO.OF CHARS., SYMN=ENTRY FWA * * * L JSB INSR,I * * * L+1 ERROR RETN ('SO' OR 'DD'PRNTD)* * * L+2 NORMAL RETN * * ************************************************* .DD ASC 2,DDSO INSR NOP STB NAME+3 SAVE VALUE JSB ?SYMK SYMBOL TABLE LOOKUP u JMP INS1 LDA .DD NO, 'DD' ERROR (MULTIPLE SYMBOL) INSX JSB ERPR JMP INSR,I GET OUT HERE INS1 LDB NAMI ADB TEMP+2 STB VAL0 SET LIMIT LDA ?NDOP GET LWA AVAIL. MEM. CMA,INA ADA SYMI TEST FOR SYMBOL TBL ADA TEMP+2 OVERFLOW SSA JMP *+3 NO LDA .DD+1 'SO' SYMBOL TABLE OVERFLOW JMP INSX GO TO PRINT ERROR MESSAGE. LDA NAME+3 MOVE VALUE STA 1,I UP LDA NAMI LDB 0,I ADD ENTRY (FROM *+6) STB SYMI,I TO SYMBOL CPA VAL0 JMP INSEX EXIT INA ISZ SYMI JMP *-6 INSEX LDB SYMI STB ?NDSY SET NEW END OF SYMBOL TABLE. ISZ INSR BUMP EXIT POINT FOR A+2 EXIT JMP INSR,I EXIT HERE HA63 LDA .IL ILLEGAL OPCODE: ABS. ASSEMBLIES ! JMP HA55+2 TO ERPR * SKP * *********************** * * PROCESS OCT AND DEC * * *********************** HA40 CLB,INB B=1 CPA DEX CHECK CODE FOR 'DEX' ADB .1+1 B=3 IF CODE IS 'DEX' STB DCNT SET LOCN COUNT BUMPER CLA STA CNTB STA TEMP LDA SCN1+2 STA PNTR SET POINTER * * * PICK UP AND EXAMINE A CHARACTER * HA41 JSB PKUP (HA40+4 WAS HA41) LDB DCNT GET COUNT BUMPER CPA L+4 COMMA? JMP HA44 YES, GO SCAN FOR NEXT PARAM. CPB .1+2 IS IT=3(I.E. DEX)? JMP HA42 YES CPA L+6 PERIOD? JMP HA48 YES CPA .E 'E' ? JMP HA48 HA42 CPA BLNK END OF STATEMENT? JMP HA49 YES JMP HA41 * * * RESET FLT PT FLAG, SKIP BLANKS FOR NEXT CHAR * HA44 CLA STA TEMP JSB BPKUP LDB DCNT GET 'BUMP' COUNT JMP HA48+4 * * * FLT PT TEST FOR NUMBER USING BOTH . AND E * HA48 LDA TEMP ISZ TEMP SZA y E OR '.' COUNTED YET? CLB YES, SET B=0. * ADB CNTB (HA48+4) STB CNTB ADD TO WORD COUNT JMP HA41 * * * END OF NUMERIC PSEUDO-OP PROCESSOR * HA49 LDA DCNT ADA CNTB SET A=NO OF LOCNS TO BE USED LDB CODE GET OPCODE I.D. NUMBER. CLE PREPARE FOR REMAINDER TEST. CPB BYT BYTE? ERA YES, DIVIDE BY 2 SEZ ODD BYTE REMAINING ? INA YES, ADD 1 TO WORD COUNT. JMP HA3Z EXIT SKP * ******************************** * * PROCESS ASC (GET VALUE OF N) * * ******************************** HA54 LDA ...1+1 (2) 'ASC' INDIC.FOR CHOP JSB ?CHOP JMP HA3B * ERROR * SZA JMP HA55 * ERROR-NOT ABS.VAL. SZB,RSS ZERO WORD COUNT ? JMP HA55 YES, * ERROR * ADB .M29 -29 LDA SUMP SSB SKIP IF >28 WORDS JMP HA3Z HA55 ISZ PLCN * ERROR EXIT * LDA .MBLN 'M' ERROR(BAD OPERAND) JSB ERPR TO PRINT ERROR DIAG. JMP HA32 * ********************** * * PROCESS EQU PSEUDO * * ********************** HA56 JSB CHOPI EVALUATE OPERAND JMP HA32 *ERROR* CPA ...1+3 (4) EXT ? LDA ...1+4 (5) SET FOR NON-PNCH EXT STA TEMP NO STB TEMP+1 CLB,INB JSB MSYMS GO TO MEAS.SYMBOL, SET SYMP/SYMN LDA TEMP LDB TEMP+1 * * * SEND LABEL TO TABLE * JSB INSR TO SYMBOL TABLE INSERTION RTN NOP JMP HA32 * ****************************** * * ORG ORR REP PROC.JUMPS * * ****************************** HA64 JSB INST,I GO TO SUBROUTINE JMP HA32 HA70 LDA .1+1 A=2 JMP HA3Z * SKP * ************************ * * PASS 1 END PROCESSOR * * ] ************************ DEF BUFF HB00 LDA ?TFLG GET TABLE OUTPUT FLAG SZA,RSS JMP HB08 TABLE NOT REQUESTED - FINISH PASS LDA HB00-1 ADA .1+3 STA HB00-1 SET HB00-1 = L(BUFF+4) LDA X GET FWA OF AVAILABLE MEMORY STA ENTV TO ENTV HBX LDA ENTV,I TEST 1ST WORD OF ENTRY SZA,RSS COMPLETED? JMP HB08 YES - GO TO FINISH PASS 1 LDB ENTV GET TBL ENTRY LOCATION CMB,INB * * SEND ADDR. TO MOVE LINKAGE STB HMOV5 * * MOVE BLANKS TO BUFFER LDB BLNS STB BUFF STB BUFF+1 STB BUFF+2 STB BUFF+3 LDB FFUB ADDR. OF BUFF TO B SPC 1 * * MOVE CHARS FROM SYMBOL TABLE * ALF AND ...1+6 (7) FOR NO.OF WRDS. STA SUMP CPA ...1+1 (2) CLA IOR ...1 JSB MOVE HMOV5 NOP * * * GET VALUE OF SYMBOL * LDB SUMP (NO.OF WORDS IN ENTRY) ADB ..M1 ADB ENTV STB ENTV LDA 1,I ISZ ENTV CLE SET E = 0 FOR OCTAL CONV. JSB ?BNCN * * STORE ASCI VALUE INTO BUFF LDB HB00-1 GET L(BUFF+4) JSB ?V LDB FFUB SET PRINT PARAMETERS LDA .12+2 (14) JSB ?PRNT GO TO PRINT JMP HBX ENTRY DONE. * * SKP * * ERRORS PRINTED * HB08 JSB ?ENDS GO TO END PASS PROCESSOR SPC 1 * ******************************** * * START 'ABSOLUTE' PASS 2 HERE * * ******************************** SPC 1 * JSB ?POSN POSITION SOURCE FILE TO BEGINNING * LDA *+2 PICK UP ENT CODE TO GET ASMB5 JMP ?SEGM GO TO LOADER FOR NEXT SEGMENT ASC 1,4 * .2000 OCT 2000 FFUB DEF BUFF * SKP * ******************************************************** * * PROCESS EXTENDED INSTRUCTION SET AND USER MICROCODES * * ******************************************************** * XMIC STA B CODE-100B NOW IN B LDA .1+1 SET A=2 CPB .12 TYPE 114B? INA YES, A=3 CPB .12+1 TYPE 115B? INA YES, A=3 ADB .M8 SSB,RSS USER CODE? (101B THRU 107B) JMP HA3Z NO, USE VALUE IN A FOR PLCN BUMP ADB .1+6 ADA B A = MACRO INSTRUCTION COUNT. JMP HA3Z * ********************************************************** * * PROCESS A 'MIC' PSEUDO OPERATION (I.E. USER MICROCODE) * * * FORMAT: MIC MMM,CCC,N * * * WHERE * * * MMM = USER DESIGNATED MNEMONIC (ALL ALPHABETIC) * * * CCC = USER DESIGNATED FUNCTION CODE (0 TO 177777B) * * * N = NUMBER OF PARAMETERS IN USER OPERAND * * ********************************************************** * MIC LDA SCN1+2 STA PNTR MOVE POINTER TO OPERAND JSB ?OPLK CHECK FOR DUPLICATE MNEMONIC JMP MIC01 GOOD - MNEMONIC NOT FOUND MICOP JSB ?OPER ERROR IN OPERAND ('M' TERM) STA CODE -SET CODE NOT = 100B JMP HA32 GO GET NEXT INSTRUCTION * MIC01 LDA TEMP+5 * * SAVE USER MNEMONIC HERE * * STA SCODE SAVE 1ST 2 CHARS. LDA TEMP+6 STA MTEMP SAVE LAST CHARACTER * * * TEST 3 CHARACTERS FOR ALPHA ONLY MNEMONIC * LDA ..M1+2 STA TEMP MIC04 JSB PKUP PICK UP A CHARACTER CMA,INA ADA .100B SSA,RSS LESS THAN LETTER A? JMP MICOP YES - NON-ALPHA ADA .32B SSA GREATER THAN LETTER Z? JMP MICOP YES - NON-ALPHA ISZ TEMP LAST CHARACTER TESTED? JMP MIC04 NO - GO GET NEXT ONE LDA .21B STA CODE SET CODE 'ABS' TO FOOL CHOP RTN. LDA .1+1 SET FOR COMMA STOP IN CHOP JSB VMIC PICK UP MICRO CODE AND TEST PART STA INST SAVE USER FUNCTION CODE * CLA SET FOR NO COMMA STOP IN CHOP JSB VMIC GET VALUE OF N SSB IS VALUE OF N POSITIVE JMP MICOP NO - ERROR ADB .M8 SSB,RSS IS N GREATER THAN 7? JMP MICOP YES - ERROR ADA .100B CPA .100B WILL CODE BE 100B? LDA .30B YES - NO PARAMS. THUS IT'S =30B STA CODE SAVE CODE FOR OPTABLE ENTRY * * **************************************************** * * ENTER NEW OPCODE INTO SUPPLEMENTARY OPCODE TABLE * * **************************************************** * LDA ?NDOP GET ORG OF SUPPL. OPCODE TABLE ADA ..M1+2 SET NEW ORIGIN STA B CMB,INB START TEST FOR OVERFLOW ADB ?NDSY SSB OPTABLE OVERFLOW? JMP MIC10 NO LDA .SO YES - PRINT 'SO' ERROR JSB ERPR JMP HA32 GO FOR NEXT STATEMENT * MIC10 STA ?NDOP SET NEW OPTABLE ORIGIN LDB SCODE STB A,I STORE 1ST 2 CHARS. INA LDB MTEMP GET 3RD CHAR. ADB CODE INSERT CODE STB A,I STORE IT INTO THE TABLE INA LDB INST STB A,I STORE THE MICROCODE (FUNCTION) JMP HA32 GO FOR NEXT STATEMENT * SKP * ********************************************************** * * VMIC CHECKS FOR COMMAS, NUMERICS, AND TYPE OF OUTPUT * * * FROM OPERAND PROCESSOR (MICROCODE AND # OF PARAMETERS * * ********************************************************** * VMIC NOP STA CTM SAVE CHOP INPUT PARAMETER JSB PKUP PICK UP A CHAR. CPA L+4 IS IT A COMMA? RSS YES JMP MICOP NO - ERROR JSB BPKUP SKIP OVER FOLLOWING BLANKS STB SCN1+2 SET OPERAND PNTR TO NEXT PARAM. LDA CTM 640 JSB ?CHOP EVALUATE THE PARAMETER JMP HA32 ERROR - GO TO NEXT SOURCE STATE. SZA ABSOLUTE VALUE? JMP MICOP ERROR - NO LDA SUMP VALUE IN BOTH A AND B ON EXIT JMP VMIC,I RETURN * CTM NOP SAVE A FOR CHOP ENTRY .21B EQU .12+5 (21B) .30B OCT 30 SCODE NOP SAVE 1ST 2 NMEMONIC CHARS. MTEMP NOP SAVE 3RD CHAR. A EQU 0 B EQU 1 .SO ASC 1,SO * SPC 1 ?INS? EQU INSR SPC 1 END ASMB3 6   92064-18131 1650 S C0222 &MAS40 RTE-M ASSEMBLER SEGMENT 4             H0102 CASMB,R,L,C HED ** RTE-M ASMB - SEGMENT 4 ** * * * 9/29/76 * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAME : ASMB4 * SOURCE: 92064-18131 * RELOC : 92064-16044 * PRGMR : C.H., H.C., S.K. * NAM ASMB4,5,99 92064-16044 REV.1650 761007 * ENT ASMB4,?AREC * EXT ?SUP,?BPKU,?PKUP,?BFLG,?LFLG,?RSTA,?ERPR EXT ?OPLK,?GETC,?LINC,?LIST,?LOUT,?OKOL EXT ?CHOP,?CHPI,?OPER,?ASCN,?MSYM,?ASM1,?LINS EXT ?LST,?LPER,?PERL,?SETM EXT ?ENDS,?PLIN,?PCOM,?ASMB,?FMPE EXT WRITF EXT AI EXT CLOSE EXT DCBI EXT DCBO EXT ?ERR EXT AO EXT FCONT EXT B100 EXT .M12 * COM TEMP(322B) *********************************** * # EQU TEMP SAME AS DATA ORIGIN VALU EQU TEMP+5 ...1 EQU TEMP+7 .1 EQU ...1 .12 EQU .1+7 ..M1 EQU .12+6 L EQU ..M1+6 .9 EQU #+41B .M8 EQU #+43B .M29 EQU #+45B BLNK EQU #+46B =40B(LOWER BLANK) .NO EQU #+51B .OP EQU #+52B .OV EQU #+53B .IL EQU #+47B BLNS EQU #+55B TW10 EQU #+56B ADDRESS MASK .1000 EQU #+57B BIT15 EQU #+60B .E EQU #+61B RELC EQU #+76B RELOCATION FLAG SIGN EQU #+77B SUMP EQU #+100B RUNNING SUM FOR 'CHOP' TERM EQU #+101B NO. OF TERMS IN AN OPERAND T EQU #+102B CNTB EQU #+106B CODE EQU #+107B OPCODE TYPE(FROM OPTABLE) DSIG EQU #+110B 'ASCN' FLAG EQU #+111B FLAQ EQU #+112B INST EQU #+113B OPCODE FORMAT LAST EQU #+114B PASS EQU #+115B PASS FLAG(0=PASS 1 AND 1=PASS2) PLCN EQU #+117B PROGRAM LOCATION COUNTER PNTR EQU #+121B POINTS AT LAST OR CURRENT CHAR. SCN1 EQU #+125B STATE LNG/OPCODE/OPERAND/LABEL(4) TEST EQU #+135B TEST CHARACTER PBUF EQU #+225B WCNT EQU PBUF WORD(BLK) CNT FOR BIN.RECRD. ASM1 EQU ?ASM1 CHOP EQU ?CHOP CHOPI EQU ?CHPI ERPR EQU ?ERPR GETC EQU ?GETC LINC EQU ?LINC LIST EQU ?LIST LOUT EQU ?LOUT LST EQU ?LST OKOLE EQU ?OKOL OPERR EQU ?OPER RSTA EQU ?RSTA A EQU 0 B EQU 1 SPC 1 * **************************************** * * CONTINUE PASS 2 OF ABSOLUTE ASSEMBLY * * **************************************** SPC 1 * ASMB4 CLA STA PBUF STA PBUF+1 STA PBUF+2 STA PBUF+3 * LDA ?LPER LENGTH OF 'CLEAR' AREA LDB ?PERL GET ORIGIN OF 'CLEAR' AREA JSB ?SETM GO TO SET MEMORY ROUTINE OCT 0 TO SET MEMORY TO ZERO LDA .2000 STA PLCN INITIALIZE PROG LOC'N COUNTER CLA,INA STA PASS SET PASS FLAG JSB RSTA READ CONTROL STATEMENT LDA TW10 STA ASM1 SET FLAG FOR 'INIT' PORTION ASH JSB RSTA READ A SOURCE STATEMENT(NAM?) LDA CODE CPA .12+3 HED? JMP ASH YES, GO PICK UP THE NEXT STATEME STA ASM1 CLEAR 'CS' AND 'INIT' FLAG CPA .1 JMP HI12 LDA .NO 'NO'= NO ORG OR NAM STATEMENT JSB ERPR JMP HC05 ERROR EXIT FROM INIT HI12 JSB ?CHOP EVALUATE ORG JMP HC02 ERROR RETURN STB PLCN JMP HC02 * .2000 OCT 2000 * SKP * ****************************** * * SKIP AND SPACE LIST OUTPUT * * ****************************** SKPR LDB LINC 'SKIP'ENTRY CMB,INB JMP SK2 SPCR JSB CHOPI EVALUATE SPACE COUNT CLB,INB ERROR - SET COUNT=1 SK2 SZB,RSS SPACES=0? JMP HC04 EXIT TO HC04(START OF PASS) LDA ?LFLG NO, START LINE SKIPPING SZA,RSS LIST REQUESTED? JMWwP HC04 EXIT TO HC04(START OF PASS) LDA LST LST FLAG SZA SUPPRESS LISTING? JMP HC04 EXIT TO HC04(START OF PASS) STB DSIG SET COUNTER LDA LINC CPA ..M1 ON LAST LINE? JMP HC04 YES - EXIT ADB LINC SSB,RSS WILL IT GO TO BOTTOM OF PAGE? JMP *+5 YES,GO TO TOP OF FORM STB LINC NO, SAVE NEW LINE COUNT LDA DSIG GET NO. OF LINES TO BE SKIPPED JSB ?LINS GO TO LINE SKIPPER JMP HC04 EXIT TO GET NEXT STATEMENT JSB OKOLE SKIP TO TOP OF FORM JMP HC04 EXIT TO GET NEXT STATEMENT * * ************************* * * BINARY OUTPUT ROUTINE * * ************************* .M57 DEC -57 DEF PBUF+2 BREC NOP LDA WCNT SZB RECORD OUT? JMP HI66 NO. SZA,RSS WCNT=0? JMP BREC,I YES. HI60 LDA WCNT ** OUTPUT A BINARY RECORD ** ALF,ALF ROTATE 8 STA WCNT STORE WCNT IN UPPER PBUF ALF,ALF ADA .1+2 ADD 3 TO THE DATA COUNT STA CNTB SET COUNTER = WCNT+3 * JSB WRITF PUNCH CURRENT RECORD DEF *+5 DEF DCBO OUTPUT DCB DEF ?ERR ERROR WORD DEF PBUF PUNCH BUFFER DEF CNTB WORD COUNT SSA,RSS TEST FOR ERRORS, 0 = NONE JMP HI63 NO ERRORS JSB ?FMPE FMP ERROR ROUTINE DEF AO OUTPUT FILE NAME HI63 CLA STA WCNT INITIALIZE WCNT =0 JMP BREC,I AND EXIT HI66 SZA 1ST WORD OF BINARY RECORD? JMP HI70 -NO- LDB PLCN PLCN TO BREG STB PBUF+59 PUT IN CHECKSUM SAVER STB PBUF+1 SET RECORD ADDR. LDA BREC-1 STA STOR SET STOR=L(PBUF+2) LDA .M57 STA CNTB SET COUNT=-57 HI70 LDA INST STA STOR,I SET CURRENT BIN. WORD ISZ STOR BUMP POINTER ADA PBUF+59 UPDAiTE CHECKSUM STA PBUF+59 STA STOR,I SAVE IN LWA+1 OF PUNCH RECORD ISZ WCNT ISZ CNTB IS RECORD FULL? JMP BREC,I NO - EXIT JMP HI60 YES - GO PUNCH STOR BSS 1 SPC 2 HC02 LDA ...1+1 LIST PARAMETER HC03 JSB LIST * * * READ NEXT STATEMENT * HC04 JSB RSTA READ NEXT STATEMENT * * * TEST MNEMONIC CODES FOR PROCESS TYPE * * HC05 LDA CODE LDB INST CPA .100B CODE = 'MIC' ? JMP X39 YES, GO TO LIST IT. ADA M100B SUBTRACT 100 OCTAL SSA,RSS CODE >100B ? JMP XMIC YES, IT'S A MICROCODE MACRO. LDA CODE GET OPCODE I.D. AGAIN. CPA L+3 (43) SOC OR SOS ? JMP HC28 YES AND .M8 (177770) CPA L I/O ? JMP IOPR YES ARS,ARS SHIFT A RIGHT 4 BITS ARS,ARS CPA .1+2 60 OR 70?(MICRO-OP?) JMP MICR YES LDA CODE ADA CODLC SET UP ADDRESS OF PROCESSOR JMP A,I JUMP TO OPCODE PROCESSOR * SKP * ************************ * * PROCESSOR JUMP TABLE * * ************************ * * CODLC DEF *,I DEF HC42 ORG 1 DEF HC42 ORR 2 DEF HC38 *COM 3 DEF HC38 *ENT 4 DEF HC38 *EXT 5 DEF HC38 *ARITH 6 DEF NUMP ASC 7 DEF NUMP DEC 10 DEF NUMP OCT 11 DEF BSSP BSS 12 DEF EQUP EQU 13 DEF FIN2 END 14 DEF HC38 *NAM 15 DEF MEMRY MEMORY 16 DEF X50 HED 17 DEF MEMRY DEF 20 DEF HC26 ABS 21 DEF SKPR SKP 22 DEF SPCR SPC 23 DEF X54 LST/UNL 24 DEF NUMP DEX 25 DEF HC70 HDW ARITH 26 DEF HC80 HDW SHL2IFT 27 DEF HC30 CLO, ETC. 30 .I OCT 111 ASCII I 31 DEF HC38 *RPL 32 CBIT OCT 175777 33 .1777 OCT 1777 34 DEF X52 REP 35 M17 DEC -17 36 -17 FOR SHIFT-ROT CNTC NOP 37 MICRO-OP PROC DEF X56 SUP/UNS 40 DEF BYTE DBL 41 DEF BYTE DBR 42 DEF BYTEG BYT 43 INSV NOP MICRO-OP PROC SUM. EQU INSV MEMORY REF PROC. DEX OCT 25 'DEX' OPCODE TYPE * SKP * * PROCESS MEMORY REFERENCE INSTRUCTIONS * * MEMRY LDA INST AND ..M1+1 CLEAR LDSB OF 'INST' STA INST LDA .I SET FOR INDIRECT BIT LDB BIT15 INDIRECT BIT MASK(100000B) JSB CHOP JMP HC17E ERROR EXIT HCX STB SUM. OPERAND VALUE CLB LIST PARAMETER=0 HCXL STB TERM SAVE THE LIST PARAMETER LDA SUM. LDB CODE CPB .12+4 (16) DEF? JMP HC17 ADA TW10 NO - TEST FOR OPERAND>1023 SSA,RSS IS IT? JMP *+5 YES. LDA INST NO - SET TO CLEAR'CURRENT' BIT. AND CBIT CURRENT BIT MASK(175777) STA INST RESTORE JMP HC14 LDA PLCN TEST NOW FOR OPER.AND INSTR. AND TW10 IN THE SAME PAGE OF MEMORY CMA,INA ADA SUM. AND TW10 SZA,RSS IN SAME PAGE? JMP *+3 YES LDA .OV NO - IT'S AN OVERFLOW JSB ERPR LDA .1777 AND SUM. STRIP UPPER 6 BITS OF OPERAND STA SUM. HC14 LDA SUM. GET ADDRESS HC17 IOR INST FOR INSTRUCTION, AND STA INST SET LOADER FLAG * * * OUTPUT A BINARY WORD * * HC19 CLB,INB JSB BREC * * * OUTPUT A LINE FOR LISTING * * LDB BLNS GET BLANKS FOR LIST ROUTINE LDA TERM GET THE LIST PnARAMETER JSB LIST ISZ PLCN JMP HC04 * SKP * ***************** * * BSS PROCESSOR * * ***************** BSSP JSB CHOPI EVAL. OPERAND JMP HC02 ERROR SZB,RSS B=0? JMP HC02 YES CLB B=0 JSB BREC CLA A=0 LDB BLNS NO RELOC. INDIC. JSB LIST LDA SUMP PICK UP BLOCK LENGTH FOR PLCN ADA PLCN STA PLCN JMP HC04 EXIT * SKP * ********************************************** * * PROCESS THE 'DEF' FOLLOWING THE FIRST WORD * * * OF AN ARITHMETIC PAIR * * ********************************************** HC70 JSB LOUT OUTPUT THE ARITH. OPERATION JSB LIST LIST THE FIRST WORD LDA .12+4 (20B) STA CODE =DEF CLA STA INST CLEAR INST LDA .I SET UP FOR INDIRECT BIT LDB BIT15 MASK= 100000B JSB CHOP NOP ISZ PLCN BUMP LOCATION COUNTER STB SUM. SAVE OPERAND VALUE LDB .1+3 LIST PARAMETER=4 JMP HCXL HC17E CLA LIST PARAMETER =0 STA TERM SAVE IT JMP HC17 * * * PROCESS 'ABS' OPCODE * * HC26 JSB CHOPI GO EVALUATE OPERAND JMP HP2D ERROR STB INST JMP HP2D OK.. * * * OUTPUT BIN RECRD AND/OR LIST LINE * * HC30 JSB LOUT JSB LIST * * * ADD 1 TO PROG. LOCN. CNTR. * * ISZ PLCN BUMP LOCATION CNTR JMP HC04 * * * COM,ENT,EXT AND ARITH MACRO * HC38 LDA .IL ILLEGAL IN ABSOLUTE ASSEMBLY JSB ERPR X39 CLA,INA 1 TO A JMP HC03 * SKP * * * PRE-PROCESSOR FOR ORG AND ORR * * HC42 CLB OUTPUT A JSB BREC RECORD JSB INST,I JUMP TO CORRECT SUBROUT. JMP HC02 BACK TO START LIST X50 LDA ?LFLG  GET THE LIST FLAG SZA,RSS IS LIST FLAG OFF? JMP HC04 YES - GO TO NEXT STATEMENT JSB INST,I TO HEADER SUBROUTINE JSB OKOLE SPACE TO BOTTOM OF PAGE JMP HC04 GET NEXT STATEMENT X52 JSB INST,I TO REPSB JMP X39 X54 STB LST SET LST/UNL FLAG JMP HC04 X56 STB ?SUP SET 'SUP/UNS' FLAG JMP X39 SPC 1 * * PASS 2 'EQU' PROCESSOR * * EQUP JSB CHOPI EVAL. OPERAND CLB ERROR EXITS LDA PLCN STA SUMP SAVE PLCN VALUE STB PLCN SET PLCN=0 LDA ...1+1 (2) LIST 'EQU' JSB LIST LDA SUMP REPLACE PLCN VALUE STA PLCN JMP HC04 HC80 JSB CHOPI GO EVALUATE THE COUNT JMP HC84 BAD COUNT EXIT ADB M17 B-17 SSB B GRTR THAN 16? CPB M17 NO. IS B=0? JSB OPERR YES, IT'S AN 'M' ERROR,. LDA SUMP GET THE SHIFT OR ROTATE COUNT.. AND .12+3 MASK OUT LOWEST 4 BITS HC82 ADA INST MAKE UP THE FINAL INSTRUCTION STA INST JMP HC30 GO AND OUTPUT THE INSTRUCTION HC84 CLA SET COUNT FOR 16 BIT SHIFT ROTATE JMP HC82 * SKP * ************************* * * OCT/DEC/ASC PROCESSOR * * ************************* NUMP LDA SCN1+2 STA PNTR SET POINTER CLA STA T+1 SET FPAS=0 LDA CODE CPA ...1+6 (7) JMP ASCR HE06 LDB PNTR PNTS AT 1ST CH OF NUMBER STB SIGN CLB STB CNTC INB STB RELC * * * TEST CHARACTER FOR TERMINATOR * HE08 LDA PNTR JSB GETC STA TERM CPA L+4 COMMA? JMP HE12 YES CPA BLNK BLANK? JMP HE12 YES * * * UPDATE CHAR.CNTR(CNTC) AND POSN. PNTR(TLOC) * LDB CODE CPB .9 OCT? JMP HE10+1 YES CPB DEX 'DEX'?9 JMP HE11 YES LDB ...1+1 (2) NOT OCTAL CPA L+6 PERIOD? STB RELC YES, SET RELC = 2 CPA .E 'E' ? HE10 STB RELC YES, SET RELC FOR USE AS ASCN MD ISZ CNTC ISZ PNTR BUMP PNTR JMP HE08 HE11 LDB .1+2 SET B=3 FOR DEX MODE JMP HE10 * * * SET UP VALUE FOR LIST AND/OR PUNCH * HE12 LDA CODE CLB CPA .9 OCT? JMP *+3 YES LDB RELC NOT OCT BLF,BLF ADB CNTC LDA SIGN JSB ?ASCN GO TO 'ASCI' CONVERSION CLA SET A=0 STA INST STB SUMP STORE VALUE LDA VALU SAVE LEAST SIG PART OF 'DEX' STA SIGN HE18 JSB NOUT LDA RELC ARS,SLA IS RELC = 0 OR 1? JMP HE20 NO, ITS 3 OR 2 LDA TERM GET THE TERMINATOR CPA BLNK IS THIS THE END OF THE TERM ? JMP HC04 YES, EXIT ON BLANK ISZ PNTR BUMP PNTR JSB ?BPKU SCAN OVER BLANKS LDA PNTR TEST FOR EOL 1976-09-22-1500 CMA,INA ADA SCN1 THE RECORD CHARACTER COUNT SSA,RSS JMP HE06 MORE DATA FOLLOWS LDA .IL SOMETHING IS NOT GOOD JSB ?ERPR CLA MAKE A NOP STA INST AND JSB NOUT DUMP IT JMP HC04 DONE * HE20 LDA SUMP STA INST VALUE TO INST LDB RELC CPB .1+2 IS RELC=3? JMP HE22 YES- SET SUMP FOR 3RD WORD CLA HE21 STA RELC SET RELC FOR NEXT TEST JMP HE18 * HE22 LDA SIGN STA SUMP VALU TO SUMP LDA .1+1 FOR SETTING RELC=2 JMP HE21 * *************************** * * OCT DEC ASC WORD OUTPUT * * *************************** NOUT NOP LDA T+1 1ST LIST LINE FLAG SZA 1ST? JMP *+4 NO INA 1 TO A STA T+1 SET FLAG CLA,RSS  CLEAR A,SKIP LDA ...1+3 (4) SET A=4 FOR LIST LDB BLNS JSB LIST CLA CLB,INB JSB BREC PUNCH ISZ PLCN BUMP LOCN CNTR. JMP NOUT,I EXIT * ******************** * * PROCESS ASC HERE * * ******************** ASCR LDA ...1+1 (2) INDIC.'ASC' JSB CHOP GO EVALUATE WORD LENGTH JMP HC30 ERROR EXIT SZA VALUE ABSOL.? JMP HP2D-1 NO; ERROR SZB,RSS ASKING FOR ZERO WORDS? JMP HP2D-1 YES * ERROR * ADB .M29 (-29)(VALUE IS IN SUMP TOO) SSB,RSS VAL.>28? JMP HP2D-1 YES; ERROR LDA PNTR STA T LDA SUMP CMA,INA STA CNTC VALUE(COMPL.) TO CNTC * * * PICK UP WORDS AND STORE INTO PROGRAM * SB ISZ T LDA T JSB GETC ALF,ALF STA TEST ISZ T LDA T JSB GETC STA INST * * * OUTPUT 2 ASCI CHARACTERS * JSB NOUT CLA STA TEST ISZ CNTC JMP SB JMP HC04 DONE, GO GET NEXT STATEMENT * ************************* * * PROCESS I/O GROUP HERE * * ************************** RAM OCT 105000 OCT 177400 OCT 300 IOPR LDA SCN1+2 IS OPERAND SZA PRESENT? JMP P YES! LDA CODE NO OPERAND CPA L+1 'HLT'? JMP HP2D YES * * * OPERAND ERROR EXIT HERE * JSB OPERR (HP2D-1) HP2D CLA STA TERM SAVE THE LIST PARAMETER JMP HC19 P LDA .C TEST FOR 'CLEAR FLAG'(C). LDB .1000 GET 'C' MASK FOR IO INSTR. JSB CHOP JMP Q ERROR EXIT LDA 1 LDB INST LOAD B WITH OCTAL INSTR ADA IOPR-2 MASK FIRST PART CPB RAM SEE IF A RAM INSTR RSS SKIP NEXT MASK IF RAM ADA IOPR-1 IF NOT RAM ADD  SECOND PART LDB SUMP RESTORE B REG * SKP * * * TEST FOR VALUE>63 * * SSA VALUE >64 ? JMP *+4 YES-O.K. LDA .OV 'OV' ADDRESS OVERFLOW JSB ERPR GO PRINT ERROR MESSAGE. Q CLB ADB INST (HE54+1) STB INST JMP HP2D .C OCT 103 ASCII 'C' * * * PROCESS SOC OR SOS * HC28 LDA SCN1+2 PNTR TO OPERAND LDB 0 A TO B JSB ?MSYM ADA ..M1 SZA JMP HP2D LDA LAST CPA .C IS 'C' PRESENT? JMP *+2 YES JMP HP2D NO * * * 'OR' 1 TO BIT 9 (C BIT) OF I/O INST * * LDA INST IOR .1000 MASK IN CURRENT BIT STA INST JMP HP2D * SKP * ********************** * * MICRO-OP PROCESSOR * * ********************** MICRD OCT 7777,4000,60000,60,71,14000 * * * INITIALIZE FLAGS * MICR CLA STA CNTC =0 WHEN CLE APPEARS STA TERM BITS 12-11 = 1 IF B REG * BITS 12-11 = 2 IF A REG STA TEMP+4 BITS 14-13=1 IF SRG; =2 IF ASG STA INSV USED TO ACCUMULATE THE CODE STA FLAG STA TEST CLEAR CHAR TESTER * * * START HERE FOR EACH NEW CODE * F LDA INST UNPACK THE MICRO-OP CODE * * THE FORMAT IS: * BITS 14-13=1 IF SRG,2 IF ASG, 0 IF * EITHER * BITS 12-11=1 IF BREG,2 IF AREG, 0 IF * NEITHER. * BITS 11-0 = ACTUAL 12 BIT CODE AND MICRD EXTRACT OPCODE STA FLAQ SAVE IT (=+2) LDA CODE THIS IS THE GROUP NUMBER. CMA,INA MAKE SURE IT'S BIGGER THAN THE LAST. ADA FLAG A=(LAST GRP)-(PRESENT GRP) SSA JMP O SEQUENCE IS OK * * * IF PRES GRP IS GO WE CAN CHANGE IT AND MAY BE OK LDA CODE CPA MICRD+3 IS CODE TYPE = 60B (MICRO-OP)? JMP *+4 CHANGE ERROR GROUP AND OP CODE MERR LDA .OP 'OP' FOR OPCODE ERROR JSB ERPR RETURN JMP HP2D LDA MICRD+4 71B, CHANGE GROUP (FROM *-4) STA CODE TO 71 * * * MOVE BITS 8-5 OF OPCODE TO BITS 4 AND 2-0 * LDA FLAQ AND MICRD+1 SET A/B BIT STA 1 SAVE IN B. XOR FLAQ ALF,ALF MOVE BITS 0 AND 15-13 RAR,SLA MOVE BIT 0 TO INA BIT 1. ALF,RAR ROTATE LEFT 3, TO BITS 4,2-0 IOR 1 PUT IN THE A/B BIT JMP F+2 O LDA CODE STA FLAG SET LAST GRP TO PRESENT GRP * * * CHECK REGISTER CONSISTENCY * LDA INST AND MICRD+5 GET BITS 12-11 IOR TERM CPA MICRD+5 IF EQUAL, THERE'S A REGISTER JMP MERR INCONSISTENCY. STA TERM NEW REGS TO REGS, * * * OTHERWISE CHECK GROUP CONSISTENCY * LDA INST AND MICRD+2 BITS 14-13 IOR TEMP+4 CPA MICRD+2 IF EQUAL,THERE ARE 2 CODES JMP MERR FROM DIFFERENT GROUPS. STA TEMP+4 * * * CHECK FOR CLE * LDA FLAQ SZA,RSS ISZ CNTC * * * NOW 'OR' THE CODE INTO CURRENT CODE SO FAR * IOR INSV STA INSV * * * GET THE NEXT CHARACTER * LDA SCN1+1 OPCODE PNTR ADA ...1+2 (3) STA PNTR POINTS AT POS'N FOLLOWING OPCODE JSB ?PKUP CPA BLNK IS THIS CHAR. A BLANK ? JMP *+7 YES, WE'RE DONE. CPA L+4 COMMA ? JMP *+2 JMP MERR * * * GET THE NEXT OPCODE * JSB ?OPLK OPCODE LOOKUP JMP HP2D JMP F * * * TO FINISH TEST CLE; IF USED AND IN ASG SET, ADD 40 * * TO THE CODE. LDA TEMP+4 (FROM *-7) ALF,ALF SZA,RSS c IOR BLNK (40B) LDB CNTC SZB,RSS CLA IOR INSV STA INST JMP HP2D * SKP * ***************** * * PROCESS 'END' * * ***************** * FIN2 CLB JSB BREC PUNCH REST OF LAST DBL RECORD CLA,INA LDB BLNS JSB LIST LIST 'END' STATEMENT JSB ?ENDS GO TO END SUBROUTINE LDB ?PLIN CPB ?PCOM TTY OUTPUT? JMP ASMBX YES CCA NO - ITS ON A PRINTER JSB ?LINS SKIP TO TOP OF FORM JMP ASMBX GO TO COMPLETION * SKP * * ********************************************************* * * PROCESS BASE SET EXTENSION AND MEMORY EXPANSION CODES * * ********************************************************* * XMIC STA SCODE SAVE CODE-100B CMA,INA STA OPNUM START SETTING PARAMETER COUNT ADA .1+6 SSA,RSS CODE GRTR THAN 107B? JMP PROCX NO - OPNUM IS OK LDB ..M1 B = -1 CPA ..M1+5 BIT TYPE INSTR.? (115B) ADB ..M1 B = -2 IF YES STB OPNUM SAVE PARAMETER COUNT PROCX JSB LOUT OUTPUT MICROCODE TO PUNCH JSB LIST LIST SOURCE STATEMENT LDA PLCN GET CURRENT LOCN COUNTER VALUE STA STAR SAVE IN PSEUDO COUNTER STA STARX SAVE AS ORIGINAL VALUE ISZ STAR BUMP PSEUDO ISZ PLCN BUMP ACTUAL * PROC1 LDA .20B SET CODE TO = 20B(DEF) STA CODE IN ORDER TO FAKE OUT CHOP LDA STARX STA PLCN RESET PLCN TO STARTING VALUE CLA STA INST CLEAR INSTRUCTION LDA SCODE CPA .13B IS CODE = 113B?(NO INDIRECT) JMP PROC2 YES LDB BIT15 NO LDA .I JSB CHOP EVALUATE AN OPERAND JMP PROC3 ERROR EXIT JMP PROC4 NORMAL RETURN * PROC2 JSB CHOPI EVALUATE OPER.(NON-INDIRECT) JMP PROC3 8NLH ERROR EXIT JMP PROC4 NORMAL RETURN PROC3 CLA STA SUMP SET VALUE = 0 PROC4 LDA PNTR STA SCN1+2 RESET POINTER TO NEXT OPERAND LDA SUMP IOR INST STA INST INST = OPERAND VALUE SSA WAS ADDR INDIRECT? ISZ SCN1+2 YES, BUMP LOCN OF OPERAND LDB STAR STB PLCN SET LOCN COUNTER TO ACTUAL VALUE JSB LOUT GO PUNCH IT LDA .1+3 JSB LIST GO LIST IT ISZ PLCN BUMP LOCN COUNTER ISZ STAR BUMP PSEUDO LOCN COUNTER CLA STA INST CLEAR INST IN CASE FINAL NOP LDB SCODE CPB .12 CODE=114B? (NOP IN LAST WORD) JMP PROCA YES - EXIT ISZ OPNUM LAST OPERAND? JMP PROC1 NO - GO PROCESS NEXT ONE JMP HC04 YES - GO FOR NEXT SOURCE STATEM. * PROCA JSB LOUT GO PUNCH NOP LDA .1+3 SET FOR RESTRICTED LIST JMP HC30+1 GO. * STAR NOP PSEUDO LOCN COUNTER STARX NOP LOCN OF INSTRUCTION .13B OCT 13 13B SCODE NOP SAVE CODE-100B .100B OCT 100 100B M100B OCT -100 -100B OPNUM NOP SAVE OPERAND COUNT .20B EQU .12+4 20B ROTFL OCT 125252 ODD/EVEN FLAG LMASK OCT 377 377B UMASK EQU RAM+1 177400B N* * ************************************ * * GENERATE A STRING OF BYTES. * * * OCTAL NUMBERS ONLY * * * -377 >= NUMBER <=+377 * * ************************************ * BYTEG LDA SCN1+2 START INITIALIZATION STA PNTR SET PNTR TO 1ST BYTE CLA STA T+1 SET FIRST LINE LIST OUTPUT FLAG LDA ROTFL STA SCODE SET RIGHT/LEFT ALTERNATOR * BYT01 LDB PNTR STB SIGN SAVE START OF BYTE CLB STB CNTC INITIALIZE CHARACTER COUNT * BYT03 LDA PNTR GET A CHARACTER JSB GETC STA TERM SAVE IT CPA L+4 COMMA? (END OF BYTE) JMP BYT05 YES GO PROCESS A BYTE CPA BLNK BLANK? (END OF BYTE AND STRING) JMP BYT05 YES GO PROCESS A BYTE * ISZ CNTC BUMP CHAR. COUNT ISZ PNTR BUMP CHAR. POINTER JMP BYT03 GO GET NEXT CHAR. * BYT05 LDB CNTC B=CHARACTER COUNT LDA SIGN A = POINTER TO BYTE JSB ?ASCN CONVERT BYTE TO OCTAL NUMBER CLA ERROR RETURN - SET A=0. STA B SAVE VALUE IN B AND UMASK SZA GRTR THAN 377B? CPA UMASK MAYBE - TEST FOR GOOD NEG. VALUE JMP *+3 NUMBER IS OK JSB OPERR ERROR CLB LDA B AND LMASK LDB SCODE RBR,SLB LEFT BYTE BEING PROCESSED? JMP BYT10 YES STB SCODE SAVE LEFT/RIGHT FLAG ADA INST NO - SET UP TO GENERATE A WORD STA INST BYT06 JSB NOUT OUTPUT A WORD TO LIST/PUNCH LDA TERM GET LAST CHAR. TESTED CPA BLNK BLANK? (END OF STATEMENT) JMP HC04 YES - EXIT JMP BYT12 NO - GO START NEXT BYTE * BYT10 ALF,ALF PROCESS LEFT BYTE STA INST PLACE IN UPPER 'INST' STB SCODE SAVE LEFT/RIGHT FLAG LDB TERM CPB BLNK LAST TERM IN STRING? JMP BYT06 J   YES - GO OUTPUT IT BYT12 ISZ PNTR NO - START NEXT BYTE JSB ?BPKU JMP BYT01 * * ******************************************************* * * PROCESS BYTE LOCN DEFINE INSTRUCTIONS - DBL AND DBR * * ******************************************************* * BYTE LDA .20B STA CODE SET CODE=DEF TO FAKE OUT CHOP JSB CHOPI JMP HC17E ERROR EXIT CLE,ELB ADDRESS*2,E=0 FOR ERROR CHECK SEZ VALID OPERAND? JMP HP2D NO INFORM USER OF ERROR JMP HCX GO COMPLETE PROCESSING * SPC 1 * * * ASMBX JSB FCONT WRITE AN EOF MARK ON OUTPUT FILE DEF *+4 DEF DCBO DEF ?ERR DEF B100 SSA,RSS ERRORS? JMP CLOUT NO THEN CLOSE OUTPUT FILE CPA .M12 -12 ERROR? JMP CLOUT YES,THEN IGNORE IT JSB ?FMPE DEF AO+1 CLOUT JSB CLOSE CLOSE BINARY FILE DEF *+3 DEF DCBO OUTPUT DCB DEF ?ERR ERROR WORD SSA,RSS TEST FOR ERRORS JMP ?ASMB NO ERRORS JSB ?FMPE FMP ERROR ROUTINE DEF AO+1 OUTPUT FILE NAME * ?AREC EQU BREC SPC 1 END ASMB4 K   92064-18132 1650 S C0122 &MAS50 RTE-M ASSEMBLER SEGMENT D             H0101 TASMB,R,L,C HED ** RTE-M ASMB - SEGMENT D ** * * * 9/24/76 * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * * NAME : ASMBD * SOURCE: 92064-18132 * RELOC : 92064-16050 * PRGMR : C.H., H.C., S.K. * NAM ASMBD,5,99 92064-16050 REV.1650 761001 * ENT ASMBD * EXT ?ASMB,?BPKU,?PKUP,?RSTA,?SETM,?SEGM,?ASM1 EXT ?MESX,?FLGS,?AFLG EXT ?X,?Z,?LWA,?RFLG,?ICSA,?LSTL EXT ?XRFI,?NEAU,?HA38 EXT ?FP,?FPT,?NDSY,?FMPE,LSTLU,OUTLU * EXT AI EXT DCBI EXT ?ERR EXT OPEN EXT OPTNI EXT AL EXT DCBL EXT OPTNL EXT CREAT EXT DCBO EXT AO EXT OPTNO * * * **************************** * * TEMPORARY AND FLAG REGION* * **************************** * * COM TEMP(7) COM ...1(7) COM .12(6) COM ..M1(6) COM L(7) COM .9 COM .29 COM .M8 COM .M15 COM .M29 COM BLNK COM .IL COM .MBLN COM .NO COM .OP COM .OV COM .UN COM BLNS COM TW10 COM .1000 COM BIT15 COM .E COM .B(2) COM RC(5) COM NAMI COM NAME(40) COM IOBF(63B) COM PBUF(72B) *************************** * A EQU 0 B EQU 1 DATA DEF *+1 * ...1 DEC 1,2,3,4,5,6,7 * .12 DEC 12,13,14,15,16,17 * ..M1 DEC -1,-2,-3,-4,-5,-6 * L OCT 50,51,52,53,54,55,56 ( ) * + , - . * .9 DEC 9 * .29 DEC 29 (35B) * .M8 DEC x-8 * .M15 DEC -15 * .M29 DEC -29 * BLNK OCT 40 LOWER BLANK,UPPER 0 (=40B) * .IL ASC 1,IL * .MBLN ASC 1,M * .NO ASC 1,NO * .OP ASC 1,OP * .OV ASC 1,OV * .UN ASC 1,UN * BLNS ASC 1, * TW10 OCT 176000 ADDRESS MASK * .1000 OCT 1000 * BIT15 OCT 100000 * .E OCT 105 * .B OCT 102 DEF RC ADR OF RC * RC ASC 5,E R B C X .1 EQU ...1 * NAMI DEF NAME LOC'N FOR TEMP SYMBOL STORAGE * NAME OCT 0,0,0,0 OPLK USAGE DATAE DEF * # EQU TEMP SAME AS DATA ORIGIN .4 EQU TEMP+10 PASS EQU #+115B PASS FLAG(0=PASS 1 AND 1=PASS2) PLCN EQU #+117B PROGRAM LOCATION COUNTER PLEN EQU #+120B LIT LENGTH PASS 1/LIT ORG PASS 2 PNTR EQU #+121B POINTS AT LAST OR CURRENT CHAR. * * I/O STATEMENT BUFFER * * *(INPUXFFER(BUFF) STARTS IN 11TH WORD)* BUFF EQU IOBF+12B * CON DEF *+1 * PBUF OCT 10400,20000,0 START OF PUNCH BUFR(NAM FMT) ASC 3, OCT 0,0,0,0,143,0,0,0,0,0,0 ASMB0 OCT 5757 FOR ASMB CHECK ATEMP DEF TEMP+7 CNT DEC -17 APBUF DEF PBUF LSIZE DEC 64 .M2 EQU TEMP+21 * * ASMBD LDB DATA ADR OF COMMON - INITIALIZE LDA B,I COMMON BY MOVING A BLOCK OF STA ATEMP,I DATA INTO IT ISZ ATEMP INB CPB DATAE RSS JMP *-6 * LDB APBUF LDA CON,I STA B,I INB ISZ CON ISZ CNT JMP *-5 CLA EXTRA WORD FOR BUFFER OVERFLOW STA PBUF+60 * OPIN JSB OPEN OPEN SOURCE FILE DEF *+7 DEF DCBI INPUT DCB DEF ?ERR ERROR WORD DEF AI+1 NAME FROM GTFIL DEF OPTNI OPEN OPTIONS DEF AI+5 SECURITY CODE DEF AI CR # SSA,RSS TEST FOR OPEN ERRORS JMP CRLST f\ NO ERRORS JSB ?FMPE FMP ERROR ROUTINE DEF AI+1 * CRLST LDA LSTLU IS LIST FILE AN LU? SZA JMP OPLST YES, THEN DO NOT CREATE IT JSB CREAT CREATE LIST FILE DEF *+8 DEF DCBL LIST FILE DCB DEF ?ERR ERROR WORD DEF AL+1 LIST FILE NAME DEF LSIZE SIZE OF LIST FILE DEF .4 TYPE OF LIST FILE DEF AL+5 SECURITY CODE DEF AL DRN OR -LU# SSA,RSS ERRORS? JMP OPLST NO CPA .M2 DUPLICATE FILE NAME? JMP OPLST YES THEN OPEN FILE JSB ?FMPE FMP ERROR ROUTINE DEF AL+1 LIST FILE NAME JMP CRLST CREATE FILE AGAIN OPLST JSB OPEN OPEN LIST FILE DEF *+7 DEF DCBL LIST DCB DEF ?ERR ERROR CODE DEF AL+1 NAME FROM GTFIL DEF OPTNL OPTION WORD DEF AL+5 SECURITY CODE DEF AL CR # SSA,RSS ERRORS? JMP ASMD1 NO JSB ?FMPE YES DEF AL+1 LIST FILE NAME * ASMD1 LDA ?ICSA CMA,INA STA ?LSTL CLA STA PASS SET PASS FLAG=0 (PASS 1) JSB ?RSTA READ AND PRINT CONTROL STATEMENT * * * TEST FOR 'ASMB' IN FIRST 4 POSITIONS * * LDA BUFF CMA,INA ADA BUFF+1 CPA ASMB0 =5757B (I.E. =ASMB?) JMP COPS YES * * * CONTROL STATEMENT ERROR ROUTINE * * CSER LDA .CS 'CONTROL' STATEMENT'ERROR LDB .CS+1 JSB ?MESX PRINT MESSAGE JMP ?ASMB ASSEMBLER EXIT * * * TEST FOR CONTROL OPTIONS (A,B,C,F,L,N,R,T,X,Z) * * COPS LDA .1+4 (5) STA PNTR SET PNTR = 5 CLA INITIALIZE STA XFOPT X OR F OPTION COUNT COPUP JSB ?PKUP GET NEXT CHARACTER CPA BLNK DONE ? JMP G YES SZA,RSS CHAR=0? JMP G YES, 0K CPA L+4 COMMA? K{ RSS -YES- JMP CSER -NO- ERROR JSB ?BPKU SKIP BLANKS LDB ?FLGS LOC'N OF CONTROL CHAR SET CPA .B =B? JMP BCON1 YES, IGNORE IT, READ NEXT CHAR CPA .L =L? (LIST) JMP BCON YES CPA .R =R? (RELOC.-NOT NECESSARY) ADB ...1 YES CPA .T =T? (SYMBOL TABLE PRINT) ADB ...1+1 YES CPA .N IS IT FOR IFN? ADB ...1+2 YES CPA .Z IS IT FOR IFZ? ADB .1+2 YES CPA .A =A? (ABSOLUTE ASSEMBLY?) ADB .1+3 YES CPA .C =C? (CROSS REF. TABLE?) ADB .1+4 YES CPB ?FLGS SKIP IF ANY OPTION FOUND JMP XTST NO NICE MATCH SO FAR BCON STA 1,I SET OPTION FLAG BCON1 ISZ PNTR BUMP PNTR FOR NEXT CHAR. JMP COPUP GO FOR NEXT OPTION .L OCT 114 ASCII 'L' .N OCT 116 'N' .R OCT 122 'R' .T OCT 124 'T' .Z OCT 132 'Z' .A OCT 101 'A' .C OCT 103 'C' .X OCT 130 'X' .F OCT 106 'F' XFOPT DEC 0 'X' OR 'F' OPTION COUNT CNTX DEC -12 LENGTH OF FLOATING POINT OPCODE ENTRIES DESTN DEF ?FP LOC'N OF HDWE. 'FIX/FLT' OPCODES AS.FI OCT 43111 ASCII 'FI' TO ENABLE 'FIX/FLT' OPCODES DESLO DEF ?FPT LOC'N OF FLOATING POINT OPCODE ENTRIES * MVLC DEF *+1 FLOATING POINT OPCODE TBL. VALUES * * ****** FAD ******* ****** FDV ******* OCT 43101,42026,105000,43104,53026,105060 * * ****** FMP ******* ****** FSB ******* OCT 43115,50026,105040,43123,41026,105020 * * * END OF FLOATING POINT ENTRIES * * SKP CS.CK NOP LDA XFOPT LOAD A WITH OPTION FLAG SZA SKIP IF FLAG 0 JMP CSER IF 1 PRINT CS ERROR INA INCREMENT VALUE OF FLAG `STA XFOPT SAVE IN FLAG POSITION JMP CS.CK,I RETURN * FMOVE JSB CS.CK GO CHECK LEGAL OPTION LDB DESTN LOAD B WITH TABLE POINTER RBL,CLE,SLB,ERB CLEAR INDIRECT BIT, IF ANY. LDB B,I PUT POINTER ADDR. IN B LDA AS.FI LOAD A WITH ASCII "FI" STA B,I STORE IN FIX PART OF TABLE LDB DESLO LOAD B WITH SECOND TABLE POINTER RBL,CLE,SLB,ERB CLEAR INDIRECT BIT, IF ANY. LDB B,I PUT POINTER ADDR. IN B TMOV2 LDA MVLC,I LOAD FIRST WORD STA B,I STORE IN TABLE ISZ MVLC INCREMENT TO NEXT WORD INB INCREMENT POINTER ISZ CNTX INCREMENT COUNT, SKIP IF 0 JMP TMOV2 RETURN FOR NEXT WORD JMP BCON+1 RETURN * XTST CPA .F IS OPTION =F JMP FMOVE YES, GO CHANGE TABLE CPA .X IS OPTION =X JMP TMOVE YES, GO CHANGE TABLE JMP CSER NO, PRINT CONTROL STATEMENT ERROR! TMOVE JSB CS.CK CHECK IF F BEFORE LDB DESLC MOVE N-EAU OPCODE VALUES RBL,CLE,SLB,ERB CLEAR INDIRECT BIT, IF ANY. LDB B,I PUT POINTER ADDRESS IN B TMOV1 LDA MOVLC,I OPCODE TABLE IN ASMB.. RAL,CLE,SLA,ERA CLEAR INDIRECT BIT, IF ANY. LDA A,I GET DIRECT ADDRESS. STA B,I STORE NEW VALUE INTO OPCODE TBL. ISZ MOVLC INB BUMP TABLE POINTER ISZ COUNX IS TABLE ALL MOVED? JMP TMOV1 NO, GO MOVE ANOTHER WORD. JMP BCON+1 COUNX DEC -13 LENGTH OF NEW TABLE DESLC DEF ?NEAU LOCATION OF OPCODE VALUE DESTIN. * MOVLC DEF *+1 NON-EAU OPCODE VALUES FOR TABLE. OCT 42111,53006 DIV DEF ?HA38 OCT 42114,42006 DLD DEF ?HA38 OCT 42123,52006 DST DEF ?HA38 OCT 46520,54406 MPY DEF ?HA38 OCT 0 END OF NEW TABLE * * TEST FOR COMPATABILITY AMONG THE OPTIONS * * G LDB ?AFLG LDA ?RFLG SZB,RSS 'A' STET? JMP *+3 NO SZA YES-IS 'R' SET? JMP CSER YES - CONTROL CONFLICT LDA ?X GET FWA OF AVAILABLE CORE SZB 'A' SET? LDA ?Z YES - GET FWA FOR ABS. ASSMBLY. CMA,INA ADA ?LWA LWA-FWA AVAIL MEM. IN A INA A NOW = SYMBOL TBL LENGTH * * * CLEAR SYMBOL TABLE * * CCE E=1 SZB ABS. ASSY? CLE YES - E=0 LDB ?Z GET FWA OF ABSOL ASSY. SEZ SKIP IF ABS. ASSY. LDB ?X FWA OF SYM TBL TO 'B' STB ?NDSY SET ADDRESS OF END OF SYMBOL TABLE JSB ?SETM NOP SET SYMBOL TABLE TO ZERO * ********************* * * START PASS 1 HERE * * ********************* CLA NO STA ?XRFI SET XREF INPUT FLAG... LDA TW10 STA ?ASM1 SET FLAG FOR 'INIT' PROCESSING CLA STA PASS SET PASS FLAG FOR PASS 1 STA PLCN INITIALIZE PROG LOC'N COUNTER STA PLEN CLEAR LITERAL LENGTH FLAG LDA EXTLN GET LENGTH OF NAM EXTENSION AREA. LDB EXTAD GET FWA OF NAM EXTENSION. JSB ?SETM GO SET BLANKS INTO THE AREA. OCT 20040 DUAL ASCII BLANKS. LDA OUTLU CREATE AND OPEN OUTPUT FILES SZA IS OUTPUT FILE AN LU? JMP OPOUT YES, THEN DONT CREATE JUST OPEN LDB .7 FILE TYPE FOR ABSOLUTE FILE LDA ?AFLG ABSOLUTE OR RELOCATABLE OUTPUT? SZA,RSS LDB .5 RELOCATABLE OUTPUT FILE TYPE STB FLTYP JSB CREAT CREATE OUTPUT FILE DEF *+8 DEF DCBO OUTPUT FILE DCB DEF ?ERR ERROR WORD DEF AO+1 OUTPUT FILE NAME DEF .20 FILE SIZE DEF FLTYP FILE TYPE DEF AO+5 SECURITY CODE DEF AO DRN OR -LU SSA,RSS ERRORS? JMP OPOUT NO, THEN OPEN FILE*($ CPA .M2 DUPLICATE FILE NAME? JMP OPOUT YES, OPEN EXISTING FILE JSB ?FMPE FMP ERROR ROUTINE DEF AO+1 FILE NAME * OPOUT JSB OPEN OPEN OUTPUT FILE DEF *+7 DEF DCBO OUTPUT FILE DCB DEF ?ERR ERROR WORD DEF AO+1 OUTPUT FILE NAME DEF OPTNO OPTION WORD DEF AO+5 SECURITY CODE DEF AO DRN OR -LU SSA,RSS ERRORS? JMP SGLD NO, LOAD NEXT SEGMENT JSB ?FMPE FMP ERROR ROUTINE DEF AO+1 FILE NAME * SGLD LDA ABSA SEG. CALL FOR ABSOLUTE LDB ?AFLG GET ABSOLUTE-ASSEMBLY FLAG. SZB,RSS ABS. ASSY? - SKIP IF TRUE. LDA *+2 PICK UP CODE FOR ASMB1 JMP ?SEGM GO TO LOAD THE NEXT SEGMENT ASC 1,1 ASCII '1 ' FOR RELOC. ASSEMBLY-'ASMB1' ABSA ASC 1,3 ASCII '3 ' FOR ABS. ASSEMBLY-'ASMB3' .CS ASC 2,CS ASCII 'CS' FOR CONTROL STMT. ERROR MSG. .20 DEC 20 .5 EQU TEMP+11 .7 EQU TEMP+13 FLTYP NOP EXTAD DEF PBUF+17 FWA OF NAM EXTENSION AREA. EXTLN EQU L+4 (54B) LENGTH OF NAM EXTENSION AREA. * END ASMBD z*   92064-18133 1650 S C0122 &MF000 RTE-M FORTRAN MAIN             H0101 ASMB,R,L,C HED RTE-M FORTRAN MAIN NAM FTN 92064-16045 REV.1650 761118 SUP * * * ********************************************************* * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. * * * * * * ALL RIGHTS RESERVED. NO PART OF THIS PROGRAM MAY BE * * * PHOTOCOPIED, REPRODUCED, OR TRANSLATED TO ANOTHER * * * PROGRAM LANGUAGE WITHOUT THE PRIOR WRITTEN CONSENT OF * * * HEWLETT-PACKARD COMPANY. * * ********************************************************* * * RTE-M FORTRAN IS SCHEDULED USING THE FOLLOWING FORMAT: * * ON, * RU,FTN [,FI,LE,NM [,NN]] * [,LU ] * * WHERE: * * FI,LE,NM IS THE NAME OF AN ANSWER FILE CONTAINING ANSWERS TO * FORTRAN QUERIES. * * LU IS THE LOGICAL UNIT NUMBER OF A CONSOLE DEVICE WHICH * FORTRAN WILL COMMUNICATE WITH FOR ANSWERS TO ITS QUERIES. * DEFAULT IS THE LU FORTRAN WAS SCHEDULED FROM. * * NN IS THE NUMBER OF LINES PER PAGE(056? JMP FTN11 YES.USE 56 LDB PBUFF+3 NO.USE PARAMETER RSS FTN11 EQU * LDB .56 SET LINES/PAGE=56 CMB,INB NEGATE LINES PER PAGE STB LINES AND SAVE IN COMMON LDA .M24 CLEAR STA VAL COMMON CLA AREA LDB PNT07 USED FTN12 EQU * FOR THE STA B,I GTFIL INB ARRAYS ISZ VAL JMP FTN12 SKP LDA PNT06 INITIALIZE FMP ERROR STA NAME FILE NAME POINTER JSB GTFIL GET INPUT, DEF FTN00 OUTPUT,LIST, DEF GOPTS AND SCRATCH DEF ERRS FILES DEF PBUFF DEF AI DEF AO DEF AL DEF * DEF AS1 FTN00 EQU * SSA ERROR OCCUR? JMP FMPER YES.GO REPORT IT LDA B410 INITIALIZE STA OPTS1 OPEN LDA B210 OPTIONS STA OPTS2 LDA B110 STA OPTS3 LDA PNT02 INITIALIZE FMP ERROR STA NAME FILE NAME POINTER JSB OPEN ATTEMPT DEF FTN01 TO OPEN DEF IDCB0 INPUT DEF ERRS FILE PNT02 DEF AI+1 DEF OPTS1 DEF AI+5 DEF AI FTN01 EQU * SSA ERROR OCCUR? JMP FMPER YES.GO REPORT IT LDA PNT03 INITIALIZE FMP ERROR STA NAME FILE NAME POINTER JSB OPEN ATTEMPT TO DEF FTN08 OPEN THE OUTPUT DEF IDCB2 FILE USING THE DEF ERRS LIST FILE DCB PNT03 DEF AO+1 DEF OPTS3 DEF AO+5 DEF AO FTN08 EQU * SSA,RSS ERROR OCCUR? JMP FTN09 NO.GO ON TO OPEN LIST(CLOSE OUTPUT) LDA ERRS YES.IS CMA,INA IT FMP CPA B6 ERROR -006? RSS YES JMP FMPER NO.GO REPORT IT SKP JSB CREAT ATK6TEMPT TO DEF FTN10 CREATE THE DEF IDCB2 OUTPUT FILE AS DEF ERRS A TYPE 5 FILE DEF AO+1 USING THE LIST DEF .20 FILE DCB DEF .5 DEF AO+5 DEF AO FTN10 EQU * SSA ERROR OCCUR? JMP FMPER YES.GO REPORT IT FTN09 EQU * LDA PNT04 INITIALIZE FMP ERROR STA NAME FILE NAME POINTER JSB OPEN ATTEMPT DEF FTN02 TO OPEN DEF IDCB2 LIST FILE DEF ERRS (AND CLOSE THE PNT04 DEF AL+1 OUTPUT FILE) DEF OPTS2 DEF AL+5 DEF AL FTN02 EQU * SSA,RSS ERROR OCCUR? JMP FTN03 NO.GO ON TO SCRATCH FILE LDA ERRS YES.IS CMA,INA IT FMP CPA B6 ERROR -006? RSS YES JMP FMPER NO.GO REPORT FMP ERROR JSB CREAT ATTEMPT TO DEF FTN04 CREATE THE DEF IDCB2 LIST FILE DEF ERRS AS A TYPE DEF AL+1 4 FILE DEF .64 DEF .4 DEF AL+5 DEF AL FTN04 EQU * SSA ERROR OCCUR? JMP FMPER YES.GO REPORT IT SKP FTN03 EQU * LDA PNT05 INITIALIZE FMP ERROR STA NAME FILE NAME POINTER JSB OPEN ATTEMPT DEF FTN05 TO OPEN DEF IDCB3 SCRATCH FILE DEF ERRS PNT05 DEF AS1+1 DEF OPTS3 DEF AS1+5 DEF AS1 FTN05 EQU * SSA,RSS ERROR OCCUR? JMP FTN06 NO.GO ON LDA ERRS YES.IS CMA,INA IT FMP CPA B6 ERROR -006? RSS YES JMP FMPER NO.GO REPORT FMP ERROR JSB CREAT ATTEMPT TO DEF FTN07 CREATE THE DEF IDCB3 SCRATCH FILE DEF ERRS AS A TYPE DEF AS1+1 5 FILE DEF .20 DEF .5 DEF AS1+5 DEF AS1 FTN07 EQU * SSA ERROR OCCUR? JMP FMPER  YES.GO REPORT IT FTN06 EQU * LDA PNT06 INITIALIZE FMP ERROR STA NAME FILE NAME POINTER JSB SEGLD LOAD SEGMENT 1 AND DEF FMPER EXECUTE IT FOR PASS 1 DEF SEG1 EXECUTION,ELSE BRANCH DEF ERRS TO ERROR ROUTINE FMPER * * EXIT THE MAIN TO GO TO EXECUTION OF PASS 1. INPUT,LIST * AND SCRATCH FILES ARE OPEN. * HED RTE-M FORTRAN MAIN ROUTINES * F M P E R * * REPORTS THE FMP ERROR DEFINED BY THE NEGATIVE NUMBER * IN COMMON LOCATION "ERRS" AND TERMINATES FTN. EXPECTS * A POINTER TO THE FILE NAME IN COMMON LOCATION "NAME". * FMPER EQU * LDA B6 INITIALIZE CONVERSION ROUTINE LDB PNT01 TO OUTPUT 6 CHARACTERS EVEN JSB XPUTI THOUGH IT WILL ONLY OUTPUT 5 LDA ERRS CONVERT ERROR NUMBER CMA,INA TO ASCII JSB XDCAS IN ERROR MESSAGE LDA NAME,I MOVE FILE STA FNAME NAME INTO ISZ NAME ERROR LDA NAME,I MESSAGE STA FNAME+1 ISZ NAME LDA NAME,I STA FNAME+2 JSB IMESS REPORT FMP DEF TERM ERROR ON DEF .2 SESSION DEF ERR CONSOLE DEF .13 TERM EQU * JSB IMESS WRITE "$FTN- DEF END ABORTED" ON DEF .2 ON SESSION DEF ABORT CONSOLE DEF B6 END EQU * JSB EXEC TERMINATE DEF *+2 FTN DEF B6 SKP * X P U T I/X P U T * * PACK CHARACTERS IN DESTINATION BUFFER: * * INIT CALL: INIT DESTINATION BUFFER * LDA * LDB * JSB XPUTI * * XPUT CALL: STUFF A CHAR * LDA * JSB XPUT * P+1 * P+2 * XPUTI NOP STA XDLNG STB XDADR CLA STA XDCNT JMP XPUTI,I * XPUT NOP LDB XDCNT CPB XDLNG EOB ? JMP XPUT,I YES, LEAVE STA XPUTI LDA XDADR,I GET CURRENT WORD SLB,RSS EVEN COUNT ? ALF,ALF YES, POSITION AND M400 CLEAR EXCESS IOR XPUTI MERGE CHARACTER SLB,RSS EVEN COUNT ? ALF,ALF YES, POSITION STA XDADR,I SLB,INB ODD COUNT ? ISZ XDADR YES, BUMP ADDRESS STB XDCNT BUMP COUNT LDA XPUTI ISZ XPUT JMP XPUT,I SKP * X C V A S/X D C A S * * INTEGER TO ASCII CONVERSION ROUTINES. FUNCTIONALLY * SIMILAR TO HP PART # 25311-80045. * * XCVAS CALL: TO ASCII * * LDA * LDB <+/- RADIX> * +RADIX: UNSIGNED 16 BIT INTEGER * -RADIX: SIGNED 15 BIT INTEGER * CLE * CCE * JSB XCVAS * P+1 * P+2 * * XDCAS CALL: DECIMAL TO ASCII, UNSIGNED * * GENERATE LEADING ZEROES. * LDA * JSB XDCAS * P+1 * * R.FAJARDO, 731214 * XDCAS NOP LDB .10 RADIX=10, UNSIGNED # CCE GENERATE LEADING 0'S JSB XCVAS NOP JMP XDCAS,I * XCVAS NOP SEZ SUPPRESS LEADING 0'S ? ISZ LDING NO, GIVE THEM TOO STA VAL STB RADIX SSB,RSS SIGNED ? JMP XCV2 CMB,INB YES, FORCE STB RADIX + RADIX SSA,RSS + VALUE? JMP XCV2 CMA,INA NO, FORCE + STA VAL LDA B55 & GIVE "-" JSB XPUT JMP XCVAS,I EOB, EXIT P+1 SKP XCV2 LDA RADIX FIND LARGEST MPY RADIX DIGIT POSITION SZB,RSS JMP *-3 DIV RADIX SAVE AS DIVISOR STB FDIG XCV3 STA DIVS/$"R LDA VAL EXTRACT NEXT DIGIT CLB DIV DIVSR STB VAL SZA ISZ LDING WORRY ABOUT LEADING 0'S LDB LDING SZB,RSS JMP XCV4 IGNORE THEM ISZ FDIG SSA IN CASE OF -DIVISOR CMA,INA ADA B60 MAKE ASCII CHARACTER JSB XPUT JMP XCVAS,I EOB, LOSE EXIT XCV4 CLB LDA DIVSR FIND NEXT DIGIT POSITION DIV RADIX SZA JMP XCV3 STA LDING LDA FDIG SZA JMP *+4 LDA B60 JSB XPUT JMP XCVAS,I ISZ XCVAS JMP XCVAS,I HED CONSTANTS,LINKS,STORAGE & MESSAGES .10 DEC 10 .13 DEC 13 .2 DEC 2 .20 DEC 20 .4 DEC 4 .5 DEC 5 .56 DEC 56 .64 DEC 64 .M24 DEC -24 .M57 DEC -57 ABORT ASC 6,$FTN-ABORTED B110 OCT 110 B210 OCT 210 B410 OCT 410 B55 OCT 55 B6 OCT 6 B60 OCT 60 BNAME ASC 3, BLANK FILE NAME DIVSR NOP DIVISOR FOR XDCAS ERR ASC 6,FMP ERROR - ERR# ASC 2,0000 5 DIGIT FMP ERROR OCT 30040 CODE STUFFED HERE ASC 1, FNAME ASC 3, FILE NAME STUFFED HERE FDIG NOP HOLDS DIGITS FOR XDCAS GOPTS OCT 425 GTFIL OPTIONS LDING NOP LEADING ZEROS FOR XDCAS M400 OCT -400 PBUFF BSS 5 BUFFER FOR RMPAR PARAMETERS PNT01 DEF ERR# LINK TO FMP ERROR # IN ERROR MSG. PNT06 DEF BNAME LINK TO BLANK FILE NAME PNT07 DEF AI LINK TO 1ST GTFIL ARRAY IN COMMON RADIX NOP NUMBER BASE FOR XDCAS SEG1 ASC 3,FTN1 VAL NOP ACCUMULATOR FOR XDCAS XDADR NOP DESTINATION BUFFER ADDRESS XDCNT NOP DESTINATION CHARACTER COUNT XDLNG NOP DESTINATION CHARACTER LENGTH END FTN0 $   92064-18134 1650 S C1122 &MF100 RTE-M FORTRAN SEGMENT 1             H0111 ASMB,R,L HED RTE-M FORTRAN--SEGMENT 1--PASS 1 NAM FTN1,5 92064-16046 REV.1650 761118 SUP * * * ********************************************************* * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. * * * * * * ALL RIGHTS RESERVED. NO PART OF THIS PROGRAM MAY BE * * * PHOTOCOPIED, REPRODUCED, OR TRANSLATED TO ANOTHER * * * PROGRAM LANGUAGE WITHOUT THE PRIOR WRITTEN CONSENT OF * * * HEWLETT-PACKARD COMPANY. * * ********************************************************* * * ENT FTN1 * EXT .STOP,POST,FCONT,LIMEM,READF,WRITF,TERM EXT IDCB0,IDCB2,IDCB3,FMPER,SEGLD,IMESS * COM TCLIS COM MCBUF(40) COM PTYPE COM BUFAD COM OPT(3) COM ...T * COM AI(6),AO(6),AL(6),AS1(6) COM ERRS,OPTS1,OPTS2,OPTS3,NAME,LINES COM FDVL,OPT4 * * * * SKP BUFOR DEF MCBUF MULTI-COMPILE BUFFER BUFND DEF MCBUF+40 END OF BUFFER +1 MOVA. DEF MOVA MOVA ENTRY POINT DOND DEF DOEN LWA+1 OF DO-TABLE MDOAD DEF DOAD BEGIN OF DO-TABLE WPREV BSS 2 .TEMP BSS 5 RS1 EQU .TEMP RS2 EQU .TEMP+1 RS3 EQU .TEMP+2 RS4 EQU .TEMP+3 REOSF EQU .TEMP+4 BSS 1 * TILT EQU * CORE OVERFLOW ERROR JSB LNK20,I DO END,END$ SEQUENCE * STYPE BSS 1 STATEMENT TYPE (SET BY SCANNER) TYPE EQU STYPE LABL BSS 3 ADDITIONAL INPUT FOR PUTAWAY BCLIS BSS 1 BOTTOM OF TEMP CONLIST HIGH EQU BCLIS FWA BSS 1 FWA OF ALPHA OR BETA FWBET EQU FWA LFWA EQU FWA RFWAN EQU FWA LWA BSS 1 LWA+1 OF ALPHA OR BETA ALFA EQU LWA LLWA EQU LWA TOP OF USED CORE NWBET EQU LWA ENTRY DEF START ENTRY POINT ADDR.OF CONTROL1, * 4=REAL FUNCTION PTYP EQU PTYPE * OPT - OPTION FLAGS: 0 FOR NONE * NE.0 FOR OPTION. ORDER: LIST. ι* ASSEMBLY LIST, BINARY OUTPUT C1 OCT 52000 C2 OCT 100 FUNCTION CODE FOR EOF * * BEGIN COMPILATION HERE. * * FTN0, USED AT THE START OF EACH PASS, REWINDS * THE READ POINTER ON THE FORTRAN MIDDLE OUTPUT FILE * AND THEN BRANCHES TO THE LOCATION : ENTRY. * FTN1 CLA INITIALIZE STA OPT4 COMMON LDA C1 STA ...T * * NOREW LDA BUFOR GET MULTI-COMPILE BUFFER ORIGIN STA BUFAD TO USE FOR BUFFER. JMP ENTRY,I JMP TO START PASS 1 SKP * * L I S T * * WRITES RECORD TO LIST FILE OR CAUSES PAGE EJECT. * * LDA WDCNT(-1 FOR PAGE EJECT) * LDB ADDRESS OF BUFFER * JSB LIST * LIST NOP STA SAVE1 SAVE A-REG LDA PNT01 INITIALIZE FMP ERROR STA NAME FILE NAME POINTER LDA SAVE1 RESTORE A-REG SSA JMP PEJ SZA,RSS JMP PSKP CMA,INA STA PBUFL STB PBUFF * JSB WRITF WRITE A DEF PLST1 RECORD TO DEF IDCB2 THE LIST DEF ERRS FILE PBUFF BSS 1 DEF PBUFL PLST1 EQU * SSA ERROR OCCUR? JMP FMPER YES.GO REPORT IT ISZ LCOUT NO.DONE A PAGE? JMP LIST,I NO.RETURN LDA LINES YES.RE-INITIALIZE STA LCOUT THE LINE COUNTER CCA GO EJECT JMP PEJ A PAGE * PNT01 DEF AL+1 LINK TO LIST FILE NAME PBUFL NOP SAVE1 NOP LCOUT BSS 1 LINES PER PAGE COUNTER SKP * PSKP CLA,INA PEJ STA PPRAM JSB FCONT DO A DEF PSKP1 PAGE DEF IDCB2 EJECT DEF ERRS DEF PCNW1 DEF PPRAM PSKP1 EQU * SSA,RSS ERROR OCCUR? JMP LIST,I NO.RETURN LDA ERRS YES.IS IT CMA,INA FMP ERROR CPA O14 -012? JMP LIST,I YES.RETURN JMP FMPER NO.REPORT ERROR * PCNW1 OCT 11007 PPRAM NOP SKP * **************************************************** * XSTOP BSS 1 AESIZ BSS 1 SIZE OF ASF-ERAS.STORAGE ALOC BSS 1 SIZE OF PROG.FOR DECLAR.CODE ARSIZ BSS 1 SIZE OF COMBINED ARRAYS ASFLG BSS 1 ASF-FLAG,NE.0 : ASF PROCESSING CLOC BSS 1 SIZE OF COMMON CONAD OCT 0 ADDEND TO STATEMENT LABEL. DVLS1 BSS 1 CURRENT ADDR.IN SYMBOL TABLE LDVL EQU DVLS1 RALFI EQU LDVL ERCNT BSS 1 ERAS.COUNT (ASF AND PROGRAM ) ERSIZ BSS 1 SIZE OF PROG.-ERAS.STORAGE FNLIS DEF FNTAB FWA OF INTRINSIC FUNC.TABLE FNLS1 DEF FNTB1 FWA OF EXT. FUNCTION TABLE LABEL BSS 1 STATEMENT LABEL VALUE LBCNT BSS 1 INTERNAL-LABEL COUNT (10000 UP) LBORD BSS 1 CURRENT LABEL ORDINAL LOCNT BSS 1 LOCATION COUNTER LVORD BSS 1 CURRENT LOCAL VAR.ORDINAL MODE BSS 1 MODE OF ARITHMETIC FOR PUTAWAY PREVS OCT 0 STATEMENT TYPE OF PREVIOUS * EXECUTABLE STATEMENT RTYPE BSS 1 1=PUTAWAY CODE,2=BETA CODE,3= * SOURCE LIST+ DIAGNOST.,4=DVLIS * (MULTI-COMPILE) SFPAD BSS 1 -(NO.OF PARAMS+1) FOR ASF.USED * IN PUTAWAY,SET IN ASF PROCESSOR TDVL BSS 1 CONTAINS FWA OF TEMP SYMBTAB IN * PASS 1,FWA OF POINTER TABLE * IN PASS 2 * * LINKS IS THE TABLE OF ENTRY POINT ADDRESSES. * IT IS ALSO USED AS JUMP-TABLE IN CONTROL. * LINKS DEF MSP11 FORMAT LNK1 DEF MSP6 IF LNK2 DEF MSP4 GOTO N LNK3 DEF MSP5 GOTO ( ),N LNK4 DEF MSP2 STOP LNK5 DEF MSP1 PAUSE LNK6 DEF MSP3 RETURN FORMT DEF M3SFR FORMAT (NO JUMPS) LNK8 DEF MSP9 CALL LNK9 DEF MSP7 DO (BEGIN) LNK10 DEF WARTH ARITH MPYA DEF .MPYA MPY: DECPRO+PRO ALPHA LNK12 DEF LSTIO I/O LNK13 DEF LSTIO I/O LNK14 DEF LSTIO I/O LNK15 DEF LSTIO I/O  LNK16 DEF LSTIO I/O LNK17 DEF LSTIO I/O LNK18 DEF LSTIO I/O LNK19 DEF MSP10 END LNK20 DEF FINS1 END$ LNK21 DEF MASF1 ASF LNK22 DEF SCAN SCANNER LNK23 DEF NEST DECLAR. PROCESSOR LNK24 DEF PRA PROCESS ALPHA LNK25 DEF WPRB PROCESS BETA LNK26 DEF WSSEV SUBSCRIPT EVALUATOR LNK27 DEF WRITB WRITE RROUT DEF ASCQ ASCN LNK29 DEF MSP8 END DO LNK30 DEF MSP7A IMPLIED DO MPUT1 DEF PUTA PUTAWAY LNK32 DEF MDOTL DO-TAB SEARCH ROUTINE LNK33 DEF FINIS END$ PROCESSING LNK34 DEF SDVL SEARCH DECL VAR LNK35 DEF ECSUB CONSTANT ROUTINE LNK31 EQU MPUT1 * .CON0 OCT 0 O1 OCT 1 O2 OCT 2 O3 OCT 3 O4 OCT 4 O5 OCT 5 O6 OCT 6 O7 OCT 7 O10 OCT 10 O11 OCT 11 O12 OCT 12 O13 OCT 13 O14 OCT 14 O15 OCT 15 O16 OCT 16 O17 OCT 17 O20 OCT 20 O21 OCT 21 O22 OCT 22 O23 OCT 23 O25 OCT 25 O26 OCT 26 O27 OCT 27 O30 OCT 30 O31 OCT 31 O32 OCT 32 O33 OCT 33 O34 OCT 34 O35 OCT 35 O36 OCT 36 O37 OCT 37 O40 OCT 40 O44 OCT 44 O52 OCT 52 O377 OCT 377 O400 OCT 400 O4000 OCT 4000 M1 OCT -1 M2 OCT -2 M3 OCT -3 M4 OCT -4 MO100 OCT -100 .MU1 OCT 177400 UPPER 8-BITS IBIT OCT 100000 M5 OCT -5 M6 OCT -6 M7 OCT -7 M8 DEC -8 M9 DEC -9 O77 OCT 77 MLBLM DEC -10000 MD1K DEC -1000 MD100 DEC -100 MD10 DEC -10 RLW4Z OCT 177760 MC01 OCT 140000 MC02 OCT 40000 MC03 OCT 37777 W6060 OCT 30060 CONVERSION FACTOR TO ASCII MPAR OCT 37400 * A EQU 0 B EQU 1 * *** BETA-FORMATS *** * W.PLS OCT 11001 + W.MIN OCT 21001 - W.TMS OCT 32001 * W.SLS OCT 42001 / W.EXP OCT 54001 ** W.EQ OCT 67401 = W.LP OCT 100002 ( W.RP OCT 140002 ) W.LPC OCT 100042 ( FOR CONST SUBSCRIPT W.LPV OCT 100022 (-BASE FOR VARIABLE SUBSCRIPT W.CMA OCT 40002 , W.RPC OCT 140042 ) FOR CONST. SUBSCR SKP * *CNASCŲ CONVERTS A BINARY NUMBER LT.10000 TO ASCII. *ENTER:A= NUMBER. RETURNS: A,B = ASCII CODE * CNASC NOP LDB MD1K -1000D JSB WGETD GET 1ST DIGIT STB CEQS LDB MD100 -100D JSB WGETD 2ND DIGIT STB CENTR LDB MD10 -10D JSB WGETD 3RD DIGIT STB CSFRM STA RCEQS LDA CEQS ALF,ALF ADA CENTR ADD IN 2ND DIGIT LDB CSFRM 3RD DIGIT BLF,BLF ADB RCEQS ADD IN 4TH DIGIT ADA W6060 CONVERT TO ASCII ADB W6060 JMP CNASC,I * *WGETD SUPPLIES THE MOST SIGNIFICANT DEC.DIGIT FOR A *BINARY VALUE. ENTER: A=VALUE,B=-VALUE TO CNMPARE *AGAINST.RETURNS: A=REMAINDER, B= DIGIT * WGETD NOP STB CSAVE+1 SAVE COMPARISON VALUE CLB 0 TO DIGIT WGTD1 STA CSAVE SAVE REMAINDER ADA CSAVE+1 SSA LARGER ? JMP WGTD2 NO,READY INB YES, BUMP DIGIT IN B JMP WGTD1 CONTINUE * WGTD2 LDA CSAVE A=REMAINDER JMP WGETD,I EXIT SKP * *ERRR IS THE ERROR-DIAGNOSTIC WRITE ROUTINE FOR *PASS1 AND PASS 2. ENTER WITH A= ERROR CODE. THE OUT *PUT FORMAT IS:E-CODE: LABL +ADDEND,WHERE ALL NUMERIC *FIELDS HAVE 4 DECIMAL DIGITS. * ERRR NOP STA SAVE2 SAVE ERROR CODE JSB CNASC CONVERT CODE TO ASCII STA ERBUF+1 STB ERBUF+2 LDA LABEL JSB CNASC CONVERT LABEL TO ASCII STA ERBUF+4 STB ERBUF+5 LDA CONAD JSB CNASC CONVERT ADDEND TO ASCII STA ERBUF+7 STB ERBUF+8 LDA O3 STA RTYPE RECORD TYPE=3 FOR ASCII OUTPUT LDA O22 NO. OF CHARS=18 LDB ERBUF-1 ADDR. OF ERBUF JSB LNK27,I WRITE ERROR DIAGNOSTIC (WRITB) LDA SAVE2 WAS IT SYMBOL CPA O16 TABLE OVERFLOW? JMP SYMEX YES.GO TERMINATE FTN JMP ERRR,I NO.EXIT * DEF *+1 ERBUF ASC 1,E- BSS 2 ASC 1,: Y' BSS 2 ASC 1, + BSS 2 SAVE2 BSS 1 TEMPORARY STORAGE SKP * *CEQS SEARCHES CONLIST. TCLIS= TOP OF CONLIST +1. *ENTER CEQS WITH A=CONSTANT VALUE,B= ADDR.POINTER IN *CONLIST. ALT.EXIT IS TO CALLING ADDR.+2 WHEN NO *EQUALITY IS FOUND. * CEQS NOP CPB TCLIS TOP OF CONLIST+1 JMP CEQS1 YES,NOT FOUND CPA 1,I EQUALITY ? JMP CEQS,I YES,NORMAL EXIT INB NO,CONTINUE SEARCH JMP CEQS+1 * CEQS1 ISZ CEQS BUMP RETURN ADDR. FOR JMP CEQS,I ALTERNATE RDTURN * *ICEQS IS THE INTEGER CONSTANT LOOK-UP AND INSERT *ROUTINE. ENTER WITH: A=CONST.VALUE. IT RETURNS THE *ALPHA(BETA) FORMAT OF THE CONST.IN A. IN CASE OF *CORE OVERFLOW A JMP TO TILT IS EXECUTED. * ICEQS NOP LDB BCLIS BOTTOM OF CONLIST JSB CEQS SEARCH FOR INT CONST. RSS FOUND,GET FORMAT JSB CENTR NOT FOUN(,ENTER CONST LDA O3 B=ADDR OF CONST, A=3 FOR INT CONV JSB CSFRM FORM CONST. FORMAT IN B JMP ICEQS,I EXIT WITH FORMAT IN B * SKP * *CENTR ENTERS A CONST.IN CONLIST AT (BCLIS)-1. IT *JUMPS TO TILT IN CASE OF CORE OVERFLOW. IT RETURNS *B= ADDR OF CONST * CENTR NOP CCB ADB BCLIS CPB LWA EQUAL TO LOW CORE? JMP TILT YES,CORE OVERFLOW STB BCLIS SET NEW VALUE FOR BCLIS STA 1,I ENTER CONST. JMP CENTR,I * *CSFRM FORMS A CONST FORMAT. THE ADDR.OF THE CONST *IS IN B UPON ENTRY, A= CLASS IDENT. (1 FOR INT. CON., *21B FOR REAL CONST.) * CSFRM NOP CMB COMPLEM-1 ADB TCLIS POINTER= TCLIS - ADDR.-1 BLF RBL,RBL SHIFT POINTER TO UPPER 10 BITS ADA 1 ADD IN CLASS IDENT (1=INT,21=RL) JMP CSFRM,I EXIT SKP * *RCEQS IS THE REAL CONST LOOKUP AND INSERT ROUTINE *ENTER WITH THE CONST IN A,B. IT RETURNS THE INT. *FORMAT IN A. A JMP TO TILT IS EXECUTED IN CASE OF *CORr*E OVERFLOW. * RCEQS NOP STA CSAVE SAVE CONST STB CSAVE+1 LDB BCLIS BOTTOM OF CONLIST RCEQ2 JSB CEQS SEARCH FOR UPPER PART JMP RCEQ1 FOUND, TEST LOWER PART RCEQ3 LDA CSAVE+1 NOT FOUND,ENTER LOWER PART JSB CENTR LDA CSAVE ENTER UPPER PART JSB CENTR LDA O23 23B=CLASS IDENT. FOR REAL CONST. JSB CSFRM GET FORMAT IN A JMP RCEQS,I EXIT * RCEQ1 INB BUMP ADDR CPB TCLIS TOP OF CONLIST ? JMP RCEQ3 YES,NOT FOUND LDA CSAVE+1 LOWER PART OF CONST. CPA 1,I EQUALITY ? JMP *+3 YES,FINISH LDA CSAVE RESTORE A=UPPER PART OF CONST JMP RCEQ2 CONTINUE SEARCH ADB M1 ADDR. BACK TO FWA JMP RCEQ3+4 GET FORMAT AND EXIT * CSAVE BSS 2 SKP * *WFCS FETCHES A REAL CONST. ENTER WITH B=ADDR.OF *CONST. FORMAT IN BETA. RETURNS CONST. IN A AND B. * WFCS NOP LDB 1,I CONST. FORMAT IN B JSB WFCS1 GET CONST IN A AND B JMP WFCS,I * *WFCS1 FETCHES A REAL CONST.FROM TEMP.CONLIST * WFCS1 NOP JSB WPFAD GET POINTER CMA ADA TCLIS LWA+1 OF TEMP CONLIST LDB 0 INB SET B= ADDR.OF LOWER PART LDA 0,I UPPER PART LDB 1,I LOWER PART JMP WFCS1,I EXIT * *SDVLL SEARCHES SYMBTAB FOR A LABEL FOR WHICH THE *VALUE IS SUPPLIED THROUGH A. IT RETURNS:THE DVLIST *ORD.IN A OR -1,IF NOT FOUND,AND B= LOC.OF LABEL REL *ADDR.IN SYMBTAB ENTRY * SDVLL NOP STA EDVLL SAVE VALUE OF LABEL LDB FDVL FWA OF DECLARED VAR LIST SDVL1 CPB LDVL END OF SYMBOL TABLE ? JMP SDVL2 YES,LABEL NOT FOUND LDA 1,I NO, TEST SZA LABEL ? JMP SDVL3 NO,CONTINUE SEARCH INB YES,BUMP POINTER LDA 1,I GET LABEL VALUE INB BUMP POINTER FOR RETURN CPA EDVLL SAME VALUE ? }nJMP SDVLL,I YES,EXIT ADB M2 NO, -2 TO RESET AT ENTRY-FWA SDVL3 JSB NDVLE,I GET FWA OF NEXT ENTRY JMP SDVL1 CONTINUE SEARCH * SDVL2 CCA A=-1 TO INDICATE NO FIND JMP SDVLL,I EXIT * SKP *EDVLL INSERTS A LABEL IN SYMBTAB. ENTER WITH VALUE *OF LABEL IN A. RETURNS WITH B=ADDR.IN SYMBTAB OF *REL.LOC.OF LABEL. IN ADDITION EDVLL WILL MOVE BETA *+ POINTER TABLE+ TEMP.CONLIST,SET INC= 4,AND ADD 4 *TO FWAPT,FWA,LWA,AND HICOR. IN THIS PROCESS IT WILL *CHECK FOR (HICOR) GE.(BCLIS).CORE OVERFLOW IF TRUE. * EDVLL NOP CLB STB DVLS1,I 0 TO 1ST WORD IN ENTRY ISZ DVLS1 BUMP ADDR. STA DVLS1,I SET VALUE IN ENTRY ISZ DVLS1 BUMP ADDR.IN DVLIS CCA STA DVLS1,I -1 TO UNDEFINE REL.ADDR. ISZ DVLS1 LDA LBORD STA DVLS1,I SET LABEL ORD.IN ENTRY ISZ LBORD BUMP LABEL ORDINAL COUNT ISZ DVLS1 BUMP POINTER ISZ DORDT BUMP ORDINAL COUNTER FOR DVLIS LDA FWA CMA,INA ADA DVLS1 SSA,RSS CORE OVERFLOW IF SYMBOL JMP TILT TABLE GROWS BEYOND FWA OF BETA LDB DVLS1 ADB M2 -2 TO GET ADDR. OF LABEL ADDR. JMP EDVLL,I EXIT * SKP *SCATR SCATTERS A SYMBTAB ENTRY FOR WHICH THE BETA *FORMAT IS GIVEN IN A. IT RETURNS: A= ADDR.+1 OF *ENTRY IN SYMBTAB, B= NO.OF WORDS IN NAME OF ENTRY+1 *OTHER VALUES THROUGH PARAMETERS. * SCATR NOP LDB 0 FORMAT TO A FOR WPFAD JSB WPFAD CMA,INA STA CSAVE SET COUNT LDA FDVL FWA OF DVLIS JSB NENT GET FWA OF NEXT ENTRY ISZ CSAVE READY? JMP *-2 NO,GET NEXT ENTRY STA CSAVE YES, SAVE FWA OF ENTRY INA STA CSAVE+1 SAVE FWA+1 LDA CSAVE,I 1ST WORD IN ENTRY RAL,RAL AND O3 STA V SET V-FIELD ADA M3 STA SDVLL SAVE FLAG LDA CSAVE,I AND O7 GET NO. OF CHARS . ADA O3 ARS STA WFCS SAVE NO.OF WORDS IN NAME +1 ADA CSAVE+1 A=ADDR. OF ORD LDB 0,I STB ORD SET ORDINAL LDB 0 LDA CSAVE,I ALF,ALF AND O77 STA PARAM PARAMETER NUMBER SZA,RSS FORMAL PARAM INB NO,BUMP TO NEXT DVL-LOC LDA 1,I STA DIM1 SET 1ST DIM ISZ SDVLL ONE DIMENSION? INB LDA 1,I SKP STA DIM12 DIM1*DIM2 (=DIM1 IF 1 DIM) LDA CSAVE,I AND O20 STA T T-FIELD VALUE (0 OR 20B) LDA CSAVE,I AND O10 STA CBIT C-FIELD VALUE (0 OR 10B) LDA CSAVE,I ALF,ALF RAL,RAL AND O3 STA F F-FIELD VALUE (0-2) LDA CSAVE+1 A= ADDR.OF ENTRY +1 LDB WFCS B= NO.OF WORDS+1 IN NAME JMP SCATR,I EXIT * V BSS 1 V-FIELD VALUE:0 THRU 3 PARAM BSS 1 PARAM NUMBER:1 THRU 63,OR 0 F BSS 1 F-FIELD VALUE:0 THRU 2 T BSS 1 TYPE:0=INTEGER,20B= REAL CBIT BSS 1 COMMON-BIT: 1=COMMON, 0=PROG. ORD BSS 1 REL.PROG.ADDR.OF FWA OF ARRAY DIM1 BSS 1 VALUE OF 1ST DIMENSION DIM12 BSS 1 DIM1 * DIM2 FFLAG BSS 1 FORMAT FLAG DORDT BSS 1 MAX. ORDINAL FWAPT DEF LFNTB FWA OF POINTER TABLE(4K ONLY) SKP *GETS POINTER OF BETA FORMAT. ENTER WITH B=BETA *FORMAT. RETURNS A=POINTER * WPFAD NOP NOCHR EQU WPFAD LDA 1 AND MO100 GET UPPER 10 BITS ALF,ALF RAL,RAL SHIFT 10 JMP WPFAD,I EXIT * *LOKUP LOOKS UP AN ENTRY IN SYMBTAB. ENTER WITH B= *BETA FORMAT. RETURNS: A=(FWA OF ENTRY) +1,B= NO. *OF LOCS IN SYMBOL NAME * LOKUP NOP LDA 1 OPERAND TO A JSB SCATR CRACK SYMBTAB ENTRY JMP LOKUP,I * **FIND LOC OF NEXT ALPHA ENTRY********** * ENTER A= LOC ALPHA * EXIT A= LOC NEXT ALPHA * NELM NOP STA LOKUP SAVE A = CURREQL<:6NT ALPHA ADDR LDA 0,I 1ST WORD ALF,ALF ALF NO CHAR AND O17 MASK TO 4 BITS STA NOCHR NO OF CHARS ADA M6 SSA GT 5 ? JMP *+3 NO,EXIT LDA O4 YES, ERROR IN NAME JSB ERRR PRINT ERROR LDA NOCHR RELOAD NO OF CHARS ARS NO CHAR/2+1 IS NO WORDS INA ADA LOKUP +LOC = NEXT LOC JMP NELM,I SKP *FIND NEXT DVL ENTRY ********* *ENTER A= LOC DVL EXIT A=LOC NEXT ENTRY * NENT NOP LDB 0 JSB NDVLE,I LDA 1 JMP NENT,I * NDVLE BSS 1 LOC OF ROUTINE SET TO ADD 8 OR * COMPUTE NEXT LOC BY DECL PROC * * *PERMANENT STORAGE EPAR BSS 1 *INTERMEDIATE STORAGE LNWA BSS 1 NWALF EQU LNWA TEMP BSS 4 ALEN EQU TEMP CFLG EQU TEMP+1 PFWA BSS 1 NWCE BSS 1 BWCE BSS 1 CWCE BSS 1 SBCE BSS 1 LSYM BSS 1 MTLDO NOP k><CNSIZ BSS 1 SIZE OF CONSTANTS AREA PARM BSS 1 NO.OF PARAMS (SET BY DECPRO) MLBCH DEF MLBCK * RALID NOP SET ALFA STRING FOR IDENT LDA RACNT CHARACTER CNT AND RLW4Z MASK OUT CHAR CNT SZA JMP RERRI,I LDA RACNT STA RXC SAVE CHAR COUNT ALF IOR O4 SET CLASS IDENT=4 IOR RALST,I STA RALST,I LDA ALFA,I SZA JSB RCKAL,I STA RACNT STA RAFLG JMP RALID,I * RCKAL DEF CKALF RERRI DEF RER2 NESTM DEF DUP8 ALPHM DEF NXDVL O110 OCT 110 ASC H WXSAV BSS 1 TEMPORARY STORAGE * STYP NOP DETERMINE TYPE OF IDENTIFIER ALF,ALF CHAR TO LOWER AND O377 CMA,INA ADA O110 H SSA JMP *+3 .LT. "I", IS REAL CLA,INA JMP STYP,I ADA O6 LT 0 MEANS GT N SSA JMP *-4 CLA JMP STYP,I * LPRG DEF *+1 OCT 43104 F IN ALPHA FORM ASC 2,TN. COMFG BSS 1 COMMON/DIMENSION FLAG: 0 INITIAL * LY,-1 WHEN COMMON ENCOUNTERED * RBL DEF RBUFF+3 CURRENT ADDR OF SOURCE CHAR RGFLG OCT 0 RL1 DEF RBUFF RBF3 DEF RBUFF+3 RBF2 DEF RBUFF+2 .2B ASC 1, BLANKS O60 OCT 60 ASCII 0 .BZ OCT 20000 BLNK(ASCII)UPPR,ZERO LOWR RCTI BSS 1 RPS OCT 50000 P RSSS OCT 51400 S RFS OCT 43000 F RDS OCT 42000 D RCS OCT 41400 C RES OCT 42400 " E RIS OCT 44400 I RGS OCT 43400 G RRS OCT 51000 R RWS OCT 53400 W RBS OCT 41000 B RNS OCT 47000 N RTS OCT 52000 RORS ASC 1,OR RMAS ASC 1,MA MO140 OCT -140 RKSS ASC 1,KS RCES ASC 1,CE RTES ASC 1,TE RURS ASC 1,UR RINS ASC 1,IN RNDS ASC 1,ND RLES ASC 1,LE RALS ASC 1,AL RONS ASC 1,ON ROMS ASC 1,OM RIMS ASC 1,IM RUNS ASC 1,UN RUBSgq ASC 1,UB RTOS ASC 1,TO RROS ASC 1,RO RAUS ASC 1,AU RSES ASC 1,SE RAMS ASC 1,AM ROS OCT 47400 RLZ OCT 46000 RLABC OCT 405 LABEL NUM TYPE AND CHAR CT .M8CC OCT -200 -8 IN CHAR CT POS O360 OCT 360 CHAR COUNT MASK .M1Z OCT -240 -10 IN CHAR CT POS RFFWA DEF REFLG .9ASC OCT 34400 ROPTF OCT 25400 + OCT 26400 - OCT 25000 * OCT 27400 / OCT 26000 , OCT 24000 ( OCT 24400 ) OCT 36400 = OCT 22000 $ OCT 27000 . RNCTI DEC -21 RNFWA DEF RNUM FWA CONST STRING ROPT DEF ROPTF-1 FWA OPER TABL RNUM BSS 11 NUM CHAR STRING STORGE RNBUF DEF RNUM CURRENT DIGIT ADDR LOC*** RNCT DEC -21 RALST BSS 1 FWA IDENT STRING REFLG BSS 1 *FWA OF FLAGS RAFLG BSS 1 ALFA FLAG RNFLG BSS 1 NUM FLAG RNULF BSS 1 UPPR/LOWR FLAG FOR RNSTO RACNT BSS 1 ALFA CHAR CNT RTF BSS 1 REAL CONST FLAG RPARC BSS 1 PAREN LEVEL COUNT CEFLG BSS 1 COMMA,EQUAL FLAG RBF BSS 1 OCTAL CONST FLAG RF1 OCT 0 UPPR/LOWR FLAG FOR RGET RXC OCT 0 CHAR COUNT RFLWA DEF * LWA+1 OF FLAGS RGC BSS 1 RGCC BSS 1 NEG CHAR CNT RBUFF BSS 36 36 WORD READ-BUFFER RSFLG BSS 1 END OF TAPE FLAG MBUF3 BSS 40 INTERMEDIATE OUTPUT BUFFER SKP * *ROUTINE TO ENCODE SOURCE STATMNTS. ENTER WITH FWA OF ALFA STRING.* *ON EXIT, A=FWA OF ALFA, B=LWA+1 OF ALFA * * * SCAN NOP LDA TCLIS STA BCLIS LDA LDVL STA FWA STA ALFA SAVE ALFA FWA LDA RBF3 STA RBL RESET TO COLM 7 ADDRESS LDA RNCTI STA RNCT INIT @NUM CHAR CNT LDA RNFWA RESET FWA NUM STRING STA RNBUF LDB RFFWA CLA STA REOSF SET END-STATEMENT FLAG S2 STA B,I INB CPB RFLWA JMP *+2 JMP S2 STA ALFA,I CLEAR ALFA FWA LDA RSFLG TEST END OF TAPE FLAG SZA,RSS JMP S4 NOT ON S3 JSB READ READ NEXT STATMNT SZA,RSS JMP *-2 S4 LDB RL1 LDA B,I CPA .2B ALL BLANKS? JMP R111 AND .MU1 CPA RCS C IN COLM 1 ? JMP RS6 LIST STATMNT R112 LDA RL1 LOAD ADDRESS OF RBUFF LDB RLABC LOAD CONST TYPE AND CHAR CT JSB RROUT,I CONERTLABEL JMP RER1A ILLEGAL CONST STA LABEL CLA STA CONAD RESET LABEL ADDEND JMP R21 CONTINUE AT COLM 7 * RS6 JSB RPRNT LIST IF L-OPTION SPECIFIED JMP S3 * R111 INB LDA B,I CPA .2B TWO BLANKS? INB,RSS JMP R112 CONVERT LABEL LDA B,I AND .MU1 GET LEFT CHAR CPA .BZ BLANK? JMP S5 YES JMP R112 * S5 ISZ CONAD ADDEND INITIALLY -1 NOP R21 JSB RGET COLM7, GET CHARACTER SSA JMP REOS END OF STATMNT R21A LDB M9 -9 STB RS1 LDB ROPT OPER TABL FWA STB RS2 SAVE ADDRESS ISZ RS2 CPA RS2,I JMP RPROP OPER FOUND ISZ RS1 JMP *-4 CPA ROPTF+9 COMPARE /PERIOD JMP RPE YES JSB RNX TEST FOR NUMERIC JMP RNN NON NUMERIC LDB RAFLG SZB JMP RPC5 YES, NEG STB REFLG RESET E-FLAG R211 JSB RNSTO STORE NUM CHAR JMP R21 GET NEXT CHAR * RNSTO NOP STORE NUM CHAR ROUTINE STA RNFLG STB RS3 LDB RBF Ŧ B-FLAG. SZB SET? JMP RER1 ILLEGAL CONSTANT. LDB RNULF CHECK UPPER/LOWER FLAG AND .MU1 SSB JMP RNLOW MERGE INTO LOWER STA RNBUF,I RN11 ISZ RNCT INC NUM CHAR CNT CMB,RSS JMP RER1 ERROR MAX+ NUM CHAR STB RNULF LDB RS3 JMP RNSTO,I EXIT * RNLOW ALF,ALF ADA RNBUF,I STA RNBUF,I ISZ RNBUF JMP RN11 * RPC5A LDB RAFLG CHECK IDENT FLAG SZB JMP RPC5 LDB ALFA STB RALST JMP RPC5 * RDOPR LDB RALFI PROCESS DO STATMNT LDA B,I AND .MU1 CPA RDS COMPARE W/D,ZERO JMP *+2 JMP RER4 ILLEGAL STATMNT LDA B,I AND O360 GET CHAR COUNT ALF,ALF ALF CMA,INA STA RXC SAVE -(CHAR CNT) INB LDA B,I AND .MU1 CPA ROS ASCII O, NULL RSS JMP RER4 LDA B,I RP ALF,ALF STA RS1 JSB RNX TEST FOR NUMERIC JMP RP2 NON NUMERIC JSB RNSTO ISZ RXC JMP *+2 JMP RER1 TOO MANY DIGITS LDA RNCT TEST DIGIT COUNT SLA JMP RP4 EVEN INB LDA B,I JMP RP+1 * RP4 LDA RS1 JMP RP * RP2 AND O377 SZA,RSS JMP RP2X ARS,ARS SZA,RSS JMP RER2 ILLEGAL FORMAT RP2X LDA RXC CMA,INA ADA M2 -2+CHAR COUNT STA RXC ALF STA RS4 SAVE IN TEMP LDA RNCT NUM CHAR CNT SLA JMP REVEN EVEN NO. OF DIGITS IN LABEL ADB M1 DECR ADDR BY 1 JSB RDOC CLA JSB RIDN2 LDA RFWAN ADA M1 -1 STA RFWAN RD21 LDB O22 TYPE DO JMP RAMOV * REVEN JSB RDOC LDA RXC IDENT CHAR CNT V ALF STA RXC LDA B,I ALF,ALF AND .MU1 IOR RXC IOR O4 SET CLASS IDENT STA B,I ADB M1 STB RFWAN JMP RD21 * RDOC NOP ADB M1 DECR ADDR BY 1 STB RS2 LDB RNCT DIGIT CNT ADB O25 ADB O400 INT CONST LDA RNFWA FWA CONST STRING JSB RROUT,I CONVERT NUM JMP RER1 ERROR JSB ICEQS FORMAT ALFA ENTRY LDB RS2 STA B,I INB JMP RDOC,I * RNX NOP SUBR; TEST FOR NUMERIC STA RS3 SAVE CHAR AND .MU1 177400 CMA,INA,SZA,RSS JMP RER2 ILLEGAL CHARACTER ADA .9ASC 9-CHAR SSA JMP RNX1 NON NUMERIC LDA RS3 CMA,INA ADA ROPTF+3 (1)=ZERO-1 SSA ISZ RNX BUMP EXIT,NUMERIC (P+2) RNX1 LDA RS3 RESTORE CHAR JMP RNX,I EXIT * R211B STA RBF JMP R21 OCTAL FLAG SET * RNN LDB RNFLG SZB,RSS JMP RPC5A CPA RBS COMPARE W/B JMP R211B CHAR=B STB REFLG SET E-FLAG CPA RES JMP RPE+3 CHAR=E JMP RER1 * RPC5 JSB RASTO STORE ALFA CHAR JMP R21 * RPE LDB RAFLG SZB JMP RER2 ILLEGAL USE OF PERIOD LDB O23 STB ALFA,I SET NUMERC TPE TO REAL STB RTF JMP R211 * RPROP LDB REFLG CHECK E-FLAG SZB,RSS JMP RP1 NOT SET CLB STB REFLG RESET E- FLAG CPA ROPTF CHAR EQUAL + JMP R211 YES CPA ROPTF+1 CHAR EQUAL - JMP R211 YES JMP RER1 ILLEGAL CONSTANT * RP1 LDB RNFLG SZB,RSS JMP RCKA CHECK A-FLAG JSB RNCVT CONVERT NUMBER RPROQ LDA RS1 ADA QRJUMP JMP ADDR FOR +-*/,()=$ STA RS2 STORE ADDRESS IN TEMP JMP RS2,I * RPL LDA W.PLS PROCESS PLUS + STA ALFA,I JSB CKALF JMP R21 * RMI LDA W.MIN PROCESS MINUS - JMP RPL+1 * RAS JSB RGET PROCESS ASTERISK * * SSA JMP RER4 ERROR CPA ROPTF+2 CP WITH * JMP RDBLA PRO ** LDB W.TMS * STB ALFA,I STA RS2 JSB CKALF INC ALFA LDA RS2 JMP R21A PROC CHAR * RSL LDA W.SLS PROCESS SLASH / JMP RPL+1 * RCO JMP *+1,I PROCESS COMMA DEF CMTCO AND CHECK FOR COMMENT IN PROG,SUB,FUNC * RLP ISZ RPARC PRO ( ;INC PAREN CNT LDA RXC CHAR CNT CPA O6 JMP *+2 ALFA-NUM CHAR CT=6 JMP RLP1 LDB RALST LDA B,I TRY FOR "FORMAT" AND .MU1 CPA RFS COMPARE W/F,ZERO INB,RSS JMP RLP1 LDA B,I CPA RORS COMPARE W/OR INB,RSS JMP RLP1 LDA B,I CPA RMAS COMPARE W/MA INB,RSS JMP RLP1 LDA B,I CPA RTS COMPARE W/T,ZERO JMP *+2 JMP RLP1 LDA RALFI STA ALFA LDA ROPTF+5 LFT PAREN IOR O40 INSERT BLANK STA ALFA,I JSB CKALF CLA,INA STA RACNT SET CHAR CNT=1 RFOR1 CCA STA RGFLG SET FLAG=-1 JSB RGET GET NEXT CHARACTER SSA JMP *+3 JSB RASTO JMP RFOR1 LDB ALFA FWA ALFA LDA B,I SZA,RSS ADB M1 A=0, SUBTRACT 1 LDA B,I CPA .2B JMP *-3 INB LDA O17 END ALFA STRING STA B,I LDA O11 TYPE FORMAT STA TYPE STB ALFA JMP SCAN,I * RLP1 LDA W.LP ( JMP RPL+1 * RRP CCA PRO ) ADA RPARC STA RPARC DEC PAREN CNT LDA W.RP ) JMP RPL+1 * REQ LDA RPARC PRO = SZA JMP *+4 CLA,INA IOR CEFLG SET LSB STA CEFLG LDA W.EQ = JMP RPL+1 * RDOL LDB RALFI CHECK ALFA STRING: LDA 1,I FOR E N D CHARS, CPA RE34 TYPE 4, INB,RSS AND 3 CHARS, JMP RER4 LDA B,I ANYTHING ELSE IS CPA RNDS CONSIDERED AN ERROR. INB,RSS JMP RER4 STB LWA SET THE LWA. JSB RPRNT LIST SOURCE LINE. LDB O35 END$ - TYPE 35. JMP RAMOV STORE TYPE AND EXIT. * RE34 OCT 42464 ASCII, BCD 34. * RDBLA LDA W.EXP ** JMP RPL+1 * RCKA LDA RAFLG CHECK ALFA FLAG- SZA JSB RALID SET JMP RPROQ * REOS STA REOSF RESET END OF SCAN FLAG LDA RPARC SZA JMP RER6 UNMATCHED PARENS LDB RNFLG SZB,RSS JMP REA CHECK A-FLAG JSB RNCVT CONVRT AND STORE NUMBER REOB LDA O17 LDB ALFA,I SZB ISZ ALFA STA ALFA,I ISZ ALFA LDB CEFLG SSB JMP RCDO CHECK FOR DO STATMNT SLB,RSS JMP RSPRO GET STATMNT TYPE LDA O23 ARITH TYPE STA TYPE JMP SCAN,I EXIT * REA LDB RAFLG SZB JSB RALID FIX INDENT FORMAT JMP REOB * RCDO SLB JMP RDOPR PROCES DO STATMNT RSPRO LDB RALFI GET STATMNT TYPE SECTION LDA B,I AND .MU1 CPA RPS JMP RPPAU CHK PROGRAM, PAUSE CPA RSSS JMP RSUST CHK SUBRR, STOP CPA RFS JMP RFUN CHK FUNCTION CPA RDS JMP RDIM CHK DIMENSION CPA RCS JMP RCCC CHK COMMON, CONTIN, CALL CPA RES JMP REEEE CHK EQU.IV,ENDFLE,END,END CPA RIS JMP RIF CHK IF CPA RGS JMP RGO CHK GOTO CPA RRS JMP RRR CHK RETURN , READ,REWIND CPA RWS JMP RWT CHK WRITE CPA RBS CHK BACKSPACE INB,RSS JMP RER4 ERROR INB ADD 2 TO ADDRESS LDA B,I CPA RKSS INB,RSS JMP RER4 ERROR INB ADD 2 TO ADDRESS LDA B,I CPA RCES INB,RSS JMP RER4 ERROR STB RFWAN LDA O11 DEF CHAR CNT LDB O32 TYPE BACKSPACE JMP RM2 * RWT ADB O2 CHECK WRITE LDA 1,I CPA RTES COMPARE W/TE JMP *+2 EQUAL JMP RER4 ERROR JSB RRWT LDB O30 SET FOR WRITE FORMATTED SZA LDB O26 WRITE BINARY JMP RAMOV * RRR ADB O2 ADD 2 TO ADDRESS LDA B,I CPA RURS COMPARE W/UR JMP RET EQUAL CHECK RETURN CPA RINS COMPARE W/IN JMP REW EQUAL, CHECK REWIND CPA RDS COMPARE W/D,ZERO JMP *+2 JMP RER4 ERROR JSB RRWT LDB O27 TYPE READ, FORMATTED SZA LDB O25 TYPE READ, BINARY JMP RAMOV * RRWT NOP INB LDA B,I CPA W.LP LEFT PAREN JMP *+2 JMP RER4 ERROR STB RFWAN SAVE ALFA FWA INB LDA B,I COMPUTE COMMA ADDR SLA CLA,RSS NOT VARIABLE TYPE. ALF,ALF ALF AND O17 SAVE CHAR COUNT ARS INA ADDEND=N/2+1 ADA B LDB A,I CPB W.CMA COMMA CLA EXIT A=0 JMP RRWT,I * RET INB LDA B,I CPA RNS INB,RSS JMP RER4 ERROR STB RFWAN LDB O17 1640 TYPE RETURN JMP RAMOV * REW INB STB RFWAN LDA M6 -6 LDB O31 TYPE REWIND JMP RM2 * RGO ADB O2 ADD 2 TO ADDRESS LDA B,I AND .MU1 177400 CPA ROS COMPARE W/0, ZERO JMP *+2 JMP RER4 ERROR STB RFWAN INB LDA B,I CPA W.LP LEFT PAREN (ALFA) JMP *+4 LDB O13 TYPE GO TO N LDA M4 -4 JMP RM2 STB RFWAN LDB O14 TYPE GO TO ( JMP RAMOV * RIF INB LDA B,I CPA RFS COMPARE W/F,ZGO INB,RSS JMP RER4 ERROR LDA B,I CPA W.LP LEFT PAREN (ALFA) JMP *+2 JMP RER4 ERROR STB RFWAN LDB O12 TYPE IF JMP RAMOV * REEEE INB LDA B,I CPA RNDS COMPARE W/ND JMP RND LDB RALFI ADB O5 ADD 5 TO ADDRESS LDA B,I CPA RCES COMPARE W/CE INB,RSS JMP RER4 ERROR 6 LDA B,I CPA W.LP LEFT PAREN (ALFA) JMP *+2 JMP RER4 ERROR STB RFWAN LDB O6 TYPE EQUIVALENCE JMP RAMOV * RND INB LDA B,I STB RFWAN COMPARE W/END ALFA STRING CPA O17 CHECK FOR $ OR LE JMP REND INB LDA B,I CPA RLES COMPARE W/LE INB,RSS JMP RER4 ERROR STB RFWAN LDA O7 LDB O33 TYPE ENDFILE JMP RM2 * REND LDB O34 TYPE END JMP RAMOV * RCCC INB LDA B,I CPA RALS COMPARE W/AL JMP RCALL EQUAL PROCESS CALL CPA RONS COMPARE W/ON JMP RCONT EQUAL, PROCESS CONTINUE CPA ROMS COMPARE W/OM INB,RSS EQUAL, PROCESS COMMON JMP RER4 ERROR INB ADD 2 TO ADDRESS LDA B,I AND .MU1 CPA RNS COMPARE W/N,ZERO JMP *+2 JMP RER4 ERROR LDA MO140 OCT -140 JSB RIDNT LDB O5 TYPE COMMON JMP RAMOV * RCONT ADB O3 ADD 3 TO ADDRESS LDA B,I CPA RES COMPARE W/E,ZERO CLB,INB,RSS JMP RER4 ERROR LDA O17 END ALFA STRING STA RALFI,I ADB RALFI LDA O20 TYPE CONTINUE STA TYPE LDA RALFI JMP SCAN,I * RCALL INB LDA B,I CPA RLZ COMPARE W/L,ZERO JMP RER4 ERROR AND .MU1 CPA RLZ JMP *+2 JMP RER4 ERROR LDA MO100 -4 IN CHAR CNT POSN JSB RIDNT STB RFWAN LDA RALFI,I AND O360 =(N/2)+1, WHERE N=NO. CHARS ALF,ALF IN IDENT STRING ALF,ARS INA ADA RALFI LDB A,I CPB W.LP LEFT PAREN (ALFA) JMP RCAL1 LDB W.LP STB A,I INSERT LFT PAREN INA J LDB W.RP STB A,I INA LDB O17 STB A,I ADD END ALFA SIGNAL INA STA ALFA RCAL1 LDB O21 TYPE CALL JMP RAMOV EXIT * RDIM INB LDA B,I CPA RIMS JMP *+2 JMP RER4 ERROR ADB O3 ADD 3 TO ADDRESS LDA B,I CPA RONS COMPARE W/ON JMP *+2 JMP RER4 ERROR LDA M9 JSB RIDN2 LDB O4 TYPE DIMENSION JMP RAMOV * RFUN INB LDA B,I CPA RUNS COMPARE W/ON JMP *+2 JMP RER4 ERROR ADB O3 ADD 3 TO ADDRESS LDA B,I AND .MU1 CPA RNS COMPARE W/N,ZERO JMP *+2 JMP RER4 ERROR LDA .M8CC -8 IN CHAR CT POS JSB RIDNT LDB O3 TYPE FUNCTION JMP RAMOV * RSUST INB LDA B,I CPA RUBS COMPARE W/UB JMP RSUBR PROCESS SUBROUTINE CPA RTOS COMPARE W/TO INB,RSS JMP RER4 ERROR LDA B,I AND .MU1 CPA RPS COMPARE W/P,ZERO JMP *+2 JMP RER4 ERROR LDA M4 -4 STB RFWAN LDB O15 TYPE STOP JMP RM2 * RSUBR ADB O4 LDA B,I AND .MU1 CPA RES COMPARE W/E,ZERO JMP *+2 JMP RER4 ERROR LDA .M1Z -10 IN CHAR CNT POS JSB RIDNT LDB O2 TYPE SUBROUTINE JMP RAMOV * RPPAU INB LDA B,I CPA RROS COMPARE W/RO JMP RPROG PROCESS PROGRAM CPA RAUS COMPARE W/AU INB,RSS JMP RER4 ERROR LDA B,I CPA RSES COMPARE W/SE INB,RSS JMP RER4 ERROR STB RFWAN LDA O5 LDB O16 TYPE PAUSE JMP RM2 * RPROG ADB O2 ADD 2 TO ADDRESS LDA uB,I CPA RAMS COMPARE W/AM JMP *+2 JMP RER4 ERROR LDA M7 -7 JSB RIDN2 CLB,INB TYPE PROGRAM RAMOV STB TYPE JMP SCAN,I EXIT * * ENTERED FOR STOP, PAUSE, GO TO N, REWIND, * ENDFILE, AND BACKSPACE PROCESSING * (A)= # CHAR IN VERB (2'S CP. IF EVEN) * (B)= TYPE CODE * RFWAN POINTS TO 1ST CHAR FOLLOWING VERB * RM2 STB TYPE SSA,RSS CMA,INA MAKE 2'S CP. IF POS. STA RS1 # CHAR IN VERB (2'S CP.) LDA RALFI,I GET TOTAL # CHAR IN STRING ALF,ALF ALF AND O17 ADA RS1 STA RS2 # CHAR TO BE PROCESSED CPB O15 STOP STATEMENT? JMP RM2SP YES CPB O16 PAUSE STATEMENT? JMP RM2SP YES CPB O13 GO TO N STATEMENT? JMP RM2G YES LDA RFWAN,I CHECK FIRST CHARACTER: LDB RS1 IF ODD, CHAR IS IN UPPER HALF SLB,RSS IF EVEN, CHAR IS IN LOWER HALF ALF,ALF INTERCHANGE IF EVEN JSB RNX JMP RM2NN NON-NUMERIC * NUMERIC: CHECK LAST CHARACTER FOR B LDB RS2 # NUMERIC CHAR LDA RS1 # CHAR IN VERB SLA ODD OR EVEN? ADB M1 ODD, SUBTRACT 1 BRS DIV BY 2 AND TRUNCATE ADB RFWAN LDA B,I WORD CONTAINING LAST CHARACTER LDB RS1 ADB RS2 SLB SKIP IF LAST CHAR IS IN U/H ALF,ALF POSITION TO UPPER HALF AND .MU1 CLEAR LOWER HALF LDB RS2 CPA RBS COMPARE WITH B, ZERO JMP *+3 LAST CHAR IS B RM5 ADB O400 SET INTEGER BIT FOR CONVERSION JMP *+2 ADB M1 SUBTRACT 1 FOR B CHARACTER STB RS2 RM2C LDA RFWAN LDB RS1 SLB,RSS MAKE ADDRESS NEG. IF FIRST CHAR CMA,INA IS IN LOWER HALF (RS1 IS EVEN) LDB RS2 JSB RROUT,I CONVERT JMP RER1 JSB ICEQS STORE CO&NSTANT IN LIST LDB RALFI STA B,I STORE CONSTANT CODE IN STRING STB FWA INB RM4 LDA O17 END OF ALFA STRING STA B,I INB STB LWA JMP SCAN,I RETURN * RM2SP SZA TEST RS2 JMP RM2C LDB RALFI NO DIGITS IN STOP OR PAUSE STB FWA JMP RM4 * RM2G LDB RS2 JMP RM5 * RM2NN LDA RS1 # CHAR IN VERB IN 2'S COMPLIMENT LDB RFWAN RESTORE POINTER SLA IF EVEN, PREPARE CALL TO RIDNT JMP *+4 IF ODD, PREPARE CALL TO RIDN2 ALF ROTATE TO CHAR CNT POS JSB RIDNT JMP SCAN,I EXIT SCANNER ADB M1 REPOSITION POINTER FOR CALL JSB RIDN2 JMP SCAN,I EXIT SCANNER * RNCVT NOP LDA RNCT COMPUTE CHAR CNT ADA O25 STA RNCT LDA RNFWA FWA NUM STRNG LDB RTF SZB,RSS JMP RIO CHK INT,OCT LDB O400 BLS REAL CONST TYPE ADB RNCT ADD CHAR CNT JSB RROUT,I JUMP TO ASCN JMP RER1 ERROR, ILLEGAL CHAR JSB RCEQS STORE REAL NUM RN2 STA ALFA,I JSB CKALF STA RTF RESET REAL CONST FLAG STA RNFLG CLEAR NUM FLAG STA RBF RESET OCTAL FLAG STA RNULF LDA RNFWA RESET NUM STRING BUFFR STA RNBUF LDA RNCTI STA RNCT INIT NUM CHAR CNT JMP RNCVT,I * RIO LDB RBF CHK OCTAL FLAG SZB,RSS JMP RINT LDB RNCT LOAD CHAR CNT JSB RROUT,I CONVERT CONSTANT JMP RER1 ERROR JSB ICEQS STORE INTEGER JMP RN2 * RINT LDB O400 TYPE INTEGER ADB RNCT ADD CHAR CNT JMP RIO+4 * RIDN2 NOP STA RS1 SAVE NEG CHAR CNT LDA CEFLG TEST FOR DO STATMNT SLA JMP RID7 TYPE = DO LDA RALFI,I RID8 ALF,ALF ALF AND O17 MASK TOTAL CHAR COUNT ADA RS1 ALF STA RS1 SAVE DESCRIPTOR CHAR COUNT STB RCTI SAVE LOCATION COUNTER STB RFWAN LDA O4 CLASS IDENT IOR RS1 STA RCTI,I INB LDA B,I JSB RLE CHECK FOR LFT PAREN,END JMP RER4 AND .MU1 JMP RID6 * RID7 LDA RS4 PICK UP CHAR CNT JMP RID8 * RID3 INB LDA B,I JSB RLE JMP RID4 ALF,ALF AND O377 MASK OUT UPPER BITS RID6 IOR RCTI,I STA RCTI,I ISZ RCTI LDA RS2 ALF,ALF AND .MU1 MASK OUT LOWER BITS STA RCTI,I JMP RID3 * RID4 LDA RS1 SLA,RSS JMP RIDN2,I CLA STA RCTI,I JMP RIDN2,I EXIT * RLE NOP CPA W.LP LEFT PAREN (ALFA) JMP RLE,I CPA O17 END ALFA JMP RLE,I CPA W.EQ EQUAL (ALFA) JMP RLE,I CPA W.CMA COMMA JMP RLE,I STA RS2 ISZ RLE RETURN TO CALL+2, IF # JMP RLE,I * RASTO NOP STA RAFLG SET FLAG AND .MU1 LDB RACNT NO OF CHAR. SZB,RSS JMP RA1 SLB,RSS ALF,ALF NEG, PUT CHAR IN UPPER RA1 IOR ALFA,I STA ALFA,I SZB SLB,RSS JSB CKALF BUMP ALFA INB STB RACNT JMP RASTO,I EXIT * CKALF NOP ROUTINE TO CHK ALFA LENGTH ISZ ALFA LDA ALFA CPA BCLIS JMP RER5 ERROR, ALFA STRING EXCEEDED CLA STA ALFA,I JMP CKALF,I * RER1A ISZ CONAD BUMP ADDEND TO LABEL CCB,RSS CCB STB RSFLG INDICATE END-OF-STATEMENT RER1 LDA O14 ILLEGAL CONSTANT JSB ERRR LDA REOSF SZA JMP SCAN+1 FLAG=0,END OF STATMNT JSB RGET P GET NEXT CHARACTER SSA,RSS JMP *-2 JMP SCAN+1 END OF STATMNT * RER2 LDA O4 ILLEGAL USE OF PERIOD JMP RER1+1 * RER4 LDA O2 UNRECOGNIZED STATEMENT JMP RER1+1 * RER5 LDA O16 JSB ERRR PRINT ERROR FOR TABLE OVERFLOW JMP TILT HALT * RER6 LDA O3 UNMATCHED PARENS JMP RER1+1 * RIDNT NOP STA RCTI LDA RALFI,I AND O360 ADA RCTI AND O360 STA RCTI LDA B,I ALF,ALF AND .MU1 IOR RCTI INSERT CHAR COUNT IOR O4 INSERT CLASS IDENT. STB RFWAN STA B,I JMP RIDNT,I EXIT * SKP ***************************************************************** *THIS ROUTINE GETS A NON-BLANK CHARACTER FROM THE INPUT BUFFER * *AND RETURNS IT TO A-REG(UPPR W/LOWR ASC BLANK) OR RETURNS ZERO * *IF END OF STATMNT IS ENCOUNTERED * *************************************************************** * RGET NOP LDB RF1 FLAG (UPPER/LOWER HALF WD) RGET1 LDA RBL,I LOAD CHARACTERS ISZ RGCC CHECK CHAR CNT RSS JMP RGET4 END OF RECORD SSB JMP RGET3 NEG,LOWER HALF JMP RGET3+2 * RGET4 JSB RPRNT LIST IF L-OPTION SPECIFIED JSB READ SZA,RSS JMP RGET2 END OF TAPE,EOS LDA RBUFF AND .MU1 CPA RCS JMP RGET4 LDA RBF2,I FWA+2,BUFFR AND O377 CPA O40 BLANK? JMP RGET2 EQUAL, END OF STATMNT CPA O60 ZERO? JMP RGET2 EQUAL, EOS LDA RBF3 FWA+3 OF BUFF STA RBL CLB JMP RGET1 * RGET2 CCA JMP RE5 * RGET3 ALF,ALF ISZ RBL BUMP BUFF ADDR CMB AND .MU1 ISZ RGFLG JMP *+2 SQUEEZE BLANKS JMP *+3 PASS BLANKS CPA .B*Z BLNK(ASCII)UPPR,ZERO LOWR JMP RGET1 IGNORE BLANK STB RF1 SAVE UPPER/LOWER FLAG RE5 CLB STB RGFLG CLEAR FLAGS JMP RGET,I EXIT WITH NON-BLANK CHAR * SKP RPRNT NOP LDA OPT SZA,RSS L-OPTION ? JMP RPRNT,I NO,EXIT LDA O3 YES, SET STA RTYPE ASCII RECORD TYPE LDA RGC CHAR. COUNT LDB RL1 FWA OF BUFFER JSB LNK27,I LIST LINE OF CODE (WRITB) JMP RPRNT,I EXIT * READ NOP LDB PNT03 INITIALIZE FMP ERROR STB NAME FILE NAME POINTER LDA .2B FILL FIRST 6 CHAR OF READ BUFFER STA RBUFF WITH BLANKS BEFORE READING STA RBUFF+1 STA RBUFF+2 * JSB READF READ DEF *+6 SOURCE DEF IDCB0 RECORD DEF ERRS DEF RBUFF DEF O44 DEF LENI SSA ERROR OCCUR? JMP FMPER YES.GO REPORT IT LDA LENI NO.GET AN CPA M1 EOF? JMP RD1B YES.EOS RAL * * SZA BLANK FRAME? JMP READ1 NO RD1B LDB RSFLG YES SZB JMP READ+1 CCB RD1A STB RSFLG SZB JMP READ+1 JMP READ,I * READ1 STA RGC CMA ADA O6 SSA,RSS CHECK CHAR CNTR NEGATIVE CCA POSITIVE, SET TO -1 STA RGCC SAVE NEG CHAR CNT CLB JMP RD1A * PNT03 DEF AI+1 LINK TO INPUT FILE NAME RJUMP DEF ROPJP+9 ROPJP JMP RPL PRO + JMP RMI PRO - JMP RAS PRO * JMP RSL PRO / JMP RCO PRO , JMP RLP PRO ( JMP RRP PRO ) JMP REQ PRO = JMP RDOL PRO $ * SKP * LENI NOP * * * ******************************** * ENTRY POINT FOR RETURN STATEMENT *  ******************************** * MSP3 NOP LDA FDVL,I LOAD FIRST WORD OF DEC VAR LIST AND O20 ISOLATE TYPE BIT STA MODE SET MODE INDICATOR IOR O4 FORM BETA NOTATION FOR NON- STA 1 DIMENSIONED VARIABLE OF CORRECT LDA PTYPE IS THIS A FUNCTION CPA O1 IS THIS A PROGRAM? JMP MSP3,I YES, RETURN ADA M3 IF NOT, JUMP OVER LDA CALL SSA JMP *+3 CLA,INA LOAD A WITH LDA INDICATOR JSB MPUT1,I CALL PUTAWAY 1 CLB LDA O11 LOAD A WITH JUMP INDICATOR JSB MPUT1,I CALL PUTAWAY 1 JMP MSP3,I RETURN TO CALLING PROGRAM * SKP * * *CONSTANTS CPAR OCT 1000 OCT 27024 ALPHA-FORMAT OF VAR,CALLED . * *********************************** * NEST PROCESS NON-EXECUTABLE STATEMENTS *CALLING SEQUENCE * JSB NEST *RETURN A= FWA SYMTAB * B= LWA SYMTAB *ALPHA STRING OF NEXT STATEMENT * LFWA IS FIRST WORD * LLWA IS LAST WORD *********************************** * BUFAS BSS 1 EPTYP BSS 1 W99UP OCT 61400 99 IN HIGH 8 BITS WM72 OCT -72 PPRGO DEF PPROG * ISZ NEST JMP NEST,I * NEST NOP LDB BUFAD STB BUFAS SAVE BUF ADDR LDA W99UP PRESET PROG PRIORITY STA 1,I TO 99 INB CLA STA 1,I CLEAR OUT ALL INB OTHER PARAMETERS STA 1,I INB STA 1,I * STA EPTYP CLEAR DEFAULT PROG TYPE STA COMFG INITIALIZE COMMON/DIMEN FLAG STA PARM STA DORDT ORDINAL OF TABLE LDA FDVL CONST ADDR- FIRST WORD AVAIL STA LDVL LDA NESTM STA NDVLE CLA,INA STA CLOC INITIALIZE COMMON ALLOC JSB LNK22,I READ A STATEMENT, ALPHA (SCAN) JSB MOVA.,I MOVA: MOVE ALPHA TO HI MEM LDA STYPE CPA O35 JMP NEST-2 CLB FIRST 640STATEMENT IS FUNCTION, STA PTYP ADA M4 -4 SSA JMP PPRG NO USE DUMMY PRG STATEMENT LDB LFWA LDA LPRG STA LFWA CLA,INA STA TYPE PPRG STB PFWA * *PROCESS PRG, FUN, OR SUBR STATEMENT LDA LFWA,I CPA O4 FUNCTION OR SUBR WITHOUT NAME? RSS YES, ERROR JMP *+4 CONTINUE JSB ERRR PRINT ERROR MESSAGE LDB CPAR+1 STB LFWA,I NAME FUNC OR SUBR: .,AND GO ON * ALF,ALF AND O377 ADA WM72 SSA,RSS DIGIT? JMP *+6 NO, GO ON ADA O12 SSA DIGIT? JMP *+3 NO, OK LDA O4 YES, ERROR=4 JSB ERRR PRINT MESSAGE, THEN GET NAME LDB O3 CCA ADA TYPE SZA PROGRAM? LDB O7 NO. STB EPTYP DEFAULT TYPE=3(PROG),7(SUBPROG) * LDA LFWA JSB PRAE PROGRAM NAME LDA LNWA,I CPA W.LP TEST FOR PARAM RSS GOT ( JMP NEXT4 NO PARAMS * *PROCESS PARAM CCA ADA TYPE SZA,RSS PROGRAM? JMP PPRGO,I YES * PPAR LDA LNWA NEXT ALPHA ENTRY INA STA LFWA PPAR1 LDA LFWA,I ) CPA W.RP JMP NEXT5 YES END PARAM CPA W.CMA (, ,, COMB BYPASS JMP PPR1 PROCESS NEXT ELEM AND O17 ALPHANUMERIC TYPE ADA M4 SZA JMP SERR1 NO- ERR g6 LDA PARM YES ALS ADA CPAR SSA JMP PARO TOO MANY PARAM ARS STA PARM LDA LFWA JSB NELM EXTRACT NAME STA LNWA LDA LFWA JSB LNK34,I (SDVL) PREVIOUSLY DEFINED? SSA -1 MEANS NOT FOUND JMP NXT0 NO DDEF LDA O7 YES, DOUBLE DEFINE JSB ERRR LDA BUFAS SET CORRECT MULTI-COMPILE STA BUFAD ADDRESS JMP NXT1 * NXT0 LDA LDVL LOC IN DVL LDB 0 ADA O10 LOC NEXT DVL STA LDVL ISZ DORDT COUNT ENTRIES LDA 1,I IOR PARM SET PARAM NO STA 1,I INB CCA STA 1,I -1 TO LOC OF PARAM LDA LNWA,I NEXT ELEM CPA W.CMA , JMP PPAR PROCESS NEXT PARAM CPA W.RP END? JMP NEXT5 YES JMP SERR1 NO ERROR * NEXT5 ISZ LNWA NEXT4 JMP *+1,I GET OPTIONAL COMMENTS ON SUB,FUN DEF GTCMT * NEXT3 BSS 0 NEXT LDA LDVL STA EPAR SAVE LOC END OF PARAM * WNEXT LDA BUFAS SET CORRECT MULTI- STA BUFAD BUFFER ADDRESS LDA PTYP CPA O3 RSS JMP NST LDA FDVL,I AND O20 20B SZA ISZ PTYP NST LDB FDVL LDA PARM IOR 1,I STA 1,I INB LDA EPTYP PRG TYPE TODVL OF PRG NAME ALF ALLOW 4 BITS FOR TYPE ADA PTYP SAVE RTE TYPE AND PROG TYPE STA 1,I LDA PFWA SZA,RSS JMP NXT1 NO STA LFWA YES LDA TYPE USE FIRST STATEMENT STA 1,I LDB PTYP STA PTYP STB TYPE JMP *+2 NXT1 JSB LNK22,I READ A STATEMENT, ALPHA FORMAT JSB MOVA.,I MOVE TO TOP OF AVAILABLE MEM LDA TYPE ADA M4 LT 4 IS PRG, FUN, OR SUBR SSA JMP ISER ERR LDB M3 ADB 0 SSB,RSS JMP TFMT GT 7 MAY BE FORMAT OR EXECUTABLE ِ ADA NXSL SET UP JMP TO PROCESSOR JMP 0,I (A) = ADDR OF PROCESSOR * NXSL DEF *+1 JMP DIMS JMP COMN JMP EQIV * **PROCESS ALPHANUMERIC IDENTIFIERS * PRAE NOP JSB NELM END OF ELEM STA LNWA LDA LFWA JSB LNK34,I SEARCH FOR DECL VAR OR USE NEW SSA JMP *+3 LDA 1 LOC TO A ORDINAL NOT USED JMP PRAE,I LDB LDVL MOVED LOC TO BE NEXT ENTRY JSB NDVLE,I LDA LDVL STB LDVL SAVE NEW END OF DVL ISZ DORDT COUNT ENTRIES JMP PRAE,I * ISER LDA O2 STATEMENT OUT OF RSS SERR LDA O4 ERROR IN FORM OF STATEMENT JSB ERRR JMP NXT1 * PPR1 ISZ LFWA NEXT ELEM JMP PPAR1 * SERR1 LDA O4 RSS PARO LDA O10 ERROR: TOO MANY PARAM JSB ERRR JMP NEXT * TFMT ADB M3 SSB,RSS JMP NEND GT9 EXECUTABLE JSB FORMT,I JMP NXT1 * DIMS LDA COMFG COMMON-FLAG SZA,RSS DID COMMON STATEMENT OCCUR ? JMP *+3 NO,OK LDA O2 JMP SERR+1 ERROR,DIMENSION FOLLOWS COMMON STA SBCE JSB .PVAR JMP NXT1 RETURN FOR NEXT STATEMENT ISZ LFWA NEXT VARIABLE TO BE JMP *+2 ENTERED IN SYMTAB * .PVAR NOP PROCESS VARIABLE DECLARATION LDA LFWA,I AND O17 TYPE OF ALPHA ELEM. CPA O4 SHOULD BE ALPHANUMERIC JMP *+2 JMP CFWA OR END LDA LFWA,I AND O377 CPA O4 0 - COUNT? JMP SERR YES. LDA LFWA JSB PRAE PROCESS ALPHA NUMERIC STA LSYM LOC IN SYMBOL TABLE CPA FDVL PROG.NAME= DECLARED VAR OR ARRAY JMP DDEF YES,ERROR LDA SBCE COMMON OR DIM SZA,RSS JMP DVAR DIM LDB EPAR COM MAY NOT BE PARAM CMB,INB ADB LSYM SSB TEST CBIT, MAY NOT BE PARAM JMP DDEF AK OR ERR LDA LSYM,I AND O10 SZA PREVIOUS COMMON DECLARATION JMP DDEF LDA O10 SET COMMON BIT IOR LSYM,I STA LSYM,I DVAR LDA LNWA STA LFWA LDA LFWA,I CPA W.LP IF ( JMP DVARE GO TO PROCESS SUBSCRIPT LDA LSYM,I PREVIOUS DIMENSIONS SSA DIMENSION JMP WVARX YES IOR MC02 NO,SET NON-DIMEN ENTRY STA LSYM,I IN DVLIST LDB LSYM FWA OF DVLIST-ENTRY (8 LOC/ENT) ADB O7 CLA,INA STA 1,I SIZE OF NON-DIM VAR = 1 WVARX LDA SBCE MUST BE COMMON STATEMENT SZA,RSS JMP SERR OR HAVE SUBSCRIPTS LDA LFWA,I JMP *+5 * DVARE LDA LSYM,I SSA JMP DDEF JSB PSUB STA BWCE SAVE A LDA STYPE CPA O5 COMMON STATEMENT? CLB,INB,RSS JMP DVARF NO,CONTINUE ADB LSYM FWA OF DVLIST-ENTRY LDA CLOC STA 1,I SET COMMON LOC ADB O6 LDB 1,I SIZE OF ELEMENT LDA LSYM,I AND O20 SZA BLS SIZE *2 IF REAL ADB CLOC STB CLOC UPDATE CLOC DVARF LDA BWCE RELOAD A CPA W.CMA JMP .PVAR-2 PROCESS NEXT ENTRY CFWA CPA O17 END? JMP .PVAR,I YES JMP SERR OR ERROR * COMN CCA STA COMFG OUTLAW DIMENSION STATEMENT LDA O10 STA SBCE JSB .PVAR JMP NXT1 SKP * *PROCESS SUBSCRIPT ALLOCATION EXPRESSION *ENTER WITH LSYM= LOC OF FIRST WORD IN SYMTAB * LFWA= LOC OF ( * PSUB NOP ISZ LFWA LDB LSYM ADB O5 5 LDA LFWA,I AND O37 CPA O3 EXTRACT CONSTANT SUBSCRIPT JMP *+2 JMP SERR NOT CONSTANT, IS ERROR XOR LFWA,I EXTRACT ORDINAL ALF,ALF RAL,RAL CMA ADA TCLIS LDA 0,I SZA,RSS JMP SERR LDB LSYM/ ADB O6 STA 1,I INB STA 1,I SET NO.OF ELEMENTS 1ST DIM LDB 0 ISZ LFWA LDA LFWA,I ISZ LFWA CPA W.CMA JMP PSB2 PROCESS 2 SUBS CPA W.RP OR ELSE END JMP *+2 JMP SERR NO, ERROR LDB IBIT SDIM LDA LSYM,I AND MC03 IOR 1 STA LSYM,I SYM TABLE LDA LFWA,I NEXT ALPHA IN A JMP PSUB,I EXIT * PSB2 LDA LFWA,I AND O37 CPA O3 JMP *+2 JMP SERR XOR LFWA,I ALF,ALF RAL,RAL CMA ADA TCLIS LDA 0,I SZA,RSS JMP SERR ISZ LFWA JSB MPYA,I LDA LSYM ADA O7 LOC OF D2 IN SYMTAB STB 0,I LDA LFWA,I ISZ LFWA CPA W.RP RSS JMP SERR LDB MC01 140000 JMP SDIM * CERR LDA O15 STB SWAP SAVE B JSB ERRR CLA,INA SET LOC TO 0 IF SUBSCR WAS NE LDB SWAP RELOAD B JMP AMC2-1 * SWAP NOP LDA BWCE REVERSE BASE AND LDB CWCE CURRENT STA CWCE LOCS STB BWCE LDA SBCE AND SUBSCRIPT OF LDB NWCE BOTH STA NWCE STB SBCE JMP SWAP,I * BASE NOP STA TEMP+2 FIND BASE OF EQUIV ENTRY LDA 0,I AND O40 SZA JMP *+3 LDA TEMP+2 JMP BASE,I LDA TEMP+2 ADA O5 LOC OF CONAD OF BASE ADB 0,I CONADD OF NEW BASE LDA TEMP+2 LOC NEW BASE INA LDA 0,I NEW BASE JMP BASE,I * EQIV CLA STA BWCE BASE WORD CURRENT EQ STA SBCE SUBSCRIPT OF BASE LDA LFWA,I ALPHA ENTRY CPA W.LP ( JMP EQV1 YES CPA O17 NO, END? JMP NEQL YES QERR LDA O4 NO, FORMAT ERROR JSB ERRR JMP NEQL GET NEXT STATEMENT * EQV1 ISZ LFWA NEXT ENTRY LDA LFWA,I ALPHXXA ENTRY AND O17 MASK TYPE CPA O4 ALPHANUMERIC IDENTIFIER? JMP EQV2 YES ENEL LDA LFWA,I NO CPA W.CMA TEST FOR (8 OR ,, COMBINATION JMP EQV1 YES CPA W.RP NO; () OR ,) COMBINATION? JMP NLST YES JMP QERR NO UNDEFINED * EQV2 LDA LFWA PROCESS ALPHANUMERIC IDENTIFIER JSB PRAE SEARCH (OR ENTER) DVL STA CWCE LOC OF ENTRY IN DVL CPA FDVL MAY NOT B PRG NAME JMP QERR LDA 0,I OR PARAM AND MPAR SZA JMP QERR LDA LNWA UPDATE ALPHA STA LFWA LDB CWCE,I LDA LFWA,I FOLLOWED BY SUBSCRIPT CPA W.LP ( ? JMP EQV2A LDA CWCE,I SSA,RSS IOR MC02 STA CWCE,I CLB JMP EQV3 * EQV2A SSB DIMENSIONED VAR? JMP *+4 YES LDA O6 NO, ERROR. JSB ERRR JMP NEQL LDA CWCE LDB LFWA JSB LNK35,I (ECSUB) STB LFWA LDB 0 EQV3 STB NWCE LDA BWCE IS THIS BASE ELEM SZA JMP EQV3A NO LDA CWCE YES JSB BASE EXTRACT BASE OF BASE STA BWCE STB SBCE JMP ENEL PROCESS NEXT ELEM * EQV3A LDA CWCE JSB BASE EXTRACT BASE OF CURRENT EQ STA CWCE STB NWCE CPA BWCE IF SAME AS BASE EQUIV ERR JMP QERR LDA CWCE,I IS CURRENT COMMON AND O10 SZA JSB SWAP EXCHANGE BASE AND CURRENT LDA BWCE,I SET COMMON FLAG AND O10 STA CFLG SZA JMP BCOM PROCESS COMMOM CMB,INB -SUBS CURR ADB SBCE +SUBS BASE SSB JSB SWAP CURRENT GT BASE, LDA CWCE MAKE NEW BASE ADA O5 +5 LDB 0,I STB WQADD+1 SAVE ADDEND TO BASE LDB NWCE CMB,INB -SUB CUR ADB SBCE +SUB BASE IS CONADD STB WQAD`WD+2 SAVE DIFF STB 0,I CON ADDEND OF BASE ADA M4 LDB 0,I STB WQADD BASE ADDR LDB BWCE LOC BASE STB 0,I TO CURRENT ENTRY SETE LDA CWCE,I AND O40 STA WQADD+3 0 IF NOT EQUIV,1 IF EQUIV LDA O40 SET PRIOR REF TO THIS BASE IOR CWCE,I BY UPDATING EACH ENTRY STA CWCE,I LDA CWCE SEARCH FOR PREVIOUS REFERENCES TO LDB FDVL EQIV AND SET EQIV TO BASE TSTE CPB LDVL END JMP DEQCK LDA 1,I LOC BASE IF EQIV AND O40 SZA JMP *+3 EQIV JSB NDVLE,I JMP TSTE INB BASE LDA 1,I LOC CURRENT BASE CPA CWCE JMP *+3 SAME AS THIS EQIV ADB O7 PROCESS NEXT ENTRY JMP TSTE LDA BWCE SET NEW BASE STA 1,I ADB M1 LDA CFLG SET COM IF SET IOR 1,I STA 1,I ADB O5 LOC OF SUBSCR ADDEND LDA 1,I ADA WQADD+2 NEW ADDEND STA 1,I ADB O3 NEXT DVL ENTRY JMP TSTE * DEQCK LDA WQADD+3 SZA,RSS NON-BASE IS EQUIVALENCED ? JMP ENEL NO, NEXT EQUIV LDA WQADD YES,INCLUDE ALL EQUIV TO OTHER STA CWCE BASE,SET OTHER BASE TO NON-BASE LDB WQADD+1 ADDEND JMP EQV3 * NLST ISZ LFWA NEXT ELEM LDA LFWA,I END OF () ISZ LFWA CPA W.CMA (), JMP EQIV PROCESS NEXT EQUIV CPA O17 END? JMP NEQL YES JMP QERR OR ERROR * BCOM LDA CWCE,I PROCESS COMMON EQIV AND O10 BOTH COMMON IS ERROR SZA,RSS JMP *+4 LDA O15 BAD EQUIV PARAM JSB ERRR JMP NEQL LDA O10 IOR CWCE,I STA CWCE,I LDA CWCE INA LDB 0,I STB WQADD BASE ADDR LDB BWCE STB 0,I LOC BASE ADA O4 LOC CON ADDEND FOR SUBSCRIPT LDB 0,I  STB WQADD+1 SAVE ADDEND LDB NWCE SUBSCRIPT CURRENT CMB,INB -CURRENT SUBS ADB SBCE SUBS BASE - SUBS CURR STB WQADD+2 SAVE DIFF STB 0,I JMP SETE * JSB FORMT,I PROCESS FORMAT STATEMENT NEQL JSB LNK22,I READ A STATEMENT, ALPHA (SCAN) JSB MOVA.,I MOVA: MOVE ALPHA TO HI MEM LDA TYPE CPA O11 FORMAT? JMP NEQL-1 YES ADA M6 SZA,RSS JMP EQIV SSA,RSS JMP NEND LDA O2 JSB ERRR JMP NEQL * NEND CLA INIT MEMORY ALLOCATION ADA LOCNT STA ALOC LOC ARRAYS LDB EPAR FIRST DVL FOLLOWING PARAM AMEN CPB LDVL END DVL JMP AMCE YES END MEMORY ALLOCATION ARRAYS LDA 1,I NO SZA,RSS LABEL JMP AMEN1 YES AND O40 EQUIVALENCED TO ANOTHER VARIABLE SZA,RSS JMP *+3 NO AMEN1 JSB NDVLE,I NEXT DVL ENTRY JMP AMEN LDA 1,I PROCESS VARIABLE AND O10 COMMON VARIABLE STB BWCE LOC OF BASE OF EQIV SZA JMP ACOM YES JSB UPKL UNPACK DVL ENTRY A=TYPE SZA B=D1*D2 BLS REAL=S*INT NWCE=NO DIM STB ALEN LENGTH BASE ARR SBCE=NO CHAR LDB BWCE INB LDA ALOC LOC OF THIS ARRAY STA 1,I JSB SEALE JMP SEAR * SEALE NOP LDB EPAR SET LOC OF ALL ARRAYS EQIV SEAL CPB LDVL END JMP SEALE,I EXIT * LDA 1,I NO,EQIV AND O40 SZA EQUIV? JMP *+3 YES JSB NDVLE,I NEXT DVL ENTRY JMP SEAL INB LDA 1,I LOC OF BASE CPA BWCE EQUIV TO THIS ELEM JMP *+3 YES ADB O7 NO JMP SEAL STB CWCE ADB M1 JSB UPKL SZA TYPE BLS ARRAY LENGTH*SIZE LDsQA CWCE ADA O4 LOC SUBSCRIPT LDA 0,I EXTRACT SUBSCR OF BASE FOR ZERO OF ADA ALOC CURRENT & SET LOC OF CURR EQUIV SSA JMP CERR EQUIV TRIES TO REORIGIN COMMON STA CWCE,I AMC2 LDA CWCE ADA O4 LDA 0,I EXTRACT SUBSCRIPT DIF AND FIND LENGTH CMA,INA OF BASE ADA ALEN B STILL CONTAINS CURRENT LENGTH CMA,INA -LENGTH BASE PART ADA 1 +LENGTH CURRENT SSA GT 0 JMP *+3 NO, NO EXTENSION ADA ALEN EXTEND LENGTH OF ARRAY TO INCLUDE ALL STA ALEN EQIV ARRAYS LDB CWCE ADB O7 LOC NEXT ENTRY JMP SEAL * SEAR LDA ALEN ADA ALOC JMP ACOM1 * ACOM INB LDA 1,I LDB ALOC STA ALOC SET ALOC=COMMON ADDR FOR SEALE STB WQADD+4 SAVE ALOC LDB BWCE JSB UPKL SZA BLS STB ALEN SIZE OF ARRAY JSB SEALE PROCESS EQUIVALENCED VARS LDA ALOC FWA IN COMMON OF CURRENT ELEMENT ADA ALEN ADD TOTAL SIZE OF EQUIVALENCED LDB 0 ENTITIES CMA,INA ADA CLOC SSA EXTEND COMMON ? STB CLOC YES,SET NEW SIZE OF COMMON LDA WQADD+4 ACOM1 STA ALOC LDB BWCE ADB O10 JMP AMEN * AMCE LDA LOCNT END ARRAY ALLOC, SAVE SIZE, BEG CMA,INA COMMON EQUIV AND DEFS ADA ALOC STA ARSIZ LDB EPAR AMC0 CPB LDVL END JMP PKDVL FINISHED STB CWCE LDA 1,I SSA,RSS JMP *+5 LDA ALOC ADB O5 STA 1,I ISZ ALOC LDB CWCE JSB NDVLE,I NEXT DVL LOC JMP AMC0 * PKDVL LDA ALPHM SET UP FOR PACKED DVL STA NDVLE LDA FDVL LDB FDVL B CONTAINS LOC NEXT DVL, PACKED PKNX1 STA BWCE STA CWCE CPA LDVL JMP PKOUT END LDA BWCE,I STA TEMP SAVE SZA JMP *+3 LDA O4 LABEL ENTRY @ 640 JMP PKNX2 AND O7 MOVE 1,2 AND NAME INA ARS ADA O2 PKNX2 CMA,INA NO WDS DVL STA NWCE JSB PKCWC ISZ CWCE ISZ NWCE JMP *-3 LDA TEMP SZA JMP *+4 LDA BWCE ADA O4 JMP PKNX1 LDA BWCE ADA O5 STA CWCE LOC ORDINAL ADA O3 LOC END STA SBCE LDA TEMP SSA,RSS DIMENSIONS? JMP PKNXT NO LDA TEMP AND MPAR TEST FOR ORDINAL SZA,RSS JSB PKCWC ISZ CWCE NEXT DIM1 JSB PKCWC ISZ CWCE LDA TEMP RAL SSA GOTO PKNXT IF ONLY 1 JSB PKCWC PKNXT LDA SBCE JMP PKNX1 * PKOUT STB LDVL STB TDVL END OF PERMANENT LIST LDA FDVL JMP NEST,I 6 SKP * * UPKL NOP DVL LOC IN B LDA 1,I AND O7 STA SBCE LDA 1,I RAL,RAL AND O3 ADA M1 STA NWCE LDA 1,I ADB NWCE ADB O5 5 LDB 1,I SSA,RSS CLB,INB NON DIMENSIONED AND O20 MASK TYPE-BIT JMP UPKL,I * PKCWC NOP LDA CWCE,I STA 1,I INB JMP PKCWC,I * WQADD BSS 5 SKP * ******************************* * ENTRY POINT FOR PAUSE STATEMENT * ******************************* * MSP1 NOP LDA MSP1 STA MSP2 STORE RETURN ADDRESS IN MSP2 LDA MF1 JMP MSP2+2 GO STORE PAUSE FOR PUTAWAY * * ****************************** * ENTRY POINT FOR STOP STATEMENT * ****************************** * MSP2 NOP LDA MF2 STA MSP1 STORE STOP FOR PUTAWAY CALL CLA STA MODE SET INTEGER MODE LDA FWA,I CPA O17 IS FIRST BETA WORD AN END? JMP MGO1 YES, GO TO PUTAWAY CALL FOR CLA LDA FWA NO, CHECK THAT BETA STRING IS ADA O2 ONE WORD PLUS END CPA LWA JMP *+4 YES, CONTINUE MERR1 LDA O4 NO, LOAD ERROR INDICATOR AND JSB ERRR GO TO DIAGNOSTICS JMP MSP2,I RETURN TO CALLING PROGRAM LDA FWA,I CHECK THAT THE FIRST BETA WORD AND O37 IS AN INTEGER CONSTANT CPA O3 JMP MGO2 JMP MERR1 IF NOT, GO TO DIAGNOSTICS * MGO1 LDA O22 LOAD A WITH CLA INDICATOR JMP MGO2+2 RETURN TO CALLING PROGRAM * MGO2 LDB FWA,I LOAD B WITH BETA OPERAND CLA,INA LOAD A WITH LDA INDICATOR JSB MPUT1,I CALL PUTAWAY 1 LDA O7 LOAD A WITH JSB INDICATOR LDB MSP1 LOAD B WITH PAUSE OR STOP JSB MPUT1,I CALL PUTAWAY 1 JMP MSP2,I RETURN TO CALLING PROGRAM * MF1 ' OCT 1113 .PAUS MF2 OCT 1413 .STOP * SKP * ********************************* * ENTRY POINT FOR GO TO N STATEMENT * ********************************* * MSP4 NOP LDA FWA CHECK THAT BETA STRING IS ADA O2 ONE WORD PLUS END CPA LWA JMP *+4 YES, CONTINUE MERR2 LDA O4 NO, LOAD ERROR INDICATOR AND JSB ERRR GO TO DIAGNOSTICS JMP MSP4,I RETURN TO CALLING PROGRAM LDA FWA,I CHECK THAT THE FIRST BETA WORD AND O37 IS AN INTEGER CONSTANT CPA O3 RSS IF SO, CONTINUE JMP MERR2 OTHERWISE GO TO ERROR LDB FWA JSB MLBCH,I CHECK LABEL FOR 1 TO 9999 RANGE JMP MSP4,I ERROR, RETURN TO CALLING PROGRAM LDB FWA,I LOAD B WITH BETA LABEL LDA O11 LOAD A WITH JMP INDICATOR JSB MPUT1,I CALL PUTAWAY 1 JMP MSP4,I RETURN TO CALLING PROGRAM * SKP * ******************************************* * ENTRY POINT FOR GO TO (N1,..,NM)J STATEMENT * ******************************************* * MSP5 NOP LDB FWA INITIALIZE BETA WORD ADDRESS CLA STA M1SP INITIALIZE LABEL COUNTER LDA 1,I CPA W.LP IS THE FIRST BETA WORD A ( JMP MLOP1 IF SO, CONTINUE MERR3 LDA O4 OTHERWISE, LOAD ERROR INDICATOR JSB ERRR AND GO TO DIAGNOSTICS JMP MSP5,I RETURN TO CALLING PROGRAM * MLOP1 INB INCREMENT BETA WORD ADDRESS LDA 1,I OBTAIN NEXT BETA WORD AND O37 ISOLATE TYPE BITS CPA O3 IS THIS AN INTEGER CONSTANT? RSS IF SO, CONTINUE JMP MERR3 OTHERWISE GO TO ERROR LOCATION JSB MLBCH,I CHECK LABEL FOR 1 TO 9999 RANGE JMP MSP5,I ERROR, RETURN TO CALLING PROGRAM ISZ M1SP INCREMENT LABEL COUNTER INB INCRrEMENT BETA WORD ADDRESS LDA 1,I OBTAIN NEXT BETA WORD CPA W.CMA IS THIS A , JMP MLOP1 IF SO CONTINUE CHECKING STRING CPA W.RP IS THIS A ) INB,RSS IF SO, INCREMENT BETA WORD ADDR JMP MERR3 OTHERWISE, GO TO ERROR LOCATION LDA 1,I OBTAIN NEXT BETA WORD CPA W.CMA IS THIS A , INB YES, INCREMENT POINTER LDA 1,I STA M2SP STORE TEMPORARILY AND O37 ISOLATE TYPE BITS CPA O4 IS THIS AN INTEGER VARIABLE? INB,RSS IF SO, INCREMENT BETA WORD ADDR JMP MERR3 OTHERWISE GO TO ERROR LOCATION LDA 1,I OBTAIN NEXT BETA WORD CPA O17 IS THIS THE END OF THE STRING? RSS IF SO, CONTINUE JMP MERR3 OTHERWISE GO TO ERROR LOCATION LDB MF3 LOAD B WITH GO TO LDA O7 LOAD A WITH JSB INDICATOR JSB MPUT1,I CALL PUTAWAY 1 LDB M1SP LOAD B WITH LABEL COUNTER ADB O2 ADD TWO LDA O34 LOAD B WITH DEF*+B INDICATOR JSB MPUT1,I CALL PUTAWAY 1 LDB M2SP LOAD B WITH INDEX VARIABLE LDA O10 LOAD A WITH DEF INDICATOR JSB MPUT1,I CALL PUTAWAY 1 LDB M1SP CMB,INB INITIALIZE LABEL DEFINITION STB M1SP COUNTER CLA,INA STA M2SP INITIALIZE LABEL LOCATOR MLOP2 LDA FWA ADA M2SP LDB 0,I LOAD B WITH BETA LABEL LDA O36 LOAD A WITH DEF INDICATOR JSB MPUT1,I CALL PUTAWAY 1 ISZ M2SP INCREMENT LABEL LOCATOR TWICE ISZ M2SP ISZ M1SP HAS THE LAST LABEL BEEN DEFINED JMP MLOP2 NO, GO BACK FOR NEXT LABEL JMP MSP5,I YES, RETURN TO CALLING PROGRAM * M1SP OCT 0 M2SP OCT 0 MF3 OCT 0613 .GOTO SKP * * ***************************************** * ENTRY POINT FOR IF (E) N1,N2,N3 STATEMENT * ***************************************** * MSP6 NOP LDB LWA INITIALIZE BETA WORD ADDRESS JMP MLOP3+4 * MERR4 LDA O4 JSB ERRR CALL DIAGNOSTICS JMP MSP6,I RETURN TO CALLING PROGRAM * MLOP3 ADB M1 DECREMENT BETA WORD ADDRESS LDA 1,I LOAD BETA WORD CPA W.RP IS THIS A ) JMP *+4 IF SO, END OF (E) JUMP CPB FWA IF REACH START OF BETA STRING JMP MERR4 ERROR,THIS PREVENTS HANG UP JMP MLOP3 CHECK NEXT BETA WORD LDA O17 REPLACE ) ENDING THE EXPRESSION STA 1,I BY AN END FOR PROCESS BETA INB INCREMENT BETA WORD ADDRESS STB MSP2E STORE CLA STA MSP1E SET BRANCH COUNTER TO 0 MLOP4 LDA 1,I OBTAIN NEXT BETA WORD AND O37 ISOLATE TYPE BITS CPA O3 IS THIS AN INTEGER CONSTANT? RSS IF SO, CONTINUE JMP MERR4 OTHERWISE GO TO ERROR JSB MLBCH,I CHECK LABEL FOR 1 TO 9999 RANGE JMP MSP6,I ERROR, RETURN TO CALLING PROGRAM INB INCREMENT BETA WORD ADDRESS LDA 1,I CPA W.CMA IS THIS A , INB,RSS IF SO, INCREMENT BETA WORD ADDRESS JMP *+3 OTHERWISE CHECK FOR END ISZ MSP1E INCREMENT BRANCH COUNTER JMP MLOP4 GO BACK & CHECK NEXT WORD CPA O17 IS THIS AN END? RSS IF SO, CONTINUE JMP MERR4 OTHERWISE GO TO ERROR LDB MSP1E CPB O1 CHECK THAT THE NUMBER OF JMP *+4 BRANCHES EQUALS TWO OR THREE CPB O2 RSS JMP MERR4 ADB M1 STB MSP1E LDB MSP2E LOAD LWA+1 OF (E) FOR PROC. BETA LDA FWA CMA,INA COMPUTE RELATIVE LOCATION OF ADA MSP2E START OF BRANCH STRING STA MSP2E LDA FWA INA LOAD FWA OF (E) FOR PROCESS BETA JSB LNK25,I CALL PROCESS BETA (WPRB) LDA O20 LOAD A WITH SS:A INDICATOR JSB MPUT1,I CALL PUTAWAY 1 LDA MSP2E ADA FWA LDB 0,I LOAD B WITH BETA OPERAND LDA O11 LOAD A WITH JMP INDICATOR JSB MPUT1,I CALL PUTAWAY 1 LDA MSP1E IS THIS A 3 BRANCH IF SZA,RSS IF SO, CONTINUE JMP MLOP9 OTHERWISE JUMP OVER 3 BRANCH LDA O16 LOAD A WITH SZA INDICATOR JSB MPUT1,I CALL PUTAWAY 1 LDA FWA COMPUTE LOCATION OF 3RD. ADA MSP2E BRANCH LABEL ADA O4 LDB 0,I LOAD B WITH BETA OPERAND LDA O11 LOAD A WITH JMP INDICATOR JSB MPUT1,I CALL PUTAWAY 1 MLOP9 LDA FWA COMPUTE LOCATION OF 2ND. ADA MSP2E BRANCH LABEL ADA O2 LDB 0,I LOAD B WITH BETA OPERAND LDA O11 LOAD A WITH JMP INDICATOR JSB MPUT1,I CALL PUTAWAY 1 JMP MSP6,I RETURN TO CALLING PROGRAM * MSP1E OCT 0 MSP2E OCT 0 * SKP * *INTERMEDIATE STORAGE FWALF BSS 1 COMCT BSS 1 SUBC BSS 1 VTYPE BSS 1 VARIABLE TYPE O=INT 1=REAL SUBL BSS 1 LENGTH SUBSCRIPT OPENN BSS 1 LOC OF ARRAY SUBSCRIPTS ( LASFL BSS 1 SUBSC BSS 1 *CONSTANTS O100 OCT 100 P200 OCT 200 O300 OCT 300 IVBIT OCT 100320 * ***** PROCESS ALPHA STRING ***** *** CALLING SEQUENCE *** * P JSB PRA * P+1 ERROR RETURN * P+2 NORMAL RETURN * 1. IDENTIFY ALPHANUMERIC NAMES WITHIN ALPHA * 2. CHECK SYNTAX OF SUBSCRIPT EXPRESSIONS * 3. PRODUCE BETA STRING ** PRA IDENTIFIES:NON DECLARED VARIABLES * INTRINSIC FUNCTIONS * EXTERNAL FUNCTIONS * DECLARED VARIABLES * ARITHMETIC STATEMENT FUNCTIONS * ASF PARAMETERS * LOCAL VARIABLES * PRA NOP LDA FWBET STA FWALF STA NWBET LDA ASFLG SZA JMP DASF PROCESS ASF PARAMETERS PRST LDA FWALF,I AND O17 IDENTIFY ALPHANUMERIC ELEMENTS CPA O4 TYPE 4? JMP PRALP YES LDA FWALF,I NO,RESTORE ALPHA ENTRY ISZ FWALF SUBCH STA NWBET,I ISZ NWBET CPA O17 END? RSS END JMP PRST PROCESS NEXT ELEM ISZ PRA JMP PRA,I * PRALP LDA FWALF PROCESS ALPHANUMERIC ENTRIES JSB NELM STA NWALF LDA ASFLG SZA,RSS JMP PRAL1 NOT ASF LDA FWALF,I JSB STYP STA VTYPE LDB NWALF END ALPHA ENTRY LDA FWALF SEARCH FOR ASF PARAM JSB SASFL SZA,RSS FOUND JMP PRAL1 NO STA NWBET,I YES ISZ NWBET LDA NWALF,I CPA W.LP JMP DSERR LDA NWALF STA FWALF JMP PRST * PRAL1 LDA FWALF JSB LNK34,I SDVL: SEARCH DECL VAR SSA,RSS JMP PREND FOUND LDA NWALF,I CPA W.LP JMP CFUN OPEN IS AN EXTERNAL FUNCTION JSB EDVL NON-DECL.VAR * * ENTER NAME IN DVL, RETURN * A= ORDINAL, B= LOCATION IOR O4 STA NWBET,I ISZ NWBET LDA 1,I FETCH DVLIST ENTRY AND O20 INB STB WXXXS SAVE DVLIST ADDR. LDB LVORD STB WXXXS,I LV-ORD TO DVLIST ISZ LVORD SZA REAL IS 2 WORDS ISZ LVORD JMP PREND-3 * WXXXS BSS 1 TEMP STORAGE * CFUN LDA FWALF JSB SIFUN SZA JMP PXFN2 INTRINSIC FUNCTION FOUND LDA O14 STA NWBET,I LDA FWALF JSB EDVL IOR NWBET,I STA NWBET,I ISZ NWBET LDA P200 SET TYPE FUN IN DVL IOR 1,I STA 1,I LDA NWALF STA FWALF JMP PRST * PREND ALS,ALS FOUND IN DVL ALF PACK ORDINAL IN BETA FORMAT STA NWBET,I STB SUBSC SZA ORD = 0 ? JMP PREN1 NO, CONTINUE LDA O7 S DOUBLY DEF ERROR CODE LDB PTYPE PROG TYPE ADB M3 SSB FUNCTION ? JMP DSERR+1 NO,ERROR: PROG NAME USED AS IDEN PREN1 LDA SUBSC,I AND O20 IOR NWBET,I TO BETA STA NWBET,I LDA SUBSC,I DVL ENTRY SSA JMP ARRAY DIMENSIONED RAL,RAL AND O3 SZA DECL VAR, NO DIMS JMP PVAR LDA SUBSC,I DVL ENTRY AND O300 FUNCTION SZA,RSS JMP PVAR LOCAL VARIABLE LDB NWALF,I CPB W.LP ( ? JMP *+4 DSERR LDA O6 USED AS FUN AND VAR JSB ERRR JMP PRA,I LDB 0 LDA NWBET,I CPB O100 ASF? IOR O11 YES, ASF-REF CODE = 11B CPB P200 EXTERNAL FUNCTION ? IOR O14 EXT REF CODE = 14B PXFN2 LDB NWALF UPDATE LOC ALPHA STB FWALF JMP SUBCH * ARRAY LDA NWALF,I CPA W.LP JMP *+4 EQ LDA NWBET,I IOR O5 NON SUBSCRIPTED ARRAY JMP PXFN2 LDA NWBET,I IOR O6 STA NWBET,I ISZ NWBET LDA NWBET STA OPENN LDA NWALF,I ISZ NWALF IOR O20 SET TYPE ARRAY ELEM SUBSCRIPT STA NWBET,I BETA ENTRY ISZ NWBET LDA NWALF STA FWALF CCA STA COMCT 0 TO COMMA COUNT CLA PROCESS SUBSCRIPT EXP STA SUBC 0 TO CONSTANT SUBSCRIPT FLAG STA SUBL 0 TO LENGTH SUBS LDA FWALF,I START SUBSC AND O17 MASK ALPHA TYPE CPA O4 TYPE ALPHANUMERIC JMP SUBVR VARIABLE SUBSCRIPT CPA O3 OR CONSTANT JMP *+4 SUBER LDA O13 ELSE ERROR JSB ERRR JMP PRA,I LDA FWALF,I UPDATE BETA STA NWBET,I ISZ NWBET ISZ FWALF ISZ SUBL LDA FWALF,I STA NWBET,I ISZ FWALF ISZ SUBL ISZ NWBET CPA W.TMS C*V JMP SUBV϶R OR SBNL CPA W.RP C) JMP CSB OR CPA W.CMA C, RSS JMP SUBER ELSE ERROR SBNL1 ISZ COMCT ONLY 1 COMMA JMP SUBER LDA SUBSC,I VAR MUST HAVE 2 DIM RAL LOC IN B SSA,RSS JMP SUBER ONLY 1 DIM JMP SUBS * CSB LDA SUBC SZA,RSS JMP ESUB EXPAND CONSTANT SUBSCRIPT LDA SUBL ALF,ALF IOR OPENN,I STA OPENN,I JMP PRST * SUBVR ISZ SUBC LDA FWALF JSB NELM STA NWALF LDA FWALF JSB LNK34,I SDVL: SEARCH DECL VAR SSA JMP SUBV1 ALF,ALS ALS STA NWBET,I LDA 1,I AND IVBIT SZA JMP SUBER JMP SUBV2 * SUBV1 JSB EDVL ENTER NAME IN DVL STA NWBET,I INB LDA LVORD STA 1,I ISZ LVORD LDA NWBET,I AND O20 BETA TYPE SZA JMP SUBER ERROR IF REAL SUBSCRIPT SUBV2 LDA NWBET,I IOR O4 STA NWBET,I ISZ NWBET ISZ SUBL LDA NWALF STA FWALF LDA FWALF,I STA NWBET,I ISZ NWBET ISZ FWALF ISZ SUBL CPA W.CMA JMP SBNL1 CPA W.PLS JMP *+5 CPA W.MIN JMP *+3 CPA W.RP JMP CSB LDA FWALF,I STA NWBET,I ISZ FWALF ISZ NWBET ISZ SUBL AND O37 CPA O3 RSS JMP SUBER LDA FWALF,I STA NWBET,I ISZ FWALF ISZ NWBET ISZ SUBL JMP SBNL * ESUB CCB LOC OF SUBSCRIPTED VARIABLE ADB OPENN LDA 1,I IOR O40 SET CON SUBS BIT STA 1,I LDA O40 SET PAREN TYPE CONST SUBS IOR W.LP STA OPENN,I SET CNT=1, TYPE=CONADDEND LDB OPENN LDA SUBSC JSB LNK35,I (ECSUB) INA LDB OPENN INB STB NWBET STA NWBET,I ISZ NWBEW+T LDA W.RP JMP SUBCH * PVAR LDA NWALF,I CPA W.LP VARIABLE JMP DSERR ERROR MAY NOT BE FOLLOWED BY LDA NWBET,I IOR O4 JMP PXFN2 * DASF LDA FWALF PROCESS ASF PARAM JSB NELM ASF NAME STA NWALF LDA FWALF JSB EDVL ENTER TEMP DVL IOR O11 STA NWBET,I ISZ NWBET LDA O100 SET DVL TO TYPE ASF IOR 1,I STA 1,I LDA FASFL STA LASFL DASFP LDA NWALF BYPASS ( INA PROCESS PARAM STA FWALF JSB NELM STA NWALF JSB EASFL ENTER ASF PARAM LIST LDA NWALF,I CPA W.RP END? CLA,INA,RSS JMP DASFP NO ADA NWALF BYPASS ) STA FWALF PROCESS ARITH JMP PRST * *ASF TABLE FASFL EQU MDOAD USE DO TABLE WHEN IN MEM LASFE EQU DOND SKP * *ENTER PARAM NAME IN ASF LIST *ENTER B=NWALF * A=FWALF * EASFL NOP LDA FWALF LDB NWALF JSB SASFL SEARCH FOR PARAMETER SZA FOUND? JMP ASFER YES, DUPLICATE ASF PARAMETER LDA LASFL STA SUBL LOC CURRENT ENTRV ADA O3 LDB LASFE CMB,INB ADB 0 SSB,RSS + IS TOO MANY PARM JMP ASFER STA LASFL NEW END OF ASF PARAM LIST LDB FWALF LDA 1,I STA SUBL,I ISZ SUBL INB CPB NWALF END JMP EASFL,I YES JMP *-6 * ASFER LDA O10 JSB ERRR JMP PRA,I DELETE ASF SKP * *SEARCH ASF PARAM LIST *ENTER A=FWALF * B=NWALF (SUBL) * SASFL NOP STB SUBL NEXT ALPHA STA OPENN FIRST ALPHA CLB INIT ORDINAL STB ORD LDB FASFL FIRST LOC TABLE SASF0 STB SUBSC FIRST LOC CURRENT ENTRY STA COMCT CURRENT LOC ALPHA LDA COMCT,I CPB LASFL END TABLE JMP SASF2 YES, NOT FOUND lG<:6 CPA 1,I NO, SAME NAME JMP *+6 YES LDB SUBSC NO, NEXT TABLE ENTRY ADB O3 LDA OPENN FIRST ALPHA ISZ ORD JMP SASF0 INB NEXT TABLE ENTRY ISZ COMCT NEXT ALPHA ENTRY LDA COMCT CPA SUBL END ALPHA JMP SASF3 YES, FOUND JMP SASF0+2 NO * SASF2 CLA JMP SASFL,I * SASF3 LDA ORD ALS,ALS PACK ORD TO UPPER 10 BITS IOR VTYPE ALF IOR O7 JMP SASFL,I SKP * * ENTER ALPHANUMERIC IDENTIFIER IN TEMP DVL * CALLING SEQUENCE LDA LOC FWA * JSB EDVL * EDVL NOP RETURN B=LOC LDB LDVL JSB NDVLE,I NEXT DVL ENTRY '< LDA LDVL STB LDVL LDB 0 LDA 1,I AND O20 STA VTYPE INB CCA SET LOC TO -1 STA 1,I ADB M1 LDA DORDT ORDINAL ALS,ALS ALF IOR VTYPE ISZ DORDT NEXT ORDINAL JMP EDVL,I * SKP ****************************** *SEARCH INTRINIC FUNCTION LIST *ENTER A=LOC ALPHA *EXIT A=BETA FORMAT * B=LOC ****************************** * SIFUN NOP STA COMCT TEMP LOC ALPHA LDB FNLIS LDA COMCT,I AND .MU1 UPPER 8 BITS STA WXXXS SAVE 1ST CHAR,0 LDA 1,I AND .MU1 177400 CPA WXXXS FIRST CHAR SAME ? JMP SIFNF FIRST CHAR+LENGTH ARE ALIKE SIFNI ADB O3 NEXT ENTRY=END? CPB FWAPT CLA,RSS YES JMP *-7 JMP SIFUN,I EXIT NOT FOUND * SIFNF LDA 1,I ALF,ALF ALF AND O7 STA SUBC LDA COMCT,I ALF,ALF ALF AND O17 CPA SUBC SAME NO CHAR RSS JMP SIFNI NOT SAME STB SUBC ARS CMA,INA STA SUBL -NO WDS +1 LDA COMCT NEXT ALFA WORD INA STA OPENN INB NEXT IFUN LDA 1,I NEXT NAME CPA OPENN,I JMP *+3 STILL ALIKE LDB SUBC NOT THIS ONE JMP SIFNI NEXT IFUN ENTRY ISZ OPENN NEXT ALPHA ISZ SUBL END JMP *-8 NO LDB FNLIS FOUND CMB,INB ADB SUBC ORDINAL BLS PACK V LDA SUBC,I AND P200 SZA INB BLS LDA SUBC,I AND O10 SZA INB LDA 1 ALF IOR O12 A= BETA ENTRY LDB SUBC B= LOC IN IFUN JMP SIFUN,I EXIT SKP * * ****************************** * ENTRY POINT FOR ASF STATEMENT * *******************}*********** * MASF1 NOP CLA,INA STA ERCNT SET ERCNT=+1 CCA STA ASFLG SET ASFLG=-1 JMP MSF1A * M3SF JSB M3SFR FORMAT MSF1 LDA LDVL STA FWA INITIALIZE FWA FOR SCANNER JSB LNK22,I CALL SCANNER TO READ STMT (SCAN) MSF1A JSB MOVA.,I MOVE ALPHA STRING LDA STYPE CPA O23 IS THIS AN ARITH. REPLACEMENT? JMP MSF3 YES,JUMP CPA O11 IS THIS A FORMAT? JMP M3SF YES,JUMP CLA NO,CLEAR A M2SF STA MSP1A STORE A TEMPORARILY LDA ERCNT LOAD ERASABLE COUNT STA AESIZ STORE IN ERASABLE SIZE CLA STA ASFLG CLEAR ASFLG INA STA ERCNT STORE 1 IN ERASABLE COUNT LDA MSP1A LOAD ERROR INDICATOR JMP MASF1,I RETURN TO CALLING PROGRAM * M3SFR NOP LDA CONAD SZA LABELLED? JMP M3SFE NO, ERROR. LDA LABEL JSB SDVLL CHECK THAT THE LABEL IS NOT IN CPA M1 DVLIST. JMP M4SF NOT IN, JUMP M3SFE CLA,INA ERROR, LOAD ERROR INDICATOR JSB ERRR CALL DIAGNOSTICS JMP M3SFR,I * M4SF LDA LABEL JSB EDVLL ENTER FORMAT LABEL INTO DVLIST LDA LOCNT RELATIVE LOCATION ENTRY POINT & STA 1,I STORE LOCATION COUNTER THERE LDB LWA LDA O31 LOAD A WITH ASCII INDICATOR JSB MPUT1,I CALL PUTAWAY 1 JMP M3SFR,I * MSF3 LDA FWA ARITH. REPLACEMENT STA MSP1A JSB LNK34,I SEARCH DECLARED VARIABLE LIST (SDVL) CPA M1 IS THIS THE 1ST WORD IN THE TABLE? RSS NO, CONTINUE JMP MSF5 YES, TERMINATE ASF LDA MSP1A JSB NELM COMPUTE LOCATION OF NEXT ELEMENT STA MSP1A LDA 0,I OBTAIN NEXT ELEMENT CPA W.LP IS THIS A ( CLB,RSS YES, INITIALIZE PARAMETER COUNTER JMP M2SF-1 NO, TERMINATE ASF STB MSP2A MSF4 ISZ RMSP1A INCREMENT ELEMENT ADDRESS LDA MSP1A,I OBTAIN ELEMENT AND O17 ISOLATE TYPE BITS CPA O4 IS THIS AN ALPHANUMERIC? JMP *+4 YES,CONTINUE M1ERR LDA O4 LOAD ERROR INDICATOR JSB ERRR JMP MSF1 ISZ MSP2A INCREMENT PARAMETER COUNTER LDA MSP1A JSB NELM COMPUTE LOCATION OF NEXT ELEMENT STA MSP1A LDA 0,I CPA W.CMA IS THIS A , JMP MSF4 YES,OBTAIN NEXT ELEMENT CPA W.RP IS THIS A ) RSS YES,CONTINUE JMP M1ERR NO, GO TO ERROR ROUTINE ISZ MSP1A INCREMENT ELEMENT ADDRESS LDA MSP1A,I OBTAIN ELEMENT CPA W.EQ IS THIS AN = RSS YES,CONTINUE JMP M1ERR NO ,GO TO ERROR ROUTINE JSB LNK24,I CALL PROCESS ALPHA (PRA) JMP MSF1 ERROR RETURN LDA MSP2A LOAD NO OF PARAMETERS STA MSP1A STORE TEMPORARILY CMA FORM -(NO. OF PARAMETERS+1) STA SFPAD STORE IN SFPAD LDB FWA,I LOAD ASF NAME JSB LOKUP FIND LOCATION OF ENTRY IN DVL LDB 0,I A=FWA+2, LOAD REL. ADDRESS CPB M1 HAS THIS ASF BEEN DEFINED JMP *+3 PREVIOUSLY. NO, JUMP MSF6 LDA O20 YES, LOAD MULTIPLY DEFINED JMP M1ERR+1 LDB LOCNT STORE (LOCATION COUNT + NO.OF ADB MSP1A PARAMETERS) IN REL. ADDRESS STB 0,I LOCATION OF ASF ENTRY STA MSP2A STORE ADDRESS OF ASF ENTRY LDB MSP1A LOAD B WITH NO. OF PARAMETERS LDA O32 LOAD A WITH BSS INDICATOR JSB MPUT1,I CALL PUTAWAY 1 CLB CLEAR B LDA O25 LOAD A WITH OCT VALUE INDICATOR JSB MPUT1,I CALL PUTAWAY 1 LDB O13 LOAD B WITH .ENTR OPERAND LDA O7 LOAD A WITH JSB INDICATOR JSB MPUT1,I CALL PUTAWAY 1 LDB MSP1A LOAD N= NO.OF PARAMETERS ADB O2 ADD 2 CMB,INB OFORM -(N+2) LDA O34 LOAD A WITH DEF+* INDICATOR JSB MPUT1,I CALL PUTAWAY 1 LDA FWA ADA O2 SET A = FWA+2 LDB LWA SET B = LWA JSB LNK25,I CALL PROCESS BETA (WPRB) LDB MSP2A,I LOAD REL.ADDRESS OF ASF CMB,INB LDA O15 LOAD A WITH JMP,I INDICATOR JSB MPUT1,I CALL PUTAWAY 1 JMP MSF1 READ NEXT STATEMENT * MSF5 LDA 1,I AND O300 CPA O100 ASF? JMP MSF6 YES, DUPLICATE NAMES. JMP M2SF-1 NO, CONTINUE. * MSP1A OCT 0 MSP2A OCT 0 * SKP ************************************************************************ * ASCN ***** CONVERT ASCII TO BINARY * CALLING SEQUENCE: * P-2 LDA POSITION OF FIRST CHAR * P-1 LDB (0-7) NUMBER OF CHARACTERS * (8-15) MODE (0=OCT,1=INT,2=FP) * P JSB ASCN * P+: ERROR RETURN * P+2 NORMAL RETURN: VALUE IN A OR A AND B ********************************************************************** *CONSTANTS MO60 OCT -60 PSGN OCT 53 MSGN OCT 55 DPER OCT 56 DEAS OCT 105 KM31 OCT 177741 MO20 OCT -20 CNVT OCT 0 LOCC OCT 0 ALTC OCT 0 ERRX OCT 0 DCNT OCT 0 VALU OCT 0 VAL1 OCT 0 SMAN OCT 0 DECE OCT 0 BSS 4 * DGTC NOP ISZ ALTC JMP *+5 LDA LOCC,I ALF,ALF AND O377 JMP DGTC,I CCA STA ALTC LDA LOCC,I ISZ LOCC JMP *-6 * KOVP OCT 77600 MP10 OCT 50000 MM10 OCT 63146 OCT 63146 VAL0 OCT 0 MANT OCT 0 OCT 0 DSIG BSS 1 CFRA BSS 1 * ASCQ NOP STB CNVT CCB SSA,RSS JMP *+3 CLB CMA,INA STB ALTC LEFT-RIGHT FLAG STA LOCC SAVE POINTER LDA ASCQ STA ERRX SET UP ERROR EXIT ISZ ASCQ SET FOR SKIP RETURN LDA CNVT AND O377 CMA,INA STA DCNT -NO. CHARS TO READ CCA ,STA DSIG SET SIGN FLAG OFF LDA CNVT ALF,ALF AND O377 STA CNVT CONVERSION MODE SZA JMP DECI STA VALU OCTAL MODE. INITIALIZE VALUE DOC1 JSB DGTC CPA O40 BLANK? JMP DOCE YES LDB M8 JSB DDOS JMP DILC LDB VALU SHIFT VALUE LEFT 3 CLE,ELB SEZ JMP DILC ERROR ON OVERFLOW ELB SEZ JMP DILC ELB SEZ JMP DILC ADA 1 ADD NEW DIGIT STA VALU DOCE ISZ DCNT COUNT CHARS READ JMP DOC1 MORE TO GO ISZ DSIG NEGATIVE SIGN? CMA,INA YES. NEGATE NO. JMP ASCQ,I * DILC JMP ERRX,I * DDOS NOP TEST CHARACTER SUBROUTINE STA DECE+1 SAVE CHAR ADA MO60 SSA JMP *+4 NOT A DIGIT ADB 0 SSB JMP DDSX LEGAL DIGIT. LDA DECE+1 GET CHAR CPA PSGN PLUS SIGN? JMP DDSX-1 YES. IGNORE. CPA MSGN MINUS SIGN? CLA,RSS YES. JMP DDOS,I ILLEGAL OTHERWISE STA DSIG SET SIGN FLAG CLA DDSX ISZ DDOS SKIP RETURN JMP DDOS,I * DECI LDA IBIT INTEGER OR REAL CONVERSION. STA CFRA DECIMAL POINT FLAG OFF CLA STA DECE INITIALIZE EXPONENT (SCALE FACTOR) CCA ADA CNVT SZA JMP DECR REAL. JSB DCIC INTEGER. JMP ASCQ,I * DCIC NOP INTEGER CONVERSION ROUTINE JSB DCNV JMP DILC LDA VAL0 SZA JMP DILC LOSE: NOT SINGLE PRECISION. LDA CFRA SSA,RSS JMP DILC LOSE: CONTAINED DECIMAL POINT. LDA VALU SZA,RSS ZERO RESULT? JMP DCIC,I YES, OK. ISZ DSIG MINUS SIGN SEEN? JMP *+4 YES. SSA NO. VALUE SHOULD BE + JMP DILC JMP DCIC,I CMA,INA SSA JMP DCIC,I XJMP DILC * DCNV NOP CONVERT A NUMBER CLA INITIALIZE DOUBLE PRECISION STA VAL0 PRECISION VALUE STA VALU DDIG JSB DGTC GET A CHARACTER CPA O40 BLANK? JMP DFIN-2 LDB MD10 JSB DDOS CHECK CHARACTER JMP DEC2 STA VAL1 SAVE DIGIT LDA VAL0 DOUBLE PRECISION LDB VALU MULTIPLY BY TEN: CLE,ELB LONG LEFT SHIFT 3, ELA SSA JMP DOV2 ELB ELA SSA JMP DOV2 ELB ELA SSA JMP DOV2 ADB VALU ADD ORIGINAL NUMBER... SEZ CLE,INA ADB VALU TWICE MORE, SEZ CLE,INA ADB VAL1 ADD NEW DIGIT, SEZ CLE,INA ADA VAL0 ADD REST OF ORIGINAL NUMBER... SSA JMP DOV2 ADA VAL0 TWICE MORE. SSA OVERFLOW? JMP DOV2 YES. BUMP EXPONENT STB VALU STA VAL0 STORE NEW NUMBER ISZ CFRA CHARS IN FRACTION ISZ DCNT COUNT CHARS READ JMP DDIG MORE TO GO DFIN ISZ DCNV SKIP RETURN JMP DCNV,I * DEC2 CPA DPER DECIMAL POINT? JMP DEC. YES JMP DCNV,I * DEC. LDA CFRA FIRST DECIMAL POINT? SSA,RSS JMP DILC NO. LOSE. CLA STA CFRA CHARS IN FRACTION: SET TO COUNT JMP DFIN-2 * DOV2 ISZ DECE BUMP EXPONENT ISZ CFRA COUNT CHARS IN FRACTION ISZ DCNT COUNT CHARS READ JMP *+2 MORE TO GO JMP DFIN DONE JSB DGTC GET A CHARACTER CPA O40 BLANK? JMP DOV2 YES. TREAT AS ZERO. LDB MD10 JSB DDOS CHECK FOR LEGAL DIGIT. JMP DEC2 JMP DOV2 OK. THROW IT AWAY. * FLX1 EQU MANT FLX2 EQU MANT+1 FLX3 EQU DSIG FLX4 EQU CNVT FLX5 EQU LOCC FLX6 EQU VAL1 FLX7 EQU VALU TEM1 EQU VAL0 FLEX EQU CFRA * DECX CPA DEAS  E-FORMAT? JMP *+2 JMP DILC NO. LOSE. JSB DSAV SAVE FRACTION ISZ DCNT CCA,RSS JMP DFLT OUT OF CHARS, GO FINISH STA DSIG SIGN FLAG OFF FOR EXPT LDA IBIT STA CFRA SET DECIMAL PT FLAG OFF JSB DCIC GET EXPONENT ADA DECE COMBINE WITH SCALING STA DECE JMP DFLT * DECR JSB DCNV REAL CONVERSION ROUTINE JMP DECX NOT LEGAL FRACTION JSB DSAV DFLT LDA KM31 STA FLEX BINARY EXPONENT (NEGATIVE) LDB MANT LDA MANT+1 SZA IF ZERO FRACTION, JMP *+3 SZB,RSS JMP ASCQ,I RETURN ZERO. DPFL JSB NORM NORMALIZE FRACTION STA FLX1 STB FLX2 LDA DECE EXPONENT SSA JMP DMEX SZA,RSS ZERO? JMP FLOT YES. SCALING COMPLETE. ADA M1 STA DECE LDA M5 SCALE NUMBER ADA FLEX STA FLEX LDA MP10 10.0 CLB JMP DMYH * DMEX INA NEGATIVE EXPONENT STA DECE LDA O2 ADA FLEX STA FLEX LDA MM10 0.1 LDB MM10+1 JMP DMYH * DSAV NOP LDB DSIG LDA VALU STA MANT STB SMAN LDA VAL0 STA MANT+1 LDA CFRA DECIMAL POINT READ? SSA JMP DSAV,I NO, EXIT. CMA,INA YES. ADJUST SCALE FACTOR. ADA DECE STA DECE JMP DSAV,I * * SIGN AND PACK FLOATING POINT FORMAT * FLOT LDA FLX2 3434 AND .MU1 3 0 3 4 LDB 0 3 0 3 0 XOR FLX2 0 4 3 0 ALF,ALF 4 0 3 0 CLE,SSA,RSS ROUND ? JMP NRND NO LDA FLX1 1 2 3 0 ADB O400 CLO SEZ CLE,INA CARRY ROUND TO A SOC RAR STA FLX1 LDA FLEX SOC ADA M1 ADJUST EXPT STA FLEX NRND LDA FLX1 ISZ SMAN SIGN OF MANT CMB,CLE,INB,RSS NEGATE LOW FRACTION JMP *+4 CMA,SEZ COMPLEMENT HIGH. CARRY FROM LOW? INA YES. JSB NORM NORMALIZE FRACTION IN A,B. STA FLX1 SAVE HIGH LDA FLEX IF EXPONENT OVERFLOW, CLO CLE,SSA CMA,INA ADA KOVP SET OVERFLOW FLAG. LDA FLEX CMA,INA GET TRUE EXPONENT SOC JMP DEOV RAL POSITION AND O377 CUT TO SIZE IOR 1 COMBINE WITH LOW FRACTION LDB 0 PUT IN B LDA FLX1 HIGH FRACTION TO A JMP ASCQ,I EXIT * DEOV SSA,RSS JMP DILC CLA UNDERFLOW CLB JMP ASCQ,I SET UNDER FLOW TO TRUE ZERO * DMYH STA FLX5 DOUBLE MULTIPLY(FLX1/2)*(FLX5/6) STB FLX6 LDA 1 LDB FLX2 JSB .MPYA STA FLX3 LOW PRODUCT STB FLX4 LDA FLX5 LDB FLX2 JSB .MPYA FIRST CROSS-PRODUCT ADB FLX3 COMBINE STB FLX3 SEZ CLE,INA STA FLX7 LDA FLX6 LDB FLX1 JSB .MPYA SECOND CROSS-PRODUCT ADB FLX3 STB FLX3 COMBINE CLB,SEZ CLE,INA SEZ CLE,INB ADA FLX7 SEZ CLE,INB PROPAGATE CARRY STA FLX2 STB FLX7 LDA FLX5 LDB FLX1 JSB .MPYA HIGH PRODUCT ADB FLX2 COMBINE SEZ CLE,INA ADA FLX7 JMP DPFL * .MPYA NOP STA TEM1 LDA MO20 STA DCNT MULTIPLY 16BIT A * 16 BIT B CLA MULT CLE,SLB ADA TEM1 ERA ERB,CLE ISZ DCNT JMP MULT JMP .MPYA,I * NORM NOP DNOR RAL 14 TO SIGN, 15 TO LSB CLE,SLA CME - VALUE SSA CME MSB=1 RAR RESTORE SEZ NORMALIZED? JMP NORM,I YES, EXIT ELB LONG LEFT SHIFT ELA q640 ISZ FLEX ADJUST EXPONENT NOP JMP DNOR * DOAD BSS 50 DO-TABLE DOEN BSS 1 LWA+1 OF DO-TABLE SKP * * * ********************** * LABEL CHECK SUBROUTINE * ********************** * MLBCK NOP STB MTLDO STORE B, ADDRESS OF THE LABEL JSB WFCS EVALUATE LABEL SZA ERROR IF ZERO SSA ERROR ALSO IF NEGATIVE JMP MLBCE GO TO ERROR. ADA MLBLM ADD -10,000 TO VALUE SSA,RSS SKIP IF RESULT NEGATIVE, I.E. JMP MLBCE LABEL LESS THAN 10,000 LDB MTLDO RESTORE LABEL ADDRESS IN B ISZ MLBCK INCREMENT RETURN LOCATION JMP MLBCK,I RETURN TO CALLING PROGRAM * MLBCE CLA,INA LOAD ERROR INDICATOR JSB ERRR GO TO DIAGNOSTICS JMP MLBCK,I RETURN TO CALLING PROGRAM AT * ERROR LOCATION SKP IWHCH OCT 1 IWRDS NOP * * * THE CODE AT START BEGINS COMPILATION BY * PROCESSING THE CONTROL STATEMENT * START EQU * CCA STA CONAD INITIALIZE TO -1 STA RSFLG SET EOS FLAG CLA CLEAR OPTIONS STA RF1 SET UPPR/LOWR FLAG FOR RGET STA LABEL STA OPT STA OPT+1 STA OPT+2 STA ERDGT INIT ERR DIGIT TO ZERO LDA LINES INITIALIZE THE STA LCOUT LINES PER PAGE COUNTER JSB LIMEM GET DEF LIM1 MEMORY m 6 DEF IWHCH LIMITS DEF FDVL 1ST WORD AVAILABLE DEF IWRDS # OF WORDS AVAILABLE LIM1 EQU * LDA IWRDS ANY MEMORY SZA,RSS AVAILABLE? JMP SYMEX NO.GO TERMINATE FTN CMA,INA YES.GREATER ADA O10 THAN 7 WORDS SSA AVAILABLE? JMP LIM2 YES.OK.GO ON SYMEX EQU * JSB IMESS NO.WRITE "SYM DEF *+4 TABLE OVFL" DEF O2 ON THE DEF SMSG SESSION DEF O7 CONSOLE JMP TERM GO TERMINATE FTN LIM2 EQU * CCA FORM ADA FDVL LWAM ADA IWRDS VALUE STA TCLIS SAVE IT IN COMMON JSB SREAD,I READ CONTROL STATEMENT LDA RGC CHAR COUNT CMA STA RGCC LDA RL1 GET 1 NON-BLANK CHAR STA RBL JSB WRGET,I GET CHAR CPA RFS F JMP YESF DFTNE LDA O4 ERROR-CODE= 4 CLB STB CONAD JSB ERRR JSB .STOP ABORT * YESF JSB WRGET,I GET 2ND CHAR CPA RTS T RSS JMP DFTNE JSB WRGET,I GET CHAR CPA RNS N RSS JMP DFTNE DFTN0 JSB WRGET,I OPTIONS SSA END JMP DEXIT,I YES CPA ROPTF+4 , RSS YES JMP DFTNE JSB WRGET,I GET CHAR SSA JMP DFTNE IS ERROR LDB 0 BLF,BLF GET OPTION ADB M72 SSB,RSS LEGAL DIGIT? JMP FTNOP NO, CHECK IF LETTER ADB O12 SSB LEGAL DIGIT? JMP FTNOP NO, CHECK IF LETTER STB ERDGT YES, SAVE ERR DIGIT JMP DFTN0 CONTINUE SCAN * FTNOP CPA ...A STA OPT+1 ASSEMBLY OPTION CPA ...L STA OPT LIST OPTION CPA ...T STA OPT+1 TABLE OPTION CPA ...A ALSO SAVE ASSEMBLY OPTION STA OPT4 IN COMMON IF THERE FOR PASS 2 C LDA ...B FORCE BINARY STA OPT+2 OUTPUT OPTION JMP DFTN0 * SREAD DEF READ WRGET DEF RGET ...A OCT 40400 ASCII A I LEFT HALF ...B OCT 41000 ASCII B IN LEFT HALF ...L OCT 46000 ASCII L IN LEFT HALF DEXIT DEF FTN11 FWA OF CONTROL ROUTINE M72 OCT -72 ERFL DEF ERFLG ERDGT OCT 0 DPUTW DEF PUTW .RNAM ASC 2,ERR0 SMSG ASC 7,SYM TABLE OVFL SKP * ERSUB NOP LDA ERFL,I SZA,RSS GEN. CALL TO ERROR ROUTINE? JMP ERSUB,I NO LDA O7 CODE=7 FOR JSB EXT LDB .RNAM ERR ROUTINE NAME JSB DPUTW,I OUTPUT 2 WORDS LDA ERDGT GET ERR DIGIT ADA .RNAM+1 ADD TO NAME JSB LNK27,I OUTPUT 2ND WORD OF NAME CLA JSB LNK27,I OUTPUT 0 FOR 3RD WORD JMP ERSUB,I RETURN * WPRB NOP JSB WSSEV EVALUATE SUBSCRIPTS JMP WSQZ SQUEEZE 0-S AND EVALUATE EXPR. SKP * *WSSEV IS THE SS-EVALUATOR. ENTER WITH A=FWA OF BETA, *B=LWA+1. IT SETS THE RESULTANT FORMAT IN FWA OF EACH *ARRAY ELEM.REF AND ZEROS OUT THE REF. * WSSEV NOP STA WFWA SET FWA OF BETA * START OUT TO PROCESS ALL SUBSCR PTS IN BETA STB WLWA SET LWA OF BETA STA WPNT SET ADDRESS POINTER AT FWA CLA STA MODE SET INTEGER-MODE IN PUTAWAY WSLP LDA WPNT CPA WLWA ARE WE AT END OF BETA? JMP WSSEV,I YES,SUBSCRIPT PROC. IS READY LDA WPNT,I NO, CONTINUE SEARCHING FOR NEXT SS ISZ WPNT BUMP POINTER AND O77 CPA O22 IS ENTRY A C FOR VAR.SS, TYPE=22B RSS YES JMP WSLP1 NO,CHECK FOR CONST SS LDB WPNT ADB M1 RESET TO ( LDA 1,I ALF,ALF AND O17 MASK NO. LOCS IN SUBSCR ADA WPNT ADA M1 -1 TO ADDR. OF SUBSCR VAR FORMAT STA WLW1 SET SUB-LWA (POINTS AT ) ) * *NO OF LOCS IN SUBSCR. INCLUDES ),EXCLUDES ( *THE SUBSCRIPT IS NOW PROCESSED. CODE _IS GENERATED BY *CALLS TO PUTAWAY. THE VALUE OF THE SUBSCRIPT IS STOR *ED IN ERASABLE STORAGE, THE SUBSCRIPT STRING IN BETA *IS ZEROD OUT,(ERAS,I)-FORMAT IS INSERTED IN THIS *AREA. * ADB M1 -1 STB WPN1 RESET POINTER, POINTS AT ARRAY NAME LDB WPNT WSL1 LDA 1,I CPA W.CMA CHECK FOR COMMA JMP W2SS COMMA IN RANGE: TWO SUBSCRIPT EXP INB BUMP LC POINTER IN SUBSCRIPT CPB WLW1 JMP W1SS NO COMMA FOUND: ONE SUBSCR. EXPR. JMP WSL1 CONTINUE LOOKING FOR COMMA * WSLP1 CPA O42 RSS CONST SUBSCR. JMP WSLP CONTINUE SEARCH LDB WPNT ADB M2 LDA 1,I JSB SCATR CRACK SYMBTAB ENTRY LDA PARAM SZA FORMAL PARAM ? JMP *+3 YES, GENERATE ADDR. ARITH ISZ WPNT NO, SKIP CONSTANT SUBSCRIPT JMP WSLP NO, CONTINUE SEARCH ** *IF ARRAY ELEM REF WITH CONST. SUBSCR. IS A FORMAL *PARM, ADDR. ARITHMETIC IS DONE AT RUN TIME CLA LDB WPNT,I ADB M1 -1 JSB LNK31,I GENERATE LDA CONST ADDEND LDA WPNT ADA M2 STA WPN1 POINT AT ARRAY NAME FOR WSDUP ADA O3 STA WLW1 POINT AT ) FOR WSDUP LDA WPN1,I XOR O40 STA WPN1,I REMOVE C-BIT FROM TYPE-6 FORMAT AND O20 STA WETYP SET TYPE JMP W1SB1 DO ADA ARR NAME AND SRCH DUPL.SS. * *W1SS PROCESSDS SINGLY SUBSCRIPTED VARIABLES * W1SS LDA WPNT ADDR. OF (+1 LDB WLW1 ADDR.OF ) JSB WES1 EVALUATE SUBSCRIPT EXPRESSION W1SB LDA WPN1,I ARRAY VAR. FORMAT AND O20 MASK OUT TYPE-BIT STA WETYP SET TYPE OF ERAS. FORMAT SZA,RSS JMP *+3 INTEGER, SUBSCR. OK LDA O30 REAL, MPY SUBSCR. BY 2 JSB LNK31,I DO ALS (PUTA) W1SB1 LDA WPN1,I SUBSCR.VAR.FORMAT AND WM21B 177757B, SET TYPE=0 FOR ADD ADDR LDB 0 OPE LDA O3 OP=3 FOR ADD JSB LNK31,I GENERATE ADA L(ARRAY) JSB WSTE GENERATE: STORE ERAS ADA WETYP ADD IN TYPE OF ERAS. OPERAND ADA O40 SET I-BIT FOR INDIR. REF. STA WSV1 SAVE ERASABLE FORMAT JSB WSDUP CHECK FOR DUPLICATE SS JMP WSLP-3 SKP * *SEARCH FOR DUPLICATE ARRAY ELEMENT REFS IN REMAINDER *OF BETA. RETURN WITH A= POINTER IN BETA OF ) IN CURR *SS. ENTER WITH: * WPN1= ADDR OF ARRAY NAME * WLW1= ADDR OF ) IN SS * WSV1= ERAS. FORMAT OF RESULT. SS * WSDUP NOP LDA WLW1 START AT LWA+1 OF FIRST REF STA WPN2 W1S1 ISZ WPN2 BUMP POINTER IN BETA LDB WPN2 CPB WLWA JMP W1S4 READY,NO MORE SAME REFS. LDA 1,I CPA WPN1,I SAME ARRAY NAMES ? RSS JMP W1S1 NO LDA WPN2 YES,COMPARE SUBSCRIPTS STA WPN4 LDA WPN1 STA WPN3 W1S2 LDA WPN3,I COMPARE SUBSCRIPTS CPA WPN4,I RSS SAME ELEM JMP W1S1 DIFFERENT,LOOK FURTHER IN BETA LDA WPN3 CPA WLW1 END OF SUBSCRIPT? JMP W1S3 YES,EQUAL SUBSCRIPTS ISZ WPN3 ISZ WPN4 JMP W1S2 * W1S3 LDA WPN2 ADDR.OF ( IN SUBSCRIPT =1ST WORD INA LDB WPN4 TO BE ZEROD OUT; B=LWA OF AREA STB WPN2 TO BE ZEROD JSB WZER JMP W1S1 SKP * *WZER MOVES WSV1 TO(ADDR.IN A)-1,AND ZEROS OUT FROM *ADDR.IN A THROUGH ADDR. IN B * WZER NOP STB WSV3 ADA M1 -1 LDB WSV1 STB 0,I SET ERASABLE FORMAT CLB WZE1 INA STB 0,I ZERO OUT CPA WSV3 JMP WZER,I READY JMP WZE1 * W1S4 LDA WPN1 SET ERAS.FORMAT FOR CURRENT SUB- INA SCRIPT AND LDB WLW1 ZERO OUT REMAINDER LOCS JSB WZER IN SUBSCRIPT LDA WLW1 SET POINTER IN BETA TO ( OF C?UR- JMP WSDUP,I RENT SUBSCR. AND RETURN SKP * *WES1 EVALUATES A SUBSCRIPT EXPRESSION. ENTER WITH A= *AD.1ST ELEMENT IN SUBSCR.EXP.,B=ADDR.OF ) OR , *WHICH FOLLOWS THE SUBSCR. EXP.; IT RETURNS O IN B-REG *IF COMPUTATION GENERATED,OR CONSTANT - FORMAT,IF *SUBSCR.CONSISTS ONLY OF CONSTANT , IN B-REG. * WES1 NOP STB WSV3 SAVE B STA 1 LDA 1,I FIRST ELEM. STA WSV4 SAVE OPERAND AND O17 17B CPA O3 CHECK FOR CONSTANT JMP WES4 YES, NEXT EITHER * OR END SUBSC. STB WSVX7 SAVE B LDB WSV4 NO, OPER. IN B CLA,INA OP=1 JSB LNK31,I DO LOAD OPERAND (PUTA) LDA WSVX7 WES5 INA CLB CPA WSV3 JMP WES3-5 END OF SUBS EXPR? STA 1 NOT END,ONLY + OR - CONST NEXT LDA 1,I STA WSVX7 SAVE OP INB JSB WFCS FETCH CONST. STA 1 CONST TO B LDA WSVX7 CPA W.PLS COMPARE OPER. AGAINST + RSS YES, + CMB,INB - LDA WES1 CPA DW1SB 1 SUBSCR? -1 IF SO ADB M1 -1 SZB,RSS JMP WES1,I DO NOT ADD 0, EXIT WES3 LDA O26 OP=26 FOR ADA VALUE JSB LNK31,I DO ADA CONST JMP WES1,I * DW1SB DEF W1SB * WES4 LDA 1 LDB WSV4 CONST. FORMAT ADA O2 POINTER TO VAR OR , STA WSV4 SAVE POINTER CLA,INA JSB LNK31,I LDA O13 OP=13B FOR MPY LDB WSV4,I JSB LNK31,I DO MPY VAR. LDA WSV4 JMP WES5 * *W2SS PROCESSES DOUBLE SUBSCRIPT EXPRESSIONS. *THE CODE GENERATD IS A CALL TO MAP LIB ROUTINE: * JSB *+1,I * DEF MAP * DEF ARRAY NAME * DEF SA1 (CONTAINS VALUE SS1) * DEF SA2 (CONTAINS VALUE SS2) * OCT D1 (SIZE OF 1ST DIMENS., * 2S-COMPLEM.IF A INT.) * STA ERAS * W2SS STB WSV5 SAVE LOC OF , LDA WPNT INA CPA WSV5 ONE ELEM. IN SUBSCRIPT? JMP W2S5 YES,ELEM.IS PARAM TO MAP LDA WPNT NO,EVALUATE EXPR. LDB WSV5 JSB WES1 EVALUATE SUBSCR.EXP.1 JSB WSTE GENERATE: STORE ERAS. W2S2 STA WSV6 SAVE ERAS. FORMAT FOR SS1 ISZ WSV5 LDA WSV5 BUMP POINTER BEYOND , INA CPA WLW1 ONE ELEM. IN 2ND SS-EXPR.? JMP W2S6 YES LDA WSV5 LDB WLW1 JSB WES1 EVALUATE SS-EXPR.2 JSB WSTE GENERATE: STORE ERAS. W2S3 STA WSV7 SAVE ERAS.FORMAT FOR SS2 LDB WMAPF FORMAT FOR .MAP. FUNCTION LDA O7 OP=7 FOR CALL JSB LNK31,I GENERATE: CALL MAP LDB WPN1,I ARRAY NAME FORMAT ADB M1 -1 TO FORCE INDIRECT IF FOR. PAR. LDA O10 OP=10 FOR DEF JSB LNK31,I DEF ARRAY NAME LDB WSV6 ERAS. FORMAT FOR SS1 LDA O10 JSB LNK31,I DEF SS1 LDB WSV7 ERAS. FORMAT FOR SS2 LDA O10 JSB LNK31,I DEF SS2 LDA WPN1,I FORMAT OF SUBSCRIPTED VAR. JSB SCATR LDB DIM1 FIRST DIMENSION LDA WPN1,I AND O20 STA WETYP SET TYPE FOR ERAS. FORMAT SZA,RSS CMB,INB COMPLEM. IF INT. ARRAY LDA O25 OP=25 FOR OCT VALUE JMP W1SB1+4 GO ON AS FOR ONE SS * W2S5 LDA WPNT,I NO, ELEM.IN SS1 IS PARM.TO MAP JMP W2S2 * W2S6 LDA WSV5,I ELEM. IN SS2 IS PARM TO MAP JMP W2S3 * *WSQZ SQUEEZES ZEROS BEFORE GENERATING ARITH CODE * WSQZ LDA WFWA POINTER OF OLD STRING IN A STA WPN1 PNTR FOR NEW STRING STA WRPL ORIG FWA_ADDR. OF REPLACEMENT VAR WSQ1 LDB 0,I ELEM.IN OLD STRING SZB ZERO? JMP WSQ2 NO, MOVE WSQ3 INA YES,BUMP OLD COUNT CPA WLWA END OF OLD STRINT?  JMP WSQ4 YES,READY JMP WSQ1 NO,NEXT ELEM. * WSQ2 LDB 0,I MOVE ELEMENT STB WPN1,I ISZ WPN1 BUMP NEW COUNT JMP WSQ3 * WSQ4 LDA WPN1 STA WLWA SET NEW LWA+1 LDA WFWA INA WSE4 LDB 0,I CPB W.EQ = ? JMP WSE3 YES CPB W.LPC NO, ( FOR CONST SS? RSS YES JMP WSE2-2 NO,NO REPLACEMENT OR ERROR ADA O3 JMP WSE4 * WSE3 INA STA WFWA BUMP FWA TO LOC FOLLOWING = JMP WSE2 * CCB STB WRPL SET REPLACEMENT VAR., -1 IF NONE * *CHECK REST OF STRING FOR = ,ERROR IF SO * WSE2 INA CPA WLWA JMP WINI READY LDB 0,I CPB W.EQ = ? JMP WERP YES,ERROR JMP WSE2 NO,CONTINUE SEARCH SKP * *GOPN MOVES BETA-POINTER FOWARD BEYOND (+-(FN(+- *ETC. UNTIL THE FIRST OPERAND,OR UNTIL THE END OF *BETA,ERROR IN THIS CASE. IT ALSO CHECKS FOR ILLEGAL *COMBINATIONS OF OPERATORS/DELIMITERS,E.G.,) *) (* *() )( ETC. *IT SETS ( FOLLOWING A FUNCTION NAME TO CI=22B, *SETS WOPG TO (BIN)+OR-,OR TO 1ST OPND.-FORMAT * IT SETS MODE IN PUTAWAY:0=I,NE.0=R. *IT SETS WPNT AT 1ST OPND.,WPN3 AT UNARY+ OR - * GOPN NOP LDA WPNT,I CPA O17 END OF BETA? JMP WERP YES, ERROR LDB WPNT STB WPN3 SET LEFT POINTER CPA W.MIN - ? JMP GON1 YES CPA W.PLS + ? JMP GON1 YES GON2 AND O17 CPA O1 OTHER OP? JMP WERP YES, ERROR CPA O2 DELIM? JMP GON3 YES, CHECK FOR (. ERROR IF NOT ADA M9 SSA,RSS FUNCTION? JMP GON4 YES, CHANGE ( TO CI=22B, AND CONT. LDA WPNT,I NO, MUST BE OPERAND, EXIT AND O20 JMP GOPN,I * GON1 ISZ WPNT BUMP BETA-POINTER LDA WPNT,I FETCH NEXT ELEM JMP GON2 * GON3 LDA WPNT,I CPA W.LP ( ? JMP GON5  YES, OK, CONTINUE JMP WERP NO, ERROR SKP * GON4 ISZ WPNT BUMP POINTER LDA W.LPV LEFT PAREN OF TYPE CI=22B STA WPNT,I REPLACE ( ISZ WPNT LDA WPNT,I CPA W.RP ()-CASE? RSS YES JMP GOPN+1 NO,CONTINUE LDA WPNT GENERATE CALL ADA M2 OF SUBR. WITHOUT LDB 0,I PARAMETERS LDA O7 JSB LNK31,I GENERATE CALL LDA O34 OP = DEF CLB,INB JSB LNK31,I GENERATE DEF *+1 JMP WPRB,I EXIT PROCESS BETA * GON5 ISZ WPNT BUMP POINTER JMP GOPN+1 CONTINUE SKP * *WFNE FETCHES THE NEXT OPERATOR FROM BETA,POINTER IS *IN WPNT.IT TESTS FOR END OF LIST,JUMPS TO FINISH *ARITH PROCESSING,IF SO.EXIT WITH A=CURRENT ELEM., *B=PREVS.ELEM. IT BUMPS WPNT TO OPND. * WFNE NOP LDB WPNT STB WPNP0 POINTER TO PREVS.OPND LDB WPNT,I ISZ WPNT BUMP POINTER LDA WPNT STA WPNP1 SET POINTER TO OP. LDA WPNT,I CPA O17 END OF BETA? JMP WFNE1 YES,FINISH UP BETA PROCESSING ISZ WPNT BUMP POINTER TO OPND CPA W.LPC ( OF CONST SUBSCR? RSS YES JMP WFNE,I NO,RETURN ISZ WPNT BUMP POINTER LDA W.RPC ) FOR CONST. SUBSCR. STA WPNT,I REPLACES ) JMP WFNE+4 * WFNE1 JSB WTSAR GENERATE PRVS,OP IF ANY JMP WRAP WRAP UP SKP * *WTSAR CHECKS IF ANY CODE HAS TO BE GENERATED FOR AN *OP IN BETA PRECEDING A , ) OR END. *FIRST CONDITION: ACCUMULATOR NON-EMPTY. ADDITIONAL *CONDITION IS THAT WPNP0,I NE.0,I.E.NO MULTIPLE )-S *PRECEDE. IF TRUE, CODE IS GENERATED * WTSAR NOP JSB WTSAC ACCUM EMPTY ? RSS JMP WTSAR,I YES,EXIT LDA WPNP0,I SZA,RSS PRECEDING OPND ? JMP WTSAR,I NO,EXIT LDA WOPF PRIOR.=CURRENT PRIOR JSB WGAR GENERATE OP JMP WTSAR,I EXIT SKP * *WTSAC CHECKS ACCUMULATOR. IF EMPTY,EXIT AT CALLING *ADDR.+2 WITH ACCUM-FLAG(WAFG) SET AT EMPTY ACCUM. *OTHERWISE, NORMAL EXIT. IT DESTROYS CONTENTS OF A. * WTSAC NOP ISZ WAFG ACCUM EMPTY ? JMP WTSAC,I NO,EXIT CCA YES,RESET WAFG STA WAFG ISZ WTSAC BUMP EXIT JMP WTSAC,I EXIT AT CALLING ADDR+2 *INITIALIZE ARITH PROCESSOR WINI LDA WFWA STA WPNT WARI JSB GOPN PROCESS SUBEXPRESSION STA MODE SET MODE IN PUTAWAY CCA STA WIFG SET 1ST-OP FLAG TO -1 STA WAFG SET ACCUM.FLAG TO -1 LDB WPMPR STB WOPF SET OP-LEVEL +OR- LDA WPNT STA WPN4 SET POINTER AT OPND WARZ JSB WFNE FETCH NEXT OP. OR DELIM. CPA W.LP ( ? JMP WERP YES, ERROR: C( OR V( CPA W.RP ) ? JMP WRPP YES, END OF SUBEXPR. CPA W.CMA , ? JMP WECM YES AND O17 17B CPA O1 OP? RSS YES,OK JMP WERP NO,ERROR (FOR )V-CASE) LDA WPNP1,I RESTORE OP AND WOPM MASK PRIORITY STA WCPR SAVE CURRENT PRIORITY CPA WOPF SAME PRIORITY ? JMP WSPR YES CMA,INA NO, TEST HIGH-LOW. ADA WOPF LDB WCPR LOAD NEW PRIORITY SSA,RSS JMP WHIL HIGH-LOW OP SEQ STB WOPF SET NEW PRIORITY JSB WTSAC TEST ACCUM RSS NON EMPTY JMP *+3 EMPTY JSB WSTE GENERATE STORE ERAS STA WPN4,I SET ERAS IN BETA LDA WPNP0 POINTER TO L.OPND STA WPN3 MOVE LEFT POINTER UP STA WPN4 JMP WART CONTINUE L. TO R. SKP * *WGLE PERFORMS A R.TO L. SCAN LOOKING FOR THE 1ST NON *0-ELEM.ENTER WITH A=POINTER IN BETA. IT RETURNS THE *ADDR. IN A. RETURN IS TO CALLING ADDR.+1 IF FWA OF *SUBEXPR.FOUND AT L. NORMAL EXIT AT CALL. ADDR.+2 * WGLE NOP STA WSVB SAVE ADDR. CPA WFWA FWA ? JMP WGLE2 YES,ALTERNATE RETURN ADA M1 -1 STA WSVB SAVE ADDR LDB 0,I SZB,RSS ELEMENT=0 ? JMP WGLE+2 YES,NEXT ELEM CPB W.RPC ) FOR CONST SS? JMP WGLE1 YES LDA 1 AND O17 17B CPA O2 DELIM? JMP WGLE3 YES,ALTERNATE EXIT=NORMAL EXIT ISZ WGLE NO,EXIT AT RETURN ADDR.+1 WGLE2 LDA WSVB SET A=ADDR JMP WGLE,I EXIT * WGLE1 ADA M3 SET POINTER AT ARRAY NAME ISZ WGLE BUMP EXIT FOR NORMAL RETURN JMP WGLE,I EXIT * WGLE3 ISZ WSVB BUMP ADDR.BACK TO LOC.AFTER , OR ( JMP WGLE2 NORMAL EXIT SKP * WSPR CPA WPMPR + OR - ? RSS YES JMP WARX NO,GENERATE CODE ISZ WIFG FIRST TIME ? JMP WARX NO,GENERATE CODE WART LDA WPNT YES STA WPN2 SAVE CURRENT R. POINTER LDA WPNT,I AND O17 CPA O1 JMP WERP-2 ERROR: OP, OP SEQUENCE. LDA WPN3 STA WSV1 SAVE LEFT POINTER JSB GOPN GET NEXT OPERAND LDB 0 LDA WPNT CPA WPN2 OPERAND IN NEXT LOC ? JMP WARY YES STB SAVEM SAVE MODE ISZ WAFG IS ACCUM EMPTY? RSS NO, DO STORE ERAS. FIRST JMP *+3 YES,NEXT SUBEXPR. JSB WSTE GENERATE: STORE ERAS STA WPN4,I STORE ERAS.FORMAT IN BETA LDA SAVEM NEW MODE JMP WARI+1 CONTINUE * WARX JSB WGAR GENERATE CODE JMP WART NEXT OP * WARY LDA WSV1 STA WPN3 RESET LEFT POINTER JMP WARZ SKP * *WGAR GENERATES CODE. IF THE ACCUM. IS EMPTY CODE IS *GENERATED FOR A TRIAD(INCL. ON.-).WPN3 POINTS TO THE *LEFT MOST ELEM. ENTER WITH PRIORITY OF CURRENT OP. * WGAR NOP CPA .W108 ** ? (PRIORITY = 10B AT B8 ) JMP WPOW YES, DO POWER JSB WTB@ POST DEF *+3 SCRATCH DEF IDCB3 FILE DEF ERRS SSA ERROR OCCUR? JMP FMPER YES.GO REPORT IT JSB IMESS WRITE DEF *+4 "$FTN-END PASS 1" DEF O2 ON SESSION DEF EMSG CONSOLE DEF O10 LDA PNT04 INITIALIZE FMP ERROR STA NAME FILE NAME POINTER JSB SEGLD END OF PASS 1.LOAD DEF *+3 SEGMENT 2 AND EXECUTE PASS DEF SEG2 2,ELSE BRANCH TO ERROR DEF ERRS ROUTINE FMPER IN THE MAIN JMP FMPER * * SEG2 ASC 3,FTN2 PNT02 DEF AS1+1 LINK TO SCRATCH FILE NAME PNT04 DEF *+1 LINK TO BLANK FILE NAME ASC 3, EMSG ASC 8,$FTN-END PASS 1 * * LINKA DEF LINKS-11B,I LINKF DEF LINKS,I WDOFG BSS 1 SAVEF BSS 1 * NESER LDA O2 2-ERROR FOR NON-EX STATEMENT EM- * BEDDED IN EXEC.STATEMENTS JSB ERRR OUTPUT ERROR JMP FTN15+4 GO TO NEXT STATEMENT * DOERR LDA O17 DO-LOOP ERROR CODE=17B JSB ERRR PRINT ERROR JMP FTN15 END DO,AND GO ON * W10G DEC 10000 MIN.VALUE OF INTERAL LABELS SKP * *TABLE OF BASIC EXTERNAL FUNCTIONS******* * FNTB1 ASC 3,. ENTR ASC 3,. MAP. ASC 3,. GOTO ASC 3,. PAUS ASC 3,. STOP ASC 3,. TAPE ASC 3,. DIO. ASC 3,. BIO. ASC 3,. IOI. ASC 3,. IOR. ASC 3,. IAR. ASC 3,. RAR. ASC 3,. DTA. SKP * *INTRINSIC FUNCTION TABLE******* * * THE FOLLOWING BIT MAPPING IS USED FOR INTRINSICS * WORD1: * BITS 8-15=FIRST CHAR OF NAME * BIT 7 =FUNCTION CALLING SEQUENCE * 0 - LOAD,JSB * 1 - JSB,DEF * BITS 4-6=NO. OF CHAR IN NAME * BIT 3 =RESULT TYPE * 0 - INTEGER * 1 - REAL * BIT 2 =ARGUMENT TYPE * 0 - INTEGER * 1 - REAL * BIT 1 =NO. OF PARAMETERS * 0 - ONE PARAM * 1 - TWO PARAMS * BIT 0 =NEED ERR0 SUBROUTINE * 0 - DON'T NEED IT * 1 - NEED JSB ERR0 CALL * * WORD2: CHAR3/CHAR4 * WORD3: CHAR5 --- * UNUSED BITS ARE LEFT AS ZEROES, NOT SPACES * FNTAB OCT 40474 ABS ASC 1,BS OCT 0 OCT 44500 IABS ASC 1,AB OCT 51400 OCT 43130 FLOAT ASC 2,LOAT OCT 44504 IFIX ASC 1,FI OCT 54000 OCT 42475 EXP ASC 1,XP OCT 0 OCT 40515 ALOG ASC 1,LO OCT 43400 OCT 51475 SIN ASC 1,IN OCT 0 OCT 41475 COS ASC 1,OS OCT 0 OCT 52075 TAN ASC 1,AN OCT 0 OCT 52114 TANH ASC 1,AN OCT 44000 OCT 51515 SQRT ASC 1,QR OCT 52000 OCT 40514 ATAN ASC 1,TA OCT 47000 OCT 47060 NOT ASC 1,OT OCT 0 *THE NEXT 4 FUNCTIONS ARE CALL-BY-NAME WITH 2 PARAM OCT 51716 SIGN ASC 1,IG OCT 47000 OCT 44722 ISIGN ASC 2,SIGN OCT 44702 IAND ASC 1,AN OCT 42000 OCT 44662 IOR ASC 1,OR OCT 0 OCT 44500 ISSW,CALL-BY-VALUE,1 PARAM ASC 1,SS OCT 53400 LFNTB BSS 0 SKP * *ADDITIONAL INFO IN LABEL (3) FOR SOME OPS. *MODE HAS TO BE SET EXTERNALLY FOR ARITHMETIC OPS. *OUTPUT IS OF TWO FORMS: INTERNAL REFS AND EXTERNAL *REFS. *PUTAWAY ENTERS CONSTANTS INTO A CONSTANTS-LIST * PUTA NOP STA WPCUR STB WPCUR+1 SAVE CURRENT INPUT LDA 1 AND O20 STA WPTYP SET TYPE OF OPND CLA,INA STA RTYPE 1=PUTAWAY RECORD-TYPE LDA WPCUR ADA *+2 JMP 0,I SELECTIVE JUMP DEF *+1,I * DEF WPLDV LDA VALUE 0 DEF WPLOD LOAD 1 DEF WPCIN LOAD NEG 2 DEF WPART ADD 3 DEF WPCIN-3 SUB 4 DEF WPNEG NEGATE 5 DEF WPSTR \STORE 6 DEF WPCAL CALL 7 DEF WPARM DEF PARAM 10 DEF WPJPI JMP LABEL OR EXIT (,I) 11 WPINF BSS 1 DEF WPCIN MPY 13 DEF WPDIV DIV 14 DEF WPJPR JUMP REL.ADDR. 15 DEF WPMIC SZA 16 DEF WPMIC ENTRY 17 DEF WPMIC SSA 20 DEF WPMIC INA 21 DEF WPMIC CLA 22 DEF WPEND END$ 23 DEF WPEND END 24 DEF WPOCV OCT VALUE 25 DEF WPADV ADA VALUE 26 DEF WPOWR POWER 27 DEF WPMIC ALS 30 DEF WPAC2 ASCII 31 DEF WPBSS BSS 32 WPSV1 BSS 1 DEF WPDST DEF *+N 34 DEF WPLDB LDB 35 DEF WPDLB-3 DEF LABEL 36 DEF WPDLB-3 JMP LABEL 37 DEF WPASC GENERATE DVLIS OR SYMBTAB 40 WDLBL DEF LABL WPBAS OCT 400 PROG BASE OCT 1000 LABELS BASE OCT 1400 LOC VAR BASE OCT 2000 CONST BASE OCT 2400 COMMON BASE WCCMA OCT 3000 PROG ERAS BASE OCT 3400 ASF ERAS BASE * OCT 4000 REAL CONST BASE OCT 4400 FORMAL PARAM BASE * WPLDV CLA,INA PROCESS LDA VALUE ADA WPBAS+3 ISZ CNSIZ BUMP CONSTANTS REF.COUNTER WPOUT JSB PUTW OUTPUT CURRENT OP *PUTW ALSO BUMPS LOCATION COUNTER LDA WPCUR LDB WPCUR+1 MOVE CURRENT OP STA WPREV TO PREVS OP STB WPREV+1 LDA WPINF LOAD A WITH OUTPUT INFO JMP PUTA,I * WPMIC LDA WPCUR PROCESS MICRO OPS ISZ LOCNT BUMP LOC.COUNTER JMP WPEND+1 * WPOCV LDA O12 PROCESS OCT VALUE JMP WPOUT * WPADV LDA O3 PROCESS ADA VALUE JMP WPLDV+1 CONTINUE AS FOR LDA VALUE * WPLOD LDA WPREV CPA O6 PREVIOUS WAS STORE? RSS YES JMP WPART NO,CONTINUE AS OTHER ARITH OPS LDA 1 AND O17 17B CPA O6 SUBSCR VAR? JMP WPSIV+3 YES WPSIV CPB WPREV+1 SAME OPERANDS ? ܑJMP WPOUT+1 YES, SUPPRESS LOAD JMP WPART NO, DO LOAD * LDA SAVCA CONAD IF PREVS WAS SUBSCR VAR CPA LABL+1 SAME CONAD ? JMP WPSIV YES JMP WPART NO, DO LOAD SKP * *WPCMA CHECKS FOR MIXED ARITHMETIC. IT JUMPS TO *WPERA IF SO. OTHERWISE,EXIT * WPCMA NOP LDA WPTYP GET TYPE CPA MODE TYPE= MODE? JMP WPCMA,I YES,OK,EXIT JMP WPERA MIXED MODE ERROR * LDA WPTYP SZA,RSS ISZ LOCNT BUMP FOR SUB (3LOCS TOTAL) WPCIN JSB WPCMA CHECK MIXED MODE,NO RETURN IF ER LDA WPTYP SZA,RSS INTEGER TYPE OF OP ? ISZ LOCNT YES,ALLOW ONE ADDIT.LOC.FOR LOAD * NEG.,SUB,MPY RSS NO,GO ON WPART JSB WPCMA CHECK MIXED MODE,NO RETURN IF ER JSB WPOPN GET OPERAND *WPOPN EVALUATES OPERAND. ENTER WITH BETA-FORMAT IN *B. IT RETURNS PUTAWAY-OUTPUT FORMAT,MINUS OP-CODE, *IN A AND B * WPCKM STB WPSAV SAVE B LDB MODE SZB INT. MODE? JSB WPREL NO, ADD 35B TO GENERATE FLOATING OP LDB WPSAV ADA WPCUR ADD IN OPCODE JMP WPOUT OUTPUT CODE AND EXIT * WPNEG LDA WPCUR GENERATE CMA,INA OR FCM LDB MODE SZB ADA O35 FCM IF REAL JMP WPMIC+1 * WPREL NOP ADA O35 CHANGE TO FLOATING OP ISZ LOCNT ADDIT.BUMP OF LOCATION COUNTER JMP WPREL,I EXIT * *PUTW OUTPUT A AND B (BINARY OUTPUT) * PUTW NOP ISZ LOCNT BUMP LOC. COUNTER STA WPOPN SAVE STB WPSAV JSB LNK27,I (WRITB) LDA WPSAV JSB LNK27,I OUTPUT OPND LDA WPOPN AND MO100 177700 CPA O4000 RSS YES JMP PUTW,I NO,EXIT LDA WPSVC JSB LNK27,I OUTPUT 2ND WORD OF REAL CONST (WRITB) JMP PUTW,I * WPEND LDA WPCUR JSB LNK27,I JMP WPOUT+1 * WPJPR LDA WPCUR ADA WPBAS W<:6PROG. BASE JMP WPOUT * WPLDB JSB WPOPN EVALUATE OPND ADA WPCUR ADD LDB-OP JMP WPOUT * WPARM EQU WPLDB * WPDST ADB LOCNT ADD LOC.COUNTER FOR *+N LDA O10 DEF-OP=10B ADA WPBAS PROG. BASE JMP WPOUT * WPCAL CLA STA ERFLG CLEAR JSB ERR0 FLAG LDA 1 AND O17 17B: MASK OUT OPND TYPE CPA O11 ASF? JMP WPASF YES,INTERNAL JSB CLB STB LABL ZERO OUT NAME AREA STB LABL+1 STB LABL+2 LDB WDLBL DEF LABL STB WPSV1 LDB WPCUR+1 OPERAND CPA O12 INTRINSIC FN? JMP WPINT YES CPA O13 BASIC EXTERNAL FUNCTION? JMP WPBAX YES JSB LOKUP GET SYMBTAB ADDR. ADB 0 LWA+1 OF NAME IN SYMBTAB STB WPSAV INA WPCL1 CPA WPSAV JMP *+5 READY }_< LDB 0,I MOVE STB WPSV1,I FUNCTION NAME ISZ WPSV1 JMP WPCL1-1 CONTINUE MOVE LDA WPCUR LDB LABL 1ST WORD IN NAME JSB PUTW LDA LOCNT ADA M1 STA LOCNT LDA LABL+1 GENERATE LAST 2 WORDS IN LDB LABL+2 EXT NAME OR ZEROS JSB PUTW LDA WPCUR CPA O7 IS IT CALL? JSB ERSB,I YES, GEN.JSB ERR0 IF NEEDED JMP WPOUT+1 RETURN * WPASF JSB WPOPN EVALUATE OPND ADA O27 JSB PROG LOC =27B FOR ASF REF JMP WPOUT OUTPUT OF ,ETC. * WPBAX JSB WPFAD GET ORDINAL OF BASIC EXT.FUNCTN ADA FNLS1 BASE OF BASIC EXT.TABLE,FNTB1 JMP WPIN1 CONTINUE AS INTRINSIC FUNCTION * WPINT JSB WPFAD LDB WCCMA OCTAL FOR CMA CPA O44 INTRINSIC FUNCTION = NOT? JMP WPOCV YES,GENERATE CMA ADA FNLIS BASE ADDR. OF INTRINSIC FUNLIST LDB 0,I GET INTRINSIC TABLE CODE SLB NEED JSB ERR0? ISZ ERFLG YES, SET FLAG WPIN1 STA WPSAV SAVE LDA 0,I AND .MU1 MASK FOR UPPER 8 BITS=1ST CHAR STA LABL STORE 1ST CHAR,0 ISZ WPSV1 BUMP POINTER ISZ WPSAV BUMP TO NEXT LOC IN FUNLIST LDA WPSAV ISZ WPSAV ISZ WPSAV JMP WPCL1 CONTINUE AS WITH IMPLIED FUNCS * WPJPI SZB,RSS OPERAND=O ? JMP WPBSS+4 YES,OPERAND= ENTRY POINT LDA WPCUR+1 NO,OPER. IS LABEL AND O17 CPA O3 CONST? JMP *+3 WPERR LDA O4 OPERAND ERROR INDICATES INCORRECT JMP WPERA+1 STATEMENT FORMAT LDB WPCUR+1 CURRENT OPND JSB WFCS1 FETCH CONST WPJP2 JSB WSLAB SEARCH LABEL,RETURN B=LABEL ORD. STA WPINF SET FWA+2 OF LABEL ENTRY IN DVLIS CMB,INB COMPLEM.TO INDICATE INDIRECT JMP LDA WPCUR ADA WPBAS+1 BASE=LABELS JMP WPOUT GENERATE JMP CODE * WPSTR JSB WPOPN GET OPERAND CPA WPBAS+3 STORE INTO CONSTANT? JMP WPERR YES,ERROR STB WPSAV LDB WPTYP CPB MODE TYPE=MODE ? JMP WPCKM+2 YES ISZ LOCNT BUMP PROG.COUNTER CMB,INB NO,MIXED STORE ADB MODE ADA O52 SET MIXED STORE = R. TO I. SSB,RSS JMP *+3 REAL TO INTEGER ISZ LOCNT BUMP FOR 3 LOCS TOTAL IN INA INTEGER TO REAL STORE=53 LDB WPSAV RESTORE B JMP WPOUT * WPBSS LDA LOCNT ADA 1 ADD IN NO. OF LOCS ADA M1 -1 TO MAKE UP FOR BUMP IN PUTW STA LOCNT LDA WPCUR OP=BSS JMP WPOUT GENERATE CODE * WPOWR LDB O44 CODE FOR R**I LDA LABL AND O20 STA WPSAV SAVE TYPE OF BASE CMA,INA ADA WPTYP COMPARE AGAINST TYPE OF EXPON SZA,RSS JMP WPOW1 EQUAL TYPES SSA,RSS JMP WPERA ERROR IN ARITH, I**R LDA O20 MODE=REAL STA WPTYP SET TYPE OF BASE FOR WPOPN WPOW2 STA MODE STB WPCUR SET NEW OP LDB LABL LDA LABL+1 SAVE EXPON.CA STA LABL LDA LABL+2 STA LABL+1 SET CA OF BASE JSB WPOPN EVALUATE BASE ADA WPCUR ADD IN OF OP=44(RTOI),45(RTOR),OR 46 JSB PUTW OUTPUT CODE FOR BASE LDA WPCUR+1 OPERAND = EXPONENT AND O20 TYPE OF EXPONENT STA WPTYP RESET TO TYPE OF EXPONENT LDB WPCUR+1 LDA LABL STA LABL+1 JSB WPOPN EVALUATE EXPON ADA WPCUR ADD IN OP JSB PUTW OUTPUT CODE FOR EXPON ISZ LOCNT BUMP PROG. LOC. COUNTER ISZ ERFLG SET JSB ERR0 FLAG JSB ERSB,I GENERATE JSB ERR0 JMP WPOUT+1 EXIT * ERFLG BSS 1 NEED A JSB-ERR0 FLAG ERSB DEF ERSUB DEF TO SUBROUTINE * WPOW1 LDA WPTYP INB SZA,RSS INB CODE=46 FOR ITOI (45 FOR RTOR) JMP WPOW2 * WPER!A LDA O12 ERROR, MIXED ARITH JSB ERRR PRINT ERROR JMP WPOUT+1 EXIT * WPAC2 LDA FWA CMA,INA ADA WPCUR+1 A= NO.OF LOCS IN FORMAT ADA LOCNT SET NEW LOC.COUNT STA LOCNT WPASC STB WPSAV SET LWA+1 OF ASCII STRING LDA WPCUR JSB LNK27,I OUTPUT OP (31 OR 40) (WRITB) LDA FWA CMA,INA ADA WPCUR+1 LENGTH OF STRING JSB LNK27,I OUTPUT LENGTH WPAC1 LDA FWA CPA WPSAV READY ? JMP WPOUT+1 YES,EXIT LDA 0,I NO JSB LNK27,I OUTPUT BINARY WORD (WRITB) ISZ FWA BUMP CURRENT ADDR-IN OUTPUT JMP WPAC1 CONTINUE OUTPUT LDA WPCUR ADA WM26 STA WPCUR RESET TO 10=DEF,11=JMP WPDLB INB,SZB JMP WPJP2-2 LDA LBCNT ISSUE LABEL STA WPINF SET I>FO TO RETURN IN A AT EXIT ISZ LBCNT JMP WPJP2 ENTER LABEL IN SYMBTAB,ETC. SKP * *WPOPN EVALUATES OPERANDS:CONSTANTS,VARIABLES(INCL. *FORMAL PARAMETERS,ASF FORMAL PARAMS,SUBSCRIPTED VARS *WITH AND WITHOUT C-BIT). IT ALSO CONTROLS ERASABLE *STORAGE *IT RETURNS PUTAWAY-OUTPUT - OP.CODE IN A AND B *ENTER WITH OPERAND FORMAT IN B * WPOPN NOP STB WPSVN LDA 1 OPERAND TO A AND O17 ADA *+2 JMP 0,I JMP TO SECTION DEF *,I * DEF WPERR 1=ILLEGAL OP DEF WPERR 2=ILLEGAL OP DEF WPCON CONSTANT=3 DEF WPVAR NON DIMENS.VAR =4 DEF WPVAR ARRAY VAR=5,SAME AS VAR. DEF WPSSV SUBSCR.VAR.= 6 DEF WPASP ASF PARAM = 7 DEF WPERS ERAS = 10B DEF WASFR ASF REF = 11B DEF WPERR 12B= ILLEGAL OP DEF WPERR 13B= ILLEGAL OP DEF WPERR 14B= ILLEGAL OP * WASFR JSB LOKUP LDB 0,I REL PROG ADDR OF ASF ENTRY-POINT JMP WPPRB * WPCON JSB WFCS1 FETCH CONST STB WPSVC SAVE LOWER PART STA WPSVN UPPER PART  ISZ CNSIZ BUMP CONST COUNT LDB WPTYP LDA WPBAS+3 TYPE FOR INT CONST =2000B SZB,RSS INT CONST ? JMP *+3 YES ISZ CNSIZ NO,BUMP CONST COUNT RAL TYPE=4000B FOR REAL CONST LDB WPSVN UPPER PART OF CONST JMP WPOPN,I EXIT * WPERS JSB WPFAD OPERAND IS PROGRAM ERASABLE STA WSLAB SAVE ERAS.ORDINAL LDA WPBAS+5 PROG. ERAS.BASE LDB ASFLG SZB ASF PROCESSING ? ADA WPBAS YES,SET BASE TO ASF ERAS. STA LOKUP SAVE BASE LDB WSLAB SET B= ERAS ORDINAL SZB JMP WPER1 ERAS. ALREADY DEFINED LDB ERCNT ERAS. TO BE ISSUED LDA 1 ALF SHIFT POINTER TO UPPER 10 BITS RAL,RAL ADA O10 10B FOR ERAS FORMAT ADA MODE ADD IN MODE STA WPSVN RESET OPERAND FORMAT STA WPCUR+1 RESET OPERAND FORMAT STA WPINF SET ERAS.FORMAT TO RETURN INFO. ISZ ERCNT BUMP ERAS COUNTER LDA MODE STA WPTYP TYPE=MODE FOR ERASABLE SZA TYPE INT.? ISZ ERCNT REAL,RESERVE ONE MORE LOC WPER1 LDA WPSVN AND O40 GET I-BIT SZA CMB,INB INDIRECT REF LDA LOKUP ERAS.BASE JMP WPOPN,I EXIT * WPVR1 LDB PARAM CMB,INB INDIRECT REF LDA WPBAS+7 PARAM BASE= 4400B JMP WPOPN,I * WPVAR JSB WPFAD GET ORDINAL SZA 0 ? JMP *+3 NO,CONTINUE NORMALLY CLB,INB YES,OPND =LOC.VAR 1 JMP WPLCV JSB LOKUP OPERAND= VAR.,GET SYMBTAB ADDR STA LOKUP SAVE DVL ADDR FOR LATER USE LDB 0,I GET REL.ADDR. LDA PARAM SZA F*MAL PARAM JMP WPVR1 YES,INDIRECT REF LDA CBIT GET COMMON FLAG SZA JMP WPLCV+2 COMMON BASE LDA LOKUP DVL ADDR CMA,INA ADA TDVL SSA,RSS DECLARED VAR ? JMP WPPRB YES, BASE IS PROG. WPLCV LDA WPBAS+2 LOC.VAR.BASE JMP WPOPN,I * LDA WPBAS+4 COMMON BASE JMP WPOPN,I * WPSSV LDA LABL+1 CONAD OF SUBSCR VAR STA SAVCA JSB LOKUP LOOK-UP ARRAY-NAME OF SS VAR LDB 0,I REL.ADDR. OR ORDINAL (IF FP.) LDA WPSVN AND O40 SZA C-BIT SET ? JMP WPSS1 YES LDA PARAM SZA PARAM ? JMP WFPAR YES LDA WPCUR CPA O10 DEF? JMP WPSS1+2 YES,TAKE ADDR.ITSELF LDB ORD NO, DO ADDR. ARITH JMP WPPRB * WPSS1 ADB LABL+1 ADD CONST. ADDEND ADB M1 -1 LDA CBIT COMMON BIT VALUE SZA COMMON ? JMP WPSSV-2 YES,COMMON BASE WPPRB LDA WPBAS NO, PROG. BASE JMP WPOPN,I EXIT * WPASP JSB WPFAD OPERAND IS ASF- PARAM,FETCH POINT ADA SFPAD -(NO.OF PARAMS +1)=CON.ADDEND STA LABL+1 SAVE LDB FWA,I GET BETA FORMAT OF ASF-NAME JSB LOKUP GET FWA OF ASF ENTRY IN SYMBTAB LDB 0,I ADB LABL+1 CMB INDIRECT REF.AND COMPENSATE LDA WPBAS PROG.BASE JMP WPOPN,I EXIT * WPDIV LDA WPREV CPA O13 WAS PREVS. INSTR MPY? JMP WPCIN YES,CONTINUE AS OTHER ARITH OPS LDA WPTYP SZA TYPE=INT ? JMP WPART NO LDA O12 LDB WCCLB JSB PUTW OUTPUT CLB = 6400B LDA O20 ISZ LOCNT JSB LNK27,I CALL WRITE TO OUTPUT SSA LDA O12 LDB WCCMB JSB PUTW OUTPUT CMB = 7000B LDB WPCUR+1 RESTORE OPND IN B FOR WPOPN JMP WPCIN GENERATE CODE FOR DIV SKP * *WSLAB IS A LABEL LOOKUP-AND-INSERT ROUTINE. ENTER *WITH A=LA EL VALUE. RETURN:A= LOC OF REL.ADDR.OF *LABEL, B= LABEL ORDINAL. *CALLS SDVL (SEARCH DVLIST) AND EDVL (ENTER DVLIST). *INC (AMOUNT OF BETA-STRING MOVE) TO 0 BEFORE CALLING *THESE ROUTINES. * WSLAB NOP STA WPSV3 SET ALPHA-FORMAT CONST FOR SDVL JSB SDVLL SEARCH SYMBTAB FOR LABEL INA,SZA LABEL FOUND? JMP WSLB1 YES LDA WPSV3 NO JSB EDVLL ENTER LABEL IN SYMBTAB WSLB1 LDA 1 A= LOC.IN SYMBTAB OF LABEL ADDR INB BUMP TO LOC OF ORDINAL LDB 1,I GEL LABEL ORDINAL JMP WSLAB,I EXIT * WFPAR LDB PARAM PARAM ORDINAL JMP WPVR1+2 * SAVCA BSS 1 CONAD OF CURRENT SUBSCR VAR WPCUR BSS 2 WPSVC BSS 1 WPTYP BSS 1 WPSVN BSS 1 WPSAV BSS 1 WPSV3 BSS 1 WM26 OCT 177752 -26B WCCLB OCT 6400 OCT FOR CLB WCCMB OCT 7000 OCT FOR CMB * SKP * ****************************** * ENTRY POINT FOR CALL STATEMENT * ******************************* * MSP9 NOP LDA FWA LDB LWA JSB LNK25,I PROCESS BETA (WPRB) JMP MSP9,I * DUP8 NOP LDA 1,I ADB O4 FOR LABEL ADD 4 SZA LABEL ? ADB O4 NO, ADD 4 MORE JMP DUP8,I EXIT * * * ********************************** * ENTRY POINT FOR BEGIN DO STATEMENT * ********************************** * MSP7A NOP ENTRY FOR IMPLIED DO STA 1 STB MSP1D SAVE FWA LDA MSP7A STA MSP7 STORE RETURN ADDRESS IN MSP7 CLA,INA STA MSP7A SET IMPLIED DO FLAG JMP MSP7B+2 * * MSP7 NOP NORMAL ENTRY CLA STA MSP7A CLEAR IMPLIED DO FLAG LDB FWA INITIALIZE BETA WORD ADDRESS STB MSP1D SAVE FWA LDA 1,I AND O37 CPA O3 IS THE FIRST BETA WORD A LABEL JMP MSP7B IF SO, CONTINUE MERR5 LDA O4 OTHERWISE, LOAD ERROR INDICATOR JSB ERRR AND GO TO DIAGNOSTICS JMP MSP7,I * MSP7B JSB MLBCH,I CHECK LABEL FOR 1 TO 9999 RANGE JMP MSP7,I ERROR, RE>TURN TO CALLING PGM INB INCREMENT BETA WORD ADDRESS LDA 1,I OBTAIN NEXT BETA WORD AND O37 ISOLATE TYPE BITS CPA O4 IS THIS AN INTEGER VARIABLE? RSS IF SO, CONTINUE JMP MERR5 OTHERWISE, GO TO ERROR STB MSP4D STORE BETA ADDRESS OF INDEX INB INCREMENT BETA WORD ADDRESS LDA 1,I OBTAIN NEXT BETA WORD CPA W.EQ IS THIS AN = RSS IF SO, CONTINUE JMP MERR5 OTHERWISE, GO TO ERROR STB MSP2D STORE BETA WORD ADDRESS LDB M2 INITIALIZE M COUNTER TO -2 MLOP5 INB INCREMENT M COUNTER ISZ MSP2D INCREMENT BETA WORD ADDRESS LDA MSP2D,I OBTAIN NEXT BETA WORD AND O37 ISOLATE TYPE BITS CPA O4 IS THIS AN INTEGER VARIABLE? JMP MLP5A IF SO, CONTINUE CPA O3 IS THIS AN INTEGER CONSTANT? RSS IF SO, CONTINUE JMP MERR5 OTHERWISE, GO TO ERROR STB MSP3D STORE M COUNTER TEMPORARILY LDB MSP2D LOAD B WITH ADDRESS OF WORD JSB WFCS EVALUATE THE CONSTANT SSA,RSS IF VALUE IS NEGATIVE OR SZA,RSS ZERO GO TO ERROR JMP MERR5 CMA,INA COMPLEMENT VALUE STA MSP2D,I STORE VALUE IN BETA STRING LDB MSP3D RESTORE M COUNTER MLP5A ISZ MSP2D INCREMENT BETA WORD ADDRESS LDA MSP2D,I OBTAIN NEXT BETA WORD CPA W.CMA IS THIS A , JMP MLOP5 IF SO,CHECK NEXT WORD CPA O17 IS THIS THE END? RSS IF SO,CONTINUE JMP MERR5 OTHERWISE,GO TO ERROR CPB O1 CHECK THAT THE M COUNTER EQUALS JMP *+3 ONE OR ZERO SZB JMP MERR5 STB MSP3D STORE M COUNTER LDA MSP1D INA LDA 0,I LOAD INDEX VARIABLE LDB O2 LOAD RELATIVE POSITION IN DO JSB MDOTL TABLE ENTRY AND SEARCH DO TABLE JMP MERR5+1 RETURN IF THE TABLE IS FULL SZA IF INDEX IS NOT IN TABLE SKIP JMP MERR5+1 INDEX ALREADY IN TABLE,ERROR ADB M2 SUBTRACT 2 TO GET STARTING STB MSP2D ADDRESS OF DO TABLE ENTRY LDA MSP7A IS THIS AN IMPLIED DO CALL SZA,RSS IF SO JUMP AROUND THE LABEL JMP *+3 EVALATION ROUTINE LDA MSP1D,I JMP *+3 LDB MSP1D LOAD B WKH LABEL ADDRESS JSB WFCS EVALUATE LABEL ISZ MSP2D INCREMENT DO TABLE ADDRESS STA MSP2D,I STORE BINARY END LABEL ISZ MSP1D INCREMENT BETA ADDRESS WORD LDB M2 SET UP TO SKIP LOADING OF M1 MLOP6 SZB ISZ MSP2D INCREMENT DO TABLE ADDRESS LDA MSP1D,I OBTAIN NEXT BETA WORD STA MSP2D,I STORE IN DO TABLE ISZ MSP1D INCREMENT BETA WORD ADDRESS ISZ MSP1D TWICE INB INCREMENT B CPB O2 IS THIS THE END? RSS IF SO, JUMP OUT OF LOOP JMP MLOP6 LDA MSP3D LOAD M COUNTER CCB SZA,RSS IF ZERO, STORE -1 IN M3 ENTRY STB MSP2D,I OF DO TABLE CLA STA MODE SET INTEGER MODE LDA MSP4D LOAD ADDRESS OF INDEX ADA O2 ADD 2 LDB 0,I LOAD B WITH M1 CLA,INA LOAD A WITH LDA INDICATOR SSB,RSS IS THIS A CONSTANT JMP *+3 NO ,JUMP CMB,INB YES,COMPLEMENT ADA M1 REDUCE A TO 0 IF LDA CONSTANT JSB MPUT1,I CALL PUTAWAY 1 LDB MSP4D,I LOAD B WITH INDEX LDA O6 LOAD A WITH STA INDICATOR JSB MPUT1,I CALL PUTAWAY 1 LDA MSP2D ADA M4 LDB LOCNT STORE LOCATION COUNTER IN DO STB 0,I TABLE AT DO LOOP START POSITION CLA RESET PREVIOUS OP TO ENSURE THAT STA WPREV A SUBSEQUENT LDA INDEX IS NOT * DELETED JMP MSP7,I RETURN TO CALLING PROGRAM * _7 MSP1D OCT 0 MSP2D OCT 0 MSP3D OCT 0 MSP4D OCT 0 * SKP * ************************** * DO TABLE SEARCH SUBROUTINE * ************************** * * EACH DO TABLE ENTRY CONTAINS THE FOLLOWING * 1. RELATIVE ADDRESS OF BEGINNING OF THE LOOP * 2. END LABEL (BINARY) * 3. INDEX VARIABLE (BETA FORMAT) * 4. M2 BETA FORMAT * 5. M3 BETA FORMAT OR -1 IF NO M3 IN STATEMENT * * THE SUBROUTINE IS CALLED WITH THE ITEM TO BE * SEARCHED FOR IN A IN THE APPROPRIATE FORMAT * AND ITS RELATIVE LOCATION WITHIN AN ENTRY * IN B * * IF THE ITEM IS IN THE TABLE, RETURN IS MADE * TO THE THIRD LOCATION OF THE CALLING SEQUENCE * WITH 17B IN A AND THE ABSOLUTE LOCATION OF * THE ITEM IN B * IF THE ITEM IS NOT IN THE TABLE, AND THE TABLE * IS NOT FULL,RETURN IS MADE TO THE THIRD * LOCATION OF THE CALLING SEQUENCE WITH ZERO * IN A AND THE ABSOLUTE LOCATION OF THE FIRST * FREE LOCATION FOR THIS ITEM IN B * * IF THE ITEM IS NOT IN THE TABLE, BUT THE TABLE * IS FULL,RETURN IS MADE TO THE SECOND LOCATION * OF THE CALLING SEQUENCE WITH 17B IN A * * * MDOTL NOP STA MDOT4 STORE A CLA STA MDOT3 LDA O17 INITIALIZE TABLE FULL FLAG STA MDOT1 LDA MDONO INITIALIZE ENTRY COUNTER STA MDOT2 ADB MDOND ADD LAST ADDRESS OF DO TABLE INA MDOL1 ADB M5 ADD -5 TO DO-TABLE ADDRESS. MOVE LDA 1,I UP THE TABLE ENTRY BY ENTRY SZA,RSS SKIP IF ENTRY NON ZERO JMP MDOL3 JUMP TO CLEAR TABLE FULL FLAG CPA MDOT4 IS ENTRY EQUAL TO ITEM JMP MDOL4 IF SO, JUMP LDA MDOT3 SZA,RSS STB MDOT3 |MDOL2 ISZ MDOT2 HAS THE COMPLETE TABLE BEEN JMP MDOL1 CHECKED, IF NOT CONTINUE CHECK LDA MDOT1 LOAD TABLE FULL FLAG SZA JMP MDOTL,I OTHERWISE, JUMP TO ERROR RETURN LDA MDOT3 SZA,RSS JMP MDOL4+1 LDB MDOT3 ADB O5 CLA,RSS MDOL4 LDA O17 LOAD ITEM FOUND INDICATOR ISZ MDOTL INCREMENT RETURN ADDRESS JMP MDOTL,I RETURN TO CALLING PROGRAM * MDOL3 STA MDOT1 CLEAR TABLE FULL FLAG JMP MDOL2 CONTINUE CHECKING * MDOT1 OCT 0 MDOT2 OCT 0 MDOT3 OCT 0 MDOT4 OCT 0 MDONO DEC -10 SKP * * ************************* * ENTRY POINT FOR END OF DO * ************************* * MSP8 NOP STA MSPD1 STORE BINARY LABEL MLOP7 CLB,INB SET B TO LABEL RELATIVE ADDRESS JSB MDOTL SEARCH DO TABLE JMP MERR6+6 LABEL NOT FOUND TABLE FULL, ERROR SZA,RSS IS THIS LABEL IN THE TABLE JMP MLOP8 IF NOT GO TO NESTING CHECK ADB M1 B CONTAINS ADDRESS OF LABEL ADD STB MSPD2 -1 TO GET ENTRY START & STORE ADB O2 ADD 2 TO GET INDEX ADDRESS STB MSPD3 STORE INDEX ADDRESS LDB 1,I OBTAIN INDEX CLA STA MODE SET INTEGER MODE CLA,INA LOAD A WITH LDA INDICATOR JSB MPUT1,I CALL PUTAWAY 1 LDB MSPD2 ADD 4 TO ENTRY START TO GET ADB O4 ADDRESS OF INDEX INCREMENT (M3) LDB 1,I LDA O21 LOAD A WITH INA INDICATOR CPB M1 IS M3 = -1, I. E. NO M3 SPECIFIED? JMP *+6 YES, CONTINUE ADA MO16 NO, REDUCE A TO 3, ADA INDICATOR SSB,RSS IS THIS A CONSTANT(STORED -RE) JMP *+3 NO , JUMP CMB,INB YES,COMPLEMENT ADA O23 A=26, ADA CONSTANT JSB MPUT1,I CALL PUTAWAY 1 LDB MSPD3,I OBTAIN INDEX LDA O6 LOAD A WITH STA INDICATOR JSB MPUT1,I q  CALL PUTAWAY 1 LDA O5 LOAD A WITH CMA,INA INDICATOR JSB MPUT1,I CALL PUTAWAY 1 ISZ MSPD3 LDB MSPD3,I LOAD B WITH FINAL INDEX VALUE(M2) LDA O3 LOAD A WITH ADA INDICATOR SSB,RSS IS THIS A CONSTANT JMP *+3 NO ,JUMP CMB,INB YES,COMPLEMENT ADA O23 A=26, ADA CONSTANT JSB MPUT1,I CALL PUTAWAY 1 LDB MNSSA LOAD B WITH OCT 2021 (SSA,RSS) LDA O25 LOAD A WITH OCT INDICATOR JSB MPUT1,I CALL PUTAWAY 1 LDB MSPD2,I LOAD B WITH REL. ADDRESS OF THE LDA O15 BEGINNING OF LOOP, A WITH JMP JSB MPUT1,I CALL PUTAWAY 1 LDA M5 PREPARE TO CLEAR TABLE ENTRY STA MSPD3 STORE -5 IN MSP3 LDB MSPD2 LOAD B WITH ENTRY START CLA STA 1,I STORE ZERO IN ENTRY LOCATION INB INCREMENT ENTRY LOCATION ISZ MSPD3 HAS THIS ENTRY BEEN CLEARED JMP *-3 NO, CONTINUE CLEARING LDA MSPD1 LOAD BINARY LABEL JMP MLOP7 CHECK TABLE FOR OTHER LOOPS * ENDING IN THIS LABEL * CHECK FOR CORRECT DO LOOP * NESTING BY CHECKING THAT ALL * DO LOOPS FOLLOWING THIS DO * HAVE BEEN CLEARED FROM TABLE * MLOP8 LDB MSPD2 PICK UP START OF THIS ENTRY LDA 1,I LOAD THE VALUE SZA IS IT ZERO? JMP MERR6 NO, GO TO ERROR CPB MDOND IS THIS THE END OF DO TABLE JMP MSP8,I YES, RETURN TO CALLING PROGRAM INB NO, INCREMENT ADDRESS JMP MLOP8+1 CONTINUE CHECKING * MERR6 CLA STA 1,I STORE ZERO IN ENTRY LOCATION CPB MDOND IS THIS THE END OF DO TABLE JMP *+3 YES, GENERATE DIAGNOSTIC INB INCREMENT ADDRESS JMP MERR6+1 CONTINUE TO CLEAR TABLE S<HFB LDA O17 LOAD ERROR INDICATOR JSB ERRR CALL DIAGNOSTICS JMP MSP8,I RETURN TO CALLING PROGRAM * MNSSA OCT 2021 CODE FOR SSA,RSS MSPD1 OCT 0 MSPD2 DEF .CON0 ZERO POINTER FOR MLOP8 DEFAULT MSPD3 OCT 0 MO16 OCT -16 * SKP * *************************************** * ENTRY POINT FOR END STATEMENT IN PASS 2 * *************************************** * MSP10 NOP LDA CONAD SZA,RSS LABELLED END ? JMP MEND1-1 YES,GENERATE RETURN CODE LDA PREVS CHECK THE TYPE OF THE PREVIOUS CPA O17 STATEMENT, IF THIS WAS A JMP MEND1 RETURN(17), IF(12), GO TO(13,14) CMA,INA OR A STOP(15), DO NOT GENERATE ADA O11 JMP ENTRY,I CODE SSA,RSS JMP *+4 dH ADA O4 SSA,RSS JMP MEND1 JSB LNK6,I CALL RETURN PROCESSOR (MSP3) MEND1 LDB MDOAD LOAD DOTABLE ADDRESS LDA 1,I OBTAIN THE VALUE SZA IS IT ZERO JMP MERR7 NO ,ERROR CPB MDOND YES,IS THIS THE END OF DO TABLE JMP MEND2 YES,CONTINUE INB NO, INCREMENT DO TABLE ADDRESS JMP MEND1+1 CONTINUE CHECK FOR ZERO DOTABLE * MERR7 CLA STA 1,I STORE ZERO IN THIS LOCATION CPB MDOND IS THIS THE END OF DO TABLE JMP *+3 YES,JUMP OUT INB NO, INCREMENT DO TABLE ADDRESS JMP MERR7+1 LDA O17 LOAD ERROR INDICATOR JSB ERRR CALL DIAGNOSTICS MEND2 LDA TDVL STA FWA LDB LDVL LDA O40 JSB MPUT1,I CALL PUTAWAY 1 CLA STA CONAD SET TO 0 FOR ERROR PRINT LDA TDVL FWA OF SYMBOL TABLE CPA LDVL END OF SYMBOL TABLE ? JMP WFEND YES, CONTINUE ENDPRO LINNR STA WHADD POINTER IN SYMBOL TABLE LDB 0,I SZB,RSS LABEL ? JMP LBCHK YES,CHECK FURTHER LOUTR LDA WHADD INA BUMP ADDR. CPA LDVL END OF LIST ? JMP WFEND YES,FINISH UP ENDPRO JMP LINNR NO,CONTINUE SEARCH * LBCHK INA LDB 0,I STB LABEL SET LABEL VALUE INA LOC.OF LABEL ADDR. STA WHADD ISZ 0,I LABEL DEFINED JMP LOUTR+1 YES,OK LDA O1 NO, UNDEFINED LABEL ERROR =1 JSB ERRR PRINT ERROR JMP LOUTR CONTINUE SEARCH * WHADD BSS 1 * STORE THE FOLLOWING PARAMETERS * IN THE MULTI-COMPILE TABLE WFEND LDB LOCNT LDA PTYPE CPA O1 ADB O3 STB LOCNT STB BUFAD,I ISZ BUFAD LDA LVORD LOCAL VARIABLE ORDINAL STA BUFAD,I ISZ BUFAD LDA AESIZ ASF ERASABLE SIZE STA BUFAD,I ISZ BUFAD LDA ERSIZ PROGRAM ERASABLE SIZE STA BUFAD,I ISZ BUFAD LDA LBORD STA BUFAD,I ISZ BUFAD LDA CLOC LENGTH OF COMMON STA BUFAD,I ISZ BUFAD LDA CNSIZ SIZE OF CONSTANT AREA STA BUFAD,I ISZ BUFAD LDA BUFAD CPA BUFND IS THE MULTI-COMPILE TABLE FULL JMP LNK33,I YES, TERMINATE PASS2 COMPIL. (FINIS) JMP MSP10,I NO,RETURN TO CALLING PROGRAM * MDOND EQU DOND * SKP * ******************************** * ENTRY POINT FOR FORMAT STATEMENT * ******************************** * MSP11 NOP LDA CONAD SZA,RSS IS THE FORMAT STATEMENT LABELLED JMP *+4 YES,CONTINUE CLA,INA NO, GENERATE ERROR MESSAGE JSB ERRR JMP MSP11,I RETURN TO CALLING PROGRAM LDA FFLAG SZA IS FFLAG ZERO JMP MGOF1 NO, JUMP CCB YES, LOAD B WITH -1 LDA O37 LOAD A WITH JMP LABEL INDICATOR JSB MPUT1,I CALL PUTAWAY 1 STA FFLAG STORE LABEL ADDRESS IN FFLAG LDA LOCNT LOAD CURRENT LOCATION COUNTER STA FFLAG,I STORE IN LABEL REL. ADDRESS LDA LABEL INCREMENT THE LABEL LOCATOR JSB SDVLL BY ONE TO SKIP OVER THE ISZ 1,I JUMP INSTRUCTION MGOF1 LDA FWA CMA,INA ADA LWA A = LENGTH OF FORMAT STRING ADA FFLAG,I ADD CONTENTS OF LABEL REL. ADDR. STA FFLAG,I STORE IN LABEL REL. ADDRSS LDB LWA LDA O31 LOAD A WITH ASCII INDICATOR JSB MPUT1,I CALL PUTAWAY 1 JMP MSP11,I RETURN TO CALLING PROGRAM * ********** SDVL ********* * SEARCH DECLARED VARIABLES FOR ALPHA ENTRY * ENTER A=LOC ALPHA STRING IDENTIFIER * EXIT A= ORDINAL OF ENTRY OR -1 IF NOT FOUND * B= LOC OF ENTRY IN SYMBTAB * CCA NOT FOUND JMP *+1,I EXIT SDVL NOP ] CLB STB TEMP+3 JSB MDVL LDB FDVL NDVL CPB LDVL JMP SDVL-2 NOT FOUND STB TEMP+2 LDA 1,I AND O7 LDB 0 LDA LDVL,I AND O7 CPA 1 JMP *+5 UDVL LDB TEMP+2 JSB NDVLE,I ISZ TEMP+3 COUNT ORDINAL JMP NDVL INA ARS CMA,INA STA TEMP+1 NO WDS LDA LDVL ADA O2 STA TEMP LDB TEMP+2 ADB O2 LDA 1,I CPA TEMP,I INB,RSS JMP UDVL ISZ TEMP ISZ TEMP+1 END JMP *-6 LDA TEMP+3 ORINAL LDB TEMP+2 LOC JMP SDVL,I FOUND ** MDVL NOP STA TEMP LDA LFWA CPA LPRG PROGRAM WITHOUT NAME AT START ? JMP MDVLX YES, THEN TEST MUST BE BYPASSED * LDB LDVL ADB O10 CMB,INB ADB LFWA SSB JMP DOVF MDVLX LDA TEMP,I JSB STYP ALF STA LDVL,I LDB LDVL LDA TEMP,I ALF,ALF NO CHAR ALF AND O17 NO. OF CHARS (4 BITS) ADA M6 -6 SSA,RSS NO OF CHARS GE 6? CLA YES, NO OF CHARS=6 ADA O6 RESTORE NO. OF CHARS IOR 1,I STA 1,I ADB O2 AND O7 EXTRACT COUNT CMA,INA STA TEMP+1 COUNTER LDA TEMP,I FIRST CHAR ALF,ALF IS UPPER DVLA ISZ TEMP NEXT WORD IS UPPER AND O377 ALF,ALF STA 1,I ISZ TEMP+1 RSS EDVE JMP MDVL,I LDA TEMP,I ALF,ALF UPPER ALPHA AND O377 IOR 1,I LOWER DVL STA 1,I INB ISZ TEMP+1 RSS JMP EDVE LDA TEMP,I JMP DVLA * DOVF LDA O16 JSB ERRR JMP TILT * ECSUB NOP INB USE AS TEMP CORE NOT USED BY PRA STB TEMP LOC FIRST CONSTANT OF SUBSCRIPT STA TEMP+1 LOC DVLIST LDA TEMP,I EXTRACT FIRST ALPHA STRING ENTRY K AND O37 TYPE INTEGER CONSTANT ONLY CPA O3 JMP ESB1 ESBER LDA O13 JSB ERRR LDB TEMP RETURN A=0 AND BYPASS REMAINDER LDA 1,I INB CPA W.RP CLA,RSS JMP *-4 JMP ECSUB,I * ESB1 XOR TEMP,I EXTRACT ORDINAL OF CONSTANT ALF,ALF RAL,RAL CMA C*NT CON LIST DOWN ADA TCLIS LOC IN CONLIS LDA 0,I VALUE CLB STA TEMP+2 VALUE OF FIRST SUBSCRIPT SAVED ISZ TEMP NEXT ALPHA ENTRY LDA TEMP,I CPA W.RP JMP ESBE CPA W.CMA RSS JMP ESBER ISZ TEMP NEXT ALPHA ENTRY LDA TEMP,I CPA W.RP JMP ESBE AND O37 CPA O3 RSS JMP ESBER XOR TEMP,I NEXT ALPHA CONSTANT ALF,ALF RAL,RAL CMA ADA TCLIS LDA 0,I LDB TEMP+1,I EXTRACT DVL ENTRY RBL SSB,RSS MORE THAN 1 DIM JMP ESBER LDB TEMP+1 LOC DVL STA WXSAV SAVE A JSB NDVLE,I NENT TO GET FWA NEXT DVLIST ENTRY ADB M2 -2 TO GET ADDR. OF DIM1 OF ARRAY LDA WXSAV RELOAD A LDB 1,I D1 ADA M1 FORM D1*(C2-1) JSB MPYA,I ISZ TEMP NEXT ALPHA LDA TEMP,I CPA W.RP MUST BE ) RSS JMP ESBER ELSE ERROR ESBE ISZ TEMP NEXT ALPHA ADB TEMP+2 ADD IN 1ST CONST.SS-VALUE ADB M1 -1 LDA TEMP+1,I 1ST WORD OF ENTRY IN DVLIST AND O20 MASK FOR TYPE BIT SZA BLS REAL, ADDEND *2 LDA 1 ADDEND TO A LDB TEMP JMP ECSUB,I * * * PROCESS PROGRAM STATEMENT * PPROG ISZ LNWA SET ALPHA PNTR AT LOC LDA LNWA STA LFWA CCA STA DEFLG DEFAULT-TYPE FLAG JSB WGETC SSB LDB O3 DEFAULT-TYPE (MAIN PROG=3) STB EPTYD,I PROG TYPE JSB WGETC  GET PRIORITY SSB JMP *+3 YES, LEAVE DEF.PR=99 BLF,BLF STB BUFAD,I SET PROG PRIORITY CLB STB DEFLG CLEAR FLAG JSB WGETC GET RES. CODE ADB BUFAD,I STB BUFAD,I SAVE RESOLUTION CODE ISZ BUFAD JSB WGETC STB BUFAD,I SAVE EXECUTION MULTIPLE ISZ BUFAD JSB WGETC BLF,BLF STB BUFAD,I SAVE HOURS JSB WGETC ADB BUFAD,I STB BUFAD,I SAVE MINUTES ISZ BUFAD JSB WGETC BLF,BLF STB BUFAD,I SAVE SECONDS JSB WGETC ADB BUFAD,I STB BUFAD,I SAVE TENS OF MILLISECONDS ISZ BUFAD * GTCMT CLA,INA STA RTYPE SET WRITB FOR OUTPUT LDA M4 STA DEFLG JSB LNK27,I OUTPUT -4 FOR HEADER CODE LDA DBUFS,I STA WGSAV GTCM1 LDA WGSAV,I OUTPUT 4 WORDS JSB LNK27,I OF PARAMS ISZ WGSAV ISZ DEFLG DONE YET? JMP GTCM1 NO LDA LNWA,I YES, CHECK FOR COMMENTS CPA W.CMA COMMA? ISZ LNWA YES, SKIP IT LDA LNWA,I ONLY ALLOW 1 COMMA AND O17 CHECK PARSED TYPE CPA O17 END OF STATEMENT? CLA YES. CPA O16 COMMENTS? RSS YES. CLA,RSS LDA LNWA,I ALF AND .MU1 GET CHARACTER COUNT IN COMMENT ALF,ALF ROTATE TO LOWER INA CLE,ERA MAKE WORD COUNT LDB 0 CMB STB DEFLG SAVE NEG CNT JSB LNK27,I OUTPUT WDCNT GTCM2 ISZ DEFLG DONE YET? RSS JMP NEXTD,I RETURN ISZ LNWA LDA LNWA,I JSB LNK27,I OUTPUT A WORD JMP GTCM2 REPEAT TIL DONE SKP * * * WGETC FETCHES THE NEXT CONST. FOR A PARAMETER LIST * OF A PROGRAM STATEMENT. ZERO IS RETURNED IF PARAM * IS NOT SPECIFIED. IT JUMPS TO NEXT AFTER THE * RIGHT-PARENTHESIS. * CALLING SEQUENCE: JSB WGETC (RETURNS B=VALUE) * DEFLG BSS 1 WGSAV BSS 1 DBUFS DEF BUFAS NEXTD DEF NEXT3 EPTYD DEF EPTYP WGETC NOP LDB LFWA CPB LWA END OF ALFA? JMP GTCMT YES, END OF PROGRAM STATEMENT CLB LDA LFWA,I ISZ LFWA BUMP ALPHA POINTER ISZ LNWA CPA W.RP ) ? JMP WGET1 YES CPA O17 END OF ALFA STRING? JMP WGET1 YES CPA W.CMA , ? JMP WGETC,I YES, EXIT WITH VALUE=0 STA WGSAV SAVE ALPHA FORMAT AND O37 CPA O3 INTEGER CONST? JMP WGET3 YES, OK LDA O4 NO, ERROR JSB ERRR WGET2 LDB DEFLG PICK UP DEF.TYPE FLAG JMP WGETC,I EXIT WGET3 ISZ LFWA BUMP ALPHA POINTER ISZ LNWA LDA WGSAV AND MO100 ALF,ALF RAL,RAL CMA ADA TCLIS ADDR OF CONST IN CONLIST LDB 0,I VALUE TO B-REG JMP WGETC,I EXIT WGET1 LDA LWA STA LFWA SET END OF ALPHA JMP WGET2 * * SKP * ****************************** * WRITB OUTPUT PROGRAM IN PASS 1 * ****************************** * WRITB NOP STA MBOX1 STB MBOX2 LDA RTYPE LOAD RECORD TYPE LDB OPT+1 CPA O3 IS THIS TYPE 3, ASCII? RSS YES, CONTINUE JMP MWRT1 NO ,JUMP TO NEXT CHECK * * WTAPO LDA MBOX1 NO. OF ASCII CHARACTERS LDB MBOX2 LOCATION OF ASCII STRING JSB LIST CALL LIST OUTPUT JMP WRITB,I RETURN * MWRT1 CPB OPT+2 NO A AND B-OPTIONS? JMP WRITB,I YES, NO INTERMEDIATE FOR L ONLY CPA O1 IS THIS TYPE 1, PUTAWAY? RSS YES,CONTINUE JMP MTPCK NO ,JUMP LDA MBOX1 LOAD WORD TO BE OUTPUT STA MIND1,I STORE IN NEXT BUFFER LOCATION ADA MBUF3+1 ADD PARTIAL CHECKSUM STA MBUF3+1 STORE IN PARTIAL CHECKSUM ISZ MIND1 INCREMENT dBUFFER ADDRESS LDB MIND1 CPB MBUF5 IS THE BUFFER FULL RSS YES,CONTINUE JMP WRITB,I NO ,RETURN MWRT2 LDA MTYP5 40 WORDS, TYPE 1 INDICATOR STA MBUF3 ADA MBUF3+1 ADD TO PARTIAL CHECKSUM CMA,INA STA MBUF3+1 -(CHECKSUM) * LDA PNT02 INITIALIZE FMP ERROR STA NAME FILE NAME POINTER JSB WRITF WRITE DEF *+5 INTERMEDIATE DEF IDCB3 CODE TO DEF ERRS SCRATCH DEF MBUF3 FILE DEF ILS1 SSA ERROR OCCUR? JMP FMPER YES.GO REPORT IT * MWRTI LDA MINDF NORMAL RETURN STA MIND1 INITIALIZE BUFFER LOCATOR LDB MBUF4 CLA ZERO ALL BUFFER LOCATIONS STA 1,I INB CPB MBUF5 RSS JMP *-4 * JMP WRITB,I * MTPCK SZA,RSS IS THIS AN INITIALISATION JMP MWRT2 NO, JUMP JMP MWRTI YES,JUMP TO INITIALISATION * * * ILS OCT 3 ILS1 DEC 40 * MBOX1 OCT 0 MBOX2 OCT 0 MBUF1 BSS 3 MBUF2 DEF MBUF1 MTYP3 OCT 2003 MTYP4 OCT 106612 MTYP5 OCT 24001 MD40 DEC -40 MBUF4 DEF MBUF3 FWA OF M BUFFER MBUF5 DEF MBUF3+40 LWA+1 OF M BUFFER MINDF DEF MBUF3+2 MIND1 DEF MBUF3+2 * * CMTCO LDA W.CMA SET PARSED FORM OF COMMA IN STRING STA ALFA,I JSB RCKAL,I LDA RPARC CHECK RT.PARENS CNT SZA JMP DR21,I GET ANOTHER CHAR LDA IBIT IOR CEFLG SET SIGN OF COMMA-EQUALS FLAG STA CEFLG * LDB RALFI LDA 1,I INB AND .MU1 GET 1ST CHAR OF LINE CPA RPS "P" ? JMP CMTPR CPA RSSS "S" ? JMP CMTSB CPA RFS "F" ? JMP CMTFN JMP DR21,I RETURN TO GET NEXT CHAR * CMTPR LDA RROS CHECK FOR "PROGRAM" JSB CMTCH INB LDA RAMS JSB CMTCH JMP CMTCM IS PROGRAM * CMTSB LDA RUBS CHECK FOR "SUB=0.*ROUTINE" JSB CMTCH ADB O3 LDA 1,I AND .MU1 CPA RES JMP CMTCM IS SUBROUTINE JMP DR21,I * CMTFN LDA RUNS CHECK FOR "FUNCTION" JSB CMTCH ADB O2 LDA 1,I AND .MU1 CPA RNS JMP CMTCM IS FUNCTION JMP DR21,I * CMTCM LDA ALFA SAVE LOCATION FOR STA CMTAD WORD COUNT JSB RCKAL,I CLA,INA STA RACNT SET COUNT=1 TO PUT IN LEFT RSS CMTL2 CCA STA RGFLG -1 TO KEEP BLANKS JSB GETC,I GET A CHAR SSA END OF TEXT? JMP CMTL3 YES LDB D81 NO, CHECK IF GOT CPB RACNT MAX NO. OF CHARS (80) RSS SKIP IF GOT MAX JSB STOC,I ELSE SAVE IT JMP CMTL2 GET MORE * CMTL3 LDA RACNT GET COUNT ADA M1 ALF SHIFT CHAR COUNT IOR O16 CLASS IDENT=16 STA CMTAD,I LDB RACNT LDA ALFA,I IF NEXT CHAR TO GO IOR O40 ON RIGHT, FILL IN SLB,RSS RIGHT BLANK. STA ALFA,I CLA STA RAFLG STA RACNT STA CEFLG CCA SET A=-1 TO END STMT JMP DREOS,I ADD O17 TO TERM.PARSE * DREOS DEF REOS GETC DEF RGET STOC DEF RASTO DR21 DEF R21 D81 DEC 81 CMTAD NOP * CMTCH NOP CPA 1,I INB,RSS JMP DR21,I JMP CMTCH,I * END FTN1 0 zj 92064-18135 1650 S C0422 &MF200 RTE-M FORTRAN SEGMENT 2             H0104 ASMB,R,L,C HED RTE-M FORTRAN--SEGMENT 2--PASS 2 NAM FTN2,5 92064-16047 REV.1650 761118 SUP * * * ********************************************************* * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. * * * * * * ALL RIGHTS RESERVED. NO PART OF THIS PROGRAM MAY BE * * * PHOTOCOPIED, REPRODUCED, OR TRANSLATED TO ANOTHER * * * PROGRAM LANGUAGE WITHOUT THE PRIOR WRITTEN CONSENT OF * * * HEWLETT-PACKARD COMPANY. * * ********************************************************* * * ENT FTN2 * EXT .STOP,OPEN,FCONT,PURGE,LIMEM,READF,WRITF EXT IDCB0,IDCB1,IDCB2,IDCB3,FMPER,CLOSE,RWNDF EXT EXEC,IMESS * COM LCLIS COM MCBUF(40) COM PTYPE COM BUFAD COM OPT(3) COM ...T * COM AI(6),AO(6),AL(6),AS1(6) COM ERRS,OPTS1,OPTS2,OPTS3,NAME,LINES COM FDVL,OPT4 * * BUFOR DEF MCBUF MULTI-COMPILE BUFFER BUFND DEF MCBUF+40 END OF BUFFER +1 ENTR. DEF GENTR ENTRY DEF FTN2 START OF PASS 2 PROCESSING * PTYPE - PROG TYPE: PROG=1,SUBR=2 * INT.FUNCTION=3,REAL FUNCT=4 * OPT - OPTION FLAGS: 0 FOR NONE * ORDER: LIST,ASMBLY LIST,BINARY TILT CLA,RSS STOP NOP JSB .STOP * SKP * .CON0 OCT 0 O1 OCT 1 O2 OCT 2 O3 OCT 3 O4 OCT 4 O5 OCT 5 O6 OCT 6 O7 OCT 7 O10 OCT 10 O11 OCT 11 O12 OCT 12 O14 OCT 14 O16 OCT 16 O17 OCT 17 O20 OCT 20 O21 OCT 21 O22 OCT 22 O23 OCT 23 O24 OCT 24 O25 OCT 25 O31 OCT 31 O32 OCT 32 O34 OCT 34 O35 OCT 35 O40 OCT 40 M1 OCT -1 M2 OCT -2 M3 OCT -3 M4 OCT -4 M5 OCT -5 * AEBAS BSS 1 ASF ERASABLE STORAGE BASE ADDR. BCLIS BSS 1 FWA OF CONLIST CLEN BSS 1 COMMON LENGTH CNSIZ BSS 1 MAX.SIZE OF CONSTANTS AREA COo DE BSS 1 CSBAS BSS 1 CONSTANTS BASE ADDR. ENTAD BSS 1 ENTRY POINT ADDR. ERBAS BSS 1 PROG ERAS.STORAGE BASE ADDR .EXTS DEF HEXTS SYMBOL TABLE SEARCH & INSERT C1A DEF CREP1 C2A DEF CREP2 LABAS BSS 1 LABEL REF BASE ADDR. LDVL BSS 1 LWA+1 OF DVLIST LVBAS BSS 1 BASE OF LOC.VAR.AREA LVSIZ BSS 1 SIZE OF LOC.VAR AREA AESIZ BSS 1 SIZE OF ASF ERAS AREA ERSIZ BSS 1 SIZE OF PROG ERAS AREA LBSIZ BSS 1 SIZE OF LABEL REFS AREA MBUF BSS 40 READ BUFFER FOR FTN MIDDLE OUTP MBUF1 DEF * LWA+1 OF READ BUFFER MBUFF DEF MBUF FWA OF READ BUFFER READB DEF READL ENTRY TO READ ROUTINE PARM BSS 1 NUMBER OF FORMAL PARAMETERS PASS OCT 1 PASS-FLAG FOR CREP * 1=PUNCH, 2=LIST ASMB, 3=BOTH PLEN BSS 1 PROGRAM LENGTH RELAD BSS 1 CALUE OF REL.ADDR.FOR WHICH RELC BSS 1 RELOC.CODE:0=ABSOL,1=PROG RELOC, * 3=COMMON RELOC, 4=EXT RFLAG BSS 1 FLAG FOR READB. =0 FOR INIT.CALL SAVAD BSS 1 SAVOR BSS 1 FWA OF FORMATS-SAVE AREA SAVND BSS 1 CURRENT ADDR.IN SAVE AREA TCLIS BSS 1 CURRENT ADDR.IN CONLIST XTORD BSS 1 CURRENT EXT ORDINAL IFWAM BSS 1 DUMMY LOCATION IWRDS BSS 1 " " IWS BSS 1 " " IFWAS EQU SAVOR FWAM FOR SEGMENT 2 SKP * *CNASC CONVERTS AN INTEGER LT 32K TO ASCII.A=NUMBER *AT ENTRY. * CNASC NOP LDB WM10K -10000D JSB WGETD GET UPPER DIGIT ADB W6060 CONVERT TO ASCII STB CNASC,I RETURN UPPER 2 DIGITS IN LOC. * FOLLOWING CALL ISZ CNASC BUMP RETURN ADDR. LDB WM1K -1000D JSB WGETD GET 2ND DIGIT BLF,BLF SHIFT TO UPPER 8 BITS STB CNBUF SAVE LDB WM100 -100D JSB WGETD GET 3RD DIGIT ADB CNBUF ADD 2ND DIGIT IN ADB W6060 CONVERT TO ASCII STB CNBUF SAVE LDB WM10D -10D JSB WGETD GET 4TH AND 5TH DIGIT BLF,BLF ADB 0 ADB W6060 B= ASCII OF 4TH AND 5TH DIGIT LDA CNBUF A= ASCII OF 2ND AND 3RD DIGIT JMP CNASC,I EXIT * SKP *CNOCT CONVERTS A NUMBER IN A TO OCTAL ASCII **** * CNOCT NOP RAL STA 1 SAVE IN B AND O1 ALF,ALF STA CSAVE+1 SAVE SIGN DIGIT JSB OCDIG GET OCTAL DIGIT IN A ADA CSAVE+1 ADD SIGN DIGIT ADA W6060 CONVERT TO ASCII STA CNOCT,I RETURN THRU RETURN ADDR ISZ CNOCT BUMP RETURN ADDR JSB OCDIG 3RD DIGIT ALF,ALF STA CSAVE+1 SAVE JSB OCDIG 4TH DIGIT ADA CSAVE+1 STA CSAVE+1 JSB OCDIG 5TH DIGIT ALF,ALF STA CSAVE+2 JSB OCDIG 6TH DIGIT ADA CSAVE+2 LDB 0 LDA CSAVE+1 ADA W6060 CONVERT TO ASCII ADB W6060 JMP CNOCT,I EXIT * OCDIG NOP LDA 1 RAL,RAL RAL STA 1 AND O7 MASK OCTAL DIGIT JMP OCDIG,I SKP * *FIND NEXT DVL ENTRY **** *ENTER A=LOC DVL EXIT A=LOC NEXT ENTRY *** * NENT NOP LDB 0 JSB NXDVL LDA 1 JMP NENT,I * BSS 1 NXDVL NOP B CONTAINS DVL LOC LDA 1,I FIRST ENTRY SZA ZERO MEANS LABEL ENTRY JMP *+3 ADB O4 LENGTH OF LABEL ENTRY JMP NXDVL,I AND O7 INA ARS ADA O2 STA NXDVL-1 LDA 1,I SSA,RSS JMP NXDV1 NOT DIMEN INB RAL SSA INB ARS ALF,ALF AND O77 SZA,RSS INB NXDV1 ADB NXDVL-1 COUNT ORD JMP NXDVL,I ** ** WGETD NOP STB CSAVE+1 SAVE COMPARISON VALUE CLB 0 TO DIGIT WGTD1 STA CSAVE SAVE REMAINDER ADA CSAVE+1 COMPARE SSA ' LARGER ? JMP WGTD2 NO,READY ISZ 1 YES,BUMP DIGIT JMP WGTD1 CONTINUE WGTD2 LDA CSAVE A=REMAINDER JMP WGETD,I EXIT SKP * *SCATR SCATTERS A SYMBTAB ENTRY FOR WHICH THE BETA *FORMAT IS GIVEN IN A. IT RETURNS: A= ADDR.+1 OF *ENTRY IN SYMBTAB, B= NO.OF WORDS IN NAME OF ENTRY+1 *OTHER VALUES THROUGH PARAMETERS. * SCATR NOP LDB 0 FORMAT TO A FOR WPFAD JSB WPFAD CMA,INA STA CSAVE SET COUNT LDA FDVL FWA OF DVLIS JSB NENT GET FWA OF NEXT ENTRY ISZ CSAVE READY? JMP *-2 NO,GET NEXT ENTRY STA CSAVE YES, SAVE FWA OF ENTRY INA STA CSAVE+1 SAVE FWA+1 LDA CSAVE,I 1ST WORD IN ENTRY RAL,RAL AND O3 STA V SET V-FIELD ADA M3 STA SSAVE SAVE FLAG LDA CSAVE,I AND O7 GET NO. OF CHARS. ADA O3 ARS STA SSAVE+1 SAVE NO.OF WORDS+1 IN NAME ADA CSAVE+1 A=ADDR. OF ORD LDB 0,I STB ORD SET ORDINAL INA LDB 0,I STB DIM1 ISZ SSAVE INA NO,BUMP ADDR.TO NEXT LOC LDB 0,I STB DIM12 LDA CSAVE,I ALF,ALF AND O77 STA PARAM PARAM NO. LDA CSAVE,I AND O20 STA T T-FIELD VALUE (0 OR 20B) LDA CSAVE,I AND O10 STA CFLAG C-FIELD VALUE (0 OR 10B) LDA CSAVE,I ALF,ALF RAL,RAL AND O3 STA F F-FIELD VALUE (0-2) LDA CSAVE+1 A= ADDR.OF ENTRY +1 LDB SSAVE+1 NO.OF WORDS+1 IN NAME JMP SCATR,I EXIT * WPFAD NOP LDA 1 AND MO100 SAVE UPPER 10 BITS ALF,ALF RAL,RAL SHIFT L 10 JMP WPFAD,I EXIT * V BSS 1 V-FIELD VALUE:0 THRU 3 PARAM BSS 1 FORM.PARAM NUMBER:1 THRU 63, OR 0 F BSS 1 F-FIELD VALUE:0 THRU 2 T BSS 1 TYPE:0=INTEGA{ER,20B= REAL CFLAG BSS 1 COMMON-BIT: 1=COMMON, 0=PROG ORD BSS 1 REL.PROG.ADDR.OF FWA OF ARRAY DIM1 BSS 1 VALUE OF 1ST DIMENSION DIM12 BSS 1 DIM1 * DIM2 CSAVE BSS 2 CNBUF BSS 1 SSAVE BSS 2 GENC. DEF GENCO SKP * *JUMP TABLE FOLLOWS **** W2TAB DEF *,I DEF W2LDA 1 LDA DEF W2LAC 2 LAC DEF W2ADA 3 ADA DEF W2MIN 4 SUB DEF W2CMA 5 CMA,INA DEF W2STA 6 STA DEF W2JSE 7 EXT,JSB DEF W2DEF 10 DEF DEF W2JMP 11 JMP LOC. DEF W2OCT 12 OCT DEF W2MPY 13 MPY DEF W2DIV 14 DIV DEF W2JMP JMP DEF W2SZA 16 SZA DEF W2ENT 17 PROGRAM ENTRY DEF W2SSA 20 SSA DEF W2INA 21 INA DEF W2CLA 22 CAL DEF *,I 23 DEF WPUT2 24 END,GO ON TO SYMBOL TABLE DEF *,I 25 DEF *,I 26 DEF W2JSI 27 JSB LOC. (ASF) DEF W2ALS 30 ALS DEF W2FOR 31 FORMAT DEF W2BSS 32 BSS DEF *,I 33 DEF *,I 34 DEF W2LDB 35 LDB DEF W2DLD 36 DOUBLE LOAD:DLD DEF W2DLC 37 DOUBLE LOAD COMP:DLC DEF W2FAD 40 FAD OR: *** SYMBOL TABLE *** DEF W2FSB 41 FSB DEF W2FCM 42 FCM (FLOATING COMP.) DEF W2DST 43 DST: DOUBLE STORE DEF W2RPI 44 R**I DEF W2RPR 45 R**R DEF W2IPI 46 I**I DEF *,I 47 DEF W2FMP 50 FMP DEF W2FDV 51 FDV DEF W2RSI 52 REAL TO INT. STORE DEF W2ISR 53 INT.TO REAL STORE SKP * W2REL NOP JSB READB,I READ 2ND WORD OF OPND. ADA M1 COMPENSATE ORDINAL STARTS AT 1 STA RELAD OPERAND VALUE CLA,INA STA RELC PROG.BASE LDA PCODE ALF,ALF AND O77 ADA *+2 JMP 0,I DEF *+1,I * DEF W2ABS ABSOLUTE DEF W2PAD PROGݱ. ADDR. DEF W2LAB LABEL REF DEF W2LVR LOCAL VAR REF DEF W2ICS INT.CONST DEF W2COM COMMON REF DEF W2PER PROG.ERAS DEF W2AER ASF ERAS DEF W2RCS REAL CONST DEF W2PAR PARAM.REF * W2LAB LDA LABAS LABEL BASE W2RLC ADA RELAD ADD REL.ADDRESS JSB FIXAD CORRECT ADDR FOR INDIR.REFS STA RELAD SET REL.ADDR. JMP W2REL,I EXIT * W2LVR LDA LVBAS LOC.VAR.BASE JMP W2RLC * W2ABS ISZ RELAD BUMP TO ORIGINAL VALUE NOP CLA STA RELC ABSOL.RELOCATION JMP W2REL,I EXIT * WUP8 OCT 37400 PCODE BSS 1 PUTAWAY 1ST WORD POPCD BSS 1 PUTAWAY OPCODE WCOUN BSS 1 COUNTER VAROP BSS 1 DEF OR STA OPCODE MICOP OCT 3004 CMA,INA OCT 2002 SZA OCT 2020 SSA OCT 2004 INA OCT 2400 CLA OCT 1200 ALS BSS 1 AVAILABLE SKP * * *************************************************** * * BASIC EXTERNAL FUNCTIONS/NAMES TABLE * FXTBL DEF *+1 STOP 00B ASC 3,.STOP DEF *+1 RTOI 04B ASC 3,.RTOI DEF *+1 RTOR 10B ASC 3,.RTOR DEF *+1 ITOI 14B ASC 3,.ITOI DEF *+1 DLC 20B ASC 3,..DLC DEF *+1 FCM 24B ASC 3,..FCM DEF *+1 IFIX 30B ASC 3,IFIX DEF *+1 FLOAT34B ASC 3,FLOAT * DEF *+1 FMP 40B ASC 3,.FMP DEF *+1 FDV 44B ASC 3,.FDV DEF *+1 FAD 50B ASC 3,.FAD DEF *+1 FSB 54B ASC 3,.FSB * EAOPS OCT 100200 EAU-CODE FOR MPY OCT 100400 DIV OCT 104200 DLD OCT 104400 DST SKP * * *************************************************** * * FIXAD NOP FIXAD ADJUST THE ADDR.IN A IF IT LDB RELAD IS LT.0 AND RETURNS THE CORRECT * ADDR.FOR INDIR.REF IN A SSB,RSS INDIRECT REF ? JMP FIXAD,I NO,RETURN CMB,INB ABSOL VALUE RBL *2 ADA M2 -2 TO COUNTERACT PREV -1 ADA 1 ADD IN PREVSLY.COMPUTED ADDR CMA,INA,SZA,RSS COMPLMNT FOR IND.REF. LDA IBIT FOR 0,I REF. JMP FIXAD,I SKP * *GENERATES DEF-S FOR FWA OF ARRAYS **** * GNDEF NOP JSB READB,I READ BSS JSB READB,I READ:-NO.OF DEF-S SZA,RSS 0 ? JMP GNDEF,I YES,EXIT STA WCOUN NO,SET COUNT LDA O10 10B FOR DEF. STA CODE SET OPCODE GLOOP LDA O100 100B=ORD. 1 IN DVLIST STA ORDSV CLB,INB STB RELC SET PROG.RELOC. JSB SCATR SCATTER DVLIST ENTRY LDB V V-FIELD VALUE ADB M2 SSB ARRAY ? JMP GNDF1 NO LDB PARAM YES LDA 0,I FWA OF ARRAY FOR NON-PARAMS SZB PARAMETER ? JMP GNDF1 YES ADA M1 STA RELAD SET ADDR.FOR CREP LDA CFLAG SZA,RSS COMMON ? JMP *+3 NO ISZ RELC ISZ RELC SET TO COMMON BASE = 3 JSB .EXTS+2,I GENERATE DEF ISZ WCOUN READY ? RSS NO,CONTINUE JMP GNDEF,I YES,EXIT GNDF1 LDA ORDSV ADA O100 BUMP ORDINAL BY 1 JMP GLOOP+1 NEXT ARRAY * ORDSV BSS 1 SKP * *CEQS SEARCHES CONLIST FOR A CONSTANT IN A. BCLIS= *FWA OF CONLIST, TCLIS= TOP OF CONLIS+1.ENTER WITH *A= VALUE,B= ADDR.IN CONLIST * CEQS NOP CPB TCLIS TOP OF CONLIS+1 ? JMP CEQS1 YES,NOT FOUND CPA 1,I EQUALITY ? JMP CEQS,I YES,NORMAL EXIT INB NO JMP CEQS+1 CONTINUE SEARCH CEQS1 ISZ CEQS BUMP FOR JMP CEQS,I ALTERNATE RETURN * ICEQS NOP LDB BCLIS BOTTOM OF CONLIST JSB CEQS SEGARCH FOR CONST JMP *+3 FOUND STA 1,I NOT FOUND,ENTER CONSTANT ISZ TCLIS BUMP TCLIS LDA BCLIS CMA,INA ADA 1 REL.ADDR.IN CONLIST JMP ICEQS,I EXIT SKP * *REAL CONSTANT SEARCH ROUTINE **** * RCEQS NOP STA CSAVE STB CSAVE+1 LDB BCLIS RCEQ2 JSB CEQS SEARCH FOR UPPER PART JMP RCEQ1 FOUND,TEST LOWER PART RCEQ3 STA 1,I NOT FOUND,ENTER UPPER PART ISZ TCLIS LDA CSAVE+1 STA TCLIS,I ENTER LOWER PART ISZ TCLIS BUMP TCLIS RCEQ4 LDA BCLIS CMA,INA ADA 1 REL.ADDR.IN CONLIST JMP RCEQS,I * RCEQ1 INB CPB TCLIS END OF CONLIST ? JMP RCEQ3 YES,ENTER CONST LDA CSAVE+1 NO,COMPARE LOWER PART CPA 1,I JMP *+3 EQUALITY LDA CSAVE NO EQUALITY,CONTINUE SEARCH JMP RCEQ2 ADB M1 -1, RESET AT ADDR OF UPPER PART JMP RCEQ4 FINISH UP SKP * * **************************** * * CREP DATA AND TABLE AREA * * **************************** * HLN EQU 64 SET EXT TABLE LENGTH(193) A EQU 0 A REGISTER B EQU 1 B REGISTER * MO100 OCT -100 WM10K DEC -10000 WM1K DEC -1000 WM100 DEC -100 WM10D DEC -10 W6060 OCT 30060 CONVERSION FACTOR TO ASCII * MD14 DEC -14 O210 OCT 210 FWA MASK MD54 DEC -54 O77 OCT 77 SET LOW MASK FOR XTORD O100 OCT 100 O377 OCT 377 .UMSK OCT 177400 WORD MASK (UPPER HALF) O200 OCT 200 FOR EXT TEST CMTSZ BSS 1 SIZE OF COMMENTS IN NAM IBIT OCT 100000 INDIRECT BIT SKP * * READB INPUT ROUTINE IN PASS 2 * ***************************** * READL NOP LDB PNT02 INITIALIZE FMP ERROR STB NAME FILE NAME POINTER LDA RFLAG SZA IS THIS THE FIRST TIME JMP MRDB2 NO ,JUMP RENXT EQU * LDA MDM46400 YES, A = WORD COUNT OF 40 JMP PTAPE NO TP.RD LDA MBUF AND O77 * CPA O3 RSS JMP MRDB1 JSB MCKSM CLA,INA STA RTEMP * JSB READF READ A DEF *+6 RECORD FROM DEF IDCB3 INTERMEDIATE DEF ERRS CODE IN DEF MBUF SCRATCH FILE DEF RTEMP DEF LENS SSA ERROR OCCUR? JMP FMPER YES.REPORT IT LDA LENS NO.GET CPA M1 AN EOF? JMP FMPER YES.EOS.ERROR HERE JMP RENXT * MRDB1 CPA O1 IS THIS TYPE 1, PUTAWAY JMP CONT. YES, CONTINUE 6 LDA O7 NO, RECORD UNRECOGNIZABLE JSB STOP JMP RENXT CONT. JSB MCKSM CALL CHECKSUM LDA MBUFF ADA O3 STA MIND1 INITIALIZE BUFFER LOCATOR LDA MBUF+2 LOAD 1ST DATA WORD JMP READL,I RETURN * MRDB2 LDA MIND1 CPA MBUF1 IS THE BUFFER EXHAUSTED JMP RENXT YES,READ NEXT RECORD LDA MIND1,I NO , OBTAIN NEXT WORD ISZ MIND1 INCREMENT BUFFER LOCATOR JMP READL,I RETURN * PTAPE CMA,INA STA RTEMP JSB READF READ DEF *+6 SCRATCH DEF IDCB3 FILE DEF ERRS RECORD DEF MBUF DEF RTEMP DEF LENS SSA ERROR OCCUR? JMP FMPER YES.REPORT IT LDA LENS NO.GET CPA M1 AN EOF? JMP FMPER YES.EOS.ERROR HERE * JMP TP.RD NO * RTEMP NOP LENS NOP SKP * * * ****CHECKSUM SUBROUTINE**** * THIS ROUTINE IS CALLED WITH THE BINARY RECORD * TO BE CHECKED IN MBUF. IT OBTAINS THE NO. OF WORDS * IN THE RECORD FROM THE 1ST WORD OF THE RECORD & SUMS * ALL OF THESE. THE 2ND WORD OF THE RECORD CONTAINS * THE TWOS COMPLEMENT OF THE SUM. THUS THE SUMMATION * YIELDS ZERO IF THE INPUT IS CORRECT. * MCKSM NOP LDA MBUF AND .UMSK ISOLATE MS 8 BITS OF 1ST WORD ALF,ALF SHIFT TO LS BITS LDB MBUFF STB MINA1 INITIALIZE WORD ADDRESS CMA,INA STA MINA2 INITIALIZE WORD COUNTER CLB ADB MINA1,I ADD NEXT WORD ISZ MINA1 ISZ MINA2 JMP *-3 SZB,RSS IS SUM =0? JMP MCKSM,I YES, RETURN LDA O11 NO, ERROR JSB STOP SYSTEM STOP 11 * MIND1 OCT 0 MINA1 OCT 0 MINA2 OCT 0 MDM40 DEC -40 * SKP HADDR DEF * NOP * * MNEMONIC INSTRUCTION TABLE * .MT DEF * DEF .MxT+13B LDA CODE +1 DEF .MT+57B ADA CODE +2 ASC 2,JMP JMP OCT 26000 * DEF .MT+16B STA CODE +6 DEF .MT+21B JSB CODE +7 DEF .MT+26B DEF CODE +10 DEF .MT+3 JMP CODE +11 DEF .MT+40B OCT CODE +12 ASC 2,LDA LDA OCT 62000 * ASC 2,STA STA OCT 72000 * ASC 2,JSB JSB OCT 16000 * DEF .MT+43B END CODE +24 DEF .MT+46B TRA CODE +25 ASC 2,DEF DEF OCT 0 * .END OCT 2000 END WORD COUNT DEF .MT+51B BSS CODE +32 .EXT OCT 3000 EXT WORD COUNT .TWXM OCT 1777 FOR PURGING UPPER 6 BITS OF INST DEF .MT+54B LDB CODE +35 .UP11 OCT 177740 .LMSK OCT 377 LOWER HALF WORD MASK ASC 2,OCT OCT OCT 0 * ASC 2,END END OCT 0 * ASC 2,TRA TRA OCT 0 * ASC 2,BSS BSS OCT 0 * ASC 2,LDB LDB OCT 66000 * ASC 2,ADA ADA OCT 42000 * * *** END OF TABLE *** SKP * .R ASC 1,R R .C ASC 1,C C .X ASC 1,X X .BLNK ASC 1, BLANKS .IND ASC 1,,I ,I HZPTR DEF .CON0 PTS AT LOCN CONT. 0 HFUBP DEF HPBUF HFBP4 DEF HPBUF+4 HFFUB DEF HBUFF HEADR DEF *+1 ASC 3, PAGE PAGE HEADER HERE ASC 3, VALUE GOES HERE HPNAM BSS 3 HENDR ASC 4,*** END HSTAB ASC 7, SYMBOL TABLE * * * TEMPORARY REGION * * HCNTR NOP BIN.REC.WORD COUNTER (HPNCH) (HBREC) HINST NOP CURRENT INSTRUCTION FORMAT HLINC NOP 2'S COMP. CURRENT LINE COUNT HLST NOP HNUMB NOP HPAGE NOP CURRENT PAGE NO. HPLCN NOP PROG.LOCN. CNTR. VALUE HRCNT NOP RELOC.BYTE CNTR FOR PARAM WORD (HBREC) HSVST NOP CONTAINS ADDR.OF RELOC.BYTE PARAM.(") HSTOR NOP NEXT AVAIL.LOC IN DBL BUFFER (HBREC) HSAVA NOP HSAVB NOP HMANP DEF HPNAM HBATS DEF HSTAB HENDX DEF HENDR HPBUF BSS 60 PUNCH BUFFAER HBUFF BSS 14 LIST BUFFER SKP * * *********************************************** * * HINSR: MOVE A SYMBOLIC NAME FROM THE SYMBOL * * * TABLE TO A DESIGNATED AREA. * * * ENTRY - A CONTAINS THE ADDRESS OF THE * * * DESIGNATED AREA * * * - B REG. CONTAINS THE FWA OF THE * * * SYMBOL TABLE ENTRY * * *********************************************** * HINSR NOP STA HSAVA SET ADDR.OF RECVNG.AREA LDA B,I AND O7 GET NO. OF CHARS IN THE NAME ADB O2 B POINTS AT 1ST 2 CHARS STB HNUMB LDB HNUMB,I STB HSAVA,I STORE 1ST 2 CHARS OF NAME. ADA M3 A-3 SSA IS NAME MORE THAN 2 CHARS? JMP HNSR NO, GO TEST FOR BLANK INSERT * ISZ HNUMB ISZ HSAVA LDB HNUMB,I STB HSAVA,I STORE NEXT 2 CHARS OF NAME ADA M2 A - 2 SSA IS NAME MORE THAN 4 CHARS ? JMP HNSR NO, GO TEST FOR BLANK INSERT * ISZ HNUMB ISZ HSAVA LDB HNUMB,I STB HSAVA,I STORE 5TH CHAR OF NAME. * * *SET LOWER CHAR BLANK, IF=0 * * HNSR LDA B AND .LMSK SZA IS LOWER CHAR = 0 ? JMP HINSR,I NO - EXIT ADB O40 YES - INSERT BLANK STB HSAVA,I JMP HINSR,I SKP * * **************************************** * * HMOCT: GET ASCI EQUIVALENT OF SYMBOL * * * VALUE, PLACE IN TABLE BUFFER * * * FOR OUTPUT. * * * B REG = ADDR-1 OF VALUE * * **************************************** * HMOCT NOP INB ADDRESS OF VALUE LDA B,I VALUE TO A JSB CNOCT CONVERT VALUE TO OCTAL ASCI NOP MOST SIG. DIGITS  STA HBUFF+5 MIDDLE SIG, DIGITS STORED STB HBUFF+6 LEAST SIG. DIGITS STORED LDA *-3 PICK UP MOST SIG.DIGITS STA HBUFF+4 STORE THEM JMP HMOCT,I RETURN TO PROGRAM SKP * * * ********************************************* * * HPNCH: PROCESSES BINARY RECORD FOR OUTPUT * * * - COMPUTES CHECKSUM * * * - GOES TO PUNCH DRIVER * * ********************************************* * HPNCH NOP LDB HFUBP ADDRESS OF PUNCH BUFFER LDA HPBUF ALF,ALF STA ILO POSITIVE WORD COUNT CMA,INA STA HNUMB SET NO. OF WORDS FOR PUNCH DRIVER INA STA HCNTR SET CHECKSUM COUNTER CLA STA HPBUF+2 CLEAR CHECKSUM ADDR. * * * COMPUTE CHECKSUM HERE * * ISZ B BUMP PUNCH BUFFER ADDR ADA B,I ISZ HCNTR JMP *-3 STA HPBUF+2 STORE CHECKSUM * * * GO TO PUNCH RECORD * * JSB WRITF WRITE DEF *+5 RECORD DEF IDCB1 TO THE DEF ERRS OUTPUT DEF HPBUF FILE DEF ILO SSA ERROR OCCUR? JMP FMPER YES.REPORT IT * CLA STA HPBUF CLEAR WORD COUNT JMP HPNCH,I EXIT HERE * ILO NOP ERRO NOP SKP * * * * ********************************************** * * HLINE: SKIPS N LINES ON LIST OUTPUT DEVICE * * * - N = 2'S COMPL. OF NO.OF LINES * * * - N IS IN A ON ENTRY * * * - HLINE USES PRINT DRIVER * * ********************************************** * HLINE NOP STA HNUMB SAVE COUNT CLA JSB LIST ISZ HNUMB JMP *-3 JMP HLINE,I EXIT * SKP * ***************************************** * * HOUTP: PROCESS AN OUTPUT UNIT * * * - SEND BIN. WORD TO PUNCH BUFFER * * * - PRINT A LINE OF CORRESPONDING * * * OUTPUT * * * - ADDS 1 TO THE PROG. LOCN. CNTR.* * * - A=0, DON'T PROCESS ADDRESS * * * DURING HLIST * * * A=1, PROCESS ADDR DURING HLIST* * ***************************************** * HOUTP STA HLST SAVE ADDRESS CONV.FLAG CLB,INB SET B=1 JSB HBREC * JSB HLIST ISZ HPLCN BUMP PROG.LOCN.CNTR. JMP CREP2,I EXIT FROM CREP SKP * * *********************************** * * HLIST: SET UP LIST PARAMETERS * * * -LOCATION * * * -INSTRUCTION * * * -OPCODE * * * -ADDRESS (HLST=0, SYMBOLIC * * * HLST=1, OCTAL ) * * *********************************** * HLIST NOP LDA PASS CPA O1 PUNCH ONLY? JMP HLIST,I YES,EXIT LDA OPT+1 CHECK FOR THE "T" OPTION. CPA ...T JMP HLIS2 T OPTION BUT MIGHT HAVE A ALSO HLIS3 EQU * LDA HLST SZA,RSS SYMBOLIC ADDRESS IN ALREADY? JMP HLIS1 -YES, SKIP OCTAL CONVERSION LDA RELAD ADDRESS JSB CNOCT GO TO OCTAL CONV. NOP MOST SIGNIF. DIGITS HERE STA HBUFF+11 LDA *-2 STA HBUFF+10 STB HBUFF+12 * HLIS1 LDA HPLCN CONVERT LOCATION JSB CNOCT NOP STA HBUFF+1 LDA *-2 AND .LMSK ADA .RIC1 SET BLANK OVER MOST SIG. DIG. (COL 1) STA HBUFF STB HBUFF+2 LDA HINST CONVERT INSTRUCTION JSB CNOCT NOP STA HBUFF+5 LDA *-2 STA HBUFF+4 STB HBUFF+6 7 LDA O34 28 CHAR. FOR OUTPUT LDB HFFUB JSB HPRNT GO TO PRINT SR JMP HLIST,I EXIT LIST ROUTINE HLIS2 EQU * LDA OPT4 ALSO HAVE SZA THE A OPTION? JMP HLIS3 YES.CONTINUE JMP HLIST,I NO SKP * * ********************************* * * HPRNT: PRINT A LINE OF OUTPUT * * * - COUNTS LINES (HLINC) * * * - COUNTS PAGES (HPAGE) * * * - SETS UP PAGE HEADER AT * * * START OF A PAGE * * ********************************* * HPRNT NOP STA HSAVA STB HSAVB ISZ HLINC END OF A PAGE ? JMP HPRN1 NO, SKIP PAGE PROCESSING * * * PAGE PROCESSOR * * LDA LINES STA HLINC RESET LINE COUNTER CCA JSB LIST EJECT PAGE HPRN2 ISZ HPAGE BUMP PAGE COUNTER LDA HPAGE JSB CNASC CONVERT PAGE NUMBER NOP STA HEADR+4 STB HEADR+5 LDA O22 18 CHAR. LDB HEADR ADDR.OF HEADER JSB LIST PRINT LINE LDA M2 JSB HLINE * HPRN1 LDA HSAVA LDB HSAVB JSB LIST PRINT LINE JMP HPRNT,I EXIT HERE * LIST NOP STA SAVE1 SAVE A-REG LDA PNT03 INITIALIZE FMP ERROR STA NAME FILE NAME POINTER LDA SAVE1 RESTORE A-REG SSA JMP PEJ SZA,RSS JMP PSKP CMA,INA STA PBUFL STB PBUFF JSB WRITF WRITE A DEF PLST1 RECORD DEF IDCB2 TO THE DEF ERRS LIST FILE PBUFF BSS 1 DEF PBUFL PLST1 EQU * SSA ERROR OCCUR? JMP FMPER YES.REPORT IT JMP LIST,I * PBUFL NOP * * PSKP CLA,INA PEJ STA PPRAM JSB FCONT DO A DEF PSKP1 PAGE DEF IDCB2 EJECT DEF ERRS OR SKIP DEF PCNW1 CW PAGE DEF PPRAM PSKP1 EQU * SSA,RSS ERROR OCCUR? JMP LIST,I NO.RETURN LDA ERRS YES.IS IT CMA,INA FMP ERROR CPA O14 -012 JMP LIST,I YES.IGNORE IT JMP FMPER NO.REPORT FMP ERROR * PCNW1 OCT 1100 PPRAM NOP SAVE1 NOP TEMPORARY STORAGE PNT03 DEF AL+1 LINK TO LIST FILE NAME * SKP * ****************************************************** * * HBREC: ADD AN INSTRUCTION TO THE BINARY DBL RECORD * * * OR, OUTPUT A BINARY DBL RECORD. * * * - FURNISHES RELOCATION BYTES FOR THE LOADER * * * - SETS UP THE INST.FORMAT TO BCS LOADER SPECS * * * - ON ENTRY: B = 0, OUTPUT A RECORD * * * - B = 1, ADD AN INST. TO THE RECORD * * ****************************************************** HBREC NOP LDA PASS CPA O2 LIST ONLY? JMP HBREC,I YES, EXIT LDA HPBUF SZB PUNCH A RECORD? (B=0) JMP HBRC2 -NO,GO TO INSERT AN INSTRUCTION. * * * BINARY RECORD OUTPUT * * SZA,RSS IS BUFFER EMPTY? JMP HBREC,I -YES- EXIT * HBRC1 LDA HPBUF WORD COUNT IN A REG ALF,ALF POSITION IT FOR OUTPUT STA HPBUF LDA HSVST,I POSITION THE REMAINING RELOC. * BYTE PARAM. WORD ALF,RAR ISZ HRCNT JMP *-2 RAL STA HSVST,I STORE IT INTO RECORD * JSB HPNCH GO TO BINARY OUTPUT ROUTINE JMP HBREC,I EXIT HBREC HERE * * * INSERT AN INSTRUCTION * * HBRC2 SZA IS THE FIRST WORD GOING IN? JMP HBRC3 NO LDA HPLCN YES,INITIALIZE. STA HPBUF+3 SET DBL LOAD ADDRESS LDA O4 STA HPBUF SET INITIAL WORD COUNT = 4. LDA .RIC3 STA HPBUF+1 SET REC.IDENT.CODE (RIC) LDA HFBP4 STA LHSTOR SET ADDR.OF NEXT BUFFER LOC. LDA M5 STA HRCNT SET RELOC.BYTE COUNTER LDA MD54 STA HCNTR SET WORD COUNTER = 54 WORDS * HBRC3 LDA HRCNT INITIALIZE REL.BYTE PARAM.WORD? CPA M5 JMP *+2 -YES JMP *+7 -NO- SKIP INITIALIZATION LDA HSTOR STA HSVST SET ADDR.OF RELOC.BYTE PARAM. ISZ HSTOR BUMP PNTR ADDR. ISZ HPBUF BUMP BLOCK WORD COUNT CLA STA HSVST,I CLEAR RELOC.BYTE PARAMETER * * * PROCESS RELOC.BYTE PARAMETER * * LDA HSVST,I PLACE ALF,RAR CURRENT IOR RELC RELOC.BYTE STA HSVST,I INTO PARAMETER ISZ HPBUF+1 ADD 1 TO DATA WORD COUNTER * ISZ HRCNT IS PARAMETER WORD FULL? (5 BYTES) JMP HBRC4 -NO LDB M5 -YES, RESET COUNT & STORE WORD STB HRCNT SET HRCNT = -5 RAL STA HSVST,I STORE FINAL PARAM.WORD * LDA HCNTR CPA M1 HCNTR=-1 (NEAR END OF RECORD)? JMP *+2 YES - DON'T BUMP IT ISZ HCNTR NO - ADD 1 TO IT * HBRC4 LDB HINST STB HSTOR,I PLACE INST INTO RECORD ISZ HSTOR UPDATE STORAGE ADDRESS ISZ HPBUF AND WORD COUNT LDA RELC CPA O5 RELOC. BYTE INDICATE 2 WORD ENTRY? JMP *+4 YES * HBRC5 ISZ HCNTR END OF A RECORD? JMP HBREC,I NO - EXIT JMP HBRC1 YES - GO TO OUTPUT THE RECORD. * * * PROCESS A 2 WORD RELOC.ENTRY * * ISZ HPBUF ADD 1 TO RECORD WORD COUNT. LDA RELAD ADDRESS TO A STA HSTOR,I PLACE IT INTO NEXT LOCN. IN RECRD. ISZ HSTOR ADD 1 TO STORAGE ADDRESS AND .TWXM CLEAR UPPER 6 BITS OF ADDRESS BRS,BRS BLS,BLS CLEAR LOWER 2 BITS OF INSTRUCTION IOR B 'OR' THEM TOGETHER STA HINST SET UP INSTRUCTION FOR LIST OUTPUT ISZ HCNTR - END OF A RECORD? JMP HBRC5 - NO GO TO EXIT UPDATE AND TEST JMP HBRC1 - YES,GO TO OUTPZUT RECORD * SKP * ***************************************************** * * FORTRAN ASSEMBLY AND RELOCATABLE TRANSLATOR * * * WJ HOLDEN: OCTOBER 1966 * * * FUNCTIONS: * * * 1. ASSEMBLY LISTING OF BINARY OUTPUT * * * 2. PUNCHING OF A RELOCATABLE BINARY * * * PROGRAM TAPE * * 3. PRINT OUT OF THE SYMBOL TABLE * * * INPUT PARAMETERS: * * * PASS =1 PUNCH ONLY * * * =2 LIST ONLY (INCLUDES SYMBOL TABLE)* * * =3 PUNCH AND LIST * * * RELC - RELOCATION ODE - * * * =0 ABSOLUTE * * * =1 RELOCATABLE * * * =3 COMMON * * * =4 EXTERNAL SYMBOL * * * RELAD - ADDRESS OR EXT SYMBOL ORDINAL - * * * CODE - OPCODE ORDINAL - * * * LINKAGE: * * * INITIAL ENTRY - P JSB CREP1 * * * P+1 RETURN * * * SUBSEQUENT * * * ENTRYS P JSB CREP2 * * * P+1 RETURN * * ***************************************************** * .RIC1 OCT 20000 FOR NAM RIC .ENT OCT 3400 FOR ENT WORD COUNT .RIC2 OCT 40001 FOR ENT RIC .RIC3 OCT 60100 FOR DBL RIC .RIC4 OCT 100001 FOR EXT RIC .RIC5 OCT 120000 FOR END RIC * * r<:6 CREP1 NOP CCA STA HLINC SET INITIAL LINE COUNTER VALUE CLA STA HPLCN SET LOCN CNTR=0 STA HPBUF CLEAR BIN OUTPUT WORD COUNT STA HPBUF+7 CLEAR B.P.LENGTH IN 'NAM' RECORD STA HPAGE SET PAGE CNTR=0 STA XTORD SET EXT ORDINAL = 0 STA EXTBL,I SET 1ST WORD OF EXT TBL = 0 LDB .BLNK PREPARE PROGRAM NAME BUFFER STB HPNAM+1 STB HPNAM+2 LDB FDVL WORD 1 OF PROG NAME ENTRY LDA HMANP JSB HINSR GO MOVE NAME TO PNAME BUFFER * LDA PASS CPA O2 PASS = LIST ONLY? JMP CREP1,I YES - SKIP BINARY * * * * OUTPUT 'NAM' RECORD * * LDA O21 SET LENGTH OF NAM RECORD ADA CMTSZ INCLUDING COMMENTS ALF,ALF STA HPBUF SET WORD COUNT LDA .RIC1 STA HPBUF+1 SET 'NAM' RECRD IDENT CODE LDA PLEN IOR IBIT STA HPBUF+6 SET PROGRAM LENGTH LDA CLEN STA HPBUF+8 SET COMMON LENGTH LDA HPNAM SET PROGRAM NAME STA HPBUF+3 LDA HPNAM+1 STA HPBUF+4 LDA HPNAM+2 STA HPBUF+5 $<* JSB HPNCH GO PUNCH 'NAM' RECORD * * * OUTPUT 'ENT' RECORD * * LDA .ENT STA HPBUF SET WORD COUNT LDA .RIC2 STA HPBUF+1 SET 'ENT' RECRD IDENT CODE LDA ENTAD ADDRESS OF ENTRY POINT STA HPBUF+6 SET 'ENT' ADDRESS * LDA HPBUF+5 AND .UMSK STA HPBUF+5 JSB HPNCH GO PUNCH 'ENT' RECORD JMP CREP1,I * * **** START CREP2 HERE **** * * * CLEAR LIST BUFFER * * CREP2 NOP LDA MD14 STA HNUMB SET COUNTER FOR 14 LDA .BLNK BLANKS TO A REG LDB HFFUB ADDR.OF BUFFER TO B REG STA B,I BLANKS TO MEMORY INB ISZ HNUMB DONE? JMP *-3 NO - GO BACK * * * * SET UP OPCODE NAME AND INSTRUCTION * * LDA CODE ADA .MT LDA A,I A CONTAINS LOCN OF CODE ENTRY LDB A,I B = CONTENTS OF ENTRY (1ST WORD) STB HBUFF+8 SET 1ST 2 CHARS OF OPCODE INA LDB A,I STB HBUFF+9 SET LAST CHAR OF OPCODE INA LDB A,I STB HINST SET INSTRUCTION FORMAT (OCTAL) LDB PASS SET A = PASS LDA CODE B = CODE CPA O24 END? JMP HC40 YES CPA O25 TRA? JMP HC40 YES CPA O22 EXT? JMP HC30 YES CPA O32 BSS? JMP HC20 YES * * * IT'S A REGULAR INSTRUCTION * LDB RELAD CPA O12 OCT? JMP HC16 YES * * * IT'S A MEMORY REFERENCE OR DEF INSTRUCTION * SSB,RSS IS IT INDIRECT? JMP HC04 -NO- SKIP INDIR.SETUP * CMB,INB * INDIRECT PROCESSING HERE * CPB RELAD CLB STB RELAD RESET ADDRESS LDA .IND STA HBUFF+13 SET ,I INTO LINE LDA IBIT IOR HINST PLACE INDIRECT BIT STA HINST INTO INSTRUCTION HC04 LDB RELC RELOC.BITS TO B CPB O4 IS IT EXTERNAL? K JMP HC14 YES LDA CODE CPA O10 CODE = DEF? JMP HC12 YES LDA PASS CPA O2 PASS = LIST? JMP HC13 * * * SET UP FOR 2 WORD ENTRY FOR LOADER * * LDA O5 STA RELC LDA B ADA M1 RELC-1 TO A * * CONCLUDE INST SETUP * HC08 IOR HINST STA HINST LDA .R CPB O3 COMMON RELC? LDA .C YES STA HBUFF+7 HC10 CLA,INA SET A=1 (FOR HLIST FLAG) JMP HOUTP GO TO OUTPUT LIST/PUNCH * * * DEF PROCESSOR * * HC12 LDA RELAD JMP HC08 * * * SET UP ADDRESS FOR LIST ONLY PROCESSING * * HC13 LDA RELAD AND .TWXM MASK OUT UPPER 6 BITS JMP HC08 * * * PICK UP EXT NAME ENTRY FROM TABLE * * HCREL NOP LDA RELAD PICK UP EXT ORDINAL AND O77 SZA,RSS IS IT = TO A MLTPL OF 100 OCTAL ? LDA O100 YES, SET TBL PARAMETER = 100 OCTAL LDB A BLS USE PARAM TO FIND EXT NAME IN TABLE ADB A ADB M3 3(EXT ORD.)-3 = REL LOC OF ORD. ADB EXTBL B = ADDR OF CURR.EXTERNAL SYMBOL LDA B,I STA HBUFF+10 SET 1ST 2 CHARS INB LDA B,I STA HBUFF+11 SET NEXT 2 CHARS INB LDA B,I JMP HCREL,I EXIT * * * RELC=4; PROCESS EXT NAME FOR PRINTING * * HC14 JSB HCREL AND .UMSK MASK OUT ORDINAL BITS ADA O40 INSERT BLANK STA HBUFF+12 SET LAST CHAR LDA .X STA HBUFF+7 SET RELOC. INDICATOR LDA RELAD IOR HINST STA HINST SET INSTRUCTION CLA A=0 FOR HLST FLAG (DON'T PRINT ADDRESS) JMP HOUTP * * * OCT PROCESSOR * * HC16 STB HINST JMP HC10 * * * BSS PROCESSOR * * HC20 CLB OUTPUT CURRENT BIN. RECORD JSB HBREC CLA,INA STA HLST SET LIST PARAMETER JSB HLIST LDA RELAD  ADA HPLCN BUMP LOCN CNTR BY VALUE IN RELAD STA HPLCN JMP CREP2,I EXIT CREP HERE * * * EXT PROCESSOR * * HC30 CPB O2 PRINT ONLY? JMP CREP2,I YES, EXIT CREP CLB JSB HBREC OUTPUT CURRENT BIN.RECORD LDA .EXT STA HPBUF SET EXT WORD COUNT LDA .RIC4 STA HPBUF+1 SET RECORD IDENT.CODE * * * GET EXTNAME ENTRY AND PLACE INTO BINARY RECORD * * JSB HCREL STA HPBUF+5 SET LAST WORD OF ENTRY LDA HBUFF+10 STORE REMAINING EXT NAME STA HPBUF+3 LDA HBUFF+11 STA HPBUF+4 JSB HPNCH PUNCH EXT RECORD JMP CREP2,I EXIT CREP * * * PROCESS END AND TRA CODES HERE * * HC40 CPB O2 LIST ONLY? JMP HC44 YES CLB JSB HBREC OUTPUT CURRENT BIN.RECORD * * * SET UP END BIN. RECORD * * LDA ENTAD GET ENTRY PT ADDR STA HPBUF+3 SET AS EXEC.ADDR OF END RECORD LDA .END STA HPBUF SET 'END' WORD COUNT LDA .RIC5 STA HPBUF+1 SET RECORD IDENT. CODE LDB CODE CPB O25 CODE = 'TRA'? SKIP IF NOT ISZ HPBUF+1 SET TRA ADDR.CODE JSB HPNCH PUNCH 'END' RECORD HC44 LDB PASS CPB O1 PUNCH ONLY? JMP CREP2,I YES, EXIT CREP LDB CODE CPB O24 CODE = 'END'? JMP HC46 * * * SET UP PROG.NAME FOR TRA POINT * * LDA HPNAM STA HBUFF+10 LDA HPNAM+1 STA HBUFF+11 LDA HPNAM+2 STA HBUFF+12 HC46 LDA O32 TO PRINT 26 CHARS LDB HFFUB BUFFER ORG JSB HPRNT LDB HENDX LOC OF END** LDA O10 PRINT 10 CHARS JSB HPRNT PRINT '*** END ' CCA STA HLINC SET LINE COUNT FOR TOP OF PAGE * * PRINT SYMBOL TABLE HEADER * LDB HBATS LDA O16 14 CHAR BUFFER JSB HPRNT * * *********************** *  * OUTPUT SYMBOL TABLE * * *********************** * LDA FDVL FWA OF TABLE TO A HC60 LDB .BLNK SET PORTION OF BUFF TO BLANKS STB HBUFF+1 STB HBUFF+2 STA HINST SAVE A FOR NEXT TABLE LOOKUP CPA LDVL LAST ENTRY FINISHED? JMP CREP2,I YES, GO TO SYM TABLE EXIT PROCESS LDB A,I SZB STATEMENT LABEL? JMP HC70 NO * * * PROCESS A STATEMENT LABEL (NUMERIC) * INA STA HSAVB LDA A,I STATEMENT NO. TO A JSB CNASC CONVERT IT TO DEC ASCI. NOP MOST SIGNIF. RESULT HERE STA HSAVA * * PROCESS 1ST 2 CHARS OF LABEL * LDA *-2 '01' AND .LMSK ' 1' ALF,ALF '1 ' STA HBUFF '1 ' LDA HSAVA '23' ALF,ALF '32' AND .LMSK ' 2' ADA HBUFF '12' STA HBUFF '12' 1ST 2 CHARS NOW SET * * PROCESS NEXT 2 CHARS OF LABEL * LDA HSAVA '23' AND .LMSK ' 3' ALF,ALF '3 ' STA HBUFF+1 '3 ' LDA B '45' ALF,ALF '54' AND .LMSK ' 4' ADA HBUFF+1 '34' STA HBUFF+1 '34' NEXT 2 CHARS NOW SET * * PROCESS LAST CHAR OF LABEL * LDA B '45' AND .LMSK ' 5' ALF,ALF '5 ' ADA O40 '5B' (B=BLANK) STA HBUFF+2 '5B' LAST CHARACTER SET * * * PROCESS LABEL VALUE * * LDA HSAVB INA LDB A,I ADB M1 A_A-1 STB HADDR+1 LDB HADDR JSB HMOCT LDA .R STA HBUFF+3 SET RELOC. CHAR = 'R' JMP HC80 * * * PROCESS SYMBOLIC LABEL * * HC70 LDA A,I CONT.OF 1ST WORD OF ENTRY AND O210 MASK EXT/COM BITS FOR TESTING LDB .R SET UP RELOCATION INDICATOR SZA,RSS 'R'? JMP *+4 YES, SKIP LDB .C CPA O200 'X'? JMP HC90 YES - IGNORE ENTRY ' STB HBUFF+3 STORE CHARACTER * * GO TO CONVERT AND STORE VALUE LDA HINST INA LDB A,I B*VAL SSB VAL<0 ? JMP HC75 YES ADB M1 VAL_VAL-1 LDA HINST,I A*FWA OF ENTRY AND .UP11 MASK OUT UPPER 11 BITS SZA,RSS UPPER 10 BITS = 0 ? ADB LVBAS YES HC75 STB HADDR+1 LDB HADDR JSB HMOCT * * GET LABEL AND INSERT IT INTO BUFFER LDB HINST LDA HFFUB JSB HINSR GO TO BUFFER INSERTION * * DONE WITH LABEL * * * PRINT SYMBOL TABLE ENTRY HERE * HC80 LDA O16 FOR 14 CHARS LDB HFFUB FROM BUFF JSB HPRNT HC90 LDA HINST ADDR OF CURRENT ENTRY JSB NENT GET FWA OF NEXT ENTRY JMP HC60 * SKP * ******************************************* * * EXT SYMBOL TABLE SEARCH AND INSERT * * * -C(B)= ADDR OF 3 WORD BUFFER CONTAINING * * * NAME TO BE INSERTED. * * * -IF 2ND CHAR=0 SQUEEZE UP REST OF NAME. * * * BUFFER IS 0 FILLED * * * -NAME FOUND SET RELC=4 AND RELAD=ORDINAL* * * -NOT FOUND, BUMP XTORD BY 1 * * * ASSIGN XTORD TO CURR.ENTRY * * * GENERATE EXT REC.VIA CREP2 * * * -IF XTORD=255, HALT THEN CONTINUE, DO * * * NOT BUMP IT * * * -IF TABLE FULL(>64 ENTRIES)RESTART TABLE* * ******************************************* * HEXTS NOP LDA B,I MOVE NAME TO TEST BUFFER AND STA HBUFF+10 INSERT BLANKS WHERE NEEDED JSB HCRL STA HBUFF+11 JSB HCRL STA HBUFF+12 * * TEST HERE FOR 2ND CHAR = 0 * LDA HBUFF+10 AND .LMSK SZA IS 2ND CHAR = 0 ? JMP .EXT1 NO * LDA HBUFF+11 YL4ES, BUMP ALL CHARS UP 1 POSN. ALF,ALF STA HBUFF+11 AND .LMSK ADA HBUFF+10 STA HBUFF+10 STORE 1ST 2 CHARS LDA HBUFF+11 AND .UMSK STA HBUFF+11 LDA HBUFF+12 ALF,ALF STA HBUFF+12 AND .LMSK ADA HBUFF+11 STA HBUFF+11 STORE NEXT 2 CHARS .EXT1 LDA HBUFF+12 AND .UMSK CLEAR ORDINAL CHAR. STA HBUFF+12 AND SET LAST WORD LDA EXTBL STA HSAVA TABLE POINTER = FWA OF EXT TBL .EXT2 LDA HSAVA,I PICK UP 1ST WORD OF ENTRY SZA,RSS LAST ENTRY IN TABLE? JMP .EXT6 GO TO INSERT AND OUTPUT EXT REC. ISZ HSAVA CPA HBUFF+10 1ST WORDS SAME ? JMP *+3 YES ISZ HSAVA NO JMP .EXT4 LDA HSAVA,I PICK UP 2ND WORD OF ENTRY ISZ HSAVA CPA HBUFF+11 2ND WORDS SAME ? JMP *+2 YES JMP .EXT4 NO LDA HSAVA,I AND .UMSK CPA HBUFF+12 LAST WORDS SAME ? JMP *+3 YES .EXT4 ISZ HSAVA NO JMP .EXT2 GO TO TEST NEXT ENTRY LDA HSAVA,I AND .LMSK STA RELAD SET RELAD = EXT ORDINAL LDA O4 STA RELC SET RELC = 4 JMP HEXTS,I EXIT FROM EXT ROUTINE * * * END OF CURRENT ENTRIES IN TABLE * * * -ENTER THE NEW SYMBOL * * .EXT6 LDB EXTBL LDA HSAVA INA CPA FDVL END OF TABLE AREA? STB HSAVA YES, RESET POINTER TO TBL ORG LDA XTORD NO CPA .LMSK ORDINAL MASTER = 255? JMP .EXT9 YES, GO TO HALT ISZ XTORD ADD 1 TO XTORD LDA XTORD STA RELAD SET RELAD=XTORD ADA HBUFF+12 SET ORDINAL INTO ENTRY STA HBUFF+12 LDA HBUFF+10 MOVE ENTRY TO TABLE STA HSAVA,I ISZ HSAVA LDA HBUFF+11 STA HSAVA,I ISZ HSAVA LDA HBUFF+12 STA HSAVA,I ISZ HSAVA CLA STA HSAVA,I CLEAR LOCN FOLLOWING ENTRY LDMA O22 STA CODE SET CODE = 22 (FOR EXT OUTPUT) LDA O4 STA RELC SET RELC = 4 JSB CREP2 GO TO CREP2 TO PUNCH EXT RECORD JMP HEXTS,I EXIT FROM EXTS * .EXT9 LDA O10 TOO MANY EXTERNALS JSB STOP SYSTEM STOP 10 * * * INSERT BLANKS WHERE WORD CON- * * * TAINS A ZERO FOR A CHARACTER * * HCRL NOP INB LDA B,I ENTRY WORD TO A SZA,RSS WORD = 0? JMP HCRLA YES AND .LMSK NO SZA,RSS LOWER CHAR = 0? JMP *+3 YES LDA B,I NO, PICK UP WORD JMP HCRL,I EXIT LDA B,I INSERT LOWER BLANK ADA O40 JMP HCRL,I EXIT HCRLA LDA .BLNK SET WORD = BLANK JMP HCRL,I EXIT SKP * * ************************ * * EXTERNAL SYMBOL TABLE* * ************************ * EXTBL DEF *+1 BSS HLN+HLN+HLN+1 EEXT EQU * LWA+1 EXT TABLE * HPB09 DEF HPBUF+9 HPB10 DEF HPBUF+10 HPB11 DEF HPBUF+11 HPB12 DEF HPBUF+12 HPB13 DEF HPBUF+13 HPB14 DEF HPBUF+14 HPB15 DEF HPBUF+15 HPB16 DEF HPBUF+16 HPB BSS 1 * * SPLIT NOP JSB READB,I STA WCOUN AND O377 LOWER 8 BITS LDB 0 IS 2ND WORD LDA WCOUN ALF,ALF UPPER 8 BITS AND O377 IS 1ST WORD JMP SPLIT,I * * PNT02 DEF AS1+1 LINK TO SCRATCH FILE NAME PNT04 DEF AI+1 LINK TO INPUT FILE NAME * * START OF PASS 2 PROCESSING * FTN2 EQU * * LDA BUFOR INITIALIZE BUFFER STA BUFAD ADDRESS CLB STB MBUFF,I 0 TO FIRST WORD IN READ-BUFFER * LDA PNT01 INITIALIZE FMP ERROR STA NAME FILE NAME POINTER JSB OPEN OPEN DEF *+7 OUTPUT DEF IDCB1 FILE DEF ERRS PNT01 DEF AO+1 DEF OPTS3 DEF AO+5 DEF AO SSA ERROR OCCUR? JMP FMPER YES.REPORT IT * |{ LDA PNT02 INITIALIZE FMP ERROR STA NAME FILE NAME POINTER JSB RWNDF REWIND DEF *+3 SCRATCH DEF IDCB3 FILE DEF ERRS SSA ERROR OCCUR? JMP FMPER YES.REPORT IT LDA PNT04 INITIALIZE FMP ERROR STA NAME FILE NAME POINTER JSB CLOSE CLOSE DEF *+3 INPUT DEF IDCB0 FILE DEF ERRS SSA ERROR OCCUR? JMP FMPER YES.REPORT IT LDA PNT05 INITIALIZE FMP ERROR STA NAME FILE NAME POINTER JSB LIMEM GET THE DEF FTN5 FWAM AFTER DEF O1 CURRENT DEF IFWAM SEGMENT DEF IWRDS DEF IFWAS DEF IWS * FTN5 EQU * CLB,INB LDA OPT+1 SZA ASSEMBLY LIST ? ADB O2 YES, B=2 FOR LIST, 3 FOR BOTH FTN4 STB PASS NO,SET CREP FLAG * 1=PUNCH, 2=LIST ASMB, 3=BOTH FTN3 CLA STA RELC SET OP.CODE ABSOLUTE STA RFLAG SET TO 0 FOR INIT.CALL OF READB * FTN20 JSB READB,I ISZ RFLAG SET NOT ZERO FOR LATER CPA M4 HEADER CODE? RSS JMP FTN23 NO, CHECK FOR END$ JSB SPLIT STA HPB10,I PRIORITY STB HPB11,I RESOL.CODE JSB READB,I STA HPB12,I EXECUTION MULTIPLE JSB SPLIT STA HPB13,I HOURS STB HPB14,I MINUTES JSB SPLIT STA HPB15,I SECONDS STB HPB16,I 10-S OF MSECS * JSB READB,I GET COMMENT SIZE STA CMTSZ LDB HPB16 STB HPB CMA STA WCOUN FTN2C ISZ WCOUN RSS JMP FTN2D JSB READB,I GET A WORD OF COMMENTS ISZ HPB STA HPB,I JMP FTN2C COPY TIL DONE * FTN2D LDA BUFAD,I ADA M1 STA ENTAD ENTRY POINT ADDR. ISZ BUFAD LDA BUFAD,I ADA M1 STA LVBAS PROGRAM LENGTH=LOC.VARZ640.BASE ISZ BUFAD LDA BUFAD,I STA LVSIZ SIZE OF LOCAL VAR. AREA ISZ BUFAD LDA BUFAD,I STA AESIZ SIZE OF ASF ERASABLES ISZ BUFAD LDA BUFAD,I STA ERSIZ SIZE OF PROGRAM ERASABLES ISZ BUFAD LDA BUFAD,I STA LBSIZ SIZE OF LABEL REFS.AREA ISZ BUFAD LDA BUFAD,I ADA M1 STA CLEN LENGTH OF COMMON ISZ BUFAD LDA BUFAD,I STA CNSIZ TOTAL NO.OF CONSTANT REFS. CMA ADA LCLIS STA BCLIS SET FWA OF CONLIS = TOP OF AVAIL * MEMORY - MAX NUMBER OF CONSTANTS ISZ BUFAD LDB FDVL LDA SAVOR ORIGINAL ADDR.OF SAVE-FORMAT STA SAVND AREA. INITIALIZE ADDR. STB LDVL FTN22 JSB READB,I READ PUTAWAY TYPE CPA O31 FORMAT? 6 RSS YES JMP FTN23 NO JSB READB,I READ LENGTH CMA,INA STA WCOUN SET COUNT FTN21 JSB READB,I READ ONE WORD OF FORMAT STA SAVND,I SAVE WORD ISZ SAVND LDA SAVND CPA FDVL OVERFLOW TOP OF AVAIL MEMORY? JMP TILT OVERFLOW; SYSTEM STOP 0 ISZ WCOUN READY ? JMP FTN21 NOT READY,GET NEXT WORD JMP FTN22 READY,READ NEXT PUTAWAY-OP * FTN2A CPB O3 BOTH PUNCHING & LISTING? CLB,INB YES, SET B =1 TO DO PUNCHING JMP FTN4 NO,SET PASS= ONLY OPTION CHOSEN * FTN23 CPA O23 END$? JMP W2FIN YES,START NEXT PASS OR HLT JSB READB,I READ LENGTH OF DVLIST CMA,INA STA WCOUN FTN24 JSB READB,I READ DVLIST-WORD STA LDVL,I LDA LDVL CPA SAVOR DVLIST OVERFLOWS BTM OF CPA SAVND SAVED FORMATS ?YES,FORMAT SAVED? RSS NO PROBLEM JMP TILT OVERFLOW; SYSTEM STOP 0 CLA,INA SET A NE.0 ISZ LDVL ISZ WCOUN READY ? JMP FTN24 NO,CONTIN.READ DVLIST LDA FDVL,I PROGRAM NAME ENTRY IN DVLIST ALF,ALF AND O77 PARAM. FIELD OF PROGRAM NAME CON- STA PARM TAINS NO.OF PARAMS LDA FDVL,I IOR WUP8 SET PARAM FIELD OF PROG NAME STA FDVL,I ENTRY SO THAT IT DOES NOT LOOK * LIKE A LOCAL VAR TO CREP IN PRINTING SYMB.TABLE * LDB FDVL INB LDA 1,I AND O17 KEEP LOW 4 BITS (PROG TYPE) STA PTYPE LDA 1,I ARS,ARS ARS,ARS STA HPB09,I PROG TYPE TO NAM RECORD BUFF LDA ENTAD INA STA 1,I * * PROG.NAME ENTRY IN DVLIST LDA LVBAS LOC.VAR.BASE ADA LVSIZ ADA M1 STA AEBAS ASF ERAS.BASE ADA AESIZ ADA M1 STA ERBAS PROG.ERAS BASE ADA ERSIZ ADA M1 STA LABAS LABEL REF BASE ADA LBSIZ ADA M1 STA CSBAS CONST.BASE ADA CNSIZ MAX CONST.AREA SIZE STA PLEN SET MAX.PROG.LGTH. LDA O12 12B FOR OCTAL OPCODE STA CODE JSB C1A,I CREP1 TO INITIALIZE CREP2 AND * INITIAL CODE (NAM,ENT ) *PROCESS CODE FOR HELD OFF FORMAT STATEMENTS NEXT LDA SAVOR CPA SAVND ANY FORMAT STATEMENTS SAVED ? JMP FTN26 NO,SKIP GENERATION OCT CODE STA SAVAD FTN25 LDA SAVAD,I STA RELAD OCTAL VALUE TO OPERAND VALUE JSB C2A,I GENERATE OCT ISZ SAVAD LDA SAVAD CPA SAVND END ? RSS YES,READY JMP FTN25 NO,CONTINUE FTN26 LDA BCLIS STA TCLIS INITIALIZE CONLIST FWA LDA PTYPE CPA O1 IS IT PROG? RSS JMP *+4 NO LDA O6 YES,PUT 6 INTO CONLIST STA TCLIS,I FOR TERMINATION CALL ISZ TCLIS BUMP CONLIS POINTER CLA STA XTORD INITIALIZE EXT ORDINAL JSB READB,I CPA O32 BSS? RSS YES JMP WPUT2+1 STA CODE SET CODE JSB READB,I SSA CMA,INA STA RELAD SET OPERAND (=N) JSB C2A,I GENERATE BSS N JSB GNDEF GENERATE DEF'S FOR ARRAY FWA-S WPUT2 JSB READB,I STA PCODE READ FIRST WORD OF PUTAWAY-CODE LDB O10 10B = OPCODE FOR DEF STB VAROP INITIALIZE AT DEF AND O77 STA POPCD PUTAWAY OPCODE ADA W2TAB COMPUTE JUMP TABLE ADDRESS JMP 0,I * W2FOR JSB READB,I READ LENGTH OF FORMAT STATEMENT CMA,INA STA WCOUN SET COUNT CLA STA RELC LDA O12 12B = OPCODE FOR OCT STA CODE JSB READB,I READ BIN.VALUE STA RELAD SET VALUE JSB C2A,I GENERATE OCT ISZ WCOUN READY? JMP *-4 NO,CONTINUE JMP WPUT2 NEXT OP. * W2LD#A JSB W2REL SET RELC AND RELAD FOR CREP2 CLA,INA STA CODE OPCODE= 1 OFR LDA JSB C2A,I OUTPUT LDA JMP WPUT2 NEXT OP * W2COM LDA O3 JMP W2ABS+3 * W2PAD LDA RELAD JMP W2RLC+1 * W2PER LDA ERBAS PROG.ERAS BASE JMP W2RLC * W2AER LDA AEBAS ASF ERAS BASE JMP W2RLC * W2ICS LDA RELAD CONST-1 INA JSB ICEQS SEARCH-AND-INSERT INT CONSTANT ADA CSBAS JMP W2RLC+2 * W2RCS JSB READB,I READ LOWER PART OF REAL CONST LDB 0 TO B LDA RELAD INA UPPER PART OF CONST JSB RCEQS SEARCH-AND-INSERT REAL CONST JMP W2ICS+3 * W2PAR LDA PARM NO OF PARAMS CMA,INA ADA RELAD ORDINAL OF PARAM ADA ENTAD ENTRY POINT ADDR. JMP W2RLC+1 * W2ENT JSB ENTR.,I GENTR: GENERATE ENTRY POINT CODE JMP WPUT2 CONTINUE * W2ADA JSB W2REL SET RELC AND RELAD (CREP2) LDA O2 OPCODE = 2 FOR ADA JMP W2LDA+2 * W2CMA LDB MICOP OCT 3004B FOR CMA,INA CLA STA RELC 0 FOR ABSOL. STB RELAD JMP W2OCT+1 * W2STA JSB W2REL SET RELC AND RELAD LDA O6 OPCODE = 6 FOR STA JMP W2LDA+2 * W2DEF JSB W2REL SET RELC AND RELAD LDA O10 OPCODE = 10B FOR DEF JMP W2LDA+2 * W2JMP JSB W2REL SET RELC AND RELAD LDA RELC SZA ABSOL.RELOC. JMP W2JM1 NO LDA PTYPE CPA O1 PROGRAM? JMP W2STP YES, GENERATE JSB .STOP FOR * RETURN IN PROGRAM LDA ENTAD CMA,INA,SZA,RSS LDA IBIT INDICATE 0,I STA RELAD ISZ RELC 1 FOR PROG.RELOC. W2JM1 LDA O11 OPCODE = 11B FOR JMP JMP W2LDA+2 * W2STP LDB FXTBL .STOP JSB .EXTS,I EXT FOR STOP LDA O7 7= CODE FOR JSB JMP W2LDA+2 * W2OCT JSB W2REL SET RELC AND RELAD LDA O12 <OPCODE = 12B FOR OCT JMP W2LDA+2 * W2SZA LDB MICOP+1 OCT 2002B FOR SZA JMP W2CMA+1 * W2SSA LDB MICOP+2 OCT 2020B FOR SSA JMP W2CMA+1 * W2INA LDB MICOP+3 OCT 2004B FOR INA JMP W2CMA+1 * W2CLA LDB MICOP+4 OCT 2400B FOR CLA JMP W2CMA+1 * W2ALS LDB MICOP+5 OCT 1200B FOR ALS JMP W2CMA+1 * W2BSS JSB W2REL SET RELC AND RELAD LDA O32 OPCODE = 32B FOR BSS JMP W2LDA+2 * W2LDB JSB W2REL SET RELC AND RELAD LDA O35 OPCODE = 35B FOR LDB JMP W2LDA+2 * W2JSI JSB W2REL SET RELC AND RELAD FOR JSB ASF LDA O7 OPCODE = 7 FOR JSB JMP W2LDA+2 * W2LAC JSB W2REL SET RELC AND RELAD CLA,INA OPCODE=1 FOR LDA STA CODE JSB C2A,I OUTPUT LDA OPND JMP W2CMA OUTPUT CMA,INA * * * ****************************************** * * CALLS TO BASIC EXTERNAL FUNCTIONS * W2SUB LDB FXTBL ADDR.OF .STOP IN EXT.SYM.TAB. JSB .EXTS,I GENERATE EXT IF NECESSARY LDA O7 OPCODE = 7 FOR JSB STA CODE JSB C2A,I OUTPUT JSB JSB W2REL GET OPND AND SET RELC AND RELAD LDA VAROP OPCODE FOR DEF OR STA JMP W2LDA+2 GENERATE DEF OR STA * W2DLD LDB EAOPS+2 OPCODE FOR DLD JMP W2MPY+1 * W2DST LDB EAOPS+3 OPCODE FOR DST JMP W2MPY+1 * W2DIV LDB EAOPS+1 OPCODE FOR DIV JMP W2MPY+1 * W2MPY LDB EAOPS OP CODE FOR MPY STB RELAD ADDR = VALUE CLA STA RELC ABSOLUTE CODE LDA O12 CODE FOR OCT = 12B JMP W2SUB+3 * W2DLC LDB FXTBL+20B FWA OF DLC-ENTRY JMP W2SUB+1 * W2FAD LDA PCODE PUTAWAY OPCODE CPA O40 SYMBOL TABLE? JMP W2END YES,READ SYMBTAB AND END-PROCESS LDB FXTBL+50B FWA OF FAD-ENTRY JMP W2SUB+1 * W2FSB LDB FXTBL+54B FWA OF FSB-ENTRY JMP W2SUB+1 * W2FCM LDB FXTBL+24B FWA OF FCM JSB .EXTS,I GENERAHTE EXT LDA O7 OPCODE FOR JSB JMP W2LDA+2 * W2FMP LDB FXTBL+40B FWA OF FMP-ENTRY JMP W2SUB+1 * W2FDV LDB FXTBL+44B FWA OF FDV-ENTRY JMP W2SUB+1 * *REAL TO INT STORE.GENERATED CODE: JSB IFIX, STA OPERAND (2 LOCS) * W2RSI LDB FXTBL+30B FWA OF IFIX ENTRY LDA O6 OPCODE FOR STA STA VAROP JMP W2SUB+1 GENERATE JSB IFIX,STA * *INTEGER TO REAL STORE GENERATES: JSB FLOAT ,DST OPERAND (3 LOCS) * W2ISR LDB FXTBL+34B FWA OF FLOAT-ENTRY * JSB .EXTS,I GENERATE EXT FOR FLOAT LDA O7 STA CODE OPCODE=7 FOR JSB JSB C2A,I GENERATE JSB FLOAT JMP W2DST GENERATE DST OPND * W2JSE JSB READB,I STA XNAME+1 FIRST WORD IN NAME JSB READB,I STA XNAME+2 2ND WORD IN NAME JSB READB,I STA XNAME+3 3RD WORD IN NAME LDB XNAME DEF XNAME+1 JMP W2FCM+1 * XNAME DEF *+1 BSS 3 * W2RPI LDB FXTBL+4B FWA OF .RTOI ENTRY JSB .EXTS,I OUTPUT EXT LDA O7 OPCODE FOR JSB STA CODE JSB C2A,I OUTPUT JSB .RTOI, .ITOI, .RTOR JSB W2REL SET RELC AND RELAD FOR BASE LDA O10 OPCODE FOR DEF STA CODE JSB C2A,I OUTPUT DEF BASE JSB READB,I READ 1ST WORD OF EXPON. STA PCODE SET FOR W2REL JMP W2DEF OUTPUT DEF EXPON. * W2RPR LDB FXTBL+10B FWA OF .RTOR ENTRY JMP W2RPI+1 * W2IPI LDB FXTBL+14B FWA OF .ITOI ENTRY JMP W2RPI+1 * * ****************************************** * W2END JSB READB,I SZA,RSS EMPTY SYMBOL TABLE ? JMP W2N11 YES CMA,INA STA WCOUN W2EN1 JSB READB,I READ 1 WORD OF SYMBOL TABLE STA LDVL,I ISZ LDVL LDA LDVL CPA BCLIS OVERFLOW INTO CONLIST ? JMP TILT OVERFLOW; SYSTEM STOP 0 ISZ WCOUN END ? JMP W2EN1 NO,CONTINUE READING W2N11 LDA PTYPE CPA O1 PROGRAM? RSS YES JMP W2EN2 NO LDB XECNA EXT FOR EXEC JSB .EXTS,I LDA O7 CODE=7 FOR JSB STA CODE JSB C2A,I OUTPUT JSB EXEC CLA,INA STA RELC REL.CODE=1 FOR PROG LDA LVBAS STA RELAD RELAD=FWA OF LOC.VAR.AREA LDA O10 STA CODE CODE=10B FOR DEF JSB C2A,I OUTPUT DEF *+2 LDA CSBAS STA RELAD JSB C2A,I OUTPUT DEF =6 W2EN2 JSB GENC.,I GENERATE BSS FOR LV,ERAS,DEFS * FOR LABEL REFS,AND OUTPUT CONST. LDB O24 OPCODE FOR END LDA PTYPE CPA O1 PROGRAM? LDB O25 YES, OPCODE FOR TRA STB CODE JSB C2A,I OUTPUT END OR TRA AND PRINT * SYMBOL TABLE IF LISTING JMP FTN20 CONTINUE WITH NEXT PROG.OR END$ * W2FIN LDA PASS HERE IF END$ DETECTED ADA M2 SSA,RSS PASS GE 2 (LISTING JUST DONE)? JMP W2FN2 YES, END OF COMPILATION LDA OPT+1 NO, HAVE ONLY DONE BIN PUNCHING * (& PUNCH DEVICE =LIST DEVICE) SZA,RSS ASSEMBLY LISTING? JMP W2FN2 NO, END OF COMPILATION HLT 1 LET USER TURN OFF PUNCH ISZ PASS BUMP OPTION TO LIST LDA BUFOR STA BUFAD LDA *+3 STA ENTRY SET JUMP ADDR FOR CODE AT FTN0 JMP ENTRY,I DEF FTN3 * W2FN2 CCA LDB OPT CHECK LIST OPTION SZB IF ANY LISTING JSB LIST EJECT PAGE * LDA PNT03 INITIALIZE FMP ERROR STA NAME FILE NAME POINTER JSB CLOSE CLOSE DEF *+3 LIST DEF IDCB2 FILE DEF ERRS SSA ERROR OCCUR? JMP FMPER YES.REPORT IT LDA PNT04 INITIALIZE FMP ERROR STA NAME FILE NAME POINTER JSB FCONT WRITE DEF *+4 EOF ON DEF IDCB1 OUTPUT DEF ERRS FILLE DEF O100 SSA,RSS ERROR OCCUR? JMP *+6 NO.GO ON LDA ERRS YES.IS IT CMA,INA FMP ERROR CPA O14 -012? RSS YES.IGNORE IT JMP FMPER NO.REPORT FMP ERROR LDA PNT01 INITIALIZE FMP ERROR STA NAME FILE NAME POINTER JSB CLOSE CLOSE DEF *+3 OUTPUT DEF IDCB1 FILE DEF ERRS SSA ERROR OCCUR? JMP FMPER YES.REPORT IT LDA PNT02 INITIALIZE FMP ERROR STA NAME FILE NAME POINTER LDA AS1+4 GET WORD 5 OF SCRATCH FILE ARRAY SSA,RSS SCRATCH FILE DEFAULTED? JMP C.END NO.SKIP PURGE JSB PURGE YES.PURGE DEF *+6 SCRATCH DEF IDCB3 FILE DEF ERRS DEF AS1+1 DEF AS1+5 DEF AS1 SSA ERROR OCCUR? JMP FMPER YES.REPORT IT JMP M.END NO.GO ON TO RELEASE MEMORY C.END EQU * JSB CLOSE CLOSE DEF *+3 SCRATCH DEF IDCB3 FILE DEF ERRS SSA ERROR OCCUR? JMP FMPER YES.REPORT IT M.END EQU * LDA PNT05 INITIALIZE FMP ERROR STA NAME FILE NAME POINTER JSB LIMEM RELEASE MEMORY OBTAINED DEF *+2 FROM FIRST LIMEM CALL DEF M1 IN SEGMENT 1,PASS 1 JSB IMESS WRITE DEF *+4 "$FTN-END" DEF O2 ON SESSION DEF EMSG CONSOLE DEF O4 JSB EXEC TERMINATE DEF *+2 FORTRAN DEF O6 * PNT05 DEF *+1 LINK TO BLANK FILE NAME ASC 3, EMSG ASC 4,$FTN-END SKP * *GENERATED CODE FOR SUB: CMA,INA - ADA OPERAND - CMA,INA (3 LOCS) * W2MIN LDB MICOP CODE FOR CMA,INA CLA STA RELC RELOC = ABSOL STB RELAD VALUE OF MICOP LDA O12 STA CODE OPCODE= OCT JSB C2A,I GENERATE CMA,INA JSB W2REL kGET OPERAND LDA O2 OPCODE FOR ADA JMP W2LAC+2 GENERATE ADA OPND- CMA,INA * * HERE IF PUNCH DEVICE =LIST DEVICE *GENCO GENERATES A BSS FOR LOCAL VAR,PROG.ERABLES *AND ASF ERASABLES, DEF-S FOR LABELS AND OCT-S FOR *CONSTANTS. * GENCO NOP LDA LVSIZ LOC.VAR.SIZE ADA AESIZ ASF ERAS.SIZE ADA ERSIZ PROG ERAS.SIZE CLB STB RELC 0 FOR ABSOLUTE OPND ADA M4 SSA BSS 0 ? JMP GENCX YES, DO NOT GENERATE ANYTHING STA RELAD LDA O32 STA CODE JSB C2A,I BSS FOR LOCALS AND ERASABLES CLA STA RELAD LDA O12 STA CODE JSB C2A,I GENERATE OCT 0 GENCX LDA O10 STA CODE OPCODE FOR DEF ISZ RELC PROG. RELOCATABILITY =1 LDB FDVL GENC1 INB CPB LDVL END OF SYMBTAB ? JMP GENC4 YES,EXIT LDA 1,I NO,CHECK FOR LABEL SZA JMP GENC1 NO LABEL,CONTINUE SEARCH INB LABEL STB GSAVE ADDR OF LABEL VALUE INB STB GSAVE+1 SAVE POINTER IN SYMBTAB LDA 1,I LABEL ADDR. CPA M1 UNDEFINED? (ADDR. = 1) JMP GENC2 YES GENC3 ADA M1 -1 FOR CORRECT ADDR. STA RELAD SET ADDR. JSB C2A,I GENERATE DEF LABL ADDR LDB GSAVE+1 JMP GENC1 CONTINUE LOOKING FOR LABELS * GENC2 LDA ENTAD CMA,INA GENERATE DEF ENTRY,I JMP GENC3+1 * **** GENERATE CONLIST **** GENC4 CLA STA RELC ABSOL RELOC LDA O12 12B = OPCODE FOR OCT STA CODE LDB BCLIS BTM OF CONLIST GENC5 CPB TCLIS READY ? JMP GENCO,I YES,EXIT STB GSAVE NO,SAVE ADDR.IN CONLIST LDA 1,I STA RELAD CONST.VALUE JSB C2A,I GENERATE OCT VALUE LDB GSAVE INB JMP GENC5 CONTINUE GENERATING OCT-S * GSAVE BSS 2 DEF *+1 ENi640TER ROUTINE 100B ASC 3,.ENTR SKP * *SUBROUTINE GENTR GENERATES THE ENTRY POINT CODE *** *IT IS CALLED WHEN AN OPCODE=17B IS READ*** * GENTR NOP CLA STA RELC ABSOLUTE VALUE LDA PTYPE CPA O1 PROGRAM? JMP GENT1 YES,NO PARAMS LDA O32 32B FOR BSS STA CODE OPCODE FOR BSS LDA PARM NO. OF PARAMS STA RELAD JSB C2A,I GENT1 CLA STA RELAD LDA O12 OCT OPCODE STA CODE JSB C2A,I OCT 0 AT ENTRY POINT LDA PTYPE LDB CIOAD CLRIO - ADDRESS CPA O1 PROGRAM? RSS YES,GENERATE CALL TO CLRIO LDB GENTR-4 FWA OF .ENTR- NAME JSB .EXTS,I GENERATE EXT .ENTR OR CLRIO LDA O7 STA CODE OPCODE FOR JSB JSB C2A,I GENERATE JSB .ENTR OR CLRIO CLA,INA STA RELC PROG RELOC LDA O3 3 FOR DEF ENTRY +3 FOR PROGRAMS LDB PTYPE PROG TYPE CPB O1 PROGRAM? JMP *+3 YES, GENERATE DEF ENTRY+3 LDA PARM NO.OF FORMAL PARAMS CMA,INA ADA ENTAD ENTRY POINT ADDR.-NO.OF PARAMS STA RELAD LDA O10 STA CODE OP=DEF JSB C2A,I GENERATE DEF ENTRY+(-N OR +3) JMP GENTR,I EXIT * CIOAD DEF *+1 ASC 3,CLRIO CLEAR I/O CLEAR I/O ROUTINE FOR PROGRAMS * XECNA DEF *+1 ASC 3,EXEC ** .END2 BSS 0 * END FTN2 6 , 92064-18137 1805 S C0322 &MAS60 RTE-M CROSS REFERENCE SEGMENT             H0103 |ASMB,R RTE-M CROSS-REFERENCE TABLE GENERATOR SEGMENT HED ** RTE-M CROSS-REFERENCE TABLE GENERATOR SEGMENT ** * * * 9/10/76 * * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAME : XRFSG * SOURCE: 92064-18137 * RELOC : 92064-16026 * PRGMR : C.H., H.C., S.K. * NAM XRFSG,5,99 92064-16026 REV.1805 771110 EXT READF EXT CLOSE EXT IMESS EXT FCONT EXT AI,AL,?FMPE,?ERR,DCBL,?FWA,?LWA,FCONT,WRITF,READF EXT DCBI,RTNXR,PRMXR,.M12 * * * THIS SEGMENT PRODUCES A CROSS REFERENCE TABLE FOR A PROGRAM * WRITTEN IN HP-21XX ASSEMBLY LANGUAGE (HPAP). THE TABLE CON- * SISTS OF A LIST OF SYMBOLS, IN ALPHABETIC ORDER, EACH FOLLOWED * BY ITS LOCATION IN THE PROGRAM, AND A LIST OF REFERENCES TO * THAT SYMBOL. EACH LOCATION IS A 5-DIGIT SEQUENCE NUMBER, FOL- * LOWED BY THE NUMBER OF THE TAPE ON WHICH IT APPEARS. THESE TWO * ARE SEPARATED BY A SLASH. THE TAPE NUMBER IS NOT PRINTED WHEN * ONE TAPE ONLY EXISTS. * * THE METHOD USED IS TO READ IN THE HPAP SOURCE PROGRAM AND * BUILD A TABLE OF REFERENCES. THERE ARE TWO INTERNAL TABLES, THE * LABEL TABLE (LTAB) AND THE CROSS REFERENCE TABLE (XTAB). THESE * TABLES ARE ORGANIZED AS FOLLOWS: * * LTAB: EACH ENTRY CONTAINS THE LABEL NAME AS FOLLOWS: * WORD COUNT CHAR.1 * CHAR.2 CHAR.3 (OPTIONAL) * CHAR.4 CHAR.5 (OPTIONAL) * CHAR.6 CHAR.7 (OPTIONAL) * * THE WORD COUNT MAY BE 1,2,3, OR 4 * * XTAB: EACH ENTRY CONTAINS THE FOLLOWING: * -NUMBER OF WORDS IN ENTRY (-N-2) * LhABEL SEQUENCE NUMBER * REF.1 " " LABELS ARE ADDED AS ENCOUNTERED; * ... * REF.N " " REST OF TABLE IS PUSHED DOWN. * * NO LINKAGE BETWEEN THE 2 TABLES IS REQUIRED BECAUSE THE ENTRIES * ARE IN THE SAME ORDER AND CORRESPOND 1 FOR 1. * NOTE THAT LTAB BEGINS IN LOW CORE AND XTAB IN HIGH CORE, SO THAT * BOTH ARE OPEN-ENDED. * * A LABEL WHICH HAS BEEN DEFINED BUT NEVER REFERENCED IS SIGNIFIED BY * A "@" IN COLUMN #1 PRECEEDING THE LABEL. * * A LABEL WHICH HAS BEEN DEFINED MORE THAN ONCE WILL HAVE A DEFINITION * FIELD OF HASH MARKS: "#####". * * A LABEL WHICH HAS BEEN REFERENCED BUT NEVER DEFINED WILL HAVE A * DEFINITION FIELD OF QUESTION MARKS "?????". * * ANY INSTRUCTION THAT WILL HAVE AN EFFECT UPON THE PROGRAM LISTING * AS ORG, ORB, ORR, IFN, IFZ, XIF, ECT. WILL BE DEFINED AS FOLLOWS: * " **XXX ***** NNNNN NNNNN " WHERE XXX IS THE TYPE OF INSTR. * AND NNNNN IS THE SEQUENCE NUMBER OF THE INSTRUCTION. * * A LITERAL INSTRUCTION WILL BE DEFINED AS A LABEL WITH ITS DEFINITION * FILLED WITH DOTS, OTHER SEQUENCE NUMBERS DEFINE WHERE THEY WERE USED. * * PARAMETERS ARE PASSED BY ASMB OR XREF MAIN IN A 2 WORD BUFFER PRMXR * WHERE PRMXR BIT 15 = 0 NO ALPHA LIMITS WILL BE ASKED * = 1 ALPHA LIMITS WILL BE ASKED * "ENTER LIMITS OR /E" * BITS 0-14 = # LINES PER PAGE - DEFAULT IS 55 * PRMXR+1 = 0 TAPE NUMBERS WITH SEQUENCE #'S WILL BE GIVEN * = N NO TAPE NUMBERS ARE GIVEN THUS ALLOWING * LARGER SEQUENCE #'S * = -N PAGES ARE NUMBERED CONSECUTIVELY FROM THE * LAST RTE-ASMB PAGE # * (TAPE #'S WILL BE PRINTED) * (MORE THAN 16 TAPES: PROCESSING TERMINATES) * * SKP * * XRFSG LDA PRMXR GET FIRST PARAMETER ELA SIGN BIT IN E REG CLB ELB B REG HAS BIT 15 ERA A REG HAS BITS 0-14 OF FIRST PARM STB LETOP SAVE LIMIT PARAMETER CMA,INA,SZA,RSS NEGATE COUNT, AND CHECK FOR ZERO JMP TAPE ZERO, SO USE DEFAULT COUNT = 55 LINES PER PAGE STA CHEKR SAVE FOR LATER USE ADA .55 ADD MAXIMUM ALLOWABLE VALUE SSA IS PARAMETER <= MAXIMUM VALUE? JMP TAPE NO, USE DEFAULT LDA CHEKR YES, GET SUPPLIED VALUE STA NLINZ SAVE IN LINE COUNTER STA LNSKP SAVE IN LINE SKIP COUNTER * TAPE LDA PRMXR+1 GET THE TAPE NUMBER OPTION PARAMETER STA .TAPE SAVE THE TAPE NUMBER OPTION PARAMETER SSA,RSS IF PARAM. IS POSITIVE, PROCEED JMP TAPE# NORMALLY; ELSE, IF NEGATIVE, CMA,INA MAKE POS. FOR CONTINUING PAGE STA PAGNO FROM THE ASSEMBLER. CLA SET THE FLAG TO INDICATE STA .TAPE THAT TAPE NUMBERS ARE DESIRED. * TAPE# SZA IS THIRD PARAMETER NON-ZERO JMP XR11 YES; SET FOR NO TAPE NUMBERS LDA RM4 NO; SET FOR TAPE NUMBERS STA MSK12 SET SEQ # MADK LDA RM5 STA TAPE1 SET TAPE # ADD VALUES LDA RM6 STA ROTAT SET ROTATE INSTR -ALF,RAL- FGSET CLA LOAD A WITH ZERO STA RUN SET RUN TO ZERO RSTAR LDA DEFCB INITIALIZE CONSTANTS ADA DEFCB STA CHAR1 STA OUTBF LDA DEFLB ADA DEFLB STA LABCH LDA FXEND GET "CODED" END OF OP-CODE TABLE, STA ETAB AND SET CURRENT END-OF-TABLE ADDRESS. LDA ?FWA SET BEGINNING OF LTAB TABLE STA FWA * LDA RUN GET RUN FLAG SZA NEW PASS: OPERATOR SPEC'D LIMITS ? JMP CLSEQ YES, SKIP LINE CNT,. & NAME INIT. LDA BLBL SET BLANKS IN STA NAME NAME LOCATION STA NAME+1 STA NAME+2 CCA SET A TO -1 STA LINES SET LINES TO -1 CLSEQ CLA INITIALIvZE STA SEQNO SEQUENCE NUMBER & STA LABCT NUMBER OF LABELS TO ZERO STA DDFLG CLEAR DOUBLE DEFINES FLAG STA LOBND SET LOWER BOUND OF LLOWED SYMBS 0 STA TAPNO INITIALIZE TAPE NUMBER LDA MASK8 SET UPPER BOUND OF ALLOWED STA HIBND SYMBOLS. LDA ?FWA BOUNDS OF STA LTAB. LABEL TABLE LDA ?LWA BOUNDS OF CROSS STA .XTAB REFERENCE TABLE LDA LETOP CHECK IF XREF LIMITS SPECIFIED SZA,RSS JMP RAC THEYRE NOT--USE 0 AND 377,I.E.,ALL. JSB IMESS DEF *+4 DEF .2 DEF EMESG DEF .18 LDA TWO LDB BUFAD READ TWO CHARS FROM KEYBOARD. JSB KEYBD LDA CBUF CPA SLSHE KEYBOARD TERMINATE REQUEST? RSS YES, GO SEE IF PAGE EJECT REQUIRED. JMP BOUND NO. GO TO SET NEW BOUNDS. LDA RUN GET RUN FLAG. SZA HAS ANY OUTPUT OCCURRED? JMP PEJEC YES, GO ISSUE TERMINATING PAGE EJECT. JMP STOP NO. DON'T WASTE PAPER. BOUND LDA CBUF PLACE THE TWO CHARS IN LOBND AND MASK8 AND HIBND. STA HIBND XOR CBUF ALF,ALF STA LOBND SPC 1 * RECORD INPUT SECTION * SPC 1 RAC CLA INITIALIZE NEXT TO ZERO TO PRE- STA NEXT VENT ERROR FROM OCCURING IN ID. LDA DEC80 NUMBER OF CHARACTERS TO BE READ. LDB BUFAD ADDRESS OF CHARACTER BUFFER JSB READ GO TO READ THE RECORD. SZA END OF TAPE? JMP DOCRD NO. GO TO PROCESS RECORD SPC 1 * END OF TAPE SECTION * SPC 1 LDA .TAPE YES, LOAD A WITH TAPE # PARAMETER SZA SKIP IF PARAMETER IS ZERO JMP RAC IF NOT ZERO SKIP EOT ROUTINE STA SEQNO RESET SEQUENCE NO. TO ZERO. LDA TAPNO OTHERWISE BUMP TAPE NUMBER ADA TAPE1 BY ONE STA TAPNO AND UPDATE TAPE COUNTkER. SSA,RSS MORE THAN 16 TAPES PROCESSED? JMP RAC NO, CONTINUE. LDA TPMSG YES, GET ADDRESS OF TAPE MESSAGE. JMP NDFIL+1 GO TO PRINT & ABORT. * XR11 LDA RM1 LOAD WITH MASK OF 077777B STA MSK12 SET SEQ # MASK LDA RM2 STA TAPE1 SET TAPE # ADD VALUE LDA RM3 STA ROTAT SET ROTATE INSTRUCTION -RAL- STA .TAPE SET TAPE# PARAMETER: NON-ZERO JMP FGSET M1 DEC -1 SPC 1 * RECORD PROCESSING SECTION * SPC 1 DOCRD ISZ SEQNO ADD 1 TO SEQUENCE NUMBER. CMA INITIALIZE CCNT TO STA CCNT -1-# OF CHARACTERS IN RECORD LDA RM1 LOAD A WITH RM1 MASK CPA MSK12 IS IT THE SAME AS MASK 12 JMP RETRX YES, CONTINUE NORMAL SEQUENCE. LDA SEQNO NO, LOAD A WITH SEQUENCE NUMBER CPA =D2048 IS SEQUENCE NUMBER 2048 JMP .CHNG YES, CHANGE TO NO TAPE NUMBERS RETRX LDB CHAR1 GET THE FIRST STB CPNTR JSB BUF2A CHARACTER. CPA STAR IF A STAR, GO TO READ THE JMP RAC NEXT RECORD. CPA BLANK IF A BLANK, SKIP OVER LABEL JMP DOOP SECTION. JSB ID GO GET THE LABEL JMP RAC ILLEGAL LABEL. CPA COMMA IS NEXT CHARACTER A COMMA ? JMP RAC IF SO, IGNORE--ASMB CARD. JSB CHEKR JMP DOOP JSB LLKUP FIND THE LABEL IN LTAB. CCB SET B TO POINT AT LABEL SEQUENCE JSB PUTSQ NUMBER AND PUT IN XTAB. SPC 1 * OPERATOR PROCESSING SECTION * SPC 1 DOOP JSB ID GO GET THE OPERATOR. JMP RAC ILLEGAL OPERATOR. JSB LOOK FIND IN OPERATOR TABLE DEF OPBEG DEFINE BEGINNING OF OPERATOR TABLE ETAB DEF FXEND DEF END OP-TABLE (MODIFIED BY 'DOMIC') LDB A GET INDEX VALUE CMB IF IT IS EQUAL ADB MICOP OR GREATER ELB THAN SEZ  CONSTANT, USE LDA MICOP CONSTANT AS INDEX BASE. LDB OPCNT GET # OF OPERANDS FOR CURRENT OP-CODE. SZB IF NOT ZERO, JMP DOOP1 GO MAKE NUMBER NEGATIVE. SEZ,RSS IF NOT A MIC-OP, INB,RSS INCR BY ONE, AND SKIP. RSS DOOP1 CMB,INB MAKE NEGATIVE AND STB TEMP2 SAVE FOR FUTURE REFERENCE. ADA SWICH JUMP TO CORRECT PROCESSING JMP 0,I ROUTINE. * .CHNG LDA RM1 CHANGE STA MSK12 FOR LDA RM2 NO STA TAPE1 TAPE LDA RM3 NUMBERS STA ROTAT STA .TAPE SET TAPE PARAMETER NON-ZERO JMP RETRX RETURN. SPC 1 * CHEKR TESTS FOR WHETHER THE CURRENT LABEL IS BETWEEN THE * BOUNDS OF ACCEPTABILITY. THAT IS, WHETER ITS FIRST CHAR * IS BETWEEN LOBND AND HIBND. IF IT IS, WE RETURN TO * NORMAL +1, OTHERWISE TO NORMAL SPC 1 CHEKR NOP LDA LABEL GET THE FIRST CHARACTER AND MASK8 CMA,INA -CHAR ADA HIBND HIBND-CHAR SSA TEST HIGH END JMP CHEKR,I TOO HIGH. CMA,INA CHAR-HIBND ADA HIBND CHAR CMA -CHAR-1 ADA LOBND LOBND-CHAR-1 SSA TEST LOW END ISZ CHEKR FORCE THE SKIP IF OKAY. JMP CHEKR,I SPC 1 PSUDO NOP LDA LABEL+1 LOAD CHARACTERS 2 AND 3 STA LABEL+2 STORE AS CHARACTERS 4 AND 5 LDA LABEL LOAD THE FIRST CHARACTER IOR SSTAR SET THE WORD COUNT TO "*". STA LABEL+1 STORE AS CHARACTERS 2 AND 3 LDA SPCLB LOAD WORD COUNT/ASTERISK STA LABEL STORE FIRST CHARACTER WORD JSB CHEKR GO CHECK FOR CURRENT BOUNDS JMP PSUDO,I GO IGNORE CURRENT OPERATOR ISZ PSUDO RETURN TO P+2: WITHIN BOUNDS. JSB LLKUP GO GET THE SYMBOL ORDINAL JMP PSUDO,I RETURN SPC 1 DOSP1 CLA,RSS SPECIAL OPCODE; OPERAND EXPECTED. DOSPC CCA SPECIAL OPCODE; NO OPERAND. STA SOP STORE THE OPERAND OPTION FLAG. JSB PSUDO GO PROCESS PSUEDO OPCODE JMP IGNOP IGNORE: OPCODE OUT OF BOUNDS! CLB ENTER: B=0 JSB PUTSQ GO INSERT SEQ. # IN XTAB. IGNOP ISZ SOP IS AN OPERAND TO BE PROCESSED? SPC 1 * PROCESS SINGLE AND MULTIPLE OPERANDS * SPC 1 DOSOP JSB SOP PROCESS THE OPERAND. JMP RAC GO TO NEXT RECORD. SPC 1 * ROUTINE TO HANDLE SINGLE AND MULTIPLE OPERANDS * SPC 1 SOP NOP LDA TEMP2 IF NO OPERANDS SZA,RSS WERE SPECIFIED JMP SOP,I RETURN. CLIND CLA STA INDIR CLEAR INDIRECT INDICATOR DONXT JSB ID GET A SYMBOL JMP NXOPR NOT SYMBOLIC LDA INDIR IF INDIRECT INDICATOR SZA IS SET, GO CLEAR AND JMP CLIND GO GET NEXT SYMBOL. JSB CHEKR JMP NXOPR JSB LLKUP GET SYMBOL'S ORDINAL IN A CLB AND CREATE A SEQ. NO. IN JSB PUTSQ XTAB. NXOPR LDA NEXT IS NEXT CHARACTER CPA PLUS A PLUS JMP DONXT YES-GO GET NEXT SYMBOL CPA MINUS NO-IS IT A MINUS? JMP DONXT YES-GO GET NEXT SYMBOL CPA COMMA NO-IS IT A COMMA? JMP STIND YES-GO SET INDIR. CPA BLANK NO-IS IT A SPACE? JMP BPCNT YES-GO DECR CNTR JMP SOP,I NO-GO GET NEXT STIND STA INDIR SET INDIRECT INDICATOR BPCNT ISZ TEMP2 DECR COUNTER BY 1 JMP DONXT GO GET NEXT OPERAND JMP SOP,I GO GET NEXT STATEMENT TEMP2 = 0 SPC 1 * MIC PROCESSOR SPC 1 DOMIC JSB PSUDO GO PROCESS PSUEDO OP-CODE JMP IGMIC IGNORE 'MIC': OUT OF BOUNDS. CLB ENTER B=0 JSB PUTSQ GO INSERT SEQ # IN XTAB. IGMIC JSB ID GET OP-CODE JMP RAC GO TO PROCESS NEXT RECORD LDA LABEL GET 1ST CHAR OF OP-CODE LDB ETAB GET CURRENT END OF OP-CODE TABLE STA B,I STORE 1ST CHAR OF OP-CODE INB INCR CURRENT END OF OP-CODE TABLE LDA LABEL+1 STA B,I STORE LAST 2 CHARS OF OP-CODE JSB PSUDO GO PROCESS AS PSUEDO OP-CODE JMP MICPR IGNORE PSUEDO OPCODE; CHECK PARAMETERS. CCB SET B TO POINT AT LABEL SEQUENCE JSB PUTSQ NUMBER AND PUT IN ETAB. MICPR LDA NEXT IS NEXT CHAR CPA COMMA EQUAL TO A COMMA? RSS YES - GO GET NEXT PARAM JMP RAC NO - GO GET NEXT STATEMENT. GSEC JSB ID GO GET NEXT SYMBOL JMP *+1 SKIP SECOND PARAMETER LDA NEXT IS NEXT CHAR CPA BLANK EQUAL TO SPACE JMP RAC YES - GO GET NEXT STATEMENT CPA FEED IS IT A LINE FEED JMP RAC YES - GO GET NEXT STATEMENT CPA COMMA IS IT A COMMA RSS YES - GO GET NEXT CHAR JMP GSEC NO - GO GET NEXT SYMBOL GTLEN JSB CHAR GET # OF OPERANDS PARAMETER CPA BLANK SKIP JMP GTLEN BLANKS. CPA FEED END OF CARD? JMP FLEN YES - CONTINUE. JSB DIGIT GO CHECK SEE IF IT IS A DIGIT RSS YES - IT IS A DIGIT CONTINUE FLEN CLA,INA,RSS SYMBOLIC - SET # OF OPERANDS TO 1. AND .7 CONVERT ASCII DIGIT TO OCTAL. ALF ALF,ALF STA NEXT LDB ETAB LDA B,I GET FIRST CHAR OF CURRENT OP-CODE IOR NEXT "OR" IN NUMBER OF OPERANDS STA B,I RESTORE ENTRY IN TABLE ALF,ALF UPDATE POINTER AND .15 TO NEXT ADB A ENTRY IN OP-CODE STB ETAB TABLE. JMP RAC GO GET NEXT STATEMENT SPC 1 * EXT PROCESSOR SPC 1 DOEXT JSB ID GET SYMBOL JMP RAC END OF STATEMENT. JSB CHEKR JMP DOEXX JSB LLKUP PUT IN LABEL TABLE. JSB ORDLK GET ADDRESS OF LABEL SEQUENCE ADA MIN1 LDB 0,I NUMBER AND SEE IF IT'S ZERO. SZB,RSS IF IT IS, PLACE THE CURRENT JSB MKSEQ SEQNO THERE. DOEXX LDA NEXT IF NEXT CHARACTER IS A CPA COMMA COMMA, JMP DOEXT GO GET THE NEXT SYMBOL, JMP RAC ELSE GO TO READ NEXT LINE. SPC 1 * ENT PROCESSOR * SPC 1 DOENT JSB SOP PROCESS SYMBOL. CPA COMMA IF NEXT CHARACTER IS A COMMA, RSS SKIP FOR REFRESH JMP RAC ELSE GO TO READ NEXT CARD. CCA REFRESH NUMBER-OF-OPERANDS STA TEMP2 COUNTER, AND JMP DOENT GO TO GET THE NEXT SYMBOL. SPC 1 * COM PROCESSOR * SPC 1 DOCOM JSB ID GET A SYMBOL JMP RAC END OF STATEMENT. JSB CHEKR JMP DOCM1 JSB LLKUP PUT IN LABEL TABLE. CCB JSB PUTSQ PUT SEQUENCE NUMBER IN XTAB. DOCM1 LDA NEXT IF NEXT CHARACTER IS A CPA LPREN LEFT PARENTHESIS, JMP COMRG GO TO PROCESS ARGUMENT. COM1 CPA COMMA IF A COMMA, JMP DOCOM GO GET NEXT COMMON ENTRY. JMP RAC ELSE GET NEXT RECORD. COMRG JSB CHAR PROCESS ARGUMENT. CPA RPREN IF NEXT CHAR. IS A RIGHT PAREN, JMP *+4 GO GET NEXT COM ENTRY. CPA FEED IF A LINE FEED, THEN JMP RAC END OF CARD. JMP COMRG ELSE GET NEXT CHARACTER. JSB CHAR JMP COM1 SPC 1 * NAM PROCESSOR * SPC 1 DONAM LDA CCNT GET CURRENT CHARACTER COUNT. STA NAMLN SAVE FOR EXTENSION PROCESSING. JSB ID GET THE NAME JMP RAC NOT THERE LDA LABEL GET FIRST CHARACTER OF NAME AND MASK8 IOR UPBLN AND PRECEDE IT BY A BLANK. STA NAME  MOVE TO NAME LOCATION. LDA LABEL+1 STA NAME+1 LDA LABEL+2 STA NAME+2 LDA CCNT GET CURRENT CHARACTER COUNT. CMA,INA,SZA,RSS MAKE POSITIVE. ZERO ? JMP RAC YES, GO GET NEXT RECORD. ADA NAMLN ANY MORE TO PROCESS ? SSA,RSS JMP RAC NO. GO TO READ NEXT RECORD. LDA .NMEX ADA .NMEX STA NAMLN LDA NEXT GET LAST CHARACTER READ. RSS GO TO CHECK FOR FIRST BLANK. FBLNK JSB CHAR YES, EXAMINE NEXT CHARACTER. CPA FEED IF CHAR. IS A LINE FEED, THIS IS JMP RAC END OF STRING. GO READ NEW REC CPA BLANK IS THIS BEGINNING OF NAM EXTENT? RSS YES, GO TO PROCESS. JMP FBLNK NO. GO SEARCH FOR 1RST BLANK. LDB DM40 (B) = MAX CHAR. COUNT. LDA CCNT GET CURRENT CHAR. COUNT. ADA DEC40 IS NAM EXTENT >40 CHARS.? SSA STB CCNT YES, SET = 40 MAX CHARS. LDA BLANK (A)= ASCII BLANK. MVEXT LDB NAMLN JSB A2BUF ISZ NAMLN JSB CHAR GET THE NEXT CHARACTER. LDB CCNT GET NUMBER OF CHARS. ALREADY MOVED. SZB EXTENSION BUFFER FULL ? CPA FEED NO. IF THIS CHARACTER IS A LINE FEED, JMP RAC THAT'S ALL. JMP MVEXT GO BACK FOR MORE. SPC 1 * END PROCESSOR * SPC 1 DOEND JSB SOP PROCESS ELEMENT FOLLOWING END. LDA TAPNO SET TAPE NUMBER STA TPCNT TO TAPE COUNT * SPC 1 * OUTPUT SECTION * SPC 1 LDA RUN GET RUN FLAG SZA NEW PASS: OPERATOR SPEC'D LIMITS? JMP *+3 YES, DON'T FORCE NEW HEADER. CCA SET LINE COUNT TO -1 TO FORCE PAGE EJECT STA LINES TITLE AT THE BEGINNING. LDA LABCT COMPLEMENT LABCT TO FACILITATE STA LBLCT CMA ITS USE AS A COUNTER. STA LABCT SPC 1 * SECTION TO PROCESS A SINGLE LABEL * SPC 1 DUMP ISZ LABCT ANY MORE LABELS ? JMP DOLAB YES. LDA LETOP GET LIMIT PARAMETER. SZA LIMITS SUPPLIED FROM KEYBOARD ? JMP KYRTN YES, BYPASS PAGE EJECT. PEJEC JSB FCONT DEF *+5 EJECT DEF DCBL PAGE DEF ?ERR DEF .110B DEF LINES SSA,RSS ERRORS? JMP STOP NO CPA .M12 -12 ERROR? JMP STOP YES, THEN IGNORE IT JSB ?FMPE FMP ERROR ROUTINE DEF AL+1 FILE NAME KYRTN ISZ RUN SET RUN NOT EQUAL TO ZERO JMP RSTAR RETURN FOR NEXT LIMITS * DOLAB LDA MAXCC SET CCNT SO AS TO FORCE A STA CCNT BLANK LINE. JSB LINE * * SEARCH LABEL TABLE TO FIND THE FIRST LABEL, ALPHABETICALLY * * LDA MASK8 INITIALIZE TO A STA LABEL MAXIMUM. LDA ?FWA INITIALIZE LPNTR TO POINT AT STA PNTR1 FIRST ENTRY. LDA LTAB. SET LTAB. AS END OF TABLE CMA,INA POINTER. STA PNTR2 CLA INTIALIZE ORDNL TO STA ORDNL ZERO. DOLB1 ISZ ORDNL ADVANCE ORDNL. LDB PNTR1 TEST FOR END OF LTAB. ADB PNTR2 SSB,RSS SKIP IF NOT END OF LABEL TABLE. JMP GOTLB GO TO PRINT SECTION. * * MOVE CURRENT LABEL TO TEST ARRAY. * * LDA BLBL FIRST INITIALIZE TO BLANKS. STA TEST+1 STA TEST+2 STA TEST+3 STORE BLANKS IN TEST BUFFER LDA PNTR1 SET TEMP TO POINT AT CURRENT STA TEMP LABEL. LDB .TEST SET B TO POINT AT TEST ARRAY. LDA TEMP,I GET FIRST WORD OF LABEL IN A. AND MASK8 GET FIRST CHARACTER IN STA TEST TEST. XOR TEMP,I GET WORD COUNT IN HI-PART OF A. ALF,ALF ROTATE TO LO-PART. CMA,INA STORE AS NEGATIVE IN COUNT. STA COUNT DOLB2 ISZ TEMP ADVANCE LABEL POINTER. ISZ COUNT TEST FOR ANY MORE WORDS IN L=ABEL INB,RSS ADVANCE TEST POINTER, SKIP JMP COMPR GO TO COMPARISON SECTION. LDA TEMP,I GET NEXT WORD OF LABEL. STA 1,I AND MOVE IT TO TEST ARRAY. JMP DOLB2 SPC 1 * COMPARISON SECTION * SPC 1 COMPR LDA .LAB SET TEMP1 TO POINT STA TEMP1 AT LABEL LDB .TEST AND B TO POINT AT TEST LDA MIN4 SET COUNT TO -4 STA COUNT DOLB3 LDA TEMP1,I GET LABEL WORD IN A AND CMA,INA SUBTRACT IT FROM ADA 1,I TEST WORD. SSA IF TEST WORD IS SMALLER, GO TO JMP MOVE MOVE SECTION; SZA IF BIGGER GO TO JMP KEEP KEEP SECTION. ISZ COUNT TEST FOR ANY MORE WORDS. RSS YES. JMP KEEP NO--SHOULDN'T COME HERE ISZ TEMP1 ADVANCE LABEL POINTER INB AND TEST POINTER JMP DOLB3 MOVE LDA 1,I MOVE TEST WORD TO LABEL STA TEMP1,I ISZ TEMP1 ADVANCE INB POINTERS. ISZ COUNT ANY MORE WORDS IN TEST ? JMP MOVE YES. LDA PNTR1 SET UP ADDRESS OF BEST LABEL STA BESTL SO FAR. LDA ORDNL SET ORDINAL OF THAT STA BESTO LABEL ALSO. KEEP LDA TEMP SET PNTR1 TO NEXT LABEL, AND STA PNTR1 GO TO TEST THE JMP DOLB1 NEXT ONE. * SKP * SECTION TO PRINT FOR THE OPTIMUM LABEL * SPC 1 GOTLB LDA BESTL,I STORE A MAXIMUM CHARACTER IOR MASK8 IN THIS LABEL SO THAT WE STA BESTL,I DON'T PICK IT UP AGAIN. LDA LABEL+3 SAVE LAST WORD OF LABEL STA TEMPZ SAVE LAST WORD IN TEMPZ LDA BESTO GET ADDRESS OF XTAB ENTRY JSB ORDLK IN A AND SAVE IN STA PNTR1 PNTR1. LDA PNTR1,I GET LENGTH OF ENTRY AND SAVE STA COUNT IN COUNT. LDB LABEL LOAD B WITH FIRST WORD OF LABEL ADB UPBLN ADD ENTRIES CPA MIN2 SEE IF ONLY ONE ENTRY ADB UPBLN YES. FORCE "@" FOR FIRST CHAR. STB LABEL OF LABEL GOTL1 ISZ COUNT TEST COUNT FOR ANY MORE. JMP *+3 GO TO DO NEXT SEQUENCE NUMBER. JSB LINE JMP DUMP GO TO DO NEXT LABEL. CCA SUBTRACT 1 FROM PNTR1 SO AS ADA PNTR1 TO HAVE IT POINT AT NEXT STA PNTR1 SEQUENCE NUMBER. LDB MIN4 SET MINUS 4 INTO STB PCOUN POWERS OF TEN COUNTER. LDA PNTR1,I LOAD A WITH THE SEQUENCE NUMBER. SSA NEGATIVE SEQUENCE NUMBER? JMP DEFDD YES, PROCESS DOUBLY-DEFINED LABEL. AND MSK12 OBTAIN THE STA SEQNO SEQNO AND XOR PNTR1,I TAPE NO. ROTAT NOP ROTATE TAPE # TO LOW BITS INA INCREMENT A BY ONE STA TAPNO LDA BLANK OUTPUT A BLANK JSB OUTCR CHARACTER. LDA .P10 SET SQ1 TO POINT AT POWERS OF STA SQ1 TEN TABLE LDB SEQNO LOAD A WITH SEQUENCE NUMBER SZB,RSS SKIP IF NOT ZERO JMP UNDEF GO MODIFY DEFINITION AREA DGLUP LDA SIXTY INITIALIZE A TO ASCII 0 ADB SQ1,I TRY & SUBTRACT A POWER OF TEN. SSB SKIP IF O.K. JMP *+3 INA BUMP OUTPUT DIGIT JMP *-4 & LOOP. CMB ADD BACK THE ADB SQ1,I POWER OF CMB TEN, AND SAVE STB SEQNO REMAINDER IN SEQNO JSB OUTCR OUTPUT THE DIGI ISZ SQ1 ADVANCE POWER OF 10 POINTER. LDB SEQNO LOAD B WITH SEQUENCE NUMBER ISZ PCOUN ANY MORE DIGITS? JMP DGLUP YES. LDA .TAPE LOAD A WITH TAPE # PARAMETER SZA SKIP IF PARAMETER IS ZERO JMP EASYT IF NOT ZERO SKIP OUTPUT TAPE NO. ROUT. gTRNNT SPC 2 * NOW OUTPUT THE TAPE NUMBER.* SPC 1 CPA TPCNT IS THE TAPE COUNT ZERO JMP EASYT YES; GO OUTPUT BLANKS LDA SLASH OUTPUT A SLASH. JSB OUTCR LDB TAPNO GET TAPE NUMBER IN B LDA SIXTY SET A TO ASC 0 ADB MTEN IF B IS GREATER OR EQUAL TO 10 SSB JMP *+3 INA THEN THE FIRST DIGIT IS A 1 JMP *-4 ADB FEED STB TAPNO AND THE SECOND IS TAPNO-10 JSB OUTCR FIRST DIGIT. LDA TAPNO ADA SIXTY JSB OUTCR SECOND DIGIT JMP GOTL1 SPC 1 DEFDD LDA BLANK OUTPUT A BLANK JSB OUTCR CHARACTER. LDA HASH GET ASCII '#'. RSS SKIP UNDEF INITIALIZATION. UNDEF LDA QUEST LOAD A WITH "?" LDB LABEL LOAD B WITH FIRST WORD OF LABEL CPB BL.AS COMPARE FIRST WORD WITH AN ASTERISK LDA STAR LOAD A WITH A "*" CPB BL.EQ COMPARE FIRST WORD WITH AN "=" LDA DOT LOAD A WITH A "." FIELD JSB OUTCR GO TO OUTPUT CHARACTER ROUTINE ISZ PCOUN INCREMENT POINTER JMP FIELD RETURN FOR NEXT CHAR LDB TPCNT LOAD B WITH TAPE COUNT SZB,RSS SKIP IF COUNT NOT ZERO EASYT LDA BLANK OUTPUT JSB OUTCR THREE BLANKS JSB OUTCR WHEN JSB OUTCR TAPNO=1. JMP GOTL1 SPC 1 * ROUTINE TO MOVE A CHARACTER TO THE OUTPUT BUFFER * SPC 1 OUTCR NOP STA CR1 SAVE CHARACTER IN CR1. ISZ CCNT TEST FOR END OF LINE. JMP *+3 NOT END OF LINE. JSB LINE OUTPUT THE LINE. JMP *-3 TRY AGAIN. LDA CR1 PUT THE LDB CPNTR CHARACTER IN THE JSB A2BUF OUTPUT BUFFER. ISZ CPNTR ADVANCE CHARACTER POINTER. LDA CR1 RETURN WITH CHARACTER JMP OUTCR,I STILL IN A. SPC 2 * ROUTINE TO PRINT THE OUTPUT LINE * SPC 1 LNE NOP ISZ V+LINES ADVANCE THE LINE COUNT. JMP LNE,I IF NOT END OF PAGE SKIP OUT ISZ FIRLN IF FIRST OUTPUT, THEN JMP NOPAG BYPASS PAGE-EJECT. JSB FCONT DEF *+5 DEF DCBL DEF ?ERR DEF .110B DEF LNSKP SSA,RSS ERRORS? JMP NOPAG NO CPA .M12 -12 ERROR? JMP NOPAG YES, THEN IGNORE IT JSB ?FMPE DEF AL+1 * NOPAG LDA MIN6 LOAD A WITH -6 FOR NEXT SKIP PAGE END STA LNSKP STORE IN END PAGE SKIP EXEC CALL ISZ PAGNO INCREMENT PAGE NUMBER BINARY LDA PAGNO CONVERT JSB CNDEC BINARY STA PGNUM+1 PAGE INB NUMBER LDA B,I TO ASCII STA PGNUM IN HEDDING LDA HEDCT PRINT THE PAGE LDB .NAME HEADING. JSB WRITE CLA JSB WRITE LDA TCNT LDB .TITL JSB WRITE CLA JSB WRITE LDA NLINZ SET LINE COUNT TO -55. STA LINES CCA SET FLAG TO ALLOW STA FIRLN PAGE-EJECT AT NEXT CALL. JMP LNE,I RETURN * FIRLN NOP FIRST PASS FLAG. SPC 2 LINE NOP JSB LNE GO TEST AND PROCESS EOT LDA TEMPZ RECALL LAST WORD OF LABEL STA LABEL+3 INSTAL INTO LAST POSITION OF LABEL AND MASK8 SAVE LAST CHARACTER CPA BLANK SEE IF LAST CHARACTER IS BLANK JMP *+4 NO; SKIP NEXT FOUR INSTRS, LDA DOT LOAD A WITH A LOW CHAR DOT IOR UPBLN ADD A UPPER BLANK STA LABEL+4 STORE ONLY ONE DOT INSTED OF TWO LDA CCNT GET CHARACTER COUNT IN A SZA,RSS IF 0 THEN IT SHOULD BE -1. CMA ADA DEC73 GET + NUMBER OF CHARS. FOR PRINT. CLE,SLA,ERA JMP ODDCN PROCESS ODD CHARS LINE1 LDB ..LAB GET ADDRESS OF PRINT BUFFER. JSB WRITE LDA BLBL BLANK OUT THE STA LABEL  LABEL STA LABEL+1 FIELD. STA LABEL+2 STA LABEL+3 BLANK OUT FIELD STA TEMPZ SET LAST LABEL WORD TO BLANKS LDA OUTBF RESET CPNTR TO POINT ADA MIN1 STA CPNTR BEYOND THE LABEL. LDA SETCC INITIALIZE CCNT STA CCNT & JMP LINE,I RETURN SPC 1 ODDCN STA WRCNT LDB ..LAB ADB A LDA B,I AND MSKUP IOR BLANK STA B,I LDA WRCNT INA JMP LINE1 MSKUP OCT 177400 * ROUTINE TO FETCH A CHARACTER FROM A STRING * SPC 1 BUF2A NOP CLE,ERB ROTATE TO GET ADDRESS IN B LDA 1,I GET WORD IN A SEZ,RSS IF E=0, ROTATE TO GET CHARACTER ALF,ALF IN LOW END. AND MASK7 MASK THE CHARACTER JMP BUF2A,I SPC 1 * ROUTINE TO STORE A CHARACTER INTO A STRING * SPC 1 A2BUF NOP STA TEMP SAVE CHARACTER IN TEMP ERB COMPLEMENT LOW ORDER BIT OF B. CME ELB JSB BUF2A OBTAIN MATE TO THIS CHARACTER ALF,ALF IN HIGH END. IOR TEMP INSERT THE OTHER CHARACTER SEZ AND ALF,ALF ROTATE IF NECESSARY. STA 1,I STORE THE WORD & JMP A2BUF,I RETURN. SPC 1 * CHAR GETS THE NEXT CHARACTER FROM THE INPUT STRING * SPC 1 CHAR NOP LDB CPNTR GET CHARACTER POINTER. LDA FEED IN CASE OF END OF RECORD. ISZ CPNTR BUMP CHARACTER POINTER. ISZ CCNT TEST FOR END OF RECORD. JSB BUF2A NOT END OF RECORD. JMP CHAR,I * * LOOK FINDS THE ID IN LABEL IN THE TABLE SPECIFIED * SPC 1 LOOK NOP LDA LOOK,I GET TABLE STARTING ADDRESS. STA .LOOK ISZ LOOK LDA LOOK,I GET TABLE ENDING ADDRESS CMA,INA STORE AS NEGATIVE STA LOOK. CLA INITIALIZE LOOKC STA LOOKC TO ZERO. ISZ KLOOK SET LOOK TO POINT TO RETURN ADRS LOOK1 ISZ LOOKC BUMP COUNTER. LDB .LOOK TEST FOR END OF LIST ADB LOOK. B POSITIVE IF THE END. CLA SSB,RSS SKIP IF NOT END OF LIST. JMP LOOK,I RETURN WITH A=0, IF END OF LIST. * * NEXT 4 INSTRUCTIONS FOR MULTI-OPERAND OP-CODES (E.G. 'MIC') * * LDA .LOOK,I GET FIRST WORD OF TABLE ALF POSITION OPERAND COUNT AND .15 ISOLATE NUMBER OF OPERANDS STA OPCNT SAVE NUMBER OF OPERANDS. LDA .LOOK,I GET FIRST WORD OF LIST ELEMENT ALF,ALF GET NUMBER OF WORDS IN A. AND .15 ISOLATE NUMBER OF WORDS IN ENTRY. LDB .LOOK GET ADDRESS OF LIST ELEMENT IN B ADA 1 AND ADD WORD COUNT TO IT SO IT STA .LOOK POINTS AT NEXT ELEMENT. LDA .LAB SET TEMP TO POINT AT THE STA TEMP LABEL. LDA B,I GET FIRST WORD OF LABEL. AND MASK9 STRIP NUMBER OF OPERANDS. RSS GO TO COMPARE WITH LABEL. LOOK2 LDA 1,I LOAD A WORD FROM THE ELEMENT IN- CPA TEMP,I TO A AND COMPARE WITH LABEL. INB,RSS BUMP LIST ELEMENT POINTER. JMP LOOK1 IF NOT EQUAL GO GET NEXT ELEMENT LDA LOOKC COMPARE TO NEW VALUE OF .LOOK CPB .LOOK RETURN WITH A=LOOKC IF EQUAL. JMP LOOK,I ISZ TEMP BUMP LABEL POINTER ALSO AND JMP LOOK2 CONTINUE CHECKING THIS ELEMENT SPC 1 * LLKUP RETURNS THE ORDINAL OF LABEL IN THE LABEL TABLE * SPC 1 LLKUP NOP JSB LOOK LOOK UP LABEL IN LABEL TABLE FWA DEF * LTAB. BSS 1 END OF LABEL TABLE. SZA IF ORDINAL NOT 0, LABEL IS IN JMP LLKUP,I TABLE, SO RETURN. LDA LABEL GET FIRST WORD OF LABEL AND FIND ALF,ALF ITS WORD COUNT. AND .15 CMA,INA STORE AS NEGATIVE IN STA PCOUN PCOUN. ADA .XTAB COMPUTE .XTAB-LTAB.+PCOUN-1 CMA,INA AND TEST FOR POSITIVE. ADA LTAB. CMA,SSA JMP OVERR OTHERWISE, TABLE OVERFLOW. LDB .LAB MOVE LABEL TO LABEL TABLE. LDA 1,I A_LABEL WORD STA LTAB.,I PUT IN LTAB ISZ LTAB. BUMP THE INB POINTERS. ISZ PCOUN ANY MORE? JMP *-5 YES LDA MIN2 NO. SET -2 IN XTAB AS NUMBER OF STA .XTAB,I WORDS IN ENTRY. ADA .XTAB SUBTRACT 2 FROM XTAB TO POINT IT STA .XTAB AT NEW BEGINNING OF TABLE. INA STORE A ZERO IN XTAB ENTRY TO CLB SAY THAT LABEL IS UNDEFINED SO STB 0,I FAR. LDA LOOKC RETURN LOOKC AS ORDINAL OF THIS ISZ LABCT LABEL. JMP LLKUP,I SPC 1 * ORDLK GETS THE ADDRESS OF THE NTH ENTRY IN XTAB * SPC 1 ORDLK NOP CMA,INA GET N IN PUTS1 AS STA PUTS1 NEGATIVE. LDA ?LWA STB MKSEQ TEMPORARILY SAVE CONTENTS OF B ISZ PUTS1 TEST FOR A LINK RSS JMP ORDLK,I ADA 0,I LINK THROUGH XTAB JMP *-4 SPC 1 * MKSEQ STORES THE CURRENT SEQUENCE NUMBER IN 0,I * SPC 1 MKSEQ NOP STA 1 ADDRESS TO LDA DDFLG GET DOUBLY-DEFINED FLAG. SZA PROCESSING DOUBLE-DEF.? JMP *+3 YES, USE ORIG. SEQ. NO. FOR NEW ENTRY. LDA SEQNO GET CURRENT SEQUENCE NUMBER. IOR TAPNO ADD IN THE CURRENT TAPE NUMBER. STA 1,I STORE IT INTO XTAB. JMP MKSEQ,I * DDFLG NOP DOUBLE-DEF FLAG (SEQUENCE/TAPE NO.) * PUTSQ INSERTS THE CURRENT SEQUENCE NUMBER IN XTAB. A CONTAINS THE * ORDINAL, AND B=-1 IF THIS IS ONLY TO BE STORED AS THE LABEL SE- * QUENCE NUMBER, OR B=0 IF THE TABLE MUST BE EXPANDED TO ADD A NEW * ELEMENT TO THE SPECIFIED ENTRY. SPC 1 PUTSQ NOP JSB ORDLK GET ADDRESS OF ENTRY STA TEMP SAVE ADDRESS FOR DOUBLE-DEF PROCESSING. ai SZB,RSS IF B IS ZERO, GO TO TABLE MOVE JMP PUTS2 SECTION. ADA 1 SET A TO POINT AT LABEL SEQ.NO. LDB 0,I TEST TO SEE IF A SEQUENCE NUMBER SZB IS ALREADY THERE. JMP DDERR DOUBLY DEFINED SYMBOL. PUTS3 JSB MKSEQ NOW COMPUTE THE SEQUENCE NUMBER LDA TEMP GET ENTRY ADDRESS. CLB PREPARE TO CLEAR DOUBLE-DEF FLAG. CPB DDFLG IS THE DOUBLE-DEF FLAG SET? JMP PUTSQ,I NO, RETURN. STB DDFLG YES, CLEAR IT, AND ADD NEW ENTRY. PUTS2 CCB ADD ONE TO THE ADB 0,I NUMBER OF ELEMENTS IN THE STB 0,I ENTRY. ADA 0,I ADD THIS TO A (AND ADD THE 1 INA BACK IN) TO GET THE ADDRESS STA PUTS1 OF THE NEW ELEMENT. LDA .XTAB MOVE ELEMENTS IN [.XTAB+1,PUTS1] STA PUTS5 DOWN 1 LOCATION. CMA -.XTAB-1 ADA LTAB. +LTAB. SSA,RSS IF POSITIVE, THEN JMP OVERR TABLE OVERFLOW. LDB .XTAB SET B TO BEGINNING OF BLOCK. CPB PUTS1 JMP PUTS6 BLOCK MOVED. INB LDA 1,I MOVE A STA PUTS5,I WORD. ISZ PUTS5 ADVANCE DESTINATION POINTER. JMP *-6 PUTS6 CCA DECREMENT .XTAB ADA .XTAB STA .XTAB LDA PUTS1 JMP PUTS3 * DDERR SSB,RSS ALREADY DOUBLY-DEFINED? JMP NEWDD NO, GO PROCESS DOUBLE DEFINITION. LDA TEMP YES, GET XTAB ENTRY-ADDRESS. JMP PUTS2 GO TO ADD NEW ENTRY. NEWDD SWP ADDRESS TO , SEQUENCE NUMBER TO . STA DDFLG SAVE SEQUENCE NUMBER AS DOUBLE-DEF FLAG. IOR RM2 SET SIGN FOR DOUBLE DEFINITION INDICATOR. STA B,I PLACE IN XTAB'S LABEL SEQUENCE NO. LDA TEMP GET ENTRY ADDRESS. JMP PUTS2 GO TO ADD FIRST SEQUENCE NO.TO ENTRIES. SPC 1 * ID SCANS THE INPUT STRING & BUILDS THE NEXT IDENTIFIER. IF THERE * IS ONE, IT SKIP RETURNS. SPC 1 ID NOP CLA STA ALTRL LDA BLBL INITIALIZE LABEL TO BLANKS. STA LABEL+1 STA LABEL+2 STA LABEL+3 BLANK OUT FIELD LDA ONEBL STA LABEL STA L.DLM LDA MIN6 INITIALIZE CHARACTER COUNTER. STA ID1 LDA LABCH SET LABEL CHARACTER POINTER IN STA TEMP1 TEMP1 LDA NEXT IF LAST CHARACTER WAS A CPA FEED FEED , THIS IS THE END OF JMP ID,I CARD ID2 JSB CHAR GET NEXT CHARACTER STA NEXT PUT INTO NEXT. CPA EQUAL IS THE CHAR AN #="? JMP LITRL YES, GO PROCESS THE LITERAL CPA BLANK SKIP BLANKS JMP ID2 JSB LETTR IS IT A LETTER JMP NONID ...NO-GO TO SCAN FOR END OF FIELD SPC 1 * ADD THIS LETTER TO THE LABEL SO FAR * SPC 1 ID4 LDB ID1 LABEL CHARACTER COUNT. INB,SZB,RSS MORE THAN 5 CHARACTERS ? JMP ID3 YES STB ID1 BUMP CHARACTER COUNT ISZ TEMP1 BUMP CHARACTER POINTER LDB TEMP1 INSERT CHARACTER IN JSB A2BUF LABEL STRING LDA LABEL LDB ID1 ADD ONE TO LABEL WORD COUNT SLB,RSS IF ID1 IS EVEN. ADA HIGH1 STA LABEL LDA NEXT LOAD THE LAST CHARACTER READ. CPA TEMP IS THE LAST CHARACTER PROCESSED? ID3 JSB CHAR GET NEXT CHARACTER AND MASK7 ISOLATE THE LOWER 7 BITS STA NEXT SAVE THE NEW CHARACTER ISZ L.DLM CHARACTER #3 OF A LITERAL JMP ID0 NO, CONTINUE ID5 LDB ALTRL SSB,RSS JMP ID7 CPA FEED END OF ERCORD? JMP ID6 YES, GO ISSUE A SKIP RETURN. JMP ID4 NO, GO INSERT CHARACTER IN LABEL ID0 CLB,INB ENTER: B=1 CPB L.DLM CHARACTER #4 OF A LITERAL? JMP ID5 YES GO BACK FOR EOR CHECK ID7 JSB LETTR IS IT A LETTER RSS NO JMP ID4 YES  JSB DIGIT IS IT A DIGIT JMP ID4 YES STA NEXT ID6 ISZ ID JMP ID,I SPC 1 NOTID STA NEXT SCAN FOR END OF FIELD. CPA BLANK JMP ID,I NONID CPA COMMA JMP ID,I CPA PLUS JMP ID,I CPA MINUS JMP ID,I CPA FEED JMP ID,I JSB CHAR JMP NOTID SPC 1 * LETTER DETERMINES WHETHER THE CHAR IN A IS A LEGAL HPAP LETTER * * LETTR NOP CPA BLANK BLANKS JMP LETTR,I & CPA FEED LINE FEEDS ARE JMP LETTR,I NOT LETTERS. JSB DIGIT IS IT A DIGIT ? JMP LETTR,I YES--NOT A LETTER. LDB 0 GET CHARACTER IN B & CMB,INB SUBTRACT FROM ADB LETMX LETMX SSB IF NOT SMALLER THEN JMP ISLET IT IS A LETTER. ADB LETMN OTHERWISE TEST AGAINST SSB,RSS LETMN. ISLET ISZ LETTR JMP LETTR,I LITRL JSB CHAR GO GET NEXT CHARACTER STA NEXT SAVE THE NEW CHARACTER CPA FEED END OF RECORD? JMP ID,I YES, RETURN CPA BLANK JUMP IF BLANK JMP ID6 YES, GO GET NEXT CHARACTER CPA EQ.L COMPARE TO OCTAL 114 "L" JMP ID2 YES, GO PROCESS SYMBOLS LDB MIN2 LOAD: B=-2 STB L.DLM SET THE LITERAL COUNT FLAG. ADB ID1 DECREMENT SYMBOL LIMIT BY 2 STB ID1 ALLOW SYMBOL TO BE 7 CHARS. CLB CPA EQ.A CCB STB ALTRL LDB .EQ. NO, LOAD THE SPECIAL "=". LDA EQUAL LOAD AN "=" CHAR. CPA NEXT IS THE NEW CHAR. AN "=" STB NEXT YES, STORE THE SPECIAL "=". JMP ID4 GO ENTER "=" INTO LABEL STRING. SPC 1 LETMX OCT 55 LETMN DEC -6 ALTRL NOP EQ.A OCT 101 SPC 2 * DIGIT DETERMINES WHETHER THE CHARACTER IN A IS A DIGIT * SPC 1 DIGIT NOP LDB 0 GET CHAR IN B CMB,INB AS NEGATIVE ADB DIGMX COMPARE TO MAXIMUM DIGxrIT (ASC9) SSB JMP NODIG ADB DIGMN AND TO MINIMUM DIGIT (ASC0) SSB,RSS NODIG ISZ DIGIT SKIP RETURN IF NOT A DIGIT JMP DIGIT,I SPC 1 DIGMX OCT 71 * SKP * CONSTANTS & VARIABLES * SPC 1 SEQNO NOP LABCT NOP .XTAB NOP TAPE1 OCT 004000 TAPE NUMBER --- INCREMENT CONSTANT. TAPNO NOP NEXT NOP DM40 DEC -40 DEC73 DEC 73 DEC80 DEC 80 BUFAD DEF CBUF CCNT NOP CHAR1 NOP STAR OCT 52 BLANK OCT 40 PLUS OCT 53 MINUS OCT 55 SLASH OCT 57 COMMA OCT 54 LPREN OCT 50 RPREN OCT 51 BL.AS ASC 1, * BL.EQ ASC 1, = DOT OCT 56 QUEST OCT 77 EQUAL OCT 75 EQ.L OCT 114 .EQ. OCT 275 L.DLM OCT 440 SSTAR OCT 24000 SPCLB OCT 1452 UPBLN OCT 20000 LINES NOP DEC40 EQU LPREN MAXCC DEC -71 PNTR1 NOP PNTR2 NOP ORDNL NOP TEMP NOP .TEST DEF TEST COUNT NOP ..LAB DEF LABEL-1 .LAB DEF LABEL TEMP1 NOP HIBND BSS 1 LOBND BSS 1 TWO DEC 2 BESTL NOP BESTO NOP MSK12 OCT 003777 11 BIT SEQUENCE NUMBER MASK = 2048. .P10 DEF *+1 DEC -10000,-1000,-100,-10,-1 MIN1 EQU *-1 MTEN EQU *-2 DIGMN EQU MTEN SQ1 NOP MIN4 DEC -5 PCOUN NOP SIXTY OCT 60 CR1 NOP LBLCT OCT 000000 .NAME DEF HEDR .TITL DEF BLBL .NMEX DEF NAMXT NAMLN NOP NLINZ DEC -55 LNSKP DEC -55 OUTBF NOP SETCC DEC -64 MASK7 OCT 177 MASK8 OCT 377 MASK9 OCT 7777 CPNTR NOP FEED OCT 12 .LOOK NOP LOOKC NOP LOOK. NOP MIN2 DEC -2 PUTS1 NOP PUTS5 NOP ONEBL OCT 440 MIN6 DEC -6 INDIR NOP SET FOR COMMA IN MULTI-OP INSTR. TEMP2 NOP OPCNT NOP NO. OPERANDS IN CURRENT STATEMENT. FXEND DEF OPEND "CODED" END OF OP-CODE TABLE. MICOP DEF EJMP POINTER TO START OF MICRO-OPS. LABCH NOP HIGH1 OCT 400 HASH OCT 43 ASCII '#' ASC 1, LABEL BSS 4 CBUF BSS 40 SUP HEDR ASC 4, PAGE PGNUM ASC 4,0000 ASC 8, NAME ASC 4, NAMXT ASC 20, BLBL ASC 19, CROSS-REFERENCE ASC 6,SYMBOL TABLE HEDCT EQ<U DEC80 TCNT DEC 50 RUN BSS 1 PAGNO NOP .TAPE BSS 1 TPCNT BSS 1 SKP OVERR JSB IMESS DEF *+4 DEF .2 DEF OVDEF DEF .11 CLA JMP STOP1 * OVDEF ASC 11, /XREF: TABLE OVERFLOW .11 DEC 11 TEST BSS 4 ID1 BSS 1 * * READ ROUTINE READS ONE RECORD FROM THE INPUT DEVICE SPECIFIED. * * CALLING SEQUENCE: * LDA <# CHARACTERS(+)> * LDB * JSB READ * READ NOP STA RDCNT STB RD10 JSB %READ UTILITY READ ROUTINE DEF *+4 RD10 DEF * DEF RDCNT JMP NDFIL END OF FILE ERROR RETURN STB A SET # CHAR IN JMP READ,I RETURN * RDCNT NOP NDFIL JSB IMESS DEF *+4 DEF .2 DEF ENDFA MESSAGE BUFFER POINTER DEF DEC10 JMP STOP1 ENDFA ASC 10, /XREF: END OF FILE * * WRITE ROUTINE OUTPUTS ONE LINE TO OUTPUT DEVICE * * CALLING SEQUENCE: * LDA # OF CHARS(+) OR 0 IF SINGLE SPACE * LDB BUFFER ADDRESS * JSB WRITE * WRITE NOP SZA,RSS CHECK IF TO SPACE 1 LINE JMP WSPAC YES STA WRCNT STB WRI10 STORE BUFFER ADDRESS JSB WRITF OUTPUT ONE LINE DEF *+5 DEF DCBL DEF ?ERR WRI10 NOP DEF WRCNT SSA,RSS ERRORS? JMP WRITE,I RETURN JSB ?FMPE DEF AL+1 LIST FILE NAME * WSPAC JSB FCONT OUTPUT SINGLE SPACE DEF *+5 DEF DCBL DEF ?ERR DEF .110B DEF .1 SSA,RSS ERRORS? JMP WRITE,I NO, RETURN CPA .M12 -12 ERROR? JMP WRITE,I YES, THEN IGNORE IT JSB ?FMPE FMP ERROR ROUTINE DEF AL+1 LIST FILE NAME * STOP LDA NAME GET FIRST NAME CHARACTER. CPA BLBL NAME PRESENT ? JMP STOP1 NO, USE ASTERISKS FOR TERM. MESSG. AND MASK8 STRIP OFF UPPER BLANK IOR CARET ADD LEFT CARET, TO CONFIGURE STA BMESS+7 $END MESSAGE LDA NAME+1 TO INCLUDE STA BMESS+8 THE PROGRAM LDA NAME+2 NAME STA BMESS+9 IF, ANY. STOP1 JSB IMESS DEF *+4 DEF .2 DEF BMESS DEF .11 * JMP RTNXR RETURN TO MAIN PROGRAM * * DEC10 EQU FEED BMESS ASC 11, /XREF: $END <*****> * * KEYBD READS INPUT FROM SYSTEM TELETYPE FOR SETTING * CROSS-REFERENCE GENERATION SEARCH LIMITS. * * CALLING SEQUENCE: * LDA <# CHARS (+)> * LDB * JSB KEYBD * KEYBD NOP CMA,INA STA WRCNT FORM CHARACTER COUNT STB INBUF JSB IMESS READ IN # OF CHARACTERS DEF *+4 DEF .1 REQUEST CODE INBUF NOP BUFFER ADDRESS DEF WRCNT CHAR COUNT JMP KEYBD,I RETURN SPC 1 CNDEC NOP BINARY TO DECIMAL ASCII LDB MTEN STB CNDIV LDB A00 STB ASCI STB ASCI+1 STB ASCI+2 LDB CNMBR STB CNMLC CNORG JSB DVUKN DIVIDE BY 10 ADB CNMLC,I STB CNMLC,I SZA,RSS JMP CNOUT JSB DVUKN BLF,BLF ADB CNMLC,I STB CNMLC,I ISZ CNMLC SZA JMP CNORG CNOUT LDB CNMBR+3 LDA CNMBR+1 STA CNMBR+3 STB CNMBR+1 LDB CNMBR JMP CNDEC,I SPC 1 DVUKN NOP CLB CLEAR LOOP COUNTER = QUOTIENT + STB DVTMP DVU00 STA B FLAG ALLOW BIT 15 OF # TO BE SET DVU01 ADA CNDIV DIDIDE BY SUCCESSIVE SUBTRACTION ISZ DVTMP SSA,RSS DONE IF A IS NEG AND B IS POS JMP DVU00 CLEAR B TO ALLOW EXIT SSB EXIT IF POS JMP DVU01 ORIGINAL # TO CONVERT WAS NEG LDB CNDIV DONE CMB,INB ADB A REMAINDER TO B LDA DVTMP ADA MIN1 QUOTIENT TO A JMP DVUKN,I * DVTMP BSS 1 CNDIV NOP CNMLC NOP ;ZHFB A00 ASC 1,00 CNMBR DEF *+1 ASCI ASC 3, SPC 1 * READS SOURCE FROM DISK (IF LUN= 2) OR OTHER DEVICE * RETURNS WITH: (B) = NO.OF CHARS. * CALLING SEQUENCE FOR %READ: JSB %READ * DEF *+4 * DEF BUFFR FWA OF READ-BUFFER * DEF RLEN +(NO OF CHARS) * EOF RETURN * NORMAL RETURN %READ NOP LDA %READ,I STA EXIT RETURN ADDRESS ISZ %READ LDA %READ LDA 0,I RAL,CLE,SLA,ERA TEST I-BIT AND CLEAR JMP *-2 INDIRECT, GO ON THRU INDIR.CHAIN STA RBFAD FWA OF READ-BUFFER ISZ %READ LDA %READ,I STA RLGTH RECORD-LENGTH ADDR LDA A,I CHANGE LNGTH TO WORDS ARS STA RLGTH,I ISZ %READ BUMP RETURN ADDR FOR EOF RETURN * JSB READF READ RECORD DEF *+6 RETURN DEF DCBI INPUT DCB DEF ?ERR ERROR WORD RBFAD NOP BUFFER ADR RLGTH NOP BUFFER LENGTH - WORDS DEF LENI ACTUAL LNGTH READ SSA,RSS TEST FOR ERROR JMP EOFTS NO ERROR JSB ?FMPE DISPLAY ERROR AND ABORT DEF AI+1 INPUT FILE NAME * EOFTS LDB LENI TEST FOR EOF CPB M1 JMP %READ,I TAKE EOF RETURN; ELSE, BLS CONVERT COUNT TO WORDS JMP EXIT,I EXIT * EXIT BSS 1 EXIT POINT LENI NOP H SKP * * MORE CONSTANTS, ETC. * * WRCNT NOP .1 DEC 1 .2 DEC 2 .3 DEC 3 .6 DEC 6 .7 DEC 7 .15 DEC 15 .18 DEC 18 .55 DEC 55 MAXIMUM ALLOWABLE LINES/PAGE .110B OCT 1100 CARET OCT 036000 RM1 OCT 077777 RM2 OCT 100000 RM3 RAL RM4 OCT 003777 RM5 OCT 004000 RM6 ALF,RAL DEFCB DEF CBUF DEFLB DEF LABEL LETOP NOP TEMPZ NOP EMESG ASC 18, /XREF: ENTER LIMITS OR ?_ SLSHE ASC 1,/E TPMSG DEF *+1 ASC 10, /XREF: >16 TAPES !! * SKP ************************************************************************* * * * * OPERATOR BRANCH TABLE * * * * * EACH SINGLE ENTRY CORRESPONDS 1 FOR 1 WITH A 3-WORD OP-TABLE ENTRY. * * * * ENTRIES ARE ADDRESSES OF OPCODE/OPERAND PROCESSORS. * * * * EXAMPLES: * * * * << STANDARD OPCODES >> * * DEF DOSOP ABS : OPCODE WITH SINGLE OPERAND. * * * * << SPECIAL OPERANDS >> * * DEF DONAM NAM : PROCESS 'NAM' STATEMENT. * * * * << SPECIAL OPCODES >> * * DEF DOSPC IFN : OPCODE MODIFIES ASSEMBLED RESULTS, * * HAS NO DEFINING LABEL, AND * * DOES NOT HAVE AN OPERAND. 2 * * * * DEF DOSP1 ORG : (SAME AS DOSPC) BUT, HAS OPERAND. * * * ************************************************************************* SPC 3 SWICH DEF *+1,I * SJMP EQU * START OF BRANCH TABLE * DEF RAC 0 NO OP-TABLE ENTRY FOUND DEF DOSOP ABS DEF DOSOP ADA DEF DOSOP ADB DEF DOSOP ADX DEF DOSOP ADY DEF DOSOP AND DEF DOSOP ASC DEF DOSOP ASL DEF DOSOP ASR DEF DOSOP ATD DEF DOSOP BAD DEF DOSOP BDV DEF DOSOP BMY DEF DOSOP BSS DEF DOSOP BTD DEF DOSOP CBS DEF DOSOP CBT DEF DOSOP CLC DEF DOSOP CLF DEF DOSOP CMW DEF DOCOM COM DEF DOSOP CPA DEF DOSOP CPB DEF DOSOP DAD DEF DOSOP DBL DEF DOSOP DBR DEF DOSOP DCP DEF DOSOP DCS DEF DOSOP DEF DEF DOSOP DIV DEF DOSOP DJP DEF DOSOP DJS DEF DOSOP DLD DEF DOSOP DSB DEF DOSOP DSF DEF DOSOP DSN DEF DOSOP DST DEF DOSOP DTA DEF DOSOP DTB DEF DOEND END DEF DOENT ENT DEF DOSOP EQU DEF DOEXT EXT DEF DOSOP FAD DEF DOSOP FDV DEF DOSOP FMP DEF DOSOP FSB DEF DOSOP HLT DEF DOSPC IFN DEF DOSPC IFZ DEF DOSOP IOR DEF DOSOP ISZ DEF DOSOP JLY DEF DOSOP JMP DEF DOSOP JPY DEF DOSOP JRS DEF DOSOP JSB DEF DOSOP LAX DEF DOSOP LAY DEF DOSOP LBX DEF DOSOP ALBY DEF DOSOP LDA DEF DOSOP LDB DEF DOSOP LDX DEF DOSOP LDY DEF DOSOP LIA DEF DOSOP LIB DEF DOSOP LSL DEF DOSOP LSR DEF DOSOP MBT DEF DOSOP MIA DEF DOSOP MIB DEF DOMIC MIC DEF DOSOP MPY DEF DOSOP MVW DEF DONAM NAM DEF DOSPC ORB DEF DOSP1 ORG DEF DOSPC ORR DEF DOSOP OTA DEF DOSOP OTB DEF DOSOP RAM DEF DOSOP REP DEF DOSOP RRL DEF DOSOP RRR DEF DOSOP RPL DEF DOSOP SSM DEF DOSOP SAX DEF DOSOP SAY DEF DOSOP SBS DEF DOSOP SBX DEF DOSOP SBY DEF DOSOP SFC DEF DOSOP SFS DEF DOSOP SJP DEF DOSOP SJS DEF DOSOP SPC DEF DOSOP STA DEF DOSOP STB DEF DOSOP STC DEF DOSOP STF DEF DOSOP STX DEF DOSOP STY DEF DOSOP TBS DEF DOSOP UJP DEF DOSOP XCA DEF DOSOP XCB DEF DOSOP UJS DEF DOSPC XIF DEF DOSOP XLA DEF DOSOP XLB DEF DOSOP XOR DEF DOSOP XSA DEF DOSOP XSB * EJMP EQU *-SJMP NO. OF BRANCH TABLE ENTRIES * DEF DOSP1 OP-CODES DEFINED BY MIC INSTR. * * * END OF BRANCH TABLE * * SKP *************************************************************************** * * * * OPERATOR TABLE * * * * * EACH 3-WORD ENTRY CORRESPONDS 1 FOR 1 WITH ONE BRANCH TABLE ENTRY. * * *  * FORMAT: O*OOO*WWW*WAA*AAA*AAA, A*AAA*AAA*AAA*AAA*AAA * * * * WHERE: OOOO (WORD#1 BITS 15-12) = NO. OPERANDS THIS OP-CODE. * * [ 0 FOR ONE OPERAND; ACTUAL NO. FOR >1 OPERAND. ] * * WWWW (WORD#1 BITS 11-08) = NO. WORDS THIS ENTRY. * * AAAAAAAA (WORD#1 BITS 07-00) = 1RST ASCII CHAR. OF OP-CODE. * * AAAAAAAAAAAAAAAA (WORD#2)= PACKED ASCII CHARS.2/3 OF OPCODE. * * * *************************************************************************** SPC 3 OPBEG EQU * START OF OPERATOR TABLE * OCT 1101,41123,1101,42101,1101,42102 ABS ADA ADB OCT 1101,42130,1101,42131,1101,47104 ADX ADY AND OCT 1101,51503,1101,51514,1101,51522 ASC ASL ASR OCT 21101,52104,21102,40504,31102,42126 ATD BAD BDV OCT 31102,46531,1102,51523,21102,52104 BMY BSS BTD OCT 21103,41123,1103,41124,1103,46103 CBS CBT CLC OCT 1103,46106,1103,46527,1103,47515 CLF CMW COM OCT 1103,50101,1103,50102,21104,40504 CPA CPB DAD OCT 1104,41114,1104,41122,21104,41520 DBL DBR DCP OCT 1104,41523,1104,42506,1104,44526 DCS DEF DIV OCT 1104,45120,1104,45123,1104,46104 DJP DJS DLD OCT 21104,51502,31104,51506,1104,51516 DSB DSF DSN OCT 1104,51524,21104,52101,21104,52102 DST DTA DTB OCT 1105,47104,1105,47124,1105,50525 END ENT EQU OCT 1105,54124,1106,40504,1106,42126 EXT FAD FDV OCT 1106,46520 FMP OCT 1106,51502,1110,46124,1111,43116 FSB HLT IFN OCT 1111,43132,1111,47522,1111,51532 IFZ IOR ISZ OCT 1112,46131,1112,46520,1112,50131 JLY JMP JPY OCT 21112,51123 JRS OCT 1112,51502,1114,40530,1114,40531 JSB LAX LAY OCT 1114,41130,1114,41131,1114,42101 LBX LBY LDA OCT 1114,42102,1114,42130,1114,42131 LDB LDX LDY OCT 1114,44501,1114,44502,1114,51514 LIA LIB% LSL OCT 1114,51522,1115,41124,1115,44501 LSR MBT MIA OCT 1115,44502,1115,44503,1115,50131 MIB MIC MPY OCT 1115,53127,1116,40515 MVW NAM OCT 1117,51102,1117,51107,1117,51122 ORB ORG ORR OCT 1117,52101,1117,52102,1122,40515 OTA OTB RAM OCT 1122,42520,1122,51114,1122,51122 REP RRL RRR OCT 1122,50114,1123,51515 RPL SSM OCT 1123,40530,1123,40531,21123,41123 SAX SAY SBS OCT 1123,41130,1123,41131,1123,43103 SBX SBY SFC OCT 1123,43123,1123,45120,1123,45123 SFS SJP SJS OCT 1123,50103,1123,52101,1123,52102 SPC STA STB OCT 1123,52103,1123,52106,1123,52130 STC STF STX OCT 1123,52131,21124,41123,1125,45120 STY TBS UJP OCT 1125,45123,1130,41501,1130,41502 UJS XCA XCB OCT 1130,44506,1130,46101,1130,46102 XIF XLA XLB OCT 1130,47522,1130,51501,1130,51502 XOR XSA XSB * OPEND EQU * END OF BASIC INSTRUCTION SET * * THE EXPANSION TABLE ** MUST ** IMMEDIATELY FOLLOW THE OPERATOR TABLE! * * BSS 1024 EXPANSION AREA FOR 'MIC'-DEFINED OP-CODES * A EQU 0 B EQU 1 SPC 1 UNS SPC 1 END XRFSG [ % 92064-18138 1650 S C0122 &MPF MI,II POWER FAIL             H0101 N*USE 'ASMB,R,N' (RTE-M I/RTE-M II) OR 'ASMB,R,Z' (RTE-M III) * * IFN OPTION * NAME: $MPF * SOURCE: 92064-18138 * RELOC: 92064-16027 * PROGMR: E.J.W. BASED ON RTE-III VERSIONS G.A.A.,E.J.W.,D.L.S. * * IFZ OPTION * NAME : $MPF3 * SOURCE: 92064-18138 * RELOC: 92064-16029 * PROGMR: E.J.W. BASED ON RTE-III VERSIONS G.A.A.,E.J.W.,D.L.S. * * **************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT * * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * **************************************************************** * * IFN NAM DVP43,0 92064-16027 REV.1650 761020 EXT $OPSY XIF IFZ NAM DVP43,0 92064-16029 REV.1650 761020 XIF ENT $POWR,IP43,CP43 EXT $CVEQ,$SCLK,$TIME,$XEQ,$UPIO,$LIST,$MESS EXT $CIC,$PWR5,$DLFL SUP * * * * THIS IS THE RTE POWER FAIL AUTO RESTART ROUTINE. * * IT WORKS AS FOLLOWS: * * ON POWER FAILURE: * 1. BOTH DMA CHANNELS (PORT A AND B) ARE STOPPED * 2. ALL REGISTERS ARE SAVED, ALSO RETURN ADDRESS * 3. FOR RTE-III ALL FOUR MAPS ARE SAVED. * 4. TURN OFF POWER-FAIL INTERRUPTS UNTIL POWER RETURNS * * ON POWER UP: * 1. IN RTE-III ALL FOUR MAPS ARE RESTORED * 2. THE EQT ADDRESS FOR THIS ROUTINE IS FOUND, IT * IS SET TO TIME OUT IN ONE TICK, AND THE "I WILL * HANDLE TIME OUT" BIT IS SET. * 3. THE CURRENT SYSTEM TIME IS SAVED (THIS WILL BE THE * TIME OF POWER FAILURE). * 4. THE CLOCK IS RESTARTED BY CALLING $SCLK WHICH WILL * SET UP FOR AN IMMEDIATE INTERRUPT. * 5. A RETURN WITH ALL REGISTERS RESTORED IS MADE TO THE * POINT OF THE POWER FAIL INTERR*UPT. * * * ON THE FOLLOWING TIME OUT ENTRY THE FOLLOWING ACTION IS * TAKEN: * * 1. EACH EQT ENTRY IS CHECKED AND) * A) IF BUSY IT'S POWER FAIL FLAG IS SET (BIT 13 OF * THEN THE DRIVER IS ENTERED AT I.XX. THE FACT THAT * IT IS A POWER FAIL ENTRY MAY BE DETECTED BY * CHECKING THE BUSY BIT (ON NORMAL ENTRIES IT IS * NOT SET.) * * B) IF THE DEVICE IS BUSY AND IT'S POWER FAIL BIT * IS NOT SET THE DEVICE WILL BE SET DOWN, THE * POWER FAIL ROUTINE TIME OUT WILL BE SET BACK * TO ONE TICK AND THE CLOCK RESTARTED AND THE * SYSTEM "UP" PROCESSOR WILL BE CALLED TO UP * THE DEVICE. THIS CAUSES THE SYSTEM TO REISSUE * THE LAST REQUEST AND TO REENTER THE TIME OUT * SECTION OF THIS REOUTNE. * THE IMPLICATIONS OF THIS ARE THAT DISC TRANSFERS * WILL BE RETRIED, TTY, PUNCH, PHOTO READER * REQUESTS WILL BE RE-DONE RESULSTING IN DOUBLE * LINES IN SOME CASES. * * SOME DEVICES WILL BE REPORTED DOWN IS THEIR POWER * WAS ALSO CUT E.G. MAGTAPE, DISC. THESE * DEVICES MAY BE UPPED BY THEIR DRIVERS WHEN THEY * COME BACK ON LINE E.G. THE DISC. * * C) IF THE DEVICE IS DOWN THE SYSTEM UP PROCESSOR WILL * BE CALLED TO UP THE DEVICE. THIS WILL CAUSE * THE DOWNED DEVICES TO HAVE NEW MESSAGES POSTED * ON THE SYSTEM TTY. * * 2. THE PROGRAM "AUTOR" WILL BE ABORTED AND RESCHEDULED. * (THE ABORT IS TO ALLOW FOR MOMENTARY POWER UPS.) * AUTOR SHOULD TAKE WHAT EVER ACTION IS NEEDED TO * BRING UP THE SYSTEM IN TERMS OF ENABLING TERMINALS - * COMMUNICATION LINES ETC. IN ORDER TO ALLOW TIME * SYNC. THIS ROUTINE WILL PROVIDE THE THREE WORD SYSTEM * TIME AT POWER FAILURE ON THE FIRST READ REQUESDT * AFTER POWER UP. THE SECOND READ REQUEST WILL * RETURN THE SAME TIME BUT CAUSES THE ROUTINE TO * RESET TO HANDLE A TOTAL NEW POWER FAILURE HED POWER UP/DOWN ENTRY POINT/ DOWN CODE. $POWR NOP POWER UP/DOWN ENTRY SFC 4 UP? JMP UP YES GO DO UP THING. * JMP DOWN,I GO TO DOWN ROUTINE DOWN DEF DWN POINTS TO WAIT WHILE SENSITIVE * CODE IS EXECUTING. STF STF 0 TURN ON THE INTERRUPT SYSTEM SW2 NOP (CLF 0 IF NOT USER RETURN ELSE STC 5) IFN JMP PSAVE,I RETURN TO POINT OF POWER FAILURE. * XIF IFZ JRS MEMST PSAVE,I RETURN TO PT OF PWR FAIL. * XIF DOWNI DEF DOWN INDIRECT FOR EXIT TO AVOID INTERRUPT * EXIT2 LDA ASAVE RESTORE A REGISTER LDB BSAVE AND THE B REGISTER JSB DOWNI,I RESET DOWN SWITCH AND EXIT * * DOWN ROUTINE * DWN STF 6B STOP DMA! PREVENT LONG DMA STF 7B TRANSFER FROM JAMMING CPU STA ASAVE SAVE A-REG. STB BSAVE SAVE B-REG. ERA,ALS SOC SET LEAST A FOR INA "O-REG" SIGN FOR "E-REG" STA EOSAV SAVE E/O LDA $POWR SAVE INTERRUPT LOCATION STA PSAVE IFN LIB 6 CHECK IF MX CPU SZB,RSS JMP NOMX1 * XIF STX XSAVE SAVE X-REG STY YSAVE SAVE Y-REG NOMX1 LIA 5 SAVE ADDRESS WHERE WE LIB 5 LAST VIOLATED IN CASE OF MP IN CPB A PROGRESS - IF SO THEN ALSO STA $CIC RESET THE INTERRUPT LOCATION STA $PWR5 LIA 2 SAVE THE DMA STA SDMA1 WORD COUNTS LIA 3 STA SDMA2 LIA 1 SAVE THE SWITCH STA SSAVE REGISTER IFZ RSA SAVE STATUS OF STA MEMST WHAT WAS LAST MAP USED CLA (A) = STARTING REG # LDB SMAPA (B) = ADDR OF MAP SAVE AREA LDX MD128 (X) = -128 TO SAVE ALL MAPS XMM XIF LDA STC5 SET UP THE EXIT SPC 1 IFN * BEGIN NON-DMS CODE *************** LDB $OPSY CPB RTEM1 IF IN RTE-M I DON'T LDA STF TURN ON MEMORY PROTECT *** END NON-DMS CODE *************** XIF SPC 1 SFS 0 SWITCH BASED ON INTERRUPT SYSTEM LDA CLF0 STA SW2 WAIT CLC 4 SET UP FOR MOMENTARY HLT 0 POWER FAILURE /WAIT FOR POWER HED POWER UP ROUTINE UP LDA DWAIT SET SWITCH FOR DOWN ROUTINE STA DOWN TO AVOID LOSS OF INFORMATION. LDA SW2 SSA,RSS IF HALTED AT POWER DOWN JMP HALT GO HALT AGAIN * CLC 0,C INIT THE WHOLE I/O SYSTEM. * STC 4 CAN NOW ALLOW A DOWN INTERRUPT. * IFZ CLA (A) = STARTING REG # LDB SMAPA (B) = ADDR OF MAP SAVE AREA LDX D128 (X) = +128 TO RESTORE ALL MAPS XMM * LDA MEMST GET MEU STATUS WORD AND B3777 SAVE FENCE ADDR AND PORTION BIT LFA LOAD FENCE * XIF LDB EQT# SET UP TO SEARCH FOR CMB,INB THE POWER FAIL STB EQTCO EQT LDB EQTA ADDRESS INB * NEXT LDA B,I GET WORD #2 CPA DEFI. IS IT THE LOCAL IP43? JMP FOUND YES GO DO IT * ADB D15 NO INDEX TO NEXT EQT ISZ EQTCO IF END THEN SKIP JMP NEXT TRY NEXT ENTRY * HALT HLT 4,C CPU HALTED OR NO JMP *-1 EQT ENTRY * FOUND ADB D2 INDEX TO WORD 4 LDA B,I FETCH IT IOR B10K SET THE "I WILL HANDLE TIME OUT" STA B,I BIT ADB D11 INDEX TO EQT15 CCA,CCE AND SET TIME OUT STA B,I FOR NEXT TICK. STB EQ15 SAVE EQT15 ADDRESS * LDA TIME+2 IF TIME IN HAND SZA THEN DO NOT JMP NIXTM SAVE IT AGAIN * DLD $TIME GET THE TIME OF DAY D$TM EQU *-1 DST TIME AND SAVE IT LDA D$TM GET ADDRESS RAL,CLE,SLA,ERA OF LDA A,I DAY/YEAR ADA D2 AND LDB A,I SAVE THE TIME OF YEAR STB TIME+2 TOO. * NIXTM CLA,CCE CLEAR THE EQT COUNT STA EQTCO FOR THE TIME OUT ROUTINE. LDA EQ5,I SET EQT IN PROCESS ALR,ERA BUSY STA EQ5,I SO WE UP IT AGAIN JSB $SCLK SET CLOCK FOR INTERRUPT SPC 1 IFN * BEGIN NON-DMS CODE *************** LDA $OPSY CPA RTEM1 IF RTE-M I, NEVER MEMORY PROTECT JMP NOMP *** END NON-DMS CODE *************** XIF SPC 1 LDA CLF0 SET EXIT SWITCH TO SYSTEM LDB MPTFL IF MP FLAG SZB SAYS WE STA SW2 WERE IN THE SYSTEM NOMP LDA DUMMY IF PRIV. SYS SZA,RSS MUST SET UP. WELL? JMP NOPRV OK SO DON'T. * IOR STF MAKE A STF DUMMY STA STFD PUT IT DOWN STFD NOP AND DO IT IOR STCD NOW MAKE A STC DUMMY STA STCD AND IOR CLCD A CLC DUMMY STA CLCD DO THE CLC CLCD CLC 0 NOW SZB IF IN SYSTEM ALSO STCD NOP DO THE STC. NOPRV LDA EOSAV RESTORE THE REGISTERS CLO SLA,ELA STO LDA SDMA1 STC 2 OTA 2 LDA SDMA2 STC 3 OTA 3 IFN LIB 6 IF MX CPU SZB,RSS JMP NOMX2 * XIF LDX XSAVE RESTORE X-REG LDY YSAVE RESTORE Y-REG NOMX2 LDA SSAVE OTA 1 LDA FENCE SPC 1 IFN * BEGIN NON-DMS CODE *************** LDB $OPSY CPB RTEM1 IF RTE-M I SKIP OTA 5 RSS *** END NON-DMS CODE *************** XIF SPC 1 OTA 5 LDA TBG CONFIGURE THE TBG STF  SZA IF THERE IS ONE IOR STF AND STA STFTB STORE IT JMP EXIT2 GO RETURN TO POINT OF INTERRUPT * SPC 3 SPC 1 IFN * BEGIN NON-DMS CODE *************** RTEM1 DEC -7 *** END NON-DMS CODE *************** XIF SPC 1 STC5 STC 5 CLF0 CLF 0 DWAIT DEF WAIT ASAVE NOP BSAVE NOP EOSAV NOP * XSAVE NOP YSAVE NOP * IFZ MEMST NOP SMAPA DEF SMAP SMAP BSS 32 DO NOT CHANGE ORDER - SYSTEM MAP BSS 32 -USER MAP BSS 32 -PORT-A MAP BSS 32 -PORT-B MAP MD128 DEC -128 D128 DEC 128 B3777 OCT 3777 XIF * SDMA1 NOP SDMA2 NOP SSAVE NOP EQ5 NOP EQT IN PROCESS FLAG EQ15 NOP EQTCO NOP PSAVE DEF HALT P-REG SAVE (HLT DEF IF HALTED) TIME OCT 0,0,0 TIME SAVE LOCATION A EQU 0 B EQU 1 SPC 3 DEFI. DEF IP43 D15 DEC 15 D3 DEC 3 B10K OCT 10004 D2 DEC 2 HED TIME OUT SECTION CP43 NOP ENTRY HERE FOR TIME OUT ONLY CLA CLEAR THE EQT IN PROCESS FLAG STA SW2 CLEAR SWITCH TO SHOW NO PFAIL STA EQ5 STFTB STF 0 SET CLOCK AGAIN OR NOP IF NONE CCB SET UP TO TIME OUT AGAIN STB EQ15,I SET IN EQT15 ISZ $DLFL INCREMENT DELAY 'TIME-OUT' FLAG NOP WATCH OUT FOR A SKIP * NOTIM LDA EQTCO GET CURRENT EQT COUNT CPA EQT# IF DONE JMP AUTOR GO START AUTOR * SZA,RSS IF FIRST TIME STB BSAVE SET BSAVE FOR AUTOR COUNT SZA,RSS STB EOSAV SET EOSAV FOR TIME CALL * ISZ EQTCO STEP THE EQT NUMBER LDA EQTCO GO SET UP JSB $CVEQ THE EQT ADDRESSES LDA EQT5,I GET EQT5 RAL,CLE,SLA IF DMA WAIT CCE,SSA,RSS THEN RSS FORGET RESTART JMP NOTIM * LDA EQT1,I CHECK IF SYS IS CLEARING SSA WELL? . JMP NOTIM YES LET TIME OUT CATCH IT. * LDA EQT4,I DEVICE DOWN OR BUSY ALF,RAR CHECK HIS "I KNOW ABOUT PF" SEZ,CCE,SLA BIT JMP DVR SET AND BUSY GO DO IT * LDA EQT5 EITHER DOWN OR PF BIT NOT SET STA EQ5 SAVE EQT5 ADDRESS IN CASE LDA EQT5,I WE GO DOWN WHILE PROCESSING ALR,RAL SET DEVICE DOWN ERA,RAR AND STA EQT5,I AND JMP $UPIO GO RESTART * DVR LDA EQT4,I SET SELECT AND B77 CODE IN LDB EQT2,I A-REG AND JSB B,I CALL AT I.XX JMP NOTIM GO DO NEXT EQT. * AUTOR ISZ BSAVE FIRST TIME HERE? JMP SAUTO NO - GO SCHEDULE AUTOR * LDA DOF YES - ABORT AUTOR LDB D11 BY CALLING SYSTEM JSB $MESS MESSAGE PROCESSOR SZA A RETURN INDICATES JMP NOAUT NO AUTOR * SAUTO JSB $LIST SECOND ENTRY OCT 201 SCHEDULE BY NAME DEF OF2 NOAUT CLA CLEAR THE TIME OUT STA EQ15,I FLAG IN EQT 15 JMP $XEQ START THE SYSTEM * DOF DEF *+1 ASC 2,OFF, OF2 ASC 4,AUTOR,1 D11 DEC 11 B77 OCT 77 N3 DEC -3 D4 DEC 4 HED TIME REQUEST SECTION IP43 NOP LDA EQT6,I GET THE REQUEST CODE RAR,SLA IF NOT READ GO COMPLETE JMP REJ * LDA EQT8,I MUST HAVE A ADA N3 THREE WORD SSA BUFFER JMP REJ ELSE IGNOR * LDA EQT7,I BUFFER ADDRESS TO A LDB TIME SET THREE WORD STB A,I TIME MESSAGE INA IN LDB TIME+1 USER STB A,I BUFFER INA LDB TIME+2 STB A,I CCA IF FIRST CALL AFTER TIME OUT CPA EOSAV AFTER POWER UP ISZ EOSAV SET FLAG TO ZERO AND SKIP JMP CLEAR NOT FIRST ENTRY JMP * I.EX LDB D3 SET TLOG = 3 REJ LDA D4 IMMEADIATE COMPLETION > JMP IP43,I RETURN TO USER * CLEAR CLA SECOND OR LATER ENTRY STA TIME+2 CLEAR THE TIME IN HAND FLAG JMP I.EX AND EXIT * * * HED ** SYSTEM BASE PAGE COMMUNICATION AREA ** . EQU 1650B ESTABLISH ORIGIN OF AREA * * SYSTEM TABLE DEFINITION * * EQTA EQU .+0 FWA OF EQUIPMENT TABLE EQT# EQU .+1 # OF EQT ENTRIES DRT EQU .+2 FWA OF DEVICE REFERENCE TABLE LUMAX EQU .+3 # OF LOGICAL UNITS (IN DRT) INTBA EQU .+4 FWA OF INTERRUPT TABLE INTLG EQU .+5 # OF INTERRUPT TABLE ENTRIES TAT EQU .+6 FWA OF TRACK ASSIGNMENT TABLE KEYWD EQU .+7 FWA OF KEYWORD BLOCK * * I/O MODULE/DRIVER COMMUNICATION * EQT1 EQU .+8 ADDRESSES EQT2 EQU .+9 EQT3 EQU .+10 OF EQT4 EQU .+11 EQT5 EQU .+12 CURRENT EQT6 EQU .+13 EQT7 EQU .+14 15-WORD EQT8 EQU .+15 EQT9 EQU .+16 EQT EQT10 EQU .+17 EQT11 EQU .+18 ENTRY EQT12 EQU .+81 EQT13 EQU .+82 EQT14 EQU .+83 EQT15 EQU .+84 CHAN EQU .+19 CURRENT DMA CHANNEL # TBG EQU .+20 I/O ADDRESS OF TIME-BASE CARD SYSTY EQU .+21 EQT ENTRY ADDRESS OF SYSTEM TTY * * SYSTEM REQUEST PROCESSOR /'EXEC' COMMUNICATION * * RQCNT EQU .+22 # OF REQUEST PARAMETERS -1 RQRTN EQU .+23 RETURN POINT ADDRESS RQP1 EQU .+24 ADDRESSES RQP2 EQU .+25 RQP3 EQU .+26 OF REQUEST RQP4 EQU .+27 RQP5 EQU .+28 PARAMETERS RQP6 EQU .+29 RQP7 EQU .+30 (SET FOR MAXIMUM OF RQP8 EQU .+31 9 PARAMETERS) RQP9 EQU .+32 * * DEFINITION OF SYSTEM LISTS (QUEUES) * * SKEDD EQU .+33 'SCHEDULE' LIST, SUSP2 EQU .+35 'WAIT' LIST, SUSP3 EQU .+36 'AVAILABLE MEMORY' LIST, SUSP4 EQU .+37 'DISC ALLOCATION' LIST, SUSP5 EQU .+38 'OPERATOR SUSPEND' LIST * * DEFINITION OF EXECUTING PROGRAM ID SEGMENT' * * XEQT EQU .+39 ID SEGMENT ADDR. OF CURRENT PROG. XLINK EQU .+40 'LINKAGE' XTEMP EQU .+41 'TEMPORARY (5-WORDS) XPRIO EQU .+l46 'PRIORITY' WORD XPENT EQU .+47 'PRIMARY ENTRY POINT' XSUSP EQU .+48 'POINT OF SUSPENSION' XA EQU .+49 'A REGISTER' AT SUSPENSION XB EQU .+50 'B REGISTER' XEO EQU .+51 'E AND OVERFLOW * * SYSTEM MODULE COMMUNICATION FLAGS * * OPATN EQU .+52 OPERATOR/KEYBOARD ATTENTION FLAG OPFLG EQU .+53 OPERATOR COMMUNICATION FLAG SWAP EQU .+54 RT DISC RESIDENT SWAPPING FLAG DUMMY EQU .+55 I/O ADDRESS OF DUMMY INT. CARD IDSDA EQU .+56 DISC ADDR. OF FIRST ID SEGMENT IDSDP EQU .+57 -POSITION WITHIN SECTOR * * DEFINITION OF MEMORY ALLOCATION BASES * * BPA1 EQU .+58 FWA R/T DISC RES. BP LINK AREA BPA2 EQU .+59 LWA R/T DISC RES. BP LINK AREA BPA3 EQU .+60 FWA BKG DISC RES. BP LINK AREA LBORG EQU .+61 FWA OF RESIDENT LIBRARY AREA RTORG EQU .+62 FWA OF REAL-TIME AREA RTCOM EQU .+63 LENGTH OF REAL TIME COMMON AREA RTDRA EQU .+64 FWA OF R/T DISC RESIDENT AREA AVMEM EQU .+65 FWA OF SYSTEM AVAILABLE MEMORY BKORG EQU .+66 FWA OF BACKGROUND AREA BKCOM EQU .+67 LENGTH OF BACKGROUND COMMON AREA BKDRA EQU .+68 FWA OF BKG DISC RESIDENT AREA * * UTILITY PARAMETERS * TATLG EQU .+69 LENGTH OF TRACK ASSIGNMENT TABLE TATSD EQU .+70 # OF TRACKS ON SYSTEM DISC SECT2 EQU .+71 # SECTORS/TRACK ON LU 2 (SYSTEM) SECT3 EQU .+72 # SECTORS/TRACK ON LU 3 (AUX.) DSCLB EQU .+73 DISC ADDR OF RES LIB ENTRY PTS DSCLN EQU .+74 # OF RES LIB ENTRY POINTS DSCUT EQU .+75 DISC ADDR OF RELOC UTILITY PROGS DSCUN EQU .+76 # OF RELOC UTILITY PROGS LGOTK EQU .+77 LOAD-N-GO: LU,STG TRACK,# OF TRKS LGOC EQU .+78 CURRENT LGO TRACK/SECTOR ADDRESS SFCUN EQU .+79 SOURCE FILE LU AND DISC ADDRESS MPTFL EQU .+80 MEMORY PROTECT ON/OFF FLAG (0/1) FENCE EQU .+85 MEM PROTECT FENCE ADDRESS BKLWA EQU .+87 LWA OF MEMORY IN BACKGROUND * ORG * LENGTH OF $POWR END $POWR `q<:66<  92064-18139 1726 S C0122 &MRCNF RTE-M RECONFIGURATION             H0101 gASMB,R,L,C * NAME : MRCNF * SOURCE: 92064-18139 * RELOC: 92064-16028 * PROGMR: E.J.W. BASED ON RTE-III VERSION D.L.S. * * **************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT * * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * **************************************************************** * * NAM MRCNF,3,90 92064-16028 REV.1726 770512 EXT $OPSY * A EQU 0 B EQU 1 * MRCNF NOP THIS 'PROGRAM' IS ACTUALLY A SUBROUTINE ADA D5 WHICH IS CALLED BY $MSC DURING THE START-UP STA IDNAM SAVE A-REG (ADDR OF NAME IN ID SEG) CLB CLEAR A,B,S REGISTERS TO PREVENT CLA POSSIBLE ERROR IF OPERATOR OTA 1 ACCIDENTLY HITS RUN PREMATURELY HLT 70B HALT 'CAUSE FLOPPY IBL CAN'T. USER SETS S AND B. STB NEWCH SAVE B-REG (FLOPPY BOOT SETS I/O CHANNEL IN B) SZB,RSS IF B=0, SKIP DISC SECTION JMP CRTIO * * DISC RECONFIGURATION * LDB DRT CHECK IF LU 2 POINTS TO FLOPPY INB LDA B,I SZA,RSS JMP CRTIO LU 2 = 0, SKIP DISC SECTION * AND B77 COMPUTE EQT ADDR OF LU 2 ADA M1 IF IT WASN'T 0 MPY D15 ADA EQTA ADA D4 INDEX TO EQT TYPE WORD LDA A,I AND B374C STA DMASK SAVE DISC EQT TYPE BITS AND B36K CPA B14K 27 < TYPE < 34 ? RSS YES, IT IS DISC. SKIP JMP CRTIO NO, NOT DISC * LDA DMASK SET A=EQT TYPE, CHP2=NEW I/O CHANNEL JSB SCAN FIND EQT AND SET NEW I/O CHANNEL IN EQT STA DKEQT SAVE EQT # STB EQTAD SAVE EQT ADDR JSB SINT SET UP INTERRUPT TABLE & TRAP CELLD ISZ NEWCH NEED 2 I/O SLOTS FOR FLOPPY LDB EQTAD JSB SINT SET UP SECOND INT SLOT * LDB DRT SET LU 2 TO POINT TO INB CURRENT DISC EQT LDA B,I GET LU WORD AND REMOVE OLD EQT AND C77 IOR DKEQT STA B,I SET NEW WORD WITH CURRENT EQT * * * SYSTEM CONSOLE RECONFIGURATION * CRTIO LIA 1 GET NEW S.C. FOR AND B77 CONSOLE FROM S-REG SZA,RSS BITS 0-5. JMP TBGIO IF ZERO, SKIP CRT SECTION * STA NEWCH SAVE S.C. FOR SCAN AND LDA CHSC3 CONFIGURE I-O IOR NEWCH INSTRUCTIONS. STA CHSC3 LDA CHSC4 IOR NEWCH STA CHSC4 LDA CHSC2 IOR NEWCH STA CHSC2 * LDA CHMRS SEND MASTER RESET.FLAG SET=12966A. CHSC2 CLF 0 CHSC3 OTA 0 CHSC4 SFS 0 * CLE,RSS IF NOT 12966A CARD, SET E=0. CCE IF 12966A CARD, SET E=1. * LDB SYSTY GET ADB D4 OLD LDA B,I DEVICE AND B374C TYPE. CPA B2400 JMP PAS29 * SEZ JMP PAS28 OLD=00, NEW=05. JMP PAS27 OLD=00, NEW=00. * PAS29 SEZ JMP PAS27 OLD=05, NEW=05. * PAS28 CLA,SEZ OLD=05, NEW=00. LDA B2400 SCAN FOR 00 OR JSB SCAN 05 DEVICE. * STB SYSTY SETUP BASE PAGE CONSOLE WORD. * STA DRT,I FIX LU#1. * PAS25 JSB SINT SET INTERRUPT TABLE & TRAP CELL JMP TBGIO * PAS27 ADB M1 CURRENT SYSTEM CONSOLE IS ALRIGHT LDA B,I EXCEPT FOR THE CHANNEL IN EQT AND C77 WORD 4. FIX UP WORD IOR NEWCH 4 THEN RETURN AND STA B,I FIX UP BASE PAGE ADB M3 JMP PAS25 TRAP CELL AND INTBA. * * * TIME-BASE-GENERATOR RECONFIGURATION * TBGIO LIA 1 GET NEW S.C.FOR ALF,ALF TBG FROM S-REG RAL,RAL BITS 6-11. AND B77 3 SZA,RSS IF ZERO, JMP PRVIO SKIP TBG SECTION * STA TBG CLB CLEAR LDA INTBA TBG ADA M6 INTERRUPT ADA TBG TABLE STB A,I LOCATION. * LDA JCICI SET UP TBG STA TBG,I TRAP CELL. * * * PRIVILEGED TERMINATOR CARD RECONFIGURATION * PRVIO LIA 1 GET NEW S.C. ALF FOR PRIVILEGED AND B17 INTERRUPT CARD. SZA,RSS IF ZERO, JMP MEMSZ SKIP PRIVILEGED INTERRUPT SECTION * CPA B10 IF NEW S.C=10 CLA THEN CLEAR STA DUMMY DUMMY. * LDB JCICI PUT 'JSB $CIC,I' INTO BASE STB DUMMY,I PAGE TRAP CELL. * * * MEMORY SIZE RECONFIGURATION * MEMSZ LDA $OPSY CPA M5 IS IT RTE-M III? JMP NOCHG YES, THEN DON'T DO IT. * LDB SZ32K SET ADDR FOR 32K MEMORY CHECK STB B,I TRY STORING THERE LDA B,I CPA B CAN WE READ IT BACK? JMP FNDSZ YES, WE HAVE 32K! * LDB SZ24K NO, TRY 24K MEMORY STB B,I LDA B,I CPA B CAN WE READ IT BACK? JMP FNDSZ YES, WE HAVE 24K! * LDB SZ16K NO, TRY 16K MEMORY STB B,I LDA B,I CPA B WE SHOULD HAVE THAT MUCH AT LEAST RSS JMP NOCHG ...BUT IF WE DON'T... * FNDSZ LDA BGORG SUBTRACT CURRENT HIGH ADDR CMA,INA FROM MAX MEMORY INSTALLED NOW ADA B STA TEMP0 AND SAVE THE DIFFERENCE ADA M7K.. SSA IS THERE AN INCREASE TO NEXT 8K BOARD? JMP NOCHG NO, MAKE NO CHANGES * STB BGLWA YES, SET UP NEW LWA STB BGORG LDA AVMEM ADA TEMP0 STA AVMEM ADJUST FWA SAM BY SAME AMOUNT * NOCHG CLA CLEAR OUT NAME IN ID SEG STA IDNAM,I TO RELEASE ID SEG ISZ IDNAM STA IDNAM,I ISZ IDNAM ST A IDNAM,I JMP MRCNF,I RETURN TO SYSTEM START-UP SEQUENCE * * CHMRS OCT 150077 MASTER RESET FOR 12966A CARD. DMASK NOP FLOPPY DRIVER TYPE DKEQT NOP EQTAD NOP OLDCH NOP SET BY SCAN. NEWCH NOP IDNAM NOP B10 OCT 10 B17 OCT 17 B77 OCT 77 B2400 OCT 2400 B14K OCT 14000 B36K OCT 36000 B374C OCT 37400 C77 OCT 177700 M5 DEC -5 M6 DEC -6 M3 DEC -3 M1 DEC -1 D4 DEC 4 D5 DEC 5 D15 DEC 15 SZ32K OCT 77776 SZ24K OCT 57777 SZ16K OCT 37777 M7K.. OCT -17776 SKP * **************************************************************** * * SCAN SUBROUTINE - FIND EQT BY TYPE & SET UP NEW I-O CHANNEL * * ENTRY: * :=NEW I/O CHANNEL # TO PUT INTO EQT * :=BITS 8-13 = DEVICE TYPE. * JSB SCAN * * EXIT: * :=EQT# * :=EQT1 ADDRESS. * :=OLD I/O CHANNEL # OF EQT * **************************************************************** * SCAN NOP STA TEMP0 SAVE DEVICE TYPE MASK. LDB EQT# SET CMB,INB UP STB COUNT COUNT. LDB EQTA POSITION TO FIRST ADB D4 EQT WORD 5 * SCAN1 LDA B,I GET DEVICE TYPE AND B374C FROM EQT WORD 5. CPA TEMP0 IF CORRECT TYPE, JMP SCAN2 THEN EXIT. ADB D15 POSITION TO NEXT ISZ COUNT EQT WORD 5. JMP SCAN1 CONTINUE SCAN. * LDA TEMP0 HLT 61B IF NO DEVICE, JMP *-1 HLT 61. (A)=DEVICE TYPE TO BE FOUND * SCAN2 ADB M1 LDA B,I AND B77 GET OLD STA OLDCH CHANNEL AND LDA B,I SAVE IT. AND C77 FIX CHANNEL # IOR NEWCH IN EQT WORD 4. STA B,I ADB M3 POSITION TO EQT1. LDA COUNT COMPUTE ADA EQT# EQT # INA AND JMP SCAN,I RETURN. * *****************************************************************  * * SINT SUBROUTINE - SET UP INTERRUPT TABLE & TRAP CELL * * ENTRY: * :=NEW I/O CHANNEL # * :=EQT ADDR * JSB SINT * * EXIT: * REGISTERS MEANINGLESS * ***************************************************************** * SINT NOP STB TEMP0 SAVE EQT ADDR LDA NEWCH GET NEW I/O CHANNEL ADA M6 STA B ADB INTBA (B) = ADDR OF INTERRUPT TABLE ENTRY CMA,CLE,SSA TEST FOR NEGATIVE I/O CHANNEL ADA INTLG TEST FOR MAX I/O CHANNEL LDA TEMP0 SEZ,RSS ANY ERROR IN ABOVE TESTS? JMP BADCH YES, ERROR HALT * STA B,I SET EQT ADDR IN NEW INTERRUPT TABLE ENTRY * LDA JCICI GET 'JSB $CIC-LINK,I' AND STA NEWCH,I PUT INTO NEW TRAP CELL JMP SINT,I RETURN * BADCH LDB INTLG ERROR. I O CHANNEL # TOO HIGH ADB D5 LDA NEWCH (A)=NEW I/O CHANNEL HLT 63B HLT 63 (B)=MAX I/O CHANNEL ALLOWED JMP *-1 * * TEMP0 NOP COUNT NOP * * JCICI EQU 5B LOCATION 5 MUST BE 'JSB $CIC-LINK,I' EQTA EQU 1650B EQT# EQU 1651B DRT EQU 1652B INTBA EQU 1654B INTLG EQU 1655B TBG EQU 1674B SYSTY EQU 1675B DUMMY EQU 1737B AVMEM EQU 1751B BGORG EQU 1752B BGLWA EQU 1777B * END MRCNF    92064-18141 1650 S C0122 &MAUTO RTE-M AUTOR             H0101 ?ASMB,R,L,C * NAME : MAUTO * SOURCE: 92064-18141 * RELOC: 92064-16030 * PROGMR: E.J.W. BASED ON RTE-III VERSIONS G.A.A.,L.W.A.,D.L.S. * * **************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT * * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * **************************************************************** * * NAM AUTOR,1,1 92064-16030 REV.1650 761027 EXT EXEC * AUTOR NOP ENTRY/TEMPORARY STORAGE * CLA,INA RESET LU# TO STA CNWD 1 FOR THIS ENTRY * SRCH JSB EXEC *SEARCH EQT FOR DVR43* DEF *+4 ERROR RETURN DEF ICODE REQUEST CODE DEF CNWD LU# FOR STATUS CALL DEF EQT5 BUF LOCATION JMP BDLU ERROR ROUTINE * LDA EQT5 AND EMASK MASK OUT STATUS AND AV. CPA .43 TEST FOR POWER FAIL DRIVER JMP GTIME FOUND DVR43-GO GET TIME OF P/F BDLU LDA CNWD NOT DVR43--GO TRY AGAIN CPA B77 TEST FOR END OF LU#S JMP NO.LU YES-POWER FAIL DRIVER NOT FOUND INA NO-CONTINUE SEARCH--BUMP LU STA CNWD SAVE LU# FOR EXEC CALL JMP SRCH * * * * POWER FAIL DRIVER NOT FOUND * NO.LU JSB EXEC DEF *+5 DEF .2 DEF .1 DEF NOBUF DEF NBL CLA STA CNWD SET P/F LU. TO 0 FOR SECOND CALL JMP SCAN SKP * * * POWER FAIL DRIVER FOUND * REQUEST READ TO * OBTAIN TIME * GTIME JSB EXEC DEF GT2 RETURN DEF .1 READ DEF CNWD LU OF P/F DRIVER DEF TIME TIME BUFFER DEF .3 BUFFER LENGTH * * * GT2 LDA TIME *CONVERT TIME FOR PRINTING* F LDB TIME+1 CLE CLEAR E FOR ADDITION ADA PRS1 ADD POSITIVE 24 HRS. SEZ TO GET A POSITIVE INB TIME ADB PRS2 DIV .6000 DIVIDE BY 6000 STA BUF1 TEMPORARY STORAGE FOR MIN/HRS ASR 16 POSITION B(SEC/10MS) FOR DIVIDE DIV .100 DIVIDE BY 100 TO GET SEC/10MS STB BUF4 SET 10MS VALUE STA BUF3 SET SECONDS VALUE CLB CLB FOR DIVIDE LDA BUF1 GET MIN/HRS DIV .60 SEPARATE STB BUF2 SET MIN LDB R.BUF SET BUFFER AREA POINTER STB TEMP1 FOR THIS CONVERSION LDB N4 SET CONVERSION COUNTER STB TEMP2 * * BACK JSB CNVRT GO CONVERT TO ASCII STA TEMP1,I SAVE IN OUTPUT BUFFER ISZ TEMP2 TEST FOR END OF CONVERSION RSS JMP DA.YR GO CONVERT DAY AND YEAR ISZ TEMP1 BUMP OUTPUT POINTER ISZ TEMP1 LDA TEMP1,I GET NEXT VALUE JMP BACK GO CONVERT NEXT VALUE * DA.YR LDA TIME+2 FETCH DAY AND YEAR CLB DIV D365 GET YEAR CCE,INB INCRE (B) FOR DAY 0 CORRECTION ADA YEAR1 SET YEAR INTO BUFFER STA YEAR SAVE FOR PRINTING ASR 16 PREPARE TO GET DAY DIV .100 GET HUNDREDS IOR BLK0 STA DAY SAVE IN PRINT BUFFER ASR 16 JSB CNVRT GO GET TENS AND ONES STA DAY+1 SAVE IN PRINT BUFFER * * * * SCAN EQT FOR ALL TTY DEVICES (DVR00) * AND ISSUE WRITE REQUEST (POWER FAIL * TIME MESSAGE ) TO EACH * * * SCAN CLA,INA SET LU#. TO STA LU 1 FOR SEARCH OF EQT SCAN2 JSB EXEC DEF *+6 ERROR RETURN POINT DEF ICODE REQUEST CODE DEF LU LU# FOR STATUS TEST DEF EQT5 BUF LOCATION DEF TIME DUMMY LOCATION FOR EQT4 DEF SUBCH SUBCHANNEL INFO RETURNED HERE JMP BAD LU NOT ASSIGNED-GO TEST NEXT LU * LDA EQT5 FETCH EQT5 AND EMASK GET RID OF STATUS AND AV. SZA,RSS TEST FOR DVR00 JMP PRINT FOUND DVR00 GO PRINT P/F MESSAGE CPA DVR05 IS IT DVR05? JMP SBCHK CHECK SUBCHANNEL TO BE SURE IT IS CRT BAD LDA LU NOT DVR00-CONTINUE CPA B77 TEST FOR END OF SCAN JMP DONE YES-GO RESET POINTERS AND CONSTANTS-EXIT INA NO-BUMP LU# STA LU SET LU# FOR NEXT TEST JMP SCAN2 GO TEST NEXT LU * SBCHK LDA SUBCH IT'S DVR05, IS IT CRT? AND B37 SZA JMP BAD NO * * * * PRINT POWER FAIL MESSAGE * ON CONSOLE DEVICE FOUND IN SCAN ROUTINE * * * * * PRINT JSB EXEC DEF *+5 RETURN DEF .2 WRITE COMMAND DEF LU LU# OF DEVICE DEF MESS P/F MESSAGE DEF MESL. MESSAGE LENGTH JMP BAD GO TEST FOR END OF SEARCH-CONTINUE SPC 5 * * * * CONVERT A TWO DIGIT BINARY NUMBER INTO ASCII * * * * CNVRT NOP CLB DIV .10 GET TENS AND ONES ALF,ALF SHIFT TENS DIGIT INTO UPPER CHAR POSITION IOR ASCII CREATE AN ASCII FIELD IOR B 'OR' IN ONES DIGIT JMP CNVRT,I * * * * SECOND CALL ON P.FAIL ROUTINE RESETS * TO SAVE TIME ON NEXT FAILURE. * * DONE JSB EXEC DEF *+5 DEF N1 SECOND READ REQUEST DEF CNWD LU OF P/F DRIVER. DEF TIME TIME BUFFER DEF .3 BUFFER LEGNTH NOP POINT OF RETURN IF P/F LU. UNKNOWN SPC 5 * * * * * * * * *************EXIT TO SYSTEM************* JSB EXEC DEF *+2 DEF IC2 * * * * * CONSTANT AND STORAGE AREAS * * ICODE OCT 100015 YEAR1 OCT 033460 BLK0 OCT 020060 ASCII OCT 030060 EMASK OCT 37400 DVR05 OCT 02400 SUBCH NOP B37 OCT 37 .43  OCT 21400 D365 DEC 365 B77 OCT 77 .2 DEC 2 .3 DEC 3 .1 DEC 1 N1 OCT 100001 PRS1 OCT 153000 PRS2 OCT 203 CNWD OCT 1 EQT5 BSS 1 TEMP2 EQU EQT5 TEMPORARY STORAGE NOBUF OCT 6412 CR/LF ASC 12, NO POWER FAIL LU FOUND. NBL DEC 13 TIME BSS 3 .6000 DEC 6000 .100 DEC 100 .60 DEC 60 .10 DEC 10 MESS OCT 6412 ASC 9, POWER FAILED AT BUF1 NOP ASC 1,: BUF2 NOP ASC 1,: BUF3 NOP ASC 1,. BUF4 NOP ASC 4,0 ON DAY DAY BSS 2 ASC 2, OF ASC 1,19 YEAR BSS 1 MESL. DEC 27 TEMP1 BSS 1 TEMPORARY STORAGE LU EQU TEMP1 TEMPROARY STORAGE R.BUF DEF BUF1 IC2 DEC 6 B EQU 1 N4 OCT -4 END AUTOR   92064-18143 1650 S C0122 &MRN MII,III RN MGR             H0101 ZOASMB,R,L,C ** RTE-M II/III $MRN RN-LU SYSTEM ROUTINES ** * NAME : $MRN * SOURCE: 92064-18143 * RELOC: 92064-16031 * PROGMR: E.J.W. BASED ON RTE-III VERSIONS G.A.A. * * **************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT * * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * **************************************************************** * * NAM $MRN,0 92064-16031 REV.1650 761020 * EXT $RNTB,$IDNO,$SCD3,$SCLK ENT $TRRN,$CGRN,$ULLU * SUP A EQU 0 B EQU 1 * * * $TRRN IS THE RN/LU LOCK CLEAN UP ROUTINE. * IT IS CALLED BY THE DISPATCHER WHEN EVER A PROGRAM COMPLETES * (THE CALL IS BY WAY OF THE REENTRENT CLEAN UP ROUTINE. * * ITS FUNCTION IS TO RELEASE ANY LOCAL LOCKS AND ANY LOCAL * ALLOCATIONS THE PROGRAM HAS. IT ALSO RELEASES ANY LU * LOCKS THE PROGRAM HAS. * * CALLING SEQUENCE: * * LDB ID-SEGMENT ADDRESS * JSB $TRRN * NORMAL RETURN REGISTERS MEANING LESS * * $TRRN NOP JSB $ULLU RELEASE ANY LU LOCKS / SET UP TEMPS LDA D$RN SET THE TABLE ADDRESS FOR STA TEMP1 BOTH LOOPS STA TEMP2 LDA A,I GET THE TABLE SIZE CMA,INA,SZA,RSS SET NEGATIVE / IF ZERO EXIT JMP $TRRN,I * STA TEMP3 SET LOOP COUNTERS STA RQP8 FOR BOTH LOOPS * TRRN1 ISZ TEMP2 DALLOCATE LOOP LDA TEMP2,I GET THE RN ALF,ALF PUT OWNER FLAG IN LOW A AND B377 MASK CPA RQP5 IF OWNED BY COMPLETING STA TEMP2,I PROGRAM FLAG FOR NEXT LOOP ISZ RQP8 STEP COUNTER JMP TRRN1 LOOP IF NOT DONE * TRRN3 ISZ TEMP1 LOCAL LOCK LOOP LDA TEMP1,I GET THE RN AND B377 IF LOCAL LOCK CPA RQP5 TO COMPLETING PROGRAM JMP TRRN6 GO RELEASE THE LOCK * TRRN4 ISZ TEMP3 STEP COUNT JMP TRRN3 IF NOT DONE LOOP * LDB TEMP2 GET THE DEALLOCATE FLAG LDA D$RN AND THE ALLOCATE SUSPEND FLAG SZB,RSS IF ANY DEALLOCATED JSB $SCD3 SCHEDULE ANY WAITING PROGRAMS JMP $TRRN,I RETURN * TRRN6 XOR TEMP1,I CLEAR THE LOCK STA TEMP1,I FLAG AND RESET SZA,RSS IF DEALLOCATED STA TEMP2 SET FLAG FOR END OF LOOP JSB SRNW SCHEDULE ANY WAITERS FOR THIS RN JMP TRRN4 RETURN TO LOOP SKP * $CGRN IS THE CLEAR GLOBAL RN ROUTINE FOR USE BY DRIVERS * AND OTHER SUCH USER WRITTEN SYSTEM PROGRAMS * * CALLING SEQUENCE: * * LDA RN SET A TO USER RN WORD * JSB $CGRN CALL THIS ROUTINE * RETURN REGISTERS MEANING LESS. * $CGRN JMP TEMP1 INITILIZE ON FIRST JUMP TO HERE. STA B SAVE THE RN NUMBER AND B377 CACULATE THE TABLE ADA D$RN ADDRESS STA TEMP1 AND SET IT LDA B GET RN WORD AGAIN IOR B377 SET THE GLOBAL FLAG CPA TEMP1,I IS THIS A LEGAL RN? RSS YES SKIP JMP $CGRN,I NO RETURN NO ACTION AND C377 CLEAR THE RN STA TEMP1,I AND RESET IT JSB SRNW SCHEDULE ANY WAITING PROGRAMS JMP $CGRN,I RETURN SPC 3 * SRNW SCHEDULES ANY PROGRAMS SUSPENDED IN THE '3' LIST * WITH A FLAG = (TEMP1) (USUALLY RN LOCK REQUEST SUSPEND) * SRNW NOP LDA TEMP1 GET THE FLAG WORD JSB $SCD3 SCHEDULE ALL SUCH WAITERS JMP SRNW,I RETURN SKP * * THIS SUBROUTINE RELEASES ALL LU'S LOCKED BY A PROGRAM * AND SCHEDULES ANY PROGRAMS WAITING FOR AN * LU OR AN RN. * * CALLING SEQUENCE: * * LDB ID ADDRESS * JSB $ULLU * RETURN - REGISTERS MEANNINGLESS * $ULLU NOP JSB E $IDNO GET THE ID NUMBER STB RQP5 SET FOR $TRRN BLF,BLF PUT THE FLAG WORD STB RQP6 IN HIGH END ADB RQP5 AND IN BOTH ENDS STB RQP7 SET IN RQP7 LDA LUMAX SET UP TO SCAN THE CMA,CLE,INA DRT STA TEMP2 * LDA DRT GET THE DRT ADDRESS STA TEMP3 AND SET FOR LOOP ULLU1 LDA TEMP3,I SEARCH FOR ALL AND B3700 LOCKED LU'S SZA THIS ONE LOCKED? JMP ULLU4 YES - GO TEST * ULLU2 ISZ TEMP3 NO / YES STEP TO NEXT ENTRY ISZ TEMP2 IF NOT DONE JMP ULLU1 TRY NEXT ONE * CLB,SEZ,RSS IF NONE RELEASED JMP $ULLU,I JUST EXIT * STB TEMP1,I CLEAR THE RN JSB SRNW SCHEDULE RN WAITERS LDA D$RN AND ALLOCATION JSB $SCD3 WAITERS JMP $ULLU,I EXIT * ULLU4 CLB LSL 10 SHIFT LOCK FLAG TO LOW B ADB D$RN AND INDEX INTO THE RN TABLE LDA B,I GET THE RN FLAG CPA RQP7 CURRENT PROGRAM? CCE,RSS YES SKIP JMP ULLU2 NO CONTINUE SEARCH * STB TEMP1 YES SET ADDRESS FOR SCHEDULE LDA TEMP3,I GET THE DRT ENTRY AND C3700 CLEAR THE FLAG STA TEMP3,I RESET IT AND JMP ULLU2 CONTINUE SEARCH * D$RN DEF $RNTB B377 OCT 377 C377 OCT 177400 B3700 OCT 3700 C3700 OCT 174077 SPC 2 TEMP1 STA D$RN INITIALIZE CODE TEMP2 LDB B,I GET ADDRESS OF TEMP3 JMP $SCLK D.RTR AND GO START CLOCK * DRT EQU 1652B LUMAX EQU 1653B RQP5 EQU 1704B RQP6 EQU 1705B RQP7 EQU 1706B RQP8 EQU 1707B * ORG * PROGRAM LENGTH END $TRRN `  92064-18145 1650 S C0122 &ONMTM PROGRAM              H0101 PASMB,R,L * NAME : ONMTM * SOURCE: 92064-18145 * RELOC: 92064-16032 * PROGMR: E.J.W. * * **************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT * * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * **************************************************************** * * NAM ONMTM,3,90 92064-16032 REV.1650 761020 * * RU,ONMTM,LU * EXT EXEC A EQU 0 B EQU 1 * ONMTM NOP LDA B,I GET LU IOR ENABL STA CONWD * JSB EXEC SEND CONTROL REQUEST TO ENABLE DEF *+3 DEF D3 DEF CONWD * JSB EXEC END DEF *+2 DEF D6 * D3 DEC 3 D6 DEC 6 ENABL OCT 2000 CONWD NOP * END ONMTM 2  92064-18149 1650 S C0122 &MXRF0 RTE-M CROSS REFERENCE MAIN             H0101 BASMB,R,L,C RTE-M CROSS-REFERENCE TABLE GENERATOR HED ** RTE-M CROSS-REFERENCE TABLE GENERATOR ** * * * 9/10/76 * * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAME : XREF * SOURCE: 92064-18149 * RELOC : 92064-16051 * PRGMR : C.H., H.C., S.K. * NAM XREF,3,99 92064-16051 REV.1650 761001 SUP * * * * * PARAMETERS ARE PASSED THROUGH THE RU COMMAND * RU,XREF,FI,LE,NM,A,B * LU * 0 * WHERE FI,LE,NM IS ANSWER FILE NAME CONTAINING * INPUT AND LIST FILE NAMES * LU IS LU# OF DEVICE TO WHICH QUERIES ARE DIRECTED BY XREF * 0 DEFAULT IS CONSOLE FROM WHICH XREF WAS SCHEDULED * * PARAMETERS A & B ARE DESCRIBED PRECEEDING XRFSG SEGMENT * * EXT CREAT,OPEN,CLOSE,GTFIL,LIMEM,SEGLD EXT .STOP,IMESS,RMPAR,WRITF,READF,FCONT ENT AI,AL,DCBI,DCBL,?ERR,?LWA,?FWA,PRMXR ENT ?FMPE,RTNXR,.M12 * * XREF1 ASC 3,XREF1 IWHCH NOP IWRDS NOP ?FWA NOP ?LWA NOP AI BSS 6 AL BSS 6 ANSW BSS 3 OPTNI OCT 410 ?ERR NOP DCBL BSS 144 DCBI BSS 144 M1 DEC -1 M2 DEC -2 .M12 DEC -12 .1 DEC 1 .4 DEC 4 .64 DEC 64 .210B OCT 210 .21B OCT 21 .LU ASC 1,LU ... ASC 1,.. PRMXR BSS 2 * * * XREF JSB RMPAR GET PARAMETERS DEF *+2 DEF AI USE AI AS TEMPORARY BUFFER DLD AI MOVE FIRST 3 PARMS IN ANSWER FILE DST ANSW BUFFER LDA AI+2 STA ANSW+2 DLD AI+3 PARMS 4&5 INTO PARM BUFFER DST PRMXR * GETFL JSB GTFIL GET FILE NAMES FOR DEF *+7 INPUT & LIST DEF .21Bt OPTION WORD DEF ?ERR ERROR WORD DEF ANSW ANSWER FILE NAME DEF AI INPUT FILE NAME BUFFER NOP DEF AL LIST FILE NAME BUFFER SSA,RSS ERRORS? JMP XREFA NO JSB ?FMPE FMP ERROR ROUTINE DEF ANSW * XREFA CLB CLEAR ANSWER FILE NAME STB ANSW STB ANSW+1 STB ANSW+2 * OPIN JSB OPEN OPEN INPUT FILE DEF *+7 DEF DCBI INPUT FILE DCB DEF ?ERR DEF AI+1 INPUT FILE NAME DEF OPTNI OPTION WORD=410B DEF AI+5 SECURITY CODE DEF AI DRN OR -LU # SSA,RSS ERRORS? JMP CRLST NO, CREATE LIST FILE JSB ?FMPE FMP ERROR ROUTINE DEF AI+1 INPUT FILE NAME * CRLST LDA AL+1 LIST FILE IS AN LU? CPA .LU RSS JMP CRLS1 NOT AN LU LDA AL+2 CPA ... JMP OPLST IT IS AN LU, DO NOT CREATE CRLS1 JSB CREAT CREATE LIST FILE DEF *+8 DEF DCBL LIST FILE DCB DEF ?ERR ERROR WORD DEF AL+1 LIST FILE NAME DEF .64 SIZE OF LIST FILE 64 BLOCKS DEF .4 TYPE OF LIST FILE 4 DEF AL+5 SECURITY CODE DEF AL DRN OR -LU# SSA,RSS ERRORS? JMP OPLST NO OPEN LIST FILE CPA M2 DUPLICATE FILE NAME? JMP OPLST YES, THEN DO NOT CREATE FILE JSB ?FMPE FMP ERROR MESSAGE ROUTINE DEF AL+1 LIST FILE NAME * OPLST JSB OPEN OPEN LIST FILE DEF *+7 DEF DCBL LIST FILE DCB DEF ?ERR ERROR WORD DEF AL+1 LIST FILE NAME DEF .210B OPTION WORD FOR LIST FILE DEF AL+5 SECURITY CODE DEF AL DRN OR -LU# SSA,RSS ERRORS? JMP SYMTB NO, GET MEMORY SPACE FOR SYMBOL TABLE JSB ?FMPE FMP ERROR MESSAGE ROUTINE DEF AL+1 LIST FILE NAME * SYMTB JSB LIMEM FIND FWAa & # OF WORDS IN AVAILABLE DEF *+4 MEMORY DEF IWHCH DEF ?FWA DEF IWRDS LDA IWRDS # OF WORDS = 0? SZA JMP AVMEM NO CALCULATE LWA JSB IMESS NO SYMBOL TABLE SPACE DEF *+4 DEF .2 SEND MESSAGE DEF TBLOV /XREF: TABLE OVERFLOW DEF .11 JMP XRFEX ABORT XREF * AVMEM LDA ?FWA FIRST WORD AVAILABLE OF FREE MEMORY ADA M1 -1 ADA IWRDS # OF WORDS IN FREE MEM STA ?LWA LAST WORD AVAILALE IN FREE MEM * JSB FCONT PAGE EJECT DEF *+5 DEF DCBL LIST FILE DCB DEF ?ERR ERROR WORD DEF B1100 OPTION WORD DEF M1 PAGE EJECT SSA,RSS ERRORS? JMP SGMLD NO, THEN LOAD SEGMENT CPA .M12 -12 ERROR? JMP SGMLD YES, THEN IGNORE IT JSB ?FMPE YES, DISPLAY ERROR DEF AL+1 LIST FILE NAME * SGMLD JSB SEGLD LOAD XREF SEGMENT DEF *+3 DEF XREF1 XREF SEGMENT NAME DEF ?ERR ERROR WORD JSB ?FMPE FMP ERROR ROUTINE DEF XREF1 SEGMENT NAME * * RTNXR JSB CLOSE CLOSE INPUT FILE DEF *+3 DEF DCBI INPUT FILE DCB DEF ?ERR ERROR WORD SSA,RSS ERRORS? JMP EFLST NO, WRITE EOF ON LIST FILE JSB ?FMPE DEF AI+1 INPUT FILE NAME EFLST JSB FCONT WRITE EOF RECORD ON LIST FILE DEF *+4 DEF DCBL DEF ?ERR DEF B100 SSA,RSS ERRORS? JMP CLLST NO CPA .M12 -12 ERROR? JMP CLLST YES, THEN IGNORE IT JSB ?FMPE YES DEF AL+1 * CLLST JSB CLOSE CLOSE LIST FILE DEF *+3 DEF DCBL LIST FILE DCB DEF ?ERR ERROR WORD SSA,RSS ERROR? JMP XRFEX NO, EXIT XREF JSB ?FMPE DISPLAY ERROR AND ABORT XREF DEF AL+1 LIST FILE NAME * XRFEX JSB IMESS DEF *+4 DD DEF .2 DEF XRFEN DEF .6 * JSB LIMEM RELEASE AVAILABLE MEMORY DEF *+2 DEF M1 CLA EXIT XREF JSB .STOP * XRFEN ASC 6, /XREF: $END TBLOV ASC 11, /XREF: TABLE OVERFLOW B100 OCT 100 B1100 OCT 1100 .6 DEC 6 .11 DEC 11 * * * ?FMPE - ROUTINE TO DISPLAY FMP ERROR & ABORT XREF * CALLING SEQUENCE: JSB ?FMPE * DEF AI FILE NAME OF FILE BEING ACCESSED * WHEN ERROR OCCURED * A REG = ERROR CODE * * ?FMPE NOP CMA,INA MAKE ERROR CODE +VE STA FMERR SAVE ERROR CODE CCE E REG = 1 FOR DECIMAL JSB BNCN CONVERT ERROR CODE TO ASCII DLD ASCI+1 DST FMPER+6 LDA ?FMPE,I GET FILE NAME BUFFER ADDRESS STA ASCI USE ASCI BUFFER AS TEMPORARY DLD ASCI,I MOVE FILE NAME TO BUFFER DST FMPER+9 LDA ASCI ADA .2 LDA A,I STA FMPER+11 JSB IMESS PRINT MESSAGE ON CONSOLE DEF *+4 FILEMANAGER ERROR -NNNN FILENM DEF .2 DEF FMPER ERROR MESSAGE DEF .12 LENGTH OF MESSAGE JMP XRFEX ABORT ASMB * FMERR NOP .2 DEC 2 .12 DEC 12 FMPER ASC 12,FMP ERROR - * * * ************************************** * * BINARY TO ASCII CONVERSION ROUTINE * * * A = NUMBER TO BE CONVERTED * * * E = 0 CONVERT TO OCTAL * * * E = 1 CONVERT TO DECIMAL * * ************************************** OCT 30060 PACKED ASCII '00'. BNCN NOP LDB ICSA GET LOC'N OF ACSI BUFFER STB SYMI CCB STB VALUS START UPPER LDB BNCN-1 SET BUFFER=ASCII ZERO'S STB ASCI STB ASCI+1 STB ASCI+2 SEZ TEST E BIT (=0,OCTAL =1,DECIMAL) JMP % DEC CONVERSION LDB .M6 STB DCNT CLE,ELA STA VALU CLA S ELA SIGN BIT IS SIXTH DIGIT JSB DPCK LDA VALU ALF,RAR STA VALU AND .7 (7) MASK 1 DIGIT ISZ DCNT END ? JMP *-6 NO. CONTINUE. JMP BNCN,I YES, EXIT DPCK NOP ADA SYMI,I ISZ VALUS JMP *+4 ALF,ALF STA SYMI,I JMP DPCK,I STA SYMI,I ISZ SYMI CCA STA VALUS JMP DPCK,I EXIT % LDB .M3 (-3) DEC. CONVERSION RTN STB DCNT LDB LMDG STB VAL0 LDB LPDG STB VAL1 LDB 0 A TO B ISZ SYMI DPCR CLA,RSS INA (FROM *+3) ADB VAL0,I COUNT NO.OF TIMES GT 10**N SSB,RSS JMP *-3 ADB VAL1,I <10**N, RESTORE VALUE JSB DPCK PACK DIGIT ISZ VAL1 ISZ VAL0 ISZ DCNT JMP DPCR RETURN FOR 10**N-1 LDA 1 JSB DPCK JMP BNCN,I EXIT * .M3 DEC -3 .M6 DEC -6 .7 DEC 7 ICSA DEF ASCI SYMI NOP VAL0 NOP VAL1 NOP VALU NOP VALUS NOP DCNT NOP LMDG DEF *+1 DEC -1000,-100,-10 LPDG DEF *+1 DEC 1000,100,10 ASCI BSS 3 A EQU 0 B EQU 1 * END XREF u    92064-18150 1709 S C0122 &FMGF0 RTE-M FLPY FMGR MAIN             H0101 ASMB,R,L,C HED FMGR * NAME: FMGR * SOURCE: 92064-18150 * RELOC: 92064-16055 * PGMR: G.L.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM FMGR,1,80 92064-16055 REV.1709 770223 * * ENT FMGR,N.OPL,ELOG.,AB.FM,FM.AB ENT TMP.,MSS.,C.BUF,LODCB EXT OPEN,READF,DTTY,RMPAR,WRITF,.MVW EXT $CON,EXEC,.ENTR,IDCB1,.E.R,LIMEM,$CDIR EXT CONV.,OPEN.,CLO,.DRCT,MGLU,IMESS,IDCB2 EXT $LIBR,$LIBX SUP * * CON1 NOP N20K OCT 160000 * ONP1 NOP ONP2 NOP ONP3 NOP ONP4 NOP ONP5 NOP * FMGR JSB RMPAR FETCH DEF *+2 THE ONP1A DEF ONP1 5 TURN ON PARMS * * BOOT JMP INITD GO INITIALIZE THE MASTER DIRECTORY * BOOT1 LDA $CON,I FETCH TERMINAL LU AND B77 ISOLATE IT STA CON1 AND SAVE IT * * 1ST PARM CHECKS * LDA ONP1 FETCH PARM1 LDB N20K FETCH MIN ASCII WD ADB A IS THIS A ANSWER FILE? SSB,RSS WELL? JMP ITNME YES--CONTINUE * SZA,RSS IF DEFAULT USEC LDA CON1 USE CORRECT CONSOLE STA ONP1 SAVE CORRECT VALUE FOR OTHER CHECKS JSB DTTY INTERACTIVE? STA INT. SAVE RESULT (0=NO, NON ZERO = YES) * * GET MAGIC NAME FOR THIS LU * JSB MGLU DEF *+3 DEF ONP1 OBF DEF C.BUF * LDA OBF FETCH ADDRESS OF NAME JSB OPIN GO TRY TO OPEN IT(ERRORS RETURN TO USEC) * JMP USEC BAD RETURN FROM OPEN--USE CONSOLE * LDA ONP2 FETCH LOG (NORMAL RETURN) SZA,RSS DEFAULT? 8JMP W2K YEP--GO FIND SOMETHING TO USE * * LOG GIVEN--MUST BE INTERACTIVE * JSB DTTY VERIFY THAT IT IS INTERACTIVE LDB ONP2 FETCH LOG IN CASE IT OK SZA WELL? JMP W3K ----IT'S INTERACTIVE----CONTINUE * * LOG NOT INTERACTIVE * ISSUE BAD PARM ERROR CODE * THEN USE CORRECT TERMINAL * LDA .56 FETCH ERROR CODE STA ER SET IT JSB ONER USE IMESS FOR BOOT UP ERROR * * * LOG NOT GIVEN OR NOT INTERACTIVE * W2K LDA INT. WAS INPUT INTERACTIVE? LDB ONP1 FETCH IT IN CASE IT WAS SZA,RSS WELL? WKFL LDB CON1 NOPE--USE CONSOLE W3K STB ONP2 SET NEW LOG LU JSB MGLU GO GET MAGIC NAME FOR IT DEF *+3 DEF ONP2 ADDRESS OF NUMBER TO BE CONVERTED DEF C.BUF TEMP AREA FOR RESULT * * GO OPEN HER UP * JSB OPEN DEF O.2R DLO$ DEF LODCB DEF ER DEF C.BUF DEF OPOPT * O.2R SSA,RSS ANY PROBLEMS? JMP LSTWK * * ISSUE ERROR MESSAGE THEN TRY AGAIN USING CONSOLE * JSB ONER JMP WKFL * * * OPIN OPENS THE INPUT FILE/DEVICE * LDA ADDR ADDRESS OF NAME TO BE OPENED * JSB OPIN * * P+1=OPEN ERROR WAS FOUND--ERROR HAS BEEN ISSUED * P+2=NORMAL RETURN * OPIN NOP STA INME JSB OPEN DEF O.1R DIN$ DEF INDCB DEF ER INME NOP ADDRESS OF BUF HOLDING NAME GOES HERE DEF OPOPT OPEN OPTION * O.1R SSA,RSS ANY ERRORS? JMP GDD NOPE--GO EXIT P+2 * JSB ONER ISSUE ERROR CODE JMP OPIN,I RETURN P+1 (BAD RETURN) * GDD ISZ OPIN ADVANCE TO GOOD RETURN JMP OPIN,I RETURN * * ONER NOP LDA ER JSB STER GO SET UP ERROR MESS JSB IMESS DEF RTRN DEF .2 DEF ERMES DEF .5 RTRN JMP ONER,I * * * * SPC 5 * * INPUT IS A FILE NAME * q ITNME LDA ONP1A FETCH ADDRESS OF NAME JSB OPIN GO OPEN IT JMP NOGD ERROR FROM OPEN--SET UP TO USE DEFAULTS * LDB DIN$ OPEN WAS OK--NOW ADB .2 SEE IF IT'S INTERACTIVE LDA B,I FETCH TYPE WORD SZA CONTINUE IF ZERO JMP NZRO ELSE SET IT NON-INTERACTIVE INB ADVANCE TO LU LDA B,I FETCH LU -DTTY ISOLATES IT STA EX! SAVE IT IN TEMP JSB DTTY STINT STA INT. LDB ONP5 FETCH LIST PARM STB ONP3 SET FOR NORMAL LIST PROCESSING SZA,RSS USE THIS LU IF INTERACTIVE JMP WKFL GO SET CONSOLE AS LOG DEVICE * LDB EX! FETCH LU JMP W3K GO USE SAME LU AS LOG * NZRO CLA JMP STINT GO SET INPUT INTERACTIVE FLAG FALSE * * NOGD LDA CON1 FETCH CONSOLE LU STA ONP2 SET AS LOG LDA ONP5 STA ONP3 SET LIST JMP USEC GO DO EVERYTHING DEFAULT * * LSTWK LDA ONP3 FETCH LIST LU SZA,RSS SKIP IF NOT DEFAULT LDA .6 DEFAULT TO LU 6 STA TMP. SAVE IT FOR USE BY SUBS * LDA DIN$ ADDRESS OF INPUT DCB STA IN$ SET AS CURRENT INPUT FILE * JSB CLOAL CLOSE ALL FILES SPC 10 * * COMMAND INPUT FILE OPEN-- * FETCH AND PARSE NEXT COMMAND * NXCM JSB RE.C GO GET A COMMAND CLA CLEAR COMMAND ADDRESS IN CASE STA CMAD ONLY BLANKS OR CONTROL IS ENTERED * JSB PARS GO PARSE IT * * LDA CMAD FETCH COMMAND ADDRESS SZA,RSS IF ZERO THEN 0 NON-BLANK CHARS HAVE BEEN ENTERED JSB CMND? ERROR-- * * COMMAND HAS BEEN IDENTIFIED AND ADDRESS IS IN CMAD * CLA CLEAR OUT STA ER ERROR WORDS STA .E.R * JSB CMAD,I CALL THE ACTION ROUTINE DEF CALR DEF P.CNT DEF P.RAM DEF ER * CALR LDA ER SZA,RSS JMP SHUT JMP ELOG. SPC 5 * * ER NOP INDCB BSS 144 * ORG INDCB FORCE BOOT-UP CODE INTO DCB * INITD LDA $CDIR FETCH FIRST WORD OF DIRECTORY SSA,RSS CONTINUE ONLY IF NOT DONE JMP XGOOD ELSE EXIT * JSB OPEN FORCE CALL TO D.RFP DEF XRTN DEF LODCB DEF XER DEF XNAM * XRTN CPA XN100 ONLY BAD RETURN IS -100 JMP XBAD * * XGOOD CLA REMOVE STA BOOT JMP INITD JMP BOOT1 * * XBAD JSB IMESS DEF XRTN2 DEF X.2 DEF XBUF DEF XLEN * XRTN2 JSB $LIBR GO PRIV NOP AND CLEAR BOOT FLAG CLA ($CDIR= NEG DISK LU) STA $CDIR (MAKE IT =0) JSB $LIBX DEF *+1 DEF XGOOD CONTINUE AFTER MESSAGE * * X.2 OCT 2 X.5 OCT 5 XN100 DEC -100 XER NOP XNAM ASC 3,---- - XLEN DEC 20 * XBUF ASC 20, FMGR -100 (LU 2 MUST BE INITIALIZED) * * ORR SPC 5 * * * TMP. NOP TMP.2 OCT 0,0 SC.L NOP CRLU NOP SPC 10 AB.FM LDA .E.R JMP ELOG. * FM.AB EQU AB.FM SPC 5 MSCD NOP MSCD2 NOP MSS. NOP JSB .ENTR DEF MSCD LDA MSCD,I * * * ELOG. JSB STER GO SET UP ERROR MESS JSB WRITF DEF ERMS DEF LODCB DEF ER DEF ERMES DEF .5 ERMS LDA DLO$ STA IN$ SWITCH TO LOG DEVICE FOR INPUT STA INT. SET INTERACTIVE FLAG * JSB CLO CLOSE THE INPUT FILE DEF INDCB * CLO2 CLB LDA MSCD2 STB MSCD2 CLEAR PARM SO WE CAN EXIT SZA JMP MSS.2 YEP--SO ISSUE IT LDA MSS. STB MSS. SZA JMP A,I * JSB LIMEM RELEASE MEMORY IN CASE PK ABORTED DEF SHUT DEF N1 * SHUT JSB CLOAL * CLRTN JMP NXCM GO GET NEXT COMMAND * * * MSS.2 LDA A,I FETCH THE CODE JMP \ELOG. GO DO IT * * * * STER NOP LDB BLK IF NOT NEG USE BLANK SSA LDB BSGN STB ESGN SSA CMA,INA STA OLDER SAVE ERROR CODE JSB CONV. DEF CVTN DEF OLDER DEF ECDE DEF .3 CVTN JMP STER,I * * * ZERO NOP ERMES ASC 3,FMGR ESGN NOP ECDE NOP * * * * BSGN ASC 1,- BLK ASC 1, OLDER NOP SPC 5 ERR? CLA LDB IBP FETCH CURRENT BYTE ADDRESS CLE,SLB,ERB DETERMINE WHICH BYTE TO ZAP LDA HBTE SAVE HIGH BYTE AND B,I ELSE USE 0 * IOR B77 INCLUDE "?" SEZ,RSS IF CURRENT BYTE=HIGH RE-POSITION ALF,ALF STA B,I SET BACK INTO INPUT BUFFER * * DETERMINE ECHO LENGTH * ERB SET CHAR FLAG INTO SIGN OF B LDA DNFLG FETCH REMAINING COUNT (1'S COMP & BYTE) SZA SKIP COMP IF ZERO CMA MAKE IT POSITIVE CLE,ERA MAKE IT WORDS CMA,INA SET COUNT NEG ADA ECH ADD TO ORGINIAL COUNT CLE,ELA MAKE IT BYTES SSB,RSS IF IT WAS HIGH BYTE INA BUMP CHAR COUNT CMA,INA SET IT NEG FOR CHAR COUNT STA ECH STORE PRINT LENGHT JSB ECHO GO PRINT IT LDA .10 STA .E.R JMP AB.FM * * HBTE OCT 177400 * SKP * * EX! NOP * JSB CLO DEF INDCB CLOSE INPUT FILE * * EXR1 JSB WRITF DEF EXR3 DEF LODCB DEF ER DEF ENDM ISSUE END FMGR MESSAGE DEF .5 DON'T NEED TO CLOSE LOG AS IT MUST BE LU * EXR3 JSB CLOAL EXR4 JSB EXEC DEF *+2 DEF .6 TERMINATE * * ENDM ASC 5,$END FMGR * * * * CLOSE LIBRARY DCBS IDCB1 AND IDCB2 * CLOAL NOP JSB CLO CLOSE ROUTINE-- DEF IDCB1 DIRECT CALLING SEQUENCE JSB CLO DEF IDCB2 CLOSE SECOND DCB JMP CLOAL,I * * * * SPC 10 * LLTMP NOP LLST NOP LLER NOP * LL! NOP JSB .ENTR DEF LLTMP ISZ LLST JSB OPEN. DEF BKLL DEF IDCB1 DEF LLST,I DEF N.OPL DEF B411 * BKLL LDA LLST,I STA TMP. ISZ LLST DLD LLST,I DST TMP.2 JSB .DRCT DEF N.OPL ASSURE DIRECT ADDRESS LDB A,I STB SC.L INA LDB A,I STB CRLU CLA STA LLER,I JMP LL!,I * B411 OCT 411 OPOPT EQU B411 * * * * SPC 3 ******FETCH DIRECT ADDR******** * .ADDR NOP RAL,CLE,ERA SEZ LDA A,I JMP .ADDR,I * .56 DEC 56 * * * B77 OCT 77 * * .2 OCT 2 .3 OCT 3 .5 OCT 5 .6 OCT 6 .10 DEC 10 .36 DEC 36 * * SPC 10 TCNT NOP TLST NOP TER NOP * TR! NOP JSB .ENTR DEF TCNT ISZ TLST ADVANCE TO NAME/LU * LDA TLST,I FETCH IT SZA,RSS * * TRANSFER BACK TO THE LOG DEVICE * JMP ERMS * * OPITR JSB OPEN. GO OPEN NEW TRANSFER FILE DEF BACK XX DEF INDCB DEF TLST,I DEF N.OPL DEF OPOPT * BACK LDA XX FORCE INPUT DCB TO BE USED STA IN$ ADA .2 ADVANCE TO TYPE WORD LDB A,I FETCH IT SZB IF ZERO--CONTINUE JMP DSFL NOPE IT'S A DISK FILE INA ADVANCE TO LU WORD LDA A,I FETCH IT JSB DTTY TRINT STA INT. SET INTERACTIVE FLAG JMP TR!,I * DSFL CLA FORCE NOT INTERACTIVE JMP TRINT SKP * * * * RE.C SHOULD DO THE FOLLOWING: * 1- DETERMINE IF INPUT FROM INTERACTIVE DEVICE * IF SO, PROMPT ON THAT DEVICE * 2- READ FROM INPUT FILE/DEVICE * 3- IF ECHO REQUIRED-DO IT TO LOG * * * GLOBALS * * ECH CMND INPUT LEGNTH * INT. INTERACTIVE FLAG * C.BUF CMND INPUT BUFFER * INDCB INPUT DCB * .1 OCT 1 * RE.C NOP LDA INT. IF NOT INTERACTIVE SZA,RSS JMP WR.1R DON'T PROMPT * JSB WRITF DEF WR.1R DEF IN$,I DEF TMP2 DEF PRM DEF .1 * WR.1R JSB READF DEF WR.2R DEF IN$,I DEF TMP2 DEF C.BUF DEF .36 DEF ECH LEGNTH PARM * WR.2R SSA IF ANY ERROR JMP WR.1R RETRY * * LDA ECH IF EOF CPA N1 TRANSFER TO JMP ERMS LOG DEVICE * * * DO ECHO IF IN FROM NON INT WORK * * LDA INT. FETCH INTERACTIVE FLAG SZA,RSS JSB ECHO GO DO ECHO JMP RE.C,I IT'S INTERACTIVE SO EXIT * SPC 5 N1 OCT -1 ECHO NOP JSB WRITF DEF ECRT DEF LODCB DEF TMP2 DEF C.BUF DEF ECH ECRT JMP ECHO,I IN$ NOP PRM OCT 35137 BACK SPACE AND BACK ARROW * * * .88 DEC 88 * SKP * * ********************************************** ********************************************** *******THE*PARSE*ROUTINE*MAY*BECOME*A*SEPERATE* ****************SUBROUTINE******************** * * * * PARSE ROUTINE * PARS NOP LDA ECH RESET COMMAND LEGNTH CLE,ELA CONVERT TO CHAR COUNT CMA SET NEGATIVE FOR GTCHR STA DNFLG LDA CAM.A RESET CHARACTER ADDRESS STA IBP FOR INBUF SCAN * * * LDB INT. FETCH INTERACTIVE FLAG SZB IF NOT INTERACTIVE-SKIP JMP OK: --ELSE CONTINUE * JSB GTCHR JMP ERR? * * CPA CLN MUST HAVE : FOR FIRST CHAR JMP OK: GOT IT-CONTINUE * JMP ERR? ELSE ISSUE ERROR AND TRANSFER TO LOG DEVICE * SPC 5 OK: CLA ZERO OUT POINTERS,BUFFERS STA MRSLT WORK FIELDS AND FLAGS LDA MADDR FETCH START ADDRESS (DEF MRSLT STA" B AND FORM INB RESULT FIELD ADDRESS * JSB .MVW GO DEF .88 CLEAR NOP THE WORLD * LDA MADDR FETCH ADDRESS OF MAIN RESULT STA NXBUF FIELD AND SET IT AS FIRST BUFFER LDA .17 FETCH MAIN BUF CODE STA NXBC SET AS NEXT BUF FLAG LDA N2 SET FIRST FLAG FOR CMND CHECK STA FIRST * SKP * TOP ISZ FIRST GOT CMND READY? RSS NOPE JSB CMND? DOES NOT RETURN IF BAD CMND * LDA WORKA RESET WORK BUF ADDRESS STA TMP1 FOR THIS PASS LDA NXBUF FETCH NEXT BUFFER ADDRESS STA CBUF SET IT AS CURRENT BUFFER LDA NXBC SET CURRENT STA CXBC BUFFER FLAG CLA STA FNDCT CLEAR CHAR FOUND THIS PARM COUNT * * * LDB DNFLG FETCH DONE FLAG SSB,RSS IF MORE CHAR --SKIP JMP PARS,I ELSE GO TO EXIT * * NEXT JSB GTCHR FETCH NEXT NON-BLANK CHAR JMP CONV -ALL DONE--SEE IF CONVERSION NEEDED * CPA CMA IS IT A COMMA? JMP GTCMA YES-GO PROCESS IT * CPA CLN IS IT A COLON? JMP GTCLN YES- GO PROCESS IT * * NOT SURE ON THIS COUNT * LDB .8 CHECK FOR TOO MANY CHARS CPB FNDCT COMPARE AGAINST #FOUND JMP NEXT YES--DON'T SAVE EXTRAS * STA TMP1,I =LOCATION TO SAVE CHAR ISZ FNDCT BUMP CHAR FOUND COUNT ISZ TMP1 BUMP SAVE LOCATION * JMP NEXT GO GET NEXT CHAR * * FIRST NOP N2 OCT -2 * * SPC 5 * * GOT A CMND--SEE IF IT IS LEGIT * * * DETERMINE CMND TYPE * CMND? NOP LDB MADDR FETCH FLAG FOR LDA B,I COMMAND-- CPA .3 MUST BE ASCII INB,RSS YEP-- IT'S OK * JMP ERR? NOPE--BAD INPUT * * LDA B,I FETCH [COMMAND STA OPP SET STOP WORD LDB TABP SET TABLE STB TMP1 POINTER FOR SEARCH LDB ACTP SET ACTION ADDRESS STB TMP2 FOR SEARCH * SCH CPA TMP1,I THIS IT? JMP CALL YES--GO TO IT ISZ TMP1 BUMP COMMAND POINTER ISZ TMP2 BUMP ACTION POINTER JMP SCH TRY AGAIN-- * * SPC 2 CALL LDA TMP2 FETCH CMND ADDRESS CPA ERC IF EQUAL TO ERROR ADDRESS JMP ERR? THEN GO NO FURTHER * STA CMAD SET COMMAND ADDRESS JMP CMND?,I * CMAD NOP * TABP DEF *+1 ASC 8,CRDUSTLIEXLLTRCN ASC 9,INMCDCCLDLCOPUPKRN OPP NOP SET TARGET HERE * * ACTP DEF *+1,I EXT CR.. DEF CR.. EXT DU.. DEF DU.. EXT ST.. DEF ST.. EXT LI.. DEF LI.. DEF EX! DEF LL! DEF TR! EXT CNT. DEF CNT. EXT IN..,RC..,MC.. DEF IN.. DEF MC.. DEF RC.. EXT CL..,DL..,CO.. DEF CL.. DEF DL.. DEF CO.. EXT PU..,PK..,CN.. DEF PU.. DEF PK.. DEF CN.. ERC DEF *,I NOT FOUND --BAD INPUT * * .8 DEC 8 .17 DEC 17 * SKP * * * FOUND A COMMA * GTCMA ISZ P.CNT INC MAIN PARM COUNT LDA P.CNT FETCH MAIN PARM COUNT RAL,RAL MULT BY 4 ADA MADDR AND ADD BUFFER START ADDRESS STA NXBUF TO GET RESULT STARTING ADDRESS * LDA .17 FETCH # MAX PARMS+1 STA NXBC SET AS NEXT BUF FLAG CPA P.CNT ALSO CHECK FOR TOO MANY PARAMETERS JMP ERR? --TOO MANY BYE BYE * CLA RESET SUB PARM COUNT STA SPCNT JMP CONV GO CONVERT PARM * SPC 5 * * FOUND A COLON * GTCLN LDA P.CNT FETCH MAIN PARM COUNT ADA N2 BUT NO MORE THAN 2 LDB SPADR FETCH SUB PARM BUFFER ADDRESS S@SA IF FOR FIRST MAIN PARM JMP SET GO SET BUFFER ADDRESS * SZA IF MORE THAN 2ND PARM JMP ERR? --TAKE ERROR EXIT ADB .5 ELSE ADVANCE TO 2ND MAIN FIELD * * (B)= START OF SUB PARM FIELD * DETERMINE OFSET * SET ADB SPCNT ADD CURRENT SUB PARM COUNT STB NXBUF SET AS NEXT RESULT BUFFER ADDRESS ISZ SPCNT BUMP SUB PARM COUNT LDA .6 MAX # SUB PARMS +1 STA NXBC SET SUB PARM AS NEXT RESULT FIELD CPA SPCNT SEE IF WE'VE GOT TOO MANY JMP ERR? YEP--TAKE ERROR EXIT * * THIS FALLS THRU TO CONVERT * * SPC 5 * * * CONVERT ROUTINE * CONV LDA FNDCT IF NO CHARS FOUND SZA,RSS THEN EITHER DONE OR NULL JMP NONE GO CHECK * LDB WORKA SET ADDRESS OF WORK STB TMP1 BUFFER FOR CONVERSION LDA B,I FETCH FIRST CHAR * CPA DASH IF "-" GO SEE IF THATS ALL JMP C. * CPA PLUS DO THE SAME JMP C. FOR "+" * LSTT ADB FNDCT ADVANCE TO LAST CHAR ADDRESS ADB N1 LDA B,I FETCH IT CPA AS.B CHECK FOR BASE INDICATOR JMP .B YES IT'S BASE 8 INB ADVANCE PAST LAST CHAR LDA .10 FETCH FOR BASE 10 CONVERSION * STBS STA BASE SET BASE FOR CONVERSION STB STOP SET STOP ADDRESS CLB,CLE CLEAR THE RESULT STB VALUE BUFFER * CMPY MPY VALUE LDB TMP1,I FETCH CURRENT CHARACTER ADB DM58 IF GREATER THAN "9" SEZ,CLE,RSS THEN NOT A NUMBER ADB .10 IF LESS THAN "0" SEZ,CLE,RSS THEN NOT JMP ASCII A NUMBER * ADA B INCLUDE PREVIOUS RESULT STA VALUE AND SAVE IT * ISZ TMP1 BUMP WORK BUFFER POINTER LDA BASE FETCH BASE FOR NEXT LOOP LDB STOP FETCH STOP ADDRESS CPB TMP1 IF EQUAL TO CURRENT WORK POINTER JMP CDNE THEN CONVERSION COMPLETE JMP CMPY ELSE--CONTINUE CONVERSION * * * SPC 5 C. ISZ TMP1 LDA FNDCT CPA .1 JMP ASCII JMP LSTT SPC 5 .B LDA .8 FETCH CONVERSION BASE JMP STBS * * * * * * * CONVERSION DONE * NUMERIC RESULT * IN "VALUE" * CDNE LDA WORKA,I FETCH FIRST CHAR LDB VALUE FETCH CONVERTED VALUE CPA DASH IF ="-" THEN NEGATE CMB,INB RESULT * * * DETERMINE WHERE RESULT GOES * LDA CXBC FETCH CURRENT BUFFER CODE CPA .17 MAIN PARM BUF? JMP MAIN YEP * * GOES IN SUB PARM BUF * STB CBUF,I SAVE RESULT IN BUFFER JMP TOP GET NEXT PARAMETER * * * GOES IN MAIN PARM BUF * * MAIN CLA,INA STA CBUF,I SET NUMERIC FLAG INTO BUFFER ISZ CBUF ADVANCE PAST FLAG WORD STB CBUF,I SET CONVERTED VALUE INTO BUFER JMP TOP FETCH NEXT PARAMETER * * SPC 10 * * * ASCII PARAMETER * * ASCII LDA CXBC FETCH CURRENT BUFFER FLAG CPA .17 MAIN BUFFER?? JMP AMAIN YEP--MOVE TO MAIN BUFFER * * * MOVE TO SUB PARM BUFFER * LDA SPCNT IF SUB CNT >4 THEN ADA N4 CAN'T HAVE SSA,RSS ASCII PARM JMP ERR? SO ERROR EXIT * * LDA .2 FETCH MAX # CHAR TO BE MOVED JMP MASC GO DO IT * * * * MAIN BUF MOVE * AMAIN LDA .3 FLAG CODE FOR ASCII STA CBUF,I SET FLAG INTO BUFFER ISZ CBUF ADVANCE PAST FLAG WORD LDA .6 SET A MAX OF 6 MASC CMA,INA CHARS FOR MOVE STA CCNT SET IN COUNTER * * LDB WORKA FETCH ADDRESS OF WK BUFFER ADB FNDCT ADD # CHARS FOUND STB STOP SET AS STOP ADDRESS * * LDB :WORKA FETCH WK BUF ADDR STB TMP1 SET AS FROM ADDRES CLE,RSS CLEAR BYTE FLAG AND SKIP ADDR FETCH * MNXT LDB TMP1 FETCH FROM ADDRESS CPB STOP IS THAT ALL FROM HERE JMP GTBLK YES--PAD WITH BLANKS * LDA B,I FETCH CHAR FROM WORK FIELD ISZ TMP1 BUMP FROM ADDRESS POSN SEZ,CME,RSS NEED TO POS CHAR? ALF,ALF YES-SHIFT TO HIGH BYTE LDB CBUF,I FETCH CURRENT RESULT WORD IOR B INCLUDE CURRENT CHAR STA CBUF,I SAVE BACK INTO RESULT BUFFER SEZ,RSS INCREMENT RESULT BUFFER ADDR ISZ CBUF ONLY IF NEW WORD IS NEEDED ISZ CCNT BUMP MOVE COUNT-DONE? JMP MNXT NOPE-GO SEE ABOUT NEXT CHAR JMP TOP ALL DONE--GET NEXT PARAMETER * * GTBLK LDA B40 FETCH ASCII LOW " " JMP POSN GO PAD FIELD * * * SPC 5 * NONE LDB DNFLG FETCH DONE FLAG SSB,RSS IF SIGN NOT SET JMP PARS,I DONE * JMP TOP ELSE GET NEXT PARAMETER(O=NULL ) * * * * GTCHR NOP * * NOBK LDA IBP FETCH INPUT CHAR ADDRESS ISZ DNFLG BUMP CHAR COUNTER SKIP IF DONE RSS SKIP EXIT JMP GTCHR,I DONE EXIT CLE,ERA GET WORD ADDR AND SET BYTE FLAG LDA A,I FETCH INPUT WORD SEZ,RSS POSITION FOR REQUESTED BYTE ALF,ALF IF NEEDED AND B377 ISOLATE IT ISZ IBP BUMP CHAR ADDRESS CPA B40 IF BLANK JMP NOBK GET NEXT ONE ISZ GTCHR ELSE BUMP RETURN ADDRESS JMP GTCHR,I RETURN * * ******************************************** *******THE FOLLOWING SECTION IS ZEROED****** *******EACH TIME THE PARSE ROUTINE IS ****** *******INVOKED****************************** * * * DON'T REMOVE ANY OF THESE AS LIST * USES THIS SECTION AS A BUFFER * * ************ MRSLT BSS 4 FIRST 4 ARE FOR THE COMMAND P.RAM BSNLHS 64 MRSLT AND P.RAM FORM THE RESULT FIELD ************ WORK BSS 8 TEMP BUFFER FOR CONVERSION SPBUF BSS 10 RESULT FIELD FOR SUB PARMS P.CNT NOP FNDCT NOP SPCNT NOP ********************************************************* ********************************************************* NXBC NOP CXBC NOP NXBUF NOP N.OPL EQU SPBUF CBUF NOP TMP1 NOP TMP2 NOP WORKA DEF WORK C.BUF BSS 40 CAM.A DBL C.BUF IBP NOP MADDR DEF MRSLT SPADR DEF SPBUF DASH OCT 55 AS.B OCT 102 DM58 DEC -58 ECH NOP * INT. NOP CLN OCT 72 CMA OCT 54 DNFLG NOP N4 OCT -4 B40 OCT 40 B377 OCT 377 * * * * * PLUS OCT 53 ASCII + BASE NOP STOP NOP VALUE NOP CCNT NOP * * LODCB BSS 144 PUT THIS HERE TO PREVENT BP LINKS A EQU 0 B EQU 1 LEN EQU * * END FMGR mN  92064-18151 1650 S C0122 &L1..F RTE-M FLPY FMGR LIST SUB             H0101 RSPL,L,O,M,C ! NAME: LI.. ! SOURCE: 92064-18151 ! RELOC: 92064-16055 ! PGMR: G.A.A. ! MOD: G.L.M. ! ! *************************************************************** ! * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * ! * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * ! * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* ! * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ! *************************************************************** ! ! NAME LI..(7) " 92064-16055 REV.1650 760824" ! ! ! LI.. IS THE RTE FMGR FILE LIST MODULE ! IT IS ENTERED ON COMMAND ! ! LI,NAMR,TY ! ! WHERE: ! ! ! NAMR IS THE NAME REFERENCE INCLUDING ! SECURITY CODE AND DISC ID ! ! TY IS THE LISTING TYPE AND IS ASCII: ! ! S OR A OR NULL SOURCE WITH LINE NUMBERS ! B BINARY DUMP ! D DIRECTORY HEAD ONLY ! ! ! EACH LISTING WILL BE PROCEEDED BY THE HEAD: ! ! NAMEL T=XXXXX IS ON PK XXXXX USING XXXX BLKS R=XXXX ! ! ! ! ! ! S FORMAT IS A BLANK FOLLOWED BY 4 DIGIT ! LINE NUMBER FOLLOWED BY TWO BLANKS FOLLOWED ! BY THE RECORD. ! ! B FORMAT IS : ! A)THE RECORD HEAD: REC# XXXXX ! B)N LINES FORMATED AS FOLLOWS ! 8 5-DIGIT OCTAL NUMBERS SEPERATED BY BLANKS ! AND FOLLOWED BY A "*" FOLLOWED BY THE ! 16 ASCII CHARACTERS THE DIGITS REP. ! NON-PRINTING CHARACTERS WILL BE FILLED ! WITH BLANKS ! ! D FORMAT IS THE HEAD ONLY ! ! ! ! DEFINE EXTERNALS ! LET .TTY BE FUNCTION,EXTERNAL LET JER. BE SUBROUTINE,EXTERNAL,DIRECT ! LET IDCB1,IDCB2,BUF.,.E.R ,\ TMP.,N.OPL,D.LB BE INTEGER,EXTERNAL LET OPEN.,LOCF,WRITF,READF,EXEC,\ DR.RD, \ CONV.,JER. \ h> BE SUBROUTINE,EXTERNAL ! ! DEFINE INTERNAL ROUTINES ! LET SETA,WRIT,SPACE BE SUBROUTINE,DIRECT ! ! DEFINE CONSTANTS ! HL LET BL.T BE CONSTANT (20124K)! T LET EQ.BL BE CONSTANT (36440K)!= LET BL.I BE CONSTANT (20111K)! I LET S.BL BE CONSTANT (51440K)!S LET O.N BE CONSTANT (47516K)!ON LET BL.C BE CONSTANT (20103K)! C LET R.BL BE CONSTANT (51040K)!R LET BL.L BE CONSTANT (20114K)! L LET U.BL BE CONSTANT (52440K)!U LET BL.U BE CONSTANT (20125K)! U LET S.I BE CONSTANT (51511K)!SI LET N.G BE CONSTANT (47107K)!NG LET BL.B BE CONSTANT (20102K)! B LET L.K BE CONSTANT (46113K)!LK LET R.EQ BE CONSTANT (51075K)!R= LET A.BL BE CONSTANT (40440K)!A LET B.BL BE CONSTANT (41040K)!B LET D.BL BE CONSTANT (42040K)!D LET R.E BE CONSTANT (51105K)!RE LET C.NO BE CONSTANT (41443K)!C# LET DST BE CONSTANT (25052K)!** ! ! DEFINE BUFFER SET UP ! LET LSTBF(2),LNNO,BLWD,LBF(128) BE INTEGER LI..: SUBROUTINE(NOC,LIS ,ER) GLOBAL ! OPFL_401K !SET DEFAULT OPEN OPTION NUL_0 !PRESET NULL PRAM FLAG TYPF_($([LIS1_@LIS +1]+4) AND 177400K)+40K IF TYPF=A.BL THEN GO TO STYP !CHECK FOR IF TYPF=40K THEN[NUL_1;GO TO STYP]!LEGAL IF TYPF=D.BL THEN GO TO TYPOK !OPTIONS IF TYPF=B.BL THEN[OPFL_311K;GO TO TYPOK]!NULL,A,S,B,D IF TYPF#S.BL THEN [ER_56;RETURN]!NO; RETURN 56 ! STYP: TYPF_S.BL !FOURCE NULL,ATOS ! TYPOK:OPLS_ @TMP.+3 !GET LIST UNIT OP LIST ! OPEN.(IDCB2,TMP.,$OPLS, 0) !OPEN LIST FILE ! OPEN.(IDCB1,$LIS1,N.OPL,OPFL) !OPEN FILE TO BE LISTED ! CALL LOCF(IDCB1,.E.R ,LP,LP,LP,NSEC,FLU,FTYP,RECS) IFNOT NUL THEN GO TO OK !IF NULL THEN CHOSE 2THE RIGHT OPTION IFNOT FTYP THEN GO TO OK !TYPE ZERO DEFAULT IS ASC IF FTYP=3 THEN GO TO OK !SAME FOR TYPE 3 IF FTYP=4 THEN GO TO OK !SAME FOR TYPE 4 CTYP: TYPF_B.BL !OTHERWISE USE BINARY FORMAT ! OK: CALL LOCF(IDCB2,.E.R ,LP,LP,LP,LP,LLU) !GET LIST LU ! EXEC(13,LLU,EQT5) !GET LIST LU TYPE CODED ! P36_[P3_@LIS +4]+33 !SET UP LIST ADDRESSES LP_1 !SET LINE PRINTER FLAG IF (EQT5 AND 37400K)<5000K THEN LP_0 TTY_.TTY(LLU) FOR T_ P3 TO P36 DO[$T_20040K] ! BLANK THE BUFFER P_P3-1 SETA(BL.T) !SET BLANK T SETA(EQ.BL) !SET = BLANK P_P+2 CONV.(FTYP,$P,5) !SET TYPE SETA(BL.I) !SET BLANK I SETA(S.BL) !SET S BLANK SETA (O.N) !SET ON IF FTYP THEN[SETA(BL.C);SETA(R.BL);DR.RD(1,-FLU,\ 0);T_$$@D.LB;N_5],\ ELSE[SETA(BL.L);SETA(U.BL);T_FLU;N_2] P_P + N/2 CONV.(T,$P,N) IFNOT FTYP THEN[N_13;GO TO WRHD] SETA(BL.U) !SET USING SETA(S.I ) SETA(N.G ) P_P+3 ! CONV.(NSEC/2,$P,5) ! ! SETA(BL.B) !SET BLKS R= SETA(L.K) SETA(S.BL) SETA(R.EQ) ! P_P+2 ! CONV.(RECS,$P,4) ! N_27 ! WRHD: TB_[BF_[IF TYPF=S.BL THEN @LSTBF,ELSE @BUF.]]+1 $BF_20040K !BLANK FIRST WD P_LIS1 FOR T_TB TO TB+N DO [$T_$P;P_P+1] !MOVE LINE IF LIS #3 THEN[$([P_TB+1]+1)_DST;\IF FACK FILE REPLACE NAME $P_DST;$TB_DST]! WITH "******" WRIT ! WRITE THE HEAD ! IF TYPF=D.BL THEN GOTO EOF !DONE IF HEAD ONLY SPACE !SPACE A LINE IF FTYP=6 THEN $(@IDCB1+2)_1 !FOURCE TYPE 6 TO ONE RC_1 NEXT: P_BF !INITILIZE BUFFER POINTER SETA(R.E) ! SET UP SETA(C.NO) ! REC# XXXXX SETA(20040K) P_P+2 CONV.(RC,$P,5)! SET NUMBER READF(IDCB1,.E.R ,LBF,128,L) ! REARD RECORD IF .E.R = -12 THEN GO TO EOF !IF EOF-GO EXIT JER. !CHECK FOR ERRORS IF L <0 THEN GO TO EOF !SOFT EOF? N_L+3 IF TYPF=S.BL THEN[CONV.(RC,LNNO,4);BLWD_20040K;\ L_0;GO TO WRTIT]!JUST LISTING - GO WRIT ! SPACE !SPACE A LINE N_5 !WRITE THE RECORD NUMBER WRIT ! SPACE !SPACE A LINE ! F_@LBF !SET BUFFER POINTER NEXTL:IFNOT L THEN [RC_RC+1;GO TO NEXT] !IF NO DATA GET NEXT P_[ST_[WP,T_TB]+27]+1 !INITILIZE POINTERS REPEAT 36 TIMES DO[ $T_20040K; T_T+1] UP_ -1 !SET UPPER FLAG TRUE REPEAT 8 TIMES DO THRU PTSTP IF[T2_ [T_$F]AND 77400K]>57400K THEN GOTO BLANK IF T2>17777K THEN GOTO OKUP ! BLANK:T_ (T AND 177K)+20000K ! OKUP: IF [T2_($F AND 177K)]<140K THEN[IF T2> 37K THEN\ GO TO OKLOW] ! T_ (T AND 77400K) +40K ! OKLOW:DO[ $P_T AND 77577K;P_P+1] ! T2_ [T_$F-<1] AND 1 ! $WP_[IF UP THEN (T2-<8)+([T_T-<3] AND 7)+30060K,\ ELSE T2 + 20060K] ! REPEAT 2 TIMES DO[ \ $[WP_WP+1]_(([T_T-<3] AND 7)-<8)+\ ([T_T-<3] AND 7)+ 30060K] ! IF UP THEN GOTO PTSTP ! $[WP_WP+1]_(((T-<3) AND 7)-<8)+30040K ! PTSTP:DO[WP_WP+1;UP_NOT UP;F_F+1;IFNOT [L_L-1] THEN\ GO TO PREPR] ! ! PREPR:IF $[P_P-1]=20040K THEN GO TO PREPR !FIND LAST !NON BLANK N_ P-TB+1 !PRINT LENGTH ! $ST_ $ST +12K !SET THE STAR SEPERATOR ! WRTIT:WRIT !TRANSMIT THE LINE ! GOTO NEXTL !GO DO NEXT LINE ! EOF: WRITF(IDCB2,.E.R ,$BF,-1) !WRITE EOF JER. RETURN END ! ! SETA: SUBROUTINE(PRA)DIRECT !STEP P AND SET PRA IN P INDIRECT $[P_P+1]_PRA RETURN END ! ! WRIT: SUBROUTINE DIRECT!WRITE ON IDCB2 BUFFER AT BF IF LP !OR TB IF NOT LP WITH LWENGTH N+LP !IF TTY -LIMIT LENGTH TO 72. IF TTY THEN[IF N>36 THEN N_36] WRITF(IDCB2,.E.R ,$(TB-LP),N+LP) JER. RETURN END ! ! SPACE:SUBROUTINE DIRECT !SPACE THE LIST DEVICE N_1 !SET LENGTH TO ONE WORD DO[T_$TB;$TB_ 20040K]!SET BLANK IN BUFFER WRIT !WRIT BLANK LINE $TB_T !RESTORE OLD CONTENTS RETURN !RETURN END END END$    92064-18153 1650 S C0122 &STDUF RTE-M FLPY STORE-DUMP SUB.             H0101 USPL,L,O,M,C ! NAME: ST.DU ! SOURCE: 92064-18153 ! RELOC: 92064-16055 ! PGMR: G.A.A. ! MOD: G.L.M. ! ! *************************************************************** ! * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * ! * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * ! * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* ! * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ! *************************************************************** ! ! NAME ST.DU(7) " 92064-16055 REV.1650 761029" ! ! THIS IS THE RTE FMP FMGR ROUTINE TO STORE ! AND DUMP FILES. ! ! DU,NAME,LU,OP1,OP2,OP3 ! ! O R ! ! ST,LU,NAME,OP1,OP2,OP3,OP4 ! ! ! W H E R E: ! ! ST IS STORE. ! DU IS DUMP. ! ! NAME ! NAME IS THE FILE TO BE STORED OR DUMPED. ! ! LU IS EITHER THE SOURCE OR DESTINATION ! DEVICE AND MAY BE A FILE REFERENCE. ! ! OP1 IS A MEDIUM ASC CODE AS FOLLOWS: ! AS ASCII DATA ! BR BINARY RELOCATABLE DATA ! BA BINARY ABSOLUTE DATA ! MT MAG TAPE NORMAL FORMAT ! MS MAG TAPE SIO FORMAT ! ! OP2 IS AN END OF FILE OPTION ! FLAG -- TWO ASC CHARACTERS: ! SA SAVE END OF FILES IN THE ! NEW FILE. ! IN INHIBIT ALL LEADER, TRAILER, ! END OF FILE TRANSFERS; ! DOES NOT APPLY TO FINAL ! EOF ON A DISC FILE. ! ! OP3 IS THE NUMBER OF THE FIRST FILE ! TO BE TRANSFERRED (APPLIES TO ! FILES OF TYPE ZERO) (DEFAULT=1) ! ! OP4 IS THE NUMBER OF FILES TO BE ! TRANSFERRED (APPLIES TO FILES ! B OF TYPE ZERO) (DEFAULT= ) ! ! N O T E: OP3 AND OP4 ARE RELATIVE TO CURRENT POSITION. ! ! DEFINE EXTERNALS ! LET IDCB1,IDCB2,BUF. BE INTEGER,EXTERNAL ! LET N.OPL,.E.R BE INTEGER,EXTERNAL ! LET CREA.,OPEN.,LOCF,\ EXEC,READF,WRITF,\ MSS.,RWNDF,\ CK.SM,CLOSE BE SUBROUTINE,EXTERNAL LET IER. BE SUBROUTINE,EXTERNAL,DIRECT ! LET IFBRK BE FUNCTION,EXTERNAL ! LET DU..,ST.. BE SUBROUTINE ! LET AS BE CONSTANT (40523K) LET BR BE CONSTANT (41122K) LET BN BE CONSTANT (41116K) LET BA BE CONSTANT (41101K) LET MT BE CONSTANT (46524K) LET MS BE CONSTANT (46523K) LET IH BE CONSTANT (44510K) LET SA BE CONSTANT (51501K) ! ST..: SUBROUTINE(NPD,LISTO,ERD) GLOBAL ERD_ -1 !SET DUMP FLAG DU..(NPD,LISTO,ERD) RETURN END ! DU..: SUBROUTINE(NPS,LISTS,ERS) GLOBAL LI12_[LIS8_[LIS4_@LISTS+4]+4]+4 ! LIS21_[LIS17_[LIS13_[LIS9_[LIS5_[LIS1_\ @LISTS+1]+4]+4]+4]+4]+4 ! ! PRESET DEFAULT OPTIONS ! OBUF,SPDCB_@IDCB2 !SET DCB ADDRESS FOR SPACING IBUF_@IDCB1 !SET INPUT DCB ADDRESS BUFF,BUFA,BF_@BUF. DO[F1,SIOI,EOFF,CK,SIO,FLG,LDR_0] DO[SUBF_400K;F2,TYP,DUMP_1] IFNOT ERS+1 THEN [ERS,DUMP_0;SPDCB_IBUF] !SET STORE OPTIONS IF NPS<2 THEN [ERS_55;RETURN] DT_3 !SET DEFAULT TYPE ! ! ANALYZE OPTIONS ! ! FIRST THE TYPE FLAG ! IFNOT $LIS8 THEN GO TO ST3 !OPTION IS NULL GO TO CHECK NEXT IF $LIS9 = MS THEN [SIO_1;BUFA_BF+1;\ LIS9_LIS9+1] IF $LIS9=" " THEN GO TO ST3 IF $LIS9 = AS THEN [SUBF_410K;GO TO ST3] IF $LIS9 = BR THEN[CK,SUBF_310K;\ DT_5; GO TO ST3] IF $LIS9 = BN THEN[SUBF_310K; \ 8 GO TO ST3] IF $LIS9 = BA THEN[CK,SUBF_2310K;TYP_0;\ DT_7;GO TO ST3] IF $LIS9 = MT THEN GO TO ST3 IF $LIS9 = SA THEN[EOFF_1;GO TO ST2] IF $LIS9 = IH THEN[LDR_20000K;GO TO ST2] ! STER1:DO[ERS_56; RETURN] ! ! CHECK FOR OP2 ! ST3: IF $LI12#3 THEN GO TO ST2 ! IF $LIS13 = SA THEN[EOFF_1;GO TO ST5] IF $LIS13 = IH THEN[LDR_20000K;GO TO ST5] ! GO TO STER1 !ILLEGAL OPTION ! OPT2 WAS FOUND IN OP1 LOCATION SO ! ADJUST ADDRESSES AND SKIP ! OPT2 CHECK. ! ! ST2: DO[LIS21_[LIS17_LIS13]+4] ST5: OPEN.(IDCB1,$LIS1,N.OPL ,SUBF+1) LOCF(IDCB1,.E.R ,ID,ID,ID,ISZ,ILU,INTY,ISZ2) IER. IF $LIS17>0 THEN F1_$LIS17-1 IF $LIS21>0 THEN F2_$LIS21, ELSE \ [IFNOT $LIS21 THEN [IF$LIS17>0 THEN GOTO ST6,ELSE[\ IF INTY THEN F2_9999]]] ! ST6: SUBF_(SUBF AND 100K)+LDR \SET OUTPUT FUNCTION OR[IF (INTY AND 177775K)=5 THEN 100K,ELSE 0] IF $LIS9=AS THEN SUBF_SUBF AND 177677K ! IF A STORE OPERATION CREAT THE FILE ! SZ1_[SZ_[TY_[OPLS_@N.OPL+5]+2]+1]+1 ! IFNOT ERS+2 THEN[ERS_0;GO TO ST12] !COPY CALL THE FILE IS OPEN IF DUMP THEN GO TO ST10 ! ! SET DEFAULTS ! IFNOT $TY THEN $TY_[IF INTY THEN INTY,\ ELSE DT] IFNOT $SZ THEN $SZ_[IF INTY THEN ISZ->1,\ ELSE 15 ] !NOTE THIS DEFAULT !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! IFNOT $SZ1 THEN[IF INTY THEN $SZ1_ISZ2] ! ! CREAT THE FILE ! CREA.(IDCB2,$LIS5,$OPLS)?[GO TO ST10] GO TO ST12 ST10: OPEN.(IDCB2,$LIS5,$OPLS,SUBF) ST12: LOCF(IDCB2,.E.R ,ID,ID,ID,ISZ,OLU,OUTY) IER. IF INTY=6 THEN $(IBUF+2),INTY_1 IF OUTY=6 THEN $(OBUF+2),OUTY_1 ! ! BOTH IN AND OUT ARE OPEN -- ! LEADER HAS BEEN PUNCHED IF NOT SUPPRESSED. ! ! IF SIO STORE THEN SET IT UP C5! IF SIO THEN [IFNOT DUMP THEN[\ SIO_0; SIOI_1;BUFF_[BUFA_BF]+1]] ! UNTIL F1=0 DO[READF($SPDCB,.E.R ,$BUFA,128,ALN);IER.;\ IF ALN<1 THEN[F1_F1- 1; IF IFBRK() THEN GO TO BRK]] ST15: READF(IDCB1,.E.R ,$BUFA,128,ALN) IF IFBRK() THEN[\ IF BREAK THEN BRK: MSS.(0);GO TO KILL] ! SEND BREAK ERROR AND GO FLUSH THE FILE IF .E.R = -12 THEN [ALN_ -1;GO TO ST16] IER. IF ALN>0 THEN GO TO ST20 ! DATA? ! ! NO DATA -- EITHER EOF OR ZERO REG ! ! ! END OF XFER? ! ST16: IFNOT ALN+1 THEN[IF INTY THEN[F2_0;\ GO TO ST18]]!TRUE EOF-QUIT ! IF [F2_F2-1] THEN [IF EOFF THEN[ALN_-1;\ GO TO ST22],ELSE GO TO ST25] ST18: ALN_-1 IFNOT LDR THEN GO TO ST22 !IF INHIBIT NOT REQUESTED--EOF ! GO TO EXIT !DONE - NO EOF REQUIRED ! ST20: DO [IF SIOI THEN [ALN_[\ IF $BUFA<0 THEN-$BUFA,ELSE\ ($BUFA+1)>-1];ID_BUFA+1],ELSE\ ID_BUFA ;IF CK THEN[\ CK.SM($ID,TYP)?[GO TO ABO];ALN_($ID-<8)+(1-TYP)*3]] FLG_1 !SET FLAG TO SAY WE WROTE A RECORD ST22: IF ALN>0 THEN[IF SIO THEN[$BUFF_-ALN;ALN_ALN+1]],\ ELSE[IF F2 THEN[IF OUTY THEN ALN_0]] WRITF(IDCB2,.E.R ,$BUFF,ALN) IF .E.R = -6 THEN[MSS.(.E.R );GO TO KILL] IER. IF ALN= -1 THEN[IFNOT F2 THEN GOTO EXIT,\ ELSE GO TO ST25 ] IF ALN THEN GO TO ST15 ST25: EXEC (13, ILU,EQT5) IF(EQT5 AND 37400K)=400K THEN [MSS.(2006);\ EXEC(7)] GO TO ST15 ! ABO: MSS.(7) !SEND CHECK SUM ERROR KILL: ID_-1 !SET TO ABORT THE FILE ENDIT:IF DUMP THEN RETURN IFNOT OUTY THEN RETURN IF ID<0 THEN RWNDF(IDCB2) !REWIND TO BE SURE OF PURGE CLOSE(IDCB2,.E.R ,$SZ-ID-1) !CLOSE AND IER. RETURN ! EXIT: LOCF(IDCB2,.E.R ,T,ID) IER. IFNOT FLG THEN ID_-1 GO TO ENDIT END ! ! END END$ s   92064-18154 1650 S C0122 &CO..F RTE-M FLPY FMGR COPY SUB             H0101 TSPL,L,O,M,C ! NAME: CO.. ! SOURCE: 92064-18154 ! RELOC: 92064-16055 ! PGMR: G.A.A. ! MOD: G.L.M. ! ! *************************************************************** ! * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * ! * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * ! * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* ! * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ! *************************************************************** ! ! NAME CO..(7) " 92064-16055 REV.1650 760907" ! ! CO.. IS A MODULE OF THE RTE ! FMP PROGRAM FMGR. ! CO COPIES ALL DISC FILES ON ! ONE DISC TO SOME OTHER DISC. ! THE COMMAND IS: ! CO, CR, CR2 ! WHERE: ! CR IS THE FROM DISC ID ! CR2 IS THE TO DISC ID ! ! ! DEFINE EXTERNALS ! LET DR.RD, DU..,MSS.,IMESS,CREAT,CLOS.\ BE SUBROUTINE,EXTERNAL ! LET PK.DR,N.OPL, DS.LU BE INTEGER,EXTERNAL LET IDCB2 BE INTEGER ,EXTERNAL ! ! DEFINE LOCALS ! LET SETAD BE SUBROUTINE ! LET STLIS,FNAM(3),LTY,TNAM(3),\ OPLS, SACD, DM(14) BE INTEGER CO..: SUBROUTINE (N, LIS,ER) GLOBAL !SET UP DU.. CALL ARRAY FOR T _ @ STLIS TO @ STLIS+23 DO $T _0 LTY,STLIS,OPLS_3 !SET TYPE FLAGS ! SACD _ 51501K ! SAVE EOF MARKS ! LIS5 _ [LIS1 _ @ LIS+1]+4 ! ! SET UP THE OPTION LIST ADDRESSES ! OPS2_ [OPS1_[OPT2 _ [OPCR2_ [OPL_ [OPT1_ [\ OPCR1_ @N.OPL+1]+1]+3] \ + 1]+1]+1]+1 ! BLK_0 FOR T _ OPCR1 TO OPS2 DO $T _ 0 ! $ OPCR1 _ $ LIS1 $ OPCR2 _ $ LIS5 ADD_128 !SET UP ADDRESS INCREMENT ! DRBF _ @PK.DR ! SET PACK BUFADD. ! ! CHECK FOR LEGAL DISCS. ! IF $ LIS5 THEN [DR.RD(1,$LIS5,0)?[ \ GO TO NODES]   ; LU_$$@DS.LU\ ;GO TO INCK] ! NODES:DO[ER_21;RETURN]! NO DIS C EXIT ! INCK: IFNOT $LIS1 THEN GO TO NODES ! SETAD ? [GO TO NODES] IF LU = $$@ DS.LU THEN GO TO NODES ! ! BOTH DISCS ARE DEFINED AND ! SEPERATE ! ! START TRANSFER ! XFER: SETAD? [RETURN ] IF $PKD<0 THEN GO TO XFER ! IFNOT $PKD3 THEN GO TO XFER IF $PKD5 AND 177400K THEN GOTO XFER !SKIP EXTENTS IMESS (2, FNAM,3) ! SEND CURRENT NAME TO LOG CREAT(IDCB2,.E.R.,$PKD,$OPS1,$PKD3,$PKD8,$LIS5)! CREAT THE FILE IF .E.R.<0 THEN [MSS.(.E.R. );GO TO XFER] ERR_-2 !SET COPY CALL FLAG FOR DU ROUTINE DU..(4, STLIS,ERR) !CALL STORE TO TRANSFER ! IFNOT ERR THEN GO TO XFER ! ! BAD: MSS. (ERR) !PRINT MESSAGE ! ! ER _ 22 RETURN END ! ! SETAD:SUBROUTINE FEXIT ! READ DIRECTORY ! AND SET UP ST CALL ! IF ADD = 128 THEN [ \ DR.RD (1,$LIS1,BLK)?[FRETURN];\ ADD_ 0; BLK_ BLK+1] ! PKD8_[PKD7_[PKD6_[PKD5_[PKD3_[PKD2_[PKD_ \ DRBF+ADD]+2]+1]+2]+1]+1]+1 ! ADD_ ADD+16 !SET ADD FOR NEXT TIME IFNOT $PKD THEN FRETURN !END OF DIR. T1_@FNAM !SET TO MOVE T2_@ TNAM !NAME TO CALL FOR T _ PKD TO PKD2 DO[$T1,$T2_ $T;\ T1_T1 +1; T2_T2+1] ! N.OPL,$OPL_$PKD8 ! SET SECURITY CODES ! $OPT1,$OPT2_$PKD3 ! SET TYPES $OPS1_$PKD6/2 ! SET DEST SIZE $OPS2_$PKD7 ! SET DEST REC. SIZE RETURN ! DONE - RETURN END END END$ d   92064-18155 1650 S C0122 &LOCKF RTE-M FLPY FMGR DISK LOCK SUB             H0101 ASMB,R,L,C * NAME: LOCK. * SOURCE: 92064-18155 * RELOC: 92064-16055 * PGMR: G.A.A. * MOD: G.L.M * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM LOCK.,7 92064-16055 REV.1650 760826 * * * THIS ROUTINE OBTAINS A LOCK AND RELEASES IT ON THE * GIVEN DISC * ENT LOCK. EXT CLD.R,.P1,.P2,MSS.,DS.DF,DS.F1,.ENTR * * DSID NOP RQ NOP LOCK. NOP * JSB .ENTR DEF DSID * * SET UP CLD.R FOR CALL TO D.RFP * LDA RQ,I FETCH THE REQUEST CODE STA .P1 SET IT FOR CALL LDA DSID,I STA .P2 SET DISK ID JSB CLD.R * LDA B,I ANY ERRORS? SZA,RSS WELL? JMP OK NOPE --GO CLEAR A FLAG AND GET OUT * STA .P1 SAVE ERROR CODE JSB MSS. ISSUE ERROR DEF MRTN DEF .P1 CODE MRTN CCE SET UP A SPL FRETURN JMP LOCK.,I * * OK CLA,CLE CLEAR STA DS.DF CORE FLAGS--FORCE NEW READ STA DS.F1 JMP LOCK.,I E=0=GOOD RETURN * B EQU 1 END B  92064-18156 1650 S C0122 &MSC.F RTE-M FLPY FMGR SECURITY CHECK             H0101 iASMB,R,L,C * NAME: MSC. * SOURCE: 92064-18156 * RELOC: 92064-16055 * PGMR: G.L.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM MSC.,7 92064-16055 REV.1650 760928 * EXT $XECM,.ENTR ENT MSC. * * THIS ROUTINE CHECKS THE PASSED PARAMETER AGAINST THE * SYSTEM MASTER SECURITY CODE * * ON RETURN: A=1 IF GOOD * A=0 IF BAD * MSEC NOP MSC. NOP JSB .ENTR DEF MSEC LDB $XECM FETCH SYSTEM MASTER SECUTITY CODE ISZ MSEC SZB FORCE MATCH IF OLD CODE=0 CPB MSEC,I MATCH? CLA,INA,RSS YES--RETURN A=1 CLA NO--RETURN A=0 JMP MSC.,I EXIT END k  92064-18157 1650 S C0122 &CR..F RTE-M FLPY FMGR CREATE SUB             H0101 dSPL,L,O,M,C ! NAME: CR.. ! SOURCE: 92064-18157 ! RELOC: 92064-16055 ! PGMR: G.A.A. ! MOD: G.L.M. ! ! *************************************************************** ! * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * ! * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * ! * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* ! * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ! *************************************************************** ! ! NAME CR..(7) " 92064-16055 REV.1650 761021" ! ! THIS MODULE OF THE RTE FMP ! ROUTINE F M G R CREATES EMPTY ! FILES, IT ALSO CREATS TYPE ! ZERO FILES. ! COMMANDS THIS ROUTINE HANDLES ! ARE: ! CR,NAMR ! WHERE ! NAMR IS A NAME REFERENCE ! WHICH INCLUDES ! SC SECURITY CODE ! CR CARTRIDGE ID ! TY TYPE ! SZ 1 SIZE (NO. OF BLOCKS) ! SZ 2 RECORD SIZE (ONLY IF TY=2) ! OR ! CR,NAMR,LU,RWOP,SPOP,EOFOP, SUBFUN OP ! WHERE : ! NAMR IS AS ABOVE EXCEPT ! TY=0 ! (IN THIS CASE CR IS FORCED TO-2) ! LU IS THE DEVICE LOGICAL UNIT ! RWOP IS THE READ WRITE OPTION ! I.E. "READ", "WRITE", "BOTH" ! SPOP IS THE SPACING OPTION ! I.E. " BSPACF", "FSPACE", "BOTH" ! EOF IS THE END OF FILE OPTION ! I.E. "EOF","LEADER","PAGE", ! NUMERIC SUB FUNCTION. ! SUBFUNOP IS THE READ/WRITE ! SUB FUNCTION ! (I.E. "BINARY","ASCII",NUMERIC ! SUBFUNCTION. ! DEFINE EXTERNALS ! LET CREA.,NAM..,EXEC, \ RWNDF,WRITF, IER.,\ OPEN.,LOCK.,D.RIO,MVW,RMPAR,MSS.\ BE SUBROUTINE,EXTERNAL ! LET CLD.R BE SUBROUTINE,EXTERNAL,DIRECT LET FM.AB BE LAB:EL,EXTERNAL ! ! LET N.OPL,IDCB1,.E.R,.P1,.P2,.P3,.P4,.P5,\ D.SDR BE INTEGER,EXTERNAL ! DEFINE LOCAL SUBS. ! LET CR.. BE SUBROUTINE ! ! DEFINE TYPE ZERO NAME BLOCK ! LET NAM,NAM1,NAM2,LUC,\ EF,SP ,RW,SC(8) BE INTEGER ! ! DEFINE CONSTANTS ! LET XEQT BE CONSTANT (1717K) LET EOF BE CONSTANT (42517K) LET LE BE CONSTANT (46105K) LET PA BE CONSTANT (50101K) LET AS BE CONSTANT (40523K) LET BI BE CONSTANT (41111K) LET RE BE CONSTANT (51105K) LET WR BE CONSTANT (53522K) LET BO BE CONSTANT (41117K) LET BS BE CONSTANT (41123K) LET FS BE CONSTANT (43123K) ! LET READI BE CONSTANT (1) LET WRITI BE CONSTANT (2) LET A BE CONSTANT (0) LET B BE CONSTANT (1) ! CR..: SUBROUTINE(NO,LIS, ER) GLOBAL TY_@N.OPL+2 ! DCB9_[DCB4_[R3_[R2_[DCB_@IDCB1]+1]+1]+2]+5 ! LIS21_[LIS20_[LIS17_[LIS16_[LIS13_[LIS9_[\ LIS5_[LIS1_@LIS+1]+4]+4]+4]+3]+1]+\ 3]+1 ! ADD_128 BLK,RW,SP, EF_0 !INITILIZE FLAGES ! FOR T_@NAM TO @NAM+14 DO $T_0 !CLEAR TYPE 0 NAME BLOCK IF $TY THEN [CREA.(IDCB1, $LIS1,N.OPL)?[\ ER_-15];RETURN] ! ! IF $LIS5 >20000K THEN GO TO ILLU IF $LIS5<1 THEN GO TO ILLU OPEN. (IDCB1,$LIS5,N.OPL,20000K)!SET DEFAULT EOF !AND INHIBIT LEADER IF PUNCH ! $DCB9_0 !ALSO PREVENT TRAILER ON CLOSE IFNOT $LIS9 THEN GO TO MISPM ! SET R/W CODE IF $LIS9 = RE THEN RW_100000K IF $LIS9 = WR THEN RW_1 IF $LIS9 = BO THEN RW_100001K IFNOT RW THEN GO TO ILLPM ! SET SPACING CODE IFNOT $LIS13 THEN GO TO EOFCD IF $LIS13= BS THEN SP_100000K a IF $LIS13 = FS THEN SP_1 IF $LIS13=BO THEN SP_100001K IFNOT SP THEN GOTO ILLPM !BAD SP COMMAND ! SET EOF CODE (DEFAULT -FMGR DEFAULT) ! EOFCD:IF $LIS17=EOF THEN EF_100K IF $LIS17=PA THEN EF_1100K IF $LIS17=LE THEN EF_1000K IF $LIS16<3 THEN EF_($LIS17 AND 37K)-<6 IFNOT $LIS16 THEN EF_$DCB4 IFNOT EF THEN GO TO ILLPM ! ! SET SUB FUNCTION (DEFAULT 00=ASCII ! IFNOT $LIS20 THEN GO TO SETUP IF $LIS20<3 THEN LUC_($LIS21 AND 37K)-<6 IF $LIS21 = BI THEN LUC_100K IF $LIS21=AS THEN GO TO SETUP IFNOT LUC THEN GO TO ILLPM !IF GIVEN AND NOT SET ERROR ! SETUP: LUC_ LUC+[T_($ LIS5 AND 77K)] EF_EF OR T SC(1)_N.OPL !SET SECURITY CODE NAM.. ($LIS1) AREG_$0 IF AREG THEN GO TO ILNAM ! ! ! D.RIO(READI) !GET CURRENT COPY OF MASTER DIRECTORY IFNOT [LULK_-D.SDR] THEN \ !IF NOTHING MOUNTED [ER_-6;RETURN] !GIVE ERROR AND EXIT ! ! LOCK.(LULK,3)?[RETURN] ! LOCK THE DISC ! ! ! .P1_1 !SET FUNCTION CODE .P2_LULK !SET THE NEG DISK LU .P3_$LIS1 !SET 1ST 2 CHAR OF NAME .P4_$(LIS1+1) !NEXT TWO .P5_$(LIS1+2) !LAST TWO ! ASSEMBLE "CLA SET TYPE=0" ASSEMBLE "CLB SET SIZE=0" ! ! ! CLD.R !CALL D.RFP TO ASSIGN A DIR ENT ! RMPAR(IDCB1) !FETCH RETURN PARMS IF [ER_IDCB1] THEN RETURN !EXIT IF ERROR TR_(($R2 AND 177700K) -> 6) !ISOLATE TRACK SECT_ $R3 AND 377K ! SECTOR AND OFFSET_ (($R3 AND 177400K)->8) !OFFSET OF DIR ENTRY ! ! EXEC(READI,D.SDR,IDCB1,128,TR,SECT) !READ THE BLOCK IF $B # 128 THEN [MSS.(1, D.SDR);GOTO FM.AB] ! ! ! OFFSET_@IDCB1+OFFSET+4 !SET ADDRESS OF LU WORD MVW(@LUC, OFFSET,12) EXEC(WRITI,D.SDR,IDCB1,128,TR,SECT) !WRITE NEW BLOCK ! ! LOCK.(LULK,5) IDCB1_0 !CLEAR FIRST WORD FOR CLOSE RETURN ! ILLU: DO[ ER_ 20 ; RETURN] MISPM:DO[ ER_ 55 ; RETURN] ILLPM:DO[ ER_ 56 ; RETURN] ILNAM:DO[ ER_-15 ; RETURN] ! END END END$ &  92064-18158 1805 S C0122 &PK..F RTE-M FLPY FMGR PACK SUBTINE             H0101 ASPL,L,O,M,C ! NAME: PK.. ! SOURCE: 92064-18158 ! RELOC: 92064-16055 ! PGMR: G.A.A. ! MOD: G.L.M. ! ! *************************************************************** ! * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * ! * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * ! * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* ! * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ! *************************************************************** ! ! NAME PK..(7) " 92064-16055 REV.1805 771018" ! ! MODIFIED 750416 TO NOT MOVE EXTENTS IF THEY ALREADY RESIDE AT ! THE DESTINATION AND ALSO TO CORRECTLY HANDLE FILES TO 32K SECTORS ! PK.. IS THE PACKING ROUTINE FOR THE ! RTE FMGR PROGRAM. ! ! IT PACKS RTE FILES AS FOLLOWS: ! ! ! 1. EACH FILE IS MOVED DOWN (IF NECESSARY). ! AFTER EACH FILE IS MOVED ITS DIRECTORY ! ENTRY IS UPDATED. ! (THUS NO MORE THAN ONE FILE IS ! LOST BY A CRASH.) ! ! 2. AFTER ALL FILES ARE MOVED A NEW DIRECTORY ! IS CREATED PACKING OUT ALL THE PURGED ! ENTRIES AND THIS IS WRITTEN ON THE DISC DIRECTLY AFTER ! REQUESTING A LOCK VIA D.RFP ! ! THIS ROUTINE IS ENTERED BY THE COMMAND: ! ! PK,CR ! ! WHERE CR IS OPTIONAL AND RESTRICTS ! THE PACK TO DISC CR. ! ! DECLARE EXTERNALS ! LET D.RIO,DR.RD,LOCK.,MSS.,\ EXEC,READF, \ WRITF,RWNDF,MVW,LIMEM \ BE SUBROUTINE,EXTERNAL ! LET IER.,JER.,CLD.R BE SUBROUTINE,EXTERNAL,DIRECT ! ! LET D.SDR,PK.DR,DS.LU,IDCB1,IDCB2,\ .E.R,.P1,.P2,.P3,.P4,.P5 BE INTEGER,EXTERNAL ! ! DECLARE INTERNAL SUBROUTINES ! LET SETAD,BADTR\ BE SUBROUTINE ! ! DECLARE ARRAYS ! LET BTL(6) BE INTEGER ! ! DECLARE CONSTANTS ! LET READI BE CONSTjANT( 1) LET WRIT BE CONSTANT( 2) LET XEQT BE CONSTANT(1717K) LET KEYWD BE CONSTANT(1657K) LET A BE CONSTANT( 3 ) LET B BE CONSTANT( 1 ) ! ! PK..: SUBROUTINE(N,LIS,ER) GLOBAL !ENTRY POINT PACK_$(@LIS+1) !GET THE PACK LUPT_@D.SDR PAKAD_@PK.DR !SET DIRECTORY ADD. CALL LIMEM(1,FWAM,WRDS) !SEE IF ANY MEMORY AVAIL. WRDS_WRDS AND 77600K !FULL SECTOR BOUNDS PK1: D.RIO(READI) ! AGAIN:DIS_[IF PACK THEN PACK,ELSE -$LUPT] IFNOT DIS THEN [CALL LIMEM(-1);\ !END OF DISC DIRECTORY RETURN] !RETURN MEMORY AND EXIT CALL JER. !CHECK FOR BREAK LOCK.(DIS,3)?[MSS.(DIS);GO TO NXDIS] ! DR.RD(READI,DIS,0)?[ER_54;RETURN] ! FILCO_0 SETAD LU_$$@DS.LU ! ! SET UP DCBS FOR PACKING ! DCB5_[NXSEC_[NXTR_[DCB2_[\ DCB_@IDCB1]+2]+1]+1]+1 DCB21_[DCB20_[DCB19_[OBUF_[DCB9_[DCB8_[DCB7_[DCB6_ \ DCB5+1]+1]+1]+1]+7]+3]+1]+1 TBUF_DCB+32 IDCB1_0 MVW(@IDCB1,@IDCB1+1,31) $DCB_LU $DCB2_1 $DCB6_128 !SET RECORD SIZE $DCB7_100200K !SECURITY FLAG $DCB8_$PKD6 AND 377K !SET #SECT TRK $DCB9_$XEQT !AND OPEN FLAG FOR T_DCB TO DCB9 DO[T1_T+16;$T1_$T] ! ! THE DISC IS LOCKED AND WE MAY START ! PACKING - WE MUST HAVE A BUFFER ! AND ITS SIZE. IF LIMEM GOT MORE ! THAN 256 WORDS USE THAT MEMORY; ! ELSE USE IDCB1+32 (256 WDS) ! ! ! ! WRDS AND FWAM WERE SET UP BY CALL TO LIMEM UPON ENTRY ! ! IF WRDS>256 THEN [BUFAD_FWAM;LN_WRDS;\ GOTO PK5] !USE LARGER BUFFER FOR SPEED ! ! PK3: DO[LN_256;BUFAD_TBUF] PK5: SECSZ_LN-<10 !SET SECTOR COUNT. ! ! BUFFER AND LENGTH ARE SET NOW ! START TO PACK ! ! DO[$NXTR_$PKD4; FOR\  T_@BTL TO @BTL+5 DO[\ PKD9_PKD9+1; $T_$PKD9]] $NXSEC,BLK_0 NXBLK:DR.RD(READI,DIS,BLK)?[GO TO CLEAN] ! FILCO_0 ! NXFIL:SETAD?[GO TO WRBLK] ! ! IFNOT $PKD THEN GOTO CLEAN !END ! IF $PKD<0 THEN GOTO NXFIL !PURGED IFNOT $PKD3 THEN GOTO NXFIL !TYPE0 ! ! IF THE FILE CONTAINS A BAD TRACK ! PURGE IT AND CONTINUE ! BADTR($PKD4,[$DCB20_$PKD5 AND 377K],$PKD6)?[WRFL,$PKD_ -1;\ GO TO WRBLK] ! ! ! COMPUTE NEW LOCATION ! NEWLO:BADTR($NXTR,$NXSEC,$PKD6)?[\ $NXTR_$BT+1;$NXSEC_0;GO TO NEWLO] ! ! IF NEW LOCATION SAME AS OLD THEN ! GO TO NEXT FILE ! IF $NXTR=$PKD4 THEN [IF $NXSEC=$DCB20 THEN\ GO TO PK11] ! ! FAKE OPEN THE FILES ! WRFL,CO,$DCB5,$DCB21_$PKD6 !# OF SECTORS $DCB19_$PKD4 !START TRACK RWNDF(IDCB1,.E.R ) !SET REST OF DCB IER. RWNDF($OBUF,.E.R ) !FOR IN AND OUT IER. PK10: XFER_[IF CO>SECSZ THEN LN,ELSE CO-<6] READF($OBUF,.E.R ,$BUFAD,XFER) IER. WRITF(IDCB1,.E.R ,$BUFAD,XFER) IER. IF [CO_CO-(XFER-<10)] THEN GOTO PK10 DO[$PKD4_$NXTR;$PKD5_$NXSEC+($PKD5 AND 177400K)] PK11: DO[$NXTR_NTR;$NXSEC_NSEC]!UPDATE FOR NEXT FILE ! ! PONTERS ARE UPDATED ! ! FILE IS MOVED - UPDATE DIRECTORY ! THEN GO DO NEXT FILE. ! WRBLK:IF WRFL THEN[DR.RD(WRIT,DIS,BLK);WRFL_0] IF FILCO=128 THEN[BLK_BLK+1;GOTO NXBLK],ELSE\ GO TO NXFIL ! ! ! ASSEMBLE " SKP" ! ! ! ! ! CLEAN: TCNT,FCNT,FBLK,TBLK_0 !INITIALIZE POINTERS FBF_@PK.DR !SET ADDRESS OF DIR BUFFER TBF_@IDCB1 !SET ADDRESS OF OUT BUF ! TOP: DR.RD(READI,DIS,FBLK)?[GO TO EED]!READ DIRECTORY BLOCK !GO TO END IF LAST+1 ! IF FBLK THEN GO TO PCK !IF NOT FIRST--CONTINUE ! ! FILCO_0 ]  !CLEAR FILE COUNT FOR SETAD SETAD !THIS IS THE DIR ID $PKD9_$NXTR !SET NEXT TRACK $PKD5_$NXSEC !SET NEXT SECTOR GO TO MOK !MOVE THIS ENTRY ! ! ! ! PCK: IFNOT [T_$(FBF+FCNT)]THEN\ !GET OUT IF GO TO EED,\ !END OF DIRECTORY ELSE[IF T<0 THEN GO TO NEX ] !IF PURGED-TRY NEXT ONE ! MOK: MVW(FBF+FCNT,TBF+TCNT,16) !MOVE DIR ENTRY TO SAVE BUF ! IF [TCNT_TCNT+16]=128 THEN\ !BUMP OUT COUNT-IF FULL [TCNT_0;\ !RESET OUT COUNT DR.RD(-2,DIS,TBLK);\ !WRITE THE BLOCK TBLK_TBLK+1] !BUMP THE BLOCK CONUT ! NEX : IF [FCNT_FCNT+16]=128 THEN\ !BUMP IN COUNT-IF EMPTY [FCNT_0;FBLK_FBLK+1;GO TO TOP],\ !RESET IN COUNT ELSE GOTO PCK !BUMP BLOCK COUNT !GO READ NEXT BLOCK ! EED: $(TBF+TCNT)_0 !CLEAR "CURRENT" FW OF BUF T_(128-TCNT)-1 !CALCULATE # WORDS TO MOVE !TO CLEAR REST OF BUFFER ! MVW(TBF+TCNT,TBF+TCNT+1,T) !CLEAR REST OF BUFFER ! ! WIPE: CALL DR.RD(-2,DIS,TBLK) !WRITE IT OUT TBLK_TBLK+1 !BUMP BLOCK COUNT ! ! IFNOT FBLK < TBLK THEN [IFNOT TCNT\ !CLEAR REST OF DIRECTORY THEN GO TO WIPE,\ !CONT AT WIPE IF ELSE[\ !ELSE CLEAR FULL BUFFER TCNT_0;GO TO EED]] ! ! ! ! ! ! ! ! PK26: LOCK.(DIS,5) !UNLOCK DISC NXDIS: IDCB2_0 !CLEAR FW SO CLOSE WON'T !GET SCREWED UP IFNOT PACK THEN [LUPT_LUPT+4;GOTO AGAIN] CALL LIMEM(-1) RETURN END ! ! SETAD SETS THE ADDRESSES FOR THE NEXT FILES ENTRY ! IN PK.DR - IF NONE THEN AN FRETURN IS MADE. ! SETAD:SUBROUTINE FEXIT ! IF FILCO=128 THEN FRETURN PKD9_[PKD8_[PKD6_[PKD5_[PKD4_[PKD3_[PKD_\ PAKAD+FILCO]+3]+1]+1]+1]\ +2]+1 FILCO_FILCO+16 RETURN END ! ! BADTR RETURNS FALSE IF THE CURRENT FILE ! AREA CONTAINS A BAD TRACK. ! BADTR:SUBROUTINE(TRAK,SECT,NOSEC)FEXIT NTR_((SECT+NOSEC)->1)/($DCB8->1)+TRAK !COMPUTE (ROTATE TO AVOID NSEC_$B+$B !NEXT TRACK & SECTOR (32K SECTORS SIGN PROB.) ! CHECK EACH TRACK AGAINST THE BAD LIST. FOR T_TRAK TO[IF NSEC THEN 0,ELSE -1]\ + NTR DO[\ FOR BT_@BTL TO @BTL+5 DO[ \ IF $BT THEN[IF T=$BT THEN FRETURN]]] RETURN END END END$ ! -   92064-18159 1650 S C0122 &PU..F RTE-M FLPY FMGR PURGE SUB             H0101 C5SPL,L,O,M,C ! NAME: PU.. ! SOURCE: 92064-18159 ! RELOC: 92064-16055 ! PGMR: G.A.A. ! MOD: G.L.M. ! ! *************************************************************** ! * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * ! * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * ! * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* ! * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ! *************************************************************** ! ! NAME PU..(7) " 92064-16055 REV.1650 760923" ! ! ! PURGE FILE ROUTINE FOR THE RTE FILE MANAGER ! ! ENTERED AFTER A: ! ! PU,NAMR ! ! W H E R E: ! ! NAMR IS THE FILE'S NAMR WHICH CAN CONTAIN: ! ! CR (OPTIONAL) IS THE CARTRIDGE ID. ! ! SC (OPTIONAL) IS THE FILE SECURITY CODE. ! ! ! DEFINE EXTERNAL ADDRESSES ! LET .E.R ,IDCB1,N.OPL,PK.DR BE INTEGER,EXTERNAL ! LET LOCK.,PURGE,EXEC,MSS. \ BE SUBROUTINE,EXTERNAL LET IER. BE SUBROUTINE,EXTERNAL,DIRECT LET FM.AB BE LABEL,EXTERNAL ! ! LET PUIT BE SUBROUTINE,DIRECT LET WRIT BE CONSTANT (2) LET READI BE CONSTANT (1) PU..: SUBROUTINE(NCAM,PLIST,ER) GLOBAL ! ENTRY POINT ! LET NCAM,PLIST,ER BE INTEGER ! DO[T_@N.OPL+1;BLK_@PLIST+1] ! PUIT !GO PURGE IT ! ! IF .E.R = -16 THEN GO TO ZPURG ! IER. RETURN ! ZPURG:DCB2_[DCB1_@IDCB1]+1 !SET UP DIRECTORY ADDRESS WORDS ! LU_$DCB1 AND 77K !SAVE LU OF DISK LOCK.(-LU,3) !SET LOCK ON DISK PUIT !FORCE CURRENT DIR. ADDRESS !TO BE SET INTO DCB1&2 ! TR_(($DCB1 AND 177700K) ->eI   6) !ISOLATE TRACK SECT_$DCB2 AND 377K ! SECTOR OFFSET_(($DCB2 AND 177400K) -> 8) ! AND OFFSET OF DIR ENT ! ! EXEC(READI,LU,IDCB1,128,TR,SECT) !READ BLOCK HOLDING ENTRY IF $1 #128 THEN \ !MUST GET FULL BLOCK [MSS.(1,LU);GOTO FM.AB] $(DCB1+OFFSET)_-1 !SET THE ENTRY AS PURGED EXEC(WRIT,LU,IDCB1,128,TR,SECT) !WRITE IT BACK OUT ! IDCB1_0 !CLEAR FOR CLOSE LOCK.(-LU,5) !CLEAR THE LOCK RETURN END ! ! PUIT:SUBROUTINE DIRECT PURGE(IDCB1,.E.R,$BLK,N.OPL,$T) RETURN END END END$ !J   92064-18160 1650 S C0122 &CN..F RTE-M FLOPY FMGR NAME CHANGE SUB             H0101 1SPL,L,O,M,C ! NAME: CN.. ! SOURCE: 92064-18160 ! RELOC: 92064-16055 ! PGMR: G.A.A. ! MOD: G.L.M. ! ! *************************************************************** ! * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * ! * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * ! * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* ! * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ! *************************************************************** ! ! NAME CN..(7) " 92064-16055 REV.1650 761204" ! ! THE CN ROUTINE ALLOWS THE OPERATOR TO ! CHANGE FILE NAMES. ! ! COMMAND: ! ! CN,NAMR,NEWNAME ! ! WHERE NAMR IS THE FILES NAME REFERENCE ! INCLUDING SECURITY CODE AND ! CARTRIDGE ID IF APPROPIATE ! ! NEWNAME IS THE NEW FILE NAME ! ! ! DEFINE EXTERNAL ! LET .E.R ,IDCB1,N.OPL BE INTEGER,EXTERNAL LET NAMF BE SUBROUTINE,EXTERNAL LET IER.,CLO BE SUBROUTINE,EXTERNAL,DIRECT CN..: SUBROUTINE (N,LI,E) GLOBAL L5_[L1_@LI+1]+4 CLO(IDCB1) !GO CLOSE LIBRARY DCB NAMF(IDCB1,.E.R ,$L1,$L5,N.OPL,$(@N.OPL+1)) IER. RETURN END END END$ p  92064-18161 1650 S C0122 &CRE.F RTE-M FLPY FMGR CREATE CALL SUB             H0101 zSPL,L,O,M,C ! NAME: CREA. ! SOURCE: 92064-18161 ! RELOC: 92064-16055 ! PGMR: G.A.A. ! MOD: G.L.M. ! ! *************************************************************** ! * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * ! * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * ! * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* ! * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ! *************************************************************** ! ! NAME CREA.(7) " 92064-16055 REV.1650 760923" ! LET CREAT BE SUBROUTINE,EXTERNAL LET IER.,CLO BE SUBROUTINE,EXTERNAL,DIRECT LET .E.R BE INTEGER,EXTERNAL CREA.:SUBROUTINE(DCBR,LUR,PPLIS) GLOBAL,FEXIT CLO(DCBR) !CLOSE CURRENT FILE IF OPEN IF LUR <64 THEN FRETURN DCB3_[DCB2_[DCB1_@PPLIS+1]+1]+1 CREAT(DCBR,.E.R ,LUR,$DCB3,$DCB2,PPLIS,$DCB1) IER. $DCB3_.E.R >- 1 !SET ACTUAL SIZE FOR TRUNCATE OPTION RETURN END END END$ s$  92064-18162 1805 S C0122 &DL..F RTE-M FLOPY FMGR DIRECTORY LIST SUB             H0101 PSPL,L,O,M,C ! NAME: DL.. ! SOURCE: 92064-18162 ! RELOC: 92064-16055 ! PGMR: G.A.A. ! MOD: G.L.M. ! ! *************************************************************** ! * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * ! * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * ! * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* ! * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ! *************************************************************** ! ! NAME DL..(7) " 92064-16055 REV.1805 771025" ! ! ! RTE FMGR DIRECTORY LIST MODULE ! ! ENTERED ON COMMAND: ! ! DL,CR,MSC ! ! WHERE: ! CR IF GIVEN RESTRICTS THE LIST TO ! THE GIVEN CARTRIDE ! ! MSC IF GIVEN MUST BE THE MASTER ! SECURITY CODE AND CAUSES THE ! EXPANDED LIST FORMAT. (SEE BELOW) ! ! FORMATS: ! ! HEAD: ! !L1 CR=XXXXX !L2 ILAB=YYYYYY NXTR=XXXX NXSEC=XXX #SEC/TR=XXX ! LAST TR= XXXX #DR TR=XX ! ! ! ! WHERE: CR IS FOLLOWED BY THE CARTRIDGE ID NUMBER ! YYYYYY IS THE CARTRIDGE LABEL ! NXTR INDICATES THE NEXT TRACK ! NXSEC THE NEXT SECTOR ! #SEC/TR THE NO. OF SECTORS/TRACK ! LAST TR THE LAST TRACK AND ! #DR TR THE NUMBER OF DIRECTORY TRACKS ! ! STANDARD (MSC NOT SUPPLIED): !L3 NAME TYPE #BLKS/LU OPEN TO ! ! FOLLOWED BY THE DIRECTORY ENTRIES ! ! EXTENDED FORMAT (MSC SUPPLIED) ! NAME TYPE #BLKS/LU SCODE TRACK SEC OPEN TO ! ! ! IF THE LIST DEVICE IS A TTY (TYPE 00 OR 05) ! THE EXTENDED FORMAT MAY FOURCE TWO LINES ! (IF 7 PROGRMS HAVE THE FILE OPEN) ! IF A PROGRAM HAS A FILE OPEN EXCLUSIVELY ! A - (MINUS SIGN) WILL FOLLOW THE PROGRAMS NAME ! IF AN ENTRY IS FOR AN EXTENT A + (PLUS SIGN) ! WILL BE PRINTED IN THE OPEN TO FIELD ! FOLLOWED BY THE EXTENT 6NUMBER ! ! ! DEFINE EXTERNALS ! LET PK.DR,D.SDR,TMP.,IDCB2,.E.R ,\ BUF. BE INTEGER,EXTERNAL LET HEAD.(4),H1(2),H1.5,H2(4),H3,H4(4),H5,H6(5),H7,H8(6),H9,\ H10(4),H11 BE INTEGER LET HEA.1(15),HEA.2(24) BE INTEGER INITIALIZE HEAD.,H1,H1.5,H2,H3,H4,H5,H6,H7,H8,H9,H10,H11 TO \ " ILAB=YYYYYY NXTR=XXXX NXSEC=XXX #SEC/TR=XXX LAST TR= XX"\ ,"XX #DR TR=XX" INITIALIZE HEA.1 TO " NAME TYPE #BLKS/LU OPEN TO" INITIALIZE HEA.2 TO " NAME TYPE #BLKS/LU SCODE TRACK SEC ",\ "OPEN TO " ! LET MSC.,.TTY BE FUNCTION,EXTERNAL ! LET DR.RD,LOCF,WRITF,OPEN.,CONV.,D.RIO\ BE SUBROUTINE,EXTERNAL LET JER. BE SUBROUTINE,EXTERNAL,DIRECT ! ! DEFINE INTERNALS ! LET SETAD, WRIT, SPACE BE SUBROUTINE ! ! DEFINE CONSTANTS ! LET BLANK BE CONSTANT (20040K) LET C.R BE CONSTANT (41522K)!CR LET EQ.BL BE CONSTANT (36440K)!= LET MIN.B BE CONSTANT (26440K)!- LET PLS.B BE CONSTANT (25440K)!+ LET MIN BE CONSTANT ( 55K)! - ! ! DL..: SUBROUTINE(N,LIS,ER) GLOBAL EXEND_0 DL_$(@LIS+1) !SET DISC SPEC LUPT_@D.SDR !SET LU POINTER DO[T_ @LIS+4 ;IF $T THEN[IFNOT[\ !CHECK EXEND_MSC.($T)]THEN[ER_51;RETURN]]]!SECURITY D.RIO(1) AGAIN:DIS_[IF DL THEN DL,ELSE -$LUPT] !GET DISC ID IFNOT DIS THEN RETURN !END OF DIREC-DONE BLK,INDEX_0 T_ @TMP.+3 OPEN.(IDCB2,TMP.,$T,0) !OPEN LIST FILE LOCF(IDCB2,.E.R ,T,T,T,T,T2) !GET LIST LU TTY_[IF .TTY(T2) THEN 1, ELSE 0] !SET TTY FLAG TB_[BF_@BUF.]+1 $BF_BLANK NXBLK:DR.RD(1, DIS,BLK)?[IFNOT BLK THEN [ER_54;RETURN]\ ,ELSE GO TO CLEAN]!READ BLOCK NXFIL:SETAD?[INDEX_0;BLK_BLK+1;GO TO NXBLK] !SET ADDRESSES P_TB IF INDEX+BLK-16 THEN GO TO FILEP !NOT FIRST JUMP L $P_C.R !SET $(P+1) _EQ.BL !CR=XXXXX ! CONV.($PK3,$(P+3),5)!IN BUFFER ! WRIT($BF,4) !WRITE ON LIST UNIT CONV.($PK9,H3,4) !INSERT NEXT TRACK CONV.($PK5,H5,3) ! NEXT SECTOR $PK6_$PK6 AND 377K ! ISOLATE #SECTORS/TRACK CONV.($PK6,H7,3) ! #SECTORS/TRACK CONV.($PK7-$PK8-1,H9,4) ! LAST TRACK CONV.(-$PK8,H11,2) ! #DIRICTORY TRACKS FOR T6_@H1 TO @H1.5 DO[ $T6_$PK AND 77777K;\ PK_PK+1] WRIT(HEAD.,34) SPACE IF EXEND THEN WRIT(HEA.2,23) ,ELSE WRIT(HEA.1,14) SPACE !SPACE T6_[T5_[T4_[T3_TB+2]+3]+3]+2 !SET POINTERS GO TO NXFIL !START LIST ! FILEP:IF $PK<0 THEN GO TO NXFIL !PURGED ENTRY IFNOT $PK THEN GO TO CLEAN ! END OF DIRECTORY FOR T_TB TO TB+80 DO[$T_BLANK] !BLANK BUFFER FOR T_TB TO T3 DO [$T_$PK;PK_PK+1]!SET NAME CONV.($PK3,$T4,5) !SET TYPE IF $PK3 THEN GO TO NOT0 !IF TYPE ZERO CONV.($PK4 AND 77K,$T5,2) !CONVERT LU GO TO EXCK !ELSE NOT0: CONV.($PK6/2,$T5,5) !CONVERT BLOCK SIZE ! EXCK: IFNOT EXEND THEN GO TO NAMST !NOT EXTENDED JMP ! !SET NAME LIST ORGIN ! T6_[PK_[PK6_[T2_[P_TB+10]+2]+3]+2]+2 IF $PK8 <0 THEN [$P_MIN.B ;$PK8_-$PK8] CONV.($PK8,$T2,5) !SET SECURITY CODE IFNOT $PK3 THEN GO TO NAMST !IF TYPE ZERO CONV.($PK4,$PK6,4) !SKIP TRACK CONV.($PK5 AND 377K,$PK,3) !AND SECTOR NAMST:T2_T6 !SET WORKING ADDRESS ! IF $PK3 THEN [IF [T_($PK5 -<8)AND 377K] THEN[\ $T6_PLS.B ;CONV.(T,$(T6+1),3);GO TO PRT] ] ! REPEAT 7 TIMES DO THRU NAMSK NAMSK: IF $[PK8_PK8+1]THEN[\ P_($PK8 AND 77777K)+12;FOR T_P TO P+2\ DO[ $T2_$T ;T2_6_T2+1];T_T2-1; \ $T_($T AND 177400K)+[IF $PK8<0 THEN \ MIN,ELSE 40K]] PRT: P_TB+81 LNCK: IF $[P_P-1]=BLANK THEN GO TO LNCK L_P-TB+1 T_BF !SET BUFFER ADDRESS IF L>34 THEN[WRIT($BF,34);L_L-15;T_TB+14;\ FOR T6_T TO TB+33 DO $T6_BLANK] WRIT($T,L) ! WRITE THE LINE GO TO NXFIL ! CLEAN:WRITF(IDCB2,.E.R ,T,-1) !END FILE ! IFNOT DL THEN[LUPT_LUPT+4;GOTO AGAIN] ! RETURN END ! SETAD:SUBROUTINE FEXIT ! SET PACK DIRECTORY ENTRY ! ADDRESSES IF INDEX=128 THEN FRETURN !END BLOCK EXIT PK9_[PK8_[PK7_[PK6_[PK5_[PK4_[PK3_[PK_INDEX+@PK.DR]+\ 3]+1]+1]+1]+1]+1]+1 !SET THE ADDRESSES INDEX_INDEX+16 !STEP INDEX RETURN END ! ! WRIT: SUBROUTINE(BAD,NWORD) !WRITE N WORDS ON IDCB2 !IF NOT A TTY TWO BLANKS ARE WRITF(IDCB2,.E.R ,$(@BAD+TTY),NWORD+1-TTY)!ADDED JER. !AT THE RETURN !FRONT END ! SPACE:SUBROUTINE $TB_BLANK !SET A 1 WORD BLANK WRIT($BF,1) !WRITE IT RETURN !RETURN END ! END END$ SN  92064-18163 1650 S C0122 &CL..F RTE-M FLOPY FMGR CARTRIDGE LIST SUB             H0101 7SPL,L,O,M,C ! NAME: CL.. ! SOURCE: 92064-18163 ! RELOC: 92064-16055 ! PGMR: G.A.A. ! MOD: G.L.M. ! ! *************************************************************** ! * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * ! * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * ! * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* ! * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ! *************************************************************** ! ! NAME CL..(7) " 92064-16055 REV.1650 760923" ! ! DIBC DIRECTORY LIST ! ! ENTERED BY ! ! CL COMMAND ! ! ! ! DEFINE EXTERNALS ! ! LET OPEN.,WRITF,D.RIO,CONV.\ BE SUBROUTINE,EXTERNAL LET IER. BE SUBROUTINE,EXTERNAL,DIRECT ! LET D.SDR,IDCB2 BE INTEGER,EXTERNAL LET TMP.,.E.R ,BUF. BE INTEGER,EXTERNAL ! DEFINE CONSTANTS LET BLANK(14) BE INTEGER INITIALIZE BLANK TO " LU LAST TRACK CR LOCK" ! ! CL..: SUBROUTINE GLOBAL !NO PRAMETERS NEEDED T_@TMP.+3 OPEN.(IDCB2,TMP.,$T,0)! OPEN LIST FILE TB_@BUF.+1 BUF._BLANK(1) WRITF(IDCB2,.E.R ,BLANK,14) !WRITE THE HEAD IER. WRITF(IDCB2,.E.R ,BUF.,1) !SPACE A LINE IER. CALL D.RIO !READ THE DIRECTORY OF DISCS PN_[PCR_[PTR_ TB+ 4]+5]+2 TL_@D.SDR !SET ITS ADDRESS NEXT: IFNOT $TL THEN [WRITF(IDCB2,.E.R ,T,-1);IER.;\ RETURN] ! FOR T_ TB TO PN DO[$T_BLANK(1)] CONV.($TL,$TB ,2) CONV.($[TL_TL+1],$PTR,4) CONV.($[TL_TL+1],$PCR,5) IFNOT $[TL_TL+1] THEN [N_11;GO TO WRT] T_$TL +12 T2_[T1_PN+1]+1 $PN_$T $T1_$(T+1) $T2_($(T+2) AND 177400K) +40K N_15 ! WRT: WRITF(IDCB2,.E.R ,BUF.,N) IER. TL_TL+1 GO TO NEXT ! END END END$ q]     92064-18164 1650 S C0122 &FMCMF RTE-M FLPY FMGR CMND SUBS             H0101 2VSPL,L,O,M,C ! NAME: FM.CM ! SOURCE: 92064-18164 ! RELOC: 92064-16055 ! PGMR: G.A.A. ! MOD: G.L.M. ! ! *************************************************************** ! * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * ! * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * ! * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* ! * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ! *************************************************************** ! ! NAME FM.CM(7) " 92064-16055 REV.1650 761204" ! LET EXEC BE SUBROUTINE,EXTERNAL LET CLOSE,OPEN,MGLU BE SUBROUTINE,EXTERNAL LET OPEN. BE SUBROUTINE LET CLO BE SUBROUTINE,DIRECT LET IFBRK BE FUNCTION,EXTERNAL LET BUF.(129) BE INTEGER,GLOBAL LET MNAM(3) BE INTEGER LET JER.,CONV.,IER.,MVW BE SUBROUTINE LET .E.R BE INTEGER,GLOBAL LET ELOG.,AB.FM BE LABEL,EXTERNAL LET XEQT BE CONSTANT (1717K) LET A BE CONSTANT(0) LET B BE CONSTANT(1) ! OPEN.:SUBROUTINE(DCBRF,LURF,PLIS,OPLST) GLOBAL OPN3: CLO (DCBRF) !CLOSE THE OLD ONE IF LURF<20000K THEN [MGLU(LURF,MNAM);FAD_@MNAM],\ IF FILE THEN ELSE FAD_@LURF OPEN(DCBRF,.E.R ,$FAD,\ !IF FILE THEN (OPLST AND 37777K),\ PLIS,$(@PLIS+1));IF .E.R <0 THEN GO TO ELOG.,\ ELSE RETURN END ! ! ! CLO: SUBROUTINE(DCB)GLOBAL,DIRECT !CLOSE SUBROUTINE FOR INTERNAL WORK IFNOT (DCB = 177400K) THEN CLOSE(DCB,.E.R ) !IF NOT FAKE CLOSE $(@DCB+9)_0 !ELSE KILL THE OPEN FLAG RETURN END ! CONV.:SUBROUTINE (NOO,BUF,NDIG) GLOBAL ! ROUTINE TO CONVERT NO WITH NDIG DIGITS TO ASC ! A T BUF ! ! BUF WILL CONTAIN THE LOWEST DIGITS BUF-1 THE NEXT ! LOWEST ETC. ! EV,BF_@BUF NUM_NOO FOR I_1 TO NDIG DO THRU COV DO[NU  M_NUM/10;DI_$B+60K] $BF_[IF EV THEN ($BF AND 177400K)+DI,\ ELSE ($BF AND 377K)+(DI-<8)] COV: IF EV THEN EV_0, ELSE\ EV,BF_BF-1 RETURN END ! ! ! ! JER. SHOULD ONLY BE CALLED WHEN NO CLEAN UP IS REQUIRED ! AS IT EXITS TO AB.FM OR ELOG. ! JER.:SUBROUTINE GLOBAL,DIRECT IER. !GO CHECK FOR FMP ERROR .E.R_0 IF IFBRK THEN GO TO AB.FM RETURN END ! MVW:SUBROUTINE(FROM,TT,LENZ) GLOBAL ! ASSEMBLE " LDA FROM,I" ASSEMBLE " LDB TT,I" ASSEMBLE " EXT .MVW" ASSEMBLE " JSB .MVW" ASSEMBLE " DEF LENZ,I" ASSEMBLE " NOP " ! RETURN END ! ! ! IER.:SUBROUTINE GLOBAL,DIRECT IF .E.R=>0 THEN RETURN,\ ELSE GO TO ELOG. END ! ! ! ! END END$ x    92064-18165 1650 S C0122 &IN..F RTE-M FLOPY FLPY FMGR DISK INITIAL.SUB            H0101 |SPL,L,O,M,C ! NAME: IN.. ! SOURCE: 92064-18165 ! RELOC: 92064-16055 ! PGMR: G.A.A. ! MOD: G.L.M. ! ! *************************************************************** ! * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * ! * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * ! * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* ! * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ! *************************************************************** ! ! NAME IN..(7) " 92064-16055 REV.1650 761024" ! ! ! IN.. IS THE RTE FILE MANAGER ACTION ROUTINE ! FOR THE IN DIRECTIVE. ! ! THE IN DIRECTIVE HAS THE FORM: ! ! IN,MSC,CR,LABEL,ILAB,#FT,#DTR,#SEC/TR,BTL !PARAMETER 1 5 9 13 17 21 25 29 ! ! OR ! ! IN,MSC--NMSC ! ! W H E R E: ! ! MSC IS THE TWO CHARACTER MASTER SECURITY CODE ! ! CR IS EITHER THE CARTRIDGE LABEL(+) OR ITS ! LOGICAL UNIT(-) (MUST BE NUMERIC) ! ! LABEL IS THE NEW CARTRIDGE LABEL (MUST BE NUMERIC > 0). ! ! ILAB IS THE CARTRIDGE INFORMATION LABEL (MUST BE ASCII). ! ! #FT IS THE FIRST FMP TRACK. ! ! #DTR IS THE NUMBER OF DIRECTORY TRACK ! (NULL (SET TO 1) OR NUMERIC) ! ! #SEC/TR IS THE NUMBER OF 64 WORD SECTORS ! PER TRACK (NUMERIC (MAY BE NULL FOR LU2 AND 3)). ! ! BTL IS A BAD TRACK LIST - UP TO 6 BAD TRACK NUMBERS. ! ! NMSC IS A NEW MASTER SECURITY CODE. ! ! THE MASTER SECURITY CODE IS SET AT GENERATION ! AND MUST MATCH THEREAFTER. ! LET DR.RD,D.RIO,MSS.,NAM..,EXEC \ ,READF,WRITF,IMESS \ BE SUBROUTINE,EXTERNAL ! LET CLD.R BE SUBROUTINE,EXTERNAL,DIRECT LET PK.DR,D.SDR ,D.LT,D.LB,C.BUF, \ .P1,.P2,.P3,.P4, \ DS.LU BE INTEGER,EXTEưRNAL LET PTST BE SUBROUTINE LET LOCK.,MVW BE SUBROUTINE,EXTERNAL LET FID. BE FUNCTION,EXTERNAL LET MSC. BE FUNCTION,EXTERNAL ! ! ! ! DEFINE DUMMY LOCK FILE TO PROTECT TRACK 0 SECTOR 0 ! ! LET LK0(3),LK3,LK4,LK5,LK6,LK7,LK8 \ BE INTEGER ! ! INITIALIZE LK0 TO "FLOPLK" INITIALIZE LK3 TO 1 INITIALIZE LK4 TO 0 INITIALIZE LK5 TO 0 INITIALIZE LK6 TO 2 INITIALIZE LK7 TO 0 INITIALIZE LK8 TO -32767 ! ! ! ! CONSTANTS ! LET YE BE CONSTANT(54505K) LET NO BE CONSTANT(47117K) LET A BE CONSTANT(0 ) LET B BE CONSTANT(1 ) LET WRIT BE CONSTANT(2 ) LET READI BE CONSTANT(1 ) LET XEQT BE CONSTANT(1717K) LET DMSIN BE CONSTANT(26455K) IN..: SUBROUTINE(NCAM,PLIST,MSNO)GLOBAL LET NCAM,PLIST,MSNO BE INTEGER ! ! DDIR_@D.SDR PDIR2_[PDIR1_[PDIR_@PK.DR]+1]+1 PDIR9_[PDIR8_[PDIR7_[PDIR6_[PDIR5_[PDIR4_[PDIR3_\ PDIR2+1]+1]+1]+1]+1]+1]+1 LIS29_[LIS21_[LIS17_[LIS13_[LIST9_[LIST5_@PLIST+5]+4]+4]+4]+4]+8 MSNO_0! INITILIZE FOR NO ERRORS ! ! TEST FOR LEGAL PARAMETERS ! IF NCAM>3 THEN GO TO IN2 !IF MORE THAN 3 PARMS CONTINUE AT IN2 IF NCAM#1 THEN GOTO NOPRM !IF LESS THAN 3,MUST BE 1 ! MSC CHANGE? ! IFNOT MSC.(PLIST) THEN GOTO SCER ! IF $(@PLIST+2)#DMSIN THEN GOTO NOPRM ! T2_[IF([T_$(@PLIST+3)]AND 77400K)=20000K THEN 0,ELSE T] ! ! GO PRIV AND SET NEW MASTER SECURITY CODE ! ASSEMBLE " JSB .DRCT" ASSEMBLE " EXT $XECM" ASSEMBLE " DEF $XECM" ASSEMBLE " STA 1 SAVE ADDRESS IN B" ASSEMBLE " LDA DEFT2 FETCH ADDRESS OF WORD HOLDING NEW CODE" ASSEMBLE " EXT PMOVE" ASSEMBLE " JSB PMOVE" ASSEMBLE " OCT 1" RETURN !RE TURN ! ! DEFT2: ASSEMBLE " DEF T2" ! ! ! LABER:DO[MSNO_53;RETURN] ! NOPRM:DO[MSNO_50;RETURN] !NOT ENOUGH PRAMS - EXIT ! IN2: IFNOT MSC.(PLIST)THEN GO TO SCER !CHECK SECURITY ! ! CHECK LABEL PARAMETERS ! ! IN6: IFNOT -$LIST9<0 THEN GO TO LABER !LABEL MUST BE >0 ! IF $(@PLIST+12)#3 THEN GO TO LABER !MUST BE ASCII NAM..($(LIS13 )) !MUST BE VALID NAMR DO[AREG_$A; IF AREG THEN GO TO LABER] ! ! SET UP TO TEST THE REST OF THE PRAMS. ! FOR T_4 TO 13 DO[PTST($(@PLIST+T*4))] ! IFNOT$[T_(LIS21 )]THEN $T_1 !MUST HAVE DRTRK ! ! READ BLOCK ZERO ! IN7: DR.RD(READI,$LIST5 ,0)?[MSNO_54;RETURN] ! ! T_@PLIST+25 !SET NO OF SECTORS ADDRESS IFNOT $T THEN $T_60 !IF #SECT NOT GIVEN DEFAULT TO 60 !WILL NEED TO INCLUDE SECT SKIP HERE ! LTR_$$@D.LT NEW,TN_LTR-[FTR_$LIS17]+1 !SET FIRST TRACK,TOTAL NO. TRACKS IF TN<[ND_$LIS21 ]THEN GOTO BADPM ! IF ND>((TN-ND)>-3)+1 THEN GO TO BADPM !DISALLOW UNREASONABLE ! NUMBER OF DIRECTORY TRACKS ! ! CHECK THE BAD TRACKS AND ARRANGE IN ASCENDING ORDER ! LIS49_[T1_LIS29]+20 FOR T_LIS29 TO LIS49 BY 4 DO[\ IF $T THEN[$T1_$T;T1_T1+1]] FOR T_T1 TO LIS29+6 DO[$T_0] ! ZERO THE END OF THE LIST IN10: SWP,LAST_0 !INITILIZE THE SORT FOR T_LIS29 TO T1-1 DO[\ SWAP LOOP IF $T LTR-ND THEN GO TO BTER IN13: T3_$$@DS.LU !SET LU DLB_D.LB !SET THE LABEL ADDRESS ! IF $LIST9=$DLB THEN GO TO IN12!IS SAME LABEL SKIP ! ! CHECK FOR DUPLICATE LABEL ! DR.RD(READI,$LIST9,0)?[DR.RD(READI,$LIST5,0);GO TO IN1[.2] DO[MSNO_12;RETURN]!DUPLICATE LABEL ERROR RETURN ! ! ! ! GET DRIVER TYPE -- IF FLOPPY DRIVER WE MUST PROTECT TRACK ! ZERO SECTOR ZERO. ! IN12: CALL EXEC(13,T3,EQ5) !DO STATUS EQ5_EQ5 AND 37400K !ISOLATE DRIVER TYPE IF EQ5=15400K THEN FLPY_2, ELSE FLPY_0 ! IF [TX,NEW_FID. ($(LIST5 ))] THEN GO TO IN20 ! LOCK.($LIST5,3)?[RETURN] ! REQUEST LOCK/RETURN IF ERROR ! ! A DIRECTORY EXISTS - IS THE NEW PRAM SET ! COMPATIBLE? ! ! CALCULATE # BLOCKS IN DIRECTORY ! ENDBL_ -$PDIR8*($PDIR6 AND 377K)/2 ! IF FTR>$(PDIR4 ) THEN GOTO IN15 IF $(PDIR9 )>(LTR-ND+1)THEN GOTO IN15 IF ND+$PDIR8 <0 THEN GO TO IN15 !IF FEWER DIRECTORY TRACKS ASK. ! IF FLPY THEN[IFNOT FTR THEN [IF $PDIR4 \ !IF INIT DOWN THEN GOTO IN15]] !TO TRK 0 THEN ASK(ONLY IF FLOPPY) ! ! ! FULL SPEED AHEAD! IN20: FLCR_16 !OFFSET VALUE FOR DIR CLEAR $PDIR_$(LIS13 )+100000K !SET ID+SIGN BIT $(PDIR1 )_$(@PLIST+14) !SET LAST 2 WORDS OF ID $(PDIR2 )_$(@PLIST+15) $(PDIR3 )_$LIST9 !SET LABEL $(PDIR4 )_FTR !SET FIRST AVAIL TRK ! IFNOT NEW THEN GOTO IN21 !SKIP SETTING NXTRK AND SECT IF OLD !ALSO SKIP SECT/TRK INFO AS DIRECTORY !AND FILES ARE ALREADY WRITTEN ! ! ! ! ! ! SET FIRST TRACK (PDIR9) AND IF IT'S A FLOPPY ! AND FIRST TRACK=0 THEN SET FIRST SECTOR (PDIR5) ! TO 2 AND MOVE DUMMY FILE IN TO PROTECT TRK 0 SECT 0 ! ! $(PDIR9)_FTR $(PDIR5)_FLPY IFNOT FTR THEN [IF FLPY THEN \ !IF TRK=0 AND ITS A FLOPPY MVW(@LK0,PDIR+16,9);\ !THEN MOVE DUMMY ENTRY IN FLCR_25],\ ELSE $(PDIR5)_0 ! ! ! $(PDIR6 )_$(@PLIST+25) ! SET SKIP FACTOR\#SECT ! ! IN21: $(PDIR7 )_LTR-ND+1 !SET LOWEST DIRECTORY TRACK $(PDIR8 )_-ND !SET #DIRECTORY TRACKS ! ! SET BAD TRACKS ! FOR T_10 TO 15 DO $(PDIR+T)_$(@PLIST+T+19) ! ! IF NEW CLEAR REST OF DIRECTORY ! IF NEW THEN[FOR T_FLCR TO 127 DO $(PDIR+T)_0] BL_0 !SET THE BLOCK TO ZERO ! ! NOW WRITE IT OUT IN22: DR.RD(WRIT,$LIST5 ,BL)?[GO TO IN30] ! ! !CLEAR BUFFER ! FOR T_0 TO 127 DO $(PDIR+T)_0 IFNOT NEW THEN [BL,NEW_ENDBL;GOTO IN22]!SET TO ZERO ADDED DIRECTORY DO[BL_BL+1;GO TO IN22]!ZERO THE NEXT BLOCK ! ! ! SET UP FOR CALL TO D.RFP TO UPDATE THE DRN ! IN30: IF $LIST9=$DLB THEN GO TO EXNOW !SKIP UPDATE OF DRN IF SAME .P1_7 !SET FUNCTION CODE .P2_$LIST9 !SET THE LABEL .P3_ $$@DS.LU !SET THE LU ! ASSEMBLE " CCB SET THE SUBFUNCTION(P7) FOR DRN UPDATE" ! CALL CLD.R !CALL D.RFP ! ! IF DUP DRN THEN ERROR 12 WILL RETURN ! IN THIS CASE--THE DISK WILL HAVE BEEN INITIALIZED ! BUT THE MASTER DIRECTORY WILL NOT HAVE IT'S DRN ! THAT WORD WILL BE ZERO ! ! MSNO_$$B !SET THE ERROR CODE EXNOW: LOCK.($LIST9,5) !RELEASE LOCK RETURN !WE DID IT - EXIT ! IN15: MSS.(60);IMESS(2,35137K,1) ;\ SEND COLON PROMPT IMESS(1, C.BUF,36);LN_$1 !READ RESPONSE IF LN<1 THEN GOTO IN15 IF C.BUF=YE THEN[NEW_1; GO TO IN20], ELSE [ \ IF C.BUF=NO THEN GOTO IN30 ,\ ELSE GOTO IN15] ! BADPM:DO[MSNO_56;RETURN] ! MSPRM:DO[MSNO_55;RETURN] ! BTER: DO[MSNO_57;RETURN] SCER: MSNO_51 RETURN END PTST: SUBROUTINE(PTR) ! IF PTR=3 THEN GOTO BADPM !MUST NOT BE ASCII ! ! IF $(@PTR+1)<0 THEN GOTO BADPM !IF <0 - BAD NEWS ! RETURN !OK !RETURN ! END END ! END$ .$"$   92064-18166 1650 S C0122 &FID.F RTE-M FLPY FMGR DIRECT. CHK SUB             H0101 SPL,L,O,M,C ! NAME: FID. ! SOURCE: 92064-18166 ! RELOC: 92064-16055 ! PGMR: G.A.A. ! MOD: G.L.M. ! ! *************************************************************** ! * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * ! * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * ! * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* ! * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ! *************************************************************** ! ! NAME FID.(7) " 92064-16055 REV.1650 760824" ! LET DR.RD BE SUBROUTINE,EXTERNAL LET READI BE CONSTANT(1) LET PK.DR,D.LT BE INTEGER,EXTERNAL ! FID.: FUNCTION (DS)GLOBAL !RETURNS FALSE IF A FILE SYSTEM !EXIST ON DISC WITH ID !DS LET NAM.. BE SUBROUTINE,EXTERNAL DR.RD(READI,DS,0)?[GO TO RETF] !READ THE DIRECTORY ! PDIR8_[PDIR7_[PDIR6_[PDIR5_[PDIR3_[PDIR_@PK.DR]\ +3]+2]+1]+1]+1 DO[TX_$PDIR;$PDIR_TX AND 77777K] DO[NAM..(PK.DR);AREG_$0;$PDIR_TX]!CHECK ASC LABEL IF AREG THEN GOTO RETF !IF ILLEGAL OR FLAG IF TX>0 THEN GOTO RETF !NOT SET THEN NO FILE IF $(PDIR3 )<0 THEN GOTO RETF !IF LABEL WORD LESS THAN ZERO IF $(PDIR7 )-$(PDIR8 )-1 #$D.LT THEN GOTO RETF !LTR MAKE IF $(PDIR6 )<$(PDIR5 ) THEN GO TO RETF DO[FID.V_0; RETURN] RETF: DO[FID.V_1;RETURN] END ! END END$    92064-18167 1650 S C0122 &MC..F RTE-M FLPY FMGR MOUNT CART. SUB             H0101 SPL,L,O,M,C ! NAME: MC.. ! SOURCE: 92064-18167 ! RELOC: 92064-16055 ! PGMR: G.A.A. ! MOD: G.L.M. ! ! *************************************************************** ! * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * ! * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * ! * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* ! * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ! *************************************************************** ! ! NAME MC..(7) " 92064-16055 REV.1650 761029" ! ! MOUNT CARTRIDGE DIRECTIVE ! ROUTINE FOR RTE FILE ! MANAGER (FMGR). ! ! ENTERED ON COMMAND: ! ! MC,LU,LTR ! ! W H E R E: ! ! LU IS THE LOGICAL UNIT OF THE DISC TO BE MOUNTED. ! ! LTR IS THE LAST TRACK ON THE UNIT TO BE ! USED BY THE FILE MANAGER. ! MC..: SUBROUTINE(N,LIS,ER) GLOBAL !ENTRY ! ! DECLARE EXTERNALS ! LET DR.RD,D.RIO, EXEC \ BE SUBROUTINE,EXTERNAL LET CLD.R BE SUBROUTINE,EXTERNAL,DIRECT ! LET D.SDR,DS.F1,PK.DR,TBLEN,DS.DF, \ .P1,.P2,.P3,.P4,.P5 BE INTEGER,EXTERNAL ! LET FID. BE FUNCTION,EXTERNAL ! ! DECLARE CONSTANTS ! LET XEQT BE CONSTANT(1717K) LET B BE CONSTANT( 1) LET READI BE CONSTANT( 1) ! IFNOT [LU_$(@LIS+1)] THEN\ !BRING IN THE [ER_50;RETURN] LTR_$(@LIS+5) !PRAMS DS.F1_0 !INSURE A CLEAN READ IF LU>0 THEN LU_-LU NLU_-LU ! ! ATTEMPT READ OF BLOCK ZERO ! DR.RD(READI,LU,0)?[GO TO OK] ! MC00: ER_12 !SEND DUPLICATE LU GOTO CLEX ! OK: DSDR_@D.SDR ! ! SEARCH FOR ROOM ! FOR DLU_DSDR TO DSDR+TBLEN-4 BY 4 DO[\ IFNOT $DLU THEN GO TO MC01] ER_25 !OUT OF MASTER DIRECTORY SPACE RETURN !RETURN ! MC01: MXTR_0 5   EXEC(100015K,NLU,EQT5) GOTO BADLU IF(EQT5 AND 36000K)#14000K THEN[\ BADLU: ER_56; RETURN] !NO DISC-ERR. IF (EQT5 AND 37400K)#\ 14000K THEN[EXEC(2,NLU,1,1,10000,0);\ MXTR_$B-1],ELSE GOTO MC02 !IF NOT DVR30 FETCH MAX !TRACK IFNOT LTR THEN LTR_MXTR !IF LAST TRK NOT GIVEN USE MAX-1 IF LTR>MXTR THEN[ER_56;RETURN] !IF LAST TRACK>MAX TRACK-ERROR ! MC02: IFNOT LTR THEN[ER_55;RETURN] !IF DVR30--LAST TRK MUST BE GIVEN ! .P3,$DLU_NLU !SET UP DS.DF,.P4,$(DLU+1)_LTR ! FOR FID. AND D.RFP CALLS !AND PREVENT NEW READ OF CDIR IFNOT [NEW_FID.(LU)] THEN[\ .P5_$(@PK.DR+3); \ .P6_0; \ DR.RD(READI,.P5,0)?[GOTO MC04];\ GO TO MC00] ! DO [.P5_0;.P6_$XEQT;DS.F1_0] !SET LOCK IF NEW !AND PREVENT BAD PARMS FROM !BEING USED IN FM.UT ! ! ! MC04: .P1_7 .P2_ LU .P7_-2 ! ASSEMBLE " LDA .P6" ASSEMBLE " LDB .P7" CALL CLD.R ER_$$B CLEX: DS.DF,DS.F1_0 !FORCE CLEAN READ OF MASTER DIR. ! RETURN !DONE END END END$    92064-18168 1650 S C0122 &RC..F RTE-M FLPY FMGR REMOVE CART. SUB            H0101 sSPL,L,O,M,C ! NAME: RC.. ! SOURCE: 92064-18168 ! RELOC: 92064-16055 ! PGMR: G.A.A. ! MOD: G.L.M. ! ! *************************************************************** ! * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * ! * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * ! * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* ! * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ! *************************************************************** ! ! NAME RC..(7) " 92064-16055 REV.1650 760826" ! ! THIS IS THE REMOVE CARTRIDGE ROUTINE OF THE ! RTE FILE MANAGER PROGRAM FMGR. ! IT IS ENTERED AS A RESULT OF A ! ! RC,CR ! WHERE CR IS THE CARTRIDGE ID ! ! THE CARTRIDGE IS LOCKED IF IT HAS BEEN ! INITILIZED. ! ! THEN IT IS REMOVED FROM THE DIRECTORY OF DISCS. ! ! ! DECLARE EXTERNALS ! LET DR.RD, D.RIO, IMESS, \ LOCK., CONV. BE SUBROUTINE, EXTERNAL LET CLD.R BE SUBROUTINE,EXTERNAL,DIRECT ! LET FID. BE FUNCTION, EXTERNAL ! LET D.LT, DS.LU, D.SDR,DS.DF BE INTEGER, EXTERNAL LET .P1,.P2,.P3 BE INTEGER,EXTERNAL ! ! DECLARE CONSTANTS LET MSS(7),MS BE INTEGER INITIALIZE MSS TO "LAST TRACK " ! LET WRIT BE CONSTANT ( 2) LET READI BE CONSTANT ( 1) LET B BE CONSTANT ( 1 ) RC..: SUBROUTINE (N,LIS,ER) GLOBAL DIS_@LIS+1 !SET DISC SPEC ADDRESS IFNOT $DIS THEN [ER_55;RETURN] !NOT SPECIFIED ERROR DR.RD(READI,$DIS,0)?[ER_54; RETURN] !NOT MOUNTED IFNOT FID.($DIS) THEN LOCK.($DIS, 3)?[RETURN] ! LOCK HIM UP CONV. ($$@D.LT,MS,4) !SET LAST TRACK IN MESSAGE .P1_7 .P2_ - $$@DS.LU !SET LU FOR D.RFP .P3_0 ASSEMBLE "CLB CLEAR PARM 7(SUBFUNCTION)" CLD.R ! IF [ER_$$B] THEN RETURN !IF ERROR-SET C!  ODE AND GET OUT IMESS (2, MSS,8) ! SEND LAST TRACK TO LOG ! ! DS.DF,DS.F1_0 ! FORCE MASTER DIRECTORY TO BE CHECKED ! RETURN END END END$   92064-18169 1709 S C0122 &FMUTF RTE-M FLPY FMGR DISK UTIL. SUB             H0101 lSPL,L,O,M,C ! NAME: FM.UT ! SOURCE: 92064-18169 ! RELOC: 92064-16055 ! PGMR: G.A.A. ! MOD: G.L.M. ! ! *************************************************************** ! * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * ! * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * ! * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* ! * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ! *************************************************************** ! ! NAME FM.UT(7) " 92064-16055 REV.1709 770314" ! ! ! LET EXEC,MSS. BE SUBROUTINE,EXTERNAL LET IDCB1 BE INTEGER,EXTERNAL LET D.RIO,DR.RD BE SUBROUTINE LET FM.AB BE LABEL,EXTERNAL LET PK.DR BE INTEGER(128),GLOBAL LET D.SDR BE INTEGER(128),GLOBAL LET DS.LU,D.LT,D.LB,D.LK BE INTEGER,GLOBAL LET DS.SC,DFMT,TBLEN BE INTEGER,GLOBAL LET DS.DF,DS.F1 BE INTEGER,GLOBAL INITIALIZE DS.DF,DS.F1 TO 0,0 LET READI BE CONSTANT(1 ) LET XEQT BE CONSTANT(1717K) LET WRIT BE CONSTANT(2 ) LET A BE CONSTANT (0) LET B BE CONSTANT (1) ! N1: ASSEMBLE "OCT -1" D124: ASSEMBLE "DEC 124" %DSDR: ASSEMBLE "DEF D.SDR" ASSEMBLE "EXT $CDIR,.MVW,.DRCT" ! D.RIO:SUBROUTINE(RCODE) GLOBAL !READ MASTER DIRECTORY ! ! IF DS.DF THEN [DS.DF_0;RETURN]!IF READ INHIBIT FLAG(DS.DF) SET !USE CURRENT CONTENTS OF D.SDR !CLEAR INHIBIT FLAG FOR NEXT TIME ! ! FETCH DIRECT ADDRESS OF MASTER DIRECTORY AND ! SET ADDRESS OF END OF DIRECTORY IN MDSTP,SET TABLE ! LENGTH INTO TBLEN. ! ! ASSEMBLE "JSB .DRCT FETCH DIRECT ADDRESSES" ASSEMBLE "DEF $CDIR" ASSEMBLE "ADA N1 BACK UP TO STOP WORD" ASSEMBLE "LDB 0,I FETCH IT" ASSEMBLE "INA ADVANCE A TO FW OF DIR" ASSEMBLE "CMA,INA CALCULATE LEGNTH" ASSEMBLE "ADB 0" ASSEMBLE "STB TBLEN AND SAVE FOR MOVE" ! ! CHECK FOR MORE THAN 31 POSSIBLE DISC'S(TBLFP>124) ! ASSEMBLE "CMB,INB SET NUMBER NEG" ASSEMBLE "ADB D124 ADD TO MAX LEN" ASSEMBLE "SSB,RSS SKIP IF BAD " ASSEMBLE "JMP MVR GO MOVE HER IN" ! ASSEMBLE "LDB D124 ELSE MAX=31 DISCS" ASSEMBLE "STB TBLEN SAVE FOR MOVE" MVR: ASSEMBLE "CMA,INA SET FW OF DIRECTORY POSITIVE" ASSEMBLE "LDB %DSDR FETCH ADDRESS OF D.SDR" ASSEMBLE "JSB .MVW MOVE MASTER DIRECTORY TO LOCAL BUFFER" ASSEMBLE "DEF TBLEN ADDRESS OF WORD HOLDING LENGTH" ASSEMBLE "NOP MAKE THE MICRO CODE HAPPY" ! ASSEMBLE "CLA" ASSEMBLE "STA 1,I SET END OF TABLE+1=0" DIR02: ASSEMBLE "STA DS.DF FORCE NEW READ TO PREVENT PROBLEMS IN MTM" RETURN !RETURN END ! ! ! DR.RD:SUBROUTINE(RCOD,DISID,BLK)FEXIT,GLOBAL ! ! THIS SUBROUTINE READS/WRITES THE DIRECTORY BLOCK ! SPECIFIED BY BLK FROM THE DISC IDENTIFIED ! BY DISID. FEXIT IS TAKEN IF THE ! DISC CANNOT BE FOUND OR IF THE END ! OF THE DIRECTORY IS REACHED. ! ! IF [RWCD_RCOD] < 0 THEN [\ !CHECK FOR WRITE FROM DBUF_@IDCB1;RWCD_-RCOD;GO TO DRRD1],\ !IDCB1--IF NEG RCOD ELSE DBUF_@PK.DR !USE IDCB1--ELSE USE PK.DR ! IF DISID=DS.F1 THEN[IF RWCD=WRIT THEN[IFNOT BLK THEN\ GOTO DIRR2];GOTO DRRD1] D.RIO(READI) !READ MASTER DIRECTORY INTO !INTO D.SDR ! !DETERMINE IF LU OR DISKETTE !REFERENCE IF DISID<0 THEN[DLU_-DISID;T_0], \ ELSE[DLU_DISID;T_2] ! !SEARCH FOR REQUESTED DISK !C| ONTINUE AT DIRR0 IF FOUND FOR I_0 TO TBLEN-4 BY 4 DO[IF$(@D.SDR+I+T)=DLU\ THEN GOTO DIRR0] ! ! !IF NOT FOUND--EXIT EXITF:FRETURN ! ! THE DISID HAS BEEN FOUND SO READ IN BLK0 DIRR0:D.LK_[D.LB_[D.LT_[DS.LU_@D.SDR+I]+1]+1]+1! SET POINTERS ! !IF WRITE AND IF BLOCK !ZERO--CONTINUE AT DIRR2 ! !READ BLOCK ZERO- ! ! IF RWCD=WRIT THEN[IFNOT BLK THEN GO TO DIRR2] ! EXEC(READI,$DS.LU ,PK.DR,128,$D.LT,0 ) !READ DISK ID INFO ! DO[BREG_$B;IF BREG#128 THEN[MSS.(1,$DS.LU);GOTO FM.AB]] DIRR2:DS.F1_DISID !SET UP DISC ID DISBL_0 !ALSO THE CURRENT BLOCK DISNT_$(@PK.DR+8) !AND # OF DIRECTORY TRACKS DS.SC_ ($(@PK.DR+6)AND 377K) !ISOLATE AND SET NO. OF SECTORS DFMT_ (($(@PK.DR+6)->8)AND 377K) !SAVE SECTOR SECTOR SKIP INFO IFNOT DFMT THEN DFMT_14 !DEFAULTS TO 14 (7 BLOCKS) ! IF (BLK=0) AND (RWCD=READI) THEN GO TO EXIT ! CALCULATE THE SECTOR ADDRESS DRRD1:TR_(BLK*DFMT)/DS.SC !COMPUTE THE SECTOR ADDRESS T_$1 !SET IN T ! !DIVIDE BY SECTOR SKIP/2 TR_TR/(DFMT->1) !RELATIVE TRACK TO TR IF (TR+DISNT)> -1 THEN GO TO EXITF TR_$D.LT-TR !SET THE TRACK ADDRESS IN TR ! ! READ/WRITE ! ! IF WRITE MUST HAVE LOCKED THE DISK ! IF RWCD=WRIT THEN[IF $D.LK# $XEQT THEN[MSS.(101);GOTO FM.AB]] ! DRRD4:EXEC(RWCD,$DS.LU,$DBUF,128,TR,T) BREG_$B !TEST FOR ERRORS IF BREG#128 THEN[MSS.(1,$DS.LU); GOTO FM.AB] EXIT: RETURN !RETURN END END END$ o@  92064-18170 1650 S C0222 &DRFP0 MI,MII,III FLOPY DIRECT PROGRAM             H0102 ښ* USE ASMB,R,L,N FOR THE M1 VERSION\ ASMB,R,L,Z FOR M2&M3 * * HED RTE-M DIRECTORY MANAGER PROGRAM/SUBROUTINE(FLPY) * * * Z OPTION FOR M2/M3 VERSION * N OPTION FOR M1 VERSION * * * *********************** * M2/M3 VERSION * *********************** * * NAME: D.RFP * SOURCE: 92064-18170 * RELOC: 92064-16056 * PGMR: G.A.A. * MOD: G.L.M * * * ************************ * M1 VERSION * ************************ * * NAME: $D.RF * SOURCE: 92064-18170 * RELOC: 92064-16060 * PRMGR: G.L.M. * * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * * IFZ * ************************************** * BEGIN M2\3 VERSION CODE * ************************************** * * NAM D.RFP,2,1 92064-16056 REV.1650 761020 EXT PRTN,RMPAR,P.PAS,PMOVE * XIF * ************************************** * END M2\3 VERSION CODE * ************************************** * * * IFN * ************************************** * BEGIN M1 VERSION CODE * ************************************** * * NAM D.RFP,6 92064-16060 REV.1650 761020 EXT .ENTP ENT $D.RF * XIF * ************************************** * END M1 VERSION CODE * ************************************** * * EXT EXEC,$CDIR EXT $LIBR,$LIBX * * SUP * RTE FMP DIRECTORY ROUTINE NOV/72**GAA * * THIS PROGRAM IS THE CENTRAL MANAGER OF THE RTE FILE MANAGEMENT * SYSTEM. IT OWNS THE DIRECTORY AND PERFORMS ALL WRITES * ON IT. * * PROGRAM WISHING TO ACCESS THE DIRECTORY * SCHEDULE (WITH WAIT) THIS PROGRAM. * * CALLS ARE AS FOLLOWS (P1,P2,P3,P4,P5 ARE THE PASSED PARAMETERS): * * * 1. OPEN * P1. FUNCTION CODE =11 * P2. -LU,+CR,0 * P3. E,NAME(1,2) E(BIT 15) INDICATES EXCLUSIVE OPEN IF SET * P4. 0,NAME(3,4) S(BIT 15) INDICATES SCRATCH FILE PURGE. * P5. 0,NAME(5,6) * * 2. CLOSE * P1. FUNCTION CODE =0 * P2. TR,LU * P3. OFFSET,SECTOR /DIRECTORY ADDRESS * P4. 0,-(NO. SECTORS TO BE DELETED),+ PURGE EXTENTS ONLY * P5. * * 3. CREAT * P1. FUNCTION CODE =1 * P2. -LU,+CARTRIDGE,0 SEE 1.P5. * P3. NAME (1,2) * P4. NAME (3,4) * P5. NAME (5,6) * P6. TYPE \ TYPE=0 * P7. FILE SIZE \ 0 * P8. REC SIZE \ NOT PASSED * P9. SEC CODE \ NOT PASSED * * 4. CHANGE NAME * P1. FUNCTION CODE=2 * P2. TR,LU (FROM DCB WD 1) * P3. OFFSET,SECTOR (FROM DCB WD 2 OF FILE BEING RENAMED) * P4. NEW NAMME(1) * P5. NEW NAMME(2) * P6. NEW NAMME(3) * P7. NOT USED * P8. LU OF FILE * P9. NOT USED * * 6. SET,CLEAR LOCK ON DISC * P1. FUNCTION = 3 FOR SET, 5 FOR CLEAR * P2. -LU,+CARTRIDGE (0 NOT LEGAL) DISC TO BE LOCKED * P3. * P4. * P5. * * 7. MOUNT,DISMOUNT,UPDATE CALL * P1. FUNCTION =7 * P2. -LU,+CR * P3. LU * P4. LAST TRACK * P5. DISKETTE REFERENCE * P6. LOCK WORD * P7. SUBFUNCTION CODE: -1=UPDATE DRN ONLY * 0=DISMOUNT CALL * -2=MOUNT CALL * * 8. EXTENSION OPEN * P1. FUNCTION CODE= 6(READ), 8(WRITE) * P2. TR,LU \ * P3. OFFSET,SECTOR \DIRECTORY ADDRESS OF MASTER ENTRY * P4. EXTENSION NUMBER * P5. * SKP * * WORD FORMATS FOR DOUBLE DUTY WORDS * * 15.+..6 5..0 15...8 7...0 * TRACK ^ LU OFFSET^SECTOR * #SEC/TR^SECTOR * * RETURN PARAMETERS * R1. ERROR CODE IF >0 THEN #SEC IN FILE (0=> TYPE 0) * R2. TR,LU \ * R3. OFFSET,SECTOR \ DIRECTORY ADDRESS - OPEN & CREATE CALLS * R4. TR(LU IF TYPE 0)/ FILE ADDRESS ON OPEN & CREATE CALLS * R5. #SEC/TR,SECTOR / * * ERROR CODES * 0 OR POSITIVE -NO ERROR * -1 DISC DOWN * -2 DUPLICATE NAME * -3 FILE NOT FOUND * -5 READ EXTENT OPEN AND EXTENT NOT FOUND * -6 CARTRIDGE NOT FOUND * -8 FILE IS CURRENTLY OPEN (ALSO FOR REJECT LOCK) * -9 FILE CURRENTLY OPEN TO THE SAME PROGRAM * -11 FILE NOT OPEN (CLOSE) * -13 DISC LOCKED * -14 DIRECTORY FULL * * -100 BOOTUP AND LU 2 DOES NOT REFERENCE INITIALIZED * FMGR DISK * -101 ILLEGAL PARAMETERS IN CALL * -102 ILLEGAL CALL SEQUENCE (LOCK NOT REQUESTED FIRST) SKP * SPC 1 * * BUF BSS 128 INIT EQU BUF * ORG BUF PUT INITIALIZE CODE IN BUFFER AREA * FETCH DIRECT ADDRESSES FOR DIRECTORIES STB XTMPB SAVE B JSB .ADDR DEF $CDIR STA CRDIR ADA N1 BACK UP TO END OF DIRECTORY WORD STA MDSTP SET MASTER DIRECTORY STOP WORD * * * * * * NOTE! * BOOT UP ON LU2 WILL NOT WORK IF LU2 IS ASSIGNED TO * THE FIXED HEAD DISK. THIS IS BECAUSE THE DRIVER * (DVR30) WILL NOT RETURN LAST TRACK INFORMATION. * * * LDA $CDIR FETCH FIRST WORD OF CARTRIDGE DIRECTORY CMA,SSA,INA IF ZERO OR POSITIVE JMP BGCLR THEN CONTINUE * STA TLU SAVE THE LU CCA SET STA XXX FIRST FLAG * * XREAL JSB EXEC DEF XRTN DEF X.1 READ DEF TLU DEF XTBUF DEF X.16 DEF XTRK DEF XZRO SECTOR ZERO * XRTN JMP BAD * ISZ XXX IF FIRST--SKIP JMP XOTIT GO CHECK DIR ID * ADB XN1 STB XTRK SET LAST TRACK JMP XREAL GO GET DIR ID * * XOTIT LDA XTBUF FETCH FIRST WORD OF ID CPB X.16 MUST HAVE 16 WORDS SSA,RSS AND FIRST WORD MUST BE NEGATIVE JMP BAD NO GOOD--EXIT * LDA HD3 FETCH LABEL SSA MUST BE POSITIVE JMP BAD * STA TDRN SAVE IT LDA HD4 FETCH FIRST TRK CMA ADA HD7 SSA MUST BE LESS THAN FIRST DIR TRK JMP BAD * LDA HD8 FETCH #DIR TRKS SSA,RSS MUST BE NEGATIVE JMP BAD * * LDA DTLU LDB CRDIR JSB PMOVE X.4 OCT 4 * BGCLR CLA STA BEGI2 LDB XTMPB RESTORE B JMP BG2 * XTMPB NOP * * BAD LDA X.BIG RESET LAST TRACK AS DEC 2000 STA XTRK LDA X.100 JMP CREX * * XXX NOP XN1 OCT -1 X.1 OCT 100001 DON'T ABORT X.16 DEC 16 X.100 DEC -100 X.BIG DEC 2000 * * TLU NOP XTRK DEC 2000 TDRN NOP XZRO NOP * * DTLU DEF TLU XTBUF NOP NOP NOP HD3 NOP HD4 NOP NOP NOP HD7 NOP HD8 NOP BSS 8 * * .ADDR NOP LDA .ADDR LDA A,I RAL,CLE,SLA,ERA JMP *-2 ISZ .ADDR JMP .ADDR,I * * * * IFN * ************************************** * BEGIN M1 VERSION CODE * ************************************** * BEGIN HLT 37B FORCE ERROR IF LOADED AS SUB IN USER AREA. * ************************************** * END M1 VERSION CODE * ************************************** * * XIF ORR :CONTINUE * CRDIR DEF $CDIR ADDRESS OF CART DIR * ****************************************** * .20 DEC 20 B777 OCT 77v7 N1 OCT -1 .9 DEC 9 ID NOP * IFZ * ************************************** * BEGIN M2\3 VERSION CODE * ************************************** * * P1 NOP ID P2 NOP FUNCTION P3 NOP CR\-LU\0 P4 NOP P5 NOP *--------------------FROM SCHED REQUEST------------- P6 NOP FROM CALLERS ID SEG: XA NOP NOP THESE POSITION THE CALL PARMS FOR CREATE P7 NOP XB P8 NOP W27 P9 NOP W28 * XIF * * ************************************** * END M2\3 VERSION CODE * ************************************** * * IFN * ************************************** * BEGIN M1 VERSION CODE * ************************************** * * .26 DEC 26 * TDB NOP DEC 14 NOP P1 NOP P2 NOP P3 NOP P4 NOP P5 NOP P6 NOP ..P7 NOP NOP P7 NOP P8 NOP P9 NOP * * * NOTE: THIS ROUTINE (M1 VERSION) WILL RUN ONLY IN M1. * DO NOT ATTEMPT TO USE IT IN M2 OR M3 AS IT IS * NOT A TRUE RE-ENTRANT ROUTINE (IT DEPENDS ON THE * METHOD OF HANDLING RE-ENTRANT ROUTINES WHICH ONLY * M1 SUPORTS) * $D.RF NOP ENTRY POINT JSB $LIBR RE-ENTRANT DEF TDB ENTRY JSB .ENTP P1A DEF P1 FETCH CALL PARMS STA TDB+2 SET RETURN ADDRESS * LDA P1 FETCH ADDRESS OF CALL PARMS LDB P1A FETCH LOCAL BUF ADDRESS JSB PMOVE GO GET EM OCT 7 ALL 7 OF THEM * LDA ..P7 STA P7 SET UP FOR INTERNAL STRUCTURE * * * BEGI2 JMP INIT GO DO BOOT-UP THING BG2 LDA XEQT FETCH ID SEGMENT ADDRESS STA ID SAVE IT FOR INTERNAL USE ADA .26 ADVANCE TO WORD 27 * XIF * o************************************** * END M1 VERSION CODE * ************************************** * * * * * * SPC 2 IFZ * ************************************** * BEGIN M2\3 VERSION CODE * ************************************** * * BEGIN JSB RMPAR FETCH DEF *+2 CALL DEF P1 PARMS * BEGI2 JMP INIT GO DO BOOT-UP THING BG2 LDA XEQT FETCH ID SEG ADDR ADA .20 ADVANCE TO FATHER INFO. LDA A,I AND FETCH IT RAL POSITION FATHER WAIT BIT TO SIGN SSA,RSS CONTINUE ONLY IF FATHER IS WAITING JMP EXIT2 NOT WAITING--ERROR EXIT * RAR REPOSITION ID SEG # OF FATHER AND B777 ISOLATE IT ADA N1 ADA KEYWD ADD TO TABLE OF ID SEGS LDA A,I FETCH ID SEG ADDRESS OF CALLER STA ID * ADA .9 ADVANCE TO XA LDB A,I AND FETCH IT STB P6 NOW SAVE INA ADVANCE TO XB LDB A,I FETCH IT STB P7 AND SAVE ADA .16 ADVANCE TO WORD 27 XIF * ************************************** * END M2\3 VERSION CODE * ************************************** * * * DLD A,I FETCH WDS 27&28 DST P8 SAVE FOR PARMS P8 AND P9 SPC 2 SPC 2 CLB STB FIRST CLEAR THE FIRST FLAG STB TMP1 * * FETCH ADDRESS OF CARTRIDGE DIRECTORY. * LDA CRDIR SET LOCK SEARCH FOR FIRST STA DIRAD ENTRY SKP * THE LOCK ROUTINE SEARCHES THE DISC DIRECTORY FOR THE * REFERENCED DISC. * * FOR THE FIRST CALL DIRAD SHOULD POINT AT THE * FIRST WORD IN $CDIR. SUBSEQUENTLY LOCK * WILL UPDATE DIRAD EACH CALL. * * WITH THE EXCEPTION OF THE DISC DIRECTORY UPDATE THE DISC * MUST BE FOUND. IN THIS CASE, EXIT IS TO THE CREAT ROUTINE * * ON EXIT ATRAK CONTAINS THE DIRECTORY TRACK * ALU CONTAINS THE DIRECTORY LU * A CONTAINS THE LOCK WORD * * ON SUBSEQUENT CALLS IF THE DISC ID WAS 0, THE NEXT * DISC IS RETURNED. IF THE DISC ID WAS NOT 0, * A NOT FOUND EXIT IS TAKEN. * NEXT LDA P2 FETCH LU LDB P1 FETCH FUNCTION CCE,SLB,RSS IS FUNCTION EVEN? JMP LOCK3 YES; GO EXTRACT LU CMA,CCE,SSA,INA E_0 INDICATES CARTRIDGE LABEL CMA,CLE,INA E_1 INDICATES LU(SET +) LDB TMP1 GET PREVIOUS ID STA TMP1 STORE ID CME,SZB IF NOT A ZERO, ID ON SECOND JMP EX6 CALL TAKE -6 EXIT SPC 1 RAL,ERA SET SIGN BIT IF A LABEL SEARCH STA TMP2 AND SET FOR COMPARE SPC 1 LOCK6 LDA TMP2 SET THE FOUND BIT IN E IF CMA,CLE,INA A ZERO ID LDB DIRAD GET CURRENT DIRECTORY ADD. LOCK2 CPB MDSTP,I END OF DIRECTORY? JMP LOCK5 YEP--GO CHECK FOR TYPE 7 CALL LDA B,I GET FIRST WORD SZA,RSS IF 0 THEN END JMP LOCK5 SO GO CHECK FOR DIRECTORY STA ALU UPDATE; ELSE SAVE LU CPA TMP2 IS THIS THE REQUIRED DISC? CCE YES SET E TO 1 TO INDICATE FOUND INB STEP TO TRACK ADDRESS AND LDA B,I SET STA ATRAK IN ATRAK INB STEP TO LDA B,I LABEL AND FETCH IOR SIGN SET SIGN FOR COMPARE SEZ,INB,RSS STEP TO LOCK ADDRESS SKIP IF FOUND CPA TMP2 IS THIS THE REQUESTED DISC? JMP LOCK4 YES; GO EXIT INB NO; STEP TO NEXT ONE JMP LOCK2 AND GO CHECK IT SPC 2 * LU AND TRACK IN (A) * LOCK3 AND B77 MASK TO LU STA TMP2 SAVE LU STA B SAVE LU IN B FOR TEST XOR P2 MASK TO TRACK ALF,RAL ROTATE TO RAL,ALF LOW A AND STA DITR SAVE THE TRACK CPB RDPS DO WE HAVE THIS ONE ALREADY? JMP DECOD YES SO GO DECODE THE REQUEST JMP LOCK6 NO SO GO LOOK FOR IT SPC 2 LOCK4 STB DIRAD FOUND - UPDATE CURRENT ISZ DIRAD ADDRESS FOR NEXT TIME LDA B,I LOCK TO A SZA IF NOT LOCKED CPA ID OR LOCKED TO CALLER JMP DECOD SKIP LDA TMP1 ELSE IF SZA,RSS MULTI-DISC SEARCH JMP NEXT CONTINUE JMP EX13 ELSE EXIT LOCKED DISC SPC 2 DECOD LDA P1 FETCH FUNCTION CODE SSA CHECK REQUEST CODE JMP EX101 NEGATIVE - EXIT ADA N12 SSA,RSS JMP EX101 GREATER THAN 11- EXIT ADA TABAD INDEX INTO THE FUNCTION JMP A,I GO EXECUTE THE FUNCTION SPC 2 N12 DEC -12 SPC 2 TABAD DEF TABA+12 TABA JMP CLOSE 0 JMP CREAT 1 JMP CNAM 2 JMP RLOCK 3 JMP EX101 4 JMP ULOCK 5 JMP EXOPN 6 JMP MDUDT 7 JMP EXOPN 8 JMP EX101 9 JMP EX101 10 JMP OPEN 11 USE 9 FOR OPEN SPC 5 * * RDPS CURRENT DISK FLAG * RDPS NOP SPC 5 * * WCSR WRITE CURRENT BLOCK * WCSR NOP LDA WCS GET WRITE FLAG ISZ RW SET REQUEST CODE TO WRITE SZA IF NOT WRITTEN ON SKIP JSB RWSUB ELSE WRITE THE BLOCK CLA,INA RESET REQUEST CODE TO STA RW READ JMP WCSR,I AND EXIT (A=1) SPC 2 RW NOP DRLU NOP SPC 2 * * RWSUB ROUTINE TO READ OR WRITE A TWO-SECTOR BLOCK * RWSUB NOP DLD RW FETCH THE NEW POINTERS * * STB RPRM SLA,RSS IF WRITE THEN JMP RWSU1 GO DO IT CPB LDRLU ELSE IF LDB N7 SAME BLOCK AS LDA TRACK CURRENT ONE CPA LTRAC THEN INB LDA SECT NO CPA LSECT ACTION IS  CLE,INB CPB N5 REQUIRED SO JMP RWSUB,I RETURN RWSU1 JSB EXEC NOT SAME BLOCK CALL EXEC DEF RTN RETURN DEF RW READ WRITE CODE DEF RPRM LU ABUF DEF BUF BUFFER DEF .128 128 WORDS DEF TRACK ON TRACK & DEF SECT SECTOR RTN CLA,CLE CLEAR THE WRITE STA WCS FLAG LDA RPRM SET UP LAST POINTERS FOR NEXT TIME STA LDRLU LDA TRACK SAVE THE TRACK STA LTRAC ADDRESS AND THE LDA SECT SECTOR STA LTRAC+1 ADDRESS CPB .128 DISC ERR? JMP RWSUB,I NO - RETURN STA LDRLU YES; SET NOT IN CORE FLAG JMP EX1 YES - TAKE DISC ERR EXIT SPC 2 LDRLU NOP LTRAC NOP LSECT NOP N5 OCT -5 SKP OPEN DLD P4 SET NAME WORDS 2 AND 3 ELA,CLE,ERA CLEAR POSSIBLE SCRATCH PURGE BIT DST NAME+1 INTO THE NAME BUFFER LDA P3 SET NAME WORD1 RAL,CLE,ERA LESS POSSIBLE SIGN BIT STA NAME INTO THE NAME BUFFER JSB SETDR SET UP TO READ THE DIRECTORY JSB N.SHR GO FIND THE FILE JMP NEXT NOT FOUND - TRY NEXT DISC JSB SETAD FOUND - GO SET THE ADDRESSES JSB FLAG CHECK THE OPEN FLAGS LDB COUN2 IF 7 OPENS * * * IF SCRATCH PURGE MUST HAVE CLEARED SC PU BIT EARLIER * NOW MUST MAKE SURE ONLY 1 PROG OPEN TO IT(ELSE EX 101?) * THEN CLEAR OPEN FLAG * JMP PURGE * LDA P4 FETCH POSSIBLE SCR PURGE FLAG SSA IF SIGN NOT SET--CONTINUE JMP SCPU ELSE FORCE PURGE * * * * CPB .7 THEN NO ROOM SO JMP EX8 EXIT LDA P3 IF EXCLUSIVE OPEN CLE,SSA,RSS THEN SKIP JMP OPEN3 NON EXCLUSIVE SKIP CCE,SZB IF ANY OPENS THEN JMP EX8 REJECT EXCLUSIVE OPEN OPEN3 LDB SC GET THE FLAG ADDRESS LESS ONE OPEN5 INB `SEARCH FOR OPEN SPOT IN FLAG LIST LDA B,I GET FLAG WORD SSA IF SIGN BIT SET THEN JMP EX8 FILE IS EXCLUSIVELY OPEN TO SOME ONE SZA THIS WORD? JMP OPEN5 NO; GO TRY NEXT ONE LDA ID YES; GET THE ID ADDRESS RAL,ERA SET THE EXCLUSIVE/NON-EXCLUSIVE STA B,I FLAG AND PUT IN THE DIRECTORY STA WCS SET TO WRITE THE BLOCK OPEN4 LDA TYPE,I SET UP THE RETURN PARAMETERS SZA IF TYPE ZERO SEND BACK ZERO CODE LDA #SEC,I ELSE SEND BACK THE FILE SIZE CREX JSB RPRM SET THE RETURN PRAMS * EXIT JSB WCSR WRITE THE SECTOR IFZ * ************************************** * BEGIN M2\3 VERSION CODE * ************************************** * JSB PRTN PASS THE RETURN PRAMS DEF *+2 AND DEF R1 THEN EXIT2 JSB EXEC COMPLETE DEF *+2 DEF .6 XIF * ************************************** * END M2\3 VERSION CODE * ************************************** * SPC 2 * IFN * ************************************** * BEGIN M1 VERSION CODE * ************************************** * * LDA R1AD FETCH ADDRESS OF RETURN PARMS LDB XEQT FETCH IDSEG ADDRESS INB ADVANCE TO TEMP AREA * * GO PRIV AND: 1/SET RETURN PARMS INTO ID TEMP AREA * * JSB PMOVE OCT 5 * * RESET B FOR RAMPAR CALL BY CALLER * LDB XEQT INB JSB $LIBX DEF TDB NOP * * .5 DEC 5 R1AD DEF R1 * XIF * ************************************** * END M1 VERSION CODE * ************************************** * * * EXTENSION OPEN ROUTINE * EXOPN JSB DIRCK GO READ IN THE MASTER DIRECTORY ENTRY CLA CLEAR THE STA ID OPEN FLAG WORD LDA P4 SET THE SZA,RSS IF AFTER THE MAIN THEN JMP OPEN4 WE HAVE IT ALREADY ALF,ALF EXTENSION NO FOR POSSIBLE STA GSEC EXTENSION CREAT JSB EXSHR SEARCH FOR THE REQUIRED EXTENT JMP EXOPT NOT FOUND SO GO TEST IF READ ALF,ALF EXTENT NO TO A AND B377 MASK CPA P4 THIS IT? JMP OPEN4 YES SO GO RETURN THE PRAMS CSER LDA TYPE NO SO CONTINUE JMP NSHR4 THE SEARCH SPC 1 EXOPT LDB P1 IF EXTENT OPEN IS FOR CPB .8 WRITE THE GO CREAT THE EXTENT JMP CREA0 GO EXIT LDA N5 ELSE RETURN ILLEGAL RECORD ERROR JMP CREX GO EXIT SPC 2 .8 DEC 8 .14 DEC 14 ANAME DEF NAME ATRAK NOP SIGN OCT 100000 SPC 2 * * SETDR ROUTINE TO SET UP TO READ A DIRECTORY * SETDR NOP JSB WCSR WRITE CURRENT SECT LDA .128 PRESET # SET TO AVOID DIVIDE ISZ FIRST (EXCEPT WHEN REWRITING) STA ##SEC PROBLEMS CCA SET FIRST STA FIRST FLAG TO INDICATE FIRST BLOCK LDA ATRAK SET THE TRACK STA TRACK ADDRESS LDA ALU AND THE LU STA DRLU ADDRESS * * LDA N#FMT ADD SECTOR BUMP FACTOR(=14 UNTIL1ST BLK READ) STA SECT SET THE SECTOR JMP SETDR,I RETURN N14 DEC -14 * * N.SHR DIRECTORY SEARCH ROUTINE * TARGET NAME IN NAME * RETURNS: * P+1 END OF DIRECTORY A=NEXT ADDR. (IF A=0 END OF SPACE) * P+2 FOUND RETURN A=ENTRY ADDR. * N.SHR NOP JSB RDNXB READ THE DIRECTORY JMP N.SHR,I END OF DISC RETURN NSHR0 LDA ABUF SET A TO THE BUFFER ADDRESS LDB N8 SET COUNT FOR THE NO. IN A BLOCK STB COUN1 NSHR1 CCE SET FOUND FLAG (E=1) LDB ANAME SET THE NAME ADDRESS STB TMP2 IN TMP2 LDB N3 SET FOR 3-WORD NAME STB COUN2 NSHR2 LDB A,I GET A NAME WORD SZB,RSGHFBS IF ZERO - END OF DIRECTORY JMP N.SHR,I SO EXIT CPB TMP2,I MATCH? INA,RSS YES - SET FOR NEXT WORD SKIP CLE,INA NO - SET NOT FOUND - STEP NAME ISZ TMP2 STEP LOCATIONS ISZ COUN2 AND COUNT MORE NAME JMP NSHR2 YES; GO DO IT CLB,SEZ,CCE,INB NO; FOUND? JMP NSHR3 YES; GO TAKE FOUND EXIT NSHR4 ADA .13 NO; SET FOR NEXT ENTRY ISZ COUN1 DONE WITH BLOCK? JMP NSHR1 NO; DO NEXT ENTRY JMP N.SHR+1 YES; GO READ NEXT BLOCK NSHR3 ADB N.SHR FOUND - STEP RETURN ADDRESS ADA N3 ADJUST TO START OF ENTRY JMP B,I RETURN * * SETAD TO SET UP ADDRESSES FOR DIRECTORY ENTRY IN BUF AT * ADDRESS POINTED TO BY A * * SETAD NOP CLB,CLE JSB P.PAS N10 DEC -10 DIRA NOP NOP NOP TYPE NOP TRAKA NOP SECTA NOP #SEC NOP RL NOP SC NOP FLAGA NOP JMP SETAD,I SPC 2 H SPC 2 RPRM NOP STA R1 SET FIRST RETURN PRAM LDA TRACK TRACK,LU LSL 6 TO ADA ALU RETURN STA R2 TWO LDA ABUF OFFSET CMA,INA AND ADA DIRA SECTOR ALF,ALF TO ADA SECT RETURN STA R3 3 LDA TRAKA,I TRACK OF FILE TO STA R4 RETURN 4 LDA SECTA,I GET THE SECTOR ADDRESS AND B377 ISOLATE IT LDB ##SEC GET THE NUMBER OF SECTORS /TRACK BLF,BLF ROTATE AND ADA B COMBINE WITH THE SECTOR STA R5 RETURN 5 JMP RPRM,I SPC 2 R1 NOP R2 NOP R3 NOP R4 NOP R5 NOP SPC 2 * * RDNXB READ NEXT DIRECTORY BLOCK * RDNXB NOP JSB UDAD UPDATE THE ADDRESSES JMP RDNXB,I END OF DIRECTORY RETURN JSB RWSUB READ THE BLOCK ISZ RDNXB STEP TO OK RETURN ISZ FIRST FIRST BLOCK? JMP RDNXB,I NO; SO RETURN SPC 1 CLE JSB DPMM JMP RDNXB,I RETURN * * UDAD -- UPDATE THE DIRECTORY ADDRESS * * * THE SECTOR OFFSET MUST BE KEPT ON THE DISK ITSELF * * CKECK ALL REFS TO IT BEFORE CHANGING * * * UDAD NOP JSB WCSR WRITE CURRENT BLOCK LDA #FMT SET SECTOR BUMP FACTOR(=14 UNTIL 1ST BLK READ) ADA SECT ADD 7 TO THE SECTOR CLB PREPARE FOR DIVIDE DIV ##SEC DIVIDE BY THE NO OF SECTORS0TRACK STB SECT SET THE NEW SECTOR ADDRESS SZA IF NO ROLLOVER OR SZB IF SECTOR IS ZERO THEN SKIP (NEW TRACK) JMP UDAD1 ELSE GO EXIT SPC 1 CCB SET TO DECREMENT TRACK CLA SET A FOR ERROR RETURN ADB TRACK ADDRESS CPB LTR OUT OF DIRECTORY? JMP UDAD,I YES SO RETURN STB TRACK SET THE NEW TRACK UDAD1 ISZ UDAD STEP RETURN JMP UDAD,I TAKE OR RETUaRN SPC 2 LTR NOP NXSCA DEF BUF+5 SPC 2 * DPMM MOVE DISC PARAMETERS FOR CURRENT UNIT * CALLING SEQUENCE * * E=0 - SAVE PARAMETERS * E=1 - MOVE PARAMETERS BACK * * DPMM NOP LDA NXSCA LDB SIGN JSB P.PAS N11 DEC -11 NXSEC NOP #SECT DEC 96 LASTR NOP #TRK NOP NXTR NOP BAD1 NOP BAD2 NOP BAD3 NOP BAD4 NOP BAD5 NOP BAD6 NOP NOP LDB #TRK ADB TRACK COMPUTE THE ADDRESS OF TRACK STB LTR ELSE SET THE ADDRESS LDB DRLU SAVE THE CURRENT LU STB RDPS FOR CORE RESIDENT SPEED * * ISOLATE AND SAVE THE SECTOR OFFSET AND #SECTORS / TRACK * * THE HIGH EIGHT BITS FORM THE OFFSET * THE LOW EIGHT FORM THE #SECT/TRACK * LDA #SECT FETCH THE #SECT/TRACK&OFFSET ALF,ALF POSITION * THE SKIP FACTOR TO LOW END AND B377 ISOLATE IT SZA,RSS ZERO DEFAULTS TO 14 LDA .14 STA #FMT SAVE IT CMA,INA SET IT NEGATIVE (SO YOU CAN SEE BLOCK 0) STA N#FMT SAVE IT ALSO * LDA #SECT FETCH THE ORIGIONAL WORD AND B377 ISOLATE THE SECTORS/TRACK INFO STA ##SEC SAVE ANOTHER ONE JMP DPMM,I * * * #FMT DEC 14 N#FMT DEC -14 ##SEC NOP SPC 5 * * FLAG CHECKS FOR OPEN FLAGS * ASSUMES FLAGA POINTS TO THE FLAG AREA * FLAG NOP CLA CLEAR THE OPEN COUNT STA COUN2 AND LDA N7 SET TO TEST STA COUN1 THE OPEN FLAGS LDB FLAGA GET THE FLAG ADDRESS FLAG1 LDA B,I GET OPEN FLAG RAL,CLE,ERA REMOVE POSSIBLE EXCLUSIVE BIT JSB DORM TEST FOR DORMANT ISZ COUN2 STEP OPEN FLAG COUNT INB STEP TO NEXT ENTRY ISZ COUN1 STEP COUNT; END OF FLAGS? JMP FLAG1 NO; TRY NEXT ONE JMP FLAG,I YES; RETURN SPC 5 * .28 DEC 28 N20 DEC P-20 * DORM CHECK TO SEE IF PROGRAM IS DORMANT * * * * ID ADDRESS IN A * LOCATION TO BE SET TO ZERO'S ADDRESS INB * RETURN P+1 IF NOT DORMANT; ELSE P+2 DORM NOP STB TMP2 SAVE B REG CCE,SZA,RSS IF ZERO THEN JUST RETURN P+2 CLE,RSS SO SKIP ELSE CPA ID IF OPEN TO THIS PGM FORCE CLOSE JMP DORM1 SO GO EXIT LDB KEYWD MAKE SURE THE FLAG POINTS STB RWSUB TO A VALID DORM2 LDB RWSUB,I ID SEGMENT CPB A THIS ONE? JMP DORM3 YES CONTINUE ISZ RWSUB NO TRY THE NEXT ONE SZB IF END THEN JMP DORM2 JMP DORM1 NOT VALID GO CLEAR FLAG DORM3 ADA .28 ADDRESS OF NEW RUN BIT LDB A,I FETCH IT CCE,SSB SKIP IF NOT NEW RUN JMP DORM1 NEW RUN--CLEAR FLAG ADA N20 BACKUP TO POINT OF SUSPENSION LDB A,I FETCH IT CMB,CLE,INB,SZB,RSS IF ZERO (DORMANT) E_1 DORM1 ISZ DORM ELSE SKIP LDB TMP2 RESTORE BREG CLA,SEZ CHANGE TO DORMANT STA B,I SET TO ZERO SEZ AND STB WCS SET WRITE FLAG JMP DORM,I RETURN SPC 2 EX1 CLA,INA,RSS EX2 LDA .2 RSS EX6 LDA .6 RSS EX8 LDA .8 RSS EX13 LDA .13 RSS EX14 LDA .14 CMA,INA,RSS EX11 LDA N11 RSS EX12 LDA .12 JMP CREX SPC 2 .12 DEC 12 .7 DEC 7 .13 DEC 13 .128 DEC 128 B77 OCT 77 N8 DEC -8 FIRST NOP COUN1 NOP COUN2 NOP BTRA DEF BAD1 BADTR NOP SKP * P3A DEF P3 * CREAT LDA ID SET UP EXCLUSIVE OPEN FLAG IOR SIGN ADD THE EXCLUSIVE BIT STA ID SAVE IT CLA,CLE CLEAR THE EXTENT FLAG STA GSEC SAVE IT FOR THE DIRECTORY * * LDA P3A MOVE IT JSB MOVE1 THE SAVE AREA JSB SETDR SET TO READ THE DIRECTdORY JSB N.SHR SEARCH FOR THE NAME CREA0 CCE,RSS NOT FOUND SKIP JMP EX2 FOUND - TAKE DUP NAME EXIT SZA,RSS IF DIRECTORY FULL JMP EX14 TAKE EXIT JSB SETAD SET THE ADDRESSES CCE LDA DIRA MOVE IN JSB MOVE1 LDA ID SET THE OPEN FLAG STA FLAGA,I LDB BTRA SET THE BAD TRACK POINTER CHKBT LDA B,I IF END OF LIST SZA,RSS THEN JMP EOL CONTINUE CMA,CLE ELSE SET ADA NXTR BADTR TO SEZ,RSS POINT TO JMP EOL FIRST BAD TRACK INB => NXTR JMP CHKBT EOL STB BADTR SET BAD TRACK POINTER LDB NXSEC GET THE NEXT TRACK LDA NXTR AND SECT CREA1 STA TRAKA,I SET THE TRACK ADB GSEC ADD THE EXTENT WORD STB SECTA,I SET THE SECT/EXTENT LDB #SEC,I GET THE REQUEST SIZE LDA BADTR,I AND THE FIRST BAD TRACK SZA IF GOOD SKIP SSB,RSS ELSE IF REST OF DISC SKIP JMP CREA2 GO CALCULATE SIZE CREA3 INA BAD TRACK ON REST OF DISC RQ ISZ BADTR SET FILE ABOVE IT AND CLB TRY AGAIN JMP CREA1 SPC 2 CREA2 SSB IF REST OF DISC JMP CREA5 JMP * CREA7 JSB NXT/S COMPUTE THE NEXT TRACK AND SECTOR STA SETAD SECTOR - SAVE LAST TRACK LDA BADTR,I GET LAST AVAILABLE TRACK SZA,RSS IF NOT BAD LDA LASTR THE LAST ON DISC+1 CMA SUBTRACT FROM SZB BUMP TRACK INA IF SOME OF IT USED ADA SETAD LAST FILE TRACK SSA 0 OR +? JMP CREA4 YES; IT FITS LDA BADTR,I NO; WON'T FIT SZA WAS IT A BAD TRACK? JMP CREA3 YES; TRY ABOVE IT * STA DIRA,I NO CLEAR THE ENTRY FROM BUFFER LDA GSEC IF EXTENT CREAT SZA,RSS THEN SKIP TO ERROR EXIT B6 JMP NEXT ELSE TRY NEXT DISC JMP EX6 NO ROOM FOR EXTENT EXIT SPC 2 CREA4 LDA SETAD IT FIT SO CREA6 STA NXTR UPDATE THE NEXT STB NXSEC TRACK AND SECTOR ISZ WCS SET THE WRITE FLAG LDA #SEC,I GET THE RETURN PRAM JSB RPRM AND GO SET UP THE RETURN CCA SET FIRST TO AVOID STA FIRST RESETING THE #SECTORS/TRACK JSB SETDR SET UP TO READ FIRST STA FIRST DIRECTORY BLOCK JSB RDNXB READ IT .2 DEC 2 CCE MOVE NEW JSB DPMM NEXT TRACK AND SECT WORDS ISZ WCS IN - SET TO WRITE JMP EXIT AND EXIT SPC 2 CREA5 LDA TRAKA,I REQUEST FOR REST OF DISC CMA,INA COMPUTE THE ADA LASTR NUMBER OF LDB SECTA,I GET THE NUMBER OF SECTORS CMB,INB USED THIS TRACK STB MOVE1 AND SAVE MPY ##SEC SECTORS ADA MOVE1 SUBTRACT NUMBER USED THIS TRACK SZB,RSS IF MORE THAN 32K SSA THEN LDA MAXSZ SET TO MAX ALLOWABLE(32K) STA #SEC,I SET IN THE FILE ENTRY SZA,RSS IF ZERO JMP NEXT TRY NEXT DISC * JMP CREA7 GO WRAP IT UP * MAXSZ OCT 77776 MAX NUMBER OF SECTORS IN A FILE SPC 2 * * * MOVE1/2 TO MOVE DIRECTORY ENTRIES TO/FROM * THE LOCAL SAVE AREA DEFINED * HEREIN. * * CALLING SEQUENCE: * * E=0 TO THIS SAVE AREA * E=1 FROM THIS SAVE AREA * * A = ADDRESS OF OTHER AREA * * MOVE1 MOVES 9 WORDS * MOVE2 MOVES 3 WORDS * MOVE1 NOP LDB SIGN SET B TO MOVE WORDS JSB P.PAS CALL TO MOVE N9 DEC -9 9 WORDS NAME BSS 9 CSEC EQU NAME+5 JMP MOVE1,I RETURN SPC 2 MOVE2 NOP LDB SIGN SET B FOR MOVE JSB P.PAS CALL TO MOVE N3 DEC -3 3 BS!S 3 WORDS JMP MOVE2,I RETURN SPC 2 GSEC NOP SKP SPC 2 SPC 5 LOCK5 LDA P7 FETCH SUBFUNCTION CODE LDB P1 FETCH FUNCTION CPB .7 IF MASTER DIRECTORY UPDATE, SSA,RSS AND NOT "DC" CALL--CONTINUE JMP EX6 ELSE EXIT--NOT FOUND * * THIS IS THE WAY "IN"(DISKETTE REF UPDATE) AND MOUNT * CARTRIDGE GET IN. * LDB CRDIR FETCH MASTER DIRECTORY ADDRESS CPA N1 IF SUBFUNCTION=-1 JMP MDNXT THEN GO UPDATE DISKETTE REF * * ELSE DO MOUNT WORK * MDSTP=ADDRESS OF END OF TABLE WORD * * FIRST SEARCH FOR DUPLICATE LABEL * MCLB? LDA B,I FETCH FIRST ENTRY SZA,RSS END? JMP OKMC YEP--B=AVAILABLE SPACE * ADB .2 ADVANCE TO LABEL LDA B,I FETCH IT CPA P5 MATCH? JMP EX12 YES--DUPLICATE LABEL EXIT * ADB .2 ADVANCE TO NEXT ENTRY CPB MDSTP,I OUT OF ROOM? JMP EX14 YEP-BYE BYE JMP MCLB? GO CHECK THIS ENTRY * * * MDSTP NOP * B=DESTINATION ADDRESS * OKMC LDA P3A FETCH ADDRESS OF NEW DIRECTORY ENTRIES MV4 JSB PMOVE GO PRIV AND MOVE ER DOWN .4 OCT 4 JMP EXIT4 OK-- ALL DONE SO EXIT * SPC 5 * * UPDATE DISKETTE REFERENCE # * A CHECK FOR DUPLICATE LABEL HAS JUST BEEN DONE * NOW JUST FIND THE CORRECT LU AND DROP THE NEW LABEL IN. * * MDNXT LDA B,I FETCH FIRST ENTRY CPA P3 THIS THE RIGHT LU? JMP GTIT YUP YUP YUP * ADB .4 NOPE--SO ADVANCE TO NEXT ENTRY CPB MDSTP,I END OF DIRECTORY JMP EX6 YUP YUP SO GET OUT JMP MDNXT GO CHECK THIS ONE * * GTIT ADB .2 ADVANCE TO LABEL WORD LDA P2A ADDRESS OF WORD HOLDING NEW LABEL * JSB PMOVE OCT 1 JMP EXIT4 * P2A DEF P2 SPC 10 * * CENTRAL MOVE WORDS ROUTINE * FOR M1 VERSION * *  IFN * ************************************** * BEGIN M1 VERSION CODE * ************************************** * PA NOP * PMOVE NOP STA PA LIA 6 SZA,RSS MX OR XE COMPUTER? JMP NMX0 NEITHER * LDA PMOVE STA MVW+1 SET ADDRESS OF MVW LDA PA RESTORE A MVW MVW 0 JMP PEXIT * * * * NEITHER MX OR XE * * NMX0 LDA PMOVE,I GET THE COUNT SZA,RSS SKIP MOVE IF JMP FEXT ZERO COUNT * CMA,INA SET IT NEGATIVE STA MOUNT SET COUNTER LOOP LDA PA,I GET WORD STA B,I SET IN DESTINATION INB STEP DESTINATION ISZ PA SOURCE ISZ MOUNT AND COUNT JMP LOOP IF NOT DONE LOOP * FEXT LDA PA PEXIT ISZ PMOVE JMP PMOVE,I * MOUNT NOP * XIF * ************************************** * END M1 VERSION CODE * ************************************** * * * SKP * * * MASTER DIRECTORY MODIFICATION * MDUDT LDA P7 FETCH SUBFUNCTION SZA THIS ENTRY IS USED BY "DC" ONLY JMP EX12 DUPLICATE LU OR LABEL * * LDB ALU IF SAME LU AS LAST ONE REF CPB LDRLU CLEAR IT TO PREVENT STA LDRLU MISTAKEN ID. * * * DIRAD = REQUESTED LOCATION+4 * LDB DIRAD IF DISKETTE TO BE DISMOUNTED IS LAST CPB MDSTP,I ---SKIP CLOSE JMP CLR UP OF GAP * * CALCULATE LEGNTH OF MOVE(TO CLOSE UP GAP)B=NEXT ADDRESS IN DIRECTORY * CMB,INB SET ADDRESS NEGATIVE ADB MDSTP,I ADD TO STOP ADDRESS STB LN1 SAVE THE LEGNTH LDA DIRAD FETCH "FROM" ADDRESS LDB A "TO" ADDRESS ADB N4 = "FROM" -4 * JSB PMOVE LN1 NOP GO PRIV AND CLOSE UP THE GAP * * CLEAR FIRST WORD IN LAST ENTRY OF DIRECTORY * CLR LDB MDSTP,I FETCH STOP ADDRESS c ADB N4 BACK UP TO BEGINING OF LAST ENTRY LDA DZERO ADDRESS OF A ZERO * JMP MV4 GO PRIV * DZERO DEF ZERO N4 DEC -4 SKP * * EXIT3 ISZ WCS SET WRITE FLAG EXIT4 CLA AND TAKE JMP CREX ACCEPT EXIT SPC 2 TMP1 NOP TMP2 NOP DIRAD NOP TRACK NOP SECT NOP WCS NOP ALU NOP DITR NOP ZERO NOP THESE 4 WORDS ARE USED TO CLEAR A BUFFER NOP NOP NOP SKP RLOCK LDA TMP1 DISC MUST BE SPECIFIED SZA,RSS JMP EX101 NOT SPECIFIED - EXIT JSB SETDR SET TO SEARCH FOR OPEN FLAGS ROCK1 JSB RDNXB READ ENTRY JMP ROCK4 END OF DIRECTORY - GRANT LOCK LDA N8 SET COUNTER FOR 8 ENTRIES STA EXSH LDA ABUF SET A_ADDRESS OF FIRST ROCK2 LDB A,I END OF SSB IF PURGED JMP ROCK3 IGNOR SZB,RSS DIRECTORY? JMP ROCK4 YES; GRAND LOCK JSB SETAD NO; SET ENTRY ADDRESSES JSB FLAG TEST FOR FLAGS LDB COUN2 ANY SZB SET? JMP EX8 YES; REJECT LOCK LDA DIRA NO; GET ADDRESS TO A ROCK3 ADA .16 STEP TO NEXT ENTRY ISZ EXSH END OF BLOCK? JMP ROCK2 NO; TRY NEXT ENTRY JMP ROCK1 YES; TRY NEXT BLOCK SPC 2 ROCK4 LDA IDAD LOCK GRANTABLE CCB ADB DIRAD BACK UP TO LOCK WORD JSB PMOVE OCT 1 JMP EXIT4 * * * * * * * * IDAD DEF ID SPC 5 ULOCK CLA UNLOCK - CLEAR LDB ALU FETCH LU OF DISK CPB LDRLU IF SAME AS CURRENT STA LDRLU FORCE NEW READ NEXT TIME STA ID JMP ROCK4 AND GO SET IT SPC 2 EX101 LDA N102 INA,RSS EX102 LDA N102 JMP CREX SPC 2 N102 DEC -102 .16 DEC 16 B377 OCT 377 N7 DEC -7 SKP P4A DEF P4 * *# CNAM LDA P4A MOVE NEW NAME TO CLE  GO THE RIGHT WAY JSB MOVE2 LOCAL SAVE AREA LDA P4A SET UP THE NAME JSB MOVE1 FOR DUP CHECK JSB SETDR SET UP TO READ THE DIRECTORY JSB N.SHR SEARCH FOR DUPLICATE NAME RSS NOT FOUND SO SKIP JMP EX2 TAKE DUP NAME EXIT JSB DIRCK GO GET DIRECTORY ENTRY LDA FLAGA,I OPEN EXCLUSIVELY RAL,CLE,ERA CLEAR EXCLUSIVE BIT AND SAVE IN E CPA ID TO CALLER? SEZ,CCE,RSS YES SKIP JMP EX102 NO; REJECT CNAM1 LDA DIRA YES; MOVE JSB MOVE2 THE NEW NAME IN JSB EXSH SEARCH FOR EXTENT OF THIS FILE JMP CNAM1 YES GO SET NEW NAME SPC 2 EXSH NOP DIRECTOR SEARCH FOR EXTENTS TO MODIFY ISZ WCS SET THE WRITE FLAG JSB EXSHR SEARCH FOR EXTENT JMP EXIT4 NOT FOUND SO EXIT JMP EXSH,I FOUND RETURN SPC 5 * * DIRCK READ A DIRECTORY ENTRY - SET FLAGS * CHECK OPEN FLAGS ETC. * DIRCK NOP LDA ALU DO WE ALREADY CPA RDPS HAVE THE DISC SPECS? RSS YES SO SKIP SET UP JSB SETPR SET UP THE DISC PARAMETERS LDA DITR SET STA TRACK TRACK LDA P3 GET THE PASSED AND B377 SECTOR STA SECT AND SET IT XOR P3 NOW GET THE ALF,ALF OFFSET ADA ABUF ADD THE BUFFER ADDRESS JSB SETAD SET DIRECTORY ADDRESSES JSB RWSUB READ THE BLOCK LDA DIRA MOVE THE ENTRY TO LOCAL JSB MOVE1 STORAGE JMP DIRCK,I SKP SPC 5 CLOSE JSB DIRCK CLOSE; GET THE SECTOR LDA N7 SET FOR 7 ENTRIES CLOS1 LDB FLAGA,I FIND RBL,CLE,ERB CALLERS CPB ID FLAG JMP CLOS2 FOUND ISZ FLAGA NOT; YET TRY NEXT ONE INA,SZA MORE? JMP CLOS1 YES; OK JMP EX11 NO; ERR - NOT OPEN TO CALLER SPC TK2 CLOS2 CLA FOUND; CLEAR THE STA FLAGA,I FLAG LDA P4 GET TRUNCATE CODE SZA IF ZERO THEN SKIP NO ACTION SEZ,RSS EXCLUSIVE OPEN? JMP EXIT3 NO; EXIT SSA,RSS IF POSITIVE THEN JMP EXPUR GO PURGE THE EXTENTS ADA #SEC,I CALCULATE NEW FILE SIZE SLA,RSS IGNOR IF ODD SECTOR COUNT SSA IF RESULT LESS THAN ZERO JMP EXIT3 THEN IGNOR IT CCE,SZA,RSS IF ZERO JMP PURGE GO PURGE STA TMP2 SAVE THE NEW SIZE JSB LAST? LAST FILE? CLE,RSS NO, CLEAR E SKIP CCE YES; SET E LDA TMP2 SET THE NEW SIZE STA #SEC,I IN THE DIRECTORY SEZ,RSS IF NOT THE LAST ENTRY JMP EXPUR GO PURGE ANY EXTENTS JMP PURG8 ELSE GO UPDATE DISC PRAMS SPC 5 NXT/S NOP CACULATE THE NEXT TRACK AND SECTOR LDB #SEC,I GET THE FILE SIZE LDA SECTA,I GET THE NO OF SECTORS IN THE FILE AND B377 ISOLATE ADB A SUM LSR 16 EXTEND TO A DIV ##SEC DIVIDE BY THE NO SECT PER TRACK ADA TRAKA,I ADD THE CURRENT TRACK ADDRESS JMP NXT/S,I RETURN A=NEXT TRACK,B=NEXT SECTOR SPC 5 EXSHR NOP EXTENT SEARCH ROUTINE LDB DEF SET RETURN ADDRESS IN STB N.SHR NAME SEARCH ROUTINE JMP NSHR0 GO TO NAME SEARCH DEF DEF *+1 RETURN ADDRESS FOR NAME SHEARCH JMP EXSHR,I NOT FOUND SO EXIT JSB SETAD FOUND SET THE ADDRESSES LDB EXSHR STEP THE RETURN ADDRESS CCE,INB AND LDA SECTA,I MAKE SURE THIS IS NOT THE MAIN CPA CSEC SAME AS MAIN? JMP CSER YES SO TRY AGAIN JMP B,I RETURN SPC 2 LAST? NOP LDB TYPE,I IF TYPE SIX SZB OR TYPE ZERO FILE CPB .6 THEN TREAT * JMP LAST?,I AS NOT LAST JSB NXT/S COMPUTE THE NEXT TRACK AND SECTOR CPA NXTR SAME TRACK? CCA YES; A_1 CPB NXSEC SAME AS NEXT SECTOR? INA,SZA YES; WAS IT SAME TRACK ALSO? JMP LAST?,I NO; NOT LAST FILE EXIT P+1 ISZ LAST? YES; LAST FILE JMP LAST?,I EXIT P+2 SPC 3 SETPR NOP READ AND SET UP THE DISC PARAMETERS JSB SETDR SET UP TO ACCESS THE DIR JSB RDNXB READ AND SET PRAMS N16 DEC -16 JMP SETPR,I RETURN TO CALLER SPC 2 .6 DEC 6 N2 OCT -2 SKP SCPU ADB N2 CHECK OPEN FLAG COUNT-- SSB,RSS IF JUST ONE OK JMP EX101 ELSE EXIT MORE THAN 1 PROG OPEN TO IT CLA STA FLAGA,I CLEAR FLAG,IF ANY SPC 5 PURGE CCA PURG0 STA DIRA,I SET PURGE FLAG JSB LAST? LAST FILE? JMP EXPUR NO; GO CHECK FOR EXTENTS PURG2 STA DIRA,I MAKE ENTRY AVAILABLE LDA DIRA IS THIS THE FIRST STA WCS SET TO WRITE CURRENT BLOCK CPA ABUF ENTRY IN THE CURRENT BLOCK? JMP PURG5 YES; GO READ PREVIOUS BLOCK PURG7 ADA N16 NO; BACK UP TO PREVIOUS JSB SETAD ENTRY; FIND FIRST UNPURGED LDB TYPE,I CHECK TYPE LDA DIRA,I ENTRY CPB .6 IF TYPE SIX FILE CCE DO NOT ATTEMPT RECOVERY SZB TYPE ZERO - IF SO SKIP SEZ,INA,SZA,RSS PURGED? JMP PURG2 YES; TRY PREVIOUS ENTRY SPC 1 SSA FOUND ENTRY - IS IT THE JMP PURG3 DISC SPEC ENTRY? - YES JUMP PURG8 JSB NXT/S NO; CACULATE THE NEXT TRACK AND SECT JMP CREA6 GO SET, WRITE & EXIT SPC 2 PURG3 LDA TRAKA,I SET TO SHOW CLB NEXT AVAILABLE SECT JMP CREA6 IS FIRST SECTOR SPC 1 PURG5 JSB WCSR WRITE CURRENT SECTOR LDB SECT GET SECTOR ADDRESS SZB,RSS IF START OF TRACK ISZ TRACK DIRECTORY TRACK ADB N14  SUBTRACT 14 SECTORS SSB IF NEGATIVE THEN ADB ##SEC ADD THE NO. PER TRACK STB SECT SET NEW SECTOR ADDRESS JSB RWSUB READ THE BLOCK LDA ABUF SET ADDRESS FOR ADA .128 LAST ENTRY JMP PURG7 IN THE BLOCK SPC 2 EXPUR JSB EXSH SEARCH FOR EXTENTS TO PURGE JMP PURGE GO PURGE EXTENT SKP * P.PAS EXTERNAL * CALLING SEQUENCE * * E_0 FOR SETUP * E_1 TO MOVE OUT * * B_0 TO SET ADDRESS * B_100000 TO SET PARAMETERS * * A = ADDRESS OF FROM-TO AREA * * JSB P.PAS * DEC -N NO. OF PARAMETERS TO BE MOVED * BSS N AREA SET UP OR MOVED OUT * * IFN * ************************************** * BEGIN M1 VERSION CODE * ************************************** * * * P.PAS NOP ADB LOAD CONFIGURE THE LOAD STB MEXT AND SET IT LDB P.PAS,I GET THE COUNT STB COUNT AND SET ISZ P.PAS STEP TO PRAM AREA LDB P.PAS ADDRESS TO B SEZ IF FROM SWP SWAP ADDRESSES STB DEST SAVE THE DESTINATION ADDRESS MEXT LDB A GET ADDRESS OR IF LDB A,I STB DEST,I A WORD - SET IF ISZ DEST STEP DESTINATION INA STEP FROM ISZ COUNT STEP COUNT - DONE? JMP MEXT NO; GET NEXT ONE SEZ YES; EXIT TO JMP A,I END OF CALL JMP DEST,I SEQUENCE SPC 5 COUNT NOP DEST NOP LOAD LDB A TEST NOP XIF * ************************************** * END M1 VERSION CODE * ************************************** * SPC 2 A EQU 0 B EQU 1 . EQU 1650B KEYWD EQU .+7 XEQT EQU .+39 LN EQU * * END BEGIN zNLHHN 0 92064-18171 1709 S C0122 &TBLFP RTE-M FLOPY TABLES             H0101 ASMB,R,L,C,Z * NAME: $TBLFP * SOURCE: 92064-18171 * RELOC: 92064-16057 * PGMR: G.L.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM $TBLFP,6 92064-16057 REV.1709 770307 * * IFZ UNL XIF ENT $CDIR,$XECM EXT $SECM LST * * * MODIFY THE FOLLOWING INSTRUCTION IF MORE THAN 4 * DISKETTES ARE TO BE MOUNTED AT ANY ONE TIME. * * * #ENT EQU 0 NUMBER OF ADDITIONAL DISKETTES OTHER * THAN FIRST 4 * * IFZ UNL XIF $XECM DEF $SECM THIS WORD HOLDS THE SYSTEM SECURITY CODE * * DEF ENDIT $CDIR DEC -2 LU OF BOOT-UP DISKETTE NOP NOP REP 12 NOP REP #ENT+#ENT+#ENT+#ENT+1 NOP ENDIT EQU * * * THIS NOP MUST NOT BE MOVED OR MODIFIED NOP * SPC 10 * END s\  92064-18172 1650 S C0122 &SECM RTE-M FLPY FMP DUMMY SECURITY             H0101 ASMB,R,L,C * NAME: SECM * SOURCE: 92064-18172 * RELOC: 92064-16058 * PGMR: G.L.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM SECM,6 92064-16058 REV.1650 761005 * * ENT $SECM * * THIS ROUTINE SUPPLIES A DUMMY ENTRY POINT FOR $TBLFP * ONLY IF NO SYSTEM SEWCURITY CODE WAS ENTERED BY THE * OPERATOR IN THE "CHANGE ENTS" SECTION OF THE GENERATION. * * * $SECM EQU 0 * END   92064-18173 1805 S C0122 >FF RTE-M FLPY GTFIL SUB             H0101 ASMB,R,L,C,N * * N OPTION FOR DISKETTE SYSTEM * * Z OPTION FOR CARTRIDGE SYSTEM * * * * NAME: GTFIL * SOURCE: 92064-18173 (DISKETTE SYSTEM) * RELOC: 92064-16058 (DISKETTE SYSTEM) * PGMR: G.L.M. * * NAME: GTFIL * SOURCE: 92064-18061 (CARTRIDGE SYSTEM) * RELOC: 92064-16061 (CARTRIDGE SYSTEM) * PGMR: G.L.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * IFN NAM GTFIL,7 92064-16058 REV.1805 771017 XIF * * * * IFZ NAM GTFIL,7 92064-16061 REV.1801 771017 XIF * ENT GTFIL * EXT .DRCT,CLOSE EXT CLD.R,.P1,.P2,.P3,.P4 EXT .ENTR,$PARS,$LIBR,MGLU EXT $LIBX,$CON,.MVW EXT IFTTY,OPEN,READF,WRITF,GDCB * * * * SUP * ****** ZERO NOP ****** .5 OCT 5 DEFAULT LU'S .4 OCT 4 .6 OCT 6 OCT 6 .1 OCT 1 .2 OCT 2 ADRLU DEF * ******* * DON'T MESS WITH ANY OF THE ABOVE!!!!!!! * MSK1 OCT 140000 C.ARR NOP N6 OCT -6 * * * * * READ BSS 20 NOTE INPUT LENGTH OF 20 WORDS INAD ASC 3,INPUT OUAD ASC 3,OUTPUT LIAD ASC 3,LIST ERAD ASC 3,ERROR S1AD ASC 3,SCR1 S2AD ASC 3,SCR2 * * DO NOT CHANGE THE FOLLOWING DEF'S * THEY ARE A TABLE TO DERIVE THE PROPER ASCII MESSAGE * DEF INAD DEF OUAD DEF LIAD DEF ERAD ADSC1 DEF S1AD ADSC2 DEF S2AD * MUAD DEF * * * ***************************************************** * MESG BSS 3 ASC 2, ? OCT 3537 BELL / BACK ARROW * MESAD DEF MESG * MORE? NOP .3 OCT 3 PADDR DEFF SCR2+1 RBUF BSS 33 RBUFA DEF RBUF WD5 NOP N10 DEC -10 N12 DEC -12 N20K OCT 157777 .9 DEC 9 B77 OCT 77 ODD OCT 52525 RZERO DEF DZERO OPOP OCT 411 OPEN OPTION CON1 NOP CLSE? NOP SKP * * GTFIL NOP LDA RZERO FETCH RESET VALUE ADDR. LDB A INB DESTINATION IS (A) +1 JSB .MVW GO RESET PARMS DEF .9 NOP * * IFN CLA STA T267F XIF * * LDA GTFIL STA DGTFL SET PARM ADDR FOR .ENTR JMP DUMMY GO GET PARMS * * ******************************************************** DZERO DEF ZERO DON'T MOVE THIS(USED IN RESET) * * * OPTN DEF ZERO * ERR DEF ZERO * ANSW DEF ZERO INPT DEF ZERO * OUTP DEF ZERO * LIST DEF ZERO * ELOG DEF ZERO * SCR1 DEF ZERO * SCR2 DEF ZERO * * * ******************************************************** DGTFL NOP * DUMMY JSB .ENTR TRANSFER PARAMETERS DEF OPTN TO LOCAL AREA * CLA CLEAR ERROR RETURN STA ERR,I * LDA $CON,I FETCH CONSOLE LU AND B77 ISOLATE IT STA CON1 SAVE IT * LDA OPTN,I STA OPTN STA CLSE? IF SIGN SET--DON'T CLOSE ANSW AND ODD ISOLATE BITS THAT WOULD CAUSE OP. RESPONSE SZA,RSS IF NONE SET, SKIP ANSW FILE OPEN JMP ADFL * * * OPEN INPUT FILE/LU * LDA ANSW,I FETCH ANSWER NAME/LU LDB N20K IS THIS A NAME ? ADB A OR AN LU ?? SSB,RSS JMP OP1 @ IT'S A NAME--DO NORMAL OPEN * SZA,RSS IF DEFAULT LDA CON1 USE MTM TERMINAL STA TEMP SAVE FOR CONVERSION * * CALL ROUTINE TO CREATE MAGIC NAME * IF REQUESTED LU IS TOO LARGE OR NOT ASSIGNED * MAGIC NAME "LU..99" IS RETURNED. THIS WILL GENERATE * A ERROR -18 (BAD LU) IN THE OPEN ROUTINE. * JSB MGLU CALL ROUTINE TO BUILD MAGIC NAME DEF *+3 DEF TEMP ADDRESS OF LU TO BE CONVERTED READA DEF READ TEMP BUFFER FOR RESULT LDA READA FETCH ADDRESS OF MAGIC NAME STA ANSW SET IT FOR OPEN CALL * OP1 JSB OPEN DEF OP2 DEF GDCB DEF ERR,I DEF ANSW,I DEF OPOP * OP2 LDA ERR,I SSA JMP DGTFL,I * * SEE IF INTERACTIVE * JSB .DRCT FETCH DEF GDCB DIRECT ADDRESS OF DCB ADA .2 ADVANCE TO TYPE WORD LDB A,I FETCH IT SZB CONTINUE IF ZERO JMP DFILE NON-INTERACTIVE * INA ADVANCE TO LU STA LUAD SET LU ADDRESS JSB IFTTY DETERMINE IF INTERACTIVE DEF *+2 LUAD NOP RSS DFILE CLA STA INT 0=NO,1=YES * * * * * * ADFL LDA N6 FETCH LOOP CNTR STA MORE? SET IT * NEXT LDA OPTN FETCH OPTION PARAMETER RAR,RAR POSITION OPTION BITS TO 15/14 STA OPTN UPDATE FOR NEXT PASS * AND MSK1 (B140000) ISOLATE BITS 15&14 SZA,RSS ANY WORK? JMP BMP2 NO-TRY NEXT PASS * * FETCH ADDRESS OF CURRENT ARRAY * LDB PADDR FETCH ADDR OF END OF PARMS ADB MORE? BACK UP TO CURRENT WORK LDB B,I FETCH ADDRESS OF THAT ARRAY CPB DZERO SEE IF PARM SUPPLIED JMP EX10 EXIT NOT ENOUGH PARMS * STB C.ARR SAVE AS CURRENT ADDRESS CLB STB WD5 CLEAR STATUS WORD * SPC 5 * * IF THIS IS DEFAULT REQUEST-GO DO IT. * . ELSE OUTPUT PROPER OPERATOR QUESTION * FETCH INPUT AND PARSE** * LDA OPTN FETCH CURRENT OPTION SSA IF SIGN SET=ODD REQUEST=DEFAULT JMP DFLT * * -NOT DEFAULT- * MOVE IN PROPER MESSAGE * PNT LDA MORE? INDEX TO ADA MUAD PROPER MESSAGE TYPE LDA A,I FETCH ADDRESS(INDIRECT PROBLEM???) LDB MESAD OUTPUT BUFFER ADDRESS JSB MVIT3 MOVE MESSAGE TO BUFFER JSB WR/RE WRITE IT AND FETCH RESPONSE * * * SPC 5 * * THE INPUT BUFFER MUST BE PARSED*** * * * SET TRANS LOG TO CHAR * IF ZERO LOG, (CNTR D, OR ERROR) RETRY * LDB RLEN FETCH READ LENGTH SSB,RSS SZB,RSS JMP EX12 BAD INPUT ERROR--ABORT WORK--RETURN * CLE,ELB MAKE TRANS LOG CHAR STB RLEN SAVE IT FOR SYSTEM PARSE CMB,INB SET IT NEGATIVE STB RL2 SAVE IT TOO * LDA IBCH FETCH IBUF CHAR ADDRESS STA FBYTE SET FOR BUFFER SCAN STA TBYTE TO REPLACE ":" WITH "," * NX: JSB GTBYT FETCH BYTE CPA COLON BAD GUY? LDA COMMA YES--REPALACE IT JSB STBYT GO STORE BYTE ISZ RL2 DONE? JMP NX: NOPE --CONTINUE * LDB RLEN FETCH CHAR COUNT LDA READA FETCH ADDRESS OF INPUT BUFFER * * GO PRIV AND CALL SYSTEM PARSE ROUTINE * JSB $LIBR NOP REQUEST PRIV MODE JSB $PARS CALL SYSTEM PARSE ROUTINE DEF RBUF RESULT BUFFER JSB $LIBX RESTORE NORMAL USER MODE DEF *+1 DEF *+1 * * CHECK PARSE RESULTS * * LDB RBUFA FETCH ADDR OF RESULT BUF LDA B,I FETCH FLAG WORD 1 SZA,RSS NULL? JMP DFLT YES--THE OPERATOR DEFAULTED * CPA .2 ALPH? JMP ALPH? YES,NAME GIVEN * * NUMERIC VALUE GIVEN * INB ADVANCE TO VALUE LDA QB,I FETCH IT GTMJ CLB * STB C.ARR,I CLEAR WD1 OF ARRAY * * STLU STA TEMP SAVE LU FOR CONVERSION * * JSB MGLU GO GET MAGIC LU NAME FOR THIS GUY DEF *+3 DEF TEMP LOCATION OF LU DEF READ LOCATION FOR RESULT LDA READA ADDRESS OF RESULT LDB C.ARR FETCH CURRENT ARRAY ADDRESS INB ADVANCE TO WD2 JSB MVIT3 MOVE MAGIC NAME IN * INB ADVANCE TO SECURITY ADDRESS CLA SET IT STA B,I EQUAL TO ZERO JMP BUMP * * * ALPH? INB ADVANCE TO FIRST WD OF NAME STB A SET AS FROM ADDRESS LDB C.ARR FETCH CURRENT ARRAY ADDRESS INB ADVANCE TO WD2 JSB MVIT3 GO MOVE NAME IN * * A=ADDRESS OF FLAG FOR SECURITY CODE * B=ADDRESS OF WORD 5 OF GTF ARRAY * INB ADVANCE TO SECURITY STB TEMP SAVE ADDRESS FOR SECURITY LDB A,I FETCH FLAG INA ADVANCE TO SECURITY VALUE SZB IF DEFAULT--USE ZERO LDB A,I FETCH IT STB TEMP,I SET IT INTO WD6-GTF ARRAY ADA .3 ADVANCE TO DRN/-LU/0 FLAG LDB A,I FETCH FLAG INA ADVANCE TO VALUE SZB IF DEFAULT--USE 0 LDB A,I FETCH IT STB C.ARR,I SET IT INTO WD1 JMP BUMP * * * * * TO GET HERE EITHER: 1-THE OPTION BIT WAS ODD. * OR 2-THE OPERATOR DEFAULTED. * * DFLT LDA WD5 FETCH TEMP WORD 4 OF ARRAY CCE SET E RAL,ERA SET DEFAULT BIT STA WD5 RESET TEMP FOR MORE UPDATES * LDB .2 CHECK FOR ADB MORE? SCRATCH REQUEST SSB,RSS IF SIGN BIT SET--NOT SCRATCH REQUEST JMP SCTCH SIGN BIT NOT SET--SCRATCH-- * LDA C.ARR,I LU SUPPLIED? SZA,RSS IF NOT-- JMP DLU --GO GET DEFKAULT LU * * ALLOW BOTH POS AND NEG LU'S TO BE PASSED FROM USER * MAY WANT TO ONLY ALLOW -LU * * SSA CMA,INA MAKE IT POS JMP GTMJ GO GET MAGIC NAME * SPC 5 * * TEMP EQU GTFIL * * * * FETCH DEFAULT LU FOR THIS PASS * DLU LDA MORE? FETCH PASS CNTR ADA ADRLU LOCATE ADDRESS OF DEFAULT LU LDA A,I FETCH LU JMP GTMJ GO SET THIS INTO MAGIC NAME * * SPC 5 MVIT3 NOP JSB .MVW DEF .3 NOP JMP MVIT3,I * SPC 5 * * PRINT/READ SUBROUTINE * INT NOP WR/RE NOP * * IF NOT INTERACTIVE-SKIP PROMPT * LDA INT SZA,RSS JMP RT1 * JSB WRITF DEF RT1 DEF GDCB DEF ERR,I DEF MESG DEF .6 * * FETCH REPLY * RT1 JSB READF DEF RT2 DEF GDCB DEF ERR,I DEF READ DEF .20 DEF RLEN READ LENGTH * RT2 LDA ERR,I SZA JMP DGTFL,I JMP WR/RE,I * .20 DEC 20 * * BUMP LDA C.ARR ADA .4 POINT AT WD 4 OF ARRAY LDB WD5 FETCH DFLT//SCRN INFORMATION STB A,I SET INTO USER ARRAY * BMP2 ISZ MORE? ALL DONE? JMP NEXT NOPE-- CONTINUE * * IFN * * * LDA T267F IF WDS 27&28 WERE MODIFIED SZA,RSS GO JMP EXCLS DLD T267 RESET JSB ST278 THEM * XIF * * * EXIT * * * IF SIGN WAS SET ON GETFIL OPTION THEN DON'T CLOSE ANSW FILE * EXCLS LDA CLSE? FETCH ORIGIONAL OPTION SSA IF SIGN CLEAR GO CLOSE ANSW FILE JMP EX.2 NOPE --HARVEY WANTS IT LEFT OPEN,BYE * JSB CLOSE DEF EX.2 DEF GDCB EX.2 LDA ERR,I LOAD ERROR CODE JMP DGTFL,I * * * SPC 5 * * EX10 LDA N10 RSS * EX12 LDA N12 * STA ERR,I SET MASTER ERROR CODE WD * * THIS WD WILLh CONTAIN THE LAST ERROR CODE ONLY * JMP EXCLS SEE ABOUT CLOOSING INPUT--EXIT !! * * SKP * * SCTCH ISZ WD5 SET SCRATCH BIT * * IFZ * * * ELSE--IF B=0 GIVE SCR1 ON LCTU * --IF B=1 GIVE SCR2 ON RCTU * (B WAS SETUP BEFORE CALL TO SCTCH) * * SZB,RSS SCR1 OR 2 LDA N4 SCR1! SZB LDA N5 SCR2! STA C.ARR,I JMP BUMP * N4 OCT -4 N5 OCT -5 * XIF IFN SKP * * * INB IF ZERO--GIVE SCR1 * IF 1---GIVE SCR2 ADB B60 FORM ACSII DIGIT STB TEMP FOR FIRST CHAR (1 =SCR1, 2=SCR2) * CLB STB .P2 CLEAR -LU/+DRN WORD FOR CALL TO D.RFP * * BUILD SRCATCH NAME * LDA XEQT FETCH ID SEG ADDRESS ADA .12 ADVANCE TO NAME CLE,ELA MAKE IT A BYTE ADDRESS STA FBYTE SAVE IT FOR MOVE LDA C.ARR FETCH ADDRESS INA OF RESULT BUF CLE,ELA MAKE IT BYTE ADDRESSABLE ALSO STA TBYTE SAVE FOR MOVE * LDA N5 SET COUNTER STA RL2 FOR 5 BYTES * LDA TEMP FETCH FIRST CHAR OF NAME JSB STBYT GO SET IT * * MOVE IN PROGRAM NAME * MNME JSB GTBYT GO GET BYTE FROM NAME JSB STBYT GO SET INTO BUF ISZ RL2 BUMP COUNT, DONE?? JMP MNME NOPE * * SETUP D.RFP CALL TO CREATE SCRATCH FILE * AGAIN JSB .DRCT DEF .P3 FETCH DIRECT ADDRESS FOR MOVE STA B LDA C.ARR FETCH INA ADDRESS OF NAME JSB MVIT3 GO MOVE INTO CALL FOR CREATE * LDA T267F SEE IF WDS 27&28 SAVED YET SZA IF DONE JMP GTDNE CONTINUE * ISZ T267F SET SAVED FLAG LDA XEQT ELSE ADA .26 SAVE EM STA W27 SAVE ADDRESS FOR RESTORE DLD A,I DST T267 r* GTDNE CLA CLEAR RECORD SIZE CLB CLEAR SECURITY CODE JSB ST278 GO SET THEM INTO THE IDSEG WDS 27&28 * GTD2 CLA,INA SET STA .P1 FUNCTION CODE LDA .3 FETCH TYPE LDB .60 FETCH SIZE * JSB CLD.R GO DO IT * LDA B,I ANY ERRORS? SSA,RSS JMP OK: NOPE * CPA N2 IF DUPLICATE NAME JMP PGE GO PURGE IT OFF * SCERR LDB C.ARR FETCH RESULT BUFFER INB ADVANCE TO WD2 STA B,I SET ERROR CODE STA ERR,I SET MASTER CODE JMP BUMP GO DO NEXT GUY SPC 5 PGE LDA .P4 FETCH WORD 4 OF NAME CCE SET SIGN RAL,ERA TO INDICATE STA .P4 SCRATCH PURGE * * SET UP OPEN CALL TO D.RFP * LDA .11 SET FUNCTION CODE STA .P1 JSB CLD.R GO DOIT * LDA B,I ANY ERRORS? SSA,RSS WELL JMP AGAIN GO DO CREAT NOW JMP SCERR NOPE --SET ERROR * SPC 5 OK: INB LDA B,I LDA .P2 FETCH TR/LU AND B77 ISOLATE LU CMA,INA SET IT NEG STA C.ARR,I SAVE IT FOR CALLER * LDA C.ARR FETCH ADDRESS OF CALLER'S BUF ADA .5 ADVANCE TO SECURITY WORD CLB STB A,I SET ZERO SEC CODE JMP BUMP * * SPC 5 ST278 NOP JSB $LIBR N NOP DST W27,I JSB $LIBX DEF ST278 SPC 5 W27 NOP T267F NOP N2 OCT -2 N5 OCT -5 .11 DEC 11 .12 DEC 12 .60 DEC 60 B60 OCT 60 .26 DEC 26 T267 BSS 2 * XIF SKP * * * BYTE MOVE SUBS * * SET:FBYTE=BYTE ADDRESS OF DATA TO BE MOVED * TBYTE=BYTE ADDRESS OF RESULT FIELD * * JSB GTBYT TO FETCH BYTE--RETURNS IN LOW BYTE * * JSB STBYT SO SET BYTE--EXPECTED IN LOW BYTE * * GTBYT NOP LDA FBYTE FETCH N640ADDRESS CLE,ERA PUT BYTE FLAG INTO E LDA A,I FETCH WORD HOLDING BYTE SEZ,RSS IF HIGH BYTE ALF,ALF POSITION TO LOW] AND B377 ISOLATE REQUESTED BYTE ISZ FBYTE JMP GTBYT,I EXIT * * * * * STBYT NOP STA TEMP SAVE BYTE TO BE MOVED LDB TBYTE FETCH DESTINATION BYTE ADDRESS CLE,ERB PUT BYTE FLAG INTO E LDA B,I FETCH DESTINATION WORD SEZ,RSS REQUESTED BYTE POS TO LOW BYTE ALF,ALF AND HBYTE SAVE THE HIGH BYTE IOR TEMP INCLUDE NEW BYTE SEZ,RSS SHIFT TO HIGH BYTE IF NEEDED ALF,ALF STA B,I RESTORE DESTINATION WORD ISZ TBYTE BUMP DESTINATION ADDRESS JMP STBYT,I EXIT * * FBYTE NOP TBYTE NOP B377 OCT 377 RL2 NOP IBCH DBL READ RLEN NOP HBYTE OCT 177400 COMMA OCT 54 COLON OCT 72 * * A EQU 0 B EQU 1 XEQT EQU 1717B END 6  " 92064-18174 1650 S C0122 &GDCBF RTE-M FLPY GTFIL DCB             H0101 $ASMB,R,L * NAME: GDCB * SOURCE: 92064-18174 * RELOC: 92064-16058 * PGMR: G.L.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM GDCB,7 92064-16058 REV.1650 760504 * ENT GDCB GDCB BSS 144 END /  92064-18175 1726 S C0122 &SGLDF RTE-M FLPY SRG LOAD SUB             H0101 ]ASMB,R,L,C * NAME: SEGLD * SOURCE: 92064-18175 * RELOC: 92064-16058 * PGMR: G.L.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM SEGLD,7 92064-16058 REV.1726 770510 * * * * * * ENT SEGLD * EXT .ENTR,PMOVE EXT .MVW,OPEN,READF,CLOSE SUP * * SEGLD NOP STB XB SAVE B REGISTER IN CASE NO PARMS PASSED LDA WD5A RESET TRAILER RRECORDS STA SPCAD POINTER. * LDA DZERO STA NAMR RESET PARMS STA IERR STA XT1 STA XT2 STA XT3 STA XT4 STA XT5 LDA SEGLD STA DEGLD SET PARM ADDR FOR .ENTR JMP ENTD GO GET PARMS * * NAMR DEF ZERO IERR DEF ZERO XT1 DEF ZERO XT2 DEF ZERO XT3 DEF ZERO XT4 DEF ZERO XT5 DEF ZERO * DEGLD NOP DUMMY ENTRY POINT ENTD JSB .ENTR FETCH DEF NAMR CALL PARMS * LDA NAMR MUST HAVE CPA DZERO NAME PARM. JMP PERR ELSE--EXIT -10 * * * IF NO TEMPS -- MOVE ID TMPS TO LOCAL BUFFER * ELSE MOVE TEMPS INTO LOCAL BUFFER * * * LDA XT1 FETCH 1ST PARAMETER ADDRESS CPA DZERO ANYTHING PASSED? JMP NOPAR NOPE--NOTHING PASSED * LDA N5 SETUP TO STA LMAIN MOVE 5 PARMS INTO LDA XDEF LOCAL BUFFER STA HMAIN * L.1 LDA HMAIN,I FETCH PARAMETER ADDRESS LDA A,I FETCH PARAMETER STA HMAIN,I SAVE IT LOCALLY * * ISZ HMAIN BUMP PARAMETER ADDRESS POINTER ISZ LMAIN ALL FIVE DONE? JMP L.1 NOPE CONTINUE * LDA XEQT FETCH ID ADDRESS INA ADVANCE TO TEMP ADDRESS STA XB SET AS B FOR SEGMENT ENTRY * * * * * * FETCH PROGRAM LIMITS * PLIM LDA XEQT FETCH ADA .22 HIGH-LOW LDB DHILO VALUES FOR JSB .MVW MAIN AND DEF .4 BASE PAGE * NOP * STA W27 SAVE FOR HIGH SEG ADDR * * OPEN FILE CONTAINING * REQUESTED SEGMENT * JSB OPEN DEF RTO DEF SGDCB DEF ERRS DEF NAMR,I DEF OPENO FORCE TO BINARY * RTO LDA ERRS FETCH ERROR RETURN SSA JMP SGERR OPEN ERROR * SPC 5 * * READ ABSOLUTE RECORD * RDF0 JSB READF READ DEF RTR DEF SGDCB THRU SEGLD'S DCB DEF ERRS DEF IBUF INTO IBUF DEF .64 MAX RECORD LEGNTH DEF LEN ACTUAL READ LEGNTH RETURNED HERE * RTR SSA ERROR CODE RETURNED IN (A) JMP SGERR GOT AN ERROR --EXIT * * CHECK FOR EOF * LDA LEN FETCH LEGNTH WORD SSA SEE IF NEG (EOF?) JMP EOF GOT EOF-GO DO EOF THING * * DO CHECKSUM * LDA IBUF FETCH 1ST WORD AND LHALF ISOLATE ABS SIZE ALF,ALF GET TO LOW END STA ABSSZ SAVE ABS SIZE * * * CALCULATE AND SAVE RECORD HIGH ADDRESS * * CCB REC SIZE ADB A MINUS 1 ADB WD2 PLUS LOAD ADDRESS STB RECSZ EQUALS HIGH ADDRESS. * * CMA,INA NEGATE STA MTMP1 SAVE FOR CHECKSUM LDB WD2 FETCH WD2 AND ADDR LDA WD3A OF WORD 3 STA TMP2 * CKSM1 LDA TMP2,I FETCH NEXT WORD ADB A ADD TO CHECKSUM ISZ TMP2 BUMP WORD POINTER ISZ MTMP1 BUMP COUNT--DONE? JMP CKSM1 NO--CONTINUE * * LDA TMP2,I FETCH CHECKSUM WORD CPA B COMPARE TO CALCULATED VALUE JMP CKOK IT'S OK * SPC 3 * LDA N28 CKSUM ERROR CODE RSS BNDER LDA N27 BOUNDS ERROR RSS PERR LDA N10 PARAMETER ERROR SGERR STA IERR,I SET ERROR CODE * JSB CLOSE GO CLOSE IF OPEN DEF CEX DEF SGDCB * CEX LDA IERR,I SET A= ERROR CODE FOR RETURN JMP DEGLD,I EXIT SPC 2 N27 DEC -27 N28 DEC -28 * * SEE WHERE RECORD GOES * CKOK LDA WD2 FETCH ADDR OF RECORD CPA .2 JMP SPC MIGHT BE SPEC REC * BPLNK AND BPMSK CHECK FOR BASE PAGE CPA WD2 JMP BPR YEP- IT'S A BASE PAGE RECORD * DLD LMAIN --MAIN MEMORY RECORD-FETCH JMP CKB BOUNDS * BPR DLD LBASE FETCH BP BOUNDS * CKB JSB CKBND GO SEE IF RECORD IS WITHIN BOUNDS JMP BNDER BOUNDS ERROR * * * * COPY ABS TO MEMORY * * LDA WD3A FETCH ADDR OF WD3(FW OF CODE) LDB WD2 ACTUAL LOAD ADDR JSB PMOVE GO PRIV AND MOVE CODE IN ABSSZ NOP JMP RDF0 GO GET NEXT RECORD * * SPC 3 * * MOVE THE ID TEMPS INTO LOCAL BUFFER * * NOPAR LDA XEQT ID SEG ADDRESS INA ADVANCE TO TEMP AREA LDB XDEF LOCAL BUFFER ADDRESS JSB .MVW MOVE THEM IN DEF .5 ALL FIVE OF THEM NOP JMP PLIM CONTINE WITH PROGRAM LIMITS * * SPC CPA ABSSZ IF LEN=2 RSS THEN ITS A SPECIAL JMP BPR ---NO, MUST BE A LINK * DLD WD3 FETCH TRAILER RECORDS DST SPCAD,I SAVE IN INPUT BUFFER ISZ SPCAD ISZ SPCAD BUMP POINTER FOR NEXT SPEC REC JMP RDF0 FETCH NEXT RECORD SPC 3 * * GOT A EOF * EOF LDA N39 RELOCATABLE INPUT ERROR LDB SPCAD CPB WD5A JMP SGERR MUST HzAVE SEEN SPECIAL RECORDS * * * LDA ID27 LOCATION OF SEG HIGH ADDR(SPC REC) LDB W27 ID SEGMENT WD 27 ADDRESS JSB PMOVE GO SETIT .1 OCT 1 * JSB CLOSE DEF CRTN DEF SGDCB CLOSE SEG FILE BEFORE ENTERING THE UNKNOWN! * * * * MOVE THE PARAMETERS INTO THE ID SEGMENT * * THE PARAMETERS ARE: 1) FIVE TEMPS PASSED IN CALL (B=ID TEMP AREA) * OR 2) FIVE TEMPS FROM ID IF NOTHING PASSED * B IS NOT CHANGED. * * * CRTN LDA XDEF ADDRESS OF PARAMETERS LDB XEQT IDSEG ADDRESS INB ADVANCE TO TEMP AREA * * GO PRIV AND MOVE THEM IN * JSB PMOVE .5 OCT 5 * * LDB XB IF NO PARMS B=ORIG VALUE * ELSE B=ID TEMP ADDRESS * LDA XEQT SET A=ID SEG ADDRESS JMP WD4,I ENTER SEGMENT SPC 3 * * CKBND NOP CMA,INA ADA WD2 SSA JMP CKBND,I * CMB,INB ADB RECSZ SSB ISZ CKBND JMP CKBND,I * * * SKP * .2 DEC 2 .4 DEC 4 .22 DEC 22 .64 DEC 64 N5 DEC -5 N10 DEC -10 N39 DEC -39 IBUF BSS 64 * ZERO NOP DZERO DEF ZERO XDEF DEF XT1 XB NOP * DHILO DEF LMAIN LMAIN NOP HMAIN NOP LBASE NOP HBASE NOP DON'T CHANGE ABOVE ORDER * SPCAD NOP MTMP1 EQU SEGLD W27 NOP ERRS NOP OPENO OCT 110 FORCE TO BINARY LEN NOP LHALF OCT 177400 WD2 EQU IBUF+1 WD3 EQU IBUF+2 WD4 EQU IBUF+3 WD3A DEF IBUF+2 WD5A DEF IBUF+4 TMP2 NOP BPMSK OCT 1777 ID27 DEF IBUF+17 NEED ADDRESS TO SET SEG HIGH RECSZ NOP * * ****Z OPTION FOR CARTRIDGE * ****N OPTION FOR DISKETTE * * SGDCB BSS 144 * * XEQT EQU 1717B A EQU 0 B EQU 1 PLEN EQU * END    92064-18176 1650 S C0122 &POSNF RTE-M FLPY POSNT SUB             H0101 jASMB,L,R,C * NAME: POSNT * SOURCE: 92064-18176 * RELOC: 92064-16058 * PGMR: G.A.A. * MOD: G.L.M * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM POSNT,7 92064-16058 REV.1650 761116 * HED POSNT ENT POSNT EXT EXEC,.ENTR,RFLG$,P.PAS,READF,$KIP * * POSNT IS THE FILE POSITION ROUTINE FOR THE * RTE FILE MANAGEMENT PACKAGE * * CALLING SEQUENCE: * CALL POSNT (IDCB,IERR,NP,IR) * WHERE: * IDCB IS THE FILES DATA CONTROL BLOCK * ADDRESS * IERR IS THE ERROR RETURN ADDRESS * POSNT ERRORS ARE: * 0 NONE * -1 DISC DOWN * -5 AN ILLEGAL RECORD WASENCOUNTERED * (LENGTHS AT EACH END DID NOT MATCH * -10 NOT ENOUGH PARAMETERS * -11 DCB NOT OPEN * -12 EOF OR SOF SENSED * NP IF >0 THEN SKIP NP RECORDS * IF <0 THEN BACK SPACE NP RECORDS * IF =0 THEN NO OPERATION * IR (OPTIONAL) IF NOT CODED OR ZERO * NP IS RELATIVE OTHERWIZE * NP IS ABSOLUTE (NP MUST BE>0) SPC 3 * * POSNT NOP LDA DFZER PRE-SET OPTIONAL ENTRY PARMS STA NP STA IR CLA STA ZERO LDA POSNT TRANSFER ENTRY ADDRESS STA DOSNT TO DUMMY ENTRY POINT JMP DOSNT+1 GO FETCH CALL PARMS * * PRE STORAGE SPC 1 N10 DEC -10 N11 DEC -11 DFZER DEF ZERO ZERO NOP DCB NOP ER NOP NP DEF ZERO IR DEF ZERO SPC 1 DOSNT NOP ENTRY POINT JSB .ENTR FETCH DEF DCB ADDRESSES LDA N10 ENOUGH LDB NP PRAMS CPB DFZER SUPPLIED? JMP EXIT NO,EXIT STB RFLG$ FOURCE READS WHILE SPACING CLB,CLE SET LDA DCB UP JSB P.PAS LOCAL DEC -15 DCB RCOU NOP ADDRESSES DUM NOP TYPE NOP TYPE LU NOP LU FOR TYPE 0 EOF NOP EOF CODE FOR TYPE 0 SPACE NOP SPACING LEGAL FLAGE TYPE 0 CONND NOP LN NOP DSTAT NOP OPEN NOP OPEN FLAG ABRC NOP RCLN NOP BFPT NOP BUFFER POINTER TYPE 3AND ABOVE RWFLG NOP READ/WRIE /EOF FLAG RC NOP RECORD COUNT LDA N11 GET NOT OPEN ERROR.CODE TO A LDB OPEN,I GET OPEN FLAG TO B CPB XEQT OPEN CCE,RSS YES; SKIP;SET E JMP EXIT NO; EXIT OPEN ERROR LDA BFPT GET BUFFER POINTER ADDRESS RAL,ERA SET INDIRECT BIT STA BFPT RESET POINTER LDA IR,I GET RELATIVE /ABSOLUTE FLAG CLB ASSUME ABSOLUTE SZA,RSS RELATIVE? LDB RC,I YES; GET CURRENT RECORD NO. ADB NP,I ADD THE REQUESTED MOVEMENT STB ABRC SAVE NEW ABSOLUTE ADDRESS CMB,INB SET NEGATIVE AND ADB RC,I COMPUTE RELATIVE RECORD NUMBER CMB,INB,SZB,RSS SET TO RIGHT SIGN - ZERO? JMP EXOK YES - GO EXIT STB RCOU NO; SET COUNT SPC 1 LDA TYPE,I GET TYPE OF FILE CMA,INA,SZA,RSS TYPE ZERO? JMP TYP0 YES; GO TO TYPE ZERO ROUTINE INA,SZA TYPE; 1 INA,SZA,RSS OR 2 JMP TY1/2 YES; GO TO RANDOM ACESS POSITION SPC 1 CMB,SSB,INB TYPE 3 OR ABOVE - FORWARD JMP FSRC SPACE - YES GO DO IT. SPC 2 * TYPE 3 AND ABOVE BACKSPACE ROUTINE SPC 1 BSRC LDJA BFPT,I GET CURRENT POSITION INA,SZA IS IT EOF? JMP BSRC3 NO; GO BACKSPACE LDA RWFLG,I YES; GET THE READ/WRITE RAR,CLE,RAR FLAG AND CLEAR THE EOF BIT ELA,RAL THEN STA RWFLG,I RESTORE THE FLAG SEZ WAS IT SET? JMP BSRC5 YES; COUNT AS A RECORD BSRC3 CCB NO; BACKSPACE 1 LDA DCB WORD JSB $KIP WITH THE JMP EXIT SKIP ROUTINE LDA BFPT,I GET THE RECORD LENGTH STA RCLN SAVE IT CMA BACK SPACE TO STA B THE LDA DCB TWIN JSB $KIP WITH THE JMP EXIT SKIP ROUTINE LDA BFPT,I GET TWIN CPA RCLN TWINS MATCH? BSRC5 CCA,RSS YES; SKIP JMP ER5 NO; ERROR -5 ADA RC,I DECREMENT THE STA RC,I RECORD COUNT ISZ RCOU STEP BACKSPACE COUNT ; DONE? JMP BSRC3 NO; DO THE NEXT ONE JMP EXOK * FORWARD SPACE TYPE ZERO AND 3 AND ABOVE FILES * FSRC STB RCOU SET COUNT FSRC1 JSB READF READ DEF REART A DEF DCB,I RECORD DEF ER,I TO DEF DUM LOCAL DUMMY DEF .1 ONE WORD BUFFER DEF LN REART SSA IF ERROR JMP EXIT EXIT LDB LN SSB JMP EOFEX ISZ RCOU JMP FSRC1 JMP EXIT SPC 2 N3 DEC -3 SPC 2 * TYPE ZERO SPACE ROUTINE SPC 1 TYP0 CMB,SSB,INB IF FORWARD SPACE JMP FSRC GO TO READ ROUTINE SPC 1 LDA N3 PRESET FOR ERROR LDB SPACE,I BACK SPACE GET SSB,RSS LEGAL CODE JMP EXIT BACK SPACE NOT LEGAL-EXIT SPC 1 LDA LU,I GET AND AND B77 ISOLALE LU ADA B200 ADD BACK SPACE FUNCTION STA CONND SET FOR CALL ADA B400 MAKE A DYNAMIC STATUS RQ STA DSTAT SET IT CCA SEdT FIRST EOF RECORD FLAG SPC0 STA OPEN IN OPEN JSB EXEC CALL EXEC DEF EXRTN TO DEF .3 BACK DEF CONND SPACE EXRTN JSB EXEC DO DYNAMIC STATUS DEF STRTN DEF .3 DEF DSTAT STRTN AND B200 MASK EOF BIT CCB DECREMENT ADB RC,I THE RECORD COUNT STB RC,I CCB SET B TO FORWARD SPACE 1 SZA,RSS IF EOF TEST FOR FIRST JMP *+3 ELSE SKIP TO COUNT THE RECORD ISZ OPEN SKIP IF EOF ON FIRST RECORD JMP FSRC ELSE GO FORWARD SPACE ISZ RCOU DONE? JMP SPC0 NO; DO NEXT ONE JMP EXOK YES; GO EXIT SPC 2 N5 DEC -5 B200 OCT 200 B400 OCT 400 B77 OCT 77 SPC 2 ER5 LDA N5 LENGTH MISMATCH ERROR JMP EXIT SEND ERROR CODE SPC 1 * TYPE 1 AND TWO SPACE ROUTINE * THE NEW RECORD NO. IS SET ONLY * NO EOF CHECK IS DONE * NEGATIVE OR ZERO RECORD * NUMBERS ARE REPLACED * WITH 1 AND SOF ERROR SENT * TY1/2 LDA ABRC GET THE ABSOLUTE RECORD NO. CCE,SZA IF ZERO SSA OR NEGATIVE CLA,CLE,INA SET TO ONE STA RC,I SET NEW RECORD NO. SEZ IF FOURCED TO ONE TAKE SOF EXIT SPC 2 EXOK CLA,RSS GOOD EXIT EOFEX LDA N12 EOF/SOF EXIT SPC 1 EXIT STA ER,I SET ERROR AND JMP DOSNT,I RETURN SPC 2 N12 DEC -12 * POST STORAGE SPC 2 .1 DEC 1 .3 DEC 3 SPC 2 A EQU 0 B EQU 1 XEQT EQU 1717B SPC 1 END EQU * SPC 1 END R  92064-18177 1650 S C0122 &PURGF RTE-M FLPY PURGE SUB             H0101 YASMB,L,R,C * NAME: PURGE * SOURCE: 92064-18177 * RELOC: 92064-16058 * PGMR: G.A.A. * MOD: G.L.M * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM PURGE,7 92064-16058 REV.1650 760819Q * HED PURGE ENT PURGE EXT OPEN,EXEC EXT .ENTR,CLOSE * * SUP * * PURGE IS THE FILE DELETION ROUTINE FOR THE RTE * FILE MANAGEMENT PACKAGE * * THE FORTRAN CALLING SEQUENCE IS: * * CALL PURGE(IDCB,IERR,NAME,IS,ILU) * * W H E R E: * * IDCB IS A 144-WORD DATA CONTROL BLOCK * WHICH IS USED BY PURGE AS A * WORKING BUFFER. IDCB IS FREE * FOR OTHER USE AFTER A PURGE. * * IERR IS THE ERROR RETURN LOCATION. * * NAME IS THE NAME OF THE FILE TO BE PURGED. * * IS IS THE FILE'S SECURITY CODE. * * ILU IS THE DISC THAT THE FILE IS ON. * IF ILU >0 THEN ON DISC LABELED ILU * IF ILU <0 THEN ON DISC AT LOGICAL UNIT (-ILU) * * ERRORS RETURNED BY PURGE ARE: * * CODE REASON * 0 NO ERRORS * -1 DISC READ/WRITE ERROR * -6 FILE (OR DISC) NOT FOUND * -7 ILLEGAL SECURITY CODE * -8 FILE IS OPEN TO SOME OTHER PROGRAM * -10 NOT ENOUGH PARAMETERS * -13 DISC LOCKED * -16 ATTEMPT TO PURGE A TYPE 0 FILE * * SKP PURGE NOP LDA DZERO STA NAME STA SC STA LU LDA PURGE STA DURGE JMP DURGE+1 * * DCB NOP IERR NOP aHNAME DEF ZERO SC DEF ZERO LU DEF ZERO SPC 1 DURGE NOP ENTRY POINT JSB .ENTR DO ENTRY ROUTINE DEF DCB LDA N10 NOT ENOUGH PRAM LDB NAME ERROR CPB DZERO ? JMP EXIT YES-EXIT CLA CLEAR THE TRUNCATE WORD STA LNG AND SPC 1 JSB OPEN NO; GO DEF OPRTN OPEN DEF DCB,I EXCLUSIVELY DEF IERR,I TO DEF NAME,I CALLER DZERO DEF ZERO DEF SC,I PASS THE SECURITY CODE DEF LU,I AND THE DISC ID OPRTN SSA OPEN ERROR? JMP EXIT YES; EXIT SZA,RSS NO; TYPE ZERO JMP EX16 YES - ILLEGAL PURGE SPC 1 LDA DCB GET ADDRESS ADA .7 OF LDB A,I SECURITY SSB,RSS IF MISMATCH JMP EX7 GO SET ERROR EXIT SPC 1 ADA N2 ADDRESS OF FILE LENGTH LDA A,I GET FILE LENGTH ARS SET TO BLOCK LENGTH STA LNG SET FOR TRUNCATE CODE SPC 1 CLOS JSB CLOSE CLOSE THE FILE AND TRUNCATE TO ZERO DEF *+4 (I.E. PURGE IT) DEF DCB,I FILE DEF LU DUMMY ERROR RETURN DEF LNG TRUNCATE WORD ADDRESS LDB IERR,I GET CURRENT ERROR CODE SSB IF NONE SKIP LDA B ELSE USE IT EXIT STA IERR,I SET THE ERROR CODE JMP DURGE,I AND EXIT SPC 2 EX7 LDA .7 SET ERROR CMA,INA,RSS CODE AND SKIP EX16 LDA N16 STA IERR,I SET CODE IN USER AREA JMP CLOS GO CLOSE THE FILE SPC 3 N2 DEC -2 N10 DEC -10 .7 DEC 7 N16 DEC -16 LNG NOP ZERO NOP D.RTR ASC 3,D.RTR SPC 2 XEQT EQU 1717B A EQU 0 B EQU 1 SPC 2 END EQU * END /   92064-18178 1650 S C0122 &OPENF RTE-M FLPY OPEN SUB             H0101 ASMB,R,L,C * NAME: OPEN * SOURCE: 92064-18178 * RELOC: 92064-16058 * PGMR: G.A.A. * MOD: G.L.M * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM OPEN,7 92064-16058 REV.1650 761116 * HED OPEN * ENT OPEN EXT EXEC,CLOSE,RMPAR,$OPEN,$LIBR,$LIBX EXT .DRCT,$CON * * EXT .ENTR,.P1,.P2,.P3,.P4,.P5,CLD.R SUP * * OPEN IS THE FILE OPEN ROUTINE OF THE REAL TIME * FILE MANAGEMENT PACKAGE * * THE FORTRAN CALLING SEQUENCE IS: * * CALL OPEN(IDCB,IERR,NAME,IOP,IS,ILU,IBLK) * * W H E R E: * * IDCB IS A 144-WORD DATA CONTROL BLOCK (ARRAY) * TO BE USED WITH ALL ACCESS TO THE FILE * UNDER THIS OPEN. * * IERR IS THE RETURN ERROR CODE (ALSO RETURNED IN A) * * NAME IS THE 6-CHARACTER (3 WORD) NAME ARRAY. * * IOP (OPTIONAL); IS THE OPEN OPTION FLAG WORD * OPTIONS ARE: * BIT MEANING IF SET * 0 NON-EXCLUSIVE OPEN * 1 UPDATE OPEN * 2 FORCE TO TYPE 1 OPEN * 3 USE SUB FUNCTION IN BITS 6-11 * IF TYPE 0. * * IS (OPTIONAL); IS THE EXPECTED SECURITY CODE. * * ILU (OPTIONAL); IS THE DISC SPECIFIED. * IF ILU >0 THEN USE DISC LABELED ILU * IF ILU <0 THEN USE DISC AT LOGICAL UNIT (-ILU) * * IBLK (OPTIONAL); SPECIFIES A DCB BUFFER AREA OF * IBLK WORDS. (NORMALLY 128 IS  USED.) MUST BE A * MULTIPLE OF 128. THE BUFFER MUST BE AN EVEN * DIVISOR OF THE FILE SIZE SO ONLY PART OF * THE SPECIFIED SIZE MAY BE USED. THE USED SIZE IS: * USED SIZE=FILE SIZE/N WHERE * N=(FILE SIZE/IBLK)+(IF REMAINDER THEN 1,ELSE 0) * * OPEN ERRORS ARE AS FOLLOWS: * * -1 DISC ERROR * -6 FILE NOT FOUND * -7 WRONG SECURITY CODE * -8 FILE IS CURRENTLY OPEN (IF EXCLUSIVE REQUEST) OR * IS CURRENTLY OPEN TO 7 OTHER PROGRAMS * -9 ATTEMPT TO OPEN TYPE 0 AS TYPE 1 * -10 NOT ENOUGH PARAMETERS * -13 DISC LOCKED * * SKP * * OPEN NOP LDA DZERO PRESET ENTRY PARMS STA NAME STA OP STA SC STA LU STA IBLK CLA RESET ZERO WORD STA ZERO LDA OPEN STA DPEN JMP DPEN+1 * * MIGHT NEED TO CLEAR ZERO * DCB NOP ERR NOP NAME DEF ZERO OP DEF ZERO SC DEF ZERO LU DEF ZERO IBLK DEF ZERO SPC 1 DPEN NOP ENTRY POINT JSB .ENTR TRANSFER PARAMETERS DEF DCB TO LOCAL AREA LDA N10 LDB NAME DID WE GET CPB DZERO ENOUGH PARAMETERS? JMP EXIT NO; ERROR - EXIT SPC 1 JSB CLOSE CLOSE DEF *+2 IF DEF DCB,I OPEN SZA SKIP IF NO ERRORS CPA N11 OR IF NOT OPEN CLE,RSS JMP EXIT ELSE TAKE ERR EXIT * LDB NAME FETCH ADDRESS OF NAME PARM LDA B,I GET NAME WORD1 CPA MJ.. CHECK FOR MAJIC LU INB,RSS SO FAR SO GOOD JMP NORM NOPE--NORMAL OPEN LDA B,I FETCH NEXT TWO CHARS CPA LU.. CHECK FOR LAST PART OF "LU.." INB,RSS GOT IT,ADVANCE TO LU WORD JMP NORM CONTINUE * * * * FOUND MAGIC NAME * BUILD DUMMY DCB INFO * LDA B,I FETCH ASCII LU X STA TEMP1 SAVE IT ALF,ALF POSITION FIRST DIGIT TO LOW END AND B17 ISOLATE IT STA VALUE SAVE FOR MULT. LDA .10 FETCH BASE FOR CONVERSION MPY VALUE CONVERT TO BINARY STA VALUE SAVE RESULT LDA TEMP1 FETCH ORIGINAL ASCII VALUES AND B17 ISOLATE SECOND DIGIT ADA VALUE INCLUDE CONVERTED VALUE JSB TYPER GO GET DEVICE TYPE AND SUB-CHNL * * DEVICE TYPE RETURNS IN (A) * SUB-CHNL IS IN "SUBC" * * IF LU WAS NOT ASSIGNED, A ERROR-18 (ILLEGAL LU) EXIT * IS TAKEN FROM TYPER * LDB B100 FETCH EOF CODE FOR MT TYPE DEVICES ADA N7K SEE IF TYPE GREATER THAN 17 SSA,RSS WELL? JMP STEOF YES IT IS--GO STORE THE EOF CODE * * CHECK FOR 2644\5\7 CTU'S * LDA EQT5 RESTORE TYPE CODE CPA B24K IS THIS DVR05 RSS YES--SKIP JMP BRF NOPE GO TRY SOMETHING ELSE LDA SUBC FETCH SUBCHANNEL CPA .1 LCTU? JMP STEOF YES --GO SET EOF CODE(B100) CPA .2 RCTU? JMP STEOF YES-- SEE ABOVE^^^^^^^^^^^^ * * BRF LDB B1000 EOF CODE FOR PUNCH CPB EQT5 IT'S ALSO TYPE CODE FOR DVR02 RSS YEP IT'S A PUNCH--USE EOF CODE IN B LDB B1100 EVERYONE ELSE DEFAULTS TO 1100B STEOF STB EOF SAVE CODE * * * * SET UP REQUIRED DCB ADDRESSES * * LDA DCB INA STA DCB1 INA STA DCB2 INA STA DCB3 INA STA DCB4 INA STA DCB5 INA STA DCB6 INA STA DCB7 ADA .2 STA DCB9 ADA .5 STA DCB14 * * * * BUILD DCB INFO * LDA DUM SET DUMMY STA DCB,I DCB FLAG LDA EQT5 FETCH TYPE CODE STA DCB1,I SAVE IT CLA STA DCB2,I SET TYPE * LDA OP,I FETCH SUBFUNCTION AND B3700  ISOLATE GOOD BITS IOR VALUE INCLUDE LU STA DCB3,I SAVE IT LDA EOF INCLUDE EOF CODE NOW IOR VALUE STA DCB4,I SET FOR DCB MOVE * * LDA BOTHW CODE FOR RW,SP,SC MATCH STA DCB5,I STA DCB6,I STA DCB7,I * LDA XEQT STA DCB9,I * CLA,INA STA DCB14,I * LDA VALUE FETCH LU AGAIN SZA IF ZERO LU--ALLOW WRITE ONLY JMP NOZRO NOT ZERO-CONTINUE INA SET FOR WRITE ONLY STA DCB6,I SAVE READ WRITE CODE * * SEE IF PRE-FUNCTION IS REQUIRED * NOZRO LDB OP,I FETCH OPTION WORD BLF,BRS POSITION TO SLB THE INHIBIT BIT(#13) LDA EQT5 PUNCH? CPA B1000 PUNCH? JMP IH? GO SEE IF LEADER HAS BEEN INHIBITED CPA B400 PHOTO READR LDA B700 CONTROL CODE TO SET EOT SZA,RSS IF NOT ONE OF ABOVE SKIP CONTROL JMP SPCN1 SPCFN LDB VALUE FETCH LU IOR B COMBINE FOR CONTROL WORD STA VALUE DON'T NEED LU ANY MORE-- * JSB EXEC DEF SPCN1 DO DEF .3 SPECIAL PRE-FUNCTION--(SET EOT DEF VALUE IF PHOTO READR,PUNCH LEADER ON PUNCH) * * * * SPCN1 CLA JMP EXIT2 * * * B400 OCT 400 B700 OCT 700 BOTHW OCT 100001 DUM OCT 177400 B17 OCT 17 .10 DEC 10 B100 OCT 100 B1000 OCT 1000 N7K OCT 170777 B24K OCT 2400 B1100 OCT 1100 SPC 2 DCB1 NOP DCB2 NOP DCB3 NOP DCB4 NOP DCB5 NOP DCB6 NOP DCB7 NOP DCB9 NOP DCB14 NOP MJ.. ASC 1,LU LU.. ASC 1,.. TEMP1 NOP VALUE NOP EQT5 NOP SUBC NOP EOF NOP * * * INHIBIT BIT SET? * * IH? SLB,RSS IF INHIBIT BIT NOT SET JMP SPCFN GO DO LEADER * CLA STA DCB1,I PREVENT TRAILER ON CLOSE JMP SPCN1 DON'T DO LEADER SPC 5 * * * * TYPER SUBROUTINE * FETCHES DEVICE TYPE AND SUB-CHNL * LDA LU * JSB TYPER * RETURNS DEVICE TYPE IN (A) * * * * * TYPER NOP STA VALUE * JSB EXEC DEF STRTN DEF STAT DEF VALUE DEF EQT5 DEF EOF DEF SUBC * STRTN JMP ERN18 BAD LU EXIT * * LDA EQT5 AND TYPE ISOLATE TYPE CODE BITS STA EQT5 * * LDB MIDSK MINIMUM DISK DRIVER TYPE-1 ADB A IF LESS--OK SSB WELL??? JMP TYPER,I IT'S OK SO GET OUT * LDB MADSK MAXIUM DISK DRIVER TYPE+1 ADB A CHECK IT SSB OK IF GREATER OR ZERO JMP ERN17 * JMP TYPER,I * * STAT OCT 100015 TYPE OCT 37400 MADSK OCT 162000 NEG TYPE 34 MIDSK OCT 164400 NEG TYPE 27 ND18 DEC -18 ND17 DEC -17 * * * ILLEGAL LU(ASSIGNED TO DISK) OPEN * ERN17 LDA ND17 RSS * BAD LU EXIT * ERN18 LDA ND18 JMP EXIT2 * * SKP * * * * NORMAL FILE OPEN * **************** * * NORM LDB $CON,I FETCH WORD HOLDING NEW RUN FLAG SSB,RSS IF NOT SET--SKIP JMP NORM2 * JSB $LIBR GO NOP PRIV ELB,CLE,ERB AND CLEAR STB $CON,I IT. * * * JSB $LIBX DEF *+1 DEF *+1 RETURN TO NON-PRIV MODE * * NORM2 LDA NAME,I LDB OP,I AND OPTION ERB EXCLUSIVE BIT TO E CME INVERT AND RAL,ERA SET IN SIGN OF A STA .P3 SET FOR CALL TO D.RTR ISZ NAME GET DLD NAME,I REST OF SZA,RSS CHECK FOR NULL FROM ON PROCESSOR LDA BLK FILL WITH BLANK SZB,RSS SAME CHECK LDB BLK FILL WITH BLANKS DST .P4 LDA .11 FETCH OPEN CODE STA .P1 SET IN CALL LDA LU,I FETCH CR\LU STA .P2 SET IN CALL JSB CLD.R GO GET D.RFP * JSB RMPAR YES; GET THE RETURN DEF *+2  CODES DEF ID TO LOCAL AREA LDA ID GET ERROR WORD SSA IF ERROR JMP EXIT EXIT DLD ID+1 ELSE SET DST DCB,I THE DCB FOR $OPEN CLO SET O LDA OP,I TO RAR,SLA,RAR INDICATE STO UPDATE OPTION ERA AND E FOR TYPE 1 OVER-RIDE STA LU SAVE FLAG LDA DCB GET DCB ADDRESS LDB SC,I AND SECURITY CODE JSB $OPEN AND GO SET UP THE DCB DEF IBLK,I ADDRESS OF BLOCK SIZE DEF ID+4 ADDRESS OF NO OF SECTORS PER TRACK JMP OPEN1 ERROR - CLOSE AND EXIT SSA IF OPEN PROTECT SSB AND CODE MISMATCH THEN SKIP JMP OPEN2 ELSE GO EXIT - GOOD OPEN SPC 2 LDA N7 SET EXIT CODE OPEN1 STA ID IN ID JSB CLOSE ILLEGAL OPEN SO CLOSE DEF *+2 THE DEF DCB,I FILE OPEN2 LDA ID SEND ERROR CODE LDB LU GET SUB FUNCTION FLAG SLB IF NOT SET SZA OR NOT TYPE ZERO JMP EXIT THEN EXIT SPC 1 LDB DCB CACULATE DCB SUB FUNCTION ADB .3 ADDRESS STB SC SAVE IT LDA OP,I GET THE OPTIN SUB FUNCTION AND B3700 MASK IT OFF STA B AND SAVE IT LDA SC,I GET THE CURRENT WORD AND B77 SAVE THE LU ADA B ADD IN THE NEW SUB FUNCTION STA SC,I SET IT IN THE DCB CLA CLEAR A AND EXIT SPC 1 EXIT LDB DCB IF NO ERRORS, ADB .2 THEN REPLACE THE SIZE SSA,RSS WITH THE TYPE LDA B,I IF NO ERRORS EXIT2 STA ERR,I SET THE ERROR CODE JMP DPEN,I AND RETURN SPC 2 SPC 3 DZERO DEF ZERO N10 DEC -10 N11 DEC -11 ID NOP NAME1 BSS 4 N7 DEC -7 ZERO NOP .1 OCT 1 .2 DEC 2 .3 DEC 3 .59*($ OCT 5 B3700 OCT 3700 B77 OCT 77 BLK ASC 1, .11 DEC 11 SPC 3 A EQU 0 B EQU 1 XEQT EQU 1717B SPC 3 END EQU * END V*  % 92064-18179 1650 S C0122 &CREAF RTE-M FLPY CREAT SUB             H0101 4ASMB,R,L,C * NAME: CREAT * SOURCE: 92064-18179 * RELOC: 92064-16058 * PGMR: G.A.A. * MOD: G.L.M * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM CREAT,7 92064-16058 REV.1650 761024 * HED CREAT ENT CREAT EXT CLOSE,$OPEN,.ENTR EXT $LIBR,$LIBX,CLD.R,.P1,.P2,.P3,.P4,.P5 EXT NAM..,RMPAR EXT EXEC EXT D.R SUP * * * CREAT IS THE FILE CREATION MODULE OF THE REAL TIME * FILE MANAGEMENT PACKAGE. * * THE FORTRAN CALLING SEQUENCE IS: * * CALL CREAT(IDCB,IERR,NAME,ISIZE,ITYPE,IS,ILU,IBLK) * O R * IER = CREAT(IDCB,IERR,NAME,ISIZE,ITYPE,IS,ILU,IBLK) * * W H E R E: * * IDCB IS THE ADDRESS OF A 144-WORD ARRAY WHICH * CREAT WILL USE AS A SCRATCH AREA. IF * ISIZE<0 THEN THE CREATED FILE IS ALSO * OPENED TO THIS DATA CONTROL BLOCK. * * IERR IS THE ADDRESS TO WHICH THE ERROR CODE * IS RETURNED. THIS INFORMATION IS ALSO * RETURNED IN THE A REGISTER. * * ERROR CODES ARE: * * >0 THE CREAT WAS SUCCESSFUL - THE #SECTORS IS RETURNED * -1 THE DISC IS DOWN * -2 DUPLICATE NAME * -4 FILE TOO LONG * -6 CARTRIDGE NOT FOUND * -10 NOT ENOUGH PARAMETERS IN THE CALL * -13 DISC LOCKED * -14 DIRECTORY FULL * -15 ILLEGAL NAME * -16 ILLEGAL TYPE OR SIZE * * * * NAME IS A 3-WORD ARRAY CONTAINING THE NEW FILE'S NAME. * THE NAME MUST CONTAIN ONLY LEGAL ASCII * CHARACTERS INCLUDKING EMBEDDED BLANKS. COMMAS, * + SIGN, - SIGN ARE NOT ALLOWED. * IN ADDITION THE FIRST * CHARACTER MUST BE NON-NUMERIC AND NON-BLANK. * * ISIZE A TWO-WORD ARRAY. WORD 1 IS THE SIZE IN * 124-WORD DOUBLE SECTORS. WORD 2 IS USED * ONLY FOR TYPE 2 FILES AND IS THE RECORD LENGTH. * * ITYPE IS THE FILE TYPE--MUST BE >0. * * IS (OPTIONAL); IS THE FILE'S SECURITY CODE. * IF IS>0 THE FILE IS WRITE PROTECTED. * IF IS<0 THE FILE IS OPEN PROTECTED. * IF IS=0 OR IS NOT CODED THE FILE IS PUBLIC. * * ILU (OPTIONAL); DIRECTS THE CREAT TO: * IF ILU<0 THEN THE DISC AT LOGICAL UNIT (-ILU). * IF ILU>0 THEN THE DISC WITH LABEL ILU. * IF ILU=0 OR NOT CODED, THE FIRST AVAILABLE * DISC WITH ENOUGH ROOM IS USED. * * IBLK (OPTIONAL); SPECIFIES A DCB BUFFER AREA OF * IBLK WORDS. (NORMALLY 128 IS USED.) MUST BE A * MULTIPLE OF 128. THE BUFFER MUST BE AN EVEN * DIVISOR OF THE FILE SIZE SO ONLY PART OF * THE SPECIFIED SIZE MAY BE USED. THE USED SIZE IS: * USED SIZE=FILE SIZE/N WHERE * N=(FILE SIZE/IBLK)+(IF REMAINDER THEN 1,ELSE 0) * * * SCHEDULE PARAMETERS FOR D.RFP * * P1. FUNCTION CODE (1) * P2. +CR\-LU * P3. NAME 1,2 * P4. 3,4 * P5. 5,6 * (A) TYPE * (B) FILE SIZE * W27 RECORD SIZE * W28 SEC CODE * SKP CREAT NOP LDA DZERO STA SC STA LU STA TYPE STA IBLK LDA CREAT STA DREAT JMP DREAT+1 * DCB NOP IERR NOP NAME NOP SIZE NOP TYPE DEF ZERO SC DEF ZERO LU DEF ZERO IBLK DEF ZERO SPC 1 DREAT NOP ENTRY POINT JSB .ENTR TRANSFER THE PARAMETERS DEF DCB LDA TYPE MAKE SURE THERE ARE CPA DZERO ENOUGH JMP ER 10 NO - ERROR EXIT JSB CLOSE GO CLOSE THE DCR (IF OPEN) DEF *+2 DEF DCB,I SZA NO ERROR CPA N11 AND NOT OPEN ERROR - OK RSS SO SKIP IF THIS IS THE CASE JMP EXIT ELSE EXIT SOME CLOSE ERROR * * * JSB NAM.. GO CHECK THE NAME DEF *+2 DEF NAME,I SZA IF OK SKIP JMP EXIT ELSE EXIT ERROR SPC 2 LDA NAME,I GOOD NAME SO STA .P3 SET ISZ NAME UP DLD NAME,I SKELETON DIRECTORY DST .P4 ENTRY IN BUF LDA TYPE,I SZA TYPE MUST BE SSA >0 JMP ER16 NOT >0 ; ERR STA .P6 LDB SIZE,I GET THE SIZE BLS DOUBLE TO GET 64-WORD SECTORS SSB MUST BE >0 OR CCB SET TO -1 SZB,RSS IF ZERO JMP ER16 ERROR STB .P7 SET ISZ SIZE STEP TO RECORD SIZE CPA .2 IF NOT TYPE TWO CLA,RSS THEN JMP CREA4 SKIP SIZE TEST LSR 10 SHIFT TO A FOR DIVIDE DIV SIZE,I IF OVER FLOW THE RECORD SIZE TO SMALL SOC IF OK SKIP JMP ER4 ELSE ERROR FILE TOO LARGE CREA4 LDA SIZE,I LDB .P6 GET TYPE CPB .1 IF TYPE=1 LDA .128 SET SIZE TO 128 CPB .2 IF TYPE TWO SIZE MUST BE GIVEN SSA,RSS SIZE GIVEN? RSS YES; OR NOT TYPE TWO SKIP JMP ER4 ELSE ERROR CREA3 STA .P8 SET RECORD SIZE LDA SC,I SET STA .P9 SECURITY CODE CLA,INA SET STA .P1 FUNCTION CODE LDA LU,I SET STA .P2 THE LU/CR WORD * * SAVE WDS 27 AND 28 OF IDSEG * THEN PASS PARMS 8&9 IN THEIR SPOT * * UPON RETURN FROM D.RFP RESTORE ORIGIONAL CONTENTS * * LDA XEQT FETCH IDSEG ADDRESS ADA .26 ADVANCE TO ADDRESS OF WD27 STA T27 SAVE IT DLD A,I FETCH 27&28 DST WD27 SAVE EM DLD .P8 FETCH PARMS 8&9 JSB ST267 SET THEM INTO IDSEG DLD .P6 SET A&B=PARMS 6&7 JSB CLD.R GO CALL D.RFP * * SPC 2 SPC 2 JSB RMPAR YES; DEF *+2 CALL RMPAR DEF .P1 TO GET RETURN CODES * * RESET 27&28 * DLD WD27 JSB ST267 * LDA .P1 GET D.RTR COMPLETION SSA CODE - OK JMP EXIT NO; TAKE EXIT LDA .P2 YES; SET UP STA DCB,I TO CALL LDB DCB $OPEN CLE,INB TO LDA .P3 OPEN STA B,I THE LDA DCB FILE LDB SC,I STO SET UP FOR A UPDATE OPEN JSB $OPEN SET UP REST OF DCB DEF IBLK,I ADDRESS OF BLOCK SIZE DEF .P5 ADDRESS OF NO OF SECTORS/TRACK JMP EXIT DISC ERROR - EXIT LDA TYPE,I GET TYPE ADA N3 IF 3 OR MORE SSA SKIP TO WRITE EOF JMP EXIT0 NOT RANDOM ACCESS FILE CCA SET WRITTEN ON AND EOF FLAG IN DCB LDB DCB GET WRITE FLAG ADB .13 ADDRESS STA B,I SET WRITTEN ON FLAG ADB .3 STEP TO THE BUFFER AND SET EOF STA B,I IN FIRST WORD OF BUFFER EXIT0 LDA .P1 NO; USE D.RTR RETURN FOR ERROR EXIT STA IERR,I SET ERROR CODE JMP DREAT,I AND EXIT SPC 3 ER4 LDA N4 SET ERROR JMP EXIT CODE ER10 LDA N10 AND JMP EXIT EXIT SPC 3 ER16 LDA N16 GET THE ERROR CODE JMP EXIT TAKE EXIT SPC 3 TMP NOP N16 DEC -16 N10 DEC -10 N11 DEC -11 N3 OCT -3 N4 OCT -4 .1 OCT 1 .2 DEC 2 .3 OCT 3 .4 DEC 4 .9 DEC 9 .5 DEC 5 .13 DEC 13 .128 DEC 128 DLU NOP TRACK NOP ZERO NOP DZERO DEF ZERO .P6 NOP .P7 NOP .P8 NOP .P9 NOP T27 NOP WD27 BSS 2 .26 DEC 26 * * ST267 NOP JSB $LIBR NOP DST T27,I JSB $LIBX DEF ST267 * * SPC 3 A EQU 0 B EQU 1 XEQT EQU 1717B SPC 1 END EQU * SPC 1 END }  $ 92064-18180 1650 S C0122 &NAMFF RTE-M FLPY RENAME SUB             H0101 9ASMB,R,L,C * NAME: NAMF * SOURCE: 92064-18180 * RELOC: 92064-16058 * PGMR: G.A.A. * MOD: G.L.M * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM NAMF,7 92064-16058 REV.1650 761118 * HED NAMF EXT EXEC,.ENTR,CLOSE,NAM..,OPEN EXT CLD.R,.P1,.P2,.P3,.P4,.P5 ENT NAMF * * NAMF IS THE FILE NAME CHANGE MODULE OF THE * RTE FILE MANAGEMENT PACKADGE. * * CALLING SEQUENCE: * * CALL NAMF(IDCB,IERR,NAME,NNAME,IS,ILU) * * WHERE: * IDCB IS A 144 WORD DATA CONTROL BLOCK * THIS AREA IS FREE AFTER THE CALL. * * IERR IS THE ERROR RETURN LOCATION * ERRORS ARE RETURNED HERE AND IN * THE A REGISTER. * DEFINED ERRORS ARE: * * * 0 NO ERROR * -1 DISC DOWN * -2 DUPLICATE NAME * -6 CARTRIDGE OR FILE NOT FOUND * -7 INVALID SECURITY CODE * -8 FILE CURRENTLY OPEN * -10 NOT ENOUGH PARAMETERS * -13 THE REQUIRED DISC IS LOCKED * -15 ILLEGAL NEW NAME * * NNAME THE NEW 6 CHARACTER FILE NAME * * IS OPTIONAL - THE FILE SECURITY CODE * * ILU OPTIONAL - THE FILES DISC ID. * * PRECEEDING CONSTANTS * N7 DEC -7 .7 DEC 7 N10 DEC -10 SPC 3 NAMF NOP ENTRY POINT LDA DZERO X REP 3 STA *-X+NNAME CLA STA ZERO LDA NAMF STA DAMF JMP DAMF+1 * * DCB DEF ZERO IERR DEF ZERO NAME DEF ZERO NNAME DEF ZERO IS DEF ZERO ILU DEF ZERO * * DAMF NOP JSB .ENTR FETCH PARAM ADDRESSES DEF DCB TO LOCAL LIST SPC 1 LDA N10 LOAD FOR NOT ENOUGH PRAM REJECT LDB NNAME NEW NAME SUPPLIED? CPB DZERO JMP EXIT NO; GO EXIT SPC 1 JSB NAM.. YES;NEW NAME DEF NAM.R LEGAL DEF NNAME,I FOR A FILE NAME? NAM.R SZA JMP EXIT NO; EXIT JSB OPEN CALL DEF OPRTN TO DEF DCB,I OPEN DEF IERR,I THE DEF NAME,I FILE DEF ZERO EXCLUSIVELY DEF IS,I WITH DEF ILU,I USER PRAMS OPRTN SSA SUCESSFUL OPEN? JMP EXIT NO; EXIT LDA DCB YES; CHECK ADA .7 THE LDB A,I SECURITY LDA N7 CODE SSB,RSS MATCH? JMP CLOEX NO; CLOSE AND EXIT * * * LDA .2 STA .P1 LDB DCB LDA B,I STA .P2 INB LDA B,I STA .P3 DLD NNAME,I DST .P4 LDA NNAME ADA .2 LDA A,I JSB CLD.R * * LDA B,I ERROR FLAG TO A STA NAME SAVE IT SPC 1 EXR4 RSS SKIP ERROR ENTRY CLOEX STA NAME SAVE ERROR CODE JSB CLOSE CLOSE DEF CLOR1 THE DEF DCB,I FILE CLOR1 LDB NAME GET ERROR CODE SZB IF NONE SKIP LDA B ELSE USE IT EXIT STA IERR,I SET RETURN ERROR JMP DAMF,I EXIT TO USER SPC 3 * FOLLOWING CONSTANTS SPC 1 ZERO NOP DZERO DEF ZERO SPC 2 * TEMPS REFERENCED ONLY BY DEFS SPC 1 .2 DEC 2 SPC 2 * ASSEMBLY AIDS SPC 1 A EQU 0 B EQU 1 XEQT EQU 1717B SPC 1 END EQU * PROG. LENGTH SPC 1 END 0  # 92064-18181 1650 S C0122 &CLOSF RTE-M FLPY CLOSE SUB             H0101 :ASMB,R,L,C * NAME: CLOSE * SOURCE: 92064-18181 * RELOC: 92064-16058 * PGMR: G.A.A. * MOD: G.L.M * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM CLOSE,7 92064-16058 REV.1650 761019 * HED CLOSE ENT CLOSE EXT EXEC,.ENTR,R/W$,CLD.R,.P1,.P2,.P3,.P4 SUP * * THIS IS THE CLOSE SUBROUTINE--A PART OF THE * REAL-TIME FILE MANAGEMENT PACKAGE * * THE ASSEMBLY CALL TO CLOSE A FILE IS: * * JSB CLOSE * DEF RTN RETURN ADDRESS * DEF IDCB DATA CONTROL BLOCK ADDRESS * DEF IERR (OPTIONAL) ERROR CODE RETURNED HERE AND IN A REG * DEF IRX (OPTIONAL) NO. OF 128 WORD DOUBLE *RTN SECTORS TO BE DELETED FROM THE FILE * * ERRORS ARE: * 0 NONE * -1 DISC DOWN * -10 NOT ENOUGH PARAMETERS * -11 FILE NOT OPEN * -13 DISC LOCKED * * * SKP CLOSE NOP LDA DZERO STA IDCB STA IRX LDA DM STA IERR CLA STA ZERO STA .P1 FUNCTION CODE FOR CLOSE LDA CLOSE STA DLOSE JMP DLOSE+1 * * * IDCB DEF ZERO DCB ADDRESS IERR DEF IDCB ERROR CODE ADDRESS IRX DEF ZERO TRUNICATE CODE ADDRESS SPC 1 DLOSE NOP ENTRY POINT JSB .ENTR TRANSFER THE ADDRESSES DM DEF IDCB LDA IDCB IF NO PARAMETERS CPA DZERO THEN JMP ER10 ERROR EXIT INA STEP TO WORD TWO LDB A,I FETCH OFFSET SECTOR STB .P3 SAVE FOR D.RTR CALL ADA .8 ADD 8 TO GET THE THE OIPEN FLAG STA OPNFL SAVE THE OPEN FLAG ADDRESS LDB A,I GET THE OPEN FLAG ADA N2 BACK UP TO THE STA SC SAVE THE SECURITY CODE ADDRESS CPB XEQT FILE OPEN? CLE,RSS YES SKIP JMP ER11 NO; ERROR EXIT LDB IDCB GET THE DCB ADDRESS * LDA B,I IF MAGIC LU OPEN CPA FAKE DON'T CALL D.RFP JMP DUMMY JUST CLOSE DCB AND GET OUT * JSB R/W$ CALL TO FLUSH THE BUFFER JMP EXIT DISC ERROR EXIT LDB IDCB GET THE TYPE FLAG ADB .2 LDA B,I A SZA IF ZERO NO TRUNCATE LDA IRX,I DISC FILE SET TRUNCATE CODE ALS ADJUST FOR 64 WORD SECTORS ADB .13 STEP TO EXTENT WORD LDB B,I IF NOT SZB FIRST EXTENT CLA DO NOT ALLOW TRUNCATION LDB SC,I GET THE SECURITY FLAG SSB,RSS IF BAD SC CLA DIS ALLOW TRUNCATION CMA,INA SET NEGATIVE STA .P4 SAVE FOR D.RFP * LDA IDCB,I SET DIRECTORY ADDRESS FOR D.RFP STA .P2 JSB CLD.R SCHED D.RFP RSS SKIP MAGIC LU EXIT WORK * DUMMY CLB SPC 2 CLA STA OPNFL,I CLEAR THE OPEN FLAG LDA B,I YES; GET ERROR RETURN STA IRX SAVE THE ERROR CODE * * * * IF MAGIC LU OPEN AND PUNCH-- * THEN DO TRAILER----- * LDB IDCB FETCH DCB ADDRESS LDA B,I FETCH CONTENTS CPA FAKE IF MAGIC LU OPEN-- RSS CONTINUE JMP EXI ELSE--ALL DONE * INB ADVANCE TO DEVICE TYPE WORD LDA B,I FETCH IT ADB .3 ADVANCE TO EOF CODE STB CLOSE SAVE ITS ADDRESS CPA PUNCH IS IT A PUNCH??? RSS YEP--GO DO TRAILER JMP EXI NOPE--SO ALL DONE * * * JSB EXEC DEF EXI 8d DEF .3 CONTROL CALL DEF CLOSE,I EOF CODE * EXI LDA IRX RESTORE ERROR CODE * EXIT STA IERR,I SET THE ERROR CODE JMP DLOSE,I EXIT ERROR CODE IN A SPC 3 ER11 CCA FILE NOT OPEN - ERROR 11 ER10 ADA N10 NOT ENOUGH PRAMS - ERROR 10 JMP EXIT GO EXIT SPC 3 FAKE OCT 177400 PUNCH OCT 1000 N10 DEC -10 N2 DEC -2 .2 OCT 2 .3 OCT 3 .8 DEC 8 .13 DEC 13 SC NOP OPNFL NOP ZERO NOP DZERO DEF ZERO SPC 2 SPC 3 A EQU 0 B EQU 1 XEQT EQU 1717B SPC 1 END EQU * SPC 1 END  $ 92064-18182 1650 S C0122 &CLDRF RTE-M FLPY DIR PRG CALL SUB             H0101 ASMB,R,L,C * NAME: CLD.R * SOURCE: 92064-18182 * RELOC: 92064-16058 * PGMR: G.A.A. * MOD: G.L.M * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM CLD.R,7 92064-16058 REV.1650 761013 * HED CALL ROUTINE FOR D.RF 761013B ENT CLD.R,.P1,.P2,.P3,.P4,.P5 EXT EXEC,$D.RF,$OPSY,$CON * * * THIS ROUTINE PROVIDES A CENTRAL * CALLING POINT FOR THE SCHEDULING * OF D.R. * * * RTE-M1 MAY NOT HAVE THE SCHEDULING * ABILITY FOUND IN M2 & M3. THEREFORE * THIS ROUTINE WILL DO A DIRECT ENTRY * IN THE M1 ENVIRONMENT IF THE DIRECTORY * MANAGER ($D.RF1) WAS NOT RELOCATED INTO * THE RESIDENT LIBRARY. * * * * .P1 NOP .P2 NOP .P3 NOP .P4 NOP .P5 NOP TMPA NOP TMPA2 NOP * CLD.R NOP ENTRY POINT DST TMPA SAVE THE A AND B REGS LDA $D.RF FETCH THE SUBROUTINE FLAG SSA,RSS WAS M1 VERSION LOADED?(DUMMY ENT =-1) JMP M1 YES--GO DO DIRECT ENTRY IF M1 * LDA TMPA RESTORE A JSB EXEC NOW SCHED DEF BACK D.R WITH DEF SCED WAIT AND QUEUE DEF D.RF PASSING DEF .P1 THE FIVE TEMPS IN THE CALL. DEF .P2 FOUR MORE PARMS MAY BE PASSED BY DEF .P3 USING WDS 27&28 OF CALLERS ID SEG DEF .P4 ALONG WITH THE A AND B REGS. D.R CAN THEN DEF .P5 DETERMINE HIS FATHERS ID ADDRESS AND PROCEDE * TO FETCH ANY EXTRA PARMS AS REQUIRED * BACK JMP ERR8 SC6,  HEDULE ERROR * EXIT TO CALLING PROG. * RETURN PARMS MAY BE FETCHED BY RMPAR * * JMP CLD.R,I * * M1 LDA $OPSY FETCH OP SYS TYPE CPA N7 ALLOW RE-ENTRANT CALL ONLY IN M1 RSS OK---SKIP JMP ERR26 NO!!!! GIVE ERROR AND ABORT * JSB $D.RF DIRECT ENTRY TO D.R IN LIBRARY DEF M1BK DEF .P1 * M1BK JMP CLD.R,I EXIT, SEE ABOVE FOR INFO ON RETURN PARMS * * N7 DEC -7 * SCED OCT 100027 D.RF ASC 3,D.RFP * * ERR8 LDA E8 SCHEDULE ERROR RSS ERR26 LDA E26 ATTEMPT TO USE M1 SUB IN 2/3 SYS STA CPE SET THE ERROR CODE * LDA $CON,I FETCH LU FOR MESSAGE AND B77 ISOLATE LU STA LU SAVE IT FOR CALL * JSB EXEC DEF P1TN DEF .2 DEF LU DEF EBUF DEF .5 * P1TN LDB XEQT FETCH IDSEG ADDRESS ADB .12 ADVANCE TO NAME LDA B,I MOVE STA PN1 FIRST WORD INB DLD B,I FETCH NEXT TWO STA PN2 SET WORD 2 SWP GET LAST WORD TO A AND HBYTE ISOLATE HIGH BYTE IOR B40 INCLUDE BLANK STA PN3 SET INTO BUF * JSB EXEC DEF P2TN DEF .2 DEF LU DEF ABUF DEF .8 * P2TN JSB EXEC DEF *+2 DEF .6 * * .2 OCT 2 .5 OCT 5 .6 OCT 6 .12 DEC 12 B40 OCT 40 B77 OCT 77 HBYTE OCT 177400 LU NOP E8 ASC 1,08 E26 ASC 1,26 EBUF ASC 4, FMGR 0 CPE BSS 1 ABUF ASC 1, PN1 NOP PN2 NOP PN3 NOP ASC 4, ABORTED .8 DEC 8 * * XEQT EQU 1717B B EQU 1 * * END EQU * END   $ 92064-18183 1650 S C0122 &DD.RF RTE-M FLPY DUMMY ENT             H0101 1ASMB,R,L,C * NAME: DD.RF * SOURCE: 92064-18183 * RELOC: 92064-16058 * PGMR: G.L.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM DD.RF,7 92064-16058 REV.1650 761010 * ENT $D.RF * * THIS ROUTINE SUPPLIES A DUMMY ENTRY POINT FOR CLD.R * ONLY IF WE ARE NOT IN A M1 SYSTEM. IN WHICH CASE, THE * DIRECTORY MANAGER MUST HAVE BEEN RELOCATED INTO THE MEM- * RESIDENT LIBRARY. IF THIS WAS NOT DONE, THIS ENTRY POINT * WILL CAUSE THE PROGRAM TO BE ABORTED (FMGR 026). * * * * * * $D.RF OCT -1 * END  $ 92064-18184 1650 S C0122 &READF RTE-M FLPY READ/WRITE SUB             H0101 ,lASMB,R,L,C * NAME: READF * SOURCE: 92064-18184 * RELOC: 92064-16058 * PGMR: G.A.A. * MOD: G.L.M * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM READF,7 92064-16058 REV.1650 761115 * HED READF ENT READF,WRITF EXT EXEC,R/W$,.ENTR,P.PAS EXT RW$UB,$KIP EXT D$XFR EXT RFLG$ SUP * * * THIS IS THE RTE FILE MANAGEMENT PACKAGE * READ/WRITE SUBROUTINE. * * THIS ROUTINE WILL READ OR WRITE ANY TYE FILE. * * * CALLING SEQUENCE: * * CALL READF(IDCB,IERR,IBUF,IL,L,N) * * O R * * IER = READF(IDCB,IERR,IBUF,IL,L,N) * * TO READ, O R * * CALL WRITF(IDCB,IERR,IBUF,IL,N) * * O R * * IER = WRITF(IDCB,IERR,IBUF,IL,N) * * TO WRITE. * * * W H E R E: * * IDCB IS THE 144 WORD DATA CONTROL BLOCK * FOR THE REFERENCED FILE. * * IERR IS THE ERROR RETURN LOCATION * ERRORS ARE AS FOLLOWS: * * CODE ERROR CONDITION * 0 OR >0 NO ERROR * -1 A REQUIRED DISC OR DEVICE IS DOWN * -5 ILLEGAL RECORD NUMBER OR * ATTEMPT TO READ A RECORD NOT WRITTEN * -7 INVALID SECURITY CODE FOR * WRITE (FILE IS READ ONLY) * -10 A REQUIRED PARAMETER IS MISSING * -11 THE DCB IS NOT OPEN * -12 SOF OR EOF SENSED ON READ * -17 ILLEGAL REQUEST TO A TYPE ZMuER0 FILE * * IER SEE IERR - RETURNED AS FUNCTION * * IBUF IS THE BUFFER TO BE USED TO READ OR WRITE. * * IL IS THE REQUESTED TRANSFER LENGTH IN WORDS. * * L IS THE LENGTH AS READ IN WORDS. * * N IS THE REQUESTED RECORD NUMBER * IF N>0 OR IF N<0 THE RELATIVE RECORD * NUMBER FROM THE CURRENT POSITION. * N IS LEGAL ON TYPE 1 AND 2 FILES ONLY. * * * O P T I O N S: * * IL IS OPTIONAL ON TYPE 1 AND 2 FILES. * ON TYPE 1 FILES, 128 IS USED; * ON TYPE 2 FILES THE RECORD LENGTH IS USED. * * L IS OPTIONAL AT ALL TIMES. * * N IS OPTIONAL AND IS IGNORED ON FILES * OF TYPES OTHER THAN 1 AND 2. IF NOT * SUPPLIED, ZER0 IS USED. * THE FIRST RECORD IN A FILE IS RECORD #1. * * * E X T E R N A L S: * * RW$UB IS USED TO READ OR WRITE WORDS * FROM OR TO FILES OF TYPE 2 OR * ABOVE. IT HANDLES ALL SECTOR, * TRACK, AND EXTENT SWITCHING FOR * THESE FILES AND ALSO WRITES AND/OR * READS BLOCKS FROM THE FILE AS * REQUIRED. READS ARE CONDITIONAL * ON RFLG$. A GLOBAL FLAG WHICH * MUST BE NON-ZER0 BEFORE A READ * IS EXECUTED. * * RW$UB CALLING SEQUENCE IS: * * LDB #WORDS * LDA DCB ADDRESS * CLE/CCE WRITE/READ * JSB RW$UB CALL * DEF UBUF ADDRESS OF USER'S BUFFER * JMP ERROR ERROR RETURN (A = CONDITION) * -- NORMAL RETURN SKP WRITF NOP WRITE ENTRY POINT LDA WRITF TRANSFER RETURN ADDRESS STA DEADF TO READ ENTRY JMP RST AND GO TO PRESET ENTRY PARMS * READF NOP READ ENTRY POINT LDA READF FETCH AND STA DEADF TRANSFER RETURN ADDRESS TO DUMMY ENTRY mCCA SET RST STA ENTFG ENTRY FLAG(POS FOR WRITF/NEG FOR READF) * * * PRE-SET ENTRY PARMS * LDA N17 STA BUF LDA DMBUF STA IL LDA DZER0 STA L STA N CLA STA ZER0 STA DM JMP DEADF+1 GO FETCH CALL PARMS * * SPC 3 DCB NOP DCB POINTER IERR NOP ERROR BOX BUF OCT -17 USER BUFFER ADDRESS IL DEF DM REQUEST LENGTH L DEF ZER0 RETURN LENGTH N DEF ZER0 RECORD NUMBER * * DEADF NOP READ ENTRY POINT JSB .ENTR TRANSFER THE DEF DCB PARAMETERS LDA DCB SET UP THE CLB,CLE DCB JSB P.PAS ADDRESSES N17 DEC -17 TMP NOP USE FIRST TWO AS BFSZ EQU TMP TMP1 NOP TEMP STORAGE TYPE NOP ADDRESS OF TYPE LU0 NOP LU (FOR 0 FILE) TRACK EQU LU0 ALSO TRACK EOF0 NOP EOF CODE (0 FILE) BSECT EQU EOF0 ALSO SECTOR SPAC NOP SPACING CODE (0 FILE) SIZE EQU SPAC ALSO FILE SIZE RL NOP RECORD LENGTH SCMO NOP SECURITY/OPEN MODE #SC/T NOP SECTORS/TRACK OCFLG NOP OPEN FLAG TR NOP CURRENT TRACK SECT NOP CURRENT SECTOR BUFPT NOP CURRENT POSITION RWFLG NOP READ/WRITE FLAG RC NOP RECORD COUNT TMP2 NOP BUFD NOP SPC 2 LDA N10 PRESET FOR MISSING PRAM ERROR LDB BUF BUFFER MUST BE SSB SUPPLIED JMP EXIT ELSE MISSING PRAM * LDB OCFLG,I IF NOT OPEN LDA N11 CPB XEQT THEN RSS JMP EXIT EXIT FILE NOT OPEN * LDB ENTFG GET READ WRITE FLAG LDA SCMO,I AND SECURITY CODE ARS,ALR CLEAR LEAST AND SIGN BITS STA BFSZ SAVE BLOCK LENGTH XOR SCMO,I GET THE SECURITY CODE/]UDATE FLAG SSB,RSS IF WRITE SSA AND JMP SCOK BAD SECURITY * LDA N7 THEN EXIT STA IERR,I SET THE ERROR CODE JMP DEADF,I RETURN * * ENTFG NOP SPC 2 SCOK RRL 1 SHIFT SIGN TO LOW A STA RFLG$ USE A READ FLAG LDB L,I GET N FOR WRITE SLA,ARS IF READ LDB N,I GET READ N LDA TYPE,I GET TYPE CPA .2 TWO JMP LTEST GO TEST FOR EOF * CPA .1 IF TYPE ONE CLA,RSS SKIP JMP EOFTS ELSE GO TO EOF TEST * RANDOM ACCESS FILE SPC 1 STA RWFLG,I INHIBIT R/W$ WRITE FOR TYPE ONE FILES LDA .128 FOURCE LENGTH TO 128 FOR TYPE 1 FILES STA RL,I FOR THE POSITION ROUTINE SPC 1 LTEST LDA IL,I GET THE REQUEST LENGTH SSA IF EOF REQUEST THEN JMP EXIOK GO EXIT NO ACTION * SZB POSITION OPTION? SSB YES IF <0 ADB RC,I ADD CURRENT POSITION STB TMP2 SAVE RESULT CCA ADA B MULTIPLY RECORD LENGTH SSA IF NEG RECORD NO JMP EOFEX TAKE ERROR EXIT * MPY RL,I BY THE DESIRED RECORD DIV BFSZ COMPUTE THE BLOCK AND OFFSET STB OCFLG SAVE THE OFFSET CLB NOW COMPUTE THE SECTOR ADDRESS MPY BFSZ OF THE BLOCK ASR 6 EVEN SECT ADDRESS TO A STA TMP SAVE CMA CHECK FOR ADA SIZE,I EOF SSA IF NOT EOF SKIP JMP EOFEX TAKE ERROR EXIT * LDA TMP RESTORE A ADA BSECT,I ADD THE BASE SECTOR DIV #SC/T,I DIVIDE BY NO. SECT/TRACK ADA TRACK,I ADD BASE TRACK-A = TRACK DST TMP SAVE NEW TR/SECTOR ADDRESS CPA TR,I IF SAME CCA AS CPB SECT,I CURRENT LDB 0 POSITION vJ CLE,SSB THEN JMP RACS SKIP * LDB DCB ELSE JSB R/W$ WRITE THE CURRENT BLOCK JMP EXIT IF NECESSARY * DLD TMP THEN SET DST TR,I THE NEW SPC 2 ADDRESS RACS LDA OCFLG SET THE OFFSET ADA BUFD ADD BUFFER ADDRESS STA BUFPT,I AND SET THE POINTER LDA TMP2 SET THE STA RC,I NEW RECORD NUMBER SPC 2 EOFTS LDA BUFPT SET THE INDIRECT ADA MSIGN BIT ON STA BUFPT THE BUFFER POINTER LDA TYPE,I GET FILE TYPE CMA,INA,SZA,RSS IF 0 JMP TYP00 OR 1 * INA,SZA,RSS GO DO 0/1 THING JMP .1TYP * INA,SZA,RSS IF TYPE 2 JMP TWOTY GO DO READ TEST * INTS LDA RWFLG,I GET THE IN CORE FLAG CCE,SZA IF IN CORE JMP TWOSP GO TEST FOR TWO * LDB DCB ELSE READ JSB R/W$ THE BLOCK JMP EXIT ERROR EXIT SPC 2 TWOSP LDA TYPE,I GET THE TYPE AGAIN TWORW LDB RL,I GET THE RECORD LENGTH (TYPE 2) CPA .2 IF TYPE 2 JMP .2RW GO DO READ WRITE SPC 2 * * TYPE 3 AND ABOVE READ/WRITE LOOP * LDA ENTFG SET READ WRITE FLAG ELA IN E 0=> WRITE 1=>READ LDB BUFPT,I GET CURRENT WORD SSB,RSS IF <0 THEN EOF JMP RDLEN NO <0 - SKIP * LDA RWFLG,I EOF RAR,RAR SET (READ) OR CLEAR (WRITE) ELA,RAL EOF SENT STA RWFLG,I BIT IN DCB LDA ENTFG GET THE DIRECTION AGAIN SSA,RSS IF WRITE JMP SWRI GO BACK UP THE COUNT IF REQUIRED * * READ AT EOF * EOFT0 STA L,I FOR EOF HERE WITH A = -1 CLA,SEZ IF FIRST EOF SKIP EOFEX LDA N12 ELSE EOF ERROR SSA,RSS IF FIRST EOF THEN ISZ RC,I STEP THE RECORD COUNT JMP EXIT GO EXIT * * WRITE AT EOF * SWRI CLA,SEZ  IF THE EOF WAS PASSED TO THE USER CCA THEN BACK UP THE RECORD COUNT ADA RC,I SO WE DON'T COUNT TWO OF STA RC,I THEM CLB,CLE RECOVER THE E BIT FOR WRITE STB RFLG$ CLEAR THE READ FLAG RDLEN CCB,SEZ IF READ JMP RDLE1 SKIP WRITE CHECKS * LDA IL,I GET REQUEST LENGTH CMA,CCE,SSA,INA,RSS IF WRITE EOF JMP EOFWR GO WRITE EOF * ADA BUFPT,I COMPARE NEW LENGTH TO OLD LDB RFLG$ GET READ FLAG CLE,SZA IF NEW LENGTH = OLD SZB,RSS OR IF NOT UPDATE JMP RDLE2 CONTINUE WRITE SPC 1 ERR5 LDA N5 ELSE UPDATE ERROR JMP EXIT GO EXIT SPC 1 RDLE1 LDA DMBUF GET LENGTH RETURN ADDRESS RDLE2 CLB,SEZ,INB,RSS IF WRITE LDA IL USE REQUEST LENGTH STA BUA SET ADDRESS OF BUFFER LDA DCB SET THE DCB ADDRESS JSB RW$UB GO READ FIRST LENGTH WORD BUA DEF L,I JMP EXIT ERROR EXIT * LDB A .2RW LDA ENTFG GET READ/WRITE FLAG ELA TO E CLA,SEZ,RSS IF WRITE THEN SKIP JMP WRIT WRITE SO SKIP * LDA IL CHECK IF LENGTH SUPPLIED CPA DMBUF IF COMPARE THEN NO LENGTH CLA,RSS NOT SUPPLIED SO FORCE TRANSFER LDA B SUPPLIED SO CHECK FOR RECORD CMA,INA TOO LONG FOR ADA IL,I BUFFER SSA SKIP IF OK LDB IL,I TOO LONG SO USE SUPPIED LENGTH STB L,I SET AS RETURN LENGTH WRIT STA SKIP SAVE RESIDUE FOR SKIP AFTER READ LDA DCB DCB TO A JSB RW$UB READ THE RECORD DEF BUF,I TO USER BUFFER JMP EXIT ERROR EXIT * LDB TYPE,I GET FILE TYPE CPB .2 IF 2 JMP EXIOK-1 THEN DONE - GO EXIT * LDA DCB SET UP TO SKIP LDB SKIP THE RESIDUE CMB,SSB,INB SET + NO WORDS SKIP IF >0 JMP NOSKP <0 SO DON'T SKIP * JSB $KIP GO SKIP THE WORDS JMP EXIT ERROR EXIT * NOSKP LDA ENTFG ELSE ELA SET TO CLA,SEZ,RSS READ /WRITE THE LDA IL TWIN WORD STA BUFAA WORD LDA DCB TO DUM CLB,INB OR FROM JSB RW$UB USER. BUFAA NOP JMP EXIT ERROR - EXIT * CPA BUA,I IF TWIN MISMATCH CCB,RSS JMP ERR5 THEN BAD RECORD - EXIT * LDA RFLG$ GET READ FLAG CLE,SZA,RSS IF NOT READING JMP EOFWR GO SET EOF IN FILE * EXT0 ISZ RC,I STEP THE RECORD COUNT EXIOK CLA DONE - OK SO JMP EXIT EXIT SPC 2 EOFWR STB BUFPT,I SET EOF IN DCB ELB,RBL SET UP THE EOF READ FLAG AND THE STB RWFLG,I WRITTEN ON AND EOF FLAG IN THE DCB JMP EXT0 GO EXIT SPC 2 TWOTY LDB RFLG$ GET READ WRITE FLAG SZB IF READING JMP INTS GO TEST FOR IN CORE * JMP TWOSP ELSE GO WRITE. SPC 2 * * TYPE 0 OR 1 FILE -- TRANSFER FROM CORE * .1TYP LDA IL GET LENGTH ADDRESS LDB A,I GET LENGTH CPA DMBUF IF NOT SUPPLIED THEN LDB .128 USE 128 STB IL SAVE LOCALLY ADB B177 ROUND UP LSR 7 GET # OF SECTORS COVERED STB SKIP SAVE ROUNDED LENGTH ADB RC,I = # OF 128 WORD RECORDS STB TMP SAVE NEW RECORD # ADB N1 SUBTRACT 1 (RECORD #'S START AT 1) BLS CONVERT TO 64 WORD SECTORS CMB,INB SUBTRACT ADB SPAC,I FROM FILE SIZE SSB IF OUT OF FILE JMP EOFEX TAKE EOF EXIT SPC 2 LDA SKIP GET ROUNDED LENGTH LSL 7 SET TO CORRECT POSITION LDB ENTFG AND SSB,RSS RESET IF STA IL WRITE LDA IL GET XFER LENGTH FOR D$XFR SSB IF READ THEN  STA L,I SET THE RETURN LENGTH ELB SET E FOR DXFR$ CALL LDB BUF GET THE BUFFER ADDRESS STB BUFA SET IT IN THE CALL LDB DCB GET THE DCB ADDRESS JSB D$XFR GO DO THE TRANSFER BUFA NOP JMP EXIT ERROR RETURN * LDA TMP SET THE NEW STA RC,I RECORD COUNT JMP EXIOK AND EXIT SPC 1 TYP00 LDB ENTFG IF READ STB TMP SET READ WRITE FLAG FOR EOF TEST LDA RL,I GET THE READ WRITE LEGAL FLAG SSB,RSS IF WRITE RAR SHIFT THE WRITE FLAG TO BIT 15 SSA,RSS TEST THE FLAG JMP EX17 ILLEGAL REQUEST GO EXIT SPC 1 CCA IF READ SSB THEN JMP TYP01 SKIP * CPA IL,I EOF? JMP EOFW0 YES; GO MAKE CONTROL RQ SPC 1 TYP01 CLA,CCE,INA SET UP THE REQUEST CODE SSB,RSS FOR THE CALL INA AND ELA,RAR STA RQ IT. JSB EXEC CALL DEF RTN THE DEF RQ EXEC DEF LU0,I FOR DEF BUF,I I/O DEF IL,I TO/FROM USER BUFFER. RTN JMP EX17 DRIVER REJECTED CALL - ERROR. ISZ TMP TEST READ WRITE JMP EXT0 GO EXIT IF WRITE * STB L,I SET THE RETURN LENGTH SPC 1 RAL,CLE,ELA PUT THE DOWN BIT IN E ALF,RAL SHIFT THE EOF BIT RAL TO BIT 15 SSA IF EOF BIT SET JMP EOF00 GO DO EOF THING * SZB IF ZER0 WORDS READ THEN SKIP JMP EXT0 ELSE GO EXIT GOOD XFER * AND B70 MASK THE HIGH ORDER TYPE BIT SEZ,CCE,SZA IF NOT DOWN OR IF TYPE <10 THEN EOF JMP TYP00 ELSE RETRY THE XFER SPC 1 EOF00 CCA,CLE JMP EOFT0 DO EOF TYPE ZER0 EXIT SPC 2 EOFW0 JSB EXEC WRITE TYPE ZER0 EOF DEF EOFRT RETURN ADDRESS DEF .3I 640CATCH ERRORS DEF EOF0,I DEF N1 EOFRT RSS IF ERROR RETURN THE CODE JMP EXIOK SPC 3 EX17 LDA N17 SET UP ILLEGAL REQUEST FLAG JMP EXIT GO EXIT SPC 2 * * * C O N S T A N T S N1 OCT -1 .1 OCT 1 .2 OCT 2 .3I DEF 3,I .128 DEC 128 MSIGN DEF 0,I DZER0 DEF ZER0 ZER0 NOP DMBUF DEF DM DM NOP N11 DEC -11 N10 DEC -10 N7 OCT -7 N12 DEC -12 N5 OCT -5 B177 OCT 177 B70 OCT 70 SPC 5 SKIP NOP RQ NOP SPC 3 A EQU 0 B EQU 1 XEQT EQU 1717B SPC 1 PLENG EQU * END 6  - 92064-18185 1650 S C0122 &POSTF RTE-M FLPY POST SUB             H0101 ASMB,R,L,C * NAME: POST * SOURCE: 92064-18185 * RELOC: 92064-16059 * PGMR: G.A.A. * MOD: G.L.M * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM POST,7 92064-16059 REV.1650 761024Q * HED POST - CLEAR THE DCB BUFFER ENT POST EXT .ENTR,R/W$ * * * THE POST ROUTINE CLEARS THE DCB BUFFER BY POSTING ANY * DATA THAT NEEDS TO BE WRITTEN ON THE DISC. IT WILL IN * ALL CASES CLEAR THE INCORE FLAG SO THE NEXT FILE * ACCESS WILL FOURCE A DISC READ. * * POST IS TO BE USE WITH THE RN LOCK FEATURE AS * FOLLOWS: * * POST * LOCK * * DO YOUR THING * * POST * UNLOCK * * CALLING SEQUENCE: * * CALL POST(DCB,ER) * * WHERE: * * DCB IS THE DCB ARRAY * ER IS THE OPTIONAL RETURN ERROR CODE * * POST NOP CLA PRE-SET STA ER CALL LDA POST PARMS STA DOST MOVE PARM ADDRESS JMP DOST+1 TO DUMMY ENTRY POINT * DCB NOP ER NOP DOST NOP ENTRY POINT JSB .ENTR GET THE PRAM ADDRESSES DEF DCB LDB DCB CHECK ADB D9 THAT THE DCB LDA B,I IS OPEN CPA XEQT YES? JMP OK YES! * LDA N11 NO RETURN ERROR EREX STA ER,I SET THE ERROR CODE CLB SET ER ADDRESS STB ER FOR NEXT TIME JMP DOST,I EXIT * OK LDB DCB GET THE DCB ADDRESS CLE SET E FOR WRITE JSB R/W$ GO POST THE BUFFER JMP EREX DISC ERROR GO EXIT * W   CLA ALL IS GOOD SET OK ERROR CODE JMP EREX AND GO EXIT * D9 DEC 9 N11 DEC -11 XEQT EQU 1717B A EQU 0 B EQU 1 END p   ' 92064-18186 1650 S C0122 &RWNDF RTE-M FLPY REWIND SUB             H0101 HASMB,R,L,C * NAME: RWNDF * SOURCE: 92064-18186 * RELOC: 92064-16059 * PGMR: G.A.A. * MOD: G.L.M * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM RWNDF,7 92064-16059 REV.1650 760817 * HED RWNDF ENT RWNDF EXT .ENTR,RWND$,EXEC EXT R/W$ * THE MODULE OF THE RTE FILE MANAGER PERFORMS * THE REWIND OR RESET FUNCTION * * A FILE IS RESET TO EXTENT 0 RECORD 1 VIA RWND$ * A TYPE ZERO UNIT IS REWOUND VIA AND EXEC CALL * * * CALLING SEQUENCE * * CALL RWNDF(IDCB,IER) * * WHERE: * * IDCB IS THE FILES DATA CONTROL BLOCK ARRAY * * IER IS THE ERROR RETURN LOCATION. * ERRORS ARE RETURNED IN THE A REG * ALSO. * ERRORS CODES ARE: * 0 NO ERROR * -11 DCB NOT OPEN * * SPC 2 * PRE CONSTANT AREA SPC 1 .3 DEC 3 TYPE NOP .2 OCT 2 .7 DEC 7 .5 DEC 5 SPC 3 RWNDF NOP LDB DFDM PRESET STB DCB ENTRY STB IER ADDRESSES LDA RWNDF MOVE RETURN ADDRESS STA DWNDF TO DUMMY ENTRY POINT JMP DWNDF+1 GO DO IT * DCB DEF DCB IER DEF DCB SPC 1 DWNDF NOP ENTRY POINT JSB .ENTR FETCH DFDM DEF DCB PRAM ADDRESSES SPC 1 LDB DCB GET DCB ADDRESS ADB .2 INDEX TO TYPE AND STB TYPE SET ADDRESS ADB .7 INDEX TO OPEN FLAG AND LDA B,I FETCH CPA XEQT OPEN? CLA,INA,RSS YES; SE;  T AWRWND RECORD COUNT/SKIP JMP NOOPN NO; TAKE ERROR EXIT ADB .5 INDEX TO RECORD COUNT AND STA B,I SET RECORD COUNT LDA TYPE,I GET TYPE CLE,SZA IF NOT ZERO JMP DISC GO DO DISC THING SPC 1 ISZ TYPE TYPE =0 -STEP TO LU LDA TYPE,I FETCH LU AND AND B77 ISOLATE IT THEN ADA B400 ADD THE REWIND BIT STA TYPE AND SAVE FOR EXEC SPC 1 JSB EXEC CALL EXEC TO DEF EXRTN REWIND DEF .3 TYPE DEF TYPE ZERO FILE EXRTN CLA,RSS SET ERROR CODE AND SKIP TO EXIT NOOPN LDA N11 NOT OPEN- EXIT -11 EXIT STA IER,I SET ERROR CODE JMP DWNDF,I RETURN SPC 2 * MID CONSTANT AREA SPC 1 B77 OCT 77 B400 OCT 400 N11 DEC -11 SPC 3 DISC LDB DCB SET UP AND JSB R/W$ WRITE THE BLOCK IF NECESSARY JMP EXIT IF ERROR EXIT SPC 1 LDB DCB DISC FILE-CALL CLA RWND$ JSB RWND$ TO SET UP DCB JMP EXIT ERROR RETURN JMP EXRTN NORMAL RETURN SPC 2 * POST CONSTANT AREA SPC 1 A EQU 0 B EQU 1 XEQT EQU 1717B SPC 1 END EQU * SPC 1 END ]  !( 92064-18187 1650 S C0122 &APOSN RTE-M FLPY ABS POSN SUB             H0101 `ASMB,R,L,C * NAME: APOSN * SOURCE: 92064-18187 * RELOC: 92064-16059 * PGMR: G.A.A. * MOD: G.L.M * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM APOSN,7 92064-16059 REV.1650 761021 * HED APOSN ENT APOSN EXT $KIP,NX$EC,RFLG$,.ENTR,LOCF SPC 1 * THE APOSN ROUTINE DOES ABSOLUTE FILE POSITIONING * OF RTE FILES * * CALLING SEQUENCE: * * CALL APOSN(IDCB,IERR,IREC,IRS,IOFF) SPC 1 * WHERE: * * IDCB IS THE FILES DATA CONTROL BLOCK * * IERR IS AN ERROR RETURN FLAG. POSSIBLE ERRORS, * 0 NO ERROR * -1 DISC DOWN * -5 SPACING BEYOND END OF DEFINED EXTENT * -9 ATTEMPT TO POSITION TYPE ZERO FILE * -10 NOT ENOUGH PARAMETERS * -11 DCB NOT OPEN * -12 SOF IE IREC <1 * * IREC THE RECORD NUMBER TO BE READ NEXT * * IRS (REQUIRED FOR 3 & ABOVE ONLY) THE * RELATIVE BLOCK OF THE NEXT RECORD * * * IOFF THE BLOCK OFFSET OF THE NEXT * RECORD (REQUIRED FOR TYPE 3 AND * ABOVE ONLY) * SPC 5 * PRE CONSTANT STORAGE SPC 2 TYPE NOP .2 DEC 2 .5 DEC 5 N11 DEC -11 N3 DEC -3 RC EQU TYPE SPC 5 APOSN NOP CLA PRE-SET CALL PARMS STA IRC STA IOFF LDA APOSN STA DPOSN MOVE ENTRY ADDRESS TO DUMMY ENTRY POINT. JMP DPOSN+1 GO FETCH CALL PARMS * DCB NOP ER NOP IRC NOP IRS NOP IOFF NOP SPC 1 DPOSN NOP ENTRY POHINT JSB .ENTR FETCH PRAM DEF DCB ADDRESSES SPC 1 CLB,INB SET THE READ STB RFLG$ FLAG LDB DCB COMPUTE ADB .2 TYPE STB TYPE AND ADB .5 STEP TO BLOCK LENGTH LDA B,I FETCH ARS,ALR AND ALF,ALF CONVERT RAL TONUMBER OF 128 WORD BLOCKS STA BLKSZ SAVE ADB .2 STEP TO OPEN FLAG LDA N11 IS LDB B,I DCB CPB XEQT OPEN? INA,RSS YES; SKIP JMP EXIT NO; EXIT INA SET A= 9 LDB TYPE,I IS FILE TYPE SZB,RSS ZERO? JMP EXIT YES; EXIT ADB N3 IF TYPE 1 OR 2 LDA IRC TEST FOR RECORD PRAM SSB,RSS ELSE TEST LDA IOFF FOR FULL PRAM SZA,RSS LIST JMP ER10 NOT ENOUGH PRAMS - EXIT SSB IF 1 OR 2 JMP RCSET GO SET RECORD NO. SPC 1 JSB LOCF USE LOCF TO DEF LOCRT GET DEF DCB,I CURRENT DEF ER,I RELATIVE DEF RC SECTOR DEF CIRS ADDRESS LOCRT CLB CALL LDA DCB SKIP JSB $KIP TO JMP EXIT SET UP NX$EC CLB CACULATE LDA CIRS THE RELATIVE DIV BLKSZ BLOCK CMA,INA NUMBER STA CIRS CLB LDA IRS,I DESIRED DIV BLKSZ AND SWP SET FOR ADB CIRS NS$EC CALL SZB,RSS IF ALREADY THERE JMP RCSET SKIP POSITION CALL JSB NX$EC POSITION WITH NX$EC JMP EXIT ERROR - EXIT RCSET RRL 7 LDB DCB GET DCB ADB .12 COMPUTE BUFFER POINTER ADDRESS STB CIRS ADB IOFF,I COMPUTE DESIREDED ADB .4 CONTENTS ADB A ADD THE NO OF 128 WORD BLOCKS STB CIRS,I AND SET u ISZ CIRS STEP TO THE ISZ CIRS RECORD NUMBER LDB IRC,I SET RECORD NUMBER SZB ZERO SSB OR NEG JMP ER12 EXIT ERROR STB CIRS,I SET THE RECORD NUMBER CLA,RSS OK - EXIT ER10 LDA N10 EXIT STA ER,I SET ERROR CODE JMP DPOSN,I RETURN. SPC 2 ER12 LDA N12 SEND EOF ERROR JMP EXIT SPC 2 * POST CONSTANTS SPC 1 N12 DEC -12 .4 DEC 4 .12 DEC 12 N10 DEC -10 BLKSZ NOP CIRS NOP SPC 2 A EQU 0 B EQU 1 XEQT EQU 1717B SPC 1 END EQU * SPC 1 END  "* 92064-18188 1650 S C0122 &LOCFF RTE-M FLPY LOCF SUB             H0101 ASMB,R,L,C * NAME: LOCF * SOURCE: 92064-18188 * RELOC: 92064-16059 * PGMR: G.A.A. * MOD: G.L.M * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM LOCF,7 92064-16059 REV.1650 760819 * HED LOCF ENT LOCF EXT P.PAS,.ENTR SPC 2 * * * LOCF RETURNS THE CURRENT STATUS OF A * RTE FILE TO THE CALLER. * SPC 1 * * THE FORTRAN CALLING SEQUENCE IS: * SPC 1 * CALL LOCF(IDCB,IERR,IREC,IRS,IOFF,JSEC,JLU,JTY,JREC) * SPC 1 * * W H E R E: * SPC 1 * IDCB IS THE DATA CONTROL BLOCK FOR THE FILE. * * IERR IS THE ERROR CODE RETURN. * POSSIBLE CODES ARE: * 0 - NO ERROR * -11 - DCB NOT OPEN * -10 - NOT ENOUGH PARAMETERS * * IREC IS THE RECORD NUMBER OF THE NEXT RECORD. * * IRS IS THE RELATIVE SECTOR OF THE NEXT RECORD./2 * * IOFF IS THE OFFSET IN THE SECTOR OF THE NEXT RECORD. * * JSEC IS THE NO. OF SECTORS IN THE FILE (OR EXTENT). * * JLU IS THE FILE'S LOGICAL UNIT. * * JTY IS THE FILE'S TYPE. * * JREC IS THE RECORD SIZE. * SPC 1 * ALL PARAMETERS AFTER IREC ARE OPTIONAL. * SKP LOCF NOP LDA DFDM STA IER STA IREC STA IRS STA IOFF STA JSEC STA JLU STA JTY STA JREC * LDA LOCF STA DOCF JMP DOCF+1 * SPC 5 DCB NOP IER DEF DM IREC DEF DM IRS DEF DM IOFF DEF DM JSEC DEF DM JLU DEF DM JTY DEF DM JREC DEF DM `DOCF NOP ENTRY JSB .ENTR GET DFDCB DEF DCB PARAMETERS ADDRESSES LDA N10 NOT ENOUGH LDB IREC PRAM CPB DFDM TEST JMP EXIT NOT ENOUGH - EXIT LDA DCB SET A TO GET DCB CLB,CCE SET TO GET ERB,CLE ACTUAL WORDS JSB P.PAS CALL TO PASS N16 DEC -16 DCB LU NOP PARAMETERS AD NOP TYP NOP TRK NOP SEC NOP #SEC NOP SIZE NOP COUNT NOP SEC/T NOP OPCLS NOP CTRK NOP CSEC NOP BUFPT NOP TMP NOP REC NOP EXNO NOP LDB OPCLS IS LDA N11 FILE CPB XEQT OPEN? JMP OK YES; JUMP EXIT STA IER,I NO; SET EXIT CODE JMP DOCF,I EXIT SPC 3 OK LDB REC GET AND STB IREC,I SET RECORD NO. LDB #SEC SET STB JSEC,I THE FILE SIZE IN SECTORS LDA TYP GET THE TYPE CMA,INA,SZA,RSS SET NET AND TEST FOR ZERO JMP TYPST ZERO SO JUMP ADA .2 IF THREE OR GREATER SSA THEN JMP NOTRA JUMP NOT RANDOM ACCESS CCA COMPUTE THE OFFSET ADA REC AND BLOCK MPY SIZE FOR STA TMP TYPE AND B177 ONE AND STA IOFF,I TWO XOR TMP FILES ASR 7 NOW JMP STRS GO STORE IT NOTRA LDA DCB COMPUTE CMA,INA CURRENT ADA BUFPT BUFFER OFFSET ADA N16 ADJUST FOR BUFFER ADDRESS CLB RE ADDJUST OFFSET TO DIV .128 128 WORD BLOCK BASE STB IOFF,I STA TMP SAVE OVERFLOW LDA #SEC GET AND CLE,ERA DIVIDE BY TWO TO GET BLOCKS MPY EXNO COMPUTE EXTENT OFFSET STA EXNO AND SAVE LDA TRK COMPUTE RELATIVE CMA,INA SECTOR ADA CTRK CTRK-TRK MPY SEC/T (CTRK-TRK)*#SEC/TRACK LDB SEC CMB,INB  ADA B (CTRK-TRK)*#S/TR-SEC ADA CSEC (CTRK-TRK)*#S/TR-SEC+CSEC CLE,ERA CONVERT TO BLOCKS ADA EXNO ADD #BLOCKS IN PREVIOUS EXTENTS ADA TMP ADD THE BLOCK OVER FLOW STRS STA IRS,I AND PASS TO CALLER TYPST LDB TYP GET AND SET STB JTY,I TYPE LDA LU GET LU (DISC FILE) SZB,RSS IS IT A DISC FILE? LDA TRK NO; USE TYPE 0 LU AND B77 MASK STA JLU,I AND SET LDA SIZE GET THE RECORD STA JREC,I SIZE AND SET IT CLA NO ERRORS JMP EXIT RETURN SPC 4 B177 OCT 177 .128 DEC 128 .2 DEC 2 N10 DEC -10 N11 DEC -11 N9 DEC -9 B77 OCT 77 DFDM DEF *+1 DM NOP A EQU 0 B EQU 1 XEQT EQU 1717B SPC 1 END EQU * SPC 1 END m #+ 92064-18189 1650 S C0122 &FCONF RTE-M FLPY FCONT SUB             H0101 OASMB,R,L,C * NAME: FCONT * SOURCE: 92064-18189 * RELOC: 92064-16059 * PGMR: G.A.A. * MOD: G.L.M * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM FCONT,7 92064-16059 REV.1650 761024 * HED FCONT ENT FCONT EXT .ENTR,EXEC * * THIS IS THE TYPE ZERO CONTROL ROUTINE OF * THE RTE FILE MANAGEMENT PACKAGE. * * A STANDAD RTE CONTROL REQUEST IS ISSUED * TO THE DEVICE VIA THE EXEC IF THE * PCB IS OPEN TO A TYPE ZERO FILE. * CALLING SEQUENCE * CALL FCONT(IDCB,IERR,ICON1,ICON2) * WHERE: * IDCB IS THE DATA CONTROL BLOCK FOR * THE FILE. * IERR IS THE LOCATION FOR RETURNED * ERRORS. * POSSIBLE ERRORS ARE: * 0 NO ERRORS * -11 DCB NOT OPEN * -12 EOF SENSED * >0 NOT A TYPE ZERO FILE (IERR=TYPE) * ICON1 IS CONTROL WORD #1 - THE DEVICE * LU IS MURGED INTO THE LOW * 6 BITS OF THIS WORD * ICON2 IS CONTROL WORD TWO - OPTIONAL * ZERO IS USED IF NOT SPECIFIED * ON RETURN A = IERR * B = DEVICE STATUS SPC 3 * PRE CONSTANT AREA .2 OCT 2 .3 OCT 3 TYPE NOP .7 OCT 7 N10 DEC -10 SPC 3 FCONT NOP LDB DZERO STB IDCB PRE-SET STB IERR STB ICON1 CALL STB ICON2 PARMS CLB STB ZERO LDA FCONT STA DCONT MOVE PARM ADDRESS TO DUMMY ENTRY JMP DCONT+1 * * IDCB DEF ZERO q PARAMETER IERR DEF ZERO ADDRESS ICON1 DEF ZERO AREA ICON2 DEF ZERO SPC 1 DCONT NOP ENTRY POINT JSB .ENTR FETCH PARAMETERS DEF IDCB * LDA N10 FETCH ERROR CODE LDB ICON1 FOR NOT ENOUGH PARMS CPB DZERO OK????? JMP EXIT NOPE--GET OUT * LDB IDCB GET DCB ADB .2 ADDRESS STB TYPE OF TYPE ADB .7 AND LDB B,I OPEN FLAG CPB XEQT OPEN? JMP OK YES, CONTINUE LDA N11 NO; SEND NOT OPEN ERROR EXIT STA IERR,I TO CALLER LDB DZERO RESET X REP 4 ENTRY STB *-X+IDCB ADDRESS CLB CLEAR DUMMY STB ZERO ZERO LDB STAT STATUS TO B AND JMP DCONT,I RETURN SPC 2 * MID CONSTANT AREA SPC 1 N11 DEC -11 DZERO DEF ZERO ZERO NOP STAT NOP SPC 1 B77 OCT 77 SPC 3 OK LDA TYPE,I GET FILE TYPE SZA ZERO? JMP EXIT NO; EXIT : TYPE IN A SPC 1 ISZ TYPE YES; STEP TO WORD WITH LU LDA TYPE,I GET LU AND B77 AND ISOLATE THEN STA B SAVE LDA ICON1,I GET THE FUNCTION AND B1777 MAKE SURE THE LOW END IS ZERO IOR B PUT THEM TOGETHER STA ICON1 SET FOR CALL JSB EXEC CALL EXEC TO DEF EXRTN DO DEF .3 THE DEF ICON1 CONTROL DEF ICON2,I FUNCTION EXRTN STA STAT SAVE STATUS FOR RETURN AND B200 MASK EOF BIT SZA EOF ? LDA N12 YES; SEND EOF CONDITION JMP EXIT GO; EXIT SPC 3 * POST CONSTANT AREA SPC 1 B1777 OCT 177700 B200 OCT 200 N12 DEC -12 SPC 2 A EQU 0 B EQU 1 XEQT EQU 1717B SPC 1 END EQU * SPC 1 END [  $, 92064-18190 1650 S C0122 &IDCBF RTE-M FLPY IDCBS SUB             H0101 }=ASMB,R,L,C * NAME: IDCBS * SOURCE: 92064-18190 * RELOC: 92064-16059 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM IDCBS,7 92064-16059 REV.1650 750609 * HED IDCBS EXT .ENTR ENT IDCBS * IDCB NOP IDCBS NOP JSB .ENTR FETCH PARAM ADDR DEF IDCB LDB IDCB ADB D9 GET THE OPEN FLAG LDA B,I FROM WORD 9 OF THE DCB CPA XEQT IS THIS FILE OPENED? JMP OPEND YES LDA MD11 NO, ERROR -11 JMP EXIT * OPEND ADB MD7 BACK UP TO WORD 2 LDA B,I CPA D1 FILE TYPE 1? CLA OR 0? SZA,RSS YES, SET BUFFER SIZE=0 * JMP RTNOK * NOT12 ADB D5 ADVANCE TO WORD 7 LDA B,I GET SIZE WORD ARS,ALR BUT CLEAR BITS 0 AND 15 RTNOK ADA D16 ADD 16 TO BUFFER SIZE EXIT JMP IDCBS,I RETURN DCB SIZE IN A * A EQU 0 B EQU 1 XEQT EQU 1717B D1 DEC 1 D2 DEC 2 D5 DEC 5 D9 DEC 9 D16 DEC 16 MD11 DEC -11 MD7 DEC -7 * END  %+ 92064-18191 1650 S C0122 &$OPEN RTE-M FLPY $OPEN UTILITY             H0101 {ASMB,L * NAME: $OPEN * SOURCE: 92064-18191 * RELOC: 92064-16059 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM $OPEN,7 92064-16059 REV.1650 740801 * HED $OPEN EXT EXEC EXT RWND$ ENT $OPEN SUP * * $OPEN IS A ROUTINE OF THE RTE FILE MANAGEMENT PACKAGE. * * $OPEN IS CALLLED BY OPEN AND CREAT TO SET UP THE * DCB. IT READS THE DIRECTORY INFORMATION * AND TRANSFERS THE INFORMATION FROM THERE * TO THE DCB. IT ALSO INITIALIZES THE REST * OF THE DCB. * * CALLING SEQUENCE: * (IT IS ASSUMED THAT WORDS 1 & 2 OF THE DCB ARE SET UP.) * * A = DCB ADDRESS * B = SECURITY CODE (EXPECTED) * E = 1 IF TYPE 1 OVERRIDE * O = 1 IF AN UPDATE OPEN * * JSB $OPEN * DEF IBLK DEF OF LENGTH OF DCB OR ZERO * DEF #SECT DEF OF WORD CONTAINING #SEC/TRACK * IN THE HIGH HALF (PASSED FROM D.RTR) * JMP ERR ERROR RETURN * NORMAL RETURN * ON A NORMAL RETURN: * A = FILE SECURITY CODE * B = SECURITY CODE/UPDATE FLAG * * ON AN ERROR RETURN, EITHER * A = -1 DISC ERROR OR * A = -9 TYPE ZERO OVERRIDE ERROR * IN EITHER CASE THE DCB IS NOT SET UP. * * $OPEN NOP ENTRY STB SC SAVE THE SECURITY CODE SSB IF NEGATIVE CMB,INB SET POS STB SC2 AND SAVE STA DCB AND THE DCB ADDRESS STA DCB2 LDA A,I GET THE DIRECTORY AND B77 ADDRESS STA LU  AND SET XOR DCB,I TO ALF,ALF READ RAL,RAL THE STA TRACK DIRECTORY ISZ DCB BLOCK LDA DCB,I GET THE SECTOR AND B377 MASK STA SECT AND XOR DCB,I SET ALF,ALF GET THE LDB DCB OFFSET ADB .4 AND SIZE STB SIZE ADB .11 AND STB BUF COMPUTE BUFFER ADDRESS ADB .3 AND ADB A OFFSET STB PRMA TO ISZ DCB THE PRAMS CLB,SEZ,INB IF TYPE 1 OVERRIDE STB DCB,I SET TYPE SEZ AND CCB THE STB TPFLG OVERRIDE SKIP FLAG JSB EXEC READ DEF RTN THE DEF .1 BLOCK DEF LU TO BUF NOP THE DEF .128 DCB DEF TRACK DEF SECT RTN CCA SET A FOR DISC ERROR CPB .128 DISC ERROR? CLB,RSS NO SKIP JMP EREX EXIT - ERROR ADA BUF COMPUTE THE EXTENT ADDRESS STB A,I AND SET THE EXTENT TO ZERO LDA N9 LDB PRMA,I GET FILE TYPE SZB,RSS IF ZERO ISZ TPFLG AND OVERRIDE FLAG SET RSS JMP EREX EXIT - ERROR SPC 1 LDB N5 OF - SET TO MOVE 5 NXT LDA PRMA,I PARAMETERS ISZ TPFLG IF OVERRIDE SET SKIP STA DCB,I SET PARAMETER ISZ DCB STEP ADDRESS ISZ PRMA STEP SOURCE INB,SZB AND COUNT - DONE? JMP NXT NO; DO NEXT ONE LDA PRMA,I CLE,SZA CPA SC CCE MATCH SO SET E CPA SC2 MATCH WITH POS OF NEG CCE YES SO SET E ERB MATCH - SET FLAG SOC SET UPDATE INB FLAG STB SC SAVE SECURITY CODE LDA $OPEN,I GET THE SIZE IN WORDS LDB A,I TO THE B REG LSR 7 DIVIDE BY 128 TO GET BLOCKS SZB,RSS IF ZERO THEN INB USE ONE BLS CONVERT TO SECTORS NXBUF STB TPFLG SAVE IT LDA SIZE,I GET THE FILE SIZE CLB DIV TPFLG DIVIDE TO GET N SZB,RSS IF NO REMAINDER JMP BFOK THEN THE SIZE IS OK LDB N2 ELSE TRY ONE SMALLER ADB TPFLG THAN THE CURRENT JMP NXBUF ONE BFOK LDA TPFLG GET THE BUFFER SIZE LSL 6 CONVERT SECTORS TO WORDS ADA SC ADD THE SECURTITY CODE AND UPDATE FLAG STA DCB,I SET IN DCB ISZ $OPEN STEP TO NEXT PRAM ISZ DCB SET NUMBER OF SECTORS / TRACK ADD LDB $OPEN,I GET THE WORD LDB B,I FROM THE CALL LSR 8 SET TO LOW B STB DCB,I PUT IT IN THE DCB ISZ $OPEN STEP RETURN ADDRESS CLA OPEN EXTENT ZERO LDB DCB2 GET THE DCB ADDRESS JSB RWND$ SET REST OF DCB JMP $OPEN,I ERROR EXIT ADB N2 SET B TO THE RECORD NO ADDRESS CLA,INA SET THE RECORD NO STA B,I TO 1. ISZ DCB STEP TO THE OPEN FLAG ADDRESS LDA XEQT GET THE CURRENT ID ADDRESS STA DCB,I SET THE OPEN FLAG LDA PRMA,I RESTORE SECURITY CODE LDB SC AND MATCH - UPDATE FLAG RSS EREX ISZ $OPEN STEP TO ERROR RETURN ISZ $OPEN STEP AND JMP $OPEN,I AND RETURN SPC 3 SIZE NOP SC2 NOP SC NOP DCB NOP DCB2 NOP LU NOP TRACK NOP B77 OCT 77 B377 OCT 377 SECT NOP N9 DEC -9 .4 DEC 4 .11 DEC 11 .3 DEC 3 PRMA NOP TPFLG NOP .1 DEC 1 .128 DEC 128 N5 DEC -5 N2 OCT -2 SPC 2 XEQT EQU 1717B A EQU 0 B EQU 1 SPC 1 END EQU * SPC 1 END  &/ 92064-18192 1650 S C0122 $RW$UB RTE-M FLPY DISK UTILITY             H0101 N(ASMB,L,R,C * NAME: RW$UB * SOURCE: 92064-18192 * RELOC: 92064-16059 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM RW$UB,7 92064-16059 REV.1650 750422 * HED RW$UB * * RW$UB READS AND WRITES A WORD OR BLOCK OF WORDS ON A RTE FILE * CALLING SEQUENCE: * SET E=1 FOR READ * E=0 FOR WRITE * LDA DCB SET A TO DCB ADDRESS * LDB COUNT SET B TO THE NO OF WORDS TO BE XFERED * JSB RW$SUB CALL * DEF BUF BUFFER CONTAING (WRITE) OR RECIEVING (READ) * JMP ERROR ERROR RETURN CODE IN A * --- NORMAL RETURN * EXT RWND$,R/W$ EXT EXEC,P.PAS EXT RFLG$ ENT RW$UB,NX$EC ENT $KIP RW$UB NOP ENTRY CMB,INB,SZB,RSS SET NEGATIVE SKIP IF NOT ZERO JMP ZER0 ZERO GO RETURN STB COUNT NEGATIVE CLB,SEZ,RSS COUNTER LDB RSS SET READ/WRITE SWITCH STB NEXTW RSS IF WRITE, ELSE NOP JSB PRAM GO GET THE PRAMETERS ADA B CALCULATE CMA,INA THE # ADA BUFPT,I OF REMAINING STA LEFT WORDS AND SET LDB BUFPT,I GET THE POINTER TO B LDA RW$UB GET USER BUFFER LDA A,I GET ADDRESS RAL,CLE,SLA,ERA IF INDIRECT JMP *-2 TRY AGAIN ISZ RW$UB STEP RETURN STA PTR SET USER POINTER NEXTW RSS OR NOP IF WRIT JMP READ DO READ THING LDA PTR,I WRITE; GET WORD STA B,I SET IT IN DCB RDW ISZ PTR STEP POINTER INB STEP DCB ADDRESS q] ISZ LEFT ANY ROOM LEFT? RSS RSS YES; SKIP JMP ENDBL NO; GO WRITE IT OUT CONT ISZ COUNT STEP WORD COUNT-DONE? JMP NEXTW NO; DO NEXT WORD STB BUFPT,I RESET THE BUFFER POINTER LDB NEXTW IF WRITE SZB THEN STB FLAG,I SET THE WRITTEN ON FLAG EX ISZ RW$UB YES; STEP THE RETURN ADDRESS JMP RW$UB,I RETURN SPC 2 ZER0 ISZ RW$UB STEP FOR GOOD RETURN JMP EX EXIT SPC 2 ENDBL LDB TYPE,I IF TYPE TWO CPB .2 THEN LDB COUNT IF COUNT IS INB,SZB,RSS EXAUSTED JMP CONT JUST CONTINUE LDB NEXTW GET THE READ WRITE FLAG SZB IF WRITE THEN STB FLAG,I SET THE BIT IN THE DCB CLB,INB SET FOR NEXT BLOCK JSB NX$EC GO GET IT JMP RW$UB,I ERROR - RETURN LDB BLKLN OK - CMB,INB RESET STB LEFT LEFT COUNTER LDB BUFA AND BUFFER POINTER JMP CONT AND CONTINUE SPC 1 READ LDA B,I GET THE WORD STA PTR,I SET IN USER BUFFER JMP RDW RETURN TO WRITE CODE SPC 2 COUNT NOP BUFA NOP SPC 2 $KIP NOP SKIP ENTRY STB COUNT SAVE THE WORD COUNT JSB PRAM GO SET THE PRAMS CMA,INA COMPUTE THE BUFFER ADA BUFPT,I OFFSET ADA COUNT ADD THE COUNT STA B SET UP FOR DIVID ASR 16 EXTENT THE SIGN DIV BLKLN DIVIDE BY BLOCK LENGTH SSB SKIP IF POSITIVE ADA N1 ELSE ADDJUST THE BLOCK SSB IF NEGATIVE ADB BLKLN ADJUST TO POSITIVE ADB BUFA COMPUTE THE NEW BUFFER ADDRESS SWP PUT BUFFER ADDRESS IN A BLOCK IN B SZB,RSS IF ZERO THE GO TO EXIT JMP *+3 JSB NX$EC GO GET THE BLOCK JMP $KIP,I ERROR RETURN STA BUFPT,I SET THE BUFFER ADDRESS IN THE DCB "6 ISZ $KIP SET TO NORMAL RETURN JMP $KIP,I MAKE NORMAL RETURN SPC 1 PRAM NOP FETCH DCB ADDRESS SUBROUTINE CLB,CLE SET UP JSB P.PAS AND DEC -16 FETCH DCB NOP DCB TMP NOP TYPE NOP TR NOP SEC NOP #SEC NOP SAV NOP PTR NOP USED AS LOCAL SEC/T NOP LEFT NOP USED AS LOCAL ONLY CTRK NOP CSEC NOP BUFPT NOP FLAG NOP BLKLN NOP EXT# NOP LDB PTR,I GET THE BLOCK LENGTH WORD BRS,BLR CLEAR THE LEAST AND SIGN BITS STB BLKLN SET THE BLOCK LENGTH STA BUFA SET THE BUFFER ADDRESS JMP PRAM,I RETURN TO CALLER SKP * NX$EC COMPUTES THE ADDRESS OF THE NEXT SECTOR * FOR ALL READ/WRITE ACCESSES AND FOR * SEQUENTIAL POSITIONING. * * CALLING SEQUENCE: * * LDB RELATIVE BLOCK NO. * JSB NX$EC * DISCERR/EOF RETURN (ON EXTENDABLE FILES EODISC) * NORMAL RETURN * * NX$EC WRITES THE CURRENT SECTOR BUT DOES NOT * SET THE RELATIVE POSITION POINTERS * THE TARGET BLOCK IS READ. * IF RFLG$ IS NON 0. * * * NX$EC NOP STA SAV SAVE THE A REG LDA B CONVERT BLOCKS CLB,CLE TO MPY BLKLN SECTORS ASR 6 AND STA SECOF SAVE LDB DCB GO WRITE THE CURRENT JSB R/W$ BLOCK JMP NX$EC,I IF ERROR RETURN LDA TR,I COMPUTE THE CMA,INA RELATIVE SECTOR ADA CTRK,I ADDRESS MPY SEC/T,I IN THE FILE LDB SEC,I AND CMB,INB THEN ADB A ADD ADB CSEC,I THE ADB SECOF CHANGE ASR 16 EXTEND TO A DIV #SEC,I DIVIDE BY FILE SIZE SSB IF NEGATIVE ADA N1 REMAINDER SSB CORRECT ADB #SEC,I RESULT SZA IF DIFFERENT EXTENT JMP EXTND )S GO GET ITS ADDRESS NX$E1 ADB SEC,I COMPUTE THE NEW LSR 16 TRACK AND DIV SEC/T,I SECTOR ADA TR,I ADDRESSES STA CTRK,I AND SET THEM STB CSEC,I IN THE DCB LDA RFLG$ IF FLAG CLEARED CCE,SZA,RSS THEN DO NOT JMP NORD READ LDB DCB SET UP TO JSB R/W$ READ AND DO IT JMP NX$EC,I ERROR RETURN NORD ISZ NX$EC STEP AND LDA SAV RESTOR A JMP NX$EC,I RETURN SPC 5 EXTND STB TMP SAVE THE RELATIVE SECTOR ADA EXT#,I ADD CURRENT EXTENT NUMBER LDB TYPE,I GET THE TYPE SSA,RSS IF LESS THAN ZERO CPB .2 OR IFIF TYPE 2 THEN JMP SOF END OF FILE LDB DCB GO SET UP JSB RWND$ THE EXTENT JMP NX$EC,I ERROR RETURN LDB TMP GET THE SECTOR OFFSET JMP NX$E1 AND GO COMPUTE THE ADDRESS SOF LDA N12 ELSE EOF JMP NX$EC,I RETURN SECOF NOP SPC 2 N1 OCT -1 .2 DEC 2 N12 DEC -12 SPC 2 A EQU 0 B EQU 1 SPC 1 END EQU * SPC 1 END Ε '0 92064-18193 1650 S C0122 &R/W$ RTE-M FLPY READ/WRITE UTILITY             H0101 yASMB,R,L,C * NAME: R/W$ * SOURCE: 92064-18193 * RELOC: 92064-16059 * PGMR: G.A.A. * MOD: G.L.M * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM R/W$,7 92064-16059 REV.1650 760801 * HED R/W$ EXT EXEC ENT R/W$ ENT D$XFR ENT D.R * * R/W$ WRITES THE CURRENT SECTOR BLOCK IF IT HAS * BEEN WRITTEN ON OR READS UNCONDITIONALLY. * * CALL SEQUENCE: * * SET E=0 FOR WRITE E=1 FOR READ * LDB DCB SET B TO DCB ADDRESS * JSB R/W$ * JMP DERR ERROR RETURN (A = -1) * NORMAL RETURN * R/W$ NOP STB RC SAVE THE DCB ADDRESS ADB .7 INDEX TO THE BLOCK SIZE LDA B,I FETCH THE BLOCK SIZE ARS,ALR CLEAR THE LEAST AND SIGN BITS ADB .6 INDEX TO THE WRITTEN ON FLAG STB WOFLG SAVE ITS ADDRESS ADB .3 INDEX TO THE BUFFER ADDRESS STB BUFA SET IN CALL LDB WOFLG,I GET THE WRITTEN ON FLAG SEZ,SLB,RSS IF NOT WRITTEN ON (SKIP ON READ) JMP EXIT EXIT LDB RC GET THE DCB ADDRESS JSB D$XFR DO THE TRANSFER BUFA NOP JMP R/W$,I ERROR - RETURN LDB RC GET THE REQUEST CODE CCE,SLB,RSS IF THIS IS A WRITE CALL EXIT CLA,CLE CLEAR THE IN CORE FLAGS ERA,ALS CLEAR WRITTEN ON FLAG AND SET IF READ STA WOFLG,I RESET ISZ R/W$ TAKE OK JMP R/W$,I EXIT SPC 2 .2 DEC 2 .3 DEC 3 .6 DEC 6 .7 DEC 7 .8 DEC 8 RC NOP TRACK NOP AT TRACK SECT NOP AND SECTOR LU NOP WOFLG NOP B77 OCT 77 SPC 2 * DISC TRANSFER CALL SEQUENCE * * E=0 FOR WRITE * E=1 FOR READ * B= DCB ADDRESS * A= LENGTH (NO. OF WORDS) * JSB D$XFR CALL TO HERE * DEF BUFR BUFFER ADDRESS (MUST BE DIRECT) * JMP ERR ERROR RETURN (A=-1) * NORMAL RETURN SPC 2 D$XFR NOP ENTRY POINT STA LSAVE SAVE LENGTH CLA,SEZ,INA,RSS SET UP THE REQUEST CODE INA AND STA RC SET IT LDA B,I CONFIGURE THE CON WORD AND B77 * * MUST HAVE "Z" OPTION TO RUN IN RTE 2/3 SYSTEM * IFZ ADA PRC XIF * STA LU ADB .8 GET THE NUMBER OF SECTORS PER TRACK STB #SC/T ADDRESS AND SAVE IT ADB .2 GET THE TRACK ADDRESS DLD B,I AND DST TRACK SAVE IT LDA D$XFR,I GET THE BUFFER ADDRESS STA BUF SAVE IT ISZ D$XFR STEP TO ERROR RETURN ADDRESS LDA B GET THE SECTOR ADDRESS TO A CMA,INA SET NEGATIVE AND NXTR ADA #SC/T,I CACULATE NUMBER OF WORDS LEFT ON THIS ASL 6 ON THIS TRACK STA #WORD SET FOR TRANSFER CMA,INA SET MAX COUNT NEGATIVE LDB LSAVE GET REMAINING COUNT ADA B AND SUBTRACT SSA IF LESS THAN REST OF TRACK STB #WORD RESET COUNT TO RIGHT NUMBER STA LSAVE SET REMAING WORDS FOR NEXT TIME JSB EXEC CALL EXEC TO DEF ERTS DEF RC WRITE/READ DEF LU FROM THE DISC BUF NOP AT THE SPECIFIED BUFFER DEF #WORD SIZE DEF TRACK TRACK AND DEF SECT SECTOR ERTS CCA SET UP FOR ERROR EXIT CPB #WORD ERROR? CLA,RSS NO ERROR SKIP JMP D$XFR,I ERROR RETURN ADB BUF UP DATE THE BUFFER STB BUF w ADDRESS STA SECT SET THE SECTOR ADDRESS FOR NEW TRACK ISZ TRACK STEP THE TRACK ADDRESS LDB LSAVE GET THE REMAINING LENGTH CMB,SSB,INB,SZB CHECK IF ANY LEFT JMP NXTR NO CONTINUE XFER ISZ D$XFR END SO JMP D$XFR,I MAKE THE NORMAL RETURN SPC 2 LSAVE NOP #SC/T NOP #WORD NOP A EQU 0 B EQU 1 UNL * IFZ * PRC OCT 74000 * XIF * LST D.R ASC 3,D.RTR SPC 1 END EQU * SPC 1 END q (0 92064-18194 1650 S C0122 &RWND$ RTE-M FLPY READ/WRITE UTILITY             H0101 ASMB,R,L,C * NAME: RWND$ * SOURCE: 92064-18194 * RELOC: 92064-16059 * PGMR: G.A.A. * MOD: G.L.M * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM RWND$,7 92064-16059 REV.1650 760629 * HED RWND$ ENT RWND$ EXT CLD.R,.P1,.P2,.P3,.P4 ENT RFLG$ * * RWND$ IS A MODULE OF THE REAL TIME FILE * MANAGEMENT PACKAGE. IT IS INVOKED * TO SET OR RESET WORDS 11 THROUGH 16 * OF THE DCB. THE RECORD COUNT IS RESET IF EXTENT 0. * * CALLING SEQUENCE: * * LDA EXTENT# SET A TO DESIRED EXTENT * LDB DCB SET B TO DCB ADDRESS * JSB RWND$ CALL * JMP ERR ERROR EXIT (A=CODE) * --- NORMAL RETURN * SPC 3 TMP NOP TMP2 NOP RWND$ NOP ENTRY POINT STA .P4 SET THE EXTENT# LDA B,I FETCH TRACK AND LU STA .P2 SAVE IT INB ADVANCE TO OFSET/SECTOR LDA B,I FETCH IT STA .P3 SAVE FOR D.R ADB .2 STB TMP ADB .12 INDEX TO EXTENT# LDA .P4 FETCH REQUESTED EXTENT# CPA B,I IF SAME - CONTINUE JMP SETUP WITH SETUP LDA RFLG$ GET READ WRITE FLAG LDB .6 GET READ EXTENT OPEN REQUEST CODE SZA,RSS IF WRITE ADB .2 ADD TWO TO GET WRITE EXTENT OPEN REQUEST STB .P1 SET IT FOR CALL TO D.RTR JSB CLD.R * SPC 1 LDA B,I YES; ANY ERRORS? SSA FROM D.RTR? JMP RWND$,I YES; RETURN SPC 1    ADB .3 NO; STEP TO TRACK LDA B,I GET TRACK STA TMP,I SET IN DCB INB STEP TO SECTOR LDA B,I GET AND AND B377 MASK LDB TMP GET DCB ADDRESS INB SET STA B,I SECTOR IN DCB SETUP LDB TMP SET THE DCB FROM THE ADB .7 TRACK & SECTOR WORDS LDA TMP,I SET JSB SET TRACK ISZ TMP AND LDA TMP,I SECTOR JSB SET WORDS. LDA B SET THE ADA .4 BUFFER JSB SET ADDRESS. CLA CLEAR THE READ/ JSB SET WRITE FLAGS LDA .P4 GET EXTENT# INB SKIP JSB SET SET THE EXTENT # ISZ RWND$ STEP JMP RWND$,I AND RETURN SPC 3 SET NOP STA B,I SET THE WORD IN THE DCB INB STEP DCB ADDRESS JMP SET,I RETURN SPC 3 .2 OCT 2 .3 OCT 3 .4 OCT 4 .7 OCT 7 .6 DEC 6 .12 DEC 12 .9 DEC 9 B377 OCT 377 RFLG$ NOP GLOBAL READ WRITE FLAG XEQT EQU 1717B A EQU 0 B EQU 1 SPC 1 END EQU * SPC 1 END   )0 92064-18195 1650 S C0122 &PPASF RTE-M FLPY PARM PASS SUB             H0101 yASMB,R,L,Z,C * NAME: P.PAS * SOURCE: 92064-18195 * RELOC: 92064-16059 * PGMR: G.A.A. * MOD: G.L.M * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM P.PAS,7 92064-16059 REV.1650 740801 ENT P.PAS * HED P.PAS * P.PAS IS USED TO SET UP ADDRESS OR TO MOVE * INFORMATION FROM THE CALL AREA * * CALLING SEQUENCE: * * E=0 SET UP CALL AREA * E=1 MOVE FROM CALL AREA * B=0 SET ADDRESSES ONLY * B=100000 MOVE PARAMETERS * A = ADDRESS OF OTHER AREA OR FIRST ADDRESS * * JSB P.PAS * DEC -N N= NO. OF WORDS TO BE SET UP * BSS N CALL AREA BUFFER * IF B IS 0, THIS WILL BE A * LIST OF ADDRESSES; IF B=100000, * THIS WILL BE THE WORDS AT THE * ADDRESS PROVIDED IN A. * * P.PAS NOP ADB LOAD CONFIGURE THE LOAD STB NEXT AND SET IT LDB P.PAS,I GET THE COUNT STB COUNT AND SET ISZ P.PAS STEP TO PRAM AREA LDB P.PAS ADDRESS TO B SEZ IF FROM SWP SWAP ADDRESSES STB DEST SAVE THE DESTINATION ADDRESS NEXT LDB A GET ADDRESS OR IF LDB A,I STB DEST,I A WORD - SET IF ISZ DEST STEP DESTINATION INA STEP FROM ISZ COUNT STEP COUNT - DONE? JMP NEXT NO; GET NEXT ONE SEZ YES; EXIT TO JMP A,I END OF CALL JMP DEST,I SEQUENCE SPC 5 COUNT NOP DEST NOP LOAD LDB A TEST NOP SPC 2 A EQU 0 B EQ  U 1 END EQU * END 1  *1 92064-18196 1650 S C0122 &FDCB0 RTE-M FLPY LIBR DCB1             H0101 ASMB,R,L * NAME: IDCB0 * SOURCE: 92064-18196 * RELOC: 92064-16059 * PGMR: G.L.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM IDCB0,7 92064-16059 REV.1650 761215 * ENT IDCB0 IDCB0 NOP 143 OF THESE FOLLOW UNL REP 143 NOP LST END ! +1 92064-18197 1650 S C0122 &FDCB1 RTE-M FLPY LIBR DCB             H0101 ASMB,R,L * NAME: IDCB1 * SOURCE: 92064-18197 * RELOC: 92064-16059 * PGMR: G.L.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM IDCB1,7 92064-16059 REV.1650 761214 * ENT IDCB1 IDCB1 NOP 143 OF THESE FOLLOW UNL REP 143 NOP LST END & ,2 92064-18198 1650 S C0122 &FDCB2 RTE-M FLPY LIBR DCB             H0101 ASMB,R,L * NAME: IDCB2 * SOURCE: 92064-18198 * RELOC: 92064-16059 * PGMR: G.L.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM IDCB2,7 92064-16059 REV.1650 761214 * ENT IDCB2 IDCB2 NOP 143 OF THESE FOLLOW UNL REP 143 NOP LST END + -3 92064-18199 1650 S C0122 &FDCB3 RTE-M FLPY LIBR DCB             H0101 ASMB,R,L * NAME: IDCB3 * SOURCE: 92064-18199 * RELOC: 92064-16059 * PGMR: G.L.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM IDCB3,7 92064-16059 REV.1650 761214 * ENT IDCB3 IDCB3 NOP 143 OF THESE FOLLOW UNL REP 143 NOP LST END 0 .4 92064-18200 1650 S C0122 &FDCB4 RTE-M FLPY LIBR DCB             H0101 ASMB,R,L * NAME: IDCB4 * SOURCE: 92064-18200 * RELOC: 92064-16059 * PGMR: G.L.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM IDCB4,7 92064-16059 REV.1650 761214 * ENT IDCB4 IDCB4 NOP 143 OF THESE FOLOWW UNL REP 143 NOP LST END / /5 92064-18201 1650 S C0122 &FDCB5 RTE-M FLPY LIBR DCB             H0101 ASMB,R,L * NAME: IDCB5 * SOURCE: 92064-18201 * RELOC: 92064-16059 * PGMR: G.L.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM IDCB5,7 92064-16059 REV.1650 761214 * ENT IDCB5 IDCB5 NOP 143 OF THESE FOLLOW UNL REP 143 NOP LST END 1 06 92064-18202 1650 S C0122 &FDCB6 RTE-M FLPY LIBR DCB             H0101 ASMB,R,L * NAME: IDCB6 * SOURCE: 92064-18202 * RELOC: 92064-16059 * PGMR: G.L.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM IDCB6,7 92064-16059 REV.1650 761214 * ENT IDCB6 IDCB6 NOP 143 OF THESE FOLLOW UNL REP 143 NOP LST END 6 17 92064-18203 1650 S C0122 &FDCB7 RTE-M FLPY LIBR DCB             H0101 ASMB,R,L * NAME: IDCB7 * SOURCE: 92064-18203 * RELOC: 92064-16059 * PGMR: G.L.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM IDCB7,7 92064-16059 REV.1650 761214 * ENT IDCB7 IDCB7 NOP 143 OF THESE FOLLOW UNL REP 143 NOP LST END ; 28 92064-18204 1650 S C0122 &FDCB8 RTE-M FLPY LIBR DCB             H0101 ASMB,R,L * NAME: IDCB8 * SOURCE: 92064-18204 * RELOC: 92064-16059 * PGMR: G.L.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM IDCB8,7 92064-16059 REV.1650 761214 * ENT IDCB8 IDCB8 NOP 143 OF THESE FOLLOW UNL REP 143 NOP LST END @ 39 92064-18205 1650 S C0122 &FDCB9 RTE-M FLPY LIBR DCB             H0101 ASMB,R,L * NAME: IDCB9 * SOURCE: 92064-18205 * RELOC: 92064-16059 * PGMR: G.L.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM IDCB9,7 92064-16059 REV.1650 761214 * ENT IDCB9 IDCB9 NOP 143 OF THESE FOLLOW UNL REP 143 NOP LST END E 4: 92064-18207 1826 S 0122 &MSYLB RTE-M SYSTEM LIBRARY             H0101 ASMB,L * NAME: MSYLB * SOURCE: 92064-18207 * RELOC: 92064-16081 * PGMR: H.C. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM MSYLB 92064-16081 REV.1826 780509 END `Z 5; 92064-18208 1709 S C0122 &MALRN RESOURCE NUMBER SUBR             H0101 (ASMB,R,L,C ** $ALRN RN-LU COMMON SUBROUTINES *** HED $ALRN - RN-LU COMMON SUBROUTINES * NAME: MALRN * SOURCE: 92064-18208 * RELOC: 92064-16081 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1975. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM MALRN,6 92064-16081 REV.1709 741106 * EXT $RNTB,$ERAB,$LIST,$XEQ ENT $ALRN,$RNSU,$RNEX,$LUEX,$LUSU,$DRAD SUP A EQU 0 B EQU 1 * * $ALRN THIS ROUTINE ALLOCATES AN RN IF POSSIBLE * TO THE USER WHOSE ID SEGMENT ADDRESS IS * AT XEQT. * * OPTIONS/CALLING SEQUENCE: * * < IDNO MUST BE USER ID SEG # OR 377 IF GLOBAL * LDB =B1 TO ALLOCATE FROM BOTTOM OF THE RN TABLE * LDB =B-1 TO ALLOCATE FROM THE TOP OF THE RN TABLE * * JSB $ALRN * * < RETURN A=RN WORD (USER FORMAT) IF SUCESSFUL * A=0 IF NO RN'S AVAILABLE NOW * RQP6 IS SET TO RN ADDRESS IN RN TABLE * * * * $ALRN NOP STB TEMP4 SAVE THE INCREMENT LDA $RNTB GET THE LENGTH OF THE RN TABLE CMA,INA SET NEGATIVE. * STA TEMP2 SET THE COUNT LDA D$RN GET THE RN TABLE ADDRESS JSB $DRAD MAKE INTO DIRECT ADDR STA D$RN SAVE FOR LATER SSB,RSS IF BOTTOM UP INA,RSS SET TO FIRST WORD ADA $RNTB ELSE SET TO LAST WORD * ALRN1 LDB A,I SEARCH FOR SZB,RSS AN AVAILABLE JMP ALRN2 SLOT. FOUND * ADA TEMP4 STEP THE ADDRESS ISZ TEMP2 SKIP IF END JMP ALRN1 ELSE TRY NEXT ONE * CLA NO RN'S AVAILABLE NOW JMP $ALRN,I SO EXIT WITH A=0 * ALRN2 STA RNADR SAVE LOCATION CMA,INA SET TO CACULATE RN NUMBER * LDB IDNO GET THE USER ID NUMBER BLF,BLF ROTATE TO HIGH HALF STB RNADR,I SET THE ASSIGNMENT IN THE TABLE ADA D$RN COMPUTE RN NUMBER CMA,INA SET POSTIVE ADA B ADD THE USER ID FLAG JMP $ALRN,I RETURN * * $RNSU LDB RQOP GET NO-WAIT OPTION FLAG SSB IF NO WAIT JMP EXRNW THEN EXIT * $LUSU STA XTEMP,I SET THE SUSPEND FLAG JSB $LIST AND PUT THE PROG IN LIST OCT 503 NUMBER 3. JMP $XEQ GO THE THE DISPATCHER * EXRNW LDB D5 ENTRY FOR 6/7 RETURN $RNEX LDA RNADR TEST THE RN LOCATION ADDRESS CMA,CLE,INA,SZA,RSS IF ZERO SET E, ELSE SKIP LDB D4 NO RN STATUS LDA RNADR,I GET THE RN SEZ,SZA,RSS SKIP IF ALLOCATE PROBLEMS CLB ELSE SET DEALLOCATED FLAG IF RN IS ZERO AND B377 MASK TO LOCK BITS SZA IF LOCKED INB STEP B TO SO INDICATE CPA B377 IF GLOBAL INB STEP AGAIN STB RQST,I SET THE STATUS WORD $LUEX LDB XEQT SET THE RN BIT IN HIS ADB D20 ID-SEGMENT LDA B,I IOR B400 STA B,I LDA RQRTN PUSH UP HIS STA XSUSP,I RETURN ADDRESS JMP $XEQ ** GO TO THE DISPATCHER ** * * * $DRAD NOP ADDR IS GIVEN IN A RSS GET DIRECT ADDRESS LDA A,I IF NOT ALREADY RAL,CLE,SLA,ERA JMP *-2 JMP $DRAD,I RETURN DIRECT ADDR IN A D$RN DEF $RNTB * * D5 DEC 5 D4 DEC 4 D20 DEC 20 B377 OCT 377 B400 OCT 400 TEMP2 NOP TEMP4 NOP * RQOP EQU 1701B RQP2 IS RN/LU REQUEST CODE RQNO EQU 1702B RQP3 IS ADDR OF RN/LU NUMBER RQST EQU 1703B RQP4 IS ADDR OF RN/LU STATUS IDNO EQU 1704B RQP5 IS USERS ID¬ SEG # RNADR EQU 1705B RQP6 IS ADDR OF RN IN RN TABLE RQRTN EQU 1677B XEQT EQU 1717B XTEMP EQU 1721B XSUSP EQU 1730B * ORG * PROGRAM LENGTH END  6> 92064-18209 1709 S C0122 &MRNRQ RESOURCE NUMBER ALLOC             H0101 D!ASMB,R,L,C ** RNRQ RESOURCE NUMBER MODULE ** HED ** REAL-TIME EXECUTIVE RNRQ RESOURCE NUMBER MODULE ** * NAME: MRNRQ * SOURCE: 92064-18209 * RELOC: 92064-16081 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1975. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM MRNRQ,6 92064-16081 REV.1709 741120 * EXT $ERAB,$RNTB,$IDNO,$SCD3,$DRAD EXT $ALRN,$LIBR,$PVCN,$RNSU,$RNEX ENT RNRQ * SUP A EQU 0 B EQU 1 * * * * RESOURCE NUMBERS (RN'S) ARE ACCESSED BY USER * CALLS THAT CAN ALLOCATE, DEALLOCATE * SET AND CLEAR THE RN. IF A RN REQUEST CAN NOT * BE GRANTED BECAUSE OF NONE AVAILABLE OR * CONFLICT WITH OTHER PROGRAMS THE REQUESTER IS * SUSPENDED UNTIL THE RN BECOMES AVAILABLE * * THE EXEC CALL IS: * * EXT RNRQ * * JSB RNRQ * DEF *+4 * DEF OPTION OPTION ADDRESS * DEF RN RN NUMBER ADDRESS/RETURN * DEF STAT RN STATUS RETURN ADDRESS * * * WHERE: * OPTIN BSS 1 OPTION WORD * RN BSS 1 RN WORD * STAT BSS 1 RN STATUS * * THE OPTION WORD DEFINES WHAT ACTION IS TO BE TAKEN ON THE * REQUEST AS FOLLOWS: * * BIT MEANING IF SET * BIT 0 SET THE RN LOCALLY * BIT 1 SET THE RN GLOBALLY * BIT 2 CLEAR THE RN * BIT 3 ALLOCATE AN RN LOCALLY * BIT 4 ALLOCATE AN RN GLOBALLY * BIT 5 DEALLOCATE THE RN * BIT 14 DON'T ABORT IF ERROR, RETURN ASCII CODE IN A,B * BIT 15 RETURN EVEN IF REQUEST NOT GRANTED * * A LOCALLY ALPLOCATED RN MAY BE RELEASED ONLY BY THE ALLOCATOR * A LOCALLY SET RN MAY BE CLEARED ONLY BY THE SETER * GLOBALLY ALLOCATED/SET RN'S MAY BE DEALLOCATE/CLEARED BY * ANY PROGRAM. * * IF MORE THAN ONE BIT IS SET IN THE OPTION WORD THE FOLLOWING * PRESEDENCE IS FOLLOWED: * * 1) LOCAL ALLOCATE (SKIP 2 IF DONE) * 2) GLOBAL ALLOCATE * 3) DEALLOCATE * 4) LOCAL SET (SKIP 5 IF DONE) * 5) GLOBAL SET * 6) CLEAR * * THIS IMPLIES THAT RN MAY BE ALLOCATED,SET,AND CLEARED IN * THE SAME REQUEST. * A STATUS REQUEST WOULD BE A SET, CLEAR, WITHOUT WAIT. * THERE ARE TWO RN CODE WORDS: * A) THE USER WORD (RETURN ON ALLOCATE/SUPPLIED FOR OTHER * REQUESTS). * B) THE RN TABLE CODE WORD. * * THE USER CODE WORD HAS THE RN NUMBER IN THE LOW HALF (8 BITS) * AND THE OWNERS ID SEGMENT NUMBER IN THE HIGH 8 BITS * * THE RN TABLE CODE WORD HAS THE LOCKERS ID SEGMENT NUMBER * IN THE LOW HALF AND THE OWNERS ID NUMBER IN THE HIGH OF * THE WORD. * * GLOBAL ALLOCATES/LOCKS ARE CODED AS 377 * AVAILABLE/UNLOCKED IS CODED AS 0. * * RN STATUS IS AS FOLLOWS: * * VALUE MEANING * 0 NORMAL DEALLOCATE RETURN * 1 RN IS CLEAR (UNLOCKED) * 2 RN IS LOCKED LOCALLY TO CALLER * 3 RN IS LOCKED GLOBALLY * 4 NO RN AVAILABLE NOW * 5 NOT DEFINED * 6 RN IS LOCKED LOCALLY TO OTHER PROGRAM * 7 RN WAS LOCKED GLOBALLY WHEN REQUEST WAS MADE. * * STATUS 4,6,7 ARE ONLY RETURNED IF THE REQUEST FAILED * AND THE NO WAIT BIT WAS SET * * POSSIBLE ERRORS FROM THIS CODE ARE: * * ERROR MEANING * * RN00 NO BITS SET IN THE OPTION WORD. * RN01 NO RN'S IN THE SYSTEM (EVER). * RN02 ILLEGAL RN NUMBER. * RN03 RELEASE OR UNLOCK OF UNOWNED RN. * RN REQUEST PROCESSOR *  SKP RNRQ NOP ENTRY JSB $LIBR PRIVILEGED NOP CLA SINCE WE DON'T PLAN TO RETURN STA $PVCN VIA $LIBR, CLEAR CNTR LDA D$RN JSB $DRAD GET DIRECT ADDR OF RN TABLE STA D$RN * CCA ADA RNRQ SET CALLING ADDR IN SUSP. WORD STA XSUSP,I IN CASE OF SUSPENSION LDA RNRQ,I SET RETURN ADDR JSB $DRAD WORRY ABOUT FTN CALLS STA RQRTN IN CASE OF ABORT * ISZ RNRQ LDB RNRQ,I LDA B,I GET OPTION WORD STA RQOP RAL,CLE,ELA BIT14 TO E SEZ,RSS NO ABORT OPTION? JMP ABCAL NO, NORMAL CALL * LDB XSUSP ADB D7 GET ADDR OF STATUS LDA B,I RAL,ERA PUT E IN BIT15 STA B,I OF STATUS WORD ISZ RQRTN BUMP RETURN ADDR * ABCAL ISZ RNRQ LDA RNRQ,I JSB $DRAD GET DIRECT ADDR STA RQNO ADDR OF RN NUMBER ISZ RNRQ LDA RNRQ,I JSB $DRAD GET DIRECT ADDR STA RQST GET ADDR OF RETURN STATUS LDB RQRTN IF RETURN ADDR CMB,INB IS LESS THAN ADB RNRQ THIS NOW, SSB,RSS THEN JMP ERN02 ABORT WITH RN02 * LDB XEQT GET THE ID SEGMENT NUMBER JSB $IDNO TO B STB IDNO SAVE FOR EVERYBODY STB TEMP6 SAVE FOR ME LDA RQOP GET THE OPTION WORD AND B77 IF NO BITS SET THEN CLB SET B FOR ERROR EXIT SZA,RSS TAKE JMP ERN00 ERROR EXIT * AND B30 MASK TO THE ALLOCATE BITS SZA,RSS IF NO ALLOCATION REQUESTED JMP DAL GO TEST FOR DEALLOCATE * AND B10 LDB B377 SZA,RSS GLOBAL ALLOCATE? (BIT 4) STB IDNO YES, SET IDNO TO 377B CCB SET TO SCAN FROM TOP JSB $ALRN ALLOC AN RN AND SET RNADR STA RQNO,I SET IN THE USER AREA SZqA SKIP IF ALLOCATION FAILED JMP DALX ELSE GO TEST DALLOCATION * LDA D$RN GET SUSPEND FLAG JMP $RNSU CHECK IF NEED TO SUSPEND * DAL LDA RQNO,I GET THE RN USER SUPLIED WORD AND B377 ISOLATE THE RN#. STA B TEST THE RN CMB,INB TO SEE IF IN THE ADB $RNTB TABLE CLE,SZA IF ZERO OR SSB BIGGER THAN LEGAL JMP ERN02 GO BOOM! * ADA D$RN INDEX INTO THE RN TABLE STA RNADR SET THE RN ADDRESS LDA A,I GET THE RN ENTRY XOR RQNO,I IS IT OWNED AND C377 BY THE SAME USER HE THINKS? CLE,SZA JMP ERN03 NO TOO BAD ABOUT THAT! * DALX LDA RQOP TEST FOR AND B40 DEALLOCATE SZA,RSS BIT SET? JMP SET NO GO DO THE SET THING * LDA RQNO,I GET THE RN AND ALF,CLE,ALF MAKE SURE HE OWNS IT AND B377 OWNER ID# TO A CPA B377 IF GLOBAL RSS OR CPA TEMP6 HE IS OWNER CLA,RSS THEN SKIP THE JMP ERN03 BAD NEWS SEND 'RN03' (WATCH E) * STA RNADR,I CLEAR THE RN ASSIGNMENT LDA D$RN RESCHEDULE JSB $SCD3 ALLOCATION WAITERS JMP CLRN2 GO DO CLEAR SCHEDULING * SET LDA RNADR,I GET THE RN AND B377 MASK TO CURRENT LOCK LDB RQOP GET THE FLAG WORD CCE,SLB,RSS IF LOCK ERB,SLB THEN JMP LOKRN GO DO LOCK * CLRN LDB RQOP CHECK FOR CLEAR RBR,RBR FLAG. IF NOT CLE,SLB,RSS SET JUST JMP EXRN EXIT * SZA IF NEVER LOCKED, THEN OK. CPA B377 IF GLOBALLY LOCKED RSS CPA TEMP6 OR LOCKED BY CALLER RSS THEN OK, ELSE JMP ERN03 SEND 'RN03' (WATCH E) * XOR RNADR,I CLEAR THE RN. STA RNADR,I RESTORE THE WORD * CLRN2 JSB SRNW SCHEDULE THE WAITERS EXRN CLB,\INB SET THE CLEAR FLAG JMP $RNEX EXIT TO DISPATCHER PROPERLY * * LOCK RN ROUTINE * LOKRN LDB B377 GET GLOBAL FLAG SEZ IF LOCAL LDB TEMP6 REPLACE WITH LOCAL SZA IF NOT LOCKED CPA TEMP6 OR LOCKED TO CALLER CMA,INA,RSS THEN OK CONTINUE JMP LKSUS ELSE SUSPEND THIS GUY. * LOKIT ADA B SET LOCK FLAG LESS CURRENT ENTRY ADA RNADR,I SET THE LOCK FLAG STA RNADR,I IN THE RN TABLE LDA B SET A=ID OF NEW LOCKER JMP CLRN GO TEST FOR CLEAR OPTION * LKSUS LDA RNADR GET THE SUSPEND FLAG JMP $RNSU AND GO SUSPEND SPC 2 * SRNW SCHEDULES ANY PROGRAMS SUSPENDED IN THE '3' LIST * WITH A FLAG = (RNADR) (USUALLY RN LOCK REQUEST SUSPEND) * SRNW NOP LDA RNADR GET THE FLAG WORD JSB $SCD3 SCHEDULE ALL SUCH WAITERS JMP SRNW,I RETURN * * ERN02 LDB D2 RN02 ERROR RSS ERN03 LDB D3 RN03 ERROR ERN00 LDA ASRN USE RN JMP $ERAB GO BOOM!#$#$%&'" * ASRN ASC 1,RN SKP * LU UNLOCK REQUEST * * D$RN DEF $RNTB D2 DEC 2 D3 DEC 3 D7 DEC 7 B377 OCT 377 C377 OCT 177400 B77 OCT 77 B10 OCT 10 B30 OCT 30 B40 OCT 40 * TEMP6 NOP * RQRTN EQU 1677B RETURN POINT ADDRESS IDNO EQU 1704B USERS ID SEG # RNADR EQU 1705B RN ADDR IN RN TABLE XEQT EQU 1717B ID SEGMENT ADDR. OF CURRENT PROG. XSUSP EQU 1730B 'POINT OF SUSPENSION' * RQOP EQU 1701B RQP2 USED FOR RN OPTION NUMBER RQNO EQU 1702B RQP3 USED FOR ADDR OF RN NUMBER RQST EQU 1703B RQP4 USED FOR ADDR OF RN STATUS ORG * PROGRAM LENGTH END w 7 A 92064-18210 1740 S 0122 &MLURQ LU LOCK             H0101 ASMB,R,L,C ** LURQ LU LOCK REQUEST MODULE ** HED ** REAL-TIME EXECUTIVE LURQ LU LOCK REQUEST MODULE ** * NAME: MLURQ * SOURCE: 92064-18210 * RELOC: 92064-16081 * PGMR: G.A.A.,E.J.W. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1975. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM MLURQ,6 92064-16081 REV.1740 770812 EXT $ERAB,$RNTB,$IDNO,$SCD3,$LUSU,$DRAD EXT $LIBR,$PVCN,$ALRN,$LUEX,$ULLU ENT LURQ * SUP A EQU 0 B EQU 1 * * * * THE LU LOCK FEATURE ALLOWS A PROGRAM TO LOCK AN LU * TO HIS PROGRAM EXCULSIVELY. ANY OTHER PROGRAM IS * PUT IN THE WAIT LIST WHEN IT REQUESTS EITHER * A LOCK ON THE SAME LU OR WHEN IT ATTEMPTS I/O * ON A LOCKED LU (ASSUMING IT IS NOT LOCKED TO HIM) * * THE WAITING PROGRAM WILL BE RESTARTED WHEN THE * LU IS UNLOCKED. ALL LU'S LOCKED TO A PROGRAM WILL BE * UNLOCKED WHEN THE PROGRAM TERMINATES. LU'S MAY * ALSO BE UNLOCKED SELECTIVELY WITH THE FOLLOWING * CALL. * * CALL TO LOCK/UNLOCK AN LU * * EXT LURQ * * JSB LURQ * DEF *+4 * DEF IOPT ADDRESS OF OPTION FLAG WORD * DEF LUARY ADDRESS OF ARRAY OF LU'S * DEF NOLU ADDRESS OF NUMBER OF LU'S TO LOCK/UNLOCK * RETURN - - * . * . * . *LUARY DEC N1 ARRAY OF LU'S TO BE LOCKED * DEC N2 ONLY THE LEAST 6 BITS ARE USED. * . * . * . *IOPT DEC OPTION OPTIONS FOR THIS CALL SEE BELOW *NOLU DEC NO NUMBER OF LU'S IN THE ARRAY * * OPTIONS ARE: * IOPT MEANING * 0 UNLOCK SPECIFIED LU'S * 100000B MUNLOCK ALL OWNED LOCKS * 1 LOCK WITH WAIT THE SPECIFIED LU'S * 100001B LOCK WITHOUT WAIT THE SPECIFIED LU'S. * * TO PREVENT A DEAD LOCK AN ARRAY OF LU'S IS TO BE USED * IT IS POSSIBLE TO RELEASE LOCKS ON AN LU AT ANY TIME. * IF A NO WAIT LOCK REQUEST IS MADE AND THE CALLER ALREADY * HAS ONE OR MORE LU'S LOCKED HE WILL BE ABORTED 'LU01' * * ON A NO WAIT RETURN THE A REGISTER INDICATES THE * STATUS AS FOLLOWS: * * A REGISTER MEANING * -1 NO RN AVAILABLE AT THIS TIME * 0 REQUEST SUCESSFUL * 1 ONE OR MORE OF THE LU'S IS ALREADY LOCKED TO * ANOTHER PROGRAM * * POSSIBLE ABORT ERRORS ON THIS REQUEST ARE: * ERROR MEANING * LU01 HE HAS OTHERS LOCKED AND WAIT OPTION * LU02 ILLEGAL LU * LU03 NOT ENOUGH PRAMETERS * RN01 SYSTEM HAS NO RN'S * RN03 HE DOESN'T OWN THE LOCK HE IS TRYING TO RELEASE * * INTERNAL FUNCTION: * * THE USER IS ASSIGNED AN RN WHICH IS LOCKED TO HIM. * THE DRT ENTRY FOR EACH LOCKED LU CONTAINS A POINTER * TO THE RN USED TO DO THE LOCK. * * ALL A PROGRAMS LU LOCKS ARE CONNECTED WITH THE SAME RN * AND THE DRT FIELD IS 5 BITS WIDE, THUS A TOTAL * OF 31 (0 IS RESERVED FOR NO LOCK) PROGRAMS * MAY HAVE LU'S LOCKED AT THE SAME TIME. * THE DRT ENTRY IS IN BITS 6-10 OF THE DRT ENTRY. * SKP LURQ NOP JSB $LIBR PRIVILEGED ENTRY NOP CLA CLEAR CNTR SINCE WE DON'T STA $PVCN PLAN TO RETURN VIA $LIBX LDA D$RN JSB $DRAD GET DIRECT ADDR OF RN TABLE STA D$RN * CCA ADA LURQ SET CALLING ADDR IN SUSP. WORD STA XSUSP,I IN CASE OF SUSPENSION LDA LURQ,I SET RETURN ADDR JSB $DRAD (WORRY ABOUT FTN CALLS.) STA RQRTN IN CASE OF ABORT * ISZ LURQ LDB LURQ,I LDA B,I  GET OPTION WORD STA RQOP RAL,CLE,ELA BIT14 TO E SEZ,RSS NO-ABORT OPTION? JMP ABCAL NO, NORMAL CALL * LDB XSUSP ADB D7 GET ADDR OF STATUS LDA B,I RAL,ERA PUT E INTO BIT15 STA B,I OF STATUS WORD ISZ RQRTN BUMP RETURN ADDR * ABCAL ISZ LURQ LDA LURQ,I JSB $DRAD GET DIRECT ADDR STA RQTB ADDR OF LU ARRAY ISZ LURQ LDA LURQ,I JSB $DRAD GET DIRECT ADDR STA RQSZ ADDR OF NUMBER OF LU'S LDA BIT15 CPA RQOP IF REQ IS RELEASE ALL JMP LUUL3 SKIP PARAMS CHECK * LDB RQRTN MAKE SURE THERE ARE CMB,INB ENOUGH PARAMETERS ADB LURQ ELSE SSB,RSS REJECT JMP ELU03 WITH LU03 ERROR * LDB XEQT HERE ON LU LOCK CALL JSB $IDNO GET THE USERS ID NUMBER STB IDNO SET FOR ALLOCATE, ECT BLF,BLF PUT USER OWN/LOCK ADB IDNO FLAG IN STB TEMP6 TEMP6 LDA RQSZ,I GET THE # OF LU'S CMA,INA,SZA IF NEG OR ZERO, SSA,RSS JMP ELU03 'LU03' ERROR * STA TEMP5 SET COUNTERS STA TEMP4 FOR THE TWO LOOPS LDA LUMAX GET THE DRT SIZE CMA SET NEG OF MAX LU STA TEMP3 STA TEMP9 SET FOR BOTH LOOPS LDB RQTB GET THE LU ARRAY ADDRESS STB RQP7 AND SET LDA RQOP GET THE OPTION FLAG SLA,RSS IF THIS IS NOT LOCK REQ, JMP LUUL1 GO TO RELEASE CODE * * CHECK IF AN RN HAS ALREADY BEEN ASSIGNED * FOR THIS PROGRAMS LU LOCKS. * ISZ TEMP3 STEP LU COUNTER LDB DRT GET THE DRT ADDRESS LULK1 LDA B,I GET LU ENTRY AND B3700 MASK TO LU LOCK FLAG STA RQP8 SAVE THE LOCK FLAG ALF,ALF ROTATE TO RAL,CLE,RAL LOW AND USE TO ADA D$RN INDEX INTO THE RN TABLE LDA A,I GET RN CODE CPA TEMP6 IF OWNED AND LOCKED BY CALLER JMP LULK8 BY CALLER, JUMP * CCE,INB ELSE STEP DRT ISZ TEMP3 ADDRESS IF NOT END JMP LULK1 CONTINUE SEARCH * CLA CLEAR ALLOCATED FLAG STA RQP8 * LULK2 CCB TEST TO SEE IF ALL ADB DRT THE LU'S HE WANTS LDA RQP7,I ARE AVAILABLE AND B77 GET THE LU FROM HIS ARRAY ADB A AND INDEX INTO THE DRT ADA TEMP9 IF GREATER THAN MAX. CCE,SSA,RSS LU ON SYSTEM JMP ELU02 GO ISSUE 'LU02' ABORT * LDA B,I GET THE DRT ENTRY AND B3700 MASK OUT THE LOCK CODE SZA IF AVAILABLE CONTINUE JMP LULK5 ELSE GO SUSPEND * LULK3 ISZ RQP7 STEP LU ARRAY ISZ TEMP4 AND COUNT DONE? JMP LULK2 NO TRY NEXT LU. * LDA RQP8 GET THE ALLOCATED FLAG SZA IF AN RN ALREADY ALLOCATED JMP LULK4 GO SET UP * * NO RN ASSIGNED SO ALLOCATE ONE * CLB,INB ASSIGN FROM LOW END OF TABLE JSB $ALRN AND B377 SET RN NUMBER IN A STA B AND B AND B37 IF RN>37B CPA B OR ZERO SZA,RSS THEN GO JMP LULK7 HANG HIM UP. * BLF,BLF MOVE NUMBER TO RBR,RBR BITS 6-10 STB RQP8 AND SET FOR LOCK LOOP LDB TEMP6 GET THE LOCAL LOCK FLAG STB RNADR,I AND SET IN RN TABLE * LULK4 CCB SET ALL REQUESTED LU'S ADB DRT LOCKED TO LDA RQTB,I THE CURRENT AND B77 CALLER. ADB A DRT ADDRESS TO B LDA B,I GET DRT ENTRY IOR RQP8 SET LOCK FLAG STA B,I RESET IN THE DRT ISZ RQTB STEP ARRAY ADDRESS ISZ TEMP5 IF NOT DONE JMP LULK4 DO THE NEXT ONE * LULKS CLA SET A TO SHOW LULKF STA XA,I SUCESSFU%L COMPLETION JMP $LUEX EXIT VIA LU-RN EXIT CODE * LULK5 ALF,ALF IF LOCK IS TO CALLER RAL,RAL THEN ADA D$RN THE LOCK STA RNADR IS TO LDA A,I BE IGNORED CPA TEMP6 TO CALLER? JMP LULK3 YES OK * * LOCKED TO SOME OTHER PROGRAM * CLA,INA SET FAILURE FLAG LULK6 LDB RQOP IF SUSPEND OPTION SSB SUSPEND OPTION? JMP LULKF YES, EXIT LDA RNADR NO, SUSPEND PROGRAM JMP $LUSU * * * ALLOCATION FAILED - * LULK7 CLB IF BECAUSE >32B SZA THEN STB RNADR,I RELEASE THE RN LDB D$RN SET SUSP FLAG STB RNADR IN RNADR AND CCA SET THE COMPLETION FLAG JMP LULK6 GO EXIT * * HE HAS AT LEAST ONE LU LOCKED ALREADY * TO PREVENT DEAD LOCK HE MUST NOT CODE * WAIT ON SUBSEQUENT CALLS * LULK8 LDA RQOP GET THE OPTION FLAG ERN01 CME,SSA AND THIS CALL WITH JMP LULK2 WAIT THEN * CLB,INB,RSS SEND 'LU01' ELU02 LDB D2 LU ERROR RSS ELU03 LDB D3 LU ERROR LDA ASLU LU ERROR JMP $ERAB GO BOOM!#$#$%&'" * ASLU ASC 1,LU * * * LUUL1 CCB ELSE ADB DRT SCAN HIS LDA RQP7,I ARRAY AND B77 AND ADB A DO THE THING ADA TEMP3 IF ILLEGAL LU CCE,SSA,RSS SEND 'LU02' ERROR JMP ELU02 * LDA B,I GET THE DRT ENTRY AND B3700 MASK LOCK FLAG STA TEMP9 SAVE IN CASE FOUND ALF,ALF ROTATE TO RAL,RAL LOW A AND ADA D$RN USE TO INDEX THE RN TABLE STA RNADR SAVE THE ADDRESS LDA A,I GET THE FLAG CPA TEMP6 HIS? RSS YES SKIP ERROR EXIT JMP ELU03 NO- TOO BAD, YOU LOSE. * LDA B,I UNLOCK THE XOR TEMP9 LU STA B,I ISZ RQP7 STEP HISa@$" ARRAY ADDRESS ISZ TEMP4 DONE? JMP LUUL1 NO TRY NEXT ONE * LDA RNADR SCHEDULE ANY WAITING PROGRAMS JSB $SCD3 * ISZ TEMP3 TEST IF ANY LU'S LDB DRT STILL LOCKED LUUL2 LDA B,I BY CALLER AND B3700 IF SO CPA TEMP9 JUST JMP LULKS EXIT * INB STEP DRT ADDRESS ISZ TEMP3 AN COUNT / DONE? JMP LUUL2 NO TRY NEXT * CLA NO LU'S LOCKED STA RNADR,I DEALLOCATE THE RN LDA D$RN SCHEDULE ANY ALLOCATION JSB $SCD3 WAITERS AND JMP LULKS EXIT * LUUL3 LDB XEQT RELEASE ALL JSB $ULLU LU'S LOCKED BY JMP LULKS CALLER AND RETURN * D$RN DEF $RNTB D2 DEC 2 D3 DEC 3 D7 DEC 7 BIT15 OCT 100000 B377 OCT 377 B3700 OCT 3700 B77 OCT 77 B37 OCT 37 * TEMP3 NOP TEMP4 NOP TEMP5 NOP TEMP6 NOP TEMP9 NOP * DRT EQU 1652B LUMAX EQU 1653B * RQOP EQU 1701B RQTB EQU 1702B RQSZ EQU 1703B IDNO EQU 1704B RQP5 IS USERS ID SEG # RNADR EQU 1705B RQP6 IS RN ADDR IN RN TABLE * RQRTN EQU 1677B RQP7 EQU 1706B RQP8 EQU 1707B XEQT EQU 1717B XSUSP EQU 1730B XA EQU 1731B ORG * PROGRAM LENGTH END $ 8 C 92064-18211 1709 S C0122 &MPRTN PARAMETER RETURN             H0101 ASMB,L ** PRTN TO RETURN PARAMETERS TO SCHEDULING PROG ** HED PRTN TO RETURN PRAMETERS TO THE SCHEDULING PROGRAM * NAME: MPRTN * SOURCE: 92064-18211 * RELOC: 92064-16081 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1975. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM MPRTN,6 92064-16081 REV.1709 761122 ENT PRTM ENT PRTN EXT $LIBR,$LIBX SPC 2 * THIS ROUTINE IS USED TO PASS FIVE PARAMETERS TO THE PROGRAM * THAT SCHEDULED THE CALLER WITH WAIT. IT DOES NOT HONOR THE * NO PARAMETERS BIT. * * THE SCHEDULING PROGRAM MAY RECOVER THESE PARAMETERS WITH RMPAR. * * THE WAIT FLAG IS CLEARED SO THE CALLER SHOULD HAVE HIGHER * PRIORITY THAN THE SCHEDULER TO PREVENT A SWAP. * * CALLING SEQUENCE: * * JSB PRTN * DEF *+2 STANDARD FORTRAN SEQUENCE * DEF PRAM ADDRESS OF THE FIVE RETURN PRAMATERS * JSB EXEC PROGRAM SHOULD COMPLETE * DEF *+2 * DEF SIX SPC 3 PRTN NOP ENTRY POINT JSB $LIBR GO DO PRIVLEDGE THING COUNT NOP LDA PRTN GET THE ADDRESS OF THE CALL PRAMS LDB A,I GET RETURN ADDRESS STB RTN SAVE IT INA STEP TO PRAM ADDRESS LDA A,I GET PRAM ADDRESS RAL,CLE,SLA,ERA REMOVE POSSIBLE INDIRECT JMP *-2 IF INDIRECT TRY AGAIN STA PRTN SAVE THE PRAM ADDRESS LDA KEYWD GET HEAD OF THE KEY WORD LIST STA PRTM SAVE IT LOCALLY JMP NEXT1+1 GO SCAN THE LIST SPC 1 NEXT CLB,INB ADD ONE ADB A TO IT TO GET THE WAIT ID ADDRESS STB ID ALSO THE PRAM SAVE ADDRESS SAVE IT LDB B,I GET THE WORD CPB XEQT THIS THE SCHEDULING PROGRAM? JMP FOUND LOOKS GOOD GO CHECK THE STATUS NEXT1 ISZ PRTM STEP KEYWORD ADDRESS LDA PRTM,I GET NEXT ENTRY SZA IF END OF LIST EXIT JMP NEXT NOT END TRY NEXT ID SPC 1 EXIT LDA OP1 RESET THE OPTION FOR PRTN ENTRY STA OPTIN JSB $LIBX EXIT TO THE SYSTEM EXIT ROUTINE DEF RTN RETURN ADDRESS SPC 1 RTN NOP ID NOP STAT NOP SPC 2 FOUND LDB D5 CACULATE LAST PRAM ADDRESS ADB A TO B STB LAST SAVE IT FOR TESTING ADB D10 CALCULATE THE STATUS ADDRESS STB STAT SAVE IT LDB B,I GET STATUS OF SCHEDULER BLF,SLB IS HE WAITING? OPTIN CCE,RSS (OR CLE,INA,RSS FOR PRTM) JMP NEXT1 NO TRY NEXT PGM ERB,CLE,ELB CLEAR WAIT BIT(SAVE E-REG.) BLF,BLF ROTATE B THE REST BLF OF THE WAY AROUND OVER SEZ,CLE,INA ADVANCE POINTER. STB STAT,I SAVE STATUS WITHOUT WAIT BIT IF PRTN. LDB PRTN,I GET FIRST PRAM STB A,I SET PRAM ISZ PRTN STEP ADDRESS CPA LAST LAST PRAMETER? CLB,INB,RSS YES B_1 AND SKIP JMP OVER NO GO DO NEXT ONE ADA D5 YES SET TO B REG ADDRESS LDB ID GET ADDRESS OF PRAM AREA STB A,I SET BREG SAVE TO POINT TO PRAMS JMP EXIT DONE RETURN TO PGM SPC 3 OP1 CCE,RSS INARS CLE,INA,RSS PRTM ENTRY A OPTION LAST NOP D5 OCT 5 D10 DEC 10 SPC 2 PRTM NOP OPTIONAL ENTRY FOR FOUR JSB $LIBR PRAMETER PASS WITH OUT CLEARING NOP THE WAIT BIT LDA INARS GET THE OPTIONAL INSTRUCTION STA OPTIN SET IT IN THE CODE LDA PRTM GET THE RETURN ADDRESS STA PRTN SET IT IN THE MAIN ENTRY POINT JMP COUNT+1 GO TO MAIN LINE AN D DO THE JOB SPC 2 A EQU 0 B EQU A+1 KEYWD EQU 1657B XEQT EQU 1717B END # 9A 92064-18212 1709 S C0122 &MEQLU EQ/LU CONVERSION             H0101 ASMB,R,L,C ** EQLU - FIND 'LU' FROM EQT4 ADDR IN B REG ** HED -EQLU - FIND 'LU' FROM EQT4 ADDRESS IN B-REG * NAME: MEQLU * SOURCE: 92064-18212 * RELOC: 92064-16081 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1975. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM MEQLU,6 92064-16081 REV.1709 741120 ENT EQLU EXT $LIBR,$LIBX * * ROUTINE TO FIND THE LOGICAL UNIT NUMBER OF A DEVICE * GIVEN THE ADDRESS OF WORD 4 OF ITS EQUIPMENT TABLE * CALLED AS FOLLOWS: * * LDB EQT4 (PASSED FROM DVR00/DVR65) * * JSB EQLU -OR- JSB EQLU -OR- CALL EQLU (LUSDI) * DEF *+2 DEF *+1 * DEF LUSDI * * A-REG. = 0 IF NOT FOUND -OR- * A-REG. = THE LOGICAL UNIT NUMBER IF FOUND * LUSDI = RETURNED SAME AS A-REG. * B-REG. = ASCII "00" -OR- LOGICAL UNIT IN ASCII (I.E. "16") * SUP EQLU NOP ENTRY JSB $LIBR PRIVLAGED ROUTINE NOP STB EQT4 SAVE B-REG FOR LATER TEST LDA EQLU,I GET ADRS OF RETURN ADDRESS ISZ EQLU BUMP TO POSSIBLE PRAM. LDB EQLU,I GET POSS. ADDRS OF PRAM. CPA EQLU PARAMETER PASSED? CLB NO, SET DUMMY ADRS (A-REG.) STA EQLU SET RETURN POINT FOR $LIBX STB LUADR SET PASSED PRAM. ADDRESS CLA STA LUNUM SET LU POINTER NEXT LDA LUNUM GET CURRENT LU NUM-1 CPA LUMAX DONE THRU ALL LU'S JMP NTFND YES, NOT FOUND!! ISZ LUNUM BUMP TO CURRENT LU ADA DRT POINT TO TABLE ADDRESS LDA 0,I GET CONTENTS AND O7~"  7 MASK OF SUBCHANNEL BITS MPY D15 CALCULATE ADDRESS OF WORD 4 ADA EQTA BASE ADDRESS ADA DM12 SUBTRACK ONE EQT & ADD DEC 3 CPA EQT4 COMPARE?? JMP FOUND YES !! JMP NEXT NO, TRY NEXT ONE SPC 1 NTFND STB LUNUM NOT FOUND RETURN A=0 FOUND LDA LUNUM FOUND RETURN A= LU NUMBER DIV D10 CONVERT TO ASCII ALF,ALF POSITION MOST SIG. DIGIT ADB 0 MIRGE IN LEAST ADB ASC00 CONVERT TO ASCII LDA LUNUM RESTORE BINARY VALUE STA LUADR,I PASS BACK TO CALLER JSB $LIBX RETURN A=BIN. VALUE, B= ASCII VALUE DEF EQLU SPC 1 EQT4 NOP LUADR NOP LUNUM NOP O77 OCT 77 D10 DEC 10 ASC00 ASC 1,00 D15 DEC 15 DM12 DEC -12 EQTA EQU 1650B DRT EQU 1652B LUMAX EQU 1653B END   :A 92064-18213 1709 S C0122 &MDRCT DIRECT ADDRESS             H0101 lASMB,L HED .DRCT ROUTINE * NAME: MDRCT * SOURCE: 92064-18213 * RELOC: 92064-16081 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1975. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM MDRCT,7 92064-16081 REV.1709 741120 SPC 1 ENT .DRCT * CALLING SEQUENCE * THIS ROUTINE TRACKS DOWN POSSIBLE INDIRECT ADDRESSES * * JSB .DRCT * DEF ADDR * RETURN IS TO HERE WITH A THE ADDRESS * B IS UN ALTERED E IS LOST .DRCT NOP LDA .DRCT LDA A,I RAL,CLE,SLA,ERA JMP *-2 ISZ .DRCT JMP .DRCT,I A EQU 0 END K ;A 92064-18214 1826 S C0122 &MREIO RE-ENTRANT I/O             H0101 ]ASMB,L,C ** REIO ** * NAME: MREIO * SOURCE: 92064-18214 * RELOC: 92064-16081 * PGMR: G.A.A. * DATE: OCT. 2,1974 * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM MREIO,7 92064-16081 REV.1826 780426 EXT .DFER,$LIBR,$LIBX,EXEC,.ENTR ENT REIO SUP SPC 1 * THIS ROUTINE DOES REENTRENT I/O IF THE USERS BUFFER * IS 3 OR MORE WORDS ABOVE THE LOW MAIN ADDRESS * THIS RESTRICTION IS ENFORCED BECAUSE THE USERS BUFFER * IS USED AS A TDB FOR THE REENTRANT PROCESSOR AND THUS * THREE WORDS ARE REQUIRED AHEAD OF IT. * * THESE THREE WORDS ARE SAVED LOCALLY AND THE TDB IS SET UP * AFTER THE I/O HAS COMPLETED THE WORDS ARE RESTORED. * * IF THE BUFFER IS TOO CLOSE TO THE LOW MAIN THE I/O IS PREFORMED * IN THE STANDARD MANNER. THIS IS ALSO TRUE IF THE BUFFER IS * MORE THAN 129 WORDS LONG (TO CONSERVE SYSTEM MEMORY). * * CALLING SEQUENCE: * * THE SAME AS THE EXEC I/O CALL WITH OUT THE TRACK/SECTOR WORDS. * RQ BSS 4 PRAMETER ADDRESS AREA REIO NOP ENTRY POINT JSB .ENTR FETCH THE PRAMETERS DEF RQ LDA RQ+3,I PULL PRAMETERS IN LOCALLY STA RQ+3 INCASE THEY ARE LDA RQ,I ARE IN THE THREE WORD STA RQ AREA AHEAD OF LDA RQ+1,I THE BUFFER STA RQ+1 * LDA RQ+2 GET THE BUFFER ADDRESS ADA N3 LESS THREE AND STA TDBA SET UP THE LIBR/LIBX STA TDBA2 CALLS CMA SET NEGATIVE AND TEST LDB XEQT .CHECK FOR LOW MAIN ADDRESS INTRUSION    ADB D22 ADA B,I CLE,SSA,RSS IF BELOW THE FENCE JMP DIRIO GO DO DIRECT I/O. * JSB .DFER ELSE SAVE THE THREE WORDS DEF S1 IN LOCAL SAVE AREA DEF TDBA,I LDB RQ+3 GET THE REQUEST LENGTH SSB,RSS IF POSITIVE SKIP CONVERSION JMP RE1 * BRS CONVERT CHARACTERS TO CMB,INB WORDS AND SET POSITIVE RE1 ADB D3 ADD THREE WORDS FOR TDB LENGTH STB A AND PUT IN A FOR LENGTH TEST ADA N133 SUBTRACT 133 (129 + 3 + 1) CLE,SSA,RSS IF POSITIVE OF ZERO JMP DIRIO DO IT DIRECT * CLA,CCE SET ZERO IN WORD ONE AND DST TDBA,I LENGTH IN WORD TWO OF THE TDB JSB DOIO GO DO THE I/O S1 OCT 0,0,0 RETURN SKIPS THREE WORDS DST RQ SAVE THE REGISTERS JSB .DFER RESTORE THE THREE WORDS DEF TDBA,I DEF S1 DLD RQ RESTORE THE A AND B REGS. JMP REIO,I AND EXIT TO USER. * DOIO NOP JSB $LIBR TELL THE SYSTEM WE ARE TDBA DEF * RENT DIRIO JSB EXEC DO THE I/O CALL DEF EX RETURN ADDRESS DEF RQ DEF RQ+1 DEF RQ+2,I DEF RQ+3 EX RSS SKIP IF ERROR EXIT ISZ REIO ELSE STEP RETURN ADDRESS SEZ,RSS IF DIRECT JMP REIO,I EXIT * JSB $LIBX ELSE EXIT RENT TDBA2 DEF * SECTION D3 DEC 3 +3 WORDS * N133 DEC -133 N3 DEC -3 D22 DEC 22 XEQT EQU 1717B A EQU 0 B EQU 1 ORG * END D  <C 92064-18215 1709 S C0122 &MIFBR BREAK TEST             H0101 IAASMB,R,L,C ** IFBRK ** HED R/T IFBRK MODULE * NAME: MIFBR * SOURCE: 92064-18215 * RELOC: 92064-16081 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1975. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM MIFBR,7 92064-16081 REV.1709 741120 * ENT IFBRK EXT $LIBR,$LIBX SPC 2 * CALLING SEQUENCE: * * IF(IFBRK(IDMY)) 10,20 * * WHERE: 10 BRANCH WILL BE TAKEN IF SET & WILL CLEAR IT. * 20 BRANCH WILL BE TAKEN IF NOT SET * * JSB IFBRK * DEF *+1 * A-REG. = -1 IF SET, ELSE A-REG = 0 * BREAK BIT WILL ALWAYS BE CLEARED IF SET! SPC 1 IFBRK NOP ENTRY FROM FTN LDA IFBRK,I GET P+1 ADDRESS STA IFBRK SET RETURN ADDRESS LDB XEQT GET IDSEG ADDRESS OF THIS PROG ADB D20 GET ID(21) ADDRESS LDA B,I GET CONTENTS AND BIT12 MASK DOWN TO BIT 12 SZA,RSS SET? JMP IFBRK,I NO, RETURN A=0 JSB $LIBR TURN OFF INTERRUPTS NOP XOR B,I YES, CLEAR IT STA B,I RESTORE WORD 21 CCA RETURN A-REG. = -1 JSB $LIBX DEF IFBRK SPC 1 D20 DEC 20 BIT12 OCT 10000 XEQT EQU 1717B B EQU 1 END Y =C 92064-18216 1709 S C0122 &MCORA MEMORY LIMIT             H0101 YASMB,L ** COR.A ** HED COR.A ROUTINE * NAME: MCORA * SOURCE: 92064-18216 * RELOC: 92064-16081 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1975. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM MCORA,7 92064-16081 REV.1709 741120 ENT COR.A * * ROUTINE TO FIND THE ADDRESS OF THE FIRST WORD OF AVAIL MEM. * FOR A GIVEN ID SEGMENT * * CALLING SEQUENCE: * * LDA IDSEG GET ID SEGMENT ADDRESS TO A * JSB COR.A CALL THIS ROUTINE * RETURN A= FIRST WORD OF AVAIL MEM (MEM2 FROM ID) * COR.A NOP ADA .14 INDEX TO THE NAME 5 WORD LDB A,I GET THE WORD BLF,BLF ROTATE THE BLF,SLB SHORT ID FLAG TO LOW B AND TEST INA,RSS SHORT SO INDEX TO MEM ADA .8 LONG SO INDEX TO MEM INA INDEX TO MEM2 LDA A,I SET IT IN A JMP COR.A,I RETURN * .14 DEC 14 .8 DEC 8 A EQU 0 END  >D 92064-18217 1709 S C0122 &MKCVT OCTAL TO ASCII CONVERSION             H0101 LASMB,R,L ** KCVT ** HED CONVERT ROUTINE * NAME: MKCVT * SOURCE: 92064-18217 * RELOC: 92064-16081 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1975. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM MKCVT,6 92064-16081 REV.1709 741120 ENT KCVT * * EXT $CVT1,.ENTP,$LIBR,$LIBX * NUMBR BSS 1 * KCVT NOP JSB $LIBR NOP JSB .ENTP DEF NUMBR LDA NUMBR,I CCE JSB $CVT1 JSB $LIBX DEF KCVT END X ?E 92064-18218 1709 S C0122 &MPARS SYSTEM PARSE             H0101 iASMB,R,L ** PARSE ** HED PARSE ROUTINE * NAME: MPARS * SOURCE: 92064-18218 * RELOC: 92064-16081 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1975. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM MPARS,6 92064-16081 REV.1709 741120 ENT PARSE * EXT $PARS,.ENTP,$LIBR,$LIBX * CMBUF BSS 1 BFLEN BSS 1 BUFR BSS 1 * PARSE NOP JSB $LIBR NOP JSB .ENTP DEF CMBUF LDA BUFR STA BUFR1 LDA CMBUF LDB BFLEN,I JSB $PARS BUFR1 BSS 1 JSB $LIBX DEF PARSE END "$ @F 92064-18219 1709 S C0122 &MTMVL TIME VALUES             H0101 }kASMB,L ROUTINE TO CONVERT TIME HED TMVAL * NAME: MTMVL * SOURCE: 92064-18219 * RELOC: 92064-16081 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1975. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM MTMVL,6 92064-16081 REV.1709 741120 ENT TMVAL EXT $LIBX,$LIBR,.ENTP,$TIMV * * * CALLING SEQUENCE (FORTRAN) * * CALL TMVAL(ITM,ITMAR) * * WHERE ITM IS THE TWO WORD NEGATIVE TIME IN TENS OF * MS. AND ITMAR IS A 5 WORD ARRAY TO RECIEVE THE * TIME. THE ARRAY WILL BE SET UP AS: * * 1. TENS OF MS. * 2. SECONDS * 3. MINUTES * 4. HOURS * 5. CURRENT SYSTEM DAY OF YEAR (NOT RELATED TO CALL VALUES) * ITM NOP ITM1 NOP * TMVAL NOP JSB $LIBR NOP JSB .ENTP GET PRAMS DEF ITM * LDA ITM1 SET ADDRESS STA RQP2 FOR SYSTEM ROUTINE CLA AND ZAP THE STA RQP3 YEAR ADDRESS DLD ITM,I GET THE TIME JSB $TIMV CONVERT IT JSB $LIBX EXIT DEF TMVAL * RQP2 EQU 1701B RQP3 EQU RQP2+1 END  AG 92064-18220 1709 S C0122 &MCNMD DECIMAL TO ASCII CONV.             H0101 ASMB,L,R ** CNUMD ** HED CNUMD...ROUTINE TO CONVERT BINARY TO ASC * NAME: MCNMD * SOURCE: 92064-18220 * RELOC: 92064-16081 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1975. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM MCNMD,6 92064-16081 REV.1709 741120 SPC 2 * * ROUTINE TO CONVERT BINARY TO OCTAL. USED IN * RTEII * CALLING SEQUENCE * JSB CNUMD * DEF *+3 * DEF BINARY # TO BE CONVERTED * DEF BUFFER * . * . *BUF BSS 3 * SPC 2 * * DEFINE ENTRY POINT * ENT CNUMD SPC 2 * * DEFINE EXTERNAL * EXT $LIBR,$LIBX,.ENTP,.DFER,$CVT3 SPC 4 * * HERE WE START BY DEFINING PRAM AREA * BINA NOP BINARY # ADDRESS WILL APPEAR HERE BUFA NOP BUFFER ADDRESS WILL APEAR HERE CNUMD NOP ENTRY POINT INTO ROUTINE JSB $LIBR TURN OFF THE "LIGHT" NOP JSB .ENTP GO GET PRAMS DEF BINA CCE SET FOR BINARY TO DEC. CONVERSION LDA BINA,I GET NUMBER JSB $CVT3 GO CONVERT IT STA FROM SAVE ADDRESS FROM JSB .DFER AND MOVE IT DEF BUFA,I WHERE TO PUT IT FROM NOP JSB $LIBX AND RETURN DEF CNUMD END  BH 92064-18221 1709 S C0122 &MCNMO OCTAL TO ASCII CONVERSION             H0101 SASMB,L,R ** CNUMO ** HED CNUMO...ROUTINE TO CONVERT BINARY TO ASC * NAME: MCNMO * SOURCE: 92064-18221 * RELOC: 92064-16081 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1975. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM MCNMO,6 92064-16081 REV.1709 741120 SPC 2 * * ROUTINE TO CONVERT BINARY TO OCTAL. USED IN * RTEII * CALLING SEQUENCE * JSB CNUMO * DEF *+3 * DEF BINARY # TO BE CONVERTED * DEF BUFFER * . * . *BUF BSS 3 * SPC 2 * * DEFINE ENTRY POINT * ENT CNUMO SPC 2 * * DEFINE EXTERNAL * EXT $LIBR,$LIBX,.ENTP,.DFER,$CVT3 SPC 4 * * HERE WE START BY DEFINING PRAM AREA * BINA NOP BINARY # ADDRESS WILL APPEAR HERE BUFA NOP BUFFER ADDRESS WILL APEAR HERE CNUMO NOP ENTRY POINT INTO ROUTINE JSB $LIBR TURN OFF THE "LIGHT" NOP JSB .ENTP GO GET PRAMS DEF BINA CLE SET FOR BINARY TO OCTAL CONVERSION LDA BINA,I GET NUMBER JSB $CVT3 GO CONVERT IT STA FROM SAVE ADDRESS FROM JSB .DFER AND MOVE IT DEF BUFA,I FROM NOP JSB $LIBX AND RETURN DEF CNUMO END $ CI 92064-18222 1709 S C0122 &MIPRS INVERSE PARSE             H0101 {ASMB,R,L,C ** INPRS ** HED INPRS - PREAMBLE * NAME: MINPR * SOURCE: 92064-18222 * RELOC: 92064-16081 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1975. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM MINPR,6 92064-16081 REV.1709 741119 SUP PRESS EXTRANEOUS LISTING ENT INPRS EXT $LIBR,$LIBX,.ENTP,$CVT3 SPC 1 A EQU 0 B EQU 1 HED INPRS : DESCRIPTION * CALLING EXAMPLE : * FTN,L * PROGRAM R$PN$(2,10) * INTEGER BUFFER(22),PARBUF(33),PRAM(5),IREG(2),P1,P2,CLASS * EQUIVALENCE (PRAM(1),CLASS), * & (PRAM(2),IREG,REG,IA), * & (PRAM(3),IB), * & (PRAM(4),IC), * & (PRAM(5),ID) * CALL RMPAR(PRAM) * 1 REG = EXEC(21,BUFFER,22,IC,ID,CLASS) * CALL PARSE(BUFFER,IB,PARBUF) * <"ON" REQUEST - PARBUF(2)="ON" ?> * * * CALL INPRS(PARBUF,PARBUF(33)) * IC = MESSS(BUFFER,IB) * * * GO TO 1 * END SPC 2 * THE BUFFER 'PARBUF' LOOKS LIKE : SPC 2 * PARBUF(1) * PRAM(1) TYPE * (2) * VALUE(1) * (3) * (2) * (4) * (3) * (5) * PRAM(2) TYPE * (6) * VALUE(1) * (7) * (2) * (8) * (3) SPC 1 * ET CETERA SPC 1 * PARBUF(33)* NUMBER OF PARAMETERS PARSED SPC 2 * WHERE : TYPE = 0 => NULL PARAMETER * 1 => NUMERIC PARAMETER IN VALUE(1) * E 2 OR 3 => ASCII PARAMETERS IN VALUE(1) TO VALUE(3) HED INPRS : MAIN BUF NOP #P NOP INPRS NOP JSB $LIBR NOP JSB .ENTP DEF BUF SPC 2 LDA #P,I SET PRAM CMA,INA,SZA,RSS COUNTER JMP EXIT NO PRAMS EXIT STA #P INIT COUNTER LDB BLANK USE LEADING BLANK SPC 2 LOOP EQU * LDA BUF GET VALUE FOR INA THIS ENTRY LDA A,I AND IF SSA NEGATIVE ADB B21 CONVERT BLANK TO 1. LDA BUF,I GET PRAM SPEC STB BUF,I STORE ", " OR " " BACK ISZ BUF STEP TO VALUE CMA,INA,SZA,RSS IF ZERO JMP NULL THEN NULL PRAM SPC 2 INA,SZA,RSS IF ONE JMP NUMBR THEN NUMERIC SPC 2 ISZ BUF MUST BE ASCII,SO LOOP2 EQU * IT'S OK ISZ BUF AS ISZ BUF IS. LDB COMMA GET ", " ISZ #P DONE ? JMP LOOP NO-GET NEXT PRAM. SPC 2 EXIT EQU * JSB $LIBX YES-EXIT DEF INPRS TO CALLER SPC 2 NULL EQU * LDB BLANK FOR NULL STB BUF,I PRAM , REPLACE LDA B WITH STO EQU * ISZ BUF SIX DST BUF,I BLANKS JMP LOOP2 & GET NEXT PRAM. SPC 2 NUMBR EQU * NUMERIC PRAM PROC. LDA BUF,I GET NUMBER CCE,SSA VALUE IF CLE NEG,SET FOR OCTAL CONVERSION JSB $CVT3 CONVERT TO ASCII ERB SET E IF NEG. LDB A,I GET HIGH DIGIT SEZ,INA STEP & IF OCTAL ADB B104C CONVERT '1' TO 'B' STA T SAVE ADDRESS LDA A,I GET NEXT DIGIT RRL 8 ROTATE 1ST 2 DIGITS TO 'B'REG STB BUF,I STORE 1ST 2 DIGITS ISZ T STEP TO LAST 2 DIGITS ALF,ALF LDB T,I GET LAST 2 DIGITS RRL 8  ROTATE TO RIGHT ORDER JMP STO GO STORE IT HED INPRS : CONSTANTS B21 OCT 21 B104C OCT 10400 COMMA ASC 1,, BLANK ASC 1, T NOP HED INPRS - END END x DL 92064-18223 1709 S C0122 &.MVW MOVE WORDS SUBROUTINE             H0101 (+ASMB,L ** .MVW - MOVE WORD ROUTINE ** * NAME: .MVW * SOURCE: 92064-18223 * RELOC: 92064-16081 * PGMR: G.A.A * HED MOVE WORD ROUTINE TO SIMULATE 105777B MICROCODE INSTR * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1975. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** NAM .MVW,7 92064-16081 REV.1709 751021 RP=105777B ENT .MVW .MVW EQU * *** MOVE NOP STA FROM MICRO CODE MOVE REPLACEMENT SUB LDA MOVE,I GET THE COUNT LDA A,I TO A ISZ MOVE STEP TO NOP (NOP IS RETURN) SZA,RSS JMP OUT SKIP MOVE IF ZERO COUNT * CMA,INA SET IT NEGATIVE STA COUNT SET COUNTER LOOP LDA FROM,I GET WORD STA B,I SET IN DESTINATION INB STEP DESTINATION ISZ FROM FROM ISZ COUNT AND COUNT JMP LOOP IF NOT DONE LOOP * OUT LDA FROM PUT NEXT LOCATION IN A FOR PURISTS JMP MOVE,I AND RETURN * * A EQU 0 B EQU 1 FROM NOP COUNT NOP END  EK 92064-18224 1826 S C0122 HEADER FOR M LIB              H0101 ]ASMB,L NAM $CLIBM 92064-12007 REV.1826 780414 * THIS THE PART NUMBER NAM RECORD FOR THE RTE-M * VERSION OF THE COMPILER LIBRARY * THE PART NUMBER OF THIS THING IS * 92064-18224 END  FL 92064-18225 1826 S C0122 COMPILER LIB GET FILES             H0101 ȍASMB,R,L,C NAM GTF.C,7 92064-18225 780414 REV. 1826 $CLIB * * * * * NAME: GTF.C * SOURCE: 92064-18225 * * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * * CALLING SEQUENCE: JSB GTF.C * * * ERROR CODE RETURNED IN A REGISTER * STRING LENGTH RETURNED IN B REGISTER * * ENT GTF.C * EXT .DRCT,MGLU,IFTTY,$CON UNKNOWN ROUTINES(POS FTN LIB) EXT CLOSE,OPEN,READF,WRITF,RMPAR RTE-M REF MAN EXT .MVW ASMB MAN EXT C.TRN COMPILER LIB * * GTF.C NOP * JSB RMPAR DEF *+2 DEF ANSW LDA $CON,I FETCH CONSOLE LU AND =B77 ISOLATE IT STA CON1 SAVE IT * * * OPEN INPUT FILE/LU * LDA ANSW FETCH ANSWER NAME/LU LDB =B157777 IS THIS A NAME ? ADB A OR AN LU ?? SSB,RSS JMP OP1 IT'S A NAME--DO NORMAL OPEN * SZA,RSS IF DEFAULT LDA CON1 USE MTM TERMINAL STA LU SAVE FOR CONVERSION * * CALL ROUTINE TO CREATE FILE NAME LU..XX XX ::= LU # * (IF REQUESTED LU IS TOO LARGE OR NOT ASSIGNED * FILE NAME "LU..99" IS RETURNED. THIS WILL GENERATE * A ERROR -18 (BAD LU) IN THE OPEN ROUTINE.) * JSB MGLU CALL ROUTINE TO BUILD MAGIC NAME DEF *+3 DEF LU ADDRESS OF LU TO BE CONVERTED DEF ANSW SET IT FOR OPEN CALL * OP1 JSB OPEN DEF OP2 DEF GDCB DEF ERR DEF ANSW DEF OPOP * OP2 LDA ERR SSA JMP GTF.C,I * * SEE IF INTERACTIVE * JSB .DRCT FETCH DEF GDCB DIRECT ADDRESS OF DCB ADA =B2 ADVANCE TO TYPE WORD LDB A,I FETCH IT SZB CONTINUE IF ZERO JMP DFILE NON-INTERACTIVE * INA ADVANCE TO LU LDA A,I FETCH IT STA X JSB IFTTY DETERMINE IF INTERACTIVE DEF RTN DEF X RTN RSS DFILE CLA STA INT 0=NO,1=YES * * LDA STAA INA INA STA STAD PRESET STRING POINTER LDA .5 STA LEN PRESET STRING LENGTH (ALLOWS FOR RU,X, , , ) LDA =B-3 FETCH LOOP CNTR STA CNTR SET IT * * SET UP ADDRESSES * INPT LDA PNT2 ADA CNTR LDA A,I STA MSAD ADA .5 INA STA LNAD INA STA RDAD * * IF NOT INTERACTIVE-SKIP PROMPT * LDA INT SZA,RSS JMP RT1 JSB WRITF DEF RT1 DEF GDCB DEF ERR DEF MSAD,I DEF .5 * * * FETCH REPLY * RT1 JSB READF DEF RT2 DEF GDCB DEF ERR DEF RDAD,I REPLY DEF .20 DEF LNAD,I READ LENGTH * RT2 LDA ERR SZA JMP EX0 ERROR EXIT FROM READ * ISZ CNTR JMP INPT * LDA =B-3 RESET COUNTER STA CNTR OUTPT LDA PNTR ADA CNTR LDA A,I ADA .5 STA DFAD INA STA LNAD INA STA RDAD * * LDB LNAD,I LOAD LENGTH WORD LDA INT CHECK SINCE DEFAULT ON TERMINAL = EOF SZA,RSS JMP RT3 SSB,RSS EOF FROM TERM = ZERO RECORD AS FROM FILE SZB,RSS CLB STB LNAD,I RT3 SSB JMP EX12 ERROR EXIT LDA RDAD SZB JMP RPLY ISZ LNAD,I INSERT DEFAULT IF REQD ISZ LEN LDA DFAD RPLY ADB LEN STB LEN INCREMENT STRING LENGTH LDB CMA STB STAD,I LDB STAD INB JSB .MVW6` DEF LNAD,I NOP STB STAD INCR STRING PNTR * * ISZ CNTR JMP OUTPT * * EXIT * * EXCLS JSB CLOSE DEF *+2 DEF GDCB * LOAD RUN STRING * LDB .CTRN JMP *+2 LOOP LDB B,I RBL,CLE,SLB,ERB CLEAR INDIRECTS JMP LOOP LDA STAA JSB .MVW DEF LEN NOP LDA ERR LOAD ERROR CODE LDB LEN LOAD STRING LENGTH BLS (CHARACTERS,NO WORDS ARE EXPECTED) JMP GTF.C,I * * ERROR EXIT * * EX0 CLB STB LEN EX12 LDA =D-12 STA ERR SET MASTER ERRORCODEWORD JMP EXCLS * * * LOOP VARIABLES * * WORD 1- 5 PROMPT * 6 LENGTH OF REPLY * 7 DEFAULT * 8-21 REPLY * INP ASC 4,INPUT? OCT 3537 (BELL/BACK ARROW) ASC 1, 5 BSS 14 LENGTH WORD + 13W REPLY OUT ASC 4,OUTPUT? OCT 3537 ASC 1, 4 BSS 14 LST ASC 4,LIST? OCT 3537 ASC 1, 6 BSS 14 * DEF INP DEF LST DEF OUT PNTR DEF * DEF INP DEF OUT DEF LST PNT2 DEF * CNTR BSS 1 DFAD BSS 1 LNAD BSS 1 RDAD BSS 1 MSAD BSS 1 * * RUN STRING * LEN BSS 1 CMA OCT 26040 LEFT JUST COMMA AND BLANK STAA DEF STR STR ASC 2,RU,X X IS PLACEHOLDER FOR COMPILER NAME BSS 38 STAD BSS 1 * * GDCB BSS 144 DCB BUFFER AREA FOR INPUT .CTRN DEF C.TRN LOCAL POINTER TO LIB ERR BSS 1 ANSW BSS 5 OPOP OCT 411 OPEN OPTION CON1 BSS 1 A EQU 0 B EQU 1 INT BSS 1 LU BSS 1 X BSS 1 .5 OCT 5 .20 OCT 24 END  GO 92064-18232 1740 S 0122 &MSAFD SOURCE FLEX. DISC BACKUP             H0101 -FTN4 C C VERSION 8 / 13 / 77 SL C PROGRAM SAFD C C C************************************************************* C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * C RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * C PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * C OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C************************************************************* C C C C C C C************************************************************** C SOURCE (&MSAFD) PART NUMBER = 92064-18232 * C RELOCATABLE (%MSAFD) PART NUMBER = 92064-16086 * C DATE = 1740 * C************************************************************** C C C C C C DIMENSION LU(5),IREG(2),IHEDD(33) DIMENSION IBUF(3840),IBF(3712) INTEGER FIRST,LAST C CCCCCCCCCCCC DIMENSION MEST(31),IHEAD(33),IH2(30),IH22(30) CCCCCCCCCCCCC DIMENSION MESS1(18),MESS2(14),MESS3(17),MESS4(21) DIMENSION MESS7(11),IPBUF(33),MESS19(16) DIMENSION MESS8(2),MESS9(11),MESS10(22),MESS11(22) DIMENSION MESS13(18),MESS14(6),MESS17(15),MESS18(12) DIMENSION MESS20(6),MESS15(22),MESS12(15),MESS16(15) C CCCCCCCCCCCCCC EQUIVALENCE (ITPE,IHEAD),(ITRAK,IHEAD(2)) EQUIVALENCE (ISEC,IHEAD(3)),(IH2,IHEAD(4)) EQUIVALENCE (IH22,IHEDD(4)) CCCCCCCCCCCCCCC EQUIVALENCE (IA,IREG),(IB,IREG(2)),(X,IREG) C C CCCCCCC DATA MEST/2HEN,2HD ,2HOF,2H C,2HAR,2HTR,2HID,2HGE,2H O,2HR , & 2HMA,2HG ,2HTA,2HPE,2H R,2HEA,2HCH,2HED,2H. ,2HIN, & 2HSE,2HRT,2H N,2HEW,2H T,2HAP,2HE ,2H(#,2H ,2H , & 2H)./ DATA MESS1/6412B,2HEN,2HTE,2HR ,2HCA,2HRT,2HRI,2HDG,2HE ,2HOR, & 2H M,2HAG,2H T,2HAP,2HE ,2HLU,2H: ,2H _/ DATA MESS2/6412B,2HEN,2HTE,2HR ,2HFL,2HEX,2HIB,2HLE,2H D,2HIS, & 2HC ,2HLU,2H: ,2H _/ DATA MESS3c/6412B,2HER,2HRO,2HR ,2H- ,2HNO,2HT ,2HA ,2HFL,2HEX, & 2HIB,2HLE,2H D,2HIS,2HC ,2HLU,2H? / DATA MESS4/6412B,2HER,2HRO,2HR ,2H- ,2HNO,2HT ,2HA ,2HCA,2HRT, & 2HRI,2HDG,2HE ,2HOR,2H M,2HAG,2H T,2HAP,2HE ,2HLU, & 2H? / DATA MESS7/6412B,2HEN,2HTE,2HR ,2HTA,2HPE,2H H,2HEA,2HDE,2HR:, & 2H _/ DATA MESS8/2HST,2HOP/ DATA MESS9/6412B,2HFI,2HLE,2HS ,2HSA,2HVE,2HD ,2HON,2H T,2HAP, & 2HE / DATA MESS10/2HFL,2HEX,2HIB,2HLE,2H D,2HIS,2HC ,2HSA,2HVE,2H O, & 2HR ,2HRE,2HST,2HOR,2HE?,2H (,2HSA,2H,R,2HE,,2HNO, & 2H):,2H _/ DATA MESS11/2HER,2HRO,2HR ,2H- ,2HNO,2HT ,2HEN,2HOU,2HGH,2H T, & 2HRA,2HCK,2HS ,2HON,2H F,2HLE,2HXI,2HBL,2HE ,2HDI, & 2HSC,2H? / DATA MESS12/2HEN,2HTE,2HR ,2HMA,2HG ,2HTA,2HPE,2H F,2HIL,2HE , & 2HNU,2HMB,2HER,2H: ,2H _/ DATA MESS13/6412B,2HFI,2HLE,2HS ,2HRE,2HST,2HOR,2HED,2H O,2HN , & 2HFL,2HEX,2HIB,2HLE,2H D,2HIS,2HC.,6412B/ DATA MESS14/6412B,2HHE,2HAD,2HER,2H I,2HS:/ DATA MESS15/2HER,2HRO,2HR ,2H- ,2HWR,2HON,2HG ,2HTA,2HPE,2H. , & 2HIN,2HSE,2HRT,2H N,2HEW,2H T,2HAP,2HE ,2H(#,2H , & 2H ,2H)./ DATA MESS16/2HER,2HRO,2HR ,2H- ,2HNO,2HT ,2HA ,2HPO,2HSI,2HTI, & 2HVE,2H N,2HUM,2HBE,2HR?/ DATA MESS17/2HER,2HRO,2HR ,2H- ,2HEO,2HT ,2H- ,2HFI,2HLE,2H N, & 2HOT,2H F,2HOU,2HND,2H? / DATA MESS18/6412B,2HTE,2HRM,2HIN,2HAT,2HE ,2H(Y,2HES,2H,N,2HO), & 2H: ,2H _/ DATA MESS19/2HTO,2H C,2HON,2HTI,2HNU,2HE ,2HHI,2HT ,2HAN,2HY , & 2HKE,2HY/,2HRE,2HTU,2HRN,2H _/ DATA MESS20/6412B,2HTA,2HPE,2H #,2H ,2H / C CALL RMPAR(LU) IF(LU)1,2,32 1 STOP 2 LU=1 32 IF(LU.LE.63)33,1 33 ILU=LU+400B C CCCCCCCCCCCCCCCCCCCC JLNTH=3840 CCCCCCCCCCCCCCCCCCCC C GET SAVE OR RESTORE C 5 CALL REIO(2,ILU,MEkSS10,22) X=REIO(1,ILU,IBUF,10) IF(IBUF(1).EQ.2HSA)GO TO 15 IF(IBUF(1).NE.2HRE)GO TO 8000 GO TO 2000 C C GET FLEXIBLE DISC LU 15 CALL REIO(2,ILU,MESS2,14) X=REIO(1,ILU,IBUF,10) CALL PARSE(IBUF,IB*2,IPBUF) IC=IPBUF(1) IF(IC.NE.1)GO TO 18 IDISC=IPBUF(2) LASTTR=IPBUF(6) C 16 CALL EXEC(13,IDISC,ISTAT) ITYPE=IAND(ISTAT,37400B)/256 IF(ITYPE.EQ.33B)GO TO 10 18 CALL REIO(2,ILU,MESS3,17) 20 CALL REIO(2,ILU,MESS18,12) X=REIO(1,ILU,IBUF,2) IF(IBUF(1).EQ.2HNO)GO TO 15 IF(IBUF(1).NE.2HYE)GO TO 20 GO TO 8000 C C GET CARTRIDGE OR MAG TAPE LU C 10 CALL REIO(2,ILU,MESS1,18) X=REIO(1,ILU,IBUF,10) CALL PARSE(IBUF,IB*2,IPBUF) MTLU=IPBUF(2) IC=IPBUF(1) IF(IC.NE.1)GO TO 12 C CALL EXEC(13,MTLU,ISTAT,IX,ISUB) IF(IAND(ISTAT,37400B)*2.NE.5000B)GO TO 13 IF(IAND(ISUB,37B).EQ.1B)GO TO 14 IF(IAND(ISUB,37B).EQ.2B)GO TO 14 12 CALL REIO(2,ILU,MESS4,21) 22 CALL REIO(2,ILU,MESS18,12) X=REIO(1,ILU,IBUF,2) IF(IBUF(1).EQ.2HNO)GO TO 10 IF(IBUF(1).NE.2HYE)GO TO 22 GO TO 8000 13 IF(IAND(ISTAT,37400B).NE.11400B)GO TO 12 C C FIND PLACE ON TAPE TO BEGIN THE SAVE 7 CALL REIO(2,ILU,MESS12,15) X=REIO(1,ILU,IBUF,-10) CALL PARSE(IBUF,IB,IPBUF) IC=IPBUF(1) INUM=IPBUF(2) IF(INUM.LE.0)GO TO 4 IF(IC.EQ.1)GO TO 6 4 CALL REIO(2,ILU,MESS16,15) GO TO 7 6 X=EXEC(3,MTLU+600B) ISTAT=IAND(IA,1) IF(ISTAT.EQ.1)GO TO 6 8 IF(INUM.EQ.1)GO TO 14 REWIND MTLU 19 X=EXEC(3,MTLU+600B) ISTAT=IAND(IA,1) IF(ISTAT.EQ.1)GO TO 19 DO 9 I=2,INUM X=EXEC(3,MTLU+1300B) 3 X=EXEC(3,MTLU+600B) ISTAT=IAND(IA,1) IF(ISTAT.EQ.1)GO TO 3 ISTAT=IAND(IA,40B) IF(ISTAT.EQ.0)GO TO 9 CALL REIO(2,ILU,MESS17,15) GO TO 7 9 CONTINUE GO TO 17 Ʒ14 REWIND MTLU C 17 X=EXEC(3,MTLU+600B) ISTAT=IAND(IA,1) IF(ISTAT.EQ.1)GO TO 17 C 30 DO 31 I=1,30 IH2(I)=2H 31 CONTINUE C CALL REIO(2,ILU,MESS7,11) CALL REIO(1,ILU,IH2 ,30) C C C HAVE ALL LU'S, NOW GO COPY THE DISC... C COPY ALL DIRECTORY TRACKS FIRST, FOLLOWED BY C ALL TRACKS USED BY FMP (UN-USED TRACKS WON'T BE COPIED) C X=EXEC(1,IDISC,IBUF,128,10000,0) ITRAK=IB-1 IF(LASTTR.NE.0)ITRAK=LASTTR CALL EXEC(1,IDISC,IBUF,JLNTH,ITRAK,0) FIRST=IBUF(5) LAST=IBUF(10) IF(LAST.EQ.LASTTR)LAST=LAST-1 LOWDIR=IBUF(8) C C WRITE TAPE HEADER C CCCCCCCCCCCCCCCCCC ITPE=1 ISEC=0 CALL EXEC(2,MTLU+100B,IHEAD,33) CCCCCCCCCCCCCCCCCC C C GO WRITE TRACK TO TAPE C ASSIGN 42 TO JJ C GO TO 1000 C C READ A TRACK C 40 CALL EXEC(1,IDISC,IBUF,JLNTH,ITRAK,0) C C C GO WRITE THE TRACK TO TAPE C GO TO 1000 42 IF(ITRAK.EQ.LOWDIR)GO TO 45 ITRAK=ITRAK-1 GO TO 40 C 45 ASSIGN 49 TO JJ DO 49 ITRAK=FIRST,LAST CALL EXEC(1,IDISC,IBUF,JLNTH,ITRAK,0) GO TO 1000 49 CONTINUE C GO TO 90 C C THIS ROUTINE RETURNS TO JJ C 1000 ICOUN=1 DO 1500 ISEC=0,58,2 C C C THIS SECTION DOES A DYNAMIC STATUS CHECK ON THE CARTRIDGE C TAPE LOOKING FOR EOT CONDITION. IF FOUND, A MESSAGE IS ISSUED C TO INFORM THE OPERATOR, AND THE PROGRAM IS SUSPENDED. C C 1001 X= EXEC(3,MTLU+600B) ISTAT=IAND(IA,1) IF(ISTAT.EQ.1) GOTO 1001 ISTAT=IAND(IA,40B) IF (ISTAT.EQ.0) GO TO 1050 C C WE MUST HAVE REACHED EOT C C TELL THE OPERATOR ABOUT IT C ITPE=ITPE+1 MEST(29)=KCVT(ITPE) CALL EXEC(2,ILU,MEST,31) CALL EXEC(2,ILU,MESS19,16) CALL EXEC(1,ILU,IREG,2) C C WRITE A HEADER ON THE NEW TAPE C C C REWIND MTLU C 1042 X=EXEC(3,MTLU+600B) ISTAT=IAND(IA,1) IF(ISTATKu.EQ.1)GO TO 1042 CALL EXEC(2,MTLU+100B,IHEAD,33) C C C THIS SECTION TRANSFERS 1 TRACK FROM IBUF TO CARTRIDGE TAPE C 128 WORDS AT A TIME. C 1050 X=EXEC(2,MTLU+100B,IBUF(ICOUN),128) ICOUN=ICOUN+128 C 1500 CONTINUE GOTO JJ C C C C 90 ENDFILE MTLU ENDFILE MTLU C C END: REWIND TAPE C 99 REWIND MTLU CALL REIO(2,ILU,MESS9,11) C GO TO 5 C C RESTORE FLEXIBLE DISC C C ENTER FLEXIBLE DISC LU C 2000 CALL REIO(2,ILU,MESS2,14) X=REIO(1,ILU,IBUF,10) CALL PARSE(IBUF,IB*2,IPBUF) IC=IPBUF(1) IF(IC.NE.1)GO TO 2008 IDISC=IPBUF(2) LASTTR=IPBUF(6) C C CHECK TO MAKE SURE ITS A FLEXIBLE DISC 2005 CALL EXEC(13,IDISC,ISTAT) ITYPE=IAND(ISTAT,37400B)/256 IF(ITYPE.EQ.33B)GO TO 2004 2008 CALL REIO(2,ILU,MESS3,17) 2021 CALL REIO(2,ILU,MESS18,12) X=REIO(1,ILU,IBUF,2) IF(IBUF(1).EQ.2HNO)GO TO 2000 IF(IBUF(1).NE.2HYE)GO TO 2021 GO TO 8000 C C C GET CARTRIDGE OR MAG TAPE LU C 2004 CALL REIO(2,ILU,MESS1,18) X=REIO(1,ILU,IBUF,10) CALL PARSE(IBUF,IB*2,IPBUF) IC=IPBUF(1) IF(IC.NE.1)GO TO 2001 MTLU=IPBUF(2) C C CHECK TO MAKE SURE ITS A CARTRIDGE OR MAG TAPE 5000 CALL EXEC(13,MTLU,ISTAT,IX,ISUB) IF(IAND(ISTAT,37400B)*2.NE.5000B)GO TO 2002 C CHECK FOR SUBCHANNEL (LEFT OR RIGHT CARTRIDGE) IF(IAND(ISUB,37B).EQ.1B)GO TO 2003 IF(IAND(ISUB,37B).EQ.2B)GO TO 2003 2001 CALL REIO(2,ILU,MESS4,21) 2023 CALL REIO(2,ILU,MESS18,12) X=REIO(1,ILU,IBUF,2) IF(IBUF(1).EQ.2HNO)GO TO 2004 IF(IBUF(1).NE.2HYE)GO TO 2023 GO TO 8000 2002 IF(IAND(ISTAT,37400B).NE.11400B)GO TO 2001 C C FIND PLACE ON TAPE TO BEGIN RESTORE 2012 CALL REIO(2,ILU,MESS12,15) X=REIO(1,ILU,IBUF,-10) CALL PARSE(IBUF,IB,IPBUF) IC=IPBUF(1) INUM=IPBUF(2) C IF(INUM.LE.0)GO TO 1999 IF(IC.EQ.1)GO TO 2006 1999 CALL REIO(2,ILU,MEgSS16,15) GO TO 2012 2006 X=EXEC(3,MTLU+600B) ISTAT=IAND(IA,1) IF(ISTAT.EQ.1)GO TO 2006 2013 IF(INUM.EQ.1)GO TO 2003 REWIND MTLU 2009 X=EXEC(3,MTLU+600B) ISTAT=IAND(IA,1) IF(ISTAT.EQ.1)GO TO 2009 DO 2014 I=2,INUM X=EXEC(3,MTLU+1300B) 4050 X=EXEC(3,MTLU+600B) ISTAT=IAND(IA,1) IF(ISTAT.EQ.1)GO TO 4050 ISTAT=IAND(IA,40B) IF(ISTAT.EQ.0)GO TO 2014 CALL REIO(2,ILU,MESS17,15) GO TO 2012 2014 CONTINUE GO TO 2007 2003 REWIND MTLU C C ENTER FLEXIBLE DISC LU 2007 X=EXEC(3,MTLU+600B) ISTAT=IAND(IA,1) IF(ISTAT.EQ.1)GO TO 2007 C C INITIALIZE IHEAD TO ZERO 2010 DO 2011 I=1,30 IH2(I)=2H 2011 CONTINUE C C READ THE FIRST TAPES HEADER AND PUT IN IHEAD. 4000 CALL EXEC(1,MTLU+100B,IHEAD,33) CALL REIO(2,ILU,MESS14,6) CALL REIO(2,ILU,IHEAD(4),30) MESS20(5)=KCVT(IHEAD(1)) CALL REIO(2,ILU,MESS20,6) 4005 CALL EXEC(2,ILU,MESS18,12) X=EXEC(1,ILU,IBUF,1) IF(IBUF(1).EQ.2HYE)GO TO 8000 IF(IBUF(1).NE.2HNO)GO TO 4005 IF(IHEAD.EQ.1)GO TO 2030 ITPE=1 SEC=0 MESS15(20)=KCVT(ITPE) CALL REIO(2,ILU,MESS15,22) CALL EXEC(2,ILU,MESS19,16) CALL EXEC(1,ILU,IREG,2) C REWIND MTLU 4001 X=EXEC(3,MTLU+600B) ISTAT=IAND(IA,1) IF(ISTAT.EQ.1)GO TO 4001 GO TO 5000 C PROMPT LAST TRACK ON VIRGIN DISC 2030 X=EXEC(1,IDISC,IBUF,128,10000,0) ITRAK=IB-1 IF(LASTTR.NE.0)ITRAK=LASTTR DO 2015 I=1,3840,128 CALL EXEC(1,MTLU+100B,IBUF(I),128) 2015 CONTINUE C C IDIR GETS # OF DIRECTORY TRACKS C IVIR GETS AVAILABLE FMP TRACKS ON VIRGIN DISC C LAST GETS AVAILABLE FMP TRACKS ON TAPE C CHECK TO SEE IF DISC CAN HOLD FILES ON TAPE C IDIR=IBUF(9) IVIR=ITRAK+IDIR LAST=IBUF(10)-1 IF(IVIR.GE.LAST)GO TO 2020 CALL EXEC(2,ILU,MESS11,22) GO TO 8000 C C LOWDIR GETS LOWEST DIRECTORY TRACK C FIhRST GETS FIRST AVAILABLE TRACK FOR FMP 2020 LOWDIR=IBUF(8) FIRST=IBUF(5) C ASSIGN 2042 TO JJ ASSIGN 2062 TO KK C GO TO KK C 2040 DO 2041 I=1,3840,128 CALL EXEC(1,MTLU+100B,IBUF(I),128) C C CHECK FOR END OF TAPE C 3000 X=EXEC(3,MTLU+600B) ISTAT=IAND(IA,1) IF(ISTAT.EQ.1)GO TO 3000 ISTAT=IAND(IA,40B) IF(ISTAT.EQ.0)GO TO 2041 ITPE=ITPE+1 3001 MEST(29)=KCVT(ITPE) CALL EXEC(2,ILU,MEST,31) CALL EXEC(2,ILU,MESS19,16) CALL EXEC(1,ILU,IREG,2) C 2098 REWIND MTLU 2029 X=EXEC(3,MTLU+600B) ISTAT=IAND(IA,1) IF(ISTAT.EQ.1)GO TO 2029 C DO 3002 J=1,30 IH22(J)=2H 3002 CONTINUE C C PRINT OUT HEADER CALL EXEC(1,MTLU+100B,IHEDD,33) CALL REIO(2,ILU,MESS14,6) CALL REIO(2,ILU,IHEDD(4),30) MESS20(5)=KCVT(IHEDD(1)) CALL EXEC(2,ILU,MESS20,6) C C CHECK TO SEE IF HEADERS MATCH DO 3003 K=4,33 IF(IHEDD(K).NE.IHEAD(K))GO TO 3004 3003 CONTINUE C C CHECK FOR THE RIGHT TAPE IF(ITPE.EQ.IHEDD)GO TO 2039 3004 MESS15(20)=KCVT(ITPE) CALL REIO(2,ILU,MESS15,22) CALL EXEC(2,ILU,MESS19,16) CALL EXEC(1,ILU,IREG,2) GO TO 2098 C 2039 ITRAK=IHEDD(2) ISEC=IHEDD(3) 2041 CONTINUE GO TO KK C C DECREMENT THE TRACK NUMBER 2042 IF(ITRAK.EQ.LOWDIR)GO TO 2045 ITRAK=ITRAK-1 GO TO 2040 C C FROM FIRST TO LAST TRACK FILL UP BUFFER ONE TRACK AT A TIME. 2045 ASSIGN 2049 TO JJ ASSIGN 2060 TO KK DO 2049 ITRAK=FIRST,LAST DO 2048 I=1,3840,128 CALL EXEC(1,MTLU+100B,IBUF(I),128) C C CHECK FOR END OF TAPE 2047 X=EXEC(3,MTLU+600B) ISTAT=IAND(IA,1) IF(ISTAT.EQ.1)GO TO 2047 ISTAT=IAND(IA,40B) IF(ISTAT.EQ.0)GO TO 2048 ITPE=ITPE+1 2051 MEST(29)=KCVT(ITPE) CALL EXEC(2,ILU,MEST,31) CALL EXEC(2,ILU,MESS19,16) CALL EXEC(1,ILU,IREG,2) C 2052 REWIND MTLU 2056 X=EXEC(3,MTLU+600B) Q0.* ISTAT=IAND(IA,1) IF(ISTAT.EQ.1)GO TO 2056 C DO 2053 J=1,30 IH22(J)=2H 2053 CONTINUE C C PRINT OUT HEADER CALL EXEC(1,MTLU+100B,IHEDD,33) CALL REIO(2,ILU,MESS14,6) CALL REIO(2,ILU,IHEDD(4),30) MESS20(5)=KCVT(IHEDD(1)) CALL EXEC(2,ILU,MESS20,6) C C CHECK TO SEE IF HEADERS MATCH DO 2054 K=4,33 IF(IHEDD(K).NE.IHEAD(K))GO TO 2055 2054 CONTINUE C C CHECK TO SEE IF RIGHT TAPE IF(ITPE.EQ.IHEDD)GO TO 2048 2055 MESS15(20)=KCVT(ITPE) CALL REIO(2,ILU,MESS15,22) CALL EXEC(2,ILU,MESS19,16) CALL EXEC(1,ILU,IREG,2) C GO TO 2052 2048 CONTINUE GO TO KK 2049 CONTINUE GO TO 2099 C C ELIMINATE THE FIRST SECTOR IN THE FIRST TRACK 2060 K=1 DO 2061 J=129,3840 IBF(K)=IBUF(J) K=K+1 2061 CONTINUE C C WRITE ONTO DISC CALL EXEC(2,IDISC,IBF,3712,ITRAK,2) ASSIGN 2062 TO KK GO TO JJ C 2062 CALL EXEC(2,IDISC,IBUF,JLNTH,ITRAK,0) GO TO JJ C C 2099 REWIND MTLU C C FILES RESTORED TO FLEXIBLE DISC CALL REIO(2,ILU,MESS13,18) GO TO 5 8000 CALL EXEC(2,ILU,MESS8,2) END END$ 00 H U 92064-18233 1805 S C0122 &RU.. RTE-M RUN COMMANDD             H0101 sSPL,L,O ! NAME: RU.. ! SOURCE: 92064-18233 ! RELOC: 92064-16087 ! PGMR: G.L.M. ! ! *************************************************************** ! * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * ! * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * ! * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* ! * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ! *************************************************************** ! ! NAME RU..(7) " 92064-16087 REV.1805 771103" ! ! LET EXEC BE SUBROUTINE,EXTERNAL !ERROR PRINTING ! ! ! ! ! THIS ROUTINE MAKES AN EXEC SCHEDULE WITH WAIT AND QUEUE ! (ICODE=23) FOR THE PROGRAM NAME SPECIFIED. ! ! IF THE PROG CANNOT BE FOUND, RETURNS AN ERROR 61 ! IF THE SCHEDULE OPTION WAS NOT IN THE SYSTEM, RETURNS ERROR 62 ! LET A BE CONSTANT(0) ! ! RU..: SUBROUTINE (NO,LIS,ER) GLOBAL ! LIS6_[LIS5_[LIS4_[LIS3_[LIS2_[LIS1_ \ ! SETUP PARAMETER ADDRESSES @LIS+1]+4]+4]+4]+4]+4 ! IF LIS#3 THEN [ER_10;RETURN] !PROGRAM NAME MUST BE ASCII ! ER_0 !PRESET ERROR RETURN EXEC(100000K+23,$LIS1,$LIS2,$LIS3,\ !ATTEMPT THE SCHEDULE WITH $LIS4,$LIS5,$LIS6) !THE NO-ABORT OPTION. ! GOTO EEREX !EXEC ABORTED OUR REQUEST !EITHER M1 WITHOUT %MMP OR !PROG NOT FOUND ! RETURN ! ! EEREX: AREG_$A ER_[IF AREG="SC" THEN 61, ELSE 62] RETURN END END END$  IO 92064-18234 1805 S C0122 &MDUTF RTE-M MCDC COMMAND             H0101 ۳ASMB,R,L,C * NAME: MCDC. * SOURCE: 92064-18234 * RELOC: 92064-16055 * PGMR: G.L.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM MCDC.,7 92064-16055 REV.1805 771128B * * ENT MC..,RC.. EXT EXEC,.ENTR,CLD.R,.P1,.P2,.P3,.P4,.P5 EXT DS.F1,DS.DF,DS.LU,D.LB,D.LT USED BY FM.UT EXT IMESS,FID.,CONV. * * MOUNT/DISMOUNT SUBROUTINE * * N NOP LIS NOP ER NOP MC.. NOP JSB .ENTR DEF N ISZ LIS LDA LIS,I FETCH FIRST PARAMETER SZA,RSS MUST NOT BE ZERO JMP EX50 ELSE, RETURN ERROR=50 * SSA CMA,INA ALLOW NEG NUMBERS STA LU * LDA LIS ADA D4 ADVANCE TO LAST TRACK PARAMETER STA LSTRK SAVE IT * MOUNT CARTRIDGE SUBROUTINE * THIS ROUTINE PERFORMS THE FOLLOWING: * -CHECK DRIVER TYPE (MUST BE DISC) * -DETERMINE MAX LAST TRACK * -DOES VALIDITY CHECK ON DISK * PASSES CONTROL TO DIRECTORY MANAGER (D.RFP) WHO THEN: * -FINDS DIRECTORY SPACE * -CHECKS FOR DUPLICATE DRN OR LU * -WRITES DIRECTORY ENTRY IN MEMORY RESIDENT LIBRARY (%TBLFP) * JSB EXEC GET STATUS ON LU DEF STRTN TO DETERMINE DRIVER TYPE DEF STCOD (100015B) DEF LU DEF EQT5 STRTN JMP BADLU IF LU IS UNDEFINED, EXIT LDA EQT5 AND DTYPE (36000B) CPA DISC (14000B) JMP GDLU BADLU LDA N18 JMP EXMC * CHECK FOR DVR30, IF SO, SKIP THIS SECTION GDLU LDA EQT5 AND TFLD TYPE CODE FIELD (37400B) CPA DISC TYPE 30 ? B JMP DVR30 YES LDA D9999 STA TRACK REQUEST READ FROM TRACK 9999 JSB RD16 RETURNS ACTUAL LAST TRACK IN B CCA ADB A * IF LAST TRACK NOT GIVEN, USE MAX LAST TRACK LDA LSTRK,I PASSED LAST TRACK SZA,RSS IF ZERO JMP DVR30+1 USE MAX LAST TRACK * LAST TRACK CANNOT BE > MAX LAST TRACK CMA,INA ADB A SUBTRACT FROM MAX LDA D56 SSB JMP EXMC (LAST TRACK IS > MAX) DVR30 LDB LSTRK,I LDA D55 SZB,RSS JMP EXMC STB TRACK * READ CARTRIDGE DIRECTORY JSB RD16 READ SECTOR 0 OF DIRECTORY TRACK * DO VALIDITY CHECK ON DIRECTORY * LDA DBUF FIRST WORD SSA,RSS MUST HAVE SIGN SET JMP NOINT (NOT INITIALIZED) LDA DBF3 WORD 3 (DRN) MUST BE POS NON-ZERO SSA,RSS SZA,RSS JMP NOINT LDA DBF8 WORD 8(# OF DIRECTORY TRACKS MUST BE NEG) SSA,RSS JMP NOINT LDA DBF7 FETCH LOWEST DIRECTORY TRACK CMA,INA SET IT NEG ADA DBF4 FIRST AVAIL. MUST BE < DIRECT. SSA,RSS JMP NOINT LDB DBF9 NEXT AVAIL. FMP TRACK SSB MUST BE A POSITIVE VALUE JMP NOINT CMB,INB ADB DBF7 AND--MUST BE LESS THAN OR EQUAL SSB TO LOWEST DIRECTORY TRACK JMP NOINT CLA STA NLIS CLEAR LOCK WORD * * IT IS OK!, SET UP DIRECTORY MANAGER CALL STUP LDA D7 P1=7 STA .P1 LDA LU P2=-LU STA .P3 CMA,INA P3=LU STA .P2 LDA TRACK P4=LAST TRACK STA .P4 LDA DBF3 P5=DISC REFERENCE STA .P5 LDA NLIS SET PARM #6 LDB N2 SET PARM #7 JSB CLD.R GOTO DIRECTORY MANAGER * FETCH ERROR RETURN LDA B,I (B IS POINTING TO ERROR) EXMC STA ER,I CLA STA DS.DF \PSTA DS.F1 FORCE NEW READ OF MASTER DIRECTORY JMP MC..,I * * * DISC WAS NOT INITIALIZED SO LOCK TO FMGR * NOINT LDA XEQT SET THIS PROG AS LOCKER (FMGR) STA NLIS SET AS LOCK PARM CLA CLEAR STA DBF3 LABEL IF NOT INIT JMP STUP CONTINUE * * EX50 LDA D50 JMP EXMC * * RD16 NOP READ A BLOCK JSB EXEC DEF R16X DEF .1 DEF LU DEF DBUF DEF .16 DEF TRACK DEF ZERO R16X JMP RD16,I * STCOD OCT 100015 EQT5 EQU N LU NOP TRACK NOP ZERO NOP * XEQT EQU 1717B * .1 DEC 1 .16 DEC 16 DTYPE OCT 36000 DISC OCT 14000 TFLD OCT 37400 DBUF BSS 16 DBF3 EQU DBUF+3 DBF4 EQU DBUF+4 DBF7 EQU DBUF+7 DBF8 EQU DBUF+8 DBF9 EQU DBUF+9 * A EQU 0 B EQU 1 * DISM - DISMOUNT SUBROUTINE PERFORMS THE FOLLOWING* * CALLS THE DIRECTORY MANAGER TO PLACE A LOCK ON THE * REQUESTED DISC - THIS ASSURES THAT NO ACTIVE OPEN * FILES EXIST ON THE DISC. * * CALLS THE DIRECTORY MANGER TO CLEAR THE DIRECTORY * ENTRY FOR THE DISC & CLOSE UP ANY GAPS IN THE * DIRECTORY CAUSED BY THE DISMOUNT. * * NN NOP NLIS NOP NER NOP RC.. NOP JSB .ENTR DEF NN * ISZ NLIS ADVANCE TO DRN PARAMETER LDB NLIS,I FETCH IT LDA D55 PRE-FETCH ERROR CODE SZB,RSS -LU OR +DRN MUST BE GIVEN JMP EXDC ELSE ERROR EXIT STB .P2 SAVE DRN/LU FOR D.RFP * * CALL FID. TO VERIFY THAT THE DISC IS MOUNTED AND HAS * BEEN INITIALIZED. * JSB FID. DEF *+2 DEF NLIS,I -LU OR DRN * SZA OK? JMP MONT? NO-EITHER NOT MOUNTED OR NO DIRECTORY * * THE DISC IS MOUNTED AND IT HAS A DIRECTORY * * * LDA D3 SET FUNCTION CODE STA .P1 FOR DISC LOCK JSB CLD.R GOTO CLD.R LDA B,I FETCH ERROR CODE SZA Á JMP EXDC ERROR EXIT * DISC IS LOCKED SO NO OPEN FILES EXIST * SET UP DISMOUNT CALL TO DIRECTORY MANAGER * (IF NOT LOCKED, THEN NO DIRECTORY EXISTS) * * OK2 LDA D7 SET FUNCTION CODE STA .P1 FOR DIRECTORY MODIFICATION * * .P2 STILL CONTAINS THE -LU/DRN * CLB SET P3=0 & SUBFUNCTION (P7 WHICH STB .P3 IS PASSED VIA B) =0 FOR DISMOUNT JSB CLD.R LDA B,I FETCH ERROR CODE STA NER,I PASS IT BACK TO FMGR * * THE CALL TO FID. CAUSED THE LAST TRACK OF THE DISC TO BE SAVED * IN THE GLOBAL "D.LT". CONVERT AND PRINT IT. * JSB CONV. DEF *+4 DEF D.LT,I DEF MS DEF D4 * JSB IMESS ISSUE MESSAGE TO LOG DEF *+4 DEF D2 DEF MSS DEF D8 * JMP BYE * * * * IF MOUNTED, THE CALL TO FID. CAUSED THE GLOBALS DS.LU (DISC LU) * AND D.LB (DISC LABEL) TO THE SPECIFIED VALUES FOR THE DISC * * TO PROVE THAT THE DISC IS MOUNTED, THE LU/DRN PASSED MUST * MATCH ONE OF THE ABOVE GLOBALS. * MONT? LDA D54 PRE-FETCH ERROR CODE LDB NLIS,I FETCH THE PASSED -LU/DRN SSB WHAT WAS IT? JMP WLU IT WAS AN LU * CPB D.LB,I IT WAS A LABEL,IS IT MOUNTED? JMP OK2 YEP--GO DO DISMOUNT JMP EXDC * WLU CMB,INB SET LU POS CPB DS.LU,I IS IT MOUNTED? JMP OK2 YEP--CONTINUE EXDC STA NER,I BYE CLA STA DS.DF STA DS.F1 FORCE A NEW READ OF DISC DIRECTORY JMP RC..,I * * * LSTRK EQU NN MSS ASC 7,LAST TRACK MS NOP * N2 OCT -2 N18 DEC -18 D2 DEC 2 D3 DEC 3 D8 DEC 8 D6 DEC 6 D7 DEC 7 D4 DEC 4 D50 DEC 50 D54 DEC 54 D55 DEC 55 D56 DEC 56 D9999 DEC 9999 END  J T 92064-18235 1805 S C0122 &IFTTY RTE-M IFTTY SUBROUTINE             H0101 *ASMB,R,L,C ** IFTTY - SEE IF SPECIFIED LU IS INTERACTIVE. HED -IFTTY - DETERMINES IF SPECIFIED LU IS INTERACTIVE. * NAME: IFTTY * SOURCE: 92064-18235 * RELOC: 92064-16088 * PGMR: C.M.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM IFTTY,7 92064-16088 REV. 1805 771031 ENT IFTTY,.TTY EXT EXEC * * ROUTINE TO DETERMINE IF THE SPECIFIED LU IS INTERACTIVE * CALLED AS FOLLOWS: * * IFLAG = IFTTY(LU) JSB IFTTY * DEF *+2 * DEF LU * * * IFLAG = A REG = -1 IF THE LU IS INTERACTIVE * = 0 IF THE LU IS NON-INTERACTIVE * B REG = UPPER BYTE = DEVICE TYPE * LOWER BYTE = SUBCHANNEL NUMBER * * * .TTY EQU * IFTTY NOP ENTRY DLD IFTTY,I GET RETURN ADDRESS & LU# LDB B,I GET THE LU # STA IFTTY SAVE RETURN ADDRESS STB ANLU# AND LU # * JSB EXEC SEE IF THE LU IS INTERACTIVE DEF *+6 DEF D13 STATUS REQUEST DEF ANLU# THE LU WE WANT THE INFO ABOUT DEF YTEMP EQT WORD 5 PLACED HERE DEF DTYPE EQT WORD 4 PLACED HERE(NOT NEEDED) DEF ZTEMP SUB CHANNEL IN LOWER 5 BIT HERE * LDA YTEMP GET EQT WORD 5 AND MEQT KEEP ONLY THE EQT TYPE FIELD LDB A AND SAVE IT LDA ZTEMP GET THE SUBCHANNEL BITS AND M37 STA ZTEMP ADA B CONFIGURE B REGISTER RETURN WORD STA DTYPE SZB,RSS IF DVR 00 THEN JMP ITSIN ITS INTERACTIVE {  CPB M2400 IF DVR 05 THEN JMP DVR05 DO ONE MORE CHECK FOR SUB CHANNEL CPB M3400 IS IT DVR07 ? JMP DVR05 THEN DO DVR05 CHECK JMP ITSNT ELSE ITS NOT INTERACTIVE * DVR05 LDA ZTEMP GET THE SUB CHANNEL # SZA,RSS IF = 0 THEN ITS ITSIN CCA,RSS SET INTERACTIVE FLAG ITSNT CLA SET NON INTERACTIVE FLAG LDB DTYPE JMP IFTTY,I RETURN TO CALLER * * D13 DEC 13 M2400 OCT 2400 M37 OCT 37 M3400 OCT 3400 MEQT OCT 37400 ANLU# NOP DTYPE NOP YTEMP NOP ZTEMP NOP A EQU 0 B EQU 1 END f  KR 92064-18237 1805 S C0122 COMPILER LIB OPEN             H0101 0 THEN THE # OF SECTORS IN THE FILE * D.RP2 = TRACK AND LOGICAL UNIT * D.RP3 = OFFSET AND SECTOR NUMBER * D.RP4 = TRACK NUMBER (LU IF TYPE = 0) * D.RP5 = NUMBER OF SECTORS IN TRACK AND SECTOR NUMBER * D.RP6 = SECURITY CODE OF THE FILE * D.RP7 = TYPE OF THE FILE * * OPEN LDA .2 CALL LDB C.CR ROUTINE TO JSB GEX.C OPEN A FILE DEF C.NAM JMP ERR * LDA D.RP7 CHECK TO SEE IF FILE TYPE MATCHES LDB OPTYP CPB .1 BINARY FILE OPEN?? JMP BIN YES! CPB .3 LIST FILE OPEN? JMP LST YES! * CKSC LDA D.RP6 IS SECURITY CPA C.SC CODE OF FILE SAME AS USER SUPPLIED? JMP RETRN YES, OK! SSA FILE WRITE PROTECTED? JMP E7 YES, ILLEGAL SECURITY CODE! ISZ TMP SOURCE FILE READ? JMP E7 NO, NO CAN WRITE ON EITHER! RETRN LDB D.RP1 TYPE 0 FILE? LDA D.RP4 A=LU#,B=#SECTRS SZB,RSS JMP OPNL1 YES JSB SETUP SET UP THE FCB * * LINK THE FCB INTO THE LIST - HEAD IS GLOBAL CALLED C.HLK * LDA C.HLU,I SET TRACK LU STA C.FLU,I INTO PRIMARY LU RET1 CLA,INA STA C.WRD,I CLEAR WORD PTR LDA C.HLK GET HEAD LDB C.FCB GET ADDRESS OF FILE CONTROL BLK STB C.HLK AND SET IT IN HEAD POINTER SZA HEAD LINK PTR EMPTY? STA C.FCB,I NO, SO PLACE ADDRESS IN NEW FCB CLA CLEAR ERROR RETRUN JMP EXIT TAKE P+2 EXIT * BIN CPA .5 BINARY FILE? JMP CKSC YES! JMP E16 NO, ILLEGAL FILE TYPE * LST CPA .3 SOURCE FILE? JMP CKSC YES! CPA .4 SOURCE FILE? JMP CKSC YES! JMP E16 NO ,ILLEGAL FILE TYPE * E202 LDA M202 NO SOURCE NAMR RSS E15 LDA M15 BAD NAMR RSS E16 LDA M16 ILLEGAL TYPE RSS E201 LDA M201 NO BINARY ERROR RSS E200 LDA M200 BAD FCB FORMAT ERROR RSS TAKE P+1 ERROR EXIT E7 LDA M7 SECURITY CODE ERROR RSS EXIT ISZ OPN.C TAKE P+2 EXIT ERR JMP OPN.C,I EXIT * * WRITE BINARY (TYPE=5) FILE * WRITB LDA C.TYP IS NAME SZA,RSS A NULL? JMP E201 YES SET ERROR TO 201 SO NOT TO OUTPUT BINARY LDA C.NAM IS AND HIMSK FIRST CPA MINUS CHARACTER A MINUS? RSS YES , USE SOURCE NAME EXECPT FOR FIRST CHAR JMP CRE CREATE A TYPE 5 FILE! SMNAM CLA,INA GET SOURCE JSB GTNAM NAMR LDA C.FST IS FIRST CHARCTER CPA AMPSD AND AMPERSAND? RSS YES! JMP E15 NO! LDA C.NAM USE SOURCE AND B377 IOR PERCT NAMR EXCEPT STA C.NAM REPLACE FIRST CHAR BY % CRE LDB PERCT SET UP FOR POSSIBLE DUPLICATE FILE NAME CHECK LDA .5 JMP CREAT CREATE FILE OR OPEN IT * * * WRITE SOURCE FILE - LIST(CREATE TYPE 4 FILE) * WRITS LDA C.TYP IS NAMR SZA,RSS A NULL? JMP LU6 YES, SET LU TO 6 LDA C.NAM IS AND HIMSK FIRST CPA MINUS CHARACTER A MINUS? RSS YES, CREATE OR OPEN FILE WITH SAME NAME AS SOURCE JMP CRE1 CREATE FILE NAME WITH SOURCE NAMR * CLA,INA GET LIST JSB GTNAM NAMR LDA C.FST IS FIRST CPA AMPSD CHARACTER OF SOURCE NAME AN AMPERSAND? RSS YES, CREATE OR OPEN ('NAMR) JMP E15 ILLEGAL NAME LDA C.NAM STUFF IN AND B377 IOR APOST APOSTROPHE STA C.NAM CRE1 LDA .4 CREATE TYPE 4 FILE LDB APOST SET UP CREAT STB TMP APOSTROPHE FOR POSSIBLE DUPLICATE FILE NAME CHECK JSB CRE.C AND GO TO TO IT NOP ERROR, DO SPECIAL CHECK CPA M2 DUPLICATE NAME? JMP CKNAM YES, CHECK IF SAME AS SOURCE NAMR SSA,RSS ANY OTHER ERROR? JMP RETRN SETUP FCB JMP ERR YES, PASS ON THRU * * CHECK NAME TO SEE IF IT STARTS WITH A (') FOR LIST OR (%) FOR * BINARY. IF SO OPEN IT AND USE IT IF NOT THEN ERR 15. * CKNAM LDA C.NAM GET AND HIMSK FIRST CHARACTER CPA TMP IS IT A (') FOR LIST OR (%) FOR BINARY? JMP OPEN YES, OPEN EXISTING FILE JMP E15 NO, GIVE ERROR * * * * * WRITE SCRATCH FILE (GET TRACK FOR RTE-II,RTE-III, AND RTE-IV) * (OPEN SCRATCH FILES FOR RTE-M) * WRTSC LDA .4 JSB GEX.C GET SCRATCH FILE JMP ERR JMP RETRN SET UP FCB * * * * OPEN LOGICAL UNIT DEVICE * LU6 LDA .6 DEFAULT TO LU 6 RSS OPNLU LDA C.NAM GET LU FROM OPNL1 STA LU SET CONTROL LU IOR B600 SET V AND K BITS TO ECHO AND PRINT COLUMN ONE ON LP CPB .1 BINARY? JMP WRTBN YES! CPB .4 SOURCE INPUT? JMP INSRC YES! SZA,RSS INPUT SOURCE-GUARANTEE REWINDABILITY? JMP INSRC YES! STA C.FLU,I SET LU SSA CMA,INA STA LU * DTTY2 JSB EXEC REQUEST STATUS DEF RT1 DEF .13 DEF LU DEF EQ5 DEF EQ4 DEF SPC * * RT1 LDA EQ5 CHECK FOR DVR00 AND TYPE SZA,RSS JMP GOOD YEP--TAKE GOOD EXIT * ADA NDVR5 CHECK FOR DVR05 SZA,RSS JMP SBCNL YEP--SO FAR SO GOOD--GO CHECK FOR SUB CHNL 0 * JMP LULK * SBCNL LDA SPC FETCH SUB CHNL AND B77 SZA JMP LULK NOT ZERO * GOOD LDA PRMPT SET PROMPT STA C.??,I CHARACTERS UP OPN1 LDA C.FID,I SET SIGN IOR SIGN BIT TO SHOW STA C.FID,I IT IS AN LU. LDA C.FID,I IS THIS AND B17 A REWINDABLE SOURCE CPA .2 READ OPERATION? RSS YES! JMP RET1 NO! * LDA .4 GET SCRATCH JSB GEX.C FILE JSB ERR JSB SETUP SET UP FCB LDA C.HLU,I AND ALSO STA C.SLU,I SETUP SECONDARY LU JMP RET1 * LULK JSB LURQ LOCK DEF *+4 DEF B101 THE DEF C.FLU,I DEF .1 DEVICE CPA .1 LU ALREADY LOCKED? JMP OPN1 YES! SZA,RSS REQUEST MAKE IT? JMP OPN1 YES! JSB EXEC NO RESCHEDULE DEF *+6 DEF .12 DEF .0 AGAIN 15 SECONDS FROM NOW DEF .2 DEF .0  DEF M15 JMP LULK * WRTBN IOR B100 SET BINARY STA C.FLU,I FLAG LDA LU IOR B1000 SET OUTPUT LEADER CONT STA LU JSB EXEC OUTPUT CONTROL FUNCTION DEF *+3 DEF .3 DEF LU JMP DTTY2 * INSRC LDA LU IOR B700 SET END-OF PAPER TAPE JMP CONT * SIGN DEF 0,I * * INDIRECT ROUTINE * INDCK NOP RSS LDA A,I RAL,CLE,SLA,ERA JMP *-2 JMP INDCK,I * * GET THE DEFAULT FILE NAMR INTO GLOBAL STORAGE * * CALLING SEQUENCE: * A = DEFAULT PARAMETER NUMBER * JSB GTNAM * * GTNAM NOP ADA M1 COMPUTE MPY .10 OFFSET WITHIN BUFFER ADA TRNON LDB TOADD MOVE DATA JSB .MVW TO BUFFER DEF .8 NOP LDA C.CR IS CARTRIDGE SZA,RSS NUMBER SUPPLIED? LDA C.TRN+5 NO, USE SOURCE CR! STA C.CR JMP GTNAM,I RETURN * * * SET UP DATA IN FCB * SETUP NOP LDB C.BFF LDA B100K SET UP BUFFER STA B,I CCA INB STA B,I FLAGS LDA D.RP1 MAKE SECTORS/FILE INTO BLOCKS/FILE RAR STA C.#SC,I AND SAVE IN FCB LDA D.RP2 AND B77 ISOLATE FILE LU AND STA TMP SAVE IT CMA,INA SET MINUS LU STA C.TRN+5 SOURCE FILE NAMR FOR LIST, BINARY DEFAULTS LDB C.#SC,I GET FILE SIZE LDA D.RP4 GET START STA C.STR,I TRACK AND SET IN FCB STA C.HTR,I IN BOTH CURRENT AND HEAD TRACK LDA TMP DISC FILE! IOR PROBT OR IN DISC UNPROTECT BITS STA C.HLU,I SET IN FCB LDA D.RP5 EXTRACT AND B377 START SECTOR STA C.SSC,I SET START BLOCK XOR D.RP5 EXTRACT ALF,ALF #BLOCKS/TRACK RAR STA C.S/T,I SET UP NUMBER OF BLOCKS/TRACK IN FCB JMP SETUP,I * * * * * CONSTANTS AND B0.*UFFERS * TRNON DEF C.TRN TOADD DEF C.NAM TURN ON STRING ADDRESS TMP BSS 1 OPTYP BSS 1 .0 DEC 0 .1 DEC 1 .2 DEC 2 .3 DEC 3 .4 DEC 4 .5 DEC 5 .6 DEC 6 .8 DEC 8 .10 DEC 10 .12 DEC 12 .13 DEC 13 M1 DEC -1 M2 DEC -2 M7 DEC -7 M15 DEC -15 M16 DEC -16 M200 DEC -200 M201 DEC -201 M202 DEC -202 B17 OCT 17 B77 OCT 77 B100 OCT 100 B377 OCT 377 B600 OCT 600 B700 OCT 700 B1000 OCT 1000 HIMSK OCT 177400 TYPE OCT 37400 NDVR5 OCT -2400 EQ4 NOP EQ5 NOP LU NOP SPC NOP B101 OCT 100001 B100K OCT 100000 PROBT OCT 74000 PRMPT BSS 1 MINUS OCT 26400 MINUS CHARACTER AMPSD OCT 23000 AMPERSAND PERCT OCT 22400 PERCENT CHARACTER APOST OCT 23400 APOSTROPHE CHARACTER SPC 2 END b0 L Y 92064-18238 1805 S C0122 COMPILER LIB CLOSE             H0101 `yASMB,R,L,C HED COMPILER LIBRARY CLOSE ROUTINE NAM CLO.C,7 92064-18238 770515 REV. 1726 $CLIB * * *************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * * REPRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * *************************************************************** * * * * SOURCE PART NUMBER : 92060-18055 * * * CLOSE FILE ROUTINE * * THIS ROUTINE WILL SEARCH THE LINKED LIST OF FCB'S AND REMOVE IT * FROM THE LIST. IT WILL THEN BE CLOSED. IF IT IS A SCRATCH FILE * THE TRACKS WILL BE RETURNED TO THE SYSTEM. IF IT IS A READ FILE * IT WILL BE CLOSED. IF IT IS WRITE FILE THE * FCB WILL BE CHECKED TO SEE IF THE BUFFER NEEDS TO BE WRITTEN OUT * AND IF SO IT WILL BE WRITTEN OUT PRIOR TO CLOSING. * ALSO IF THE FILE DOES NOT HAVE EXTENTS IT WILL BE TRUNCATED. * * * * * * * CALLING SEQUENCE: * * JSB CLO.C * DEF FCB * ERROR RETURN * NO ERROR RETURN * * ON RETURN A < 0 INDICATES ERROR * A = 0 INDICATES NO ERROR * * * * ENTRY POINT: * ENT CLO.C * * EXTERNALS: * EXT EXEC SYSTEM EXEC EXT GEX.C D.RTR REPLACEMENT ROUTINE EXT ADS.C FCB ADDRESS PASSER ROUTINE EXT GE#SC WRITE OUT BUFFER ROUTINE EXT D.RP1 ERROR PARAMETER FROM D.RTR CALL EXT C.HLK HEAD OF FCB LINKED LIST EXT C.LNK FCB LINK WORD EXT C.FCB ADDRESS OF FCB EXT C.FID FCB ID WORD EXT C.FLU FCB LOGICAL UNIT WORD EXT C.STR FCB CURRENT EXTENT TRACK NUMBER WORD EXT C.SSC FCB CURRENT EXTENT SECTOR NUMBER WORD EXT C.EXT FCB EXTENT NUMBER WORD EXT C.S/T FCB NUMBER OF BLOCKS/TRACK WORD EXT C.#SC FCB NUMBER OF BLOCKS/EXTENT WOzRD EXT C.RSC CURRENT OFFSET SECTOR NUMBER EXT C.BFF FCB BUFFER ADDRESS WORD EXT C.WRD FCB CURRENT WORD POINTER WORD EXT C.FAD FCB DIRECTORY ADDRESS FROM D.RTR WORDS EXT C.HTR FCB START OF FILE TRACK NUMBER WORD EXT C.SLU FCB SECONDARY LOGICAL UNIT NUMBER WORD EXT C.?? FCB PROMPT CHARACTERS EXT C.GRW FCB REWIND GUARANTEE ROUTINE ADDRESS EXT C.INS FCB $INCLUDE ROUTINE ADDRESS EXT C.CNT FCB CONTROL ROUTINE ADDRESS * EXT C.FCB ADDRESS OF FCB * * * * DETERMINE TYPE OF OPERATION * * THE FCB CONTAINS THE OPERATION TYPE AS FOLLOWS: * * TYPE = 0 IS READ SOURCE FILE(OR LU) * = 1 IS WRITE BINARY FILE(OR LU) * = 2 IS WRITE SCRATCH FILE * = 3 IS WRITE LIST FILE(OR LU) * * * A EQU 0 B EQU 1 * CLO.C NOP JSB ADS.C SET UP FILE CONTROL BLOCK ADDRESSES DEC 0 CLA STA SECTS SET FOR NO TRUNCATION LDA AHEAD GET ADDRESS OF NEXT LDB A,I PTR AND ALSO PTR SZA,RSS IS IT EMPTY? JMP CLO.C,I ERROR EXIT CPB C.FCB IS IT THE ONE WE'RE LOOKING FOR JMP FND YES, GOT IT LDA B NO, CONTINUE ON DOWN THE LIST JMP NEXT FND LDB B,I REMOVE STB A,I IT BY CONNECTING NEXT TO PREVIOUS FCB * LDA C.#SC,I IS THIS A LOGICAL SZA,RSS UNIT? JMP EXIT YES, JUST EXIT * LDA C.FID,I DETERMINE AND B17 FCB TYPE CPA .2 SCRATCH? JMP CLSSC CLOSE SCRATCH FILE SZA,RSS READ FCB JMP CLSRD CLOSE READ FCB * CLSWR LDA C.BFF,I SHOULD BUFFER SSA,RSS BUFFER BE FLUSHED? JMP TRUN NO! CLA CLOSE WRITE FCB CLB JSB GE#SC AND FLUSH BUFFER JMP CLO.C,I ERROR RETURN * * TRUNCATE IF NO EXTENTS * TRUN LDA C.EXT,I  IS SZA AND EXTENTS? JMP CLSRD YES! LDA C.RSC,I DETERMINE CMA,INA ADA C.#SC,I NUMBER OF UNUSED RAL ADA M2 SECTORS CMA,INA COMPLEMENT STA SECTS JMP CLSRD CLOSE FILE * * * CLOSE SCRATCH FILE * CLSSC LDA .5 CALL CLOSE GEX.C TO RETURN SCRATCH FILE JSB GEX.C JMP EXIT YES! * * CLOSE READ FILE * CLSRD CLA CLOSE FILES CLB JSB GEX.C DEF SECTS JMP CLO.C,I ERROR EXIT P+1 EXIT ISZ CLO.C JMP CLO.C,I OK RETURN P+2 * * CONSTANTS AND BUFFERS * AHEAD DEF C.HLK ADDRESS OF HEAD OF LINKED LIST SECTS NOP NUMBER OF SECTORS TO TRUNCATE ID BSS 5 .1 DEC 1 .2 DEC 2 .5 DEC 5 M2 DEC -2 B17 OCT 17 END  MU 92064-18239 1805 S C0122 COMPILER LIB SPACE             H0101 cmASMB,R,L,C HED COMPILER LIBRARY SPACE ROUTINE NAM SPC.C,7 92064-18239 770515 REV. 1726 $CLIB * * *************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * * REPRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * *************************************************************** * * * * SOURCE PART NUMBER : 92060-18058 * * * LINE SPACE ROUTINE * * THIS ROUTINE WILL EJECT PAGES AND SPACE LINES ON LISTINGS * * * * * * * CALLING SEQUENCE: * * JSB SPC.C * DEF FCB * DEF FUN * ERROR RETURN * NO ERROR RETURN * * ON RETURN A < 0 INDICATES ERROR * A = 0 INDICATES NO ERROR * * WHERE FUN < 0 INDICATES PAGE EJECT IF LINE PRINTER * FUN > 0 SPACE 'FUN' LINES. * * * * ENTRY POINT: * ENT SPC.C * * EXTERNALS: * EXT EXEC SYSTEM EXEC EXT WRTC. WRITE ROUTINE EXT ADS.C FCB ADDRESS PASSER ROUTINE EXT C.FID FCB ID WORD EXT C.FLU FCB LOGICAL UNIT WORD EXT C.STR FCB CURRENT EXTENT TRACK NUMBER WORD EXT C.SSC FCB CURRENT EXTENT SECTOR NUMBER WORD EXT C.EXT FCB EXTENT NUMBER WORD EXT C.S/T FCB NUMBER OF BLOCKS/TRACK WORD EXT C.#SC FCB NUMBER OF BLOCKS/EXTENT WORD EXT C.WRD FCB CURRENT WORD POINTER WORD EXT C.FAD FCB DIRECTORY ADDRESS FROM D.RTR WORDS EXT C.HTR FCB START OF FILE TRACK NUMBER WORD EXT C.SLU FCB SECONDARY LOGICAL UNIT NUMBER WORD EXT C.?? FCB PROMPT CHARACTERS EXT C.GRW FCB REWIND GUARANTEE ROUTINE ADDRESS EXT C.INS FCB $INCLUDE ROUTINE ADDRESS EXT C.CNT FCB CONTROL ROUTINE ADDRESS * EXT C.PR1 PARAMETER ONE ADDRESS * * * * DETERMINE TYPE OF OPERATION * * THE FCB CONTAINS THE OPERATION TYPE AS FOLLOWS: * * TYPE = 0 IS READ SOURCE FILE(OR LU) * = 1 IS WRITE BINARY FILE(OR LU) * = 2 IS WRITE SCRATCH FILE * = 3 IS WRITE LIST FILE(OR LU) * = R IS READ SOURCE GUARANTEE REWINDABLILITY * * * A EQU 0 B EQU 1 * SPC.C NOP JSB ADS.C SET UP FILE CONTROL BLOCK ADDRESSES M1 DEC -1 LDB C.PR1,I GET CONTROL FUNCTION WORD LDA C.FID,I GET FILE/LU FLAG SSA IS THIS LU? JMP LUDEV YES! * * THIS A FILE SO WRITE EITHER A M1 FOR PAGE EJECT OR WRITE * THE NECESSARY LINE FOR LINE SPACING. * LDA LBUF SET UP BUFFER STA C.PR1 FOR WRITE SSB PAGE EJECT? JMP EJCTF WRITE A M1 IN COL 1 OF A LINE TO DO PAGE EJECT CMB,INB SET UP LINE STB CTR COUNTER WRT LDB .1 WRITE A JSB WRTC. A BLANK LINE(ONE CHAR) JMP ERROR ERROR RETURN ISZ CTR DONE? JMP WRT NO! JMP RETRN YES! * * EJECT PAGE * EJCTF LDA PBUF SET UP STA C.PR1 PAGE EJECT BUFFER LDB .1 JSB WRTC. WRITE A MINUS ONE FOR PAGE EJECT JMP ERROR ERROR RETURN JMP RETRN * LUDEV LDA C.FLU,I SET UP CONTROL WORD AND B77 MASK EXTRANEOUS BITS IOR B1100 MASK IN LINE CONTROL FUNCTIONS STA LU STB CTR SET CONTROL FUNCTION JSB EXEC PERFORM DEF *+4 DEF .3 CONTROL FUNCTION DEF LU DEF CTR RETRN ISZ SPC.C GOOD RETURN ERROR JMP SPC.C,I RETURN * * CONSTANTS AND VARIABLES * .1 DEC 1 .3 DEC 3 B77 OCT 77 B1100 OCT 1100 CTR NOP LINE COUNTER LU NOP LOGICAL UNIT LBUF DEF *+1 ASC 1, BLANKS PBUF DEF .1 END Eu  NV 92064-18240 1805 S C0122 COMPILER LIB REWIND             H0101 xASMB,L,C NAM RWN.C,7 92064-18240 770523 REV. 1726 $CLIB * * NAME: RWN.C * SOURCE: 92060-18059 * PGMR: EARL STUTES * *************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * * REPRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * *************************************************************** SPC 2 * THIS PROCEDURE PROVIDES THE REWIND FUNCTION FOR THE COMPILER * LIBRARY/ SPC 3 * PROC REWIND(FCB); * RECORD FCB; * BEGIN * BOOLEAN READWRITEFLAG := FALSE; * ADDRESSETUP; * IF WRITEBUFFER THEN * [ IF FCB.UNITRECORD THEN * [ FCB.UNITRECORD := FALSE; * FCB.FLU := FCB.SLU] * GETNEXTSECTOR(FALSE); * IF ERROR THEN GO ERROR EXIT;] * FCB.EXTENT# := 0; * GEX.C(3,FALSE); * ^ * +---------READWRITEFLAG = WRITE * IF RETURNP1 < 0 THEN * GO ERROR EXIT; * FCB.STARTTRACK := RETURNP4; * FCB.STARTSECTOR := RETURNP5 AND @377; ] * FCB.OFFSETBLOCK :=0; * FCB.RECORD# := 0; * BUFFERVALID := FALSE; * FCB.BP ;= 1; * END OF REWIND SKP ENT RWN.C EXT ADS.C ADDRESS SETUP PROC EXT C.FLU FCB PRIMARY FILE LU EXT C.HLU FCB HEAD LOGICAL UNIT EXT C.SLU FCB SECONDARY FILE LU EXT C.FAD FCB FILE DIRECTORY ADDRESS EXT C.HTR FCB HEAD TRACK EXT C.STR FCB START TRACK EXT C.SSC FCB START SECTOR EXT C.RSC FCB OFFSET BLOCK EXT C.FID FCB ID EXT C.EXT FCB EXTENT # EXT C.BFF FCB BUFFER POINTER EXT C.WRD FCB WORD OFFSET POINTER EXT C.RC# FCB RECORD NUMBER EXT GES.C THE DISC READ/WRITE ROUTINE EXT GEX.C THE HIDE THE FMGR/OPSYS ROUTINE EXT D.RP1 D.RTR RETURN PARAM  ETER 1 EXT D.RP4 D.RTR RETURN PARAMETER 4 EXT D.RP5 D.RTR RETURN PARAMETER 5 EXT EXEC GUESS WHO B EQU 1 SPC 2 * PROC REWIND(FCB); * RECORD FCB; * BEGIN * BOOLEAN READWRITEFLAG := FALSE; RWFLG OCT 0 SPC 2 RWN.C BSS 1 ENTRY POINT * ADDRESSETUP; JSB ADS.C DEC 0 * IF WRITEBUFFER THEN LDA C.BFF,I SSA,RSS JMP L0 * [ IF FCB.UNITRECORD THEN LDA C.FID,I SSA,RSS JMP LA * [ FCB,UNITRECORD := FALSE ELA,CLE,ERA STA C.FID,I * FCB.FLU := FCB.SLU; LDA C.SLU,I STA C.FLU,I * [ GETNEXTSECTOR(FALSE); LA EQU * CLA JSB GES.C * IF ERROR THEN GO ERROR EXIT;] JMP RWN.C,I * FCB.EXTENT# := 0; L0 EQU * CLA STA C.EXT,I * GEX.C(3,FALSE); LDA =D3 JSB GEX.C DEF RWFLG * IF RETURNP1 < 0 THEN * GO ERROR EXIT; JMP RWN.C,I * FCB.STARTTRACK := RETURNP4; LDA D.RP4 STA C.STR,I * FCB.STARTSECTOR := RETURNP5 AND @377; ] LDA D.RP5 AND =B377 STA C.SSC,I * FCB.OFFSETBLOCK := 0; L2 EQU * CLA STA C.RSC,I * FCB.RECORD# := 0; STA C.RC#,I * BUFFERVALID := FALSE; STA C.BFF,I * FCB.BP ;= 1; INA STA C.WRD,I * END OF REWIND ISZ RWN.C JMP RWN.C,I END (  OV 92064-18250 1805 S C0122 COMPILER LIB BIN-R FCB             H0101 uASMB,R,L,C HED COMPILER LIBRARY BINARY FILE CONTROL BLOCK NAM C.BIN,7 92064-18250 770515 REV. 1726 $CLIB * * *************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * * REPRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * *************************************************************** * * * * SOURCE PART NUMBER : 92060-18077 * * * * WRITE BINARY - RECORD ORIENTED * * * GENERAL FILE CONTROL BLOCK FORMAT * * * 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 0 * +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+ * C.LNK ! LINK TO NEXT FCB ! WORD 0 * +--+-----------+--------------+--------+--------+ * C.FID !DD!DFLT PRM# ! FCB # !XXXXXXXX!FCB TYPE! WORD 1 * +--+-----------+--------------+--------+--------+ * C.FLU ! !FUNCT CODE ! LOGICAL UNIT # ! WORD 2 * +--------------+--------------+-----------------+ * C.STR ! CURRENT EXTENT START TRACK NUMBER ! WORD 3 * +-----------------------------------------------+ * C.SSC ! CURRENT EXTENT START BLOCK NUMBER ! WORD 4 * +-----------------------------------------------+ * C.RSC ! CURRENT EXTENT OFFSET BLOCK ! WORD 5 * +-----------------------------------------------+ * C.EXT ! EXTENT NUMBER ! WORD 6 * +-----------------------------------------------+ * C.S/T ! NUMBER OF BLOCKS IN TRACK ! WORD 7 * +-----------------------------------------------+ * C.#SC ! NUMBER OF BLOCKS PER EXTENT ! WORD 8 * +-----------------------------------------------+ * C.FA1 ! DIRECTORY ADDRESS ! WORD 9 * +------------- ---------------+ * C.FA2 ! FROM D.RTR ! WORD 10 * +-----------------------------------------------+ * C.HTR ! HEAD TRACK NUMBER ! WORD 11 * +-----------------------------------------------+ * C.HLU ! HEAD TRACK LOGICAL UNIT ! WORD 12 * +-----------------------------------------------+ * C.SLU ! SECONDARY LOGICAL UNIT NUMBER ! WORD 13 * +-----------------------------------------------+ * C.RC# ! RECORD NUMBER ! WORD 14 * +-----------------------------------------------+ * C.?? ! PROMPT CHARACTERS ! WORD 15 * +-----------------------------------------------+ * C.WRD ! CURRENT WORD POINTER ! WORD 16 * +-----------------------------------------------+ * C.BUF ! BUFFER ADDRESS ! WORD 17 * +-----------------------------------------------+ * C.GRW ! REWIND CHECK GUARANTEE ADDRESS ! WORD 18 * +-----------------------------------------------+ * C.INS ! $INCLUDE ROUTINE ADDRESS ! WORD 19 * +-----------------------------------------------+ * C.CNT ! CONTROL ROUTINE ADDRESS ! WORD 20 * +-----------------------------------------------+ * * * * * * DETERMINE TYPE OF OPERATION * * THE FCB CONTAINS THE OPERATION TYPE AS FOLLOWS: * * TYPE = 0 IS READ SOURCE FILE(OR LU) * = 1 IS WRITE BINARY FILE(OR LU) * = 2 IS WRITE SCRATCH FILE * = 3 IS WRITE LIST FILE(OR LU) * = 4 IS REWINDABLE SOURCE * * * ENT C.BIN * EXT C.BBI BINARY BUFFER ADDRESS EXT C.DUM DUMMY WARC. EXT INSC. $INCLUDE ROUTINE EXT CNTC. CONTROL ROUTINE * * * WHERE: FCB TYPE = 0 FOR READ S_ OURCE * = 1 FOR WRITE BINARY * = 2 FOR READ-WRITE SCRATCH * = 3 FOR WRITE SOURCE * FCB # = THE NUMBER ASSIGNED TO THIS FCB * DFLT PR # = THE DEFAULT PARAMETER NUMBER * DD = 0 FOR DISC DEVICE * 1 FOR UNIT RECORD DEVICE * * * * * * C.BIN NOP LINK OCT 14001 DEFAULT PARAMETER #3, WRITE BINARY FILE NOP LOGICAL UNIT NOP START TRACK NUMBER NOP START SECTOR NUMBER NOP OFFSET BLOCK NUMBER NOP EXTENT NUMBER NOP NUMBER OF BLOCKS PER TRACK NOP NUMBER OF BLOCKS IN EXTENT NOP DIRECTORY ADDRESS NOP FROM D.RTR NOP HEAD TRACK NUMBER NOP HEAD TRACK LOGICAL UNIT NOP SECONDARY LOGICAL UNIT NOP CURRENT RECORD NUMBER NOP PROMPT CHARACTERS NOP CURRENT WORD POINTER DEF C.BBI BUFFER ADDRESS DEF C.DUM REWIND GUARANTEE ROUTINE DEF INSC. $INCLUDE ROUTINE ADDRESS DEF CNTC. CONTROL ROUTINE ADDRESS END d7 PX 92064-18251 1805 S C0122 COMPILER LIB LST FCB             H0101 rASMB,R,L,C HED COMPILER LIBRARY LIST FILE CONTROL BLOCK NAM C.LST,7 92064-18251 770515 REV. 1726 $CLIB * * *************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * * REPRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * *************************************************************** * * * * * SOURCE PART NUMBER : 92060-18078 * * * * WRITE LIST FILE - LINE SPACE AND EOF * * * GENERAL FILE CONTROL BLOCK FORMAT * * * 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 0 * +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+ * C.LNK ! LINK TO NEXT FCB ! WORD 0 * +--+-----------+--------------+--------+--------+ * C.FID !DD!DFLT PRM# ! FCB # !XXXXXXXX!FCB TYPE! WORD 1 * +--+-----------+--------------+--------+--------+ * C.FLU ! !FUNCT CODE ! LOGICAL UNIT # ! WORD 2 * +--------------+--------------+-----------------+ * C.STR ! CURRENT EXTENT START TRACK NUMBER ! WORD 3 * +-----------------------------------------------+ * C.SSC ! CURRENT EXTENT START BLOCK NUMBER ! WORD 4 * +-----------------------------------------------+ * C.RSC ! CURRENT EXTENT OFFSET BLOCK ! WORD 5 * +-----------------------------------------------+ * C.EXT ! EXTENT NUMBER ! WORD 6 * +-----------------------------------------------+ * C.S/T ! NUMBER OF BLOCKS IN TRACK ! WORD 7 * +-----------------------------------------------+ * C.#SC ! NUMBER OF BLOCKS PER EXTENT ! WORD 8 * +-----------------------------------------------+ * C.FA1 ! DIRECTORY ADDRESS ! WORD 9 *  +------------- ---------------+ * C.FA2 ! FROM D.RTR ! WORD 10 * +-----------------------------------------------+ * C.HTR ! HEAD TRACK NUMBER ! WORD 11 * +-----------------------------------------------+ * C.HLU ! HEAD TRACK LOGICAL UNIT ! WORD 12 * +-----------------------------------------------+ * C.SLU ! SECONDARY LOGICAL UNIT NUMBER ! WORD 13 * +-----------------------------------------------+ * C.RC# ! RECORD NUMBER ! WORD 14 * +-----------------------------------------------+ * C.?? ! PROMPT CHARACTERS ! WORD 15 * +-----------------------------------------------+ * C.WRD ! CURRENT WORD POINTER ! WORD 16 * +-----------------------------------------------+ * C.BUF ! BUFFER ADDRESS ! WORD 17 * +-----------------------------------------------+ * C.GRW ! REWIND CHECK GUARANTEE ADDRESS ! WORD 18 * +-----------------------------------------------+ * C.INS ! $INCLUDE ROUTINE ADDRESS ! WORD 19 * +-----------------------------------------------+ * C.CNT ! CONTROL ROUTINE ADDRESS ! WORD 20 * +-----------------------------------------------+ * * * * * * DETERMINE TYPE OF OPERATION * * THE FCB CONTAINS THE OPERATION TYPE AS FOLLOWS: * * TYPE = 0 IS READ SOURCE FILE(OR LU) * = 1 IS WRITE BINARY FILE(OR LU) * = 2 IS WRITE SCRATCH FILE * = 3 IS WRITE LIST FILE(OR LU) * = 4 IS REWINDABLE SOURCE * * * ENT C.LST * EXT C.BLI LIST BUFFER ADDRESS EXT C.DUM DUMMY WARC. EXT INSC. $INCLUDE ROUTINE EXT CNTC. CONTROL ROUTINE * * * WHERE: FCB TYPE = 0 FOR p READ SOURCE * = 1 FOR WRITE BINARY * = 2 FOR READ-WRITE SCRATCH * = 3 FOR WRITE SOURCE * FCB # = THE NUMBER ASSIGNED TO THIS FCB * DFLT PR # = THE DEFAULT PARAMETER NUMBER * DD = 0 FOR DISC DEVICE * 1 FOR UNIT RECORD DEVICE * * * * * * C.LST NOP LINK OCT 10003 DEFAULT PARAMETER #2, WRITE LIST FILE OCT 1 LOGICAL UNIT NOP START TRACK NUMBER NOP START SECTOR NUMBER NOP OFFSET BLOCK NUMBER NOP EXTENT NUMBER NOP NUMBER OF BLOCKS PER TRACK NOP NUMBER OF BLOCKS IN EXTENT NOP DIRECTORY ADDRESS NOP FROM D.RTR NOP HEAD TRACK NUMBER NOP HEAD TRACK LOGICAL UNIT NOP SECONDARY LOGICAL UNIT NOP CURRENT RECORD NUMBER NOP PROMPT CHARACTERS NOP CURRENT WORD POINTER DEF C.BLI BUFFER ADDRESS DEF C.DUM REWIND GUARANTEE ROUTINE DEF INSC. $INCLUDE ROUTINE ADDRESS DEF CNTC. CONTROL ROUTINE ADDRESS END  QY 92064-18252 1805 S C0122 COMPILER LIB SCR FCB 0             H0101 bASMB,R,L,C HED COMPILER LIBRARY SCRATCH #0 FILE CONTROL BLOCK NAM C.SC0,7 92064-18252 770515 REV. 1726 $CLIB * * *************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * * REPRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * *************************************************************** * * * * SOURCE PART NUMBER : 92060-18079 * * * * READ-WRITE SCRATCH FILE - REWIND IF NECESSARY * * * GENERAL FILE CONTROL BLOCK FORMAT * * * 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 0 * +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+ * C.LNK ! LINK TO NEXT FCB ! WORD 0 * +--+-----------+--------------+--------+--------+ * C.FID !DD!DFLT PRM# ! FCB # !XXXXXXXX!FCB TYPE! WORD 1 * +--+-----------+--------------+--------+--------+ * C.FLU ! !FUNCT CODE ! LOGICAL UNIT # ! WORD 2 * +--------------+--------------+-----------------+ * C.STR ! CURRENT EXTENT START TRACK NUMBER ! WORD 3 * +-----------------------------------------------+ * C.SSC ! CURRENT EXTENT START BLOCK NUMBER ! WORD 4 * +-----------------------------------------------+ * C.RSC ! CURRENT EXTENT OFFSET BLOCK ! WORD 5 * +-----------------------------------------------+ * C.EXT ! EXTENT NUMBER ! WORD 6 * +-----------------------------------------------+ * C.S/T ! NUMBER OF BLOCKS IN TRACK ! WORD 7 * +-----------------------------------------------+ * C.#SC ! NUMBER OF BLOCKS PER EXTENT ! WORD 8 * +-----------------------------------------------+ * C.FA1 ! DIRECTORY ADDRESS ! WOR!6D 9 * +------------- ---------------+ * C.FA2 ! FROM D.RTR ! WORD 10 * +-----------------------------------------------+ * C.HTR ! HEAD TRACK NUMBER ! WORD 11 * +-----------------------------------------------+ * C.HLU ! HEAD TRACK LOGICAL UNIT ! WORD 12 * +-----------------------------------------------+ * C.SLU ! SECONDARY LOGICAL UNIT NUMBER ! WORD 13 * +-----------------------------------------------+ * C.RC# ! RECORD NUMBER ! WORD 14 * +-----------------------------------------------+ * C.?? ! PROMPT CHARACTERS ! WORD 15 * +-----------------------------------------------+ * C.WRD ! CURRENT WORD POINTER ! WORD 16 * +-----------------------------------------------+ * C.BUF ! BUFFER ADDRESS ! WORD 17 * +-----------------------------------------------+ * C.GRW ! REWIND CHECK GUARANTEE ADDRESS ! WORD 18 * +-----------------------------------------------+ * C.INS ! $INCLUDE ROUTINE ADDRESS ! WORD 19 * +-----------------------------------------------+ * C.CNT ! CONTROL ROUTINE ADDRESS ! WORD 20 * +-----------------------------------------------+ * * * * * * DETERMINE TYPE OF OPERATION * * THE FCB CONTAINS THE OPERATION TYPE AS FOLLOWS: * * TYPE = 0 IS READ SOURCE FILE(OR LU) * = 1 IS WRITE BINARY FILE(OR LU) * = 2 IS WRITE SCRATCH FILE * = 3 IS WRITE LIST FILE(OR LU) * = 4 IS REWINDABLE SOURCE * * * ENT C.SC0 * EXT C.BS0 SCRATCH BUFFER ADDRESS EXT C.DUM DUMMY WARC. EXT INSC. $INCLUDE ROUTINE EXT CNTC. CONTROL ROUTINE * * * WHERE: FCB TYPE 4 = 0 FOR READ SOURCE * = 1 FOR WRITE BINARY * = 2 FOR READ-WRITE SCRATCH * = 3 FOR WRITE SOURCE * FCB # = THE NUMBER ASSIGNED TO THIS FCB * DFLT PR # = THE DEFAULT PARAMETER NUMBER * DD = 0 FOR DISC DEVICE * 1 FOR UNIT RECORD DEVICE * * * * * * C.SC0 NOP LINK OCT 00002 READ OR WRITE SCRATCH NOP LOGICAL UNIT NOP START TRACK NUMBER NOP START SECTOR NUMBER NOP OFFSET BLOCK NUMBER NOP EXTENT NUMBER NOP NUMBER OF BLOCKS PER TRACK NOP NUMBER OF BLOCKS IN EXTENT NOP DIRECTORY ADDRESS NOP FROM D.RTR NOP HEAD TRACK NUMBER NOP HEAD TRACK LOGICAL UNIT NOP SECONDARY LOGICAL UNIT NOP CURRENT RECORD NUMBER NOP PROMPT CHARACTERS NOP CURRENT WORD POINTER DEF C.BS0 BUFFER ADDRESS DEF C.DUM REWIND GUARANTEE ROUTINE DEF INSC. $INCLUDE ROUTINE ADDRESS DEF CNTC. CONTROL ROUTINE ADDRESS END  RZ 92064-18253 1805 S C0122 COMPILER LIB SCR FCB 1             H0101 bASMB,R,L,C HED COMPILER LIBRARY SCRATCH #1 FILE CONTROL BLOCK NAM C.SC1,7 92064-18253 770515 REV. 1726 $CLIB * * *************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * * REPRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * *************************************************************** * * * * SOURCE PART NUMBER : 92060-18080 * * * * READ-WRITE SCRATCH FILE - REWIND IF NECESSARY * * * GENERAL FILE CONTROL BLOCK FORMAT * * * 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 0 * +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+ * C.LNK ! LINK TO NEXT FCB ! WORD 0 * +--+-----------+--------------+--------+--------+ * C.FID !DD!DFLT PRM# ! FCB # !XXXXXXXX!FCB TYPE! WORD 1 * +--+-----------+--------------+--------+--------+ * C.FLU ! !FUNCT CODE ! LOGICAL UNIT # ! WORD 2 * +--------------+--------------+-----------------+ * C.STR ! CURRENT EXTENT START TRACK NUMBER ! WORD 3 * +-----------------------------------------------+ * C.SSC ! CURRENT EXTENT START BLOCK NUMBER ! WORD 4 * +-----------------------------------------------+ * C.RSC ! CURRENT EXTENT OFFSET BLOCK ! WORD 5 * +-----------------------------------------------+ * C.EXT ! EXTENT NUMBER ! WORD 6 * +-----------------------------------------------+ * C.S/T ! NUMBER OF BLOCKS IN TRACK ! WORD 7 * +-----------------------------------------------+ * C.#SC ! NUMBER OF BLOCKS PER EXTENT ! WORD 8 * +-----------------------------------------------+ * C.FA1 ! DIRECTORY ADDRESS ! WOR%-D 9 * +------------- ---------------+ * C.FA2 ! FROM D.RTR ! WORD 10 * +-----------------------------------------------+ * C.HTR ! HEAD TRACK NUMBER ! WORD 11 * +-----------------------------------------------+ * C.HLU ! HEAD TRACK LOGICAL UNIT ! WORD 12 * +-----------------------------------------------+ * C.SLU ! SECONDARY LOGICAL UNIT NUMBER ! WORD 13 * +-----------------------------------------------+ * C.RC# ! RECORD NUMBER ! WORD 14 * +-----------------------------------------------+ * C.?? ! PROMPT CHARACTERS ! WORD 15 * +-----------------------------------------------+ * C.WRD ! CURRENT WORD POINTER ! WORD 16 * +-----------------------------------------------+ * C.BUF ! BUFFER ADDRESS ! WORD 17 * +-----------------------------------------------+ * C.GRW ! REWIND CHECK GUARANTEE ADDRESS ! WORD 18 * +-----------------------------------------------+ * C.INS ! $INCLUDE ROUTINE ADDRESS ! WORD 19 * +-----------------------------------------------+ * C.CNT ! CONTROL ROUTINE ADDRESS ! WORD 20 * +-----------------------------------------------+ * * * * * * DETERMINE TYPE OF OPERATION * * THE FCB CONTAINS THE OPERATION TYPE AS FOLLOWS: * * TYPE = 0 IS READ SOURCE FILE(OR LU) * = 1 IS WRITE BINARY FILE(OR LU) * = 2 IS WRITE SCRATCH FILE * = 3 IS WRITE LIST FILE(OR LU) * = 4 IS REWINDABLE SOURCE * * * ENT C.SC1 * EXT C.BS1 SCRATCH BUFFER ADDRESS EXT C.DUM DUMMY WARC. EXT INSC. $INCLUDE ROUTINE EXT CNTC. CONTROL ROUTINE * * * WHERE: FCB TYPE 6 = 0 FOR READ SOURCE * = 1 FOR WRITE BINARY * = 2 FOR READ-WRITE SCRATCH * = 3 FOR WRITE SOURCE * FCB # = THE NUMBER ASSIGNED TO THIS FCB * DFLT PR # = THE DEFAULT PARAMETER NUMBER * DD = 0 FOR DISC DEVICE * 1 FOR UNIT RECORD DEVICE * * * * * * C.SC1 NOP LINK OCT 00102 READ OR WRITE SCRATCH NOP LOGICAL UNIT NOP START TRACK NUMBER NOP START SECTOR NUMBER NOP OFFSET BLOCK NUMBER NOP EXTENT NUMBER NOP NUMBER OF BLOCKS PER TRACK NOP NUMBER OF BLOCKS IN EXTENT NOP DIRECTORY ADDRESS NOP FROM D.RTR NOP HEAD TRACK NUMBER NOP HEAD TRACK LOGICAL UNIT NOP SECONDARY LOGICAL UNIT NOP CURRENT RECORD NUMBER NOP PROMPT CHARACTERS NOP CURRENT WORD POINTER DEF C.BS1 BUFFER ADDRESS DEF C.DUM REWIND GUARANTEE ROUTINE DEF INSC. $INCLUDE ROUTINE ADDRESS DEF CNTC. CONTROL ROUTINE ADDRESS END  S[ 92064-18254 1805 S C0122 COMPILER LIB SCR FCB 2             H0101 bASMB,R,L,C HED COMPILER LIBRARY SCRATCH #2 FILE CONTROL BLOCK NAM C.SC2,7 92064-18254 770515 REV. 1726 $CLIB * * *************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * * REPRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * *************************************************************** * * * * SOURCE PART NUMBER : 92060-18081 * * * * READ-WRITE SCRATCH FILE - REWIND IF NECESSARY * * * GENERAL FILE CONTROL BLOCK FORMAT * * * 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 0 * +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+ * C.LNK ! LINK TO NEXT FCB ! WORD 0 * +--+-----------+--------------+--------+--------+ * C.FID !DD!DFLT PRM# ! FCB # !XXXXXXXX!FCB TYPE! WORD 1 * +--+-----------+--------------+--------+--------+ * C.FLU ! !FUNCT CODE ! LOGICAL UNIT # ! WORD 2 * +--------------+--------------+-----------------+ * C.STR ! CURRENT EXTENT START TRACK NUMBER ! WORD 3 * +-----------------------------------------------+ * C.SSC ! CURRENT EXTENT START BLOCK NUMBER ! WORD 4 * +-----------------------------------------------+ * C.RSC ! CURRENT EXTENT OFFSET BLOCK ! WORD 5 * +-----------------------------------------------+ * C.EXT ! EXTENT NUMBER ! WORD 6 * +-----------------------------------------------+ * C.S/T ! NUMBER OF BLOCKS IN TRACK ! WORD 7 * +-----------------------------------------------+ * C.#SC ! NUMBER OF BLOCKS PER EXTENT ! WORD 8 * +-----------------------------------------------+ * C.FA1 ! DIRECTORY ADDRESS ! WOR(.D 9 * +------------- ---------------+ * C.FA2 ! FROM D.RTR ! WORD 10 * +-----------------------------------------------+ * C.HTR ! HEAD TRACK NUMBER ! WORD 11 * +-----------------------------------------------+ * C.HLU ! HEAD TRACK LOGICAL UNIT ! WORD 12 * +-----------------------------------------------+ * C.SLU ! SECONDARY LOGICAL UNIT NUMBER ! WORD 13 * +-----------------------------------------------+ * C.RC# ! RECORD NUMBER ! WORD 14 * +-----------------------------------------------+ * C.?? ! PROMPT CHARACTERS ! WORD 15 * +-----------------------------------------------+ * C.WRD ! CURRENT WORD POINTER ! WORD 16 * +-----------------------------------------------+ * C.BUF ! BUFFER ADDRESS ! WORD 17 * +-----------------------------------------------+ * C.GRW ! REWIND CHECK GUARANTEE ADDRESS ! WORD 18 * +-----------------------------------------------+ * C.INS ! $INCLUDE ROUTINE ADDRESS ! WORD 19 * +-----------------------------------------------+ * C.CNT ! CONTROL ROUTINE ADDRESS ! WORD 20 * +-----------------------------------------------+ * * * * * * DETERMINE TYPE OF OPERATION * * THE FCB CONTAINS THE OPERATION TYPE AS FOLLOWS: * * TYPE = 0 IS READ SOURCE FILE(OR LU) * = 1 IS WRITE BINARY FILE(OR LU) * = 2 IS WRITE SCRATCH FILE * = 3 IS WRITE LIST FILE(OR LU) * = 4 IS REWIDABLE SOURCE * * * ENT C.SC2 * EXT C.BS2 SCRATCH BUFFER ADDRESS EXT C.DUM DUMMY WARC. EXT INSC. $INCLUDE ROUTINE EXT CNTC. CONTROL ROUTINE * * * WHERE: FCB TYPE  = 0 FOR READ SOURCE * = 1 FOR WRITE BINARY * = 2 FOR READ-WRITE SCRATCH * = 3 FOR WRITE SOURCE * FCB # = THE NUMBER ASSIGNED TO THIS FCB * DFLT PR # = THE DEFAULT PARAMETER NUMBER * DD = 0 FOR DISC DEVICE * 1 FOR UNIT RECORD DEVICE * * * * * * C.SC2 NOP LINK OCT 00302 READ OR WRITE SCRATCH NOP LOGICAL UNIT NOP START TRACK NUMBER NOP START SECTOR NUMBER NOP OFFSET BLOCK NUMBER NOP EXTENT NUMBER NOP NUMBER OF BLOCKS PER TRACK NOP NUMBER OF BLOCKS IN EXTENT NOP DIRECTORY ADDRESS NOP FROM D.RTR NOP HEAD TRACK NUMBER NOP HEAD TRACK LOGICAL UNIT NOP SECONDARY LOGICAL UNIT NOP CURRENT RECORD NUMBER NOP PROMPT CHARACTERS NOP CURRENT WORD POINTER DEF C.BS2 BUFFER ADDRESS DEF C.DUM REWIND GUARANTEE ROUTINE DEF INSC. $INCLUDE ROUTINE ADDRESS DEF CNTC. CONTROL ROUTINE ADDRESS END  T\ 92064-18255 1805 S C0122 COMPILER LIB SCR BFR 0             H0101 eASMB,R,L,C HED COMPILER LIBRARY SCRATCH BUFFER #0 NAM C.BS0,7 92064-18255 770515 REV. 1726 $CLIB * * *************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * * REPRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * *************************************************************** * * * * SOURCE PART NUMBER : 92060-18089 * * * SOURCE I/O BUFFER * ENT C.BS0 BUFFER ENTRY POINT * * * C.BS0 BSS 129 * * END  U[ 92064-18256 1805 S C0122 COMPILER LIB INITIALIZE             H0101 ASMB,R,L,C HED COMPILER LIBRARY INITIALIIZE SUBROUTINE IFZ NAM SUP.C,7 92060-18091 770515 REV. 1726 $CLIB XIF IFN NAM SUP.C,7 92064-18256 770515 REVM. 1726 $CLIB XIF * * * Z OPTION GETS YOU AN RTE-II/RTE-III VERSION * N OPTION GETS YOU AN RTE-M VERSION * *************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * * REPRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * *************************************************************** * * * * SOURCE PART NUMBER : 92060-18091 * * * * ENTRY POINT: ENT SUP.C * * EXTERNALS: * EXT C.TRN TURN ON STRING FROM 'RUN' EXT EXEC EXT .MVW MOVE WORDS ROUTINE UNL IFZ LST EXT NAMR PARSE TURN ON STRING UNL XIF IFN LST EXT GTF.C GET FILE NAMES EXT C.HLK HEAD OF LINKED FCB'S EXT C.SN0 SOURCE NAME ADDRESS EXT C.BN0 BINARY NAME ADDRESS EXT C.LN0 LIST NAME ADDRESS EXT C.PC0 PAGE COUNT EXT RMPAR UNL XIF LST * * * * * CALLING SEQUENCE: * * JSB SUP.C * DEF STRING * ERROR RETURN * NO ERROR RETURN * * * A < 0 INDICATES THE ERROR * B = STRING LENGTH IN WORDS * * * WHERE: STRING IS A FIFTEEN WORD ARRAY CONTAINING THE TIME IN THE * FORMAT "12:01 PM MON., 29 DEC., 1982" * * * NOTE: THIS ROUTINE CAN BE CALLED ONCE AT THE BEGINNING OF THE LANGUAGE * PROCESSOR. AFTER THAT IT WILL BE USED AS A BUFFER FOR THE OTHER * ROUTINES OF THE COMPILER LIBRARY. * IT WILL ALSO GET THE LANGUAGE TURN ON STRING FROM THE OPERATING * SYSTEM AND STORE &IT IN THE GLOBAL ARRAY C.TRN. ONLY THE FIRST * FOUR PARAMTERS ARE RECOVERED. * SUP PRESS * A EQU 0 B EQU 1 O13 OCT 13 N1900 DEC -1900 D1 DEC 1 D12 DEC 12 MD60 DEC -60 DM12 DEC -12 O30K OCT 30000 ASCII 0 IN HIGH WORD M1 OCT -1 M3 DEC -3 M80 DEC -80 "AM" ASC 1,AM "PM" ASC 1,PM O3 OCT 3 O4 OCT 4 * * SUP.C NOP UNL IFN LST JSB RMPAR DEF *+2 DEF PBUFF CLA CLEAR OUT STA C.HLK FOR RESTART UNL XIF LST DATE JSB EXEC DEF *+4 DEF O13 GET TIME DEF ITIME DEF IYEAR LDA IMIN JSB PD00 LDB ":" IOR O30K DON'T SUPPRESS LEADING ZEROS HERE RRR 8 B=1'S BLANK,A= ":" , 10'S DST TMSG+1 SET IN MESSAGE LDA IHOUR LDB "PM" ASSUME PM FOR NOW ADA DM12 IS IT SSA,RSS TEST AND ADJUST JMP PM YES * LDB "AM" NO USE AM LDA IHOUR RESTORE THE CORRECT HOUR PM SZA,RSS IF ZERO USE LDA D12 TWELVE STB TMSG+3 SET THE AM PM JSB PD00 STA TMSG HOURS * LDA IYEAR ADA N1900 SUBTRACT THE HUNDREDS JSB PD00 CONVERT THE YEAR STA TMSG+14 YEARS LDB IDAY ADB MD60 -60 LDA IYEAR AND O3 SZA SKIP IF LEAP YEAR SSB ADB M1 ADJUST FOR LEAP YEAR SSB ADB D366 ADB D31 LDA B RAL,RAL ADA B *5 CLB DIV D153 STA ITIME QUOTIENT=MONTH. LDA B CLB DIV O5 INA GET DAY OF MONTH. JSB PD00 STA TMSG+8 LDB ITIME RECOVER MONTH BLS ADB MOTBA DLD B,I DST TMSG+10 CCA CALCULATE DAY OF WEEK. ADA IYEAR ARS,ARS ADA IYEAR ADA IDAY  CLB DIV O7 BLS ADB DAYWK DLD B,I DST TMSG+5 LDB SUP.C,I GET RETURN ADDRESS LDA TMSGA AND THE TIME ARRAY JSB .MVW MOVE IT DEF D15 NOP * UNL IFN LST JSB GTF.C GET THE FILE NAMES DEF *+6 DEF * DEF PBUFF DEF C.SN0 SOURCE FILE NAME DEF C.BN0 BINARY FILE NAME DEF C.LN0 LIST FILE NAME LDB PBUFF+3 STB C.PC0 SETUP THE PAGE COUNT SSA ERROR? JMP ERROR YES * LDB ATRN RSS LDB B,I RBL,CLE,SLB,ERB MAKE ADDR DIRECT JMP *-2 STB ATRN * * UNL XIF IFZ LST CLA LDB ADATE STA B,I CLEAR OUT PROGRAM INB PRIOR TO ISZ MD60 READING IN TURN ON STRING JMP *-3 * JSB EXEC GET TURN ON DEF *+5 STRING FROM DEF D14 :RU,,STRING DEF D1 AND STORE ON TOP OF THIS ROUTINE ADATE DEF DATE DEF M80 * STB LEN SAVE LENGTH OF PASSED STRING * SKIP OVER 'RU,' * GETPR JSB NAMR SKIP DEF *+5 BUFFA DEF C.TRN OVER FIRST DEF DATE DEF LEN TWO PARAMETERS DEF D1 SSA DONE? JMP DONE YES! LDA M3 INA DONE FIRST STA M3 SSA TWO? JMP GETPR NO! CPA O4 FINISHED? JMP DONE YES! LDA BUFFA INCREMENT RSS LDA A,I RAL,CLE,SLA,ERA STRIP OFF INDIRECT JMP *-2 ADA D10 TO NEXT STA BUFFA PARAMETER POSITION JMP GETPR UNL XIF LST DONE ISZ SUP.C ERROR ISZ SUP.C LDB D15 STRING LENGTH PASSED ON JMP SUP.C,I RETURN * SPC 2 PD00 NOP CONVERT TO 2 ASCII DIGITS CLB Ѣ DIV D10 DIVIDE BY 10 A=HIGH ,B=LOW SZA SUPPRESS ADA "0" LEADING ZEROS ALF,ALF PUT HIGH TO HIGH ADA B ADD IN THE LOW IOR "0" ADD ASCII BLANK 0 JMP PD00,I RETURN * "0" ASC 1, 0 ":" ASC 1, : D10 DEC 10 LEN EQU PD00 D14 DEC 14 D15 DEC 15 O5 OCT 5 O7 OCT 7 D31 DEC 31 D153 DEC 153 D366 DEC 366 UNL IFN LST ATRN DEF C.TRN PBUFF BSS 5 UNL XIF LST * SPC 1 * ITIME NOP TENS OF MSEC NOP SEC IMIN NOP MIN IHOUR NOP IDAY NOP IYEAR NOP * SPC 1 * MESSAGE FORMAT: ASC 15,10:03 AM MON., 29 DEC., 1975 * 001122334455667788990011223344 * TMSGA DEF *+1 TMSG ASC 15,12:01 PM MON., 29 DEC., 1975 * DAYWK DEF *+1 ASC 14,FRI.SAT.SUN.MON.TUE.WED.THU. * MOTBA DEF *-1 ASC 2,MAR. ASC 6,APR.MAY JUNE ASC 6,JULYAUG.SEPT ASC 6,OCT.NOV.DEC. ASC 4,JAN.FEB. * END չ V_ 92064-18257 1826 S C0122 LOGLU ROUTINE TO RETURN TU             H0101 PASMB,R,L,C ** LOGLU - RETURNS LU FROM $CON ENTRY POINT HED -LOGLU - FIND LU THAT THIS PROGRAM ORIGINATED FROM. * NAME: LOGLU * SOURCE: 92064-18257 * PGMR: R.T.S. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM LOGLU,7 92064-16081 REV.1826 780509 ENT LOGLU EXT $CON * * ROUTINE TO FIND THE LOGICAL UNIT NUMBER THAT THIS * PROGRAM ORIGINATED FROM. * CALLED AS FOLLOWS: * * LU = LOGLU(IDUMY) JSB LOGLU * DEF *+2 * DEF IDUMY * * * LU = A REG = LU # OF LU AT WHICH 'RU' OR 'ON' WAS ENTERED. * OR IF SCHEDULED BY A FATHER, THE LU AT WHICH * THE FATHER WAS SCHEDULED. * = 1 IF PROGRAM SCHEDULED BY INTERUPT OR TIME LIST * B REG = ASCII LU # * IDUMY = -1 SET TO NON-SESSION MODE SINCE RTE-M * DOES NOT SUPPORT SESSION MONITOR * * LOGLU NOP ENTRY DLD LOGLU,I GET RETURN ADDRESS & DUMMY ADDRESS STB DUMMY SAVE DUMMY ADDRESS STA LOGLU &RETURN ADDRESS CCA SO SET SESSION INDICATOR STB DUMMY,I GIVE ANSWER TO CALLER * SPC 1 *************************************************************** * SESSION MONITOR LU RETRIEVAL CODE TO BE INSERTED HERE * *************************************************************** SPC 1 * LDA $CON,I .FETCH TERM LU # AND B77 .MASK OUT LU STA LU# * CLB .SET UP FOR INTEGER DIVIDE DIV D10 NOW CONVERT B  LU TO ASCII ALF,ALF ADB A ADB ASC00 B = ASCII LU # LDA LU# A = BINARY LU # JMP LOGLU,I RETURN * * * D10 DEC 10 B77 OCT 77 DUMMY NOP LU# NOP ASC00 ASC 1,00 A EQU 0 B EQU 1 END J  W^ 92065-18001 1726 S C0222 &MBCM0 RTE-M BAISC MAIN PROG             H0102 ASMB,R HED <> 92065-16001 NAM BASIC,3,90 92065-16001 REV.1726 770513 * * DATE 5-13-77 * ************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * * PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ************************************************************** * * * SOURCE: 92065-18001 * * ************************************************************* * ENT FINDV,ERRPT,DRQST,GETCR,OUTCR,BCKSP,LETCK ENT PRMT,REED,WRITE,PEXMK,RDYPT,OUTER,INTCK,KEYBD * * * * ENT DIGCK,FNDPS,OUTIN,ENOUT,NUMOT ENT PRNIN,OUTLN,NUMCK,SSYMT,MVTOH,RUN,COMND ENT PLIST,LOADT,INDCK,.IENT,OLNCK EXT REIO,.FLUN,EXEC EXT MVNAM,FILRD,FILWR,CLFIL EXT BASC5,BASC3,BASC2 * EXT ..FCM,.PACK,RMPAR,BASC1 COM TEMPS(30),PNTRS(61),SPEC(10) ************************************** * * * BASIC MAIN CONTROL * * * ************************************** * * THIS PART OF THE INTERPRETER REMAINS CORE RESIDENT DURING * THE EXECUTION OF BASIC. IT INTERPRETS AND EXECUTES ALL * OF THE SYSTEM COMMANDS BY LOADING THE APPROPRIATE SEGMENT * AND TRANSFERRING EXECUTION TO IT. UPON COMPLETION, THE * SEGMENTS RETURN EXECUTION TO THIS PROGRAM.IN ADDITION, IT * PROVIDES FOR ALL USER COMMUNICATION WITH THE INTERPRETER. * THERE ARE 8 SEGMENTS WHICH MAY CALLED BY THE MAIN CONTROL: * * SEGMENT #1: CHECKS SYNTAX AND TRANSLITERATES CODE * SEGMENT #2: LISTS THE PROGRAM * SEGMENT #3: CHECKS THE PROGRAM PRIOR TO EXECUTION * SEGMENT #4: EXECUTES THE PROGRAM * SEGMENT #5: EXECUTES COMMANDS * SEGMENT #6: EXECUTES MORE COMMANDS * SEGMENT #8: EXECUTES e0NON-TIME DEPENDENT STATEMENTS * * * TO RUN BASIC USE: * * *ON,BASIC,CONSOLE LU,LIST LU,INPUT LU,OUTPUT LU, ERROR LU * * OR * * *ON,BASIC,NA,ME,XX,CONSOLE LU,LIST LU * * WHERE: NAMEXX = THE COMMAND FILE NAME * *************************** * * * CONSTANTS AND VARIABLES * * * *************************** * FWAM EQU PNTRS FIRST WORD OF AVAILABLE MEMORY LWBM EQU PNTRS+1 LAST WORD OF AVAILABLE MEMORY .INBF EQU PNTRS+2 INPUT BUFFER ADDRESS SBUFA EQU PNTRS+3 SYNTAX BUFFER ADDRESS SYMTA EQU PNTRS+4 START OF SYMBOL TABLE SYMTF EQU PNTRS+5 END OF SYMBOL TABLE PBUFF EQU PNTRS+6 FIRST WORD OF USER PROGRAM PBPTR EQU PNTRS+7 LAST WORD+1 OF USER PROGRAM INBFA EQU PNTRS+8 INPUT BUFFER POINTER ICCNT EQU PNTRS+9 INPUT CHARACTER COUNT SBPTR EQU PNTRS+10 SYNTAX BUFFER POINTER .LNUM EQU PNTRS+11 CURRENT LINE # FCORE EQU PNTRS+12 START OF FREE CORE MNNAM EQU PNTRS+13 MNEMONIC TABLE NAME:SC:LU BRNAM EQU PNTRS+18 BRANCH TABLE NAME:SC:LU FWAMM EQU PNTRS+23 POINTER TO START OF MNEMONIC TABLE FWAMB EQU PNTRS+24 POINTER TO START OF BRANCH TABLE .OTBF EQU PNTRS+25 POINTER TO OUTPUT BUFFER OCCNT EQU PNTRS+26 OUTPUT CHARACTER COUNT OTBFA EQU PNTRS+27 POINTER INTO OUTPUT BUFFER LUOUT EQU PNTRS+28 CURRENT OUTPUT L.U. # LUINP EQU PNTRS+29 CURRENT INPUT L.U. # SIGN EQU PNTRS+30 SIGN OF CURRENT NUMBER BLANK EQU PNTRS+31 CURRENT TERMINATION CHAR REC# EQU PNTRS+32 COMMAND FILE RECORD NUMBER FLTYP EQU PNTRS+33 TYPE 0 FILE FLAG TTYPR EQU PNTRS+34 CONSOLE TTY L.U. # PRINT EQU PNTRS+35 LISTING L.U. # READR EQU PNTRS+36 AUXILLIARY INPUT L.U. # PUNCH EQU PNTRS+37 AUXILLIARY OUTPUT L.U. # ERTTY EQU PNTRS+38 ERROR LIST OUTPUT L.U. # FLFIL EQU PNTRS+39 FILE SAVERSTORE FLAG FILBK EQU PNTRS+40 FILE CONTROL BLOCK ADDRESS PFLAG EQU PNTRS+41 SAVE,LOAD FILE FLAG LOLIM EQU PNTRS+42 LOW LIMITS OF PROGRAM HILIM EQU PNTRS+43 HIGH LIMITS OF PROGRAM LORUN iEQU PNTRS+44 LOW RUN LIMITS HIRUN EQU PNTRS+45 HIGH RUN LIMITS SLSTM EQU PNTRS+46 EXECUTE SLOW STMTS LOTRC EQU PNTRS+47 LOW TRACE LIMITS HITRC EQU PNTRS+48 HIGH TRACE LIMITS BRKP1 EQU PNTRS+49 BREAK POINT #1 BRKP2 EQU PNTRS+50 BREAK POINT #2 BRKP3 EQU PNTRS+51 BREAK POINT #3 BRKP4 EQU PNTRS+52 BREAK POINT #4 SMFLG EQU PNTRS+53 SIMULATE FLAG TYPE EQU PNTRS+54 PARTIAL LINE CHARACTER COUNT DLMTR EQU PNTRS+55 CHAR EDIT DELIMITER MERGF EQU PNTRS+56 MERGE FLAG COMN EQU PNTRS+57 COMMAND FILE NAME SYFLG BSS 1 SYNTAX SEGMENT FLAG TEMPT BSS 15 * RDYA DEF READY QMRKA DEF QMARK ACKNA DEF ACKNW SPC 1 SUP PRESS MULTIPLE LISTING SPC 1 .2 DEC 2 .3 DEC 3 .4 DEC 4 .9 DEC 9 .12 DEC 12 .15 DEC 15 .32 DEC 32 .9999 DEC 9999 B77 OCT 77 B700 OCT 700 MSK OCT 177400 M1 DEC -1 M2 DEC -2 M4 DEC -4 M7 DEC -7 M14 DEC -14 M80 DEC -80 MSK3 EQU M7 * QMARK ASC 1,?_ : ACKNW ASC 1,>_ : READY OCT 6412 ASC 6,BASIC READY SKP ********************** * * * BASIC MAIN CONTROL * * * ********************** BASIC NOP ENTRY * JSB RMPAR FETCH LOGICAL DEF *+2 UNIT NUMBERS DEF TTYPR LDA .9999 SET FLAG TO STA PFLAG TO ENABLE BASIC INIT. JSB BASC3 .INIITALIZE CODE HLT 01 SPC 1 RDYPT LDA TTYPR SET UP STA LUOUT INPUT AND STA LUINP OUTPUT DEVICE UNITS LDB 1717B GET ADB .12 CURRENT LDA 1,I PROGRAM STA READY+1 NAME INB AND LDA 1,I STORE STA READY+2 IN INB THE LDA 1,I READY AND MSK MESSAGE ADA .32 STA READY+3 LDA M14 PR?INT LDB RDYA THE BASIC'S 'NAME' JSB WRITE AND 'READY' JMP PRMT PROMPT! SPC 1 * EXECUTION RETURNED HERE FROM SEGMENT #1 SPC 1 * * PFLAG MAY HAVE THE FOLLOWING VALUES: * * PLFAG = -1 INPUT FROM TAPE * PFLAG = 0 INPUT FROM KEYBOARD * PFLAG = 1 INPUT FROM PROGRAM FILE * PFLAG = 2 INPUT FROM SPECIFIED LU # * PFLAG = 3 LOAD B&M TABLE FLAG * PFLAG = 4 INPUT FROM COMMAND FILE * PFLAG = 5 RUN A PROGRAM BY NAME * PFLAG = 9999 EXECUTE INITIALIZATION IN SEG 3(ONCE ONLY) * PEXMK LDA PFLAG SZA IS TAPE FLAG SET? JMP MORTP GET RECORD FROM PHOTO RDR * * EXECUTION RETURNED HERE FROM SEGMENTS #5 AND #6 * PRMT LDA TTYPR INITIALIZE STA LUOUT INPUT AND STA LUINP OUTPUT DEVICES UNITS CLA,INA INITIALIZE STA LOLIM LOW LIMIT STA LORUN LDA .9999 INITIALIZE STA HILIM HIGH LIMIT STA HIRUN CLA STA DRQST CLEAR DATA REQUEST FLAG STA PFLAG CLEAR TAPE INPUT FLAG STA SYFLG CLEAR SYNTAX SEGMENT FLAG STA MERGF CLEAR OUT MERGE FLAG CCA SET FOR STA FLTYP NO TYPE 0 I-O LDA M2 LDB ACKNA JSB WRITE PRINT '>' WITH NO CR-LF JMP GTRCD INPUT RECORD SPC 1 * PROCESS DATA REQUEST SPC 1 DRQST NOP LDA LUINP IS THIS JSB KEYBD . A KEYBOARD DEVICE ? JMP GTRCD NO LDA M2 LDB QMRKA JSB WRITE PRINT '?' AND WAIT SPC 1 * INPUT RECORD FROM TTY SPC 1 GTRCD LDA M80 LDB .INBF JSB REED GET RECORD FROM TT SPC 1 * PROCESS RECORD SPC 1 RPRCS CMA SET A = -1# CHARS STA ICCNT SET CHAR COUNT STA TEMP8 SET FOR ERROR PRINT OUT LDB .INBF LOAD BUFFER ADDRESS CLE,ELB SHIFT LEFT,LEAST BIT USED AS STB INBFA ODD/EVEN FLAG INA,SZA,RSS NULL RECORD ? JMP GTRCD YES, INPUT AGAIN LDB DRQST SZB,RSS DATA REQUEST? JMP RPRC0 NO DATA REQUEST,GO CHECK RECORD CLA STA DRQST CLEAR DATA REQUEST FLAG JMP 1,I AND FAKE THE RETURN THRU DRQST SPC 1 * LOAD SYNTAX SEGMENT AND BRANCH TO IT SPC 1 RPRC0 JSB GETCR GET FIRST CHARACTER JMP GTRCD UNLESS THERE ISN'T ONE CKRCD LDB SBUFA INITIALIZE SYNTAX STB SBPTR BUFFER POINTER STA 1,I PUT FIRST CHAR IN SYNTAX BUFFER CPA DLMTR LIST NEXT LINE COMMAND? JMP COMND YES, LIST IT! JSB LETCK IS THIS A LETTER? JSB BASC1 .GO TO SYNTAX CHECKERE JMP COMND YES, GO TO COMMAND PHASE * * SKP * EXECUTION RETURNED HERE WHEN ERROR OCCURS * SET FOR PRINTING ERROR MESSAGE SPC 1 OUTER CCA SET L.U. NEGATIVE FOR FLAG STA LUOUT TO INDICATE ERROR MESSAGE JMP PLIST BRANCH TO LIST SEGMENT SPC 1 * EXECUTION RETURNED HERE AFTER PRINTING ERROR MESSAGE * SET FOR LOADING SYNTAX SEGMENT AGAIN SPC 1 ERRPT CLA CLEAR SYNTAX SEGMENT FLAG STA SYFLG STA PFLAG AND FILE FLAG INA SET FOR END STA REC# OF COMMAND FILE INPUT JMP PEXMK GO WAIT FOR INPUT * PROCESS SYSTEM COMMANDS SPC 1 * LOAD COMMAND SEGMENT SPC 1 * COMES HERE THROUGH SYNTAX SEGMENT (A) CONTAINS FIRST * CHARACTER OF COMMAND * COMND CLB CLEAR SYNTAX FLAG STB SYFLG JSB BASC5 .CALL COMMAND PROCESSOR SPC 1 * PROCESS 'RUN' COMMAND SPC 1 RUN JSB BASC3 .CALL EXECUTE PROCESSOR SPC 1 SPC 1 * PROCESS 'SAVE' & 'LIST' COMMAND SPC 1 PLIST JSB BASC2 .CALL LIST & SAVE PROCESSOR SPC 1 * PROCESS 'LOAD' COMMAND SPC 1 LOADT LDA READR SET L.U. TtO READER LDB PFLAG .LU SPECIFIED? CPB .2 RSS .OR "RUN FROM" ? CPB .5 LDA LUINP .YES DO NOT CHANGE LUINPUT STA LUINP AND B77 ISOLATE L.U. # IOR B700 MGE IN FUNCTION CODE STA LENTH SAVE IT JSB EXEC CALL EXEC DEF *+3 DEF .3 TO SET EOT BIT DEF LENTH * MORTP LDA M80 LDB .INBF JSB REED GET RECORD FROM READER CPA M2 END OF TAPE? JMP LOAD0 .CHECK FOR RUN FROM COMMAND SZA,RSS JMP MORTP NULL RECORD JMP RPRCS GO PROCESS RECORD * LOAD0 LDA FLFIL .CHECK FOR FILE INPUT INA,SZA,RSS JSB CLFIL .YES - CLOSE THE FILE LDA PFLAG CPA .5 .RUN ? JMP RUN .YES EXECUTE PROGRAM JMP RDYPT .NO PROMPT * *********************** * * * UTILITY SUBROUTINES * * * *********************** * * THE FOLLOWING SUBROUTINES ARE USED BY THE SEGMENTS OF THE * BASIC INTERPRETER AND THEREFORE ARE CORE RESIDENT. THEY * ARE DEFINED IN THE SEGMENTS AS BEING EXTERNAL. * * ******************************* * * * INDIRECT CHECK * * * ******************************* * INDCK NOP CHASE INDIRECT CHAIN RSS AND RETURN DIRECT POINTER IN A LDA 0,I GO ANOTHER LEVEL RAL,CLE,SLA,ERA SKIP IF NOT INDIRECT JMP *-2 JMP INDCK,I REAL ADDRESS, EXIT * ******************** * * * CHECK FOR LETTER * * * ******************** LETCK NOP CHARACTER IN (A) LDB 0 ADB D133 ASCII 133B SSB,RSS OR GREATER? JMP LETCK,I YES, EXIT WITH CHARACTER IN (A) ADB .26 NO, ASCII 101B SSB,RSS OR GREATER? ISZ LETCK YES JMP LETCK,I NO * .26  DEC 26 D72 OCT -72 D133 OCT -133 ******************* * * * CHECK FOR DIGIT * * * ******************* DIGCK NOP CHARACTER IN (A) LDB 0 ADB D72 ASCII 72B SSB,RSS OR GREATER? JMP DIGCK,I YES, RETURN WITH CHARACTER ADB .10 NO, ASCII 60B SSB OR GREATER? JMP DIGCK,I NO ISZ DIGCK YES, SET 'SUCCESS' EXIT, LDA 1 LOAD DIGIT INTO (A), JMP DIGCK,I AND RETURN SKP ***************************** * * * ADD CHAR TO OUTPUT BUFFER * * * ***************************** OUTCR NOP CHARACTER IN (A) STA TEMP4 SAVE CHARACTER ISZ OCCNT COUNT IT LDB OCCNT FIRST CHARACTER SLB OF BUFFER WORD? ISZ OTBFA YES, MOVE TO FRESH WORD LDA OTBFA,I LOAD BUFFER WORD SLB SAVE ALF,ALF OTHER AND M256 CHARACTER IOR TEMP4 ADD NEW CHARACTER SLB POSITION ALF,ALF WORD AND STA OTBFA,I STORE IT JMP OUTCR,I ****************************** * * * GET CHAR FROM INPUT BUFFER * * * ****************************** GETCR NOP ISZ ICCNT ANY CHARACTERS LEFT? RSS JMP GETCR,I NO, END-OF-FILE EXIT LDB INBFA LOAD BUFFER ADDRESS ISZ INBFA UPDATE FOR NEXT TIME CLE,ERB SET CHARACTER FLAG LDA 1,I LOAD CURRENT BUFFER WORD SEZ,RSS FIRST CHARACTER? ALF,ALF YES, POSITION IT AND B177 MASK EXTRANEOUS BITS CPA BLANK BLANK? JMP GETCR+1 YES, FETCH NEXT CHARACTER ISZ GETCR UPDATE RETURN ADDRESS JMP GETCR,I AND EXIT * B177 OCT 177 M256 DEC -256 *************************** * * * BACKSPACE OVERP ONE CHAR * * * *************************** BCKSP NOP CCA BACKSPACE ADA ICCNT OVER STA ICCNT LAST CCA CHARACTER IN ADA INBFA INPUT STA INBFA BUFFER JMP BCKSP,I SKP ***************************** * * * INITIALIZE FOR NEW LINE * * * ***************************** * PRNIN NOP CCA INITIALIZE ADA .OTBF BUFFER STA OTBFA POINTER CLA INITIALIZE STA OCCNT CHARACTER COUNTER JMP PRNIN,I SPC 1 ************************* * * * OUTPUT COMPLETED LINE * * * ************************* OUTLN NOP LDA OCCNT OUTPUT LDB .OTBF A JSB WRITE LINE JSB PRNIN CLEAN UP OUTPUT BUFFER STA TYPE RESET PARTIAL LINE COUNTER JMP OUTLN,I * * ***************************** * * * CHECK FOR LINE OVERFLOW * * * ***************************** * * AT ENTRY, A = NUMBER OF CHARACTERS * TO BE OUTPUT, EXCLUSIVE * OF TRAILING BLANKS. * THIS ROUTINE CHECKS FOR LINES OVER 72 * CHARACTERS, AND OUTPUTS THEM BEFORE * FIGURING THE END OF FIELD FOR NUMERIC * FORMATTING. THE END OF FIELD COLUMN * NUMBER IS RETURNED IN TEM10. * OLNCK NOP STA BCKSP SAVE REQUEST LENGTH TEMPORARILY ADA OCCNT FIGURE LENGTH OF BUFFER ADA TYPE FIGURE COLUMN OF RESULT CMA,INA ADA .80 TOO MANY CHARACTERS ? SSA JSB OUTLN YES, OUTPUT LINE FIRST LDA BCKSP RECOVER REQUEST LENGTH ADA OCCNT AND FIGURE ADA .3 THE END-OF-FIELD STA TEM10 COLUMN NUMBER JMP OLNCK,I * .80 DEC 80 SKP ******************************* * * * FIND OUT THE DEVICE TYPE * * * ******************************* * * ON INPUT (A) = LU NUMBER * ON EXIT (A) = DVR NUMBER * (B) = SUBCHANNEL # * FINDV NOP STA SLU .SET UP STATUS EXEC CALL JSB EXEC . TO FETCH EQUIP TYPE CODE DEF FIND1 . AND SUBCHANNEL NUMBER DEF .13 DEF SLU DEF EQT5 DEF EQT4 DEF SBCHN * FIND1 LDA SBCHN .FETCH SUBCHANNEL AND AND MSK0 . REMOVE DOWN BIT LDB 0 .LEAVE IN B REG LDA EQT5 ALF,ALF .FETCH EQUIP TYPE CODE AND B77 JMP FINDV,I * .13 DEC 13 SLU NOP EQT5 NOP EQT4 NOP SBCHN NOP * * ******************************** * * DETERMINE IF LU# IS KEYBOARD DEVICE * * A(ENTRY) IS LU# * ON EXIT A UNCHANGED * EXIT P+1 NOT A KEYBOARD DEVICE * EXIT P+2 IS A KEYBOARD DEVICE * ******************************* * KEYBD NOP STA KEY1 .SAVE LU # AND B77 .STRIP OFF CONTROL BITS JSB FINDV .ISOLATE LU# CPA .5 . IS IT DVR05 ? JMP KEY2 .CHECK FOR CTU OR PRINTER SZA .IS IT DVR00? JMP KEYBD,I .NO EXIT P+1 KEYS ISZ KEYBD LDA KEY1 .RESTORE LU # JMP KEYBD,I KEY2 SZB,RSS .IS IT THE DISPLAY? JMP KEYS .YES JMP KEYBD,I KEY1 NOP .5 DEC 5 MSK0 OCT 377 SKP ******************** * * * FIND A STATEMENT * * * ******************** * * UPON ENTRY (A) = SEQUENCE NUMBER TO BE FOUND. IF (A) * IS LARGER THAN ANY SEQUENCE NUMBER IN THE PROGRAM, EXIT * TO (P+1) WITH (B) POINTING TO LAST WORD+1 OF THE PROGRAM * IF (A) FALLS BETWEEN TWO SEQUENCE NUMBERS, EXIT TO (P+2) * WITH (B) POINTING TO THE STATEMENT WITH THE LARGER SEQUENCE * NUMBER. IF A STATEMENT IN THE PROGRAM HAS THE SEQUENCE * NUMBER THEN EXIT TO (P+3) WITH (B) POINTING TO THIS STATEMENT. * FNDPS NOP STA TEMP3 SAVE SEQUENCE NUMBER LDB PBUFF STARTING ADDRESS FNDP1 CPB PBPTR END OF PROGRAM? JMP FNDP4 YES, EXIT VIA (P+1) LDA TEMP3 SUBTRACT PROGRAM CMA,INA SEQUENCE NUMBER FROM ADA 1,I S-BUFFER SEQUENCE NUMBER SZA,RSS EQUAL? ISZ FNDPS YES, SET EXIT TO (P+3) SSA,RSS NO, P-SEQ NO > S-SEQ NO ? JMP FNDP3 YES, SET EXIT TO (P+2) LDA 1 POINT (A) TO INA PROGRAM ADDRESS INCREMENT ADB 0,I COMPUTE NEW ADDRESS JMP FNDP1 FNDP3 ISZ FNDPS FNDP4 STB TEMP3 SAVE STATEMENT ADDRESS JMP FNDPS,I ***************************** * * * MOVE WORDS TO HIGHER CORE * * * ***************************** MVTOH NOP LDB TEMP2 FETCH SOURCE ADDRESS MVTO1 CPB TEMP3 ALL RELOCATION DONE? JMP MVTOH,I YES, EXIT CCA BACK UP ADB 0 ADA TEMP4 SOURCE AND STA TEMP4 DESTINATION LDA 1,I MOVE STA TEMP4,I WORD JMP MVTO1 SKP *********************** * * * SEARCH SYMBOL TABLE * * * *********************** * * SSYMT IS CALLED WITH THE IDENTIFIER TO SEARCHED FOR IN * (A). IT RETURNS WITH THE ADDRESS OF THE MATCHING ENTRY * IN (B) OR (B)=-1 IF THERE IS NO MATCHING ENTRY. * * THE FOLLOWING RULES APPLY WHEN SEARCHING FOR ARRAYS: * * 1. TYPE 1 (ONE DIMENSION) SEARCH FOR CORRESPONDING * TYPE 1 OR TYPE 3 ARRAY. IF TYPE 3 IS FOUND CHANGE * THE ENTRY TO TYPE 1. * * 2. TYPE 2 (TWO DIMENSIONS) SEARCH FOR CORESPONDING * TYPES OR TYPE 3 ARRAY. IF TYPE 3 IS FOUND CHANGE * THE EB@= 5 ? JMP NUMO9+1 NO * * ** ROUND ASCII MANTISSA ** * * LDB NMPTR NUMO7 ADB M1 LOAD LAST LDA 1,I DIGIT INA INCREMENT IT CPA .58 WAS IT A 9 ? RSS YES JMP NUMO9 NO CPB NMBFA LEADING DIGIT? JMP NUMO8 YES LDA .48 NO, OVERLAY STA 1,I A 0 JMP NUMO7 NUMO8 ISZ EXPON BUMP DECIMAL NOP EXPONENT AND LDA .49 OVERLAY A 1 NUMO9 STA 1,I LDA EXPON IS NUMBER SSA,RSS LESS THAN 1 ? JMP NMO11 NO STA TEMP6 YES LDA .48 LDB NMPTR NMO10 ISZ TEMP6 COUNT ZEROS NOP PLUS 1 ADB M1 LAST CPA 1,I DIGIT 0? JMP NMO10 YES LDA TEMP6 NO, ALL SIGNIFICANCE SSA IN SIX DIGITS? JMP NMO11 NO CCA YES, SET STA FFLAG 'FIXED' FLAG TRUE NMO11 LDA .9 COMPUTE ISZ FFLAG FIELD ADA .3 WIDTH JSB OLNCK CHECK FOR LINE OVERFLOW LDA SIGN YES SZA SIGN? JSB OUTCR YES, OUTPUT IT LDB M7 SET OUTPUT STB DIGCT DIGIT COUNTER LDB NMPTR CCA FIXED CPA FFLAG FORMAT? JMP *+5 NO LDA EXPON YES, SET CMA INDICATOR TO STA TEMP6 DECIMAL POINT JMP NMO16 STA TEMP6 SET INDICATOR FOR DECIMAL POINT JMP NMO14 NO * * ** DELETE TRAILING ZEROS ** * * NMO12 LDA DIGCT AT RIGHT OF INA DECIMAL CPA TEMP6 POINT? JMP *+6 NO STA DIGCT YES, DELETE ZERO NMO16 ADB M1 LAST LDA 1,I DIGIT CPA .48 0? JMP NMO12 YES CCA NO, FIXED CPA FFLAG FORMAT? JMP NMO14 NO LDA EXPON YES, LEADING SSA,RSS DECIMAL POINT? JMP NMO14 NO STA TEMP6 YES, SET LEADING ZEROS COUNTER * * ** OUTPUT MANTISSA ** * * LDA .46 OUTPUT A RSS DECIMAL POINT NMO13 LDA .48 OUTPUT JSB OUTCR A ZERO ISZ TEMP6 MORE LEADING ZEROS? JMP NMO13 YES ISZ DIGCT NO, COUNT DECIMAL POINT NMO14 LDB NMBFA SET STB NMPTR DIGIT POINTER JMP *+5 NMO15 ISZ TEMP6 DECIMAL POINT NEXT? JMP *+3 NO LDA .46 YES, LOAD IT JMP *+3 LDA NMPTR,I LOAD NEXT ISZ NMPTR DIGIT JSB OUTCR OUTPUT CHARACTER ISZ DIGCT MORE DIGITS? JMP NMO15 YES ISZ FFLAG NO, EXPONENT? JMP NUMOT,I NO * * ** OUTPUT THE EXPONENT ** * * LDA E JSB OUTCR OUTPUT AN 'E' LDA .45 OUTPUT LDB EXPON SSB AN CMB,INB,RSS LDA .43 EXPONENT STB EXPON JSB OUTCR SIGN LDA EXPON CLB COMPUTE DIV .10 ADA .48 EXPONENT'S ADB .48 STB EXPON 10'S DIGIT JSB OUTCR OUTPUT IT LDA EXPON OUTPUT JSB OUTCR 1'S DIGIT JMP NUMOT,I SKP ********************* * * * OUTPUT AN INTEGER * * * ********************* OUTIN NOP INTEGER IN (A) LDB M4 SET DIGIT STB DIGCT COUNTER LDB LDVSR SET DIVISOR STB TEMP7 ADDRESS CLB SUPPRESS STB TEMP6 ZEROES OUTI1 DIV TEMP7,I DIVIDE INTEGER STB TEMP5 CURRENT DIVISOR CPA TEMP6 LEADING ZERO? JMP OUTI2 YES! ADA .48 NO, TURN OFF STA TEMP6 ZERO SUPPRESSION JSB OUTCR OUTPUT DIGIT OUTI2 CLB LDA TEMP5 RETRIEVE REMAINDER ISZ TEMP7 SET FOR NEXT DIVISOR ISZ DIGCT ALL DIVISOR USED? JMP OUTI1 NO! ADA .48 YES, OUTPUT JSB OUTCR LAST DIGIT JMP OUTIN,I * .43 DEC 43 .45 DEC 45 .46 DEC 46 .48 DEC 48 .49 DEC 49 .58 DEC 58 E OCT 105 M5 DEC -5 M6 DEC -6 * ****************************** * * * ASCII-TO-BINARY CONVERSION * * * ****************************** NUMCK NOP CHARACTER IN (A), SIGN SETE CLB STB EXP ZERO STB MANT1 ALL STB MANT2 COMPONENTS STB EXPON OF NUMBER STB TEMP3 SET 'NUMBER' FLAG FALSE CCB SET 'DECIMAL POINT' STB DPFLG FLAG FALSE NUMC1 CPA .46 DECIMAL POINT? ISZ DPFLG YES, SET FLAG TRUE JMP NUMC2 NO CLA INITIALIZE POST-DECIMAL DIGIT STA EXPON DIGIT COUNTER TO ZERO JMP NUMC3+1 FETCH A CHARACTER NUMC2 JSB DIGCK DIGIT? JMP NUMC7 NO ISZ EXPON YES, COUNT DIGIT ALF,ALF LEFT-JUSTIFY ALF,RAR DIGIT AND STA TEMP4 SAVE IT JSB MBY10 MULTIPLY PREVIOUS NUMBER BY 10 LDB EXP SZB ZERO EXPONENT? JMP NUMC4 NO LDA .4 YES, SET STA EXP EXPONENT TO 4 LDA TEMP4 LOAD CLB NUMBER NUMC3 JSB NO߷RML NORMALIZE THE NUMBER ISZ TEMP3 SET 'NUMBER OCCURRED' FLAG JSB GETCR ANOTHER CHARACTER? JMP NUM12 NO JMP NUMC1 YES NUMC4 ADB M4 COMPUTE CMB EXPONENT LDA TEMP4 BIAS AND STB TEMP4 SAVE IT CLB NUMC5 ISZ TEMP4 DIGIT POSITIONED? JMP NUMC6 NO CLE YES, ADD IN ADB MANT2 LOW PART CLO OF NUMBER SEZ OVERFLOW? INA YES, BUMP (A) ADA MANT1 ADD IN HIGH PART OF NUMBER SOS OVERFLOW? JMP NUMC3 NO CLE,ERA YES, ROTATE ERB DOWN AND ISZ EXP BUMP NOP EXPONENT JMP NUMC3 NUMC6 CLE,ERA SHIFT ERB DIGIT JMP NUMC5 RIGHT NUMC7 CLB DECIMAL POINT STB TEMP4 CPB TEMP3 OR DIGIT FOUND? JMP NUMCK,I NO, EXIT VIA (P+1) CPA E YES, 'E' ? RSS YES JMP NUM12 NO, NO EXPONENT PART JSB GETCR JMP NUMER CPA .43 '+' ? JMP NUMC8 YES CPA .45 NO, '-' ? CCA,RSS YES JMP NUMC9 NO STA TEMP4 NOTE MINUS SIGN NUMC8 JSB GETCR JMP NUMER NUMC9 JSB DIGCK DIGIT? JMP NUMER NO STA TEMP3 YES, SAVE IT JSB GETCR JMP NUM10 SECOND JSB DIGCK DIGIT? JMP NUM10 NO LDB TEMP3 YES BLS,BLS MULTIPLY ADB TEMP3 PRIOR DIGIT BLS BY 10 ADA 1 ADD NEW DIGIT STA TEMP3 SAVE EXPONENT JSB GETCR JMP NUM10 THIRD JSB DIGCK DIGIT? RSS NO JMP NUMER YES NUM10 LDA TEMP3 LOAD EXPONENT ISZ TEMP4 POSITIVE? CMA,INA YES, COMPLEMENT IT RSS NO NUM12 CLA CLEAR IF NO hEXPONENT PART ISZ DPFLG DECIMAL POINT? ADA EXPON YES, CORRECT EXPONENT SZA,RSS ZERO EXPONENT? JMP NUM14 YES SKP SSA NO, NEGATIVE EXPONENT? JMP NUM13 NO CMA,INA YES, SET STA EXPON COUNTER JSB DBY10 DIVIDE NUMBER BY 10 ISZ EXPON DONE? JMP *-2 NO JMP NUM14 YES NUM13 STA EXPON SET COUNTER JSB MBY10 MULTIPLY BY 10 ISZ EXPON DONE? JMP *-2 NO NUM14 LDA MANT1 YES, LOAD LDB MANT2 NUMBER ISZ SIGN POSITIVE? JMP NUM15 YES CMA NO, CMB,INB,SZB,RSS COMPLEMENT INA IT NUM15 JSB .PACK PACK NUMBER INTO (A) AND (B) EXP BSS 1 EXPONENT ISZ SBPTR STA SBPTR,I STORE ISZ SBPTR NUMBER IN STB SBPTR,I PROPER ISZ SBPTR LOCATION JSB BCKSP FETCH JSB GETCR FIRST LDA .10 UNUSED CHARACTER ISZ NUMCK NUMER ISZ NUMCK RETURN JMP NUMCK,I VIA (P+2) OR (P+3) SKP *************************************** * * * INTEGERIZE FLOATING POINT nUMBER * * * *************************************** * * ENTER WITH A F.P. NUMBER IN (A) AND (B). IF EXPONENT * EXCEEDS 23, NUMBER HAS INTEGER SIGNIFICANCE EXIT TO (P+1) * ALL OTHER CASES EXIT TO (P+2) WITH 32 BIT INTEGER RIGHT * JUSTIFIED IN (A) AND (B). ON EXIT (O) = 1 IF NUMBER IS EXACTLY * REPRESENTABLE AS 16 BIT INTEGER. IF EXPONENT IS NEGATIVE, TRUN- * CATE TO 0 OR -1 APPROPRIATELY AND LET (O) = 1. OTHERWISE RIGHT * JUSTIFY INTEGER AND EXIT WITH LAST BIT LOST IN (E). * IFIX NOP STO SET OVERFLOW FLAG STA MANT1 SAVE (A) CLA OCT 101050 LSR 8, GET EXPONENT ALF,ALF IN (A) AND BLF,BLF MANTGISSA IN (B) SLA,RAR NEGATIVE EXPONENT? IOR SMASK YES, PROPAGATE SIGN SSA EXPONENT NON-NEGATIVE? JMP IFIX3 NO, RETURN 0 OR -1 ADA M16 SSA EXPONENT LESS THAN 16? CLO YES, CLEAR OVERFLOW ADA M8 SSA,RSS EXPONENT LESS THAN 24? JMP IFIX,I NO, ERROR EXIT, NO FRACTION * ADA M8 STA MANT2 SAVE SHIFT COUNT LDA MANT1 RETRIEVE HIGH MANTISSA JMP IFIX2 * IFIX1 CLE,SLA,ARS LONG RIGHT SHIFT CME SLB,ERB STO SET OVERFLOW IF 1 LOST IFIX2 ISZ MANT2 DONE? JMP IFIX1 NO, SHIFT SOME MORE ISZ IFIX DONE, SKIP (P+1) JMP IFIX,I RETURN (P+2) * IFIX3 LDA MANT1 NEGATIVE EXPONENT, RETRIEVE (A) CLE,SSA CCA,RSS TRUNCATE TO -1 OR 0 CLA,RSS CCB,RSS CLB JMP IFIX2+2 SKIP RETURN * SMASK OCT 77600 M16 DEC -16 M8 DEC -8 SKP ********************************************* * * * SUBROUTINE TO COMPUTE THE ENTIER OF A&B * * * ********************************************* * * ENTER WITH NUMBER IN (A) AND (B). IF EXPONENT > 14 THEN * EXIT TO (P+1), ELSE EXIT TO (P+2) WITH THE ENTIER OF THE * ARGUMENT IN (A). * .IENT NOP JSB IFIX JMP .IENT,I OVERFLOW XOR 1 (A) SHOULD BE FULL OF SIGN BITS SSA (B) SHOULD HAVE A SIGN TOO JMP .IENT,I IT DOESNT, ERROR EXIT CPA 1 IF (A) WAS ZERO JMP *+3 ALL IS OK CMA IF (A) WAS -1 CPA 1 ISZ .IENT ALSO OK, SKIP RETURN JMP .IENT,I LEAVE WITH RESULT IN A AND B. SKP ********************* * * * FORMAT AN INTEGER * * * ********************* INTCK NOP CHARACTER IN (A) CLB STORE STB INTGR PARTIAL RESULT INTC1 JSB DIGCK DIGIT? JMP INTC2 NO CLO LDB INTGR MULTIPLY ADB 1 PARTIAL ADB 1 RESULT ADB INTGR BY ADB 1 10 ADB 0 ADD LATEST DIGIT SOC OVERFLOW? JMP INTC3 YES STB INTGR STORE PARTIAL RESULT JSB GETCR NO, FETCH LDA .10 NEXT CHARACTER JMP INTC1 INTC2 LDB INTGR ZERO SZB,RSS INTEGER? JMP INTC3 YES STB SBPTR,I NO, RECORD IT LDB INTCK,I INTEGER LDB 1,I TOO ADB INTGR LARGE? SSB,RSS JMP INTC3 YES LDB INTGR NO, ISZ SBPTR RETURN WITH ISZ INTCK INTEGER IN (B) INTC3 ISZ INTCK SET FOR 'FAIL' RETURN JMP INTCK,I SKP *********************** * * * GET DIGIT TO OUTPUT * * * *********************** GETDG NOP JSB MBY10 MULTIPLY BY 10 LDB EXP GET EXPONENT IN (B) CMB,INB AS NEGATIVE AND HIMSK KEEP 5 HIGH BITS OF (A) RAL NORMALIZE TO BIT 15 SSB,INB ROTATE INTEGER JMP *-2 INTO (A) AND MSK0 EXTRACT STA TEMP5 DIGIT LDB EXP ROTATE CMB,INB RAR BACK SSB,INB JMP *-2 XOR MANT1 REMOVE LDB MANT2 DIGIT JSB NORML NORMALIZE REMAINDER LDA TEMP5 LOAD (A) WITH DIGIT JMP GETDG,I ********************************** * * * MULTIPLY UNPACKED NUMBER BY 10 * * * ********************************** MBY10 NOP LDA MANT1 RETURN ON SZA,RSS ZERO JMP MBY10,I MANTISSA LDB EXP MULTIPLY ADB .3 BY STB EXP 8 LDB MANT2 LOAD MANTISSA CLE,ERA DIVIDE ERB BY CLE,ERA 4 ERB,CLE ADB MANT2 DOUBLE SEZ ADD TO INA PRODUCE ADA MANT1 1.25 * MANTISSA SSA,RSS CORRECT JMP *+5 CLE,ERA ON ERB ISZ EXP OVERFLOW NOP STA MANT1 STB MANT2 JMP MBY10,I SKP ******************************** * * * DIVIDE UNPACKED NUMBER BY 10 * * * ******************************** DBY10 NOP MULTIPLY BY DOUBLE-LENGTH TENTH LDA MANT1 RETURN SZA,RSS ON ZERO JMP DBY10,I MANTISSA LDB M2 ADD EXPONENT OF ADB EXP 'TENTH' TO STB EXP MANTISSA EXPONENT LDA MANT2 JUSTIFY CLE,ERA LOWER NTISSA MPY TENTH MULITPLY BY ONE-TENTH (63416) CLE,ELA SHIFT ELB,CLE BACK ADA 1 ADD IN LOWER MANTISSA* SEZ TENTH*(2)-16 INB AND ROUND STB MANT2 TO 16 BITS LDA MANT1 DO MPY TENTH SAME FOR CLE HIGH ADA 1 MANTISSA ADA MANT2 (EFFECTIVELY) SUM SEZ DOUBLE-LENGTH INB PRODUCTS STB MANT1 EXCHANGE STA 1 (A) AND (B) LDA MANT1 REGISTERS JSB NORML NORMALIZE RESULT JMP DBY10,I * TENTH OCT 63146 HIMSK OCT 174000 ******************************* * * * NORMALIZE (A), (B) AND EXP * * * ******************************* NORML NOP STA TEMP3 SET LEFT-SHIFT CLA COUNTER STA FERR TO ZERO LDA TEMP3 SZA,RSS ON SZB ZERO JMP NORM3 CLEAR STA EXP 4 EVERYTHING STA MANT1 STORE NORM1 STB MANT2 MANTISSA JMP NORML,I AND RETURN NORM2 ISZ FERR COUNT LEFT SHIFTS NORM3 CLE,ELB ROTATE (A) AND ELA (B) LEFT INTO (E) SEZ,SSA,RSS TWO HIGHEST BITS 0? JMP NORM2 YES, + UNNORMALIZED SEZ,SSA NO, TWO HIGHEST BITS 1? JMP NORM2 YES, - UNNORMALIZED ERA SHIFT TO ERB,CLE NORMALIZE MANTISSA STA MANT1 NO, LDA FERR COMPUTE CMA,INA CORRECTED ADA EXP EXPONENT STA EXP VALUE LDA MANT1 JMP NORM1 SKP SPC 3 TEMP1 EQU TEMPS+2 TEMP2 EQU TEMPS+3 TEMP3 EQU TEMPS+4 STEMP EQU TEMPS+4 TEMP4 EQU TEMPS+5 TEMP5 EQU TEMPS+6 TEMP6 EQU TEMPS+7 TEMP7 EQU TEMPS+8 TEMP8 EQU TEMPS+9 TEMP9 EQU TEMPS+10 TEM10 EQU TEMPS+11 FFLAG EQU TEMPT+1 DPFLG EQU TEMPT+2 NMPTR EQU TEMPT+3 DIGCT EQU TEMPT+4 FERR EQU TEMPT+5 FILE ERROR FLAG MANT1 EQU TEMPT+8 MANT2 EQU TEMPT+9 EXPON EQU TEMPT+10 LENTH EQU TEMPT+11 INTGR EQU TEMPT+1 SKP ******************* * * * I/O SUBROUTINES * * * ******************* * * THE FOLLOWING SUBROUTINES ARE PRIMARILY USED BY THE BASIC * MAIN CONTROL FOR DOING I/O. THE INDIVIDUAL SEGMENTS MAY * ALSO CONTAIN SOME SPECIALIZED I/O ROUTINES. * *********************** * * * PRINT A LINE * * * *********************** WRITE NOP ENTRY SSA,RSS IF LENGTH > 0, MAKE CMA,INA NEGATIVE FOR CHARS STA LENTH SAVE IT STB WBUF1 SAVE BUFFER ADDRESS LDA FLFIL .CHECK FOR FILE SAVE-RESTORE INA,SZA,RSS JMP WRFIL .YES- CALL FILE WRITE JSB REIO RE-ENTRANT I/O DEF *+5 DEF .2 TO PRINT DEF LUOUT WBUF1 BSS 1 LINE ON DEF LENTH JMP WRITE,uHFBI TTY * WRFIL JSB FILWR .WRITE INTO A FILE DEF *+3 DEF LENTH .REQUEST LENGTH DEF WBUF1,I .BUFFER ADDRESS * SSB .ERROR ? RSS .YES - CLOSE THE FILE JMP WRITE,I .NO CONTINUE WR1 JSB CLFIL .GO TO CLOSE FILE ROUTINE JMP RDYPT . AND GO HOME * ************************ * * * READ A LINE * * * ************************ REED NOP ENTRY STA LENTH SAVE BUFFER LENGTH STB KBUF1 AND ADDRESS LDA FLFIL .IS THIS A FILE INPUT? INA,SZA,RSS JMP RDFIL .YES READ A RECORD JSB REIO CALL REIO DEF *+5 DEF .1 TO READ A DEF LUINP KBUF1 BSS 1 LINE OF ASCII DEF LENTH STA MANT1 STB LENTH AND .32 END OF SZA TAPE? JMP REED1 .YES SET EOF INDICATOR LDA MANT1 .CHECK FOR EOF STATUS AND B200 SZA .YES EOF SET EOF INDICATOR REED1 LDB M2 YES LDA 1 NO, RETURN WITH JMP REED,I LENGTH IN (A) * RDFIL JSB FILRD . READ A RECORD DEF *+3 DEF LENTH DEF KBUF1,I SSB .AN ERROR ? JMP WR1 .CLOSE FILE - GO HOME CPA M1 .AN EOF ? ADA M1 .YES - SO SET THE FLAG JMP REED,I .1 DEC 1 B200 OCT 200 * * END BASIC 1H Yv 92065-18002 1726 S C0322 &MBC10 RTE-M BASIC SYNTAX SUBR             H0103 6ASMB,R HED <> 92065-16001 NAM BASC1,7 92065-16001 REV.1726 770523 * DATE REV CODE 9-24-76 * * * ************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1975. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * * PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ************************************************************** * * * * SOURCE: 92065-18002 * * * ************************************************************* * * ENT BASC1,QUOTE,DIM EXT PLIST,PEXMK,GETCR,LETCK,DIGCK,INTCK,MVTOH EXT BCKSP,FNDPS,NUMCK,OUTER EXT FCNS,FCNCT,INDCK COM TEMPS(30),PNTRS(61),SPEC(10) **************************************************** * * * SEGMENT #1: CHECK SYNTAX AND TRANSLITERATE * * * **************************************************** * * THIS PART OF THE INTERPRETER IS LOADED BY THE BASIC MAIN CONTROL * WHENEVER A RECORD IS INPUT WITH A NUMBER AS THE FIRST CHAR. IT * WILL CONVERT AN ASCII STATEMENT RECORD INTO THE SPECIAL BINARY * CODE WHICH IS USED BY THE LIST AND EXECUTION SEGMENTS OF THE * INTERPRETER. AFTER EACH STATEMENT IS PROCESSED, EXECUTION IS * RETURNED TO THE MAIN CONTROL PROGRAM. THE GENERAL FORM OF THE * TRANSLITERATED CODE IS SHOWN BELOW: * * WORD #1 - LINE NUMBER * WORD #2 - # WORDS IN TRANSLITERATED STATEMENT * WORD #3 > WORD #N - OPERATORS, CONSTANTS, ETC. SKP *************************** * * * CONSTANTS AND VARIABLES * * * *************************** * FWAM EQU PNTRS FIRST WORD OF AVAILABLE MEMORY LWBM EQU PNTRS+1 LAST WORD OF AVAILABLE MEMORY .INBF EQU PNTRS+2 INPUT BUFFER ADDREtYSS SBUFA EQU PNTRS+3 SYNTAX BUFFER ADDRESS SYMTA EQU PNTRS+4 START OF SYMBOL TABLE SYMTF EQU PNTRS+5 END OF SYMBOL TABLE PBUFF EQU PNTRS+6 FIRST WORD OF USER PROGRAM PBPTR EQU PNTRS+7 LAST WORD+1 OF USER PROGRAM INBFA EQU PNTRS+8 INPUT BUFFER POINTER ICCNT EQU PNTRS+9 INPUT CHARACTER COUNT SBPTR EQU PNTRS+10 SYNTAX BUFFER POINTER .LNUM EQU PNTRS+11 CURRENT LINE # FCORE EQU PNTRS+12 START OF FREE CORE MNNAM EQU PNTRS+13 MNEMONIC TABLE NAME:SC:LU BRNAM EQU PNTRS+18 BRANCH TABLE NAME:SC:LU FWAMM EQU PNTRS+23 POINTER TO START OF MNEMONIC TABLE FWAMB EQU PNTRS+24 POINTER TO START OF BRANCH TABLE .OTBF EQU PNTRS+25 POINTER TO OUTPUT BUFFER OCCNT EQU PNTRS+26 OUTPUT CHARACTER COUNT OTBFA EQU PNTRS+27 POINTER INTO OUTPUT BUFFER LUOUT EQU PNTRS+28 CURRENT OUTPUT L.U. # LUINP EQU PNTRS+29 CURRENT INPUT L.U. # SIGN EQU PNTRS+30 SIGN OF CURRENT NUMBER BLANK EQU PNTRS+31 CURRENT TERMINATION CHAR REC# EQU PNTRS+32 COMMAND FILE RECORD NUMBER FLTYP EQU PNTRS+33 TYPE 0 FILE FLAG TTYPR EQU PNTRS+34 CONSOLE TTY L.U. # PRINT EQU PNTRS+35 LISTING L.U. # READR EQU PNTRS+36 AUXILLIARY INPUT L.U. # PUNCH EQU PNTRS+37 AUXILLIARY OUTPUT L.U. # ERTTY EQU PNTRS+38 ERROR LIST OUTPUT L.U. # DCB EQU PNTRS+39 DATA CONTROL BLOCK ADDRESS FILBK EQU PNTRS+40 FILE CONTROL BLOCK ADDRESS PFLAG EQU PNTRS+41 SAVE,LOAD FILE FLAG LOLIM EQU PNTRS+42 LOW LIMITS OF PROGRAM HILIM EQU PNTRS+43 HIGH LIMITS OF PROGRAM LORUN EQU PNTRS+44 LOW RUN LIMITS HIRUN EQU PNTRS+45 HIGH RUN LIMITS SLSTM EQU PNTRS+46 EXECUTE SLOW STMTS LOTRC EQU PNTRS+47 LOW TRACE LIMITS HITRC EQU PNTRS+48 HIGH TRACE LIMITS BRKP1 EQU PNTRS+49 BREAK POINT #1 BRKP2 EQU PNTRS+50 BREAK POINT #2 BRKP3 EQU PNTRS+51 BREAK POINT #3 BRKP4 EQU PNTRS+52 BREAK POINT #4 SMFLG EQU PNTRS+53 SIMULATE FLAG TYPE EQU PNTRS+54 PARTIAL LINE CHARACTER COUNT DLMTR EQU PNTRS+55 CHAR EDIT DELIMITER MERGF EQU PNTRS+56 MERGE FLAG SKP SUP PRESS MULTIPLE LISTINGS SPC 1 oTEMPT BSS 14 .2 DEC 2 .3 DEC 3 .10 DEC 10 B42 OCT 42 B4000 OCT 4000 LETOP OCT 32000 OPMSK OCT 77000 OPDMK OCT 100777 FRMSK OCT 100757 M1 DEC -1 M2 DEC -2 M3 DEC -3 M9 DEC -9 MNEG OCT 100000 MAXIMUM NEGATIVE FLOATING OCT 376 POINT NUMBER FLGBT EQU MNEG STBAS DEF SYNTB-26,I SKP ********************************** * * * PRINT NAME TABLE FOR OPERATORS * * * ********************************** QUOTE OCT 1000 BITS 15-9 OF THE LABELLED WORD ASC 1," COMMA OCT 2000 ARE THE BASIC CODE OPERATOR ASC 1,, SMCLN OCT 3000 NUMBERS. BITS 3-0 ARE THE ASC 1,; RPARN OCT 4001 OPERATOR'S HIERARCHICAL ASC 1,) RBRAC OCT 5001 PRECEDENCE FOR THOSE OPERATORS ASC 1,] SCMMA OCT 6002 BELONGING TO FORMULAS. THE ASC 1,, ASSOP OCT 7002 UNLABELLED WORD GIVES THE ASC 1,= PLUS OCT 10007 ASCII REPRESENTATION OF THE ASC 1,+ MINUS OCT 11007 SINGLE CHARACTER OPERATORS. ASC 1,- TIMES OCT 12010 ASC 1,* DIV OCT 13010 ASC 1,/ EXPS OCT 14012 ASC 1,^ GTR OCT 15005 ASC 1,> LSS OCT 16005 ASC 1,< UNEQL OCT 17005 ASC 1,# EQUAL OCT 20005 ASC 1,= UNMIN OCT 21011 ASC 1,- LBRAC OCT 22020 ASC 1,[ LPARN OCT 23020 ASC 1,( UPLUS OCT 24011 ASC 1,+ OROP OCT 25003 MSFLG NOP ANDOP OCT 26004 DFLAG NOP NOTOP OCT 27011 PRFLG NOP GTREQ OCT 30005 UFLAG NOP LSSEQ OCT 31005 SKP * DIM OCT 33003 ASC 2,DIM COM OCT 34003 ASC 2,COM DEF OCT 35003 ASC 2,DEF REM OCT 36003 ASC 2,REM IF OCT 40002 ASC 1,IF FOR OCT 41003 ASC 2,FOR NEXT OCT 42004 ASC 2,NEXT END OCT 45003 ASC 2,END DATA OCT 51004 ASC 2,DATA * LET OCT 32003 THESE STATEMENTS MAY FOLLOW AN ASC 2,LET GOTO OCT 37004 'IF' OPERATOR ASC 2,GOTO GOSUB OCT 43005 ASC 3,GOSUB RTRN OCT 44006 ASC 3,RETURN STP OCT 46004 ASC 2,STOP WAIT OCT 47004 ASC 2,WAIT CALL OCT 50004 ASC 2,CALL READ OCT 52004 ASC 2,READ PRNT OCT 53005 ASC 3,PRINT INPUT OCT 54005 ASC 3,INPUT RSTOR OCT 55007 ASC 4,RESTORE PAUSE OCT 56005 ASC 3,PAUSE TRAP OCT 66004 ASC 2,TRAP * FAIL OCT 57005 ASC 3,FAIL: THEN OCT 60004 ASC 2,THEN * USING OCT 61005 ASC 3,USING * TO OCT 75002 ASC 1,TO STEP OCT 76004 ASC 2,STEP OF OCT 77002 ASC 1,OF NOT OCT 27003 ASC 2,NOT AND OCT 26003 ASC 2,AND OR OCT 25002 ASC 1,OR * GTE OCT 30002 ASC 1,>= LTE OCT 31002 ASC 1,<= AUNEQ OCT 17002 ALTERNATE UNEQUAL SIGN ASC 1,<> * LEN OCT 3 ASC 2,LEN #SIGN OCT 73001 ASC 1,# EOF OCT 62003 ASC 3,EOF SKP ************************************* * * * BRANCH TABLE FOR STATEMENT SYNTAX * * * ************************************* SYNTB DEF LETS LET DEF DIMS DIM DEF COMS COM DEF DEFS DEF DEF REMS REM DEF GOTOS GO TO DEF IFS IF DEF FORS FOR DEF NXTS NEXT DEF GOTOS GOSUB DEF ENDS RETURN DEF ENDS END DEF ENDS STOP DEF WAITS WAIT DEF CALLS CALL DEF DATAS DATA DEF READS READ DEF PRINS PRINT DEF INPTS INPUT DEF RSTRS RESTORE DEF PAUS PAUSE DEF SYNE2-1 FAIL DEF SYNE2-1 THEN DEF SYNE2-1 USING NOP SPCECIAL SYNTAX REP 3 NOP .PLACE HOLDERS DEF TRAPS TRAP SPC 1 * #STND DEC -23 # STANDARD OPERATORS IN TABLE  * #PSIF DEC -12 # OPERATORS ALLOWED PAST 'IF' * SKP *********************************** * * * CHECK SYNTAX AND TRANSLITERATE * * * *********************************** BASC1 NOP * * LDA SBPTR,I GET FIRST CHAR IN BUFFER SPC 1 * DETERMINE SEQUENCE NUMBER SPC 1 SYNTX CPA .45 MINUS SIGN(DELETE CURRENT LINE)? JMP DLLIN YES JSB INTCK RECORD DEF MAXSN SEQUENCE NUMBER JMP SYE25 STA TEMP3 SAVE CHAR LDA LOLIM IS SEQUENCE CMA,INA NUMBER >= ADA 1 TO THE SSA LOW LIMIT? JMP PEXMK NO, IGNORE STMT LDA 1 IS SEQUENCE CMA,INA NUMBER <= ADA HILIM TO THE SSA HIGH LIMIT? JMP PEXMK NO, IGNORE STMT STB .LNUM SAVE LINE NUMBER * * LDB FWAMM SET UP INB SEARCH STB SUBS1 POINTERS STB SUBS2 STB SUBS3 STB SUBS4 LDA TEMP3 RECOVER CHAR ISZ SBPTR SAVE SPACE FOR LENGTH WORDR; LDB SBUFA SET INB TEMP TO STB TEMP (SBUFF)+1 SPC 1 * DETERMINE STATEMENT TYPE SPC 1 CPA .10 NULL STATEMENT? JMP DLSTM DELETE STATEMENT! LDB #STND -# OF STANDARD MNEMONICSR JSB TBSRH FIND STATEMENT TYPE DEF DIM START AT TOP OF LIST RSS NO ERROR IF NOT FOUND JMP PSTIF FOUND SUBR LDB FWAMM,I GET MNEM COUNT SZB,RSS .SKIP TABLE SEARCH IF NULL TABLE JMP SS1 JSB TBSRH LOOK IN MNEMONIC TABLE SUBS1 DEF 0 SS1 JMP TRYLT TRY LET STATEMENT PSTIF LDB M9 SET MULTIPLE STORE STB MSFLG TO FALSE LDB PBPTR NULL CPB PBUFF PROGRAM? RSS JMP SYNT1 NO LDB FWAM IN,SURE NO STB PBUFF SPURIOUS COMMON STB PBPTR EXISTS SYNT1 STB TEMPS POINTER CLB SET DEFINE FLAG STB DFLAG TO FALSE STB PRFLG SET PARAMETER FLAG TO FALSE STB FROMF SET FROM FLAG CLEAR STA 1 * SYNT5 LDA FWAMM IS ENTRY IN CMA,INA THE STANDARD BASIC ADA TBLPT STATEMENT TABLE? SSA,RSS NAMED SUBROUTINE? JMP NMSBR YES LSR 9 COMPUTE ADDRESS OF SYNTAX STB SFLAG SET STRING FLAG TO OFF ADB STBAS ROUTINE AND JMP 1,I BRANCH TO IT ** *** TRY IMPLIED LET ** TRYLT LDB M1 SET TO SMALL NEG. NO. STB TBLPT SO TO SKIP NAMED SUB. SYNTAX JSB BCKSP BACK UP TO START FORMULA PROCESSOR LDA LETOP STA SBPTR,I DUB IN "LET" CODE JMP PSTIF SKP ** * *** *** ** LET STATEMENT SYNTAX ** *** *** * LETS LDA SBPTR ENABLE STRING STA SFLAG VARIABLE ISZ MSFLG SET MULTIPLE STORE FLAG ON JSB FSC FETCH FORMULA ISZ SFLAG STRING VARIABLE FOUND? JMP LET1 NO! JSB SYMCK YES, DEMAND ASSIGNMENT OPERATOR! DEF ASSOP-1 JMP SYNE2-1 NO ASSIGNMENT OPERATOR! JSB RSTOP RECORD STRING OPERATOR JSB SNULL RECORD END-OF-FORMULA JMP EOST DEMAND END SPC 1 LET1 ISZ SFLAG DID STORE OCCUR? JSB ERROR NO SYNE2 EQU * * ****************************** * * * CHECK FOR END OF STATEMENT * * * ****************************** EOST CPA .10 END OF STATEMENT? JMP ACTST YES,ACCEPT STATEMENT! NOEOF JSB ERROR CHARACTERS AFTER LEGAL END-OF-STATEMENT ***************************** * * * CALL STATEMENT SYNTAX * * * ***************************** *  * THE CALL SYNTAX CHECK MAKES EXTENSIVE USE OF THE MNEMONIC AND * BRANCH TABLES TO DETERMINE THE CORRECTNESS OF THE SUBROUTINE * CALL AND THE ORDINAL POSITION OF THE SUBROUTINE WITHIN THE * BRANCH TABLE, SO THAT THE EXECUTE SEGMENT OF BASIC CAN COMPUTE * THE ADDRESS OF THE SUBROUTINE. CERTAIN ERRORS CAN BE CAUSED * BY THE INCORRECT USE OF PARAMETERS IN THE CALLING SEQUENCE OF * A SUBROUTINE. BELOW IS A SIMPLE TABLE INDICATING LEGAL PARAMETERS: * * * DIRECTION OF PARAMETER TRANSFER * +---------------------------------------------------+ * ! TYPE OF PARAMETER ! BASIC TO SUB. ! SUB. TO BASIC ! * +---------------------------------------------------! * ! SIMPLE VARIABLE ! LEGAL ! LEGAL ! * +---------------------------------------------------+ * ! CONSTANT ! LEGAL ! ILLEGAL ! * +---------------------------------------------------+ * ! ARRAY VARIABLE ! LEGAL ! LEGAL ! * +---------------------------------------------------+ * ! ARRAY ELEMENT ! LEGAL ! LEGAL ! * +---------------------------------------------------+ * ! STRING VARIABLE ! LEGAL ! LEGAL ! * +---------------------------------------------------+ * ! STRING CONSTANT ! LEGAL ! ILLEGAL ! * +---------------------------------------------------+ * ! EXPRESION ! LEGAL ! ILLEGAL ! * +---------------------------------------------------+ * * * * THE MNEMONIC TABLE CONTAINS THE ASCII NAME OF THE SUBROUTINE, * THE NUMBER OF CHARACTERS IN THE SUBROUTINE, AND THE NUMBER OF * PARAMETERS IN THE SUBROUTINE CALLING SEQUENCE. THE FORMAT OF * EACH ENTRY IS SHOWN BELOW. * * * 15 0 * +-------------------------------+ * !F! ! ! ! ! ! ! !P!P!P!P!C!C!C!C! * +-------------------------------+ * ! 1ST CHARACTER ! 2ND CHARACTER ! * +-------------------------------+ * ! 3RD CHARACTER ! ETC. ! * +-------------------------------+ * * WHERE : * F = 1 IF FUNCTION * F = 0 IS SUBROUTINE * PPPP = NUMBER OF PARAMTERS * CCCC = NUMBER OF CHARACTERS IN NAME * * * THE BRANCH TABLE CONTAINS INFORMATION REGARDING THE ADDRESS * OF THE SUBROUTINE, PARAMETER CONVERSION (REAL TO INTEGER OR * INTEGER TO REAL), TYPE OF PARAMETER, AND DIRECTION THAT THE * PARAMETER IS REUIRED TO GO ( BASIC TO SUBROUTINE OR SUBROUTINE * TO BASIC). * * * 15 0 * +-------------------------------+ * !D!D!D!D!D!P!P!P!P!P!S!S!S!S!S!S! ADDRESS * +-------------------------------+ * !X!A!A!A!A!A!A!A!A!A!A!A!A!A!A!A! ARRAY * +-------------------------------+ * !X!T!T!T!T!T!T!T!T!T!T!T!T!T!T!T! TO FROM * +-------------------------------+ * !F!I!I!I!I!I!I!Y!I!I!I!I!I!I!I!I! CONVERSION * +-------------------------------+ * * * WHERE: * DDDDD = IDENTIFICATION LETTER * PPPPP = OVERLAY NUMBER * SSSSSS = SUBROUTINE NUMBER WITHIN OVERLAY * A = 1 IF ARRAY, 0 IF NON-ARRAY * T = 1 IF FROM SUBROUTINE, 0 IF TO SUBROUTINE * F = 1 IF INTEGER FUNCTION * F = 0 IF REAL FUNCTION * I = 1 IF CONVERSION TO INTEGER REQUIRED * I = 0 IF NO CONVERSION REQUIRED * X = BIT POSITION NOT USED * * * CALLS JSB GETCR FETCH AND JMP NOEOF RECORD LDB FWAMM,I GET MNEM COUNT SZB,RSS JMP SS2 .IF NULL TABLE SKIP TABLE SEARCH JSB TBSRH LOOK FOR SUBROUTINE NAME USUBS2 DEF 0 SS2 JSB ERROR NOT FOUND CALER JMP PSTIF DO POST-IF STATEMENT * ** *** NAMED SUBROUTINE SYNTAX (NO 'CALL' PREFIX) ** NMSBR CLA SET TO STA TEMP7 INDICATE SUBROUTINE * GET FIRST WORD OF MNEMONIC TBL ENTRY LDA PRPTR,I IS THIS SSA REALLY A SUBROUTINE? JSB ERROR NO! SYNE3 EQU * FUNCT STA TEMP6 SAVE PARAMETER WORD RRR 4 COUNT AND .15 FROM CMA BEING DESTROYED STA PCNT BY FSC CMA SAVE COUNT LSL 9 LEFT JUSTIFY STA TEMP3 FOR INTERP. CODE LDA FWAMM,I COMPUTE OFFSET IN MNEMONIC TBL CMA,INA ADA COUNT AND SAVE IT FOR LATER STA TCCNT THIS ORDINAL POSITION OF SUB. ENTRY LDB TEMP6 FORTRAN SSB FUNCTION? JMP CALL1 YES! ADA B5000 NO, ADD IN CALL OP CODE CALL4 STA SBPTR,I STORE IN INTERP. CODE ISZ SBPTR UPDATE INTERP. CODE PTR. LDA COMMA COMMA CODE STA SBPTR,I STUFF IT (WIPE OUT LEFT PAREN) ISZ PCNT ANY PARAMETERS REQUIRED? JMP NAMSB YES LDB B4000 FUDGE A RIGHT PAREN STB SBPTR,I LDA TEMP7 DID WE PROCESS A AND OPDMK FORTRAN CPA FRMSK FUNCTION JMP FSC10+1 YES! JSB GETCR FETCH NEXT CHARACTER LDA .10 ISZ SBPTR JMP CALL5 * CALL1 ADA TEMP3 STUFF IN JMP CALL4 PARM COUNT INSTEAD OF B50000 * * CALL2 CCB JSB SYMCK COMMA? DEF COMMA-1 JMP CALL3 NO ISZ PCNT YES, MORE PARAMS REQUIRED? JMP PRMCK YES, LOOK FOR PARAMETER. SYE11 JSB ERROR WRONG NUMBER OF PARAMS. * * PROCESS SUBROUTINE AND FUNCTION PARAMETERS * NAMSB LDA TCCNT GET ORDINAL NUMBER ALS,ALS AND MULTIPLY BY 4 ADA .2 AND ADD 2 TO GET ADA FWAMB POSITION IN BRANCH TBL THEN LDA 0,I GET THE TO/FROM PARAMETER WORD STA TOFRM SAVE FOR CHECKING EACH PARAMETER PRMCK LDA TOFRM GET TO/FROM WORD CCB SLA,RSS IS IT SET? CLB NO! THEN SET THE FLAG TO 0 STB FROMF YES! THEN SET IT NON-ZERO ARS SHIFT TO STA TOFRM FOR NEXT PARAMETER JSB GETCR GET THE FIRST PARAMETER CHARACTER LDA .10 CPA B42 IS IT A STRING LITERAL? JMP CALL6 YES! JSB LETCK IS IT A LETTER? JSB PERR NO, CHECK FOR PARAMETER ERROR JSB BCKSP NO, PUT CHAR BACK JSB FRCUR SAVE VARIABLES LDA SBPTR SET TO STA SFLAG ALLOW STRING VARIABLES JSB FSC FETCH CLB CLEAR STB FROMF TO/FROM FLAG ISZ SFLAG STRING? RSS NO! JMP CALL7 YES! CALL8 JSB FPOP RESTORE VARIABLES JMP CALL2 PARAMETER FORMULA * CALL3 ISZ PCNT ALL PARAMETERS PRESENT? JMP SYE11 NO JSB RPCK YES, FETCH RIGHT PARENTHESIS STA 1 SAVE CHARACTER LDA TEMP7 FORTRAN AND OPDMK FUNCTION CPA FRMSK BEING PROCESSED? JMP FSC19 YES, COMPLETE SYNTAX CHECK LDA 1 RESTORE CHARACTER * CALL5 CCB JSB TBSRH IS CALL FOLLOWED BY "FAIL:"? DEF FAIL JMP EOST JSB GETCR YES. ANALYZE REST OF STMT. JMP NOEOF ISZ SBPTR JMP FAILS * CALL6 JSB PERR CHECK FOR PARAMETER ERROR ISZ SBPTR POINT AT PLACE TO PUT " OPERATOR CCB JSB SYMCK PUT IN " OPERATOR DEF QUOTE-1 NOP LDA B42 SPECIFY STRING TERMINATOR JSB CHRST PUT STRING IN INTERP CODE JSB SNULL ADD NULL AFTER STRING CONSTANT JSB GETCR FETCH NEXT CHARACTER LDA .10 JMP CALL2 * CALL7 JSB SNULL PUT NULL AFTER STRING D CCB STB SFLAG RESET SFLAG JMP CALL8 * * * A CHECK IS MADE HERE TO SEE IF THE SUBROUTINE PARAMETER * (A STRING LITERAL, CONSTANT OR EXPRESSION) IS BEING * RETURNED FROM A SUBROUTINE AS INDICATED BY THE BRANCH TABLE * PERR NOP LDB FROMF FLAG SZB,RSS SET? JMP PERR,I NO! CPA .41 RIGHT PAREN? JMP PERR,I YES, OK THEN! CPA B135 RIGHT BRACKET? JMP PERR,I YES, OK CPA B54 COMMA? JMP PERR,I YES, OK THEN! CLA CLEAR STA FROMF FROM FLAG JSB ERROR NO, ILLEGAL PARAMETER SYE16 EQU * B5000 OCT 50000 .15 DEC 15 .41 DEC 41 B54 OCT 54 B135 OCT 135 SKP * ******************** * * * TRAP STATEMENT * * * ******************** * TRAPS CCB SET FOR STB CCODE NEG SEQ NUMBER CASE JSB FSC FETCH TRAP # FORMULA CPA .10 END-OF-STATEMENT? JMP SYNE6-1 YES CCB GET JSB TBSRH GOSUB SYNTAX DEF GOSUB JSB ERROR NOT FOUND SYNE6 JSB GETCR CHECK NOP FOR (-) SIGN CPA .45 IS IT? JMP TRAP1 YES! JSB BCKSP GET BACK TO LAST CHAR TRAP2 CCB SET FOR STB RFLAG ERROR RETURN HERE JSB PRGIN GET SEQUENCE NUMBER DEF MAXSN RSS GOOD RETURN JSB CKZER IS NUMBER=0? JSB BCKUP BACK UP TO SEQ NUMBER LDB SBPTR,I NEGATE ISZ CCODE SEQUENCE NUMBER CMB,INB STB SBPTR,I IF NECESSARY ISZ SBPTR RESET PTR JMP EOST END-OF-STATEMENT PROCESSING * TRAP1 CLB SET FOR STB CCODE (-) FOUND JMP TRAP2 * CKZER NOP IF SZB B=0 JMP SYE25 THEN STORE STB SBPTR,I IT IN INTERP. ISZ SBPTR ELSE PRINT JM8HFBP CKZER,I ERROR MESSAGE * SKP * ************************ * * * DIM STATEMENT SYNTAX * * * ************************ DIMS ISZ DFLAG SET DFLAG TO TRUE LDA SBPTR ENABLE STRING STA SFLAG VARIABLE JSB ARRYS CHECK AN ARRAY JMP ACTST DONE JMP DIMS+1 WAS A COMMA, CONTINUE ************************ * * * COM STATEMENT SYNTAX * * * ************************ COMS CLB SET ARRAY POINTER STB TEMPS+7 INITIALLY TO ZERO ISZ SBPTR SAVE SPACE FOR ISZ SBPTR COMMON SIZE WORD STB SBPTR,I INSERT NULL ISZ DFLAG SET DEFINE FLAG TO TRUE COMS1 CCA SET COMMON FLAG STA PRFLG TO TRUE LDA SBPTR ENABLE STA SFLAG STRING VARIABLES JSB ARRYS CHECK AN ARRAY RSS DONE JMP COMS1 MORE ARRAYS LDB SBUFA CALCULATE WHERE ADB .3 COMMMON SIZE GOES LDA TEMPS+7 RECORD COMMON STA 1,I SIZE JMP ACTST EXIT * SKP H************************ * * * DEF STATEMENT SYNTAX * * * ************************ DEFS JSB LTR JMP SYNE4 FIRST LDA TEMP1 ALF,ALF TWO CHARACTERS IOR TEMP2 CPA FN 'FN'? RSS YES JMP SYNE4 NO JSB LTR LETTER FOLLOWS? SYNE4 JSB ERROR NO LDA TEMP1 YES, RECORD A LDB .58 FUNCTION JSB STROP NAME LDA TEMP2 RETRIEVE CHARACTER JSB LPCK LEFT PARENTHESIS? IOR FLGBT YES, SET FORMAL STA SBPTR,I PARAMETER BIT JSB VAROP FETCH SIMPLE VARIABLE NOP NONE FOUND JSB ERROR SUBSCRIPTED VARIABLE FOUND SYNE5 JSB RPCK RECORD A RIGHT PARENTHESIS CCB ASSIGNMENT JSB SYMCK DEF ASSOP-1 OPERATOR? JMP SYNE2-1 NO LDA M2 YES, ADA SBPTR RETRIEVE LDA 0,I PARAMETER AND MSK1 AND STA PRFLG SAVE IT JSB FSC FETCH DEFINING FORMULA JMP EOST END-OF-STATEMENT TEST * .58 DEC 58 B200 OCT 200 MSK1 OCT 777 FN ASC 1,FN * * ************************ * * * REM STATEMENT SYNTAX * * * ************************ REMS LDA B200 DUMMY STRING TERMINATOR JSB CHRST FETCH CHARACTER STRING JMP ACTST *********************** * * * IF STATEMENT SYNTAX * * * *********************** IFS ISZ SBPTR FETCH JSB GETCR NEXT CHARACTER JMP SYNE7-1 ILLEGAL IF STMT STA SBPTR,I FOUND, SAVE IT CCB LOOK JSB TBSRH FOR 'EOF' DEF EOF JMP IF0 NONE FOUND JSB LUCHK .LOOK FOR THE LU # JSB ERROR .NO PROPER LU # FOUND SYE27 JMP *-1 JMP IFS2 .LU FOUND LOOK FOR THEN XX IF0 JSB BCKSP RESTORE b JSB BCKUP AS WAS ON ENTRY STB SFLAG ENABLE STRING FORMULA JSB FSC GET DECISION FORMULA ISZ SFLAG STRING? JMP FAILS NO! STA TEMP1 YES,SAVE NEXT CHAR LDB M3 MULTI-CHARACTER JSB TBSRH OPERATOR DEF GTE PRESENT? RSS NO! JMP STER4 YES, PUT IT AWAY LDA TEMP1 CHAR IN (A) LDB M4 SEARCH 4 OPERATORS JSB SYMCK SINGLE CHAR REL OPERATOR DEF GTR-1 PRESENT? JSB ERROR ILLEGAL REL OPERATOR STER4 JSB RSTOP STORE STRING JSB SNULL SET END-OF-FORMULA FAILS CCB LOOK FOR JSB TBSRH 'THEN' DEF THEN JMP IFS1 NOT FOUND IFS3 CLB FOUND, GET STATEMENT JMP GOTO0 LABEL NUMBER IFS1 LDB #PSIF FOR FOLLOWING JSB TBSRH OPERATOR DEF LET RSS JMP PSTIF FOUND, GO CHECK SYNTAX LDB FWAMM,I FOR FOLLOWING SZB,RSS .SKIP TABLE SEARCH IF NULL TABLE JMP SS3 JSB TBSRH NAMED SUBROUTINE SUBS3 DEF 0 SS3 JSB ERROR NOT FOUND SYNE7 JMP PSTIF FOUND, GO CHECK SYNTAX * IFS2 CCB .LOOK FOR 'THEN' JSB TBSRH DEF THEN JMP SYNE7-1 .NOT FOUND (ONLY THEN LEGAL AFTER END) JMP IFS3 .GET GOTO SYNTAX M4 DEC -4 MAXSN DEC -10000 * * *********************************** * * * GOTO AND GOSUB STATEMENT SYNTAX * * * *********************************** GOTOS LDA INBFA SAVE CURRENT STA TEMP6 BUFFER POINTER LDA ICCNT AND COUNTER STA TEMP7 CCB SET 'PRGIN' FOR RETURN GOTO0 STB RFLAG ON ERROR JSB PRGIN FETCH SEQUENCE DEF MAXSN NUMBER JMP GOTO2 FOUND END-OF-STATEMENT? GOTO3 JSB BCKUP BACK UP SYNTAX POINTER LDB TEMP6 RESTORE CURRENT  STB INBFA BUFFER POINTER LDB TEMP7 AND COUNTER STB ICCNT LDA SBPTR,I ERASE AND OPMSK 'INTEGER FOLLOWS' STA SBPTR,I FLAG JSB FSC FETCH FORMULA CPA .10 END-OF-STATEMENT? JMP SYNE8-1 YES CCB THE 'OF' JSB TBSRH DEF OF JSB ERROR MISSING SYNE8 CLB SET 'PRGIN' FOR EXIT STB RFLAG ON ERROR GOTO1 JSB PRGIN FETCH SEQUENCE DEF MAXSN NUMBER CCB JSB SYMCK COMMA NEXT? DEF COMMA-1 JMP EOST NO, END-OF-STATEMENT? JMP GOTO1 YES GOTO2 CPA .10 END-OF-STATEMENT? JMP EOST YES JSB BCKUP NO, MUST JMP GOTO3 BE A FORMULA SKP ************************ * * * FOR STATEMENT SYNTAX * * * ************************ FORS JSB VAROP FETCH SIMPLE VARIABLE NOP NONE FOUND JMP SYNE5-1 SUBSCRIPTED VARIABLE FOUND CCB JSB SYMCK ASSIGNMENT DEF ASSOP-1 OPERATOR? JMP SYNE2-1 NO JSB FSC YES, FETCH INITIAL VALUE FORMULA CCB THE JSB TBSRH 'TO' DEF TO JSB ERROR MISSING SYNE9 JSB FSC GET LIMIT FORMULA CPA .10 END-OF-STATEMENT? JMP ACTST YES JSB BCKUP NO, ERASE ZERO WORD CCB FOR JSB TBSRH THE 'STEP' DEF STEP JSB ERROR MISSING SYE10 JSB FSC GET STEP SIZE FORMULA JMP EOST END-OF-STATEMENT TEST ************************* * * * NEXT STATEMENT SYNTAX * * * ************************* NXTS JSB VAROP FETCH SIMPLE VARIABLE NOP NONE FOUND JMP SYNE5-1 SUBSCRIPTED VARIABLE FOUND JMP EOST END-OF-STATEMENT TEST ****************************************************~** * * * END, STOP, RESTORE, RETURN, PAUSE STATEMENT SYNTAX * * * ****************************************************** ENDS ISZ SBPTR JSB GETCR END-OF-STATEMENT? JMP ACTST YES JMP NOEOF NO ************************* * * * WAIT STATEMENT SYNTAX * * * ************************* WAITS CLB DISALLOW STRINGS STB SFLAG JSB GETCR GET FIRST CHAR JMP FSCE1 NO PAREN ERROR ISZ SBPTR JSB LPCK FETCH LEFT PAREN JSB FSC FETCH FORMULA JSB RPCK FETCH RIGHT PAREN JMP EOST END-OF-STATEMENT TEST SKP * ********************* * * * PAUSE STATEMENT * * * ********************* * PAUS CLB DISALLOW STB SFLAG STRINGS ISZ SBPTR JSB GETCR GET FIRST CHAR JMP ACTST IF NO PARAMETER IT'S OK JSB LPCK FETCH LEFT PAREN JSB GETCR GET FIRST CHAR OF PARAMETER JMP SYE25 BAD! CLB SET STB SIGN SIGN POSITIVE JSB NUMCK NUMBER? JMP SYE25 NO! JMP SYE25 NO! JSB NUMOP FIX UP PRECEDING OPERATOR JSB RPCK FETCH LEFT PAREN JMP EOST *********************** * * * RESTORE STATEMENT * * * *********************** * RSTRS JSB GETCR END OF STMT? JMP RSTR1 YES! JSB BCKSP NO,DEMAND JSB PRGIN SEQUENCE NUMBER DEF MAXSN JMP EOST DEMAND END-OF-STATEMENT RSTR1 ISZ SBPTR RECORD DUMMY OPERAND JMP ACTST ACCEPT STATEMENT * ************************* * * * DATA STATEMENT SYNTAX * * * ************************* DATAS CLA STA SIGN CLEAR SIGN  JSB GETCR JSB ERROR END-OF-INPUT CONDITION SYE12 CLB,INB SET SIGN CPA .43 '+' ? JMP DATA4 YES CCB CPA .45 NO, '-' ? JMP DATA4 YES DATA1 JSB NUMCK NO, NUMBER? JMP DATA3 NO JSB ERROR BAD EXPONENT NUMER JSB NUMOP FIX UP PRECEDING OPERATOR DATA2 CCB CHECK JSB SYMCK FOR A DEF COMMA-1 COMMA JMP EOST END-OF-STATEMENT TEST JMP DATAS FETCH ANOTHER NUMBER DATA3 CPB SIGN SIGN FOUND? (B)=0 RSS NO! JSB ERROR YES,SOLITARY SIGN SYE26 ISZ SBPTR DEMAND A JSB GETST STRING CONSTANT JMP DATA2 DATA4 STB SIGN RECORD SIGN JSB GETCR JMP EOST END-OF-INPUT CONDITION JMP DATA1 * .43 DEC 43 .45 DEC 45 * ******************* * * *LU CHECK * * * ******************* LUCHK NOP ISZ SBPTR .BUMP TO NEXT CHARACTER JSB GETCR . AND FETCH IT JMP LUCHK,I .END OF FILE RETURN ISZ LUCHK CCB JSB SYMCK .A "#"? DEF UNEQL-1 JMP LUCHK,I .NO - NOT A SPECIFIED LU ISZ LUCHK .YES CHECK FOR JSB FSC . LU VARIABLE OR CONSTANT JMP LUCHK,I .EXIT - VALID LU * ************************** * * * READ STATEMENT SYNTAX * * * ************************** READS JSB LUCHK .AN LU READ ? JMP SYE13-1 .MUST HAVE ARGUMENTS JMP READ1 .NO ! TRY INTERNAL READ CCB JSB SYMCK DEF SMCLN-1 JMP SYE13-1 .MUST HAVE SEMICOLON JMP INPTS .FETCH ARGUMENT LIST READ1 JSB BCKSP .RESTORE POINTERS JSB BCKUP * ************************** * * * INPUT STATEMENT SYNTAX * * * ************************** INPTS LDB SBPTR ENABLE STRING STB SFLAG VARIABLE JSB VAROP RECORD VARIABLE OPERAND JSB ERROR MISSING SYE13 NOP CCB CHECK JSB SYMCK FOR A DEF COMMA-1 COMMA RSS JMP INPTS IS, FETCH NEXT ITEM JSB SNULL APPEND END-OF-FORMULA JMP EOST END OF STATEMENT TEST * ************************************ * * * PRINT STATEMENT SYNTAX CHECKER * * * ************************************ * * * PRINT USING CODE GOES HERE SOMEDAY * PRINS JSB LUCHK .A #,LU PRINT? JMP ACTST .END OF RECORD - DONE JMP PRIN5 .NOT A #LU PRINT CCB .LOOK FOR A SEMICOLON JSB SYMCK DEF SMCLN-1 JMP ACTST .NONE FOUND NULL PRINT JMP PRIN0 .YES - LU SPECIFIED PRIN5 JSB BCKUP .NO - CRT/CONSOLE JSB BCKSP .RESTORE POINTERS PRIN0 ISZ SBPTR ADVANCE SYNTAX PTR JSB GETCR MORE STATEMENT? JMP ACTST NO! CCB YES, ENABLE STB TEMP,I FORMULA AND TAB CPA B42 QUOTE? RSS YES! JMP PRIN3 NO! PRIN1 JSB GETST RECORD A STRING CONSTANT ISZ SBPTR CPA .10 END-OF-STATEMENT? JMP ACTST YES! CCB NO! STB TEMP,I PRIN2 CPA B42 QUOTE? JMP PRIN1 YES! LDB M2 NO! JSB SYMCK COMMA OR DEF COMMA-1 SEMICOLON? RSS NO! JMP PRIN0 YES! JSB SNULL ZERO NEXT WORD PRIN3 ISZ TEMP,I FORMULA OR TAB PERMITTED? SYE15 JSB ERROR NO! STA SBPTR,I NO! PRIN4 JSB BCKSP BACKUP JSB BCKUP POINTERS STB SFLAG ENABLE STRING VARIABLE JSB FSC RECORD FORMULA CCB WAS THIS A CPB SFLAG STRING VARIABLE JSB SNULL YES, OUTPUT A NULL WORD CPA .10 END-OF-STATEMENT? RSS YES! JMP PRIN2  NO! JSB SNULL SET END-OF-FORMULA JMP ACTST ACCEPT STATEMENT SPC 3 *************************** * * * OUTPUT A NULL WORD * * * *************************** * SNULL NOP CLB STB SBPTR,I STORE 0 IN INTERPRETIVE ISZ SBPTR BUFFER AREA JMP SNULL,I SKP SKP ************************** * * * FORMULA SYNTAX CHECKER * * * ************************** FSC NOP CLA SET LEFT PARENTHESIS STA TEMPS,I COUNT TO ZERO FSC1 CCA SET UNARY FLAG STA UFLAG TO TRUE STA TEMP5 SET LEN FLAG OFF SPC 1 * PROCESS VARIABLE OPERAND SPC 1 FSC2 JSB VAROP LOOK FOR VARIABLE OPERAND JMP FSC9 NOT FOUND JMP FSC13 SUBSCRIPTED OR STRING VARIABLE FOUND JSB PERR CHECK FOR PARAMETER ERROR JSB LETCK FOLLOWED BY LETTER? JMP FSC6 NO LDB M2 YES, LOOK FOR JSB MCBCK 'AND' OR 'OR' LDA TEMP1 NOT FOUND, FETCH PREVIOUS ALF,ALF CHARACTER AND LEFT-JUSTIFY IT IOR TEMP2 ADD LATEST CHARACTER CPA FN 'FN'? JMP FSC4 YES JSB BCKSP GO BACK ONE SPACE LDA TEMP1 CCB JSB TBSRH IS THIS DEF LEN A LENGTH FUNCTION? RSS NO! JMP FSC15 YES! LDB FCNCT IS FUNCTION IN MNEMONIC TABLE? LDA TEMP1 A = CHARACTER JSB TBSRH FUNCTION DEF FCNS JMP FSC16 NOT FOUND LDA FCNCT FOUND FUNCTION SO COMPUTE OFFSET IN CMA,INA TABLE ADA COUNT FSC18 ALF IOR FLGBT ADD FLAG BIT JMP FSC5 FSC16 LDB FWAMM,I GET TABLE LENGTH SZB,RSS .SKIP TABLE SEARCH IF NULL TABLE JMP SS4 JSB TBSRH IS THERE SUBS4 DEF 0 FORTRAN FUNCTION SS4 JMP FSC3 NO! n? LDA FRMSK YES, CODE OCT 36 CCB INDICATES ADB SBPTR A FORTRAN FUNCTION STA TEMP1 SAVE IT LDA 1,I RETRIEVE PREVIOUS AND OPMSK OPERATOR IOR TEMP1 AND COMBINE WITH FUNCTION STA 1,I FUNCTION STA TEMP7 SET TEMP7 AS FORTRAN FNCT FLAG LDA PRPTR,I IS IT REALLY SSA,RSS A FORTRAN FUNCTION? JSB ERROR NO! SYNE1 EQU * JMP FUNCT YES,CHECK SYNTAX OF IT FSC3 ISZ UFLAG 'NOT' PERMITTED? JMP FSC8-2 NO CCB SEARCH FOR JSB TBSRH 'NOT' DEF NOT JMP FSC8-2 'NOT' NOT FOUND CCB RETRIEVE ADB SBPTR PREVIOUS WORD LDA 1,I WORD AND OPMSK SET TO STA 1,I NULL OPERAND JMP FSC14 SPC 1 * LEN FUNCTION FOUND? SPC 1 FSC15 CLA SET LEN FLAG! STA TEMP5 LDA B37 LEN OP CODE IS FIXED JMP FSC18 AT OCT 37 SPC 1 * PROCESS USER-DEFINED FUNCTIONS (FNA, FNB, ...) SPC 1 FSC4 JSB GETCR IDENTIFYING JMP SYNE4 FUNCTION JSB LETCK LETTER? ?q JMP SYNE4 NO ADA D100 YES, ALF ASSEMBLE AND FSC5 ADA .15 SAVE STA TEMP1 FUNCTION IDENTIFIER CCB RETRIEVE ADB SBPTR PREVIOUS LDA 1,I PROGRAM WORD AND OPMSK EXTRACT OPERATOR, IOR TEMP1 APPEND OPERAND, STA 1,I AND RECORD ISZ TEMP5 IS "LEN" FLAG SET? JMP FSC17 YES! JSB GETCR LEFT PARENTHESIS FSCE1 JSB ERROR OR JSB LPCK LEFT BRACKET? JSB FRCUR YES, SAVE LOCAL VARIABLES OF FSC JSB FSC FETCH ACTUAL PARAMETER JSB FPOP RESTORE LOCAL VARIABLES OF FSC JSB RPCK FETCH RIGHT PARENTHESIS JMP FSC10+1 FSC7 LDB M2 CHECK FOR Jd JSB SYMCK RIGHT PARENTHESIS DEF RPARN-1 OR RIGHT BRACKET JMP FSC8 NOT FOUND LDA B4000 RECORD A STA SBPTR,I RIGHT PARENTHESIS LDA .41 RESTORE RIGHT PARENTHESIS CCB MATCHING ADB TEMPS,I LEFT SSB PARENTHESIS? JMP FSC8 NO STB TEMPS,I YES ISZ SBPTR JSB GETCR FETCH LDA .10 FSC6 CPA .10 END OF FORMULA? JMP FSC8 YES STA UFLAG NO, SET UNARY FLAG TO FALSE LDB M5 SEARCH FOR A MULTICHARACTER JSB MCBCK BINARY OPERATOR LDB MSFLG SEARCH JSB SYMCK FOR A DEF PLUS-1 BINARY OPERATOR CCB,RSS NOT FOUND JMP FSCM FOUND JSB SYMCK DEF ASSOP-1 OPERATOR? JMP FSC7 NO LDA M2 STA SFLAG YES, SET JMP FSC1 'STORE OCCURRED' FLAG JSB GETCR RETRIEVE LETTER LDA .10 FSC8 LDB TEMPS,I ALL LEFT PARENTHESES S\ SZB MATCHED? FSCE2 JSB ERROR NO STB SBPTR,I YES, RECORD AN ISZ SBPTR END-OF-FORMULA AND CCB JMP FSC,I EXIT WITH CHARACTER IN (A) SPC 1 * PROCESS "LEN" FUNCTION FOR STRING ARGUMENT SPC 1 FSC17 JSB GETCR RECORD JMP FSCE1 LEFT JSB LPCK PARENTHESIS JSB LTR LETTER NEXT? JSB ERROR NO, PARAMETER NOT STRING! STER2 CPA B44 YES, FOLLOEWED BY "$"? RSS YES! JMP STER2-1 NO, PARAMETER NOT STRING! LDA TEMP1 RECORD LDB B53 STRING JSB STROP VARAIABLE CLA PLACE NULL STA SBPTR,I AFTER PARAMETER ISZ SBPTR JSB GETCR RECORD JMP FSCE2 RIGHT JSB RPCK PARENTHESIS JMP FSC10+1 SPC 1 * PROCESS CONSTANT OPERAND SPC 1 FSC9 CLB SET SIGN POSITIVE STB SIGN JS4VB NUMCK NUMBER? JMP FSC11 NO, TRY FOR LEFT PAREN JMP NUMER-1 JMP FSC10 FOUND IT! FSC19 LDA 1 RESTORE CHARACTER LDB M2 SET STORE STB SFLAG OCCURRED FLAG RSS FSC10 JSB NUMOP YES, FIX UP PRECEDING OPPERATOR LDB M9 UPDATE STB MSFLG MULTIPLE STORE FALG JMP FSC6 FSC11 CPA .40 LEFT JMP FSC12 PARENTHESIS CPA B133 OR LEFT BRACKET? JMP FSC12 YES ISZ UFLAG NO! SPC 1 * PROCESS UNARY OPERATORS SPC 1 FSCE3 JSB ERROR NO LDB UNMNC CPA .43 '+'? JMP *+4 YES CPA .45 NO, '-'? JMP *+3 YES JMP FSCE3 NO ADB B3000 STORE ISZ SBPTR UNARY STB SBPTR,I OPERATOR FSC14 LDB M9 UPDATE STB MSFLG MULTIPLE STORE FLAG JMP FSC2 FLAG SPC 1 FSC12 ISZ SBPTR IS LPAR, LDA LPARN RECORD IT AND OPMSK AND ISZ TEMPS,I COUNT IT STA SBPTR,I FSCM LDB M9 ENTER ON MULTICHAR OPR STB MSFLG UP DATE MULTIPLE STORE FLAG JMP FSC1 SPC 1 FSC13 CCB STRING VARIABLE CPB SFLAG FOUND? JMP FSC,I YES! JMP FSC6 NO! SKP ********************************************** * * * CHECK FOR A MULTICHARACTER BINARY OPERATOR * * * ********************************************** MCBCK NOP JSB TBSRH OR 'OR' DEF AND JMP MCBCK,I NOT FOUND JMP FSCM FOUND ******************************** * * * RESTORE FSC LOCAL QUANTITIES * * * ******************************** FPOP NOP STA TEMP1 SAVE CHARACTER LDB TEMPS ADB M7 STB TEMPS RESTORE S-STACK TOP INB VLDA 1,I STA MSFLG RESTORE MULTIPLE STORE FLAG INB LDA 1,I RESTORE STA PCNT PARAMETER COUNT INB LDA 1,I RESTORE FORTRAN STA TEMP7 FUNCTION FLAG INB LDA 1,I STA UFLAG RESTORE UNARY OPERATOR FLAG INB LDA 1,I STA FSC RESTORE FSC RETURN ADDRESSS INB LDA 1,I RESTORE STA VAROP VAROP RETURN ADDRESS ISZ SFLAG RESTORE SFLAG VALUE NOP LDA TEMP1 RETRIEVE CHARACTER JMP FPOP,I ***************************** * * * SAVE FSC LOCAL QUANTITIES * * * ***************************** FRCUR NOP LDB TEMPS FETCH CURRENT S-STACK POINTER INB UPDATE IT LDA MSFLG DUMP MULTIPLE STORE STA 1,I FLAG ON S-STACK INB LDA PCNT SAVE STA 1,I PARAMETER COUNT INB LDA TEMP7 SAVE FORTRAN STA 1,I FUNCTION FLAG INB LDA UFLAG STACK UNARY OPERATOR STA 1,I FLAG INB LDA FSC STACK FSC STA 1,I RETURN ADDRESS LDA VAROP STACK VAROP RETURN ADDRESS JSB SSOV AND CHECK FOR S-STACK OVERFLOWO CCA ADA SFLAG DISABLE SFLAG VALUE STA SFLAG JMP FRCUR,I * .40 DEC 40 B37 OCT 37 B44 OCT 44 B53 OCT 53 B133 OCT 133 B3000 OCT 3000 UNMNC OCT 21000 M5 DEC -5 M7 DEC -7 M16 DEC -16 D100 OCT -100 SKP ********************************************** * * * PUT ITEM ON S-STACK AND CHECK FOR OVERFLOW * * * ********************************************** SSOV NOP STORE QUANTITY INB ADVANCE S-STACK POINTER STA 1,I SAVE ITEM IN (A) INB ADVANCE S-STACK POINTER STB ͼTEMPS AND RECORD IT CMB,INB ADB LWBM LAST WORD SSB EXCEEDED? FSCE4 JSB ERROR YES JMP SSOV,I **************************** * * * CHECK FOR SUBSCRIPT PART * * * **************************** SBSCK NOP CHARACTER IN (A) CLB CLEAR CALL SYNTAX STB FROMF TO-FROM FLAG LDB M2 LEFT BRACKET JSB SYMCK OR DEF LBRAC-1 LEFT PARENTHESIS? JMP SBSCK,I NO, RETURN VIA (P+1) ISZ SBSCK YES, SET RETURN TO (P+2) LDA ARYAD,I SET AND M16 ARRAY INA TO STA ARYAD,I SINGLE SUBSCRIPT LDA B2200 RECORD A STA SBPTR,I LEFT BRACKET CLB DIM OR COM CPB DFLAG STATEMENT? JMP SBSC3 NO CLB SET 'PRGIN' FOR STB RFLAG EXIT ON ERROR JSB PRGIN FETCH INTEGER DEF M256 SUBSCRIPT BOUND BLF,BLF SAVE STB TEMP1 BOUND LDB SFLAG STRING CPB M1 VARIABLE? JMP SBSC1 YES! CCB IS THE JSB SYMCK NEXT CHARACTER DEF SCMMA-1 A COMMA? JMP SBSC1 NO ISZ ARYAD,I YES, NOTE SECOND SUBSCRIPT JSB PRGIN FETCH SECOND DEF M256 INTEGER SUBSCRIPT BOUND RSS SBSC1 CLB,INB SET ONE-DIMENSIONAL CASE ISZ PRFLG COM STATEMENT? JMP SBSC2 NO STA TEMP2 SAVE CHARACTER LDA 1 IOR TEMP1 RETRIEVE FIRST BOUND JSB MDIM FIND STORAGE NEED ISZ SFLAG STRING RSS VARIABLE? JMP SBSC4 YES! SBSC5 ADA TEMPS+7 UPDATE COM STA TEMPS+7 STORAGE POINTER LDA TEMP2 RETRIEVE NEXT CHARACTER SBSC2 LDB M2 RIGHT PARENTHESIS JSB SYMCK OR DEF RPARN-1 RIGHT BRACKET? JMP FSCE2 NO LDA LF hNLHYES, RECORD A STA SBPTR,I RIGHT BRACKET ISZ SBPTR ADJUST S-BUFFER POINTER JSB GETCR FETCH FOLLOWING LDA .10 CHARACTER LDB DFLAG DIM OR COM SZB STATEMENT? JMP SBSCK,I YES JSB FPOP RESTORE FSC LOCAL VARIABLES LDB M2 RESTORE ADB TEMPS S-STACK STB TEMPS POINTER INB FETCH LDB 1,I RETURN ADDRESS JMP 1,I AND EXIT SBSC3 LDA SBSCK SAVE LDB TEMPS RETURN ADDRESS JSB SSOV ON S-STACK JSB FRCUR SAVE FSC LOCAL VARIABLES LDB M9 SET MULTIPLE STORE FLAG STB MSFLG TO FALSE LDA ARYAD SAVE LDB TEMPS OPERAND JSB SSOV ADDRESS JSB FSC GET SUBSCRIPT FORMULA JSB BCKUP ERASE ZERO WORD LDB M2 RESTORE ADB TEMPS S-STACK STB TEMPS POINTER INB RESTORE LDB 1,I OPERAND STB ARYAD ADDRESS CCB IS THE JSB SYMCK NEXT CHARACTER DEF SCMMA-1 A COMMA? JMP SBSC2 NO ISZ ARYAD,I YES, NOTE SECOND SUBSCRIPT JSB FSC GET SUBSCRIPT FORMULA JSB BCKUP ERASE ZERO WORD JMP SBSC2 SBSC4 ARS ADJUST SIZE INA OF COMMON ARS TO EQUAL INA SPACE FOR CHARS JMP SBSC5 PLUS SPACE FOR SIZE * LF OCT 5000 B2200 OCT 22000 M32 DEC -32 M256 DEC -256 SKP N******************************************* * * * TABLE SEARCH FOR MULTICHARACTER SYMBOLS * * * ******************************************* TBSRH NOP STA SBPTR,I LDA TBSRH,I JSB INDCK PEEL OFF INDIRECTS ISZ TBSRH STA TABLE STORE TABLE ADDRESS STB LNGTH STORE -(NUMBER OF ENTRIES) LDA INBFA SAVE STA TEMP3 INPUT LDA ICCNT BUFFER STA TEMP4 STATUS LDA SBPTR INITIALIZE END-OF-SYMBOL STA SMEND POINTER CLA,INA COUNT FIRST CHARACTER OF STA SLENG SYMBOL LDA SBPTR,I FETCH PARTIAL SYMBOL ALF,ALF LEFT-JUSTIFY IOR .32 FIRST CHARACTER AND STA SBPTR,I APPEND BLANK TSRC1 JSB GETCR FETCH NEXT CHARACTER JMP TSRC9 END-OF-STATEMENT LDB SLENG CHECK FOR CPB .8 IMPOSSIBLE LENGTH JMP TSRC9 SLB EVEN-NUMBERED CHARACTER? JMP TSRC2 YES ISZ SMEND NO, FETCH FRESH WORD, ALF,ALF LEFT-JUSTIFY CHARACTER, IOR .32 APPEND BLANK, JMP TSR10 TSRC2 ADA M32 DELETE BLANK, ADA SMEND,I FILL SECOND CHARACTER, TSR10 STA SMEND,I AND STORE ISZ SLENG COUNT IT LDB LNGTH INITIALIZE TABLE LENGTH STB COUNT COUNTER LDA TABLE TSRC3 STA TBLPT SET TABLE POINTER STA PRPTR PTR AND SAVE IT LDA TBLPT,I EXTRACT SYMBOL LENGTH AND .7 FROM TABLE AND COMPARE CPA SLENG WITH CURRENT SYMBOL JMP TSRC5 EQUAL? TSRC4 ADA .3 DIFFERENT, ARS UPDATE ADA TBLPT TABLE POINTER ISZ COUNT MORE ENTRIES? JMP TSRC3 YES JMP TSRC1 NO * SKP TSRC5 LDB TBLPT SET POINTER TO STB TSPTR TABLE SYMBOL LDB SBPTR + SET (B) TO INPUT JMP TSRC7 SYMBOL POINTER TSRC6 CPB SMEND ALL OF SYMBOL CONSIDERED? JMP TSRC8 YES, MATCH OCCURRED INB NO, INCREMENT TSRC7 ISZ TSPTR SYMBOL POINTERS LDA TSPTR,I FETCH WORD FROM TABLE CPA 1,I MATCH WITH INPUT SYMBOL? JMP TSRC6 YES LDA SLENG NO, WRONG JMP TSRC4 SYMBOL TSRC8 LDA TBLPT,I EXTRACT AND OPMSK SYMBOL CODE STA SBPTR,I ISZ TBSRH AND RETURN VIA JMP TBSRH,I 'SUCCESS' EXIT TSRC9 LDA TEMP3 RESTORE STA INBFA INPUT LDA TEMP4 BUFFER STA ICCNT STATUS LDA SBPTR,I GET ORIGINAL CHAR ALF,ALF POSITION IT AND MSK0 ISOLATE IT JMP TBSRH,I 'FAILURE' EXIT * .7 DEC 7 .8 DEC 8 .32 DEC 32 ************************************* * * * CHECK SYNTAX OF ARRAY DEFINITIONS * * * ************************************* ARRYS NOP JSB ARRID FETCH ARRAY IDENTIFIER JSB SBSCK RECORD A SUBSCRIPT JSB ERROR MISSING SUBSCRIPT SYE20 CPA .10 END-OF-STATEMENT? JMP ARRYS,I YES, RETURN VIA (P+1) CCB NO, JSB SYMCK MUST BE DEF COMMA-1 A COMMA JMP NOEOF ISN'T ISZ ARRYS IS, RETURN JMP ARRYS,I VIA (P+2) ************************** * * * FETCH ARRAY IDENTIFIER * * * ************************** ARRID NOP JSB LTR FETCH LETTER JMP SYE20-1 NONE FOUND CPA B44 $ ? JMP ARRE1 YES ARRE2 LDA SBPTR NO,SAVE STA ARYAD OPERAND ADDRES LDA TEMP1 RECORD LDB .46 ARRAY JSB STROP IDENTIFIER LDA TEMP2 RETRIEVE FOLLOWING CHARACTER JMP ARRID,I ARRE1 LDA SFLAG STRING VARIABLE CPA SBHPTR PERMITTED CCA,RSS YES! JSB ERROR STRING NOT PERMMITED STER5 STA SFLAG SET FLAG TO 'STRING OCCURRED' LDA TEMP1 RECORD LDB B53 STRING JSB STROP VARIABLE LDA TEMPS SET PTR TO DUMMY LOCATION STA ARYAD JSB GETCR FETCH NEXT CHAR LDA .10 JMP ARRID,I * .46 DEC 46 .47 DEC 47 .48 DEC 48 ****************************** * * * CHECK FOR VARIABLE OPERAND * * * ****************************** VAROP NOP JSB LTR LETTER? JMP VAROP,I NO, EXIT VIA (P+1) ISZ VAROP CPA .40 LEFT PARENTHESIS? JMP VARO5 YES CPA B44 DOLLAR SIGN? JMP VARO6 YES, STRING VARAIBLE! CPA B133 NO, LEFT BRACKET? JMP VARO5 YES ISZ VAROP NO JSB DIGCK DIGIT? JMP VARO1 NO LDA TEMP1 YES, RETRIEVE LETTER, ADB .48 AND RESTORE ASCII DIGIT STB TEMP1 JSB STROP RECORD VARIABLE JSB GETCR FETCH FOLLOWING LDA .10 CHARACTER JMP VARO2 VARO1 LDA TEMP1 RETRIEVE LETTER, LDB .47 SET 'NO DIGIT', JSB STROP AND RECORD VARIABLE LDA TEMP2 RETRIEVE FOLLOWING CHARACTER VARO2 STA TEMP2 SAVE CHARACTER CLB INSIDE A CPB PRFLG DEF STATEMENT? JMP VAROP,I NO, EXIT VIA (P+3) CCB ADB SBPTR RETRIEVE LDA 1,I AND MSK1 OPERAND CPA PRFLG MATCH PARAMETER? JMP VARO4 YES VARO3 LDA TEMP2 NO, RETRIEVE JMP VAROP,I CHARACTER AND EXIT VIA (P+3) VARO4 LDA 1,I SET OPERAND TO IOR FLGBT ACTUAL PARAMETER STA 1,I AND RECORD IT JMP VARO3 VARO5 LDA SBPTR SAVE STA ARYAD OPERAND ADDRESS LDA TEMP1 RETRIEVE LETTER LDB .46 RECORD JSB STROP 6 ARRAY IDENTIFIER LDA B133 RETRIEVE LEFT BRACKET VARO7 JSB SBSCK FETCH SUBSCRIPT NOP JMP VAROP,I EXIT VIA (P+2) SPC 1 VARO6 LDA SFLAG STRING VARIABLE PERMITTED CPA SBPTR CCA,RSS YES! JSB ERROR NO, ILLEGAL STRING VARIABLE! STER1 STA SFLAG SET SFLAG TO 'STRING OCCURRED' LDA TEMP1 RECORD STRING VARIABLE LDB B53 JSB STROP LDA TEMPS SET POINTER TO DUMMY STA ARYAD LOCATION JSB GETCR GET LDA .10 NEXT CHARACTER JMP VARO7 FETCH SUBSCRIPT SKP ****************** * * * FETCH A LETTER * * * ****************** LTR NOP JSB GETCR LDA .10 JSB LETCK LETTER? JMP LTR,I NO, EXIT VIA (P+1) ISZ LTR YES, STA TEMP1 SAVE IT JSB GETCR NEXT CHARACTER LDA .10 TO (A) STA TEMP2 SAVE SECOND CHARACTER JMP LTR,I EXIT VIA (P+2) ************************* * * * STORE AN OPERAND NAME * * * ************************* STROP NOP LETTER IN (A), NUMBER IN (B) ADA D100 NUMERICALLY ADJUST THE ADB D53 OPERAND NAME ALF COMBINE THE IOR 1 TWO PARTS IOR SBPTR,I COMPLETE OPERAND-OPERATOR PAIR STA SBPTR,I AND STORE IT ISZ SBPTR UPDATE S-BUFFER POINTER JMP STROP,I ****************************** * * * CHECK FOR LEFT PARENTHESIS * * * ****************************** LPCK NOP CHARACTER IN (A) LDB M2 LEFT PARENTHESIS JSB SYMCK OR DEF LBRAC-1 LEFT BRACKET? JMP FSCE1 NO LDA B2300 YES, RECORD A STA SBPTR,I LEFT PARENTHESIS JMP LPCK,I EXIT * B2300 OCT 23000 D53 OCT -53 ************************** *  * * BACK UP SYNTAX POINTER * * * ************************** BCKUP NOP CCB DECREMENT ADB SBPTR SYNTAX POINTER STB SBPTR BY 1 JMP BCKUP,I SKP ******************************* * * * CHECK FOR RIGHT PARENTHESIS * * * ******************************* RPCK NOP LDB M2 RIGHT PARENTHESIS JSB SYMCK OR DEF RPARN-1 RIGHT BRACKET? ? JMP FSCE2 NO LDA B4000 YES, RECORD A STA SBPTR,I RIGHT PARENTHESIS ISZ SBPTR UPDATE SYNTAX BUFFER POINTER JSB GETCR FETCH LDA .10 FOLLOWING CHARACTER JMP RPCK,I * ************************* * * * RECORD STRING FORMULA * * * ************************* * * DEMAND A STRING VARIABLE OR A STRING CONSTANT. EXIT TO * ERROR IF NEITHER IS FOUND, ELSE EXIT WITH THE NEXT CHAR- * ACTER IN (A). * RSTOP NOP LDA SBPTR SEEK STA SFLAG STRING JSB VAROP OPERAND JMP RSTO1 FIRST CHARACTER NOT LETTER ISZ SFLAG STRING VARIABLE? JMP STER1-1 NO STRING FOUND! JMP RSTOP,I SPC 1 RSTO1 ISZ SBPTR JSB GETST DEMAND STRING CONSTANT JMP RSTOP,I SKP *************************** * * * FETCH A STRING CONSTANT * * * *************************** * * EXIT TO ERROR IF (A) # " UPON ENTRY. ELSE SAVE CURRENT PTR * AND PACK INPUT STRING INTO BUFFER WORD. EXIT TO ERROR IF NO * CLOSING " IS FOUND. RECORD OPENING " ALONG WITH COUNT OF * THE STRING CHARS AND EXIT WITH THE NEXT CHARACTER IN (A). * EXIT TO ERROR IF STRING EXCEEDS 255 CHARACTERS. * GETST NOP LDB SBPTR SAVE SYNTAX BUF PTR STB ARYAD CCB LOOK FOR JSB SYMCK QUOTE AND RECORD DEF QUOTE-1 OPERAT3OR JMP STER1-1 NO STRING FOUND! LDA B42 SET QUOTE AS TERMINATOR JSB CHRST RECORD STRING CONSTANT LDA ARYAD,I CHECK FOR ADA M1400 TOO MANY CHARACTERS SSA,RSS JSB ERROR YES! STER3 JSB GETCR NO,FETCH NEXT CHAR LDA .10 END-OF-STATEMENT JMP GETST,I * M1400 OCT 176400 SKP *************************************** * * * FLAG OPERATOR WHICH PRECEDES NUMBER * * * *************************************** NUMOP NOP STA TEMP4 LDB M3 FETCH ADB SBPTR PRECEDING LDA 1,I OPERATOR IOR FLGBT ADD FLAG BIT STA 1,I REPLACE OPERATOR LDA TEMP4 JMP NUMOP,I ************************************ * * * FETCH AND RECORD PROGRAM INTEGER * * * ************************************ PRGIN NOP LDA SBPTR,I SET IOR FLGBT 'INTEGER ADA .3 FOLLOWS' STA SBPTR,I OPERAND LDA PRGIN,I GIVE ADDRESS STA PRGI1 TO INTCK ISZ SBPTR ISZ PRGIN JSB GETCR JMP PRGI2 JSB INTCK FETCH PRGI1 NOP RSS JMP PRGIN,I RETURN VIA P+2 PRGI2 ISZ RFLAG RETURN ON ERROR? JMP PRGI3 .CHECK FOR DIM ERROR ISZ PRGIN YES JMP PRGIN,I RETURN VIA P+3 * PRGI3 CLB CPB DFLAG .DIM STATEMENT? SYE25 JSB ERROR JMP STER3-1 .YES **************************** * * * PROCESS CHARACTER STRING * * * **************************** CHRST NOP STA TEMP2 REM SENDS US (A)=B200 LDB SBPTR SAVE PTR TO CHAR COUNT WORD STB TEMP9 SZA IF A=0 SUPPRESS BLANKS STB BLANK ANYTHING GOES ON INPUT JSB GETCR FIRST CHAR CAN EVEN BE TERMINATOR ? JMP CHRS5 NO MORE CHARS CPA TEMP2 TERMINATOR? JMP CHRS3 YES! CHRS1 ISZ TEMP9,I INCREMENT CHAR COUNT ALF,ALF ISZ SBPTR STA SBPTR,I STORE IN LEFT HALF OF WORD JSB CHRS2 GET A CHARACTER BUT NOT TERMINATOR ISZ TEMP9,I INCREMENT CHAR COUNT IOR SBPTR,I STA SBPTR,I STORE RIGHT HALF IN WORD JSB CHRS2 GET A CHARACTER BUT NOT TERMINATOR JMP CHRS1 SPC 1 CHRS2 NOP JSB GETCR GET NEXT CHARACTER JMP CHRS5 NO MORE CHARACTERS CPA TEMP2 TERMINATOR CHARCTER? CHRS3 CLA,RSS YES! JMP CHRS2,I ISZ SBPTR STA SBPTR,I NULL OPERATOR FOLLOWS STRING LDA .32 STA BLANK BEGIN IGNORING BLANKS AGAIN JMP CHRST,I SPC 1 CHRS5 JSB BCKSP IN CASE WE NEED TO SENSE THIS LATER LDA TEMP2 CPA B200 ARE WE DOING A REM JMP CHRS3 YES, ALL OK! SZA,RSS DOING A FILES STMT? JMP CHRS3 YES! LDA .32 RESTORE BLANK STA BLANK DELIMITER JSB ERROR NO, MISSING TERMINATOR SYE14 EQU * * ******************** * * * DELETE STATEMENT * * * ******************** DLLIN LDA .LNUM GET CURRENT LINE # RSS AND DELETE IT DLSTM LDA SBUFA,I LOAD SEQUENCE NUMBER JSB FNDPS FIND STATEMENT TO BE DELETED JMP PEXMK DOESN'T JMP PEXMK EXIST CLA ZERO WORD SKIP FOR DESTINATION STB LOLIM INB ADDRESS OF SOURCE WORD SKIP IN B JSB CLPRG CLOSE UP PROGRAM LDA LOLIM,I SET UP STA .LNUM TO INA JSB FNDPS LIST NOP NEXT NOP STB HILIM STATEMENT JMP PLIST SKP ******************** * * * ACCEPT STATEMENT * * * ******************** ACTST LDA SBUFA COMPUTE CMA,INA  LENGTH ADA SBPTR OF STATEMENT STA TEMP,I AND RECORD IT LDA SBUFA,I LOAD SEQUENCE NUMBER JSB FNDPS SEARCH ON SEQUENCE NUMBER JMP ACCS1 APPEND STATEMENT TO PROGRAM JMP ACCS4 INSERT STATEMENT IN PROGRAM INB REPLACE STATEMENT IN PROGRAM LDA MERGF IS MERGE SSA FLAG SET? JMP PEXMK YES, DON'T OVERLAY OLD STMT LDA 1,I COMPARE LENGTHS OF CMA,INA STATEMENT BEING REPLACED ADA TEMP,I AND STATEMENT SZA,RSS REPLACING IT JMP ACCS2 EQUAL SSA,RSS JMP ACCS4+1 SHORTER LDA TEMP,I LONGER, JSB CLPRG CLOSE UP PROGRAM JMP ACCS2 ACCS1 LDA TEMP,I LOAD PROGRAM SPACE REQUIREMENT JSB OVCHK SUFFICIENT PROGRAM SPACE LEFT? ACCS2 CLB YES, SET COUNTER TO ZERO LDA SBUFA INITIALIZE STA TEMP2 SOURCE ADDRESS ACCS3 LDA TEMP2,I TRANSFER WORD FROM STA TEMP3,I S-BUFFER TO PROGRAM SPACE ISZ TEMP2 INCREMENT SOURCE AND ISZ TEMP3 DESTINATION ADDRESSES INB BUMP COUNTER CPB TEMP,I ENTIRE STATEMENT MOVED? JMP ACCS5 YES JMP ACCS3 NO ACCS4 LDA TEMP,I LOAD PROGRAM SPACE REQUIREMENT JSB OVCHK SUFFICIENT PROGRAM SPACE LEFT? JSB MVTOH MAKE JMP ACCS2 ROOM * ACCS5 LDA .INBF MOVE LDB .OTBF STATEMENT JSB MVW TO DEC 36 OUTPUT NOP BUFFER LDA TEMP8 FOR CHAR CMA EDITTING STA OCCNT JMP PEXMK EXIT THIS PHASE *************************** * * * DELETE SPACE IN PROGRAM * * * *************************** CLPRG NOP REFERENCE LOCATION IN TEMP3 ADA TEMP3 SKIP (A) LOCATIONS FROM TEMP3 STA TEMP4 AND SAVE DESTINATION ADDRESS LDB 1,I SKIP TO END OF STATEMENT BEING ADB TEMP3 DELETED, SOURCE ADDRESS IN (B) CLPR1 CPB PBPTR ALL OF PROGRAM MOVED? JMP CLPR2 YES LDA 1,I NO, MOVE WORD FROM SOURCE TO STA TEMP4,I DESTINATION ADDRESS ISZ TEMP4 INCREMENT DESTINATION ADDRESS INB INCREMENT SOURCE ADDRESS JMP CLPR1 CLPR2 LDA TEMP4 SET END-OF-PROGRAM STA PBPTR POINTER JMP CLPRG,I ************************************ * * * CHECK FOR PROGRAM SPACE OVERFLOW * * * ************************************ OVCHK NOP NEW WORD REQUIREMENT IN (A) LDB PBPTR SET SOURCE ADDRESS STB TEMP2 FOR PROGRAM RELOCATION ADB 0 SET DESTINATION STB TEMP4 ADDRESS CMB,INB ENOUGH ADB LWBM FREE SSB SPACE? JMP FSCE4 NO, PROGRAM SPACE OVERFLOW LDB TEMP4 YES, RELOCATE FREE STB PBPTR PROGRAM SPACE POINTER JMP OVCHK,I * * * * MOVE WORDS ROUTINE * * CALLING SEQ IS: A=SOURCE ADDRESS * B=DESTINATION ADDRESS * * (P) JSB MVW * (P+1) COUNT OF WORDS * (P+2) NOP * (P+3) RETURN HERE * MVW NOP STA TEMP4 SAVE SOURCE ADDRS LDA MVW,I GET COUNT CMA,INA AND USE ISZ MVW AS COUNTER STA MVW,I FOR MOVE MVW1 LDA TEMP4,I GET WORD STA 1,I PUT AWAY ISZ TEMP4 INCREMENT SOURCE ADDR INB INCREMENT DESTINATION ADDR ISZ MVW,I INCREMENT COUNTER, DONE? JMP MVW1 NO, NOT YET ISZ MVW YES JMP MVW,I SKP *********************** * * * PRINT ERROR MESSAGE * * * *********************** ERROR NOP LDA MERGF IF FLAG IS SSA,RSS SET THEN CHECK FOR = LINE #'S JMP ERRO1 NOT SET * LDA .LNUM YES, SEARCH JSB FNDPS PROGRAM TO SEE NOP THERE IS ALREADY RSS A STMT WITH THIS LINE NUMBER JMP PEXMK FOUND ONE, IGNORE ERROR THEN * ERRO1 LDB ERROR ERROR SOURCE IN (B) LDA ERBS ERROR ADDRESS IN (A) INA MOVE TO NEXT ERROR CPB 0,I SAME AS ACTUAL ERROR? CMA,INA,RSS YES, MAKE ERROR NEGATIVE JMP *-3 NO ADA ERBS MAKE ERROR POSITIVE CMA,INA STA TEMP3 SAVE IT JMP OUTER PRINT ERROR MESSAGE * ERBS DEF ERR-1 *************** * * * ERROR TABLE * * * *************** ERR DEF NUMER ILLEGAL EXPONENT DEF SYNE1 NOT A FORTRAN FUNCTION DEF SYNE2 MISSING ASSIGNMENT OPERATOR DEF SYNE3 NOT A SUBROUTINE CALL DEF SYNE4+1 MISSING OR BAD FUNCTION NAME DEF SYNE5 MISSING OR BAD SIMPLE VARIABLE DEF SYNE6 MISSING OR BAD TRAP NUMBER DEF SYNE7 MISSING OR ILLEGAL 'THEN' DEF SYNE8 MISSING OR ILLEGAL 'OF' DEF SYNE9 MISSING OR ILLEGAL 'TO' DEF SYE10 MISSING OR ILLEGAL 'STEP' DEF CALER MISSING OR ILLEGAL SUBROUTINE DEF SYE11+1 WRONG NUMBER OF PARAMETERS DEF SYE12 MISSING OR ILLEGAL DATA ITEM DEF SYE13 ILLEGAL READ OR INPUT VARIABLE DEF SYE14 NO CLOSING QUOTE DEF SYE15+1 MISSING OR BAD LIST DELIMITER DEF SYE16 ILLEGAL PARAMETER DEF STER1 ILLEGAL STRING VARIABLE DEF STER2 PARAMETER NOT STRING DEF SYE20 MISSING OR ILLEGAL SUBSCRIPT DEF STER3 STRING OR DIM LARGER THAN 255 DEF STER4 ILLEGAL STRING RELATIONAL OPERATOR DEF STER5 STRING NOT PERMMITED DEF FSCE1+1 MISSING LEFT PARENTHESIS DEF FSCE2+1 MISSING RIGHT PARENTHESIS S DEF FSCE3+1 UNDECIPHERABLE OPERAND DEF ARRE2 MISSING OR BAD ARRAY IDENTIFIER DEF SYE25+1 MISSING OR BAD INTEGER DEF SYE26 SIGN WITHOUT NUMBER DEF NOEOF+1 CHARACTERS AFTER STATEMENT END DEF FSCE4+1 OUT OF CORE DURING SYNTAX DEF MER9 ARRAY TOO LARGE SKP ****************************************** * * * FIND AND STORE ONE-CHARACTER OPERATORS * * * ****************************************** SYMCK NOP CHARACTER IN (A) STB COUNT -(ENTRIES TO BE SEARCHED) ALF,ALF POSITION IOR .32 CHARACTER LDB SYMCK,I STARTING TABLE ENTRY - 2 ISZ SYMCK SET RETURN ADDRESS SYMC1 ADB .2 UPDATE TABLE POINTER CPA 1,I MATCH? JMP SYMC2 ISZ COUNT NO, CONTINUE SEARCH? JMP SYMC1 YES ALF,ALF NO, RESTORE AND B177 CHARACTER JMP SYMCK,I AND EXIT SYMC2 CCA GET ADA 1 INFORMATION LDA 0,I WORD AND OPMSK AND STA SBPTR,I STORE IT CPA B1400 JMP FSC14 ISZ SYMCK RETURN VIA JMP SYMCK,I (P+2) * B177 OCT 177 MSK0 OCT 377 B1400 OCT 14000 SKP **************************** * * * COMPUTE STORAGE OF ARRAY * * * **************************** MDIM NOP STA 1 STORE PACKED DIMS. TEMPORALILY AND MSK0 STA COUNT STORE # COLUMNS LDA 1 ALF,ALF AND MSK0 A = # OF ROWS ALS DOUBLE FOR FLOATING POINT MPY COUNT COMPUTE 2*ROWS*COLUMS SSA RESULT < 32768 ? JSB ERROR NO, ERROR DIMENSIONS TOO LARGE MER9 JMP MDIM,I YES, RETURN * TEMP EQU TEMPS+1 TEMP1 EQU TEMPS+2 TEMP2 EQU TEMPS+3 TEMP3 EQU TEMPS+4 TEMP4 EQU TEMPS+5 TEMP5 EQU TEMPS+6 TEMPHFB6 EQU TEMPS+7 TEMP7 EQU TEMPS+8 TEMP8 EQU TEMPS+9 TEMP9 EQU TEMPS+10 PCNT EQU TEMPS+11 COUNT EQU TEMPT+1 SFLAG EQU TEMPT+2 CCODE EQU TEMPT+2 ARYAD EQU TEMPT+3 RFLAG EQU TEMPT+4 TABLE EQU TEMPT+4 SMEND EQU TEMPT+5 SLENG EQU TEMPT+6 TBLPT EQU TEMPT+7 TSPTR EQU TEMPT+8 LNGTH EQU TEMPT+9 PRPTR EQU TEMPT+10 PARAMETER PTR TCCNT EQU TEMPT+11 ORDINAL NUMBER OF SUBROUTINE FROMF EQU TEMPT+12 FROM SUB. PARAMETER FLAG TOFRM EQU TEMPT+13 TO/FROM WORD * END TH \+ 92065-18003 1726 S C0222 &MBC20 RTE-M BASIC LISTER SUBR             H0102 ASMB,R HED <> 92065-16001 NAM BASC2,7 92065-16001 REV.1726 770512 * * DATE 5-12-77 * * ************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977 . ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * * PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ******************************************** ****************** * * * * SOURCE: 92065-18003 * * * ************************************************************* * ENT BASC2 EXT EXEC,RDYPT,FNDPS,OUTCR,OUTIN,INTCK,INDCK EXT WRITE,ERRPT,NUMOT,GETCR,FCNS EXT QUOTE,DIM,MESGA,CLFIL EXT IFBRK,FINDV,PRMT COM TEMPS(30),PNTRS(61),SPEC(10) ************************************** * * * SEGMENT #2: LIST THE PROGRAM * * * ************************************** * * THIS PART OF THE INTERPRETER IS LOADED BY THE BASIC MAIN CONTROL * WHENEVER THE 'LIST' OR 'SAVE' COMMANDS ARE GIVEN. IT WILL RE- * CONSTRUCT A USER PROGRAM, LINE BY LINE, CONVERTING IT FROM THE * TRANSLITERATED FORM TO ASCII. IT THEN OUTPUTS THIS ASCII TO * THE LIST DEVICE. * * IN ADDITION, THIS SEGMENT IS LOADED WHENEVER AN ERROR OCCURS. IT * WILL PRINT OUT THE APPROPRIATE ERROR MESSAGE AND THEN RETURN * EXECUTION TO THE MAIN CONTROL PROGRAM. SKP *************************** * * * CONSTANTS AND VARIABLES * * * *************************** * FWAM EQU PNTRS FIRST WORD OF AVAILABLE MEMORY LWBM EQU PNTR S+1 LAST WORD OF AVAILABLE MEMORY .INBF EQU PNTRS+2 INPUT BUFFER ADDRESS SBUFA EQU PNTRS+3 SYNTAX BUFFER ADDRESS SYMTA EQU PNTRS+4 START OF SYMBOL TABLE SYMTF EQU PNTRS+5 END OF SYMBOL TABLE PBUFF EQU PNTRS+6 FIRST tWORD OF USER PROGRAM PBPTR EQU PNTRS+7 LAST WORD+1 OF USER PROGRAM INBFA EQU PNTRS+8 INPUT BUFFER POINTER ICCNT EQU PNTRS+9 INPUT CHARACTER COUNT SBPTR EQU PNTRS+10 SYNTAX BUFFER POINTER .LNUM EQU PNTRS+11 CURRENT LINE # FCORE EQU PNTRS+12 START OF FREE CORE MNNAM EQU PNTRS+13 MNEMONIC TABLE NAME:SC:LU BRNAM EQU PNTRS+18 BRANCH TABLE NAME:SC:LU FWAMM EQU PNTRS+23 POINTER TO START OF MNEMONIC TABLE FWAMB EQU PNTRS+24 POINTER TO START OF BRANCH TABLE .OTBF EQU PNTRS+25 POINTER TO OUTPUT BUFFER OC CNT EQU PNTRS+26 OUTPUT CHARACTER COUNT OTBFA EQU PNTRS+27 POINTER INTO OUTPUT BUFFER LUOUT EQU PNTRS+28 CURRENT OUTPUT L.U. # LUINP EQU PNTRS+29 CURRENT INPUT L.U. # SIGN EQU PNTRS+30 SIGN OF CURRENT NUMBER BLANK EQU PNTRS+31 CURRENT TERMINAT ION CHAR REC# EQU PNTRS+32 COMMAND FILE RECORD NUMBER FLTYP EQU PNTRS+33 TYPE 0 FILE FLAG TTYPR EQU PNTRS+34 CONSOLE TTY L.U. # PRINT EQU PNTRS+35 LISTING L.U. # READR EQU PNTRS+36 AUXILLIARY INPUT L.U. # PUNCH EQU PNTRS+37 AUXILLIARY OUTPUT L.U. # ERTTY EQU PNTRS+38 ERROR LIST OUTPUT L.U. # FLFIL EQU PNTRS+39 FILE FLAG SAVFL EQU PNTRS+40 .SAVE COMMAND FLAG ADDRESS PFLAG EQU PNTRS+41 SAVE,LOAD FILE FLAG LOLIM EQU PNTRS+42 LOW LIMITS OF PROGRAM HILIM EQU PNTRS+43 HIGH LIMITS OF P ROGRAM LORUN EQU PNTRS+44 LOW RUN LIMITS HIRUN EQU PNTRS+45 HIGH RUN LIMITS SLSTM EQU PNTRS+46 EXECUTE SLOW STMTS LOTRC EQU PNTRS+47 LOW TRACE LIMITS HITRC EQU PNTRS+48 HIGH TRACE LIMITS BRKP1 EQU PNTRS+49 BREAK POINT #1 BRKP2 EQU PNTRS+50 BREAK POINT #2 BRKP3 EQU PNTRS+51 BREAK POINT #3 BRKP4 EQU PNTRS+52 BREAK POINT #4 SMFLG EQU PNTRS+53 SIMULATE FLAG TYPE EQU PNTRS+54 PARTIAL LINE CHARACTER COUNT DLMTR EQU PNTRS+55 CHAR EDIT DELIMITER MERGF EQU PNTRS+56 MERGE FLAG SK P TEMPT BSS 7 STTYP DEF DIM FOPBS DEF QUOTE-2 LNBFA DEF LNBFF-1 ERBFA DEF ERBUF AFCNS DEF FCNS SPC 1 SUP PRESS MULTIPLE LISTINGS SPC 1 .0 DEC 0 .1 DEC 1 .3 DEC 3 d*.7 DEC 7 .10 DEC 10 .15 DEC 15 .32 DEC 32 .34 DEC 34 .40 DEC 40 .45 DEC 45 .73 DEC 73 .G50 OCT 50000 B36 OCT 36 B37 OCT 37 B40 EQU .32 B44 OCT 44 B60 OCT 60 B100 OCT 100 F OCT 106 N OCT 116 B177 OCT 177 B77 OCT 77 B200 OCT 200 B7 77 OCT 777 MSK0 OCT 377 B1100 OCT 1100 COMWD OCT 34000 REMOP OCT 36000 FOROP OCT 41000 NEXOP OCT 42000 NSBOP OCT 56000 ONOP OCT 73000 OPMSK OCT 77000 TYPFL OCT 100017 OPDMK OCT 100777 M1 DEC -1 M2 DEC -2 M3 DEC -3 M5 DEC -5 M21 DEC -21 MNEG OCT 100000 MAXIMUM NEGATIVE FLOATING OCT 376 POINT NUMBER FLGBT EQU MNEG SPC 3 ERBUF ASC 5, IN LINE LNBFF BSS 2 BLNK DEF *+1 ASC 2, _ : ALEN DEF *+1 OCT 3 ASC 2,LEN FORCT NOP 'FOR'-'NEXT' SPACE COUNTER LNCNT NOP LINE COUNTER CRLF DEF *+1 OCT 6412 SKP ******************** * * * LIST THE PROGRAM * * * ******************** BASC2 NOP CLA INITIALIZE STA LNCNT LINE COUNTER STA FORCT .RESET FOR/NEXT COUNTER LDA FOPBS .SET OPERATOR PRINT ADDRESS JSB INDCK . DIRECT STA FOPBS LDA STTYP .SET SYNTAX TABLE POINTER JSB INDCK . DIRECT STA STTYP LDA LUOUT IS IT ERROR SSA MESSAGE ENTRY? JMP PRMES YES! LDB LOLIM SET PTR STB TEMPS TO PRO GRAM START LDB PRINT ASSUME PRINTER LDA PFLAG BUT CHECK FLAG FOR SURE SSA -1 IF PUNCH LDB PUNCH ITS A PUNCH REQUEST CMA,SSA,INA,SZA PFLAG <= 0? RSS .NO SPEC LU # STB LUOUT SAVE OUTPUT DEVICE L.U. SPC 1 * IF LINE PRINTER LIST DEVICE - MOVE FORM TO NEW PAGE * IF PUNCH LIST DEVICE - PUNCH LEADER ON TAPE SPC 1 LDA FLFI.L .OUTPUTTING ON FILE ? INA,SZA,RSS JMP LIST 1 .YES - IGNOR DEVICE CONTROLS LDA FLFIL .CHECK FOR FILE SAVE INA,SZA,RSS .FILE THIS TIME? JMP LIST1 .YES LDA LUOUT JSB FINDV .FETCH DRIVER NUMBER CPA .2 .PUNCH TYPE DEVICE ? JMP LI S40 . YES - OUTPUT LEADER CPA .10 .LINE PRINTER ? JMP LIS41 .YES THROW A PAGE CPA .5 RSS .IT IS A CRT LINE PRINTER ? JMP LIST1 .NO SPECIAL PROCESSING CPB .4 LIS41 JSB HEAVE .YES A LINE PRINTER JMP LIST1 .CONTINUE * LIS40 LDA LUOUT .FORM LEADER PUNCH IOR B1000 . CONTROL WORD STA LIS51 JSB EXEC .PUNCH LEADER DEF *+3 DEF .3 DEF LIS51 SPC 1 * INITI ALIZE FOR CONVERTING A STATEMENT SPC 1 LIST1 LDB TEMPS MORE CPB HILIM PROGRAM? JMP LIS13 NO * CCA INITIALIZE ADA .OTBF OUTPUT STA OTBFA BUFFER POINTER CLA INITIALIZE STA OCCNT CHAR COUNT SKP * JSB OUTBL .YES - SET BLANKS AS FIRST CHAR JSB OUTBL . IN LINE ISZ LNCNT UPDATE LINE COUNTER SPC 1 * OUTPUT LINE NUMBER SPC 1 LDA TEMP S,I OUTPUT STA .LNUM JSB OUTIN SEQUENCE NUMBER JSB OUTBL .OUTPUT BLANK LDB FORCT JSB FORSP INDENT 'FOR'-'NEXT' LOOP ISZ TEMPS FETCH LDA TEMPS,I STATEMENT LENGTH CMA,INA SET INA WORD STA LCNTR COUNTER LIST3 ISZ TEMPS MORE ISZ LCNTR STATEMENT? JMP LIST4 YES SPC 1 * CONVERSION COMPLETE - OUTPUT THE LINE ON LIST DEVICE SPC 1 LIS30 JSB IF BRK IS DEF *+1 ATTENTION SZA FLAG SET? JMP LIS13 YES, GO TO READY * * LDB .OTBF OUTPUT LDA OCCNT STATEMENT JSB WRITE TO PERIPHERAL JMP LIST1 * SPC 1 * SAVE1 LDA B40 APPEND A JSB OUTCR SPACE TO OUTPUT BUFFER * CONVERT THE OPERATOR SPC 1 LIST4 LDA TEMPS,I AND OPMSK SZA,RSS NULL OPERATOR? JMP LIST5 YES * CONT STA TEMP2 SA VE OPERATOR ALF,ALF SINGLE ARS LDB 0 CHARACTER ADA M21 SSA,RSS OPERATOR? JMP LIS12 NO BLS YES INB LOAD ADB FOPBS SYMBOL'S LD A 1,I ASCII WORD ALF,ALF ADJUST AND MSK0 CHARACTER CPA .34 " ? JMP LIS14 YES JSB OUTCR NO SKP * CONVERT THE OPERAND SPC 1 LIST5 LDA TEMPS,I AND OPDMK SA VE STA TEMP3 OPERAND SSA FLAG BIT SET? JMP LIST9 YES SZA,RSS NO, NULL OPERAND? JMP LIST3 YES AND TYPFL ISOLATE TYPE PART CPA .15 FUNCTION? JMP LIST8 YES SPC 1 * OUTPUT LETTER-DIGIT COMBINATIONS SPC 1 LIST6 LDA TEMP3 RRR 4 AND B177 OUTPUT ADA B100 JSB OUTCR LETTER LDA TEMP3 YES AND .15 RESTORE SZA,RSS STRING? JMP LIS16 YES! ADA M5 NO! SSA LETTER-DIGIT? JMP LIST3 NO! ADA B60 DIGIT LIS17 JSB OUTCR OUTPUT DIGIT JMP LIST3 SPC 1 LIS16 LDA B44 '$' JM P LIS17 SPC 1 LIST8 LDA F OUTPUT JSB OUTCR LDA N 'FN' JSB OUTCR LDA TEMP3 OUTPUT RRR 4 AND B177 LETTER ADA B100 JSB OUTCR JMP LIST3 SPC 1 * OUTPUT FLOATING-POINT CONSTANTS SPC 1 LIST9 XOR FLGBT SZA NUMBER? JMP LIS10 NO ISZ TEMPS YES  LDA TEMPS,I ISZ TEMPS LDB TEMPS,I ISZ LCNTR ISZ LCNTR CCE OUTPUT JSB NUMOT THE NUMBER JMP LIST3 SPC 1 * OUTPUT FUNCTION NAMES SPC 1 LIS10 AND .15 CPA .3 INTEGER? JMP LIS11 YES CPA .15 NO, FUNCTION? RSS YES JMP LIST6 NO, MUST BE A PARAMETER LDA TEMP3 COMPUTE RRR 4 AND B37 COMPUTE INTERNAL FUNCTION NO. CPA B37 IS IT LEN FUNCTION? JMP LENF YES CPA B36 FORTRAN FUNCTION? JMP FRFCT YES! STA TEMP2 CODE CMA STA TEMP5 NO. OF MNEMONICS TO SKIP LDA AFCNS GET ADDR. OF FUNCTION MNEM. JSB INDCK MAKE DIRECT STA 1 ADDR OF MNEMONIC ENTRIES IN BREG NXFCN ISZ TE MP5 IS THIS IT? RSS NO! JMP LFCN YES! LDA 1,I GET FIRST WORD OF MNEMONIC ENTRY AND .7 GET CHARACTER COUNT ADA .3 ARS INCREMENT TO NEXT ENTRY ADB 0 ADD IN MNEM TBL ADDRESS JMP NXFCN CHECK NEXT ENTRY LFCN JSB MCOPY OUTPUT FUNCTION NAME JMP LIST3 * LEN FUNCTION FOUND LENF LDB ALEN ADDRESS OF PRINT JMP LFCN BUFFER FOR LEN FRFCT ISZ TEMPS ISZ LCNTR JMP MCAL1 PRINT FORTRAN FUNCT MNEM SPC 1 * OUTPUT INTEGER CONSTANTS SPC 1 LIS11 ISZ TEMPS OUTPUT ISZ LCNTR LDA TEMPS,I INTEGER SSA MINUS SIGN REQUIRED? JMP LIS19 YES! LIS18 JSB OUTIN JMP LIST3 OPERAND * LIS19 LDA .45 OUTPUT JSB OUTCR MINUS SIGN LDA TEMPS,I COMPLEMENT CMA,INA TO OBTAIN JMP LIS18 ABSOLUTE VALUE SPC 1 * OUTPUT OPERATOR SP C 1 LIS12 JSB OUTBL .OUTPUT BLANK * LDA TEMP2 IS THIS CPA FOROP A 'FOR' STATEMENT? JM4P LIS21 YES, INDENT 'FOR' STATEMENT LIS22 LDA TEMP2 CPA NEXOP IS THIS A 'NEXT' STMT? RSS YES! JMP *+4 NO! LDB FORCT DECREMENT ADB M1 FOR STB FORCT COUNT CPA .G50 CALL? JMP MCALL YES. PRINT CALL STATEMENT JSB MCOUT OUTPUT LDA TEMP2 OPERATOR CPA REMOP IS IT A REMARK STATEMENT? JMP LIS15 YES LDA TEMP2 COM STMT? CPA COMWD RSS YES! JMP *+5 NO! ISZ TEMPS YES, SKIP ISZ TEMPS OVER COMMON SIZE ISZ LCNTR AND DECREMENT ISZ LCNTR LENGTH COUNTER LDA BLANK OUTPUT A BLANK JMP LIST5-1 AND LOOK FOR OPERANDS. * LIS15 JSB OUTST OUTPUT STRING JMP LIST3 SPC 1 LIS21 ISZ FORCT INCREMENT CO UNT LDB .1 AND INDENT JSB FORSP 'FOR' STATEMENT JMP LIS22 ONE MORE TIME SPC 1 * IF PUNCH LIST DEVICE - PUNCH TRAILER ON TAPE SPC 1 LIS13 LDA FLFIL .CHECK FOR FILE INPUT INA, SZA,RSS JMP CLOSE .YES CLOSE IT LDA LUOUT JSB FINDV .FETCH DRIVER NUMBER CPA .5 .2640.44.45 RSS .YES JMP LIS49 . NO TRY SOMETING ELSE CPB .1 .IS IT A MINITAPE? JMP EOF .YES LEFT ONE CPB .2 JMP EOF .YES - RIGHT ONE CPB .4 .CRT PRINTER ? JMP LIS50 .YES - THROW A PAGE LIS49 CPA .10 .A LINE PRINTER ? JMP LIS50 .YES THROW A PAGE CPA .2 .IS IT THE PUNCH ? JMP EOF .PUNCH LEADER * ENLST JMP RDYPT .FINISHED - GO TO OPERATOR * LIS50 JSB HEAVE JMP ENLST * EOF LDA LUOUT IOR B1000 .FORM EOF REQUEST STA LIS51 JSB EXEC .PUN CH LEADER -OR- DEF *+3 . WRITE 2644/45 EOF DEF .3 DEF LIS51 JMP ENLSkT * CLOSE JSB CLFIL .CLOSE OUTPUT FILE JMP ENLST * B1000 OCT 1000 .5 DEC 5 .2 DEC 2 .4 DEC 4 LIS51 NOP ************ ******************* * * * INDENT 'FOR'-'NEXT' LOOPS * * * ******************************* * FORSP NOP SZB,RSS NEED ANY SPACES? JMP FORSP,I NO! SSB TOO MANY 'NEXT'S' ? JMP FORSP,I YES! CMB,INB SET STB TEMP3 COUNTER LDA M1 . SAVE OR PUNCH CPA SAVFL JMP FORSP,I .YES - A SAVE CPA PFLAG JMP FORSP,I YES, DON'T INDENT FORS0 LDA B40 OUTPUT JSB OUTCR SPACE LDA B40 OUTPUT ANOTHER JSB OUTCR SPACE ISZ TEMP3 DONE? JMP FORS0 NO! JMP FORSP,I YES! * SKP * OUTPUT QUOTE STRING SPC 1 LIS14 LDB TEMPS,I OUTPUT QUOTE STRING BLF,BLF TEST BIT 8 SLB SUPPRESS QUOTES? JMP LIS13 YES! JSB OUTCR OUTPUT " JSB OUTST OUTPUT QUOTE STRING LDA .34 OUTPUT " JMP LI S17 * ********************* * * * OUTPUT FORMFEED * * * ********************* * HEAVE NOP AND B177 MAKE SURE V-BIT IS 0 IOR B1100 FORM TAB COMMAND STA LENTH JSB EX EC DO IT TO IT DEF *+4 DEF .3 DEF LENTH DEF M3 JMP HEAVE,I * * ************************************** * * * OUTPUT BLANKS IF LISTING * * * ************************************** * OUTBL NOP LDA SAVFL .TEST FOR PUNCH OR SAVE CPA M1 JMP OUTBL,I .YES - NO BLANKS LDA .32 .NO - INSERT BLANKS JSB OUTCR JMP OUTBL,I SKP ******************* * * * OUTPUT A STRING * *  * ******************* OUTST NOP LDA TEMPS,I AND B177 GET STRING COUNT CMA,INA,SZA,RSS NULL STRING? JMP OUTST,I YES! STA TEMP6 NO, SAVE NEG OF COUNT OUTS1 ISZ TEMPS MOVE TO NEXT PAIR OF CHARS ISZ LCNTR BUMP COUNTER LDA TEMPS,I GET THEM ALF,ALF POSITION TO OUTPUT LEFT CHARACTER JSB OUTS2 OUTPUT CHAR LDA TEMPS, I GET CHAR PAIR AGAIN JSB OUTS2 OUTPUT RIGHT HAND CHAR JMP OUTS1 SPC 1 OUTS2 NOP AND B177 JSB OUTCR ISOLATE AND OUTPUT CHAR ISZ TEMP6 WAS IT LAST CHAR JMP OUTS2,I NO! JMP OUTST, I YES! * ********************************** * * * OUTPUT A MULTICHARACTER SYMBOL * * * ********************************** MCOUT NOP LDB STTYP ADDRESS OF STATEMENT OPERATORS MCOU1 LDA 1,I LOAD INFORMATION WORD AND OPMSK COMPARE WITH CPA TEMP2 OPERATOR CODE JMP MCOU2 EQUAL LDA 1,I UNEQUAL, AND .7 COMPUTE ADA .3 ENTRY ARS LENGTH ADB 0 COMPUTE ADDRESS OF NEXT ENTRY JMP MCOU1 MCOU2 JSB MCOPY GO OUTPUT SYMBOL JMP MCOUT,I * MCOPY NOP LDA 1,I COMPUTE AND .7 ENTRY CMA,INA LENGTH STA DIGCT AND SAVE IT CLE,INB SET FOR FIRST CHARACTER STB TEMP3 SAVE SYMBOL ADDRESS MCOU3 LDA TEMP3,I LOAD WORD SEZ,RSS FIRST CHARACTER? ALF,ALF YES, POSITION IT AND B177 EX TRACT CHARACTER JSB OUTCR OUTPUT IT SEZ,CME SET FOR NEXT CHARACTER ISZ TEMP3 MOVE TO NEXT WORD OF SYMBOL ISZ DIGCT MORE CHARACTERS? JMP MCOU3 YES JMP MCOPY,I **************************** *** * * * LIST A CALL STAT)<:6EMENT * * * ******************************* * MCALL JSB MCOUT OUTPUT 'CALL" JSB OUTBL .OUTPUT SPACE MCAL1 LDA TEMPS STA TEMP7 CLEAR FORT FCT FLAG LDA 0,I GET OPERATOR WORD AND B777 GET MNEMONIC TBL OFFSET CMA USE OFFSET TO FIND MNEMONIC STA TEMP5 NO. OF MNEMONICS TO SKIP LDB FWAMM GET ADDR. OF SUB. MNEMONICS INB NXSUB ISZ TEMP5 IS THIS IT? RSS NO! JMP LCALL YES! LDA 1,I GET FIRST WORD OF MNEMONIC ENTRY AND .7 GET CHARACTER COUNT ADA .3 ARS INCREMENT TO NEXT ENTRY ADB 0 ADD IN MNEM TBL ADDRESS JMP NXSUB CHECK NEXT ENTRY LCALL JSB MCOPY LIST THE CALL MNEMONIC LDA TEMP4 GET LAST CHAR (SEE OUTCR) CPA .40 LAST CHAR "("? JMP MCAL2 YES, SUPPRESS SPACE JSB OUTBL .OUTPUT A BLANK MCAL2 ISZ TEMPS POINT AT FIRST PARAM ISZ LCNTR UPDATE INTERMEDIATE CODE COUNTER JMP LIST5 SKP <* * * MOVE WORDS ROUTINE * * CALLING SEQ IS: A=SOURCE ADDRESS * B=DESTINATION ADDRESS * * (P) JSB MVW * (P+1) COUNT OF WORDS * (P+2) NOP * (P+3) RETURN HERE * MVW NOP STA TEMP4 SAVE SOURCE ADDRS LDA MVW,I GET COUNT CMA,INA AND USE ISZ MVW AS COUNTER STA MVW,I FOR MOVE MVW1 LDA TEMP4,I GET WORD STA 1,I PUT AWAY ISZ TEMP4 INCREMENT SOURCE ADDR INB INCREMENT DESTINATION ADDR ISZ MVW,I INCREMENT COUNTER, DONE? JMP MVW1 NO, NOT YET ISZ MVW YES JMP MVW,I *********************** * * * PRINT ERROR MESSAGE * * * *********************** * * PRMES LDA ERTTY RESET OUTPUT STA LUOUT L.U. # TO ERROR DEVICE * LDA FLFIL .OUTPUTTING ON FILES ? INA,SZA,RSS JSB CLFI L .YES - CLOSE FILE SO THAT ERROR PRINTS LDA TEMP3 .FETCH ERROR # * CMA,INA MAKE NEGATIVE AND STA LCNTR SAVE FOR COUNTER LDB MESGA SET TABLE PNTR TO START PRMS1 LDA 1,I GET LENGTH OF MESSAGE IN B MOVE PNTR TO MESSAGE ISZ LCNTR INDEX ERROR CNTR, IS IT = 0? RSS NO, MOVE PNTR TO NEXT MESSG JMP PRMS2 YES - GO PRINT MESSAGE SLA IF CHAR COUNT ODD, INA MAKE EVEN ARS CONVERT TO WORDS ADB 0 MOVE PNTR TO NEXT MESSG JMP PRMS1 GO INDEX ERROR COUNTER * * DISK FILE ERRORS ARE NEGATIVE AND COME HERE * * * PRMS2 JSB WRITE PRINT FIRST PART OF MESSAGE LDA .10 INITIALIZE STA OCCNT OUTPUT LDA LNBFA BUFFER STA OTBFA LDA .LNUM OUTPUT SZA,RSS COMMAND ERROR? JMP ERRP2 YES, DON'T PRINT OUT LINE# JSB OUTIN NO! LDA OCCNT    LINE LDB ER BFA JSB WRITE NUMBER * LDA TEMP8 IS CHAR SSA,RSS COUNT CMA,INA WITHIN ADA .73 A REASONABLE SSA RANGE? JMP ERRP1 NO, GO TO MAIN! LD A .INBF YES, MOVE LDB .OTBF BAD STMT JSB MVW FROM INPUT DEC 36 BUFFER TO NOP OUTPUT BUFFER LDA TEMP8 MAKE CMA STATEMENT STA OCCNT LENGTH POSITIVE LDA PFLAG KEYBOARD SZA,RSS INPUT? JMP ERRP1 YES, EXIT LDA .OTBF,I ARE FIRST TWO CPA BLNK,I CHARACTERS BLNKS? JMP PRMS3 YES, DON'T INSERT BLANKS LDA .3 OUTPUT LDB BLNK TWO JSB WRITE BLANKS PRMS3 LDA OCCNT REPRINT LDB .OTBF THE JSB WRITE STATEMENT * ERRP1 JMP PRMT YES, RETURN TO IT THEN * ERRP2 LDA M2 PRINT LDB CRLF CARRIAGE RETURN/LINE FEED JSB WRITE JMP ERRP1 * TEMP2 EQU TEMPS+3 TEMP3 EQU TEMPS+4 TEMP4 EQU TEMPS+5 TEMP5 EQU TEMPS+6 TEMP6 EQU TEMPS+7 TEMP7 EQU TEMPS+8 TEMP8 EQU TEMPS+9 LENTH EQU TEMPT+1 TBUFA EQU TEMPT+2 TCNTR EQU TEMPT+3 LCNTR EQU TEMPT+4 DIGCT EQU TEMPT+5 FERR EQU TEMPT+6 END  ^p 92065-18004 1650 S C0222 &MBC30 RTE-M BAISC PRE-EXEC SUBR             H0102 -ASMB,R HED <> 92065-16001 NAM BASC3,7 92065-16001 REV.1650 761022 * * * DATE 9-24-76 * * SOURCE: 92065-18004 * ************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1975. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * * PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ************************************************************** ENT BASC3 ENT GETNM,CHRCK EXT LIMEM,MNTBL,BRTBL,INDCK EXT EXEC,OUTER,SSYMT,TRAP,BCKSP,GETCR,DIGCK EXT RDYPT,BASC4 COM TEMPS(30),PNTRS(61),SPEC(10) ********************************************** * * * SEGMENT #3: PRE-EXECUTION PROCESSING * * * ********************************************** * * THIS PART OF THE INTERPRETER IS LOADED BY THE BASIC MAIN CONTROL * ONCE TO PERFORM BASIC SYTEM INITIALIZATION AND ALSO * WHENEVER THE 'RUN' COMMAND IS GIVEN. IT WILL CONSTRUCT THE * SYMBOL TABLE, CHECK FOR-NEXT LOOPS AND DETERMINE ARRAY STORAGE * ALLOCATIONS FOR THE USER PROGRAM. UPON COMPLETION, IT RETURNS * TO THE MAIN CONTROL PROGRAM WHICH THENS LOADS THE EXECUTION * SEGMENT AND BRANCHES TO IT. SKP *************************** * * * CONSTANTS AND VARIABLES * * * *************************** * FWAM EQU PNTRS FIRST WORD OF AVAILABLE MEMORY LWBM EQU PNTRS+1 LAST WORD OF AVAILABLE MEMORY .INBF EQU PNTRS+2 INPUT BUFFER ADDRESS SBUFA EQU PNTRS+3 SYNTAX BUFFER ADDRESS SYMTA EQU PNTRS+4 START OF SYMBOL TABLE SYMTF EQU PNTRS+5 END OF SYMBOL TABLE PBUFF EQU PNTRS+6 FIRST WORD OF USER PROGRAM PBPTR EQU PNTRS+7 LAST WORD+1 OF USER PROGRAM INBFA EQU PNTRS+8 INPUT BUFFER POINTER ICCNT EQU PNTRS+9 INPUT CHARACTER COUNT SBPTR EQU PNTRS+10 SYNTAX BUFFER POINTER .LNUM EQU PNTRS+11 CURRENT LINE # FCORE EQU PNTRS+12 START OF FREE CORE MNNAM EQU PNTRS+13 MNEMONIC TABLE NAME:SC:LU BRNAM EQU PNTRS+18 BRANCH TABLE NAME:SC:LU FWAMM EQU PNTRS+23 POINTER TO START OF MNEMONIC TABLE FWAMB EQU PNTRS+24 POINTER TO START OF BRANCH TABLE .OTBF EQU PNTRS+25 POINTER TO OUTPUT BUFFER OCCNT EQU PNTRS+26 OUTPUT CHARACTER COUNT OTBFA EQU PNTRS+27 POINTER INTO OUTPUT BUFFER LUOUT EQU PNTRS+28 CURRENT OUTPUT L.U. # LUINP EQU PNTRS+29 CURRENT INPUT L.U. # SIGN EQU PNTRS+30 SIGN OF CURRENT NUMBER BLANK EQU PNTRS+31 CURRENT TERMINATION CHAR REC# EQU PNTRS+32 COMMAND FILE RECORD NUMBER FLTYP EQU PNTRS+33 TYPE 0 FILE FLAG TTYPR EQU PNTRS+34 CONSOLE TTY L.U. # PRINT EQU PNTRS+35 LISTING L.U. # READR EQU PNTRS+36 AUXILLIARY INPUT L.U. # PUNCH EQU PNTRS+37 AUXILLIARY OUTPUT L.U. # ERTTY EQU PNTRS+38 ERROR LIST OUTPUT L.U. # DCB EQU PNTRS+39 DATA CONTROL BLOCK ADDRESS FILBK EQU PNTRS+40 FILE CONTROL BLOCK ADDRESS PFLAG EQU PNTRS+41 SAVE,LOAD FILE FLAG LOLIM EQU PNTRS+42 LOW LIMITS OF PROGRAM HILIM EQU PNTRS+43 HIGH LIMITS OF PROGRAM LORUN EQU PNTRS+44 LOW RUN LIMITS HIRUN EQU PNTRS+45 HIGH RUN LIMITS SLSTM EQU PNTRS+46 EXECUTE SLOW STMTS LOTRC EQU PNTRS+47 LOW TRACE LIMITS HITRC EQU PNTRS+48 HIGH TRACE LIMITS BRKP1 EQU PNTRS+49 BREAK POINT #1 BRKP2 EQU PNTRS+50 BREAK POINT #2 BRKP3 EQU PNTRS+51 BREAK POINT #3 BRKP4 EQU PNTRS+52 BREAK POINT #4 SMFLG EQU PNTRS+53 SIMULATE FLAG TYPE EQU PNTRS+54 PARTIAL LINE CHARACTER COUNT DLMTR EQU PNTRS+55 CHAR EDIT DELIMITER MERGF EQU PNTRS+56 MERGE FLAG SKP TEMPT BSS 15 TEMPORARIES * ERBS DEF ERR-1 MBUF DEF TEMPS MNADD DEF MNTBL BTADD DEF BRTBL * SUP PRESS MULTIPLE LISTINGS SPC 1 .1 DEC 1 .2 DEC 2 .3 DEC 3 .4 DEC 4 .5 DEC 5 .27 DEC 27 .28 DEC 28 .30 DEC 30 .32 DEC 32 .33 DEC 33 .34 DEC 34 .37 DEC 37 .63 DEC 63 .9999 DEC 9999 CALOP OCT 50000 DATOP OCT 51000 B400 OCT 400 B757 OCT 757 B1000 OCT 1000 B777 OCT 777 D72 OCT -72 HIMSK OCT 177400 SLASH OCT 57 STDIM OCT 5001 STANDARD DIMENSIONS FOR ARRAYS STRDM OCT 400 STANDARD DIMENSIONS FOR STRINGS COMOP OCT 34000 COMMON OPERATOR FILOP OCT 63000 OPMSK OCT 77000 DEFOP OCT 35000 M1 DEC -1 M2 DEC -2 M3 DEC -3 M4 DEC -4 M16 DEC -16 M40 DEC -40 M99 DEC -99 MNEG OCT 100000 MAXIMUM NEGATIVE FLOATING OCT 376 POINT NUMBER * SKP **************************** * * * PRE-EXECUTION PROCESSING * * * **************************** TEMPX NOP BASC3 NOP * ***************************************************** * * ** BASIC SYSTEM INITIALIZATION - ONCE ONLY CODE ** * * ***************************************************** * LDA PFLAG IS THIS AN CPA .9999 AN INITIALIZATION? RSS YES! JMP PREEX NO, DO PRE-EXECUTION * SPC 1 * DEFINE COMPILER BUFFERS AND USER AREA SPC 1 JSB LIMEM .FETCH MEMORY LIMITS DEF *+4 DEF .1 DEF FWAM .SET FIRST WORD AVAIL MEMORY DEF TEMPX .USE LAST WORD AVAIL TEMP FOR #WORDS LDB TEMPX .CALCULATE ADDRESS OF LAST WORD ADB FWAM ADB M40 SET STB .INBF INPUT BUFFER ADDRESS ADB M40 SET OUTPUT STB .OTBF BUFFER ADDRESS ADB M1 SET SYMBOL TABLE STB SYMTA ADDRESS ADB M99 SET SYNTAX STB SBUFA BUFFER ADDRESS ADB M1 SET LAST WORD STB LWBM BASIC AVAILABLE MEMORY CLB INITIALIZE STB TYPE STB SLSTM * LDA MNADD JSB INDCK .SET FIRST WORD OF MNEMONIC TABLE STA FWAMM * LDA BTADD o$JSB INDCK .SET FIRST WORD OF BRANCH TABLE INA STA FWAMB * * * LDA FWAM STA PBUFF SET PROGRAM BUFFER ADDRESS STA PBPTR SET PROGRAM BUFFER POINTER LDA .32 INITIALIZE STA BLANK DELETE CHARACTER FOR GETCR CLA SET LINE NUMBER TO STA .LNUM ZERO INITIALLY CCA INITIALIZE STA FLTYP TYPE 0 FILE LDA SLASH INITIALIZE CHAR STA DLMTR EDIT DELIMTER SPC 1 * SET LOGICAL UNIT NUMBERS SPC 1 CLA,INA SET UP STA REC# RECORD NUMBER LDA TTYPR SZA,RSS L.U. # ENTERED? CLA,INA NO, SET TO #1 IOR B400 SET ECHO BIT STA TTYPR STA ERTTY .SET ERROR TO TTY LU LDA PRINT LIST OUTPUT SZA,RSS L.U. # ENTERED? LDA TTYPR NO, SET TO CONSOLE L.U.# STA PRINT LDA READR AUXILLARY INPUT SZA,RSS L.U. # ENTERED? LDA .5 NO, SET TO #5 IOR B400 YES, ADD CONTROL BIT STA READR LDA PUNCH AUXILLARY OUTPUT SZA,RSS L.U. # ENTERED? LDA .4 NO, SET TO #4 STA PUNCH JMP RDYPT START UP BASIC SPC 1 * SKP * * PREEX EQU * PRE-EXECUTION PROCESSING FOR SPEC SYNTAX BAS3 LDA PBUFF NULL CPA PBPTR PROGRAM? JMP RDYPT YES STA MPTR INITIALIZE PROGRAM POINTER LDA M16 ADA M1 STA TEMP4 CLA INITIALIZE COMMON STA COML SIZE TO ZERO * LDB PBUFF START OF PROGRAM MLO10 CPB PBPTR ALL COMMON JMP MLO14 STMTS CHECKED? ADB .2 NO LDA 1,I GET NEXT STMT TYPE INB AND OPMSK CPA COMOP COMMON STMT? RSS YES! JMP MLO11 NO! LDA 1,I FETCH COMMON SIZE ADA COML AND UPDATE STA COML  COMMON COUNTER MLO11 ADB M2 STATEMENT SIZE ADB 1,I CALCULATE ADDRESS ADB M1 OF NEXT STATEMENT JMP MLO10 SPC 1 MLO14 LDB PBUFF GET START OF PROG CPB PBPTR END OF PROG? JMP MLO15 YES ADB .2 NO, GET LDA 1,I THE STATEMENT AND OPMSK OP CODE ADB M1 SET ADB 1,I (B) TO ADB M1 NEXT STATEMENT JMP MLO14+1 SPC 1 MLO15 STB FCORE SET FOR-TABLE POINTER LDA COML ANY COMMON INA JSB CKOVF IS BLOCK TOO BIG? CMA,INA ALLOCATE COMMON ADA LWBM STA SYMTA SYM TBL END = COM START -1 STA SYMTF SYM TBL START(EMPTY) INA STA COML START OF COMMON SPC 1 MLOP1 LDB MPTR,I STB .LNUM SET LINE NUMBER LDB MPTR ISZ MPTR ADB MPTR,I COMPUTE LOCATION OF NEXT STB MNPTR STATEMENT AND STORE THIS ISZ MPTR LDA MPTR,I FETCH THE FIRST WORD IN THE ARS STATEMENT AND SAVE ALF,ALF THE STATEMENT TYPE AND .63 STA TYP CPA .30 NO, REM STATEMENT? STB MPTR YES, SET TO SKIP IT CPA .28 COMMON? ISZ MPTR YES, SKIP CPA .28 OVER ISZ MPTR SIZE CPA .43 NO, PRINT STATEMENT? STB MPTR YES, SET TO SKIP IT CCA NO, SET STA MWDNO 'FIRST VARIABLE' JMP MLOP2+1 FLAG * MLO13 AND B777 YES, ISOLATE OPERAND LDB MPTR CPA B757 IS THIS A USER DEFINED FUNCTION? JMP *+4 YES, SO INCREMENT PAST CALL#-PARAMETER COUNT * INDEX THE PROGRAM POINTER BY SZA,RSS AN AMOUNT APPROPRIATE TO THE ADB .2 OPERAND. THE FOLLOWING APPLIES CPA .3 OPERAND = 0 ADD 2 TO POINTER INB OPERAND =3 ADD 1 TO POINTER STB MPTR * ! SKP * PROCESS OPERAND SPC 1 MLOP2 ISZ MPTR INCREMENT WORD-OF-STATEMENT PTR LDA MPTR STATEMENT CPA MNPTR EXHAUSTED? JMP MLOP5 YES LDA MPTR,I NO AND OPMSK 'QUOTE' CPA B1000 OPERATOR? JMP MLP4A YES, SET TO SKIP CPA CALOP CALL OPERATOR? JMP MLOP2 YES! SKIP LDA MPTR,I NO SSA 'CONSTANT' OPERAND? JMP MLO13 YES AND B777 NO SZA,RSS NULL OPERAND? JMP MLOP2 YES STA MBOX1 NO, SAVE IT AND .15 PROGRAMMER-DEFINED CPA .15 FUNCTION? JMP MLOP6 YES ADA M4 NO SSA ARRAY VARIABLE? JMP MLOP7 YES SPC 1 * PROCESS SIMPLE VARIABLE SPC 1 LDA MBOX1 NO, SIMPLE VARIABLE JSB SSYMT ALREADY IN SSB,RSS SYMBOL TABLE? JMP MLOP3 YES LDA MNEG NO LDB MNEG+1 ENTER STA MBOX1+1 IT WITH STB MBOX1+2 'UNDEFINED' LDA M3 VALUE JSB ESYMT MLOP3 LDB TYP LDA MBOX1 CPB .34 NEXT STATEMENT? JMP MLOP4 YES SPC 1 * PROCESS 'FOR' STATEMENT SPC 1 CPB .33 NO, FOR STATEMENT? ISZ MWDNO YES, FIRST VARIABLE? JMP MLOP2 NO ISZ FCORE DEMAND LDB FCORE SPACE CPB SYMTF FOR NEW JMP MER8-1 ENTRY STA FCORE,I SAVE VARIABLE NAME JMP MLOP2 SPC 1 * PROCESS 'NEXT' STATEMENT SPC 1 MLOP4 LDB FCORE FOR-TABLE CPB PBPTR EMPTY? JSB ERROR YES MER3 CPA FCORE,I NO, MATCH LATEST ENTRY? RSS YES JMP MER3-1 NO ADB M1 REMOVE STB FCORE MATCHED JMP MLOP2 ENTRY SPC 1 SPC 1 * PROCESS 'END' STATEMENT SPC 1 MLP4A XOR MPTR,I SET POINTER TO 5ADA .3 CLOSING ARS QUOTES ADA MPTR STA MPTR JMP MLOP2+1 SPC 1 MLOP5 CPA PBPTR PROGRAM EXHAUSTED? RSS YES JMP MLOP1 NO LDA TYP YES CPA .37 END STATEMENT? JMP M1LOP YES JSB ERROR NO SPC 1 * PROCESS 'DEF' STATEMENT SPC 1 MLOP6 LDA MPTR,I ISOLATE AND OPMSK PRECEDING OPERATOR CPA DEFOP 'DEF' ? RSS YES JMP MLOP2 NO GO TO PROCESS NEXT WORD LDA MBOX1 SEARCH SYMBOL TABLE FOR JSB SSYMT THE FUNCTION SSB,RSS JSB ERROR FOUND. ERROR MULTIPLY DEFINED MER4 LDA MPTR ADA .3 ENTER THE FUNCTION INTO THE STA MBOX1+1 SYMBOL TABLE TOGETHER WITH LDA M2 ITS ENTRY POINT IN THE SOURCE JSB ESYMT CODE JMP MLOP2 GO TO PROCESS THE NEXT WORD SPC 1 * PROCESS ARRAY VARIABLE SPC 1 MLOP7 CPA M4 IF STRING VARIABLE INA FORCE TO SINGLE DIMENSION STA 1 (B)=ARRAY TYPE LDA TYP CPA .27 DIM STATEMENT? JMP MLOP8 YES CPA .28 NO, COM STATEMENT? JMP MLOP8 YES JSB MSYMT NO, LOOK FOR IT IN SYMBOL TABLE JMP MLOP2 FOUND CLA NOT THERE STA MBOX1+1 ENTER IT WITH STA MBOX1+2 DIMENSIONS AND STA MBOX1+3 DIMENSIONALITY JMP MLOP0 UNDEFINED SPC 1 * PROCESS 'COM' AND 'DIM' STATEMENT SPC 1 MLOP8 ISZ MPTR PROCESS COM OR DIM STMT ISZ MPTR LDA MPTR,I PICK UP FIRST DIMENSION ALF,ALF SHIFT TO M. S. PART OF WORD CPB M3 IS THIS A SINGLE DIMENSION ARRAY JMP *+5 YES, JUMP ISZ MPTR NO, INDEX POINTER TO THE LOC. ISZ MPTR OF SECOND DIMENSION AND PACK IOR MPTR,I INTO A WITH THE FIRST DIMENSION RSS IOR .1 STA MBOX1+2 SET UP TOeL0.* STORE PACKED STA MBOX1+3 DIMENSIONS IN FORMAL AND ACTUAL CLA SLOTS AND UNDEFINED FLAG IN STA MBOX1+1 STORAGE ALLOCATION SLOT SPC 1 JSB MSYMT IN SYMBOL TABLE? JMP MLOP9 NO LDA TYP YES CPA .28 RSS IS STMT A COM JMP MLOP0 NO, JUMP LDA MBOX1+2 YES PICK UP PACKED DIMENSIONS JSB MDIM COMPUTE STORAGE REQUIRED SWP LDA MBOX1 IS IT A AND .15 STRING SZA,RSS VARIABLE? JMP STRM1 YES! LDA COML POINTER TO NEXT FREE LOC IN COM STRM2 STA MBOX1+1 STORE IN STORAGE ALLOCATION SLOT ADA 1 UPDATE POINTER BY THE AMOUNT OF STA COML STORAGE ASSIGNED. MLOP0 LDA M4 ENTER THE FOUR WORD ENTRY JSB ESYMT PREVIOUSLY SET UP IN MBOX1 INTO JMP MLOP2 SYMBOL TABLE AND CONTINUE SKP V0* STRM1 BRS SET UP INB POINTER BRS FOR STRINGS LDA COML,I SET UP AND B377 STA COML,I STRING HEADER LDA MBOX1+2 AND M256 IOR COML,I STA COML,I LDA COML INCREMENT INA TO FIRST WORD OF STRING DATA JMP STRM2 MLOP9 ADB .2 CHECK THE FORMAL DIMENSIONS LDA 1,I LOCATION TO SEE IF THE DIMENSION SZA IS ALREADY DEFINED JSB ERROR ERROR, DOUBLY DIMENSIONED MER5 LDA TYP CPA .28 COM STMT? JSB ERROR ERROR MISPLACED COM STMT MER5A LDA MBOX1+2 STA 1,I STORE THESE DIMENSIONS IN FORMAL INB AND ACTUAL SLOTS IN SYMBOL TABLE STA 1,I ENTRY JMP MLOP2 GO TO PROCESS NEXT WORD SPC 1 * CHECK FOR UNMATCHED 'FOR' STATEMENTS SPC 1 M1LOP LDA FCORE ALL FORS CPA PBPTR MATCHED? RSS YES JSB ERROR NO MER6 LDB SYMTF SPC 1 * CHECK ARRAY VARIABLE DIMENSIONS SPC 1 M2LOP CPB SYMTA MORE SYMBOLS? RSS NO, EXECUTE PROGRAM! JMP M7LOP YES LDA FCORE LDB FCORE ADA .20 ALLOCATE LIST SPACE STA FCORE CLA MCLOP STA 1,I AND CLEAR ALL SLOTS INB CPB FCORE RSS JMP MCLOP LDA .1 SET UP TRAP JSB TRAP TABLE (B)=-1 IF TABLE IS IN USE NOP JSB BASC4 GOTO SEGMENT #4 * M7LOP LDA 1,I YES AND .15 ACCOUNT FOR ADB .2 A FUNCTION CPA .15 IS IT? JMP M2LOP YES INB SZA,RSS STRING SYMBOL? JMP M5LOP YES! ADA M4 SIMPLE VARIABLE SSA,INA,RSS IS IT? JMP M2LOP YES SZA,RSS NO, # OF SUBSCRIPTS KNOWN? JSB ERROR NO * SKP MER10 INA SAVE STA MBOX1+1 FLAG STB MBOX1 SA VE POINTER LDA 1,I DEFINED SZA ARRAY? JMP M3LOP YES LDA STDIM NO, LOAD ISZ MBOX1+1 APPROPRIATE ADA .9 STANDARD DIMENSIONS STA 1,I RECORD AS ADB M1 FORMAL AND ACTUAL STA 1,I DIMENSIONS SPC 1 * ALLOCATE ARRAY STORAGE SPC 1 M3LOP JSB MDIM SAVE STORAGE STA MBOX1+1 REQUIREMENT LDB MBOX1 LOAD ADB M2 ADDRESS OF LDA 1,I ELEMENT SPACE SZA DEFINED IN COM? JMP M4LOP YES LDA FCORE NO, USE CURRENT STA 1,I FREE-CORE ADDRESS ADA MBOX1+1 UPDATE FREE-CORE STA FCORE ADDRESS CMA,INA OUT ADA SYMTF OF SSA SPACE? JSB ERROR YES MER7 LDB MBOX1+1 DIMENSIONS TO CMB,INB 'UNDEFINED' ADB FCORE M6LOP LDA MNEG STA 1,I INB LDA MNEG+1 STA 1,I INB CPB FCORE DONE? RSS JMP M6LOP NO! M4LOP LDB MBOX1 ADVANCE POINTER INB TO NEXT SYMBOL JMP M2LOP SPC 1 * SET UP STRING SYMBOLS SPC 1 M5LOP LDA 1,I DEFINED? AND M256 SZA,RSS DEFINED? LDA STRDM NO, LOAD STANDARD DIMENSIONS STA 1,I ADB M1 STA 1,I STA MBOX1 SAVE DIMENSION ADB M1 LDA 1,I DEFINED IN COMMON? SZA JMP M8LOP YES! LDA FCORE NO, SET UP STA 1,I ADDRESS OF STRING IN SYMBOL TBL LDA MBOX1 SET UP DIMENSIONS STA FCORE,I IN STRING HEADER ISZ 1,I BUMP ADDRESS TO ACTUAL STRING DATA ALF,ALF COMPUTE INA THE NUMBER ARS OF WORDS IN INA STRING ADA FCORE STA FCORE CMA,INA ADA SYMTF MORE CORE? SSA JMP MER7-1 Z NO! M8LOP ADB .3 JMP M2LOP CHECK NEXT SYMBOL SKP * SUBROUTINE TO GET A FLOATING POINT NUMBER * CONVERT IT, AND RETURN IT IN THE B REG * THE A REG=NEXT CHAR * CALLING SEQUENCE * JSB GETNM * UNABLE TO CONVERT RETURN * CONVERTED RETURN * B REG=NUMBER * GETNM NOP JSB GETCR GET NEXT CHAR LDA .10 CPA .10 EOF? JMP GETNM,I YES, RETURN CLB,CLE CLEAR E AND B REG STB TEMP1 CLEAR OUT SUM WORD STB TEMP2 CLEAR OUT DIGIT RECIEVED WORD CPA .43 IS IT A "+" CCE SET E=READ ANOTHER CHAR CPA .45 IS IT A "-" CCB,CCE SET B=-1, SET E =READ ANOTHER CHAR STB SIGN SAVE SIGN SEZ,RSS READ ANOTHER CHAR? JMP *+3 NO! GTNMA JSB GETCR YES LDA .10 EOF! JSB DIGCK GO SEE IF DIGIT IS NUMERIC JMP GTNMB NOT NUMERIC...DONE CONVERSION LDA TEMP1 GET PARTICAL SUM IN A REG STB TEMP1 DIGCK RETURN NUMBER IN BOTH A AND B REG MPY .10 MULTIPLY PARTICAL SUM BY 10 ADA TEMP1 AND IN NEXT DIGIT STA TEMP1 SAVE NEW SUM ISZ TEMP2 SET FOR RECIEVED A DIGIT JMP GTNMA GET NEXT DIGIT SPC 1 GTNMB LDB TEMP2 DID WE GET ANY DIGITS? SZB,RSS JMP GETNM,I NO LDB SIGN GET SIGN CLE,ERB IF NEGATIVE, SET E REG LDB TEMP1 GET BINARY VALUE SEZ NEGATIVE VALUE? CMB,INB YES...NEGATE RESULT ISZ GETNM GET DIGIT RETURN JMP GETNM,I RETURN * .10 DEC 10 .15 DEC 15 .20 DEC 20 .45 DEC 45 .43 DEC 43 .9 DEC 9 B377 OCT 377 B54 OCT 54 B72 OCT 72 M256 DEC -256 SPC 2 SKP * * SUBROUTINE TO CHECK IF A CHARACTER IN THE A REG * IS EITHER AN END OF LINE ".10" OR A : "B72" * CALLING SEQUENCE * JSB CHRCK * END OF LINE RETURN * COLEN RETURN A* NEITHER RETURN * A REG CONTAINS THE CHARACTER * B AND E REG NOT CHANGED * CHRCK NOP CPA .10 IS IT END OF LINE? JMP CHRCK,I YES...EOL RETURN CPA B54 IS IT A ","? JMP CHRCK,I YES...TREAT AS A EOL ISZ CHRCK CPA B72 IS IT A ":" JMP CHRCK,I ":" RETURN ISZ CHRCK JMP CHRCK,I NO DELM RETURN SKP * * SUBROUTINE TO STORE A BYTE * CALLING SEQUENCE * JSB SYBTE * A REG CONTAINS BYTE * B REG CONTAINS BYTE ADDRESS * SBYTE NOP AND B377 MASK ALL BUT LOWER 8 BITS STA TEMP7 SAVE IN TEMP LOCATION CLE,ERB CHANGE FROM BYTE TO WORD ADD LDA 1,I GET WORD SEZ,RSS RIGHT OR LEFT HALF ALF,ALF LEFT AND HIMSK MASK ALL BUT UPPER 8 BITS IOR TEMP7 OR IN NEW BYTE SEZ,RSS LEFT OR RIGHT ALF,ALF LEFT STA 1,I STORE WORD BACK ELB,CLE GET BYTE ADDRESS AGAIN JMP SBYTE,I RETURN SPC 2 ************************* * * * ENTER SYMBOL IN TABLE * * * ************************* ESYMT NOP STA MBIN1 SAVE NEGATIVE OF LENGTH OF ENTRY ADA SYMTF STA SYMTF MOVE SYMBOL TABLE START LOCATOR STA MBIN2 UP BY THE LENGTH OF ENTRY CMA,INA CHECK THAT THE SYMBOL TABLE AND ADA FCORE FOR TABLE DO NOT OVERLAP SSA,RSS JSB ERROR OVERLAP ERROR MER8 LDB MBUF POINTER TO REQD ENTRY LDA 1,I TRANSFER ENTRY TO THE SYMBOL STA MBIN2,I TABLE INB ISZ MBIN2 ISZ MBIN1 JMP MER8+1 JMP ESYMT,I RETURN ********************************* * * * SEARCH SYMBOL TABLE FOR ARRAY * * * ********************************* MSYMT NOP B GIVES ARRAY TYPE -3 = 1 DIM, STB MBIN1 -2 = 2DIM, -1 = UNDIMENSIONED :W LDA MBOX1 LOAD IDENTIFIER JSB SSYMT SEARCH SYMBOL TABLE SSB,RSS JMP MSYMT,I FOUND, RETURN ISZ MBIN1 IF ARRAY UNDIMENSIONED RSS JMP MSYM JUMP TO NOT FOUND EXIT ISZ MBIN1 SET UP TO CHECK THAT ARRAY DOES AND .15 SZA,RSS STRING? JMP MSYM YES, DONT CHECK FURTHER LDA MBOX1 ADA .2 NOT APPEAR IN THE TABLE WITH ADA M1 DIFFERENT DIMENSIONS. CHANGE JSB SSYMT TYPE 2 TO 1 & TYPE 1 TO 2 AND SSB,RSS SEARCH AGAIN JSB ERROR FOUND, INCONSISTENT DIMENSIONS MSYM ISZ MSYMT NOT FOUND, INCREMENT RETURN JMP MSYMT,I ADDRESS AND RETURN * ************************************* * * * COMPUTE STORAGE REQUIRED BY ARRAY * * * ************************************* MDIM NOP STA 1 STORE PACKED DIMS. TEMPORALILY AND B377 STA TEMP8 STORE # OF COLUMNS LDA 1 ALF,ALF AND B377 A = # OF ROWS ALS DOUBLE FOR FLOATING POINT MPY TEMP8 COMPUTE 2*ROWS:COLUMNS SSA RESULT < 32768 ? JSB ERROR NO, ERROR DIMENSIONS TOO LARGE MER9 JMP MDIM,I YES, RETURN SKP ****************************** * * CHECK FOR COMMON BLOCK OVERFLOW * ****************************** * CKOVF NOP STA TEMP5 .SAVE BLOCK SIZE ADA PBPTR .WILL WE ADA .256 . DESTROY CMA,INA . THE PROGRAM ADA LWBM . IF WE CONTINUE SSA . JMP MER7-1 .YES ERROR LDA TEMP5 JMP CKOVF,I .NO - EXIT * .256 DEC 256 SKP *********************** * * * PRINT ERROR MESSAGE * * * *********************** ERROR NOP LDB ERROR ERROR SOURCE IN (B) LDA ERBS ERROR ADDRESS IN (A) INA MOVE TO NEXT̽$" ERROR CPB 0,I SAME AS ACTUAL ERROR? CMA,INA,RSS YES, MAKE ERROR NEGATIVE JMP *-3 NO ADA ERBS MAKE ERROR POSITIVE CMA,INA ADA .34 ADJUST FOR SEG 1 ERRORS STA TEMP3 SAVE IT JMP OUTER PRINT ERROR MESSAGE *************** * * * ERROR TABLE * * * *************** ERR DEF MER5A COM STATEMENT OUT OF ORDER DEF MER4 FUNCTION DEFINED TWICE DEF MER6 UNMATCHED FOR DEF MER3 NEXT WITHOUT MATCHING FOR DEF MSYM DIMENSIONS NOT COMPATIBLE DEF MLOP6 LAST STATEMENT NOT 'END' DEF MER5 VARIABLE DIMENSIONED TWICE DEF MER10 ARRAY OF UNKNOWN DIMENSIONS DEF MER9 ARRAY TOO LARGE DEF MER7 OUT OF STORAGE DEF MER8 SYMBOL TABLE OVERFLOW SKP MBOX1 EQU TEMPS MBIN1 EQU TEMPT+1 MBIN2 EQU TEMPT+2 MNPTR EQU TEMPT+3 TYP EQU TEMPT+4 NAME EQU TEMPT+5 SC EQU TEMPT+8 LU EQU TEMPT+9 COML EQU TEMPT+10 MWDNO EQU TEMPT+11 MPTR EQU SBPTR FERR EQU TEMPS+1 TEMP1 EQU TEMPS+2 TEMP2 EQU TEMPS+3 TEMP3 EQU TEMPS+4 TEMP4 EQU TEMPS+5 TEMP5 EQU TEMPS+6 TEMP6 EQU TEMPS+7 TEMP7 EQU TEMPS+8 TEMP8 EQU TEMPS+9 TEMP9 EQU TEMPS+10 TEM10 EQU TEMPS+11 * END $ `t 92065-18005 1805 S C0522 &MBC4O RTE-M BASIC EXECUTE SUBR             H0105 SASMB,R HED <> 92065-16001 NAM BASC4,7,99 92065-16007 REV. 1805 771020 * * DATE REVISED10-20-77 * * ************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * * PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ************************************************************** * * * SOURCE 92065-18005 * * ENT BASC4,ETAB,ERND,ESGN,ESWR,XERR,SERR,OCT,TIM ENT ETYP EXT FINDV,BCKSP,WRITE,DRQST,GETCR,MVTOH,OUTER EXT IFBRK,ENOUT,NUMCK,OUTCR,..FCM,INDCK,.IENT EXT OUTLN,OUTIN,TRAP,FCNEX,.MBT EXT PRNIN,SSYMT,FNDPS,.PACK,COMND EXT EXP,ALOG,RMPAR EXT EXEC,OLNCK,KEYBD EXT .FAD,.FSB,.FMP,.FDV,IFIX,FLOAT EXT BASC8 * COM TEMPS(30),PNTRS(61),SPEC(10) ***************************************** * * * SEGMENT #4: EXECUTE THE PROGRAM * * * ***************************************** * * THIS PART OF THE INTERPRETER IS LOADED BY THE BASIC MAIN CONTROL * AFTER THE SUCCESSFUL COMPLETION OF THE PRE-EXECUTION PROCESSING * SEGMENT. IT WILL EXECUTE THE USER PROGRAM, LINE BY LINE, BY * EXAMINING THE TRANSLITERATED CODE AND BRANCHING TO THE VARIOUS * EXECUTION SUBROUTINES. UPON COMPLETION, IT RETURNS EXECUTION TO * THE MAIN CONTROL PROGRAM. SKP *************************** * * * CONSTANTS AND VARIABLES * * * *************************** * FWAM EQU PNTRS FIRST WORD OF AVAILABLE MEMORY LWBM EQU PNTRS+1 LAST WORD OF AVAILABLE MEMORY .INBF EQU PNTRS+2 INPUT BUFFER ADDRESS SBUFA EQU PNTRS+3 SYNTAX BUFFER ADDRESS SYMTA EQU PNTRS+4 START OF SYMBOL TABLE SYMTF EQU PNTRS+5 END OF SYMdBOL TABLE PBUFF EQU PNTRS+6 FIRST WORD OF USER PROGRAM PBPTR EQU PNTRS+7 LAST WORD+1 OF USER PROGRAM INBFA EQU PNTRS+8 INPUT BUFFER POINTER ICCNT EQU PNTRS+9 INPUT CHARACTER COUNT SBPTR EQU PNTRS+10 SYNTAX BUFFER POINTER .LNUM EQU PNTRS+11 CURRENT LINE # FCORE EQU PNTRS+12 START OF FREE CORE MNNAM EQU PNTRS+13 MNEMONIC TABLE NAME:SC:LU BRNAM EQU PNTRS+18 BRANCH TABLE NAME:SC:LU FWAMM EQU PNTRS+23 POINTER TO START OF MNEMONIC TABLE FWAMB EQU PNTRS+24 POINTER TO START OF BRANCH TABLE .OTBF EQU PNTRS+25 POINTER TO OUTPUT BUFFER OCCNT EQU PNTRS+26 OUTPUT CHARACTER COUNT OTBFA EQU PNTRS+27 POINTER INTO OUTPUT BUFFER LUOUT EQU PNTRS+28 CURRENT OUTPUT L.U. # LUINP EQU PNTRS+29 CURRENT INPUT L.U. # SIGN EQU PNTRS+30 SIGN OF CURRENT NUMBER BLANK EQU PNTRS+31 CURRENT TERMINATION CHAR REC# EQU PNTRS+32 COMMAND FILE RECORD NUMBER FLTYP EQU PNTRS+33 TYPE 0 FILE FLAG TTYPR EQU PNTRS+34 CONSOLE TTY L.U. # PRINT EQU PNTRS+35 LISTING L.U. # READR EQU PNTRS+36 AUXILLIARY INPUT L.U. # PUNCH EQU PNTRS+37 AUXILLIARY OUTPUT L.U. # ERTTY EQU PNTRS+38 ERROR LIST OUTPUT L.U. # DCB EQU PNTRS+39 DATA CONTROL BLOCK ADDRESS FILBK EQU PNTRS+40 FILE CONTROL BLOCK ADDRESS PFLAG EQU PNTRS+41 SAVE,LOAD FILE FLAG LOLIM EQU PNTRS+42 LOW LIMITS OF PROGRAM HILIM EQU PNTRS+43 HIGH LIMITS OF PROGRAM LORUN EQU PNTRS+44 LOW RUN LIMITS HIRUN EQU PNTRS+45 HIGH RUN LIMITS SLSTM EQU PNTRS+46 EXECUTE SLOW STMTS LOTRC EQU PNTRS+47 LOW TRACE LIMITS HITRC EQU PNTRS+48 HIGH TRACE LIMITS BRKP1 EQU PNTRS+49 BREAK POINT #1 BRKP2 EQU PNTRS+50 BREAK POINT #2 BRKP3 EQU PNTRS+51 BREAK POINT #3 BRKP4 EQU PNTRS+52 BREAK POINT #4 SMFLG EQU PNTRS+53 SIMULATE FLAG TYPE EQU PNTRS+54 PARTIAL LINE CHARACTER COUNT DLMTR EQU PNTRS+55 CHAR EDIT DELIMITER MERGF EQU PNTRS+56 MERGE FLAG SKP HSTPT BSS 1 HIGH-STACK POINTER TSTPT BSS 1 TEMPORARY STACK POINTER LSTPT BSS 1 LOW-STACK POINTER LSTAK BSS 1 LOW-STACK ADDRESS PRADD BSS 1 PROGRAM EXECUTION NXTST BSS 1 SEQUENCING INFORMATION DSTRT BSS 1 DATA NXTDT BSS 1 STATEMENT DCCNT BSS 1 POINTERS SPC 1 SUP PRESS MULTIPLES LISTING SPC 1 XH BSS 1 XL BSS 1 TT1 BSS 1 TT2 BSS 1 TT3 BSS 1 TT4 BSS 1 EOL BSS 1 TAB END-OF-LINE FLAG STRFG BSS 1 STRING CONSTANT FLAG * FOPBS DEF QUOTE-1 ARBAS DEF AROTB-6,I XECBR DEF XECTB-26,I ADATA DEF DATA FINCA DEF FINCH ADDRESS OF FETCH INPUT ROUTINE FSCHA DEF FSCH ADDRESS OF FETCH SOURCE CHAR ROUTINE * TRMSA DEF *+1 TRACE ASC 4,*TRACE A EQU 0 B EQU 1 SKP .1 DEC 1 .2 DEC 2 .3 DEC 3 .6 DEC 6 .10 DEC 10 .15 DEC 15 .20 DEC 20 .32 DEC 32 LFTAR OCT 137 CTRLQ OCT 21 B40 EQU .32 B42 OCT 42 B77 OCT 77 B377 OCT 377 B777 OCT 777 B2000 OCT 2000 RSS OCT 2001 B3000 OCT 3000 SCCNT OCT 3002 DATA OCT 51004 DATOP OCT 51000 ENDOP OCT 45000 #OP OCT 17000 SPLOP OCT 65000 OPMSK OCT 77000 ATMSK OCT 10000 INF OCT 77777 INTFL OCT 100003 OPDMK OCT 100777 WRFLG OCT 100001 M1 DEC -1 M2 DEC -2 M3 DEC -3 M6 DEC -6 M15 DEC -15 M20 DEC -20 M21 DEC -21 D31 OCT -31 M73 DEC -73 M256 DEC -256 M1000 DEC -1000 HALF OCT 40000 OCT 0 HONE EQU HALF MNEG OCT 100000 MAXIMUM NEGATIVE FLOATING OCT 376 POINT NUMBER FLGBT EQU MNEG HIMSK EQU M256 AFCNX DEF FCNEX ADDRESS OF BRANCH ENTRIES FOR FUNCTIONS SKP *************************** * * * EXECUTION BRANCH TABLES * * * *************************** * * THE EXECUTION BRANCH TABLES ARE THE BASIS FOR EXECUTING A BASIC * USER PROGRAM. FOR EACH OPERATOR IN BASIC THERE IS A UNIQUE CODE * NUMBER. THIS CODE NUMBER, WHEN ADDED TO A REFERENCE ADDRESS, , * FORMS A POINTER TO ONE OF THE ADDRESSES IN THESE BRANCH TABLES. * THE ADDRESS WHICH IS POINTED TO IN THE TABLE, IS THE ADDRESS OF * THE CORRESPONDING EXECUTION SUBROUTINE. * XECTB DEF ELET LET DEF XEC4 DIM DEF XEC4 COM DEF XEC4 DEF DEF XEC4 REM DEF EGOTO GO TO DEF EIF IF DEF EFOR FOR DEF ENEXT NEXT DEF EGOSB GOSUB DEF ERTRN RETURN DEF EEND END DEF EEND STOP DEF EWAIT WAIT DEF ECALL CALL DEF XEC4 DATA DEF EREAD READ DEF EPRIN PRINT DEF EINPT INPUT DEF ERSTR RESTORE DEF EPAZ PAUSE DEF XEC4 FAIL DEF EGOTO THEN DEF XEC4 USING NOP .PLACE HOLDERS NOP NOP DEF 0 SPECIAL SYNTAX DEF ETRAP TRAP * SKP DEF FORMX,I EXIT ON EMPTY STACK BSS 5 DUMMY ADDRESSES AROTB DEF ESCMA SUBSCRIPT SEPARATOR DEF ESTR ASSIGNMENT OPERATOR DEF EFAD '+' DEF EFSB '-' DEF EFMP '*' DEF EFDV '/' DEF EPWR '^' DEF EGTRT '>' DEF ELST '<' DEF ENEQL '#' DEF EEQL '=' DEF EUMIN UNARY '-' DEF ELBRC '[' DEF FORM1 '(' DEF FOR11 UNARY '+' DEF EOR OR DEF EAND AND DEF ENOT NOT DEF EGORE '>=' DEF ELORE '<=' * SKP ***************************** * * * OPERATOR PRECEDENCE TABLE * * * ***************************** * * THIS TABLE IS USED BY THE FORMULA EVALUATION SUBROUTINE TO * DETERMINE THE HIERARCHICAL PRECEDENCE OF THE FORMULA-TYPE * OPERATORS. BITS 15-9 OF THE LABELLED WORD ARE THE BASIC * CODE OPERATOR AND BITS 3-0 ARE THE PRECEDENCE FOR THE * OPERATOR. QUOTE OCT 1000 COMMA OCT 2000 SEMIC OCT 3000 * RPARN OCT 4001 RBRAC OCT 5001 SCVMMA OCT 6002 ASSOP OCT 7002 PLUS OCT 10007 MINUS OCT 11007 TIMES OCT 12010 DIV OCT 13010 EXPS OCT 14012 GTR OCT 15005 LSS OCT 16005 UNEQL OCT 17005 EQUAL OCT 20005 UNMIN OCT 21011 LBRAC OCT 22020 LPARN OCT 23020 UPLUS OCT 24011 OROP OCT 25003 ANDOP OCT 26004 NOTOP OCT 27011 GTREQ OCT 30005 LSSEQ OCT 31005 * SKP *********************** * * * EXECUTE THE PROGRAM * * * *********************** BASC4 NOP CPB M1 (B)=-1 IF TRAP TABLE IS BUSY RSS YES ITS BUSY SO DONT ALLOW TRAP POLING JMP BASX NO, OK TO USE IT LDA RSS STORE RSS IN 'JSB TRAP' STA TRAPX STA ETRAP BASX LDA SLSTM RETURN SZA FROM SEGMENT 7 OR 8? JMP XEC4 YES, CONTINUE WITH NEXT STMT * * LDA FWAM SET FOR RANDOM NUMBER GENERATOR STA XH INITIALIZE INA RANDOM STA XL VARIABLE SPC 1 * INITIALIZE THE DATA POINTER SPC 1 CCA SET STA DCCNT 'NO STA DSTRT DATA' LDB PBUFF CONDITION STB NXTDT LDA ADATA,I SEARCH FOR FIRST JSB STSRH DATA STATEMENT JMP XEC2 NONE FOUND STB DSTRT SAVE STATEMENT LOCATION JSB SETDP SET DATA POINTER SPC 1 * INITIALIZE STACK POINTERS SPC 1 XEC2 JSB SETPT INITIALIZE PTRS LDA LORUN FIRST STMNT CPA .1 OF PROGRAM? JMP XEC3 YES! JSB FNDPS NO, FIND IT NOP JMP XEC5-1 CAN'T FIND IT * XEC3 LDA 1,I GET FIRST STATEMENT NUMBER STA NXTST AND SET UP FOR STB TEMP1 POINTERS JMP XEC5 SKP * FIND NEXT STATEMENT TO BE EXECUTED SPC 1 XEC4 LDA TTYPR RESTORE STA LUINP CONSOLE STA LUOUT LOGICAL UNITS LDA FCORE SET TEMPORARY STVA TSTPT STACK POINTER LDA NXTST XEC44 SZA,RSS END OF PROGRAM? JMP EEND YES LDB HIRUN .CHECK FOR RUN LIMIT CMB ADB A .BEYOND THE LIMIT ? SSB,RSS JMP EEND .YES - END LDB PRADD PROSPECTIVE ADDRESS CPA 1,I DESIRED STATEMENT? JMP XEC6 YES XEC43 JSB FNDPS NO, FIND STATEMENT NOP NON-EXISTENT JSB ERROR STATEMENT XEC5 LDA 1,I GET NEW LINE NO. XEC6 STA .LNUM STB TEMP1 * LDB 1717B GET ID SEG ADDRESS ADB .20 GET ADDRESS OF THE RIGHT WORD LDA 1,I GET THE WORD AND ATMSK OPERATOR ATTENTION SZA FLAG SET? JMP OPEND YES, STOP THE PRESSES! LDB TEMP1 RESTORE B WITH ADDR OF NEXT STATEMENT LDA M1000 STA FILE# .SET TO STANDARD I/O TRAPX JSB TRAP CHECK FOR INTERRUPT JMP TRERR ERROR RETURN SSA,RSS JMP EGOS2 INTERRUPT, DO GOSUB JSB FLWST SETSX LDA TEMPS,I AND OPMSK EXTRACT STATEMENT TYPE CONT ALF,ALF POSITION RAR IT ADA XECBR COMPUTE EXECUTION ADDRESS JMP 0,I BRANCH TO EXECUTION CODE SKP ***************** * * ** EXECUTE LET ** * * ***************** * * ELET CLA,INA ENABLE FOR STRING CONSTANT STA STRFG IN FORMULA JSB FORMX JMP XEC4 * * ******************* * * ** EXECUTE FOR ** * * ******************* * EFOR JSB FVSRH FOR-VARIABLE ALREADY IN STACK? JMP EFOR1 NO STA TEMP2 YES, SAVE SOURCE ADDRESS ADA .6 SAVE STA TEMP4 DESTINATION ADDRESS STB TEMP1 SAVE FOR-VARIABLE ADDRESS JSB MVTOH COMPRESS STACK LDB TEMP1 RESTORE FOR-VARIABLE ADDRESS CLA,RSS COMPUTE NEW EFOR1 LDA M6 TOP OF ADA HSTPT FOR-STACK STA HSTPT POINTER STA TEMP1 CMA,INA STACK ADA LSTPT SSA,RSS OVERFLOW? JMP E1 YES. ERROR 57. STB TEMP1,I NO, RECORD FOR-VARIABLE ADDRESS JSB FORMX INITIALIZE FOR-VARIABLE ISZ TEMPS ISZ TEMP1 SAVE LDA TEMP1 LIMIT STA ENEX2+1 ADDRESS JSB FETCH FETCH STA TEMP1,I AND ISZ TEMP1 STORE STB TEMP1,I LIMIT ISZ TEMP1 LDB M2 SET FOR STEP SIZE STB FDATA SIGN CHECK LDA TEMPS,I LOOK FOR SZA FOLLOWING ' STEP' JMP EFOR2 FOUND LDA HONE NOT FOUND, CMB,INB,RSS DEFAULT IS 1.0 EFOR2 JSB FETCH SSA STEP SIZE NEGATIVE? ISZ FDATA YES STA TEMP1,I SAVE ISZ TEMP1 STEP STB TEMP1,I SIZE ISZ TEMP1 SET POINTER LDA NXTST TO STATEMENT STA TEMP1,I FOLLOWING THE FOR EFOR3 LDA NEXTX FIND LDB PRADD 'NEXT' JSB STSRH STATEMENT NOP JSB FLWST FIND FOLLOWING STATEMENT AND B777 SAME CPA ETAB FOR-VARIABLE? RSS YES JMP EFOR3 NO LDB HSTPT,I LOAD DLD 1,I LOAD VALUE OF FOR VARIABLE JMP ENEX2-2 CHECK ACCEPTABILITY * * NEXTX OCT 42004 * ** EXECUTE NEXT ** * ENEXT JSB FVSRH FIND CORRESPONDING STACK ENTRY JMP XEC4 NONE PRESENT STA HSTPT RESET TOP OF STACK STB ENEX1+1 SAVE FOR-VARIABLE ADDRESS INA SAVE LIMIT STA ENEX2+1 ADDRESS ADA .2 SAVE STEP SIZE STA TEMP1 ADDRESS LDB M2 SET STEP SIZE STB FDATA SIGN CHECK LDA TEMP1,I LOAD ISZ TEMP1 STEP LDB TEMP1,I SIZE ISZ TEMP1 SSA CHECK ISZ FDATA SIGN ENEX1 JSB .FAD INCREMENT FOR-VARIABLE NOP DST ENEX1+1,I AND SAVE VALUE STA EFMT STB NFMT ENEX2 JSB .FSB COMPUTE FOR-VARIABLE - LIMIT NOP ISZ FDATA POSITIVE STEP SIZE? ELA YES, COMPLEMENT SIGN SSA NO, NON-NEGATIVE RESULT? JMP ENEX3 NO LDA TEMP1,I YES, GO TO FIRST STA NXTST JMP XEC4 STATEMENT OF LOOP * ENEX3 LDA HSTPT FAILS, ADA .6 ERASE STA HSTPT STACK ENTRY JMP XEC4 SKP ***************** * * * EXECUTE PRINT * * * ***************** EPRIN LDA HSTPT SAVE HI STK PTR IN CASE STA HTEMP OF END-OF-FILE EXIT JSB VALLU .A #,LU ? STA LUOUT .YES - SAVE * EPR01 JSB PRNIN INITIALIZE OUTPUT BUFFER JSB FLUPT FIND ANY PARTIAL LINE FLAG AND B377 AND ISOLATE THE STA TYPE CHARACTER COUNT CLA,RSS TURN ON EPR02 CCA TURN OFF STA EOL END-OF-LINE FLAG EPR04 LDB TEMPS MORE CPB PRADD STATEMENT? JMP EPR19 NO,EXIT PRINT EXECUTION LDA 1,I AND OPDMK EXTRACT OPERAND SZA NULL JMP EPR07 NO,GO TO EVALUATION EPR05 LDB TEMPS INB CPB PRADD MORE STATEMENT? JMP EPR19 NO, EXIT PRINT PROCESSING LDA 1,I YES, EXTRACT AND OPMSK OPERATOR CPA B2000 "," ? JMP EPR10 YES,GO TO COMMA EXECUTION CPA B3000 ";" ? JMP EPR14 YES, TURN OFF END-LINE FLAG CPA ENDOP "END" JMP EPR19 .EXIT PRINT OPERATION I/O SZA NULL OPERATOR? JMP EPR07 NO,EVALUATE FORMULA EPR06 ISZ TEMPS YES, STEP CODE POINTER, JMP EPR04 AND EXAMINE OPERANND. * EPR07 CLA,INA STA STRFG ALLLOW STRING CONSTANTS CCA AND PRESET TAB FLAG STA EOL ug JSB FORMX EVALUATE NEXT EXPRESSION ISZ EOL WAS IT A TAB? JMP EPR12 YES, EXECUTION DONE LDB HSTPT,I WAS IT A STRING? SSB JMP EPR11 YES, GO PROCESS IT JSB OPCHK QUALIFY THE OPERAND DLD 1,I NO JSB ENOUT OUTPUT THE NUMBER CLA AND REMEMBER THAT STA TABFG IT WAS NUMERIC OUTPUT JMP EPR12 * EPR12 ISZ HSTPT POP VARIABLE PTR OFF HI STK JMP EPR05 * EPR10 CLA CPA EOL WAS THERE A TAB LAST? JSB EDELM NO,EXECUTE COMMA CLA,INA STA TABFG EPR14 ISZ TEMPS STEP CODE POINTER JMP EPR02 AND TURN OFF END-LINE FLAG * EPR11 LDA M2 PREPARE JSB PSTR PRINT STA TEMP8 STRING STB TPRME LDB TEMPS ADB M1 STB TEMPS LDB M3 LDA TNULL NO,GET STRING LENGTH CMA STA EDELM AND SAVE FOR LATER JSB OLNCK CHECK LINE OVERFLOW LDA .OTBF FIGURE STARTING CLE,ELA CHARACTER ADA OCCNT ADDRESS STA TEMP5 FOR TRSTR ADA EDELM UPDATE OUTPUT CLE,ERA POINTER SEZ,RSS ADA M1 STA OTBFA SINCE TRSTR WON'T LDA OCCNT AND ALSO ADA EDELM UPDATE THE STA OCCNT CHAR COUNT LDA FSCHA JSB TRSTR OUTPUT THE CHARACTERS CLA,INA STA TABFG AND REMEMBER NO BACKSPACING JMP EPR05 EXAMINE THIS OPERATOR * EPR19 CLA ISZ EOL TERMINATE THIS LINE? JMP EPR20 YES,GO TO OUTPUT LDA LUOUT IS THIS AND B77 A JSB FINDV LINEPRINTER? CPA .10 JMP EPR15 YES! LDA LFTAR NO, ADD TRAILING JSB OUTCR LEFT ARROW LDB M1 AND CORRECT FOR IT EPR21 ADB OCCNT MANUFACTURE ADB TYPE LOGICAL UNIT LDA LUOUT ( AND COUNT AND B77 WORD INCLUDING ALF,ALF ALL CHARACTERS IOR 1 OUTPUT, EXCEPT '_' EPR20 STA TEMP1,I UPDATE OR RELEASE LU/COUNT WORD JSB OUTLN AND OUTPUT THIS RECORD JMP XEC4 * EPR15 LDA LUOUT SET IOR B2000 HONESTY STA LUOUT MODE CLB JMP EPR21 * * * VALIDATE LU # FOR READ AND PRINT * * VALLU NOP LDA M1000 .PRESET FOR NON #,LU CASE STA FILE# LDA TEMPS .LOOK FOR # OPERAND INA LDA A,I AND OPMSK CPA #OP .DO WE HAVE A # ? RSS .FOUND IT - FETCH LU VALUE JMP VAL1 .NOT FOUND LET LU BE STA FILE# .SET TO ALTERNATE LU # ISZ TEMPS .MOVE TO EVALUATE LU CLA STA STRFG .DISABLE STRINGS JSB FETCH .FETCH LU VALUE JSB IFIX .CONVERT TO INTEGER STA VAL2 .SAVE RESULT ISZ TEMPS .SKIP OVER NULL RECORD LDA TEMPS,I FETCH SEMICOLON CPA B3000 .VARIABLE ATTACHED? JMP VAL3 .CHECK FOR STRING CONSTANT FOLLOWING VAL4 LDA VAL2 .RESTORE VALUE JMP VALLU,I & EXIT VAL1 ISZ VALLU .JMP OVER LU SET JMP VALLU,I VAL2 NOP * VAL3 LDB TEMPS .THIS IS AKLUDGE TO COMPENSATE INB . FOR FORMX LDA B,I .CHECK TO SEE IF NEXT DATA AND OPMSK . IS A STRING CONSTANT ALF,ALF . IF IT IS DO NOT INCREMENT TEMPS CPA .2 JMP VAL4 ISZ TEMPS .IF IT NOT ,SKIP OVER 3000 IN JMP VAL4 . INTERPRETTIVE CODE * SKP *********************** * * * FIND LU/COUNT WORD * * * *********************** * FLUPT NOP LDA LUOUT CREATE THE AND B77 SEARCH TARGET STA LUTMP LDB M20 INITIALIZE STB TEMP7 COUNTER ADB FCORE AND FIGURE START OB@ LOW BYTE AND B377 AND ISOLATE THE BYTE CPA .32 6 IS IT A BLANK ? RSS YES JMP TABXT NO, QUIT NOW ADB M1 BACK UP STB OCCNT ONE CHARACTER SLB NEW WORD ? JMP ETAB4 NO LDA OTBFA YES ADA M1 STEP BUFFER POINTER STA OTBFA BACK TOO ETAB4 ISZ TEMP3 COUNT BLANKS REMOVED JMP ETAB3 AND CONTINUE JMP TABXT UNLESS COUNT EXHAUSTED SKP ********************* * ** *** EXECUTE NOT ** ** * ********************* * ENOT JSB STTOP LOAD OPERAND JMP EEQL1 ********************* * ** *** EXECUTE AND ** ** * ********************* EAND JSB BINOP VALIDATE JMP *+2 OPERANDS NOP ANDS SZA,RSS FIRST OPERAND ZERO? JMP FALSE YES LDA ANDS-1,I JMP ENEQ1 CHECK SECOND OPERAND ********************* * ** *** EXECUTE OR ** ** * ********************* EOR JSB BINOP VALIDATE JMP *+2 NOP IOR *-1,I TRUE IF EITHER OPND JMP ENEQ1 NON-ZERO. SKP ****************** * * ** EXECUTE IF ** * * ****************** * EIF DLD TEMPS,I CPB EOFOP .END OF FILE CHECK? SSA .EOF RETURNED? CLA,INA,RSS ALLOW STRING JMP EIF1 .YES! STA STRFG CONSTANTS! JSB FETCH FETCH VALUE OF FORMULA STA EFMT SAVE RESULT FOR SINGLE STEPPING STB NFMT SZA,RSS RESULTANT TRUE? JMP XEC4 NO ISZ TEMPS ADVANCE TO NEXT OPERATOR EIF4 LDB TEMPS (B) = PTR TO INTERP. CODE JMP SETSX GO EVALUATE 'THEN' PART * EIF1 ISZ TEMPS JSB VALLU .FETCH LU # NOP . < SYNTAX SEG CHECKS FOR '#LU' > STA EIF2 .SET LU # JSB EXEC DEF EIF5 .MAKE A STATUS CALL ON THE DEVICE DEF .13 DEF EIF2 DEF EIF3 EIF5 LDA EIF3 ALF,ALF .P{NOSITION EOF BIT TO BIT 15 SSA JMP EIF4 .TRUE - DO THEN PART ALS,ALS .SHIFT TO EOT BIT SSA,RSS .SET? JMP XEC4 .FALSE - DO NEXT STATEMENT JMP EIF4 .TRUE - DO THEN PART .13 DEC 13 EIF2 NOP .LU NUMBER EIF3 NOP .STATUS WORD EOFOP OCT 62000 .EOF OPERATOR CODE * ********************* * * ** EXECUTE GO TO ** * * ********************* * EGOTO CLA SET FLAG TO 'GOTO' MODE JMP EGOS0 FIND REFERENCED STATEMENT SKP ********************* * * ** EXECUTE INPUT ** * * ********************* * EINP1 JSB WDRQS PRINT '?' AS WARNING JSB DRQST YES, CALL FOR MORE JSB QCHEK CHECK FOR STOP CHARACTER EINP2 JSB CONST CONVERT AND STORE NUMBER JMP EINP1 NOT NUMBER LDB TEMPS END-OF- INB CPB PRADD STATEMENT? JMP EIN15 YES CPA .10 NO, INSURE MORE INPUT EINPT JSB DRQST CALL FOR INPUT JSB QCHEK CHECK FOR STOP CHARACTER EINP5 LDA TEMPS,I .CHECK FOR NULL RECORD SZA,RSS . IF NULL THEN SKIP OVER JMP EINP6 JSB FORMX COMPUTE VARIABLE ADDRESS LDB HSTPT,I IS IT A SSB STRING VARIABLE? JMP EINP4 YES! ADB M1 STORE ISZ HSTPT ADDRESS-1 IN STB SBPTR POINTER JMP EINP2 EINP6 ISZ TEMPS JMP EINP5 * EINP4 CMB EXTRACT LDA 1,I PHYSICAL LENGTH ALF,ALF LENGTH OF AND B377 DESTINATION STRING CMA SET IT AS END ADA TSTPT,I OF UNSPECIFIED STA TPRME DESTINATION STRING CCA PREPARE JSB PSTR DESTINATION STRING LDB TNULL SAVE LENGTH STB TEMP7 ALLOWANCE EIN14 JSB GETCR FETCH CHARACTER NOP CPA B42 QUl3OTE? RSS YES! JSB BCKSP NO,STRING BEGINS HERE CLB TURN OFF STB BLANK SUPPRESSION LDA FINCA ADDRESS OF INPUT ROUTINE JSB TRSTR TRANSFER STRING CLB ALL REQUESTED CPB TNULL CHARACTERS TRANSFERRED JMP EIN10 YES! CPB PS1 NO,TRANSFER LENGTH SPECIFIED JMP EINP9 NO STA TEMP7 YES, SAVE (A) CCA FINISH STA TPRME ADA TNULL TRANSFER STA TNULL LDA FSCHA WITH BLANKS JSB TRSTR LDA TEMP7 RESTORE (A) EINP7 CPA .10 TRANSFER ENDED BY END-OF-INPUT JMP EIN13 YES! EINP8 JSB GETCR NO, WAS IT A QUOTE LDA .10 EXIT WITH JMP EIN13 NEXT CHARACTER EINP9 LDB TEMP6,I SET LOGICAL ADB TNULL TO ACTUAL STB TEMP6,I STRING LENGTH JMP EINP7 EIN10 CPB PS1 LENGTH OF STRING SPECIFIED? JMP EIN12 NO! EIN11 JSB GETCR YES! JMP EIN13 IMPLIED CLOSING QUOTE CPA B42 QUOTE? JMP EINP8 YES! JMP EIN11 NO, LOOK FOR " OR END-OF-INPUT EIN12 JSB GETCR END-OF-INPUT NEXT? JMP EIN13 YES! CPA B42 NO,CLOSING QUOTE? JMP EINP8 YES! LDA TEMP7 NO, DESTINATION STRING EXCEEDED! STA TNULL RESTORE LDA SBPTR DESTINATION STRING STA TEMP5 PARAMETERS LDA B40 SET TO SKIP BLANKS STA BLANK JSB WDRQS PRINT EXTRA QUESTION MARK AS WARNING JSB DRQST GET A NEW DATA RECORD JSB QCHEK AND CHECK FOR STOP CHARACTER JMP EIN14 * EIN13 LDB B40 RESTORE STB BLANK BLANK SUPRESSION JMP EINP2+2 * * RESET PARTIAL LINE FLAG PENDING ON LUINP * EIN15 LDA LUINP .SET LUOUT = LUINP STA LUOUT JSB FLUPT .CHECK FOR ANY PARTIAL LINE FLAG SZA,RSS JMP XEC4 .NONE - NEXT STATEMENT  CLA STA 1,I .YES - RESET FLAG JMP XEC4 .NOW THEN NEXT STATEMENT * * QCHEK NOP LDA .INBF,I FETCH FIRST WORD ALF,ALF POSITION FIRST BYTE AND B377 AND ISOLATE IT CPA CTRLQ IS IT A '^Q' ? JMP OPEND YES, TAKE ORDERLY ABORT EXIT JMP QCHEK,I NO, RETURN SKP * * OUTPUT WARNING ? IF KEYBOARD DEVICE * WDRQS NOP LDA LUINP .CHECK FOR CRT DEVICE JSB KEYBD JMP E13-1 .NOT A KEYBOARD - ISSUE ERROR LDA M2 LDB QMRKA .PRINT ? JSB WRITE JMP WDRQS,I .AND RETURN * QMRKA DEF QMARK QMARK ASC 1,?_ * * ******************** * * ** EXECUTE TRAP ** * * ******************** * ETRAP NOP RSS SKIP ERROR MESSAGE IF NOT BUSY JSB ERROR TRAP TABLE BUSY TERR4 EQU * JSB FETCH GET TRAP # JSB IFIX MAKE INTEGER CMA,INA MAKE NEGATIVE STA TEMP4 SAVE IT LDB TEMPS ADB .2 SKIP OVER 'GOSUB' AND FLAG LDA 1,I GET SEQ NO. STA TEMP5 SAVE IT SSA POSITIVE? CMA,INA NO, MAKE IT SO JSB FNDPS MAKE SURE JMP XEC5-1 STATEMENT JMP XEC5-1 EXISTS LDB TEMP5 GET SEQ NO. LDA TEMP4 GET TRAP NO. JSB TRAP SET UP TRAP VS. SEQ NO. TRERR RSS TRAP ERROR JMP XEC4 CPA .1 TRAP TABLE FULL? JSB ERROR YES! TERR1 CPA .2 ILLEGAL TRAP COMBINATION? JSB ERROR YES! TERR2 JSB ERROR NO, MUST BE SCHEDULED BUT DELETED TASKED TERR3 EQU * SKP ********************* * * ** EXECUTE GOSUB ** * * ********************* * EGOSB CCA SET FLAG TO EGOS0 STA RFLAG 'GOSUB' MODE LDA 1,I INB SIMPLE BRANCH AND OPDMK STATEMENT? CPA INTFL JMP EGOS1 YES! JSB FETCH NO, COMPUTE JSB SBFIX BRANCH INDEX JMP XEC4 UNSUITABLE RESULT LDB 0 BLS COMPUTE ADB TEMPS 'ADDRESS' ADB .2 ADDRESS LDA 1 CMA WITHIN ADA PRADD STATEMENT RANGE SSA JMP XEC4 NO! EGOS1 LDA 1,I YES, LOADR BRANCH ADDRESS ISZ RFLAG 'GOTO' MODE? JMP EGOS3 YES LDB NXTST LOAD (B) WITH EGOS2 STA NXTST RETURN SEQUENCE NUMBER JSB SLWST STACK RETURN ON LOW-CORE STACK ADA M21 GOSUBS NESTED 20 DEEP? CPA LSTAK JSB ERROR YES! E2 JMP XEC4 NO! EGOS3 STA NXTST SAVE STMT # JMP XEC4 EXECUTE IT * * *********************** * * ** EXECUTE RESTORE ** * * *********************** * ERSTR LDA TEMPS,I CHECK TO SEE ISZ TEMPS IF THERE IS ANY LDB DSTRT DATA STATEMENTS CPB M1 IMPOSSIBLE ADDRESS? JMP XEC4 YES, SO IGNORE IT SSA,RSS FOLLOWED BY SEQ NUMBER JMP E7 NO! LDA TEMPS,I YES, SO USE IT JSB FNDPS CONVERT THE NOP TO ABSOLUTE CORE ADDRESS JMP XEC5-1 UNDEFINED STATEMENT REFERENCED LDA 1 FOUND A STATEMENT ADA .2 NOW CHECK TO LDA 0,I SEE IF AND OPMSK THIS IS CPA DATOP A DATA STATEMENTNT RSS YES IT IS! JSB ERROR NO, NOT A DATA STMNT E7 JSB SETDP SET DATA POINTERS JMP XEC4 DONE * ** *** EXECUTE A BINARY OPERATOR ** ** BINOP NOP JSB OPCHK VALIDATE TOP (SECOND) OPERAND LDA BINOP INA STB 0,I POST ITS ADDRESS ISZ HSTPT UNSTACK ADDRESS JSB STTOP LOAD & VALIDATE FIRST OPERAND JMP BINOP,I * ** *** EVALUATE FORMULA AND RETURN RESULT ** ** FETCH NOP m*($ JSB FORMX EVALUATE FORMULA JSB OPCHK ISZ HSTPT UNSTACK RESULT ADDRESS DLD 1,I LOAD (A&B) WITH VALUE JMP FETCH,I EXIT SKP  ********************************* * * ** EXECUTE SUBSCRIPT COMMA ** * * ******************************** ESCMA JSB ESBS INTEGERIZE COLUMN SUBSCRIPT ISZ LSTPT JSB ESBS INTEGERIZE ROW SUBSCRIPT LDB HSTPT,I SSB STRING VARIABLE? JMP ESCM2 YES! ADB .2 FETCH SUBSCRIPT LDA 1,I BOUNDS AND B377 EXTRACT STA OUTLN COLUMN BOUND LDA 1,I EXTRACT ALF,ALF ROW AND B377 BOUND CMA,INA ACTUAL ADA LSTPT,I ROW SUBSCRIPT SSA,RSS LEGAL? JMP E6-1 NO. ERROR 49. LDA LSTPT,I CLB,INB CPB OUTLN COLUMN MATRIX? JMP ESCM1 YES. MPY OUTLN NO, COMPUTE ADDRESS * DISPLACEMENT DUE TO ROWS ESCM1 CCB UNSTACK ADB LSTPT ROW STB LSTPT SUBSCRIPT LDB OUTLN ACTUAL CMB,INB COLUMN ADB LSTPT,I SUBSCRIPT SSB,RSS LEGAL? JSB ERROR NO. ERROR 49. E6 ADA LSTPT,I YES, ADD IN COLUMN DISPLACEMENT ALS DOUBLE DISPLACEMENT LDB HSTPT,I COMPUTE ADA 1,I ACTUAL STA HSTPT,I ADDRESS STB TEMP7 AND SAVE BASE FOR ECALL CCB ADB LSTPT UNSTACK STB LSTPT * JMP FORM1 GO TO FORMULA PROCESSOR * ESCM2 JSB RSCHK PUT STRING LDB M2 SUBSCRIPTS ADB LSTPT ON STB LSTPT TEMPORARY INB STACK DLD 1,I RRR 16 CORRECT ORDER DST TSTPT,I OF SUBSCRIPTS JMP FORM1 SKP ** *** INTEGERIZE A SUBSCRIPT ** ** ESBS NOP JSB OPCHK VALIDATE SUBSCRIPT DLD 1,I FETCH SUBSCRIPT JSB .IENT INTEGER? JMP E6-1 NO. ERROR 49. SEZ,RSS YES, ROUND AND ADA M1 BIAS BY -1 SSA POSITIVE INTEGER? JMP EBS1 CHECK FOR NEG SUBSCRIPT ERROR EBS2 STA LSTPT,I SAVE IN OPERATOR STACK ISZ HSTPT POP OPERAND STACK JMP ESBS,I EBS1 LDB HSTPT IS THIS ADB .2 A STRING LDB 1,I VARIABLE? SSB,RSS JMP E6-1 NO, ERROR NEG SUBSCRIPT! CPA M1 IF STRING -1 JMP EBS2 IS OK JMP E6-1 EVERY OTHER NEG VALUE BAD ** *** EXECUTE STORE ** ** ESTR LDB TEM10 IS NEXT OPERATOR SZB AN END-OF-FORMULA? JMP FOR10 NO, DEFER STORE CPB TEMP5 YES, FIRST STORE OPERATOR USED? JMP ESTR2 YES ESTR1 LDA HSTPT,I SET STA TEMP8 DESTINATION LDA TEMP5 SOURCE ADDRESS IN (A) LDB 0,I TRANSFER HIGH STB TEMP8,I PART OF SOURCE STB EFMT ISZ TEMP8 UPDATE INA POINTERS LDB 0,I TRANSFER LOW STB TEMP8,I PART OF SOURCE STB NFMT ISZ HSTPT POP STACK JMP FOR11 RETURN TO FORMULA OCESSOR * ESTR2 LDA HSTPT,I STRING OPERANDS SSA JMP ESTR3 YES! JSB OPCHK SAVE ADDRESS STB TEMP5 OF QUANTITY ISZ HSTPT POP HIGH-CORE JMP ESTR1 STACK AND EXECUTE STORE * ESTR3 LDA M2 PREPARE JSB PSTR SOURCE STA TEMP8 STRING STB TPRME CCA PREPARE JSB PSTR DESTINATION STRING LDB PBPTR SAVE CORE POINTER STB EST1 LDA TEMP8 TRANSFER CMA TO ADA TEMP5 HIGHER SSA CORE? JMP ESTR4 NO ADA TPRME YES ADA .2 OVERLAPPING SSA,RSS TRANSFER? JMP ESTR4 NO LDA TEMP5 YES, SAVE STA EST2 DESTINATION ADDRESS INB SET DESTINATION r BLS ADDRESS TO START STB TEMP5 OF FREE CORE LDA TNULL SAVE TRANSFER STA EST3 LENGTH CMA,INA ALLOCATE ARS SPACE FOR JSB OVCHK INTERMEDIATE LDA FSCHA STRING JSB TRSTR TRANSFER STRING TO FREE CORE LDA EST3 RESTORE TRANSFER STA TNULL LENGTH STA TPRME RESET ACTUAL SOURCE LENGTH LDA EST1 SET SOURCE INA ADDRESS TO ALS INTERMEDIATE STA TEMP8 STRING LDA EST2 RESTORE ORIGINAL STA TEMP5 DESTINATION STRING ESTR4 LDA FSCHA JSB TRSTR COMPLETE TRANSFER LDA EST1 RESTORE FREE STA PBPTR CORE POINTER JMP FORM9 EXECUTE END-OF-FORMULA ISZ PBPTR DEFER ISZ PBPTR EXECUTION LDA BASSO GUARANTEE ASSIGNMENT STA PBPTR,I OPERATOR ON STACK JMP FORM4+6 * BASSO OCT 7402 EST1 BSS 1 EST2 BSS 1 EST3 BSS 1 TNULL BSS 1 TPRME BSS 1 CP0 BSS 1 CP1 BSS 1 SKP ***************** * * *** CALL ADD ** * * ***************** * EFAD JSB BINOP JSB .FAD NOP JMP FORM0 ********************** * * ** CALL SUBTRACT ** * * ********************** * EFSB JSB BINOP GET OPERAND DIFFERENCE JSB .FSB NOP JMP FORM0 ********************** * * ** CALL MULTIPLY ** * * ********************** * EFMP JSB BINOP JSB .FMP NOP JMP FORM0 ********************** * * ** CALL DIVIDE ** * * ********************** * EFDV JSB BINOP JSB .FDV NOP JMP FORM0 SKP ********************** * * ** EXECUTE ^ ** * * ********************** * EPWR JSB BINOP } EVALUATE ARGUMENTS JMP *+2 EPWRA NOP ADDRESS OF POWER STA UTEMP SAVE BASE STB UTEMP+1 SZA BASE ZERO? JMP PCHK1 NO LDA EPWRA,I BASE ZERO; SZA,RSS IS POWER ZERO? JSB ERROR YES! POWER SSA,RSS NO; POWER POSITIVE? JMP FALSE YES, RETURN ZERO JSB ERROR NO. ERROR 70. ZRTNG LDA INF USE POSITIVE LDB M2 INFINITY JMP FORM0 * PCHK1 DLD EPWRA,I FETCH POWER JSB .IENT INTEGERIZE JMP EPWR1 OVERFLOW SOS BITS LOST ? JMP EPWR1 NO, IS INTEGER. LDA UTEMP REAL POWER. FETCH BASE LDB UTEMP+1 SSA NEGATIVE BASE? JSB ERROR YES. ERROR 51. BASER EQU * JSB ALOG TAKE NATURAL LOG OF BASE JSB ERROR LOG ERROR LOGER JSB .FMP MULTIPLY BY POWER DEF EPWRA,I JSB EXP EXPONENTIATE JSB ERROR EXP ERROR EXPER JMP FORM0 * EPWR1 STA TT1 INTEGER; CALC BY MULTIPLICATION. LDB HONE INITIALIZE RESULT TO 1.0 STB TT3 LDB .2 STB TT4 SSA CMA,INA TAKE ABSOLUTE VALUE IPWR1 SLA,RSS TEST (SHIFTED) POWER JMP IPWR3 WAS EVEN. STA TT2 LDA UTEMP LOAD BASE LDB UTEMP+1 JSB .FMP MULTIPLY RESULT-SO-FAR DEF TT3 STA TT3 SAVE PARTIAL STB TT4 RESULT LDA TT2 IPWR3 ARS STA TT2 SZA,RSS DONE? JMP IPWR4 YES. LDA UTEMP LOAD BASE LDB UTEMP+1 JSB .FMP SQUARE IT DEF UTEMP STA UTEMP STB UTEMP+1 LDA TT2 JMP IPWR1 * IPWR4 LDA TT1 GET ORIGINAL POWER SSA POSITIVE POWER? JMP IPWR5 NEGATIVE. RETURN RECIPROCAL. LDA TT3 YES,LOAD LDB TT4 RESULT JMP FORM0 * IPWR5 LDA HONE LOAD LDB .2 1.0 JSB .FDV DIVIDE BY RESULT DEF TT3 JMP FORM0 RETURN RESULT * * ****************** * * ** EXECUTE <= ** * * ****************** ** ELORE JSB COMPR COMPARE OPERANDS SSA < ? JMP TRUE NO! JMP EEQL+1 YES! ** SKP ***************** * * ** EXECUTE = ** * * ***************** ** EEQL JSB COMPR COMPARE OPERANDS EEQL1 SZA EQUAL? JMP FALSE NO! JMP TRUE YES! ** ***************** * * ** EXECUTE # ** * * ***************** ** ENEQL JSB COMPR COMPARE OPERANDS ENEQ1 SZA NOT EQUAL? JMP TRUE NO! JMP FALSE YES! ** ***************** * * ** EXECUTE > ** * * ***************** ** EGTRT JSB COMPR COMPARE OPERANDS SSA < ? JMP FALSE YES! JMP ENEQL+1 NO! ** ***************** * * ** EXECUTE < ** * * ***************** ** ELST JSB COMPR COMPARE OPERANDS CMA,RSS ** ****************** * * ** EXECUTE >= ** * * ****************** ** EGORE JSB COMPR COMAPARE OPERANDS SSA < ? JMP FALSE YES! JMP TRUE NO! ** FALSE CLA LOAD CLB ZERO JMP FORM0 ** *** EXECUTE UNARY - ** ** EUMIN JSB STTOP LOAD NUMBER JSB ..FCM NEGATE IT JMP FORM0 ** *** EXECUTE LEFT BRACKET ** ** ELBRC ISZ LSTPT LOAD SUBSCRIPT COMMA LDB SCCNT INFORMATION WORD JSB SLWST STACK IT JSB BHSTP BUMP STACK JSB RSCHK LDA HSTPT IS THIS ADA .2 A STRING LDA 0,I VARIABLE? SSA JMP ELB1 YES TRUE LDA HONE NO,ARRAY SO LDB .2 LOAD DEFAULT 0 JMP FORM0 ELB1 CLA SET DEFAULw T CLB SUBSCRIPT TO BE JMP FORM0 FINALLY -1 SKP * *********************************** * * * COMPARE TOP OPERANDS ON STACK * * * *********************************** * * ON EXIT (A) IS NEGATIVE IF THE TOP OPERAND OF THE * STACK IS GREATER THAN THE NEXT-TO-TOP OPERAND AND * POSITIVE IF IT IS LESS, AND ZERO IF THEY ARE EQUAL. * COMPR NOP LDA HSTPT,I STRING SSA ARGUMENTS? JMP COMP1 YES! JSB BINOP NO, COMPARE JSB .FSB NUMERICAL NOP JMP COMPR,I OPERANDS SPC 1 COMP1 LDA M2 PREPARE JSB PSTR COMPARISON STA TEMP8 STRING STB TPRME LDA TNULL SAVE SPECIFIED STA CP0 LENGTH LDA M2 PREPARE JSB PSTR TEST STRING STB CP1 SAVE ACTUAL LENGTH ISZ TSTPT RESERVE SPACE ISZ TSTPT FOR RESULT JSB BHSTP BUMP HI STACK COMP2 ISZ CP0 MORE SPECIFIED STRING JMP COMP3 YES! CLB NO, LOAD A NULL JMP COMP4 CHARACTER COMP3 JSB FSCH LOAD NEXT LDA B40 COMPARISON LDB 0 CHARACTER COMP4 ISZ TNULL MORE SPECIFIED TEST STRING? JMP COMP6 YES! CLA NO, LOAD NULL CHARACTER COMP5 CMB,INB COMPARE ADA 1 CHARACTERS SZA,RSS EXIT ON NOT EQUAL SZB,RSS OR BOTH NULL JMP COMPR,I CHARACTERS JMP COMP2 COMP6 LDA CP1 MORE ACTUAL INA,SZA TEST STRING? JMP COMP7 YES! LDA B40 NO, LOAD A BLANK JMP COMP5 COMP7 STA CP1 LDA TEMP5 EXTRACT CLE,ERA LDA 0,I NEXT SEZ,RSS ALF,ALF TEST AND B377 ISZ TEMP5 CHARACTER JMP COMP5 * * ** ************************** * * *** FETCH A DATA ITEM ** * * ************************** * * UPON ENTRY (B)=1 IF NUMBER IS REQUESTED OR (B)=2 IF A * STRING IS REQUESTED. TYPE MATCH IS CHECKED. NUMBERS RETURN * IN (A) AND (B) STRINGS ARE PREPARED A SOURCE STRINGS. * FDATA FILLS FROM A FILE IF ONE IS REFERENCED BY THE CALLER. * FDATA MOVES TO NEW FILE RECORDS OR AS NECESSARY. * ** FDATA NOP STB TEMP8 SAVE DATA TYPE FDAT1 ISZ DCCNT MORE DATA? JMP FDAT2 YES LDA DATA NO, SEARCH LDB NXTDT FOR NEXT JSB STSRH DATA STATEMENT JSB ERROR NONE FOUND. ERROR 56 E4 JSB SETDP INITIALIZE THE JMP FDAT1 DATA POINTERS * FDAT2 LDB TEMP8 RESTORE TYPE ISZ DCCNT UPDATE LDA NXTDT,I POINTER ISZ NXTDT CORRECT RBR TYPE XOR 1 OF DATA? SSA JSB ERROR NO! E5 SSB,RSS YES, STRING? JMP FDAT3 YES! DLD NXTDT,I LOAD ISZ NXTDT DATA ISZ NXTDT UPDATE POINTER ISZ DCCNT AND COUNTER JMP FDATA,I FDAT7 LDA 1,I LOAD STRING HEADER INB SET CLE,ELB SOURCE STB TEMP8 ADDRESS CLE,ERB AND B377 SET CMA TRANSFER STA TPRME LENGTH CMA,INA ADJUST ARS RECORD ADB 0 PAST STB TEMP3,I STRING JMP FDATA,I FDAT3 LDA NXTDT,I SET ISZ NXTDT LDB NXTDT START-OF-STRING RBL CHARACTER STB TEMP8 ADDRESS AND B377 SET CMA TRANSFER STRING STA TPRME LENGTH CMA,INA UPDATE ARS LDB 0 ADA NXTDT DATA STA NXTDT ADB DCCNT STB DCCNT POINTERS JMP FDATA,I SKP ** *** SET FOR FOLLOWING STATEMENT ** ** FLWST NOP (B) HOLDS PRESENT ADDRESS LDA 1 COMPUTE INA ADDRESS LDA 0,I OF ADA 1 NEXT STA PRADD STATEMENT CPA PBPTR END OF PROGRAM? CLA,RSS YES, SET LINE NO. TO 0 LDA 0,I RECORD THE STA NXTST SEQUENCE NUMBER ADB .2 FETCH STB TEMPS FIRST WORD LDA 1,I OF CURRENT JMP FLWST,I STATEMENT * *** SEARCH STACK FOR GIVEN FOR-VARIABLE ** ** FVSRH NOP LDA TEMPS,I FETCH AND B777 FOR-VARIABLE STA ETAB SAVE FOR-VARIABLE JSB SSYMT FIND ADDRESS IN INB SYMBOL TABLE LDA HSTPT SAVE STA TEMP3 STACK TOP FVSR1 CPA SYMTF STACK BOTTOM? JMP FVSRH,I YES, EXIT VIA (P+1) CPB 0,I MATCHING FOR-VARIABLE? JMP FVSR2 YES ADA .6 NO, MOVE TO JMP FVSR1 NEXT STACK ENTRY * FVSR2 ISZ FVSRH EXIT JMP FVSRH,I VIA (P+2) SKP * * * ******************* * * * EXECUTE PAUSE * * * ******************* * EPAZ LDA .2 GO TO RSS SEGMENT 8 * * ********************** * * * EXECUTE END/STOP * * * ********************** * EEND LDA .3 GO TO RSS SEGMENT 8 SKP * * ******************************** * * * EXECUTE OPERATOR ATTENTION * * * ******************************** * OPEND LDA .4 GO TO CLB SEGMENT 8 STB TEMP3 CLEARING ERROR FLAG * * SEG8 STA SLSTM SET SLOW STATEMENT FLAG JSB BASC8 PULL JMP XEC4 .EXECUTE NEXT STATEMENT * .4 DEC 4 SKP ******************** * * * EXECUTE CALL * * d * ******************** * * * THE GENERAL FLOW THRU ECALL IS AS FOLLOWS: * * 1. CONTROL IS PASSED TO ECALL OR FCALL WHEN A * CALL OR FORTRAN FUNCTION IS FOUND RESPECTIVELY. * * 2. IF IT IS A CALL THEN THE SIMULATE FLAG IS CHECKED * AND IF SET CONTROL IS PASSED TO SEGMENT 7 TO SIMULATE * THE CALL STATEMENT. * * 3. THEN THE PARAMETERS OF THE CALL ARE STACKED ONE BY ONE * ON THE HIGH STACK. EACH PARAMETER IS A THREE WORD ENTRY. * THE DESCRIPTOR TRIPLET HAS THE FOLLOWING FORM, DEPENDING ON * THE PARAMETER TYPE DISCOVERED BY ECALL: * * SIMPLE VARIABLES ARRAYS STRINGS * ---------------------------------------------------------- * HSTPT+2 ! ARGUMENT POINTER ! ELEMENT POINTER ! -BASE ADDRESS - 1 ! * !----------------------------------------------------------! * HSTPT+1 ! ARGUMENT POINTER ! ARRAY BASE PTR ! CHARACTER ADDRESS ! * !----------------------------------------------------------! * HSTPT ! 2:REAL / 1:INTG ! ARRAY SIZE (WDS)! -STRG LNGTH (CHAR)! * ---------------------------------------------------------- * * 4. FOR FORTRAN FUNCTIONS THE SAME THINGS ARE DONE FOR * PARAMETERS BUT THE CALL # AND PARAMETER COUNT FROM THE * INTERPRETIVE CODE IS STACKED ON THE LOW STACK. DURING * EXECUTION OF THE STATEMENT THE INTERMEDIATE RESULTS ARE * STACKED ON THE TEMPORARY STACK AND POPPED OFF AS REQUIRED. * * 5. AFTER SCANNING THE LIST, THE * PARAM CT. IS PUT ON THE HIGH STACK. AT THIS TIME THE * HIGH STACK CONTAINS THE PARAMETER COUNT AND THREE WORD ENTRIES * FOR EACH OF THE PARAMETERS ALL IN REVERSE ORDER ON THE HIGH * STACK. I.E. LAST PARAMETER ON TOP. * * 6. NEXT THE SUBROUTINE NUMBER IS USED TO FIND THE * CORRECT BRANCH TABLE ENTRY AND THE CONTROL WORD AND * PARAMETER CONVERSION WORDS ARE RETRIEVED FROM THE TABLE. * ) FROM THE CONTROL WORD, THE NAME OF THE OVERLAY IS BUILT, * AND THE SUBROUTINE NUMBER IS SAVED FOR THE OVERLAY. SKP * 7. THEN THE PARAMETERS ARE WRITTEN OUT TO SYSTEM AVAILABLE * MEMORY WITH CLASS I/O. THE FIRST RECORD WRITTEN IS THE HIGH * STACK WHICH IS USED BY THE OVERLAY AS A PARAMETER DESCRIPTION. * THEN EACH PARAMETER IS WRITTEN OUT, ACCORDING TO THE TABLE * ON THE NEXT PAGE. * * 8. THE OVERLAY IS THEN SCHEDULED. THE OVERLAY READS IN * ALL PARAMETERS FROM SYSTEM AVAILABLE MEMORY, BUILDS * A SUBROUTINE CALL PARAMETER ADDRESS LIST, INTEGERIZES AS * REQUIRED, AND TRANSFERS CONTROL TO THE SUBROUTINE * SPECIFIED BY THE BRANCH TABLE CONTROL WORD. * * 9. UPON COMPLETION OF THE SUBROUTINE THE PARAMETERS ARE * RECONVERTED AS REQUIRED, AND WRITTEN OUT USING * CLASS I/O TO SYSTEM AVAILABLE MEMORY. * CONTROL IS THEN RETURNED TO BASIC AND * THE PARAMETERS ARE READ IN FROM SYSTEM AVAILABLE MEMORY * AND PLACED BACK INTO THEIR RESPECTIVE PLACES, IF THE * RETURNED VALUE FLAG IS SET FOR THAT PARAMETER, AND IF * THE SUBROUTINE RETURNED NO ERROR FLAG. * * 10. CONTROL IS THEN PASSED TO THE NEXT STATEMENT FOR CALLS, AND * BACK INTO THE FORMX ROUTINE FOR FORTRAN FUNCTIONS, UNLESS * AN ERROR OCCURRED. * * ERROR CONDITIONS FROM THE OVERLAY ARE ALWAYS FATAL FOR * FORTRAN FUNCTIONS, AND ARE FATAL FOR CALLS UNLESS * THE BASIC PROGRAM LINE CONTAINS A "FAIL:" STATEMENT. * FOREGROUND/BACKGROUND COMMUNICATION ERRORS AND * OVERLAY ABORT ERRORS ARE ALWAYS FATAL. SKP * THIS TABLE DESCRIBES THE ACTION OF ECALL IN TRANSFERRING * ARGUMENTS FROM THE PARAMETER LIST SPECIFIED IN THE BASIC * PROGRAM TO THE OVERLAY ROUTINE IN THE FOREGROUND. * * THE ACTION TAKEN BY THE INTERPRETER DEPENDS ON THE CONTENTS * OF THREE PARAMETER CONVERSION WORDS OBTAINED FROM THE * BRANCH TABLE, SPECIFYING THE ATTRIBUTES OF THE ARGUMENTS * EXPECTED BY THE OVERLAY ROUTINE: * WORD 0 -- ROUTINE CONTROL WORD * WORD 1 -- ARRAY IDENTIFIER WORD * WORD 2 -- RETURNED VALUE WORD * WORD 3 -- INTEGER CONVERSION WORD * * * FORMAL * ARGUMENT : ARRAY/SIMPLE RETURN/NO INTEGER/REAL * ACTUAL !--------------------------------------------------------! * ARGUMENT: ! ! ! FIX ON CALL ! * SIMPLE ! PASS VARIABLE ! SAVE RETURN ! AND ! * VARIABLE ! ! IF BIT = 1 ! FLOAT ON RETURN ! * !--------------------------------------------------------! * ! PASS ARRAY IF 1 ! PASS VALUE(S) ! FIX ALL VALUES ! * ARRAY ! WITH POINTER TO ! SAVE RETURN(S)! AND ! * VARIABLE ! GIVEN ELEMENT ! IF BIT = 1 ! FLOAT ON RETURN ! * ! PASS ELEMENT IF 0 ! ! ! * !--------------------------------------------------------! * ! PASS STRING OR ! ! \ / ! * STRING ! SUBSTRING IF 1 ! SAVE STRING ! \/ ! * VARIABLE ! PASS 2 CHARACTERS ! OR SUBSTRING ! /\ ! * ! IF 0 ! IF 1 ! / \ ! * !--------------------------------------------------------! * ! PASS STRING OR ! SYNTAX ERROR ! \ / ! * STRING ! SUBSTRING IF 1 ! IF BIT = 1 ! \/ ! * CONSTANT ! PASS 2 CHARACTERS ! PASS ONLY IF 0 ! /\ ! * ! ! ! / \ ! * !--------------------------------------------------------! * ! ! SYNTAX ERROR ! FIX ON CALHFBL ! * SIMPLE ! PASS CONSTANT ! IF BIT =1 ! AND ! * CONSTANT ! ! PASS ONLY IF 0 ! FLOAT ON RETURN ! * ! ! ! IF BIT = 1 ! * !--------------------------------------------------------! * ! SYNTAX ERROR ! ! ! * REAL ! IF BIT = 1 ! SYNTAX ERROR ! FIX VALUE ! * EXPRESSION ! PASS VALUE IF ! IF BIT = 1 ! ON CALL ! * ! BIT = 0 ! ! ! * !--------------------------------------------------------! SKP H* ECALL JSB BHSTP FCALL LDA FORMX SAVE RETURN STA HSTPT,I FROM FORMX JSB CALL0 .INITIALIZE FOR THE CALL LDB TEMPS,I STACK CALL ID WORD JSB SLWST ON LOW STACK LDA B AND B777 .CALCULATE THE ADDRESS OF ALS,ALS . BRANCH TABLE ENTRY ADA FWAMB STA TMPC6 . AND SAVE LDB A,I STB SUBLC INA LDB A,I .FETCH ARRAY FLAG WORD STB TMPC1 . AND SAVE ADA .2 .BUMP TO CONVERT FLAG WORD LDB A,I . AND SAVE STB TMPC2 CLB JSB SLWST INIT ARGUMENT CNTR INB & STB STRFG STRING FLAG CALL2 ISZ TEMPS FETCH NEXT CALL3 LDA TEMPS,I INTERPRETIVE WORD SZA,RSS NULL? JMP CBKSP YES,BACK UP 1 CPA LFPAR SUBCRIPTED VARIABLE? JMP CBKSP YES, BACK UP TO OPND-ID AND OPMSK CPA B4000 RIGHT PARENTHESIS? JMP CALL5 YES, END OF LIST JSB FORMX EVALUATE ARGUMENT * LDA HSTPT,I FETCH ARGUMENT ADDRESS SSA STRING? JMP STVAL YES CMA NO, CHECK FOR ARRAY LDB PBPTR LOW END OF ARRAY STORAGE ADB 0 SSB,RSS ABOVE? JMP CSVAL NO,MUST BE CONSTANT LDB FCORE HIGH END OF ARRAY STORAGE ADB M2 DECREMENT FOR 1'S COMP -1 ADB 0 SSB ABOVE? JMP COVAL .YES-MUST BE INTERMED.,COM OR VARIABLE COVAR LDB TEMP7,I NO,FETCH ARRAY BASE ADDR FROM SYMBOL TBL. ISZ TEMP7 POINT TO ARRAY SIZE LDA TEMP7,I FETCH ARRAY SIZE STB TEMP7 SAVE BASE ADDR TEMPORY CLB MULTIPLY RRR 8 COLUMN * BLF,BLF ROW STB TEMP3 TO CALCULATE MPY TEMP3 ARRAY SIZE. RRR 15 CONVERT SIZE TO WORDS IN B LDA TEMP7 FETCH BASE ADDR JMP CSVPT PUT BASE ADDR & SIZEC> ON HISTK. * COVAL LDB SYMTA .IS THE POINTER TO A ADB M1 . COMMON VARIABLE ? ADB 0 SSB JMP COVAR .YES * CSVAL CMA BACK TO ADDRESS LDB .2 LENGTH =2 CSVPT STB TEMP3 SAVE SIZE TEMPORARY JSB BHSTP STA HSTPT,I SAVE BASE OR CHAR ADDR JSB BHSTP LDA TEMP3 SAVE LENGTH STA HSTPT,I +=WORDS, -=CHARS ISZ LSTPT,I ADD TO ARG COUNT JSB DOPRM .PROCESS THIS PARAMETER JMP CALL2 CHECK FOR MORE * STVAL LDA M2 SOURCE STRING FLAG JSB PSTR PREPARE STRING. RTN A=ADDR, B=LENGTH SWP EXCHANGE REGS CMA STA TEMP7 SAVE ACTUAL STRING LEN LDA TEMP6,I GET ARRAY DIMENSION AND HIMSK AND ADA TEMP7 STUFF IN ACTUAL LENGTH CMA,INA AND SAVE STA TEMP3 LOGICAL-PHYSICAL LENGTH (2'S COMPLMT) SWP JSB BHSTP UNDO STACK BUMP FROM PSTR JMP CSVPT+1 SAVE IT ALL ON HISTK * CBKSP LDB TEMPS BACK UP ADB M1 TO LAST STB TEMPS INTERPRETIVE JMP CALL3 WORD * * END OF ARGUMENT SCAN * B4000 OCT 4000 LFPAR OCT 122000 SKP * * INITIALIZE ROUTINE * CALL0 NOP LDA ADPRM INA STA TMPC2 .ZERO ALL PARAMETER POINTERS STA RTNAD .SET RETURN ADDRESS LDA M15 CLB STB TMPC2,I ISZ TMPC2 INA,SZA .DONE ? JMP *-3 . NO DO ALL 15 JMP CALL0,I ************************************** * * DUMMY CALL AREA * THIS ROUTINE IS CONFIGURED FOR THE * ACTUAL SUBROUTINE CALL * ************************************** * SUBCL NOP JSB SUBLC,I RTNAD DEF *+16 PRAM DEF * REP 14 DEF * JMP SUBCL,I * SUBLC DEF * LCPRM DEF * .LOCAL STORAGE FOR INTEGER IPRAM BSS 15 . ADPRM DEF PRAM-1 TMPC1 NOP .ARRAY FLAGS TMPC7 NOP .RETURN FLAGS TMPC2 NOP .CONVERT FLAGS NOP .PLACE HOLDER TMPC3 NOP .# PARAMETERS TMPC4 NOP .CALL I.D. ARRAY ADDRESS RTN TMPC5 NOP .# ELEMENTS IN INTEGER ARRAY TMPC6 NOP .ADDRESS OF BRANCH TABLE TMPC8 NOP .REAL ARRAY ADDRESS ARRAD EQU TMPC7 ABREG BSS 2 RRL16 OCT 100100 SKP * ********************************************** * * ROUTINE TO CONAFIGURE ROUTINE CALL * * LOWSTACK = # OF PARAMETERS * LOWSTACK-1 = CALL I.D. * HIGHSTACK HAS THREE WORD PARAMETER DESCRIPTOR * ********************************************** * DOPRM NOP LDA TMPC2 SLA .CONVERT TO INTEGER ? JSB ICONV .YES - DO IT JSB CDEF .NO - FIX PARAMETER ADDRESS IN CALL * LDA TMPC1 LDB TMPC2 RRR 1 .POSITION FOR NEXT PARAMETER STA TMPC1 STB TMPC2 ISZ RTNAD .BUMP RETURN ADDRESS JMP DOPRM,I .EXIT * * CDEF NOP LDA HSTPT,I .FETCH PARAMETER TYPE SSA .REAL / INTEGER / ARRAY ? JMP STRNG .NO - IT'S A STRING CPA .1 .INTEGER ? JMP INT .YES CPA .2 .REAL VARIABLE ? JMP REAL .YES LDA HSTPT .IT IS AN ARRAY ADA .2 .MOVE TO ARRAY ADDRESS LDA A,I . AND FETCH IT CDEF2 LDB TMPC2 .AN INTEGER ARRAY ? SLB LDA ARRAD .YES INCERT PROPER ADDRESS CDEF1 LDB ADPRM ADB LSTPT,I .INCREMENT TO PARAM POSITION STA B,I .STUFF PARAM ADDRESS JMP CDEF,I * INT LDA LCPRM ADA LSTPT,I .CALCULATE INTEGER STORE JMP CDEF1 * REAL LDA HSTPT INA LDA A,I .FETCH PARAMETER ADDRESS JMP CDEF2 * STRNG JSB ULWST .POP LOW STACK AND SAVE STB TMPC3 . # PRAM JSB ULWST . AND CALL ID STB TMPC4 LDA LSTPT .COMPUTE STRING PARAMETER ADDRESS INA STA ARRAD .SAVE FOR INCLUSION IN SUB CALL LDA HSTPT ADA .2 .FETCH BASE ADDRESS AND LDA A,I . DETERMINE IF STRING CONSTANT ADA PBPTR SSA .CONSTANT ? JMP STRG1 .NO CONTINUE LDA HSTPT,I .FETCH LENGTH AND " CODE AND B377 .ELIMINATE " CODE STA B ALF,ALF .MOVE LENGTH TO UPPER BYTE ADA B .REINSERT LENGTH STA HSTPT,I .UPDATE HIGH STACK STRG1 LDA HSTPT,I ALF,ALF .POSITION PHYSICAL SIZE IOR LBYTE .FILL UPPER BITS CMA,INA .NEGATE STA STRLG .SAVE FOR MOVE BYTES LDA HSTPT,I .COMPUTE LOGICAL LENGTH CMA,INA AND B377 STA B .PUT ON LOW STACK JSB SLWST LDA HSTPT .FIND BYTE ADDRESS OF STRING INA LDA A,I STA STRPT .SAVE FOR MOVE BYTES CALL LDB LSTPT .COMPUTE BYTE ADDRESS IN LOWSTACK CLE,INB ELB STB SSTR . AND SAVE TEMP JSB .MBT . MOVE STRING DEF STRLG NOP CLE,ERB .COMPUTE NEW LOWSTACK ADDRESS SEZ INB STB LSTPT . AND SAVE CMB,INB .CHECK FOR STACK OVERFLOW ADB HSTPT SSB .OVERFLOW ? JMP E1 .YES LDB STRPT .PLACE BYTE ADDRESS OF STRING ON JSB SLWST . LOWSTACK LDB SSTR .ALSO PLACE BYTE ADDRESS OF STRING JSB SLWST . IN THE LOWSTACK LDB STRLG .ALSO THE STRING LENGTH IN LOW STACK JSB SLWST LDB TMPC4 .REPLACE CALL ID JSB SLWST LDB TMPC3 .REPLACE #PRAM JSB SLWST JMP CDEF1-1 .SET CALL PARAMETER * STRLG NOP STRPT NOP SSTR NOP SKP *********************************************** * * ICONV IS THE PARAMETER CONVERT ROUTINE * FOR SUBROUTINE ENTRY * ********************************************** * ICONV NOP LDA TMPC1 SLIA .ARRAY PARAMETER TYPE ? JMP ICON1 .YES LDA HSTPT .NO - FETCH THE PARAMETER ADDRESS LDB HSTPT,I .CHECK FOR ARRAY ELEMENT ADB M3 SSB,RSS INA .YES FETCH ELEMENT POINTER INA LDA A,I DLD A,I .FETCH VALUE ITSELF JSB IFIX . CONVERT TO INTEGER LDB LCPRM ADB LSTPT,I .COMPUTE ADDRESS OF TEMP STA B,I . STORE AND SAVE STB ARRAD .SAVE ADDRESS JMP ICONV,I .EXIT * ICON1 LDB HSTPT INB LDA B,I .FETCH ARRAY BASE ADDRESS INB LDB B,I .FETCH ELEMENT ADDRESS CMB,INB .NEGATE AND COMPUTE # ELEMENTS LEFT ADA B ADA HSTPT,I .COMPUTE SIZE OF PASSED ARRAY ARS . DIVIDE BY 2 = # ELEMENTS CMA,INA STA TMPC5 STA SUBCL .USE SUBCL AS TEMP/ SAVE ARRAY SIZE INA,SZA,RSS .IF REAL THEN ERROR JSB ERROR E15 JSB ULWST .POP LOW STACK AND STB TMPC3 . SAVE # PARAM JSB ULWST STB TMPC4 . AND CALL I.D. LDA LSTPT .STACK TEMPORARILY THE FIXED ARRAY INA .BUMP TO NEXT ADDRESS STA ARRAD . ON THE LOW STACK - SAVE ADDRESS LDA HSTPT ADA .2 LDA A,I .ARRAY BASE ADDRESS STA TMPC8 . AND SAVE ICON2 DLD TMPC8,I JSB IFIX LDB A JSB SLWST .STACK THIS ELEMENT ISZ TMPC8 ISZ TMPC8 .BUMP ARRAY PTR ISZ TMPC5 .DONE ? JMP ICON2 .NO LDB ARRAD .YES - STORE ARRAY LOCATION WITH JSB SLWST . ARRAY ON LOW STACK LDB SUBCL .ALSO SAVE ARRAY SIZE JSB SLWST . ON LOW STACK LDB TMPC4 .YES RESTORE # PARAM JSB SLWST LDB TMPC3 . AND CALL I.D. TO LOW STACK JSB SLWST JMP ICONV,I SKP CALL5 JSB BHSTP MAKE ROOM ON HI STACK JSB ULWST AND UNSTACK STB HSTPT,I >ARGUMENT COUNT * EXECUTE SUBROUTINE JSB SUBCL * ****************************** * * SUBROUTINE RETURN PARAMETERS * HANDLING * ****************************** * DST ABREG .SAVE RETURN VALUE * LDB HSTPT,I .FETCH # PARAMETERS ISZ HSTPT . & POP STACK CMB,INB,SZB,RSS . FOR PARAMETER FLAGS JMP RTN6 . NO PARAMETERS SKIP CONVERSION STB TMPC3 ADB .16 ADB RRL16 .FORM ROTATE INSTRUCTION STB RTN1 . AND STORE STB RTN2 JSB ULWST .ELIMINATE CALL I.D. STB CALID . SAVE FOR RETURN PROCESSING LDA TMPC6 .FETCH B&M ADDRESS INA DLD A,I .FETCH ARRAY AND RETURN RTN1 RRL 1 . FLAGS DST TMPC1 .SET ARRAY & RETURN FLAGS LDA TMPC6 ADA .3 LDA A,I CLB RTN2 RRL 1 DST TMPC2 .SET INTEGER FLAG TEMP * RTN5 LDA TMPC7 .RETURN ? SSA,RSS JMP RTN8 .NO - LOOK FOR STRING UNSTACK LDA TMPC2 SSA,RSS .INTEGER ? JMP RTN8 .NO - CHECK FOR STRING LDA TMPC1 SSA,RSS .ARRAY ? JSB RTN3 .NO - RETURN INTEGER JSB RTN4 .YES - RETURN ARRAY * FIN ISZ HSTPT .UNSTACK PARAMETER DESCRIPTOR ISZ HSTPT ISZ HSTPT * ISZ TMPC3 .MORE PARAMETERS ? RSS JMP RTN6 .NO - CHECK FOR FUNCTION * DLD TMPC1 .POSITION PARAM FLAGS RRL 1 . FOR NEXT ONE DST TMPC1 LDA TMPC2 RRL 1 DST TMPC2 JMP RTN5 .PROCESS NEXT PARAMETER * RTN6 LDA CALID .FETCH CALL I.D. AND OPMSK CPA CALOP .IS IT A SUBROUTINE ? JMP RTN10 .YES LDA ERRCD .NO - A FUNCTION SZA .ANY ERROR RETURNED? JMP E15-1 . YES - FATAL FOR FUNCTIONS JSB BHSTP JSB RSCHK .MAKE ROOM FOR RESULT ON LDA TMPC6 ADA .3 .IS THIS AN INTEGER FUNCTION ? R LDA A,I SSA,RSS JMP RTN11 .NO - RETURN VALUE AS RECEIVED LDA ABREG JSB FLOAT .YES - RETURN REAL VALUE JMP RTN12 RTN11 DLD ABREG . TEMP STACK RTN12 ISZ TEMPS .STEP PAST RIGHT ) JMP FOR12 .CONTINUE WITH FORMULEA * RTN10 ISZ HSTPT .POP HIGH STACK LDB ERRCD SZB,RSS .ANY ERROR RETURN ? JMP XEC4 .NO - PROCESS NEXT STATEMENT CPB MNEG .IS THIS A FATAL ERROR? JMP E15-1 .YES - ISSUE ERROR ISZ TEMPS LDB PRADD .END OF STATEMENT ? CPB TEMPS JMP E15-1 .YES - ISSUE ERROR ISZ TEMPS .NO - FAIL OPTION USED LDB TEMPS .SKIP OVER FAIL OP CODE JMP SETSX . AND PROCESS REST OF CODE * .16 DEC 16 CALID NOP CALOP OCT 50000 * * RTN8 LDA HSTPT,I . IS IT A STRING SSA,RSS JMP FIN .NO - MOVE TO NEXT PARAMETER JSB ULWST .YES - FETCH STRING DATA STB STRLG . FROM LOWSTACK JSB ULWST . :LENGTH STB SSTR . :LOWSTACK BYTE ADDRESS JSB ULWST . :STRING BYTE ADDRESS LDA SSTR .COMPUTE NEW LOWSTACK ADDRESS CLE,ERA ADA M1 STA LSTPT .AND SAVE LDA TMPC7 .CHECK FOR NO RETURN SSA,RSS JMP RTN9 .YES NO RETURN LDA SSTR .READY FOR MOVE BYTES TO STRING STORE JSB .MBT DEF STRLG NOP LDA HSTPT INA .CHECK FOR SUBSTRING RETURN LDB A,I .FETCH CHARACTER ADDRESS INA LDA A,I .COMPUTE BYTE ADDRESS OF BASE CMA,CLE STA SSTR .SAVE INA .MOVE TO FIRST CHAR BYTE ADDRESS ELA CPA B .BASE = CHAR? JMP STRUP . YES - FIX NEW LOGICAL LENGTH RTN9 JSB ULWST .NO - POP LOWSTACK JMP FIN .MOVE TO NEXT PARAMETER * STRUP JSB ULWST STB A AND B377 .FETCH RETURNED LOGICAL LENGTH STA B LDA SSq(TR,I .FETCH STRING LENGTH WORD AND LBYTE .REMOVE OLD LOGICAL LENGTH IOR B .MERGE AND STORE BACK STA SSTR,I JMP FIN .MOVE TO NEXT PARAMETER * LBYTE OCT 177400 * ****************************** * * RETURN INTEGER PARAMETER * ****************************** * RTN3 NOP ISZ RTN3 .SET FOR PROPER RETURN LDA TMPC3 CMA,INA ADA LCPRM .ADDRESS OF PARAMETER LDB HSTPT INB LDB B,I .FETCH ADDRESS OF VARIABLE STB TMPC4 LDA A,I .FETCH VALUE JSB FLOAT DST TMPC4,I .FLOAT & STORE JMP RTN3,I * ******************************** * * RETURN INTEGER ARRAY * ******************************** * RTN4 NOP JSB ULWST .FETCH ARRAY SIZE FROM STB TMPC5 . LOW STACK AND SAVE JSB ULWST .FETCH ARRAY LOCATION FROM LOW STB TMPC4 . STACK AND SAVE ADB M1 .COMPUTE NEW LOW STACK ADDRESS STB LSTPT . AND SET IT LDA HSTPT .COMPUTE ELEMENT ADDRESS OF REAL ADA .2 . ARRAY AND SAVE IN SUBCL AS TEMP LDA A,I STA SUBCL * RTN7 LDA TMPC4,I JSB FLOAT .CONVERT TO REAL DST SUBCL,I ISZ TMPC4 .STEP TO NEXT ELEMENT ISZ SUBCL ISZ SUBCL ISZ TMPC5 .DONE ? JMP RTN7 .NO - DO ANOTHER JMP RTN4,I .YES - EXIT SKP ****************** * * * EXECUTE WAIT * * * ****************** EWAIT NOP ISZ TEMPS POINT (TEMPS) TO FORMULA JSB FETCH FETCH EVALUATED FORMULA SSA NEGATIVE JMP XEC4 YES JSB IFIX CONVERT TO INTEGER SOC LARGE INTEGER LDA MNEG YES CMA NO STA TEMP2 SAVE COUNT (<0) ADA .74 AND CHECK FOR SSA,RSS SHORT WAIT JMP COUNT GO COUNT FOR < 75 MS CCB LDA TEMP2 DIV .10 TENS OF MILLISECONDS STA TEMP2 JSB EXEC CALL SYSTEM DEF *+6 FOR DELAY DEF .12 DEF .0 THIS PRGRM DEF .1 BY 10'S OF MS DEF .0 ONLY ONCE DEF TEMP2 FOR THIS LONG JMP XEC4 ABANDON REMAINDER(SYSTEM UNCERTAINTY) * COUNT LDA TEMP2 RECOVER COUNT EWAI1 INA,SZA,RSS WAIT? JMP XEC4 NO! LDB M280 YES SET INNER LOOP INB,SZB MORE? JMP *-1 YES! JMP EWAI1 NO! * .0 DEC 0 .12 DEC 12 .74 DEC 74 M280 DEC -280 SKP ********************** * * * EXECUTE RETURN * * * ********************** ERTRN LDB LSTPT RETURN STACK CPB LSTAK EMPTY? JSB ERROR YES. ERROR 55. E3 LDA LSTPT,I NO, LOAD RETURN ADDRESS ADB M1 RESET STB LSTPT STACK POINTER SSA,RSS IF NEGATIVE STMT NUMBER, JMP XEC43 STA 1 THIS IS RETURN FROM SCHED TASK. LDA M256 HANDLED BY SPECIAL HOOK JSB TRAP IN TRAP ROUTINE. JMP TRERR ERROR JMP XEC43 SKP * * ** EXECUTE READ ** * EREAD LDA HSTPT SAVE HI STK PTR STA HTEMP JSB VALLU .READ #,LU ? JSB EREA4 .SET NEW LUINP LDA FILE# CPA M1000 . READ FROM A DATA STMT? JMP EREA6 .YES LDA LUINP .NO - READ FROM LU AND B77 .SET EOT CONDITION TO IGNOR IOR B700 . PAPER TAPE LEADER STA EREA5 JSB EXEC DEF *+3 DEF .3 DEF EREA5 JMP EINPT .NOW READ FROM THE DEVICE * EREA5 NOP B700 OCT 700 * EREA6 LDB TEMPS EREA1 CPB PRADD JMP XEC4 JSB FORMX NO, EVALUATE NEXT ADDRESS LDA HSTPT,I RECORD ADDRESS SSA STRING VARIABLE? JMP EREA2 YES! STA OUTLN CL B,INB JSB FDATA GET DATA ITEM STA OUTLN,I STORE ISZ OUTLN DATA STB OUTLN,I ITEM ISZ HSTPT EREA3 LDB TEMPS INB JMP EREA1 EREA4 NOP STA LUINP JSB KEYBD .DETERMINE IF NEW DEVICE JMP EREA4,I . IS KEYBOARD LDA LUINP IOR B400 . IT IS SO INSERT ECHO BIT STA LUINP STA LUOUT .SET OUTPUT DEVICE FOR "?" JMP EREA4,I SPC 1 EREA2 LDB .2 PREPARE JSB FDATA SOURCE STRING CCA PREPARE JSB PSTR DESTINATION STRING LDA FSCHA JSB TRSTR TRANSFER STRING JMP EREA3 * * * ** *** SEARCH FOR STATEMENT OF GIVEN TYPE ** ** STSRH NOP TYPE IN (A), ADDRESS IN (B) AND OPMSK (77000) EXTRACT STMT TYPE STA TEMP4 STSR1 CPB PBPTR PAST LAST STATEMENT? JMP STSRH,I YES LDA 1 EXTRACT ADA .2 PROGRAM LDA 0,I STATEMEN AND OPMSK TYPE CPA TEMP4 DESIRED TYPE? JMP STSR2 YES LDA 1 NO, FETCH INA STATEMENT LENGTH ADB 0,I COMPUTE NEW ADDRESS JMP STSR1 * STSR2 ISZ STSRH FOUND IT, SKIP RETURN JMP STSRH,I * ** *** SET POINTER TO START OF DATA STATEMENT ** ** SETDP NOP STATEMENT ADDRESS IN (B) INB LOAD LDA 1,I STATEMENT LENGTH CMA,INA SET INA DATA COUNTER STA DCCNT TO 1-STATEMENT LENGTH INB SET 'NEXT DATA' POINTER ONE STB NXTDT WORD ABOVE FIRST CONSTANT JMP SETDP,I SPC 1 SETPT NOP LDB SYMTF INITIALIZE STB HSTPT POINTERS TO LDB FCORE 'HIGH CORE' STACK, STB TSTPT ADB .23 STB LSTAK AND 'LOW' STB LSTPT STACK CMB DO ADB HSTPT STACKS#q SSB MEET? JMP E1 YES LDB PBUFF BEGIN JMP SETPT,I EXECUTION * .23 DEC 23 .9 DEC 9 SKP ** *** ALLOT SPACE FOR INTERMEDIATE RESULT ** ** RSCHK NOP LDA TSTPT ALLOT ADA .2 STA TSTPT SPACE ADA M1 OVERFLOW INTO CPA LSTAK LOW-CORE STACK? RSS YES JMP RSCHK,I NO LDA LSTAK SAVE INA LOWER STA TEMP3 STACK BOUND ADA .9 UPDATE STA LSTAK STACK BOTTOM LDA LSTPT SET INA SOURCE STA TEMP2 ADDRESS ADA .9 UPDATE STA LSTPT STACK TOP INA SET DESTINATION STA TEMP4 ADDRESS CMA,INA OVERFLOW ADA HSTPT INTO SSA HIGH-CORE STACK? JMP E1 YES. ERROR 57. JSB MVTOH NO, MOVE JMP RSCHK,I LOW-CORE STACK SKP ** *** BUMP HIGH STACK POINTER ** ** BHSTP NOP CCB ADVANCE ADB HSTPT STB HSTPT POINTER CPB LSTPT OVERFLOW? JMP E1 YES JMP BHSTP,I NO ** *** VERIFY LEGITIMACY OF OPERAND ** ** OPCHK NOP LDB HSTPT,I OPERAND ADDRESS TO (B) SSB STRING OPERAND? JMP OPCH2 YES LDA 1,I HIGH PART OF CPA MNEG OPERAND 100000B? INB,RSS YES JMP OPCH1 NO; OK. LDA 1,I IS LOW PART OF OPERAND 376B? CPA B376 JSB ERROR YES. VALUE NOT DEFINED. (50) E8 ADB M1 OPCH1 CPB TSTPT TEMPORARY? JMP OPCH3 YES JMP OPCHK,I OPCH2 CMB,INB SET ADDRESS TRUE ISZ HSTPT UNSTACK OPERAND OPCH3 LDA TSTPT UNSTACK TEMP STACK ADA M2 STA TSTPT JMP OPCHK,I * B376 OCT 376 LBOP OCT 22000 M4 DEC -4 SKP * * ************************** * *, ** EVALUATE A FORMULA ** * * ************************** * FORMX NOP FORMULA BEGINS IN (TEMPS) CLB INITIALIZE OPERATOR JSB SLWST STACK FORM1 LDA TEMPS,I FETCH OPERAND ISZ TEMPS SET FOR NEXT WORD OF FORMULA AND OPDMK (100777) EXTRACT OPERAND STA TEMP5 AND SAVE IT SZA,RSS NULL OPERAND? JMP FORM2 YES JSB BHSTP SET STACK FOR OPERAND ADDRESS SSA FLAG BIT SET? JMP FORM4 YES JSB SSYMT FETCH OPERAND ADDRESS INB,SZB,RSS EXISTANT? JMP E8-1 NO. ERROR 50. AND .15 YES CPA .15 USER DEFINED FUNCTION? JMP FORM6 YES STB HSTPT,I NO LDB 1,I LOAD PTR TO VALUE SZA STRING VARIABLE? JMP FORM2 NO! LDA TEMPS,I YES AND OPMSK FOLLOWED BY CPA LBOP SUBSCRIPT? JMP FORM2-2 YES! STB TEMP8 NO! JSB RSCHK CREATE TEMPORARY CLA RECORD CCB DST TSTPT,I (0,-1) LDB TEMP8 RETRIEVE AND CMB,INB NEGATE STRING ADDRESS STB HSTPT,I STACK OPERAND ADDRESS FORM2 LDA TEMPS,I FETCH AND OPMSK OPERATOR ALF,ALF POSITION IT CPA .2 STRING CONSTANT? JMP FORM3 YES! FORM8 RAR LDB 0 LOAD ADDRESS OF ADB FOPBS OPERATOR'S INFORMATION WORD ADA M4 NON-FORMULA SSA OPERATOR? CLB YES ADA D31 NO, NON-FORMULA SSA,RSS OPERATOR? CLB YES CLA NO LDA 1,I LOAD INFORMATION WORD AND B777 SAVE STA TEM10 PRECEDENCE XOR 1,I RECOVER OPR NO. ARS STA TEMP5 IDENTIFICATION JMP FOR11 * * EVALUATION ROUTINES RETURN VALUE HERE. * FORM0 DST TSTPT,I STAC]NLHK HIGH WORD LDA TSTPT STACK OPERAND STA HSTPT,I ADDRESS FOR11 LDA LSTPT,I DOES OPERATOR AND B377 ON TOP OF CMA OPERATOR STACK ADA TEM10 HAVE HIGHER SSA PRECEDENCE? JMP FORM9 YES, EXECUTE IT RSS * FOR10 ISZ LSTPT LDB TEM10 RETRIEVE PRECEDENCE ADB M15 NO, LEFT PARENTHESIS SSB OR LEFT BRACKET? ADB .15 NO, RESTORE PRECEDENCE ADB TEMP5 COMBINE IDENTIFICATION JMP FORM1-1 WITH PRECEDENCE AND STACK SKP JN* ***************************** * * * PROCESS STRING CONSTANT * * * ***************************** * * WHEN STRING CONSTANTS ARE STACKED, AN APPROPRIATE * ENTRY IS PLACED ON THE TEMPORARY STACK SO THAT ALL * STRING OPERANDS HAVE THE SAME FORM: A NEGATED BASE * ADDRESS ON THE OPERAND STACK AND A TWO WORD ENTRY ON * THE TEMPORARY STACK CONTAINING THE START-OF-STRING * AND END-OF-STRING DESIGNATORS BIASED BY -1 (DEFAULT * START-OF-STRING DESIGNATORS HAVE A STACK VALUE OF 0, * DEFAULT END-OF-STRING DESIGNATORS HAVE S STACK VALUE * OF -1). IN THE CASE OF SUBSCRIPTED STRING VARIABLES, * THE TEMPORARY IS CREATED WHEN THE ']' IS SCANNED THE * ENTRY FOR NON-SUBSCRIPTED STRING OPERANDS IS CREATED * WHEN THEY ARE SCANNED. * FORM3 CLA,INA PRINT STATEMENT CPA STRFG STRING CONSTANT? JSB STSTR NO,STACK STRING CONSTANT! JMP FORM8 EXECUTE END OF FORMULA * FORM4 CPA FLGBT CONSTANT? JMP FORM5 YES AND .15 NO CPA .15 PRE-DEFINED FUNCTION? JMP FORM7 YES LDB TEMP8 NO, MUST BE A JMP FORM2-1 PARAMETER * FORM5 LDB TEMPS LOAD CONSTANT ADDRESS ISZ TEMPS MOVE POINTER TO ISZ TEMPS NEXT CODE WORD JMP FORM2-1 * * HERE FOR USER-DEFINED FUNCTION (FNA, FNB, ETC.) * FORM6 STB TEMP5 SAVE SYMBOL TABLE POINTER LDB TSTPT SAVE CURRENT POINTER JSB SLWST TO TEMPORARY STACK LDB TEMP5,I JSB SLWST SAVE FUNCTION ADDRESS LDA FORMX SAVE CURRENT STA HSTPT,I FORMX RETURN ADDRESS JSB FORMX EVALUATE THE PARAMETER ISZ TEMPS UPDATE FORMULA POINTER ISZ TEMPS PAST RIGHT PARENTHESIS LDA TEMPS SWITCH LDB LSTPT,I FORMULA POINTER STB TEMPS TO FUNCTION'S STA LSTPT,I FORMULA LDB TEMP8 SET LDA HSTPT,I PARAMETER FPOINTER ISZ LSTPT TO NEW PARAMETER, ISZ HSTPT SAVING PREVIOUS STB LSTPT,I SETTING ON STA TEMP8 LOW-CORE STACK CPA TSTPT PROTECT PARAMETER IF JSB RSCHK ON TEMPORARY STACK JSB FORMX EVALUATE FUNCTION LDA LSTPT,I RESTORE OLD STA TEMP8 PARAMETER POINTER LDA LSTPT CUT BACK ADA M3 LOW-CORE STA LSTPT STACK INA RESTORE ORIGINAL LDB 0,I TEMPORARY STACK STB TSTPT POINTER INA RESTORE LDB 0,I ORIGINAL STB TEMPS FORMULA POINTER JSB STTOP POP RESULT FOR12 DST TSTPT,I STORE HIGH WORD ISZ HSTPT LDB HSTPT,I RESTORE FORMX STB FORMX RETURN ADDRESS LDA TSTPT STACK ADDRESS STA HSTPT,I OF RESULT JMP FORM2 * * HERE FOR PREDEFINED FUNCTION (SIN, ETC.) * FORM7 LDA TEMP5 OPERAND IDENTIFIES FUNCTION CPA FRMSK FORTRAN FUNCTION? JMP FCALL YES! RRR 4 AND .31 FUNCTION OFFSET ALS MULT BY 2 FOR OFFSET IN BR TBL LDB 0 MOVE TO B FOR SLWST JSB SLWST STACK CALL NUMBER LDA FORMX SAVE CURRENT STA HSTPT,I FORMX RETURN ADDRESS JSB FORMX EVALUATE THE PARAMETER ISZ TEMPS UPDATE FORMULA POINTER ISZ TEMPS PAST RIGHT PARENTHESIS JSB ULWST POP FUNCT # OFF LOW STACK * CLA SET INST. FOLLOWING FUNCT. CALL STA SKIPE TO NOP LDA AFCNX COMPUTE THE ADDRESS JSB INDCK OF THE CORRECT ADB 0 ENTRY IN THE BRANCH TABLE DLD 1,I A = WORD THAT INDICATES STA SKIPE 'RSS' OR 'NOP' FOR ERROR STB FADRS B=ADDRESS OF FUNCTION LDA HSTPT,I IS THIS A SSA STRING VARIABLE? JMP FOR13 YES, MUST BE LEN FUNCTION!  JSB STTOP GET THE ARGUMENT OF THE FUNCTION JSB FADRS,I EXECUTE THE FUNCTION!!! SKIPE NOP MODIFIED TO AN 'RSS' IF ERROR RETURN JMP FOR12 FUNCTION EXECUTION COMPLETE JSB ERROR THERE WAS AN ERROR FNERR EQU * * * FADRS NOP FUNCTION ADDRESS GOES HERE * SPC 1 * LENGTH FUNCTION (LEN) SPC 1 FOR13 LDA HSTPT,I GET STRING LENGTH CMA,INA AND CONVERT ADA M1 TO FLT PT LDA 0,I AND B377 JSB FLOAT FLOAT STRING LENGTH JMP FOR12 * * * HERE TO EXECUTE AN OPERATOR (+, *, ETC.) * FORM9 LDA LSTPT,I EXECUTE OPERATOR; UNSTACK CCB OPERATOR ADB LSTPT INFORMATION STB LSTPT WORD ALF,ALF COMPUTE AND B177 SUBROUTINE SZA,RSS END FORMULA? JMP FORMX,I YES, EXIT ADA ARBAS GET ADDRESS JMP 0,I EXECUTE * .31 DEC 31 B177 OCT 177 FRMSK OCT 100757 * *************************** * * * FETCH TOP OF STACK * * * *************************** ** STTOP NOP JSB OPCHK VALIDATE JSB RSCHK OPERAND LDB HSTPT,I SAVE DLD 1,I LOAD JMP STTOP,I SKP ******************************* * * * STACK (B) ON LOW CORE STACK * * * ******************************* SLWST NOP ISZ LSTPT LDA LSTPT CPA HSTPT STACK OVERFLOW E1 JSB ERROR YES STB LSTPT,I JMP SLWST,I * ************************************ * * ** UNSTACK LOW CORE STACK ON (B) ** * * ************************************ * ULWST NOP LDB LSTPT,I POP CCA STACK ADA LSTPT STA LSTPT JMP ULWST,I * *************************** * u/ * * STACK STRING CONSTANT * * * *************************** * STSTR NOP JSB BHSTP SET STACK FOR OPERAND LDA TEMPS STACK NEGATIVE CMA OF STRING STA HSTPT,I ADDRESSES LDA TEMPS,I COMPUTE AND B377 STRING CCB LENGTH ADB 0 -1 ADA .3 UPDATE ARS INTRA-STATEMENT ADA TEMPS POINTER STA TEMPS PAST STRING JSB RSCHK CREATE TEMPORARY CLA RECORD DST TSTPT,I (0,(B)) JMP STSTR,I SKP * **************************** * * * PREPARE STRING OPERAND * * * **************************** * * THE STRING ADDRESS ON TOP OF THE OPERAND STACK IS COMBINED * WITH THE SUBSCRIPTS IN A PSUEDO-ENTRY ON THE TEMPORARY STACK * TO FORM A STRING OPERAND. (A)=-2 UPON ENTRY FOR A SOURCE * STRING (A)=-1 FOR A DESTINATION STRING. THE ADDRESS OF * THE FIRST CHARACTER OF THE STRING OPERAND IS LEFT IN TEMPS+5 * FOR SOURCE STRINGS (A)= TEMPS+5 UPON EXIT. THE SOURCE * STRING LENGTH IN CHARACTERS (1'S COMPLEMENT) IS IN (B) * UPON EXIT. THE FOLLOWING * CONDITIONS EXIT TO ERROR: NEGATIVE STRING LENGTH, REQUESTED * DESTINATION STRING WOULD EXCEED PHYSICAL STRING BOUNDARY, OR * REQUESTED DESTINATION STRING WOULD PRODUCE A STRING QUANTITY * WITH TWO UNCONNECTED PARTS. THE LOGICAL LENGTH OF A * DESTINATION STRING IS ADJUSTED AS NEEDED. * PSTR NOP STA PS0 SAVE MODE FLAG JSB OPCHK UNSTACK OPERAND STB PS1 SET FLAG POSITIVE CLE,ELB SAVE ADDRESS OF FIRST STB TEMP5 CHARACTER OF STRING ERB SAVE ADB M1 POINTER TO STB TEMP6 STRING LENGTH LDB TSTPT LOAD ADB .2 START-OF-STRING LDA 1,I DESIGNATOR STA MPT SAVE IT ADA TEMP5 RECORD CHARACTER ADDRESS STA TEMP5 OF START-OF-STRING STA SBPTR SAVE ADDRESS INB LOAD LDA 1,I END-OF-STRING DESIGNATOR INA,SZA SPECIFIED? JMP PSTR2 YES CCA NO CPA PS0 'SOURCE' MODE? JMP PSTR1 NO LDA TEMP6,I YES LOAD STRING'S AND B377 LOGICAL LENGTH JMP PSTR2 * PSTR1 STA PS1 SET FLAG TO -1 LDA TPRME COMPUTE CMA END-OF-STRING ADA MPT DESIGNATOR PSTR2 STA NQT SAVE IT CMA IS LENGTH ADA MPT OF SPECIFIED STRING SSA,RSS NEGATIVE? JSB ERROR YES STER1 STA TNULL ADA B400 NO SSA >255 JMP STER3-1 STRING OVERFLOW LDA TEMP6,I DOES AND B377 START-OF-STRING CMA CHARACTER ISZ PS0 RELATE TO INA PREVIOUS ADA MPT VALUE SSA,RSS OF STRING JMP PSTR3 NO LDA TEMP6,I YES,EXTRACT ISZ PS0 END-OF- ALF,ALF PERMITTED-STRING AND B377 DESIGNATOR CMA COMPUTE DIFFERENCE FROM ADA NQT END OF SPECIFIED STRING -1 CLB,INB 'SOURCE' CPB PS0 MODE? JMP PSTR5 NO LDB TNULL YES,SPECIFIED SOURCE STRING INA CONTAINED WITHIN SSA,RSS DEFINED SOURCE STRING ADB 0 NO, CORRECT LENGTH JMP PSTR4 OF ACTUAL SOURCE STRING * PSTR3 ISZ PS0 'SOURCE' MODE? JSB ERROR NO, NON-CONTIGUOUS STRING STER2 CCB YES SET ACTUAL LENGTH TO 0 PSTR4 LDA TEMP5 LOAD START-OF-STRING JMP PSTR,I CHARACTER ADDRESS PSTR5 SSA,RSS PHYSICAL STORAGE OVERFLOW? JSB ERROR YES, STRING OVERFLOW STER3 ISZ PS1 END-OF-STRING SPECIFIED?9 JMP PSTR7 YES * PSTR6 LDA TEMP6,I NO AND M256 RESET IOR NQT LOGICAL LENGTH STA TEMP6,I OF STRING JMP PSTR,I * PSTR7 LDA TEMP6,I IS NEW AND B377 DESTINATION CMA STRING ADA NQT LONGER SSA,RSS THAN OLD? JMP PSTR6 YES JMP PSTR,I * PS0 BSS 1 MPT BSS 1 PS1 BSS 1 NQT BSS 1 B400 OCT 400 TRS0 BSS 1 *********************** * * * TRANSFER A STRING * * * *********************** * * THE NUMBER OF CHARACTERS SPECIFIED BY TNULL (IN 1'S * COMPLEMENT) IS TRANSFERRED FROM THE SOURCE STRING TO * A DESTINATION STRING BEGINNING WITH THE CHARACTER * ADDRESSED BY TEMP5. * TRSTR NOP STA TRFCH SAVE FETCH CHAR ROUTINE ADDR ISZ TNULL MORE TRANSFER STRING? RSS YES JMP TRSTR,I NO JSB TRFCH,I FETCH A SOURCE CHARACTER LDA B40 NONE LEFT,LOAD A BLANK STA TRS0 SAVE IT LDB TEMP5 LOAD CLE,ERB DESTINATION LDA 1,I WORD SEZ,RSS SAVE ALF,ALF OTHER AND M256 CHARACTER IOR TRS0 COMBINE WITH SEZ,RSS NEW CHARACTER ALF,ALF AND STORE STA 1,I WORD ISZ TEMP5 INCREMENT DESTINATION ADDRESS JMP TRSTR+2 * **************************** * * * FETCH CHARACTER STRING * * * **************************** * * CHARACTER ADDRESS IN TEMP8, SOURCE CHARACTER COUNT * IN TPRME (IN 1'S COMPLEMENT). EXIT TO (P+1) ON NO * MORE CHARACTERS (TPRME = -1) ELSE EXIT TO (P+2) WITH * NEXT CHARACTER IN (A). * FSCH NOP LDA TPRME MORE CHARACTERS? INA,SZA,RSS JMP FSCH,I STA TPRME YES, UPDATE CHARACTER COUNT LDA TEMP8 LOAD CHARACTER CLE,ERA ADDRES9S LDA 0,I EXTRACT SEZ,RSS NEXT CHARACTER ALF,ALF AND B377 ISZ TEMP8 UPDATE CHARACTER ADDRESS ISZ FSCH JMP FSCH,I * *************************** * * * FETCH INPUT CHARACTER * * * *************************** * * EXITS NORMALLY TO (P+2) WITH NEXT INPUT CHARACTER IN (A). * IF THE CHARACTER IN (A) IS A QUOTE OR THE INPUT RECORD IS * EMPTY, EXIT TO TRSTR,I ( THE ONLY CALLER THAT CAN ENCOUNTER * THE SITUATION ). * FINCH NOP ISZ FINCH JSB GETCR FETCH NEXT CHARACTER JMP FINC1 END-OF-INPUT CPA B42 QUOTE? JMP TRSTR,I YES! JMP FINCH,I FINC1 LDA .10 SET END-OF-INPUT JMP TRSTR,I * ********************** * * * CHECK FOR ENOUGH * * * ********************** * OVCHK NOP NEW WORD REQUIREMNET IN (A) ADA PBPTR CHECK STA PBPTR CMA FOR ADA LWBM OVERFLOW SSA,RSS JMP E1 OUT OF STORAGE JMP OVCHK,I SKP * ****************************** * * * ROUND SUBSCRIPT TO INTEGER * * * ****************************** SBFIX NOP SUBSCRIPT IN (A) AND (B) JSB .FAD SET FOR ROUNDING DEF HALF JSB IFIX CONVERT TO INTEGER SOC WAS IT INTEGER? JMP SBFIX,I NO ADA M1 YES, BIAS BY -1 SSA,RSS POSITIVE INTEGER? ISZ SBFIX YES JMP SBFIX,I NO ******************** * * * INPUT A CONSTANT * * * ******************** CONST NOP JSB GETCR JMP CONST,I CLB SET SIGN STB SIGN POSITIVE INB CPA .43 '+' ? JMP CONS1 YES CPA .45 NO, '-' ? CCB,RSS YES JMP CONS2 NO CONS1 STB SIGN RECORD SIGN JSB GETCR FETCH NEXT JMP E13-1 CHARACTER CONS2 JSB NUMCK FETCH CONSTANT JMP CONS3 NONE FOUND JSB ERROR BAD EXPONENT PART E14 ISZ CONST SUCCESSFULLY FOUND JMP CONST,I EXIT VIA (P+2) CONS3 CPB SIGN SIGN FOUND? ( (B) = 0) CCA,RSS NO JSB ERROR YES, SOLITARY SIGN E13 JMP CONST,I EXIT VIA (P+1) .43 DEC 43 .45 DEC 45 SKP ********************** * * ** COMPUTE RND(X) ** * * ********************** * * THE RANDOM NUMBER FUNCTION COMPUTES A RANDOM NUMBER FROM THE * FORMULAS: * * X(N)=A*X(N-1)+C(MOD 2^30) (A=5^11,C=2^30*(1/2-1/SQR(12))) * RND =X/2^30 MIN (1-2^-23) * ERND NOP SSA,RSS POSITIVE ARGUMENT? JMP ERND1 YES, USE PREVIOUS VALUE RBL,CLE,ERB NO, MAKE A ELA STA RNDX1 A NEW SEED STB RNDX2 ERND1 EQU * LDA RNDX1 COMPUTE FIRST MPY RNDA2 CROSS PRODUCT. STA RNDX1 SAVE (ONLY NEED LOW ORDER PART) LDA RNDX2 COMPUTE 2ND MPY RNDA1 CROSS PRODUCT. ADA RNDX1 ADD IN FIRST. ADA RNDC1 ADD IN HIGH PART OF C. STA RNDX1 SAVE TOTAL. (THIS IS HIGH PART). CLE LDA RNDX2 COMPUTE LOW ORDER PRODUCT. MPY RNDA2 ADA RNDC2 ADD IN LOW PART OF C. SEZ ADD ANY CARRY INTO INB B. RAL,CLE,ERA E_A(15),A(15)_0. STA RNDX2 SAVE LOW ORDER RESULT. ELB SHIFT HIGH ORDER PART & ADD IN ADB RNDX1 PREVIOUS TOTAL. ELB,CLE,ERB CLEAR BIT 15 AND STORE. STB RNDX1 RAL SHIFT A ADJACENT TO B. SWP EXCHANGE REGISTERS AND JSB .PACK PACK. NOP CPB .2 TEST FOR RESULT=1.0 RSS JMP ERND,I EXIT IF NOT. LDA INF SET RESULT TO 1-2^-23 LDB M256 JMP ERND,I RNDA1 DEC 1490 A DIV 2^15 RNDA2 DEC 3805 A MOD 2^15 RNDC1 OCT 16441 C DIV 2^15 RNDC2 OCT 7701 C MOD 2^15 RNDX1 BSS 1 RNDX2 BSS 1 M5 DEC -5 SKP ***** * ** OCT ** BASIC FUNCTION TO CONVERT INTEGER FOR * OCTAL OUTPUT. ACTUALLY CONVERTS INTEGER * TO FLOATING POINT QUANTITY WHICH WILL * PRINT OUT AS OCTAL VALUE * * CALLING SEQUENCE: * * DLD FLOATING EQUIVALENT OF INTEGER * JSB OCT * RETURN (FLOATING PT VALUE IN .A.8.B.) * ***** * OCT NOP JSB IFIX CONVERT TO INTEGER LDB M5 INITIALIZE STB CNTR DIGIT COUNTER LDB ATBL INITIALIZE POINTER STB TEMP3 TO DIGIT TABLE STA 1 MOVE INTEGER TO .B. RBL USE SIGN BIT CLA AS VALUE SLB FOR FIRST INA DIGIT IN STA TEMP3,I TABLE OCT01 BLF,RBR POSITION NEXT OCTAL DIGIT LDA 1 AND .7 AND ISOLATE IT IN .A. ISZ TEMP3 BUMP POINTER TO TABLE STA TEMP3,I AND MAKE ENTRY ISZ CNTR BUMP COUNTER, MORE DIGITS? JMP OCT01 YES, GET THEM NOW * ** BUILD FLOATING POINT NUMBER * LDB M6 RESET STB CNTR DIGIT COUNTER LDB ATBL REINITIALIZE STB TEMP3 POINTER TO DIGIT TABLE CLA CLB DST VALUE INITIALIZE FLOATING PT VALUE OCT02 LDA TEMP3,I GET NEXT DIGIT ISZ TEMP3 BUMP TO NEXT ENTRY JSB FLOAT CONVERT TO FLOATING POINT JSB .FAD USE TO UPDATE VALUE DEF VALUE ISZ CNTR BUMP DIGIT COUNTER, DONE ? RSS JMP OCT,I YES, RETURN JSB .FMP NO, MULTIPLY BY 10, DEF FD10 DST VALUE UPDATE VALUE JMP OCT02 AND DO FOR NEXT DIGIT * ** STORAGE ** * VALUE BSS 2 CNTR BSS 1 ATBL DEF *+1 BSS 6 FD10 DEC 10. .7 DEC 7 * **************************** * Q * * READ ERROR CODE FUNCTION * * * **************************** * XERR NOP LDA ERRCD JSB FLOAT FLOAT CODE JMP XERR,I RETURN IN A-B REGISTERS * ***************************** * * * SET ERROR CODE SUBROUTINE * * * ***************************** * ERRCD NOP SERR NOP JSB IFIX CONVERT TO INTEGER STA ERRCD SAVE JMP SERR,I * ******************* * * * TIME FUNCTION * * * ******************* * TIM NOP JSB IFIX FIX INPUT PARAMETER STA TEMP3 AND SAVE JSB EXEC GET DEF *+4 TIME DEF .11 FROM DEF ATBL+1 THE DEF ATBL+6 SYSTEM LDA TEMP3 DETERMINE ADA .2 WHICH ADA ATBL TIME THE USER WANTS LDA 0,I GET IT JSB FLOAT AND FLOAT IT JMP TIM,I RETURN * .11 DEC 11 * SKP **************** * * * SGN FUNCTION * * * **************** * ESGN NOP CLB SZA,RSS ZERO? JMP ESGN,I YES! SSA,RSS NO, POSITIVE? LDB .2 YES, SET EXPONENT LDA FLGBT LOAD MANTISSA SZB POSITIVE? RAR YES, CORRECT MANTISSA JMP ESGN,I * * ******************************************** * * ** EXECUTE SWITCH REGISTER TEST FUNCTION ** * * ******************************************** ESWR NOP JSB .IENT CONVERT TO 16 BIT INTEGER JMP FNERR-1 TOO BIG LDB 0 AND .15 CPA 1 NUMBER OUTSIDE RANGE 0-15? RSS NO JMP FNERR-1 YES LIA 1 READ SWITCH REGISTER SZB,RSS IS THIS THE SWITCH? JMP ESWR1 YES RAfR MOVE TO NEXT SWITCH ADB M1 JMP *-4 * ESWR1 AND .1 ISOLATE THAT BIT JSB FLOAT CONVERT TO FLOATING POINT JMP ESWR,I RETURN * * SKP * *********************** * * * PRINT ERROR MESSAGE * * * *********************** ERROR NOP LDA ERBS ERROR ADDRESS IN (A) LDB ERROR ERROR SOURCE IN (B) INA MOVE TO NEXT ERROR CPB 0,I SAME AS ACTUAL ERROR? CMA,INA,RSS YES, MAKE ERROR NEGATIVE JMP *-3 NO ADA ERBS MAKE ERROR POSITIVE CMA,INA ADA .45 ACCOUNT FOR SHORTENED TABLE STA TEMP3 SAVE IT LDA .3 JMP SEG8 PRINT ERROR MESSAGE, AFTER CLEANING HOUSE * * * ******************************************** * * * COMPUTE DATA TYPE * * * ******************************************** * UPON ENTRY (A) AND (B) MUST HAVE A F.P. 0 TO REFERENCE * THE DATA STATEMENT. RETURNS 1,2,3 IF THE DATA ITEM IS * A NUMBER,STRING,END-OF-FILE RESPECTIVILY. * ETYP NOP .DUMMY ENTRY POINT ALLOWS USE SZA,RSS .DATA STATEMENT REFERENCE ? JMP ETYP3 .YES - ONLY ONE ALLOWED IN M BASIC JSB ERROR . OF MURTB BRTBL FNER1 EQU * * ETYP1 JSB FLOAT .PUT RESULT INTO FLOATING PT JMP ETYP,I .AND EXIT ETYP2 LDB NXTDT .OUT OF DATA ? LDA DATA JSB STSRH JMP ETYP5 .YES JSB SETDP .NO , SET DATA POINTERS ETYP3 CCA .MORE DATA IN CURRENT STATEMENT? CPA DCCNT JMP ETYP2 .NO LDB NXTDT,I .YES LOAD TYPE WORD CLA,INA .SET NUMBER SSB,RSS .IS IT A NUMBER? LDA .2 .NO SET TO STRING JMP ETYP1 ETYP5 LDA .3 JMP ETYP1 SKP *************** * * * ERROR TABLE * * 0 * *************** ERBS DEF * ERR DEF E1+1 OUT OF STORAGE DEF E2 GOSUBS NESTED 10 DEEP DEF E3 RETURN WITH NO PRIOR GOSUB DEF E4 OUT OF DATA DEF E5 WRONG DATA TYPE DEF E6 SUBSCRIPT OUT OF BOUNDS DEF E7 STATEMENT REFERENCED NOT DATA DEF E8 UNDEFINED VALUE ACCESSED DEF E13 BAD DATA ITEM DEF E14 BAD EXPONENT DEF E15 .SUB. OR FUNCTION PARAMETER ERROR DEF TERR1 TRAP TABLE FULL DEF TERR2 BAD TRAP/SEQ # COMBINATION DEF TERR3 SCHEDULED BUT DELETED TASK DEF TERR4 TRAP TABLE BUSY DEF STER1 NEGATIVE STRING LENGTH DEF STER2 NON-CONTIGUOUS STRING DEF STER3 STRING OVERFLOW DEF XEC5 UNDEFINED STATEMENT REFERENCE DEF BASER NEGATIVE NUMBER TO REAL POWER DEF POWER ZERO TO ZERO POWER DEF ZRTNG ZERO TO NEGATIVE POWER DEF FNERR OUT OF RANGE IN FUNCTION DEF LOGER LOG OF NEG ARGUMENT DEF EXPER EXP OF NEG ARGUMENT DEF FNER1 .ILLEGAL FUNCTION SKP NFMT EQU TEMPS+1 TEMP1 EQU TEMPS+2 TEMP2 EQU TEMPS+3 TEMP3 EQU TEMPS+4 TEMP4 EQU TEMPS+5 TEMP5 EQU TEMPS+6 TEMP6 EQU TEMPS+7 TEMP7 EQU TEMPS+8 TEMP8 EQU TEMPS+9 TEMP9 EQU TEMPS+10 TEM10 EQU TEMPS+11 EFMT EQU TEMPS+12 RFLAG EQU TEMPS+13 HTEMP EQU TEMPS+14 NUMO1 EQU TEMPS+15 UTEMP EQU TEMPS+16 TWO WORD ARRAY TRFCH EQU TEMPS+18 ADDRESS OF FETCH CHAR ROUTINE FERR EQU TEMPS+19 FILE ERROR FLAG FILE# EQU TEMPS+20 FILE REFERENCE NUMBER RCRD# EQU TEMPS+21 RECORD REFERENCE NUMBER EORFL EQU TEMPS+22 END-OF-RECORD FLAG DADDR EQU TEMPS+23 FILE LOCATION PTR FILT EQU TEMPS+24 FILE REQUEST TYPE RQ2 EQU TEMPS+25 TABFG EQU TEMPS+26 * END QNLHHN e@ 92065-18006 1726 S C0122 &MBC50 RTE-M BASIC COMMAND SUBR             H0101 +ASMB,R HED <> 92065-16001 NAM BASC5,7 92065-16001 REV.1726 770512 * * DATE REVISED 5-12-77 * * * ************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * * PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ************************************************************** * * * * SOURCE: 92065-18006 * * * ************************************************************* * * ENT BASC5 EXT GETNM,CHRCK,LIMEM,MVNAM EXT TRAP,PRMT,INTCK,FNDPS,EXEC EXT RUN,PLIST,LOADT,DIGCK,LETCK EXT FINDV,WRITE,INDCK,OUTER,GETCR COM TEMPS(30),PNTRS(61),SPEC(10) ***************************************** * * * SEGMENT #5: EXECUTE THE COMMAND * * * ***************************************** * * THIS PART OF THE INTERPRETER IS LOADED BY THE BASIC MAIN CONTROL * WHENEVER A STATEMENT IS FOUND THAT DOES NOT START WITH A STATE- * MENT NUMBER.THE STATEMENT IS THEN CHECKED TO SEE IF IT IS * A LEGAL COMMAND WITH PROPER SYNTAX. IF SO THE CORRECT COMMAND * ROUTINE IS EXECUTED AND CONTROL RETURNED TO * MAIN CONTROL, ELSE AN ERROR MESSAGE IS PRINTED. SKP *************************** * * * CONSTANTS AND VARIABLES * * * *************************** * FWAM EQU PNTRS FIRST WORD OF AVAILABLE MEMORY LWBM EQU PNTRS+1 LAST WORD OF AVAILABLE MEMORY .INBF EQU PNTRS+2 INPUT BUFFER ADDRESS SBUFA EQU PNTRS+3 SYNTAX BUFFER ADDRESS SYMTA EQU PNTRS+4 START OF SYMBOL TABLE SYMTF EQU PNTRS+5 END OF SYMBOL TABLE PBUFF EQU PNTRS+6 FIRST WORD OF USER PROGRAM PBPTR EQU PNTRS+7 LAST WORD+1 OF USER PROGRAM INBFA EQU PNTR S+8 INPUT BUFFER POINTER ICCNT EQU PNTRS+9 INPUT CHARACTER COUNT SBPTR EQU PNTRS+10 SYNTAX BUFFER POINTER .LNUM EQU PNTRS+11 CURRENT LINE # FCORE EQU PNTRS+12 START OF FREE CORE MNNAM EQU PNTRS+13 MNEMONIC TABLE NAME:SC:LU BRNAM EQU PNTRS+18 BRANCH TABLE NAME:SC:LU FWAMM EQU PNTRS+23 POINTER TO START OF MNEMONIC TABLE FWAMB EQU PNTRS+24 POINTER TO START OF BRANCH TABLE .OTBF EQU PNTRS+25 POINTER TO OUTPUT BUFFER OCCNT EQU PNTRS+26 OUTPUT CHARACTER COUNT OTBFA EQU PNTRS+27 POINTER INTO OUTPUT BUFFER LUOUT EQU PNTRS+28 CURRENT OUTPUT L.U. # LUINP EQU PNTRS+29 CURRENT INPUT L.U. # SIGN EQU PNTRS+30 SIGN OF CURRENT NUMBER BLANK EQU PNTRS+31 CURRENT TERMINATION CHAR REC# EQU PNTRS+32 COMMAND FILE RECORD NUMBER FLTYP EQU PNTRS+33 TYPE 0 FILE FLAG TTYPR EQU PNTRS+34 CONSOLE TTY L.U. # PRINT EQU PNTRS+35 LISTING L.U. # READR EQU PNTRS+36 AUXILLIARY INPUT L.U. # PUNCH EQU PNTRS+37 AUXILLIARY OUTPUT L.U. # ERTTY EQU PNTRS+38 ERROR LIST OUTPUT L.U. # FLFIL EQU PNTRS+39 FILE SAVE-RESTORE FLAG SAVFL EQU PNTRS+40 .SAVE COMMAND FLAG PFLAG EQU PNTRS+41 SAVE,LOAD FILE FLAG LOLIM EQU PNTRS+42 LOW LIMITS OF PROGRAM HILIM EQU PNTRS+43 HIGH LIMITS OF PROGRAM LORUN EQU PNTRS+44 LOW RUN LIMITS HIRUN EQU PNTRS+45 HIGH RUN LIMITS SLSTM EQU PNTRS+46 EXECUTE SLOW STMTS LOTRC EQU PNTRS+47 LOW TRACE LIMITS HITRC EQU PNTRS+48 HIGH TRACE LIMITS BRKP1 EQU PNTRS+49 BREAK POINT #1 BRKP2 EQU PNTRS+50 BREAK POINT #2 BRKP3 EQU PNTRS+51 BREAK POINT #3 BRKP4 EQU PNTRS+52 BREAK POINT #4 SMFLG EQU PNTRS+53 SIMULATE FLAG TYPE EQU PNTRS+54 PARTIAL LINE CHARACTER COUNT DLMTR EQU PNTRS+55 CHAR EDIT DELIMITER MERGF EQU PNTRS+56 MERGE FLAG SKP TEMPT BSS 22 TEMPORARIES SPC 1 SUP PRESS MULTIPLE LISTINGS SPC 1 .1 DEC 1 .2 DEC 2 .6 DEC 6 .7 DEC 7 .8 DEC 8 .10 DEC 10 .9999 DEC 9999 B13 OCT 13 B14 OCT 14 B105 OCT 105 MAXSN DEC +10000 TEMAD DEF TEMP8 BIT BUCKET LENGC EQU LUOUPT-FWAM LENCM ABS LENGC A EQU 0 B EQU 1 SKP * CMDCT DEC -11 -NUMBER OF COMMANDS * CMDS EQU * * * * COMMAND MNEMONICS START HERE * OCT 3 ASC 2,RUN EXECUTE PROGRAM * OCT 3 ASC 2,DEL DELETE PROGRAM * OCT 4 ASC 2,SAVE SAVE PROGRAM * OCT 4 ASC 2,LIST LIST PROGRAM * OCT 4 ASC 2,LOAD LOAD PROGRAM * OCT 3 ASC 2,BYE TERMINATE BASIC * * OCT 5 ASC 3,MERGE MERGE PROGRAM * * DEC 6 ASC 3,REWIND REWIND TAPE * DEC 4 ASC 2,WEOF WRITE END-OF-FILE * DEC 5 ASC 3,SKIPF SKIP FILE FORWARD * DEC 5 ASC 3,BACKF SKIP FILE REVERSE * * ********************************************************************** * * * THE FOLLOWING TABLE DEFINES ENTRY POINTS FOR EXECUTION * OF COMMANDS. * ********************************************************************** * * * * CMDEX DEF *+1 DEF $RUN EXECUTE PROGRAM DEF $DEL DELETE DEF $SAVE SAVE DEF $LIST LIST DEF $LOAD LOAD DEF $BYE TERMINATE BASIC DEF $MERG MERGE PROGRAM DEF $REW REWIND TAPE DEF $WEOF WRITE END-OF-FILE DEF $SKIP SKIP FILE FORWARD DEF $BACK SKIP FILE REVERSE SKP *************************** * * * CHECK FOR LEGAL COMMAND * * * *************************** * BASC5 NOP LDA .32 SETUP STA BLANK TO SKIP BLANKS STA SAVFL .RESET SAVE FLAG * * LDA SBPTR,I GET FIRST LETTER CPA DLMTR PRINT NEXT LINE COMMAND? JMP PNEXT YES, DO IT TO IT LDB CMDCT SEARCH FOR LEGAL COMMAND JSB TBSRH DEF CMDS JMP CERR1-1 .CAN'T FIND IT - ERROR ADA CMDCT DETERMINE ORDINAL # IN B&M TABLE CMA,INA 4 ADA COUNT ADA CMDEX INCREMENT TO ENTRY PT ADDRESS LDA 0,I GET ADDRESS OF COMMAND JSB INDCK MAKE DIRECT JMP 0,I EXECUTE THE COMMAND * JMP PRMT GO TO 'READY' * * * SKP * HERE FOR: DEL [] * $DEL JSB GETCR FETCH NEXT CHARACTER JMP DEL1 EOF! CPA B105 'E'? JMP DEL2 YES, MAYBE 'DELETE'? JSB PGOLM NO, FETCH LINE #'S NOP EOF DETECTED? LDA LOLIM GET PROGRAM'S LDB HILIM LIMITS AND STA TEMP4 SAVE DESTINATION ADDRESS CLPR1 CPB PBPTR ALL OF PROGRAM MOVED? JMP CLPR2 YES LDA 1,I NO, MOVE WORD FROM SOURCE TO STA TEMP4,I DESTINATION ADDRESS ISZ TEMP4 INCREMENT DESTINATION ADDRESS INB INCREMENT SOURCE ADDRESS JMP CLPR1 CLPR2 LDA TEMP4 SET END-OF-PROGRAM STA PBPTR POINTER JMP PRMT DEL1 JSB SCR DELETE PROGRAM JMP PRMT RETURN * DEL2 CCB SEARCH FOR JSB TBSRH 'ETE' DEF ETE JMP CERR1-1 NOT FOUND JMP $DEL OK! * ETE OCT 3 ASC 2,ETE * SKP * * HERE FOR: RUN [] FROM * $RUN JSB GETCR FETCH NEXT CHAR JMP RUN EOF! JSB LIMCK LIMITS LEGAL LDB LOLIM SET UP STB LORUN RUN LDB HILIM LIMITS STB HIRUN FOR EXECUTION LDB .1 RESTORE STB LOLIM LIMITS LDB .9999 SO ALL STB HILIM OF PROG GETS LOADED CPA .10 LOAD PROGRAM? JMP RUN NO! LDB .5 .ASSUME "RUN FROM" COMMAND STB PFLAG JSB FROMS CHECK "FROM" SYNTAX JSB SCR DELETE CURRENT PROGRAM JMP LOADT NO! * .5 DEC 5 * SKP * * HERE FOR: SAVE,CHANGE OR LIST [] ON * * LISTF=0 FOR L4IST COMMAND AND # 0 FOR SAVE * $LIST CLA SET DEFAULT TO JMP $SAVE+1 LIST FLAG FOR TYPE 0 FILE SPC 1 $SAVE CCA SET DEFAULT TO STA PFLAG PUNCH DEVICE STA SAVFL .SET SAVE COMMAND FLAG CLA RESET SAVE1 STA TEMP6 PURGE FLAG LDA PBUFF INITIALIZE STA LOLIM LIMITS LDA PBPTR TO INCLUDE STA HILIM ALL OF PROGRAM JSB GETCR FETCH NEXT NON-BLANK CHAR JMP PLIST EOF! JSB PGOLM GET PROGRAM LIMITS JMP PLIST EOF DETECTED, ASSUME DEFAULT JSB ONS MORE, CHECK "ON" SYNTAX JMP PLIST * SKP * * HERE FOR: >/ LIST NEXT LINE * PNEXT JSB GETCR GET FIRST CHAR JMP PNEX2 EOF, NO STMT # JSB DIGCK NUMBER? JSB ERROR INVALID NUMBER CER14 ADA .48 JSB INTIN FETCH NUMBER DEF MAXSN SZB,RSS ZERO? JMP CER14-1 YES, BAD! LDA 1 JMP PNEX3 * PNEX2 LDA .LNUM GET CURRENT LINE # CPA .9999 LAST STATEMENT OF PROG? PNEX1 CLA YES! INA NO, GET PNEX3 JSB FNDPS AND DETERMINE WHAT JMP PNEX1 THE NEXT ONE NOP IF ANY LDA 1,I THEN STA .LNUM SET UP STB LOLIM LIMITS INA JSB FNDPS FIND NOP POSITION NOP OF NEXT STB HILIM STATEMENT JMP PLIST ONE LINE ONLY * SPC 3 * HERE FOR: BYE * * $BYE LDA .2 OPEN JSB TRAP UP NOP TRAP TABLE JSB LIMEM .RELEASE MEMORY DEF *+4 DEF M32 DEF * DEF * JSB EXEC TERMINATE BASIC PROGRAM DEF *+2 DEF .6 * * SKP * * * HERE FOR: LOAD OR MERGE [] FROM * $MERG CCA SET FLAG SO 'ACTST' 35DOESN'T OVERLAY STMTS STA MERGF IN SYNTAX SEGMENT * $LOAD STA PFLAG SET FOR DEFAULT INPUT JSB GETCR GET NEXT CHAR JMP LTAPE LOAD FROM DEFAULT DEVICE JSB LIMCK FETCH PROG LIMITS CPA .10 EOF ? RSS .YES USE DEFAULT DEVICE LDB .2 .ASSUME SPEC LU# LOAD/MERGE STB PFLAG JSB FROMS CHECK "FROM"SYNTAX LTAPE LDA MERGF IS THIS A SZA,RSS 'MERGE'? JSB SCR NO, DELETE PROGRAM! JMP LOADT NO, LOAD AND CHECK SYNTAX * * * JSB ERROR NONE FOUND * CERR1 NOP * HERE FOR: REWIND * $REW LDA .4 SET CONTROL JMP FCNT REWIND SPC 1 $WEOF LDA .1 SET CONTROL JMP FCNT WRITE EOF SPC 1 $SKIP LDA B13 SET CONTROL JMP FCNT FOR SKIP FILE FORWARD SPC 1 $BACK LDA B14 SET CONTROL FOR BACK SPACE FILE FCNT CLB RRL 6 SET UP STA ICODE CONTROL WORD * JSB GETCR GET FIRST CHAR JMP CERR1-1 NO NAME FOUND JSB INTIN .INPUT LU # AND CHECK OCT 1653 . FOR MAXIMUM LU LDA B * IOR ICODE .INSERT LU# RETURNED IN A STA ICODE JSB EXEC .PERFORM REWIND DEF *+3 DEF .3 DEF ICODE .CONTROL WORD FOR CONTROL JMP PRMT .RETURN TO PROMPT * ICODE BSS 1 .3 DEC 3 .4 DEC 4 SKP * ******************************************* * * * TABLE SEARCH FOR MULTICHARACTER SYMBOLS * * * ******************************************* TBSRH NOP STA SBPTR,I LDA TBSRH,I JSB INDCK PEEL OFF INDIRECTS ISZ TBSRH STA TABLE STORE TABLE ADDRESS STB LNGTH STORE -(NUMBER OF ENTRIES) LDA INBFA SAVE STA TEMP3 INPUT LDA ICCNT fBUFFER STA TEMP4 STATUS LDA SBPTR INITIALIZE END-OF-SYMBOL STA SMEND POINTER CLA,INA COUNT FIRST CHARACTER OF STA SLENG SYMBOL LDA SBPTR,I FETCH PARTIAL SYMBOL ALF,ALF LEFT-JUSTIFY IOR .32 FIRST CHARACTER AND STA SBPTR,I APPEND BLANK TSRC1 JSB GETCR FETCH NEXT CHARACTER JMP TSRC9 END-OF-STATEMENT LDB SLENG CHECK FOR CPB .8 IMPOSSIBLE LENGTH JMP TSRC9 SLB EVEN-NUMBERED CHARACTER? JMP TSRC2 YES ISZ SMEND NO, FETCH FRESH WORD, ALF,ALF LEFT-JUSTIFY CHARACTER, IOR .32 APPEND BLANK, JMP TSR10 TSRC2 ADA M32 DELETE BLANK, ADA SMEND,I FILL SECOND CHARACTER, TSR10 STA SMEND,I AND STORE ISZ SLENG COUNT IT LDB LNGTH INITIALIZE TABLE LENGTH STB COUNT COUNTER LDA TABLE TSRC3 STA TBLPT SET TABLE POINTER LDA TBLPT,I EXTRACT SYMBOL LENGTH AND .7 FROM TABLE AND COMPARE CPA SLENG WITH CURRENT SYMBOL JMP TSRC5 EQUAL? TSRC4 ADA .3 DIFFERENT, ARS UPDATE ADA TBLPT TABLE POINTER ISZ COUNT MORE ENTRIES? JMP TSRC3 YES JMP TSRC1 NO * TSRC5 LDB TBLPT SET POINTER TO STB TSPTR TABLE SYMBOL LDB SBPTR SET (B) TO INPUT JMP TSRC7 SYMBOL POINTER TSRC6 CPB SMEND ALL OF SYMBOL CONSIDERED? JMP TSRC8 YES, MATCH OCCURRED INB NO, INCREMENT TSRC7 ISZ TSPTR SYMBOL POINTERS LDA TSPTR,I FETCH WORD FROM TABLE CPA 1,I MATCH WITH INPUT SYMBOL? JMP TSRC6 YES LDA SLENG NO, WRONG JMP TSRC4 SYMBOL TSRC8 LDA TBLPT,I EXTRACT AND OPMSK SYMBOL CODE STA SBPTR,I ISZ TBSRH AND RETURN VIA JMP TBSRH,I 'SUCCESS' UEXIT TSRC9 LDA TEMP3 RESTORE STA INBFA INPUT LDA TEMP4 BUFFER STA ICCNT STATUS LDA SBPTR,I GET ORIGINAL CHAR ALF,ALF POSITION IT AND MSK0 ISOLATE IT JMP TBSRH,I 'FAILURE' EXIT * M32 DEC -32 OPMSK OCT 77000 MSK0 OCT 377 SKP * ****************************************************** * * FIND REQUESTED PROGRAM CORE LIMITS * * CALL SEQ: (A)=NEXT CHAR * JSB PGOLM * RETURN: P+1: EOF DETECTED * P+2: MORE INPUT TO COME * (A)=NEXT CHAR * LOLIM=LOW CORE LIMIT * HILIM=HI CORE LIMIT * ***************************************************** * PGOLM NOP JSB LIMCK FETCH PROGRAM LIMITS STA TEMP5 SAVE NEXT CHAR LDA LOLIM JSB FNDPS FIND POSITION NOP OF 1ST STATEMENT NOP STB LOLIM SAVE IT LDA HILIM INA JSB FNDPS FIND POSITION NOP OF LAST STATEMENT NOP STB HILIM SAVE IT LDA TEMP5 RETRIEVE NEXT CHAR CPA .10 EOF ?? JMP PGOLM,I YES, TAKE P+1 RETURN ISZ PGOLM JMP PGOLM,I NO, TAKE P+2 EXIT * * SKP ******************************************************** * * FETCH PROGRAM LIMITS FROM INPUT BUFFER * ACCORDING TO THE FOLLOWING SYNTAX: * ...... * ...... * ...... * CALL SEQ: (A)=NEXT CHAR * JSB LIMCK * RETURN: (A)=NEXT CHAR * LOLIM = LO LIMIT ; HILIM = HIGH LIMIT * ******************************************************** * LIMCK NOP CLB,INB SET UP STB LOLIM DEFAULT LIMITS LDB .9999 1-9999 STB HILIM LDB M2 STB TEMP4 RSS LIM3 JSB GETCR FETCH NEXT CHAR P NOP LIM1 JSB DELM DELIMITER ? JMP LIM3 YES, IGNORE CPA .43 PLUS? JMP LIM3 YES! CPA .45 MINUS? JMP CERR2-1 YES, VERY BAD JSB DIGCK DIGIT ? JMP LIMCK,I NO,EXIT ADA .48 YES, JSB INTIN FETCH # DEF MAXSN & SZB,RSS ZERO? JMP CERR2-1 YES, BAD STB HILIM SAVE IT ISZ TEMP4 DONE ? RSS JMP LIM2 STB LOLIM NO, CONTINUE JMP LIM1 LIM2 INB INSURE CMB,INB LOLIM<=HILIM ADB LOLIM SSB,RSS JSB ERROR INVALID LIMITS CERR2 LDB .32 OK, SET UP FOR STB BLANK FREE FORMAT INPUT RSS FETCH NEXT JSB GETCR NON-DELIMITER NOP JSB DELM CHARACTER JMP *-3 (A)=NEXT CHAR JMP LIMCK,I & RETURN * .43 DEC 43 .45 DEC 45 .48 DEC 48 .32 DEC 32 M2 DEC -2 * **************************************************** * * DELM WILL TEST FOR A DELIMITER * **************************************************** * DELM NOP CPA .32 BLANK? JMP DELM,I YES, P+1 RETURN CPA B54 COMMA? JMP DELM,I YES ISZ DELM NEITHER TAKE JMP DELM,I P+2 RETURN * B54 OCT 54 * * * ***************************************************** * * INTIN WILL BUILD AN INTEGER FROM INPUT * * CALL SEQ: (A)=CURRENT CHAR * JSB INTIN * DEF (MAX #) * RETURN: (B)=INTEGER * ***************************************************** * INTIN NOP STA TEMP5 SAVE CUR. CHAR. LDA INTIN,I FETCH JSB INDCK MAXIMUM LDA A,I CMA,INA STA INTI1 ALLOWABLE ISZ INTIN LIMIT LDA SBPTR SAVE STA TEMP1 SBPTR LDA TEMAD STATUS STA SBPTR LDA TEMP5  RECOVER CUR.CHAR. JSB INTCK FETCH INTEGER DEF INTI1 JMP CERR8-1 STA TEMP5 LDA TEMP1 RESTORE STA SBPTR SBPTR STATUS LDA TEMP5 JMP INTIN,I * INTI1 NOP SKP **************************************************** * * SET FROM / TO FLAG * * ***************************************************** * FROMS NOP LDB .2 STB FRMTO .SET FROM FLAG CCB JSB TBSRH DEF FROM JMP CERR1-1 .NOT FOUND SYNTAX ERROR * JSB GETCR JMP CERR8-1 JSB FILCK .CHECK FOR FILE NAME OK JMP FROMS,I .YES GO BACK JSB INTIN .BUILD LU # OCT 1653 .LUMAX SZA,RSS JMP CERR8-1 .NOT VALID LU STB LUINP JMP FROMS,I .EXIT- SUCCESSFUL * JSB ERROR .INVALID LU # CERR8 EQU * * FROM OCT 4 ASC 2,FROM ON OCT 2 ASC 1,ON * * ONS NOP CLB,INB STB FRMTO .SET FROM/TO FLAG CCB .LOOK FOR "ON" JSB TBSRH DEF ON JMP CERR1-1 .NOT FOUND SYNTAX ERROR JSB GETCR .FETCH NEXT CHARACTER JMP CERR8-1 .ERROR IF NO LU# SPECIFIED JSB FILCK .CHECK FOR FILE NAME OK JMP ONS,I .YES GO BACK JSB INTIN .BUILD LU # OCT 1653 SZA,RSS JMP CERR8-1 .NOT VALID LU STB LUOUT LDB .2 .SET PFLAG TO LU INPUT STB PFLAG JMP ONS,I .EXIT WITH LU * SKP D53 OCT -53 FILCK NOP JSB LETCK CHECK FOR ALPHA RSS .NOT ALPHA - CHECK SPEC CHAR JMP FILE .GO PROCESS FILES LDB A ADB D53 .ALLOW !#$%&'()* SSB,RSS . AS FIRST CHAR JMP NFILE .NO FILE NAME ADB .10 SSB,RSS JMP FILE .YES LIGIT NFILE CLB .NO FILE RESET FLAG STB FLFIL ISZ FILCK .EXIT NO FILE JMP FILCK,I * FILE JSB MV{NAM .CHECK FOR FILE HANDLER JMP NFILE .NO HAND CCB STB FLFIL .SET FILE FLAG JMP FILCK,I SKP **************************************************** * * SCRATCH SUBROUTINE * * CALL SEQ: JSB SCR * RETURN: P+1: NORMAL * *************************************************** * SCR NOP LDA FWAM STA PBUFF SET PROGRAM BUFFER ADDRESS STA PBPTR SET PROGRAM BUFFER POINTER LDA .32 INITIALIZE STA BLANK DELETE CHARACTER FOR GETCR CLA SET LINE NUMBER STA .LNUM TO 0 INITIALLY JMP SCR,I * ************ * *********************** * * * PRINT ERROR MESSAGE * * * *********************** ERROR NOP CLA RESET STA PFLAG FILE FLAG STA .LNUM AND DO NOT PRINT LINE # FLAG LDB ERROR ERROR SOURCE IN (B) LDA ERBS ERROR ADDRESS IN (A) INA MOVE TO NEXT ERROR CPB 0,I SAME AS ACTUAL ERROR? CMA,INA,RSS YES, MAKE ERROR NEGATIVE JMP *-3 NO ADA ERBS MAKE ERROR POSITIVE CMA,INA ADA .71 ACCOUNT FOR LENGTH OF TABLE STA TEMP3 SAVE IT JMP OUTER PRINT ERROR MESSAGE * .71 DEC 71 ERBS DEF ERR-1 SKP *************** * * * ERROR TABLE * * * *************** ERR DEF CERR1 NOT A VALID COMMAND DEF CERR2 INVALID LIMITS DEF CERR8 INVALID LU DEF CER14 INVALID STATEMENT NUMBER * TEMP EQU TEMPS+1 TEMP1 EQU TEMPS+2 TEMP2 EQU TEMPS+3 TEMP3 EQU TEMPS+4 TEMP4 EQU TEMPS+5 TEMP5 EQU TEMPS+6 TEMP6 EQU TEMPS+7 TEMP7 EQU TEMPS+8 TEMP8 EQU TEMPS+9 TEMP9 EQU TEMPS+10 TEM10 EQU TEMPS+11 COUNT EQU TEMPT+1 JREC EQU TEMPT+2 FRMTO EQU TEMPT+3 TABLE EQU TEMPT+4 SMEND EQU TEMPT+5 SLENG EQU TEMPT+6 TBLPT EQU TEMPT+7 TSPTR EQU TEMPT+8 LNGTH EQU S3HFBTEMPT+9 FERR EQU TEMPT+10 TYP EQU TEMPT+11 NAME EQU TEMPT+12 ARRAY OF 5 WORDS SC EQU TEMPT+15 LU EQU TEMPT+16 NNAME EQU TEMPT+17 ARRAY OF 3 WORDS * END H fw 92065-18007 1650 S C0122 &MBC80 RTE-M SLOW STATEMENT SUBR             H0101 3sASMB,R HED <> 92065-16001 NAM BASC8,7 92065-16001 REV.1650 761022 * * REVISED 3-31-76 * * SOURCE 92065-18007 * ************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1975. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * * PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ************************************************************** ENT BASC8,ERROR EXT IFBRK,TRAP,RDYPT,OUTER,OUTLN,OUTIN,WRITE,FINDV EXT IFIX,PRNIN,REED,SERR,FLOAT,.ENTR COM TEMPS(30),PNTRS(61),SPEC(10) ***************************************** * * * SEGMENT #8: EXECUTE THE PROGRAM * * * ***************************************** * * THIS PART OF THE INTERPRETER IS LOADED BY THE EXECUTE PHASE OF * BASIC TO PERFORM CERTAIN FUNCTION WHICH ARE NOT TIME CRITICAL. * CONTROL IS PASSED TO THIS SEGMENT WITH THE VARIABLE 'XSEG7' IN- * DICATING WHICH FUNCTION IS TO BE PERFORMED. AFTER COMPLETION OF * THE FUNCTION, CONTROL IS RETURNED TO EXECUTE SEGMENT 4 AND * EXECUTION OF THE USER'S PROGRAM IS RESUMED. SKP *************************** * * * CONSTANTS AND VARIABLES * * * *************************** * FWAM EQU PNTRS FIRST WORD OF AVAILABLE MEMORY LWBM EQU PNTRS+1 LAST WORD OF AVAILABLE MEMORY .INBF EQU PNTRS+2 INPUT BUFFER ADDRESS SBUFA EQU PNTRS+3 SYNTAX BUFFER ADDRESS SYMTA EQU PNTRS+4 START OF SYMBOL TABLE SYMTF EQU PNTRS+5 END OF SYMBOL TABLE PBUFF EQU PNTRS+6 FIRST WORD OF USER PROGRAM PBPTR EQU PNTRS+7 LAST WORD+1 OF USER PROGRAM INBFA EQU PNTRS+8 INPUT BUFFER POINTER ICCNT EQU PNTRS+9 INPUT CHARACTER COUNT SBPTR EQU PNTRS+10 SYNTAX BUFFER POINTER .LNUM EQU PNTRS+11 )CURRENT LINE # FCORE EQU PNTRS+12 START OF FREE CORE MNNAM EQU PNTRS+13 MNEMONIC TABLE NAME:SC:LU BRNAM EQU PNTRS+18 BRANCH TABLE NAME:SC:LU FWAMM EQU PNTRS+23 POINTER TO START OF MNEMONIC TABLE FWAMB EQU PNTRS+24 POINTER TO START OF BRANCH TABLE .OTBF EQU PNTRS+25 POINTER TO OUTPUT BUFFER OCCNT EQU PNTRS+26 OUTPUT CHARACTER COUNT OTBFA EQU PNTRS+27 POINTER INTO OUTPUT BUFFER LUOUT EQU PNTRS+28 CURRENT OUTPUT L.U. # LUINP EQU PNTRS+29 CURRENT INPUT L.U. # SIGN EQU PNTRS+30 SIGN OF CURRENT NUMBER BLANK EQU PNTRS+31 CURRENT TERMINATION CHAR REC# EQU PNTRS+32 COMMAND FILE RECORD NUMBER FLTYP EQU PNTRS+33 TYPE 0 FILE FLAG TTYPR EQU PNTRS+34 CONSOLE TTY L.U. # PRINT EQU PNTRS+35 LISTING L.U. # READR EQU PNTRS+36 AUXILLIARY INPUT L.U. # PUNCH EQU PNTRS+37 AUXILLIARY OUTPUT L.U. # ERTTY EQU PNTRS+38 ERROR LIST OUTPUT L.U. # DCB EQU PNTRS+39 DATA CONTROL BLOCK ADDRESS FILBK EQU PNTRS+40 FILE CONTROL BLOCK ADDRESS PFLAG EQU PNTRS+41 SAVE,LOAD FILE FLAG LOLIM EQU PNTRS+42 LOW LIMITS OF PROGRAM HILIM EQU PNTRS+43 HIGH LIMITS OF PROGRAM LORUN EQU PNTRS+44 LOW RUN LIMITS HIRUN EQU PNTRS+45 HIGH RUN LIMITS SLSTM EQU PNTRS+46 EXECUTE SLOW STMTS LOTRC EQU PNTRS+47 LOW TRACE LIMITS HITRC EQU PNTRS+48 HIGH TRACE LIMITS BRKP1 EQU PNTRS+49 BREAK POINT #1 BRKP2 EQU PNTRS+50 BREAK POINT #2 BRKP3 EQU PNTRS+51 BREAK POINT #3 BRKP4 EQU PNTRS+52 BREAK POINT #4 SMFLG EQU PNTRS+53 SIMULATE FLAG TYPE EQU PNTRS+54 PARTIAL LINE CHARACTER COUNT DLMTR EQU PNTRS+55 CHAR EDIT DELIMITER MERGF EQU PNTRS+56 MERGE FLAG SKP HSTPT BSS 1 HIGH-STACK POINTER PRADD BSS 1 PROGRAM EXECUTION TEMPT BSS 7 SPC 1 SUP PRESS MULTIPLE LISTINGS SPC 1 .2 DEC 2 B200 OCT 200 B377 OCT 377 HIMSK OCT 177400 M2 DEC -2 M10 DEC -10 M16 DEC -16 M20 DEC -20 M32 DEC -32 PMESS DEF *+1 OCT 6412 ASC 4,PAUSE _ : QMARK DEF *+1 ASC 1,?? AMESS DEF &*+1 OCT 6412 ASC 15,OPERATOR TERMINATION IN LINE _ : GO ASC 1,GO CTRLQ OCT 10400 SKP * ********************************* * * * OVERFLOW STMT ADDRESS TABLE * * * ********************************* * XECTB DEF * STATEMENT ADDRESS TABLE NOP .PLACE HOLDER DEF EPAZ 2-PAUSE STMT DEF EEND 3-STOP END STMT DEF OPEND 4-END STMT * SKP **************************************** * * * EXECUTE THE OVERFLOW STMT FROM SEG 4 * * * **************************************** * BASC8 NOP LDA SLSTM EXECUTE ADA XECTB REQUEST LDA 0,I FROM SEGMENT 4 JMP 0,I * SPC 3 ********************* * * ** EXECUTE PAUSE ** * * ********************* * EPAZ LDA M10 WRITE LDB PMESS 'PAUSE' JSB WRITE MESSAGE JSB PRNIN INITIALIZE FOR NUMBER ISZ TEMPS LDB TEMPS ANY CPB PRADD PARAMETER? JMP EPAZ1 NO! ISZ TEMPS DLD TEMPS,I GET PARAMETER JSB IFIX INTEGERIZE EPAZ2 JSB OUTIN PRINT NUMBER JSB OUTLN EPAZ3 LDA M2 READ LDB .INBF INPUT JSB REED 'GO' LDA .INBF,I CPA GO 'GO'? JMP BASC8,I .RETURN AND HIMSK CPA CTRLQ ABORT PROGRAM? JMP OPND1 YES, BUT DO NOT PUSH AND SHOVE LDA M2 NO, SO LDB QMARK OUTPUT JSB WRITE DOUBLE '??' JMP EPAZ3 EPAZ1 CLA ZERO JMP EPAZ2 PAUSE SKP ************************ * * ** EXECUTE END/STOP ** * * ************************ * * OPEND JSB IFBRK CLEAR ATTENTION DEF *+1 BIT OPND1 LDA ERTTY C} SET UP STA LUOUT ERROR LU LDB AMESS PRINT LDA M32 MESSAGE JSB WRITE INDICATING JSB PRNIN OPERATOR LDA .LNUM TERMINATION JSB OUTIN OF JSB OUTLN PROGRAM EEND EQU * OUTPUT LDB FCORE SET UP POINTER ADB M20 TO OUTPUT ANY STB TEMP4 PARTIAL LINES LULOP LDA TEMP4,I IN THE LU TABLE SZA,RSS IS THIS SLOT ASSIGNED ? JMP LUNXT NO, TRY THE NEXT ONE ALF,ALF YES, ISOLATE THE LU AND B377 IOR B200 STA LUOUT SAVE THE LU WORD JSB FINDV AND DISCOVER THE EQUIPMENT TYPE STA 1 ADA M16 IS THIS DEVICE TYPE SSA,RSS < 20(8) ? JMP LUNXT NO, TRY THE NEXT STA FLTYP YES, SET FOR NON-FILE WRITE CLA SET UP A NULL LDB PMESS WRITE OPERATION JSB WRITE ON THIS LU LUNXT ISZ TEMP4 POINT TO THE NEXT LU WORD LDA TEMP4 AND CHECK IF CPA FCORE WE ARE DONE RSS YES JMP LULOP NO, GO BACK FOR ANOTHER * CLA CLEAR STA SLSTM SEG 8 FLAG LDA .2 CLEAR JSB TRAP TRAP TABLE NOP LDA TEMP3 WAS THIS AN SZA ERROR EXIT ? JMP OUTER YES ! STA .LNUM RESET POINTER TO START OF PROGRAM JMP RDYPT NO, GO TO READY * * SKP ************************************ * * * ERROR MESSAGE PROCESSOR FOR * TRAP AND SCHED MODULES * * * ************************************ * B2000 OCT 2000 IERR DEF * ERMSG DEF * ERROR NOP JSB .ENTR .FETCH ERROR # AND MESSAGE DEF IERR LDA IERR,I .FETCH ERROR NUMBER JSB FLOAT .MAKE REAL FOR SERR INȨPUT JSB SERR .POST ERROR NUMBER IN ERRCD * LDA ERTTY .SET HONESTY MODE IN OUTPUT IOR B2000 . CRT STA LUOUT LDA ERRL .PRINT "ERROR" LDB ERRM JSB WRITE LDA ERMSG,I .FETCH MESSAGE LENGTH ISZ ERMSG LDB ERMSG .FETCH MESSAGE ADDRESS JSB WRITE . AND OUTPUT LDA M2 LDB DSHM .PRINT " -" JSB WRITE JSB PRNIN . RESET OUTPUT BUFFER LDA IERR,I .FETCH ERROR CODE JSB OUTIN .CONVERT TO ASCII JSB OUTLN . OUTPUT LDA LINEL .OUTPUT "IN LINE " LDB LINEM JSB WRITE LDA ERTTY .SET ERROR CRT TO NORMAL MODE STA LUOUT JSB PRNIN .CONVERT LINE # TO ASCII LDA .LNUM JSB OUTIN .AND PRINT JSB OUTLN JMP ERROR,I .EXIT * ERRL DEC -6 ERRM DEF *+1 ASC 3,ERROR DSHM DEF *+1 ASC 1, - LINEL DEC -8 LINEM DEF *+1 ASC 4,IN LINE * TEMP3 EQU TEMPS+4 TEMP4 EQU TEMPS+5 END  g q 92065-18008 1726 S C0122 &MESGA RTE-M BASIC ERROR MESSAGES             H0101 ^nASMB,R HED <> 92065-16002 NAM MESGA,7 92065-16002 REV. 1726 770512 * ENT MESGA * DATE 5-12-77 * * SOURCE 92065-18008 * * ************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * * PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ************************************************************** * * *********************** * * * ERROR MESSAGE TABLE * * * *********************** SPC 1 * ERROR MESSAGES FOR SYNTAX (SEG1) PHASE SPC 1 MESGA DEF *+1 ADDRESS OF ERROR STANDARD ERRORS MESSG DEC 17 ASC 9,ILLEGAL EXPONENT_ : DEC 23 ASC 12,NOT A FORTRAN FUNCTION_ : DEC 28 ASC 14,MISSING ASSIGNMENT OPERATOR_ : DEC 22 ASC 11,NOT A SUBROUTINE CALL_ : DEC 29 ASC 15,MISSING OR BAD FUNCTION NAME_ : DEC 31 ASC 16,MISSING OR BAD SIMPLE VARIABLE_ : DEC 27 ASC 14,MISSING OR BAD TRAP NUMBER_ : DEC 26 ASC 13,MISSING OR ILLEGAL 'THEN'_ : DEC 24 ASC 12,MISSING OR ILLEGAL 'OF'_ : DEC 24 ASC 12,MISSING OR ILLEGAL 'TO'_ : DEC 26 ASC 13,MISSING OR ILLEGAL 'STEP'_ : DEC 30 ASC 15,MISSING OR ILLEGAL SUBROUTINE_ : DEC 27 ASC 14,WRONG NUMBER OF PARAMETERS_ : DEC 29 ASC 15,MISSING OR ILLEGAL DATA ITEM_ : DEC 31 ASC 16,ILLEGAL READ OR INPUT VARIABLE_ : DEC 17 ASC 9,NO CLOSING QUOTE_ xo : DEC 30 ASC 15,MISSING OR BAD LIST DELIMITER_ : DEC 18 ASC 9,ILLEGAL PARAMETER_ : DEC 24 ASC 12,ILLEGAL STRING VARIABLE_ : DEC 21 ASC 11,PARAMETER NOT STRING_ : DEC 29 ASC 15,MISSING OR ILLEGAL SUBSCRIPT_ : DEC 30 ASC 15,STRING OR DIM LARGER THAN 255_ DEC 35 ASC 18,ILLEGAL STRING RELATIONAL OPERATOR_ : DEC 21 ASC 11,STRING NOT PERMITTED_ : DEC 25 ASC 13,MISSING LEFT PARENTHESIS_ : DEC 26 ASC 13,MISSING RIGHT PARENTHESIS_ : DEC 23 ASC 12,UNDECIPHERABLE OPERAND_ : DEC 30 ASC 15,MISSING OR BAD ARRAY VARIABLE_ : DEC 27 ASC 14,ILLEGAL OR MISSING INTEGER_ : DEC 20 ASC 10,SIGN WITHOUT NUMBER_ : DEC 31 ASC 16,CHARACTERS AFTER STATEMENT END_ : DEC 15 ASC 8,OUT OF STORAGE_ : DEC 16 ASC 8,ARRAY TOO LARGE_ : DEC 28 ASC 14,NO LU NUMBER REFERENCE FOUND SPC 1 * ERROR MESSAGES FOR PRE-EXECUTION (SEG3) PHASE SPC 1 DEC 27 ASC 14,COM STATEMENT OUT OF ORDER_ : DEC 23 ASC 12,FUNCTION DEFINED TWICE_ : DEC 14 ASC 7,UNMATCHED FOR_ : DEC 26 ASC 13,NEXT WITHOUT MATCHING FOR_ : DEC 26 ASC 13,DIMENSIONS NOT COMPATIBLE_ : DEC 25 ASC 13,LAST STATEMENT NOT 'END'_ : DEC 27 ASC 14,VARIABLE DIMENSIONED TWICE_ : DEC 28 ASC 14,ARRAY OF UNKNOWN DIMENSIONS_ :  DEC 16 ASC 8,ARRAY TOO LARGE_ : DEC 15 ASC 8,OUT OF STORAGE_ : DEC 22 ASC 11,SYMBOL TABLE OVERFLOW_ : SPC 1 * ERROR MESSAGES FOR EXECUTE (SEG4) PHASE SPC 1 DEC 15 ASC 8,OUT OF STORAGE_ : DEC 22 ASC 11,GOSUBS NESTED 20 DEEP_ : DEC 27 ASC 14,RETURN WITH NO PRIOR GOSUB_ : DEC 12 ASC 6,OUT OF DATA_ : DEC 16 ASC 8,WRONG DATA TYPE_ : DEC 24 ASC 12,SUBSCRIPT OUT OF BOUNDS_ : DEC 30 ASC 15,REFERENCED STATEMENT NOT DATA_ : DEC 29 ASC 15,UNDEFINED STATEMENT ACCESSED_ : DEC 9 ASC 5,BAD DATA_ : DEC 13 ASC 7,BAD EXPONENT_ : DEC 37 ASC 19,SUB. OR FUNCT. TERMINATED ABNORMALLY_ : DEC 16 ASC 8,TRAP TABLE FULL_ : DEC 24 ASC 12,ILLEGAL TRAP/SEQ NUMBER_ : DEC 27 ASC 14,SCHEDULED BUT DELETED TASK_ : DEC 16 ASC 8,TRAP TABLE BUSY_ : DEC 23 ASC 12,NEGATIVE STRING LENGTH_ : DEC 22 ASC 11,NON-CONTIGUOUS STRING_ : DEC 16 ASC 8,STRING OVERFLOW_ : DEC 30 ASC 15,UNDEFINED STATEMENT REFERENCE_ : DEC 30 ASC 15,NEGATIVE NUMBER TO REAL POWER_ : DEC 19 ASC 10,ZERO TO ZERO POWER_ : DEC 23 ASC 12,ZERO TO NEGATIVE POWER_ : DEC 25 ASC 13,OUT OF RANGE IN FUNCTION_ q : DEC 25 ASC 13,LOG OF NEGATIVE ARGUMENT_ : DEC 17 ASC 09,EXP OUT OF RANGE_ DEC 17 ASC 9,ILLEGAL FUNCTION_ SPC 1 * ERROR MESSAGES FOR COMMAND (SEG 5) PHASE SPC 1 DEC 15 ASC 8,INVALID COMMAND DEC 14 ASC 7,INVALID LIMITS DEC 30 ASC 15,INVALID LU OR STATEMENT NUMBER DEC 24 ASC 12,INVALID STATEMENT NUMBER * END c hq 92065-18009 1650 S C0122 &MESCD RTE-M BASIC ERROR CODES             H0101 2 ASMB,R,L HED <> 92065-16003 NAM CODGA,7 92065-16003 REV. 1650 761022 * * SOURCE 92065-18009 * * ENT MESGA * DATE 9-18-76 * SUP *********************** * * * ERROR MESSAGE TABLE * * * *********************** SPC 1 * ERROR MESSAGES FOR SYNTAX (SEG1) PHASE SPC 1 MESGA DEF *+1 ADDRESS OF ERROR STANDARD ERRORS CODGA EQU MESGA MESSG DEC 3 ASC 2,01_ ILLEGAL EXPONENT_ : DEC 3 ASC 2,02_ NOT A FORTRAN FUNCTION DEC 3 ASC 2,03_ MISSING ASSIGNMENT OPERATOR_ : DEC 3 ASC 2,04_ NOT A SUBROUTINE CALL_ : DEC 3 ASC 2,05_ MISSING OR BAD FUNCTION NAME_ : DEC 3 ASC 2,06_ MISSING OR BAD SIMPLE VARIABLE_ : DEC 3 ASC 2,07_ MISSING OR BAD TRAP NUMBER_ : DEC 3 ASC 2,08_ MISSING OR ILLEGAL 'THEN'_ : DEC 3 ASC 2,09_ MISSING OR ILLEGAL 'OF'_ : DEC 3 ASC 2,10_ MISSING OR ILLEGAL 'TO'_ : DEC 3 ASC 2,11_ MISSING OR ILLEGAL 'STEP'_ : DEC 3 ASC 2,12_ MISSING OR ILLEGAL SUBROUTINE_ : DEC 3 ASC 2,13_ WRONG NUMBER OF PARAMETERS_ : DEC 3 ASC 2,14_ MISSING OR ILLEGAL DATA ITEM_ : DEC 3 ASC 2,15_ ILLEGAL READ OR INPUT VARIABLE_ : DEC 3 ASC 2,16_ NO CLOSING QUOTE_ : DEC 3 ASC 2,17_ MISSING OR BAD LIST DELIMITER_ : DEC 3 ASC 2,18_ ILLEGAL PARAMETER_ : DEC 3 ASC 2,19_ ,ILLEGAL STRING VARIABLE_ : DEC 3  ASC 2,20_ PARAMETER NOT STRING_ : DEC 3 ASC 2,21_ MISSING OR ILLEGAL SUBSCRIPT_ : DEC 3 ASC 2,22_ STRING LONGER THAN 72 CHARACTERS_  : DEC 3 ASC 2,23_ ILLEGAL STRING RELATIONAL OPERATOR_ : DEC 3 ASC 2,24_ STRING NOT PERMITTED_ : DEC 3 ASC 2,25_ MISSING LEFT PARENTHESIS_ : DEC 3 ASC 2,26_ MISSING RIGHT PARENTHESIS_ : DEC 3 ASC 2,27_ UNDECIPHERABLE OPERAND_ : DEC 3 ASC 2,28_ MISSING OR BAD ARRAY VARIABLE_ : DEC 3 ASC 2,29_ ILLEGAL OR MISSING INTEGER_ : DEC 3 ASC 2,30_ SIGN WITHOUT NUMBER_ : DEC 3 ASC 2,31_ CHARACTERS AFTER STATEMENT END_ : DEC 3 ASC 2,32_ OUT OF STORAGE_ : DEC 3 ASC 2,33_ ARRAY TOO LARGE_ : DEC 3 ASC 2,75_ NO LU NUMBER REFERENCE FOUND SPC 3 * ERROR MESSAGES FOR PRE-EXECUTION (SEG3) PHASE SPC 3 DEC 3 ASC 2,34_ ,COM STATEMENT OUT OF ORDER_ : DEC 3 ASC 2,35_ FUNCTION DEFINED TWICE_ : DEC 3 ASC 2,36_ UNMATCHED FOR_ : DEC 3 ASC 2,37_ NEXT WITHOUT MATCHING FOR_ : DEC 3 ASC 2,38_ DIMENSIONS NOT COMPATIBLE_ : DEC 3 ASC 2,39_ LAST STATEMENT NOT 'END'_ : DEC 3 ASC 2,40_ VARIABLE DIMENSIONED TWICE_ : DEC 3 ASC 2,41_ ARRAY OF UNKNOWN DIMENSIONS_ : DEC 3 ASC 2,42_ ARRAY TOO LARGE_ : DEC 3 ASC 2,43_ OUT) OF STORAGE_ : DEC 3 ASC 2,44_ SYMBOL TABLE OVERFLOW_ : SPC 3 * ERROR MESSAGES FOR EXECUTE (SEG4) PHASE SPC 3 DEC 3 ASC 2,45_ OUT OF STORAGE_ : DEC 3 ASC 2,46_ GOSUBS NESTED 20 DEEP_ : DEC 3 ASC 2,47_ RETURN WITH NO PRIOR GOSUB_ : DEC 3 ASC 2,48_ OUT OF DATA_ : DEC 3 ASC 2,49_ WRONG DATA TYPE_ : DEC 3 ASC 2,50_ SUBSCRIPT OUT OF BOUNDS_ : DEC 3 ASC 2,51_ REFERENCED STATEMENT NOT DATA_ : DEC 3 ASC 2,52_ UNDEFINED VALUE ACCESSED_ : DEC 3 ASC 2,53_ BAD DATA_ : DEC 3 ASC 2,54_ BAD EXPONENT_ : DEC 3 ASC 2,55_ SUB. OR FUNCT. TERMINATED ABNORMALLY_ : DEC 3 ASC 2,56_ TRAP TABLE FULL_ : DEC 3 ASC 2,57_ ILLEGAL TRAP/SEQ NUMBER_ : DEC 3 ASC 2,58_ SCHEDULED BUT DELETED TASK_ : DEC 3 ASC 2,59_ TRAP TABLE BUSY_ : DEC 3 ASC 2,60_ NEGATIVE STRING LENGTH_ : DEC 3 ASC 2,61_ NON-CONTIGUOUS STRING_ : DEC 3 ASC 2,62_ STRING OVERFLOW_ : DEC 3 ASC 2,63_ UNDEFINED STATEMENT REFERENCE_ : DEC 3 ASC 2,64_ NEGATIVE NUMBER TO REAL POWER_ : DEC 3 ASC 2,65_ ZERO TO ZERO POWER_ : DEC 3 ASC 2,66_ ZERO TO NEGATIVE POWER_ : DEC 3 ASC 2,67_ OUT kOF RANGE IN FUNCTION_ : DEC 3 ASC 2,68_ LOG OF NEGATIVE ARGUMENT_ : DEC 3 ASC 2,69_ EXP OF NEGATIVE ARGUMENT_ : DEC 3 ASC 2,70_ ILLEGAL FUNCTION_ SPC 3 * ERROR MESSAGES FOR COMMAND (SEG 5) PHASE SPC 3 DEC 3 ASC 2,71 INVALID COMMAND DEC 3 ASC 2,72 INVALID LIMITS DEC 3 ASC 2,73 INVALID LU OR STATEMENT NUMBER DEC 3 ASC 2,74 INVALID STATEMENT NUMBER * END CODGA  ir 92065-18010 1726 S C0122 &MBTG TABLE GENERATOR MAIN             H0101 (FTN4,L,M PROGRAM RTMTG C C DATA BUFFERS AND STOREAGE C INTEGER FUNC1,FUNC2,A,E,F,R,X,AI(6),AO(6) DIMENSION IBUF(72),IDCB1(144),IDCB2(144) DIMENSION IBUF4(6),IBUF5(6) C C C C C RTM BRANCH AND MNEMONIC TABLE GENERATOR C MIKE SCHOENDORF C OCTOBER 22,1976 C C SOURCE: 92065-18010 C RELOCATEABLE: 92065-16004 REV.1726 770518 C C C C C C MAXIMUM READ LENGTH FROM SESSION CONSOLE C IL=72 C C "RTMTG" C CALL MESS1 C C > C 50 CALL MESS2 C C INITIALIZE END OF FILE, COMMAND, EDIT, ERROR, MESSAGE LENGTH C AND LINE NUMBERS INDICATORS. C E=0 FUNC1=0 FUNC2=0 IERR=0 LEN=0 NUMB=0 C C GET COMMAND FUNCTION C CALL READ1(FUNC1,IERR) C C IF NOT EDIT, TABLE, LIST, OR END COMMANDS ERROR EXIT. C IF (IERR .NE. 0) GO TO 90 C C EDIT COMMAND C IF (FUNC1 .EQ. 4)GO TO 995 C C GET INPUT AND OUTPUT FILE NAMES C CALL GTFIL(5,IERR,0,AI,AO) C C CHECK FOR GTFIL ERR C IF (IERR .NE. 0)GO TO 910 C C OPEN INPUT FILE C CALL OPEN(IDCB1,IERR,AI(2),410B) C C CHECK FOR OPEN ERROR C IF (IERR .LT. 0)GO TO 920 C C IF OUTPUT FILE FOR TABLE, OPEN WITH 110B C IF (FUNC1 .EQ. 2)GO TO 95 C C OPEN OUTPUT FILE (LIST, EDIT) C CALL OPEN(IDCB2,IERR,AO(2),210B) C C CHECK FOR OPEN ERROR C 55 IF (IERR .LT. 0)GO TO 70 C C GO PROCESS EDIT, LIST, AND TABLE COMMANDS C 60 GO TO (100,700,800)FUNC1 C C OPEN ERROR ON OUTPUT FILE. CHECK IF FILE EXISTS. C 70 IF (IERR .EQ. -6)80,920 C C FILE DOESN'T EXIST, CREATE IT. C 80 IF (FUNC1 .EQ. 2)GO TO 85 C C CREATE TYPE 4 OUTPUT FILE C CALL CREAT(IDCB2,IERR,AO(2),30,4,AO(6),AO(1)) C C CHECK FOR CREATE ERROR C IF (IERR .LT. 0)990,60 C C CREATE TYPE 5 OUTPUT FILE C 85 CALL CREAT(IDCB2,IERR,AO(2),30,5,AO(6),AO(1)) C C CHECK FOR CREATE ERROR C IF (IERR .LT. X0)990,60 C C COMMAND ERROR C 90 CALL ERR2 GO TO 50 C C OPEN OUTPUT FILE (TABLES) C 95 CALL OPEN(IDCB2,IERR,AO(2),110B) GO TO 55 C C C EDIT C C C C INITIALIZE ADD, FIND, LINE NUMBER, DELETE LINE NUMBER INDICATORS. C 100 A=0 F=0 N=0 X=0 C C "BRANCH AND MNEMONIC SOURCE EDIT" C CALL MESS3 C C - (PROMPT) C 110 CALL MESS9 C C GET EDIT COMMAND C 130 CALL READ2(FUNC2,NUMB,IERR) C C IF NOT END, ABORT, ADD, DELETE, END, FIND, OR REPLACE, C COMMAND ERROR. C IF (IERR .NE. 0)GO TO 190 C C GO TO ABORT, ADD, DELETE, END, FIND, REPLACE OR C FIND NEXT LINE. C GO TO(400,900,200,300,500,600,550)FUNC2 C C COMMAND ERROR C 190 CALL ERR2 GO TO 110 C C C ADD C C C C IF FIND PREVIOUS COMMAND, GO WRITE THE LINE. C 200 IF (F .EQ. 1)GO TO 260 C C READ FROM INPUT FILE C 210 CALL READ3(IBUF,LEN) C C IF NO INPUT, ADD ERROR C IF (LEN .EQ. 0) GO TO 960 C C WRITE ON OUTPUT FILE C CALL WRITF(IDCB2,IERR,IBUF,LEN) C C SET ADD FLAG INDICATOR C A=1 C C GET NEXT EDIT COMMAND, IF NO WRITE ERROR. C IF (IERR .NE. 0)950,110 C C WRITE PENDING LINE TO OUTPUT FILE C 260 CALL WRITF(IDCB2,IERR,IBUF,LEN) C C CLEAR FIND FLAG INDICATOR C F=0 C C GET NEXT EDIT COMMAND, IF NO WRITE ERROR.OMMAND C IF (IERR .NE. 0)950,210 C C C DELETE (N) C C C C CLEAR DELETE LINE NUMBER INDICATOR C 300 X=0 C C IF "FIND" PREVIOUS COMMAND, DON'T READ NEXT LINE. C IF (F .EQ. 1)GO TO 320 C C IF DONE, GO PROMPT C 310 IF (X .EQ. NUMB)GO TO 110 C C READ NEXT LINE FROM INPUT FILE C CALL READF(IDCB1,IERR,IBUF,IL,LEN) C C CHECK FOR READ ERROR C IF (IERR .NE. 0)GO TO 930 C C IF END OF FILE, OUTPUT TO SESSION CONSOLE "EOF" C IF (LEN .EQ. -1)GO TO 350 C C CLEAR "ADD" FLAG INDICATOR C A=0 C C N = CՌURRENT LINE NUMBER C N=N+1 C C X = NUMBER OF LINES DELETED C 315 X=X+1 C C CHECK IF FINISHED C GO TO 310 C C IF NO LINES TO DELETE GET NEXT EDIT COMMAND C 320 IF (NUMB .EQ. 0)GO TO 110 C C CLEAR "FIND" PREVIOUS COMMAND INDICATOR C F=0 GO TO 315 C C SET "EOF" INDICATOR C 350 E=1 C C "EOF" C CALL MESS6 GO TO 110 C C C END C C C C IF AT END OF INPUT, CLOSE INPUT AND OUTPUT FILES. C 400 IF (E .EQ.1)GO TO 900 C C IF "FIND" LAST COMMAND, GO WRITE LINE. C IF (F .EQ. 1)GO TO 420 C C READ NEXT LINE C 410 CALL READF(IDCB1,IERR,IBUF,IL,LEN) C C CHECK FOR READ ERROR C IF (IERR .NE. 0)GO TO 930 C C IF AT END OF FILE, GO CLOSE INPUT AND OUTPUT FILES. C IF (LEN .EQ. -1)GO TO 900 C C WRITE PENDING LINE TO OUTPUT FILE C 420 CALL WRITF(IDCB2,IERR,IBUF,LEN) C C CHECK FOR WRITE ERROR C IF (IERR .NE. 0)950,410 C C C FIND C C C C CHECK FOR END OF FILE C 500 IF (E .EQ. 1)GO TO 350 C C CHECK IF "ADD" PREVIOUS COMMAND C IF (A .EQ. 1)GO TO 570 C C CHECK IF "REPLACE" PREVIOUS COMMAND C IF (R .EQ. 1)GO TO 570 C C CHECK IF "FIND" PREVIOUS COMMAND C IF (F .EQ. 1)GO TO 530 C C CHECK IF AT START OF INPUT FILE C 505 IF (N .EQ. 0)GO TO 580 C C IF LINE SOUGHT IS LESS THAN CURRENT LINE, ERROR C IF LINE SOUGHT = CURRENT LINE STOP LOOKING C IF LINE SOUGHT > CURRENT LINE, KEEP LOOKING. C 510 IF (NUMB-N)970,540,520 C C CLEAR "ADD" FLAG INDICATOR C 520 A=0 C C READ NEXT LINE C CALL READF(IDCB1,IERR,IBUF,IL,LEN) C C CHECK FOR READ ERROR C IF (IERR .NE. 0)GO TO 930 C C CHECK FOR END OF FILE C IF (LEN .EQ. -1)GO TO 980 C C GO WRITE LINE C 530 CALL WRITF(IDCB2,IERR,IBUF,LEN) C C N = CURRENT LINE NUMBER C N=N+1 C C CLEAR "FIND" FLAG INDICATOR C F=0 C C CHECK FOR WRITE ERROR C QIF (IERR .NE. 0)950,510 C C CHECK FOR END OF FILE C 540 IF (E .EQ. 1)GO TO 350 C C READ NEXT LINE C CALL READF(IDCB1,IERR,IBUF,IL,LEN) C C CHECK FOR END OF FILE C IF (LEN .EQ. -1)GO TO 350 C C CHECK IF READ ERROR C IF (IERR .NE. 0)GO TO 930 C C OUTPUT CURRENT LINE NUMBER C CALL MESS4(N) C C OUTPUT CURRENT LINE C CALL MESSA(IBUF,LEN) C C SET "FIND" FLAG INDICATOR C F=1 C C GO GET NEXT EDIT COMMAND C GO TO 130 C C C FIND NEXT LINE C C C C CHECK FOR END OF FILE C 550 IF (E .EQ. 1)GO TO 350 C C N = CURRENT LINE NUMBER C N=N+1 C C IF "FIND" PREVIOUS COMMAND, WRITE PENDING LINE, C ELSE SET FOR NEXT LINE READ. C IF (F .EQ. 1)560,565 C C WRITE PENDING LINE C 560 CALL WRITF(IDCB2,IERR,IBUF,LEN) C C CHECK FOR WRITE ERROR C IF (IERR .NE. 0)GO TO 950 C C SET LINE SOUGHT = PENDING LINE C 565 NUMB=N C C GO READ LINE C GO TO 590 C C CHECK IF AT START OF FILE C 570 IF (N .EQ. 0)GO TO 580 C C CHECK IF LINE SOUGHT <, =, OR > PENDING LINE. C IF (NUMB-N)970,970,580 C C SET TO GET NEXT LINE C 580 N=N+1 C C CLEAR "ADD" AND "REPLACE" INDICATORS C 590 A=0 R=0 GO TO 510 C C C REPLACE C C C C IF AT END, OUTPUT "EOF" TO SESSION CONSOLE. C 600 IF (E .EQ. 1)GO TO 350 C C SET "REPLACE" FLAG INDICATOR C R=1 C C IF "FIND" PREVIOUS COMMAND, GET REPLACEMENT LINE C IF (F .EQ. 1)GO TO 610 C C N = CURRENT LINE NUMBER C N=N+1 C C READ NEXT LINE C CALL READF(IDCB1,IERR,IBUF,IL,LEN) C C CHECK FOR READ ERROR C IF (IERR .NE. 0)GO TO 930 C C CHECK FOR END OF FILE C IF (LEN .EQ. -1)GO TO 350 C C OUTPUT CURRENT LINE NUMBER C CALL MESS4(N) C C OUTPUT CURRENT LINE C CALL MESSA(IBUF,LEN) C C GET REPLACEMENT LINE C 610 CALL READ3(IBUF,LEN) C C CHECK FOR REPLACEMENT ERROR C IF (LEN .EQ. 0)GO TO 985 C C CLEAR FIND AND ADD FLAG INDICATORS C F=0 A=0 C C WRITE ON OUTPUT FILE C CALL WRITF(IDCB2,IERR,IBUF,LEN) C C CHECK FOR WRITE ERROR C IF (IERR .NE. 0)950,110 C C C BRANCH AND MNEMONIC TABLE GENERATOR C C C C "BRANCH TABLE GENERATOR" C 700 CALL MESS7 C C N = NUMBER OF BRANCH TABLE ENTRIES C N=0 C C FORMAT NAM RECORD C C NAM BMTBL C CALL NAMRC(IBUF) C C OUTPUT NAM RECORD C CALL WRITF(IDCB2,IERR,IBUF,17) C C CHECK FOR WRITE ERROR C IF (IERR .NE. 0)GO TO 950 C C FORMAT ENTRY RECORD C C ENT BRTBL C CALL ENTBT(IBUF) C C OUTPUT ENTRY RECORD C CALL WRITF(IDCB2,IERR,IBUF,7) C C CHECK FOR WRITE ERROR C IF (IERR .NE. 0)GO TO 950 C C FORMAT DBL RECORD C C BRTBL DEF *+1 C CALL ENTBR(IBUF) C C OUTPUT DBL RECORD C CALL WRITF(IDCB2,IERR,IBUF,6) C C CHECK FOR WRITE ERROR C IF (IERR .NE. 0)GO TO 950 C C READ NEXT BRANCH TABLE ENTRY C 720 CALL READF(IDCB1,IERR,IBUF,IL,LEN) C C CHECK FOR READ ERROR C IF (IERR .NE. 0)GO TO 930 C C CHECK FOR END OF FILE C IF (LEN .EQ. -1)GO TO 750 C C GO PARSE LINE C CALL PARS1(IBUF,LEN,IBUF4,IBUF5,IERR) C C CHECK FOR SYNTAX ERROR C IF (IERR .NE. 0)GO TO 790 C C N = BRANCH TABLE NUMBER ENTRY C N=N+1 C C WRITE EXTERNAL RECORD C CALL WRITF(IDCB2,IERR,IBUF4,6) C C CHECK FOR WRITE ERROR C IF (IERR .NE. 0)GO TO 950 C C WRITE DBL RECORD C CALL WRITF(IDCB2,IERR,IBUF5,9) C C CHECK FOR WRITE ERROR C IF (IERR .NE. 0)GO TO 950 C C GET NEXT BRANCH TABLE ENTRY C GO TO 720 C C DETERMINE IF INPUT IS FROM PAPER TAPE C 750 CALL RWIND(X,IDCB1,IERR) C C CHECK FOR ERROR IN DETERMINING INPUT DEVICE C IF (IERR .NE. 0)GO TO 991 C C CLOSE INPUT FILE C  CALL CLOSE(IDCB1,IERR) C C CHECK FOR CLOSE ERROR C IF (IERR .LT. 0)GO TO 940 C C IF PAPER TAPE INPUT OUTPUT MESSAGE C IF (X .EQ. 1)760,780 C C "REWIND SOURCE FILE" C 760 CALL MESS8 C C PAUSE UNTIL REWIND IS DONE, THEN ENTER GO,RTMTG TO CONTINUE. C PAUSE C C MNEMONIC TABLE GENERATOR C 780 CALL MES10 C C OPEN INPUT FILE AGAIN C CALL OPEN(IDCB1,IERR,AI(2),410B) C C CHECK FOR OPEN ERROR C IF (IERR .LT. 0)GO TO 920 C C FORMAT ENTRY RECORD C C ENT MNTBL C CALL ENTMT(IBUF) C C OUTPUT ENTRY RECORD C CALL WRITF(IDCB2,IERR,IBUF,7) C C CHECK FOR WRITE ERROR C IF (IERR .NE. 0)GO TO 950 C C FORMAT DBL RECORD C C MNTBL DEC -X C C WHERE X IS THE NUMBER OF BRANCH TABLE ENTRIES C CALL ENTMN(IBUF,N) C C OUTPUT DBL RECORD C CALL WRITF(IDCB2,IERR,IBUF,6) C C CHECK FOR WRITE ERROR C IF(IERR .NE. 0)GO TO 950 C C SET MNEMONIC TABLE ENTRY NUMBER = 0 C N=0 C C NUM = DBL RECORD LENGTH C 785 NUM=0 C C READ NEXT MNEMONIC TABLE ENTRY C CALL READF(IDCB1,IERR,IBUF,IL,LEN) C C CHECK FOR READ ERROR C IF (IERR .NE. 0)GO TO 930 C C CHECK FOR END OF FILE C IF (LEN .EQ. -1)GO TO 795 C C GO PARSE ENTRY C CALL PARS2(IBUF,LEN,IBUF4,IERR,NUM) C C CHECK FOR SYNTAX ERROR C IF (IERR .NE. 0)GO TO 788 C C STEP TO NEXT MNEMONIC TABLE ENTRY C N=N+1 C C WRITE DBL RECORD C CALL WRITF(IDCB2,IERR,IBUF4,NUM) C C CHECK FOR WRITE ERROR C IF (IERR .NE. 0)950,785 C C STEP TO NEXT MNEMONIC TABLE ENTRY C 788 N=N+1 C C SYN ERR IN LINE "N" C CALL ERR11(N) C C READ NEXT LINE C GO TO 785 C C STEP TO NEXT MNEMONIC TABLE ENTRY C 790 N=N+1 C C SYN ERR IN LINE "N" C CALL ERR11(N) C C READ NEXT LINE C GO TO 720 C C FORMAT END RECORD C 795 CALL ENDRC(IBUF) C C 6 WRITE END RECORD C CALL WRITF(IDCB2,IERR,IBUF,4) C C CHECK FOR WRITE ERROR C IF (IERR .NE. 0)GO TO 950 C C CLOSE INPUT FILE C CALL CLOSE(IDCB1,IERR) C C CHECK FOR CLOSE ERROR C IF (IERR .LT. 0)GO TO 940 C C WRITE END OF FILE C CALL FCONT(IDCB2,IERR,100B) C C CHECK FOR END OF FILE ERRROR C IF (IERR .LT. 0)GO TO 940 C C CLOSE OUTPUT FILE C CALL CLOSE(IDCB2,IERR) C C CHECK FOR CLOSE ERROR C IF (IERR .LT. 0)GO TO 940 C C GET NEXT COMMAND C GO TO 50 C C C LIST (ADD LINE NUMBERS TO INPUT FILE ENTRIES) C C C C N = CURRENT LINE NUMBER C 800 N=0 C C "LIST" C CALL MESS5 C C STEP TO NEXT LINE C 810 N=N+1 C C PUT LINE NUMBER (N) IN OUTPUT BUFFER C CALL CNUMD(N,IBUF) C C PUT NEXT LINE IN OUTPUT BUFFER C CALL READF(IDCB1,IERR,IBUF(6),IL,LEN) C C CHECK FOR READ ERROR C IF (IERR .NE. 0)GO TO 930 C C CHECK FOR END OF FILE C IF (LEN .EQ. -1)GO TO 900 C C ADD 2 BLANKS TO OUTPUT BUFFER C IBUF(4)=20040B IBUF(5)=20040B C C SET OUTPUT LINE LENGTH C LEN=LEN+4 C C GO WRITE LINE WITH ITS LINE NUMBER ATTACHED C CALL WRITF(IDCB2,IERR,IBUF(2),LEN) C C CHECK FOR WRITE ERROR C IF (IERR .NE. 0)GO TO 950 C C PROCESS NEXT LINE C GO TO 810 C C C ABORT C C C C CLOSE INPUT FILE C 900 CALL CLOSE(IDCB1,IERR) C C CHECK FOR CLOSE ERROR C IF (IERR .LT. 0)901,905 C C CHECK IF DCB OPEN C 901 IF (IERR .EQ. -11)905,906 C C WRITE END OF FILE C 905 CALL FCONT(IDCB2,IERR,100B) C C CHECK FOR END OF FILE ERROR C IF (IERR .LT. 0)GO TO 940 C C CLOSE OUTPUT FILE C CALL CLOSE(IDCB2,IERR) C C CHECK FOR CLOSE ERROR C IF (IERR .LT. 0)907,50 C C CLOSE ERROR C 906 CALL ERR5 C C GO CLOSE OUTPUT FILE C GO TO 905 C C CHECK IF DCB OPEN C 907 IF ( 0.*IERR .EQ. -11)50,940 C C C ERROR MESSAGES C C C C GTFIL ERR C 910 CALL ERR1A GO TO 995 C C OPEN ERR C 920 CALL ERR3 GO TO 50 C C READ ERR C 930 CALL ERR4 GO TO 900 C C CLOSE ERR C 940 CALL ERR5 GO TO 995 C C WRITE ERR C 950 CALL ERR6 GO TO 900 C C ADD ERR C 960 CALL ERR7 GO TO 110 C C SEQ ERR C 970 CALL ERR8 GO TO 110 C C LINE ERR C 980 CALL ERR9 GO TO 110 C C REPL ERR C 985 CALL ERR10 GO TO 110 C C CREATE ERR C 990 CALL ERR12 GO TO 900 C C REWIND ERR C 991 CALL ERR13 GO TO 900 C C "RTMTG FINISHED" C 995 CALL MESS0 END END$ sh0 j w 92065-18011 1650 S C0122 &DTRAP RTE-M BASIC DUMMY TRAP             H0101 ASMB,L,R NAM TRAP,7 92065-16005 REV.1650 761022 ENT TRAP TRAP NOP ISZ TRAP JMP TRAP,I END TRAP e kq 92065-18012 1709 S C0222 &MTGS0 TABLE GEN. SUBROUTINE             H0102 CASMB,R HED SUBROUTINES FOR BRANCH AND MNEMONIC TABLE GENERATOR NAM RTMSR,7 92065-16006 REV.1709 770309 * * ******************************************************* * * * RTM TABLE GENERATOR SUBROUTINES * MIKE SCHOENDORF * OCTOBER 22, 1976 * * SOURCE: 92065-18012 * RELOCATEABLE: 92065-16006 * * ******************************************************* * * * ENTRY POINT NAMES * * ENT ENDRC,ENTBR,ENTBT,ENTMN,ENTMT ENT ERR1A,ERR2,ERR3,ERR4,ERR5,ERR6 ENT ERR7,ERR8,ERR9,ERR10,ERR11,ERR12 ENT ERR13,MESS0,MESS1,MESS2,MESS3 ENT MESS4,MESS5,MESS6,MESS7,MESS8 ENT MESS9,MES10,MESSA,NAMRC,PARS1,PARS2 ENT READ1,READ2,READ3,RWIND * * * EXTERNAL REFERENCE NAMES * * EXT CNUMD,.ENTR,EXEC,IMESS EXT LOCF,PARSE SUP SKP * * * PROMPTS/ERROR MESSAGES * * CALLING SEQUENCE: * * LDA LNGTH MESSAGE LENGTH * LDB ADDRS MESSAGE ADDRESS * JSB MESSI OUTPUT TO SESSION CONSOLE * OCT 2 * RETURN * * * * "RTMTG FINISHED" * * MESS0 NOP JSB .ENTR DEF MESS0 LDA D16 LDB MES00 JSB MESSI OCT 2 JMP MESS0,I * MES00 DEF *+1 ASC 8,"RTMTG FINISHED" * * "RTMTG" * MESS1 NOP JSB .ENTR DEF MESS1 LDA B7 LDB MES01 JSB MESSI OCT 2 JMP MESS1,I * B7 OCT 7 * MES01 DEF *+1 ASC 4,"RTMTG" SKP * * > * MESS2 NOP JSB .ENTR DEF MESS2 CLA,INA LDB MES02 JSB MESSI OCT 2 JMP MESS2,I * MES02 DEF *+1 ASC 1,> * * "BRANCH AND MNEMONIC SOURCE EDIT" * MESS3 NOP JSB .ENTR DEF MESS3 LDA D33 LDB MES03 JSB MESSI OCT 2 JMP MESS3,I * D33 DEC 33 * MES03 DEF *+1 ASC 17,"BRANCH AND MNEMONIC SOURCE EDIT" [* * PENDING LINE NUMBER (N) * N1 NOP MESS4 NOP JSB .ENTR DEF N1 LDA N1,I GET CURRENT LINE NUMBER STA NUMB1 JSB CNUMD CONVERT TO ASCII DEF *+3 DEF NUMB1 AND PUT IN OUTPUT BUFFER DEF BUFA1 LDB BUFAD ADB B3 LDA BLANK STA 1,I INB LDA BKARO ADD BACK ARROW TO SUPPRESS STA 1,I CARRIAGE RETURN-LINE FEED LDA D10 LDB BUFAD JSB MESSI OCT 2 JMP MESS4,I * B4 OCT 4 * NUMB1 NOP * BKARO OCT 20137 SKP * * "LIST" * MESS5 NOP JSB .ENTR DEF MESS5 LDA B6 LDB MES05 JSB MESSI OCT 2 JMP MESS5,I * B6 OCT 6 * MES05 DEF *+1 ASC 3,"LIST" * * EOF (END OF FILE) * MESS6 NOP JSB .ENTR DEF MESS6 LDA B3 LDB MES06 JSB MESSI OCT 2 JMP MESS6,I * B3 OCT 3 * MES06 DEF *+1 ASC 2,EOF * * "BRANCH TABLE GENERATOR" * MESS7 NOP JSB .ENTR DEF MESS7 LDA D24 LDB MES07 JSB MESSI OCT 2 JMP MESS7,I * D24 DEC 24 * MES07 DEF *+1 ASC 12,"BRANCH TABLE GENERATOR" SKP * * "REWIND SOURCE FILE" * MESS8 NOP JSB .ENTR DEF MESS8 LDA D20 LDB MES08 JSB MESSI OCT 2 JMP MESS8,I * D20 DEC 20 * MES08 DEF *+1 ASC 10,"REWIND SOURCE FILE" * * - (PROMPT) * MESS9 NOP JSB .ENTR DEF MESS9 LDA B2 LDB MES09 JSB MESSI OCT 2 JMP MESS9,I * MES09 DEF *+1 OCT 26537 * * "MNEMONIC TABLE GENERATOR" * MES10 NOP JSB .ENTR DEF MES10 LDA D26 LDB ME010 JSB MESSI OCT 2 JMP MES10,I * ME010 DEF *+1 ASC 13,"MNEMONIC TABLE GENERATOR" * D26 DEC 26 * * PENDING LINE IS OUTPUT * IBUF0 NOP LEN3 ΧNOP MESSA NOP JSB .ENTR DEF IBUF0 LDA LEN3,I CMA,INA LDB IBUF0 JSB MESSI OCT 2 JMP MESSA,I SKP * * * ERROR MESSAGES * * * * GTFIL ERROR * * ERR1A NOP JSB .ENTR DEF ERR1A LDA D9 LDB ERR01 JSB MESSI OCT 2 JMP ERR1A,I * D9 DEC 9 * ERR01 DEF *+1 ASC 5,GTFIL ERR * * COMMAND ERROR * ERR2 NOP JSB .ENTR DEF ERR2 LDA D11 LDB ERR02 JSB MESSI OCT 2 JMP ERR2,I * D11 DEC 11 * ERR02 DEF *+1 ASC 6,COMMAND ERR * * OPEN ERROR * ERR3 NOP JSB .ENTR DEF ERR3 LDA D8 LDB ERR03 JSB MESSI OCT 2 JMP ERR3,I * D8 DEC 8 * ERR03 DEF *+1 ASC 4,OPEN ERR SKP * * READ ERROR * ERR4 NOP JSB .ENTR DEF ERR4 LDA D8 LDB ERR04 JSB MESSI OCT 2 JMP ERR4,I * ERR04 DEF *+1 ASC 4,READ ERR * * CLOSE ERROR * ERR5 NOP JSB .ENTR DEF ERR5 LDA D9 LDB ERR05 JSB MESSI OCT 2 JMP ERR5,I * ERR05 DEF *+1 ASC 5,CLOSE ERR * * WRITE ERROR * ERR6 NOP JSB .ENTR DEF ERR6 LDA D9 LDB ERR06 JSB MESSI OCT 2 JMP ERR6,I * ERR06 DEF *+1 ASC 5,WRITE ERR SKP * * ADD ERROR * ERR7 NOP JSB .ENTR DEF ERR7 LDA B7 LDB ERR07 JSB MESSI OCT 2 JMP ERR7,I * ERR07 DEF *+1 ASC 4,ADD ERR * * SEQ ERROR * ERR8 NOP JSB .ENTR DEF ERR8 LDA B7 LDB ERR08 JSB MESSI OCT 2 JMP ERR8,I * ERR08 DEF *+1 ASC 4,SEQ ERR * * LINE ERROR * ERR9 NOP JSB .ENTR DEF ERR9 LDA D8 LDB ERR09 JSB MESSI OCT 2 JMP ERR9,I * ERR09 DEF *+1 ASC 4,LINE ERR * * REPL ERROR * ERR10 NOP JSB .ENTR DEF ERR10 LDA D8 LDB ER010 JSB MESSI OCT 2 JMP ERR10,I * ER010 DEF *+1 ASC 4,REPL ERR SKP * * SYN ERR IN LINE XXX * LINE NOP ERR11 NOP JSB .ENTR DEF LINE LDA LINE,I LINE NUMBER STA NUMB1 JSB CNUMD CONVERT TO ASCII DEF *+3 DEF NUMB1 AND PUT IN OUTPUT BUFFER DEF ER11P LDA D22 LDB ER011 JSB MESSI OCT 2 JMP ERR11,I * ER011 DEF *+1 ASC 8,SYN ERR IN LINE ER11P BSS 3 * D22 DEC 22 * * CREATE ERROR * ERR12 NOP JSB .ENTR DEF ERR12 LDA D10 LDB ER012 JSB MESSI OCT 2 JMP ERR12,I * D10 DEC 10 * ER012 DEF *+1 ASC 5,CREATE ERR * * REWIND ERROR * ERR13 NOP JSB .ENTR DEF ERR13 LDA D10 LDB ER013 JSB MESSI OCT 2 JMP ERR13,I * ER013 DEF *+1 ASC 5,REWIND ERR SKP * * * SUBROURINE TO DETERMINE BRANCH-MNEMONIC TABLE * COMMAND (EDIT, TABLE, LIST, OR END) * * FUNC1 NOP ERRP1 NOP READ1 NOP JSB .ENTR DEF FUNC1 JSB READX GET INPUT FROM SESSION CONSOLE LDA M4 DETERMINE COMMAND LDB CTABL JSB SCAN JMP R1ERR ERROR CLB SET TO NO ERROR RD1ER STA FUNC1,I SAVE COMMAND TYPE STB ERRP1,I SAVE ERROR TYPE JMP READ1,I R1ERR CLB,INB CLA JMP RD1ER * M4 DEC -4 * * * SUBROUTINE TO DETERMINE EDIT COMMAND * (END, ABORT, ADD, DELETE, FIND, REPLACE, * FIND(/)-NEXT LINE * FUNC2 NOP NUMB NOP ERRP2 NOP READ2 NOP JSB .ENTR DEF FUNC2 JSB READX GET INPUT FROM SESSION CONSOLE LDA M7 LDB ETABL JSB SCAN DETERMINE EDIT COMMAND JMP R2ERR ERROR STA FUNC2,I SAVE EDIT COMMAND TYPE JSB PNMRA PA|RSE FOR # IN DEL AND FIND COMMANDS CLA NO LINE NUMBER CLB NO ERROR RD2ER STA NUMB,I SAVE LINE NUMBER STB ERRP2,I SAVE ERROR CODE JMP READ2,I R2ERR CLB,INB ERROR CLA SET FOR NO FUNCTION STA FUNC2,I JMP RD2ER * M7 DEC -7 SKP * * COMMAND AND EDIT LOOK-UP TABLES. * * BITS 15-8 #CHARS IN ASCII KEYWORD TABLE * BITS 7-0 OFFSET IN THAT TABLE(TO LOCATE ASCII WORDS) * * THE ORDER OF ENTRIES IN THESE TABLES IS USED IN DETERMINING * THE OFFSET ASSOCIATED WITH KEYWORDS. THUS ORDER IN THIS * TABLE IS OF PARAMOUNT IMPORTANCE. * * * COMMAND LOOK-UP TABLE * CTABL DEF CTABS CTABS ABS 2000B+AEDIT-CMTBL EDIT ABS 2400B+ATABL-CMTBL TABLE ABS 2000B+ALIST-CMTBL LIST ABS 1400B+AEND-CMTBL END * * EDIT LOOK-UP TABLE * ETABL DEF ETABS ETABS ABS 1400B+AEND-CMTBL END ABS 2400B+ABORT-CMTBL ABORT ABS 1400B+ADD-CMTBL ADD ABS 3000B+ADELE-CMTBL DELETE ABS 2000B+AFIND-CMTBL FIND ABS 3400B+AREPL-CMTBL REPLACE ABS 400B+ASLSH-CMTBL FIND(/)-NEXT LINE * * ASCII KEYWORD TABLE * ORDER OF ENTRIES IN THIS TABLE IS OF NO IMPORTANCE. * CMTBL DEF * AEDIT ASC 2,EDIT ATABL ASC 3,TABLE ALIST ASC 2,LIST AEND ASC 2,END ABORT ASC 3,ABORT ADD ASC 2,ADD ADELE ASC 3,DELETE AFIND ASC 2,FIND AREPL ASC 4,REPLACE ASLSH ASC 1,/ SKP * * SUBROUTINE TO INPUT FROM SESSION CONSOLE FOR * ADD EDIT COMMAND. * IBUF NOP LEN NOP READ3 NOP JSB .ENTR DEF IBUF LDA D72 BUFFER LENGTH LDB IBUF BUFFER ADDRESS JSB MESSI READ UP TO 72 CHARACTERS OCT 1 STB TEMP1 SAVE CHARACTER LENGTH INB CONVER TO # OF WORDS BRS STB LEN,I AND SAVE STB 0 LDB IBUF,I ADD BLANK TO LAST ADB 0 CHARACTER OF LAST WORD ADB M1  ONLY IF ODD # OF CHARACTERS LDA TEMP1 SLA,RSS JMP READ3,I EVEN # OF CHARACTERS, EXIT LDA 1,I AND UPCM IOR B40 STA 1,I JMP READ3,I * TEMP1 NOP * D72 DEC 72 * * SUBROUTINE TO READ FROM SESSION CONSOLE * READX NOP LDA D72 BUFFER LENGTH LDB QBUFA BUFFER ADDRESS JSB MESSI READ FROM CONSOLE OCT 1 STB QQCHC SAVE # OF CHARACTERS CLA RESET INCOMING STA QQCNT CHARACTER POINTERS LDA QBUFA STA QQPTR JMP READX,I * QBUFA DEF QIBUF QIBUF BSS 72 * QQCHC NOP QQCNT NOP QQPTR NOP SKP * * SUBROUTINE TO OUTPUT THE NAM RECORD BMTBL * * NAM BMTBL * * IBUF1 NOP NAMRC NOP JSB .ENTR DEF IBUF1 LDA IBUF1 OUTPUT BUFFER ADDRESS LDB TABL1 NAM RECORD DATA JSB STORE PUT DATA IN OUTPUT BUFFER DEC -17 DATA BUFFER LENGTH JMP NAMRC,I * * NAM RECORD DATA * TABL1 DEF *+1 OCT 10400 OCT 20000 OCT 1256 OCT 41115 OCT 52102 OCT 46040 OCT 177777 OCT 0 OCT 0 OCT 0 OCT 0 OCT 0 OCT 0 OCT 0 OCT 0 OCT 0 OCT 0 SKP * * SUBROUTINE TO OUTPUT THE ENT RECORD BRTBL * * ENT BRTBL * * IBUF2 NOP ENTBT NOP JSB .ENTR DEF IBUF2 LDA IBUF2 OUTPUT BUFFER ADDRESS LDB TABL2 ENTRY RECORD DATA JSB STORE PUT DATA IN OUTPUT BUFFER DEC -7 DATA BUFFER LENGTH JMP ENTBT,I * * ENT RECORD DATA * TABL2 DEF *+1 OCT 3400 OCT 40001 OCT 21225 OCT 41122 OCT 52102 OCT 46000 OCT 0 SKP * * SUBROUTINE TO OUTPUT THE DBL RECORD BRTBL DEF *+1 * * BRTBL DEF *+1 * IBUF3 NOP ENTBR NOP JSB .ENTR DEF IBUF3 CLA,INA SET STA LDADR LOADں ADDRESS STA IDNUM AND EXTERNAL ID NUMBER TO 1 LDA B4400 SET RECORD COUNT TO 9 WORDS STA RLCNT LDA B6014 SET WORD 2 OF DBL RECORD TO PROGRAM STA INSTR FOR LOAD ADD. & 4 FOR # INST. WORDS LDA MNEG SET RELOCATION INDICATOR TO STA RLIND EXTERNAL REFERENCE LDA IBUF3 OUTPUT BUFFER ADDRESS LDB TABL3 DBL RECORD DATA JSB STORE PUT DATA IN OUTPUT BUFFER DEC -6 DATA BUFFER LENGTH JMP ENTBR,I * * DBL RECORD DATA * TABL3 DEF *+1 OCT 3000 OCT 60101 OCT 100102 OCT 0 OCT 20000 OCT 1 * B4400 OCT 4400 B6014 OCT 60104 MNEG OCT 100000 SKP * * SUROUTINE TO PUT THE NAM, ENT, EXT, DBL, AND END * RECORDS IN THE OUTPUT BUFFER. * STORE NOP STA IBUFF OUTPUT BUFFER STB TABL ADDRESS OF RECORDS LDA STORE,I GET DATA BUFFER LENGTH STA COUNT STOR1 LDA TABL,I GET NEXT DATA WORD STA IBUFF,I STORE IN OUTPUT BUFFER ISZ TABL INCREMENT TO NEXT DATA WORD ISZ IBUFF INCREMENT TO NEXT OUTPUT BUF ADD ISZ COUNT DONE? JMP STOR1 NO ISZ STORE SET RETURN ADDRESS JMP STORE,I * COUNT NOP IBUFF NOP TABL NOP SKP * * SUBROUTINE TO PARSE SOURCE FILE AND CREATE * RELOCATEABLE BRANCH TABLE OUTPUT. * IBUF4 NOP LEN1 NOP IBUF5 NOP IBUF6 NOP IERR1 NOP PARS1 NOP JSB .ENTR DEF IBUF4 LDA IERR1 SET ERROR RETURN ADDRESS STA IERR LDA LEN1,I INPUT LENGTH LDB IBUF4 INPUT ADDRESS JSB INIT GO INITIALIZE LDA IBUF5 CREATE EXTERNAL RECORD AND PUT IN JSB EXTRC OUPUT BUFFER JSB PRAMS CHECK IF THERE ARE ANY PARAMETERS JMP PARSC NO PARAMETERS, INPUT BUFFER EMPTY JMP PARSB NO PARAMTERS, CHECK FOR FUNCTION TYPE PARSA JSB PARAM CHECK PARAMETER TYPES ISZ PRMCT INCREMENT # OF PARAMETERS JSB OTPUT FORMAT OUTPUT WORD JSB EPRAM DONE WITH PARAMETERS? JMP PARSA NO, GET NEXT ONE JMP PARSC YES, INPUT BUFFER EMPTY PARSB JSB INTRL CHECK FOR FUNCTION TYPE JMP PARSC NO ENTRY POINT NAME JSB TEQUL CHECK NEXT 2 CHARS FOR "T=" LDA IBUF5 REPROCESS ENTRY POINT NAME JSB EXTRC AND OVERLAY SUBROUTINE NAME PARSC LDA WORDX SET WORD 9 BIT 15 IN DBL RECORD IOR WORD3 IF FUNCTION IS AN INTEGER STA WORD3 LDA FTN SET WORD 8 BIT 15 IN DBL RECORD IOR WORD2 IF FTN STA WORD2 LDA IBUF6 PUT DBL RECORD IN OUTPUT BUFFER JSB DBLRC ISZ IDNUM INCREMENT EXT ID NUMBER JMP PARS1,I * IERR NOP PRMCT NOP WORDX NOP SKP * * SUBROUTINE TO INITIALIZE BRANCH AND * MNEMONIC TABLE GENERATOR * INIT NOP SZA,RSS JMP ERR1 RAL STA QQCHC SAVE # OF CHARACTERS CLA STA QQCNT RESET INCOMING CHAR POINTER STA WORD1 INITIALIZE STA WORD2 OUTPUT STA WORD3 BUFFER STA WORDX ENTRIES STA PRMCT # OF PARAMETERS STA CHRCT # OF CHARS. IN SUB. NAME STA IERR,I CLEAR ERROR CODE STA FUNC CLEAR FUNCTION BIT STA FTN CLEAR FTN BIT STB QQPTR JMP INIT,I * FTN NOP FUNC NOP * ERR1 CLA,INA SET FOR ERROR RETURN STA IERR,I JMP PARS1,I SKP * * SUBROUTINE TO GENERATE AN EXTERNAL RECORD FOR THE NAME OF THE * FUCTION OR SUBROUTINE. IF ENTRY IS SUPPLIED, IT WILL OVERLAY * THE FUNCTION OR SUBROUTINE NAME FOR BRANCH TABLE ENTRIES. * * EXTRC NOP STA IBUFF DESTINATION ADDRESS LDB BLANK INITIALIZE ADA B4 OUTPUT BUFFER STB 0,I INA STB 0,I LDA B3000 RECORD LENGTH STA IBUFF,I ISZ IBUFF LDA B1001 RECORD IDENT-# ENTRIES STA IBUFF,I ISZ IBUFF ISZ IBUFF LDA IBUFF DESTINATION ADDRESS JSB MOVE. MOVE SYMBOL NAME FROM INPUT BUFFER ISZ IBUFF ISZ IBUFF LDA IBUFF,I SET EXTERNAL ID NUMBER AND UPCM IOR IDNUM STA IBUFF,I LDA IBUF5 STA IBUFF ADA B3 LDB 0,I CALCULATE CHECKSUM INA ADB 0,I INA ADB 0,I ADB B1001 LDA IBUFF AND STORE IN WORD3 ADA B2 STB 0,I OF EXTERNAL RECORD JMP EXTRC,I * B2 OCT 2 BLANK OCT 20040 B3000 OCT 3000 B1001 OCT 100001 UPCM OCT 77400 SKP * * SUBROUTINE TO CHECK IF THERE ARE ANY PARAMETERS * PRAMS NOP CLA INITIALIZE PARAMETER COUNT STA PRMCT JSB NXTC GET NEXT NON BLANK CHARACTER JMP PRAMS,I NO MORE ISZ PRAMS CPA COMMA IF COMMA, NO PARAMETERS JMP PRAMS,I NO PRAMS., EXIT CPA LPARN MUST HAVE LEFT PARENTHESIS RSS JMP ERR1 NONE, ERROR EXIT ISZ PRAMS SET RETURN ADDRESS JMP PRAMS,I * LPARN OCT 50 SKP * * SUBROUTINE TO DETERMINE TYPE OF PARAMETER. * POSSIBLE TYPES (I,R,IA,RA,IV,RV,IVA,RVA). * * 0 = I * 1 = R * 2 = IA * 3 = RA * 4 = IV * 5 = RV * 6 = IVA * 7 = RVA * * ABOVE VALUES STORED IN "TYPE" ON EXIT. * PARAM NOP CLB STB TYPE INIT TYPE JSB NXTC GET NEXT CHAR. JMP ERR1 NONE, ERROR EXIT CPA I = I? JMP PARA1 YES CPA R = R? RSS YES JMP ERR1 NO, ERROR EXIT ISZ TYPE PARA1 JSB NXTC GET NEXT CHARACTER JMP ERR1 NO MORE, ERROR EXIT LDB B2 CPA RPARN RIGHT PARENTHESIS? JMP PARA3 YES, EXIT CPA COMMA COMMA? JMP PARA3 YES, EXIT CPA A = A? JMP PARA4 YES CPA V = V? RSS <:6YES JMP ERR1 NO, ERROR EXIT LDB B4 ADB TYPE STB TYPE JSB NXTC GET NEXT CHARACTER JMP ERR1 NO MORE, ERROR EXIT CPA A = A? JMP PARA5 YES PARA6 CPA RPARN RIGHT PARENTHESIS? JMP PARA3 YES, EXIT CPA COMMA COMMA? JMP PARA3 YES, EXIT JMP ERR1 NO, ERROR EXIT PARA5 LDB TYPE SET PARAMTER TYPE ADB B2 STB TYPE JMP PARAM,I * PARA3 JSB BAKUP BAKUP INPUT STRING JMP PARAM,I * PARA4 ADB TYPE STB TYPE JSB NXTC GET NEXT CHARACTER JMP ERR1 NO MORE JMP PARA6 * A OCT 101 I OCT 111 R OCT 122 V OCT 126 * TYPE NOP SKP A<* * SUBROUTINE TO FORMAT OUTPUT BUFFER FOR DBL * INSTRUCTION WORDS 1, 2, AND 3. * OTPUT NOP LDA PRMCT 16 PARAMETERS? CPA D16 JMP ERR1 YES, ERROR EXIT LDB OTBL OUTPUT BUFFER ADDRESS STB OUTBL LDA ARRAY ADD. OF WORD 1 OF DATA BUFFER JSB FORMT GET VALUE FOR PARAMETER LDA VALRT ADD OF WORD 2 OF DATA BUFFER JSB FORMT GET VALUE FOR PARAMETER LDA CONVT ADD. OF WORD 3 OF DATA BUFFER JSB FORMT GET VALUE FOR PARAMETER JMP OTPUT,I * D16 DEC 16 * OTBL DEF WORD1 * * SUBROUTINE TO GET VALUE FROM DATA BUFFER AND PUT IT * IN THE OUTPUT BUFFER FOR DBL RECORDS. * FORMT NOP ADA TYPE PARAMETER TYPE LDB 0,I GET VALUE FOR PARAMETER LDA PRMCT CMA,INA FORM1 ISZ 0 RSS JMP FORM2 DONE RBL POSITION BIT IN OUTPUT WORD JMP FORM1 FORM2 LDA OUTBL,I MERGE WITH EXISTING OUTPUT WORD IOR 1 STA OUTBL,I ISZ OUTBL JMP FORMT,I * OUTBL NOP SKP * * THE FOLLOWING BUFFERS ARE USED TO LOOK-UP * THE BIT PATTERNS FOR PARAMETERS THAT ARE * PASSED TO THE SUBROUTINE OR FUNCTION. * * * PARAMETER IS AN ARRAY * * ARRAY DEF *+1 OCT 0 I OCT 0 R OCT 1 IA OCT 1 RA OCT 0 IV OCT 0 RV OCT 1 IVA OCT 1 RVA * * PARAMETER IS RETURNED FROM SUBROUTINE * VALRT DEF *+1 OCT 0 I OCT 0 R OCT 0 IA OCT 0 RA OCT 1 IV OCT 1 RV OCT 1 IVA OCT 1 RVA * * CONVERT PARAMETER TO REAL ON RETURN FROM SUBROUTINE * CONVT DEF *+1 OCT 1 I OCT 0 R OCT 1 IA OCT 0 RA OCT 1 IV OCT 0 RV OCT 1 IVA OCT 0 RVA SKP * * SUBROUTINE TO CHECK IF FINISHED PROCESSING PARAMETERS. * EPRAM NOP JSB NXTC GET NEXT CHARACTER JMP ERR1 NO MORE, ERROR EXIT CPA COMMA COMMA? JMP EPRAM,I YES, MORE PARAMETERS ISZ EPRAM CPA RPARN MUST END WITH RIGHT PARENTHESIS RSS YES JMP ERR1 NO, ERROR EXIT JSB NXTC GET NEXT CHARACTER JMP EPRAM,I NO MORE ISZ EPRAM SET RETURN ADDRESS CPA COMMA COMMA? RSS YES JMP ERR1 NO, ERROR EXIT JMP EPRAM,I * COMMA OCT 54 RPARN OCT 51 * * SUBROUTINE TO CHECK FOR "T=" ASCII CHARACTERS * * TEQUL NOP JSB NXTC2 GET NEXT 2 CHARACTERS CPA T= = T=? JMP TEQUL,I YES JMP ERR1 NO, ERROR EXIT * T= ASC 1,T= SKP * * SUBROUTINE TO DETERMINE IF SUBROUTINE IS TO BE * TREATED AS A FUNCTION (REAL OR INTEGER). * INTRL NOP JSB NXTC2 GET NEXT 2 CHARACTERS CCB CPA IN =IN CLB,INB YES CPA RE =RE CLB YES CPA FT =FT JMP INTR3 YES CPA EN =EN JMP INTR1 YES SSB IF NONE OF ABOVE JMP ERR1 ERROR EXIT LDA 1 SAVE TYPE OF SUBROUTINE RAR STA WORDX JSB NXTC2 GET NEXT 2 CHARACTERS LDB WORDX INTEGER? SSB JMP TGCHK YES CPA AL =AL? RSS YES JMP ERR1 NO, ERROR EXIT INTR2 LDA MNEG SET FUNC BIT IF EITHER REAL OR INTG STA FUNC JSB NXTC GET NEXT CHARACTER JMP INTRL,I NO MORE CPA COMMA =COMMA? RSS YES JMP ERR1 NO, ERROR EXIT JSB NXTC2 GET NEXT 2 CHARACTERS CPA FT =FT JMP INTR3 YES INTR4 ISZ INTRL SET RETURN ADDRESS CPA EN =EN? RSS YES JMP ERR1  NO, ERROR EXIT JMP INTRL,I TGCHK CPA TG =TG? JMP INTR2 YES JMP ERR1 NO, ERROR EXIT INTR1 ISZ INTRL SET RETURN ADDRESS JMP INTRL,I * INTR3 JSB NXTC GET NEXT CHARACTER JMP ERR1 NO MORE, ERROR EXIT CPA N =N RSS JMP ERR1 NO, ERROR EXIT LDA MNEG SET FTN BIT STA FTN JSB NXTC GET NEXT CHARACTER JMP INTRL,I NO MORE, EXIT CPA COMMA =COMMA RSS JMP ERR1 NO, ERROR EXIT JSB NXTC2 GET NEXT 2 CHARACTERS JMP INTR4 CHECK FOR ENT * AL ASC 1,AL EN ASC 1,EN FT ASC 1,FT IN ASC 1,IN RE ASC 1,RE TG ASC 1,TG * N OCT 116 SKP * * SUBROUTINE TO PUT DBL RECORD IN OUTPUT BUFFER. * A REGISTER ON ENTRY CONTAINS ADDRESS OF OUTPUT * BUFFER. * DBLRC NOP LDB LDADR CALCULATE ADB IDNUM ADB WORD1 ADB WORD2 CHECKSUM ADB WORD3 ADB B1601 STB CKSUM AND SAVE LDB TABL4 DBL RECORD DATA JSB STORE PUT DATA IN OUTPUT BUFFER DEC -9 DATA BUFFER LENGTH LDA LDADR INCREMENT LOAD ADDRESS ADA B4 BY 4 STA LDADR AND SAVE JMP DBLRC,I * * DBL RECORD DATA * TABL4 DEF *+1 RLCNT OCT 4400 INSTR OCT 60104 CKSUM OCT 0 LDADR OCT 0 RLIND OCT 100000 IDNUM OCT 0 WORD1 OCT 0 WORD2 OCT 0 WORD3 OCT 0 * B1601 OCT 160104 SKP * * SUBROUTINE TO DETERMINE IF INPUT IS FROM A PHOTO-READER. * IF YES, SET X = 1 ON EXIT. * X NOP IDCB1 NOP ERRP3 NOP RWIND NOP JSB .ENTR DEF X LDA IDCB1 DATA CONTROL BUFFER OF INPUT FILE JSB LOCFS GET ITS LOGICAL UNIT JMP WIND1 ERROR JSB EXEC DETERMINE INPUT TYPE DEF *+4 DEF D13 DEF JLU DEF IEQT5 CLB LDA IEQT5 AND B374K CPA B400 PHOTO-READER? CLB,IN9B YES STB X,I SAVE INPUT TYPE CLA,RSS WIND1 CLA,INA STA ERRP3,I SET ERROR CODE JMP RWIND,I * B400 OCT 400 B374K OCT 37400 D13 DEC 13 * IEQT5 NOP JLU NOP SKP * * SUBROUTINE TO OUTPUT THE ENTRY RECORD ENT MNTBL * * ENT MNTBL * IBUF7 NOP ENTMT NOP JSB .ENTR DEF IBUF7 LDA LDADR SET LOAD ADDRESS STA LDAD1 ADA B2662 CALCULATE STA CKSU1 CHECKSUM AND SAVE LDA IBUF7 OUTPUT BUFFER ADDRESS LDB TABL5 ENTRY RECORD DATA JSB STORE PUT DATA IN OUTPUT BUFFER DEC -7 DATA BUFFER LENGTH JMP ENTMT,I * * ENTRY RECORD DATA * TABL5 DEF *+1 OCT 3400 OCT 40001 CKSU1 OCT 0 OCT 46516 OCT 52102 OCT 46000 LDAD1 OCT 0 * B2662 OCT 26621 SKP * * SUBROUTINE TO OUTPUT THE DBL RECORD MNTBL DEC -X * (WHERE X = TO THE NUMBER OF SUBROUTINES DEFINED * IN THE BRANCH TABLE). * * MNTBL DEC -X * IBUF8 NOP NUMBR NOP ENTMN NOP JSB .ENTR DEF IBUF8 LDA LDADR SET LOAD ADDRESS STA LDAD2 ISZ LDADR INCREMENT LOAD ADDRESS FOR 1ST DBL REC LDA NUMBR,I NUMBER OF SUBROUTINES CMA,INA STA MNTBL SAVE FOR DBL RECORD ADA LDAD2 CALCULATE ADA B6010 CHECKSUM STA CKSU2 AND SAVE LDA IBUF8 OUTPUT BUFFER ADDRESS LDB TABL6 DBL RECORD DATA JSB STORE PUT DATA IN OUTPUT BUFFER DEC -6 DATA BUFFER LENGTH JMP ENTMN,I * * DBL RECORD DATA * TABL6 DEF *+1 OCT 3000 B6010 OCT 60101 CKSU2 OCT 0 LDAD2 OCT 0 OCT 0 MNTBL OCT 0 SKP * * SUBROUTINE TO PARSE SOURCE FILE AND CREATE * RELOCATEABLE MNEMONIC TABLE OUTPUT. * IBUF9 NOP LEN2 NOP IBF10 NOP IERR2 NOP NUM NOP PARS2 NOP JSB .ENTR DEF IBUF9 LDA PARS2 SET RETURN ADDRESS STA PARS1  LDA IERR2 SET ERROR RETURN ADDRESS STA IERR LDA LEN2,I INPUT LENGTH LDB IBUF9 INPUT BUFFER JSB INIT GO INITIALIZE LDA OTBL MOVE SUROUTINE NAME TO OUTPUT JSB MOVE. BUFFER JSB ADPAR ADD LEFT PAREN IF PARAMETERS EXIST JMP PARSM INPUT BUFFER EMPTY JMP PARSN NO PARAMETERS, CHECK IF FUNC. SUB. JSB PRAMS CHECK IF THERE ARE ANY PARAMETERS JMP PARSM INPUT BUFFER EMPTY JMP PARSN NO PARAMETERS, CHECK IF FUNC. SUB. PARSL JSB PARAM CHECK FOR NUMBER OF PARAMETERS ISZ PRMCT INCREMENT # OF PARAMETERS JSB EPRAM DONE WITH PARAMETERS? JMP PARSL NO, GET NEXT ONE JMP PARSM YES, INPUT BUFFER EMPTY PARSN JSB INTRL CHECK FOR FUNCTION SUBROUTINE NOP FORGET ENTRY POINT NAME PARSM JSB DBLR2 FORMAT DBL RECORD LDA CHRCT SAVE RECORD LENGTH ADA B6 STA NUM,I JMP PARS2,I * CHRCT NOP * B40 OCT 40 SKP * * SUBROUTINE TO OUTPUT THE END RECORD * IBUFA NOP ENDRC NOP JSB .ENTR DEF IBUFA LDA IBUFA OUTPUT BUFFER ADDRESS LDB TABL7 END RECORD DATA JSB STORE PUT DATA IN OUTPUT BUFFER DEC -4 DATA BUFFER LENGTH JMP ENDRC,I * * END RECORD DATA * TABL7 DEF *+1 OCT 2000 OCT 120000 OCT 120000 OCT 0 * * SUBROUTINE TO ADD LEFT PARENTHESIS TO THE DBL RECORDS FOR * ALL MNEMONIC TABLE ENTRIES THAT HAVE AT LEAST ONE PARAMETER. * ADPAR NOP JSB NXTC GET NEXT CHARACTER JMP ADPAR,I NO MORE, DON'T ADD LEFT PAREN. ISZ ADPAR SET RETURN ADDRESS CPA COMMA COMMA? JMP ADPAR,I YES, NO PARAMETERS ISZ ADPAR SET RETURN ADDRESS CPA LPARN LEFT PARENTHESIS? JMP ADPA3 YES JMP ERR1 ERROR EXIT ADPA4 JSB BAKUP BACKUP INPUT JMP ADPAR,I ADPA3 LDA MOVE3,I ADD LEFT PAENTHESIS z AND UPCM LDB CHRCT SLB,RSS TO JMP ADPA1 UPPER CHARACTER IF EVEN IOR LPARN AND LOWER CHARACTER IF ODD STA MOVE3,I AND SAVE ADPA2 ISZ CHRCT ADD ONE TO CHAR COUNT FOR PAREN JMP ADPA4 EXIT ADPA1 ISZ MOVE3 GET DESTINATION ADDRESS LDA LPBLK ADD LEFT PAREN-BLANK STA MOVE3,I JMP ADPA2 * LPBLK ASC 1,( SKP * * SUBROUTINE TO GET NEXT 2 ASCII CHARACTERS * NXTC2 NOP JSB NXTC GET NEXT CHARACTER JMP ERR1 NO MORE, ERROR EXIT ALF,ALF SHIFT TO UPPER BITS STA WORDA JSB NXTC GET NEXT CHARACTER JMP ERR1 NO MORE, ERROR EXIT IOR WORDA MERGE WITH FIRST CHARACTER JMP NXTC2,I * WORDA NOP SKP * * SUBROUTINE TO PUT THE MNEMONIC TABLE DBL * RECORD INTO THE OUTPUT BUFFER. * DBLR2 NOP LDA FUNC FUNCTION SUBROUTINE STA IDNUM -Y-X WORD LDA PRMCT WHERE Y = NUMBERS OF PARAMETERS ALF IOR IDNUM AND IOR CHRCT X = # OF CHARS. IN NAME STA IDNUM CLA REL INDICATOR = ABSOLUTE STA RLIND LDA CHRCT CONVERT NUMBER OF CHARACTERS INA IN NAME TO WORDS ARS STA CHRCT ADA B6 DBL RECORD LENGTH ALF,ALF IS 6 MORE STA RLCNT SAVE IN DBL RECORD LENGTH WORD LDA CHRCT SET WORD 2 OF DBL RECORD ADA B6010 STA INSTR LDA INSTR CALCULATE ADA LDADR ADA RLIND ADA IDNUM ADA WORD1 CHECKSUM ADA WORD2 ADA WORD3 STA CKSUM AND SAVE LDA CHRCT GET TOTAL RECORD LENGTH ADA B6 CMA,INA STA NUMWD LDA IBF10 OUTPUT BUFFER ADDRESS LDB TABL4 DBL RECORD DATA JSB STORE PUT DATA IN OUTPUT BUFFER NUMWD DEC -9 DATA BUFFER LENGTH LDA LDADR ADJUST LOAD ADDRESS INA ADA _CHRCT STA LDADR JMP DBLR2,I SKP * * * ***** * ** BAKUP ** BACK UP INPUT BUFFER (QIBUF) POINTERS BY ONE CHARACTER * CALLING SEQUENCE: * * JSB BAKUP * RETURN * ***** BAKUP NOP LDA QQCNT DECREMENT CHAR COUNT ADA M1 STA QQCNT LDB QQPTR SLA AND IF NECESSARY, ADB M1 DECREMENT POINTER STB QQPTR JMP BAKUP,I * M1 DEC -1 SKP * ** SCAN ** SCAN INPUT BUFFER (QIBUF) FOR KEYWORD * CALLING SEQUENCE: * * LDA NUMBER OF ENTRIES TO SEARCH * LDB ADDRESS OF PNEUMONIC TABLE ENTRY ASSOC WITH FIRST CHOICE * JSB SCAN * RETURN1 NOT FOUND * RETURN2 FOUND, OFFSET FROM FIRST ENTRY SEARCHED IN .A. * * NOTE: THIS ROUTINE WILL SKIP LEADING BLANKS IN ATTEMPTING A MATCH. * FURTHER,BUFFER POINTERS ARE ADVANCED PAST THE KEYWORD * MATCHED OR RESET IF NO MATCH OCCURRED. ***** SCAN NOP ENTRY/EXIT STB PTR INITIALIZE SCANNER STA CNTR CLA STA CNT INITIALIZE OFFSET COUNTER SCAN1 LDA PTR,I GET COMMAND POINTER WORD AND B377 MASK COMMAND TABLE OFFSET ADA CMTBL STA PTR2 STORE POINTER TO ASCII COMMAND LDA PTR,I ALF,ALF AND B377 GET # CHARS. STA NCHAR ISZ CNT BUMP OFFSET COUNTER CLA STA CCNT LDA QQCNT SAVE CHARACTER STREAM STA QQCN1 LDA QQPTR STA QQPT. POINTERS. JSB NXTC GET THE FIRST NON-BLANK CHAR CLA END OF LINE JMP SCAN5 GET REST OF CHARS IN LOOP SCAN2 JSB QGETC GET NEXT CHARACTER. CLA NO MORE CHARS. SCAN5 STA TEMP LDA PTR2,I LDB CCNT ISZ CCNT CPB NCHAR ALL CHARS. MATCH? JMP SCAN4 YES-CHECK END OF INPUT ELEMENT. SLB,RSS IS CHAR IN HIGH-ORDER BYTE? ALF,ALF YES--ROTATE TO LOW AND B177 MASK SLB BUMP ASCII COM%MAND TABLE POINTER ON ISZ PTR2 EVEN-NUMBERED CHARACTERS. CPA TEMP DO CHARS. MATCH? JMP SCAN2 YES--SO FAR. LDA QQPT. NO--BACKUP POINTERS STA QQPTR LDA QQCN1 STA QQCNT SPC 1 SKP * NOW BUMP COMMAND TABLE POINTER, OR TAKE ERROR EXIT * IF NO MORE LEFT SPC 1 ISZ PTR ISZ CNTR END OF TABLE? JMP SCAN1 NO JMP SCAN,I SPC 1 SCAN4 LDA TEMP IS NEXT SOURCE CHAR A DELIMITER? SZA END OF LINE? JSB BAKUP LDA CNT ISZ SCAN JMP SCAN,I * B377 OCT 377 * CCNT NOP COUNTER CNT NOP OFFSET COUNTER CNTR NOP NUMBER OF ENTRIES TO SEARCH NCHAR NOP NUMBER OF CHARACTERS PTR NOP MNEMONIC TABLE ADDRESS PTR2 NOP POINTER TO ASCII COMMAND QQCN1 NOP CHARACTER STREAM QQPT. NOP POINTERS TEMP NOP TEMP STORAGE SKP ***** * ** MOVE. ** MOVE BLOCK OF CHARS FROM INPUT BUFFER (QIBUF) TO A * SPECIFIED LOCATION. STOP AT FIRST DELIMITER. * CALLING SEQUENCE: * * LDA ADDRESS OF DESTINATION * JSB MOVE. * RETURN * ***** MOVE. NOP STA MOVE3 SAVE DESTINATION ADDRESS CLA,INA STA CHRCT JSB NXTC GET NEXT NON BLANK CHAR JMP ERR1 NONE FOUND MOV01 ALF,ALF POSITION CHAR TO LEFT, STA MOVE3,I AND STORE IN OUTPUT BUFFER JSB QGETC GET NEXT CHAR JMP MOV03 END OF LINE CPA LPARN LEFT PAREN? JMP MOV02 CPA B40 BLANK JMP MOV02 CPA COMMA JMP MOV02 ISZ CHRCT IOR MOVE3,I PUT LOWER HALF STA MOVE3,I IN BUFFER JSB QGETC GET NEXT CHAR JMP MOV03 END OF LINE CPA LPARN LEFT PAREN? JMP MOV02 CPA B40 BLANK? JMP MOV02 CPA COMMA JMP MOV02 ISZ CHRCT ISZ MOVE3 BUMP OUTPUT POINTER JMP MOV01 KEEP GOING MOV02 JSB BAKUP BACK UP OVER LAST CHAR MOV03 LDA CHRCT MORE THAN 5 CHARACTERS CMA,INA ADA B5 SSA JMP ERR1 YES LDA MOVE3,I WAS LAST CHAR AND UPCM CPA MOVE3,I AN EVEN NUMBERED CHAR? RSS JMP MOVE.,I YES, BUFFER IS OK IOR B40 NO, APPEND A BLANK STA MOVE3,I AND STORE IT AWAY JMP MOVE.,I * B5 OCT 5 * MOVE3 NOP DESTINATION ADDRESS * SPC 1 SKP * * SUBROUTINE TO GET LOGICAL UNIT NUMBER OF FILE * LOCFS NOP STA IDCB JSB LOCF DEF *+8 DEF IDCB,I DCB BUFFER DEF IERR ERROR CODE DEF IREC NEXT RECORD NUMBER DEF IRB RELATIVE BLOCK OF NEXT READ DEF IOFF BLOCK OFFSET OF NEXT READ DEF JSEC NUMBER OF SECTORS IN THE FILE DEF JLU FILE LOGICAL UNIT SSA,RSS ISZ LOCFS JMP LOCFS,I * IDCB NOP IOFF NOP IRB NOP IREC NOP JSEC NOP SKP * * SUBROUTINE TO INPUT-OUTPUT FROM-TO SESSION CONSOLE. * MESSI NOP CMA,INA STA IL MESSAGE LENGTH STB IBUF MESSAGE ADDRESS LDA MESSI,I STA INOUT INPUT OR OUTPUT ISZ MESSI JSB IMESS DEF *+4 DEF INOUT INPUT/OUTPUT MESSAGE DEF IBUF,I MESSAGE ADDRESS DEF IL CHARACTER COUNT JMP MESSI,I * IL NOP INOUT NOP * * SUBROUTINE TO CONVERT ASCII INPUT TO DECIMAL OUTPUT. * PNMRA NOP JSB NXTC GET NEXT CHARACTER JMP PNMRA,I NO MORE JSB BAKUP LDA BLANK STA BUFA1+1 STA BUFA1+2 LDA BUFAD JSB MOVE. PUT ASCII CHARS IN BUFFER JSB PARSE PARSE INPUT DEF *+4 DEF BUFA1 DEF B6 DEF RBUF LDA RBUF+1 ISZ PNMRA JMP PNMRA,I BUFAD DEF *+1 BUFA1 BSS 3 RBUF BSS 33 SKP ** NXTC ** GET NEXT NON-BL=<:6ANK CHAR FROM INPUT BUFFER (QIBUF) *CALLING SEQUENCE: * * JSB NXTC * RETURN1 NO MORE NON-BLANK CHARS * RETURN2 GOT ONE, AND IT IS RETURNED IN .A. * ***** NXTC NOP GET NEXT NONN-BLANK CHARACTER. JSB QGETC JMP NXTC,I ERROR RETURN CPA B40 BLANK? JMP *-3 YES ISZ NXTC TAKE NORMAL EXIT JMP NXTC,I ***** * ** QGETC ** GET NEXT CHAR FROM INPUT BUFFER (QIBUF) * CALLING SEQUENCE: * * JSB * RETURN1 NO MORE CHARS IN BUFFER * RETURN2 GOT ONE, RETURN IT IN .A. * ***** QGETC NOP GET A CHARACTER LDB QQCNT CPB QQCHC END OF INPUT? JMP QGETC,I YES. ISZ QQCNT COUNT CHARS READ LDA QQPTR,I SLB,RSS LEFT CHAR? ALF,ALF YES, MOVE RIGHT AND B177 SLB IF THIS CHAR IS RIGHT, ... ISZ QQPTR NEXT ONE IS LEFT OF NEXT WORD. ISZ QGETC SKIP EXIT JMP QGETC,I * B177 OCT 177 * SKP SKP END M< m 92065-18013 1726 S C0122 &ACFIL BASIC FILE HANDLER             H0101 ASMB,R,L NAM ACFIL,7 92065-16008 REV 1726 770512 * ************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * * PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ************************************************************** * * * * SOURCE 92065-18013 * * ENT MVNAM,FILRD,FILWR,CLFIL EXT READF,CLOSE,CREAT,OPEN,WRITF EXT $LIBR,$LIBX,$CVT1,.ENTR,EXEC EXT NAMR,.MBT,GETCR,.ENTR,EXEC COM TEMPS(30),PNTRS(61),SPEC(10) TTYPR EQU PNTRS+34 FLFIL EQU PNTRS+39 A EQU 0 B EQU 1 * DCB NOP REP 15 NOP BSS 128 * IPBUF BSS 10 .PARAMETER BUFFER FOR NAMR INBUF BSS 14 .NAMR INPUT BUFFER LENTH NOP .INPUT TEXT LENGTH ISTRC NOP * .1 OCT 1 M26 DEC -26 DPBUF DEF IPBUF CHAR NOP TEMP NOP SOUR DBR CHAR DEST DBL INBUF .DESTINATION BYTE ADDRESS SKP *************************************************** * * * THIS ROUTINE WILL MOVE THE FILENAME INTO A * * BUFFER FOR NAMR PROCESSING. THE FIRST CHARATER * * IS IN THE A REGISTER THE RETURN IS THROUGH * * P+2 TO INDICATE THE MODULE IS PRESENT FOR BASIC* * THE RETURN TROUGH P+1 IS FOR THE DUMMY VERSION * * OF THIS ROUTINE * *************************************************** * * MVNAM NOP STA CHAR .SAVE FIRST CHAR LDA M26 STA TEMP .CLEAR BUFFERS LDA DPBUF CLB AGAIN STB A,I INA ISZ TEMP JMP AGAIN * LDA .1 .SET FIRST CHARACTER COUNT STA ISTRC LDB DEST .SET UP FOR MOVING NAMR STB TEMP . INTO THIS ROUTINE TOP LDA SOUR JSB .MBT .MOVE THE CHARACTER DEF .1 NOP ɟ ISZ LENTH STB TEMP .SET UP FOR NEXT CHARACTER JSB GETCR JMP DONE .MOVE CHARACTERS UNTIL EOR STA CHAR LDB TEMP JMP TOP * DONE JSB NAMR .PROCESS NAMR RECORD DEF *+5 DEF IPBUF DEF INBUF DEF LENTH DEF ISTRC * ISZ MVNAM JMP MVNAM,I .EXIT WITH NAMR PROCESSED SKP ***************************************************** * * * THIS IS THE FILE READ ROUTINE FOR RETREIVING * * BASIC PROGRAMS FROM DISC. THIS ROUTINE WILL * * OPEN A SPECIFIED FILE IF NOT OPEN ALREADY. AND * * WILL GENERATE AN FMGR ERROR MESSAGE IF ANY FMP * * ERRORS ARE RETURNED * ***************************************************** * * M1 DEC -1 ZERO NOP IERR NOP ALEN NOP * BLEN DEF * BLOC DEF * FILRD NOP JSB .ENTR .FETCH PARAMETERS DEF BLEN * LDA DCB+9 CPA 1717B .CHECK FOR OPEN JMP RD3 .YES OPEN JSB DOOP .NO OPEN IT * RD3 LDB BLEN,I CMB,INB .CHANGE TO POSITIVE AND CLE,ERB . DIVIDE BY 2 SEZ .ADD ONE FOR ODD # CHAR INB STB TEMP * RD1 JSB READF DEF RD2 .READ A RECORD DEF DCB DEF IERR DEF BLOC,I DEF TEMP DEF ALEN DEF ZERO * RD2 LDA IERR SSA .FMP ERROR ? JSB ERROR .PRINT ERROR MESSAGE LDA ALEN .SET REGISTERS CLE,ELA .A= NUMBER ACTUAL CHARACTERS LDB IERR .B= FMP ERROR CODE JMP FILRD,I SKP **************************************************** * * * THIS ROUTINE WILL WRITE A RECORD OF BASIC * * SOURCE TO A FILE ON DISC. IT WILL OPEN OR * * CREATE A FILE IF IT IS NOT ALREADY OPEN * * IT WILL GENERATE A FMGR ERROR MESSAGE FOR ANY * L* ERROR RETURN FROM A FMP CALL * **************************************************** * * UBYTE OCT 177400 LSPC OCT 40 * BFLEN DEF * BFLOC DEF * FILWR NOP JSB .ENTR .FETCH PARAMETERS DEF BFLEN * LDA DCB+9 .CHECK FOR FILE OPEN CPA 1717B JMP WR3 .YES OPEN JSB OP.CR .OPEN OR CREATE IT * WR3 LDB BFLEN,I .MAKE BUFFER LENGTH POSITIVE CMB,INB CLE,ERB . AND DIVIDE BY 2 SEZ INB ADD ONE FOR ODD STB TEMP SEZ,RSS .PAD WITH BLANK? JMP WR1 .NO ADB M1 .COMPUTE LAST WORD ADDRESS ADB BFLOC LDA B,I .FETCH LAST WORD OF BUFFER AND UBYTE .REMOVE LOW BYTE IOR LSPC .INSERT A SPACE STA B,I . SET INTO THE BUFFER * WR1 JSB WRITF .WRITE THE RECORD DEF WR2 DEF DCB DEF IERR DEF BFLOC,I DEF TEMP * WR2 LDA IERR SSA .ERROR? JSB ERROR .PRINT FMP MESSAGE WR4 CLA LDB IERR .SET A = 0 SET B=FMP ERROR CODE JMP FILWR,I .EXIT SKP **************************************************** * * * CHECK FOR FILE EXISTANCE - CREATE ONE IF NOT * * * **************************************************** * * .4 DEC 4 M6 DEC -6 OP.CR NOP JSB OPEN .TRY TO OPEN THE FILE DEF OP.1 DEF DCB DEF IERR DEF IPBUF DEF ZERO DEF IPBUF+4 .SEC CODE DEF IPBUF+5 .CART REF # * OP.1 LDA IERR .FILE NOW OPEN? SSA,RSS .NO TRY TO CREATE IT JMP OP.CR,I .YES RETURN CPA M6 .SIMPLY NOT FOUND ? JMP OP.2 .CREATE JSB ERROR .NO SOME OTHER PROBLEM JMP WR4 .PRINT MESSAGE AND GO * * CREATE IT * OP.2 LDA .4 .FORCE TO TYPE 4 STA =IPBUF+6 LDA IPBUF+7 .SIZE DECLARED ? LDB LSPC SZA,RSS .IF NOT FORCE TO 32 BLOCKS STB IPBUF+7 JSB CREAT DEF OP.3 DEF DCB DEF IERR DEF IPBUF .NAME DEF IPBUF+7 .SIZE DEF IPBUF+6 .TYPE DEF IPBUF+4 .SEC CODE DEF IPBUF+5 .CART REF # * OP.3 LDA IERR .CREATED PROPERLY ? SSA,RSS JMP OP.CR,I .YES CONTINUE WITH WRITE JSB ERROR .NO PRINT FMGR MESSAGE JMP WR4 .EXIT WITH NO WRITE SKP ************************************************ * * * OPEN FOR READ A RECORD * * * ************************************************ * * DOOP NOP JSB OPEN DEF OOP.1 DEF DCB DEF IERR DEF IPBUF .NAME DEF ZERO DEF IPBUF+4 .SECURITY CODE DEF IPBUF+5 .CRN * OOP.1 LDA IERR SSA,RSS .ERROR? JMP DOOP,I .NO JMP RD2 .YES PRINT MESSAGE * ******************************************************* * * * CLOSE THE PROGRAM FILE * * ******************************************************* * CLFIL NOP JSB CLOSE .CLOSE THE FILE DEF CL.1 DEF DCB DEF IERR DEF ZERO * CL.1 CLA .RESET FILE FLAG STA FLFIL LDA IERR .CHECK FOR CLOSE ERROR SZA,RSS JMP CLFIL,I .NO ERROR JSB ERROR .PRINT ERROR MESSAGE JMP CLFIL,I SKP ********************************************** * * * FMP ERROR MESSAGE PRINT * * * ********************************************** * TWO DEC 2 M8 DEC -8 ERROR NOP JSB $LIBR NOP LD7A IERR LDB SPMIN .SET BUFFER TO - OR + SSA,RSS LDB SPSP .IT IS + STB PBUF+2 SSA CMA,INA .MAKE ERROR CODE POSITIVE CCE .SET FOR DECIMAL CONVERTION JSB $CVT1 .CONVERT TO ASCII STA PBUF+3 JSB $LIBX .EXIT PRIVILEDGED MODE DEF *+1 DEF *+1 JSB EXEC .WRITE OUT TO CONSOLE DEF ERR.1 DEF TWO DEF TTYPR DEF PBUF DEF M8 * ERR.1 JMP ERROR,I PBUF ASC 4,FMGR SPMIN ASC 1, - SPSP ASC 1, END p n x 92065-18014 1726 S C0122 &DUFIL DUMMY FILE HANDLER             H0101 ASMB,R NAM DUFIL,7 92065-16009 REV 1726 770512 * ************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * * PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ************************************************************** * * * * SOURCE 92065-18014 * * ENT MVNAM,FILRD,FILWR,CLFIL EXT EXEC,PRMT COM TEMPS(30),PNTRS(61),SPEC(10) LUOUT EQU PNTRS+28 A EQU 0 B EQU 1 FLFIL EQU PNTRS+39 * ENTRY NOP CLA RESET FILE FLAG STA FLFIL * JSB EXEC .OUTPUT ERROR MESSAGE DEF EXIT DEF TWO DEF LUOUT DEF ERRBF DEF BFLEN * EXIT JMP ENTRY,I * TWO DEC 2 ERRBF ASC 15, ERROR - FILE HANDLER ABSENT BFLEN DEC -29 * MVNAM EQU ENTRY FILRD EQU ENTRY FILWR EQU ENTRY CLFIL EQU ENTRY END U, ou 92065-18015 1805 S C0122 &MBASR RTE-M BASIC NAMR             H0101 kASMB,R * * NAME: MBASR * SOURCE: 92065-18015 * PROGMR: RICH * * **************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT * * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * **************************************************************** * * NAM MBASR 92065-16001 REV.1805 771110 END _7 pv 92067-18001 1805 S C0122 &4PVMP RTE-IV PRIV. MAPPING ROUT.            H0101 JASMB,R,L,C ** RTE-IV PRIVILEGED MAPPING SUBROUTINE ** HED RTE-IV PRIVILEGED DRIVER'S MAPPING SUBROUTINE * DATE: 8/17/77 * NAME: PVMP4 * SOURCE: 92067-18001 * RELOC: 92067-16001 * PGMR: E.J.W. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM PVMP4,8 92067-16001 REV.1805 771219 ENT $PVMP EXT $DVPT,$MATA,$MRMP A EQU 0 B EQU 1 * * * * ****************** NOTICE ********************** * ** $PVMP IS DESIGNED FOR USE BY PRIVILEGED ** * ** DRIVERS. EXTREME CAUTION SHOULD BE TAKEN ** * ** BY THE DRIVER WHEN CHANGING THE USER MAP. ** * ** ** * ** THE USER MAP MUST BE SAVED BEFORE CALLING ** * ** $PVMP AND THEN RESTORED BEFORE RETURNING ** * ** CONTROL TO THE POINT OF INTERRUPT!!! ** * ****************** NOTICE ********************** * * CALLING SEQUENCE: * * LDA IDADR (A) HAS ID SEG ADDR * JSB $PVMP CALL SUBROUTINE TO MAP USER * (A)=0 ERROR, PROG NOT IN PTTN * (A)#0 OK, PROGRAM MAPPED * * * * $PVMP NOP CALLED ONLY BY PRIVILEGED DRIVERS STA XIDA TEMP SAVE OF ID ADDR LDB A ADA D8 LDA A,I GET PROG'S POINT OF SUSPENSION SZA,RSS IF IT IS ZERO, TAKE JMP $PVMP,I ERROR EXIT, (A)=0 * ADB D14 LDA B,I AND D15 IS PROG MEM RES CPA D1 JMP MRPV YES,GO SET MEM RES MAP * ADB D7 GET MPID WORD LDA B,I AND B77 MPY MATSZ ADA $MATA GET PTTN ADDR STA XMAT SAVE MAT ENTRY ADDR ADA D2 LDA A,I CPA XIDA IS PROG STILL IN PARTITION? JMP XDMOK YES ,CONTINUE * CLA NO, ERROR JMP $PVMP,I RETURN (A)=0 * XDMOK CCA CAX (X)=-1 READ 1 REG LDA $DVPT (A)=REG # OF DRIVER PARTITION LDB DFDMR (B)=ADDR OF SAVE AREA XMM SAVE REG USED FOR MAPPING USER BP * LDB XMAT (B)=MATA ENTRY ADDR ADB D3 FOR SAVE & RESTORE MAP REGS LDA B,I GET PTTN'S FIRST PAGE # AND B1777 WHICH IS THE PHYSICAL BP STA B (B) = PAGE # OF BP CLA,INA CAX (X) = 1 TO SET ONE REGISTER LDA $DVPT (A)=REG # OF DRIVER PARTITION XMS MAP IN THE PHYSICAL BP * LDA $DVPT GET DRIVER PTTN PAGE # ALF,ALF SHIFT TO BITS 10-14 RAL,RAL TO FORM LOGICAL ADDRESS IOR B1740 OFFSET TO BP COPY AREA USA SET USER MAP REGISTERS * CLA,INA CAX (X)=1 WRITE 1 REG LDA $DVPT (A)=REG # OF DRIVER PARTITION LDB DVMPR (B)=SAVED DRIVER PTTN REG VALUE XMS RESTORE REG USED FOR MAPPING USER BP JMP $PVMP,I RETURN (A)=NONZERO * MRPV LDA $MRMP USA SET MEM RES MAP JMP $PVMP,I RETURN (A)=NONZERO * * D1 DEC 1 D2 DEC 2 D3 DEC 3 D7 DEC 7 D8 DEC 8 D14 DEC 14 D15 DEC 15 B77 OCT 77 B1740 OCT 1740 B1777 OCT 1777 MATSZ EQU D7 XIDA NOP XMAT NOP DFDMR DEF DVMPR ADDR OF STORAGE FOR DRIVER MAP REG DVMPR NOP DRIVER MAP REGISTER CONTENTS * BSS 0 SIZE OF SUBROUTINE END 9)  qy 92067-18002 1840 S 1022 RTE-IV LOADR              H0110 ASMB,Q,C * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * HED RELOCATING LOADR FOR RTE-IV <1730> NAM LOADR,4,90 92067-16002 REV.1840 780804 * * ENT LOADR * * EXT $ENDS,$MATA,NAMR EXT $MNP,$MBGP,$MRTP,$MCHN,$SDA,$COML EXT $PLP,$DLP,$IDEX EXT REIO,OPEN,CLOSE,READF,$CVT3,LURQ,LOGLU EXT LOCF,APOSN,WRITF,CREAT,POST EXT IFBRK,EXEC,$LIBR,$LIBX,PRTN * * NAME: RTE LOADER * SOURCE: 92067-18002 * RELOC: 92067-16002 * PGMR: C.M.M. * SUP PRESS EXTRANIOUS LISTING * SKP *1 LOADR ERROR CODES *0 ALL LOADR ERRORS ARE REPORTED TO THE LIST DEVICE. THE LIST * DEVICE MAY BE SPECIFIED AT LOAD TIME OR DEFAULTED. THE DEFAULT * LIST DEVICE IS SPECIFIED UNDER 'LIST = ' AT THE BEGINING OF THIS * DOCUMENT. * THE LOADR ERROR CODES ARE LISTED BELOW. NOTE THAT ERROR CODES * 19, 20, 21, 22, REFER TO RTE 4 ONLY. ERROR CODE 23 REFERS TO * RTE 3 ONLY. *0 LIST OF LOADR ERROR DIAGNOSTICS * * * = MODULE NAME PRINTED BEFORE DIAGNOSTIC * **= ENTRY POINT NAME PRINTED AFTER MODULE NAME * * 01 * - CHECKSUM ERROR (WAS IT A RELOCATABLE FILE ?) * 02 * - ILLEGAL RECORD * 03 * - MEMORY OVERFLOW (YOUR PROGRAM IS TOO LARGE) * (YOUR PROGRAM + MSEG SIZE IS TOO LARGE) * 04 * - BP LINKAGE OVERFLOW (TRY REARRANGING THE SUBROUTINES) * 05 * - SYMBOL TABLE OVERFLOW (GIVE THIS LOADR MORE ROOM) * 06 * - COMMON BLOCK ERROR (WAS THE 1ST COM DECL THE LARGEST ?) * 07 * ** - DUPLICATE ENTRY POINTS (YOU PUT THE SUBROUTINE IN TWICE) * 08 - NO TRANSFER ADDR (ONLY SUBROUTI+NES WERE LOADED WHERE'S THE MAIN?) * 09 * - RECORD OUT OF SEQUENCE (DID YOU POSITION THE TAPE CORRECTLY ?) * 10 - ILLEGAL PARAMETER IN RU STATEMENT OR IN STATEMENT PRIOR TO * A RELOCATE STATEMENT. * 11 - ATTEMPT TO REPLACE A CORE RESIDENT PROG (A MEM RES PROG W/SAME NAME) * 14 * - ASMB PRODUCED ILLEGAL RELOCATABLE . A DBL REC * WAS PRODUCED REFERING TO AN EXTERNAL WHICH WAS NOT DEFINED. * IE, I SHOULD HAVE FOUND IT IN MY SYMBOL TABLE BUT I DIDN'T * 16 - ILLEGAL PARTITION NUMBER OR CORRUPT MAP TABLE. * 17 - NUMBER OF PAGES REQUIRED EXCEEDS AMOUNT IN PTTN. * 18 - REQUESTED # OF PAGES EXCEEDS LARGEST POSSIBLE * ADDRESS SPACE FOR THAT PROGRAM. * 19 - EMA DECLARED TWICE OR DECLARED IN A PROGRAM SEGMENT * OR A REFERENCE TO THE EMA LABEL BEFORE THAT LABEL WAS * DECLARED EMA OR AN ATTEMPT TO DECLARE THE SAME LABEL AS * AN ENT RECORD (IE DUPLICATE ENT). EMA MUST BE DECLARED * IN THE MAIN. ANY INDIVIDUAL RELOCATABLE MODULES THAT * PRECEED THE MAIN MAY NOT HAVE EMA REFERENCES. EMA * REFERENCES MAY APPEAR ANYWHERE IN THE MAIN. EMA REFERENCES * IN SEGMENTS OR SUBROUTINES MAY APPEAR ANYWHERE WITHIN THE * MODULE BUT THAT MODULE MUST NOT BE RELOCATED BEFORE THE MAIN * 20 - NO ID EXTENSIONS AVAILABLE FOR YOUR EMA PROGRAM * 21 - PROGRAMS EMA SIZE IS TOO LARGE FOR CURRENT SYSTEMS * PARTITIONS. * 23 - ATTEMPT TO LOAD A SEGMENTED PROGRAM INTO REAL TIME PARTITION. * 24 - ATTEMPT TO ACCESS AN SSGA ENTRY POINT BUT SSGA ACCESS * WAS NOT DECLARED AT THE BEGINING OF THE LOAD. * 25 - ATTEMPT TO PURGE A PROGRAM UNDER BATCH OR ATTEMPT TO * USE THE LI OR PU COMMANDS WITHIN A TRANSFER FILE. * LI & PU MAY BE USED IN THE INTERACTIVE MODE BUT * WILL NOT BE HONORED WHEN ENCOUNTERED WITHIN A FILE. * 26 - NOT ENOUGH LONG AND SHORT ID SEGMENTS TO FINISH LOAD. * THIS ERROR CODE IS EXTREMELY RARE. IT CAN OCCUR WHEN * LOADING A SEGMENTED P̷ROGRAM WHERE THERE WERE ENOUGH * LONG + SHORT ID SEGMENTS TO SUCCESSFULLY LOAD THE LAST * SEGMENT IN THE PROGRAM WHILE THE LAST SEGMENT LOAD WAS * GOING ON. HOWEVER, WHEN THE LOADR WENT TO CREATE THE * ID SEGMENTS NOT ENOUGH LONG + SHORT SEGMENTS WERE FOUND. * IN THIS CASE SOME ID SEGMENTS WERE CREATED BUT OTHERS * WERE NOT. IF THE PROGRAM IS RUN AN SC05 ERROR WOULD * RESULT. THE CORRECT ACTION IS TO OFF OR PURGE ALL ID'S * CREATED, FREE UP ADDITIONAL ID SEGMENTS, AND PERFORM THE * LOAD OVER AGAIN. * 27 - ATTEMPT TO ACCESS AN EMA EXTERNAL (ARRAY) WITH OFFSET * OR INDIRECT. TO ACCESS EMA ARRAYS USE THE H-P SUPPLIED * SUBROUTINES .EMAP & .EMIO . * LIST OF WARNINGS (THE RELOCATION IS NOT ABORTED) * * 17 - NUMBER OF PAGES REQUIRED EXCEEDS AMOUNT IN PTTN. SKP * * LOADING OF PROGRAMS WITH THE RELOCATABLE LOADER CONSISTS OF * (1) LOADING PROGRAMS FROM THE INPUT UNIT * (2) LOADING PROGRAMS FROM THE PROG LIB * THE FIRST PROGRAM WITH A PRIMARY ENTRY POINT IS CONSIDERED * TO BE THE MAIN PROGRAM. AT LEAST ONE MAIN PROG MUST BE LOADED * BEFORE THE LIBRARY IS LOADED. LINKAGES FROM THE MAIN PROG * TO ALL USER AND LIB SUBROUTINES IS DETERMINED BY ENTRIES * IN THE LOADER SYMBOL TABLE (LST). * * EACH LST ENTRY CONSISTS OF 5 WORDS: * **************************************************** * 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 0 * **************************************************** * L * CHAR 1 * CHAR 2 * *..................................................* * U * CHAR 3 * CHAR 4 * *..................................................* * CHAR 5 * ORDINAL * *..................................................* * TYPE * V* * S * *..................................................* * V = 0/1 ABS ADDRESS / BP LINK ADDRESS * **************************************************** * 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 0 * **************************************************** * * * * EACH WORD IN THE LST ENTRY CONSISTS OF THE FOLLOWING: * * WORD 1: SYMBOL NAME - ASCII CHARACTERS 1,2 * BIT 15 = 1 MEANS THE ENTRY IS FROM SYS LIBRARY * BIT 15 = 0 MEANS THE ENTRY FROM MODULE * WORD 2: SYMBOL NAME - ASCII CHARACTERS 3,4 * BIT 15 = 1 SYMBOL REFERENCED BY CURRENT MODULE * BIT 15 = 0 SYMBOL NOT REFERENCED BY CURRENT MODULE * WORD 3: (8-15) SYMBOL NAME - ASCII CHARACTER 5 * (0-7) EXT ORDINAL NUMBER * WORD 4: ORGANIZED INTO FOLLOWING THREE FIELDS - * STATUS FIELD (BITS 0 TO 6) - INDICATES STATUS * OF THE SYMBOL AS FOLLOWS: * 0 - ENT SYMBOL READ DURING LIB SCAN (COULD BE * FROM RES LIB, RELOC LIB ON DISC OR USER * GIVEN LIB). * 1 - ENT SYMBOL READ DURING LOADING OF USER * PROGRAM. * 2 - EXT ENTRY (UNDEFINED SYMBOL). * 3 - EMA ENTRY THE SYMBOL IS CONSIDERED DEFINED. * NOTE THAT STATUS OF A SYMBOL CHANGES FROM 2 TO * 0 OR 1 AS IT BECOMES DEFINED. * 'V' BIT (BIT 7) - WHEN SET THEN WORD 5 HAS THE * THE ADDRESS OF THE BASE PAGE LINK, ELSE WORD 5 * HAS SYMBOL VALUE (VALUE OF ENT AFTER RELOCATION ). * V WILL ONLY BE SET IF THE REFERENCE IS TO EMA. * TYPE : * ENT TYPE (BITS 8 TO 15) - IS 0 FOR EXT ENTRY AND * 0 TO 4 (RELOCATION INDICATOR) FOR ENT SYMBOL. * TYPE = 0 PROG RELOCATABLE * 1 BP RELOCATABLE * 2 COMMON RELOCATABLE * 3 ABSOLUTE * 4 INSTRUCTION REPLACEMENT * * WORD 5: BASE PAGE LINKAGE ADDR IF 'V' BIT IS SET * ELSE SYMBOL VALUE . * * IIILU DEC 1 DEBUG LU IPBUF BSS 10 OUTPUT PARSED BUFFER STRNG BSS 40 INPUT STRING BUFFER SLONG NOP STRING LENGTH IN CHARS DONE? NOP =1 WHEN INPUT PRAMS CHECKED OUT * F3 DEF FILE3 FILE3 OCT 206 NOP NOP TYPE3 NOP F3SC NOP F3DSC NOP * PLIST DEC 2 BATCH NOP BATCH FLAG 0=NO /-1 = YES SKP.1 NOP SKIP FLAG (SKIP IF WE REREAD LAST COMMAND) N80 DEC -80 P16 DEC 16 P23 DEC 23 * * MOVE OR REARRANGE THE BUFFERS BELOW AT YOUR UNDYING & EVERLASTING * PERIL !!!!!!! * IDCB3 BSS 144 LIST FILE DCB NOP TEMP. LEAVE IN FRONT OF MBUF MBUF BSS 66 NAM RECORD BUFFER MBUF1 EQU MBUF+1 IDCB1 BSS 16 DCB HEADER FOR RELO FILE XBUF BSS 128 DCB & READ BUFFER FOR LU & SYS LIB READS SBUF BSS 128 DCB & DIRECTORY BLOCK READ BUFFER LBUF BSS 64 RELO RECORD PROCESS BUFFER DBUF BSS 128 ABSOLUTE OUTPUT BUFFER IDCB2 BSS 144 COMMAND FILE DCB SGNAM BSS 60 SEGMENT NAM RECORD BUFFER MVBUF BSS 18 ID INFO TO BE MOVED INTO SYS ID AREA * .BUF EQU * END OF BUFFERS IN OVERLAYED CODE SKP * * ORG IDCB3 * * *THIS SECTION OF THE LOADR RETRIEVES THE RUN STRING AND PARSES THE *INPUT. ONLY MIMIMAL ERROR CHECKING IS DONE. THIS MEANS THAT *FINAL ERROR CHECKING OF ALL ERROR CONDITIONS IS DONE ONLY AFTER *THE INPUT FROM THE COMMAND FILE IS READ. THIS ALLOWS GROSS ERRORS *TO BE MADE ON THE RUN STATEMENT BUT CORRECTED IN THE COMMAND FILE. *IN ADDITION IT MEANS COMMAND FILES WILL HAVE THE LAST WORD ON *HOW A PROGRAM IS LOADED. THUS A COMMAND FILE COULD BE SET UP TO *KEEP INEXPERIENCED USERS FROM HURTING THEMSELVES, THE SYSTEM, OR *OTHER USERS. I HATE TO USE THE WORD BUT IT IS VERY (UGH) FRIENDLY. * * * CALCULATE THE BLOCK NUMBER WHERE THE LIB DIRECTORY STARTS * AND THE POSSIBLE OFFSET IN NUMBER OF ENTRYS TO ACCOUNT FOR * AN ODD STARTING SECTOR. * WE DO THIS HERE BECAUSE IT IS OVERLAYABLE ;I SPC 1 LOADR JSB LOGLU GET THE DEFAULT LU DEF *+2 DEF MYLU# STA MYLU# * * LDA DSCLB GET DISC ADDR OF LIB DIRECT. AND M177 GET SECTOR NUMBER STA BLOK# AND SAVE TEMP XOR DSCLB GET TRACK NUMBER ALF,ALF AND POSITION RAL RIGHT JUSTIFIED MPY SECT2 MULYPLY BY SECTORS/TRACK ADA BLOK# AND ADD INTO SECTOR NUMBER CLE,ERA PRODUCE BLOCK NUMBER STA BLOK# AND SAVE FOR "GTENT" CLA,SEZ NOW SET ENTRY OFFSET NUMBER ADA P16 EQUAL TO 0 OR 16 STA OEFL1 AND SET FOR "GTENT" LDA SYSLN GET # OF,SYSTEM ENTRY POINTS ADA DSCLN ADD # OF USER ENTRY POINTS STA #ENTS TO GET TOTAL # OF ENTS * * JSB EXEC GET THE RUN STRING DEF *+5 DEF P14 DEF P1 THIS IS A GET NOT A PUT DEF STRNG ADDRESS OF 40 WORD STRING BUFFER DEF N80 LENGTH OF STRING (NEG CHAR LENGTH) * STB SLONG SLONG = STRING LENGTH IN + CHARACTERS * JSB NAMRR PARSE TWICE TO GET RID OF THE RU AND JSB NAMRR THE LOADR. WE NOW HAVE PARAMETERS. * * JSB GTCMD GET THE COMMAND FILE * * JSB NAMRR NOW GET THE INPUT FILE NAME SSA END OF STRING ? JMP SEFIL YES LDA N6 NEG COUNT TO A REG FOR MOVE WORDS JSB MOVE DEF IPBUF ADDRESS OF SOURCE DEF FILE1 ADDRESS OF DESTINATION LDA TYPE1 GET TYPE OF INPUT THAT WAS PARSED AND P3 SAVE THE LEAST TWO BITS STA TYPE1 FOR A LU VERSES FILE TEST * * * LDA IPBUF+6 * SZA,RSS * JMP *+5 * STA IIILU * JSB DBUGR * DEF *+2 * DEF IIILU * EXT DBUGR * * * * GTLST JSB NAMRR NOW GO GET THE LIST LU SSA JMP SEFIL JMP GETOP * TRKYX EQU MBUF-* ORG MBUF LEAVE ROOM FOR IDCB3 * GETOP JSB DOLST SEE IF IT'S A FILE OR LU * JSB NAMRR NOW GO GET THE OPCODE INFO SSA JMP SEFIL LDB IPBUF GET THE 1ST OPCODE JSB TEST CHECK IT OUT LDB IPBUF+1 NOW THE NEXT ONE JSB TEST LDB IPBUF+2 AND THE LAST ONE JSB TEST * JSB NAMRR NO, GO GET FMT PARAMETERS SSA JMP SEFIL LDB IPBUF GET THE FIRST OP JSB TEST CHECK IT OUT LDB IPBUF+1 NOW DO THE JSB TEST 2ND ONE LDB IPBUF+2 AND NOW THE LAST JSB TEST ONE. * JSB NAMRR NO, GET THE PART'N NUMBER IF SUPPLIED. SSA JMP SEFIL LDA IPBUF GET THE # STA #PTTN SAVE * JSB NAMRR NO, GET THE SIZE OF THE PROGRAM SSA JMP SEFIL LDA IPBUF STA #PGS AND SAVE * ******************CHECK OUT COMMAND FILE********************* * * SEFIL LDA TYPE2 GET THE TYPE WORD FOR THE COMMAND FILE SZA,RSS WAS A COMMAND FILE ENTERED ? JMP CNFLT NO, SO GO CHECK OUT THE INPUT STRING ERA,SLA YES, BUT IS IT A FILE OR A LU ? JMP FOPEN A FILE ! JMP *+1,I GO DO THE READ DEF LREAD (SAVE A BP LINK TOO ) * * M200 OCT 200 MYLU# DEC 1 DEFAULT LU B1777 OCT 1777 M400 OCT 400 SPC 1 * CHECK FOR ANY CONFLICT IN PARAMETERS AND THEN CHECK THE * PARAMETERS THEMSELVES. SPC 1 CNFLT ISZ DONE? MAKE SURE WE NEVER COME HERE AGAIN  * LDA LISTU GET THE LIST LU LDB DOLST AND THE LU LOCK SUB ENTRY POINT SZB,RSS NOW IF DOLST NEVER CALLED SZA AND LIST LU NEVER RESET, THEN JMP CNFL1 SET UP USER CONSOLE AS DEFAULT * CLA,INA SET LU NOT FILE FLAG STA IPBUF+3 * LDA MYLU# STA IPBUF JSB DOLST NOW GO SET THE LU & LOCK IT * CNFL1 LDA DBFLG GET THE DEBUG APPENDED FLAG SZA,RSS HAS DEBUG BEEN APPENDED ? JMP CHEKaR TEST THE REST OF THE PARAMETERS LDA EDFLG YES, SO SEE WHAT TYPE LOAD IT IS CPA P1 IS IT A PERMANENT LOAD JMP LDI5 YES, SO DO ERROR THING CPA P2 NO, WELL IS IT A REPLACEMENT ? JMP LDI5 YES, THIS IS AN ERROR TOO. * * CHEKR LDB XEQT (B)=ADDR OF LOADR'S ID SEG ADB P20 (B)=ID SEG'S WORD 21 ADDR XLA B,I GET WORD 21 TO CHECK BIT 15 CCB GET A FLAG READY SSA IF LOADR RUNNING UNDER BATCH STB BATCH LDA PLIST GET THE LISTING PARAMETER SSA JMP LDI5 THEN INPUT ERROR ADA N4 SSA,RSS IF GREATER THAN 3 JMP LDI5 THEN INPUT ERROR. LDA FILE1 CHECK PRAM 1. CPA P1 IF INPUT IS SYS TTY, JMP LDI5 TREAT AS ERROR CPA P2 IS THIS TO THE DISK JMP LDI5 JUST WHO DO YOU THINK YOUR KIDDING?????? * LDB XEQT (B)=ADDR OF LOADR'S ID SEG ADB P23 (B)=ADDR OF LOADR'S HIGH MAIN XLA B,I SET UP LOADR SYMBOL TABLE TO STA BLST START FROM LOADR'S HIGH STA PLST MAIN ADDR AND GROW UP STA TLST TOWARD HIGH CORE. STA SLST STA FLST ADB N9 (B)=ADDR OF LOADR ID'S WORD 15 XLA B,I GET LOADR'S PROG TYPE LDB BKLWA GET ADDR OF LOADR'S LAST WORD AND P7 SPC 1 CPA P2 SKIP IF LOADR IS BG LDB RTLWA ELSE GET LWA OF BG. STB BKLWR SET AS LWA AVAILABLE TO LOADR CLB STB MBUF CLEAR "VALID MODULE NAME PRESENT" FLAG * LDA #PGS DID HE SUPPLY A NEGATIVE SIZE ? SSA WELL ? JMP ER.17 SEND THE TURKEY A LOVE MESSAGE. LDA #PTTN GET THE PART'N SPECIFIED IF ANY SZA,RSS WAS PTTN# SPECIFIED? JMP NOPTN NO, DO SIZE CHECK LATER SSA BUT IF NEG JMP ER.16 FLUSH HIM. FSPC 2 * PARTITION WAS SPECIFIED FOR THIS PROG * XLA $MNP YES, DO SIZE CHECK NOW. GET MAX # PART'NS * CMA ADA #PTTN SSA,RSS ERR16 IF PTTN# > #PTTNS JMP ER.16 * CCA ADA #PTTN 7 * (PTTN# - 1) + $MATA MPY P7 IS ADDR OF ENTRY XLB $MATA ADA B XLB A,I (A) IS ADDR MAP ENTRY SSB IF ENTRY NOT DEFINED, JMP ER.16 GIVE ERR16 * ADA P4 BUMP TO WORD 5 XLA A,I AND B1777 REMOVE RESERVED FLAG STA #PGPT SAVE #PAGES IN PTTN CMA ADA #PGS ENOUGH PAGES IN SSA SPECIFIED PTTN? JMP PGSOK YES SZA OK IF EQUAL LDA #PGS NO, BUT WAS SPECIFIC SZA SIZE REQUESTED? JMP ER.17 YES, CAN'T FIT! * PGSOK CCA ADA #PGS SUBT 1 FROM #PGS REQUESTED SSA ANY REQUESTED? LDA #PGPT NO, USE SIZE OF PTTN STA #MXBG SET AS MAX SIZE STA #MXRT OF QUALIFIED AREAS JMP CMMST NOW SET UP COMMON STUFF * * * NO PARTITION WAS SPECIFIED FOR THIS PROG * NOPTN XLA $MBGP GET MAX BG PARTN STA #MXBG XLA $MRTP GET MAX RT PARTN STA #MXRT * * *E * CMMST LDB PTYPE GET THE PROG TYPE XLA $PLP ASSUME ITS A TYPE 2 OR TYPE 3 RBR,RBR IS IT ? SLB,RSS WELL ?! JMP SETLP YES * XLA $DLP NO, ITS A LARGE BG PROG TYPE = 4 LDB COMTP GET THE COMMON TYPE ADB #MPFT ADD IN SSGA SZB,RSS ANY COMMON ? JMP SETLP NO. * XLA $SDA THE FIND PG # OF START OF SYSDVR AREA ALF,ALF CONVERT TO PG # RAL,RAL SETLP STA URFWA SET THE LOAD POINT OF PROG. * RAL,RAL PUT PAGE # IN LOWER BITS ALF ADA #PGS ADD IN REQUESTED PAGE SIZE ADA N34 SU6BTRACT MAX PROG SIZE SSA,RSS REQUESTED SIZE TOO LARGE ? JMP ER.18 YES, SO FLUSH THE TURKEY * LDA URFWA GET THE LOAD POINT AGAIN CCB SET PROPER LWA USER ADB #PGS #PAGES REQ'D LESS BASEPAGE SSB WAS ANY REQUESTED? JMP LEDT4 NO, DEFAULTS 77777 BLF,BLF SHIFT TO FORM PAGE ADDR RBL,RBL ADA N1 SUBT 1 AND ADD TO U.FWA ADA B FOR ADDR OF U.LWA SSA,RSS IF PAST 32K USE 77777 STA URLWA NO, SET URLWA,UBLWA * * LEDT4 LDA COMTP GET THE COMMON TYPE SZA,RSS ANY COMMON JMP LCLCM NO JUST LOCAL COMMON LDB PTYPE GET THE PROG TYPE CPA P1 SYS COMMON OR REVERSE COMMON ? JMP STRAT SYS COMMON. * CPB P2 IS IT A RT PROGRAM ? JMP ITSBG YES, SO USE BG COMMON JMP ITSRT NO, A BG PROG SO USE RT COMMON * STRAT CPB P2 IS IT A RT PROG JMP ITSRT ITSBG LDA P3 SET MPFT FENCE STA #MPFT LDA BKORG GET START OF BG COMMON LDB BKCOM AND THE LENGTH JMP STUF ITSRT LDA P2 STA #MPFT NOW DO RT LIKE BG ABOVE LDA RTORG LDB RTCOM STUF STA COMAD STB MXCOM JMP CMEXI GO LOOK FOR SSGA. * LCLCM CCA SET THE LOCAL COMMON FLAG STA COMIN LDA P5 NOW ASSUME PROG BG OR RT LDB PTYPE GET THE PROG TYPE CPB P4 IS IT A LBG PROG ? CLA YES STA #MPFT * CMEXI LDA P4 WELL, DOES HE WANT SSGA ? LDB SSGA SZB 0/1 NO/YES STA #MPFT * * * LDA UBFWA SET FWA USER BG DISC RES STA AFWA ORIGIN AS ABS FWA + LDA UBLWA SET UPPER STA LWA BOUND. LDA BPA3 GET FWA OF BKG BASE PAGE AREA STA BPREL SET BASE PAGE RELOCATION BASE STA BPFWA SAVE IT CMA,INA AND SUBTRACT FR=OM LWA OF ADA BKGBL LINK AREA. * CMA,INA CACULATE AREA SIZE IN UPPER MEMORY STA B SAVE COUNT FOR ZEROING ADA BKLWR SUBTRACT FROM END OF MEM STA FWABP SET BOUNDRY STA CWABP INITIALIZE ALLOCATION WORD STA SEGB AND SEGMENT BASE PAGE STA IDA ADDRESS OF BASE ID SEG (NONE EXIST YET) STA MBUF1 POINTER TO ZAP THE AREA WITH STA TFIX LOW END OF FIXUP TABLE (AGAIN NONE EXIST) LDA BKLWR SET LWA STA LWABP OF AREA CLA CLEAR LDI7 STA MBUF1,I DUMMY ISZ MBUF1 BASE INB,SZB PAGE JMP LDI7 AREA * LDA AFWA SET UP THE BASE LOAD ADDRESSES STA FWA FIRST WORD FOR LOAD ADA P2 ALLOCATE ROOM FOR X,Y REGS STA SEGM SEGMENT BASE STA TPREL HIGHEST USED MEMORY ADDRESS STA PPREL * LDB OPCOD GET THE LAST OPCODE CPB P4 WAS IT A 4 JMP PURGE YES SO GO PURGE THE PROGRAM * LDB EDFLG IF REPLACEMENT, CPB P2 DON'T REQUIRE A CLA,INA,RSS BLANK ID SEGMENT. CLA BLANK ID REQUIRED CLB INDICATE LONG ID JSB SETID BLANK ID SEGMENT * JSB ITRAK MAKE ALLOCATION. * CCB STB NUPLS SET NO. PROGS LOADED = -1 STB PLFLG SET LOADING FLAG = LOADING LDA DBFLG GET DEBUG FLAG SZA,RSS SKIP - DEBUG OPTION SELECTED JMP NODBG OMIT ENTERING DEBUG INTO LST SKP * * ENTER '.BBUG' INTO LST * JSB LSTX SET CURRENT LST ADDRES NOP LDA CHRDE GET CHARS . , D STA LST1,I SET NAME 1,2 INTO LST LDA CHRBU GET CHARS B,U STA LST2,I SET NAME 3,4 INTO LST LDA UCHRG GET UPPER CHAR G STA LST3,I SET NAME 5 INTO LST LDA P2 SET LST4 = UNDEF SYMBOL & STA LST4,I LDA TLST SET NEW STA PLST END-OF-LIST ADDR. NODBG CLA STA DSECT SET CURRENT SECTOR = 0. LDA TRAKB SET CURRENT TRACK = STA DTRAK TRACK BASE. * * * LDA TYPE1 GET THE TYPE OF INPUT SZA,RSS ANY MAIN SPECIFIED ? JMP CDTST NO, GO SEE IF ANY CMND FILE LDB TYPE2 YES SZB,RSS IS THERE A CMND FILE ALSO ? JMP DMANE NO, SO JUST GO LOAD MAIN * CCB YES, SO SET A FLAG SO THAT WE KNOW STB SKP.1 TO REREAD THE LAST COMMAND JMP DMANE * N34 DEC -34 * ER.17 LDA ERR17 JMP ABOR * ERR17 ASC 1,17 CDTST LDB TYPE2 GET CMND FILE TYPE SZB,RSS IS THERE A CMND FILE ? JMP LDI5 NO CMND FILE AND NO MAIN ???????? JMP *+1,I GO GET THE LAST COMMAND DEF SECK1 (SAVE A BP LINK TOO !) * SKP SKP 2 *********************************************************************** * OVERLAYABLE SUBROUTINES *********************************************************************** SPC 2 * * THE TEST SUBROUTINE IS USED TO CHECK OUT AND PROCESS * ALL OPCODE AND FMT PARAMETERS. * FMT AND OPCODE MNEMONICS MAY BE INTERMIXED AND INTER- * MINGLED. ANY UNDEFINED MNEUMONIC WILL GENERATE AN * L-10 ERROR. TEST NOP SZB IF NOTHING ENTERED CPB ABLNK JMP TEST,I STB OPP SET THE ERROR RETURN CODE = INPUT CODE LDA LDOPC GET START OF OPCODE TABLE STA XTEMP AND SAVE FOR SEARCH LDA LDJMP GET JUMP ADDRESS TABLE STA YTEMP AND SAVE FOR JUMP TO APPROPRIATE PROCESSOR LOOPR CPB XTEMP,I IS THIS THE CODE JMP YTEMP,I YES, SO JUMP TO THE APPROPRIATE PROCESSOR ISZ XTEMP NO, SO BUMP THE ISZ YTEMP TWO POINTERS AND JMP LOOPR TRY AGAIN. * LDOPC DEF *+1 ADDRESS OF START OF TABLE ASC 16,LIPULBRTSCRCNCSSDBPETERPRSBGLENL OPP NOP ERROR CODE LDNLHJMP DEF *+1,I HEAD OF JUMP TABLE DEF DO3 LIST OPERATION DEF DO4 PURGE OPERATION DEF LB BG PROGRAM (LARGE) DEF RT RT PROGRAM DEF SC USES SYSTEM COMMON DEF RC USES REVERSE COMMON DEF NC NO COMMON (OR LOCAL COMMON- DEFAULT) DEF SS USES SSGA DEF DB APPEND THE DEBUG ROUTINE DEF PE PERMANENT PROGRAM (ADDITION) DEF TE TEMPORARY PROGRAM (DEFAULT) DEF RP REPLACEMENT OPERATION DEF RS RESCAN FILE FOR APPENDED SUBROUTINES DEF BG PRIVLEDGED PROGRAM DEF LE LIST ENTRY POINTS DEF NL NO LISTING DESIRED DEF PRERR INPUT ERROR PROCESSING * * ABLNK ASC 1, * * ********************************************************************** *THIS SECTION SETS A FEW FLAGS FOR LATER USE IN LOADING THE PROGRAM WN*AS THE INFORMATION COMES IN THE FLAGS ARE SET. THE FLAGS ARE NOT *CHECKED UNTIL ALL INFORMATION ABOUT THE PROGRAM FROM THE RUN STRING *OR THE COMMAND FILE HAS BEEN PROCESSED. * * BACKROUND PROGRAMS SET PTYPE = 3 * REAL TIME PROGRAMS SET PTYPE = 2 * TEMPORARY PROGRAMS SET EDFLG = 0 * PERMANENT PROGRAMS SET EDFLG = 1 IE PERMANENT ADDITION * REPLACED PROGRAMS SET EDFLG = 2 IE PERMANENT REPLACEMENT * #PAGES = # OF PAGES IN PROGRAM (INCLUDES BP) * #PTTN = PARTITION # (COUNTING FROM 1 ) * SSGA = 0/1 DON'T USE / USE SSGA * COMTP = 0 ... NO COMMON ( OR LOCAL COMMON) * COMTP = 1 ... SYSTEM COMMON * COMTP = 3 ... REVERSE COMMON * OPCOD = 1 IF DBUG APPENDED * OPCOD = 3 IF PROGRAM LISTING DESIRED * OPCOD = 4 IF PROGRAM PURGE DESIRED * DO3 LDA TYPE2 GET THE COMMAND TYPE ERA,SLA IS IT A FILE ? JMP LDI25 THEN ITS AN ERROR JMP LLIST DO THE LISTING * DO4 LDB P4 GET THE PURGE CODE STB OPCOD AND SAVE FOR LATER LDB TYPE2 GET THE CMND TYPE ERB,SLB IF ITS A FILE FLUSH HIM JMP LDI25 AND TELL HIM THE COMMAND TOO JMP CHEKR INTERACTIVE CMND OK. * LB LDA P4 BACKROUND PROGRAM (LARGE) BG2 STA PTYPE JMP TEST,I RT LDA P2 JMP BG2 BG LDA P3 JMP BG2 * NC CLA,RSS SC CLA,INA SC2 STA COMTP JMP TEST,I RC LDA P3 JMP SC2 * SS CLA,INA STA #MPFT STA SSGA SSGA FLAG JMP TEST,I * DB CLA,INA STA DBFLG STA OPCOD JMP TEST,I * TE CLA,RSS PE CLA,INA PM2 STA EDFLG JMP TEST,I RP LDA P2 JMP PM2 * RS CLA,INA STA RSCAN SET THE RESCAN FLAG STA MSEG SET SEGMENTED PROGRAM FLAG JMP TEST,I * LE CLA,RSS NL LDA P3 STA PLIST JMP TEST,I * * SKP * * THIS ROUTINE SETS UP THE LIST DEVICE AS AN LU OR FILE * DOLST NOP LDB IPBUF+3 GET THE TYPE WORD SZB ANY LU SUPPLIED OR IS IT NULL ? JMP DOALU YES, SO FIX THE LU * INB NULL SUPPLIED, SO SET DEFAULT STB IPBUF+3 * LDA MYLU# STA IPBUF * * JSB CLOS3 CLOSE ANY OLD FILE * DOALU LDA N6 GET THE NEG COUNT FOR THE MOVE JSB MOVE MOVE THE BUFFER TO FILE NAME AREA DEF IPBUF THE LIST DEVICE MAY BE A FILE DEF FILE3 LDA TYPE3 GET THE INPUT TYPE AND P3 AND KEEP ONLY STA TYPE3 THE LOWER BITS ERA,SLA IS IT A FILE OR AN LU ?? JMP OPNFL A FILE, SO OPEN IT. * LDA IPBUF GET THE LIST LU SZA,RSS IS THERE ONE ? JMP ZIPLU NO . JSB INTER IS IT INTERACTIVE ? RSS NO! JMP ZIPLU YES, DON'T LOCK IT * JSB LURQ UNLOCK ANY PREVIOUS LOCK DEF *+2 DEF MSIGN * JSB LURQ NOW LOCK THE NON INTERACTIVE LU DEF *+4 DEF P1 SPECIFY LOCK DEF IPBUF SPECIFY THE LU DEF P1 AND THE # OF LU'S * LDA IPBUF GET THE LU IOR M200 SET V BIT TO USE COLUMN 1 ZIPLU STA LISTU AND SET IT UP * JMP DOLST,I GET THE NEXT PARAMETER * OPNFL LDA FILE3 GET THE 1ST 2 CHARS OF FILE NAME AND M7400 KEEP ONLY UPPER BYTE CPA ACENT IS IT A ' JMP OPEN3 YES SO GO OPEN THE FILE * CRAT3 JSB CREAT NO, SO CREAT THE FILE DEF *+8 DEF IDCB3 DEF IERR3 DEF FILE3 DEF P12 SIZE = 12 BLOCKS DEF P4 DEF F3SC DEF F3DSC * F3ERR SSA,RSS ANY ERRORS ? JMP DOLST,I NO, FILE NOW OPEN. SO RETURN * JSB CLOS3 YES, SO CLOSE THE LIST FILE LDB F3 GET THE FILE NAME ADDRESS TO B LDA IERR3  ERROR CODE TO A JMP FLERR DO FILE ERROR THING * * OPEN3 JSB OPEN OPEN THE LIST FILE DEF *+7 DEF IDCB3 DEF IERR3 DEF FILE3 DEF IPTN3 DEF F3SC DEF F3DSC * CPA N6 DID WE FIND THE FILE ? JMP CRAT3 NO SO GO CREAT IT JMP F3ERR SEE IF ANY ERRORS * * ACENT OCT 23400 THIS IS A ' * * * * OVLY1 CPB AS ASSIGN PARTITION ? JMP DOAS CPB SZ SPECIFY PROGRAM SIZE JMP DOSZ CPB LL NEW LIST DEVICE ? JMP DOLL CPB OP NEW OPCODE PARAMETERS ? JMP DOOP CPB FM NEW FORMAT PARAMETERS JMP DOOP JMP PRERR MUST BE AN ERROR * AS ASC 1,AS SZ ASC 1,SZ LL ASC 1,LL OP ASC 1,OP FM ASC 1,FM * * * DOAS JSB NAMRR GO PARSE THE INPUT LDA IPBUF GET THE PARTITION # STA #PTTN AND SAVE FOR LATER CHECK JMP NXTOP DOSZ JSB NAMRR GO PARSE LDA IPBUF GET THE # OF PAGES STA #PGS SAVE FOR LATER ERROR CHECKING JMP NXTOP DOLL JSB NAMRR PARSE TO GET THE LIST DEVICE JSB DOLST NOW CHECK IT OUT JMP NXTOP DOOP JSB NAMRR PARSE THE INPUT PARAMETER STRING LDB IPBUF GET THE 1ST PARAMETER JSB TEST AND CHECK IT OUT LDB IPBUF+1 JSB TEST NOW TEST THE SECOND PARAMETER LDB IPBUF+2 JSB TEST AND THE LAST PARAMETER JMP NXTOP GET THE NEXT OP CODE * * * ********************************************************************** * TRKYY EQU IDCB2-* OVERLAY CHECK !! * * SKP * * SYSTEM PROGRAM LISTING OPTION * * THE SELECTION OF THIS OPTION GIVES A LISTING * (ON THE LIST UNIT) OF THE PRIMARY CONTENTS OF * EACH ID SEGMENT IN THE SYSTEM. * THE LISTING IS PRECEDED BY THE HEADING: * NAME TYPE PRIORITY HIGH MAIN LOW MAIN REQ'D SIZE EMA SIZE PTTN * * EACH LINE OF OUTPUT FOR A DEFINED ID SEGMENT IS: * AS SHOWN ABOVE. * * A BLANK ID SEGMENT (AVAILABLE FOR USE) IS * NOTED BY THE LINE OUTPUT: * "" OR "" * * * LLIST JSB SPACE LDB LLM1 PRINT LDA P76 SPC 1 JSB DRKEY JSB SPACE JSB SPACE * LDA KEYWD SAVE STARTING STA ABT1 KEYWORD ADDR. * ZAP36 LDB ABLNK GET AN ASCII BLANK READY LDA N38 # OF WORDS TO BLANK STA YTEMP SAVE TEMPORARIALLY LDA LLM1 GET THE BUFFER ADDRESS ZAPIT STB A,I BLANK IT OUT FOR REUSE INA BUMP POINTER ISZ YTEMP ARE WE DONE ? JMP ZAPIT NO * * JSB BREAK SEE IF BREAK BIT SET XLB ABT1,I GET ID SEGMENT ADDR. SZB,RSS IF END-OF-LIST, GO TO SINGLE JMP GTNBR TERMINATION * ADB P12 SET TO NAME AREA. XLA B,I GET NAME 1,2, STA LLM1+1 SET IN MESSAGE. SZA,RSS IF NAME WORD = 0, THEN JMP LL3 BLANK ID SEGMENT. INB XLA B,I SET NAME 3,4 STA LLM1+2 IN MESSAGE. INB XLA B,I GET NAME 5, AND M7400 ISOLATE, IOR BLNK ADD BLANK STA LLM1+3 AND STORE. * JSB LIST? GO SEE IF WE SHOULD PRINT IT * * XLA B,I GET TYPE AND M7 CODE. STA ZTEMP SAVE PROG TYPE IOR M60 MAKE ASCII, IOR UBLNK ADD UPPER BLANK, STA LLM1+5 AND STORE. * XLA B,I GET THE WORD AGAIN AND M20 GET THE SS BIT STA YTEMP SAVE IT * CLB STB OPCOD INSURE AN OCTAL CONVERSION * JSB ADJST GET THE ID ADDRESS AGAIN ADA P23 INDEX TO HIGH MAIN XLA A,I GET IT LDB LLM18 GET THE DESTINATION ADDRESS JSB CONVD DO THE CONVERSION. * JSB ADJST GET THE ID ADDRESS AGAIN ADA D22 INDEX TO THE LOW MAIN WORD XLA A,I LDB LLM13 GET THE DESTINATION JSB CONVD DO THE CONVERSION * JSB ADJST GET THE ID ADDRESS AGAIN ADA P24 GET LOW BP XLA A,I GET THE WORD LDB LLM23 GET THE DESTINATION JSB CONVD DO THE CONVERSION * JSB ADJST GET THE ID ADDRESS AGAIN ADA P25 GET THE HI BP XLA A,I LDB LLM28 JSB CONVD * * LDB ZTEMP GET THE PROGRAM TYPE BACK AGAIN CPB P5 IS IT A SEGMENT ? JMP LL4 YES * PROR XLB ABT1,I GET THE ID ADDRESS AGAIN ADB P6 INDEX TO THE PRIORITY XLA B,I GET THE PRIORITY LDB P3 MAKE SURE THE CONVERSION IS DECIMAL STB OPCOD LDB LLM8 GE THE DESTINATION ADDRESS JSB CONVD DO THE CONVERSION * LDA ZTEMP GET THE PROG TYPE AGAIN CPA P1 MEM RES ? JMP LL4 YES, SO WE'RE DONE * * XLB ABT1,I GET THE ID ADDRESS AGAIN (TEDIOUS ISN'T IT ?) ADB D21 INDEX TO SIZE WORD XLA B,I GET THE SIZE STA XTEMP SAVE IT AND M0760 NOW GET THE SIZE INFO ALF,ALF PLAY A FEW GAMES WITH IT RAR,RAR INA ACCOUNT FOR BASE PAGE JSB CNV99 CONVERT TO ASCII STA LLM1+28 SOCK IT AWAY * LDA XTEMP GET THE SIZE WORD AGAIN SSA,RSS IS THIS PROG ASSIGNED TO A PARTITION ? JMP LL4. NO, SO GO DO OUTPUT * AND M77 SO GET THE PARTITION # INA MAKE IT COUBT FROM 1 (NOT 0 ) JSB CNV99 DO THE CONVERSION STA LLM1+37 SAVE IT * LL4. XLB ABT1,I GET THE ID SEG AGAIN ADB D28 GET TO EMA WORD XLA B,I PULL IT IN SZA,RSS ANY EMA DECLARED ? JMP LL4 NO, SO WE'RE DONE WITH THIS LINE * STA LLIST SAVE WORD AND B1777  KEEP EMA SIZE LDB LLM30 GET THE ADDRESS JSB CONVD AND CONVERT * LDA LLIST NOW GET THE MSEG SIZE FROM THE ALF ID EXTENSION RAL,RAL AND M77 XLB $IDEX ADA B XLA A,I NOW HAVE THE MSEG ADDRESS XLA A,I NOW HAVE THE MSEG WORD AND M37 JSB CNV99 STA LLM1+34 * * LL4 LDA P76 PRINT NAME LDB LLM1 LINE JSB DRKEY * LL2 ISZ ABT1 GET NEXT KEYWORD ADDR. JMP ZAP36 -REPEAT SCAN. * * OUTPUT BLANK ID MESSAGE * LL3 LDA TYPE1 GET THE PROG NAME TYPE WORD SZA ANY PROG SPECIFIED JMP LL2 YES SO DONT PRINT THE BLANK ID MSG. ADB P2 (B)=ADDR OF NAM5 WORD XLA B,I GET NAM5 WORD AND M20 MASK IN 'SS' BIT LDB LLM3 (B)=ADDR OF LONG ID MESSAGE SZA 'SS' BIT SET ? LDB LLM4 YES-(B)=ADDR OF SHORT ID MESSAGE LDA P18 (A)=MESSAGE LENGTH JSB DRKEY JMP LL2 * * GTNBR LDA P3 INSURE DECIMAL CONVERSION STA OPCOD JSB BLKID LDA BID5 GET # OF LONG LDB L#1 GET ADDRESS JSB CONVD CONVERT * LDA BID6 GET # OF SHORT IDS LDB L#2 JSB CONVD * LDA BID11 GET # OF ID EXTS LDB L#3 JSB CONVD * JSB SPACE LDA P64 PRINT THE INFO LDB L#IDS JSB DRKEY AND AS PORKY PIG WOULD SAY : * JMP EXIT THA-THA-THA-THA-THATS ALL FOLKS !!!!! * * * PURGE CLA,INA GO SET CLB JSB SETID ID ADDRS FOR LONG ID LDB BATCH GET THE BATCH FLAG SSB UNDER BATCH ? JMP LDI25 YES , ITS AN ERROR * LDA PAM1 GET INPUT PARAMETER P1 * SZA INPUT SPECIFIED ? * JMP USEIM YES - GO USE IT. * LDB BATCH GET BATCH FLAG * INA SET FOR LU1 * SZ`B RUNNING UNDER BATCH ? * LDA P5 YES-THEN DEFAULT INPUT TO LU 5 * SZB,RSS RUNNING UNDER BATCH? *SEIM STA LIST1 NO, SET PROMPT LU LDA FILE2 GET THE CMND FILE LU # AND M77 KEEP ONLY LOWER BITS JSB INTER SEE IF IT'S INTERACTIVE JMP TRLST NOPE GOTIT IOR M400 SET ECHO BIT STA LISTU AND SET THE LU JMP TRYAG GO PRINT THE MESSAGE * TRLST LDA LISTU GET THE LIST LU AND M77 KEEP ONLY LU JSB INTER GO SEE IF ITS INTERACTIVE JMP LDI5 THAT'S NOT EITHOR, SO FLUSH HIM ! JMP GOTIT * * TRYAG LDA P10 SEND THE MESSAGE LDB LLM2 LOADR: PNAME ? JSB SYOUT TO THE OUTPUT DEVICE * LDA LLM2+1 GET AN ASCII BLANK STA NAM12,I AND INITIALIZE BUFFER STA NAM34,I STA NAM5,I * JSB EXEC READ THE REPLY DEF *+5 TO THE DEF P1 DEF LISTU DEF NAM12,I NAME AREA IN THE ID SEGMENT DEF P3 THREE WORDS LDA NAM12,I CHECK FOR /A (ABORT OPERATION) CPA /A JMP ABORT YES GO ABORT JSB MIDN GO SEE IF THE NAME IS DEFINED JMP LDI5 NO GO SEND MESSAGE JMP *+1,I GO PURGE THE PROG DEF ED0 (SAVE A BP LINK TOO !) SPC 1 * BLNK OCT 40 D21 DEC 21 D22 DEC 22 * * L#IDS DEF *+1 ASC 22,XXXXXX FREE LONG IDS, XXXXXX FREE SHORT IDS, ASC 10,XXXXXX FREE ID EXTS * L#1 DEF L#IDS+1 L#2 DEF L#IDS+12 L#3 DEF L#IDS+23 LLM1 DEF *+1 ASC 20,NAME TYPE PRIORITY LO MAIN HI MAIN ASC 18, LO BP HI BP SIZE EMA MSEG PART'N SPC 1 /A ASC 1,/A * LLM4 DEF *+1 ASC 9, LLM3 DEF *+1 ASC 9, * LLM13 DEF LLM1+12 LLM18 DEF LLM1+17 LLM23 DEF LLM1+20 LLM28 DEF LLM1+24 LLM8 DEF LLM1+7 LLM30 DEF LLM1+30 P24 DEC 24 P25 DEC 25 P76 DEC 76 N38 DEC -38 D28 DEC 28 LLM2 DEF *+1 ASC 5, PNAME ?_ * * * ADJST NOP XLA ABT1,I GET THE ID ADDRESS AGAIN LDB YTEMP GET THE SHORT SEG FLAG CPB M20 IS THIS A SHORT SEG ? ADA N7 THEN ADJUST A REG JMP ADJST,I AND RETURN * * LIST? NOP LDA TYPE1 SZA,RSS ANY THING INPUT FOR PROG NAME ? JMP LIST?,I NO, SO CONTINUE LDA FILE1 GET 1ST CHAR CPA LLM1+1 IS IT THIS ONE ? RSS YES JMP LL2 NO LDA FILE1+1 GET 2ND CHAR CPA LLM1+2 RSS JMP LL2 LDA FILE1+2 GET THE LAST CHAR CPA LLM1+3 JMP LIST?,I SUCCESS !!! JMP LL2 SPC 1 NOVLY EQU * BEGIN NON-OVERLAYABE CODE .LBUF EQU *-LBUF-128 OVERLAY CHECK .DBUF EQU *-DBUF-128 OVERLAY CHECK .XBUF EQU *-XBUF-128 OVERLAY CHECK * BSS .BUF-* TURKY EQU *-.BUF OVERLAY CHECK NOP * * UBLNK OCT 20000 COMTP NOP TYPE OF COMMON 0/1/3 LOCAL/SYS/REVERSE M60 OCT 60 ERR25 ASC 1,25 LDI25 LDA ERR25 JMP ABOR DBFLG NOP 0/1 NORMAL LOAD /APPEND DEBUG XTEMP NOP YTEMP NOP ZTEMP NOP BKLWR NOP LAST WORD OF AVAIL MEMORY INDLU NOP TEMP LU WORD #PGPT NOP # OF PAGES IN PART'N * * SKP *********************************************************************** * NON OVERLAY AREA *********************************************************************** * * * LSCAN SEARCHES FOR AN ENTRY IN LST IDENTICAL TO THE NAME IN TBUF. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB LSCAN * * RETURN: CONTENTS OF A AND B ARE DESTROYED. * (N+1): END OF LST. CURRENT LST ADDRES POINT TO THE NEXT * AVAILABLE ENTRY IN LST. * (N+2): NAME FOUND IN LST. CURRENT LST ADDRES POINT * TO THIS ENTRY. * LSCAN NOP JSB INLST INITIALIZE LSTX LDB TLST ENTX1 CPB PLST END OF LST ? JMP SLSTS "t YES - GO MAKE NEW ENTRY LDA B,I RAL,CLE,ERA CPA TBUF NAME 1,2 EQUAL ? JMP *+3 YES ADB P5 JMP ENTX1 NO - CHECK NEXT ENTRY INB LDA B,I CPA TBUF+1 NAME 3,4 EQUAL ? JMP *+3 ADB P4 JMP ENTX1 NO - CHECK NEXT ENTRY INB LDA B,I AND M7400 MASK OFF ORDINAL STA TBUF+3 LDA TBUF+2 AND M7400 MASK IN NAME 5 CPA TBUF+3 NAME 5 EQUAL ? JMP *+3 YES - SET LST1-5 ADDRES ADB P3 JMP ENTX1 ADB N2 BACK UP TO LST1 STB TLST AND SET UP TO CALL LSTX JSB LSTX FAKE IT HLT 0 I ALREADY CHECKED!! ISZ LSCAN SET FOR (P+2) RETURN JMP LSCAN,I SLSTS STB TLST (FOR LSTX TO USE) JSB LSTX ** RETURN MUST ALWAYS BE (P+1) ** JMP LSCAN,I RETURN (P+1) HLT 0 SKP * * SET NAME INTO LST * * SELST SETS THE CURRENT NAME INTO LST. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB SELST * * RETURN: CONTENTS OF A AND B ARE DESTROYED. * SELST NOP LDA TBUF GET NAME 1,2 STA LST1,I SET NAME 1,2 INTO LST. LDA TBUF+1 GET NAME 3,4 STA LST2,I SET NAME 3,4 INTO LST LDA TBUF+2 GET NAME 5 AND M7400 ISOLATE UPPER CHAR STA LST3,I SET NAME 5 INTO LST LDA TLST GET NEXT LST ADDR STA PLST SET NEW END OF LST JMP SELST,I RETURN * * * GTCMD NOP JSB CLOS2 CLOSE CURRENT LIB * JSB NAMRR NOW GET THE COMMAND FILE NAME SSA,RSS END OF STRING ? JMP NOSTG NO * LDA MYLU# YES, NO STRING. GET THE DEFAULT LU STA IPBUF PUT INTO PARSE BUFFER CLA,INA SET TYPE WORD TO LU (NOT A FILE) STA IPBUF+3 * NOSTG LDA N6 GET THE NEG COUNT AGAIN JSB MOVE AND MOVE THE NAME TO THE CMND NAeME BUFFER DEF IPBUF SOURCE OF MOVE DEF FILE2 COMMAND FILE NAME ADDRESS * CLA CLEAR INTERACTIVE FLAG STA DFLAG * LDA TYPE2 GET THE PARSE TYPE WORD AND P3 KEEP ONLY THE LEAST TWO BITS STA TYPE2 AND SAVE FOR LATER * ERA,SLA IS IT A FILE OR AN LU ? JMP GTCMD,I FILE, SO JUST RETURN LDA FILE2 AN LU. JSB INTER SEE IF IT IS INTERACTIVE JMP GTCMD,I SO JUST RETURN * ISZ DFLAG IT IS SO SET THE INTERACTIVE BIT * STA FILE3 IT IS, SO MAKE IT THE LIST LU IOR M200 USE COLUMN 1 STA LISTU IOR M400 SET THE ECHO BIT STA FILE2 ON THE LU FOR THE PROMPT JMP GTCMD,I RETURN * * * * FOPEN JSB OPEN OPEN THE COMMAND FILE DEF *+7 DEF IDCB2 DATA CONTROL BLOCK DEF IERR2 ERROR FLAG DEF FILE2 FILE NAMR DEF IPTN2 OPEN OPTION DEF F2SC SECURITY CODE DEF F2DSC CARTRIDGE REF # * SSA,RSS ANY ERRORS ? JMP FREAD NO LDB F2 GET THE FILE NAME ADDRESS JMP FLERR YES * * * COMMAND FILE PROCESSOR * * LREAD LDA DFLAG (ALL LU READS RETURN HERE) GET THE FLAG SZA ARE WE INTERACTIVE ?? JSB PRMTR YES, SO OUTPUT LOADR PROMPT JSB REIO NOW READ THE INPUT DEF *+5 DO IT IN A REENTRANT FASHION SO THAT DEF P1 WE ARE SWAPABLE DEF FILE2 DEF STRNG DEF N80 SZB,RSS WAS THE READ OF ZERO LENGTH ? JMP END?? YES, END OF INPUT, GO DO ERROR CHECKING CMND STB SLONG SAVE READ LENGTH FOR PARSING ROUTINE CLA,INA SET UP PARSING OFFSET TO START PARSING STA ISTRC AT THE FIRST CHARACTER JSB NAMRR PARSE THE OPCODE LDB IPBUF+1 GET 3RD & 4TH CHAR STB OP1? LDB IPBUF AND SAVE THE OPCODE STB OP? S TEMPORARIALLY * * THESE COMMANDS MAY BE ENTERED ANY TIME * * CPB EN END OF COMMAND FILE ? JMP SECHK CPB /E END OF COMMAND FILE ? JMP SECHK CPB EX END OF COMMAND FILE ? JMP SECHK CPB LO MODIFY CURRENT LOAD POINT ? JMP SECHK CPB SE A SEARCH COMMAND ? JMP SECHK CPB FO A FORCE COMMAND ? JMP FORCE CPB RE A RELOCATE COMMAND ? JMP SECHK CPB DS DISPLAY UNDEFS ? JMP DSPLY CPB EC ECHO COMMANDS ? JMP SUPRS CPB LI LIBRARY FILE ? NOP JMP GTLIB CPB .A ABORT ? JMP ABORT CPB AB ABORT ? JMP ABORT CPB TR TRANSFER ? NOP JMP XEQTR CPB SL LIBRARY SEARCH ? NOP JMP SECHK LDA B AND M7400 CPA AS2RK JMP NXTOP * LDA DONE? GET THE MAIN LOADED FLAG SZA,RSS HAS THE MAIN BEEN LOADED ? JMP OVLY1 NO, GO TO OVERLAY AREA FOR REST OF COMNDS * PRERR LDA DFLAG GET THE INTERACTIVE FLAG ? SZA,RSS ARE WE IN THE INTERACTIVE MODE ? JMP DOERR GO DO THE INPUT ERROR THING JSB PRMTR YES, JSB EXEC SO GIVE HIM ANOTHER CHANCE DEF *+5 DEF P2 DEF FILE2 DEF PROMT+6 DEF P1 * JMP NXTOP GO GET THE NEXT INPUT * DOERR LDA CLEN GET THE READ LENGTH SZA IF NON ZERO ECHO IT JSB IECHO JMP LDI5 ELSE JUST ABORT THYSELF OP? NOP LAST OPCODE ISTRC DEC 1 POINTER TO CURRENT CHAR TO BE PARSED * * PROCESS THE COMMAND. * DSPLY LDA DFLAG GET THE CMND INTERACTIVE FLAG SZA,RSS IS IT INTERACTIVE ?? JMP DSPL1 NO LDB LISTU YES SO GET THE LIST LU STB QTEMP AND SAVE LDB FILE2 GET THE CMND LU STB LISTU AND USE IT AS THE LIST DEVICE LDB TYPE3 GET TYPE STB PTEMP AND SAVE CLB,INB STB TYPE3 JSB PUDF REPORT UNDEFS LDB QTEMP GET THE LIST LU BACK AGAIN STB LISTU AND RESTORE IT LDB PTEMP GET TYPE STB TYPE3 AND SAVE IT TOO JMP NXTOP GET NEXT COMMAND DSPL1 JSB PUDF REPORT UNDEFS JMP NXTOP GET THE NEXT COMMAND SUPRS CCA STA ECHO? NXTOP LDA TYPE2 GET THE TYPE OF INPUT ERA,SLA WHERE ARE WE READING FROM ? JMP FREAD A FILE JMP LREAD AN LU FORCE CCA SET THE FORCE STA FORCD FLAG. JMP NXTOP RELOC CLA,RSS NOW SET A FEW FLAGS SERCH CCA NOW SET A FEW FLAGS STA LIBFL IS A LIBRARY SEARCH * DOPRS CLA SET A FEW FLAGS STA SCSEG CLEAR SCAN TILL SEG ENCOUNTERED FLAG STA SLIBF NOT A SYS LIB SCAN STA LGOU NOT AN LG READ CMA STA NUPLS NO ROUTINES LOADED STA PLFLG NAM MUST BE FIRST JSB NAMRR PARSE TH INPUT SSA WAS THERE ANYTHING TO PARSE ? JMP SE?? NO SEE IF LAST ONE WAS A SE,< > LDA IPBUF GET THE 1ST PARSED WORD SZA IF = 0 OR CPA PROMT+4 = ASCII BLANK THEN JMP SE?? BETTER BE A SE,0, OR SE,, COMMAND * LDA N6 GET THE WORD COUNT JSB MOVE MOVE THE NAMR TO THE DCB AREA DEF IPBUF SOURCE DEF FILE1 DESTINATION LDA TYPE1 GET THE TYPE WORD AND P3 KEEP ONLY THE LEAST 2 BITS STA TYPE1 JMP DMANE NOW GO DO THE READ * DLOAD JSB NAMRR GO PARSE THE INPUT TO GET NEW LOAD ADDRESS LDA IPBUF+3 GET THE TYPE OF PARAMETER SLA RAR,SLA ONLY NUMERIC ALLOWED. NO ASCII. JMP PRERR SHAME ON YOU ! LDA PPREL GET THE CURRENT LOAD ADDRESS CMA,INA AND MAKE SURE THAT THE NEW LOAD NLH ADA IPBUF ADDRESS IS ABOVE THE OLD ONE SSA IS IT ? JMP PRERR NO, SEND AN ERROR LDB IPBUF GET THE ADDRESS AGAIN SSB IF NEGATIVE JMP PRERR ITS AN ERROR ALSO CLA OK, SO CLEAR THE UNUSED AREA JSB OUTAB OUTAB WILL CHECK TO SEE IF HE SET THE * CCA ADA TPREL RESET LOAD POINT STA PPREL JMP NXTOP LOAD POINT TOO HIGH. NOW GET NEXT CMND. * SE?? LDA OP? GET THE LAST OPCODE ENTERED CPA SE WAS IT AN ' SE ' ? RSS YES JMP PRERR NO, WAS AN RE, < > = AN ERROR * JMP *+1,I NOW GO SCAN DEF LOADN (SAVE A BP LINK TOO !) * END?? LDA EN FLIB NOP 0/-1 NOT/IS A LIBRARY FILE SCAN SVTP1 NOP OLD INPUT FILE TYPE WORD STA OP? SECHK LDB DONE? GET THE ERROR CHECKS DONE FLAG SZB,RSS HAVE WE DONE THE PARAMETER CONFLICT CHECK ? JMP CNFLT NO, SO DO IT (JMPS BACK TO OVERLAY AREA ) SECK1 LDA OP? GET THE OPCODE AGAIN * CPA FO WAS IT A FORCE ? JMP FORCE YES, SO DO THE FORCE LOAD CPA SE WAS IT A SEARCH ? JMP SERCH YES, SO SEARCH THE FILE N CPA RE WAS IT A RELOCATE ? JMP RELOC YES, SO RELOCATE THE FILE CPA LO WAS IT A CHANGE LOAD ADDRESS CMND ? JMP DLOAD YES, SO GO SET UP NEW LOAD ADDRESS CPA SL WAS IT A SEARCH LIBRARY COMMAND ? JMP SELIB THEN DO IT JSB CLOS2 MUST HAVE BEEN AN END. SO CLOSE JSB CLOS1 COMMAND AND INPUT FILES. AND JMP CLFL1 FINISH THE LOAD. * GTLIB JSB NAMRR PARSE FOR NEXT INPUT SSA ANY ERRORS ? JMP PRERR YES, NOTHING TO PARSE * LDA IPBUF+3 GET THE TYPE WORD AND P3 KEEP ONLY TYPE CPA P3 WAS THE INPUT ASCII ? RSS YES. SO ITS OK FOR NOW. JMP PRERR NO, LU'S ARE NOT LIBRARY FILES. * LDB LPNTR GET THE POINTER TO THE LAST LIB FILE CPB END TOO MANY LIB FILES ? JMP PRERR THATS AN ERROR TOO. STB NXTAD OK. SO MOVE NAME & SC & CART # TO BUFFER AREA * LDA N3 MOVE COUNT JSB MOVE DEF IPBUF SOURCE NXTAD NOP DESTINATION SET ABOVE * LDB LPNTR GET THE SOURCE ADDR ADB P3 ADD MOVE COUNT LDA IPBUF+4 GET THE SECURITY CODE STA B,I & STUFF IT INB BUMP POINTER LDA IPBUF+5 GET THE CART REF # STA B,I AND STUFF THAT TOO. INB STB LPNTR RESET THE POINTER ADDRESS FO NEXT LIB. JMP NXTOP GET THE NEXT COMMAND. * XEQTR JSB GTCMD CLOSE OUT OLD FILE & OPEN NEW. JSB BREAK CHECK IF ABORT DESIRED LDA TYPE2 GET THE TYPE WORD ERA,SLA FILE OR LU JMP FOPEN FILE JMP LREAD LU * SELIB JSB LIBSC SCAN THE LIBRARIES JMP NXTOP GO GET NEXT COMMAND * * * THE FOLLOWING ARE THE LEGAL COMMAND FILE COMMANDS * DS ASC 1,DI TR ASC 1,TR SL ASC 1,SL LI ASC 1,LI EC ASC 1,EC RE ASC 1,RE SE ASC 1,SE FO ASC 1,FO EN ASC 1,EN .A ASC 1,L/A AB ASC 1,AB /E ASC 1,/E EX ASC 1,EX LO ASC 1,LO AS2RK OCT 25000 AN * ECHO? NOP LPNTR DEF LIBRY POINTER TO LIBRARY NAME BUFFERS SPC 1 * * * IERR2 NOP ERROR FLAG FOR COMMAND FILE IPTN2 NOP OPEN OPTION * IERR3 NOP ERROR FLAG FOR LIST DEVICE IPTN3 DEC 1 OPEN OPTION (NON EXCLUSIVE !!!!!) * * IERR1 NOP READ ERROR FLAG IPTN1 NOP OPEN OPTION IDCBS DEC 256 * * SPC 1 * OPEN, READ, AND ECHO THE COMMAND. SPC 1 * FREAD JSB READF READ THE COMMAND FILE DEF *+6 DEF IDCB2 DEF IERR2 DEF STRNG DEF P40 DEF CLEN * LDA ECHO? ARE WE ECHOING COMMANDS ? SZA JSB IECHO YES, SO DO IT. * * * LDA IERR2 SSA,RSS ANY ERRORS ? JMP FLCHK NO LDB F2 JMP FLERR YES FLCHK LDB CLEN GET LENGTH OF COMMAND JUST READ SZB,RSS WAS IT ZERO ? JMP FREAD YES, SO DO IT AGAIN SSB WAS IT NEGATIVE (IE END OF FILE) JMP END?? YES, SO FINISH PROCESSING CLE,ELB CONVERT TO CHAR COUNT (MULT BY 2) JMP CMND GO DO COMMAND FILE PROCESSING * CLEN NOP RECORD READ LENGTH * * * P40 DEC 40 * ************************************************************************* * NON-OVERLAYABLE SUBROUTINES ************************************************************************* * THE NAMRR SUBROUTINE USES THE RELOCATABLE LIBRARY * PARSING ROUTINE NAMR. THE INPUT TO NAMR IS A STRING * OF ASCII CHARACTERS. * THE OUTPUT IS A 10 WORD BUFFER PARSED AS : * PRAM1,PRAM2,PRAM3,TYPE,S1,S2,S3,S4,S5,S6 * PARAMETERS BETWEEN COMMAS ARE PARSED. SUBPARAMETERS ARE * DELINEATED BY COLONS. THE TYPE WORD DESCRIBES ALL * PARAMETERS AS ASCII, NUMERIC, OR NULL. * THE TYPE WORD IS BROKEN UP INTO 2 BIT FIELDS TO DESCRIBE * THE INPUT. *15,14 13,12 11,10 9,8 7,6 5,4 3,2 1,0 *----------------------------------------------- * S6 ! S5 ! S4 ! S3 ! S2 ! S1 ! PRAM ! *----------------------------------------------- * * PRAM = 0 ...NULL PRAM1 = PRAM2 = PRAM3 = 0 * PRAM = 1....NUMERIC (ONLY PRAM1 USED) PRAM1 = # * PRAM = 2 ...NOT USED * PRAM = 3 ... ASCII (USES PRAM1,PRAM2,PRAM3 ) * * S1 - S6 ARE DEFINED THE SAME EXCEPT THEY ARE ONE WORD ONLY * NAMRR NOP JSB NAMR THIS IS THE RELO LIBR PARSING ROUTINE DEF *+5 RETURN ADDR DEF IPBUF ADDRESS OF 10 WORD PARSED BUFFER DEF STRNG ADDRESS OF BUFFER TO BE PARSED DEF SLONG CHARACTER LENGTH DEF ISTRC CHAR OFFSET IN STRNG FOR NEXT PRAM JMP NAMRR,I RETURN TO CALLER * * * THIS SUBROUTINE IS USED IF THE COMMAND FILE FOR * INPUT IS AN INTERACTIVE LU. IT OUTPUTS A LOADR * PROMPT WHICH IS /LOADR: * PRMTR NOP JSB EXEC DEF *+5 DEF P2 DEF FILE2 DEF PROMT DEF P6 JMP PRMTR,I PROMT ASC 6, /LOADR: _ ASC 1,?? * * * THE IECHO ROUTINE ECHOS COMMAND FILE COMMANDS AND ECHOS * ANY BAD COMMANDS ENCOUNTERED IN THE COMMAND FILE * IT ASSUMES THE WORD COUNT IN ' CLEN ' AND THE BUFFER * TO BE OUTPUT IN ' DSTRG '. * IECHO NOP LDA CLEN RAL WORD COUNT IS NOW CHAR COUNT LDB DSTRG GET THE BUFFER ADDRESS JSB DRKEY OUTPUT IT JMP IECHO,I RETURN TO CALLER * * * *THE FLERR ROUTINE HANDLES ALL FILE ERRORS. CALLING SEQUENCE: * * LDA WITH ERROR CODE (NEGATIVE) * LDB WITH ADDRESS OF FILE * JMP FLERR * * *THIS ROUTINE WILL CLOSE ALL FILES FLERR STB EFILE SAVE NAME OF FILE CMA,INA MAKE ERROR POSITIVE JSB CNV99 CONVERT TO ASCII STA EFBUF+4 PUT INTO ERROR MESSAGE LDA EFILE,I GET THE FILE NAME STA EFBUF+10 AND ISZ EFILE PUT LDA EFILE,I IT STA EFBUF+11 D INTO ISZ EFILE THE LDA EFILE,I ERROR STA EFBUF+12 MESSAGE . * LDA DFLAG GET INTEACTIVE FLAG SZA,RSS WE INTERACTIVE ? JMP PRNIT NO,JUST GO PRINT IT * LDA LISTU SAVE THE LIST LU STA QTEMP LDA FILE2 REPLACE WITH INTERACTIVE LU STA LISTU LDA TYPE3 SAVE TYPE STA PTEMP CLA,INA SET TYPE = LU STA TYPE3 * PRNIT LDA P26 GET THE CHAR COUNT LDB DEBUF AND THE ADDRESS JSB DRKEY NOW PRINT THE ERROR MESSAGE * LDA DFLAG GET THE INTERACTIVE CMND FILE WORD SZA,RSS ARE WE INTERACTIVE ? JMP LDI5 NO, DO THE REST OF THE ERROR THING * LDA QTEMP RESTORE LIST DEVICE STA LISTU LDA PTEMP STA TYPE3 AND TYPE OF LIST DEVICE WORD * JMP NXTOP GO GET NEXT COMMAND * * * EFILE NOP DSTRG DEF STRNG POINTER TO STRING BUFFER P26 DEC 26 * * *THE FCLOSE ROUTINE CLOSES ALL FILES OPEN TO THE *LOADR AND IGNORES ANY ERROR RETURNS. AFTER ALL WHAT ELSE *CAN YOU DO ?? * FCLOS NOP JSB CLOS1 JSB CLOS3 JSB CLOS2 JMP FCLOS,I * CLOS1 NOP LDA TYPE1 GET THE TYPE WORD FOR THE FILE CLB,CLE STB TYPE1 CLOSE OUT THE FILE TYPE WORD ERA,SLA IS IT A FILE ? RSS YES JMP CLOS1,I NO, LOOK AT THE NEXT ONE JSB CLOSE CLOSE THE FILE DEF *+2 DEF IDCB1 JMP CLOS1,I * CLOS2 NOP LDA TYPE2 CLB STB TYPE2 CLOSE OUT FILE TYPE WORD STB DFLAG AND INTERACTIVE LU WORD ERA,SLA IS IT A FILE RSS YES JMP CLOS2,I NO JSB CLOSE YES DEF *+2 DEF IDCB2 JMP CLOS2,I * CLOS3 NOP LDA TYPE3 ERA,SLA RSS JMP CLOS3,I JSB CLOSE DEF *+2 DEF IDCB3 * CLA,INuA SET UP THE STA TYPE3 NUMERIC FIELD IN THE TYPE WORD LDB TYPE2 GET THE CMND TYPE SZB,RSS IF NO COMMAND MODE JMP USEL1 USE LU 1 ERB,SLB IS IT A FILE OR AN LU ? JMP USEL1 A FILE * LDA FILE2 AN LU AND M77 KEEP ONLY LU BITS JSB INTER SEE IF IT IS INTERACTIVE RSS NOT INTERACTIVE JMP USEL2 IS INTERACTIVE USEL1 LDA MYLU# ITS NOT, SO USE START UP LU USEL2 STA LISTU AS THE LIST LU JMP CLOS3,I RETURN * * JMP CLOS3,I RETURN * DEBUF DEF EFBUF EFBUF ASC 13, FMGR -XX ON FILE * *THE INTER SUBROUTINE DETERMINES IF THE INPUT LU# IS AN *INTERACTIVE LU OR NOT. IN ADDITION, THE LU IS CHECKED TO SEE IF *IT IS IN RANGE. IF NOT IT IS ASSUMED TO BE AN INPUT ERROR AND THE *LOAD IS ABORTED. * * * CALLING SEQUENCE : LDA LU# * JSB INTER * * RETURN P+1 IF NOT INTERACTIVE * P+2 IF INTERACTIVE * INTER NOP SZA,RSS IF BIT BUCKET JMP INTER,I ITS NOT INTERACTIVE STA ANLU# SAVE THE LU # FOR RETURN SSA IF NEG, FLUSH HIM JMP LDI5 CMA MAKE NEG ADA P64 ADD IN CORRECT RANGE SSA JMP LDI5 JSB EXEC GET THE EQT INFO ON THE LU# DEF *+6 DEF P13 DEF ANLU# DEF QTEMP EQT WORD 5 PLACED HERE DEF PTEMP EQT WORD 4 PLACED HERE DEF RTEMP SUBCHANNEL IN LOWER 5 BITS HERE * LDA QTEMP GET EQT WORD 5 AND MEQT GET THE EQT TYPE SZA,RSS IF DVR00 THEN JMP BUMPR BUMP RETURN ADDRESS * CPA M2400 IF DVR05 THEN CHECK THE SUBCHANNEL RSS CPA M3400 IF DVR07 SUBCHANNEL = 0 RSS JMP NBUMP NOT INTER ACTIVE, SO RETURN LDA RTEMP GET THE SUBCHANNEL AND M37 KEEP ONLY SUBCHANNEL BITS SZA,RSS IF = 0, THEN ITS~W INTERACTIVE BUMPR ISZ INTER NBUMP LDA ANLU# JMP INTER,I * MEQT OCT 37400 ANLU# NOP M2400 OCT 2400 M3400 OCT 3400 * * * * THE BREAK ROUTINE CATCHES ANY PROGRAM BREAKS AND DOES * A CLEAN TERMINATION. * BREAK NOP JSB IFBRK DEF *+1 SSA ANY BREAK INPUT ? JMP ABORT YES , SO ABORT THYSELF JMP BREAK,I NO SO JUST RETURN * PTEMP NOP QTEMP NOP RTEMP NOP SKP * * HERE WE DECIDE WHERE THE INPUT IS TO BE READ FROM. THE NEW * INPUT COULD BE FROM LG, LU, OR A FILE. SPC 2 * DMANE LDA FILE1 GET THE READ LU OR FILE # LDB TYPE1 NO SO GET THE TYPE ERB,SLB IS IT A FILE OR AN LU ? JMP F1OPN A FILE. SO LETS OPEN IT. * JSB INTER AN LU SO CHECK IT OUT. IF P1=0, RSS JMP LDI5 IOR M300 SET THE BINARY AND V BITS STA PGMIN SET NEW INPUT LU IOR B400 SET EOT CONTROL WORD STA SEOT * JSB EXEC SET EOT ON INPUT UNIT DEF *+3 DEF P3 DEF SEOT * CLA SET FLAG FOR 'LG NOT BEING USED' STA LGOU * LDRIN LDA LGOU GET 'LG USE' FLAG SZA LG BEING USED FOR INPUT ? JMP LDRN2 YES, READ FROM LG AREA. LDA TYPE1 NO, SO GET THE READ TYPE WORD ERA,SLA IS THE READ FROM AN LU OR FILE JMP RREAD A FILE SO GO READ THE NEXT RECORD. * SKP * * LOAD FROM INPUT LU * JSB EXEC DEF *+5 DEF P1 1 = READ REQUEST DEF PGMIN PROG INPUT UNIT NO. DEF LBUF LBUF = INPUT BUFFER DEF P64 BUFFER LENGTH = 64 WORDS * AND M240 EOF OR EOT? SZA NO JMP RECLS SZB JMP TESTR JMP RECLS * * PGMIN OCT 305 SEOT OCT 705 B400 OCT 400 * * M240 OCT 240 * SPC 1 * OPENN NOP JSB OPEN OPEN THE FILE ! DEF *+8 DEF IDCB1 DCrLB DEF IERR1 ERROR FLAG DEFF1 DEF FILE1 ASCII FILE NAME DEF IPTN1 READ OPTION DEF F1SC SECURITY CODE DEF F1DSC CART REF # DEF IDCBS # OF BUFFER WORDS * SSA,RSS ANY ERROR IN THE READ ? JMP OPENN,I NO LDB F1 YES , GET THE FILE NAME JMP FLERR AND REPORT * * * * F1OPN JSB OPENN OPEN THE FILE FNXT1 CLA STA #SEGS CLEAR # OF SEGMENTS ENCOUNTERED FLAG STA #NAMS CLEAR # OF NAMS FOUND WHILE SCAN TILL SEG FLAG * SPC 1 RREAD JSB READF READ THE NEXR RECORD DEF *+6 DEF IDCB1 DEF IERR1 DEF LBUF RELOCATABLE RECORD BUFFER ! DEF P64 DEF LEN ACTUAL RECORD LENGTH READ * SPC 1 SSA,RSS ANY ERRORS ? JMP FNXT2 NO LDB F1 YES, GET THE FILE NAME JMP FLERR AND REPORT SPC 1 FNXT2 LDA LEN GET THE RECORD LENGTH READ SZA,RSS ZERO RECORD LENGTH ? JMP RREAD YES, SO TRY AGAIN SSA,RSS NO, WAS IT A NEG LENGTH ( -1 ) JMP TESTR NO, SO GO PROCESS RECORD ! * LDA FLIB THIS A FILE LIB SCAN (LI,XXXXX COMMAND) SZA,RSS WELL ? JMP NOLIB NO. * ISZ NUPLS YES, ANYTHING LOADED ? JMP DUMMY YES, SO DO IT AGAIN JMP LBRTN NO, SO GO CHECK OUT THE NEXT FILE. * SPC 1 NOLIB LDA RSCNX YES ! SZA WERE WE RESCANNING THE FILE ?? JMP NSCAN YES NOW GO RESET THE FILE BACK * LDA LIBFL IS THIS A LIBRARY SCAN ? ADA SCSEG AND NOT A SCAN TILL SEGMENT FOUND SZA,RSS WELL? JMP CK#SG NO, SEE IF ANY SEGMNETS IN THIS FILE LDA OP1? DID HE SAY SE, OR SEXXXX, ? CPA ASNUL WELL JMP RECLS SE, SO DON'T LOOK FOR BACKWARD REFS ISZ NUPLS YES, WAS ANYTHING LOADED ? JMP DUMMY YES, SO DO IT AGAIN (BACKWARD REF FIX) JMP RE0rCLS NO, SO GO CLOSE THE FILE * CK#SG LDA #SEGS GET THE # OF SEGMENTS IN THIS FILE SZA,RSS ANY ? JMP RECLS NO. * LDA #NAMS WERE THERE ANY NAMS AFTER THE SEGMENT ? CMA,INA,SZA JMP SCANW YES,SET A REG NEG * * RECLS JSB CLOS1 NO , EOF REACHED. CLOSE FILE * ISZ SKP.1 SKIP IF 1ST CMND NOT YET DONE RSS JMP SECK1 GO DO LAST COMMAND * LDA TYPE2 GET THE CMND FILE TYPE WORD. SZA IS THERE A CMND FILE ? JMP NXTOP YES, SO GO GET NEXT COMMAND * CLFL1 LDA P3 NO CNMD FILE & NO RELOC FILE. MUST BE LDB MSEG FINISHED WITH USER INPUT. SO IF SZB THE PROG IS SEGMENTED. SET LAST SEG STA MSEGF FLAG. JMP LOADX NOW GO FINISH THE LOAD. * * F1 DEF FILE1 POINTER TO RELOC FILE BUFFER LEN NOP LENGTH OF READ OF RELO FILE ASNUL ASC 1, A BLANK OP1? NOP 2ND WORD OF SEARCH COMMAND (SEXXCH) * * * ALL FORCE LOADS COME HERE TO CLEAN UP FIX UP TABLE * * FIXCL LDA MSEG GET THE SEGMENTED PROG FLAG SZA,RSS IS PROG SEGMENTED ? JMP NODEX NO, DON'T NEED TO CLEAN UP FIXUP TABLE. * JSB SILST SET TO SCAN THE SEGMENTS LDB TLST LST FIXC0 CPB PLST END? JMP NODEX YES GO FINISH * STB LST1 SET LST1 FOR FIXAL ADB P3 TO GET THE LDA B,I DEFINED FLAG AND P7 ISOLATE IT CPA P2 UNDEFINED? JMP FIXC1 YES GO DEFINE IT * FIXC2 ADB P2 NO INDEX TO THE NEXT ONE JMP FIXC0 AND GO LOOK AT IT * FIXC1 LDA M2000 SET TYPE TO 4 (IN HIGH BYTE) STA B,I DEFINE THE SYMBOL INB SET ITS VALUE CLA STA B,I TO ZERO JSB FIXAL GO DO ALL FIXUPS LDB LST4 RESTOR B JMP FIXC2 AND CONTINUE THE LOOP * ERR05 ASC 1,05 ERR10 ASC 1,10 P13 DEC 13 PLFLG FNOP LDI5 LDA ERR10 JMP ABOR * * * * * SYMBOL TABLE OVERFLOW * LOVER EQU * JSB CPRNM PRINT MODULE NAME(IF PRSENT) LDA ERR05 SET CODE EQUAL LST OVERFLOW ABOR JSB ERROR ABORT CLA CLEAR PROG NAME STA PRAM IN NAME PASSED BACK STA PRAM+1 THRU PRTN ROUTINE STA PRAM+2 LDA MERR GET THE ERROR CODE STA PRAM+3 PUT INTO TO ERROR CODE LDA MERR+1 AND THE # OF THE ERROR CODE STA PRAM+4 STUFF IT IN RETURN MESSAGE FOR FATHER LDA P13 LDB MES10 MES10 = ADDR "LOADR ABORTED" JMP *+1,I TERMINATE LOADER(AND THIS PROGMER) DEF LTERM (SAVE A BP LINK TOO ) * MES10 DEF *+1 ASC 7,LOADR ABORTED SKP * * INPUT FROM DISC LOAD-AND-GO AREA (SYSTEM LIBRARY SCAN ) * LDRN2 LDB XCUR IF CURRENT ADDR. OF XBUF = CPB XBUFA FWA OF XBUF, RSS READ NEXT SECTOR JMP LDRN4 DON'T BOTHER ITS IN CORE * LDRN3 LDB LGSEC CHECK CURRENT SECTOR #. CPB SECT2 IF CURRENT = LAST SECTOR, CLB,RSS SKIP JMP LDRN6 GO TO INPUT SECTOR. STB LGSEC RESET SECTOR # TO ZERO ISZ LGTRK ADD 1 TO TRACK # * READ NEXT SECTOR FROM LG AREA OR SYS LIB * LDRN6 JSB EXEC DEF *+7 DEF P1 DEF P2 DEF XBUF DEF P128 READ 2 LOGICAL SECTORS (1 PHYSICAL 7900) DEF LGTRK DEF LGSEC * ISZ LGSEC -ADD 2 FOR NEXT SECTOR. ISZ LGSEC LDA XBUFA SET STARTING BUFFER STA XCUR ADDR LDA N128 AND STA LGT1 COUNTER = -128. LDB LBOEF IS THE LIB ODD/EVEN SSB,RSS FLAG SET??? JMP LDRN4 -NO- CLA CLEAR THE STA LBOEF FLAG LDA N64 RESET COUNT FOR HALF SECTOR ONLY STA LGT1 CLA STA XCNT SET REC COUNT TO ZERO LDA XBHLF SET THE BUF ADDR STA XCUR 7TO THE ODD SECTOR * LDRN4 CLA IF CURRENT CPA XCNT REC COUNT = 0, RSS THEN SET FOR NEW REC. JMP LDRN5 CONTINUE WITH CURRENT REC. LDA XCUR,I GET NEXT ALF,ALF REC LENGTH (UPPER CHAR.), AND M77 SET NEGATIVE CMA,INA,SZA,RSS JMP LDRNE YES, READ NEXT SECTOR STA XCNT NO, SAVE COUNT FOR MOVE LDA ALBUF RESET ADDR OF STA LGT2 LBUF FOR MOVE. * LDRN5 LDA XCUR,I MOVE WORD FORM XBUF STA LGT2,I TO LBUF ISZ XCUR UPDATE BUFFER ISZ LGT2 ADDRES. ISZ XCNT INDEX NOP ISZ LGT1 COUNTERS. NOP CLA LDB XBUFA RESET ADDR OF CPA LGT1 'XBUF' IF STB XCUR END OF XBUF. CPA XCNT IF END OF REC, JMP TESTR GO TO PROCESS IT. CPA LGT1 IF END OF XBUF, JMP LDRN3 GO TO READ NEXT SECTOR. JMP LDRN5 CONTINUE WITH CURRENT REC. * N64 DEC -64 N128 DEC -128 P128 DEC 128 LDRNE LDA XBUFA WAS ZERO LENGTH REC AT CPA XCUR START OF A SECTOR? RSS JMP LDRN3 NO, READ NEW SECTOR. CCB YES, SUBTRACT 1 FROM CURR SECTOR ADB LGSEC IN CASE END OF LG ON ODD SECTOR JMP LDRN6 CHECK FOR END OF LG * SKP * * SUBROUTINES TO SAVE AND RESTORE DISC READ PARAMETERS. * * * * LGTRK NOP TRACK LGSEC NOP SECTOR LGS# NOP # SECS / TRK LGT1 NOP DOWN COUNTER IN XBUF LGT2 NOP CURRENT LBUF ADDR XCNT NOP REC LENGTH RIC NOP REC INDICATOR L7 OCT -7 XBHLF DEF XBUF+64 ADDR OF END OF XBUF XBUFA DEF XBUF DEFINE ADDR OF XBUF XCUR DEF XBUF * * SKP * * THE SCANX ROUTINE SAVES OUR LOCATION IN THE FILE AND * THEN REWINDS THE FILE TO THE BEGINING SO THAT THE FILE * MAY BE SCANNED FOR UNDEFS. THIS ALLOWS A SUBROUTINE TO * PLACED IN THE FILE ONLY ONCE, BUT TO HAVE IT APPENDED TO * ANY SEGMENT OR MAIN THAT CALLS IT. SCANX IS CALLED WHENEVER * A SEGMENT NAM IS ENCOUNTERED IN THE FILE. WHEN THE END OF * FILE IS ENCOUNTERED THE FILE MUST ALSO BE SCANNED (IE MAY BE * THE LAST SEGMENT IN THE PROGRAM) IN THIS CASE EOF IS REACHED * INSTEAD OF THE NEXT SEGMENT. THIS IS DETECTED BY THE FILE * READ ROUTINE. IF MORE THAN ONE NAM IS ENCOUNTERED AFTER AHEN * SEGMENT BUT BEFORE THE NEXT SEGMENT OR EOF THEN THE * CONTROL IS TRANSFERED TO SCANW (A REG IS NEG). THEN #SEGS IS * MADE NEG AS A FLAG SO THAT THE NSCAN ROUTINE WILL CLOSE THE * FILE INSTEAD OF GOING OF TO DO A SYSTEM LIBRARY SEARCH. * * SCANW STA #SEGS SET FLAG FOR EOF REACHED & RESCANNING FILE CLA STA SCSEG CLEAR SCAN TILL SEG FOUND FLAG. SCANX CCA SET THE RESCAN FLAG HERE.(NOT BELOW) STA RSCNX * LDA IREC GET THE RECORD # FROM PREVIOUS LOCF CALL CPA P2 IF REC # IS 2, THEN DON'T SCAN FILE JMP NOSCN IE FIRST RECORD IS SEGMENT NAM RECORD. * DUMMY JSB POSTX POST FILE (KLUGE FIX FOR A FMGR BUG !!!!!!) JSB APOSN NO SO REWIND FILE DEF *+6 DEF IDCB1 DEF IERR1 DEF P1 DEF ANOP DEF ANOP * SSA,RSS ANY ERRORS ? JMP SCFLG NO, SO GO SET THE FLAGS DORWN LDB F1 YES JMP FLERR SO REPORT THE ERROR * SCFLG CLA NOW SET A FEW FLAGS STA SLIBF NOT SYS LIB STA LGOU NOT LG AREA CMA STA LIBFL IS A SCAN OF LIBRARY STA NUPLS NO ROUTINES LOADED STA PLFLG NAM MUST BE FIRST JMP RREAD NOW GO SCAN THE FILE * ANOP NOP * * * THE NSCAN ROUTINE SETS THE FILE BACK TO THE ORGINAL * LOCATION BEFORE THE SCANX ROUTINE REWOUND IT. * * NSCAN ISZ NUPLS ANYTHING LOADED LAST SCAN ?? JMP DUMMY SO DO IT AGAIN * JSB APOSN SET THE FILE BACK UP DEF *+6 :e DEF IDCB1 DEF IERR1 DEF IREC DEF IRB DEF IOFF * SSA ANY ERRORS ? JMP DORWN YES NOSCN CLA WE NEED TO RESET A FEW FLAGS STA LIBFL NOT A LIBRARY SCAN STA RSCNX NO LONGER RESCANNING THE FILE * LDB #SEGS GET THE # OF SEGS LOADED FLAG SSB,RSS WAS THE RESCAN DUE TO EOF OR NEW SEGMENT JMP LOADX NEW SEGMENT. SCAN SYS LIB FOR OLD SEG JMP RECLS EOF. SO GO CLOSE THE FILE . * POSTX NOP JSB POST DEF *+3 POST THE FILE TO CLEAR ALL OF CORE BIT IN FMGR DEF IDCB1 ALSO FIXES A FMGR BUG ! DEF IERR1 * SSA,RSS ANY ERRORS ? JMP POSTX,I NO * LDB F1 YES JMP FLERR GO REPORT * * IREC NOP IRB NOP RSCNX NOP 0/-1 NO RESCAN/ RESCAN OF FILE IN PROGRESS IOFF NOP LGOU NOP LG (SYS LIBRARY) IN USE FLAG #SEGS NOP #OF SEGMENTS IN THIS FILE FLAG * SKP * TEST FOR VALID REC * TESTR LDA LBUF+1 GET REC IDENTIFIER ALF,RAR AND M7 ISOLATE RIC STA RIC SAVE REC ID CODE SZA SKIP - ABSOLUTE REC ADA L7 SUBTRACT 6B SSA,RSS SKIP - VALID REC TYPE JMP RCERR INVALID REC TYPE * TEST FOR VALID CHECKSUM LDA LBUF GET REC LENGTH AND M7400 AND ZERO LOWER CHARACTER, STA B BLF,BLF ROTATE TO LOW B CMB,INB COMPLEMENT ADB P3 ADJUST FOR ADDR OF WORD 4 SSB,RSS SKIP - VALID REC LENGTH JMP RCERR INVALID (SHORT) REC STB WDCNT SET WORD COUNT FOR CHECKSUM LDA LBUF+1 GET WORD 2 - INITIALIZE CHECKSUM LDB ALBUF GET ADDR OF LBUF ADB P3 ADJUST ADDR FOR WORD 3 TEST1 ADA B,I ADD WORD TO CHECKSUM INB INCR CURRENT LBUF ADDR ISZ WDCNT SK9NLHIP - END OF REC JMP TEST1 CONTINUE CHECKSUM TEST CPA LBUF+2 EQUAL TO GIVEN CHECKSUM? JMP LDRC YES - PROCESS REC * * CHECKSUM ERROR. PRINT MODULE NAME * (MODULE NAME WILL BE IN MBUF IF A NAM REC * HAS ALREADY BEEN READ. OTHERWISE, IT WILL NOT * BE PRINTED SINCE IT MAY BE GARBAGED IN THE * THE NAM RECORD ITSELF. * JSB CPRNM PRINT NAME IF ANY LDA ERR01 CODE 01 = CHECKSUM ERROR LSUSP JSB ERROR PRINT DIAGNOSTIC ON SYSTEM TTY JMP ABORT GO ABORT THYSELF * ERR01 ASC 1,01 ERR02 ASC 1,02 * * * ILLEGAL RECORD TYPE * RCERR EQU * JSB CPRNM PRINT MODULE NAME,IF GOOD LDA ERR02 CODE 02 = ILLEGAL REC JMP LSUSP * * PRINT NAME OF MODULE(OR ENTRY POINT) * * CALLING SEQUENCE: * JSB PRNAM * DEF TO NAME TO BE PRINTED * * PRNAM NOP PRINT 5 CHARACTERS LDA P5 LDB PRNAM,I GET NAME ADDR ISZ PRNAM BUMP FOR RETURN JSB SYOUT PRINT MESSAGE JMP PRNAM,I RETURN * * CHECK IF GOOD REC HAS BEEN READ BEFORE * PRINT NAME. * CPRNM NOP LDA MBUF GET "VALID NAME" FLAG SZA,RSS NAME READ? ZN JMP CPRNM,I NO, EXIT JSB PRNAM PRINT NAME DEF MBUF JMP CPRNM,I EXIT * * CLASSIFY RECS BY TYPE LDRC LDA RIC GET REC IDENTIFICATION CODE LDB PLFLG GET LOADING FLAG CPA P1 TYPE = NAM ? JMP NAMRX YES - PROCESS NAM REC SZB SKIP - NOT LOADING JMP NMERR REC OUT OF SEQUENCE CPA P2 TYPE = ENT? JMP ENTR YES - PROCESS ENT REC CPA P3 TYPE = DBL? JMP DBLR YES - PROCESS REC CPA P4 TYPE = EXT? JMP EXTR YES - PROCESS EXT REC CPA P6 TYPE = EMA? JMP EMARC YES - PROCESS EMA RECORD * * * MUST BE AN END RECORD. SKP * * *** PROCESS END RECORD *** * * * JSB BREAK SEE IF WE SHOULD BREAK LDA IGNOR SZA,RSS LATEST SUBROUTINE LOADED ? JMP RESET YES, PROCESS AS NORMAL. * LDA BID3 NO, THEN RESTORE CURRENT STA CWABP FW AVAILABLE ON BASE PAGE. LDA BID4 AND END OF LST. STA PLST JMP NOCLR SKIP CLEARING OF BIT15 IN LST1 * * TEST FOR OVERFLOW OF COMMON * RESET LDA MCOMX GET COMMON LENGTH OF LAST MODULE CMA,INA SUBTRACT FROM INITIAL SET LENGTH ADA MXCOM SSA,RSS IF SAME OR LESS JMP NOCLR THEN OK * * COMMON ALLOCATION ERROR * CMERR JSB CPRNM PRINT MODULE NAME LDA ERR06 ELSE ERROR 06 - COMMON BLOCK JMP ABOR ERROR. ERR06 ASC 1,06 MCOMX NOP LEN OF LAST MODULE SCANNED/LOADED * NOCLR LDA XBUFA RESET ADDR OF CPA XCUR IF ALREADY SET JMP NOUSE THEN NO USE CHECKING FURTHER LDB XBHLF GET THE ODD SEC BOUNDARY CMB,INB ADB XCUR IS CURRENT IN EVEN OR ODD SZB IF ZERO THEN IN LOWER HALF SSB LDA XBHLF SET FOR ODD SECTOR STA XCURB LGO BUFFER ON END REC. LDB N128 SET DOWN COUNTER TO PROPER VALUE CPA XBHLF LDB N64 STB LGT1 NOUSE CLA SET REC INDEX STA XCNT = 0 TO GET SECTOR. LDA ALBUF GET ADDR OF LBUF ADA P3 ADJUST FOR WORD 3 OF END REC STA CURAL SET CURRENT LBUF ADDR LDA LBUF+1 GET PRIMARY ENTRY POINT FLAG SLA,RSS SKIP - HAS PRIMARY ENTRY POINT JMP NOPRE OMIT PROCESSING NO ENTRY POINT SKP * * * PRINT MEMORY MAP ENDKY LDA PRENT,I GET PRIMARY ENTRY POINT. SZA SKIP - PRENT NOT SET JMP ENDK1 TEST FOR DEBUG LOADED LDA LBUF+3 GET WORD 3 OF END REC ADA PPREL ADD PROG RELOC BASE STA PRENT,I SET IN ID SEGMENT LDA MBUF GET PROG NAME 1,2 STA NAM12,I SET IN ID SEGMENT LDA MBUF+1 GET PROG NAME 3,4 STA NAM34,I SET IN ID SEGMENT LDA MBUF+2 GET PROG NAME 5 AND M7400 ISOLATE UPPER CHAR * LDB MSEG NOW GET THE SEGMENT LOAD FLAG ERB,ERB TO E. LDB PTYPE GET THE PROG TYPE SEZ THIS A SEGMENT OR MAIN ? LDB M25 SEGMENT, SO SET TYPE & SEG BIT. IOR B * STA NAM5,I AND SET IN ID SEGMENT. AND P7 ISOLATE PROG TYPE CPA P5 IF PROCESSING SEGMENT JMP IDSN0 THEN FORGET REMAINING PARMS LDA NPAR STORE PRIORITY SZA FROM NAME REC STA PRIOR,I IF NON-ZERO. LDA NPAR+1 IF RESOLUTION SZA,RSS CODE = 0, SKIP SETTING OTHER JMP IDSN0 TIME PARAMETERS. AND P7 PUT ALF,ALF RESOLUTION ALF,RAL CODE (3 BITS) STA B IN 15-13 LDA NPAR+2 AND AND M7770 EXECUTION MULTIPLE IOR B IN 11-00 STA RESL,I LDA NPAR+5 GET SECONDS MPY P100 SCALE TO TMS  ADA NPAR+6 TMS+SCALED SECONDS STA NPAR+5 SAVE LDA NPAR+3 GET HOURS MPY P60 SCALE TO MINUTES ADA NPAR+4 ADD MINUTES MPY P6K SCALE TO TMS CLE SET FOR DOUBLE ADD ADA NPAR+5 TMS+SCALED SECONDS SEZ WAS THERE A CARRY ? INB YES, BUMP (B) SET01 CLE,SSB JMP SET02 ADA NDAY+1 SEZ,CLE INB ADB NDAY JMP SET01 SET02 DST TMDY1,I SAVE FOR ID SEG * SKP * TEST FOR DUPLICATE PROG NAMES IDSN0 CCA STA NMFLG SET PROG NAME FLAG IDSN JSB MIDN FIND THE ID IF ONE JMP NOPRE NONE SO OK LDA P2 IF OPERATION IS REPLACEMENT CPA EDFLG EDITING, IGNORE DUPLICATE, JMP NOPRE AND CONTINUE. * LDA MBUF GET THE NAME STA MESS7+12 AND PUT IN DUPLICATE PROG LDA MBUF+1 NAME MESSAGE BUFFER STA MESS7+13 LDA MBUF+2 STA MESS7+14 LDA P27 LDB MESS7 MESS7 = ADDR: DUPLICATE PROG NAM JSB SYOUT PRINT: DUPL. PROG NAME ISZ NMFLG SKIP - TRY RESETTING PROG NAM JMP ABORT INVALID RESET PROG NAME LDA RENAM GET ASCII '##' STA MBUF SET PROG NAME 1,2 = '..' STA NAM12,I IN BOTH COPIES. JMP IDSN REPEAT DUPLICATE PROG NAME SCAN SPC 1 P27 DEC 27 M25 OCT 25 M7770 OCT 7777 NPAR BSS 7 NAME RECORD PARAMETERS RENAM ASC 1,.. MESS7 DEF *+1 ASC 14,DUPLICATE PROG NAME - * SPC 1 ENDK1 JSB DEBUG TEST FOR DEBUG LOADED NOPRE CCA STA PLFLG SET 'LOOK FOR NAM' FLAG LDA IGNOR SZA,RSS IF LAST SCAN USEFUL JSB MAPPR THEN PRINT MEM MAP & UPDAT BASE * JSB INLST INITIALIZE LSTX LDB TLST CPORD CPB PLST END OF LST ? JMP SLTST YES - SET UP NEXT OPERATION ADB P2 CLEAR POSSIBLE ORDINAL LDA B,I FROM LST 3. AND M7400 STA B,I ADB P3 JMP CPORD CONTINUE CLEARING PROG ORDINALS SPC 1 * SLTST CLA CLEAR "VALID NAME" FLAG STA MBUF LDA SLIBF GET DISC LIB LOAD FLAG SZA LOADING SYSTEM LIB ? JMP RSET? YES, CHECK ON NEXT OPERATION. * * LDA MSEG IS THIS A SEGMENTED PROGRAM ? CPA P2 WELL ? RSS YES JMP LDRIN NO,GET NEXT RECORD * LDA PROGT THIS MODULE A SEGMENT ? CPA P5 WELL ? RSS YES JMP LDRIN NO, GO GET THE NEXT RECORD. * LDA LIBFL WE, SCANNING AT THE MOMENT ? SZA WELL ? JMP LDRIN NO, GET THE NEXT MODULE * CCA SET THE LIBRARY SCAN FLAG STA LIBFL CLA,INA SET THE SCAN TILL NEXT SEGMENT FLAG STA SCSEG JMP LDRIN GO GET THE NEXT SEGMENT * * NMFLG NOP PROG NAME FLAG COMIN NOP COMMON DECLARATION FLAG MESS9 DEF COM ACOM3 DEF COM+3 ACOM6 DEF COM+6 COM ASC 9,COM SEGM NOP SKP * * * PROCESS EMA RECORD. * * EMARC LDA LIBFL GET THE LIB SCAN FLAG SZA WE SCANNING ? JMP LDRIN YES SO IGNOR THE WHOLE THING * LDA EMABP ANY PREVIOUS DECELERATION ? SZA WELL ? JMP LL19 YES, ITS AN ERROR * * *E LDB ALBUF GET THE RECORD BUFFER ADDRESS INB INDEX TO EMA WORD LDA B,I & PULL IT IN AND B1777 KEEP ONLY EMA SIZE STA EMASZ * ADB P2 NOW GET THE SYMBOL NAME LDA B,I CHARS 1 & 2 STA TBUF * INB CHARS 3 & 4 LDA B,I STA TBUF+1 * INB CHAR 5 & ORDINAL # LDA B,I STA TBUF+2 * INB & MSEG SIZE LDA B,I AND M37 STA MSGSZ * JSB LSCAN SEE IF THIS ÓSYMBOL PREVIOUSLY REFERENCED RSS JMP LL19 AN ERROR LDA MSEG IS THIS A SEGMENT ? CPA P2 WELL ? JMP LL19 THATS AN ERROR ALSO * LDA TBUF NOW PUT THE LABEL IN THE SYMBOL TABLE STA LST1,I LDA TBUF+1 STA LST2,I LDA TBUF+2 STA LST3,I * LDA TLST UPDATE END OF SYMBOL TABLE STA PLST * LDA B200 NOW SET SYM TABLE V BIT ADA P3 SET SYMBOL AS EMA TYPE(DEFINED) STA LST4,I & PUT IN SYMBOL TABLE * JSB ALLOC GET A BP LINK STA LST5,I & PUT ABS ADDRESS IN TABLE STB EMABP SAVE DUMMY ADDRESS LOCALLY * LDB #PGS *E SZB ANY SPECIFIED SIZE GIVEN? JMP NOPG1 YES, CHECK AGAINST 32K MAX * LDA MSGSZ GET THE MSEG SIZE INA ACCOUNT FOR I/O OVERFLOW CPA P1 IF JUST 1 INA THEN SET MIN MSEG SIZE ALF,ALF NOW ADJUST TO # OF PAGES RAL,RAL CMA,INA & SET NEW UPPER BOUNDS FOR CODE ADA B7777 SPACE STA LWA JMP NOPG *E * NOPG1 LDA URFWA GET LOAD PT IN # PGS ALF *E RAL,RAL CONVERT TO # PAGES ADA B ADD # OF PAGES SPECIFIED LDB MSGSZ *E INB ACCOUNT FOR I/O OVERFLOW PAGE CPB P1 DEFAULTED EMA? INB YES, BUMP FOR MINIMUM SIZE ADA B (A) = # PAGES REQUIRED CMA,INA WITH EXTRA BP INA TAKE OUT EXTRA BP ADA D32 SUBTRACT FROM 32K LOGICAL SSA EXCEEDED 32K? JMP ER.18 YES. * NOPG JSB BLKID GO COUNT ID SEGS LDA BID9 SEE IF THERE ARE ANY SZA,RSS ID EXTENSIONS JMP LL20 IF NOT ABORT THYSELF JMP LDRIN GET THE NEXT RECORD * LL19 LDA ERR19 JMP ABOR ER.18 LDA ERR18 JMP ABOR ERR18 ASC 1,18 LL20. JSB $LIBX RETURN FROM PRIV PROCESSING DEF *+1 DEF *+1 LL20 LDA ERR20 JMP ABOR ERR19 ASC 1,19 ERR20 ASC 1,20 EMABP NOP MSGSZ NOP EMASZ NOP B7777 OCT 77777 * * * * MAPPR NOP LDB PLGTH GET LEN WORD SZB IF ZERO OR SSB COMPILER PRODUCED JMP MAPP1 FORGET THE BSS FILL * ADB N1 ELSE SET TO RELATIVE ADDR OF ADB PPREL GET REAL CORE ADDR STB A INA CPA TPREL WAS IT LOADED? JMP MAPP1 YES SKIP THE FILL * CLA NO FILL THE BSS WITH ZERO'S JSB OUTAB OUTPUT FILL WORDS MAPP1 JSB PRMAP PRINT MEM MAP & UPDATE BASES JMP MAPPR,I RETURN * * * * WHEN LOADING AND A TYPE 5 NAM IS ENCOUNTERED * THEN CONTROL TRANSFERS HERE. ALL RELOCATABLE READ * POINTERS ARE SAVED AND THE SYSTEM LIBRARY IS SCANNED * FOR THE LAST MAIN OR SEGMENT. * * SEOF LDA MSEG GET THE SEGMENT LOADING FLAG SZA,RSS IS IT SET ? ISZ MSEG NO, SO SET IT. CLA RESET THE SCAN TILL SEGMENT FLAG STA SCSEG LDB SEGM GET THE SEGMENT BASE ADDRESS CPB PPREL IF SAME AS CURRENT SEGMENT THEN JMP NAMR1 LAST SEGMENT LOADED. THIS IS NEW ONE * * ISZ #SEGS INCREMENT THE # OF SEGMENTS ENCOUNTERED FLAG LDA N60 GET NEG COUNT JSB MOVE DEF LBUF SOURCE OF MOVE DEF SGNAM DESTINATION (SEGMENT NAM BUFFER) * LDA TYPE1 GET THE INPUT TYPE WORD ERA,SLA WHERE IS THE INPUT FROM ? RSS A FILE JMP LOADX SO FOR GET ABOUT ANY RESCAN * JSB LOCF OK SO SAVE OUR POSITION IN THE FILE DEF *+6 DEF IDCB1 DEF IERR1 DEF IREC RECORD # IN FILE USED IN JUST A SECOND DEF IRB DEF IOFF * SSA,RSS ANY ERRORS ? JMP *+3 NO * LDB F1 GET THE FILE NAMEY JMP FLERR AND REPORT * LDA RSCAN GET THE RESCAN FLAG SZA,RSS RESCAN THIS FILE BEFORE SYS LIB SEARCH ? JMP SCANX YES ! * CCA NO, SET A FLAG TO ALLOW THE RESCAN STA RRSCN ON UNDEFS ! (20% FASTER ON THIS PATH) JMP LOADX * * RRSCN NOP 0/-1 NO FILE RESCAN/ALLOW RESCAN ON UNDEFS RSCAN NOP 0/1 NO/YES VARY SYS LIB SCAN SEQUENCE SCSEG NOP 0/1 NO/YES SCAN TILL SEGMENT FOUND #NAMS NOP # OF NAMS FOUND WHILE SCAN FOR NEXT SEG. * * * SKP * PROCESS NAM REC NAMRX SZB,RSS SKIP - VALID REC SEQUENCE JMP NMERR REC OUT OF SEQUENCE LDA FWABP GET DUMMY BP BASE CMA,INA AND SUBTRACT FROM ADA CWABP CURRENT DUMMY BP LOCATION. ADA BPFWA ADD OFFSET TO REAL BP BASE STA BPREL AND SET AS NEW BP REL BASE CLA SET UP FLAG TO 'NOT IGNORE' STA IGNOR LDA LBUF+9 GET PGM TYPE STA PROGT AND SAVE IT. LDA LIBFL IF SCANNING TILL NEXT SEG,THEN ADA SCSEG LOOK AT THE SEG ELS IF JUST SZA SCANNING LIB JMP NAMR1 THEN AVOID SEGMENT LOOKUP. LDB LBUF+9 GET THE NAM TYPE CPB P5 IF SEGMENT JMP SEOF SEE IF THIS FIRST ONE & SAVE NAM BUFFER SPC 1 * NAMR1 LDA SCSEG IS THIS A SCAN TILL SEG FOUND OPERATION ? SZA WELL ? ISZ #NAMS YES, SO COUNT THE NAMS LDA LBUF+8 GET COMMON LENGTH STA MCOMX SET COMMON LENGTH SZA,RSS SKIP - HAS COMMON JMP COMOK NO COMMON, TEST B.P. LENGTH LDB LIBFL IF THIS IS A LIBRARY SCAN SZB THEN CHECK COMMON ALLOC AT THE END REC JMP COMOK ISZ COMIN YES, HAS COMMON. SKIP IF FIRST & LOCAL. JMP COMOK ASSUME COMMON OK TILL 'END' IS READ * LDB URFWA GET THE BAaSE LOAD ADDRESS ADB P2 ACCOUNT FOR THE X&Y REGISTERS CPB TPREL COMPARE TO HIGH MAIN RSS = , SO COMMON DECLRATION OK JMP CMERR COMMON ERROR STA MXCOM FIRST COMMON, SET MAX LENGTH LDA FWA ADJUST RELOCATION BASES SPC 1 ADA P2 2 WORDS FOR X-Y REG SAVE SPC 1 STA COMAD SET FWA OF COMMON (LOCAL) LDB ACOM3 GET ADDR OF COMMON MSG (LOW) JSB CONVD CONVERT LOWER COMMON BOUND LDA COMAD ADA MXCOM COMPUTE COMMON UPPER BOUND + 1 SPC 1 SPC 1 STA PPREL SET AS LOW PROG BOUND ADA N1 ACTUAL LWA COMMON LDB ACOM6 GET ADDR OF COMMON MSG (HI) JSB CONVD CONVERT UPPER COMMON BOUND LDA PLIST GET LIST/NO LIST FLAG SLA SKIP TO LIST MEMORY BOUNDS JMP NAMR2 OMIT LISTING, TEST COM BOUNDS. LDA P18 LDB MESS9 ADDR OF COMM BUF JSB DRKEY LIST COMMON BOUNDS NAMR2 LDA LWA CMA,INA COMPUTE LENGTH LEFT OVER AFTER ADA PPREL COMMON ALLOCATION. SSA SKIP IF INVALID COMMON LENGTH JMP COMOK COMMON DECLARATION IS OK * * MEMORY OVERFLOW ERROR * LGERR JSB CPRNM PRINT MODULE NAME LDA ERR03 03 = MEMORY OVERFLOW JMP ABOR ERR03 ASC 1,03 ERR09 ASC 1,09 * * RECORD OUT OF SEQUENCE * NMERR JSB CPRNM PRINT MODULE NAME(IF ANY) LDA ERR09 09 = REC OUT OF SEQUENCE JMP LSUSP SYMAD BSS 1 ADDR OF SYMBOL RELOCATION MXCOM NOP MAX COMMON LENGTH * * COMOK CLA SET UP FLAG TO STA PLFLG "NAM HAS BEEN READ" JSB SEMAP SET PROG NAME IN MEM MAP LDA PLST SAVE STA BID4 END OF LST ADDR LDA CWABP NEXT AVAILABLE WORD ADDR ON BP STA BID3 CCA LDB LIBFL GET THE LIB SCAN FLAG SZB WE SCANNING ? STA IGNOR YES, SET FLAG "TOP IGNORE" PGOCK LDA LBUF+7 GET BP LENGTH SZA,RSS ANY BP RELOCATION ? JMP LDRIN NO, THEN GET NEXT REC. CMA,INA SET NEGATIVE LENGTH OF STA ABT1 BASE PAGE AREA NEEDED. BPCLR JSB ALLOC MOVE CWABP BY SAME ISZ ABT1 ZEROED AND MOVED ALL ? JMP BPCLR NO, THEN DO MORE. JMP LDRIN GET NEXT REC * PROGT NOP PROG TYPE BEING SCANNED P100 DEC 100 P60 DEC 60 P6K DEC 6000 M37 OCT 37 SKP * * THE INLST AND LSTX SUBROUTINES SET THE ADDRES FOR THE CURRENT * ENTRY IN THE LOADER SYMBOL TABLE (LST). * * INITIALIZE LSTX * * INLST SETS THE ADDRESS OF THE FIRST ENTRY IN LST IN TLST. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB INLST * * RETURN: CONTENTS OF A AND B ARE DESTROYED. * INLST NOP LDA BLST GET STARTING ADDR OF LST STA TLST SET CURRENT LST ADDR JMP INLST,I RETURN * * SPECIAL ROUTINE "SILST" * * THIS ROUTINE INITIALIZES THE LST FOR THE * BACKGROUND SEGMENT AREA ONLY, IF MAIN/SEGMENT * LOADING IS BEING DONE. IT USES THE CONTENTS * OF "SLST" - SLST IS INITIALIZED TO BE = TO * "BLST" BUT IS CHANGED AFTER THE "MAIN" PROG * IS LOADED TO BE THE ADDR OF THE ENTRY * FOLLOWING THE LAST ENTRY FOR THE MAIN. * * SAME CALLING SEQUENCE AS FOR "INLST". * SILST NOP LDA SLST SET SEGMENT LST ADDR STA TLST AS CURRENT ADDR. JMP SILST,I * * THIS ROUTINE INITIALIZES START OF LST TO BEGIN JUST * AFTER THE END OF RESIDENT LIB LST (START OF THE LST * BUILT FROM USER'S PROG) * FNLST NOP LDA FLST STA TLST JMP FNLST,I * * * SET CURRENT LST ADDRES * * THE LSTX SUBROUTINE SETS THE CURRENT LST ADDRES FROM TLST. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB LSTX * * RETURN: CONTENTS OF A AND B ARE DESTROYED. * LSTX NOP LDA TLST > GET CURRENT LST ADDR CPA PLST END OF LST? RSS YES - CONTINUE ISZ LSTX NO - INCR RETURN ADDR STA LST1 SET WORD 1 ADDR INA STA LST2 SET WORD 2 ADDR INA STA LST3 SET WORD 3 ADDR INA STA LST4 SET WORD 4 ADDR INA STA LST5 SET WORD 5 ADDR INA STA TLST SET NEXT LST ADDR CMA,INA ADA TFIX ADD FWA OF DUMMY ID SEGMENT AREA SSA,RSS IF RESULT = 0 OR <0, SZA,RSS THEN ERROR JMP LOVER OVERFLOW. JMP LSTX,I -OK, RETURN. * * * * SCAN TO SEE IF ANY UNDEFINED * (REGS MEANINGLESS ON ENTRY AND RETURN) * JSB LSTX1 * (P+1) RETURN - NO UNDEFINED * (P+2) RETURN - UNDEFINED EXIST * LSTX1 NOP JSB FNLST START LST FROM USER MAIN LDA MSEG BUT IF CPA P2 LOADING A SEGMENT JSB SILST THEN START FRM SEGMENT'S LST. LDB TLST GET CURRENT LST ADDR LSTX2 CPB PLST END OF LST ? JMP LSTX1,I YES - RETURN (P+1) ADB P3 LDA B,I GET LST4 AND P7 MASK IN STATUS CPA P2 UNDEF EXT ? JMP YEXT YES ADB P2 POINT TO NEXT SYMBOL JMP LSTX2 SEE NEXT SYMBOL YEXT ISZ LSTX1 UNDEF FOUND - BUMP RETURN ADDR JMP LSTX1,I RETURN (P+2) SKP * * READ DISK REC TO DBUF * * THE DREAD SUBROUTINE READS A DISK REC (1 SECTOR) TO DBUF. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB DREAD * RETURN: CONTENTS OF A AND B ARE DESTROYED. * DREAD NOP JSB EXEC REQUEST DISK READ DEF *+7 DEF P1 READ REQUEST CODE DEF DSKUN DISK LOGICAL UNIT NO. ADBUF DEF DBUF ADDR OF DISK I/O BUFFER DEF P128 NO. WORDS DEF DTRAK DISK TRACK DEF DSECT DISK SECTOR JMP DREAD,I RETURN SPC 2 *  * WRITE DBUF TO DISK * * THE DWRIT SUBROUTINE WRITES THE CURRENT REC ON THE DISK. * THE ADDRESS OF THE REC IS CONTAINED IN DISKO * AND THE LENGTH OF THE REC IN DLGTH. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB DWRIT * * RETURN: CONTENTS OF A AND B ARE DESTROYED. * DWRIT NOP JSB EXEC REQUEST DISK WRITE DEF *+7 DEF P2 WRITE REQUEST CODE DEF DSKUN DISK LOGICAL UNIT NO. DEF DBUF ADDR OF OUTPUT BUFFER DEF P128 BUFFER LENGTH DEF DTRAK DISK TRACK DEF DSECT DISK SECTOR JMP DWRIT,I RETURN * * * * * TEST AND SET FOR DEBUG CONTROL * * DEBUG TESTS IF THE CURRENT PROG LOADED WAS DEBUG. IF IT WAS, * THE PRIMARY ENTRY POINT OF THE PROG IS SET INTO * 'DEBUG', THE PRIMARY ENTRY POINT OF DEBUG IS SET INTO THE * ID SEGMENT, AND THE ADDR OF DEBUG IS SET TO BE INDIRECT. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB DEBUG * * RETURN: CONTENTS OF A AND B ARE DESTROYED,. * DEBUG NOP LDA DBFLG IS DEBUG ALLOWED ? SZA,RSS WELL ? JMP DEBUG,I NO, SO FORGET IT * LDA IGNOR YES SO SEE IF THIS MODULE IS DEBUG SZA IF LAST SCAN WAS USELESS JMP DEBUG,I THEN DON'T LOOK FOR MATCH LDA MBUF GET PROG NAME 1,2 CPA DB1 CHARS = D,B? RSS YES - CONTINUE JMP DEBUG,I RETURN - PROG IS NOT 'DEBUG' LDA MBUF+1 GET PROG NAME 3,4 CPA DB2 CHARS = U,G? RSS YES - CONTINUE JMP DEBUG,I RETURN - PROG IS NOT 'DEBUG' LDA MBUF+2 GET PROG NAME 5 AND M7400 ISOLATE UPPER CHAR CPA DB3 CHAR = R? RSS YES - CONTINUE JMP DEBUG,I RETURN - PROG IS NOT 'DEBUG' * JSB SILST INITIALIZE FOR SEGMENT DSCAN JSB LSTX SET LST ADDRES HLT 0 'DEBUG' NOT FOUND IN LST LDA LST1,I GET NAME 1,2 CPA CHRDE CHARS = D,E? RSS YES - CONTINUE JMP DSCAN NO - TRY NEXT LST ENTRY LDA LST2,I GET NAME 3,4 CPA CHRBU CHARS = B,U? RSS YES - CONTINUE JMP DSCAN NO - TRY NEXT LST ENTRY LDA LST3,I GET NAME 5 AND M7400 ISOLATE UPPER CHAR CPA UCHRG CHAR = G? RSS YES - CONTINUE JMP DSCAN NO - TRY NEXT LST ENTRY * LDA LST4,I GET ENT/EXT FLAG AND P7 MASK IN STATUS CPA P2 UNDEFINED ? HLT 0 'DEBUG' IS UNDEFINED LDA PRENT,I THE PROG OR SEG PRIMARY ENT POINT LDB LST5,I AND PUT IT INTO ENTRY POINT JSB OUTAB 'DEBUG'(ON THE DISC) * LDA CURAL,I GET DEBUG TRANSFER ADDR ADA PPREL ADD CURRENT PROG RELOCATION ADDR STA PRENT,I SET 'DEBUG' TRANSFER IN ID SEG. * JMP DEBUG,I RETURN * DB1 ASC 1,DB DB2 ASC 1,UG DB3 OCT 51000 R DB1X ASC 1,.S ASC 1,TD OCT 41000 * * PROCESS ENT,EXT RECS * ENTR CCA,RSS ENT REC PROCESSOR EXTR CLA EXT REC PROCESSOR STA NXFLG SET ENT/EXT FLAG = -1/0 * LDA LIBFL GET THE LIBRARY SCAN FLAG SZA,RSS SCANNING LIBRARY JMP ADDON NO LDA PROGT YES, SO GET THE PROGRAM TYPE CPA P5 IS IT A SEGMENT ? JMP LDRIN YES, SO FORGET IT ADDON LDA LBUF+1 GET NO. SYMBOLS AND M37 ISOLATE SYMBOLS CMA,INA STA EXCNT SET ENT/EXT SYMBOL COUNT LDB ALBUF GET ADDR OF LBUF ADB P3 NEXSY LDA B,I GET SYMBOL 1,2 STA TBUF SAVE NAME 1,2 INB LDA B,I GET SYMBOL 3,4 STA TBUF+1 SAVE NAME 3,4 INB LDA B,I GET SYMBOL 5 STA TBUF+2 SAVE NAME 5 INB STB SYMAD SAVE SYMBOL ADDR (FOR ENT) * voNLH LDB NXFLG GET ENT/EXT FLAG SZB,RSS SKIP - SET ENT ABSOLUTE ADDR JMP NOTEN OMIT SETTING ABS. ADDR FOR EXT AND P7 MASK IN RELOCATION BASE TYPE STA ENTYP SAVE ENT TYPE CLB CPA P4 IF TYPE 4 ENT JMP TYP4 THEN GO SET IT UP. ADA ENTRL ADD RELOCATION BASE ADDR LDB A,I GET PROPER RELOCATION BASE TYP4 ADB SYMAD,I ADD TO GET ABSOLUTE ADDR STB OPRND AND SAVE IT NOTEN JSB LSCAN SCAN LST FOR NAME JMP ENTX3 END OF LST * LDA LST4,I SET UP STATUS OF AND P3 SYMBOL MATCHED WITH. STA ENTST LDA LIBFL SZA,RSS SCANNING LIB ? JMP NRML NO LDA NXFLG SZA,RSS PROCESSING ENT ? JMP NRML NO LDA ENTST GET SYMBOL STATUS CPA P2 ENT MATCHED WITH EXT ? RSS YES - THEN IT IS OK. JMP ENTX5 NO - THEN FORGET IT. NRML LDA NXFLG GET ENT/EXT FLAG SZA,RSS SKIP - PROCESS ENT JMP ENTX4 COMPLETE EXT PROCESSING * LDA ENTST GET STATUS OF SYMBOL _xN CPA P2 IF STATUS = 2 (UNDEF SYMBOL) JMP ENT2X THEN SET ENT ABS VALUE FOR EXT * * DUPLICATE ENTRY POINT * CPA P3 AN EMA ENTRY PERHAPS ? JMP LL19 YES JSB CPRNM PRINT MODULE NAME JSB PRNAM PRINT ENTRY POINT NAME DEF TBUF LDA ERR07 07 = DUPLICATE ENT JMP ABOR * ERR07 ASC 1,07 * ENT2X LDA ENTYP GET ENT TYPE ALF,ALF POSITION ENT TYPE LDB LIBFL GET LIB SCAN FLAG SZB,RSS IF SCANNING LIB INA THEN SKIP THIS INSTRUCTION STA LST4,I SET LST4 CLA STA IGNOR SET TO 'NOT IGNORE' FOR LIB INA STA NUPLS SET FLAG FOR 'SOME LIB LOADED' LDA OPRND OPERAND IN IT STA LST5,I SET VALUE INTO LST. JSB FIXAL FIX ALL REFERENCES JMP ENTX5 COMPLETE ENT PROCESSING * SKP * ENTX3 JSB SELST SET NAME INTO LST LDB NXFLG GET ENT/EXT FLAG SZB,RSS PROCESSING EXT ? JMP EXTNM YES LDA ENTYP ALF,ALF POSITION ENT TYPE LDB LIBFL SZB,RSS LIB SCAN ? INA NO, THEN SET STATUS = 1. STA LST4,I SET LST4 LDA OPRND SET SYMBOL VALUE STA LST5,I AND SET JMP ENTX5 IN LST5. COMPLETE ENT PROCESSING. * EXTNM LDA P2 STATUS = 2 FOR EXT STA LST4,I SET UP LST4 FOR EXT ENTX4 LDA TBUF+2 GET CHAR 5, ORDINAL STA LST3,I SET ORDINAL INTO LST ENTX5 LDB SYMAD GET SYMBOL ADDR LDA NXFLG GET ENT-EXT FLAG SZA SKIP - EXT INB INCR SYMBOL ADDR FOR ENT ISZ EXCNT SKIP - ALL SYMBOLS PROCESSED JMP NEXSY PROCESS NEXT SYMBOL JMP LDRIN READ NEXT REC * EXCNT BSS 1 EXT/ENT SYMBOL COUNT NXFLG BSS 1 EXT/ENT FLAG ENTYP BSS 1 ENT TYPE BEING PROCESSED ENTST BSS 1 STATUS OF LST SYMBOL MATCHED M100 OCT 100 N5 rDEC -5 * * SKP * PROCESS DBL REC DBLR LDA IGNOR SZA REC TO BE IGNORED ? JMP LDRIN YES, GET NEXT REC. * LDA LBUF+1 GET INSTRUCTION COUNT AND M77 ISOLATE COUNT CMA,INA STA EXCNT SET INSTRUCTION COUNT LDA ALBUF GET ADDR OF LBUF ADA P4 ADJUST FOR FIRST RELOCATION BYTE STA CURAL SET CURRENT LBUF ADDR LDA LBUF+1 GET WORD 2 OF DBL REC AND M300 ISOLATE REL TYPE FOR LOAD ADDR STA DBLBS SAVE FOR LATER LDB LBUF+3 GET THE RELOCATION ADDRESS CPA M100 IF = 1 JMP MBASE THEN PROG RELOCATABLE. ADB BPREL RELOCATE THE LOAD ADDRESS FOR BP. SZA IF = 0 THEN BASE PAGE RELOCATABLE JMP RCERR ELSE ERROR 2 - ILLEGAL REC. JMP DBL0 FOR BP REL, AVOID FWA RESET. * MBASE ADB PPREL RELOCATE THE LOAD ADDRESS FOR MAIN MEM. ISZ DBLFL (SKIPS ONLY IF 1ST DBL OF NEW SEGMENT) JMP DBL0 * * ADJUST PROGRAM RELOCATION BASE TO LOAD ADDR IN * FIRST DBL RECORD IN EACH LOADING OPERATION TO * NOT ALLOCATE DISC SPACE FOR BSS AREAS AT THE * BEGINNING OF A PROGRAM. ALSO,THIS ALLOWS FOR * A PSEUDO COMMON REGION BETWEEN A "MAIN" PROG * AND ALL SEGMENTS IF THE SAME SIZE BSS AREA IS * DECLARED AT THE BEGINNING OF EACH SEGMENT. * LDA LBUF+3 ADJUST FWA TO BSS DISPLACEMENT ADA FWA ON DISC LOWER BOUND. STA FWA SET NEW FWA FOR LOAD OPERATION STA TPREL DBL0 STB DBLAD SET THE LOAD ADDRESS DBL1 LDB CURAL,I GET RELOCATION BYTE STB REKEY SAVE RELOCATION RYTE LDA N5 STA INSCN SET RELOCATION BYTE COUNT ISZ CURAL INCR CURRENT LBUF ADDR DBL2 LDA REKEY GET RELOCATION BYTE ALF,RAR ROTATE TO LOW A STA REKEY SET NEXT RELOCATION BYTE AND M7 ISOLATE CURRENT BYTE CPA P4 EXTERNAL REFERENCE? JMP DBL4 YES - GET LINK ADDR CPA P5 MEMORY REFERENCE? JMP DBL5 YES - CHECK FOR EXT WITH OFFSET CPA P6 BYTE ADDR ? JMP DBL6 YES ADA RBTAD ADD RELOCATION BASE TABLE ADDR LDA A,I SET RELOCATION BASE ADA CURAL,I ADD CURRENT INSTRUCTION WORD DBL3 LDB DBLAD GET LOAD ADDRESS TO B DABOT JSB OUTAB OUTPUT ABSOLUTE PROG WORD ON DISC DBL9 ISZ CURAL INCR CURRENT LBUF ADDR ISZ EXCNT SKIP - ALL INSTRUCTIONS OUT RSS NO - CONTINUE JMP LDRIN GET NEXT REC ISZ DBLAD INCR CURRENT DBL RELOCATION ADDR ISZ INSCN SKIP - GET NEW RELOCATION BYTE JMP DBL2 PROCESS NEXT INSTRUCTION JMP DBL1 GET NEXT RELOCATION BYTE DBL4 LDA CURAL,I GET CURRENT DBL WORD AND M377 ISOLATE ORDINAL STA EXORD AND SAVE IT. CLA STA OFSET SET OFFSET = 0 JSB DBLEX SET BP LINK ADDR FOR EXT JMP DBL9 INSTRUCTION IS OUTPUT BY DBLEX * DBL5 LDA CURAL,I GET CURRENT WORD FROM LBUF RAR,RAR POSITION AND AND M377 MASK IN ORDINAL IF ANY SZA,RSS ANY ORDINAL ? JMP DBL5M NO - GO PROCESS MEM REF. * STA EXORD SET UP ORDINAL LDB CURAL GET LBUF ADDR INB BUMP TO WHERE OFFSET IS LDA B,I GET OFFSET STA OFSET AND SET OFFSET VALUE. JSB DBLEX SET BP LINK FOR EXT REF ISZ CURAL INCREMENT LBUF ADDR JMP DBL9 GO INDEX TO NEXT WORD DBL5M LDA CURAL,I GET NEXT WORD FROM LBUF ISZ CURAL INCR CURRENT LBUF ADDR JSB MREF SET ADDR FOR MEM REF INSTR JMP DBL3 OUTPUT ABSOLUTE PROG WORD DBL6 LDA CURAL,I GET WORD 1 OF THE GROUP ALF POSITION AND AND M17 MASK IN TYPE. SZA IF NON-ZERO JMP RCERR THEN ILLEGAL REC ERROR LDA CURAL,I ELSE GET WORD 1 AGAIN AND P3 ) MASK IN RELOCATION TYPE LDB ENTRL GET RELOCATION BASE ADB A LDB B,I FROM TABLE RBL AND COVERT TO BYTE ADDR ISZ CURAL LDA CURAL,I GET WORD 2 (BYTE ADDR) SSA IF SIGN BIT SET JMP RCERR THEN ILLEGAL REC. ADA B ADD BASE BYTE ADDR TO GET INSTRUCTION JMP DBL3 GO TO OUTPUT ON DISC OR BP * DBLBS NOP LOAD ADDR INDICATOR OFSET NOP OFFSET FOR AN EXT M17 OCT 17 * * SKP * *********** LIBRARY FILE SCAN MODULE ************ * * LOADX JSB LIBSC GO SCAN FOR LIBRARIES JMP LOADQ GO SCAN SYSTEM LIBRARY * * SKP LIBSC NOP LDA START,I ANY LIBRARIES TO SEARCH ? SZA,RSS WELL ? JMP LIBSC,I NO, SO FORGET THE WHOLE THING. * * * LIBRARY FILE(S) EXIST * * LDB TYPE1 OK, BUT IS THERE ALSO A CURRENT INPUT STB SVTP1 FILE THAT WE ARE RELOCATING ? SZB,RSS WELL ? JMP LOADK NO INPUT FILE, BUT A LIBRARY FILE EXISTS. * * *********** LIBRARY EXISTS BUT WE HAVE AN INPUT FILE OPEN ************ * * ERB,SLB FILE OR LU OPEN ? RSS FILE. JMP LOADK LU. * JSB CLOS1 CLOSE THE INPUT FILE SSA,RSS ANY ERRORS ? JMP LOADK NO LDB F1 YES JMP FLERR * * ****** SET UP FOR LIBRARY SCAN ******** * * LOADK CCA SET THE FILE LIB SCAN FLAG STA FLIB * LDA START GET THE 1ST LIB FILE PARAMETERS STA F1 SET INTO ERROR FLAG STA INCX AND THE OPEN CALL ADA P3 SET SEC CODE & CART ALSO STA INCY INA STA INCZ * NXLIB JSB OPEN OPEN THE LIB FILE DEF *+8 DEF IDCB1 DEF IERR1 INCX NOP NAME DEF IPTN1 EXCLUSIVE OPEN INCY NOP SECURITY CODE INCZ NOP CART REF DEF IDCBS # OF WORDS TO USE  * LDB P3 SET FILE IN USE FLAG STB TYPE1 * SSA,RSS ANY ERRORS JMP SCFLG NO, GO READ THE RELO CODE. LDB F1 YES, JMP FLERR GO SEND ERROR MESSAGE * * LBRTN JSB CLOS1 CLOSE THE FILE SSA,RSS ANY ERRORS JMP *+3 NO. LDB F1 YES JMP FLERR SEND ERROR * LDA INCX SET UP NEXT LIBRARY ADA P5 LDB A,I IS THERE A NEXT LIB ? SZB WELL ? CPB END WELL ? JMP LOADW NOPE. * STA F1 SET ERROR POINTER & STA INCX SET UP THE OPEN CALL LDA INCY ADA P5 STA INCY * LDA INCZ ADA P5 STA INCZ * JMP NXLIB GO GET 'EM ROVER ! * * LOADW CLA LIB SCAN DONE STA FLIB * LDA DEFF1 SET ORGINAL F1 BACK UP STA F1 * LDA SVTP1 GET THE OLD TYPE WORD . STA TYPE1 & RESET SZA,RSS WAS A PREVIOUS FILE OPEN ? JMP LIBSC,I NO, SO RETURN * ERA,SLA YES, FILE OR LU RSS FILE JMP LIBSC,I LU SO RETURN * JSB OPENN OPEN THE ORGINAL FILE JSB APOSN POSITION FILE TO CORRECT DEF *+6 DEF IDCB1 AREA DEF IERR1 DEF IREC DEF IRB DEF IOFF * SSA,RSS ANY ERRORS JMP LIBSC,I NO, SO RETURN * LDB F1 GET THE FILE NAME JMP FLERR REPORT THE ERROR * * * * START DEF LIBRY LIBRY BSS 5 LIBRARY FILE 1 BSS 5 LIBRARY FILE 2 BSS 5 LIBRARY FILE 3 BSS 5 LIBRARY FILE 4 BSS 5 LIBRARY FILE 5 BSS 5 LIBRARY FILE 6 BSS 5 LIBRARY FILE 7 BSS 5 LIBRARY FILE 8 END DEF * END OF LIBRARY AREA SKP * * * LOAD FROM PROG LIB * LOADQ LDA TYPE1 SEE IF THERE STILL A FILE OPEN.   ERA,SLA IF THERE IS RSS (THERE IS) JMP LOADZ (THERE ISN'T) * POSTR JSB POSTX THEN THIS MUST BE A SEGMENTED PROGRAM * AND WE ARE GOING TO DO A LIB SCAN. * IF WE CALL POST THEN WE CAN USE THE * 256 WORDS AS BUFFER SPACE FOR THE SCAN. * * LOADZ LDA PRENT,I GET PRIMARY ENTRY POINT SZA SKIP - NO PRIMARY ENTRY POINT JMP LOADN LOAD FROM PROG LIB LDA ERR08 CODE 08 = NO TRANSFER ADDR JSB ERROR PRINT DIAGNOSTIC ON SYSTEM TTY JMP ABORT AND ABORT THYSELF LOADN CCA SET FLAG STA SLIBF FOR 'LOADING FROM SYS LIB' STA LIBFL 'SCANNING LIB' STA LGOU DUMMY UP 'LG BEING USED' FLAG STA LSTBK SET UP POINTERS TO DISC LIB SUCH LDB SYSLN GET THE START OF USER ENTS LDA PTYPE GET PROG TYPE CPA P3 PRIV PROG ? CLB YES, SO SET SCAN TO 0 STB DCNT LDA PLIST GET LIST/NO LIST FLAG SLA,RSS SKIP LISTING ? JSB SPACE NO, THEN SPACE OVER. JMP RSET? GO FIGURE OUT THE NEXT MOVE * * * COMMAND IS TRANSFERED HERE IF AFTER A SYS LIBRARY * SCAN NO MORE UNDEFINED EXTERNALS EXIST. SPC 1 * RNDEX LDA MSEG GET THE SEGMENTED PROG FLAG SZA ARE WE SEGMENTED ? JMP SEGT YES LDA TYPE2 NO, GET THE CMND FILE TYPE SZA IS THERE A COMMAND FILE ? JMP NXTOP YES SO GET THE NEXT COMMAND JMP NODEX NO, SO GO FINISH LOAD. * SEGT LDA TYPE2 GET THE CMND FILE FLAG WORD SZA,RSS IS THERE A COMMAND FILE JMP NODEX NO, MIGHT BE END OF LOAD LDA SKP.1 GET THE SE RE EXECUTED FLAG SSA HAVE WE DONE ANY OF THESE YET JMP NODEX NO, SO FINISH LOAD LDA OP? YES, GET THE LAST OPCODE CPA SE B\ WAS IT AN SE ? JMP NXTOP YES, MUST HAVE BEEN AN SE,< > COMMAND JMP NODEX NO, WE NEED TO FINISH THE SEGMENT LOAD * * * SKP * * SCAN THE DIRECTORY OF ENTRY POINTS * SYLOK NOP LDA DCNT CPA #ENTS IF NO MORE SYMBOLS JMP EMPTY THEN RETURN WITH NO MATCH ISZ DCNT BUMP TO NEXT ENT JSB GTENT GET NEXT ENT JSB FNLST INITIALIZE TO START OF USER LST LDA MSEG IF SEG LOAD CPA P2 THEN JSB SILST INITIALIZE LST FOR SEG ONLY JSB MATCH SCAN LST FOR MATCHING NAME JMP SYLOK+1 NO MATCH - CHECK NEXT SYMBOL * GTSUB LDA TBUF+3 MATCH !(GET THIS SUB) GET SYMBOL TYPE. CPA P1 IF NOT FIXED JMP GTSU GO SET UP TO LOAD * ALF,ALF SET TYPE TO HIGH END STA B,I SET IN SYMBOL TABLE LST4 STA GTENT SAVE FOR ENT TYPE CHECK BELOW INB SET TO LST5 LDA TBUF+4 GET SYMBOL VALUE STA B,I SET IN LST5 ADB N4 SET TO LST1 STB LST1 SET FOR FIXUP * LDB GTENT GET THE SYMBOL TYPE SZB IS IT MEM RES ? JMP GTMEM NO, AN RP OR ABS LDB SSGA NOW SEE IF SSGA CPB P1 ACCESS IS ALLOWED. JMP GTMEM IT IS. CMA NO. SO IF THE ADDRESS XLB $DLP IS ABOVE START OF COMMON ADA B SSA,RSS THEN CHECK FURTHER JMP GTMEM ELSE CONTINUE XLB $COML GET LENGTH OF COMMON BLF,BLF CONVERT TO PAGES RBL,RBL ADA B ADD TO CURRENT LOCATION SSA,RSS IF POS, THEN THE ENT IS IN COMMON JMP LL24 AND ITS AN ERROR. * GTMEM JSB FIXAL FIX ALL REFERENCES JMP SYLOK+1 CONTINUE SCAN * GTSU LDA TBUF+4 GET DISC ADDR OF LIB SUB ALF,ALF RAL SET UP DISC ADDRES IN LG READ ROUTINE AND M377 STA LGTRK  SET TRACK ADDR LDA TBUF+4 AND M177 SECTOR ADDR CLB,CLE ERA,RAL ERB STB LBOEF SET LIB ODD/EVEN FLAG STA LGSEC LDA XBUFA STA XCUR CLA STA LGT1 STA LGT2 STA XCNT RSS (P+1) RETURN FOR MATCH FOUND EMPTY ISZ SYLOK CCA STA IGNOR STA PLFLG STA NUPLS JMP SYLOK,I (P+2) RETURN FOR NO MATCH * * DCNT NOP CURRENT DBUF COUNT SSGA NOP 0/1 USE / DON'T USE SSGA * LL24 JSB PRNAM PRINT EXTERNAL NAME DEF TBUF LDA ERR24 JMP ABOR ERR24 ASC 1,24 * SKP * * * GTENT - ROUTINE TO GET AN "ENT" OFF THE DIRECTORY IN THE * SYSTEM LIBRARY. BEFORE IT IS CALLED, SECT# MUST BE SET TO * THE 15 BIT DISC ADDR IN BLOCKS. "OFLE1" MUST BE SET TO * 0 OR 16, DEPENDING IF THE DIRECTORY STARTS IN AN EVEN OR * ODD SECTOR. CALLED: * LDA ENT# THE ENTRY NUMBER ON LIB. * JSB GTENT 4 WORD ENT IN TBUF 1-4. * GTENT NOP ENTRY A-REG = ENT NUMBER ADA OEFL1 ADJUST FOR POSS. ODD SECTOR CLB DIV P32 DETERMINE THE RELETIVE BLOCK ADA BLOK# NOW THE ABS BLOCK # BLS,BLS BUMP TO REL WORD IN BLOCK ADB ETBFA BUFFER STB IOFFS SET PNTR CPA LSTBK HAS BLOCK NUMBER CHANGED? JMP GTNT1 NO, CONTINUE STA LSTBK YES, UPDATE BLOCK BUFFER JSB READD READ LU=2 OFF DISC LDB IOFFS GET INDEX INTO BUFFER GTNT1 LDA B,I GET 1ST WORD STA TBUF AND PUT IN TBUF 1- 5 INB LDA B,I GET 2DN WORD STA TBUF+1 INB LDA B,I GET 3RD WORD AND M7400 GET 5TH CHAR STA TBUF+2 XOR B,I GET LO BYTE STA TBUF+3 AND PUT IN 4TH WORD INB LDA B,I GET 4TH WORD STA TBUF+4 AND PUT IN 5TH WORсD JMP GTENT,I RETURN DONE SPC 1 P32 DEC 32 * * * SUBROUTINE TO READ A DIRECTORY BLOCK (128 WORDS) * SPC 1 READD NOP ENTRY B=BUFFER ADDR CLB A=ABS BLOCK NUMBER ALS MPY BY 2 FOR 64 WORD SECTS DIV SECT2 BY THE NUMB SECTS / TRACK STA GTNT2 SAVE TRACK # STB GTNT3 AND SECTOR NUMBER JSB EXEC READ DISC LU=2 DEF *+7 DEF P1 DEF P2 LU = 2 FOR SYSTEM DISC ETBFA DEF SBUF DEF P128 WORDS DEF GTNT2 DEF GTNT3 JMP READD,I SPC 1 LSTBK DEC -1 IOFFS NOP GTNT2 NOP GTNT3 NOP #ENTS NOP TOTAL # OF ENTS IN SYSTEM SPC 1 * * LIBFL NOP SLIBF NOP REKEY NOP INSCN NOP ERR08 ASC 1,08 * * * * SKP * * SET UP DISC ADDRESSES , SECTOR OFFSET AND SYMBOL * COUNT TO SCAN DIRECTORY FROM START. * CSUBR NOP JSB LSTX1 ANY UNDEFINED ? JMP RNDEX NO LDB SYSLN SET UP FOR LIB SCAN LDA PTYPE GET PROG TYPE CPA P3 PRIV ? CLB YES, SET START OF SCAN = 0 STB DCNT SET UP THE START OF THE SCAN JMP CSUBR,I RETURN * * SCAN OF THE SYSTEM LIBRARY STARTS HERE. ALL SYSTEM * ROUTINES LOADED RETURN HERE AFTER THE END RECORD IS * PROCESSED. * RSET? JSB LSTX1 INITIALIZE LST & ANY UNDEF ? JMP RNDEX NO EXIT LOOP * JSB SYLOK SCAN DIRECTORY JMP LDRN2 MATCH FOUND - GET THIS SUB * JSB CSUBR INITIALIZE LST & ANY UNDEF ? JSB SYLOK SCAN DIRECTORY JMP LDRN2 MATCH FOUND - GET THIS SUB JSB CSUBR TAKE ONE LAST LOOK AT THE SYM TABLE * * SPC 1 * CONTROL IS TRANSFERED HERE WHEN THE ENTIRE SYS LIB HAS BEEN * SCANNED AND UNDEFINED EXTERNALS REMAIN. WE NOW DECIDE WHAT * TO DO WITH THE UNDEFS. * CAN GET HERE UNDER THE FOLLOWING CONDITIONS : * 1. LOADING MAIN & SEG ENCOUNTERED. * 2. LOpADING SEG & NEXT SEG ENCOUNTERED. * 3. SE,<> COMMAND * 4. END OF RELOC INPUT FROM LU OR FILE & NO COMMAND FILE. * * DNON1 LDA TYPE2 NO, IS THERE A COMMAND FILE OPEN? SZA IS THERE ? JMP SE..? YES SEE WHAT LAST COMMAND WAS DNON2 LDA MSEG IS THE PROG SEGMENTED ? SZA,RSS WELL? JMP FLUSH NO, FLUSH THE TURKEY !!! ISZ RRSCN DO WE RESCAN THE ENTIRE FILE ? RSS NO JMP SCANX YES * CPA P1 IS THIS THE MAIN OF THE SEG JMP NODEX YES SO LOAD IT ANYWAY * FLUSH JSB PUDF MAIN OR SEG W/UNDEFS, SO LIST THEM LDA FORCD IS THE FORCE SSA FLAG SET? JMP FIXCL YES,GO FIX THE FIX UP TABLE JMP ABORT NO, SO ABORT THYSELF * * * LIST UNDEFINED EXTS * * PUDF NOP ENTRY POINT CLA SET UP FLAG FOR NO UNDEFS STA UN# LDA DONE? GET THE PARAMETER CHECK DONE FLAG SZA,RSS ANY PARAMETER CHECKS DONE ? JMP NPUDF NO, THUS NO UNDEFS LDA P14 LDB MESS3 MESS3 = ADDR: UNDEFINED EXTS JSB SYOUT PRINT: UNDEFINED EXTS JSB FNLST INITIALIZE LSTX * LDA MSEG IF LOADING CPA P2 A SEGMENT, INITIALIZE JSB SILST FOR IT IN LST. * XSCAN JSB LSTX SET LST ADDRES JMP PSUSP END OF EXTS LDA LST4,I GET ENT/EXT FLAG AND P7 MASK IN SYMBOL STATUS CPA P2 UNDEFINED SYMBOL ? RSS YES - THEN SKIP JMP XSCAN TRY NEXT LST ENTRY ISZ UN# INCREMENT THE UNDEFS # LDA P5 LDB LST1 GET ADDR OF SYMBOL JSB SYOUT PRINT UNDEFINED EXT JMP XSCAN TRY NEXT LST ENTRY * PSUSP LDA UN# GET THE # OF UNDEFS SZA ARE THERE ANY UNDEFS ? JMP PUDF,I YES, LIST IS PRINTED * NPUDF LDA P12 LDB NMESS _ JSB SYOUT TELL THE FOLKS NO UNDEFS JMP PUDF,I RETURN TO CALLER * CONSTANTS * MESS3 DEF *+1 ASC 7,UNDEFINED EXTS NMESS DEF *+1 ASC 6, NO UNDEFS IGNOR NOP UN# NOP SKP * SE..? LDA SKP.1 HAS ANY RE OR SE COMMAND BEEN EXECUTED ? SSA WELL JMP DNON2 NO, SO FORGET ABOUT THE SE COMMAND * LDA OP? GET THE LAST OPCODE CPA SE WAS IT A SEARCH (IE NO NAMR) JMP NXTOP YES SO GET THE NEXT OPCODE JMP DNON2 NO, GO SEE IF IT WAS A FORCED LOAD * * * JMP DEBUG,I RETURN * * * PRINT MESSAGE ON LIST DEVICE * * THE DRKEY SUBROUTINE PRINTS A MESSAGE ON THE LIST OUTPUT DEVICE. * * CALLING SEQUENCE: * A = NO. CHARACTERS (POS.) TO BE PRINTED. * B = ADDRESS OF MESSAGE * JSB DRKEY * * RETURN: CONTENTS OF A AND B ARE DESTROYED * DRKEY NOP STA CHAR# SAVE THE # OF CHARACTERS * ADB N1 BACK THE ADDRESS UP BY ONE STB MADDR AND SAVE FOR LU WRITE STB MADDF OR FILE WRITE LDA B,I GET THE WORD PRIOR TO THE BUFFER STA LTEMP AND SAVE IT LDA BLNK2 GET A BLANK STA B,I AND PUT IT IN THE BUFFER * LDB CHAR# GET THE # OF CHARACTERS ADB P3 ALLIGN TO A WORD & ACCOUNT FOR THE BLANK CLE,ERB DIV BY 2 . NOW HAVE WORD COUNT STB COUNT SAVE FOR LU OR FILE WRITE * LDB CHAR# GET THE # OF CHARS SLB,INB,RSS ODD # ? JMP GOWRT NO, SO WRITE THE BUFFER OUT CLE,ERB INDEX ADB MADDR THE THE LAST WORD LDA B,I GET IT & PUT A BLANK AND M7400 IN THE LOW END ADA D32 STA B,I * GOWRT LDA TYPE3 OK, SO NOW FIND OUT WHERE THE ERA,SLA WRITE GOES JMP WFILE A FILE * LDA LISTU GET THE LU TO WRITE TO AND M77 WITHOUT ANYTHING ELSE LDB MYLU# GET MY&O DEFAULT LU # SZA,RSS NULL OR BIT BUCKET ? STB LISTU YES THEN SET IT UP * JSB EXEC REQUEST WRITE DEF *+5 DEF P2 WRITE REQUEST CODE DEF LISTU ADDR OF LIST OUTPUT UNIT NO. MADDR DEF 0 BUFFER LOCATION DEF COUNT CURRENT WORD COUNT LDA LTEMP GET AND RESTORE STA MADDR,I THE ALTERED WORD JMP DRKEY,I * WFILE JSB WRITF DO THE FILE WRITE DEF *+5 DEF IDCB3 DEF IERR3 MADDF NOP BUFFER ADDRESS DEF COUNT BUFFER LENGTH * LDB LTEMP GET THE ALTERED WORD STB MADDR,I AND RESTORE IT SSA,RSS ANY FILE ERRORS JMP DRKEY,I NO, SO RETURN * JSB FCLOS YES, SO ATTEMPT TO CLOSE ALL FILES LDB F3 GET THE FILE NAME LDA IERR3 AND THE ERROR TYPE JMP FLERR AND REPORT THE ERROR SPC 1 COUNT BSS 1 CURRENT MESSAGE LENGTH LTEMP NOP D32 DEC 32 BLNK2 ASC 1, DOUBLE BLANK CHAR# NOP INPUT # OF CHARACTERS * * PRINT DIAGNOSTIC ON SYS. TTY. * * ERROR IS USED TO PRINT ALL DIAGNOSTIC MESSAGES. * * CALLING SEQUENCE: * A = 2-DIGIT ERROR CODE (ASCII) * B = IGNORED * JSB ERROR * * RETURN: CONTENTS OF A AND B ARE DESTROYED. * ERROR NOP STA MERR+1 SET CODE INTO ERROR MESSAGE LDA P4 LDB MESS5 MESS5 = ADDR: L XX JSB SYOUT PRINT: L XX JMP ERROR,I RETURN JMP ERROR,I RETURN SPC 1 MESS5 DEF *+1 MERR ASC 2,L 77 * * NEW LINE ON LIST OUTPUT DEVICE * * THE SPACE SUBROUTINE IS CALLED TO PAGE UP THE PRINTER. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB SPACE * * RETURN: CONTENTS OF A AND B ARE DESTROYED. * SPACE NOP CLA SET COUNT = 0. LDB ALBUF B = DUMMY ADDR. JSB DRKEY NEW LINE JMP SPACE,I RETURN 5NLH* * OUTPUT MESSAGE TO SYS. TTY. * * THE SYOUT SUBROUTINE PRINTS ALL DIAGNOSTICS ON THE SYSTEM * TELETYPE. THESE INCLUDE ALL OPERATOR MESSAGES AND ALL * ERROR DIAGNOSTICS. EACH MESSAGE IS PRECEDED WITH THE * CHARACTERS: * * /LOADR: * * * CALLING SEQUENCE: * A = NO. OF CHARACTERS IN MESSAGE (POSITIVE) * B = MESSAGE ADDRESS * JSB SYOUT * * RETURN: CONTENTS OF A AND B ARE DESTROYED. * SYOUT NOP STB TTYAD SET MESSAGE ADDR CMA,INA STA B ARS CHANGE NO. CHARS. TO NO. WORDS STA WDCNT SET MESSAGE LENGTH ADB N8 ADJUST FOR LENGTH OF /LOADR: STB TTYNO SET NO. OF CHARACTERS IN MESSAGE * LDB SYM4 GET ADDR OF MESSAGE BUFFER SYOU LDA TTYAD,I GET WORD FROM MESSAGE STA B,I SET WORD INTO MESSAGE BUFFER INB INCR BUFFER ADDR ISZ TTYAD INCR MESSAGE ADDR ISZ WDCNT SKIP - MESSAGE MOVED TO BUFFER JMP SYOU CONTINUE MOVING MESSAGE * LDA TTYNO GET THE # OF CHARS CMA,INA LDB DSYMS AND THE ADDRESS JSB DRKEY OUTPUT MESSAGE N* JMP SYOUT,I RETURN * N8 DEC -8 TTYAD BSS 1 TTYNO BSS 1 SYM4 DEF SYMES+4 SYMES ASC 20, /LOADR: DSYMS DEF SYMES POINTER TO MESSAGE BUFFER * N2 DEC -2 P64 OCT 100 P1 OCT 1 P10 DEC 10 N20 DEC -20 MEM1 BSS 1 LOW MAIN ADDR OF DUMMY ID MEM2 BSS 1 HIGH MAIN MEM3 BSS 1 LOW BASE PAGE MEM4 BSS 1 HIGH BASE PAGE DMAIN BSS 1 DISC ADDR OF PROG SKP * * SUBROUTINE: "SETID" * * PURPOSE: THIS ROUTINE INSURES THAT A BLANK * ID SEGMENT IS AVAILABLE FOR A PROG * ADDITION OR NORMAL BG LOAD, * ALLOCATES SPACE FOR A DUMMY SEGMENT * IN UPPER MEMORY (BELOW THE DUMMY BASE * PAGE AREA), PRESETS SOME VALUES IN * THE DUMMY ID SEGMENT, AND SETS THE * ADDRESS OF EACH WORD IN A LINK WORD * IN THE DATA SECTION OF THE LOADER. * * IF A BLANK ID SEGMENT IS NOT AVAILABLE * OR THERE ARE INSUFFICIENT NUMBER OF * SEGMENTS FOR MAIN/SEGMENT LOADING, THE * MESSAGE: * "NO BLANK ID SEGMENTS" * IS PRINTED AND THE LOADER IS SUSPENDED. * THE OPEATOR MAY DELETE A PROG FROM * THE SYSTEM (OF COMMAND) OR TERMINATE * THE LOADER. * * * CALL: (A):= 0 FOR ADDITION (BLANK ID SEG. REQ) * = 1 FOR REPLACEMENT (BLANK IDS NOT REQ) * (B)= 0 FOR LONG ID SEG (18 WORDS) * = 1 FOR SHORT ID SEG (9 WORDS) * (P) JSB SETID * (P+1) -RETURN- REGISTERS MEANINGLESS * * THE ALLOCATION OF CORE IS AS FOLLOWS : * LONG DUMMY ID SHORT DUMMY ID * ------------- -------------- * * PRIOR PRENT(ENTRY POINT) * PRENT(ENTRY POINT) NAM12 * NAM12 NAM34 * NAM34 NAM5 * NAM5 MEM1 * RESL MEM2 * TMDY1 MEM3 * TMDY2 MEM48 * MEM1 DMAIN * MEM2 * MEM3 * MEM4 * DMAIN * EMAID * SHIGH * SESW1 * SESW2 * SESW3 * IDEX1 * IDEX2 * * SKP * SETID NOP STB TYPID SAVE LONG/SHORT FLAG ISZ ID# SZA,RSS IF NOT ADDITION, SKIP JSB COIDS ELSE COUNT THE IDS * * ALLOCATE DUMMY ID SEGMENT IN UPPER CORE. * LDB TYPID GET LONG/SHORT FLAG LDA N20 SZB SHORT ID ? LDA N9 YES, SET (A)=-9. STA SET6 SET NEGATIVE LENGTH OF ID ADA TFIX THE FIXUP TABLE STA SET2 SET NEW END LDB TFIX CURRENT ADDRESS TO B STA TFIX SET NEW END OF FIXUP TBL. SETI0 CPB IDA END OF TABLE? JMP SETI1 YES * LDA B,I NO MOVE A WORD STA SET2,I MOVE IT INB STEP THE ADDRESSES ISZ SET2 JMP SETI0 AROUND WE GO * SETI1 LDA TFIX CMA,INA TEST FOR SYMBOL ADA PLST OVERFLOW SSA,RSS WELL JMP LOVER ALL OVER NOW * LDA IDA SUBTRACT PROPER LENTH FROM ADA SET6 CURRENT ID SEG ADDR. STA IDA FOR NEW ADDR. LDB IDA SET CLA DUMMY SETI STA B,I ID INB SEGMENT ISZ SET6 = TO JMP SETI ZERO. * LDA IDA LDB TYPID GET LONG/SHORT FLAG SZB SKIP ON LONG ID JMP SHID SET UP SHORT ID SEG. STA PRIOR SET ADDR OF PRIORITY INA STA PRENT SET ADDR OF PRIMARY ENT. PT. INA STA NAM12 SET ADDR OF NAME 1,2 INA STA NAM34 SET ADDR OF NAME 3,4 INA STA NAM5 SET ADDR OF NAME 5, TYPE INA STA RESL SET ADDR OF RESOLUTION CODE INA STA TMDY1 SET ADDR OF TIME OF DAY, LS INA STA TMDY2 SET ADDR OF TIME OF DAY , MS INA STA MEM1 C SET ADDR OF LOW MEMORY BOUND INA STA MEM2 SET ADDR OF HIGH MEMORY BOUND INA STA MEM3 SET ADDR OF LOW BP BOUND INA STA MEM4 SET ADDR OF HIGH BP BOUND INA STA DMAIN SET DISK ADDR OF MAIN PROG INA STA EMAID SET EMA WORD INA STA SHIGH HIGH MAIN + LARGEST SEG + 1 INA STA SESW1 SESSION MONITOR WORD # 1 INA STA SESW2 SESSION MONITOR WORD # 2 INA STA SESW3 SESSION MONITOR WORD # 3 INA STA IDEX1 ID EXTENSION WORD # 1 INA STA IDEX2 ID EXTENSION WORD # 2 * * LDA P99 INITIALIZE STA PRIOR,I PRIORITY = 99 * LDA MYLU# SET LU # CMA,INA STA SESW3,I * CLA STA RESL,I AND DLD NDAY INITIALIZE STB TMDY1,I TIME OF DAY, LS HALF STA TMDY2,I TIME OF DAY, MS HALF JMP SETID,I RETURN * P99 DEC 99 * SHID STA PRENT SET ADDR OF PRIMARY ENT. PT. INA STA NAM12 SET ADDR OF NAME 1,2 INA STA NAM34 SET ADDR OF NAME 3,4 INA STA NAM5 SET ADDR OF NAME 5 & TYPE INA STA MEM1 SET ADDR OF LOW MAIN BOUND INA STA MEM2 SET ADDR OF HIGH MAIN BOUND INA STA MEM3 SET ADDR OF LOW BP BOUND INA STA MEM4 SET ADDR OF HIGH BP BOUND INA STA DMAIN SET DISC ADDR OF SEGMENT JMP SETID,I RETURN * * SET6 NOP TMDY1 NOP ADDR OF TIME OF DAY TMDY2 NOP SETM DEF *+1 ASC 10,NO BLANK ID SEGMENTS * ID# NOP # OF DUMMY ID SEGMENTS ALLOCATED TYPID NOP LONG(0) / SHORT(1) ID FLAG IDA NOP FWA OF CURRENT DUMMY ID SEGMENT EMAID NOP ADDRESS OF EMA WORD SHIGH NOP ADDRESS OF HIGH MAIN + SEG + 1 SESW1 NOP SESSION WORDS 1 - 3 SESW2 NOP SESW3 NOP IDEX1 NOP ID EXTENS9uION WORD 1 IDEX2 NOP ID EXTENSION WORD 2 SKP COIDS NOP THIS ROUTINE COUNTS THE IDS JSB BLKID GO COUNT LDB ID# GET THE REQUIRED NUMPER CMB,INB SET NEGATIVE ADA B SUBTRACT FROM AVAILABLE SSA,RSS IF ENOUGH JMP COIDS,I RETURN SPC 1 * SEND NO ID MESSAGE * NOIDS LDA P20 LDB SETM JSB SYOUT JMP ABORT * * * DBLEX HANDLES ALL DBL EXTERNAL REFERENECS & EMA REFERENCES. * BEFORE ENTRY INTO DBLEX, 'EXORD' MUST BE SET UP WITH * THE PROPER ORDINAL AND 'OFSET' SHOULD HAVE A FINITE VALUE. * (TYPE 4 DBL RECORD SETS OFSET=0 AND TYPE 5 GETS OFSET FROM * THE RECORD). * EXORD = EXT ORDINAL # * OFSET = OFFSET OF INSTRUCTION * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB DBLEX * * RETURN: CONTENTS OF A AND B ARE DESTROYED. * (A) HAS INSTRUCTION TO BE OUTPUT * DBLEX NOP JSB INLST INITIALIZE LSTX LDB PLST ADB P2 SET END PNTR STB PRMAP LDB TLST ADB P2 DBLF CPB PRMAP END OF LST ? JMP ORD? ORDINAL NOT FOUND * LDA B,I GET LST3 AND M377 MASK IN ORDINAL ADB P5 POINT TO NEXT LST1 CPA EXORD ORDINALS EQUAL ? RSS YES - SKIP JMP DBLF NO - CHECK NEXT LST ENTRY * ADB N7 BACK UP TO CURRENT SYMBOL STB TLST AND SET UP FOR LSTX JSB LSTX HLT 0 I HAVE ALLREADY CHECKED!! LDA REKEY SET THE DBL AND M7 TYPE STA T1FIX FOR FIXIT OR... LDA CURAL,I GET THE INSTRUCTION AND M1740 ISOLATE IT STA T2FIX AND SAVE IT ALSO LDA LST4,I GET WORD 4 OF LST ENTRY AND P3 ISOLATE THE TYPE CPA P3 IS IT EMA ? JMP EMDBL YES, SO PROCESS EMA EXTERNAL REFERENCE * CPA P2 IS SYMBOL DEFINED? JMP DBLE0 NO G;O BUILD A FIX UP * JSB FIXIT YES FIX IT UP AND OUTPUT IT JMP DBLEX,I RETURN * DBLE0 LDB TFIX GET CURRENT END ADB N4 PUSH DOWN STB TFIX THE BOTTOM OF THE TABLE CMB,INB WAS THERE ROOM? ADB PLST SSB,RSS WELL?? JMP LOVER NOPE DID HIM IN * LDB TFIX YES JSB FIXX SET UP THIS ENTRY * LDA LST1 SET STA FIX2,I THE LST ENTRY LDA T2FIX COMBINE IOR T1FIX THE INSTRUCTION AND DBL TYPE STA FIX3,I AND SET IT LDA OFSET GET THE OFSET STA FIX4,I AND SET IT LDA DBLAD NOW FOR THE ADDRESS STA FIX1,I JMP DBLEX,I EXIT * ORD? JSB CPRNM PRINT MODULE NAME LDA ERR14 ASMB GAVE EXT REF IN DBL REC JMP ABOR BUT NO EXT REC. ASMB ERROR * ERR14 ASC 1,14 * * PROCESS EMA EXTERNAL REFERENCE. * EMDBL LDA T1FIX GET THE TYPE OF DBL RECORD CPA P4 TYPE 4 ? RSS YES, SO ALL'S WELL JMP LL27 NO, ITS AN ERROR LDA T2FIX GET THE INSTRUCTION CODE SSA INDIRECT BIT SET ? JMP LL27 THAT'S AN ERROR ALSO * ADA MSIGN NOW SET THE SIGN BIT ADA LST5,I AND ADD THE BP LOCATION IN LDB DBLAD GET THE ABSOLUTE ADDRESS JSB OUTAB AND OUTPUT THE WORD JMP DBLEX,I RETURN * * LL27 LDA ERR27 JMP ABOR ABORT LOAD ERR27 ASC 1,27 * SKP * * THE OUTAB ROUTINE IS CALLED TO OUTPUT A WORD TO THE DISC * OUTAB NOP ROUTINE TO OUTPUT * * TEST FOR MAIN OR BASE PAGE FIXUP. * STA ABWRD ALL ABS CODE STB ABADD SAVE WORD (A) AND ADDRESS (B) CMB SET ADDRESS NEGATIVE STB A SAVE IT ADB FWA BELOW CURRENT MODULE? SSB,RSS WELL? JMP OUTA3 YES COULD BE BP OR MAIN FIXUP * ADA TPREL BEYOND LAST WORD PUT OUT? INA [ SSA,RSS WELL?? JMP OUTA2 NO JUST PUT THE WORD TO ABOUT * * ZERO ANY BSS 'S FOUND IN PROGRAM * OUTA1 CLA ZERO'S LDB TPREL NEXT ADDRESS CPB ABADD THIS THE ADDRESS TO WRITE? JMP OUTA2 YES GO DO IT * JSB ABOUT ELSE SEND A ZERO JMP OUTA1 CHECK IF ANOTHER NEEDED * * DO NORMAL OUTPUT OF A NORMAL INSTRUCTION * OUTA2 LDA ABWRD GET THE WORD LDB ABADD AND THE ADDRESS JSB ABOUT AND SEND IT JMP OUTAB,I RETURN * OUTA3 STA B ADDRESS NOT IN CURRENT MAIN ADA M2000 IN BP? SSA,RSS WELL?? JMP OUTA6 YES GO DO BASE PAGE FIX * * FIXUP OF A MAIN OF A SEGMENTED PROGRAM * STB A GET ANOTHER COPY ADB SEGM SEG-CURRENT ADDRESS ADA AFWA ABSOLUTE BASE-CURRENT ADDRESS SSB,RSS IF ABOVE SEGMENT BASE SSA,RSS OR BELOW MAIN JMP RCERR ERROR SHOULD NEVER GET HERE * LDA DMTBL SET ADDRESSES FOR ABOUT STA DTBL INA STA DTBL+1 INA STA DTBL+2 SO IT CAN GET BACK TO THE MAIN LDA ABWRD GET THE WORD LDB ABADD AND THE ADDRESS JSB ABOUT PUT IT OUT LDA DSTBL RESTOR ADDRESSES STA DTBL INA STA DTBL+1 INA STA DTBL+2 JMP OUTAB,I RETURN * * BP FIXUP (NOTE WE DON'T GO TO THE DISC YET ) * OUTA6 ADB BPFWA GET OFFSET INTO PGM. CMB BASE PAGE (MAIN AND SEG ARE CONTIG.) ADB FWABP TRANSLATE TO MEM. RES. DUMMY LDA ABWRD GET THE WORD STA B,I STORE IT IN THE BP JMP OUTAB,I RETURN * ABADD NOP TEMP TO HOLD LOAD ADDRESS * DMTBL DEF *+1 ADDRESS OF MAIN TRIPLET AFWA OCT 0,0,0 ABSOLUTE BASE DSTBL DEF *+1 NORMAL LOADING BASE ADDRESSES FWA NOP BASE OF CURRENT PROGRAM OR SEGMENT STRAK NOP BASE TRACK(=0 IF PROG NOT SEGMENTED) SSgECT NOP BASE SECTOR (BOTH ARE RELATIVE TO ZERO FOR MAIN) * DTBL DEF FWA NORMAL SET UP OF DEF STRAK ABOUT LOAD ADDRESSES DEF SSECT CHANGED ONLY TO FIX UP MAIN * SKP * * FIXAL FIXES UP REFERENCES * TO ENTRY POINTS NOT DEFINED WHEN REFERENCED * BY TAKING THE INFORMATION FROM THE CURRENT FIXUP TABLE ENTRY * AND BUILDING AN APPROPIATE INSTRUCTION FROM IT. * * THE FIX UP TABLE HAS 4- WORDS PER ENTRY AS FOLLOWS: * ....................................................... * ********************************************************************* * FIX1 MEMORY ADDRESS TO BE FIXED (-1 INDICATEDS AN EMPTY ENTRY) * * FIX2 SYMBOL TABLE ADDRESS OF EXT FOR THIS INSTRUCTION * * FIX3 INST OP CODE. BITS 2-0 = DBL TYPE (REKEY) 0,1,2,3,4,5 * * FIX4 OFSET FROM DBL RECORD. * *********************************************************************** * FIXAL EXTRACTS THE INFORMATION FROM THE CURRENT FIXUP TABLE ENTRY * AND LEAVES IT WHERE 'FIXIT' CAN FIND IT. THIS IS DONE TO ALLOW * 'FIXIT' CODE TO BE USED WITHOUT THE FIXUP TABLE OVER HEAD WHEN * DOING CODE THAT DOES NOT REQUIRE FIXUPS. * FIXAL NOP LDA LST1 LST1 MUST POINT TO SYM TAB ENTRY STA TLST JSB LSTX SET UP PROPER SYM TAB ENTRY HLT 0 * LDB IDA GET ORGION FIXA2 CPB TFIX END OF TABLE? JMP FIXA3 GO PACK THE TABLE * ADB N3 DOWN TO THE LDA B,I SYM. TBL. ENTRY ADB N1 SET B TO ORGION OF ENTRY CPA LST1 THIS ONE? JMP FIXA1 YES GO DO IT * JMP FIXA2 AROUND WE GO * FIXA1 JSB FIXX SET THE BASE ADDS IN FIX1-FIX4 LDA FIX3,I GET THE DBL CODE AND P7 AND STA T1FIX SET IT XOR FIX3,I GET THE MASKED INSTRUCTION STA T2FIX AND SET IT LDA FIX4,I GET THE OFFSET STA OFSET AND SET IT LDA FIX1,I GET THE MEhMORY ADDRESS STA DBLAD SET IT JSB FIXIT DO THE FIXUP CCA STA FIX1,I RELEASE THE FIXUP TABLE ENTRY STA FIX2,I * LDB FIX1 CONTINUE JMP FIXA2 SEARCH * FIXA3 LDB IDA TABLE GET THE BASE ADDRESS PKF00 CPB TFIX IF EMPTY JMP FIXAL,I JUST EXIT * ADB N4 INDEX TO FRONT OF ENTRY STB SET1 SET ADDRESS OF FIRST AVAILABLE ENTRY LDA B,I IS IT? SSA,RSS IT IS IF IT IS <0. JMP PKF00 NO AROUND WE GO * PKF01 LDA N4 SET UP A MOVE COUNTER STA SET2 TO MOVE THE NEXT ENTRY PKF02 CPB TFIX IS THERE ANOTHER ENTRY? JMP PKF05 NO GO PATCH UP TFIX * ADB N4 YES CHECK IT LDA B,I STILL IN USE? SSA WELL JMP PKF02 NO TRY NEXT ONE * PKF03 STA SET1,I YES MOVE IT DOWN INB ISZ SET1 STEP THE ADDRESSES LDA B,I GET THE NEXT WORD ISZ SET2 FOUR WORDS MOVED YET? JMP PKF03 NO * LDA SET1 YES SET UP FOR THE NEXT ADA N8 EMPTY SLOT STA SET1 ADB N4 ALSO B JMP PKF01 TRY THE NEXT ENTRY * PKF05 LDA SET1 END OF THE FIX UP LIST ADA P4 SET THE ADDRESS STA TFIX OF THE LAST VALID ENTRY IN TFIX JMP FIXAL,I RETURN * * SKP * * * FIXIT CONFIGURES THE INSTRUCTION THAT FIXAL SET UP * * FIXIT NOP THIS ROUTINE BUILD A INSTRUCTION AND PUTS IT OUT LDA LST4,I GET THE SYMBOL TYPE ALF,ALF AND P7 TO A CPA P4 IF REPLACE OP JMP FIX05 GO DO IT * LDA LST5,I GET THE SYMBOL VALUE ADA OFSET ADD THE OFFSET STA OPRND SET FOR SCANNERS AND M0760 ISOLATE PAGE BITS CMA,CLE,INA SET E IF PAGE ZERO LDA T2FIX GET THE OPCODE SEZ IF BASE PAGE REF JMP FIX04 USE DIRECT LINK * LDB lT1FIX GET THE DBL TYPE CPB P4 IF TYPE 4 THEN JMP FIX01 ALWAYS USE LINK * SZA ELSE USE LINK CPA MSIGN ONLY IF NOT A DEF JMP FIX04 A DEF DO DIRECT LINK * LDA OPRND CHECK IF A LINK NEEDED XOR DBLAD AND M0760 ISOLATE PAGE INFO SZA IN NOT SAME PAGE JMP FIX01 MUST USE LINK * LDA OPRND EXT REF WITH OFFSET TO SAME PAGE AND MPAG ISOLATE THE PAGE OFFSET IOR M2000 AND INDIRECT BIT ADD CURRENT PAGE ADA T2FIX BIT AND THE INSTRUCTION CODE JMP FIX03 GO SEND IT TO THE DISC * FIX01 LDB OPRND IF OPCODE LDA T2FIX SSA IS INDIRECT ADB MSIGN ADD A SIGN BIT STB OPRND JSB SCAN SCAN FOR A LINK JMP FIX02 SUCCESS * JSB ALLOC NO LINK FOUND ALLOCATE ONE STB T3FIX SAVE ACTUAL MEMORY ADDRESS OF IMAGE LDB OPRND AND STB T3FIX,I SET THE OPERAND INTO IT LDB A GET ACTUAL ADDRESS FIX02 LDA T2FIX INSTRUCTION TO A IOR MSIGN ADD THE INDIRECT IOR B AND THE BASE PAGE ADDRESS FIX03 LDB DBLAD GET THE ADDRESS TO B JSB OUTAB SEND THE WORD JMP FIXIT,I RETURN * FIX04 ADA OPRND DIRECT DEF ADD IN OPERAND JMP FIX03 GO PRODUCE IT * FIX05 LDA LST5,I REPLACE OP JMP FIX03 SEND IT * * * FIXX SETS UP FIX1-FIX4 * * ON ENTRY B=FIX1 ADDRESS * FIXX NOP STB FIX1 INB STB FIX2 INB STB FIX3 INB STB FIX4 JMP FIXX,I SO YOU EXPECTED COMMENTS YET! * * * FIX1 NOP FIX2 NOP FIX3 NOP FIX4 NOP T1FIX NOP DBL WORD TYPE FROM REKEY IE THE R FROM THE RRRRR FIELD T2FIX NOP THE INSTRUCTION OP CODE IN THE PROPPER UPPER BITS T3FIX NOP JUST A TEMP TO HOLD A DUMMY BP ADDR FOR A MOMENT TFIX NOP EXORD BSS 1 SET2 NOP SET1 NOP M1740 OCT 174000 MPAG OCT 101777 PAGE OFFSET AND INDIRECT BIT SKP * * * * CONVD CONVERTS THE CONTENTS OF A INTO ASCII (OCTAL) * AT THE LOCATION SPECIFIED BY THE ADDR IN B. * CALLING SEQUENCE: * A = NO. TO BE CONVERTED * B = ADDRESS OF CONVERTED NO. * JSB CONVD * * RETURN: CONTENTS OF A AND B ARE DESTROYED. * * CONVD NOP STB ATEMP SAVE THE ADDRESS OF THE BUFFER CLE FORCE OCTAL CONVERSION LDB OPCOD GET THE OPCODE CPB P3 IF OPCODE = 3 CME THEN SET E FOR DECIMAL CONVERSION JSB $CVT3 DO THE CONVERSION LDB A,I GET 1ST ASCII RETURN STB ATEMP,I AND PUT IT WHERE THE CALLER WANTS INA ISZ ATEMP LDB A,I GET THE NEXT ONE STB ATEMP,I INA ISZ ATEMP LDB A,I STB ATEMP,I NOW WERE DONE JMP CONVD,I * ATEMP NOP * * * * THE SEMAP SUBROUTINE SETS THE NAME OF THE CURRENT PROG * INTO THE MEMORY MAP AND SETS THE PROG LENGTH. * IT ALSO EXTRACTS THE PRIORITY AND TIME PARAMETERS * FROM THE NAME RECORD AND STORES THEM INTO 'NPAR'. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB SEMAP * * RETURN: CONTENTS OF A AND B ARE DESTROYED. * SEMAP NOP LDA LBUF+3 GET PROG NAME 1,2 STA MBUF SET NAME INTO MEMORY MAP LDA LBUF+4 GET PROG NAME 3,4 STA MBUF+1 SET NAME IN MEMORY MAP LDA LBUF+5 GET PROG NAME 5 AND M7400 ISOLATE UPPER CHAR IOR B40 ADD BLANK CHAR STA MBUF+2 SET NAME IN MEMORY MAP LDA LBUF+6 GET PROG LENGTH STA PLGTH SAVE PROG LENGTH * LDA N7 MOVE PRIORITY,RESOLUTION CODE, JSB MOVE EX MUL,HRS,MINS,SECS, DEF LBUF+10 AND TENS OF MS TO DEF NPAR NPAR * LDA LBUF GET THE REC LENGTH ALF,ALF AND ADA N17 SUBTRACT 17 LDB P10 GET #WORDS IN MAP MESS.  SSA,RSS IF NAM REC > 17 WORDS ADB A ADD DIFFERENCE TO MAP LENGTH BLS CONVERT TO WORDS STB NODE SAVE FOR MAP OUTPUT CPB P20 IF NO EXTRA WORDS JMP SEMAP,I EXIT * CMA,INA SET TO MOVE THE REST OF THE NAM JSB MOVE REC TO DEF LBUF+17 MBUF DEF MBUF+10 JMP SEMAP,I RETURN SPC 1 PLGTH BSS 1 PROG LENGTH B40 OCT 40 N17 DEC -17 N7 DEC -7 SKP MOVE NOP WORD MOVE SUBROUTINE STA PRMAP SAVE WORD COUNT LDA MOVE,I GET SOURCE STA LSCAN SET IN LSCAN ENTRY ISZ MOVE STEP TO DEST. ADDR LDA MOVE,I GET DEST. ISZ MOVE STEP TO RETURN ADDR MOV1 LDB LSCAN,I GET A WORD STB A,I PUT IT AWAY ISZ LSCAN STEP SOURCE INA AND DEST. ADDRES ISZ PRMAP DONE? JMP MOV1 NO - CONTINUE JMP MOVE,I YES - EXIT SPC 1 * PRINT MEMORY MAP * * PRMAP SETS THE CURRENT MEMORY BOUNDS INTO THE MEMORY MAP * AND PRINTS THE MAP IF THIS OPTION WAS SELECTED. FOLLOWING * THIS, THE MEMORY BOUNDS ARE UPDATED FOR THE NEXT PROG. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB PRMAP * * RETURN: CONTENTS OF A AND B ARE DESTROYED * PRMAP NOP LDA PPREL GET CURRENT PROG RELOC ADDR LDB AMEM3 GET ADDR IN MEMORY MAP JSB CONVD CONVERT TO OCTAL IN MAP CCA ADA TPREL GET LWA PROG LDB AMEM6 GET ADDR IN MEMORY MAP JSB CONVD CONVERT TO OCTAL IN MAP LDA PLIST GET LIST/NO LIST FLAG SLA SKIP - LIST MEMORY BOUNDS JMP PRMA1 OMIT LISTING LDA BLNK2 BLANK THE UNSET WORD STA MBUF+9 LDA NODE LDB MESS2 MESS2 = ADDR MEMORY MAP JSB DRKEY PRINT: XXXXX NNNNN NNNNN * LDA PLIST GET THE LIST OPTION SZA ? IF HE WANTS ENTS WE GIVE HIM LINKS TOO. JMP PRMA1 NO ENTS OF BP LINKS ASKED FOR * LDA FWABP GET THE ORGINE OF DUMMY BP CMA,INA AND FROM IT CALCULATE THE ADA CWABP CURRENT REAL BP ADDRESS ADA BPFWA NOW WE HAVE IT. LDB BPMSG SO CONVERT TO ASCII JSB CONVD * LDA P18 GET THE MSG LENGTH LDB BPADR AND THE ADDRESS JSB DRKEY AND REPORT TO THE USER JSB SPACE SPACE A LINE * PRMA1 LDA TPREL GET NEXT AVAIL ADDR STA PPREL SET NEXT RELOCATION BASE JMP PRMAP,I RETURN * BPADR DEF *+1 ASC 18, BP LINKAGE XXXXX BPMSG DEF BPADR+7 * NODE NOP MESS2 DEF MBUF SKP * SCAN LST FOR SAME ENT/EXT * SPC 2 * * MATCH DIRECTORY ENTRY WITH LST * * THIS ROUTINE DETERMINES IF ENT ENTRY FROM DIRECTORY * (IN TBUF) MATCHES ANY EXT IN THE LST . THE START OF * LST MUST BE SET BEFORE CALLING THIS SUBROUTINE. * * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB MATCH * (P+1) - MATCH NOT FOUND * (P+2) - MATCH FOUND * MATCH NOP LDB TLST MACH? CPB PLST END OF LST ? JMP MATCH,I YES - RETURN (P+1) LDA B,I GET LST1 RAL,CLE,ERA CLEAR BIT15 CPA TBUF NAME 1 , 2 EQUAL ? JMP *+3 YES ADB P5 NO - BUMP (B) BY 5 JMP MACH? GET NEXT LST1 INB LDA B,I GET LST2 RAL,CLE,ERA CLEAR BIT 15 CPA TBUF+1 NAME 3, 4 EQUAL ? JMP *+3 YES ADB P4 NO - BUMP (B) BY 4 JMP MACH? GET NEXT LST1 INB LDA B,I GET LST3 AND M7400 MASK IN NAME 5 CPA TBUF+2 NAME 5 EQUAL ? JMP *+3 YES ADB P3 POINT TO NEXT LST1 JMP MACH? GET NEXT LST1 INB LD NLHA B,I GET LST4 AND P7 MASK IN SYMBOL STATUS CPA P2 UNDEFINED ? JMP *+3 YES ADB P2 NO - FORGET ENT MATCHED TO ENT JMP MACH? GET NEXT LST1 ISZ MATCH BUMP TO (P+2) RETURN FOR MATCH JMP MATCH,I RETURN (P+2) * * SKP * * SCAN DUMMY LINKAGE AREA FOR OPERAND * * SCAN LOOKS THROUGH THE DUMMY BASE PAGE TO FIND IF A * BP LINK HAS ALREADY BEEN ALLOCATED FOR THIS WORD. * ON RETURN : * * (P+1) - MATCH FOUND AND REG-A = 0 * AND REG-B = ABSOLUTE LINK ADDR * * (P+2) - NO MATCH - REGS ARE MEANINGLESS. * SCAN NOP LDB FWABP GET THE LOWER BOUND LDA OPRND AND THE OPERAND SRC CPB CWABP END OF ALREADY ALLOCATED LINKS ? JMP NOTFD DO NOT FOUND RETURN CPA B,I IS THIS THE GUY ? JMP FOUND YES ! INB NO, BUMP POINTER & TRY AGAIN JMP SRC * NOTFD ISZ SCAN MAKE THE NOT FOUND RETURN JMP SCAN,I * FOUND LDA FWABP NOW CALCULATE THE ABSOLUTE ADDRESS CMA,INA ADB A ADB BPFWA JMP SCAN,I MAKE THE FOUND RETURN BN* OPRND NOP ADDRESS OF WORD WE'RE LOOKIN FOR. CWABP NOP NEXT DUMMY LINK ADDR TO BE ALLOCATED FWABP NOP ADDR OF 1ST WORD OF DUMMY LINK AREA * ALLOCATE NEXT BP LINK ADDR * * ALLOC ALLOCATES A WORD IN BASE PAGE TO BE USED FOR INDIRECT * LINKAGES. IF THE BASE PAGE AREA HAS BEEN EXHAUSTED, A * DIAGNOSTIC IS PRINTED AND LOADING IS ABORTED. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB ALLOC * * RETURN: * A = ABSOLUTE BASE PAGE ADDR * B = DUMMY AREA BASE PAGE ADDR * ALLOC NOP LDA CWABP GET NEXT AVAILABLE BP ADDR ISZ CWABP INCR CURRENT BP ADDR LDB A CMB,INB SET B = - CURRENT BP ADDR ADB LWABP GET LWA BP LINKAGE. SSB,RSS SKIP - BP OVERFLOW JMP ALLO1 JSB CPRNM PRINT MODULE NAME(IF ANY) LDA ERR04 04 = BP LINKAGE OVERFLOW JMP ABOR ALLO1 CLB STB A,I ZERO THE LINK WORD LDB FWABP SUBTRACT FWA BP AREA CMB,INB FROM CURRENT ADDR, ADA B TO GET RELATIVE ADDR. ADA BPFWA ADD FWA OF ACTUAL AREA FOR LDB CWABP ABS ADDR, B=DUMMY AREA ADB N1 JMP ALLOC,I ADDR. -RETURN. * ERR04 ASC 1,04 BASE PAGE OVERFLOW * * * SET MEMORY REFERENCE ADDRES * * MREF RELOCATES THE MEMORY REFERENCE INSTRUCTIONS. IF THE CURRENT * REFERENCE IS OUTSIDE THE CURRENT PAGE, IT ESTABLISHES AN INDIRECT * LINK THROUGH BASE PAGE. * * CALLING SEQUENCE: * A = FIRST WORD OF MEMORY REFERENCE GROUP * B = IGNORED * JSB MREF * * RETURN: CONTENTS OF A AND B ARE DESTROYED. * MREF NOP STA ABT4 SAVE (A) TEMPORARILY AND P3 ISOLATE RELOCATION BASE TYPE LDB ENTRL GET RELOCATION ADDR PNTR ADB A ADD OFFSET TO GET PROPER PNTR LDB B,I GET RELOCATION BASE ADDR LDA ABT4 RESTORE (A) ADB CURAL,I F ADD CURRENT INSTRUCTION ADDR AND M1740 ISOLATE INSTRUCTION CODE SSA SKIP - DIRECT REFERENCE ADB MSIGN SET SIGN OF ADDR = 1 STA INSTR SAVE INSTRUCTION CODE LDA DBLAD GET CURRENT RELOCATION ADDR AND M0760 ISOLATE CURRENT PAGE NO. STA PAGNO SAVE CURRENT PAGE NO. LDA B GET CURRENT ADDR AND M0760 ISOLATE PAGE NO. OF ADDR SZA,RSS BASE PAGE REFERENCE? JMP DBL8 YES CPA PAGNO CURRENT PAGE REFERENCE? JMP DBL7 YES, NO LINK NEEDED STB OPRND SAVE ABSOLUTE OPERAND JSB SCAN SCAN DUMMY LINK AREA JMP LNFND LINK FOUND JSB ALLOC ALLOCATE LINK STA TBUF SAVE BP LINK ADDR LDA OPRND GET CURRENT OPERAND STA B,I SET OPERAND IN DUMMY BASE PAGE. LDA TBUF GET BP LINK ADDR SMLNK IOR MSIGN ADD INDIRECT BIT MREF0 IOR INSTR ADD INSTRUCTION CODE TO ADDR JMP MREF,I RETURN LNFND SWP JMP SMLNK GO TO USE SAME LINK * DBL7 LDA B IT'S CURR PAGE AND M1777 SO REMOVE PAGE BITS FROM ADDR IOR M2000 AND SET CURR PAGE BIT JMP MREF0 ADD INSTR TO ADDR, RETURN * DBL8 LDA B IT'S BASE PAGE JMP MREF0 JUST ADD INSTR TO ADDR, RETURN * M1777 OCT 1777 INSTR BSS 1 PAGNO BSS 1 * * * SET VALUE INTO SYSTEM * * THE SYSET SUBROUTINE SET THE CURRENT WORD (IN THE A REG) * INTO THE SPECIFIED LOCATION OF THE SYSTEM. THIS IS REQUIRED * FOR BOTH THE BASE PAGE LINKAGES AND THE ID SEGMENT. * * CALLING SEQUENCE: * A = CURRENT VALUE * B = CURRENT LOCATION * JSB SYSET * * RETURN: CONTENTS OF A AND B ARE THE SAME AS AT CALL * SYSET NOP JSB $LIBR TURN OFF NOP INTERRUPT SYSTEM XSA B,I STORE WORD INTO SYSTEM JSB $LIBX RESTORE INTERRUPT DEF SYSET SYSTEM AND RETURN ֙* EMES DEF *+1 ASC 1, * ENTRY POINT BSS 6 LIST BUFFER BLANK OCT 40 * SKP * * NORMAL LOAD TERMINATION * NODEX LDA #PTTN IF NO PTTN SPECIFIED SZA THEN JMP NODEY CHECK INPUT #PAGES * XLB $MBGP GET THE MAX BG PROG LDA PTYPE & PROG TYPE CPA P2 IS PROG BG? RSS JMP *+3 XLB $MRTP NO, GET MAX RT SIZE * LDA EMABP *E SZA IF EMA, RSS JMP *+3 XLB $MCHN USE MAX MOTHER PTTN SIZE * LDA #PGS GET THE # OF PAGES REQUESTED CMA,INA & CHECK AGAINST MAX SIZE ADA B *E INA ACCOUNT FOR BP SSA DID HE ASK FOR TOO MUCH? JMP ER.18 YES, SO FLUSH HIM * NODEY LDA EMABP ANY EMA DECLARATION ? SZA,RSS WELL ? JMP NOEMA NO. * LDA SHIGH,I GET HIGHEST LOAD POINT SZA,RSS THIS IT ? LDA TPREL NO. NOW WE HAVE IT ADA M1777 ALLIGN TO NEXT PAGE AND M0760 STA EMABP,I AND STUFF INTO DUMMY BP * LDA #PGS GET SPECIFIED INPUT PAGES SZA,RSS ANY SPECIFIED? JMP NOEMA NO, FORGET IT * ADA N1 DON'T COUNT BP TWICE! ALF,ALF CONVERT #PAGES TO WORDS RAL,RAL *E ADA URFWA ADD TO LOAD PT STA EMABP,I PUT START ADDR MSEG INTO DUMMY BP * NOEMA LDA PLIST GET ENTRY POINT LIST FLAG ARS SZA SKIP - LIST ENTRY POINTS JMP NOLST OMIT ENT LISTING * * LIST LIB ENTRY POINTS * JSB SPACE NEW LINE LDA P12 LDB MESS8 MESS8 = ADDR: ENTRY POINTS JSB DRKEY PRINT : ENTRY POINTS JSB SPACE NEW LINE ON LIST OUTPUT DEVICE JSB INLST INITIALIZE LSTX ELIST JSB LSTX SET CURRENT LST ADDRES JMP NOLST END OF LST LDA LST4,I GET ENT/EXT FLAG AND P7 MASK IN SYMBOL STATUS CPA P2 IF STILL UNDEFINED JMP ELIST THEN DON'T LIST IT * LDA LST1,I GET NAME 1,2 CCE,SSA IF UN USED LIB ENTRY JMP ELIST DON'T LIST IT. * STA EMES+2 SET NAME 1,2 INTO BUFFER RAL,ERA SET THE SIGN BIT SO IT IS LISTED ONCE STA LST1,I RESET IN LST LDA LST2,I GET NAME 3,4 STA EMES+3 SET INTO BUFFER LDA LST3,I GET NAME 5 AND M7400 ISOLATE UPPER CHAR IOR BLANK ADD BLANK CHAR STA EMES+4 SET NAME 5 INTO BUFFER * LDA LST4,I GET THE TYPE OF CONTENTS OF LST5 AND B200 SZA,RSS IS V BIT SET JMP GOTAD NO, LST5 IS VALUE LDA BPFWA GET THE ADDR OF FIRST REAL AVAIL LINK CMA,INA ADA LST5,I ADD LINK ALLOCATED TO GET OFFSET INTO ADA FWABP DUMMY LINK TABLE LDA A,I NOW GET THE ADDRESS RSS GOTAD LDA LST5,I GET THE DEFINING ADDRESS LDB EMES GET ADDR OF 'NNNNN ' IN ADB P4 BUFFER. JSB CONVD CONVERT TO OCTAL IN MEMORY MAP LDA P14 LDB EMES ADDR OF ' *' BEFORE ENT BUFFER JSB DRKEY PRINT ENTRY POINT LISTING JMP ELIST CONTINUE ENTRY POINT SEARCH * NOLST JSB DWRIT WRITE LAST DISK SECTOR LDA FWA SET LOW MAIN STA MEM1,I ADDR LDA TPREL SET STA MEM2,I ADDR LDA FWABP CALCULATE RELATIVE CMA,INA CURRENT BP ADDR ADA CWABP AND ADD FWA OF REAL ADA BPFWA AREA FOR LAST ADDR AND STA MEM4,I SET IN ID SEGMENT LDA FWABP IF SEGMENT BEING LOADED, CMA,INA SUBTRACT FWABP FROM SEGB ADA SEGB (SEGMENT BASE) AND ADD ADA BPFWA TO REAL FWA OF BASE PAGE, STA MEM3,I SET AS LOW BOUND OF BP. LDA SEGB GET CURRENT LOWER BOUND OF BP, CMA,INA ] ADA CWABP ADD CURRENT BP LINK ADDR LDB MSEG (B) = M/SEG FLAG. CPB P1 IF LOADING MAIN, STA MTMP SAVE BP LENGTH SZA,RSS SKIP - SOME BP LINKAGES JMP NOBPL NO BP OUTPUT * * OUTPUT BASE PAGE LINKAGES * LDA FWA SET CMA,INA DBLAD ADA PPREL = TO DISPLACEMENT ADA M177 TO START OF AND M7600 NEXT SECTOR ADA FWA FOR STA DBLAD BP AREA. CLA,INA SET ABT12 = 1, STA ABT12 FOR WRITING BASE PAGE. LDA SEGB SET FWA OF CURRENT BASE PAGE STA ABT13 AREA IN ABT13. CPB P1 IF NOT LOADING RSS MAIN, JMP NOLS1 JUMP TO OUTPUT BASE PAGE. LDA FWA SAVE MAIN: STA MTMP+1 FWA LDA PPREL STA MTMP+2 PPREL LDA DBLAD STA MTMP+3 DBLAD LDA SEGB STA MTMP+4 FWABP LDA CWABP STA MTMP+5 CWABP. * NOLS1 LDA ABT13 IF CURRENT ABT13 = LAST USED CPA CWABP BASE PAGE ADDR, JMP NOBPL THEN FINISHED. * LDA ABT13,I OUTPUT CURRENT LINK WORD LDB DBLAD JSB ABOUT ISZ DBLAD UPDATE ISZ ABT13 ADDRES JMP NOLS1 AND CONTINUE. * NOBPL CLA RESET BASE PAGE OUTPUT STA ABT12 FLAG FOR "ABOUT". LDA MSEG SKIP NAME CPA P2 PROCESSING IF JMP MSGP1 SEGMENT LOAD LDB MESS4 GET ADDR OF TERM. MESSAGE LDA NAM12,I GET PROG NAME 1,2 STA B,I SET NAME INTO MESSAGE INB INCR CURRENT ID SEG ADDR LDA NAM34,I GET PROG NAME 3,4 STA B,I SET NAME INTO MESSAGE INB INCR CURRENT ID SEG ADDR LDA NAM5,I GET PROG NAME 5 AND M7400 ISOLATE UPPER CHAR IOR BLANK ADD BLANK CHAR STA B,I SET NAME INTO MESSAGE * JSB BREA5K LAST CHANCE TO BREAK THE PROGRAM * LDA MSEG CHECK FOR SPECIAL SZA,RSS MAIN/SEGMENT PROCESSING JMP NTRM0 -NO, NORMAL TERMINATION * MSGP1 LDB PLST IF MAIN LOADED, SAVE END OF CPA P1 LST AS BEGINNING OF STB SLST SEGMENT AREA OF LST. * LDB SLST ERASE PREVIOUS STB PLST SEGMENT LST ENTRIES. STB TLST * LDB OPCOD CHECK OPERATION CODE. CPB P1 -IF DEBUG LOAD, JMP MSGP3 SKIP. JMP MSGP4 CONTINUE. MESS8 DEF *+1 ASC 6,ENTRY POINTS M7600 OCT 177600 DRSET ASC 1,BS * * * MSGP3 LDA MSEGF SKIP DEBUG CHECK , ETC., CPA P3 IF FINAL JMP MSGP6 LOAD (=3). * LDA DRSET RESET .DBUG TO .DBSG TO GET SEGMENTS STA CHRBU SUBROUTINE THAT ACCESSES DBUG. * JSB SILST INITIALIZE FOR SEGMENT AREA, JSB LSTX SET ADDRES FOR NEXT LST ENTRY NOP LDA CHRDE PUT STA LST1,I ".DBSG" LDA CHRBU IN STA LST2,I NEXT LDA UCHRG LST ENTRY STA LST3,I FOR SEGMENT. LDA P2 SET LST4 = UNDEF SYMBOL STA LST4,I LDA TLST SET NEW STA PLST END-OF-LIST ADDR. * LDA N3 GET # OF WORDS TO MOVE JSB MOVE MOVE EM DEF DB1X SOURCE DEF DB1 DESTINATION (SAVES 6 BP LINKS) * * SAVE "MAIN" BOUNDS IF MAIN JUST LOADED * MSGP4 LDA MSEG CONTINUE IF CPA P2 PROCESSING A SEGMENT. JMP MSGP5 ISZ MSEG SET 'MSEG' = 2. LDA PPREL SAVE SEGMENT STA SEGM BASE ADDR LDA CWABP SAVE BASE PAGE LOWER BOUND STA SEGB FOR LINK AREA FOR SEGMENTS. * * SET CONDITIONS FOR NEXT SEGMENT. * MSGP5 LDA MSEGF SKIP IF CPA P3 FINAL LOAD. JMP MSGP6 LDA SEGM RESET LOWER STA PPREL BOUNDS VALUES FOR STA FWA L PPREL , FWA STA TPREL LDA SEGB STA CWABP CCA SET LAST ACCESS PNTR STA LELAD USED BY OUTAB ROUTINE STA DBLFL SET 1ST DBL FLAG = -1 STA PLFLG NAM MUST BE 1ST. CLA STA LGOU STA SLIBF STA LIBFL * * LDA IDA (A) = ID SEGMENT ADDR(DUMMY) ADA P4 (A)= ADDR OF MEM1 OF SHORT ID LDB TYPID GET LONG/SHORT ID FLAG SZB,RSS LONG ID ? ADA P4 YES, (A)=ADDR OF LONG ID'S MEM1 JSB C#S CALCULATE # SECTORS. * ADA SSECT ADD IN STARTING SECTOR. CLB DIVIDE BY DIV TRKS# # SECTORS PER TRACK. STB SSECT SET REMAINDER AS NEW SSECT. ADA STRAK ADD IN STARTING TRACK TO STA STRAK QUOTIENT AND SET NEW STRAK. ALF,RAL ROTATE TRACK # TO RAL,RAL 14-07, ADD IN IOR SSECT SECTOR # AND STA ALLOC SAVE TEMPORARILY IN SUB HEAD * * ALLOCATE NEW ID SEGMENT. * LDB EDFLG SET CLA (A) = 1 IF CPB P2 A REPLACEMENT, INA OTHERWISE (A)=0, CLB,INB INDICATE SHORT ID JSB SETID ALLOCATE SHORT ID SEG * LDA ALLOC STORE NEW STARTING TRACK STA DMAIN,I AND SECTOR IN "DMAIN" * LDA PLIST CHECK LIST FLAG SLA SKIP IF NOT SUPPRESSED. JMP MSG10 GO TO LOAD NEXT * JSB SPACE TRIPLE JSB SPACE SPACE FOR JSB SPACE CLARITY ON LISTING. * MSG10 LDA N60 GET THE COUNT JSB MOVE MOVE SEGMENT NAM BUFFER BACK DEF SGNAM SOURCE DEF LBUF DESTINATION * JMP *+1,I REPROCESS THE SEGMENT NAM RECORD DEF TESTR (SAVE A BP LINK TOO !) * * MESS4 DEF *+1 PRAM ASC 6, READY SKP * * RE-OUTPUT "MAIN" BASE PAGE LINKAGES * MSGP6 LDA SLST SAVE SLST V ALUE TEMPORARILY STA LSTX AND SET IT EQUAL TO FLST LDB FLST TO FOOL LSTX1 TO INITIALIZE STB SLST LST FROM START. JSB LSTX1 ANY UNDEFINED ? JMP MSGP9 NO - THEN DON'T OUTPUT MESSAGE LDA LSTX SET ACTUAL VALUE OF SLST BACK STA SLST LIUND LDA P6 LDB MESSM PRINT "MAIN'S" JSB SYOUT JSB PUDF GO REPORT THE UNDEFINEDS LDA FORCD GET THE FORCE LOAD FLAG SSA,RSS DO WE IGNOR UNDEFS ? JMP ABORT NO SO ABORT THYSELF. MSGP9 LDA LSTX RESET ORIGNAL VALUE OF SLST STA SLST LDA MTMP SZA,RSS TRANSFER IF NO JMP NTRM0 BASE PAGE. * LDA MTMP+1 RESET "MAIN" WORDS. STA FWA FWA LDA MTMP+2 STA PPREL PPREL LDA MTMP+3 STA DBLAD DBLAD LDA MTMP+4 STA ABT13 FWABP LDA MTMP+5 STA CWABP CWABP CLA SET STARTING TRACK STA STRAK AND SECTOR FOR STA SSECT PROG = 0. CLA,INA SET BP OUTPUT STA ABT12 FLAG. MSGP7 LDA ABT13 IF CURRENT ABT13 = LAST USED CPA CWABP BASE PAGE ADDR, JMP NTRM0 THEN FINISHED. * LDA ABT13,I OUTPUT CURRENT LINK WORD LDB DBLAD JSB ABOUT ISZ DBLAD UPDATE ISZ ABT13 ADDRES JMP MSGP7 AND CONTINUE MTMP OCT 0,0,0,0,0,0 TEMP STORAGE FOR "MAIN" P17 DEC 17 P9 DEC 9 MESSM DEF *+1 ASC 3,MAIN'S SKP * * CHECK FOR AND DO NORMAL ON-LINE LOAD TERMINATION * FOR A MAIN OR SEGMENT , OR FOR MAIN AND SEGMENTS * IF NO EDITING. * NTRM0 JSB DWRIT DUMP LAST OF BASE PAGE LDB EMABP GET THE EMA FLAG SZB,RSS ANY EMA DECLARED ? JMP NTRM. NO. * LDA MSGSZ GET THE SUPPLIED MSEG SIZE SZA WAS ANY SUPPLIED JMP SETMS YES * LDA B,I GET THE EMA DEFINING ADDRESS ALF )% & CONVERT TO PAGE # RAL,RAL CMA ACCOUNT FOR I/O OVERFLOW ADA P32 NOW HAVE MAX POSSIBLE MSEG * STA MSGSZ NO, USE MAX POSSIBLE SETMS ADA MSIGN NOW SET NON STANDARD MSEG BIT STA IDEX1,I AND PUT IN DUMMY ID SEGMENT * LDA EMASZ GET THE EMA SIZE LDB EMABP,I & START PAGE OF MSEG RBL PLACE INTO PROPER FIELD SZA,RSS WAS EMA SIZE DEFAULTED ? ADB M2000 YES, SO SET DEFAULT BIT STB IDEX2,I & PLACE IN DUMMY ID * LDA URFWA NOW CHECK OUT EMA SIZE ALF FIRST GET PROG SIZE RAL,RAL AND M37 CMA,INA LDB EMABP,I GET NEXT PAGE ADDRESS BLF RBL,RBL ADB A NOW HAVE PROG SIZE ADB EMASZ NOW HAVE REQ'D SIZE CMB,INB STB MESSM SAVE IT * LDA #PTTN WAS A PARTITION SPECIFIED ? SZA,RSS WELL ? JMP GTMCN NO * CCA YES ADA #PTTN MPY P7 INDEX TO PROPER ENTRY ADA P4 XLA A,I GET THE AND B1777 # OF PAGES * JMP GTMC1 * GTMCN XLA $MCHN GET MAX SIZE SZA IS IT 0. JMP GTMC1 NO XLA $MBGP ASSUME BG LDB PTYPE CPB P2 IS IT ? RSS NO JMP *+3 XLA $MRTP NO * GTMC1 ADA MESSM NOW ADD IN SIZE SSA OK ? JMP LL21 NO. * NTRM. LDA SHIGH,I CALCULATE # OF PAGES VALUE FOR ID SZA,RSS PROG SEGMENTED ? LDA TPREL NO * LDB URFWA GET LOAD POINT CMB MAKE NEG (ACCOUNT FOR HIGH MAIN '+' 1 ADA B A = # OF WORDS OF CODE ALF NOW ACCOUNT FOR PAGES RAL,RAL AND M37 ADA P2 ACCOUNT FOR BASE PAGE & CURRENT PAGE STA MES11+1 SAVE FOR # OF PAGES RELOCATED MESSAGE LDB #PGS GET AN#Y SUPPLIED SIZE SZB,RSS ANY SUPPLIED ? STA #PGS NO, SO USE CODE SIZE * CCB OK, SO BUILD ID SEG WORD 22 ADB #PTTN PUT PART'N WORD IN BITS 0-5 CCE,SSB SET BIT 15 IF PARTITION REQUESTED CLB,RSS IF NO PARTITION THE SET TO 0 RBL,ERB * CCA GET # PGS REQ'D LESS BP ADA #PGS ADA MSGSZ ADD IN MSEG SIZE ALF,RAR # PGS IN BITS 14 - 10 IOR #MPFT MEM PROT FENCE INTO BITS 9-7 ALF,ALF RAR IOR B SAVE THE WORD STA PG.PT FOR THE MVIDS ROUTINE * * LDA FWABP SET UP ADDR ADA N20 OF DUMMY STA IDA ID SEGMENT. LDA ID# SET NEGATIVE CMA,INA INDEX FOR NUMBER OF STA ID## DUMMY ID SEGMENTS. LDA EDFLG CHECK FOR SZA LOADING OPERATION JMP ED00 -EDITING * * CONTROL TRANSFERS HERE FOR TEMPORARY LOADS & FOR PERM LOADS * WHERE NO PREVIOUS DISC SPACE IS AVAILABLE FOR THE PROG. * NTRM7 LDA IDA ADA P4 GET ADDR OF MEM1 LDB ID## CMB,INB CPB ID# ADA P4 STA ED61 AND SAVE IT. JSB C#S COMPUTE # OF SECTORS NEEDED STA ABT13 AND SAVE FOR LATER. LDB ED61 GET ADDR OF MEM1 ADB P4 AND SET (B)=DMAIN'S ADDR LDA B,I GET DMAN AND M177 ISOLATE SECTOR STA ED62 ADDR AND SAVE. LDA B,I GET DMAN AGAIN ALF,ALF ISOLATE RELATIVE STARTING RAL TRACK NUMBER AND AND M377 ADD BASE TRACK NUMBER. ADA TRAKB STA TRAKP SAVE ABSOLUTE TRACK ADDR ALF,RAL RAL,RAL STA ABT11 SAVE POSITIONED TRACK # LDA TRKLU GET LU OF USER TRACKS CLE,ERA PUT 0 OR 1 FOR LU2 OR CLA LU3 RESPECTIVLY ERA PUT BIT IN (A) IOR ABT11 MERGE yIN TRACK IOR ED62 AND SECTOR ADDRES. STA B,I STORE REAL ADDR IN DMAN LDA EDFLG GET EDIT FLAG SZA EDIT OPERATION ? JMP NOSET YES LDB IDA NO, THEN SET BIT7 OF ADB P3 NAM5 WORD OF ID SEG LDA ID## CMA,INA TO INDICATE THAT CPA ID# 'PROG IN CORE ONLY'. INB LDA B,I GET NAM5 WORD IOR B200 MERGE IN BIT7 STA B,I STORE BACK IN NAM5 * NOSET LDA ABT13 GET # OF SECTORS REQD CLB DIVIDE BY # OF SEC/TRK DIV TRKS# TO FIND # OF TRKS REQD. SZB IF REMAINDER INA THEN BUMP TO WHOLE TRK. STA #TRAK SET AS NUMBER OF TRACKS LDA EDFLG GET EDIT FLAG SZA,RSS IF NOT DOING EDIT OPERATION JMP NTRM5 THEN DO NOT COMPRESS TRACKS. * * DETERMINED FOR MAIN/SEGMENT LOAD IF SEMENTS * HAVE TO BE COMPRESSED (MOVED UP ON USER * TRACKS IF PREVIOUS SEGMENTS OR MAIN HAVE * BEEN STUFFED IN SYSTEM AVAILABLE AREA). * LDA ID## CMA,INA CPA ID# IF PROCESSING MAIN JMP NTRM5 THEN DO NOT MOVE. LDB IDA GET CURRENT DUMMY ID SEG ADDR ADB P17 (B)=DMAN ADDR OF PREVIOUS ID LDA ID## ADA ID# CPA P1 PROCESSING FIRST SEG ? ADB P4 YES, ADJUST DMAN'S ADDR. LDA B,I GET DMAN SSA IF PREVIOUS SEG/MAIN ON LU3 JMP NTRM5 THEN TOO DO NOT MOVE CMA,INA MAKE DMAN NEGATIVE AND ADA DSCLB ADD TO DISC LIB ADDR SSA DMAN POINT TO SYSTEM AREA ? JMP NTRM5 NO, THEN TOO DO NOT MOVE. LDA ID## ADA ID# CPA P1 IF PROCESSING FIRST SEGMENT JMP MOVEB THEN MOVE TO START OF USER TRKS CMA,INA SET NEG INDEX FOR NUMBER OF STA ED61 DUMMY IDS TO BE UPDATED. UPID ISZ ED61 REACHED MAIN'S ID ? RSS NO3, THEN SKIP. ADB P4 YES, ADJUST DMAN'S ADDR. LDA B,I GET DMAN SSA IS THIS SEG ON LU 3 ? JMP MOVER YES, MOVE TO WHERE HE LEFT OFF. CMA,INA NO, THEN SUBTRACT FROM ADA DSCLB LIB ADDR SSA THIS SEG ON USER TRAKS ? JMP MOVER YES, MOVE TO WHERE HE LEFT OFF. LDA ED61 SZA,RSS EXAMINED MAIN'S ID ? JMP MOVEB YES, MOVE TO START OF USER TRKS. ADB P9 (B)=DMAIN ADDR OF PREVIOUS ID JMP UPID EXAMINE NEXT ID SKP * DETERMINE WHERE LAST SEGMENT OR MAIN LEFT OFF * ON USER TRACKS. * B200 OCT 200 * MOVER LDA B,I SAVE DMAN OF LAST ID STA BID2 POINTING TO USER TRACKS. LDA B ADA N4 (A)=ADDR OF MEM1 JSB C#S DETERMINE NUMBER OF SECTORS STA BID1 AND SAVE THE NUMBER LDA BID2 GET DMAN AND M177 GET SECTOR ADDR ADA BID1 ADD TO TOTAL REQUIRED CLB DTERMINE TRACK OFFSET BY DIV TRKS# DIVIDING BY SECS/TRK STA BID1 SAVE NUMBER OF TRACKS LDA BID2 GET DMAN AGAIN ALF,ALF MASK IN RAL TRACK AND M377 ADDR (RELATIVE) ADA BID1 ADD TRK OFFSET FOR MOVE STA ED66 SET AS DESTINATION TRACK STB ED67 AND SET DESTINATION SECTOR JMP SHIFT GO DO MOVE * DESLU NOP IDCNT NOP * * MOVE TO BEGINNING OF USER TRACKS * MOVEB LDA TRAKB GET BASE TRACK ADDR STA ED66 SET DESTINATION TRACK CLB AND SECTOR TO VERY STB ED67 BEGINNING. * * * MOVE CURRENT AND REMAINING SEGMENTS * UPWARD ON USER TRACKS. * SHIFT LDB ID## SET # OF SEGS TO BE MOVED STB IDCNT INCLUDING CURRENT LDA DSKUN SET DESTINATION LU STA DESLU OF USER TRACKS LDB IDA SET ADDR OF ID SEG STB BID2 BEING PROCESSED. LDA ED66 NLH GET TARGET TRACK NUMBER CPA TRAKP SAME AS SOURCE TRACK # ? CLA,RSS YES, THEN SKIP. JMP DIFTR NO (ATLEAST 1 TRK DIFFERENCE) LDB ED67 GET TARGET SECTOR ADDR CMB,INB MAKE NEGATIVE TO GET REMAINDER JMP SAMTR GO FIND REMAINING SECS ON TRK DIFTR INA GET NUMBER OF TRACKS CMA,INA TO BE ADA TRAKP SHIFTED THROUGH MPY TRKS# CONVER TO NUMBER OF SECTORS LDB ED67 GET DESTINATION SEC ADDR CMB,INB SUBTRACT FROM SECS/TRK ADB TRKS# TO NUM LEFT ON TRACK. SAMTR ADB ED62 ADD TO OFFSET FROM SOURCE ADB A ADD FOR TRACK OFFSET CMB,INB MAKE NEGATIVE STB BID1 SAVE NEGATIVE SEC OFFSET CLA CLEAR NUMBER STA ED21 OF SECS TO BE MOVED. * * UPDATE DMAN OF CURRENT AND REMAINING * ID SEGMENTS AND DETERMINE TOTAL NUMBER * OF SECTORS TO BE MOVED. * LDA BID2 GET ID SEG ADDR OF CURRENT ID MORID ADA P4 (A)=ADDR OF MEM1 1-N JSB C#S FIND # OF SECS FOR THIS ID ADA ED21 ADD TO TOTAL NUMBER OF STA ED21 SECTORS TO BE MOVED. LDB BID2 ADB P8 (B)=DMAN'S ADDR LDA B,I GET DMAN AND M177 ISOLATE SECTOR ADDR STA BID4 SAVE SECTOR ADDR TEMPORARILY LDA B,I GET DMAIN AGAIN ALF,ALF POSITION RAL AND AND M377 MASK IN RELATIVE TRK ADDR MPY TRKS# GET EQUIVALENT SEC COUNT ADA BID4 ADD SECTOR OFFSET (ADDR IN SECS) ADA BID1 DECREMENT BY SEC OFFSET CLB,CCE (A)=NEW ADDR IN SECS DIV TRKS# GET RELATIVE TRK & SEC ADDR ALF,RAL POSITION REL TRK ADDR RAL,RAL IOR B MERGE IN SECTOR ADDR LDB DSKUN GET THE CURRENT DISC LU CPB P3 IS IT LU 3 ? RAL,ERA THEN DON'T FORGET THE SIGN BIT. LDB BID2 ADB P8 (B)=ADDR OF DMAIN STA B,I UPDATE DMAIN ISZ IDCNT ALL IDS UPDATED ? RSS NO JMP FSHFT YES, GO MOVE USER TRACKS. LDA BID2 SET ADDR OF NEXT ADA N9 ID SEGMENT (EXTENDING STA BID2 DOWNWARD IN CORE) JMP MORID UPDATE NEXT ID * * MOVE USER TRACKS FSHFT LDA ED21 SET NEGATIVE NUMBER CMA,INA NUMBER OF TRACKS TO STA ED21 BE MOVED. JSB ED15 MOVE USER TRACKS * * NTRM5 LDB IDA GET CURRENT ID SEG ADDR ADB P8 (B)=ADDR OF DMAN LDA ID## CMA,INA CPA ID# IF PROCESSING MAIN'S ADB P4 THEN ADJUST ADDR OF DMAN LDA B,I GET DMAN ALF,ALF POSITION AND RAL ISOLATE ACTUAL AND M377 STARTING TRACK NUMBER STA BID2 SAVE IT LDA B,I GET DMAIN AGAIN AND M177 GET SECTOR OFFSET CMA,INA,SZA,RSS IF NO OFFSET JMP TRBDY THEN NO SPECIAL FIX ADwA TRKS# GET SEC LEN - OFFSET CMA,INA TO GET # OF SECS USED IN 1ST TRK ADA ABT13 SUBRTRACT FROM TOTAL SECS NEEDED SSA CROSSED TRACK BOUNDARY ? JMP NTRM9 NO - THEN TAT OK. CLB YES - THEN FIND TRACKS REQD. DIV TRKS# (EXCLUDING OFFSET) SZB IF REMAINDER INA THEN BUMP TO WHOLE TRACK STA #TRAK SET NEW TRACK LENGTH ISZ BID2 ALSO FORGET ABOUT FIRST TRACK TRBDY LDA #TRAK SET NUMBER OF CMA,INA,SZA,RSS TRKS AS NEGATIVE COUNT. JMP NTRM9 TAT OK IF ON TRK BOUNDARY STA ABT1 COUNT. LDA TRKLU SET (B) = FWA OF LDB TATSD SYSTEM CPA P2 OR AUXILIARY CLB DISC'S TRACK BASE ADB TAT ADB BID2 (B)=ADDR IN TAT STB ABT2 SAVE TAT'S ADDR * NTRM2 LDA MSIGN (A)=100000 FOR SYSTEM ASSIGNED. LDB ABT2 (B)= TAT ADDR JSB SYSET SET VALUE IN TAT CLA CHECK CPA EDFLG OPERATION JMP NTRM8 -NORMAL LDA MSIGN -EDITING- CHANGE LDB ABT2 WORD IN JSB SYRUW TAT ON DISC NTRM8 ISZ ABT2 ADD 1 TO TAT ADDR. ISZ ABT1 INDEX TRACK # COUNTER. JMP NTRM2 -DO NEXT TRACK. * * * DO FINAL ID SEGMENT PROCESSING * NTRM9 CLB CLA,INA (A)=1 FOR ADDITION CPB EDFLG IF NOT EDITING CLA THEN (A)=0 FOR NORMAL LOAD LDB ED25 (B)=ADDR OF TARGET ID IF ANY JSB MVIDS MOVE DUMMY TO REAL ID JSB FIX FIX FOR TRYING LONG TO SHORT MOVE CLA CPA MSEG DOING MAIN/SEGMENT LOAD JMP NTRM4 NO, THEN TERMINATE. JMP *+1,I YES, SET UP FOR NEXT SEG. DEF ED183 (SAVE A BP LINK TOO !) * SPC 1 NTRM4 LDA MES11+1 GET THE # OF PAGES RELOCATED JSB CNV99 CONVERT TO ASCII STA MES11+1 AND PUT INTO USER INFO BUFFER ^j* LDA PLIST SLA LOADR LISTING SUPPRESSED? JMP PTNCK YES, SKIP #PAGES MESS. JSB SPACE * LDB P3 STB OPCOD SPECIFY DECIMAL CONVERSION * * LDA EMABP SZA,RSS ANY EMA ? JMP LOUT NO . LDA MSGSZ YES JSB CNV99 GET ASCII MSEG SIZE STA AMSEG+2 LDA EMASZ GET EMA SIZE SZA,RSS DEFAULTED ? JMP EDFLT YES LDB AEMAD GET ADDRESS OF ASCII JSB CONVD CONFERT IT JMP LOUT * EDFLT LDA N4 JSB MOVE DEF IDFLT DEF AEMA+2 * LOUT LDA #PGS GET # OF PAGES OF CODE LDB EMABP AND EMA DECLARATION SZB,RSS ANY EMA ? JMP *+4 NO ADA EMASZ YES, SO ADD EMA SIZE CPA #PGS IF DEFAULTED INA ADD 1 LDB PGRQD GET ADDRESS JSB CONVD AND CONVERT TO ASCII * * LDA P72 GET CHAR COUNT LDB MES11 & ADDRESS JSB DRKEY NOW GO TELL THGE FOLKES * * PTNCK LDB PTYPE CHECK #PAGES REQ'D DOESN'T LDA #MXBG CPB P2 RT OR BG PROG LDA #MXRT * INA ADD 1 FOR BASE PAGE LDB #PGS CMB,INB ADB A #PAGES REQ'D SSB > MAX ? JSB WN.17 YES, GIVE WARNING JMP DONE FINISHED * * * ISSUE WARNING FOR CODE EXCEEDING PTTN SIZE * CALL SEQUENCE: JSB WN.17 * WN.17 NOP LDA P4 (A)=CHAR COUNT LDB WNG17 (B)=MESSAGE ADDR JSB SYOUT PRINT: 'W 17' JMP WN.17,I RETURN * WNG17 DEF *+1 ASC 2,W 17 CODE > PTTN SIZE * MES11 DEF *+1 ASC 18,00 PAGES RELOCATED 0000 PAGES REQ'D AEMA ASC 9, NO PAGES EMA AMSEG ASC 9, NO PAGES MSEG MS11# EQU MES11+1 P72 DEC 72 PG.PT NOP WORD 22 OF ID SEG OF MAIN AEMAD DEF AEMA PGRQD DEF MES11+10 IDFLT ASC 4,DEFAULT DEF#C DEF *+1 #CODE ASC 12,00 PAGES OF CODE LOADED * SPC 1 DONE LDA #IDAD INA GET ADDR OF ID TEMP AREA LDB #IDAD ADB P10 GET ADDR OF B-REG SAVE WORD STB WORD WITHIN THE ID SEG JSB SYSET SET TEMP ADDR IN B LDB EDFLG SZB,RSS JMP *+3 LDB WORD IF PERMANENT, UPDATE JSB SYRUW ID SEG ON DISC TOO * LDA P12 LDB MESS4 MESS4 = ADDR: XXXXX READY ETC. JSB SYOUT PRINT: XXXXX READY - LOADING ETC * * * EXIT JSB SPACE DO A LINE FEED LDA P4 SET UP TO LDB ENDMS SEND END MESSAGE. * LTERM JSB SYOUT SEND TERMINATE MESSAGE * * LDB BATCH GET BATCH FLAG * LDA OPCOD GET OP CODE * CPA P4 IS IT DELETE ? * SZB YES - NON-BATCH OPERATION ? * JMP DLEN NO - THEN GO THROUGH PAGE-EJECT * JMP EXIT1 AVOID PAGE EJECT FOR NON-BATCH DELETE DLEN LDA PLIST GET LIST/NO LIST FLAG CPA P3 SKIP PAGE EJECT IF JMP EXIT1 NOT LISTING ANYTHING AT ALL * LDA TYPE3 GET THE LIST TYPE ERA,SLA FILE OR LU ? JMP EXIT1 FILE. PAGE EJECT NOT NECESSARY * LDA LISTU GET THE LIST LU AND M77 TO A IOR M1100 SET THE PAGING BITS STA RELAD SET FOR EXEC CALL JSB EXEC DEF *+4 CALL TO EJECT A PAGE ON A DEF P3 PRINTER OR DEF RELAD SPACE 2 LINES ON DEF N2 A TTY * * EXIT1 JSB EXEC RELEASE DEF *+3 ANY TRACKS DEF P5 NOT DEF N1 ACCOUNTED FOR. * * JSB FCLOS CLOSE ALL OPEN FILES * * * PASS BACK PROG NAME TO BATCH MONITOR * JSB PRTN CALL ROUTINE DEF *+2 DEF PRAM ADDR OF NAME BUF * SPC 1 JSB EXEC REQUEST PROG COMPLETION DEF *+2 DEF P6 6 = PROG COMPLETION CODE SPC 1 $END ASC 2,$END M1100 OCT 1100 SPC 1 xRELAD BSS 1 RELATIVE BG ADDR M40 OCT 40 TEMPP BSS 1 ABSOLUTE PROG WORD LELAD DEC -1 OFFSET INTO CURRENT LOAD MODULE ABWRD NOP SAVED ABSOLUTE PROG WORD ENDMS DEF $END SKP * P21 DEC 21 * SUBROUTINE: "MEM?" IDENTIFY LONG/SHORT ID SEGMENT * * THIS SUBROUTINE IDENTIFIES WHETHER THE ID SEGMENT * UNDER CONSIDERATION IS LONG OR SHORT. * * (NOTE: THIS ROUTINE NOT USED FOR DUMMY ID SEGMENTS * SET UP BY THE LOADER) * * CALL: (B)=ADDRESS OF NAM5 WORD IN ID SEGMENT * (P) JSB MEM? * * RETURN (P+1) FOR SHORT ID SEGMENT * (P+2) FOR LONG ID SEGMENT * REG-B = ADDRESS OF MEM1 IN ID SEGMENT. * REG-A = OCT 20 IF (P+1) RETURN * = 0 IF (P+2) RETURN * * MEM? NOP XLA B,I GET NAM5 WORD FROM ID SEG AND M20 MASK IN 'SS' BIT INB (B)=MEM1 ADDR OF SHORT ID SZA LONG ID ? ('SS' BIT = 0) JMP MEM?,I NO, SHORT ID RETURN. ADB P7 (B)=MEM1 ADDR OF LONG ID ISZ MEM? BUMP TO (P+2) RETURN JMP MEM?,I LONG ID RETURN * SKP * SUBROUTINE: "MIDN" MATCH ID SEGMENT NAME * * THIS ROUTINE SEARCHES THE SYSTEM ID SEGMENTS * TO FIND A MATCH WITH THE NAME IN THE CURRENT * DUMMY ID SEGMENT. * * CALL: (P) JSB MIDN * (P+1) -NO MATCH RETURN- * (P+2) -MATCH RETURN, ID SEG ADDR IN ABT1 AND (B) * MIDN NOP LDA KEYWD INITIALIZE STA ABT1 KEYWORD LIST ADDR. * MIDN1 XLB ABT1,I IF END-OF-LIST, SZB,RSS RETURN TO JMP MIDN,I NO MATCH RETURN, P+1. * ADB P12 COMPARE XLA B,I NAME CPA NAM12,I AREAS INB,RSS OF JMP MIDN2 DUMMY ID SEG. XLA B,I AND CPA NAM34,I CURRENT INB,RSS SYSTEM ID SEG. JMP MIDN2 XLA B,I STA BLKID SAVE THE TYPE WORD AND M7400 STA B LDA NAM5,I AND M7400 CPA B JMP MIDN3 MATCH - MIDN2 ISZ ABT1 INDEX FOR NEXT ID SEGMENT- JMP MIDN1 CONTINUE SCAN. * MIDN3 ISZ MIDN MATCH - ADJUST RETURN TO (P+2) XLB ABT1,I (B) = ADDR OF MATCH ID SEG. LDA BLKID GET THE ID WORD AND P7 STRIP TO TYPE CPA P1 RESIDENT JMP ERL11 ERROR GO SEND MESSAGE AND ABORT JMP MIDN,I RETURN. SPC 1 ERL11 LDA ASL11 SEND L11 MESSAGE JMP ABOR AND ABORT SPC 2 ASL11 ASC 1,11 * * CONVERT TO DECIMAL ASCII (MAX VALUE = 99) * CALL SEQUENCE: LDA VALUE * JSB CNV99 * STA ASCII * CNV99 NOP QUICK CONVERSION CLB BINARY TO DECIMAL ASCII DIV P10 MAX VALUE = 99 SZA ADA M20 FORCE LEADING BLANK IF ZERO ADA M40 ALF,ALF PUT IN LEFT HALF IOR B FILL UNITS IN RIGHT IOR B60 JMP CNV99,I RETURN ASCII IN (A) B60 OCT 60 SKP UREAD NOP DISC READ SUBROUTINE JSB EXEC READS 64 WORDS DEF *+7 DEF P1 DEF P2 ALBUF DEF LBUF DEF P64 DEF TRACK DEF SECTR JMP UREAD,I * TRACK NOP SECTR NOP * * * * THIS ROUTINE CONVERTS A MEMORY OP SYS ADDRESS TO A DISC * ADDRESS. ON INPUT A REG = LOCATION (MEMORY ADDRESS) * * TRK NOP GENERAL MEMORY TO DISC ADDRESS CONVERSION SUBROUTINE CLB WILL NOT WORK FOR BASE PAGE LOCATIONS ! ADA DM1K SUBTRACT 1024 DIV D6144 DIVIDE BY TRK SIZE STA TRACK WE NOW HAVE THE TRACK LDA B CLB GET READY FOR ANOTHER DIVIDE DIV P64 DIVIDE BY SECTR SIZE STB WORD WORD = WORD OFFSET IN SECTR (0 - 63) ADA D18 ADD IN STARTING SECTR OF OP SYS STA SECTR SECTR = SECTOR WHERE THE WORD IS LDB SECT2 CHECK FOR SECTOR OVERFLOW CM B,INB ADA B SSA TOO MANY SECTERS ? JMP TRK,I NO STA SECTR OPPS , TOO MANY ISZ TRACK INCREMENT TO THE NEXT TRACK JMP TRK,I NOW GO BACK * * DM96 DEC -96 DM1K DEC -1024 D6144 DEC 6144 WORD NOP D18 DEC 18 *THIS IS A GENERAL PURPOSE DISC PATCH SUBROUTINE * CALLING SEQUENCE JSB SYRUW * A REG = MEMORY ADDRESS (LOCATION) * B REG = REPLACEMENT VALUE * THE MEMORY LOCATION WILL BE CHANGED TO A DISC ADDRESS * AND THE CONTENTS OF THE B REG WILL BE PLACED THERE * THIS ROUTINE SHOULD ONLY BE USED TO MODIFY OP SYSTEM * LOCATIONS !!!!!! * SYRUW NOP UPDATE $BGFR & $RTFR ON DISC SWP FIX FROM DFINE TO WORK IN LOADR (CMM) STB UPDT1 JSB TRK GET THERE TRACK ADDRESS JSB UREAD READ THEIR SECTOR LDA WORD GET THE ADDRESS ADA ALBUF WITHIN THE SECTOR LDB UPDT1 GET CONTENTS OF THE NEW $RTFR WORD STB A,I STICK IT INTO THE BUFFER * ISZ P1 NOW MAKE IT A WRITE JSB UREAD PATCH ON DISC CLA,INA FIX P1 STA P1 JMP SYRUW,I UPDT1 NOP * SKP * OUTPUT ABSOLUTE PROG WORD * * ABOUT PUTS OUT THE CURRENT ABSOLUTE PROG WORD. * * IF THE CURRENT PROGRAM WORD IS TO BE LOCATED IN A DIFFERENT * SECTOR FROM THE CURRENT SECTOR, THE CURRENT SECTOR IS WRITTEN ON * THE DISK AND THE APPROPRIATE SECTOR READ. * * * CALLING SEQUENCE: * A = CURRENT PROGRAM WORD * B = ADDRESS * DTBL SET UP AS FOLLOWS: *DTBL DEF BASE MEMORY ADDRESS * DEF BASE TRACK OFSET -STRAK * DEF BASE SECTOR OFSET -SSECT * * JSB ABOUT * * RETURN: CONTENTS OF A AND B ARE DESTROYED * ABOUT NOP STB TEMPQ SAVE THE ADDRESS STA TEMPP SAVE ABSOLUTE PROG WORD LDA DTBL,I SUBTRACT FWA OF CMA,INA AREA FROM CURRENT ADA B ADD CURRENT IRELOCATION ADDR. STA RELAD SAVE RELATIVE ADDR. LDA MSIGN SET ABT14 TO INA BE 100001 FOR NO SUSPENSION, STA ABT14 1 TRACK ALLOCATION. * CLA,INA IF FLAG SAYS DUMMY BASE PAGE CPA ABT12 AREA IS BEING OUTPUT, JMP AB0 SKIP OVERFLOW CHECK. * CMB,INB FROM LWA OF AREA. ADB LWA -ERROR SSB IF AREA IS JMP LGERR EXCEEDED. * AB0 CLB DIVIDE RELATIVE ADDR LDA RELAD BY 64 (SECTOR SIZE). DIV P64 STB SPOS SAVE REMAINDER (POSITION) ADA DTBL+2,I ADD STARTING SECTOR OF PROG.=0 IF MAIN CLB DIVIDE BY # OF DIV TRKS# SECTORS PER TRACK. CLE SET FOR ERB,RBL EVEN SECTOR BOUNDARIES STB TSECT SAVE SECTOR # IN TRACK. LDB P64 SEZ,RSS IF SECTOR WAS ODD JMP *+3 * ADB SPOS OFFSET POSITION TBY 64 STB SPOS ADA DTBL+1,I ADD THE PGRM BASE TRACK AND(=0 IF MAIN) STA B SAVE FOR TEST OF OVERFLOW ADA TRAKB ADD IN TRACK BASE ADDR. STA TTRAK SAVE AS ABSOLUTE TRACK # LDA #TRAK SUBTRACT # OF TRACKS ALLOCATED CMA,INA FROM RELATIVE TRACK #, ADA B A POSITIVE RESULT MEANS TRACK SSA,RSS OVERFLOW, GO TO JMP AB3 OVERFLOW SECTION. * * TRACK/SECTOR OF CURRENT WORD IS DETERMINED. * LDA TTRAK CHECK FOR CURRENT TRACK/SECTOR CPA DTRAK = TRACK/SECTOR IN CORE. RSS TRACKS =. JMP AB1 LDA TSECT CHECK FOR SECTOR CPA DSECT # NEEDED. JMP AB2 -CURRENTLY IN CORE. * * WRITE OUT SECTOR IN CORE, READ IN NEW SECTOR * AB1 JSB DWRIT WRITE CURRENT SECTOR. LDA TTRAK SET STA DTRAK NEW LDA TSECT TRACK/SECTOR #'S. STA DSECT JSB DREAD READ IN DESIRED SECTOR. * AB2 LDg\B ADBUF ADD POSITION IN SECTOR OF NEW ADB SPOS WORD TO ADDR OF DBUF. LDA TEMPP STORE ABSOLUTE WORD INTO STA B,I DBUF CLA,INA RETURN IMMEDIATELY IF DUMMY CPA ABT12 BASE PAGE AREA IS JMP ABOUT,I BEING OUTPUT * * CHECK FOR NEW UPPER BOUND * LDA TEMPQ ABSOLUTE LOAD ADDR, INA ADD 1, STA B SAVE. CMA,INA -SUBTRACT THIS ADDR ADA TPREL FROM CURRENT UPPER BOUND, SSA IF CURRENT IS LARGER, * * SET UP TPREL HIGH LOAD +1 !!!!!!!!!!!!! * STB TPREL SET NEW ADDR. LDA MSEG GET THE MSEG FLAG CPA P2 THIS A SEGMENT ? RSS YES. JMP ABOUT,I NO, JUST RETURN LDA SHIGH,I GET THE PAST HIGH CMA,INA ADA B IS THIS HIGH BIGGER ? SSA,RSS WELL ? STB SHIGH,I YES, SO SET UP NEW HIGH MAIN +SEG + 1 JMP ABOUT,I * TEMPQ NOP * * * OVERFLOW OF TRACK ALLOCATION * AB3 JSB EXEC ASK FOR 1 TRACK DEF *+6 DEF P4 DEF ABT14 1 TRACK. DEF ABT1 -STARTING TRACK # - DEF ABT2 -LOGICAL UNIT # - DEF ABT3 -# SECTORS PER TRACK- * CCA CPA ABT1 IF NO TRACK AVAILABLE, JMP AB4 GO TO PRINT WAITING MESSAGE. * LDA ABT2 CHECK IF NEW TRACK ON SAME CPA TRKLU DISC (LOGICAL UNITS =) RSS -YES JMP AB10 -NO, LDA TRAKB CHECK FOR NEW TRACK TO ADA #TRAK BE NEXT CONTIGOUS TO CMA,INA SUBTRACT FROM ADA ABT1 NEW ALLOCATION SZA IF CONTIGOUS SKIP JMP AB5 ELSE GO TEST FURTHER JSB RELLO RELEASE ANY TRACKS BELOW THE NEEDED ISZ #TRAK ADD 1 TO # OF TRACKS JMP AB0 CONTINUE. * * PRINT WAITING MESSAGE AND REPEAT 1 TRACK CALL * AB4 LDA P22 PRINT: 5?LDB ITRKM "WAITING FOR DISC SPACE" JSB SYOUT CLA,INA RESET FOR SUSPENSION, STA ABT14 1 TRACK, JMP AB3 REPEAT CALL. SPC 1 AB5 SSA,RSS IF NEW TRACK BELOW CURRENT AREA JMP AB10 SKIP, ELSE GO SET TO MOVE JMP AB3 GO TRY ANOTHER ALLOCATION SPC 1 * * NOT CONTIGUOUS, RELEASE LATEST AND ALLOCATE * COMPLETE NEW SET OF TRACKS. * AB10 JSB EXEC RELEASE ONE DEF *+5 TRACK DEF P5 JUST DEF P1 ALLOCATED DEF ABT1 DEF ABT2 * JSB RELLO RELEASE ALL TRACK BLOW CURRENT LDA #TRAK SAVE STA ABT1 CURRENT LDA TRAKB VARIBLES STA ABT2 ASSOCIATED STA ABT9 LDA TRKLU WITH STA ABT3 TRACK LDA TRKS# ALLOCATION STA ABT4 LDA SSECT STA ABT5 LDA STRAK STA ABT6 * JSB DWRIT WRITE OUT CURRENT SECTOR. ISZ #TRAK JSB ITRAK LARGER THAN PREVIOUS. * LDA ABT2 OLD TRAKB + OLD #TRAK ADA ABT1 TO ABT7 FOR LIMIT STA ABT7 ON MOVE. LDA TRAKB STA ABT8 CLA SET STARTING STA ABT10 SECTOR # = 0 FOR BOTH STA ABT11 SOURCE AND DESTINATION TRACKS. * * MOVE PREVIOUS INFORMATION TO NEW SET OF TRACKS * AB11 JSB EXEC READ SECTOR DEF *+7 DEF P1 DEF ABT3 SOURCE LOGICAL UNIT DEF DBUF DBUF INPUT DEF P128 DEF ABT9 CURRENT TRACK DEF ABT10 CURRENT SECTOR * JSB EXEC WRITE SECTOR DEF *+7 DEF P2 DEF TRKLU DESTINATION LOGICAL UNIT DEF DBUF DEF P128 DEF ABT8 CURRENT TRACK DEF ABT11 CURRENT SECTOR * LDA ABT10 UPDATE SOURCE ADA P2 SECTOR #. CPA ABT4 IF = TO # SECTORS PER TRACK, CLA RESET TO ZERO STA ABT1ւ0 AND RESTORE. SZA,RSS IF RESET ISZ ABT9 ADD 1 TO CURRENT TRACK #. LDA ABT9 CHECK FOR TERMINATION CPA ABT7 TRACK #. JMP AB12 -YES. * LDA ABT11 UPDATE DESTINATION ADA P2 SECTOR #. CPA TRKS# IF = TO # SECTORS PER TRACK CLA RESET TO ZERO STA ABT11 AND RESTORE. SZA,RSS IF RESET, ISZ ABT8 ADD 1 TO CURRENT TRACK #. LDA TRAKB CHECK FOR POSSIBLE ADA #TRAK OVERFLOW OF NEW CPA ABT8 ALLOCATION. HLT 0 ?????????????????????????????????????? JMP AB11 -NO, CONTINUE COPY * AB12 LDA TRAKB SET UP "DREAD" STA DTRAK AND CLA READ IN SECTOR 0 STA DSECT OF FIRST TRACK JSB DREAD TO INITIALIZE. * * RELEASE OLD SET OF TRACKS * JSB EXEC DEF *+5 DEF P5 DEF ABT1 DEF ABT2 DEF ABT3 * LDA ABT5 RESET RELATIVE STA SSECT STARTING TRACK AND SECTOR LDA ABT6 FOR CURRENT STA STRAK LOAD. * * ADJUST RELATIVE DMAN IN SEGMENTS' IDS IF * PROCESSING SEGMENTS (MAIN'S RELATIVE * DMAN IS ALREADY SET UP - ZERO). * CLA,INA CPA ID# IF PROCESSING SEGMENTS RSS JMP AJST THEN ADJUST THEIR DMAN * * CHECK FOR DIFFERENT SIZE DISCS * LDA ABT4 IF # OF SECTORS IS THE SAME CPA TRKS# ON BOTH ALLOCATIONS, JMP AB0 THEN CONTINUE TO LOAD. * CLA IF NOT DOING MAIN/SEGMENT CPA MSEG LOADING, THEN ALSO JMP AB0 CONTINUE TO LOAD. * * NEED TO ADJUST BASE TRACK/SECTOR BASES FOR * MAIN AND SEGMENTS. * * AJST LDA ID# SET INDEX AS # OF DEFINED CMA,INA DUMMY ID SEGMENTS STA ABT1 FOR MAIN/SEGMENT. CCB SET 'STRAK' & 'SSECT' TO STB ABT7 BE SET ONLY ONCE. LDA IDA (A)= SFTARTING ADDR. * AB14 ADA P8 SET (ABT2) = ADDR OF ID STA ABT2 SEGMENT WORD (DISC ADDR) ISZ ABT1 IF ABOUT TO UPDATE MAIN'S ID RSS JMP AB0 THEN AVOID - DMAN ALREADY ZERO. LDA ABT2,I GET DISC ADDR AND M177 ISOLATE AND SAVE STA ABT5 SECTOR #. LDA ABT2,I GET AGAIN ALF,ALF FOR RAL ISOLATING AND M377 TRACK #. MPY ABT4 MULTIPLY BY PREVIOUS # SECT/TRAK ADA ABT5 ADD SECTOR BASE, CLB DIVIDE BY NEW TRKS# TO GET NEW DIV TRKS# TRACK/SECTOR BASE. ISZ ABT7 IF 'STRAK' & 'SSECT' SET ONCE JMP *+3 THEN DO NOT MODIFY AGAIN. STA STRAK SET RELATIVE TRACK & SECTOR STB SSECT ADDR FOR NEXT ID SEGMENT. ALF,ALF ROTATE TRACK TO 14-07, RAR AND -OR- SECTOR # IOR B INTO 06-00, STA ABT2,I RESTORE WORD IN ID SEGMENT. LDA ABT2 (A)= ID SEGMENT (DUMMY) ADDR. INA JMP AB14 -CONTINUE TO PROCESS. * P22 DEC 22 ABT1 NOP TEMPORARY ABT2 NOP ABT3 NOP STORAGE ABT4 NOP ABT5 NOP FOR ABT6 NOP ABT7 NOP "ABOUT" ABT8 NOP ABT9 NOP ROUTINE. ABT10 NOP ABT11 NOP ABT12 NOP ABT13 NOP ABT14 NOP SPC 1 RELLO NOP RELEASE ALL OWNED TRACKS BELOW CLA THE CURRENT TRAKB STA ABT2 CLEAR THE TRACK COUNT LDA TAT SET THE ATAT ADDR STA ABT3 FOR INDEXING LDB TATSD SET UP THE TRAKB STOP LDA TRKLU IF ON LU 3 SLA,RSS THEN CLB ADD TATSD ADB TRAKB ADD THE CURRENT BASE STB ABT5 SET AS THE LIMIT SPC 1 GA0 LDA ABT2 GET CURRENT TRACK CPA ABT5 END? JMP RELLO,I YES RETURN XLA ABT3,I NO IS THE TRACK CPA XEQT ASSIGNED TO ME? RSS N]NLH IF SO SKIP JMP GA1 ELSE GO STEP THE PNTRS LDA P2 SET UP TO REALSE THE TRACK LDB TATSD IF ON CMB,INB LU 3 ADB ABT2 THE SSB,RSS TRACK AND LU INA MUST BE ADDJUSTED SSB FOR THE AUX DISC LDB ABT2 DST ABT6 SET FOR THE CALL JSB EXEC GIV THE TRACK BACK DEF *+5 DEF P5 DEF P1 DEF ABT7 DEF ABT6 SPC 1 GA1 ISZ ABT2 ISZ ABT3 STEP THE PNTRS JMP GA0 AND CONTINUE SKP * * SUBROUTINE: "MVIDS" MOVE ID SEGMENT * * PURPOSE: THIS IS A GENERAL ROUTINE TO PROCESS * THE DUMMY ID SEGMENTS GENERATED DURING * BOTH A NORMAL LOAD AND AN EDITING * OPERATION. IT PERFORMS THE FOLLOWING * FUNCTIONS ACCORDING TO THE TYPE OF * LOAD OPERATION: * * 1) NORMAL BG LOAD: * * -FIND BLANK ID SEGMENT * -MOVE DUMMY ID SPECIFIED BY * THE CONTENTS OF "IDA" TO * THE POSITION OF THE BLANK * ID SEGMENT IN THE SYSTEM AREA. aN* * 2) EDITING OPERATION: * * ADDITION: SAME AS FOR A NORMAL * LOAD EXCEPT THAT THE NEW * ID SEGMENT IS WRITTEN IN THE * APPROPRIATE AREA ON THE SYSTEM * DISC TO MAKE THIS A PERMANENT * ADDITION. * * * * CALLING SEQUENCE: (IDA) = ADDR. OF DUMMY * ID SEGMENT * * (A):= 0 FOR NORMAL LOAD * * = 1 FOR EDITING ADDITION * * (B) = ID SEGMENT ADDR IF A * PARTICULAR ONE IS TO * BE USED FOR ADDITION. * * (P) JSB MVIDS * (P+1) -ERROR - NO BLANK ID'S- * (P+2) - NORMAL RETURN- * SKP * MVIDS NOP JSB $LIBR GO PRIVILEDGED !!!!!!!!!!!!!!!!!!! NOP STA ABT10 SAVE EDIT NO-EDIT FLAG STB ABT11 SAVE DESTINATION ID ADDR * LDA DESA INITIALIZE DESTINATION STA DESAM ADDR ARRAY PNTR. XLA $PLP SUBTRACT FWA OF R/T AREA CMA,INA FROM SOURCE ID ADDR TO ADA IDA CHECK IF SOURCE IS IN DUMMY. SSA,RSS SOURCE ID IN SYSTEM AREA ? JMP DMYMV NO, THEN IT IS IN DUMMY. * * SOURCE ID IS IN SYSTEM AREA AND SO DESTINATION * MUST BE SPECIFIED. ONLY MEM1 TO DMAN NEED TO * BE MOVED FROM SOURCE TO DESTINATION. * LDB IDA ADB P14 (B) = NAM5 ADDR OF SOURCE ID JSB MEM? GET ADDR OF MEM1 NOP STB SRADR SET FWA OF SOURCE LDB ABT11 GET DESTINATION ID ADDR ADB P14 (B)=NAM5 ADDR OF DESTINATION ID JSB MEM? GET ADDR OF MEM1 NOP LDA N5 SET MOVE COUNT = 5 WORDS STA NUMWD FOR MEM1 TO DMAN. JSB STRFR TRANSFER ADDRES INTO ARRAY JMP MOVID MOVE TO SYSTEM AREA * * SET ADDRESS ARRAY FOR CONSEQUETIVE MOVE. * (A) = NUMBER OF WORDS TO BE MOVED b * (B) = FIRST WORD DESTINATION ADDR * STRFR NOP SADRS STB DESAM,I SET DESTINATION ID WORD ADDR ISZ DESAM MOVE UP TO NEXT ARRAY STORAGE INB BUMP ID WORD ADDR INA,SZA ALL ADDRES STORED ? JMP SADRS NO, THEN CONTINUE. JMP STRFR,I RETURN * * * SOURCE ID IS IN DUMMY AREA. SET SOURCE * ADDRESS AND COUNT AND ALSO CHECK IF * DESTINATION ID HAS BEEN SPECIFIED. * * DMYMV LDB IDA SET ADDR STB SRADR OF SOURCE ID. LDA ID# CHECK IF SOURCE CMA,INA ID IS FOR CPA ID## MAIN (LONG ID) ? CLA,RSS SET FLAG FOR LONG ID = 0 CCA SET FLAG FOR SHORT ID = -1 STA SSFLG SOURCE ID TYPE FLAG LDB N9 SET MOVE COUNT=-9 (SHRT ID) SZA,RSS IF LONG ID LDB N20 THEN SET MOVE COUNT=-20. STB NUMWD JSB BLKID GET CURRENT ID EXT LDB ABT11 GET DESTINATION ID ADDR SZB,RSS DESTINATION SPECIFIED ? JMP FBLNK NO, THEN USE BLANK ID. * * DESTINATION ID HAS BEEN SPECIFIED * ADB P14 (B)=NAM5 ADDR OF DESTINATION ID JSB MEM? FIND IF ID LONG OR SHORT. CCB,RSS SHORT ID, SET (B)=-1. CLB LONG ID, SET (B)=0. SZB DESTINATION ID LONG ? JMP SCHK NO, GO CHECK SOURCE ID. CPB SSFLG YES. IS SOURCE ID ALSO LONG. JMP DB13B YES, THEN SET 13 WORD TRANSFER. JMP SDS9B NO, SET 9 TO 13 WORD TRANSFER. SCHK CPB SSFLG IS SOURCE ID SHORT TOO ? JMP DS9S YES, SET 9 TO 9 WORD TRANSFER. MBACK JSB $LIBX ERROR RETURN (LONG TO SHORT ILLEGAL). DEF MVIDS * * FIND BLANK ID OF APPROPRIATE LENGTH * FBLNK JSB NAMOK SEE IF PROG NAME STILL OK. LDB SSFLG GET SOURCE ID FLAG SZB,RSS SOURCE ID SMALL ? JMP SLNG NO, ANALYZE FOR LONG ID. LDA BID4 SET ADDR OF SMALL ID STA ABT11 W/O DISC ALLOCn!ATION. LDB BID8 GET # OF SMALL IDS W/O DISC ALLOC SZB ANY SMALL IDS W/O DISC ALLOCATION ? JMP DS9S YES, SET 9 WORD SMALL-TO-SMALL TRFR LDA BID3 SET ADDR OF SMALL ID STA ABT11 WITH LEAST DISC ALLOCATION. LDB BID6 (B)=3 SMALL IDS WITH & W/O DSC ALLOC SZB ANY AVAILABLE ? JMP DS9S YES, SET 9 WORD SMALL-TO-SMALL TRFR * SLNG LDB BID7 GET # OF LONG IDS W/O DISC ALLOC LDA BID2 (A)=LONG ID ADDR W/O DISC ALLOC SZB ANY LONG ID W/O DISC ALLOCATION ? JMP SSCHK YES LDA BID1 (A)=LONG ID ADDR WITH LEAST DSC ALLOC LDB BID5 (B)=# OF LONG IDS WITH & W/O DSC ALLC SZB,RSS ANY LONG ID WITH DISC ALLOCATION ? JMP OSHIT NO, DO ERROR RETURN. * SSCHK STA ABT11 SET DESTINATION ID ADDR LDA SSFLG GET SOURCE ID FLAG SZA,RSS SOURCE ID LONG ? JMP DB13B YES, SET 13 WORD BIG-TO-BIG TRANSFER SKP SDS9B LDB IDA ADB P3 (B)=NAM5 ADDR IN SHORT ID LDA B,I GET NAM5 WORD CONTAINING 'SS' BIT XOR M20 MASK OFF 'SS' BIT STA B,I AND STORE BACK NAM5 * * * TRANSFER FROM SMALL ID IN DUMMY AREA TO * BIG ID IN SYSTEM AREA. * LDB ABT11 GET DESTINATION ID ADDR ADB P7 (B)=ADDR OF PRIM ENTRY POINT STB DESAM,I SET ADDR IN ARRAY ISZ DESAM ADB P5 (B)=ADDR OF NAM12 LDA N3 (A)=-3 FOR TRFR OF NAM12 TO NAM5 JSB STRFR TRANSFER ADDR PNTRS ADB P7 (B)=ADDR OF MEM1 LDA N5 (A)=-5 TO TRFR MEM1 TO DMAN PNTRS JSB STRFR TRANSFER MEM1 TO DMAN ADDRES JMP MOVID DO MOVE TO SYSTEM AREA * * * TRANSFER FROM SMALL ID IN DUMMY AREA TO * SMALL ID IN SYSTEM AREA. * DS9S LDB ABT11 (B)=DESTINATION ID ADDR ADB P11 POSITION TO PRENT OF ID SEG LDA N9 (A)=-9 TO TRANSFER 9 WORDS JSB STRFR  TRANSFER ADDR PNTRS JMP MOVID DO MOVE TO SYSTEM AREA * N3 DEC -3 P11 DEC 11 * * TRANSFER FROM BIG ID IN DUMMY AREA * TO BIG ID IN SYSTEM AREA. * DB13B LDB ABT11 GET DESTINATION ID ADDR ADB P6 (B)=ADDR OF PRIORITY WORD LDA N2 (A)=-2 TO TRFR PRIOTY & PRM EN PNT JSB STRFR TRANSFER ADDR PNTRS ADB P4 (B)=ADDR OF NAM12 LDA N3 (A)=-3 TO TRFR NAM12 TO NAM5 PNTRS JSB STRFR TRANSFER ADDR PNTRS ADB P2 (B)=ADDR OF RESL WORD LDA N3 (A)=-3 FOR RESL TO TMDY2 ADDR TRFR JSB STRFR TRANSFER ADDR PNTRS ADB P2 (B)=ADDR OF MEM1 LDA N5 (A)=-5 FOR MEM1 TO DMAN ADDR TRFR JSB STRFR TRANSFER ADDR PNTRS INB (B) = ADDR OF EMAID LDA N5 A = -5 FOR EMAID TO SESW3 JSB STRFR TRANSFER ADDRESS POINTERS * * * * LDA EMABP GET THE EMA FLAG SZA ANY DECLARED ? JMP DOEMA YES LDA N18 NO. CHANGE THE MOVE COUNT STA NUMWD TO 18. (IE DON'T USE ID EXTENSION) JMP MOVID GO MOVE THE DUMMY ID SEGMENT * DOEMA LDB BID9 GET THE ADDRESS OF THE ID EXT TO USE SZB,RSS IS THERE ONE ? JMP LL20. NO, EN ERROR LDA N2 SET FOR TRANSFER (ADDRESS IF ID EXTENSION) JSB STRFR SET UP THE POINTERS * LDA BID10 GET THE ID EXT # ALF,ALF ROTATE TO UPPER END RAL,RAL LDB EMASZ GET THE EMA SIZE SZB,RSS WAS IT DEFAULTED INA SET A FLAG ADA B NO, SO USE SPECIFIED SIZE STA EMAID,I AND PUT IN DUMMY ID SEGMENT * * SKP * * * MOVE INTO SYSTEM ID AREA TAKES PLACE FROM * SOURCE (FIRST WORD ADDR IN 'SRADR' AND * AND BUMPED CONSEQUETIVELY) TO DESTINATION * (ADDRESS POINTERS SET UP IN 'DESAM' ARRAY). * NUMBER OF WORDS TO BE MOVED IS IN 'NUMWD'. * MOVID LDB DESA INITIALIZE DESTINATION STB DESAM ADDR ARRAY PNTR. LDB SRADR AND SOURCE TOO. STB SRAD2 LDB NUMWD STB NUMW2 ALSO # OF WORDS TO MOVE KEPON LDA SRADR,I GET WORD FROM SOURCE ID LDB DESAM,I (B)=ADDR OF DESTINATION ID WORD XSA B,I STORE IN SYSTEM ID ISZ DESAM BUMP DESTINATION ARRAY ADDR ISZ SRADR BUMP SOURCE ADDR OF ID WORD ISZ NUMWD ALL WORDS MOVED ? JMP KEPON NO, DO MORE. * JSB $LIBX RESTORE INTERUPT DEF *+1 PROCESSING DEF *+1 * * LDB ABT10 GET THE EDIT FLAG SZB,RSS PERM ADDITION ? JMP NODSK NO, SO DON'T USE THE DISC * LDB DESA INITIALIZE SOURCE POINTERS STB DESAM DODSK LDA SRAD2,I GET THE WORD LDB DESAM,I GET THE DESTINATION JSB SYRUW FIX THE DISC ISZ DESAM ISZ SRAD2 ISZ NUMW2 ARE WE DONE ? JMP DODSK NO, SO PLAY IT AGAIN SAM * NODSK ISZ MVIDS SET UP THE SUCCESSFUL RETURN * LDB ABT11 ADB P14 GET THE PROG TYPE WE JUST LAID DOWN XLA B,I AND P7 CPA P5 SEGMENT ? JMP MVIDS,I YES, SO WERE DONE. * LDB ABT11 MAIN, SO DO SOME MORE PROCESSING STB #IDAD SAVE THE ID ADDRESS * LDA PG.PT GET PAGES/ PART'N WORD ADB P21 AND ADDRESS JSB SYSET AND SET UP THE WORD * LDB ABT10 PERM LOAD ? SZB,RSS JMP MVIDS,I NO, WE'RE DONE * LDA PG.PT LDB ABT11 ADB P21 JSB SYRUW * JMP MVIDS,I **RETURN** * * 'MVIDS' CONSTANTS * NUMWD NOP NUMBER OF WORDS TO BE MOVED SRADR NOP FWA OF SOURCE ID MOVE DESA DEF MVBUF ARRAY CONTAINING ADDRES * IN DESTINATION ID AREA DESAM NOP CURRENT PNTR TO ARRAY SSFLG NOP 0 FOR LONG, -1 FOR SHO)RT SOURCE ID LL21 LDA ERR21 JMP ABOR ERR21 ASC 1,21 N18 DEC -18 NUMW2 NOP SRAD2 NOP * OSHIT JSB $LIBX RETURN TO INTERUPT PROCESSING DEF *+1 DEF *+1 LDA SSFLG LONG OR SHORT ID ? JMP NOIDS LONG LDA ERR26 SHORT JMP ABOR ABORT THYSELF WITH A L-26 ERROR ERR26 ASC 1,26 * SKP * * THE NAMOK ROUTINE CHECKS THE IDS IN THE SYSTEM TO MAKE * SURE THAT THE PROGRAM JUST RELOCATED STILL HAS A UNIQUE * NAME. THAT IS, THAT SOMEBODY DIDN'T SNEAK AN RP IN ON US. * * * NAMOK NOP LDA SSFLG GET THE LONG/SHORT ID FLAG LDB IDA AND THE DUMMY ID ADDRESS SSA,RSS SHORT OR LONG ? INB 0 = LONG INB -1 = SHORT * STB NAM12 INB SET UP NAME FOR TEST STB NAM34 INB STB NAM5 * CCA SET UP FLAG FOR # OF TESTS STA NMFLG SET PROG NAME FLAG * ONEMR JSB MIDN FIND THE ID IF ONE JMP NAMOK,I NONE SO OK LDA P2 IF OPERATION IS REPLACEMENT CPA EDFLG EDITING, IGNORE DUPLICATE, JMP NAMOK,I AND CONTINUE. * LDA NAM12,I GET THE NAME STA MESS7+12 AND PUT IN DUPLICATE PROG LDA NAM34,I NAME MESSAGE BUFFER STA MESS7+13 LDA NAM5,I STA MESS7+14 LDA P27 LDB MESS7 MESS7 = ADDR: DUPLICATE PROG NAM * JSB $LIBX RETURN TO INT PROCESSING DEF *+1 DEF *+1 * JSB SYOUT PRINT: DUPL. PROG NAME ISZ NMFLG SKIP - TRY RESETTING PROG NAM JMP ABORT INVALID RESET PROG NAME LDA RENAM GET ASCII '##' STA NAM12,I SET PROG NAME 1,2 = '..' LDB SSFLG IF MAIN, SET INTO OUTPUT MESSAGE SSB,RSS STA MESS4,I LDA P5 LDB NAM12 JSB SYOUT TELL THEM THE NEW NAME * JSB $LIBR NOP JMP ONEMR REPEAT DUPLICATE PROG NAME SCAN * SKP * * SUBROUTINEb: "C#S" CALCULATE # SECTORS * * THIS ROUTINE CALCULATES THE TOTAL # OF WORDS * IN THE MAIN BODY AND BASE PAGE AREA FOR A PROG * AND DETERMINES THE # OF SECTORS REQUIRED. * * CALL: (A) = ADDRESS OF MEM1 IN ID SEGMENT * * (P) JSB C#S * (P+1) -RETURN- (A) = # SECTORS REQUIRED * * C#S NOP JSB SETAB * LDA ABT4,I DETERMINE CMA,INA # OF ADA ABT5,I MAIN WORDS STA ABT1 LDA ABT6,I DETERMINE CMA,INA # OF ADA ABT7,I BASE PAGE WORDS C#SXX CLB DIV P64 DIVIDE BP BY SZB 64 AND INA ROUND AND SLA SKIP IF EVEN SECTOR COUNT INA ELSE BUMP TO EVEN SECTOR COUNT STA ABT2 SAVE. CLB DIVIDE MAIN # WORDS LDA ABT1 BY 64, DIV P64 ROUND TO WHOLE SECTOR SZB INA SLA IF ODD SECTOR COUNT INA THEN MAKE EVEN. ADA ABT2 ADD TO BASE PAGE COUNT FOR TOTAL JMP C#S,I RETURN. * * * * * SUBROUTINE: "C#SMX" CALCULATE # SECTORS * * THIS ROUTINE CALCULATES THE TOTAL # OF WORDS * IN THE MAIN BODY AND BASE PAGE AREA FOR A PROG * AND DETERMINES THE # OF SECTORS REQUIRED. * IT USES CROSS LOADS BECAUSE THE ID SEGMENT IS NOT A * DUMMY ID SEGMENT, RATHER, IT IS AN ID IN MEMORY. * CALL: (A) = ADDRESS OF MEM1 IN ID SEGMENT * * (P) JSB C#SMX * (P+1) -RETURN- (A) = # SECTORS REQUIRED * * C#SMX NOP JSB SETAB * XLA ABT4,I DETERMINE CMA,INA # OF XLB ABT5,I MAIN WORDS ADA B STA ABT1 XLA ABT6,I DETERMINE CMA,INA # OF XLB ABT7,I BASE PAGE WORDS ADA B LDB C#SMX SET RETURN STB C#S JMP C#SXX * * SETAB NOP STA ABT4 INA STA ABT5 SET UP THE ADDR OF BOUNDS INA STA ABT6 INA STA AB9T7 JMP SETAB,I * * SKP * * * * * * * * SUBROUTINE: "BLKID" * * THIS ROUTINE SCANS THE SYSTEM ID SEGMENTS AND * AND RECORDS THE FOLLOWING : * * BID1 = ADDRESS OF BIG ID WITH LEAST DISC ALLOC. * BID2 = ADDRESS OF BIG ID WITHOUT DISC ALLOCATION * BID3 = ADDRS OF SMALL ID WITH LEAST DISC ALLOC. * BID4 = ADDRS OF SMALL ID WITHOUT DISC ALLOCATION * BID5 = # OF BIG IDS WITH & WITHOUT DISC ALLOC. * BID6 = # OF SMALL IDS WITH & WITHOUT DISC ALLOC. * BID7 = # OF BIG IDS WITHOUT DISC ALLOCATION * BID8 = # OF SMALL IDS WITHOUT DISC ALLOCATION * BID9 = ADDRS OF 1ST AVAIL ID EXTENSION, = 0 IF NONE * BID10 = ORDINAL # OF THE FREE ID EXT * BID11 = # OF FREE ID EXTENSIONS * * (NOTE: ABOVE PARAMETERS ARE ZERO IF NOT SET) * * * CALL: (P) JSB BLKID * (P+1) -RETURN- * (A) = # AVAIL (SMALL+BIG) OR 0 * IF NO BIG AVAILABLE (TOTAL * INCLUDES WITH AND W/O DISC * ALLOCATION). * (B) = MEANINGLESS * BLKID NOP CLA CLEAR STA BID1 ADDR OF BIG WITH LEAST DISC ALLOC STA BID2 ADDR OF BIG WITHOUT DISC ALLOCATION STA BID3 ADDR OF SMALL WITH LEAST DISC ALLOC STA BID4 ADDR OF SMALL WITHOUT DISC ALLOC STA BID5 # OF BIG IDS WITH & WITHOUT DISC ALOC STA BID6 # OF SMALL IDS WITH & W/O DISC ALLOC STA BID7 # OF BIG IDS WITHOUT DISC ALLOCATION STA BID8 # OF SMALL IDS W/O DISC ALLOCATION STA BID9 ADDRESS OF FREE ID EXT STA BID10 FREE ID EXTENSION'S ORDINAL # STA BID11 # OF FREE ID EXTENSIONS STA DISPS CLEAR DISC ALLOC FOR SHORT ID STA DISPL AND FOR LONG ID LDA KEYWD INITIALIZE ADDR OF STA KEYPT KEYWORD LIST. * XLA $IDEX GET THE ADDR OF ID EXTENSION BLOCK STA IDEX AND SAVE JMP *+3 CNTEX ISZ IDEX BUMP POINTER ~ ISZ BID10 BUMP ID EXTENSION # XLA IDEX,I GET THE ADDRESS SZA,RSS IF END OF LIST JMP BLK1A GO TO ID SEGS XLB A,I ELSE GET THE CONTENTS OF 1ST WORD SZB IS THIS ONE FREE ? JMP CNTEX NO STA BID9 SAVE THE ADDRESS ISZ BID11 COUNT IT AS FREE NXIDX ISZ IDEX BUMP POINTER XLA IDEX,I GET THE ADDRESS SZA,RSS FINISHED ? JMP BLK1A YES, COUNT REST OF IDS XLA A,I GET THE 1ST WORD SZA,RSS IS IT FREE ? ISZ BID11 YES, SO COUNT IT JMP NXIDX GO LOOK AT THE NEXT ONE * BLK1 ISZ KEYPT BUMP KEYWORD ADDR BLK1A XLB KEYPT,I GET KEYWORD SZB,RSS IF END OF LIST JMP BLK3 THEN GO TO SET COUNTS. ADB P12 (B)=ADDR OF NAM12 CLA STA FLGSS CLEAR ID TYPE FLAG XLA B,I IF NAM12=0 SZA,RSS THEN ITS A BLANK ID JMP BLK2 CPA P1 CHECK FOR REPLACE OPERATION FLAG JMP BLK2 CPA P2 JMP BLK2 * JMP BLK1 ELSE CONTINUE SCAN * * ANALYZE BLANK ID * BLK2 ADB P2 (B)=ADDR OF NAM5 JSB MEM? FIND IF ID LONG OR SHORT CCA,RSS SHORT ID, SET (A)=-1. CLA LONG ID, SET (A)=0. STA FLGSS SET ID TYPE FLAG ADB P4 (B)=ADDR OF DMAIN XLA B,I GET DMAN SZA ANY DISC ALLOCATION ? JMP DSCAL YES * LDA FLGSS GET SHORT/LONG ID FLAG SZA,RSS LONG ID ? JMP LGND YES ISZ BID8 BUMP COUNT FOR SHORT ID W/O DSC CLA XLB KEYPT,I GET ID SEG ADDR CPA BID4 ADDR OF 1ST SMALL W/O DSC SET ? STB BID4 NO, SET ADDR OF SMALL ID. JMP BLK1 YES, CONTINUE SCAN. LGND ISZ BID7 COUNT LONG ID W/O DSC ALOC. XLB KEYPT,I GET ID SEG ADDR CPA BID2 ADDR OF 1ST BIG W/O DSC SET ? _* STB BID2 NO, SET ADDR OF LONG ID. JMP BLK1 YES, CONTINUE SCAN. * * P15 DEC 15 * DSCAL XLA KEYPT,I GET ID SEG ADDR ADA P15 (A)=ADDR OF MEM1 OF SHORT ID LDB FLGSS GET ID TYPE FLAG SZB,RSS LONG ID ? JMP DLGND YES,ADJUST (A) FOR MEM1 OF BIG ID. JSB C#SMX DETERMINE # OF SECTORS LDB DISPS GET DISC ALLOC COMPARATOR SZB,RSS ANY DISC ALLOC SET UP YET ? JMP SHNEW NO, THEN SET THIS ONE. STA B SAVE SEC COUNT TEMPORARILY CMA,INA SUBTRACT THIS SPACE FROM PREVIOUS ADA DISPS SSA IS THIS DISC SPACE < PREVIOUS ? JMP SHCNT NO, LET PREVIOUS BE THERE. LDA B RESTORE SECTOR COUNT SHNEW STA DISPS SET DISC SPACE ALLOCATION XLB KEYPT,I SET ADDR OF SMALL ID WITH STB BID3 LEAST DISC ALLOCATION. SHCNT ISZ BID6 COUNT SHORT IDS WITH DISC ALLOC JMP BLK1 CONTINUE SCAN * DLGND ADA P7 (A)=MEM1 ADDR OF LONG ID JSB C#SMX DETERMINE NUMBER OF SECTORS LDB DISPL GET DISC ALLOC COMPARATOR SZB,RSS ANY ALLOC SET UP YET ? JMP LGNEW NO, THEN SET THIS ONE IN. STA B SAVE SECTOR COUNT TEMPORARILY CMA,INA SUBTRACT THIS ALLOC ADA DISPL FROM PREVIOUS. SSA IS THIS ALLOC LESS ? JMP LGCNT NO LDA B RESTORE SECTOR COUNT LGNEW STA DISPL SET ALLOCATION XLB KEYPT,I SET ADDR OF LONG ID STB BID1 WITH LEAST ALLOCATION. LGCNT ISZ BID5 COUNT LONG IDS WITH JMP BLK1 DISC ALLOCATION & CONTINUE SCAN. * BLK3 LDA BID8 SET BID8= # OF SMALL IDS ADA BID6 WITH AND WITHOUT STA BID6 DISC ALLOCATION. LDA BID7 SET BID5= # OF LONG IDS ADA BID5 WITH AND WITHOUT STA BID5 DISC ALLOCATION. SZA,RSS ANY BIG IDS AVAILABLE ? JMP BLKID,I NO, RETURN WITH (A)=0. ADA BID6 YES, RETURN WITH (A) = TOTAL JMP BLKID,I NUMBER OF IDS. * * * CONSTANTS * BID1 NOP BID2 NOP BID3 NOP BID4 NOP BID5 NOP BID6 NOP BID7 NOP BID8 NOP BID9 NOP BID10 NOP BID11 NOP FLGSS NOP =0 FOR LONG ID, NON-ZERO FOR SHORT IDEX NOP POINTER TO ID EXTENSION LIST DISPL NOP LONG ID SECTOR COUNT DISPS NOP SHORT ID SECTOR COUNT KEYPT NOP KEYWORD * SKP * * SKP * * SUBROUTINE: "ITRAK" -INTIIALIZE TRACK ALLOCATION * * CALL: "#TRAK" CONTAINS # OF TRACKS * TO BE ALLOCATED * * A AND B MEANINGLESS * (P) JSB ITRAK * (P+1) -RETURN- A AND B MEANINGLESS * * THE FOLLOWING WORDS OF STORAGE ARE SET * AND ALL TRACKS HAVE BEEN SET TO ZERO: * * #TRAK - # OF TRACKS ALLOCATED * TRAKB - STARTING TRACK # (BASE TRACK) * TRKLU - LOGICAL UNIT OF DISC * TRKS# - # OF SECTORS PER TRACK * * IF THE TRACK ALLOCATION CANNOT BE MADE, THE * LOADER PRINTS THE MESSAGE * "/LOADR: WAITING FOR DISC SPACE" * AND REPEATS THE REQUEST WITH THE SUSPENSION * OPTION. THE LOADR CONTINUES WHEN TRACKS BECOME * AVAILABLE. THE LOADR MAY BE ABNORMALLY * TERMINATED BY THE OPERATOR IN THIS STATE. * * ITRAK NOP ITRK9 LDA #TRAK SET SIGN BIT OF #TRAK WORD IOR MSIGN FOR NO SUSPENSION IF TRACKS STA #TRAK NOT AVAILABLE. * ITRK1 JSB EXEC REQUEST DEF *+6 DISC DEF P4 SPACE DEF #TRAK DEF TRAKB DEF TRKLU DEF TRKS# * LDA #TRAK REMOVE RAL,CLE,ERA SIGN BIT FROM STA #TRAK # TRACKS WORD. CCA IF STARTING TRACK # = -1, CPA TRAKB THEN NO TRACKS AVAILABLE, JMP ITRK3 PRINT MESSAGE(WILL RETRY FOR 1ST ALLOC) * * LDA TRKLU DSKUN = DISC'S STA DSKUN  LU # LDA TRAKB ITRKB = STARTING TRACK # ADA #TRAK ITRK6 = ENDING TRACK STA ITRK6 # +1. * ISZ TKTRY NO MORE RETRYS ALLOWED JMP ITRAK,I RETURN * * PRINT WAITING MESSAGE * ITRK3 LDA TKTRY GET THE RETRY FLAG SZA,RSS CAN WE RETRY ? JMP ITRK4 YES * * ITRK8 LDA P22 GET THE BUFFER LENGTH LDB ITRKM JSB SYOUT JMP ITRK1 * * ITRK4 LDA #TRAK GET THE # WE ASKED FOR LAST TIME ADA N2 SUBTRACT 2 SZA,RSS DID WE ASK FOR 2 LAST TIME ? JMP ITRK5 YES ,SO FORGET IT CCA NO SO SUBTRACT ONE AND TRY AGAIN ADA #TRAK STA #TRAK JMP ITRK9 DO IT AGAIN * ITRK5 ISZ #TRAK BUMP REQUEST BACK TO 4 ISZ #TRAK JMP ITRK8 AND SUSPEND THYSELF * ITRKM DEF *+1 ASC 11,WAITING FOR DISC SPACE * ITRK6 NOP * * #TRAK DEC 4 # OF TRACKS ALLOCATED TRAKB NOP STARTING TRACK # (BASE TRACK) TRKLU NOP LOGICAL UNIT OF DISC TRKS# NOP # OF SECTORS PER TRACK SPOS NOP RELATIVE SECTOR POSITION TSECT NOP TEMPORARY SECTOR AND TTRAK NOP TRACK #. TKTRY NOP RETRY FLAG FOR TRACKS SKP * * 'EDIT' COMPLETION * ED00 LDA MSEG GET MAIN/SEG FLAG SZA PROCESSING MAIN/SEG ? JMP ED18 YES * * SINGLE PROGRAM OPERATION * CLA,INA CHECK CPA EDFLG TYPE JMP ED10 ADDITION * * PROGRAM REPLACEMENT * E0D JSB MIDN FIND MATCHING ID SEGMENT JMP ED10 -NO, TREAT AS ADDITION. * ED0 STB ED25 SAVE MATCH ID ADDR. ADB P14 (B)=NAM5 ADDR JSB MEM? GET ADDR OF MEM1 NOP STB A CALCULATE JSB C#SMX # SECTORS STA ED60 AND SAVE * ED001 LDB TAT SET SIGN BIT XLA B,I ON SYS DISC TO TEST JSB SYהNLHRUW WRITE PROTECT BEFORE DAMAGE IS DONE * LDB ED25 ADB P12 SET ADDR OF NAM12 STB LH1 OF ID SEG. ADB P2 (B)=NAM5 ADDR OF MATCHED ID XLA B,I GET NAM5 AND AND P7 MASK IN PROG TYPE. STA SWPID SAVE THE TYPE FOR A MOMENT CPA P5 IS THIS A SEGMENT ? JMP ED004 YES, FORGET DORMANY CHECK. ADB N6 (B)=ADDR OF SUSPEND WORD XLA B,I POINT OF SUSPENSION? SZA ZERO - CONTINUE JMP ED003 SUSPEND ADB P7 GET XLA B,I STATUS: SZA DORMANT? JMP ED003 NO - SUSPEND ADB P2 GET XLA B,I TIME LIST: AND BIT12 IN LIST? SZA WELL JMP ED003 * * ADB P4 GET LAST PARTITION PROGRAM WAS IN XLA B,I AND M77 KEEP ONLY PARTITION MPY P7 NOW INDEX INTO $MATA TABLE XLB $MATA ADA B ADA P2 GET RESIDENT PROG XLA A,I CPA ED25 DID PROG TERM SERIALLY REUSABLE ? SN RSS YES, YOU LOSE JMP ED004 * * * SKP ED003 LDA P18 PRINT MESSAGE LDB MES70 JSB SYOUT PROG IS NON-DORMANT JMP ABORT AND ABORT THYSELFZERO * MES70 DEF *+1 ASC 9,SET PRGM INACTIVE BIT12 OCT 10000 LH1 NOP * ED004 LDB OPCOD GET THE OPERATION FLAG CPB P4 THIS A PURGE ? CLB,RSS YES, SET NAME = 0 CLB,INB SET REPLACE FLAG INTO ID * KEEPS OTHER LOADRS & FMGR HONEST JSB $LIBR TURN OFF INTERUPTS NOP XSB LH1,I ZERO ISZ LH1 NAME XSB LH1,I IN ISZ LH1 CORE XLA LH1,I ID AND M20 SEGMENT (LEAVE 'SS' BIT) XSA LH1,I * CLA LDB SWPID GET THE PROGRAM TYPE CPB P5 IS IT A SEGMENT ? JMP NOZAP FORGET ABOUT ID EXTENSION * LDA LH1 NOW GET THE ADDRESS OF ADA P14 THE ID EXT WORD XLA A,I PULL IT IN SZA,RSS ANY ID EXTENSION JMP NOZAP NO. * ALF YES RAL,RAL GET THE # TO LOW END AND M77 & KEEP ONLY THE # XLB $IDEX ADD START OF TABLE ADA B XLA A,I NOW HAVE THE ADDRESS CLB XSB A,I AND ZAP THE WORD NOZAP JSB $LIBX RESTORE DEF *+1 INTERRUPT DEF *+1 SYSTEM * SZA,RSS WAS THERE AN ID EXT ? JMP TKREL NO, GO RELEASE THE TRACKS SWP YES, SO ZAP THE DISC AS WELL. JSB SYRUW * * RELEASE "OLD" TRACKS * TKREL LDB ED25 GET MATCHED ID SEG ADDR ADB P14 (B)=NAM5 ADDR JSB MEM? GET ADDR OF MEM1 NOP ADB P4 (B)=ADDR OF DMAIN XLA B,I GET DISC WORD AND SAVE STA ED63 TEMPORARILY. SSA TRACKS ON LU3 ? JMP CLEAR YES, THEN RELEASE TRKS. CMA,INA nDSUBTRACK FROM DISC LIB ADDR ADA DSCLB AND IF SSA,RSS IN SYSTEM AREA JMP ED01 THEN DON'T RELEASE TRKS CLEAR CLA CLEAR JSB SYSET DISC WORD. JSB SYRUW DISC TOO LDB ED63 RESTORE DISC WORD TO B. LDA ED60 JSB DREL GO RELEASE TRACKS UNLESS GLOBAL * SKP ED01 LDB ED25 GET ID SEGMENT ADDR TO B JSB TATCL GO CLEAR ANY TRACKS ASSIGNED TO PGM LDB ED25 CLEAR ADB P12 NAME STB ED63 WORDS (3) LDB N3 STB ED60 ED02 CLA CCB CPB ED60 IF CLEARING NAM5 RSS JMP *+3 XLA LH1,I THEN GET SAME VALUE AS IN CORE LDB ED63 JSB SYRUW ISZ ED63 ISZ ED60 JMP ED02 LDA OPCOD CPA P4 IF PURGE OPERATION JMP EXIT THEN DONE SO GO TERMINATE JMP PADD GO TO TREAT AS ADDITION * * * PROGRAM ADDITION * ED10 CLA CLEAR MATCHED STA ED25 ID SEG ADDR STORAGE. RSS SKIP MESSAGE OUTPUT FOR NOW ED03 JMP NOIDS GO TELL THER ARE NO ID SEGMENTS PADD JSB BLKID DETERMINE # BLANK ID'S. LDB ID## CMB,INB CPB ID# IF LOOKING FOR MAIN'S ID JMP BIGID THEN SKIP SETTING UP FOR SMALL LDA BID6 (A)=TOTAL # OF SMALL IDS LDB BID8 (B)=# OF SMALL IDS WITHOUT DISC ALOC SZA SETTLE FOR LONG IF SMALL UNAVAILABLE JMP *+3 SKIP SETTING FOR LONG IDS BIGID LDA BID5 (A)=TOTAL # OF LONG IDS LDB BID7 (B)=# OF LONG IDS WITHOUT DISC ALLOC SZA,RSS IF NONE, JMP ED03 PRINT MESSAGE CPA B IF NONE WITH DISC ALLOC, JMP NTRM7 GO TO USE FIRST BLANK. * LDA IDA GET ID SEGMENT ADDR ADA P4 (A)=MEM1 ADDR OF SHORT ID LDB ID## CMB,INB CPB ID# IF PROCESSING MAIN ADA P4 TH^EN (A)=MEM1 ADDR OF LONG ID JSB C#S CALCULATE # OF SECS REQUIRED STA ED20 SAVE # OF SECTORS CMA,INA SAVE STA ED21 NEGATIVE # OF SECTORS LDA KEYWD SAVE STARTING KEYWORD STA ED22 LIST ADDR. CLA CLEAR STA ED23 ACCUMULATOR * ED11 XLB ED22,I GET NEXT ID SEGMENT ADDR. SZB,RSS JMP ED14 -END OF LIST * ADB P12 CHECK NAME(1) XLA B,I IF SZA,RSS = JMP ED17 0, CHECK FURTHER. CPA P1 JMP ED17 ED12 ISZ ED22 CHECK JMP ED11 NEXT SEGMENT. * ED17 ADB P2 (B)=NAM5 ADDR JSB MEM? GET ADDR OF MEM1 NOP (REG-A NOT 0 FOR SHORT ID RETURN) ADB P4 (B)=ADDR OF DMAIN XLA B,I SZA,RSS IF NO DISC ALLOCATION TO THIS SEG JMP ED12 THEN CONTINUE SCAN. * LDA B ADA N4 (A)=MEM1 ADDR JSB C#SMX GET SECTOR COUNT STA B SAVE ADA ED21 SUBTRACT DUMMY FROM THIS SSA # OF SECTORS. JMP ED12 IF DUMMY >, CONTINUE SCAN. * LDA ED23 GET PREVIOUS MIN # SECTORS SZA,RSS IF 0, JMP ED13 GO TO USE THIS ALLOCATION. CMA,INA SUBTRACT ADA B PREVIOUS FROM NEW, SSA,RSS USE NEW # IF < OLD. JMP ED12 NO, KEEP CHECKING ED13 STB ED23 SET ALLOCATION #. XLA ED22,I ALSO, SET STA ED24 ID SEGMENT ADDR. JMP ED12 GO TO CHECK NEXT. * * * MODIFY WORD IN ID IN SYSTEM AREA * MODID NOP JSB SYSET STORE IN CORE JSB SYRUW STORE ON DISC JMP MODID,I RETURN * * ED14 LDA ED23 IF SPACE NOT FOUND IN SYSTEM SZA,RSS AREA, GO TO USE A BLANK ID SEG JMP NTRM7 AND KEEP PROG ON USER TRACKS * SKP * * * MOVE PROGRAM INTO SYSTEM AREA * LDB IDA GET DUMPMY ID ADDR ADB P8 (B)=DMAN ADDR OF SHORT ID LDA ID## CMA,INA CPA ID# IF PROCESSING MAIN ADB P4 THEN (B)=DMAN ADDR OF LONG ID LDA B,I GET RELATIVE STARTING ALF,ALF TRACK # RAL AND AND M377 ADD ADA TRAKB BASE TRACK. STA TRAKP SET ABSOLUTE TRACK ADDR LDA B,I GET DMAN AGAIN AND M177 MASK IN SEC ADDR STA ED62 SET SECTOR ADDR * LDB ED24 GET DESTINATION ID ADDR ADB P14 (B)=ADDR OF NAM5 JSB MEM? GET ADDR OF MEM1 NOP ADB P4 (B)=ADDR OF DMAIN XLA B,I GET DESTINATION AREA ON SYS DSC ALF,ALF SET STARTING RAL TRACK AND M377 NUMBER. STA ED66 XLA B,I AND M177 SET STARTING STA ED67 SECTOR NUMBER. LDA P2 SET STA DESLU DESTINATION LU. LDA ED23 GET NUMBER OF ADA ED21 SECTORS LEFT OVER. SZA,RSS IF NO SECTORS LEFT JMP MPRG THEN ONLY MOVE THE PROG. SKP * * ALLOCATE LEFTOVER SPACE TO A BLANK * ID SEGMENT WITHOUT DISC ALLOCATION. * MPY P64 FIND # OF WORDS LEFT OVER STA ED23 AND SAVE FOR LATER. JSB BLKID FIND BLANK ID ALLOCATION LDB BID7 (B)=# OF IDS W/O DISC ALLOC SZB ANY BIG ID W/O DISC AVAIL ? JMP LFND YES, SET IT UP FOR ALLOC. LDB BID8 (B)=# OF SMALL IDS W/O DSC ALOC SZB,RSS ANY SMALL ONES AVAILABLE ? JMP MPRG NO, THEN GO TO MOVE PROG. LDB BID4 (B)=ADDR OF SHORT ID W/O DSC ALOC ADB P15 (B)=MEM1 ADDR OF SHORT ID JMP SBND SKIP OVER LONG ID'S SET UP LFND LDB BID2 (B)=ADDR OF LONG ID W/O DISC ALOC ADB P22 (B)=MEM1 ADDR OF LONG ID SBND STB BID2 SET ADDR OF MEM1 o CLA JSB MODID SET LOW MAIN = 0 ISZ BID2 SET ADDR OF MEM2 LDA ED23 GET NUMBER OF WORDS LEFT OVER LDB BID2 GET ADDR OF MEM3 JSB MODID SET HIGH MAIN=WORDS LEFT OVER ISZ BID2 SET ADDR OF MEM3 LDB BID2 SET LOW BASE =0 CLA JSB MODID ISZ BID2 SET ADDR OF MEM4 LDB BID2 GET MEM4 ADDR CLA JSB MODID SET HIGH BASE =0 ISZ BID2 SET ADDR OF DMAN LDA ED67 GET STARTING SECTOR ADDR ADA ED20 MOVE UP TO END OF USED AREA CLB GET DISC ADDR OF AREA LEFT DIV SECT2 FIND # OF TRKS ADA ED66 GET ACTUAL DISC ADDR ALF,RAL POSITION TRACK RAL,RAL ADDR. IOR B MERGE IN SECTOR ADDR LDB BID2 GET DMAN ADDR JSB MODID SET DISC ADDR IN DMAN * SKP * MPRG JSB ED15 MOVE PROG TO SYSTEM AREA JMP ED16 SET UP IDS * ED15 NOP BGN JSB EXEC READ 1 SECTOR FROM DEF *+7 SOURCE AREA DEF P1 DEF DSKUN DEF LBUF DEF P64 DEF TRAKP DEF ED62 * JSB EXEC WRITE SAME SECTOR DEF *+7 INTO DESTINATION DEF P2 DEF DESLU DEF LBUF DEF P64 DEF ED66 DEF ED67 * ISZ ED21 INDEX SECTOR MOVE COUNT RSS -NOT FINISHED. JMP ED15,I -FINISHED. * LDA ED62 INDEX INA SOURCE SECTOR #. CPA TRKS# IF = # SECTORS/TRACK, CLA SET = 0, STA ED62 RESTORE. SZA,RSS IF = 0 ISZ TRAKP ADD 1 TO TRACK #. * LDA ED67 INDEX INA DESTINATION SECTOR #. CPA SECT2 IF = # SECTORS/TRACK, CLA SET = 0, STA ED67 RESTORE. SZA,RSS IF = 0, ISZ ED66 ADD 1 TO TRACK #. JMP BGh\N SKP * * COMPLETE ID SEGMENT PROCESSING * ED16 LDB ED24 GET OLD ID SEG ADDR ADB P14 (B)=NAM5 ADDR JSB MEM? GET ADDR OF MEM1 NOP ADB P4 (B)=ADDR OF DMAIN XLA B,I GET DISC ADDR STA ED63 SAVE TEMPORARILY LDB IDA STORE IT ADB P8 IN LDA ID## DMAN CMA,INA OF CPA ID# NEW ADB P4 ID LDA ED63 SEGMENT STA B,I * LDB ED24 IF SAME ID-SEGMENT CPB ED25 THEN RSS SKIP JSB SWPID ELSE SWAP THE ID-SEGMENTS ON THE DISC JSB FIX24 IDS NOT SWAPPED - CLEAN ED24'S. CLA,INA (A) = 1 FOR ADDITION JSB MVIDS JSB FIX FIX FOR TRYING LONG TO SHORT MOVE LDA MSEG PROCESSING MAIN/SEG ? SZA,RSS THEN SKIP. JMP NTRM4 ELSE TERMINATE * * MAIN/SEGMENT REPLACEMENT OR ADDITION * ED183 LDA IDA SET ADDR OF ADA N9 NEXT SHORT DUMMY STA IDA ID SEGMENT. ISZ ID## END OF SEGMENTS ? CLB,RSS NO, THEN SKIP JMP NTRM4 TERMINATE, ALL MAIN/SEGS DONE. CPB EDFLG EDIT OPERATION ? JMP NTRM7 NO, GO BACK TO TEMP LOAD. JMP ED181 YES, SET UP FOR NEXT SEG. * ED18 LDA IDA INA * ED181 CLB,INB CPB EDFLG ADDITION ? JMP ED10 YES, ATTEMPT TO USE SYSTEM AREA. INA IT IS REPLACEMENT SO STA NAM12 SET UP INA ADDRES STA NAM34 OF NAM12, NAM34 INA AND NAM5. STA NAM5 JMP E0D GO LOOK FOR MATCHING ID SEG. SKP * SAVE MEM BOUNDS AND DISC ADDR OF MATCHED ID INTO * ID SEG WHOSE DISC SPACE WE USED. * SWPID NOP ROUTINE TO SWAP SYS ID-SEG TACKS LDA IDA SAVE THE DUMMY ID ADDR STA DREL IN DREL ENTRY LDA ED25 GET THE ID-SEGMENT TO MOVE SZA,RSRS IF NO OLD ID-SEGMENT JUST JMP SWPID,I RETURN, ELSE STA IDA SET IT IN IDA FOR MVIDS AND STA MIDN SAVE FOR LATER CLA,INA SET EDIT FLAG JSB MVIDS AND CALL MVIDS TO SET UP NOP IGNOR ERROR RETURN LDB DREL RESTORE STB IDA THE DUMMY ID-ADDR LDB MIDN AND THE MOVED (AND NOW FREE) STB ED25 ID-SEGMENT ADDR ISZ SWPID BUMP RETURN ADDR FOR SWAP DONE JMP SWPID,I RETURN * * * THIS ROUTINE IS EXECUTED WHEN "MVIDS" DOES AN ERROR * RETURN FOR ATTEMPTING TO MOVE A LONG ID INTO A SHORT * ONE. "FIX" ROUTINE BLANKS OUT MEM BOUNDS AND DMAIN * OF THE SHORT ID AND THEN GOES TO "MVIDS" WITHOUT * SPECIFYING A TARGET ID. "MVIDS" SHOULD NEVER RUN * INTO THE PROBLEM OF RUNNING OUT OF LONG ID SEGS. * FIX NOP LDA N5 SET UP TO BLANK OUT STA SWPID MEM1 TO DMAIN OF SHORT ID. LDA ABT11 SET UP ADDR OF MEM1 OF ADA P11 SHORT ID SEGMENT. STA DREL WIPE CLA WRITE 0 IN MEM1 TO DMAIN LDB DREL JSB MODID ISZ DREL ISZ SWPID DONE ? JMP WIPE NO CLB CLA,INA CPB EDFLG SKIP IF EDITING CLA JSB MVIDS SET UP ID IN SYSTEM HLT 0 ** SHOULD NEVER HAPPEN ** JMP FIX,I RETURN * SKP * * DISC TRACK RELEASE ROUTINE * A = # OF TRACKS TO RELEASE * B = DISC SWAP WORD * * DREL NOP STA ED63 LDA TAT STARTING SSB BASE ADA TATSD ADDR STA ED64 FOR DISC UNIT. (ED64 = TAT ADDRESS) LDA SECT2 SET APPROPRIATE SSB # SECTORS/TRACK LDA SECT3 FOR STA ED62 DISC LDA B GET AND M177 MASK THE TRACK SWP SWAP ALF,ALF STARTING RAL TRACK AND M377 #. ADA ED64 ADD TO STA ED64  BASE ADDR. LDA B SET STARTING SECTOR CMA,INA,SZA,RSS IF ZERO JMP DREL1 JUMP ISZ ED64 ELSE DO NOT RELEASE FIRST TRACK ADA ED62 COMPUTE NUMBER LEFT ON TRACK CMA,INA AND DREL1 ADA ED63 SUBTRAC FROM NUMBER TO RELEASE SSA IF NEGATIVE JMP DREL,I RETURN NO TRACKS START WITH THIS ID SEGMENT CLB TOTAL # OF DIV ED62 SECTORS BY # SECTORS/TRACK. SZB ROUND INA TO # OF TRACKS INVOLVED, CMA,INA,SZA,RSS SET NEG. IF ZERO JMP DREL,I EXIT DONE STA ED62 FOR INDEX. * DR LDB ED64 CLEAR XLA B,I DO NOT SSA,RSS RELEASE JMP DR2 GLOBAL TRACKS LDA XEQT ASSIGN TRACK TO SELF JSB SYSET IN TRACK CLA JSB SYRUW DR2 ISZ ED64 TABLE. ISZ ED62 JMP DR JMP DREL,I SKP * * CLEAR ENTRY IN TAT * TATCL NOP SUBROUTINE TO RELEASE ALL TRACKS STB DREL CURRENTLY ASSIGNED TO PROG ID ADDR IN B LDB TATLG SET TAT LENGTH STB FIX24 FOR COUNT LDB TAT SET INITIAL ADDR STB FIX & SAVE NXTRK LDA DREL GET ID SEGMENT ADDR TO A XLB FIX,I THIS TRACK BELONG?? CPA B RSS YES SKIP JMP NXTR1 NO STEP TO NEXT ONE LDA XEQT ASSIGN JSB SYSET TRACK TO SELF NXTR1 ISZ FIX STEP TRACK ADDR ISZ FIX24 DONE?? JMP NXTRK NO TRY NEXT TRACK JMP TATCL,I YES REETURN * * ROUTINE TO CLEAN OUT THE ID SEG (MEM1 TO DMAIN) * WHOSE DISC SPACE WE UTILIZED BUT 'SWAPID' * DID NOT SAVE ANYTHING IN IT. USEFUL IF THIS * ID HAPPENS TO BE A LONG ONE BUT THE DUMMY IS SHORT. * ALSO EXECUTED WHEN ED24 AND ED25 HAVE SAME ID ADDR. * FIX24 NOP LDB ED24 ADB P14 (B)= NAM5 ADDR JSB MEM? GET ADDR OF >MEM1 NOP STB DREL SET UP MEM1 ADDR LDB N5 SET COUNT TO BLANK STB SWPID TO BLANK OUT MEM1-DMAIN. WIPE1 CLA (A)=0 LDB DREL (B)=ADDR OF WORD IN ID SEG JSB MODID MODIFY THE ID SEG ISZ DREL BUMP ADDR ISZ SWPID DONE ? JMP WIPE1 NO LDB ED25 (B)=0 FOR NO PARTICULAR ID JMP FIX24,I RETURN * SKP * * TRAKP NOP ID## NOP ED20 NOP ED21 NOP ED22 NOP ED23 NOP ED24 NOP ED25 NOP ED60 NOP ED61 NOP ED62 NOP ED63 NOP ED64 NOP ED66 NOP ED67 NOP * PTYPE DEC 3 PROGRAM DEFAULT = 3 = PRIVLEGED EDFLG NOP EDIT FLAG: 1 = ADDITION, 2 = REPLACEMENT, 0 = TEMP #PTTN NOP SPECIFIED PARTITION # #PGS NOP SPECIFIED # OF PAGES IN PROGRAM (INCLUDES BP) #MPFT NOP INDEX TO MEMORY PROTECT FENCE TABLE MSEG NOP SEGMENTED PROG FLAG * 0 = NOT SEGMENTED PROGGMENTED FLAG * 1 = SEGMENTED PROG BUT WE'RE LOADING MAIN * 2 = SEG PROG & WE'RE LOADING A SEGMENT OPCOD NOP 1ST WORD OF OPCODE FIELD LISTU NOP LIST OUTPUT UNIT # DFLAG NOP 0/1 NON INTERACTIVE / INTERACTIVE LU # FILE1 BSS 3 NAME OF INPUT FILE TYPE1 NOP PARSED TYPE WORD FOR FILE OR LU # F1SC NOP AND SECURITY CODE F1DSC NOP AND DISC LU OR CARTRIDGE # F2 DEF FILE2 FILE2 BSS 3 NAME OF COMMAND FILE TYPE2 NOP TYPE WORD FOR COMMAND FILE OR LU F2SC NOP AND ITS SECURITY CODE F2DSC NOP AND ITS LU OR CART REF LST1 NOP LST WORD 1 ADDR LST2 NOP LST WORD 2 ADDR LST3 NOP LST WORD 3 ADDR LST4 NOP LST WORD 4 ADDR LST5 NOP LST WORD 5 ADDR PRIOR NOP ADDR OF PRIORITY IN ID SEG PRENT NOP ADDR OF PRIMARY ENTRY POINT NAM12 NOP ADDR OF NAME 1,2 NAM34 NOP ADDR OF NAME 3,4% NAM5 NOP ADDR OF NAME 5, TYPE RESL NOP ADDR OF 10'S MILLS. IN ID SEG NUPLS NOP NO. UTILITY PROGS LOADED TPREL NOP CURRENT MAX PROG RELOC ADDR DBLAD NOP DATA BLOCK RELOCATION ADDR WDCNT NOP TEMPORARY COUNTER DSKUN NOP CURRENT DISK LOGICAL UNIT NO. DTRAK NOP CURRENT DBUF TRACK DSECT NOP CURRENT DBUF SECTOR CURAL NOP CURRENT LBUF ADDR TBUF BSS 5 TEMPORARY BUFFER MSEGF NOP MAIN/SEGMENT FINAL LOAD FLAG LWA NOP LOADING AREA, BPFWA NOP FWA OF ACTUAL BP LINK AREA LWABP NOP BASE PAGE AREA. SEGB NOP SEGMENT BASE PAGE LOWER BOUND DBLFL NOP FIRST DBL REC: -1,YES; 0,NO. FORCD NOP FORCE FLAG 0/-1 NO FORCE /FORCE LOAD N1 DEC -1 N6 DEC -6 N9 DEC -9 N60 DEC -60 N4 DEC -4 P2 DEC 2 P3 DEC 3 P4 DEC 4 P5 DEC 5 P6 DEC 6 P7 DEC 7 P8 DEC 8 P12 DEC 12 P14 DEC 14 P18 DEC 18 P20 DEC 20 M7 EQU P7 M20 OCT 20 M77 OCT 77 M177 OCT 177 M300 OCT 300 M377 OCT 377 M2000 OCT 2000 M0760 OCT 76000 M7400 OCT 177400 NDAY OCT 177574,025000 ENTRL DEF *+3 RELOCATION BASE TABLE RBTAD DEF *+1 RELOCATION BASE TABLE NOP PPREL NOP CURRENT PROG BASE BPREL NOP BASE PAGE BASE COMAD NOP COMMON BASE NOP ABSOLUTE BASE BLOK# NOP UCHRG OCT 43400 MSIGN OCT 100000 CHRDE ASC 1,.D CHRBU ASC 1,BU AMEM3 DEF MBUF+3 AMEM6 DEF MBUF+6 BLST NOP BEGINNING OF LOADER SYMBOL TABLE PLST NOP END OF LST TLST NOP CURRENT LST ADDR. SLST NOP INITIALIZE FOR SEGMENT AREA. FLST NOP FWA OF LST SET FOR USER'S PROG OEFL1 NOP ODD/EVEN SECTOR FLAG LBOEF NOP LIB ODD/EVEN SECOR FLAG #IDAD NOP ADDR OF LONG ID SEGMENT * SPC 1 #MNPG NOP LOWEST PAGE NO. USED BY PROG #MXPG NOP HIGHEST PA^GE NO. USED BY PROG #MXRT DEC -1 #PAGES IN LARGEST RT PTTN #MXBG DEC -1 #PAGES IN LARGEST BG PTTN ER.16 LDA ERR16 ILLEGAL PTTN # JMP ABOR ERR16 ASC 1,16 SPC 1 SKP * BASE PAGE COMMUNICATION VALUES * A EQU 0 B EQU 1 * . EQU 1650B ESTABLISH ORIGIN OF AREA * INTLG EQU .+5 NUMBER OF INTERRUPT TBL ENTRIES TAT EQU .+6 FWA OF TRACK ASSIGNMENT TABLE KEYWD EQU .+7 FWA OF KEYWORD BLOCK XEQT EQU .+39 ID SEGMENT ADDR OF LOADR IDSDA EQU .+56 DISC ADDR. OF FIRST ID SEGMENT IDSDP EQU .+57 -POSITION WITHIN SECTOR BPA2 EQU .+59 LWA RT DISC RES. BP LINK AREA RTORG EQU .+62 FWA OF REAL-TIME AREA RTCOM EQU .+63 LENGTH OF REAL TIME COMMON AREA RTLWA EQU .+65 LWA OF RT DISC RESIDENT AREA BKORG EQU .+66 FWA OF BG AREA BKCOM EQU .+67 LENGTH OF BG COMMON AREA TATLG EQU .+69 LENGTH OF TRACK ASSIGNMENT TABLE TATSD EQU .+70 # OF TRACKS ON SYSTEM DISC SECT2 EQU .+71 # SECTORS/TRACK ON LU 2 (SYSTEM) SECT3 EQU .+72 # SECTORS/TRACK ON LU 3 (AUX.) DSCLB EQU .+73 DISC ADDR OF RES LIB ENTRY PTS DSCLN EQU .+74 # OF RES LIB ENTRY POINTS DSCUT EQU .+75 DISC ADDR OF RELOC UTILITY PROGS SYSLN EQU .+76 # OF RELOC UTILITY PROGS LGOTK EQU .+77 LOAD-N-GO: LU,STG TRACK,# OF TRKS LGOC EQU .+78 CURRENT LGO TRACK/SECTOR ADDR BKLWA EQU .+87 LWA OF MEMORY IN BG SPC 1 SPC 1 SPC 1 BPA1 EQU P2 FWABP USER RT DISC RES BPA3 EQU BPA1 FWABP USER BG DISC RES BKGBL EQU BPA2 LWABP USER BG DISC RES URFWA NOP FWA USE RT DISC RES AREA URLWA OCT 77777 LWA USER RT DISC RES AREA UBFWA EQU URFWA FWA USER BG DISC RES AREA UBLWA EQU URLWA LWA USER BG DISC RES AREA * BSS 0 SIZE OF LOADR SPC 3 END LOADR ]HFBBH { 92067-18003 1805 S C0222 &4MTM1 RTE-IV MULTI TERMINAL MONITOR             H0102 ASMB,R,L,C HED PRMPT - MTM PROMPTER * NAME: PRMPT * SOURCE: 92067-18003 * RELOC: PART OF 92067-16003 * PGMR: G.A.A.,C.M.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM PRMPT,1,5 92067-16003 REV.1805 780119 SUP PRESS ALL EXTRANEOUS LISTING EXT EXEC,TRMLU,$LIBR,$LIBX,IDGET,$RNTB EXT $LIBR,$LIBX,$MTM * * THIS INTERRUPT ROUTINE REPLACES (AUXTY IN RTE) WITH (PRMPT IN RTE II). * IT IS SCHEDULED ON INTERRUPT BY DVR00 IF THAT TERMINAL HAS BEEN * PROPERLY ENABLED (ON,CNTRL,LU,20) * PRMPT : DETERMINES LU IN ASCII & BINARY * OUTPUTS A ZERO LENGTH RECORD * OUTPUTS "LU>_" * REQUESTS A CLASS READ TO THE INTERRUPTING LU * SCHEDULES R$PN$,2,10 WITH :CLASS #,EQT4,LU,ASCII LU * W/O WAIT * TERMINATES,SAVING RESOURCES * PRMPT EQU * STB EQT4 SAVE INTERRUPTING DEVICE'S EQT WORD 4 ADDRESS JSB TRMLU OBTAIN LU IN BINARY & ASCII DEF *+1 SZA,RSS FOUND ONE ? JMP EXIT NO,TERMINATE. STA LU YES,SAVE LU IOR B400 READY PRINT BACK STA RLU SAVE READ LU + CNTRL IN RLU XOR B2500 FORM CONTROL WORD... STA CONWD * STB ASCLU SAVE ASCII LU BLF,BLF ROTATE FOR NAME STB PNAM+2 FORM NAME OF FMGR FOR THE TERMINAL * SPC 1 * CHECK IF DEVICE IS OPERABLE SPC 1 LDB DRT GET START OF DEV REF TAB ADB LU INDEX TO PROPER ENTRY ADB DM1 STB LU1 SAVE THE ADDRESS ADB LUMAX GET TO DRT PART 2 LDA B,UI PULL IT IN SSA IS THE LU DOWN ? JMP EXIT YES SO FORGET IT * LDB EQT4 NOW GET INB EQT 5 LDA B,I AND MEQT GET THE EQT TYPE FOR STA DVTYP DVR07 CHECK * LDA B,I GET IT AGAIN RAL,RAL GET STATUS BITS AND D3 CPA D1 IS EQT DOWN ? JMP EXIT YES SO FORGET IT * LDA LU1,I GET THE DRT ENTRY AND M3700 NOW THE LOCK BITS SZA,RSS IS THE DEVICE LOCKED ? JMP DISAB NO, SO WRITE OUT THE PROMPT. * ALF,ALF YES SO CONFIGURE A RN BYPASS WORD RAL,RAL STA RN# ADA RNTB NOW GO TO RN # TABLE XLA A,I AND B377 GET THE OWNER TO ALF,ALF TO UPPER END IOR RN# CONFIGURE THE WORD DISAB STA RN# * LDA DVTYP GET THE DRIVER TYPE CPA DVR07 IS IT DVR07 ? JMP DVR7A YES * JSB EXEC DISABLE THE TERMINAL TO AVOID DEF *+10 MULTIPLE PROMPTS.... DEF D3 DEF CONWD DEF NOP DEF NOP DEF NOP DEF NOP DEF NOP DEF NOP DEF RN# * JMP ZEROL GO SEND ZERO LENGTH RECORD * DVR7A LDA LU SEND EDIT MODE REQUEST TO DVR07 IOR B2300 STA CONWD JSB EXEC DEF *+10 DEF D3 DEF CONWD DEF IM DEF NOP DEF NOP DEF NOP DEF NOP DEF NOP DEF RN# * ZEROL JSB EXEC RESPOND WITH DEF *+10 ZERO LENGTH RECORD DEF DS2 DEF LU DEF BUFF DEF D0 DEF NOP DEF NOP DEF NOP DEF NOP DEF RN# NOP * LDA PNAM+2 FINISH NAME SET UP AND B377 KEEP LOW CHAR. ONLY IOR "G" ADD HIGH ORDER G FOR FMGXX STA PNAM+1 SET 'GX' SKP * JSB IDGET LOOK UP THE ID ADDRESS DEF *+2 DEF PNAM SEZ v JMP PROMT NO GO DO PROMPT * ADA D8 GET POINT OF SUSP. XLB A,I GET ADDRESS SZB IF NOT ZERO JMP PROMT DO STD. PROMPT * ADA D12 GET ADDRESS OF SESSION BIT WORD STA IDA SAVE IT FOR LATER ADA D12 GET THE SESSION WORD STA SESWD SAVE IT FOR LATER TOO * * JSB EXEC TRY TO SCHEDULE 'FMGLU' DEF *+1+9 DEF DS10 (NO ABORT) DEF PNAM DEF LU PASS IT THE TERMINAL LU DEF LU LOG LU DEF LU LIST LU DEF D1 SEVERITY OF ONE DEF D1 DUMMY DEF STNG TURN ON STRING DEF D4 LENGTH IS 4 JMP PROMT IF ERROR - DO PRMPT-R$PN$ THING! SZA A=0 IF ALL'S WELL... JMP PROMT ELSE, DO PRMPT-R$PN$ AS NORMAL. * JSB $LIBR GO PRIV NOP XLA IDA,I GET THE SESSION BIT WORD IOR SESS XSA IDA,I SET SESSION BIT IN ID LDB LU GET OUR LU # CMB,INB MAKE NEG XSB SESWD,I AND SET UP FMGR'S LOG LU JSB $LIBX DEF *+1 DEF *+1 LDA ASCSP SET UP PROMPT BUFFER... STA ASCLU+1 JSB EXEC OUTPUT "LU> FMGLU" DEF *+10 DEF DS2 DEF LU DEF ASCLU DEF N9 DEF NOP DEF NOP DEF NOP DEF NOP DEF RN# * NOP * LDA DVTYP GET THE DEVICE TYPE CPA DVR07 IS IT DVR07 ? JMP EXIT YES, SO JUST EXIT LDA CONWD RE-ENABLE THE TERMINAL AND B77 IOR B2000 STA CONWD JSB EXEC DEF *+10 DEF D3 DEF CONWD DEF NOP DEF NOP DEF NOP DEF NOP DEF NOP DEF NOP DEF RN# JMP EXIT * PROMT LDA ASCBK SET BACK-ARROW IN PROMPT STA ASCLU+1 MESSAGE * JSB EXEC DEF *+10 "LU>_" DEF DS2 5 DEF LU DEF BUFF DEF D2 DEF NOP DEF NOP DEF NOP DEF NOP DEF RN# NOP SPC 1 LDA $MTM GET ANY PREVIOUS CLASS # ALLOCATED STA CLASS AND USE IT. SPC 1 JSB EXEC PERFORM CLASS I/O READ DEF *+10 DEF DS17 DEF RLU DEF * DEF DM52 DEF LU DEF EQT4 DEF CLASS DEF NOP DEF RN# NOP SSA ERROR RETURN? JMP EXIT YES-BEAT IT ! * ZAPIT JSB SVMTM NO, SO SAVE CLASS # SPC 1 JSB EXEC SCHEDULE R$PN$ W/O WAIT DEF *+1+3 IGNORE SCHEDULE ERRORS SINCE DEF D10 R$PN$ IN CLASS 'GET' SUSPEND DEF R$PN$ DEF CLASS * * * EXIT JSB EXEC TERMINATE DEF *+1+3 & SAVE DEF D6 RESOURCES DEF D0 DEF D1 JMP PRMPT RESTART HERE ON INTERRUPT * * * * * SVMTM NOP JSB $LIBR GO PRIV NOP LDA CLASS GET CLASS # STA $MTM AND SAVE IN TABLE AREA 1 CLA NEVER DO THIS SUB AGAIN STA ZAPIT JSB $LIBX DEF SVMTM RETURN * * SKP IDA NOP "G" OCT 43400 B377 OCT 377 SESS OCT 20000 EQT4 BSS 1 LU BSS 1 B77 OCT 77 B400 OCT 400 B2000 OCT 2000 B2500 OCT 2500 RLU BSS 1 DS2 OCT 100002 D2 OCT 2 D3 OCT 3 D25 DEC 25 CONWD NOP LU1 NOP DRT EQU 1652B LUMAX EQU 1653B BUFF EQU * ASCLU ASC 2,00>_ PROMPT MESSAGE PNAM ASC 3,FMGXX FMGR FOR THE TERMINAL ASCSP ASC 1,> * ASCBK ASC 1,>_ * N9 DEC -9 D6 DEC 6 D0 DEC 0 D1 DEC 1 DM1 DEC -1 M3700 OCT 3700 D4 DEC 4 D8 DEC 8 D12 DEC 12 STNG ASC 4,::HI::-2 TR TO 'HI' TO START UP CLASS NOP NOP NOP DM52 DEC -52 D10 DEC 10 DS10 OCT 100012 R$PN$ ASC 3,R$PN$ DS17 OCT 100021 RNTB DEF $RNTB+0 RN# NOP MEQT OCT 37400 B2300 OCT 2300 IM OCT 71401 DVR07 OCT 3400 DVTYP NOP SESWD NOP A EQU 0 B EQU 1 END PRMPT ASMB,R,L,C * ASMB,Z FOR THE WHZAT SCHEDULING OPTION HED R$PN$ MTM RESPONSE * NAME: R$PN$ * SOURCE: 92067-18003 * RELOC: PART OF 92067-16003 * PGMR: G.A.A.,C.M.M. * DATE: AUGUST 1,1974 * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM R$PN$,1,5 92067-16003 REV.1805 780119 SUP PRESS EXTRANEOUS LISTING EXT EXEC,TRMLU,$RNTB,$WORK,$$OP EXT $LIBX,$LIBR,IDGET,$MESS,$PVCN * A EQU 0 B EQU 1 * * SPC 2 R$PN$ EQU * ENTRY POINT,SCHED BY PRMPT SPC 2 XLA B,I GET CLASS # AND C160K MASK OFF CLASS NO ONLY STA RQCLS & SAVE IT IOR B20K SET FOR SAVE CLASS STA CLASS & SAVE IT ! JSB BUFF INITILIZE ID ADDS (NOP AFTER FIRST CALL) SPC 2 WAIT JSB EXEC CLASS I/O GET DEF *+1+7 DEF D21 DEF CLASS DEF BUFF DEF DM52 DEF LU DEF ID DEF RCLAS * LDA RCLAS RAR,SLA WAS THIS A READ RETURN? JMP WAIT NO, WAIT * SPC 1 * SEE IF WE CAN WRITE TO THE LU W/O BEING SUSPENDED SPC 1 * LDA DRT GET START OF DEV REF TAB ADA LU INDEX TO PROPER ENTRY ADA DM1 STA LU1 SAVE THE ADDRESS ADA LUMAX GET TO DRT PART 2 LDA A,I PULL IT IN SSA IS THE LU DOWN ? JMP ENABL YES SO FORGET IT * LDA ID NOW GET INA EQT 5 LDA A,I RAL,RAL GET STATUS BITS AND D3 CPA D1 IS EQT DOWN ? JMP ENABL ^ YES SO FORGET IT * LDA LU1,I GET THE DRT ENTRY AND M3700 NOW THE LOCK BITS SZA,RSS IS THE DEVICE LOCKED ? JMP SETRN NO, DO IT ! * ALF,ALF YES, SO CONFIGURE LOCK ID WORD RAL,RAL STA RN# ADA RNTB XLA A,I GET THE OWNER OF THE RN # AND B377 ALF,ALF IOR RN# SETRN STA RN# * LDA ID GET THE EQT INA TYPE WORD LDA A,I AND MEQT KEEP ONLY DEVICE TYPE FOR STA DVTYP LATER DVR07 CHECK * * WRITES & READS TO THIS TERMINAL ARE OK . STB IB YES, SAVE XFER LOG CHARS SZB,RSS IF ZERO-LENGTH JMP ENABL SKIP PROCESSING CODE. * * SPC 2 LDA BUFF TEST FOR FLUSH COMMAND CPA ASCFL JMP FL YES-FLUSH THIS LU'S BUFFER * CPA "BR" IF BREAK JMP BRPR GO DO BREAK * CPA "AB" IF ABORT JMP ABPR GO DO ABORT THING * IFZ CPA WHZAT WHZAT CALL? JMP WHPR YES GO DO IT XIF SPC 2 PROCS EQU * NO-PROCESS REQUEST JSB MESSX BUFFR DEF BUFF * * MES SZA,RSS ANY MESSAGE RETURNED ? JMP ENABL NO. * * JSB EXEC & DISPLAY DEF *+10 SYSTEM DEF D18 MESSAGE DEF LU DEF BUFF DEF IA DEF LU DEF ID DEF RQCLS DEF NOP DEF RN# SPC 2 JMP ENABL NOW WAIT SPC 2 FL EQU * LDA DVTYP GET DEVICE TYPE CPA DVR07 IF ITS DVR07 JUST JMP WAIT FORGET IT. * LDA B2300 SET UP CNWRD IOR LU TO FLUSH STA CONWD JSB EXEC PERFORM DEF *+10 I/O DEF D3 CONTROL DEF CONWD DEF CONWD DEF RQCLS DEF NOP DEF NOP DEF NOP DEF NOP DEF RN# SPC 2 ENABL EQU * ΔLDA DVTYP GET THE DEVICE TYPE CPA DVR07 IS IT DVR07 ? JMP WAIT YES SO DON'T SEND DVR CONTROL REQUEST LDB ID RETRANSLATE JSB TRMLU INCASE LU WAS REASSIGNED DEF *+1 IOR B2000 STA CONWD JSB EXEC DEF *+10 DEF DS3 REENABLE THE TERMINAL DEF CONWD DEF NOP DEF NOP DEF NOP DEF NOP DEF NOP DEF NOP DEF RN# * JMP WAIT JMP WAIT SPC 2 BRPR LDB IB IF IB MORE THAN BRS,BRS 3 CHAR. SZB THEN JMP PROCS LET SYSTEM HANDLE * JSB GETID GET THE LOWEST ID SEGMENT BRSET JSB $LIBR GO PRIV NOP ADB D5 INDEX TO BRAKE LOCATION XLA B,I GET THE WORD IOR BIT12 SET THE FLAG XSA B,I RESET THE WORD JSB $LIBX GET OUT DEF *+1 DEF ENABL RE- ENABLE THE TERMINAL * * ABPR JSB GETID GET LOWEST ID SEZ,RSS IF IT IS FMGR JMP BRSET GO SET BREAK IN STEAD * ADB N3 XLA B,I GET NAME STA NAM1 INB STEP TO NAM 2 XLA B,I GET IT STA NAM2 INB NOW NAM 3 XLA B,I AND C377 IOR B40 ADD BLANK PAD STA BUFF SET IN FIRST WORD OF BUFFER LDA IB GET THE OLD LENGTH ADA D8 WE ADDED 8 CHARACTERS STA IB JSB MESSX SEND THE MESSAGE DEF OF JMP MES * IFZ WHPR JSB EXEC RUN WHZAT TO THIS TERMINAL DEF WHEX WITHOUT WAIT & WITHOUT ABORT DEF D10I DEF WHZAT DEF LU WHEX NOP IGNOR ERROR JMP ENABL GO TO NEXT TRICK * WHZAT ASC 3,WHZAT D10I DEF 10,I XIF SPC 2 GETID NOP SUBROUTINE TO TRACK DOWN THE LOWEST ID LDA LU CONVERT THE LU INTO CLB THIS GUY'S DIV D10 FMGXX  IOR "G0" FORM 'GX' PART OF FMGXX STA PNAM+1 SET IT ADB "G0" ADJUST LOW X TO ASCII BLF,BLF ROTATE IT STB PNAM+2 SET LOW X IN HIGH PART OF WORD 3 JSB IDGET GET THE ID ADDRESS DEF *+2 DEF PNAM OF THIS FMGR SEZ GET ONE?? JMP PROCS NO DO STANDARD TRICK * NXSON STA B SET IN B AND STB IA SET IN IA ADB D15 INDEX TO THE STATUS XLA B,I GET IT TO A ALF,SLA WAITING FOR A SON?? JMP TRK YES TRACK DOWN * JMP GETID,I NO THIS IS IT * TRK ISZ IA SET TO PICK UP SON'S ID XLA IA,I GET THE SON'S ID CPA D.RTR IF D.RTR OR JMP GETID,I * CPA SMP SMP THEN STOP JMP GETID,I HERE * CCE SET E TO SHOW NOT FIRST ONE JMP NXSON GO GET IT * * * * SKP * THE MESSX SUBROUTINE IS A PERTERBATION OF THE RELEASED * MESSS SYSTEM LIBRARY ROUTINE. IT DOES ALL THE FUNCTIONS * THAT THE RELEASED ROUTINE DOES AND ALSO SETS UP THE LOG LU * IN WORD 32 OF THE PROGRAMS ID SEGMENT. * IN ADDITION, IT AVOIDS .ENTR AND SPENDS MINIMAL TIME WITH * THE INTERUPT SYSTEM OFF. * * ********************************************************************** * * * MODIFY THIS SUBROUTINE AT YOUR UNDYING AND EVERLASTING * * PERIL !!!! * * * * YOU SEE, $MESS DOES NOT ALWAYS RETURN, IE IT'S AN * * OPEN SUBROUTINE. * * * * WHEN THE PROG IS REDISPATCHED GUESS WHERE CONTROL IS * * TRANSFERED ? * ********************************************************************** * * * CALLING SEQUENCE : JSB MESSX * DEF BUFFR INPUT MESSAGE BUFFER * * LU = LOG LU * IB = POS CHAR COUNT * * ON RETURN : A = 0 IF NO MESSAGE * ELSE IA = NEG CHAR COUNT * AND BUFF CONTAINS MESSAGE * * * MESSX NOP JSB $LIBR GO PRIV !!!! NOP * LDA HERE AM I ALREADY HERE ? SZA,RSS WELL ? JMP EXITR YES, SO I DON'T WANT TO BE HERE NOW. * CLA NO STA HERE BUT NOW I'M HERE STA $PVCN (RESET PRIV NEST CNTR SO SYS STAYS UP) * LDA MESSX,I GET THE BUFFER ADDRESS LDB IB GET THE CHAR COUNT (POS) JSB $MESS PASS MESSAGE TO SYSTEM. * SZA,RSS ANY MESSAGE RETURNED ? JMP CHECK NO, SO CHECK FOR RU & ON * XLB A,I GET THE CHAR COUNT (NEG) STB IA AND SAVE FOR MESSAGE OUTPUT * CMB,INB MAKE POS INB ACCOUNT FOR ODD CHAR BRS CONVERT TO WORDS CBX SET MOVE COUNT INA SOURCE (A NOT = 0 FOR RETURN) LDB BUFFR DESTINATION MWF MOVE WORDS FROM ALT MAP TO THIS MAP * SPC 2 * EXITR CLB,INB NOW SET A FLAG SO STB HERE I KNOW I'M NOT HERE & SO STB $PVCN THE PRIV RUN RETURNS CORRECTLY * ISZ MESSX SET RETURN JSB $LIBX RETURN TO INTERUPT PROCESSING DEF MESSX SPC 2 * CHECK LDB $WORK GET PROGRAM'S ID SEGMENT ADDRESS. INB LDA MESSX,I TEST FOR ON OR RUN LDA A,I COMMANDS. CPA .ON JMP DP1 TEST 1ST PRAM CPA .RU JMP DP1 JMP DP2 SEE IF SYSTEM PARSED A RU OR ON COMMAND. * SPC 2 DP1 XLA B,I GET 1ST PRAM THAT SYSTEM DID Q SZA,RSS WAS THERE ONE ? LDA LU NO. SO GET THE LU XSA B,I AND GIVE IT TO THE PROGRAM. * DP2 XLA $$OP,I GET THE 1ST PRAM PARSED BY SYSTEM CPA .ON ON ? JMP DP3 CPA .RU RU ? JMP DP3 * RETRN CLA NO, SET NO MESSAGE FLAG & JMP EXITR RETURN. * DP3 ADB D13 GET TO THE STATUS WORD XLA B,I PULL IT IN AND D7 KEEP ONLY THE STATUS FIELD CPA D1 MEM RES PROG ? ADB DM4 ADB D18 INDEX TO THE SESSION WORD LDA LU GET THE LU CMA,INA MAKE NEG XSA B,I AND SET AS THE LOG LU JMP RETRN RETURN TO CALLER * * * "BR" ASC 1,BR "G0" ASC 1,G0 "AB" ASC 1,AB PNAM ASC 3,FMGXX CURRENT MASTER FMGR BIT12 OCT 10000 D8 DEC 8 DM4 DEC -4 D7 DEC 7 D13 DEC 13 DM1 DEC -1 DRT EQU 1652B LUMAX EQU 1653B LU1 NOP M3700 OCT 3700 D10 DEC 10 D1 DEC 1 SMP NOP ADDRESS OF SMP'S ID D.RTR NOP ADDRESS OF D.RTR'S ID D5 DEC 5 B40 CLE C377 OCT 177400 COMPLEMENT OF 377B D15 DEC 15 N3 DEC -3 * PRAM NOP BEGIN 5 WORD PRAM BUFFER CLASS EQU PRAM IA NOP PLEASE IB NOP DO NOT LU NOP RE-ARRANGE ID NOP THESE CONSTANTS D21 DEC 21 D3 DEC 3 DS3 OCT 100003 C160K OCT 17777 KEEP BITS 0-12 DM52 DEC -52 OF ASC 2,OF, DON'T MOVE THE NEXT 4 WORDS NAM1 NOP NAM2 NOP BUFF BSS 26 MUST FOLLOW THE OF, CODE ORG BUFF NOP INIT SUB. NEEDED ONLY ONCE JSB IDGET GET D.RTR'S ID DEF *+2 DEF D. SEZ CLA IF NONE SET TO ZERO STA D.RTR SAVE IT JSB IDGET NOW GET SMP'S DEF *+2 DEF SM SEZ IF NONE CLA USE ZERO STA SMP CCB GET THE CALL TO HERE ADB BUFF AND CLA r*($ CLEAR STA B,I IT JMP BUFF,I RETURN * SM ASC 3,SMP D. ASC 3,D.RTR * LEFT EQU BUFF+26-* ERROR IF NEGATIVE ORR OUT OF THE BUFFER D18 DEC 18 HERE DEC 1 FLAG FOR IN OR OUT OF MESSX .ON ASC 1,ON .RU ASC 1,RU B377 OCT 377 RNTB DEF $RNTB+0 RN# NOP RCLAS NOP ASCFL ASC 1,FL CONWD NOP B2300 OCT 2300 B2000 OCT 2000 DVR07 OCT 3400 NOP NOP MEQT OCT 37400 DVTYP NOP B20K OCT 20000 RQCLS NOP EOP EQU * SPC 2 END R$PN$ * } 92067-18004 1840 S 0122 RTE-IV POWER FAIL DRIVER              H0101 ASMB,R,L,C RTE-IV POWER FAIL/AUTO RESTART DRIVER HED DVP43 - RTE-IV POWER FAIL / AUTO RESTART * NAME: DVP43 * PGMR: G.A.A.,E.J.W. * SOURCE: 92067-18004 * RELOC: 92067-16004 * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM DVP43,0 92067-16004 REV.1840 780731 ENT $POWR,IP43,CP43 EXT $CVEQ,$SCLK,$TIME,$XEQ,$UPIO,$LIST,$MESS EXT $CIC,$PWR5,$DVMP,$DRVM,$UIN SUP * * * * THIS IS THE RTE-IV POWER FAIL AUTO RESTART ROUTINE. * * W A R N I N G ! ! ! * ******************** * DVP43 MUST BE INSTALLED IN THE RTE-IV SYSTEM AS A DRIVER * IN THE SYSTEM DRIVER AREA. THIS DRIVER DOES ITS OWN MAPPING. * * DVP43 REQUIRES AN EQT ENTRY: * 04,DVP43,M * * DVP43 REQUIRES A DRT ENTRY: * XX,## * * DVP43 REQUIRES AN INTERRUPT TABLE ENTRY: * 04,ENT,$POWR * * * * IT WORKS AS FOLLOWS: * * ON POWER FAILURE: * 1. BOTH DMA CHANNELS (PORT A AND B) ARE STOPPED * 2. ALL REGISTERS ARE SAVED, ALSO RETURN ADDRESS * 3. ALL FOUR MAPS ARE SAVED. * 4. TURN OFF POWER-FAIL INTERRUPTS UNTIL POWER RETURNS * * ON POWER UP: * 1. ALL FOUR MAPS ARE RESTORED * 2. THE EQT ADDRESS FOR THIS ROUTINE IS FOUND, IT * IS SET TO TIME OUT IN ONE TICK, AND THE "I WILL * HANDLE TIME OUT" BIT IS SET. * 3. THE CURRENT SYSTEM TIME IS SAVED (THIS WILL BE THE * TIME OF POWER FAILURE). * 4. THE CLOCK IS RESTARTED BY CALLING $SCLK WHICH WILL * SET UP FOR AN IMMEDIATE INTERRUPT. * 5. A RETURN WITH ALL REGISTERS RESTORED IS MADE TO THE * POINT OF THE POWER FAIL INTERRUPT. * * * ON THE FOLLOWING TIME OUT ENTRY THE FOLLOWING ACTION IS * TAKEN: * * 1. EACH EQT ENTRY IS CHECKED AND) * A) IF BUSY IT'S POWER FAIL FLAG IS SET (BIT 13 OF * THEN THE DRIVER IS ENTERED AT I.XX. THE FACT THAT * IT IS A POWER FAIL ENTRY MAY BE DETECTED BY * CHECKING THE BUSY BIT (ON NORMAL ENTRIES IT IS * NOT SET.) * * B) IF THE DEVICE IS BUSY AND IT'S POWER FAIL BIT * IS NOT SET THE DEVICE WILL BE SET DOWN, THE * POWER FAIL ROUTINE TIME OUT WILL BE SET BACK * TO ONE TICK AND THE CLOCK RESTARTED AND THE * SYSTEM "UP" PROCESSOR WILL BE CALLED TO UP * THE DEVICE. THIS CAUSES THE SYSTEM TO REISSUE * THE LAST REQUEST AND TO REENTER THE TIME OUT * SECTION OF THIS REOUTNE. * THE IMPLICATIONS OF THIS ARE THAT DISC TRANSFERS * WILL BE RETRIED, TTY, PUNCH, PHOTO READER * REQUESTS WILL BE RE-DONE RESULSTING IN DOUBLE * LINES IN SOME CASES. * * SOME DEVICES WILL BE REPORTED DOWN IS THEIR POWER * WAS ALSO CUT E.G. MAGTAPE, DISC. THESE * DEVICES MAY BE UPPED BY THEIR DRIVERS WHEN THEY * COME BACK ON LINE E.G. THE DISC. * * C) IF THE DEVICE IS DOWN THE SYSTEM UP PROCESSOR WILL * BE CALLED TO UP THE DEVICE. THIS WILL CAUSE * THE DOWNED DEVICES TO HAVE NEW MESSAGES POSTED * ON THE SYSTEM TTY. * * 2. THE PROGRAM "AUTOR" WILL BE ABORTED AND RESCHEDULED. * (THE ABORT IS TO ALLOW FOR MOMENTARY POWER UPS.) * AUTOR SHOULD TAKE WHAT EVER ACTION IS NEEDED TO * BRING UP THE SYSTEM IN TERMS OF ENABLING TERMINALS - * COMMUNICATION LINES ETC. IN ORDER TO ALLOW TIME * SYNC. THIS ROUTINE WILL PROVIDE THE THREE WORD SYSTEM * TIME AT POWER FAILURE ON THE FIRST READ REQUEST * AFTER POWER UP. THE SECOND READ REQUEST WILL * RETURN THE SAME TIME BUT CAUSES THE ROUTINE TO * RESET TO HANDLE A TOTAL NEW POWER FAILURE HED POWER UP/DOWN ENTRY POINT/ DOWN CODE. $POWR NOP POWER UP/DOWN ENTRY SFC 4 UP? JMP UP YES GO DO UP THING. * JMP DOWN,I GO TO DOWN ROUTINE DOWN DEF DWN POINTS TO WAIT WHILE SENSITIVE * CODE IS EXECUTING. STF STF 0 TURN ON THE INTERRUPT SYSTEM SW2 NOP (CLF 0 IF NOT USER RETURN ELSE STC 5) JRS MEMST PSAVE,I RETURN TO PT OF PWR FAIL. * DOWNI DEF DOWN INDIRECT FOR EXIT TO AVOID INTERRUPT * EXIT2 LDA ASAVE RESTORE A REGISTER LDB BSAVE AND THE B REGISTER JSB DOWNI,I RESET DOWN SWITCH AND EXIT * * DOWN ROUTINE * DWN STF 6B STOP DMA! PREVENT LONG DMA STF 7B TRANSFER FROM JAMMING CPU STA ASAVE SAVE A-REG. STB BSAVE SAVE B-REG. ERA,ALS SOC SET LEAST A FOR INA "O-REG" SIGN FOR "E-REG" STA EOSAV SAVE E/O LDA $POWR SAVE INTERRUPT LOCATION STA PSAVE STX XSAVE SAVE X-REG STY YSAVE SAVE Y-REG * LIA 5 SAVE ADDRESS WHERE WE LIB 5 LAST VIOLATED IN CASE OF MP IN CPB A PROGRESS - IF SO THEN ALSO SSB,RSS XOR B SZA JMP *+3 STB $CIC RESET THE INTERRUPT LOCATION STB $PWR5 * CLA,INA CLEAR SWITCH, SET NONZERO WHEN STA SW2 DONE WITH SAVE SEQUENCE * LIA 2 SAVE THE DMA STA SDMA1 WORD COUNTS LIA 3 STA SDMA2 LIA 1 SAVE THE SWITCH STA SSAVE REGISTER RSA SAVE STATUS OF STA MEMST WHAT WAS LAST MAP USED CLA (A) = STARTING REG= # LDB SMAPA (B) = ADDR OF MAP SAVE AREA LDX MD128 (X) = -128 TO SAVE ALL MAPS XMM LDA STC5 SET UP THE EXIT SFS 0 SWITCH BASED ON INTERRUPT SYSTEM LDA CLF0 STA SW2 WAIT CLC 4 SET UP FOR MOMENTARY HLT 0 POWER FAILURE /WAIT FOR POWER HED POWER UP ROUTINE UP LDA DWAIT SET SWITCH FOR DOWN ROUTINE STA DOWN TO AVOID LOSS OF INFORMATION. LDA SW2 SSA,RSS IF HALTED OR NOT ENOUGH TIME JMP HALT TO SAVE EVERYTHING ON WAY DOWN * CLC 0,C INIT THE WHOLE I/O SYSTEM. * STC 4 CAN NOW ALLOW A DOWN INTERRUPT. * CLA (A) = STARTING REG # LDB SMAPA (B) = ADDR OF MAP SAVE AREA LDX D128 (X) = +128 TO RESTORE ALL MAPS XMM * LDA MEMST GET MEU STATUS WORD AND B3777 SAVE FENCE ADDR AND PORTION BIT LFA LOAD FENCE * LDB EQT# SET UP TO SEARCH FOR CMB,INB THE POWER FAIL STB EQTCO EQT LDB EQTA ADDRESS INB * NEXT LDA B,I GET WORD #2 CPA DEFI. IS IT THE LOCAL IP43? JMP FOUND YES GO DO IT * ADB D15 NO INDEX TO NEXT EQT ISZ EQTCO IF END THEN SKIP JMP NEXT TRY NEXT ENTRY * HALT HLT 4,C CPU HALTED, LESS THAN 500US, JMP *-1 OR NO EQT ENTRY FOR POWER FAIL * FOUND ADB D2 INDEX TO WORD 4 LDA B,I FETCH IT IOR B10K SET THE "I WILL HANDLE TIME OUT" STA B,I BIT ADB D11 INDEX TO EQT15 CCA,CCE AND SET TIME OUT STA B,I FOR NEXT TICK. STB EQ15 SAVE EQT15 ADDRESS * LDB EQTCO INB ADB EQT# GET EQT# OF POWER FAIL DRIVER ADB $DVMP GET THE FIRST WORD OF LDA B,I THE DRIVER MAP TABLE ENTRY AND B76K AND INSURE THAT THE SDA FLAG IOR SDAFL ANDF DO-MY-OWN-MAPPING FLAGS STA B,I ARE SET * LDA TIME+2 IF TIME IN HAND SZA THEN DO NOT JMP NIXTM SAVE IT AGAIN * DLD $TIME GET THE TIME OF DAY D$TM EQU *-1 DST TIME AND SAVE IT LDA D$TM GET ADDRESS RAL,CLE,SLA,ERA OF LDA A,I DAY/YEAR ADA D2 AND LDB A,I SAVE THE TIME OF YEAR STB TIME+2 TOO. * NIXTM CLA,CCE CLEAR THE EQT COUNT STA EQTCO FOR THE TIME OUT ROUTINE. LDA EQ5,I SET EQT IN PROCESS ALR,ERA BUSY STA EQ5,I SO WE UP IT AGAIN JSB $SCLK SET CLOCK FOR INTERRUPT LDA CLF0 SET EXIT SWITCH TO SYSTEM LDB MPTFL IF MP FLAG SZB SAYS WE STA SW2 WERE IN THE SYSTEM LDA DUMMY IF PRIV. SYS SZA,RSS MUST SET UP. WELL? JMP NOPRV OK SO DON'T. * IOR STF MAKE A STF DUMMY STA STFD PUT IT DOWN STFD NOP AND DO IT IOR STCD NOW MAKE A STC DUMMY STA STCD AND IOR CLCD A CLC DUMMY STA CLCD DO THE CLC CLCD CLC 0 NOW SZB IF IN SYSTEM ALSO STCD NOP DO THE STC. NOPRV LDA EOSAV RESTORE THE REGISTERS CLO SLA,ELA STO LDA SDMA1 STC 2 OTA 2 LDA SDMA2 STC 3 OTA 3 * * LDX XSAVE RESTORE X-REG LDY YSAVE RESTORE Y-REG NOMX2 LDA SSAVE OTA 1 LDA FENCE OTA 5 LDA STFTB CONFIGURE THE TBG STF IOR TBG AND STA STFTB RESTORE IT JMP EXIT2 GO RETURN TO POINT OF INTERRUPT * SPC 3 STC5 STC 5 CLF0 CLF 0 DWAIT DEF WAIT ASAVE NOP BSAVE NOP EOSAV NOP * XSAVE NOP YSAVE NOP * MEMST NOP SMAPA DEF SMAP SMAP BSS 32 DO NOT CHANGE ORDER - SYSTEM MAP BSS 32 -USER MAP BSS 32 n -PORT-A MAP BSS 32 -PORT-B MAP MD128 DEC -128 D128 DEC 128 B3777 OCT 3777 * SDMA1 NOP SDMA2 NOP SSAVE NOP EQ5 NOP EQT IN PROCESS FLAG EQ15 NOP EQTCO NOP PSAVE DEF HALT P-REG SAVE (HLT DEF IF HALTED) TIME BSS 3 TIME SAVE LOCATION A EQU 0 B EQU 1 SPC 3 DEFI. DEF IP43 D15 DEC 15 D3 DEC 3 B10K OCT 10004 D2 DEC 2 SDAFL OCT 100001 B76K OCT 76000 HED TIME OUT SECTION CP43 NOP ENTRY HERE FOR TIME OUT ONLY CLA CLEAR THE EQT IN PROCESS FLAG STA SW2 CLEAR SWITCH TO SHOW NO PFAIL STA EQ5 STFTB STF 0 SET CLOCK FOR ANOTHER TIME OUT CCB SET UP TO TIME OUT AGAIN STB EQ15,I SET IN EQT15 * NOTIM LDA EQTCO GET CURRENT EQT COUNT CPA EQT# IF DONE JMP AUTOR GO START AUTOR * SZA,RSS IF FIRST TIME STB BSAVE SET BSAVE FOR AUTOR COUNT SZA,RSS STB EOSAV SET EOSAV FOR TIME CALL * ISZ EQTCO STEP THE EQT NUMBER LDA EQTCO GO SET UP JSB $CVEQ THE EQT ADDRESSES LDA EQT5,I GET EQT5 RAL,CLE,SLA IF DMA WAIT, CCE,SSA,RSS THEN FORGET RSS RESTART. JMP NOTIM * LDA EQT1,I CHECK IF SYS IS CLEARING SSA WELL? JMP NOTIM YES LET TIME OUT CATCH IT. * LDA EQT4,I DEVICE(CONTROLLER)IS UP, DOWN OR BUSY. ALF,RAR CHECK HIS "I KNOW ABOUT PF" SEZ,CCE,SLA BIT JMP DVR SET AND BUSY GO DO IT * LDA EQT5 EITHER CONTROLLER IS UP OR DOWN OR BUSY. STA EQ5 POWER FAIL BIT SET, SAVE EQT ADDRESS LDA EQT5,I INCASE WE GO DOWN WHILE PROCESSING. ALR,RAL SET CONTROLLER DOWN. ERA,RAR AND STA EQT5,I AND JMP $UPIO GO RESTART CONTROLLER AND ANY DOWNED DEVICES. * DVR JSB $DRVM SET UP PROPER DRIVER MAP LDA EQT4,I GET SELECT CODE IN (A) AND B77 LDB EQT2,I GET I.XX ADDR IN (B) SEZ ENTER DRIVER IN USER MAP? JMP INUSE YES JSB B,I NO, ENTER I.XX IN SYSTEM MAP JMP NOTIM GO DO NEXT EQT. * INUSE JSB $UIN ENTER I.XX IN USER MAP JMP NOTIM GO DO NEXT EQT * * AUTOR ISZ BSAVE FIRST TIME HERE? JMP SAUTO NO - GO SCHEDULE AUTOR * LDA DOF YES - ABORT AUTOR LDB D11 BY CALLING SYSTEM JSB $MESS MESSAGE PROCESSOR JMP NOAUT ANY RETURN MEANS NO AUTOR * SAUTO JSB $LIST SECOND ENTRY OCT 201 SCHEDULE BY NAME DEF OF2 NOAUT CLA CLEAR THE TIME OUT STA EQ15,I FLAG IN EQT 15 JMP $XEQ START THE SYSTEM * DOF DEF *+1 ASC 2,OFF, OF2 ASC 4,AUTOR,1 D11 DEC 11 B77 OCT 77 N3 DEC -3 D4 DEC 4 HED TIME REQUEST SECTION IP43 NOP LDA EQT6,I GET THE REQUEST CODE RAR,SLA IF NOT READ GO COMPLETE JMP REJ * LDA EQT8,I MUST HAVE A ADA N3 THREE WORD SSA BUFFER JMP REJ ELSE IGNOR * LDA EQT7,I BUFFER ADDRESS TO A LDB TIME SET THREE WORD XSB A,I TIME MESSAGE INA IN LDB TIME+1 USER XSB A,I BUFFER INA LDB TIME+2 XSB A,I CCA IF FIRST CALL AFTER TIME OUT CPA EOSAV AFTER POWER UP ISZ EOSAV SET FLAG TO ZERO AND SKIP JMP CLEAR NOT FIRST ENTRY JMP * I.EX LDB D3 SET TLOG = 3 REJ LDA D4 FOR IMMEDIATE COMPLETION JMP IP43,I RETURN TO USER * CLEAR CLA SECOND OR LATER ENTRY STA TIME+2 CLEAR THE TIME IN HAND FLAG JMP I.EX AND EXIT * * * HED ** SYSTEM BASE PAGE COMMUNICATION AREA ** . EQU 1650B ESTABLISH ORIGIN OF AREA * * SYSTEM TABLE DEFINITION * * EQTA EQU .+0 FWA OF EQUIPMENT TABLE EQT# EQU .+1 # OF EQT ENTRIES DRT EQU .+2 FWA OF DEVICE REFERENCE TABLE LUMAX EQU .+3 # OF LOGICAL UNITS (IN DRT) INTBA EQU .+4 FWA OF INTERRUPT TABLE INTLG EQU .+5 # OF INTERRUPT TABLE ENTRIES TAT EQU .+6 FWA OF TRACK ASSIGNMENT TABLE KEYWD EQU .+7 FWA OF KEYWORD BLOCK * * I/O MODULE/DRIVER COMMUNICATION * EQT1 EQU .+8 ADDRESSES EQT2 EQU .+9 EQT3 EQU .+10 OF EQT4 EQU .+11 EQT5 EQU .+12 CURRENT EQT6 EQU .+13 EQT7 EQU .+14 15-WORD EQT8 EQU .+15 EQT9 EQU .+16 EQT EQT10 EQU .+17 EQT11 EQU .+18 ENTRY EQT12 EQU .+81 EQT13 EQU .+82 EQT14 EQU .+83 EQT15 EQU .+84 CHAN EQU .+19 CURRENT DMA CHANNEL # TBG EQU .+20 I/O ADDRESS OF TIME-BASE CARD SYSTY EQU .+21 EQT ENTRY ADDRESS OF SYSTEM TTY * * SYSTEM REQUEST PROCESSOR /'EXEC' COMMUNICATION * * RQCNT EQU .+22 # OF REQUEST PARAMETERS -1 RQRTN EQU .+23 RETURN POINT ADDRESS RQP1 EQU .+24 ADDRESSES RQP2 EQU .+25 RQP3 EQU .+26 OF REQUEST RQP4 EQU .+27 RQP5 EQU .+28 PARAMETERS RQP6 EQU .+29 RQP7 EQU .+30 (SET FOR MAXIMUM OF RQP8 EQU .+31 9 PARAMETERS) RQP9 EQU .+32 * * DEFINITION OF SYSTEM LISTS (QUEUES) * * SKEDD EQU .+33 'SCHEDULE' LIST, SUSP2 EQU .+35 'WAIT' LIST, SUSP3 EQU .+36 'AVAILABLE MEMORY' LIST, SUSP4 EQU .+37 'DISC ALLOCATION' LIST, SUSP5 EQU .+38 'OPERATOR SUSPEND' LIST * * DEFINITION OF EXECUTING PROGRAM ID SEGMENT' * * XEQT EQU .+39 ID SEGMENT ADDR. OF CURRENT PROG. XLINK EQU .+40 'LINKAGE' XTEMP EQU .+41 'TEMPORARY (5-WORDS) XPRIO EQU .+46 'PRIORITY' WORD XPENT EQU .+47 'PRIMARY ENTRY POINT' XSUSP EQU .+48 'POINT OF SUSPENSION' XA EQU .+49 'A REGISTER' AT SUSPENSION XB EQU .+50 'B REGISTER' XEO EQU .+51 'E AND OVERFLOW * * SYSTEM MODULE COMMUNICATION FLAGS * * OPATN EQU .+52 OPERATOR/KEYBOARD ATTENTI640ON FLAG OPFLG EQU .+53 OPERATOR COMMUNICATION FLAG SWAP EQU .+54 RT DISC RESIDENT SWAPPING FLAG DUMMY EQU .+55 I/O ADDRESS OF DUMMY INT. CARD IDSDA EQU .+56 DISC ADDR. OF FIRST ID SEGMENT IDSDP EQU .+57 -POSITION WITHIN SECTOR * * DEFINITION OF MEMORY ALLOCATION BASES * * BPA1 EQU .+58 FWA R/T DISC RES. BP LINK AREA BPA2 EQU .+59 LWA R/T DISC RES. BP LINK AREA BPA3 EQU .+60 FWA BKG DISC RES. BP LINK AREA LBORG EQU .+61 FWA OF RESIDENT LIBRARY AREA RTORG EQU .+62 FWA OF REAL-TIME AREA RTCOM EQU .+63 LENGTH OF REAL TIME COMMON AREA RTDRA EQU .+64 FWA OF R/T DISC RESIDENT AREA AVMEM EQU .+65 FWA OF SYSTEM AVAILABLE MEMORY BKORG EQU .+66 FWA OF BACKGROUND AREA BKCOM EQU .+67 LENGTH OF BACKGROUND COMMON AREA BKDRA EQU .+68 FWA OF BKG DISC RESIDENT AREA * * UTILITY PARAMETERS * TATLG EQU .+69 LENGTH OF TRACK ASSIGNMENT TABLE TATSD EQU .+70 # OF TRACKS ON SYSTEM DISC SECT2 EQU .+71 # SECTORS/TRACK ON LU 2 (SYSTEM) SECT3 EQU .+72 # SECTORS/TRACK ON LU 3 (AUX.) DSCLB EQU .+73 DISC ADDR OF RES LIB ENTRY PTS DSCLN EQU .+74 # OF RES LIB ENTRY POINTS DSCUT EQU .+75 DISC ADDR OF RELOC UTILITY PROGS DSCUN EQU .+76 # OF RELOC UTILITY PROGS LGOTK EQU .+77 LOAD-N-GO: LU,STG TRACK,# OF TRKS LGOC EQU .+78 CURRENT LGO TRACK/SECTOR ADDRESS SFCUN EQU .+79 SOURCE FILE LU AND DISC ADDRESS MPTFL EQU .+80 MEMORY PROTECT ON/OFF FLAG (0/1) FENCE EQU .+85 MEM PROTECT FENCE ADDRESS BKLWA EQU .+87 LWA OF MEMORY IN BACKGROUND * ORG * LENGTH OF $POWR END $POWR WQ6 ~  92067-18005 1805 S C0122 &4AUTR RTE-IV AUTO RESTART SRC             H0101 X(FTN,L C NAME: AUTOR C SOURCE: 92067-18005 C RELOC: 92067-16005 C PGMR: G.A.A. C E.J.W.,750505 C D.L.S.,760622 C E.J.W.,771219 C C PROGRAM AUTOR(2,1),92067-16005 REV.1805 771219 DIMENSION ITM(3),ITMX(5) EQUIVALENCE (ITM(1),REG),(ITM(2),IB) C C SCAN THE LU'S TO FIND THE LU FOR C THE PFAIL DRIVER DO 5 I= 1,64 C DO A STATUS CALL C CALL EXEC(100015B,I,IEQT5,IEQT4) C C IGNOR UNDEFINED,AND UNASSIGNED LU'S. GO TO 5 C IS DRIVER TYPE EQUAL TO 43? C 600 IF (IAND(IEQT5,37400B)-21400B)5,15,5 C C YES, IS THE SELECT CODE=4? C 15 IF (IAND(IEQT4,77B)-4)5,17,5 C 5 CONTINUE C POWER FAIL LU NOT FOUND WRITE (1,700) 700 FORMAT("POWER FAIL LU NOT FOUND. TIME OF POWER FAIL UNKNOWN") C C SET TO USE LU ZERO LU=0 GO TO 20 C LU FOUND SET TO GET FAIL TIME 17 LU=I C CALL THE PFAIL DVR TO GET FAIL TIME 20 CALL EXEC(1,LU,ITM,3) C CONVERT THE DOUBLE INTEGER TO: C HR,MIN,SEC.TENS OF MS CALL TMVAL(ITM,ITMX) C GET THE YEAR OFFSET FROM DAYS IB=ITM(3)/365 C ADD THE BASE YEAR TO GET ACTUAL YEAR IY=IB+1970 C SUBTRACT THE YEARS TO GET DAYS AND C CORRECT FOR DAY ZERO. ID=ITM(3)-IB*365+1 C FLOAT THE TENS OF MS VALUE REG=ITMX(1) C COMPUTE SECONDS INTO ONE FLOATING WORD REG=REG/100.+FLOAT(ITMX(T2)) C ***************************** C THE FOLLOWING DO LOOP MAY BE C MODIFIED IF DESIRED. C IT SERVES TWO FUNCTIONS: C 1) BY SENDING A MESSAGE TO EACH TTY C THE DRIVER WILL RESET THE TTY C INTERFACE TO REENABLE ANY C TERMINALS (MUST ISSUE A STC). C 2) ANY USERS AT THE TERMINALS ARE C INFORMED THAT THE LAST LINE MAY C NOT HAVE BEEN TRANSMITTED C CORRECTLY. C ***************************** C C FORMAT TO PRINT THE TIME C 40 FORMAT("POWER FAILED AT "I2":"I2":"F6.3" ON DAY "I3" OF "I4) C C SCAN FOR ALL THE TTY TYPE DEVICES DO 30 I=1,64 C DO STATUS CALL CALL EXEC(100015B,I,IEQT5,ISTA2,ISTA3) C IGNOR UNDEFINED,AND UNASSIGNED LU'S GO TO 30 C CHECK IF TYPE 0 DEVICE (I.E. A TTY) 1 IF(IAND(IEQT5,37400B))25,2,25 C CHECK IF TYPE 5 DEVICE 25 IEQT5=IEQT5-2400B IF(IAND(IEQT5,37400B))30,27,30 C IF TYPE 5 DEVICE, CHECK TO SEE IF C SUBCHANNEL 0(I.E. A CONSOLE) 27 IF(IAND(ISTA3,37B))30,2,30 C IF FIND A DEVICE, WRITE TIME ON IT. 2 WRITE(I,40)ITMX(4),ITMX(3),REG,ID,IY 30 CONTINUE C ***************************** C USER POWER FAIL RECOVERY CODE C SHOULD BE ADDED HER? E. C REMEMBER IF POWER FAILS C WHILE IN THIS CODE IT C MAY RUN FOR A FEW C SECONDS AFTER POWER IS C RESTORED AND THEN BE ABANDONED C AND RESTARTED FROM THE C TOP. C ***************************** C C SECOND CALL ON PFAIL ROUTINE RESETS C TO SAVE TIME ON NEXT FAILURE. CALL EXEC(1,LU,ITM,3) STOP END END$ |O  92067-18006 1805 S C0222 &CNFX1 RTE-IV CONF. EXT.             H0102 ASMB,R,L,C HED RTE IV CONFIGURATOR EXTENSION 92067-16006 NAM $CNFX,3 92067-16006 REV.1805 780112 * NAME: $CNFX * SOURCE: 92067-18006 * RELOC: 92067-16006 * PGMR: S. KAPOOR,D.VENHAUS * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * EXT $PCHN,$EXIT,$WRRD,$USRS,$ABDP,$TRTB,$TREN,$NPGQ EXT $GDPG,$SAVE,$SMTB EXT $PARS,$CVT3,$MATA,$MNP,$MCHN,$MBGP,$MRTP EXT $CFR,$BGFR,$RTFR,$IDEX,$SDA,$PLP,$CMST,$SBTB EXT $MPS2,$ENDS * SUP * A EQU 0 B EQU 1 KEYWD EQU 1657B .1 DEC 1 .2 DEC 2 .3 DEC 3 .4 DEC 4 .5 DEC 5 .6 DEC 6 .7 DEC 7 .9 DEC 9 .11 DEC 11 .12 DEC 12 .14 DEC 14 .15 DEC 15 .16 DEC 16 .18 DEC 18 .19 DEC 19 .28 DEC 28 .32 DEC 32 .33 DEC 33 * B77 OCT 77 B37 OCT 37 B140K OCT 140000 * .10 DEC 10 * YE ASC 1,YE NO ASC 1,NO E ASC 1, E R ASC 1,R S ASC 1,S RT ASC 1,RT BG ASC 1,BG PARTN ASC 6,PART'N ? SPACE ASC 1, MSG23 ASC 10,CURRENT SIZE OF SAM: MSG24 ASC 10,DEFAULT: WORDS MSG25 ASC 10,EXTENSION: PAGES * MSG29 ASC 14,CURRENT PART'N DEFINITIONS: MSG31 ASC 11,CURRENT PART'N REQMTS: MSG32 ASC 4,REALTIME MSG33 ASC 5,BACKGROUND MSG35 ASC 9,MAX PROGRAM SIZE: MSG36 ASC 11,W/OUT COMMON: PAGES MSG37 ASC 11,W/ COMMON: PAGES MSG38 ASC 11,W/ TABLE II: PAGES MSG39 ASC 10,MAX # OF PART'NS: MSG40 ASC 11,PAGES REMAINING: * A$SMT DEF $SMTB+0 E$SMT DEF $SMTB+9 USRST NOP ABDPG NOP SUBPR NOP PGSRM NOP MEMSZ NOP LSTLU NOP ECHO NOP SAVE BSS 4 TEMP NOP TEMP1 NOP TEMP2 NOP TEMP3 _NOP TEMP4 NOP TEMP5 NOP STSME NOP SMEXS NOP ENDSM NOP * * * PRINT CURRENT PARTITION DEFINITION * $CNFX XLA $PCHN GET MEMORY SIZE STA MEMSZ SAVE IT XLA $WRRD GET LIST DEVICE LU# STA LSTLU XLA $TRTB GET ECHO FLAG STA ECHO LDB .10 JSB WRLST DEF MSG23 CURRENT SIZE OF SAM: XLB $SAVE+2 GET # OF WORDS IN SAM DEFAULT XLA $SAVE+13 HAVE TWO PIECES ADA B ADD THE TWO PIECES CCE CONVERT TO DECIMAL ASCII JSB $CVT3 INA POINT TO LAST FOUR DIGITS DLD A,I SET UP MESSAGE DST MSG24+5 DEFAULT: XXXX WORDS LDB .10 JSB WRLST PRINT IT DEF MSG24 LDA $MPS2 # OF PAGES IN SAM EXT ALF,RAL RAL # OF PAGES IN LOW 6 BITS AND B77 A REG HAS # OF PAGES IN SAM EXT STA SMEXS SAVE SIZE OF SAM EXT CCE CONVERT TO ASCII DECIMAL JSB $CVT3 ADA .2 POINT TO LOW 2 DIGITS LDA A,I GET ASCII VALUE STA MSG25+6 SET UP MESSAGE LDB .10 JSB WRLST PRINT DEF MSG25 EXTENSION: XX PAGES LDA $SBTB+1 # OF PAGES IN DRIVER PARTITIONS ADA $SBTB+3 # OF PAGES IN MEM RES BASE PAGE ADA $SBTB+5 # OF PAGES IN MEM RES PARTN ADA $ENDS # OF PAGES UPTO SAM DEFAULT STA STSME PHSICAL START PAGE OF SAM EXT IOR BIT15 SJS $GDPG FIND THE FIRST GOOD PAGE FOR SAM EXT JMP SMER1 ERROR NO MORE PAGES LEFT STA STSME START PAGE OF SAM EXT STRPG CCE CONVERT TO ASCII DECIMAL JSB $CVT3 INA DLD A,I ASCII VALUE DST MSG26+19 SET UP MESSAGE LDB .21 JSB WRLST PRINT MESSAGE DEF MSG26 PHSICAL START PAGE OF SAM EXT XX LDA $ENDS FIND # OF PAGES AVAIL FOR SAM EXT CMA,INA ADA .32 # OF PAGES BET END OF LOG MEM AND SAM DEFA|ULT STA TEMP SAVE IT LDB STSME PHSICAL START PAGE OF SAM EXT CMB,INB ADB MEMSZ (MEMSZ-START OF SAM EXT) CMA,INA - ADA B (32-$ENDS) SSA,RSS WHICH IS GREATER? LDB TEMP THE SMALLER QUANTITY IS MAX SIZE OF SAME EXT STB MXSME MAX. PAGES AVAIL FOR SAM EXT LDA B CCE JSB $CVT3 CONVERT IT TO ASCII DECIMAL ADA .2 LDA A,I GET ASCII VALUE STA MSG27+18 SET UP MESSAGE LDB .19 JSB WRLST DEF MSG27 MAX PAGES AVAIL FOR SAM EXT: XX * CLA CLEAR $SMTB LDB A$SMT CL$SM XSA B,I CPB E$SMT END OF $SMTB? JMP SMEXQ YES INB NO JMP CL$SM SMEXQ LDB .18 JSB QUERY DEF MSG28 CHANGE SAM EXTENSION?(#PAGES/" "CR) LDA PRSBF SZA,RSS NULL? JMP NOCHG YES, NO CHANGE IN SAM EXT CLA LOWER LIMIT LDB APRSB POINTER TO PARSE BUFFER JSB TST# TEST VALIDITY OF RESPONSE MXSME NOP MAX AVAIL MEM FOR SAM EXT JMP SMERR ERROR RSS NOCHG LDA SMEXS SAM EXT SIZE GENERATED STA SMEXS * * CHANGE SYSTEM MAP FOR NEW SAM EXT CMA,INA,SZA,RSS SAM EXT SIZE IS 0? JMP NOSME YES STA TEMP1 -VE OF SAM EXT SIZE CLA,INA CAX LDA $ENDS LOGICAL START PAGE OF SAM EXT STA TEMP5 LDA A$SMT START OF $SMTB STA TEMP2 SAVE IT FOR POINTER VALUE LDA STSME PHYSICAL START PAGE XSA TEMP2,I SET INITIAL START PAGE FOR SAM EXT STA TEMP3 ISZ TEMP2 POINT TO # OF PAGES IN CHUNK ENTRY SMELP IOR BIT15 SJS $GDPG FIND NEXT GOOD PAGE JMP SMER1 ERROR CPA TEMP3 BAD PAGE ENCOUNTERED? JMP INCR NO LDB TEMP2 CPB E$SMT END OF $SMTB REACHED? JMP SMER2 YES, ERROR ISZ TEMP2 NO, POINT TO NEXT ENTRY XSA TEMP2,I START PHYSICAL PG FOR NEXT CHUNK OF SAM EXT ISZ TEMP2 INCR XLB TEMP2,I INCREMENT #PGS IN THIS CHUNK OF SAM EXT INB XSB TEMP2,I STA B ADB B40K WRITE PROTECT SAM EXTENSION LDA TEMP5 XMS STORE PAGE # IN DMS REG BLS,RBR CLEAR BIT 14 ISZ TEMP1 INCREMENT COUNTER RSS NOT DONE YET JMP SMELC DONE ISZ TEMP5 INCREMENT LOGICAL PAGE # ISX LDA B STA TEMP3 JMP SMELP STORE NEXT PAGE * SMERR LDA A10 ERROR JSB ERROR JMP SMEXQ SMER2 LDA A22 TOO MANY BAD PAGES IN SAM EXT JSB ERROR JMP SMEXQ * A10 ASC 1,10 A22 ASC 1,22 A12 ASC 1,12 B40K OCT 40000 .22 DEC 22 N2 DEC -2 MSG26 ASC 21,SAM EXTENSION STARTS AT PHYSICAL PAGE MSG27 ASC 19,MAX PAGES AVAIL FOR SAM EXTENSION: MSG28 ASC 18,CHANGE SAM EXTENSION?(#PAGES/" "CR) * SMER1 LDA A12 JSB ERROR JMP SMEXQ * NOSME LDA $ENDS NO CHANGE IN SAM EXT STA ENDSM END OF SYSTEM LDA STSME START OF USER PARTN AREA XSA $USRS CLA STA $MPS2 XSA $SAVE+4 JMP RWPRO READ-WRITE PROTECT REST OF THE REG * * SMELC STA ENDSM A REG HAS END OF LOG SYS PAGE XSB $USRS START PAGE OF USER PARTITIONS LDB SMEXS # OF PAGE IN SAM EXT BLF,BLF # OF WORDS IN SAM EXT RBL,RBL CPA .32 DID SAM EXT END AT LOG PAGE 31? RSS THEN LAST ADDRESS MUST BE 77775B CLA,RSS LDA N2 ADB A XSB $SAVE+4 # OF WORDS IN SAM EXT LDA SMEXS SAM EXT SIZE ALF,ALF RAL,RAL MOVE IT TO BITS 10-25 ADA STSME START PAGE SAM EXT STA $MPS2 * RWPRO CLA,INA READ WRITE PROTECT REST OF CAX THE REGISTERS IN THE SYSTEM MAP LDA ENDSM LOGICAL PAGE SAM EXT ENDS RWPRL CPA .32 LOGICAuL REG # IS 32? JMP PRTDF YES DONE LDB B140K READ WRITE PROTECT NEXT REG XMS ISX JMP RWPRL * * PRTDF LDB .14 JSB WRLST DEF MSG29 CURRENT PART'N DEFINITIONS: JSB PRNPR PRINT LIST OF PARTITION DEFINITIONS LDB .11 PRINT LIST OF JSB WRLST DEF MSG31 CURRENT PART'N REQMTS: LDB .4 JSB WRLST REALTIME DEF MSG32 CLB INDICATE TO ROUTINE TO PRINT STB TYPE PART'N REQMTS FOR REAL TIME PROGS JSB PGREQ LDB .5 JSB WRLST BACKGROUND DEF MSG33 ISZ TYPE JSB PGREQ PART'N REQMTS FOR BG PROGS LDB .9 JSB WRLST DEF MSG35 MAX PROGRAM SIZE LDA $CMST START OF COMMON AREA CMA,INA CCE,INA ADA .32 32-$CMST+1 STA MXWOC JSB $CVT3 CONVERT TO ASCII DECIMAL ADA .2 LDA A,I SET UP MESSAGE STA MSG36+7 W/OUT COMMON : XX PAGES LDB .11 JSB WRLST DEF MSG36 LDA $SDA START OF SYSTEM DRIVER AREA CMA,INA INA ADA .32 32-$SDA+1 CCE CONVERT MAX ADDRESS SPACE WITH COMMON JSB $CVT3 TO ASCII DECIMAL ADA .2 LDA A,I STA MSG37+7 W/ COMMON : XX PAGES LDB .11 JSB WRLST DEF MSG37 LDA $PLP LOAD POINT FOR PRIV PROGS ALF RAL,RAL GET PAGE # IN LOW BITS AND B37 MASK PAGE# CMA,INA INA ADA .32 32-#PAGES UPTO TABLE AREA II+1 CCE CONVERT # OF PAGES IN MAX ADDR SPACE FOR JSB $CVT3 A PRIVILEGED PROGRAM TO ASCII DECIMAL ADA .2 LDA A,I STA MSG38+7 LDB .11 JSB WRLST W/ TABLE II: DEF MSG38 LDA $MNP MAX # OF PARTITIONS CCE JSB $CVT3 ADA .2 LDA A,I GET ASCII VALUE STA MSG39+9 SET UP MESSAGE ; LDB .10 JSB WRLST PRINT IT DEF MSG39 MAX # OF PART'NS : XX XLA $USRS START PAGE OF USER PARTITION AREA CMA,INA ADA MEMSZ MEMSZ-$USRS STA PGSRM PAGES REMAINING FOR USER PARTITION CCE DEFINITIONS JSB $CVT3 CONVERT IT TO ASCII DECIMAL INA DLD A,I SET UP THE MESSAGE DST MSG40+9 PAGES REMAINING: XX LDB .11 JSB WRLST DEF MSG40 * * DEFINE USER PARTITIONS * DFNPR LDB $MATA SET ALL WORDS IN MAT TO 0 STB MATAD START ADDRESS OF MAT LDA $MNP # OF WORDS TO BE CLEARED SZA,RSS MAX # OF PARTITIONS IS 0? JMP QPERM YES,SKIP REST OF MEMORY RE-CONFIGURATION MPY .7 EACH ENTRY HAS 7 WORDS STA B CLA VALUE FOR REGISTERS JSB SETM SET MEMORY MATAD NOP START OF MAT LDA $MNP CMA,INA -VE OF # OF PART'NS ALLOWED STA TEMP COUNTER TO SET LINK WORDS OF ALL MAT LDA $MATA ENTRIES TO -1 CCB INITL STB A,I STORE VALUE IN ENTRY ADA .7 POINT TO NEXT ENTRY ISZ TEMP JMP INITL NOT DONE YET * XLA $USRS SAVE START OF USER PARTITIONS STA USRST XLA $ABDP SAVE CURRENT BAD PAGE POINTER STA ABDPG * STDFN CLA START OF PARTITION DEFINITION STA SUBPR CLEAR FLAG FOR SUBPART'N DEF'N STA PRTN# LDA $MATA START OF MAT STA PRPNT SET UP POINTER TO MAT ENTRIES * STCHN CCA SJS $PCHN START OF PART'N DEF'N SZA,RSS FOR THIS CHUNK OF MEMORY JMP THRLS 0,DONE WITH PART'N DEF'N FOR ALL OF MEM CLB INITIALIZE FLAG FOR END OF SUBPARTITION STB ERFLG * XLB $USRS NEW START OF USER AREA STB SAVE SAVE IT STA #PGS # OF PAGES IN BLOCK FROM MEM STA SAVE+1 SAVE IT LDB PRPNT POINTER IN MAT STB YSAVE+2 SAVE IT LDB PRTN# PARTITIONS DEFINED SO FAR STB SAVE+3 SAVE IT * CCE CONVERT # OF PAGES IN CHUNK JSB $CVT3 TO ASCII DECIMAL INA POINT TO LAST 4 ASCII DIGITS DLD A,I DST MSG50+9 AND SET UP MESSAGE LDB .15 JSB WRTTY DEFINE PART'NS FOR PPPP PAGES: DEF MSG50 LDB .9 JSB WRTTY DEF MSG41 #PAGES,RT/BG/S(,R) PRTNQ LDA PRTN# CONVERT PARTITIONS DEFINED SO FAR CCE,INA + 1 INTO ASCII DECIMAL JSB $CVT3 ADA .2 POINT TO LAST 2 ASCII DIGITS LDA A,I STA PARTN+4 LDB .6 JSB QUERY PARTITION DEFINITION PROMPT DEF PARTN PART'N XX? LDA PRSBF CPA .2 ASCII RESPONSE? RSS YES JMP TSTTY NO, TEST TYPE OF PART'N JSB END? /E ENTERED? RSS YES JMP CHK/R NO, THEN CHECK FOR /R LDA ERFLG ONLY /E OR /R PERMITTED AS A RESPONSE? SSA JMP STCHN YES, THEN /E VALID LDA SUBPR DEFINING SUBPARTITIONS? SSA,RSS JMP #PGSE NO, THEN ERROR JSB RSTSB YES, THEN END SUBPART'N DEFINITION JMP ENPR2 * CHK/R LDA PRSBF+1 CPA /R RESTART ? RSS JMP TSTTY NO LDA PRSBF+2 CPA SPACE JMP RSTOR RESTART PARTITION DEFINITIONS * TSTTY LDA ERFLG END OF SUBPARTITION FLAG SET? SSA JMP #PGSE YES,ONLY /E OR /R ALLOWED FOR A RESPONSE LDA PRSBF+6 TEST FOR VALID PART'N TYPE CPA SPACE RSS JMP TYPER NOT A SPACE THEN ERROR LDB PRSBF+5 TEST FOR VALID PART'N TYPE CLA 0 IF BACKGROUND CPB BG BACKGROUND? JMP SETYP YES INA CPB RT REALTIME? JMP SETYP YES CPB S SUBPARTITION? CCA,RSS -1 IF SUBPARTITION JMP TYPER INVALID TYPE ERROR SETYxP STA TYTMP SAVE TYPE OF PART'N LDB SUBPR DEFINING SUBPARTITIONS? SSB,RSS JMP NOSUB NO SSA,RSS PART'N TYPE IS S? JSB RSTSB NO, THEN END SUBPARTITION DEFINITION JMP TESTR TEST FOR RESERVE PARAMETER NOSUB SSA PARTITION TYPE IS S? JMP TYPER YES, THEN ERROR * TESTR LDB PRSBF+8 TEST FOR R PARAMETER SZB,RSS NULL? JMP SETR YES LDB PRSBF+9 CPB R R? RSS YES JMP RSRVE NO, THEN ERROR LDA PRSBF+10 GET NEXT CHAR CPA SPACE BLANK? CLB,INB,RSS YES, THEN OK JMP RSRVE NO, ERROR SETR STB RTMP RTMP IS 1 IF RESERVED PART'N * LDA .2 GET # OF PAGES REMAINING LDB APRSB IN THIS CHUNK JSB TST# TEST IF # PAGES DEFINED IS #PGS NOP GREATER THAN REMAINING # PAGES IN CHUNK JMP #PGSE ERROR * STA PGTMP GET PAGES FOR THIS PART'N CMA,INA # OF PAGES REMAINING ADA #PGS IN BLOCK OF MEM CPA .1 1 PAGE LEFT IN CHUNK? RSS YES JMP SET#P NO ISZ PGTMP INCREMENT # OF PAGES IN PRV PART'N CLA CLEAR # OF PAGES REMAINING IN CHUNK SET#P STA #PGS NEW # PAGES LEFT IN CHUNK LDA PRPNT POINTER TO CURRENT MAT ENTRY CLB STB A,I CLEAR LINK WORD ADA .3 POINT TO WORD 3 OF MAT ENTRY XLB $USRS START PAGE FOR THIS PART'N STB A,I SET UP MAT WORD INA LDB RTMP PARTITION RESERVE PARAMETER RBR BIT 15 IS SET IF R PARM ADB PGTMP WAS SPECIFIED - # PAGES IN LOW BITS ADB N1 -1 TO EXCLUDE BASE PAGE STB A,I SET UP WORD 4 OF MAT ENTRY INA LDB TYTMP REAL TIME OR BACKGROUND PART'N SSB 'S' ENTERED? LDB SVTYP YES, THEN USE TYPE OF MOTHER PART'N RBR BIT 15 SET IF REALTIWME PART'N STB A,I SET UP WORD 5 OF MAT LDB SUBPR DEFINING SUBPARTITIONS? SSB JMP SBPRT YES LDA .2 LDB APRSB ADDRESS OF PARSE BUFFER JSB TST# # OF PAGES FOR PART'N LESS THAN MXWOC NOP MAX ADDRESSABLE SPACE W/OUT COMMON? JMP MPART YES, DEFINE MOTHER PART'N ENPRT XLA $USRS START OF USER PART'N PAGE ADA PGTMP ADD # PAGES DEFINED FOR PART'N XSA $USRS TO GET NEW START USER PAGE ENPR1 LDA PRPNT POINT TO NEXT MAT ENTRY ADA .7 STA PRPNT ISZ PRTN# INCREMENT PART'NS DEFINED SO FAR LDA PRTN# # OF PARTITIONS DEFINED SO FAR CPA $MNP IS EQUAL TO MAX # PART'NS? JMP MX#PR YES, THEN DONE ENPR2 LDA #PGS # PAGES LEFT IN CHUNK SZA 0? JMP PRTNQ NO JMP STCHN YES, THEN DEFINE MORE PART'NS * MX#PR LDB SUBPR DEFINING SUBPARTITIONS? SSB JSB RSTSB YES, END SUBPARTITION DEFINITION LDA #PGS # OF PAGES LEFT IN THIS CHUNK SZA 0? JMP RDFNQ NO, THEN REDEFINE PART'NS? CCA SJS $PCHN ANY MORE PAGES LEFT IN MEM? SZA,RSS JMP THRLS NO, THEN THREAD LISTS * RDFNQ LDA A20 MAX # PART'NS DEFINED AND JSB ERROR PAGES LEFT UNDEFINED IN MEM RSTOR LDA USRST RESTORE START OF USER PART'NS XSA $USRS LDA ABDPG RESTORE POINTER TO BAD PAGE LIST XSA $ABDP JMP DFNPR REDEFINE PARTITIONS * A20 ASC 1,20 MSG50 ASC 15,DEFINE PART'NS FOR PAGES: MSG41 ASC 9,#PAGES,RT/BG/S(,R) * * DEFINE MOTHER PARTITIONS * MPART LDB .11 JSB QUERY SUBPARTITIONS?(YES/NO) DEF MSG43 LDA PRSBF+1 CPA NO JMP ENPRT NO, THEN CONTINUE NORMALLY CPA YE RSS YES JMP MPART ILLEGAL RESPONSE CCA,CCE SET E REG FOR FUTURE USE STA SUBPR SET FLAG TO INDICATE DEFINING SUBPiARTITIONS LDA TYTMP SAVE PART'N TYPE OF THIS MOTHER PART'N STA SVTYP LDA #PGS STA SV#PG SAVE # OF PAGES LEFT IN CHUNK LDA PGTMP STA #PGS # OF PAGES IN MOTHER PART'N XLA $USRS ADA PGTMP ADD # OF PAGES DEFINED FOR MOTHER PART'N STA SVUSR SAVE START PAGE FOR NEXT PART'N LDA PRPNT SET M BIT IN MAT ENTRY ADA .3 FOR THE MOTHER PART'N LDB A,I RBL,ERB E REG SET PREVIOUSLY STB A,I ADA .3 POINT TO SUBPART'N LINK WORD LDB PRPNT STB A,I POINT SLW OF MOTHER PART'N TO ITSELF STA PRVSL SAVE TO USE FOR NEXT SLW JMP ENPR1 * SBPRT LDB PRVSL,I YES,POINT PREV. SLW TO THIS SUBPART'N ENTRY LDA PRPNT STA PRVSL,I ADA .6 SET UP THIS PARTN'S SLW STA PRVSL STB A,I LDA #PGS SZA END SUBPART DEF'N IF # PAGES LEFT IS 0 JMP ENPRT JSB RSTSB END SUBPARTITION DEFINITION JMP ENPR1 * RSTSB NOP ROUTINE TO END SUBPARTITION DEF'N LDA SVUSR RESTORE START USER PART'N PAGE # XSA $USRS FOR NEXT PART'N TO BE DEFINED LDA SV#PG STA #PGS RESTORE # PAGES LEFT IN CHUNK CLA STA SUBPR CLEAR SUBPART'N DEFINITION FLAG JMP RSTSB,I RETURN * #PGSE LDA A13 INVALID PARTITION SIZE JSB ERROR LDA #PGS # OF PAGES LEFT IN CHUNK IS 0? SZA JMP PRTNQ NO, PROMPT FOR LAST PART'N DEF'N CCA YES, THEN SET FLAG TO INDICATE STA ERFLG ONLY /E OR /R WILL BE ALLOWED FOR A RESPONSE JMP PRTNQ PROMPT FOR PART'N DEF'N * TYPER LDA A14 INVALID PARTITION TYPE RSS * RSRVE LDA A15 INVALID PARTITION RESERVATION PARAMETER JSB ERROR DISPLAY ERROR JMP PRTNQ QUERY PARTN# AGAIN * A13 ASC 1,13 A14 ASC 1,14 A15 ASC 1,15 ERFLG NOP SV#PG NOP SVUSR NOP PRVSL NOP oTYTMP NOP SVTYP NOP PGTMP NOP RTMP NOP MSG43 ASC 11,SUBPARTITIONS?(YES/NO) PRSBF BSS 33 PRPNT NOP PNTBG NOP PNTRT NOP PNTCH NOP ADTBL DEF *+1 ABGFR DEF $BGFR ARTFR DEF $RTFR ACFR DEF $CFR AMBGP DEF $MBGP AMRTP DEF $MRTP AMCHN DEF $MCHN AMPS2 DEF $MPS2 LSHDR NOP MXPRT NOP PRTSZ NOP PRVPN NOP CURPN NOP CURKY NOP PRTMP NOP RDBUF BSS 80 BIT15 OCT 100000 .N7 DEC -7 * * THREAD PARTITIONS JUST DEFINED INTO BG,RT AND CHAIN FREE LISTS * FREE LISTS IN AN INCREASING ORDER ACCORDING TO THEIR SIZE * THRLS CLA CLEAR LIST HEADERS STA $BGFR STA $RTFR STA $CFR STA $MCHN STA $MBGP STA $MRTP LDA .N7 COUNTER RMOVI LDB ADTBL,I REMOVE INDIRECTS FROM ENT POINT ADDRESSES RSS LDB B,I RBL,CLE,SLB,ERB JMP *-2 STB ADTBL,I ISZ ADTBL INA,SZA JMP RMOVI LDA $MATA SET POINTER AT THE BEGINING OF MAT STA PRPNT LDA ABGFR ADDRESS OF LIST HEADER FOR BG STA PNTBG POINTER FOR THE BG LIST LDA ARTFR ADDRESS OF LIST HEADER FOR RT STA PNTRT POINTER FOR THE RT LIST LDA ACFR ADDRESS OF LIST HEADER FOR CHAIN LIST STA PNTCH POINTER FOR THE CHAIN LIST LDA $MNP MAX # OF PARTITIONS ALLOWED CMA,INA USE AS COUNTER STA PRTMP * * THRDL LDA PRPNT GET POINTER TO MAT LDB A,I IS THE LINK WORD -1? SSB JMP THRDN YES, THEN DONE THREADING LISTS ADA .3 POINT TO WORD 4 OF MAT ENTRY LDB A,I SSB,RSS IS THE M BIT SET? CLB,RSS NO, THEN NOT A MOTHER PARTN LDB ACFR YES, SET LST HEADER FOR CHAIN LIST STB LSHDR CURRENT POINTER LDB AMCHN ADDR OF MAX SIZE CHAINED PART'N ENT PNT STB MXPRT INA POINT TO WORD 5 OF MAT ENTRY LDB A,I RBL,CLE,ERB GET BIT 15 IN E REG AND CLEAR IT STB PRTSZ sj SIZE OF PARTITION TO COMPARE INA NO LDB LSHDR SZB LIST HEADER ALREADY SET? JMP STPRT YES, SET MAX PART'N SIZE LDA A,I NO SSA,RSS RT BIT SET? JMP BGPRT NO, THEN BACKGROUND PART'N LDB ARTFR YES, RT PARTN, POINTER FOR RT LIST LDA AMRTP MAX RT PART'N SIZE ENTRY POINT JMP STPNT BGPRT LDA AMBGP MAX BG PART'N SIZE ENTRY POINT LDB ABGFR BG PART'N SIZE ENTRY POINT STPNT STA MXPRT POINTER TO MAX PART'N SIZE STB LSHDR HEADER FOR CURRENT LIST STPRT LDA PRTSZ GET PART'N SIZE CMA,SEZ,INA RESERVE PARTITION? JMP STCRP YES, SET CURRENT POINTER ADA MXPRT,I SIZE OF CURRENT PART'N SSA,RSS IS GREATER THAN PREVIOUS ONE? JMP STCRP NO LDA PRTSZ YES STA MXPRT,I NEW MAX PART'N SIZE FOR GIVEN LIST STCRP LDB B,I GET VALUE STB CURPN CURRENT POINTER CLA CLEAR STA PRVPN PREVIOUS POINTER TLOOP LDB CURPN GET CURRENT POINTER SZB,RSS 0? JMP TPLEX YES, THEN DONE WALKING THRU LIST ADB .4 NO, GET PART'N SIZE LDA B,I PART'N SIZE OF CURRENT PART'N ELA,CLE,ERA CLEAR R BIT IF SET CMA,INA IN LIST < PART'N SIZE OF NEW PART'N ADA PRTSZ TO INSERTED IN THE LIST?T SSA JMP TPLEX YES,THEN FOUND PLACE TO INSERT NEW PART'N LDB CURPN NO, THEN CURRENT POINTER BECOMES STB PRVPN PREVIOUS POINTER LDA B,I CONTENTS OF LINK WORD OF STA CURPN CURRENT PART'N BECOMES THE CURRENT POINTER JMP TLOOP CHECK NEXT PARTITION IN LIST * TPLEX LDA PRPNT POINTER TO NEW PART'N TO BE INSERTED LDB PRVPN GET PREVIOUS POINTER SZB IS THE CURRENT POINTER TO LIST HEADER? JMP PRINS NO, THEN INSERT PART'N STA LSHDR,I YES POINT LIST HEADER TO PART'N JMP FORWD ADJUSTHNLH FORWARD POINTER IN MAT * PRINS STA PRVPN,I PREV PART'N POINTS TO NEW PART'N FORWD LDA CURPN NEW PART'N POINTS TO CURRENT PART'N STA PRPNT,I * PARTITION HAS BEEN INSERTED * INSERT NEXT PART'N IN MAT IN PROPER LIST ENTHR LDA PRPNT ADA .7 POINT TO NEXT ENTRY STA PRPNT POINTER FOR NEW PART'N ISZ PRTMP MAX # OF PART'NS ALLOWED INSERTED? JMP THRDL NO, REPEAT PROCESS FOR ALL PART'NS * * ALL PARTITIONS ARE THREADED IN FREE LISTS * * THRDN DLD NEW SET UP MESSAGE FOR DST MSG29+2 NEW PART'N DEFINITIONS: LDB .12 JSB WRLST PRINT MESSAGE ON LIST DEVICE DEF MSG29+2 NEW PART'N DEFINITIONS: CCE E REG SET TO INDICATE CALLING FROM USER MAP JSB PRNPR PRINT LIST OF NEW PART'N DEFINITIONS * * UNASSIGN PROGRAMS IF THEY DO NOT FIT IN * THE PARTITIONS THEY WERE ORIGINALLY ASSIGNED TO * LDB .10 JSB WRLST CALLING PRINT ROUTINE FROM USER MAP DEF MSG44 UNASSIGNED PROGS: XLA KEYWD START OF KEYWORD TABLE STA CURKY CURRENT POSITION IN KEY WORD TABLE NIDLP LDA CURKY,I GET NEXT ID SEG ADDRESS SZA,RSS 0? JMP IDONE YES, THEN DONE UNASSIGNING ADA .14 NO, POINT TO WORD 15 LDB A,I GET VALUE TO CHECK IF A LSR 4 SHORT ID SEGMENT SLB SS BIT SET? JMP ENLP YES, THEN LOOK AT NEXT ID SEGMENT LDB CURKY,I ADB .21 NO, A LONG ID SEG LDA B,I GET CONTENTS OF WORD 21 SSA,RSS RP BIT SET? JMP ENLP NO, PROG NOT ASSIGNED TO A PART'N AND B77 YES, GET PART'N # LDB CURKY,I ADDRESS OF ID SEGMENT JSB FIT PROG STILL FITS IN PART'N? RSS NO JMP ENLP YES * UNASN LDA SPACE NO, THEN UNASSIGN PROG LDB SPACE DST RDBUF CLEAR 3 WORDS IN BUFFER STA RDBUF+1 THEY WILL HOLD PROG NAME LDB CURKY,I ADDRESS OF ID SEG ADB .21 GET WORD 21 OF ID SEG LDA B,I AND B777C 77700B - CLEAR BIT 15 AND BITS 0-5 STA B,I STORE IT BACK * LDA CURKY,I REPORT NAME OF PROGRAM ADA .12 LDB A,I GET FIRST 2 CHARS OF PROG NAME STB RDBUF INA LDB A,I CHARS 3 & 4 OF PROG NAME STB RDBUF+1 INA LDA A,I MASK 5TH CHAR AND B1774 CLEAR LOW BYTE IOR B40 INSERT SPACE IN LOW BYTE STA RDBUF+2 LDB .3 JSB WRLST DEF RDBUF PRINT NAME OF PROG * ENLP ISZ CURKY POINT TO NEXT ENTRY IN KEY WORD TABLE JMP IDLP EXAMINE NEXT ID SEGMENT * * MODIFY PROGRAM PAGE REQUIREMENTS? * IDONE LDA CURKY GET THE LAST+1 ADDR IN KEYWORD LIST ADA N1 POINT TO LAST ENTRY IN KEYWORD LIST LDA A,I GET CONTENTS STA CURKY SAVE ADDRESS OF LAST ID SEGMENT LDB .18 JSB WRTTY MODIFY PROG PAGE REQMTS?(/E TO END) DEF MSG45 LDB .6 JSB WRTTY PNAME,#PAGES DEF MSG46 MDPRM CLB,INB JSB =QUERY HYPHEN PROMPT DEF HYPHN JSB END? /E ENTERED? JMP ASNPR YES,DONE WITH PROG SIZE MODFICATION * NXTPR LDB APRSB NO INB POINT TO PROGRAM NAME IN PARSE BUFFER JSB TNAME GET ID SEG ADDRESS OF PROGRAM SEZ FOUND IT? JMP MDPRE NO SUCH PROG OR SHORT ID SEG STB IDSGA FOUND PROGRAM'S ID SEG ADDRESS * * MODIFY PROGRAM SIZE * ADB .14 POINT TO TYPE WORD LDA B,I AND B17 GET PROGRAM TYPE CPA .2 REAL TIME DISC RES PROG? RSS YES CPA .3 BACKGROUND DISC RES PROG? RSS YES CPA .4 LARGE BACKGROUND DISC RES PROG? RSS YES JMP MDPRE NO, THEN WRONG PROGRAM TYPE ADB .8 LOW MAIN ADDRESS LDA B,I CLB LSL 6 LOW MAIN PAGE# IN B REG CMB,INB ADB .33 MAX # OF PAGES ALLOWED FOR PROG STB UPRLM LDA IDSGA GET ID SEGMENT ADDRESS OF PROG ADA .28 WORD 29 OF ID SEGMENT LDB A,I GET CONTENTS SZB EMA PROGRAM? JMP EMAE YES, THEN ERROR INA POINT TO WORD 29 OF ID SEGMENT LDB A,I HIGH ADDR + 1 OF LARGEST SEGMENT ADA N6 POINT TO WORD 24 OF ID SEG SZB,RSS SEGMENTED PROGRAM? LDB A,I NO, THEN HIGH ADDRESS+1 OF MAIN LDA IDSGA ID SEGMENT ADDRESS ADA .22 LDA A,I CMA -(LOW MAIN+1) ADA B HIGH ADDR + 1 - (LOW MAIN + 1) CLB LSL 6 ADB .2 #PAGES USED TO RELOCATE PROG + BASE PAGE STB A USE AS LOW LIMIT FOR MODIFYING PROG SIZE LDB APRSB ADDRESS OF PARSE BUFFER ADB .4 CONTAINING # OF PAGES JSB TST# TEST THE # OF PAGES FOR VALIDITY UPRLM NOP JMP PGSE INVALID # OF PAGES ADA N1 SUBTRACT 1 TO EXCLUDE BASE PAGE ALF,ALF  # OF PAGES IN BITS 10-14 RAL,RAL STA TEMP SAVE #PAGES FOR NOW LDB IDSGA ID SEGMENT ADDR OF PROG ADB .21 POINT TO WORD 21 LDA B,I GET CONTENTS AND B1017 101777B - CLEAR # PAGES FROM WORD 21 ADA TEMP ADD THE NEW VALUE STA B,I RESTORE WORD BACK IN ID SEG JMP MDPRM PROMPT FOR NEXT ENTRY * MDPRE LDA A16 NO SUCH PROG OR SHORT ID SEG JMP *+2 EMAE LDA A21 PAGE REQMTS OF AN EMA PROG CANNOT BE MODIFIED JSB ERROR JMP MDPRM * PGSE LDA A19 PROGRAM SIZE INCORRECT JMP EMAE+1 * B17 OCT 17 N6 DEC -6 .8 DEC 8 B1017 OCT 101777 A21 ASC 1,21 A19 ASC 1,19 NEW ASC 2,NEW MSG44 ASC 10,UNASSIGNED PROGRAMS: MSG45 ASC 18,MODIFY PROG PAGE REQMTS?(/E TO END) MSG46 ASC 6,PNAME,#PAGES MSG47 ASC 16,ASSIGN PROG PART'NS?(/E TO END) MSG48 ASC 7,PNAME,PART'N# HYPHN ASC 1,- IDSGA NOP * * ASSIGN PROGRAMS TO PARTITIONS * ASNPR LDB .16 JSB WRTTY ASSIGN PROG PART'NS?(/E TO END) DEF MSG47 LDB .7 JSB WRTTY PNAME,PART'N# DEF MSG48 ASGNQ CLB,INB JSB QUERY HYPHEN PROMPT DEF HYPHN JSB END? JMP QPERM YES, DONE WITH PROG ASSIGNMENT LDB APRSB INB JSB TNAME FIND ID SEG ADDRESS FOR PROG SEZ FOUND IT? JMP ASPRE NO, NO SUCH PROG OR SHORT ID SEG STB TEMP YES, SAVE THE ID SEG ADDRESS ADB .14 POINT TO WORD 15 OF ID SEG LDA B,I AND B17 GET TYPE CPA .2 RSS CPA .3 RSS CPA .4 RSS JMP ASPRE NEITHER TYPE 2,3, OR 4 LDB APRSB ADB .4 POINT TO PART'N# VALUE IN PARSE BUF CLA LOW LIMIT JSB TST# TEST VALIDITY OF PART'N # PRTN# NOP # OF PARTITIONS DEFINED JMP PARTE ERROR IN PART'N# SZA,RSS IF PART NO. ZERO, THEN UNASSIGN JMP ASGNU Z ADA N1 SUBTRACT 1 TO HAVE PART'N # START FROM 0 STA TEMP1 SAVE PART'N # LDB TEMP ID SEG ADDRESS JSB FIT DOES THE PROG FIT IN PART'N? JMP NOFIT NO, ERROR * LDB TEMP YES, CHANGE ID SEG WORD 21 ADB .21 LDA B,I AND B777C MASK OUT RP BIT & PART'N# ADA TEMP1 NEW PART'N # ADA BIT15 RP BIT SET STA B,I RESTORE VALUE BACK JMP ASGNQ PROMPT AGAIN FOR NEXT ENTRY * ASGNU LDB TEMP ID SEG ADDRESS ADB .21 CHANGE WORD 21 LDA B,I AND B777C MASK OUT RP BIT AND STA B,I PUT BACK JMP ASGNQ GO GET SOMEMORE COMMANDS * ASPRE LDA A16 NO SUCH PROG OR SHORT ID SEG OR NOT TYPE 2,3,4 ASGN1 JSB ERROR JMP ASGNQ * PARTE LDA A17 JMP ASGN1 * NOFIT LDA A18 JMP ASGN1 * A16 ASC 1,16 A17 ASC 1,17 A18 ASC 1,18 .21 DEC 21 B777C OCT 77700 N1 DEC -1 MSG49 ASC 21,NEW MEM CONFIGURATION PERMANENT?(YES/NO) /R ASC 1,/R * * * MEMORY CONFIGURATION PERMANENT? * QPERM LDB .21 JSB QUERY NEW MEM CONFIGURATION PAERMANENT?(YES/NO) DEF MSG49 LDA PRSBF+1 CPA /R RESTART MEMORY RE-CONFIGURATION? JMP RSTRT YES CPA YE JMP MEMPR YES CPA NO RSS JMP QPERM ERRORNEOUS RESPONSE, ASK AGAIN SJP $EXIT EXIT THRU $CNFG RSTRT SJP $NPGQ RESTART MEMORY RE-CONFIGURATION * * MAKE MEM CONFIGURATION PERMANENT * COPY MAT ON DISC MEMPR XLA $SMTB+2 SZA 0? JMP PR$SM NO XSA $SMTB XSA $SMTB+1 PR$SM LDA A$SMT LDB .10 LENGTH OF TABLE ADB BIT15 SJS $TRTB * LDA $MNP MAX ALLOWABLE PART'NS MPY .7 EACH MAT ENTRY IS 7 WORDS LONG STA B LENGTH OF MAT ADB BIT15 LDA $MATA START ADDRESS OF MAT SJS $TRTB WRITE IT ON DISC * * COPY ALL ID( SEGMENTS TO DISC XLA KEYWD ADDRESS OF FIRST ID SEG LDA A,I CAX SAVE THIS VALUE ADA .14 POINT TO WORD 14 OF ID SEGMENT LDA A,I GET CONTENTS LSR 4 CXB FIRST ID SEGMENT ADDRESS SLA IS IT A SHORT ID SEGMENT? ADB .11 YES, THEN ADJUST START ADDRESS CBX SAVE THIS VALUE LDA CURKY GET ID SEGMENT ADDRESS OF LAST ID SEGMENT ADA .14 LDA A,I LSR 4 LDB CURKY SLA,RSS SHORT ID SEGMENT? ADB .13 NO ADB .19 ADJUST LAST WORD ADDRESS OF ID SEGMENT LIST CXA ADDRESS OF FIRST ID SEGMENT CMA ADB A LAST ADDR -START ADDR + 1 ADB BIT15 # OF WORDS IN ID SEGMENTS CXA START ADDRESS OF ID SEGMENTS SJS $TRTB TRANSFER ID SEGMENTS TO DISC * LDA AMPS2 MAKE $MPS2 PERMANENT CCB SJS $TREN * * CHANGE VALUES OF $MCHN,$MBGP,$MRTP,$BGFR,$RTFR * AND $CFR ENTRY POINTS ON DISC * LDA AMCHN ADDRESS OF $MCHN ENTRY POINT CCB SJS $TREN TRANSFER ENTRY POINT TO CORRESP LOC ON DISC LDA AMBGP CCB SJS $TREN LDA AMRTP CCB SJS $TREN LDA ACFR CCB SJS $TREN LDA ABGFR CCB SJS $TREN LDA ARTFR CCB SJS $TREN CCA XSA $GDPG INDICATE SYSTEM MAP IS CHANGED FOR SAM EXT SJP $EXIT DONE * .13 DEC 13 * * * * END? - ROUTINE TO DETERMINE IF /E WAS ENTERED AS * A RESPONSE * CALLING SEQUENCE: JSB END? * RETURNS: LOC P IF /E WAS ENTERED * P+1 OTHERWISE * * END? NOP LDA PRSBF+1 GET FIRST WORD OF RESPONSE CPA /E IS IT /E? RSS YES JMP NOTEN LDA PRSBF+2 GET SECOND WORD OF RESPONSE CPA SPACE 2 SPACES? JMP END?,I YES, THEN RESPONSE IS /E NOTEWN ISZ END? JMP END?,I RESPONSE NOT /E * /E ASC 1,/E * * QUERY - ROUTINE * CALLING SEQUENCE: B REG = # OF WORDS IN BUFFER TO DISPLAY * QUERY NOP CCA SET FLAG TO INDICATE ENTRY THRU QUERY JMP CONTQ WRTTY NOP SECOND ENTRY FOR ROUTINE TO WRITE TO TTY LDA WRTTY STA QUERY SET UP RETURN ADDRESS CLA CLEAR FLAG TO INDICATE ENTRY THRU WRTTY CONTQ STA WFLAG LDA QUERY,I STA QBUFR CLA,INA CAY LU# IN Y REG INA REQ CODE IS 2 FOR WROTE ADB BIT15 SET BIT 15 IN B REG TO INDICATE CALLING SJS $WRRD FROM USER MAP QBUFR NOP ISZ WFLAG JMP RQUER RETURN * READ RESPONSE CLA,INA LU # CAY IN Y REG LDA B401 REQUEST CODE LDB .80 80 WORDS TO READ ADB BIT15 INDICATE CALLING FROM USER MAP SJS $WRRD ARDBF DEF RDBUF BLS CONVERT TO # OF CHARS READ LDA ARDBF JSB $PARS CALL PARSE BUFFER APRSB DEF PRSBF RQUER ISZ QUERY JMP QUERY,I RETURN * .80 DEC 80 B401 OCT 401 WFLAG NOP B1777 OCT 1777 * * * WRLST - ROUTINE TO WRITE BUFER ON LIST DEVICE AND THE * SYSTEM CONSOLE IF ECHO IS REQUESTED * CALLING SEQUENCE: B REG = BUFFER LENGTH * JSB WRLST * DEF BUFR BUFFER ADDRESS * * WRLST NOP STB TEMP4 SAVE LENGTH OF BUFFER LDA WRLST,I GET BUFFER ADDRESS STA CNBF STA LSBF LDA ECHO ECHO REQUIRED? SZA JMP NECHO NO JSB WRTTY YES, SEND BUFFER OUT TO CONSOLE CNBF NOP * NECHO LDA LSTLU SEND BUFFER OUT TO LIST DEVICE CAY LDA B202 LDB TEMP4 ADB BIT15 SJS $WRRD LSBF NOP ISZ WRLST JMP WRLST,I RETURN * B202 OCT 202 * * * TST# - ROUTINE TO TEST VALIDITY OF A GIVEN # * CALLING SEQUENCE: A REG = LOWEWR LIMIT OF RANGE FOR # * B REG = POINTER TO 4 SET OF WORDS * FOR $# IN PARSE BUFFER * RETURN: LOC P IF ERROR RETURN * LOC P+1 IF NORMAL RETURN * NUMBER IS IN THE A REG * * TST# NOP CBX SAVE CONTENTS OF B REG LDB B,I TYPE OF VALUE CPB .1 NUMERIC? RSS YES JMP TSTE NO, THEN ERROR RETURN CXB RETRIEVE VALUE OF B REG INB LDB B,I GET VALUE CMA,INA -VE OF LOWER LIMIT ADA B VALUE-LOWER LIMIT SSA VALUE > UPPER LIMIT? JMP TSTE YES, THEN ERROR LDA B CMA,INA ADA TST#,I UPPER LIMIT-VALUE SSA VALUE>UPPER LIMIT? JMP TSTE YES, ERROR LDA B ISZ TST# NORMAL RETURN TSTE ISZ TST# JMP TST#,I RETURN * * * ERROR - ROUTINE PRINTS ERROR MESSAGE * CALLING SEQUENCE: A REG = ERROR# IN ASCII * JSB ERROR * ERROR NOP STA ERR00+6 LDB .7 LENGTH OF BUFFER JSB WRTTY DISPLAY ON CONSOLE DEF ERR00 JMP ERROR,I RETURN * ERR00 ASC 7,CONFIG ERR * * * PRNPR - ROUTINE TO PRINT A LIST OF PARTITION DEFINITIONS * CALLING SEQUENCE: JSB PRNPR * * PRNPR NOP LDA $MNP MAX # OF PARTITIONS CMA,INA STA TEMP USE AS COUNTER CLA,INA STA TEMP3 USE TEMP3 FOR PART'N # COUNTER LDA $MATA START OF MATA ENTRIES STA TEMP1 PARTL LDA TEMP1,I CONTENTS OF 1ST WORD OF MAT ENTRY CPA N1 -1? JMP PRNPR,I YES,RETURN - END OF MAT ENTRIES LDA TEMP3 GET PART'N # CCE CONVERT IT TO ASCII DECIMAL JSB $CVT3 ADA .2 LDA A,I GET PART'N # IN ASCII STA MSG30+4 SET UP MESSAGE LDA TEMP1 NO ADA .3 POINT TO WORD 4 STA TEMP1 LDA A,I GET CONTEN1TS STA TEMP2 SAVE IT ISZ TEMP1 5TH WORD OF MAT ENTRY LDA TEMP1,I LDB SPACE SSA R BIT SET? LDB COMAR YES STB MSG30+13 INCLUDE R IN THE MESSAGE * NPGS AND B1777 # OF PAGES IN PART'N INA ADD BASE PAGE CCE CONVERT TO ASCII DECIMAL JSB $CVT3 INA DLD A,I LAST 4 DIGITS DST MSG30+6 # OF PAGES IN PARTITION ISZ TEMP1 POINT TO WORD 6 LDA TEMP1,I LDB BG SSA BG PART'N? LDB RT NO, REAL TIME ISZ TEMP1 7TH WORD LDA TEMP1,I GET CONTENTS SZA,RSS SLW ZERO? JMP RTBGS YES, THEN NOT A SUBPART LDA TEMP2 GET CONTENTS OF WORD 4 SSA,RSS M BIT SET? LDB S NO, THEN SUBPARTITION * RTBGS STB MSG30+12 LDB .14 BUFFER LENGTH JSB WRLST PRINT IT DEF MSG30 PART'N XX = XX PAGES,[(RT,BG OR S) [,R] ISZ TEMP1 POINT TO NEXT MAT ENTRY ISZ TEMP3 INCREMENT PART'N # ISZ TEMP INCREMENT -VE COUNTER JMP PARTL NEXT PARTITION DATA JMP PRNPR,I RETURN ALL PART'NS DONE * COMAR ASC 1,,R MSG30 ASC 14,PART'N = PAGES, * * * PGREQ - ROTUINE TO PRINT REAL TIME AND BACKGROUND * PROGRMAS' PAGE REQIUREMENTS * * CALLING SEQEUNCE : TYPE = 0 FOR REALTIME PROGRAMS * = 1 FOR BACKGROUND PROGRAMS * PGREQ NOP XLA KEYWD START OF KEYWORD LIST STA TEMP KEYLP LDA TEMP,I GET ADDRESS OF AN ID SEGMENT SZA,RSS 0? JMP PGREQ,I YES, THEN DONE ADA .14 POINT TO WORD 15 OF ID SEG LDA A,I KEYWORDS ARE ADJUSTED TO POINT TO WORD 15 AND B27 OF LONG SHORT ID SEGMENTS LDB TYPE SZB LOOKING FOR REALTIME PROGS? JMP BKG NO, BACKGROUND CPA .2 IS THE TYPE 2 FOR REALTIME? JMP PRNPG YES, THEN PRINT PG REQMTS KEYEN ISZ TEMP NO, THEN LOOK AT NEXT ID SEG JMP KEYLP * BKG CPA .3 TYPE 3 FOR BG DISC RES PROG? JMP PRNPG YES, PRINT CPA .4 BG DISC RESIDENT WITHOUT TABLE AREA II? RSS YES JMP KEYEN NO, LOOK AT NEXT ID SEG LDB ASTER * FOR PROG WITHOUT TABLE AREA II RSS PRNPG LDB SPACE NOT A PRIV PROG STB MSG34+8 LDA TEMP,I GET ID SEG ADDRESS ADA .12 POINT TO WORD 13 CAX SAVE ADDRESS DLD A,I GET FIRST 4 CHARS OF NAME OF PROG DST MSG34 SET UP MESSAGE CXA ADA .2 POINT TO WORD 15 LDA A,I GET CONTENTS AND B1774 MASK UPPER BYTE IOR B40 INSERT BLANK IN LOW BYTE STA MSG34+2 LDA TEMP,I ID SEG ADDRESS ADA .28 LDA A,I GET CONTENTS OF WORD 29 LDB SPACE SZA EMA PROG? LDB E YES, THE INSERT E IN MESSAGE STB MSG34+9 LDA TEMP,I JSB PRGSZ DETERMINE # PAGES REQD BY PROG INA INCREMENT TO INCLUDE BASE PAGE CCE JSB $CVT3 INA POINT TO ASCII VALUE DLD A,I DST MSG34+3 LDA TEMP,I GET ID SEG ADDR OF PROG ADA .21 POINTO TO WORD 22 OF ID SEG LDA A,I GET CONTENTS OF WORD 22 OF ID SEG SSA,RSS RP BIT SET? JMP WRPGR NO AND B77 PROG IS ASSIGNED TO A PART'N INA PART'N # STARTING FROM 1 CCE CONVERT TO ASCII DEC JSB $CVT3 ADA .2 LDA A,I STA MSG34+14 LDB .15 LENGTH OF BUFFER RSS WRPGR LDB .10 WITHOUT PART'N # JSB WRLST DEF MSG34 PNAME XXXX PAGES [*] [E] [PART'N XX] JMP KEYEN LOOK FOR NEXT PROGRAM * ASTER ASC 1, * B1774 OCT 177400 B27 OCT 27 B40 OCT 40 TYPE NOP MSG34 ASC 15,PNAME PAGES PART'N * * * TNAME - SEARCH KEYWORD LIST FOR~ PROGRAM NAME * CALLING SEQUENCE: B REG = ADDRESS OF ASCII PROGRAM NAME * JSB TNAME * RETURNS: A REG = 0 IF PROGRAM NOT FOUND (E=1) * B REG = ID SEGMENT ADDRESS OF REQUESTED PROGRAM * E REG = 0 IF STANDARD ID SEGMENT * E REG = 1 IF SHORT ID SEGMENT OR NOT FOUND * * TNAME NOP STB TEMP3 ADDRESS OF NAME 1 AND 2 INB INCREMENT TO CHAR 3 AND 4 ADDR STB TEMP4 SAVE IT INB INCR TO CHAR 5 ADDR LDA B,I ASCII NAME CHAR 5 AND X AND B1774 MASK OFF X STA TEMP5 SZA IF NULL CHAR. FORCE ERROR RETURN XLA KEYWD STA TEMP TN005 LDA TEMP,I CHECK IF AT END OF LIST CCE,SZA,RSS JMP TNAME,I END OF LIST RETURN ADA .12 LDB A,I ID SEG ASCII NAME CHARS 1 AND 2 CPB TEMP3,I COMPARE WITH REQUESTED CHAR 1,2 INA,RSS COMPARES JMP TN030 DOES NOT COMPARE-GO TO NEXT PROG LDB A,I ID SEG ASCII NAME CHARS 5,X CPB TEMP4,I COMPARE WITH REQUESTED CHARS 3,4 INA,RSS COMPARES JMP TN030 DOES NOT COMPARE-GO TO NEXT PROG LDA A,I ID SEG ASCII NAME CHARS 5,X STA B SAVE FOR SHORT ID TEST AND B1774 MASK OFF X CPA TEMP5 COMPARE CHAR 5 JMP TN040 COMPARES-SO PROGRAM FOUND * TN030 ISZ TEMP INCREMENT KEYWORD ADDRESS JMP TN005 GO TO COMPARE CHARS TN040 LSR 4 MOVE SHORT ID BIT TO LEAST B ERB SET E FOR RETURN LDB TEMP,I LOAD B WITH ID SEG ADDRESS JMP TNAME,I EXIT * * * SETM - ROUTINE TO SET MEMORY TO A GIVEN VALUE * CALLING SEQUENCE: A REG = VALUE * B REG = # OF LOCATIONS TO CHANGE * JSB SETM * DEF LOC STARTING LOCATION * * SETM NOP CAX SAVE VALUE OF A REG IN X LDA SETM,I STARTING LOC STA TEMP ADDRESS OFp LOC ISZ SETM CMB,INB -VE COUNT CXA VALUE IN A SETLP STA TEMP,I STORE VALUE INB,SZB,RSS INCREMENT COUNTER JMP SETM,I RETURN ISZ TEMP POINT TO NEXT MEM LOC JMP SETLP * * * FIT - ROUTINE TO TEST IF GIVEN PROGRAM CAN * FIT INTO THE PARTITION # PASSED AS PARAMETER * CALLING SEQUENCE: A REG = PART'N # STARTING AT 0 * B REG = ID SEG ADDRESS * JSB FIT * RETURNS: LOC P IF PROGRAM DOES NOT FIT IN PART'N * LOC P+1 IF THE PROGRAM DOES FIT * FIT NOP STB TEMP4 SAVE ID SEGMENT ADDRESS MPY .7 GET ADDRESS OF PART'N ENTRY IN MAT ADA $MATA ADDRESS OF MAT LDB A,I SSB IS PART'N DEFINED? JMP FIT,I NO, THEN ERROR RETURN ADA .4 WORD 5 OF MAT ENTRY LDB A,I ELB,CLE,ERB CLEAR R BIT IF SET STB TEMP5 SAVE # OF PAGES IN PART'N LDA TEMP4 GET ID SEG ADDRESS OF PROG JSB PRGSZ FIND # PAGES REQD BY THIS PROG CMA,INA ADA TEMP5 # PAGES IN PART'N - # PAGES REQD BY PROG SSA PROGRAM FITS? JMP FIT,I NO, THEN ERROR RETURN ISZ FIT YES JMP FIT,I RETURN TO LOC P+1 * * * PRGSZ - ROUTINE TO DETERMINE # PAGES REQD BY * A PROGRAM NOT INCLUDING BASE PAGE * CALLING SEQUENCE: A REG = ID SEGMENT ADDRESS * JSB PRGSZ * RETURNS: A REG = # OF PAGES REQD. BY PROG * B REG = 0 IF NON-EMA PROGRAM * = -1 IF EMA PROGRAM * * PRGSZ NOP STA TEMP3 SAVE ID SEG ADDRESS FOR LATER USE ADA .21 LDA A,I GET WORD 21 OF ID SEG ALF # OF PAGES IN LOW BITS RAL,RAL AND B37 # OF PAGES REQUIRED BY PROG CAX SAVE VALUE LDA TEMP3 GET ID SEG ADDRESS ADA .28 EMA PROG? LDB A,I SZB,RSS JMP NOEMA NO HFB CLA YES, EMA PROG RRL 6 GET ID SEG EXT # STB TEMP3 SAVE EMA SIZE VALUE LEFT IN B REG ADA $IDEX ID SEG EXT ADDRESS LDA A,I ADDRESS OF FIRST WORD OF ID SEG EXT LDA A,I CONTENTS OF FIRST WORD OF ID SEG EXT AND B37 GET BITS 0-4 - MSEG SIZE CMA,INA LDB TEMP3 ROTATE VALUE SAVED IN TEMP BLF,BLF RBL,RBL TO GET EMA SIZE ADA B - MSEG SIZE CXB ADA B + # PAGES IN PROGRAM CCB SET B TO INDICATE EMA PROG JMP PRGSZ,I RETURN NOEMA CXA # PAGES REQUIRED BY PROGRAM CLB B = 0 TO INDICATE NON-EMA PROG JMP PRGSZ,I RETURN * END $CNFX H  92067-18007 1840 S 0222 RTE-IV WHZAT              H0102 $ASMB,R,Q,C * * **************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT * * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * **************************************************************** * HED WHZAT FOR RTE-IV NAM WHZAT,1,1 92067-16007 REV.1840 780727 * * NAME: WHZAT * SOURCE: 92067-18007 * RELOC: 92067-16007 * PRGMR: E.J.W. * SUP PRESS ALL EXTRANEOUS LISTING EXT EXEC,$TIME,$RNTB,$CLAS,TMVAL EXT $MATA,$MNP * A EQU 0 B EQU 1 * EQTA EQU 1650B EQT# EQU 1651B DRT EQU 1652B LUMAX EQU 1653B KEYWD EQU 1657B * * *THE FOLLOWING IS A SAMPLE OUTPUT OF THIS PROGRAM: * ON,WHZAT,LU * * 09:51:50:710 * ********************************************************************** * PT SZ PRGRM,T ,PRIOR*DRMT*SCHD*I/O *WAIT*MEMY*DISC*OPER * NEXT TIME * * ********************************************************************** * 0 ** MEM *1 *09000 ***** 1 * 2 2 R$PN$*1 *00010 *************** 3,CL 032 * 3 5 PROGA*3 *00097 ******************************* 6 * 4 5 PROGB*3 *00097B*************** 3,LULK 40,LKPRG=PROGA * 5 17 PROGC*3E*00097 *************** 3,RN 031,LKPRG=PROGD * 3A27 PROGD*4 *00097 *************** 3,RESOURCE * 5 7 PROGE*3 *00097 *************** 3,CLASS # * 2 4 QUIKR*3 *00099 0 **********************************00:00:00:000 * 6 7 FMGR *3 *00090 *************** 3,EDITR'S QUEUE * 3 7 EDITR*3 *00050 ************************* 5 * 6 15 ASMB *3 *00099 *************** 3,LU,EQ DN , 5(0[00000000]) * 4A 6 TIMEL*4 *00090 *************** 3,LU,EQ DN 6, 5(0[00000000]) * 4A 6 TIMEL*4 *00090 *************** 3,LU,EQ DN *********00:00:00:000 * 7 7 FMG07*3 *00050 *************** 3,BL,EQT 7 * 2 3 WHZAT*4 *00001 ***** 1 * 0 *-* RENSB*1 *00060 ******************** 4 * 3 6 PROGF*4 *00096 *************** 3,RN 031,LKPRG=GLOBL * 6 7 ED26 *3 *00050 ********** 2, 16(2[00000010]) * ********************************************************************** * DOWN LU'S, 6, 14 ************************************************************************ * DOWN EQT'S, 5, 6 * ********************************************************************** * 09:51:50:710 * * * BRIEF EXPLANATION OF SOME OF THE ABOVE. * * PT SZ COLUMN HEADING (PARTITION NUMBER AND PARTITION SIZE) * 0 ** IN RTE-IV MEANS MEMORY RESIDENT PROGRAM * 5 8 IN RTE-IV MEANS PARTITION #5 IS USED AND 8 PAGES IN USE * 11 IN RTE-IV MEANS SCHEDULED PROGRAM IS NOT YET IN PARTITION * * 'A' AFTER THE PARTITION # MEANS THE PROGRAM WAS ASSIGNED * 'E' AFTER THE PROGRAM'S TYPE MEANS IT IS AN EMA PROGRAM * 'B' AFTER THE PROGRAM'S PRIORITY MEANS RUNNING UNDER BATCH * WHEN A PROGRAM IS IN STATE 3[WAIT],THE REASON FOR BEING IN THAT * STATE WILL BE SPECIFIED ACCORDING TO THE FOLLOWING RULES : * IDSEG(2) ::= $RNTB => 'RN ALLOCATION' * ::= DRT(#[6:10])=RN# => 'LU # LOCKED' * ::= >$RNTB,<$RNTB+[$RNTB] => 'RN LOCKED' * ::= $CLAS => 'CLASS ALLOCATION' * ::= >$CLAS,<$CLAS+[$CLAS] => 'CLASS GET' * ::= 4 => 'DEVICE(LU OR EQT) DOWN' * ::= SON'S IDSEG ADDRESS => 'SON'S NAME' * ::= EQT ADDRESS => 'BL,EQT#NN' * * * * FORMAT IF THE PARTITION LIST OPTION IS CHOSEN IN RTE-IV * ON,WHZAT,LU,1 * * 09:00:21:250 * ********************************************************************** * PTN# SIZE PAGES BG/RT PRGRM * ********************************************************************** * 1 7 42- 48 BG FMG11 * 2 15 49- 63 BG EDITR * 3 16 64- 79 RT WHZAT * 4M 48 80- 127 BG EMAPR * 5C 16 80- 95 BG * 6C 16 96- 111 BG * 7C 16 112- 127 BG * 8M 64 128- 191 RT * 9SR 16 128- 143 RT * 10S 16 144- 159 RT PROGQ * 11S 16 160- 175 RT SAMPL * 12SR 16 176- 191 RT * 13 R 64 192- 255 BG EMAID * 14 * 15 * ********************************************************************** * 09:00:21:310 * * SKP WHAT XLA B,I CLE,SZA,RSS SCHED W PRAM ? CLA,CCE,INA NO-DEFAULT TO LU 1 STA CRTLU SAVE LU FOR OUTPUT INB XLA B,I STA PARM2 SAVE SECOND PARAMETER INB XLA B,I GET SPECIAL LU PARAM SZA,RSS IN CASE OF PREV RUN LDA CRTLU SEZ DEFAULT NEEDED? STA CRTLU YES SPC 2 LDA .EOF SEND BLANK LINE LDB DM6 JSB PRINT USE STD PRINT SUB JSB TOD PRINT TIME-OF-DAY AS NEXT LINE JSB STARS ERASE EOL + A LINE OF ASTERISKS * LDA PARM2 SZA WAS SECOND PARAMETER GIVEN? JMP WHATP YES, SHOW PARTITIONS * SPC 2 LDA .HEAD ERASE EOL + COLUMN HEADER LDB DM74 JSB PRINT JSB STARS ERASE EOL + A LINE OF ASTERISKS CLA ZERO IDSEG # STA IDCNT AND AWAY WE GO ! SPC 2 SKP MAIN JSB SETPT BEGIN MAIN CODE. INIT STACK LDA KEYWD GET ADDRESS OF KEYWORD BLOCK ADA IDCNT ADD ON IDSEG # TO INDEX XLA A,I TO THIS LOOP'S WORK STA IDPNT IDSEG(1) * SZA,RSS IF ZERO, JMP FINIS THEN WE'RE THRU WITH ID SEG'S * LDB D15 ELSE VERIFY JSB IDWRD THAT THIS AND B17 IDSEG(16[4-0])=PROG STATUS STA STATS PROGRAM IS SZA NOT DORMANT ? JMP PROCS ACTIVE SO PROCESS IT ! * LDB D17 VERIFY JSB IDWRD THAT THIS ALF,vSLA IDSEG(18[12])=TIME LIST INDICATOR JMP PROCS PROG IS IN TIME LIST ! JMP BUMP0 ELSE NEXT INDEX(IDSEG #) * D2 DEC 2 D3 DEC 3 D5 DEC 5 D6 DEC 6 D12 DEC 12 D14 DEC 14 D15 DEC 15 D16 DEC 16 D17 DEC 17 D21 DEC 21 B77 OCT 77 B17 EQU D15 CRTLU NOP PARM2 NOP IDCNT NOP IDPNT NOP STATS NOP STACK OCT 0,0 BSS 35 .STAK DEF STACK STKPT NOP .TM. DEF STACK+31 .DNTM DEF STACK+26 .LAST DEF STACK+36 ASTER OCT 0,0 UNL REP 35 ASC 1,** LST .ASTE DEF ASTER .STAR DEF ASTER+2 DM4 DEC -4 D7 DEC 7 SPC 4 PROCS EQU * LDB D14 JSB IDWRD GET PROG TYPE AND D7 CPA D1 RESIDENT PROGRAM? RSS JMP PRLNG NO, PROCESS DISC RESIDENT * LDA .RSDT YES, RESIDENT PROGRAM JSB MVBYT PRINT IT IS IN PARTITION 0 DEF D6 * JMP NAME GO GET PROGRAM NAME * PRLNG LDB D21 GET CONTENTS JSB IDWRD OF WORD 22 STA NUM (PARTITION #) STA B AND B77 SSB,RSS WAS PROG ASSIGNED TO PTTN SZA NO, WAS IT IN ANY PTTN? JMP PRPTN YES, ASSIGNED OR IN PTTN (NOT 1) * LDB D8 JSB IDWRD SZA HAS PROGRAM BEEN SUSPENDED BEFORE? JMP PRPT YES, THEN PARTITION #1 IS OK. * LDA .SPAC NO, PROGRAM MAY NOT HAVE BEEN LOADED JSB MVBYT DEF D2 JMP PRASG DO ASSIGNMENT INDICATOR * PRPT CLA PRPTN INA CONVERT TO ASCII JSB .ASC2 AND ADD TO STACK * PRASG LDA .SPAC LDB NUM SSB WAS PROG ASSIGNED TO PTTN? LDA .A YES, PUT 'A' IN LINE JSB MVBYT ELSE PUT A SPACE IN DEF D1 OUTPUT LINE * LDA NUM ALF,RAL GET NUMBER OF PAGES RAL IN PARTITION AND B37 INA ADD 1 FOR BASE PAGE JSB .ASC2 COyNVERT TO ASCII LDA .SPAC JSB MVBYT PUT A SPACE DEF D1 * * NAME LDA IDPNT CALC 'FROM' JSB MVNAM MOVE NAME TO OUTPUT STACK * JSB PSTAR PUSH AN ASTERISK SPC 2 TYPE LDB D14 GET PROGRAM TYPE JSB IDWRD ALF,ALF CHECK FOR SHORT ID ALF,SLA,ALF SHORT ? JMP FINIS YES,STOP ID CHECK AND D7 MASK OFF IDSEG(15[2-0]) STA NUM SAVE PROG TYPE FOR A WHILE JSB .ASC1 & STORE BYTE LDB D28 GET EMA WORD FROM ID SEG LDA NUM CPA D1 IS IT MEM. RES. PROG? CLA,RSS YES, SKIP EMA STUFF JSB IDWRD LDB .SPAC SZA IS IT EMA? LDB .E YES, PUT 'E' IN LINE LDA B ELSE USE SPACE JSB MVBYT DEF D1 JSB PSTAR PUSH AN ASTERISK * PRIOR LDB D6 GET PROG PRIORITY JSB IDWRD IN 'A'REG JSB ZASC5 CONVERT TO ASCII & ADD TO STACK * LDB D20 JSB IDWRD LDB .SPAC SSA IF RUNNING UNDER BATCH, LDB .B PRINT 'B' LDA B ELSE PRINT SPACE JSB MVBYT DEF D1 SPC 2 LDA STATS CALC STATUS COLUMN SZA,RSS DORMANT ? JMP M NO ASTERISKS NECESSARY MPY D5 5 CHARS PER COLUMN STA NUM SET UP MOVE LDA .STAR 'A'REG=SOURCE JSB MVBYT MOVE BYTES,R/L DEF NUM BER OF BYTES * M LDA STATS CONVERT STATUS TO ASCII JSB .ASC2 & PUSH ONTO STACK * LDA STATS GET STATUS CPA D2 I O SUSPEND ? JMP EQT YES-PROCESS EQT# CPA D3 WAIT LIST ? JMP WAIT YES-PROCESS WAIT LDA .SPAC ADD ONE MORE SPACE JSB MVBYT DEF D1 JMP TLIST CHECK TLIST SPC 2 EQTPT NOP #EQTS NOP .RSDT DEF *+1 ASC 3, 0 ** .A DEF *+1 ASC 1,AA .B DEF *+1 P ASC 1,BB .E DEF *+1 ASC 1,EE D28 DEC 28 SKP EQT CLA PROG'S IN I/O SUSPEND STA #EQTS SET UP EQT INDEX * EQTLP LDA #EQTS GET EQT INDEX MPY D15 (15 WORDS EQT) ADA EQTA ADD ON EQT AREA BASE STA EQTPT SAVE THIS EQT'S ADDRESS XLA A,I GET CONTENTS OF EQT'S FIRST WORD * IDSLP SZA,RSS SCAN SUSPEND LIST. NULL LIST? JMP NXTEQ YES-GO TO NEXT EQT CPA IDPNT NO-POINTS TO OUR ID SEG ? JMP FNDEQ YES-GO PROCESS. SSA IF INDIRECT MUST BE GARBAGE JMP NXTEQ XLA A,I NO-NEXT LIST ELEMENT JMP IDSLP & CONTINUE THE SEARCH * NXTEQ ISZ #EQTS STEP EQT CNTR FOR NEXT EQT ENTRY LDA #EQTS ARE WE THRU ? CPA EQT# COMPARE WITH BASE PAGE COUNT JMP OSCAR YES-MUST BE OSCAR JMP EQTLP NO- GOTO EQT LOOP * OSCAR LDA .EXEC MOVE " ,EXEC" ONTO STACK JSB MVBYT DEF D6 JMP TLIST & CHECK TIME LIST SPC 2 .EXEC DEF *+1 ASC 3,, EXEC .CMBL EQU .EXEC COMMA, BLANK B140K ABS 140000B .LPAR DEF *+1 ASC 1,( .LBRK DEF *+1 ASC 1,[ .IOBE DEF *+1 ASC 1,]) * SPC 2 FNDEQ EQU * PUSH ", EQ(L[DEV.STAT]) *" LDA .CMBL MOVE COMMA AND BLANK JSB MVBYT DEF D2 LDA #EQTS CALC EQT # INA JSB .ASC2 CONVERT TO ASCII LDA .LPAR PUSH "(" ONTO STACK JSB MVBYT DEF D1 * LDB EQTPT GET DEV.LOG.STATUS ADB D4 LDA B,I ALF,ALF STA EQST SET UP FOR BINARY STATUS ALF,ALF AND B140K MASK OFF LOGICAL STATUS RAL,RAL RIGHT JUSTIFY IN WORD JSB .ASC1 CONV TO ASCII & STORE LDA .LBRK PUSH "[" ONTO STACK JSB MVBYT DEF D1 * LDA DM8 SET UP LOGICAL STATUS STA CNT COUNTER BINLP LDA EQST CONVERT STATUS WORsD TO BINARY RAL ROTATE CCW STA EQST SAVE IT AND D1 MASK OFF LSB(IT) JSB .ASC1 CONV TO ASCII & STORE ISZ CNT DONE 8 ? JMP BINLP NO-LOOP * LDA .IOBE MOVE LAST PART OF MESSAGE JSB MVBYT PUSH DEF D2 JMP TLIST CHECK TLIST SPC 2 DM8 DEC -8 D20 DEC 20 REASN NOP TEST EQU REASN EQST NOP SKP WAIT LDA .EXEC PUSH "," ONTO STACK JSB MVBYT FOR EXPLANATION DEF D1 * CLB,INB GET IDSEG(2) JSB IDWRD STA REASN CPA .RNTB RESOURCES LOCK ? JMP RESLK YES-PUSH "RESOURCE" ONTO STACK * CPA .CLAS NO-CLASS LOCK ? JMP CLSLK YES-PUSH "CLASS #" ONTO STACK * CPA D4 NO-DEVICE DOWN ? JMP DEVDN YES-PUSH "DEVICE DOWN" ONTO STACK * JSB TSTWD RNTBL<=IDSEG(2)<=[RNTBL] ? .RNTB DEF $RNTB+0 JMP RNLCK YES-PUSH "RN LOCK" ONTO STACK * JSB TSTWD CLASS<=IDSEG(2)<=[CLASS] ? .CLAS DEF $CLAS+0 JMP CLGET YES-PUSH "CLASS GET" ONTO STACK * LDA 1650B EQT <= IDSEG(2) <= #EQTS CMA,INA - S.A. OF EQT ADA REASN + POINTER SSA IF -, THEN POINTER < EQT S.A. JMP SONID FORGET IT CLB RESULT IS ADD REL S.A.EQT DIV D15 MOD 15 INA + 1 STA TEMP = EQT # CMA,INA -EQT# ADA 1651B + # EQT'S SSA,RSS IF POS,THEN VALID EQT # JMP BL SO PROCESS IT * SONID LDA REASN GET SON'S IDSEG ADDRESS JSB MVNAM MOVE SON'S NAME ONTO STACK LDB D15 JSB IDWRD ALF,SLA JMP TLIST BIT 12 SET, HAVE SON * LDA .QUE BIT 12 CLEAR, SON YET TO BE JMP PUSH8 SPC 2 .BLIM DEF *+1 ASC 3,BL,EQT00 * BL LDA .BLIM SET UP BUFFER LIMIT MESSAGE JSB MVBYT DEF D6 LDA TEpeMP JSB .ASC2 CONVERT EQT# & PUSH JMP TLIST TEMP NOP SPC 2 .QUE DEF *+1 ASC 4,'S QUEUE .RN?? DEF *+1 ASC 4,RESOURCE RESLK LDA .RN?? PUSH "RN ??" ONTO STACK JMP PUSH8 SPC 2 .CL?? DEF *+1 ASC 4,CLASS # CLSLK LDA .CL?? PUSH "CL ??" ONTO STACK PUSH8 JSB MVBYT PUSH 8 CHARS ONTO STACK DEF D8 JMP TLIST SPC 2 .EQDN DEF *+1 ASC 5,LU/EQ DN DEVDN LDA .EQDN PUSH "LU,EQ DN" ONTO STACK JSB MVBYT DEF D8 LDB D2 JSB IDWRD GET LU# FROM SUSPENDED ID STA REASN SAVE IT TEMPORARILY SSA IF NEGATIVE, IT IS EQT ADDR JMP DVDNE OF DOWN DEVICE * JSB .ASC4 PUT LU LEADING BLANKS * CCA FIND EQT NO. FOR LU ADA REASN AND B77 ADA DRT LDA A,I AND B77 ADA M1 STA #EQTS * MPY D15 ADA EQTA STA EQTPT JMP FNDEQ GO PRINT EQT STUFF. * DVDNE CMA,INA SAVE EQT ADDR OF DOWN DEVICE STA EQTPT LDA REASN CONVERT EQT ADDR TO EQT # ADA EQTA BY SUBTRACTING EQT BASE ADDR CMA,INA CLB DIV D15 AND DIVIDE BY 15 INA BUMP BY 1 FOR FIRST EQT STA #EQTS LDA .SPAC PUT 4 BLANKS FOR LU# JSB MVBYT DEF D4 JMP FNDEQ PUT OUT EQT INFO SPC 2 B37 OCT 37 @DRT EQU 1652B @LUMX EQU 1653B .RNLK DEF *+1 ASC 2,RN 00,LKPRG=PROGA . .LKPR DEF *+1 ASC 4,,LKPRG= * RNLCK STA RN SAVE RN# TEMP LDA @DRT GET DRT ADDRESS STA PTR SET UP POINTER LDA @LUMX GET MAX # OF LU'S CMA,INA SET UP COUNTER STA CNT LLOOP EQU * SEARCH FOR LU LOCK LDA PTR,I GET DRT ENTRY RRR 6 POSITION LU LOCK RN AND B37 & MASK IT CPA RN LU LOCK ? JMP LULCK YES-PROCESS IT ISZ zPTR NO LOOP ISZ CNT JMP LLOOP LDA .RNLK PUSH "RN LK" ONTO STACK JSB MVBYT DEF D4 LDA RN PROCESS RNLCK JSB ZASC3 JSB PLOCK PUT PROG NAME INTO MESSAGE JMP TLIST SPC 2 .LULK DEF *+1 ASC 3,LULK 00,LKPRG=PROGA . * LULCK LDA .LULK PUT "LULK" ONTO STACK JSB MVBYT DEF D4 LDA CNT PROCESS LU LOCK - FIND ADA @LUMX OWNER'S NAME INA JSB .ASC3 PUT LU# IN MESSAGE JSB PLOCK PUT PROG NAME IN MESSAGE JMP TLIST SPC 2 PLOCK NOP LDA .LKPR PUSH ",LKPRG=" ONTO STACK JSB MVBYT DEF D7 LDA .RNTB ADA RN XLA A,I AND B377 GET RESOURCE LOCKER'S ID SEG # CPA B377 IS IT GLOBAL? JMP PLCK9 YES. ADA M1 ADA KEYWD XLA A,I JSB MVNAM MOVE NAME JMP PLOCK,I * PLCK9 LDA .GLBL JSB MVBYT MOVE NAME 'GLOBL' DEF D5 JMP PLOCK,I * .GLBL DEF *+1 ASC 3,GLOBL M1 DEC -1 RN NOP PTR NOP CNT NOP .CLGT DEF *+1 ASC 3,CL .SPAC DEF .CLGT+2 CL# NOP * CLGET STA CL# LDA .CLGT PUSH "CL " ONTO STACK JSB MVBYT DEF D4 LDA CL# JSB ZASC3 JMP TLIST * * TLIST LDB D17 IDSEG(18[12])=TIME LIST INDICATOR JSB IDWRD ALF,SLA SET ? JMP NXTTM YES-CONV NEXT TIME JMP DUMP NO-PRINT WHAT WE'VE GOT. SPC 2 D8 DEC 8 SPC 2 NXTTM LDA .TM. CALC # OF STARS TO FILL LINE CLE,ELA CMA,INA ADA STKPT CMA,INA SSA,RSS MORE THAN WE CAN FIT? JMP NXTM2 NO, OK * JSB OUTPT YES, LU/DN MSG TOO LONG LDA .DNTM COPY LINE AFTER PRINTING IT CLE,ELA AND ADD TIME STUFF TO IT STA STKPT JMP NXTTM * NXTM2 STA NUM & SAVE IT LDA .STAR SET UP FOR MOVE JSB MVBYT DEF NUM * LDA IDPNT ADA D18 JSB CNVTM * DUMP JSB OUTPT DISPLAY STACK BUMP0 ISZ IDCNT JMP MAIN SPC 2 FINIS JSB STARS EOL + 70 ASTERISKS * DNDEV JSB SETPT RESET STACK FOR DOWN LU'S. LDA .DNLU PRINT LINE HEAD. JSB MVBYT DEF D9 LDA STKPT SAVE CURRENT POSITION STA PTR IN CASE NEED MORE LINES * LDA DRT GET LU TABLE AREA ADDRESS, ADA LUMAX POSITION TO WORD TWO STA EQTPT TABLE AND SAVE. CLA INITIALIZE STA #EQTS COUNTER. * DNLU1 LDA EQTPT,I GET LU'S STATUS. ISZ #EQTS SSA,RSS IS IT DOWN? JMP NXTLU NO--GET NEXT LU. * LDA .LAST CLE,ELA CMA,INA NEGATE LAST POSITION TO START ADA STKPT SEE IF TOO FULL YET. SSA LINE FULL YET? JMP DNLU2 NO, DO IT * JSB OUTPT YES, DUMP LINE LDA PTR SET UP NEW LINE STA STKPT JUST LIKE THE PREVIOUS DNLU2 LDA .CMBL YES--PROCESS IT. JSB MVBYT PUSH A ','. DEF D1 LDA #EQTS CONVERT LU# JSB .ASC3 TO ASCII. NXTLU ISZ EQTPT INCREMENT DRT WORD 2 POINTER. LDA #EQTS IF LAST, CPA LUMAX THEN GO RSS DUMP LINE. JMP DNLU1 ELSE CONTINUE. * JSB OUTPT PRINT STACK. JSB STARS E0L + LINE OF ASERISKS. * JSB SETPT RESET STACK FOR DOWN EQTS LDA .DNEQ PRINT LINE HEAD JSB MVBYT DEF D10 LDA STKPT SAVE CURRENT POSITION STA PTR IN CASE WE NEED ANOTHER LINE * LDA EQTA GET EQT TABLE AREA ADDRESS ADA D4 INDEX TO STATUS STA EQTPT PUSH POINTER CLA INIT STA #EQTS EQT COUNTER DEVLP LDA EQTPT,I FIND EQT'S. GET STATUS ISZ #EQTS RAL,RAL POSITION AND D3 & MASDK CPA D1 IS IT DOWN RSS YES-PROCESS JMP NXTDV NO-NEXT EQT * LDA .LAST CLE,ELA CMA,INA NEGATE LAST POSITION ADA STKPT TO SEE IF FULL YET? SSA FULL YET? JMP DNEQ2 NO, DO IT * JSB OUTPT DUMP LINE LDA PTR SET UP FOR ANOTHER LINE STA STKPT JUST LIKE THE PREVIOUS DNEQ2 LDA .CMBL PUSH "," JSB MVBYT DEF D1 LDA #EQTS CONV EQT# TO ASCII JSB .ASC3 NXTDV LDA EQTPT BUMP ADA D15 TO NEXT STA EQTPT EQT STATUS WORD LDA #EQTS WAS THIS THE LAST CPA EQT# RSS YES-DUMP IT JMP DEVLP NO-CONTINUE SPC 2 DONE JSB OUTPT PRINT STACK DONE1 JSB STARS EOL + LINE OF ASTERISKS EXIT JSB TOD FINALLY TIME OF DAY LDA .EOF ANOTHER BLANK LINE LDB DM6 JSB PRINT SPC 2 JSB EXEC I AM SERIALLY REUSABLE DEF RSTRT DEF D6 DEF ZERO DEF M1 DEF ZERO DEF PARM2 DEF CRTLU RSTRT JMP WHAT RESTART SPC 2 ZERO OCT 0 D18 DEC 18 DM6 DEC -6 RNTBL NOP CLASS NOP NUM NOP D4 DEC 4 .DNEQ DEF *+1 ASC 5,DOWN EQT'S .DNLU DEF *+1 ASC 5,DOWN LU'S D9 DEC 9 * .EOF DEF *+1 OCT 0,0,20040 .HEAD DEF *+1 OCT 0,0 ASC 10,PT SZ PRGRM,T ,PRIOR ASC 10,*DRMT*SCHD*I/O *WAIT ASC 10,*MEMY*DISC*OPER * NE ASC 5,XT TIME *** SKP SPC 2 FROM BSS 2 TO EQU FROM+1 B377 OCT 377 SPC 2 STBYT NOP LDB TO OCT 105764 JSB SBT STB TO JMP STBYT,I SPC 2 * ('A'REG = WORD ADDRESS OF FROM) * JSB MVBYT * DEF COUNT * MVBYT NOP CLE,ELA LDB STKPT DST FROM LDA MVBYT,I ISZ MVBYT STA .MVBY DLD FROM OCT 105765 JSB MBT .MVBY NOP NdOP STB STKPT JMP MVBYT,I SPC 2 PSTAR NOP LDA .STAR JSB MVBYT DEF D1 JMP PSTAR,I SPC 2 SETPT NOP LDA .STAK ADA D2 CLE,ELA STA STKPT JMP SETPT,I SPC 2 OUTPT NOP LDA .STAK LDB .STAK CLE,ELB CONV TO BYTES CMB,INB ADB STKPT ADD ON CURRENT BYTE POSITION CMB,INB JSB PRINT JMP OUTPT,I SPC 2 STARS NOP LDA .ASTE LDB DM74 JSB PRINT JMP STARS,I * DM74 DEC -74 SPC 2 * 'A'REG = UPPER LIMIT * 'B'REG = LOWER LIMIT * TEST = ??????????? * JSB TESTR * RETURN -'A'REG : POS => FALSE NEG => TRUE . TESTR NOP CMB,CLE,INB ADB TEST LDB TEST CMB,SEZ,CLE,INB ADB A ERA SIGN = E. E=0 FALSE E=1 TRUE JMP TESTR,I SPC 2 TSTWD NOP LDB TSTWD,I GET ADDR OF TABLE ISZ TSTWD XLA B,I GET UPPER LIMIT BY ADDING ADA B SIZE OF TABLE TO ADDR STB SAVEB SAVE ADDR OF TABLE AS LOWER LIMIT JSB TESTR SSA,RSS ISZ TSTWD LDA SAVEB CMA,INA ADA TEST JMP TSTWD,I SPC 2 * (A) = ID SEG ADDR * JSB MVNAM * MVNAM NOP MOVE NAME FROM ID SEG TO OUTPUT LINE ADA D12 LDB D3 CBX MOVE 3 WORDS FROM SYSTEM MAP LDB DWRD1 BECAUSE MBF REQUIRES MWF DEST. TO BE AT EVEN WORD LDA DWRD1 JSB MVBYT DEF D5 JMP MVNAM,I * WORD1 NOP WORD2 NOP WORD3 NOP SPC 2 PRINT NOP STA .BUFF STB CNT JSB EXEC DEF *+1+4 DEF D2 DEF CRTLU .BUFF DEF STACK DEF CNT JMP PRINT,I * TOD NOP JSB SETPT LDA @TIME JSB CNVTM JSB OUTPT JMP TOD,I SPC 2 @TIME DEF $TIME+0 MS NOP SEC NOP MIN NOP HOURS NOn!P DAY NOP .HOUR DEF HOURS .COLN DEF *+1 ASC 1,:: .ZERO DEF *+1 ASC 1,00 SPC 2 CNVTM NOP LDB D3 MOVE 3 WORDS OF TIME CBX TO USER MAP FROM SYS MAP LDB DWRD1 MWF JSB TMVAL CONVERT INTO COMPONENTS DEF *+1+2 DWRD1 DEF WORD1 DEF MS LDA .HOUR STA PTR LDA DM4 STA CNT JMP TLOOR * TLOOP LDA .COLN PUSH A ":" OUT JSB MVBYT DEF D1 TLOOR LDA PTR,I JSB .ASC2 CONVERT TIME TO ASCII CCA ADA PTR STA PTR ISZ CNT JMP TLOOP * LDA .ZERO ADD "0" FOR LAST NUMBER JSB MVBYT TO MULTIPLY BY 10 FOR MS DEF D1 JMP CNVTM,I RETURN WITH ASCII VALUES IN ARRAY TIME SPC 2 IDWRD NOP ADB IDPNT XLA B,I JMP IDWRD,I SPC 2 * 'A'REG = BINARY VALUE * 'B'REG = 5 MINUS NUMBER OF DIGITS TO BE CONVERTED * 'E'REG = 0 FOR NO ZEROES, 1 FOR LEADING ZEROES * JSB ASCII * 'A'REG = LAST BYTE * 'B'REG = BYTE ADDRESS UPDATED * ASCII NOP STA VAL CLA ELA STA FILL LDA STKPT STA TO LDA B (A)=(B)=DIGIT COUNT CODE ADB DM4 STB CCNTR SZB,RSS IF ONLY ONE DIGIT JMP LSTDG GO TO LAST DIGIT CODE ADA .N10K ADJUST POWERS OF TEN TO STA QPNTR NUMBER OF DIGITS DESIRED LOOP LDA VAL CLB DIV QPNTR,I DIVIDE BY POWER OF TEN STB VAL SAVE REMAINDER (LOWER DIGITS) SZA JMP ASCNV CPA FILL LEADING ZEROES WANTED? JMP LZERO NO, BLANK OUT IF E#0 ORIGINALLY ASCNV IOR B60 NOT 0 OR LEADING 0 WANTED STA FILL SO INSURE NO 0 GETS LOST ASCST JSB STBYT ISZ QPNTR INCRE TO NEXT POWER OF TEN ISZ CCNTR BUMP DIGIT COUNTER JMP LOOP MORE THAN 1 DIGIT LEFT LSTDG LDA VAL cTRNNT IOR B60 DO LAST DIGIT EVEN IF ZERO JSB STBYT STB STKPT (B) IS STILL NEXT BYTE ADDR JMP ASCII,I * LZERO LDA B40 REPLACE LEADING ZEROES JMP ASCST WITH BLANKS SPC 2 .ASC1 NOP CONVERT 1 DIGIT TO ASCII CLE LDB D4 JSB ASCII JMP .ASC1,I SPC 2 .ASC2 NOP CONVERT BINARY TO ASCII CLE LDB D3 JSB ASCII JMP .ASC2,I SPC 2 .ASC3 NOP CONVERT 3 DIGITS, LEADING BLANKS CLE LDB D2 JSB ASCII JMP .ASC3,I SPC 2 ZASC3 NOP CONVERT 3 DIGITS, LEADING ZEROES CCE LDB D2 JSB ASCII JMP ZASC3,I SPC 2 .ASC4 NOP CONVERT 4 DIGITS, LEADING BLANKS CLB,CLE,INB JSB ASCII JMP .ASC4,I SPC 2 .ASC5 NOP CONVERT 5 DIGITS, LEADING BLANKS CLB,CLE JSB ASCII JMP .ASC5,I SPC 2 ZASC5 NOP CONVERT 5 DIGITS, LEADING ZEROES CLB,CCE JSB ASCII JMP ZASC5,I SPC 2 VAL NOP .N10K DEF N10K N10K DEC 10000,1000,100,10 D1 DEC 1 D10 EQU N10K+3 QPNTR NOP CCNTR NOP FILL NOP SAVEB EQU VAL B40 OCT 40 B60 OCT 60 SKP WHATP LDA .PHED LDB DM38 JSB PRINT PRINT HEADING FOR PARTITION STUFF JSB STARS '**********' * CLA,INA STA PTN# INIT PARTITION NUMBER XLA $MATA STA PTNAD INIT PARTITION ADDR XLA $MNP GET # OF PARTITIONS SZA,RSS JMP DONE IN CASE BOO-BOO MPY D7 ADA PTNAD CALCULATE ADDR OF STA LPTAD LAST PARTITION * NXPTN JSB SETPT LDA PTN# BEGIN PARTITION LINE JSB .ASC2 CONVERT # TO ASCII * XLA PTNAD,I GET LINK WORD SSA,RSS PARTITION DEFINED? JMP CKPTN YES, CHECK STUFF * IFZ * LDB D3 UNDEFINED BUT WAS JSB PTNWD THIS DUE TO A SZA,RSS PARITY ERROR ? JMP UNDEF NO * LDA .PERR GET THE PARITY ERROR JSB MVBYT MESSAGE & DEF D16 JMP DMPTN DUMP IT * XIF UNDEF LDA .UNDF NO, PRINT 'NOT DEFINED' JSB MVBYT DEF D14 JMP DMPTN DUMP LINE, PROCESS NEXT * CKPTN LDB D3 JSB PTNWD GET WORD 4 SSA,RSS IS IT MOTHER PTTN? JMP NTMOM NO * LDA .M FILL IN 'M' JMP DOMCS * NTMOM LDB D4 JSB PTNWD GET WORD 5 RAL SSA,RSS IS SUBPTTN IN CHAIN MODE? JMP NTCHN NO * LDA .C FILL IN 'C' JMP DOMCS * NTCHN LDB D6 JSB PTNWD GET WORD 7 STA B LDA .SPAC USE SPACE IF NOT SUBPTTN SZB LDA .S ELSE FILL IN 'S' DOMCS JSB MVBYT DO 'M' 'C' OR 'S' DEF D1 * CKRES LDB D4 JSB PTNWD CALC ADDR OF RES-SIZE CLE,ELA RAR KEEP ONLY 10 BITS AND B1777 (STATUS JUNK IN HIGH BITS) STA PTSIZ SAVE SIZE OF PART. LDA .SPAC OUTPUT SPACE IF NOT RESERVED SEZ ELSE LDA .R USE 'R ' IF RESERVED JSB MVBYT DEF D1 * LDA PTSIZ GET PART. SIZE (MAX=1024) INA ADD 1 FOR BASE PAGE JSB .ASC5 CONVERT TO ASCII + OUTPUT * LDA .SPAC JSB MVBYT 2 MORE SPACES DEF D2 * LDB D3 JSB PTNWD ADDR OF START PAGE # AND B1777 PAGE # IN LOW 10 BITS ONLY STA PAGE# JSB .ASC4 CONVERT + OUTPUT 4 DIGITS * LDA .DASH JSB MVBYT PUT "-" ON OUTPUT STACK DEF D1 * LDA PAGE# ADA PTSIZ CALCULATE LAST PAGE # JSB .ASC4 CONVERT + OUTPUT 4 DIGITS * LDB D5 JSB PTNWD CLE,ELA PUT RT-BG BIT INTO (E) LDA .BG 'BG " IF BACKGROUND SEZ ELSE LDA .R- T ' RT' IF REAL-TIME JSB MVBYT CLASS PARTITION DEF D7 * LDB D2 JSB PTNWD SZA,RSS EMPTY? JMP NOPRG YES, PRINT '' JSB MVNAM MOVE NAME TO OUTPUT * DMPTN JSB OUTPT DUMP OUTPUT STACK ISZ PTN# INCRE PARTITION # LDA PTNAD ADA D7 INCRE TO NEXT PARTITION ADDR STA PTNAD CPA LPTAD DONE YET? JMP DONE1 YES. PRINT TIME, EXIT JMP NXPTN NO. DO NEXT PARTITION * NOPRG LDA .NONE JSB MVBYT DEF D6 JMP DMPTN SPC 2 PTNWD NOP ADB PTNAD XLA B,I JMP PTNWD,I SPC 2 .PHED DEF *+1 OCT 0,0 ASC 17,PTN# SIZE PAGES BG/RT PRGRM * .UNDF DEF *+1 ASC 7, .PERR DEF *+1 ASC 8, * .R DEF *+1 ASC 1,RR * .S DEF *+1 ASC 1,SS * .C DEF *+1 ASC 1,CC * .M DEF *+1 ASC 1,MM * .DASH DEF *+1 ASC 1,- * .BG DEF *+1 ASC 4, BG * .NONE DEF *+1 ASC 3, .RT DEF *+1 ASC 4, RT * B1777 OCT 1777 DM38 DEC -38 PTSIZ EQU STATS PTNAD EQU EQTPT PTN# EQU IDCNT LPTAD EQU IDPNT PAGE# EQU #EQTS UNS END WHAT   92067-18008 1805 S C0122 ,LGTAT RTE-IV LOG TAT TABLE             H0101 $ASMB,Q * * DATE:780321 * NAME:LGTAT * SOURCE: 92067-18008 * RELOC: 92067-16008 * PGMR:RD * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM LGTAT,3,99 92067-16008 REV.1805 780321 SUP ENT LGTAT EXT $CVT3,$LIBR,$LIBX EXT EXEC,$IDEX A EQU 0 B EQU 1 LGTAT XLA B,I INPUT PARAMETERS ARE STORED AWAY CLE,SZA,RSS SCHED WITH PARAMETER? CLA,CCE,INA DEFAULT TO LU 1 IOR M200 SET "V" BIT IN CONTROL WORD STA LU OUTPUT DEVICE INB XLA B,I GET OPTION STA LU+1 INB XLA B,I GET SPECIAL LU PARAMETER SZA,RSS IN CASE OF PREV RUN LDA LU SEZ DEFAULT NEEDED STA LU YES LDA FWA FIRST WORD ADDRESS OF TAT STA TAT * LDA D2 SET LU # TO 2 STA LUDSK CLA STA TRKCT CLEAR COUNTERS STA CTR STA CNTR STA TRCTR STA ITRCT STA CTRCT LDA TLG TAT LENGTH STA TATLG LDA SLG NUMBER OF TRACKS ON SYSTEM DISC STA TATSD ADA TATLG ADD NUMBER OF TRACKS ON SYSTEM DISC * TO TRACK LENGTH TO GET NUMBER OF TRACKS ON AUX. DISC CMA,INA MAKE RESULT POSITVE STA TATAD NUMBER OF TRACKS ON AUX. DISC LDA LU+1 CHECK FOR DESIRED OPTION SZA,RSS IF IT IS NOT ONE, DON'T PRINT TABLE JMP HIGH HEADING JSB EXEC EXEC CALL TO WRITE OUT TABLE HEADING DEF *+5 DEF D2 DEF LU DEF TBLHD STORAGE OF TABLE HEADING DEF D23 JSB BAUD PRODUCE A BLANK LINE JSB EXEC EXEC CALL TO PRINT COLUMN #'S IN OUTPUT DEF *+5 DEF D2 DEF LU DEF TBL STORAGE CONTAINING COLUMN NUMBERS DEF D39 * * THE FOLLOWING CODE IS USED TO KEEP TRACK OF * THE NUMBER OF FREE TRACKS WHILE FINDING THE * THE LARGEST CONTIGUOUS BLOCK OF TRACKS * HIGH XLA TAT,I A REG HAS FWA OF TAT SZA IF TAT ENTRY =0 THEN INCREMENT BOTH CTRS JMP LABL TAT ENTRY IS NOT 0 CHECK COUNTER TO GET * LARGEST CONTIGUOUS BLOCK * ISZ ITRCT INCREMENT TOTAL AVAILABLE TRACK COUNTER ISZ CTRCT INCREMEMT CONTIGUOUS TRACK COUNTER JMP LBL1 GO ON WITH TRACK IDENTIFICATION * * SEE IF CURRENT MAX > OLD MAX # FREE TRACKS * LABL LDB CTRCT TRACK ENTRY MUST HAVE BEEN ZERO CMB,INB MAKE CONTIGUOUS TRACK CTR. NEGATIVE ADB TRCTR ADD TO TEMPORARY CONTIG. TRACK COUNTER SSB,RSS SKIP IF RESULT IS NEG. I.E. TEMPORARY * COUNT IS OF GREATER VALUE JMP LBL OLD TRACK COUNT IS OF GREATER VALUE * LDB CTRCT IN GOES NEW * REPLACE TEMP. TRACK COUNTER WITH STB TRCTR THE NEW CONTIGUOUS TRACK VALUE LBL CLB RESET CURRENT MAX CONTIG TRACK # STB CTRCT * * THIS CODE DETERMINES WHAT TO OUTPUT WHEN LGTAT * IS RUNNING AS A PROGRAM. THE CHOICES BEING THE * TRACK STATEMENTS OR STATEMENTS AND TABLE. * LBL1 LDB LU+1 SZB,RSS JMP THERE JUST CHECK FOR ALL FREE AND CONTIG, TRACKS JMP GOON IDENTIFY ALL TRACKS AND OUTPUT TABLE THERE ISZ TATLG CHECK TO SEE IF FINISHED WITH CHECK JMP ARND NO,CONTINUE WITH CHECKS JMP WRONG YES,PRINT OUT TRACK STATEMENTS ARND ISZ TAT INCREMENT TAT ADDRESS JMP HIGH GET ANOTHER TAT ENTRY * * "NO." DETERMINES HOW MANY WORDS ARE PASSED TO THE BUFFER. * I.E.$  THREE OR FOUR WORDS ARE STORED IN THE TABLE USED FOR * OUTPUT. THIS ALLOWS THE PASSING OF "SYSTEM" OR " SYSTEM " * TO THE OUTPUT TABLE KEEPING THE COLUMNS STRAIGHT AND THE * ENTRIES ALIGNED PROPERLY. * GOON LDB TRKCT CHECK FOR EVEN OR ODD SLA JMP ODD LDB ADFOR LOAD ADDRESS OF FOUR STB NO. JMP CONT ODD LDB ADTHR LOAD ADDRESS OF THREE STB NO. * * THIS CODE IDENTIFYS THE SYSTEM TRACKS IN THE * TAT. FURTHERMORE IT BREAKS THEM DOWN INTO THE * COMPONENTS OF LG, START OF THE LS AREA, LIBRARY, * ENTRY POINTS, MEMORY IMAGE PROGRAMS AND SWAPPED * PROGRAM TRACKS. * CONT CPA SYS CHECK TAT ENTRY FOR SYSTEM TRACKS JMP LG CHECK FOR LG TRACKS JMP FP NOT SYSTEM TRACKS, CHECK FOR FMP TRACKS LG LDA LGOTK GET DISC POINTER FOR LG AREA JSB FDISK CALL SUBROUTINE TO GET DISC INFORMATION LDA INPTR OBTAINED THE NUMBER OF TRACKS USED FOR AND M177 LG AREA ADA JTRAK ADD # OF TRACKS TO STARTING TRACK TO ADA SUB1 GET LAST TRACK OF LG AREA. * SUBTRACT ONE (TRACK COUNT STARTS AT ZERO) STA LGEND LAST TRACK OF LG AREA LDB LUD DETERMINE IF IT IS THE RIGHT LU CPB LUDSK JMP STR IT IS TH RIGHT LU JMP LS IT IS THE WRONG LU STR LDA JTRAK SEE IF TRACK ENTRY IS A LG TRACK CMA,INA THIS IS DONE BY CHECKING THE TRACK ADA TRKCT COUNTER AGAINST THE LOWER SSA AND HIGHER BOUNDS OF THE POSSIBLE JMP LS LG TRACKS----NOT AN LG TRACK LDA TRKCT CHECK TRACK COUNTER AGAINST CMA,INA THE HIGHER BOUND ADA LGEND SSA JMP LS NOT LG TRACK CHECK START OF LS AREA JMP PRTLG PRINT OUT LG TRACKS * * FIND THE START OF THE LS TRACKS * LS LDA SFCUN CHECK FOR START OF LS TRACKS JSB FDISK FIND TRACK ADDRESS AND LU # SZA IF TRACK ENTWRY IS 0 THEN UNDEFINED JMP RDJ LS TRACKS ARE NOT UNDEFINED LDA ADUND IN OUTPUT PRINT UNDEFINED FOR LDB ADLST START OF LS TRACKS. MVW D15 JMP LEN RDJ JSB HERE PASS TRACK ADDRESS TO CONVERSION * ROUTINE. PUT ASCII FORMAT IN STATEMENT * ALSO CONVERT LU ON WHICH THE TRACK ADDRESS * IS ON, THEN PLACE IN STATEMENT. INA LDB A,I STB LST+15 LOCATION OF LS STATEMENT INA LDB A,I STB LST+16 * * CONVERT NUMBERS FROM BINARY TO ASCII * JSB $LIBX DEF *+1 DEF *+1 LDA LUD JSB HERE INA LDB A,I STB LST+21 LOCATION OF LS STATEMENT INA LDB A,I STB LST+22 JSB $LIBX DEF *+1 DEF *+1 * * CHECK FOR ENTRY POINTS * LEN LDA DSCLB DISC ADDRESS OF LIBRARY ENTRY PTS. JSB FDISK PASS DISC PTR., TO FDISK STA ENTST GET STARTING TRACK LDB LUD CHECK FOR PROPER LU CPB LUDSK JMP HUH JMP FOO IT IS THE WRONG LU HUH LDA DSCLN CALCULATE LAST TRACK OF ENTRY POINTS ADA DSSUP ADD # OF SYS. TO USER ENTRY PTS. MPY D4 FIRST DETERMINE THE # OF SECTORS USED CLB BY MULT. BY 4 (4 WORDS PER ENTRY) DIV D64 THEN DIVIDING BY 64 (64 WORDS SECTOR) STA TEMP LDA DSCLB GET STARTING SECTOR AND M177 ADA SUB1 COMPENSATE FOR STARTING AT ZERO ADA TEMP ADD IN # OF SECTORS USED FOR STORAGE CLB DIV NSPTK DIVIDE BY # OF SECTORS/TRACK ADA ENTST ADD TO TRACK ADDRESS STA ENTND SUM IS LAST TRACK CONTAING ENTS. LDA ENTST CHECK AGAINST THE LOWER BOUND CMA,INA ADA TRKCT SSA JMP FOO LDA TRKCT CHECK THE HIGHER BOUND CMA,INA ADA ENTND SSA JMP FOO NOT ENTRY TRACKS JMP PRTEN &a IT IS ENTRY TRACK(S) * * CHECK FOR LIBRARY ROUTINES * FOO LDA LUDSK LIBRARY MUST BE ON SYSTEM DISC CPA D2 JMP TOP IT IS SYSTEM DISC JMP HARD IT'S NOT SYS. DISC, GO ON TOP LDA DSCUT DISC ADDRESS OF RTE LIBRARY JSB FDISK GET DISC INFORMATION CMA,INA CHECK TRACK BOUNDS ADA TRKCT SSA JMP HARD NOT LIBRARY TRACK LDA TRKCT CHECK FOR UPPER BOUND CMA,INA ADA ENTST LIBRY TRACKS START BEFORE ENTRY PTS. SSA JMP HARD NOT A LIBRARY TRACK JMP PRTLB PRINT OUT LIBRARY TRACKS HARD JSB PRGTR CHECK FOR MEM. IMAGE OR SWAPPED PROGRAM JMP PRTSY TRACKS ARE NONE OF THE ABOVE * DEFAULT IS SYSTEM TRACKS * CHECK FOR FMP TRACKS * FP CPA FMP JMP PRTFP JMP TO PRINT FMP * * CHECK FOR GLOBAL TRACKS CPA GLBL CHECK FOR GLOBAL TRACKS JMP PRGBL JUMP TO PRINT GLOBAL * * CHECK FOR PROGRAMS OWNING TRACKS * ON A SUCCESSFUL FIND OF PROGRAMS OWNING * A TRACK, THAT PROGRAM NAME IS OBTAINED * FROM THE ID SEGMENT MAP WHOSE ADDRESS * IS LOCATED IN THE TAT. * ALSO, THIS CODE IS USED TO GET NAMES * OF PROGRAMS THAT HAVE SWAPPED TRACKS * AND THAT ARE MEMORY IMAGE SOURCE PROGRAMS. * SZA,RSS IF TAT ENTRY IS 0, GO ON TO FREE TRACKS JMP FEE LDB B40 PLACE A BLANK IN TYPE STB TYPE ABOVE LDB TRKCT IF CTR IS ODD DO THE FOLLOWING CODE SLB,RSS THIS CODE PUTS A BLANK CHAR. JMP BELOW IN FRONT OF THE PROGRAM NAME. LDB ADNAM ADDRESS AS TO WHERE TO STORE THE PROG STB TEMPY NAME ADA D12 GET FIRST TWO CHARACTERS OF PROG NAME STA TEMP XLB A,I SHIFT UPPER BYTE TO LOWER BYTE POSITION BLF,BLF LDA B STA WORD AND M177 PUT A BLANK IN THE UPPER BYTE IOR B2000 STA TEMPY,I STORE BLANK AND FIRST CHAR, IN BUFFER ISzZ TEMP GET THIRD AND FOURTH CHAR. XLB TEMP,I BLF,BLF SHIFT UPPER BYTE TO LOWER BYTE POSITION STB WORD1 GET SECOND CHAR. IN UPPER BYTE POSITION LDA WORD AND B1774 STA WORD LDA B AND M177 GET 3RD CHAR. IN LOWER BYTE POSITION IOR WORD PUT 2ND AND 3RD CHAR. TOGETHER ISZ TEMPY STA TEMPY,I * LDA WORD1 GET 3RD AND 4TH CHAR. AND B1774 GET UPPER BYTE POSITION STA WORD1 ISZ TEMP XLB TEMP,I BLF,BLF GET 5TH CHAR. LDA B AND SHIFT TO LOWER BYTE POSITION AND M177 IOR WORD1 ISZ TEMPY STORE IN TEMPORARY IN LOCATION STA TEMPY,I * ISZ TEMPY PUT BLANKS IN LAST TWO CHARS. LDA B2000 POSITION IOR TYPE ALF,ALF STA TEMPY,I LDA ADNAM JMP BAD TRANSFER NAME TO OUTPUT BUFFER * BELOW LDB ADNAM THE FOLLOWING CODE DOES THE SAME STB TEMPY AS THE ABOVE BUT IT DOES NOT * PUT A BLANK IN FRONT OF THE PROG. NAME ADA D12 STORE PROGRAM NAME IN TEMPORARY HOLDING XLB A,I A REG HAS ADDRESS OF ID SEGMENT INDEX STB TEMPY,I IT BY 12 TO GET THE FIRST TWO CHAR. INA ISZ TEMPY XLB A,I STB TEMPY,I INA ISZ TEMPY XLB A,I LDA B AND B1774 AND IN A BLANK CHARACTER IOR TYPE STA TEMPY,I PRPRG LDA ADNAM LOAD ADDRESS OF PROGRAM NAME JMP BAD TRANSFER NAME TO OUTPUT BUFFER * FEE JMP PRTFR MUST BE A FREE TRACK * PRTSY LDA TRKCT GET READY TO PRINT SYSTEM SLA SKIP IF ODD JMP LAB LDA ADSYE LOAD A REG WITH ADD. OF SYSTEM(EVEN) JMP BAD LAB LDA ADSYO LOAD A REG WITH ADDRESS OF SYS(ODD) JMP BAD PRTFP LDA TRKCT GET READY TO PRINT FMP SLA JMP LB LDA ADFME FMP (EVEN) JMP BAD LB LDA ADFMO FMP (OEDD) JMP BAD PRGBL LDA TRKCT GET READY TO PRINT GLOBAL SLA JMP LBLA LDA ADGBE JMP BAD LBLA LDA ADGBO JMP BAD PRTLG LDA TRKCT GET READY TO PRINT LG TRACKS SLA JMP LEFT LDA ADLGE JMP BAD LEFT LDA ADLGO JMP BAD PRTFR LDA TRKCT GET READY TO PRINT -- TO INDICATE FREE SLA JMP LBA LDA ADAVE JMP BAD LBA LDA ADAVO JMP BAD PRTEN LDA TRKCT GET READY TO PRINT ENTS SLA JMP DO LDA ADENE JMP BAD DO LDA ADENO JMP BAD PRTLB LDA TRKCT GET READY TO PRINT LIBRY SLA JMP OH LDA ADLBE JMP BAD OH LDA ADLBO JMP BAD * * "CTR" INDEXES THE POINTER TO THE APPROPRIATE POSITION * IN THE OUTPUT BUFFER. POINTER IS INCREMENTED ALTERNATELY * BY THREE OR FOUR. * BAD LDB TRKCT LOAD TRACK CTR. SLB,RSS SKIP IF ODD JMP ME GO TO ODD LDB CTR MAKE COUNTER THREE ADB D3 STB CTR JMP BALL ME LDB CTR MAKE COUNTER FOUR ADB D4 STB CTR BALL LDB ADTAB LOAD ADDRESS OF TABLE AND ADB CTR INDEX IT BY COUNTER MVW NO.,I PUT ENTRY IN TABLE, A REG. HAS ADDR. LDA CTR SEE IF FINISHED WITH LINE CPA D35 BY COMPARING WITH 35 JMP DOWN YES, PRINT OUT TABLE (ONE LINE) LDB TRKCT COMPARE CTR. WITH LENTGH OF SYS DISC INB CPB TATSD JMP .DWN PRINT LAST TRACKS ON SYSTEM DISC JMP LOW CHECK FOR TABLE COMPLETION * * PRINT OUT TABLE WITH TRACK IDENTIFIERS * .DWN LDA CTR STA TEMP LDB TRKCT SLB,RSS JMP BE LDB TEMP ADB D4 STB TEMP JMP TALL BE LDB TEMP ADB D3 STB TEMP TALL LDA ABLK LDB ADTAB ADB TEMP MVW ONE DOWN LDA CNTR CNTR IS AN INDEX OF TEN USED IN THE OUTPUT JSB HERE JMP TO CONVERSION ROUTINE LDB A,I RETURN HERE FROM THE CONVERSION ROUTINE INA THREE WORDS OF TABLE LDB A,I STB TABLE INA LDB A,I STB TABLE+1 JSB $LIBX END PRIVILEGE STATUS DEF *+1 DEF *+1 * * PRINT OUT TABLE WITH TRACK IDENTIFIERS * JSB EXEC EXEC CALL TO WRITE OUT TABLE DEF *+5 DEF D2 DEF LU DEF TABLE BUFFER FOR TABLE OUTPUT DEF D39 LENGTH OF OUTPUT * * BLANK OUT TABLE * LDA ADBLK LOAD ADDRESS OF BLANKS INTO A REG LDB ADTAB MVW D39 CLA CLEAR COUNTER STA CTR LDA CNTR ADA D10 STA CNTR LOW ISZ TATLG INCREMENT TATLG (NEGATIVE #) JMP TWO JMP KAYO * TWO LDB LUDSK DETERMINE SUBCHANNEL CPB D3 JMP .AUX NO NEED TO CHECK COMPLETION OF SYS DISC LDB TRKCT INCREMENT TRACK COUNTER INB CHECK FOR COMPLETION OF CPB TATSD SYSTEM DISC JMP SOON PRINT OUT AUX DISC HEADING .AUX ISZ TRKCT INCREMENT TABLE COUNTER ISZ TAT INCREMENT I.E. DECREMENT TABLE LENGTH JMP HIGH * * PRINT OUT AUX DISC HEADING * SOON JSB BAUD PRODUCE A BLANK LINE JSB BAUD JSB EXEC EXEC CALL TO WRITE OUT AUX DISC HEADING DEF *+5 DEF D2 DEF LU DEF AUXDS DEF D7 JSB BAUD LDA D3 SET LU # TO THREE. STA LUDSK LDA TATAD STA TATSD REPLACE SYS. COUNT WITH AUX. COUNT CLA STA TRKCT RESTART COUNTER FOR TABLE ENTRIES. STA CNTR RESTART INDEX COUNTER STA CTRCT RESET TEMP CONTIGUOUS TRACK COUNTER ISZ TAT INCREMENT TAT POINTER JMP HIGH CHECK ANOTHER ENTRY * * PRINT OUT WITH TABLE THE START OF THE LS TRACKS * KAYO JSB EXEC LAST LINE MAY BE PARTIALLY FILLED DEF *+5 DEF D2 DEF LU DEF TABLE u DEF D39 JSB BAUD PRODUCE A BLANK LINE JSB EXEC PRINT TRACK STATEMENT DEF *+5 DEF D2 DEF LU DEF LST DEF D24 * * THE FOLLOWING PREPARES AND OUTPUTS THE TRACK * STATEMENTS BY CONVERSION FROM BINARY TO ASCII * THROUGH THE "HERE" SUBROUTINE * WRONG LDA ITRCT COUNT OF TOTAL FREE TRACKS JSB HERE JUMP TO BINARY TO ASCII SUBROUTINE. LDB A,I STB PRTAT+12 INA LDB A,I STB PRTAT+13 INA LDB A,I STB PRTAT+14 JSB $LIBX COMPLETE EXEC CALL TO SYSTEM DEF *+1 DEF *+1 * JSB EXEC EXEC CALL TO PRINT TRACK STATEMENT DEF *+5 DEF D2 DEF LU DEF PRTAT BUFFER LOCATION DEF D15 * LDA TRCTR CONTIGUOUS TRACK COUNTER JSB HERE LDB A,I STB CTAT+16 STORE CONTIGUOUS TRACK COUNT IN LAST 3 INA WORDS OF CONTIGUOUS TRACK STAEMENT LDB A,I STB CTAT+17 INA LDB A,I STB CTAT+18 JSB $LIBX COMPLETE EXEC CALL TO SYSTEM DEF *+1 DEF *+1 * JSB EXEC DEF *+5 DEF D2 DEF LU DEF CTAT DEF D19 * JMP NOW * * FINDS THE SYSTEM OR AUXILIARY DISC WHERE THE * DISC POINTER (IN PACKED FORMAT) POINTS TO, * AS WELL AS THE TRACK. IF THE DISC POINTER IS * LESS THAN 0 THEN THE LU IS 3. ON RETURN * NSPTK =# SECTORS PER TRACK ON THE DISC * LUD = LOGICAL UNIT (DISC LU 2 OR 3) * JTRAK =TRACK ADDRESS * FDISK NOP STA INPTR STORE DISC POINTER AWAY LDB D2 STB LUD SSA,RSS IF THE DISC POINTER IS <0 THEN LU=3 JMP TOO LDB D3 STB LUD TOO ADB M1755 GET NUMBER OF SECTORS PER TRACK LDA B,I STA NSPTK * *FIND THE STARTING TRACK ADDRESS * LDA INPTR AND B776C GET BITS 14 - 7 OF DISC POINTER CLB I.E. THE TRACK ADDRESS DIV D128. STA JTRAK JMP FDISK,I * * THIS SUBROUTINE DETERMINES IF THE TRACK ENTRY INDICATED BY * SYSTEM IN THE TAT, IS THE SWAPPED PROGRAM TRACK OR THE TRACK CONTAINING * MEMORY IMAGE VERSION OF A PROGRAM. THIS IDENTIFICATION IS * ACCOMPLISHED THROUGH THE SEARCH OF THE KEYWORD TABLE. * WHEN THE TAT POINTER IS EQUAL TO THE TRACK POINTER FOUND * IN A PROGRAM'S ID SEGMENT MAP, A TRACK IS IDENTIFIED. * PRGTR NOP LDA FWAK FWA OF KEYWORD BLOCK STA KEYWD TEN XLA KEYWD,I GET FWA OF KEYWORD TABLE SZA,RSS IF KEYWORD ENTRY IS 0 THEN FINISHED JMP PRGTR,I WITH CHECK,RETURN FROM SUBROUTINE ADA D14 GET NAME PORTION CONTAINING THE TYPE AND STA IDADR SHORT SEGMENT (SS) BIT XLA IDADR,I STA NAM3 CLB STB SHTID 0 IN SHTID INDICATES LONG ID SEGMENT AND M20 CHECK THE SS BIT (BIT 4) TO SEE IF IT SZA,RSS IS A LONG ID OR SHORT ID SEGMENT JMP LNGID IT IS A LONG ID SEGMENT LDB SUB1 ID SEGMENT IS OF SHORT FORM STB SHTID INDICATE IT BY -1 IN SHTID LNGID LDA NAM3 MAKE SURE IT'S A DISC RESIDENT PROGRAM AND M22 OR SHORT ID FOR SEGMENTS SZA JMP FROG LDA NAM3 CHECK FOR TYPE FOUR PROGRAMS AND M4 SZA,RSS JMP KEY FROG LDA M46 OCTAL 46 =& STA TYPE SET FLAG FOR MEMORY IMAGE PROG. TRACKS SSB,RSS PICK UP MEMORY ADDRESSES JMP FIVE ISZ IDADR CALCULATE # OF SECTORS USED FOR STORAGE XLA IDADR,I OBTAIN LOW AND HIGH MAIN ADDRESSES STA LWMAN ALSO, LOW AND HIGH BASE PAGE WORDS ISZ IDADR XLA IDADR,I AND THE DISC ADDRESS OF A PROGRAM STA MNHGH IN A SHORT ID SEGMENT ISZ IDADR XLA IDADR,I STA LOWBP ISZ IDADR XLA IDADR,I STA HGHBP ISZ IDADR XLA IDADR,I STA KTRAK JMP SIX * * LONG ID SEGMENT * FIVE LDA IDADR ÚGET MEMORY ADDRESSES OF THE PROG. ADA D8 FROM THE LONG ID SEG. STA IDADR ALSO GET THE DISC ADDRESS OF XLA IDADR,I THE PROGRAM STA LWMAN ISZ IDADR XLA IDADR,I STA MNHGH ISZ IDADR XLA IDADR,I STA LOWBP ISZ IDADR XLA IDADR,I STA HGHBP ISZ IDADR XLA IDADR,I STA KTRAK * * CALCULATE THE NUMBER OF SECTORS REQUIRED FOR * PROGRAM STORAGE. * SIX SZA,RSS IF DISC PTR. =0 THEN GET JMP KEY ANOTHER KEYWORD ENTRY LDA LWMAN CMA,INA MAKE NEGATIVE ADA MNHGH ADA D127 CLB DIV D128 CLE,ELA MULTIPLY BY TWO STA TEMP LDA LOWBP CMA,INA ADA HGHBP ADA D127 CLB DIV D128 CLE,ELA ADA TEMP STA NSCTS * * CHECK FOR PROGRAMS OWNING TRACKS * LDA KTRAK DISC PTR. PASSED AS PARAMETER JSB FDISK TO FDISK LDB LUD DETERMINES IF ON CORRECT LU CPB LUDSK JMP ONCE IT IS THE CORRECT LU JMP ING IT IS THE WRONG LU. ONCE CLB CALCULATE THE LAST TRACK LDA NSCTS ADA NSPTK TO ROUND UP RESULT ADA SUB1 DIV NSPTK ADA JTRAK SUM IS THE LAST TRACK STA LSTRK LDB TRKCT SEE IF LAST TRACK OF PROGRAM SOURCE CMB,INB IS GREATER THEN COUNTER OF TAT ADB LSTRK SSB JMP ING * * IF LSTRK >= TRKCT THEN GO CHECK * THE OTHER BOUND * LDB JTRAK CMB,INB ADB TRKCT SSB SKIP IF TRKCT IS LESS THAN START OF * SOURCE TRACKS JMP ING CHECK FOR SWAPPED TRACKS JMP IN SUCCESS IN FINDING SOURC TRACKS ING LDA SHTID CHECK FOR SHORT ID SEGMENT SZA IF SHORT SEG, SWAP TRACK CAN'T JMP KEY APPEAR. GET ANOTHER SEGMENT ISZ IDADR  XLA IDADR,I STA KTRAK SZA,RSS IF WORD ID 0 THEN NO SWAP TRACKS JMP KEY JSB FDISK CLB STORAGE FOR # OF EMA TRACKS ISZ IDADR POINTER TO ID EXT XLA IDADR,I ID AND EMA SIZE-WORD 28 OF ID SEG. SZA,RSS IF IT'S ZERO,DON'T WORRY ABOUT EMA TRACKS JMP NOEMA AND B176C GET ID EXT OFFSET OUT OF UPPER 6 BITS ALF,RAL RAL PUT UPPER 6 BITS IN LOWER POSITION ADA $IDEX ADDRESS OF ID EXTENSION TABLE ADA SUB1 ADD IN OFFSET-ADDRESS OF ID EXT LDA A GET ADDRESS OF ID EXT. * ADA TWO COMPENSATE FOR STARTING AT ZERO * AND POINT TO WORD 2 OF ID EXT. LDA A GET # OF TRACKS FOR EMA SWAP AND M1777 LOWER 9 BITS CONTAIN INFO. STA B NOEMA LDA KTRAK COMPUTE LAST POSSIBLE SWAP TRACKS AND M177 ADA JTRAK ADA SUB1 ADA B ADD IN # OF EMA SWAP TRACKS. STA LSTRK LDB LUD CHECK FOR CORRECT LOGICAL UNIT CPB LUDSK JMP ZERO JMP KEY ZERO LDB M136 INDENTIFIER FOR SWAP TRACKS STB TYPE LDA TRKCT CMA,INA A REG CONTAINS LSTRK * * CHECK FOR UPPER BOUNDS OF POSSIBLE SWAPPED TRACKS * ADA LSTRK SSA POINTER FOR SUCCESS JMP KEY NO SUCCESS TRY TO GET ANOTHER ID SEGMENT LDB JTRAK CHECK TO SEE IF TRACK ENTRY COUNTER IS CMB,INB EQUAL TO OR GREATER THAN TRACK # ADB TRKCT OF SWAPPED TRACKS SSB JMP KEY * IN XLA KEYWD,I GET POINTER OF ID SEGMENT JMP ABOVE GET PROGRAM NAME FROM ID SEG. * NOTE: TYPE SYMBOL IS APPENDED TO PROG. NAME * KEY ISZ KEYWD GET ANOTHER KEYWORD ENTRY JMP TEN * SUBROUTINE THAT CONVERTS FROM BINARY TO ASCII. * HERE NOP JSB $LIBR NOP CCE JSB $CVT3 JMP HERE,I * * WILL PRINT OUT ONE BLANK= LINE WHEN CALLED * BAUD NOP JSB EXEC DEF *+5 DEF D2 DEF LU DEF BLNK DEF ONE JMP BAUD,I * * EXEC CALL TO TERMINATE PROGRAM * NOW JSB EXEC DEF *+7 DEF CODE DEF ZORO DEF SUB1 SERIAL REUSABLE DEF ZORO DEF LU+1 SAVE OPTION DEF LU * * ZORO DEC 0 INUMB DEC -1 SERIAL REUSEABLE BLNK ASC 1, USED TO PRODUCE A BLANK LINE ABLK DEF BLNK LU BSS 2 STORAGE FOR PARAMETERS TAT BSS 1 ADDRESS OF TRACK ASSIGN. TABLE TATLG BSS 1 LENGTH OF TAT (NEG. #) TATSD BSS 1 LENGTH OF SYSTEM DISC TATAD BSS 1 LENGTH OF AUX. DISC CNTR BSS 1 INDEX USED IN OUTPUT. CODE DEC 6 FWA EQU 1656B FWA OF TRACK ASSIGN. TABLE TLG EQU 1755B TABLE LENGTH SLG EQU 1756B SYSTEM DISC LENGTH TRCTR BSS 1 CONTIGUOUS TRACK COUNTER CTRCT BSS 1 TEMPORARY CONTIGUOUS TRACK COUNTER ITRCT BSS 1 FREE TRACK COUNTER PRTAT ASC 15,TOTAL AVAILABLE TRACKS = CTAT ASC 19,LARGEST CONTIGUOUS TRACK BLOCK = D10 DEC 10 D2 DEC 2 D3 DEC 3 D15 DEC 15 D19 DEC 19 D22 DEC 22 D24 DEC 24 D23 DEC 23 D35 DEC 35 D36 DEC 36 D39 DEC 39 NO. BSS 1 NUMBER OF WORDS MOVED INTO BUFFER TRKCT BSS 1 TAT ENTRY COUNTER AUXDS ASC 7,AUXILIARY DISC D7 DEC 7 TABLE ASC 20, ASC 19, TBL ASC 17,TRACK 0 1 2 3 ASC 22, 4 5 6 7 8 9 TBLHD ASC 23,TRACK ASSIGNMENT TABLE & =PROG ^ =SWAP ADTAB DEF TABLE CTR BSS 1 POINTER IN BUFFER SYS OCT 100000 REPRESENTATION OF SYS IN TAT FMP OCT 077776 REPRESENTATION OF FMP IN TAT FREE OCT 0 " " OF FREE IN TAT M200 OCT 200 AVALE ASC 3, -- AVALO ASC 4, -- SYSE ASC 3,SYSTEM SYSO ASC 4, SYSTEM FMGRO ASC 4, FMP FMGRE ASC 3, FMP D4 DEC 4 ADFOR DEF D4 ADTHR DEF D3 ADSYE DEF SYSE ADSYO DEF SYSO ADFME DEF FMGRE +zADFMO DEF FMGRO ADAVE DEF AVALE ADAVO DEF AVALO ADBLK DEF BLNKS BLNKS ASC 20, ASC 19, ONE DEC 1 GLBL OCT 077777 REPRESENTATION OF GLOBAL IN TAT GBE ASC 3,GLOBAL GBO ASC 4, GLOBAL ADGBE DEF GBE ADGBO DEF GBO SUB1 DEC -1 LGOTK EQU 1765B DISC POINTER TO LG TRACKS M177 OCT 177 M1777 OCT 1777 LGE ASC 3, LG LGO ASC 4, LG ADLGE DEF LGE ADLGO DEF LGO INPTR BSS 1 DISC POINTER JTRAK BSS 1 STARTING TRACK ADDRESS LGEND BSS 1 LAST TRACK OF LG AREA LUD BSS 1 LOGICAL UNIT CONTAINED IN DISC PTR LUDSK BSS 1 CURRENT LOGICAL UNIT NSPTK BSS 1 NUMBER OF SECTORS PER TRACK ENTST BSS 1 STARTING TRACK OF ENTRY PTS. ENTND BSS 1 LAST TRACK OF ENTRY PTS. D64 DEC 64 TEMP BSS 1 TEMPORARY STORAGE ENTE ASC 3, ENTS ENTO ASC 4, ENTS ADENE DEF ENTE ADENO DEF ENTO DSCLB EQU 1761B DISC ADDRESS OF LIB. ENTRY PTS. LIBE ASC 3,LIBRY LIBO ASC 4, LIBRY ADLBE DEF LIBE ADLBO DEF LIBO DSCUT EQU 1763B DISC ADDRESS OF RTE LIB PTS. DSCLN EQU 1762B # OF USER LIB. ENTRY PTS. DSSUP EQU 1764B # OF SYS. LIB. ENTRY PTS. B776C OCT 77600 B176C OCT 17600 SUB10 DEC -10 SFCUN EQU 1767B LS TRACK POINTER NAME ASC 4, ADNAM DEF NAME TEMPY BSS 1 TEMPORARY STORAGE LST ASC 24,THE LS TRACK(S) START AT TRACK OF LU UNDEF ASC 15,ARE UNDEFINED ADLST DEF LST+8 ADUND DEF UNDEF M1755 OCT 1755 B40 OCT 40 B1774 OCT 177400 D12 DEC 12 D14 DEC 14 D8 DEC 8 KEYWD BSS 1 ADDRESS OF KEYWORD BLOCK FWAK EQU 1657B FWA OF KEYWORD TABLE IDADR BSS 1 ID SEGMENT ADDRESS NAM3 BSS 1 LOWER PORTION OF ID SEGMENT NAME SHTID BSS 1 INDICATES LONG OR SHRT ID SEG. M20 OCT 20 M136 OCT 136 M26 OCT 26 M46 OCT 46 TYPE BSS 1 BLANK, &, OR ^ LWMAN BSS 1 LOWMAIN ADDRESS MNHGH BSS 1 HIGH MAIN ADDRESS LOWBP BSS 1 LOW BASE PAGE ADDRESS HGHBP BSS 1 HIGH BASE PAGE ADDRESS KTRAZXTK BSS 1 DISC PTR. OR SWAPPED DISC ADDRESS NSCTS BSS 1 NUMBER OF SECTORS USED ON THE DISC M22 OCT 22 D127 DEC 127 D128 DEC 128 M4 OCT 4 LSTRK BSS 1 LAST TRACK WORD BSS 1 WORD1 BSS 1 B2004 OCT 20040 B2000 OCT 20000 END LGTAT XZ  92067-18009 1805 S C2822 &4GN01 RTE-IV GENERATOR              H0128 ΂ASMB,R,L,C,N HED RT4GN ---- MAIN FOR ON-LINE GENERATOR NAM RT4GN,3,90 92067-16009 REV.1805 780320 SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 2 SPC 1 ************************************************************ * * NAME: RT4GN * SOURCE PART #: 92067-18009 * REL PART #: 92067-16009 * WRITTEN BY: KFH, JH, RB, GAA * ************************************************************* SPC 2 * * * DEFINE ENTRY POINTS. * * OPERATOR INPUT SUBROUTINES: * ENT \PRMT PRINT COMMAND AND ACCEPT INPUT. ENT \READ \READ INPUT. ENT \RNME SPECIAL ENTRY TO READ SUBR. ENT \YENO ANALYZE YES/NO RESPONSE. ENT \DCON ANALYZE INPUT FOR OCTAL VALUE. ENT \GETC SUPPLY CHAR FOR GETNA & GETOC. ENT \GETN MOVE LBUF TO TBUF. ENT \GET# LBUF CHAR FROM ASCII TO OCTAL. ENT \GINT INITIALIZE LBUF SCAN. * * DIAGNOSTIC SUBROUTINES: * ENT \GNER PRINT DIAGNOSTIC. ENT \INER CALL ERROR AND CONTINUE. ENT \IRER CALL ERROR AND ABORT. ENT \ABOR \ABOR THE GENERATION. * * DISC FILE I/O SUBROUTINES: * ENT \CRET CREATE A FILE. ENT \CLOS CLOSE A FILE. ENT \TRUN CLOSE RTGEN OUTPUT FILE. ENT \CFIL CHECK FOR FILE ERRORS. ENT \MESS WRITE ON INTERACTIVE DEVICE. ENT \SPAC OUTPUT BLANK LINE. ENT \RNAM FIND A NAM RECORD IN A FILE. ENT \RBIN READ RELOCATABLE FILE. ENT \TERM PURGE ALL FILES ON ABORT. ENT \EXIT FINAL FILE CLEANPUP * * CORE-IMAGE OUTPUT FILE SUBROUTINES. * ENT \DSKA INCR. DISC ADDRESS. ENT \DSKI INPUT CONTROL. ENT \DSKO OUTPUT CONTROL. ENT \DSKD I/O SUBROUTINE. * * DCB'S: * ENT \RDCB RELOCATABLE FILE DCB. ENT \NDCB NEW-NAM FILE DCB. ENT \BDCB BOOT DCB * * LST, IDENT, FIX-UP SUBS AND POINTERS. * ENT \ILST,\LSTS,\LSTX,\LSTE ENT \TLST,\PLST ENT \LST1,\LST2,\LST3,\LST4,\LST5 * ENT \INID,\IDXS,\IDX ENT \TIDN,\PIDN ENT \ID1,\ID2,\ID3,\ID4,\ID5,\ID6,\ID7,\ID8,\ID9,\ID10,\ID11 ENT \ID12,\ID13,\ID14,\ID15,\ID16 * ENT \IFIX,\FIX,\PFIX,\TFIX ENT \FIX1,\FIX2,\FIX3,\FIX4 * ENT \LNKX,\LNK,\LNKS ENT \LNK1,\LNK2,\LNK3 * * LINKAGES FOR SEGMENT SUBR CALLS TO ANOTHER SEGMENT. * ENT \LODN LOADS A PROGRAM ENT \DPLD LOADS A DRIVER EXT \NLOD (RT4G4) * ENT \GNIO BUILDS I-O TABLES EXT \IOTB (RT4G5) * EXT \GENS BUILDS THE SYSTEM (RT4G3) * EXT \TB31 BUILDS $TB31 (RT4G1) EXT \TB32 BUILDS $TB32 (RT4G7) * ENT \FSEC CLEAN-UP BOOT EXTENSION AND HEADER RECORDS EXT \FSC0 (RT4G1) EXT \FSC5 (RT4G7) * ENT \SYTB BUILDS SYSTEM TABLES EXT \TBLS (RT4G5) * ENT \CLDP LOADS DRIVER PARTITIONS ENT \DDON EXT \\LDP (RT4G8) * ENT \PART PARTITION DEFINITION EXT \PDEF (RT4G6) * * POINTERS FOR CURRENT PAGE LINKAGE IMAGE AREA. * ENT \TBLK,\CPLM ENT \LRBP,\URBP,\IRBP ENT \CUBP,\UCBP,\ICBP,\CBPA * * MISCELLANEOUS SUBROUTINES: * ENT \CONV ENT \ABDO,\USER,\USRS,\SEGS,\SYS,\DSYS * * MISCELLANEOUS VARIABLES: * ENT \NAMN,\NAMB,\NAMO ENT \TRCM,\IACM,\TRCH ENT \SRET ENT \FMRR ENT \DPR2 ENT \BPAR ENT \OCTN ENT \BUFL ENT \TCHR ENT \ADSK,\PREL,\NUMP ENT \ADBF ENT \MRT2 ENT \PTYP ENT \TMSK ENT \RNT,\PRV ENT \TBCH,\PIOC,\SWPF ENT \LBUF,\TBUF ENT \CURL,\CPL2 ENT \CMFL ENT \ABCO,\MXAB ENT \OLDA ENT \ADBP,\NABP ENT \OBUF ENT \TIME,\TIM1,\MULR ENT \CPLB,\ASKY,\SSID,\SKYA * SKP * * DEFINE EXTERNALS * EXT \PIP,LURQ,RMPAR,IFBRK EXT WRITF,EXEC,CLOSE EXT LOCF,APOSN EXT CREAT,OPEN,READF,CNUMD EXT .ENTR EXT COR.A,\DST0,\BOT0 EXT GETST EXT \DST5,\BOT5 * SPC 2 * * DEFINE A AND B REG * A EQU 0 B EQU 1 SUP SPC 3 LST#T DEC 2 # LST TRACKS. IDT#T DEC 3 # IDENT TRACKS. FIX#T DEC 1 # FIX-UP TRACKS. SECWD DEC 128 # WORDS PER SECTOR. SKP * IDENT FORMAT * * WORD 1: \ID1 - NAME 1,2 * WORD 2: \ID2 - NAME 3,4 * WORD 3: \ID3 - (15-8) NAME 5 * (7-3) NOT USED * (2-0) USAGE FLAG * (2) MODULE WAS LOADED * (1) MUST LOAD MODULE (EXT DEFINED BY IT) * (0) MODULE WAS LOADED AS PART OF A SEGMENT * WORD 4: \ID4 - (15) MAIN PROGRAM * (14-0) COMMON LENGTH * WORD 5: \ID5 - (15) BASE/CURRENT PAGE LINKING FLAG * (14) NEW NAM RECORD FLAG * (13-4) EMA SIZE * (3-0) MAP OPTIONS * (2) LINKS * (1) MODULES * (0) GLOBALS * WORD 6: \ID6 - (15) EMA DECLARED * (14-10) MSEG SIZE * (9-7) NOT USED * (6-0) PROGRAM TYPE * (4) SSGA DECLARED * (3) REVERSE COMMON DECLARED * WORD 7: \ID7 - LOWEST DBL ADDRESS * WORD 8: \ID8 - DISK LENGTH FOR UTILITY REtLOCATABLES * OR MAIN IDENT INDEX FOR SEGMENTS * OR (15-8) PROGRAM PAGE REQMTS * (7-0) KEYWORD INDEX * OR (15) EQT DEFINED * (14) SDA DECLARED * (13) SDA/OWN MAPPING DECLARED * (13-0) DRIVER LENGTH * WORD 9: \ID9 - FILE NAME 1,2 * WORD 10: \ID10 - FILE NAME 3,4 * WORD 11: \ID11 - FILE NAME 5,6 * WORD 12: \ID12 - SECURITY CODE * WORD 13: \ID13 - CARTRIDGE LABEL * WORD 14: \ID14 - RECORD NUMBER * WORD 15: \ID15 - RELATIVE BLOCK * WORD 16: \ID16 - BLOCK OFFSET * SKP * * LST FORMAT * * WORD 1: \LST1 - NAME 1,2 * WORD 2: \LST2 - NAME 3,4 * WORD 3: \LST3 - NAME 5, ORDINAL * WORD 4: \LST4 - IDENT INDEX OR 2 IF COMMON * 3 IF ABSOLUTE * 4 IF REPLACE * 5 IF UNDEFINED * 6 IF EMA * WORD 5: \LST5 - SYMBOL VALUE, OR IDENT INDEX IF EMA * * * * FIXUP TABLE FORMAT * * \FIX1: CORE ADDRESS * \FIX2: (15-11) INSTRUCTION CODE * (10) BYTE INSTR * (9) UPPER BP LINK * (2-0) DBL RECORD TYPE * \FIX3: OFFSET * \FIX4: INDEX OF LST ENTRY REFERENCED, * OR 0 IF A LOCAL SYMBOL * OR -1 IF .ZRNT * * * * * PROGRAM TYPES * * 0: SYSTEM * 1: MEMORY RESIDENT * 2: RT DISK RESIDENT * 3: BG DISK RESIDENT * 4: ENLARGED BG DISK RESIDENT * 5: BG SEGMENT * 6: LIBRARY/UTILITY * 7: UTILITY * 8: UTILITY LOAD ONLY TO SATISFY EXTERNAL REFERENCES. * 9: MEMORY RESIDENT USING BACKGROUND COMMON. * 10: RT DISC RESIDENT USING BACKGROUND COMMON. * 11: BG DISC RESIDENT USING FORGROUND COMMON. * 12: ENLARGED BG DISC RESIDENT USING REALTIME COMMON * 13: TABLE AREA II * 14: TYPE 6 LIBRARY/UTILITY THAT IS TO BE FOURCE LOADED TO THE LIBRARY. * 15: TABLE AREA I * 30: SUBSYSTEM GLOBAL MODULE * 17,18,19,20,25,26,27,28: TYPES 1,2{,3,4,9,10,11,12 (RESP) W/SSGA ACCESS * 21-24,29,31-99:UNUSED (TYPE + 80 IS USED TO * DESIGNATE AUTO SCHEDULE AT STARTUP, BUT MAY * ONLY BE ENTERED IN PARM PHASE. +80 IS JUST * A FLAG TO PARM PHASE, NOT STORED IN ID-SEG.) SKP * * ERROR CODES * * 0/ HARDWARE/GENERATOR ERROR (SEND IN BUG REPORT) * 1: INVALID REPLY TO INITIALIZATION PARAMETERS * 2: INSUFFICIENT AMOUNT OF AVAILABLE MEMORY FOR TABLES * 3: RECORD OUT OF SEQUENCE * 4: INVALID RECORD TYPE * 5: DUPLICATE ENTRY POINTS * 6: COMMAND ERROR - PROGRAM INPUT PHASE * 7: LST,IDENT,FIXUP TABLE OVERFLOW * 8: DUPLICATE PROGRAM NAMES * 9: PARAMETER NAME ERROR * * 10: PARAMETER TYPE ERROR * 11: PARAMETER PRIORITY ERROR * 12: PARAMETER EXECUTION INTERVAL ERROR * 13: BG SEGMENT PRECEDES BG DISC RESIDENT * 14: CHECKSUM ERROR * 15: ILLEGAL CALL BY A TYPE 6 OR 14 PROGRAM TO A TYPE 7 * 16: BP LINKAGE AREA OVERFLOW * 17: TYPE 1 OUTPUT FILE OVERFLOW (ESTIMATE WAS NOT LARGE ENOUGH) * 18: MEMORY OVERFLOW * 19: TR STACK UNDERFLOW/OVERFLOW * * 20: INVALID COMMAND INPUT LU * 21: '$CIC' NOT FOUND IN LOADER SYMBOL TABLE * 22: LIST FILE ERROR * 23: INVALID S OR M OPERANDS * 24: INVALID SELECT CODE IN EQT ENTRY * 25: INVALID DRIVER NAME IN EQT ENTRY * 26: INVALID D,B,U,T,X,S,M OPERANDS IN EQT ENTRY * 27: INVALID DEVICE REFERENCE NO. * 28: INVALID INTERRUPT SELECT CODE * 29: INVALID INTERRUPT SELECT CODE ORDER * * 30: INVALID INT ENTRY MNEMONIC * 31: INVALID EQT NO. IN INT ENTRY * 32: INVALID PROGRAM NAME IN INT ENTRY * 33: INVALID ENTRY POINT IN INT ENTRY * 34: INVALID ABSOLUTE VALUE IN INT ENTRY * 35: MORE THAN 63 EQT OR 255 DRT ENTRIES DEFINED * 36: INVALID TERMINATING OPERAND IN INT ENTRY * 37: INVALID COMMON LENGTH IN SYS, LIB, OR SSGA MODULE..... * 38: ID-SEGMENT OF SEGMENT 3 NOT FOUND * 39: NOT USED * * 40: INVALID EMA PROGRAM TYPE * 41: MULTIPLE EMA DECLARATIONS * 42: INVALID REFERENCE TO EMA SYMBOL ַ* 43: INVALID MSEG SIZE * 44: SAM EXCEEDS 32K LOGICAL ADDRESS SPACE * 45: INVALID PARTITION SIZE * 46: INVALID PARTITION TYPE * 47: INVALID PARTITION RESERVATION * 48: INVALID OR UNKNOWN ASSIGNED PROGRAM NAME * 49: INVALID PARTITION NUMBER * * 50: PROGRAM TOO LARGE FOR PARTITION SPECIFIED * 51: INVALID PAGE OVERRIDE SIZE * 52: ILLEGAL REFERENCE TO SSGA ENTRY POINT * 53: SUM OF PARTITION SIZES DOESN'T EQUAL # PAGES LEFT * 54: SUBROUTINE OR SEGMENT DECLARED MORE COMMON THAN MAIN * 55: PAGE REQ'MTS OF EMA PROGRAM CAN'T BE OVERRIDDEN * 56: SUBPARTITION SIZE OR SUM OF SIZES > THAN MOTHER PART'N SIZE * 57: MISSING SYSTEM ENTRY POINT * 58: ILLEGAL REF TO TYPE 0 SYSTEM ENTRY POINT BY NON-TYPE 3 MODULE * 59: DRIVER PARTITION OVERFLOW * * 60: LONG ID SEGMENT LIMIT OF 254 EXCEEDED * 61: PHYSICAL MEMORY OVERFLOW * 62: INVALID INSTRUCTION REFERENCE TO AN EMA SYMBOL SKP DBP EQU * FWA DUMMY BASE PAGE. * ************************************************ * * * THE NEXT 1K IS OVERLAID FOR DUMMY BASE PAGE * * WHEN RT4G3 BEGINS EXECUTION. * * * ************************************************ SPC 5 START NOP STB PARS5 JSB RMPAR DEF *+2 DEF PARS5 * * * SET UP COMMAND LU OR FILE, AND THE ERRLU * LDA PARS5 GET PARAMETER 1 SZA,RSS IF NOT SPECIFIED, THEN ISZ PARS5 DEFAULT TO LU 1 FOR INPUT AND B1774 MASK FOR TYPE SZA,RSS NUMERIC? JMP NOPRM YES, GO SET UP CMDLU * JSB GETST RETRIEVE PARAMETERS DEF *+4 DLBUF DEF \LBUF DEF P48 DEF \FMRR * RBL CONVERT TO CHARACTERS LDA DLBUF GET INPTU BUFFER ADDRESS JSB \PARS GO PARSE THE PARAMETER STRING DEF PARS2 INTO THE PARSE BUFFER AT WORD 2 JMP STRT2 * NOPRM LDB PARS5 SET UP THE COMMA\ND LU STB PRS21 CLA,INA STA PARS2 PARAMETER TYPE 1 * STRT2 LDA RWSUB GET POTENTIAL R/W SUBFUCTION STA PARS5 SAVE FOR OPEN CALL * JSB STATE SET THE STATE FLAGS \IACM & CMDLU JMP INVLU INVALID INPUT LU SPECIFIED - GO RECOVER LDA CMDLU IF AN INTERACTIVE LU, SET THE LDB \IACM 1 MEANS INTERACTIVE SZB,RSS CLA,INA DEFAULT TO LU 1 STA ERRLU ERROR LU * JSB FOPEN GO OPEN FILE DEF *+3 DEF \IDCB DEF PARS5 LDA \FMRR SSA,RSS ANY ERRORS? JMP STRT3 NO CMA,INA SET POS. FOR CONVERT STA \FMRR JSB CNUMD GET DEC ERROR CODE DEF *+3 DEF \FMRR DEF FERMA ERROR MESSAGE ADDR LDA FERMA+2 GET LAST TWO CHARACTERS STA FILEA+6 LDA DNAM MOVE THE FILE NAME LDB DFILE MVW P3 * JSB EXEC SEND ERROR TO OPERATOR LU DEF *+5 DEF P2 DEF ERRLU DEF FILEA+1 DEF P10 STRT4 CLB SET BACK TO LU 1 STB CMDLU STB \IACM INB STB ERRLU JMP NOPRM+1 START OVER * INVLU JSB EXEC INVALID INPUT LU SPECIFIED DEF *+5 ISSUE ERROR MESSAGE TO LU 1 (NOW DEF P2 DEFAULT ERRLU) DEF P1 DEF GNR20 DEF P5 JMP STRT4 SET UP THE INPUT LU * STRT3 CLA JSB PUSH GO PLACE ON STACK JSB \TERM ERROR RETURN - CAN'T HAPPEN! * LDA ERRLU WE'RE GOING TO OVERLAY 3 WORDS CMA,INA LDB DSTRT AT STRT3 - IN ORDER TO SETUP JSB \CONV THE ERROR COMMAND: LDA STRT3+2 "TR,ERRLU" STA TRCOM+2 STORE THE ASCII LU * LDA \CPLM NEGATE HIGH END OF CURRENT CMA,INA PAGE LINK LIMIT IMAGE STA \CPLM AREA SKP * ALLOCATE SPACE FOR FIX-UP,IDENT, AND LST TABLES: * * DETERMINE HOW MUCH CORE REMAINS BEYOND LONG>EST * SEGMENT, DIVIDE INTO 3 BLOCKS FOR IN-CORE CHUNKS * OF TABLES, AND ALLOCATE DISC SPACE FOR TABLE STORAGE. * AVAILABLE CORE MUST BE AT LEAST 512 WORDS. * THE LST IS ALLOCATED LAST TO USE WASTED CORE FROM * FIXUP & IDENT BLOCKS. * LDA 1657B ADDR OF KEYWORD TABLE. STA TEMP1 TRY LDB TEMP1,I GET NEXT ID SEG ADDRESS SZB END OF TABLE IF ZERO JMP TRYY LDA ERR38 SEGMENT 3'S ID SEGMENT IS MISSING JMP NROOM+1 SEND ERROR & TERMINATE * TRYY ADB P12 GET TO NAME. LDA B,I GET FIRST TWO CHAR. * * DYNAMICALLY DETERMINE LONGEST SEGMENT * CPA AS.RT "RT4G3" = LONGEST SEGMENT. RSS MATCH. JMP NEXT INB LDA B,I GET SECOND TWO CHAR. CPA AS.GN RSS MATCH. JMP NEXT INB LDA B,I AND M7400 CPA AS.3 "3". JMP MATCH NEXT ISZ TEMP1 JMP TRY * MATCH LDA TEMP1,I GET ADDR OF IDSEG. JSB COR.A GET TO LWAM OF SEGMENT. INA GET FWAM. STA FWAM SAVE AS FIRST WORD AVAIL. MEM. CMA,INA GET SIZE OF UNDECLARED CORE. ADA LWAM LWAM SET BY RTE. STA NEXT LDA N512 MAKE SURE ENOUGH CORE. ADA NEXT AT LEAST 512 WORDS WORTH SSA JMP NROOM NO ROOM. BAIL OUT. LDA NEXT CLB DIV P4 ALLOCATE AVAILABLE MEMORY: STA TEMP1 1/4 TH FOR FIXUP TABLE, AND CMA,INA 3/8 TH'S EACH FOR IDENT AND LST ADA NEXT ARS DIVIDE BY 2 STA TEMP2 * * SET UP FIX-UP TABLE. * LDA TEMP1 CLB TRUNCATE BLOCK SIZE DIV P6144 IF GREATER THAN 6144 (#WORDS/TRACK) SZA LDB P6144 TO ONE TRACK STB A SETF0 CLB DIV SECWD SEE HOW MANY SECTORS FIT. STA FX.#S SAVE # SECT PER FIX-UP BLOCK. MPY SECWD CONVERT TO WORDS FOR LENGTH. STA LFIX 1 OF DISC READS AND WRITES. CLB BLOCK MULTIPLE MUST END ON A TRACK LDA P6144 BOUNDARY AS WELL DIV LFIX SZB,RSS JMP SETF1 OK LDA LFIX ADA N128 DECREMENT SIZE BY ONE SECTOR JMP SETF0 SETF1 LDA LFIX CLB GET # 4 WORD ENTRIES IN DIV P4 THE BLOCK. STA EFIX SAVE # ENTRIES IN BLOCK. * LDA FWAM INITIALIZE FIX-UP POINTERS: STA BFIX FIRST ENTRY, CLA STA \PFIX # ENTRIES USED, STA \TFIX CURRENT ENTRY INDEX. STA B.F 1ST ENTRY NOW IN CORE. * * SET UP IDENT TABLE. THIS ONE HAS AN OFFSET OF +10. * LDA BFIX SET FWA IDENT AREA AT ADA LFIX STA BIDNT END OF FIX-UP AREA. LDA TEMP2 GET BLOCK CLB TRUNCATE BLOCK SIZE DIV P6144 IF GREATER THAN 6144 (#WORDS/TRACK) SZA LDB P6144 TO ONE TRACK STB A SETI0 CLB DIV SECWD SEE HOW MANY SECTORS FIT STA ID.#S MPY SECWD CONVERT TO WORDS FOR LENGTH STA LIDNT CLB BLOCK MULTIPLE MUST END ON LDA P6144 TRACK BOUNDARY AS WELL DIV LIDNT SZB,RSS JMP SETI1 OK LDA LIDNT DECREMENT BLOCK ADA N128 SIZE BY ONE SECTOR JMP SETI0 SETI1 LDA LIDNT CLB GET # 16 WORD ENTRIES IN DIV P16 THE BLOCK. STA EIDNT SAVE # ENTRIES IN BLOCK. * LDA P10 INITIALIZE IDENT POINTERS: STA \PIDN # ENTRIES USED +10, STA \TIDN CURRENT ENTRY INDEX, STA B.I 1ST ENTRY INDEX NOW IN CORE. * * SET UP LOADER SYMBOL TABLE (LST). * LDA BIDNT SET FWA LST AREA AT END ADA LIDNT STA BLST OF IDENT AREA. CMA,INA USE ALL OF REMAINING ADA LWAM AVAILABLE MEMORY. CLB TRUNCATE BLOCK SIZE DIV P6144 IF GREATER THAN 6144 (#WORDS/TRACK) SZA LDB P6144 TO ONE TRACK STB A SETL0 CLB DIV SECWD SEE HOW MANY SECTORS FIT. STA LS.#S SAVE # SECT PER LST BLOCK. MPY SECWD CONVERT TO WORDS FOR LENGTH STA LLST OF DISC READS AND WRITES. CLB LDA P6144 BLOCK MULTIPLE DIV LLST MUST END ON TRACK SZB,RSS BOUNDARY AS WELL JMP SETL1 LDA LLST ADA N128 DECREMENT BY ONE SECTOR JMP SETL0 SETL1 LDA LLST CLB GET # 5 WORD ENTRIES IN DIV P5 THE BLOCK. STA ELST SAVE # ENTRIES. * CLA INITIALIZE LST POINTERS: STA \PLST # ENTRIES USED, STA \TLST CURRENT ENTRY INDEX, STA B.L 1ST ENTRY NOW IN CORE. SKP * * ALLOCATE DISC SPACE FOR FIX-UP, IDENT, LST. * LDA FIX#T GET # FIX-UP TRACKS, ADA IDT#T ADD # IDENT TRACKS, ADA LST#T ADD # LST TRACKS. IOR MSIGN SET NO SUSPEND BIT STA NEXT TOTAL # TRACKS TO ALLOCATE. * GETTR JSB EXEC DEF *+6 DEF P4 DEF NEXT # TRACKS REQUESTED. DEF FTRKA RETURNED: FIRST TRACK. DEF DSKLU RETURNED: WHICH DISC. DEF SECTK RETURNED: SECTORS/TRACK. * LDA FTRKA GET FIRST TRACK # SSA,RSS REQUEST GRANTED? JMP ALLOC YES JSB \SPAC JSB EXEC NO, TELL USER OF PROBLEM DEF *+5 DEF P2 DEF ERRLU DEF TRMSG DEF P14 "GENERATOR WAITING FOR TRACKS" * LDA NEXT TAKE OUT NO-SUSPEND BIT XOR MSIGN STA NEXT SUSPEND UNTIL TRACKS ARE AVAILABLE JMP GETTR * ALLOC LDA FX.#S GET # 128 WORD SECTORS. CLE,ELA MPY BY 2 (64 WORD SECTORS). CLB DIV SECTK FIND MULT. FACTOR PER WRITE. SZB,RSS IF A TRACK MULTIPLE LDB P96 THEN SET IT SO STB FX.#S # 64 WORD SECTORS PER BLOCK. * V LDA ID.#S CLE,ELA CLB DIV SECTK SZB,RSS LDB P96 STB ID.#S * LDA LS.#S CLE,ELA CLB DIV SECTK SZB,RSS LDB P96 STB LS.#S * LDA FTRKA STA FX.BT FIX-UP START TRACK. STA FX.LT FIX-UP TRACK LAST READ. ADA FIX#T STA FX.ET FIX-UP LAST TRACK +1. STA ID.BT IDENT START TRACK. STA ID.LT IDENT TRACK LAST READ. ADA IDT#T STA ID.ET IDENT LAST TRACK +1. STA LS.BT LST START TRACK. STA LS.LT LST TRACK LAST READ. ADA LST#T STA LS.ET LST LAST TRACK +1. CLA STA FX.LS STA ID.LS STA LS.LS SKP * * GET NAME, SECUR, LABEL OF LIST FILE. * FNAME LDA P10 "LIST FILE?" LDB LSTFI JSB \RNME GET LIST FILE JSB \CRET GO CREATE THE FILE DEF *+5 DEF \LDCB DEF P64 DEF P3 DEF ZERO CLA JSB \CFIL CHECK FILE STATUS JMP FNAME ERROR ISZ LFERR 1=> ACKNOWLEDGE LIST FILE ERRORS * DLD PARS2 WAS NAME A FILE OR LU? CPA P1 RSS JMP FLNM0 FILE NAME, SO DEFAULT TO LSTLU=0 STB LSTLU SAVE THE LU - MAY NOT BE INTERACTIVE JSB EXEC DETERMINE THE DEVICE TYPE DEF *+6 DEF P13 DEF LSTLU DEF EQT5 DEF FNAME DEF ALLOC * CLB LDA FNAME IF BIT BUCKET WAS SPECIFIED, AND M77 DON'T MISTAKE IT FOR A TYPE SZA,RSS 00 DEVICE JMP SETIA * LDB LSTLU LDA EQT5 INTERACTIVE DEVICES ARE TYPE 0, OR ALF,ALF TYPE 5, SUBCHANNEL 0 AND M77 STA EQT5 CPA P7 IF A TYPE 7 DEVICE, THEN IT IS CLA AUTOMATICALLY INTERACTIVE CPA P5 LDA ALLOC GET TYPE 5 SUBCHANNEL AND M77 CLB SZA,RSS INB StHFBET INTERACTIVE SETIA STB IALST 0=NOT INTERACTIVE, 1=IT IS * SZB IF ITS INTERACTIVE JMP EC? THEN DON'T LOCK LULOC JSB LURQ DEF *+4 DEF IOPTN DEF LSTLU DEF P1 * SZA,RSS WAS IT SUCCESSFUL? JMP EC? YES JSB \SPAC JSB EXEC DEF *+5 DEF P2 H DEF ERRLU DEF LUMSG DEF P17 "GENERATOR WAITING ON LIST LU LOCK" * LDA IOPTN SET THE WAIT BIT FOR NEXT CALL XOR MSIGN STA IOPTN JMP LULOC * * RE-OPEN THE LIST FILE WITH A NON-EXCLUSIVE OPEN SO IT CAN * BE EXAMINED CONCURRENT WITH GENERATION * FLNM0 JSB OPEN A CALL TO OPEN AN ALREADY DEF *+7 OPEN FILE WILL RESULT DLDCB DEF \LDCB IN IT BEING CLOSED AND DEF \FMRR RE-OPENED WITH THE OPTIONS DEF PARS2+1 DEF P1 DEF PARS3+1 DEF PARS4+1 LDA DLDCB GET DCB ADDRESS JSB \CFIL CHECK ERROR STATUS JMP FLNM0 * * ASK WHETHER ECHO IS DESIRED * AND OPEN IT IF SO * EC? LDA P5 LDB ECHOI JSB YE?NO JMP EC? INVALID REPLY STA ECHON 1 FOR YES, 0 FOR NO * CLA,INA SET UP FOR CREATION STA PARS2 OF DUMMY DCB IN TYP0 LDA ERRLU STA PARS2+1 LU ALREADY DETERMINED JSB FOPEN DEF *+3 DEF \EDCB DEF RWSUB * JSB \CFIL JSB \TERM RSS SKIP * * GET SIZE, NAME, SECUR, LABEL OF CORE-IMAGE RTE OUTPUT FILE. * JSB \INER INPUT ERROR EST# JSB \SPAC LDA P30 LDB FISIZ "EST. # TRACKS IN OUTPUT FILE?" JSB \READ LDA N3 JSB \DCON GET BINARY. JMP EST# ERROR. TRY AGAIN. STA NEXT ADA MIN15 CHECK FOR 15 TRACKS MIN. SSA JMP EST#-1 LDA NEXT MPY P48 GET # BLOCKS. SSA IF NEGATIVE THEN RETRY JMP EST#-1 STA NEXT * FLNAM JSB \SPAC LDA P17 LDB OUTFI JSB \RNME "OUTPUT FILE NAME?" * LDA PARS2 CHECK FOR NUMERIC OR NULL ANSWER CMA,INA,SZA IF NULL(TYPE 0) INA,SZA,RSS OR NUMERIC(TYPE 1) RSS JMP FLNMC THEN ITS A LU JSB \INER JMP FLNAM * FLNMC JSB \CRET GO CREATE THE OUTPUT FILE K DEF *+5 DEF ABDCB DEF NEXT # BLOCKS. DEF P1 TYPE 1 FILE. DEF ZERO CLA JSB \CFIL CHECK FILE ERROR JMP FLNAM RETRY...ERROR * * GET SYSTEM DISK TYPE * JSB \SPAC RSS JSB \INER INPUT ERROR TO "SYSTEM DISK?" STRT0 LDA P12 TO GET THE INITIAL SEGMENT LDB MES00 DEPENDS ON THE DISK TYPE JSB \READ MES00: "SYSTEM DISK?" LDA N4 JSB \DCON CONVERT 4 DEC DIGITS JMP STRT0 ERROR - TRY AGAIN CLB,INB CPA P7900 CHECK FOR A CLB 7900 CPA P7905 OR A 7905 CCB CPA P7906 OR A 7906 CCB CPA P7920 OR A 7920 CCB STB DTYPE 0=7900, -1=7905,7906,7920 SSB JMP STRT5 SZB IF NOT 7900 JMP STRT0-1 THEN ERROR * JSB SWAP SWAP IN SEGMENT 1 FOR 7900 DEC 1 DISK DEPENDENT SUBROUTINES JMP .NM * STRT5 JSB SWAP SWAP IN SEGMENT 7 FOR 7905 DEC 7 DISK DEPENDENT SUBROUTINES * * CREATE TEMPORARY FILE FOR MODIFIED NAM RECORDS. * .NM JSB CREAT CREATE @.NM.@ FILE NAME. DEF *+6 DNDCB DEF \NDCB DEF \FMRR DEF \.NM. DEF P64 DEF P5 * LDA \FMRR DUPLICATE NAME? CPA N2 RSS YES JMP .NMCH CHECK FOR OTHER ERRORS * ISZ NAMM BUMP TO NEXT SYMBOL JMP .NM AND TRY TO CREATE IT * .NMCH LDA DNDCB GET DCB ADDRESS AND CHECK FOR ANY JSB \CFIL OTHER ERRORS JSB \TERM YES, SO ABORT SKP * * THE FOLLOWING MESSAGES ARE PRINTED DURING THE INITIALIZATION * PHASE, WITH THE SPECIFICATIONS FOR EACH VALID RESONSE. * * * MESSAGE RESPONSE * * * TBG SELECT CODE? ENTER 2 OCTAL DIGITS * * PRIV. INT. SELECT CODE? ENTER 2 OCTAL DIGITS * * MEM.RES. ACCESS TABLE AREA II? ENTER YES EOR NO * * RT MEMORY LOCK? ENTER YES OR NO * * BG MEMORY LOCK? ENTER YES OR NO * * SWAP DELAY? ENTER <= 3 DECIMAL DIGITS * * MEM SIZE? ENTER <= 4 DECIMAL DIGITS * * JSB \SPAC GET A NEW LDA \ADBP GET ADDRSS OF DUMMY BASE PAGE CMA,INA MAKE NEG STA \NABP SAVE * LDB D$REN ENTER .ZRNT IN THE LST JSB \LSTE LDA RSS SET IT UP AS STA \LST5,I A REPLACE WITH RSS LDA P4 STA \LST4,I ENT CLA STA \RNT INDEX IS 0 * LDB D$PRV DO SAME FOR .ZPRV JSB \LSTE LDA P4 STA \LST4,I LDA RSS STA \LST5,I CLA,INA STA \PRV SET FLAG FOR LOAD PHASE * LDB D$CLS ENTER $CLAS INTO JSB \LSTE THE SYMBOL TABLE LDB D$LUS NOW ENTER $LUSW JSB \LSTE LDB D$RNT AND $RNTB JSB \LSTE LDB $LUAV AND $LUAV JSB \LSTE * LDB DTYPE SET UP THE DISC SPECIFICATIONS. SSB JMP SPEC5 JSB \DST0 7900 RSS RSS * SPEC5 JSB \DST5 7905 * * SET TIME BASE GENERATOR CHANNEL * JSB \SPAC NEW LINE CHNLT LDA P16 LDB MES30 MES30 = ADDR: TBG SELECT CODE? JSB \READ PRINT MESSAGE, GET REPLY LDA P2 SET FOR 2 OCTAL DIGITS INPUT JSB \DCON GET DIGITS, RETURN OCTAL JMP CHNLT REPEAT INPUT STA \TBCH SET TBG CHANNEL NO. CLE JSB TBPI? CHECK FOR A VALID SELECT CODE JMP CHNLT TRY AGAI N * * GET PRIV. INT. CARD ADDR. * JSB \SPAC NEW LINE DUMY LDA P23 LDB MES41 MES41 = ADDR: PRIV. INT. SELECT CODE? JSB \READ PRINT MESSAGE, GET REPLY LDA P2 SET FOR 2 OCTAL DIGITS INPUT JSB \DCON GET DIGITS JMP DUMY -ERROR, REPEAT INPUT. STA W\PIOC SET ADDRESS OF DUMMY CARD CCE JSB TBPI? CHECK FOR A VALID SELECT CODE JMP DUMY LDA P3 SET BOTH RT AND STA \SWPF BG SWAP FLAGS ALWAYS. SPC 1 JSB \SPAC MAPC? LDA P31 ASK: MEM. RES. ACCESS TABLE AREA II? LDB MSMP. JSB YE?NO JMP MAPC? ASK AGAIN IF BAD ANSWER STA \MRT2 SAVE 1 IF YES, 0 IF NO LDA "RT" NOW ASK JSB LOCK? 'RT MEMORY LOCK?' RAL,RAL ROTATE TO PROPER BIT POSITION IOR \SWPF COMBINE STA \SWPF AND SAVE * LDA "BG" NOW DO SAME FOR BACKGROUND JSB LOCK? ALF,RAR IOR \SWPF COMBINE STA \SWPF SAVE THE WORD. * SWPDL JSB \SPAC LDA P11 GET THE LDB MES33 SWAP DELAY JSB \READ LDA N3 CONVERT JSB \DCON TO BINARY FROM DECIMAL JMP SWPDL ERROR TRY AGAIN * AND M7400 IF > 256 SZA,RSS THEN JMP SWPOK * JSB \INER BITCH AND JMP SWPDL TRY AGAIN * SWPOK LDA \OCTN COMBINE ALF,ALF WITH SWAP IOR \SWPF FLAG STA \SWPF AND SAVE * JSB \SPAC SKIP A LINE MEMSZ LDA P9 THEN ASK USER LDB MESS3 FOR NUMBER OF PAGES JSB \READ OF MAIN MEMORY LDA N4 GET 4 DECIMAL JSB \DCON DIGITS OR TRY AGAIN JMP MEMSZ IF ERROR STA \NUMP * ADA N48 CHECK FOR THE 48-PAGE MINIMUM SSA,RSS JMP BOUT OK BDSZ JSB \INER FLAG ERROR JMP MEMSZ AND ASK AGAIN * BOUT ADA N977 NOW CHECK FOR 1024 PAGE MAX SSA,RSS JMP BDSZ TOO BIG, ISSUE ERROR & RETRY LDB DTYPE FINISH THE DISC SET UP. SSB JMP SET05 JSB \BOT0 7900 BOOT RSS * SET05 JSB \BOT5 7905 BOOT * JMP SEGCN * N48 DEC -48 N977 DEC -977 SKP * * CHECK FOR VALID SELECT CODE RESPONSE TO TBG OR PI QUERY * * ON ENTRY: E-REG = 0 IF 0 RESPONSE NOT ALLOWED, IE, FOR TBG * ON ENTRY: E-REG = 1 IF 0 RESPONSE ALLOWED FOR PI QUERY * TBPI? NOP SZA,RSS ZERO RESPONSE? JMP TBG? YES, CHECK FOR VALIDITY * ADA N8 MUST BE >= 10 OCTAL SSA JMP TBRR NOPE * TBXT ISZ TBPI? JMP TBPI?,I * TBG? SEZ TBG OR PI? JMP TBXT PI IS OKAY TBRR JSB \INER SORRY! JMP TBPI?,I SPC 3 * * NOT ENOUGH CORE BEYOND LONGEST SEGMENT * FOR LST, IDENT, FIXUP TABLES. * NROOM LDA ERR02 JSB \GNER JSB \TERM * ERR02 ASC 1,02 ERR38 ASC 1,38 SEGMENT 3'S ID-SEGMENT MISSING SKP * * OVERLAID CONSTANTS. * FWAM NOP CALCULATED AT RUNTIME LWAM EQU 1777B END OF CORE * N4 DEC -4 MIN15 DEC -15 N128 DEC -128 N512 DEC -512 P1 DEC 1 P9 DEC 9 P11 DEC 11 P16 DEC 16 P23 DEC 23 P17 DEC 17 P30 DEC 30 P48 DEC 48 P96 DEC 96 P6144 DEC 6144 #WORDS PER TRACK P7900 DEC 7900 P7905 DEC 7905 P7906 DEC 7906 P7920 DEC 7920 B1774 OCT 177400 MSIGN OCT 100000 IOPTN OCT 1 FTRKA NOP RWSUB OCT 400 "RT" ASC 1,RT "BG" ASC 1,BG AS.RT ASC 1,RT AS.GN ASC 1,4G AS.3 OCT 31400 LONGEST SEG = RT4G3. TEMP1 NOP TEMP2 NOP DSTRT DEF STRT3 * D$REN DEF *+1 ASC 3,.ZRNT D$PRV DEF *+1 ASC 3,.ZPRV D$CLS DEF *+1 ASC 3,$CLAS D$LUS DEF *+1 ASC 3,$LUSW D$RNT DEF *+1 ASC 3,$RNTB $LUAV DEF *+1 ASC 3,$LUAV * TRMSG ASC 14,GENERATOR WAITING FOR TRACKS LUMSG ASC 17,GENERATOR WAITING ON LIST LU LOCK MES00 DEF *+1 ASC 6,SYSTEM DISC? LSTFI DEF *+1 ASC 5,LIST FILE? OUTFI DEF *+1 ASC 9,OUTPUT FILE NAME? ECHOI DEF *+1 ASC 3,ECHO? FISIZ DEF *+1 ASC 15,EST. # TRACKS IN OUTPUT FILE? MES30 DEF *+1 ASC 8,TBG SELECT CODE? MES41 DEF *+1 ASC 12,PRIV. INT. SELECT CODE? MES32 ZDEF *+1 ASC 8,RT MEMORY LOCK? MES33 DEF *+1 ASC 6,SWAP DELAY? MESS3 DEF *+1 ASC 5,MEM SIZE? MSMP. DEF *+1 ASC 16,MEM. RES. ACCESS TABLE AREA II? * P31 DEC 31 GNR20 ASC 5,GEN ERR 20 HED RTGEN SUBROUTINES. SPC 5 * * * LOCK? ASKS AND ANALIZES THE 'XX MEMORY LOCK?' QUESTION. * * CALLING SEQUENCE: * * LDA "RT" OR "BG" * JSB LOCK? * RETURN A=1 IF YES, 0 IF NO. * * LOCK? NOP STA MES32,I SET THE 'FG' OF 'BG' IN MESSAGE JSB \SPAC MAKE IT LOOK NEAT. LOCK1 LDA P15 GET THE LENGTH LDB MES32 GET MESSAGE ADDRESS JSB YE?NO GO ASK AND GET ANSWER JMP LOCK1 ERROR SO RETRY * JMP LOCK?,I RETURN P15 DEC 15 SKP * YE?NO ROUTINE SENDS A QUESTION TO THE TTY * AND READS AND ANALIZES THE RESPONSE * * CALLING SEQUENCE: * * LDA MESSAGE CHARACTER COUNT * LDB MESSAGE ADDRESS * JSB YE?NO * JMP ERROR * NORMAL RETURN A=1 FOR YES, 0 FOR NO. * YE?NO NOP JSB \READ GO PRINT MESSAGE AND GET ANSWER JSB \YENO ANALIZE THE ANSWER JMP YE?NO,I ERROR EXIT * CLA,RSS NO RETURN CLA,INA YES RETURN ISZ YE?NO STEP RETURN ADDRESS JMP YE?NO,I RETURN TO CALLER. SPC 5 * BSS 1650B+DBP-* BUF64 IS A TEMPORARY BUFFER USED BY \CFIL BUF64 BSS 2000B+DBP-* RESERVE 1K FOR DUMMY BASE PAGE. * SPC 5 *********************************************** * * * END OF AREA OVERLAID FOR DUMMY BASE PAGE. * * * *********************************************** SKP * DBPO EQU DBP \ADBP DEF DBPO ADDR OF DUMMY BASE PAGE \NABP NOP NEG OF RT4GN START * * CURRENT PAGE LINKAGE IMAGE AREA. * \TBLK BSS 3 \LRBP BSS 1 AREA 1: CR SYSTEM BP \URBP BSS 1 \IRBP BSS 1 \CUBP BSS 1 AREA 2: CURRENT PROG BP. \UCBP BSS 1 \ICBP BSS 1 * BSS 600 CURRENT PAGE LINKAGE IMAGE AREA. * \CPLM DEF * END OF CP LINK AREA. \CBPA DEF \CUBP ADDR OF CURRENT BP SPECS. SPC 2 \TIME BSS 1 \TIM1 BSS 1 \MULR BSS 1 * \RNT BSS 1 INDEX OF \RENT ENTRY \PRV BSS 1 INDEX OF \PRIV ENTRY * \CURL NOP CURRENT \LBUF ADDRESS. \CPL2 NOP ADDR OF HIGH CURRENT PAGE LINK SPECS. * \PREL NOP CURRENT PROGRAM RELOC ADDRESS \NUMP NOP MEM SIZE(PAGES) \TBCH NOP TIME BASE GENERATOR CHANNEL \PIOC NOP ADDR OF PRIVILEGED I/0 CARD \SWPF NOP SWAPPING FLAG = 0/1 = NO/YES DTYPE NOP TARGET DISK = 0/-1 = 7900/7905 \LBUF BSS 64 LOAD BUFFER \TBUF BSS 4 TEMP BUFFER SKP SEGCN JSB SWAP DO PROG INPUT PHASE. P2 DEC 2 ROLL IN RT4G2 JSB \PIP GO TO SEGMENT. * JSB SWAP GO GENERATE RTE! P3 DEC 3 JMP \GENS SPC 3 ******************************************************************************** * * CONTROL ROUTINES FOR INTER-SEGMENT CALLS: * ***************************************************************************** SPC 3 * * BUILD SYSTEM TABLES * \SYTB NOP IN-CORE RT4G3 ISSUED CALL JSB SWAP ROLL IN RT4G5 DEC 5 * JSB \TBLS BUILD THE TABLES * JSB SWAP BRING BBACK RT4G3 DEC 3 JMP \SYTB,I SPC 3 * * LOAD A PROGRAM * \LODN NOP IN-CORE RT4G3 ISSUED CALL. JSB SWAP ROLL IN RT4G4. P4 DEC 4 * JSB \NLOD CALL LOADING ROUTINE IN RT4G4 * JSB SWAP BRING BACK RT4G3. DEC 3 JMP \LODN,I RETURN. SPC 3 * * BUILD I/O TABLES * \GNIO NOP IN-CORE RT4G3 ISSUED CALL. * * BUILD TRACK MAP TABLE FIRST ($TB31/$TB32) * LDB DTYPE DETERMINE DISC TYPE SSB JMP D05 * JSB SWAP  ROLL IN RT4G1 FOR 7900 DISC DEC 1 JSB \TB31 CALL ROUTINE TO BUILD TMT JMP GET5 * D05 JSB SWAP ROLL IN RT4G7 FOR 7905/7920 DISCS DEC 7 JSB \TB32 CALL ROUTINE TO BUILD TMT * GET5 JSB SWAP ROLL IN RT4G5. P5 DEC 5 * JSB \IOTB BUILD THE TABLES IN RT4G5 * JSB SWAP BRING BACK RT4G3. DEC 3 JMP \GNIO,I RETURN. SPC 3 * * RELOCATE DRIVER PARTITIONS * \CLDP NOP IN-CORE RT4G3 ISSUED CALL JSB SWAP ROLL IN RT4G8 P8 DEC 8 * JMP \\LDP CONTROL DP RELOCATION * \DDON JSB SWAP BRING BACK RT4G3 DEC 3 JMP \CLDP,I SPC 3 * * RELOCATE A PARTITION-RESIDENT DRIVER * \DPLD NOP IN-CORE RT4G8 ISSUED CALL JSB SWAP ROLL IN RT4G4 DEC 4 * JSB \NLOD CALL LOADING ROUTINE IN RT4G4 * JSB SWAP BRING BACK RT4G8 DEC 8 JMP \DPLD,I SPC 3 * * PERFORM PARTITION DEFINITION * \PART NOP IN-CORE RT4G3 ISSUED CALL JSB SWAP ROLL IN RT4G6 DEC 6 * JSB \PDEF DO PARTITION DEFINITION * JSB SWAP BRING BACK RT4G3 DEC 3 JMP \PART,I SPC 3 * * CLEAN-UP BOOT EXTENSION AND HEADER RECORDS * \FSEC NOP IN-CORE RT4G3 ISSUED CALL. LDB DTYPE DETERMINE DISK TYPE SSB JMP F05 * JSB SWAP ROLL IN RT4G1 (7900) DEC 1 JSB \FSC0 CALL "\FSC0" IN RT4G1. JMP BK3 * F05 JSB SWAP ROLL IN RT4G7 (7905,7920) DEC 7 JSB \FSC5 CALL "\FSEC" IN RT4G7 * BK3 JSB SWAP BRING BACK RT4G3. DEC 3 JMP \FSEC,I RETURN. SKP * * ROUTINE TO SWAP SEGMENTS * CALLING SEQUENCE * JSB SWAP * DEC SEG # * A AND B REG SAVED * SWAP NOP DST ABREG SAVE REGISTERS. CCA ADA SWAP,I GET SEG NUMBER. MPY P3 ADA RTGMA STA SWAPA JSB EXEC ROLL IN SEGMENT DEF *+3 - IT WILL COME BACK TO \SRET DEF P8 AFTER EXECUTING FRONT END CODE. SWAPA NOP \SRET ISZ SWAP GET RETURN ADDRESS DLD ABREG RESTORE REGISTERS. JMP SWAP,I AND RETURN SPC 1 ABREG BSS 2 * * * THE FOLLOWING ORDER MUST NOT BE CHANGED * RTGMA DEF *+1 ASC 3,RT4G1 7900 DISC SUBR. SEGMENT ASC 3,RT4G2 PARAMETER INPUT PHASE SEGMENT ASC 3,RT4G3 LOADING CONTROL SEGMENT ASC 3,RT4G4 LOADER SEGMENT ASC 3,RT4G5 I/O TABLE GENERATION SEGMENT ASC 3,RT4G6 PARTITION DEFINITION SEGMENT ASC 3,RT4G7 7905 DISC SUBR. SEGMENT ASC 3,RT4G8 DRIVER PART. LOADING CONTROL SEGMENT SKP * CONVERT A TO ASCII AT B * * THE \CONV SUBROUTINE CONVERTS THE CONTENTS OF A * INTO ASCII (DECIMAL OR OCTAL) AT THE LOCATION SPECIFIED * BY B. THE CONVERTED RESULT REQUIRES 3 WORDS, AND IS * IN THE FORMAT: XXXXX, WITH A SPACE IN THE FIRST POSITION. * * CALLING SEQUENCE: * A = NO. TO BE CONVERTED. IF THE SIGN OF A IS POS., * THE CONVERSION IS TO BE IN OCTAL; IF NEGATIVE, * IN DECIMAL. * B = ADDRESS OF CORE LOCATION FOR CONVERTED RESULT * RETURN: CONTENTS OF A AND B ARE DESTOYED. * \CONV NOP STB CURAT SET MESSAGE ADDRESS LDB OPWRS GET ADDR OF OCTAL POWERS SSA SKIP IF OCTAL CONV REQUIRED LDB DPWRS GET ADDRESS OF DECIMAL POWERS STB RANAD SET POWER RANGE ADDRESS SSA,RSS SKIP IF NEGATIVE (DECIMAL) CMA,INA CONVERT NUMBER TO NEGATIVE STA B PUT NUMBER IN B (REMAINDER) LDA N2 STA TCNT SET CONVERSION COUNTER JSB GETD GET FIRST DIGIT IOR UBLNK ADD BLANK TO FIRST CHAR STA CURAT,I SAVE FIRST BLANK, CHARACTER ISZ CURAT INCR MESSAGE ADDRESS NEXTD JSB GETD GET NEXT DIGIT Bj ALF,ALF ROTATE TO UPPER STA CURAT,I SAVE UPPER CHARACTER JSB GETD GET NEXT DIGIT IOR CURAT,I ADD UPPER CHAR STA CURAT,I SAVE NEXT 2 CHARACTERS ISZ CURAT INCR MESSAGE ADDRESS ISZ TCNT SKIP - 5 DIGITS IN JMP NEXTD NO - CONTINUE WITH NEXT DIGIT JMP \CONV,I YES - RETURN * OPWRS DEF *+1 OCT 10000 OCT 1000 OCT 100 OCT 10 OCT 1 * DPWRS DEF *+1 DEC 10000 DEC 1000 DEC 100 P10 DEC 10 DEC 1 * N2 DEC -2 TCNT NOP SKP * * GET DIGIT FOR \CONV * * GETD PROVIDES THE ASCII CHARACTERS FOR \CONV. * * CALLING SEQUENCE: * A = IGNORED * B = REMAINDER * JSB GETD * * RETURN: * A = ASCII DIGIT * B = IGNORED * GETD NOP CLA INCRA ADB RANAD,I ADD POWER CMB,SSB,INB,SZB SKIP - TRY NEXT HIGHER DIGIT JMP GET2 DIGIT FOUND INA INCR DIGIT CMB,INB RESTORE REMAINDER TO NEGATIVE JMP INCRA TRY HIGHER DIGIT GET2 ADB RANAD,I ADD POWER CMB,INB RESTORE REMAINDER ISZ RANAD INCR POWER LIST ADDRESS IOR M60 CONVERT TO ASCII JMP GETD,I RETURN WITH DIGIT IN A * M60 OCT 60 RANAD NOP SKP * * SET UP LNK AREA * * \LNK, \LNKS, AND \LNKX MANAGE THE LINK AREA. * * THIS AREA IS COMPOSED OF TRIPLETS AND LINK AREA * IMAGES AS FOLLOWS: * * WORD1 THE ACTUAL CORE ADDRESS OF THE LINK AREA * WORD2 THE ACTUAL CORE ADDRESS OF THE LAST WORD+1 OF THE AREA * WORD3 THE ADDRESS OF THE LOADRS IMAGE OF THE AREA * * THE FIRST TWO ENTRIES ARE FOR BASE PAGE AS FOLLOWS: * * AREA 1 THE CORE RESIDENT SYSTEM BASE PAGE AREA * AREA 2 THE CURRENT PROGRAMS BASE PAGE AREA * * FOR THESE AREA THE IMAGE IS IN THE DUMMY BASE PAGE * FOR ALL OTHER ENTRIES (I.E. FOR CURRENT PAGE LINK AREAS) * THE IMAGE FOLLOWSP THE THREE WORD DEFINITION OF THE AREA. * * IN ALL CASES THE LAST DEFINED AREA IS THE ONE THAT HAS A * WORD1 ADDRESS OF \CPL2, WHICH IS USUALLY THE HIGH * CURRENT PAGE LINK AREA FOR THE CURRENT PROGRAM * * \LNKX INITILIZES THE SCANNING OF THE LINKAGE AREA * \LNK SETS UP \LNK1, \LNK2, \LNK3 FOR THE NEXT ENTRY * P+1 RETURN INDICATING THERE IS NO NEXT ONE. * P+2 INDICATING THAT THE SET UP WAS DONE. * * \LNKS SETS UP \LNK1, \LNK2, \LNK3 GIVEN THAT THE FIRST WORD ADDRESS * IS KNOWN (AND PASSED IN THE A REGISTER) * \LNKX NOP LDA TLNK GET INITIAL ADDRESS STA \LNK1 SET IN \LNK1 JMP \LNKX,I RETURN SPC 3 \LNK NOP LDA \LNK1 GET CURRENT ADDRESS CPA \CPL2 IF LAST ENTRY JMP \LNK,I RETURN, END OF LST * LDA A,I GET THE ACTUAL ADDRESS AND M0760 ISOLATE THE PAGE ADDRESS SZA,RSS IF BASE PAGE DO THE BP THING JMP LNKB * LDA \LNK1,I ELSE CACULATE THE ADDRESS OF CMA,INA THE NEXT ADA \LNK2,I ENTRY ADA \LNK3,I BY SKIPPING OVER THE IMAGE LNKA JSB \LNKS SET UP THE NEW AREA ISZ \LNK SET OK RETURN ADDRESS JMP \LNK,I RETURN * LNKB LDA \LNK1 FOR BASE PAGE ADA P3 USE NEXT THREE JMP LNKA WORD AREA. SPC 3 \LNKS NOP STA \LNK1 SET THE LINK POINTERS UP INA STA \LNK2 INA STA \LNK3 JMP \LNKS,I AND RETURN SPC 3 \LNK1 NOP \LNK2 NOP \LNK3 NOP TLNK DEF \TBLK M0760 OCT 076000 SKP * * NUMERICAL INPUT CONTROL * * THE \DCON SUBROUTINE ANALYZES THE INPUT FOR THE * CHANNEL NO., DISK SIZES, TBG CHANNEL NO. AND LAST * WORD OF AVAILABLE MEMORY. * * CALLING SEQUENCE: * A = MAX NO. OF CHARACTERS PERMITTED IN RESPONSE. * THE SIGN OF A DETERMINES THE CONVERSION FROM * ASCII TO OCTAL (POS.) OR DECIMAL (NEG.). * +HFB B = IGNORED * JSB \DCON * * RETURN: * (N+1): CONTENTS OF A AND B ARE DESTROYED. AN INVALID * CHARACTER HAS BEEN DETECTED IN THE RESPONSE, OR * THE RESPONSE CONTAINS AN INVALID NO. CHARACTERS. * THE MESSAGE IS TO BE REPEATED ON RETURN. 6@H* (N+2): A = CONVERTED RESULT * \DCON NOP JSB \GET# GET OCTAL/DECIMAL, RETURN OCTAL JMP *+4 INVALID DIGIT JSB \GETC GET NEXT CHAR FROM \LBUF SZA,RSS CHAR = ZERO? (END OF BUFFER) JMP *+3 YES - CONTINUE JSB \INER INVALID DIGIT ENTRY JMP \DCON,I RETURN ISZ \DCON INCR RETURN ADDRESS LDA \OCTN GET CONVERTED NUMBER JMP \DCON,I RETURN SKP * * GET CHAR FROM \LBUF, RETURN IN A * * THE FOLLOWING SUBROUTINE SUPPLIES THE CHARACTERS FOR * \GETN AND \GET#. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB \GETC * * RETURN: * A = CURRENT CHARACTER * B = DESTROYED * \GETC NOP LDA \CMFL \CMFL = COMMA-IN FLAG SZA,RSS SKIP IF NO COMMA IN JMP BLRET RETURN BLANK LDB \BUFL GET U/L FLAG IGNOR LDA \CURL,I GET CHAR FROM \LBUF SZB SKIP IF LOWER CHAR ALF,ALF ROTATE TO LOWER AND M377 ISOLATE LOWER CHAR CPA STAR IF STAR CLA TREAT AS END OF LINE SZA,RSS END OF BUFFER? JMP \GETC,I YES - RETURN WITH ZERO CMB,SZB RESET U/L, SKIP IF UPPER CHAR ISZ \CURL INCR \LBUF ADDRESS STB \BUFL SAVE U/L FLAG CPA BLANK CHAR = BLANK? JMP IGNOR IGNORE BLANKS * CPA COMMA CHAR = COMMA? ISZ \CMFL RESET FLAG TO SHOW COMMA IN (SKIPS) JMP \GETC,I RETURN WITH NON-BLANK CHAR BLRET LDA BLANK REPLACE WITH BLANK CHAR JMP \GETC,I RETURN WITH BLANK * COMMA OCT 54 STAR OCT 52 BLANK OCT 40 \BUFL NOP BUFFER U/L FLAG. \CMFL NOP COMMA FLAG= -1/0= NOT IN/IN. M377 OCT 377 SKP * * MOVE ALPHA FROM \LBUF TO \TBUF * * THE FOLLOWING SUBROUTINE MOVES THE CHARACTERS FROM \LBUF * TO \TBUF. * * CALLING SEQUENCE: * A = MAX. NO. OF CD HARACTERS TO BE MOVED. THE SIGN OF A * DESIGNATES THE POSITION OF THE FIRST CHARACTER. * IF THE SIGN OF A IS POSITIVE, THE FIRST CHAR IS TO * BE MOVED TO THE LOW CHAR IN \TBUF. IF A IS NEGATIVE, THE * FIRST CHARACTER IS TO BE MOVED TO THE UPPER CHAR IN \TBUF. * B = IGNORED * JSB \GETN * * RETURN: * A = FIRST CHAR (IF ONLY 1 CHAR) OR FIRST 2 CHARS MOVED. * B = DESTROYED * \GETN NOP CCE,SSA,RSS SET E = 1 (EVEN) POSITION CMA,CLE,INA SET E = 0 (ODD) POSITION - COMP STA MAXC MAXC = MAXIMUM NO. CHARS LDA ATBUF ATBUF = ADDR OF TBUF STA CURAT SET CURRENT TBUF ADDRESS CLB STB ATBUF,I CLEAR WORD 1 OF TBUF CCA STA \CMFL SET COMMA-IN FLAG SEZ,RSS SKIP - ODD POSITION JMP OCHAR BEGIN WITH ODD CHARACTER NEXTC JSB \GETC GET CHAR FROM \LBUF SZA,RSS END OF BUFFER? LDA BLANK YES - REPLACE CHAR WITH BLANK ALF,ALF ROTATE TO UPPER A STA CURAT,I SET CHARACTER IN TBUF ISZ MAXC CHECK FOR ALL CHARS IN JMP OCHAR GET ODD CHAR FROM \LBUF LDA ATBUF,I GET FIRST 2 TRANSFERRED CHARS JMP \GETN,I YES - RETURN OCHAR JSB \GETC GET CHAR FROM \LBUF SZA,RSS END OF BUFFER? LDA BLANK REPLACE ZERO CHAR WITH BLANK IOR CURAT,I ADD TO UPPER CHAR IN TBUF STA CURAT,I SET CHARS IN TBUF ISZ CURAT INCR TBUF ADDRESS ISZ MAXC CHECK FOR ALL CHARS IN JMP NEXTC NO - TRY NEXT UPPER CHAR LDA ATBUF,I GET FIRST 2 TRANSFERRED CHARS JMP \GETN,I RETURN * CURAT NOP CURRENT TBUF ADDR. ATBUF DEF \TBUF MAXC NOP MAX. CHAR COUNT. SKP * * CONVERT OCT/DEC ASCII TO BINARY * * THE \GET# SUBROUTINE CONVERTS THE NEXT CHARACTERS IN \LBUF FROM * ASCII (DECIMAL OR OCTAL) TO THEIR BINARY VALUE. * * CALLING SEQUENCE: * A = MAX. NO. OF CHARS IN CONVERSION REQUEST. IF A IS * POSITIVE, THE REQUEST IS FOR OCTAL; IF A IS NEGATIVE, * THE REQUEST IS FOR DECIMAL. * B = IGNORED * JSB \GET# * * RETURN: * (N+1): INVALID DIGIT OR OVERFLOW IN CONVERSION * (N+2): A = CONVERTED NO. * B = DESTROYED * \GET# NOP LDB N8 GET OCTAL RANGE SSA SKIP IF OCTAL REQUEST LDB N10 GET DECIMAL RANGE STB DRANG SET DIGIT RANGE SSA,RSS SKIP IF DECIMAL REQUEST CMA,INA SET REQUEST COUNT TO NEGATIVE STA MAXC SET MAX NO. OF DIGITS CCA STA DIFLG SET DATA-IN FLAG = NO DATA IN STA \CMFL SET COMMA-IN FLAG CLA STA \OCTN \OCTN = OCTAL NUMBER GETNX JSB \GETC GET CHAR FROM \LBUF SZA,RSS CHAR = ZERO? (END OF BUFFER) JMP ENDOC YES - RETURN CPA BLANK CHAR = BLANK? (COMMA IN) JMP ENDOC YES - RETURN ADA L60 SUBTRACT 60B FROM CHAR STA \TCHR SAVE CHAR SSA SKIP IF VALID LOWER LIMIT JMP DGERR INVALID DIGIT ADA DRANG ADD DIGIT RANGE CLE,SSA,RSS CLEAR E - SKIP IF VALID DIGIT JMP DGERR INVALID DIGIT ISZ DIFLG INCR DATA-IN FLAG, SKIP NOP LDA \OCTN GET PREVIOUS OCTAL NO. ADA A SET A = \OCTN X 2 ADA A SET A = \OCTN X 4 LDB DRANG GET DIGIT RANGE CPB N10 RANGE = DECIMAL? ADA \OCTN SET A = \OCTN X 5 ADA A SET A = \OCTN X 10/8 ADA \TCHR SET A = NEW OCTAL NO. STA \OCTN SAVE NEW OCTAL NO. SEZ TEST FOR OVERFLOW JMP DGERR INVALID NO. ISZ MAXC SKIP IF ALL DIGITS PROCESSED JMP GETNX GET NEXT DECIMAL DIGIT ISZ \GET# INCR RETURN ADDRESS LDA \OCTN GET OCTAL EQUIVALENT DGERR JMP \GET#,I RETURN ENDOC ISZ DIFLG SKIP - NO DATA IN JMP *-4  DATA IN - NORMAL RETURN JMP \GET#,I RETURN - ERROR * \TCHR NOP TEMP CHAR SAVE AREA. DIFLG NOP DATA-IN FLAG= -1/0= NOT IN/IN. DRANG NOP DIGIT RANGE. \OCTN NOP OCTAL DIGIT. L60 OCT -60 N10 DEC -10 N8 DEC -8 SKP * * INITIALIZE CHAR TRANSFER * * THE \GINT SUBROUTINE SETS THE CURRENT ADDRESS AND UPPER/LOWER * FLAG FOR SCANNING \LBUF. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB \GINT * * RETURN : CONTENTS OF A AND B ARE DESTROYED * \GINT NOP LDA ALBUF ALBUF = ADDR OF \LBUF STA \CURL SET CURRENT \LBUF ADDRESS CCB STB \BUFL \BUFL = BUFFER U/L FLAG JMP \GINT,I SPC 10 * * INVALID TTY RESPONSE * * THE \INER SUBROUTINE PRINTS THE DIAGNOSTIC FOR INVALID * RESPONSES DURING THE INITIALIZATION SECTION. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB \INER * * RETURN: CONTENTS OF A AND B ARE DESTROYED. * \INER NOP LDA ERR01 SET INVALID DEVICE ERROR CODE JSB \GNER PRINT \GNER MESSAGE JMP \INER,I RETURN SPC 1 ERR01 ASC 1,01 SKP * SUBROUTINE TO READ INPUT * \RNME NOP READ FILE NAME. ISZ RMODE JSB \READ CLB STB RMODE JMP \RNME,I * * \READ NOP STA READ2 SZA,RSS IF ZERO, THEN NULL PROMPT LDB ALBUF SO PUT A BOGUS ADDRESS IN READB STB READ1 READ0 JSB \PRMT DEF *+6 READ1 NOP MSG BUFR NULL IF NO PROMPT. DEF READ2 ZERO LEN IF NO PROMPT. ALBUF DEF \LBUF DEF P80 DEF PARSA * STA PARNO SAVE PARAM RECORD LENGTH LDA \TBUF STA TEMP4 SAVE IT JSB \GINT CLA,INA JSB \GETN IF FIRST CHAR IS A BLANK CPA BLANK OR A * THEN SKIP RECORD RSS JMP READ5 NOT SO CLA F STA READ2 DON'T REISSUE PROMPT JMP READ0 * READ5 LDA TEMP4 STA \TBUF RESTORE LDB RMODE CHECK WHICH ENTRY. SZB JMP \READ,I LDA PARNO INA CLE,ERA CONVERT TO WORD ADDR. ADA ALBUF GET TO END OF BUFFER. CLB INSERT ZERO AT END. STB A,I JSB \GINT INITIALIZE \LBUF SCAN. LDA PARNO RETURN WITH RECORD LEN. JMP \READ,I SPC 1 READ2 NOP RMODE OCT 0 PARNO NOP TEMP4 NOP P80 DEC 80 SKP * * ANALYZE YES/NO RESPONSE * RETURN: (P+1) ERROR * (P+2) NO * (P+3) YES * \YENO NOP LDA N3 JSB \GETN JSB \GETC SZA MORE THEN 3 CHAR JMP YE/ER ERROR LDB ATBUF,I GET RESPONSE CPB YCHAR YE? LDA P2 YES - SET RETURN OFFSET FOR YES CPB NCHAR WAS IT NO? CLA,INA YES - SET RETURN FOR YES SZA,RSS STILL ZERO? JMP YE/ER YES - NOT YES OR NO - ERROR ADA \YENO ADJUST RETURN JMP A,I RETURN YE/ER JSB \INER ERROR - SEND MESSAGE JMP \YENO,I AND TAKE ERROR EXIT SPC 1 YCHAR ASC 1,YE NCHAR ASC 1,NO N3 DEC -3 SPC 5 * * NEW LINE (CR,LF) ON TTY * * THE \SPAC SUBROUTINE IS USED TO \SPAC UP THE TELEPRINTER. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB \SPAC * * RETURN: CONTENTS OF A AND B ARE DESTROYED. * \SPAC NOP LDB DBLNK GET ADDRESS OF A BLANK CLA,INA SET CHARACTER COUNT = ONE JSB \MESS OUTPUT CR, LF ON TTY JMP \SPAC,I RETURN * DBLNK DEF UBLNK UBLNK OCT 20000 SKP * * PRINT: ERR XX * * THE ERROR SUBROUTINE IS USED TO PRINT THE DIAGNOSTICS * FOR ALL ERROR MESSAGES. * * CALLING SEQUENCE: * A = 2-DIGIT ASCII ERROR CODE, IF NEG THEN DON'T DO A TR,ERRLU * B = IGNORJED * JSB \GNER * * RETURN: CONTENTS OF A AND B ARE DESTROYED. * \GNER NOP PRINT ERROR MESSAGES CLE IF A IS NEG THEN SET IT POSITIVE SSA AND DON'T DO A TR CME SEZ CMA,INA STA AMERR+5 SET ERROR CODE INTO MESSAGE SEZ JMP EROUT LDA \IACM IS COMMAND LU INTERACTIVE ALREADY? SZA JMP EROUT YES * LDA \TRCH SAVE RETURN ADDRESS OF \TRCH IN CASE ITS STA \ABOR CALLING ERROR LDA \TRCM SIMULATE THE "TR,ERRLU" LDB B6 JSB \TRCH GO PUSH THE STACK LDA \ABOR RESTORE \TRCH RETURN ADDRESS STA \TRCH * LDA EOFFL NO MESSAGE IF EOF-GENERATED SZA JMP \GNER,I * EROUT JSB \SPAC LDA P10 LDB AMERR AMERR = MESSAGE ADDRESS JSB \MESS PRINT ERROR MESSAGE ISZ ERCNT BUMP ERROR COUNTER JMP \GNER,I RETURN * \TRCM DEF TRCOM TRCOM ASC 3,TR, XX EOFFL NOP ERCNT NOP ERROR COUNTER SKP * * IRRECOVERABLE ERROR EXIT * \IRER NOP JSB \GNER PRINT \GNER MESSAGE JSB \TERM IRRECOVERABLE ERROR * AMERR DEF *+1 ASC 5,GEN ERR ERROR MSG = ERR + CODE SPC 5 \ABOR NOP FORMERLY "HLT 0B". CCA ADA \ABOR GET ADDR OF \ABOR CALLER. LDB DER00 JSB \CONV PUT IN MESSAGE. LDA P18 LDB ABERR JSB \MESS DISPLAY ER00 AND ADDRESS. ISZ ERCNT BUMP ERROR COUNTER JSB \TERM ABORT (NO RETURN). * ABERR DEF ERR00 ERR00 ASC 9,GEN ERR 00 DER00 DEF ERR00+6 P18 DEC 18 SKP * * THE \INID,\IDXS AND \IDX SUBROUTINES ARE USED TO SET THE CURRENT * INDICES FOR THE ENTRY IN THE PROGRAM IDENTIFICATION * BLOCK TABLE (IDENT). THE INDEX OF THE NEXT ENTRY * IN THE IDENT TABLE IS CONTAINED IN \TIDN. ON RETURN FROM * \IDX, \TIDN CONTAINS THE INDEX OF THE NEXT AVAILABLE * ENTRY I N IDENT. THE ADDRESS OF THE FIRST ENTRY IS CONTAINED * IN BIDNT AND THE # ENTRIES USED IS IN \PIDN. * * \IDXS FINDS AN ENTRY IN THE TABLE. * * IF THE NEXT IDENT ENTRY OVERFLOWS INTO THE LAST LST ENTRY, * \IDX PRINTS A DIAGNOSTIC AND EXITS TO THE IRRECOVERABLE ERROR * SUBROUTINE. * * SET INITIAL IDENT ADDRESS * * \INID SETS THE INDEX OF THE FIRST ENTRY IN THE IDENT * TABLE AS THE CURRENT INDEX. * * NOTE. OFFSET = 10 TO AVOID PROBLEMS WITH VALUES * 1-5 IN LST WORD 4. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB \INID * * RETURN: CONTENTS OF A DESTROYED, B PRESERVED * \INID NOP LDA P10 RESET CURRENT IDENT INDEX. STA \TIDN (HAS OFFSET OF 10) JMP \INID,I RETURN SKP * * \IDXS FINDS AN ID ENTRY IN THE IDENT TABLE. * * CALLING SEQUENCE: * A = IGNORED * B = ADDRESS OF THE NAME TO FIND. * JSB \IDXS * * RETURN: CONTENTS OF A AND B ARE DESTROYED. * (N+1): CURRENT IDENT ADDRESSES ARE FOR THE NEXT FREE ENTRY IN * THE IDENT LIST. SYMBOL NOT FOUND. * (N+2): CURRENT IDENT ADDRESSES ARE FOR THE SPECIFIED PROGRAM. * \IDXS NOP JSB \INID INIT \TIDN TO 1ST IDENT. STB \INID SAVE POINTER TO ASCII NAME. * ** OTHER SUBS MAY WANT NAME PTR IN \INID ** * IDSX2 JSB \IDX SET IDENT ENTRY ADDRESSES. JMP \IDXS,I END OF TABLE. \ID1,\ID2,... SET. LDB \INID GET ADDR OF TARGET MATCH. LDA B,I CPA \ID1,I CHAR 1 & 2 MATCH? INB,RSS JMP IDSX2 NO. GET NEXT ENTRY. LDA B,I CPA \ID2,I CHAR 3 & 4 MATCH? INB,RSS JMP IDSX2 NO. GET NEXT ENTRY. LDA B,I XOR \ID3,I AND M7400 CHECK CHAR 5. SZA JMP IDSX2 NOT THIS ENTRY. ISZ \IDXS FOUND. TAKE SUCCESS RETURN. JMP \IDXS,I SKP * SET IDENT ADDRESSES FROM \TIDN * * \IDX SETS  THE ADDRESSES OF THE CURRENT 11-WORD ENTRY IN THE * IDENT TABLE FROM THE INDEX OF THE CURRENT ENTRY (\TIDN). * THE \TIDN ENTRY MAY REFERENCE CURRENT/FORWARD/BACKWARD * BLOCKS. \IDX ASSURES THAT THE PROPER BLOCK IS IN CORE. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB \IDX * * RETURN: CONTENTS OF A DESTROYED, B PRESERVED. * (N+1): CURRENT IDENT ADDRESSES ARE THE ADDRESSES * OF THE NEXT AVAILABLE IDENT ENTRY, OR THE * END OF THE IDENT TABLE HAS BEEN REACHED. * (N+2): CURRENT IDENT ENTRY ADDRESSES (NOT END OF IDENT) * \IDX NOP STB \ID16 TEMP SAVE LDA B.I CHECK IF ENTRY IN CORE (DOT OK). CMA,INA ADA \TIDN SSA JMP IDX0 .LT. LOW ENTRY INDEX. * LDA B.I (NOT "B,I" - DOT OK) ADA EIDNT CMA,INA ADA \TIDN SSA JMP IDX2 IN CORE. * IDX0 LDA \TIDN .GT. HIGH ENTRY INDEX. ADA N10 CLB DIV EIDNT GET BLOCK NO. STA B.I TEMP SAVE... DOT OK. MPY ID.#S GET # SECTORS OFFSET. CLB DIV SECTK CHECK TRACK SPILL OVER. STB ID.CS REMAINDER= NEW CURR. SECTOR. ADA ID.BT STA ID.CT NEW CURRENT TRACK. * ADB ID.#S GET LAST+1 SECTOR OF BLOCK. CMB,INB ADB SECTK SSB,RSS JMP *+4 CLB STB ID.CS IF END NOT ON SAME TRACK, ISZ ID.CT START BLOCK ON NEXT TRACK * CPA ID.ET END OF IDENT DISK AREA? JMP LSERR YES. IDENT OVERFLOW! * JSB RDIDN WRITE/READ THE DISC. LDA B.I DOT OK. SET NEW LOW INDEX. MPY EIDNT ADA P10 ADD THE OFFSET. STA B.I DOT OK. IDX2 LDA \TIDN GET ADDR OF DESIRED ENTRY. ADA N10 ADJUST FOR OFFSET. CLB DIV EIDNT LDA B REMAINDER = OFFSET. ALF MULTIPLY BY 16 WORDS PER ENTRY ADA BIDNT STA \ID1 SET ADDRESS OF NAME 1,2 INA STA \ID2 SET ADDRESS OF NAME 3,4 INA STA \ID3 SET ADDRESS OF NAME 5, USE FLAG INA STA \ID4 SET ADDRESS OF COM/PROG LENGTH INA STA \ID5 SET ADDRESS OF LINKS-MAP OPT FLAGS. INA STA \ID6 SET ADDRESS OF M/S,PRIOR/DISK,TY INA STA \ID7 SET ADDRESS OF LOWEST DBL. INA STA \ID8 SET MAIN IDENT ADDR FOR BS INA STA \ID9 SET FILE NAME ADDRESSES. INA STA \ID10 INA STA \ID11 INA STA \ID12 SET ADDRESS OF SECURITY CODE INA STA \ID13 SET ADDRESS OF CR LABEL . INA STA \ID14 SET ADDRESS OF RECORD NUMBER INA STA \ID15 SET ADDRESS OF REL. BLOCK INA LDB \ID16 RESTORE B-REG STA \ID16 SET ADDRESS OF BLK OFFSET * LDA \PIDN CHECK IF END OF IDENT. CMA,INA ADA \TIDN SSA ISZ \IDX NOT END. P+2 EXIT. ISZ \TIDN SET NEXT IDENT ENTRY. JMP \IDX,I RETURN * B.I DEC 10 1ST ENTRY INDEX OF CUR CORE BLOCK. * (OFFSET = 10) SPC 3 * POINTERS FOR IDENT TABLE. * BIDNT NOP FWA CORE BLOCK. \TIDN NOP CURRENT ENTRY INDEX IN CORE BLOCK. \PIDN NOP # ENTRIES USED + 10. EIDNT NOP # IDENT ENTRIES PER CORE BLOCK. LIDNT NOP # WORDS PER DISC WRITE/READ. ID.BT NOP START TRACK ID.LT NOP LAST TRACK ID.LS NOP AND SECTOR READ. ID.CT NOP CURRENT TRACK ID.CS NOP AND SECTOR (OR NEXT REQUIRED). ID.ET NOP ENDING TRACK ID.#S NOP # SECTORS PER BLOCK. * \ID1 NOP \ID2 NOP \ID3 NOP \ID4 NOP \ID5 NOP \ID6 NOP \ID7 NOP \ID8 NOP \ID9 NOP \ID10 NOP \ID11 NOP \ID12 NOP \ID13 NOP \ID14 NOP \ID15 NOP \ID16 NOP SKP * * SUBROUTINv E TO WRITE-READ IDENT TABLE FROM DISC. * CALLING SEQUENCE: * JSB RDIDN * RDIDN NOP LDA ID.LS GET LAST SECTOR ADDR. LDB ID.LT GET LAST TRACK ADDR. CPA ID.CS EQUAL TO CURRENT? RSS YES. JMP RDID1 NO. WRITE AND READ. CPB ID.CT SAME TRACK? JMP RDIDN,I YES, RETURN. * RDID1 LDA BIDNT STA WI1 STA WI2 * JSB EXEC WRITE OUT CURRENT BLOCK. DEF *+7 DEF P2 DEF DSKLU WI1 NOP DEF LIDNT DEF ID.LT DEF ID.LS * JSB EXEC READ NEW BLOCK. DEF *+7 DEF B1 DEF DSKLU WI2 NOP DEF LIDNT DEF ID.CT DEF ID.CS * LDA ID.CT RESET TRACK & SECTOR ADDRS. STA ID.LT LDA ID.CS STA ID.LS JMP RDIDN,I SKP * * THE \ILST, \LSTS, \LSTE AND \LSTX SUBROUTINES ARE USED TO SET THE * CURRENT LOADER SYMBOL TABLE (LST) INDICES. THE INDEX OF THE * NEXT ENTRY IN LST IS CONTAINED IN \TLST. ON RETURN FROM \ILST, * \TLST CONTAINS THE INDEX OF THE NEXT AVAILABLE ENTRY IN LST, OR * THE INDEX OF THE END OF LST. THE ADDRESS OF THE FIRST ENTRY * IN LST IS AT BLST AND THE # ENTRIES USED IS IN \PLST. * * IF THE NEXT ENTRY IN LST OVERFLOWS CORE-DISC SPACE, * \LSTX PRINTS A DIAGNOSTIC AND EXITS * TO THE IRRECOVERABLE ERROR SUBROUTINE. * * \ILST SETS THE ADDRESS OF THE FIRST ENTRY IN LST. * \ILST NOP CLA STA \TLST RESET CURRENT LST INDEX. JMP \ILST,I RETURN SKP * * \LSTS SEARCHES THE LST FOR A SPECIFIED ENTRY. * * CALLING SEQUENCE: * A = IGNORED * B = ADDRESS OF THE ASCII NAME TO BE FOUND. * JSB \LSTS * * RETURN: CONTENTS OF A AND B DESTROYED. * (N+1): THE END OF THE LST WAS FOUND WITH OUT FINDING THE * SYMBOL. THE LST ENTRIES ARE SET TO THE NEXT AVAILABLE * ENTRY. * (N+2): THE CURRENT LST ADDRESS POINT TO THE FOUND ENTRY. * \LSTS NOP JS%CB \ILST INIT \TLST TO 1ST LST INDEX. STB \ILST SAVE PTR TO ASCII NAME * ** SOME SUBS EXPECT \LSTS TO STORE THIS ** * ** POINTER IN \ILST'S ENTRY POINT ** LSTS2 JSB \LSTX SET LST ENTRY ADDRESSES. JMP \LSTS,I END OF TABLE. \LST1,...,\LST5 SET. LDB \ILST GET ADDR OF TARGET MATCH. LDA B,I CPA \LST1,I CHAR 1 & 2 MATCH? INB,RSS JMP LSTS2 NO. GET NEXT ENTRY. LDA B,I CPA \LST2,I CHAR 3 & 4 MATCH? INB,RSS JMP LSTS2 NO. GET NEXT ENTRY. LDA B,I XOR \LST3,I AND M7400 CHECK CHAR 5. SZA JMP LSTS2 NOT THIS ENTRY. ISZ \LSTS FOUND. TAKE SUCCESS RETURN. JMP \LSTS,I SKP * SET LST ADDRESSES FROM \TLST * * \LSTX SETS THE CURRENT LST ADDRESSES FROM \TLST. THE \TLST ENTRY * MAY REFERENCE CURRENT-FORWARD-BACKWARD BLOCKS. \LSTX ASSURES * THAT THE PROPER CORE BLOCK IS IN CORE. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB \LSTX * * RETURN: CONTENTS OF A DESTROYED, B PRESERVED. * (N+1): THE END OF LST IS REACHED AND THE CURRENT * LST ADDRESSES ARE THE ADDRESSES OF THE NEXT AVAILABLE * ENTRY IN LST. * (N+2): CURRENT LST ADDRESSES ARE SET (NOT END OF LST). * \LSTX NOP STB \LST5 TEMP SAVE LDA B.L CHECK IF ENTRY IN CORE. CMA,INA ADA \TLST SSA JMP LSTX0 .LT. LOW ENTRY INDEX. * LDA B.L ADA ELST CMA,INA ADA \TLST SSA JMP LSTX2 * LSTX0 LDA \TLST .GT. HIGH ENTRY INDEX. CLB DIV ELST GET BLOCK NUMBER. STA B.L SAVE FOR LATER. MPY LS.#S GET # SECTORS OFFSET. CLB DIV SECTK SEE IF TRACK SPILL OVER. STB LS.CS REMAINDER= NEW CUR. SECTOR. ADA LS.BT STA LS.CT NEW CURRENT TRACK. * AD}HFBB LS.#S GET LAST+1 SECTOR OF BLOCK. CMB,INB ADB SECTK IF END NOT ON SAME TRACK, SSB,RSS START BLOCK ON NEXT TRACK. JMP *+4 CLB STB LS.CS ISZ LS.CT * CPA LS.ET END OF LST DISC AREA? H JMP LSERR YES. LST OVERFLOW! * JSB RDSMB WRITE/READ THE DISC. LDA B.L SET NEW LOW INDEX. MPY ELST STA B.L LSTX2 LDA \TLST GET ADDR OF DESIRED ENTRY. CLB DIV ELST LDA B REMAINDER= OFFSET. MPY P5 ADA BLST STA \LST1 SET WORD 1 ADDR. INA STA \LST2 SET WORD 2 ADDR INA STA \LST3 SET WORD 3 ADDR INA STA \LST4 SET WORD 4 ADDR INA LDB \LST5 RESTORE B-REG STA \LST5 SET WORD 5 ADDR LDA \PLST CHECK IF END OF LST. CMA,INA ADA \TLST SSA ISZ \LSTX NOT END. P+2 EXIT. ISZ \TLST SET NEXT LST INDEX. JMP \LSTX,I RETURN * B.L OCT 0 1ST ENTRY INDEX NOW IN CORE. * LSERR LDA ERR07 JSB \IRER IRRECOVERABLE ERROR EXIT * ERR07 ASC 1,07 IDENT/LST/FIX-UP OVERFLOW. SKP * ENTER A NEW SYMBOL * * \LSTE SEARCHS THE LST FOR A SYMBOL AND IF NOT FOUND ENTERS IT * IN THE LST. * * CALLING SEQUENCE: * A = IGNORED * B = SYMBOL ADDRESS * JSB \LSTE * * RETURN: CONTENTS OF A AND B ARE DESTROYED. * (N+1): SYMBOL IS NEW AND WAS ENTRED, LST ADDRESS ARE SET UP * (N+2): SYMBOL WAS IN LST. LST ADDRESS ARE SET UP. * \LSTE NOP JSB \LSTS SEARCH FOR THE SYMBOL JMP LSTE2 IF NOT FOUND GO ENTER * ISZ \LSTE STEP TO ALREADY IN LST EXIT JMP \LSTE,I AND EXIT * LSTE2 LDB \ILST,I GET THE FIRST CHARACTERS OF NEW STB \LST1,I SYMBOL AND SET IN THE LIST ISZ \ILST STEP TO NEXT CHARACTERS LDA \ILST,I GET THE CHARACTERS STA \LST2,I AND SET ISZ \ILST STEP TO THE LAST CHARACTER LDA \ILST,I FETCH IT AND M7400 KEEP ONLY THE HIGH CHARACTER STA \LST3,I SET IT IN THE LST CLA CLEAR STA \LST4,I THE IDENT FLAG STA \LST*5,I AND VALUE FIELDS ISZ \PLST BUMP # LST ENTRIES. JMP \LSTE,I EXIT BACK TO THE USER. SKP * * * POINTERS FOR LOADER SYMBOL TABLE (LST). * BLST NOP FWA CORE BLOCK. \TLST NOP CURRENT ENTRY INDEX IN CORE BLOCK. \PLST NOP # ENTRIES USED. ELST NOP # LST ENTRIES PER CORE BLOCK. LLST NOP # WORDS PER DISC WRITE/READ. LS.BT NOP START TRACK LS.LT NOP LAST TRACK LS.LS NOP AND SECTOR READ. LS.CT NOP CURRENT TRACK LS.CS NOP AND SECTOR (OR NEXT REQUIRED). LS.ET NOP ENDING TRACK LS.#S NOP # SECTORS PER BLOCK. * \LST1 OCT 0 \LST2 OCT 0 \LST3 OCT 0 \LST4 OCT 0 \LST5 OCT 0 SKP * * SUBROUTINE TO READ/WRITE SYMBOL TABLE FROM DISC * CALLING SEQUENCE * JSB RDSMB * RDSMB NOP LDA LS.LS GET LAST SECTOR ADDRESS LDB LS.LT GET LAST TRACK ADDRESS CPA LS.CS IS IT EQUAL TO CURRENT? RSS YES JMP WTSMT NO...WRITE AND READ CPB LS.CT HOW ABOUT THE TRACK ADDRESS? JMP RDSMB,I SAME THING...DON'T DO ANYTHING * WTSMT LDA BLST STA WS1 STA WS2 * JSB EXEC GO WRITE OUT CURRENT DEF *+7 DEF P2 DEF DSKLU WS1 NOP DEF LLST DEF LS.LT DEF LS.LS * JSB EXEC READ IN NEW BLOCK DEF *+7 DEF B1 DEF DSKLU WS2 NOP DEF LLST DEF LS.CT DEF LS.CS * LDA LS.CT STA LS.LT LDA LS.CS STA LS.LS RESET TRACK SECTOR ADDRESS JMP RDSMB,I AND RETURN SKP * * THE \IFIX AND \FIX SUBROUTINES ARE USED TO SET THE * CURRENT FIX-UP TABLE INDICES. * * \IFIX SETS THE INDEX OF THE FIRST ENTRY IN THE FIX-UP * TABLE AS THE CURRENT ENTRY. * \IFIX NOP CLA STA \TFIX JMP \IFIX,I SPC 5 * * \FIX SETS THE CURRENT FIX-UP ADDRESSES FROM \TFIX/. * THE \TFIX ENTRY MAY REFERENCE CURRENT-FORWARD-BACKWARD * BLOCKS. FIX ASSURES THAT THE PROPER BLOCK IS IN CORE. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB \FIX * * RETURN: A LOST, B SAVED. * P+1 IF BEYOND END OF DEFINED FIX-UPS * P+2 IF DEFINED ENTRY. * \FIX NOP STB \FIX4 TEMP SAVE LDA B.F CHECK IF ENTRY IS IN CORE. CMA,INA ADA \TFIX SSA JMP FIX0A .LT. LOW ENTRY INDEX. * LDA B.F ADA EFIX CMA,INA ADA \TFIX SSA JMP FIX0C * FIX0A LDA \TFIX .GT. HIGH ENTRY INDEX. CLB DIV EFIX GET BLOCK NUMBER. STA B.F MPY FX.#S GET # SECTORS OFFSET. CLB DIV SECTK SEE IF TRACK SPILL OVER. STB FX.CS REMAINDER = NEW CURRENT SECTOR. ADA FX.BT STA FX.CT NEW CURRENT TRACK. * ADB FX.#S GET LAST+1 SECTOR OF BLOCK. CMB,INB ADB SECTK IF END NO ON SAME TRACK, SSB,RSS START BLOCK ON NEXT TRACK. JMP *+4 CLB STB FX.CS ISZ FX.CT * CPA FX.ET END OF FIX-UP DISC AREA? JMP LSERR YES. FIX-UP OVERFLOW! * JSB RDFIX WRITE/READ THE DISC. LDA B.F SET NEW LOW INDEX. MPY EFIX STA B.F FIX0C LDA \TFIX GET ADDR OF DESIRED ENTRY. CLB DIV EFIX LDA B REMAINDER = OFFSET. MPY P4 ADA BFIX STA \FIX1 SET WORD 1 ADDR. INA STA \FIX2 SET WORD 2 ADDR. INA STA \FIX3 SET WORD 3 ADDR. INA LDB \FIX4 RESTORE B-REG STA \FIX4 SET WORD 4 ADDR. LDA \PFIX CHECK IF END OF DEFINED FIX-UPS. CMA,INA ADA \TFIX SSA ISZ \FIX NOT END. P+2 EXIT. ISZ \TFIX SET NEXT FIX-UP ENTRY. JMP \FIX,I RETURN. * B.F OCT 0 LOW INDEX OF BLOCK IN CORE SKP * * * POINTERS FOR FIX-UP TABLE. * BFIX NOP FWA CORE BLOCK. \TFIX NOP CURRENT ENTRY INDEX IN CORE BLOCK. \PFIX NOP # ENTRIES USED. EFIX NOP # FIX-UP ENTRIES PER CORE BLOCK. LFIX NOP # WORDS PER DISC WRITE/READ. FX.BT NOP START TRACK FX.LT NOP LAST TRACK FX.LS NOP AND SECTOR READ. FX.CT NOP CURRENT TRACK FX.CS NOP AND SECTOR (OR NEXT REQUIRED). FX.ET NOP ENDING TRACK FX.#S NOP # SECTORS PER BLOCK. * \FIX1 NOP \FIX2 NOP \FIX3 NOP \FIX4 NOP SKP * * SUBROUTINE TO READ/WRITE FIX-UP TABLE FROM DISC. * CALLING SEQUENCE: * JSB RDFIX * RDFIX NOP LDA FX.LS GET LAST SECTOR ADDRESS. LDB FX.LT GET LAST TRACK ADDRESS. CPA FX.CS IS IT EQUAL TO CURRENT? RSS YES. JMP RDFX1 NO... WRITE AND READ. CPB FX.CT HOW ABOUT TRACK ADDRESS? JMP RDFIX,I SAME THING... DON'T TO ANYTHING. * RDFX1 LDA BFIX STA WX1 SET BUFFER ADDRESS. STA WX2 * JSB EXEC GO WRITE OUT CURRENT BLOCK. DEF *+7 DEF P2 DEF DSKLU WX1 NOP DEF LFIX DEF FX.LT DEF FX.LS * JSB EXEC READ IN NEW BLOCK. DEF *+7 DEF B1 DEF DSKLU WX2 NOP DEF LFIX DEF FX.CT DEF FX.CS * LDA FX.CT RESET TRACK & SECTOR ADDRESSES. STA FX.LT LDA FX.CS STA FX.LS JMP RDFIX,I RETURN. SKP * * SUBROUTINE TO CLOSE AND PURGE ALL FILES * CURRENTLY OPEN TO PROGRAM IN CASE OF ABORT * * JSB \TERM * * \TERM NOP LDA ABDCB+5 GET # OF SECTORS CLE,ERA CONVERT TO BLOCKS STA BLKS AND SAVE IT JSB \CLOS PURGE THE FILE!!! DEF *+3 DEF ABDCB DEF BLKS * JSB CLOSE PURGE THE BOOT FILE(IF ANY) DEF *+4 DEF \BDCB DEF \FMRR DE4:F B1 JMP CONTA * * ENTER HERE FOR NORMAL CLEANUP AT END OF GENERATION * \EXIT JSB \CLOS CLOSE BOOT FILE (IF ANY) DEF *+3 IGNORING ANY ERRORS DEF \BDCB DEF ZERO * LDA DFIN LDB DAB GET ADDRESS INTO MESSAGE MVW P4 AND SENT "FINISHED" * CONTA LDB DFABM GET BUFFER ADDRESS LDA P14 AND COUNT JSB \LOUT SEND THE TERMINATION MESSAGE JSB \SPAC * LDA ERCNT NOW PRINT THE # OF ERRORS CMA,INA FOR THIS GENERATION LDB ERMSG JSB \CONV LDA P12 LDB ERMSG INB JSB \MESS * JSB CLOSE PURGE TEMP NEW NAM FILE. DEF *+4 DEF \NDCB DEF \FMRR DEF P64 * JSB \CLOS CLOSE LIST FILE DEF *+3 DEF \LDCB DEF ZERO * JSB \CLOS CLOSE RELOCATABLE INPUT FILE IF OPEN DEF *+3 DEF \RDCB DEF ZERO * JSB \CLOS CLOSE ANSWER FILE DEF *+3 DEF \IDCB DEF ZERO * * * AT THIS POINT ALL FILES ARE CLOSED OR PURGED * TELL WORLD WE ARE DONE * LDA IALST ABORT MESSAGE ALREADY SZA PRINTED? JMP RELTR JSB EXEC PRINT OUT ABORT MESSAGE DEF *+5 DEF P2 DEF ERRLU DFABM DEF ABMSG "RT4GN -------" DEF B7 * RELTR JSB EXEC RELEASE TRACKS DEF *+3 DEF P5 DEF M1 JSB EXEC AND TURN OFF DEF *+2 DEF B6 SPC 1 DAB DEF *+4 ABMSG ASC 3,RT4GN ASC 4,ABORTED B1 OCT 1 B6 OCT 6 B7 OCT 7 BLKS NOP \.NM. ASC 1,@@ ASC 1,NM NAMM ASC 1,@A * ERMSG DEF *+1 ASC 7, ERRORS DFIN DEF *+1 ASC 4,FINISHED SKP * * SUBROUTINE TO WRITE ON INTERACTIVE COMMAND INPUT DEVICE * AND LIST FILE * CALLING SEQUENCE * JSB \MESS * A REG= SIO LENGTH WORD * B REG= ADDRESS OF MESSAGE * \MESS NOP  DST ABREG SAVE A AND B REG FOR \LOUT JSB BYTCN CONVERT SIO TO USUAL INB SKIP OVER LEADING SPACE ADA M1 CUT COUNT NOT INCLUDE SPACE STA PRNTA SAVE LENGTH STB PRNTB SAVE ADDRESS LDA IALST IS THE LIST FILE AN I.A. LU? SZA JMP PRNT1 YES, SO DONT PRINT MESSAGE TWICE LDA \IACM IS THE COMMAND DEVICE I.A.? SZA,RSS JMP PRNT1 NO, SO DONT WRITE TO IT * JSB WRITF OUTPUT MESSAGE DEF *+5 DEF \IDCB TO THE INPUT DEVICE DEF \FMRR PRNTB NOP DEF PRNTA LENGTH * PRNT1 DLD ABREG GET LENGTH AGAIN JSB \LOUT WRITE TO FILE JMP \MESS,I AND RETURN SPC 1 PRNTA NOP M1 DEC -1 SKP * SUBROUTINE TO CONVERT SIO LENGTH TO POSITIVE WORDS * BYTCN NOP STA BYTCA SAVE LENGTH FOR CHECKING LATTER SSA WORDS OR CHARACTERS? JMP *+3 WORDS CMA,INA CONVERT CHAR TO WORDS ARS DIVIDE BY 2+1 STA BYTCC SAVE IN DOWN COUNTER STB BYTCD SAVE B TEMPORARILY. LDB N40 TRUNCATE TO 40 WORDS. ADA P40 SSA STB BYTCC LDB BYTCD RESTORE B. LDA LSBFA GET ADDRESS WHERE TO PUT OUTPUT STA BYTCD SAVE FOR MOVE BYTC1 LDA B,I MOVE MESSAGE STA BYTCD,I ISZ BYTCD INB ISZ BYTCC DONE? JMP BYTC1 NO LDB BYTCA WORDS OR CHARACTERS? SSB JMP BYTC2 WORDS CLE,ERB CONVERT CHARACTERS TO WORDS SEZ,RSS ODD # OF CHAR? JMP BYTC3 NO STB BYTCC YES...SAVE COUNT FOR LATTER ISZ BYTCC INCLUDE ODD CHAR ADB LSBFA GET TO END LDA B,I AND M7400 MASK OFF LOWER HALF IOR B40 OR IN A SPACE STA B,I SAVE IT LDB BYTCC GET LENGTH AGAIN BYTC3 RSS SKIP OVER COMPLEMENTING BYTC2 CMB,INB w CHANGE NEG WORDS TO + WORDS LDA B GET LENGTH IN A REG LDB OTBFA GET ADDRESS OF BUFFER...INCLUDING SPACE INA INCLUDE SPACE IN COUNT JMP BYTCN,I AND RETURN SPC 1 BYTCA NOP BYTCC NOP BYTCD NOP OTBFA DEF OTBUF LSBFA DEF OTBUF+1 OTBUF ASC 1, PRINT BUFFER BSS 40 * B40 OCT 40 N40 DEC -40 P40 DEC 40 SKP * * SUBROUTINE TO WRITE ONTO A LIST FILE, AND OPTIONALLY ECHO TO CONSOLE * CALLING SEQUENCE * JSB \LOUT * AREG = SIO LENGTH * B REG= BUFFER ADDRESS * \LOUT NOP JSB BYTCN CONVERT LENGTH STA LOUTA STB LSBF SAVE BUFFER ADDRESS FOR OUTPUTING * LDB LFERR IS THE LIST FILE IN ERROR MODE? SZB,RSS IE, PRE-CREATION OR POST-ERR22 JMP LF0 YES * JSB WRITF WRITE THE RECORD DEF *+5 LDCBA DEF \LDCB DEF \FMRR LSBF NOP LIST BUFFER ADDRESS HERE DEF LOUTA * LDA \FMRR SSA,RSS JMP LF0 NO LIST FILE ERROR * CMA,INA SET POSITIVE FOR CONVERSION STA \FMRR JSB CNUMD CONVERT ERROR CODE TO ASCII DEF *+3 DEF \FMRR DEF FERMA ADDRESS OF ERROR MESSAGE LDA FERMA+2 PICK OFF CODE STA FILEA+6 LDB LDCBA NOW STORE THE FILE NAME STB PEMP JSB ADDCB IN THE MESSAGE NOP WON'T RETURN HERE LDB DFILE MOVE THE FILE NAME TO MVW P3 THE ERROR MESSAGE * JSB WRITF DEF *+5 SEND A BLANK LINE DEF \EDCB DEF \FMRR DEF C4040 DEF B1 * JSB WRITF SEND: DEF *+5 FMP ERR -XX DEF \EDCB DEF \FMRR DEF FILEA+1 (\CFIL WASN'T CALLED BECAUSE DEF P10 IT CALLS ... \LOUT) * ISZ ERCNT ISZ ERCNT LDA ERR22 STORE GEN ERROR CODE IN MESSAGE STA AMERR+5 JSB WRITF SEND: : DEF *+5 GEN ERR 22 DEF \EDCB DEF \FMRR DEF AMERR+1 (\GNER WASN'T CALLED BECAUSE DEF P5 IT CALLS ... \LOUT) * ASKAG JSB WRITF ASK: DEF *+5 "OK TO CONTINUE?" DEF \EDCB DEF \FMRR DEF OKAY? DEF P8 * LDA ERRLU SET ECHO BIT IN IOR B400 EXEC CONTROL STA \FMRR WORD GETAN JSB EXEC RETRIEVE OPERATOR'S ANSWER DEF *+5 DEF B1 DEF \FMRR DEF ECBF DEF N2 SZB,RSS SKIP IF INPUT RECEIVED JMP GETAN ELSE GET AGAIN * CLA SET TO IGNORE ALL FUTURE LIST STA LFERR FILE ERRORS INA TURN ECHO ON STA ECHON * LDA ECBF OKAY? CPA YCHAR "YE" JMP LF0 YES-CONTINUE CPA NCHAR "NO" JSB \TERM NO-ABORT JMP ASKAG ASK AGAIN * LF0 LDA ECHON ARE WE TO ECHO? SZA,RSS JMP \LOUT,I NO * LDA IALST IS THE LIST FILE AN SZA,RSS INTERACTIVE LU? JMP LF1 NO, GO CHECK COMMAND INPUT LDB LSTLU IS THE LIST LU SAME AS CPB ERRLU LU OF OPERATOR CONSOLE? JMP \LOUT,I YES - DON'T ECHO * LF1 LDA \IACM IS THE COMMAND INPUT SZA,RSS FROM AN INTERACTIVE LU? JMP LF2 NO - SO PERFORM ECHO LDB CMDLU IS THE COMMAND LU THE CPB ERRLU SAME AS OP CONSOLE? JMP \LOUT,I YES - SO DON'T ECHO * LF2 LDA LSBF SET BUFFER ADDRESS STA ECBF JSB WRITF AND OUTPUT IT DEF *+5 DEF \EDCB DEF \FMRR ECBF NOP DEF LOUTA JMP \LOUT,I AND RETURN * ECHON NOP ECHO FLAG, 1=ON LOUTA NOP LFERR NOP LIST FILE ERROR ACKNOWLEDGER,0=NO,1=YES ERR22 ASC 1,22 LIST FILE GEN. ERROR CODE OKAY? ASC 8,OK TO CONTINUE? SKP * SUBROUTINE TO OPEN A RELOCATABLE FILE AND ADVANCE TO THE * NAM GIVEN IN THE CURRENT IDENT ENTRY. THE FILE IS LEFT OPEN. * THE NAM DESIRED MAY BE IN THE SAME FILE AS THE PREVIOUS ONE. * * CALLING SEQUENCE: * * A = BUFFER ADDRESS FOR NAM RECORD. * B = 0, DON'T COMPARE BUFFER FILE NAMES * JSB \RNAM * ERROR RETURN * NORMAL RETURN: A = # WORDS. * \RNAM NOP STA RDNMA SAVE BUFFER ADDRESS. SZB,RSS SKIP IF CHECK WANTED JMP RDNM1 LDB \DPR2 CHECK WHETHER \RBIN'S FILE NAME INB IS THE SAME AS IN IDENT. LDA B,I CPA \ID9,I INB,RSS JMP RDNM1 NO MATCH. LDA B,I CPA \ID10,I INB,RSS JMP RDNM1 NO MATCH. LDA B,I CPA \ID11,I INB,RSS JMP RDNM1 NO MATCH LDA B,I CPA \ID12,I SECURITY CODE INB,RSS JMP RDNM1 NO MATCH LDA B,I CPA \ID13,I CR LABEL JMP RDNM3 THE NAMES MATCH. GO SEARCH. * RDNM1 JSB CLOSE NAMES DO NOT MATCH. CLOSE THIS DEF *+3 FILE AND GET THE RIGHT ONE. DEF \RDCB DEF \FMRR * LDA P2 SET TYPE = ASCII. STA PARS2 LDA \ID9 STORE FILE NAME FROM IDENT. LDB DNAM MVW P3 LDA \ID12,I GET SECURITY CODE STA PRS31 LDA \ID13,I AND CR LABEL STA PRS41 * RDNM3 LDA RDNMA RESTORE BUFFER ADDRESS. CCB SIGNAL \RBIN TO CALL APOSN. JSB \RBIN READ NEXT RECORD FROM FILE. JMP \RNAM,I ERROR. SZA,RSS JMP RDNM3 EOF. MUST HAVE BEEN PAST THE NAM. * ISZ \RNAM SET FOR NORMAL EXIT. JMP \RNAM,I * RDNMA NOP RDNMB NOP SKP * SUBROUTINE TO GET NAME * * OPEN,READ AND CLOSE A RELOCATABLE FILE. * CALLING SEQUENCE * JSB \RBIN * ERROR RETURN * NORMAL RETURN * * A REG= BUFFER ADDRESS * B REG: 0 = NULL * 1 = LOCATE BEFORE READ. * -1 = POSITION BEFORE READ. * UPON RETURN !~ * A REG=0 EOF OR A = NUMBER OF WORDS. * \RBIN NOP STA RBINA SAVE BUFFER ADDRESS STB RBINB SAVE CODE. LDA \RDCB+9 SEE IF DCB OPEN CPA 1717B IS IT OPEN JMP RBIN2 YES...DON'T RE OPEN ISZ ZERO SIGNAL A NON-EXCLUSIVE OPEN JSB FOPEN TRY TO OPEN FILE DEF *+3 DEF \RDCB DEF B300 CLA STA ZERO RESET ZERO TO ZERO! JSB \CFIL JMP \RBIN,I RBIN2 LDA RBINB GET CODE. SZA,RSS JMP RBOPN ZERO = NO ACTION. * CPA M1 JMP RBIN3 -1 = PRE-POSITION THE FILE. ADA M1 1 = GET THE FILE POSITION. SZA JMP RBOPN UNDEFINED. ASSUME ZERO. * JSB LOCF GET POSITION OF NEXT DEF *+6 RECORD IN THE FILE. DEF \RDCB DEF \FMRR DEF \NAMN DEF \NAMB DEF \NAMO * JMP RBIN4 * RBIN3 JSB APOSN POSITION THE FILE. DEF *+6 DEF \RDCB DEF \FMRR DEF \ID14,I DEF \ID15,I DEF \ID16,I * RBIN4 LDA DRDCB GET DCB ADDRESS JSB \CFIL FOR ERROR CHECKING JMP \RBIN,I * RBOPN JSB READF READ THE FILE DEF *+6 DRDCB DEF \RDCB DEF \FMRR DEF RBINA,I DEF D60 MAX OF 60 WORDS DEF RLEN LENGTH OF RECORD LDA DRDCB JSB \CFIL SEE IF ANY ERROR JMP \RBIN,I ERROR...DO ERROR RETURN LDA RLEN GET LENGTH SZA,RSS IGNORE ZERO LENGTH RECORDS. JMP RBOPN ISZ \RBIN GET NORMAL RETURN. CPA M1 EOF? RSS JMP \RBIN,I NO JSB \CLOS YES...CLOSE FILE DEF *+3 DEF \RDCB DEF ZERO CLA TELL THEM END OF FILE JMP \RBIN,I AND RETURN SPC 2 RBINA NOP RELOC. INPUT BUFFER ADDRESS RBINB NOP " FILE POSITION FLAG RLEN NOP " RECORD LENGTH \NAMN NOP \NAMB NOP .\NAMO NOP SKP * * SUBROUTINE TO OPEN A FILE * CALLING SEQUENCE * JSB FOPEN FILE OPEN * DEF *+3 * DEF DCB ADDRESS * DEF SUBFUNCTION FOR READ OR WRITE IN CASE A TYPE 0 FILE * * ASSUMES THAT PARS2+1=FILE NAME * PARS3+1=SECURITY CODE * PARS4+1=LU * ODCBA NOP SUBF NOP FOPEN NOP JSB .ENTR DEF ODCBA LDA ODCBA GGET DCB ADDRESSPE LDB SUBF,I GET SUBFUNCTION JSB TYP0 CHECK IF TYPE IS 0 JMP FOPEN,I YES EXIT JSB OPEN TRY TO OPEN FILE DEF *+7 DEF ODCBA,I DEF \FMRR DEF PARS2+1 NAME DEF ZERO ALWAYS = 0 EXCEPT WHEN CALLED BY \RBIN DEF PARS3+1 SECURTIY CODE DEF PARS4+1 LOGICAL UNIT JMP FOPEN,I RETURN SKP * * SUBROUTINE TO CREATE A DUMMY TYPE 0 FILE * CALLING SEQUENCE * LDA DCB ADDRESS * LDB SUBFUNCTION * JSB TYP0 * RETURN HERE(P+1) IF IT IS TYPE 0 * RETURN HERE(P+2) IF IT IS NOT TYPE 0 * * TYP0 NOP STA T0DCB LDA PARS2 CMA,INA,SZA IF NULL OR NUMERIC (TYPE 0,1) INA,SZA,RSS THEN OPEN A DUMMY TYPE 0 JMP TYP1 ISZ TYP0 OTHERWISE TAKE NOT JMP TYP0,I TYPE 0 EXIT TYP1 LDA PARS2+1 GET LU SZA,RSS IF NOT DEFINED INA DEFINE AS LU = 1 STA PARS2+1 CLA JSB SETIT SET DIRECTORY JSB SETIT ADDRESS TO ZERO JSB SETIT ALSO SET TYPE TO 0 LDA PARS2+1 GET LOGICAL UNIT IOR B MERGE IN SUBFUNCTION JSB SETIT AND SET IN DCB JSB EXEC GET DRIVER TYPE DEF *+6 DEF P13 DEF PARS2+1 DEF EQT5 DEF EQT4 DEF SUB05 LDA EQT5 GET TYPE ALF,ALF ROTATE TO LOW A AND M77 AND MASK STA EQT5 SAVE CPA P5 IF TYPE 5, MUST RSS JMP NOT05 LDA SUB05 DETERMINE IHFBTS SUBCHANNEL AND M77 STA SUB05 SAVE THE SUBCHANNEL * LDA EQT5 NOT05 LDB B100 GET EOF CONTROL SUBFUNCTION CPA P5 RSS JMP TYP2 LDA SUB05 IF SUBCHANNEL 0 SZA,RSS JMP TYP3 ƝH JMP SEOF * TYP2 ADA MD17 IF TYPE > 16 SSA,RSS JMP SEOF SET EOF CODE * TYP3 LDB B1000 LDA EQT5 CPA P2 IS DRIVER A PUNCH JMP SEOF GO SET LEADER GENERATION CLB SZA,RSS IF TYPE=0 DON'T DO PAGE EJECT JMP SEOF CPA P7 IF A TYPE 7 DEVICE JMP SEOF THEN IT IS AUTOMATICALLY INTERACTIVE CPA P5 RSS JMP TYP4 LDA SUB05 NEED TO GET SUBCH ON A TYPE 5 SZA,RSS JMP SEOF * TYP4 LDB B1100 LINE SPACE OPTION SEOF LDA PARS2+1 GET LU IOR B MERGE EOF CONTROL SUBFUNCTION JSB SETIT SET IN DCB CLA JSB SETIT SET NO SPACING LEGAL LDA B1001 SET READ&WRITE LEGAL JSB SETIT AND SECURITY CODES AGREE JSB SETIT AND UPDATE MODEES AGREE LDA 1717B GET MY ID ADDRESS ISZ T0DCB INCREMENT TO WORD 9 JSB SETIT SET OPEN FLAG LDA T0DCB ADA P3 STA T0DCB SET TO WORD 13 CLA SET IN CORE BUFFER FLAG JSB SETIT TO ZERO INA JSB SETIT SET RECORD COUNT CLA STA \FMRR CLEAR ERROR CODE FOR TYPE 0 LDB EQT5 IF THIS IS A MT UNIT CPB P5 NO EOF IF A TYPE 5 DEVICE RSS CPB B23 THEN DON'T WRITE AN EOF JMP TYP0,I LDB T0DCB GET DCB ADDRESS ADB MD11 RESET TO WORD5, CONTROL FUNC LDB B,I GET CONTROL WORD STB SETIT SAVE IN TEMP LOCATION JSB EXEC DO AN EOF DEF *+4 DEF P3 DEF SETIT TEMP WHERE FUNCTION CODE LOCATED DEF MD17 FORCE A PAGE EJECT OR LEADER CLA JMP TYP0,I * * SETIT NOP STA T0DCB,I SET IN DCB ISZ T0DCB INCREMENT TO NEXT WORD JMP SETIT,I * * P7 DEC 7 T0DCB NOP EQT5 NOP MD17 DEC -17 MD11 DEC -11 B23 OCT 23 B100 OCT 100 B300 OCT 300 B1000 OCT 1000 B1001 OCT 100001 B19100 OCT 1100 SPC 2 D60 DEC 60 SUB05 NOP TYPE 5 SUBCHANNEL SKP * * SUBROUTINE TO CREATE A FILE * CALLING SEQUENCE * JSB \CRET * DEF *+5 * DEF DCB ADDRESS * DEF SIZE * DEF TYPE * DEF SUBFUNCTION FOR READ/WRITE IN CASE A TYPE 0 FILE * * ASSUMES THAT PARS2+1=FILE NAME * PARS3+1=SECURITY CODE * PARS4+1=LU * SPC 1 CDCBA NOP CSIZ NOP CTYP NOP CSBUF NOP \CRET NOP JSB .ENTR DEF CDCBA JSB FOPEN GO TRY TO OPEN THE FILE DEF *+3 DEF CDCBA,I DEF CSBUF,I SZA,RSS TYPE 0? JMP \CRET,I YES...RETURN JSB CLOSE IF NOT CLOSE FILE IF OPEN DEF *+3 DEF CDCBA,I DEF \FMRR JSB CREAT TRY CREATING THE FILE DEF *+8 DEF CDCBA,I DEF \FMRR DNAM DEF PARS2+1 DEF CSIZ,I DEF CTYP,I DEF PARS3+1 DEF PARS4+1 JMP \CRET,I SKP * * SUBROUTINE TO CLOSE A FILE * USED TO DETERMINE IF CLOSING A DUMMY TYPE 0 * CALLING SEQUENCE * JSB \CLOS * DEF *+3 * DEF DCB ADDRESS * DEF TRUNCATE OPTION (DEFAULT IS ZERO) * * CLDCB NOP COPTN DEF ZERO \CLOS NOP JSB .ENTR DEF CLDCB LDA CLDCB,I GET DIRECTORY DISC ADDRESS SZA,RSS IF ZERO JMP FCLS1 THEN DUMMY DCB JSB CLOSE ELSE DO STANDARD CLOSE DEF *+4 DEF CLDCB,I DEF \FMRR DEF COPTN,I FCLS1 LDA DFZER RESET THE OPTION WORD STA COPTN IN CASE NOT SUPPLIED NEXT TIME LDA CLDCB,I SZA JMP \CLOS,I DONE WITH FILES LDA CLDCB MAKE SURE DUMMY DCB CLOSED. ADA D9 CLB STB A,I LDA CLDCB SEE IF LIST DCB CPA LDCBA RSS YES IT IS JMP \CLOS,I NO ADA P4 STA FCLS2 SAVE FOR EXEC CALL JSB EXEC DO A PAGE EJECT DEF *+ 4 DEF NABP3 CONTROL REQUEST FCLS2 NOP LU DEF MD17 PAGE EJECT CODE NOP JMP \CLOS,I AND RETURN * * D9 DEC 9 NABP3 OCT 100003 NO ABORT 3 * SKP * * SUBROUTINE TO CLOSE THE ABSOLUTE CORE IMAGE FILE * * CALLING SEQUENCE * JSB \TRUN * NORMAL RETURN * * THIS ROUTINE WILL DELETE UNUSED FILE AREA * \TRUN NOP ASSUMES NO EXTENTS BEC TYPE 1 CLB LDA \FMRR GET \DSKD ERROR CODE SSA IF NEGATIVE THE EXACT SIZE WAS CORRECT JMP SETBL LDA ABDCB+3 TRK CMA,INA ADA ABDCB+10 CTRK - TRK MPY ABDCB+8 (CTRK - TRK) * #SEC/TR LDB ABDCB+4 CMB,INB ADA B (CTRK - TRK) * #S/TR - SEC ADA ABDCB+11 (CTRK - TRK) * #S/TR - SEC + CSEC ARS CONVERT TO NUMBER OF BLOCKS LDB ABDCB+5 GET NUMBER OF SECS CLE,ERB CONVERT TO BLOCKS CMA,INA SET CURRENT BLOCK NEG ADB A # OF BLKS - CURRENT BLK SETBL STB TMP JSB \CLOS DEF *+3 DEF ABDCB DEF TMP JMP \TRUN,I * TMP NOP ABDCB BSS 144 ABS FILE DCB SKP * * SUBROUTINE TO PRINT COMMAND AND ACCEPT * INPUT. * CALLING SEQUENCE * JSB \PRMT * DEF *+6 * DEF PRINT MESSAGE BUFFER * DEF LENGTH (IN SIO FORMAT) * DEF REPLY ADDRESS * DEF LENGTH (IN + # OF CHARACTERS) * DEF PARSE BUFFER * * A REG= + NUMBER OF CHARACTERS * PMEMB NOP PMEML NOP PRADD NOP PRLEN NOP PPARS NOP \PRMT NOP JSB .ENTR DEF PMEMB PRMT1 LDB PMEMB GET BUFFER ADDRESS LDA PMEML,I GET LENGTH SZA SKIP IF NO QUESTION. JSB \MESS PRINT QUESTION PRMT5 LDA PRLEN,I GET LENGTH INA CONVERT TO WORDS CLE,ERA STA PRMTA SAVE LENGTH CMA,INA CONVERT TO NEGATIVE WORD COUNT STA PRMTB SAVE IN TEMP LDB PRADD ÿ GET ADDRESS WHERE TO SPACE FILL LDA C4040 SPACE WORD STA B,I INB ISZ PRMTB DONE? JMP *-3 NO JSB READF GO GET INPUT DEF *+6 DIDCB DEF \IDCB FROM INPUT DEVICE DEF \FMRR DEF PRADD,I DEF PRMTA DEF PRMTB LDA DIDCB GET DCB ADDRESS AND JSB \CFIL SEE IF WE HAD A FILE ERROR JMP INPRR LDA PRMTB GET LENGTH FOR PRINT ON FILE SSA,RSS IS IT A END OF FILE JMP PRMT2 NO LDA \IACM IF THE COMMAND INPUT IS FROM AN SZA INTERACTIVE LU, THEN JMP PRMT1 TRY AGAIN FOR RESPONSE LDA TR ELSE GO SIMIULATE A TR STA PRADD,I COMMAND TO POP LDA PRADD THE STACK LDB P2 ISZ EOFFL SIGNAL NO ERROR MESSAGE JMP PRMT3 * INPRR CLA STA \IACM FORCE A TR,ERRLU LDA ERR20 BY GNER JSB \GNER JMP PRMT1 TRY AGAIN * PRMT2 SZA,RSS IF 0-LENGTH RECORD JMP PRMT5 THEN SIMPLY SKIP & RETRY CLE,ELA CONVERT TO CHARACTERS STA PRMTB LDA IALST IF LIST DEVICE A FILE SZA,RSS (NON-INTERACTIVE) JMP PRMTL THEN ECHO INPUT CPA \IACM IF BOTH COMMAND AND LIST FILE RSS ARE INTERACTIVE, JMP PRMTL LDA LSTLU THEN SEE IF THEY'RE TO THE SAME CPA CMDLU LU JMP PRMTN YES, SO DON'T ECHO INPUT * PRMTL LDB PRADD GET INPUT LDA PRMTB JSB \LOUT WRITE IT ONTO LIST FILE * PRMTN LDA PRADD,I SEE IF THEY WANT OUT? CPA !! JSB \TERM YES...GET OUT AND M7400 MASK TO HIGH BYTE ONLY CPA LCOMM IF A COMMA OR COLON RSS CPA LCOLN JMP PRMT6 THEN ASSUME A TR * PRMT7 LDA PRADD GET BUFFER ADDRESS LDB PPARS SET CORRECT PARSE BUFFER ADDRESS STB PADD LDB PRMTB CHARACTER COUNT JSB \PAR9S PADD NOP LDB PPARS GET FIRST 2 CHARS. INB LDA B,I CPA TR TRANSFER COMMAND? RSS JMP PRMT4 NO - GO EXIT * INB YES - BUT CHECK LDA B,I FURTHER FOR A AND M7400 BLANK OR A CPA LBLNK COMMA IN CHARACTER 3 JMP PRMT6 CPA LCOMM RSS JMP PRMT4 PRMT6 LDA PRADD GET BUFFER ADDRESS LDB PRMTB GET LENGTH PRMT3 JSB \TRCH GO DO TR THING CLA RESET IF EOF-GENERATED STA EOFFL JMP PRMT1 GO RETRY COMMAND PRMT4 LDA PRMTB GET ACTUAL REPLY LENGTH JMP \PRMT,I AND RETURN SPC 1 C4040 ASC 1, !! ASC 1,!! TR ASC 1,TR ASTER OCT 25000 * PRMTA NOP PRMTB NOP LBLNK OCT 20000 LCOMM OCT 26000 , LCOLN OCT 35000 : B171 OCT 171000 SKP * * PARSE ROUTINE (MODIFIED VERSION OF $PARS) * * CALLING SEQUENCE: * LDA BUFFER ADDRESS * LDB CHARACTER COUNT * JSB \PARS * DEF PRAM BUFFER * -RETURN- * * THE PRAM BUFFER IS 21 WORDS LONG AND CONTAINS UP TO 5 * PRAMETER DESCRIPTERS FOLLOWED BY THE PRAMETER COUNT. * * EACH PARAMETER DESCRIPTER CONSISTS OF FOUR WORDS: * * WORD MEANING * 1 FLAG WORD 0=NULL PRAMETER * 1=NUMERIC PRAMETER * 2=ASCII PRAMETER * 2 0 IF NULL,VALUE IF NUMERIC,ASCII(1,2) IF ASCII * 3 0 IF NOT ASCII ELSE ASCII(3,4) * 4 0 IF NOT ASCII ELSE ASCII(5,6) * * TEMP USAGE IN PARSE SECTION: * * WSTAT = ADDR OF 21 WORDS OF OUTPUT BUF * PEMPP = CHARACTER ADDRESS * PEMP = PARAMETER FLAG ADDRESS * PEMP1 = TEMP BUFFER FETCH ADD. * PEMP2 = TEMP BUFFER STORE ADD. * kU PEMP3 = LAST INPUT CHAR.+1 ADD. * PEMP4 = PARAMETER VALUE ADDRESS. * PBUF = DEF PEMP5 (7 LOCATIONS) * PBUFS = DEF PEMP5+7 * \PARS NOP CLE,ELA MAKE CHARACTER ADD. STA PEMPP SET BUFFER CHAR ADD. ADA B COMPUTE END ADDRESS. STA PEMP3 AND SET IT. LDB N20 CLEAR PARAMETER AREA STB PEMP LDB \PARS,I CLA STA COMMT CLEAR COMMENT DETECTED FLAG MES1 STA B,I CLEAR INB ENTIRE ISZ PEMP OUTPUT JMP MES1 BUFFER * STA B,I CLEAR THE PRAM COUNT STB WSTAT SET ADDRESS OF PRAM COUNT DEC09 LDA PBUF INITIALIZE PEMP BUFFER ADDRESS STA PEMP1 ADDRESS OF PEMP5 STA PEMP2 * DEC10 LDB PEMPP GET THE BUFFER CHAR ADDRESS CPB PEMP3 IF NO MORE CHARACTERS JMP DEC60 GO PROCESS PRAM ISZ PEMPP STEP INPUT POINTER CLE,ERB CONVERT TO WORD SET UP LOW IN E LDA B,I GET WORD FROM THE BUFFER SEZ,RSS CHECK IF TO EXAMINE UPPER/LOWER ALF,ALF UPPER, SO ROTATE TO LOWER BITS AND B377 MASK OFF ALL BUT LOW ORDER CPA COMMA SEE IF A COMMA JMP DEC60 YES CPA COLON SEE IF A COLON JMP DEC60 YES CPA STAR SEE IF AN ASTERISK (COMMENT) JMP DEC60-1 YES CPA LASCI CHECK IF BLANK CHARACTER JMP DEC10 YES, SO SKIP CHARACTER LDB PEMP2 CHECK IF 6 CHARACTERS IN PRAM CPB PBUFS IF SO JMP DEC10 SKIP STORE STA PEMP2,I STORE THE CHARACTER STA SABRT SAVE THE LAST CHARACTER ISZ PEMP2 STEP FOR NEXT CHAR. * JMP DEC10 GO TO PROCESS NEXT CHARACTER * * ATPEMPT NUMERIC CONVERSION OF PRAM. * ISZ COMMT SIGNAL COMMENT STARTED DEC6-]0 LDA WSTAT,I FIRST SET UP POINTERS RAL,RAL TAKE 4 TIMES THE PRAM NUMBER ADA \PARS,I PLUS THE OP CODE ADDRESS-1 STA PEMP SET FLAG ADDRESS CLE,INA ONE MORE AND WE HAVE STA VALOC THE PRAMETER VALUE LOCATION LDA PEMP2 IF NO CHARACTERS CPA PBUF INPUT JMP DEC75 GO TRY NEXT ONE * * NOW TRY FOR A NUMBER * LDB PEMP1,I GET FIRST CHAR CPB DASH MINUS SIGN? ISZ PEMP1 YES, INCRE TO NEXT CHAR CPA PEMP1 (A) STILL = PEMP2 JMP DEC80 IF "-" WAS ONLY CHAR, THEN ASCII * LDB P10 SET UP CONVERSION BASE LDA SABRT CPA "B" IF B SUFFIX LDB P8 SET FOR BASE 8 STB PEMP4 SET BASE ISZ PEMP,I SET FLAG TO 1 FOR NUMBER DEC65 MPY VALOC,I BUMP THE CURRENT VALUE VALOC EQU *-1 LDB PEMP1,I GET THE NEXT CHAR. ADB DM58 IF GREATER THAN "9" SEZ,CLE,RSS THEN NOT A NUMBER ADB P10 IF LESS THAN "0" SEZ,CLE,RSS THEN JMP DEC80 NOT A NUMBER ADA B ACCUMULATE THE STA VALOC,I NUMBER ISZ PEMP1 STEP THE BUFFER ADDRESS LDA PEMP4 GET THE BASE TO A LDB PEMP1 AND THE NEXT CHAR. LOC. TO B CPB PEMP2 IF END THEN JMP DEC70 GO TO NEXT PRAM * INB IF BASE 8 CONVERSION CPB PEMP2 AND LAST CPA P10 CHAR. THEN DONE SO SKIP JMP DEC65 ELSE GO GET THE NEXT ONE * SPC 1 DEC70 LDB VALOC,I GET VALUE LDA PBUF,I IF NEG NUMBER, CPA DASH CMB,INB NEGATE VALUE STB VALOC,I STORE VALUE * DEC75 ISZ WSTAT,I COUNT THE PRAMETER LDA COMMT WAS A COMMENT BEGUN? SZA JMP DEC90 YES, EXIT LDA WSTAT,I IF LDB PEMP3 EOL OR CPB PEMPP 5 PRAMS LINE RSS THEN CPA P5 JMP DEC90 t GO PROCESS JMP DEC09 ELSE GO GET NEXT CHARACTER SPC 1 DEC80 ISZ PEMP,I SET NOT NUMBER FLAG LDA AASCI FILL THE PRAM WITH BLANKS LDB VALOC PRAM ADDRESS TO B INB DON'T WORRY ABOUT FIRST WORD STA B,I SET SECOND WORD CLE,INB STEP TO THIRD WORD STA B,I SET THIRD WORD TO DOUBLE BLANK. LDB PBUF GET THE PEMP BUFFER POINTER DEC85 CPB PEMP2 END OF INPUT? JMP DEC70 YES GO PROCESS NEXT PRAM CPB STOP SIXTH CHAR YET? JMP DEC75 YES, END PARAM LDA B,I GET THE CHARACTER SEZ,RSS IF UPPER CHARACTER ALF,SLA,ALF ROTATE AND SKIP XOR VALOC,I LOWER ADD THE UPPER CHAR. XOR LASCI ADD/DELETE THE LOWER BLANK STA VALOC,I STORE THE PACKED WORD SEZ,CME,INB STEP B,SKIP IF UPPER ISZ VALOC ELSE STEP STORE ADDRESS. JMP DEC85 GO GET OTHER CHAR. SPC 2 DEC90 ISZ \PARS STEP RETURN ADDRESS JMP \PARS,I RETURN SPC 2 "B" OCT 102 ASCII "B" DASH OCT 55 ASCII "-" STOP DEF PEMP5+6 ASCII 6TH CHAR STOP * * PEMP NOP PEMP1 NOP PEMP2 NOP PEMP3 NOP PEMP4 NOP PEMP5 NOP NOP NOP NOP NOP ASCI NOP ASCI1 NOP ASCI2 NOP * PEMPP NOP WSTAT NOP PBUF DEF PEMP5 PBUFS DEF PEMP5+7 DM58 DEC -58 COLON OCT 72 COMMT NOP SABRT NOP AASCI ASC 1, B377 OCT 377 N20 DEC -20 LASCI OCT 40 SKP SKP * SUBROUTINE TO DETERMIN IF STACK IS TO * * BE PUSHED OR POPPED * * IF PUSHED, IT CLOSES THE CURRENT FILE, * SAVES RC,AND OPENS NEW FILE * * IF POPPED, IT CLOSES THE CURRENT FILE, * OPENS THE PREVIOUS FILE, AND POSITIONS * IT TO THE PROPER RECORD * SPC 1 \TRCH NOP JSB \PARS B = LENGTH, A = ADDR DEF \BPAR LDA PARS2 GET FILE TYPE SZA IF NOT NULL JMP TR3 GO TO PUSH * sTR1 JSB \CLOS CLOSE THE CURRENT FILE DEF *+3 DEF \IDCB DFZER DEF ZERO JSB POP GO POP STACK JMP POPRR ERROR, NO MORE ENTRIES STA RC SAVE RECORD COUNT JSB FOPEN OPEN PREVIOUS FILE DEF *+3 DEF \IDCB DEF B400 CLA JSB \CFIL JMP \TRCH,I FILE ERROR - STAY AT ERRLU LDA \IDCB+2 GET TYPE SZA,RSS IF TYPE 0 JMP \TRCH,I EXIT LDA RC GET RECORD COUNT CMA,INA SET NEGATIVE AND STA COUNT SAVE TR2 ISZ COUNT ARE WE THERE YET? RSS JMP \TRCH,I YES...GET OUT JSB READF READ A RECORD DEF *+6 DEF \IDCB DEF \FMRR DEF PRADD,I DEF ZERO DEF RL LDA DIDCB GET DCB ADDRES AND SEE IF AN JSB \CFIL ERROR OCCURRED JMP \TRCH,I ERROR - STAY AT ERRLU LDA RL SSA IF EOF...POP STACK JMP TR1 JMP TR2 GET NEXT RECORD SKP * * PLACE NEW INPUT FILE ON STACK AND PUSH * TR3 LDA \IDCB+14 GET REC NUMBER OF NEXT RECORD STA RC SAVE AS CURRENT RECORD # JSB \CLOS GO CLOSE THE FILE DEF *+3 DEF \IDCB DEF ZERO LDA RC GET RECORD COUNT JSB PUSH GO PUSH STACK JMP PUSHR ERROR - STACK OVERFLOW JMP TR4 OPEN FILE JSB RECOV INVALID LU SPECIFIED LDA ERR20 RECOVER AND ISSUE JSB \GNER ERROR MESSAGE JMP \TRCH,I * TR4 JSB FOPEN GO OPEN NEW FILE DEF *+3 DEF \IDCB DEF B400 LDA \FMRR AN ERROR? SSA,RSS JMP \TRCH,I RETURN (MAY BE TO \CFIL ITSELF) STA PUSH SAVE ERROR VALUE LDA DNAM MUST SAVE THE FILE NAME LDB DFDIR BECAUSE RECOV/POP MAY OVERLAY MVW P3 IT IF A "TR,ERRLU" IS DONE JSB RECOV RECOVER PREVIOUS ENTRY LDA PUSH RESTORE STA \F$MRR THE FMP ERROR CODE LDA DFDIR NOW MOVE THE FILE NAME LDB DNAM BACK INTO THE PARSE BUFFER MVW P3 FOR THE \CFIL CALL CLA SIGNAL FILE NAME IN PARS2+1 JSB \CFIL ISSUE ERROR & TRANSFER TO ERRLU JMP \TRCH,I AND RETURN * PUSHR CCA ADA P:TR RESET THE POINTER FOR POP STA P:TR JSB RECOV RECOVER PREVIOUS ENTRY * POPRR CLA INSURE THAT A "TR,ERRLU" IS DONE STA \IACM LDA ERR19 TRANSFER STACK UNDERFLOW OR OVERFLOW JSB \GNER JMP \TRCH,I SKP RECOV NOP RECOVERS THE PREVIOUSLY OPEN STACK ENTRY JSB POP JMP NONET NONE THERE STA RC JSB FOPEN GO OPEN THE FILE DEF *+3 DEF \IDCB DEF B400 LDA RC STA \IDCB+14 JMP RECOV,I NONET CLA "TR,ERRLU" MUST BE DONE STA \IACM JMP RECOV,I * ERR19 ASC 1,19 ERR20 ASC 1,20 COUNT NOP RC NOP RL NOP B400 OCT 400 SKP * * SUBROUTINE TO PUSH AND POP A STACK * STACK DEFINITION * WORD 6= RECORD COUNT FOR NEXT RECORD TO READ * WORD 5= CARTRIDGE REFERENCE NUMBER * WORD 4= SECURITY CODE * WORD 3= 0 ELSE CH5 & CH6 * WORD 2= 0 ELSE CH3 & CH4 * WORD 1= LU ELSE CH1 & CH2 * WORD 0= TYPE...1=TYPE 0, 2=REGULAR * * PUSH-PLACES FILE NAME AND TYPE ON STACK * LEAVES POINTER AT RECORD COUNT (WORD 6) * ASSUMES PARS2 CONTAINS INFO NEEDED * * CALLING SEQUENCE * LDA RC OF CURRENT FILE * JSB PUSH * (P+1) ERROR RETURN STACK OVERFLOW * (P+2) NORMAL RETURN * (P+3) ERROR RETURN INVALID LU * SPC 1 PUSH NOP STA P:TR,I SAVE CURRENT RECORD COUNT ISZ P:TR INCREMENT TO BEGINNING OF NEXT ENTRY LDA ENDST GET END OF STACK ADDRESS CPA P:TR IF = JMP PUSH,I THEN OVERFLOW DLD PARS2 SAVE TYPE nB DST P:TR,I ISZ P:TR ISZ P:TR DLD PARS2+2 STORE CHARS 3-6 DST P:TR,I ISZ P:TR ISZ P:TR LDA PARS3+1 GET SECURITY CODE LDB PARS4+1 AND CRN DST P:TR,I ISZ P:TR ISZ P:TR JSB STATE SET THE STATES \IACM AND CMDLU ISZ PUSH INVALID LU ISZ PUSH SET FOR NORMAL RETURN JMP PUSH,I AND RETURN SKP * * SUBROUTINE THAT MOVES THE POINTER TO PREVIOUS * STACK ENTRY * PLACES RECORD COUNT IN A REG * LEAVES POINTER AT REC. COUNT * * CALLING SEQUENCE * JSB POP * ERROR RETURN * NORMAL RETURN * A REG=REC. COUNT * SPC 1 POP NOP LDA P:TR GET CURRENT POINTER ADA MD13 DECREMENT TO PREVIOUS ENTRY LDB STKAD GET STACK ADDRESS CMB,INB ADB A IF CURRENT LESS THAN SSB START OF STACK JMP POP,I NO MORE ENTRIES STA P:TR SET AS NEW POINTER DLD P:TR,I GET OLD ENTRY DST PARS2 ISZ P:TR INCREMENT TO WORDS 3 AND 4 ISZ P:TR DLD P:TR,I DST PARS2+2 ISZ P:TR ISZ P:TR DLD P:TR,I STA PARS3+1 STB PARS4+1 ISZ P:TR ISZ P:TR JSB STATE SET THE STATES \IACM AND CMDLU NOP INVALID LU ERROR NOT POSSIBLE HERE LDA P:TR,I GET RECORD COUNT ISZ POP GET NORMAL RETURN JMP POP,I AND RETURN SPC 2 STKAD DEF *+2 POINT TO DEFAULT LU 1 BSS 1 DEC 1 INSERT LU 1 DEC 1 AT STACK BOTTOM BSS 5 WHERE THEY DON'T REALIZE IT STACK BSS 70 ALLOWS A NESTING LEVEL TO 10 ENDST DEF * P:TR DEF STACK-1 INITIAL POINTER AFTER HARD-CODE LU 1 MD13 DEC -13 SKP * * STATE SETS THE CURRENT "STATE" FLAGS \IACM AND CMDLU, * REFLECTING THE.NEW COMMAND INPUT DEVICE/FILE. * ASSUMES PARS2 AND PARS2+1 CONTAIN THE TYPE * =HFB AND FIRST PARAMTER, RESPECTIVELY * * CMDLU = LU #, ELSE 0 FOR ASCII FILE * \IACM = 0 IF A NON-INTERACTIVE LU, OR FILE * = 1 IF AN INTERACTIVE LU * * RETURN (P+1) ERROR - INVALID INPUT LU SPECIFIED * (P+2) NORMAL * STATE NOP DLD PARS2 GET WORD0 = PARAMETER TYPE CPA P2 & WORD1 = PARAMETER CLB A TYPE 2 IS A FILE NAME STB CMDLU SO IS 0, OR THE LU CPA P2 JMP STATF FILE NAME, GO SET \IACM TO 0 * SSB JMP STATE,I CAN'T BE < 0 63 SSB,RSS JMP STATE,I TOO BAD! * JSB EXEC GET LU TYPE FROM EQT DEF *+6 DEF NAB13 NO-ABORT 13 CALL DEF CMDLU DEF EQT5 DEF EQT4 DEF LUSUB JMP STATE,I EXEC ERROR RETURN LDA EQT4 CHECK FOR VALID LU AND M77 IF THE SELECT CODE IS 0 SZA,RSS THEN ITS THE BIT BUCKET JMP STATE,I WE'RE EXPECTING INUT FROM! * LDA EQT5 ALF,ALF GET TYPE TO LOW A AND M77 STA EQT5 SAVE IT CPA P7 IF TYPE 7 THEN IT IS CLA AUTOMATICALLY INTERACTIVE LDB CMDLU CPA P5 TYPE 5 ? LDA LUSUB YES, GO RETRIEVE ITS SUBCHANNEL AND M77 ???CHECK STATUS? CLB * STATF SZA,RSS TYPE 0, OR TYPE 5'S SUBCHANNEL 0? INB YES, SO AN INTERACTIVE DEVICE STB \IACM 0 = NOT IA, 1 = IA ISZ STATE JMP STATE,I * EQT4 NOP NAB13 OCT 100015 LUSUB NOP SKP * * FILE CHECK ROUTINE * * CALLING SEQUENCE: * A-REG = FILE'S DCB ADDRESS * = 0 IF A FILE OPEN OR CREATE CALL * \FMRR = RETURNED ERROR PARAMETER * JSB \CFIL * * (P+1) ERROR RETURN * (P+2) NORMAL RETURN * * \CFIL NOP LDB \FMRR GET FMP ERROR PARAMETER SSB,RSS ANY ERROR? JMP FNOER NO ISZ ERCNT BUMP COUNTER CMB,INB SET POS FOR CONVERT STB \FMRR STA PEMP SAVE FILE DCB ADDRESS * JSB CNUMD GET DEC ERROR CODE DEF *+3 DEF \FMRR DEF FERMA ERROR MESSAGE ADDRESS LDA FERMA+2 GET LAST TWO CHARACTERS STA FILEA+6 & STORE IN MESSAGE LDB PEMP WAS IT AN OPEN/CREAT CALL SZB HAVING AN INVALIC DCB ADDRESS JSB ADDCB NO - CAN GET FILE NAME/LU FROM DCB * LDA DNAM ELSE GET FILE NAME FROM PARSE BUFFER LDB DFILE  GET DEST ADDRESS MVW P3 IN ERROR MESSAGE AND MOVE FILENAME/LU * LDA \IACM DETERMINE IF WE ARE TO BRANCH TO SZA THE ERROR LU JMP ROUT NO, SINCE ALREADY GET INPUT FROM IA DEVICE * LDA \TRCH SAVE ITS RETURN ADDRESS STA \DSKA IN A TEMP LDA \TRCM SIMULATE A "TR,ERRLU" LDB B6 JSB \TRCH DO THE TR LDA \DSKA RESTORE THE RETURN ADDRESS STA \TRCH * ROUT JSB \SPAC LDA P20 LDB FILEA JSB \MESS SEND ERROR TO USER RSS FNOER ISZ \CFIL GET NORMAL RETURN IF NO ERROR * JSB IFBRK BREAK REQUESTED? DEF *+1 SZA JSB \TERM YES, DO ABORTIVE CLEANUP JMP \CFIL,I NORMAL RETURN SPC 2 FILEA DEF *+1 ASC 10,FMP ERR - DFILE DEF FILEA+8 DFERM DEF *+1 FERMA ASC 3, \FMRR NOP P20 DEC 20 SPC 4 * * GET THE FILE NAME/LU FROM THE DCB * ADDCB NOP ISZ ADDCB BUMP RETURN ADDRESS BY 1 LDA B,I GET FIRST DCB WORD AND CHECK FOR SZA,RSS AND ACTUAL FILE DCB JMP LUERR OR A LU - TYPE 0 DUMMY DCB * ***** ***** CHECK NEW DCB FORMAT AND BRANCH APPROPRIATELY ***** * LDB A GET LU OF AND M77 THE FILE DIRECTORY ENTRY STA PEMP1 AND SAVE BLF,RBL NOW GET THE TRACK # BLF,RBL FROM THE SAVE DCB LDA B WORD 0 AND AND M377 STA PEMP2 SAVE ISZ PEMP BUMP TO WORD 1 OF DCB LDA PEMP,I GET OFFSET/SECTOR LDB A AND SAVE AND M377 ISOLATE SECTOR STA PEMP3 BLF,BLF LDA B NOW ISOLATE AND M377 THE OFFSET STA PEMP4 AND SAVE * JSB EXEC READ THE PROPER SECTOR DEF *+7 THE FILE DIRECTORY DEF B1 DEF PEMP1 LU OF DIRECTORY ENTRY DFDIR DEF PEMP,I BUFFER ADDRESS IN OWN DCB DEF P128 DEF PE*MP2 TRACK ADDRESS DEF PEMP3 SECTOR ADDRESS LDA PEMP GET BUFFER ADDRESS & ADA PEMP4 OFFSET INTO IT FOR THE FILE NAME JMP ADDCB,I EXIT TO MOVE THE NAME * LUERR ADB P3 POSITION TO WORD 3 LDA B,I OF DUMMY DCB AND M77 AND ISOLATE THE LU STA PEMP4 SAVE FOR CONVERSION JSB CNUMD TO ASCII DEF *+3 DEF PEMP4 DEF FERMA LDA "LU" MOVE 'LU' TO PRECEDE STA FERMA # IN DISPLAY LDA DFERM GET BUFFER ADDRESS JMP ADDCB,I FOR MOVE * "LU" ASC 1,LU P128 DEC 128 SKP * * INCREMENT DISK ADDRESS * * THE \DSKA SUBROUTINE INCREMENTS THE CURRENT DISK ADDRESS * TO PROVIDE THE ADDRESS OF THE SUCCEEDING SECTOR, * WHETHER THAT SECTOR IS ON THE SAME TRACK OR THE FOLLOWING * TRACK. * * NOTE... THIS ROUTINE IS GOOD FOR MH & 7905 DISC. * ... MUST BE MODIFIED FOR FH. * * CALLING SEQUENCE: * A = CURRENT DISK ADDRESS * B = IGNORED * JSB \DSKA * * RETURN: * A = NEXT DISK ADDRESS * B = DESTROYED * \DSKA NOP STA B SAVE CURRENT ADDRESS AND M177 ISOLATE SECTOR NUMBER INA ADD 1. CPA SDS#T IF = TO MAX NO. ON SYS. DISC, CLA SET # = 0, STA DISKT AND SAVE NEW SECTOR #. LDA B ISOLATE ALF,ALF TRACK RAL ADDRESS AND M777 IN LOW A. CLB IF NEW CPB DISKT SECTOR # = 0, INA ADD 1 TO TRACK #. * ALF,RAL RESTORE TRACK # TO 14-07, RAL,RAL AND IOR DISKT INSERT SECTOR #. JMP \DSKA,I -RETURN. * DISKT NOP -TEMPORARY STORAGE M177 OCT 177 M777 OCT 777 SDS#T DEC 96 SYSTEM DISK SECTORS PER TRACK SKP * * DISK INPUT DRIVER * * THE \DSKI SUBROUTINE CONTROLS THE INPUT F}ROM THE DISK. * * THIS ROUTINE USES A CORE BUFFER TO MAKE THE DISC APPEAR TO HAVE * 64 WORD SECTORS. * * NOTE... THIS ROUTINE IS GOOD FOR MH & 7905 DISC. * ...MUST BE MODIFIED FOR FH. * * * CALLING SEQUENCE: * A = DISK ADDRESS * B = CORE ADDRESS * JSB \DSKI * * RETURN: CONTENTS OF A AND B ARE DESTROYED. * \DSKI NOP CLE,ERA SET EVEN SECTOR ADDRESS STB \DSKO SAVE CORE ADDRESS FOR MOVE LDB \OBUF+1 GET OUTBUFFER ADDRESS CPA \OBUF REQUESTED SECTOR IN OUTBUFFER? JMP DIS01 YES - GO MOVE * LDB INBUF+1 REQUESTED SECTOR IN INBUFFER? CPA INBUF ? JMP DIS01 YES GO MOVE * ELA SECTOR NOT IN CORE GO CCE TO DRIVER JSB \DSKD TO READ THE SECTOR LDA DCMND SET TO SHOW CLE,ERA SECTOR IN STA INBUF CORE LDB INBUF+1 GET BUFFER ADDRESS DIS01 LDA N64 SET COUNT FOR 64 STA DISKT WORDS SEZ IF ODD SECTOR ADB P64 ADD 64 TO LOCAL BUFFER ADDRESS DIS03 LDA B,I MOVE THE STA \DSKO,I ISZ \DSKO 64 INB WORDS ISZ DISKT TO THE JMP DIS03 USER BUFFER * JMP \DSKI,I RETURN SKP * * DISK OUTPUT DRIVER * * THE \DSKO SUBROUTINE CONTROLS ALL OUTPUT TO THE * DISC. IT USES A CORE BUFFER TO MAKE THE DISC APPEAR TO HAVE 64 * WORD SECTORS. * * NOTE... THIS ROUTINE IS GOOD FOR MH & 7905 DISC. * ...MUST BE MODIFIED FOR FH. * * CALLING SEQUENCE: * A = DISK ADDRESS * B = CORE ADDRESS * JSB \DSKO * * RETURN: CONTENTS OF A AND B ARE DESTROYED. * \DSKO NOP STB \DSKI SAVE CORE ADDRESS LDB DSKA GET LAST MAX ADDRESS CMB,INB SET NEG AND ADB A SUBTRACT FROM CURRENT ACCESS SSB,RSS IF CURRENT HIGHER STA DSKA THEN RESET MAX. CLE,ERA 1> SET TO EVEN SECTOR CPA \OBUF SAME AS CURRENT SECTOR? JMP DIS02 YES - GO MOVE * ELA,CLE NO - SET TO WRITE CURRENT SECTOR STA \DSKA SAVE REQUEST ADDRESS LDA \OBUF GET BUFFER ADDRESS FOR CORE SECTOR LDB \OBUF+1 GET CORE ADDRESS OF THE SECTOR ELA,CLE CLEAR E FOR WRITE JSB \DSKD WRITE THE SECTOR LDA \DSKA GET THE REQUESTED SECTOR LDB \OBUF+1 AND LOCAL BUFFER ADDRESS CCE SET E FOR READ JSB \DSKD READ THE SECTOR LDA \DSKA SET TO SHOW IT IS IN CLE,ERA STA \OBUF CORE DIS02 LDB INBUF IF CURRENT WRITE BUFFER CPA B IS THE READ CCB BUFFER THEN STB INBUF SHOW READ BUFFER EMPTY LDB N64 SET COUNTER FOR STB DISKT 64 WORDS LDB \OBUF+1 GET THE LOCAL BUFFER ADDRESS SEZ IF ADDRESS IS ODD ADB P64 64 TO THE BUFFER LOCATION DIS04 LDA \DSKI,I MOVE STA B,I THE INB ISZ \DSKI TO THE ISZ DISKT LOCAL JMP DIS04 BUFFER AND * JMP \DSKO,I RETURN * DSKA NOP SPC 3 \OBUF OCT 2 DEF BUFOU OUTPUT BUFFER ADDRESS INBUF OCT -1 INBUF IN CORE FLAG (IMPOSSIBLE) DEF BUFIN INPUT BUFFER ADDRESS BUFIN BSS 128 INPUT BUFFER FOR DISC BUFOU BSS 128 OUTPUT BUFFER FOR DISC SKP * THE \DSKD SUBROUTINE PERFORMS ALL I/O TO THE CORE-IMAGE * RTE SYSTEM OUTPUT FILE. THROUGHOUT THE GENERATOR, DISC * ADDRESSES ARE USED AND MAINTAINED AS IN THE OFF-LINE * VERSION SINCE RTE REQUIRES LOCATIONS OF ITEMS ON THE DISC. * DISC ADDRESSES ARE RELATIVE TO THE START OF THE DISC, THUS * ARE RELATIVE TO THE START OF THE OUTPUT FILE. * * \DSKD CONVERTS THE DISC ADDRESS IN THE A-REG (64 WORD BASIS) * TO A RECORD NUMBER WITHIN THE TYPE 1 OUTPUT FILE. READF * AND WRITF CALLS SPECIFY THIS RECORD NUMBER IN ORDER TO * SATISFY THE RANDOM ACCESS NATURE OF I/O TO THIS FILE. * * CALLING SEQUENCE: * * A = DISC ADDR ON A 64 WORD/SECTOR BASIS. * B = CORE ADDRESS. * IF B IS NEGATIVE, AND A IS POSITIVE, THEN WRITE HEADER #1 * IF B IS NEGATIVE, AND A IS NEGATIVE, THEN WRITE HEADER #2 * E = 1 FOR READ, * = 0 FOR WRITE. * * * RETURN - ALWAYS NORMAL, REGS DESTROYED. * \DSKD NOP SSB,RSS IF NEGATIVE,THEN WE'RE JMP DIS0 WRITING THE HEADER RECORD STB HEADR WSET FLAG CMB,INB SSA,RSS CHECK IF A IS NEGATIVE CLA,RSS NO, HEADER RECORD #1 CLA,INA HEADER RECORD #2 INA STA NUM FOR THE WRITE * DIS0 STB BUFR1 STORE CORE ADDR IN STB BUFR2 READF AND WRITF CALLS. CLB ELB STB \FMRR TEMP SAVE READ-WRITE CODE. * * COMPUTER RECORD NUMBER FROM THE DISC ADDRESS * LDB HEADR SSB JMP DIS1 HEADER RECORD - WRITE IT STA DCMND SAVE DISC ADDR. AND M177 ISOLATE SECTOR (64 BASIS). STA SECT1 XOR DCMND ISOLATE THE TRACK. ELA,CLE,ERA ALF,ALF RAL MPY SDS#T MULT. BY # 64 WD SECT/TRACK. ADA SECT1 ADD OFFSET. CLE,ERA FORM 128 WORD SECTOR # (0,1,2,,,) ADA P3 GET RECORD NUMBER (2,3,4,,,) STA NUM SAVE FOR CALL. * DIS1 LDA \FMRR SEE IF READ OR WRITE. SZA JMP READD * JSB WRITF WRITE. DEF *+6 DEF ABDCB DEF \FMRR BUFR1 NOP DEF IL DEF NUM * LDA \FMRR CHECK FOR END OF FILE. ADA P12 SZA JMP CHK NOT END. LDA ERR17 IRRECOVERABLE ERROR! JSB \IRER * READD JSB READF READ. DEF *+7 DABDC DEF ABDCB DEF \FMRR BUFR2 NOP DEF IL DEF LEN DEF NUM * * IGNORE -12 ERROR (EOF SENSED) ON READ: THAT RECORD * HAS NOT YET BEEN WRITTEN. BUFFER WILL CONATAIN * GARBAGE BUT OK FOR PACKING PURPOSES. * LDA \FMRR CPA N12 JMP \DSKD,I RETURN * CHK LDA DABDC JSB \CFIL CHECK FOR ERRORS. JSB \TERM ERROR - ABORT. CLA STA HEADR RESET JMP \DSKD,I NO ERROR, RETURN. * DCMND NOP SECT1 NOP NUM NOP IL DEC 128 LEN NOP N12 DEC -12 P12 DEC 12 ERR17 ASC 1,17 HEADR NOP HEADER RECORD FLAG SKP * * OUTPUT ABSOLUTE PROGRAM WORD * * \ABDO PUTS OUT THE CURRENT ABSOLUTE CODE WORD FOR THE PROGRAM * BEING LOADED. IT FILLS THE GAPS WITH ZERO CODES IF THE * CURRENT WORD FALLS BEYOND THE HIGHEST PREVIOUSLY GENERATED * WORD. * * \ABDO WORKS FROM A TABLE OF THREE WORDS WHICH DEFINE * THE CURRENT CODE SEGMENT'S DISC ADDRESS. THIS TABLE IS * AS FOLLOWS: * * ABDSK,I IS THE BASE DISC ADDRESS OF THE CURRENT CODE SEGMENT * \ABCO,I IS THE BASE CORE ADDRESS OF THE CURRENT CODE SEGMENT * \MXAB,I IS THE MAX CORE ADDRESS OBTAINED SO FAR IN THE SEGMENT * * \MXAB,I SHOULD BE INITILIZED TO \ABCO,I AND WILL BE UPDATED BY * THIS ROUTINE AS THE LOAD ADVANCES. * * THIS ROUTINE HAS NO RESTRICTIONS ON BACKING UP AND OVERLAYING. * * CALLING SEQUENCE: * A = CURRENT ABSOLUTE CODE WORD * B = CORE ADDRESS OF THE WORD * JSB \ABDO * * RETURN: A-REG HAS PREVIOUS CONTENTS OF MODIFIED WORD. * B-REG HAS CORE ADDRESS PLUS ONE * \ABDO NOP SSB IF LESS THAN ZERO THEN JMP \ABDO,I OVER FLOW OF MEM SO IGNOR * STB CASAV SAVE THE CORE ADDRESS STA INSAV AND THE CODE WORD ADB L2000 IF ADDRESS SSB IS ON THE JMP LABBP BASE PAGE GO DO SPECIAL * LDA \ABCO SAVE CURRENT BASE PRAM STA LABTM IN LOCAL TEMP LDB A,I IF THE CURRENT CORE LDA P5 ADDRESS IS LESS CPA \PTYP THAN THIS BASE AND SEG. LOAD CMB,INB,RSS JMP LAB01 / NOT A SEG LOAD * ADB CASAV IF BOTH CONDITIONS TRUE SSB THEN JSB \USER SET UP TO FIX MAIN. LAB01 LDB CASAV RESTORE THE CORE ADDRESS CMB,INB COMPUTE OFFSET FROM OLD ADB \MXAB,I MAX INB AND STB LABSK SET THE SKIP COUNT (-# TO SKIP) LDA \MXAB,I GET THE CURRENT MAX INA PLUS ONE SSB,RSS IF NOT SKIPPING LDA CASAV USE GIVEN ADDRESS LDB \ABCO,I AND COMPUTE CORE CMB,INB ADDRESS OFSET ADA B FROM THE BASE ADDRESS SSA DIAGOSTIC HALT JSB \ABOR SHOULD NEVER BE NEGATIVE CLB PREPARE TO DIVIDE DIV P64 DIVIDE BY THE SECTOR SIZE ADB \ADBF SET DBUF OFFSET STB CURAD SET ADDRESS FOR TSTEL * STA B SAVE THE SECTOR COUNT LDA ABDSK,I GET THE BASE DISC ADDRESS CMB,INB,SZB,RSS SET THE COUNT NEGATIVE JMP FSTAD IF ZERO USE FIRST ADDRESS * STB ABCNT SET THE CALL COUNTER LABSA JSB \DSKA BUMP THE DISC ADDRESS ISZ ABCNT THE SPECIFIED NUMBER JMP LABSA OF TIMES * FSTAD STA NEWDA SET THE NEW DISC ADDRESS CPA \OLDA IF SAME AS OLD JMP LABIC SECTOR IS IN CORE * LDA \OLDA GET THE OLD ADDRESS LDB \ADBF AND BUFFER ADDRESS SSA,RSS IF REAL DISC ADDRESS JSB \DSKO WRITE THE BUFFER LDB LABSK GET THE SKIP COUNT CMB,INB SET POSITIVE LDA \ADBF IF FIRST WORD OF BUFFER CPA CURAD AND NOT BACKING SSB UP RSS JMP LABRD SKIP THE READ * LDB \ADBF READ IN THE SECTOR LDA NEWDA TO BE MODIFIED JSB \DSKI LABRD LDA NEWDA UPDATE THE DISC STA \OLDA ADDRESS LABIC LDA LABSK GET THE SKIP COUNT SSA,RSS IF NONE TO SKIP JMP LABOU JUST OPUTPUT THE WORD * LABFI CLA "1ELSE FILL JSB TSTEL WITH ZEROS ISZ LABSK DONE? JMP LABFI NO DO NEXT WORD * LABOU LDA INSAV GET THE WORD JSB TSTEL OUTPUT IT STB LBSAV SAVE PRIOR CONTENTS OF WORD LDA CASAV GET THE CORE ADDRESS LDB A IF NEW CMB,INB MAXIMUM ADB \MXAB,I THEN SSB SET STA \MXAB,I SET IT LDA LABTM RESET JSB SETDS THE PRAMETERS LDA \OLDA IF NEW MAX CMA,INA DISC ADDRESS ADA \ADSK THEN LABEX LDB CASAV INB SSA,RSS SKIP RETURN JMP LABX2 * LDA \OLDA AND STA \ADSK UP DATE THE DISC ADDRESS LABX2 LDA LBSAV SET PRIOR CONTENTS OF WORD JMP \ABDO,I AND THEN RETURN SPC 2 LABBP LDB CASAV GET THE CORE ADDRESS ADB \ADBP ADJUST FOR DUMMY BASE PAGE ADDRESS LDA B,I RETURN OLD STA LBSAV CONTENTS LDA INSAV OF WORD. STA B,I SET THE WORD CLA SET TO FOURCE EXIT JMP LABEX AND GO EXIT SPC 2 LABTM NOP NEWDA NOP \OLDA OCT -1 LABSK NOP INSAV NOP CASAV NOP ABDSK NOP \ABCO NOP \MXAB NOP LBSAV NOP USED HERE AND IN TSTEL * TO RETURN OLD VALUE OF * MODIFIED WORD. ABCNT NOP CURAD NOP L2000 OCT -2000 \ADSK NOP \PTYP NOP SKP * * SETDS SETS ABDSK,\MXAB,\ABCO TO A,A+1,A+2 * FOR USE BY \ABDO * SETDS NOP STA \ABCO SET INA THE STA \MXAB ADDRESS INA FOR STA ABDSK THE ABS OUTPUT ROUTINE JMP SETDS,I RETURN SPC 3 * \USER RESETS THE \ABDO SPECIFICATION ADDRESSES FOR * DRIVER PARTITIONS (FROM 2 ONWARD), MEMORY RESIDENT * PROGRAMS, AND DISK RESIDENT PROGRAMS * * CALLING SEQUENCE * * JSB \USER * \USER NOP LDA DUSER GET DEF TO USER ARRAY  JSB SETDS AND SET IT UP JMP \USER,I RETURN SPC 3 * \USRS INITIALIZES THE \ABDO SPECIFICATION ADDRESSES FOR * \USER CODE USING THE CURRENT DISC ADDRESS,AND \PREL * FOR THE CORE ADDRESS. * * CALLING SEQUENCE: * * JSB \USRS * \USRS NOP JSB \USER SET UP THE ADDRESSES JSB SET SET UP THE ADDRESSES JMP \USRS,I RETURN SPC 2 * SET SETS THE CURRENT \PREL AND DISC ADDRESSES IN THE * CURRENT \ABDO SPECIFICATION TABLE * * CALLING SEQUENCE * * JSB SET * SET NOP LDA \ADSK GET CURRENT DISC ADDRESS STA ABDSK,I SET IT IN THE SPEC BUFFER LDA \PREL GET THE CURRENT CORE ADDRESS STA \ABCO,I AND SET STA \MXAB,I IT UP JMP SET,I RETURN SPC 2 * \SEGS SETS UP A NEW \ABDO AREA FOR SEGMENTS * THE SAME AS \USRS. * \SEGS NOP JSB \SEG GO SET THE ADDRESSES JSB SET SET THE PRAMATERS JMP \SEGS,I RETURN SPC 2 * \SEG IS THE SEGMENT VERSION OF \USER * \SEG NOP LDA DSEGS GET THE ADDRESS JSB SETDS SET IT UP JMP \SEG,I RETURN SPC 3 * * \SYS SETS UP THE \ABDO SPECIFICATION ARRAY TO POINT AT THE * SYSTEM TABLE. * * CALLING SEQUENCE: * * JSB \SYS * \SYS NOP LDA \DSYS GET THE SYSTEM SPEC. ADDRERSS JSB SETDS SET UP THE ADDRESSES JMP \SYS,I RETURN SPC 2 \DSYS DEF *+1 OCT 2000 ***TEMP****** OCT 2000 ***TEMP****** NOP DUSER DEF *+1 BSS 3 DSEGS DEF *+1 BSS 3 SKP * * TEST FOR ABSOLUTE BUFFER FULL * * TSTEL PUTS OUT THE CURRENT ABSOLUTE BUFFER WHEN IT * CONTAINS 64 WORDS OF CODE. IN ADDITION, IT CHECKS FOR * * CALLING SEQUENCE: * A = CURRENT WORD * B = IGNORED * JSB TSTEL * * RETURN: A DESTROYED, B HAS OLD CONTENTS * OF AD*B@0 IF YES) LBCAD BSS 1 FIRST WORD OF MEMORY RES LIBRARY LEND BSS 1 LAST WORD OF MEMORY RES LIBRARY FWMRP BSS 1 FIRST WORD OF MEMORY RES PROGRAM AREA EMRP BSS 1 LAST WORD OF MEMORY RES PROGRAM AREA FPMRP BSS 1 FIRST PAGE OF MEMORY RES PROGRAM AREA FPMBP BSS 1 PAGE # FOR MEMORY RES BASE PAGE MRP# BSS 1 # PAGES OCCUPIED BY MRL & MRP'S DSKMB BSS 1 DISK ADDRESS OF MEMORY RES BASE PAGE DSKMR BSS 1 DISK ADDRESS OF MEMORY RESIDENT LIB/PROG AREA DSKBP BSS 1 SYSTEM DISK ADDRESS * DSKAV BSS 1 NEXT AVAILABLE DISK ADDRESS DSKLC BSS 1 DISK ADDRESS OF LIBRARY CODE DSKLB BSS 1 DISK ADDR OF LIBRARY ENTRY PTS DSKUT BSS 1 UTILITY PROG DISK ADDRESS DSKBS BSS 1 DISK ADDR OF MAIN BG DISK RES BP DSKBR BSS 1 CURRENT MAIN BG DISK RES DISK AD ADICT BSS 1 ADDR OF DISK DICTIONARY LBCNT BSS 1 RESIDENT LIBR ENTRY PT COUNT SYCNT BSS 1 SYSTEM ENTRY POINT COUNT KEYAD BSS 1 CURRENT KEYWORD ADDRESS * SYBAD BSS 1 ADDR OF FIRST BP LINK FOR BG IDSAD BSS 1 ADDR OF FIRST ID SEGMENT ABSID BSS 1 IDENT ADDR FOR NEXT BG SEG SCAN IDMBS BSS 1 BG MAIN ADDRESS FOR BS REF * * ********************************************************* * * * END OF COMMON STORAGE BLOCK FOR ALL SEGMENTS. * * * ********************************************************* * SKP BEGIN JMP \SRET SEGMENT'S ENTRY POINT ABOOT DEF START ADDRESS OF. BOOTSTRAP LOADR * INTMP BSS 1 TEMP FOR INITILIZATION ROUTINES MS3 DEF *+1 SUBCHANNEL NUMBER MESAGE ASC 2, MES1 DEF *+1 ASC 15,# TRKS, FIRST TRK ON SUBCHNL: * MES4 DEF MES04 MES04 ASC 8,BOOT FILE NAME? MES05 ASC 8,SYSTEM SUBCHNL? MES07 ASC 9,AUX DISC SUBCHNL? MES40 DEF *+1 ASC 13,# 128 WORD SECTORS/TRACK? "/E" ASC 1,/E "?0" ASC 1,?0 MES5 DEF MES05 MES7 DEF MES07 TTEMP NOP STEMP NOP P23 DEC 23 N8 DEC -8 * ATB30 DEF TB30 HED INTERACTIVE DISC SET UP SECTION * * THE FOLLOWING MESSAGES ARE PRINTED DURING THE INITIALIZATION * PHASE, WITH THE SPECIFICATIONS FOR EACH VALID RESONSE. * * * MESSAGE RESPONSE * * CONTROLLER SELECT CODE? ENTER 2 OCTAL DIGITS * * # TRKS, FIRST TRK ON SUBCHNL: * 0? * . ENTER TWO 3 DIGIT DECIMAL NOS. * . SEPERATED BY A COMMA * . OR * . /E * 7? * * SYSTEM SUBCHNL? ENTER 1 OCTAL DIGIT * * AUX DISC (YES OR NO)? ENTER YES OR NO * * AUX DISC SUBCHNL? ENTER 1 OCTAL DIGIT SPC 3 \DST0 NOP ENTRY POINT FOR QUESTION SECESSION. LDB $TB31 PUT TB31 IN THE LST JSB \LSTE NOP IGNOR AL\READY THERE RETURN CHNLD LDA P23 LDB MESS2 MESS2 = ADDR: CONTROLLER SELECT CODE? JSB \READ PRINT MESSAGE, GET REPLY LDA P2 SET FOR 2 OCTAL DIGITS INPUT JSB \DCON GET DIGITS, RETURN OCTAL JMP CHNLD REPEAT INPUT * STA DCHN SET DISK CHNL # FOR BOOTSTRAP. STA DCHNL SET DISK CHNL # ADA N8 MUST BE >= TO 10 OCTAL SSA,RSS JMP STB30-1 JSB \INER JMP CHNLD * JSB \SPAC SET UP TRACK MAP STB30 LDA P29 SEND MESSAGE: LDB MES1 # TRKS, FIRST TRK ON SUBCHNL: JSB \MESS PRINT MESSAGE LDA ATB30 SET ADDRESSES STA STEMP FOR INPUT *TEMP* STA INTMP AND CLEAR LOOPS ADA P8 SET # TRACKS ADDRESS STA TTEMP * TEMP * LDB N16 CLEAR CLA THE TB30. STA INTMP,I TRACK ISZ INTMP MAP INB,SZB STEP COUNT - DONE? JMP TB30. NO - CLEAR NEXT WORD * STA #SUBC SET 0 DEFINED SUBCHANNELS TB30A STB INTMP SAVE CURRENT UNIT ADB "?0" ADD CONSTANT TO GET ?X BLF,BLF AND ROTATE TO GET X? STB MS3+2 SET IN MESSAGE LDB MS3 GET MESSAGE ADDRESS LDA P4 AND LENGTH JSB \READ GO GET THE ANSWER LDA N2 GET FIRST JSB \GETN TWO CHARACTERS CPA "/E" /E? JMP TB30X YES - GO CHECK FURTHER * JSB \GINT NO - REINITIALIZE LBUF SCAN LDA N3 CONVERT 3 DIGITS JSB \GET# DECIMAL JMP TB30E ERROR - * STA TTEMP,I SET # TRACKS SZA,RSS IF ZERO JMP TB30B GO UPDATE POINTERS * JSB \GETC NOT ZERO - GET NEXT CHARACTER CPA BLANK COMMA IN? RSS YES - SKIP JMP TB30E NO - ERROR * LDA N3 SET FOR JSB \DCON 3 DECIMAL DIGITS AND CONVERT JMP TB30E+1 ERROR * STA STEMP,I SET FIRST TRACK OF CHANNEL LDA TTEMP,I GET CHANNEL SIZE STA DSIZE SET SYSTEM LDA INTMP TO THIS SUBCHANNEL STA SYSCH FOR DEFAULT TB30B ISZ #SUBC STEP TOTAL SUBCHANNEL COUNT ISZ STEMP STEP TABLE ISZ TTEMP ADDRESSES ISZ INTMP STEP SUBCHANNEL TB30F LDB INTMP IF CURRENT SUBCHANNEL CPB P8 IS 8 THEN JMP TB30Y DONE SO GO EXIT * JMP TB30A NOT 8 - GO ASK FOR NEXT ONE * SPC 1 TB30E JSB \INER TELL HIM THERE WAS AN ERROR CLA CLEAR STA TTEMP,I CURRENT # TRACKS JMP TB30F GO ASK AGAIN * SPC 1 TB30X JSB \GETC /E ENTERED SZA ANY THING ELSE? JMP TB30E YES - wERROR * TB30Y LDA #SUBC NO - GET NUMBER OF CHANNELS CMA,INA,SZA DEFINED - IS IT ZERO? JMP TB30Z NO - SKIP * JSB \INER YES - TELL HIM JMP STB30 AND RESTART * TB30Z JSB \SPAC ISYSC LDA P15 SEND MESSAGE: LDB MES5 SYSTEM SUBCHNL? JSB \READ GET ANSWER LDA N3 OCTAL RESPONSE JSB \DCON GO CONVERT JMP ISYSC ERROR - TRY AGAIN * JSB TSTCH TEST FOR LEGAL SUBCHANNEL STB DSIZE SET SYSTEM SIZE STA SYSCH SET SYSTEM SUBCHANNEL * ADB M7400 IF GREATER THEN 256, CMB,SSB,INB,SZB RSS THEN ERROR JMP SETEM+1 JSB \INER SEND ERROR DIAGNOSTIC JMP ISYSC * SETEM CLA LDB ATB30 EXTRACT INFO ADB A CONCERNING SYSTEM LDB B,I SUBCHANNEL STB T#AC0 AND STORE VALUES FOR BOOT STB TBASE STARTING TRACK # * LDB A CLE,ERB STB UN#IT STB U#NIT * XOR P1 SET PLATTER NUMBER. ALF,ALF RAL STA H#AD STA B#MSK * LDA S#EKC ADA B STA S#EKC SET HEAD # IN SEEK COMMAND STA SKCMD * LDA R#DCM ADA B STA R#DCM AND IN THE \READ COMMAND STA R#CMD SPC 1 AUXIN CLA PRESET TO SHOW NO AUX DISC STA DAUXN SET CHANNEL TO ZERO STA ADS# CCA AND SUBCHANNEL STA AUXCH TO -1. JSB \SPAC AUXDS LDA P31 SEND MESSAGE LDB MES6 AUX DISC (YES OR NO OR # TRKS)? JSB \READ GO GET ANSWER LDA N3 FIRST TRY FOR A DECIMAL JSB \GET# NUMBER JMP AUX0 NO TRY FOR YES OR NO * STA \TBUF SAVE THE NUMBER JSB \GETC END OF INPUT? SZA JMP AUX0 NO LET \YENO SEND ERROR * LDA \TBUF RESTORE THE SIZE TO A AND STA DAUXN SET THE AUX DISC SIZE JSB niDSSIZ GET ITS # SECTORS / TRACK JMP AUX3 GO SET IT * AUX0 JSB \GINT RESET THE SCANNER JSB \YENO TRY FOR YES OR NO JMP AUXDS NO MUST BE BAD ANSWER * JMP STSCR NO - SKIP * CLA,INA YES - IF ONLY ONE CPA #SUBC DISC SUBCHANNEL THEN JMP AUX4 THEN WRONG ANSWER TRY AGAIN * JSB \SPAC YES - SET UP AUX UNIT AUXUN LDA P17 SEND QUESTION: LDB MES7 AUX DISC SUBCHNL? JSB \READ GO SEND AND GET ANSWER LDA N3 OCTAL RESPONSE JSB \DCON JMP AUXUN ERROR - TRY AGAIN * JSB TSTCH TEST FOR LEGAL UNIT STB DAUXN SET SIZE OF AUX UNIT CPA SYSCH SAME AS SYSTEM? RSS YES - ERROR SKIP JMP AUX2 NO - GO SET UP * AUX4 JSB \INER SEND ERROR MESSAGE JMP AUXIN AND TRY AGAIN * SPC 1 AUX2 ADB M7400 IF SIZE IS GREATER CMB,SSB,INB,SZB JMP AUX4 THAN 256, THEN ERROR * STA AUXCH SET AUX CHANNEL LDA P96 SET AUX TRK SIZE TO SAME AS SYS DISC AUX3 STA ADS# SET AUX DISC # SECT. TRACK SPC 1 STSCR JMP \DST0,I RETURN TO MAIN LINE CODE * P96 DEC 96 M7400 OCT 177400 SPC 1 * * GET # SECTORS FOR DISC * DSSIZ NOP JSB \SPAC NEW LINE #SEC1 LDA P25 LDB MES40 MES40 = ADDR: # 128 WORD SECTORS/TRACK?$$ JSB \READ PRINT MESSAGE, GET REPLY LDA N3 SET FOR 3 DECIMAL DIGITS INPUT JSB \DCON GET DIGITS, RETURN OCTAL JMP #SEC1 REPEAT INPUT * ALS DOUBLE FOR 64 WORD SECTORS JMP DSSIZ,I RETURN SKP SPC 3 * SUBROUTINE TO TEST LEGALITY OF * A SUBCHANNEL. THE TEST CONSISTS * OF LOOKING FOR THE DESIRED * CHANNEL IN THE TRACK MAP. * y<:6CALLING SEQUENCE * * P-1 ERROR RETURN * P JSB TSTCH * P+2 NORMAL RETURN CHANNEL IN A SIZE IN B SPC 1 {<* A ON ENTRY IS ASSUMED TO BE THE SUBCHANNEL TO BE CHECKED. * ERROR EXIT IS P-1 * IF THE SUBCHANNEL IS LEGAL IT IS RETURNED IN A * AND B IS THE NUMBER OF TRACKS ON THAT CHANNEL SPC 1 TSTCH NOP LDB A TEST FOR VALID SUBCHANNEL # ADB N8 SSB,RSS JMP TSTER NO GOOD * LDB ATB30 GET TABLE ADDRESS ADB A ADD SUBCHANNEL ADB P8 STEP TO # TRACKS LDB B,I GET # TRACKS IN B SZB IF ZERO - ERROR - SKIP JMP TSTCH,I ELSE OK - RETURN B= # TRACKS * TSTER JSB \INER SEND ERROR MESSAGE LDA TSTCH GET RETURN ADDRESS ADA N2 ADJUST FOR P-1 JMP A,I AND RETURN SKP * * INSERT CHNL NO. IN INSTRUCTION * * THE STDSK SUBROUTINE SETS THE CURRENT DISK CHANNEL * NOS. IN THE I/O INSTRUCTIONS. * * CALLING SEQUENCE: * A = NO. WORDS TO BE CONFIGURED (NEG.) * B = ADDRESS OF INSTRUCTION ADDR LIST * JSB STDSK * * RETURN: * A = DESTROYED * B = NEXT INSTRUCTION ADDRESS * STDSK NOP STA \TBUF SAVE NO. OF INSTRUCTIONS STDS1 LDA B,I GET INSTRUCTION AND M7700 ISOLATE INSTRUCTION CODE IOR DCHN INSERT CHANNEL NO. STA B,I SET INSTRUCTION IN CODE INB INCR INSTRUCTION ADDRESS ISZ \TBUF SKIP - ALL INSTRUCTIONS CONFIG. JMP STDS1 CONFIGURE NEXT INSTRUCTION JMP STDSK,I RETURN * SPC 2 DCHN NOP HPDSK DEF I/OTB,I ADDRESS OF I/O INSTR LIST #DATA ABS I/OTB-I/OTC # OF DATA I/O INSTR #CMND ABS I/OTC-I/OTD # OF COMMAND I/O INSTR I/OTB DEF DSKDJ DATA CHANNEL DEF DSKDK DEF DSKDL DEF DSKDM DEF DSKDN DEF DSKDO DEF DSKPP DEF DSKDQ DEF DSKDR DEF DSKDS DEF DSKDZ I/OTC DEF DSKCL COMMAND CHANNEL DEF DSKCM DEF DSKCP DEF DSKCQ DEF DSKCR DEF DSKCS z DEF DSKCT DEF DSKCU DEF DSKCV I/OTD EQU * HED MH RTGEN CONFIGURE AND COMPLETE INITILIZATION \BOT0 NOP CONFIGURE PAPER TAPE BOOTSTRAP LDA #DATA GET THE NUMBER OF DATA CHANNEL INSTRUCTIONS LDB HPDSK GET THE ADDRESS OF THE DISK ADDRESSES JSB STDSK GO SET DATA CHANNEL ADDRESSES ISZ DCHN STEP TO COMMAND CHANNEL LDA #CMND GET NUMBER OF COMMAND CHANNEL INSTRUCTIONS JSB STDSK SET COMMAND CHANNEL ADDRESSES * LDA BADD GET THE BOOT ADDRESS AND M1177 MASK TO PAGE BITS AND IOR M0760 ADD PAGE BITS AND STA BADD SET FOR THE PAPER BOOT * * SEND BOOT EXTENSION TO OUTPUT FILE * LDB ABOOT OUTPUT THE BOOT EXT ENSION CLA,CLE TO PSEUDO TRACK 0 SECTOR 0 JSB \DSKD IN CORE IMAGE OUTPUT FILE. SKP BOOT0 JSB \SPAC NEW LINE LDA P15 SEND MESSAGE LDB MES4 BOOT FILE NAME? JSB \RNME GET THE NAME. * JSB \GINT IF 0 ANSWER, THEN CLA,INA NO BOOT WANTED JSB \GETN CPA ZERO JMP \BOT0,I * JSB \CRET CREATE BOOT FILE. DEF *+5 DEF \BDCB DEF P1 DEF P7 DEF M2300 * CLA JSB \CFIL CHECK FILE STATUS. JMP BOOT0 ERROR- TRY AGAIN. * LDA NBLC GET BOOT LENGTH STA \TBUF SET FOR CHECK SUM CACULATION LDA STRAP GET LOAD ADDRESS CLB,RSS INITIALIZE CHECKSUM BOOT1 ADB A,I COMPUTE CHECKSUM INA STEP ADDRESS ISZ \TBUF DONE? JMP BOOT1 NO - GET NEXT WORD * STB A,I YES - SET CHECKSUM * JSB WRITF OUTPUT THE BOOTSTRAP FILE. DEF *+5 DEF \BDCB DEF \FMRR DEF STRAP+1 DEF BOOTL * LDA \BDCB+2 IF ITS A TYPE 0 FILE SZA THEN WRITE AN EOF JMP \BOT0,I NO JSB WRITF DEF *+5 4 DEF \BDCB DEF \FMRR DEF STRAP+1 DEF N1 JMP \BOT0,I RETURN TO MAIN. SPC 2 MESS2 DEF *+1 ASC 12,CONTROLLER SELECT CODE? MES6 DEF *+1 ASC 16,AUX DISC (YES OR NO OR # TRKS)? P7 DEC 7 N1 DEC -1 M2300 OCT 2300 ZERO OCT 60 P6144 DEC 6144 P24 DEC 24 * SKP * GENERATE $TB31 TRACK MAP TABLE. * \TB31 NOP * GENERATE TB31 SPC 2 LDA ATB30 GET THE TABLE ADDRESS STA \TBUF SET FOR INDEXING LDA N16 GET NUMBER OF WORDS STA \TBUF+1 SET COUNT LDB $TB31 GET THE LST ENTRY JSB \LSTS FOR $TB31 JSB \ABOR BAD NEWS NO $TB31 ????? LDB \PREL GET THE CORE ADDRESS FOR TABLE STB \LST5,I SET IN THE SYMBOL TABLE * DSTB1 LDA \TBUF,I GET WORD FROM TABLE JSB \ABDO SEND TO DISC ISZ \TBUF STEP TABLE ADDRESS ISZ \TBUF+1 STEP COUNT - DONE? JMP DSTB1 NO - GET NEXT ENTRY * STB \PREL RESET NEW CORE ADDRESS * LDB ATB30 SIGNAL \DSKD TO CMB,INB WRITE HEADER RECORD #2 CCA,CLE CONTAINING THE JSB \DSKD TRACK MAP TABLE IMAGE JMP \TB31,I EXIT * $TB31 DEF *+1 ASC 3,$TB31 * SKP * * FSECT IS A ROUTINE TO SET LOAD SPECS IN THE LOAD SPEC. * TABLE IN THE DISC RESIDENT BOOT EXTENSION AND TO * FLUSH THE FINAL SECTOR FROM CORE AT THE END OF * GENERATION. * * \FSC0 NOP LDB ABOOT GET THE CLA,CCE BOOT FROM JSB \DSKD THE DISC LDB LWSLB STORE HIGH ADDRESS OF SYSTEM STB HIGH IN BOOT LDB ABOOT NOW WRITE CLA,CLE THE BOOT JSB \DSKD BACK TO THE DISC CLE DLD \OBUF FLUSH THE FINAL BUFFER. ELA,CLE FROM CORE JSB \DSKD * * STORE THE SYSTEM SUBCHANNEL INFORMATION IN THE FIRST * 6 WORDS OF HEADER RECORD@ #1, THEN WRITE IT. * * LDA SYSCH SET WORDS 1-6 IOR MSIGN SIGNAL AN RTE-IV SYSTEM FOR SWTCH STA TB30 SYSTEM SUBCHANNEL LDA DRT2 AND M77 STA TB30+1 SYSTEM EQT # LDA CEQT STA TB30+2 # OF EQT'S LDA \PIOC STA TB30+3 PRIV INT CHANNEL LDA \TBCH STA TB30+4 TBG CHANNEL LDA TB30+127 RETRIEVE FROM TEMP. STORAGE AND M77 LDB #SUBC GET THE # OF DEFINED SUBCHANNELS BLF,BLF ROTATE TO HIGH BYTE IOR B MERGE WITH TTY CHANNEL STA TB30+5 AND SAVE LDB ATB30 CMB,INB CLA,CLE JSB \DSKD WRITE IT OUT * JMP \FSC0,I RETURN HED RTGN1 CONSTANTS AND WORKING STORAGE. N2 DEC -2 N3 DEC -3 N16 DEC -16 P1 DEC 1 P2 DEC 2 P4 DEC 4 P6 DEC 6 P8 DEC 8 P13 DEC 13 P15 DEC 15 P17 DEC 17 P25 DEC 25 P29 DEC 29 P31 DEC 31 M77 OCT 77 M0760 OCT 76000 M1777 OCT 1777 M7700 OCT 177700 M1177 OCT 101777 BLANK OCT 40 MSIGN OCT 100000 * BSS BEG00+1600B-* SKP HED RT4GN DISC DRIVE I/O INSTRUCTION ADDRESSES HED RT4GN ** TRACK 0 SECTOR 0 BOOT EXTENSION ** * * THE FOLLOWING LOADER PERMITS LOADING OF THE RESIDENT PORTIONS * OF THE REAL TIME MONITOR. THE LOADER IS LOCATED ON SECTOR 0/1, * TRACK 0 OF THE SYSTEM DISC. IT IS GENERATED BY THE SYSTEM * GENERATOR AND CONSISTS OF: * * (1) THE INSTRUCTIONS REQUIRED FOR LOADING THE SYSTEM * (2) THE DISK AND CORE ADDRESSES SPECIFYING LOADING * * * THE PROGRAM IS ASSUMED TO BE LOADED IN THE AREA JUST PRECEDING * THE PROTECTED LOADER. * START ABS LDA-O+HIGH HIGH CORE ADDRESS CMA,CCE COMPLEMENT, SET DIRECTION BIT ABS STA-O+RECNT INITIALIZE INITIALIZE COUNT ERB 100000B IS LOW CORE ADDRESS WITH CLC 2 DIRECTION BIT SET OTB 2 SET MEMORY ADDRESS REGISTER ABS LDA-O+SC SZA,RSS  COMING FROM PAPER TAPE BOOT? LIA 1 YES, READ CONTENTS OF SWITCH REGISTER LSR 6 ABS AND-O+B77 GET DISC SC ABS STA-O+SC SAVE IT LOOP ABS LDA-O+STIO+I+I CONFIGURE I/O INSTR FROM STIO ABS LDB-O+STIO+I+I ABS AND-O+IOMSK MASK OUT LOWER 6 BITS IN INSTR ABS ADB-O+SC CONFIGURE INSTR FOR DISC SC ABS CPA-O+IOG IS THIS INSTR IN I/O GROUP? ABS STB-O+STIO+I+I YES, THEN STORE IT BACK ABS ISZ-O+STIO MOVE ON TO THE NEXT INSTR ABS LDA-O+STIO ABS CPA-O+ENIO ALL DISC IO INSTR CONFIGURED? CLB,INB,RSS YES,SET B TO 1 FOR SECTOR # ABS JMP-O+LOOP NO, THEN CONFIGURE THE NEXT ONE * ABS LDA-O+TBASE GET ABSOLUTE TRACK # ABS STA-O+T#ACK SAVE FOR ADDRESSSING ABS LDA-O+N#WDS SLOAD ABS ADA-O+#WDTK NUMBER OF WORDS PER TRACK ABS STA-O+P#WDS SET POSITIVE # WORDS CMA,INA AND ABS STA-O+N#WDS NEGATIVE # WORDS THIS TRACK ABS LDA-O+RECNT GET NUMBER LEFT SSA,RSS IF POSITIVE JMP 3B,I DONE - SO EXIT * ABS ADA-O+P#WDS ELSE SET TO READ ABS STA-O+RECNT SAVE REMANING COUNT RSS SKIP ADDRESS OF BENT ABS 2000B+BENT-OO DEFINE ADDRESS OF BENT SSA NEXT TRACK CLA USE MIN. OF NUMBER ON TRACK OR ABS ADA-O+N#WDS NUMBER LEFT STC 2 SET DMA FOR WORD COUNT OTA 2 AND SEND IT ABS LDA-O+T#ACK GET THE TRACK ADDRESS DSKDA OTA 0 AND SEND DSKDB STC 0,C IT ABS LDA-O+SKCMD GET THE SEEK DSKCA CLC 1 COMMAND AND DSKCB OTA 1 SEND IT DSKCC STC 1,C START SEEK ABS ADB-O+N#SCT SUBTRACK NUMBER PER SIDE SSB,RSS IF SIDE TWO ABS ADB-O+B400 ADD HEAD BIT SSB ELSE ABS ADB-O+P#SCT ADD BACK TO GET SECTOR ABS ADB-O+B#MSK ADD THE SUBCHANNEL HEAD BIT DSKDC SFS 0 WAIT FOR TRACK ABS JMP-O+DSKDC * DSKDD OTB 0 SEND HEAD/SECTOR WORD DSKDE STC 0,C TELL THE CONTROLLER ABS LDA-O+R#CMD GET THE READ COMMAND DSKCD SFS 0 WAIT FOR SEEK ABS JMP-O+DSKCD * DSKCE OTA 1 SEND READ COMMAND DSKDF STC 0,C SET UP FOR READ DSKCF CLC 1 STC 6,C START DMA DSKCG STC 1,C START READ DSKCH SFS 1 WAIT FOR END ABS JMP-O+DSKCH * STF 6 DISABLE DMA FOR STATUS DSKDG STC 0,C DO ABS LDA-O+U#NIT STATUS DSKCI CLC 1 DSKCJ OTA 1 ON UNIT DSKCK STC 1,C DSKDH SFS 0 WAIT FOR STATUS ABS JMP-O+DSKDH * DSKDI LIA 0 GET STATUS SLA,RSS IF BAD ABS JMP-O+GDST STATUS GOOD HLT31 HLT 31B STATUS HALT ABS JMP-O+HLT31 PREVENT FOR RESTARTING * GDST CLB SET SECTOR TO ZERO FOR REST OF SEGMENT ABS ISZ-O+T#ACK STEP THE TRACK ADDRESS CLA AND ABS JMP-O+SLOAD GO LOAD * * DATA AREA T#ACK DEC -128 MOVE COUNT FOR BBDL MOVE B400 OCT 400 P#WDS OCT 77600 N#WDS DEC -128 RECNT OCT 77600 CONFIGURED TO BBL ADDRESS #WDTK DEC 6144 SKCMD OCT 30000 P#SCT DEC 24 # OF SECTORS PER TRACK ON ONE SURFACE N#SCT DEC -24 B#MSK NOP SET BY THE GENERATOR R#CMD OCT 20000 U#NIT NOP SET BY THE GENERATOR SPCAD ABS 2000B-OO+START ADDRESS OF BOOT BEFORE RELOCATION TBASE NOP FIRST TRACK#-MUST BE AT START+143B FOR SWTCH STIO ABS 76000B-O+DSKDA START OF IO INSTRUCTIONS ENIO ABS 76000B-O+DSKDI+1 END OF I/O INSTRUCTIONS IOMSK OCT 172076 IOG OCT 102000 B77 OCT 77 HIGH NOP SC NOP * * BSS 2 CORRECT OFFSET FOR SWTCH * BENT NOP JSB HERE FROM BBDL STF 6 CLEAN UP DMA CLC 0,C AND THE I/O SYSTEM CLB ELIMINATE HLT 77B LIA 1 READ SWITCH REG ABS STA-OO+SC SAVE SWITCH REGISTER CONTENTS LSR 5 SLA,RSS WAS BIT 5 SET IN THE SWITD.CH REG? ABS JMP-OO+NORCN NO, THEN RECONFIG NOT REQD HLT 77B YES, THEN HALT TO LET USER SET SW REG ABS JMP-OO+DRBOT RELOCATE THE REST OF THIS BOOT NORCN OTB 1 CLEAR SWITCH REGISTER * DRBOT ABS LDA-OO+SPCAD+I+I MOVE 128 WORDS TO BBL-128 ABS STA-OO+RECNT+I+I ABS ISZ-OO+SPCAD ABS ISZ-OO+RECNT ABS ISZ-OO+T#ACK DONE? ABS JMP-OO+DRBOT NO GET NEXT WORD * ABS JMP-OO+P#WDS+I+I YES GO EXECUTE THE BOOT * * * * THE FOLLOWING EQU SECTION ALLOWS THE BOOTSTRAP * TO BE LOCATED ANYWHERE IN CORE WHEN OUTPUT TO * DISK, BUT EXECUTABLE FROM THE LAST PAGE OF CORE. * * * O EQU START-1600B SET FOR START AT 1600 PAGE RELATIVE * LDB EQU 066000B LDB STB EQU 076000B STB ADB EQU 046000B ADB JSB EQU 016000B JSB ISZ EQU 036000B ISZ LDA EQU 062000B LDA STA EQU 072000B STA ADA EQU 042000B ADA AND EQU 012000B AND XOR EQU 022000B XOR JMP EQU 026000B JMP CPA EQU 052000B CPA I EQU 040000B INDIRECT BIT (CODE AS I+I) * * THE FOLLOWING EQU ARE USE TO SET UP THE BBDL MOVE CODE * WHEN BOOTED BY THE BBDL THE LOADR IS LOADED TO 2011 * AND JSB'ED TO AT 2055,I (44 RELATIVE) * OO EQU START-11B RELATIVE PAGE LOCATION OF START HED RT4GN PAPER TAPE BOOT STRAP * MOVING HEAD BOOTSTRAP * THIS BOOTSTRAP IS CONFIGURED AND PUNCHED BY THE GENERATOR AND IS * USED TO LOAD THE DISC RESIDENT BOOTSTRAP FROM SYSTEM TRACK * 0 SECTOR 0. * SPC 3 STRAP DEF *+1 ADDRESS OF THE BOOT STRAP ABS BL256 LENGTH OF LOADR IN HIGH HALF OF WORD ABS BORG LOAD ADDRESS S#ART CLC 0,C STOP EVERTHING - RTE IS COMMING! LIMIT LIA 1 READ CONTENTS OF SWITCH REGISTER SSA,RSS RECONFIGURATION DESIRED? JMP SETDS-ADCON NO, SET CURRENT DISC SC IN SWITCH REG ELA,CLE,ERA YES, CLEAR SIGN BIT CLB LSR 6 DISC SC IN THE A=# REG SZA,RSS SPECIFIED? JMP SETDS-ADCON NO, SET CURRENT DISC SC IN SWITCH REG STA DSKSC-ADCON SAVE IT LDA DATA#-ADCON GET THE # OF DATA CHANNEL INSTRUCTIONS LDB DSKAD-ADCON GET THE ADDRESS OF I/O INSTRUCTIONS JSB CNFIG-ADCON CONFIGURE DATA CHANNEL ISZ DSKSC-ADCON COMMAND CHANNEL LDA CMND#-ADCON GET # OF COMMAND CHANNEL INSTRUCTIONS JSB CNFIG-ADCON CONFIGURE COMMAND CHANNEL JMP CNTNU-ADCON * SETDS LDA DSKDJ-ADCON ISOLATE CURRENT DISC SELECT CODE # AND DSKSC-ADCON ALF RAL,RAL MOVE IT TO BITS 6-11 STA DSKSC-ADCON SAVE IT LIA 1 READ SWITCH REGISTER CONTENTS AND CLRDS-ADCON CLEAR BITS 6-11 IOR DSKSC-ADCON INSERT DISC SC # IN BITS 6-11 OTA 1 OF THE SWITCH REGISTER * CNTNU LDA T#AC0-ADCON SEEK DSKDJ OTA 0 TO DSKDK STC 0,C FIRST SYSTEM LDA S#EKC-ADCON TRACK DSKCL OTA 1 DSKCM STC 1,C AND DSKDS SFS 0 JMP *-1-ADCON HEAD * LDA H#AD-ADCON DSKDL OTA 0 START DSKDM STC 0,C SEEK LDA DSKDR-ADCON SET OTA 6 UP CLC 2 DMA LDB BADD-ADCON BUFFER ADDRESS OTB 2 LDA DM128-ADCON 128 WORDS STC 2 OTA 2 DSKDZ SFS 1 WAIT FOR JMP *-1-ADCON SEEK * LDA R#DCM-ADCON SET DSKCP CLC 1 UP DSKCQ OTA 1 THE DSKDN STC 0,C \READ STC 6,C DSKCR STC 1,C START \READ DSKCS SFS 1 WAIT JMP *-1-ADCON FOR IT * STF 6 CLEAR DMA FOR STATUS DSKDO STC 0,C DO LDA UN#IT-ADCON STATUS DSKCT CLC 1 DSKCU OTA 1 DSKCV STC 1,C DSKPP SFS 0 WAIT FOR JMP *-1-ADCON STATUS * DSKDQ LIA 0 RBL,CLE,ERB REMOVE SIGN BIT FROM ADDRESS SLA,RSS ANY ERRORS? JMP BTEXT-ADCON NO, GET READY TO GO TO THE EXTENSION * CPA JSTLD-ADCON  IS THIS THE FIRST TIME? RSS YES, TRY AGAIN. HLT 11B NO HALT JMP S#ART-ADCON RETRY ON RESTART * BTEXT STB A CLEAR B REG FOR THE BOOT EXTENSION CLB JMP A,I GO EXECUTE THE BOOT EXTENSION * JSTLD OCT 040001 DM128 DEC -128 BADDD ABS START-O BADD ABS START-O+I+I THESE UN#IT NOP SEVEN H#AD NOP WORDS S#EKC OCT 30000 ARE R#DCM OCT 20000 SET BY DSKDR OCT 120000 THE T#AC0 NOP GENERATOR MASK OCT 177700 DSKSC OCT 77 CLRDS OCT 170077 I#OTB DEF DSKDJ-ADCON DATA CHANNEL DEF DSKDK-ADCON DEF DSKDL-ADCON DEF DSKDM-ADCON DEF DSKDN-ADCON DEF DSKDO-ADCON DEF DSKPP-ADCON DEF DSKDQ-ADCON DEF DSKDR-ADCON DEF DSKDS-ADCON DEF DSKDZ-ADCON I#OTC DEF DSKCL-ADCON COMMAND CHANNEL DEF DSKCM-ADCON DEF DSKCP-ADCON DEF DSKCQ-ADCON DEF DSKCR-ADCON DEF DSKCS-ADCON DEF DSKCT-ADCON DEF DSKCU-ADCON DEF DSKCV-ADCON I#OTD EQU * * DSKAD DEF I#OTB-ADCON,I ADDRESS OF IO INSTR LIST DATA# ABS I#OTB-I#OTC # OF DATA I/O INSTR CMND# ABS I#OTC-I#OTD # OF COMMAND I/O INSTR * * CNFIG NOP STA LIMIT-ADCON SAVE # OF INSTR CLOOP LDA B,I GET INSTR WORD AND MASK-ADCON CLEAR LOW 6 BITS IOR DSKSC-ADCON ADD NEW DISC SELECT CODE STA B,I RESTORE INSTR WORD INB ISZ LIMIT-ADCON JMP CLOOP-ADCON CONFIGURE NEXT INSTR HNDR JMP CNFIG-ADCON,I RETURN * SPC 1 * NOP LOCATION FOR CHECK SUM SPC 2 BORG EQU 100B RUN TIME ORG OF PAPER BOOT ADCON EQU S#ART-100B ADDRESS ADJUSTING CONSTANT. BL EQU HNDR-S#ART+1 BOOT LENGTH BL4 EQU BL+BL+BL+BL BOOT LENGTH TIMES 4 BL16 EQU BL4+BL4+BL4+BL4 TIMES 16 BL64 EQU BL16+BL16+BL16+BL16 TIMES 64 BL256 EQU BL64+BL64+BL64+BL64 TIMES 256 BOOTL ABS BL+3 LENGTH FOR PUNCHING NBLC ABS -BL-Y<:62 BOOT LENGTH FOR CHECK SUM CACULATION * END EQU * * END BEGIN BQ<ASMB,R,L,C HED RT4G2 - PROGRAM INPUT PHASE SEGMENT NAM RT4G2,5,90 92067-16009 REV.1805 780203 SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 3 ****************************************************************** * * NAME: RT4G2 * SOURCE PART #: 92067-18009 * REL PART #: 92067-16009 * WRITTEN BY: KFH, JH, JC, GAA, EJW * ****************************************************************** SPC 1 ENT \PIP * * EXTERNAL REFERENCE NAMES * EXT \LST1,\LST4,\LST5 EXT \CURL,\LBUF,\TBUF EXT \BPAR,\DPR2 EXT \PRMT,\LSTS,\ILST,\LSTX,\LSTE EXT \TLST,\PLST,\TIDN,\PIDN EXT \INID,\IDXS,\IDX EXT \ID1,\ID2,\ID3,\ID4,\ID5,\ID6,\ID7,\ID8,\ID9,\ID10,\ID11 EXT \ID12,\ID13,\ID14,\ID15,\ID16 EXT \SRET,\RBIN EXT \RDCB,\CLOS,\ABOR EXT \GNER,\MESS,\SPAC,\TERM EXT \OCTN,\BUFL,\TCHR EXT \READ,\GETN,\GETC,\GET# EXT \NDCB,\FMRR,\CFIL,\RNAM EXT READF,WRITF EXT LOCF,RWNDF,APOSN EXT \NAMN,\NAMB,\NAMO EXT \IACM,\TRCM,\TRCH * A EQU 0 B EQU 1 SUP ************************************************************************ * SKP *************************************************************************** * * 770913 * * THE FOLLOWING BLOCK OF STORAGE FOR VARIABLES PRECEEDS, * AND IS REFERENCED BY, EACH SEGMENT. IT IS NOT OVERLAID * AS EACH NEW SEGMENT IS LOADED INTO MEMORY. * * THE LOCATION OF EACH VARIABLE MUST BE THE SAME IN ALL *  SEGMENTS. IF A CHANGE IS MADE, MAKE THE SAME CHANGES * IN THE REST OF THE SEGMENTS. * *************************************************************************** * * TB30 BSS 128 TRACK MAP TABLE/HEADER RECORD BUFFER * ILIST BSS 64 USER SYSTEM PROG IDENT ADDR LIST CURIL BSS 1 CURRENT ILIST ADDRESS * SYSCH BSS 1 SUBCHANNEL OF SYSTEM UNIT. DCHNL BSS 1 CHANNEL OF SYSTEM DISK UNIT AUXCH BSS 1 SUBCHANNEL OF AUX UNIT. DSIZE BSS 1 DISK SIZE -NO. OF TRACKS. #SUBC BSS 1 # DISC SUBCHANNELS DEF'D (7905/7920) DAUXN BSS 1 AUXILIARY DISK SIZE. ADS# BSS 1 AUX DISC SECTORS/TRACK. * * RELOCATION BASE TABLE. RBTA BSS 1 ABSOLUTE PROGRAM BASE. TPREL BSS 1 CURRENT PROGRAM BASE ADDRESS. TPBRE BSS 1 BASE PAGE RELOCATION ADDRESS. COMAD BSS 1 CURRENT COMMON RELOCATION BASE. BSS 1 ABS PROGRAM BASE FOR MR CODE. * WDCNT BSS 1 TEMPORARY WORD COUNTER. DSKSY BSS 1 INITIAL ID SEGMENT DISK ADDRESS IDSP BSS 1 POSITION OF 1ST ID SEG. IN SECT TTYCH BSS 1 SYSTEM TTY CHANNEL NO. * PLFLG BSS 1 PROGRAM LOAD. FLAG = -1/0 = L/NL DSCNT BSS 1 DISK SEGMENT SECTOR COUNT * NXFLG BSS 1 ENT/EXT FLAG = -1/0 EXCNT BSS 1 SYMBOL COUNTER * LCNT BSS 1 CURRENT \LBUF COUNT DCNT BSS 1 CURRENT DBUF COUNT CURAI BSS 1 CURRENT IBUF COUNT * CPLS BSS 1 ADDRESS OF TOP OF FIXED CP LINK IMAGE CPL1 BSS 1 ADDRESS OF LOW CURRENT PAGE LINK SPECS. CPL1H BSS 1 NUMBER OF CURRENT PAGE LINKS ASSIGNED CPL2H BSS 1 IN LOW AND HIGH AREA RESPECTIVELY URBP1 BSS 1 LWA R/T DISC RES BP LINK AREA CURAK BSS 1 CURRENT KBUF ADDRESS * CURAT BSS 1 CURRENT \TBUF ADDRESS TCNT BSS 1 CURRENT \TBUF COUNT * CURAP BSS 1 CURRENT PLIST ADDRESS * AMAD BSS 1 CURRENT MLIST ADDRESS * IXCNT BSS 1  ID EXTENSION COUNT IDEXC BSS 1 CURRENT ID EXT'S USED IDEX BSS 1 ADDRESS OF ID EXTENSION TABLE * LICNT BSS 1 LONG ID SEGMENT COUNT SICNT BSS 1 SHORT ID SEGMENT COUNT SSCNT BSS 1 BG. SEG ID COUNT * DSKID BSS 1 DISK ID SEGMENT ADDRESS KEYCN BSS 1 TOTAL KEYWORD COUNT KEYCT BSS 1 CURRENT KEYWORD COUNT * MLIST BSS 11 MEMORY MAP BUFFER * TEMP1 BSS 1 TEMP2 BSS 1 LWH1 BSS 1 LWH2 BSS 1 LWH3 BSS 1 LWH4 BSS 1 L01 BSS 1 * FSYBP BSS 1 FIRST WORD SYS BP LINKAGE SYSAD BSS 1 CURRENT ID SEGMENT ADDRESS * TBREL BSS 1 CURRENT BP RELOC ADDR PBREL BSS 1 INITIAL BP RELOC ADDR * RELAD BSS 1 CURRENT CORE RELOCATION ADDRESS * BSBAD BSS 1 BG SEGMENT BP RELOC ADDR BSPAD BSS 1 BG SEGMENT PROG RELOC ADDR * LFLAG BSS 1 PROGRAMS-LOADED FLAG IMAIN BSS 1 CURRENT MAIN IDENT INDEX. HDFLG BSS 1 HEADING FORMAT FLAG CIDNT BSS 1 CURRENT MAIN IDENT INDEX. * AEQT BSS 1 ADDRESS OF EQUIPMENT TABLE CEQT BSS 1 NO. ENTRIES IN EQUIPMENT TABLE SPLCO BSS 1 SPOOL EQT COUNT DVMAP BSS 1 ADDRESS OF DRIVER MAP TABLE * DPFLG BSS 1 DP RELOCATION FLAG, 0=YES, -1=NO DPLN BSS 1 PAGE LENGTH OF DRIVER PARTITION DPADD BSS 1 START ADDR OF DRIVER PARTITION DSKDP BSS 1 DISK ADDRESS OF DP #2 PAGE# BSS 1 NEXT PHYSICAL PAGE TO ALLOCATE DPNUM BSS 1 CURRENT DP# -1, OR TOT DP PAGES SDID BSS 1 IDENT IDEX OF SYS DISK DRIVER LWDP1 BSS 1 LAST WORD OF DP, +1 FWSDA BSS 1 FIRST WORD OF SDA * ASQT BSS 1 ADDR OF DEVICE REFERENCE TABLE CSQT BSS 1 NO. ENTRIES IN DEV. REF. TABLE * AINT BSS 1 ADDRESS OF INTERRUPT TABLE * DSKIN BSS 1 DISK ADDR OF INT CODE RECORD INTCN BSS 1 RECORD COUNT OF INT CODE * IDSAV BSS 1 INDEX OF CURRENT IDENT. DSKMN BSS 1 INITIAL MA&IN DISK ADDRESS BSSDP BSS 1 INITIAL DISK RES MAIN BSS DISP PRENT BSS 1 PRIMARY ENTRY POINT DBLAD BSS 1 CURRENT DBL ADDRESS REKEY BSS 1 INSTRUCTION TYPE BYTE INSCN BSS 1 INSTRUCTION TYPE COUNTER INSTR BSS 1 CURRENT INSTRUCTION PAGNO BSS 1 CURRENT PAGE NO. OPRND BSS 1 CURRENT OPERAND PLGTH BSS 1 PROGRAM LENGTH * DRT2 BSS 1 DISK DRT ENTRY ( SYSTEM) DRT3 BSS 1 AUX DISK DRT ENTRY * LIBFG BSS 1 LDTYP BSS 1 * SCH1 BSS 1 INDEX OF IDENT OF PGM TO BE SCHEDULED SCH3 BSS 1 ADDRESS OF CURRENT ID SEGMENT SCH4 BSS 1 ADDRESS OF THE SCHEDULED PGM ID SEG FGBGC BSS 1 BACKGROUND USING FG COMMON FLAG $LIBR BSS 1 INDEX OF $LIBR ENT $LIBX BSS 1 INDEX OF $LIBX ENT CUPRI BSS 1 * BLLO BSS 1 -(LOWER BUFFER LIMIT) BLHI BSS 1 -(UPPER BUFFER LIMIT) * MEM6 BSS 1 MEM12 BSS 1 * COMRT BSS 1 MAXIMUM RT COM LENGTH COMBG BSS 1 MAXIMUM BG COM LENGTH COMSZ BSS 1 #WORDS COMMON DECLARED IN CURRENT MAIN RTCAD BSS 1 RT COMMON ADDRESS BGCAD BSS 1 BG COMMON ADDRESS FPCOM BSS 1 FIRST PAGE OCCUPIED BY COMMON LPCOM BSS 1 LAST PAGE CONTAINING ANY COMMON * FPSAM BSS 1 1ST PAGE CONTAINING S.A.M. FWSAM BSS 1 1ST WORD CONTAINING S.A.M. SYMAD BSS 1 VALUE FOR AVMEM IN SCOM SAM#1 BSS 1 SIZE OF FIRST CHUNK OF SAM SAM#2 BSS 1 SIZE OF SECOND CHUNK OF SAM SAM2P BSS 1 START PAGE OF SAM #2 LWTAI BSS 1 LAST WORD OF TABLE AREA I FOR SAM#0 FWPRV BSS 1 FIRST WORD FOR PRIVILEGED PROGRAMS * FWSYS BSS 1 FIRST WORD OF SYSTEM CODE LPSYS BSS 1 LAST PAGE CONTAINING SYS LWSYS BSS 1 LAST WORD OF SYSTEM LPSLB BSS 1 LAST PAGE OF SLOW BOOT LWSLB BSS 1 LAST WORD OF SLOW BOOT MTYPE BSS 1 MAIN PROGRAMS'S TYPE * HIBP BSS 1 BP LINK MODE FOR FIXUP ENTRIES LOLNK BSS 1 M LOW LINK FOR SSGA,LIB, OR SYS HILNK BSS 1 HI LINK USED BY MEM RES PRG BPINC BSS 1 BP LINK ALLOCATION MODE, -1=DOWN,1=UP BPLMT BSS 1 LAST AVAIL BP LINK IN CURRENT MODE, +1 * TPMAX BSS 1 HWM FOR RELOCATION OF BG MAINS & SEGS MAXPT BSS 1 NUM PARTS. ALLOWED MAT. BSS 1 ADDRESS OF MEMORY ALLOCATION TABLE * SSGA. BSS 1 FWA SSGA MAP. BSS 1 PTR TO MEU RES MAP MPFT. BSS 1 PTR TO MPFT * EMLNK BSS 1 EMA SYMBOL'S LINK EMLST BSS 1 LST INDEX OF EMA SYMBOL EMDSK BSS 1 DISK ADDR OF EMA PROGRAM * * MEMORY RESIDENT AREA POINTERS * MRACM BSS 1 MR ACCESS COMMON FLAG (>0 IF YES) LBCAD BSS 1 FIRST WORD OF MEMORY RES LIBRARY LEND BSS 1 LAST WORD OF MEMORY RES LIBRARY FWMRP BSS 1 FIRST WORD OF MEMORY RES PROGRAM AREA EMRP BSS 1 LAST WORD OF MEMORY RES PROGRAM AREA FPMRP BSS 1 FIRST PAGE OF MEMORY RES PROGRAM AREA FPMBP BSS 1 PAGE # FOR MEMORY RES BASE PAGE MRP# BSS 1 # PAGES OCCUPIED BY MRL & MRP'S DSKMB BSS 1 DISK ADDRESS OF MEMORY RES BASE PAGE DSKMR BSS 1 DISK ADDRESS OF MEMORY RESIDENT LIB/PROG AREA DSKBP BSS 1 SYSTEM DISK ADDRESS * DSKAV BSS 1 NEXT AVAILABLE DISK ADDRESS DSKLC BSS 1 DISK ADDRESS OF LIBRARY CODE DSKLB BSS 1 DISK ADDR OF LIBRARY ENTRY PTS DSKUT BSS 1 UTILITY PROG DISK ADDRESS DSKBS BSS 1 DISK ADDR OF MAIN BG DISK RES BP DSKBR BSS 1 CURRENT MAIN BG DISK RES DISK AD ADICT BSS 1 ADDR OF DISK DICTIONARY LBCNT BSS 1 RESIDENT LIBR ENTRY PT COUNT SYCNT BSS 1 SYSTEM ENTRY POINT COUNT KEYAD BSS 1 CURRENT KEYWORD ADDRESS * SYBAD BSS 1 ADDR OF FIRST BP LINK FOR BG IDSAD BSS 1 ADDR OF FIRST ID SEGMENT ABSID BSS 1 IDENT ADDR FOR NEXT BG SEG SCAN IDMBS BSS 1 BG MAIN ADDRESS FOR BS REF * * ********************************************************* * * * END OF COMMON STORAGE BLOCK FOR ALL SEGMENTS. * * * ********************************************************* * SKP LSWAP NOP * * RESOLVE ANY ARITHMETIC DEF'S TO EXTERNALS * LDA N GET LOOP COUNTER STA BLINE SAVE IN TEMP LOCATION LDB LSTAA GET ADDRESS OF WHERE LIST ROUTINE LOCATED LOOP LDA B,I GET ADDRESS RSS LDA A,I RAL,CLE,SLA,ERA JMP *-2 STA B,I AND SAVE IT AGAIN INB ISZ BLINE DONE? JMP LOOP NO JMP \SRET RETURN TO MAIN. SPC 1 N DEC -5 LSTAA DEF *+1 ATBUF DEF \TBUF+0 ALBUF DEF \LBUF+0 DNAM DEF \LBUF+3 DRDCB DEF \RDCB+0 DNDCB DEF \NDCB+0 SKP * * BEGIN PROGRAM INPUT PHASE (UNDER COMMAND CONTROL). * \PIP NOP JSB \SPAC JSB \SPAC LDA P17 LDB MESS7 JSB \MESS "PROG INPUT PHASE:" LDA \PLST SET BOTTOM OF PROGRAM STA SLST DEFINED LST (INDEX #) * JSB PRCMD PROCESS OPERATOR COMMANDS. * CLA STA SCH1 STA SCH4 * * CLEAR UNDEFINED EXTS AND SET TO TYPE 5 * LDA SLST INITIALIZE \LSTX STA \TLST IGNOR PREDEFINED ENTRIES CLST3 JSB \LSTX SET LST ADDRESSES JMP ENDLB SET USAGE FLAGS * LDA \LST4,I GET IDENT INDEX CMA,INA SSA SKIP - UNDEFINED EXT JMP CLST3 IGNORE DEFINED ENTRY POINT * LDA P5 SET UNDEFINEDS TO ZERO REPLACE ENTS STA \LST4,I SET TYPE UNDEFINED CLB STB \LST5,I CLEAR VALUE JMP CLST3 TRY NEXT LST ENTRY * ENDLB LDB D$LIR FIND THE LIBRARY JSB \LSTS ENTRY POINTS $LIBR JMP ER57 UNDEFINED, SO TERMINATE LDA \TLST ADA N1 STA $LIBR SAVE FOR THE LOADER * LDB D$LIX DO SAME THING FOR $LIBX JSB \LSTS JMP ER57 UNDEFINED, SO TERMINATE LDA \TLST ADA N1 STA $LIBX * JMP PARAM GO DO PARAM INPUT PHASE. * ER57 STB ENDLB SAVE ASCII ADDRESS IN TEMP LDA ERR57 SEND ERROR DIAGNOSTIC JSB \GNER LDB ENDLB GET IT BACK LDA P5 CHARACTER COUNT JSB \MESS PRINT ENTRY POINT JSB \TERM ABORT ERR57 ASC 1,57 * * D$LIR DEF *+1 ASC 3,$LIBR D$LIX DEF *+1 ASC 3,$LIBX * P17 DEC 17 MESS7 DEF *+1 ASC 9,PROG INPUT PHASE: N1 DEC -1 SKP SPC 1 ***** * ** BLINE ** BLANK OUT THE PRINT LINE BUFFER (LBUF) * CALLING SEQUENCE: * * JSB BLINE * RETURN * ***** BSS 1 BLINE NOP LDA ALBUF STA BLINE-1 LDA MD24 LDB BLANK STB BLINE-1,I ISZ BLINE-1 INA,SZA JMP *-3 JMP BLINE,I ***** STMP1 NOP * ***** * ** DELIM ** ADVANCE POINTERS TO ASCII INPUT BUFFER PAST NEXT * DELIMETER. ACCEPTABLE DELIMITERS ARE A COMMA, ONE OR * MORE BLANKS, OR A COMMA IMBEDDED IN BLANKS. * CALLING SEQUENCE: * * JSB DELIM * RETURN1 NOTHING BUT BLANKS OR A COMMENT TO END OF LINE * RETURN2 DELIMETER FOUND * * NOTE: IF NO VALID DELIMITER IS FOUND (OR COMMA WITH NOTHING BUT * BLANKS TO THE END OF LINE) A DIRECT JUMP TO THE COMMAND * ERROR ROUTINE WILL RESULT. THUS CONTROL MAY NOT BE RETURNED ***** DELIM NOP JSB QGETC GET THE NEXT CHAR JMP DELIM,I END OF LINE , RETURN (P+1) LDB N2 INITIALIZE STB STMP1 COMMA COUNTER CPA B40 IS THIS A BLANK? JMP DEL01 YES CPA B54 NO, IS IT A COMMA? RSS JMP CMER NO, ERROR ISZ STMP1 DEL01 JSB NXTC GET NEXT NON BLANK CHAR JMP DEL02 END OF LINE CPA B54 GOT ONE, IS IT A COMMMA? RSS JMP DEL03 gNO ISZ STMP1 YES, IS IT THE SECOND ONE? JMP DEL01 NO, GET NEXT NON BLANK CHARACTER DEL03 JSB BAKUP YES, BACK UP BUFFER POINTERS ISZ DELIM AND EXIT (P+2) JMP DELIM,I DEL02 ISZ STMP1 WAS THERE A COMMA? JMP DELIM,I NO, EXIT (P+1) JMP CMER YES, ERROR ***** * ** BAKUP ** BACK UP INPUT BUFFER (QIBUF) POINTERS BY ONE CHARACTER * CALLING SEQUENCE: * * JSB BAKUP * RETURN * ***** BAKUP NOP CCA ADA QQCNT DECREMENT CHAR COUNT STA QQCNT LDB QQPTR SLA AND IF NECESSARY, ADB N1 DECREMENT POINTER STB QQPTR JMP BAKUP,I ***** * ** PRCMD ** MAIN ENTRY POINT - CONTROL IS PASSED TO NXTCM TO GET THE NEXT * COMMAND. THAT COMMAND IS PARSED, AND CONTROL IS PASSED * TO ITS ASSOCIATED PROCESSING ROUTINE. IF A FATAL ERROR * IS DETECTED, CONTROL IS RETURNED TO THE ROUTINE CALLING * PRCMD AT (P+1). THE ONLY OTHER EXIT IS VIA THE END * COMMAND (P+2). AFTER PROCESSING ANY OTHER COMMAND, * CONTROL RETURNS TO NXTCM TO PROCESS THE NEXT COMMAND. * ***** PRCMD NOP PROCESS OPERATOR COMMANDS. NXTCM JSB CMDIN GET NEXT COMMAND LINE LDA CTACN COMST JMP'S HERE VIA NXTCM+1 LDB CTABL JSB SCAN SCAN 1ST ELEMENT FOR MATCH JMP CMER COMMAND ERROR. ADA PTABL JUMP TO PROCESSOR LDA A,I JMP A,I * ***** CMER LDA ERR06 JSB \GNER JMP NXTCM GET NEXT COMMAND FROM TTY * ERR06 ASC 1,06 SKP ***** * * BRANCH TABLE FOR COMMAND PROCESSORS. * ORDER OF THIS TABLE MUST CONFORM TO ORDER OF FIRST ENTRIES IN * COMMAND PNEUMONIC TABLE. * ***** PTABL DEF * DEF MAPST MAP STATEMENT DEF RELST RELOCATE STATEMENT DEF RELST REL STATEMENT DEF DSPST DISPLAY STATEMENT DEF EOL /E STATEMENT DEF LNKST LINKS STATEMENT **o*** * * COMMAND PNEUMONIC TABLE * * BITS 15-8 # CHARS IN ASCII KEYWORD TABLE * BITS 7-0 OFFSET IN THAT TABLE (TO LOCATE ASCII WORDS) * * THE ORDER OF ENTRIES IN THIS TABLE IS USED IN DETERMINING THE * OFFSET ASSOCIATED WITH KEYWORDS. THUS ORDER IN THIS TABLE IS * OF PARAMOUNT IMPORTANCE. IF ANY KEYWORD IS EXACTLY THE SAME * AS THE BEGINNING OF A LONGER KEYWORD, THE LONGER KEYWORD MUST * APPEAR FIRST. (FOR EXAMPLE RELOCATE APPEARS BEFORE REL) * ***** CTACN ABS CTABS-CTABN NEG NBR ENTRIES IN TABLE CTABL DEF CTABS CTABS ABS 1400B+AMAP-CMTBL MAP ABS 4000B+ARELC-CMTBL RELOCATE ABS 1400B+ARELC-CMTBL REL ABS 3400B+ADISP-CMTBL DISPLAY ABS 1000B+AEND.-CMTBL /E ABS 2400B+ALINK-CMTBL LINKS CTABN EQU * LTABS ABS 2400B+ATBLE-CMTBL TABLE ABS 3000B+AUNDE-CMTBL UNDEFS MTABS ABS 3400B+AMODS-CMTBL MODULES ABS 3400B+AGLOS-CMTBL GLOBALS ABS 2400B+ALINK-CMTBL LINKS ABS 1400B+AOFF.-CMTBL OFF ABS 1400B+AALL.-CMTBL ALL ITAB ABS 1000B+AIN..-CMTBL IN BTAB ABS 2000B+ABASE-CMTBL BASE CPTAB ABS 3400B+ACURN-CMTBL CURRENT TTAB ABS 1000B+ATR..-CMTBL TR ITABL DEF ITAB BTABL DEF BTAB CPTBL DEF CPTAB LTABL DEF LTABS MTABL DEF MTABS TTABL DEF TTAB ***** * ASCII KEYWORD TABLE * ORDER OF ENTRIES IN THIS TABLE IS ON NO IMPORTANCE ***** CMTBL DEF * AMAP ASC 2,MAP ARELC ASC 4,RELOCATE ADISP ASC 4,DISPLAY ATBLE ASC 3,TABLE AUNDE ASC 3,UNDEFS AMODS ASC 4,MODULES AGLOS ASC 4,GLOBALS ALINK ASC 3,LINKS AOFF. ASC 2,OFF AALL. ASC 2,ALL AEND. ASC 1,/E AIN.. ASC 1,IN ACURN ASC 4,CURRENT ABASE ASC 2,BASE ATR.. ASC 1,TR * HYADD DEF *+1 PRPTA ASC 1,- * PTR NOP CNTR NOP PTR2 NOP CCNT NOP QQCN1 NOP QQPT. NOP TEMP NOP NCHAR NOP CNT NOP SKP SKP * * SCANNER ROUTINE * ***** * ** SCAN ** SCAN INPUT BUFFER (QIBUF) FOR KEYWORD * CALLING SEQUENCE: * * LDA NUMBER OF ENTRIES TO SEARCH * LDB ADDRESS OF PNEUMONIC TABLE ENTRY ASSOC WITH FIRST CHOICE * JSB SCAN * RETURN1 NOT FOUND * RETURN2 FOUND, OFFSET FROM FIRST ENTRY SEARCHED IN .A. * * NOTE: THIS ROUTINE WILL SKIP LEADING BLANKS IN ATTEMPTING A MATCH. * FURTHER,BUFFER POINTERS ARE ADVANCED PAST THE KEYWORD * MATCHED OR RESET IF NO MATCH OCCURRED. ***** SCAN NOP ENTRY/EXIT STB PTR INITIALIZE SCANNER STA CNTR CLA STA CNT INITIALIZE OFFSET COUNTER SCAN1 LDA PTR,I GET COMMAND POINTER WORD AND B377 MASK COMMAND TABLE OFFSET ADA CMTBL STA PTR2 STORE POINTER TO ASCII COMMAND LDA PTR,I ALF,ALF AND B377 GET # CHARS. STA NCHAR ISZ CNT BUMP OFFSET COUNTER CLA STA CCNT LDA QQCNT SAVE CHARACTER STREAM STA QQCN1 LDA QQPTR STA QQPT. POINTERS. JSB NXTC GET THE FIRST NON-BLANK CHAR CLA END OF LINE JMP SCAN5 GET REST OF CHARS IN LOOP SCAN2 JSB QGETC GET NEXT CHARACTER. CLA NO MORE CHARS. SCAN5 STA TEMP LDA PTR2,I LDB CCNT ISZ CCNT CPB NCHAR ALL CHARS. MATCH? JMP SCAN4 YES-CHECK END OF INPUT ELEMENT. SLB,RSS IS CHAR IN HIGH-ORDER BYTE? ALF,ALF YES--ROTATE TO LOW AND B177 MASK SLB BUMP ASCII COMMAND TABLE POINTER ON ISZ PTR2 EVEN-NUMBERED CHARACTERS. CPA TEMP DO CHARS. MATCH? JMP SCAN2 YES--SO FAR. LDA QQPT. NO--BACKUP POINTERS STA QQPTR LDA QQCN1 STA QQCNT SPC 1 * NOW BUMP COMMAND TABLE POINTER, OR TAKE ERROR EXIT * IF NO MORE LEFT SPC 1 ISZ PTR ISZ CNTR END OF TABLE? JMP SCAN1 NO JMP SCAN,I SPC 1 SCAN4 LDA TEMP IS NEXT SOURCE CHAR A DELIMITER? SZA END OF LINE? JSB BAKUP LDCA CNT ISZ SCAN JMP SCAN,I SKP * * INPUT COMMAND LINE * ***** * ** CMDIN ** INPUT NEXT COMMAND LINE * CALLING SEQUENCE: * * JSB CMDIN * RETURN * * * RETURN: QQCHC= POSITIVE # CHARS TRANSMITTED * ***** CMDIN NOP CLA RESET INCOMING CHARACTER STA QQCNT POINTERS LDA QBUFA STA QQPTR JSB \PRMT SEND \PRMT,READ REPLY DEF *+6 DEF PRPTA DEF P1 DEF QIBUF DEF D72 DEF \BPAR STA QQCHC JSB NXTC KLUDGE HERE JMP CMDIN+1 IF FIRST CHARACTER A *, OR IT'S CLA A BLANK LINE, THEN GO GET NEXT LINE STA QQCNT OTHERWISE RE-INIT POINTERS LDA QBUFA STA QQPTR JMP CMDIN,I AND RETURN * MOVE3 NOP SKP ***** * ** MOVE. ** MOVE BLOCK OF CHARS FROM INPUT BUFFER (QIBUF) TO A * SPECIFIED LOCATION. STOP AT FIRST DELIMITER. * CALLING SEQUENCE: * * LDA ADDRESS OF DESTINATION * JSB MOVE. * RETURN * ***** MOVE. NOP STA MOVE3 SAVE DESTINATION ADDRESS JSB NXTC GET NEXT NON BLANK CHAR JMP CMER NONE FOUND MOV01 ALF,ALF POSITION CHAR TO LEFT, STA MOVE3,I AND STORE IN OUTPUT BUFFER JSB QGETC GET NEXT CHAR JMP MOV03 END OF LINE CPA B40 BLANK? JMP MOV02 CPA B54 COMMA? JMP MOV02 CPA B51 RIGHT PAREN? JMP MOV02 IOR MOVE3,I PUT LOWER HALF STA MOVE3,I IN BUFFER JSB QGETC GET NEXT CHAR JMP MOV03 END OF LINE CPA B40 BLANK? JMP MOV02 CPA B54 COMMA? JMP MOV02 CPA B51 RIGHT PAREN? JMP MOV02 ISZ MOVE3 BUMP OUTPUT POINTER JMP MOV01 KEEP GOING MOV02 JSB BAKUP BACK UP OVER LAST CHAR MOV03 LDA MOVE3,I WAS LAST CHAR AND UPCM CPA MOVE3,I AN EVEN NUMBERED CHAR? RSS JMP MOVE.,I NO, BUFFEHFBR IS OK IOR B40 NO,APPEND A BLLANK STA MOVE3,I AND STORE IT AWAY JMP MOVE.,I SPC 1 SKP * * ****COMMAND PROCESSORS**** * ***** * ** REL COMMAND PROCESSOR. * ***** RELST CLA STA NREC CLEAR #GOOD RECORDS COUNTER STA RIC STA XNAM STA SERFG INA STA POSIN SIGNAL \RBIN TO CALL LOCF. JSB \CLOS CLOSE OPEN REL INPUT FILE...IF NOT CLOSED. DEF *+2 DEF \RDCB+0 JSB NXTC GET NEXT NON-BLANK CHAR JMP CMER NO MORE CPA B54 IS IT A COMMA? JMP CHFNM YES...CHECK FILENAME FURTHER CPA B50 LEFT PAREND? RSS YES JMP CMER NO--COMMAND ERROR LDA BLANK BLANK OUT XNAM STA XNAM+1 STA XNAM+2 LDA XNAMA JSB MOVE. MOVE MODULE NAME INTO XNAM BUFFER * JSB NXTC GET NEXT NON BLANK CHAR JMP CMER NO MORE CPA B51 RIGHT PAREN? RSS YES JMP CMER NO, ERROR JSB NXTC GET NEXT NON-BLANK CHAR JMP CMER NO MORE CPA B54 COMMA? RSS YES JMP CMER NO,ERROR * CHFNM JSB NXTC GET THE FIRST FILENAME CHAR JMP CMER NO MORE CPA B54 COMMA? JMP CMER FILENAME PARAMETER MUST BE THERE CPA B53 PLUS? ( MINUS ALREADY SKIPPED) JMP CMER INVALID * LDB A NOW CHECK IF NUMERIC ADB L60 >= "1" ? SSB JMP LDRIN OK LDB A ADB L73 < A ":"? SSB,RSS &OH JMP LDRIN OK JMP CMER LU CAN'T BE USED * B53 OCT 53 + L60 OCT -60 L73 OCT -73 XNAMA DEF XNAM SKP * ** DISPLAY COMMAND PROCESSOR * ***** DSPST LDA \IACM IF COMMANDS ARE FROM AND INTERACTIVE STA TIACM DEVICE, SZA JMP DISDN THEN DISPLAY ALREADY GOES TO THEM LDA \TRCM ELSE SIMULATE A "TR,ERRLU" LDB P6 JSB \TRCH * DISDN JSB BLINE BLANK PRINT LINE LDA QQPTR SAVE STA STMP BUFFER LDA QQCNT POINTERS STA SVAL LDA ALBUF MOVE NAME OF ENTITY TO BE DISPLAYED JSB MOVE. INTO THE OUTPUT BUFFER LDA STMP STA QQPTR RESTORE BUFFER POINTERS LDA SVAL STA QQCNT LDA N2 LDB LTABL JSB SCAN IS THIS A KEYWORD? JMP DSP10 NO, IT MUST BE AN IDENTIFIER CPA B2 UNDEFS? JMP OLSTU CPA P1 TABLE? JMP OLSTE JMP CMER ERROR. SPC 2 DSP10 LDB ALBUF JSB \LSTS SEARCH SYMBOL TABLE JMP DSP30 SYMBOL IS UNDEFINED LDB \LST5,I GET VALUE LDA \LBUF+2 SET EQUAL SIGN(=) IN 6TH CHAR AND UPCM OF PRINT LINE IOR B75 STA \LBUF+2 LDA DNAM JSB CONV CONVERT THE VALUE TO ASCII LDA P12 DSP25 LDB ALBUF JSB \MESS PRINT THE LINE DSP27 LDA TIACM DETERMINE STATE BEFORE THE DISPLAY SZA JMP NXTCM WAS ALREADY INTERACTIVE LDA \TRCM MUST POP THE "TR,ERRLU" LDB B2 WE PUT THERE JSB \TRCH WITH A "TR" ONLY JMP NXTCM * DSP30 LDA DSP40 MOVE "UNDEFINED" TO LBUF LDB DNAM MVW P5 LDA D15 JMP DSP25 * DSP40 DEF *+1 ASC 5,UNDEFINED TIACM NOP TEMPORARY STORAGE OF \IACM * OLSTE CLA,INA,RSS ENTRY POINT LIST OPTION. OLSTU CLA LIST UNDEFINED SYMBOLS OPTION. STA TEMP2 SAVE LIST TYPE CLA CLEAR 'TR' INDICATOR STA MRP# SAVE *TEMP* JSB DELIM ADVANCE PAST DELIMITERS CCA SEARCH FOR LDB TTABL A TR AFTER THE DISPLAY JSB SCAN RSS NONE ISZ MRP# YES, A TR WAS DESIRED LDA TEMP2 GET LIST TYPE AGAIN JSB EPL DO LISTING LDB TEMP2 WERE UNDEFS SZB PRINTED JMP DSP27 NO SZA,RSS WERE THERE ANY? JMP DSP27 NO LDA MRP# DID THEY WANT A TR DONE? SZA JMP NXTCM YES, DO DON'T POP STACK JMP DSP27 NO, SEE IF WE DID A TR TO DISPLAY SKP * ** MAP COMMAND PROCESSOR * * MAPMD--CORE MAP LISTING FLAG * BIT 0 GLOBAL VARIABLES * 1 MODULES * 2 LINKS ***** MAPST LDA N5 LDB MTABL JSB SCAN JMP CMER STA B LDA MAPMD CPB P1 MODULES? IOR B2 SET BIT 1 CPB B2 GLOBALS? IOR P1 SET BIT 0 CPB P3 LINKS? IOR P4 SET BIT 2 CPB P4 OFF? CLA RESET POINTER CPB P5 ALL? IOR B7 SET BITS 2-0 STA MAPMD JSB DELIM ADVANCE PAST DELIMITERS RSS JMP MAPST JMP NXTCM GET NEXT COMMAND SPC 1 STMP NOP SVAL NOP SKP * ** LINKS IN ** COMMAND PROCESSOR. * ***** LNKST CCA LDB ITABL JSB SCAN LOOK FOR "IN" JMP CMER CCA LDB BTABL JSB SCAN LOOK FOR "BASE" JMP *+3 NO. CLA YES. JMP LNK01 CCA LDB CPTBL JSB SCAN LOOK FOR "CURRENT" JMP CMER NEITHER. CLA,INA LNK01 STA LNKMD 0=BASE, 1=CURRENT. JMP NXTCM * SKP * ***** * ** NXTC ** GET NEXT NON-BLANK CHAR FROM INPUT BUFFER (QIBUF) *CALLING SEQUENCE: * * JSB NXTC * RETURN1 NO MORE NON-BLANK CHARS * RETURN2 GOT ONE, AND IT IS RETURNED IN .A. * ***** NXTC NOP GET NEXT NONN-BLANK CHARACTER. JSB QGETC JMP NXTC,I ERROR RETURN CPA B40 BLANK? JMP NXTC+1 GET ANOTHER CHARACTER ISZ NXTC TAKE NORMAL EXIT JMP NXTC,I B55 OCT 55 SKP * * RECORD PROCESSING CONTROL * ******************************************************************** * THE TRANSFER OF CONTROL TO THE APPROPRIATE RECORD PROCESSORS IS * MADE FROM THIS SECTION. ******************************************************************** * LDRIN LDA RIC WAS LAST RECORD AN END RECORD? CPA P5 JMP NXTCM GET NEXT COMMAND INCHK LDA ALBUF GET BUFFER WHERE TO PUT REL. LDB POSIN GET \RBIN FLAG. JSB \RBIN GET NEXT RELOCATABLE RECORD JMP CMER FILE ERROR ON INPUT SZA,RSS EOF? JMP NXTCM END OF FILE. * * CHECK FOR LEGAL RECORD TYPE * STA TEMP1 SAVE RECORD LENGTH CLA CLEAR \RBIN FLAG. STA POSIN LDA \LBUF+1 GET TYPE WORD ALF,RAR ROTATE RIC FIELD TO AND B7 LOW A AND ISOLATE CODE STA RIC SAVE FOR PROCESSING SZA IF RIC=0 ADA N7 OR GREATER THAN 6 SSA,RSS ERROR? JMP RCERR YES * * TEST CHECKSUM * LDB \LBUF GET RECORD LENGTH BLF,BLF ROTATE TO LOW B CPB TEMP1 MUST BE SAME AS RETURNED BY \RBIN RSS JMP CKERR NO - ASSUME CHECKSUM ERROR CMB,INB SET TO NEGATIVE ADB P3 ADD 3 FOR WORD COUNT IN CHECKSUM SSB,RSS TEST FOR SHORT (1,3) RECORD JMP RCERR SHORT LDA ALBUF GET BUFFER ADDRESS JSB CKSUM COMPUTE CHECKSUM CPA \LBUF+2 TEST WITH GIVEN CHECKSUM JMP LDRC OK, PROCESS RECORD * CKERR LDA ERR14 GET ERROR CODE JMP ERCOV AND SEND DIAGNOSTIC ERR14 ASC 1,14 * RCERR LDA ERR04 YES...TELL THEM ILLEGAL RECORD JMP ERCOV GO TEST & PRINT MESSAGE. * * PROCESS VALID RECORD * LDRC ISZ NREC BUMP COUNT # GOOD RECORDS. LDA RIC (A) = RECORD TYPE LDB SERFG CPA P1 IF RIC = 1, THEN GO TO PROCESS JMP LDRC3 NAM RECORD. CPA P5 IF END RECORD THEN PROCESS IT JMP ENDR SSB SKIP RECORD IF NOT LOADING. JMP INCHK CPA B2 IF RIC = 2, JMP ENTR GO PROCESS ENT RECORD. CPA P3 IF RIC = 3, GO TO JMP DBLR DBL RECORD PROCESSOR. CPA P4 EXT? JMP EXTR EXT RECORD PROCESSOR. CPA P6 EMA?? JMP EMAR GO PROCESS EMA RECORD * * PROCESSING FOR END RECORD. * ENDR CLA CLEAR FLAG FOR STA NAMR. NAM RECORD EXPECTED. STA SERFG SET PROG LOAD FLAG = LOADING INA STA POSIN SIGNAL \RBIN TO CALL LOCF SSB B STILL IS OLD SERFG JMP INCHK SKIP THIS END RECORD * * PROCESS END RECORD AND \LBUF+1 ISOLATE M/S RAR MOVE M/S TO SIGN POSITION IOR \ID4,I ADD TO COMMON SIZE STA \ID4,I SET M/S * LDA LWH1 COMPILED PROGRAM? SZA,RSS SKIP IF YES. JMP END2 * * SET NEW LENGTH OF COMPILED PROGRAM. * JSB LOCF SAVE CURRENT POSITION IN FILE. DEF *+6 DEF \RDCB+0 DEF \FMRR+0 DEF IRECR DEF IRBR DEF IOFFR * LDA DRDCB GET DCB ADDRESS JSB \CFIL IN CASE OF FILE ERROR JSB \TERM * LDA ACBUF READ NAM REC INTO CBUF. CCB JSB \RNAM JSB \ABOR ERROR. * LDA CBUF IF 9 WORD RECORD, MAKE ALF,ALF IT 17 WORDS. CPA P9 LDA P17 STA IL ALF,ALF STA CBUF * LDA LWH2 STORE PROGRAM LENGTH. IOR SIGN SET "COMPILED" BIT. STA CBUF+6 LDA ACBUF GET NAM BUFFER ADDRESS JSB CKSUM COMPUTE & STORPE NEW CHECKSUM. STA CBUF+2 * JSB WRITF WRITE RECORD TO NEW NAM FILE. DEF *+5 DEF \NDCB+0 DEF \FMRR+0 DEF CBUF DEF IL * LDA DNDCB GET DCB ADDRESS IN CASE OF ERROR JSB \CFIL JSB \TERM \ABOR IF WRITE ERROR. * LDA \ID5,I SET FLAG IN IDENT. IOR BIT14 STA \ID5,I * JSB APOSN RESTORE FILE POSITION. DEF *+6 DEF \RDCB+0 DEF \FMRR+0 DEF IRECR DEF IRBR DEF IOFFR * LDA DRDCB GET DCB ADDRESS IN CASE OF ERROR JSB \CFIL JSB \TERM * END2 LDA XNAM IF XNAM ZERO, SZA CONTINUE PROCESSING RECORDS, JMP NXTCM ELSE GET NEXT COMMAND. JMP INCHK SKP * * PRELIMINARY NAM RECORD PROCESSING * ***** * * THIS PROCESSING OF NAM RECORDS OCCURS BEFORE DECIDING * WHETHER OR NOT TO RELOCATE A MODULE * ***** LDRC3 LDB NAMR. IS NAM 1ST RECORD? SZB IS NAM 1ST RECORD? JMP NMERR NO--SEQUENCE ERROR. LDB XNAMA LDA B,I SZA,RSS WAS A MODULE NAME SPECIFIED? JMP L.DC4 NO. CPA \LBUF+3 YES--DOES THIS MODULE MATCH THE NAME? INB,RSS JMP LDRC6 NO--SKIP IT LDA B,I CPA \LBUF+4 INB,RSS JMP LDRC6 LDA B,I XOR \LBUF+5 AND UPCM SZA JMP LDRC6 L.DC4 CLA STA SERFG CLEAR LOADING FLAG. ISZ NAMR. NAM NOT EXPECTED. JMP NAMR GO PROCESS NAM RECORD. * * RESET PROCESSING - PROGRAM FROM LIBRARY IS * TO BE DISCARDED. LDRC6 CLA STA NAMR. CCA STA SERFG RECORD SKIPPING MODE. JMP INCHK * NMERR LDA ERR03 MISSING END RECORD JMP ERCOV SKP * * CONSTANTS AND STORAGE FOR MAIN CONTROL SECTION * NREC NOP #GOOD RECORDS COUNTER. RIC OCT 0 HOLDS RECORD IDENTIFICATION CODE UPCM OCT 77400 UPPER CHARACTER K MASK. SERFG NOP PROG LOAD FLAG: -1/0=NL/L. NAMR. NOP "NAM REC EXPECTED" FLAG. * D72 DEC 72 * ERR04 ASC 1,04 ERR03 ASC 1,03 * XNAM BSS 3 * BLANK ASC 1, (ORG LBUF-1 FOR EPL SUBROUTINE) NBUF BSS 6 POSIN OCT 0 POSITIONING CODE FOR \RBIN SUBR. SKP * NAM RECORD PROCESSOR * NAMR LDA \PIDN SAVE CURRENT IDENT AND STA BUID LST ENTRY INDICES. LDA \PLST STA BULST FOR POSSIBLE MODULE PURGE LDB DNAM GET NAME ADDRESS JSB \IDXS SEARCH FOR THE ENTRY JMP ENTNA ENTER NAME * LDA ERR08 GET ERROR CODE - DUPLICATE NAMES CMA,INA SET NEG SO NO TR,ERRLU MAY BE DONE JSB \GNER PRINT DIAGNOSTIC LDA P5 LDB \ID1 GET ADDRESS OF NAME IN IDENT JSB \MESS PRINT DUPLICATE PROG. NAME * JSB FINDN DID IT HAVE A MODIFIED NAM RECORD? JMP REPNA NO CLA,INA INVALIDATE THE RECORD LDB ACBUF ADB P3 STA B,I BY OVERWRITING THE NAME JSB NEWNM AND REWRITE THE RECORD JMP REPNA REPLACE REST OF IDENT * "DV" ASC 1,DV * ENTNA LDA \LBUF+3 GET NAME 1,2 STA \ID1,I SET NAME 1,2 IN IDENT CLE CLEAR DRIVER FLAG CPA "DV" WANT TO SET \ID8,I CCE IF ONE LDA \LBUF+4 GET NAME 3,4 STA \ID2,I SET NAME 3,4 IN IDENT LDA \LBUF+5 GET NAME 5 AND M7400 SAVE UPPER CHAR STA \ID3,I SET NAME 5 IN IDENT ISZ \PIDN BUMP IDENT COUNTER. * REPNA LDA \LBUF+9 GET PROGRAM TYPE AND M177 ISOLATE TYPE STA \ID6,I SET TYPE IN IDENT SZA IF NOT A DRIVER CLE THEN DON'T SAVE LENGTH LDB \LBUF+8 GET COMMON LENGTH STB \ID4,I SAVE COMMON LENGTH * LDA LNKMD SET BASE/CURRENT LINKAGE RAR AND MAP OPTIONS. IOR MAPMD STA \ID5,I  CLA,INA LDB \LBUF+6 COMPILED? SSB,RSS IF YES, SKIP & SET SWITCH CLA OTHERWISE, CLEAR SWITCH STA LWH1 LDA M7777 INITILIZE THE FIRST DBL ADDRESS STA \ID7,I TO MAX POSSIBLE CLA AND THE PROG. LENGTH TO STA LWH2 MIN. POSSIBLE SEZ IF A DRIVER, THEN STORE LDA B *TEMP* ITS SIZE HERE STA \ID8,I CLEAR BS IDENT MAIN ADDRESS LDA \DPR2 SET FILE NAME IN IDENT. INA LDB A,I STB \ID9,I INA LDB A,I STB \ID10,I INA LDB A,I STB \ID11,I ADA B2 POSITION TO SECURITY CODE LDB A,I STB \ID12,I SAVE IT ADA P4 POSITION TO CR LABEL LDB A,I STB \ID13,I LDA \NAMN STA \ID14,I SET RECORD NUMBER. LDA \NAMB STA \ID15,I SET RELATIVE BLOCK. LDA \NAMO STA \ID16,I SET BLOCK OFFSET. JMP LDRIN GET NEXT RECORD SKP * * DBL REC PROCESSOR * DBLR LDA \LBUF+3 GET THE RELOCATION ADDRESS CMA,INA IF LESS THAN CURRENT ADA \ID7,I MIN. SSA SKIP JMP DBLR1 ELSE JUST SKIP * LDA \LBUF+3 NEW MIN. SO SET IT STA \ID7,I IN THE IDENT. * DBLR1 LDA \LBUF+1 GET THE LENGTH AND M77 OF THE RECORD (NO. OF PROGRAM WORDS) ADA \LBUF+3 COMPUTE MAX. LOAD ADDRESS LDB A SAVE IN B CMB,INB IF THIS IS A NEW ADB LWH2 MAX. THEN SSB SET THE STA LWH2 NEW MAX. JMP LDRIN GO GET NEXT RECORD. SKP * * ENT/EXT RECORD PROCESSOR * ENTR CCA,RSS ENT PROCESSOR EXTR CLA EXT PROCESSOR STA NXFLG NXFLG = ENT/EXT FLAG LDA \LBUF+1 SET NO. SYMBOLS AND M37 ISOLATE NO. SYMBOLS CMA,INA STA EXCNT SET SYMBOL COUNT LDB ALBUF ALBUF = A(LBUF) ADB P3 P3 = +3 STB SYM12 SET STARTING SYMBOL ADDR * SETNX LDB SYM12 SET B FOR LSTE JSB \LSTE ENTR SYMBOL IN THE LST JMP ENTX3 NEW ENTRY GO FINISH. * * LDA NXFLG GET ENT/EXT FLAG SZA,RSS SKIP IF ENT JMP ENTX4 COMPLETE EXT PROCESSING * * PROCESS ENT REC * LDA SLST IF THIS IS A FORCED CMA SYMBOL ADA \TLST THEN SSA GIVE ERROR JMP DUPEN * LDA \LST4,I GET WORD 4 OF LST ENTRY SZA,RSS SKIP IF NON-ZERO (DEFINED) JMP ENTX2 MAKE ENTRY FOR DEFINED EXT * SSA SKIP IF ENTRY MADE JMP ENTX6 MAKE ENTRY FOR BS EXT * DUPEN LDA ERR05 SET CODE - DUPLICATE ENTRY POINT CMA,INA SET NEG SO NO TR,ERRLU MAY BE DONE JSB \GNER PRINT \GNER MESSAGE LDA P5 LDB \LST1 \LST1 = ADDR OF SYMBOL JSB \MESS PRINT DUPLICATE ENTRY SYMBOL LDA \LST4,I GET THE CURRENT DEFINING ADA N5 VALUE AND IF NOT A SELF DEFINING SSA,RSS SYMBOL JMP ENTX2 GO REDEFINE THE SYMBOL * JMP ENTX5 ELSE GO REDEFINE ONLY IF NEW SELF DEF. * * ENT HERE SATISFYING A BG SEGMENT'S EXTERNAL * ENTX6 LDA \ID6,I GET CURRENT TYPE AND M7 ISOLATE TYPE CPA B2 RT DISK RESIDENT? RSS CPA P3 TYPE = PR DISK RESIDENT? RSS YES - CONTINUE (ERROR) CPA P4 TYPE = BG DISK RESIDENT? RSS YES JMP ENTX2 MAKE ENTRY FOR UNDEFINED EXT * LDA ERR13 SET CODE = INVALID BG BS ORDER JMP ERCO1 ENTX2 CCA GET MAIN IDENT INDEX. ADA \TIDN STA \LST4,I ENTER IDENT INDEX IN WORD 4 JMP ENTX5 * ENTX3 LDA NXFLG GET EXT/ENT FLAG SZA SKIP IF EXT ENTRY JMP ENTX2 SET WORD 4 OF ENT ENTRY * * EXT DEFINES A NEW SYMBOL * LDA \ID6,I GET TYPE AND M7 ISOLATE TYPE CCB GET MAIN IDENT INDEX ADB \TIDN CPA P5 TYPE = BS? CMB,RSS YES - SET \LST4 = BS REF, SKIP CLB NO - SET \LST4 = UNDEFINED STB \LST4,I YES - SET INDEX IN LST WORD 4 ENTX4 LDA \ID6,I GET TYPE AND M7 ISOLATE TYPE CPA P5 TYPE = BG SEGMENT? RSS YES - CONTINUE JMP ENTX5 NO - IGNORE BG SEG MAIN ADDR * * CHECK EXT REFERENCE BY A BG SEGMENT * CCA ADA \TIDN GET CURRENT IDENT INDEX. STA IMAIN SAVE IDENT INDEX. LDA \LST4,I GET IDENT INDEX. SZA SKIP IF UNDEFINED. SSA SKIP IF IDENT INDEX. JMP ENTX5 IGNORE UNDEFINED EXT * CPA B2 IF SPECIAL SYMBOL RSS FOR GET CPA P3 THE BS RSS BIT CPA P4 JMP ENTX5 CPA P6 IF AN EMA SYMBOL LDA \LST5,I THEN GET ITS IDENT INDEX * STA \TIDN SET IDENT INDEX FOR \IDX JSB \IDX SET IDENT ADDRESSES JSB \ABOR IDENT NOT FOUND LDA \ID4,I GET M,S SSA,RSS SKIP IF MAIN JMP NTMAN SET FLAG FOR IGNORING BS REF * LDA \ID6,I GET TYPE AND M7 ISOLATE TYPE CPA B2 TYPE = RT DISK RESIDENT? RSS CPA P3 TYPE = PR DISK RESIDENT? RSS CPA P4 TYPE = BG DISK RESIDENT? CCB,RSS SET FLAG FOR BS REF, SKIP NTMAN CLB SET FLAG FOR IGNORING BS REF STB \TCHR SET FLAG = 0/-1 = IGNORE/BS REF LDA IMAIN GET CURRENT IDENT INDEX. STA \TIDN SET FOR NEXT IDENT. JSB \IDX SET CURRENT IDENT ADDRESSES JSB \ABOR INDEX INVALID. ISZ \TCHR SKIP - SET IDENT ADDR FOR BS REF JMP ENTX5 IGNORE IF NOT MAIN BG DISK RES * LDA \LST4,I GET BG MAIN INDEX. CPA P6 IF AN EMA SYMBOL LDA \LST5,I THE MAIN IDENT IS HERE! STA \ID8,I SET MAIN IDENT INDEX IN BS IDENT ENTX5 LDA SYM12 GET SYMBOL ADDR ADA P3 ADJUST FOR BOTH ENT & EXT STA SYM12 SAVE THE ADDRESS FOR NEXT SYMBOL LDB NXFLG GET EXT/ENT FLAG SZB,RSS IF EXT SKIP THE SPECIAL SYMBOL JMP ENTX8 CODE * ADB SYM12 GET THE FLAG LDA B,I AND P15 ISOLATE THE SYMBOL TYPE LDB \LST4,I IF UNDEFINED MUST SZB,RSS BE A FOURCED JMP ENTX7 SYMBOL SO DON'T RESET * SZA IF PROGRAM CPA P1 OR BASE PAGE JMP ENTX7 THEN STANDARD SYMBOL SKIP * STA \LST4,I SET THE SPECIAL FLAG LDA SYM12,I GET THE VALUE STA \LST5,I AND SET IT ENTX7 ISZ SYM12 STEP TO THE NEXT SYMBOL ENTX8 ISZ EXCNT TEST SYMBOL COUNTER JMP SETNX PROCESS NEXT SYMBOL * JMP LDRIN GO GET NEXT RECORD. SKP * * EMA RECORD PROCESSOR * EMAR LDA \ID6,I HAS AN EMA ALREADY SSA BEEN DECLARED FOR THIS MODULE? JMP EER41 YES (ERROR+BACKUP) * AND M7 GET THE MODULE TYPE - EMA'S CPA B2 AN BE USED ONLY IN RSS REAL-TIME DR CPA P3 RSS PRIVILEGED DR CPA P4 RSS AND BACKGROUND DR JMP EER40 ELSE INVALID DECLARATION (SET TO TYPE 8) * * ENTER EMA SYMBOL INTO LST AS A TYPE 6 * ENLST LDB DNAM JSB \LSTE ENTER EMA SYMBOL INTO LST JMP NEWEM NEW ENTRY LDA \LST4,I PREVIOUSLY DEFINED? SZA,RSS JMP NEWEM NO, JUST REFERENCED * LDA ERR05 DUPLICATE ENTRY POINT CMA,INA SEND ERROR JSB \GNER DIAGNOSTIC LDA P5 AND THE LDB \LST1 NAME JSB \MESS * NEWEM LDA P6 SET SYMBOL TYPE TO STA \LST4,I THAT OF AN EMA CCB SET ITS 'VALUE' TO ADB \TIDN THE IDENT INDEX OF STB \LST5,I THE MAIN PROGRAM DECLARING IT * LDB ALBUF GET EMA SIZE FROM INB WORD 2 OF EMA RECORD LDA B,I AND M1777 ISOLATE IT ALF ROTATE DECLARED SIZE IOR \ID5,I TO BIT (13-4) AND SET IN STA \ID5,I MODULE'S IDENT ENTRY * ADB P5 GET MSEG SIZE FROM WORD 7 LDA B,I OF EMA RECORD AND M37 ISOLATE IT ALF,RAL AND ROTATE THE DECLARED ALF,RAL SIZE TO BITS (14-10) IOR MSIGN SET BIT 15 FOR EMA IOR \ID6,I AND SET IN IDENT STA \ID6,I ENTRY JMP LDRIN GO GET NEXT RECORD * EER40 LDA ERR40 SEND ERROR DIAGNOSTIC FOR EMA CMA,INA DECLARATION BY A NON-DISC RESIDENT JSB \GNER PROGRAM LDB \ID1 GET ADDRESS OF NAME LDA P5 AND CHARACTER COUNT JSB \MESS PRINT PROGAM NAME LDA \ID6,I NOW SET ITS TYPE AS A AND M1776 'DELETED' PROGRAM IOR P8 OF TYPE = 8 STA \ID6,I UNTIL POSSIBLY RESET JMP ENLST DURING THE PARAMETER PHASE * M1777 OCT 1777 M1776 OCT 177600 MSIGN OCT 100000 ERR41 ASC 1,41 SKP * EER41 LDA ERR41 DUPLICATE EMA'S DECLARED * ERCOV LDB SERFG IF PROCESSING A SKIP SSB JMP INCHK THEN JUST CONTINUE * CMA,INA SET NEG SO NO TR,ERRLU MAY BE DONE ERCO1 JSB \GNER SEND ERROR MESSAGE * LDA NAMR. WAS A NAM RECORD EXPECTED? SZA,RSS SKIP IF ONE WASN'T JMP ERCO2 NEEDN'T BACK UP THE INDICES LDA SERFG WAS A SKIP BEING PROCESSED? SSA SKIP IF ONE WASN'T JMP ERCO3 NEEDN'T BACK UP INDICES * LDA BUID BACK UP THE IDENT LST STA \PIDN LDA BULST AND THE ENT LIST STA \PLST * ERCO2 CCA SET THE FLUSHING STA SERFG FLAG ERCO3 CLA STA NA~HFBMR. AND CLEAR THE NAM EXPECTED FLAG. JMP INCHK GO GET THE NEXT RECORD SKP * * SUBROUTINE TO COMPUTE CHECKSUM OF A RELOCATABLE RECORD. * * ON ENTRY: * A-REG = BUFFER ADDRESS CONTAINING RECORD * ON EXIT: * A-REG = CHECKSUM VALUE * CKSUM NOP LDB A,I GET RECORD LENGTH BLF,BLF CMB,INB NEGATE. ADB P3 SKIP WORDS 1-3. STB WDCNT RECORD WORD COUNTER. LDB A GET BUFFER ADDRESS INA LDA A,I GET WORD 2, INIT CHECKSUM ADB P3 SET TO WORD 4 ADA B,I ADD WORD TO CHECKSUM. INB INCREMENT ADDRESS ISZ WDCNT SKIP IF END OF RECORD JMP *-3 LOOP TILL DONE. JMP CKSUM,I EXIT. SKP BUID NOP SAVED IDENT INDEX BULST NOP SAVE LST INDEX N5 DEC -5 P1 DEC 1 P3 DEC 3 P4 DEC 4 P5 DEC 5 P8 DEC 8 P9 DEC 9 P12 DEC 12 P13 DEC 13 P15 DEC 15 P30 DEC 30 M7 OCT 7 M17 OCT 17 M37 OCT 37 M77 OCT 77 M177 OCT 177 M7400 OCT 177400 M7777 OCT 77777 ERR05 ASC 1,05 ERR08 ASC 1,08 ERR13 ASC 1,13 SYM12 NOP SLST NOP SIGN OCT 100000 * MES22 DEF *+1 ASC 3,(NONE) SKP * * PROCESSOR FOR END COMMAND * ***** * ** END COMMAND PROCESSOR * ***** * * PRINT LIST OF UNDEFINEDS, IF ANY, OR "NO UNDEFS" * EOL CLA JSB EPL JMP PRCMD,I END OF COMMANDS. * H* ***** CONSTANTS ***** * MD24 DEC -24 B2 OCT 2 B40 OCT 40 B51 OCT 51 B54 OCT 54 SKP * * SET PARAMETERS INTO IDENTS * * THE PARAMETER INPUT SECTION PERMITS ALTERATION (OR INTRODUCTION) * OF THE TYPE, PRIORITY, AND EXECUTION INTERVAL FOR EACH PROGRAM. * EACH PARAMETER RECORD HAS ONE OF THE FOLLOWING FORMATS: * * NAME,TYPE * NAME,TYPE,PRIORITY * NAME,TYPE,PRIORITY,EXECUTION INTERVAL * * TYPE = 2 DECIMAL DIGITS (1-99) * PRIORITY = 5 DECIMAL DIGITS (0-32767) * EXECUTION INTERVAL = 6 OPERANDS * 1 - RESOLUTION CODE (2 DECIMAL DIGITS) * 2 - EXECUTION MULTIPLE (5 DECIMAL DIGITS) * 3 - HOURS (2 DECIMAL DIGITS) * 4 - MINUTES (2 DECIMAL DIGITS) * 5 - SECONDS (2 DECIMAL DIGITS) * 6 - 10'S MULLISECONDS (2 DECIMAL DIGITS) * * NOTE: TYPE OF BG DISK RESIDENTS HAVING BG SEGMENTS MAY NOT * BE ALTERED WITHOUT DESTROYING RELATIONSHIP. * PARAM JSB \SPAC NEW LINE LDA P10 LDB MES24 MES24 = ADDR: PARAMETERS JSB \MESS PRINT: PARAMETERS * PARST CLA,INA LDB HYADD JSB \READ GET ASCII PARAMETER RECORD SZA,RSS SKIP IF CHARS INPUT JMP PARST REPEAT PARAMETER INPUT * LDA N5 JSB \GETN MOVE CHARS FROM LBUF TO TBUF CPA "/E" CHARS = /E? JMP SETLB YES - CLOSE FILE. * CPA BLANK BLANK LINE OR COMMENT? JMP PARST YES TRY ANOTHER * JSB \GETC GET NEXT CHAR FROM LBUF CPA B40 CHAR = BLANK?(DELIMITER = COMMA) JMP PANOK YES - CONTINUE * PANER LDA ERR09 PARAMETER NAME ERROR JMP PARER * PANOK LDB ATBUF FIND THE PROGRAM JSB \IDXS IN THE IDENT TABLE JMP PANER NOT FOUND- INVALID NAME * * SET TYPE LDA N2 JSB \GET# CONVERT TO OCTAL JMP PATER INVALID DIGIT * JSB \GETC GET NEXT CHAR FROM LBUfF CPA ZERO CHAR = ZERO? (END OF BUFFER) RSS YES - CONTIMUE CPA B40 CHAR = BLANK?(DELIMITER = COMMA) JMP SETYP SET PROGRAM TYPE IN IDENT * PATER LDA ERR10 PARAMETER TYPE ERROR JMP PARER * SETYP CLB IF THIS IS THE SCHEDULED PGM CCA ADA \TIDN AGAIN CPA SCH1 THEN STB SCH1 CLEAR ITS FLAG LDB \OCTN GET CONVERTED NUMBER LDA \ID6,I GET CURRENT TYPE AND M177 TO A CPA B IF NO CHANGE JMP TYPOK SKIP CHECK * CPB P14 IF CHANGE IS TO CORE RES LIB CPA P6 MUST BE LEGAL CORE RES. LIB. MODULE RSS OK SKIP JMP PATER NOT OK, ERROR CPB P8 IF A DELETION JMP TYPOK THEN JUST CONTINUE * LDA \ID6,I EMA PROGRAM? SSA,RSS JMP TYPOK NO,NEEDN'T CHECK NEW TYPE LDA B GET NEW TYPE AND M7 ISOLATE CPA B2 RT DISK RESIDENT? JMP TYPOK YES, A VALID EMA TYPE CPA P3 PR DISK RESIDENT? JMP TYPOK OK HERE TOO CPA P4 BG DISK RESIDENT? JMP TYPOK AND HERE * LDA ERR40 NOT A VALID EMA TYPE JSB PNERR JMP PARST CONTINUE ERR40 ASC 1,40 * TYPOK LDA \OCTN IF AUTO SCHED AND P64 BIT NOT SET SZA,RSS THEN JUST GO JMP SCH SET TYPE. SPC 1 LDB \OCTN AUTO SCHED...SUBTRACT ADB N80 80 FROM TYPE TO STB \OCTN GET REAL TYPE. * LDA \ID4,I M,S BIT TO E CLE,ELA LDA \ID6,I MERGE EMA INFO AND M7600 WITH TYPE. IOR B CCB ADB \TIDN B HAS IDENT INDEX. SPC 1 SEZ,RSS IF NOT MAIN PGM JMP SCH IGNOR IT AND M7 MASK TO THE ID TYPE SZA IF ZERO OR ADA N5 MORE THAN 4 SSA SKIP STB SCH1 ELSE SET PGM IDENT IN SCH FLAG SPC 1 SCH LDB \OCTN GET NEW TYPE LDA \ID6,I INTO IDENT 6 AND M7600 IOR B STA \ID6,I SPC 1 JSB \GETC GET NEXT CHAR FROM LBUF CPA ZERO CHAR = ZERO ? (END OF BUFFER) JMP PARST YES - GET NEXT PARAMETER RECORD * * SET NEW PROGRAM PRIORITY * LDA N5 SET COUNT FOR DECIMAL CONVERSION JSB \GET# CONVERT TO OCTAL JMP PAPER PRIORITY ERROR * SSA IF NEGATIVE JMP PAPER THEN ERROR * JSB \GETC GET NEXT CHAR FROM LBUF SZA CHAR = ZERO ? (END OF BUFFER) CPA B40 CHAR = BLANK?(DELIMITER = COMMA) JMP SETNR SET PRIORITY * PAPER LDA ERR11 PARAMETER PRIORITY ERROR JMP PARER * SETNR CLB SIGNAL \RNAM TO IGNORE NAME IN PARSA LDA ACBUF GET THE NAM RECORD TO CBUF. JSB \RNAM JSB \ABOR ERROR. * JSB FINDN SEARCH FOR A MODIFIED NAM RECORD JMP SETPR DID'T HAVE ONE YE$ JMP SETPR FOUND, NOW MODIFY IT SKP * * SEARCH FOR A MODIFIED NAM RECORD BELONGING TO THE * CURRENT IDENT * * RETURN: (P+1) ONE DOES NOT EXIST YET * (P+2) FOUND ONE - POSITIONED TO IT * * BRANCHES TO PACLO ON FILE ERROR (FOR TERMINATION) * FINDN NOP CLA STA IRECW LDA \ID5,I CHECK IF NAM RECORD ALREADY HAS RAL MODIFIED VERSION (COMPILED PROG). SSA,RSS JMP FINDN,I NO. * JSB LOCF YES. SAVE CURRENT WRITE POINTERS. DEF *+6 DEF \NDCB+0 DEF \FMRR+0 DEF IRECW DEF IRBW DEF IOFFW * LDA DNDCB GET DCB ADDRESS IN CASE OF ERROR JSB \CFIL JMP PACLO ERROR. * JSB RWNDF REWIND THE FILE. DEF *+3 DEF \NDCB+0 DEF \FMRR+0 * LDA DNDCB JSB \CFIL JMP PACLPO ERROR. * END1 JSB LOCF GET LOC. OF NEXT RECORD. DEF *+6 DEF \NDCB+0 DEF \FMRR+0 DEF IRECR DEF IRBR DEF IOFFR * LDA DNDCB GET DCB ADDRESS IN CASE OF ERROR JSB \CFIL JMP PACLO ERROR. * JSB READF READ THE RECORD. DEF *+6 DEF \NDCB+0 DEF \FMRR+0 DEF CBUF DEF P60 DEF LEN * LDA DNDCB JSB \CFIL JMP PACLO ERROR. * LDA LEN CPA N1 JMP PACLO ERROR IF EOF. * LDB ACBUF COMARE NAM IN CBUF ADB P3 AGAINST NAM IN IDENT. LDA B,I CPA \ID1,I INB,RSS JMP END1 NO MATCH. LDA B,I CPA \ID2,I INB,RSS JMP END1 NO MATCH. LDA B,I XOR \ID3,I AND M7400 SZA JMP END1 NO MATCH. * JSB APOSN MATCH. POSITION NEXT WRITE. DEF *+6 DEF \NDCB+0 DEF \FMRR+0 DEF IRECR DEF IRBR DEF IOFFR * LDA DNDCB GET DCB ADDRESS IN CASE OF ERROR JSB \CFIL JMP PACLO ERROR. * ISZ FINDN JMP FINDN,I RETURN (P+2) SKP * SETPR LDA CBUF ADJUST RECORD LENGTH FOR THOSE ALF,ALF NOT FIXED FOR COMPILED PROGRAMS. CPA P9 LDA P17 STA IL ALF,ALF STA CBUF LDB \OCTN GET PRIORITY SZB,RSS SKIP - PRIORITY ENTERED LDB P99 REPLACE ZERO PRIORITY WITH 99 LDA \ID6,I GET THE TYPE AND M177 AND ISOLATE IT SZA,RSS IF A SYSTEM PROGRAM USE CLB PRIORITY ZERO STB CBUF+10 SET NEW PRIORITY IN THE RECORD JSB \GETC GET NEXT CHAR FROM LBUF CPA ZERO CHAR = ZERO ? (END OF BUFFER) JMP PARWR YES - GO REWRITE THE NAM RECORD * * GET RESOLUTION CODE * LDA N2 SET FOR 2 DECIMAL DIGITS JSB EXAINT GET DIGITS FROM LBUF STA CBUF+11 SET IN THE NAM RECORD * * GET EXECUTION MULTIPLE * LDA N5 SET COUNT FOR DECIMAL CONVERSION JSB EXINT GET DIGITS FROM LBUF AND M1600 ISOLATE UPPER 3 BITS IN A SZA SKIP IF VALID MULTIPLE JMP PAIER INVALID EXECUTION INTERV FORMAT LDA \OCTN GET CONVERTED NUMBER STA CBUF+12 SET IN THE NAM RECORD * * GET HOURS * LDA N2 SET FOR 2 DECIMAL DIGITS JSB EXINT GET DIGITS FROM LBUF STA CBUF+13 SET IN THE NAM RECORD * * GET MINUTES * LDA N2 SET FOR 2 DECIMAL DIGITS JSB EXINT GET DIGITS FROM LBUF STA CBUF+14 SET IN THE NAM RECORD * * GET SECONDS * LDA N2 SET FOR 2 DECIMAL DIGITS JSB EXINT GET DIGITS FROM LBUF STA CBUF+15 SET IN THE NAM RECORD * * GET TENS OF MILLISECONDS * LDA N2 SET FOR DECIMAL CONVERSION JSB \GET# CONVERT TO OCTAL JMP PAIER INVALID DIGIT JSB \GETC GET NEXT CHAR FROM LBUF SZA CHAR = 0? (END OF BUFFER) JMP PAIER NO - INVALID DELIMITER * LDA \OCTN GET CONVERTED NUMBER STA CBUF+16 SET IN THE NAM RECORD * PARWR JSB NEWNM BUILD NEW MODIFIED RECORD JMP PARST SKP * * COMPUTE AND STORE NEW CHECKSUM, WRITE RECORD TO * NEW NAM FILE, AND SET FLAG IN IDENT. * NEWNM NOP LDA ACBUF GET BUFFER ADDRESS CONTAINING RECORD JSB CKSUM STA CBUF+2 SAVE NEW CHECKSUM * JSB WRITF WRITE RECORD. DEF *+5 DEF \NDCB+0 DEF \FMRR+0 DEF CBUF DEF IL * LDA DNDCB GET DCB ADDRESS IN CASE OF ERROR JSB \CFIL \ABOR IF WRITE ERROR. JMP PACLO * LDA \ID5,I SET FLAG IN IDENT. IOR BIT14 STA \ID5,I * LDA IRECW WAS IT AN UPDATE WRITE? SZA,RSS JMP NEWNM,I NO. * JSB APOSN YES. GET BACK TO OLD PLACE. DEF *+6 DEF \NDCB+0 DEF \FMRR+0 DEF IRECW DEF IRBW DEF IOFFW * LDA DNDCB GET DCB ADDRESS IN CASE OF ERROR JSB \CFIL JMP PACLO * JMP NEWNM,I * IRECW NOP IRBW NOP IOFFW NOP IRECR NOP IRBR NOP IOFFR NOP P60 DEC 60 LEN NOP BIT14 OCT 40000 ACBUF DEF CBUF CBUF BSS 60 SKP * EXECUTION INTERVAL INPUT CONTROL EXINT NOP JSB \GET# CONVERT TO OCTAL JMP PAIER INVALID DIGIT JSB \GETC GET NEXT CHAR FROM LBUF CPA B40 CHAR = BLANK? (DELIMITER=COMMA) RSS YES - CONTINUE JMP PAIER NO - INVALID DELIMITER LDA \OCTN GET CONVERTED NUMBER JMP EXINT,I RETURN WITH NUMBER IN A * PAIER LDA ERR12 PARAMETER INTERVAL ERROR PARER JSB PNERR SEND ERROR MESSAGE JMP PARST TRY AGAIN * PNERR NOP SUBROUTINE TO PRINT ERROR JSB \GNER PRINT \GNER MESSAGE JSB \SPAC NEW LINE JMP PNERR,I RETURN * * PACLO LDA \FMRR WRITE ERROR? SSA,RSS JMP PARST NO. * JSB \TERM \ABOR. SKP * * CHANGE ENTS SECTION * SETLB JSB \SPAC LDA P12 GET MESSAGE LENGTH LDB MES21 SEND MESSAGE JSB \MESS 'CHANGE ENTS?' * PENT CLA,INA LDB HYADD JSB \READ \READ THE ENT RECORD. SZA,RSS IF ZERO JMP PENT TRY AGAIN * LDA N5 TO JSB \GETN TBUF CPA "/E" IF '/E' JMP EXENT DONE GO TO NEXT SECTION * CPA BLANK IF '*' OR BLANK LINE JMP PENT TRY THE NEXT LINE * JSB \GETC GET THE NEXT CHAR CPA B40 IF COMMA JMP ENTOK OK *  ENAME LDA ERR09 ELSE ERROR JMP EARER GO REPORT IT * ENTOK LDB ATBUF FIND THE JSB \LSTE DEFINE AND OR LOCATE LST NOP (DON'T CARE IF EARLIER DEFINED) * LDA \LST4,I CAN'T CHANGE THE TYPE OF CPA P6 AN EMA SYMBOL JMP EATER * LDA N2 GET TYPE FLAG JSB \GETN CARACTER CLE CPA "AB" IF ABSOLUTE CLB,CCE SET FLAG CPA "RP" IF REPLACE CLB,CCE,INB SET OTHER FLAG SEZ IF NONE OF THE ABOVE JMP ENTNO * EATER LDA ERR10 THEN SEND ERROR EARER JSB PNERR JMP PENT * ENTNO ADB P3 ADJUST TO ENT TYPE STB \IDXS SAVE IN TEMP JSB \GETC CHECK FOR COMMA CPA B40 AS NEXT CHARACTER RSS IF NOT JMP EATER BITCH * LDA \CURL SAVE CURRENT STA \ID1 POSITION LDA \BUFL FOR BACKING STA \ID2 UP LDA B7 GET NUMBER JSB \GET# ASSUMING OCTAL RSS IF ERROR MIGHT BE DECIMAL SO SKIP JMP ENTOC IT IS OCTAL SO GO SET UP * LDA \ID1 BACK UP THE SCANNER STA \CURL POSITION LDA \ID2 STA \BUFL LDA N7 NOW TRY JSB \GET# A DECIMAL CONVERSION RSS ERROR EXPECTED ( 12345D) ON THE D JMP EATER NO ERROR SO WRONG INPUT * LDA \TCHR MAKE SURE ERROR CPA P20 WAS ON A "D" RSS YES SO FAR SO GOOD JMP EATER NO GO BITCH * ENTOC LDA \IDXS SET THE ENT TYPE STA \LST4,I AND LDA \OCTN VALUE STA \LST5,I IN THE SYMBOL TABLE JMP PENT GO GET NEXT SYMBOL. * EXENT JSB \SPAC SEND A \SPAC SKP * * SET LIBRARY, COM, TYPE TOTALS * * THIS SECTION IS EXECUTED WHEN THE PARAMETERS HAVE * BEEN COMPLETELY READ IN. IT COMPUTES THE MAXIMUM LENGTH OF * BOTH TH&E REAL TIME AND BACKGROUND COMMON AREAS. * IT ALSO COMPUTES THE NUMBER OF MEMORY RESIDENT, LONG, AND SHORT * (SEGMENT) ID SEGMENTS NEEDED TO RELOCATE THE PRESENT SET OF * PROGRAMS SPECIFIED BY IDENTS. THE NUMBER OF EMA EXTENSIONS NEEDED * IS ALSO COMPUTED BY COUNTING THE NUMBER OF EMA PROGRAMS. * * CLA STA SICNT CLEAR MEM.RES. ID SEG COUNT STA LICNT CLEAR LONG ID SEG COUNT STA SSCNT CLEAR SHORT ID SEG COUNT STA COMRT CLEAR RT COM LENGTH STA COMBG CLEAR BG COM LENGTH STA IXCNT CLEAR ID EXTENSION COUNT STA MRACM CLEAR MR ACCESS TO COMMON FLAG JSB \INID INITIALIZE \IDX SETIX JSB \IDX SET IDENT ADDRESSES JMP \PIP,I TERMINATE ID SEGMENT COUNT * LDA \ID6,I GET TYPE AND M17 ISOLATE TYPE AND REV COM BITS LDB \ID4,I GET COMMON LENGTH SWP AND M7777 MASK OFF M,S BIT SWP CPA P11 IF PR DISK RESIDENT USING RT COMMON RSS CPA P12 OR BG DISK RES USING RT COMMON RSS CPA P1 OR TYPE = MEMORY RESIDENT? JMP SMRRC YES, CHECK COMMON DECLARATION CPA B2 OR TYPE = RT DISK RESIDENT? JMP SETRC SET RT COMMON LENGTH * CPA P9 IF MEMORY RES. USING BG COMMON JMP SMRBC YES, CHECK COMMON DECLARATION CPA P10 LIKEWISE IF RT DSC RESIDENT RSS CPA P3 TYPE = PR DISK RESIDENT?? RSS CPA P4 TYPE = BG DISK RESIDENT? JMP SETBC SET BG COMMON LENGTH * LDA \ID6,I GET TYPE AGAIN AND M37 BUT LEAVE SSGA BIT ON CPA P14 IF CORE RES LIB. RSS CPA ZERO TYPE = SYSTEM? RSS CPA P6 TYPE = LIBRARY? RSS CPA P13 TYPE = TABLE AREA II? RSS CPA P15 TYPE = TABLE AREA I? RSS CPA P16 TYPE = SLOW BOOT? RSS CPA P30 TYPE = SSGJA?? SZB,RSS SKIP - HAS INVALID COMMON JMP SETR1 PROCESS NEXT IDENT * LDA ERR37 SET CODE = INVALID COMMON CMA,INA COMPLEMENT SO NO TR,ERRLU DONE JSB \GNER PRINT DIAGNOSTIC LDA P5 LDB \ID1 GET IDENT ADDRESS JSB \MESS PRINT PROG NAME FOR INVALID COM JMP SETIX PROCESS NEXT IDENT * SMRBC LDA \ID6,I GET TYPE AGAIN AND ONLY4 CHECK SSGA BIT ONLY SZB,RSS SET FLAG IF COMMON DECLARED SZA OR IF SSGA BIT SET IN TYPE ISZ MRACM SET ACCESS TO COMMON FLAG * SETBC LDA COMBG GET PREVIOUS MAX COMMON LENGTH CMA,INA ADA B SET A = PROG COM - PREVIOUS COM SSA,RSS SKIP IF PREVIOUS GREATER STB COMBG SET NEW MAX BG COMMON LENGTH JMP SETR1 CHECK TYPE * SMRRC LDA \ID6,I GET TYPE AGAIN AND ONLY4 CHECK SSGA BIT ONLY SZB,RSS SET FLAG IF COMMON DECLARED SZA OR IF SSGA BIT SET IN TYPE ISZ MRACM SET ACCESS TO COMMON FLAG * SETRC LDA COMRT GET PREVIOUS MAX COMMON LENGTH CMA,INA ADA B SET A = PROG COM - PREVIOUS COM SSA,RSS SKIP IF PREVIOUS GREATER STB COMRT SET NEW MAX RT COM LENGTH SETR1 LDA \ID4,I GET M/S SSA,RSS SKIP IF MAIN JMP SETIX PROCESS NEXT IDENT * LDA \ID6,I AND M7 ISOLATE TYPE CPA P1 TYPE = RT RESIDENT? ISZ SICNT YES, COUNT MEM.RES. ID SEGMENT CPA B2 IF RT DISC RESIDENT RSS OR CPA P3 PRIVILEGED DISC RESIDENT RSS CPA P4 BACKGROUND DISK RESIDENT ISZ LICNT COUNT A LONG ID SEGMENT * CLE CLEAR EMA FLAG LDA \ID6,I GET TYPE,EMA BIT SSA SKIP IF NO EMA DECLARED CCE INDICATE EMA AND M17 ISOLATE TYPE TO DISTINGUISH CPA P5 BETWEEN TYPES 5 AND 13 ISZ SSCNT COUNT A SHORT ID SEGMENT SEZ,RSS EMA? JMP SETIX NO, GO PROCESS NEXT IDENT AND M7 MASK TYPE SZA EXCLUDE TYPE 8'S SINCE THEY'RE EMAS ARE INVALID ISZ IXCNT INCREMENT COUNT JMP SETIX CONTINUE SCAN * * ONLY4 OCT 20 BIT 4 SET ZERO OCT 0 N7 DEC -7 P6 DEC 6 P10 DEC 10 P11 DEC 11 P14 DEC 14 P16 DEC 16 P20 DEC 20 P64 DEC 64 P99 DEC 99 N80 DEC -80 "/E" ASC 1,/E "AB" ASC 1,AB "RP" ASC 1,RP M1600 OCT 160000 M7600 OCT 177600 IL NOP * MES24 DEF *+1 ASC 5,PARAMETERS MES21 DEF *+1 ASC 6,CHANGE ENTS? * ERR09 ASC 1,09 ERR10 ASC 1,10 ERR11 ASC 1,11 ERR12 ASC 1,12 ERR37 ASC 1,37 SKP ***** * ** EPL * ENTRY POINT LIST ROUTINE * * CALLING SEQUENCE: * (A): =0, LIST UNDEFINED EXTERNAL SYMBOLS. * =1, LIST ENTRY POINT SYMBOLS AND * * (P) JSB EPL * (P+1) (RETURN) A AND B DESTROYED * ***** EPL NOP ENTRY/EXIT POINT STA NBUF SAVE ENTRY PARAMETER. SZA,RSS UNDEFS? JMP EPL5 YES EPL0 JSB \ILST INITIALIZE SYMBOL TABLE POINTERS. EPL1 JSB \LSTX SET LST ENTRY ADDRESSES JMP EPL3 END OF SYMBOL TABLE JSB MLBUF MOVE SYMBOL TO LBUF LDB \LST4,I (B) = ENT. ADDRESS LDA NBUF (A) = ENTRY PARAMETER SZA IF ENT LIST REQUESTED JMP EPL2 GO DISPLAY. CMB,SSB,INB,SZB SKIP IF UNDEF OR BS REF. JMP EPL1 GO CHECK NEXT ENTRY. * LDA TEMP1 HEADING PRINTED? SZA JMP EPL8 YES. ISZ TEMP1 NO. SET FLAG AND LDA UNDFS PRINT "UNDEFS". LDB UNDFS+1 JSB \MESS * EPL8 LDB ALBUF LDA P5 JSB \MESS OUTPUT SYMBOL. JMP EPL1 CONTINUE SCAN * * LIST SYMBOL TABLE * EPL2 CMB,SSB,INB,SZB,RSS ENTRY DEFINED? JMP EPL1 NO JMP EPL8 PROCESS N%EXT ENTRY IN LST. * * LIST UNDEFS * EPL5 LDA SLST SET BOTTOM OF PGM LST FOR SCAN. STA \TLST CLA CLEAR HEADING FLAG. STA TEMP1 JMP EPL1 * EPL3 LDA NBUF IF NO UNDEFS, ADA TEMP1 PRINT "NO UNDEFS". SZA JMP EPL,I * LDA EPL6 NO--PRINT "NO UNDEFS" LDB EPL6+1 JSB \MESS CLA JMP EPL,I SPC 1 EPL6 DEC 9 DEF *+1 ASC 5,NO UNDEFS SPC 1 * UNDFS DEC 7 DEF *+1 ASC 4, UNDEFS * * CONSTANT AND STORAGE SECTION FOR -EPL- . * M3 OCT -3 B7 OCT 7 B60 OCT 60 * * * MOVE CURRENT SYMBOL FROM SYMBOL TABLE TO LBUF * MLBUF NOP LDA \LST1 LDB ALBUF MVW P3 LDA \LBUF+2 MAKE 6TH CHAR. A BLANK IOR B40 STA \LBUF+2 JMP MLBUF,I SKP ***** * * SUBROUTINE: CONV (CONVERT 15-BIT BINARY NUMBER * TO 6-CHARACTER (LEADING BLANK) * ASCII FORM OF THE OCTAL * REPRESENTATION.) * * CALLING SEQUENCE: * * (A)-ADDRESS OF 3-WORD AREA FOR * STORING ASCII/OCTAL CHARACTERS * (B)-BINARY VALUE FOR CONVERSION * * (P) JSB CONV * (P+1) (RETURN)-(A)=NEXT ADDRESS OF STORAGE * AREA,(B)-DESTROYED. ***** CONV NOP STA NBUF+3 SAVE STORAGE AREA ADDRESS RBL POSITION FIRST DIGIT TO B(15-13). LDA M3 LET CONVERT COUNTER STA NBUF+4 = -3. LDA B40 MAKE FIRST CHARACTER A \SPAC. CONV1 ALF,ALF ROTATE CHAR. TO UPPER POSITION STA NBUF+5 AND SAVE. BLF,RBR POSITION NEXT DIGIT TO B(02-00), LDA B AND B7 ISOLATE DIGIT. IOR B60 MAKE AN ASCII CHAR. (60 - 67). IOR NBUF+5 PACK IN UPPER CHARACTER STA NBUF+3,I AND STORE IN STORAGE AREA. ISZ NBUF+3 ADD 1 TO STORAGE AREA ADDRESS. HFBBLF,RBR ROTATE NEXT DIGIT TO LOW B, LDA B ISOLATE CHAR AND B7 IN LOW A, IOR B60 MAKE AN ASCII CHAR. ISZ NBUF+4 INDEX CONVERT COUNTER JMP CONV1 NOT FINISHED. LDA NBUF+3 FINISHED, SET (A)= NEXT STORAGE JMP CONV,I AREA WORD ADDRESS AND EXIT. * SPC 2 ***** * ** QGETC ** GET NEXT CHAR FROM INPUT BUFFER (QIBUF) * CALLING SEQUENCE: * * JSB * RETURN1 NO MORE CHARS IN BUFFER * RETURN2 GOT ONE, RETURN IT IN .A. * ***** QGETC NOP GET A CHARACTER LDB QQCNT CPB QQCHC END OF INPUT? JMP QGETC,I YES. ISZ QQCNT COUNT CHARS READ LDA QQPTR,I SLB,RSS LEFT CHAR? ALF,ALF YES, MOVE RIGHT AND B177 SLB IF THIS CHAR IS RIGHT, ... ISZ QQPTR NEXT ONE IS LEFT OF NEXT WORD. CPA STAR IF * THEN END OF LINE RSS ISZ QGETC SKIP EXIT JMP QGETC,I * QBUFA DEF QIBUF QIBUF BSS 40 QQCHC NOP QQCNT NOP QQPTR NOP STAR OCT 52 SKP * * CONSTANTS,AND MESSAGES * * ***** CONSTANTS ***** * B50 OCT 50 D15 DEC 15 B75 OCT 75 B177 OCT 177 B377 OCT 377 N2 DEC -2 LNKMD NOP LINKS FLAG. MAPMD NOP MAP FLAG. SPC 3 SPC 1 END EQU * * END LSWAP vHASMB,R,L,C HED RT4G3 - LOADING CONTROL SEGMENT NAM RT4G3,5,90 92067-16009 REV.1805 780302 SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 2 SPC 1 ****************************************************************** * * NAME: RT4G3 * SOURCE PART #: 92067-18009 * REL PART #: 92067-16009 * WRITTEN BY: KFH, JH, GAA * ****************************************************************** SPC 1 * * ENTRY POINT NAMES * ENT \GENS * * EXTERNAL REFERENCE NAMES * EXT \PART * EXT \EXIT,\CLDP EXT \LODN,\GNIO,\FSEC,\SYTB EXT \CURL,\CPL2 EXT \TBCH,\PIOC,\SWPF,\LBUF,\TBUF EXT \CONV,\ABDO,\DSKA,\DSKO,\DSKI EXT \OCTN,\ADSK,\PTYP,\TMSK EXT \GET#,\GETC,\SPAC,\READ,\GNER,\MESS,\ABOR EXT \ADBP,\PREL,\NUMP EXT \ILST,\LSTX,\LSTS EXT \LST3,\LST4,\LST5 EXT \INID,\IDX,\TIDN,\IDXS EXT \ID1,\ID2,\ID3,\ID4,\ID5,\ID6,\ID8 EXT \TBLK,\MRT2 EXT \LRBP,\URBP,\IRBP EXT \CUBP,\UCBP,\ICBP,\CBPA EXT \LNK,\LNKS EXT \LNK1,\LNK2,\LNK3 EXT \SEGS,\SYS,\USRS,\USER,\DSYS EXT \SRET,\PFIX,\TFIX,\ADBF,\OLDA EXT \TRUN EXT \IRER,\TERM EXT \ABCO,\MXAB,\TIME,\TIM1,\MULR EXT \CPLB,\ASKY,\SSID,\SKYA EXT \INER * * A EQU 0 B EQU 1 SUP ************************************************************************ * SKP *************************************************************************** * * 770913  * * THE FOLLOWING BLOCK OF STORAGE FOR VARIABLES PRECEEDS, * AND IS REFERENCED BY, EACH SEGMENT. IT IS NOT OVERLAID * AS EACH NEW SEGMENT IS LOADED INTO MEMORY. * * THE LOCATION OF EACH VARIABLE MUST BE THE SAME IN ALL * SEGMENTS. IF A CHANGE IS MADE, MAKE THE SAME CHANGES * IN THE REST OF THE SEGMENTS. * *************************************************************************** * * TB30 BSS 128 TRACK MAP TABLE/HEADER RECORD BUFFER * ILIST BSS 64 USER SYSTEM PROG IDENT ADDR LIST CURIL BSS 1 CURRENT ILIST ADDRESS * SYSCH BSS 1 SUBCHANNEL OF SYSTEM UNIT. DCHNL BSS 1 CHANNEL OF SYSTEM DISK UNIT AUXCH BSS 1 SUBCHANNEL OF AUX UNIT. DSIZE BSS 1 DISK SIZE -NO. OF TRACKS. #SUBC BSS 1 # DISC SUBCHANNELS DEF'D (7905/7920) DAUXN BSS 1 AUXILIARY DISK SIZE. ADS# BSS 1 AUX DISC SECTORS/TRACK. * * RELOCATION BASE TABLE. RBTA BSS 1 ABSOLUTE PROGRAM BASE. TPREL BSS 1 CURRENT PROGRAM BASE ADDRESS. TPBRE BSS 1 BASE PAGE RELOCATION ADDRESS. COMAD BSS 1 CURRENT COMMON RELOCATION BASE. BSS 1 ABS PROGRAM BASE FOR MR CODE. * WDCNT BSS 1 TEMPORARY WORD COUNTER. DSKSY BSS 1 INITIAL ID SEGMENT DISK ADDRESS IDSP BSS 1 POSITION OF 1ST ID SEG. IN SECT TTYCH BSS 1 SYSTEM TTY CHANNEL NO. * PLFLG BSS 1 PROGRAM LOAD. FLAG = -1/0 = L/NL DSCNT BSS 1 DISK SEGMENT SECTOR COUNT * NXFLG BSS 1 ENT/EXT FLAG = -1/0 EXCNT BSS 1 SYMBOL COUNTER * LCNT BSS 1 CURRENT \LBUF COUNT DCNT BSS 1 CURRENT DBUF COUNT CURAI BSS 1 CURRENT IBUF COUNT * CPLS BSS 1 ADDRESS OF TOP OF FIXED CP LINK IMAGE CPL1 BSS 1 ADDRESS OF LOW CURRENT PAGE LINK SPECS. CPL1H BSS 1 NUMBER OF CURRENT PAGE LINKS ASSIGNED CPL2H BSS 1 IN LOW AND HIGH AREA RESPECTIVELY URBP1 BSS 1 LWA R/T DISC RES BP LINK AREA CURAK BSS 1 CURRENT KBUF ADDRESS * CURAT BSS 1 CURRENT \TBUF ADDRESS TCNT BSS 1 CURRENT \TBUF COUNT * CURAP BSS 1 CURRENT PLIST ADDRESS * AMAD BSS 1 CURRENT MLIST ADDRESS * IXCNT BSS 1 ID EXTENSION COUNT IDEXC BSS 1 CURRENT ID EXT'S USED IDEX BSS 1 ADDRESS OF ID EXTENSION TABLE * LICNT BSS 1 LONG ID SEGMENT COUNT SICNT BSS 1 SHORT ID SEGMENT COUNT SSCNT BSS 1 BG. SEG ID COUNT * DSKID BSS 1 DISK ID SEGMENT ADDRESS KEYCN BSS 1 TOTAL KEYWORD COUNT KEYCT BSS 1 CURRENT KEYWORD COUNT * MLIST BSS 11 MEMORY MAP BUFFER * TEMP1 BSS 1 TEMP2 BSS 1 LWH1 BSS 1 LWH2 BSS 1 LWH3 BSS 1 LWH4 BSS 1 L01 BSS 1 * FSYBP BSS 1 FIRST WORD SYS BP LINKAGE SYSAD BSS 1 CURRENT ID SEGMENT ADDRESS * TBREL BSS 1 CURRENT BP RELOC ADDR PBREL BSS 1 INITIAL BP RELOC ADDR * RELAD BSS 1 CURRENT CORE RELOCATION ADDRESS * BSBAD BSS 1 BG SEGMENT BP RELOC ADDR BSPAD BSS 1 BG SEGMENT PROG RELOC ADDR * LFLAG BSS 1 PROGRAMS-LOADED FLAG IMAIN BSS 1 CURRENT MAIN IDENT INDEX. HDFLG BSS 1 HEADING FORMAT FLAG CIDNT BSS 1 CURRENT MAIN IDENT INDEX. * AEQT BSS 1 ADDRESS OF EQUIPMENT TABLE CEQT BSS 1 NO. ENTRIES IN EQUIPMENT TABLE SPLCO BSS 1 SPOOL EQT COUNT DVMAP BSS 1 ADDRESS OF DRIVER MAP TABLE * DPFLG BSS 1 DP RELOCATION FLAG, 0=YES, -1=NO DPLN BSS 1 PAGE LENGTH OF DRIVER PARTITION DPADD BSS 1 START ADDR OF DRIVER PARTITION DSKDP BSS 1 DISK ADDRESS OF DP #2 PAGE# BSS 1 NEXT PHYSICAL PAGE TO ALLOCATE DPNUM BSS 1 CURRENT DP# -1, OR TOT DP PAGES SDID BSS 1 IDENT IDEX OF SYS DISK DRIVER LWDP1 BSS 1 LAST WORD OF DP, +1 FWSDA BSS 1 FIRST WORD OF SDA * ASQT BSS 1 ADDR OF DEVICE REFERENCE TABLE CSQT BSS 1 NO. ENTRIES IN DEV. REF. TABLE * AINT BSS 1 ADDRESS OF INTERRUPT TABLE * DSKIN BSS 1 DISK ADDR OF INT CODE RECORD INTCN BSS 1 RECORD COUNT OF INT CODE * IDSAV BSS 1 INDEX OF CURRENT IDENT. DSKMN BSS 1 INITIAL MAIN DISK ADDRESS BSSDP BSS 1 INITIAL DISK RES MAIN BSS DISP PRENT BSS 1 PRIMARY ENTRY POINT DBLAD BSS 1 CURRENT DBL ADDRESS REKEY BSS 1 INSTRUCTION TYPE BYTE INSCN BSS 1 INSTRUCTION TYPE COUNTER INSTR BSS 1 CURRENT INSTRUCTION PAGNO BSS 1 CURRENT PAGE NO. OPRND BSS 1 CURRENT OPERAND PLGTH BSS 1 PROGRAM LENGTH * DRT2 BSS 1 DISK DRT ENTRY ( SYSTEM) DRT3 BSS 1 AUX DISK DRT ENTRY * LIBFG BSS 1 LDTYP BSS 1 * SCH1 BSS 1 INDEX OF IDENT OF PGM TO BE SCHEDULED SCH3 BSS 1 ADDRESS OF CURRENT ID SEGMENT SCH4 BSS 1 ADDRESS OF THE SCHEDULED PGM ID SEG FGBGC BSS 1 BACKGROUND USING FG COMMON FLAG $LIBR BSS 1 INDEX OF $LIBR ENT $LIBX BSS 1 INDEX OF $LIBX ENT CUPRI BSS 1 * BLLO BSS 1 -(LOWER BUFFER LIMIT) BLHI BSS 1 -(UPPER BUFFER LIMIT) * MEM6 BSS 1 MEM12 BSS 1 * COMRT BSS 1 MAXIMUM RT COM LENGTH COMBG BSS 1 MAXIMUM BG COM LENGTH COMSZ BSS 1 #WORDS COMMON DECLARED IN CURRENT MAIN RTCAD BSS 1 RT COMMON ADDRESS BGCAD BSS 1 BG COMMON ADDRESS FPCOM BSS 1 FIRST PAGE OCCUPIED BY COMMON LPCOM BSS 1 LAST PAGE CONTAINING ANY COMMON * FPSAM BSS 1 1ST PAGE CONTAINING S.A.M. FWSAM BSS 1 1ST WORD CONTAINING S.A.M. SYMAD BSS 1 VALUE FOR AVMEM IN SCOM SAM#1 BSS 1 SIZE OF FIRST CHUNK OF SAM SAM#2 BSS 1 SIZE OF SECOND CHUNK OF SAM SAM2P BSS 1 START PAGE OF SAM #2 LWTAI BSS 1 LAST WORD OF TABLE AREA I FOR SAM#0 FWPRV BSS 1 FIRST WORD FOR PRIVILEGED PROGRAMS * FWSYS BSS 1 FIRST WORD OF SYSTEM CODE LPSYS BSS 1 LAST PAGE CONTAINING_ SYS LWSYS BSS 1 LAST WORD OF SYSTEM LPSLB BSS 1 LAST PAGE OF SLOW BOOT LWSLB BSS 1 LAST WORD OF SLOW BOOT MTYPE BSS 1 MAIN PROGRAMS'S TYPE * HIBP BSS 1 BP LINK MODE FOR FIXUP ENTRIES LOLNK BSS 1 LOW LINK FOR SSGA,LIB, OR SYS HILNK BSS 1 HI LINK USED BY MEM RES PRG BPINC BSS 1 BP LINK ALLOCATION MODE, -1=DOWN,1=UP BPLMT BSS 1 LAST AVAIL BP LINK IN CURRENT MODE, +1 * TPMAX BSS 1 HWM FOR RELOCATION OF BG MAINS & SEGS MAXPT BSS 1 NUM PARTS. ALLOWED MAT. BSS 1 ADDRESS OF MEMORY ALLOCATION TABLE * SSGA. BSS 1 FWA SSGA MAP. BSS 1 PTR TO MEU RES MAP MPFT. BSS 1 PTR TO MPFT * EMLNK BSS 1 EMA SYMBOL'S LINK EMLST BSS 1 LST INDEX OF EMA SYMBOL EMDSK BSS 1 DISK ADDR OF EMA PROGRAM * * MEMORY RESIDENT AREA POINTERS * MRACM BSS 1 MR ACCESS COMMON FLAG (>0 IF YES) LBCAD BSS 1 FIRST WORD OF MEMORY RES LIBRARY LEND BSS 1 LAST WORD OF MEMORY RES LIBRARY FWMRP BSS 1 FIRST WORD OF MEMORY RES PROGRAM AREA EMRP BSS 1 LAST WORD OF MEMORY RES PROGRAM AREA FPMRP BSS 1 FIRST PAGE OF MEMORY RES PROGRAM AREA FPMBP BSS 1 PAGE # FOR MEMORY RES BASE PAGE MRP# BSS 1 # PAGES OCCUPIED BY MRL & MRP'S DSKMB BSS 1 DISK ADDRESS OF MEMORY RES BASE PAGE DSKMR BSS 1 DISK ADDRESS OF MEMORY RESIDENT LIB/PROG AREA DSKBP BSS 1 SYSTEM DISK ADDRESS * DSKAV BSS 1 NEXT AVAILABLE DISK ADDRESS DSKLC BSS 1 DISK ADDRESS OF LIBRARY CODE DSKLB BSS 1 DISK ADDR OF LIBRARY ENTRY PTS DSKUT BSS 1 UTILITY PROG DISK ADDRESS DSKBS BSS 1 DISK ADDR OF MAIN BG DISK RES BP DSKBR BSS 1 CURRENT MAIN BG DISK RES DISK AD ADICT BSS 1 ADDR OF DISK DICTIONARY LBCNT BSS 1 RESIDENT LIBR ENTRY PT COUNT SYCNT BSS 1 SYSTEM ENTRY POINT COUNT KEYAD BSS 1 CURRENT KEYWORD ADDRESS * SYBAD BSS 1 4 ADDR OF FIRST BP LINK FOR BG IDSAD BSS 1 ADDR OF FIRST ID SEGMENT ABSID BSS 1 IDENT ADDR FOR NEXT BG SEG SCAN IDMBS BSS 1 BG MAIN ADDRESS FOR BS REF * * ********************************************************* * * * END OF COMMON STORAGE BLOCK FOR ALL SEGMENTS. * * * ********************************************************* * SPC 4 AILST DEF ILIST SKP * NOTE THE FOLLOWING RESOLVES ARITHMETIC DEF'S TO EXTERNALS * LABS CCA GET LOOP COUNTER STA TEMP1 SAVE LDB LSTAA GET ADDRESS OF LIST LOOP LDA B,I GET ADDRESS RSS LDA A,I RAL,CLE,SLA,ERA JMP *-2 STA B,I AND SAVE IT AGAIN INB ISZ TEMP1 JMP LOOP JMP \SRET RETURN TO MAIN * * LSTAA DEF *+1 ATBUF DEF \TBUF+0 SKP * PROGRAM CONSTANT FACTORS N1 DEC -1 N2 DEC -2 N5 DEC -5 N7 DEC -7 P6 DEC 6 P7 DEC 7 P9 DEC 9 P10 DEC 10 P13 DEC 13 P15 DEC 15 P17 DEC 17 P18 DEC 18 P20 DEC 20 P22 DEC 22 P24 DEC 24 P28 DEC 28 P30 DEC 30 P31 DEC 31 L2000 OCT -2000 M7 EQU P7 M37 EQU P31 M77 OCT 77 M177 OCT 177 M1000 OCT 1000 M1777 OCT 1777 M2000 OCT 2000 M1377 OCT 137777 M7777 OCT 77777 M3777 OCT 37777 M7400 OCT 177400 M7757 OCT 77577 * LWASM EQU M7777 LWSBP OCT 1645 * HLT0 HLT 0B MSIGN OCT 100000 UBLNK OCT 20000 D$STR DEF *+1 ASC 3,$STRT SKP * * LOAD ABSOLUTE SYSTEM * * THIS SEGMENT CONTROLS THE GENERATION OF * THE ABSOLUTE CODE FOR THE SYSTEM. EACH PROGRAM * IS LOADED BY TYPE AS FOLLOWS: * * (1) TABLE AREA I * (2) SSGA & COMMON * (3) SYSTEM DRIVER AREA * (4) TABLE AREA II * (5) SYSTEM * (6) PARTITION DRIVERS * (7) RESIDENT LIBRARY * ? (8) MEMORY RESIDENTS * (9) RT DISK RESIDENTS * (10) PR DISK RESIDENTS (AND BG SEGMENTS) * (11) BG DISK RESIDENTS (AND BG SEGMENTS) * * EACH TYPE OF PROGRAM IS LOADED IN THE FOLLOWING MANNER: * * THE IDENTIFICATION BLOCK FOR THE PROGRAM IS LOCATED * IN IDENT. A CALL TO LOAD IS EXECUTED TO LOAD THIS PROGRAM AND * ALL CALLED SUBROUTINES. IF THE PROGRAM IS DISK RESIDENT, * THE BASE PAGE SECTION OF CODE IS WRITTEN ON THE DISK * IMMEDIATELY AFTER THE MAIN SECTION OF CODE. IF THE * PROGRAM IS RT DISK RESIDENT, THE BOUNDARIES OF THE LARGEST * SECTION OF BASE PAGE AND PROGRAM ARE SAVED. IF THE PROGRAM IS * A USER PROGRAM (OTHER THAN SYSTEM USER PROGRAM) AN ID SEGMENT IS * GENERATED. * SKP * * INITIALIZATION * \GENS LDB P64 GET FWA BP STB FSYBP SET ADDR OF FIRST SYS LINK JSB \SPAC NEW LINE * * CLEAR LST WORD 5 (SYMBOL VALUE) * JSB \ILST INITIALIZE LST ADDRESSES CLLST JSB \LSTX SET LST ADDRESSES JMP CLRID-1 CLEAR USAGE FLAGS CLA LDB \LST4,I GET TYPE ADB N7 IF SELF SSB,RSS DEFINING SKIP CLEAR STA \LST5,I CLEAR \LST WORD 5 LDA \LST3,I GET WORD 3 OF \LST ENTRY AND M7400 ISOLATE UPPER CHARACTER STA \LST3,I SET \LST WORD 3 WITH NO ORDINAL JMP CLLST CONTINUE CLEARING LST * * CLEAR PROGRAM USAGE FLAGS * JSB \INID INITIALIZE IDENT ADDRESSES CLRID JSB \IDX SET IDENT ADDRESSES JMP IDCLR ALL IDENT FLAGS CLEAR LDA \ID3,I GET USAGE FLAG AND M7400 SET FLAG = ZERO STA \ID3,I SET CLEARED USAGE FLAG JMP CLRID CLEAR NEXT IDENT FLAG * * CLEAR PAGE 1 FOR INDIRECT LINKS * IDCLR LDA L2000 STA WDCNT SET WORD COUNT = 2000(8) CLA LDB \ADBP GET ADDRESS OF PSEUDO BASE PAGE CLRBP STA B,I CLEAR WORD IN BASE PAGE AREA INB INCR PAGE ADDRESS ISZ WDCNT  SKIP - AREA CLEARED JMP CLRBP CONTINUE CLEARING SKP * * LOAD INITIALIZATION * SPC 1 CLA STA RBTA CLEAR THE RELOCATION BASE TABLE STA TPREL STA TPBRE STA COMAD+1 STA RELAD STA \TBLK RESET THE LNKX STARTER STA LIBFG SET "NOT LOADING RES LIB" STA KEYCT STA COMAD RESET COMMON RELOC BASE STA IDSAV STA MTYPE STA DPNUM NO DP'S YET SPC 1 * SET BOUNDS FOR BASE PAGE LINK SCANNING SPC 1 STA \LRBP SHOW NO LINKS IN RESIDENT STA \URBP BASE PAGE AREA SPC 1 STA DSKMB * * SET BP LINK PARAMETERS TO ALLOCATE TOP-DOWN * FROM THE SYSTEM COMMUNICATION AREA. * CCA STA BPINC SET INC = -1 STA DPFLG NOT DP RELOC MODE * ADA LWSBP SET FIRST LINK ADDR TO STA PBREL FIRST WORD BELOW SCOM * LDA FSYBP SET BP LINK ALLOCATION STA BPLMT LIMIT TO LOWEST WORD AVAILABLE SPC 1 STA \CUBP SET CURRENT SCAN AREA TO FIRST LINK ADDR ADA \ADBP AND SET MEMORY ADDR IN RT4GN STA \ICBP IMAGE OF THE AREA * LDA M1000 SET HIGH BASE PAG INDICATOR STA HIBP FOR FIXUP BUILDING SPC 1 LDA LWSBP CURRENT PROGS SCAN AREA ENDS AT STA \UCBP SYSTEM COMM AREA SPC 1 LDA \CBPA MARK CURRENT PAGE LINK STA \CPL2 AREA EMPTY STA CPLS SPC 1 * SET RELOCATION ADDRESSES SPC 1 LDA M2000 STA \PREL SYSTEM RELOC BASE = 2000B CLA STA DSKMR SPC 1 * SET INITIAL DISK ADDRESSES SPC 1 LDA P2 STA \ADSK SET AS CURRENT STA DSKBP AND AS LOC OF BASE PAGE SPC 1 * STORE BASE PAGE ON DISK, JUST TO SAVE SPACE FOR IT SPC 1 LDA M2000 GET UPPER ADDR+1 CLB AND LOWER ADDRESS JSB BPOU<T DUMP A BASE PAGE TO DISK SPC 1 * BUMP TO NEXT EVEN SECTOR SPC 1 JSB DSKEV ALIGN AT EVEN SECTOR STA \DSYS+3 AND SAVE IN \ABDO MAP SPC 1 * SET UP LABDO CONTROL WORDS TO ACCESS SYSTEM AREA OF DISK SPC 1 JSB \SYS SPC 1 * SET PROGRAM TYPE MASK TO LOOK AT WHOLE * TYPE FIELD WHEN SCANNING THROUGH IDENT LIST SPC 1 LDA M177 LOW SEVEN BITS STA \TMSK SKP * * BUILD I/O TABLES * SPC 1 JSB \GNIO BRING IN SEG 5, GO TO IT SPC 1 * * LOAD TABLE AREA I MODULES * LDA P15 SET MODULE TYPE STA \PTYP LODI JSB IDSCN SCAN IDENTS JMP PSEUD END OF IDENTS LDB \ID3,I GET USAGE FLAG SLB,INB SKIP IF UNLOADED JMP LODI * STB \ID3,I SET WORD 3 WITH USAGE FLAG JSB \LODN INITIATE AND LOAD JSB INCAD UPDATE \PREL AND PBREL JMP LODI PROCESS NEXT TA.I MODULE * PSEUD JSB NOTST TEST FOR PROGRAMS LOADED SPC 1 * * * ASK FOR OVERRIDE OF DRIVER PARTITION SIZE * LDA P16 SET MAX SIZE FOR STA TEMP2 DP LENGTH * CLB LDA P2 ASK IF THEY WANT TO CMA CHANGE THE JSB CHBND SIZE AND DEF MES32 THEN STORE DEF TEMP2 THE STA DPLN NEW SIZE * * LOAD THE SYSTEM DISK DRIVER (PLUS ANY OTHER DRIVERS * THAT WILL FIT) INTO DRIVER PARTITION #1 * CCA SIGNAL \\LDP WHICH DP MODE JSB \CLDP NOW LOAD DP #1 * * LOAD SSGA MODULES * JSB \SPAC MAKE IT LOOK NICE LDA P30 STA \PTYP SET MODULE TYPE LDA P21 PASS MESSAGE LENGTH LDB MES31 AND ADDRESS JSB SETHD TO HEADER ROUTINE * SSGAL JSB IDSCN SCAN IDENTS JMP SETCM END OF IDENTS LDA \ID3,I PICK UP LOAD FLAG CLB,INB IOR B SET LOADED BIT z STA \ID3,I AND RESTORE JSB \LODN LOAD THE MODULE JSB INCAD UPDATE \PREL AND PBREL JMP SSGAL THEN GO FIND NEXT * SETCM JSB NOTST TEST FOR PROGRAMS LOADED * * * SET UP THE REAL TIME COMMON AREA * JSB \SPAC LDA \PREL COMPUTE MAX SIZE BY STA RTCAD SUBTRACTING CURRENT CMA LOCATION FROM ADA M3777 LAST ALLOWED (APPROX. 37777) STA TEMP2 SAVE AS THE LIMIT * CLB LDA COMRT CMA ASK IF THEN JSB CHBND WANT TO DEF MES53 CHANGE THE SIZE DEF TEMP2 OF RT COMMON STA COMRT SAVE IT * LDA RTCAD LOAD STARTING ADDRESS LDB MES14+1 OF RT COMMON JSB \CONV AND STUFF IN MESSAGE LDA P20 LDB MES14 JSB \MESS AND PRINT IT JSB \SPAC SPC 1 * * SET UP BG COMMON * LDA COMRT SAVE BASE ADA \PREL ADDRESS OF STA BGCAD BG COMMON * ADA COMBG BUMP TO END OF DECLARED ADA N1 IOR M1777 ROUND TO END OF PAGE STA TEMP2 SAVE TEMPORARILY LDB BGCAD GET FWA BG COMMON CMB,INB AND SUBTRACT ADA B IN ORDER TO GET DEFAULTED INA SIZE STA COMBG AND SAVE NEW SIZE * LDB TEMP2 GET LAST WORD ADDRES CMB,INB AND SUBTRACT FROM LAST ADB M3777 ALLOWED ADDRESS STB TEMP2 AND SAVE AS UPPER LIMIT * CMA CLB,INB ASK IF THEY JSB CHBND WANT TO DEF MES57 CHANGE THE DEF TEMP2 SIZE OF BG COMMON * ADA COMBG UPDATE BG COMMON SIZE STA COMBG BY THAT SIZE * LDA BGCAD LOAD STARTING ADDR LDB MES18+1 OF BG COMMON JSB \CONV AND STUFF IN LDA P20 MESSAGE LDB MES18 JSB \MESS PRINT IT * LDA COMBG LOAD NEW SIZE OF BG CMyA,INA COMMON AND LDB MES62+1 STUFF IN MESSAGE JSB \CONV (DECIMAL) LDA P16 LDB MES62 JSB \MESS AND PRINT IT JSB \SPAC * * WRITE HALTS ON DISK FOR RT AND BG COMMON AREAS * LDA COMRT GET TOTAL ADA COMBG COMMON SIZE LDB \PREL GET RELOC BASE SZA,RSS JMP NOCOM JUMP IF NO COMMON * CMA,INA SET LOOP COUNTER STA TCNT TO -(LENGTH OF COMMON) WTCOM LDA HLT0 GET HALT 0 VALUE JSB \ABDO WRITE ONE ISZ TCNT HALT AT A TIME JMP WTCOM UNTIL DONE * STB \PREL UPDATE RELOC BASE FOR SDA NOCOM STB FWSDA SAVE START ADDRESS OF SDA * SKP * * LOAD SYSTEM DRIVER AREA * SPC 1 CLA SET TO SCAN FOR STA \PTYP TYPE 0 MODULES LDA P18 PRINT HEADING LDB MES63 JSB SETHD AND INIT FOR LOADING * SDAL JSB SCDRV GET NEXT DRIVER JMP SYSTB END OF IDENTS JMP SDAL A PRD - GO GET NEXT DRIVER LDA \ID3,I PICK UP CLB,INB USAGE FLAG IOR B AND SET STA \ID3,I LOADED BIT * JSB \LODN LOAD THE MODULE JSB INCAD UPDATE PBREL & \PREL JMP SDAL PROCESS NEXT DRIVER SPC 1 * * RESERVE SPACE AND SET UP SYSTEM TABLES * IN TABLE AREA II. * SYSTB JSB NOTST TEST FOR PROGRAMS LOADED JSB \SYTB GO DO IT IN SEG 5 SPC 1 * * LOAD TABLE AREA II MODULES * LDA P13 SET MODULE TYPE STA \PTYP LODII JSB IDSCN SCAN IDENTS JMP ENDII END OF IDENTS LDB \ID3,I GET USAGE FLAG SLB,INB SKIP IF UNLOADED JMP LODII IGNORE LOADED PROGRAMS * JSB \LODN INITIATE AND LOAD THE PROGRAM JSB INCAD UPDATE \PREL & PBREL JMP LODII PROCESS NEXT TA.II MODULE * ENDII JSB NOTST TEST FOR PROGRAMS LOADED * CCA GET LAST WORD USED BY ADA \PREL TABLE AREA II MODULES IOR M1777 AND ROUND TO END OF PAGE INA GET FIRST WORD ADDRESS OF NEXT PAGE STA FWPRV AND SAVE AS PRIV LOAD PT SKP * INITIALIZE FOR SYSTEM LOADING * LDA PBREL SAVE LAST(LOWEST) INA BP LINK USED STA LOLNK IN TABLE AREAS, ETC STA BPLMT AND USE A UPPER LIMIT FOR SYSTEM LINKS * CLA,INA RESET THE ALLOCATION OF LINKS UPWARD STA BPINC LDA FSYBP STARTING AT STA PBREL LOCATION 100 * CLA CLEAR THE HIGH BASE PAGE LINK STA HIBP REQUEST FOR NEW FIXUP ENTRIES * LDA \CBPA RESET THE CP LINK ARE POINTERS STA \CPL2 TO 'EMPTY': LAST CP AREA=LAST BP AREA STA CPLS LAST 'SAVE' CP AREA=LAST BP AREA * * LOAD SYSTEM MODULES * JSB \SPAC LDA \PREL GET STARTING RELOCATION STA FWSYS ADDRESS AND SAVE LDA P6 LDB MES12 PRINT: SYSTEM JSB SETHD AND INITIALIZE IDX CLA STA \PTYP SET TO SCAN SYSTEM MODULES * SYLD JSB IDSCN SCAN IDENTS FOR TYPE 0 MODULES JMP SYEND END OF IDENTS LDB \ID8,I CHECK IF AN EQT WAS DEFINED SSB FOR THIS MODULE, IN WHICH CASE JMP SYLD IT'S A DRIVER SO DON'T LOAD HERE LDB \ID3,I GET USAGE FLAG SLB,INB SKIP IF UNUSED JMP SYLD IGNORE USED PROGRAM * STB \ID3,I SET WORD 3 WITH USAGE FLAG JSB \LODN INITIATE & LOAD PROGRAM JSB INCAD UPDATE \PREL & PBREL JMP SYLD PROCESS NEXT SYSTEM PROGRAM * SYEND JSB NOTST TEST FOR PROGRAMS LOADED * CCA SET LAST WORD ADA \PREL USED BY SYSTEM STA LWSYS CODE JSB CPAG# CONVERT TO A PAGE # AND M37 AND SET AS LAST USED BY SYSTEM STA LPSYS AND SAVE SKP * * _NLHHN* LOAD SLOW BOOT, AND SET LWSLB - MUST BE <= 77577, * OR ELSE ABORT. * * LDB DCNFG GET BUFFER ADDRESS OF $CNFG JSB \IDXS NOW GO FIND ENTRY JMP ER57 NOT THERE - NO GOOD FOR YOU LDB \ID3,I SET USAGE FLAG INB IN WORD 3 STB \ID3,I TO INDICATE LOADED JSB \LODN NOW LOAD THE MODULE JSB INCAD UPDATE \PREL AND PBREL LDA \PREL CHECK FOR OVERFLOW CMA,INA ADA M7757 PAST 77577 SSA,RSS JMP NOVF NO OVERFLOW * LDA ERR18 YES, MUST ABORT JSB \IRER ISSUE DIAGNOSTIC & ABORT * ER57 LDA ERR57 SEND ERROR DIAGNOSTIC JSB \GNER INDICATING A MISSING SYSTEM MODULE LDA P5 NOW SEND THE MODULE LDB DCNFG NAME TOO JSB \MESS JSB \TERM ABORT THEM NOW ERR57 ASC 1,57 DCNFG DEF *+1 ASC 3,$CNFG * * NOVF CCA ADA \PREL STA LWSLB SAVE LAST USED ADDRESS STA B SAVE FOR CHECK IOR M1777 ROUND TO END OF CURRENT CPA B PAGE - ANY CHANGE AT ALL? CLB,RSS IF NOT, THEN DON'T ZERO-FILL STA B JSB CPAG# GET THE PAGE # AND M37 STA LPSLB AND SAVE IT TOO! CLA MIGHT AS WELL SZB SKIP IF NO EXTRA WORDS ADDED TO ZERO JSB \ABDO ZERO-FILL THE REMAINDER * * INITIALIZE LOCATIONS 2 AND 3 IN THE BASE PAGE SO $STRT * WILL BE ENTERED FROM BOOT-UP * LDB D$STR GET THE LST ENTRY FOR $STRT JSB \LSTS GO FIND IT JSB \ABOR OH-OH, TOO BAD! LDB \ADBP GET ADDRESS FOR THE JMP,I START ADB P2 LDA JMP3I GET JMP 3,I CODE STA B,I AND SET IN BP LOCATION 2 INB INCREMENT TO BP LOCATION 3 LDA \LST5,I GET ADDRES OF $STRT STA B,I AND SET IN 3 * * * DUMP SYSTEM LINKS (AND TRAP CELLS) FROM THE LOW PART OF * BASE PAGE TO DISK, AND CLEAR THAT IMAGE AREA. THE PRD'S * AND ALL MEMORY AND DISK RESIDENT PROGRAMS CANNOT SHARE * (OR SEE) ANY LINKS BELOW HILNK ('HIGHEST SYSTEM LINK') * ANYHOW, SO THEY ARE NOT NEEDED IN THE GENERATER ANY LONGER. * THE AREA WILL BE USED FOR MEMORY AND DISK RESIDENT PROGRAM * LINKS. * LDA \ADSK SAVE THE CURRENT DISK ADDRESS STA TEMP4 LDA DSKBP BACK UP THE DISK ADDR TO THE STA \ADSK START OF THE SYSTEM BP * CLB START AT LOW ADDR AND LDA PBREL CONTINUE UP TO LAST SYS LINK JSB BPOUT AND WRITE THE LINKS THERE * LDA TEMP4 RESTORE THE STA \ADSK DISK ADDRESS * LDA P2 CLEAR BP IMAGE OF SYSTEM LDB PBREL LINKS, STARTING AT JSB CLRLT 2 * * * LOAD PARTITION-RESIDENT DRIVERS INTO DP'S #2 ONWARD * CLA SIGNAL \\LDP WHICH DP MODE JSB \CLDP NOW LOAD 'EM ALL JSB NOTST TEST FOR PROGRAMS LOADED SKP * * INITIALIZE FOR MEMORY RESIDENT LIBRARY & PROGRAM LOADING * LDA PBREL SAVE THE LOWEST INA BP LINK USED STA LOLNK BY THE PRD'S STA BPLMT AND AS UPPER LIMIT FROM NOW ON * * SET THE SYSTEM BASE PAGE SCAN AREA TO INCLUDE ONLY THE * UPPER PORTION OF BASE PAGE CONTAINING TABLE AREA, SSGA, * AND DRIVER LINKS. * STA \LRBP SAVE LOWEST DRIVER LINK AS LOWEST ADA \ADBP SYSTEM LINK, AND STA \IRBP SAVE THE RT4GN IMAGE ADDRESS LDA LWSBP SET LAST LINK BEFORE SCOM, +1 STA \URBP AS LAST SYSTEM LINK * CLA RESET FLAGS STA SDID STA HIBP CLEAR AGAIN * * CLEAR THE FIXUP TABLE HERE * STA \PFIX ALL REMAINING UNDEFS ARE LOST * INA SET THE BP LINK ALLOCATION STA BPINC UPWARDS INA STA PBREL FROM LOCATION 2 * * SET UP THE CURRENT PROGRAM'S BASE PAGE SCAN AREA * STA \C:UBP SET LOWEST MEM RES LINK AT 2 ADA \ADBP AND SET ITS RT4GN STA \ICBP IMAGE ADDRESS LDA LOLNK SET THE LAST AVAILABLE MEM RES LINK,+1 STA \UCBP AS LOWEST (UPPER) SYSTEM LINK * LDA \CBPA CLEAR THE STA \CPL2 CURRENT PAGE STA CPLS LINK AREAS * * DETERMINE MEMORY RESIDENT LIBRARY LOAD POINT * LDB \MRT2 ARE MEMORY RESIDENTS TO SZB ACCESS TABLE AREA II? JMP MYES YES, SET LOAD ADDRESS LDA FWSDA GET FIRST WORD OF SDA LDB MRACM DID ANY MR DECLARE ACCESS TO COMMON/SSGA? SZB,RSS LDA LWDP1 NO, SET LOAD ADDRESS TO COMMON START JMP SETP YES,SET LOAD PT TO SAME AS SDA * MYES LDA FWPRV OTHERWISE GET PRIV LOAD POINT SETP STA \PREL SET RELOCATION ADDRESS STA LBCAD AND FIRST WORD OF MEMORY RES LIBRARY JSB DSKEV START MRL ON AN EVEN SECTOR BOUNDARY STA DSKMR AND SAVE THE ADDRESS JSB \USRS INITIALIZE THE \ABDO SPEC'S * CCA SET LIB FLAG TO SHOW LIB LOADING STA LIBFG SO ONLY TYPE 6 PROGRAMS WILL LOAD JSB CLRT6 GO CLEAR LOAD FLAGS FOR TYPE 6 PGMS * * LOAD LIBRARY * LDA P14 SET TO GET RESIDENT LIB. ROUTINES STA \PTYP LDA P24 LDB MES13 MES13 = ADDR: MEMORY RESIDENT LIBRARY JSB SETHD PRINT HEADING, INITIALIZE IDX LDLB JSB IDSCN SCAN IDENTS JMP LBEND END OF IDENTS LDB \ID3,I GET USAGE FLAG SLB,INB SKIP IF UNUSED LIBRARY ROUTINE JMP LDLB IGNORE USED PROGRAM * LDA P14 IF THIS IS A FOURCE LOAD CPA \PTYP THEN STB \ID3,I SET THE LOADED FLAG JSB \LODN INITIATE AND \LODN MAIN PROGRAM JSB INCAD UPDATE BP, PROG RELOC ADDR JMP LDLB PROCESS NEXT LIBRARY PROGRAM * LBEND CLA,INA DID WE FINISH LOADING LIB FOR CPA \PTYP RESIDEN T?? JMP COMTS YES, CONTINUE...... STA \PTYP NO, SET UP LDA M7 THE SCAN STA \TMSK MASK LDA P10 AND RESET STA CIDNT THE LST POINTERS JMP LDLB AND RESTART SPC 1 COMTS JSB NOTST PRINT "NONE" IF NO LIB JSB \SPAC SKIP A LINE SPC 1 * CLEAN UP AFTER LOADING LIBRARY SPC 1 CLA CLEAR THE STA LIBFG "LIBRARY LOADING" FLAG * * ZERO-FILL THE LAST PAGE CONTAINING THE MEMORY RESIDENT LIBRARY * IN ORDER TO START THE MEMORY RESIDENT PROGRAM AREA ON A PAGE * BOUNDARY. * CCA GET THE LAST WORD OCCUPIED ADA \PREL BY THE MRL, AND ROUND STA LEND IOR M1777 IT UP TO A PAGE INA BOUNDARY STA \PREL SAVE AS RELOCATION ADDRESS OF STA FWMRP THE MEMORY RESIDENT PROGRAM AREA * LDB LBCAD GET THE STARTING ADDR OF THE CMB,INB MRL, AND COMPUTE ITS SIZE ADA B (INCLUDING THE ZERO-FILL) JSB CPAG# CONVERT TO # PAGES ADA FPMBP ADD TO THE MRBP PAGE # INA ADD MRBP SIZE STA FPMRP AND SET FIRST PAGE OF MEM RES PROGRAMS SPC 1 * RESET CP LINK AREA POINTERS SPC 1 LDA \CBPA STA \CPL2 LAST CP AREA=LAST BP AREA STA CPLS LAST "SAVE" CP AREA=LAST BP AREA SKP * * LOAD MEMORY RESIDENT PROGRAMS * RRLDD LDA P16 LDB MES15 MES15 = ADDR: MEM RESIDENTS JSB SETHD PRINT HEADING, INITIALIZE IDX RRLD JSB IDSCN SCAN IDENTS JMP RREND END OF IDENTS SEZ,RSS SKIP IF MAIN JMP RRLD IGNORE SUB LDB \ID3,I GET USAGE FLAG SLB,INB SKIP - PROGRAM NOT LOADED JMP RRLD IGNORE LOADED PROGRAM * STB \ID3,I SET NEW USAGE FLAG JSB \USER RESET THE \ABDO MAP TO MEM RES SPEC'S JSB \LODN INITIATE AND LOAD MAIN PROGRAM * JSB \SYS RESET TO SYSTEM MAP TO CLA JSB GENID GENERATE ID SEGMENT, KEYWORD CLA NO PARTITION REQMT CCB ADB \TIDN IDENT INDEX (\TIDN POINTS TO NEXT ENTRY) JSB IDFIX GO SET MEM PROTECT INDEX NOP ERROR RTN NOT POSSIBLE HERE JSB INCAD UPDATE BP, PROG RELOC ADDR JMP RRLD PROCESS NEXT RT RESIDENT * RREND JSB NOTST TEST FOR PROGRAMS LOADED JSB \SPAC NEW LINE JSB CCPLK PACK THE CURRENT PAGE LINKAGE AREA JSB BPDSA OUTPUT REMAINDER OF RECORD * * * DUMP THE MEMORY RESIDENT BASE PAGE TO DISK * STA DSKMB SAVE THE BASE PAGE DISK ADDRESS LDB P2 START AT LOW ADDRESS LDA PBREL AND DUMP ALL THE MEMORY JSB BPOUT RESIDENT LINKS ALLOCATED * * COMPUTE THE NUMBER OF PAGES OCCUPIED BY THE MEMORY RESIDENT * LIBRARY AND MEMORY RESIDENT PROGAMS. * CCA GET THE LAST WORD OCCUPIED BY ADA \PREL THE MEMORY RESIDENT PROGRAM AREA STA EMRP IOR M1777 AND ROUND IT TO A PAGE INA BOUNDARY (IE,ZERO-FILL) LDB LBCAD GET THE STARTING ADDRESS OF THE CMB,INB MEMORY RES LIBRARY, AND COMPUTE ADA B THE ENTIRE MEMORY RESIDENT SIZE JSB CPAG# CONVERT TO # PAGES STA MRP# AND SAVE THE # PAGES OCCUPIED BY MEM RES ADA FPMBP ADD TO PAGE # OF MRBP INA ADD SIZE OF MRBP STA PAGE# AND SAVE THE NEXT PHYSICAL PAGE # * CMA,INA DETERMINE IF THERE EXISTS ADA \NUMP ENOUGH MEMORY PAGES FOR THE SSA,RSS MEMORY RESIDENT AREA JMP IRTDR INIT FOR RT DISK RESIDENTS * LDA ERR61 JSB \IRER ISSUE DIAGNOSTIC & TERMINATE ERR61 ASC 1,61 SKP * * INITIALIZE FOR REAL TIME DISK RESIDENT LOADING * IRTDR LDA P2 STA \PTYP SET TO FIND TYPE 2 PROGS STA MTYPE * JS$PB DEMTL DEMOTE ALL TYPE 6 AND 14 PROGS TO TYPE 7 * * SET BPLINK SCAN AREA FOR CURRENT PROGRAM AND BOUNDS * FOR BP LINK ALLOCATION. NOTE THAT THAT BP LINK ALLOCATION * REMAINS SET IN THE "UPWARD" DIRECTION FROM MEM RESIDENT * LOADING, AND LIMIT IS STILL LOLNK. SPC 1 LDA P2 SET LOWEST DISK LINK STA PBREL STARTING AT 2 STA \CUBP ADA \ADBP AND SAVE ITS IMAGE STA \ICBP ADDRESS. LDB LOLNK SET UPPER DISK LINK AS STB \UCBP BELOW SYS,LIB, AND SSGA LNKS * * CLEAR BASE PAGE IMAGE OF MEMORY RESIDENT PROGRAM LINKS SPC 1 LDA PBREL START CLEAR AT 2 & END BEFORE LOLNK JSB CLRLT AND GO DO IT SPC 1 * RESET CP LINK AREA POINTERS TO "EMPTY" SPC 1 LDA \CBPA STA \CPL2 LAST CP AREA=LAST BP AREA STA CPLS LAST "SAVE" CP AREA=LAST BP AREA STA \CPLB (FOR PACK),AND FOR SEGMENT LOADING JMP RDLD SKIP RESETTING OF TYPE/HEADING FOR BG * TEMP3 NOP TEMP4 NOP SKP * * LOAD RT & BG DISK RESIDENTS * SETBG LDA P3 SET BG PROGRAM TYPE LDB "BG" AND HEADING TYPE STB MS16 SAVE BG IN HEADING STA \PTYP BG DISK RESIDENT STA MTYPE RDLD LDA P17 LDB MES16 MES20 = ADDR: XX DISK RESIDENTS JSB SETHD PRINT HEADING INITIALIZE IDX BDLD JSB DSKEV LOAD DISC RESIDENTS ON EVEN SECTOR STA EMDSK SAVE IN CASE AN EMA PROG CLA KILL ANY LEFT OVER FIX UPS STA \PFIX STA SDID CLEAR SEGMENT COUNTER JSB IDSCN SCAN IDENTS JMP BDEND END OF IDENTS SEZ,RSS SKIP IF MAIN JMP BDLD IGNORE SUBS LDB \ID3,I GET USAGE FLAG SLB,INB SKIP - PROGRAM NOT LOADED JMP BDLD IGNORE LOADED PROGRAM * * INITIALIZE FOR LOADING * STB \ID3,I SET NEW USAGE FLAG CCA STA EMLNK p CLEAR EMA INDICATORS STA EMLST ADA \TIDN GET CURRENT MAIN IDENT INDEX STA IDSAV SAVE MAIN IDENT INDEX FOR BS REF * LDA \PTYP GET CURRENT PROGRAM TYPE CPA P2 RSS CPA P3 ARE WE SETTING THE LOAD PT FOR JSB SETPV RT/BG PRIVILEGED PROGRAMS JSB SETRB OR BG PROGRAMS JSB \USRS SET UP A NEW USER JSB \LODN INITIATE AND \LODN MAIN PROGRAM * * BUILD ID SEGMENT, SEND LINKS TO DISK * JSB \SYS RESET TO SYSTEM MAP CCA JSB GENID GENERATE ID SEGMENT, KEYWORD JSB BPDSA OUTPUT REMAINDER OF RECORD LDA \ADSK GET CURRENT DISK ADDRESS STA DSKBS SAVE DISK ADDR OF BP SECTION LDA TBREL GET UPPER BP ADDRESS LDB PBREL GET LOWER BP ADDRESS JSB BPOUT OUTPUT BP SECTION LDA TPREL GET CURRENT PROG RELOC ADDR STA BSPAD SAVE PROG RELOC ADDR FOR BS STA TPMAX SET HWM FOR MAIN JSB CCPLK PACK THE CP LINK AREA LDA \CPL2 UP DATE STA CPLS THE LOW SAVE ADDRESS * LDA TBREL GET CURRENT BP RELOC ADDR STA BSBAD SAVE BP RELOC ADDR FOR BS * * SEARCH FOR THE PROGRAM'S SEGMENTS * LDA P5 STA \PTYP SET TYPE = BG SEGMENT JSB \INID INITIALIZE IDX BSLD JSB \IDX SET IDENT ADDRESSES JMP BSEND END OF IDENTS CCA ADA \TIDN GET CURRENT MAIN IDENT INDEX STA IMAIN SAVE MAIN BS IDENT INDEX LDA \ID4,I GET M OR S SSA,RSS SKIP IF MAIN BG SEGMENT JMP BSLD IGNORE SUBS LDA \ID6,I GET TYPE AND M37 ISOLATE TYPE CPA P5 TYPE = BG SEGMENT? RSS YES - CONTINUE JMP BSLD NO - IGNORE IDENT * LDA \ID8,I GET BS MAIN \IDENT INDEX CPA IDSAV BS CALLS THIS BG MAIN? RSS YES - CONTINUE JMP BSLD NO - IGNORE BACKGROUND SEGMENT 4 LDA \TIDN GET NEXT IDENT INDEX STA ABSID SAVE INDX FOR NEXT BG SEG SCAN CCB STB HDFLG SET HEADING FLAG FOR BG SEGMENT JSB DSKEV SET FOR EVEN SECTOR JSB \SEGS SET UP A NEW USER AREA LDA BSPAD RESET THE LDB \ABCO STA B,I BASE CORE ADDRESSES FOR LDB \MXAB STA B,I A SEGMENT LOAD JSB \LODN LOAD BG SEGMENT * LDA CPLS RESET THE CP LINK STA \CPL2 BOTTOM JSB \SYS RESET TO SYSTEM MAP JSB \SPAC NEW LINE CCA JSB GNSID GENERATE ID SEGMENT, KEYWORD JSB BPDSA OUTPUT REMAINING OF ABS REC * LDB TPREL SUBTRACT SEG'S HIGH ADDR LDA B FROM PREV MAX CMA,INA HIGH ADDR ADA TPMAX SSA IF NEW IS HIGHER STB TPMAX THEN STORE AS MAX * ISZ SDID SET SEGMENT FLAG FOR IDFIX LDA TBREL GET UPPER BP ADDRESS LDB BSBAD GET LOWER BS BP ADDRESS JSB BPOUT OUTPUT BP SECTION LDA BSBAD GET BS BP RELOC ADDR LDB TBREL GET UPPER BOUND BP ADDRESS JSB CLRLT CLEAR BP LINKAGES LDA BSBAD GET BS BP RELOC ADDRESS STA TBREL SET BP RELOC ADDR LDA BSPAD GET BS PROG RELOC ADDRESS STA TPREL SET PROG RELOC ADDR LDA ABSID GET NEXT BG SEG IDENT INDEX STA \TIDN SET IDENT INDEX FOR IDX JMP BSLD LOAD NEXT BG SEGMENT * * * FIX ID SEGMENT OF MAIN * BSEND LDA TPMAX PASS MAX HIGH ADDR LDB \PREL AND LOW ADDR, THEN JSB PGREQ SET A-REG LDB IDSAV PASS PAGE REQMT & IDENT JSB IDFIX INDEX THEN FIX iD SEG. JMP CLBPL ERROR RETURN ON EMA'S * * UPDATE BP LINKS (IE, EMA) * LDA \ADSK GET CURRENT DISK ADDRESS STA DSKBR SAVE CURRENT DISK ADDR OF ABS LDA DSKBS GET DISK ADDR FOR MAIN BP CODE STA \ADSK SET CURRENT BP CODE ADDRESS LDA BSBAD GET UPPER ADDR OF BP CODE LDB PBREL GET LOW ADDR FOR BP CODE JSB BPOUT OUTPUT BP CODE FOR MAIN DISK RES LDA DSKBR GET CURRENT DISK ADDRESS STA \ADSK SET CURRENT ABS DISK ADDRESS CLBPL LDA PBREL GET LOW BP ADDRESS LDB BSBAD GET UPPER BOUND BP CODE JSB CLRLT CLEAR BP LINKAGES * LDA MTYPE RESET THE MAIN PROGRAM TYPE STA \PTYP SET PROG TYPE = XX DISK RESIDENT JSB CLID3 CLEAR PROGS-LOADED FLAGS LDA IDSAV GET MAIN IDENT INDEX STA \TIDN SET CURRENT IDENT INDEX LDA \CPLB RESET THE LOW SAVE ADDRESS STA CPLS RESET FOR BG MAIN STA \CPL2 PROGRAMS JMP BDLD LOAD NEXT BG DISK RESIDENT * BDEND LDA \PTYP CPA P4 RSS JSB NOTST TEST FOR PROGRAMS LOADED JSB \SPAC NEW LINE LDA \PTYP SET PROPER HEADING AND TYPE CPA P4 IF PRIVILEGED PROGRAMS WERE JUST JMP PD DONE, THEN MOVE ON CPA P2 IF REAL-TIMES WERE JMP SETBG JUST DONE, THEN GO SET FOR BG'S INA ELSE SET FOR TYPE 4 BG'S STA \PTYP SET CURRENT PROGRAM TYPE STA MTYPE CCA STA LFLAG SET PROGRAMS-LOADED-FLAG TO -1 LDA P10 START IDENT TABLE SCAN STA CIDNT BACK TO BEGINNING JMP BDLD AND PERFORM NEXT PASS SKP * * PERFORM PARTITION DEFINITION, FOLLOWED BY STORING THE DISK * RESIDENT LIBRARY AND LIBRARY ENTRY POINTS LIST ON DISK * PD JSB \PART PARTITION DEFINITION PHASE * JSB BPDSA OUTPUT REMAINDER OF LIBR LIST JSB \SYS BACK TO THE SYSTEM MAP SKP * * GENERATE BLANK ID SEGMENTS * ENDBI LDA CURAK MORE BLANK ID'S? CPA \ASKY ? JMP ENDRL NO HOW ABOUT SHORT ONES? * LDA N2 YES GENERATE A JSB GENID BLANK ID SEGMENT JMP ENDBI NEED ANOTHXER? * ENDRL LDA \SKYA IF NEXT KEYWORD IS INA CPA IDSAD THEN TERMINATE JMP ENDSZ BLANK OUTPUT. * LDA N2 A=-2 FOR BLANK ID SEGMENT FLAG. JSB GNSID GENERATE ID SEGMENT. JMP ENDRL REPEAT TEST. * * PUT OUT DISK DICTIONARY ENDSZ LDA \ADSK GET CURRENT DISC ADDRESS. ALF,ALF ROTATE DISK TRACK NO. TO LOW A RAL ISOLATE AND M377 TRACK NUMBER. ADA P2 SET A = NUMBER OF USED TRACKS STA CURAT SAVE NO. OF USED TRACKS CMA,INA STA TCNT SET TRACK USAGE COUNT CLA STA \TBUF CLEAR \TBUF LDA ADICT SET THE TAT ADDRESS STA CURAI FOR OUTID SYSTR LDA MSIGN SET FLAG FOR SYSTEM-USED TRACK JSB OUTID OUTPUT TRACK-USED FLAG ISZ TCNT STEP THE COUNT JMP SYSTR MORE TO DO CONTINUE * USRTR JSB REMDO FLUSH FINAL SECTOR FROM DBUF SKP * * CLEAR SYSTEM COMMUNICATION AREA * * THIS OVERLAYS 133 OCTAL WORDS * BELOW THE LABEL "USRTR". * LDA FWCMM GET ADDR OF SYS COMM AREA LDB NLCOM GET NEG. LENGTH OF COMM AREA STB WDCNT SET COUNT FOR CLEARING BP AREA CLB STB A,I CLEAR BP COMM AREA WORD INA ISZ WDCNT SKIP - AREA CLEARED JMP *-3 CONTINUE CLEARING BP AREA * * LDA AEQT 1650 - SET ADDRESS OF EQT'S STA EQTA GET ADDRESS OF EQT * LDA CEQT 1651 - SET NUMBER OF EQT'S STA EQT# SET NO. OF EQT ENTRIES * LDA ASQT 1652 - SET ADDRESS OF DRT STA DRT SET ADDR OF DEV REF TABLE * LDA CSQT 1653 - SET NUMBER OF DRT ENTRIES STA LUMAX SET NO. OF DEV REF TABLE ENTRIES * LDA AINT 1654 - SET ADDRESS OF INT STA INTBA SET ADDR OF INTERRUPT TABLE * LDA M72 1655 - SET NUMBER FOF INT ENTRIES STA INTLG SET NO. OF INT ENTRIES * LDA ADICT 1656 - SET ADDRESS OF TRACK ALLOCATION TABLE STA TAT SET ADDR OF TAT * LDA KEYAD 1657 - SET ADDRESS OF KEYWORD TABLE STA KEYWD SET ADDR OF KEYWORD LIST * LDA \TBCH 1674 - SET SELECT CODE OF TBG STA TBG SET I/O ADDR FOR TBG * LDA TTYCH 1675 - SET EQT ADDRESS OF SYSTEM CONSOLE STA SYSTY SET EQT ADDR FOR SYS TELETYPE * LDB SCH4 1711 - SET ID SEGMENT ADDRESS, OR ZERO STB SKEDD IN SCHEDULED LIST * LDA \SWPF 1736 - SET SWAPPING FLAG STA SWAP SET SWAPPING FLAG * LDA \PIOC 1737 - SET ADDRESS OF PRIVILEGED STA DUMMY I/O CARD * LDA DSKSY 1740 - SET DISC ADDRESS OF STA IDSDA FIRST ID SEGMENT * LDA IDSP 1741 - SET POSITION OF FIRST STA IDSDP ID SEGMENT IN SECTOR * LDA P2 1742 - SET FIRST LINK FOR STA BPA1 RT DR'S STA BPA3 BG/PR DR'S (1744) * CCA 1743 - AND SAVE LOWEST ADA LOLNK DRIVER LINK AS LAST STA BPA2 DR LINK * LDA LBCAD 1745 - SET ADDRESS STA LBORG OF MEMORY RESIDENT LIBRARY * LDA RTCAD 1746 - SET REAL TIME COMMON ADDRESS STA RTORG SET RT COM ADDRESS * LDA COMRT 1747 - SET REAL TIME COMMON LENGTH STA RTCOM SET RT COM LENGTH * LDA BGCAD 1752 - SET BG COMMON ADDRESS STA BKORG * LDA COMBG 1753 - SET BACKGROUND COMMON STA BKCOM LENGTH * LDA LWASM 1777 - SET LAST WORD MEMORY STA BKLWA ADDRESS OF BG PARTITION * LDA P96 1757 - SET # OF SECTORS PER TRACK FOR STA SECT2 SYSTEM DISC (LU #2). * LDA ADS# 1760 - SET # OF SECTORS PER TRACK FOR STA SECT3 AUXILIARY DISC (LU #3). * LDA DSKLB 1761 - SET DISK ADDRESS OF LIBRARY 2STA DSCLB ENTRY POINTS LIST * LDA LBCNT 1762 - SET NUMBER OF USER-AVAILABLE STA DSCLN ENTRY POINTS IN LIB ENTRY PT LIST * LDA DSKUT 1763 - SET DISK ADDRESS OF RELOCATABLE STA DSCUT DISK RESIDENT LIBRARY * LDA SYCNT 1764 - SET NUMBER OF SYSTEM ENTRY STA SYSLN POINTS IN LIB ENTRY PT LIST * LDA DSIZE 1755 - SET NEGATIVE TAT LENGTH ADA DAUXN CMA,INA STA TATLG SET TOTAL DISK TABLE LENGTH * LDA DSIZE 1756 - SET SYSTEM DISC SIZE STA TATSD * LDA LWSYS INITIALIZE SYSTEM AVAILBLE MEMORY MAP: INA STA EQT1 ADDRESS OF SAM #1 LDB SAM#1 STB EQT2 SIZE OF SAM #1 ADA B STA EQT3 ADDRESS OF SAM #2 LDB SAM#2 STB EQT4 SIZE SAM #2 LDA LWTAI GET LAST WORD ADDRESS OF TABLE AREA I INA AND SET STARTING ADDRESS OF SAM#0 STA EQT5 CMA,INA COMPUTE SIZE BY SUBTRACTING ADA DPADD FROM START OF DRIVER PARTITION STA EQT6 AND SET * LDA NLCOM SET UP # WORDS. CMA,INA STA TEMP1 LDA FWCMM MOVE THE SYS COM LDB \ADBP AREA ADB LWSBP TO THE MVW TEMP1 THE DUMMY BASE PAGE SPC 2 * PUT OUT BASE PAGE * JSB DSKEV GET NEXT EVEN SECTOR ADDRESS STA DSKAV SAVE NEXT AVAILABLE DISK ADDR SPC 2 * WRITE UPPER PART OF SYSTEM BASE PAGE TO DISK. * * THE PORTION OF THE BASE PAGE CONTAINING SYSTEM * LINKS WAS ALREADY WRITTEN OUT. * SINCE WE PROBABLY ENDED THE LOWER PORTION IN * THE MIDST OF A SECTOR, IT IS MOST CONVENIENT TO * WRITE THE REMAINDER OF THE B.P. USING \ABDO, A * WORD AT A TIME, TO INSURE THAT NEW WORDS ARE * MERGED INTO THE APPROPRIATE POSITIONS ON DISK. * * WE TELL \ABDO WE ARE WRITING PAGE 1 WORDS VICE * PAGE 0 SINCE \ABDO WAS DESIGNED TO VECTOR ALL BASE * PAGE REFERENCES INmNLHTO THE IN-CORE "DUMMY BASE PAGE" gN* INSTEAD OF THE DISK. SPC 1 LDA DSKBP GET STARTING SECTOR OF SBP STA \DSYS+3 AND SAVE IN \ABDO MAP. LDA M2000 ****SET BASE CORE ADDR STA \DSYS+1 IN MAP. LDA M4000 AND SET MAX CORE ADDR SEEN STA \DSYS+2 IN MAP. JSB \SYS INITIALIZE THE MAP LDA LOLNK SAVE CORE ADDRESS OF LOWEST ADA \ADBP DRIVER LINK IN TEMPORARY. STA TEMP5 LDB LOLNK CONVERT TARGET BP ADDR TO PAGE 1 ADB M2000 ADDR TO FAKE OUT \ABDO. SPC 1 BLOOP LDA TEMP5,I PICK UP NEXT BP WORD AND JSB \ABDO WRITE TO DISK, INCREMENTING B ISZ TEMP5 REG (TARGET) AND TERMP5 CPB M4000 (SOURCE) EACH TIME UNTIL JMP BPEND END OF PAGE IS PASSED JMP BLOOP (TARGET ADDR = PAGE 2) SPC 1 TEMP5 BSS 1 LOCAL TEMPORARY SPC 1 BPEND LDA \OLDA FLUSH THE \ABDO BUFFER LDB \ADBF TO THE JSB \DSKO DISC JSB \FSEC FLUSH THE FINAL SECTOR SKP * * GENERATION COMPLETE. PERFORM CLEAN-UP. * JSB \SPAC LDA P22 LDB MES23 MES23 = ADDR: *SYSTEM STORED ETC JSB \MESS PRINT: SYSTEM STORED ON DISK * LDA DSKAV CONVERT ALF,ALF LAST RAL USED AND M377 DISC CMA LDB ATBUF ADDRESS (TRACK #) TO DECIMAL JSB \CONV AND LDA \TBUF+2 STORE STA MES38+6 IN MESSAGE. LDA DSKAV CONVERT AND M177 SECTOR ARS CONVERT TO 128 WORD SECTORS CMA,INA (DECIMAL) LDB ATBUF # JSB \CONV AND LDA \TBUF+2 STORE STA MES38+11 IN LDA \TBUF+1 MESSAGE AND M377 ISOLATE 3RD DIGIT, IOR UBLNK ADD UPPER BLANK. STA MES38+10 LDA P28 PRINT MESSAGE: LDB MES38 "SYS SIZE: JSB \MESS TRK XX SEC XXX(10)" JSB n\SPAC * * LDA DSKAV FORCE ACESS TO LAST RECORD LDB \ADBF SO TRUNCATE WILL WORK. JSB \DSKI JSB \TRUN CLOSE CORE-IMAGE FILE. * JMP \EXIT DO FINAL CLEANUP * * M4000 OCT 4000 M377 OCT 377 M72 OCT 72 P16 DEC 16 P96 DEC 96 P14 DEC 14 NLCOM OCT 177645 SPC 5 * CONVERT THE ADDRESS IN THE A-REG TO A PAGE # * CPAG# NOP ALF,RAL ROTATE PAGE BITS RAL TO LOW BYTE AND M1777 AND MASK THEM JMP CPAG#,I SKP *** SYSTEM BASE PAGE COMMUNICATION AREA *** * * SYSTEM TABLE DEFINITION * * FWCMM DEF USRTR-133B . EQU USRTR-130B * XIDEX EQU .-3 ID EXTENSION ADDR OF CURRENT PROG XMATA EQU .-2 MAT ENTRY ADDR OF CURRENT PROG XI EQU .-1 ADDR OF I-REG SAVE AREA EQTA EQU .+0 FWA OF EQUIPMENT TABLE EQT# EQU .+1 # OF EQT ENTRIES LUMAX EQU .+3 # OF LOGICAL UNITS (IN DRT) DRT EQU .+2 FWA OF DEVICE REFERENCE TABLE INTBA EQU .+4 FWA OF INTERRUPT TABLE INTLG EQU .+5 # OF INTERRUPT TABLE ENTRIES TAT EQU .+6 FWA OF TRACK ASSIGNMENT TABLE KEYWD EQU .+7 FWA OF KEYWORD BLOCK * * I/O MODULE/DRIVER COMMUNICATION * EQT1 EQU .+8 ADDRESSES EQT2 EQU .+9 EQT3 EQU .+10 OF EQT4 EQU .+11 EQT5 EQU .+12 CURRENT EQT6 EQU .+13 EQT7 EQU .+14 15-WORD EQT8 EQU .+15 EQT9 EQU .+16 EQT EQT10 EQU .+17 EQT11 EQU .+18 ENTRY EQT12 EQU .+81 EQT13 EQU .+82 EQT14 EQU .+83 EQT15 EQU .+84 * CHAN EQU .+19 CURRENT DMA CHANNEL # TBG EQU .+20 I/O ADDRESS OF TIME-BASE CARD SYSTY EQU .+21 EQT ENTRY ADDRESS OF SYSTEM TTY * * SYSTEM REQUEST PROCESSOR /'EXEC' COMMUNICATION * * RQCNT EQU .+22 # OF REQUEST PARAMETERS -1 RQRTN EQU .+23 RETURN POINT ADDRESS RQP1 EQU .+24 ADDRESSES RQP2 EQU .+25 RQP3 EQU .+26 OF REQUEST RQP4 EQU .+27 RQP5 EQU .+28 PARAMETERS RQP6 EQU .+29 RQP7 EQU .+30 (SEg,T FOR MAXIMUM OF RQP8 EQU .+31 9 PARAMETERS) RQP9 EQU .+32 * * DEFINITION OF SYSTEM LISTS (QUEUES) * * SKEDD EQU .+33 'SCHEDULE' LIST, SUSP2 EQU .+35 'WAIT SUSPEND' LIST, SUSP3 EQU .+36 'AVAILABLE MEMORY' LIST, SUSP4 EQU .+37 'DISC ALLOCATION' LIST, SUSP5 EQU .+38 'OPERATOR SUSPEND' LIST * * DEFINITION OF EXECUTING PROGRAM ID SEGMENT' * * XEQT EQU .+39 ID SEGMENT ADDR. OF CURRENT PROG. XLINK EQU .+40 'LINKAGE' XTEMP EQU .+41 'TEMPORARY (5-WORDS) XPRIO EQU .+46 'PRIORITY' WORD XPENT EQU .+47 'PRIMARY ENTRY POINT' XSUSP EQU .+48 'POINT OF SUSPENSION' XA EQU .+49 'A REGISTER' AT SUSPENSION XB EQU .+50 'B REGISTER' XEO EQU .+51 'E AND OVERFLOW * * SYSTEM MODULE COMMUNICATION FLAGS * * OPATN EQU .+52 OPERATOR/KEYBOARD ATTENTION FLAG OPFLG EQU .+53 OPERATOR COMMUNICATION FLAG SWAP EQU .+54 RT DISC RESIDENT SWAPPING FLAG DUMMY EQU .+55 I/O ADDRESS OF DUMMY INT. CARD IDSDA EQU .+56 DISC ADDR. OF FIRST ID SEGMENT IDSDP EQU .+57 -POSITION WITHIN SECTOR * * DEFINITION OF MEMORY ALLOCATION BASES * * BPA1 EQU .+58 FWA USER BASE PAGE LINK AREA BPA2 EQU .+59 LWA USER BASE PAGE LINK AREA BPA3 EQU .+60 FWA USER BASE PAGE LINK LBORG EQU .+61 FWA OF RESIDENT LIBRARY AREA RTORG EQU .+62 FWA OF REAL-TIME COMMON RTCOM EQU .+63 LENGTH OF REAL TIME COMMON AREA RTDRA EQU .+64 FWA OF RT PARTITION AVMEM EQU .+65 LWA+1 OF REAL TIME PARTITION BKORG EQU .+66 FWA OF BACKGROUND AREA BKCOM EQU .+67 LENGTH OF BACKGROUND COMMON AREA BKDRA EQU .+68 FWA OF BACKGROUND PARTITION * * UTILITY PARAMETERS * TATLG EQU .+69 NEGATIVE LENGTH OF TRACK ASSIGNMENT TABLE TATSD EQU .+70 # OF TRACKS ON SYSTEM DISC SECT2 EQU .+71 # SECTORS/TRACK ON LU 2 (SYSTEM) SECT3 EQU .+72 # SECTORS/TRACK ON LU 3 (AUX.) DSCLB EQU .+73 DISC ADDR OF RES LIB ENTRY PTS DSCLN EQU .+74 # OF USER ENTRY POINTS IN LEP LIST DSCUT EQU .+75 DISC ADDR OF RELOC DISK RES LIBR SYSLN EQU .+76 # OF SYSTEM ENTRY POINTS IN LEP LIST LGOTK EQU .+77 LOAD-N-GO: LU, ST TRACK, # OF TRKS LGOC EQU .+78 CURRENT LGO TRACK/SECTOR ADDRESS SFCUN EQU .+79 SOURCE FILE LU AND DISC ADDRESS MPTFL EQU .+80 MEMORY PROTECT ON/OFF FLAG (0/1) FENCE EQU .+85 MEM PROTECT FENCE ADDRESS BKLWA EQU .+87 LWA OF BACKGROUND PARTITION HED RTGN3 - LOADING CONTROL SEGMENT SUBROUTINES. * * SCDRV SCANS THE IDENT TABLE FOR DRIVERS OF TYPE 0 * WHOSE NAME BEGINS WITH "DV". * * RETURN: (P+1) END OF IDENTS * (P+2) PARTITION-RESIDENT DRIVER * (P+3) SDA DRIVER * * SCDRV NOP * NEXTD JSB IDSCN SCAN IDENTS FOR A TYPE 0 JMP SCDRV,I END OF IDENTS * LDA \ID1,I GET CHARACTERS 1 & 2 CPA "DV" OF NAME, AND COMPARE RSS MUST BEGIN WITH DV JMP NEXTD TRY NEXT DRIVER LDA \ID8,I CHECK IF AN EQT SSA,RSS DEFINED FOR IT (BIT 15 SET) JMP NEXTD NOPE LDB \ID3,I GET LOADED FLAG SLB IF ALREADY LOADED JMP NEXTD THEN SKIP IT * ISZ SCDRV BUMP EXIT RAL NOW CHECK IF AN SDA SSA (BIT 14 WAS SET) ISZ SCDRV YES, BUMP EXIT JMP SCDRV,I RETURN * "DV" ASC 1,DV SKP * * IDFIX: SETS UP WORDS 21, 28 & 29 OF A LONG ID SEGMENT * AND BUILDS AN ID EXTENSION FOR EMA PROGRAMS * * WORD 21 FORMAT - BIT 15: 1=PARTITION ASSIGNED * 10-14: PARTITION SIZE REQMT. IN PAGES * NEGLECTING BASE PAGE (#PAGES-1) * 7-9: MEM PROTECT FENCE TBL INDEX * 6: RESERVED (0) * 0-5: ASSIGNED PARTITION NUMBER-1 * * WORD 28 - 15-10: ID EXTENSION INDEX * 9-0: EMA SIZE * * WORD 29 - HIGH MAIN ADDRESS OF LARGEST SEGMENT, ELSE 0 * * CALLING SEQUENCE: * * JSB \SYS (OR MAKE SURE \ABDO IS MAPPING SYSTEM) * A= #PAGES NEEDED BY PROGRAM INCL. BASE PAGE * B= INDEX OF IDENT ENTRY FOR PROG * JSB IDFIX * * * RETURN: * (P+1): ERROR ON MSEG SIZE OF EMA PROG * (P+"): NORMAL RETURN SPC 1 IDFIX NOP SZA DON'T INCLUDE BASE ADA M1 PAGE IN SIZE. STA IDTM1 SAVE PAGE REQMT STB \TIDN STORE DESIRED ENTRY INDEX JSB \IDX AND BRING INTO CORE JSB \ABOR NOT THERE * LDA \ID6,I WAS THIS AN EMA PROGRAM? SSA,RSS JMP SETMP NO, CONTINUE WITH MPFT INDEX * * DETERMINE PROGRAM'S MAXIMUM MSEG SIZE AND CHECK AGAINST * THE DECLARED SIZE IN ID6 (14-10), OR SET IF DEFAULTED * CCA ROUND THE HIGH MAIN OF THE PROGRAM OR ADA TPMAX ITS LARGEST SEGMENT TO THE START IOR M1777 OF THE NEXT PAGE INA STA EHM BITS 14-10 CONTAIN THE LOG START PAGE OF MSEG * JSB CPAG# GET THE PAGE # AND USE IT TO CMA,INA DETERMINE THE MAXIMUM MSEG SIZE ADA P31 SSA,RSS IF THERE DOES NOT EXIST AT SZA,RSS LEAST 2 PAGES (1 EACH FOR MSEG AND OVFLOW) JMP EER43 THEN DELETE PROG FROM SYS * STA MMSEG SAVE MAX MSEG SIZE LDA \ID6,I GET DECLARED JSB CPAG# SIZE FROM IDENT AND M37 SZA,RSS DEFAULTED? JMP MDFLT YES, USE MMSEG * STA B SAVE FOR LATER CMA,INA IS THE DECLARED MSEG SIZE GREATER ADA MMSEG THAN THE MAX? SSA,RSS JMP EMAF1 NO, ITS OK * * INVALID MSEG SIZE - BACK UP DISK ADDRESS AND GET RID OF * PROGRAM'S ID SEGMENT(S) * EER43 LDA ERR43 SEND ERROR DIAGNOSTIC CMA,INA JSB \GNER JSB \SPAC * LDA EMDSK BACK|UP THE DISK ADDRESSES STA \ADSK OVER THE EMA PROGRAM CCA AND THE KEYWORD POINTER ADA CURAK STA CURAK LDB N33 NOW THE LONG ID SEGMENT ADDRESS ADB SYSAD STB SYSAD STB CURAI SET FOR ZOUT LDB N33 CLEAR THE ENTIRE JSB ZOUT ID SEGMENT USED BY MAIN LDA \ID6,I GET PROGRAM TYPE AND M1776 AND MASK IT OUT IOR P8 SET IT TO A TYPE 8 MAIN (DELETED) STA \ID6,I AND STORE * LDA SDID WERE THERE ANY SZA,RSS SEGMENTS? JMP IDFIX,I NO ALF,RAR BACK-UP THE SHORT ID-SEG ADDRESS ADA SDID BY 9 WORDS EACH CMA,INA STA B SAVE FOR ZOUT ADA \SSID AND RESET THE NEXT STA \SSID SHORT ID-SEG ADDRESS ADA P11 BUMP TO ACTUAL START STA CURAI OF ID SEG JSB ZOUT AND CLEAR ALL OF THEM * LDA SDID NOW BACK UP THE CMA,INA KEYWORD COUNTER AS WELL ADA \SKYA STA \SKYA * JMP IDFIX,I ERR43 ASC 1,43 M1776 OCT 177600 P8 DEC 8 SPC 2 MDFLT LDA MMSEG GET MAXIMUM MSEG SIZE STA B ALF,RAL AND POSITION TO BITS 14-10 ALF,RAL IOR \ID6,I AND STORE IN IDENT ENTRY STA \ID6,I OF PROG * EMAF1 STB MMSEG SET CURRENT PROG'S MSEG ADB IDTM1 ADD TO CODE PAGE REQ'S STB IDTM1 AND SET FOR WORD 21 * * UPDATE ID SEGMENT WORD 28 OF AN EMA PROGRAM * LDB IDEXC GET INDEX OF NEXT EXTENSION BLF,RBL AND MOVE TO (15-10) BLF,RBL LDA \ID5,I GET THE DECLARED EMA SIZE ALF,ALF FROM IDENT ALF AND M1777 STA PGREQ *TEMP* SAVE * SZA,RSS DEFAULT? INA YES, SET TO 1 ADA B MERGE INDEX STA IDTM3 AND SAVE JSB IDFND GET ID SEG ADDRESS ADB P28 POSITION TO WORD 28 LDA ?IDTM3 GET VALUE TO STORE JSB \ABDO AND DO IT * * BUILD THE ID EXTENSION FOR AN EMA PROGRAM: * WORD 0: (4-0) MSEG SIZE * WORD 1: (15-11) LOGICAL START PAGE OF MSEG * (10) =1 IF DEFAULT EMA SIZE * LDB IDEX GET ADDRESS OF NEXT ID ADB IDEXC EXTENSION ENTRY JSB DPRW FROM ID EXTENSION TABLE LDB A ADDRESS TO B-REG LDA MMSEG STORE MSEG SIZE JSB \ABDO IN WORD 0 STB IDTM3 SAVE ADDR LDA EHM GET LOG START PAGE AND M0760 OF MSEG IN 14-10 LDB PGREQ WAS EMA SIZE DEFULTED? SZB,RSS ADA M1000 YES, SET SO BIT 10 WILL BE SET RAL MOVE 'EM ALL LEFT 1 LDB IDTM3 GET ENTRY ADDRESS OF WORD 1 JSB \ABDO AND SEND IT * ISZ IDEXC BUMP # OF EXTENSIONS USED LDA EMLNK NOW STORE THE MSEG STARTING ADA \ADBP ADDRESS INTO THE ALREADY- LDB EHM ALLOCATED BASE PAGE LINK STB A,I SPC 2 * CHECK USE OF SSGA SPC 1 SETMP LDA \ID6,I GET PROG TYPE FROM \IDENT AND M20 AND ISOLATE THE SSGA BIT. SZA,RSS IF NOT USING SSGA, JMP NOSSC THEN GO CHECK OTHER COMMONS. SPC 1 LDA P4 IF USING SSGA, THEN PICK UP ITS JMP IDSET MPFT INDEX AND GO WRITE ID-SEG. SPC 1 * NOT USING SSGA; USE COMMON SIZE FROM IDENT * (EITHER SOME OR NONE), REVERSE COMMON BIT IN TYPE, * AND LOW TWO TYPE BITS TO INDEX INTO TABLE OF * MPFT INDICES. SPC 1 NOSSC LDA \ID6,I GET TYPE AGAIN AND SAVE BITS AND M13 0,1, AND REVERSE COMMON BIT(3) LDB \ID4,I PICK UP COMMON SIZE CLE,ELB CLEAR SIGN BIT SZB IF ANY, THEN SET BIT 2 IN A. IOR P4 SPC 1 ADA IDTB. USE BIT PATTERN IN A TO INDEX LDA A,I TABLE, AND PICK UP MPFT INDipEX. SPC 1 * A CONTAINS MPFT INDEX, MERGE IN SIZE REQUIREMENT * AND WRITE DISK. SPC 1 IDSET CLB PUT MPFT INDEX AND RRR 3 IOR IDTM1 PAGE REQMT IN PROPER RRL 10 POSITIONS IN A-REG SPC 1 STA IDTM3 SAVE NEW ID WORD JSB IDFND FIND ID-SEG ADDRESS ADB P21 POINT TO ID-SEG WORD 21 LDA IDTM3 AND WRITE NEW CONTENTS JSB \ABDO TO DISK. SPC 1 LDA IDTM1 MERGE PARTITION SIZE ALF,ALF REQUIREMENT LESS 1 IOR \ID8,I INTO UPPER BYTE STA \ID8,I OF \IDENT WORD 8 * * IF A SEGMENTED PROGRAM THEN SET WORD 29 * ISZ IDFIX BUMP RETURN ADDR LDA SDID GET SEGMENT-ENCOUNTERED FLAG SZA,RSS ANY FOR THIS PROGRAM JMP IDFIX,I NONE, SO RETURN ADB P7 POSITION TO WORD 29 ADDR LDA TPMAX GET HIGH MAIN OF LARGEST JSB \ABDO SEGMENT AND STORE * JMP IDFIX,I EHM NOP MMSEG NOP N33 DEC -33 P11 DEC 11 SKP * CONSTANTS, ETC. SPC 1 IDTM1 BSS 1 IDTM3 BSS 1 M20 EQU P16 * M13 OCT 13 SPC 4 * INDEX LOOKUP TABLE * * TABLE CONTAINS MPFT INDICES * * THE INDEX TO THIS TABLE IS 4 BITS LONG: * * BITS 0,1: 00 - LBG DISK RES * (FROM TYPE) 01 - MEM RES * 10 - RT DISK RES * 11 - BG DISK RES * BIT 2: 0 - NO COMMON USED * 1 - COMMON USED * BIT 3: 0 - USE NORMAL COMMON * 1 - USE REVERSE COMMON SPC 1 IDTB. DEF *+1 INDEX OCT 0 0000-BG W/O COMMON OCT 1 0001-MR W/O COMMON OCT 5 0010-RT DR W/O COMMON P5 OCT 5 0011-BG DR W/O COMMON P3 OCT 3 0100-BG DR W/BG COMMON P2 OCT 2 0101-MR W/RT COMMON OCT 2  0110-RT DR W/RT COMMON OCT 3 0111-BG DR W/BG COMMON OCT 0 1000-BG DR W/O COMMON (REVERSE) OCT 1 1001-MR W/O COMMON (REVERSE) OCT 5 1010-RT DR W/O COMMON (REVERSE) OCT 5 1011-BG DR W/O COMMON (REVERSE) OCT 2 1100-BG DR W/RT COMMON OCT 3 1101-MR W/BG COMMON OCT 3 1110-RT DR W/BG COMMON OCT 2 1111-BG DR W/RT COMMON * END OF TABLE SKP * * IDFND - FIND ID SEGMENT ADDRESS BY READING * KEYWORD FROM DISC. * * CALLING SEQ: RETURN SEQ: (N+1) * (INSURE 'SYS' MAP IS SET FOR \ABDO) A IS DESTROYED * (INSURE IDFIX CALLED EARLIER FOR PROG) B IS ID SEG ADDR * (INSURE PROG'S IDENT IS IN CORE) * JSB IDFND * SPC 1 IDFND NOP LDA M377 PICKUP KEYWD# IN IDENT AND \ID8,I WORD 8 AND ISOLATE IT ADA KEYAD ADD KEYWORD BASE ADDR LDB A AND SAVE IN B FOR DPRW. JSB DPRW THEN READ KEYWD. LDB A JMP IDFND,I RETURN W/ID-SEG ADDR IN B. SPC 4 * DETERMINE PAGE REQUIREMENTS FOR A PROGRAM * * CALLING SEQUENCE: RETURN SEQUENCE: * A=HIGH MAIN ADDR+1 B,E DESTROYED * B=LOW MAIN ADDR A=PAGE REQUIREMENT * JSB PGREQ INCL. BASE PAGE. SPC 1 PGREQ NOP CMB B=-LOMAIN-1 ADA B A=NO. WORDS NEEDED-1 RRR 10 A=#PAGES-1 AND M37 CLEAN OUT BAD BITS ADA P2 A=#PAGES+1(I.E. INCL BASE PAGE) SPC 1 JMP PGREQ,I PAGE REQUIREMENTS. SKP * * PRINT HEADING, INITIALIZE IDX * * THE SETHD SUBROUTINE PRINTS THE HEADINGS FOR THE DIFFERENT * TYPES OF PROGRAMS LOADED, SETS THE NO-PROGRAMS-LOADED-YET * FLAG, AND ORIGINS THE SCAN OF IDENT. * * CALLING SEQUENCE: * A = NO. CHARS. (POS.) IN MESSAGE * B = ADDRESS OF MESSAGE * JSB SETHD * * RETURN: CONTENTS OF A AND B ARE DESTROYED * SETHD NOP DST \TBUF SAVE THE MESSAGE JSB \SPAC NEW LINE DLD \TBUF NOW JSB \MESS PRINT HEADING JSB \SPAC NEW LINE CCA STA LFLAG SET PROGRAMS-LOADED FLAG = -1 LDA P10 GET FIRST IDENT INDEX STA CIDNT SET IDENT ADDRESS FOR ID SCAN JMP SETHD,I RETURN SKP * * UPDATE RESIDENT MEMORY BOUNDS * * THE INCAD SUBROUTINE UPDATES THE MAIN AND BP MEMORY BOUNDS * FROM THAT USED IN THE PREVIOUS LOADING CALL. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB INCAD * * RETURN: CONTENTS OF A AND B ARE DESTROYED * INCAD NOP LDA TPREL GET CURRENT RELOCATION ADDRESS STA \PREL SET NEW PROGRAM RELOC ADDRESS LDB TBREL GET CURRENT BP RELOC ADDRESS STB PBREL SET NEW BP RELOCATION ADDRESS JMP INCAD,I RETURN SPC 5 * DSKEV FORCES THE CURRENT DISC * ADDRESS TO BE EVEN. THIS IS * DONE TO INCREASE LOAD EFFENCIENCY * DURING RTE EXECUTION DSKEV NOP LDA \ADSK GET CURRENT ADDRESS SLA IF EVEN SKIP JSB \DSKA ELSE STEP BY ONE STA \ADSK RESET ADDRESS JMP DSKEV,I RETURN - ADDRESS IN A. SKP * N6 DEC -6 P21 DEC 21 * MES13 DEF MS13 MES14 DEF *+2 DEF *+8 ASC 10,RT COM ADD MES15 DEF MS15 MES18 DEF *+2 DEF *+8 ASC 10,BG COM ADD MES16 DEF MS16 MES22 DEF *+1 ASC 3,(NONE) MES23 DEF MS23 MES12 EQU MES23 * MES38 DEF *+1 ASC 14,SYS SIZE: XX TRKS, XXX SECS * JMP3I JMP 3,I INITIAL JMP INSTRUCTION * MES31 DEF *+1 ASC 11,SUBSYSTEM GLOBAL AREA MES32 ASC 5,DRIVR PART MES62 DEF *+2 DEF *+6 MES57 ASC \8,BG COMMON MES63 DEF *+1 ASC 9,SYSTEM DRIVER AREA MES64 DEF *+1 ASC 9,PARTITION DRIVERS MESDP DEF *+1 ASC 2,DP DO NOT REARRANGE MESPD NOP THESE FOUR ASC 1,: LINES * MES53 ASC 5,RT COMMON * P4 DEC 4 SPC 3 MS02 ASC 8,BP LINKAGE XXXXX MS13 ASC 12,MEMORY RESIDENT LIBRARY MS15 ASC 8,MEMORY RESIDENTS MS16 ASC 9,RT DISC RESIDENTS MS23 ASC 11,SYSTEM STORED ON DISC "BG" ASC 1,BG "PR" ASC 1,PR SKP * * FOR LBG DISK RESIDENTS, SET THE RELOCATION BASE AT * THE FIRST PAGE FOLLOWING THE DRIVER PARTITION, * OR, IF USED, COMMON. THIS ROUTINE IS CALLED BEFORE * RELOCATION OF EACH DISK RESIDENT PROGRAM SPC 1 SETRB NOP LDB LWDP1 GET LWA OF DP + 1 LDA \ID6,I GET PROG TYPE AND M20 ISOLATE SSGA BIT IN TYPE, IOR \ID4,I MERGE IN COMMON LENGTH, AND M7777 CLEAR SIGN BIT SZA AND IF HE USES EITHER LDB FWSDA SET RELOC BASE ABOVE COMMON. STB \PREL AND SAVE AS RELOCATION BASE. JMP SETRB,I RETURN SPC 3 * * SET THE RELOCATION BASE FOR PRIVILEGED PROGRAMS * AT THE PAGE BOUNDARY ABOVE TABLE AREA II. THIS * ROUTINE IS CALLED BEFORE THE RELOCATION OF EACH * RT/BG PRIVILEGED DISK RESIDENT PROGRAM. * SETPV NOP ISZ SETPV LDB FWPRV STB \PREL JMP SETPV,I SPC 3 * * DPRW - READ AND REWRITE A WORD FROM THE ABSOLUTE SYSTEM * STORED ON THE DISK * * CALL A-IGNORED * B- ABS TARGET SYSTEM ADDR * RETURN: B SET TO B+1 * A=CONTENTS OF DESIRED WORD SPC 1 DPRW NOP JSB \ABDO READ AND DESTROY WORD STA DPRWT SAVE IN TEMP ADB M1 BACK UP ADDR JSB \ABDO RESTORE WORD LDA DPRWT BACK TO A JMP DPRW,I AND RETURN SPC 1 DPRWT BSS 1 SKP * *  SCAN IDENTS FOR PROGRAM TYPE * * THE IDSCN SUBROUTINE SCANS IDENT FOR A PROGRAM OF THE * CURRENT TYPE (SET IN \PTYP). * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB IDSCN * * RETURN: CONTENTS OF A AND B ARE DESTOYED. * E = M/S FLAG FOR CURRENT PROGRAM. * IDSCN NOP LDA CIDNT GET NEXT IDENT IN SCAN STA \TIDN SET IDENT INDEX FOR IDX * IDSC0 JSB \IDX SET IDENT ADDRESSES JMP IDSCN,I RETURN - END OF IDENTS CCA ADA \TIDN GET CURRENT MAIN IDENT INDEX STA IMAIN SAVE CURRENT MAIN IDENT INDEX LDA \TIDN GET NEXT IDENT INDEX STA CIDNT SAVE ADDR FOR NEXT IDENT SCAN LDA \ID4,I GET TYPE RAL,CLE,ERA SET E = M/S LDA \ID6,I GET TYPE AND M177 MASK TO TYPE BITS CPA \PTYP WHAT WE WANTED? JMP IDSC1 YES CPA P13 MUST NOT CONFUSE JMP IDSC0 TYPE 13 AND 15 MODULES CPA P15 WITH TYPES 5 AND 7 JMP IDSC0 TRY NEXT * AND \TMSK ISOLATE PROGRAM TYPE CPA \PTYP CURRENT TYPE? RSS YES - CONTINUE JMP IDSC0 IGNORE IDENT - TRY NEXT IDENT IDSC1 ISZ IDSCN INCR RETURN ADDRESS JMP IDSCN,I RETURN SKP * * TEST FOR SOME PROGRAMS LOADED * * THE NOTST SUBROUTINE CHECKS FOR PROGRAMS OF THE CURRENT * TYPE LOADED. IT IS EXECUTED FOLLOWING COMPLETION OF THE * LOADING SEQUENCE FOR EACH PROGRAM TYPE. IF NO PROGRAMS OF * THIS TYPE HAVE BEEN LOADED, IT PRINTS THE MESSAGE * (NONE) ON THE TELEPRINTER. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB NOTST * * RETURN: CONTENTS OF A AND B ARE DESTROYED. * NOTST NOP ISZ LFLAG IF NO PROGRAMS LOADED JMP NOTST,I SEND: (NONE) LDA P6 LDB MES22 MES22 = ADDR: (NONE) NLHHN JSB \MESS PRINT: (NONE) JMP NOTST,I SPC 3 MES02 DEF MS02 MES03 DEF MS02+5 SKP * * CLEAR LOCAL LST ENTRIES * * CLRLT CLEARS THE CURRENT BP LINKAGE ADDRESSES IN THE BASE PAGE * IMAGE. (CLEARS B-A WORDS). * * CALLING SEQUENCE: * A = CURRENT LOW BP ADDRESS * B = CURRENT HIGH BP ADDRESS PLUS ONE * JSB CLRLT * * RETURN: CONTENTS OF A AND B ARE DESTROYED. * CLRLT NOP STA CLRTM SAVE PARM IN TEMP LDA BPINC AND PICK UP BP INCREMENT ELA AND SAVE SIGN (<0 = DOWN) LDA CLRTM THEN RESTORE PARM. SEZ IF BP LINKS GO DOWNWARD, SWP THEN SWAP PARMS. CMB,INB SET HIGH BOUND NEGATIVE ADB A SET A = TOTAL WORD COUNT SSB,RSS SKIP - SOME BP SECTION TO CLEAR JMP CLRLT,I RETURN - NO BP SECTION STB WDCNT SET COUNT FOR CLEARING ADA \ADBP ADJUST FOR BP ADDRESS LDB CLWRD GET THE CLEARING WORD STB A,I CLEAR BP WORD INA ISZ WDCNT SKIP - ALL BP CLEAR JMP *-3 JMP CLRLT,I END OF CLEARING CLRTM BSS 1 * CLWRD NOP SKP * * OUTPUT ABSOLUTE BASE PAGE CODE * * BPOUT OUTPUTS THE BASE PAGE SECTION OF CODE FOLLOWING LOADING OF * EACH DISK RESIDENT PROGRAM, BEGINNING WITH THE DISK * ADDRESS SPECIFIED IN \ADSK. * * CALLING SEQUENCE: * A = UPPER BP ADDRESS PLUS ONE * B = LOWER BP ADDRESS * JSB BPOUT * * RETURN: CONTENTS OF A AND B ARE DESTOYED. * BPOUT NOP CMA,INA COMPLEMENT UPPER ADDRESS ADA B ADD LOWER ADDRESS STA TCNT SAVE BP LENGTH ADB \ADBP ADJUST FOR BP ADDRESS STB CURAT SAVE CURRENT LOWER CORE ADDR SSA,RSS SKIP - SOME CODE IN BP JMP BPOUT,I RETURN - ALL CODE OUT LDA \ADSK GET CURRENT DISK ADDRESS BPSYO JSB \DSKO OUTPUT CUR RENT BP SECTOR LDA \ADSK GET CURRENT DISK ADDRESS JSB \DSKA INCR DISK ADDRESS STA \ADSK SAVE NEXT DISK ADDRESS LDB TCNT GET CURRENT LENGTH ADB P64 STB TCNT SAVE COUNT FOR NEXT PASS SSB,RSS SKIP - MORE CODE TO PUT OUT JMP BPOUT,I RETURN - ALL CODE OUT LDB CURAT GET CURRENT LOW CORE ADDRESS ADB P64 STB CURAT SET NEXT CORE ADDRESS JMP BPSYO OUTPUT NEXT SECTOR TO DISK * P64 DEC 64 SKP * CLEAR PROGRAMS-LOADED FLAGS * * CLID3 CLEARS THE USAGE FLAGS TO ENSURE THAT PROGRAMS WILL BE * RE-LOADED AGAIN IF CALLED MORE THAN ONCE. THIS IS ESSENTIAL * FOR ALL UTILITY PROGRAMS AND USER SUBROUTINES, BUT MUST NOT * BE DONE FOR SYSTEM PROGRAMS OR MAIN USER * PROGRAMS. BOTH THE USAGE FLAG IN THE IDENT ENTRY AND THE * SYMBOL VALUES FOR ALL ENTRY POINTS IN THE PROGRAM ARE CLEARED. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB CLID3 * * RETURN: CONTENTS OF A AND B ARE DESTROYED. * CLID3 NOP LDB P3 GET THE STANDARD FLAG LDA P5 CPA \PTYP PROG = BG SEGMENT? LDB P7 YES - GET BS FLAG BITS STB CURAP SET CURRENT PROG FLAG BITS JSB \INID INITILIZE THE IDENT SCANNER TRID3 JSB \IDX GET THE NEXT IDENT. JMP CLID3,I IF NONE THEN EXIT - DONE * LDA \ID4,I GET M/S RAL,CLE,ERA SET E IF MAIN LDA \ID6,I GET TYPE AND M177 ISOLATE TYPE SZA,RSS IF SYSTEM JMP TRID3 LEAVE SET CPA P13 OR IF TABLE AREA II RSS CPA P15 OR TABLE AREA I JMP TRID3 THEN LEAVE SET * AND M7 NOT EVERYONE CAN REFERENCE A TYPE 6 (14,30) CPA P6 BUT USUALLY THE LIBRARY RTNS WILL BE 7'S JMP TRID3 THIS HAPPENS ONLY IN MRL AND MRP'S * CPA P7 IF A UTILITY SUBROUTINE JMP C2 THEN CLEAR I!T SEZ IF MAIN JMP TRID3 FORGET IT * C2 LDA \ID3,I GET USAGE FLAG AND P7 ISOLATE THE USAGE FLAG CPA CURAP IF ONE THAT WE ARE AFTER RSS SKIP JMP TRID3 ELSE TRY THE NEXT ONE * XOR \ID3,I ZAP THE USAGE FLAGS STA \ID3,I AND RESTORE THE WORD JSB \ILST INITIALIZE \LSTX CLSUT JSB \LSTX SET CURRENT LST ADDRESSES JMP TRID3 TRY NEXT IDENT * CCA ADA \TIDN GET IDENT INDEX CPA \LST4,I ENT/EXT BELONGS TO CURRENT PROG? CLB,RSS YES - CONTINUE JMP CLSUT TRY NEXT LST ENTRY * STB \LST5,I CLEAR SYMBOL VALUE JMP CLSUT CONTINUE CLEARING BP LINK ADDR. SKP * * PACK THE CP LINK AREA * * CCPLK PACKS THE CURRENT PAGE LINK AREA TO GET RID OF LINK * AREAS THAT ARE NO LONGER ACTIVE. * * CALLING SEQUENCE: * * LDA CURRENT PAGE ADDRESS * JSB CCPLK * * RETURN REGISTERS MEANING LESS * * CCPLK WILL DELETE ALL LINK AREAS THAT ARE ABOVE * CPLS AND REFER TO AN AREA ON A PAGE BELOW THE PAGE * ADDRESS IN A ON ENTRY. IT WILL ALSO DELETE ALL * ENTRIES FOR ZERO LENGTH AREAS. * CCPLK NOP AND M0760 SAVE THE CMA,INA PAGE STA CPAG ADDRESS LDA CPLS GET THE LOWEST ENTRY TO SAVE STA TCCP4 SAVE FOR LAST VALID ENTRY JSB \LNKS SET UP THE \LNK AREA JSB \LNK GET THE FIRST POSSIBLE PURGE AREA JMP CCPLK,I IF NONE THEN EXIT * LDA \LNK1,I IF THIS AREA CPA \LNK2,I IS OF ZERO LENGTH JMP CCPL0 GO SET UP * AND M0760 ELSE IF AREA IS ABOVE OR EQUAL ADA CPAG TO THE SAVE PAGE AREA SSA,RSS THEN JMP CCPLK,I EXIT - NO PACK NEEDED * CCPL0 LDA \LNK1 SET UP THE NEXT AVAILABLE CCPL1 STA TCCP1 POINTER CCPL5 JSB \LNK GET THE NEXT ENTRY JMP CCPL3 IF NONE GO HANDLE * LDA \LNK1,I IF STILL CPA \LNK2,I A ZERO ENTRY JMP CCPL5 REJECT THE ENTRY AND M0760 ISOLATE THE PAGE ADDRESS ADA CPAG IF STILL SSA BELOW THE SPECIFIED PAGE JMP CCPL5 REJECT THE ENTRY * LDA TCCP1 KEEP THE AREA STA TCCP4 SET LAST AREA POINTER STA TCCP2 SET MOVE POINTER LDA \LNK2,I SET UP THE CMA,INA ADA \LNK1,I MOVE STA TCCP3 COUNT LDA \LNK1,I SET WORDS STA TCCP2,I ONE ISZ TCCP2 LDA \LNK2,I TWO STA TCCP2,I ISZ TCCP2 LDA TCCP2 AND INA STA TCCP2,I THREE LDB \LNK3,I MOVE CCPL2 ISZ TCCP2 THE LDA B,I IMAGE STA TCCP2,I TO THE NEW LOCATION INB ISZ TCCP3 JMP CCPL2 * LDA \LNK1 AND CPA \CPL2 CPL2 JMP CCPL3 IF END GO DO SPECIAL * LDA TCCP2 UPDATE INA FOR THE NEXT ENTRY JMP CCPL1 AND GO DO IT * CCPL3 LDB TCCP4 SET UP STB \CPL2 CPL2, THE UPPER LIMIT JMP CCPLK,I AND EXIT SPC 2 TCCP1 NOP TCCP2 NOP TCCP3 NOP TCCP4 NOP CPAG NOP M0760 OCT 076000 SKP * * GENERATE INT ENTRY,KEYWD,ID SEG * * GENID GENERATES THE CURRENT ID SEGMENT AND KEYWORD * FOR THE PROGRAM LOADED. IN ADDITION, IT GENERATES THE * LINKAGE REQUIRED IN THE INTERRUPT TABLE FOR THOSE PROGRAMS * WHICH ARE TO BE SCHEDULED UPON RECEIPT OF AN INTERRUPT. * * CALLING SEQUENCE: * A = 0 (GENERATE MEM.RES ID SEGMENT) * -1 (GENERATE LONG ID SEGMENT) * -2 (GENERATE BLANK LONG ID SEGMENT) * B = IGNORED * JSB GENID * * RETURN: CONTENTS OF A AND B ARE DESTROYED * * GENID NOP STA PLFLG SAVE ID SEGMENT LENGTH FLAG CPA N2 IF BLANK GEN JMP BLID GO SEND THE KEY WORD * LDB SYSAD  GET START ADDR FOR ID-SEG STB SCH3 SAVE START ADDR IN A TEMP STB SYSAD AND UPDATE BASE STB CURAI UPDATE OUTID PTR TOO. * * GENERATE INT ENTRY FOR USER SYS * LDA AILST GET THE ADDRESS OF INT IMAGE STA \CURL SET CURRENT INT ADDRESS LDA M72 GET NO. OF INT ENTRIES CMA,INA STA TCNT SAVE TOTAL INT COUNT GETIT LDA \CURL,I GET CURRENT WORD IN INT CMA,INA TEST NEGATIVE ENTRIES FOR ILIST CPA IMAIN EQUAL TO MAIN IDENT INDEX? RSS YES - CONTINUE JMP NOTPN IGNORE REF IF NOT CURRENT MAIN * LDA SYSAD GET ID SEG ADDRESS CMA,INA GET 2'S COMPLEMENT FOR INT ENTRY LDB AILST COMPUTE THE INT CORE CMB,INB ADDRESS ADB \CURL = ILST OFFSET PLUS ADB AINT ACTUAL CORE ADDRESS JSB \ABDO SENT THE ENTRY TO THE DISC NOTPN ISZ \CURL STEP TO THE NEXT ENTRY ISZ TCNT SKIP - INT EXHAUSTED JMP GETIT ANALYZE NEXT INT ENTRY * * GENERATE KEYWORD STKEY LDA IMAIN GET MAIN IDENT INDEX STA \TIDN SET ADDRESS FOR IDX JSB \IDX SET IDENT ADDRESSES JSB \ABOR NO IDENT FOUND SPC 1 LDB SYSAD CCA ADA \TIDN GET IDENT POINTER CPA SCH1 SCHEDULE PGM? STB SCH4 YES - SAVE ITS ID ADDRESS BLID LDA SYSAD GET THE ID-ADDRESS TO A LDB CURAK AND THE CURRENT CORE ADDRESS JSB \ABDO TO B AND OUTPUT TO THE DISC STB CURAK SET THE NEW ADDRESS LDB SYSAD GET THE ADDRESS LDA PLFLG GET THE ID SEGMENT LENGTH FLAG ADB P29 ADJUST FOR NEXT ID SEGMENT ADDR SZA SKIP - SHORT ID SEGMENT ADB P4 ADJUST FOR LONG ID SEGMENT STB SYSAD SET NEXT ID SEGMENT ADDRESS * * GENERATE ID SEGMENT * LDA PLFLG IF FLAG = -2 FOR M CPA N2 BLANK OUTPUT, JMP GENID,I EXIT * LDA KEYAD SAVE KEYWORD CMA OFFSET FOR ADA CURAK LATER ACCESS TO ID-SEG. STA \ID8,I (TEMP SAVE) * LDB N6 JSB ZOUT OUTPUT ZEROES TO ID SEGMENT LDA CUPRI GET THE CURRENT PRIORITY JSB OUTID OUTPUT WORD TO ID SEGMENT BUFFER LDA PRENT GET PRIMARY ENTRY POINT JSB OUTID OUTPUT WORD TO ID SEGMENT BUFFER LDB N2 JSB ZOUT OUTPUT ZEROES TO ID SEGMENT LDA SCH3 GET ADDRESS OF CURRENT ID SEG INA STEP TO PRAM LIST JSB OUTID OUTPUT B REG TO ID SEGMENT CLA SEND E/O REGS TO JSB OUTID THE ID SEGMENT LDA \ID1,I GET NAME 1,2 JSB OUTID OUTPUT WORD TO ID SEGMENT BUFFER LDA \ID2,I GET NAME 3,4 JSB OUTID OUTPUT WORD TO ID SEGMENT BUFFER LDA \ID6,I GET TYPE AND M7 ISOLATE TYPE STA B SAVE TYPE IN B LDA \ID3,I GET NAME 5 AND M7400 ISOLATE NAME 5 IOR B ADD TYPE TO NAME 5 JSB OUTID OUTPUT WORD TO ID SEGMENT BUFFER CLA PRESET FOR DORMANT CCB ADB \TIDN IF THIS PGM TO BE CPB SCH1 SCHEDULED CLA,INA SET SCHEDULED FLAG JSB OUTID SET WORD IN ID CLA SET TIME LINK JSB OUTID TO ZERO AND OUTPUT LDA \MULR GET RESOLUTION CODE, EXEC MULT JSB OUTID OUTPUT WORD TO ID SEGMENT BUFFER LDA \TIME GET LOW PART OF TIME JSB OUTID OUTPUT LS TO ID SEG LDA \TIM1 GET HIGH HALF JSB OUTID OUT MS HALF TO ID SEG LDB N2 ZEROS TO JSB ZOUT ID SEG 20 AND 21 * LDA \PREL GET CURRENT PROG RELOC ADDRESS ADA BSSDP ADD INITIAL PROG DISPLACEMENT JSB OUTID OUTPUT WORD TO ID SEGMENT BUFFER LDA TPREL GET CURRENT RELOCATION ADDRESS a CMA,INA CHECK ADA LWASM MEMORY OVERFLOW SSA,INA,SZA OK IF POS OR -1 JMP ER18 YES GO SEND THE BITCH * LDA TPREL NO SEND THE UPPER LIMIT GENI9 JSB OUTID OUTPUT WORD TO ID SEGMENT BUFFER LDA PBREL GET LOW BP RELOCATION ADDR JSB OUTID OUTPUT WORD TO ID SEGMENT BUFFER LDA TBREL GET HIGH BP RELOCATION ADDR JSB OUTID OUTPUT WORD TO ID SEGMENT BUFFER ISZ PLFLG SKIP - CONTINUE WITH LONG ID SEG JMP SMWDS MEM.RES ID SEGMENT LDA DSKMN GET INITIAL MAIN DISK ADDRESS JSB OUTID OUTPUT WORD TO ID SEGMENT BUFFER LDB N3 ZEROES TO JSB ZOUT WORDS 27-29 * SMWDS LDB N3 ZERO THE SESSION MONITOR WORDS JSB ZOUT ID SEG 30, 31, & 32 JMP GENID,I RETURN - ID SEGMENT OUT * ER18 LDA ERR18 SEND ERROR 18 CMA,INA COMPLEMENT SO NO TR,ERRLU ON ERROR JSB \GNER MEMORY OVERFLOW LDA LWASM USE LAST WORD OF MEMORY INSTEAD JMP GENI9 GO FINISH THE ID-SEGMENT * ERR18 ASC 1,18 M1774 OCT 177400 N3 DEC -3 M1 DEC -1 P29 DEC 29 SPC 5 * * OUTPUT ZERO TO IDBUF * * ZOUT PUTS OUT ZEROES TO THE ID SEGMENT BUFFER. * * CALLING SEQUENCE: * A = IGNORED * B = NO. OF ZEROES TO GO OUT (NEG.). * JSB ZOUT * * RETURN: CONTENTS OF A AND B ARE DESTOYED. * ZOUT NOP STB TCNT SAVE NO. OF ZEROES TO GO OUT CLA JSB OUTID OUTPUT ZERO TO IDBUF ISZ TCNT SKIP - ALL ZEROES OUT JMP *-3 CONTINUE ZERO OUTPUT TO IBUF JMP ZOUT,I RETURN SKP * * GENERATE A SHORT BG/PR SEGMENT ID SEGMENT AND ITS ASSOCIATED * KEYWORD ENTRY. NOTE THAT THE CONTENTS OF THE KEYWORD IS 11 * LOCATIONS LESS THAN THE ACTUAL START OF THE SHORT ID * SEGMENT. THIS IS TO ALLOW FOR EASY ACCESS TO THE ID * SEGMENT'S PROGRAM NAME BY ALWAYS ADDING AN OFFSET OF * 12/ TO THE CONTENTS OF THE KEYWORD LOCATION. * * CALLING SEQUENCE: * A = -1 (GENERATE SHORT ID SEGMENT) * = -2 (GENERATE BLANK SHORT ID SEGMENT) * B = IGNORED * * RETURN: CONTENTS OF A & B DESTROYED * GNSID NOP GENERATE SHORT SEGMENT ID-SEGMENTS STA PLFLG SAVE THE FLAG LDB \SKYA GET THE KEYWORD LDA \SSID ADDRESS AND ITS CONTENTS JSB \ABDO SEND THE KEY WORD TO THE DISC STB \SKYA SET THE NEW KEYWORD ADDRESS LDB \SSID GET THE ID- ADDRESS ADB P9 ADDJUST FOR NEXT TIME STB \SSID AND SAVE ADB P2 ADDJUST FOR ADDRESS OF CURRENT ID LDA PLFLG THIS A CPA N2 BLANK SHORTY? JMP BLSID YES GO DO BLANK THING * LDA PRENT NO GET THE PRIMARY ENTRY POINT JSB \ABDO SEND IT TO THE DISC LDA IMAIN GET THE IDENT INDEX STA \TIDN TO CURRENT JSB \IDX B-REG MUST NOT BE DESTROYED JSB \ABOR BETTER BE ONE LDA \ID1,I GET NAME 1,2 JSB \ABDO SEND TO THE DISC LDA \ID2,I GET NAME 3,4 JSB \ABDO SEND IT LDA \ID3,I GET NAME 5 AND M7400 MASK IOR P21 SET TYPE AND SHORT FLAG JSB \ABDO SEND IT TO THE DISC LDA BSPAD GET THE MEMORY ADDRESS ADA BSSDP ADDJUST FOR LEADING BSS JSB \ABDO SEND MAIN 1 LDA TPREL GET AND CMA,INA CHECK FOR MAIN MEMORY ADA LWASM OVER FLOW SSA,INA,SZA IF OVER FLOW JMP BLSI3 GO REPORT IT * LDA TPREL OK SO PUT IT OUT BLSI0 JSB \ABDO SEND MAIN 2 LDA BSBAD GET AND JSB \ABDO SEND BP 1 LDA TBREL GET AND JSB \ABDO SEND BP 2 LDA DSKMN GET DISC ADDRESS BLSI2 JSB \ABDO JMP GNSID,I RETURN * BLSID ADB P3 FOR BLANK LDA P16 SET THE SHORT BIT ONLY JMP BLSI2 GO SEND IT. R* BLSI3 LDA ERR18 SEND ERROR MESSAGE STB SIDS2 SAVE POINTER TO ID SEG CMA,INA COMPLEMENT SO NO TR,ERRLU DONE JSB \GNER LDB SIDS2 LDA LWASM USE LAST WORD OF MEMORY INSTEAD JMP BLSI0 GO FINISH THE ID-SEGMENT * SIDS2 BSS 1 SPC 5 * * OUTPUT ID SEGMENT WORD TO IBUF * * OUTID PACKS THE WORDS FOR THE ID SEGMENTS IN THE ID SEGMENT * BUFFER AND WRITES THE BUFFER ON THE DISK WHEN IT CONTAINS * 64 WORDS. * * CALLING SEQUENCE: * A = CURRENT ID SEGMENT WORD * B = IGNORED * JSB OUTID * * RETURN: CONTENTS OF A AND B ARE DESTROYED * OUTID NOP LDB CURAI GET THE CURRENT ID-SEGMENT ADDRESS JSB \ABDO SEND THE WORD TO THE DISC STB CURAI SET THE ADDRESS FOR NEXT TIME JMP OUTID,I RETURN SKP * * OUTPUT REST (IF ANY) OF ABS. REC * * REMDO PUTS OUT THE CURRENT SECTOR IF IT CONTAINS ANY WORDS OF * ABSOLUTE CODE. THIS IS NORMALLY DONE ONLY AT THE END OF THE GEN * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB REMDO * * RETURN: CONTENTS OF A AND B ARE DESTROYED. * REMDO NOP LDA \OLDA GET THE CURRENT DISC ADDRESS LDB \ADBF AND THE BUFFER ADDRESS SSA IF A GOOD ADDRESS JSB \DSKO OUTPUT THE CODE JSB BPDSA UPDATE THE DISC ADDRESS JMP REMDO,I RETURN SPC 5 * BPDSA ADVANCES THE DISK ADDRESS TO THE NEXT EVEN * DISC ADDRESS ASSUMING THE CURRENT DISC ADDRESS * IS NOT AVAILABLE. THIS IS NORMALLY DONE * AFTER EACH MAIN IS LOADED AND BEFORE THE BASE * PAGE IS OUTPUT. * * CALLING SEQUENCE: * * JSB BPDSA DOES NOT USE A/B RETURNS A=CURRENT DISC ADDRESS * BPDSA NOP LDA \ADSK BUMP JSB \DSKA THE DISC ADDRESS STA \ADSK AND RESET IT JSB DSKEV MAKE SURE IT IS EVEN JMP BPDSA,I RETURN SKP ,k* * CHBND IS A ROUTINE TO ASK THE OPERATOR IF HE WANTS TO CHANGE * A BOUNDRY, GET HIS ANSWER AND CHECK IT FOR LEGALITY. * THE MESSAGES SENT ARE: * * XXXXXXXXXX YYYYY AND * CHANGE XXXXXXXXXX? WHERE XXXXXXXXXX IS A 10 CHARACTER * MESSAGE SUPPLIED AS PART OF THE CALL * AND YYYYY IS THE CURRENT BOUND IN OCTAL * OR DECIMAL. * LEGAL RESPONSES ARE: * * 0 NO CHANGE. * N WHERE N>YYYYY AND LESS THAN OR EQUAL TO * THE SUPPLIED LIMIT. * * CALLING SEQUENCE: * B = NON-ZERO IMPLIES DON'T CHECK LOWER BOUND * A = CURRENT YYYYY A > 0 MEANS OCTAL * JSB CHBND A < 0 MEANS DECIMAL(ONE'S COMPLEMENT) * DEF ADDRESS OF XXXXXXXXXX (5 WORD MESSAGE) * DEF UPPER LIMIT OF RESPONSE * * RETURN (ALWAYS P+3) A = NEW BOUND. * CHBND NOP STB BPDSA SAVE *TEMP* STA CBFLG SAVE DECIMAL FLAG SSA SKIP IF OCTAL REQUEST,ELSE INA MAKE DEC, REQUEST 2'S COMPLMNT STA TMPX SAVE DEFAULT VALUE LDB CHBND,I GET THE MESSAGE ADDRESS AND STB TMPL SET UP TO MOVE LDA N5 FIVE WORDS STA \GNER TO FORM THE MESSAGE: LDB DMES " CHANGE XXXXXXXXXX YYYYY" CHNX LDA TMPL,I MOVE STA B,I 5 INB WORDS ISZ TMPL TO ISZ \GNER THE JMP CHNX MESSAGE * ISZ CHBND INDEX TO THE UPPER LIMIT STB TMPL SAVE THE ADDRESS FOR RETRY IN CASE CHOVR LDB TMPL OF ERROR LDA TMPX CONVERT THE NUMBER JSB \CONV TO THE BUFFER JSB \SPAC SEND A \SPAC LDB DMES GET THE ADDRESS LDA P16 AND SEND MESSAGE JSB \MESS "XXXXXXXXXX YYYYY" TO THE TTY LDA "?" PUT A "?" AFTER THE XXXXXXXXXX STA ME11S SET IT LDA P19 SEND MESSAGE AND GET LDB ADMES RESPONSE FOR JSB \READ " CHANGE XX(XXXXXXXX?" LDA P5 CONVERT RESPONSE LDB CBFLG LOAD FLAG SSB DECIMAL REQUEST?? CMA,INA YES, ASK \GET# FOR DECIMAL JSB \GET# GET BINARY EQUIVALENT JMP CBERR ERROR - REPEAT * JSB \GETC END OF BUFFER? SZA,RSS JMP CHOK YES OK- * CBERR JSB \INER SEND ERR 01 JMP CHOVR AND REPEAT * CHOK LDA \OCTN GET VALUE LDB BPDSA GET FLAG IN B-REG SZB JMP BGCCH SPECIAL TREATMENT FOR BG COMMON SZA,RSS IF ZERO USE LDA TMPX SUPPLIED VALUE SSA GET ABS VALUE OF CMA,INA CURRENT TOO LDB TMPX GET -ABS VALUE SSB,RSS OF UPPER LIMIT. CMB,INB ADB A IF LIMIT LESS THAN SSB CURRENT THEN JMP CBERR ERROR * CHHI LDB CHBND,I GET UPPER BOUND LDB B,I TO B CMB IF GREATER THAN ADB A MAX SSB,RSS THEN JMP CBERR ERROR * ISZ CHBND ELSE EXIT JMP CHBND,I RETURN VALUE IN A * BGCCH ALF,ALF CONVERT PAGES RAL,RAL TO WORDS JMP CHHI AND CHECK HI BOUND ONLY SPC 2 CBFLG BSS 1 DECIMAL/OCTAL FLAG TMPX NOP TMPL NOP DMES DEF .XXX ADMES DEF *+1 ASC 4, CHANGE .XXX BSS 5 ME11S NOP BSS 3 "?" ASC 1,? P19 DEC 19 SKP * * THIS ROUTINE IS CALLED AFTER THE SYSTEM AND PRD'S ARE * LOADED, BUT BEFORE THE MEMORY RESIDENT LIBRARY. SPC 1 * CLEAR LOAD FLAGS FOR TYPE 6 PGMS * CLRT6 NOP * SET LIBRARY RESIDENT FLAGS JSB \INID INITIALIZE IDX SETLX JSB \IDX SET IDENT ADDRESSES JMP CLRT6,I END OF IDENTS LDA \ID6,I GET TYPE AND M177 ISOLATE TYPE CPA P14 IF FOURCED CORE RES. RSS PROCESS CPA P6 TYPE = LIBRARY? { RSS YES - CONTINUE JMP SETLX PROCESS NEXT IDENT * LDA \ID3,I TYPE = 6 - GET LOAD FLAG RAR,CLE,ELA LOAD BIT TO E - AND CLEARED STA \ID3,I RESET CLEARED FLAG SEZ,RSS WAS IT LOADED? JMP SETLX NO - CONTINUE JSB CLEAR CLEAR THE VALUES OF ITS ENTRY POINTS JMP SETLX AND CONTINUE ID SCAN SPC 3 * * CLEAR THE LST ENTRY POINT VALUES BELONGING TO THE CURRENT IDENT * CLEAR NOP JSB \ILST INITIALIZE \LSTX CLR1 JSB \LSTX SET CURRENT LST ADDRESSES JMP CLEAR,I END - CONTINUE ID SCAN CCA ADA \TIDN GET IDENT ADDRESS CPA \LST4,I ENT BELONGS TO CURRENT PROG? CLA,RSS YES - CONTINUE JMP CLR1 NO - TRY NEXT ENT STA \LST5,I SET LINK TO ZERO. JMP CLR1 CONTINUE SEARCH SKP * * DEMOTES ALL TYPE 6 AND 14 PROGRAMS ALREADY IN THE MEMORY RESIDENT * LIBRARY TO TYPE 7 UTILITY ROUTINES, CLEARING THEIR LOAD FLAGS AND * ENTRY POINT VALUES. * * DEMTL NOP DEMOTE TO TYPE 7 JSB \INID INITIALIZE IDX SCAN DEMS JSB \IDX SET NEXT IDENT ADDRESSES JMP DEMTL,I END OF IDENTS * LDA \ID6,I GET AND AND M177 ISOLATE TYPE CPA P14 IS IT A FORCED MEM RES LIB? RSS YES CPA P6 OR LIBRARY? RSS YES JMP DEMS PROCESS NEXT IDENT * LDA \ID3,I GET LOAD FLAG WORD AND M1770 =B177770, AND CLEAR FLAGS STA \ID3,I RESTORE LDA \ID6,I GET TYPE WORD AND M1760 =B176000, AND CLEAR TYPE ADA M7 CHANGE TO TYPE 7 STA \ID6,I AND RESTORE JSB CLEAR CLEAR ANY ENTRY POINT VALUES JMP DEMS AND CONTINUE SCAN * M1770 OCT 177770 M1760 OCT 176000 * * END LABS LNLHHNASMB,R,L,C HED RT4G4 - LOADER SEGMENT. NAM RT4G4,5,90 92067-16009 REV.1805 780320 SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 2 SPC 1 ****************************************************************** * * NAME: RT4G4 * SOURCE PART #: 92067-18009 * REL PART #: 92067-16009 * WRITTEN BY: KFH, JH, GAA * ****************************************************************** SPC 1 * * ENTRY POINT NAMES * ENT \NLOD * * EXTERNAL REFERENCE NAMES * EXT \ILST,\LSTX,\LSTS,\TLST EXT \LST1,\LST2,\LST3,\LST4,\LST5 EXT \INID,\IDX,\TIDN EXT \ID1,\ID2,\ID3,\ID4,\ID5,\ID6,\ID7 EXT \IFIX,\FIX,\PFIX,\TFIX EXT \FIX1,\FIX2,\FIX3,\FIX4 EXT \LNKX,\LNK,\LNKS EXT \LNK1,\LNK2,\LNK3 EXT \FMRR,\CFIL EXT \PREL * EXT \CPLM,\ADBP EXT \LBUF,\TBUF,\CURL,\CPL2 EXT \RNT,\PRV EXT \CONV,\SPAC,\RBIN,\MESS,\GNER,\ABOR EXT \ABDO,\SRET EXT \SYS,\USER EXT READF,RWNDF,\NDCB,\RNAM EXT \PTYP,\ADSK,\ABCO,\MXAB,\TIME,\MULR * A EQU 0 B EQU 1 SUP ************************************************************************ * SKP *************************************************************************** * * 770913 * * THE FOLLOWING BLOCK OF STORAGE FOR VARIABLES PRECEEDS, * AND IS REFERENCED BY, EACH SEGMENT. IT IS NOT OVERLAID * AS EACH NEW SEGMENT IS LOADED INTO MEMORY. * * THE LOCATION OF EACH VARIABLE MUST BE THE SAME IN ALL ߦ* SEGMENTS. IF A CHANGE IS MADE, MAKE THE SAME CHANGES * IN THE REST OF THE SEGMENTS. * *************************************************************************** * * TB30 BSS 128 TRACK MAP TABLE/HEADER RECORD BUFFER * ILIST BSS 64 USER SYSTEM PROG IDENT ADDR LIST CURIL BSS 1 CURRENT ILIST ADDRESS * SYSCH BSS 1 SUBCHANNEL OF SYSTEM UNIT. DCHNL BSS 1 CHANNEL OF SYSTEM DISK UNIT AUXCH BSS 1 SUBCHANNEL OF AUX UNIT. DSIZE BSS 1 DISK SIZE -NO. OF TRACKS. #SUBC BSS 1 # DISC SUBCHANNELS DEF'D (7905/7920) DAUXN BSS 1 AUXILIARY DISK SIZE. ADS# BSS 1 AUX DISC SECTORS/TRACK. * * RELOCATION BASE TABLE. RBTA BSS 1 ABSOLUTE PROGRAM BASE. TPREL BSS 1 CURRENT PROGRAM BASE ADDRESS. TPBRE BSS 1 BASE PAGE RELOCATION ADDRESS. COMAD BSS 1 CURRENT COMMON RELOCATION BASE. BSS 1 ABS PROGRAM BASE FOR MR CODE. * WDCNT BSS 1 TEMPORARY WORD COUNTER. DSKSY BSS 1 INITIAL ID SEGMENT DISK ADDRESS IDSP BSS 1 POSITION OF 1ST ID SEG. IN SECT TTYCH BSS 1 SYSTEM TTY CHANNEL NO. * PLFLG BSS 1 PROGRAM LOAD. FLAG = -1/0 = L/NL DSCNT BSS 1 DISK SEGMENT SECTOR COUNT * NXFLG BSS 1 ENT/EXT FLAG = -1/0 EXCNT BSS 1 SYMBOL COUNTER * LCNT BSS 1 CURRENT \LBUF COUNT DCNT BSS 1 CURRENT DBUF COUNT CURAI BSS 1 CURRENT IBUF COUNT * CPLS BSS 1 ADDRESS OF TOP OF FIXED CP LINK IMAGE CPL1 BSS 1 ADDRESS OF LOW CURRENT PAGE LINK SPECS. CPL1H BSS 1 NUMBER OF CURRENT PAGE LINKS ASSIGNED CPL2H BSS 1 IN LOW AND HIGH AREA RESPECTIVELY URBP1 BSS 1 LWA R/T DISC RES BP LINK AREA CURAK BSS 1 CURRENT KBUF ADDRESS * CURAT BSS 1 CURRENT \TBUF ADDRESS TCNT BSS 1 CURRENT \TBUF COUNT * CURAP BSS 1 CURRENT PLIST ADDRESS * AMAD BSS 1 CURRENT MLIST ADDRESS * IXCNT BSS 1  ID EXTENSION COUNT IDEXC BSS 1 CURRENT ID EXT'S USED IDEX BSS 1 ADDRESS OF ID EXTENSION TABLE * LICNT BSS 1 LONG ID SEGMENT COUNT SICNT BSS 1 SHORT ID SEGMENT COUNT SSCNT BSS 1 BG. SEG ID COUNT * DSKID BSS 1 DISK ID SEGMENT ADDRESS KEYCN BSS 1 TOTAL KEYWORD COUNT KEYCT BSS 1 CURRENT KEYWORD COUNT * MLIST BSS 11 MEMORY MAP BUFFER * TEMP1 BSS 1 TEMP2 BSS 1 LWH1 BSS 1 LWH2 BSS 1 LWH3 BSS 1 LWH4 BSS 1 L01 BSS 1 * FSYBP BSS 1 FIRST WORD SYS BP LINKAGE SYSAD BSS 1 CURRENT ID SEGMENT ADDRESS * TBREL BSS 1 CURRENT BP RELOC ADDR PBREL BSS 1 INITIAL BP RELOC ADDR * RELAD BSS 1 CURRENT CORE RELOCATION ADDRESS * BSBAD BSS 1 BG SEGMENT BP RELOC ADDR BSPAD BSS 1 BG SEGMENT PROG RELOC ADDR * LFLAG BSS 1 PROGRAMS-LOADED FLAG IMAIN BSS 1 CURRENT MAIN IDENT INDEX. HDFLG BSS 1 HEADING FORMAT FLAG CIDNT BSS 1 CURRENT MAIN IDENT INDEX. * AEQT BSS 1 ADDRESS OF EQUIPMENT TABLE CEQT BSS 1 NO. ENTRIES IN EQUIPMENT TABLE SPLCO BSS 1 SPOOL EQT COUNT DVMAP BSS 1 ADDRESS OF DRIVER MAP TABLE * DPFLG BSS 1 DP RELOCATION FLAG, 0=YES, -1=NO DPLN BSS 1 PAGE LENGTH OF DRIVER PARTITION DPADD BSS 1 START ADDR OF DRIVER PARTITION DSKDP BSS 1 DISK ADDRESS OF DP #2 PAGE# BSS 1 NEXT PHYSICAL PAGE TO ALLOCATE DPNUM BSS 1 CURRENT DP# -1, OR TOT DP PAGES SDID BSS 1 IDENT IDEX OF SYS DISK DRIVER LWDP1 BSS 1 LAST WORD OF DP, +1 FWSDA BSS 1 FIRST WORD OF SDA * ASQT BSS 1 ADDR OF DEVICE REFERENCE TABLE CSQT BSS 1 NO. ENTRIES IN DEV. REF. TABLE * AINT BSS 1 ADDRESS OF INTERRUPT TABLE * DSKIN BSS 1 DISK ADDR OF INT CODE RECORD INTCN BSS 1 RECORD COUNT OF INT CODE * IDSAV BSS 1 INDEX OF CURRENT IDENT. DSKMN BSS 1 INITIAL MAIN DISK ADDRESS BSSDP BSS 1 INITIAL DISK RES MAIN BSS DISP PRENT BSS 1 PRIMARY ENTRY POINT DBLAD BSS 1 CURRENT DBL ADDRESS REKEY BSS 1 INSTRUCTION TYPE BYTE INSCN BSS 1 INSTRUCTION TYPE COUNTER INSTR BSS 1 CURRENT INSTRUCTION PAGNO BSS 1 CURRENT PAGE NO. OPRND BSS 1 CURRENT OPERAND PLGTH BSS 1 PROGRAM LENGTH * DRT2 BSS 1 DISK DRT ENTRY ( SYSTEM) DRT3 BSS 1 AUX DISK DRT ENTRY * LIBFG BSS 1 LDTYP BSS 1 * SCH1 BSS 1 INDEX OF IDENT OF PGM TO BE SCHEDULED SCH3 BSS 1 ADDRESS OF CURRENT ID SEGMENT SCH4 BSS 1 ADDRESS OF THE SCHEDULED PGM ID SEG FGBGC BSS 1 BACKGROUND USING FG COMMON FLAG $LIBR BSS 1 INDEX OF $LIBR ENT $LIBX BSS 1 INDEX OF $LIBX ENT CUPRI BSS 1 * BLLO BSS 1 -(LOWER BUFFER LIMIT) BLHI BSS 1 -(UPPER BUFFER LIMIT) * MEM6 BSS 1 MEM12 BSS 1 * COMRT BSS 1 MAXIMUM RT COM LENGTH COMBG BSS 1 MAXIMUM BG COM LENGTH COMSZ BSS 1 #WORDS COMMON DECLARED IN CURRENT MAIN RTCAD BSS 1 RT COMMON ADDRESS BGCAD BSS 1 BG COMMON ADDRESS FPCOM BSS 1 FIRST PAGE OCCUPIED BY COMMON LPCOM BSS 1 LAST PAGE CONTAINING ANY COMMON * FPSAM BSS 1 1ST PAGE CONTAINING S.A.M. FWSAM BSS 1 1ST WORD CONTAINING S.A.M. SYMAD BSS 1 VALUE FOR AVMEM IN SCOM SAM#1 BSS 1 SIZE OF FIRST CHUNK OF SAM SAM#2 BSS 1 SIZE OF SECOND CHUNK OF SAM SAM2P BSS 1 START PAGE OF SAM #2 LWTAI BSS 1 LAST WORD OF TABLE AREA I FOR SAM#0 FWPRV BSS 1 FIRST WORD FOR PRIVILEGED PROGRAMS * FWSYS BSS 1 FIRST WORD OF SYSTEM CODE LPSYS BSS 1 LAST PAGE CONTAINING SYS LWSYS BSS 1 LAST WORD OF SYSTEM LPSLB BSS 1 LAST PAGE OF SLOW BOOT LWSLB BSS 1 LAST WORD OF SLOW BOOT MTYPE BSS 1 MAIN PROGRAMS'S TYPE * HIBP BSS 1 BP LINK MODE FOR FIXUP ENTRIES LOLNK BSS i1 LOW LINK FOR SSGA,LIB, OR SYS HILNK BSS 1 HI LINK USED BY MEM RES PRG BPINC BSS 1 BP LINK ALLOCATION MODE, -1=DOWN,1=UP BPLMT BSS 1 LAST AVAIL BP LINK IN CURRENT MODE, +1 * TPMAX BSS 1 HWM FOR RELOCATION OF BG MAINS & SEGS MAXPT BSS 1 NUM PARTS. ALLOWED MAT. BSS 1 ADDRESS OF MEMORY ALLOCATION TABLE * SSGA. BSS 1 FWA SSGA MAP. BSS 1 PTR TO MEU RES MAP MPFT. BSS 1 PTR TO MPFT * EMLNK BSS 1 EMA SYMBOL'S LINK EMLST BSS 1 LST INDEX OF EMA SYMBOL EMDSK BSS 1 DISK ADDR OF EMA PROGRAM * * MEMORY RESIDENT AREA POINTERS * MRACM BSS 1 MR ACCESS COMMON FLAG (>0 IF YES) LBCAD BSS 1 FIRST WORD OF MEMORY RES LIBRARY LEND BSS 1 LAST WORD OF MEMORY RES LIBRARY FWMRP BSS 1 FIRST WORD OF MEMORY RES PROGRAM AREA EMRP BSS 1 LAST WORD OF MEMORY RES PROGRAM AREA FPMRP BSS 1 FIRST PAGE OF MEMORY RES PROGRAM AREA FPMBP BSS 1 PAGE # FOR MEMORY RES BASE PAGE MRP# BSS 1 # PAGES OCCUPIED BY MRL & MRP'S DSKMB BSS 1 DISK ADDRESS OF MEMORY RES BASE PAGE DSKMR BSS 1 DISK ADDRESS OF MEMORY RESIDENT LIB/PROG AREA DSKBP BSS 1 SYSTEM DISK ADDRESS * DSKAV BSS 1 NEXT AVAILABLE DISK ADDRESS DSKLC BSS 1 DISK ADDRESS OF LIBRARY CODE DSKLB BSS 1 DISK ADDR OF LIBRARY ENTRY PTS DSKUT BSS 1 UTILITY PROG DISK ADDRESS DSKBS BSS 1 DISK ADDR OF MAIN BG DISK RES BP DSKBR BSS 1 CURRENT MAIN BG DISK RES DISK AD ADICT BSS 1 ADDR OF DISK DICTIONARY LBCNT BSS 1 RESIDENT LIBR ENTRY PT COUNT SYCNT BSS 1 SYSTEM ENTRY POINT COUNT KEYAD BSS 1 CURRENT KEYWORD ADDRESS * SYBAD BSS 1 ADDR OF FIRST BP LINK FOR BG IDSAD BSS 1 ADDR OF FIRST ID SEGMENT ABSID BSS 1 IDENT ADDR FOR NEXT BG SEG SCAN IDMBS BSS 1 BG MAIN ADDRESS FOR BS REF * * ********************************************************* * * * END OF COMMON STORAGE BLOCK FOR ALL SEGMENTS. * * * ********************************************************* * SPC 2 MRTAD DEF TPREL RBTAD DEF RBTA AMLST DEF MLIST AMEM5 DEF MLIST+5 AMEM8 DEF MLIST+8 SKP * * PROGRAM CONSTANT FACTORS N1 DEC -1 N3 DEC -3 N5 DEC -5 N8 DEC -8 N11 DEC -11 NDAY OCT 177574,025000 P1 DEC 1 P2 DEC 2 P3 DEC 3 P4 DEC 4 P5 DEC 5 P6 DEC 6 P7 DEC 7 P11 DEC 11 P12 DEC 12 P13 DEC 13 P14 DEC 14 P15 DEC 15 P16 DEC 16 P60 DEC 60 P99 DEC 99 P100 DEC 100 P6K DEC 6000 M7 EQU P7 M17 EQU P15 M20 EQU P16 M1760 OCT 176000 M1777 OCT 1777 M7400 OCT 177400 M7777 OCT 77777 * BLANK OCT 040 BLANK MSIGN OCT 100000 NEGATIVE SIGN SKP LODR NOP * * NOTE THE FOLLOWING RESOLVES ARITHMETIC DEF'S TO EXTERNALS * LDA N GET LOOP COUNTER STA TEMP1 SAVE IN TEMP LOCATION LDB LSTAA GET ADDRESS OF WHERE LIST ROUTINE LOCATED LOOP LDA B,I HERE WE CHASE DOWN OUR OWN RSS LDA A,I RAL,CLE,SLA,ERA JMP *-2 STA B,I AND SAVE IT AGAIN INB ISZ TEMP1 DONE? JMP LOOP NO JMP \SRET RETURN TO MAIN FOR CALL * TO \NLOD OR \LOAD. * SPC 1 N DEC -4 LSTAA DEF *+1 ATBUF DEF \TBUF+0 LBUF5 DEF \LBUF+5 ALBUF DEF \LBUF+0 DNDCB DEF \NDCB+0 SKP SKP * * INITIATE MAIN PROGRAM LOADING * * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB LOAD (FROM ANOTHER SEGMENT) * * RETURN: CONTENTS OF A AND B ARE DESTOYED. * \NLOD NOP LDA \PTYP GET RELOCATION TYPE CPA P5 IF A SEGMENT RSS JMP NONES JSsQB \LOAD THEN JUST CALL \LOAD AND RETURN JMP \NLOD,I * * INDICATE VALIDITY OF SSGA REFERENCES * NONES LDA \ID6,I TYPE AND M20 LOOK AT SSGA BIT STA SSGAF SET SSGA FLAG (0=NO SSGA USE) CCB STB HDFLG SET HEADING FLAG LDB \PREL PICK UP BASE ADDRESS LDA LIBFG IF LIB LOAD SZA JMP NOADD THEN IGNORE LDA \ID6,I GET TYPE AGAIN AND M7 JUST PRIMARY BITS CPA P1 IF MEMORY RESIDENT JMP ADD2 BUMP START ADDR CPA P2 AND IF PROG IS DISK RESIDENT JMP ADD2 CPA P3 (EITHER RT OR BG) JMP ADD2 CPA P4 ADD2 ADB P2 BUMP BY ENOUGH FOR * INDEX REG STORAGE NOADD STB TPREL LDA PBREL GET BP RELOCATION ADDRESS STA TBREL SET CURRENT BP RELOC ADDRESS JSB \LOAD LOAD PROGRAM LDA LIBFG IF NOT LIB LOAD SZA,RSS THEN JSB \SPAC NEW LINE JMP \NLOD,I RETURN SSGAF BSS 1 SKP * * LOAD, LINK MAIN PROG & SUBS. * * \LOAD IS THE MAIN LOADING SUBROUTINE FOR GENERATING THE ABSOLUTE * CODE AND LINKING ALL CALLED SUBROUTINES. IT IS USED BY EACH * PROGRAM TYPE FOR LOADING. IT READS THE RELOCATABLE RECORDS FROM * THE DESIGNATED FILE, AND WRITES THE ABSOLUTE CODE * INTO THE CORE-IMAGE OUTPUT FILE. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB LOADS (FROM ANOTHER SEGMENT) * * RETURN: CONTENTS OF A AND B ARE DESTOYED. * \LOAD NOP (WAS "LOADS") JSB SFIX SET UP A FIX UP ENTRY CCA STA PLFLG SET FLAG = NO DBL RECS IN * LOADN LDA TPREL CLEAR THE CP LINK IMAGE JSB CCPLK AREA LDA TPREL SAVE FOR RESET STA LWH4 FOR NEXT PASS LDA TBREL STA LWH3 CLA LOADX STA L01 * LDA LWH3 BP LINK LDB TBREL ADDRESSES  JSB CLRLT LDA LWH3 STA TBREL RESTORE TBREL JSB CLIST BLANK MEMORY MAP BUFFER CLA CLEAR THE LIBRARY TRAP STA ADTRP WORDS STA LIBTP LDA AMLST AMLST = ADDR OF MEM MAP BUFFER STA AMAD SET CURRENT MEMORY MAP ADDRESS LDA HDFLG GET HEADING FORMAT FLAG STA TEMP2 SSA,RSS SKIP IF NEGATIVE (MAIN) ISZ AMAD INCR CURRENT MEM MAP ADDR LDA \ID1,I GET NAME 1,2 STA AMAD,I SET NAME 1,2 IN MEMORY MAP ISZ AMAD INCR CURRENT MEMORY MAP ADDRESS LDA \ID2,I GET NAME 3 4 STA AMAD,I SET NAME 3,4 IN MEMORY MAP ISZ AMAD INCR CURRENT MEMORY MAP ADDRESS LDA \ID3,I GET NAME 5 AND M7400 ISOLATE UPPER CHAR IOR BLANK ADD BLANK (OCT 40) STA AMAD,I SET NAME 5 IN MEMORY MAP LDA \ID6,I PICK UP TYPE AND M177 AND ISOLATE CPA P13 IF TABLE AREA II TYPE RSS CPA P15 OR TABLE AREA I TYPE RSS THEN DON'T MASK BITS AND M7 MASK TO ACTUAL TYPE. STA LDTYP * * READ NAM RECORD. * LDA ALBUF READ NAM RECORD FROM FILE. STA \CURL CCB JSB \RNAM JSB \ABOR ERROR ON READ. SZA,RSS JSB \ABOR END OF FILE. CMA,INA SET COUNT WORD. STA LCNT * LDA \ID5,I CHECK IF NAM RECORD HAS RAL A MODIFIED VERSION. SSA,RSS JMP LOADC NO. * JSB RWNDF YES. SEARCH NEW NAM FILE DEF *+3 FOR REPLACEMENT RECORD. DEF \NDCB+0 DEF \FMRR+0 * LDA DNDCB GET DCB ADDRESS IN CASE OF ERROR JSB \CFIL JSB \ABOR * CREAD JSB READF DEF *+6 DEF \NDCB+0 DEF \FMRR+0 DEF \LBUF DEF P60 DEF LEN * LDA DNDCB GET DCB ADDRESS IN CASE OF ERROR JSB \CFIL JSXB \ABOR * LDA LEN BETTER BE THERE! CPA N1 JSB \ABOR * LDB ALBUF COMPARE NAM IN \LBUF ADB P3 LDA B,I AGAINST CPA \ID1,I NAM IN IDENT. INB,RSS JMP CREAD NO MATCH. LDA B,I CPA \ID2,I INB,RSS JMP CREAD NO MATCH. LDA B,I XOR \ID3,I AND M7400 SZA JMP CREAD NO MATCH. * LOADC JSB ZLOAD LOADING? JMP LH7 NO * LDA L01 SZA 1ST PASS? JMP LH7 YES * ISZ TEMP2 NO - TEST TEMPORARY HDFLG JMP SUBHD * JMP LH8 * LPAR OCT 50 LEFT PAREN. * LH7 ISZ HDFLG TEST REAL THING JMP SUBHD SKIP PRIORITY OUTPUT FOR SUB * LH8 LDA \ID6,I SET CURRENT LOAD TYPE AND M17 LOOK AT PRIMARY & REVERSE COMMON BITS CPA P5 DON'T CHANGE COMMON JMP COMOK FOR SEGMENTS (USE MAIN'S) LDB \ID4,I THIS IS A MAIN RBL,CLE,ERB GET RID OF M,S BIT STB COMSZ SET HIS COM SIZE AS LIMIT. LDB BGCAD GET BACKGROUND COMMON BOUND CPA P1 IF FORGROUND RSS CPA P2 RSS CPA P11 OR PRIVILEGED USING FORGROUND COMMON RSS CPA P12 OR BACKGROUND USING FOREGROUND COMMON LDB RTCAD USE FORGROUND COMMON ADDRESS STB COMAD SET THE COMMON BASE ADDRESS COMOK LDA \ADSK GET CURRENT DISK ADDRESS LDB L01 SZB,RSS IF 1ST PASS, STA DSKMN SAVE INITIAL MAIN DISK ADDRESS LDA \PTYP IF FOURCED SUBROUTINE AND M17 OR SSGA ROUTINE CPA P14 LOAD JMP SUBHD SEND SUB HEAD MAP * LDA LPAR GET LEFT PAREN (OCT 50) IOR AMAD,I CHANGE NAME 5, BLANK TO NAME 5,( STA AMAD,I SET NAME 5, LEFT PAREN IN MAP LDA \LBUF+10 GET PRIORITY FROM THE NAM RECORD SZA,RSS IF ZERO SET LDA P99 TO0 99 SZB,RSS UNLESS SYSTEM WHICH CLA SET TO ZERO STA CUPRI SET FOR THE ID-SEG GENERATION CMA,INA SET TO NEGATIVE FOR DECIMAL CONV LDB ATBUF GET MESSAGE ADDRESS JSB \CONV CONVERT TO DECIMAL/OCTAL LDA \TBUF+1 GET HIGH TWO CHARACTERS STA MLIST+3 SET IN MAP LDA \TBUF+2 GET 2 LEAST SIGNIFICANT DIGITS STA MLIST+4 SET PRIORITY IN MEMORY MAP LDA \LBUF+12 SET UP THE TIME PARAMETERS ASL 4 FIRST THE RESOLUTION LDB \LBUF+11 AND MULTIPLE BLS ASR 4 COMBINE STA \MULR SET FOR ID SEG GENERATOR LDA \LBUF+15 GET THE SECONDS MPY P100 CONVERT TO 10'S OF MS. ADA \LBUF+16 ADD 10'S OF MS. STA TEMP1 SAVE TEMP * LDA \LBUF+13 GET THE HOURS MPY P60 CONVERT TO MIN. ADA \LBUF+14 ADD MIN. MPY P6K CONVERT TO 10'MS CLE PREPARE FOR ADD ADA TEMP1 ADD 10'S MS. SEZ,CLE IF OVERFLOW INB STEP HIGH ORDER PART ADA NDAY+1 SUBTRACT ONE DAY OF 10'S MS. SEZ,CLE IF OVER FLOW INB STEP HIGH ORDER DIGIT ADB NDAY DST \TIME SAVE DOUBLE WORD \TIME FOR ID-SEG. * SUBHD LDA TPREL GET CURRENT PROG RELOC ADDR LDB AMEM5 SET B = ADDR OF MEMORY MAP + 5 JSB \CONV CONVERT TO DECIMAL/OCTAL LDA MLIST PUT A ")" IN THE CPA BLNKS HIGH PART OF THE JMP SUBH2 ADDRESS IF NOT A SUBHEAD * LDA MLIST+5 I.E. IF MAIN ADA B4400 CONVERT BLANK TO ) STA MLIST+5 RESTORE IT. SUBH2 LDA \LBUF+1 GET RIC ALF,RAR ROTATE TO LOW A AND M7 ISOLATE RIC CPA P1 NAM RECORD? RSS YES - CONTINUE JSB \ABOR INVALID DISK RECORD LDA \LBUF+6 GET PROGRAM LENGTH STA PLGTH SAVE PROGRAM LENGTH RAL,CLE,ERA REMOVE POSSIBLXE SIGN BIT ADA TPREL COMPUTE THE LAST WORD ADDRESS ADA N1 LDB AMEM8 AND JSB \CONV CONVERT TO THE MAP * * SET RELOCATION BASE FOR ORB STUFF SPC 1 JSB ZLOAD IGNORE IF A PSEUDO-LOAD OF AN MRP CLB,RSS LDB \LBUF+7 GET SIZE OF BASE PAGE CODE LDA BPINC AND FIGURE OUT IF WE'RE GOING SSA UP OR DOWN IN BASE JMP SUBH3 PAGE. SPC 1 LDA TBREL GOING UP, SET STA TPBRE ORB BASE AT TBREL ADB TBREL INCREMENT LINK BASE LDA BPLMT SUBTRACT LIMIT CMA,INA FROM ADA B NEXT ADDR TO CHECK FOR JMP SUBH4 BASE PAGE OVERFLOW. SPC 1 SUBH3 CMB,INB GOING DOWN...SUBTRACT ORB LENGTH ADB TBREL FROM LINK BASE INB ADD ONE STB TPBRE TO GET ORB BASE. ADB N1 GET NEXT AVAILABLE LINK ADDR. LDA B CMA,INA SUBTRACT NEW BASE FROM LIMIT ADA BPLMT TO CHECK FOR OVERFLOW. SPC 1 SUBH4 SSA,RSS IF LIMIT IS EXCEEDED, WE JMP E16RR HAVE AN ERROR. * CONLD STB TBREL BASE PAGE LDA TPBRE JSB SETBP SET PROGRAM BASE PAGE IMAGE TO -1 LDA \LBUF GET RECORD SIZE ALF,ALF LOW ORDER A STA \LBUF SAVE IN RIGHT HALF JSB ZLOAD LOADING? JMP NOLD NO, SKIP * LDA L01 FIRST PASS? SZA,RSS NO, DO MAP JMP NOMP YES, NO MAP * ISZ LFLAG BUMP THE LOADED FLAG NOP IN CASE OF LEAP LDA \ID5,I CHECK FOR "MAP MODULES". RAR SLA,RSS JMP NOMP NO. BIT 1 NOT SET. * LDB LBUF5 THE SIXTH WORD IN \LBUF LDA N11 NUMBER OF WORDS STA TCNT TO MOVE TO \LBUF LDA AMLST ADDRESS OF NAME BUFFER STA WDCNT SAVE FOR POINTER LH1 LDA WDCNT,I GET NAME WORD, AND ADDRESS STA B,I E) STORE IN \LBUF INB BUMP B ISZ WDCNT BUMP NAME ADDRESS ISZ TCNT ALL DONE? JMP LH1 NO, DO MORE * LDA BLNKS GET TWO BLANKS STA B,I PUT THEM IN \LBUF BEFORE THE COMMENTS LDA \LBUF GET RECORD SIZE ADA N5 REDUCE TO MAP LENGTH ALS TIMES 2 FOR CHARACTER COUNT LDB LBUF5 ADDRESS OF MAP AND COMMENTS JSB \MESS PRINT ALL * * THE FOLLOWING ROUTINES LINK A PROGRAM THROUGH CURRENT PAGE * LINKS WHEN POSSIBLE. THIS IS POSSIBLE WHEN THE LENGTH * OF THE PROGRAM IS KNOWN AND WHEN THE PROGRAM IS NOT AN * ASSEMBLED TYPE 2, 3, 4, OR 5 PROGRAM. * NOMP LDA \ID4,I COMPARE AND M7777 CMA,INA THIS MODULE'S COMMON ADA COMSZ DECLARATION TO MAIN'S SSA,RSS ERROR IF GREATER. JMP NOM2 LDA ERR54 CMA,INA JSB \GNER NOM2 LDA L01 1ST OF 2 PASSES? SSA JMP NOLD NO - 1 PASS ONLY * SZA,RSS IF PASS ONE JMP LH12 GO CHECK FOR OPTION SPC 1 LDA CPL1 PASS TWO SO SET UP THE NOW STA \CPL2 KILL THE UPPER AREA JSB \LNKS SET FOR DEFINING CODE JMP LH10 GO SET THE BOUNDRYS SPC 1 LH12 JSB GETCP SET UP A CURRENT PAGE LINK AREA STA CPL1 USE FOR BOTH CLA AREAS STA CPL1H CLEAR THE COUNT WORDS STA CPL2H LDB \ID5,I DOES OPERATOR WANT CURRENT PAGE SSB LINKS IF POSSIBLE? IF YES - JMP LH222 GO SET UP * LH2 CCA JMP LOADX RESTART SPC 1 LH222 LDA PLGTH SSA,RSS NO CURRENT PAGE LINKS LDA LDTYP IF ASSEMBLED TYPE 2, 3,4, OR 5 CPA P2 JMP LH2 CPA P3 JMP LH2 CPA P4 JMP LH2 CPA P5 JMP LH2 * LDA TPREL GET ADDR STA B OF LAST WD IOR M1777 OF PAGE ̣NLH SPC 1 CMB,INB COMPUTE # WDS INB REMAINING ADB A ON PAGE STB TEMP2 SPC 1 LDA PLGTH COMPUTE # WDS RAL,CLE,ERA OF PROGRAM CMB,INB THAT FALL ADB A BEYOND THIS STB TEMP1 PAGE SPC 1 SSB PROGRAM FIT ON RSS THIS PAGE? SZB,RSS NO - SKIP JMP NOLOW YES GO SET UP THE HIGH AREA SPC 1 LDA TEMP2 COMPUTE MINIMUM OF: ARS HALF # WDS OF PROG CMB,INB ON CURRENT PAGE-OR- ADB A # WDS OF PROG ON SSB,RSS NEXT PAGE SPC 1 LDA TEMP1 DIVIDE THIS CLB MINIMUM BY DIV P4 FOUR SZA,RSS IF NON-ZERO, USE AS SIZE JMP NOLOW OF LOW CURRENT PG LINK BUFF RSS SPC 1 LH10 LDA CPL1H GET PASS ONE DEFINED LENGTH LDB LWH4 SET NEW STB \LNK1,I LOWER LINK ADDRESS ADB A AND UPPER LIMIT STB TPREL OF LINK BUFFER STB \LNK2,I (ALSO PROGRAM LOAD ADDRESS) N JSB CLRCP CLEAR THE CURRENT PAGE IMAGE SPC 1 JSB GETCP GET ANOTHER CP LINK AREA LDA PLGTH GET PROGRAM LENGTH RAL,CLE,ERA STRIP POSSIBLE SIGN BIT ADA TPREL ADD THE BASE ADDRESS STA \LNK1,I SET ORGION OF HIGH LINK AREA IOR M1777 TOP IS INA FIRST WORD OF STA \LNK2,I NEXT PAGE JSB CLRCP GO CLEAR THE ALLOCATED AREA CLA CLEAR THE UPPER COUNT WORD STA CPL2H * NOLD LDB TPREL GET PROGRAM RELOCATION BASE STB RELAD SET CURRENT RELOCATION ADDRESS * * CLASSIFY ENT, EXT, DBL, END RECS * CCA FORCE FILE READ. STA LCNT CLSR1 JSB DBSET GET FIRST WORD IN RECORD. CLSRC LDA \CURL,I SAVE THE RECORD LENGTH FOR STA \TBUF DBL SKIP ROUTINE JSB DBSET GET ADDR OF NEXT WORD IN \LBUF LDA \CURL,I GET SECOND WORD IN RECORD LDB A SAVE WORD IN B ALF,RAR ROTATE RIC TO LOW A AND M7 ISOLATE RIC CPA P2 ENT RECORD? JMP DENTR PROCESS ENT RECORD CPA P3 DBL RECORD? JMP DDBLR PROCESS DBL RECORD CPA P4 EXT RECORD? JMP DEXTR PROCESS EXT RECORD CPA P6 EMA RECORD? JMP EMAR PROCESS EMA DECLARATION CPA P5 END RECORD? RSS YES - PROCESS END RECORD JSB \ABOR INVALID DISK RECORD * JSB ZLOAD LOADING? JMP CLSTX NO * NOLOW LDA L01 IF FIRST OF SSA,INA IF NOT CURRENT PAGE LINKING JMP PEND JUST GO END IT * CPA P1 IF PASS ONE JMP CPRST GO DO PASS TWO * * PASS TWO OUTPUT THE CP LINK AREAS AND UPDATE. * LDA CPL1 OUTPUT THE JSB OUTCP LOW AREA LDA \CPL2 SET UP FOR THE JSB \LNKS HIGH AREA LDA CPL2H GET THE NUMBER ALLOCATED ADA \LNK1,I AND COMPUTE[ THE UPPER LIMIT STA \LNK2,I SET THE ACTUAL VALUE LDA \CPL2 NOW JSB OUTCP OUTPUT THE LINKS * PEND JSB DBSET GET ADDR OF NEXT WORD IN \LBUF JSB DBSET GET ADDR OF NEXT WORD IN \LBUF LDA TPREL GET CURRENT PROG RELOCATION BASE ADA \CURL,I ADD RELOCATION ADDRESS LDB HDFLG GET HEADING FLAG SZB,RSS SKIP UNLESS MAIN STA PRENT SAVE PRIMARY ENTRY POINT FOR ID CLSTX JSB \ILST INITIATE \LSTX CLST JSB \LSTX SET LST ADDRESSES JMP LSTCR END OF LST * LDA \LST3,I GET WORD 3 OF \LST (ORDINAL) AND M7400 ISOLATE UPPER CHAR - CLEAR ORD STA \LST3,I SET NAME 5 IN \LST JMP CLST CONTINUE CLEARING ORDINALS * LSTCR JSB ZLOAD WAS CURRENT PGM LOADED? JMP PLSCM NO SKIP ADDRESS UP DATE * LDA PLGTH GET PROGRAM LENGTH RAL,CLE,ERA SET E = SIGN ADA TPREL ADD PROGRAM RELOCATION BASE ADA CPL2H REFLECT ANY CURRENT PAGE LINKS STA TPREL ALLOCATED LDB \ID5,I CHECK FOR "MAP LINKS" LDA TBREL CURRENT BP ADDRESS. RBR,RBR IF BIT 2 SLB IS SET JSB BPLNR REPORT THE BP LINKAGE * * SCAN FOR MODULES LEFT TO LOAD * PLSCM JSB \INID SCAN THE PLSCN JSB \IDX IDENTS FOR MODULES JMP CLFLG LEFT TO LOAD NONE SO GO EXIT * LDA \ID3,I GET THE FLAG WORD SLA,INA IF ALREADY LOADED JMP PLSCN TRY THE NEXT ONE * RAR,SLA,RAL IF MUST LOAD FLAG SET JMP ENTID GO LOAD IT * JMP PLSCN ELSE GO TRY NEXT IDENT. * * ENTID STA \ID3,I SET THE LOADED FLAG AND GO LOAD. JMP LOADN (\RNAM WILL CLOSE THE OLD FILE) * CLFLG CCA HANDLE ZERO LENGTH PROGRAMS. ADA TPREL FILL FINAL BSS. STA TEMP1 CMA,INA LDB \MXAB ADA B,I SSA,RSS JMP BPCNT CLA LDB TEMP1 JSB \ABDO  * * DON'T CLEAR LOAD FLAGS IF POSSIBLY A SEGMENTED PROGRAM * BPCNT LDA \PTYP GET CURRENT PROGRAM TYPE CPA P3 TYPE = PR DISK RESIDENT? RSS CPA P4 OR BG DISK RESIDENT RSS CPA P2 OR RT DISK RESIDENT JMP \LOAD,I YES - DO NOT CLEAR LOADED FLAGS * JSB CLID3 CLEAR PROG-LOADED FLAGS JMP \LOAD,I RETURN - ALL FLAGS CLEARED * E16RR LDA ERR16 PRINT BP OVFLOW JSB \GNER MESSAGE LDB BPINC USE LIMIT CMB,INB +1 OR -1 AS BASE ADB BPLMT PAGE BASE (DEPENDS ON WHETHER * WE'RE GOING UP OR DOWN * ALLOCATING LINKS JMP CONLD CPRST LDB CPL1H SET UP THE NEW TPREL ADB LWH4 USE SUM OF OLD AND USED LINKS STB TPREL SET NEW ADDRESS JMP LOADX GO START THE FINAL PASS SPC 1 ERR54 ASC 1,54 ERR16 ASC 1,16 LEN NOP P30 DEC 30 M37 OCT 37 M77 OCT 77 M100 OCT 100 M177 OCT 177 M377 OCT 377 M0760 OCT 076000 M2000 OCT 2000 M1177 OCT 101777 N6 DEC -6 SKP * PROCESS ENT/EXT RECORDS DENTR CCA,RSS SET ENT FLAG AND SKIP DEXTR CLA SET EXT FLAG STA NXFLG SAVE ENT/EXT FLAG LDA B GET NO. ENTRIES IN EXT/ENT AND M37 ISOLATE SYMBOL COUNT CMA,INA STA EXCNT SET SYMBOL COUNTER JSB DBSET GET ADDR OF NEXT WORD IN \LBUF JSB DBSET GET ADDR OF NEXT WORD IN \LBUF NXSYM LDA \CURL,I GET NAME 1,2 STA \TBUF SAVE NAME 1,2 IN TEMP BUFF JSB DBSET GET ADDR OF NEXT WORD IN \LBUF LDA \CURL,I GET NAME 3,4 STA \TBUF+1 SAVE NAME IN TEMP BUFF JSB DBSET GET ADDR OF NEXT WORD IN \LBUF LDA \CURL,I GET NAME 5 STA \TBUF+2 SAVE NAME IN TEMP BUFF JSB DBSET GET ADDR OF NEXT WORD IN \LBUF LDB ATBUF GET ADDRESS OF SYMBOL JSB \LST}S SET LST ADDRESSES JSB \ABOR ENT/EXT NOT FOUND IN LST * LDA NXFLG GET ENT/EXT FLAG SZA,RSS SKIP IF ENTRY JMP EXT1 PROCESS EXT * * PROCESS ENT * JSB ZLOAD IF NOT LOADING CURRENT PGM JMP NLENT SKIP LINK AND MAP * LDA \LST4,I IF THIS ENT IS SELF DEFINING ADA N6 SKIP IF PROGRAM * * EMA?? * SSA OR BASE PAGE RELOCATABLE JMP NLENT GO DO SELF DEFINING THING * LDA \TBUF+2 GET THE RELOCATION AND P7 INDICATOR ADA MRTAD RELOCATE THE LDB A,I SYMBOL ADB \CURL,I ADD CURRENT RELOCATION VALUE STB OPRND SAVE ABS ENTRY PT. ADDRESS STB \LST5,I SET VALUE IN THE \LST LDA L01 IF 1ST OF TWO SZA,RSS PASSES, SKIP JMP NLENT THE MAP AND FIX UP * LDA \ID5,I CHECK FOR "MAP GLOBALS". SLA,RSS SKIP - BIT 0 SET (LIST ENTS). JMP MLENT SUPPRESS PRINTING OF ENTS. * JSB CLIST CLEAR MEMORY MAP BUFFER LDA BLAST GET BLANK, ASTERISK STA MLIST+1 SET IN MAP LDA \LST1,I GET NAME 1,2 STA MLIST+2 SET IN MEMORY MAP LDA \LST2,I GET NAME 3,4 STA MLIST+3 SET IN MEMORY MAP BUFFER LDA \LST3,I GET NAME 5 AND M7400 ISOLATE UPPER CHAR IOR BLANK SET LOWER CHARACTER = BLANK STA MLIST+4 SET NAME 5 IN MEM MAP LDA \LST5,I GET ABSOLUTE ENTRY PT. ADDRESS LDB AMEM5 GET ADDRESS OF MESSAGE JSB \CONV CONVERT TO DECIMAL/OCTAL LDA P16 LDB AMLST GET ADDRESS OF MEM MAP BUFFER JSB \MESS PRINT ENTRY POINT * MLENT JSB DAFIX **FIX UP ALL REFERENCES TO THIS SYMBOL **** NLENT JSB DBSET GET ADDR OF NEXT WORD IN \LBUF JMP EXEND PROCESS NEXT SYMBOL * EXT1 CCA SAVE CURRENT IDENT INDEX. ADA \TIDN STA \TBUF LDA \TBUF+2 GET ORDINAL  STA \LST3,I SET ORDINAL IN \LST * LDA \LST4,I GET IDENT INDEX SZA IF ENTRY NOT DEFINED CPA P2 JMP LIBTS CPA P3 OR SELF-DEFINING RSS THEN CPA P4 SKIP THE LOAD JMP LIBTS AND JUST CONTINUE CPA P5 OR UNDEFINED JMP LIBTS CPA P6 JMP EMAX CHECK PROPER REFERENCE TO EMA * REFI STA \TIDN SET ID INDEX FOR \IDX STA \TBUF+3 SAVE FOR LATER. * * GET REFERENCED IDENT JSB \IDX SET IDENT ADDRESSES JSB \ABOR IDENT NOT FOUND IN LIST LDA \ID6,I GET TYPE AND M177 ISOLATE IT STA B SAVE IT LDA \ID4,I GET M/S BIT AND MSIGN ADA B MERGE TYPE STA \TBUF+1 SAVE M/S, TYPE LDA \ID3,I GET PROGRAM USAGE FLAG STA \TBUF+2 SAVE USAGE FLAG * * RESTORE CURRENT IDENT LDA \TBUF GET CURRENT IDENT INDEX STA \TIDN SET CURRENT IDENT INDEX. JSB \IDX SET IDENT ADDRESSES JSB \ABOR CURRENT IDENT NOT FOUND IN LIST LDA \TBUF+1 GET M/S, TYPE FOR EXT REFERENCE RAL,CLE,ERA SET E = M/S * CPA P30 JUMP IF SSGA MODULE JMP CKSSC * SZA,RSS IF SYSTEM REFERENCE JMP SYSRF GO CHECK FOR PROPER CALLER CPA P16 OR REFERENCE TO CONFIGURATOR JMP SYSRF SAME CHECKS * * CPA P14 IF REFERENCE TO LIBRARY * RSS * CPA P6 ROUTINES * JMP LIBRF CHECK FOR MRL OR MR PROG'S * EXT23 CPA P7 TYPE = UTILITY? JMP UTLRF YES - TEST FOR LEGALITY OF REFERENCE * SEZ SKIP - NOT MAIN PROGRAM JMP EXEND IGNORE PROGRAM CALL LIBUT LDA \TBUF+2 GET PROGRAM USAGE FLAG OF EXT REF SLA SKIP - PROGRAM NOT LOADED JMP EXEND OMIT PROGRAM LIST ENTRY * LDA \TIDN SAVE CURRENT IDENT INDEX. ADA N1 STA \TBUF LDA \TBUF+3 GET BACK TO REFERENCED IDENT. STA \TIDN JSB \IDX JSB \ABOR LDA \TBUF+2 LDB \PTYP IF BACK GROUND SEGMENT CPB P5 THEN IOR P4 SET THE BS FLAG IOR P2 SET THE MUST LOAD FLAG STA \ID3,I RESTORE THE FLAG TO THE IDENT LDA \TBUF RESTORE CURRENT IDENT STA \TIDN INDEX JSB \IDX AND ADDRESSES. JSB \ABOR MUST BE THERE. * EXEND ISZ EXCNT SKIP - ALL SYMBOLS PROCESSED JMP NXSYM NO - PROCESS NEXT SYMBOL * JMP CLSRC NO - CLASSIFY NEXT RECORD * * CHECK FOR LEGALITY OF TYPE 7 UTILITY REFERENCE * UTLRF LDA \PTYP GET CURRENT LOAD TYPE CPA P30 OKAY IF SSGA JMP LIBUT AND M7 ISOLATE CPA P6 IF LIBRARY RSS THEN ERROR JMP LIBUT OTHERWISE, OKAY * * CHECK LEGALITY OF TYPE 6 OR 14 LIBRARY REFERENCE * *LIBRF LDA \PTYP GET CURRENT LOAD TYPE * CPA P30 IF SSGA - THEN ERROR * JMP CALER SINCE IT CAN'T REF MRL * AND M7 MASK TO PROG CLASS * CPA P6 IF ANOTHER LIBRARY ROUTINE * JMP EXT23 (6 OR 14), THEN OKAY * CPA P1 SO IS ANY MEMORY * JMP EXT23 RESIDENT PROG * CALER LDA ERR15 SET ERROR CODE - ILLEGAL CALL * REFRR CMA,INA COMPLEMENT SO NO TR,ERRLU DONE JSB \GNER PRINT THE NO-NO LDA P5 NOW TELL 'EM THE REFERENCEE LDB \LST1 GET ASCII ADDRESDS JSB \MESS AND DISPLAY JSB \SPAC JMP EXEND TEST FOR ANOTHER * ERR15 ASC 1,15 ERR52 ASC 1,52 ERR58 ASC 1,58 * * MAKE SURE PROGRAM HAS SSGA PRIVILEGES * CKSSC LDB SSGAF GET FLAG SZB IF SET, THEN JMP EXEND JUST CONTINUE LDA ERR52 ELSE SEND ERROR MSG JMP REFRR * * CHECK LEGALITY OF SYSTEM REFERENCE * SYSRF LDA \PTYP GET CURRENT LOAD TYPE SZA IF SYSTEM CPA P30 OR SSGA RSS THEN REFERENCE IS OK CPA P16 AS IS SLOW BOOT JMP EXT23 CONTINUE CPA P15 TABLE AREA I IS JMP EXT23 OKAY CPA P13 TABLE AREA II IS JMP EXT23 OKAY LDA MTYPE GET MAIN PROGRAM TYPE AND M7 CPA P3 BG PRIVILEGED PROGRAMS ONLY JMP EXT23 HAVE VALID REFERENCES * LDA ERR58 ILLEGAL SYSTEM REFERENCE JMP REFRR SEND THE DIAGNOSTIC * LIBTS LDA LIBFG LOADING MEM. RES. LIB? CLE,SZA,RSS JMP EXEND NO SO SKIP * LDA \TLST YES,SET UP LIB REPLACE CODE. ADA N1 CLB,CLE CPA \PRV REFERENCE TO .ZPRV? CLB,CCE,INB YES SET FLAGS CPA \RNT REFERENCE TO .ZRNT? CCB,CCE YES SET FLAGS SEZ,RSS IF NEITHER JMP EXEND TREAT NORMALLY * STB LIBTP ELSE SET THE TRAP FLAG STA TRPLB AND LST INDEX JMP EXEND AND CONTINUE * * PROCESS EXTERNAL REF TO EMA SYMBOL * EMAX LDA IDSAV IS THIS A VALID RERERENCE CPA \LST5,I TO AN EMA? JMP REFI YES - IT BELONGS TO THE CURRENT PROG * LDA ERR42 NO - INVALID EMA PROGRAM TYPE, OR A JMP REFRR NON-EMA PROGRAM, OR THE WRONG EMA SYMBOL * ERR42 ASC 1,42 SKP * * SKIPR LDA \TBUF SKIP A DBL RECORD ALF,ALF GET SAVED RECORD LENGTH CMA,INA AND SET NEGATIVE INA SKIP THE LENGTH STA \TBUF SET FOR COUNTER SKIPX JSB DBSET SKIP A WORD ISZ \TBUF DONE? JMP SKIPX NO DO NEXT ONE. * JMP CLSRC YES GO GET NEXT RECORD SKP * * PROCESS DBL RECORDS * DDBLR JSB ZLOAD IF NOT LOADING JMP SKIPR SKIP TO END * LDA B GET COUNT AND M77 ISOLATE COUNT CMA,INA STA EXCNT SET INSTRUCTION COUNT LDA B COMPUTE THE RECORDS  AND M100 RELOCATION LDB TPREL GET THE MAIN RELOCATION BASE SZA,RSS IF BASE PAGE LDB TPBRE REPLACE WITH BP BASE STB DBLAD AND SET THE RECORD BASE ADDRESS JSB DBSET GET ADDR OF NEXT WORD IN \LBUF JSB DBSET GET ADDR OF NEXT WORD IN \LBUF * LDB \CURL,I GET RELOCATION ADDRESS ADB DBLAD RELOCATE THE RECORD ADDRESS STB DBLAD SAVE RELOCATION ADDRESS LDB \ID7,I GET FIRST DBL ADDRESS ISZ PLFLG SKIP - FIRST DBL RECORD JMP DBL0 IGNORE SUBSEQUENT RECORDS * * COME HERE ON FIRST BSS OF MODULE * IF MODULE IS A SEGMENT THEN DON'T * STORE BSS ON DISK SINCE IT ONLY * INDICATES ADDRESSES SHARED WITH THE MAIN * CLA STA BSSDP ZERO LOAD POINT OFFSET LDA \ID6,I AND M17 GET PRIMARY MODULE TYPE CPA P5 RSS ADJUST LOAD PT FOR SEG JMP DBL0 START FROM REL LOC 0 * FOR ALL OTHERS STB BSSDP SAVE INITIAL PROG DISPLACEMENT LDA \ABCO ADB A,I DISC /CORE STB A,I BASE ADDRESS LDA \MXAB STB A,I AND THE MAX ADDRESS DBL0 JSB DBSET GET ADDR OF NEXT WORD IN \LBUF DBL1 LDB \CURL,I GET RELOCATION BYTES STB REKEY SAVE FOR RELOCATION TYPE LDA N5 STA INSCN SET RELOCATION BYTE COUNT JSB DBSET GET ADDR OF NEXT WORD IN \LBUF * DBL2 LDA REKEY GET RELOCATION BYTES ALF,RAR ROTATE TO LOW A STA REKEY SAVE FOR NEXT INSTRUCTION WORD AND M7 ISOLATE CURRENT BYTE STA LSTOS *TEMP* SAVE DBL TYPE CPA P4 EXTERNAL,EMA REFERENCE? JMP DBL4 YES - RESOLVE OR FIXUP * CPA P5 MEMORY REFERENCE? JMP DBL5 YES - CHECK FOR INDIRECT LINK * CPA P6 BYTE ADDRESS? JMP DBL6 YES - GO CACULATE THE ADDRESS. * ADA RBTAD ADD RELOCATION BASE TABLBE ADDR LDB A,I GET RELOCATION BASE ADB \CURL,I ADD CURRENT INSTRUCTION WORD CLA CLEAR THE INSTRUCTION JMP DBL42 AND GO JOIN THE TYPE 4 PROCESSOR * DBL6 LDA \CURL,I GET THE INSTRUCTION WORD IOR M2000 SET THE INTERNAL BYTE FLAG BIT JMP DBL56 JOIN THE DBL 5 CODE * DBL33 JSB DBSET GET ADDR OF NEXT WORD IN \LBUF ISZ EXCNT SKIP - LAST INSTRUCTION OUT RSS NO - CONTINUE JMP CLSRC YES - CLASSIFY NEXT RECORD ISZ DBLAD INCR DBL RELOCATION ADDRESS ISZ INSCN SKIP IF NEW RELOCATION BYTE JMP DBL2 NO - PROCESS NEXT INSTRUCTION JMP DBL1 YES - GET NEXT RELOCATION BYTE * * * PROCESS DBL EXT RECORD * DBL4 LDA \CURL,I GET CURRENT DBL WORD AND NT2K CLEAR THE CURRENT PAGE BIT CLB SET OFFSET TO ZERO DBL42 STA INSTR SAVE THE INSTRUCTION WORD JMP DBL54 GO TO TYPE 5 RECORD HANDLER * DBL5 LDA \CURL,I GET CURRENT DBL WORD AND NT2K CLEAR THE CURRENT PAGE BIT DBL56 STA INSTR SAVE INSTRUCTION CODE JSB DBSET GET ADDR OF NEXT WORD IN \LBUF LDB \CURL,I GET ADDRESS TO B LDA INSTR GET THE INSTRUCTION ALF,RAL SET E ELA IF A BYTE ADDRESS LDA INSTR GET INSTRUCTION CODE AND P3 ISOLATE THE MR FIELD ADA MRTAD INDEX INTO THE BASE TABLE ADB A,I RELOCATE THE ADDRESS SEZ IF BYTE ADDRESS THEN ADB A,I DOUBLE THE ADDRESS LDA INSTR GET THE INSTRUCTION WORD AGAIN ARS,ARS MOVE ORDINAL TO LOW A. * * DBL TYPE 4 JOINS HERE * DBL54 AND M377 ISOLATE THE ORDINAL STA \FIX4,I SAVE ORD IN \FIX UP TBL (TEMP). STB \FIX3,I SAVE THE OFFSET/ ADDRESS LDA INSTR GET THE INSTRUCTION AGAIN AND M1760 ISOLATE THE OP CODE AND IOR HIBP MERGE BP LINK FLAG FOR FIXUP IOR LSTOS z AND MERGE DBL RECORD TYPE STA \FIX2,I PUT IT IN THE \FIXUP TABLE LDA DBLAD GET THE RECORD ADDRESS STA \FIX1,I SET THE CORE ADDRESS IN THE TABLE LDA \FIX4,I GET THE ORDINAL SZA,RSS IF NONE JMP DBL57 GO OUTPUT THE INSTRUCTION * JSB LSTOS LOOK FOR ORDINAL IN LST'S JSB \ABOR HALT IF NOT THERE * LDA \TLST GET THE LST ENTRY INDEX ADA N1 LDB LIBFG GET THE LIB FLAG SZB,RSS IF NOT LOADING CORE RES LIB JMP DBL45 JUST CONTINUE * CPA TRPLB ELSE IS THIS A REFERENCE TO .ZRNT,.ZPRV ? RSS YES SKIP JMP DBL45 NO, CONTINUE * LDA $LIBR YES USE $LIBR INDEX INSTEAD STA \TLST JSB \LSTX JSB \ABOR LDA \FIX1,I GET THE CORE ADDRESS INA AND SET THE ADDRESS STA ADTRP TRAP LDA N3 STA ADTPF SET FOR FIRST ADDRESS DBL44 LDA \TLST GET NEW LST ENTRY AND CONTINUE DBL45 SZA,RSS 0 MEANS .ZRNT INDEX CCA SO SET A SPECIAL, DONT WANT 0 STA \FIX4,I \FIX UP TABLE LDA \LST4,I GET THE DEFINITION ADDRESS CPA P3 IF PREDEFINED RSS THEN GO CPA P4 SEND RSS CPA P5 OR UNDEFINED (NOP'ED) JMP DBL57 THE INSTRUCTION CPA P6 EMA? JMP DBL57 SEND INSTR CPA P2 JMP DBL58 GO ADJUST FOR COMMON * LDA \LST5,I ELSE IF SYMBOL CCE,SZA IS DEFINED JMP DBL57 GO SEND IT * DBL60 LDA L01 IF NOT LOADING SZA SKIP THE FIX ENTRY JSB SFIX UNDEFINED SYMBOL MAKE FIX ENTRY CCA MAKE SURE FIX ENTRY IS STA \FIX1,I FLAGED PROPERLY JMP DBL33 GO GET NEXT ENTRY * DBL57 LDA \FIX1,I GET THE ADDRESS CPA ADTRP THIS A TRAP ADDRESS RSS YES SKIP JMP DBL61 NO, DO NORMAL LOAD *  LDA ADTPF GET TRAP REASON FLAG INA,SZA,RSS LAST TRAP OF THREE? JMP ADDX1 YES GO DO X+1 THING * INA,SZA,RSS X ADDRESS? JMP ADDX YES GO DO X ADDRESS THING * LDA \TFIX SAVE INDEX OF ADA N1 THIS FIX-UP STA \TBUF+3 ENTRY. CLA MUST BE P+1 TRAP STA \FIX4,I SET LST \FIX INDEX TO ZERO ISZ ADTPF SET FOR X ADDRESS NEXT TRAP LDB \FIX3,I GET ADDRESS FROM \FIX LST STB ADTRP SET FOR NEXT STA \FIX3,I SET TO NOP INCASE NOT RENT LDA LIBTP GET FLAG THAT TELLS INA,SZA,RSS IF .ZRNT JMP DBL60 GO MAKE FIX ENTRY * DBL61 CCB SIGNAL CLEARING OF FIXUP ENTRY JSB DFIX SEND THE INSTRUCTION JMP DBL33 GO GET THE NEXT ENTRY * DBL58 LDA COMAD ENTRY POINT IS IN COMMON ADA \FIX3,I SO \FIX THE STA \FIX3,I THE OFFSET JMP DBL57 AND OUTPUT THE INSTRUCTION * ADDX STA \FIX3,I ZAP THE OFFSET ISZ ADTRP SET FOR NEXT TRAP ISZ ADTPF TRAP NEXT ADDRESS (X+1) LDA $LIBX REPLACE THIS ONE WITH STA \TLST $LIBX INDEX. JSB \LSTX SET IT UP JSB \ABOR LDA JSB SET INSTRUCTION IOR HIBP MERGE BP LINK BIT STA \FIX2,I TO A JSB JMP DBL44 GO SEND IT * NT2K OCT 175777 JSB JSB 0 * ADDX1 STA ADTRP CLEAR ALL TRAPS STA ADTPF LDB LIBTP GET TYPE FLAG INB,SZB IF .ZPRV JMP DBL61 JUST SEND THE WORD * INA SET TO FORCE A FIX IN DAFIX STA \TLST WHERE FIX4,I = 0 LDA \FIX3,I GET THIS DEF STA FIXTP SAVE FOR OTHER ENTRY. LDA \TBUF+3 GET BACK TO THE STA \TFIX JSB \FIX OTHER \FIX-UP ENTRY. JSB \ABOR LDA FIXTP SET DEF IN THAT ENTRY. STA \FIX3,I JSB DAFIX GO SEND BOTH INSTRUCTIONS JMP DBL33 GET THE NEXT/A INSTRUCTION SKP * * PROCESS AN EMA RECORD (DECLARATION VALID) * EMAR CCE TELL ALLOC NOT TO SCAN FOR A LINK, JSB ALLOC JUST TO GO AND GET ONE STA EMLNK AND SAVE IT JSB DBSET JSB DBSET * LDB \CURL POSITION TO WORD 4 OF RECORD JSB \LSTS AND FIND EMA SYMBOL IN LST JSB \ABOR NOT THERE! CCA GET ITS LST INDEX ADA \TLST AND SAVE AS THE STA EMLST "CURRENT" EMA SYMBOL * JSB DBSET JSB DBSET POSITION TO WORD 6 LDA \CURL,I AND GET THE SYMBOL&'S STA \LST3,I ORDINAL AND SET IN LST JSB DBSET POSITION TO WORD 7 JMP CLSR1 CONTINUE WITH NEXT RECORD SKP * * ZLOAD NOP TEST FOR LOADING CURRENT PGM LDA LIBFG LIB LOADING? SZA,RSS JMP *+3 NO; THEN LOADING - GO STEP ADDRESS LDA P6 YES; CURRENT PGM TYPE=6? CPA LDTYP LDTYP CONTAINS THE LOW 3 BITS OF TYPE ISZ ZLOAD LIB AND SIX OR NOT LIB STEP ADDRESS JMP ZLOAD,I RETURN SPC 1 FIXTP NOP TRPLB NOP LIBTP NOP ADTRP NOP ADTPF NOP BLAST ASC 1, * BLANK,ASTERISK HED RTGN4 - LOADER SEGMENT SUBROUTINES. * * LSTOS - SEARCHES LST'S FOR ONE WITH ORDINAL MATCHING * \FIX4,I * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * * RETURN SEQUENCE: CONTENTS OF A AND B DESTROYED. * (N+1): CURRENT LST POINTERS SET UP FOR LAST LST. * ORDINAL NOT FOUND. * (N+2): CURRENT LST POINTERS SET TO LST CONTAINING * DESIRED ORDINAL. * LSTOS NOP JSB \ILST RESET TO START OF LST. LSTO2 JSB \LSTX SET ADDRS FOR NEXT ENTRY. JMP LSTOS,I IF AT END, TAKE FAILURE EXIT. * LDA \FIX4,I COMPARE ORDINALS. XOR \LST3,I AND M377 SZA JMP LSTO2 NO MATCH: TRY NEXT ENTRY. ISZ LSTOS NATCH: TAKE SUCCESS EXIT. JMP LSTOS,I SKP * DFIX DOENLHS THE FIX UP POINTED TO BY THE CURRENT FIX UP * TABLE AND LST ENTRYS. DFIX IS USED FOR ALL * INSTRUCTIONS AND MAY BE CALLED ONLY * AFTER THE SYMBOL (IF ANY) IS DEFINED. * * NOTE: THIS IS AN ENHANCED VERSION OF THE DFIX IN SEGMENT 5 * * CALLING SEQUENCE: * * SET UP FIX1-4 AND LST1-5 FOR THE ENTRY * * JSB \FIX * * RETURN THE FIX ENTRY IS FREE, A/B MEANINGLESS * DFIX NOP STB CLEAR SAVE FIXUP CLEARING FLAG CCB,CLE SET THE NOT BP LINK STB BPONL FLAG LDA \FIX4,I IF NO SZA,RSS LST INDEX JMP VFIX USE ZERO VALUE * WILL BE -1 FOR .ZRNT INDEX * BUT NO PROBLEM SINCE IT IS * A REPLACE OPERATION * LDA \LST5,I GET THE SYMBOL VALUE LDB \LST4,I GET THE SYMBOL TYPE CPB P4 IS REPLACEMENT SYMBOL JMP ZFIX GO DO REPLACEMENT CPB P5 UNDEFINED? JMP ZFIX REPLACE WITH A NOP CPB P6 EMA? JMP EMARF CHECK TYPE FOR VALID REF WN* * VFIX LDB \FIX2,I GET INSTR WITH OPTIONAL BYTE, HIBP CBX BITS, AND DBL TYPE BLF,RBL IF THE BYTE SSB BIT IS SET, THEN ADA A DOUBLE THE ADDRESS ADA \FIX3,I COMPUTE THE MEMORY ADDRESS STA OPRND AND SAVE AND M0760 EXTRACT THE PAGE NUMBER STA PAGNO AND SAVE CXA GET \FIX2 AGAIN AND M7 EXTRACT THE DBL RECORD TYPE STA DBLT AND SAVE CXA NOW GET AND M1000 THE HIBP BIT STA LINKB AND SAVE LINK MODE CXA LEAVE ONLY THE AND M1740 INSTRUCTION (15-11) STA DINST LDA PAGNO IF A BASE PAGE OPERAND SZA,RSS THEN JMP CPFIX GO TREAT AS CURRENT PAGE * LDA \FIX1,I GET THE INSTR. ADDRESS AND M0760 EXTRACT THE PAGE STA OPPAG SAVE IT LDB \FIX4,I GET THE LST INDEX SZB IF EXT REFERENCE JMP LFIX MAY NEED A BP LINK * CPA PAGNO IF SAME PAGE AS OPERAND JMP CPFIX GO DO CURRENT PAGE TRICK * * EMA? * * CHECK FOR AN EXTERNAL WITH OFFSET * LFIX SZB,RSS JMP WFIX NOT AN EXT LDB DBLT REFERENCE WITH OFFSET? CPB P5 IE, A DBL TYPE 5 JMP CPFIX YES - GO SEE IF IT'S A DEF(FOR DIRECT LINK) * WFIX LDA DINST GET THE INSTRUCTION CLE,ELA ZAP THE INDIRECT BIT SZB IF EXT REFERENCE JMP IDEF GO USE A LINK * SZA,RSS IF NOT A MRF INSTRUCTION JMP CPFIX THEN DO THE DEF TRICK * IDEF LDA OPRND GET THE OPERAND SEZ IF INDIRECT REFERENCE ADA MSIGN RESTORE THE SIGN BIT STA OPRND IN OPERAND(FOR LINK STORAGE) SZB IF EXTERNAL REF STB BPONL SET FOR BASE PAGE LINK ONLY JSB BPSCN GET A LINK ADDRESS IOR MSIGN A = ADDRESS, SET INDIRECT BIT * XFIX STA B SAVE THEQu ADDRESS AND M1177 =B101777 PURGE THE PAGE BITS CPA B IF THERE WERE SOME RSS THEN IT'S A CP LINK SO IOR M2000 SET THE CP BIT * YFIX IOR DINST INCLUDE THE INSTRUCTION ZFIX LDB L01 IF NOT LOADING SZB,RSS THEN JMP AFIX SKIP THE DISC WRITE * LDB \FIX1,I GET THE CORE ADDRESS JSB \ABDO OUTPUT THE WORD AFIX ISZ CLEAR SHOULD THIS FIXUP ENTRY BE CLEARED? JMP DFIX,I NOPE CCA FREE THE FIX UP TABLE ENTRY STA \FIX1,I JMP DFIX,I AND EXIT * CPFIX LDA OPRND CP/BP/DEF - GET OP ADDRESS LDB DINST IF CLE,ELB DEF SZB,RSS THEN JMP YFIX JUST PICK UP THE INDIRECT. * LDB PAGNO IF A BASE PAGE REFERENCE SZB OR IF LDB \FIX4,I NOT AN EXT SZB THEN DO DIRECT LINK ISZ BPONL ELSE SET TO USE BP LINK (SKIPS) JMP XFIX USE STANDARD LINK * * EXT REF WITH OFFSET (NOT A DEF) * LDB OPPAG IF INSTR ON SAME PAGE AS CPB PAGNO OPERAND THEN JMP XFIX MAKE THE INSTR DIRECT CLB,INB SET B(WE KNOW IT'S AN EXT) JMP WFIX GO GET A LINK * * CONFIGURE EMA REFERENCE * EMARF CLA LDB \FIX4,I CAN THIS MODULE REFERENCE CPB EMLST THIS EMA? RSS YES - IT IS THE CURRENT EMA SYMBOL JMP ZFIX NO, SO NOP THE INSTR (EXT FLAGGED ERROR) * LDA \FIX2,I WAS THIS AN SSA INDIRECT REF TO EMA? JMP EER62 YES - CAN'T ALLOW AND M7 OR WAS IT A REF WITH OFFSET CPA P5 JMP EER62 CAN'T ALLOW IT EITHER * LDA \FIX2,I GET AND AND M1740 ISOLATE THE INSTRUCTION IOR MSIGN SET THE INDIRECT BIT IOR EMLNK MERGE THE ALLOCATED LINK JMP ZFIX AND SEND THE INSTR * EER62 LDA ERR62 SEND ERROR DIAGNOSTIC CMA,INA b FOR EMA WITH OFFSET OR JSB \GNER INDIRECT CLA NOW NOP THE JMP ZFIX INSTR * ERR62 ASC 1,62 OPPAG NOP BPONL NOP DBLT NOP LINKB NOP M1000 OCT 1000 M1740 OCT 174000 CLEAR NOP DINST NOP SKP * SFIX FINDS THE FIRST FREE FIX UP TABLE ENTRY. * * CALLING SEQUENCE: * * JSB SFIX * SFIX NOP JSB \IFIX INITILIZE THE FIX UP TABLE SFIX1 JSB \FIX SET ADDRESSES JMP SFIX2 EXIT NEW ENTRY * LDA \FIX1,I THIS ENTRY FREE? SSA,RSS FREE IF NEGATIVE JMP SFIX1 NO KEEP LOOKING * JMP SFIX,I EXIT * SFIX2 ISZ \PFIX IF NEW ENTRY, COUNT IT. CCB STB \FIX1,I AND CLEAR THE ENTRY JMP SFIX,I EXIT SKP * DAFIX DOES ALL FIX UP FOR THE CURRENT LST ENTRY * * CALLING SEQUENCE: * * SET UP THE LST ENTRY * * JSB DAFIX * DAFIX NOP JSB \IFIX SET UP THE SCAN DAFI1 JSB \FIX SET ADDRESSES JMP DAFI2 END OF LIST GO TO EXIT CODE * LDA \FIX1,I IF NULL ENTRY SSA THEN JMP DAFI1 IGNOR IT * LDA \TLST GET LST INDEX. ADA N1 CPA \FIX4,I THIS ENTRY? RSS YES JMP DAFI1 GET NEXT FIX UP * * DETERMINE IF \ABDO OUTPUT MAP MUST BE CHANGED FOR FIX UP * LDA HIBP COULD WE BE RELOCATING A CPA M1000 DP? RSS JMP NOCHG NO LDA DPNUM YES, DP # MUST BE >= 2 SZA,RSS JMP NOCHG MUST BE DP 1, SDA,TA,SSGA * LDA LWDP1 SEE IF FIXUP IS OUTSIDE CMA,INA RANGE OF CURRENT DP - ADA \FIX1,I IE, > LAST WORD OF DP SSA,RSS JMP CHNGM NO, ITS >= LWDP1 LDA DPADD OR LESS THAN FIRST CMA,INA IE, < DPADD ADA \FIX1,I SSA JMP CHNGM IT'S LESS * NOCHG JSB SETDM GO SET FIXUP MODE JSB DFIX PERFORM FIXUP JMP DAFI1 GO GET NEXT ENTRY * AY * CHANGE OUTPUT MAP FOR \ABDO TO THAT OF THE SYSTEM FOR FIXUP * CHNGM JSB \SYS REBUILD SYSTEM MAP JSB SETDM GO SET FIXUP MODE JSB DFIX GO DO THE FIXUP JSB \USER REBUILD THE DP MAP JMP DAFI1 AND GO GET THE NEXT ENTRY * DAFI2 JSB SFIX SET UP A FREE FIX UP ENTRY JMP DAFIX,I AND EXIT * * SETDM NOP SET THE MODE FOR CLEARING OF FIXUPS LDB DPFLG IF WE'RE RELOCATING A DRIVER PARTITION LDA LDTYP THEN DON'T REUSE THE FIXUP ENTRY SZA OF THE DRIVER (LIBR RTNS OK) CCB JMP SETDM,I SKP * CLEAR PROGRAMS-LOADED FLAGS * * CLID3 CLEARS THE USAGE FLAGS TO ENSURE THAT PROGRAMS WILL BE * RE-LOADED AGAIN IF CALLED MORE THAN ONCE. THIS IS ESSENTIAL * FOR ALL UTILITY PROGRAMS AND USER SUBROUTINES, BUT MUST NOT * BE DONE FOR SYSTEM PROGRAMS OR MAIN USER PROGRAMS. * BOTH THE USAGE FLAG IN THE IDENT ENTRY AND THE * SYMBOL VALUES FOR ALL ENTRY POINTS IN THE PROGRAM ARE CLEARED. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB CLID3 * * RETURN: CONTENTS OF A AND B ARE DESTROYED. * CLID3 NOP LDB P3 GET THE STANDARD FLAG LDA P5 CPA \PTYP PROG = SEGMENT? LDB P7 YES - GET BS FLAG BITS STB CURAP SET CURRENT PROG FLAG BITS JSB \INID INITILIZE THE IDENT SCANNER TRID3 JSB \IDX GET THE NEXT IDENT. JMP CLID3,I IF NONE THEN EXIT - DONE * LDA \ID4,I GET M/S BIT RAL,CLE,ERA SET E IF MAIN LDA \ID6,I GET TYPE AND M177 ISOLATE TYPE SZA,RSS IF SYSTEM JMP TRID3 THEN LEAVE SET CPA P13 OR IF TABLE AREA II RSS CPA P15 OR TABLE AREA I RSS CPA P30 OR SSGA JMP TRID3 LEAVE SETT * AND M7 IF A TYPE 6 THEN CLEAR LOAD FLAGS CPA P6 UNLESS THE MRL OR MRP'S ARE BEING LOADEDN JMP RFMRL GO TEST CURRENT LOAD TYPE * CPA P7 IF A UTILITY PROGRAM JMP C2 THEN CLEAR IT SEZ IF MAIN JMP TRID3 FORGET IT * C2 LDA \ID3,I GET USAGE FLAG AND P7 ISOLATE THE USAGE FLAG CPA CURAP IF ONE THAT WE ARE AFTER RSS SKIP JMP TRID3 ELSE TRY THE NEXT ONE * XOR \ID3,I ZAP THE USAGE FLAGS STA \ID3,I AND RESTORE THE WORD JSB \ILST INITIALIZE \LSTX CLSUT JSB \LSTX SET CURRENT LST ADDRESSES JMP TRID3 TRY NEXT IDENT * CCA ADA \TIDN GET IDENT INDEX CPA \LST4,I ENT-EXT BELONGS TO CURRENT PROG? CLB,RSS YES - CONTINUE JMP CLSUT TRY NEXT LST ENTRY * STB \LST5,I CLEAR SYMBOL VALUE JMP CLSUT CONTINUE CLEARING BP LINK ADDR. * RFMRL LDA \PTYP GET CURRENT LOAD TYPE CPA P1 IF MEMORY RESIDENT PROG RSS CPA P14 OR MEMORY RES LIBRARY JMP TRID3 THEN DON'T CLEAR LOAD FLAGS JMP C2 OTHERWISE, DO IT SPC 4 * THE GETCP ROUTINE SETS UP AND INITILIZES A NEW CP LINK AREA * * CALLING SEQUENCE: * * JSB GETCP * * RETURN A = \LNK1,\CPL2 ADDRESS * GETCP NOP LDA \CPL2 USE CURRENT TOP JSB \LNKS SET ADDRESSES CLA FOOL THE LINK ROUTINE STA \CPL2 JSB \LNK SET ADDRESS FOR NEXT AREA CLA SET AREA TO ZERO SIZE STA \LNK1,I STA \LNK2,I LDA \LNK3 SET THE IMAGE ADDRESS INA STA \LNK3,I LDA \LNK1 SET NEW TOP AND A FOR EXIT STA \CPL2 JMP GETCP,I RETURN SKP * * GET BP LINK ADDR, SET BP VALUE * * BPSCN SCANS THE CURRENT ALLOCATED LINKS * FOR A VALUE EQUAL TO THE CURRENT OPERAND. IF SUCH A VALUE * IS FOUND, THE ADDRESS OF THE OPERAND IS RETURNED * IN THE A-REGISTER. OTHERWISE, A NEW LINK WORD IS * RESERVED AND THE ADDRESS OF THIS WORD RETURNED IN A. * IN THIS CASE THE OPERAND WORD IS SET IN THE ALLOCATION * IMAGE AREA. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB BPSCN * * RETURN: * A = BP LINK ADDRESS FOR CURRENT OPERAND * B = DESTOYED * BPSCN NOP * JSB \LNKX INITILIZE THE LINK MAPPER BPSC2 JSB \LNK SET UP THE FIRST AREA JMP BPSC4 IF NON LEFT GO ALLOCATE * JSB SCN SCAN THE AREA FOR A LINK JMP BPSC2 IF NON FOUND TRY NEXT AREA * JMP BPSCN,I ELSE RETURN THE LINK * BPSC4 CLE JSB ALLOC NON ALLOCATED SO ALLOCATE ONE JMP BPSCN,I AND RETURN SKP * * SCAN AREA FOR SAME OPERAND * * THE SCN SUBROUTINE CONTROLS THE SCAN FOR A GIVEN OPERAND * IN THE CURRENT LINK SECTION. * * CALLING SEQUENCE: * SET UP \LNK1, \LNK2, \LNK3 TO POINT TO THE CURRENT LINK AREA * SET OPRND TO THE VALUE DESIRED, AND BPONL TO -1 FOR ANY AREA * AND TO 0 FOR BASE PAGE ONLY. * * JSB SCNBP * * RETURN: * P+1: LINK NOT FOUND * P+2: LINK FOUND (A = ADDR OF OPERAND) * (B = IMAGE ADDRESS) * SCN NOP LDA \LNK1,I GET THE LOWER ADDRESS STA \LNK AND SAVE IT LDB BPONL GET THE BASE PAGE ONLY FLAG AND M0760 ISOLATE THE PAGE OF CURRENT AREA SZA,RSS IF BP THEN CCB SET B FOR OK SSB,RSS IF BP ONLY AND NOT BP JMP SCN,I RETURN NOT FOUND * SZA CHECK IF RIGHT PAGE (BP IS ALWAYS RIGHT) CPA OPPAG RSS GOOD LINK AREA JMP SCN,I NOT RIGHT PAGE, EXIT * LDB \LNK3,I GET THE IMAGE ADDRESS TO B SCN1 LDA \LNK GET THE ACTUAL ADDRESS TO A CPA \LNK2,I END OF AREA? JMP SCN,I YES, EXIT NOT FOUND * LDA B,I NO, GET THE VALUE CPA OPRND THIS IT? JMP SCN2 YES, GO RETURN I-T * INB NO SET FOR NEXT ENTRY ISZ \LNK JMP SCN1 * SCN2 LDA \LNK GET THE CORE ADDRESS ISZ SCN STEP TO THE RETURN ADDRESS JMP SCN,I RETURN, LINK FOUND, ADDRESS IN A SKP * * ALLOCATE NEW LINK WORD * * THE ALLOC SUBROUTINE ESTABLISHES ALL THE LINKAGE ADDRESSES. * IF THE ALLOCATED LINK WORD FALLS OUTSIDE A PROGRAM'S LINK AREA, * A DISGNOSTIC IS PRINTED. * IF THE FIXUP ENTRY INDICATES THAT AN ALLOCATED LINK MUST GO IN THE * UPPER PORTION OF BP ( BIT 9 OF \FIX2,I WAS SET), THEN A MATCH * IS MADE AGAINST THE CURRENT VALUE OF HIBP. IF UNEQUAL, THEN THE * LINK MUST BE ALLOCATED OUTSIDE THE CURRENT BPINC SPEC'S. THIS * OCCURS WHEN THE SYSTEM IS RESOLVING EXT REFERENCES FROM THE TABLE * AREAS, SSGA, OR SDA - WHERE THE LINKS MUST BE IN ALL MAPS. * * CALLING SEQUENCE: * E = 1, DO NOT SCAN FOR AN ALREADY EXISTING LINK * E = 0, SCAN FIRST * JSB ALLOC * * RETURN: * A = ALLOCATED BP LINK ADDRESS * B = DESTROYED * ALLOC NOP SEZ SCAN? JMP NOSCN NO LDB OPRND SAVE THE OPERAND STB ALSAV LOCALLY CLB SET OPERAND STB OPRND TO ZERO TO CALL SCN LDA CPL1 SET UP TO SCAN THE LOW CP LINK AREA JSB \LNKS JSB SCN SCAN THE AREA RSS IF NOT ALLOCATED SKIP JMP ALLO1 ELSE GO SET UP * LDA \CPL2 TRY THE HIGH AREA JSB \LNKS SET IT UP JSB SCN SCAN IT CLA,INA,RSS IF NOT FOUND SKIP JMP ALLO1 ELSE GO SET IT UP * * SET UP NEW LINK IN BASE PAGE AREA * STA \LNK1 SKIP FLAG = 1 LDA LINKB IF FIXUP ENTRY MATCHES CPA HIBP CURRENT LINK ALLOCATION MODE JMP NORML THEN ALLOCATE ACCORDING TO BPINC * * THE SYSTEM MUST BE RESOLVING A REFERENCE FROM * THE TABLE AREAS, DRIVERS, OR SSGA - SO USE A LINK * IN THEIR UPPER PORTION OF BASE PAGE. * LDA LOLNK HAS LAST SYSTEM LINKE CPA TBREL ALREADY USED IT? JMP ER16 YES ADA N1 NO, GET NEXT LINK FROM STA LOLNK TOP AND UPDATE LAST UPPER BPL USED STA BPLMT AND UPPER LIMIT FOR LOWER BPL'S LDB A GET IMAGE ADDRESS ADB \ADBP OF LINK JMP ALLO1 AND GO SET UP * NOSCN CLA,INA SET SKIP FLAG = 1 STA \LNK1 NORML LDA TBREL DOES NEW LINK CPA BPLMT EQUAL LIMIT ADDR JMP ER16 YES,ERROR LDB A NO, SAVE LINK ADDR ADA BPINC UPDATE TO NEXT STA TBREL SET NEXT LINK ADDR LDA B GET REAL ADDR OF NEW LINK ADB \ADBP AND IMAGE ADDR OF NEW LINK SPC 1 * TBREL CONTAINS POINTER TO NEXT FREE BPLINK (STARTS * AT 2 FOR DR'S AND MR'S, 100 FOR SYS, AND 1644 FOR * TABLE AREAS/SSGA/SDA/PRD'S. BPINC SET TO -1 WHEN * LOADING TABLE AREAS,SSGA,SDA,PRD'S, AND TO +1 * OTHERWISE. BPLMT SET TO LOWEST TABLE AREA/SSGA/SDA LINK * FOR SYS, LAST SYS LINK FOR PRD'S, AND LOWEST DRIVER * LINK FOR ALL OTHERS. * ALLO1 STA TCHR SET THE ADDRESS LDA ALSAV GET THE OPERAND STA OPRND RESTORE IT STA B,I SET IT IN THE IMAGE AREA LDA \LNK1 IF ALLOCATION FROM CPA CPL1 CP LOW AREA ISZ CPL1H STEP THE COUNT CPA \CPL2 IF FROM THE HIGH AREA ISZ CPL2H STEP ITS COUNT LDA TCHR SET THE ADDRESS IN A JMP ALLOC,I AND RETURN * ER16 LDA ERR16 GET THE ERROR CODE CMA,INA DON'T DO A TR JSB \GNER SEND IT CLA RETURN ZERO AS THE LINK JMP ALLOC,I * ALSAV NOP TCHR NOP SKP * * PACK THE CP LINK AREA * * CCPLK PACKS THE CURRENT PAGE LINK AREA TO GET RID OF LINK * AREAS THAT ARE NO LONGER ACTIVE. * * CALLING SEQUENCE: * * LDA CURREN !T PAGE ADDRESS * JSB CCPLK * * RETURN REGISTERS MEANING LESS * * CCPLK WILL DELETE ALL LINK AREAS THAT ARE ABOVE * CPLS AND REFER TO AN AREA ON A PAGE BELOW THE PAGE * ADDRESS IN A ON ENTRY. IT WILL ALSO DELETE ALL * ENTRIES FOR ZERO LENGTH AREAS. * CCPLK NOP AND M0760 SAVE THE CMA,INA PAGE STA CPAG ADDRESS LDA CPLS GET THE LOWEST ENTRY TO SAVE STA TCCP4 SAVE FOR LAST VALID ENTRY JSB \LNKS SET UP THE \LNK AREA JSB \LNK GET THE FIRST POSSIBLE PURGE AREA JMP CCPLK,I IF NONE THEN EXIT * LDA \LNK1,I IF THIS AREA CPA \LNK2,I IS OF ZERO LENGTH JMP CCPL0 GO SET UP * AND M0760 ELSE IF AREA IS ABOVE OR EQUAL ADA CPAG TO THE SAVE PAGE AREA SSA,RSS THEN JMP CCPLK,I EXIT - NO PACK NEEDED * CCPL0 LDA \LNK1 SET UP THE NEXT AVAILABLE CCPL1 STA TCCP1 POINTER CCPL5 JSB \LNK GET THE NEXT ENTRY JMP CCPL3 IF NONE GO HANDLE * LDA \LNK1,I IF STILL CPA \LNK2,I A ZERO ENTRY JMP CCPL5 REJECT THE ENTRY AND M0760 ISOLATE THE PAGE ADDRESS ADA CPAG IF STILL SSA BELOW THE SPECIFIED PAGE JMP CCPL5 REJECT THE ENTRY * LDA TCCP1 KEEP THE AREA STA TCCP4 SET LAST AREA POINTER STA TCCP2 SET MOVE POINTER LDA \LNK2,I SET UP THE CMA,INA ADA \LNK1,I MOVE STA TCCP3 COUNT LDA \LNK1,I SET WORDS STA TCCP2,I ONE ISZ TCCP2 LDA \LNK2,I TWO STA TCCP2,I ISZ TCCP2 LDA TCCP2 AND INA STA TCCP2,I THREE LDB \LNK3,I MOVE CCPL2 ISZ TCCP2 THE LDA B,I IMAGE STA TCCP2,I TO THE NEW LOCATION INB ISZ TCCP3 JMP CCPL2 * LDA \LNK1 AND CPA \CPL2 \CPL2 JMP CCPL3 IF END GO DO SPECIAL * c LDA TCCP2 UPDATE INA FOR THE NEXT ENTRY JMP CCPL1 AND GO DO IT * CCPL3 LDB TCCP4 SET UP STB \CPL2 \CPL2, THE UPPER LIMIT JMP CCPLK,I AND EXIT SPC 2 TCCP1 NOP TCCP2 NOP TCCP3 NOP TCCP4 NOP CPAG NOP SKP * * CLEAR THE CURRENT PAGE * * CLRCP CLEARS THE CURRENT PAGE LINKING IMAGE POINTED AT BY * THE CURRENT \LNK ENTRY. * CLRCP NOP LDA \LNK2,I COMPUTE CMA,INA NUMBER ADA \LNK1,I OF STA \LNK WORDS TO CLEAR SZA,RSS IF ZERO THEN JMP CLRCP,I EXIT * LDA \LNK3,I STA \LNKX GET ADDRESS OF AREA CLRC1 CLA CLEAR STA \LNKX,I A WORD ISZ \LNKX STEP TO NEXT ONE LDA \LNKX CHECK FOR ADA \CPLM OVERFLOW OF SSA,RSS IMAGE AREA JMP TRUN GO SHORTEN IF OVERFLOW * ISZ \LNK STEP COUNTER JMP CLRC1 IF NOT DONE DO NEXT ONE * JMP CLRCP,I RETURN * TRUN LDA \LNK3,I CACULATE MAX ADA \CPLM AREA SIZE CMA,SSA,INA IF NEGATIVE CLA SET TO ZERO ADA \LNK1,I ADD BASE ADDRESS STA \LNK2,I SET NEW UPPER END JMP CLRCP,I AND RETURN SKP * * OUTPUT CURRENT CURRENT PAGE * * OUTCP OUTPUTS THE AREA SPECIFIED BY \LNK1, \LNK2, AND \LNK3 * TO THE DISC. * * CALLING SEQUENCE: * * SET UP \LNK1, \LNK2, \LNK3 * JSB OUTCP * * RETURN REGISTERS MEANINGLESS * OUTCP NOP JSB \LNKS SET UP THE \LNK AREA LDA \LNK1,I GET THE CMA,INA NUMBER OF ADA \LNK2,I WORDS TO OUTPUT TO CMA,INA,SZA,RSS A AND IF ZERO JMP OUTCP,I RETURN * STA WDCNT SET THE COUNT LDA \LNK3,I GET THE ADDRESS OF THE FIRST WORD STA \TBUF AND SET IT LDB \LNK1,I GET THE CORE ADDRESS TO BE USED  OUTC2 LDA \TBUF,I GET A WORD JSB \ABDO SEND IT TO THE DISC ISZ \TBUF STEP THE WORD ADDRESS ISZ WDCNT AND THE COUNT DONE? JMP OUTC2 NO DO THE NEXT WORD * JMP OUTCP,I YES RETURN SKP * * READ RELOCATABLE RECORD CONTROL * * DBSET ESTABLISHES THE ADDRESS OF THE NEXT WORD OF THE RELOCATABLE * RECORD IN \LBUF. IF \LBUF HAS BEEN PROCESSED, IT ISSUES A CALL TO * \RBIN TO READ ANOTHER RELOCATABLE RECORD. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB DBSET * * RETURN: CONTENTS OF A AND B ARE DESTROYED * DBSET NOP ISZ \CURL INCR CURRENT \LBUF ADDRESS ISZ LCNT SKIP - END OF \LBUF JMP DBSET,I RETURN LDA ALBUF READ NEXT RELOC RECORD. STA \CURL CLB JSB \RBIN JSB \ABOR ERROR (MSG ALREADY DISPLAYED). SZA,RSS JSB \ABOR EOF. CMA,INA SET COUNT. STA LCNT JMP DBSET,I RETURN. SPC 3 SPC 1 * SEND MESSAGE "BP LINKAGE XXXX" ROUTINE. SPC 1 BPLNR NOP LDB MES03 XXX IS IN A ON ENTRY. JSB \CONV LDA P16 LDB MES02 JSB \MESS JMP BPLNR,I * MES02 DEF MS02 MS02 ASC 8,BP LINKAGE XXXXX MES03 DEF MS02+5 SKP * CLEAR LOCAL LST ENTRIES * * CLRLT CLEARS THE CURRENT BP LINKAGE ADDRESSES IN THE BASE PAGE * IMAGE. (CLEARS B-A WORDS). * * CALLING SEQUENCE: * A = CURRENT LOW BP ADDRESS * B = CURRENT HIGH BP ADDRESS PLUS ONE * JSB CLRLT * * RETURN: CONTENTS OF A AND B ARE DESTROYED. * CLRLT NOP STA CLRTM SAVE PARM IN TEMP LDA BPINC AND PICK UP BP INCREMENT ELA AND SAVE SIGN (<0 = DOWN) LDA CLRTM THEN RESTORE PARM. SEZ IF BP LINKS GO DOWNWARD, SWP THEN SWAP PARMS. CMB,INB SET HIGH BOUND NBHFBEGATIVE ADB A SET A = TOTAL WORD COUNT SSB,RSS SKIP - SOME BP SECTION TO CLEAR JMP CLRLT,I RETURN - NO BP SECTION STB WDCNT SET COUNT FOR CLEARING ADA \ADBP ADJUST FOR BP ADDRESS LDB CLWRD GET THE CLEARING WORD STB A,I CLEAR BP WORD INA ISZ WDCNT SKIP - ALL BP CLEAR JMP *-3 JMP CLRLT,I END OF CLEARING CLRTM BSS 1 SPC 3 * SETBP SET THE SPECIFIED BASE PAGE IMAGE WORDS TO -1 * CALLING SEQUENCE: SAME AS CLRLT. * SETBP NOP STB CLRLT SAVE THE HIGH LIMIT CCB SET THE CLEAR WORD STB CLWRD TO -1 LDB CLRLT RESTORE B JSB CLRLT GO SET THE WORDS TO -1 ISZ CLWRD RESET CLEAR WORD TO 0 NOP ALWAYS SKIPPED JMP SETBP,I RETURN SPC 1 CLWRD NOP SKP * * CLEAR MEMORY MAP BUFFER * * CLIST CLEARS THE MEMORY MAP BUFFER WITH BLANKS. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB CLIST * * RETURN: CONTENTS OF A AND B ARE DESTOYED. * CLIST NOP LDB AMLST AMLST = ADDR OF MLIST LDA N8 STA AMAD SET BUFFER LENGTH LDA BLNKS GET 2 BLANK CHARACTERS STA B,I CLEAR BUFFER WORD INB ISZ AMAD ALL WORDS CLEAR? JMP *-3 NO - CONTINUE CLEARING JMP CLIST,I RETURN SPC 2 B4400 OCT 4400 BLNKS ASC 1, * * END LODR ZdHASMB,R,L,C HED RT4G5 - I/O TABLE GENERATION SEGMENT. NAM RT4G5,5,90 92067-16009 REV.1805 780126 SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 3 ****************************************************** * * NAME: RT4G5 * SOURCE PART #: 92067-18009 * REL PART #: 92067-16009 * WRITTEN BY: KFH,JH,GAA * ****************************************************** SPC 1 * * ENTRY POINT NAMES * ENT \IOTB,\TBLS * * EXTERNAL REFERENCE NAMES * EXT \LSTS,\TLST EXT \LST1,\LST4,\LST5 EXT \IDXS,\IDX,\TIDN EXT \ID6,\ID8 EXT \IFIX,\FIX,\PFIX EXT \FIX1,\FIX2,\FIX3,\FIX4 EXT \LNKX,\LNK,\LNKS EXT \LNK1,\LNK2,\LNK3 * EXT \CURL,\CPL2,\TBUF EXT \SYS,\USER EXT \SRET EXT \OCTN,\CONV,\GETN,\GINT,\GET#,\GETC,\DCON EXT \ADBP,\NABP,\CMFL EXT \READ,\SPAC,\GNER,\INER,\ABOR,\MESS,\IRER EXT \ABDO,\ADSK EXT \SSID,\ASKY,\SKYA EXT \PREL * A EQU 0 B EQU 1 SUP ************************************************************************ * SKP *************************************************************************** * * 780126 * * THE FOLLOWING BLOCK OF STORAGE FOR VARIABLES PRECEEDS, * AND IS REFERENCED BY, EACH SEGMENT. IT IS NOT OVERLAID * AS EACH NEW SEGMENT IS LOADED INTO MEMORY. * * THE LOCATION OF EACH VARIABLE MUST BE THE SAME IN ALL * SEGMENTS. IF A CHANGE IS MADE, MAKE THE SAME CHANGES * IN THE REST OF THE SEGMENTS. * z *************************************************************************** * * TB30 BSS 128 TRACK MAP TABLE/HEADER RECORD BUFFER * ILIST BSS 64 USER SYSTEM PROG IDENT ADDR LIST CURIL BSS 1 CURRENT ILIST ADDRESS * SYSCH BSS 1 SUBCHANNEL OF SYSTEM UNIT. DCHNL BSS 1 CHANNEL OF SYSTEM DISK UNIT AUXCH BSS 1 SUBCHANNEL OF AUX UNIT. DSIZE BSS 1 DISK SIZE -NO. OF TRACKS. #SUBC BSS 1 # DISC SUBCHANNELS DEF'D (7905/7920) DAUXN BSS 1 AUXILIARY DISK SIZE. ADS# BSS 1 AUX DISC SECTORS/TRACK. * * RELOCATION BASE TABLE. RBTA BSS 1 ABSOLUTE PROGRAM BASE. TPREL BSS 1 CURRENT PROGRAM BASE ADDRESS. TPBRE BSS 1 BASE PAGE RELOCATION ADDRESS. COMAD BSS 1 CURRENT COMMON RELOCATION BASE. BSS 1 ABS PROGRAM BASE FOR MR CODE. * WDCNT BSS 1 TEMPORARY WORD COUNTER. DSKSY BSS 1 INITIAL ID SEGMENT DISK ADDRESS IDSP BSS 1 POSITION OF 1ST ID SEG. IN SECT TTYCH BSS 1 SYSTEM TTY CHANNEL NO. * PLFLG BSS 1 PROGRAM LOAD. FLAG = -1/0 = L/NL DSCNT BSS 1 DISK SEGMENT SECTOR COUNT * NXFLG BSS 1 ENT/EXT FLAG = -1/0 EXCNT BSS 1 SYMBOL COUNTER * LCNT BSS 1 CURRENT \LBUF COUNT DCNT BSS 1 CURRENT DBUF COUNT CURAI BSS 1 CURRENT IBUF COUNT * CPLS BSS 1 ADDRESS OF TOP OF FIXED CP LINK IMAGE CPL1 BSS 1 ADDRESS OF LOW CURRENT PAGE LINK SPECS. CPL1H BSS 1 NUMBER OF CURRENT PAGE LINKS ASSIGNED CPL2H BSS 1 IN LOW AND HIGH AREA RESPECTIVELY URBP1 BSS 1 LWA R/T DISC RES BP LINK AREA CURAK BSS 1 CURRENT KBUF ADDRESS * CURAT BSS 1 CURRENT \TBUF ADDRESS TCNT BSS 1 CURRENT \TBUF COUNT * CURAP BSS 1 CURRENT PLIST ADDRESS * AMAD BSS 1 CURRENT MLIST ADDRESS * IXCNT BSS 1 ID EXTENSION COUNT IDEXC BSS 1 CURRENT ID EXT'S USED IDEX BSS 1 ADDRESS OF ID EXTENSION TABLE * LICNT BSS 1 LONG ID SEGMENT COUNT SICNT BSS 1 SHORT ID SEGMENT COUNT SSCNT BSS 1 BG. SEG ID COUNT * DSKID BSS 1 DISK ID SEGMENT ADDRESS KEYCN BSS 1 TOTAL KEYWORD COUNT KEYCT BSS 1 CURRENT KEYWORD COUNT * MLIST BSS 11 MEMORY MAP BUFFER * TEMP1 BSS 1 TEMP2 BSS 1 LWH1 BSS 1 LWH2 BSS 1 LWH3 BSS 1 LWH4 BSS 1 L01 BSS 1 * FSYBP BSS 1 FIRST WORD SYS BP LINKAGE SYSAD BSS 1 CURRENT ID SEGMENT ADDRESS * TBREL BSS 1 CURRENT BP RELOC ADDR PBREL BSS 1 INITIAL BP RELOC ADDR * RELAD BSS 1 CURRENT CORE RELOCATION ADDRESS * BSBAD BSS 1 BG SEGMENT BP RELOC ADDR BSPAD BSS 1 BG SEGMENT PROG RELOC ADDR * LFLAG BSS 1 PROGRAMS-LOADED FLAG IMAIN BSS 1 CURRENT MAIN IDENT INDEX. HDFLG BSS 1 HEADING FORMAT FLAG CIDNT BSS 1 CURRENT MAIN IDENT INDEX. * AEQT BSS 1 ADDRESS OF EQUIPMENT TABLE CEQT BSS 1 NO. ENTRIES IN EQUIPMENT TABLE SPLCO BSS 1 SPOOL EQT COUNT DVMAP BSS 1 ADDRESS OF DRIVER MAP TABLE * DPFLG BSS 1 DP RELOCATION FLAG, 0=YES, -1=NO DPLN BSS 1 PAGE LENGTH OF DRIVER PARTITION DPADD BSS 1 START ADDR OF DRIVER PARTITION DSKDP BSS 1 DISK ADDRESS OF DP #2 PAGE# BSS 1 NEXT PHYSICAL PAGE TO ALLOCATE DPNUM BSS 1 CURRENT DP# -1, OR TOT DP PAGES SDID BSS 1 IDENT IDEX OF SYS DISK DRIVER LWDP1 BSS 1 LAST WORD OF DP, +1 FWSDA BSS 1 FIRST WORD OF SDA * ASQT BSS 1 ADDR OF DEVICE REFERENCE TABLE CSQT BSS 1 NO. ENTRIES IN DEV. REF. TABLE * AINT BSS 1 ADDRESS OF INTERRUPT TABLE * DSKIN BSS 1 DISK ADDR OF INT CODE RECORD INTCN BSS 1 RECORD COUNT OF INT CODE * IDSAV BSS 1 INDEX OF CURRENT IDENT. DSKMN BSS 1 INITIAL MAIN DISK ADDRESS BSSDP BSS 1 INITIAL DISK RES MAIN BSS DISP PRENT BSS 1 PRIMARY ENTRY POINT DBLAD BSS 1 CURRENT DBL ADDRESS REKEY BSS 1 INSTRUCTION TYPE BYTE INSCN BSS 1 INSTRUCTION TYPE COUNTER INSTR BSS 1 CURRENT INSTRUCTION PAGNO BSS 1 CURRENT PAGE NO. OPRND BSS 1 CURRENT OPERAND PLGTH BSS 1 PROGRAM LENGTH * DRT2 BSS 1 DISK DRT ENTRY ( SYSTEM) DRT3 BSS 1 AUX DISK DRT ENTRY * LIBFG BSS 1 LDTYP BSS 1 * SCH1 BSS 1 INDEX OF IDENT OF PGM TO BE SCHEDULED SCH3 BSS 1 ADDRESS OF CURRENT ID SEGMENT SCH4 BSS 1 ADDRESS OF THE SCHEDULED PGM ID SEG FGBGC BSS 1 BACKGROUND USING FG COMMON FLAG $LIBR BSS 1 INDEX OF $LIBR ENT $LIBX BSS 1 INDEX OF $LIBX ENT CUPRI BSS 1 * BLLO BSS 1 -(LOWER BUFFER LIMIT) BLHI BSS 1 -(UPPER BUFFER LIMIT) * MEM6 BSS 1 MEM12 BSS 1 * COMRT BSS 1 MAXIMUM RT COM LENGTH COMBG BSS 1 MAXIMUM BG COM LENGTH COMSZ BSS 1 #WORDS COMMON DECLARED IN CURRENT MAIN RTCAD BSS 1 RT COMMON ADDRESS BGCAD BSS 1 BG COMMON ADDRESS FPCOM BSS 1 FIRST PAGE OCCUPIED BY COMMON LPCOM BSS 1 LAST PAGE CONTAINING ANY COMMON * FPSAM BSS 1 1ST PAGE CONTAINING S.A.M. FWSAM BSS 1 1ST WORD CONTAINING S.A.M. SYMAD BSS 1 VALUE FOR AVMEM IN SCOM SAM#1 BSS 1 SIZE OF FIRST CHUNK OF SAM SAM#2 BSS 1 SIZE OF SECOND CHUNK OF SAM SAM2P BSS 1 START PAGE OF SAM #2 LWTAI BSS 1 LAST WORD OF TABLE AREA I FOR SAM#0 FWPRV BSS 1 FIRST WORD FOR PRIVILEGED PROGRAMS * FWSYS BSS 1 FIRST WORD OF SYSTEM CODE LPSYS BSS 1 LAST PAGE CONTAINING SYS LWSYS BSS 1 LAST WORD OF SYSTEM LPSLB BSS 1 LAST PAGE OF SLOW BOOT LWSLB BSS 1 LAST WORD OF SLOW BOOT MTYPE BSS 1 MAIN PROGRAMS'S TYPE * HIBP BSS 1 BP LINK MODE FOR FIXUP ENTRIES LOLNK BSS 1 LOW LINK FOR SSGA,LIB, OR SYS HILNK BSS 1 HI LINK USED BY MEM RES PRG BPINC ^BSS 1 BP LINK ALLOCATION MODE, -1=DOWN,1=UP BPLMT BSS 1 LAST AVAIL BP LINK IN CURRENT MODE, +1 * TPMAX BSS 1 HWM FOR RELOCATION OF BG MAINS & SEGS MAXPT BSS 1 NUM PARTS. ALLOWED MAT. BSS 1 ADDRESS OF MEMORY ALLOCATION TABLE * SSGA. BSS 1 FWA SSGA MAP. BSS 1 PTR TO MEU RES MAP MPFT. BSS 1 PTR TO MPFT * EMLNK BSS 1 EMA SYMBOL'S LINK EMLST BSS 1 LST INDEX OF EMA SYMBOL EMDSK BSS 1 DISK ADDR OF EMA PROGRAM * * MEMORY RESIDENT AREA POINTERS * MRACM BSS 1 MR ACCESS COMMON FLAG (>0 IF YES) LBCAD BSS 1 FIRST WORD OF MEMORY RES LIBRARY LEND BSS 1 LAST WORD OF MEMORY RES LIBRARY FWMRP BSS 1 FIRST WORD OF MEMORY RES PROGRAM AREA EMRP BSS 1 LAST WORD OF MEMORY RES PROGRAM AREA FPMRP BSS 1 FIRST PAGE OF MEMORY RES PROGRAM AREA FPMBP BSS 1 PAGE # FOR MEMORY RES BASE PAGE MRP# BSS 1 # PAGES OCCUPIED BY MRL & MRP'S DSKMB BSS 1 DISK ADDRESS OF MEMORY RES BASE PAGE DSKMR BSS 1 DISK ADDRESS OF MEMORY RESIDENT LIB/PROG AREA DSKBP BSS 1 SYSTEM DISK ADDRESS * DSKAV BSS 1 NEXT AVAILABLE DISK ADDRESS DSKLC BSS 1 DISK ADDRESS OF LIBRARY CODE DSKLB BSS 1 DISK ADDR OF LIBRARY ENTRY PTS DSKUT BSS 1 UTILITY PROG DISK ADDRESS DSKBS BSS 1 DISK ADDR OF MAIN BG DISK RES BP DSKBR BSS 1 CURRENT MAIN BG DISK RES DISK AD ADICT BSS 1 ADDR OF DISK DICTIONARY LBCNT BSS 1 RESIDENT LIBR ENTRY PT COUNT SYCNT BSS 1 SYSTEM ENTRY POINT COUNT KEYAD BSS 1 CURRENT KEYWORD ADDRESS * SYBAD BSS 1 ADDR OF FIRST BP LINK FOR BG IDSAD BSS 1 ADDR OF FIRST ID SEGMENT ABSID BSS 1 IDENT ADDR FOR NEXT BG SEG SCAN IDMBS BSS 1 BG MAIN ADDRESS FOR BS REF * * ********************************************************* * * * END OF COMMON STORAGE BLOCK FOR ALL SEGMENTS. * * * ********************************************************* * SPC 4 AILST DEF ILIST ATB30 DEF TB30 SKP * * NOTE THE FOLLOWING RESOLVES DEF'S TO EXTERNALS * GIO LDA N GET LOOP COUNTER STA TEMP1 SAVE IN TEMP LOCATION LDB LSTAA GET ADDRESS OF WHERE LIST ROUTINE LOCATED LOOP LDA B HERE WE CHASE DOWN OUR OWN LDA A,I INDRECTS RSS LDA A,I RAL,CLE,SLA,ERA JMP *-2 STA B,I AND SAVE IT AGAIN INB ISZ TEMP1 DONE? JMP LOOP NO JMP \SRET RETURN TO MAIN. * SPC 1 N DEC -1 LSTAA DEF *+1 ATBUF DEF \TBUF+0 SKP * THIS SECTION OF CODE GENERATES THE I/O TABLES FOR THE SYSTEM. * THESE INCLUDE THE EQUIPMENT TABLE (EQT), DEVICE REFERENCE * TABLE (DRT), INTERRUPT TABLE (INT), AND DRIVER MAP TABLE (DVMAP). * * THE EQT RECORDS HAVE THE FOLLOWING FORMAT: * * N1,DVRN2<,D><,B><,T><,X><,S><,M> * * N1 = CHANNEL NO. (2 OCTAL DIGITS) * N2 = DRIVER CLASS. CODE (2 OCTAL DIGITS) * D = DMA FLAG (OPTIONAL) * B = BUFFERING FLAG (OPTIONAL) * T = TIME-OUT VALUE TO BE ENTERED * X = EQT EXTENSION SIZE TO BE ENTERED * S = SYSTEM DRIVER AREA * M = SYSTEM DRIVER AREA WITH MAPPING * * IF T IS ENTERED, A VALUE FOR THE DEVICE'S TIME-OUT * CLOCK MUST BE NEXT ENTERED IN RESPONSE TO: * ' T = ' * THE OPERATOR MUST ENTER A POSITIVE DECIMAL NUMBER * OF UP TO FIVE DIGITS. THIS IS THEN THE NUMBER OF * TIME BASE GENERATOR INTERRUPTS (10 MSEC INTERVALS) * BETWEEN THE TIME IO IS INITIATED ON THE DEVICE AND * THE TIME AFTER WHICH THE DEVICE SHOULD HAVE INTERRUPTED. * IF THE DEVICE HAS NOT INTERRUPTED BY THIS TIME, IT * IS CONSIDERED TO HAVE TIMED-OUT. * * * EACH DRT RECORD CONSISTS OF A 2-DIGIT NO. SPECIFYING THE * CORRESPONDING ENTRY IN THE EQUIPMENT TABLE * AND AN )hOPTIONAL 1-DIGIT NO. SPECIFYING A * SUBCHANNEL WITHIN THAT ENTRY. FOR EXAMPLE, IN * RESPONSE TO THE MESSAGE: 5 = ?, THE RESPONSE 6 INDICATES THAT * THE LOGICAL UNIT NO. 5 IS TO USE DEVICE 6 IN EQT. * WHEREAS THE RESPONSE 6,2 INDICATES THAT THE * LOGICAL UNIT NO. 5 IS TO USE SUBCHANNEL 2 OF * DEVICE 6 IN EQT. * * * THE INT RECORDS HAVE ONE OF THE FOLLOWING FORMATS: * * N1,EQT,N2 * N1,PRG,NAME * N1,ENT,ENTRY * N1,ABS,N3 * * N1 = CHANNEL NO. (2 OCTAL DIGITS - MUST BE IN INCREASING ORDER) * EXCEPTION: IF N1 = 04 (POWER - FAIL), * THIS ENTRY DOES NOT HAVE TO BE IN ORDER. ALSO, * ONLY AN ENT OR AN ABS TYPE ENTRY IS ACCEPTED * FOR N1 = 04. * N2 = EQT NO. * NAME = PROGRAM NAME TO BE SCHEDULED * ENTRY = ENTRY POINT TO WHICH TRANSFER IS TO BE MADE * N3 = ABSOLUTE VALUE (6 OCTAL DIGITS) * * * GENERATE EQUIPMENT TABLE (EQT) * \IOTB NOP JSB \SPAC SEND A SPACE LDA P12 LDB MES30 JSB \MESS PRINT: TABLE AREA I: * JSB \SPAC MAKE IT LOOK NICE. LDA \PREL SET STARTING ADDRESS STA AEQT OF EQT'S CLA STA CEQT CLEAR NO. OF EQT ENTRIES STA SPLCO CLEAR THE SPOOL EQT COUNT STA BPONL ?AND THE BASE PAGE ONLY FLAG CCA SET DRT2 AND STA DRT2 DRT3 STA DRT3 TO IMPOSSIBLE NUMBERS LDA ATB30 ADA P6 SET FOR HEADER RECORD STA HEADR STORAGE JSB \SPAC LDA P22 LDB MES25 MES25 = ADDR: EQT TABLE ENTRY JSB \MESS PRINT: EQUIPMENT TABLE ENTRY * JSB SFIX GET A FIXUP ENTRY IF NEEDED SEQT JSB \SPAC SEND \SPAC LDA CEQT CPA P63 OVER LAST ALLOWED DEFINITION? JMP BLEQT YES, MAX OF 63 CMA LDB ATBUF THE CURRENT EQT JSB \CONV NUMBER TO ASCII LDA \TBUF+2 SET IN THE SETNO STA MESEQ EQT MESSAGE BUFFER LDA P7 GET MESSAGE LENGTH LDB MESQE SEND MESSAGE "EQT XX?" AND JSB \READ GET EQT RECORD FROM TTY LDA N2 JSB \GETN MOVE 2 CHARS TO \TBUF CPA "/E" CHARS = /E? JMP EQTFX YES - SET DEVICE REF TABLE (SQT) * LDA CEQT GET NUMBER OF DEFINED EQT'S CPA P63 IF OVER LIMIT JMP EQTOV THEN SEND ERROR UNTIL /E JSB \GINT RE-INITIALIZE LBUF SCAN LDA P2 JSB \GET# GET 2 OCTAL DIGITS, CONVERT JMP IOERR INVALID DIGIT JSB \GETC GET NEXT CHAR FROM LBUF CPA BLANK CHAR = COMMA? JMP CLDBU YES - SET CHNL NO., CLEAR D,B,U * IOERR LDA ERR24 SET CODE = INVALID CHNL IN EQT JSB \GNER PRINT DIAGNOSTIC JMP SEQT GET NEXT EQT RECORD * BLEQT LDA BLNKS SET EQT # TO BLANKS JMP SETNO IN PROMPT * EQTOV LDA ERR35 SET CODE = OVER 63 DEFINED EQT'S CMA,INA SIGNAL NO TR TO THE OPERATOR JSB \GNER PRINT THE DIAGNOSTIC JMP SEQT CONTINUE UNTI /E ENTERED * CLDBU LDB \OCTN GET I/O CHANNEL NO. STB IOADD SET I/O ADDRESS CLA STA IODMA CLEAR DMA FLAG STA IOBUF CLEAR AUTOMATIC BUFFERING FLAG STA IOSDM CLEAR SDA/MAPPING WORD STA XLNTH CLEAR EXTENSION LENGTH STA \FIX3,I CLEAR THE STA \FIX4,I FLAG WORDS STA \FIX2,I STA TVAL AND TIME OUT VALUE CCA STA TFLAG CLEAR TIME-OUT FLAG LDA N2 JSB \GETN MOVE 2 CHARS TO \TBUF CPA "DV" CHAR = "DV"? CLA,INA,RSS YES - CONTINUE JMP DVERR INVALID DRIVER NAME JSB \GETN MOVE 1 CHAR TO \TBUF (CHAR 3) JMP STYPE GET DRIVER TYPE * DVERR LDA ERR25 SET CODE = INVALID DRIVER NAME JSB \GNER PRINT DIAGNOSTIC JMP SEQT GET NEXT EQT RECORD * STYPE STA X. SAVE KEY CHARACTER (R FOR STD.) LDA N2 JSB \GETN MOVE 2 CHARS TO \T;BUF STA .YY SAVE 2 ASCII CHARS FOR I.XX,C.XX CCA ADA \CURL ADJUST CURRENT LBUF ADDR STA \CURL RESET \CURL TO CONVERT TYPE LDA P2 JSB \GET# GET 2 OCTAL CHARS, CONVERT JMP DVERR INVALID DRIVER NAME * LDB \OCTN GET DRIVER TYPE BLF,BLF ROTATE TO UPPER B STB IOTYP SET DRIVER TYPE JSB \GETC GET NEXT CHAR FROM LBUF CPA ZERO END OF BUFFER? JMP GENEQ SCAN FOR I.XX, C.XX CPA BLANK CHAR = COMMA? RSS YES - CONTINUE JMP DVERR NO - INVALID DRIVER NAME * CCA STA \FIX1,I STA DFLAG SET DMA-IN FLAG STA BFLAG SET BUFFERING-IN FLAG STA XFLAG SET EQT EXTEND FLAG STA SFLAG SET SDA FLAG STA MFLAG SET MAPPING FLAG * INDBU CCA STA \CMFL SET COMMA FLAG = NO COMMA IN JSB \GETC GET NEXT CHAR FROM LBUF CPA "D" CHAR = D? JMP SEDMA YES - SET DMA CODE * CPA "B" CHAR = B? JMP SETBU YES - SET BUFFERING CODE * CPA "T" CHAR = T? JMP SETIM YES - SET TIME-OUT FLAG * CPA "X" CHAR = X? JMP SETEX YES GO SET UP EQT EXTENSION * CPA "S" CHAR = S? JMP SETSD YES - SET SDA CODE FOR DVMAP * CPA "M" CHAR = M? JMP SETSM YES = SET SDA/MAPPING CODE FOR DVMAP * UNERR LDA ERR26 SET CODE = INVALID D,B,T,X JSB \GNER PRINT DIAGNOSTIC JMP SEQT GET NEXT EQT RECORD * SETIM ISZ TFLAG SKIP - FIRST T ENTERED JMP UNERR DUPLICATE T'S ENTERED JMP TEQU GET THE TIME OUT VALUE * * EQTST JSB \GETC GET NEXT CHAR FROM LBUF CPA ZERO END OF BUFFER? JMP GENEQ SCAN FOR I.XX, C.XX * CPA BLANK CHAR = COMMA? JMP INDBU YES - GET NEXT D,B,U, ENTRY JMP UNERR NO - INVALID D,B,U CHARACTER * SEDMA ISZ DFLAG  SKIP - FIRST D ENTERED JMP UNERR DUPLICATE D'S ENTERED * LDA MSIGN SET BIT 15 = 1 FOR DMA FLAG STA IODMA SET DMA CODE JMP EQTST TEST FOR NEXT OPERAND * SETBU ISZ BFLAG SKIP - FIRST B ENTERED JMP UNERR DUPLICATE B'S ENTERED * LDA BIT14 SET BIT14 = 1 STA IOBUF SET AUTOMATIC BUFFERING CODE JMP EQTST TEST FOR NEXT OPERAND * SETSD ISZ SFLAG SKIP - FIRST S ENTERED JMP UNERR DUPLICATE S'S ENTERED * LDA BIT14 SET BIT 14 = 1 JMP SETS2 IN IOSDM FOR DVMAP * SETSM ISZ MFLAG SKIP - FIRST M ENTERED JMP UNERR DUPLICATE M'S ENTERED * LDA BIT13 SET BIT 13 (MAPPING) IOR BIT14 AND BIT 14 (SDA) TO 1 SETS2 IOR IOSDM IN WORD FOR DVMAP STA IOSDM JMP EQTST TEST FOR NEXT OPERAND * SETEX ISZ \FIX1,I SKIP FIRST X ENTERED JMP UNERR NO BITCH * TEQU STA I.XX SAVE THE TYPE FLAG JSB \GETC GET THE NEXT CHARACTER CPA EQU IF NOT "=" RSS JMP UNERR BITCH * LDA N5 GET DECIMAL NUMBER JSB \GET# JMP UNERR ILLEGAL NUMBER SO BITCH * LDB I.XX GET THE TYPE FLAG CPB "X" IF EXTENSION JMP QEXT SAVE THE LENGTH OF THE EXTENSION STA TVAL SET THE TIME OUT VALUE JMP EQTST GO GET THE NEXT OPERAND * QEXT STA XLNTH SAVE EXTENSION SIZE STA \FIX3,I FOR BUILDING IT LDB \PREL SET ADDRESS OF ADB P12 EQT 13 STB \FIX2,I FOR LATER FIXUP JMP EQTST GET NEXT OPERAND * GENEQ LDA X. GET THE KEY CHARACTER STA SFLAG AND SAVE **TEMPORAY** CPA "R" IF R THEN USE LDA "." A PERIOD. IOR "INL" SET "I" IN UPPER HALF STA X. SET FOR LST SEARCH LDB ENT GET ADDRESS JSB \LSTS LOOK FOR SYMBOL JMP DVERR ILLEGAL DRIVER ENT NOT FOUND. | * LDA \LST4,I RETRIEVE IDENT INDEX OF STA \TIDN DRIVER MAIN, AND JSB \IDX SET IT UP JSB \ABOR BETTER BE THERE! LDA \ID6,I MUST BE A TYPE 0 MODULE AND M177 SZA JMP DVERR ELSE ERROR * LDB IOADD GET CHANNEL # CPB DCHNL WAS IT THE SYSTEM DISC RSS CHANNEL? JMP COMPS NO CLA MAKE SURE SDA JMP CHSM WASN'T SPECIFIED FOR IT * COMPS LDA \ID8,I WAS AN EQT PREVIOUSLY SSA,RSS DEFINED FOR THIS DRIVER? JMP SETFX NO, SO NEEDN'T CHECK AND SMBIT THE S,M SPECIFICATIONS CHSM CPA IOSDM (OR ABSENCE OF EITHER/BOTH) JMP SETFX OK, NEW CONFORMS WITH OLD, DISC NOT SDA * LDA ERR23 SET CODE = EQT DOESN'T DEFINE JSB \GNER SAME S,M SPECS FOR DRIVER - OR THE JMP SEQT SYSTEM DISC WAS SPECIFIED AS SDA * SETFX JSB SFIX GET A NEW FIXUP ENTRY LDA HIDIR SET 0 INSTR, HIBP BIT, DIRECT ADDR STA \FIX2,I CLA STA \FIX3,I CLEAR OFFSET CCA SET ADA \TLST LST INDEX OF STA \FIX4,I I.XX STA TEMP2 SAVE FOR NOCXX LDA \PREL GET EQT2 ADDRESS WHERE INA I.XX ADDRESS IS TO BE STA \FIX1,I STORED DURING FIXUP * JSB SFIX GET A NEW FIXUP ENTRY LDA HIDIR SET 0 INSTR CODE, HIBP BIT, STA \FIX2,I AND DIRECT ADDRESS CLA STA \FIX3,I CLEAR OFFSET LDA \PREL SET EQT3 ADDRESS ADA P2 WHERE C.XX ADDRESS IS TO BE STA \FIX1,I STORED DURING FIXUP * LDA X. GET THE I. OR WHAT EVER XOR B5000 CHANGE IT TO C. OR WHAT EVER STA X. AND RESET LDB ENT SCAN THE LST JSB \LSTS FOR THE "C.YY" ENTRY POINT. JMP NOCXX C.XX NOT FOUND IN LST CCA SET LST ADA \TLST INDEX OF C.XX * STCXX STA \FIX4,I IN FIXUP ENTRY LDA X. IF THIS IS CPA "CS" DVS43 THEN LDA .YY COUNT CPA "43" A ISZ SPLCO SPOOL EQT * LDA IOADD SAVE THE CHANNEL AND AND M377 TYPE IN THE HEADER ALF,ALF RECORD LDB IOTYP BLF,BLF IOR B STA HEADR,I ISZ HEADR * CLA LDB \PREL GET THE ADDRESS JSB \ABDO PUT OUT I/O LIST POINTER CLA ENTRY POINT TO BE FIXED UP JSB \ABDO OUTPUT ABSOLUTE DVRXX ENT ADDR LDA C.XX GET DRIVER EXIT POINT JSB \ABDO OUTPUT ABSOLUTE DVRXX COMP. ADDR LDA IODMA GET DMA CODE IOR IOBUF ADD BUFFERING CODE IOR IOADD ADD CHANNEL NO. JSB \ABDO OUTPUT D,B,U, CHANNEL * LDA IOTYP GET EQUIPMENT TYPE CODE AND M7000 ISOLATE UPPER 7 BITS SZA SKIP - TYPE = 0,1 CLA,RSS SET STATUS = 0, SKIP LDA BLANK SET STATUS = 40(8) IOR IOTYP ADD EQUIPMENT TYPE CODE JSB \ABDO OUTPUT EQUIPMENT TYPE, STATUS * ADB P6 INDEX TO EQT12 LDA XLNTH GET EXTENSION SIZE JSB \ABDO AND SEND IT TO THE DISC INB STEP TO EQT14 LDA TVAL GET THE TIME OUT VALUE SZA IF ZERO LEAVE IT CMA ELSE SET IT TO ONES COMPLEMENT JSB \ABDO SEND TIME OUT TO EQT INB SET THE ADDRESS STB \PREL OF THE NEXT EQT * LDB DDVMP GET DVMAP BUFFER ADDRESS ADB CEQT FOR STORAGE LDA IOSDM SET POSSIBLE S,M BITS IOR MSIGN AND EQT DEFINED BIT IOR \ID8,I STA \ID8,I IN DRIVER IDENT RAL POSITION S BIT TO 15 SSA SKIP IF NOT SDA JMP SDAEQ GO SET DVMAP ENTRY FOR SDA DRIVER * CCA GET DRIVER IDENT INDEX ADA \TIDN FOR SCAN ON RELOCATION IOR BIT14 SET TO DISTINGUISH FROM SDA,PAGE #-NLH IN ENTRY STA B,I AND STORE IN DVMAP ENTRY JMP NEXTE SET UP FOR NEXT EQT * SDAEQ STB MFLAG SAVE DVMAP ENTRY ADDR **TEMP** LDB MSIGN BIT 15 MUST BE SET FOR SDA ] N RAL POSITION M BIT TO 15 SSA SKIP IF NO MAPPING INB SET BIT 0 IF DRIVER MAPS STB MFLAG,I AND STORE IN DVMAP * NEXTE JSB SFIX GET A NEW FIXUP TABLE ENTRY IF NEEDED ISZ CEQT INCR EQT ENTRY COUNT JMP SEQT PROCESS NEXT EQT RECORD * NOCXX LDA TEMP2 C.XX NOT FOUND SO USE JMP STCXX I.XX INDEX SPC 2 MESQE DEF *+1 ASC 2,EQT DO NOT REARANGE THESE MESEQ NOP THESE THREE ASC 1,? LINES "CS" ASC 1,CS "43" ASC 1,43 D26 DEC 26 "R" OCT 122 "X" OCT 130 EQU OCT 75 ASCII "=" XFLAG NOP TVAL NOP "DV" ASC 1,DV "." OCT 56 "INL" OCT 44400 ASCII I NULL B5000 OCT 5000 BIT13 OCT 20000 HIDIR OCT 1005 HIGH BP,DIRECT LINK(DEF TO EXT) FOR FIXUPS SPC 5 EQTFX JSB \IFIX ALLOCATE AND SET UP NXEQF JSB \FIX EXTENDED EQTS JMP SDVMP END OF FIXUPS, GO BUILD DVMAP * LDA \FIX1,I GET THE TYPE FLAG SZA IF NOT ZERO THEN NOT JMP NXEQF AN EQT PATCH ENTRY * LDB \FIX2,I GET EQT13 ADDRESS LDA \PREL AND CURRENT CORE ADDRESS JSB \ABDO OUTPUT THE ADDRESS LDA \PREL RESERVE THE ADA \FIX3,I CORE STA \PREL CCA CLEAR THE FIX STA \FIX1,I ENTRY JMP NXEQF AND TRY THE NEXT ONE SPC 5 * * BUILD DRIVER MAP TABLE * SDVMP LDA CEQT SET LOOP COUNTER CMA,INA FOR NUMBER OF STA TEMP2 EQT'S DEFINED * LDB \PREL GET NEXT CORE ADDRESS SDMVL LDA DDVMP,I GET NEXT DVMAP ENTRY JSB \ABDO OUTPUT IT ISZ DDVMP BUMP BUFFER ADDRESS ISZ TEMP2 AND LOOP COUTER JMP SDMVL MORE TO GO * LDA \PREL SAVE ADDRES OF STA DVMAP DRIVER MAP TABLE ADB CEQT RESERVE SPACE FOR SECOND STB \PREL (BLANK HALF OF TABLE) * STB ASQT SET START OF DRT TABLE SKP * * SET DEVICE REFERENCE TABLE (DRT) * JSB \SPAC NEW LINE JSB \SPAC NEW LINE CLA,INA STA CSQT SET SQT COUNT = 1 CCA STA LFLAG SET 1ST DEV REF INPUT FLAG = -1 LDA P22 LDB MES26 MES26 = ADDR: *DEV REF TABLE JSB \MESS PRINT: * DEVICE REFERENCE TABLE * DEVRE LDA CSQT GET CURRENT DEV REF NO. CPA P256 OVER MAXIMUM ALLOWED? JMP BLDRT YES, GO BLANK THE # CMA,INA SET TO NEG. FOR DECIMAL CONV LDB ATBUF GET ADDRESS OF TBUF JSB \CONV CONVERT TO DECIMAL AT TBUF LDA \TBUF+2 GET 2 LEAST SIGNIFICANT DIGITS AND M7400 ISOLATE UPPER CHAR CPA UASCZ CHAR = ASCII ZERO? LDA UBLNK YES - REPLACE WITH BLANK STA B SAVE UPPER CHAR LDA \TBUF+2 GET 2-DIGIT DEV REF NO. AND M177 ISOLATE LOWER CHAR IOR B SET A = DEV REF CODE SET# STA MES28,I PUT DEV REF CODE IN MESSAGE JSB \SPAC NEW LINE LDA P11 LDB MES28 MES28 = ADDR: XX = EQT #? * JSB \READ GET SQT RECORD FROM TTY LDA N2 JSB \GETN MOVE 2 CHARS TO TBUF CPA "/E" CHARS = /E? JMP SINTT YES - SET INTERRUPT TABLE LDA CSQT WAS THIS DRT ALLOWED? CPA P256 NO MORE THAN 255 JMP DRTOV OVER LIMIT JSB \GINT RE-INITIALIZE LBUF SCAN LDA N2 JSB \GET# GET 2 DECIMAL DIGITS, CONVERT JMP DRERR INVALID DIGIT ENTERED STA TEMPL SAVE DEV. REF. NO. SZA,RSS IF NO CHANNEL JMP SUBCH IGNOR SUBCHANNEL JSB \GETC COMMA ENCOUNTERED? SZA,RSS YES - GO GET SUBCHANNEL JMP SUBCH NO - DEFAULT IT TO ZERO * LDA N2 JSB \GET# GET TWO DECIMAL DIGITS JMP DRERR AND M37 KEEP MAX SIZE CPA \OCTN IF NOT SAME JMP SUBCH JMP DRERR THEN ERROR * BLDRT LDA BLNKS  SET DRT # TO BLANKS JMP SET# WHEN MORE THAN 63 * DRTOV LDA ERR35 SET CODE = MORE THAN 63 DRT'S CMA,INA SIGNAL NO TR TO OPERATOR JSB \GNER PRINT DIAGNOSTIC JMP DEVRE CONTINUE UNTIL /E ENTERED * SUBCH STA TEMPS SAVE SUB CHANNEL ALF,ALF SET SUBCHANNEL NO. ALF,RAR INTO BITS 13 - 11 STA TEMPH SAVE SUBCHANNEL NO. LDA TEMPL GET DEV. REF. NO. CMA,INA COMPLEMENT ADA CEQT ADD NO. EQT ENTRIES SSA SKIP IF VALID DEV. REF NO. JMP DRERR INVALID DEV. REF. NO. (NO EQT) LDA TEMPL GET DEV. REF NO. LDB CSQT GET CURRENT SQT NO. CPB P1 FIRST ENTRY? RSS YES - CONTINUE CPB P2 SECOND ENTRY? RSS YES - CONTINUE JMP SESQT PUT OUT DEV REF NO. TO SQT SZA,RSS SKIP IF DEV REF IS NOT ZERO JMP DRERR INVALID DEV. REF. NO. CPB P1 FIRST SQT ENTRY? RSS YES - CONTINUE (SET TTY CHANNEL) JMP SESQT PUT OUT DEV. REF. NO. TO SQT CMA,INA COMPLEMENT CURRENT DEV. REF. NO. LDB AEQT GET ADDRESS OF EQT INA,SZA,RSS SKIP - DEV. REF. NOT 1 JMP *+4 SET TTY CHANNEL NO. = FIRST EQT ADB P15 ADJUST CURRENT EQT ADDRESS INA,SZA SKIP - EQT FOUND JMP *-2 CONTINUE CURRENT EQT SEARCH STB TTYCH SET EQT ADDR IN TTY CHANNEL * ADB P3 RETRIEVE THE CHANNEL NO. JSB \ABDO TO INSERT IN THE HEADER RECORD STA TB30+127 PLACE IN LAST WORD FOR NOW ADB N1 RESTORE THE WORD JSB \ABDO * SESQT LDB CSQT SET UP TO TEST LDA TEMPS FOR PROPER SUB CHANNEL REFERENCES CPB P2 DEV. REF = 2? CPA SYSCH YES - SYSTEM SUB CHANNEL? RSS YES - YES OR NO -X SKIP JMP DRERR YES - NO - ERROR CPB P3 DEV. REF =3? CPA AUXCH YES - AUX SUB CHANNEL? JMP SETQT YES - YES OR NO - X - GO SETUP * LDA AUXCH GET THE CHANNEL SSA IF DISC ON DIFFERENT CONTROLER JMP SETQT GO SET IT UP * LDA TEMPL YES - NO - TEST FOR AUX UNIT DEFINED LDB DAUXN SZB SKIP IF NO AUX UNIT JMP DRERR AUX DEFINED SO ERROR * SZA NO AUX-UNIT WAS REF = 0? JMP DRERR NO - SO ERROR * SETQT LDA TEMPL GET DEV. REF. NO. IOR TEMPH SET IN SUBCHANNEL NO. LDB CSQT SET UP TO TEST FOR ILLEGAL DISC REF. CPA DRT2 IF SAME AS SYSTEM DISC JMP DRERR ERROR CPB P2 IF SYSTEM DISC ENTRY STA DRT2 SET FOR FUTURE TESTING CPA DRT3 IF SAME AS AUX DISC JMP DRERR ERROR SZA,RSS IF ZERO SKIP JMP *+3 TEST FOR AUX ENTRY CPB P3 IF AUX ENTRY STA DRT3 SET FOR FUTURE TESTING LDB \PREL SET CORE ADDRESS JSB \ABDO OUTPUT SQT ENTRY ISZ \PREL INCR CURRENT RELOC ADDRESS ISZ CSQT INCR CURRENT SQT COUNT JMP DEVRE GET NEXT SQT ENTRY * DRERR LDA ERR27 SET CODE = INVALID DEV. REF. NO. JSB \GNER PRINT DIAGNOSTIC JMP DEVRE REPEAT INPUT * TEMPL NOP TEMPH NOP TEMPS NOP HEADR NOP D$CIC DEF $CIC P256 DEC 256 SKP SINTT LDA DRT2 GET EQT # FOR SYSTEM DISC AND M77 CCB AND OFFSET INTO THE DRIVER MAP TABLE ADB A IN ORDER TO GET THE ADB DVMAP JSB \ABDO IDENT INDEX OF THE SYSTEM STA SDID DISC DRIVER TO FORCE IT INTO ADB N1 DP #1 AT RELOCATION TIME JSB \ABDO RE-STORE SDID VALUE * JSB \SPAC NEW LINE JSB \SPAC NEW LINE CCB ADB CSQT SUBTRACT 1 FROM SQT COUNT STB CSQT SET SQT COUNT * ADB \PREL THE FOLLOWING ALLOWS FOR TWO WORDS STB \PREL PER DR2T ENTRY CLA ZERO THEM OUT STA ENDFL JSB \ABDO * * SET INTERRUPT TABLE (INT) * LDA \PREL GET CURRENT RELOCATION ADDR STA AINT SAVE INTERRUPT TABLE ADDRESS LDA \ADSK GET CURRENT ABS. CODE DISK ADDR STA DSKIN SAVE INT CODE DISK ADDR LDA DCNT GET CURRENT ABS. CODE DBUF COUNT STA INTCN SAVE INT CODE DISK RECORD COUNT LDA P15 LDB MES29 MES29 = ADDR. * INT TABLE JSB \MESS PRINT: * INTERRUPT TABLE LDB AILST GET ADDRESS OF ILIST STB CURIL GET CURRENT ILIST ADDRESS JSB BUFCL CLEAR ILIST * LDB D$CIC GET LST INDEX FOR JSB \LSTS SYSTEM MODULE $CIC JMP NOCIC NOT FOUNT, BAD!! CCA ADA \TLST FOR STORAGE IN STA JSCIC FIXUP ENTRIES * CLA ALLOCATE FIXUP ENTRIES FOR SETIL STA TCNT INT. LOCATIONS 0-3,5 * JSB SFIX GET A NEW FIXUP ENTRY LDA TCNT AND GO BUILD IT JSB INTFX FOR THIS LOCATION INA BUMP TO NEXT LOCATION CPA P4 SKIP LOCATION 4 INA (SET BELOW) CPA P6 DONE WITH THE LOOP? RSS YES JMP SETIL NO, CONTINUE FIXUP'S * LDB P4 INITIALIZE TRAP CELL FOUR ADB \ADBP ADJUST TO PSEUDO BASE PAGE LDA HLTB4 TO HALT(B) 4 STA B,I ADB P2 GET ADDR OF FIRST INT LOCATION, 6 STB MEM12 SET CURRENT BP ADDRESS JSB \SPAC * SETIN JSB SFIX GET A NEW FIXUP ENTRY IF NEEDED * CLA,INA NEW LINE LDB HYADD JSB \READ GET INT RECORD FROM TTY LDA N2 JSB \GETN MOVE 2 CHARS TO TBUF CPA "/E" CHARS = /E? JMP ENDIO YES - I/O TABLES COMPLETE JSB \GINT RE-INITIALIZE LBUF SCAN LDA P2 JSB \GET# GET 2 OCTAL DIGITS, CONVERT JMP CHERR INVALID INT CHANNEL NO. DIYfGIT JSB \GETC GET NEXT CHAR FROM LBUF CPA BLANK CHAR = COMMA? JMP SETCH SAVE INT CHANNEL NO. CHERR LDA ERR28 SET CODE = INVALID INT CHNL NO. JSB \GNER PRINT DIAGNOSTIC CCA STA \FIX1,I CLEAR FIXUP ENTRY JMP SETIN REPEAT INT REC INPUT * NOCIC LDA ERR21 SET CODE = CIC NOT FOUND IN LST JSB \IRER IRRECOVERABLE ERROR * SETCH LDA \OCTN GET INT CHANNEL NO. STA INTCH SAVE CHANNEL NO. * LDA N2 JSB \GETN MOVE 2 CHARS TO TBUF CPA "EQ" CHARS = EQ? JMP INTEQ YES - PROCESS INT EQT RECORD * CPA "PR" CHARS = PR? JMP INTPR YES - PROCESS INT PRG RECORD * CPA "EN" CHARS = EN? JMP INTEN YES - PROCESS INT ENT RECORD * CPA "AB" CHARS = AB? JMP INTAB YES - PROCESS INT ABS RECORD * IMNEM LDA ERR30 SET CODE = INVALID INT MNEMONIC JSB \GNER PRINT DIAGNOSTIC JMP SETIN REPEAT INT REC INPUT * INTEQ LDA N2 JSB \GETN MOVE NEXT 2 CHARS TO \TBUF CPA UTCHR CHARS = T,BLANK? RSS YES - CONTINUE JMP IMNEM NO - INVALID INT MNEMONIC LDA N2 JSB \GET# GET 2 DECIMAL DIGITS, CONVERT JMP EQUER INVALID EQT NO. IN INT REC LDB \OCTN GET EQT TABLE ENTRY NO. CMB,INB,SZB,RSS SKIP - VALID LOWER LIMIT JMP EQUER INVALID EQT REFERENCE STB TCHR SAVE EQT NO. ADB CEQT ADD UPPER EQT REF. NO. SSB,RSS SKIP - INVALID UPPER LIMIT JMP TSTIQ TEST FOR FIRST EQT REFERENCE * EQUER LDA ERR31 SET CODE = INVALID EQT NO. JSB \GNER PRINT DIAGNOSTIC JMP SETIN REPEAT INT REC INPUT * TSTIQ LDB TCHR GET EQT REF. NO. LDA AEQT GET ADDR OF EQT INB,SZB,RSS SKIP - NOT FIRST EQT REFERENCE JMP SEQTI SET EQT ADDR IN INT TABLE * ADA P15 ADJUST FOR NEXT EQT ENTRY ADDR INB,/\SZB SKIP - EQT ADDRESS FOUND JMP *-2 CONTINUE EQT SEARCH * SEQTI LDB JSCIC GET $CIC INDEX JMP COMIN SET INTERRUPT TABLE, LOCATION * INTPR LDA N2 JSB \GETN MOVE 2 CHARS TO \TBUF CPA UGCHR CHARS = G,BLANK? RSS YES - CONTINUE JMP IMNEM NO - INVALID INT MNEMONIC LDA N5 JSB \GETN MOVE 5 CHARS TO \TBUF * LDB ATBUF FIND THE PROGRAM JSB \IDXS IN THE IDENT LIST JMP PRERR INVALID PROGRAM NAME LDB JSCIC GET $CIC INDEX LDA \TIDN GET CURRENT IDENT INDEX ADA N1 CMA,INA SET NEGATIVE JMP COMIN SET INTERRUPT TABLE, LOCATION * PRERR LDA ERR32 SET CODE = INVALID PROGRAM NAME JSB \GNER PRINT DIAGNOSTIC JMP SETIN REPEAT INT REC INPUT * * INTEN LDA N2 JSB \GETN MOVE 2 CHARS TO \TBUF CPA UTCHR CHARS = T, BLANK RSS YES - CONTINUE JMP IMNEM INVALID INT MNEMONIC LDA N5 JSB \GETN MOVE 5 CHARS TO \TBUF * LDB ATBUF FIND THE ENTRY JSB \LSTS IN THE \LST JMP ENERR INVALID ENTRY POINT LDA \LST4,I GET IDENT INDEX SZA,RSS SKIP - ENT IS DEFINED JMP ENERR INVALID ENTRY POINT STA \TIDN SET IDENT INDEX OF PROGRAM JSB \IDX SET IDENT ADDRESSES JSB \ABOR END OF IDENT LIST LDA \ID6,I GET PROGRAM TYPE AND M177 ISOLATE TYPE SZA SKIP IF A SYSTEM PROGRAM JMP ENERR ERROR IF NOT LDB \ID8,I CHECK IF HAS AN EQT SSB,RSS SKIP IF DOES JMP SETEN NOT,SO ALWAY PRESENT IN SYS MAP RBL MOVE SDA BIT TO 15 SSB SKIP IF NOT SDA JMP SETEN MUST BE IN SDA IF A DRIVER * ENERR LDA ERR33 SET CODE = INVALID ENTRY POINT JSB \GNER PRINT DIAGNOSTIC JMP SETIN REPEAT INT RECORD INPUT * * ALLOCATE A FIXUP FORX THE ENT * * SETEN LDA IJSB BUILD FIXUP TABLE ENTRY IOR HIBP SET TO UPPER LINK STA \FIX2,I AND STORE JSB 0,I CODE LDB INTCH AND THE INT LOCATION STB \FIX1,I CCA ADA \TLST STORE THE LST INDEX OF STA \FIX4,I THE ENT CLA CLEAR THE STA \FIX3,I OFFSET JSB SFIX MAY NEED ANOTHER FIXUP CLA CLB SET INT ENTRY & LOC TO 0 JMP COMIN * INTAB LDA N2 JSB \GETN MOVE 2 CHARS TO TBUF CPA USCHR CHARS = U,BLANK RSS YES - CONTINUE JMP IMNEM NO - INVALID INT MNEMONIC LDA P6 JSB \GET# GET 6 OCTAL DIGITS, CONVERT JMP ABERR INVALID ABS DIGIT CLA LDB \OCTN GET ABSOLUTE VALUE * * THE 4 FORMATS ARE NOW: * ENT: A-REG = 0 B-REG = 0 * PRG: A-REG = - IDENT INDEX B-REG = $CIC IDENT INDEX * EQT: A-REG = EQT ADDRESS B-REG = $CIC IDENT INDEX * ABS: A-REG = 0 B-REG = ABSOLUTE VALUE * COMIN STA \TBUF SAVE INT TABLE CODE STB \TBUF+1 SAVE INT LOCATION CODE JSB \GETC GET NEXT CHAR FROM LBUF CPA ZERO END OF BUFFER? JMP *+4 YES - CONTINUE * LDA ERR36 SET CODE = INVALID FINAL OPRND JSB \GNER PRINT DIAGNOSTIC JMP SETIN GET NEXT INT RECORD * LDA INTCH GET INT CHANNEL NO. CPA P4 SPECIAL PROCESSING JMP PFINT IF TRAP CELL FOUR FILLM CMA,INA ADA \NABP ADJUST FOR BP LOCATION ADDR ADA MEM12 ADD CURRENT BP ADDRESS SZA,RSS SKIP - NOT NEXT LOCATION JMP STINT SET INTERRUPT TABLES, LOCATION * SSA SKIP - INVALID CHANNEL NO. ORDER JMP FILLI FILL IN SKIPPED VALUES LDA ERR29 SET CODE = INVALID INT CHNL ORDR JSB \GNER PRINT DIAGNOSTIC CCA STA \FIX1,I MARK ENTRY AS FREE JMP SETIN GEyT NEXT INTERRUPT RECORD * PFINT LDA \TBUF IF TRAP CELL FOUR, SZA ENTRY MUST BE AN JMP CHERR 'ABS' OR AN 'ENT' * LDA \ADBP ADA P4 ADJUST LDB \TBUF+1 STORE INTO STB A,I TRAP CELL FOUR JMP SETIN GET NEXT INTERRUPT RECORD * HLTB4 OCT 106004 TRAP CELL DEFAULT VALUE * FILLI STA TCNT SET NO. OF FILL-INS REQUIRED FILLJ CLA SET INTERRUPT TABLE ENTRY = ZERO LDB \PREL GET ADDRESS JSB \ABDO OUTPUT ZERO TO INTERRUPT TABLE ISZ \PREL INCR CURRENT INT TABLE ADDRESS LDA MEM12 GO BUILD A FIXUP TO ADA \NABP JSB INTFX $CIC FOR THIS INT LOCATION JSB SFIX GET A NEW ENTRY ISZ MEM12 INCR CURRENT INT LOCATION ADDR ISZ CURIL STEP THE INT IMAGE ADDRESS ISZ TCNT SKIP - ALL FILL-INS COMPLETE JMP FILLJ CONTINUE INT FILL-IN * STINT LDB \TBUF+1 IF THIS IS A "JSB $CIC,I" CPB JSCIC (IE, LST INDEX) JMP FXINT THEN GO BUILD A FIXUP STB MEM12,I ELSE PUT INT LOCATION CODE IN INT LOC STIN1 ISZ MEM12 INCR CURRENT BP LOCATION ADDR * LDA \TBUF GET INT TABLE CODE STA CURIL,I SET WORD IN INT IMAGE ISZ CURIL STEP IMAGE ADDRESS FOR NEXT TIME LDB \PREL GET CORE ADDRESS JSB \ABDO OUTPUT INT TABLE ENTRY ISZ \PREL INCR CURRENT RELOCATION ADDR ISZ ENDFL DONE WITH THE TABLE? JMP SETIN NO, GET NEXT LOCATION JMP ITAI YES, EXIT * FXINT LDA INTCH GO CHANNEL #(INT LOC.) JSB INTFX GO BUILD A JSB $CIC,I FIXUP FOR IT JSB SFIX AND GET A FREE ENTRY JMP STIN1 CONTINUE * ABERR LDA ERR34 SET CODE = INVALID ABS DIGIT JSB \GNER PRINT DIAGNOSTIC JMP SETIN REPEAT INT REC INPUT * ENDIO LDA M77 WERE ALL LOCATIONS CPA INTCH DEFINED? JMP ITAI YES,NEEDN'T FILL IN STA INTCH {GNO, MUST SiMULATE A CLB DEFINITION OF 77B STB \TBUF IN ORDER TO FILL IN ALL LDB JSCIC INTERRUPT LOCATIONS STB \TBUF+1 AND THE TABLE CCB SET FLAG STB ENDFL TO EXIT FROM FILLJ TO ITAI JMP FILLM GO SET LOOP COUNT * ITAI JSB \SPAC LDA P20 LDB MES30 JSB SETHD PRINT: TABLE AREA I MODULES JMP \IOTB,I AND INITIALIZE IDX * ENDFL NOP END OF TABLE FLAG = -1 ON LAST PASS P20 DEC 20 SPC 3 * BUILD A FIXUP ENTRY FOR A JSB $CIC,I * AT THE LOCATION IN A-REG * INTFX NOP STA \FIX1,I SAVE THE INSTRUCTION ADDRESS LDB IJSB GET THE INSTRUCTION ADB HIBP MERGE IN THE HIGH BP LINK FLAG STB \FIX2,I AND SAVE LDB JSCIC GET LST INDEX OF STB \FIX4,I $CIC, AND SAVE CLB STB \FIX3,I CLEAR OFFSET JMP INTFX,I SKP * IOADD BSS 1 I/O ADDR (CHANNEL NO.) IN EQT IOSDM BSS 1 I/O SDA/MAPPING FLAG IN EQT IODMA BSS 1 I/O DMA FLAG IN EQT IOBUF BSS 1 I/O BUFFERING FLAG IN EQT IOTYP BSS 1 I/O DRIVER TYPE IN EQT (OCTAL) DFLAG BSS 1 DMA-IN FLAG FOR EQT BFLAG BSS 1 BUFFERING-IN FLAG FOR EQT TFLAG BSS 1 TIME-OUT ENTRY FLAG FOR EQT SFLAG BSS 1 SDA ENTRY FLAG FOR EQT MFLAG BSS 1 MAPPING FLAG FOR EQT XLNTH BSS 1 EQT EXTENSION SIZE FOR EQT INTCH BSS 1 INT RECORD CHANNEL NO. JSCIC BSS 1 JSB CIC,I CODE FOR INTERRUPT LOC I.XX BSS 1 DRIVER ENTRY POINT C.XX BSS 1 DRIVER EXIT POINT SPC 3 MS28 ASC 6, = EQT #? MS29 ASC 8,INTERRUPT TABLE ENT DEF *+1 X. ASC 1,I. .YY NOP ASC 1, SPC 1 MES25 DEF *+1 ASC 11,EQUIPMENT TABLE ENTRY SPC 1 MES26 DEF *+1 ASC 11,DEVICE REFERENCE TABLE SPC 1 MES30 DEF *+1 ASC 10,TABLE AREA I MODULES MES31 DEF *+1 ASC 11,TABLE AREA II MODULES l SPC 2 ERR21 ASC 1,21 $CIC NOT FOUND IN LST ERR23 ASC 1,23 DRIVER S,M SPEC'S DON'T CONFORM ERR24 ASC 1,24 INVALID CHANNEL NO. IN EQT REC ERR25 ASC 1,25 INVALID DRIVER NAME ERR26 ASC 1,26 INVALID D,B, OR T OPERAND ERR27 ASC 1,27 INVALID DEVICE REF. NO. ERR28 ASC 1,28 INVALID INT REC CHANNEL NO. ERR29 ASC 1,29 INVALID INT CHANNEL NO. ORDER ERR30 ASC 1,30 INVALID INT REC MNEMONIC ERR31 ASC 1,31 INVALID EQT NO. IN INT RECORD ERR32 ASC 1,32 INVALID PROGRAM NAME IN INT REC ERR33 ASC 1,33 INVALID ENTRY POINT IN INT RECORD ERR34 ASC 1,34 INVALID ABS VALUE IN INT REC ERR35 ASC 1,35 MORE THAN 63 EQT OR DRT ENTRIES ERR36 ASC 1,36 INVALID FINAL OPERAND IN INT REC ERR58 ASC 1,58 MAX # PARTITIONS IS ,=0, >64 ERR60 ASC 1,60 TOTAL # ID SEGMENTS > 255 "/E" ASC 1,/E IJSB JSB 0 JSB CODE FOR INTERRUPT LOCS UASCZ OCT 30000 UPPER ASCII ZERO CHAR "D" OCT 104 ASCII CHAR D "B" OCT 102 ASCII CHAR B "T" OCT 124 ASCII CHAR T "S" OCT 123 ASCII CHAR S "M" OCT 115 ASCII CHAR M BIT14 OCT 40000 BIT 14=1 $CIC ASC 3,$CIC "EQ" ASC 1,EQ "PR" ASC 1,PR "EN" ASC 1,EN "AB" ASC 1,AB UTCHR ASC 1,T UGCHR ASC 1,G USCHR ASC 1,S MES28 DEF MS28 MES29 DEF MS29 SPC 2 ZERO DEC 0 P1 DEC 1 P2 DEC 2 P3 DEC 3 P4 DEC 4 P5 DEC 5 P6 DEC 6 P7 DEC 7 P9 DEC 9 P10 DEC 10 P11 DEC 11 P12 DEC 12 P13 DEC 13 P15 DEC 15 P24 DEC 24 P25 DEC 25 P28 DEC 28 P29 DEC 29 P32 DEC 32 P63 DEC 63 P64 DEC 64 N2 DEC -2 N3 DEC -3 N5 DEC -5 N8 DEC -8 N11 DEC -11 N65 DEC -65 LM100 OCT -100 M37 OCT 37 M77 OCT 77 M377 OCT 377 M177 OCT 177 M7000 OCT 177000 M7400 OCT 177400 SMBIT OCT 60000 MSIGN OCT 100000 BLANK OCT 40 BLNKS OCT 20040 HYADD DEF *+1 ASC 1,- UBLNK OCT 20000 TEMP3 NOP SKP * * GENERATE THE CLASS I/O TABLE ($CLAS) * \TzBLS NOP JSB \SPAC JSB \SPAC LDA P13 LDB MES31 JSB \MESS PRINT: TABLE AREA II JSB \SPAC JSB RED2 SEND MESSAGE AND GET ANSWER DEC 18 18 CHARACTERS DEF MES04 '# OF I/O CLASSES?' DEF $CLS ADDRESS OF ENT NAME ADB \OCTN RESERVE ROOM STB \PREL FOR IT (SETS IT TO ZERO) * * GENERATE THE LU MAP TABLE ($LUSW) * JSB RED2 SEND MESSAGE AND GET ANSWER DEC 18 DEF MES05 '# OF LU MAPPINGS?' DEF $LUMP ADDRESS OF ASC ENT NAME LDA \OCTN INITILIZE THE TABLE CMA,INA TO STA \TBUF -1'S NXLUM CCA AND JSB \ABDO THEN ISZ \TBUF JMP NXLUM RESET * STB \PREL THE RELOCATION ADDRESS * * GENERATE THE RN TABLE ($RNTB) * JSB RED2 SEND MESSAGE AND GET P22 DEC 22 ANSWER DEF MES06 '# OF RESOURCE NUMBERS?' DEF $RNTB ADDRESS OF ENT POINT NAME ADB \OCTN RESERVE THE TABLE AREA STB \PREL (SETS IT TO ZERO) * * SET UP THE BUFFER LIMITS ($BLLO,$BLUP) * BLGEN LDA D26 SEND MESSAGE 'BUFFER LIMITS (LOW,HIGH)?' LDB DMES7 AND GET ANSWER JSB \READ JSB BLSET SET UP DEF $BLLO LOWER LIMIT JMP BLGEN IF ERROR TRY AGAIN STA BLLO SAVE THE NEGATIVE VALUE * JSB BLSET NOW SET UP THE UPPER LIMIT DEF $BLHI JMP BLGEN IF ERROR TRY AGAIN STA BLHI SAVE THE NEGATIVE VALUE * * GENERATE THE LU AVAILABILITY TABLE ($LUAV) * LDB $LUAV MAKE THE LUAV TABEL JSB \LSTS FIRST SET UP THE ENTRY JSB \ABOR IT BETTER BE THERE LDB \PREL GET THE CORE ADDRESS STB \LST5,I SET THE ADDRESS LDA SPLCO GET THE NUMBER OF ENTRYS CMA,INA,SZA IF ZERO SKIP THE TABLE GEN. JSB \ABDO SEND THE TABEL HEAD (IF NONE ZERO) ADB SPLCO gNLH ADJUST FOR THE TABLE SIZE ADB SPLCO (TWO WORD ENTRYS) STB \PREL SET THE NEW ADDRESS N JSB DAFIX GO FIX UP ANY REFERENCES JSB \SPAC * LDA TBREL UPDATE ANY LINKS USED BY FIXUPS STA PBREL TO $CLAS,$LUSW,$RNTB,$BLLO,$BLUP,$LUAV * * CHECK IF MAX # OF LONG ID SEGMENTS ALREADY EXCEEDED * LDA LICNT IF MORE THAN 255 MAIN PROGRAMS TO BE ADA SICNT RELOCATED DURING GENERATION ADA N255 THEN WE'RE GONNA ABORT SSA AND LET THEM DECIDE JMP BLONG WHICH ONES TO DELETE LDA ERR60 JSB \IRER SEND DIAGNOSTIC & ABORT * * GET THE # OF BLANK ID SEGMENTS AND EXTENSIONS. * * LONG * BLONG LDA P24 LDB MES42 PRINT: # OF BLANK ID SEGMENTS? JSB GETBL RETRIEVE ANSWER SZA,RSS IF ZERO, ADD 1 INA FOR BG ONLINE LOADING ADA LICNT ADD TO LONG ID SEGMENT COUNT LDB A SAVE ADA SICNT ADD CURRENT MRES. ID SEG COUNT ADA N255 IF > 254 MAXIMUM SSA THEN ERROR JMP BLON1 OK * LDA ERR60 SET ERROR CODE JSB \GNER DIAGNOSTIC JMP BLONG TRY AGAIN * N255 DEC -255 * * BLON1 STB LICNT SAVE LONG ID SEGMENT COUNT * * SHORT: * JSB \SPAC BSHOR LDA P29 LDB MES43 PRINT: # OF BLANK SHORT ID SEGMENTS? JSB GETBL RETRIEVE ANSWER ADA SSCNT ADD TO SEG ID SEGMENT COUNT LDB A SAVE AND M7400 IF > 255 MAXIMUN SZA,RSS THEN ERROR JMP BSHO1 OK * LDA ERR60 SEND ERROR CODE JSB \GNER DIAGNOSTIC JMP BSHOR TRY AGAIN * BSHO1 STB SSCNT SAVE SEG ID SEGMENT COUNT ADB LICNT ADD LONG ID SEGMENT COUNT ADB SICNT ADD SHORT ID SEGMENT COUNT INB ADD ONE FOR STOP WORD STB KEYCN AND SAVE KEYWORD COUNT * * EXTENSIONS: * JSB \SPAC BLEXT LDA P25 LDB MES44 PRINT: # OF BLANK ID EXTENSIONS? JSB GETBL RETRIEVE ANSWER SZt"A,RSS IF NO BLANKS INA THE SET TO 1 EXTRA ANYWAY ADA IXCNT ADD TO CURRENT ID EXTENSION COUNT LDB A SAVE AND M7400 IF > 255 MAXIMUM SZA,RSS THEN ERROR JMP BEXT1 OK * LDA ERR60 SEND ERROR CODE JSB \GNER DIAGNOSTIC JMP BLEXT * BEXT1 LDA B MAKE SURE THAT THE # OF CMA,INA EXTENSIONS IS LESS THAN ADA LICNT THE NUMBER OF LONG SSA,RSS ID SEGMENTS JMP BEXT2 JSB \INER ELSE ASK AGAIN JMP BLEXT * BEXT2 INB ADD ONE FOR STOP WORD STB IXCNT AND SAVE COUNT * * GET MAXIMUM # OF PARTITIONS TO BE DEFINED * JSB \SPAC GMNP LDA P24 LDB MES45 PRINT: MAXIMUM # OF PARTITIONS? JSB \READ SEND MESSAGE & GET ANSWER LDA N5 CHECK FOR 2 DECIMAL DIGITS JSB \GET# IN RESPONSE RSS ERROR JMP GMNP2 * GMNP1 JSB \INER SEND ERROR DIAGNOSTIC JMP GMNP TRY AGAIN * GMNP2 LDB N65 IF MORE THEN ADB A 64, THEN SSB,RSS JMP GMNP1 ERROR * STA MAXPT SAVE MAX # OF PARTITIONS * * RESERVE SPACE AND INITIALIZE ID EXTENSIONS * LDA \PREL GET CURRENT RELOC ADDR STA IDEX SET ADDRESS OF $IDEX TABLE ADA IXCNT ADD # OF EXTENSIONS (INCL STOP WORD) STA \PREL UPDATE CURRENT RELOC ADDR TO IDEX LIST CCB INITIALIZE ADB IXCNT LOOP COUNTER SZB,RSS SKIP IF > 0 EXTENSIONS JMP NOIDX GO SET STOP WORD ONLY * CMB,INB INITIALIZE EACH EXTENSION STB TEMP2 TO THE ENTRY ADDRESS LDB IDEX GET FIRST TABLE ADDRESS * SETX STA TEMP3 SAVE ADDRESS JSB \ABDO SET POINTER FROM TABLE TO LIST LDA TEMP3 RETRIEVE ADDRESS ADA P3 BUMP TO NEXT LIST ENTRY ISZ TEMP2 END OF LIST? JMP SETX NO CCB G POSITION TO LAST WORD ADB A OF EXTENSION LIST RSS * NOIDX LDB IDEX GET STOP WORD CLA SET TO 0 STA IDEXC THE # OF EXTENSIONS USED JSB \ABDO ZERO-FILL THE ENTIRE LIST STB \PREL UPDATE RELOC ADDRESS * * SET UP THE KEYWORD AREA * STB KEYAD SET CURRENT KEYWORD ADDRESS STB CURAK SET FOR ID SEG GENERATION, TOO ADB KEYCN ADD TOTAL KEYWORD COUNT STB \PREL SET NEW RELOC ADDR FOR ID SEG STB SYSAD SET INITIAL ID SEGMENT ADDRESS STB IDSAD SET ADDRRESS OF FIRST ID SEG STB CURAI SET ADDRESS FOR OUTID LDA KEYAD COMPUTE THE KEYWORD ADDRESS ADA LICNT FOR SHORT ADA SICNT BACKGROUND SEGMENT ID SEGMENTS STA \SKYA AND SET IT STA \ASKY AND ALSO FOR BLANK GENERATION LDB IDSAD GET DISK ADDR OF FIRST ID SEGMENT CLA BY SENDING FIRST WORD JSB \ABDO TO THE DISK * * SET UP ID SEGMENT AREA * CCA BACK UP TO ID SEGMENT START ADA B AND MASK TO POSITION IN AND M77 SECTOR (MOD 640)F, THEN SAVE STA IDSP FOR BASE PAGE LATER LDA \ADSK GET CURRENT DISK ADDRESS STA DSKID SET DISK ID ADDRESS STA DSKSY SET INITIAL ID SEGMENT DISK ADDR * * SAVE SPACE FOR ID SEGMENTS * LDA P29 LENGTH OF SHORT ID SEGMENTS MPY SICNT TIMES # DESIRED (NEEDED+BLANKS) STA \OCTN SAVE COUNT LDA LICNT GET LONG ID SEGMENT COUNT MPY P33 TIME # DESIRED ADA \OCTN ADD THE SHORT COUNT ADA \PREL ADD THE BASE ADDRESS STA \OCTN SAVE THE ADDRESS ADA N11 COMPUTE THE KEY ADDRESS FOR FIRST STA \SSID BG SEG ID SEGMENT & SAVE LDA SSCNT RESERVE ROOM FOR MPY P9 THE BG SEG ID SEGMENTS ADA \OCTN COMPUTE NEW MEMORY ADDRESS * * RESERVE SPACE FOR YMEMORY ALLOCATION TABLE, * MEMORY RESIDENT PROGRAM MAP, AND MEMORY * PROTECT FENCE TABLE. * STA MAT. SAVE STARTING ADDRESS OF MAT STA \OCTN SAVE LDA MAXPT MULTIPLY # PARTITIONS MPY P7 BY # WORDS/ENTRY ADA \OCTN GET NEXT AVAILABLE MEMORY ADDR STA MAP. SAVE AS ADDR OF MRMP ADA P32 ADD LENGTH OF MAP STA MPFT. THEN SAVE START OF MPFT ADA P6 ADVANCE PAST MPFT * * RESERVE SPACE FOR THE DISC DICTIONARY * STA ADICT SAVE ADDR OF DISC DICTIONARY ADA DSIZE ADJUST FOR DISC DICT LENGTH ADA DAUXN PLUS AUX DISC LENGTH * STA \PREL SAVE NEW RELOCATION ADDRESS CCB RESERVE ALL THE SPACE SO FAR ADB A BY SENDING THE LAST WORD CLA THE ENTIRE SPACE WILL JSB \ABDO BE ZERO-FILLED * JSB \SPAC LDA P22 PRINT: TABLE AREA II MODULES LDB MES31 FOR NEXT STEP JSB SETHD AND INITIALIZE FOR SCANS JMP \TBLS,I RETURN * P33 DEC 33 SKP * * SETHD PRINTS THE HEADING AND INITIALIZES FOR IDENT * TABLE SCANNING. IT ALSO SET THE NO-PROGRAMS-LOADED- * YET FLAG. * SETHD NOP DST \TBUF SAVE THE MESSAGE SPECS JSB \SPAC NEW LINE DLD \TBUF NOW JSB \MESS PRINT THE HEADING JSB \SPAC NEW LINE CCA STA LFLAG SET PROGRAMS-LOADED-FLAG = -1 LDA P10 GET FIRST IDENT INDEX STA CIDNT FOR ORIGIN OF SCAN JMP SETHD,I RETURN SKP * THE BLSET ROUTINE SETS UP THE BUFFER LIMITS. * * CALLING SEQUENCE: * * JSB BLSET * DEF ENT NAME ENTRY POINT NAME ADDRESS * JMP RETRY ERROR RETURN * * --- NORMAL EXIT * BLSET NOP FIRST FIND LDB BLSET,I THE ENTRY POINT ISZ BLSET STEP RETURN ADDRESS JSB \LSTS SEARCH FO_R THE ENTRY JMP \ABOR IF NOT FOUND JUST EXIT * LDA N5 CONVERT A 5 DIGIT DECIMAL JSB \GET# LIMIT JMP BLERR ERROR TAKE ERROR EXIT * CMA,INA SET THE LIMIT NEGATIVE AND ISZ BLSET STEP TO OK RETURN JMP BLSET,I AND RETURN * BLERR JSB \INER SET ERROR 01 JMP BLSET,I AND TAKE ERROR RETURN SKP * * THE RED2 SUBROUTINE IS USED TO SET UP TABLES * WHICH START WITH THERE SIZE AS THE FIRST WORD * * CALLING SEQUENCE: * * JSB RED2 * DEC XX CHARACTER COUNT OF QUESTION. * DEF MESXX ADDRESS OF ASCII MESSAGE * DEF ENT ADDRESS OF ASCII ENTRY POINT NAME * RETURN B=NEXT AVAILABLE CORE LOCATION * REERR JSB \INER SEND ERROR 01 AND RSS RETRY * RED2 NOP ENTRY POINT RERED DLD RED2,I GET THE MESSAGE PRAMETERS JSB \READ GO SEND MESSAGE AND GET RESPONCE LDA N3 CONVERT 3 ASCII DIGITS JSB \DCON AS DECIMAL JMP RERED IF ERROR RETRY * AND M7400 IF NOT LESS THAN SZA 256 JMP REERR THEN ERROR * LDA \OCTN GET THE ANSWER AGAIN SZA,RSS IF ZERO INA SET TO ONE STA \OCTN AND RESET ISZ RED2 STEP ISZ RED2 TO THE SYMBOL ADDRESS LDB RED2,I FIND JSB \LSTS THE SYMBOL IN THE \LST JSB \ABOR MUST BE THERE LDB \PREL DEFINE THE SYMBOL STB \LST5,I LDA \OCTN OUTPUT THE FIRST JSB \ABDO WORD STB \PREL UPDATE THE ADDRESS JSB DAFIX \FIX UP ALL REFERENCES JSB \SPAC MAKE IT LOOK NICE. LDB \PREL SET B FOR RETURN ISZ RED2 SET RETURN ADDRESS JMP RED2,I RETURN * SPC 2 MES04 ASC 9,# OF I/O CLASSES? MES05 ASC 9,# OF LU MAPPINGS? MES06 ASC 11,# OF RESOURCE NUMBERS? DMES7 DEF MES07 MES07 ASC 13,BUFFER LIMITS (LOW, HIGH)? $CLS ASC 3,$C3&LAS $RNTB ASC 3,$RNTB $LUMP ASC 3,$LUSW $BLLO ASC 3,$BLLO $BLHI ASC 3,$BLUP $LUAV DEF *+1 ASC 3,$LUAV SKP * * GETBL ASKS FOR THE # OF BLANK LONG ID SEGMENTS, SHORT * ID SEGMENTS, OR ID EXTENSIONS. AFTER RETRIEVING THE * RESPONSE, GETBL CHECKS THAT THE REPSONSE IS < 256. IF * NOT, AN ERROR DIAGNOSTIC IS GIVEN AND THE PROMPT IS RE- * ISSUED. * * ON ENTRY: A-REG = MESSAGE LENTGH * B-REG = MESSAGE ADDRESS * ON EXIT: A-REG = # OF BLANKS SPECIFIED * GETBL NOP STB TEMP1 SAVE MESSAGE ADDR STA TEMP2 AND LENGTH * GETB1 JSB \READ SEND MESSAGE & GET ANSWER LDA N3 CHECK FOR 3 DECIMAL JSB \GET# DIGITS IN REPSONSE JMP GETB2 INVALID REPLY AND M7400 CHECK FOR > 255 SZA MAXIMUM JMP MAXER * LDA \OCTN RETRIEVE CONVERTED ANSWER JMP GETBL,I AND RETURN * GETB2 JSB \INER SEND ERROR 01 JMP GETB3 RESET MESSAGE SPECS * MAXER LDA ERR60 SEND ERROR CODE JSB \GNER DIAGNOSTIC GETB3 LDB TEMP1 GET MESSAGE ADDR LDA TEMP2 AND LENGTH JMP GETB1 RE-PROMPT * * MES42 DEF *+1 ASC 12,# OF BLANK ID SEGMENTS? MES43 DEF *+1 ASC 15,# OF BLANK SHORT ID SEGMENTS? MES44 DEF *+1 ASC 13,# OF BLANK ID EXTENSIONS? MES45 DEF *+1 ASC 12,MAXIMUM # OF PARTITIONS? SKP * DFIX DOES THE FIXUP POINTED TO BY THE CURRENT FIX UP * TABLE AND LST ENTRIES. DFIX IS USED FOR ALL * INSTRUCTIONS AND MAY BE CALLED ONLY AFTER THE * SYMBOL (IF ANY) IS DEFINED. * * CALLING SEQUENCE: * * SET UP \FIX1-4 AND \LST1-5 FOR THE ENTRY * * JSB \FIX * * RETURN THE FIX ENTRY IS FREE, A/B MEANING LESS * DFIX NOP CCB,CLE SET THE NOT BP LINK STB BPONL FLAG LDA \FIX4,I IF NO SZA,RSS LST INDEX JMP VFIX  USE ZERO VALUE * LDA \LST5,I GET THE SYMBOL VALUE LDB \LST4,I GET THE SYMBOL TYPE CPB P4 IS REPLACEMENT SYMBOL JMP ZFIX GO DO REPLACEMENT CPB P5 IF UNDEFINED, THEN ITS JMP ZFIX A NOP REPLACEMENT * EMA'S?? * VFIX LDB \FIX2,I GET THE INSTR, WITH OPTIONAL BYTE, CBX HIBP, AND DBL TYPE BITS BLF,RBL IF BYTE BIT SET SSB THEN ADA A DOUBLE THE ADDRESS ADA \FIX3,I COMPUTE THE MEMORY ADDRESS STA OPRND AND SAVE AND M0760 EXTRACT THE PAGE NUMBER STA PAGNO AND SAVE CXA GET \FIX2,I AGAIN AND M7 EXTRACT THE DBL RECORD TYPE STA DBLT AND SAVE CXA AGAIN AND M1000 NOW EXTRACT THE HIBP BIT STA LINKB AND SAVE CXA AGAIN AND M1740 LEAVE ONLY THE INSTRUCTION STA \FIX2,I IN THE FIXUP ENTRY LDA PAGNO IF A BASE PAGE OPERAND SZA,RSS THEN JMP CPFIX GO TREAT AS CURRENT PAGE * LDA \FIX1,I GET THE INSTR. ADDRESS AND M0760 EXTRACT THE PAGE STA OPPAG SAVE IT LDB \FIX4,I GET THE LIST INDEX SZB IF EXT REFERENCE JMP LFIX MAY NEED A BP LINK * CPA PAGNO IF SAME PAGE AS OPERAND JMP CPFIX GO DO CURRENT PAGE TRICK * * EMA??? * LFIX SZB,RSS CHECK FOR AN EXT WITH OFFSET JMP WFIX NOT AN EXT LDB DBLT GET DBL RECORD TYPE CPB P5 EXT REF WITH OFFSET? JMP CPFIX YES, GO SEE IF A DEF * WFIX LDA \FIX2,I GET THE INSTRUCTION CLE,ELA MOVE INDIRECT BIT TO E-REG SZB IF EXT REFERENCE JMP IDEF THEN MUST USE A BP LINK * SZA,RSS IF NOT A MRF INSTRUCTION JMP CPFIX THEN DO THE DEF TRICK * IDEF LDA OPRND GET THE OPERAND SEZ IF INDIRECT REFERENCE ADA MSd9IGN RESTORE THE SIGN BIT STA OPRND IN THE OPERAND (FOR THE LINK ADDR) SZB IF EXTERNAL REFERENCE STB BPONL SET FOR BASE PAGE LINK ONLY JSB BPSCN GET A LINK ADDRESS IOR MSIGN A = ADDRESS, SET INDIRECT BIT * XFIX STA B SAVE THE ADDRESS AND M1177 =B101777 PURGE THE PAGE BITS CPA B IF THERE WERE SOME RSS THEN IT'S A CP LINK SO IOR M2000 SET THE CP BIT * YFIX IOR \FIX2,I INCLUDE THE INSTRUCTION ZFIX LDB L01 IF NOT LOADING SZB,RSS THEN JMP AFIX SKIP THE DISC WRITE * LDB \FIX1,I GET THE CORE ADDRESS JSB \ABDO OUTPUT THE WORD AFIX CCA FREE THE FIX UP TABLE ENTRY STA \FIX1,I JMP DFIX,I AND EXIT * CPFIX LDA OPRND CP/BP/DEF - GET OP ADDRESS LDB \FIX2,I IF CLE,ELB DEF SZB,RSS THEN JMP YFIX JUST PICK UP THE INDIRECT. * LDB PAGNO IF A BASE PAGE REFERENCE SZB OR IF LDB \FIX4,I NOT AN EXT SZB THEN DO DIRECT LINK ISZ BPONL ELSE SET TO USE BP LINK (SKIPS) JMP XFIX USE STANDARD LINK * * EXTERNAL REFERENCES WITH OFFSET - NOT A DEF * LDB OPPAG IF INSTR ON SAME PAGE AS CPB PAGNO OPERAND, THEN JMP XFIX MAKE IT DIRECT CLB,INB RESET B(WE KNOW IT'S AN EXT) JMP WFIX USE BP LINK * OPPAG NOP BPONL NOP DBLT NOP LINKB NOP M7 EQU P7 M1000 OCT 1000 M1740 OCT 174000 SKP * SFIX FINDS THE FIRST FREE FIX UP TABLE ENTRY. * * CALLING SEQUENCE: * * JSB SFIX * SFIX NOP JSB \IFIX INITILIZE THE \FIX UP TABLE SFIX1 JSB \FIX SET ADDRESSES JMP SFIX2 EXIT NEW ENTRY * LDA \FIX1,I THIS ENTRY FREE? SSA,RSS FREE IF NEGATIVE JMP SFIX1 NO KEEP LOOKING * JMP SFIX,I EXIT * SFIX2 ISZ \PFIX IF NEW EN=TRY, COUNT IT. CCB STB \FIX1,I AND CLEAR THE ENTRY JMP SFIX,I EXIT SKP * DAFIX DOES ALL FIX UP FOR THE CURRENT LST ENTRY * * CALLING SEQUENCE: * * SET UP THE LST ENTRY * * JSB DAFIX * DAFIX NOP JSB \IFIX SET UP THE SCAN DAFI1 JSB \FIX SET ADDRESSES JMP DAFI2 END OF LIST GO TO EXIT CODE * LDA \FIX1,I IF NULL ENTRY SSA THEN JMP DAFI1 IGNOR IT * LDA \TLST GET LST INDEX. ADA N1 CPA \FIX4,I THIS ENTRY? RSS YES JMP DAFI1 GET NEXT FIX UP * * DETERMINE IF \ABDO OUTPUT MAP MUST BE CHANGED WHEN A DRIVER * IN A DP>=2 RESOLVES AN FIXUP * LDA HIBP COULD WE BE RELOCATING A CPA M1000 DRIVER PARTITION? RSS JMP NOCHG NO LDA DPNUM YES, (DP# MUST BE >= 2) SZA,RSS JMP NOCHG NO, MUST BE DP #1,TA,SDA,SSGA * LDA LWDP1 SEE IF FIXUP IS OUTSIDE CMA,INA RANGE OF CURRENT DP ADA \FIX1,I IE, > LAST WORD OF DP SSA,RSS JMP CHNGM NO, ITS >= LWDP1 LDA DPADD OR LESS THAN FIRST CMA,INA WORD OF DP ADA \FIX1,I IE, < DPADD SSA JMP CHNGM ITS LESS * NOCHG JSB DFIX PERFORM FIXUP JMP DAFI1 GO GET NEXT ENTRY * * CHANGE OUTPUT MAP FOR \ABDO TO THAT OF THE SYSTEM * FOR DOING THE FIXUP * CHNGM JSB \SYS REBUILD THE SYSTEM MAP JSB DFIX GO DO THE FIXUP JSB \USER REBUILD THE DP MAP JMP DAFI1 AND GO GET NEXT ENTRY * DAFI2 JSB SFIX SET UP A FREE FIX UP ENTRY JMP DAFIX,I AND EXIT SKP * * GET BP LINK ADDR, SET BP VALUE * * BPSCN SCANS THE CURRENT ALLOCATED LINKS * FOR A VALUE EQUAL TO THE CURRENT OPERAND. IF SUCH A VALUE * IS FOUND, THE ADDRESS OF THE OPERAND IS RETURNED * IN THE A-REGISTER. OTHERWISE, A NEW LINK WORD IS * RES=ERVED AND THE ADDRESS OF THIS WORD RETURNED IN A. * IN THIS CASE THE OPERAND WORD IS SET IN THE ALLOCATION * IMAGE AREA. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB BPSCN * * RETURN: * A = BP LINK ADDRESS FOR CURRENT OPERAND * B = DESTOYED * BPSCN NOP * JSB \LNKX INITILIZE THE LINK MAPPER BPSC2 JSB \LNK SET UP THE FIRST AREA JMP BPSC4 IF NONE LEFT GO ALLOCATE * JSB SCN SCAN THE AREA FOR A LINK JMP BPSC2 IF NONE FOUND TRY NEXT AREA * JMP BPSCN,I ELSE RETURN THE LINK * BPSC4 JSB ALLOC NONE ALLOCATED SO ALLOCATE ONE JMP BPSCN,I AND RETURN SKP * * SCAN AREA FOR SAME OPERAND * * THE SCN SUBROUTINE CONTROLS THE SCAN FOR A GIVEN OPERAND * IN THE CURRENT LINK SECTION. * * CALLING SEQUENCE: * SET UP \LNK1, \LNK2, \LNK3 TO POINT TO THE CURRENT LINK AREA * SET OPRND TO THE VALUE DESIRED, AND BPONL TO -1 FOR ANY AREA * AND TO 0 FOR BASE PAGE ONLY. * * JSB SCNBP * * RETURN: * P+1: LINK NOT FOUND * P+2: LINK FOUND (A = ADDR OF OPERAND) * (B = IMAGE ADDRESS) * SCN NOP LDA \LNK1,I GET THE LOWER ADDRESS STA \LNK AND SAVE IT LDB BPONL GET THE BASE PAGE ONLY FLAG AND M0760 ISOLATE THE PAGE OF CURRENT AREA SZA,RSS IF BP THEN CCB SET B FOR OK SSB,RSS IF BP ONLY AND NOT BP JMP SCN,I RETURN NOT FOUND * SZA CHECK IF RIGHT PAGE (BP IS ALWAYS RIGHT) CPA OPPAG RSS GOOD LINK AREA JMP SCN,I NOT RIGHT PAGE, EXIT * LDB \LNK3,I GET THE IMAGE ADDRESS TO B SCN1 LDA \LNK GET THE ACTUAL ADDRESS TO A CPA \LNK2,I END OF AREA? JMP SCN,I YES, EXIT NOT FOUND * LDA B,I NO, GET THE VALUE CPA OPRND THIS IT? JMP SCN2 YES, GO RETURN IT * INB NO SET FOR" NEXT ENTRY ISZ \LNK JMP SCN1 * SCN2 LDA \LNK GET THE CORE ADDRESS ISZ SCN STEP TO THE RETURN ADDRESS JMP SCN,I RETURN, LINK FOUND, ADDRESS IN A SKP * * ALLOCATE NEW LINK WORD * * THE ALLOC SUBROUTINE ESTABLISHES ALL THE LINKAGE ADDRESSES. * IF THE ALLOCATED LINK WORD FALLS OUTSIDE THE CURRENT PROGRAM'S * ALLOCATED AREA, A DIAGNOSTIC IS PRINTED. * * IF THE FIXUP ENTRY INDICATES THAT AN ALLOCATED LINK MUST GO IN THE * UPPER PORTION OF BP ( BIT 9 OF \FIX2,I HAD BEEN SET), THEN A MATCH * IS MADE AGAINST THE CURRENT VALUE OF HIBP. IF UNEQUAL, THEN THE LINK * MUST BE ALLOCATED OUTSIDE THE CURRENT BPINC SPEC'S. THIS OCCURS WHEN * THE SYSTEM IS RESOLVING EXTERNAL REFERENCES FROM TABLE AREA I & II, * SSGA, AND SDA WHERE THE LINKS MUST BE PRESENT IN ALL MAPS. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB ALLOC * * RETURN: * A = ALLOCATED BP LINK ADDRESS * B = DESTROYED * ALLOC NOP LDB OPRND SAVE THE OPERAND STB ALSAV LOCALLY CLB SET OPERAND STB OPRND TO ZERO TO CALL SCN LDA CPL1 SET UP TO SCAN THE LOW CP LINK AREA JSB \LNKS JSB SCN SCAN THE AREA RSS IF NOT ALLOCATED SKIP JMP ALLO1 ELSE GO SET UP * LDA \CPL2 TRY THE HIGH AREA JSB \LNKS SET IT UP JSB SCN SCAN IT CLA,INA,RSS IF NOT FOUND SKIP JMP ALLO1 ELSE GO SET IT UP * * SET UP NEW LINK IN BASE PAGE AREA * STA \LNK1 SKIP FLAG = 1 LDA LINKB IF FIXUP ENTRY MATCHES CPA HIBP CURRENT BP ALLOCATION MODE, THEN JMP NORML ALLOCATE ACCORDING TO BPINC * * THE SYSTEM MUST BE RESOLVING A REFERENCE FROM THE TABLE AREAS, * DRIVERS, OR SSGA - SO USE LINK IN UPPER BP AREA. * LDA LOLNK HAS LAST SYSTEM LINK ALREADY BEEN CPA TBREL USED? JMP ER16R YES, ERROR ADA N1 NO, GET NEXT LINK FROM STA LOLNK TOP, AND UPDATE LAST UPPER BP LINK USED STA BPLMT AND UPPER LIMIT FOR LOWER BP LINK'S LDB A GET IMAGE ADDRESS ADB \ADBP JMP ALLO1 AND GO SET IT UP * NORML LDA TBREL DOES NEW LINK CPA BPLMT EQUAL LIMIT ADDR JMP ER16 YES,ERROR LDB A NO, SAVE LINK ADDR ADA BPINC UPDATE TO NEXT STA TBREL SET NEXT LINK ADDR LDA B GET REAL ADDR OF NEW LINK ADB \ADBP AND IMAGE ADDR OF NEW LINK SPC 1 * TBREL CONTAINS POINTER TO NEXT FREE BPLINK (STARTS * AT 2 FOR DR'S AND MR'S, AND 100 FOR SYS). BPINC * SET TO -1 WHEN LOADING THE TABLE AREAS, SSGA, AND ALL * DRIVERS, AND TO +1 OTHERWISE. BPLMT SET BELOW LOWEST * TABLE AREA/SSGA/SDA LINK FOR SYS, TO HIGHEST SYSTEM * LINK FOR PRD DRIVERS, AND TO LOWEST DRIVER LINK FOR ALL OTHERS. * ALLO1 STA TCHR SET THE ADDRESS LDA ALSAV GET THE OPERAND STA OPRND RESTORE IT STA B,I SET IT IN THE IMAGE AREA LDA \LNK1 IF ALLOCATION FROM CPA CPL1 CP LOW AREA ISZ CPL1H STEP THE COUNT CPA \CPL2 IF FORM THE HIGH AREA ISZ CPL2H STEP ITS COUNT LDA TCHR SET THE ADDRESS IN A JMP ALLOC,I AND RETURN * ER16 LDA ERR16 GET THE ERROR CODE JSB \GNER SEND IT CLA RETURN ZERO AS THE LINK JMP ALLOC,I * ALSAV NOP TCHR NOP SKP * * CLEAR BUFFER WITH OCTAL ZEROES * * THE BUFCL SUBROUTINE CLEARS A 64-WORD BUFFER WITH ZEROES. * * CALLING SEQUENCE: * A = IGNORED * B = ADDRESS OF BUFFER * JSB BUFCL * * RETURN: CONTENTS OF A AND B ARE DESTROYED. * BUFCL NOP LDA N64 STA WDCNT SET BUFFER LENGTH = 64 CLA STA B,I CLEAR BUFFER WORD INB ISZ WDCNT ALL WORDS CLEAGNLHR? JMP *-3 NO - CONTINUE CLEARING JMP BUFCL,I RETURN SPC 5 * M0760 OCT 76000 M1177 OCT 101777 M2000 OCT 2000 N1 DEC -1 N64 DEC -64 ERR16 ASC 1,16 BP LINKAGE AREA FULL. * DDVMP DEF *+1 DUMMY DRIVER MAP TABLE BSS 64 * END GIO |NASMB,R,L,C HED RT4G6 - PARTITION DEFINITION SEGMENT. NAM RT4G6,5,90 92067-16009 REV.1805 780203 * ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 3 ****************************************************************** * * NAME RT4G6 * SOURCE PART # 92067-18009 * REL PART # 92067-16009 * WRITTEN BY: KFH,RB * ****************************************************************** * * * ENTRY POINT NAMES: * ENT \PDEF * * EXTERNAL REFERENCE NAMES: * EXT \LST1,\LST2,\LST3,\LST4,\LST5,\LSTX,\LSTS,\ILST EXT \ID1,\ID2,\ID3,\ID5,\ID6,\ID8 EXT \TIDN,\INID,\IDX,\IDXS EXT \TBUF,\LBUF EXT \ADSK,\DSKO,\DSKA EXT \CURL,\RNAM,\RBIN * EXT \SRET,\INER,\GETC EXT \MESS,\GNER,\GETN,\GET#,\GINT EXT \READ,\SPAC,\ABDO,\PTYP EXT \CONV,\OCTN EXT \SYS,\USRS,\ABCO,\MXAB EXT \MRT2,\TERM,\YENO EXT \NUMP EXT \ABOR * A EQU 0 B EQU 1 SUP ************************************************************************ * SKP *************************************************************************** * * 780112 * * THE FOLLOWING BLOCK OF STORAGE FOR VARIABLES PRECEEDS, * AND IS REFERENCED BY, EACH SEGMENT. IT IS NOT OVERLAID * AS EACH NEW SEGMENT IS LOADED INTO MEMORY. * * THE LOCATION OF EACH VARIABLE MUST BE THE SAME IN ALL * SEGMENTS. IF A CHANGE IS MADE, MAKE THE SAME CHANGES * IN THE REST OF THE SEGMENTS. * **********************************************?***************************** * * TB30 BSS 128 TRACK MAP TABLE/HEADER RECORD BUFFER * ILIST BSS 64 USER SYSTEM PROG IDENT ADDR LIST CURIL BSS 1 CURRENT ILIST ADDRESS * SYSCH BSS 1 SUBCHANNEL OF SYSTEM UNIT. DCHNL BSS 1 CHANNEL OF SYSTEM DISK UNIT AUXCH BSS 1 SUBCHANNEL OF AUX UNIT. DSIZE BSS 1 DISK SIZE -NO. OF TRACKS. #SUBC BSS 1 # DISC SUBCHANNELS DEF'D (7905/7920) DAUXN BSS 1 AUXILIARY DISK SIZE. ADS# BSS 1 AUX DISC SECTORS/TRACK. * * RELOCATION BASE TABLE. RBTA BSS 1 ABSOLUTE PROGRAM BASE. TPREL BSS 1 CURRENT PROGRAM BASE ADDRESS. TPBRE BSS 1 BASE PAGE RELOCATION ADDRESS. COMAD BSS 1 CURRENT COMMON RELOCATION BASE. BSS 1 ABS PROGRAM BASE FOR MR CODE. * WDCNT BSS 1 TEMPORARY WORD COUNTER. DSKSY BSS 1 INITIAL ID SEGMENT DISK ADDRESS IDSP BSS 1 POSITION OF 1ST ID SEG. IN SECT TTYCH BSS 1 SYSTEM TTY CHANNEL NO. * PLFLG BSS 1 PROGRAM LOAD. FLAG = -1/0 = L/NL DSCNT BSS 1 DISK SEGMENT SECTOR COUNT * NXFLG BSS 1 ENT/EXT FLAG = -1/0 EXCNT BSS 1 SYMBOL COUNTER * LCNT BSS 1 CURRENT \LBUF COUNT DCNT BSS 1 CURRENT DBUF COUNT CURAI BSS 1 CURRENT IBUF COUNT * CPLS BSS 1 ADDRESS OF TOP OF FIXED CP LINK IMAGE CPL1 BSS 1 ADDRESS OF LOW CURRENT PAGE LINK SPECS. CPL1H BSS 1 NUMBER OF CURRENT PAGE LINKS ASSIGNED CPL2H BSS 1 IN LOW AND HIGH AREA RESPECTIVELY URBP1 BSS 1 LWA R/T DISC RES BP LINK AREA CURAK BSS 1 CURRENT KBUF ADDRESS * CURAT BSS 1 CURRENT \TBUF ADDRESS TCNT BSS 1 CURRENT \TBUF COUNT * CURAP BSS 1 CURRENT PLIST ADDRESS * AMAD BSS 1 CURRENT MLIST ADDRESS * IXCNT BSS 1 ID EXTENSION COUNT IDEXC BSS 1 CURRENT ID EXT'S USED IDEX BSS 1 ADDRESS OF ID EXTENSION TABLE * LICNT BSS 1 LO9NG ID SEGMENT COUNT SICNT BSS 1 SHORT ID SEGMENT COUNT SSCNT BSS 1 BG. SEG ID COUNT * DSKID BSS 1 DISK ID SEGMENT ADDRESS KEYCN BSS 1 TOTAL KEYWORD COUNT KEYCT BSS 1 CURRENT KEYWORD COUNT * MLIST BSS 11 MEMORY MAP BUFFER * TEMP1 BSS 1 TEMP2 BSS 1 LWH1 BSS 1 LWH2 BSS 1 LWH3 BSS 1 LWH4 BSS 1 L01 BSS 1 * FSYBP BSS 1 FIRST WORD SYS BP LINKAGE SYSAD BSS 1 CURRENT ID SEGMENT ADDRESS * TBREL BSS 1 CURRENT BP RELOC ADDR PBREL BSS 1 INITIAL BP RELOC ADDR * RELAD BSS 1 CURRENT CORE RELOCATION ADDRESS * BSBAD BSS 1 BG SEGMENT BP RELOC ADDR BSPAD BSS 1 BG SEGMENT PROG RELOC ADDR * LFLAG BSS 1 PROGRAMS-LOADED FLAG IMAIN BSS 1 CURRENT MAIN IDENT INDEX. HDFLG BSS 1 HEADING FORMAT FLAG CIDNT BSS 1 CURRENT MAIN IDENT INDEX. * AEQT BSS 1 ADDRESS OF EQUIPMENT TABLE CEQT BSS 1 NO. ENTRIES IN EQUIPMENT TABLE SPLCO BSS 1 SPOOL EQT COUNT DVMAP BSS 1 ADDRESS OF DRIVER MAP TABLE * DPFLG BSS 1 DP RELOCATION FLAG, 0=YES, -1=NO DPLN BSS 1 PAGE LENGTH OF DRIVER PARTITION DPADD BSS 1 START ADDR OF DRIVER PARTITION DSKDP BSS 1 DISK ADDRESS OF DP #2 PAGE# BSS 1 NEXT PHYSICAL PAGE TO ALLOCATE DPNUM BSS 1 CURRENT DP# -1, OR TOT DP PAGES SDID BSS 1 IDENT IDEX OF SYS DISK DRIVER LWDP1 BSS 1 LAST WORD OF DP, +1 FWSDA BSS 1 FIRST WORD OF SDA * ASQT BSS 1 ADDR OF DEVICE REFERENCE TABLE CSQT BSS 1 NO. ENTRIES IN DEV. REF. TABLE * AINT BSS 1 ADDRESS OF INTERRUPT TABLE * DSKIN BSS 1 DISK ADDR OF INT CODE RECORD INTCN BSS 1 RECORD COUNT OF INT CODE * IDSAV BSS 1 INDEX OF CURRENT IDENT. DSKMN BSS 1 INITIAL MAIN DISK ADDRESS BSSDP BSS 1 INITIAL DISK RES MAIN BSS DISP PRENT BSS 1 PRIMARY ENTRY POINT DBLAD BSS 1 CURRENT DBL P ADDRESS REKEY BSS 1 INSTRUCTION TYPE BYTE INSCN BSS 1 INSTRUCTION TYPE COUNTER INSTR BSS 1 CURRENT INSTRUCTION PAGNO BSS 1 CURRENT PAGE NO. OPRND BSS 1 CURRENT OPERAND PLGTH BSS 1 PROGRAM LENGTH * DRT2 BSS 1 DISK DRT ENTRY ( SYSTEM) DRT3 BSS 1 AUX DISK DRT ENTRY * LIBFG BSS 1 LDTYP BSS 1 * SCH1 BSS 1 INDEX OF IDENT OF PGM TO BE SCHEDULED SCH3 BSS 1 ADDRESS OF CURRENT ID SEGMENT SCH4 BSS 1 ADDRESS OF THE SCHEDULED PGM ID SEG FGBGC BSS 1 BACKGROUND USING FG COMMON FLAG $LIBR BSS 1 INDEX OF $LIBR ENT $LIBX BSS 1 INDEX OF $LIBX ENT CUPRI BSS 1 * BLLO BSS 1 -(LOWER BUFFER LIMIT) BLHI BSS 1 -(UPPER BUFFER LIMIT) * MEM6 BSS 1 MEM12 BSS 1 * COMRT BSS 1 MAXIMUM RT COM LENGTH COMBG BSS 1 MAXIMUM BG COM LENGTH COMSZ BSS 1 #WORDS COMMON DECLARED IN CURRENT MAIN RTCAD BSS 1 RT COMMON ADDRESS BGCAD BSS 1 BG COMMON ADDRESS FPCOM BSS 1 FIRST PAGE OCCUPIED BY COMMON LPCOM BSS 1 LAST PAGE CONTAINING ANY COMMON * FPSAM BSS 1 1ST PAGE CONTAINING S.A.M. FWSAM BSS 1 1ST WORD CONTAINING S.A.M. SYMAD BSS 1 VALUE FOR AVMEM IN SCOM SAM#1 BSS 1 SIZE OF FIRST CHUNK OF SAM SAM#2 BSS 1 SIZE OF SECOND CHUNK OF SAM SAM2P BSS 1 START PAGE OF SAM #2 LWTAI BSS 1 FIRST WORD OF TABLE AREA I FOR SAM#0 FWPRV BSS 1 FIRST WORD FOR PRIVILEGED PROGRAMS * FWSYS BSS 1 FIRST WORD OF SYSTEM CODE LPSYS BSS 1 LAST PAGE CONTAINING SYS LWSYS BSS 1 LAST WORD OF SYSTEM LPSLB BSS 1 LAST PAGE OF SLOW BOOT LWSLB BSS 1 LAST WORD OF SLOW BOOT MTYPE BSS 1 MAIN PROGRAMS'S TYPE * HIBP BSS 1 BP LINK MODE FOR FIXUP ENTRIES LOLNK BSS 1 LOW LINK FOR SSGA,LIB, OR SYS HILNK BSS 1 HI LINK USED BY MEM RES PRG BPINC BSS 1 BP LINK ALLOCATION MODE, -1=DOWN,1{!=UP BPLMT BSS 1 LAST AVAIL BP LINK IN CURRENT MODE, +1 * TPMAX BSS 1 HWM FOR RELOCATION OF BG MAINS & SEGS MAXPT BSS 1 NUM PARTS. ALLOWED MAT. BSS 1 ADDRESS OF MEMORY ALLOCATION TABLE * SSGA. BSS 1 FWA SSGA MAP. BSS 1 PTR TO MEU RES MAP MPFT. BSS 1 PTR TO MPFT * EMLNK BSS 1 EMA SYMBOL'S LINK EMLST BSS 1 LST INDEX OF EMA SYMBOL EMDSK BSS 1 DISK ADDR OF EMA PROGRAM * * MEMORY RESIDENT AREA POINTERS * MRACM BSS 1 MR ACCESS COMMON FLAG (>0 IF YES) LBCAD BSS 1 FIRST WORD OF MEMORY RES LIBRARY LEND BSS 1 LAST WORD OF MEMORY RES LIBRARY FWMRP BSS 1 FIRST WORD OF MEMORY RES PROGRAM AREA EMRP BSS 1 LAST WORD OF MEMORY RES PROGRAM AREA FPMRP BSS 1 FIRST PAGE OF MEMORY RES PROGRAM AREA FPMBP BSS 1 PAGE # FOR MEMORY RES BASE PAGE MRP# BSS 1 # PAGES OCCUPIED BY MRL & MRP'S DSKMB BSS 1 DISK ADDRESS OF MEMORY RES BASE PAGE DSKMR BSS 1 DISK ADDRESS OF MEMORY RESIDENT LIB/PROG AREA DSKBP BSS 1 SYSTEM DISK ADDRESS * DSKAV BSS 1 NEXT AVAILABLE DISK ADDRESS DSKLC BSS 1 DISK ADDRESS OF LIBRARY CODE DSKLB BSS 1 DISK ADDR OF LIBRARY ENTRY PTS DSKUT BSS 1 UTILITY PROG DISK ADDRESS DSKBS BSS 1 DISK ADDR OF MAIN BG DISK RES BP DSKBR BSS 1 CURRENT MAIN BG DISK RES DISK AD ADICT BSS 1 ADDR OF DISK DICTIONARY LBCNT BSS 1 RESIDENT LIBR ENTRY PT COUNT SYCNT BSS 1 SYSTEM ENTRY POINT COUNT KEYAD BSS 1 CURRENT KEYWORD ADDRESS * SYBAD BSS 1 ADDR OF FIRST BP LINK FOR BG IDSAD BSS 1 ADDR OF FIRST ID SEGMENT ABSID BSS 1 IDENT ADDR FOR NEXT BG SEG SCAN IDMBS BSS 1 BG MAIN ADDRESS FOR BS REF * * ********************************************************* * * * END OF COMMON STORAGE BLOCK FOR ALL SEGMENTS. * * } * ********************************************************* * SKP BLNKS ASC 1, BLANK OCT 40 M1777 OCT 1777 M7400 OCT 177400 M7700 OCT 177700 N1 DEC -1 N2 DEC -2 N32 DEC -32 N4 DEC -4 N5 DEC -5 P7 DEC 7 P10 DEC 10 P14 DEC 14 P18 DEC 18 P2 DEC 2 P20 DEC 20 P21 DEC 21 P22 DEC 22 P24 DEC 24 P26 DEC 26 P30 DEC 30 P3 DEC 3 P31 DEC 31 P4 DEC 4 P32 DEC 32 P33 DEC 33 P5 DEC 5 P6 DEC 6 M37 EQU P31 M7 EQU P7 TEMP3 NOP TEMP4 NOP * MES22 DEF *+1 ASC 3,(NONE) SKP * * NOTE THE FOLLOWING RESOLVES DEF'S TO EXTERNALS * PART LDA N GET LOOP COUNTER STA TEMP1 SAVE IN TEMP LOCATION LDB LSTAA GET ADDRESS OF WHERE LIST ROUTINE LOCATED LOOP LDA B HERE WE CHASE DOWN OUR OWN LDA A,I INDRECTS RSS LDA A,I RAL,CLE,SLA,ERA JMP *-2 STA B,I AND SAVE IT AGAIN INB ISZ TEMP1 DONE? JMP LOOP NO JMP \SRET RETURN TO MAIN. * * N DEC -2 LSTAA DEF *+1 ATBUF DEF \TBUF+0 ALBUF DEF \LBUF+0 SKP * * * LIST PARTITION REQUIREMENTS FOR RT AND * BG (INCLUDING PR) DISC RESIDENTS * \PDEF NOP LDA P2 SET IDSCN TYPE TO STA \PTYP REAL TIME DISC RESIDENTS LDA "RT" STUFF 'RT' IN STA MSQ1 MESSAGE. * PQLP1 JSB \SPAC LDB MSQ1. SENT EITHER RT OR BG LDA P20 PARTITION REQMT JSB \MESS MESSAGE. * CLA SET FLAG FOR NO PROGRAMS STA PQFLG OF TYPE FOUND. PQLP0 LDA P10 REINIT IDENT PTRS STA \TIDN FOR SCAN PQLP2 JSB \IDX FIND PROG MATCHING \PTYP JMP PQDON (NO MORE) LDA \ID6,I GET THE TYPE ELA,RAR SAVE EMA BIT AND M7 ISOLATE IT CPA \PTYP WHAT WE WANTED? RSS YES! JMP PQLP2  NO TRY ANOTHER ISZ PQFLG INCR FLAG - AT LEAST ONE PROG SEZ IF ITS AN EMA PROGRAM JMP DEMA THEN GO DETERMINE ITS PG REQMTS * LDA \ID8,I PICK UP PAGE REQMT RRR 8 AND ISOLATE AND M37 IT. PQLP3 CMA GET -(PAGES +1) LDB MSQ2X AND STUFF JSB \CONV DECIMAL EQUIV IN MSG * LDA BLNKS PUT BLANKS STA MSQ2 LDA \ID1,I THEN PROGRAM NAME STA MSQ2+1 LDA \ID2,I IN MESSAGE... STA MSQ2+2 LDA \ID3,I AND M7400 IOR P32 STA MSQ2+3 * * SET OPTIONAL EMA OR LARGE BG INDICATORS * LDA BLNKS GET BLANKS IN CASE NEITHER OPTION LDB \ID6,I EMA BIT SET? SSB ADA "E" MERGE IN AN E LDB \PTYP PRIVILEGED PROGRAM? CPB P4 ADA AST MERGE IN A * STA MSQ2+9 STORE WORD IN MESSAGE * LDA P20 LDB MSQ2. JSB \MESS SEND THE MESSAGE JMP PQLP2 THEN LOOK FOR MORE PROGS * DEMA JSB PAGES GET THE PAGE REQMTS OF AN JMP PQLP3 EMA PROGRAM * PQDON LDA P3 GET THE PRIVILEGED TYPE LDB \PTYP AND THE CURRENT TYPE CPB P4 IF BG'S WERE JUST DISPLAYED JMP PQEND THEN EXIT FROM LOOP CPB A IF PR'S WERE JUST DONE LDA P4 THEN SET TO DO BG'S STA \PTYP SET TYPE TO SCAN CPB P3 RT -> PR JMP PQLP0 NO, PR -> BG * LDA "BG" STUFF 'BG' INTO STA MSQ1 INTO THE HEADER JSB NONE SEE IF AN RT'S DISPLAYED JMP PQLP1 SEND THE NEW HEADING * * * PRINT 'NONE' IF NO PROGRAMS OF THE CURRENT PARTITION * TYPE WERE DISPLAYED * NONE NOP LDA PQFLG ANY PROGRAMS FOUND? SZA IF AT LEAST ONE JMP NONE,I LDA P6 ELSE PRINT LDB MES22 "(NONE)". JSB \MESS JMP NONE,I SKP * ֈPQFLG BSS 1 * MSQ1. DEF *+1 MSQ1 ASC 10,XX PARTITION REQMTS: * MSQ2. DEF *+1 MSQ2 ASC 10, NNNNN XX PAGES MSQ2X DEF MSQ2+2 * MSQ3. DEF *+1 ASC 11,MAXIMUM PROGRAM SIZE:  * MSQ4. DEF *+1 MSQ4 ASC 4,W/ COM * "O" ASC 1,O AST OCT 05000 "E" OCT 45 PR. DEF *+1 ASC 4,W/ TA2 "?" ASC 1,? * MS62A DEF *+1 MES62 ASC 4, CHANGE MES61 ASC 9,1ST PART PG MS61A DEF MES61+6 MS61B DEF MES61 SKP * * PQADD PRINTS THE MAXIMUM PROGRAM ADDRESS SPACE FOR PROGRAMS * WITH AND WITHOUT COMMON, AND FOR PRIVILEGED PROGRAMS. * * ON ENTRY: A-REG = PAGE # PRECEDING THE PROGRAM AREA * B-REG = ASCII WORD TO STUFF INTO MESSAGE (EG, "O") * PQADD NOP *PRINT LARGEST PART MESSAGE* STB MSQ4+1 MAKE MESSAGE W/COM OR LDB MSQ2X W/O COM, THEN PUT SIZE ADA N32 JSB \CONV IN MESSAGE LDA MSQ4. LDB MSQ2. STUFF IN MSG MVW P4 HEAD,OVERLAYING HIGH-ORDER LDB MSQ2. ZEROS OF PAGE SIZE LDA P18 JSB \MESS PRINT MESSAGE JMP PQADD,I SPC 3 * * CONVERT THE ADDRESS IN THE A-REG TO A LOGICAL PAGE NUMBER * CPAG# NOP ALF,RAL ROTATE THE PAGE BITS RAL TO THE LOW BYTE AND M37 AND GET MASK THEM JMP CPAG#,I SPC 3 * * PRINT THE CURRENT SIZE OF SAM, GIVEN IN THE A-REG. * SAMSZ NOP LDB LWTAI GET LAST WORD ADDRESS OF TABLE AREA I INB AND SET STARTING ADDRESS OF SAM#0 CMB,INB DETERMINE SIZE BY SUBTRACTING ADB DPADD FROM START OF DRIVER PARTITION ADA B GET TOTAL SAM SIZE CMA,INA LDB MXSM PASS BUFFER ADDRESS JSB \CONV AND GET DECIMAL ASCII WORDS JSB \SPAC * LDB MSSM. PRINT THE MESSAGE LDA P24 JSB \MESS JMP SAMSZ,I * MSSM. DEF *+1 ASC 12,SYS AV MEM: XXXXX WORDS MXSM DEF MSSM.+7 iHYADD DEF *+1 ASC 1,- SKP * * * LIST MAXIMUM PROGRAM SIZES * PQEND JSB NONE SEE IF ANY BG REQ'S WERE DISPLAYED JSB \SPAC LDA P22 LDB MSQ3. PRINT HEADER JSB \MESS LDB "O" PASS AN O (FOR W/O) CCA ADA FPCOM AND FIRST COMMON PAGE JSB PQADD AND PRINT MSG (MAX W/O COM) LDA FWSDA AND GET LAST COMMON PAGE JSB CPAG# ADA N1 LDB BLNKS PASS BLANKS IN B. JSB PQADD AND PRINT (MAX W/ COM) * LDB PR. TRICK PQADD TO STORE STB MSQ4. 'W/ TA2' IN MESSAGE CCA ADA FWPRV CALCULATE LAST PAGE JSB CPAG# CONTAINING TABLE AREA II JSB PQADD AND PRINT MAX PRIV PROG SPACE JSB \SPAC * * * COMPUTE SIZE OF SAM #1 * LDA LWSYS SET THE FIRST PAGE INA JSB CPAG# OCCUPIED BY SAM#1 STA FPSAM LDB LWSYS DETERMINE THE SIZE OF CMB,INB THE FIRST CHUNK OF SAM LDA LWSLB GET LAST WORD & ROUND IOR M1777 TO A PAGE BOUNDARY ADB A STB SAM#1 AND SAVE * LDA LPSLB COMPUTE THE MAXIMUM LOGICAL CMA,INA PAGE SIZE ALLOWABLE FOR ADA P31 SAM #2 SZA JMP SET2 GO SET THE UPPER LIMIT ADB N2 NO SAM #2: MUST DECREMENT SIZE OF STB SAM#1 SAM #1 SO LAST WORD IS 77776 * SET2 ADA PAGE# ADD TO NEXT PHYSICAL STA SAM2P PAGE AVAILABLE, AND SET AS UPPER LIMIT * LDB \NUMP IF MORE LOGICAL PAGES AVAILABLE CMA,INA THAN PHYSICAL PAGE STILL AVAILABLE ADA B THEN SET SAM #2 LIMIT TO LAST SSA STB SAM2P PHYSICAL PAGE * LDA SAM#1 DISPLAY THE SIZE OF THE JSB SAMSZ FIRST CHUNK * LDA PAGE# GET THE NEXT AVAILABLE CMA,INA DISPLAY DECIMAL LDB MS61A PHYSICAL PAGE # AND JSB \CONV CONVERT IT TO ASCII (DEC1 ) JSB \SPAC LDB MS61B LDA P18 NOW DISPLAY: JSB \MESS "1ST PART PG XXXX" * * * REQUEST THE SIZE OF SAM #2 * LDA "?" CONVERT THE MESSAGE FOR STA MES61+6 THE QUERY GETPP LDB MS62A NOW ASK LDA P22 "CHANGE 1ST PART PG?" JSB \READ GET THE RESPONSE, TOO * LDA N5 GET THE DECIMAL RESPONSE JSB \GET# JMP SER44 INVALID RESPONSE, REPEAT * LDA \OCTN GET PAGE # SZA,RSS CHANGE? JMP NOSM2 NO, CLEAR SAM #2 SPECS LDB PAGE# COMPARE AGAINST CURRENT CMB,INB FIRST PAGE ADB A (MUST BE >= TO IT) SSB JMP SER44 TOO SMALL * LDB SAM2P GET PRESENT UPPER LIMIT CMB,INB ADB A CMB,SSB,INB,SZB LESS THAN OR EQUAL TO IT? JMP SER44 NO, MUST TRY AGAIN * LDB PAGE# GET NEXT AVAILABLE PHYSICAL PAGE STB SAM2P AND SET AS FIRST PAGE OF SAM #2 STA PAGE# AND RESET THE FIRST PART PAGE * CMB,INB DETERMINE THE PAGE SIZE OF ADA B SAM #2 NOSM2 STA PQFLG SAVE *TEMP* ALF,RAL AND CONVERT TO THE ALF,RAL #WORDS STA SAM#2 SZA,RSS ANYTHING ALLOCATED? JMP DISPS NO * LDA LPSLB IF SAM #2 ENDS ON THE 32K ADA PQFLG BOUNDARY (77777) CPA P31 (IE, THE NEXT LOGICAL PAGE AFTER RSS IT IS 32), THEN JMP DISPS LDB N2 MUST DECREMENT THE # OF WORDS ADB SAM#2 SO LAST WORD OF SAM #2 STB SAM#2 WILL BE 77776 * * DISPLAY TOTAL SAM SIZE * DISPS LDA SAM#1 ADA SAM#2 COMBINE THE TWO CHUNKS JSB SAMSZ FOR DISPLAY * LDA FPCOM SET THE MAXIMUM ADDRESSABLE CMA,INA (LOGICALLY) PAGE SIZE FOR A ADA P32 PARTITION STA MAXPG JMP DPINT CONTINUE * MAXPG NOP * SER44 LDA ERR44 nB@0 IF YES) LBCAD BSS 1 FIRST WORD OF MEMORY RES LIBRARY LEND BSS 1 LAST WORD OF MEMORY RES LIBRARY FWMRP BSS 1 FIRST WORD OF MEMORY RES PROGRAM AREA EMRP BSS 1 LAST WORD OF MEMORY RES PROGRAM AREA FPMRP BSS 1 FIRST PAGE OF MEMORY RES PROGRAM AREA FPMBP BSS 1 PAGE # FOR MEMORY RES BASE PAGE MRP# BSS 1 # PAGES OCCUPIED BY MRL & MRP'S DSKMB BSS 1 DISK ADDRESS OF MEMORY RES BASE PAGE DSKMR BSS 1 DISK ADDRESS OF MEMORY RESIDENT LIB/PROG AREA DSKBP BSS 1 SYSTEM DISK ADDRESS * DSKAV BSS 1 NEXT AVAILABLE DISK ADDRESS DSKLC BSS 1 DISK ADDRESS OF LIBRARY CODE DSKLB BSS 1 DISK ADDR OF LIBRARY ENTRY PTS DSKUT BSS 1 UTILITY PROG DISK ADDRESS DSKBS BSS 1 DISK ADDR OF MAIN BG DISK RES BP DSKBR BSS 1 CURRENT MAIN BG DISK RES DISK AD ADICT BSS 1 ADDR OF DISK DICTIONARY LBCNT BSS 1 RESIDENT LIBR ENTRY PT COUNT SYCNT BSS 1 SYSTEM ENTRY POINT COUNT KEYAD BSS 1 CURRENT KEYWORD ADDRESS * SYBAD BSS 1 ADDR OF FIRST BP LINK FOR BG IDSAD BSS 1 ADDR OF FIRST ID SEGMENT ABSID BSS 1 IDENT ADDR FOR NEXT BG SEG SCAN IDMBS BSS 1 BG MAIN ADDRESS FOR BS REF * * ********************************************************* * * * END OF COMMON STORAGE BLOCK FOR ALL SEGMENTS. * * * ********************************-************************* * SKP * BEG05 JMP \SRET SEGMENT ENTRY POINT * DC EQU 0 ABOOT DEF START ADDRESS OF BOOTSTRAP LOADR ATB30 DEF TB30 * INTMP BSS 1 TEMP FOR INITILIZATION ROUTINES MS3 DEF *+1 SUBCHANNEL NUMBER MESAGE ASC 3, 00? MES1 DEF *+1 ASC 20,# TRKS, FIRST CYL #, HEAD #, # SURFACES, ASC 14, UNIT, # SPARES FOR SUBCHNL: P68 DEC 68 LENGTH OF MESSAGE * MES4 DEF MES04 MES04 ASC 8,BOOT FILE NAME? MES05 ASC 8,SYSTEM SUBCHNL? MES07 ASC 9,AUX DISC SUBCHNL? MES40 DEF *+1 ASC 13,# 128 WORD SECTORS/TRACK? "/E" ASC 1,/E SBUF BSS 3 DSBUF DEF SBUF MES5 DEF MES05 MES7 DEF MES07 * L2000 OCT -2000 M0760 OCT 76000 M77 OCT 77 M377 OCT 377 M1177 OCT 101777 M1777 OCT 1777 M74C OCT 7400 M7400 OCT 177400 M7600 OCT 177600 M7700 OCT 177700 N2 DEC -2 N3 DEC -3 N4 DEC -4 N5 DEC -5 N6 DEC -6 N8 DEC -8 P1 DEC 1 P2 DEC 2 P4 DEC 4 P5 DEC 5 P6 DEC 6 P7 DEC 7 P15 DEC 15 P23 DEC 23 P17 DEC 17 P25 DEC 25 P31 DEC 31 BLANK OCT 40 STEMP NOP TTEMP NOP HED INTERACTIVE DISC SET UP SECTION * * THE FOLLOWING MESSAGES ARE PRINTED DURING THE INITIALIZATION * PHASE, WITH THE SPECIFICATIONS FOR EACH VALID RESONSE. * * * MESSAGE RESPONSE * * CONTROLLER SELECT CODE? ENTER 2 OCTAL DIGITS * * # TRKS, FIRST CYL #, HEAD #, # SURFACES, UNIT, # SPARES FOR SUBCHNL? * 0? * . * . * . * . * 32? * * SYSTEM SUBCHNL? ENTER 1 OCTAL DIGIT * * AUX DISC (YES OR NO)? ENTER YES OR NO * * AUX DISC SUBCHNL? ENTER 1 OCTAL DIGIT * * # 128 WORD SECTORS/TRACK? ENTER 3 DECIMAL DIGITS $$ SPC 3 \DST5 NOP ENTRY POINT FOR QUESTION SECESSION. LDB $TB32 PUT TB32 IN THE LST JSB \LSTE NOP IGNOR AL\READY THERE RETURN CHNLD LDA P23 LDB MESS2 MESS2 = ADDR: CONTROLLER SELECT CODE? JSB \READ PRINT MESSAGE, GET ^REPLY LDA P2 SET FOR 2 OCTAL DIGITS INPUT JSB \DCON GET DIGITS, RETURN OCTAL JMP CHNLD REPEAT INPUT * STA DCHNL SET DISK CHANNEL NUMBER ADA N8 TEST FOR >= 10 OCTAL SSA,RSS JMP STB30-1 OK JSB \INER JMP CHNLD * JSB \SPAC SET UP TRACK MAP STB30 LDA P68 SEND MESSAGE: LDB MES1 # TRKS, FIRST CYL #, HEAD #, # SURFACES, JSB \MESS UNIT, # SPARES FOR SUBCHNL: LDA ATB30 SET ADDRESSES STA STEMP FOR INPUT STA INTMP AND CLEAR LOOPS LDB M7600 =-128 CLEAR CLA THE TB30. STA INTMP,I TRACK ISZ INTMP MAP INB,SZB STEP COUNT - DONE? JMP TB30. NO - CLEAR NEXT WORD * STA #SUBC SET 0 DEFINED SUBCHANNELS TB30A STB INTMP SAVE CURRENT UNIT LDA B CONVERT FOR THE MESSAGE CMA,INA LDB DSBUF JSB \CONV LDA SBUF+2 STA MS3+2 SET IN THE MESSAGE LDB MS3 GET MESSAGE ADDRESS LDA P5 AND LENGTH JSB \READ GO GET THE ANSWER LDA N2 GET FIRST JSB \GETN TWO CHARACTERS CPA "/E" /E? JMP TB30X YES - GO CHECK FURTHER * JSB \GINT NO - REINITIALIZE LBUF SCAN LDA N4 CONVERT 4 DIGITS JSB \GET# DECIMAL JMP TB30E ERROR - * STA TTEMP SET # TRACKS IN TEMP SZA,RSS IF ZERO JMP TB30B GO UPDATE POINTERS * JSB \GETC NOT ZERO - GET NEXT CHARACTER CPA BLANK COMMA IN? RSS YES - SKIP JMP TB30E NO - ERROR * LDA N3 SET FOR JSB GET 3 DECIMAL DIGITS AND CONVERT STA STEMP,I THE CYL # FOR TRACK 0. CCA GET 1 DIGIT JSB GET HEAD NUMBER STA B SAVE ADA N5 MUST BE LESS THAN 5. SSA,RSS WELL? JMP TB30E NO - BITCH * r BLF,BLF PUT IN ITS PLACE STB BSHED AND SAVE CCA NOW GET # SURFACES JSB GET MUST BE 1 TO 5. STA B SZA ADA N6 SSA,RSS WELL? JMP TB30E NOT GOOD! BITCH BLF,BLF MOVE TO HIGH BLF END AND ADB BSHED COMBINE WITH HEAD STB BSHED CLA,INA NOW GET UNIT JSB GET MUST BE 0 TO 7. ADA BSHED GOOD - ADD THE HEAD WORD STA BSHED AND SAVE IT. CLA PREPARE FOR DEFAULT # SPARES STA \TBUF+1 NAMELY 0. JSB \GETC TEST FOR SPARES CPA BLANK WELL? RSS YES, SO SET TO CONVERT 2 DIGITS JMP TB30C NO, USE DEFAULT * LDA N2 JSB GET CONVERT THE # SPARES STA \TBUF+1 SAVE THE NUMBER JSB \GETC END OF LINE? SZA WELL? JMP TB30E NO - TOO BAD - AND YOU ALMOST * MADE IT TOO. TB30C ISZ STEMP STEP TO HEAD/UNIT WORD. LDA BSHED AND STA STEMP,I SALT IT AWAY. ISZ STEMP NOW THE # TRACKS LDA TTEMP WORD STA STEMP,I SALT IT AWAY. STA DSIZE SET ALSO FOR ASSUMPTION ISZ STEMP STEP TO SPARES LDA \TBUF+1 AND STA STEMP,I SALT THAT AWAY TOO. LDA INTMP TO THIS SUBCHANNEL STA SYSCH FOR DEFAULT TB30B ISZ #SUBC STEP TOTAL SUBCHANNEL COUNT ISZ STEMP STEP TABLE ISZ INTMP STEP SUBCHANNEL TB30F LDB INTMP IF CURRENT SUBCHANNEL CPB P32 IS 32 THEN JMP TB30Y DONE SO GO EXIT * JMP TB30A NOT 32 - GO ASK FOR NEXT ONE * SPC 1 TB30E JSB \INER TELL HIM THERE WAS AN ERROR JMP TB30F GO ASK AGAIN * SPC 1 TB30X JSB \GETC /E ENTERED SZA ANY THING ELSE? JMP TB30E YES - ERROR * TB30Y LDA #SUBC NO - GET NUMBER OF CHANNELS CMA,INA,SZA DEFINED - IS IT ZERO? JMP TB30Z NO - SKIP * JSB \INER YES - TELL HIM JMP STB30 AND RESTART * TB30Z JSB \SPAC ISYSC LDA P15 SEND MESSAGE: LDB MES5 SYSTEM SUBCHNL? JSB \READ GET ANSWER LDA N4 DECIMAL DIGITS JSB \DCON GO CONVERT JMP ISYSC ERROR - TRY AGAIN * JSB TSTCH TEST FOR LEGAL SUBCHANNEL STB DSIZE SET SYSTEM SIZE STA SYSCH SET SYSTEM SUBCHANNEL ADB M7400 TEST FOR TOO MANY TRACKS CMB,SSB,INB,SZB OK? JMP SYSER NO GO BITCH * * SET VALUES FOR THE BOOT * RSS SETEM CLA SUBCHANNEL IN A RAL,RAL LDB ATB30 POSITION WITHIN TMT FOR INFO ADB A LDA B,I GET FIRST CYLINDER # STA PT#TR STA PT#T2 STA TBASE * INB LDA B,I LDB A AND M74C STA H#AD SET HEAD # FOR COMMANDS STA PT#H2 ALF,ALF STA BHD# * LDA B ALF AND M17 STA #HDS * LDA B AND M377 GOT THE UNIT LDB WA#KE NOW INCORPORATE IT ADB A IT INTO THE WAKEUP, STB WA#KE SEEK,AND \READ COMMANDS STB WAK * LDB PT#SK ADB A STB PT#SK STB SKCMD * LDB PT#AD ADB A STB PT#AD STB AD#RC * LDB R#DCM ADB A STB R#DCM STB R#CMD * LDB P#EN ADB A STB P#EN STB S#TAC * SPC 1 AUXIN CLA PRESET TO SHOW NO AUX DISC STA DAUXN SET CHANNEL TO ZERO STA ADS# #SECT PER TRACK TO ZERO, CCA AND SUBCHANNEL STA AUXCH TO -1. JSB \SPAC AUXDS LDA P31 SEND MESSAGE LDB MES6 AUX DISC (YES OR NO OR # TRKS)? JSB \READ GO GET ANSWER LDA N3 FIRST TRY FOR A DECIMAL JSB \GET# NUMBER JMP AUX0 NO TRY FOR YES OR NO * STA \TBUF SAVE THE NUMBER JSB \GETC END OF INPUT? SZA JMP AUX0 NO LET \YENO SEND ERROR * LDA \TBUF GET BACK THE SIZE STA DAUXN SET THE AUX DISC SIZE JSB DSSIZ GET ITS # SECTORS / TRACK JMP AUX3 GO SET IT * AUX0 JSB \GINT RESET THE SCANNER JSB \YENO TRY FOR YES OR NO JMP AUXDS NO MUST BE BAD ANSWER * JMP STSCR NO - SKIP * CLA,INA YES - IF ONLY ONE CPA #SUBC DISC SUBCHANNEL THEN JMP AUX4 THEN WRONG ANSWER TRY AGAIN * JSB \SPAC YES - SET UP AUX UNIT AUXUN LDA P17 SEND QUESTION: LDB MES7 AUX DISC SUBCHNL? JSB \READ GO SEND AND GET ANSWER LDA N4 JSB \DCON JMP AUXUN ERROR - TRY AGAIN * JSB TSTCH TEST FOR LEGAL UNIT AUX1 STB DAUXN SET SIZE OF AUX UNIT CPA SYSCH SAME AS SYSTEM? RSS YES - ERROR SKIP JMP AUX2 NO - GO SET UP * AUX4 JSB \INER SEND ERROR MESSAGE JMP AUXIN AND TRY AGAIN * SYSER JSB \INER SEND ERROR MESSAGE JMP ISYSC TRY AGAIN * AUX2 ADB M7400 TOO MANY TRACKS FOR AUX CMB,SSB,INB,SZB DISC? JMP AUX4 YES GO BITCH SPC 1 STA AUXCH SET AUX CHANNEL LDA P96 SET AUX TRK SIZE TO SAME AS SYS DISC AUX3 STA ADS# SET AUX DISC # SECT. TRACK SPC 1 * NOTE: THE FACT THAT ANY GIVEN DISC * ADDRESS IS ON A UNIT OTHER THAN * THE SYSTEM UNIT IS FLAGGED BY * ITS TRACK ADDRESS BEING GREATER THAN * 400 BY THE AMOUNT OF THE DESIRED * TRACK. STSCR JMP \DST5,I RETURN TO MAIN LINE CODE SPC 1 P96 DEC 96 P32 DEC 32 BSHED NOP CB@<=32 SSB,RSS JMP TSTER * LDB A NUMBER TO B BLS,BLS INDEX INTO THE ADB ATB30 MAP TABLE ADDRESS ADB P2 STEP TO # TRACKS LDB B,I GET # TRACKS IN B SZB IF ZERO - ERROR - SKIP JMP TSTCH,I ELSE OK - RETURN B= # TRACKS * TSTER JSB \INER SEND ERROR MESSAGE LDA TSTCH GET RETURN ADDRElSS ADA N2 ADJUST FOR P-1 JMP A,I AND RETURN * N32 DEC -32 SKP * * INSERT CHNL NO. IN INSTRUCTION * * THE STDSK SUBROUTINE SETS THE CURRENT DISK CHANNEL * NOS. IN THE I/O INSTRUCTIONS. * * CALLING SEQUENCE: * A = NO. WORDS TO BE CONFIGURED (NEG.) * B = ADDRESS OF INSTRUCTION ADDR LIST * JSB STDSK * * RETURN: * A = DESTROYED * B = NEXT INSTRUCTION ADDRESS * STDSK NOP STA \TBUF SAVE NO. OF INSTRUCTIONS STDS1 LDA B,I GET INSTRUCTION AND M7700 ISOLATE INSTRUCTION CODE IOR DCHNL INSERT CHANNEL NO. STA B,I SET INSTRUCTION IN CODE INB INCR INSTRUCTION ADDRESS ISZ \TBUF SKIP - ALL INSTRUCTIONS CONFIG. JMP STDS1 CONFIGURE NEXT INSTRUCTION JMP STDSK,I RETURN * I/OTB DEF DSK1 DEF DSK2 DEF DSK3 DEF DSK4 DEF DSK5 DEF DSK6 DEF DSK7 DEF DSKDR I/OTC EQU * HPDSK DEF I/OTB,I ADDRESS OF I/O INSTRUCTION LIST #DATA ABS I/OTB-I/OTC # OF DATA I/O INSTRUCTIONS SPC 2 HED MH RT4GN CONFIGURE AND COMPLETE INITILIZATION \BOT5 NOP CONFIGURE PAPER TAPE BOOTSTRAP LDA #DATA GET THE NUMBER OF DATA CHANNEL INSTRUCTIONS LDB HPDSK GET THE ADDRESS OF THE DISK ADDRESSES JSB STDSK GO SET DATA CHANNEL ADDRESSES * LDA BADD GET THE BOOT ADDRESS AND M1177 MASK TO PAGE BITS AND IOR M0760 ADD PAGE BITS AND STA BADD SET FOR THE PAPER BOOT RAL,CLE,ERA CLEAR THE SIGN BIT STA BADDD FOR THE PAPER BOOT LDA DDIV CONFIGURE THE DIVIDE AND M1777 IOR M0760 STA DDIV AND RESET IT * * SEND THE BOOT EXTENSION TO ABSOLUTE OUTPUT FILE * LDB ABOOT OUTPUT THE BOOT EXTENSION CLA,CLE TO THE DISC JSB \DSKD TRACK ZERO SECT ZERO SPC 3 BOOT0 JSB \SPAC NEW LINE Z  LDA P15 SEND MESSAGE LDB MES4 BOOT FILE NAME? JSB \RNME GET THE NAME * JSB \GINT IF A 0 WAS ENTERED, THEN CLA,INA SKIP THE BOOT JSB \GETN CPA ZERO JMP \BOT5,I * JSB \CRET CREAT BOOT FILE DEF *+5 DEF \BDCB DEF P1 DEF P7 DEF M2300 * CLA JSB \CFIL CHECK FILE STATUS JMP BOOT0 ERROR-TRY AGAIN * LDA NBLC GET BOOT LENGTH STA \TBUF SET FOR CHECK SUM CACULATION LDA STRAP GET LOAD ADDRESS CLB,RSS INITIALIZE CHECKSUM BOOT1 ADB A,I COMPUTE CHECKSUM INA STEP ADDRESS ISZ \TBUF DONE? JMP BOOT1 NO - GET NEXT WORD * STB A,I YES - SET CHECKSUM * JSB WRITF OUTPUT THE BOOTSTRAP FILE DEF *+5 DEF \BDCB DEF \FMRR DEF STRAP+1 DEF BOOTL * LDA \BDCB+2 SZA IF ITS A TYPE 0 FILE JMP \BOT5,I THEN WRITE AN EOF JSB WRITF DEF *+5 DEF \BDCB DEF \FMRR DEF STRAP+1 DEF N1 * JMP \BOT5,I RETURN TO MAIN SPC 2 N1 DEC -1 M2300 OCT 2300 MESS2 DEF *+1 ASC 12,CONTROLLER SELECT CODE? MES6 DEF *+1 ASC 16,AUX DISC (YES OR NO OR # TRKS)? ZERO OCT 60 * BSS BEG55+1600B-* HED RT4GN DISC DRIVE I/O INSTRUCTION ADDRESSES HED RT4GN ** TRACK 0 SECTOR 0 BOOT EXTENSION ** * * THE FOLLOWING LOADER PERMITS LOADING OF THE RESIDENT PORTIONS * OF THE REAL TIME MONITOR. THE LOADER IS LOCATED ON SECTOR 0/1, * TRACK 0 OF THE SYSTEM DISC. IT IS GENERATED BY THE SYSTEM * GENERATOR AND CONSISTS OF: * * (1) THE INSTRUCTIONS REQUIRED FOR LOADING THE SYSTEM * (2) THE DISK AND CORE ADDRESSES SPECIFYING LOADING * * * THE PROGRAM IS ASSUMED TO BE LOADED IN THE AREA JUST PRECEDING * THE PROTECTED LOADER. * START ABS LDA-O+HIGH HIGH CORE ADDRESS CMA,CCE  COMPLEMENT, SET DIRECTION BIT ABS STA-O+RECNT INITIALIZE INITIALIZE COUNT ERB 100000B IS LOW CORE ADDRESS WITH CLC 2 DIRECTION BIT SET OTB 2 SET MEMORY ADDRESS REGISTER ABS LDA-O+SC SZA,RSS COMING FROM PAPER TAPE BOOT? LIA 1 YES,GET CONTENTS OF SWITCH REGISTER LSR 6 ABS AND-O+B77 MASK SELECT CODE OF DISC ABS STA-O+SC SAVE IT LOOP ABS LDA-O+HDA+I+I CONFIGURE I/O INSTR FROM STIO ABS LDB-O+HDA+I+I ABS AND-O+IOMSK MASK OUT LOWER 6 BITS IN INSTR ABS ADB-O+SC CONFIGURE INSTR FOR DISC SC ABS CPA-O+IOG IS THIS INSTR IN I/O GROUP? ABS STB-O+HDA+I+I YES, THEN STORE IT BACK ABS ISZ-O+HDA MOVE ON TO THE NEXT INSTR ABS LDA-O+HDA ABS CPA-O+HDA3 ALL DISC IO INSTR CONFIGURED? CLA,INA,RSS YES,SET A TO 1 FOR SECTOR # ABS JMP-O+LOOP NO, THEN CONFIGURE NEXT ONE SLOAD ABS STA-O+BENT ABS LDA-O+T#ACK CLB DIV -O+#HDS GET RELATIVE TRACK/HEAD DDIV EQU *-1 ABS ADA-O+TBASE ADD TRACK ZERO TO GET ABS. TRACK ABS STA-O+CYLA1 SAVE FOR ADDRESSING ABS STA-O+CYLA3 SAVE FOR ADDRESSING ABS ADB-O+BHD# ADD THE BASE HEAD ADDRESS ABS LDA-O+BENT GET SECTOR TO A BLF,BLF PUT HEAD IN HIGH B AND ABS ADB-O+BENT ADD THE SECTOR RSS SKIP OVER ADDRESS OF BENT ABS 2000B-OO+BENT DEFINE ADDRESS OF BENT ABS STB-O+HDA SET THE HEAD/SECTOR ADDRESSES ABS STB-O+HDA3 SET THE HEAD/SECTOR ADDRESSES LSL 7 SECTOR TIMES 128 CMA,INA AND SUBTRACT FROM ABS ADA-O+#WDTK NUMBER OF WORDS PER TRACK ABS STA-O+P#WDS SET POSITIVE # WORDS CMA,INA AND ABS STA-O+N#WDS NEGATIVE # WORDS THIS TRACK ABS LDA-O+RECNT GET NUMBER LEFT SSA,RSS IF POSITIVE JMP 3B,I DONE - S>O EXIT * ABS ADA-O+P#WDS ELSE SET TO READ ABS STA-O+RECNT SAVE REMANING COUNT SSA NEXT TRACK CLA USE MIN. OF NUMBER ON TRACK OR ABS ADA-O+N#WDS NUMBER LEFT STC 2 SET DMA FOR WORD COUNT OTA 2 AND SEND IT ABS LDB-O+D#PRM GET THE COMMAND SLOOP LDA 1,I GET A COMMAND RAL,CLE,SLA,ERA IF SIGN BIT SET DSK10 CLC 0 SEND COMMAND IS COMMING DSK11 OTA 0,C SEND THE COMMAND ABS CPB-O+A#DMA IF DMA STC 6,C START IT DSK12 STC 0 ALLOW ATTENTION SEZ,INB,RSS IF NOT A COMMAND ABS JMP-O+STDMA DON'T WAIT FOR FLAG * DSK13 SFS 0 WAIT FOR THE FLAG ABS JMP-O+*-1 STDMA STF 6 STOP DMA IF NEEDED ABS CPB-O+A#END END OF LOOP? RSS SKIP IF END ABS JMP-O+SLOOP NOT END AROUND WE GO * DSK14 LIA 0,C GET STATUS 1 DSK15 SFS 0 WAIT FOR FLAG ABS JMP-O+*-1 DSK16 LIB 0,C GET STATUS 2 ABS AND-O+C174B ISOLATE SZA,RSS IF NO ERRORS ABS JMP-O+OK CONTINUE * SWP SWITCH A AND B REGISTER CONTENTS HLT31 HLT 31B ELSE HALT ABS JMP-O+HLT31 TRY AGAIN * OK ABS ISZ-O+T#ACK STEP THE TRACK ADDRESS ABS JMP-O+SLOAD GO LOAD (A=0=SECTOR ADDRESS) * * DATA AREA C174B OCT 17400 P#WDS DEC -128 N#WDS OCT 77477 HIGH EQU N#WDS WAK OCT 113000 SKCMD OCT 101200 CYLA1 OCT 77600 HDA ABS 76000B-O+DSK10 AD#RC OCT 106000 CYLA3 NOP SC EQU CYLA3 HDA3 ABS 76000B-O+DSK16+1 FILM# OCT 107404 R#CMD OCT 102400 S#TAC OCT 101400 #WDTK DEC 6144 RECNT OCT 77600 CONFIGURED TO BBL ADDRESS D#PRM ABS 76000B-O+WAK TBASE NOP FIRST TRACK# - MUST BE AT START+143B FOR SWTCH!!!!! A#DMA ABS 76000B-O+R#CMD A#END ABS 76000B-O+S#TAC+1 IOG OCT 102000 #HDS DEC 2 # SURFACES BHD# NOP STARTING HEAD # IOMSK OCT 172076 SPCAD ABS 2000B-OO+START B77 OCT 77 T#ACK NOP * BENT NOP JSB HERE FROM BBDL STF 6 CLEAN UP DMA CLC 0,C AND THE I/O SYSTEM CLB ELIMINATE HLT 77B LIA 1 READ SWITCH REG ABS STA-OO+SC SAVE SWITCH REGISTER CONTENTS LSR 5 SLA,RSS WAS BIT 5 OF SWICTH REG SET? ABS JMP-OO+NORCN NO, THEN RECONFIG NOT REQD HLT 77B YES, THEN HALT TO LET USER SET SW REG ABS JMP-OO+DRBOT RELOCATE THE REST OF THIS BOOT NORCN OTB 1 CLEAR SWITCH REGISTER * DRBOT ABS LDA-OO+SPCAD+I+I MOVE 128 WORDS TO BBL-128 ABS STA-OO+RECNT+I+I ABS ISZ-OO+SPCAD ABS ISZ-OO+RECNT ABS ISZ-OO+P#WDS DONE? ABS JMP-OO+DRBOT NO GET NEXT WORD * ABS JMP-OO+CYLA1+I+I YES GO EXECUTE THE BOOT SKP * * * * THE FOLLOWING EQU SECTION ALLOWS THE BOOTSTRAP * TO BE LOCATED ANYWHERE IN CORE WHEN OUTPUT TO * DISK, BUT EXECUTABLE FROM THE LAST PAGE OF CORE. * * * O EQU START-1600B SET FOR START AT 1600 PAGE RELATIVE * CPB EQU 056000B CPB CPA EQU 052000B CPA LDB EQU 066000B LDB STB EQU 076000B STB ADB EQU 046000B ADB JSB EQU 016000B JSB ISZ EQU 036000B ISZ LDA EQU 062000B LDA STA EQU 072000B STA ADA EQU 042000B ADA AND EQU 012000B AND XOR EQU 022000B XOR JMP EQU 026000B JMP I EQU 040000B INDIRECT BIT (CODE AS I+I) * * THE FOLLOWING EQU ARE USE TO SET UP THE BBDL MOVE CODE * WHEN BOOTED BY THE BBDL THE LOADR IS LOADED TO 2011 * AND JSB'ED TO AT 2055,I (44 RELATIVE) * OO EQU START-11B RELATIVE PAGE LOCATION OF START HED MOVING HEAD PAPER TAPE BOOT STRAP * MOVING HEAD BOOTSTRAP * THIS BOOTSTRAP IS CONFIGURED AND PUNCHED BY THE GENERATOR AND IS * USED TO LOAD THE DISC RESIDENT BOOTSTRAP FROM SYSTEM TRACK * 0 SECTOR 0. SPC 2 STRAP DEF *+1 ADDRESS OF THE BOOT STRAP ABS BL256 LENGTH OF LOADR IN HIGH HALF OF WORD ABS BORG LOAD ADDRESS S#ART CLC 0,C STOP EVERTHING - RTE IS COMMING! LIA 1 READ CONTENTS OF SWITCH REG SSA,RSS RECONFIGURATION REQUIRED? JMP SETDS-ADCON NO, SET SWITCH REG TO OLD DISC SC ELA,CLE,ERA YES, CLEAR SIGN BIT CLB LSR 6 A REG HAS NEW DISC SC SZA,RSS SPECIFIED? JMP SETDS-ADCON NO, SET SWITCH REG TO OLD DISC SC STA DSKSC-ADCON YES, SAVE IT LDB DSKAD-ADCON CONFIGURE ALL DISC I/O INTSTRUCTIONS IOLP LDA B,I FOR NEW DISC SC AND MASK-ADCON CLEAR LOW 6 BITS OF INSTR WORD IOR DSKSC-ADCON STA B,I RESTORE DISC I/O INSTR INB ISZ DATA#-ADCON DONE? JMP IOLP-ADCON NO, CONFIGURE NEXT INSTR JMP CNTNU-ADCON YES, CONTINUE * SETDS LDA DSK1-ADCON ISOLATE CURRENT DSCE SC AND DSKSC-ADCON ALF RAL,RAL MOVE DISC SC TO BITS 6-11 STA DSKSC-ADCON SAVE IT LIA 1 GET CONTENTS OF SWITCH REGISTER AND CLRDS-ADCON CLEAR BITS 6-11 OF SWITCH REG IOR DSKSC-ADCON INSERT DISC SC INTO BITS 6-11 OTA 1 OF THE SWITCH REGISTER * CNTNU LDA DSKDR-ADCON SET OTA 6 UP CLC 2 DMA LDB BADD-ADCON BUFFER ADDRESS OTB 2 LDA DM128-ADCON 128 WORDS STC 2 OTA 2 LDB P#LST-ADCON N#XT INB STEP ADDRESS N#XT1 LDA B,I GET THE COMMAND RAL,CLE,SLA,ERA IF A CLC IS NEEDED DSK1 CLC DC DO IT DSK2 OTA DC,C SEND THE WORD CPB P#DMA-ADCON DMA NOW? STC 6,C YES DSK3 STC DC ALLOW ATTENTION SEZ,RSS IF NOT A COMMAND JMP DMAST-ADCON DON'T WAIT FOR FLAG * DSK4 SFS DC WAIT FOR FLAG JMP *-1-ADCON * DMAST STF 6 CLEAR DMA CPB P#END-ADCON END OF LOOP RSS YES SKIP OUT JMP N#XT-ADCON NO DO NEXT WORD * DSK5 LIA DC,C GET THE STATUS 1 WORD DSK6 SFS DC WAIT FOR 2 JMP *-1-ADCON * DSK7 LIB DC,C GET STATUS 2 AND B174C-ADCON ISOLATE THE IMPORTANT BITS SZA,RSS IF OK JMP BTEXT-ADCON GET READY TO EXECUTE THE BOOT * RBR,SLB,RBL TEST \READY BIT JMP ATN#-ADCON NOT \READY GO WAIT FOR ATTN. * SWP SWITCH A AND B REGISTER CONTENTS HLT 11B ELSE HALT JMS#A JMP S#ART-ADCON TRY AGAIN * BTEXT CLB CLEAR B REG FOR THE BOOT EXTENSION JMP BADDD-ADCON,I GO EXECUTE THE BOOT * ATN# LDB P#LST-ADCON GET 'END' COMMAND ADDRESS AND JMP N#XT1-ADCON GO SEND IT AND WAIT FOR ATTN. P#LST DEF *+1-ADCON ADDRESS OF COMMAND LIST OCT 112400 END COMMAND (WAITS FOR ATTN.) WA#KE OCT 113000 PT#SK OCT 101200 PT#TR NOP H#AD NOP PT#AD OCT 106000 PT#T2 NOP PT#H2 NOP OCT 107404 FILE MASK R#DCM OCT 102400 P#EN OCT 101400 STATUS COMMAND BADD ABS START-O+I+I THESE DSKDR ABS DC DMA CON WORD DM128 DEC -128 BADDD ABS START-O B174C OCT 17400 P#END ABS P#EN-ADCON P#DMA ABS R#DCM-ADCON MASK OCT 177700 DSKSC OCT 77 CLRDS OCT 170077 I#OTB DEF DSK1-ADCON DEF DSK2-ADCON DEF DSK3-ADCON DEF DSK4-ADCON DEF DSK5-ADCON DEF DSK6-ADCON DEF DSK7-ADCON DEF DSKDR-ADCON I#OTC EQU * DATA# ABS I#OTB-I#OTC # OF DATA I/O INSTRUCTIONS DSKAD DEF I#OTB-ADCON,I ADDRESS OF I/O INSTRUCTION LIST SPC 1 HNDR EQU *-1 * NOP LOCATION FOR CHECK SUM SPC 2 BORG EQU 100B RUN TIME ORG OF PAPER BOOT ADCON EQU S#ART-100B ADDRESS ADJUSTING CONSTANT. BL EQU HNDR-S#ART+1 BOOT LENGTH BL4 EQU BL+BL+BL+BL BOOT LENGTH TIMES 4 BL16 EQU BL4+BL4+BL4+BL4 TIMES 16 BL64 EQU BL16+BL16+BL16+BL16 TIMES 64 BL256 EQU BL64.+BL64+BL64+BL64 TIMES 256 BOOTL ABS BL+3 LENGTH FOR PUNCHING NBLC ABS -BL-2 BOOT LENGTH FOR CHECK SUM CACULATION HED GENERATE $TB32 TRACK MAP TABLE \TB32 EQU * **ENTRY POINT FOR DSTBL** DSTBL NOP * GENERATE TB32 SPC 2 LDA ATB30 GET THE TABLE ADDRESS STA \TBUF SET FOR INDEXING LDA #SUBC GET NUMBER OF WORDS CMA,INA SET NEGATIVE STA \TBUF+1 SET COUNT LDB $TB32 GET THE LST ENTRY JSB \LSTS FOR $TB32 JSB \ABOR BAD NEWS NO $TB32 ????? LDB \PREL GET THE CORE ADDRESS FOR TABLE STB \LST5,I SET IN THE SYMBOL TABLE LDA \TBUF+1 SEND THE SUBCHANNEL COUNT JSB \ABDO FIRST * DSTB1 LDA \TBUF,I GET WORD FROM TABLE JSB \ABDO SEND TO DISC ISZ \TBUF STEP TABLE ADDRESS LDA \TBUF,I GET THE HEAD/UNIT WORD JSB \ABDO SEND IT ISZ \TBUF STEP TO THE # OF TRACKS WORD LDA \TBUF,I AND JSB \ABDO SEND IT ISZ \TBUF STEP OVER THE SPARE WORD ISZ \TBUF ISZ \TBUF+1 STEP COUNT - DONE? JMP DSTB1 NO - GET NEXT ENTRY * STB \PREL RESET NEW CORE ADDRESS * LDB ATB30 SIGNAL \DSKD TO CMB,INB WRITE HEADER RECORD CCA,CLE #2 CONTAINING THE TRACK JSB \DSKD MAP TABLE IMAGE JMP \TB32,I EXIT * $TB32 DEF *+1 ASC 3,$TB32 * HED 7905 RTGEN SUBROUTINE SEGMENT * * FSECT IS A ROUTINE TO SET LOAD SPECS IN THE LOAD SPEC. * TABLE IN THE DISC RESIDENT BOOT EXTENSION AND TO * FLUSH THE FINAL SECTOR FROM CORE AT THE END OF * GENERATION. * \FSC5 NOP LDB ABOOT GET THE CLA,CCE BOOT FROM JSB \DSKD THE DISC LDB LWSLB GET THE HIGHEST SYSTEM ADDRESS STB HIGH AND STORE IN THE BOOT LDB ABOOT NOW WRITE CLA,CLE THE BOOT:<:6 JSB \DSKD BACK TO THE DISC CLE DLD \OBUF FLUSH THE FINAL BUFFER ELA,CLE FROM CORE JSB \DSKD * * WRITE THE GENERATOR'S FIRST HEADER RECORD, STORED IN THE TMT BUFFER. * THE FIRST 6 WORDS MUST CONTAIN THE SYSTEM SUBCHANNEL INFORMATION. * * LDA SYSCH IOR MSIGN SIGNAL AN RTE-IV STA TB30 THE SYSTEM SUBCHANNEL LDA DRT2 AND M77 STA TB30+1 " " EQT # LDA CEQT STA TB30+2 # EQT'S LDA \PIOC STA TB30+3 PRIVILEGED INTERRUPT CHANNEL LDA \TBCH STA TB30+4 TBG CHANNEL LDA TB30+127 RETRIEVE FROM TEMP. STORAGE AND M77 LDB #SUBC GET # OF DEFINED DISK SUBCHANNELS BLF,BLF ROTATE TO THE HIGH BYTE IOR B AND MERGE WITH THE TTY CHANNEL STA TB30+5 AND SAVE LDB ATB30 CMB,INB NEGATE IT SO \DSKD WILL KNOW CLA,CLE JSB \DSKD JMP \FSC5,I * MSIGN OCT 100000 * M17 OCT 17 * END EQU * * END BEG05 ='<ASMB,R,L,C HED RT4G8 - DRIVER PARTITION LOADING CONTROL SEGMENT NAM RT4G8,5,90 92067-16009 REV.1805 780207 SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 3 ****************************************************************** * * NAME: RT4G8 * SOURCE PART #: 92067-18009 * REL PART #: 92067-16009 * WRITTEN BY: KFH * ****************************************************************** SPC 1 * * ENTRY POINT NAMES * ENT \\LDP * * EXTERNAL REFERENCE NAMES * EXT \DPLD,\PREL,\TBUF EXT \CBPA,\CPL2 EXT \CONV,\ABDO,\DSKA EXT \ADSK,\PTYP,\TMSK EXT \SPAC,\GNER,\MESS,\IRER,\ABOR EXT \ADBP,\NUMP EXT \IDX,\TIDN,\ID1,\ID3,\ID4,\ID5,\ID6,\ID8 EXT \IFIX,\FIX,\FIX1 EXT \CUBP,\UCBP,\ICBP,\CBPA EXT \SYS,\USRS,\USER EXT \LRBP,\URBP,\SRET EXT \DDON * * A EQU 0 B EQU 1 SUP ************************************************************************ * SKP *************************************************************************** * * 770913 * * THE FOLLOWING BLOCK OF STORAGE FOR VARIABLES PRECEEDS, * AND IS REFERENCED BY, EACH SEGMENT. IT IS NOT OVERLAID * AS EACH NEW SEGMENT IS LOADED INTO MEMORY. * * THE LOCATION OF EACH VARIABLE MUST BE THE SAME IN ALL * SEGMENTS. IF A CHANGE IS MADE, MAKE THE SAME CHANGES * IN THE REST OF THE SEGMENTS. * *************************************************************************** * * TB30 BSS 128 r TRACK MAP TABLE/HEADER RECORD BUFFER * ILIST BSS 64 USER SYSTEM PROG IDENT ADDR LIST CURIL BSS 1 CURRENT ILIST ADDRESS * SYSCH BSS 1 SUBCHANNEL OF SYSTEM UNIT. DCHNL BSS 1 CHANNEL OF SYSTEM DISK UNIT AUXCH BSS 1 SUBCHANNEL OF AUX UNIT. DSIZE BSS 1 DISK SIZE -NO. OF TRACKS. #SUBC BSS 1 # DISC SUBCHANNELS DEF'D (7905/7920) DAUXN BSS 1 AUXILIARY DISK SIZE. ADS# BSS 1 AUX DISC SECTORS/TRACK. * * RELOCATION BASE TABLE. RBTA BSS 1 ABSOLUTE PROGRAM BASE. TPREL BSS 1 CURRENT PROGRAM BASE ADDRESS. TPBRE BSS 1 BASE PAGE RELOCATION ADDRESS. COMAD BSS 1 CURRENT COMMON RELOCATION BASE. BSS 1 ABS PROGRAM BASE FOR MR CODE. * WDCNT BSS 1 TEMPORARY WORD COUNTER. DSKSY BSS 1 INITIAL ID SEGMENT DISK ADDRESS IDSP BSS 1 POSITION OF 1ST ID SEG. IN SECT TTYCH BSS 1 SYSTEM TTY CHANNEL NO. * PLFLG BSS 1 PROGRAM LOAD. FLAG = -1/0 = L/NL DSCNT BSS 1 DISK SEGMENT SECTOR COUNT * NXFLG BSS 1 ENT/EXT FLAG = -1/0 EXCNT BSS 1 SYMBOL COUNTER * LCNT BSS 1 CURRENT \LBUF COUNT DCNT BSS 1 CURRENT DBUF COUNT CURAI BSS 1 CURRENT IBUF COUNT * CPLS BSS 1 ADDRESS OF TOP OF FIXED CP LINK IMAGE CPL1 BSS 1 ADDRESS OF LOW CURRENT PAGE LINK SPECS. CPL1H BSS 1 NUMBER OF CURRENT PAGE LINKS ASSIGNED CPL2H BSS 1 IN LOW AND HIGH AREA RESPECTIVELY URBP1 BSS 1 LWA R/T DISC RES BP LINK AREA CURAK BSS 1 CURRENT KBUF ADDRESS * CURAT BSS 1 CURRENT \TBUF ADDRESS TCNT BSS 1 CURRENT \TBUF COUNT * CURAP BSS 1 CURRENT PLIST ADDRESS * AMAD BSS 1 CURRENT MLIST ADDRESS * IXCNT BSS 1 ID EXTENSION COUNT IDEXC BSS 1 CURRENT ID EXT'S USED IDEX BSS 1 ADDRESS OF ID EXTENSION TABLE * LICNT BSS 1 LONG ID SEGMENT COUNT SICNT BSS 1 SHORT ID SEGWKMENT COUNT SSCNT BSS 1 BG. SEG ID COUNT * DSKID BSS 1 DISK ID SEGMENT ADDRESS KEYCN BSS 1 TOTAL KEYWORD COUNT KEYCT BSS 1 CURRENT KEYWORD COUNT * MLIST BSS 11 MEMORY MAP BUFFER * TEMP1 BSS 1 TEMP2 BSS 1 LWH1 BSS 1 LWH2 BSS 1 LWH3 BSS 1 LWH4 BSS 1 L01 BSS 1 * FSYBP BSS 1 FIRST WORD SYS BP LINKAGE SYSAD BSS 1 CURRENT ID SEGMENT ADDRESS * TBREL BSS 1 CURRENT BP RELOC ADDR PBREL BSS 1 INITIAL BP RELOC ADDR * RELAD BSS 1 CURRENT CORE RELOCATION ADDRESS * BSBAD BSS 1 BG SEGMENT BP RELOC ADDR BSPAD BSS 1 BG SEGMENT PROG RELOC ADDR * LFLAG BSS 1 PROGRAMS-LOADED FLAG IMAIN BSS 1 CURRENT MAIN IDENT INDEX. HDFLG BSS 1 HEADING FORMAT FLAG CIDNT BSS 1 CURRENT MAIN IDENT INDEX. * AEQT BSS 1 ADDRESS OF EQUIPMENT TABLE CEQT BSS 1 NO. ENTRIES IN EQUIPMENT TABLE SPLCO BSS 1 SPOOL EQT COUNT DVMAP BSS 1 ADDRESS OF DRIVER MAP TABLE * DPFLG BSS 1 DP RELOCATION FLAG, 0=YES, -1=NO DPLN BSS 1 PAGE LENGTH OF DRIVER PARTITION DPADD BSS 1 START ADDR OF DRIVER PARTITION DSKDP BSS 1 DISK ADDRESS OF DP #2 PAGE# BSS 1 NEXT PHYSICAL PAGE TO ALLOCATE DPNUM BSS 1 CURRENT DP# -1, OR TOT DP PAGES SDID BSS 1 IDENT IDEX OF SYS DISK DRIVER LWDP1 BSS 1 LAST WORD OF DP, +1 FWSDA BSS 1 FIRST WORD OF SDA * ASQT BSS 1 ADDR OF DEVICE REFERENCE TABLE CSQT BSS 1 NO. ENTRIES IN DEV. REF. TABLE * AINT BSS 1 ADDRESS OF INTERRUPT TABLE * DSKIN BSS 1 DISK ADDR OF INT CODE RECORD INTCN BSS 1 RECORD COUNT OF INT CODE * IDSAV BSS 1 INDEX OF CURRENT IDENT. DSKMN BSS 1 INITIAL MAIN DISK ADDRESS BSSDP BSS 1 INITIAL DISK RES MAIN BSS DISP PRENT BSS 1 PRIMARY ENTRY POINT DBLAD BSS 1 CURRENT DBL ADDRESS REKEY BSS 1 INSTRUCTION TYPE BYTE ;INSCN BSS 1 INSTRUCTION TYPE COUNTER INSTR BSS 1 CURRENT INSTRUCTION PAGNO BSS 1 CURRENT PAGE NO. OPRND BSS 1 CURRENT OPERAND PLGTH BSS 1 PROGRAM LENGTH * DRT2 BSS 1 DISK DRT ENTRY ( SYSTEM) DRT3 BSS 1 AUX DISK DRT ENTRY * LIBFG BSS 1 LDTYP BSS 1 * SCH1 BSS 1 INDEX OF IDENT OF PGM TO BE SCHEDULED SCH3 BSS 1 ADDRESS OF CURRENT ID SEGMENT SCH4 BSS 1 ADDRESS OF THE SCHEDULED PGM ID SEG FGBGC BSS 1 BACKGROUND USING FG COMMON FLAG $LIBR BSS 1 INDEX OF $LIBR ENT $LIBX BSS 1 INDEX OF $LIBX ENT CUPRI BSS 1 * BLLO BSS 1 -(LOWER BUFFER LIMIT) BLHI BSS 1 -(UPPER BUFFER LIMIT) * MEM6 BSS 1 MEM12 BSS 1 * COMRT BSS 1 MAXIMUM RT COM LENGTH COMBG BSS 1 MAXIMUM BG COM LENGTH COMSZ BSS 1 #WORDS COMMON DECLARED IN CURRENT MAIN RTCAD BSS 1 RT COMMON ADDRESS BGCAD BSS 1 BG COMMON ADDRESS FPCOM BSS 1 FIRST PAGE OCCUPIED BY COMMON LPCOM BSS 1 LAST PAGE CONTAINING ANY COMMON * FPSAM BSS 1 1ST PAGE CONTAINING S.A.M. FWSAM BSS 1 1ST WORD CONTAINING S.A.M. SYMAD BSS 1 VALUE FOR AVMEM IN SCOM SAM#1 BSS 1 SIZE OF FIRST CHUNK OF SAM SAM#2 BSS 1 SIZE OF SECOND CHUNK OF SAM SAM2P BSS 1 START PAGE OF SAM #2 LWTAI BSS 1 LAST WORD OF TABLE AREA I FWPRV BSS 1 FIRST WORD FOR PRIVILEGED PROGRAMS * FWSYS BSS 1 FIRST WORD OF SYSTEM CODE LPSYS BSS 1 LAST PAGE CONTAINING SYS LWSYS BSS 1 LAST WORD OF SYSTEM LPSLB BSS 1 LAST PAGE OF SLOW BOOT LWSLB BSS 1 LAST WORD OF SLOW BOOT MTYPE BSS 1 MAIN PROGRAMS'S TYPE * HIBP BSS 1 BP LINK MODE FOR FIXUP ENTRIES LOLNK BSS 1 LOW LINK FOR SSGA,LIB, OR SYS HILNK BSS 1 HI LINK USED BY MEM RES PRG BPINC BSS 1 BP LINK ALLOCATION MODE, -1=DOWN,1=UP BPLMT BSS 1 LAST AVAIL BP LINK IN CURRENT MODE, +1f * TPMAX BSS 1 HWM FOR RELOCATION OF BG MAINS & SEGS MAXPT BSS 1 NUM PARTS. ALLOWED MAT. BSS 1 ADDRESS OF MEMORY ALLOCATION TABLE * SSGA. BSS 1 FWA SSGA MAP. BSS 1 PTR TO MEU RES MAP MPFT. BSS 1 PTR TO MPFT * EMLNK BSS 1 EMA SYMBOL'S LINK EMLST BSS 1 LST INDEX OF EMA SYMBOL EMDSK BSS 1 DISK ADDR OF EMA PROGRAM * * MEMORY RESIDENT AREA POINTERS * MRACM BSS 1 MR ACCESS COMMON FLAG (>0 IF YES) LBCAD BSS 1 FIRST WORD OF MEMORY RES LIBRARY LEND BSS 1 LAST WORD OF MEMORY RES LIBRARY FWMRP BSS 1 FIRST WORD OF MEMORY RES PROGRAM AREA EMRP BSS 1 LAST WORD OF MEMORY RES PROGRAM AREA FPMRP BSS 1 FIRST PAGE OF MEMORY RES PROGRAM AREA FPMBP BSS 1 PAGE # FOR MEMORY RES BASE PAGE MRP# BSS 1 # PAGES OCCUPIED BY MRL & MRP'S DSKMB BSS 1 DISK ADDRESS OF MEMORY RES BASE PAGE DSKMR BSS 1 DISK ADDRESS OF MEMORY RESIDENT LIB/PROG AREA DSKBP BSS 1 SYSTEM DISK ADDRESS * DSKAV BSS 1 NEXT AVAILABLE DISK ADDRESS DSKLC BSS 1 DISK ADDRESS OF LIBRARY CODE DSKLB BSS 1 DISK ADDR OF LIBRARY ENTRY PTS DSKUT BSS 1 UTILITY PROG DISK ADDRESS DSKBS BSS 1 DISK ADDR OF MAIN BG DISK RES BP DSKBR BSS 1 CURRENT MAIN BG DISK RES DISK AD ADICT BSS 1 ADDR OF DISK DICTIONARY LBCNT BSS 1 RESIDENT LIBR ENTRY PT COUNT SYCNT BSS 1 SYSTEM ENTRY POINT COUNT KEYAD BSS 1 CURRENT KEYWORD ADDRESS * SYBAD BSS 1 ADDR OF FIRST BP LINK FOR BG IDSAD BSS 1 ADDR OF FIRST ID SEGMENT ABSID BSS 1 IDENT ADDR FOR NEXT BG SEG SCAN IDMBS BSS 1 BG MAIN ADDRESS FOR BS REF * * ********************************************************* * * * END OF COMMON STORAGE BLOCK FOR ALL SEGMENTS. * * * ********************n************************************* * SPC 4 SKP * NOTE THE FOLLOWING RESOLVES ARITHMETIC DEF'S TO EXTERNALS * SEG8 CCA GET LOOP COUNTER STA TEMP1 SAVE LDB LSTAA GET ADDRESS OF LIST LOOP LDA B,I GET ADDRESS RSS LDA A,I RAL,CLE,SLA,ERA JMP *-2 STA B,I AND SAVE IT AGAIN INB ISZ TEMP1 JMP LOOP JMP \SRET RETURN TO MAIN * * LSTAA DEF *+1 ATBUF DEF \TBUF+0 SKP * PROGRAM CONSTANT FACTORS P7 DEC 7 P10 DEC 10 P13 DEC 13 P15 DEC 15 P17 DEC 17 M37 OCT 37 M177 OCT 177 M1000 OCT 1000 M1777 OCT 1777 M7777 OCT 77777 M3777 OCT 37777 M1776 OCT 177776 * LWSBP OCT 1645 * MES64 DEF *+1 ASC 9,PARTITION DRIVERS MESDP DEF *+1 ASC 2,DP DO NOT REARRANGE MESPD NOP THESE FOUR ASC 1,: LINES SKP * * LOADING CONTROL FOR DRIVER PARTITIONS: * - CHOOSES THE NEXT PARTITION DRIVER TO RELOCATE * - ZERO-FILLS ANY REMAINING DRIVER PARTITION SPACE * - UPDATE DRIVER MAP TABLE ENTRIES WITH CORRECT * PHYSICAL DP PAGE # * * ON ENTRY: * A-REG = -1 IF DRIVER PARTITION #1 IS TO BE RELOCATED * = 0 IF DRIVER PARTITIONS #2 ONWARD ARE TO BE * RELOCATED WITH THE REMAINING PRD'S * \\LDP SSA,RSS JMP DP2ON GO LOAD DRIVER PARTITIONS #2 ... * * RELOCATE DRIVERS INTO DRIVER PARTITION #1 ONLY * ADA \PREL DETERMINE THE LAST WORD OF TA I STA LWTAI AND SAVE FOR COMPUTING SAM#0 IOR M1777 AND ROUND TO THE START OF THE INA NEXT PAGE STA DPADD SAVE LOGICAL STARTING ADDRESS OF DP'S JSB CPAG# CONVERT IT TO A PHYSICAL PAGE # AND STA PAGE# FOR UPDATING DVMAP ENTRIES * ADA DPLN ADD # PAGES PER PARTITION STA FPCOM AND SET FIRST COMMON PAGE ALF,ALF MOVE TO CORRECT FORMAT RAL,RAL AS A MEMORY ADDRESS STA LWDP1 AND SAVE AS LAST WORD OF A DP, +1 * LDA SDID GET IDENT INDEX OF SYSTEM DISK DRIVER AND M3777 TO BE RELOCATED STA CIDNT INTO DP #1 CLA SET PROGRAM TYPE STA \PTYP FOR SCDRV/IDSCN STA DPFLG SIGNAL DP RELOCATION MODE JSB \SPAC JSB \SPAC * JMP LOADD NOW LOAD DP #1 * DP1DN LDA LWDP1 SET THE RELOCATION ADDRESS FOR SSGA STA \PREL STA SSGA. AND SAVE FOR MPFT SETTING CCA TURN OFF DP RELOCATION STA DPFLG MODE JMP \DDON RETURN TO LOADING CONTROL IN RT4G3 SKP * * RELOCATE REMAINING PARTITION-RESIDENT DRIVERS INTO DP 'S #2 ONWARD * DP2ON STA \PTYP SET IDENT SCAN TYPE STA DPFLG SIGNAL DP RELOCATION MODE INA NOW SET THE # OF DP'S ALREADY STA DPNUM RELOCATED * LDA P17 SEND LDB MES64 HEADING: JSB SETHD "PARTITION DRIVERS" * * INITIALIZE FOR PARTITION DRIVER LOADING * CCA SET FOR TOP-DOWN LINK STA BPINC ALLOCATION ADA PBREL SAVE LOWEST LINK TO STA BPLMT ALLOCATE(LESS 1) STA HILNK AND HIGHEST SYSTEM LINK ALLOCATED * INA SET BP SCAN ARE TO LOWEST LINK STA \CUBP ABOVE HIGHEST SYSTEM LINK ADA \ADBP AND SAVE ITS RT4GN STA \ICBP IMAGE AREA * LDA LWSBP SET UPPER BP LINK SCAN AREA STA \UCBP BELOW SCOM * CCA ADA LOLNK SET FIRST LINK ADDRESS TO STA PBREL FOLLOW LAST TA-II LINK * CLA CLEAR SO THE SYSTEM-ONLY LINKS STA \LRBP ON BP WILL NOT STA \URBP BE SHARED * LDA M1000 FIXUP LINKS MUST GO IN STA HIBP HIGH BASE PAGE * * JSB DSKEV FORCE EVEN SECTOR BOUNDARY FOR DP #2 STA DSKDP AND SAVE DISK ADDR OF DP #2 (Ff0.*OR $SBTB) * LDA LPSLB GET PHYSICAL PAGE # FOLLOWING INA THE SLOW BOOT/SAM #1 STA PAGE# AND SET STARTING PAGE FOR DP #2 * * JMP LOADD NOW LOAD THE DRIVER PARTITIONS * DPDON LDB PAGE# NEXT AVAILABLE PAGE # STB FPMBP IS THE MEMORY RESIDENT BASE PAGE * CMB,INB DETERMINE IF THERE WERE EVEN ADB \NUMP ENOUGH PHYSICAL PAGES SSB FOR THE DRIVER PARTITIONS JMP PGOV NOPE * LDA LPSLB DETERMINE THE # OF PAGES USED CMA BY DP'S #2 ONWARD ADA FPMBP STA DPNUM AND SAVE CCA TURN OFF DP STA DPFLG RELOCATION MODE * JMP \DDON RETURN TO RT4G3 FOR MEMORY RESIDENT LOADING * * PGOV LDA ERR61 SEND ERROR DIAGNOSTIC JSB \IRER NO MORE PHYSICAL PAGES ERR61 ASC 1,61 SKP * 0* SUBROUTINE LOADD: * LOADS DRIVER PARTITION #1, OR DRIVER PARTITIONS #2 ONWARD * * ON ENTRY THE FOLLOWING HAVE ALREADY BEEN SET UP: * - DPNUM CONTAINS THE # OF DP'S ALREADY BUILT * - BPINC,BPLMT,\CUBP,\ICBP,\UCBP,PBREL,\LRBP,\URBP INITIALIZED * FOR LINK ALLOCATION * - HIBP SET TO ALLOCATE LINKS IN UPPER BASE PAGE * - PAGE# INITIALIZED TO THE PHYSICAL PAGE # OF THE NEXT DP * * LOADD EQU * * * SEARCH FOR A PARTITION-RESIDENT DRIVER * NEWDP JSB SCDRV SCAN IDENTS JMP DPDON NO MORE - DONE WITH DP'S RSS GOT A PRD! JMP NEWDP NO, IT WAS AN SDA DRIVER * * PRINT DP HEADING * SHEAD LDA DPNUM CONVERT CMA PARTITION NUMBER LDB ATBUF TO ASCII JSB \CONV AND LDA \TBUF+2 STORE STA MESPD IN MESSAGE LDA P7 LDB MESDP JSB \MESS PRINT: DP XX: JSB \SPAC * LDA \CBPA RESET THE CP LINK AREA TO "EMPTY" STA \CPL2 LAST CP AREA = LAST BP AREA STA CPLS LAST "SAVE" CP AREA = LAST BP AREA LDA DPADD SET STARTING RELOCATION STA \PREL ADDRESS LDB DPNUM DON'T CHANGE SPECIFICATION SZB MAPS YET IF STILL DP #1 JSB \USRS INITIALIZE \ABDO MAP * * LOAD THE DRIVER INTO THE PARTITION * LPRD LDA \ID3,I GET USAGE WORD CLB,INB AND SET IOR B THE LOADED BIT STA \ID3,I AND RESTORE * JSB \DPLD LOAD THE PROGRAM VIA \NLOD (RT4G4) JSB INCAD UPDATE PBREL & \PREL LDB LWDP1 GET LAST LOGICAL WORD ADDRESS CMB,INB OF A DP, AND CHECK FOR OVERFLOW ADB A OF THIS DRIVER'S RELOCATION SSB JMP SCDVM IT FIT, NOW GO UPDATE THE DVMAP ENTRIES * LDA ERR59 IRRECOVERABLE ERROR JSB \IRER SEND DIAGNOSTIC, AND THEN TERMINATE ERR59 ASC 1,59 SEND DRIVER IS TOO LARGE FOR A DP * * * ` SCAN THE DRIVER MAP TABLE FOR ENTRIES MATCHING * THE CURRENT DRIVER IDENT, AND UPDATE THE ENTRIES * TO THE STARTING PAGE OF ITS PARTITION. * SCDVM STB LEFTO SAVE NEGATIVE # WORDS LEFT IN DP JSB \SYS DVMAP IS IN THE SYSTEM MAP LDB DVMAP GET ITS MEMORY ADDRESS LDA CEQT AND THE NUMBER OF ENTRIES CMA SET A NEGATIVE STA TEMP1 LOOP COUNTER * SCDV1 ISZ TEMP1 BUMP ENTRY COUNTER RSS CONTINUE CHECKING FRO MATCHING IDENTS JMP MORE? DONE WITH THIS DRIVER - FIND NEXT JSB DPRW GET THE CONTENTS OF THE NEXT ENTRY RAL CHECK FOR A NON-UPDATED ENTRY SSA,RSS FROM A PRD-DRIVER JMP SCDV1 WAS AN SDA, OR UPDATED PRD AND M7777 CLEAR THE SIGN BIT RAR AND SHIFT BACK TO CORRECT POSITION CPA IMAIN IS THIS FOR THE CURRENT DRIVER? RSS YES, A MATCH JMP SCDV1 NO, CONTINUE THE SCAN * LDA PAGE# ??? GET STARTING PAGE OF THIS PARTITION ADB N1 MOVE BACK TO ENTRY ADDRESS JSB \ABDO AND UPDATE IT JMP SCDV1 LOOK FOR MORE OF THE SAME * * * SEE IF ANOTHER DRIVER WILL FIT INTO THIS PARTITION * MORE? LDA P10 RESET SCAN TO START AT BEGINNING STA CIDNT OF IDENT TABLE MORE1 JSB SCDRV SCAN FOR A PRD JMP ZFIL NO MORE, ZERO-FILL REMAINDER OF DP RSS JMP MORE1 AN SDA - TRY AGAIN * LDA \ID8,I GET THE DRIVER'S MAIN PROGRAM SIZE AND M3777 ADA LEFTO DOES IT FIT INTO DP? SSA,RSS JMP MORE1 NO, TRY FOR ANOTHER * JSB CPL? IF CPL'S IN EFFECT, GET ESTIMATED SIZE JMP MORE1 NOW IT'S TOO BIG, TRY FOR ANOTHER * LDA DPNUM DON'T CHANGE MAPS IF STILL DP #1 SZA JSB \USER RESET CORRECT OUTPUT MAP LDA \ID3,I GET USAGE WORD OF DRIVER CLB,INB AND SET IOR B THE LOADED BIT STA \ID3,I AND RE-STORE * LDA \ADSK GET THE CURRENT DISK ADDRESS STA EMDSK AND SAVE IN CASE OF BACKUP *TEMP* JSB \DPLD LOAD THE DRIVER AFTER PREV. ONE IN DP * * DETERMINE IF DP OVERFLOW OCCURRED - IN WHICH CASE BACKUP * MUST BE DONE * LDB LWDP1 GET LAST LOGICAL WORD ADDRESS OF A DP,+1 CMB,INB AND CHECK FOR OVERFLOW OF THIS ADB TPREL DRIVER'S RELOCATION SSB,RSS JMP DPOV TOO BAD! * STB LEFTO SAVE #WORDS STILL LEFT IN THIS DP JSB INCAD UPDATE \PREL & PBREL JMP SCDVM+1 GO FILL IN THIS DRIVER'S DVMAP ENTRIES * * DRIVER PARTITION OVERFLOW * DPOV JSB \SPAC SEND THE WARNING ONLY LDA P26 THAT A DP OVERFLOWED LDB BKUPM NO OPERATOR RECOVERY JSB \MESS * LDA IMAIN MAKE SURE THAT THE STA \TIDN CORRECT IDENT ENTRY JSB \IDX IS IN CORE JSB \ABOR NOT THERE! LDA \ID3,I NOW CLEAR ITS AND M1776 LOAD BITS STA \ID3,I LDA EMDSK RESET THE DISK ADDRESS TO STA \ADSK THE VALUE BEFORE THE DRIVER WAS LOADED JSB CLFIX CLEAR ANY FIXUP ENTRIES CREATED BY IT JMP MORE1 SEE IF ANY OTHER DRIVERS WILL FIT * * * ZERO-FILL THE REMAINDER OF THE DP SINCE NO MORE WILL FIT IN IT * ZFIL LDA DPNUM RESET TO USER'S MAP SZA JSB \USER FOR DP'S #2 ... CCA POSITION TO THE LAST ADA \PREL USED ADDRESS IN THIS DP STA B AND SAVE IOR M1777 ROUND TO LAST WORD ON PAGE CPA B ANY CHANGE? JMP NEXT? NO, SO NO FILL NECESSARY LDB A GET LAST WORD ADDRESS CLA AND ZERO-FILL UP TO AND INCLUDING JSB \ABDO THAT ADDRESS * * INITIALIZE FOR LOADING THE NEXT DRIVER PARTITION * NEXT? LDA DPNUM IF THIS WAS THE FIRST DP SZA,RSS JMP DP1DN THEN WE'RE DONE FOR NOW ISZ DPNUM # ELSE BUMP TO THE NEXT DP # * JSB DSKEV FORCE OUTPUT OF LAST SECTOR LDA \PREL GET # WORDS LEFT IN CURRENT CMA,INA DRIVER PARTITION ADA LWDP1 JSB CPAG# AND CONVERT TO THE NUMBER OF AND M37 UNUSED PAGES IN IT CMA,INA AND SUBTRACT FOR DP LENGTH ADA DPLN TO DETERMINE ACTUAL NUMBER ADA PAGE# USED STA PAGE# NOW SET THE STARTING PAGE OF THE NEXT DP * LDA P10 RESET IDENT INDEX FOR STA CIDNT SCAN JMP NEWDP GO START A NEW DRIVER PARTITION * LEFTO NOP BKUPM DEF *+1 ASC 13,DRIVER PARTITION OVERFLOW P26 DEC 26 SPC 4 * * * CONVERT THE ADDRESS IN THE A-REG TO A PAGE # * CPAG# NOP ALF,RAL ROTATE PAGE BITS RAL TO LOW BYTE AND M1777 AND MASK THEM JMP CPAG#,I SKP * * SCDRV SCANS THE IDENT TABLE FOR DRIVERS OF TYPE 0 * WHOSE NAME BEGINS WITH "DV". * * RETURN: (P+1) END OF IDENTS * (P+2) PARTITION-RESIDENT DRIVER * (P+3) SDA DRIVER * * SCDRV NOP * NEXTD JSB IDSCN SCAN IDENTS FOR A TYPE 0 JMP SCDRV,I END OF IDENTS * LDA \ID1,I GET CHARACTERS 1 & 2 CPA "DV" OF NAME, AND COMPARE RSS MUST BEGIN WITH DV JMP NEXTD TRY NEXT DRIVER LDA \ID8,I CHECK IF AN EQT SSA,RSS DEFINED FOR IT (BIT 15 SET) JMP NEXTD NOPE LDB \ID3,I GET LOADED FLAG SLB IF ALREADY LOADED JMP NEXTD THEN SKIP IT * ISZ SCDRV BUMP EXIT RAL NOW CHECK IF AN SDA SSA (BIT 14 WAS SET) ISZ SCDRV YES, BUMP EXIT JMP SCDRV,I RETURN * "DV" ASC 1,DV SKP * * PRINT HEADING, INITIALIZE IDX * * THE SETHD SUBROUTINE PRINTS THE HEADINGS FOR THE DIFFERENT * TYPES OF PROGRAMS LOADED, SETS THE NO-PROGRAMS-LOADED-YET * FLAG, AND ORIGINS THE SCAN OF IDENT. * * CALLING SEQUENCE: * A = NO. CHARS. (POS.) IN MESSAGE * B = ADDRESS OF MESSAGE * JSB SETHD * * RETURN: CONTENTS OF A AND B ARE DESTROYED * SETHD NOP DST \TBUF SAVE THE MESSAGE JSB \SPAC NEW LINE DLD \TBUF NOW JSB \MESS PRINT HEADING JSB \SPAC NEW LINE CCA STA LFLAG SET PROGRAMS-LOADED FLAG = -1 LDA P10 GET FIRST IDENT INDEX STA CIDNT SET IDENT ADDRESS FOR ID SCAN JMP SETHD,I RETURN SKP * * UPDATE RESIDENT MEMORY BOUNDS * * THE INCAD SUBROUTINE UPDATES THE MAIN AND BP MEMORY BOUNDS * FROM THAT USED IN THE PREVIOUS LOADING CALL. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB INCAD * * RETURN: CONTENTS OF A AND B ARE DESTROYED * INCAD NOP LDA TPREL GET CURRENT RELOCATION ADDRESS STA \PREL SET NEW PROGRAM RELOC ADDRESS LDB TBREL GET CURRENT BP RELOC ADDRESS STB PBREL SET NEW BP RELOCATION ADDRESS JMP INCAD,I RETURN SPC 5 * DSKEV FORCES THE CURRENT DISC * ADDRESS TO BE EVEN. THIS IS * DONE TO INCREASE LOAD EFFENCIENCY * DURING RTE EXECUTION DSKEV NOP LDA \ADSK GET CURRENT ADDRESS SLA IF EVEN SKIP JSB \DSKA ELSE STEP BY ONE STA \ADSK RESET ADDRESS JMP DSKEV,I RETURN - ADDRESS IN A. SPC 5 * * DPRW - READ AND REWRITE A WORD FROM THE ABSOLUTE SYSTEM * STORED ON THE DISK * * CALL A-IGNORED * B- ABS TARGET SYSTEM ADDR * RETURN: B SET TO B+1 * A=CONTENTS OF DESIRED WORD SPC 1 DPRW NOP JSB \ABDO READ AND DESTROY WORD STA DPRWT SAVE IN TEMP ADB N1  BACK UP ADDR JSB \ABDO RESTORE WORD LDA DPRWT BACK TO A JMP DPRW,I AND RETURN SPC 1 DPRWT BSS 1 N1 DEC -1 SKP * * SCAN IDENTS FOR PROGRAM TYPE * * THE IDSCN SUBROUTINE SCANS IDENT FOR A PROGRAM OF THE * CURRENT TYPE (SET IN \PTYP). * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB IDSCN * * RETURN: CONTENTS OF A AND B ARE DESTOYED. * E = M/S FLAG FOR CURRENT PROGRAM. * IDSCN NOP LDA CIDNT GET NEXT IDENT IN SCAN STA \TIDN SET IDENT INDEX FOR IDX * IDSC0 JSB \IDX SET IDENT ADDRESSES JMP IDSCN,I RETURN - END OF IDENTS CCA ADA \TIDN GET CURRENT MAIN IDENT INDEX STA IMAIN SAVE CURRENT MAIN IDENT INDEX LDA \TIDN GET NEXT IDENT INDEX STA CIDNT SAVE ADDR FOR NEXT IDENT SCAN LDA \ID4,I GET TYPE RAL,CLE,ERA SET E = M/S LDA \ID6,I GET TYPE AND M177 MASK TO TYPE BITS CPA \PTYP WHAT WE WANTED? JMP IDSC1 YES CPA P13 MUST NOT CONFUSE JMP IDSC0 TYPE 13 AND 15 MODULES CPA P15 WITH TYPES 5 AND 7 JMP IDSC0 TRY NEXT * AND \TMSK ISOLATE PROGRAM TYPE CPA \PTYP CURRENT TYPE? RSS YES - CONTINUE JMP IDSC0 IGNORE IDENT - TRY NEXT IDENT IDSC1 ISZ IDSCN INCR RETURN ADDRESS JMP IDSCN,I RETURN SKP * * CPL? DETERMINES THE SPACE NEEDED BY A DRIVER WITH CURRENT PAGE LINKS * IN EFFECT - AND CHECKS TO SEE IF IT WILL FIT IN THE REMAINDER OF A * DRIVER PARTITION, WHERE LEFTO CONTAINS THE NEGATIVE NUMBER OF WORDS * LEFT IN THE DP. * * RETURN: (P+1) CPL SIZE IS TOO LARGE FOR LEFTO * (P+2) THIS DRIVER WILL FIT IN THE DP * CPL? NOP LDB \ID5,I DOES THE USET WANT SSB,RSS CURRENT PAGE LINKS? JMP CPLX NO, TAKE SUCCESS RETURN * LDA \PREL  GET ADDRESS STA B OF THE LAST WORD IOR M1777 OF THE PAGE CMB,INB COMPUTE THE INB NUMBER OF WORDS ADB A REMAINING ON STB TEMP2 THE PAGE * LDA \ID8,I COMPUTE THE # OF AND M3777 WORDS OF STA TEMP3 CMB,INB THE PROGRAM ADB A THAT FALL STB TEMP1 BEYOND THIS PAGE * SSB WILL THE PROGRAM RSS FIT ON THIS PAGE? SZB,RSS NO - SKIP JMP CPLX YES, SO NEEDN'T WORRY ABOUT CPL'S * LDA TEMP2 COMPUTE MINIMUM OF: ARS HALF # OF WORDS OF PROG CMB,INB ON CURRENT PAGE -OR- ADB A # OF WORDS OF PROG ON SSB,RSS NEXT PAGE * LDA TEMP1 DIVIDE THIS CLB MINIMUM DIV P4 BY FOUR SZA,RSS IF NON-ZERO, USE AS SIZE JMP CPLX OF LOW CURRENT PG LINK AREA * ADA TEMP3 ADD PROGRAM SIZE ADA LEFTO AND NEGATIVE # OF WORDS LEFT SSA,RSS IN DP JMP CPL?,I WON'T FIT * CPLX ISZ CPL? BUMP RETURN ADDRESS TO INDICATE JMP CPL?,I THAT DRIVER WILL FIT - EXCLUDING LIBR RTNS * TEMP3 NOP P4 DEC 4 SKP * * CLFIX CLEARS ANY FIXUP ENTRIES BUILT BY A RELOCATED * DRIVER THAT HAS OVERFLOWED THE DRIVER PARTITION * (AND WILL THEREFORE BE RELOCATED INTO ANOTHER DP). * CLFIX NOP JSB \IFIX INITIALIZE THE FIXUP TABLE CLFX1 JSB \FIX SET ADDRESSES OF NEXT ENTRY JMP CLFIX,I END OF LIST * LDA \FIX1,I IS THIS ENTRY FREE? SSA JMP CLFX1 YES * LDB \PREL SEE IF THE ENTRY WAS BUILT CMB,INB BY AN OVERFLOWD DRIVER -CHECK ADA B ITS INSTR. ADDRESS AGAINST THE LAST SSA VALID DP RELOCATION ADDRESS JMP CLFX1 NO - ENTRY IS OK TO LEAVE * CCA CLEAR ENTRY BUILT BY7+0.* STA \FIX1,I OVERFLOWED DRIVER JMP CLFX1 CONTINUE UNTIL END OF LIST * * * END SEG8 q 0 e 92067-18010 1840 S 0822 SWTCH              H0108 iASMB,R,L,C HED SWTCH - TRANSFERS FILE CONTAINING RTE-IV SYSTEM GENERATED ONLINE NAM SWTCH,3,10 92067-16010 REV.1840 780810 SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 2 **************************************** * * NAME: SWTCH-IV * SOURCE: 92067-18010 * BINARY: 92067-16010 * WRITTEN BY: KFH * **************************************** SPC 2 * * TURN - ON SEQUENCE: * * RU,SWTCH,FLNAME:SC:LB,CHANNEL,SUBCHANNEL/UNIT,AUTO,FILES,TYPE6,INITS * * WHERE: * * FLNAME:SC:LB IS THE ABSOLUTE FILE NAME OF THE SYSTEM * CHANNEL IS THE OCTAL TARGET CHANNEL, WITH A "B" APPENDED * SUBCHANNEL IS THE TARGET 7900 SUBCHANNEL * OR * UNIT IS THE TARGET 7905/7920 UNIT * AUTO IS Y/N, FOR AUTO BOOT-UP * FILES IS Y/N, FOR SAVING THE TARGET FILE SYSTEM * TYPE6 IS Y/N, FOR PURGING THE TYPE 6 FILES AT THE TARGET * INITS IS Y/N, FOR INITIALIZING ANY ADDITIONAL SUBCHANNELS SPC 2 * * * THE ON-LINE RTE GENERATOR PRODUCES AN FMP FILE CONTAINING * A COMPLETE RTE-IV SYSTEM FOR A SPECIFIC CONFIGURATION. * SWTCH COPIES THE FILE ONTO THAT CHANNEL AND SUBCHANNEL(UNIT), OR * TO A USER-SPECIFIED 'TEMPORARY' CHANNEL AND SUBCHANNEL(UNIT). * AND BEFORE THE TRANSFER BEGINS, THE FILE IS CHECKED FOR VALIDITY, * THE OPERATOR IS NOTIFIED OF THE DESTINATION CONFIGURATION, * INCLUDING THE SYSTEM SUBCHANNEL DEFINITION. * * IF THE NEW RTE SYSTEM OVERLAYS THE CURRENT SYSTEM, A NEW * FMP SETUP (INITIALIZED) CODE WORD IS COMPUTED AND WRITTEN * INTO THE FMP CARTRIDGE DIRECTORY SO THAT ON BOOTUP, FMP * WILL REMAIN INTACT (INITIALIZED). SKP * ENTRY POINTS * ENT SWTCH * ENT \SWTM ENT \DFTR,\DSHD,\DNSU,\DNSP,\DNTR,\DSUB ENT \TUNT,\TCH,\TSUB,\DUNT ENT \INIT,\LNTH ENT \BUFA,\XOUT,\SAVE ENT \TRAK,\SECT ENT \CVAS,\CLEN,\DSPL,\BLIN ENT \FFMP,\STRK ENT \BOOT,\TMT,\LU2 * * EXTERNAL ENTRY POINTS * EXT RMPAR,EXEC,$LIBR EXT OPEN,READF,LOCF,CLOSE EXT $LIBR,$LIBX * EXT \DSK0,\DSK5 EXT \INP0,\INP5 EXT \INT0,\INT5 EXT \STD0,\STD5 EXT CNUMD,GETST EXT \FLGT,\SETD,\BADH * IFN EXT DBUG XIF * SPC 2 A EQU 0 B EQU 1 SUP SKP * HEADER RECORD #1 FORMAT * * ------------------------------------ * !1! SYSTEM SUBCHANNEL # ! * ------------------------------------ * ! SYSTEM EQT # ! * ------------------------------------ * ! NUMBER OF EQT'S ! * ------------------------------------ * ! PRIV. INT. CHANNEL ! * ------------------------------------ * ! TBG CHANNEL ! * ------------------------------------ * ! # SUBCHANNELS ! TTY CHANNEL ! * ------------------------------------ * ! CHANNEL # ! EQT TYPE ! FOR EQT #1 * ------------------------------------ * ! CHANNEL # ! EQT TYPE ! FOR EQT #2 * ------------------------------------ * . . * . . * . . * ------------------------------------ * ! CHANNEL # ! EQT TYPE ! FOR EQT #N * ------------------------------------ SPC 2 * z HEADER RECORD #2 FORMAT * * FOR A 7905/6/20 SYSTEM: * * ------------------------------------ * ! FIRST CYLINDER # ! ONE 4-WORD * ------------------------------------ * ! # SUFACES ! STARTING HEAD ! UNIT ! ENTRY FOR * ------------------------------------ * ! NUMBER OF TRACKS ! SUBCHANNELS * ------------------------------------ * ! NUMBER OF SPARES ! 0 THRU 31 * ------------------------------------ * * FOR A 7900 SYSTEM: * * ------------------------------------ * ! FIRST TRACK # ! SUBCHANNEL 0 * ------------------------------------ * . SUBCHANNELS 1 * . * . THRU 7 * ------------------------------------ * ! NUMBER OF TRACKS ! SUBCHANNEL 0 * ------------------------------------ * . SUBCHANNELS 1 * . * . THRU 7 SKP SPC 4 *------------------------------------------------------------------------ * * THE FOLLOWING 6144 WORDS WILL BE OVERLAID * ONCE THE TRANSFER PROCESS BEGINS. BUFR * WILL CONTAIN ONE TRACK'S WORTH OF INFO. * *------------------------------------------------------------------------ SPC 4 BUFR BSS 128 BUFFER FOR 1 FULL TRACK (6144 WORDS) * * MES1 DEF *+1 ASC 22, ****** W A R N I N G ****** MES2 DEF *+1 ASC 23,ALL ACTIVITY MUST BE TERMINATED BEFORE SYSTEM ASC 9,TRANSFER PROCESS. SPC 2 BSS 384+BUFR-* NEED TO READ IN 3 RECORDS AT VERF1 SPC 2 MES3 DEF *+1 ASC 14,FILE NAME OF NEW RTE SYSTEM? MES4 DEF *+1 ASC 9,ILLEGA>L FILE NAME MES5 DEF *+1 ASC 15,NEW SYSTEM I/O CONFIGURATION: MES6 DEF *+1 ASC 18,SELECT CODE XX PRIVILEGED INTERRUPT MES6A DEF MES6+7 MES7 DEF *+1 ASC 9,SELECT CODE XX TBG MES7A DEF MES7+7 MES8 DEF *+1 ASC 11,SELECT CODE XX TYPE=XX MES8A DEF MES8+7 MES8B DEF MES8+11 MES9 DEF *+1 ASC 24,NEW SYSTEM (LU2) SELECT CODE= XX SUBCHANNEL= XX MES9A DEF MES9+16 MES9B DEF MES9+24 MES10 DEF *+1 ASC 12,PLATTER XX FIRST TRACK# MS10A ASC 9,XXXX #TRACKS XXXX MS10C DEF MS10A MS10D DEF MS10A+7 MES11 DEF *+1 ASC 20, HEAD# X #TRACKS XXXX #SURFACES X MS11C DEF *+1 ASC 20, UNIT# X FIRST CYL# XXXX #SPARES X MS11A DEF MES11+12 MS11B DEF MS11C+12 MS11D DEF MS11C+20 MES12 DEF *+1 ASC 25,TARGET SELECT CODE FOR NEW SYSTEM? (XX OR " "CR) MES13 DEF *+1 ASC 14,TARGET PLATTER/UNIT FOR NEW ASC 11,SYSTEM? (X OR " "CR) MES14 DEF *+1 ASC 20,NEW SYSTEM WILL OVERWRITE FILE XXXXXX. MES16 DEF *+1 ASC 23,NOW IS THE TIME TO INSERT CORRECT CARTRIDGE IN MES17 DEF *+1 ASC 21,TARGET PLATTER/UNIT. (" "CR TO CONTINUE) MES18 DEF *+1 ASC 16,SAVE FILES AT TARGET? (Y OR N) MES19 DEF *+1 ASC 19,NEW SYSTEM WILL DESTROY SOME FMP FILES MES20 DEF *+1 ASC 12,OK TO PROCEED? (Y OR N) MES22 DEF *+1 ASC 15,PURGE TYPE 6 FILES? (Y OR N) MES23 DEF *+1 ASC 19, INFORMATION STORED ON PLATTER/UNIT XX ASC 14, OF TARGET SELECT CODE XX MS23B DEF *+1 ASC 9, WILL BE DESTROYED MS23A DEF MES23+32 MES24 DEF *+1 ASC 12,AUTO BOOT-UP? (Y OR N) MES25 DEF *+1 ASC 25,PRESENT CONFIGURATION DOESN'T PERMIT AUTO BOOT-UP. MES26 DEF *+1 ASC 22,SYSTEM WILL HALT AFTER TRANSFER COMPLETION. MES32 DEF *+1 ASC 17,READY TO TRANSFER. OK TO PROCEED? MES34 DEF *+1 ASC 18,INITIALIZE SUBCHANNELS ? (Y OR N) MS34A DEF MES34+12 "L" ASC 1,L MES35 DEF *+1 ASC 15,TARGET PLATTER? (XX OR " "CR) MES36 DEF *+1 ASC 16,TARGET UNIT XX FOR SUBCHANNELS MS36A ASC 24, ASC 20, ASC 24, COMBL ASC 1,, MS36B DEF MS36A MES37 DEF *+1 ASC 16,DESTN. UNIT XX FOR SUBCHANNELS MS37A ASC 24, MS37B DEF MS37A MES38 DEF *+1 ASC 14,TARGET UNIT? (XX OR " "CR) * SWAP0 DEF *+1 ASC 3,SWSG1 7900 DISK DRIVER SEGMENT SWAP5 DEF *+1 ASC 3,SWSG2 7905/7920 DISK DRIVER SEGMENT SKP * CONSTANTS * B177 OCT 177 B777 OCT 777 B1774 OCT 177400 B2060 OCT 20060 * N7 DEC -7 N31 DEC -31 N64 DEC -64 N89 DEC -89 * P12 DEC 12 P14 DEC 14 P17 DEC 17 P28 DEC 28 P64 DEC 64 P98 DEC 98 P512 DEC 512 * SKP * * * F$TB SEARCHES THE RESIDENT LIBRARY ENTRY POINT * LIST FOR THE APPROPRIATE TRACK MAP TABLE, * $TB31 OR $TB32 (DEPENDENT UPON THE SOURCE * DISK TYPE), AND RETURNS IT IN BUFR. * * CALLING SEQUENCE: JSB F$TB * DEF .1 OR .2 * F$TB NOP LDA #LEP GET # OF LIBRARY ENTRY POINTS MPY P4 4 WORDS PER ENTRY STA LEPL SAVE SIZE OF L.E.P. LIST * LDA ALEP GET DISK ADDRESS OF LEP LIST LDB A ALF,ALF RAL AND B777 STA LTRK SAVE THE TRACK LDA B AND B177 F$T3 STA LSEC AND SECTOR ADA N89 DETERMINE IF THE SECTOR RESULTS IN SSA LESS THAN 512 WORDS LEFT ON TRACK JMP F$T1 <89 INA SEE HOW MANY SECTORS LESS MPY P64 CMA,INA AND SUBTRACT FROM ADA P512 512 MAX STA LLEN LENGTH OF READ JMP F$T0 F$T1 LDA LEPL JSB GTLEN GET READ LENGTH F$T0 JSB READD READ IT * CLB LDA LLEN DIV P4 GET THE # OF ENTRIES READ IN CMA,INA NEGATE STA LCNT LOOP COUNTER LDB \BUFA F$T2 STB BPTR * LDA $T CPA B,I A "$T"? INB,RSS JMP NOTIT NO LDA B3  CPA B,I A "B3"? INB,RSS JMP NOTIT NO LDA F$TB,I LDA A,I GET "1" OR "2" XOR B,I AND B1774 SZA,RSS A MATCH? JMP F$T7 YES!! * NOTIT ISZ LCNT DONE WITH CURRENT BUFFER? RSS JMP F$T4 YES LDB BPTR ADB P4 JMP F$T2 * F$T4 LDA LLEN SEE IF ALL WERE SEARCHED CMA ADA LEPL SSA IF WE'VE GONE THRU THE ENTIRE LEP JMP ABF$ THEN ITS NOT THERE, SO ABORT SWTCH INA STA LEPL NEW # LEFT * LDB LSEC DETERMINE IF TRACK CROSSING ADB N89 IF >= 88 THEN THERE WILL BE INB SSB JMP F$T5 NOPE * ISZ LTRK YES, INCREMENT TO NEXT TRACK CLB STB LSEC SET NEXT SECTOR TO 0 JMP F$T1 SET LENGTH OF READ * F$T5 LDA LSEC INCREMENT TO NEXT STARTING ADA P8 SECTOR JMP F$T3 SET LENGTH OF READ * F$T7 STB LCNT TEMPORARY SAVE LDB P17 DETERMINE IF WE'RE TO READ LDA SEQT IN A $TB31 (17 WORDS), OR SLA,RSS A $TB32 (98 WORDS) LDB P98 STB LLEN * LDB LCNT RESTORE ENTRY POINTER LDA B,I DETERMINE IF ENTRY IS AT A INB AND P1 MEMORY ADDRESS, OR A DISK SZA BY CHECKING BIT 0 OF WORD 3 JMP F$T9 DISK ADDR * LDA B,I GET THE MEMORY ADDRESS LDB SEQT DETERMINE IF USER-DEFINED TMT SLB,RSS DIFFERENT CHECKS FOR 7900-7905/7920 JMP F$T10 7905/7920 LDB A,I GET WORD 1 SSB IF NEGATIVE, THERE'S AN EXTRA WORD INA * F$T11 LDB LLEN # WORDS TO GET CMB,INB STB LCNT LOOP COUNTER LDB \BUFA STB BPTR BUFFER POINTER RSS F$T8 ISZ BPTR NEXT LOCATION LDB A,I STB BPTR,I STORE WORD INA INCRMENT MEMORY ADDRESS IS2UZ LCNT DONE? JMP F$T8 NO LDA \BUFA STA BPTR ISZ F$TB JMP F$TB,I * F$T10 LDB A,I CHECK WORD 1 SSB,RSS IF POSITIVE,THERE'S AN EXTRA WORD INA JMP F$T11 * F$T9 LDA B,I TRANSLATE THE DISK ALF,ALF ADDRESS TO RAL AND B377 STA LTRK TRACK AND LDA B,I AND B177 STA LSEC SECTOR * JSB READD READ IT LDA \BUFA INA SKIP EXTRA WORD STA BPTR ISZ F$TB JMP F$TB,I * ABF$ LDA P28 LDB MES30 JSB \DSPL JMP \XOUT TERMINATE SWTCH SPC 3 #LEP EQU 1762B # OF LIBRARY ENTRY POINTS IN LIST ALEP EQU 1761B ADDR " " " LIST LEPL NOP LENGTH " " " " LCNT NOP COUNTER $T ASC 1,$T B3 ASC 1,B3 .1 ASC 1,1 .2 ASC 1,2 MES30 DEF *+1 ASC 28,SOURCE SUBCHANNEL NOT FOUND ON A SYSTEM TRACK MAP TABLE SKP * * GTLEN COMPUTES LLEN FOR READING THE * LIBRARY ENTRY POINTS LIST INTO * BUFR * * CALLING SEQUENCE: (A)=REMAINING SIZE OF L.E.P. * JSB GTLEN * GTLEN NOP LDB P512 THE NORMAL BUFFER SIZE CMA,INA IF MORE THAN THE REMAINING ADA P512 LEP SIZE, THEN USE THE SIZE SSA,RSS IN (A) LDB LEPL STB LLEN JMP GTLEN,I SPC 5 * * READD READS LLEN WORDS AT TRACK LTRK, AND * SECTOR LSEC * READD NOP JSB EXEC DEF *+7 DEF P1 DEF P2 DEF BUFR DEF LLEN DEF LTRK DEF LSEC * JMP READD,I * * LTRK NOP LSEC NOP SKP * * VERIFIES THE EXISTENCE OF A SYSTEM SUBCHANNEL MATCH * AT THE TARGET CHANNEL AND SUBCHANNEL. THE FOLLOWING * CHECKS ARE MADE: * * VERIFY THAT A CARTRIDGE DIRECTORY EXISTS ON THE * LAST SYSTEM TRACK (AS DEFINED BY THE NEW * SYSTEM) * ' VERIFY THAT A FILE DIRECTORY SPECIFICATION ENTRY * EXISTS ON THIS TRACK * VERIFY THAT A TRACK 0 SECTOR 0 BOOTSTRAP EXISTS * AT THE FIRST PHYSICAL TRACK/CYLINDER OF * DESTINATION SYSTEM * * * RETURN: (P+1) CAN'T SAVE THE FILE STRUCTURE * (P+2) CAN SAVE IT * VFYSY NOP CLA STA \INIT CLEAR INIT WORD FOR DISKD * LDA N128 STA \LNTH READ 128 WORDS CCE HOPEFULLY THEY WILL CONTAIN LDB \BUFA THE CARTRIDGE DIRECTORY AT STB BPTR TARGET SUBCHANNEL CCA ADA \DNTR DESTINATION SYSTEM LAST(LOGICAL) STA \TRAK TRACK, LESS 1 CLA STA \SECT JSB DISKD * * * VERIFY THE EXISTENCE OF A CARTRIDGE DIRECTORY * LDA N31 MAX # CARTRIDGE ENTRIES STA TEMP1 CHCD0 LDA BPTR,I GET WORD 0 OF ENTRY SSA JMP NOTFS LU WORD < 0 LDB N64 ADB A SSB,RSS JMP NOTFS LU > 77(8) * CPA P0 END OF LU'S ? JMP CHCD3 YES CPA P2 LU 2 (SYSTEM) ? RSS YES JMP CHCD1 CHECK WORDS 1-3 IN ENTRY * LDB BPTR GET WORD #1 OF THE (POSSIBLY) INB SYSTEM LU 2 ENTRY LDA B,I SSA JMP NOTFS LAST FMP TRACK WORD < 0 STA D.LT SAVE FOR LATER CHECKS * CHCD1 LDA N3 STA TEMP2 * CHCD2 ISZ BPTR CHECK WORDS 1,2,&3 LDA BPTR,I OF ENTRY FOR VALUES SSA >= 0 JMP NOTFS INVALID ISZ TEMP2 JMP CHCD2 CHECK NEXT WORD ISZ BPTR NEXT ENTRY WORD 0 ISZ TEMP1 LAST ENTRY (31)? JMP CHCD0 NO,CONTINUE * CHCD3 LDA D.LT (WAS INITIALLY -1) SSA JMP NOTFS NEVER SET BY A LU 2 LDA BF124 SZA JMP NOTFS WORD 124 OF CD MUST = 0 * * * LOOKED LIKE A CARTRIDGE DIRECTORY. NOW TRY FOR A * FILE DIRECTORY IN THE[o NEXT BLOCK. * CCA ADA \DNTR DETERMINE DISK ADDRESS OF NEXT STA \TRAK BLOCK CONTAINING THE LDA P14 FILE SPEC ENTRY STA \SECT READ 128 WORDS, HOPEFULLY THE LDB \BUFA SPEC ENTRY STB BPTR CCE JSB DISKD * LDA BPTR,I TESTS FOR A VALID FILE DIRECTORY ENTRY: SSA,RSS JMP NOTFS WORD 0 MUST BE < 0 * LDA N7 WORDS 1-7,9-15 IN SPEC MUST BE >= 0 STA TEMP2 CHFD1 ISZ BPTR LDA BPTR,I SSA JMP NOTFS < 0, THEREFORE INVALID ISZ TEMP2 JMP CHFD1 * ISZ BPTR WORD 8 MUST BE < 0 LDA BPTR,I SSA,RSS JMP NOTFS LDA N6 NOW CHECK WORDS 9-15 STA TEMP2 CHFD2 ISZ BPTR LDA BPTR,I SSA JMP NOTFS ISZ TEMP2 JMP CHFD2 * LDA BF6 WORD 6 (#SECTORS/TRACK) MUST BE LDB BF5 >= WORD 5 (NEXT AVAILABLE SECTOR) CMB,INB ADA B SSA JMP NOTFS INVALID * LDA BF7 LOWEST DIRECTORY TRACK(LOGICAL) LDB BF8 MINUS THE NEGATIVE # DIRECTORY STB D.# TRACKS, CMB MINUS 1 ADA B GIVES LAST FMP TRACK CPA D.LT MUST = LAST FMP TRACK INDICATED RSS IN CD FOR LU 2 JMP NOTFS INVALID * LDB \DNTR DOES THE LOGICAL DIRECTORY TRACK # ADB N1 AT TARGET = LOGICAL DIRECTORY TRACK # CPA B FOR DESTINATION (THE LAST LOGICAL TRACK FOR RSS SYSTEM LU) ? JMP NOTFS NO LDA BF4 SAVE THE FIRST FMP TRACK FOR STA \FFMP FUTURE CHECKS * * * VERIFY THAT A TRACK 0 SECTOR 0 BOOTSTRAP EXISTS AT THE * DESTINATION SYSTEM'S PHYSICAL LOCATION OF LOGICAL TRACK 0 * SECTOR 0 * LDB \BUFA READ(HOPEFULLY) THE TRACK 0,SECTOR 0 STB BPTR BOOTSTRAP CCE CLA STA \TRAK STA \SECT r<:6 JSB DISKD * CCA JSB VT0S0 VERIFY ITS EXISTENCE JMP NOTFS NO GOOD * LDA BF99 TBASE (WORD 100 OF BOOTSTRAP) IS THE CPA \DFTR PHYSICAL LOCATION (TRACK OR CYLINDER) OF RSS TRACK 0 AT THE TARGET - MUST BE EQUAL JMP NOTFS TO THAT OF DESTINATION TRACK 0 * LDA DEQT FURTHER CHECKS FOR A 7905/7920 SYSTEM SLA REPLACEMENT JMP VOUT * LDA BF97 GET NUMBER OF SURFACES CPA \DNSU SAME AS DESTINATION? RSS JMP NOTFS NO LDA BF98 GET STARTING HEAD # CPA \DSHD SAME AS DESTINATION? RSS JMP NOTFS NO * VOUT ISZ VFYSY LOOKS VALID JMP VFYSY,I SPC 2 * * ONE OF THE ABOVE TESTS FAILED, THEREFORE NOT ALLOWING THE * TARGET FILE STRUCTURE TO BE SAVED * NOTFS LDA \TSUB LDB DEQT SLB,RSS LDA \TUNT ADA B2060 STA MES23+19 LDA P1 SET FO \CVAS STA \CLEN LDA \TCH LDB MS23A JSB \CVAS LDA P33 LDB MES23 "INFORMATION STORED ON PLATTER UNIT XX OF JSB \DSPL TARGET CHANNEL YY WILL BE DESTROYED" LDA P9 LDB MS23B JSB \DSPL * JSB OK? CHECK ANSWER * CLA STA \SAVE DON'T \SAVEFILES STA TYP6 " " PURGE TYPE 6'S JMP VFYSY,I * P33 DEC 33 * BF4 EQU BUFR+4 BF5 EQU BUFR+5 BF6 EQU BUFR+6 BF7 EQU BUFR+7 BF8 EQU BUFR+8 BF97 EQU BUFR+147B # SURFACES IN 7905 BOOT EXTENSION BF98 EQU BUFR+150B STARTING HEAD IN 7905 BOOT EXTENSION BF99 EQU BUFR+143B FIRST TRACK IN BOOT EXTENSION BF124 EQU BUFR+124 SKP * VERIFIES THE EXISTENCE OF A TRACK 0, SECTOR 0 BOOTSTRAP * 0<* CALLING SEQUENCE: (A) = -1 WHERE II/III/IV BOOT EXTENSION IS OKAY * = 0 WHERE RTE-IV BOOT EXTENSION IS REQUIRED * * * RETURN: (P+1) NOT A BOOTSTRAP * (P+2) YES, ONE EXISTS * VT0S0 NOP STA STDSK SAVE FLAG IN TEMPORARY * LDB BPTR TRY FOR AN RTE-IV SYSTEM FIRST ADB B155 COMPARE WORDS: LDA B,I CPA WD155 WORD 155 INB,RSS JMP BE23 NO, TRY A II/III LDA B,I CPA WD156 WORD 156 INB,RSS JMP BE23 NO, TRY A II/III LDA B,I CPA WD157 WORD 157 INB,RSS JMP BE23 NO, TRY A II/III LDA B,I CPA WD160 WORD 160 INB,RSS JMP BE23 NO, TRY A II/III LDA B,I CPA WD161 WORD 161 INB,RSS JMP BE23 NO, TRY A II/III INB SKIP WORD 162 LDA B,I CPA WD163 WORD 163 INB,RSS JMP BE23 NO, TRY A II/III LDA B,I CPA WD164 WORD 164 INB,RSS JMP BE23 NO, TRY A II/III LDA B,I CPA WD165 WORD 165 INB,RSS JMP BE23 NO, TRY A II/III LDA B,I CPA WD166 WORD 166 INB,RSS JMP BE23 NO, TRY A II/III LDA B,I CPA WD167 WORD 167 INB,RSS JMP BE23 NO, TRY A II/III LDA B,I CPA WD170 WORD 170 RSS JMP BE23 NO, TRY A II/III ISZ VT0S0 FOUND ONE JMP VT0S0,I SO EXIT * BE23 ISZ STDSK IS A II/III EXTENSION ALLOWED? JMP VT0S0,I NO, SO TAKE FAILURE EXIT * LDB BPTR CHECK MATCH ON WORDS 3,4,5(ALL SAME),6,7 ADB P2 LDA B,I 14,15,16,17,20 CPA WD345 WORD 3 INB,RSS JMP VT0S0,I NO LDA B,I CPA WD345 WORD 4 INB,RSS JMP VT0S0,I NO LDA B,I CPA WD345 WORD 5 INB,RSS JMP VT0S0,I NO LDA B,I  CPA WD6 WORD 6 INB,RSS JMP VT0S0,I NO LDA B,I CPA WD7 WORD 7 RSS JMP VT0S0,I NO ADB P5 LDA B,I CPA WD14 WORD 14 INB,RSS JMP VT0S0,I NO LDA B,I CPA WD15 WORD 15 INB,RSS JMP VT0S0,I NO LDA B,I CPA WD16 WORD 16 INB,RSS JMP VT0S0,I NO LDA B,I CPA WD17 WORD 17 INB,RSS JMP VT0S0,I NO LDA B,I CPA WD20 WORD 20 RSS JMP VT0S0,I NO ISZ VT0S0 JMP VT0S0,I OK!!!!! SPC 2 WD345 OCT 017506 BOOTSTRAP WORDS 3,4,& 5 WD6 OCT 124003 " WORD 6 WD7 OCT 002011 " WORD 7 WD14 OCT 003304 " WORD 14 WD15 OCT 040001 " WORD 15 WD16 OCT 005225 " WORD 16 WD17 OCT 106702 " WORD 17 WD20 OCT 106602 " WORD 20 WD155 OCT 000000 " WORD 155 WD156 OCT 102106 " WORD 156 WD157 OCT 107700 " WORD 157 WD160 OCT 006400 " WORD 160 WD161 OCT 102501 " WORD 161 WD163 OCT 101045 " WORD 163 WD164 OCT 002011 " WORD 164 WD165 OCT 026201 " WORD 165 WD166 OCT 102077 " WORD 166 WD167 OCT 026202 " WORD 167 WD170 OCT 106601 " WORD 170 * B155 OCT 155 SKP * * STDSK CONTROLS THE CALL TO CONFIGURE THE * DISK DRIVER (EITHER \DSK0 FOR 7900 OR \DSK5 * FOR 7905/7920), VIA A CALL TO \STD0 OR \STD5 * STDSK NOP LDA DEQT SLA JMP STDS1 JSB \STD5 CONFIGURE THE 7905/7920 DRIVER JMP STDSK,I * STDS1 JSB \STD0 CONFIGURE THE 7900 DRIVER JMP STDSK,I SKP * OK? QUERIES THE USER WITH: * "OK TO PROCEED? (Y OR N)" * AND TRANSFERS TO \XOUT ON A "N" RESPONSE, * DOING A SIMPLE RETURN ON A "Y" RESPONSE. * OK? NOP LDA P12 LDB MES20 3JSB \DSPL JSB YE?NO DECIPHER ANSWER JMP OK?+1 INVALID REPLY JMP OK?+1 INVALID REPLY JMP \XOUT NO,TERMINATE SWTCH JMP OK?,I SPC 4 * YE?NO READS THE OPERATOR ANSWER ( Y OR N ) * RETURNS TO (P+1) IF INVALID ANSWER * (P+2) IF /E * (P+3) IF NO * (P+4) IF YES * YE?NO NOP JSB EXEC RETRIEVE ANSWER DEF *+5 DEF P1 DEF OPLU DEF BUFR DEF N2 SZB,RSS JMP YE?NO+1 TRY AGAIN FOR A RESPONSE * CLE CHECK HIGH HALF FIRST LDA BUFR CPA "/E" JMP EOUT YENO ALF,ALF AND B377 CPA "N" JMP NOUT CPA "Y" JMP YOUT * SEZ CHECK THE LOW HALF? JMP YE?NO,I ALREADY DID - NEITHER MATCHES LDA BUFR SWITCH EM ALF,ALF CCE JMP YENO CHECK THE LOW HALF * YOUT ISZ YE?NO NOUT ISZ YE?NO EOUT ISZ YE?NO JMP YE?NO,I * "N" OCT 116 "Y" OCT 131 "/E" ASC 1,/E SPC 4 * * READS TARGET RESPONSES, INCLUDING RE-ISSUING EXEC CALL * IN CASE OF TIME-OUTS. * TARGT NOP JSB EXEC GET REPONSE DEF *+5 DEF P1 DEF OPLU DEF BUFR DEF N8 SZB,RSS ANYTHING ENTERED? JMP TARGT+1 NO JMP TARGT,I YES, RETURN SKP * * CHECKS FOR A SPACE (PSEUDO CARRIAGE RETURN) FROM * THE OPERATOR. (B) IS THE LENGTH OF INPUT IN CHARACTERS * RETURN: (P+1) NOT A SPACE * (P+2) A SPACE (SO MAY USE DEFAULT VALUES) * DFLT NOP CPB P1 ONE CHARACTER RETURNED? RSS JMP DFLT,I NO, SO DON'T BOTHER CHECKING LDA BUFR AND B1774 CPA LBLNK ISZ DFLT GOT ONE JMP DFLT,I * LBLNK OCT 20000 SKP * * PARMP, PARAMETER PARSING ROUTINE (CONVERTED FROM NAMR,DLB) * PRODUCES A PARAMETER BUFFER 12 WORDS LONG * * THE TJOWELVE WORDS ARE DESCRIBED AS FOLLOWS: SPC 1 * WORD 1 = 0 IF TYPE = 0 (SEE BELOW) * = 16 BIT TWO'S COMPLEMENT NUMBER IF TYPE = 1 * = CHARS 1 & 2 IF TYPE = 3 * WORD 2 = 0 IF TYPE = 0 OR 1, CHARS 2 & 3 OR TRAILING SPACE(S) IF 3. * WORD 3 = SAME AS WORD 2. (TYPE 3 PARAM. IS LEFT JUSTIFIED) * WORD 4 = PARAMETER TYPE OF ALL 8 PARAMETERS IN 2 BIT PAIRS. * 0 = NULL PARAMETER * 1 = INTEGER NUMERIC PARAMETER * 2 = NOT IMPLEMENTED YET * 3 = LEFT JUSTIFIED 6 ASCII CHARACTER PARAMETER. * BITS FOR : P1 : P2 , P3 , P4 , P5 , P6 , P7 , P8 * 0,1 2,3 4,5 6,7 8,9 10,11 12,13 14,15 * WORD 5 = 1ST SUB-PARAMETER AND HAS CHARACTERISTICS OF WORD 1. * WORD 6 = 2ND SUB-PARAMETER DELIMETED BY COLONS AS IN WORD 5. * WORD 7 = 3RD SUB-PARAM. AS 5 & 6. (MAY BE 0, NUMBER OR 2 CHARS) * WORD 8 = 4TH " * WORD 9 = 5TH " * WORD 10 = 6TH " * WORD 11 = 7TH " * WORD 12 = 8TH " SPC 2 * * WHERE: * DNAME = TWELVE WORD DESTINATION PARAMETER BUFFER ADDRESS * INBUF = STARTING ADDRESS OF INPUT BUFFER CONTAINNING "NAMR". * PARML = CHARACTER LENGTH OF "INBUF". (MUST BE POSITIVE) * ISTRC = THE STARTING CHARACTER NUMBER IN "INBUF". THIS * PARAMETER WILL BE UPDATED FOR POSSIBLE NEXT CALL * TO "PARMP" AS THE START CHARACTER IN "INBUF". * CAUTION!!!! * ISTRC IS MODIFIED BY THIS ROUTINE, THEREFORE IT MUST * BE PASSED AS A VARIABLE (NOT A CONSTANT) FROM CALLER. * SKP * CHECK CALLERS PARAMETERS FOR CORRECTNESS SPC 1 INBUF NOP INPUT BUFFER ADDRESS PARML NOP TRANSMISSION LOG IN CHARACTERS ISTRC NOP CURRENT STARTING CHARACTER IN INBUF * PARMP NOP CCA SET TO NO COMMAS STA FRSTC CLA,INA STA ISTRC SET FIRST CHAR LDB \BUFA STB INBUF INPUT BUFFER ADDRESS LDB DNAME WSTB BPTR NOW CLEAR OUT DEST BUFFER LDA N12 GET DEST BUFFER LENGTH STA SUBCT SAVE IN TEMP CLA ZERO BUFFER STA B,I INB ISZ SUBCT JMP *-3 STA WORD4,I INITIALIZE THE TYPE WORD STA FILEW AND THE FILE FLAG LDA INBUF FORM STARTING CHARACTER CLE,ELA ADDRESS OF INPUT STA INBUF SAVE AS CHARACTER ADDRESS. LDB PARML GET CHARACTER LENGTH ADA B GET ADDRESS OF LAST+1 CHARACTER STA EOFBF AND SAVE FOR LATER USE LDA ISTRC GET START CHAR IN "INBUF" CMB,SSB,INB,SZB CHECK FOR 0 & NEG. CMA,INA,RSS >0, MAKE ISTRC NEG. + TEST FOR 0 CCE DI\DN'T PASS, SET FLAG CMA SUBTRACT 1 FROM ISTRC ADB A A-REG = ISTRC - PARML -1 CCA,SEZ TEST E FOR ERROR JMP PARMP,I RETURN A= -1 FOR ERROR LDA BPTR GET DESTINATION BUFFER LDB A ADB P3 SET ADDRESS OF TYPE WORD STB BPTR AND BUFFER POINTER LDB P3 GET LENGTH OF BUFFER (WORDS) JSB SCAN GET 1ST PARAMETER STA FILEW AND SAVE FILE TYPE(IF ANY) LDB FRSTC WAS A COMMA ENCOUNTERED SZB JMP MORE0 NO RAR,RAR YES, SKIP APPROPRIATE RAR,RAR POSITIONS IN WORD4,I STA WORD4,I FOR P1 AND P2 ISZ BPTR AND UPDATE DESTINATION ISZ BPTR POINTER JMP MORE1 MORE0 LDB N2 SET TO GET THE NEXT 2 PARAMETERS AFTER: STB SUBCT ISZ BPTR LDA BPTR CLB,INB JSB SCAN IOR WORD4,I SET BITS FOR SECURITY CODE (FIRST TIME THRU), RAR,RAR OR LABEL PARAMETER(SECOND TIME THRU) STA WORD4,I ISZ SUBCT RSS JMP MORE1 LDB FRSTC GOT A COMMA AFTER ONLY ONE COLON? SZB JMP MORE0+2 NO, A SECOND COLON ISZ BPTR UPDATE DESTINATION POINTER RAR,RAR AND TYPE BITS FOR NULL PARAMETER P2 STA WORD4,I MORE1 LDB N6 NOW SCAN FOR NEXT 6 SUB-PARAMS STB SUBCT MORE2 ISZ BPTR LDA BPTR GET DESTINATION BUFFER ADDRESS CLB,INB AND THE LENGTH JSB SCAN GET NEXT SUB PARAM IOR WORD4,I MERGE IN WITH PREV. RAR,RAR POSITION "PARAM TYPE BITS" STA WORD4,I AND PUT BACK ISZ SUBCT DONE WITH ALL EIGHT? JMP MORE2 NO, CONTINUE JMP PARMP,I SKP * SCAN ONE PARAMETER OR SUB-PARAM. FOR SETTING OF VARIOUS POINTERS * * * SOB , - 1 2 3 4 B , EOB * ^ ^ ^ ^ ^ ^ ^ ^ * INBFF ISTAR FSTCA FNMCA LNBCA LSTCA EOFBF INBFF+PARML SPC 1 * WHERE: * INBFF = START OF BUFFER (CHARACTER ADDRESS) * ISTAR = RELETIVE STARTING CHARACTER NUMBER IN "INBFF". * FSTCA = FIRST NON SPACE CHARACTER BEFORE DELIMETER. * FNMCA = FIRST NON "+" OR "-" AFTER "FSTCA". * LNBCA = LAST NON SPACE OR "B" CHARACTER BEFORE DELIMETER+1. * EOFBF = ENTERS AT "EOB" AND IS MOVED BACK TO 1ST AFTER "," DELIM. * INBFF+PARML = END OF BUFFER + 1 CHARACTER ADDRESS. SPC 1 EOFBF EQU PARML ADDRS. OF LAST CHAR+1,IN "INBFF" INBFF EQU INBUF ADDRS. OF "INPUT BUFFER TO SCAN" ISTAR EQU ISTRC ADDRS. OF START CHAR IN "INBFF" SPC 1 SCAN NOP A=DEST BUFFER ADDRS, B=LENGTH(WORDS) STA DESTA SAVE DESTINATION ADDRESS STB DESTL SAVE DEST. BUFFER LENGTH (WORDS) *- ADB A FORM LAST+1 ADDRESS *- STB FSTCA SAVE TEMP *- CLB ZERO OUT THE DESTINATION BUFFER *-ZMORE STB A,I *- INA *- CPA FSTCA DONE? *- CCB,RSS YES, CONTINUE *- JMP ZMORE NO, ZERO SOME MORE SPC 1 * SCAN UNTIL NON ASCII SPACE & SET "FSTCA" SPC 1 CCB GET MINUS ONE IN B-REG. ADB INBFF ADDRESS OF THE START ADB ISTAR CHARACTER AMORE STB FSTCA SAVE THE 1ST CۖHAR ADDRESS STB LSTCA AND LAST CHAR ADDRESS STB LNBCA SET LAST NON "B" CHAR. ADDRS. STB FNMCA SET 1ST NON "-" OR "+" CHAR ADDRS. CLA EXIT, A-REG = PARAMETER TYPE CPB EOFBF CHECK IF END OF BUFFER JMP SCAN,I NULL PARAMETER RETURN JSB GNC GET NEXT CHARACTER ISZ ISTAR ADVANCE CHARACTER POINTER CPA O40 IS IT EQUAL TO ASCII SPACE JMP AMORE YES, IGNORE IT STA FSTCR SET THE FIRST CHARACTER CPA PLUS CHECK IF 1ST CHAR RSS IS A PLUS OR MINUS CPA MINUS IF IT IS, BUMP ISZ FNMCA THE START CHAR FOR NUMB. CONV. SPC 1 * SCAN FOR DELIMETERS ":" & "," & "B" & END OF BUFFER. SKP SMORE CPA COLON COLON DELIMETER JMP CONVT NOW, GO CONVERT POSSIBLE # CPA COMMA CHECK IF COMMA JMP INCOM CHECK FOR FIRST COMMA CPA "B" CHECK THE TRAILING CHARACTER CCE,RSS FOR A "B". IF IT IS, STB LNBCA DON'T SET THE NON B CHAR ADDRS. LDA D10 SET THE BASE = 10 SEZ CHANGE TO B= 8, IF LAST CHAR LDA O10 IS EQUAL TO "B" STA BASE1 SET BASE OF NUMBER SYSTEM ADA O60 AND CALCULATE UPPER CMA,INA LIMIT CHECK WORD. STA BASE2 AND FOR LATER USE STB LSTCA AND IT'S ADDRESS+1 SIGNR CPB EOFBF REACHED END OF INBFF? JMP CONVT YES, SKIP NEXT CHAR JSB GNC GET NEXT CHARACTER ISZ ISTAR ADVANCE THE CHARACTER POINTER CPA O40 IGNORE TRAILING SPACES JMP SIGNR BY NOT ENCLUDING IN SCAN JMP SMORE GO CHECK IT SPC 2 INCOM ISZ FRSTC FIRST COMMA? NOP NO SPC 2 * CHECK IF ANY POSSIBLE ASCII NUMBERS TO CONVERT. SPC 1 CONVT CLA NOW TRY NUMBER CONVERSION LDB FSTCA GET 1ST CHAR ADDRESS CPB LSTCA IS IT = LAST CHAR ADDRESS? JMP SCAN,I YES, R/ETURN, NULL PARAMETER LDB FNMCA CHECK IF ANY DATA TO BE CPB LNBCA CONVERTED TO A JMP NOTNU NUMBER. SPC 1 * NOW CHECK IF NUMBER OR ASCII STRING & CONVERT TO NUMBER SPC 1 MMORE MPY BASE1 TRY CONVERSION STA DESTA,I ACCUMULATE NUMBER LDB FNMCA GET CURRENT CHAR ADDRESS SKIP1 JSB GNC GET THE NEXT CHARACTER STB FNMCA PUT BACK + 1 CPA O40 IGNORE ASCII SPACES JMP SKIP1 ADA BASE2 NO, CHECK IF ASCII NUMBER SEZ,CLE,RSS NUMBER MUST BE "0" TO "BASE" ADA BASE1 SEZ,CLE,RSS JMP NOTNU NOT NUMBER, MOVE BUFFER ADA DESTA,I ACCUMULATE THE NUMBER * SOC * CHECK OF OVERFLOWED? * CCA * YES, FORCE RESULT NEG. CPB LNBCA DONE? RSS YES, CONTINUE JMP MMORE SPC 1 * NOW CHECK SIGN OF NUMBER SPC 1 * SOC * TEST IF OVERFLOW? * RAL,CLE,ERA * CHANGE -1 TO 77777B IF OVERFLOW LDB FSTCR CHECK SIGN OF NUMBER CPB MINUS WAS IT NEG? * CMA,SEZ * YES. (*CHANGE TO CMA,INA) CMA,INA YES, MAKE NEG. * RSS * * INA * STA DESTA,I SAVE BACK IN DEST. BUFFER CLA,INA,RSS EXIT A=1 FOR PARAMETER TYPE EXIT3 LDA P3 EXIT A=3 FOR PARAMETER TYPE JMP SCAN,I RETURN DONE SPC 1 * NOT NUMBER, MOVE PARAM INTO DEST. BUFFER SPC 1 NOTNU LDB DESTA GET DEST BUFFER ADDRS CLE,ELB FORM CHARACTER ADDRESS STB FNMCA SAVE FOR NEAR USE ADB DESTL FORM LAST CHAR+1 ADDRESS ADB DESTL TIMES 2 FROM WORDS STB LNBCA SAVE FOR NEAR USE MSTOR LDB FSTCA GET FIRST CHAR. ADDRESS LDA O40 GET SPACE JUST IN CASE CPB LSTCA CHECK IF LAST CHARACTER ADDRESS JMP SKIP2 YES, SKIP GET CHAR FROM "INBFF" JSB GNC GET NEXT CHARACTER STB FSTCA SAVE NEXT CHAR ADDRESS SKIP2 LDB FNMCA GET DEST CHAR ADDRESS CPB LNBCA CHECK IF END OF DEST. BUFFER JMP EXIT3 YES, RETURN DONE ISZ FNMCA BUMP TO NEXT CHAR CLE,ERB CHANGE TO WORD ADDRESS SEZ,RSS POSITION ALF,SLA,ALF PACK XOR B,I AND XOR O40 STORE STA B,I BACK JMP MSTOR GO TRY NEXT CHAR SPC 1 FSTCR NOP FIRST NON SPACE CHARACTER IN BUFFER FSTCA NOP ADDRESS OF FSTCR LSTCA NOP ADDRESS OF LSTCR BASE1 NOP BASE OF NUMBER BASE2 NOP HI BASE TEST OF NUMBER FNMCA NOP CURRENT CHAR SCAN FOR CONVT LNBCA NOP DESTA NOP DESTINATION BUFFER ADDRESS DESTL NOP DEST. BUFFER LENGTH IN CHARACTERS SPC 1 GNC NOP GET NEXT CHARACTER CLE,ERB FORM WORD ADDRESS DESTROY E-REG LDA B,I GET WORD SEZ,RSS HI -OR- LO CHARACTER ALF,ALF AND O177 MASK DOWN TO 7 BITS ELB RESTORE B-REG INB BUMP THE B-REGISTER JMP GNC,I RETURN A= CHARACTER SPC 1 O177 OCT 177 "B" OCT 102 MINUS OCT 55 PLUS OCT 53 O60 OCT 60 O40 OCT 40 COMMA OCT 54 COLON OCT 72 FRSTC DEC -1 FIRST COMMA NOT IN YET O10 OCT 10 D10 DEC 10 SUBCT NOP HOLDS SUB-PARAM. COUNTER N12 DEC -12 SPC 4 WORD4 DEF *+5 ADDRESS FOR TYPE WORD DNAME DEF *+1 NAME BSS 3 FOR FILE NAME BSS 1 TYPE WORD BSS 8 PARAMETERS 1-8 ISECU EQU NAME+4 ICR EQU NAME+5 PARM3 EQU NAME+6 PARM4 EQU NAME+7 PARM5 EQU NAME+8 PARM6 EQU NAME+9 PARM7 EQU NAME+10 PARM8 EQU NAME+11 APARM EQU NAME FILEW NOP SKP * PYN - CHECKS FOR A "Y" OR "N" TURN-ON PARAMTER * A-REG = THE PARAMETER * B-REG = PRESENT STATE OF WORD 4,I * * RETURN:(P+1) NEITHER, OR NOT SPECIFIED * (P+2) GOT ONE, A-REG = 0 FOR NO, =1 FOR YES * PYN NOP STA TEMP1 SA+VE THE PARAMETER RBR,RBR NEXT WORD4 POSITION SLB,RSS IS THIS PARAMETER SPECIFIED? JMP PYN,I NO * LDA B AND P3 CPA P3 ASCII? RSS JMP PYN,I NO STB TEMP2 SAVE CCB LDA TEMP1 ALF,ALF SHIFT TO LOW AND B377 CPA "N" CLB CPA "Y" CLB,INB SSB,RSS ISZ PYN MATCH SSB,RSS ISZ BATCH ONE MORE FOUND NOP LDA B RESTORE LDB TEMP2 JMP PYN,I SPC 3 B400 OCT 400 N72 DEC -72 P384 DEC 384 "!!" ASC 1,!! SKP * * * MAINLINE CODE FOR SWTCH * * THE PRECEDING CODE AND THE CODE UP TO BFULL IS OVERLAID * WHEN THE TRANSFER IS BEGUN * SWTCH NOP STB APARM JSB RMPAR DEF *+2 DEF APARM * IFN JSB DBUG DEF *+1 XIF * * SET UP THE OPERATOR'S LU * LDA APARM GET PARAMETER 1 SZA,RSS SPECIFIED? ISZ APARM NO,SO DEFAULT TO LU 1 AND B1774 SZA NUMERIC? JMP *+3 NO,ASCII - USE DEFAULT LU 1 LDA APARM STA OPLU SET THE LU * LDA OPLU SET ECHO BIT IN IOR B400 OPERATOR LU WORD. STA OPLU * LDA SYSTY GET I-O CHANNEL ADA P3 OF SYSTEM CONSOLE LDA A,I AND B77 STA HTTY * JSB \BLIN LDA P22 DISPLAY WARNING MESSAGES. LDB MES1 JSB \DSPL LDA P32 LDB MES2 JSB \DSPL * * * PARSE THE TURN-ON PARAMETERS * JSB GETST GET THE PARAMETER STRING DEF *+4 DEF BUFR DEF P48 DEF ERR * PARS SZB,RSS ANY THERE? JMP GTNAM NO RBL CONVERT TO CHARACTERS STB PARML SAVE # CHARACTERS JSB PARMP GO PARSE THEM CPA N1 B@< 77, TRY AGAIN * * CONFIGURE THE DISK DRIVER DISKD TO THE TARGET CHANNEL * GTSCH JSB STDSK * * CHECK TARGET SUBCHANNEL OR UNIT * LDA \TSUB GET THE TARGET SUBCHANNEL SSA,RSS SPECIFIED? JMP CHSB YES, CHECK VALIDITY ASKSB JSB \BLIN LDA P25 LDB MES13 JSB \DSPL "TARGET PLATTER/UNIT FOR NEW SYSTEM?" * JSB TARGT READ ANSWER JSB DFLT CR? JMP ASK3 NO LDA DEQT SLA,RSS DEFAULT TO EITHER 7900 SUBCHANNEL OR 7905/7920 UNIT JMP ASK2 LDA \DSUB DEFAULT TARGET SUBCHANNEL TO DESTINATION SUBCHANNEL STA \TSUB JMP CHOV * ASK2 LDA \DUNT STA \TUNT DEFAULT TARGET UNIT TO DESTINATION UNIT JMP CHOV * ASK3 LDA P1 JSB GETOC CONVERT ANSWER TO OCTAL JMP ASKSB ERROR, TRY AGAIN STA \TSUB **TEMP** * CHSB ADA N8 SSA,RSS JMP ASKSB > 7, TRY AGAIN LDB \TSUB LDA DEQT FOR THE 7905/7920, SAVE THE ANSWER AS THE UNIT SLA,RSS STB \TUNT SKP * * CHECK FOR OVERWRITE OF ABSOLUTE FILE CONTAINING NEW SYSTEM * CHOV JSB LOCF GET LU OF DISK DEF *+8 CONTAINING THE FILE. DEF DCB DEF ERR DEF IREC DEF IRB DEF IOFF DEF JSEC DEF SLU * JSB EXEC GET SOURCE EQT TYPE DEF *+6 AND CHANNEL # DEF P13 DEF SLU DEF IEQT5 DEF IEQT4 DEF SSBCH * LDA IEQT4 AND B77 STA SCH DISC CHANNEL LDA IEQT5 ALF,ALF AND B77 STA SEQT DISC TYPE * CPA DEQT SAME AS TARGET TYPE? RSS JMP OKAY NO, THEN NO PROBLEM WITH OVERLAYING ABS FILE LDA SCH CPA \TCH SAME DISC CHANNEL? RSS JMP OKAY NO, AGAIN NO PROBLEM * LDA SEQT GET DISC TYPE SLA,RSS JMP OV05 CHECK VIA 7905/7920 * * * GET 7900 SOURCE SUBCHANNEL DEFINITION VIA $TB31 * JSB F$TB SEARCH THRU SYSTEM ENTRY POINTS FOR IT DEF .1 LDA BPTR GO INTO TABLE AND RETRIEVE: ADA SSBCH LDB A,I STB SFTR SOURCE SUBCHANNEL'S FIRST(PHYSICAL) TRACK * * * 7900 CHECKS FOR OVERWRITE OF ABSOLUTE FILE * LDA SSBCH GET SOURCE SUBCHANNEL(IE, PLATTER) CPA \TSUB COMPARE WITH TARGET SUBCHANNEL RSS JMP OKAY NO PROBLEM, DIFFERENT SUBCHANNELS * LDA \STRK GET NEW SYSTEM SIZE, IN # TRACKS ADA DCB+3 ADD FIRST FILE TRACK # ADA SFTR CONVERT TO ABSOLUTE LAST TRACK OF FILE,+8 ADA N9 LESS THOSE AVAILABLE TRACKS CMA,INA NEGATE ADA \DFTR ADD FIRST TRACK OF NEW SYSTEM SSA,RSS LAST SOURCE TRACK MUST BE < FIRST SYSTEM TRACK JMP OKAY NO PROBLEM LDA \DFTR GET FIRST SYSTEM TRACK CMA ADA DCB+3 ADD FIRST FILE TRACK ADA SFTR CONVERT TO ABSOLUTE FOR FILE SSA,RSS FIRST SOURCE TRACK MUST BE > FIRST SYSTEM TRACK JMP OKAY NO PROBLEM *  * * NEW SYSTEM WILL OVERLAY ABSOLUTE FILE CONTAINING IT * OVWR JSB \BLIN LDA NAME STORE ABS, FILE NAME IN MESSAGE STA MES14+17 LDA NAME+1 STA MES14+18 LDA NAME+2 STA MES14+19 LDA P20 LDB MES14 JSB \DSPL TELL USER JMP \XOUT TERMINATE SWTCH SKP *CONSTANTS B37 OCT 37 B77 OCT 77 N56 DEC -56 P11 DEC 11 P18 DEC 18 P15 DEC 15 P21 DEC 21 P19 DEC 19 P23 DEC 23 P24 DEC 24 P25 DEC 25 P31 DEC 31 P256 DEC 256 * IOFF NOP IRB NOP IREC NOP JSEC NOP * * SUBCHANNEL DEFINITION CONTAINING THE ABSOLUTE (SOURCE) FILE * SEQT NOP SOURCE CHANNEL EQT TYPE SCH NOP " " SSBCH NOP " SUBCHANNEL SFTR NOP " " FIRST TRACK SNHD NOP " " STARTING HEAD SNSU NOP " " # SURFACES SUNIT NOP " " UNIT SLU NOP " LU SPC 2 * HOST => CURRENT SYSTEM UNDER WHICH SWTCH IS OPERATING * HSBCH NOP HOST SYSTEM DISK SUBCHANNEL HCH NOP " " " CHANNEL HEQT NOP " " " TYPE HUNIT NOP " " " UNIT (7905/6/20) HNHD NOP " " SUBCHANNEL STARTING HEAD (7905/6/20) HNSU NOP " " " # SURFACES HFTR NOP " " " STARTING TRACK/CYLINDER HTTY NOP " " TTY CHANNEL SKP * * GET 7905/7920 SOURCE SUBCHANNEL DEFINITION VIA $TB32 * OV05 JSB F$TB DEF .2 LDA SSBCH MPY P3 LDB BPTR RETRIEVE FROM TABLE: INB ADB A LDA B,I STA SFTR SOURCE SUBCHANNEL'S FIRST CYLINDER # INB LDA B,I AND B17 STA SUNIT " " UNIT # LDA B,I ALF AND B17 STA SNSU " " # SURFACES LDA B,I ALF,ALF G AND B17 STA SNHD " " STARTING HEAD # * * 7905/7920 CHECKS FOR OVERWRITE OF ABS FILE * LDA SUNIT CPA \TUNT SAME UNIT? RSS JMP OKAY NO, SO OVERWRITE NOT POSSIBLE * CLB LDA \STRK GET SYSTEM SIZE, IN # TRACKS ADA DCB+3 ADD FIRST FILE TRACK ADA N9 LESS THOSE AVAILABLE TRACKS DIV SNSU CONVERT TO CYLINDER ADA SFTR ADD FIRST SOURCE SUBCH CYLINDER CMA,INA NEGATE ADA \DFTR ADD FIRST NEW SYSTEM CYLINDER SSA,RSS LAST SOURCE CYL MUST BE < FIRST SYSTEM CYL JMP OKAY NO PROBLEM CLB LDA DCB+3 GET FIRST SOURCE TRACK DIV SNSU CONVERT TO CYLINDER ADA SFTR ADD FIRST SOURCE SUBCH CYLINDER LDB \DFTR GET FIRST NEW SYSTEM CYLINDER CMB ADB A ADD FIRST SOURCE CYLINDER SSB,RSS FIRST SOURCE CYL MUST BE > FIRST SYSTEM CYL JMP OKAY NO PROBLEM * * POSSIBLE OVERWRITE EXISTS: LAST CYL OF NEW SYSTEM > FIRST CYL OF * ABSOLUTE FILE * LDA SNSU GET # OF SOURCE SUBCH. SURFACES CMA,INA STA TEMP1 AND STORE ITS NEGATIVE CLB,INB LDA SNHD GET STARTING HEAD ADA DSBUF AND ITS ENTRY ADDRESS IN BUFFER SETSS CPA ESBUF OVERFLOW(ERRONEOUS DEFINITION)? JMP INDS YES-GO SET DESTINATION SURFACES STB A,I SET SURFACE "OCCUPIED" INA ISZ TEMP1 INCREMENT TO NEXT SURFACE(SKIP IF DONE) JMP SETSS GO SET NEXT * INDS LDA \DNSU GET # OF DESTINATION SURFACES CMA,INA STA TEMP1 AND SET NEGATIVE LDA \DSHD GET STARTING HEAD ADA DDBUF AND ITS ENTRY ADDRESS IN BUFFER SETDS CPA EDBUF OVERFLOW(ERRONEOUS DEFINITION)? JMP OVRLP GO CHECK OVERLAPS STB A,I SET SURFACE "OCCUPIED" INA ISZ TEMP1 INCREMENT TO NEXT SURFACE (SKIP IF DONE) JMP SE TDS GO SET NEXT * OVRLP LDB N5 CHECK FOR MATCH ON ANY SURFACE STB TEMP1 LDB DDBUF STB TEMP2 SET DEST. ENTRY ADDRESS LDB DSBUF STB TEMP4 AND SOURCE ENTRY ADDRESS MATCH LDA TEMP2,I GET DEST. SURFACE SZA,RSS OCCUPIED? JMP NEXTS NO,INCREMENT TO NEXT SURFACES CPA TEMP4,I IS THE SOURCE SURFACE ALSO OCCUPIED? JMP OVWR YES,SO OVERWRITE POSSIBLE NEXTS ISZ TEMP2 INCREMENT TO NEXT SURFACE ADDRESSES ISZ TEMP4 ISZ TEMP1 DID 5 SURFACE CHECKS ALREADY? JMP MATCH NO JMP OKAY YES - AND WE MADE IT * DSBUF DEF *+1 BSS 5 SOURCE SURFACES 0-4 ESBUF DEF * DDBUF DEF *+1 BSS 5 DESTINATION SURFACES 0-4 EDBUF DEF * N5 DEC -5 SKP * * WE PASSED THE FIRST TEST!!! * * IF THE HOST AND TARGET SYSTEM'S ARE BOTH 7905/7920'S THEN WE'RE * GOING TO SEARCH $TB32 NOW BEFORE THE USER HAS AN OPPOR\TUNTY * TO INSERT A DIFFERENT SYSTEM DISC. THE HOST SUBCHANNEL DEFINITION * MUST BE DETERMINED IN ORDER TO CHECK FOR AN OVERLAY OF THE HOST * SYSTEM. * OKAY JSB EXEC GET I/O CHANNEL AND EQT TYPE OF LU 2 DEF *+6 DEF P13 DEF P2 DEF IEQT5 DEF IEQT4 DEF HSBCH * LDA IEQT4 GET CHANNEL AND B77 STA HCH STA B LDA IEQT5 GET HOST EQT TYPE ALF,ALF AND B77 STA HEQT CPA DEQT SLA SAME DISC TYPE - SEE WHICH JMP OKAYY 7900, NO PROBLEM CUZ CAN USE SUBCHANNEL * CPB \TCH SAME CHANNEL? RSS YES JMP OKAYY NO PROBLEM HERE * * GET 7905/7920 HOST SUBCHANNEL DEFINITION VIA $TB32 * JSB F$TB DEF .2 LDA HSBCH MPY P3 LDB BPTR RETRIEVE FROM TABLE: INB ADB A LDA B,I STA HFTR HOST SUBCHANNEL'S FIRST CYLINDER # INB LDA B,I AND B17 STA HUNIT W" " UNIT # LDA B,I ALF AND B17 STA HNSU " " # SURFACES LDA B,I ALF,ALF AND B17 STA HNHD " " STARTING HEAD # SKP * * * OPERATOR GIVEN OPPOR\TUNTY TO INSERT CORRECT CARTRIDGE * OKAYY LDA BATCH CMA,SSA,INA,SZA SKIP IF <= 0 JMP SAVE? NOT SO IN BATCH MODE JSB \BLIN LDA P23 LDB MES16 JSB \DSPL LDA P21 "NOW IS THE TIME TO INSERT CORRECT LDB MES17 CARTRIDGE IN TARGER SUBCHANNEL/UNIT" JSB \DSPL * CRLF JSB EXEC GET ANSWER DEF *+5 DEF P1 DEF OPLU DEF BUFR DEF P3 SZB,RSS CHECK TRANS. LOG JMP CRLF TRY AGAIN FOR ANSWER * * CHECK IF FILE STRUCTURE AT TARGET IS TO BE SAVED * SAVE? LDA \SAVE WAS IT SPECIFIED AT TURN-ON TIME? SSA,RSS JMP SAV?? YES * SAV1 LDA P16 NO, ASK THEM LDB MES18 JSB \DSPL "SAVE FILES AT TARGET? (Y OR N) * JSB YE?NO READ ANSWER JMP SAV1 INVALID REPLY JMP SAV1 INVALID REPLY CLA,RSS NO CLA,INA YES, SAVE IT STA \SAVE * SAV?? CPA P0 DO WE SAVE THE FILES ? JMP SUBI? NOPE * * CHECK THE SYSTEM AT THE TARGET * JSB VFYSY VERIFY THE SYSTEM OUT THERE! JMP SUBI? CAN'T SAVE THE FILES * LDA \STRK SIZE OF NEW SYSTEM (INCLUDING 9 TRACKS LDB \FFMP OF AVAILABLE TRACK SPACE) MUST BE CMA,INA < FIRST FMP TRACK OF TARGET ADA B SUBCHANNEL SSA,RSS JMP SAVE6 NO PROBLEM * LDA P19 WARN USER LDB MES19 JSB \DSPL "NEW SYSTEM WILL DESTROY SOME FMP FILES" JSB OK? "OK TO PROCEED?" * CCA SET TO PROCEED, BUT SAVE AS MANY FILES STA \SAVE AS POSSIBLE * * * CHECK IF TYPE 6 FILES ARE TO BE SAVED * SAVE6 LDA TYP6 HSPECIFIED AT TURN-ON TIME? SSA,RSS JMP SUBI? YES * SAV6A LDA P15 NO, ASK THEM LDB MES22 JSB \DSPL "PURGE TYPE 6 FILES? (Y OR N)" * JSB YE?NO DECIPHER ANSWER JMP SAV6A INVALID REPLY * * DETERMINE IF ANY ADDITIONAL SUBCHANNELS ARE TO BE INITIALIZED * JMP SAV6A /E AN INVALID REPLY CLA,RSS NO CLA,INA YES STA TYP6 SKP SUBI? LDA SUBI SPECIFIED AT TURN-ON TIME? SZA,RSS JMP AUTO? ONLY THAT NOT WANTED CCB ADB #SUBC GET NUMBER OF SUBCHANNELS SZB,RSS ASIDE FROM SYSTEM SUBCHANNEL JMP AUTO?-1 NONE, SO SKIP QUERY * SSA,RSS YES, OR NOT-YET-SPECIFIED? JMP SUBBR YES, SO DON'T ASK AGAIN * SUBIA LDA P18 LDB MES34 JSB \DSPL "INITIALIZE SUBCHANNELS? (Y OR N)" JSB YE?NO DECIPHER ANSWER JMP SUBIA INVALID REPLY JMP SUBIA INVALID REPLY CLA,RSS NO CLA,INA YES STA SUBI SAVE SZA,RSS IF NO, THEN MOVE ON TO JMP AUTO? AUTO BOOT QUERY * SUBBR LDA "L" CHANGE MESSAGE STA MES34+11 LDA DEQT GET DISC TYPE SLA,RSS BRANCH TO REQUEST JMP SUBI5 7905/6/20 INITIALIZATIONS * * REQUEST INITIALIZATIONS OF ADDITIONAL 7900 SUBCHANNELS * CCB,RSS NXSUB LDB SUBIA GET LAST SUBCHANNEL DISPLAYED INB CPB \DSUB JMP NXSUB+1 CPB #SUBC JMP AUTO? DONE ASKING * STB SUBIA SAVE SUBCHANNEL # LDA \TMT POSITION INTO TRACK MAP TABLE ADA P8 BUFFER TO GET # OF ADA B TRACKS DEFINED FOR THIS SUBCHANNEL LDA A,I SZA,RSS ANY? JMP NXSUB+1 NO,TRY NEXT SUBCH ADB B2060 CONVERT TO ASCII L+HFBBH STB MES34+12 AND STORE IN MESSAGE NXA LDA P18 LDB MES34 NOW ASK? JSB \DSPL "INITIALIZE SUBCHANNEL XX?" JSB YE?NO DECIPHER ANSWER JMP NXA INVALID REPLY JMP AUTO? /E SO EXIT JMP NXSUB NO INIT * ASKTS LDA P15 LDB MES35 ASK 'EM JSB \DSPL "TARGET PLATTER?" JSB TARGT GET RESPONSE JSB DFLT CR? JMP NASK NO LDA SUBIA DEFAULT IMPLIED, SO GO TO TMT JMP CSST GO COMPARE WITH SYS SUBCH TARGET * * GET TARGET PLATTER FOR 7900 SUBCHANNEL * NASK CLA,INA GET TARGET PLATTER JSB GETOC RESPONSE JMP ASKTS INVALID REPLY CSST CPA \TSUB SAME AS SYSTEM SUBCH'S? JMP ASKTS YES - NOT ALLOWED * LDB SUBIA GET THIS SUBCHANNEL # ADB \TMT AND OFFSET INTO THE TMT BUFFER ADB P16 PAST THE DEF'NS (16 WORDS) STA B,I SAVE TARGET PLATTER FOR THIS SUBCHANNEL ADB N16 BACK UP TO FIRST TRACK ENTRY LDA B,I AND MARK THE SUBCHANNEL IOR MSIGN TO ENABLE INITIALIZATION STA B,I JMP NXSUB NOW TRY THE NEXT ONE SKP * * REQUEST INITIALIZATIONS OF ADDITIONAL 7905/6/20 SUBCHANNELS * SUBI5 LDB MS36B SET MESSAGE BUFFER ADDRESS STB TEMP2 FOR STORAGE OF SUBCH #'S CLA CLEAR HEADER STA HDFLG FLAG INA SET ASCII CONVERSION LENGTH STA \CLEN TO 1 WORD - FOR \CVAS CLB STB TEMP1 FIRST SUBCHANNEL # * * DISPLAY THOSE SUBCHANNELS ON SAME UNIT AS SYSTEM SUBCHANNEL * SUB0 CPB \DSUB SAME AS SYS SUBCH? JMP SUB1 YES, SO NEEDED ASK RBL,RBL POSITION INTO TMT FOR ADB \TMT THIS SUBCHANNEL'S ENTRY INB LDA B,I AND GET WORD 1 OF ENTRY AND B17 ISOLATE THE UNIT # CPA \DUNT SAME UNIT AS FOR SYS SUBCH? RSS YES JMP SUB1 $NO - MOVE ON TO NEXT LDA TEMP1 GET SUB # CMA,INA (SIGNAL DECIMAL CONVERSION) LDB TEMP2 AND BUFFER ADDRESS JSB \CVAS CONVERT TO ASCII AND PUT IN MESSAGE LDA COMBL GET A COMMA AND PLACE ISZ TEMP2 AFTER THE # STA TEMP2,I IN THE MESSAGE ISZ TEMP2 NEXT BUFFER POSITION ISZ HDFLG INDICATE ONE 'FOUND' FOR THIS UNIT * SUB1 ISZ TEMP1 BUMP TO NEXT SUBCH # LDB TEMP1 CPB #SUBC LAST SUBCH DONE? RSS YES JMP SUB0 * LDA HDFLG ANY FOUND MATCHING \DUNT? SZA,RSS JMP OTHER NO * LDB \TUNT STORE THE UNIT # IN THE MESSAGE ADB B2060 STB MES36+7 * RAL SET # OF WORDS TO PRINT ADA P16 LDB MES36 GET BUFFER ADDRESS JSB \DSPL AND PRINT IT * LDA HDFLG SET LOOP COUNTER CMA,INA TO CLEAR BUFFER STA HDFLG LDB MS36B GET BUFFER ADDRESS LDA BLNK AND 2 ASCII BLANKS STA B,I STORE IN BUFFER ISZ HDFLG BUMP BUFFER COUNTER (0 WHEN DONE) JMP *-2 * * ASK IF SUBCHANNELS ON \TUNT ARE TO BE INITIALIZED * CCA STA TEMP2 ALLOW ALL MATCHES IN INIT? LDA \DUNT GET UNIT FOR TMT MATCHING LDB \TUNT AND PASS TARGET UNIT FOR THOSE SUBCH'S JSB INIT? * * DISPLAY SUBCHANNELS MATCHING EACH DEFINED UNIT * CLA INITIALIZE THE UNIT # STA TEMP5 OTHER LDB MS37B AND THE BUFFER POINTER STB TEMP2 CLB STB TEMP1 CLEAR THE SUBCH # CPA \DUNT SAME UNIT AS SYSTEM SUBCH? JMP NXUNT CAN'T ALLOW (ALREADY DONE) * OT1 RBL,RBL POSITION TO SUBCH'S ENTRY ADB \TMT IN THE TMT BUFFER INB MOVE TO WORD 1 LDA B,I AND GET IT AND B17 CPA TEMP5 IS IT THE UNIT WE WANT? RSS YUP JMP NXTSB NO, TRPY THE NEXT * INB POSITION TO WORD 2 LDA B,I AND GET THE # OF TRACKS SZA,RSS JMP NXTSB SKIP IF NO TRACKS ASSIGNED SSA OR IF ALREADY SPECIFIED JMP NXTSB * LDA TEMP1 GET SUBCH # CMA,INA (SIGNAL DECIMAL CONVERSION) LDB TEMP2 AND BUFFER POSITION JSB \CVAS STORE IN MESSGE LDA COMBL NOW PLACE A COMMA ISZ TEMP2 AFTER THE NAME STA TEMP2,I ISZ TEMP2 ISZ HDFLG BUMP COUNTER * NXTSB ISZ TEMP1 BUMP TO NEXT SUBCHANNEL LDB TEMP1 RETRIEVE IT CPB #SUBC AND SEE IF DONE RSS YES JMP OT1 NO, CONTINUE SCANNING * LDA HDFLG ANY FOUND? SZA,RSS JMP NXUNT NO, TRY NEXT UNIT LDB TEMP5 STORE UNIT IN MESSAGE ADB B2060 STB MES37+7 RAL DETERMINE LENGTH OF MESSAGE ADA P16 BY # OF SUBCH'S STORED IN IT LDB MES37 DISPLAY JSB \DSPL "DESTINATION UNIT XX FOR SUBCHANNELS ..." * LDA HDFLG CLEAR BUFFER CONTAINING CMA,INA SUBCH #'S STA HDFLG LDB MS37B BUFFER ADDR LDA BLNK BLANKS STA B,I CLEAR ISZ HDFLG BUMP JMP *-2 CONTINUE * * ASK FOR TARGET UNIT FOR THIS SET OF SUBCHANNELS * ASKTU LDA P14 ASK FOR TARGET UNIT LDB MES38 JSB \DSPL "TARGET UNIT? (XX OR " "CR, OR /E) JSB YE?NO GET RESPONSE JMP TDFLT CHECK DEFAULT JMP NXUNT /E JMP ASKTU NO, TRY A NUMBER JMP ASKTU YES, NEED A NUMBER TDFLT JSB DFLT CR? JMP GETU NO LDA TEMP5 GET DEFAULTED UNIT JMP CSSTU AND GO CHECK AGAINST TARGET SYS UNIT * GETU CLA,INA RETRIEVE TARGET UNIT # JSB GETOC FROM RESPONSE JMP ASKTU INVALID REPLY - ASK AGAIN CSSTU CPA \TUNT SAME AS SYS SUBCH UNIT? JMP ASYKTU YES - CAN'T ALLOW * * REQUEST INITIALIZATION OF EACH SUBCHANNEL OF CURRENT SET * LDB A GET TARGET UNIT # LDA \DUNT SET FOR DISALLOWING STA TEMP2 \DUNIT REPONSES LDA TEMP5 GET DEST UNIT # JSB INIT? AND ASK FOR INITIALIZATIONS * NXUNT ISZ TEMP5 BUMP UNIT COUNTER LDA TEMP5 RETRIEVE IT CPA P8 AND CHECK IF DONE JMP AUTO? YES JMP OTHER NO - START SUBCH SCAN AGAIN SKP * * SCAN TRACK MAP TABLE (IN BUFFER) FOR SUBCHANNELS THAT MAY BE * INITIALIZED, BASED UPON THE 'MATCH' UNIT IN THE A-REG. THE TARGET * UNIT FOR THESE SUBCHANNELS (IF INITIALIZED) IS IN THE B-REG. * INIT? NOP STA TEMP3 SAVE TMT MATCH UNIT STB TEMP4 AND TARGET UNIT CLB INITIALIZE STB TEMP1 NEXT SUBCHANNEL # * INIT1 CPB \DSUB SYSTEM SUBCHANNEL? JMP NXS YES, SO SKIP RBL,RBL CONVERT TO TMT ENTRY # ADB \TMT AND OFFSET INTO BUFFER INB LDA B INA IF WORD2 IS NEGATIVE LDA A,I THEN THIS SUBCH ALREADY SSA HAS BEEN SPECIFIED JMP NXS SO SKIP THIS ENTRY SZA,RSS JMP NXS ALSO SKIP IF NO TRACKS ASSIGNED TO IT * LDA B,I ISOLATE THE AND B17 UNIT CPA TEMP2 THIS UNIT MATCH DISALLOWED? JMP NXS YES, TRY NEXT SUBCH * CPA TEMP3 ONE WE'RE LOOKING FOR? RSS YES JMP NXS TRY NEXT ONE * STB TEMP6 SAVE BUFFER POSITION LDA TEMP1 GET SUBCH # CMA,INA LDB MS34A AND CONVERT TO ASCII JSB \CVAS AND STORE IN MESSAGE NXI LDA P18 NOW ASK 'EM LDB MES34 JSB \DSPL "INITIALIZE SUBCHANNEL XX?" JSB YE?NO DECIPHER ANSWER JMP NXI INVALID REPLY JMP INIT?,I /E SO EXIT JMP NXS NO REPLY * LDB TEMP6 4 GET BUFFER POSITION LDA B,I AND WORD 1 OF SUBCH'S ENTRY AND B1777 MASK OFF UNIT IOR TEMP4 AND ADD IN TARGET UNIT STA B,I RE-STORE INB NOW SET THE SIGN BIT LDA B,I FOR WORD 2 TO IOR MSIGN INDICATE A SPECIFIED ENTRY STA B,I * NXS ISZ TEMP1 BUMP SUBCHANNEL # LDB TEMP1 RETRIEVE IT AND CPB #SUBC AND SEE IF DONE JMP INIT?,I YES JMP INIT1 CONTINUE SCAN * SKP * * THE FOLLOWING CONDITIONS FOR AUTO BOOT-UP ARE CHECKED: * DESTINATION CHANNEL = TARGET CHANNEL * DESTINATION SUBCHANNEL/UNIT = TARGET SUBCHANNEL/UNIT * DESTINATION TBG CHANNEL = HOST TBG CHANNEL * DESTINATION TTY CHANNEL = HOST TTY CHANNEL * DESTINATION PI CHANNEL = HOST PI CHANNEL ( IF BOTH EXIST) * STB SUBI CLEAR INIT WORD IF NO SUBCH'S AUTO? LDA AUTO SPECIFIED AT TURN-ON TIME? SZA,RSS JMP CHPNT YES, ONLY THAT THEY DON'T WANT IT * LDA \DCH COMPARE DISC CHANNELS CPA \TCH RSS JMP CANT NO MATCH LDB DEQT SLB CHECK SUBCHANNELS OR UNITS JMP AUT0 LDA \DUNT CPA \TUNT JMP AUT1 JMP CANT NO MATCH ON 7905/7920 UNIT * AUT0 LDA \DSUB CPA \TSUB RSS JMP CANT NO MATCH ON 7900 SUBCHANNEL # * AUT1 LDA TBG GET HOST TBG CHANNEL CPA DTBG RSS JMP CANT TBG'S DON'T MATCH LDA HTTY CPA DTTY RSS JMP CANT TTY CHANNELS DON'T MATCH LDA PI GET HOST PI CHANNEL CPA P0 IF EITHER THE HOST OR JMP AUT2 LDB DPI CPB P0 DESTINATION PI IS 0, JMP AUT2 THEN DON'T CHECK CPA B RSS JMP CANT PI CHANNELS DON'T MATCH * * * AUTO BOOT-UP IS POSSIBLE * AUT2 LDA AUTO HAS IT BEEN SPECIFIED YET?  SSA,RSS -1=NOT SPECIFIED, 1=YES JMP CHPNT YES, AND WANT IT AUT3 LDA P12 LDB MES24 JSB \DSPL "AUTO BOOT-UP? (Y OR N)" JSB YE?NO GET ANSWER JMP AUT3 INVALID REPLY JMP AUT3 INVALID REPLY CLA,RSS NO CLA,INA YES STA AUTO JMP CHPNT * * * WON'T BE BOOTING UP NEW SYSTEM * CANT LDA P25 LDB MES25 JSB \DSPL "PRESENT CONFIGURATION DOESN'T PERMIT AUTO BOOT-UP" CLA STA AUTO * * * DETERMINE IF WE'RE OVERLAYING PART OF THE HOST SYSTEM. * ALSO, DETERMINE IF WE CAN RETURN TO HOST SYSTEM AFTER * TRANSFER, OTHERWISE HALT * * CHPNT LDA HEQT GET HOST EQT TYPE CPA DEQT SAME AS NEW? RSS JMP GO LDA HCH GET HOST CHANNEL CPA \TCH REPLACING CURRENT? RSS MAYBE JMP GO LDB DEQT SLB,RSS JMP CHPT5 CHECK 7905/7920 SUBCHANNEL DEFN LDA HSBCH GET HOST SUBCHANNEL CPA \TSUB SAME 7900 SUBCHANNELS? RSS JMP GO NO,SO NO PROBLEM * * WILL BE REPLACING CURRENT SYSTEM * REPL CLA,INA STA PONRT SET "POINT OF NO RETURN" FLAG FOR THE LDA AUTO SZA JMP GO LDA P22 ERROR MESSAGE PROCESSING LDB MES26 JSB \DSPL "SYSTEM WILL HALT AFTER TRANSFER COMPLETION" JMP GO * * GOT 7905/7920 HOST SUBCHANNEL DEFINITION (VIA $TB32) AT OKAY * * 7905/7920 CHECKS FOR OVERWRITE OF HOST SYSTEM, USING HUNIT ONLY * CHPT5 LDA HUNIT CPA \TUNT SAME UNIT? JMP REPL YES - SO HALT IF NO AUTO-BOOT * * ALLOW OPERATOR ONE MORE OPPOR\TUNTY TO GET OUT * GO LDA BATCH NO MESSAGE IN BATCH MODE CMA,SSA,INA,SZA SKIP IF <= 0 JMP PURGF LDA P17 LDB MES32 JSB \DSPL "READY TO TRANSFER. OK TO PROCEED?" JSB YE?NO JMP GO INVALID REPLY JMP GO INVALID REPLY JMP \XOUT BAIL OUT JMP PURGF YES, GET WITH IT SKP * * PURGE ALL FILES FROM THE FILE DIRECTORY (AND THEIR EXTENTS) * THAT WERE OVERLAID BY THE NEW SYSTEM - LISTING THEM AT THE * SAME TIME. * PURGF JSB EXEC CORE LOCK - TO DEF *+3 PREVENT SWTCH FROM DEF P22 FROM BEING SWAPPED OUT DEF P1 * LDB \SAVE WERE THE FMP FILES TO BE \SAVED? SZB,RSS JMP XFER NO * LDA D.LT CONVERT LAST FMP LOGICAL ADDRESS STA \TRAK CLB STB \SECT LDA D.# STA TEMP4 SAVE FOR LOOP CHECKS * STB \INIT FOR DISKD LDA N6144 STA \LNTH LDA \BUFA STA BPTR * LDA \SAVE SSA,RSS WERE ANY FMP FILES OVERLAID? JMP PUR6 NO,CHECK ON TYPE 6 FILES * LDA LWAM SET THE ADDRES OF THE ADA N3 FIRST FILE NAME ENTRY STA PENT * CLA,INA STA REWRT SET RE-WRITE FOR FD LDB \BUFA CCE SET FOR READ JMP BFULL * SPC 3 ****************************************************************************** * * THE FOLLOWING BSS ALLOWS FOR OVERLAY OF THE * PREVIOUS CODE, AND ADDS ADDITIONAL BSS'S FOR * AN AREA TOTALING 6144(DECIMAL) WORDS. * BSS 6144+BUFR-* * ***************************************************************************** SPC 3 BFULL JSB DISKD FIRST FULL TRACK READ JSB \BLIN LDA P10 HEADING: LDB MES27 JSB \DSPL "OVERLAID FMP FILES:" CCA STA CURCH SET FOR PURGT LDA BPTR POSITION TO CARTRIDGE SPECIFICATION ADA P900 ENTRY WORD 4 LDB \STRK AND STORE THE NEW FIRST STB A,I FMP TRACK * LDB BPTR POSITION TO FIRST FILE ADB B200 DIRECTORY ENTRY ON THE LDA N376 TRACK LOOP0 STA TCNT SET # ENTRIES TO SEARCH LOOP1 STB BPTR  BUFFER POINTER LDA BPTR,I GET WORD 0 CPA N1 JMP INCRB ALREADY PURGED SZA,RSS JMP INCRB NOT AN ENTRY ADB P4 POSITION TO TRACK ADDRESS LDA B,I LDB \STRK COMPARE WITH LAST SYSTEM CMB,INB TRACK ADA B SSA WAS THE FILE IN THE NEW SYSTEM AREA? JSB PURGT PURGES,LISTS ENTRY * INCRB JSB UPDAT SET TO SEARCH NEXT ENTRY JMP LOOP1 CONTINUE IN SAME TRACK JMP PUR6 PURGE TYPE 6 FILES JMP LOOP0 CONTINUE IN NEW TRACK * P900 DEC 900 SKP * PURGES ANY TYPE 6 FILES OF THE TARGET FMP FILE SYSTEM * PUR6 LDA TYP6 ARE WE TO PURGE ANY? SZA,RSS JMP XFER NO * CLA CLEAR THE STA REWRT REWRITE & FILES FLAGS STA CURCH FOR PURGT STA \SECT LDA D.# STA TEMP4 SET THE # DIRECTORY TRACKS TO SEARCH LDA D.LT FIRST DIRECTORY TRACK STA \TRAK LDB \BUFA STB BPTR CCE JSB DISKD READ IT * LDB BPTR POSITION TO FIRST ADB B200 FILE DIRECTORY ENTRY LDA N376 LOOP2 STA TCNT # ENTRIES TO SEARCH LOOP3 STB BPTR BUFFER POINTER LDA BPTR,I GET WORD 0 CPA N1 JMP INCRE ALREADY PURGED SZA,RSS JMP INCRE NOT AN ENTRY ADB P3 POSITION TO FILE TYPE LDA B,I CPA P6 A TYPE 6? RSS JMP INCRE NOPE LDA HDRSW SZA JMP LOOP4 ISZ HDRSW JSB \BLIN LDA P10 PRINT HEADING: LDB MES28 JSB \DSPL "TYPE 6 FILES PURGED:" * LOOP4 JSB PURGT PURGE AND LIST ENTRY INCRE JSB UPDAT POSITION TO NEXT DIRECTORY ENTRY JMP LOOP3 CONTINUE IN SAME TRACK JMP XFER DONE WITH DIRECTORY JMP LOOP2 CONTINUE IN NEW TRACK SPC 2 B50 OCT 50 B62 OCT 62 B200 OCT 200 N376 DEC -376 N6144 DEC -6144 FiHDRSW NOP HEADER SWITCH SKP * BEGIN THE TRANSFER, READING FROM THE ABSOLUTE FILE VIA READF * CALLS, AND WRITING OUT THE NEW SYSTEM VIA DISKD (TURNS OFF * THE INTERRUPT SYSTEM) * XFER CLA STA \TRAK SET DESTINATION TRACK 0 SECTOR 0 STA \SECT * * READ FROM THE NEW SYSTEM FILE * LDA \BUFA STA BPTR RESET TO BEG. OF BUFFER LDA DEQT LDB \INP0 SLA,RSS LDB \INP5 SET TO WRITE PROTECT AND INITIALIZE STB \INIT (FOR DISKD) * CLB LDA SIZE # 128-WORD SECTORS DIV P48 SIZE OF SYSTEM CMA,INA NOW MEANS THE SYSTEM SIZE IN TRACKS STA TEMP1 NEGATIVE STB TEMP2 REMAINING # OF SECTORS LDA P6144 STA \LNTH * JSB READF READ A TRACK STARTING WITH RECORD #2 DEF *+7 DEF DCB DEF ERR DEF BUFR DEF \LNTH DEF LLEN DEF P3 SSA READ ERROR? JMP RDERR YES * LDA PONRT SET TO INDICATE POSSIBLE OVERLAY CMA,INA RESULTING IN 0 OR -1 STA PONRT * * LDA \BUFA COMPUTE ADDRESS OF SYSTEM ADA P1024 COMMUNICATION AREA IN NEW ADA B50 BASE PAGE. LDB A POSITION TO LOCATION 1650. ADB P6 GET TAT ADDRESS AT 1656 WHILE LDB B,I WE'RE THERE. STB TAT * LDB \SAVE ARE WE SAVING THE FILE STRUCTURE SZB,RSS AT THE TARGET? JMP WDISK NO, WRITE OUT THE BUFFER * * * SINCE THE TARGET FILE STRUCTURE IS TO BE SAVED, RECOMPUTE * THE FMP SETUP WORD FOR THE NEW SYSTEM * CLB CLEAR THE SUM WORD STB STUPW LDB N8 ADD LOC'S 1650 THRU 1657 JSB ADDIT ADA B62 POSITION TO LOCATION 1742 LDB N6 JSB ADDIT ADD LOC'S 1742 THRU 1747 ADA P5 POSITION TO LOCATION 1755 LDB N8 JSB ADDIT ADD LOC'S 1755 THRU 1764 JMP WDISK WRITE TRACK TO DISK * * READ FROM ABSOLUTE DISK FILE * RDISK LDA P6144 ISZ TEMP1 LAST FULL TRACK'S WORTH? JMP READ NO, CONTINUE LDA TEMP2 GET # OF LEFTOVER SECTORS SZA,RSS JMP DDONE NONE! MPY B200 BY 128 ISZ EOFLG SET EOF FLAG * * CLEAR REMAINDER OF TRACK * STA \LNTH SAVE # WORDS TO BE READ CMA,INA DETERMINE # REMAINING ON TRACK ADA P6144 LDB \BUFA GET STARTING ADDRESS ADB \LNTH WITHIN BUFFER JSB CLRBF AND CLEAR THE AREA TO FOLLOW RSS THE LAST RECORD READ IN * * READ ANOTHER TRACK FROM ABS FILE * READ STA \LNTH # WORDS TO READ JSB READF DEF *+5 DEF DCB DEF ERR DEF BUFR DEF \LNTH SSA READ ERROR? JMP RDERR YES * * WRITE TO THE TARGET * WDISK LDA \TRAK DISPLAY DESTINATION OTA 1 * LDA N6144 STA \LNTH # WORDS TO READ/WRITE LDB \BUFA BUFFER(CORE) ADDRES CLE SET TO WRITE JSB DISKD AND DO IT. * LDA EOFLG DONE WITH TRANSFER? SZA NO JMP DDONE ISZ \TRAK INCREMENT DESTINATION JMP RDISK ADDRESS BY ONE TRACK * * * * TRANSFER COMPLETE. INITIALIZE THE NECESSARY DISK TRACKS * DDONE LDB \INT0 GET WRITE INITIALIZE BITS LDA DEQT SLA,RSS LDB \INT5 STB \INIT SET FOR DISKD * LDA \SAVE SZA,RSS JMP WHOLE INITIALIZE WHOLE REST OF SUBCHANNEL SSA JMP INIT2-1 INITIALIZE ONLY THE 9 AVAILABLE TRACKS * * INITIALIZE ONLY UP TO TARGET(EXISTING) FIRST FMP TRACK * LDA \FFMP COMPUTE NUMBER OF TRACKS UP TO FMGR AREA JMP LESS * * INITIALIZE REST OF SYSTEM SUBCHANNEL * WHOLE LDA \DNTR COMPUTE # TRACKS LEFT ON SUBCHANNEL LESS LDB \STRK ADB N9 CMB,INB ADA B CM~B@ GENERATION-DEFINED SYSTEM * \DCH NOP DESTINATION SYSTEM DISC CHANNEL \DSUB NOP " " " SUBCHANNEL DEQT NOP " " " EQT TYPE \DUNT NOP " " " UNIT \DFTR NOP " " " FIRST TRACK/CYLINDER \DNTR NOP " " " NUMBER TRACKS \DSHD NOP " " " STARTING HEAD (7905/7920) \DNSU NOP " " " NUMBER SURFACES " \DNSP NOP " " " " SPARES " DTTY NOP " TTY CHANNEL DPI NOP " PI CHANNEL DTBG NOP " TBG CHANNEL SPC 3 * TARGET => TEMPORARY STORAGE FOR NEW SYSTEM * \TCH DEC -1 TARGET DISC CHANNEL \TSUB DEC -1 " " SUBCHANNEL \TUNT DEC -1 " " UNIT (7905/7920) SKP * MES15 DEF *+1 ASC 20,TRANSFER CANCELLED AND SWTCH TERMINATED. MES27 DEF *+1 ASC 10,OVERLAID FMP FILES: MES28 DEF *+1 ASC 10,TYPE 6 FILES PURGED: MES29 DEF *+1 MS29 ASC 6, MES31 DEF *+1 ASC 5,FILE ERR - MS31A BSS 0 MES33 DEF *+1 ASC 7,SWTCH FINISHED SPC 3 \BOOT NOP "WE'RE BOOTING" FLAG FOR DISKD (0=NOT NOW) AUTO DEC -1 AUTO BOOT-UP FLAG (0=NO, 1=YES) \SAVE DEC -1 SAVE TARGET FILES(0=NO,1=YES,-1=OVERLAYS SOME) TYP6 DEC -1 PURGE TYPE 6 FILES FLAG (0=NO, 1=YES) SUBI DEC -1 INITIALIZE SUBCHANNELS FLAG," " BATCH DEC -6 BATCH MODE ( NO<=0, YES>=1 ) #EQTS NOP NUMBER OF DESTINATION EQT'S CURCH DEC 0 CURRENT CHANNEL COUNTER PONRT NOP "POINT-OF-NO-RETURN" FLAG (0=OK,1=WILL,-1=DONE) D.LT DEC -1 LAST DIRECTORY TRACK FROM TARGET'S CD D.# NOP # DIRECTORY TRACKS FROM TARGET'S CD TAT NOP DISK ADDRESS OF TAT IN NEW SYSTEM \FFMP NOP FIRST LOGICAL FMP TRACK AT TARGET #SUBC NOP NUMBER OF DEFINED DISK SUBCHANNELS HDFLG NOP HEADER FLAG \LU2 DEC -1 LU 2 OR 3 FLAG * \LNTH NOP LENGTH OF READ/WRITE \INIT NOP DISKD COMMAND MASK \TRAK NOP DESTINATION DISK ADDRESS \SECT NOP \BUFA DEF BUFR BPTR NOP BUFR POINTER EOFLG NOP REWRT NOP RE-WRITE TRACK FLAG SIZE NOP # BLOCKS IN FILE \STRK NOP # TRACKS IN FILE (PLUS 8) * TEMP1 NOP TEMPORARY TEMP2 NOP " TEMP3 NOP " TEMP4 NOP " TEMP5 NOP " TEMP6 NOP " * PI EQU 1737B TBG EQU 1674B SYSTY EQU 1675B * IEQT4 NOP IEQT5 NOP SKP P0 DEC 0 P2 DEC 2 P3 DEC 3 P4 DEC 4 P5 DEC 5 P6 DEC 6 P8 DEC 8 P9 DEC 9 P13 DEC 13 P16 DEC 16 P22 DEC 22 P20 DEC 20 P32 DEC 32 P48 DEC 48 P128 DEC 128 P1024 DEC 1024 P6144 DEC 6144 * N1 DEC -1 N2 DEC -2 N3 DEC -3 N6 DEC -6 N8 DEC -8 N16 DEC -16 N126 DEC -126 N128 DEC -128 * B17 OCT 17 B60 OCT 60 B377 OCT 377 B1776 OCT 177600 B1777 OCT 177760 B7777 OCT 77777 * OPLU DEC 1 DEFAULT OPER CONSOLE LU (MAY * BE OVERWRITTEN) CNHFBTR NOP DBLNK DEF BLNK BLNK OCT 20040 * * DCB BSS 144 ERR NOP LLEN NOP * \TMT DEF *+1 BSS 128 * END EQU * * * END SWTCH \HASMB,R,L,C HED SWTCH - SWSG1, 7900 DISK DRIVER SEGMENT NAM SWSG1,5,10 92067-16010 REV.1805 780206 SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 2 **************************************** * * NAME: SWSG1 * SOURCE: 92067-18010 * BINARY: 92067-16010 * WRITTEN BY: KFH * **************************************** * * * ENTRY POINTS * ENT \DSK0,\STD0 ENT \INP0,\INT0 ENT \FLGT * * * EXTERNAL ENTRY POINTS * EXT \SWTM EXT $LIBR,$LIBX EXT \TCH,\TSUB,\DFTR,\DNTR EXT \INIT,\LNTH EXT \CVAS,\CLEN,\DSPL,\BLIN EXT \DSUB,\XOUT,\BUFA EXT \BOOT,\TMT,\LU2 EXT \TRAK,\SECT * * A EQU 0 B EQU 1 SUP SKP BEG0 LDB \DSUB SEGMENT'S ENTRY POINT ADB \TMT OFFSET INTO TRACK MAP TABLE BUFFER LDA B,I GET FIRST WORD OF SUCHANNEL'S ENTRY STA \DFTR SET STARTING TRACK ADB P8 POSITION TO SECOND WORD OF SUBCH'S ENTRY LDA B,I AND GET ITS STA \DNTR # OF TRACKS JMP \SWTM RETURN SPC 3 TEMP BSS 3 TEMP FOR INTIALIZATION * M100 OCT 100 B177 OCT 177 M440 OCT 440 M0100 OCT 10000 M1776 OCT 177600 M7700 OCT 177700 * N10 DEC -10 * P10 DEC 10 P2 DEC 2 P4 DEC 4 P8 DEC 8 P9 DEC 9 P12 DEC 12 P14 DEC 14 P15 DEC 15 P16 DEC 16 P17 DEC 17 P18 DEC 18 P25 DEC 25 * \INP0 OCT 101000 INITIALIZE, WRITE PROTECT COMMAND BITS \INT0 OCT 100000 " " " SKP * *  INSERT CHNL NO. IN INSTRUCTION * * THE STDSK SUBROUTINE SETS THE CURRENT DISK CHANNEL * NOS. IN THE I/O INSTRUCTIONS. * * \STD0 NOP LDA \TCH SAVE TARGET DISK CHANNEL STA TEMP1 LDA #DATA GET # WORDS TO BE CONFIGURED LDB HPDSK GET ADDRESS OF INSTR ADDR LIST STDS1 STA TEMP2 SAVE NO. OF INSTRUCTIONS STDS2 LDA B,I GET INSTRUCTION AND M7700 ISOLATE INSTRUCTION CODE IOR TEMP1 INSERT CHANNEL NO. STA B,I SET INSTRUCTION IN CODE INB INCR INSTRUCTION ADDRESS ISZ TEMP2 SKIP - DONE WITH SET JMP STDS2 CONFIGURE NEXT INSTRUCTION * LDA TEMP1 DONE WITH COMMAND CHANNEL? CPA \TCH RSS JMP STDS3 YES LDA #CMND GET # COMMAND INSTRUCTIONS ISZ TEMP1 STEP TO COMMAND CHANNEL JMP STDS1 GO CONFIGURE * STDS3 LDA N10 CLEAR THE BAD TRACK STA TEMP TABLE LDB \FLGT GET ADDRESS OF TABLE CCA STA TEMP+2 SET TO NO BAD TRACKS STDS4 STA B,I SET TO -1 FOR NO ENTRY INB STEP TABLE ADDRESS ISZ TEMP DONE? JMP STDS4 NO, DO NEXT ONE STA B,I JMP \STD0,I RETURN * * #DATA ABS I/OTB-I/OTC # DATA INSTRUCTIONS #CMND ABS I/OTC-I/OTD # COMMAND INSTRUCTIONS HPDSK DEF I/OTB,I ADDR OF I/O INSTRUCTION LIST TEMP1 NOP TEMP2 NOP * ADDRESS OF BAD TRACK TABLE \FLGT DEF \STD0+1 WHICH OVERLAYS 10 WORDS OF \STD0 SKP * * THE DRIVER ENTERS HERE AFTER 10 TRIES HAVE FAILED TO INITILIZE A * TRACK. * INIER JSB INTON TURN INTERRUPTS BACK ON LDA STATB GET STATUS AND AND M440 MASK SEEK CHECK CHECK AND END OF CYLINDER SZA,RSS BITS - IF NOT SET CONTINUE JMP INIE0 WITH BAD TRACK ROUTINE * LDB ER43A STORE SUBCHANNEL # IN MESSAGE JSB ESUB LDA P15 ELSE SEND BAD SPECIFICATION LDB ERR43 JSB \DSPL "INVALID DISC SPECIFICATIONS" JMP \XOUT TERMINATE SWTCH * INIE0 LDA \INIT SAVE THE \INIT STA TEMP2 FLAG WORD LDA DFCYF SET COMMAND STA \INIT TO FLAG TRACK DEFECTIVE CLE AND LDB \BUFA CALL JMP DISK0+1 DRIVER * INIEH ISZ TEMP+2 BAD TRACK HEADER PRINTED YET JMP INIES YES - SKIP * JSB \BLIN LDA P10 LDB \TSUB GET SUBCHANNEL ADB BLK0 ADD ASC BLANK 0 STB EMES1-1 SET IN MESSAGE LDB EMES1 SEND THE JSB \DSPL MESSAGE * INIES LDA \TRAK GET TRACK ADDRESS CMA,INA SET NEGATIVE FOR DECIMAL CONVERSION LDB P2 STB \CLEN FOR \CVAS LDB ALBUF SET BUFFER ADDRESS JSB \CVAS CONVERT THE NUMBER LDA P4 AND LDB ALBUF SEND JSB \DSPL THE TRACK NUMBER * * TRACK IS NOW FLAGGED AND REPORTED IT IS NOW ENTERED IN THE * BAD TRACK TABLE. * LDA \LU2 SHOULD IT BE ENTERED IN TABLE? SZA,RSS JMP DISK0,I NO, RETURN NOW LDA TEMP2 STA \INIT RESTORE IT LDA \TRAK GET THE TRACK ALF,ALF RAR ADA \DSUB STA TEMP1 AND SAVE LDB \FLGT GET THE BAD TRACK TABLE ADDRESS LDA N10 ALLOW 10 ENTRIES STA TEMP+1 SET COUNTER INIE1 LDA B,I GET ENTRY SSA NEGATIVE? JMP INIET YES - USE THIS ONE * INB NO ALREADY USED ISZ TEMP+1 STEP COUNT 10 YET? JMP INIE1 NO - TRY NEXT ONE * LDB ER41A STORE SUBCHANNEL # IN MESSAGE JSB ESUB LDA P17 LDB ERR41 JSB \DSPL "LIMIT OF 10 BAD TRACKS EXDEEDED" JMP \XOUT AND TERMINATE SWTCH * INIET LDA TEMP1 GET SUBCHANNEL/TRACK STA B,I SET IN TABLE JMP DISK0,I GO FINISH INITILIZATION. * DFCYF OCT 100400 ALBUF DEF *+1 BSS 2 EMES2 ASC 10,BAD TRACKS PLATTER EMES1 DEF EMES2 BLK0 ASC 1, 0 * ERR41 DEF *+1 ASC 17,LIMIT OF 10 BAD TRACKS EXCEEDED ER41A DEF ERR41+17 ERR43 DEF *+1 ASC 15,INVALID DISC SPECIFICATIONS ER43A DEF ERR43+15 HED DISC DRIVE I/O INSTRUCTION ADDRESSES I/OTB DEF DSK51 DATA CHANNEL DEF DSK52 DEF DSK53 DEF DSK54 DEF DSK55 DEF DSK56 DEF DSK57 DEF DSK58 DEF DSK59 DEF DSK60 DEF DSK61 DEF DSKDR I/OTC DEF DSK01 COMMAND CHANNEL DEF DSK02 DEF DSK03 DEF DSK04 DEF DSK05 DEF DSK07 DEF DSK08 DEF DSK09 DEF DSK10 DEF DSK11 DEF DSK16 DEF DSK71 I/OTD EQU * HED 7900 I/O DISC DRIVER * THE DISKD SUBROUTINE IS THE MAIN DISC INPUT/OUTPUT DRIVER. * IT SETS UP THE COMPLETE TRANSFER AND READS OR WRITES * \LNTH WORDS ON THE DISC. IT WAITS UNTIL THE TRANSFER * IS COMPLETE. STATUS IS DONE AFTER EACH TRANSFER FOR WRITE * PROTECT ERRORS THE OPERATOR IS ASKED TO TURN ON THE SWITCH. * FOR DEFECTIVE CYLINDER ERRORS THE IRRECOVERABLE ERROR ERR40 IS * TAKEN. FOR NOT READY ERRORS THE OPERATOR IS NOTIFIED. * FOR OTHER ERRORS TEN TRIES ARE MADE. IF THE ERROR STILL EXIST * AND: * * A - IF THE INIT FLAG IS SET GO TO INIER * * B - ELSE NOTIFY OPERATOR AND TERMINATE * * CALLING SEQUENCE * * \LNTH = NEGATIVE # WORDS TO TRANSMIT * B = CORE ADDRESS * E = 1 FOR READ * E = 0 FOR WRITE * * RETURN - ALWAYS NORMAL--REGS. MEANINGLESS SPC 3 \DSK0 EQU * DISK0 NOP RBL,ERB SET THE READ/WRITE BIT STB MADDR AND SAVE THE ADDRESS LDA \TRAK ADA \DFTR ADD FIRST TRACK TO RELATIVE TRACK STA T#AC0 SAVE ABSOLUTE TRACK LDB \TSUB GET SUBCHANNEL NUMBER CLE,ERB B IS UNIT NOT E IS HIGH HEAD BIT STB UN#IT SAVE UNIT NUMBER  ADB M0100 SET COMMANDS LDA \INIT ADD INIT FLAG TO WRITE ADA B COMMAND STA W#CMD AND SET WRITE COMMAND ADB M0100 READ STB R#DCM SET READ ADB M0100 STB S#EKC SEEK CLA,SEZ,CLE,RSS IF E = 0 INA SET HEAD 2 LDB \SECT GET SECTOR BRS B IS ACTUAL SECTOR STB H#AD SAVE ADB NSEC SUBTRACT NUMBER ON A SIDE SSB,RSS IF POSITIVE STB H#AD RESET SECTOR ELA MOVE IN LOW HEAD BIT ALF,ALF ROTATE ADA H#AD AND ADD THE SECTOR STA H#AD SAVE HEAD/SECTOR ADDRESS JSB $LIBR KILL THE INTERRUPT SYSTEM NOP CLF 0 * RTRY LDA N10 RESET 10 TRY COUNTER STA EDCNT DSK16 STF 1 SET FLAG FOR STATUS JSB STATC GO DO STATUS AND M100 CHECK READY BIT SZA IF SET JMP NRERR GO TELL THE MAN * LDA T#AC0 SET TRACK TO A JSB SEEK AND SEEK THE RECORD LDB MADDR SET THE CORE ADDRESS TO B LDA R#DCM SET FOR READ SSB,RSS WRITE? LDA W#CMD YES - RESET TO WRITE DSK01 CLC 1 SET UP COMMAND DSK02 OTA 1 SEND COMMAND DSK51 STF 0 SET FOR WRITE CLE,SSB READ? DSK52 STC 0,C YES / RESET FOR READ LDA DSKDR GET DMA WORD OTA 6 ASSIGN DMA CLC 2 SET FOR ADDRESS OTB 2 SEND ADDRESS LDA \LNTH SET LENGTH STC 2 SET FOR LENGTH OTA 2 SEND IT STC 6,C START DMA DSK03 STC 1,C START DRIVE CLC 6 JSB STATC GET STATUS STA STATB SAVE SLA JMP ERRCH CHECK ERROR STATUS * LDA \BOOT ARE WE BOOTING UP? SZA,RSS JMP DISKR NO,CONTINUE CLA LDA \TCH GET TARGET CHANNEL = DEST. CHANNEL ALF,RAL AND STORE IN BITS RAL 11-6 OF THE OTA 1 SWITCH REGISTER LDA M2055,I GET STARTING ADDRESS LDB M1742 NOW DETERMINE IF WE'RE IN CPB P2 AN RTE-II OR RTE-III/IV RSS MUST DISABLE MAPPING FOR RTE-III JMP A,I GO TO RTE! CLB MUST CLEAR THE MPFT LFB DJP A,I WELL SAID! * M2055 OCT 2055 M2011 OCT 2011 M1742 EQU 1742B * DISKR JSB INTON OK, SO TURN ON INTERRUPTS LDA \INIT CHECK IF MAY HAVE BEEN ALF,ALF FLAGGING A DEFECTIVE SLA TRACK, SO RETURN JMP INIEH TO REPORT IT JMP DISK0,I ELSE RETURN * ERRCH RAL,CLE,ERA CLEAR SIGN BIT CPA P9 WRITE PROTECT ERROR? (BITS 3,0) RSS CPA M2011 DATA PROTECT SWITCH ON? (BITS 10,3,0) JMP WRPTM YES - GO TELL 'EM * CPA P25 DEFECTIVE CYLINDER? (BITS 4,3,0) JMP DISBM * AND M100 ISOLATE READY BIT (BIT 2) SZA READY? JMP NRERR NO - GO TELL USER * CLA YES, TRY TO RECOVER JSB SEEK SEEK TO CYLINDER 0 ISZ EDCNT INCREMENT # TRIES JMP DSK16 NOT TEN YET GO TRY AGAIN * LDA \INIT 10 TIMES IN INIT PHASE? CPA \INT0 JMP INIER YES GO TO INIT ERROR ROUTINE * * JSB INTON TURN THE INTERRUPTS BACK ON LDA \TRAK INSERT THE TRACK IN THE MESSAGE CMA,INA NEGATE FOR \CVAS LDB P2 STB \CLEN LDB ER22A JSB \CVAS LDB ER22B STORE SUBCHANNEL # IN MESSAGE JSB ESUB LDA P18 LDB ERR22 JSB \DSPL "PARITY OR DATA ERROR TRACK XXX" LDA \INIT DETERMINE ACTION TO TAKE ALF,ALF RAR SLA IF WRITE PROTECT BIT SET,THEN JMP \XOUT TRACKS WERE BEING WRITTEN, SO EXIT LDA \INIT IF INITIALIZE BIT SET, THEN SSA JMP INIER+1 GO TO INIT ERROR ROUTINE JMP \XOUT ELSE TERMINATE SWTCH * * DISBM JSB INTON ON INTERRUPTS! LDA \INIT IF DEFECTIVE CYLINDER ALF,ALF IS BEING FLAGGED BY SLA INIER JMP INIEH IGNORE ERROR, GO REPORT TRACK * RAL IF WRITE PROTECT SET, THEN SLA THE SYSTEM IS BEING WRITTEN JMP IRERR AND THAT'S IRRECOVERABLE! * LDA \INIT IF INITIALIZE BIT SET, THEN SSA JMP INIER+1 GO FLAG IT DEFECTIVE * IRERR LDA \TRAK INSERT TRACK # IN MESSAGE CMA,INA LDB P2 STB \CLEN LDB ER40A JSB \CVAS LDB ER40B STORE SUBCHANNEL # IN MESSAGE JSB ESUB LDA P18 LDB ERR40 JSB \DSPL "DEFECTIVE CYLINDER - TRACK XXX" JMP \XOUT AND EXIT * * NRERR JSB INTON INTERRUPTS ON JSB \BLIN DISC NOT READY LDB MS33A JSB ESUB STORE SUBCHANNEL # IN MESSAGE LDA P14 LDB MES33 TELL 'EM JSB \DSPL "READY DISC AND PRESS RUN" JSB $LIBR TURN OFF NOP CLF 0 DSK56 LIA 0 GET STATUS TO A HLT 33B PAUSE JMP RTRY ON RESTART, RETRY * * WRPTM JSB INTON JSB \BLIN WRITE PROTECT SWITCH IS ON LDB MS32A STORE SUBCHANNEL # IN MESSAGE JSB ESUB LDA P18 LDB MES32 JSB \DSPL "TURN OFF DISC PROTECT - PRESS RUN" JSB $LIBR OFF AGAIN NOP CLF 0 HLT 32B WAIT FOR IT JMP RTRY AND DO IT AGAIN * SPC 3 * * TURNS THE INTERRUPT SYSTEM BACK ON * INTON NOP DSK71 CLF 1 JSB $LIBX DEF INTON SPC 2 * SEEK ROUTINE SEEK NOP DSK57 OTA 0 SEND TRACK DSK58 STC 0,C SET DATA TO SHOW TRACK SEND ALF,ALF TRACK TO HIGH A ADA UN#IT ADD THE UNIT NUMBER LDB S#EKC GET SEEK COMMAND DSK09 CLC 1 0.*SET UP COMMAND CHANNEL DSK10 OTB 1 SEND COMMAND DSK11 STC 1,C TELL CONTROLLER LDB H#AD GET HEAD/SECTOR ADDRESS DSK59 SFS 0 READY? JMP DSK59 WAIT * DSK60 OTB 0 SEND HEAD/SECTOR DSK61 STC 0,C START JSB STATC GET STATUS JMP SEEK,I RETURN SPC 2 * * WAIT AND STATUS ROUTINE STATC NOP DSK04 SFS 1 WAIT FOR FLAG JMP DSK04 * STF 6 CLEAR DMA DSK05 CLC 1 CLEAR CONTROLLER DSK53 STC 0,C SET DATA FOR LDA UN#IT STATUS DSK07 OTA 1 SEND STATUS REQUEST DSK08 STC 1,C START DSK54 SFS 0 WAIT FOR JMP DSK54 STATUS * DSK55 LIA 0,C GET STATUS AND JMP STATC,I RETURN SPC 5 MADDR NOP MEMORY ADDRESS FOR CURRENT TRANSFER EDCNT NOP ERROR COUNT FOR CURRENT TRANSFER STATB NOP NSEC DEC -24 W#CMD OCT 010000 UN#IT NOP H#AD NOP S#EKC OCT 030000 R#DCM OCT 020000 DSKDR OCT 120000 MUST BE CONFIGURED T#AC0 NOP SKP * ESUB NOP CLA,INA SET FOR 1 WORD STA \CLEN CONVERSION LDA \TSUB GET CURRENT SUBCHANNEL # CMA,INA NEGATIVE FOR DECIMAL CONVERSION JSB \CVAS JMP ESUB,I * SPC 5 ERR22 DEF *+1 ASC 18,PARITY OR DATA ERROR TRACK XXXX ER22A DEF ERR22+15 ER22B DEF ERR22+18 * ERR40 DEF *+1 ASC 18,DEFECTIVE CYLINDER - TRACK XXXX ER40A DEF ERR40+15 ER40B DEF ERR40+18 * MES33 DEF *+1 ASC 14,READY DISC AND PRESS RUN MS33A DEF MES33+14 * MES32 DEF *+1 ASC 18,TURN OFF DISC PROTECT - PRESS RUN MS32A DEF MES32+18 * END EQU * * END BEG0 * * END EQU * END BEG0 0ASMB,R,L,C HED SWTCH - SWSG2, 7905 DISK DRIVER SEGMENT NAM SWSG2,5,10 92067-16010 REV.1840 780810 SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 2 ******************************************************************* * * NAME: SWSG2 * SOURCE: 92067-18010 * BINARY: 92067-16010 * WRITTEN BY: KFH * ******************************************************************* * * * ENTRY POINTS * ENT \DSK5,\STD5,\BADH ENT \INP5,\INT5,\SETD * * * EXTERNAL ENTRY POINTS * EXT \SWTM EXT $LIBR,$LIBX EXT \DFTR,\DNTR,\DSHD,\DNSU,\DNSP EXT \TCH,\TUNT,\DSUB,\DUNT,\TSUB EXT \CVAS,\CLEN,\DSPL,\BLIN EXT \LNTH,\XOUT EXT \INIT,\BOOT,\SAVE EXT \TRAK,\SECT EXT \TMT EXT \FFMP,\STRK * * A EQU 0 B EQU 1 SUP SKP BEG5 JSB \SETD SEGMENT'S ENTRY POINT JMP \SWTM RETURN TO MAIN * * \INP5 OCT 041400 INITIALIZE ,WRITE PROTECT COMMAND BITS \INT5 OCT 001400 " " " FLGPT EQU \INP5 FLGDF OCT 021400 FLGSP OCT 101400 * \BADH NOP BAD TRACKS HEADER FLAG * M17 OCT 17 M37 OCT 37 M177 OCT 177 M74C OCT 7400 M7700 OCT 177700 M1776 OCT 177600 * N10 DEC -10 * P1 DEC 1 P2 DEC 2 P4 DEC 4 P12 DEC 12 P14 DEC 14 P15 DEC 15 P16 DEC 16 P18 DEC 18 SKP * * DETERMINE SUBCHANNEL SPECIFICATIONS, USING INFORMATION * RETRIEVED FROM THE \TMT ENTRY FOR \DSUB. * \SETD NOP LDB \DSUB GET DESTINATION SUBCHANNEL RBL,RBL CONVtKERT TO 4 WORD PER ENTRY OFFSET ADB \TMT INTO THE \TMT BUFFER LDA B,I GET WORD 0 OF ENTRY STA \DFTR AND SAVE STARTING TRACK OF SUBCH INB LDA B,I GET WORD 1 OF ENTRY AND M17 ISOLATE THE UNIT # STA \DUNT AND SAVE LDA B,I NOW GET ALF,ALF AND MASK AND M17 THE STA \DSHD STARTING HEAD LDA B,I ALF NOW ISOLATE AND M17 THE STA \DNSU NUMBER OF SURFACES INB LDA B,I GET WORD 2 OF ENTRY CLE SET NO-INIT FLAG SSA CCE INIT WANTED FOR THIS SUBCH AND M7777 REMOVE SIGN BIT STA \DNTR SET THE # OF TRACKS INB LDA B,I AND FINALLY STA \DNSP SET THE # OF SPARES RESERVED CLA BUT CLEAR STA UBADC THE NUMBER USED JMP \SETD,I * M7777 OCT 77777 SKP * * INSERT CHNL NO. IN INSTRUCTION * * THE \STD5 SUBROUTINE SETS THE CURRENT DISK CHANNEL * NOS. IN THE I/O INSTRUCTIONS. * * \STD5 NOP LDB HPDSK GET ADDR OF INSTRUCTION ADDR LIST LDA #DATA GET # INSTRUCTIONS TO CONFIGURE STA TEMP1 STDS1 LDA B,I GET INSTRUCTION AND M7700 ISOLATE INSTRUCTION CODE IOR \TCH INSERT CHANNEL NO. STA B,I SET INSTRUCTION IN CODE INB INCR INSTRUCTION ADDRESS ISZ TEMP1 SKIP - ALL INSTRUCTIONS CONFIG. JMP STDS1 CONFIGURE NEXT INSTRUCTION * CCA SET NO HEADER STA \BADH FOR BAD TRACKS JMP \STD5,I RETURN * #DATA ABS I/OTB-I/OTC # DATA I/O INSTRUCTIONS HPDSK DEF I/OTB,I ADDRESS OF INSTRUCTIONS TEMP1 NOP SKP * * THE DRIVER ENTERS HERE AFTER 10 TRIES HAVE FAILED TO * INITIALIZE A TRACK. * SPC 2 * EOCYL ENTRY CONDITIONS: * STATUS ERRORS 11 AOND 14 * SEEK CHECK ON A STATUS 2 ERROR * OUT OF SPARES * EOCYL JSB INTON LDB ER43A STORE SUBCHANNEL # IN MESSAGE JSB ESUB LDB ERR43 ELSE SEND BAD SPECIFICATION LDA P15 JSB \DSPL MESSAGE AND JMP \XOUT TERMINATE SPC 2 * * BAD TRACK ENCOUNTERED - MARK IT DEFECTIVE AND SPARE IT * * INIER ENTRY CONDITIONS: FROM ERRDS, STWRT, & DEFTR * INIER ISZ \BADH BAD TRACK HEADER PRINTED YET JMP INIES YES - SKIP * JSB \BLIN LDA \DSUB CONVERT THE SUBCHANNEL TO ASCII CMA,INA LDB P1 STB \CLEN LDB EMES1 JSB \CVAS LDA P12 LDB EMES2 SEND THE JSB \DSPL MESSAGE LDA P16 SEND THE SECOND LINE: LDB EMES3 " LOGICAL CYL HD UNIT" JSB \DSPL AND AWAY IT GOES. INIES LDA \TRAK GET TRACK ADDRESS STA BTRAK AND SAVE IT * INBSP LDB ABTMS ADDRSS OF BAD TRACK JSB TRKMS SEND THE BAD TRACK NUMBERS * * TRACK IS NOW REPORTED TO THE OPERATOR * FLAGD LDA \DNSP GET THE # SPARES CPA UBADC OUT OF SPARES?? JMP EOCYL+1 YES GO SEND ERROR 43 AND TERMINATE * LDA FLGDF SET TO FLAG DEFECTIVE STA \INIT LDA \DNTR GET BASE SPARE TRACK ADDRESS ADA UBADC ADD NUMBER USED SO FAR STA \TRAK SAVE FOR DISK5 JSB DADTR GO TRANSLATE TO DISC ADDRESSES LDA PT#TR PICK UP THE CYL (B= HEAD) DST CYLA2 SET THE SPARE'S ADDR IN DEFECTIVE TRACK LDB MADDR GET BUFFER ADDRESS CLE SET TO WRITE JMP DISK5 FLAG THE TRACK DEFECTIVE * * DO A STATUS-WRITE TO THE NEXT SPARE TRACK TO SEE IF IT IS: * - AVAIABLE FOR USE * - BEING USED AS A FMGR TRACK SPARE * - DEFECTIVE * INISS DLD CYLAD SET THE ADDR OF BAD TRACK IN DST CYLBD TEMPORARY STORAGE OF INIFS CLA b RESET THE INIT FLAG STA \INIT FOR THE STATUS WRITE INA AND SET SKFLG TO INDICATE THIS MODE JMP SETSK * * INIFS IS BRANCHED TO WHEN A SPARE TRACK HAS BEEN FOUND * TO BE AVAILABLE FOR USE * INIFS LDA FLGSP SET IOR CHEKS POSSIBLY THE WRITE PROTECT BIT STA \INIT THE SPARING FLAG DLD CYLBD SET THE ADDRESS OF THE BAD TRACK DST CYLA2 IN THE SPARE TRACK CLA CLEAR THE MODE FLAG * SETSK STA SKFLG SET MODE TO 0/1 LDA \DNTR COMPUTE THE TRACK ADDRESS ADA UBADC AGAIN STA \TRAK SAVE FOR DISK5 CLE SET TO WRITE LDB MADDR GET BUFFER ADDRESS JMP DISK5 FLAG THE SPARE * * TRACK NOW SPARED - REPORT WHICH SPARE USED * INIRS LDA UBADC REPORT THE ADA \DNTR LOGICAL TRACK # OF THE LDB ASPMS USED SPARE JSB TRKMS OK LDA CHEKS RESET THE INIT FLAG STA \INIT AND LDA BTRAK GET BAD TRACK # AGAIN STA \TRAK AND RESET AS CURRENT TRACK ISZ UBADC STEP THE SPARE COUNTER JMP \DSK5,I CONTINUE WRITING & INITIALIZING * * UNAVAILABLE SPARE - EITHER DEFECTIVE OR ALREADY A FMGR SPARE * SO REPORT IT AND GO TRY THE NEXT ONE * NIXSP DLD CYLBD RESET THE ORIGINAL BAD TRACK ADDRESS DST CYLAD BECAUSE IT MUST BE REFLAGGED WITH A CCB NEW SPARE ADDRESS STB SKFLG ALSO MUST RE-SEEK TO THAT BAD TRACK LDA UBADC HERE IF SPARE IS BAD ISZ UBADC BUMP SPARE COUNT ADA \DNTR COMPUTE UNIT TRACK# JMP FLAGD DON'T REPORT BAD SPARE * BTRAK NOP ORIGINAL BAD TRACK # CYLBD BSS 2 & ITS CYLINDER, HEAD/SECTOR ADDRESSES SKP * * REPORT BAD TRACK/ SPARE ROUTINE * * A = LOGICAL TRACK * B = ADDRESS OF FIRST 5 WORDS OF MESSAGE * PT#TR = CYL ADDRESS * H#AD = HEAD ADDRESS * UN#INT = UNIT ADDRESS * * JSB TRKMS * RETURN A,B MEANINGLESS * TRKMS NOP STB TRK01 SAVE THE ADDRESS CMA,INA SET UP TO CONVERT THE TRACK LDB P2 STB \CLEN LDB ALBUF TO THE MESSAGE BUFFER JSB \CVAS DO IT LDA PT#TR NOW CONVERT CMA,INA THE CYL. # LDB ACYLM TO THE MESSAGE JSB \CVAS LDA H#AD CONVERT THE HEAD ALF,ALF ADA BL0 STA HEDMS SET IT IN THE MESSAGE LDA UN#IT NOW THE UNIT ADA BL0 STA UNIMS SET IN THE MESSAGE LDA N6 STA MOV6 COUNTER LDA TRK01 GET THE PREAMBLE LDB EMES4 AND STB TEMP2 MOVE LDB A,I MOVE IT TO THE STB TEMP2,I MESSAGE ISZ TEMP2 INA ISZ MOV6 JMP MOVE LDA P15 SEND LDB EMES4 "XXXXXXXXXX LLLLL CCCCCC H U" JSB \DSPL TO THE TTY JMP TRKMS,I AND RETURN * MOV6 NOP N6 DEC -6 TEMP2 NOP TRK01 NOP ASPMS DEF SPMS ABTMS DEF BTMS ALBUF DEF TKMS ACYLM DEF CYLMS EMES4 DEF EMS4 EMES2 DEF *+1 ASC 11,BAD TRACKS SUBCHANNEL XX EMSS2 NOP LOCATION FOR XX EMES1 DEF EMSS2 BL0 ASC 1, 0 EMES3 DEF *+1 ASC 5, ASC 11, LOGICAL CYL HEAD UNIT EMS4 ASC 6,BAD TRACK TKMS ASC 3, CYLMS ASC 3, HEDMS ASC 2, UNIMS ASC 1, BTMS ASC 6,BAD TRACK SPMS ASC 6,SPARED TO ERR43 DEF *+1 ASC 15,INVALID DISC SPECIFICATIONS ER43A DEF ERR43+15 UBADC NOP # USED SPARES SPC 7 * SWTCH DISC DRIVER I/O INSTRUCTION ADDRESSES * I/OTB DEF DSKDR DATA CHANNEL DEF DSK20 DEF DSK21 DEF DSK22 DEF DSK24 DEF DSK25 DEF DSK26 DEF DSK27 DEF DSK28 DEF DSK29 DEF DSK30 I/OTC EQU * HED 7905 I/O DISC DRIVER * THE DISK5 SUBROUTINE IS THE MAIN DISC INPUT/OUTPUT DRIVER. * IT SETS UP THE COMPLETE TRANSFER AND READS OR WRITES * \LNTH WOMRDS ON THE DISC. IT WAITS UNTIL THE TRANSFER * IS COMPLETE. STATUS IS DONE AFTER EACH TRANSFER. FOR WRITE * PROTECT ERRORS THE OPERATOR IS ASKED TO TURN ON THE SWITCH. * FOR UNDEFINED ERRORS OR ERRORS THAT SHOULD NOT HAPPEN * THE IRRECOVERABLE ERROR EXIT AT EOCYL IS * TAKEN. FOR NOT READY ERRORS THE OPERATOR IS NOTIFIED. * FOR OTHER ERRORS TEN TRIES ARE MADE. IF THE ERROR STILL EXIST * THEN: IF THE INIT FLAG IS SET GO TO EOCYL, * ELSE NOTIFY OPERATOR AND TERMINATE * * CALLING SEQUENCE * \LNTH = NEGATIVE # WORDS TO TRANSMIT * B = CORE ADDRESS * E = 1 FOR READ * E = 0 FOR WRITE * * * THE \DSK5 ROUTINE INTERCEPTS ALL I/O CALL TO DISK5 AND SETS THE * PROPER VALUES FOR THE FLAG WORD CHEKS AND THE FILE MASK * INSTRUCTION FILMK. THEIR VALUES DEPEND ON WHETHER A READ * OR A NORMAL WRITE VERSUS AN INITIALIZE WRITE IS BEING DONE. * FOR INITIALIZE WRITES, A REGULAR WRITE WITH SPARING DISABLED * IS DONE FIRST IN ORDER TO DETECT THE PRESENT STATUS OF THE * TRACK (IE, POSSIBLY DEFECTIVE) SO THAT THAT STATUS MAY BE * ACKNOWLEDGED. CHEKS CONTAINS THE ORIGINAL VALUE OF \INIT * AS SET BY THE CALL FROM SWTCH'S MAINLINE CODE - UNLESS IT WAS * A READ CALL IN WHICH CASE IT IS SET TO 0. \INIT IS THEREFORE * THE TEMPORARY VALUE PERTAINING TO EACH I/O CALL AND MAY BE * 0 FOR A REGULAR READ/WRITE, OR SET TO THE VALUES FOR FLAGGING * PROTECTED, DEFECTIVE, AND/OR SPARE TRACKS. * \DSK5 NOP SEZ IF A READ CALL CLA,RSS THEN ALWAYS SET TO 0 LDA \INIT ELSE GET THE INTENDED MODE STA CHEKS AND SAVE SZA IF AN INITIALIZE WRITE JMP SET5 THEN GO SET THE \INIT & FILMK VALUES STA SKFLG CLEAR DEF-SEEK/SPARE-STATUS FLAG LDA FLMWS OTHERWISE ENABLE SPARING STA FILMK ON ALL ACCESSES JMP DISK5 AND GO DO IT! * SET5 CLA CLEAR THE INIT MODE RFLAG STA \INIT TO SIGNAL A WRITE FOR STATUS PURPOSES STA SKFLG CLEAR DEFECTIVE-SEEK/SPARE-STATUS FLAG LDA FLMNS DISABLE SPARING SO DEFECTIVE & STA FILMK AND SPARE TRACKS CAN BE DETECTED JMP DISK5 * CHEKS NOP ORIGINAL TRANSFER MODE OF I/O CALL FLMNS OCT 107400 FILE MASK WITH NO AUTOMATIC SPARING FLMWS OCT 107404 FILE MASK WITH AUTOMATIC SPARING SKFLG NOP DEFECTIVE-SEEK = -1 / SPARE-STATUS = 1 / ELSE 0 SKP * * DISK5 RBL,ERB SET THE READ/WRITE BIT STB MADDR AND SAVE THE ADDRESS LDA \TRAK GET TRACK ADDRESS JSB DADTR TRANSLATE THE TRACK ADDRESS LDB #UNST SET # TO CONFIGURE COUNTER STB UNCOU LDB UNITC GET UNIT CONFIGURE ADDRESS NXUN XOR B,I AND CONFIGURE THE UNIT NUMBERS AND M17 OF COURSE THIS XOR B,I CODE WORKS STA B,I INB ISZ UNCOU DONE? JMP NXUN NO TRY AGAIN * LDA WRTCM GET THE WRITE COMMAND ADA \INIT ADD THE INIT CODE STA W#CMD AND SET IT LDA \INIT GET THE INIT CODE CPA FLGDF IF FLAGGING A DEFECTIVE TRACK JMP OFF THEN SKIP ADDRESS SETUP FOR SEEK LDA PT#TR GET THE CYLINDER LDB \SECT SECTOR BRS ADJUST OUT THE 64 WORD JASS ADB H#AD PUT IN THE HEAD DST CYLAD SET THE SEEK ADDRESSES * LDA \INIT IF FLAGGING A SPARE AND M137 CPA FLGSP JMP OFF THEN SKIP THE SECOND ADDRESS SET UP LDA CYLAD ELSE DST CYLA2 SET UP THE ADDRESS RECORD COMMAND * OFF JSB $LIBR KILL THE INTERRUPT SYSTEM NOP CLF 0 * RTRY LDA N10 SET THE ERROR STA EDCNT COUNTER TO 10 TRIES OVER JSB STATW GET STATUS RBR,SLB,RBL READY? JMP NRERR NO SO LONG * SLB IF DRIVE BUSY JMP OVER WAIT FOR IT * LDB +MADDR GET THE CORE ADDRESS LDA R#DCM PRESET FOR READ SSB WRITE? JMP DSEEK NO, GO DO REGULAR READ SEQUENCE * LDA CHEKS GET INITIAL TRANSFER MODE SZA,RSS JMP WSEEK GO DO A REGULAR WRITE LDA \INIT IS THIS THE FIRST WRITE FOR STATUS? SZA,RSS JMP WSEEK THEN MUST SEEK LDA SKFLG MUST SEEK FOR A SECOND-TIME-AROUND DEFECTIVE SZA FLAGGING, OR STATUS-WRITE TO A SPARE JMP WSEEK GO SEEK * LDA W#CMD SINCE A WRITE WAS JUST DONE JSB XFER WITH NO END COMMAND ISSUED, A SEEK DEF ADRES-1 NEEDN'T BE DONE DEF R/WCM JMP CKSTA CHECK ERROR STATUS * WSEEK LDA W#CMD SET TO WRITE DSEEK JSB XFER STANDARD TRANSFER WITH SEEK DEF WAITC-1 ADDRESS OF COMMAND TABLE DEF R/WCM ADDRESS OF END OF TABLE CKSTA ADA CTABA INDEX WITH STATUS INTO JMP A,I STATUS XFER TABLE * * CTABA DEF *+1 CODE ERROR DISPOSITION JMP ENDOK 00 NO ERROR - TEST FOR VERIFY JMP FAULT 01 ILLEGAL OP - PROGRAM FAULT JMP FAULT 02 UNIT AVAIL. PROGRAM FAULT JMP FAULT 03 UNIMPLEMENTED ERROR CODE - FAULT JMP FAULT 04 " " " " JMP FAULT 05 " " " " JMP FAULT 06 " " " " JMP RECAL 07 CYL COMPARE TRY TO RECAL. JMP ERRDS 10 PARITY ERROR TRY AGAIN JMP EOCYL 11 HEAD/SECTOR? RESTART ERR43 JMP FAULT 12 I/O PROGRAM (WHO? ME?) PROGRAM FAULT JMP FAULT 13 UNIMPLEMENTED ERROR CODE - FAULT JMP EOCYL 14 END OF CYL. BAD # SECT/TRK ERR43,RESTART JMP FAULT 15 UNIMPLEMENTED ERROR CODE - FAULT JMP ERRDS 16 OVER RUN JUST RETRY JMP ERRDS 17 CORRECTABLE ERROR DON'T EVEN TRY JMP ISPAR 20 ILLEGAL SPARE JMP DEFTR 21 DEFECTIVE TRACK JMP ST2ER 22 ACCESS NOT READY - STATUS 2 ERROR 640 JMP ST2ER 23 STATUS 2 GO CHECK JMP FAULT 24 UNIMPLEMENTED ERROR CODE - FAULT JMP FAULT 25 " " " " JMP ST2ER 26 ILLEGAL WRITE TEST ST 2 JMP UWAIT 27 WAIT FOR THE UNIT. SKP * * ERRDS ENTRY CONDITIONS: * STATUS 10,16,17 ERRORS * VERIFY ERROR * INVALID STATUS 2 ERROR * ERRDS ISZ EDCNT STEP OPERATION ERROR COUNT JMP OVER OK TRY AGAIN * LDB CHEKS WAS THIS A WRITE FOR STATUS SZB,RSS CHECKING? JMP DSKER NO, SO FLAG THE ERROR JSB INTON TURN THE INTERRUPTS BACK ON JSB STWRT IF STATUS WRITE, BRANCH APPROPRIATELY CPA \INT5 INIT ONLY? RSS CPA \INP5 INIT,WRITE PROTECT? JMP INIER YES, GO SPARE IT CPA FLGDF IF TRACK IS BEING SET JMP INISS DEFECTIVE - GO CHECK THE SPARES AND M137 CPA FLGSP IF TRACK IS BEING SPARED JMP NIXSP THEN MUST TRY ANOTHER RSS SKIP INTON CALL * * DSKER JSB INTON LDA \TRAK ERROR MESSAGE CONTAINING THE CMA,INA TRACK # LDB P2 STB \CLEN LDB ER22A JSB \CVAS LDB ER22B STORE SUBCHANNEL # JSB ESUB IN MESSAGE LDA P18 LDB ERR22 JSB \DSPL "PARITY OR DATA ERROR TRACK XXXX" tN6 JMP \XOUT SPC 2 * * IF A STATUS-WRITE FOR EITHER A REGULAR TRACK OR * FOR A SPARE TRACK, BRANCH APPROPRIATELY FOR THE ERROR * STWRT NOP LDA \INIT GET THE PRESENT MODE SZA,RSS IF STATUS THEN LDA SKFLG CHECK IF CHECKING A SPARE'S STATUS CPA P1 IN WHICH CASE A NEW JMP NIXSP SPARE MUST BE GOTTEN SZA,RSS OTHERWISE, JMP INIER THIS TRACK MUST BE MARKED DEFECTIVE JMP STWRT,I RETURN TO ERRDS OR DEFTR FOR MORE CHECKS SKP * * STATUS 21 ERROR - CHECK IF INITIALIZING OR NOT * DEFTR JSB INTON TURN INTERRUPTS BACK ON LDB CHEKS WAS THIS A WRITE WITH STATUS SZB,RSS CHECKING? JMP FAULT NO - REGULAR READ/WRITE WITH NO RECOVERY * JSB STWRT IF A STATUS-WRITE, BRANCH APPROPRIATELY CPA FLGDF WAS IT JUST MARKED DEFECTIVE? JMP INISS YES, SO GO SPARE IT NOW AND M137 MASK OFF POSSIBLE WP BIT CPA FLGSP WAS IT JUST SPARED? JMP NIXSP YES, GO TRY ANOTHER SPARE JMP INIER OTHERWISE, FLAG DEFECTIVE & SPARE IT SKP * * ILLEGAL SPARE (STATUS 20 ERROR) * - IF NOT INITIALIZING THE SYSTEM * SUBCHANNEL IN FILESAVE MODE, THEN IGNORE * ISPAR LDB CHEKS WAS THIS A WRITE INITIALIZE? SZB,RSS JMP FAULT-1 NO, SO STATUS 20 ERROR IS VALID * LDA SKFLG IF CHECKING THE STATUS OF A SPARE CPA P1 THEN CHECK FURTHER IF RSS IT IS AVAILABLE FOR USE JMP END01 OTHERWISE IGNORE ERROR & CONTINUE * * IF NOT THE SYSTEM SUBCHANNEL OR NOT SAVING FILES, * THEN RE-USE THE TRACK. * LDA \DSUB IS THE SYSTEM SUBCHANNEL CPA \TSUB BEING INITIALIZED? RSS JMP USESP NO - SO SPARE CAN BE REUSED LDB \SAVE ARE FILES BEING SAVED? SZB JMP GETBD YES, SEE IF IT LIES IN THE FMGR SPACE * USESP JSB INTON TURN INTERRUPTS BACK ON JMP INIFS GO REUSE IT * NEXTS JSB INTON TURN INTERRUPTS BACK ON JMP NIXSP AND TRY NEXT SPARE TRACK * * STILL INITIALIZING THE SYSTEM SUBCHANNEL, CHECK IF TRACK * BELONGS TO THE FMGR AREA. * GETBD LDB N3 MUST READ THE ADDRESS OF THE DEFECTIVE STB \LNTH THAT WAS STORED IN THIS SPARE LDB DPBUF GET THE 3-WORD PREAMBLE BUFFER ADDR LDA RFSCM AND THE READ FULL SECTOR COMMAND JSB XFER AND PERFORM THE READ DEF ADRES-1 ADDRESS OF COMMAND TABLE, -1 DEF R/WCM ADDRESS OF LAST COMMAND TO EXECUTE * LDA N6144 RESET THE LENGTH OF DMA TRANSFER STA \LNTH TO ONE TRACK LDA HDSSP GET THE HEAD/SECTOR ADDR ALF,ALF ROTATE TO LOW BYTE AND M37 AND ISOLATE STA HDSSP SAVE ONLY THE HEAD # * LDB \SAVE LDA \FFMP GET FIRST LOGICAL FMP TRACK SSB IF SOME WERE OVERLAID LDA \STRK THEN GET NEXT TRACK AFTER SYSTEM JSB DADTR CONVERT FIRST FMP TRACK TO CYL & HEAD * * CHECK IF DEFECTIVE TRACK LIES WITHIN CURRENT SUBCHANNEL DEFINITION * LDA N5 CLEAR SURFACE BUFFER STA TEMP1 SET LOOP COUNTER CLA LDB DSBUF GET BUFFER ADDRESS STA B,I INB ISZ TEMP1 DONE? JMP *-3 NO * LDA \DNSU GET # SURFACE OCCUPIED BY SYSTEM CMA,INA SUBCHANNEL, AND SET AS A STA TEMP1 LOOP COUNTER CLB,INB GET 'OCCUPIED' INDICATOR LDA \DSHD GET STARTING HEAD # ADA DSBUF AND OFFSET INTO BUFFER SETDS CPA ESBUF END-OF-BUFFER? JMP CHEKK (ERRONEOUS DEF'N) STB A,I MARK SURFACE AS ONE OCCUPIED BY SYS SUBCH INA BUMP BUFFER ADDRESS ISZ TEMP1 DONE? JMP SETDS NO * CHEKK LDA HDSSP GET HEAD # OF DEFECTIVE TRACK ADA DSBUF AND GET CORRESPONDING ENTRY IN TABLE LDB A,I y SZB,RSS POSSIBLY WITHIN THE SYS SUBCH? JMP USESP NO, SO SPARE CAN BE RESUED * * COMPARE WITH FIRST FMP CYLINDER * LDB PT#TR GET STARTING CYLINDER OF FMP CMB,INB AND COMPARE WITH DEF TRACK'S CYLINDER ADB CYLSP SSB JMP USESP DEFECTIVE TRACK CYLINDER IS LESS SZB GREATER? JMP CLAST YES, SO CHECK WITH LAST FMP TRACK * * SEE IF DEFECTIVE HEAD PRECEEDS STARTING HEAD OF FMP * LDA H#AD GET FIRST FMP HEAD# ALF,ALF INTO LOW BYTE AND M37 AND ISOLATE SZA,RSS IF ZERO THEN JMP NEXTS NO HEAD PRECEEDS IT - TRY NEXT SPARE CMA,INA ADA HDSSP GET DEFECTIVE HEAD# AND COMPARE WITH THAT SSA,RSS OF THE FIRST FMP - LESS? JMP NEXTS NO, THIS SPARING MUST BE PRESERVED - TRY NEXT JMP USESP GO AHEAD AND USE THIS SPARE * * SEE IF DEFECTIVE TRACK'S CYLINDER IS > LAST FMP CYLINDER * CLAST CCA CONVERT LAST TRACK ON SUBCHANNEL ADA \DNTR TO PHYSICAL CYLINDER AND HEAD JSB DADTR ADDRESSES LDB CYLSP GET DEFECTIVE TRACK CYL CMB,INB AND COMPARE WITH LAST FMP CYL ADB PT#TR JUST COMPUTED SSB GREATER? JMP USESP YES, REUSE THAT SPARE SZB LESS? JMP NEXTS YES, TRY FOR NEXT SPARE * * SEE IF DEFECTIVE HEAD# IS > LAST FMP CYL HEAD# * LDA H#AD GET LAST FMP HEAD ALF,ALF ISOLATE AND M37 LDB HDSSP COMPARE WITH HEAD# OF DEFECTIVE TRACK CMB,INB ADA B SSA,RSS JMP NEXTS TRY ANOTHER TRACK JMP USESP REUSE THAT SPARE SPC 2 DPBUF DEF *+1,I PREAMBLE BUFFER NOP CYLSP NOP CYLINDER ADDR STORED IN SPARE HDSSP NOP HEAD/SECTOR ADDR STORED IN SPARE N3 DEC -3 N5 DEC -5 N6144 DEC -6144 RFSCM OCT 3000 * DSBUF DEF *+1 BSS 5 SUBCHARNNEL SURFACE BUFFER ESBUF DEF * SKP * * STATUS-2 ERROR POSSIBLE CONDITIONS ARE: * NO ERROR SO JUST RETRY AT ERRDS * NOT READY GO TO NRERR TO WAKE 'EM UP * PROTECTED SEND TURN ON THE SWITCH MESSAGE * ST2ER SSB,RSS IF NO STATUS 2 ERROR THEN JMP ST2 TRY FOR A FORMAT PROTECT SWITCH ERROR * LDA B STATUS 2 TO A AND P4 ISOLATE THE SEEK CHECK BIT SZA IF SET THEN WE HAVE A BAD ADDRESS JMP EOCYL SO TERMINATE JMP NRERR OTHERWISE, IT MUST NOT BE READY * ST2 LDA MADDR WAS THIS A READ OR A WRITE? SSA JMP ERRDS READ - SO NEEDN'T WORRY ABOUT SWITCHS * LDA B GET THE STATUS WORD AGAIN AND M40 KEEP FORMAT BITS SZA,RSS SET?? JMP WRPTM TURN ON FORMAT SWITCHH LDA B GET STATUS -2 AGAIN AND M100 GET PROTECTED BIT SZA,RSS JMP ERRDS JUST COUNT THE ERROR AND TRY AGAIN * * * FORMAT/PROTECT ERROR - WARN 'EM AND WAIT * WRPTM STA TEMP2 SAVE BITS OF STATUS-2 JSB INTON JSB \BLIN WRITE PROTECT SWITCH IS LDA TEMP2 LDB MS34A SZA LDB MS32A JSB ESUB STORE SUBCHANNEL # IN MESSAGE LDA TEMP2 RETRIEVE THOSE BITS LDB MES34 "TURN ON FORMAT SWITCH - PRESS RUN" SZA LDB MES32 "TURN OFF DISK PROTECT - PRESS RUN" LDA P18 JSB \DSPL * JSB $LIBR OFF THE INTERRUPTS FOR A HALT NOP CLF 0 HLT 32B WAIT FOR TURN ON JMP RTRY TRY AGAIN. SPC 1 * * NOT READY ERROR - WARN 'EM AND WAIT * NRERR JSB INTON JSB \BLIN DISC IS NOT READY LDB MS33A STORE SUBCHANNEL # JSB ESUB IN MESSAGE LDA P14 LDB MES33 SEND THE WORD TO THE MAN JSB \DSPL "READY DISC AND PRESS RUN" * JSB $LIBR OFF THE INTERRUPTS FOR A HALT ad NOP CLF 0 LDA STATB HLT 33B PAUSE JMP RTRY ON RESTART RETRY SPC 5 * * ENTRY CONDITIONS: * STATUS ERRORS 1,2,12 * UNIMPLEMENTED STATUS ERRORS 3,4,5,6,13,15,24,25 * FROM DEFTR ON A STATUS ERROR 21 * FROM ISPAR ON A STATUS ERROR 20 * JSB INTON TURN ON INTERRUPTS FOR MESSAGE FAULT LDA \TRAK CMA,INA LDB P2 STB \CLEN LDB ER40A JSB \CVAS LDB ER40A STORE SUBCHANNEL # JSB ESUB IN MESSAGE LDA P18 LDB ERR40 JSB \DSPL "DEFECTIVE CYLINDER - TRACK XXX" JMP \XOUT TERMINATE SPC 4 ESUB NOP CLA,INA SET FOR A 1-WORD CONVERSION STA \CLEN LDA \DSUB GET CURRENT SUBCHANNEL CMA,INA JSB \CVAS JMP ESUB,I SKP SPC 1 ERR40 DEF *+1 ASC 18,DEFECTIVE CYLINDER - TRACK XXXX ER40A DEF ERR40+15 ER40B DEF ERR40+18 WRTCM OCT 4000 ENDC OCT 12400 VERCM OCT 3400 CALC OCT 600 WAITX OCT 13000 M40 OCT 40 M100 OCT 100 M137 OCT 137777 UN#IT NOP * SPC 3 * * INTON TURNS THE INTERRUPT SYSTEM BACK ON * INTON NOP DSK30 CLF 0 CLC 6 JSB $LIBX DEF INTON SPC 3 * UWAIT WAIT FOR UNIT TO BECOME AVAILABLE * * UWAIT LDA WAITX SEND THE WAIT UWAT1 JSB OUTCC COMMAND JSB WAITF AND WAIT JMP OVER OK NOW TRY IT * SPC 3 * * RECAL RECALIBRATE THE DISC ON CYLINDER COMPARE ERRORS * RECAL ISZ EDCNT CHECK COUNT RSS JMP DSKER LDA CALC GET COMMAND JMP UWAT1 GO SEND IT SKP * * ENDOK AFTER A SUCCESFUL TRANSFER WE MUST DO AND END * TO ALLOW OTHER CPU'S TO ACCESS THE CONTROLLER. * ALSO IF DOING INITIALIZE AND NOT FLAGGING DEFECTIVE DO * A VERIFY TO CHECK FOR ERRORS. * * NOTE: AN 'END' COMMA<ND IS NOT ISSUED IF A WRITE FOR STATUS PURPOSES * WAS JUST DONE, ALLOWING THE SEEK TO BE SKIPPED WHEN RE-WRITING . * ENDOK LDB CHEKS WAS THIS A WRITE FOR STATUS SZB,RSS CHECKING? JMP ENDSX NO, JUST GO SEND THE END COMMAND * END01 LDA \INIT FIRST TIME THRU FOR THE SZA STATUS ONLY? JMP END02 NO - JUST DID THE REAL THING JSB INTON TURN INTERRUPTS BACK ON FIRST LDA SKFLG IF THE STATUS CHECK WAS TO A CPA P1 POTENTIAL SPARE TRACK JMP INIFS THEN NEEDN'T SEND THE END * STB \INIT YES, NOW THE THE CORRECT INIT FLAG LDB MADDR GET BUFFER ADDRESS CLE CLEAR FOR A WRITE JMP DISK5 NOW DO THE REAL INITIALIZE (NO END WAS DONE) * END02 RAL,SLA IF SPARING JMP STDAD THE SEEK ADDRESS IS ALREADY SET * RAL,SLA IF JUST PROTECTING JMP STDAD USE STANDARD ADDRESS * RAL,SLA IF FLAGING DEFECTIVE JMP ENDSX DON'T EVEN CHECK * STDAD LDB \LNTH EITHER STRAIGHT INIT. OR CMB,INB PROTECT LSR 7 SET UP THE STB VERCO SECTOR COUNT LDA VERCM SEND VERIFY COMMAND JSB XFER AND GO DEF WAITC-1 DO IT DEF VERCO SZA ANY ERROR IS JMP ERRDS BAD NEWS * * SEND THE END COMMAND * ENDSX LDA ENDC GET THE END COMMAND JSB OUTCC SEND IT LDA \BOOT ARE WE BOOTIN UP? SZA,RSS YES, SO GO DO IT! JMP ENDBR NO LDA \TCH GET TARGET CHANNEL = DEST. CHANNEL ALF,RAL AND STORE IN BITS RAL 11-6 OTA 1 OF THE SWITCH REGISTER LDA M2055,I GET STARTING ADDRESS LDB M1742 DETERMINE IF WE'RE IN AN CPB P2 RTE-II OR AN RTE-III/IV RSS MUST DISABLE MAPPING FOR RTE-III/IV JMP A,I GO TO RTE! CLB MUST CLEAR THE BASE PAGE FENCE SETATING LFB DJP A,I WELL SAID! * M2055 OCT 2055 M1742 EQU 1742B * ENDBR JSB INTON LDA \INIT CPA FLGDF BRANCH APPROPRIATELY, JMP INISS FLAGGING DEFECTIVE - NOW GET A SPARE AND M137 CPA FLGSP JMP INIRS FLAGGING A SPARE - RESET \TRAK & \INIT JMP \DSK5,I AND EXIT SKP * * * XFER THE TRANSFER ROUTINE * DOES DMA SET UP,AND SENDS A SERIES OF WORDS TO THE DISC * CONTROLLER. THEN STATUS IS DONE USING STATW. * * CALLING SEQUENCE: * * A= COMMAND FOR THE XFER READ/WRITE INIT ETC. * B= ADDRESS WITH DIRECTION BIT SET FOR DMA * * JSB XFER * DEF COMMAND LIST * DEF LAST COMMAND (ALSO DMA COMMAND) * * XFER NOP STA R/WCM SET THE READ WRITE COMMAND LDA DSKDR SET UP THE DMA OTA 6 SEND CW1 CLC 2 PREPARE MEM ADDR REG FOR CW2 OTB 2 SEND CW2 STC 2 PREPARE WORD CNT REG FOR CW3 LDA \LNTH OTA 2 SEND CW3 LDB XFER,I GET THE HEAD OF THE LIST ISZ XFER STEP TO THE END ADDRESS NXTC INB STEP TO THE FIRST COMMAND LDA B,I GET THE WORD CPA R/WCM IF ACTION COMMAND CCE,RSS SKIP TO THE CLC RAL,CLE,SLA,ERA ELSE CLEAR THE SIGN AND IF SET DSK20 CLC 0 TELL THE CONTROLLER IT IS A COMMAND DSK21 OTA 0,C SEND THE WORD CPB XFER,I IF THIS IS THE ACTION WORD STC 6,C ACTIVATE THE DMA DSK22 STC 0 START THE CONTROLLER SEZ IF NOT A COMMAND SKIP THE FLAG WAIT JSB WAITF WAIT FOR THE FLAG STF 6 STOP THE DMA CPB XFER,I DONE? RSS YES SKIP JMP NXTC NO GO DO THE NEXT ONE * JSB WAITF THIS WAIT IS ONLY NEEDED FOR VERIFY ISZ XFER STEP TO EXIT ADDRESS JSB STATW GET THE STATUS WORDS JMP XFER,I AND GET OUT USKP * * * XFER COMMAND TABLE * WAITC OCT 113000 WAKEUP COMMAND SEEKC OCT 101200 MUST CONFIGURE TO UNIT CYLAD NOP CYLINDER ADDRESS HDSCT NOP HEAD AND SECTOR ADRES OCT 106000 NEEDS UNIT CYLA2 NOP CYLINDER ADDRESS FOR ADDRESS RECORD HDSC2 NOP FILMK OCT 107404 FILE MASK/SPARING ONLY R/WCM OCT 102400 READ/WRIT COMMAND VERCO NOP VERIFY COUNT * * END OF LIST * * UNIT CONFIGURE LIST * UNITC DEF *+1,I DEF WAITX DEF SEEKC DEF VERCM DEF CALC DEF ADRES DEF R/WCM DEF STACC DEF WRTCM DEF R#DCM DEF RFSCM #UNST ABS UNITC-*+1 NUMBER IN THE LIST SKP * * * DADTR ROUTINE TO TRANSLATE A TRACK ADDRESS INTO CYL,HEAD * UNIT TO BE STORED AT: * * CYL AT: PT#TR * HEAD AT: H#AD ALSO RETURNED IN B. * UNIT AT: UN#IT ALSO RETURNED IN A. * * CALLING SEQUENCE: * * LDA TRACK SET TRACK ADDRESS IN A. * JSB DADTR CALL * * DADTR NOP CLB DIVIDE # TRACKS BY DIV \DNSU NUMBER OF HEADS/CYL ADA \DFTR ADD BASE CYLINDER ADDRESS STA PT#TR SET THE CYLINDER ADDRESS ADB \DSHD ADD THE BASE HEAD ADDRESS BLF,BLF PUT HEAD ADDRESS IN IT'S PLACE LDA B PUT INTO A TO AND M74C ISOLATE STA H#AD STORE IT AS PROMISED SWP GET UNIT FROM LOW B LDA \TUNT STA UN#IT STORE IT AS PROMISED JMP DADTR,I RETURN A= UNIT, B=HEAD * PT#TR NOP H#AD NOP SKP * * STATW RETURNS STATUS AS FOLLOWS: * * STATB FULL STATUS 1 WORD * A ERROR CODE (MAX=27) FROM STATUS 1 * B STATUS 2 WORD * * STATW NOP LDA STACC GET STATUS COMMAND JSB OUTCC SEND IT JSB WAITF WAIT FOR FLAG DSK24 LIA 0,C GET WORD 1 JSB WAITF WAIT FOR FLAG DSK25 LIB 0,&640C GET WORD 2 STA STATB SAVE WORD 1 ALF,ALF ROTATE AND M37 ISOLATE CPA M37 ATTENTION? JMP STATW+1 YES TRY AGAIN * JMP STATW,I NO - RETURN SPC 3 * * * OUTCC OUTPUT THE COMMAND WORD IN THE A-REG * OUTCC NOP DSK26 CLC 0 SEND "HERE COME DE WORD" DSK27 OTA 0,C SEND DE WORD DSK28 STC 0 SET UP IN CASE IT IS NEEDED JMP OUTCC,I RETURN SPC 3 * * * WAITF WAITS FOR A FLAG * WAITF NOP DSK29 SFS 0 HERE YET JMP *-1 NO KEEP TRYING * JMP WAITF,I YES RETURN SPC 3 * * STACC OCT 1400 MADDR NOP MEMORY ADDRESS FOR CURRENT TRANSFER UNCOU NOP EDCNT NOP ERROR COUNT FOR CURRENT TRANSFER STATB NOP R#DCM OCT 102400 W#CMD NOP DSKDR ABS 0 DMA CONTROL WORD MES32 DEF *+1 ASC 18,TURN OFF DISC PROTECT - PRESS RUN MS32A DEF MES32+18 MES34 DEF *+1 ASC 18,TURN ON FORMAT SWITCH - PRESS RUN MS34A DEF MES34+18 MES33 DEF *+1 ASC 14,READY DISC AND PRESS RUN MS33A DEF MES33+14 ERR22 DEF *+1 ASC 18,PARITY OR DATA ERROR TRACK XXXX ER22A DEF ERR22+15 ER22B DEF ERR22+18 * * END EQU * END BEG5 6 ] 92067-18011 1805 S C0422 &4ASM1 RTE-IV ASSEMBLER - MAIN             H0104 ,ASMB,R,L,C * * NAME: ASMB * SOURCE: 92067-18011 * RELOC: 92067-16011 * PGMR: C.C.H,S.P.K. * MODIFIED BY EARL STUTES 1976-09-20-1600 * MODIFIED BY EAS TO ADD DEY INSTRUCTION 1977-01-30 * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** HED * RTE ASMB 92067-16011 * (C) HEWLETT-PACKARD COMPANY 1978. NAM ASMB,3,99 92067-16011 REV.1805 780112 * ********************************************* * * ASSEMBLER CONTROL STATEMENT OPTIONS * * * * * * A = ABSOLUTE ASSEMBLY * * * B = IGNORED * * * C = SCHEDULE 'XREF' FOR XREF TABLE * * * F = FLOATING POINT HDWE. INSTRUCTIONS * * * L = LIST OUTPUT W/ ENTIRE OBJECT CODE * * * Q = LIST OUTPUT W/ RELOC ADDR OF * * * OPERAND AS OBJECT CODE * * * N = ASSEMBLE STATEMENTS WITHIN 'IFN' * * * R = RELOCATABLE ASSEMBLY * * * T = LIST SYMBOL TABLE (END OF PASS 1) * * * X = NON-EAU INSTRUCTIONS * * * Z = ASSEMBLE STATEMENTS WITHIN 'IFZ' * * * P = NULL OVERRIDE OPTION * * ********************************************* * ENT ASMB SPC 1 EXT IFBRK EXT SUP.C,RED.C,WRT.C,PRM.C,GMM.C,OLY.C,SPC.C EXT EOF.C,END.C EXT C.SOR,C.LST,C.BIN,C.BIA,C.TTY SPC 1 EXT ?HA3Z,?LITI,?AREC,?BREC,?ART,?LKLI EXT ?CMQ,?ENP,?EXP,?EMP,?INSR,?INS? ENT ?ASCN,?ASMB,?BNCUN,?BPKU,?CHOP,?CHPI,?DCOD ENT ?ENDS,?ERPR,?MSYS,?GETC,?MOVE,?MSYM ENT ?AFLG,?LSTL,?RFLG,?ASM1,?LABE ENT ?ORRP,?SETM,?SUP,?LPER,?PERL,?PLIN ENT ?LOUT,?LTFL,?LTSA,?LTSB,?ORGS,?CNTR ENT ?ASII,?ICSA,?FLGS,?LFLG,?TFLG ENT ?X,?MESX,?ASCI,?LINC,?LINS,?LIST ENT ?OPLK,?OPER,?PKUP,?PLIT,?PNCH,?PRNT,?RSTA ENT ?SEGM,?SYMK,?V,?ARTL,?LST,?LWA ENT ?NEAU,?HA38,?FMPE,?BINF,?ASME ENT ?FPT,?FP,?ENER,?PRPG,?ENFL ENT ?BPSV,?BASF,?GETA ENT ?NDOP,?NDSY,?SYML,?SYMT SUP SUPPRESS EXTENDED LISTING SPC 3 ENT ?TEMP,?NAMI,?NAME,?RELC,?SIGN,?SUMP ENT ?TERM,?T,?BYFL,?FLEX,?CNTB,?CODE,?DSIG ENT ?FLAG,?FLAQ,?INST,?LAST,?PASS,?PEEK,?PLCN ENT ?PLEN,?PNTR,?RCNT,?SAVB,?SCN1,?SYMI,?SYMP,?TEST ENT ?ENT.,?ENTC,?ENTV,?IOBF,?BUFF,?PBUF,?SVST * ****************************** * * OPCODE AND PSEUDO-OP TABLE * * ****************************** OPT OCT 40502,51421,0, 40504,40416,42001 ABS/ADA OCT 40504,41016,46001, 40514,43060,31700 ADB/ALF OCT 40514,51060,31400, 40514,51460,31000 ALR/ALS OCT 40516,42016,12001, 40522,51460,31100 AND/ARS OCT 40523,41407,0, 41114,43060,25700 ASC/BLF OCT 41114,51060,25400, 41114,51460,25000 BLR/BLS OCT 41122,51460,25100, 41123,51412,0 BRS/BSS OCT 41503,40461,53400, 41503,41061,47400 CCA/CCB OCT 41503,42463,42300, 41514,40461,52400 CCE/CLA OCT 41514,41061,46400, 41514,41450,106700 CLB/CLC OCT 41514,42463,0, 41514,43052,103100 CLE/CLF OCT 41515,40461,53000, 41514,47430,103101 CMA/CLO OCT 41515,41061,47000, 41515,42463,42200 CMB/CME OCT 41517,46403 COM DEF ?CMQ OCT 41520,40416,52001, 41520,41016,56001 CPA/CPB OCT 42105,41410,0, 42105,43020,0 DEC/DEF OCT 42105,54025,0, 41131,52043,0 DEX/BYT ASC 2,DEY$ DEY OCT 0 OCT 42514,40460,131600, 42516,52004 ELA/ENT DEF ?ENP OCT 42514,41060,125600, 42516,42014,0 ELB/END OCT 42522,40460,131500, 42521,52413,0 ERA/EQU OCT 42522,41060,125500, 42530,52005 ERB/EXT DEF ?EXP OCT 42515,40405 EMA DEF ?EMP OCT 44114,52051,102000,46111,40450,102500 HLT/LIA OCT 46111,41050,106500,46511,40450,102400 LIB/MIA SKP * ?FPT EQU * < FLOATING POINT SUBROUTINE/MACRO OPCODES > * OCT 43101,42006 FAD DEF ?HA38 OCT 43104,53006 FDV DEF ?HA38 OCT 43115,50006 FMP DEF ?HA38 OCT 43123,41006 FSB DEF ?HA38 * OCT 44516,40466,52004, 44516,41066,46004 INA/INB OCT 44517,51016,32001, 44523,55016,36000 IOR/ISZ OCT 45115,50016,26000, 45123,41016,16000 JMP/JSB OCT 46104,40416,62001, 46104,41016,66001 LDA/LDB OCT 46511,41050,106400, 47101,46415,0 MIB/NAM OCT 47117,50030,0, 47503,52011,0 NOP/OCT OCT 47524,40450,102600, 47522,43401 OTA/ORG DEF ORGP OCT 47524,41050,106600, 47522,51002 OTB/ORR DEF ORRP OCT 51101,46060,31200, 51101,51060,31300 RAL/RAR OCT 51102,46060,25200, 51102,51060,25300 RBL/RBR OCT 51120,46032,0 RPL OCT 51123,51470,42001, 51505,55062,42040 RSS/SEZ OCT 51506,41452,102200, 51506,51452,102300 SFC/SFS OCT 51514,40465,10010, 51514,41065,4010 SLA/SLB OCT 51517,41453,102201, 51517,51453,102301 SOC/SOS OCT 51523,40464,52020, 51523,41064,46020 SSA/SSB OCT 51524,40416,72000, 51524,41016,76000 STA/STB OCT 51524,41450,102700, 51524,43052,102100 STC/STF OCT 51524,47430,102101, 51532,40467,52002 STO/SZA OCT 51532,41067,46002, 54117,51016,22001 SZB/XOR OCT 47522,41000 ORB DEF ORBP OCT 46123,52024,0, 51513,50022,0 LST/SKP OCT 51525,50040,1, 44105,42017 SUP/HED DEF HEDSB OCT 52516,46024,1, 51105,50035 UNL/REP DEF REPSB OCT 52516,51440,0, 44506,47031,116 UNS/IFN OCT 54111,43031,0, 44506,55031,132 XIF/IFZ OCT 51520,41423,0, 46511,41500,0 SPC/MIC * SKP * * * * 21MX INSTRUCTION SET * * * * OCT 41501,54030,101741, 41501,54430,101751 CAX/CAY OCT 41502,54030,105741, 41502,54430,105751 CBX/CBY OCT 54101,54030,101747, 54101,54430,101757 XAX/XAY OCT 54102,54030,105747, 54102,54430,105757 XBX/XBY OCT 44523,54030,105760, 44523,54430,105770 ISX/ISY OCT 42123,54030,105761, 42123,54430,105771 DSX/DSY OCT 46104,54110,105745, 46104,54510,105755 LDX/LDY OCT 45114,54511,105762, 45120,54513,105772 JLY/JPY OCT 46101,54111,101742, 46101,54511,101752 LAX/LAY OCT 46102,54111,105742, 46102,54511,105752 LBX/LBY OCT 51501,54111,101740, 51501,54511,101750 SAX/SAY OCT 51502,54111,105740, 51502,54511,105750 SBX/SBY OCT 51524,54111,105743, 51524,54511,105753 STX/STY OCT 40504,54110,105746, 40504,54510,105756 ADX/ADY OCT 41530,40430,101744, 41530,41030,105744 CXA/CXB OCT 41531,40430,101754, 41531,41030,105754 CYA/CYB OCT 46102,52030,105763, 51502,52030,105764 LBT/SBT OCT 51506,41030,105767, 52102,51515,105775 SFB/TBS OCT 51502,51515,105773, 41502,51515,105774 SBS/CBS OCT 41502,52114,105766, 46502,52114,105765 CBT/MBT OCT 46526,53514,105777, 41515,53514,105776 MVW/CMW OCT 42102,46041,0, 42102,51042,1 DBL/DBR * * * * * 21MX - MEU INSTRUCTIONS * * * * OCT 42112,50111,105732, 42112,51511,105733 DJP/DJS OCT 45122,51515,105715 JRS OCT 46106,40430,101727, 46106,41030,105727 LFA/LFB OCT 46502,43030,105703, 46502,44430,105702 MBF/MBI OCT 46502,53430,105704, 46527,43030,105706 MBW/MWF OCT 46527,44430,105705, 46527,53430,105707 MWI/MWW OCT 50101,40430,101712, 50101,41030,105712 PAA/PAB { OCT 50102,40430,101713, 50102,41030,105713 PBA/PBB OCT 51123,40430,101730, 51123,41030,105730 RSA/RSB OCT 51126,40430,101731, 51126,41030,105731 RVA/RVB OCT 51512,50111,105734, 51512,51511,105735 SJP/SJS OCT 51523,46511,105714 SSM OCT 51531,40430,101710, 51531,41030,105710 SYA/SYB OCT 52512,50111,105736, 52512,51511,105737 UJP/UJS OCT 52523,40430,101711, 52523,41030,105711 USA/USB OCT 54103,40511,101726, 54103,41111,105726 XCA/XCB OCT 54114,40511,101724, 54114,41111,105724 XLA/XLB OCT 54115,40430,101722, 54115,41030,105722 XMA/XMB OCT 54115,46430,105720, 54115,51430,105721 XMM/XMS OCT 54123,40511,101725, 54123,41111,105725 XSA/XSB * ?NEAU EQU * * START OF NON-EAU OPTABLE SWAP AREA * * OCT 42111,53026,100400, 42114,42026,104200 DIV/DLD OCT 42123,52026,104400, 46520,54426,100200 DST/MPY OCT 40523,46027,100020, 40523,51027,101020 ASL/ASR OCT 46123,46027,100040, 46123,51027,101040 LSL/LSR OCT 51122,46027,100100, 51122,51027,101100 RRL/RRR OCT 51527,50030,101100,51101,46451,105000 SWP/RAM * ?FP EQU * * OCT 0,54030,105100,43114,52030,105120 FIX/FLT OCT 0 ********* END OF OPCODE TABLE *********** * * SKP * ************************************* * * PUT OUT A MESSAGE TO THE OPERATOR * * ************************************* MESSX NOP STA MESS SET MESSAGE LOCN STB MESS+1 SET MESSAGE LENGTH JSB WRT.C DEF C.TTY CONSOLE FCB - OUTPUT ON SYSTEM TTY DEF MADDR MESSAGE ADDRESS DEF MSGLN MESSAGE LENGTH NOP JMP MESSX,I EXIT SEGNM ASC 3,ASMB ASGNM DEF SEGNM MADDR ASC 7, /ASMB: $END MESS ASC 2, MESSAGE EXTENSION MSGLN DEC 9 * ******************************* * * GO TO LOAD THE NEXT SEGMENT * * ******************************* SEGMT STA DFSG# : SET CORRECT DIGIT (0,1,2,3,OR 4) JSB SGNAM DEF DFSG# SEGMENT # JSB OLY.C LOAD OVERLAY SEGMENT DEF SEGNM DLD NOSG SEGMENT NOT FOUND JSB MESSX JMP ABORT DFSG# NOP NOSG ASC 2,NOSG * SGNAM NOP ROUTINE TO DETERMINE NAME OF SEGMENT LDA SGNAM,I GET ADDRESS OF SEG# LDA A,I SEGMENT # ADA B60 CONVERT # TO ASCII DECIMAL ALF,ALF MOVE TO UPPER BYTE STA SEGNM+2 SET UP SEGMENT NAME ISZ SGNAM LDB ASGNM JMP SGNAM,I RETURN * * SPC 1 * *********************** * * EXIT FROM ASSEMBLER * * *********************** ABORT LDA MXEND SET UP END MESSAGE FOR EOF ABORT LDB MXEND+1 JSB MESSX GO PRINT KESSAGE JMP ASMEX GO TO COMPLETION MXEND ASC 2,XEND * ASMBX LDA BINFL GET BINARY FLAG SZA,RSS SET? JMP XRFSC NO, THEN SEE IF XREF TO BE SCHEDULED LDA AFLAG YES SZA ABSOLUTE ASSEMBLY? JMP EOFAB YES, CLOSE ABSOLUTE OUTPUT FILE JSB EOF.C WRITE EOF ON RELOCATABLE OUTPUT FILE DEF C.BIN BINARY RELOC. FILE FCB BINER CLB,INB,RSS ERROR RETURN JMP XRFSC JMP ?FMPE DISPLAY ERROR * EOFAB JSB EOF.C WRITE EOF ON ABSOLUTE OUTPUT FILE DEF C.BIA ABSOLUTE OUTPUT FILE FCB JMP BINER * XRFSC LDA CFLAG CROSS-REFERENCE TABLE REQUESED? SZA,RSS JMP EOFLS NO, THEN WRITE EOF ON LIST FILE CLA,INA SET FLAG FOR SEGMENT D STA ?ENFL TO INDICATE SCHEDULE XREF CLA JMP SEGMT USE SEGMENT D * EOFLS JSB EOF.C WRITE EOF RECORD ON LIST FILE DEF C.LST CLA,RSS JMP ASMEX JMP ?FMPE * ASMEX LDA BLNS LDB BLNS SEND $END MESSAGE JSB MESSX LDA ERRCN ERROR COUNT STA TEMP SEND PARM BACK JSB END.C DEF TEMP BUFFER LOC ٞ DEF .1 1 PARAMETER BEING PASSED BACK JMP *-3 IF ERROR RETURN TRY TO END ASMB AGAIN * * .8 DEC 8 B60 OCT 60 ?ENFL NOP * SKP * ********************************************* * * OPLK: OPCODE TABLE LOOKUP - WALDY HACCOU * * * CALLING SEQUENCE: L JSB OPLK,I * * * L+1 ERROR RETURN * * * L+2 NORMAL RETURN * * * OUTPUT VALUES: VALUE IN A REG. AND 'CODE'* * * INSTR.FORMAT IN B AND 'INST'* * ********************************************* DOPL DEF TEMP+5 DEF OPT LOC'N OF OPCODE TABLE OPLK NOP JSB BPKUP GET OPCODE POSN STB SCN1+1 CLA STA TEMP+6 CLEAR TEMP+6 STA MFLAG CLEAR SUPPLEMENTAL TABLE FLAG LDA 1 B REG TO A REG JSB GETA GET OPCODE ADDRESS STB OPLMV LDA .3 LDB DOPL L(TEMP+5) JSB MOVE OPLMV NOP MOVE ORIGIN HERE LDB DOPL+1 L(OPCODE TABLE) OPLGO LDA 1,I GET NEXT ENTRY INB CPA TEMP+5 CHECK 1ST 2 CHARS. JMP K J ADB .2 LDA 1,I SZA END OF TABLE? JMP OPLGO NO-PICK UP NEXT ENTRY LDA MFLAG YES- SZA REACHED END OF SUPPL. TABLE? JMP OPMIC YES-CHECK FOR 'MIC' LDB ?NDOP NO-SET POINTER TO TABLE STB MFLAG SET SUPPLEMENTAL TABLE FLAG CPB ?LWA ANY ENTRIES IN SUPPLEMENTAL TABLE? JMP OPMIC NO--INVALID OPCODE; CHECK 'MIC'. JMP OPLGO GO TO CHECK NEXT ENTRY OPMIC LDA CODE GET OPCODE I.D. NO. CPA B100 CODE =100B (MIC)? JMP OPLK,I YES-O.K., RETURN. * * * ERROR EXIT HERE * * LDA .OP 'OP' OPCODE ERROR JSB ERPR CLA FORCE A 'NOP' FOR STA INST INVALID OPCODE'S INSTRUCTION. JMP OPLK,I EXIT HERE ON 'OP' ERJROR K LDA 1,I CHECK LAST CHAR OF OPCODE AND UMSK CPA TEMP+6 COMPARE IT JMP *+2 OPCODE FOUND ,SKIP JMP J NOT FOUND, TRY NEXT ENTRY LDA 1,I AND LMASK SET 'A' = OPCODE TYPE INB LDB 1,I STB INST = INSTRUCTION FORMAT STA CODE = VALUE OF CODE ISZ OPLK JMP OPLK,I EXIT ALPHA+2 * MFLAG NOP SUPPLEMENTAL-OPCODE-TABLE FLAG B100 OCT 100 * SKP * ****************************************************** * * EVALUATE OPERAND; TEST/PROCESS 'C' OR 'I' MODIFIER * * ****************************************************** * CLER DEF RELC START OF 5 WORD CLEAR AREA CHOP NOP * * * ON ENTRY A = MODIF.PARAMETER (I,C,0=NONE,2=ASC) * * * B= MASK NECESSARY FOR I OR C MODIFIER * * STA FLAG STB FLAQ SPC 1 * * CLEAR CHOP PARAMS IN T, RELC, SIGN, SUMP & TERM.. * LDA .5 LDB CLER START OF CLEAR AREA JSB SETM ZERO NOP TO SET MEMORY TO ZERO STA XORD INITIALIZE XORD =0. STA EMASY CLEAR FLAG FOR EMA SYMBL LOOKED UP IN SYMBL TBL ISZ SIGN SET SIGN = + (+1=+,-1=-) LDA SCN1+2 OPER.POSN. STA PNTR SZA,RSS JMP HD22 ERROR**NO OPERAND * * * GET THE 1ST CHARACTER * JSB GETC CPA L+3 PLUS? JMP HD34 YES CPA L+5 MINUS? JMP HD32 YES JMP HD35 NO * * * PROCESS AN ASTERISK '*' * HD26 CLA,INA SET A=1 CPA SYMP IS THE '*' ALONE? RSS YES - GOOD JMP HD22 NO - IT'S AN ERROR ADA ?BASF SET A = CURRENT RELOCATION TYPE. LDB AFLAG GET ABS. ASSMBL. FLAG SZB IS THIS AN ABS. ASSEMBLY? CLA YES, CLEAR A(WILL BE RELOC. BIT) LDB PLCN PROG LOCN CNTR TO B REG STB SAVB SAVE PLCN VALUE-TEMPORARILY. JMP HD50A * * * CHOP LOOP PROCESSING HERE * HD30 LDA PEEK CPA L+4 TEST PEEK FOR A JMP HD36 COMMA, GO TO TEST MODIFIERS CPA BLNK JMP HD40 =BLNK CLB,INB SET 'SIGN' FOR + CPA L+3 PLUS? RSS YES * * * PROCESS SIGNS HERE * HD32 CCB SET 'SIGN' FOR - STB SIGN (HD32+1) HD34 ISZ PNTR * * * PICK UP NEXT SET OF CHARS.IN BUFFER * HD35 JSB BPKUP GET POSN OF NXT NON-BLNK CHAR.HD32+3 STA PEEK STB PASCN SAVE PNTR FOR ASCN RTN JSB MSYMS MEAS.SYMBOL, SET SYMP/SYMN ADA PNTR STA PNTR * * * TEST FOR NUMERIC OR SYMBOLIC SET * LDA PEEK FIRST CHAR OF SET TO A FOR TESTING LDB TEST STB PEEK SAVE CHAR.FOR LATER TEST CPA L+2 ASTERISK? JMP HD26 TO '*' PROC ADA .M58 -58 SSA,RSS TEST FOR SYMBOLIC TERM JMP HD50 PROCESS THE SYMBOL ADA .10 (10) SSA JMP HD50 PROCESS THE SYMBOL * * * PROCESS NUMERIC SET HERE * LDB SYMP ADB .M1 LDA LAST IS B LAST - CPA .B CHARACTER? JMP *+2 * * SET B REG FOR ASCN ROUTINE ADB .401B LDA PASCN JSB ASCN TO AXCII CONVERSION TO BINARY JMP CHOP,I ERROR EXIT FROM ASCII CONV. JMP HD61+1 A REG CONTAINS THE VALUE * * * TEST INFORMATION FOLLOWING COMMA, IF LEGAL * * -USES FLAG AND FLAQ * * -IF C OR I, SET CORRECT BIT IN INSTRUC. USING FLAQ AS MASK * HD36 LDB FLAG SZB,RSS IS COMMA LEGAL JMP HD37 -NO- ERROR CPB .2 'ASC'? JMP HD40 -YES- ISZ PNTR POINT TO CHAR.FOLLOWING COMMA JSB BPKUP SEARCH FOR NON-BLANK JSB MSYM MEASURE SYMBOL CPA .1 1 CHAR SYMBOL? JMP HD43 YES *  * NO - ERROR HD37 JSB OPERR OPERAND ERROR JMP HD40 HD43 LDA TEST CPA BLNK BLANK TERMINATOR? JMP *+2 -YES- JMP HD37 -NO- ERROR LDA LAST CHAR TO A CPA FLAG =I/C? RSS YES, O.K. JMP HD37 ERROR: NOT 'I' OR 'C' MODIFIER! LDA INST IOR FLAQ SET I OR C BIT STA INST LDA CODE CPA L+2 STF OR CLF? (52) JMP HD37 -YES- ERROR * * * CHOP TERMINATION PROCESSOR * * HD40 CLA INITIALIZE THE STA SIGN OFFSET FLAG TO ZERO. LDA RELC A=RELOCATION CODE LDB CODE B=INSTRUCTION I.D. SZA ABSOLUTE OPERAND? JMP RELOC NO, CHECK RELOCATABLE. HD40A LDA SUMP YES, GET OPERAND VALUE. SSA NEGATIVE? CPB .17 YES. IS IT ABS (21B)? JMP HD42 YES-OK- CPB .32B NO. IS IT RPL (32B)? JMP HD42 YES-OK- JMP HD22 NO. *ERROR* * * * VALUE IS RELOCATABLE, TEST FOR VALIDITY * * RELOC LDA T IS RELOC. NUMBER SZA CANCELLED? JMP HD40B NO. CHECK FOR LEGAL RELOC. STA RELC YES, SET RELOCATION CODE =0. JMP HD40A GO TO CHECK FOR NEGATIVE OPERAND. HD40B CPA .1 LEGAL RELOC? (+1) RSS -YES- SKIP JMP HD22 NO,ERROR. CPB .1 ORG? JMP E -YES * * * CHECK: EQU,END,ORG,DEF,HED,& I/O EXT * * ADB .M11 -11 SSB CODE <13B? JMP HD22 YES, ERROR ADB .M6 SSB CODE > 20B ? JMP E NO. CHECK FOR EXTERNAL. ADB .M27B YES. CODE LESS THAN SSB 50B ? JMP HD22 YES. ERROR: NOT I/O! ADB .M3 CODE GREATER THAN SSB,RSS 52B ? JMP HD22 YES. ERROR: NOT I/O! CLB FORCE ERROR IF NON-EXT I/O. E  LDA RELC GET RELOC. CODE. CPA .4 EXTERNAL ? JMP HD41 YES. CHECK VALIDITY. LDA SUMP GET VALUE OF OPERAND. SSA,RSS ERROR, IF NEGATIVE. SZB,RSS RELOC. VALID FOR THIS OPCODE? JMP HD22 NO. * 'M' ERROR * JMP HD42 VALID RELOC. GO TO FINISH. * * * TEST FOR EXT W/OFFSET; SET SIGN & OFFSET VALUE * * HD41 LDA TERM GET NUMBER OF OPERAND TERMS. CPA .1 SINGLE EXTERNAL REFERENCE ? JMP HD42 YES, NO MORE CHECKING NEEDED. ADB .6 (6) TEST FOR EQU. SZB,RSS EQU TO EXTERNAL, WITH OFFSET ? JMP HD22 YES, *ERROR* LDA SUMP GET COMBINED OPERAND VALUE. LDB XORD GET EXTERNAL ORDINAL NUMBER. STB SIGN SET OFFSET FLAG = EXT ORDINAL #. CMB,INB NEGATE ORDINAL VALUE. ADA B SUBTRACT EXTERNAL ORDINAL VALUE. STA SUMP SAVE OFFSET VALUE. * * * NORMAL EXIT FROM CHOP, HERE * * HD42 LDA RELC RELOCATION CODE IN (A) AND LDB SUMP SUM IN (B) ON EXIT. ISZ CHOP JMP CHOP,I EXIT ALPHA+2 * * *CHOP ERROR EXIT* * HD22 LDA .MBLN 'M' FOR M TERM ERROR JSB ERPR ERROR PRINT CLA CLEAR THE STA SIGN OFFSET FLAG. JMP CHOP,I EXIT ALPHA+1 * * * PROCESS SYMBOLIC TERM HERE * * HD50 JSB SYMK GO TO SYMBOL TABLE LOOKUP JMP HD6 ERR0R STB SAVB SAVE VALUE FOUND IN B. LDB FLEX GET FIRST WORD OF SYMBOL ENTRY. SSB,RSS IS THE UNDEFINED BIT SET? JMP HD50A NO BLF YES, THEN IS 'E' BIT SET? SSB JMP HD6 YES, THEN THIS IS AN UNDEFINED 'ENT' CCB SET FLAG TO INDICATE SYMBOL STB EMASY JUST LOOKED UP WAS AN EMA HD50A AND .7 TYPE MASK SZA,RSS RELOCATABLE TYPE? JMP HD61 NO, ABSOLUTE. * SKP * ]* * TEST FOR EXTERNAL EQU (RELC=5) * CPA .5 RELOC=5? LDA .4 YES, SET FOR 4 * * * TEST FOR REPLACEMENT CODE SYMBOL (RELC=6) * * LDB CODE GET OPCODE I.D. CPA .6 REPLACEMENT CODE SYMBOL? CPB .32B YES, IS CODE RPL? RSS YES, CONTINUE. JMP HD22 NO, ERROR LDB RELC GET OPERAND RELOC. CODE SZB,RSS FIRST SYMBOL ENCOUNTERED? STA RELC YES, SET OPERAND RELOC. CODE CPA RELC NO,TEST FOR SAME RELOC.TYPE CPB .4 SAME. ANOTHER EXTERNAL ? JMP HD22 *ERROR* DIFFERENT OR 2 EXT'S. LDB SAVB GET SYMBOL'S VALUE. CPA .4 IF SYMBOL IS AN EXTERNAL, STB XORD SAVE THE ORDINAL NUMBER. * * *UPDATE SIGN SAVER * LDB SIGN COMPUTE ALGEBRAIC RUNNING SUM ADB T OF SYMBOLIC TERM'S SIGNS. STB T END RESULT=0/+1,ELSE 'M' ERROR. HD61 LDA SAVB VALUETO A ISZ TERM UPDATE NO OF TERMS LDB SIGN SSB IS SIGN NEGATIVE? CMA,INA -YES- COMPLEMENT ADA SUMP -UPDATE RUNNING SUM STA SUMP JMP HD30 * * * UNDEFINED SYMBOL EXIT * * HD6 LDA .UN 'UN' UNDEFINED SYMBOL JMP HD22+1 TO ERPR .M11 DEC -11 .M27B OCT -27 .401B OCT 401 .32B OCT 32 .50 DEC 50 .M58 DEC -58 XORD NOP TEMP. STORAGE: EXTERNAL ORDN'L NO. EMASY NOP FLAG FOR EMA SYMBOL FOUND IN SYMBL TABLE .40 DEC 40 * SKP * ******************** * * READ A STATEMENT * * ******************** RSTA NOP JSB IFBRK DEF *+1 SSA,RSS BREAK FLAG SET? JMP CNTRD CONTINUE TO READD CLA YES, CLEAR CROSS-REFERENCE FLAG STA CFLAG JMP ASMBX TERMINATE ASSEMBLER CNTRD LDA REP SZA,RSS ARE WE REPEATING A STATE? JMP NLHRXT NO - ISZ REP YES, ARE WE DONE? JMP RZP NO RXT LDB FBOI LDA .50 FOR 50 WORDS JSB SETM SET I/O BUFF TO BLANKS BLNS ASC 1, RXC JSB RED.C GO READ A STATEMENT DEF C.SOR SOURCE FILE FCB FFUB DEF BUFF READ BUFFER DEF .40 40 WORDS INPUT JMP REDER READ ERROR CPB .M1 EOF RETURN? JMP ABORT EOF RETURN - NOT POSSIBLE BLS CONVERT # OF WORDS TRANSMISSION LOG TO STB SCN1 # OF CHARS - SAVE COUNT CMB,INB STB PNTR SAVE NEG. CHAR COUNT LDB SCN1 SZB,RSS END OF TAPE? (B=0?) JMP TAPN YES - GO SET PARAMETERS ISZ SEQN BUMP SEQ.NO. CLB,INB 1 TO B STB PNTR SET PNTR = 1 ADB SCN1 GET TOATL LENGTH * * SET CHARS FOLLOWING STATE.TO BLANKS * ~N BRS ADB FFUB LDA BLNS STA 1,I RXL CLA (ENTER FOR REP PROCESSOR) STA BYFLG CLR PUNCH BYTE FLAG STA SCN1+3 STA TEST STA SIGN CLR EXT W/OFFSET FLAG. ISZ ASM1 CONTROL STATE.? JMP CHKLB NO.. LDA .5 YES, SET LIST CODE JSB LIST CLA,INA SET A = 1 STA TAPE SET TAPE COUNT = 1, IN CASE OF ? JMP RSTA,I EXIT * REDER CCB JMP ?FMPE DISPLAY FMP ERROR * * * CHECK LABEL AREA * CHKLB JSB PKUP PICK UP NEXT CHAR; BUMP PNTR CPA L+2 *? JMP HI24 -YES- * * * IS LABEL PRESENT? * CPA BLNK LABEL PRESENT ? JMP HS50 NO. GO TO PROCESS OPCODE. CLB =0: SYMTS LABEL CHECK. JSB SYMTS GO TO CHECK FOR VALID LABEL. NOP ERRORS ALREADY NOTED; CONTINUE SCANNING. JMP HS49 GO TO LABEL POST-PROCESSOR. * * SYMTS - TEST FOR VALID CHARACTERS IN A LABEL/SYMBOL * * ENTER: CHAR. IN LOW & 'TEST';=0:LABEL OR NEG. CHAR. CNT.:OPERAND. * EXIT: P+1 INVALID (SY ERROR PRINTED); P+2 VALID; & MEANINGLESS. * SYMTS NOP STB SCNT SAVE NEGATIVE CHARACTER COUNT. JSB LBL GO TO TEST FOR ILLEGAL CHARACTER, LDA TEST GET CHAR.; TEST FOR NUMERIC 1RST CHAR. ADA .M48 SUBTRACT 60B (ASCII '0'). SSA FIRST CHARACTER <60B ? JMP HS20 YES - O.K. - GO GET NEXT CHARACTER. ADA .M15 NO. SUBTRACT 17B. SSA FIRST CHARACTER >= 77B (ASCII '?') ? JMP LBLER NO--ILLEGAL FIRST CHARACTER! HS20 JSB PKUP GET NEXT CHARACTER. CPA BLNK END OF LABEL (SYMBOL TERMINATOR) ? JMP SYMEX YES, GO TO COMPLETION. JSB LBL NO. GO TO TEST VALIDITY OF THIS CHAR. JMP HS20 GO TO GET THE NEXT CHARACTER. * SYMEX LDA SERR GET INVALID CHARACTER FLAG. SZA,RSS ANY INVALID CHARACTERS ? ISZ SYMTS NO. SET RETURN TO P+2. CLA CLEAR INVALID CHARACTER FLAG. STA SERR FOR NEXT USER. JMP SYMTS,I RETURN: P+1-ERROR; P+2-VALID SYMBOL. * * * TEST FOR ILLEGAL CHAR. IN SYMBOL * * * THEY ARE ' ( ) * + , - * * LBL NOP ADA .M46 SUBTRACT 56B (ASCII '.') SSA,RSS GREATER THAN 55B ? JMP LBLEX YES-O.K. ADA .7 NO. ADD BACK 7B. SSA LESS THAN 47B (ASCII ' ) ? JMP LBLEX YES-O.K. LBLER LDA SERR GET ERROR FLAG. SZA ANY PREVIOUS ERRORS, THIS SYMBOL ? JMP LBLEX YES, AVOID ADDITIONAL ERROR MESSAGES. LDA .SY NO. GET 'SY' - ILLEGAL SYMBOL INDICATOR. JSB ERPR GO TO PRINT THE ERROR MESSAGE. ISZ SERR SET ILLEGAL CHARACTER FLAG. LBLEX ISZ SCNT DECREMENT COUNT. ALL CHARACTERS CHECKED? JMP LBL,I NO. GO BACK FOR MORE. JMP SYMEX YES, GO TO COMPLETION. * SCNT NOP NEGATIVE CHARACTER COUNT FOR 'SYMTS'. SERR NOP ILLEGAL CHAR. FLAG (0=OK;1=INVALID CHAR.) * * * 'REP' PROCESSING * RZP ISZ REQ 1ST REP PASS? JMP RXT YES,READ STATEMENT CCA STA REQ SET REQ = -1 CLA,INA STA PNTR SET PNTR=1 JMP RXL * * * LABEL POST-PROCESSOR * * HS49 LDA PNTR ADA .M2 (-2) SET LABEL LENGTH STA SCN1+3 * * * PROCESS OPCODE * * HS50 JSB OPLK SEARCH FOR OPCODE JMP HSERR ERROR EXIT HS51 JSB PKUP GET NEXT CHAR (_*+5) CPA BLNK BLANK? JMP HS52 YES? CPA L+4 COMMA? JSB BPKUP YES-GET NEXT NON-BLANK JMP HS51 GET NEXT CHAR. * * * TEST FOR OPCODE LENGTH LEGAL * HS52 LDB PNTR CMB,INB (POINTS TO BLNK FOLLOWING OPCODE) ADB SCN1+1 CPB .M4 (-4) JMaP HS54 LENGTH OK (=3) LDA CODE ADA .M48 CODE-60B SSA,RSS MICRO-OP ? JMP HS54 YES * * * ERROR PROCESSOR FOR OPCODE * LDA .OP 'OP'= OPCODE HAS TOO MANY CHARS. JSB ERPR HSERR LDA ASM1 LDB IFUSE CPB .1 SKIP CODE BECAUSE OF IFZ/IFN? JMP IFPRN YES - GO PRINT THE STATEMENT. SSA IS THIS AN INITIAL READ REQUEST? JMP HI24 -IT'S FROM INIT, SKIP OUTPUT BELOW. LDA PASS SZA,RSS JSB ?LABE INSERT LABEL FOR OPCODE ERROR JSB LOUT TO BREC JSB LIST ISZ PLCN BUMP LOCN.CNTR JMP RXT READ NEXT STATE. HI24 LDA .3 (3) REMARK PROC. JSB LIST JMP RXT READ NEXT STATEMENT * * * PICK UP OPERAND LOCN, THEN EXIT * * HS54 LDB CODE CPB .31B IS THIS IFZ/IFN/XIF? JMP IFZN YES LDA IFUSE GET 'IF' USE FLAG CPA .1 SKIP ASSEMBLING? CPB .12 IS IT AN 'END'? RSS YES - DON'T SKIP IT JMP HI24+1 GO ON AND PRINT THE STATEMENT JSB BPKUP GO SKIP BLANKS IF NECESSARY. ADB .M81 (-81) TEST FOR PNTR< 81 CLA SET A=0 STA LTFLG CLEAR LITERAL FLAG SSB SKIP IF FIELD OUT OF RANGE LDA PNTR PNTR TO A STA SCN1+2 OPERND POSN SZA OPERAND PRESENT? * * * TEST FOR LITERAL * JSB PKUP YES - GET 1ST CHAR. LDB AFLAG GET FLAG FOR 'ABS' TEST CPA EQ IS THE OPERAND A LITERAL? SZB YES, BUT EXIT IF ABSOLUTE ASS'Y. JMP RSTA,I NO EXIT FROM READER HERE. JSB PKUP GET THE LITERAL TYPE, NOW. LDB SCN1+2 GET OPERAND PNTR ADB .2 ADD 2 STA LTFLG SET LIT.FLAG(=LITERAL TYPE) LDA CODE * NOW CHECK FOR LEGAL LITERAL * CPA .6 ARITHMETIC MACRO? STB SCN1+2 YES, SET OPyERAND POINTER. CPA .14 MEMORY REFERENCE? STB SCN1+2 YES, SET OPERAND POINTER. CPA .26B MPY/DIV/DLD/DST ? STB SCN1+2 YES, SET OPERAND POINTER. CMA,INA NEGATE OPCODE I.D. NO. ADA .A (101B) SSA OPCODE >100B ? STB SCN1+2 RESET POINTER TO LITERAL VAALUE. JMP RSTA,I EXIT FROM RSTA HERE .26B OCT 26 * SPC 2 * * PROCESS 'IFZ', 'IFN', OR 'XIF' CODES..* SPC 1 IFZN LDA INST GET INSTR.FORMAT(HAS IF CHAR IN) CLB SZA,RSS IS INST = 0? (IS IT XIF) ? JMP IFZN3 YES CPB IFUSE IFUSE = 0? JMP IFZN2 YES - GO ON WITH PROCESSING IFZNR LDA IF NO, ERROR, WE'RE IN IF OR REP JSB ERPR PRINT 'IF' ERROR JMP IFZN3+1 YES, GO ON WITH PROGRAM IFZN2 CLB,INB SET B = 1 CPA IFTST IS 'IF' CHARACTER MATCHED? CMB,INB YES - SET B = -1 IFZN3 STB IFUSE SET 'IFUSE' FLAG CLB CPB REP IN RANGE OF A REPEAT? JMP IFPRN NO - OK STB REP YES - CLEAR 'REP' FLAG JMP IFZNR GO PRINT ERROR DIAG. IFPRN CLA,INA SET UP FOR NO INST, NO LOC'N PRNT JMP HI24+1 GO TO LIST AND CONTINUE SPC 1 IF ASC 1,IF ERROR IN IFZ OR IFN EQ OCT 75 EQUAL SIGN(=) .31B OCT 31 =IFZ,IFN,XIF TYPE .M80 DEC -80 .M46 DEC -46 .M81 DEC -81 ASM1 OCT -1 CONTROL STATE.FLAG .SY ASC 1,SY HEDR DEF HEADP UMSK OCT 177400 MASK FOR UPPER CHARACTER LMASK OCT 377 MASK FOR LOWER CHARACTER TAPE OCT 1 COUNT SOURCE TAPES SPC 1 * * SET SEQN TO ZERO, BUMP AND CONVERT SEQN. NO. * SPC 1 TAPN STB SEQN SET SEQ. NO. TO ZERO ISZ TAPE ADD 1 TO TAPE # LDA TAPE CCE CONVERT TO ASCII JSB BNCN CONVERT TO ASCII OCTAL LDA ASCI+2 STA ASCI+4 STORE IT INTO THE HEADER JMP RXC * SKP 1* * * TEST FOR LABEL PRESENT AND INSERT IN SYMBOL TABLE * * SET CORRECT RELOC.CODE BEFORE INSERTION. * ?LABE NOP LDA SCN1+3 GET LABEL LENGTH SZA,RSS LABEL PRESENT ? JMP ?LABE,I NO, DONE, EXIT.. STA SYMP SET CHAR COUNT LDB FFUB STB SYMP+1 SET LABEL ADDR. LDB LTFLG STB FLAQ SAVE LTFLG CLA STA LTFLG LTFLG_0 LDA AFLAG SZA IS THIS AN ABSOLUTE ASSEMBLY? JMP LABEX YES CLA,INA SET A = 1 LDB ?BASF SZB IN BASE PAGE ? INA YES, SET A = 2 LDB PLCN JSB ?INSR INSERT LABEL INTO SYMBOL TABLE NOP ERROR EXIT LDB FLAQ STB LTFLG RESTORE LTFLG JMP ?LABE,I EXIT LABEX JSB ?INS? GO TO INSERT RTN IN ASMB3 NOP ERROR EXIT JMP ?LABE,I EXIT * SKP * ************************************** * * MOVE: MOVES A STRING OF CHARACTERS * * * LINKAGE: A = NO.OF CHARS TO MOVE * * * B = DESTINATION ADDRESS * * * L JSB MOVE,I * * * L+1 SOURCE ADDRESS * * * L+2 RETURN * * * ADDR.TRUE IF STARTS ON LEFT * * * 2'S COMPL.IF STARTS ON RIGHT * * ************************************** MOVE NOP SZA IS CHAR.COUNT = 0? JMP MOVE1 NO JSB OPERR YES JMP MOVX MOVE1 CMA,INA STA GTEM+3 =-A * * SET UP DESTINATION CLE,SSB CMB,CCE,INB ELB STB GTEM+1 LDB MOVE,I GET SOURCE ADDRESS * * SET UP SOURCE CLE,SSB CMB,CCE,INB ELB STB GTEM+2 * * NOW MOVE THE CHARACTERS * $ LDB GTEM+2 CLE,ERB E_BIT #0 LDA 1,I B,I TO A SEZ,RSS / E=0? ALF,ALF ROTATE . AND LMASK MASK OUT UPPER 8 BITS * * LOWER 8 BITS OF A CONTAINS CHAR.TO BE MOVED.* STA GTEM LDB GTEM+1 DEST TO B CLE,ERB E_BIT #0 LDA 1,I B,I TO A SEZ,RSS E=0? ALF,ALF ROTATE AND UMSK IOR GTEM * * CHAR.NOW IN A, WITH OTHER HALF OF DEST.WORD.* * * SINCE IT'S ON RIGHT WE MAY HAVE TO ROTATE * SEZ,RSS E=0? ALF,ALF ROTATE STA 1,I A TO B,I * * NOW IT'S IN OK, BUMP COUNTERS AND PROCEED * ISZ GTEM+2 ISZ GTEM+1 ISZ GTEM+3 JMP $ MOVX ISZ MOVE JMP MOVE,I RETURN TO L+2 OF LINKAGE * * * ********************************************* * * SYMK: LOOKUP SYMBOL TABLE ENTRY; W HACCOU * * * LINKAGE: INPUT; SYMP=NO CHARS;SYMN=FWA * * * OF NAME..OUTPUT;A=TYPE,B=VALUE* * * L JSB SYMK,I * * * L+1 UNDEF.SYMBOL EXIT * * * L+2 NORMAL RETN * * ********************************************* SYMK NOP CLA INITIALIZE NAME(4), STA NAME 0 TO 1ST, BLANKS TO LDA BLNS OTHER WORDS STA NAME+1 STA NAME+2 LDA SYMP NO.OF CHARS ADA .M6 (-6) SSA JMP SYMK1 * * * SYMBOL TOO LONG, PRINT DIAG.; SET LENGTH = 5 * * LDA .SY 'SY' TOO MANY CHARS IN SYMBOL JSB ERPR LDA .5 STA SYMP SYMK1 LDA SYMP (FROM *-5) LDB SYMP+1 ADDR.OF 1ST CHAR. STB FCHMV LDB NAMI CMB,INB JSB MOVE FCHMV NOP (SET AT *-4) LDA SYMP NO.OF CHARS. ARS STORE NUMBER OF INA WORDS IN ENTRY-1 STA TEMP+2 INTO TEMP+2 INA STA TEMP+3 AND TEMP+3 ALF,ALF ALF ADA NAME£ SET NUMBER OF WORDS STA NAME TO COMPARE FIRST WORDS LDB X IN THE LP2 LDA B,I CONTENTS OF START OF NEXT ENTRY IN SYMB. TBL SZA,RSS JMP SYMK5 UNDEFINED EXIT FROM HERE AND SMASK 70377B CPA NAME COMPARE 1ST WORDS JMP LP5 ALF AND .15 (17B)MASK NO.WRDS IN ENTRY ADB A LP3 JMP LP2 LP5 STB SYMI STB TEMP+4 LDA B,I STA FLEX LDA NAMI STA SALU LDA TEMP+2 (FROM *-6) ADA SYMI SET LIMIT=LWA-1 STA VAL0 OF SYMTAB ENTRY LP6 ISZ SYMI BUMP ADDR CNTR (FROM *+7) LDA SYMI CPA VAL0 END OF ENTRY? JMP LP7 YES ISZ SALU NO LDA SYMI,I COMPARE NEXT 2 CHARS. CPA SALU,I JMP LP6 EQUAL; COMPARE NEXT TWO. LP4 LDB TEMP+3 ADB TEMP+4 SET FWA OF NEXT ENTRY JMP LP3 CHK NXT SYMTAB ENTRY LP7 LDA FLEX GET 1ST ENTRY WRD (FROM *-8) ALF,ALF AND .15 (17B) LDB LTFLG SZB,RSS LITERAL IN OPERAND? JMP LP8 NO CPB .1 ARITH MACRO WITH LITERAL? JMP LP8 YES CPA .7 RELC=7? JMP LP9 YES, DONE. JMP LP4 NO, GO BACK LP8 CPA .7 LITERAL? JMP LP4 YES, GO BACK(OPERAND IS'NT LITERAL) LP9 LDB SYMI,I B=VALUE ISZ SYMK JMP SYMK,I EXIT ALPHA+2 HERE * SYMK5 STB SYMI UNDEFINED SYMBOL STB TEMP+4 LDA B,I STA FLEX LDA NAMI STA SALU JMP SYMK,I RETURN TO L+1 * SMASK OCT 70377 .400B OCT 400 .M16 DEC -16 .M48 DEC -48 SALU NOP TEMPORARY FOR NAME ADDR. COUNTER * SKP * ************************* * * PUNCH A BINARY RECORD * * ************************* PNCH NOP LDB BINFL BINARY OUTPUT FILE EXISTS? SZB,RSS JMP PNCHX NO - EXIT * * * COMքPUTE CHECKSUM * * LDB FUBP = ADDRESS OF PUNCH BUFFER. LDA PBUF GET RECORD LENGTH. ALF,ALF POSITION TO LOWER BYTE. STA CNTB SAVE FOR 'EXEC' CALL. CMA,INA NEGATE WORD COUNT AND INA -1 (LENGTH NOT IN CK.SUM). STA GTEM STORE CHKSUM CNTR CLA CLEAR STA PBUF+2 CHECKSUM BUFFER-WORD. PNCH1 INB BUMP REC.ADDR. ADA 1,I ADD TO CHK SUM ISZ GTEM DONE? JMP PNCH1 -NO STA PBUF+2 -YES- STORE SUM * * * GO TO SYS PUNCH * * JSB WRT.C GO WRITE BIN RECORD DEF C.BIN BINARY OUTPUT FCB NAME FUBP DEF PBUF BUFFER NAME DEF CNTB WORD COUNT JMP *+2 ERROR JMP PNCHX NO ERROR CLB,INB INDICATE OUTPUT FILE JMP ?FMPE DISPLAY ERROR AND EXIT PNCHX CLA STA PBUF * * * EXIT HERE * * JMP PNCH,I * BINFL NOP SKP * SKP * ******************************************** * * ASCN - CONVERT AN ASCII NUMBER TO BINARY * * * -ENTRY: A CONTAINS POSITION OF 1ST CHAR. * * * B(LOWER) CONTAINS NO. OF CHARS. * * * B(UPPER): MODE(BELOW) * * * 0 = OCTAL * * * 1 = FIXED DECIMAL * * * 2 = FLOATING DECIMAL * * * 3 = 3 WORD FLOATING DECIMAL * * * 4 = 4 WORD FLOATING DECIMAL * * * -EXIT : L+1 = ERROR RETURN ON ILLEGAL * * * CHARACTER OR OVERFLOW. * * * L+2 = NORMAL RETURN * * * MODE=0 OR 1, VALUE IN A * * * MODE=2, VALUE IN A AND B * * * MODE=3, VALUE IN A, B AND VALU * * * MODE=4, VALUE IN A,B,VAL0 &VAL1 * * * NOTE: FOR MODES 2 AND 3 VALUES IN A ANDz * * * B ARE ALSO IN VAL0 AND VAL1 RESP. * * ******************************************** * * PROC ASCN(STRING,LENGTH,MODE); * VALUE STRING,LENGTH,MODE;INTEGER LENGTH,MODE;CHAR ARRAY STRING; * BEGIN * INITIALIZE_TEMPS; * IF MODE = 0 OR MODE = 1 THEN CONVERT_TO_INTEGER * ELSE CONVERT_TO_4_WORD_REAL; * CASE MODE *2: PACK_INTO_2_WORD_NUMBER; *3: PACK_INTO_3_WORD_NUMBER; *4: PACK_INTO_4_WORD_NUMBER; * ESAC; *END OF ASCN; * * PROC CONVERT_TO_4_WORD_REAL(STRING,LENGTH); * VALUE STRING,LENGTH;CHAR ARRAY STRING;INTEGER LENGTH; * BEGIN * INTEGER I. * INTEGER ARRAY ACC,VAL[0:3]; * FOR I := 0 TO 3 DO VAL[I] := 0 * FOR I := 0 TO LENGTH-1 DO * BEGIN * CNVT := CONVT(STRING,I); * MPY10(VAL,ACC); * IF NOT OVERFLOW THEN ADD4(ACC,CNVT); * END; ASCNP NOP ASCN EQU ASCNP STA SYMI CHAR POS. IN SYMI LDA LMSK AND 1 CMA,INA STA DCNT CHAR COUNT IN DCNT LDA 1 ALF,CLE,ALF POSITION THE MODE AND LMSK STA MODE SET MODE IN MODE ADA .M2 INTEGER CONVERSION? SSA,RSS JMP ASCN2 NO - GO TO FLOATING PT ROUTINE JSB INTEG GO TO INTEGER CONVERSION XNORM ISZ ASCNP SET UP FOR NORMAL RETURN JMP ASCNP,I EXIT * ***************************************** * * FLOATING POINT PROCESSING STARTS HERE * * ***************************************** ASCN2 CLA STA VAL0 CLEAR NUMBER SLOTS STA VAL1 STA VAL2 STA VAL3 STA DEXP CLEAR DEC. OVERFLOW SLOT CCA STA DSIG SET SIGN(-1) FIR + STA CNVT SET FLAG FOR SIGN IN 1ST POSN. LDA BIT15 STA DFCNT SET DFCNT = 100000B FDCN1 JSB CNVRT CONVERT A CHARACTER JMP FDCN3 NON DIGIT RETURN ISZ DFCNT BUMP FRAC. COUNT LDA DEXP SZA IF OVERFLOW THEN JMP DCOV GO TO DCOV JSB LODAC PROCESS DIGIT r JSB SHFTL ACC := ACC * 2; SSA IF OVERFLOW THEN GO TO DCOV; JMP DCOV JSB SHFTL ACC := ACC * 4; SSA IF OVERFLOW THEN GO TO DCOV JMP DCOV JSB ADD4 ACC := ACC * 5; SSA IF OVERFLOW THEN GO TO DCOV JMP DCOV SPC 2 JSB SHFTL ACC := ACC * 10; SSA IF OVERFLOW THEN GO TO DCOV JMP DCOV LDA ACC3 ACC := ACC + NEWDIGIT; ADA CNVT FINALLY ADD LATEST DIGIT TO NUM STA ACC3 SEZ,RSS IF NOT CARRY THEN GO TO FDCN6 JMP FDCN6 ISZ ACC2 ELSE PORPAGATE CARRY JMP FDCN6 ISZ ACC1 JMP FDCN6 LDA ACC0 CLE,INA STA ACC0 SSA IF OVERFLOW THEN GO TO DCOV JMP DCOV FDCN6 JSB STACC CURRENT_VALUE := NEW_VALUE; FDCN7 ISZ DCNT IF(CHARS:=CHARS-1) # 0 THEN JMP FDCN1 GO TO FDCN1 JMP FDHOP ELSE GO TO FDHOP; FDCN3 CPA L+6 DEC PNT? (NON DIG.FROM CNVRT) JMP FDCN5 YES CPA .E 'E'? JMP *+3 YES ILEX LDA .IL NO, GO GET 'IL' JMP OVEX+1 GO TO ERROR DIAG EXIT ISZ DCNT LAST CHARACTER? JMP FDHOP NO - GO TO PROCESS EXPONENT FDCN5 LDA DFCNT SSA,RSS IS THIS A SECOND DEC.PNT? JMP ILEX YES CLA STA DFCNT CLEAR COUNTER FOR DIGITS AFTER . JMP FDCN7 DCOV ISZ DEXP OVERFLOWDIGITS := OVERFLOWDIGITS +1; JMP FDCN7 SPC 3 * ************************************* * * PROCESS EXPONENT, IF PRESENT, AND * * * FINISH THE NUMBER(NORMALIZE, ETC)* * ************************************* FDHOP LDB DFCNT CMB,SSB,INB,RSS WAS A DEC POINT PRESENT? CLB NO, CLEAR B ADB DEXP STB DEXP SET CURRENT COUNT FOR DEC EXPONENT LDA DSIG STA SDSIG SAVE SIGN OF MANTISSA CLA NO - CONTINUE PROCESSI3HNG LDB TEST CPB .E IS EXPONENT THERE? JSB INTEG YES - EVALUATE IT ADA DEXP A+OVERFLOW CHARS STA DEXP SET VALUE OF DECIMAL EXPONENT LDA VAL0 CHECK FOR A VALUE OF ZERO IOR VAL1 IOR VAL2 IOR VAL3 SZA,RSS IS THE VALUE=0? JMP UNDTF YES, NORMAL EXIT FROM ASCN RTN. LDA .63 BINARY_EXP := 63; STA FEXP FDHP2 JSB NRMLZ GO NORMALIZE THAT TURKEY JSB STACC LDA DEXP CLE,SZA,RSS JMP FDHPX DONE IF EXPONENT=0 SSA IS EXPONENT POSITIVE? JMP FDHP6 NO - GO TO DIVIDE BY 10 ADA .M1 YES - MULTIPLY NUMBER BY 10 HERE STA DEXP DEXP=DEXP-1 LDA .3 ADA FEXP STA FEXP FEXP=FEXP+3 JSB SHFTR SHIFT THE 4 WORD ACCUMULATOR JSB SHFTR -RIGHT 2 PLACES JSB ADD4 JMP FDHP2 GO BACK TO RE-NORMALIZE * * DIVIDE NUMBER IN VAL0,VAL1,VAL2 BY 10 * FDHP6 INA STA DEXP DEXP=DEXP+1 LDA .M2 ADA FEXP STA FEXP FEXP := FEXP + EXP(.1) +1; & -2 IF U CARE LDA PVAL STA WPVAL WPVAL := @VAL0; LDA UVAL STA CNVT FDHP7 CPA VSTOP LAST SECTION PROCESSED? JMP FDHP9 YES, GO FINISH UP * * DIVIDE 'A' BY 10 (MPY BY .1) * * RESULT IN A AND B LDA WPVAL,I CLB,CLE SLA,ERA A := VAL[I]/2 LDB TENTH IF ODD(VAL[I]) THEN STB CRYOT CRYOT := TENTH ELSE CRYOT := O MPY TENTH CLE,ELA ELB,CLE BA := VAL[I]*TENTH ADA CRYOT A := A+CRYOT THE REAL PRODUCT SEZ IF CARRY THEN CLE,INB B := B+1 STB CNVT,I SAVE MSB VALUE ISZ CNVT BUMP ADDRESS STA CNVT,I SAVE LSB VALUE ISZ WPVAL @VALUE := @VALUE+1; LDA CNVT ISZ CNVT JMP FDHP7 FDHP9 LDB .M7 SUM_AND_CARRY(DATASTACK,7,CARR5YOUT,ANSWER); CLA JSB SUMCY STA VAL3 LDB .M5 VAL2 := SUM_AND_CARRY(DATASTACK,5,CARRYOUT,ANSWER); LDA CRYOT JSB SUMCY STA VAL2 LDB .M3 VAL1 := SUM_AND_CARRY(DATASTACK,3,CARRYOUT,ANSWER); LDA CRYOT JSB SUMCY STA VAL1 LDA CRYOT VAL0 := CARRYOUT + DATASTACK[0]; ADA V320 STA VAL0 JSB LODAC ACC := CURRENT_VALUE. JMP FDHP2 GO RENORMALIZE AND CONTINUE * ****************************** * * SET UP FLTG DECIMAL RESULT * * * FOR EXIT FROM CONVERSION * * ****************************** FDHPX LDB MODE ADB PVAM1 STB WPVAL LDA B,I CLE ADA .200B ROUND THE LEAST SIGNIF. WORD AND UMSK MASK OF THE EXPONENT AREA RNDLP STA B,I SEZ,RSS IF NO CARRY THEN GO PACKITUP * SINCE THE NUMBER IS A POSITIVE NORMALIZED STRUCTURE * THE MSB'S WILL NEVER CARRY OUT THUS GARRENTEEING * TERMINATION OF THIS LOOP JMP PAKIT ADB .M1 LDA B,I PROPAGATE THE CARRY CLE,INA JMP RNDLP PAKIT JSB LODAC NORMALIZE IT ONE MORE TIME JSB NRMLZ JSB STACC ISZ SDSIG IS SIGN OF MANTISSA=+ JMP FDHR4 NO, GO PROCESS NEG. MANTISSA FDHRT LDA FEXP GET FRACTIONAL EXPONENT IN A/B LDB FEXP AND .1776 CLEAR LOWER 7 BITS SZA POSITIVE OVERFLOW? CPA .1776 MAYBE, NEG. OVERFLOW? CPB .1776 MAYBE, IS EXPON,=-200B? JMP FDHR3 YES, ALSO OTHER OVERFLOWS.. LDA FEXP GET THE EXPONENET AGAIN RAL POSITION IT AND LMSK CLEAR BITS 15-8 IOR WPVAL,I ADD IN THE LEAST SIG.PART STA WPVAL,I UNDTF LDA VAL0 GET WORD 1 LDB VAL1 GET WORD 2 JMP XNORM GO OUT THE NORMAL EXIT FDHR3 SSB,RSS IS IT REALLY AN UNDERFLOW? JMP OVEX NO CLA YES, SET NO. = ZERO STA VAL0 kNLH CLEAR VAL0 JMP UNDTF FDHR4 LDB WPVAL START GETTING COMPLEMENT LDA B,I CMA,CLE,INA COMLP STA B,I CMB,INB SUBTRACT 1 FROM B REG CMB WITHOUT DESTROYING THE E REG CPB PVAM1 IF DONE THEN GO CHECK FOR A POWER OF 2 JMP PWR2 LDA B,I CMA,SEZ CLE,INA JMP COMLP PWR2 CLE,ELA WAS N0. A POWER OF 2? SSA,RSS JMP FDHRT NO BUG OUT STA VAL0 PUT AWAY THE CORRECT FRACTION PART LDA FEXP ADA .M1 STA FEXP SUBTRACT 1 FROM EXPONENT. JMP FDHRT * ************************* SPC 3 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * PROC LODAC(VALUE) THE 4 WORD ACCUMULATOR IS LOADED WITH * THE CURRENT VALUE OF THE OPERAND * CALL JSB LOCAC * * IT IS ASSUMED THAT THE CURRENT VALUE IS * IN THE 4 WORD DATA STRUCTURE VAL0,VAL1,VAL2,VAL3 * * * ON EXIT THE LSB'S OF THE 4 WORD OBJECT ARE IN THE REGISTERS * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * #ONLODAC BSS 1 LDA VAL0 STA ACC0 LDA VAL1 STA ACC1 LDB VAL2 STB ACC2 LDA VAL3 STA ACC3 JMP LODAC,I SPC 2 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * PROC STACC(VALUE) THE 4 WORD ACCUMULATOR IS STORED IN THE * 4 WORD DATA STRUCTURE VAL0,VAL1,VAL2,VAL3 * * CALL: JSB STACC * * ON EXIT THE REGISTERS CONTAIN THE MSB'S OF THE DATA STRUCTURE * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * STACC BSS 1 LDA ACC3 STA VAL3 LDA ACC2 STA VAL2 LDA ACC1 STA VAL1 LDB ACC0 STB VAL0 JMP STACC,I SPC 3 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * PROC ADD4(ACC,VALUE); * ADD THE 2 4 WORD DATA STRUCTURES AND STORE THE ANSWER * IN THE 4 WORD ACCUMULATOR ACC * FOR I := 3 SPEP -1 UNTIL 0 DO * BEGIN * ACC[I] := ACC[I] + VALUE[I]; * IF CARRY THEN ACC[I-1] := ACC[I-1] + 1; * END; END OF ADD4; SPC 2 ADD4 BSS 1 LDA ACC3 CLE ADA VAL3 STA ACC3 LDA ACC2 SEZ CLE,INA ADA VAL2 STA ACC2 LDA ACC1 SEZ CLE,INA ADA VAL1 STA ACC1 LDA ACC0 SEZ CLE,INA ADA VAL0 STA ACC0 JMP ADD4,I * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * PROC SUM_AND_CARRY(DATASTACK,N,CARRYOUT,ANSWER); * VALUE N; INTEGER ANSWER,CARRYOUT;INTEGER ARRAY DATASTACK; * BEGIN * INTEGER I; * CARRYOUT := 0; * FOR I := 1 TO N DO * BEGIN * ANSWER := ANSWER + DATASTACK[I]; * IF CARRY THEN CARRYOUT := CARRYOUT + 1; * END; * END OF SUM_AND_CARRY; SPC 2 SUMCY BSS 1 * ON ENTRY A = ANSWER * B CONTAINS -N FOR THE FOR LOOP COUNTER * ALL OTHER REGISTERS ARE MEANINGLESS STB SCNTR CLB,CLE STB CRYOT LDB PV320 SUMLP ADA B,I SEZ,CLE ISZ CRYOT ISZ SCNTR  JMP SUMGO JMP SUMCY,I SUMGO INB JMP SUMLP * ON EXIT A = ANSWER; CRYOT = CARRYOUT; ALL OTHER REGS MEANINGLESS SPC 3 SHFTR BSS 1 LDA ACC0 CLE,ERA STA ACC0 LDA ACC1 ERA STA ACC1 LDA ACC2 ERA STA ACC2 LDA ACC3 ERA,CLE STA ACC3 JMP SHFTR,I * DATA STRUCTURE: * ACC ::= A FOUR WORD ACCUMULATOR * THE ROUTINE ASSUMES THAT THAT THE ACCUMULATOR HAS BEEN * LOADED * * CALLING SEQUENCE: * JSB SHFTL * * ON EXIT THE FOUR WORD VALUE HAS BEEN SHIFTED LEFT ONE * BIT AND E & O ARE SET PROPERLY FOR THE FOUR WORD SHIFT * A & B CONTAIN THE MOST SIGNIFICANT TWO WORDS * SHFTL BSS 1 LDA ACC3 CLE,ELA STA ACC3 LDA ACC2 ELA STA ACC2 LDA ACC1 ELA STA ACC1 LDA ACC0 ELA STA ACC0 JMP SHFTL,I * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * PROC NORMALIZE(ACC); * BEGIN THE 4 WORD ACCUMULATOR IS SHIFTED LEFT UNTIL THE * LEADING 1 REACHES THE SIGN BIT AND THEN THE ACC IS SHIFTED * ONE BIT BACK TO THE RIGHT, THUS LEAVING A NORMALIZE NUMBER * IN THE ACC. THE EXPONENT COUNT IS DECREMENTED FOR EACH * LEFT SHIFT AND INCREMENTED FOR EACH RIGHT SHIFT * ON EXIT BOTH THE ACC AND EXPONENT COUNT ARE CORRECT SPC 2 * WHILE NOT OVERFLOW DO SHIFT_LEFT; * SHIFT_RIGHT; * END OF NORMALIZE; SPC 2 NRMLZ BSS 1 LDA ACC0 SSA JMP RSHFT JSB SHFTL CCA ADA FEXP STA FEXP JMP NRMLZ+1 GO AROUND AGAIN RSHFT JSB SHFTR ISZ FEXP JMP NRMLZ,I JMP NRMLZ,I JUST IN CASE SPC 2 * ********************************** * * CNVRT - CONVERT AN ASCII CHAR. * * * TO BINARY. * * * - MODE = 0,OCTAL; ELSE DECIMAL * * * - L+1 RETURN IF NON-NUMBERIC * * *******************************<*** * CNVRT NOP LDA SYMI GET POS'N.OF CHARACTER JSB GETC GET CHARACTER ISZ SYMI BUMP POS'N LDB MODE SZB OCTAL CONVERSION? LDB .M2 NO - SET FOR DEC.CONV ADB .M8 B=-8 HERE, IF OCTAL CONVERSION ADA .M48 -60B + A SSA IS VALUE LESS THAN ZERO? JMP CNVR2 YES ADB 0 NO - ADD IN MAX DIGIT VALUE. SSB IS IT A VALID NUMBER? JMP CNVRX YES- GO TO EXIT WITH NO. IN A. CNVR2 LDA TEST NO - TEST FOR + OR - CPA L+3 PLUS? JMP CNVR4 YES CPA L+5 NO - IS IT MINUS ? CLA,RSS YES JMP CNVRT,I NO - TAKE L+1 EXIT STA DSIG CNVR4 CLA ISZ CNVT HAS SIGN BEEN ENCOUNTERED BEFOR? JMP ILEX YES- 'IL' EXIT FROM ASCN CNVRX STA CNVT ISZ CNVRT JMP CNVRT,I * SKP * ************************************** * * INTEG - CONVERT A STRING OF ASCII * * * CHARS TO AN OCTAL(MODE=0) * * * OR DECIMAL INTEGER. * * *-IF OTHER THAN A LEADING SIGN OR * * * NUMBER IS FOUND 'IL' EXIT IS TAKEN * * *-'OV' EXIT IF OVERFLOW. * * ************************************** INTEG NOP CCB STB DSIG SET SIGN FLAG FOR PLUS STB CNVT SET 1ST CHAR FLAG(FOR SIGN CHK) CLA INTG2 STA VALUS SAVE CURRENT VALUE JSB CNVRT CONVERT A CHARACTER JMP ILEX ERROR - NON NUMERIC LDA VALUS CLE,ELA JSB OVTST TEST 4 TIMES A FOR OVERFLOW LDB MODE NO OVERFLOW SZB MODE = OCTAL ADA VALUS NO - 5 TIMES A(IT'S DECIMAL) JSB OVTST TEST 8(OR 10) TIMES A FOR OV ADA CNVT NO - ADD IN NEW DIGIT SEZ OVERFLOW? JMP OVEX YES ISZ DCNT LAST CHAR IN STRING? 2JMP INTG2 NO - GET ANOTHER SZB,RSS MODE = OCTAL? JMP INTG6 YES - OK CPA BIT15 IS NO. + OR - 32768? JMP INTG6 YES - OK SSA IS SIGN NEG? JMP OVEX YES - OVERFLOW INTG6 ISZ DSIG IS SIGN NEGATIVE? CMA,INA YES - COMPLEMENT A. JMP INTEG,I EXIT * ****************************************** * * TEST ZERO BIT AND 'E' BIT FOR OVERFLOW * * ****************************************** OVTST NOP ELA 2 TIMES ENTRY VALUE OF 'A' SEZ,SLA,RSS OVERFLOW? JMP OVTST,I NO - RETURN OVEX LDA .OV GET 'OV' FOR ERROR DIAGNOSTIC. JSB ERPR JMP ASCNP,I LEAVE VIA RERROR EXIT * UVAL DEF V320 VSTOP DEF V320+7 ASCN HI ORDER BITS 8 WORD STOPPER FOR DIV BY 10 .M7 DEC -7 .63 DEC 63 SCNTR BSS 1 CRYOT BSS 1 ACC BSS 8 ACC0 EQU ACC ACC1 EQU ACC+1 ACC2 EQU ACC+2 ACC3 EQU ACC+3 V320 EQU ACC VALUS EQU ACC+4 PVAL DEF VAL0 PVAM1 DEF VAL0-1 PV320 EQU UVAL DVSOR EQU ACC+1 THE NUMBER BASE IN THE BNCN ROUTINE .1776 OCT 177600 177600 TENTH OCT 63146 THE CONSTANT FOR DIVIDING BY 10 ITS IRRATIONAL HONEY .200B OCT 200 THE FLOATING POINT ROUNDING CONSTANT SWEETY LMSK EQU LMASK .10 DEC 10 HERES TEN WHEN U NEED IT * ICSAP DBR ASCI+2 * ************************************** * * BINARY TO ASCII CONVERSION ROUTINE * * * A = NUMBER TO BE CONVERTED * * * E = 0 CONVERT TO OCTAL * * * E = 1 CONVERT TO DECIMAL * * ************************************** OCT 30060 PACKED ASCII '00'. BNCN BSS 1 LDB ICSAP GET LOC'N OF ACSI BUFFER STB SYMI LDB BNCN-1 SET BUFFER=ASCII ZERO'S STB ASCI STB ASCI+1 STB ASCI+2 LDB .8 SEZ TEST E BIT (=0,OCTAL =1,DECIMAL) ADB .2 STB DVSOR SET UP THE PROPER BASE FOR THE ALGORITHM{' BNCLP CLB DIV DVSOR A:= QUOTIENT. B:= REMAINDER STA ACC SAVE QUOTIENT LDA B REMAINDER TO A LDB SYMI B:= BYTE POINTER CLE,SLB,ERB B := WORD POINTER ODD BYTE TEST JMP *+2 NOT ODD BYTE ALF,ALF ROTATE IF ODD BYTE IOR B,I STA B,I LDB SYMI ADB .M1 STB SYMI LDA ACC SZA JMP BNCLP JMP BNCN,I * * ***************** * * ORR PROCESSOR * * ***************** ORRP NOP CLA (OR$ PARAMETER) STA OFLAG TO INDICATE COMING FROM ORRP ROUTINE JSB OR$ TO PRE-PROC STA ORRSV 0 TO ORRSV LDA ORRS GET THE SAVED MAIN PLCN STA PLCN SET PLCN TO MAIN LOC CNT. JMP ORRP,I EXIT(PICKED UP AT *-5) OFLAG NOP * * * ORG/ORR PRE-PROCESSOR * * OR$ NOP LDA ?BASF LDB PLCN SZA ARE WE IN BASE PAGE ? STB ?BPSV YES, SAVE B.P. LOCATION COUNTER. LDA ORRSV GET ORRSV SZA WERE WE IN MAIN PROG? JMP OR$1 NO ISZ OFLAG COMING FROM ORRP OR ORGP? JMP ORRP,I FROM ORRP, RETURN STB ORRS FROM ORGP OR$1 SSA WAS THIS SECTION SET BY AN ORG ? JSB ORGST GO SET HIGH PLCN VALUE IN PROG. CLA STA ?BASF CLEAR BASE PAGE FLAG. JMP OR$,I * ***************** * * ORG PROCESSOR * * ***************** STBI STB ORRS THIS IS A PARAMETER ORGP NOP CCA SET OFLAG TO INDICATE COMING FORM ORGP STA OFLAG JSB OR$ CCA STA ORRSV SET ORRSV = -1 * * * GO TO EVALUATE OPERAND * * JSB CHOPI JMP ORGP,I ERROR EXIT STB PLCN LDB AFLAG SZB,RSS SKIP OUT, IF ABSOLUTE ASSEMBLY CPA .1 RELOC? JMP ORGP,I YES,OK JSB OPERR NO, 'M' ERROR JMP ORGP,I REXIT * SKP * ******************************* * * LIST ROUTINE: PARAMETERS; * * * IF A=0,4,6,7 B=RELOC CODE * * * A=0 FULL LINE * * * A=1 NO INST OR LOCN * * * A=2 NO INST * * * A=3 COMMENT * * * A=4 NO SEQ.NO., NO STATE.* * * A=5 PRINT 'ASMB' STATEMENT* * * A=6 INST ONLY(EXT OFFSET)* * * A=7 NO LOCN (RPL CODE) * * ******************************* LISTD DEC 60,-61 LISTK DEF IOBF+6 INSTRUCTION LOC'N DEF IOBF+3 LOCATION LOC'N DEF IOBF+2 LIST COMMENT LOC'N LIST NOP STB SAVB SAVE ASCII RELOC CODE STA SAVB+1 SAVE LIST PARAM. CPA .5 CONTROL STATE.? JMP HI82 YES LDB LFLAG GET LIST FLAG SZB,RSS PUNCH ONLY? JMP LIST,I YES, EXIT LDB PASS SZB,RSS PASS 1 ? JMP LIST,I YES, EXIT LDA LST SZA LIST FLAG=0 ? JMP LIST,I NO, EXIT LDA .10 LDB FBOI JSB SETM SET BUFFER TO ASC 1, BLANKS LDA SAVB+1 CPA .1 A=1? JMP HI82 YES CPA .2 A=2? JMP HI80 YES * * * CONVERT INSTRUCTION * LDB SAVB STB IOBF+9 SET RELOC INDIC LDA INST CLE E=0 JSB BNCN CONVERT TO ASCII OCTAL LDB LISTK L(IOBF+6) JSB V MOVE NO.TO BUFFER LDA SAVB+1 GET LIST PARAMETER. CPA .7 (7) NO LOCATION ? JMP HI82 YES, GO CONVERT SEQ. NUMBER. CPA .6 (6) INSTRUCTION ONLY ? JMP HX8 YES, CHECK FOR SUPPRESS. * SKP * * CONVERT LOCATION CNTR * * HI80 LDA PLCN CLE E=0 JSB BNCN CONVERT TO ASCII OCTAL LDB LISTK+1 L(IOBF+3) LDA .5 (5) JSB MOVE LISTL NOP =-ASCI GOES IN HERE LDA SAVB+1 CPA .4 A=4? JMP HX8 YES * * * CONVERT SEQ.NO. * HI82 LDA SEQN CCE E=1 JSB BNCN CONVERT IT TO ASCII DECIMAL LDA ASCI+1 STA IOBF LDA ASCI+2 STA IOBF+1 * * * SET UP BUFFER LENGTH, ADJUST IF >80 CHARS * LDB SAVB+1 CPB .5 CONTROL STATE.? STA ASCI+4 SET TAPE # =1 LDA SCN1 STATE.LENGTH CPB .3 REMARK? JMP HI19 YES HI17 STA 1 H TO B ADA LISTD+1 -61 SSA,RSS LENGTH>60 ? LDB LISTD YES, SET B=60 ADB .4 ADD 4 STB 0 NEW LENGTH TO A HI18 ADA .16 LENGTH+16 LDB FBOI JSB PRNT *PRINT THE LINE OF OUTPUT * JMP LIST,I EXIT * * * SET UP FOR LIST COMMENT * HI19 LDB LISTK+2 L(IOBF+2) JSB MOVE DEF BUFF LDA SCN1 ADA .M16 LENGTH-16 JMP HI17 * * * TEST FOR EXTENDED SUP * HX8 LDB SUP SZB SUPPRESS THE LISTING ? JMP LIST,I YES, EXIT LDA .4 INITIALIZE STATEMENT LENGTH =4. JMP HI18 GO TO PRINT THE LINE. FBOI DEF IOBF * SKP * ****************** * * SKIP 'A' LINES * * ****************** LINS NOP SZA,RSS DON'T GO TO DRIVER, JMP LINS,I IF COUNT =0 (IT'S NOT NECESSARY). STA DSIG SET LINES TO SKIP INTO CNTR. JSB SPC.C SKIP LINES DEF C.LST LIST FILE FCB DEF DSIG LINE COUNT JMP *+2 ERROR JMP LINS,I RETURN. CLB INDICATE LIST FILE JMP ?FMPE DISPLAY ERROR AND ABORT * ********************************************************************** * * * * FIND NUM.OF CHARS IN A TERM * * * Ƞ * * ENTER:=DON'T CARE; =RELATIVE POS'N IN 'BUFF' OF 1RST CHAR. * * EXIT: =NO. CHARS. IN TERM; B=STARTING MEMORY ADDRESS OF TERM * * 'TEST'=CONTINUATOR CHAR., FOLLOWING TERM * * 'LAST'=LAST CHARACTER IN TERM * ********************************************************************** * MSYM NOP STB SAVB STB PNTR CLA START WITH STA DSIG ZERO FOR CNTR STA TEST HI42 STA LAST LAST LDA SAVB JSB GETC CPA L+2 * ? JMP HI43 YES CPA BLNK END OF SYMBOL? JMP HI45 -YES- ADA .M46 -46 = -56B SSA,RSS >55B ? JMP HI44 -YES, NOT A TERMINATOR. ADA .7 (7) NO. SSA >47B [TERMINATOR: ' ( ) * + , - ] ? JMP HI44 NO * * SET UP FOR EXIT * HI45 LDA PNTR JSB GETA LDA DSIG NO.OF SYMBOLS TO A JMP MSYM,I EXIT HI43 LDA DSIG CPA .1 IS '*' ALONE? JSB OPERR NO, ERROR HI44 ISZ DSIG BUMP CNTR. ISZ SAVB LDA TEST JMP HI42 * * ******************************** * * PRINT OUTPUT AND COUNT LINES * * ******************************** PRNT NOP STB PRLOC SAVE THE BUFFER ORIGIN CLE,SLA,ERA DIVIDE #CHARS BY 2 & SKIP IF EVEN JMP ODDCN STWCN STA SAVB SAVE THE WORD COUNT ISZ LINC END OF PAGE ? JMP I - NO LDB PLINE STB LINC RESET THE LINE COUNTER LDA .7 SKIP SEVEN LINES ON TTY, CMA,INA OR GO TO TOP OF FORM JSB LINS ON LINEPRINTER. ISZ LINC+1 BUMP PAGE NO. CCE SET FOR DECIMAL NO.CONVERSION. LDA LINC+1 GET PAGE NO. JSB BNCN CONVERT TO ASCII OCTAL * * * SET UP PAGE HEADER * LDA RC 'E' STA ASCI JS'RB WRT.C GO TO PRINT THE HEADER DEF C.LST LIST FILE FCB NAME DEF HEADP HEADER LOC'N DEF .35 WORD COUNT JMP PRNER LDB PASS SZB,RSS LIST PASS JMP PRNT1 NO LDA HED HEADING PRESENT? SZA,RSS JMP PRNT1 NO JSB WRT.C PRINT THE HEADING IF GIVEN DEF C.LST LIST FILE FCB .HEAD DEF HEAD2 START OF HEADER BUFFER DEF HED HEADER BUFFER LENGTH JMP PRNER ERROR RETURN LDA .2 RSS PRNT1 LDA .3 PREPARE TO JSB LINS SKIP 2 LINES. I JSB WRT.C GO OUTPUT A LINE DEF C.LST PRLOC NOP BUFFER ORIGIN DEF SAVB WORD COUNT JMP *+2 JMP PRNT,I PRINT EXIT PRNER CLB INDICATE LIST FILE ERROR JMP ?FMPE DISPLAY AND ABORT ODDCN STA SAVB SAVE WORD COUNT ADB A POINT TO LAST WORD IN BUFFER LDA B,I GET CONTENTS AND B1774 MASK UPPER BYTE IOR BLNK INSERT BLANK IN LOW BYTE STA B,I RESTORE WORD LDA SAVB GET WORD COUNT INA INCREMENT IT JMP STWCN SET WORD COUNT * LINC OCT -1,0 LINE CNTR/PAGE CNTR .35 DEC 35 B1774 OCT 177400 * SKP * ******************* * * SET UP A HEADER * * ******************** HEDSB NOP LDA SCN1+2 SZA,RSS HEADER PRESENT? JMP HXD NO-RETURN ADA .M1 CMA,INA ADA SCN1 STA HED HEADER LENGTH IN 'HED' LDB .72 ADA .M73 -73 SSA,RSS IS HEADER TOO LONG (MORE THAN 58 CHARS) STB HED SET HEADER LENGTH TO 58 LDA SCN1+2 JSB GETA GET ADDRESS OF HEADER LDA HED STB HEDMV LDB HXD. GET L(HEDR+9) JSB MOVE HEDMV NOP ADDR OF HEADER LDA HED ADA .4 SLA,ARS CONVERT TO WORD COUNT JMP ODD# ODD # OF CHARACTERS HXD STA HED WORD COUNT JMP HEDSB,I ODD# STA HED SAVE FOR NOW LDB .HEAD ADDRESS OF HEAD BUFFER ADB A POINT TO THE LAST WORD IN HEADER LDA B,I AND B1774 MASK UPPER BYTE IOR BLNK INSERT BLANK IN LOW BYTE STA B,I RESTORE LAST WORD OF HEADER ISZ HED INCREMENT WORD COUNT FOR HEADER JMP HEDSB,I RETURN * .72 DEC 72 .M73 DEC -73 HXD. DEF HXBUF LOCATION OF HEADER HED NOP HEADER FLAG(LENGTH) ICSA DEF ASCI LOC'N OF ASCI BUFFER * ************************** * * PRINT ERROR DIAGNOSTIC * * ************************** DEF IOBF+5 ERPR NOP ISZ ERRCN BUMP ERROR COUNTER LDB BLNS STA IOBF+5 ERROR DIAG. STB IOBF+6 BLANKS STB IOBF+9 BLANK OUT RELOC INDIC. LDA SEQN CCE JSB BNCN CONVERT TO ASCII OCTAL LDA ASCI+1 FOR USE IN STA IOBF+7 THE LDA ASCI+2 DIAGNOSTIC STA IOBF+8 JSB PRPAG GO PRINT PREVIOUS PAGE NO. LDA SCN1 GET STATEMENT LENGTH ADA .10 (+10) LDB ERPR-1 GET STATE,ORIGIN (IOBF+5) JSB PRNT PRINT THE MESSAGE. JMP ERPR,I EXIT SKP * *PRINT PREVIOUS PAGE CONTAINING ERROR ** * PRPAG NOP USED IN 'ERPR' AND 'ENDSB' PRPG1 LDA .2 SET UP TO EMIT A BLANK LINE LDB ABLNS JSB PRNT GO TO PRINT ROUTINE LDA LINC GET CURRENT LINE VALUE CPA .M1 IS IT SET FOR A PAGE EJECT? JMP PRPG1 YES, GO OUTPUT ANOTHER BLANK LIN LDB PASS LDA TAPE GET SOURCE TAPE NO. SZB FIRST PASS? LDA PRERR GET PREVIOUS PAGE(=0 IF 1ST ERR) CCE JSB BNCN CONVERT PAGE OR TAPE TO DECIMAL LDA .TNO GET ' #' LDB PASS SZB FIRST PASS? LDA .PG GET "PG" FOR PAGE POINTER STA ASCI D SET IN '**' LDA ASCI+1 AND .2077 MAKE 1ST DIGIT BLANK STA ASCI+1 LDA .6 GET PARAM FOR 6 CHARS LDB ICSA BUFFER ORG JSB PRNT GO PRINT "**PAGE" OR " #TAPE" LDA LINC+1 GET CURRENT PAGE NUMBER. STA PRERR SET PREV. PAGE = CURRENT PAGE. JMP PRPAG,I EXIT .PG ASC 1,PG ABLNS DEF BLNS .2077 OCT 20077 * ************************************** * * PRINT ERROR COUNT AT END OF A PASS * * * SPACE TO BOTTOM OF PAGE * * * INIT.LINE,ERROR AND SEQUENCE CNTRS* * * SET CONTROL STATEMENT FLAG = -1 * * ************************************** ENDSB NOP LDB PASS SZB,RSS FIRST PASS? JMP GETER YES, BYPASS MESSAGE CHANGE. DLD TOTAL NO. CHANGE MESSAGE DST PAU+7 FROM: LDA TOTAL+2 "PASS#1" STA PAU+9 TO: "*TOTAL". GETER LDA ERRCN GET CURRENT ERROR COUNT. ADA ?ENER INCLUDE ENTRY POINT ERRORS, IF ANY. STA ERRCN UPDATE TOTAL ERROR COUNT. SZA,RSS ANY ERRORS? JMP ENDSR NO ERRORS.. LDB PASS SZB FIRST PASS? JSB PRPAG NO, PUT OUT THE PAGE POINTER LDA ERRCN GET THE TOTAL ERROR COUNT CCE JSB BNCN CONVERT TO ASCII OCTAL LDA ASCI+1 LDB ASCI+2 JMP ENDS1 ENDSR LDA BLNS * * * 'NO'ERROR SETUP * * LDB .NO FOR 'NO' ERRORS ENDS1 STA PAU+1 STA EMESG+4 STB PAU+2 STB EMESG+5 LDA PASS SZA,RSS PASS 2? JMP ENDS2 NO JSB WRT.C YES, SEND ERROR COUNT TO CONSOLE DEF C.TTY DEF EMESG DEF .13 NOP ENDS2 LDA DOT (46) NO OF CHARS IN MESSG. LDB PAU-1 BUFF ADDR JSB PRNT PRINT DIAG. CCA STA LINC NEXT TIME SKIP PAGE STA ASM1 SET CONT.STATE.FLG CLA,IN1A SET A=1 STA TAPE SET TAPE COUNTER = 1 JMP ENDSB,I EXIT END SUBROUTINE * DEF PAU LOC OF PASSOVER STATE. * PAU EQU * ESTABLISH START OF MESSAGE. * ASC 23,**0000 ERRORS PASS#1 **RTE ASMB 92067-16011** TOTAL ASC 3,*TOTAL EMESG ASC 13, /ASMB: 0000 ERRORS TOTAL * .20 DEC 20 ?PERL DEF *+1 ?BASF NOP BASE PAGE FLAG. ?BPSV NOP HIGHEST BASE PAGE VALUE. REP NOP REPEAT COUNTER REQ NOP FLAG FOR 1ST STATE AFTER REP LST NOP LST/UNL FLAG LTFLG NOP LITERAL FLAG(0=NO LIT.) ORRSV NOP =0 IN REG. PROG;=-1 IN ORG SECTN ORRS NOP SAVE LAST PLCN VAL FOR ORR SET ORGSV NOP HIGHEST PLCN VAL IN AN ORG SECTN PRERR NOP PREV. PAGE # CONTAINING ERROR. SUP NOP SUP/UNS FLAG IFUSE NOP =1, SKIP ASSMBL.; =-1, IN 'IF' RANGE SEQN NOP SEQUENCE COUNTER ?LPER ABS *-?PERL-1 LENGTH OF AREA TO BE CLEARED * ?ENER NOP 'ENT' ERROR COUNT STORAGE ERRCN NOP ERROR COUNTER. * SKP * * * PICK UP NEXT CHAR, ADD 1 TO PNTR * * PKUP NOP LDA PNTR JSB GETC ISZ PNTR JMP PKUP,I * * * SEARCH FOR NON-BLANK CHAR, SET PNTR AT IT * * BPKUP NOP JSB PKUP CPA BLNK BLANK? JMP *-2 YES - GET NEXT CHAR. LDB PNTR NO - SET PNTR TO LAST NON-BLANK ADB .M1 STB PNTR JMP BPKUP,I * ***************************** * * PUNCH AND SET UP FOR LIST * * ***************************** LOUT NOP CLA 0 TO A CLB,INB 1 TO B CPB PASS SKIP PUNCH IF IN PASS 1 RSS PASS 2, SO PUNCH. JMP PLST PASS 1 SO PREPARE FOR LIST. CPA AFLAG ABSOLUTE ASSEMBLY ? JMP RLREC NO, GO PROCESS RELOC. RECORD. JSB ?AREC YES,GO TO ABS REC. PROCESSOR. RSS SKIP TO PRNLHEPARE FOR LIST. RLREC JSB ?BREC GO TO RELOC. REC PROCESSOR. PLST CLA 0 TO A LDB BLNS BLANKS TO B JMP LOUT,I EXIT * SKP * * GET HIGHEST CURRENT LOCATION VALUE FOR 'ORG' PROCESSING. * ORGST NOP LDA ORGSV LAST ADDR. GENERATED DURING ORG CMA,INA ADA 1 "A" REGISTER _ LAST 'PLCN' VALUE SSA,RSS GREATER ? STB ORGSV NO. USE 'PLCN' VALUE FOR HI ORG CLA,INA "A" = 1 JMP ORGST,I RETURN. * * ***************** * * ORB PROCESSOR * * ***************** ORBP NOP LDA AFLAG SZA,RSS RELOCATABLE ASSEMBLY ? JMP XYZ YES. LDA .IL NO - 'IL ERROR ! JSB ERPR JMP ORBP,I RETURN. * XYZ LDB PLCN LDA ?BASF SZA ARE WE IN BASE PAGE ? JMP ORBP,I YES, EXIT. LDA ?BPSV NO, SET PLCN TO STA PLCN LATEST B.P. VALUE ISZ ?BASF SET B.P. FLAG. LDA ORRSV ARE WE IN SZA MAIN PROGRAM ? JSB ORGST NO, SET HIGH PLCN VALUE. SZA,RSS STB ORRS SAVE PLCN. kN CLA,INA STA ORRSV SET ORRSV = 1 JMP ORBP,I RETURN. * SKP * **************************** * * PROCESS ARITHMETIC MACRO * * **************************** DEF TEMP+4 HA38 JSB ARTLT GO TO LITERAL PROCESSOR LDA L+6 (PERIOD) STA TEMP+4 LDB HA38-1 =L(TEMP+4) LOWER CMB,INB STB SYMP+1 LOC.OF SYMBOL LDA .4 (4) EXT RELOC CODE STA SYMP NO.OF CHARS. LDB PASS SZB JMP ?ART GO TO ARITH('ART') ROUTINE LDB CNTR EXT.NUMBER JSB ?INSR INSERT INTO SYMBOL TABLE RSS ERROR- SKIP NEXT ISZ CNTR BUMP EXT CNTR LDA .2 2 JMP ?HA3Z CNTR OCT 1 EXT COUNTER,FOR PASS 1. * ************************** * * MEASURE LITERAL LENGTH * * ************************** MSYML NOP LDA SCN1+2 GET OPERAND POSITION STA SAVB SPC 1 * * SET UP AND TEST NEXR CHARACTER NXTCH ISZ SAVB SAVB = OPDRND POS'N+1 LDA SAVB GET CURRENT POSITION JSB GETC GET THE CHATACTER CPA BLNK IS IT A SPACE? RSS YES, END OF LITERAL JMP NXTCH NO, GO EXAMEINE THE NEXT CHARACT. LDB SCN1+2 GET STARTING POSITION CMB,INB COMPLEMENT IT. ADB SAVB RESULTS IN THE LITERAL LENGTH JMP MSYML,I EXIT * SKP * ******************** * * PROCESS LITERALS * * ******************** PLITS NOP LDA LTFLG LITERAL FLAG CPA .F =F ? JMP PER CPA .A =A ? JMP P.A CPA .L =L? JMP P.L JSB MSYML =B OR D; GET SYMB LNG. LDA LTFLG CPA .B =B? JMP P.0 YES CPA .D =D? JMP P.M1 YES PER JSB OPERR 'M' ERROR JMP PLITS,I EXIT P.M1 ADB .400B P.0 LDA SCN1+2 JSB ASCN U CONVERT TO BINARY JMP PLITS,I ERROR RETURN P.1 STA ASCI P.2 LDA .2 STA SYMP LDA PASS SZA PASS 1 ? JMP P.LK NO JSB ?LITI YES, INSERT LIT.INTO SYMBOL TABL JMP PLITS,I ERROR RETURN RSS P.LK JSB ?LKLI LOOKUP LITERAL IN SYMBOL TABLE ISZ PLITS JMP PLITS,I NORMAL RETURN P.L CLA EXPRESSION PROCESSOR STA LTFLG JSB CHOPI EVALUATE OPERAND JMP PLITS,I ERROR EXIT SZA ABSOL.VALUE? JMP PER NO-ERROR LDA 1 VALUE TO A REG JMP P.1 P.A LDA SCN1+2 JSB GETA STB P.MV ADDR OF OPERAND LDA .2 2 CHARS LDB ICSA GET LOC'N OF ACSI BUFFER JSB MOVE P.MV NOP OPERAND ADDR. JMP P.2 .A OCT 101 ASCII 'A' .D OCT 104 'D' .F OCT 106 'F' .L OCT 114 'L' SKP * ************************* * * ARITH MACRO PROCESSOR * * ************************* ARTLT NOP LDA LTFLG GET LITERAL FLATG SZA,RSS LITERAL PRESENT? JMP ARTLT,I NO LITERAL, EXIT LDB TEMP+6 STB ARTSV+1 LDB TEMP+5 1ST 2 OPCODE CHARS FOR TEST STB ARTSV CPB .MP MPY? JMP LTAR YES CPB .DI DIV? JMP LTAR YES CPB .DS DST? JMP LERR1 YES, ERROR CPA .F =F? FLTG PT LIT PROC JMP LERR+3 LERR1 JSB OPERR NO,'M'ERROR LERR CLB B=0 CLA,INA A=1 JMP LTAR+2 JSB MSYML PROC.LIT.LNG. ADB B1000 2 TO 'B' UPPER LDA SCN1+2 OPERND PNTR JSB ASCN CONVRT ASCII TO FLTG.PT. JMP LERR ERROR RETURN STA ASCI STB ASCI+1 LDA .4 (4) STA SYMP SET SYMK/INSR PARAMS. LDA PASS SZA,RSS PASS 1 ? JMP LTINS YES JSB ?LKLI  NO, LOOKUP LIT. IN SYMBL TABLE JMP LTAR+2 EXIT LTINS JSB ?LITI INSERT LITERAL INTO SYMBOL TABLE JMP LTARZ ERROR EXIT(OK) ISZ PLEN JMP LTARZ LTAR JSB PLITS JMP LERR ERROR RETURN STA LTSVA SAVE A STB LTSVB SAVE B LTARZ CLA,INA STA LTFLG SET LTFLG=1 FOR LIT.IN ARITH MACRO. LDA ARTSV SET OPCODE CHARS BACK STA TEMP+5 FOR FURTHER PROCESSING LDA ARTSV+1 STA TEMP+6 JMP ARTLT,I EXIT FROM LIT. PROC. HERE SPC 1 .MP ASC 1,MP .DI ASC 1,DI .DS ASC 1,DS ARTSV OCT 0,0 LTSVA NOP FOR ART USE LTSVB NOP * ******************** * * SETUP FOR REPEAT * * ******************** REPSB NOP LDA REP SZA IN 'REP' RANGE? JMP RXP YES, ERROR JSB CHOPI EVAL NO.OF REP'S JMP RXP+2 ERROR EXIT SZA VAL RELOC? JMP RXR YES, ERROR SZB,RSS VAL=0? JMP RXP+2 YES INB NO. CMB,INB -B TO B LDA .M2 STA REQ SET REQ=-2(FOR SEQNO PROC) RXX STB REP B TO REP (NO.OF REPEATS) JMP REPSB,I RXP LDA .OP 'OP' ERROR(IN RANGE OF 'REP') JSB ERPR CLB 0 TO B (FOR NO REP) JMP RXX RXR JSB OPERR RELC.VAL(ERROR) 'M' JMP RXP+2 * * * SET UP FOR EVALUATION OF OPERAND IN WHICH A COMMA * * IS ILLEGAL. * CHOPI NOP CLA JSB CHOP JMP CHOPI,I ISZ CHOPI JMP CHOPI,I * ************************************* * * GET BREC CODE AND LIST RELOC CHAR * * BREC CODE IN A, LIST CHAR IN B. * ************************************* DCOD NOP LDB BLNS SZA,RSS ABSOLUTE REL.? JMP DCOD,I YES,DONE STA SAVB SAVE RELC CODE CPA .5 IS IT EQU EXT ? ADA .M1 YES, SET = 4. LDݷB ?TFLG PRINTING THE SYMBL TBL? SSB JMP DCOD1 YES LDB EMASY OPERAND SYMBOL IS AN EMA? SSB,RSS BIT 15 SET? JMP DCOD1 NO CLA YES, THEN EMA GET 'E' STA EMASY CLEAR EMASY FLAG DCOD1 ADA RC-1 POINT TO CORR.RELC.CHAR. LDB 0,I PICK IT UP LDA BYFLG SZA,RSS LDA SAVB PICK UP RELC CODE IF NECESSARY. JMP DCOD,I RETURN * * * MOVE CHARS.TO A BUFFER FROM ASCI * * * BUFFER ADDR.IN B REG. * * V NOP LDA .6 JSB MOVE DEF ASCI JMP V,I * * * SET UP AND PRINT 'M' DIAG. FOR OPERAND ERROR * * OPERR NOP LDA .MBLN 'M'= OPERAND ERROR JSB ERPR JMP OPERR,I * ********************************************************************** * * * * GET BUFFER ADDRESS OF ITEM * * * * * ENTER: =CHARACTER POS'N. RELATIVE TO 'BUFF'; =DON'T CARE * * EXIT: =+-CHAR. MEMORY ADDR.; NEG-IN LOWER BYTE,POS-UPPER * * * ********************************************************************** * GETA NOP ADA .M1 A-1 TO A CLE,ERA ADA FFUB SEZ UPPER ADDR? CMA,INA NO - COMPLEMENT IT. STA 1 A TO B JMP GETA,I * ********************************************************************** * * * * GET AN OPERAND CHAR. * * * * * ENTER: =CHAR. POS'N RELATIVE TO 'BUFF'; =DON'T CARE * * EXIT: =CHAR.(LOWER BYTE); =WORD ADDRESS OF 'TEST' * * 'TEST' = CHA/RACTER (LOWER BYTE) * * * ********************************************************************** * GETC NOP JSB GETA STB GETMV LDB TS ADDR OF 'TEST' TO B REG CMB,INB CLA,INA SET =1 JSB MOVE GETMV NOP (FROM *-5) LDA TEST JMP GETC,I TS DEF TEST * * ************************************ * * MEASURE SYMBOL AND SET * * * SYMP = SYMBOL CHAR COUNT * * * SYMP+1 = SYMBOL POSITION * * ************************************ MSYMS NOP JSB MSYM STA SYMP STB SYMP+1 JMP MSYMS,I * * ***************************** * * SET MEMORY TO GIVEN VALUE * * ***************************** * SETM NOP CMA,INA SET VALUE FOR COUNTER STA DSIG LDA SETM,I GET PARAMETER TO BE STORED IN AREA SETLP STA 1,I - PLACE PARAMETER IN MEMORY INB ISZ DSIG JMP SETLP ISZ SETM JMP SETM,I SKP * * ?FMPE - ROUTINE TO DISPLAY FMP ERROR AND ABORT ASMB * CALLING SEQUENCE: A REG = - ERROR # * B REG = -1 IF ERROR IN INPUT FILE * 0 IF ERROR IN LIST FILE * 1 IF ERROR IN OUTPUT FILE * JMP ?FMPE * ?FMPE STB FMPMV SAVE B REG CMA,INA CONVERT ERROR # TO +VE CCE CONVERT TO ASCII JSB BNCN DLD ASCI+1 SET UP MESSAGE DST FMPER+10 LDB FMPMV GET FILE # LDA .INPT SSB IF -1 THEN INPUT FILE JMP STMVA ADA .3 SZB 0 THEN LIST FILE ADA .3 STMVA STA FMPMV LDA .6 MOVE FILE NAME INTO MESSAGE LDB FMPAD ADB .13 JSB MOVE FMPMV NOP JSB WRT.C DISPLAY MESSAGE ON CONSOLE DEF C.TTY CONSOLE FCB H DEF FMPER MESSAGE ADDRESS DEF .16 NOP JMP ASMEX ABORT ASSEMBLER * .13 DEC 13 FMPER ASC 16, /ASMB: FMP ERROR - FMPAD DEF FMPER .INPT DEF *+1 ASC 3,SOURCE ASC 3,LIST ASC 3,BINARY SKP * * ASSEMBLY OPTION FLAGS * * EXIT NOP FLAGS DEF *+1 POINTS AT BFLAG LFLAG NOP LIST RFLAG NOP RELOCATABLE ASMBLY(OPTIONAL FLG) TFLAG NOP SYMBOL TABLE PRINT REQ. IFTST NOP CONTAINS 'IF' FLAG(N,Z, OR 0) AFLAG NOP ABSOLUTE ASMBLY. CFLAG NOP CROSS REFERENCE TABLE FLAG PLINE NOP STANDARD LINE COUNT ?LWA NOP LAST WORD ADDR. OF AVAIL. MEMORY X NOP ?NDOP NOP POINTS TO SUPPLEMENTARY OPCODES ?NDSY NOP POINTS TO END OF SYMBOL TABLE SKP * HEADP ASC 2, PAG ASCI BSS 3 DEST. OF CONVERTED DEC. NOS. ASCI1 EQU ASCI+1 .TNO ASC 3, # PART OF HEADER ASC 11, TIME ASC 16, HEAD2 ASC 2, HXBUF BSS 36 HEADER BUFFER. GTEM BSS 4 TEMP STORAGE: 'MOVE' & 'PNCH'. * A EQU 0 B EQU 1 SPC 1 ASMB JSB SUP.C SUPERVISOR CALL FOR SET UP OF COMPILER LIB DEF TIME 16 WORD TIME STRING NOP NO ERRORS SHOULD OCCUR JSB PRM.C GET 4TH PARAMETER DEF .4 # OF LINES/ PAGE ON LIST OUTPUT STA PLINE SZA,RSS 0? JMP DFLT TAKE DEFAULT # OF LINES/PAGE ADA .M55 > 55? SSA,RSS JMP DFLT YES, THEN TAKE DEFAULT LDA PLINE NO CMA,INA SAVE -VE COUNT FOR # OF LINES/PAGE JMP *+2 DFLT LDA .M55 DEFAULT IS 55 LINES/PAGE STA PLINE JSB GMM.C FIND FWA AND LWA FOR FREE MEM DEF .5 TO BE USED FOR SYMBOL TABLE DEF SGNAM ROUTINE CONVERT SEG# TO SEG NAME STA ?X FWA STB ?LWA LWA STB ?NDOP SET START OF SUPPLEMENTAL OPCODE TABLE CLA STA ?NDOP,I CLEAwR START OF SUPPLEMENTAL TBL * CLA LOAD SEGMENT 0 ( ASMBD) JMP SEGMT CALL SEGMENT OVERLAY ROUTINE * .M55 DEC -55 SPC 2 ?AFLG EQU AFLAG ?ARTL EQU ARTLT ?ASCI EQU ASCI ?ASCN EQU ASCN ?ASII EQU ASCI1 ?ASM1 EQU ASM1 ?ASMB EQU ASMBX ?ASME EQU ASMEX ?BINF EQU BINFL ?BNCN EQU BNCN ?BPKU EQU BPKUP ?CHOP EQU CHOP ?CHPI EQU CHOPI ?CNTR EQU CNTR ?DCOD EQU DCOD ?ENDS EQU ENDSB ?ERPR EQU ERPR ?FLGS EQU FLAGS ?GETA EQU GETA ?GETC EQU GETC ?HA38 EQU HA38 ?ICSA EQU ICSA ?LFLG EQU LFLAG ?LINC EQU LINC ?LINS EQU LINS ?LIST EQU LIST ?LOUT EQU LOUT ?LST EQU LST ?LSTL EQU LISTL ?LTFL EQU LTFLG ?LTSA EQU LTSVA ?LTSB EQU LTSVB ?MESX EQU MESSX ?MOVE EQU MOVE ?MSYM EQU MSYM ?MSYS EQU MSYMS ?OPER EQU OPERR ?OPLK EQU OPLK ?ORGS EQU ORGSV ?ORRP EQU ORRP ?PKUP EQU PKUP ?PLIN EQU PLINE ?PLIT EQU PLITS ?PNCH EQU PNCH ?PRNT EQU PRNT ?PRPG EQU PRPAG ?RFLG EQU RFLAG ?RSTA EQU RSTA ?SEGM EQU SEGMT ?SETM EQU SETM ?SUP EQU SUP ?SYMK EQU SYMK ?SYML EQU MSYML ?SYMT EQU SYMTS ?TFLG EQU TFLAG ?V EQU V ?X EQU X FWA AVAIL. FOR RELOCAT. ASS'YS. SKP * **************************** * * TEMPORARY AND FLAG REGION* * **************************** TEMP BSS 7 TEMP AT START OF OVERLAY AREA VAL0 EQU TEMP+1 ASCN - MOST SIGNIFICANT BITS VAL1 EQU TEMP+2 ASCN VAL2 EQU TEMP+3 ASCN - MIDDLE BITS VAL3 EQU TEMP+4 ASCN - LEAST SIGNIFICANT BITS DCNT EQU TEMP+5 WPVAL EQU DCNT PASCN EQU TEMP+2 NUMBER PNTR SAVE(CHOP) .1 DEC 1 .2 DEC 2 .3 DEC 3 .4 DEC 4 .5 DEC 5 .6 DEC 6 .7 DEC 7 .12 DEC 12 .14 DEC 14 .15 DEC 15 .16 DEC 16 .17 DEC 17 .M1 DEC -1 .M2 DEC -2 .M3 DEC -3 .M4 DEC -4 .M5 DEC -5 .M6 DEC -6 L OCT 50 ( OCT 51 ) OCT 52 * OCT 53 + OCT 54 , OCT 55 - DOT OCT 56 . .9 DEC 9 H.M8 DEC -8 .M15 DEC -15 BLNK OCT 40 LOWER BLANK .IL ASC 1,IL .MBLN ASC 1,M .NO ASC 1,NO .OP ASC 1,OP .OV ASC 1,OV .UN ASC 1,UN B1000 OCT 1000 BIT15 OCT 100000 .E OCT 105 .B OCT 102 DEF *+1 ADDRESS OF RC RC ASC 5,E R B C X NAMI DEF NAME LOC'N FOR TEMP SYMBOL STORAGE NAME OCT 0,0,0,0 FOR USE BY 'OPLK' * * FOLLOWING 5 LOC'S ARE CLEARED IN CHOP ROUTINES * RELC NOP RELOCATION FLAG SIGN NOP SUMP NOP RUNNING SUM FOR 'CHOP' TERM NOP NO. OF TERMS IN AN OPERAND T BSS 2 BYFLG NOP BYTE FLAG FOR 'BREC' FLEX NOP 'ASCN' MODE EQU FLEX CNTB NOP CODE NOP OPCODE TYPE(FROM OPTABLE) DSIG NOP 'ASCN' FLAG NOP FLAQ NOP INST NOP OPCODE FORMAT LAST NOP PASS NOP PASS FLAG(0=PASS 1 AND 1=PASS2) PEEK NOP LAST CHAR PICKED UP PLCN NOP PROGRAM LOCATION COUNTER PLEN NOP LIT LENGTH PASS 1/LIT ORG PASS 2 PNTR NOP POINTS AT LAST OR CURRENT CHAR. RCNT NOP SAVB BSS 2 SCN1 BSS 4 STATE LNG/OPCODE/OPERAND/LABEL(4) SVST NOP SYMI NOP ADDR CNTR FOR SYMBOL TBL (SYMK) FEXP EQU SYMI SYMP BSS 2 SYMBOL LNG/ AND LOC'N TEST BSS 2 TEST CHARACTER ENT. NOP ENTC NOP ENTV NOP DEXP EQU ENT. CNVT EQU ENTC ASCN SDSIG EQU ENTV ASCN - SAVE SIGN OF MANTISSA DFCNT EQU ENTV * * I/O STATEMENT BUFFER * IOBF BSS 63B 50 WORDS + END OF STATEMENT BUFF * * INPUT BUFFER 'BUFF' STARTS IN 11TH WORD * BUFF EQU IOBF+12B PBUF OCT 10400,20000,0 START OF PUNCH BUFFER ASC 3, OCT 0,0,0,0,143,0,0,0,0,0,0 BSS 43 REST OF PUNCH BUFFER OCT 0 EXTRA WORD FOR BUFFER OVERFLOW OCT 5757 FOR ASMB CHECK SPC 1 * SET UP EQU'S FOR ABOVE VALUES TO DECLARE ENT'S ?TEMP EQU TEMP ?NAMI EQU NAMI ?NAME EQU NAME ?RELC EQU RELC ?SIGN EQU SIGN ?SUMP EQU SUMP ?TERM EQU TERM ?T J640 EQU T ?BYFL EQU BYFLG ?FLEX EQU FLEX ?CNTB EQU CNTB ?CODE EQU CODE ?DSIG EQU DSIG ?FLAG EQU FLAG ?FLAQ EQU FLAQ ?INST EQU INST ?LAST EQU LAST ?PASS EQU PASS ?PEEK EQU PEEK ?PLCN EQU PLCN ?PLEN EQU PLEN ?PNTR EQU PNTR ?RCNT EQU RCNT ?SAVB EQU SAVB ?SCN1 EQU SCN1 ?SVST EQU SVST ?SYMI EQU SYMI ?SYMP EQU SYMP ?TEST EQU TEST ?ENT. EQU ENT. ?ENTC EQU ENTC ?ENTV EQU ENTV ?IOBF EQU IOBF ?BUFF EQU BUFF ?PBUF EQU PBUF SPC 2 END ASMB 6 7 92067-18012 1805 S C0322 &4XRF1 RTE-IV CROSS REFERENCE GENERATOR             H0103 JwASMB,R,L,C RTE 'XREF' CROSS-REFERENCE TABLE GENERATOR HED * RTE 'XREF' CROSS-REFERENCE TABLE GENERATOR 92067-16012 * * NAME: XREF * SOURCE: 92067-18012 * RELOC: 92067-16012 * PGMR: C.C.H.,S.P.K. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM XREF,3,99 92067-16012 REV.1805 771121 SUP EXT IFBRK EXT C.SOR,C.LST,C.TTY,OPN.C,WRT.C,RED.C,END.C EXT SPC.C,PRM.C,SUP.C,GMM.C,RWN.C,EOF.C * * THIS PROGRAM PRODUCES A CROSS REFERENCE TABLE FOR AN PROGRAM * WRITTEN IN HP-21XX ASSEMBLY LANGUAGE (HPAP). THE TABLE CON- * SISTS OF A LIST OF SYMBOLS, IN ALPHABETIC ORDER, EACH FOLLOWED * BY ITS LOCATION IN THE PROGRAM, AND A LIST OF REFERENCES TO * THAT SYMBOL. EACH LOCATION IS A 5-DIGIT SEQUENCE NUMBER, FOL- * LOWED BY THE NUMBER OF THE TAPE ON WHICH IT APPEARS. THESE TWO * ARE SEPARATED BY A SLASH. THE TAPE NUMBER IS NOT PRINTED WHEN * ONE TAPE ONLY EXISTS. * * THE METHOD USED IS TO READ IN THE HPAP SOURCE PROGRAM AND * BUILD A TABLE OF REFERENCES. THERE ARE TWO INTERNAL TABLES, THE * LABEL TABLE (LTAB) AND THE CROSS REFERENCE TABLE (XTAB). THESE * TABLES ARE ORGANIZED AS FOLLOWS: * * LTAB: EACH ENTRY CONTAINS THE LABEL NAME AS FOLLOWS: * WORD COUNT CHAR.1 * CHAR.2 CHAR.3 (OPTIONAL) * CHAR.4 CHAR.5 (OPTIONAL) * CHAR.6 CHAR.7 (OPTIONAL) * * THE WORD COUNT MAY BE 1,2,3, OR 4 * * XTAB: EACH ENTRY CONTAINS THE FOLLOWING: * -NUMBER OF WORDS IN ENTRY (-N-2) * LABEL SEQUENCE NUMBER * REF.1 " " B3 LABELS ARE ADDED AS ENCOUNTERED; * ... * REF.N " " REST OF TABLE IS PUSHED DOWN. * * NO LINKAGE BETWEEN THE 2 TABLES IS REQUIRED BECAUSE THE ENTRIES * ARE IN THE SAME ORDER AND CORRESPOND 1 FOR 1. * NOTE THAT LTAB BEGINS IN LOW CORE AND XTAB IN HIGH CORE, SO THAT * BOTH ARE OPEN-ENDED. * * A LABEL WHICH HAS BEEN DEFINED BUT NEVER REFERENCED IS SIGNIFIED BY * A "@" IN COLUMN #1 PRECEEDING THE LABEL. * * A LABEL WHICH HAS BEEN DEFINED MORE THAN ONCE WILL HAVE A DEFINITION * FIELD OF HASH MARKS: "#####". * * A LABEL WHICH HAS BEEN REFERENCED BUT NEVER DEFINED WILL HAVE A * DEFINITION FIELD OF QUESTION MARKS "?????". * * ANY INSTRUCTION THAT WILL HAVE AN EFFECT UPON THE PROGRAM LISTING * AS ORG, ORB, ORR, IFN, IFZ, XIF, ECT. WILL BE DEFINED AS FOLLOWS: * " **XXX ***** NNNNN NNNNN " WHERE XXX IS THE TYPE OF INSTR. * AND NNNNN IS THE SEQUENCE NUMBER OF THE INSTRUCTION. * * A LITERAL INSTRUCTION WILL BE DEFINED AS A LABEL WITH ITS DEFINITION * FILLED WITH DOTS, OTHER SEQUENCE NUMBERS DEFINE WHERE THEY WERE USED. * * PARAMETERS: * *ON,XREF,SOURCE,LIST[,A[,B[,C]]] * NAMR NAMR * WHERE: * SOURCE AND LIST NAMR'S ARE FMGR NAMR OR LU#'S * A = 0 WILL ASK FOR NO ALPHA LIMITS. * A # 0 WILL ASK "ENTER LIMITS OR /E" * THE OPERATOR SHOULD ENTER TWO ALPHA CHARACTERS * REPRESENTING THE BEGINNING AND LAST SYMBOLS * OF THIS PASS. THE MESSAGE WILL CONTINUE AFTER * EACH PASS UNTIL A /E IS ENTERED. * * B = 0 WILL GIVE TAPE NUMBERS WITH SEQUENCE NUMBERS * B = N WILL GIVE NO TAPE NUMBERS THUS ALLOWING * LARGER SEQUENCE NUMBERS * B = -N XREF WILL NUMBER PAGES CONSECUTIVELY * FROM THE LAST RTE-ASMB PAGE NUMBER. * (TAPE NUMBERS WILL BE PRINTED.) * [ MORE THAN 16 TAPES: PROCESSING TERMINATES ! ] * * * C = 0 WILL GIVE 55 LINES PER PAGE. * C = N WILL GIVE N LINES PER PAGE. [0nNORE PSUEDO OPCODE; CHECK PARAMETERS. CCB SET B TO POINT AT LABEL SEQUENCE JSB PUTSQ NUMBER AND PUT IN ETAB. MICPR LDA NEXT IS NEXT CHAR CPA COMMA EQUAL TO A COMMA? RSS YES - GO GET NEXT PARAM JMP RAC NO - GO GET NEXT STATEMENT. GSEC JSB ID GO GET NEXT SYMBOL JMP *+1 SKIP SECOND PARAMETER LDA NEXT IS NEXT CHAR CPA BLANK EQUAL TO SPACE JMP RAC YES - GO GET NEXT STATEMENT CPA FEED IS IT A LINE FEED JMP RAC YES - GO GET NEXT STATEMENT CPA COMMA IS IT A COMMA RSS YES - GO GET NEXT CHAR JMP GSEC NO - GO GET NEXT SYMBOL GTLEN JSB CHAR GET # OF OPERANDS PARAMETER CPA BLANK SKIP JMP GTLEN BLANKS. CPA FEED END OF CARD? JMP FLEN YES - CONTINUE. JSB DIGIT GO CHECK SEE IF IT IS A DIGIT RSS YES - IT IS A DIGIT CONTINUE FLEN CLA,INA,RSS SYMBOLIC - SET # OF OPERANDS TO 1. AND .7 CONVERT ASCII DIGIT TO OCTAL. ALF ALF,ALF STA NEXT LDB ETAB LDA B,I GET FIRST CHAR OF CURRENT OP-CODE IOR NEXT "OR" IN NUMBER OF OPERANDS STA B,I RESTORE ENTRY IN TABLE ALF,ALF UPDATE POINTER AND .15 TO NEXT ADB A ENTRY IN OP-CODE STB ETAB TABLE. JMP RAC GO GET NEXT STATEMENT SPC 1 * EXT PROCESSOR SPC 1 DOEXT JSB ID GET SYMBOL JMP RAC END OF STATEMENT. JSB CHEKR JMP DOEXX JSB LLKUP PUT IN LABEL TABLE. JSB ORDLK GET ADDRESS OF LABEL SEQUENCE ADA MIN1 LDB 0,I NUMBER AND SEE IF IT'S ZERO. SZB,RSS IF IT IS, PLACE THE CURRENT JSB MKSEQ SEQNO THERE. DOEXX LDA NEXT IF NEXT CHARACTER IS A CPA COMM'A COMMA, JMP DOEXT GO GET THE NEXT SYMBOL, JMP RAC ELSE GO TO READ NEXT LINE. SPC 1 * ENT PROCESSOR * SPC 1 DOENT JSB SOP PROCESS SYMBOL. CPA COMMA IF NEXT CHARACTER IS A COMMA, RSS SKIP FOR REFRESH JMP RAC ELSE GO TO READ NEXT CARD. CCA REFRESH NUMBER-OF-OPERANDS STA TEMP2 COUNTER, AND JMP DOENT GO TO GET THE NEXT SYMBOL. SPC 1 * COM PROCESSOR * SPC 1 DOCOM JSB ID GET A SYMBOL JMP RAC END OF STATEMENT. JSB CHEKR JMP DOCM1 JSB LLKUP PUT IN LABEL TABLE. CCB JSB PUTSQ PUT SEQUENCE NUMBER IN XTAB. DOCM1 LDA NEXT IF NEXT CHARACTER IS A CPA LPREN LEFT PARENTHESIS, JMP COMRG GO TO PROCESS ARGUMENT. COM1 CPA COMMA IF A COMMA, JMP DOCOM GO GET NEXT COMMON ENTRY. JMP RAC ELSE GET NEXT RECORD. COMRG JSB CHAR PROCESS ARGUMENT. CPA RPREN IF NEXT CHAR. IS A RIGHT PAREN, JMP *+4 GO GET NEXT COM ENTRY. CPA FEED IF A LINE FEED, THEN JMP RAC END OF CARD. JMP COMRG ELSE GET NEXT CHARACTER. JSB CHAR JMP COM1 SPC 1 * NAM PROCESSOR * SPC 1 DONAM LDA CCNT GET CURRENT CHARACTER COUNT. STA NAMLN SAVE FOR EXTENSION PROCESSING. JSB ID GET THE NAME JMP RAC NOT THERE LDA LABEL GET FIRST CHARACTER OF NAME AND MASK8 IOR UPBLN AND PRECEDE IT BY A BLANK. STA NAME MOVE TO NAME LOCATION. LDA LABEL+1 STA NAME+1 LDA LABEL+2 STA NAME+2 LDA CCNT GET CURRENT CHARACTER COUNT. CMA,INA,SZA,RSS MAKE POSITIVE. ZERO ? JMP RAC YES, GO GET NEXT RECORD. ADA NAMLN ANY MORE TO PROCESS ? SSA,RSS JMP RAC NO. GO TO READ NEXT RECORD. LDA .NMEX ADA Ez.NMEX STA NAMLN LDA NEXT GET LAST CHARACTER READ. RSS GO TO CHECK FOR FIRST BLANK. FBLNK JSB CHAR YES, EXAMINE NEXT CHARACTER. CPA FEED IF CHAR. IS A LINE FEED, THIS IS JMP RAC END OF STRING. GO READ NEW REC CPA BLANK IS THIS BEGINNING OF NAM EXTENT? RSS YES, GO TO PROCESS. JMP FBLNK NO. GO SEARCH FOR 1RST BLANK. LDB DM40 (B) = MAX CHAR. COUNT. LDA CCNT GET CURRENT CHAR. COUNT. ADA DEC40 IS NAM EXTENT >40 CHARS.? SSA STB CCNT YES, SET = 40 MAX CHARS. LDA BLANK (A)= ASCII BLANK. MVEXT LDB NAMLN JSB A2BUF ISZ NAMLN JSB CHAR GET THE NEXT CHARACTER. LDB CCNT GET NUMBER OF CHARS. ALREADY MOVED. SZB EXTENSION BUFFER FULL ? CPA FEED NO. IF THIS CHARACTER IS A LINE FEED, JMP RAC THAT'S ALL. JMP MVEXT GO BACK FOR MORE. SPC 1 * END PROCESSOR * SPC 1 DOEND JSB SOP PROCESS ELEMENT FOLLOWING END. LDA TAPNO SET TAPE NUMBER STA TPCNT TO TAPE COUNT * SPC 1 * OUTPUT SECTION * SPC 1 LDA RUN GET RUN FLAG SZA NEW PASS: OPERATOR SPEC'D LIMITS? JMP *+3 YES, DON'T FORCE NEW HEADER. CCA SET LINE COUNT TO -1 TO FORCE PAGE EJECT STA LINES TITLE AT THE BEGINNING. LDA LABCT COMPLEMENT LABCT TO FACILITATE STA LBLCT CMA ITS USE AS A COUNTER. STA LABCT SPC 1 * SECTION TO PROCESS A SINGLE LABEL * SPC 1 DUMP ISZ LABCT ANY MORE LABELS ? JMP DOLAB YES. LDA LETOP GET LIMIT PARAMETER. SZA,RSS LIMITS SUPPLIED FROM KEYBOARD ? JMP STOP NO, TERMINATE XREF ISZ RUN SET RUN NOT EQUAL TO ZERO JMP RSTAR RETURN FOR NEXT LIMITS * DOLAB LDA MAXCC SET CCNT SO AS TO FORCE A STA CCNT  BLANK LINE. JSB LINE * * SEARCH LABEL TABLE TO FIND THE FIRST LABEL, ALPHABETICALLY * * LDA MASK8 INITIALIZE TO A STA LABEL MAXIMUM. LDA FWA INITIALIZE LPNTR TO POINT AT STA PNTR1 FIRST ENTRY. LDA LTAB. SET LTAB. AS END OF TABLE CMA,INA POINTER. STA PNTR2 CLA INTIALIZE ORDNL TO STA ORDNL ZERO. DOLB1 ISZ ORDNL ADVANCE ORDNL. LDB PNTR1 TEST FOR END OF LTAB. ADB PNTR2 SSB,RSS SKIP IF NOT END OF LABEL TABLE. JMP GOTLB GO TO PRINT SECTION. * * MOVE CURRENT LABEL TO TEST ARRAY. * * LDA BLBL FIRST INITIALIZE TO BLANKS. STA TEST+1 STA TEST+2 STA TEST+3 STORE BLANKS IN TEST BUFFER LDA PNTR1 SET TEMP TO POINT AT CURRENT STA TEMP LABEL. LDB .TEST SET B TO POINT AT TEST ARRAY. LDA TEMP,I GET FIRST WORD OF LABEL IN A. AND MASK8 GET FIRST CHARACTER IN STA TEST TEST. XOR TEMP,I GET WORD COUNT IN HI-PART OF A. ALF,ALF ROTATE TO LO-PART. CMA,INA STORE AS NEGATIVE IN COUNT. STA COUNT DOLB2 ISZ TEMP ADVANCE LABEL POINTER. ISZ COUNT TEST FOR ANY MORE WORDS IN LABEL INB,RSS ADVANCE TEST POINTER, SKIP JMP COMPR GO TO COMPARISON SECTION. LDA TEMP,I GET NEXT WORD OF LABEL. STA 1,I AND MOVE IT TO TEST ARRAY. JMP DOLB2 SPC 1 * COMPARISON SECTION * SPC 1 COMPR LDA .LAB SET TEMP1 TO POINT STA TEMP1 AT LABEL LDB .TEST AND B TO POINT AT TEST LDA MIN4 SET COUNT TO -4 STA COUNT DOLB3 LDA TEMP1,I GET LABEL WORD IN A AND CMA,INA SUBTRACT IT FROM ADA 1,I TEST WORD. SSA IF TEST WORD IS SMALLER, GO TO JMP MOVE MOVE SECTION; SZA IF BIGGER GO TO JMP KEEP KEEP SECTION. oNLH ISZ COUNT TEST FOR ANY MORE WORDS. RSS YES. JMP KEEP NO--SHOULDN'T COME HERE ISZ TEMP1 ADVANCE LABEL POINTER INB AND TEST POINTER JMP DOLB3 MOVE LDA 1,I MOVE TEST WORD TO LABEL STA TEMP1,I ISZ TEMP1 ADVANCE INB POINTERS. ISZ COUNT ANY MORE WORDS IN TEST ? JMP MOVE YES. LDA PNTR1 SET UP ADDRESS OF BEST LABEL STA BESTL SO FAR. LDA ORDNL SET ORDINAL OF THAT STA BESTO LABEL ALSO. KEEP LDA TEMP SET PNTR1 TO NEXT LABEL, AND STA PNTR1 GO TO TEST THE JMP DOLB1 NEXT ONE. * SKP * SECTION TO PRINT FOR THE OPTIMUM LABEL * SPC 1 GOTLB LDA BESTL,I STORE A MAXIMUM CHARACTER IOR MASK8 IN THIS LABEL SO THAT WE STA BESTL,I DON'T PICK IT UP AGAIN. XLN LDA LABEL+3 SAVE LAST WORD OF LABEL STA TEMPZ SAVE LAST WORD IN TEMPZ LDA BESTO GET ADDRESS OF XTAB ENTRY JSB ORDLK IN A AND SAVE IN STA PNTR1 PNTR1. LDA PNTR1,I GET LENGTH OF ENTRY AND SAVE STA COUNT IN COUNT. LDB LABEL LOAD B WITH FIRST WORD OF LABEL ADB UPBLN ADD ENTRIES CPA MIN2 SEE IF ONLY ONE ENTRY ADB UPBLN YES. FORCE "@" FOR FIRST CHAR. STB LABEL OF LABEL GOTL1 ISZ COUNT TEST COUNT FOR ANY MORE. JMP *+3 GO TO DO NEXT SEQUENCE NUMBER. JSB LINE JMP DUMP GO TO DO NEXT LABEL. CCA SUBTRACT 1 FROM PNTR1 SO AS ADA PNTR1 TO HAVE IT POINT AT NEXT STA PNTR1 SEQUENCE NUMBER. LDB MIN4 SET MINUS 4 INTO STB PCOUN POWERS OF TEN COUNTER. LDA PNTR1,I LOAD A WITH THE SEQUENCE NUMBER. SSA NEGATIVE SEQUENCE NUMBER? JMP DEFDD YES, PROCESS DOUBLY-DEFINED LABEL. AND MSK12 OBTAIN THE STA SEQNO SEQNO AND XOR PNTR1,I TAPE NO. ROTAT NOP ROTATE TAPE # TO LOW BITS INA INCREMENT A BY ONE STA TAPNO LDA BLANK OUTPUT A BLANK JSB OUTCR CHARACTER. LDA .P10 SET SQ1 TO POINT AT POWERS OF STA SQ1 TEN TABLE LDB SEQNO LOAD A WITH SEQUENCE NUMBER SZB,RSS SKIP IF NOT ZERO JMP UNDEF GO MODIFY DEFINITION AREA DGLUP LDA SIXTY INITIALIZE A TO ASCII 0 ADB SQ1,I TRY & SUBTRACT A POWER OF TEN. SSB SKIP IF O.K. JMP *+3 INA BUMP OUTPUT DIGIT JMP *-4 & LOOP. CMB ADD BACK THE ADB SQ1,I POWER OF CMB TEN, AND SAVE STB SEQNO REMAINDER IN SEQNO JSB OUTCR OUTPUT THE DIGI ISZ SQ1 ADVANCE POWER OF 10 POINTER. LDB SEQNO LOAD B WITH SEQUENCE NUΧMBER ISZ PCOUN ANY MORE DIGITS? JMP DGLUP YES. LDA .TAPE LOAD A WITH TAPE # PARAMETER SZA SKIP IF PARAMETER IS ZERO JMP EASYT IF NOT ZERO SKIP OUTPUT TAPE NO. ROUT. SPC 2 * NOW OUTPUT THE TAPE NUMBER.* SPC 1 CPA TPCNT IS THE TAPE COUNT ZERO JMP EASYT YES; GO OUTPUT BLANKS LDA SLASH OUTPUT A SLASH. JSB OUTCR LDB TAPNO GET TAPE NUMBER IN B LDA SIXTY SET A TO ASC 0 ADB MTEN IF B IS GREATER OR EQUAL TO 10 SSB JMP *+3 INA THEN THE FIRST DIGIT IS A 1 JMP *-4 ADB FEED STB TAPNO AND THE SECOND IS TAPNO-10 JSB OUTCR FIRST DIGIT. LDA TAPNO ADA SIXTY JSB OUTCR SECOND DIGIT JMP GOTL1 SPC 1 DEFDD LDA BLANK OUTPUT A BLANK JSB OUTCR CHARACTER. LDA HASH GET ASCII '#'. RSS SKIP UNDEF INITIALIZATION. UNDEF LDA QUEST LOAD A WITH "?" LDB LABEL LOAD B WITH FIRST WORD OF LABEL CPB BL.AS COMPARE FIRST WORD WITH AN ASTERISK LDA STAR LOAD A WITH A "*" CPB BL.EQ COMPARE FIRST WORD WITH AN "=" LDA DOT LOAD A WITH A "." FIELD JSB OUTCR GO TO OUTPUT CHARACTER ROUTINE ISZ PCOUN INCREMENT POINTER JMP FIELD RETURN FOR NEXT CHAR LDB TPCNT LOAD B WITH TAPE COUNT SZB,RSS SKIP IF COUNT NOT ZERO EASYT LDA BLANK OUTPUT JSB OUTCR THREE BLANKS JSB OUTCR WHEN JSB OUTCR TAPNO=1. JMP GOTL1 SPC 1 * ROUTINE TO MOVE A CHARACTER TO THE OUTPUT BUFFER * SPC 1 OUTCR NOP STA CR1 SAVE CHARACTER IN CR1. ISZ CCNT TEST FOR END OF LINE. JMP *+3 NOT END OF LINE. JSB LINE OUTPUT THE LINE. JMP *-3 TRY AGAIN. LDA CR1 PUT THE LDB CPNTR CHARACTER IN THE JSB A2BUF OUTPUT BUFFER. ISZ CPNTR ADVANCE CHARACTER POINTER. LDA CR1 RETURN WITH CHARACTER JMP OUTCR,I STILL IN A. SPC 2 * ROUTINE TO PRINT THE OUTPUT LINE * SPC 1 LNE NOP ISZ LINES ADVANCE THE LINE COUNT. JMP LNE,I IF NOT END OF PAGE SKIP OUT JSB SPC.C DEF C.LST LIST FILE FCB DEF LNSKP # OF LINES TO SKIP CLB,RSS ERROR JMP NOPAG JMP ?FMPE DISPLAY FMGR ERROR NOPAG LDA MIN6 LOAD A WITH -6 FOR NEXT SKIP PAGE END STA LNSKP STORE IN END PAGE SKIP EXEC CALL ISZ PAGNO INCREMENT PAGE NUMBER BINARY LDA PAGNO CONVERT JSB CNDEC BINARY STA PGNUM+1 PAGE INB NUMBER LDA B,I TO ASCII STA PGNUM IN HEDDING LDA DEC40 PRINT THE PAGE LDB .NAME HEADING. JSB WRITE LDA TCNT LDB .TITL JSB WRITE CLA JSB WRITE LDA NLINZ SET LINE COUNT TO -55. STA LINES JMP LNE,I RETURN * SPC 2 LINE NOP JSB LNE GO TEST AND PROCESS EOT LDA TEMPZ RECALL LAST WORD OF LABEL STA LABEL+3 INSTAL INTO LAST POSITION OF LABEL AND MASK8 SAVE LAST CHARACTER CPA BLANK SEE IF LAST CHARACTER IS BLANK JMP *+4 NO; SKIP NEXT FOUR INSTRS, LDA DOT LOAD A WITH A LOW CHAR DOT IOR UPBLN ADD A UPPER BLANK STA LABEL+4 STORE ONLY ONE DOT INSTED OF TWO LDA CCNT GET CHARACTER COUNT IN A SZA,RSS IF 0 THEN IT SHOULD BE -1. CMA ADA DEC73 GET + NUMBER OF CHARS. FOR PRINT. CLE,SLA,ERA IF ODD # CHAR CLEAR JMP ODDCN LOW BYTE OF LAST WORD LINE1 LDB ..LAB GET ADDRESS OF PRINT BUFFER. JSB WRITE LDA BLBL BLANK OUT THE STA LABEL LABEL STA LABEL+1 FIELD. STA LABEL+2 STA LAN$BEL+3 BLANK OUT FIELD STA TEMPZ SET LAST LABEL WORD TO BLANKS LDA OUTBF RESET CPNTR TO POINT ADA MIN1 STA CPNTR BEYOND THE LABEL. LDA SETCC INITIALIZE CCNT STA CCNT & JMP LINE,I RETURN * ODDCN STA WRCNT SAVE WORD COUNT LDB ..LAB BUFFER ADDRESS ADB A POINT TO LAST WORD LDA B,I GET CONTENTS AND MSKUP CLEAR LOW BYTE IOR BLANK INSERT BLANK IN LOW BYTE STA B,I RESTORE WORD LDA WRCNT INCREMENT WORD COUNT INA BY 1 JMP LINE1 * MSKUP OCT 177400 SPC 1 * ROUTINE TO FETCH A CHARACTER FROM A STRING * SPC 1 BUF2A NOP CLE,ERB ROTATE TO GET ADDRESS IN B LDA 1,I GET WORD IN A SEZ,RSS IF E=0, ROTATE TO GET CHARACTER ALF,ALF IN LOW END. AND MASK7 MASK THE CHARACTER JMP BUF2A,I SPC 1 * ROUTINE TO STORE A CHARACTER INTO A STRING * SPC 1 A2BUF NOP STA TEMP SAVE CHARACTER IN TEMP ERB COMPLEMENT LOW ORDER BIT OF B. CME ELB JSB BUF2A OBTAIN MATE TO THIS CHARACTER ALF,ALF IN HIGH END. IOR TEMP INSERT THE OTHER CHARACTER SEZ AND ALF,ALF ROTATE IF NECESSARY. STA 1,I STORE THE WORD & JMP A2BUF,I RETURN. SPC 1 * CHAR GETS THE NEXT CHARACTER FROM THE INPUT STRING * SPC 1 CHAR NOP LDB CPNTR GET CHARACTER POINTER. LDA FEED IN CASE OF END OF RECORD. ISZ CPNTR BUMP CHARACTER POINTER. ISZ CCNT TEST FOR END OF RECORD. JSB BUF2A NOT END OF RECORD. JMP CHAR,I * * LOOK FINDS THE ID IN LABEL IN THE TABLE SPECIFIED * SPC 1 LOOK NOP LDA LOOK,I GET TABLE STARTING ADDRESS. STA .LOOK ISZ LOOK LDA LOOK,I GET TABLE ENDING ADDRESS CMA,INA STORE %AS NEGATIVE STA LOOK. CLA INITIALIZE LOOKC STA LOOKC TO ZERO. ISZ LOOK SET LOOK TO POINT TO RETURN ADRS LOOK1 ISZ LOOKC BUMP COUNTER. LDB .LOOK TEST FOR END OF LIST ADB LOOK. B POSITIVE IF THE END. CLA SSB,RSS SKIP IF NOT END OF LIST. JMP LOOK,I RETURN WITH A=0, IF END OF LIST. * * NEXT 4 INSTRUCTIONS FOR MULTI-OPERAND OP-CODES (E.G. 'MIC') * * LDA .LOOK,I GET FIRST WORD OF TABLE ALF POSITION OPERAND COUNT AND .15 ISOLATE NUMBER OF OPERANDS STA OPCNT SAVE NUMBER OF OPERANDS. LDA .LOOK,I GET FIRST WORD OF LIST ELEMENT ALF,ALF GET NUMBER OF WORDS IN A. AND .15 ISOLATE NUMBER OF WORDS IN ENTRY. LDB .LOOK GET ADDRESS OF LIST ELEMENT IN B ADA 1 AND ADD WORD COUNT TO IT SO IT STA .LOOK POINTS AT NEXT ELEMENT. LDA .LAB SET TEMP TO POINT AT THE STA TEMP LABEL. LDA B,I GET FIRST WORD OF LABEL. AND MASK9 STRIP NUMBER OF OPERANDS. RSS GO TO COMPARE WITH LABEL. LOOK2 LDA 1,I LOAD A WORD FROM THE ELEMENT IN- CPA TEMP,I TO A AND COMPARE WITH LABEL. INB,RSS BUMP LIST ELEMENT POINTER. JMP LOOK1 IF NOT EQUAL GO GET NEXT ELEMENT LDA LOOKC COMPARE TO NEW VALUE OF .LOOK CPB .LOOK RETURN WITH A=LOOKC IF EQUAL. JMP LOOK,I ISZ TEMP BUMP LABEL POINTER ALSO AND JMP LOOK2 CONTINUE CHECKING THIS ELEMENT SPC 1 * LLKUP RETURNS THE ORDINAL OF LABEL IN THE LABEL TABLE * SPC 1 LLKUP NOP JSB LOOK LOOK UP LABEL IN LABEL TABLE FWA DEF * LTAB. BSS 1 END OF LABEL TABLE. SZA IF ORDINAL NOT 0, LABEL IS IN JMP LLKUP,I TABLE, SO RETURN. LDA LABEL GET FIRST WORD OF LABEL AND FIND ALF,ALF ITS WORD COUNT. AND .15 CMA,INA  STORE AS NEGATIVE IN STA PCOUN PCOUN. ADA .XTAB COMPUTE .XTAB-LTAB.+PCOUN-1 CMA,INA AND TEST FOR POSITIVE. ADA LTAB. CMA,SSA JMP OVERR OTHERWISE, TABLE OVERFLOW. LDB .LAB MOVE LABEL TO LABEL TABLE. LDA 1,I A_LABEL WORD STA LTAB.,I PUT IN LTAB ISZ LTAB. BUMP THE INB POINTERS. ISZ PCOUN ANY MORE? JMP *-5 YES LDA MIN2 NO. SET -2 IN XTAB AS NUMBER OF STA .XTAB,I WORDS IN ENTRY. ADA .XTAB SUBTRACT 2 FROM XTAB TO POINT IT STA .XTAB AT NEW BEGINNING OF TABLE. INA STORE A ZERO IN XTAB ENTRY TO CLB SAY THAT LABEL IS UNDEFINED SO STB 0,I FAR. LDA LOOKC RETURN LOOKC AS ORDINAL OF THIS ISZ LABCT LABEL. JMP LLKUP,I SPC 1 * ORDLK GETS THE ADDRESS OF THE NTH ENTRY IN XTAB * SPC 1 ORDLK NOP CMA,INA GET N IN PUTS1 AS STA PUTS1 NEGATIVE. LDA LWA STB MKSEQ TEMPORARILY SAVE CONTENTS OF B ISZ PUTS1 TEST FOR A LINK RSS JMP ORDLK,I ADA 0,I LINK THROUGH XTAB JMP *-4 SPC 1 * MKSEQ STORES THE CURRENT SEQUENCE NUMBER IN 0,I * SPC 1 MKSEQ NOP STA 1 ADDRESS TO LDA DDFLG GET DOUBLY-DEFINED FLAG. SZA PROCESSING DOUBLE-DEF.? JMP *+3 YES, USE ORIG. SEQ. NO. FOR NEW ENTRY. LDA SEQNO GET CURRENT SEQUENCE NUMBER. IOR TAPNO ADD IN THE CURRENT TAPE NUMBER. STA 1,I STORE IT INTO XTAB. JMP MKSEQ,I * DDFLG NOP DOUBLE-DEF FLAG (SEQUENCE/TAPE NO.) * PUTSQ INSERTS THE CURRENT SEQUENCE NUMBER IN XTAB. A CONTAINS THE * ORDINAL, AND B=-1 IF THIS IS ONLY TO BE STORED AS THE LABEL SE- * QUENCE NUMBER, OR B=0 IF THE TABLE MUST BE EXPANDED TO ADD A NEW * ELEMENT TO THE SPECIFIED ENTRY. SPC 1 PUTSQ NOP JSB ORDLK GET ADDRESS OF ENTRY STA TEMP SAVE ADDRESS FOR DOUBLE-DEF PROCESSING. SZB,RSS IF B IS ZERO, GO TO TABLE MOVE JMP PUTS2 SECTION. ADA 1 SET A TO POINT AT LABEL SEQ.NO. LDB 0,I TEST TO SEE IF A SEQUENCE NUMBER SZB IS ALREADY THERE. JMP DDERR DOUBLY DEFINED SYMBOL. PUTS3 JSB MKSEQ NOW COMPUTE THE SEQUENCE NUMBER LDA TEMP GET ENTRY ADDRESS. CLB PREPARE TO CLEAR DOUBLE-DEF FLAG. CPB DDFLG IS THE DOUBLE-DEF FLAG SET? JMP PUTSQ,I NO, RETURN. STB DDFLG YES, CLEAR IT, AND ADD NEW ENTRY. PUTS2 CCB ADD ONE TO THE ADB 0,I NUMBER OF ELEMENTS IN THE STB 0,I ENTRY. ADA 0,I ADD THIS TO A (AND ADD THE 1 INA BACK IN) TO GET THE ADDRESS STA PUTS1 OF THE NEW ELEMENT. LDA .XTAB MOVE ELEMENTS IN [.XTAB+1,PUTS1] STA PUTS5 DOWN 1 LOCATION. CMA -.XTAB-1 ADA LTAB. +LTAB. SSA,RSS IF POSITIVE, THEN JMP OVERR TABLE OVERFLOW. LDB .XTAB SET B TO BEGINNING OF BLOCK. CPB PUTS1 JMP PUTS6 BLOCK MOVED. INB LDA 1,I MOVE A STA PUTS5,I WORD. ISZ PUTS5 ADVANCE DESTINATION POINTER. JMP *-6 PUTS6 CCA DECREMENT .XTAB ADA .XTAB STA .XTAB LDA PUTS1 JMP PUTS3 * DDERR SSB,RSS ALREADY DOUBLY-DEFINED? JMP NEWDD NO, GO PROCESS DOUBLE DEFINITION. LDA TEMP YES, GET XTAB ENTRY-ADDRESS. JMP PUTS2 GO TO ADD NEW ENTRY. NEWDD SWP ADDRESS TO , SEQUENCE NUMBER TO . STA DDFLG SAVE SEQUENCE NUMBER AS DOUBLE-DEF FLAG. IOR RM2 SET SIGN FOR DOUBLE DEFINITION INDICATOR. STA B,I PLACE IN XTAB'S LABEL SEQUENCE NO. LDA TEMP GET ENTRY ADDRESS. JMP PUTS2 GO TO ADD FI^3RST SEQUENCE NO.TO ENTRIES. SPC 1 * ID SCANS THE INPUT STRING & BUILDS THE NEXT IDENTIFIER. IF THERE * IS ONE, IT SKIP RETURNS. SPC 1 ID NOP CLA INITIALIZE ASCII LITERAL FLAG TO 0 STA ALTRL LDA BLBL INITIALIZE LABEL TO BLANKS. STA LABEL+1 STA LABEL+2 STA LABEL+3 BLANK OUT FIELD LDA ONEBL STA LABEL STA L.DLM LDA MIN6 INITIALIZE CHARACTER COUNTER. STA ID1 LDA LABCH SET LABEL CHARACTER POINTER IN STA TEMP1 TEMP1 LDA NEXT IF LAST CHARACTER WAS A CPA FEED FEED , THIS IS THE END OF JMP ID,I CARD ID2 JSB CHAR GET NEXT CHARACTER STA NEXT PUT INTO NEXT. CPA EQUAL IS THE CHAR AN #="? JMP LITRL YES, GO PROCESS THE LITERAL CPA BLANK SKIP BLANKS JMP ID2 JSB LETTR IS IT A LETTER JMP NONID ...NO-GO TO SCAN FOR END OF FIELD SPC 1 * ADD THIS LETTER TO THE LABEL SO FAR * SPC 1 ID4 LDB ID1 LABEL CHARACTER COUNT. INB,SZB,RSS MORE THAN 5 CHARACTERS ? JMP ID3 YES STB ID1 BUMP CHARACTER COUNT ISZ TEMP1 BUMP CHARACTER POINTER LDB TEMP1 INSERT CHARACTER IN JSB A2BUF LABEL STRING LDA LABEL LDB ID1 ADD ONE TO LABEL WORD COUNT SLB,RSS IF ID1 IS EVEN. ADA HIGH1 STA LABEL LDA NEXT LOAD THE LAST CHARACTER READ. CPA TEMP IS THE LAST CHARACTER PROCESSED? ID3 JSB CHAR GET NEXT CHARACTER AND MASK7 ISOLATE THE LOWER 7 BITS STA NEXT SAVE THE NEW CHARACTER ISZ L.DLM CHARACTER #3 OF A LITERAL JMP ID0 NO, CONTINUE ID5 LDB ALTRL ASCII LITERAL? SSB JMP ID7 YES CPA BLANK NO, BLANK? JMP ID6 YES, RETURN ID7 CPA FEED END OF ERCORD? JMP ID6 YES, GO ISSUE A SKIP RETURN. JMP ID 4 NO, GO INSERT CHARACTER IN LABEL ID0 CLB,INB ENTER: B=1 CPB L.DLM CHARACTER #4 OF A LITERAL? JMP ID5 YES GO BACK FOR EOR CHECK JSB LETTR IS IT A LETTER RSS NO JMP ID4 YES JSB DIGIT IS IT A DIGIT JMP ID4 YES STA NEXT ID6 ISZ ID JMP ID,I SPC 1 NOTID STA NEXT SCAN FOR END OF FIELD. CPA BLANK JMP ID,I NONID CPA COMMA JMP ID,I CPA PLUS JMP ID,I CPA MINUS JMP ID,I CPA FEED JMP ID,I JSB CHAR JMP NOTID SPC 1 * LETTER DETERMINES WHETHER THE CHAR IN A IS A LEGAL HPAP LETTER * * LETTR NOP CPA BLANK BLANKS JMP LETTR,I & CPA FEED LINE FEEDS ARE JMP LETTR,I NOT LETTERS. JSB DIGIT IS IT A DIGIT ? JMP LETTR,I YES--NOT A LETTER. LDB 0 GET CHARACTER IN B & CMB,INB SUBTRACT FROM ADB LETMX LETMX SSB IF NOT SMALLER THEN JMP ISLET IT IS A LETTER. ADB LETMN OTHERWISE TEST AGAINST SSB,RSS LETMN. ISLET ISZ LETTR JMP LETTR,I LITRL JSB CHAR GO GET NEXT CHARACTER STA NEXT SAVE THE NEW CHARACTER CPA FEED END OF RECORD? JMP ID,I YES, RETURN CPA BLANK JUMP IF BLANK JMP ID6 YES, RETURN CPA EQ.L COMPARE TO OCTAL 114 "L" JMP ID2 YES, GO PROCESS SYMBOLS LDB MIN2 LOAD: B=-2 STB L.DLM SET THE LITERAL COUNT FLAG. ADB ID1 DECREMENT SYMBOL LIMIT BY 2 STB ID1 ALLOW SYMBOL TO BE 7 CHARS. CLB CPA EQ.A IS IT AN ASCII? CCB YES, THEN SET FLAG TO INDICATE SO STB ALTRL LDB .EQ. NO, LOAD THE SPECIAL "=". LDA EQUAL LOAD AN "=" CHAR. CPA NEXT IS THE NEW CHAR. AN "=" STB NEXT YES, STORE THE SPECIAL "=". JMP ID4 GO ENTER "=" IN TO LABEL STRING. SPC 1 LETMX OCT 55 LETMN OCT -6 ALTRL NOP EQ.A OCT 101 SPC 2 * DIGIT DETERMINES WHETHER THE CHARACTER IN A IS A DIGIT * SPC 1 DIGIT NOP LDB 0 GET CHAR IN B CMB,INB AS NEGATIVE ADB DIGMX COMPARE TO MAXIMUM DIGIT (ASC9) SSB JMP NODIG ADB DIGMN AND TO MINIMUM DIGIT (ASC0) SSB,RSS NODIG ISZ DIGIT SKIP RETURN IF NOT A DIGIT JMP DIGIT,I SPC 1 DIGMX OCT 71 * SKP * CONSTANTS & VARIABLES * SPC 1 SEQNO NOP LABCT NOP .XTAB NOP TAPE1 OCT 004000 TAPE NUMBER --- INCREMENT CONSTANT. TAPNO NOP NEXT NOP DM40 DEC -40 DEC73 DEC 73 DEC80 DEC 80 CCNT NOP CHAR1 NOP STAR OCT 52 BLANK OCT 40 PLUS OCT 53 MINUS OCT 55 SLASH OCT 57 COMMA OCT 54 LPREN OCT 50 RPREN OCT 51 BL.AS ASC 1, * BL.EQ ASC 1, = DOT OCT 56 QUEST OCT 77 EQUAL OCT 75 EQ.L OCT 114 .EQ. OCT 275 L.DLM OCT 440 SSTAR OCT 24000 SPCLB OCT 1452 UPBLN OCT 20000 LINES NOP DEC40 EQU LPREN MAXCC DEC -72 PNTR1 NOP PNTR2 NOP ORDNL NOP TEMP NOP .TEST DEF TEST COUNT NOP ..LAB DEF LABEL-1 .LAB DEF LABEL TEMP1 NOP HIBND BSS 1 LOBND BSS 1 TWO DEC 2 BESTL NOP BESTO NOP MSK12 OCT 003777 11 BIT SEQUENCE NUMBER MASK = 2048. .P10 DEF *+1 DEC -10000,-1000,-100,-10,-1 MIN1 EQU *-1 MTEN EQU *-2 DIGMN EQU MTEN SQ1 NOP MIN4 DEC -5 PCOUN NOP SIXTY OCT 60 CR1 NOP LBLCT OCT 000000 .NAME DEF HEDR .TITL DEF BLBL .NMEX DEF NAMXT NAMLN NOP NLINZ DEC -55 LNSKP DEC -55 OUTBF NOP SETCC DEC -64 MASK7 OCT 177 MASK8 OCT 377 MASK9 OCT 7777 CPNTR NOP FEED OCT 12 .LOOK NOP LOOKC NOP LOOK. NOP MIN2 DEC -2 PUTS1 NOP PUTS5 NOP ONEBL OCT 440 MIN6 DEC -6 INDIR NOP SET FOR COMMA IN MULTI-OP INSTR. TEMP2 NOP OPCNT NOP NO. OPERANDS IN CURRENT STATEMENT. FXEND DEF OPEND "CODED" END OF OP-CODE TABLE. MICOP DEF EJMP POINTER TO START OF MICRO-OPS.I LABCH NOP HIGH1 OCT 400 HASH OCT 43 ASCII '#' ASC 1, LABEL BSS 4 CBUF BSS 40 SUP HEDR ASC 4, PAGE PGNUM ASC 4,0000 ASC 8, NAME ASC 4, NAMXT ASC 20, BLBL ASC 20, CROSS-REFERENCE SYMBOL TABLE TIME ASC 16, TCNT DEC 36 RUN BSS 1 PAGNO NOP .TAPE BSS 1 TPCNT BSS 1 SKP OVERR JSB WRT.C DEF C.TTY CONSOLE FCB DEF OVDEF DEF .11 NOP CLA JMP STOP * OVDEF ASC 11, /XREF: TABLE OVERFLOW .11 DEC 11 TEST BSS 4 ID1 BSS 1 * * WRITE ROUTINE OUTPUTS ONE LINE TO OUTPUT DEVICE * * CALLING SEQUENCE: * LDA # OF CHARS(+) OR 0 IF SINGLE SPACE * LDB BUFFER ADDRESS * JSB WRITE * WRITE NOP SZA,RSS CHECK IF TO SPACE 1 LINE JMP WSPAC YES STA WRCNT SAVE WORD COUNT STB WRI10 STORE BUFFER ADDRESS JSB IFBRK BREAK FLAG SET? DEF *+1 SSA JMP STOP YES, TERMINATE XREF JSB WRT.C OUTPUT ONE LINE DEF C.LST WRI10 NOP DEF WRCNT WRTER CLB,RSS ERROR RETURN JMP WRITE,I RETURN JMP ?FMPE DISPLAY ERROR MESSAGE * WSPAC JSB SPC.C OUTPUT SINGLE SPACE DEF C.LST LIST FILE FCB DEF .1 JMP WRTER ERROR RETURN JMP WRITE,I RETURN * STOP JSB EOF.C WRITE EOF RECORD IN LIST FILE DEF C.LST JMP WRTER ERROR RETURN STOPX LDA NAME GET FIRST NAME CHARACTER. CPA BLBL NAME PRESENT ? JMP STOP1 NO, USE ASTERISKS FOR TERM. MESSG. AND MASK8 STRIP OFF UPPER BLANK IOR CARET ADD LEFT CARET, TO CONFIGURE STA BMESS+7 $END MESSAGE LDA NAME+1 TO INCLUDE STA BMESS+8 THE PROGRAM LDA NAME+2 NAME STA BMESS+9 IF, ANY. STOP1 JSB WRT.C DEF C.TTY DEF BMESS DEF .11 NOP TERM JSB END.C COMPLETION REQUEST DEF CMLST DE8[F .1 DEC10 EQU FEED BMESS ASC 11, /XREF: $END <*****> CMLST NOP * CNDEC NOP BINARY TO DECIMAL ASCII LDB MTEN STB CNDIV LDB A00 STB ASCI STB ASCI+1 STB ASCI+2 LDB CNMBR STB CNMLC CNORG JSB DVUKN DIVIDE BY 10 ADB CNMLC,I STB CNMLC,I SZA,RSS JMP CNOUT JSB DVUKN BLF,BLF ADB CNMLC,I STB CNMLC,I ISZ CNMLC SZA JMP CNORG CNOUT LDB CNMBR+3 LDA CNMBR+1 STA CNMBR+3 STB CNMBR+1 LDB CNMBR JMP CNDEC,I SPC 1 DVUKN NOP CLB CLEAR LOOP COUNTER = QUOTIENT + STB DVTMP DVU00 STA B FLAG ALLOW BIT 15 OF # TO BE SET DVU01 ADA CNDIV DIDIDE BY SUCCESSIVE SUBTRACTION ISZ DVTMP SSA,RSS DONE IF A IS NEG AND B IS POS JMP DVU00 CLEAR B TO ALLOW EXIT SSB EXIT IF POS JMP DVU01 ORIGINAL # TO CONVERT WAS NEG LDB CNDIV DONE CMB,INB ADB A REMAINDER TO B LDA DVTMP ADA MIN1 QUOTIENT TO A JMP DVUKN,I * DVTMP BSS 1 CNDIV NOP CNMLC NOP A00 ASC 1,00 CNMBR DEF *+1 ASCI ASC 3, SPC 1 * * * ?FMPE - ROUTINE TO DISPLAY FMP ERROR AND ABORT XREF * CALLING SEQUENCE: A REG = - ERROR # * B REG = -1 IF ERROR IN SOURCE FILE * = 0 IF ERROR IN LIST FILE * JMP ?FMPE * ?FMPE STB FMPMV SAVE B REG CMA,INA CONVERT ERROR # INTO +VE JSB CNDEC CONVERT ERROR # TO ASCII INB DLD B,I GET LAST 4 DIGITS DST FMPER+10 LDB FMPMV GET FILE # LDA .INPT SSB,RSS IF -1 THE SOURCE FILE ADA .3 OTHERWISE LIST FILE STA FMPMV DLD A,I GET FIRST 2 WORDS OF FILE NAME DST FMPER+13 LDA FMPMV ADA .2 LDA A,I THIRD WORD OF FILE NAME STA FMPER+15 JSB WRNLHT.C DISPLAY MESSAGE ON CONSOLE DEF C.TTY CONSOLE FCB DEF FMPER MESSAGE ADDRESS DEF .16 NOP JMP STOPX TERMINATE XREF * FMPMV NOP FMPER ASC 16, /XREF: FMP ERROR - .INPT DEF INPUT INPUT ASC 3,SOURCE ASC 3,LIST * * MORE CONSTANTS,ETC. * WRCNT NOP .1 DEC 1 .2 DEC 2 .3 DEC 3 .6 DEC 6 .7 DEC 7 .15 DEC 15 .16 DEC 16 .18 DEC 18 .23 DEC 23 .55 DEC 55 MAXIMUM ALLOWABLE LINES/PAGE OCTCL OCT 1100 CARET OCT 036000 .M16 DEC -16 N19 DEC -19 DEF1 DEF .1 DEFS OCT 124 DEFC OCT 125 TDEFS NOP TDEFC NOP RM1 OCT 077777 RM2 OCT 100000 RM3 RAL RM4 OCT 003777 RM5 OCT 004000 RM6 ALF,RAL DEFCB DEF CBUF DEFLB DEF LABEL LETOP NOP TEMPZ NOP EMESG ASC 18, /XREF: ENTER LIMITS OR ?_ SLSHE ASC 1,/E TPMSG ASC 10, /XREF: >16 TAPES !! * SKP ************************************************************************* * * * * OPERATOR BRANCH TABLE * * * * N* EACH SINGLE ENTRY CORRESPONDS 1 FOR 1 WITH A 3-WORD OP-TABLE ENTRY. * * * * ENTRIES ARE ADDRESSES OF OPCODE/OPERAND PROCESSORS. * * * * EXAMPLES: * * * * << STANDARD OPCODES >> * * DEF DOSOP ABS : OPCODE WITH SINGLE OPERAND. * * * * << SPECIAL OPERANDS >> * * DEF DONAM NAM : PROCESS 'NAM' STATEMENT. * * * * << SPECIAL OPCODES >> * * DEF DOSPC IFN : OPCODE MODIFIES ASSEMBLED RESULTS, * * HAS NO DEFINING LABEL, AND * * DOES NOT HAVE AN OPERAND. * * * * DEF DOSP1 ORG : (SAME AS DOSPC) BUT, HAS OPERAND. * * * ************************************************************************* SPC 3 SWICH DEF *+1,I * SJMP EQU * START OF BRANCH TABLE * DEF RAC 0 NO OP-TABLE ENTRY FOUND DEF DOSOP ABS DEF DOSOP ADA DEF DOSOP ADB DEF DOSOP ADX DEF DOSOP ADY DEF DOSOP AND DEF DOSOP ASC DEF DOSOP ASL DEF DOSOP ASR DEF DOSOP ATD DEF DOSOP BAD DEF DOSOP BDV DEF DOSOP BMY DEF DOSOP BSS DEF DOZSOP BTD DEF DOSOP CBS DEF DOSOP CBT DEF DOSOP CLC DEF DOSOP CLF DEF DOSOP CMW DEF DOCOM COM DEF DOSOP CPA DEF DOSOP CPB DEF DOSOP DAD DEF DOSOP DBL DEF DOSOP DBR DEF DOSOP DCP DEF DOSOP DCS DEF DOSOP DEF DEF DOSOP DIV DEF DOSOP DJP DEF DOSOP DJS DEF DOSOP DLD DEF DOSOP DSB DEF DOSOP DSF DEF DOSOP DSN DEF DOSOP DST DEF DOSOP DTA DEF DOSOP DTB DEF DOSOP EMA DEF DOEND END DEF DOENT ENT DEF DOSOP EQU DEF DOEXT EXT DEF DOSOP FAD DEF DOSOP FDV DEF DOSOP FMP DEF DOSOP FSB DEF DOSOP HLT DEF DOSPC IFN DEF DOSPC IFZ DEF DOSOP IOR DEF DOSOP ISZ DEF DOSOP JLY DEF DOSOP JMP DEF DOSOP JPY DEF DOSOP JRS DEF DOSOP JSB DEF DOSOP LAX DEF DOSOP LAY DEF DOSOP LBX DEF DOSOP LBY DEF DOSOP LDA DEF DOSOP LDB DEF DOSOP LDX DEF DOSOP LDY DEF DOSOP LIA DEF DOSOP LIB DEF DOSOP LSL DEF DOSOP LSR DEF DOSOP MBT DEF DOSOP MIA DEF DOSOP MIB DEF DOMIC MIC DEF DOSOP MPY DEF DOSOP MVW DEF DONAM NAM DEF DOSPC ORB DEF DOSP1 ORG DEF DOSPC ORR DEF DOSOP OTA DEF DOSOP OTB DEF DOSOP RAM DEF DOSOP REP DEF DOSOP RRL DEF DOSOP RRR DEF DOSOP RPL DEF DOSOP SSM DEF DOSOP SAX DEF DOSOP SAY DEF DOSOP SBS DEF DOSOP SBX DEF DOSOP SBY  DEF DOSOP SFC DEF DOSOP SFS DEF DOSOP SJP DEF DOSOP SJS DEF DOSOP SPC DEF DOSOP STA DEF DOSOP STB DEF DOSOP STC DEF DOSOP STF DEF DOSOP STX DEF DOSOP STY DEF DOSOP TBS DEF DOSOP UJP DEF DOSOP XCA DEF DOSOP XCB DEF DOSOP UJS DEF DOSPC XIF DEF DOSOP XLA DEF DOSOP XLB DEF DOSOP XOR DEF DOSOP XSA DEF DOSOP XSB * EJMP EQU *-SJMP NO. OF BRANCH TABLE ENTRIES * DEF DOSP1 OP-CODES DEFINED BY MIC INSTR. * * * END OF BRANCH TABLE * * SKP *************************************************************************** * * * * OPERATOR TABLE * * * * * EACH 3-WORD ENTRY CORRESPONDS 1 FOR 1 WITH ONE BRANCH TABLE ENTRY. * * * * FORMAT: O*OOO*WWW*WAA*AAA*AAA, A*AAA*AAA*AAA*AAA*AAA * * * * WHERE: OOOO (WORD#1 BITS 15-12) = NO. OPERANDS THIS OP-CODE. * * [ 0 FOR ONE OPERAND; ACTUAL NO. FOR >1 OPERAND. ] * * WWWW (WORD#1 BITS 11-08) = NO. WORDS THIS ENTRY. * * AAAAAAAA (WORD#1 BITS 07-00) = 1RST ASCII CHAR. OF OP-CODE. * * AAAAAAAAAAAAAAAA (WORD#2)= PACKED ASCII CHARS.2/3 OF OPCODE. * * * *************************************************************************** SPC 3 OPBEG EQU * START OF OPERATOR TABLE * OCT 1101,41123,1101,42101,1101,42102 ABS7 ADA ADB OCT 1101,42130,1101,42131,1101,47104 ADX ADY AND OCT 1101,51503,1101,51514,1101,51522 ASC ASL ASR OCT 21101,52104,21102,40504,31102,42126 ATD BAD BDV OCT 31102,46531,1102,51523,21102,52104 BMY BSS BTD OCT 21103,41123,1103,41124,1103,46103 CBS CBT CLC OCT 1103,46106,1103,46527,1103,47515 CLF CMW COM OCT 1103,50101,1103,50102,21104,40504 CPA CPB DAD OCT 1104,41114,1104,41122,21104,41520 DBL DBR DCP OCT 1104,41523,1104,42506,1104,44526 DCS DEF DIV OCT 1104,45120,1104,45123,1104,46104 DJP DJS DLD OCT 21104,51502,31104,51506,1104,51516 DSB DSF DSN OCT 1104,51524,21104,52101,21104,52102 DST DTA DTB OCT 1105,46501 EMA OCT 1105,47104,1105,47124,1105,50525 END ENT EQU OCT 1105,54124,1106,40504,1106,42126 EXT FAD FDV OCT 1106,46520 FMP OCT 1106,51502,1110,46124,1111,43116 FSB HLT IFN OCT 1111,43132,1111,47522,1111,51532 IFZ IOR ISZ OCT 1112,46131,1112,46520,1112,50131 JLY JMP JPY OCT 21112,51123 JRS OCT 1112,51502,1114,40530,1114,40531 JSB LAX LAY OCT 1114,41130,1114,41131,1114,42101 LBX LBY LDA OCT 1114,42102,1114,42130,1114,42131 LDB LDX LDY OCT 1114,44501,1114,44502,1114,51514 LIA LIB LSL OCT 1114,51522,1115,41124,1115,44501 LSR MBT MIA OCT 1115,44502,1115,44503,1115,50131 MIB MIC MPY OCT 1115,53127,1116,40515 MVW NAM OCT 1117,51102,1117,51107,1117,51122 ORB ORG ORR OCT 1117,52101,1117,52102,1122,40515 OTA OTB RAM OCT 1122,42520,1122,51114,1122,51122 REP RRL RRR OCT 1122,50114,1123,51515 RPL SSM OCT 1123,40530,1123,40531,21123,41123 SAX SAY SBS OCT 1123,41130,1123,41131,1123,43103 SBX SBY SFC OCT 1123,43123,1123,45120,1123,45123 SFS SJP SJS OCT 1123,50103,1123,52101,1123,52102 SPC STA STB OCT 1123,52103,1123,52106,1123,52130 STC STF STX OCT 1123,52131,21124,41123,1125,45120 STY TBS UJP OCT 1125,45123,1130,41501,1130,41502 UJS XCA XCB OCT 1130,44506,1130,46101,1130,46102 XIF XLA XLB OCT 1130,47522,1130,51501,1130,51502 XOR XSA XSB * OPEND EQU * END OF BASIC INSTRUCTION SET * * THE EXPANSION TABLE ** MUST ** IMMEDIATELY FOLLOW THE OPERATOR TABLE! * * BSS 1024 EXPANSION AREA FOR 'MIC'-DEFINED OP-CODES * A EQU 0 B EQU 1 SPC 1 UNS SPC 1 END XREF 7 % 92067-18013 1805 S C0222 &#EMA1 RTE-IV EMA FIRMWARE VERIFIER             H0102 KASMB,R,L,C HED EMA FIRMAWARE ON-LINE DIAGNOSTIC NAM #EMA,3,99 92067-16013 REV.1805 780323 EXT EXEC,.DIO.,.IOI.,.DTA.,MMAP,.EMAP,.EMIO EXT $LIBR,$LIBX,IFBRK ENT #EMA EMAA EMA 0,0 * * DATE: 03/23/78 * NAME: #EMA * SOURCE: 92067-18013 * RELOC: 92067-16013 * PGMR: DJV * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * * EMA FIRMWARE ON-LINE DIAGNOSTIC * * THIS IS A DIAGNOSTIC FOR THE 21MX E-SERIES EMA FIRMWARE. * IT OPERATES UNDER CONTROL OF AN RTE-IV SYSTEM. * * TO EXECUTE: * * RU,#EMA,LU,#TIMES * * PRINT MESSAGES ON LU. IF LU NEGATIVE, PRINT ONLY ERROR * MESSAGES. DEFAULT IS LU 1. #TIME IS NUMBER OF TIMES TO] * RUN THE DIAGNOSTIC. IF NEGATIVE, RUN CONTINUOUSLY. DEFAULT * IS ONCE. SET BREAK FLAG TO STOP. * A EQU 0 B EQU 1 XID EQU 1717B POINTS TO ID SEGMENT XIDEX EQU 1645B POINTS TO ID SEGMENT EXTENSION BPA2 EQU 1743B BASE PAGE FENCE SWAP EQU 1736B THE SWAP WORD * * FOLLOWING LOCATIONS ARE USED THROUGHOUT THE PROGRAM * ASV NOP PLACES TO SAVE A BIG OCT 77777 A BIG NUMBER BSV NOP AND B CNTR NOP COUNTS NUMBER OF TIMES THROUGH THE PROGRAM EMASZ NOP WILL HOLD THE NUMBER OF PAGES OF EMA ERCNT NOP COUNTS NUMBER OF ERRORS FLAG NOP IF = 1, DON'T PRINT INFO MESSAGES LSMSG NOP THE LAST MSEG REG +1 LU NOP PUT THE OUTPUT LU HERE M1 DEC -1 MSEG NOP STORES MSEG SIZE IN PAGES NAME NOP POINTS TO NAME OF ROUTINE BEING TESTED (FOR ERRORS) NPAGE NOP HOLDS NUMBER OF PAGES ONE DEC 1 PAGE NOP STORES STARTING PHYSICAL PAGE OF THIS PROG PART NOP HOLDS THE PARTITION NUMBER SAMSG NOP HOLDS START ADDRESS OF MSEG SOFT NOP SET TO ONE IF USING SOFTWARE SPMSG NOP LOGICAL START PAGE MSEG STEMA NOP PHYSICAL START PAGE EMA SWPSV NOP TO SAVE THE SWAP WORD PGSTR NOP HOLDS STARTING LOGICAL PAGE OF THIS PROG TEMP NOP TMPDX NOP HOLDS ID EXT. WORD ZERO TSTNO NOP HOLDS THE CURRENT TEST NUMBER TWO DEC 2 ZERO NOP .1 DEC 1 .2 DEC 2 .6 DEC 6 .19 DEC 19 .22 DEC 22 .24 DEC 24 .25 DEC 25 .29 DEC 29 .30 DEC 30 .35 DEC 35 .1024 DEC 1024 * .EMAA DEF EMAA .NMAP DEF NMAP NMAP ASC 2,MMAP .NMMP DEF NMMP NMMP ASC 2,EMAP .NMMI DEF NMMI NMMI ASC 2,EMIO .MAPS DEF MAPS,I MAPS BSS 32 MAP REGISTERS WILL BE STORED HERE .#EMA DEF #EMA * #EMA CLE CLEAR A FLAG XLA B,I GET FIRST PARAM (LU) SZA,RSS SKIP IF NOT ZERO INA IF ZERO, MAKE 1 SSA SKIP IF POSITIVE CMA,CCE,INA IF NEG, MAKE POS, SET FLAG STA LU STORE THE LU CLA THE EXTEND BIT FLAGS THAT LU WAS NEG. ERA STA FLAG INB GET #TIMES XLA B,I SZA,RSS SKIP IF NOT ZERO INA IF ZERO, MAKE 1 CMA,INA MAKE NEGATIVE STA CNTR LDA XID GET EMASZ ADA =D28 GO TO WORD 28 IN THE ID SEGMENT XLA A,I GET IT AND =B1777 STA EMASZ XLA XIDEX,I GET MSEG SIZE AND =B37 STA MSEG LDA .#EMA GET THE STARTING LOGICAL PAGE OF THIS PROG CLB ASR 10 STA PGSTR LDA XIDEX GET LOGICAL START PAGE MSEG INA XLA A,I ASL 5 STB A AND =B37 STA SPMSG FORM START PSAGE MSEG ADA MSEG FORM LAST PAGE OF MSEG+1 INA STA LSMSG SAVE IT LDA SPMSG ASL 10 MAKE LOGICAL START ADDRESS OF MSEG STA SAMSG LDA EMASZ COMPUTE MSEG-EMASZ CMA,INA ADA MSEG SSA IF MSEG>=EMASZ, CAN'T RUN JMP CANRN JUMP IF CAN RUN JSB EXEC PRINT MESSAGE DEF *+5 DEF .2 DEF LU DEF CNTRN DEF .35 JSB EXEC PRINT TERMINTED MESSAGE DEF *+5 DEF .2 DEF LU DEF TERM DEF .19 JSB EXEC NOW QUIT DEF *+2 DEF .6 CANRN LDA EMASZ SEE IF EMA BIG ENOUGH FOR A FULL TEST ADA =D-33 SSA,RSS IF NEGATIVE, TOO SMALL JMP ISFRM NEED EMASZ > 32 PAGES JSB EXEC TELL OPERATOR PARTITION TOO SMALL DEF *+5 DEF .2 DEF LU DEF TOSML DEF .24 ISFRM LDA CLMMP CHECK TO SEE IF THE EMA CALLS AND =B74000 HAVE BEEN RP'ED TO THE CPA =B14000 FIRMWARE OPCODES JMP SFTWR JUMP IF STILL JSB LDA CLEMP MUST CHECK ALL THREE AND =B74000 POSSIBLE CALLS CPA =B14000 COMPARE TO A JSB JMP SFTWR JMP IF STILL A JSB LDA CLEMI CHECK EMIO AND =B74000 CPA =B14000 JMP SFTWR JMP START USING FIRMWARE, GO DO TESTS SFTWR CLA,INA SET A TO 1 STA SOFT SET SOFTWARE FLAG JSB EXEC TELL OPERATOR, USING SOFTWARE DEF START DEF .2 DEF LU DEF NOTFW DEF .30 START LDA SWAP SAVE THE SWAP WORD STA SWPSV JSB $LIBR NOW KLUDGE THE SWAP WORD NOP TO ALLOW SWAPPING LDA =B17 STA SWAP JSB $LIBX DEF *+1 DEF *+1 JSB EXEC NOW LOCK INTO MEMORY DEF *+3 DEF .22 DEF .1 SKP TST00 LDA .NMAP PUT ADDRESS OF "MMAP" IN NAME FOR ERROR OUTPUT STA NAME CLA INITIALIZE THE TEST COUNTER OTA 1 SET THE S RERG STA TSTNO CLMMP JSB MMAP CALL MMAP WITH OFFSET NEGATIVE DEF *+3 DEF M1 A -1 FOR THE OFFSET DEF ONE CPA M1 A SHOULD BE -1 JMP TST01 IF SO, THEN DO NEXT TEST JSB NOER IF NOT, PRINT ERROR MESSAGE DEF TST01 * TST01 JSB INTST INCREMENT THE TEST NUMBER JSB MMAP DEF *+3 ASK FOR A NEGATIVE NUMBER OF PAGES DEF ONE DEF M1 CPA M1 A SHOULD BE -1 JMP TST02 IF IT IS, GO TO NEXT TEST JSB NOER PRINT ERROR MESSAGE DEF TST02 * TST02 JSB INTST INCREMENT THE TEST NUMBER LDA MSEG NOW BUILD A CALL TO ASK FOR MORE PAGES INA THAN ARE IN AN MSEG STA TEMP JSB MMAP DEF *+3 DEF ZERO A ZERO OFFSET DEF TEMP CPA M1 A SHOULD BE -1 JMP TST03 JUMP IF SO JSB NOER PRINT ERROR IF NOT DEF TST03 * TST03 JSB INTST INCREMENT THE TEST NUMBER AND DISPLAY LDA EMASZ NOW BUILD A REQUEST FOR PAGES BEYOND ADA M1 THE EMA STA TEMP JSB MMAP DEF *+3 DEF TEMP OFFSET IS EMASZ-1 DEF TWO ASK FOR 2 PAGES CPA M1 A SHOULD BE -1 JMP TST04 JUMP IF SO JSB NOER OTHERWISE PRINT ERROR MESSAGE DEF TST04 * TST04 JSB INTST INCREMENT THE TEST NUMBER AND DISPLAY JSB MMAP DO A STANDARD MSEG AND A STANDARD DEF *+3 NUMBER OF PAGES DEF ZERO NO OFFSET DEF MSEG SZA,RSS A SHOULD BE ZERO.(SKIP IF IT IS NOT) JMP A4 JSB INCER PRINT ERROR MESSAGE DEF TST05 A4 JSB ICMPS CHECK MAPS. SHOULD BE INCREMENTAL DEF TST05 * TST05 JSB INTST INCREMENT THE TEST NUMBER AND DISPLAY LDA EMASZ ASK FOR 1 PAGE AT END OF EMA TO ADA M1 CHECK READ/WRITE PROTECT BITS. STA TEMP JSB MMAP DEF *+3 DEF TEMP =h DEF ONE WANT ONE PAGE SZA,RSS IF NOT ZERO, THEN ERROR JMP A5 JSB INCER PRINT ERROR DEF TST06 A5 JSB LSTMP LAST PAGE OF EMA SHOULD BE MAPPED IN DEF TST06 * TST06 LDA .NMMP CHANGE NAME TO EMAP STA NAME JSB INTST INCREMENT THE TEST NUMBER CLEMP JSB .EMAP CALL .EMAPFROM AN EMA PROGRAM AND DEF *+4 GIVE A NON-EMA ARRAY DEF NEMA START OF ARRAY DEF TNEM6 TABLE DEF ONE ASK FOR FIRST WORD JMP A6 INCORRECT ERROR RETURN CPB .NEMA SEE IF ADDRESS RIGHT JMP TST07 JUMP IF SO JSB EMAPR ADDRESS WRONG, ERROR DEF TST07 A6 JSB INCER INCORRECT ERROR RETURN DEF TST07 TNEM6 DEC 1 ONE DIMENSION DEC -1 LOWER BOUND IS ONE DEC 1 ONE WORD PER ELEMENT NEMA NOP .NEMA DEF NEMA * TST07 JSB INTST INCREMENT AND DISPLAY THE TEST NUMBER JSB .EMAP TRY A ZERO DIMENSION ARRAY DEF *+4 DEF EMAA THE EMA ARRAY DEF TEMA7 DEF ONE THIS IS IGNORED JMP A7 INCORRECT ERROR RETURN CPB SAMSG SHOULD BE START OF EMA AREA JMP B7 JUMP IF SO LDA SAMSG A HAS WHAT WAS EXPECTED JSB EMAPR PRINT REAL B, EXPECTED B DEF TST08 A7 JSB INCER BAD ERROR RETURN DEF TST08 B7 JSB TOMPS CHECK THE MAP REGISTERS DEF TST08 TEMA7 NOP ZERO DIMENSIONS DEC 0,0 NO OFFSET * TST08 JSB INTST INCREMENT TEST NUMBER JSB .EMAP TRY NEGATIVE NUMBER OF DIMENSIONS DEF *+4 DEF EMAA DEF TEMA8 THE TABLE DEF ONE JMP A8 SHOULD ERROR RETURN JSB NOER IF NOT, THEN ERROR DEF TST09 A8 JSB EEMAP SEE IF A AND B ARE RIGHT DEF TST09 TEMA8 DEC -32768 NEGATIVE NUMBER OF DIMS DEC -1 DEC 1,0,0 * TST09 JSB INTST JSB .EMAP TRY SUBSCRIPT BELOW LOWER BOUND DEF *+4 DEF EMAA DEF TEMA9 DEF M1 JMP A9 SHOULD ERROR RETURN JSB NOER ERROR IF NOT DEF TST10 A9 JSB EEMAP CHECK A AND B DEF TST10 TEMA9 DEC 1 ONE DIMENSION DEC -1 LOWER BOUND IS ONE DEC 1 ONE WORD PER ELEMENT DEC 0,0 OFFSET WORDS * TST10 JSB INTST JSB .EMAP TRY NEGATIVE DIMENSION SIZE DEF *+4 DEF EMAA DEF TEM10 DEF ONE JMP A10 SHOULD ERROR RETURN JSB NOER IF NOT, THEN ERROR DEF TST11 A10 JSB EEMAP CHECK A AND B DEF TST11 TEM10 DEC 1 DEC 0 DEC -1 DEC 0,0 * TST11 JSB INTST JSB .EMAP TRY OFFSET TOO LARGE DEF *+4 DEF EMAA DEF TEM11 DEF ONE JMP A11 SHOULD BE ERROR JSB NOER ERROR IF RETURN HERE DEF TST12 A11 JSB EEMAP SEE IF A AND B RIGHT DEF TST12 TEM11 DEC 1 ONE DIMENSION DEC 0 LOWER BOUND ZERO DEC 1 ONE WORD PER ELEMENT OCT 0,77777 LARGE OFFSET * TST12 JSB INTST JSB .EMAP TRY ARRAY TO LARGE (>1000000) DEF *+5 DEF EMAA DEF TEM12 DEF .2000 ASK FOR ELEMENT 2,000,001 DEF ONE JMP A12 SHOULD ERROR RETURN JSB NOER ERROR IF NOT DEF TST13 A12 JSB EEMAP CHECK A AND B DEF TST13 TEM12 DEC 2 TWO DIMENSIONAL DEC -1 LOWER BOUND 1 DEC 1000 DIMENSION SIZE DEC 0 DEC 1 ONE WORD PER ELEMENT DEC 0,0 NO OFFSET .2000 DEC 2000 * TST13 JSB INTST JSB .EMAP TRY DOUBLE PRECISION CALCULATION OVERFLOW DEF *+6 DEF EMAA DEF TEM13 DEF BIG THIS IS 32767 DEF BIG THIS IS 32767 DEF BIG THIS IS 32767 JMP A13 SOULD BE ERROR RETURN JSB NOER DEF |TST14 A13 JSB EEMAP CHECK A AND B DEF TST14 TEM13 DEC 3 A 3D ARRAY DEC -1 FIRST LOWER BOUND 1 DEC 32767 FIRST DIM DEC -1 SAME FOR THE REST DEC 32767 DEC -1 DEC 1 ONE WORD PER ELEMENT DEC 0,0 NO OFFSET * TST14 JSB INTST JSB .EMAP TRY DISPLACEMENT TO LARGE DEF *+5 DEF EMAA DEF TEM14 DEF BIG DEF BIG THIS IS 32767 JMP A14 SHOULD BE ERROR RETURN JSB NOER DEF TST15 A14 JSB EEMAP CHECK A AND B DEF TST15 TEM14 DEC 2 TWO DIMENSIONAL DEC -1 LOWER BOUND 1 DEC 32767 DEC -1 DEC 1 DEC 32767,32767 BIG OFFSET * TST15 JSB INTST JSB .EMAP TRY A 2D ARRAY DEF *+5 DEF EMAA DEF TEM15 DEF ONE DEF ONE JMP A15 SHOULD NOT ERROR RETURN ADB =D-1 B SHOULD BE START MSEG+1 CPB SAMSG SHOULD BE FIRST ELEMENT JMP B15 LDA SAMSG NOT RIGHT, PRINT MESSAGE INA EXPECTED SAMSG+1 INB B WAS DECREMENTED ABOVE JSB EMAPR DEF TST16 A15 JMP INCER IMPROPER ERROR RETURN DEF TST16 B15 JSB TOMPS CHECK MAPS DEF TST16 TEM15 DEC 2 DEC -1 DEC 1024 DEC -1 DEC 1 ONE WORD PER ELEMENT DEC 1,0 ONE WORD OFFSET * TST16 JSB INTST JSB .EMAP FOLLWING 6 TESTS ARE FOR DEF *+3 NON EMA ARRAYS DEF NEMA THIS IS NEG. DIM TEST DEF TNE16 JMP A16 SHOULD ERROR RETURN JSB NOER ERROR IF NOT DEF TST17 A16 JSB EEMAP CHECK A AND B DEF TST17 TNE16 DEC -1 * TST17 JSB INTST JSB .EMAP SUBSCRIPT BELOW LOWER BOUND DEF *+4 DEF NEMA DEF TNE17 DEF M1 JMP A17 SHOULD ERROR RETURN JSB NOER ERROR IF NOT DEF TST18 @A17 JSB EEMAP CHECK A AND B DEF TST18 TNE17 DEC 1 ONE DIM DEC -1 LOWER BOUND 1 DEC 1 * TST18 JSB INTST JSB .EMAP DIM SIZE NEGATIVE DEF *+4 DEF NEMA DEF TNE18 DEF ONE JMP A18 SHOULD ERROR RETURN JSB NOER ERROR IF NOT DEF TST19 A18 JSB EEMAP CHECK A AND B DEF TST19 TNE18 DEC 1,-1,-1 * TST19 JSB INTST JSB .EMAP 15 BIT OVERFLOW DEF *+4 DEF NEMA DEF TNE19 DEF BIG THIS IS 32767 JMP A19 SHOULD ERROR RETURN JSB NOER DEF TST20 A19 JSB EEMAP CHECK A AND B DEF TST20 TNE19 DEC 1 ONE DIMENSIONAL DEC 0 LOWER BOUND 0 DEC 2 TWO WORDS PER ELEMENT * TST20 JSB INTST JSB .EMAP 16 BIT OVERFLOW DEF *+4 DEF NEMA DEF TNE20 DEF B4000 JMP A20 SHOULD ERROR RETURN JSB NOER DEF TST21 A20 JSB EEMAP CHECK A AND B DEF TST21 TNE20 DEC 1 DEC 0 DEC 4 4B*40000B SETS THE B REG B4000 OCT 40000 * TST21 JSB INTST JSB .EMAP TRY A 2D ARRAY DEF *+5 DEF NEMA DEF TNE21 DEF *+1,I TRY AN INDIRECT DEF ONE ASK FOR THE ELEVENTH WORD JMP A21 SHOULD NOT ERROR RETURN ADB =D-11 SHOULD NOW BE .NEMA CPB .NEMA SEE IF IT IS JMP TST22 JUMP IF OK LDA .NEMA ADA =D11 ADB =D11 SET B BACK, A HAS EXPECTED VALUE JSB EMAPR PRINT ERROR MESSAGE DEF TST22 A21 JSB INCER INCORRECT ERROR RETURN TNE21 DEC 2 DEC 0 DEC 10 ARRAY IS (X , 10 ) DEC 0 LOWER BOUNDS BOTH 0 DEC 1 ONE WORD PER ELEMENT * TST22 JSB INTST JSB .EMAP TRY A(N)-L(N)>32767 DEF *+4 DEF NEMA DEF TNE22 DEF M1 JMP A22 SHOULD ERROR RETURN DLJSB NOER ERROR IF NO ERROR RETURN DEF TST23 A22 JSB EEMAP CHECK A AND B DEF TST23 TNE22 DEC 1 ONE DIMENSION DEC -32768 LOWER BOUND IS 32768 DEC 1 * TST23 JSB INTST LDA .NMMI CHANGE NAME TO EMIO STA NAME CLEMI JSB .EMIO NEGATIVE BUFFER LENGTH DEF *+4 DEF M1 NOP NOP JMP A23 SHOULD ERROR RETURN JMP NOER IF NOT, IS AN ERROR DEF TST24 A23 JSB EEMIO CHECK A AND B DEF TST24 * TST24 JSB INTST LDA EMASZ BUFFER OVERFLOWS END STA TEMP OF EMA JSB .EMIO DEF *+5 DEF .2 A 2 WORD BUFFER DEF TEM24 DEF TEMP BUFFER STARTS AT THE LAST DEF .1024 WORD OF EMA JMP A24 SHOULD ERROR RETURN JSB NOER ERROR IF NOT DEF TST25 A24 JSB EEMIO CHECK A AND B DEF TST25 TEM24 DEC 2 TWO DIMENSIONS DEC -1 LOWER BOUND 1 DEC 1024 RANGE DEC -1 LOWER BOUND FOR SECOND SUBSCRIPT DEC 1,0,0 ONE WORD PER ELEMENT AND NO OFFSET * TST25 JSB INTST LDA MSEG BUFFER ONE PAGE BIGGER INA THAN AN MSEG MPY =D1024 STA TEMP JSB .EMIO BUFFER BIGGER THAN AN MSEG DEF *+4 DEF TEMP DEF TEM25 DEF ONE JMP A25 SHOULD RETURN HERE JSB NOER IF NOT, TEHN ERROR DEF TST26 A25 JSB EEMIO CHECK A AND B DEF TST26 TEM25 DEC 1 DEC 0 DEC 1,0,0 ONE WORD PER ELEMENT, NO OFFSET * TST26 JSB INTST JSB .EMIO TRY A STANDARD MSEG DEF *+4 DEF ONE DEF TEM26 DEF ZERO JMP A26 INCORRECT ERROR RETURN CPB SAMSG SEE IF ADDRESS RIGHT JMP B26 JMP IF OK LDA SAMSG A HAS WHAT B SHOULD BE JSB EMIOR PRINT ERROR MESSAGE DEF TST27 A26 JSB INCER INCORRECT ERROR RETURN  DEF TST27 B26 JSB ICMPS CHECK THE MAPS DEF TST27 TEM26 DEC 1 DEC 0 DEC 1,0,0 * TST27 JSB INTST JSB .EMIO NON-STANDARD MSEG DEF *+5 DEF .1024 OVERLAPS STANDARD MSEG DEF TEM27 DEF MSEG STARTING ELEMENT AT LAST PAGE DEF .1024 JMP A27 SHOULD NOT ERROR RETURN ADB =D-1023 B SHOULD BE LAST WORD OF CPB SAMSG THE FIRST PAGE OF MSEG JMP B27 ADB =D1023 PUT B BACK THE WAY IT WAS LDA SAMSG IF WRONG, PRINT ERROR JSB EMIOR DEF TST28 A27 JSB INCER WRONG ERROR RETURN DEF TST28 B27 JSB OFMPS GO CHECK MAPS DEF TST28 .3000 DEC 3000 TEM27 DEC 2 2 DIMENSION DEC -1 LOWER BOUND 1 DEC 1024 DEC -1 DEC 1,0,0 ONE WORD PER ELEMENT, NO OFFSET * TST28 JSB INTST LDA .NMMP STA NAME LDA XIDEX SAVE THIS LOCATION STA TEMP JSB $LIBR NOW GO PRIVLEDGED NOP CLA CLEAR THE ID EXT. ADDRESS SO STA XIDEX FIRMWARE THINKS THIS IS NON EMA PROG JSB .EMAP GIVE 1D ARRAY DEF *+4 DEF NEMA MUST REMAIN PRIVLEDGED SO THE DEF TNEM6 XIDEX IS NOT RESTORED IN A SWAP DEF ONE JMP A28 SHOULD NOT ERROR RETURN JSB $LIBX DEF *+1 DEF *+1 CPB .NEMA CHECK ADDRESS JMP TST29 JMP IF OK LDA .NEMA THIS IS EXPECTED ANSWER JSB EMAPR EMAP ERROR DEF TST29 A28 JSB $LIBX DEF *+1 DEF *+1 JSB INCER INCORRECT ERROR RETURN DEF TST29 * TST29 JSB INTST LDA .NMAP CHANGE NAME TO MMAP STA NAME JSB $LIBR INTERRUPTS OFF AGAIN NOP CLA CLEAR XIDEX INCASE IT HAS STA XIDEX BEEN RESTORED JSB MMAP MMAP CALL FROM NON EMA PROG DEF *+3 DEF ZERO DEF ONE JSB $LIBX _ DEF *+1 DEF *+1 CPA =D-1 SHOULD ERRO RETURN JMP TST30 JSB NOER INCORRECT RETURN DEF TST30 * TST30 JSB INTST LDA .NMMI CHANGE NAME TO EMIO STA NAME JSB $LIBR GO PRIVLEDGE TO CLEAR XIDEX NOP CLA CLEAR XIDEX STA XIDEX JSB .EMIO THIS IS ILLEGAL DEF *+4 DEF ONE DEF TEM26 DEF ONE JMP A30 SHOULD RETURN HERE LDA TEMP RESTORE XIDEX STA XIDEX JSB $LIBX SYSTEM BACK ON DEF *+1 DEF *+1 JSB NOER ERROR NOT DETECTED DEF TST31 A30 CAX SAVE A LDA TEMP RESTORE XIDEX STA XIDEX JSB $LIBX DEF *+1 DEF *+1 CXA PUT A BACK JSB EEMIO CHECK A AND B DEF TST31 * TST31 LDA SOFT USING SOFTWARE? SZA SKIP IF NOT JMP TST32 THIS TEST WONT WORK WITH SOFTWARE JSB INTST INCREMENT THE TEST NUMBER LDA .NMMP CHANGE NAME TO EMAP STA NAME JSB MMAP FORCE A STANDARD MSEG DEF *+3 DEF ZERO DEF .1 JSB .EMAP CALL EMAP AND ASK FOR DEF *+5 AN ELEMENT IN THE LAST PAGE DEF EMAA DEF TEM31 DEF EMASZ DEF ONE JMP A31 CPB SAMSG B SHOULD BE AT START OF MSEG JMP B31 JMP IF SO LDA SAMSG PRINT ERROR IF NOT JMP EMAPR DEF TST32 A31 JMP INCER INCORRECT ERROR RETURN DEF TST32 B31 JSB GTMPS MUST CHECK MAP REGS LDB SPMSG LOG. START PAGE MSEG LDX .MAPS ADDRESS OF MAPS LAX B,I GET THE FIRST MAP CONTENTS STA TEMP SAVE IT LDA STEMA COMPUTE PHYSICAL PAGE NUMBER OF LAST PAGE ADA EMASZ ADA =D-1 CPA TEMP SEE IF RIGHT JMP C31 JUMP IF OK JSB TOERR PRINT ERROR MESSAGE JMP TST32 C31 INB SECOND MAP REG SHOULD BE PROTECTED LAX B,I AND =B140000 CPA =B140000 JMP *+2 ALL OK JSB TOERR PRINT THE FIRST TO MAP REGS XLA XIDEX,I CHECK NONSTAN MSEG BIT SSA SKIP IF NOT SET JMP TST32 JMP IF OK LDA MSEG BUILD AN APPROXIMATION TO ID EXT 0 IOR =B10000 JMP IDXER GO PRINT ERROR MESSAGE TEM31 DEC 2 2 DIMS DEC -1 DEC 1024 DEC -1 DEC 1 DEC 0,0 NO OFFSET * TST32 EQU * JSB EXEC NOW UNLOCK MEMORY DEF *+3 DEF .22 DEF ZERO JSB $LIBR SET SWAP WORD BACK NOP LDA SWPSV STA SWAP JSB $LIBX DEF *+1 DEF *+1 JSB IFBRK SEE IF BREAK FLAG SET DEF *+1 SSA JMP QUIT LDA CNTR IF CNTR >0, RUN CONTINUOUSLY SSA,RSS SKIP IF NEGATIVE JMP START START OVER ISZ CNTR INCREMENT THE COUNTER JMP START GO AGAIN IF NOT ZERO QUIT LDA ERCNT SEE IF ANY ERRORS SZA SKIP IF NONE JMP EREND JSB EXEC WRITE TERMINATION MESSAGE DEF *+5 DEF TWO DEF LU DEF GDEND DEF .24 JMP FINE EREND LDA LU CLB SEND FAILED TO PASS MESSAGE JSB .DIO. DEF BDEND DEF FINE LDA ERCNT JSB .IOI. JSB .DTA. FINE JSB EXEC TERMINATE DEF *+2 DEF .6 HLT * * EEMAP - CHECK A AND B ON ERROR RETURN FROM EMAP * SHOULD BE A = "15" AND B = "EM" * EEMAP NOP CPA =A15 RSS JMP WGMP CPB =AEM JMP OKMP JMP IF ALL OK WGMP JSB INCER PRINT ERROR IF NOT RIGHT DEF *+1 RETURN HERE OKMP LDA EEMAP,I GET RETURN ADDRESS JMP A,I RETURN * * EEMIO - CHECK A AND B ON ERROR RETURN FROM EMIO. * SHOULD BE A= "16" AND B= "EM" . * EEMIO NOP CPA =A16 RSS pNLH JMP WGIO JUMP IF WRONG CPB =AEM JMP OKIO WGIO JSB INCER WRITE ERROR MESSAGE DEF *+1 OKIO LDA EEMIO,I RETURN JMP A,I * * EMAPR WRITES EMAP ERROR MESSAGE * EMAPR NOP STA ASV THIS IS WHAT B SHOULD BE STB BSV THIS IS WHAT IT IS JSB PTEST PRINT THE TEST NUMBER LDA LU CLB JSB .DIO. DEF FREMP DEF ENMPR LDA ASV JSB .IOI. LDA BSV JSB .IOI. JSB .DTA. ENMPR ISZ ERCNT BUMP THE ERROR COUNT NOP IN CASE ERCNT OVER FLOWS LDA EMAPR,I GET RETURN ADDRESS JMP A,I RETURN * * EMIOR - WRITES EMIO ERROR MESSAGE * EMIOR NOP STA ASV STB BSV JSB PTEST PRINT THE TEST NUMBER LDA LU CLB JSB .DIO. DEF FRIOR THE FORMAT DEF ENIOR LDA ASV JSB .IOI. LDA BSV JSB .IOI. JSB .DTA. ENIOR ISZ ERCNT INCREMENT THE ERROR COUNTER NOP IN CASE ERCNT OVERFLOWS LDA EMIOR,I RETURN JMP A,I * * THE FOLLOWING SUBROUTINE GETS THE USER MAP REGISTERS, THE PHYSICAL * START PAGE OF THE USER AREA, AND THE PHYSICAL START PAGE OF EMA. * A SECTION IS PRIVLEGED SO THAT IT WILL NOT BE SWAPPED BETWEEN * ACCESSES. MEMORY LOCK WAS NOT USED BECAUSE IT MAY BE INHIBITED. N* GTMPS NOP LDA XIDEX GET THE PHYSICAL START PAGE OF EMA INA IT IS THE SECOND WORD IN THE ID EXT. XLA A,I AND =B1777 STRIP OFF UNWANTED STUFF STA STEMA LDA XID GET THE PARTITION NUMBER ADA =D21 WHICH IS IN WORD 21 OF XLA A,I THE ID SEGMENT AND =B77 MASK OUT JUST PARTITION NUMBER INA STA PART LDA .MAPS PUT ADDRESS OF MAPS BUFFER IN A JSB $LIBR THIS IS REQUIRED BECAUSE USA MAY NOP CAUSE A DM WHEN IT SHOULDN'T USA COPY USER MAPS OUT JSB $LIBX DEF *+1 DEF *+1 JSB EXEC NOW GET PHYSICAL START PAGE OF THIS PARTITION DEF *+6 DEF .25 DEF PART DEF PAGE DEF NPAGE DEF TEMP ISZ PAGE SKIP BASE PAGE JMP GTMPS,I RETURN * * ICMPS CHECKS THE MAP REGISTERS STARTING IN THE USER AREA. * IT ASSUMES THE MAP REG CONTENTS ARE SEQUENTIAL. * ICMPS NOP JSB GTMPS GET THE MAP REGS AND START PHYS. PAGE * * GTMPS GETS THE MAPS (INTO BUFFER MAPS) AND SETS PAGE AND STEMA. * IN THE FOLLOWING, B IS A MAP NUMBER AND X IS THE START OF * THE ARRAY HOLDING THE MAPS. * LDB PGSTR LDX .MAPS START COMPARISON AT MAP FOR BEGINING OF USER AREA ICLP LAX B,I GET MAP REGISTER CONTENTS CPA PAGE SHOULD BE INCREMENTAL PAGES JMP ICEQ JMP IF EQUAL JSB MAPER PRINT ERROR IF NOT DEF ICIDX ICEQ ISZ PAGE INB POINT TO NEXT MAP REG CPB LSMSG SEE IF AT END OF MAP REGS RSS JMP ICLP LOOP BACK IF MORE ICIDX LDA MSEG SHOULD BE MSEG # 0. XCA XIDEX,I CHECK WORD ZERO OF ID EXT. JMP ICEND JUMP IF OK JMP IDXER GO PRINT ERROR MESSAGE ICEND LDA ICMPS,I GET ADDRESS TO RETURN JMP A,I * IDXER STA ASV SAVE THE EXPECTED VALUE IF IDEX0 JSB PTEST PRINT THE TEST NUMBER LDeLA LU NOW PRINT IDEX CLOBBERED MESSAGE CLB JSB .DIO. DEF FRIDX DEF NDIDX LDA ASV PRINT EXPECTED VALUE JSB .IOI. XLA XIDEX,I PRINT REAL VALUE JSB .IOI. JSB .DTA. NDIDX ISZ ERCNT NOP JMP EREND ID EXT. WORD 0 IS GONE, SO TERMINATE * INCER NOP SUBROUTINE TO PRINT ERROR IF INCORRECT ERROR RETURN STA ASV SAVE A AND B STB BSV JSB PTEST PRINT THE TEST NUMBER DLD NAME,I GET THE NAME OF THE FAILING ROUTINE DST FRMT2+2 STORE IT IN THE FORMAT LDA LU NOW CALL THE FORMATTER TO OUTPUT THE MESSAGE CLB JSB .DIO. DEF FRMT2 DEF ENDL2 LDA ASV JSB .IOI. PRINT CONTENTS OF A LDA BSV JSB .IOI. PRINT CONTENTS OF B JSB .DTA. ENDL2 ISZ ERCNT INC THE ERROR COUNTER LDA INCER,I GET THE RETURN ADDRESS JMP A,I * INTST NOP INCREMENT THE TEST NUMBER AND PUT ON S ISZ TSTNO LDA TSTNO OTA 1 ADA =D-32 IF > 32, IN A LOOP SSA,RSS IF < 0, OK JMP EREND TERMINATE THE PROGRAM JMP INTST,I * * LSTMP CHECKS THE MAP REGISTERS ASSUMING THE LAST PAGE OF * EMA IS THE ONLY ONE MAPPED IN. THE REST OF THE MSEG * IS PROTECTED. * LSTMP NOP JSB GTMPS GET THE MAPS AND PHYS START PAGE OF THIS PARTITION LDB PGSTR GET LOGICAL START ADDRESS OF THIS PROG LDX .MAPS B POINTS TO MAP REG FOR START OF THIS PROG LSLP LAX B,I GET THE MAP REG CONTENTS CPA PAGE SHOULD MATCH PHYSICAL PAGE JMP LSEQ JSB MAPER PRINT ERROR IF NO MATCH DEF LSEND LSEQ ISZ PAGE INCREMENT PHYSICAL PAGE COUNTER INB INCREMENT POINTER TO MAPS CPB SPMSG SEE IF IN MSEG YET RSS SKIP IF SO JMP LSLP JUMP IF MORE TO CHECK LDA STEMA BUILD THE PHYSICAL PAGE NUMBER FOR ADA EM?ASZ THE LAST PAGE OF EMA ADA M1 STA PAGE LAX B,I GET NEXT MAP CPA PAGE AND CHECK IT RSS JMP LSER JMP IF BAD INB LSLP2 LAX B,I GET THE MAP REG CONTENTS AND =B140000 REST OF PAGES SHOULD BE READ/WRITE PROTECTED CPA =B140000 SEE IF RIGHT JMP LSEQ2 JUMP IF OK LAX B,I GET MAP REG CONTENTS LSER JSB MAPER PRINT THE ERROR MESSAGE DEF LSIDX LSEQ2 INB CPB =D32 SEE IF AT END OF MAPS RSS IF SO, DO NEXT TEST JMP LSLP2 IF NOT, GO BACK AND DO SOME MORE LSIDX CLB CHECK ID EXT. WORD 0 LDA EMASZ MUST SEE IF LAST PAGE ADA =D-1 ONLY MAPPED IN STANDARD MSEG DIV MSEG SZB IF NO REMAINDER, STAN MSEG JMP NNSTN JUMP IF NON STAN MSEG ASL 5 SHIFT UP MSEG NUMBER IOR MSEG A IS NOW WHAT IDEX0 SHOULD BE XCA XIDEX,I COMPARE TO REAL IDE0 JMP LSEND JUMP IF OK JMP IDXER OTHERWISE PRINT ERROR NNSTN XLA XIDEX,I GET WORD ZERO AND AND =B100037 MASK OUT MSEG # STA TEMP SAVE IT LDA MSEG IDEX0 SHOULD BE MSEG SIZE WITH IOR =B100000 THE SIGN BIT SET CPA TEMP SEE IF RIGHT JMP LSEND JUMP IF OK JMP IDXER PRINT ERROR IF WRONG LSEND LDA LSTMP,I GET RETURN ADDRESS JMP A,I RETURN * MAPER NOP PRINT MMAP ERROR MESSAGE STA ASV WILL HAVE MAP REG CONTENTS ON ENTRY STB BSV WILL HAVE MAP REG NUMBER JSB PTEST PRINT THE TEST NUMBER LDA LU CLB JSB .DIO. DEF FRMAP DEF ENMAP LDA BSV JSB .IOI. LDA ASV JSB .IOI. JSB .DTA. ENMAP ISZ ERCNT INCREMENT THE ERROR COUNTER LDA MAPER,I RETURN JMP A,I * * NOER - PRINTS THE MESSAGE THAT AN ERROR CONDITION * WAS NOT DETECTED * NOER NOP STA ASV SAVE A AND B STB BSV JSB PTEST PRINT THE TEST NUMBER DLD NAME,I GET THE NAME OF THE ROUTINE DST FRNER+2 AND STORE IN THE FORMAT LDA LU NOW CALL THE FORMATTER CLB JSB .DIO. DEF FRNER DEF NDNER LDA ASV JSB .IOI. LDA BSV JSB .IOI. JSB .DTA. NDNER ISZ ERCNT INCREMENT THE ERROR COUNTER NOP NOP IN CAES IT OVERFLOWS LDA NOER,I GET THE RETURN ADDRES JMP A,I AND RETURN * * OFMPS - CHECK THE MAP REGISTERS ASSUMING A NON STANDARD MSEG. * THE FIRST PAGE OF THE MSEG IS THE LAST PAGE OF THE * FIRST STANDARD MSEG. ONLY TWO PAGES ARE CHECKED * IN CASE WE ARE IN A SMALL PARTITION. * OFMPS NOP JSB GTMPS GET THE MAP REGS LDA MSEG GET MSEG SIZE ADA =D-1 MINUS 1 ADA STEMA PLUS PHYSICAL START EMA STA PAGE = PHYS. START THIS MSEG LDA =D-2 CHECK ONLY TWO PAGES STA TEMP LDX .MAPS THE ADDRESS OF THE MAPS LDB SPMSG START CHECKING AT THE MSEG OFLP LAX B,I GET MAP CONTENTS CPA PAGE SEE IF RIGHT RSS SKIP IF SO JMP OFER JMP IF ERROR ISZ PAGE GO TO NEXT LOCATION INB ISZ TEMP JMP OFLP OFEND LDA OFMPS,I RETURN JMP A,I OFER JSB MAPER A MAPPING ERROR DEF OFEND * PTEST NOP PRINT THE TEST NUMBER LDA LU CLB JSB .DIO. DEF FRTST THE FORMAT DEF ENDPT LDA TSTNO GET THE TEST NUMBER JSB .IOI. JSB .DTA. ENDPT JMP PTEST,I * * TOMPS - CHECKS THE MAP REGISTERS SET UP BY EMAP. * IT CHECKS ONLY THE FIRST TWO BECAUSE THAT IS * ALL THAT THE FIRMWARE VERSION OF EMAP SETS UP. * THE CHECK FOR THE NON-STANDARD MSEG BIT SET * IS NOT DONE IF SOFTWARE IS USED. TOMPS NOP JSB GTMPS GET THE MAP REGS [LDB SPMSG GET LOG START PAGE MSEG LDX .MAPS STARTING ADDRESS OF MAPS LAX B,I GET FIRST PHYS. PAGE NUMBER CPA STEMA SEE IF RIGHT JMP *+3 JUMP IF SO JSB TOERR PRINT ERROR MESG. JMP TOEND INB POINT TO NEXT MAP REG CONTENTS LAX B,I ADA =D-1 BACK IT UP ONE CPA STEMA SEE IF THIS ONE RIGHT JMP *+3 JUMP IF SO JSB TOERR GO PRINT ERROR MESG. JMP TOEND LDA SOFT USING SOFTWARE? SZA JMP TOEND YES, END XLA XIDEX,I NONSTAN MSEG BIT SHOULD BE SET SSA,RSS SKIP IF ITS SET JMP *+3 DO ERROR MESSAGE TOEND LDA TOMPS,I GET RETURN ADDRESS JMP A,I RETURN LDA MSEG BUILD AN APROXIMATION OF IOR =B100000 THE ID.EXT. WE EXPECTED JMP IDXER GO DO ID.EXT. ERROR TOERR NOP PRINT THE FIRST TWO MSEG MAP REGS JSB PTEST PRINT THE TEST NUMBER LDA LU NOW PRINT MESSAGE THAT CLB EMAP SET UP MAP REGS WRONG JSB .DIO. DEF FRTWO DEF NDTWO LDA SPMSG GET FIRST MAP REG ADDRESS JSB .IOI. LDA .MAPS AND =B77777 GET ADDRESS OF MAPS ADA SPMSG STA TEMP SAVE IT LDA A,I GET THE MAP REG CONTENTS JSB .IOI. LDA SPMSG INA JSB .IOI. THIS IS THE NEXT MAP REG LDA TEMP INA LDA A,I THIS IS THE CONTENTS JSB .IOI. JSB .DTA. NDTWO ISZ ERCNT BUMP THE ERROR COUNTER NOP JMP TOERR,I RETURN * * FOLLOWING ARE FORMATS AND MESSAGES * SUP TOSML ASC 20, WARNING - PARTITION TOO SMALL FOR COMPL ASC 4,ETE TEST CNTRN ASC 20, *** THIS PARTITION IS TOO SMALL TO EXEC ASC 15,UTE THE ON-LINE DIAGNOSTIC TERM ASC 19, *** EMA ON-LINE DIAGNOSTIC TERMINATED GDEND ASC 24, EMA ON-LINE DIAGNOSTIC SUCCESSFUL COMPLETION BDEND ASC 21,(/," ***EMA FJ$"IRMWARE FAILED TO PASS DIAGNO ASC 12,STIC*** ",I6," ERRORS") FRMT2 ASC 21,( " NAME INCORRECT ERROR RETURN A =",K7,"B ASC 7, B =",K7,"B") FRMAP ASC 20,(" MMAP ERROR. FIRST MAP REGISTER TO MIS ASC 17,COMPARE = ",I2,", CONTENTS = ",I6) FRIOR ASC 22,(" EMIO ERROR. EXPECTED B =",K7,"B ACTUAL ASC 6,B =",K7,"B") FRTST ASC 9,(/," TEST",I2,":") FREMP ASC 22,(" EMAP ERROR. EXPECTED B =",K7,"B ACTUAL ASC 6,B =",K7,"B") FRNER ASC 20,( " NAME DID NOT DETECT ERROR CONDITION ASC 14, A =",K7,"B B =",K7,"B") FRIDX ASC 21,(" ID EXT. WORD ZERO WRONG. EXPECTED =",K7 ASC 12,,"B. ACTUAL =",K7,"B") NOTFW ASC 20, WARNING - EMA DIAGNOSTIC USING SOFTWARE ASC 10, INSTEAD OF FIRMWARE FRTWO ASC 12,(" EMAP MAPPING ERROR.", ASC 15,2(/" MAP REG.",I5," =",I8)) END #EMA t$  92067-18014 1840 S 0122 RTE-IV HEADER              H0101 ASMB,L * * NAME: $CSY4 * SOURCE: 92067-18014 * RELOC: 92067-16014 * PGMR: E.J.W. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM $CSY4,0 92067-16014 REV.1840 780811 END ,   92067-18015 1840 S 0622 RTE-IV DISPATCHER              H0106 mDASMB,R,Q,C ** DISP4 -- RTE-IV DISPATCHER MODULE ** HED DISP4 -- RTE-IV DISPATCHER * DATE: 2/16/77 * NAME: DISP4 * SOURCE: 92067-18015 * RELOC: PART OF 92067-16014 * PGMR: G.A.A.,L.W.A.,D.L.S.,E.J.W.,C.M.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM DISP4,0 92067-16014 REV.1840 780731 * ***** AMD ***** JUL,73 GAA ***** GSD ***** FEB,77 EJW * * DISPATCHER ENTRY POINT NAMES * ENT $RENT,$BRED,$ZZZZ,$XCQ ENT $ALDM,$DMAL,$SMAP,$PRCN ENT $XDM,$MAXP,$UNPE * ENT $BG1,$BG2,$BG3,$BG4,$BG5 ENT $RT1,$RT2,$RT3,$RT4,$RT5 ENT $MM1,$MM2,$MM3,$MM4,$MM5 * * DISPATCHER EXTERNAL REFERENCE NAMES * EXT $MRMP,$MATA,$MPFT,$BGFR,$RTFR EXT $EMRP,$RSRE,$ABRT,$XSIO,$DREQ EXT $WATR,$TIME,$DREL,$TRRN,$SZIT EXT $ABRE,$LIST,$RTST,$SGAF,$ERMG EXT $MCHN,$MBGP,$MRTP,$CFR,$WORK EXT $IOCL,$IRT,$IDLE,$DVPT,$IDEX,$CMST EXT $SDA,$SDT2,$MNP,$XDMP EXT $ABRE,$LIST,$RTST,$SGAF,$SCXX * * ******************************************************************** * * THE DISP MODULE OF THE REAL TIME EXECUTIVE PERFORMS: * * 1. IDLE LOOP IF NO PROGRAMS ARE SCHEDULED OR CAN'T BE EXECUTED * 2. SWITCHES PROGRAM EXECUTION SUCH THAT THE HIGHEST * * PRIORITY EXECUTABLE PROGRAM EXECUTES. * * 3. SETS THE FENCE REGISTER ACCORDING TO PROGRAM TYPE. * * 4. LOADS, SWAPS, AND EXECUTES DISC RESIDENT PROGRAMS * SPC 2 ABORT LDA B,I GET POSSIBLE NEXT PGM STA $ZZZZ AND SET IT FOR ABORT CLA CLcEAR THE XSUSP ADDRESS STA B,I FOR THE NEXT START ADB DM8 BACK UP TO ID-SEG ADDRESS STB A SAVE THE ID-SEG. ADDRESS STB TMP A FEW TIMES ADA D14 CHECK IF DISC RES. LDA A,I PROGRAM AND D15 STA ATMP SAVE TYPE FOR LATER CHECK CPA D1 IS IT DISC RES. PROG? RSS NO, SKIP. JSB DREL RELEASE ANY SWAP TRACKS * LDA ATMP GET PROGRAM TYPE CPA D1 IF MEM RES A <> 0 RSS CLA IF DISC RES A = 0 * LDB TMP RELEASE ANY RE-ENTRENT JSB $ABRE MEMORY PROGRAM OWNS. LDB TMP RELEASE ANY STRING STORAGE JSB $RTST MEMORY THAT THE PROGRAM OWNS. * LDB TMP JSB $WATR SCHEDULE ANYONE WAITING LDB TMP LDA B ADA D20 STA TEMP SAVE ADDR OF FLAG WORD LDA A,I ALF,ALF GET FLAG WORD SLA ANY RESOURCES HELD? JSB $TRRN YES, RELEASE THEM * CLA IF CURRENTLY LDB TEMP,I STA TEMP,I (CLEAR FLAG WORD) SLB IS HE SERIALLY REUSABLE JMP $XCQ YES,LEAVE IN MEMORY * LDA ATMP GET TYPE CPA D1 IS IT MEM RES? JMP $XCQ YES,DONT FOOL WITH PARTITION * LDA TMP GET ID SEG ADR JSB MATEN GO SET UP POINTERS LDB MID,I GET PARTITION OCCUPANT WORD CPB TMP IS PROG STILL RESIDENT? RSS YES JMP $XCQ NO, DONT BOTHER WITH IT * LDA MLNK,I DID PTTN GET UNDEFINED INA,SZA,RSS BY A PARITY ERROR? JMP X0154 YES. KILL POSSIBLE I/O TRANSFER * LDA MADR,I SSA IS IT A MOTHER PTTN? JMP XN353 YES, MOVE PTTN FROM ALLOC TO FREE * LDB MFLGS SSB IS IT A REAL TIME PARTITION? JMP XN253 YES, RT. MOVE PTTN FROM ALLOC TO FREE JMP XN153 NO, BG. M,cOVE PTTN FROM ALLOC TO FREE SPC 2 DM8 DEC -8 D17 DEC 17 SPC 2 $MAXP NOP RE-ESTABLISH MAXIMUM PTTN LIST SIZE WORDS CLA INIT ALL MAX SIZE WORD TO ZERO STA $MCHN STA $MRTP STA $MBGP STA NUMCH INIT ALL PTTN COUNTS BY TYPE TO ZERO STA NUMBG STA NUMRT LDA $MNP CMA,INA,SZA,RSS JMP MXPDN IN CASE 0, EXIT DONE * STA CNT SAVE NEG NUMBER OF PTTN ENTRIES LDA $MATA START AT FIRST PTTN * MXPSL JSB MATAD SET UP PTRS TO MAT ENTRY LDA MLNK,I INA,SZA,RSS IS THIS ENTRY UNDEFINED? JMP MXPNX YES, CHECK NEXT PTTN * LDA MADR,I SSA IS THIS A MOTHER PTTN? JMP MXPCH YES, INCRE COUNT * LDA MFLGS SSA IS THIS A RT PTTN? JMP MXPRT YES, INCRE COUNT * LDB DMBGP SET ADDR OF BG POINTER ISZ NUMBG INCRE COUNT OF BG PTTNS JMP MXPSZ CHECK PTTN SIZE FOR MAX * MXPCH LDB DMCHN SET ADDR OF MOTHER PTTN PTR ISZ NUMCH INCRE COUNT OF CH PTTNS JMP MXPSZ CHECK PTTN SIZE FOR MAX * MXPRT LDB DMRTP SET ADDR OF RT POINTER ISZ NUMRT INCRE COUNT OF RT PTTNS * MXPSZ LDA MLTH,I RAL,CLE,ERA SEZ IS THIS PTTN RESERVED? JMP MXPNX YES, SKIP MAX SIZE CHECK * AND B1777 CHECK LENGTH OF THIS PTTN STA TEMP AGAINST MAX SIZE SO FAR CMA,INA ADA B,I SSA,RSS IS THIS ONE LARGER? JMP MXPNX NO, TRY NEXT PTTN * LDA TEMP YES, SET UP NEW MAX STA B,I * MXPNX LDA MLNK ADA MATSZ INCRE TO NEXT PTTN MAT ENTRY ISZ CNT DONE YET? JMP MXPSL NO, DO NEXT PTTN * MXPDN LDA NUMCH YES, DONE SZA,RSS SET THE PROPER FREE LIST PTR STA $CFR TO ZERO IF THE LIST IS EMPTY LDA NUMRT FOR THE LSTIN SUBROUTINE SZA,RSS STA $RTFR LDA NUMBG SZA,RSS STA $BGFR JSB LSTIN RE-INIT MAT LIST PTRS JMP $MAXP,I RETURN * * NUMCH NOP 0 AT BOOT UP NUMBG NOP 0 AT BOOT UP NUMRT NOP 0 AT BOOT UP DMCHN DEF $MCHN+0 DMBGP DEF $MBGP+0 DMRTP DEF $MRTP+0 * * * INITIALIZE PARTITION MEMORY ALLOCATION TABLE ENTRY LIST POINTERS * CALLED BY BOTH DISPATCHER'S STARTUP CODE AND $MAXP * LSTIN NOP LDA $RTFR IS THERE A RT LIST OR CPA NUMRT WERE ANY IN ALLOC' LIST WHEN A SZA PARITY ERROR OCCURRED? JMP LSTI1 YES, CHECK BG LIST * LDA ABGFR NO, SET UP RT TO SAME AS BG STA ARTFR LDA ABGPR STA ARTPR LDA ABGDM STA ARTDM LDA $MBGP STA $MRTP JMP LSTI2 * LSTI1 LDA $BGFR IS THERE A BG LIST OR CPA NUMBG WERE ANY IN ALLOC' LIST WHEN A SZA PARITY ERROR OCCURRED? JMP LSTI2 YES, CHECK MOTHER PTTN LIST * LDA ARTFR NO, SET BG LIST POINTERS TO RT STA ABGFR LDA ARTPR STA ABGPR LDA ARTDM STA ABGDM LDA $MRTP STA $MBGP * LSTI2 LDA $CFR IS THERE A MOTHER PTTN LIST OR CPA NUMCH WERE ANY IN ALLOC' LIST WHEN A SZA PARITY ERROR OCCURRED? JMP LSTIN,I YES, RETURN * LDA ABGFR NO, SET MOTHER LIST SAME AS BG STA ACHFR LDA ABGPR STA ACHPR LDA ABGDM STA ACHDM LDA $MBGP STA $MCHN JMP LSTIN,I RETURN. AT LEAST ONE LIST REQUIRED * * SKP * CALLING SEQUENCE * JMP $XCQ DIRECT ENTRY IN SYSTEM MAP * OR * JMP $XEQ ENTRY VIA TABLE AREA I IN EITHER MAP * $XCQ LDB $ZZZZ CHECK IF PROGRAM TO BE ABORTED SZB JMP ABORT YES GO HANDLE IT LDB $LIST IF LIST NOT ENTERED SZB,RSS THEN NOTHING NEW SO JMP $IRT GO CONTINUHE CURRENT PGM * X0005 LDA SKEDD LOAD TOP OF SCHEDULE LIST CLB STB $LIST PREVENT NEEDLESS LIST SCANS RSS SKIP FIRST TIME X0035 LDA ZWORK,I GET THE NEXT PGM IN THE LIST SZA,RSS ANY MORE IN SKEDD LIST? JMP ILOOP NO, GO TO IDLE LOOP * CPA SGSUP IS THIS PROG SEGMENT SUSPENDED? LDA A,I YES, SKIP TO NEXT PROG SZA IF ZERO,THEN NO PROG SCHED JMP X0010 GO TO PROCESS SCHED LIST * * NO PROGRAM SCHEDULED--SETUP FOR IDLE LOOP * * * THE IDLE LOOP SECTION CONSISTS OF: * * CLEARING XEQT WORD TO SIGNIFY THAT NO PROGRAM * * CURRENTLY EXECUTING. * * STORE ADDRESS OF 4 DUMMY WORDS INTO XSUSP-XSUSP+3 * * DUE TO I/O PROCESSING. * * SET MEMORY PROTECT REGISTER TO ZERO. * * CALL INTERRUPT RESTORE ROUTINE, $IRT * JUMP TO * * * * ILOOP STA FENCE SET THE FENCE TO ZERO OTA 5 STA XEQT CLEAR XEQT ADDRESS VALUE LDB DIDLE RSS LDB B,I GET DIRECT ADDR RBL,CLE,SLB,ERB FOR IDLE LOOP JMP *-2 STB XSUSP SET BASE PAGE POINTERS INB TO POINT TO DUMMY STB XA LOCATIONS. STB XB STB XEO STB XI JMP $IRT GO TO IDLE LOOP (JMP *) * DIDLE DEF $IDLE+0 DIRECT ADDR TO IDLE LOOP SKP * * THE SWITCHING SECTION USES THE SCHEDULE LIST TO DETERMINE * * WHICH PROGRAM TO EXECUTE-STARTING FROM TOP OF LIST. * * IF PROGRAM FROM LIST OF LOWER OR EQUAL PRIORITY, * * THEN EXECUTION OF CURRENT PROGRAM CONINUES. * * IF RPROGRAM FROM LIST OF HIGHER PRIORITY AND * * TYPE EITHER REAL TIME RESIDENT OR BACKGROUND * * RESIDENT, EXECUTION SWITCHING TAKES PLACE.* * TYPE IS BACKGROUND DISC RESIDENT, * * GO TO BACKGROUND DISC PROCESSING. * * TYPE IS REAL TIME DISC RESIDENT, GO TO REAL * * TIME DISC RESIDENT PROCESSING * * X0010 STA ZWORK SCHED LIST PROG ID SEG ADDRESS ADA D6 STA ZPRIO PRIORITY ADDRESS ADA D8 STA ZTYPE TYPE ADDRESS ADA D7 STA ZMPID MAP WORD ADDRESS ADA D7 STA ZEMA EMA WORD (ID WORD 28) LDA ZMPID,I RAL ALF,ALF GET MP FENCE INDEX AND D7 FOR PROGRAM TO BE DISPATCHED. STA MPN LDA ZEMA,I JSB IDXAD GET ID EXT ADDR JMP X0012 NOT EMA, CLEAR ZIDEX X0012 STA ZIDEX SAVE ADDR OF ID EXT OR 0 * * CHECK IF CURRENT PGM IS STILL TOP. * LDA XEQT SEE IF PROGRAM CURRENTLY EXECUTING SZA,RSS YES SKIP JMP X0030 NO, SO GO XECUTE IT * ADA D15 CHECK STATUS OF XEQT ID SEGMENT LDA A,I AND D15 MASK TO MAJOR STATUS CPA D1 RSS SCHEDULED-SO GO TO CHECK PRIORITY JMP X0030 NOT SCHEDULED -SO GO SWITCH * LDA XPRIO,I LOAD TEST PROGRAM PR CMA,INA MAKE NEGATIVE ADA ZPRIO,I SUPTRACT FROM CURRENT PGM PR. SSA,RSS IF SIGN A=0 THEN PROG OF HIGHER PR JMP $RENT PROGRAM OF HIGHER PRIORITY * * CHECK PROGRAM TYPE * X0030 LDA ZTYPE,I PROGRAM TYPE AND D15 CPA D1 CHECK IF MEMORY RESIDENT JMP X0F40 YES, SET UP TO RUN NOW * LDB ZMPID,I SSB ASSIGNED TO A PARTITION? JMP PCHK YES, GO SEE WHAT TYPE * LDB ZIDEX SZB IS THIS AN EMA PROG? JMP X0300 w YES * CPA D2 REAL TIME DISC RESIDENT? JMP X0200 YES * CPA D3 BACKGROUND DISC RESIDENT? JMP X0100 YES, TREAT AS BG * CPA D4 LARGE BACKGROUND DISC RESIDENT? JMP X0100 YES * JMP X0035 NOT LEGAL TYPE, IGNORE * PCHK LDA B ASSIGNED TO PTTN AT LOAD TIME? AND B77 MPY MATSZ ADA $MATA GET PTTN ADDR ADA D3 LDB A,I SSB IS IT MOTHER PTTN? JMP X0300 YES * ADA D2 GET FLAG WORD LDA A,I SSA IS IT RT? JMP X0200 YES JMP X0100 NO,BACKGROUND * ATMP NOP SKP ADMEM DEF MEMID MEMID NOP MPN NOP INDEX TO MPFT, BP FLAG LTH NOP LSTHD NOP NPGN NOP SPRIO NOP HED DISP4 -- SET UP PROGRAM ID SEG ADR IN XEQT AREA X0F40 LDA ZMPID,I GET MAP ID WORK RAL ALF,ALF GET MP FENCE INDEX AND D7 STA MPN STORE MPFT INDEX LDA ZWORK STA MEMID SET ID FOR MEM RES PROG LDA $EMRP STA RTDRA STA AVMEM STA BGDRA STA BGLWA LDA ADMEM STA MID * CLA NO MAT ENTRY FOR MEM.RES. PROGS STA XMATA STA XIDEX X0040 LDA MID,I GET ID SET ADR ADA D22 GET LOW MAIN LDB A,I STB XI * LDB ZWORK IF SAME AS CURRENT PGM CPB XEQT THEN JMP $RENT SKIP BASE PAGE SET UP. * LDA DM12 LOAD PROGRAM TO BE EXECUTED STA TMP INTO XEQT AREA LDA XQDEF STB XEQT X0041 STB A,I INA INB ISZ TMP JMP X0041 LDB XSUSP,I CHECK IF PROGRAM SUSPENDED CMB,INB,SZB IF SO THEN JMP $RENT GO SET IT UP LDB XPENT,I GET PRIMARY ENTRY PT. STB XSUSP,I SET ENTRY ADDRESS * * CHECK IF PT OF SUSPENSION IN LIBRARY AREA * $RENT LDA XEQT GET PROG TRYING DISPATCH CPTA MID,I HAS SETUP CHANGED RSS NO,GO TO IT JSB FIX GO SET BACK UP CPA ZWORK INSURE Z WORDS RSS MATCH CURRENTLY JSB FIX EXECUTING PROGRAM. * LDA ZTYPE,I AND D7 CPA D1 MEMORY RESIDENT? JMP X0020 GO SET MP FENCE * LDA MLNK STA XMATA SAVE ADDR OF MAT ENTRY LDA ZIDEX STA XIDEX SET UP ID EXT ADDR JMP X0025 * X0020 LDA $MRMP SET UP MEM RES MAP USA X0025 LDB XEQT GET THE RENT BIT ADB D20 LDB B,I GET THE WORD BLF,RBL ROTATE TO PUT RENT BIT IN SIGN SSB,RSS IF RENT NOT IN CONTROL JMP X0028 GO SET FENCE * SLB IF MEMORY MOVED JSB $RSRE GO RESTORE IT LDA ZTYPE,I AND D7 CPA D1 IS PROG MEM RESIDENT? RSS YES, SET UP FOR MEM RES LIB ACCESS JMP X0028 NO, DISC RES CAN'T BE USING MEM RES LIB * LDA LBREG MEMORY RESIDENT AND REENTRANT LDB LB#PG CBX CLEAR WRITE-PROTECT BITS FROM LDB LBPG# RESIDENT LIBRARY PAGES XMS LDA MPN CHECK MRP'S MPFTI ARS SZA MPN > 1 ? JMP X0028 YES, USE THAT MP FENCE SETTING * LDA LBORG NO, LOWER MP FENCE FOR M.R.L. JMP X0029 FROM MRP WITH NO COMMON * * * SET MEMORY PROTECT ACCORDING TO PROG TYPE * * ID SEG WORD 21 !--!--.--.--!--.--.--!--.--.--!--.--.--!--.--.--! * !RP/ #PAGES / MPFTI /**/ PARTITION # ! * !--!--.--.--!--.--.--!--.--.--!--.--.--!--.--.--! * !15!14 13 12!11 10 09!08 07 06!05 04 03!02 01 00! * * MPFTI (MPN) = 0 DISC RESIDENT(TYPE 4), NO COMMON * 1 MEMORY RESIDENT, NO COMMON * 2 ANY PROGRAM, RT COMMON * 3 ANY PROGRAM, BG COMMON * 4 ANY PROGRAM, SSGA * 5 ;DISC RESIDENT(TYPE 2 & 3), NO COMMON * X0028 LDA MPN GET MPFT INDEX ADA $MPFT LDA A,I GET FENCE X0029 STA FENCE OTA 5B * * RESTORE REGISTERS, MEMORY PROTECT, AND TURN ON INTERRUPT SYSTEM * JMP $IRT GO EXECUTE THE PROGRAM * XQDEF DEF XLINK * LBREG NOP RES. LIB. REGISTER # IN USER MAP LBPG# NOP RES. LIB. PHYSICAL PAGE # LB#PG NOP RES. LIB. SIZE IN # OF PAGES SKP * * ****************************************************** ******************************************************* *******NOTE THAT FIX IS BEING CALLED****************** *******TO RESET MAT POINTERS--THUS******************* *******THE TEMP WORDS MUST BE RESET****************** ***************************************************** ****AREG MUST CONTAIN XEQT ON ENTRY************** * FIX NOP ROUTINE TO RESET MAT POINTERS FOR CURRENT PROG STA ZWORK RESET UP TEMP WORDS ADA D6 STA ZPRIO ADA D8 STA ZTYPE ADA D7 STA ZMPID ADA D7 STA ZEMA LDA ZTYPE,I GET PROG TYPE AND D15 CPA D1 JMP X0F40 GO RESET MEM RES INFO * LDA ZMPID,I RAL ALF,ALF GET MP FENCE INDEX AND D7 STA MPN JSB FND GO SET MAT POINTERS, BNDRY WORDS LDA ZEMA,I GET ID EXT WORD JSB IDXAD GET ID EXT ADDR JMP FIX02 NOT EMA, EXIT FIX02 STA ZIDEX SAVE ID EXT ADDR (OR 0) LDA XEQT RESET (A) TO CURRENTLY EXECUTING PROG JMP FIX,I HED DISP4 -- BUFFERS, CONSTANTS, POINTERS, ETC * ZIDEX NOP ZEMA NOP ZMPID NOP * ZWORK NOP SCHED LIST ID SEGMENT ADDRESS ZPRIO NOP SCHED LIST PRIORITY LIST ZTYPE LDB SKEDD SCHED LIST PRIORITY ADDRESS SPC 1 TEMP ADB D6 TEMPORARY WORKING STORAGE AREA TEMP1 STB ZPRIO TEMP2 INA TEMP3 LDB B,I TEMP4 STB A,I TEMP5 CLB TEMP6 STB ZPRIO,I ZEXIT JMP $ZZZZ,I TMP  NOP TEMPORARY WORKING STORAGE TMP1 NOP TMP2 NOP CN#SC NOP CURRENT # SECTORS/TRACK (-) * DM12 DEC -12 DM3 DEC -3 * D1 DEC 1 D2 DEC 2 D4 DEC 4 D5 DEC 5 D6 DEC 6 D7 DEC 7 D8 DEC 8 D14 DEC 14 D15 DEC 15 D20 DEC 20 D21 DEC 21 D22 DEC 22 D27 DEC 27 D32 DEC 32 D33 DEC 33 * C77 OCT 177700 * B7 EQU D7 B17 EQU D15 B37 OCT 37 B77 OCT 77 B100 OCT 100 B177 OCT 177 B377 OCT 377 B1777 OCT 1777 B76K OCT 76000 * HED DISP4 -- USER MAP BUILDING ROUTINES ******************************************** *ROUTINE TO SET USER MAP CALLED BY DISP4 AND RTIO4 *CALL: * (B) =ADDR MAT ENTRY * (E) = 0 REBUILD USER MAP, SAVE IN BP COPY * (E) = 1 USE CURRENT BP COPY OF USER MAP, IF ANY * JSB $SMAP * REGISTERS MEANINGLESS ******************************************** * * $SMAP NOP STB XMAT SAVE MAT ENTRY ADDR ADB D2 LDA B,I GET ID SEG ADDR STA XIDA ADA D8 LDA A,I SEZ,SZA PT SUSP=0? OR (E)=0? JMP REMAP NO, USE BP COPY OF USER MAP * INB YES, HAVE TO REBUILD USER MAP LDA B,I AND B1777 STA XSTP SAVE PTTN START PAGE # * LDB XIDA ADB D21 LDA B,I AND B76K GET BITS 10-14 ALF RAL,RAL STA XNUM SAVE # OF PROG PAGES * LDA B,I ALF,ALF RAL AND B7 GET MPFT INDEX VALUE SZA,RSS JMP NOCOM =0, DISC RES(TYPE 4), NO COMMON * LDA XIDA =2,3,4 TYPE BG/RT USING COMMON ADA D14 OR TYPE 2 OR 3 WITHOUT COMMON LDA A,I AND B7 GET ID SEG TYPE CCB SET UP FOR TYPES 2,3, OR 4 WITH COMMON ADB $SDA CLE CPA D2 IS IT TYPE 2? RSS YES, RT NEEDS TAII + SDA CPA D3 IS IT TYPE 3? CCE z YES, SET E=1 MAP COMMON + TAII + SDA JMP SYSRG NO, LEAVE E=0 MAP ONLY COMMON * NOCOM CCB NO COMMON, TYPE 4 ADB $CMST CLE (E)=0 FOR NOT PRIVILEGED * SYSRG CBX (X)= # PAGES IN TABLES, ETC. LDA D33 (A)= START REG # 33 FOR USER MAP CLB,INB (B)= 1 XMS SEZ,RSS PRIVILEGED PROG? JMP USERG NO * LDB $SDT2 YES, SET WRITE PROTECT BIT CBX (X)= # PAGES IN SDA + $$TB2 LDB $SDA ADB WRPRT (B)= PAGE # OF SDA WITH WRITE PROTECT XMS * USERG LDB XNUM NOW MAP USER CODE PAGES CBX LDB XSTP INB XMS MAP USER PROGRAM * LDB A CMB,INB ADB B100 CBX (X)= # REGISTERS LEFT LDB RWPMP (B)= READ-WRITE PROTECT FLAGS SET XMS * CLB,INB CBX (X)= 1 REGISTER LDB XSTP (B)= 1ST PAGE OF PTTN FOR BASE PAGE LDA D32 (A)= USER BASE PAGE REGISTER # XMS * LDB XMAT JSB PHYBP MAP IN USER BP TO SAVE USER MAP IOR BIT15 (A) = SIGN SET FOR SAVE MAP IN MEMORY USA JMP $SMAP,I RETURN * REMAP LDB XMAT JSB PHYBP MAP IN USER BP TO LOAD USER MAP USA RESTORE USER MAP FROM BP COPY JMP $SMAP,I RETURN * * * PHYBP MAP IN THE PHYSICAL BASE PAGE COPY OF USER MAP * CALL SEQUENCE: (B) = MAT ADDR * JSB PHYBP * (A) = ADDR OF PHYSICAL BP COPY * PHYBP NOP MAP PHYSICAL BP FOR USER PROG ADB D3 FOR SAVE & RESTORE MAP REGS LDA B,I GET PTTN'S FIRST PAGE # AND B1777 WHICH IS THE PHYSICAL BP STA B (B) = PAGE # OF BP CLA,INA CAX (X) = 1 TO SET ONE REGISTER LDA $DVPT WHERE DRIVER PTTN REG NORMALLY IS XMS MAP IN THE PHYSICAL BP LDA ADBP<C GET LOGICAL ADDR FOR BP COPY JMP PHYBP,I RETURN WITH ADDR IN (A) * * ADBPC NOP LOGICAL ADDR IN DRIVER PTTN FOR USER BP COPY RDWRP OCT 140000 READ & WRITE PROTECT RWPMP OCT 141740 READ & WRITE PROTECT END OF MEMORY WRPRT OCT 040000 WRITE PROTECT ONLY XSTP NOP XIDA NOP XNUM NOP XDMST NOP D3 DEC 3 XMAT NOP DFDMR DEF DVMPR ADDR OF STORAGE FOR DRIVER MAP REG DVMPR NOP DRIVER MAP REGISTER CONTENTS * * *************EXTERNAL ROUTINE TO SET USER MAP******** ***************************************************** **********CALL: LDA IDADR (A) HAS ID SEG ADDR ********** JSB $XDMP ********** ********** (A) =0 IF ERROR-- PROGRAM NOT IN PARTITION * $XDM RBL,RBL CALLED VIA $XDMP ($$TB1) BY JMP STB XDMST SAVE DMS STATUS STA XIDA TEMP SAVE OF ID ADR LDB A ADB D14 LDA B,I AND D15 IS PROG MEM RES CPA D1 JMP MRPV YES,GO SET MEM RES MAP * ADB D7 GET MPID WORD LDA B,I AND B77 MPY MATSZ ADA $MATA GET PTTN ADDR STA XMAT SAVE MAT ENTRY ADDR ADA D2 LDA A,I CPA XIDA IS PROG STILL IN PARTITION? JMP XDMOK YES ,CONTINUE * CLA NO, ERROR JMP XDMEX RETURN (A)=0 * XDMOK CCA CAX (X)=1 READ 1 REG LDA $DVPT (A)=REG # OF DRIVER PARTITION LDB DFDMR (B)=ADDR OF SAVE AREA XMM SAVE REG USED FOR MAPPING USER BP CCE (E)=1 TO REUSE BP COPY OF MAP LDB XMAT (B)=MATA ENTRY ADDR JSB $SMAP GO SET MAP CLA,INA CAX (X)=1 WRITE 1 REG LDA $DVPT (A)=REG # OF DRIVER PARTITION LDB DVMPR (B)=SAVED DRIVER PTTN REG VALUE XMS RESTORE REG USED FOR MAPPING USER BP XDMEX JRS XDMST $XDMP,I RETURN (A)#0 * MRPV LDA $MRMP USA SET pNLHMEM RES MAP JMP XDMEX RETURN (A)=0 * HED DISP4 -- FIND PARTITION FOR SCHEDULED PROGRAM * ***************************************** * * ROUTINE TO SEARCH FOR A PARTITION * * ***************************************** SPC 2 * FNDSG NOP LDA ZWORK SET UP PTRS TO PTTN JSB MATEN FNDAG LDA ZMPID,I FNDSH CLE,ELA GET ASSIGNED FLAG IN (E) ALF,ALF AND D7 STA MPN MPN HAS MPFT INDEX AND BF FLAG(15) * *AT THIS POINT THE FOLLOWING WORD ARE IN USE * CNT--PARTITION NUMBER PROG LAST IN * MID--MAT ENTRY ADDR FOR PARTITION ID SEG * MPN--BITS 0-3,MPFT INDEX * BIT 15,BP LOAD FLAG(1,RECOVER BP AREA * EREG--RESERVED FLAG,E=1,CNT IS PTTN SPECIFIED * AT LOAD,E=0,CNT IS PTTN LAST IN * LDA MLTH,I RAL (A) HAS "C" BIT IN SIGN LDB MID,I CPB ZWORK PROG STILL IN PARTITION? JMP FDNSW YES * SEZ,CLE NO,IS ASSIGNED FLAG SET? JMP FDSWP YES, TRY TO SWAP OUT OCCUPANT N* * SPC 2 * AT THIS POINT WE KNOW THAT THE PROGRAM IS NOT ASSIGNED TO * A PARTITION AND THAT THE PROGRAM IS NOT CURRENTLY IN THE * PARTITION. THAT IS, THE PROGRAM DOES NOT OWN THE PARTITION. * SINCE THE PROGRAM DOESN'T OWN THE PARTITION AN $XSIO CALL * WILL BE REQUIRED TO BRING HIM OFF THE DISC & INTO MEMORY. * THIS MEANS THAT IN ORDER TO DO ANYTHING USEFUL WITH THE * PROGRAM WE NEED AN $XSIO CALL. IF THE CALL IS NOT AVAILABLE * THEN NOTHING CAN BE DONE FOR THIS TYPE PROGRAM (BG) AND WE SHOULD * GO TO THE NEXT GUY IN THE SCHED LIST IF HE IS RT OR EMA SOMETHING * USEFUL IS POSSIBLE. SPC 2 * LDB FNDSG,I GET THE CONTENTS OF THE LDB B,I $XSIO BUSY WORD SZB CALL BUSY ? JMP X0035 YES, GO GET THE NEXT GUY IN SCHED LIST  * ISZ FNDSG NO, SO FIX RETURN & HOP TO IT !!! * * * ********************************** * * SEARCH FOR PARTITION * * ********************************** * * LDA ZMPID,I AND B76K GET #PAGES OF CODE - BP ALF (PLUS MSEG, IF ANY) RAL,RAL CMA,INA STA NPGN LDA ZEMA,I SZA,RSS EMA PROG? JMP FNDS3 NO * AND B1777 YES, EMA CMA,INA GET EMA SIZE ADA NPGN ADD TO PROG SIZE STA B LDA ZIDEX,I AND B37 GET #PAGES IN MSEG ADA B SUBTRACT FROM PROG SIZE FOR STA NPGN SIZE PTTN NEEDED EVEN THOUGH EMA * FNDS3 LDB FLIST GET POINTER TO FREE LIST HEADER * * * SEARCH FOR A FREE PARTITION * (B) = POINTER TO LIST HEADER * NPGN= NEGATIVE CURRENT LENGTH * GOES TO NOFRP IF NONE FOUND * * FREE LIST IS IN ORDER OF INCREASING SIZE * SCHFR LDA B,I GET ADR ENTRY(HAS LINK WORD) SZA,RSS END OF LIST JMP NOFRP YES,NO FREE PTTN * STA LSTHD STORE CURRENT ENTRY ADDR *  CAX SET UP THE INDEX REGISTER * LAX D4,I GET LENGTH PARTITION SSA PTTN RESERVED JMP FR2 YES, CAN'T USE * RAL,CLE,ELA RAR,RAR SEZ,RSS IS IT IN CHAIN MODE? JMP FR1 NO, SEE IF LARGE ENOUGH * LAX D3,I YES, CHAIN MODE SSA,RSS BUT WAS IT MOTHER PTTN? JMP FR2 NO, CAN'T USE SUBPTTN IN CHAIN MODE * LAX D4,I MOTHER IN CHAIN MODE, OK TO USE * FR1 AND B1777 SCREEN OUT FLAGS ADA NPGN SEE IF GRTR,EQUAL TO CURRENT PRG SSA,RSS IS S=0 PTTN BIG ENOUGH JMP FNDFR FOUND ONE * FR2 LDA LSTHD STA B JMP SCHFR * * UNLINK PTTN FROM FREE LIST * LINK PTTN INTO ALLOCATED LIST * FNDFR LAX D3,I WE SEARCHING THE MOTHER LIST ? SSA WELL ? JMP SUBCH YES, SO GO LOOK AT THE SUB PART'N AVAIL * LDA LSTHD,I GET ADR NEXT ENTRY STA B,I UNLINK CURRENT ENTRY JSB SCHND GO SET MAP ID WORD LDA ZWORK JSB MATEN GO SET UP MAT POINTERS * FNDF1 LDA ZPRIO,I GET NEW PRIORITY STA MPRIO,I PUT IN PARTITION JSB ALINK LINK INTO ALLOCATED LIST CLB SET TO CLEAR RESIDENT FLAG STB MID,I CLEAR PTTN ID WORD JMP FNDSG,I RETURN TO CALLER * * * FOUND A PARTITION AND DON'T NEED TO SWAP * PROGRAM IS STILL IN PARTITION (ALLOCATED) BUT IS DORMANT * OR PROGRAM WAS JUST SWAPPED OUT AND IS STILL IN THERE. * IF IT IS A MOTHER PARTITION, CHAIN IS STILL ACTIVE * FDNSW LDB MADR,I SSA,RSS TEST C-BIT JMP FDNS2 C=0 IT'S OK. * SSB,RSS TEST M-BIT JMP FNDS5 C=1, M=0 SUBPTTN BUSY IN CHAIN! * FDNS2 ISZ FNDSG SET UP RETURN ADDRESS JSB FND C=1 M=1 SET UP FLAGS AND USE IT LDA ZPRIO,I GET PARTITION PRIORITY CPA MPRIO,I IS IT THE SAME AS CURRENT? JMP FNDSG,I YES, CONTINUE * STA MPRIO,I NO, RELINK IN ALLOCATED LIST JSB RLNK CAUSE PROG WAS DORMANT JMP FNDSG,I CONTINUE * FNDS5 LDA MRDFL,I SUBPTTN BUSY, AND D7 GET PTTN STATUS CPA D3 IS HE ALL SWAPPED OUT ?TTN RSS YES, SO RELEASE THIS PART'N & GET ANOTHER JMP X0035 NO, LETS WAIT ON THIS GUY FOR A WHILE * LDA ALIST GET ALLOC LIST POINTER LDB MLNK AND MAT POINTER JSB UNLNK MOVE OUT OF ALLOC LIST AND JSB FLINK MOVE INTO FREE LIST CLA RELEASE OWNERSHIP WORD STA MID,I JMP FNDAG NOW GO GET HIM ANOTHER PARTITION. * * * * * ***************************************** * * PROGRAM WAS ASSIGNED TO A PARTITION * * ***************************************** * FDSWP LDB MLNK,I INB,SZB,RSS PTTN UNDEFINED BY P.E.? JMP FDOOH OH-OH, YES * ISZ FNDSG FIX RETURN ADDRESS LDB MADR,I SSA,RSS TEST C-BIT JMP FDSW2 C=0 C-BIT NOT SET, IT'S OK. * SSB,RSS TEST M-BIT JMP FDSUB C=1 M=0 SUBPTTN IN CHAIN, MAYBE SWAP. * FDSW2 LDA MID,I C=1 M=1 OR C=0 OK TO TRY SWAP CLE,SZA IS PTTN EMPTY? JMP FDSW1 NO * SSB,RSS THIS A MOTHER ? JMP USEIT NOT A MOM & NOT IN CHAIN. * LDA MLTH,I IS A MOM, BUT IS CHAIN IN EFFECT ? RAL C BIT IN SIGN SSA,RSS IN CHAIN MODE ? JMP SUBAS IS A MOM BUT NOT IN CHAIN JMP FDSW1 IS A MOM IS ALSO IN CHAIN * * USEIT LDA FLIST YES, AN EMPTY PARTITION LDB MLNK UNLINK FROM FREE LIST JSB UNLNK AND USE THIS PARTITION JMP FNDF1 NOW GO LINK IT INTO ALLOCATED LIST * FDSW1 JSB FND GO SET UP AND SWAP LATER JMP FNDSG,I CONTINUE * FDOOH LDA ZMPID,I UNASSIGNED PROG SINCE RAL,CLE,ERA THE PARTITION WENT AWAY `STA ZMPID,I BECAUSE OF PARITY ERROR THERE JMP FNDSH TRY TO FIND A PARTITION * * * PROGRAM IS ASSIGNED TO A SUBPARTITION, HOWEVER THAT SUB IS * IN THE CHAIN MODE. SO LETS SEE WHO OWNS THE MOTHER PARTITION * AND SEE IF THAT GUY IS SWAPABLE. * * FDSUB LDB MLNK SAVE MAT ADDR OF PTTN STB LSTHD THAT WE NEED LDB MSUBL,I GIVEN SUBPTTN WITH "C" SET FDSMO LDA D3 FIND THE MOTHER PTTN ADA B LDA A,I SSA IS THIS THE MOTHER PTTN? JMP FDSMD YES, SEE IF MOTHER IS DORMANT * ADB D6 NO, TRY NEXT LINK LDB B,I JMP FDSMO * * * PROGRAM WAS ASSIGNED TO A SUBPARTITION BUT THE MOTHER PARTITION * IS STILL OCCUPIED. SEE IF WE CAN STILL QUALIFY TO FORCE A SWAP * OUT FROM THE MOTHER PARTITION. THE USER SHOULD NOT ASSIGN PROGRAMS * TO A SUBPARTITION IF THAT PROGRAM IS CONTINUOUSLY COMING IN AND * OUT OF THE SCHEDULE LIST. EMA PROGRAM PERFORMANCE WILL BE SEVERELY * DEGRADED. * * FNDSM IS ENTERED WHEN A PROGRAM IS NOT ASSIGNED TO ANY PARTITION * AND NO PARTITION OF THE PROPER TYPE WAS FOUND BUT A SUITABLE * SUBPARTITION WAS FOUND IN A DORMANT MOTHER PROGRAM. * FDSMD STB MOTHR SAVE SUBPTTN'S MOTHER ADDR ADB D5 LDA B,I AND D6 CPA D4 CLEARING OR CLEARED SUBPTTNS? JMP X0035 YES, SKIP IT FOR NOW * FNDSM LDA MOTHR YES, SET MAT ADDRS OF MOTHER PTTN JSB MATAD CCE (E) = 1 FOR SPECIAL SWAP CHECK LDB MID,I (B) = ID FOR SWPCK JSB SWPCK JMP SMABT ABORT - ONLY IF ASSIGNED TO SUBPTTN JMP SWMOM SWAP IS OK, PROG SAVE RES. OR SUSPENDED JMP SMLOD LOAD - PROG TERM. SERIAL REUSE. JMP X0035 CAN'T SWAP, TRY NEXT SCHED PROG * SMLOD CLA LOAD - PROG TERM. SERIAL REUSE. STA MID,I CLEAR MOTHER OCCUPANT, BEFORE USE SUBPTTN LDA FLIST SAVE CURR FREE LIST HEADER STA TEMPS CAUSE UNMOM+FLINK MES,LSES IT UP LDB MLNK GET MOTHER MAT ADDR JSB UNMOM RELEASE SUBPTTNS LDA TEMPS RESTORE FREE LIST HEADER STA FLIST LDB LSTHD GET MAT ADDR OF SUBPTTN WE NEED JSB UNLNK UNLINK FROM FREE LIST LDA LSTHD JSB MATAD SET UP MAT ADDR JMP FNDF1 SET INTO ALLOC LIST, RETURN * SWMOM LDA CHSWP MOTHER PTTN I/O CALL BUSY? SZA JMP X0035 YES, TRY SCHED NEXT PROG JMP X0325 NO, DO SWAP OUT OF MOTHER PTTN * SMABT LDA ZIDEX CAN WE ABORT MOM FOR LOAD IN SUBPTTN? SZA IS THIS EMA PROG? JMP XM352 YES, ABORT LOAD IN MOM CAUSE CHSWP WILL BE FREE * LDB BGSWP LDA MFLGS SSA IS THIS PROG FOR BG TYPE PTTN? LDB RTSWP NO, RT PTTN HAS TO BE USED FOR LOAD SZB IF WE DO ABORT, CAN WE LOAD? JMP X0035 NO, WAIT TILL I/O CALL IF FREE. JMP XM352 YES, ABORT MOM LOAD, WE CAN LOAD. TEMPS NOP SKP * * REACHED END OF FREE LIST AND COULD NOT FIND A PARTITION * NOFRP LDA ZPRIO,I COME HERE IF NO FREE PTTN CMA,INA STA SPRIO SEARCH ALLOC LIST FOR PTTN LDB ACHPR LDA ZIDEX CLE,SZA CCE (E)=1 IF EMA PROG LDA MRDFL,I GET PTTN TYPE WORD SEZ WAS IT EMA PROG? JMP NOFCP YES, NO FREE MOTHER PTTN * LDB ABGPR NO FREE BG PTTN, TRY BG ALLOC LIST SSA LDB ARTPR NO FREE RT PTTN, TRY RT ALLOC LIST NOFCP AND B7 CPA D3 IS THE OCCUPANT SWAPPED OUT? CLA,RSS YES, SKIP JMP MMSWP NO,SEE IF WE CAN STEAL PARTITION FROM OWNER * CPA CNT IS THIS PARTITION ZERO? JMP FNDS2 YES,CONTINUE PARTITION CHECK * CNTSW LDA MADR,I SSA MOTHER PTTN? JMP REUSE YES, REUSE SWAPPED PROG * LDA MLTH,I RAL SSA IS PTTN IN CHAIN MODE? JMP SRCNT YES, CAN'T USE CHAINED SUBPTTN * REUSE JSB FND REUSE THIS PARTITION JMP FNDSG,I * * OK, SO SOMEBODY ELSE OWNS THE PARTITION. IF ITS A MOTHER PARTITION * AND THIS THE RESIDENT IS HAVING SUBPARTITIONS CLEARED, THEN IT'S * POSSIBLE TO STEAL THIS PARTITION FROM THE OLD OWNER. LETS SEE. * MMSWP CPA D4 PARTITIONS BEING CLEARED ? RSS YES CPA D5 PARTITIONS ALL CLEARED RSS YES JMP SRCNT NO, JUST FORGET THE WHOLE THING. * LDA MPRIO,I GET THE RESIDENTS PRIORITY CMA,INA ADA ZPRIO SEE HOW THIS COMPARES TO THE CONTENDERS PRIORITY SSA,RSS WHO WINS ? JMP SRCNT THE RESIDENT. * LDA ZPRIO THE CONTENDER STA MPRIO,I SET NEW PRIORITY IN MAT TABLE LDA ZWORK AND NEW OWNER TOO STA MID,I JSB RLNK RELINK IN ALLOCATED LIST SINCE THE PRIORITY IS JMP FNDSG,I DIFFERENT. NOW RETURN * * FNDS2 CPB ALIST IS THIS RIGHT TYPE PARTITION? RSS YES,CONTINUE JMP SRCNT NO,GO SEARCH ALLOCATED LIST * LDA MLNK,I INA,SZA,RSS PTTN UNDEFINED BY P.E.? JMP SRCNT YES, SEARCH ALLOC LIST * LDA MLTH,I GET THE LENGTH WORD SSA IS THIS RESERVED PARTITION? JMP SRCNT YES,DON'T USE * AND B1777 NO,GET LENGTH ADA NPGN SSA,RSS S=0,PARTITION LONG ENOUGH JMP CNTSW LONG ENOUGH,GO USE IT * SRCNT LDB DLIST,I LESS OR EQUAL PRIORITY * * SEARCH FOR SUITABLE ALLOCATED PARTITION. * ALLOCATED LIST IS IN ORDER * OF INCREASING PRIORITIES(I.E. DECREASING * NUMBERS)--EXCEPTION:DORMANT PROGS WITH * SAVED RESOURCES AT FRONT OF LIST * (OF,SS,COMPLET)*********** * NPGN--NEG LENGTH CURRENT * SPRIO--NEG PRIO CURRENT * GOES TO X0035 IF NO PTTN * * SCHAL CPB ALIST END OF DORM LIST? LDB B,I YES, BUMP TO ALLOC LIST SZB,RSS LIST EMPTY?  JMP SCHMO YES, SEARCH DORMANT MOTHER PTTNS * STB LSTHD STORE CURRENT LIST HEAD CBX SET THE INDEX REGISTER * LAX D4,I SSA PARTITION RESERVED JMP SCHL2 YES, CAN'T USE IT * RAL,CLE,ELA RAR,RAR SEZ,RSS IS PTTN IN CHAIN MODE? JMP SCHL4 NO, TEST SIZE * LBX D3,I SSB,RSS MOTHER IN CHAIN MODE? JMP SCHL2 NO, CAN'T USE SUBPTTN IN CHAIN MODE * SCHL4 AND B1777 GET PARTITION LENGTH ADA NPGN SSA,RSS IF S=0, PTTN IF .GE. IN LENGTH JMP SCHL3 LONG ENOUGH * SCHL2 LDB LSTHD,I SZB,RSS END OF LIST JMP SCHMO NO PTTNS, TRY DORMANT MOTHER PTTNS JMP SCHAL GO TRY NEXT ONE * * * SCHL3 LBX D2,I GET PART ID ADDR SZB,RSS ANYBODY STILL THERE? JMP FNDAL NO, SO USE IT * ADB D14 LDA B,I AND B100 SZA IS CORE LOCK BIT SET? JMP SCHL2 YES, KEEP LOOKING * LAX D1,I NO GET PARTITION PRIORITY ADA SPRIO SUBTRACT CURRENT PRIORITY CMA,SSA,INA,SZA JMP FNDAL CURRENT IS .GT., GO DO IT * INB CURRENT IS .LE. PTTN PRIORITY LDA B,I GET STATUS AND D15 CPA D1 IS PTTN SCHEDULED? JMP SCHL2 YES, GO TRY SOMEONE ELSE * FNDAL JSB SCHND GO SET MAP ID WORD JSB FND GO SET UP RES FLAGS AND MAT JMP FNDSG,I * * * NO RT OR BG ALLOC PTTNS CAN BE FOUND FOR PROGRAM * SO SEARCH THROUGH THE DORMANT MOTHER PARTITION LIST * TO SEE IF ANY SUBPARTITIONS CAN BE RELEASED WHICH * CAN BE USED FOR THIS PROGRAM * SCHMO LDB ACHDM SEARCH DORMANT MOTHER LIST CPB DLIST ALREADY LOOKED BECAUSE EMA? JMP NOMOR YES, NOTHING CAN BE DONE * STB MOTHR LDA FLIST WERE WE SCANNING FOR CPA ABGFR A BG PTTN? CLA,CLE,RSS YES, SET TEMP = 000000 CLA,CCE NO, SET TEMP = 100000 ERA STA TEMP * SCHMN LDB MOTHR,I GET NEXT ENTRY SZB ACCIDENTLY END OF LIST? CPB ACHPR OR END OF DORMANT LIST? JMP NOMOR YES, CAN'T USE BUSY MOTHER PTTNS * STB MOTHR ADB D4 LDA B,I SSA IS MOTHER PTTN RESERVED? JMP SCHMN YES, TRY NEXT DORMANT MOTHER PTTN * INB LDA B,I AND BIT15 JUST KEEP RT BIT CPA TEMP PTTN TYPE MATCH WHAT WE NEED? JMP SCHSB YES, TRY SUBPTTN SIZE CHECK JMP SCHMN NO, TRY NEXT DORMANT MOTHER PTTN * SCHSB LDA MOTHR JSB MATAD LDA MID,I GET ID OF MOTHER PTTN OCCUPANT ADA D14 LDA A,I AND B100 SZA IS CORE LOCK SET? JMP SCHMN YES, TRY NEXT MOTHER PTTN * SCHSN LDA MSUBL,I GET NEXT SUBPTTN PTR SCHNX CPA MOTHR ANY MORE SUBPTTNS? JMP SCHMN NO, TRY NEXT DORMANT MOTHER PTTN * JSB MATAD SET UP MAT PTRS LDA MLTH,I SSA SUBPTTN RESERVED? JMP SCHSN YES, SKIP TO NEXT SUBPTTN * AND B1777 GET SUBPTTN LENGTH ADA NPGN ADD NEG LENGTH NEEDED SSA IS SUBPTTN LONG ENOUGH? JMP SCHSN NO, TRY NEXT SUBPTTN * LDB MLNK YES, SAVE MAT ADDR OF SUBPTTN STB LSTHD FOR FNDSM JSB SCHND SET UP ID SEG FOR SUBPTTN JMP FNDSM MOVE SUBPTTN FROM FREE LIST INTO ALLOC LIST * SPC 1 * SO NOW WE KNOW THAT THERE IS NO PARTITION THAT THE PROGRAM * CAN USE. THAT IS, THE PARTITIONS HE COULD USE ARE LOCKED * UP OR THERE HAS BEEN A PARITY ERROR IN WHAT WAS FORMERLY * THE LARGEST PARTITION OF THAT TYPE (IE BG, RT, OR MOM). * NOW IF THERE HAS BEEN A PARITY ERROR, THEN IF THIS PROGRAM * IS TOO LARGE FOR THE SYSTEM WE SHOULD ABORT IT. IF THERE * HAS NOT BEEN A PARITY ERROR, THEN JUST GO GET THE NEXT * GUY IN THE SCHED LIST. SPC 1 * NOMO47R LDA $UNPE HAS THERE EVER BEEN A SZA,RSS PARITY ERROR ? JMP X0035 NO, SO GET THE NEXT GUY IN THE SCHED LIST * LDA ZWORK YES, I WONDER IF THIS GUY STILL FITS STA $WORK SET UP TO CALL $SZIT & FIND OUT JSB $SZIT GO SEE IT HE STILL FITS SZA,RSS DOES HE STILL FIT ? JMP X0035 YES, GO GET NEXT GUY IN SCHED LIST * LDA ZWORK NO, FLUSH HIM !!! STA XEQT MAKE HIM THE CURRENTLY EXECUTING PROG LDA DP GET THE ERROR CODE LDB BLANK JSB $ERMG ABORT THE MOTHER JMP $XCQ FINISH UP THE ABORTION. * DP ASC 1,DP BLANK ASC 1, * * SUBROUTINE TO SET UP PROGRAM ID SEG TO USE A PARTITION * WHICH WAS FOUND IN A SEARCH OF A LIST. * CALL: * (LSTHD) = ADDR OF PARTITION WHICH WAS FOUND * (ZMPID) = ADDR OF PTTN WORD IN ID SEG * JSB SCHND * * SCHND NOP LDA $MATA GET ADR OF MAT CMA,INA ADA LSTHD CLB DIV MATSZ CALCULATE PTTN # LDB A LDA ZMPID,I GET MAP ID WORD AND C77 IOR B STA ZMPID,I PUT NEW PTTN # IN JMP SCHND,I * * ************************************** * FOUND A PARTITION, SET UP MAT POINTERS AND BP POINTERS * CALL: WORK = ID SEG ADDR OF PROG * JSB FND * ************************************** * FND NOP LDA ZWORK JSB MATEN GO SET UP MAT POINTERS LDB MID,I GET OWNER OF PTTN LDA B ADA D14 LDA A,I AND D15 CPA D2 IS THIS RT PROG? JMP FNDR YES, GO SET FOR RT PROG * ADB D21 NO, SET AS BG LDA B,I GET PROG LENGTH AND B76K ADA DM1 FILL OUT PAGE INB LDB B,I GET LOW MAIN STB BGDRA ADA B STA BGLWA SET END OF CORE CCA ADA BGDRA STA RTDRA SET RT POINTERS TO ONE LESS BG % STA AVMEM FAKE FOR RTE PROCESSORS JMP FND,I * FNDR ADB D21 SET UP RT POINTERS LDA B,I GET PROG LENGTH AND B76K ADA DM1 FILL OUT PAGE INB LDB B,I STB RTDRA ADA B STA AVMEM STA BGDRA STA BGLWA JMP FND,I * DM1 DEC -1 MOM NOP TEMPORARY STORE OF MOTHER MATA ENTRY MOTHR NOP MOTHER MATA ENTRY ADDR OF CURRENT SUBPTTN MOMFL NOP SUBFL NOP SUBFR NOP SUBDM NOP * * * ******************************************** * * FOUND A FREE MOTHER OR WE HAVE * * * A PROGRAM THAT WAS ASSIGNED TO * * * A SUBPARTITION AND THAT MOTHER * * * PARTITION WAS EMPTY NOW GO SEE * * * IF SUBS ARE OVERLAYABLE OR * * * SWAPABLE * * ******************************************** * * SUBCH JSB SCHND SET PART'N # INTO ID SEG LDA ZWORK SET UP THE MATA POINTERS JSB MATEN * LDA MLTH,I RAL SSA IS "C" SET ALREADY? JMP FNDSG,I YES, USE THIS PTTN * SUBAS LDA MOMFL THIS SECTION OF CODE IN USE ? SZA WELL ? JMP X0035 YES, CAN'T DO THIS, TRY ANOTHER PROGRAM. * LDA MFLGS SSA,RSS SET UP PROPER LIST HEADERS JMP BGSUB * LDA ARTFR RT MOTHER PTTN STA SUBFR LDA ARTDM STA SUBDM JMP SUBC2 * BGSUB LDA ABGFR BG MOTHER PTTN STA SUBFR LDA ABGDM STA SUBDM * * SUBC2 LDB MLNK STB MOMFL SET UP SUBPTTN SWAPOUT FLAGS STB SUBFL WITH THE MOTHER PTTN ADDR * SUBN1 LDA MSUBL,I CHECK NEXT SUBPTTN CPA MOMFL DONE YET? JMP SUBRS YES, SET "C" START SWAPS * JSB MATAD SET UP MAT PTRS LDB MID,I CCE,SZB,RSS IS SUBPTTN EMPTY? JMP SUBN1 YES, SKIP SWAP CHECK * * V FIRST SCAN THROUGH SUBPTTNS FOR SWAPPABILITY * JSB SWPCK (E)=1 FOR SUBPTTN SWAP CHECK NOP STOP LOAD NOP SWAP OUT JMP SUBN1 LOAD OK, TEST NEXT SUBPTTN CLA CAN'T SWAP, SUBPTTN NOT AVAILABLE STA MOMFL CLEAR THE CHECK IN PROGRESS FLAGS STA SUBFL LDA ZMPID,I GET THE PARTITION WORD SSA,RSS THIS PROG ASSIGNED ? JMP FR2 NO, SO GO LOOK FOR ANOTHER PART'N JMP X0035 YES, SO FORGET IT * * SUBRS LDA MOMFL ALL SUBPTTNS SWAPPABLE SUBR1 JSB MATAD SO SET "C" FLAG ON ALL * LDA MLTH,I IOR B40K STA MLTH,I LDA MSUBL,I CPA MOMFL DONE YET? JMP SUBS0 YES, INITIATE SWAPOUTS JMP SUBR1 NO, KEEP GOING * * SUBS0 LDA MOMFL SEE IF MOTHER PTTN JSB MATAD HAS ANY SUBPTTNS * LDA FLIST *** UNLINK FROM FREE LIST *** LDB MLNK JSB UNLNK * LDA ZPRIO,I GET THE PRIORITY STA MPRIO,I INTO THE PARTITION JSB ALINK *** MOVE INTO ALLOC LIST * LDA ZWORK ***** COMMIT THE PARTITION ***** STA MID,I ***** COMMIT THE PARTITION ***** * LDA MSUBL,I CPA MOMFL ANY SUBPTTNS? JMP SUBDN NO, SO DONE SET PTTN STATUS=5 * LDA MFLGS SET MOTHER PTTN STATUS=4 IOR D4 FOR SUBPTTNS SWAPPING OUT STA MRDFL,I * SUBNX LDA SUBFL GET NEXT SUBPTTN ADA D6 LDA A,I CPA MOMFL ARE WE DONE YET? JMP SUBDN YES, DONE. STA SUBFL SET NEW SUBPTTN ADDR * * * TRY TO SWAP SUBPARTITION. GET HERE FROM I/O CALL COMPLETE CODE SUBSS LDA CHSWP CHECK IN CASE WE CAME FROM RT OR BG CODE SZA IS MOTHER PTTN/EMA CALL BUSY? JMP X0005 YES, SKIP IT FOR A WHILE * SUBS2 LDA SUBFL SET UP MAT PTRS TO SUBPTTN JSB MATAD LDB MID,I CCE,SZB,RSS IS IT EMPTY? (E=1) FOR SWPCK q JMP SUBNX YES, DO NEXT SUBPTTN * * SECOND SCAN THROUGH SUBPTTNS AND ACTUAL DO SWAPS * SUBSC JSB SWPCK (E=1) FOR SUBPTTN SWAP CHECK JMP SUBAB ABORT CURRENT LOAD JMP X0325 SWAP CURRENT OCCUPANT OUT JMP SUBNX LOAD OK, CHECK NEXT SUBPTTN LDB MOMFL CAN'T SWAP, SUBPTTN NOT AVAILABLE SUBNL ADB D4 LDA B,I AND C40K CLEAR "C" BIT STA B,I PUT IT BACK ADB D2 LDB B,I GET NEXT SUBPTTN CPB MOMFL DONE YET? JMP SUBDE YES, DEALLOCATE MOTHER PTTN JMP SUBNL NO, CLEAR CHAIN BIT * SUBDE LDA MOMFL UNLINK MOTHER PTTN FROM JSB MATAD ALLOCATED LIST SINCE WE LDA MFLGS STA MRDFL,I SET PTTN STATUS = 0 LDA ACHDM FOUND AN UNSWAPPABLE SUBPTTN LDB MOMFL JSB UNLNK LDA ACHFR STA FLIST LINK IT INTO THE FREE LIST JSB FLINK CLA CLEAR SUBPTTN CLEARING FLAGS STA MID,I UNCOMMIT THE PARTITION STA MOMFL STA SUBFL JMP X0005 GO TO TOP OF SCHED LIST * * SUBAB LDB MID,I ABORT LOAD IN SUBPTTN JSB $LIST RESCHEDULE PROG BEING ABORTED OCT 401 LDA SUBDM TO EXECUTE LATER LDB MLNK UNLINK IT FROM ALLOCATED LIST JSB UNLNK LDA SUBFR AND LINK IT INTO THE FREE LIST STA FLIST JSB FLINK JMP X0154 GO CANCEL LOAD (EXITS VIA $IOCL) * * SUBDN LDA MOMFL SET UP MOTHER PTTN PTRS JSB MATAD SUBDX LDA MSUBL,I NOW UNLINK ALL SUBPTTNS FROM LISTS CPA MOMFL DONE YET? JMP SUBCL YES, SUBPTTNS ALL CLEARED * JSB MATAD SET UP SUBPTTN PTRS LDA SUBFR GET FREE LIST HEADER LDB MID,I SZB IS SUBPTTN EMPTY? LDA SUBDM NO, UNLINK FROM ALLOC LIST LDB MLNK JSB UNLNK UNLINK ENTRY FROM LIST CLA STA MID,I CLEAR OUT OCCUPANT WORD LDA MFLGS NLH STA MRDFL,I CLEAR STATUS FIELD TOO JMP SUBDX GO DO NEXT SUBPTTN * SUBCL LDA MOMFL JSB MATAD SET UP PTRS TO MOTHER PTTN LDA MFLGS SUBPTTNS ALL CLEARED NOW IOR D5 SET UP MOTHER PTTN STATUS = 5 STA MRDFL,I CLA CLEAR OUT SUBPTTN STA MOMFL SWAPOUT FLAGS STA SUBFL JMP X0005 HAVE TO GO TO TOP OF SCHED LIST * * * * UNLINK SUBPARTITIONS FROM MOTHER PARTITION AND * RETURN SUBPARTITIONS TO THE BG OR RT FREE LIST * CALL: * MAT ADDRESSES SET UP BY MATAD (MLNK, ETC.) * (B) = MOTHER'S MAT ADDR * JSB UNMOM CALL * (A) = MOTHER'S MAT ADDR * UNMOM NOP CPB MOMFL IS MOTHER TRYING TO CLEAN HOUSE? JMP X0035 YES, LEAVE HER ALONE. * STB MOM SAVE MOTHER MAT ADDR TEMP LDA ACHDM UNLINK MOTHER PTTN FROM ALLOC LIST JSB UNLNK UNLINK FROM ALLOCATED LIST LDA ACHFR STA FLIST LINK PTTN INTO FREE LIST JSB FLINK LDA MLTH,I CLEAR "C" BIT TOO EN AND C40K STA MLTH,I LDA MRDFL,I GET PTTN STATUS AND D7 IF MOTHER PTTN STILL IN PROCESS CPA D4 OF CLEANING OUT SUBPTTNS JMP UNMOM,I FORGET RELINKING SUBPTTNS * UNMOL LDA MSUBL,I ANY SUBPARTITIONS? CPA MOM END OF LIST? JMP UNMOM,I YES. RETURN * JSB MATAD SET UP PTRS TO CURRENT MAT LDB ABGFR LDA MFLGS SSA RT PTTN? LDB ARTFR YES, CHANGE TO RT FREE LIST STB FLIST SET PROPER FREE LIST PTR JSB FLINK TO LINK SUBPTTN INTO LDA MLTH,I CLEAR "C" BIT TOO AND C40K STA MLTH,I JMP UNMOL LINK NEXT SUBPTTN SOMEWHERE * C40K OCT 137777 ULFRE NOP HED DISP4 -- MEMORY ALLOCATION TABLE LIST LINKAGE ROUTINES * MAT ENTRY * * WORD DESCRIPTION * !--!--.--.--!--.--.--!--.--.--!--.--.--!--.--.--! * !15 14 13 12 11 10 09 08 07 06 05 04 03 02 01 00! * !--!--.--.--!--.--.--!--.--.--!--.--.--!--.--.--! * ! ! ! ! ! ! ! * MLNK 0 !00! LINK TO NEXT ENTRY IN LIST ! * ! ! ! ! ! ! ! * !--!--------!--------!--------!--------!--------! * ! ! ! ! ! ! ! * MPRIO 1 !00! PRIORITY OF PARTITION OCCUPANT ! * ! ! ! ! ! ! ! * !--!--------!--------!--------!--------!--------! * ! ! ! ! ! ! ! * MID 2 !00! ID SEGMENT ADDRESS OF OCCUPANT ! * ! ! ! ! ! ! ! * !--!--------!--------!--------!--------!--------! * ! ! ! ! ! ! ! * MADR 3 ! M!** D ******** BEGIN PHYSICAL PAGE# ! * !@@! ! @@@@@@@@@@@@@@@@@@@@@@@@@@@@@! * !--!--------!--------!--------!--------!-------V-! * ! ! ! ! ! ! ! * MLTH 4 ! R! C *********** NUMBER OF PAGES IN PTTN ! * !@@! ! @@@@@@@@@@@@@@@@@@@@@@@@@@@@@! * !--!--------!--------!--------!--------!--------! * ! ! ! ! ! ! ! * MRDFL 5 !RT!***********************************! STATUS ! * !@@! ! ! ! ! ! * !--!--------!--------!--------!--------!--------! * ! ! ! ! ! ! ! * MSUBL 6 !00! POINTER TO NEXT SUBPTTN OR 0 ! * !@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@! * !--!--.--.--!--.--.--!--.--.--!--.--.--!--.--.--! * !15!14 13 12!11 10 09!08 07 06!05 04 03!02 01 00! * !--!--.--.--!--.--.--!--.--.--!--.--.--!--.--.--! * * "@" MARKS THE PARTS WHICH ARE SET AT GENERATION TIME: * "*" MARKS THE RESERVED PARTS * * PARTITION STATUS = * 0 PROGRAM BEING LOADED * 1 PROGRAM IS IN PARTITION * 2 SWAPPING OUT OR SEGMENT BEING LOADED * 3 PROGRAM IS SWAPPED OUT * 4 SUBPARTITIONS ARE BEING SWAPPED OUT * 5 SUBPARTITIONS ALL SWAPPED OUT * ************************************** * SET UP POINTERS TO ENTRY IN MAT * CALL: (A) = ID SEG ADDR OF PROG * JSB MATEN * ************************************** * MATEN NOP ADA D21 GET MAP ID WORD LDA A,I AND B77 GET PARTITION # STA CNT MPY MATSZ MULTIPLY BY MAT ENTRY LENGTH ADA $MATA JSB MATAD JMP MATEN,I RETURN * * * SET UP THE MAT POINTERS FROM THE MAT ADDR * MATAD NOP STA MLNK SET MAT ENTRY POINTER INA STA MPRIO ID SET PRIORTY INA STA MID ID SEG ADR INA STA MADR MAP START ADR INA STA MLTH PTTN LENGTH IN PAGES INA STA MRDFL READ COMPLETION FLAG INA STA MSUBL SUBPARTITION LINK WORD LDA MRDFL,I AND C7 STA MFLGS FLAGS IN PTTN STATUS WORD JMP MATAD,I * * MATSZ DEC 7 MLNK NOP LINKAGE WORD MPRIO NOP PRIORITY RESIDENT MID NOP ID SET ADR MADR NOP MAP START,BITS 0-9 MLTH NOP PTTN LENGTH, BITS 0-9 MRDFL NOP READ FLG(0-2),RT FLAG(15) MSUBL NOP CNT NOP PARTITION # MFLGS NOP UPPER BITS * * * CALCULATE ID SEGMENT EXTENSION ADDRESS * CALL: * (A) = ID SEG WORD 29 * JSB IDXAD * * * IDXAD NOP SZA,RSS ANY EMA? JMP IDXAD,I NO, RETURN P+1 * ALF YES, GET ID EXT# RAL,RAL AND B77 ADA $IDEX INDEX THRU KEYWORD TABLE LDA A,I GET THE ID EXT ADDR ISZ IDXAD JMP IDXAD,I RETURN AT P+2 SKP * ****************************************** *RELINK PART BY NEW PRIORITY ***************************************** * RLNK NOP RELINK BY NEW PRIORITY LDA MADR,I AND DMFLG SEE IF IN DORMANT PTTN ALLOC LIST SZA,RSS JMP RLN1 NO * XOR MADR,I YES STA MADR,I CLEAR FLAG LDA DLIST RLN2 LDB MLNK GET ADR CURRENT ENTRY JSB UNLNK GO UNLINK JSB ALINK GO RELINK IN ALLOC BY NEW PRIO JMP RLNK,I * RLN1 LDA ALIST GO UNLINK ALLOC LIST JMP RLN2 * * ******UNLINK ROUTINE******************** ****CALL: (A) = POINTER TO LIST HEAD * (B) = ADDR MAT ENTRY LOOKING FOR * JSB UNLNK * AFTER UNLINKING ***************************************** * UNLNK NOP UNLN1 SZA,RSS SHOULD NEVER GET CAUGHT HERE! BUT IF WE DO... HLT06 HLT 6 AT LEAST WE HAVE A CHANCE TO FIND IT STA ULST RIGHT, JIM? LDA ULST,I GET ADR CURRENT ENTRY CPB A SAME AS ONE SEARCHING FOR d6 RSS YES,GO UNLINK JMP UNLN1 GO TRY NEXT ENTRY LDB B,I GET THIS ENTRY'S LINK STB ULST,I STORE IN PREVIOUS ENTRY LINK JMP UNLNK,I * ULST NOP * * ****LINK INTO FREE LIST******* * CALL: MLNK IS THE PTTN ENTRY TO BE ENTERED IN FREE LIST * FLIST IS SET TO THE PROPER FREE LIST (SMALLEST PTTN FIRST) * JSB FLINK * PTTN IS LINKED BY SIZE (SMALLEST PTTN FIRST) ****************************** * FLINK NOP LDA MADR,I IOR DMFLG XOR DMFLG CLEAR DORMANT FLAG STA MADR,I LDA MLTH,I GET CURRENT LENGTH AND B1777 SCREEN OUT FLAGS LDB A CMB,INB FLN1 LDA FLIST,I GET FIRST ENTRY IN LIST SZA,RSS JMP FLN2 * ADA D4 BUMP TO LENGTH WORD LDA A,I AND B1777 SCREEN OUT FLAGS ADA B SSA,RSS S=1 NEXT PARTITION SMALLER JMP FLN2 S=0, GO LINK * LDA FLIST,I STA FLIST GO CHECK NEXT ENTRY IN LIST JMP FLN1 * FLN2 LDA FLIST,I GET PREVIOUS POINTER STA MLNK,I PUT IN THIS ENTRY LINK WORD LDA MLNK GET ADR THIS ENTRY STA FLIST,I PUT IN LINK WORD PREVIOUS ENTRY JMP FLINK,I * *******LINK IN ALLOCATED LIST********** * ALINK NOP LDA MLNK SET PTTN LINK ADR STA XLNK LDA MLTH SET PTTN LENGTH ADR STA XLTH LDB MPRIO,I GET CURRENT PRIORITY CLA STA XEND SET END LIST LDA ALIST STA XLST SET UP LINK LIST JSB XXLNK GO LINK JMP ALINK,I * XLTH NOP XLNK NOP XEND NOP XLST NOP C7 EQU DM8 SKP * * ****SETUP FOR DORMANT LINK******* ******CALL: (A) = ID SEG ADDR * JSB DSET * WITH ULST-ALLOC LIST * XLST-DORM LIST ******************************** * DSET NOP STA XLTH SAVE IN TEMP CELL ADA D14 LDA A,I u GET TYPE WORD AND D15 CPA D1 JMP DSET,I MEM RES,DONT LINK * LDA XLTH ADA D21 LDA A,I GET MAPID WORK AND B77 GET PTTN # MPY MATSZ CALCULATE ADR ADA $MATA STA XLNK STORE ADR JPARTITIONS LIND ADA D2 LDB A,I GET PTTN RES CPB XLTH SAME AS THE PROGRAM RSS YES JMP DSET,I NO, DON'T LINK * INA INCRE TO WORD 3 LDB A,I SSB IS THIS A MOTHER PTTN? JMP DLMOM YES, SET UP FOR LINKING MOTHER * INA SET UP TO PUT TOP ALLOC STA XLTH SAVE ADDR OF PTTN LENGTH WORD INA LDA A,I GET FLAG WORD SSA IS THIS A BG PTTN? JMP DLRT NO, IT IS RT * LDA ABGDM ADD TO BG DORMANT LIST STA XLST LDA ABGPR GET BG ALLOC LIST ADDR DLN1 STA ULST SET UNLINK HEADER STA XEND SET END LIST ISZ DSET JMP DSET,I * DLRT LDA ARTDM STA XLST SET RT DORM LIST ADDR LDA ARTPR GET RT ALLOC LIST ADDR JMP DLN1 SET UP FOR RETURN FROM DSET * DLMOM LDA ACHDM STA XLST SET MOTHER DORMANT LIST ADDR LDA ACHPR GET MOTHER ALLOC LIST ADDR JMP DLN1 SET UP FOR RETURN FROM DSET * DMFLG OCT 20000 BIT 13 OF MAT WORK 3 INDICATED DMLIST *** * *********LINK DORMANT PROGAM IN ALLC LIST**** * * DLINK NOP JSB DSET GO SETUP JMP DLINK,I NO LINK RETURN,NOT STILL IN PART * LDB XLNK ADB D3 LDA B,I GET WORK 3 MAT ENTRY AND DMFLG SZA IS IT ALREADY IN DORMANT LIST JMP DLINK,I YES, DON'T LINK AGAIN * LDA DMFLG NO IOR B,I SO SET FLAG AND LINK STA B,I LDB XLNK LDA ULST JSB UNLNK GO UNLINK ALLOCATED LIST LDA XLNK INA LDB A,I GET PRIORITY JSB XXLNK 3 GO LINK JMP DLINK,I SKP ****PERFORM LINK INTO ALLOCATED LIST**** ******ROUTINE WILL INSERT IN ALLOCATED * LIST IN ORDER OF INCREASING * PRIORITY(DECREASING NUMBER). PTTN * OF SAME PRIORITY WILL BE IN ORDER * OF INCREASING LENGTH.*************** *CALL:XLNK ADDR OF CURRENT MAT LINK WORD * XLTH ADDR OF CURRENT MAT LENGTH WORD * XLST ADDR OF ALLOCATED LIST TO BE ADDED INTO * JSB XLINK * *************************************** * * XXLNK NOP ALN1 LDA XLST,I GET FIRST ENTRY IN LIST CPA XEND END OF LIST JMP ALN3 YES * INA BUMP TO PRIORITY WORK LDA A,I CMA,INA SCREEN OUT FLAGS ADA B ADD TO CUTTENT PRIORITY SSA,RSS S=1,NEXT PARTITION LOWER PRIORITY JMP ALN2 S=0,GO LINK * ALNXT LDA XLST,I GO CHECK NEXT ENTRY STA XLST JMP ALN1 * ALN2 SZA,RSS ARE PRIORITIES THE SAME JMP ALN4 GO ARRANGE BY LENGTH * ALN3 LDA XLST,I GET PREVIOUS POINTER STA XLNK,I PUT IN THIS ENTRY LINK WORD LDA XLNK GET ADR THIS ENTRY STA XLST,I PUT IN LINK WORK PREVIOUS JMP XXLNK,I * ALN4 LDA XLTH,I GET LENGTH CURRENT ENTRY AND B1777 SCREEN OUT FLAGS CMA,INA STA CLTH LDA XLST,I ADA D4 LDA A,I GET LENGTH NEXT ENTRY IN LIST AND B1777 SCREEN OUT FLAGS ADA CLTH SSA S=1,CURRENT LENGTH GREATER JMP ALNXT GO SEE IF NEXT ENTRY BIGGER JMP ALN3 CURRENT SMALLER,GO LINK * CLTH NOP SKP *******UNLINK ALLOCATED,LINK DORMANT**** * CALL: (A) = ID SEG ADDR * JSB $ALDM * *************************************** * $ALDM NOP JSB DLINK JMP $ALDM,I NOT STILL IN PTTN OR ALREADY IN DM * * ************************************* ****UNLINK DORMANT,LINK ALLOCATED**** * CAL&L: (A) = ID SEG ADDR * JSB DMAL * **NOTE--MUST MAKE SURE IN DORMANT LIST ** BEFORE GET HERE**** ************************************* * $DMAL NOP JSB DSET GO SET UP JMP $DMAL,I NOT IN PTTN,DONT CHANGE * LDB XLNK ADB D3 LDA B,I XOR DMFLG CLEAR DM LIST FLAG STA B,I LDA XLST GO UNLINK DORM LIST LDB ULST STB XLST SET TO INSERT ALLOC LIST LDB XLNK JSB UNLNK CLA STA XEND LDA XLNK INA LDB A,I GET PRIORITY JSB XXLNK GO LINK IN ALLOC LIST JMP $DMAL,I SKP *****RELINK FOR PR COMMAND********* **RELINKS IN ALLOC LIST BY NEW PRIORITY** * * $PRCN NOP STB NEWPR JSB DSET GO SET UP JMP $PRCN,I NOT STILL IN PTTN,DONT RELINK * LDB XLNK ADB D3 LDA B,I AND DMFLG IS IT IN DORM LIST SZA,RSS JMP PRCG2 NO, MUST BE IN ALLOC * LDA XLST YES, IN DORM PRCG1 LDB XLNK JSB UNLNK GO UNLINK LDA XLNK INA LDB NEWPR PUT NEW PRIO IN PTTN STB A,I JSB XXLNK GO LINK BY NEW PRIO JMP $PRCN,I * PRCG2 CLA SET UP FOR ALLOC LIST STA XEND LDA ULST STA XLST JMP PRCG1 * NEWPR NOP ABGFR DEF $BGFR+0 ADR BG FREE LIST ABGPR DEF BGPR ADR BG ALC LIST HD ABGDM DEF BGDM ADDR BG DORMANT SUBLIST HEADER BGDM DEF BGPR INIT BG DORMANT SUBLIST HEAD BGPR NOP BG ALLOCATED LIST HEADER * * EXTERNAL DEFINITIONS FOR CMM4 & CDA4 * $BG1 EQU ABGFR $BG2 EQU ABGPR $BG3 EQU ABGDM $BG4 EQU BGDM $BG5 EQU BGPR * ARTFR DEF $RTFR+0 ADDR RT FREE LIST HEADER ARTPR DEF RTPR ADDR RT ALLOCATED LIST HEADER ARTDM DEF RTDM ADDR RT DORMANT SUBLIST HEADER RTDM DEF RTPR INIT RT DORMANT SUBLIST HEAD RTPR NOP RT ALLOCATED LIST HEADER * * EXTERNAL DEFINITIONS FOR CMM4 & CDA4 * $RT1 EQU ARTFR $RT2 EQU ARTPR $RT3 EQU ARTDM $RT4 EQU RTDM $RT5 EQU RTPR * ACHFR DEF $CFR+0 ACHPR DEF CHPR ACHDM DEF CHDM CHDM DEF CHPR CHPR NOP * * EXTERNAL DEFINTIONS FOR CMM4 & CDA4 * $MM1 EQU ACHFR $MM2 EQU ACHPR $MM3 EQU ACHDM $MM4 EQU CHDM $MM5 EQU CHPR * FLIST NOP CURRENT FREE LIST POINTER ALIST NOP CURRENT ALLOCATED LIST POINTER DLIST NOP CURRENT DORMANT SUBLIST POINTER SKP * $UNPE - UNLINK PARTITION AND UNDEFINE IT FOR PARITY ERROR MODULE * CALLED BY PERR4 * CALL: * (B) = MAT ADDR OF PARTITION * JSB $UNPE * REGISTERS MEANINGLESS * * $UNPE NOP STB NEWPR SAVE MAT ADDR ADB D3 LDA B,I SSA IS IT A MOTHER PTTN? JMP ULMOM YES, UNLINK AND UNDEFINE MOM * ADB D2 LDA B,I ADB DM3 LDB B,I (B) = ID ADDR SSA IS IT RT PARTITION? JMP ULRT YES * LDA ABGFR BG PARTITION SZB IS PTTN EMPTY? LDA ABGDM NO, USE BG ALLOC LIST JMP ULPTN YES, USE BG FREE LIST * ULRT LDA ARTFR USE RT FREE LIST IF EMPTY SZB IS PTTN EMPTY? LDA ARTDM NO, USE RT ALLOC LIST ULPTN LDB NEWPR JSB UNLNK UNLINK THE ENTRY CCA STA NEWPR,I UNDEFINE THE MAT ENTRY * CLA NOW SET THE MAT FREE LDB NEWPR ADB D2 STA B,I ZAP THE ID ADDRESS ADB D3 LDA B,I GET THE STATUS WORD AND BIT15 SAVE ONLY TYPE STA B,I ZAP THE STATUS JMP $UNPE,I RETURN * ULMOM LDA NEWPR CPA MOMFL SAME AS ONE WE'RE TRYING TO CLEAN OUT CLB,RSS YES, SKIP JMP ULM2 NO, UNLINK FROM LISTS * STB MOMFL YES, CLEAR SWAP OUT FLAGS STB SUBFL ULM2 ADA D4 LDA A,I RAL SSA,RSS IS MOTHER IN CHAIN MODE? JMP ULuM3 NO, SKIP UNMOM * LDA NEWPR JSB MATAD SET UP MAT ADDRS LDB NEWPR JSB UNMOM UNLINK SUBPTTNS FROM MOM LDA ACHFR UNLINK MOM FROM CH FREE LIST JMP ULPTN * ULM3 LDB NEWPR (UNMOM CHECKS PTTN STATUS = 4) ADB D2 LDA B,I GET PTTN STATUS AND D7 LDB A LDA ACHFR EITHER IT IS IN FREE LIST CPB D4 JMP ULMSP OR IN ALLOC LIST (SWAPPING SUBPTTNS) * LDB NEWPR ADB D2 LDB B,I SZB OR ULMSP LDA ACHDM IN ALLOC LIST (OCCUPIED) JMP ULPTN GO UNLINK AND UNDEFINE HED DISP4 -- BACKGROUND DISK PROGRAM LOADING * BACKGROUND DISK RESIDENT PROGRAM SCHEDULED * * * IF PROGRAM IS NOT RESIDENT OR BEING LOADED, GO TO * * READ IN PROGRAM FROM DISC AND SET READ IN WAIT * * FLAG, AND I/O SUSPEND THE PROGRAM. * * IF A PROGRAM IS RESIDENT AND * * IT IS THE DESIRED PROGRAM, GO TO SWITCHING * * SECTION TO EXECUTE THE PROGRAM. * * IT IS NOT THE DESIRED PROGRAM, * * CALL SWPCK TO CHECK SWAPABILITY OF THE * * CURRENT RESIDENT PROGRAM AND TAKE * * THE INDICATED ACTION. * * * X0100 LDA ABGFR SET UP LIST HEADERS STA FLIST LDA ABGPR STA ALIST LDA ABGDM STA DLIST * LDA ZIDEX SZA EMA ASSIGNED TO BG PTTN? JMP XE300 YES, GO TO MOTHER PTTN CODE * JSB FNDSG GO FIND PARTITION DEF BGSWP & SUPPLY THE $XSIO BUSY WORD LDA MRDFL,I GET READ COMP FLG SSA IS PROG IN RT PTTN JMP XB200 YES,GO pTHERE * XR100 LDB MID,I PROGRAM RESIDENT IN PTTN? SZB,RSS YES, SKIP JMP XN120 NO, SO GO READ IT IN * CPB ZWORK IF DESIRED PROGRAM JMP X0230 GO CHECK FOR READ COMPLETE * * * SET UP TO CALL SWPCK * LDA BGSWP IS BG SWP OR LOAD IN PROGRESS SZA NO,SO GO TO IT CPA B YES, IS IT SAME PTTN (B)=MID,I CLE,RSS OK,GO TO SWPCK (E=0) JMP X0035 * LDA D28 GET OCCUPANT'S EMA WORD ADA B LDA A,I SZA IS THAT PROG AN EMA PROG? JMP SWEMA YES, TRY SWAP OUT EMA PROG * JSB SWPCK CHECK SWAPPABILITY (E=0) JMP X0152 (P+1) GO CLEAR CURRENT LOAD JMP X101 (P+2) GO SWP OUT CURRENT PRGM * * LOAD RETURN FROM SWPCK * XN120 LDA BGSWP (P+3) GO LOAD OVER CURRENT OCCUPANT SZA JMP X0B35 YES, CALL BUSY, RELEASE PTTN IF FREE * LDA ZPRIO,I ASSIGN NEW PRIORITY TO PTTN CPA MPRIO,I IS IT SAME AS PARTITION PRIORITY? JMP XW120 YES, CAN'T RELINK * STA MPRIO,I ASSIGN NEW PRIORITY JSB RLNK GO RELINK IN ALLOCATED LIST XW120 LDB ZWORK STB MID,I SET NEW PGM IN PTTN JSB BBND GO SET BOUNDARY WORDS LDB ZWORK JSB $LIST SUSPEND PROG UNTIL READ COMPLETE OCT 402 CCA,CCE (E)=1 FOR PREST ON LOAD STA MRDFL,I * HED DISP4 -- BACKGROUND DISK RESIDENT PROGRAM SWAP OUT * SETUP TO SWAP OUT BACKGROUND DISK RESIDENT * * * SWAP OUT RT DISC RESIDENT PROGRAM FUNCTIONS AS FOLLOWS: * * COMPUTE NUMBER OF TRACKS NEEDED FOR SWAPPING * * OUT PROGRAM BY COMPUTING NUMBER OF SECTORS * * NEEDED FOR MAIN AND BASE PORTION OF PROGRAM. * * REQUEST THE NECESSARY NUMBER OF CONTIGUOUS * * TRACKS FRO@M EXECUTIVE. IF NONE IS AVAILABLE, * * THEN CANNOT SWAP AND RETURN TO CHECK NEXT PROG.* * IF TRACKS AVAILABLE, THEN SAVE STARTING TRACK * * ADDRESS, DISC LOGICAL UNIT NUMBER, AND NUMBER * * OF TRACKS INTO ID SEGMENT SWAP WORD. GENERATE * * PARAMETERS FOR SWAP OUTOF PROGRAM AND CALL * * DISC I/O ROUTINE. * * * X101 CLB,SEZ,INB,RSS INB STB BGRQ SET UP REQUEST CODE LDB MID,I LDA BTRPA JSB PREST EXITS VIA X0035 IF NO DISC SPACE FOR SWAP STB BGLU SET UP REQUEST LU STA BTRP SET UP TRIPLETS ADDR LDA MID,I SET CALL BUSY AFTER PREST RETURNS STA BGSWP LDA MRDFL STA BRDFL SAVE FLAGS ADDR LDA MFLGS STA BFLGS SAVE HIGH ORDER BITS LDA ZPRIO,I STA BSPR SET UP PRIORITY * JSB $XSIO MAKE DISC I/O CALL BGLU NOP LOGICAL UNIT DEF X0122 COMPLETION ADDR X0155 NOP LINK WORD BGRQ OCT 1 REQUEST CODE BTRP DEF BTRIP TRIPLETS ARRAY ADDR BSPR NOP BG SWAPPING PRIORITY BGSWP NOP ID ADDR OF PROG ISZ BRDFL,I SWAPPING OUT? JMP X0035 YES, FLAG = 2 * LDA BFLGS NO, LOAD. FLAG = 0 IOR BRDFL,I SET UP HIGH BITS STA BRDFL,I JMP X0005 * * BRDFL NOP BFLGS NOP SKP * * BACKGROUND READ IN COMPLETION PROCESSOR * * * THE BACKGROUND DISC RESIDENT READ COMPLETION PROCESSOR, * * IF NO READ ERROR, IT CLEARS THE READ IN WAIT FLAG, * * ENTERS PROGRAM INTO SCHEDULE LIST VIA LIST * * SUCH THAT EXECUTION CAN BEGIN AT THE NEXT * * OPPORTUNITY THE PROGRAM BECOME THE TOP OF LIST.* * IF READ ERRORS OCCURRED, CALL $ABRT PROCESSOR . * X0122 STB TEMP SAVE READ IN STATUS OF DISC ISZ BRDFL,I STEP BG RD FLAG (1 LOADED, 3 SEG LOADED) LDA BFLGS IOR BRDFL,I STA BRDFL,I SET READ FLAG=1 IF READ (A=1) LDB BGSWP CLA STA BGSWP CLEAR BG I/O FLAG LDA BGRQ * X0125 ISZ $LIST SET LIST FLAG TO FORCE SCAN SLA,RSS A=1 IF READ,0 IF WRITE JMP X0127 IT IS WRITE, GO SCAN LIST * STB TEMP1 SAVE ID-SEG. ADDRESS JSB $LIST CALL $LIST TO SCHEDULE PROG OCT 401 LDB TEMP CHECK READ IN STATUS FLAG SZA,RSS IF LIST ERROR OR SSB DISC ERROR RSS GO ABORT JMP X0127 ALL O-K SO GO SCAN THE LIST * LDA TEMP1 A CONTAINS ID SEG ADDR JSB $ABRT GO TO ABORT ROUTINE * X0127 LDA MOMFL SZA ANY SUBPTTNS TO SWAP OUT? JMP SUBSS YES, GO DO IT JMP $XCQ NO, DO NEXT SCHEDULE/ABORT * * CLEAR OUT CURRENT LOAD * X0152 LDB MID,I RESCHEDULE THE JSB $LIST PROGRAM OCT 401 XN153 LDA ABGDM LDB MLNK JSB UNLNK REMOVE LDA ABGFR STA FLIST STRING BY LENGTH JSB FLINK INSERT INTO FREE LIST X0154 CLB LDA MRDFL,I AND D7 CPA D5 DID WE JUST CLEAR MOTHER PTTN LOAD? JMP XABIO YES, ABORT I/O * SLA IS I/O GOING ON IN THIS PTTN? JMP XX154 NO, GO TO $XCQ * XABIO LDA MID,I GET RESIDENT PTTN STB MID,I CLEAR RESIDENT CPA BGSWP WAS I/O BUSY IN BG? JMP XB154 YES * CPA RTSWP RT CALL BUSY? JMP XR154 YES, CLEAR IT * CPA SGSWP JMP XS154 * CPA CHSW2 CHUNK I/O CALL BUSY? JMP XC154 YES, CLEAR IT * CPA CHSWP MOTHER PTTN I/O BUSY? JMP XM154 YES, CLEAR IT * XX154 STB MID,I NONE OF ABOVE, JMP $XCQ JUST CLEAR RESI[NLHDENCY WORD * XM154 STB CHSWP CLEAR MOTHER PTTN FLAG LDA DX355 BECAUSE IT WAS NONE OF ABOVE JMP $IOCL GO CANCEL LOAD * XC154 STB CHSW2 STB CHSWP LDA DX366 CHUNK I/O BUSY. JMP $IOCL GO CANCEL LOAD * XR154 LDA DX255 STB RTSWP CLEAR RT FLAG JMP $IOCL GO CANCEL LOAD * XB154 STB BGSWP CLEAR BG FLAG LDA DX155 JMP $IOCL GO CANCEL LOAD * XS154 STB SGSWP CLEAR SG FLAG LDA DX455 JMP $IOCL GO CANCEL LOAD * SPC 1 DX155 DEF X0155 ADDR OF LINK WORD IN BG $XSIO CALL DX255 DEF X0255 ADDR OF LINK WORD IN RT $XSIO CALL DX355 DEF X0355 ADDR OF LINK WORD IN MOTHER $XSIO CALL DX366 DEF X0366 ADDR OF LINK WORD IN CHUNK $XSIO CALL DX455 DEF X0455 ADDR OF LINK WORD IN SEGMENT $XSIO CALL EMAOF NOP MSGSZ NOP MSGPG NOP ZIDX0 NOP ZIDX1 NOP * B40 OCT 40 B176K OCT 176000 DM7 DEC -7 * X0B35 LDA MID,I GET PTTN RESIDENT SZA IF EMPTY PUT BACK IN FREE LIST JMP X0035 OTHERWISE ,DONT BOTHER * LDA ALIST GO REMOVE ALLOCATD LIST LDB MLNK JSB UNLNK JSB FLINK JMP X0035 * * * SET PROGRAM MEMORY BOUND WORDS ON BASE PAGE * CALL: * (B) = ID SEG ADDR * JSB BBND * * BBND NOP SUBROUTINE TO SET MEMORY BOUND WORDS ADB D21 LDA B,I GET LENGTH OF PROG AND B76K ADA DM1 STA LTH ADB DM7 LDA B,I GET TYPE AND D15 ADB D8 INDEX TO LOW MAIN N CPA D2 RT PROG? JMP BBNDR YES, SET RT BOUNDS * LDB B,I NOT RT, CAN ONLY BE BG STB BGDRA SET UP START BG DSK RES LDA B AND B76K SET NEW END OF CORE ADA LTH STA BGLWA CCA ADA BGDRA STA RTDRA SET RT POINTERS TO ONE LESS BG STA AVMEM FAKE FOR RTE PROCESSORS JMP BBND,I RETURN WITH THE BOUNDS * BBNDR LDB B,I SET UP RT BOUNDS STB RTDRA LDA B AND B76K ADA LTH STA AVMEM STA BGDRA STA BGLWA JMP BBND,I RETURN WITH RT BOUNDS * HED DISP4 -- RT DISK RESIDENT LOAD TESTS * * REAL TIME DISC RESIDENT * * REAL TIME DISC RESIDENT PROGRAM EXECUTION * * IF PROGRAM IS NOT RESIDENT OR BEING LOADED, GO TO * * READ IN PROGRAM FROM DISC AND SET READ IN WAIT * * FLAG, AND I/O SUSPEND THE PROGRAM. * * IF A PROGRAM IS RESIDENT AND * * IT IS THE DESIRED PROGRAM, GO TO SWITCHING * * SECTION TO EXECUTE THE PROGRAM. * * IT IS NOT THE DESIRED PROGRAM, * * CALL SWPCK TO CHECK SWAPABILITY OF THE * * CURRENT RESIDENT PROGRAM AND TAKE * * THE INDICATED ACTION. * * * X0200 LDA ARTFR SET POINTERS TO LIST HEADERS STA FLIST LDA ARTPR STA ALIST LDA ARTDM STA DLIST * LDA ZIDEX SZA EMA ASSIGNED TO RT PTTN? JMP XE300 YES, GO TO MOTHER PTTN CODE * JSB FNDSG GO FIND PARTITION DEF RTSWP & SUPPLY THE PROPER $XSIO BUSY WORD LDA MRDFL,I GET READ COMP FLAG SSA,RSS IS PROG IN BG PTTN? JMP XR100 YES,GO DO jIT * XB200 LDB MID,I IS PROGRAM RESIDENT? SZB,RSS JMP XN220 NO, SO GO READ IT IN * CPB ZWORK YES, DESIRED PROGRAM JMP X0230 GO CHECK FOR READ COMPLETE * * SET UP TO CALL SWPCK * LDA RTSWP IS RT I/O CALL BUSY? SZA NO, GO TO IT CPA B YES, IS IT SAME PTTN? (B)=MID,I CLE,RSS YES, GO TO SWPCK (E=0) JMP X0035 NO, I/O CALL BUSY, TRY NEXT PROG * LDA D28 GET OCCUPANT'S EMA WORD ADA B LDA A,I SZA IS THAT PROG AN EMA PROG? JMP SWEMA YES, TRY SWAP OUT EMA PROG * JSB SWPCK CHECK SWAPPABILITY (E=0) JMP X0252 GO CLEAR CURRENT LOAD JMP X201 GO SWAP OUT CURRENT PGM. JMP XN220 * SPC 1 X0230 AND B7 PROG IN MEMORY, SCHED IF DONE LOAD CCE,SLA,RSS READ IN COMPLETE? JMP X0035 NO, GO TRY THE NEXT PGM * CPA D3 STILL IN MEMORY AFTER SWAP? JMP X02IN YES, USE IT AGAIN * LDA ZWORK ADA D27 LDA A,I SWAP BACK IN? CCE,SZA CLE YES, FORCE NEW MAP XW230 LDB MLNK JSB $SMAP SET UP USER MAP LDB ZWORK GET THE ID-SEG. ADDRESS JSB DREL RELEASE SWAP TRACKS IF ANY JMP X0040 GO EXECUTE THE PGM. * X02IN LDB MFLGS CCE,INB STB MRDFL,I FORCE PTTN STATUS=1 JMP XW230 RE-USE BP COPY OF USER MAP (E=1) HED DISP4 -- RT DISK RESIDENT READ IN * * SETUP TO READ IN RT DISK PROGRAM * * READ IN OF REAL TIME DISC RESIDENT PROGRAM * * IF ID SEGMENT SWAP ADDRESS IS ZERO, THE SYSTEM * * GENERATED DISC ADDRESS IS USED TO COMPUTE THE * * PARAMETERS FOR DISC I/O CALL. * * IF THERE IS SWAP ADDRESS, THEN THIS DISC ADDRESS * * IS USED. * *  * XN220 LDA RTSWP TRANSFER IN ANOTHER AREA? SZA NO, OKAY TO LOAD JMP X0B35 YES, FREE UP PTTN AGAIN * LDA ZPRIO,I ASSIGN NEW PRIORITY TO PTTN CPA MPRIO,I IF SAME PRIO,DONT RELINK JMP XW220 * STA MPRIO,I JSB RLNK GO RELINK IN ALLOCATED LIST XW220 LDB ZWORK STB MID,I JSB BBND GO SET BOUNDARIES LDB ZWORK JSB $LIST IO SUSPEND PROG OCT 402 UNTIL READ COMPLETED CCA,CCE SET (E=1 LOAD) FOR PREST STA MRDFL,I (A)= -1 FOR LOAD OR SWAP-IN HED DISP4 -- RT DISK RESIDENT PROGRAM SWAP OUT * * SETUP TO SWAP OUT RT DISK RESIDENT * * * SWAP OUT RT DISC RESIDENT PROGRAM FUNCTIONS AS FOLLOWS: * * COMPUTE NUMBER OF TRACKS NEEDED FOR SWAPPING * * OUT PROGRAM BY COMPUTING NUMBER OF SECTORS * * NEEDED FOR MAIN AND BASE PORTION OF PROGRAM. * * REQUEST THE NECESSARY NUMBER OF CONTIGUOUS * * TRACKS FROM EXECUTIVE. IF NONE IS AVAILABLE, * * THEN CANNOT SWAP AND RETURN TO CHECK NEXT PROG.* * IF TRACKS AVAILABLE, THEN SAVE STARTING TRACK * * ADDRESS, DISC LOGICAL UNIT NUMBER, AND NUMBER * * OF TRACKS INTO ID SEGMENT SWAP WORD. GENERATE * * PARAMETERS FOR SWAP OUTOF PROGRAM AND CALL * * DISC I/O ROUTINE. * * * (E)=0 SWAP OUT (E)=1 LOAD IN X201 CLB,SEZ,INB,RSS SET UP THE REQUEST CODE INB AND SET STB RTRQ LDB MID,I ID SEGMENT ADDRESS LDA RTRPA GET THE QUE ADDRESS JSB PREST GO SET UP THE SWAP STB RTLU SET THE LU STA RTRP SET THE TRIPLET QUE ADDRESS LDA MID,I STA RTSWP LDA MRDFL STA RRDFL LDA MFLGS SAVE FLAGS STA RFLGS LDA ZPRIO,I SET THE REQUEST PRIORITY STA RTSPR IN THE CALL JSB $XSIO CALL FOR DISK I/O RTLU NOP LOGICAL UNIT DEF X0251 COMPLETION ADDRESS X0255 OCT 0 RTRQ NOP REQUEST CODE READ/WRITE RTRP DEF RTRIP ARRAY ADDRESS RTSPR NOP RT SWAP PRIORITY RTSWP NOP EXTENDED XSIO CALL--ID ADR ISZ RRDFL,I SWAPPING OUT? JMP X0035 YES, CONTINUE SEARCH (FLAG = 2) * LDA RFLGS NO, IT'S LOAD IOR RRDFL,I PUT FLAGS BACK IN MAT WORD STA RRDFL,I NOW=0 IF LOADING OR SWAPPING IN JMP X0005 RESCAN LIST, NEW PROG MAY BE READY. * RFLGS NOP UPPER 13 BITS OF PTTN STATUS WORD RRDFL NOP ADDR OF MAT PTTN STATUS WORD SPC 2 * * * READ IN COMPLETION PROCESSOR * * THE REAL TIME DISC RESIDENT READ COMPLETION PROCESSOR, * * * IF NO ERRORS, IT CLEARS READ IN WAIT FLAG, AND * * SCHEDULES PROGRAM SUCH THAT PROGRAM EXECUTION * * CAN BEGIN AT THE NEXT OPPORTUNITY. * * IF READ ERRORS, CALL $ABRT PROCESSOR * * * X0251 STB TEMP SAVE READ IN STATUS OF DISK ISZ RRDFL,I SET FLAG =1 LOAD DONE, =3 SWAP DONE LDA RFLGS IOR RRDFL,I STA RRDFL,I LDB RTSWP GET ID SEG ADR CLA STA RTSWP CLEAR SWAP IN PROGRESS LDA RTRQ GET REQUEST CODE JMP X0125 GO FINISH CHECKS SPC 2 X0252 LDB MID,I ABORT LOAD IN PTTN WHICH WE NEED JSB $LIST AND RESCHEDULE THE ABORTED PROG OCT 401 TO BE LOADED AGAIN LATER XN253 LDA ARTDM LDB MLNK JSB UNLNK REMOVE PTTN FROM ALLOCATED LIST LDA ARTFR STA FLIST JSB FLINK INSERT PTTN INTO FREE LIST JMP X0154 GO CANCEL LOAD SPC 1 RTRPA DEF RTRIP SPC 1 HED DISP4 -- MOTHER PARTITION RESIDENT PROGRAM PROCESSING * DISPATCHING EMA PROGRAM * OR A BG OR RT PROGRAM ASSIGNED TO A MOTHER PARTITION X0300 LDA ACHFR SET UP LIST HEADERS STA FLIST LDA ACHPR STA ALIST LDA ACHDM STA DLIST * LDA ZIDEX SZA,RSS IS IT AN EMA PROG? JMP X0310 NO * XE300 LDB ZWORK YES, IT IS EMA PROG ADB D8 LDB B,I GET POINT OF SUSPENSION FROM ID SEG SZB INITIAL DISPATCH? JMP X0310 NO, LEAVE EMA SIZE OR EMA START PAGE ALONE * LDA ZIDEX YES, INITIAL DISPATCH CCE,INA STA ZIDX1 SAVE ADDR OF WORD 1 IN ID EXT LDA ZIDEX,I AND B37 GET #PAGES IN MSEG STA B SAVE # PAGES IN MSEG RAL,ERA SET SIGN AND CLEAR MSEG # STA ZIDEX,I SO MSEG PAGES GET PROTECTED LDA ZMPID,I AND B76K ALF RAL,RAL GET SIZE OF PROG LESS BP CMB,INB SUBTRACT MSEG FOR ACTUAL CODE SIZE ADB A KEEP PROG SIZE IN (B) * LDA ZIDX1,I GET ID EXT WORD 1 ALF,RAL SSA,RSS WAS DEFAULT BIT SET? JMP X0310 NO, JUST USE SPECIFIED EMA SIZE * LDA ZEMA,I AND B1777 CPA D1 IS IT DEFAULTED TO 1? RSS YES, SET UP NEW EMA SIZE JMP X0310 NO, USE GIVEN SIZE * CMB,INB SUBTRACT ACTUAL CODE SIZE FROM PTTN SIZE LDA ZMPID,I SSA,RSS ASSIGNED TO A PTTN? JMP X0308 NO, USE $MCHN SIZE * STB NPGN SAVE NEG PROG SIZE LDA ZWORK YES, FIND THE PTTN'S SIZE JSB MATEN LDA MLTH,I AND B1777 LDB NPGN SUBTRACT PROG SIZE ADB A FROM PTTN SIZE TO CALCULATE RSS EMA SIZE X0308 ADB $MCHN USE MOTHER PTTN SIZE TO CALCULATE LDA kZEMA,I GET EMA WORD FROM ID SEG AND B176K IOR B AND FILL IN NEW EMA SIZE STA ZEMA,I SAVE NEW EMA SIZE WORD * X0310 JSB FNDSG GO FIND A PTTN LARGE ENOUGH DEF CHSWP & SUPPLY THE PROPER $XSIO BUSY WORD LDB MID,I PROG ASSIGNED TO MOTHER PTTN SZB,RSS IS ANY PROG IN PTTN? JMP XS320 NO, READ PROG IN IF REALLY FREE * CPB ZWORK YES, BUT IS IT THE CORRECT ONE? JMP X0330 YES, CHECK FOR READ COMPLETE * SWEMA LDA CHSWP NO, TRY SWAP IT OUT SZA IS I/O CALL BUSY? CPA B YES, CALL BUSY. IN THIS PTTN? (B)=MID,I CLE,RSS CALL NOT BUSY OR ONLY BUSY IN THIS PTTN JMP X0035 CALL IS BUSY, SO DO SOMETHING ELSE. * JSB SWPCK CHECK SWAP CONDITION (E=0) JMP X0352 THIS PROG PR > CURR PROG READ IN, STOP IT JMP X0325 WE CAN SWAP OUT OLD OCCUPANT JMP XN320 OCCUPANT NOT EXECUTED SINCE LOAD, OVERLAY IT * * * WE CAN SWAP OUT OLD PROGRAM IN PARTITION * X0325 LDB MID,I JSB BBND SET UP PROG BOUNDS FOR PREST LDB MID,I GET OLD OCCUPANT ID ADDR ADB D28 INDEX TO EMA WORD LDA B,I STA ZIDEX STB ZEMA SET UP FOR SWAP OUT CODE JSB IDXAD GET ID EXT ADDR JMP X0326 NOT EMA, GO SWAP STA ZIDEX SAVE IT INA LDA A,I ALF,RAL AND B37 STA MSGPG SAVE START PAGE MSEG * LDB MLNK GET MAT ADDR JSB PHYBP TO MAP IN THE PHYSICAL BP ADA MSGPG LDA A,I CLE,ELA SEZ,RSS IF PAGE IS READ-PROTECTED ELA,RAR SEZ,CCE OR PAGE IS WRITE-PROTECTED CLA THEN NO MSEG WAS MAPPED * ALF,RAL PAGE# TO BITS 5-14, BIT 15 SET ERA STA B (PAGE# = 0 IF NO MSEG MAPPED) * LDA ZIDEX,I AND B37 IOR B GET MSEG SIZE IN BITS 0-)O4 STA ZIDEX,I REPLACE WORD 0 OF ID EXT X0326 CLE JMP X301 GO SWAP * SPC 3 * SWAPPED EMA PROGRAM BACK IN * SINCE IT MAY COME BACK IN DIFFERENT PARTITION, WE MUST * REBUILD THE MSEG PAGE REGISTERS AND SAVE A NEW COPY OF * THE MAP IN THE USER'S PHYSICAL BASE PAGE. * * EMA START OFFSET = PG# CURR EMA PAGE - OLD EMA START PAGE * NEW EMA START PG = 1ST PG NEW PTTN + #PAGES IN ID + 1 - MSEG SIZE * #PG TO MAP IN MSEG= MSEG SIZE + 1 * * IF MSEG IS NOT COMPLETELY FILLED BY EMA PAGES BECAUSE * END OF THE EMA WAS REACHED OR IF THERE WAS NO MSEG MAPPED * AT THE TIME OF THE SWAP-OUT, THEN THOSE PAGES WILL BE * SET UP WITH READ-WRITE PROTECT. * * X0330 LDA MRDFL,I AND D7 GET PTTN STATUS CPA D4 STILL TRY TO SWAP OUT SUBPTTNS? JMP XS322 YES, DO SOME MORE * CPA D5 ALL DONE WITH SUBPTTNS? JMP XN320 YES, LOAD INTO IT * LDB ZIDEX NONE OF ABOVE, SO READ STARTED ALREADY SZB,RSS IS IT AN EMA PROG? JMP X0230 NO, JUST SET UP BP MAP * CCE,SLA,RSS IS EMA LOAD ALL DONE? JMP X0035 NO, GO DISPATCH NEXT PROG * CPA D3 STILL IN MEMORY AFTER SWAP OUT? JMP X03IN YES, CHANGE PTTN STATUS TO 1 * LDB MLNK PROGRAM IS IN MEMORY LDA ZWORK ADA D27 LDA A,I GET SWAP TRACKS WORD SZA LOAD BACK FROM SWAP? JMP X0335 YES, FORCE NEW MAP (E)=0 * LDA ZWORK ADA D8 LDA A,I GET PT OF SUSP SZA,RSS INITIAL EXECUTION? JMP X0335 YES, NEW MAP, NEW MSEG * JSB $SMAP NO, RE-RUN. REUSE MAP (E=1) JMP X0040 * X0335 CLE (E=0) TO FORCE NEW MAP JSB $SMAP SET UP USER MAP LDA ZIDEX,I EMA PROG JUST LOADED AND B37 NEEDS MAP REGS SET UP FOR MSEG STA MSGSZ SAVE MSEG SIZE LDB ZIDEX INB STB ZIDX1 SAVE ADDR OF ID EXT WORD 1 LDA B,I AND B1777 CMA,INA STA EMAS SAVE NEG. EMA START PAGE * LDA B,I ALF,RAL AND B37 LOGICAL START PAGE MSEG STA MSGPG * LDA ZIDEX,I GET PHYSICAL PAGE# OF FIRST CLE,ELA PAGE IN THE MSEG IF ANY MAPPED IN ALF,ALF IF NO MSEG WAS IN USE OR FIRST LOAD RAL,RAL SAVE PAGE# = 0 AND B1777 STA TEMP SAVE PHYSICAL PAGE IN MSEG ADA EMAS SUBTRACT EMA START STA EMAOF AND SAVE OFFSET INTO EMA * LDB MSGSZ NEGATE #PGS IN MSEG CMB,INB LDA ZMPID,I GET #PAGES IN USER ALF (WITHOUT BASE PAGE) RAL,RAL AND B37 TO GET ACTUAL CODE SIZE INA ADB A IN (B) * LDA MADR,I GET PHYSICAL START PAGE OF PTTN AND B1777 FROM MATA ENTRY ADB A ADD TO GET NEW START PAGE EMA STB EMAS SAVE NEW EMA START LDA ZIDX1,I AND B176K IOR B ADD OLD BITS IN HIGH PART STA ZIDX1,I STORE NEW ID EXT WORD 2 LDA TEMP SZA,RSS WAS THERE AN MSEG MAPPED? JMP WPMSP NO, SET ALL MSEG AS READ-WRITE PROTECTED * ADB EMAOF ADD OFFSET TO NEW EMA START STB TEMP SAVE NEW PHYSICAL PAGE MSEG * LDA ZEMA,I AND B1777 ADA EMAS STA EMAL SAVE PAGE PAST END EMA CMA,CLE,INA SUBTRACT FROM ADA TEMP ADA MSGSZ SEZ PAST END OF EMA? JMP OVMSP YES, (B) STILL HAS PAGE # * MPMSP LDA MSGSZ SET (A) UP FOR ENTIRE MSEG SIZE JMP MPMSG AND MAP ALL OF MSEG * WPMSP LDB RDWRP SET (B) UP FOR READ-WRITE PROTECT JMP MPMSP ALL MSEG PAGES * OVMSP CMA,INA SET (A) UP FOR JUST # PAGES NEEDED ADA MSGSZ IN THE MSEG MPMSG CAX (X)=#REGISTERS LDA MSGPG (B)=PAGE# ADA B40 (A)=USER REG# FOR MSEG XMS sH MAP IT SSB WERE PAGES PROTECTED? JMP MPLFT YES, SKIP OVERFLOW PAGE SET UP * CPB EMAL LAST PAGE MAPPED? LDB RDWRP CHANGE TO READ-WRITE PROTECTED LDX D1 (X)=1 REG XMS * MPLFT LDB A WRITE PROTECT ALL OTHER CMB,INB REMAINING PAGES, IF ANY ADB B100 CBX LDB RDWRP XMS * * LDB MLNK JSB PHYBP IOR BIT15 (A) = SIGN SET TO SAVE MAP USA IN USER'S PHYSICAL BASE PAGE * XW330 LDB ZWORK JSB DREL RELEASE SWAP TRACKS, IF ANY JMP X0040 GO EXECUTE PROG * X03IN LDB MFLGS CCE,INB STB MRDFL,I SET STATUS = 1 FOR PROG IN MEMORY LDB MLNK JSB $SMAP RE-USE USER MAP (E=1) JMP XW330 AFTER SWAP, SO GET RID OF SWAP TRACKS * * B40K OCT 40000 D19 DEC 19 * * X0352 LDB MADR,I NEED TO ABORT LOAD IN PROGRESS SSB MOTHER PTTN? JMP XM352 YES, MOTHER PTTN * LDB MFLGS NO, MUST BE EMA ASSIGNED TO RT/BG SSB JMP X0252 ASSIGNED TO RT (UNLINK RT PTTN) JMP X0152 ASSIGNED TO BG (UNLINK BG PTTN) * * * PROGRAM WAS ASSIGNED TO A SUBPARTITION AND THE SWPCK ROUTINE * DETERMINED THAT IT IS HIGHER PRIORITY THAN THE PROGRAM BEING * LOADED INTO THE MOTHER PARTITION SO STOP THE LOAD. * XM352 LDB MID,I JSB $LIST RESCHEDULE PROG IN MOTHER PTTN OCT 401 * XN353 LDB MLNK PROG ABORTED BY OPERATOR OR SYSTEM JSB UNMOM OR PROGRAM COMPLETED NORMALLY XW354 JSB MATAD RESET UP PTRS FOR MOTHER PTTN JMP X0154 THEN CANCEL LOAD IF NEED TO * * * DO THE LOAD OF PROGRAM INTO MOTHER PTTN * XN321 LDA MADR,I MOTHER/EMA CALL IS BUSY SSA NEED TO LOAD INTO MOTHER PTTN? JMP X0035 YES, HAVE TO WAIT. TRY NEXT SCHED JMP X0B35 NO, EMA ASSIGNED TO RT/BG. RELEASE PTTN * * XS320 LDA MRDFL,I AND B7 STILL TRYING TO CLEAR SUBPTTNS? CPA D4 RSS YES, DO SOME MORE OR GO TO NEXT PROG JMP XN320 NO, DO LOAD IF CALL IS FREE * XS322 LDA CHSWP IS MOTHER PTTN/EMA CALL BUSY? SZA (NEED THIS, IN CASE OF ABORT IN SUBPTTN) JMP X0035 YES, BUSY SO SKIP IT FOR A WHILE JMP SUBS2 NO, DO NEXT SUBPTTN. * * XN320 LDA CHSWP IS MOTHER PTTN/EMA CALL BUSY? SZA JMP XN321 YES, BUSY. TRY NEXT PROG IF MOTHER PTTN * LDA ZPRIO,I NEW PRIORITY SAME AS CPA MPRIO,I OLD OCCUPANT OF PTTN? JMP XW320 YES, DON'T RELINK * STA MPRIO,I NO, SET UP NEW PRIORITY JSB RLNK AND RELINK BY PRIORITY IN ALLOCATED LIST XW320 LDB ZWORK STB MID,I JSB BBND GO SET BOUNDARY WORDS LDB ZWORK JSB $LIST I/O SUSPEND PROG OCT 402 UNTIL READ COMPLETED CCA,CCE E=1 FOR LOAD IN FLAG TO PREST STA MRDFL,I (A)=-1 FOR LOAD OR SWAP-IN * * * SWAP-OUT OR LOAD * X301 CLB,SEZ,INB,RSS SET UP REQ CODE INB AND SET UP STB CHRQ IN MOTHER PTTN CALL STB CHRQ2 LDA MLNK STA CHMAT SAVE MAT ADDR LDB MID,I (B) = ID SEG ADDR LDA CTRPA (A)=BOTTOM OF TRIPLETS JSB PREST SET UP FOR SWAP OR LOAD OF PROG STB CHLU1 SAVE LU STB CHLU2 STA CTRP SET TRIPLET QUEUE ADDR LDA TEMP1 STA CHTRK SAVE NEXT TRACK # LDA TEMP2 STA CHSCT SAVE NEXT SECTOR # LDA MID,I STA CHSWP SET EMA/MOTHER PTTN I/O CALL BUSY LDA MRDFL STA CRDFL SET ADDR OF READ-IN FLAG LDA MFLGS STA CFLGS SET HIGH BITS OF READ-IN FLAG LDA ZPRIO,I STA CHSPR SET REQUEST PRIORITY STA CHSP2 LDA ZEMA,I STA CHEMA SAVE CONTENT OF EMA WORD LDA ZIDEX AND ID EXT ADDR STA CHID֛X FOR COMPLETION CODE * JSB $XSIO DO LOAD OR SWAP I/O CALL CHLU1 NOP DISC LU DEF X0351 COMPLETION ADDR X0355 NOP LINK WORD CHRQ NOP READ/WRITE CTRP DEF CTRIP TRIPLET ADDR CHSPR NOP PRIORITY CHSWP NOP ID ADDR OF PROG, CODE BUSY FLAG * ISZ CRDFL,I JMP X0035 SWAP OUT FLAG = 2, CONTINUE * LDA CFLGS LOAD IN OR SWAP IN IOR CRDFL,I STA CRDFL,I JMP X0005 CONTINUE * * CHEMA NOP CONTENTS OF EMA WORD CHIDX NOP ID EXT ADDRESS * * * * EMA/MOTHER PTTN I/O COMPLETE * X0351 LDA CHRQ SLA,RSS READ? CLB NO, FORCE NO ERROR SSB YES, CHECK READ FOR ERRORS JMP X03AB ERROR, ABORT! * LDA CHEMA DONE LOAD/SWAP OF PROG, SZA,RSS EMA? JMP X0380 NO, DONE NOW * LDB CHSWP ADB D8 LDB B,I GET POINT OF SUSPENSION WORD CCE,SZB,RSS INITIAL LOAD? JMP X0380 YES, SKIP EMA CHUNK MOVES * LDB CHSWP STB CHSW2 SET CHUNK I/O CALL BUSY RBL,ERB SET SIGN BIT FOR $XSIO CALL STB CHSW3 * LDA CHIDX,I GET THE MSEG SIZE AND B37 CMA,INA MAKE IT NEGATINVE INA ADD 1 FOR BP STA B SAVE -MSEGSIZE+1 LDA CHMAT GET THE PHYS. START ADA D3 PAGE OF THIS PARTITION LDA A,I AND B1777 ADB A B HAS S.P.PART-MSEGSIZE+1 LDA CHSWP GET THE PROGS ID ADRS ADA D21 GET #PAGES FROM ID LDA A,I ALF,RAL SHIFT DOWN TO BOTTOM BITS RAL AND B37 ADB A B HAS S.P.PART+#PGS+1-MSEGSIZE STB CHKPG SET STARTPAGE EMA TO START SWAP LDA CHEMA GET EMASIZE TO FIND END OF AND B1777 SWAPPED AREA ADA B STA EMAEN * X0360 LDA SVCUR SAVE CURRENT USER MAP USA  BEFORE MAPPING CHUNK CLA,INA CAX (X) = 1 REGISTER CLB (B) = 0 FOR PAGE# LDA D32 (A) = USER BASE PAGE REGISTER XMS ZAP B.P. SO RTIOC WON'T GET CONFUSED * LDA CHKPG ADA CHKSZ ADD CHUNK SIZE STA CHKNX TO GET START OF NEXT CHUNK CMA,INA ADA EMAEN SSA IS CHUNK PAST END OF EMA? JMP CHKSM YES, ADJUST # PAGES * LDA CHKSZ MAP IN THE CHUNK CHKMP CAX (X) = # PAGES IN CHUNK ALF,ALF RAL,RAL STA TEMP SAVE # WORDS IN CHUNK LDB CHKPG (B) = CHUNK PAGE START LDA CHKRG (A) = REGISTER # XMS * LDB CHMAT JSB PHYBP MAP IN USER'S BP ADA DM32 SAVE CHUNK MAP IN SECOND BP COPY IOR BIT15 USA * LDA CHKAD STA TEMP3 SET UP BEGINNING LOGICAL ADDR OF CHUNK LDA CHTRK STA TEMP1 SET TRACK # FOR SETUP LDA CHSCT STA TEMP2 SET SECTOR # FOR SETUP LDA CTRPA JSB SETUP BUILD TRIPLETS FOR CHUNK STA CTRP2 SET TOP ADDR OF TRIPLETS LDB TEMP1 STB CHTRK SAVE TRACK # FOR NEXT CHUNK, IF ANY LDB TEMP2 STB CHSCT SAVE SECTOR # FOR NEXT CHUNK, IF ANY * JSB $XSIO CHLU2 NOP DEF X0370 COMPLETION ADDR X0366 NOP LINK WORD CHRQ2 NOP READ/WRITE CTRP2 DEF CTRIP TRIPLET ADDR CHSP2 NOP PRIORITY CHSW3 NOP USE CURR USER MAP (ID ADDR + SIGN) * LDA RSCUR RESTORE USER MAP USA JMP X0005 SCHED NEXT PROG OR GO IDLE * * CHSW2 NOP CHUNK I/O BUSY FLAG CFLGS NOP UPPER 13 BITS OF PTTN STATUS WORD CRDFL NOP ADDR OF MAT PTTN STATUS WORD CHKPG NOP PAGE NUMBER OF CURRENT EMA CHUNK CHKNX NOP NEXT CHUNK PAGE NUMBER EMAEN NOP END OF EMA CHTRK NOP TRACK CHSCT NOP SECTOR EMASsNLH NOP EMAL NOP CHMAT NOP MAT ADDR OF PROG D28 DEC 28 DM32 DEC -32 BIT15 OCT 100000 SVCUR DEF CURMP,I RSCUR DEF CURMP CURMP BSS 32 * * AN EMA CHUNK IS FROM LOGICAL PAGE 1 THRU PAGE 31 IN USER MAP * SO THAT LOGICAL PAGE 0 IS NOT USED. THE REASON IS THAT WE * WILL NOT HAVE TO RELOAD THE BASE PAGE FENCE TO PREVENT THE * SYSTEM COMMUNICATION AREA FROM SHOWING THROUGH THE TOP PART * OF THE USER BASE PAGE. IT IS NO BIG LOSS TO MAP JUST ONE * PAGE LESS! CHKSZ NOP CHUNK SIZE CHKRG NOP REGISTER NUMBER OF CHUNK IN USER MAP CHKAD NOP LOGICAL ADDR OF CHUNK * * CHKSM LDA CHKPG GET SIZE OF CHUNK FROM HERE CMA,INA TO END OF EMA ADA EMAEN LDB EMAEN STB CHKNX THERE IS NO NEXT CHUNK JMP CHKMP * * X0370 LDA CHRQ SLA,RSS READ? CLB NO, FORCE NO ERROR SSB YES, CHECK READ FOR ERROR JMP X03AB ERROR, ABORT! * LDA CHKNX STA CHKPG 6N CMA,INA INSTEAD OF COMPARE, ADA EMAEN SUBTRACT TO SEE IF DONE SZA IF CHKNX = EMAEN THEN DONE JMP X0360 NO, NOT DONE YET * X0380 ISZ CRDFL,I FLAG =1 LOAD DONE, =3 SWAP DONE LDA CFLGS IOR CRDFL,I STA CRDFL,I LDB CHSWP CLA STA CHSWP STA CHSW2 LDA CHRQ ISZ $LIST SLA,RSS WAS IT SWAP OUT? JMP X0385 YES, CHECK IF NEED TO START SUBPTTN SWAPOUT * JSB $LIST NO, IT WAS LOAD OCT 401 SCHEDULE THE PROG SZA,RSS SCHEDULE ERROR? JMP X0385 NO, OK. CHECK SUBPTTN SWAPOUT * X03AB LDA CHSWP GET ID SEG ADDR OF PROG JSB $ABRT AND ABORT IT * X0385 LDA SUBFL ANY SUBPTTNS NEED TO SWAP OUT? SZA JMP SUBSS YES, START/CONTINUE SUBPTTN SWAP OUT JMP $XCQ NO, GO CHECK SCHEDULE/ABORT LISTS * SKP DREL NOP ROUTINE TO RELEASE DISC SWAP TRK STB TEMP3 ADB D27 COMPUTE ID SEGMENT SWAP ADDRESS LDA B,I CCE,SZA,RSS SWAPPED, SO GO TO RELEASE JMP DREL,I NOT, SWAPPED, SO RETURN STA TEMP SAVE LU/TRK/#TRK AND B177 STA TEMP2 ISOLATE # TRACKS TO RELEASE CLA CLEAR ID SEGMENT STA B,I SWAP VALUE LDA TEMP ALF,ALF RAL AND B377 LDB TEMP SSB ADA TATSD L. U. 3 SO ADD # SYS TRACKS STA TEMP1 LDB TEMP2 (B) TO # OF TRACKS TO REL JSB $DREL CALL DISC TRACK RELEASE PROCESOR LDB TEMP3 ADB D28 LDA B,I JSB IDXAD GET ID EXT ADDR JMP DREL,I NOT EMA, EXIT ADA D2 LDA A,I GET # EMA SWAP TRACKS AND B1777 FROM WORD 2 SZA,RSS IF NO TRACKS JMP DREL,I DON'T RELEASE * STA B (B)=#TRACKS TO RELEASE LDA TEMP1 TRACK ADDR OF PROG + #TRACKS ADA 4TEMP2 = BEGIN TRACK OF EMA JSB $DREL RELEASE THE TRACKS JMP DREL,I RETURN HED DISP4 -- SWAP CHECK ROUTINE. CAN AND SHOULD WE SWAP? * SWPCK CHECKS TO SEE IF AN AREA SHOULD BE SWAPPED, * IT CHECKS: * 1. IF A SWAP OUT IS UNDER WAY (IF SO FORGET IT) * 2. IF THE BASE PAGE SWAP FLAG FOR THE AREA ALLOWS SWAPPING. * 3. IF THE RESIDENT PROGRAM HAS INHIBITED SWAPPING. * 4. IF THE RESIDENT PROGRAM IS SCHEDULED AND HAS HIGHER * OR EQUAL PRIORITY. * 5. IF THE RESIDENT IS DORMANT BUT HAS PRIORITY AND IS IN * THE TIME LIST AND ITS TIME IS "NEAR". * 6. IF THE RESIDENT IS I/O SUSPENDED * WITH THE BUFFER IN HIS AREA. * * ALL OF THE ABOVE CONDITIONS INHIBIT A SWAP. ( JMP X0035 ). * THE FOLLOWING CONDITIONS CAUSE THE INDICATED ACTIONS. * * 7. THE RESIDENT IS BEING READ IN BUT DOES NOT HAVE PRIORITY * CAUSES AN ABORT (I.E. STOP THE READ) RETURN. * 8. THE RESIDENT HAS NOT BEEN EXECUTED SINCE IT WAS LAST * LOADED FROM THE DISC CAUSES A READ RETURN (I.E. ASSUME * THE RESIDENT CAN BE RELOADED WHEN NEEDED) * * CALLING SEQUENCE: * * ALL THE MAT PTRS ARE SET UP BY EITHER MATEN OR MATAD * MRDFL,I = THE READ IN FLAG 0=READING, 1 = INCORE, 2 =SWAPPING OUT OR * SEGMENT LOAD, 3 = INCORE AND SWAPPED OUT. * (B)= THE RESIDENTS ID-SEGMENT ADDRESS * (E)= 0 NORMAL SWAP CHECK CALL * 1 SUBPARTITION SWAP CHECK CALL * JSB SWPCK * JMP ABORT ABORT (I.E. STOP LOAD) RETURN (A=B=E=0). * JMP SWP SWAP OUT RETURN * JMP LOAD LOAD RETURN * JMP NOSWP CAN'T SWAP RETURN, ONLY SUBPTTN CHECK (E=1) * * THE FOLLOW TEMP AREAS ARE USED IN SWPCK: * RINF EQU TEMP READ IN FLAG SAVE LOCATION RBUFA EQU TEMP1 ADDRESS OF CONWRD THEN BUFFER ADDRESS RPRIO EQU TEMP2 ADDRESS OF RESIDENTS PRIORITY RSUSP EQU TEMP3 ADDRESS OF RESIDȦENTS SUSP RTIML EQU TEMP4 ADDRESS OF RESIDENTS T BIT. RTIME EQU TEMP5 ADDRESS OF RESIDENTS TIME. RSWTR EQU TEMP6 ADDRESS OF RESIDENTS SMAN. SKP SWPCK NOP LDA MRDFL,I GET CURRENT PTTN STATUS AND B7 CPA D3 IF CURRENT IS SWAPPED OUT JMP SWPC4 GO MAKE LOAD RETURN * RAL,ERA PUT (E) INTO SIGN OF RINF STA RINF SAVE THE READ IN FLAG RAR,SLA IF SWAPPING OR LOADING A SEGMENT JMP X0N35 FORGET THE SWAP, TRY NEXT PTTN * INB INDEX TO THE I/O CONWRD ADDRESS STB RBUFA SAVE IT ADB D5 INDEX TO THE PRIORITY ADDRESS STB RPRIO SAVE IT ADB D2 INDEX TO THE SUSPENSION ADDRESS STB RSUSP SAVE IT ADB D6 INDEX TO THE TYPE/CORE LOCK BIT ADDRESS LDA B,I GET THE WORD AND B100 ISOLATE THE CORE LOCK BIT SZA IF SET JMP X0N35 FORGET THIS PTTN, TRY NEXT PTTN * INB INDEX TO THE STATUS LDA B,I GET STATUS TO A AND D15 ISOLATE THE STATUS ADB D2 INDEX TO THE TIME LIST ADDRESS STB RTIML SAVE IT INB INDEX TO THE TIME ADDRESS STB RTIME SAVE IT ADB D9 INDEX TO THE SWAP TRACK ADDRESS STB RSWTR AND SAVE IT * LDB RPRIO,I GET THE PRIORITY CMB,CLE,INB SUBTRACT ADB ZPRIO,I SET E IF RES. WINS PRIORITY TEST LDB RINF GET THE READ FLAG BLR,BRS CLEAR BITS 14,15 DON'T CHANGE (E) CPA D2 IF I/O SUSPENDED JMP SWPC3 GO DO I/O SUSP. CHECKS * SEZ,RSS IF THE CONTENDER HAS PRIORITY JMP SWPC1 GO CHECK IF SWAP IS NEEDED * CPA D1 IF RESIDENT IS SCHEDULED JMP X0N35 FORGET THIS PTTN, TRY NEXT PTTN * LDB RTIML,I GET THE TIME LIST BIT BLF,SLB IF IN TIME LIST CLE,SZA AND DORMANT JMP SWPC1 NO SO GO CHECK IF SWAP IS NEEDED * DLD $TIME GET THE SYSTEM TIME DIV BTRIP !! DIVIDE BY ZERO TO SET POS. !! BTRPA EQU *-1 DEF TO BTRIP ADA RTIME,I SUBTRACT THE ID-SEG TIME VALUE SEZ,CLE IF OVERFLOW INB STEP B ISZ RTIME STEP TO NEXT TIME WORD ADB RTIME,I ADD THE HIGH WORD ADA SWPTM ADD THE NEG. OF # OF TICKS SYS WILL WAIT. SEZ,SZB,RSS IF HIGH VALUE IS ZERO AND SSA,RSS THE DIFF < LIMIT JMP SWPC1 * CPB SWPTM & LIMIT NOT = 0 RSS JMP X0N35 FORGET THE SWAP, TRY NEXT PTTN * SWPC1 LDA RSUSP,I SWAP IN ORDER TEST IF THE RESIDENT LDB RSWTR,I WAS RUN SINCE LAST LOAD CLE,SZB,RSS IF SWAP TRACKS STILL ASSIGNED OR SZA,RSS POINT OF SUSP IS ZERO SWPC4 ISZ SWPCK THEN JUST READ SWPC2 ISZ SWPCK ELSE SET SWAP RETURN (E=0) JMP SWPCK,I EASY ISN'T IT? SPC 1 SWPC3 CLA E = 0 IF HE HAS PRIORITY SEZ,SZB,RSS IF READING IN AND PRIORITY JMP SWPCK,I RETURN P+1 WITH A = 0 (ABORT) * SZB,RSS IF READING IN BUT NOT PRIORITY JMP X0N35 FORGET THIS PTTN, TRY NEXT PTTN * * THE FOLLOWING CODE WILL ALLOW THE SWAPPING OF * PROGRAMS SUSPENDED FOR UNBUFFERED I/O REQUESTS. * * LDA RBUFA,I GET CONWRD. * RAR IF IT IS A * SSA,SLA CONTROL REQUEST * JMP SWPC2 THEN ALLOW SWAP. * * IF UNBUFFERED CONTROL DONT SWAP * LDA RBUFA,I GET COMMAND AND D3 IF CONTROL CPA D3 JMP X0N35 DONT SWAP * ISZ RBUFA ELSE INCREMENT TO THE BUFFER ADDRESS. LDA RBUFA,I GET BUFFER ADR CLE,SSA IS IT A RE-ENT BUFFER JMP SWPC2 YES CAN SWAP * LDA RBUFA ADA D20 INDEX TO LOW MAIN LDA A,I CMA,CLE,INA SUBTRACT FROM BUFF ADDR ADA RBUFA,I IF BUFF ADDR IS BELOW LOW MAIN  SEZ,RSS THEN IT IS IN COMMON, SWAP OK. JMP SWPC2 (E=0) SWAP RETURN * * X0N35 - GET HERE IF SWPCK TRIED TO DISPATCH A PROGRAM * IN A PARTITION BUT FOUND THAT IT WAS NO SWAPPABLE * AT THE TIME (IF EVER). IF THE PROGRAM TO BE * DISPATCHED DOES NOT REQUIRE A SPECIFIC PARTITION * NUMBER, THEN A SWAP WILL BE TRIED ON THE NEXT * PARTITION IN THE ALLOCATED LIST. * X0N35 LDA RINF SSA,RSS DOING SPECIAL SUBPTTN CHECK? JMP X0N36 NO * ISZ SWPCK YES, RETURN NOSWP CONDITION JMP SWPC4 * X0N36 LDA ZMPID,I WAS SPECIFIC PTTN ASSIGNED FOR SSA PROGRAM TRYING TO DISPATCH? JMP X0035 YES, CAN'T USE ANOTHER PTTN. JMP SCHL2 NO, TRY NEXT PTTN IN LIST, IF ANY LEFT * SPC 1 SWPTM DEC -15 MAX WAIT IS 150 MS. D9 DEC 9 HED DISP4 -- PRELIMINARY SETUP FOR DISK CALL * PREST SETS UP FOR A DISC LOAD OR SWAP AS FOLLOWS: * * 1. SETS MEMORY BOUNDS FOR THE PROGRAM * TEMP = #WORDS IN MAIN * TEMP3 = FIRST WORD OF MAIN * TMP = #WORDS IN BASE PAGE * TMP1 = FIRST WORD OF BASE PAGE * * 2. IF SWAP, GET SWAP TRACKS IF REQUIRED * AND SETS SMAN IN THE ID-SEGMENT. * * 3. SETS THE INITIAL DISC ADDRESS * TEMP1 = TRACK ADDRESS * TEMP2 = SECTOR ADDRESS * B = LU OF DISC * * 4. SETS THE NUMBER OF SECTORS: * CN#SC = -NUMBER OF SECTORS/TRACK * * 5. CALLS SETUP TO BUILD THE TRIPLET FOR THE LOAD * * PREST CHECKS THE FOLLOWING OPTIONS: * * 1. SHORT ID-SEGMENT (BG-SEGMENT LOAD) * 2. THE "ALL OF CORE" BIT CAUSES THE WHOLE AREA * TO BE SWAPPED ALONG WITH ALL OF THE AREA * BASE PAGE. * 3. IF SWAP THEN THE FIRST WORD IS ALWAYS THE AREA * BOUNDRY. * 4. IF SWAP AND NO TRACK ASSIGN;ED THEN SWAP TRACKS * ARE ALLOCATED. * * CALLING SEQUENCE: * * PREST ASSUMES -BGLWA- AND -AVMEM- ARE SET UP FOR PROG TO BE SWAPPED * B = ID-SEGMENT ADDRESS * E = 1 FOR LOAD * E = 0 FOR SWAP OUT * A = BOTTOM OF TRIPLET TABLE * JSB PREST * * ON RETURN: * * B = DISC LU * A = DEF OF TRIPLET TABLE FOR XSIO CALL * * ABNORMAL EXIT * * A JMP IS MADE TO X0035 IF NO DISC TRACKS ARE AVAILABLE * FOR SWAPPING. * * INTERNAL TEMP AREA USAGE: * TEMP4 - TRIPLET QUE ADDRESS * TEMP5 - PROGRAM TYPE WORD * TEMP6 - MEMORY ADDRESS POINTER TO ID-SEGMENT. * TMP2 - DISC ADDRESS POINTER TO ID-SEGMENT. SKP PREST NOP STA TEMP4 SAVE THE TRIPLET QUE ADDRESS CLA SET THE START SECTOR STA TEMP2 ADDRESS FOR SWAP OPTION CPB XEQT IF CURRENT EXECUTING STA XEQT PROGRAM CLEAR THE FLAG ADB D14 INDEX TO TYPE WORD LDA B,I GET PROGRAM TYPE TO A STA TEMP5 SAVE IT ALF,ALF ROTATE THE SHORT ID-SEG. BIT ALF,SLA,RAR TO ZERO AND TEST INB,RSS ADB D8 INDEX TO MEMORY ADDRESSES STB TEMP6 SAVE THE MEMORY ADDRESS ADB D4 INDEX TO THE DISC ADDRESS STB TMP2 AND SAVE IT SSA IF SHORT ID-SEG. JMP SEGCK GO CHECK SEGMENT LIMITS ALF,RAL AND D15 CPA D5 IF TYPE 5 JMP SEGCK GO CHECK SEGMENT LIMITS * ******************************************* **E=0IF SWAP,B=0 IF FIRST LOAD******* ******************************************* * SEZ,INB STEP TO SWAP DISC ADDRESS LDB B,I GET SWAP ADDRESS (SKIPPED IF SWAP) CMB,CLE,INB,SZB IF SWAP TRACK OR SWAPPING ISZ TMP2 STEP THE DISC ADDRESS TO SMAN. PRES1 LDB TEMP6,I GET THE ID-SEG LOW MAIN ADD. ISZ TEMP6 STEP THE MEMORY ADDRESS TO HIGH MAIN STB TEMP3 CMB,INB NEGATE SEZ IF FIRST LOAD JMP PRES2 GO SET UP TRUE TO ID-SEG. * LDA TMP2 INA LDA A,I STA ZIDX0 JSB IDXAD GET ID EXT ADDR JMP PRES6 NOT EMA, ZIDX0=0 STA ZIDX0 SAVE ID EXT ADDR INA LDA A,I RAR AND B76K ADB A JMP PRES5 MAKE SURE (A)#0 * PRES6 LDA TEMP5 AND B17 CPA D2 JMP PRES3 GO SET FORGROUND BOUNDS * ADB BGLWA ELSE LAST WORD OF MEM INB PLUS ONE. CCA (A) = -1 SWAP ALL OF PTTN PRES5 STB TEMP SET #WORDS IN MAIN ISZ TEMP6 STEP TO LOW BASE PAGE LDB TEMP6,I GET LOW BP STB TMP1 AND SET IT ISZ TEMP6 STEP TO HIGH BASE PAGE CMB,INB SZA INITIAL LOAD? JMP PRES9 NO, USE ALL OF POSSIBLE BP (A#0) * ADB TEMP6,I YES, USE ACTUAL HIGH BP BOUND (A=0) RSS PRES9 ADB BPA2 STB TMP SET BASE PAGE SIZE CMA,CLE,INA SET E IF FIRST LOAD LDA TMP2,I GET THE DISC ADDRESS SZA IF NONE SKIP JMP PRES7 DISC DEFINED GO SET UP * * GET SWAP TRACKS * LDA B GET BASE PAGE SIZE ADA B177 FORCE SIZE UP TO NEXT SECTOR AND C177 TRUNCATE TO EVEN SECTOR STA TMP SAVE LDA TEMP WHILE CHECK MAIN SIZE ADA B177 FORCE SIZE UP TO NEXT SECTOR AND C177 TRUNCATE TO EVEN SECTOR STA TEMP SAVE MAIN SIZE FOR SETUP ADA TMP ADD IF ANY ROUNDED UP FROM BP ALF,ALF DIVIDE BY 128 WORDS RAL TO GET #SECTORS STA PRSCT CLB DIV #SCT DIVIDE BY MIN #SECTORS/TRACK SZB IF REMAINDER INA BUMP STA SETUP SET #TRACKS IN SMAN * LDB TMP2 INB INCRE TO EMA WORD LDA B,I }W SZA EMA PROG? JMP PRESA YES, ADD EMA TRACK NEEDS * STA EMTRK NO, JUST SWAP PROG LDA SETUP JMP PRESB * PRESA AND B1777 GET EMA SIZE (IN PAGES) ALF,RAR MULT BY 8 TO GET #SECTORS ADA PRSCT ADD #SECTORS NEEDED FOR PROG CLB DIV #SCT DIVIDE BY #SECTORS/TRACK SZB TO GET # OF TRACKS INA BUMP #TRACKS IF ANY OVERFLOWED LDB SETUP CMB,INB SUBTRACT #TRACKS FOR PROG ADB A FROM TOTAL #TRACKS STB EMTRK FOR #TRACKS IN EMA * PRESB CLB GO TO SYS TO GET TRACKS JSB $DREQ ERB,SLB SET LEAST LU BIT IN E SKIP IF NONE ALF,SLA,ALF ROTATE TRACK SKIP ALWAYS JMP X0035 NO TRACKS EXIT TO SWITCHER * ERA,CLE SET LU BIT IN TRACK WORD IOR SETUP ADD THE # TRACKS STA TMP2,I AND SET BACK IN ID-SEG * LDB ZIDX0 (A)=SWAP WORD, (E)=0 SZB,RSS EMA PROG? JMP PRES7 NO * STA SETUP SAVE (A) TEMPORARILY ADB D2 INDEX TO EMA SWAP TRACKS WORD LDA EMTRK STA B,I SET #EMA SWAP TRACKS LDA SETUP RESTORE (A) * * DECODE TRACK/SECTOR ADDRESS IN A * PRES7 AND B177 MASK OUT THE SECTOR/#TRACKS CLB,SEZ,INB SET B TO 1,SKIP IF SWAP STA TEMP2 SET SECTOR ADDRESS XOR TMP2,I GET THE TRACK/LU ASL 1 SET LU IN B/TRACK IN HIGH A ALF,ALF BRING DOWN THE TRACK STA TEMP1 SET THE TRACK ADDRESS LDA SECT2 GET THE SECTOR SIZE FOR LU 2 SLB IF LU IS 3 LDA SECT3 USE 3'S NUMBER CMA,INA SET NEGATIVE STA CN#SC NUMBER OF SECTORS/TRACK * * NOW CALL SETUP TO BUILD THE TRIPLETS * STB TEMP6 SET LU IN A SAFE PLACE LDA TEMP4 GET THE TRIPLET ADDRESS JSB SETUP SET UP THE MAIN LDB TMP STB TEMP SET UP FOR THE LDB TMP1 BASE PAGE STB TEMP3 AND JSB SETUP GO BUILD IT'S TRIPLETS LDB TEMP6 RESTORE THE LU TO B JMP PREST,I NOW THAT WASN'T HARD WAS IT? SPC 2 PRES2 CLA (A) = 0 TO USE REAL BOUNDS ADB TEMP6,I JMP PRES5 * PRES3 ADB AVMEM USE WHOLE AREA JMP PRES5 GO SET IN TEMP SPC 2 SEGCK LDB FENCE IS IT BELOW THE FENCE CMB,INB ADB TEMP6,I LOW MAIN(SEGMENT) SSB JMP SEGER YES GO ABORT * LDB TEMP6 INB LDB B,I GET HIGH MAIN(SEGMENT) CMB,INB ADB BGLWA DOES IT FIT IN PART'N INB CCE,SSB,RSS SET E FOR OK COND'N JMP PRES1 IT WILL FIT * SEGER LDB D8 IT WONT FIT JMP $SCXX GO PRINT SC08 AND ABORT * C177 OCT 177600 #SCT NOP EMTRK NOP PRSCT NOP HED DISP4 -- DISK CALLING SEQUENCE GENERATOR * * DISK READ/WRITE CALLING SEQUENCE GENERATOR ROUTINE * ON ENTRY * TEMP = NUMBER OF WORDS * TEMP1 = TRACK ADDRESS * TEMP2 = SECTOR ADDRESS * TEMP3 = STARTING MEMORY ADDRESS * A = PARAMETER TABLE ADDRESS * * THE DISC PARAMETER GENERATOR FUNCTION IS TO GENERATE * * PARAMETERS FOR DISC CALL GUARANTEEING THAT ALL * * TRACK CROSSING CALLS ARE BROKEN DOWN INTO SUB-CALLS * * SUCH THAT THE DISC DRIVER CAN HANDLE THE REQUEST. * * THE CALLS ARE BROKEN UP IN TRIPLETS OF * * STARTING CORE MEMORY ADDRESS * * NUMBER OF WORDS TO TRANSFER * * STARTING TRACK/SECTOR ADDRESS. * * THE END OF CALL IS INDICATED BY A ZERO FOLLOWING * * THE LAST TRIPLET. * * * SETUP NOP r ENTRY/EXIT LDB TEMP COMPUTE NUMBER OF SECTORS SETU1 SZB,RSS ZERO, SO RETURN JMP SETUP,I ADA DM3 SET UP TRIPLET STA DSTAD ADDRESS ADB B177 ROUND UP NUMBER ASR 7 OF SECTORS BLS STB TEMP5 SAVE NUMBER OF SECTORS LDA TEMP2 INITIAL SECTOR ADDRESS ADA B ADA CN#SC SUB CURRENT # SECTORS/TRACK LDB TEMP3 STB DSTAD,I STORE STARTING MEMORY ADDRESS ISZ DSTAD INCREMENT ARRAY ADDRESS CMA,CLE,INA,SZA CLE,SSA,RSS CHECK IF TRACK OVERFLOW JMP SETI0 NO, SO LAST TRIPLET ADA TEMP5 YES, USE REST OF TRACK IF OVER. ASL 6 UPSET LDB TEMP1 FORM BLF,RBL TRACK RBL,RBL ADDRESS ADB TEMP2 AND SECTOR ADDRESS DST DSTAD,I STORE LAST TWO WORDS OF TRIPLET DSTAD EQU *-1 ADA TEMP3 UPDATE STARTING STA TEMP3 MEMORY ADDRESS LDB TEMP2 INCREMENT SECTOR ADDRESS ADB TEMP5 TO START SECTOR FOR SEZ CHECK IF NEW TRACK CLB,RSS RSS NOT NEW TRACK SO SKIP ISZ TEMP1 YES, SO INCREMENT TRACK ADDRESS STB TEMP2 RESET SECTOR LDB DSTAD,I UPDATE NUMBER CMB,INB OF ADB TEMP WORDS STB TEMP TO GO CCA SUB 1 FOR CORRECT NEXT TRIPLET ADA DSTAD ADDRESS CALC. JMP SETU1 GO TO NEXT LOOP SPC 1 SETI0 LDA TEMP SET FOR LAST JMP UPSET TRIPLET HED DISP4 -- READ SETUP * * SETUP TO READ IN BACKGROUND DISK RESIDENT PROGRAM * OR BACKGROUND DISK RESIDENT SEGMENTS * $BRED EQU * $SGLD NOP ENTRY/EXIT CLA CPA SGSWP SEGMENT LOAD CALL BUSY? JMP SGLD1 NO, SO DO SEGMENT LOAD * LDB XEQT YES, SEGMENT LOAD CALL BUSY STA XEQT CLEAR CURRENT EXECUTING PROG STB SGSUP AND SET IT SEGMENT SUSP\ENDED JMP X0035 TRY NEXT SCHEDULED PROG * SGLD1 LDA D2 IOR MFLGS SET READ IN WAIT FLAG STA MRDFL,I PTTN STATUS =2 LOAD SEG CLA,CCE,INA (E=1) FOR PREST TO LOAD STA SGRQ SET READ REQUEST LDA MPRIO,I STA SGPR SET PRIORITY LDA STRPA JSB PREST STB SGLU SET LU STA STRP SET TRIPLETS ADDR LDA MID,I AFTER PREST CALL RETURNS STA SGSWP SET SEGMENT I/O CALL BUSY LDA MRDFL STA SRDFL SAVE FLAG WORD ADDR LDA MFLGS STA SFLGS SAVE HIGH BITS * JSB $XSIO SGLU NOP LOGICAL UNIT DEF X0422 COMPLETION ADDR X0455 NOP LINK WORD SGRQ OCT 1 REQUEST CODE STRP DEF STRIP TRIPLETS ARRAY ADDR SGPR NOP PRIORITY SGSWP NOP ID SEGMENT ADDR LDB MID,I JSB $LIST SUSPEND SEGMENT UNTIL DONE OCT 402 JMP $SGLD,I RETURN, SEGMENT LOAD INITIATED * * SRDFL NOP SFLGS NOP STRPA DEF STRIP SGSUP NOP * * * SEGMENT LOAD COMPLETION SECTION * X0422 STB TEMP SAVE COMPLETION STATUS LDB SFLGS INB STB SRDFL,I FORCE PTTN STATUS=1 LDB SGSWP CLA STA SGSWP CLEAR BUSY FLAG STA SGSUP CLEAR SEGMENT SUSPEND FLAG LDA SGRQ JMP X0125 DO OTHER COMPLETION STUFF * HED DISP4 -- SYSTEM START UP ******************************************************************** * THE START SECTION: * * CLEARS INTERRUPT SYSTEM * * SETS FENCE REGISTER TO 0 * * CLEARS XEQT * * SCHEDULES 'FMGR' IF PRESENT * STARTS THE CLOCK BY CALLING $SCLK IN RTIME MODULE * THIS SECTION IS EXECUTED ONCE - IT IS OVERLAYED ******************************************************l************** * $ZZZZ NOP * STB DFMG SET THE NAME ADDRESS CLC 0 CLEAR INTERRUPT SYSTEM JSB MPINT GO DO MAP STUFF LDA SWAP SET UP THE SWAP DELAY ALF,ALF AND B377 CMA,INA SET NEGATIVE STA SWPTM SET THE VALUE * LDA SECT2 FIND MINIMUM # SECTORS/TRACK LDB SECT3 SUBTRACT # FOR LU 3 CMB,INB,SZB FROM # FOR LU 2. ADB SECT2 IF POSITIVE RESULT, CMB,SSB,INB,SZB LU 3 IS SMALLER. LDA SECT3 OTHERWISE, USE LU 3 ARS CONVERT 64 WORD SECTORS STA #SCT TO 128 WORD SECTORS LDA SKEDD SAVE THE CURRENT STA ZWORK SCHEDULE POINTER SPC 1 JSB $LIST SCHEDULE 'FMGR' PROGRAM OCT 201 IF IT IS IN THE SYSTEM. DFMG DEF * SZA JMP ZEXIT NO - BTRIP NOP END OF BG TRIPLETS CHKBG EQU BTRIP-$ZZZZ-21 INSURE AT LEAST 7 TRIPLETS LDA SKEDD LDB A,I INSURE 'FMGR' IS CPB ZWORK FIRST IN THE SWP SCHEDULED LIST. STB SKEDD STA B,I CLB STB A,I LDA SKEDD GET THE FMGR ID-SEG ADDRESS INA AND LDB TATLG INHIBIT ALL TRACK STB A,I ALLOCATIONS UNTIL CCB 'FMGR' EXECUTES. STB TATLG 'FMGR' UNDOES THIS SPC 1 JMP ZTYPE * FNMP OCT 2000 B1740 OCT 1740 * ********MAP INITIALIZATION************** ******* MPINT NOP LDA $MPFT ADA D4 LDA A,I GET START OF SSGA ADA DM1 STA $SGAF RTRIP NOP END OF RT TRIPLETS CHKRT EQU RTRIP-BTRIP-21 INSURE AT LEAST 7 TRIPLETS * LDA $DVPT SET UP LOGICAL ADDR ALF,ALF IN DRIVER PARTITION FOR RAL,RAL ACCESSING USER'S BP COPY IOR B1740 OF USER MAP STA ADBPC * LDA $MPFT INA LDA A,I GET START OF MEM RES LIB AND B76K ALPNLHF RAL,RAL STA B LDA LBORG AND B76K ALF RAL,RAL STA LBREG LIB PAGE REGISTER START CMA,INA ADA B STA LB#PG NUMBER OF PAGES IN LIB LDA $MRMP ADA LBREG LDA A,I STRIP NOP END OF SEGMENT TRIPLETS CHKSG EQU STRIP-RTRIP-21 INSURE AT LEAST 7 TRIPLETS AND B1777 STA LBPG# LDA LBREG ADA B40 STA LBREG * LDA $CMST USE AREA FROM START OF COMMON CMA,INA TO THE END OF USER MAP ADA D32 FOR DOING I/O ON CHUNKS OF STA CHKSZ EMA TO BE SWAPPED LDA $CMST ADA D32 STA CHKRG STARTING REG# IN USER MAP LDA $CMST ALF,ALF RAL,RAL STA CHKAD SAVE LOGICAL ADDR * LDA $MRMP GET ADDRESS MEM RES MAP USA LOAD USER MAP CLA XMA SET DMA1 FROM SYS MAP INA XMA SET DMA2 FROM SYS MAP LDA BPA2 GET LAST USER LINK INA INCREASE TO FIRST SYSTEM LINK IOR FNMP SET BIT 10 TO SHOW LOWER MAPPED LFA SET FENCE FOR BP JSB LSTIN INITIALIZE PTTN LIST PTRS JMP MPINT,I * CTRIP NOP END OF MOTHER PTTN TRIPLETS CHKCH EQU CTRIP-STRIP-21 INSURE AT LEAST 7 TRIPLETS CTRPA DEF CTRIP HED DISP4 -- ** SYSTEM BASE PAGE COMMUNICATION AREA ** * * *** SYSTEM BASE PAGE COMMUNICATION AREA *** * XIDEX EQU 1645B ADDR OF CURR ID SEG EXT XMATA EQU 1646B ADDR OF CURR MAT ENTRY XI EQU 1647B . EQU 1650B ESTABLISH ORIGIN OF AREA * * SYSTEM TABLE DEFINITION * INTBA EQU 1654B )NSKEDD EQU 1711B * * * DEFINITION OF EXECUTING PROGRAM ID SEGMENT' * * XEQT EQU .+39 ID SEGMENT ADDR. OF CURRENT PROG. XLINK EQU .+40 'LINKAGE' XPRIO EQU .+46 'PRIORITY' WORD XPENT EQU .+47 'PRIMARY ENTRY POINT' XSUSP EQU .+48 'POINT OF SUSPENSION' XA EQU .+49 'A REGISTER' AT SUSPENSION XB EQU .+50 'B REGISTER' XEO EQU .+51 'E AND OVERFLOW SWAP EQU 1736B * * DEFINITION OF MEMORY ALLOCATION BASES * * BPA2 EQU .+59 LWA R/T DISC RES. BP LINK AREA LBORG EQU .+61 FWA OF RESIDENT LIBRARY AREA RTDRA EQU .+64 FWA OF R/T DISC RESIDENT AREA AVMEM EQU .+65 FWA OF SYSTEM AVAILABLE MEMORY BGDRA EQU .+68 FWA OF BGG DISC RESIDENT AREA * * UTILITY PARAMETERS * TATLG EQU .+69 LENGTH OF TRACK ASSIGNMENT TABLE TATSD EQU .+70 # OF TRACKS ON SYSTEM DISC SECT2 EQU .+71 # SECTORS/TRACK ON LU 2 (SYSTEM) SECT3 EQU .+72 # SECTORS/TRACK ON LU 3 (AUX.) * FENCE EQU .+85 MEM PROTECT FENCE ADDRESS * BGLWA EQU .+87 LWA OF MEMORY IN BACKGROUND * A EQU 0B LOCATION OF A REGISTER B EQU 1B LOCATION OF B REGISTER ORG * PROGRAM LENGTH ORIGINALLY 2716 (8) ? EQU *-2716B END $ZZZZ  K 92067-18016 1805 S C0122 &RTIM4 RTE-IV TIME PROCESSOR             H0101 @ ASMB,R,L,C ** RT TIME MODULE ** HED REAL TIME TIME MODULE * NAME: RTIME * SOURCE: 92067-18016 * RELOC: PART OF 92067-16014 * PGMR: G.A.A.,C.M.M * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM RTIME,0 92067-16014 REV.1805 780104 * SUP ******************************************************************** * * ***** AMD ***** JUL,73 * * ******************************************************************** * * RTIME ENTRY POINT NAMES * ENT $TADD,$CLCK,$TREM,$TIMV ENT $ETTM,$TIMR,$ONTM,$TMRQ,$SCLK * * RTIME EXTERNAL REFERENCE NAMES * EXT $INER,$DEVT,$LIST,$XEQ EXT $ERMG,$MSEX,$SYMG,$IDSM EXT $WORK,$BATM,$TIME * ******************************************************************** * * THE RTIME MODULE OF HP2100 REAL TIME EXECUTIVE CONSISTS OF * * * 1. TIME PROCESSOR ROUTINES * * 2. CLOCK START UP ROUTINE. * * ******************************************************************** HED REAL TIME CLOCK-TIME LIST PROCESSING ******************************************************************** * THE REAL TIME CLOCK PROCESSOR SECTION OF HP-2100 REAL TIME* * EXECUTIVE HANDLES ALL TIME DEPENDENT FUNCTIONS: * * 1. INCREMENT REAL TIME CLOCK VALUES EVERY 10 MILLISECOND. * * 2. SCHEDULE PROGRAMS AT THE REQUESTED TIME AND COMPUTE ITS* * NEXT START TIME. * * 3. ADD PROGRAMS TO THE TIME LIST. * * 4. REMOVE PROGRAMS FROM8 THE TIME LIST. * * 5. OUTPUT CURRENT SYSTEM TIME TO USER ARRAY. * * 6. SET ID SEGMENT VALUES AS REQUESTED BY USER. * ******************************************************************** SPC 1 * THE $CLCK ROUTINE FUNCTIONS AS FOLLOWS: * * THE ROUTINE IS ENTERED EVERY 10 MILLISECOND DUE * * TO TIME BASE GENERATOR INTERRUPTS. * * THE TIME VALUE IS INCREMENTED BY 10 MILLISECONDS. * * THE TIME VALUES OF EACH PROGRAM IN TIME LIST IS * * COMPARED TO THE CURRENT TIME. IF THE TIMES * * COMPARE AND THE PROGRAM IS DORMANT, A SCHEDULE * * REQUEST IS MADE VIA LIST PROCESSOR. REGARDLESS * * OF PROGRAM STATUS, THE NEXT START TIME IS * * COMPUTED UNLESS THE MULTIPLE VALUE IS ZERO- * * WHICH MEANS THAT THE PROGRAM IS TO BE REMOVED * * FROM TIME LIST. * * THE TIME-OUT CLOCKS FOR ALL ACTIVE DEVICES ARE * UPDATED. IF ANY DEVICE HAS TIMED-OUT, * RTIOC IS ENTERED TO PROCESS THE CONDITION. * * $CLCK ISZ $TIME STEP THE LOW ORDER TIME VALUE JMP CL010 GO TO PROCESS LISTS ISZ $TIME+1 STEP THE HIGH ORDER TIME VALUE JMP CL010 GO TO PROCESS LISTS LDA RS1 RESET THE COUNTER LDB RS2 TO THE FULL STA $TIME DAYS WORTH OF STB $TIME+1 OF TENS OF MS. ISZ $TIME+2 STEP THE DAYS/YEARS COUNTER * * CHECK IF TIME TO SCHEDULE PROGRAM * CL010 LDB TLIST TIME LIST CL011 CLE,SZB,RSS IF THRU PROCESSING IT, GO JMP TOBAT PROCESS BATCH TIME-OUT STB POINT SAVE TIME LINK ADB D2 B NOW PTS TO IDSEG TIME VAULE DLD B,I GET THE SCHEDULE TIME CPA $TIME IF BOTH WORDS MATCH CCE THEN CPB $TIME+1 THE SEZ,RSS TIME IS JMP CH010 JSB TMSCH NOW SO SCHEDULE THE PROG. * * INCREMENT TO NEXT PROGRAM IN LIST * CH010 LDB POINT,I GET ADDR OF NEXT PROG IN LIST JMP CL011 GO TO COMPARE NEXT PROG IN LIST * * IF CURRENT PGM IS BATCH THEN STEP THE TIMER * TOBAT LDB XEQT GET THE BATCH BIT SZB IF NO CURRENT PGM SKIP CPB DD.RT IF CURRENT PGM IS D.RTR DO NO TIME JMP IOTOP BUT GO DO DEVICE TIME OUTS * CPB $IDSM IF SMP JMP IOTOP ADB D20 TO LDA B,I GET THE BATCH FLAG SSA,RSS IF NOT BATCH JMP IOTOP SKIP TEST * ISZ $BATM STEP BATCH TIMER JMP IOTOP IF NO ROLL OVER EXIT * ISZ $BATM+1 ELSE STEP NEXT WORD JMP IOTOP IF NO ROLL OVER SKIP * RAL PUT FATHER BIT IN 15. SSA IF THIS IS A SON JMP ABOR THEN ABORT HIM * RAR RESTORE A IOR B10K SET THE BREAK FLAG STA B,I AND RESET THE WORD JMP IOTOP CONTINUE WITH TIME OUTS * ABOR LDA ATI GET THE TI ABORT MESSAGE LDB BLANK JSB $ERMG GO ABORT HIM * * PROCESS DEVICE TIME-OUT CLOCKS * IOTOP LDA EQT# SET NEGATIVE OF CMA,INA NUMBER OF EQT STA $TIMV ENTRIES FOR INDEX LDA EQTA POINT TO WORD 15 IOTO2 ADA D14 OF FIRST EQT ENTRY LDB A,I LOAD WORKING CLOCK- SZB IS IT ACTIVE? ISZ A,I YES: INCREMENT IT INA,RSS IT HAS NOT TIMED-OUT JMP $DEVT GO TO TIME-OUT PROCESSOR ISZ $TIMV THRU? JMP IOTO2 NO: GO DO NEXT ONE JMP $XEQ YES; NO TIME-OUTS-RETURN SPC 1 D20 DEC 20 M7777 OCT 7777 RS1 OCT 25000 RS2 OCT 177574 PRS1 OCT 153000 PRS2 OCT 203 BLANK ASC 1, HED REAL TIME CLOCK SCHEDULE ON TIME ROUTINE * * PROGRAM TO BE SCHEDULED * * THE TMSCH ROUTINE SCHEDULES THE PROGRAM IF DORMANT * THEN COMPUTES ITS NEXT SCHEDULE TIME FROM ITS * RES CODE AND MULT FACTOR IN ITS ID-SEGMENT. * IF THE RES CODE IS ZERO THE PROGRAM IS REMOVED FROM * THE TIME LIST. * * THE CALLING SEQUENCE IS: * SET POINT TO THE ADDRESS OF THE TIME LINK WORD * JSB TMSCH * TMSCH NOP CCB COMPUTE THE STATUS ADDRESS ADB POINT LDA B,I GET THE STATUS AND D15 GET THE LOW BITS SZA IF NOT DORMANT JMP CH026 FORGIT IT ADB DM15 ELSE SET B TO THE ID-SEG ADDRESS JSB $LIST CALL LIST PROCESSOR TO SCHED PROG OCT 401 THE PROGRAM * * CHECK IF NEXT SCHEDULE TIME TO BE COMPUTED * CH026 LDB POINT INB LDA B,I RES CODE/MULT FACTOR AND M7777 SZA,RSS IF ZERO, THEN NO NEW START TIME JMP CH040 GO REMOVE PROG FROM LIST STA TEMP SAVE MULTIPLICATION FACTOR JSB TUDAT GO UPDATE THE SCHEDULE TIME JMP TMSCH,I RETURN * * REMOVE PROGRAM FROM TIME LIST * CH040 LDA B10K CLEAR THE RESOLUTION TOO. STA B,I AND RESET IN THE ID-SEGMENT. LDB POINT VALUE OF TLINK JSB $TREM GO TO REMOVE PROGRAM JMP TMSCH,I GO TO PROCESS NEXT PROGRAM HED REAL TIME CLOCK PROCESSING ID-TIME UPDATE * TUDAT USES THE RES AND MULT FROM THE ID-SEGMENT TO * UPDATE THE EXECUTE TIME OF THE PROGRAM WHOES ID- * SEGMENT RESOLUTION CODE ADDRESS IS IN B. * * CALLING SEQUENCE: * * SET TEMP TO THE MULT FACTOR * SET B TO THE RES CODE ADDRESS * JSB TUDAT * TUDAT DEF SETMS ENTRY POINT LDA B,I GET THE RES CODE TO A INB SET STB TEMP1 TEMPS TO THE TIME INB ADDRESSES STB TEMP2 IN THE ID-SEGMENT RAL,CLE,SLA,RAL IF HOURS qJMP HR GO DO SPECIAL HOURS UPDATE RAL,CLE ELSE SET UP AND D7 FOR THE APPROPIATE ADA TTAB BASE LDA A,I AND MULTIPLY BY THE MULT. CH030 MPY TEMP CH031 ADA TEMP1,I ADD THE CURRENT VALUE SEZ IF OVERFLOW INB STEP B ADB TEMP2,I ADD THE HIGH BITS. STA TEMP1,I RESTORE THE NEW TIME STB TEMP2,I TO THE ID-SEG. CLE,SSB IF NEGATIVE RESULT THEN JMP TUDAT,I EXIT * LDA RS1 POSITIVE RESULT SO ADD NEG. OF LDB RS2 DAY TO MAKE NEGATIVE JMP CH031 * HR LDA TEMP FOR HOURS FIRST CLB INSURE LESS THAN DIV D24 ONE DAY LDA B RESULT IS MODULO 24 MPY D15 NOW SET UP TO MULTIPLY BY 60,000 STA TEMP IN TWO STEPS TO PREVENT OVERFLOW LDA D24K FIRST BY 15, JMP CH030 AND NEXT BY 24,000 * NOP TLIST NOP TOP OF TIME SCHEDULE LIST DAYS OCT 4552 RELEASE DATE. TTAB DEF * TTAB1 DEC 1 TTAB2 DEC 100 TTAB3 DEC 6000 D24K DEC 24000 D2 DEC 2 D7 DEC 7 D14 DEC 14 D15 DEC 15 D16 DEC 16 D24 DEC 24 DM15 DEC -15 SPC 4 * * SYSTEM START TBG ROUTINE * * THE $SCLK ROUTINE STARTS THE CLOCK PROVIDES * AN ENTRY POINT TO AID THE POWERFAIL ROUTINE. * * ON FIRST ENTRY THIS ROUTINE: * * 1. CONFIGURES IT SELF * 2. STARTS THE TBG. * 3. PRINTS "SET TIME" * 4. EXITS TO THE DISPATCHER. * * ON SUBSEQUENT ENTRIES IT IS A SUBROUTINE TO RESTART * TIME BASE GENERATOR. * $SCLK JMP CONFI GO CONFIGURE ON FIRST ENTRY LDA D2 PROGRAM THE TBG FOR 10'S OF MS. OTATB OTA 0 STCTB OCT 1100 CONFIGURED TO A STC TBG,C STFTB OCT 1600 CONFIGURED TO A STF TBG JMP $SCLK,I RETURN SPC 2 CONFI LDA TBG CONFIGURE THE TBG TEMP IOR OTATB MAKE AN OTA TBG TEMP1 STA OTATB SET IT TEMP2 IOR STCTB FORM AN STC TBG,C TCC STA STCTB SET THE STC XOR STFTB SET UP THE STF STA STFTB TLINC JSB $SCLK START THE TBG POINT LDA TUDAT SEND THE DD.RT STB DD.RT SAVE D.RTR ID-SEG. ADDRESS JSB $SYMG SET TIME JMP $XEQ MESSAGE AND GO TO THE DISPATCHER SPC 2 SETMS DEC -10 LENGTH OF SET TIME MESSAGE OCT 6412 PUT CR/LF OUT FIRST ASC 2,SET TIME ATI ASC 1,TI TI USED BY BATCH TIMER HED $TIMV ROUTINE TO GET CURRENT SYSTEM TIME * THE $TIMV ROUTINE CONVERTS THE CURRENT REAL TIME VALUES * * AND STORES THE VALUES INTO A USER SPECIFIED BUFFER. * * * * ROUTINE TO PROVIDE CURRENT TIME * CALLING SEQUENCE * DLD TIME PUT TIME IN A AND B REGS. * JSB $TIMV * RQP2 CONTAINS BEGIN ADDRESS OF 5 WORD BUFFER * RQP3 (OPTIONAL) CONTAINS ADDRESS OF YEAR BUFFER * ON RETURN, * ARRAY(1) = TENS OF MILLISECOND * ARRAY(2) = SECONDS * ARRAY(3) = MINUTES * ARRAY(4) = HOURS * ARRAY(5) = DAYS * RQP3,I = YEAR (197X) * * E IS SET * A IS THE YEAR * $TIMV ASC 1,ME ENTRY/EXIT (END OF SET TIME MSS.) CLE CLE FOR ADDITION ADA PRS1 ADD POSITIVE 24 HRS. SEZ TO GET A POSITIVE INB TIME ADB PRS2 DIV TTAB3 DIVIDE BY 6000 STA RQP4 SAVE MIN/HR ASR 16 POSITION B (SEC/10MS) FOR DIVIDE DIV TTAB2 DIVIDE BY 100 TO GET SEC/10MS STB RQP2,I SET 10MS VALUE ISZ RQP2 STEP ADDRESS POINTER STA RQP2,I SET SEC. VALUE ISZ RQP2 STEP TO MIN. ADDRESS. CLB SET UP FOR DIVIDE LDA RQP4 FETCH MIN/HR DIV D60 SEPERATE STB RQP2,I SET MINUTES ISZ RQP2 STEP TO HR. ADDRESS  STA RQP2,I SET HRS ISZ RQP2 STEP ADDRESS CLB SET B FOR DIVIDE LDA $TIME+2 GET DAYS FORM THE TIME DIV D365 SEPERATE DAYS AND YEARS CCE,INB STEP DAYS TO 1-365 FROM 0-364 STB RQP2,I SET DAYS ADA D1970 ADD THE BASE YEAR TO YEAR STA RQP3,I SET YEAR JMP $TIMV,I RETURN SPC 2 D60 DEC 60 D365 DEC 365 D1970 DEC 1970 BASE YEAR DM197 DEC -1970 NEG OF BASE YEAR HED REAL TIME ON REQUEST FOR TIME SCHED PROGRAM * ON REQUEST CONTINUATOR * * IF CURRENT TIME VALUES ARE ZERO OR NOW IS CODED THEN * THE CURRENT TIME IS PUT IN THE ID-SEG. AND R/M USED * TO COMPUTE THE NEXT TIME. * * IF CURRENT TIME VALUES ARE NOT ZERO THE PROGRAM IS * JUST PUT IN THE TIME LIST. * * CALLING SEQUENCE * * A=-1 IF NOW OPTION * A#-1 IF NOT NOW BUT PUT IN TIME LIST * B=ID-SEGMENT TIME ADDRESS. * * JMP $ONTM * $ONTM STB DLDAD SET LOAD ADDRESS STA TCC SET NOW FLAG FOR LATER INA,SZA,RSS IF NOW SKIP LOAD JMP NOW DLD DLDAD,I GET THE CURRENT TIME VALUES DLDAD EQU *-1 SZA,RSS IF TIME NOT ZERO SZB THEN JMP TIMIN THEN GO PUT IN TIME LIST NOW DLD $TIME GET CURRENT TIME DST DLDAD,I AND SET IN THE ID-SEG TIMIN LDB DM2 COMPUTE TIME LIST ADDRESS ADB DLDAD AND STB POINT AND SET FOR LIST ROUTINE JSB $TADD ADD PROG TO TIME LIST. ISZ TCC SKIP IF NOW RSS JSB TMSCH SCHEDULE THE PROG. AND UPDATE MESEX CLA SET A FOR NO ERROR JMP $MSEX HED $TIMR ROUTINE SETS UP ID SEGMENT TIME VALUES * THE $TIMR ROUTINE WHICH ALLOWS USER TO ENTER TIME VALUES * * INTO AN ID SEGMENT FUNCTIONS AS FOLLOWS: * * IF PROG VALUE IS ZERO, THEN CURRENT EXECUTING PROG. * * AND IF NON-ZERO, THEN SEARCH FOR ID SEGMENT * * ADDRESS. * * IF RESOLUTION CODE IS NON-ZERO, THEN RES/MULT WORD * * STORED. THE NEXT VALUE IS CHECKED FOR + OR -. * * IF PLUS, THEN NEXT START TIME VALUES GIVEN AND * * ARE STORED AND PROGRAM ENTERED INTO TIME LIST. * * IF MINUS, THEN THE COMPLEMENT OF VALUE IS ADDED* * TO THE CURRENT TIME AND ENTERED INTO THE ID * * SEGMENT. IF PROG VALUE IS ZERO, THIS IS TO BE A* * TIME DELAY OF CURRENT PROGRAM AND THUS PROGRAM * * IS SET DORMANT VIA LINK PROCESSOR BUT POINT OF * * SUSPENSION IS NOT CLEARED. IF PROG VALUE IS NON* * ZERO, THEN PROGRAM IS ENTERED INTO TIME LIST. * * THIS IS METHOD FOR SPECIFYING AN INITIAL OFFSET* * TIME. * * * ROUTINE TO SET ID SEGMENT TIME VALUES * CALLING SEQUENCE * JSB EXEC * DEF *+6 OR DEF *+9 * DEF REQUEST CODE ADDRESS RQP1 * DEF PROG RQP2 * DEF RES RQP3 * DEF MULT RQP4 * DEF OFFSET OR DEF HRS RQP5 * DEF MINS RQP6 * DEF SECS RQP7 * DEF TENS OF MSEC RQP8 * WHERE * PROG = 0 IF CURRENTLY EXECUTING * = ADDRESS OF PROGRAM NAME * RES = 1 FOR 10 MILLISECOND RESOLUTION * = 2 FOR SECONDS RESOLUTION LIST * = 3 FOR MINUTES RESOLUTION LIST * = 4 FOR HOURS RESOLUTION LIST * MULT = 0 FOR N0 MULTIPLE VALUE * $ = N A POSITIVE INTEGER FOR COMPUTING * NEXT SCHEDULE TIME * OFFSET= M A NEGATIVE INTEGER FOR COMPUTING INITIAL * OFFSET TIME * HRS= START TIME HOURS * MINS= START TIME MINUTES * SECS= START TIME SECONDS * TENS= START TIME TENS OF MILLISECONDS * * EXEC PRE-PROCESSOR CHECKS FOR RESOLUTION CODE * ERRORS AND FINDS THE ID-SEGMENT ADDRESS. * * CALLING SEQUENCE: * * LDB ID-SEGMENT ADDRESS * JMP $TIMR SKP $TIMR ADB D16 GET ADDRESS OF TIME LINK STB TCC AND SAVE IT INB STEP TO RESOLUTION ADDRESS STB TEMP1 AND SAVE LDA B,I GET RESOLUTION CODE/T/MULT INB STEP TO TIME LOCATION STB DSTAD SAVE THE ADDRESS * ALF,ERA SAVE BIT 12 SINCE PROGRAM MAY XLA RQP4,I ALREADY BE IN THE TIME LIST ALF,ERA COMBINE MULT AND SAVED T-BIT XLB RQP3,I RESOLUTION TO B LSR 3 SHIFT RESULT TO A STA TEMP1,I SET IT IN THE ID-SEG. XLA RQP5,I NEGATIVE IF OFFSET SSA,RSS POSITIVE IF START TIME JMP TI100 CMA,INA SET POSITIVE AND STA TEMP SAVE IN TEMP XLA RQP2,I CHECK IF CURRENT XEQ PROGRAM SZA JMP TI012 NO * LDB XEQT YES, SET THE SAVE- STB $WORK RESOURCES BIT IN STA XEQT THE PROGRAM'S STATUS ADB D15 WORD. LDA B,I (CLEAR XEQT SO THAT $LIST WILL IOR B200 SET THE NP BIT IF THE USER IS STA B,I MODIFING ITS ON TIME VALUES). JSB $LIST MAKE PROGRAM DORMANT OCT 300 TI012 LDA $TIME GET THE CURRENT TIME LDB $TIME+1 AND SET DST DSTAD,I IT IN THE ID-SEG DSTAD EQU *-1 LDB TEMP1 GET THE RES. CODE ADDRESS TO B JSB TUDAT UPDATE THE TIME * TI015 LDB TCC JSB PP$TADD ENTER PROG INTO TIME LIST JMP $XEQ DONE - EXIT TO DISPATCHER * * GIVEN START TIME * TI100 XLA RQP5,I BRING PARAMETERS 5 - 8 STA LOCL1 LOCALLY. XLA RQP6,I STA LOCL2 XLA RQP7,I STA LOCL3 XLA RQP8,I STA LOCL4 * LDA DEFLC NOW SET UP LOCALL ADDRESSES STA RQP5 FOR THE $ETTM ROUTINE INA STA RQP6 INA STA RQP7 INA STA RQP8 * LDB DSTAD SET B TO THE TIME ADDRESS AND JSB $ETTM GO TO STORE VALUES IN ID SEGMENT JMP TI015 GO PUT PROG IN TIME LIST * DM2 DEC -2 B200 OCT 200 DEFLC DEF LOCL1 LOCL1 NOP LOCL2 NOP LOCL3 NOP LOCL4 NOP HED REAL TIME CLOCK PROCESSOR SET TIME IN ID-SEG * $ETTM SETS A TIME IN THE REFERENCED ID-SEGMENT. * * CALLING SEQUENCE * * RQP5,I=HOURS * RQP6,I=MINUTES * RQP7,I=SECONDS * RQP8,I=TENS OF MS. * * B=TIME ADDRESS IN THE ID-SEG. * $ETTM NOP ENTRY POINT STB DSTA2 SAVE THE ID-SEG. ADDRESS LDA RQP7,I GET SECONDS MPY TTAB2 CONVERT TO MS (MPY D100) ADA RQP8,I ADD THE MS VALUE AND STA RQP8 AND SAVE LDA RQP5,I GET HOURS MPY D60 CONVERT TO MINUTES ADA RQP6,I ADD MINUTES MPY TTAB3 CONVERT MINUTES TO MS (MPY D6000) CLE PREPARE FOR ADD ADA RQP8 ADD MS VALUE SEZ IF OVERFLOW INB STEP HIGH PART SET01 CLE,SSB IF POSITIVE JMP SET02 ADA RS1 SUBTRACT 24 HRS SEZ,CLE UNTIL INB ADB RS2 IT IS JMP SET01 NEGATIVE SET02 DST DSTA2,I SET THE VALUE IN THE ID-SEG. DSTA2 EQU *-1 JMP $ETTM,I RETURN HED ADDITION OF PROGRAM TO TIME RESOLUTION CODE LIST * THE $TADD ROUTINE FUNCTIONS AS FOLLOWS: * * IF RESOLUTION CODE IS ZERO, THEN EXIT * * / IF NON-ZERO RESOLUTION, AND PROGRAM NOT IN TIME LIST* * (BIT 12 OF RES/T/MULT 0), THEN SET BIT 12 OF * * MULT WORD TO SIGNIFY THAT IT IS IN TIME LIST. * * IF TIME LIST IS NULL, THEN SET IT TO POINT TO * * PROGRAM TIME LINK AND SET TLINK TO ZERO. * * IF PROGRAM NOT IN LIST, THEN IT IS ADDED TO * * TOP OF TIME LIST AND ITS TLINK VALUE MADE * * TO POINT TO THE PREVIOUS TOP OF LIST * * PROGRAM. * * * * * ADDING A PROGRAM TO A TIME RESOLUTION CODE LIST * CALLING SEQUENCE * LDB ADDRESS OF ID SEGMENT TLINK VALUE * JSB $TADD * $TADD NOP STB TLINC SAVE TLINK ADDRESS INB INCR TO RES CODE/MULT FACTOR ADD LDA B,I ALF,CLE,ERA AND D7 SZA,RSS JMP $TADD,I EXIT SEZ PROG IN TIME LIST? JMP $TADD,I YES, SO EXIT * LDA B,I IOR B10K SET T BIT STA B,I LDB TLIST LOAD VALUE OF TOP OF LIST LDA TLINC SET LINK OF NEW PROG TO PREVIOUS STB A,I OF TIME LIST STA TLIST SET TOP OF TIME LIST TO NEW PROG TLINK ADDRESS JMP $TADD,I RETURN HED REMOVE A PROGRAM FROM TIME LIST * * * THE $TREM ROUTINE FUNCTIONS AS FOLLOWS: * * IF PROGRAM NOT IN TIME LIST, THEN EXIT * * IF PROGRAM IN TIME LIST, THEN CLEAR BIT 12 OF * * RES/T/MULT TO INDICATE NOT IN TIME LIST. * * A SEARCH IS MADE OF THE TIME LIST PROGRAMS * * UNTIL PROGRAM FOUND OR END OF LIST. THE * * TLINK VALUES ARE CHANGED AS NECESSARY. * C* * * * CALLING SEQUENCE * LDB TLINK ADDRESS OF ID SEGMENT * JSB $TREM * $TREM NOP ENTRY/EXIT STB TLINC COMPUTE LIST ADDRESS INB LDA B,I CHECK IF PROGRAM IS IN TIME LIST AND B10K SZA,RSS JMP $TREM,I NO, SO EXIT XOR B,I CLEAR T-BIT STA B,I LDA DTLST GET ADDR OF TOP OF LIST PNTR * TR010 LDB A,I GET CURRENT TOP OF LIST CPB TLINC IS THIS THE PROG? JMP TR030 YES SZB,RSS END OF LIST? JMP $TREM,I YES, RETURN STB A SAVE ADDR OF CURRENT LINKWORD JMP TR010 GO CHECK NEXT PROG * TR030 LDB B,I LINK NEXT PROG STB A,I TO PREV PROG TO REMOVE JMP $TREM,I RETURN SPC 1 DTLST DEF TLIST B10K OCT 10000 HED MESSAGE PROCESSOR TM REQUEST COMPLETION * THIS ROUTINE COMPLETES THE SET TIME REQUEST * * CALLING SEQUENCE: * * LDB DEFP1 SET B TO ADDRESS OF PRAM LIST * JMP $TMRQ * $TMRQ LDA DM6 SET UP PRAM ADDRESSES ON STA TEMP THE BASE PAGE LDA DRQP3 TM1 STB A,I ADB D4 PRAMS SEPERATED BY FOUR WORDS INA ISZ TEMP DONE? JMP TM1 NO * LDA RQP3,I GET YEAR ADA DM197 SUBTRACT THE BASE MPY D365 MULTIPLY BY DAYS PER YEAR ADA RQP4,I ADD THE DAY CMB SET B TO -1 IF LEGAL RESULT ADA B SUBRTACT ONE FROM DAY INB,SZB IF B WAS NOT ZERO AFTER MULT. THEN JMP $INER INPUT ERROR STA $TIME+2 SET DAY COUNTER * LDB DTIME GET TIME ADDRESS TO B JSB $ETTM SET THE TIME JMP MESEX EXIT TO MESSAGE PROCESSOR SPC 2 DM6 DEC -6 DRQP3 DEF RQP3 D4 DEC 4 DTIME DEF $TIME HED ** SYSTEM BASE PAGE COMMUNICATION AREA ** * * *** SYSTEM BASE PAGE CO&MMUNICATION AREA *** * . EQU 1650B ESTABLISH ORIGIN OF AREA * * SYSTEM TABLE DEFINITION * * EQTA EQU .+0 FWA OF EQUIPMENT TABLE EQT# EQU .+1 # OF EQT ENTRIES * DRT EQU .+2 FWA OF DEVICE REFERENCE TABLE LUMAX EQU .+3 # OF LOGICAL UNITS (IN DRT) * INTBA EQU .+4 FWA OF INTERRUPT TABLE INTLG EQU .+5 # OF INTERRUPT TABLE ENTRIES * TAT EQU .+6 FWA OF TRACK ASSIGNMENT TABLE * KEYWD EQU .+7 FWA OF KEYWORD BLOCK * * I/O MODULE/DRIVER COMMUNICATION * EQT1 EQU .+8 ADDRESSES EQT2 EQU .+9 EQT3 EQU .+10 OF EQT4 EQU .+11 EQT5 EQU .+12 CURRENT EQT6 EQU .+13 EQT7 EQU .+14 15-WORD EQT8 EQU .+15 EQT9 EQU .+16 EQT EQT10 EQU .+17 EQT11 EQU .+18 ENTRY EQT12 EQU .+81 EQT13 EQU .+82 EQT14 EQU .+83 EQT15 EQU .+84 * CHAN EQU .+19 CURRENT DMA CHANNEL # TBG EQU .+20 I/O ADDRESS OF TIME-BASE CARD SYSTY EQU .+21 EQT ENTRY ADDRESS OF SYSTEM TTY * * SYSTEM REQUEST PROCESSOR /'EXEC' COMMUNICATION * * RQCNT EQU .+22 # OF REQUEST PARAMETERS -1 RQRTN EQU .+23 RETURN POINT ADDRESS RQP1 EQU .+24 ADDRESSES RQP2 EQU .+25 RQP3 EQU .+26 OF REQUEST RQP4 EQU .+27 RQP5 EQU .+28 PARAMETERS RQP6 EQU .+29 RQP7 EQU .+30 (SET FOR MAXIMUM OF RQP8 EQU .+31 8 PARAMETERS) * * DEFINITION OF SYSTEM LISTS (QUEUES) * * DORMT EQU .+32 ADDRESS OF 'DORMANT' LIST, SKEDD EQU .+33 'SCHEDULE' LIST, SUSP3 EQU .+36 'AVAILABLE MEMORY' LIST, SUSP4 EQU .+37 'DISC ALLOCATION' LIST, SUSP5 EQU .+38 'OPERATOR SUSPEND' LIST * * DEFINITION OF EXECUTING PROGRAM ID SEGMENT' * * XEQT EQU .+39 ID SEGMENT ADDR. OF CURRENT PROG. XLINK EQU .+40 'LINKAGE' XTEMP EQU .+41 'TEMPORARY (5-WORDS) XPRIO EQU .+46 'PRIORITY' WORD XPENT EQU .+47 'PRIMARY ENTRY POINT' XSUSP EQU .+48 'POINT OF SUSPENSION' XA EQU .+49 'A REGISTER' AT SUSPENSION XB EQU .+50 f 'B REGISTER' XEO EQU .+51 'E AND OVERFLOW * * SYSTEM MODULE COMMUNICATION FLAGS * * OPATN EQU .+52 OPERATOR/KEYBOARD ATTENTION FLAG OPFLG EQU .+53 OPERATOR COMMUNICATION FLAG SWAP EQU .+54 RT DISC RESIDENT SWAPPING FLAG DUMMY EQU .+55 I/O ADDRESS OF DUMMY INT. CARD IDSDA EQU .+56 DISC ADDR. OF FIRST ID SEGMENT IDSDP EQU .+57 -POSITION WITHIN SECTOR * * DEFINITION OF MEMORY ALLOCATION BASES * * BPA1 EQU .+58 FWA R/T DISC RES. BP LINK AREA BPA2 EQU .+59 LWA R/T DISC RES. BP LINK AREA BPA3 EQU .+60 FWA BKG DISC RES. BP LINK AREA LBORG EQU .+61 FWA OF RESIDENT LIBRARY AREA RTORG EQU .+62 FWA OF REAL-TIME AREA RTCOM EQU .+63 LENGTH OF REAL TIME COMMON AREA RTDRA EQU .+64 FWA OF R/T DISC RESIDENT AREA AVMEM EQU .+65 FWA OF SYSTEM AVAILABLE MEMORY BKORG EQU .+66 FWA OF BACKGROUND AREA BKCOM EQU .+67 LENGTH OF BACKGROUND COMMON AREA BKDRA EQU .+68 FWA OF BKG DISC RESIDENT AREA * * UTILITY PARAMETERS * TATLG EQU .+69 LENGTH OF TRACK ASSIGNMENT TABLE TATSD EQU .+70 # OF TRACKS ON SYSTEM DISC SECT2 EQU .+71 # SECTORS/TRACK ON LU 2 (SYSTEM) SECT3 EQU .+72 # SECTORS/TRACK ON LU 3 (AUX.) * DSCLB EQU .+73 DISC ADDR OF RES LIB ENTRY PTS DSCLN EQU .+74 # OF RES LIB ENTRY POINTS DSCUT EQU .+75 DISC ADDR OF RELOC UTILITY PROGS DSCUN EQU .+76 # OF RELOC UTILITY PROGS LGOTK EQU .+77 LOAD-N-GO: LU,STG TRACK,# OF TRKS LGOC EQU .+78 CURRENT LGO TRACK/SECTOR ADDRESS SFCUN EQU .+79 SOURCE FILE LU AND DISC ADDRESS MPTFL EQU .+80 MEMORY PROTECT ON/OFF FLAG (0/1) FENCE EQU .+85 MEM PROTECT FENCE ADDRESS * BKLWA EQU .+87 LWA OF MEMORY IN BACKGROUND * * FREG1 EQU LBORG FREG2 EQU RTORG FREG3 EQU BKORG FLG EQU OPFLG * A EQU 0B LOCATION OF A REGISTER B EQU 1B LOCATION OF B REGISTER ORG * PROGRAM LENGTH END $SCLK YZXTTZ  92067-18017 1805 S C0122 &ASCM4 RTE-IV MESSAGES             H0101 ASMB,R,L ** RT MESSAGE MODULE ** HED RT MESSAGE MODULE * NAME: $ASC4 * SOURCE: 92067-18017 * RELOC: 92067-16014 * PGMR: G.A.A.,E.J.W. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM $ASC4,0 92067-16014 REV.1805 780125 * SUP * ENTRY REFERENCE NAMES * ENT $OPER,$ERIN,$NOPG,$ILST,$NOLG,$LGBS,$NMEM * ******************************************************************** * * THE RTE MESSAGE MODULE CONTAINS ALL THE FIXED MESSAGES THE * SYSTEM OUTPUTS TO THE USER. * * THESE MESSAGES CONSISTS OF A CHARACTER COUNT (NEGATIVE) * FOLLOWED BY THE ASCII MESSAGE. * * THE ENTRY POINT IS ON A DEF TO THE ABOVE MESSAGE. * ******************************************************************** * $ILST DEF *+1 ILLEGAL STATUS ERROR MESSAGE DEC -14 ASC 7,ILLEGAL STATUS * $NOLG DEF *+1 DM12 DEC -12 ASC 6,NO LGO SPACE * $LGBS DEF *+1 DM10 DEC -10 ASC 5,LGO IN USE * $OPER DEF *+1 OPERATION CODE ERROR MESSAGE DEC -12 ASC 6,OP CODE ERR * $NOPG DEF *+1 NO SUCH PROGRAM ERROR MESSAGE DEC -12 NO ASC 6,NO SUCH PROG * $ERIN DEF *+1 INPUT ERROR MESSAGE DEC -12 ASC 6,INPUT ERROR * $NMEM DEF *+1 DEC -18 ASC 9,CMD IGNORED-NO MEM * END $ERIN h   JMP $DREL,I BE RELEASED * CMB,INB SET 'N' AS INDEX. CLA SET CURRENT DREL0 STA TEMP1,I TRACK ISZ TEMP1 RELEASED INB,SZB JMP DREL0 JSB $SDSK SCHEDULE ANY SUSPENDED PROGRAMS. JMP $DREL,I -EXIT- * SKP * SUBROUTINE: < $SDSK > * * PRUPOSE: THIS ROUTINE CALLS FOR THE * SCHEDULING OF ALL USER PROGRAMS * SUSPENDED BECAUSE OF DISC TRACK * AVAILABILITY. * * CALL: (P) JSB $SDSK * (P+1) - RETURN - A = 0 * * $SDSK DEF IDADD LINK FOR START UP CODE ISZ $LIST FORCE ENTRY INTO DISPATCHER. DSKD1 LDB SUSP4 GET DISC SUSPENSION LIST POINTER. CCE,SZB,RSS IF EMPTY LIST, JMP $SDSK,I EXIT. * JSB $LIST CALL *SCHEDULER* TO OCT 401 LINK INTO SCHEDULE LIST. * JMP DSKD1 SCHEDULE NEXT PROGRAM SKP HED - EXEC - PARTITION STATUS REQUEST PROCESSOR * EXEC CALL FOR PARTITION STATUS * * CALLING SEQUENCE : JSB EXEC * DEF *+6 RETURN * DEF D25 CODE=25 * DEF PART# PARTITION NUMBER * DEF PAGE# RETURNED STARTING PAGE # * DEF #PGS RETURNED NUMBER OF PAGES * DEF PSTAT RETURNED PARTITION STATUS * BIT15 = BG/RT 0/1 * BIT14 = FREE FOR ALL/RESERVED 0/1 * BIT13 = NORMAL/MOTHER PART'N 0/1 * BIT12 = ISN'T/IS A SUB PART'N 0/1 * BIT11 = CHAIN ISN'T/IS IN EFFECT * 0/1 * * * TEMP USAGE : TEMP1 = INPUT PARTITION # * * FORMAT OF PSTAT * 15 14 13 12 11 7 *----------------------------------------------------------- *I RS I RT I M I S I C I ---- 40 ---- I ID SEGMENT NUMBER I *----------------------------------------------------------- * * #PGS = -1 ON RETURN IF PARTITION NUMBER IS ERRONEOUS * $PTST LDA RQCNT GET THE REQUEST COUNT ADA DM4 SUBTRACT THE PRAMETER COUNT SSA ARE THERE ENOUGH PARAMETERS ? JMP RQERR NO, SO TAKE GAS ! * XLA RQP2,I GET THE PART'N # STA TEMP1 AND SAVE CMA,INA IF NEG OR 0 SSA,RSS FORGET IT . JMP PT.ER * ADA $MNP ADD IN THE MAX # OF PARTITIONS SSA IF PARTITION REQUESTED IS TOO JMP PT.ER LARGE, FLUSH HIM ! * CCA NOW INDEX TO ADA TEMP1 THE REFERENCED MPY D7 PARTITION ADA $MATA CAX PUT ADDRESS IN X FOR FUTURE INDEXING LDA A,I GET THE CONTENTS OF 1ST WORD SSA IS THE PARTITION DEFINED ? JMP PT.ER NO, FLUSH HIM !!! * LBX D2,I GET THE USERS ID SEG # SZB IF NOBODY HOME, FORGET IT JSB $IDNO RETURNS IS SEG # IN B-REG * LAX D4,I GET THE RESERVED WORD RAL,CLE,SLA,ELA R =LSB C = E-REG ADB SIGN IF RESERVED,SET B-REG SIGN BIT RAR,RAR MOVE RESERVED WORD BACK AND B1777 KEEP ONLY #PGS SEZ,INA ADD BASE PAGE, SKIP IF CHAIN IN EFFECT ADB B4000 SET C BIT TO INDICATE CHAIN XSA RQP4,I GIVE # OF PAGES TO USER * LAX D5,I GET RT WORD SSA IF RT BIT SET THEN ADB B40K SET THE RT BIT IN PSTAT * RBL,RBL PLACE M&S BITS INTO BIT 15 & 14 * LAX D3,I GET THE START PAGE WORD SSA IS THE M BIT SET ? ADB SIGN YES, SO SET THE PSTAT M BIT AND B1777 KEEP ONLY START PG # XSA RQP3,I GIVE IT TO THE USER * SSB IS THIS A MOTHER PARTITION JMP PT.MB YES, SO CAN'T BE A SUB PARTITION * LAX D6,I NO, GET THE SUBPARTITION LINK WORD SZA IS THERE A SUB PARTITION ? ADB B40K YES, SO SET THE PSTAT S BIT PT.MB RBR,RBR FIX B- REG XSB RQP5,I AND GIVE THE PSTAT TO THE USER * PT.RT LDA RQRTN GET THE RETURN ADDRESS STA XSUSP,I DET AS THE POINT OF SUSPENSION JMP $XEQ AND SEE WHAT TO DO NEXT. * * PT.ER CLA XSA RQP3,I RETURN 0 AS START PG # CMA XSA RQP4,I RETURN -1 AS # OF PAGES JMP PT.RT * D6 DEC 6 B1777 OCT 1777 B40K OCT 40000 B37 OCT 37 B77 OCT 77 * HED - EXEC - PARTITION SIZE REQUEST PROCESSOR * * * EXEC 26 CALLING SEQUENCE * * JSB EXEC * DEF RETURN * DEF CODE# = 26 * DEF FWMEM = ADDRESS OF PROGRAM'S HIGHEST WORD + 1 * DEF NWLM = # OF WORDS AFTER PROG END & END OF ADDRESS SPACE * DEF PTS12 = LENGTH OF CURRENT PARTITION IN PAGES * DEF MAP = OPTIONAL 32 WORD BUFFER FOR COPY OF USER MAP * * * TEMP USAGE: TEMP1 = - [ HIGH MAIN + LARGEST SEGMENT + 1 ] * * * * PTSIZ LDA RQCNT GET THE REQUEST COUNT ADA DM3 SUBTRACT ACTUAL PRAMETER COUNT SSA AT LEAST 3 PARAMETERS SUPPLIED ? JMP RQERR NO, FLUSH HIM !!! SZA,RSS DID HE SUPPLY THE OPTIONAL PARAMETER ? JMP NMOVE NO. * LDA $PBUF GET THE DESTINATION ADDRESS ADA SIGN SPECIFY READ NOT WRITE USA GET THE MAP * LDA $PBUF NOW THAT WE HAVE THE MAP LDB RQP5 LET'S GIVE IT TO THE USER LDX D32 X = # OF WORDS TO MOVE MWI MOVE THE WORDS. * NMOVE LDA XMATA GET ADDR OF CURRENT $MATA ENTRY SZA,RSS IS THIS A MEMORY RESIDENT PROG ? JMP MEMER YES, FORGET THE REST OF THE CALL ADA D4 INDEX TO THE SIZE WORD LDA A,I GET IT. INA ACCOUNT FOR BASE PAGE. AND B1777 KEEP ONLY THE SIZE BITS XSA RQP4,I AND GIVE IT TO THEd0 USER * LDB XEQT NOW GET THIS PROS'S ID SEG ADDRESS ADB D29 INDEX TO THE HIGH MAIN + SEGMENT +1 LDA B,I GET THE SIZE ADB DM6 NOW INDEX TO HIGH MAIN + 1 SZA,RSS IS THE PROGRAM SEGMENTED ? LDA B,I NO, SO USE HIGH MAIN + 1 XSA RQP2,I NOW GIVE IT TO THE USER. CMA,INA * ADB DM1 NOW INDEX TO LOW MAIN WORD IN ID SEG ADA B,I GET THE WORD STA TEMP1 AND SAVE * ADB DM1 NOW INDEX TO # OF PAGES WORD LDA B,I GET THE WORD AND G76 & KEEP SIZE IN PAGES ADA TEMP1 ADD LOAD POINT. A = # OF WORDS LEFT XSA RQP3,I GIVE IT TO THE USER. ADB D7 *E INDEX TO EMA WORD LDA B,I *E SZA,RSS *E IS THIS AN EMA PROG? JMP MYEND *E NO, DONE * ALF *E YES, EMA PROG RAL,RAL *E GET INDEX VALUE AND B77 *E ADA $IDEX *E LDA A,I *E LDA A,I *E (A) = 1ST WORD ID EXT AND B37 *E KEEP ONLY MSEG SIZE ALF,ALF *E RAL,RAL *E CONVERT TO # OF WORDS CMA,INA *E XLB RQP3,I *E SUBTRACT FROM # OF WORDS ADA B *E THAT USER COULD HAVE XSA RQP3,I *E (A) = DYNAMIC BUFFER AREA SIZE IN #WORDS * MYEND LDA RQRTN GET RETURN POINT STA XSUSP,I SAVE OIN ID SEG AS POINT OF SUSPENSION. JMP $XEQ NOW GO SEE WHAYT TO DO NEXT. * MEMER STA RQP2,I MEMORY RESIDENT PROGRAM STA RQP3,I SO DONT RETURN STA RQP4,I PARTITION SIZE OR FREE MEMORY JMP MYEND HED * EXEC - ERROR MESSAGE SECTION * * * MEMORY PROTECT * * IN RTE 4 THE OPERATING SYSTEM IS PROTECTED BY A HARDWARE * MEMORY PROTECT. THIS MEANS THAT ANY PROGRAM THAT ILLEGALLY * TRIES TO MODIFY OR JUMP TO THE OPERATING SYSTEM WILL CAUSE * A MEMORY PROTECT INTERUPT. THE OPERATING SYSTEM INTERCEPTS * THE INTERUPT AND DETERMINES IT'S LEGALITY. IF THE MEMORY * PROTECT IS ILLEGAL, THEN THE PROGRAM IS ABORTED AND THE FOLLOWING * MESSAGE IS REPORTED TO THE SYSTEM CONSOLE : * * MP INST = XXXXXX XXXXX = OFFENDING OCTAL INSTRUCTION CODE * ABE PPPPPP QQQQQQ R CONTENTS OF A,B & E REGISTERS AT ABORT * XYO PPPPPP QQQQQQ R CONTENST OF X,Y & O REGISTERS AT ABORT * MP YYYYY ZZZZZ YYYYY = PROGRAM NAME, ZZZZZ = VIOLATION ADDRESS * YYYYY ABORTED * * * DYNAMIC MAPPING VIOLATION * * A DYNAMIC MAPPING VIOLATION OCCURS WHEN AN ILLEGAL READ OR * WRITE OCCURS TO A PROTECTED PAGE OF MEMORY. THIS MAY HAPPEN * WHEN ONE USER TRIES TO WRITE BEYOND HIS OWN ADDRESS SPACE TO * NON EXISTANT MEMORY OR SOMEONE ELSES MEMORY. IN THIS CASE THE * PROGRAM IS ABORTED AND THE FOLLOWING MESSAGE IS PRINTED: * * * DM VIOL = WWWWW WWWWW = CONTENTS OF DMS VIOLATION REGISTER * DM INST = XXXXXX * ABE PPPPPP QQQQQQ R * XYO PPPPPP QQQQQQ R * DM YYYYY ZZZZZ * YYYYY ABORTED * * * EX ERRORS * * IT IS POSSIBLE TO EXECUTE IN THE PRIVLEDGED MODE (IE INTERUPT * SYSTEM OFF) IN THIS CASE THE USER MAY NOT MAKE EXEC REQUESTS * BECAUSE MEMORY PROTECT, WHICH IS THE ACCESS VEHICLE TO EXEC IS OFF. * AN ATTEMPT TO MAKE AN EXEC CALL WITH THE INTERUPT SYSTEM OFF * WILL CAUSE THE CALLING PROGRAM TO BE ABORTED AND THE FOLLOWING * MESSAGE PRINTED : * *EX YYYYY ZZZZZ *EX ABORTED * * * * UNEXPECTED DM AND MP ERRORS * * THE OPERATING SYSTEM HANDLES ALL MP AND DM VIOLATIONS. * CERTAIN OF THESE VIOLATIONS ARE LEGAL AND OTHERS ARE NOT. * IN ANY CASE THE OPERATING SYSTEM ASSOCIATES THESE VIOLATIONS * WITH PROGRAM ACTIVITY. IF A DM OR MP ERROR OCCURS AND NO PROGRAM * WAS ACTIVE THEN, THIS IS AN UNEXPECTED MP OR DM VILATION. * SINCE NO PROGRAM IS PRESENT, THERE IS NO PROGRAM TO ABORT * IN THIS CASE THE FOLLOWING MESSAGE WILL BE PRINTED : * * * DM VIefOL = WWWWW * DM INST = XXXXX OR MP INST = XXXXX * ABE PPPPPP QQQQQQ R ABE PPPPPP QQQQQQ R * XYO PPPPPP QQQQQQ R XYO PPPPPP QQQQQQ R * DM 0 MP = 0 * * * WARNING WARNING WARNING WARNING WARNING WARNING * ------------------------------------------------- * * THE ABOVE MESSAGE WHICH SPECIFIES AS THE PROGRAM * NAME IS A SIGNAL TO THE USER THAT AN UNEXPECTED MEMORY PROTECT * OR DYNAMIC MAPPING VIOLATION ERROR HAS OCCURED. THIS IS A * SERIOUS VIOLATION OF OP SYSTEM INTEGRITY. MOST TIMES IT MEANS * USER WRITTEN SOFTWARE (DRIVER, PRIVLEDGED SUBROUTINE) HAS DAMAGED * THE OPERATING SYSTEM INTEGRETY OR INADAQUATELY PERFORMED REQUIRED * (DRIVER) SYSTEM HOUSEKEEPING. IT MAY ALSO MEAN THAT THE CPU * HAS FAILED AND THAT THE OPERATING SYSTEM CAUGHT THE FAILURE * IN TIME TO AVOID A SYSTEM CRASH. * * IF THIS ERROR OCCURS IT IS SUGGESTED THAT USERS SAVE WHATEVER * THEY WERE DOING (IE FINISH UP EDITING, ETC) AND REBOOT THE SYSTEM. * IF ONLY H-P SYSTEM MODULES ARE PRESENT IN THE OPERATING SYSTEM, * CPU FAILURE IS HIGHLY SUSPECTED AND CPU DIAGNOSTICS SHOULD BE RUN. * * * * THE ROUTINE -$ERMG- IS USED TO FORMAT * THE DIAGNOSTIC AND CALL FOR ITS OUTPUT. * * MPERR LDA MP ASSUME A MP ERROR SFS 5 IS IT A MEMORY PROTECT OR DM ERROR ? JMP MPER MEMORY PROTECT RVA GET THE VIOLATION REGISTER CLE SPECIFY OCTAL CONVERSION JSB $CNV3 CONVERT TO OCTAL LDB A,I GET THE 1ST WORD STB VBUFR+7 INA BUMP POINTER DLD A,I PULL IN LAST TWO DST VBUFR+8 AND SET IN OUTPUT BUFFER * LDA VBUFR GET ADDRESS JSB $SYMG AND REPORT ERROR * LDA DM (A) = 'DM' * MPER STA IBPBF+2 (SAVE THER ERROR CODE ) CLE OCTAL CONVERSION LDA INSTR GET THE INSTRUCTION JSB $CNV3 CONVERT TO OCTAL LDB A,I GET THE 1ST WORD STB IBPBF+7 & SAVE INA DLD A,I AND THE LAST TWO DST IBPBF+8 LDA IBPBF GET THE ADDRESS & JSB $SYMG TELL THE FOLKS THEY BLEW IT JSB $ABXY REPORT THE AB,XY, & EO REGISTERS LDA IBPBF+2 GET THE CODE JMP DOABT AND DO THE ABORTION * RQERR LDA RQ1 (A) 'RQ' JMP DOABT * ERE01 LDA RE (A) 'RE' JMP DOABT * * SYSTEM MAY BE RESTARTED AFTER * A CRASH BY SETTING P = EXEC * $XEX LDB EXECA,I GET THE CONTENTS OF EXEC SZB,RSS WAS IT A JSB ? JMP XEX1 NO ADB DM1 YES, SO USE THIS AS STB XSUSP,I A POINT OF SUSPENSION * XEX1 LDA IDLE BUT, REGARDLESS RESTORE THE STA $IDLE IDLE LOOP ADDRESS. * CLA SET EXEC BACK TO A NOP AGAIN STA EXECA,I JSB $ABXY REPORT X & Y REGISTERS * LDA EX GET THE ERROR CODE * DOABT LDB BLANK (B) = BLANKS JSB $ERMG GO ABORT THE PROGRAM & REPORT ABORTION * CLE SPECIFY OCTAL CONVERSION JMP $XEQ GO SEE WHAT TO DO NEXT * MP ASC 1,MP RQ1 ASC 1,RQ RE ASC 1,RE PE ASC 1,PE EX ASC 1,EX * VBUFR DEF *+1 DEC -16 DM ASC 8,DM VIOL = XXXXX IBPBF DEF *+1 DEC -16 ASC 8,XX INST = XXXXX * SKP * * * $ABXY PRINTS OUT THE A, B, X, Y, E, & O REGISTERS ON THE * SYSTEM CONSOLE. * IT IS CALLED FOR MP, DM, & PE ERRORS. * * * SET UP TO SEND A & B / X & Y REGISTERS TO SYS CONSOLE * $ABXY NOP DLD AB GET THE ASCII 'AB' DST ABBUF+2 AND PUT INTO MESSAGE * LDA XEO,I GET THE E & O REGISTERS LDB ASC.0 GET AN ASCII ' 0' CLE,SSA WAS E REG SET ? INB YES * LDA XA GET A REG @ SUSPENSION ADDRESS GETXY STA TEMP8 AND SAVE STB ABBUF+11 SAVE E & O REG ALSO LDA A,I GET THE VALUE TO REPORT JSB $CNV3 CONVERT TO ASCII LDB A,I GET 1ST WORD STB ABBUF+4 CLE,INA BUMP POINTER (CLEAR E FOR NEXT CONVERSION) DLD A,I GET LAST TWO WORDS DST ABBUF+5 & PUT INTO BUFFER * ISZ TEMP8 BUMP TO NEXT WORD (B REG OR Y REG) LDA TEMP8,I GET IT JSB $CNV3 AND DO IT AGAIN LDB A,I STB ABBUF+8 CLE,INA DLD A,I DST ABBUF+9 * LDA ABBUF GET THE ADDRESS JSB $SYMG REPORT THE REGISTER CONTENTS * DLD XY GET X & Y REGISTER MESSAGE CPA ABBUF+2 DONE THIS BEFORE ? JMP $ABXY,I YES, SO RETURN TO CALLER * DST ABBUF+2 NO, SO REPORT X&Y REGISTERS LDB XI GET ADDRESS OF X REGISTER XLA B,I GET IT STA X &SAVE INB XLA B,I STA Y * LDA XEO,I GET THE E&O REGISTER LDB ASC.0 AND THE ' 0' CLE,SLA O REGISTER SET ? INB YES * LDA X.Y PUT ADDRESS IN TEMP8 JMP GETXY * * X.Y DEF *+1 LOCAL X & Y REGISTER SAVE AREA X NOP Y NOP AB ASC 2,ABE XY ASC 2,XYO ABBUF DEF *+1 DEC -20 ASC 10,ABE XXXXXX XXXXXX X ASC.0 ASC 1, 0 SKP * * SUBROUTINE: <$ERMG> * * PURPOSE: THIS ROUTINE FORMATS A DIAGNOSTIC * MESSAGE WHICH CONTAINS A FOUR * CHARACTER MNEMONIC DESCRIBING THE * ERROR WITH THE PROGRAM NAME AND * LOCATION OF THE ERROR. IT THEN * CALLS THE ROUTINE <$SYMG> TO * OUTPUT THE MESSAGE. * * THE ROUTINE ALSO ATTEMPTS TO RECOVER FROM * PROCESSOR FAILURE. IT SEEMS THAT WHEN THE * CPU HICCUPS CONTROL IS TRANSFERED HERE. * THAT IS, THE HICCUP IS DECODED AS A MP, DM, * OR OTHER TYPE ERROR. IF THERE IS A PROGRAM * CURRENTLY EXECUTING, THEN THAT PROGRAM IS ABORTED * \ AND ALL THE ASSOCIATED PROGRAM CLEAN UP IS DONE * VIA THE CALL TO $ABRT. IF HOWEVER, XEQT = 0, THEN * THERE IS NO ONE TO ABORT & WE'RE IN TROUBLE. * IN THIS CASE THE MESSAGE * * DM VIOL = XXXXX * DM INST = XXXXX OR MP INST = XXXXXX * DM 0 MP 0 * * IS PRINTED AND NO CALL TO $ABRT IS MADE. WHAT THIS * DOES IS TO ALLOW THE SYSTEM TO RECOVER FROM A * CPU FAILURE. * * HINT ! SAVE WHAT YOUR DOING BECAUSE THE SYSTEM * (CPU) IS IN TROUBLE !!! * * NOTE THE FRIENDLINESS, THE OP SYSTEM IS ACTUALLY * PROTECTING THE USER FROM HIS OWN CPU !!!!! * * CALL: (A),(B) CONTAIN A 4 ASCII CHARACTER * MNEMONIC OR CODE DESCRIBING THE ERROR * * (P) JSB $ERMG * (P+1) - RETURN - (REGISTERS MEANINGLESS) * $ERMG JMP EXINT FIRST ENTRY BY JMP GOES TO INIT STA MSG+1 SET ERROR MNEMONIC IN STB MSG+2 FIRST 4 CHARACTERS OF MESSAGE. * $USER NOP RESERVE SPACE FOR USER HANDLING OF ERRORS NOP RESERVE SPACE FOR USER HANDLING OF ERRORS * LDB XEQT GET ID ADDR OF PROGRAM TO ABORT SZB IS THERE ANYBODY TO ABORT ? ADB D8 YES, SO GET POINT OF SUSPENSION ADDRESS STB $SDSK AND SAVE FOR ABORT OPTION ADB D4 SET (B) = ADDRESS OF 3-WORD NAME CPB D4 BUT IF THERE'S NOBODY TO ABORT LDB .INT. GET THE ADDRESS ERAB1 LDA B,I AND SET STA MSG+4 PROGRAM INB NAME LDA B,I IN STA MSG+5 MESSAGE. CLE,INB (E=0 FOR ASCII CONVERSION) LDA B,I AND C377 IOR B40 STA MSG+6 INB GET THE STATUS LDA B,I WORD AND IF RAL,CLE,SLA,ERA ABORT OPTIN IN EFFECT JMP NOABT GO SET IT UP. * ERM CLA POINT OF SUSP = 0 IF $SDSK  = 0 LDA $SDSK,I GET ERROR LOCATION (DON'T USE XSUSP) JSB $CNV3 CONVERT TO OCTAL/ASCII FORMAT LDB A,I MAKE STB MSG+7 5-DIGIT MEMORY ADDRESS. CLE,INA SET DLD A,I GET THE OTHER TWO WORDS DST MSG+8 AND SET IN THE MESSAGE * LDA MSGA CALL TO JSB $SYMG OUTPUT DIAGNOSTIC. * * * DOAB LDA XEQT NOW GO DO ABORT PROCESSING. SZA BUT BE CAREFUL THAT THERE IS JSB $ABRT REALY SOMEONE TO ABORT. * LDA IDLE WHEW ! THAT WAS A CLOSE ONE WE STA $IDLE ALMOST CRASHED !!!!!!!!! JMP $ERMG,I * IDLE DEF $IDLE-1 THIS IS THE ADDRESS OF THE ' JMP * ' D4 DEC 4 D8 DEC 8 C377 OCT 177400 * NOABT ADB DM6 SET A,B ADDRESS STB DSTAD SET DOUBLE STORE ADDRESS DLD DLD MSG+1 GET THE ERROR CODE DST DSTAD,I SET A,B TO THE ERROR CODE DSTAD EQU *-1 DOUBLE STORE ADDRESS * LDA XEQT IS THERE REALY SOMEONE TO ABORT ? SZA,RSS WELL ? JMP ERM NO !!!!! WOW, THAT WAS A CLOSE ONE !!!!!! CCA,CLE USE THE RETURN ADDR - 1 FOR CPB BLANK (BUT IF "MP","RQ","DM","RE", JMP ERM OR "PE" ABORT ANYWAY) ADA RQRTN STA $SDSK,I THE RETURN ADDRESS TO THE PGM. JSB $LIST OCT 501 JMP $ERMG,I RETURN * * DM6 DEC -6 * .INT. DEF *+1 PROCESSOR FAILURE ERROR CODE ASC 3, * * MSGA DEF *+1 * MSG DEC -18 EXINT STB $SDSK,I SET THE TWO SPECIAL ID-SEG. ADDS ASC 1, XOR 40 WHEN EXECUTED BLANK ASC 1, JMP $TRRN GO SET UP RN CODE IF ANY LDB B,I GET THE ADDR OF D.RTR'S ID-SEG. JMP $SCLK GO START THE CLOCK SPC 1 BSS 7+BLANK-* * A EQU 0 B EQU 1 HED * EXEC -- REQUEST CODE TABLE * *** REQUEST CODE TABLE *** * * THIS DEFINES THE RELATION FOR SYSTEM * REQUEST CODES AND CORRESPOND7ING PROCESSORS. * THE TABLE CONSISTS OF ONE-WORD ENTRIES IN * NUMERIC ORDER CORRESPONDING TO THE DEFINED * SYSTEM REQUEST CODES. THE CONTENTS OF EACH * ENTRY IS THE BASE PAGE LINKAGE ADDRESS OF * THE WORD CONTAINING THE ENTRY POINT ADDRESS * * OF THE PROCESSOR. AN -EXT- MUST BE USED * WITH THE -DEF- IN DEFINING THE TABLE. * * THE WORD LABELED -CODE#- CONTAINS THE NEGATIVE OF * ONE + THE TOTAL # OF REQUEST CODES. * EXT $IORQ TBL DEF $IORQ+0 CODE 1 I/O READ DEF $IORQ+0 CODE 2 I/O WRITE DEF $IORQ+0 CODE 3 I/O CONTROL * DEF DISC1+0 CODE 4 DISC TRACK ALLOCATION DEF DISC2+0 CODE 5 DISC TRACK RELEASE * EXT $MPT1 DEF $MPT1+0 CODE 6 PROGRAM COMPLETION * EXT $MPT2 DEF $MPT2+0 CODE 7 OPERATOR SUSPENSION * EXT $MPT3 DEF $MPT3+0 CODE 8 LOAD PROGRAM SEG$MNT * EXT $MPT4 DEF $MPT4+0 CODE 9 SCHEDULE WITH WAIT * EXT $MPT5 DEF $MPT5+0 CODE 10 SCHEDULE PROGRAM * EXT $MPT6 DEF $MPT6+0 CODE 11 REAL TIME/DATE * EXT $MPT7 DEF $MPT7+0 CODE 12 TIME SELECTION * DEF $IORQ+0 CODE 13 I/O DEVICE STATUS * EXT $MPT9 DEF $MPT9+0 CODE 14 GET-PUT STRING * DEF DISCA+0 CODE 15 GLOBAL TRACK ASSIGNMENT DEF DISCB+0 CODE 16 GLOBAL TRACK RELEASE * DEF $IORQ+0 CODE 17 READ CLASS I/O DEF $IORQ+0 CODE 18 WRITE CLASS I/O DEF $IORQ+0 CODE 19 CONTROL CLASS I/O DEF $IORQ+0 CODE 20 WRITE-READ CLASS I/O * EXT $GTIO DEF $GTIO+0 CODE 21 GET CLASS I/O * EXT $MPT8 DEF $MPT8+0 CODE 22 SWAP/CORE USAGE REQUEST * DEF $MPT4+0 CODE 23 SCHEDULE WITH WAIT/WAIT * DEF $MPT5+0 CODE 24 SCHEDULE NO WAIT/WAIT DEF $PTST+0 CODE 25 PARTITION STATUS DEF PTSIZ+0 CODE 26 PARTITION SIZE * * * * DEFINE END OF TABLE AND # ENTRIES IN TABLE. * -ADDITIONAL REQUESTS MAY BE INSERTED * ATh THIS POINT. * TBLE EQU * * * THE NAMTB WHICH FOLLOWS CONTAINS A BIT FOR EACH PRAMETER * IN AN EXEC CALL WHICH SHOULD BE CALLED BY NAME...THAT IS * THE SYSTEM WILL NORMALLY STORE INTO THE LOCATION DEFINED * BY THE PRAMETER. THIS TABLE IS USED TO CHECK SUCH * PRAMETERS TO SEE IF THEY ARE ABOVE THE CURRENT * FENCE ADDRESS. * * 8 BITS ARE DEVOTED TO EACH CALL. THE LEAST BIT REFERS * TO PRAMETER NUMBER TWO AND SO ON. * THE 'L' AND 'H' NUMBERS ARE SET UP TO REFER TO EACH * PRAMETER BY NUMBER WHERE L REFERS TO THE LOW OR ODD * CALL FOR EACH WORD AND H REFERS TO THE HIGH OR EVEN CALL. * H = HIGH(EVEN CALL) * L = LOW(ODD CALL) * NAMTB ABS L3 0/1 (READ BUFFER) ABS 0 2/3 ABS H3+H4+H5 4/5 (ALLOCATE PRAMS) ABS 0 6/7 ABS L8 8/9 (SCHEDULE) ABS L2+L3+H8 10/11 (SCHED WWAIT),(TIME VALUES) ABS L3+L4+L5 12/13 (STAT RETURN) ABS L3+L4+L5+H3 14/15 (G/S PRM.ST),(GL.ALC.PRM) ABS L7 16/17 (CLASSWORD FOR 17,18,20) ABS H7+L4 18/19 (CLASSWORD) ABS H7+L3+L5+L6+L7 20/21 (CLASSWORD,BUFFER,AND OPT PRAMS) ABS L8 22/23 (SCHEDULE W WAIT/WAIT) ABS L3+L4+L5+H8 24/25 (SCHEDULE NO WAIT/WAIT),(PART.STATUS) ABS H5+H4+H3+H2 26/- (PARTITION SIZE INFO/---) SPC 2 L2 EQU 1 L3 EQU 2 L4 EQU 4 L5 EQU 10B L6 EQU 20B L7 EQU 40B L8 EQU 100B H2 EQU 400B H3 EQU 1000B H4 EQU 2000B H5 EQU 4000B H6 EQU 10000B H7 EQU 20000B H8 EQU 40000B HED * * SYSTEM BASE PAGE COMMUNICATION AREA * * . EQU 1650B ESTABLISH ORIGIN OF AREA * * SYSTEM TABLE DEFINITION * * XIDEX EQU .-3 ADDRESS OF CURRENT ID EXTENSION XMATA EQU .-2 $MATA ADDRESS FOR CURRENT PROGRAM XI EQU .-1 X,Y SAVE ADDRESS EQTA EQU .+0 FWA OF EQUIPMENT TABLE EQT# EQU .+1 # OF EQT ENTRIES DRT EQU .+2 FWA OF DEVICE RSNLHEFERENCE TABLE LUMAX EQU .+3 # OF LOGICAL UNITS (IN DRT) INTBA EQU .+4 FWA OF INTERRUPT TABLE INTLG EQU .+5 # OF INTERRUPT TABLE ENTRIES TAT EQU .+6 FWA OF TRACK ASSIGNMENT TABLE KEYWD EQU .+7 FWA OF KEYWORD BLOCK * * I/O MODULE/DRIVER COMMUNICATION * EQT1 EQU .+8 ADDRESSES EQT2 EQU .+9 EQT3 EQU .+10 OF EQT4 EQU .+11 EQT5 EQU .+12 CURRENT EQT6 EQU .+13 EQT7 EQU .+14 15 - WORD EQT8 EQU .+15 EQT9 EQU .+16 EQT EQT10 EQU .+17 EQT11 EQU .+18 ENTRY EQT12 EQU .+81 EQT13 EQU .+82 EQT14 EQU .+83 EQT15 EQU .+84 * CHAN EQU .+19 CURRENT DMA CHANNEL # TBG EQU .+20 I/O ADDRESS OF TIME-BASE CARD SYSTY EQU .+21 EQT ENTRY ADDRESS OF SYSTEM TTY * * SYSTEM REQUEST PROCESSOR /'EXEC' COMMUNICATION * * RQCNT EQU .+22 # OF REQUEST PARAMETERS -1 RQRTN EQU .+23 RETURN POINT ADDRESS RQP1 EQU .+24 ADDRESSES RQP2 EQU .+25 RQP3 EQU .+26 OF REQUEST RQP4 EQU .+27 RQP5 EQU .+28 PARAMETERS pFNRQP6 EQU .+29 RQP7 EQU .+30 (SET FOR MAXIMUM OF RQP8 EQU .+31 9 PARAMETERS) RQP9 EQU .+32 * * DEFINITION OF SYSTEM LISTS (QUEUES) * * SKEDD EQU .+33 'SCHEDULE' LIST, SUSP3 EQU .+36 'AVAILABLE MEMORY' LIST, SUSP4 EQU .+37 'DISC ALLOCATION' LIST, SUSP5 EQU .+38 'OPERATOR SUSPEND' LIST * DEFINITION OF EXECUTING PROGRAM ID SEGMENT' * * XEQT EQU .+39 ID SEGMENT ADDR. OF CURRENT PROG. XLINK EQU .+40 'LINKAGE' XTEMP EQU .+41 'TEMPORARY (5-WORDS) XPRIO EQU .+46 'PRIORITY' WORD XPENT EQU .+47 'PRIMARY ENTRY POINT' XSUSP EQU .+48 'POINT OF SUSPENSION' XA EQU .+49 'A REGISTER' AT SUSPENSION XB EQU .+50 'B REGISTER' XEO EQU .+51 'E AND OVERFLOW * * SYSTEM MODULE COMMUNICATION FLAGS * * OPATN EQU .+52 OPERATOR/KEYBOARD ATTENTION FLAG OPFLG EQU .+53 OPERATOR COMMUNICATION FLAG SWAP EQU .+54 RT DISC RESIDENT SWAPPING FLAG DUMMY EQU .+55 I/O ADDRESS OF DUMMY INT. CARD IDSDA EQU .+56 DISC ADDR. OF FIRST ID SEGMENT IDSDP EQU .+57 -POSITION WITHIN SECTOR * * DEFINITION OF MEMORY ALLOCATION BASES * * BPA1 EQU .+58 FWA R/T DISC RES. BP LINK AREA BPA2 EQU .+59 LWA R/T DISC RES. BP LINK AREA BPA3 EQU .+60 FWA BKG DISC RES. BP LINK AREA LBORG EQU .+61 FWA OF RESIDENT LIBRARY AREA RTORG EQU .+62 FWA OF REAL-TIME AREA RTCOM EQU .+63 LENGTH OF REAL TIME COMMON AREA RTDRA EQU .+64 FWA OF R/T DISC RESIDENT AREA AVMEM EQU .+65 FWA OF SYSTEM AVAILABLE MEMORY BKORG EQU .+66 FWA OF BACKGROUND AREA BKCOM EQU .+67 LENGTH OF BABKGSMUND COMMON AREA BKDRA EQU .+68 FWA OF BKG DISC RESIDENT AREA * * UTILITY PARAMETERS * TATLG EQU .+69 LENGTH OF TRACK ASSIGNMENT TABLE TATSD EQU .+70 # OF TRACKS ON SYSTEM DISC SECT2 EQU .+71 # SECTORS/TRACK ON LU 2 (SYSTEM) SECT3 EQU .+72 # SECTORS/TRACK ON LU 3 (AUX.) DSCLB EQU .+73 DISC ADDR OF RES LIB ENTRY PTS DSCLN EQU .+74 #   OF RES LIB ENTRY POINTS DSCUT EQU .+75 DISC ADDR OF RELOC UTILITY PROGS DSCUN EQU .+76 # OF RELOC UTILITY PROGS LGOTK EQU .+77 LOAD-N-GO: LU,STG TRACK,# OF TRKS LGOC EQU .+78 CURRENT LGO TRACK/SECTOR ADDRESS SFCUN EQU .+79 SOURCE FILE LU AND DISC ADDRESS MPTFL EQU .+80 MEMORY PROTECT ON/OFF FLAG (0/1) FENCE EQU .+85 MEM PROTECT FENCE ADDRESS BKLWA EQU .+87 LWA OF MEMORY IN BACKGROUND * ORG * PROGRAM LENGTH P END $RQST B  0 92067-18020 1805 S C0122 &$TRN4 RTE-IV TRRN             H0101 c5ASMB,R,L,C ** $TRRN RN-LU SYSTEM ROUTINES ** HED ** REAL-TIME EXECUTIVE $TRRN RN-LU SYSTEM ROUTINES ** * NAME: $TRRN * SOURCE: 92067-18020 * RELOC: PART OF 92067-16014 * PGMR: G.A.A.,C.M.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM $TRN4,0 92067-16014 REV.1805 780104 * EXT $RNTB,$IDNO,$SCD3,$SCLK,$ULLU,$CGRN ENT $TRRN,$CRN#,$ULU * SUP A EQU 0 B EQU 1 * * * $TRRN IS THE RN/LU LOCK CLEAN UP ROUTINE. * IT IS CALLED BY THE DISPATCHER WHEN EVER A PROGRAM COMPLETES * (THE CALL IS BY WAY OF THE REENTRENT CLEAN UP ROUTINE. * * ITS FUNCTION IS TO RELEASE ANY LOCAL LOCKS AND ANY LOCAL * ALLOCATIONS THE PROGRAM HAS. IT ALSO RELEASES ANY LU * LOCKS THE PROGRAM HAS. * * CALLING SEQUENCE: * * LDB ID-SEGMENT ADDRESS * JSB $TRRN * NORMAL RETURN REGISTERS MEANING LESS * * $TRRN JMP TEMP1 INITIALIZATION ON FIRST JMP HERE JSB $ULLU RELEASE ANY LU LOCKS / SET UP TEMPS LDA D$RN SET THE TABLE ADDRESS FOR STA TEMP1 BOTH LOOPS STA TEMP2 LDA A,I GET THE TABLE SIZE CMA,INA,SZA,RSS SET NEGATIVE / IF ZERO EXIT JMP $TRRN,I * STA TEMP3 SET LOOP COUNTERS STA RQP8 FOR BOTH LOOPS * TRRN1 ISZ TEMP2 DALLOCATE LOOP LDA TEMP2,I GET THE RN ALF,ALF PUT OWNER FLAG IN LOW A AND B377 MASK CPA RQP5 IF OWNED BY COMPLETING STA TEMP2,I PROGRAM FLAG FOR NEXT LOOP ISZ RQP8 STEP COUNTER JMP TRRN1 LOOP IF NOT DONE * TRRN3 ISZ TEMP1 uLOCAL LOCK LOOP LDA TEMP1,I GET THE RN AND B377 IF LOCAL LOCK CPA RQP5 TO COMPLETING PROGRAM JMP TRRN6 GO RELEASE THE LOCK * TRRN4 ISZ TEMP3 STEP COUNT JMP TRRN3 IF NOT DONE LOOP * LDB TEMP2 GET THE DEALLOCATE FLAG LDA D$RN AND THE ALLOCATE SUSPEND FLAG SZB,RSS IF ANY DEALLOCATED JSB $SCD3 SCHEDULE ANY WAITING PROGRAMS JMP $TRRN,I RETURN * TRRN6 XOR TEMP1,I CLEAR THE LOCK STA TEMP1,I FLAG AND RESET SZA,RSS IF DEALLOCATED STA TEMP2 SET FLAG FOR END OF LOOP JSB SRNW SCHEDULE ANY WAITERS FOR THIS RN JMP TRRN4 RETURN TO LOOP SKP * $CGRN IS THE CLEAR GLOBAL RN ROUTINE FOR USE BY DRIVERS * AND OTHER SUCH USER WRITTEN SYSTEM PROGRAMS * * CALLING SEQUENCE: * * LDA RN SET A TO USER RN WORD * JSB $CGRN CALL THIS ROUTINE * RETURN REGISTERS MEANING LESS. * $CRN# RBL,RBL SET DMS STATUS FOR OUR STB DMRTN RETURN STA B SAVE THE RN NUMBER AND B377 CACULATE THE TABLE ADA D$RN ADDRESS STA TEMP1 AND SET IT LDA B GET RN WORD AGAIN IOR B377 SET THE GLOBAL FLAG CPA TEMP1,I IS THIS A LEGAL RN? RSS YES SKIP JMP DONE NO RETURN NO ACTION AND C377 CLEAR THE RN STA TEMP1,I AND RESET IT JSB SRNW SCHEDULE ANY WAITING PROGRAMS DONE JRS DMRTN $CGRN,I RETURN TO CALLER SPC 3 * SRNW SCHEDULES ANY PROGRAMS SUSPENDED IN THE '3' LIST * WITH A FLAG = (TEMP1) (USUALLY RN LOCK REQUEST SUSPEND) * SRNW NOP LDA TEMP1 GET THE FLAG WORD JSB $SCD3 SCHEDULE ALL SUCH WAITERS JMP SRNW,I RETURN SKP * * THIS SUBROUTINE RELEASES ALL LU'S LOCKED BY A PROGRAM * AND SCHEDULES ANY PROGRAMS WAITING FOR AN * LU OR AN RN. * * CALLING SEQUENCE: * ݫ * LDB ID ADDRESS * JSB $ULLU * RETURN - REGISTERS MEANNINGLESS * $ULU RAL,RAL FIX STATUS FOR RETURN STA DMRTN AND SAVE JSB $IDNO GET THE ID NUMBER STB RQP5 SET FOR $TRRN BLF,BLF PUT THE FLAG WORD STB RQP6 IN HIGH END ADB RQP5 AND IN BOTH ENDS STB RQP7 SET IN RQP7 LDA LUMAX SET UP TO SCAN THE CMA,CLE,INA DRT STA TEMP2 * LDA DRT GET THE DRT ADDRESS STA TEMP3 AND SET FOR LOOP ULLU1 LDA TEMP3,I SEARCH FOR ALL AND B3700 LOCKED LU'S SZA THIS ONE LOCKED? JMP ULLU4 YES - GO TEST * ULLU2 ISZ TEMP3 NO / YES STEP TO NEXT ENTRY ISZ TEMP2 IF NOT DONE JMP ULLU1 TRY NEXT ONE * CLB,SEZ,RSS IF NONE RELEASED JMP RTNDM JUST EXIT * STB TEMP1,I CLEAR THE RN JSB SRNW SCHEDULE RN WAITERS LDA D$RN AND ALLOCATION JSB $SCD3 WAITERS RTNDM JRS DMRTN $ULLU,I RETURN * DMRTN NOP DMS STATUS WORD * ULLU4 CLB LSL 10 SHIFT LOCK FLAG TO LOW B ADB D$RN AND INDEX INTO THE RN TABLE LDA B,I GET THE RN FLAG CPA RQP7 CURRENT PROGRAM? CCE,RSS YES SKIP JMP ULLU2 NO CONTINUE SEARCH * STB TEMP1 YES SET ADDRESS FOR SCHEDULE LDA TEMP3,I GET THE DRT ENTRY AND C3700 CLEAR THE FLAG STA TEMP3,I RESET IT AND JMP ULLU2 CONTINUE SEARCH * D$RN DEF $RNTB B377 OCT 377 C377 OCT 177400 B3700 OCT 3700 C3700 OCT 174077 SPC 2 TEMP1 STA D$RN INITIALIZE CODE TEMP2 LDB B,I GET ADDRESS OF TEMP3 JMP $SCLK D.RTR AND GO START CLOCK * DRT EQU 1652B LUMAX EQU 1653B RQP5 EQU 1704B RQP6 EQU 1705B RQP7 EQU 1706B RQP8 EQU 1707B * ORG * PROGRAM LENGTH END $TRRN K  92067-18021 1840 S 0722 RTE-IV SCHEDULAR              H0107 !cASMB,R,Q,C ** RT SCHEDULER MODULE ** HED RTE SCHEDULER/MESSAGE PROCESSOR * NAME: SCHED * SOURCE: 92067-18021 * RELOC: 92067-16021 * PGMR: G.A.A.,L.W.A.,D.L.S.,C.M.M. * DATA: 1/1/78 * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM SCHD4,0 92067-16014 REV.1840 780727 * SUP PRESS EXTRANIOUS LISTING ******************************************************************* * HISTORY * * *G.A.A. RTE 2 VERSION JULY 1973 *L.W.A. RTE 3 VERSION APRIL 1975 *D.L.S. ENHANCEMENTS MAY 1977 *C.M.M. RTE 4 VERSION JAN 1978 * ******************************************************************* * * SCHED ENTRY POINT NAMES * ENT $ABRT,$TYPE,$PRSE,$CNV1,$CNV3,$OP ENT $MPT1,$MPT2,$MPT3,$MPT4,$MPT5,$MPT6 ENT $STRT,$INER,$MPT7,$ASTM,$WATR,$SZIT ENT $MPT8,$IDSM,$PBUF ENT $MPT9,$RTST,$CVWD,$STRG ENT $MSEX,$LSTM ENT $LST,$SCD,$ID#,$MSG,$SCXX * * SCHED EXTERNAL REFERENCE NAMES * EXT $XSIO,$IOUP,$IODN,$ERMG,$DREQ EXT $DLP,$PLP,$MPFT,$MEU EXT $CMST,$COML,$SDA,$SDT2,$RLB,$RLN EXT $MPSA,$MPS2,$IDEX EXT $IOCL,$OTRL,$DREL,$CHTO,$LUPR,$EQST EXT $MESS,$LIST,$IDNO,$SCD3,$CNFG EXT $ERAB,$ZZZZ,$TIME,$PVCN,$MNP EXT $ERIN,$NOPG,$OPER,$ILST,$NOLG,$LGBS,$NMEM EXT $XEQ,$TMRQ,$ONTM,$ALC,$RTN,$WORK EXT $BRED,$TIMR,$ETTM,$TIMV,$TREM EXT $RNTB,$CREL,$SYMG,$SDRL EXT $ALDM,$DMAL,$MATA,$PRCN EXT $MBGP,$MRTP,$MCHN,$MAXP ALDM EQU $ALDM DMAL EQU $DMAL PRCNG EQU $PRCN * * ******************s*MEU INSTRUCTIONS*********** ********************************************** EXT $BLLO,$BLUP * ******************************************************************* * * THE SCHED MODULE OF HP2100 REAL TIME EXECUTIVE CONSISTS OF * * 1. LIST PROCESSORS * 2. LINK PROCESSORS * 3. OPERATOR INPUT MESSAGE PROCESSORS * 4. SYSTEM START UP AND OPER INPUT REQUEST ACKNOWLEDGE * 5. MEMORY PROTECT VIOLATION SCHEDULER PREPROCESSORS * 6. ABORT AND TERMINATION PROCESSORS * ******************************************************************* HED --BUFFERS, CONSTANTS, POINTERS, ETC * TEMP LDA EQT11 ***TEMPORARY WORKING STORAGE AREA TEMP1 STA TEMP5 * TEMP2 LDB EQT12 * TEMP3 STB TEMP6 * TEMP4 JSB $RTN * THESE TEMPS ARE USED TO INITIALIZE TEMP5 NOP *** SYSTEM AVAILABLE MEMORY. TEMP6 NOP * AND ALSO TMP JMP $ALC * USED BY $PARS AS CONTIGUOUS BUFFER SPACE NOP ?? WORK EQU $WORK WPRIO NOP * ASCI BSS 1 * ASCI1 BSS 1 *** ASCI2 BSS 1 DM5 DEC -5 * D2 DEC 2 D4 DEC 4 D5 DEC 5 D6 DEC 6 D7 DEC 7 D9 DEC 9 D14 DEC 14 D15 DEC 15 D17 DEC 17 * D1 OCT 1 D3 DEC 3 B77 OCT 77 B177 OCT 177 B377 OCT 377 * ZERO REP 5 NOP DEF0 DEF ZERO * * RETRN NOP DMST NOP DMM5 DEC -5 D22 DEC 22 NWCNT NOP HED ID-SEGMENT MAP ID-SEGMENT MAP ID-SEGMENT MAP * WORD USE * 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 0 * ! ! ! ! ! ! * 1 LIST LINKAGE * ! ! ! ! ! ! * 2-6 5 WORD TEMPORARY AREA USED FOR SPECIAL FLAGS IN QUEUES ETC. * ! ! ! ! ! ! * 7 PRIORITY * ! ! ! ! ! ! * @ 8 PRIMARY ENTRY POINT * !  ! ! ! ! ! * 9 POINT OF SUSPENSION (XSUSP) * ! ! ! ! ! ! * 10 A REGISTER AT SUSPENSION (XA) * ! ! ! ! ! ! * 11 B REGISTER AT SUSPENSION (XB) * ! ! ! ! ! ! * 12 E/O REGISTERS AT SUSPENSION (XEO) * ! ! ! ! ! ! * @ 13 NAME ( FIRST AND SECOND CHARACTERS ) * ! ! ! ! ! ! * @ 14 NAME (THIRD AND FOURTH CHARACTERS) * ! ! ! ! ! ! * @ 15 NAME (FIFTH CHARACTER)---- TM CL AM SS --- TYPE --- * ! ! ! ! ! ! * 16 NA NP W A O R D --- STATUS- * ! ! ! ! ! ! * 17 TIME LIST LINKAGE WORD * ! ! ! ! ! ! * @ 18 RESOLUTION T -------MULTIPLE----------------------- * ! ! ! ! ! ! * @ 19 LOW ORDER 16 BITS OF EXECUTE TIME LESS 24 HRS IN 10'S MS. * ! ! ! ! ! ! * @ 20 HIGH ORDER 16 BITS OF EXECUTE TIME * ! ! ! ! ! ! * 21 BA FW AT RM RE PW RN --FATHER ID-SEG. NUMBER-- * ! ! ! ! ! ! * 22 RP ---# OF PAGES---,--MPFTI-- .. ----PARTITION #---- * ! ! ! ! ! ! * @ 23 LOW MAIN ADDRESS * ! ! ! ! ! ! * @ 24 HI MAIN ADDRESS + 1 * ! ! ! ! ! ! * @ 25 LOW BASE PAGE ADDRESS * ! ! ! !  ! ! * @ 26 HI BASE PAGE ADDRESS + 1 * ! ! ! ! ! ! * @ 27 DISC ADDRESS (LU (15),TRACK (14-7),SECTOR(6-0) * ! ! ! ! ! ! * 28 SWAP DISC ADDRESS (LU (15),TRACK (14-7),#TRACKS(6-0) * ! ! ! ! ! ! * 29 ID EXTENSION # (15-10) EMA SIZE (9-0) * ! ! ! ! ! ! * 30 HIGH MAIN + LARGEST SEGMENT + 1 ( = 0 IF NO SEGMENT) * ! ! ! ! ! ! * 31 SESSION MONITOR WORD 1 * ! ! ! ! ! ! * 32 SESSION MONITOR WORD 2 * ! ! ! ! ! ! * 33 SESSION MONITOR WORD 3 * ! ! ! ! ! ! * 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 0 * * @ WORDS USED IN SHORT ID SEGMENTS SPC 5 * <<<<<<<<<>>>>>>>> SPC 5 * 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 0 * * 1 NS / CURRENT MSEG # / # PAGES MSEG * ! ! ! ! ! ! * 2 MSEG STRT PAGE #/DE/ EMA START PAGE PHYSICAL * ! ! ! ! ! ! * 3 /# OF TRACKS FOR EMA SWAP * 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 0 SKP * WHERE THE FLAG BITS MEAN: * * TM = TEMP LOAD (COPY OF ID-SEG NOT ON DISC) * CL = CORE LOCK (MAY NOT SWAP) * AM = ALL MEMORY (PROGRAM USES ALL OF ITS AREA) * SS = SHORT SEGMENT (INDICATES A 9-WORD ID-SEGMENT) * NA = NO ABORT (PASS ABORT ERRORS TO THE PROGRAM INSTEAD) * NP = NO PRAMS ALLOWED ON RESCHEDULE. * W = WAIT BIT (WAITING FOR PROG. WHOES ID-SEG ADD. IS IN WD.2) * A = ABORT ON NEXT LIST ENTRY FOR THIS PGM. * O = OPERATOR SUSPEND ON NEXT SCHEDULE ATTEMPT * R = RESOURCE SAVE (SAVE RESOURCES WHEN SETING DORMANT) * D = DORMANT BIT (SET DORMANT ON NEXT SCHEDULE ATTEMPT) * T = TIME LIST ENTRY BIT (PROG IS IN THE TIME LIST) * BA = BATCH (PROGRAM IS RUNNING UNDER BATCH) * FW = FATHER IS WAITING (HE SCHEDULE WITH WAIT) * AT = ATTENTION BIT (OPERATOR HAS REQUESTED ATTENTION) * RM = RE-ENTRENT MEMORY MUST BE MOVED BEFORE DISPATCHING PGM. * RE = RE-ENTRENT ROUTINE IN CONTROL NOW * PW = PROGRAM WAIT (SOME PROGRAM WANTS TO SCHEDULE THIS ONE ) * RN = RESOURCE NUMBER EITHER OWNED OR LOCKED BY THIS PGM. * RP = RESERVED PARTITION FOR REQUESTING PROGRAMS ONLY. * NS = 0/1 MSEG POINTING TO STD SEGMENT(SET BY .EMAP) / * MSEG POINTING TO NON STD SEG (SET BY .EMIO)/ * DE = SET IF EMA SIZE WAS DEFAULTED * * * $LIST STATE TRANSITION TABLE: * * THE FOLLOWING TABLE DETAILS THE STATE TRANSITIONS EFFECTED BY * $LIST. THE MAJOR STATES ARE 0 THRU 6 (DORMANT THRU OP-SUSP) * AND THE STATE MODIFIERS ARE THE ADDITIONAL BITS SET FROM TIME * TO TIME IN THE STATUS WORD. THE BITS WHICH AFFECT OR ARE * MODIFIED BY $LIST ARE (SEE ABOVE DESCRIPTION): * * BIT WEIGHT POSITION * O 10 9 * W 4 12 * R 2 7 * D 1 6 * * * 0- OP SUSPEND BIT IS A DEFERRED ACTION BIT. SUSPEND ON NEXT SCHEDULE * ATTEMPT. CAN'T DO IT NOW BECAUSE PROGRAM IS OP SUSPENDED OR * IN THE TIME LIST. * * W- WAIT BIT (EXEC 9 & 23) THIS PROGRAM SCHEDULED ANOTHER WITH WAIT. * ID ADDRESS OF PERSON HE SCHEDULED IS IN 2ND OF WORD OF ID. * * R- SAVE RESOURCES WHEN SETTING DORMANT. NOT LEFT IN ID SEG AFTER * PROG IS SET DORMANT. * * D- DORMANT BIT IS A DEFERRED ACTION BIT. IT MEANS TO SET THE * PROGRAM DORMANT ON THE NEXT SCHEDULE ATTEMPT. WE CAN'T DO IT * NOW BECAUSE HE IS I/O SUSPENDED. * * * * *   THESE BITS ARE COMBINED TO FORM 16 SUBSTATES AS PER THE TABLE BELOW * THE ENTRYS IN EACH SQUARE OF THE TABLE DEFINE THE NEXT STATE AS * FOLLOWS: * * THE FIRST DIGIT IS THE REQUESTED MAJOR TRANSITION (FROM * THE $LIST CALL). * THE SECOND TWO NUMBERS (SEPERATED BY A ".") DEFINE THE NEXT * MAJOR STATE . SUBSTATE. THUS 62.10 INDICATES A OP-SUSPEND * REQUEST (6) CAUSES A MOVEMENT TO I/O SUSPEND (2) SUBSTATE 10 * (THE O BIT IS SET). * A "*" AS THE DESTINATION INDICATES THE CURRENT STATE/SUB- * STATE I.E. NO CHANGE. * ILLEGAL OR UNEXPECTED STATES ARE MARKED WITH "X" * ONLY EXPECTED CALLS ARE PLOTTED. * * IN GENERAL CODE EXTERNAL TO $LIST MOVES PROGRAMS FROM SUB-STATE * TO SUB-STATE WHILE ONLY $LIST CAN MOVE A PROGRAM FROM ONE * MAJOR STATE TO ANOTHER. * * ONE FINAL NOTE TO THE UNWARY. THE CODE OF THE LIST PROCESSOR * IN NO WAY FOLLOW THE CHART BELOW. THE CHART IS TO GIVE THE * READER AN IDEA OF WHAT THE FOREST LOOKS LIKE NOT THE TREES. * DON'T MAKE THE MISTAKE OF THINKING THAT THE CHART SHOWS HOW * ANYTHING IS DONE. HED SYSTEM STATE TABLE******SYSTEM STATE TABLE*** *MAJOR STATE 0 1 2 3 4 5 6 *SUB-STATES *---------!-----!-------!-------!-------!-------!-------!------ * 0 11.0 00.0 02.1 00.0 00.0 00.0 00.0 * 22.0 11.0 11.0 11.0 11.0 11.0 * 33.0 62.10 66.0 66.0 66.0 * 44.0 * 55.0 * 66.0 *---------!-----!-------!-------!-------!-------!-------!------ * 1 D X X 02.1 X X X X * 10.0 * 62.11 *---------!-----!-------!-------!-------!-------!-------!------ * 2 R 11.0 00.2 02.3 00.2 00.2 00.2 06.3 * 66.3 *---------!-----!-------!-------!-------!-------!-------!------ * 3 RD X X D 0* X X X 0* * 10.2 10.2 *---------!-----!-------!-------!-------!-------!-------!------ * 4 W 00.0 33.4 00.0 00.0 00.0 00.0 00.0 * 1* 13.4 * 66.4 *---------!-----!-------!-------!-------!-------!-------!------ * 5 WD X X X X X X X *---------!-----!-------!-------!-------!-------!-------!------ * 6 WR 0* X X 00.6 X X 06.7 * 13.4 * 66.7 *---------!-----!-------!-------!-------!-------!-------!------ * 7 WRD X X X X X X 0* * 10.6 *---------!-----!-------!-------!-------!-------!-------!------ * 10 O 16.0 X 02.11 X X X X * 16.0 * 6* *---------!-----!-------!-------!-------!-------!-------!------ * 11 OD X X 0* X X X X * 10.0 * 6* *---------!-----!-------!-------!-------!-------!-------!------ * 12 OR X X 02.13 X X X X *---------!-----!-------!-------!-------!-------!-------!------ * 13 ORD X X 0* X X X X * 16.3 * 6* *---------!-----!-------!-------!-------!-------!-------!------ * 14 OW X X X X X X X *---------!-----!-------!-------!-------!-------!-------!------ * 15 OWD X X X X X X X *---------!-----!-------!-------!-------!-------!-------!------ * 16 OWR X X X X X X X *---------!-----!-------!-------!-------!-------!-------!------ * 17 OWRD X X X X X X X *-------"--!-----!-------!-------!-------!-------!-------!------ HED REAL TIME SCHEDULER---LIST PROCESSOR SECTION--- * * THE $LIST PROCESSOR SECTION OF THE HP-2100 REAL TIME * EXECUTIVE PROCESSES THE FOLLOWING LIST REQUESTS * 1. DORMANT * 2. SCHEDULE * 3. OPERATOR SUSPEND * 4. NON-OPERATOR SUSPEND * A. I/O * B. MEMORY AVAILABLE * C. DISC AVAILABLE * 5. SEGMENT LOADING * * * * CALLING SEQUENCE * * JSB $LIST * OCT (ADDRESS CODE)(FUNCTION CODE) * DEF (ADDRESS) * * IF A = 0, THEN NO MESSAGE & B = PROG ID ADDRESS * IF A NOT= 0, THE A = ASCII ERROR CODE ADDRESS * & B CONTAINS DECIMAL ERROR CODE * * * ADDRESS CODES OF 0, 6, & 7 ARE RESERVED FOR * DRIVERS. THE ONLY FUNCTION CODE ALLOWED WITH * THESE ADDRESS CODES IS 1 (SCHEDULE) * IF SUCCESSFUL A = 0 ELSE * B = 3 ILLEGAL STATUS * B = 5 NO SUCH PROG * * FOR A DRIVER THAT WANTS TO CONVERT A PROG NAME * TO AN ID ADDRESS : JSB $LIST * OCT 217 * DEF PNAME (PROG NAME) * * THIS PERFORMS A SIMPLE LIST MOVE LIKE CHANGES TO PRIORITY. * (IF THE PROGRAM IS DORMANT ITS A BIG NOP ). UPON * A SUCCESSFUL RETURN (A = 0) B WILL BE THE ID ADDRESS * OF THE PROGRAM. IF THE PROGRAM IS SCHEDULED MANY TIMES * DOING THIS REMOVES THE SEARCH TIME FOR THE ID SEG OF * THE PROGRAM. * * FUNCTION CODE * 0 = DORMANT REQUEST * 1 = SCHEDULE REQUEST * 2 = I/O SUSPEND REQUEST * 3 = GENERAL WAIT LIST REQUEST * 4 = MEMOJRY AVAILABEL REQUEST * 5 = DISK ALLOCATION REQUEST * 6 = OPERATOR SUSPEND REQUEST * 17 = RELINK PROGRAM REQUEST * 10 THRU 16 ARE NOT ASSIGNED * * ADDRESS CODE * 0 = ID SEGMENT ADDRESS(5 PARAMETERS PASSED) * 1 = ID SEGMENT ADDRESS(AS NEXT OCT VALUE) * 2 = ASCII PROGRAM NAME ADDRESS(A DEF) * 3 = ID SEGMENT ADDRESS IN WORK * 4 = ID SEGMENT ADDRESS IN B-REG * 5 = ID SEGMENT ADDRESS IN XEQT * 6 = ID SEGMENT ADDRESS (NEXT PRAM IS VALUE TO * PUT INTO B REG @ SUSP) * 7 = ASCII PROG NAME (PASSES 5 PARAMETERS) * * * * FOR EXAMPLE * * ---0,7,& 6 (FOR DRIVERS)------- ---1---- ---2---- ----3----- * - - - - - - - - * * JSB $LIST JSB $LIST JSB $LIST JSB $LIST JSB $LIST JSB $LIST * OCT 001 OCT 701 OCT 601 OCT 1XX OCT 2XX OCT 3XX * DEF RETRN DEF RETRN OCT IDADR OCT IDADR DEF PNAME ID ADR IN $WORK * OCT IDADR DEF PNAME OCT BVAL * DEF PRAM1 DEF PRAM1 * DEF PRAM2 DEF PRAM2 * DEF PRAM3 DEF PRAM3 (NO INDIRECT DEFS !!) * DEF PRAM4 DEF PRAM4 * DEF PRAM5 DEF PRAM5 * * * * ---4----- ------5-------- * - - - - * * JSB $LIST JSB $LIST * OCT 4XX OCT 5XX * ID ADR IN B REG ID ADR IN XEQT * * * * * SKP * * ************** WATCH THE E REGISTER ****************** * * * ENTRY MADE BY $LIST NOP * RSA * SJP $LIST * * $LST RAL,RAL ROTATE THE DMS STATUS AND SAVE STA DMST NOW PUT DMS STATUS IN E-REGISTER RAL,ELA E = 0/1 CALL/ CAME FROM SYS/USER MAP * LDA $LIST GET ADDRESS OF CALL STA $LSTM SAVE FOR CRASH DUMP ANALIZER ( HOPE WE * NEVER USE IT !!!!!!) SEZ (E= 0/1 CAME FROM SYS/USER MAP) JMP UMAP1 CALL CAME FROM THE USER MAP ! * LDA $LIST,I CALL FROM SAME MAP (SYSTEM MAP) AND D15 PUT FUTURE STATUS INTO L0091 STA L0091 STORE AWAY FUNCTION CODE XOR $LIST,I FORM ADDR CODE * LIST1 ALF,ALF AND PUT INTO LOW END RAL,RAL CPA D4 ADDRESS IN B-REG? JMP L0021 YES GO SET UP CPA D3 ADDRESS IN WORK? JMP L0060 YES GO SET UP LDB XEQT PRESET FOR CURRENT EXECUTING PGM. CPA D5 CURRENT PGM? JMP L0021 YES GO SET IT UP ISZ $LIST STEP TO ADDRESS WORD * SEZ WHICH MAP ? JMP UMAP2 USER MAP (ALTERNATE MAP) * LDB $LIST,I THIS MAP SO GET IT TO B LIST2 CPA D1 IS ADDRESS NOW IN B? JMP L0021 YES GO SET IT UP * CPA D2 DOES B POINT TO AN ASCII NAME ? JMP DL02 YES SO SEE IF THE PROGRAM EXISTS CPA D6 JMP DL06 * STB RETRN B MUST BE A RETURN ADDRESS ISZ $LIST BUMP TO THE PROGRAM ADDRESS OR NAME LDB $LIST AND SAVE AS A POINTER STB TEMP1 FOR PARAMETER PASSING LDB RETRN GET THE RETURN ADDRESS CMB,INB DECREMENT WITHOUT AFFECTING E-REG CMB STB $LIST THIS THEN SETS UP RETURN ADDRESS * SEZ WHICH MAP JMP UMAP3 STILL THE USER MAP LDB TEMP1,I GET THE ID ADDRESS OR PROG NAME ADDR * LIST3 CPA D7 ASCII PROGRAM NAME ? JMP DL07 YES SZA,RSS ID ADDRESS JMP DL00 YES * * * L0075 LDA $ILST ILLEGAL STATUS MESSAGE LDB D3 ILLEGAL STATUS ERROR CODE JMP L0015 * SPC 6 * * * * UMAP1 XLA $LIST,I GET 7tTHE REQUEST CODE AND D15 SAVE LOWER BITS STA L0091 SOCK IT AWAY AS FUTURE STATE OF PROGRAM XLA $LIST,I GET IT AGAIN XOR L0091 NOW GET THE UPPER BITS JMP LIST1 NOW GO SEE WHAT TYPE CALL * * UMAP2 XLB $LIST,I GET POSSIBLE ID ADDRESS JMP LIST2 AND CONTINUE * * UMAP3 XLB TEMP1,I GET ID ADDRESS OF PROGRAM NAME ADDRESS & JMP LIST3 CONTINUE HED LIST PROCESSOR--REQUEST CODE DETERMINATION * * PROCESS ID SEGMENT ACCORDING TO REQUEST CODE * DL02 SEZ IS NAME IN THIS MAP JSB PLNAM NO, SO PULL IT IN LOCALLY JSB TNAME NOW ID ADDR IN B REG SEZ,RSS SKIP IF NOT FOUND OR SHORT ID JMP L0021 GO SET UP WORK ADDRESSES * NPRG LDA $NOPG GET THE NO SUCH PROG ADDRESS LDB D5 AND THE NO SUCH PROG ERROR CODE JMP L0015 GO TO RETURN * * L0060 LDB WORK GET ID SEGMENT ADDRESS L0021 JSB DORM? GO SET UP WORK ADDRESSES * LDB L0091 GET THE REQUEST CODE SZB,RSS CHECK IF DORMANT REQUEST JMP L0100 DORMANT REQUEST CPB D1 CHECK IF SCHEDULE REQUEST JMP L0200 YES CPB D6 CHECK IF OPERATOR SUSPEND REQUEST JMP L0300 YES CPB D15 CHECK IF LINKAGE UPDATE REQUEST JMP L0135 YES JMP L0400 MUST BE A SIMPLE LIST MOVE SPC 3 HED LIST PROCESSOR--DRIVER SERVICING SECTION. * * THIS PROCESSES LIST CALLS OF 0, 6, & 7. THESE ARE RESERVED * FOR DRIVERS. THE OPERATING SYSTEM MAKES THE ASSUMPTION * THAT IF YOU KNOW HOW TO CALL $LIST YOU KNOW WHAT YOUR * DOING. IN ADDITION, IF A DRIVER WANTS A PROGRAM IT WANTS * IT IN A HURRY. THUS $LIST DOES MINIMAL ERROR CHECKING FOR * DRIVERS (AND NONE FOR THE OP SYSTEM). HERE A CHECK IS MADE * ONLY TO SEE IF THE PROGRAM IS DORMANT (ALSO IF THE PROGRAM * EXISTS IF THE CALL WAS BY NAME RATHER THAN BY ID ADDRESS). * NO SIZE yCHECKS OR EMPTY ID CHECKS ARE MADE. IF YOUR KNOW * ENOUGH TO CALL $LIST, YOU KNOW ENOUGH TO MAKE SURE THE * PROGRAM EXISTS AND THAT THERE IS A PARTITION TO RUN IT IN. * THE REAL ADVANTAGE TO THIS PHILOSOPHY IS THAT DRIVERS ARE * GIVEN OP SYSTEM STATUS AND THEREFOR OP SYSTEM SPEED IN * PROGRAM SCHEDULING. THE SYSTEM WILL SCHEDULE THE PROGRAM AS * FAST AS IT POSSIBLY CAN. * HINT. IF YOUR SCHEDULING DISC RESIDENT PROGRAMS, HAVE THEM * TERMINATE SAVING RESOURCES OR SERIALLY REUSABLE. IT WILL * SAVE LOTS OF DISC TIME. * * * * DL07 SEZ WELL WHICH MAP IS IT IN ? JSB PLNAM ALTERNATE MAP, SO PULL IN LOCALLY JSB TNAME GET THE ID ADDRESS SEZ DID THE PROGRAM EXIST ? JMP NPRG NO, SO TELL THE FOLKES * DL00 JSB DORM? SET UP THE $LIST PRAMS & SEE IF DORMANT SZA PROG DORMANT ? JMP L0075 NO, TELL THE DRIVER TO FORGET IT JSB PRAMX GO PICK UP THE PARAMETERS JMP L0275 GO SCHEDULE THE PROGRAM * DL06 ISZ $LIST BUMP TO FUTURE B-REG @ SUSP(SETS RETURN ADDR) SEZ WHICH MAP ? JMP DL061 THE OTHER ONE. * LDA $LIST,I GEY THE B REG @ SUSP DL062 STA TEMPX AND SAVE TEMPORARIALLY JSB DORM? SET UP LIST PARAMETERS & CHK FOR DORMANT SZA PROG DORMANT ? JMP L0075 TELL DRIVER TO FORGET IT. LDB WORK GET THE ID ADDRESS ADB D10 AND INDEX TO THE B REG @ SUSP WORD LDA TEMPX GET THE VALUE STA B,I AND PUT IT IN THE ID SEG JMP L0275 NOW GO SCHEDULE THE PROGRAM * DL061 XLA $LIST,I GET THE B REG AT SUSP VALUE JMP DL062 CONTINUE * * SKP * HED LIST PROCESSOR--DORMANT REQUEST * * DORMANT REQUEST * * THE DORMANT REQUEST IS PROCESSED AS FOLLOWS: * IF ABORT BIT SET, MAKE PROGRAM DORMANT * IF ALREADY DORMANT, RETURN * 4tNLH IF SCHEDULED, THEN ENTERED INTO DORMANT LIST, POINT * OF SUSPENSION CLEARED. * IF ID SEGMENT ADDRESS IS SAME AS RESIDING * BACKGROUND DISC RESIDENT PROGRAM, THEN BKRES * FLAGS ARE CLEARED SO ANOTHER PROGRAM MAY BE * LOADED INTO THE AREA. * IF ID SEGMENT ADDRESS IS SAME AS RESIDING REAL * TIME DISC RESIDENT PROGRAM, THEN RDISK FLAGS * ARE CLEARED SO ANOTHER PROGRAM MAY BE LOADED * INTO THE AREA. * IF NOT ONE OF ABOVE, THEN DORMANT BIT SET IN STATUS SPC 1 L0100 LDB WSTAT,I CHECK IF ABORT BIT SET BLF RBL,SLB,BLF JMP L0115 YES, SO GO MAKE DORMANT _N CPA D2 IF I/O SUSPENDED L0103 ALF,SLA,RAL SET DORMANT BIT JMP L0350 ELSE GO CHECK RESOURCE BIT * IOR WSTAT,I MERGE THE CURRENT STATUS AND CL.NP CLEAR NO PARMS BIT L0105 STA WSTAT,I RESET THE NEW STATUS JMP L0014 GO TO EXIT * L0115 LDA WORK CLEAR ID SEG TEMP AND SET B LDB DEF0 (CLEAR 5 TEMP WORDS TO 0) JSB PRAM LDB WORK SET FLAG FOR DISPATCHER CLA CPB XEQT STA $PVCN ADB D8 LINK THROUGH XSUSP LDA $ZZZZ SO RESIDENT FLAGS STB $ZZZZ ARE STA B,I CLEARED ADB D6 INDEX TO TYPE WORD LDA B,I AND CLEAR AND NCLAM THE CORE LOCK AND ALL OF MEMORY STA B,I BITS CLA STA XEQT CLEAR CURRENT PGM FLAG IN CASE IT IS SPC 1 L0130 STA WSTAT,I SET THE NEW STATUS AND D15 GET THE ADDITION CODE L0135 LDB L0090 SET B FOR LINK JSB LINK RELINK THE PROG L0014 CLA SET FOR NORMAL RETURN LDB WORK RETURN THE ID ADDRESS L0015 ISZ $LIST STEP TO RETURN ADDRESS JRS DMST $LIST,I LOOK MA ! NO LABEL !! SPC 1 SPC 1 L0350 SLB,RSS IF RESOURCE BIT NOT SET JMP L0115 GO MAKE DORMANT CPA D6 IF OPERATOR SUSPENDED JMP L0103 GO SET DORMANT BIT TOO. * L0355 LDA WSTAT,I GET OLD STATUS AND CLD.R CLEAR THE "R" AND "D" BITS LDB WORK IF NOT CURRENT CPB XEQT PROGRAM THEN RSS IOR B20K SET THE NO PRAMS BIT. JMP L0130 GO PUT IN THE DORM LIST SPC 2 $LSTM NOP DON'T MOVE OR REARRANGE THESE THREE L0090 NOP WORDS. CRASH DUMP ANALIZER USES THEM. L0091 NOP SPC 1 NCLAM OCT 177637 CL.NP OCT 157777 HED LIST PROCESSOR--SCHEDULE REQUEST * * SCHEDULE REQUEST * * THE SCHEDULE REQUEST IS PROCESSED AS FOLLOWS: * IF ABORT BIT SET, STORE ID SEGMENT LADDRESS SUCH THAT * PROGRAM WILL BE ABORTED AT NEXT ENTRY FROM XEQ * IF DORMANT BIT SET, GO TO DORMANT REQUEST * IF OPERATOR-SUSPEND BIT SET, GO TO OPERATOR-SUSPEND * REQUEST * IF SCHEDULED, THEN STATUS ERROR EXIT * IF CURRENT STATUS NOT ONE OF ABOVE, THE PROGRAM IS * ENTERED INTO THE SCHEDULE LIST. * L0200 CPA D6 IF OP-SUSP JMP L0250 GO CHECK FOR DORMANT BIT LDB WSTAT,I GET WHOLE STATUS WORD * SZA IF DORMANT OR CPA D2 IF I/O SUSP. THEN BLF,SLB,BLF ROTATE AND SKIP JMP L0255 ELSE GO CHECK WAIT BIT * RBR,SLB,RBL IF OP-SUSP BIT SET JMP L0220 GO CHECK FURTHER * L0270 RBL DORM BIT TO 15 L0271 CLA,INA SET A FOR SCHEDULE SSB IF DORM BIT SET JMP L0100 GO SET DORMANT * * CHECK FOR SERIALLY REUSABLE OR SAVE RESOURCES * OR OP SUSPEND TERMINATION LAST TIME THROUGH . * * LDB L0090 GET THE CURRENT STATUS SZB IF 0 CPB D6 OR 6 RSS THEN CHECK ON THE PROGS LAST PARTITION JMP L0130 ELSE GO SCHEDULE THE PROGRAM * L0275 LDB WORK GET THE ID ADDRESS ADB D14 INDEX TO THE TYPE WORD LDA B,I GET THE TYPE AND D15 ONLY CPA D1 NOW IF ITS MEMORY RES, THEN NO PARTITION JMP L0130 SO, WE JUST SCHEDULE * ADB D7 MUST BE 1ST DISPATCH & DISC RES LDA B,I GET THE PARTITION WORD AND B77 AND USE IT TO INDEX INTO THE MPY D7 $MATA TABLE ADA $MATA ADA D3 GET TO THE D BIT WORD LDA A,I AND PULL IT IN AND B20K MASK IT SZA,RSS IS IT SET ? JMP L0290 NO, SO GO SCHEDULE * LDA WORK GET THE ID ADDRESS TP 1 JSB DMAL AND SEE IF HE IS STILL IN THE PARTITION. * L0n290 CLA,INA SET FOR SCHEDULE JMP L0130 AND DO IT TO IT !!! * * * * * L0220 RBL,SLB CHECK RESOURCE BIT JMP L0230 IF SET GO CLEAR OP-SUSP SSB IF DORM BIT SET JMP L0271 GO MAKE DORMANT * L0230 XOR B1006 CLEAR THE OP-SUSP BIT AND JMP L0280 GO OP-SUSP THE PGM. * L0250 LDA WSTAT,I IF OP-SUSP BIT SET AND B100 AND DORM BIT SET SZA JMP L0355 GO CLEAR BIT AND SET DORMENT * L0255 LDA WSTAT,I IF WAIT BIT SET ALF,SLA,ALF THEN ALF,SLA,ALF GO MOVE TO WAIT LIST (SKIPS) JMP L0270 ELSE, GO SCHEDULE. * XOR D3 CHANGE STATUS TO 3 AND D15 L0280 XOR WSTAT,I AND JMP L0130 GO RELINK HED LIST PROCESSOR--SUSPEND REQUESTS * * OPERATOR SUSPEND REQUEST * * THE OPERATOR-SUSPEND REQUEST IS PROCESSED AS FOLLOWS: * IF DORMANT, THEN ENTER INTO OPERATOR SUSPEND LIST * IF ALREADY OPERATOR SUSPEND, THEN STATUS ERROR EXIT * IF SCHEDULED, THEN ENTER INTO OPERATOR SUSPEND LIST * IF NOT ONE OF ABOVE, THEN OPERATOR-SUSPEND BIT SET * L0300 CPA D6 OR OP-SUSP JMP L0075 REJECT THE REQUEST * CPA D2 IF I/O SUSP JMP L0310 GO SET TO "O" BIT * CCE,SZA IF DORM WITH RESOURCES SKIP JMP L0400 ELSE GO RELINK I.E. SET OP-SUSP. * ELA,ELA IF DORM BUT IN TIME LIST ADA WSTAT LDA A,I AND B10K THEN SET O BIT SZA IN TIME LIST ? JMP L0310 YES * LDB WSTAT,I GET FULL STATUS WORD SZB,RSS ENTIRE STATUS WORD = 0 ? JMP L0075 YES, ITS AN ERROR * LDA B306 ELSE SET "R" AND "D" BITS AND IOR B PUT IN OP-SUSP LIST JMP L0130 * L0310 LDA B1000 SET OPER-SUSP BIT IN STATUS IOR WSTAT,I JMP L0105 GO SET BIT AND EXIT SPC 1 * * NON-OPERATOR SyUSPEND REQUEST * * THE NON-OPERATOR SUSPEND REQUEST IS PROCESSED AS FOLLOWS: * THE PROGRAM IS ENTERED INTO THE REQUESTED LIST AND * THE NEW STATUS REPLACES THE 4 LOW ORDER BITS OF THE * PROGRAM STATUS-THUS SAVING THE DORMANT OR OPERATOR- * SUSPEND BITS THAT MAY BE PRESENT. * * L0400 LDA WSTAT,I UPDATE STATUS SAVING ALL AND C17 BUT LOW 4 BITS IOR L0091 JMP L0130 GO TO EXIT SPC 1 C17 OCT 177760 B100 OCT 100 B306 OCT 306 B1006 OCT 1006 CLD.R OCT 57460 D21 DEC 21 SKP * * THE PLNAM SUBROUTINE PULLS THREE WORDS OUT OF THE ALTERNATE * MAP (ASCII PROGRAM NAME). THE ROUTINE IS TYPICALLY CALLED * DIRECTLY BEFORE TNAME SO THAT THE PROGRAM NAME IS LOCAL AND * THE ID SEGMENTS CAN BE SEARCHED. * * * CALLING SEQUENCE LDB ADDRESS OF THREE WORD ARRAY * JSB PLNAM * * ON RETURN B = LOCAL ADDRESS OF ARRAY * A = DESTROYED * * PLNAM NOP XLA B,I GET THE 1ST ONE STA PNAME AND SAVE IT INB DO THIS TWO MORE TIMES XLA B,I STA PNAME+1 INB XLA B,I STA PNAME+2 LDB DPNAM JMP PLNAM,I * DPNAM DEF PNAME PNAME BSS 3 DON'T REARRANGE THESE WORDS OR MOVE THEM TEMPX NOP I NEED THEM LATER FOR CONTIGIOUS SPACE TEMPY NOP IN THE PRAMX ROUTINE TEMPZ NOP * * * THE DORM? SUBROUTINE IS CALLED BY THE $LIST PROCESSOR FOR * ALL CALLS IT'S PRIMARY FUNCTION IN LIFE IS TO SET UP * WORK, WPRIO, WSTAT, AND L0090. IN ADDITION IT RETURNS * L0090, THE PROGRAMS CURRENT STATUS IN THE A REGISTER. * $LIST FUNCTION CODES OF 0, 6, AND 7 (THE DRIVER $LIST * CALLS) USE THIS TO SEE IF THE PROGRAM IS DORMANT. * * CALLING SEQUENCE LDB ID ADDRESS * JSB DORM? * ON RETURN A-REG = CURRENT STATUS 0-6 * * DORM? NOP STB i$WORK SET UP THE ID ADDRESS FOR LATER ADB D6 AND STB WPRIO THE PRIORITY WORD ADB D9 AND STB WSTAT THE STATUS WORD LDA B,I GET THE OLD STATUS AND D15 KEEP ONLY STATUS STA L0090 SET UP THE STATUS WORDTATUS JMP DORM?,I RETURN TO THE CALLER HED SET UP ID SEGMENT TEMP PARAMETERS * * * THE PRAMX SUBROUTINE IS CALLED BY THE $LIST PROCESSOR * FOR ADDRESS CODES OF 0 & 7. THESE ADDRESS CODES * HAVE BEEN RESERVED FOR DRIVERS WHO WISH TO SCHEDULE * PROGRAMS. THE SUBROUTINE CALLS EITHOR THE PRAM OR * XPRAM SUBROUTINE TO STUFF THE PARAMETERS INTO THE PROGRAMS * ID SEGMENT TEMP AREA. PRAM IS CALLED IF THE DRIVER CALLED * $LIST FROM THE SYSTEM MAP, XPRAM IS CALLED IF THE DRIVER * IS IN THE SYSTEM MAP. * ACTUALLY PRAMX IS ONLY CALLED ONCE & THUS NEED NOT BE A * SUBROUTINE. HOWEVER, FOR THOSE WHO MUST READ THIS CODE * IT HELPS SEPERATE THE LIST MOVE PROBLEM FROM THE PARAMETER * MOVE PROBLEM AND MAKES THE CODE MUCH EASIER TO READ & * UNDERSTAND. * * * CALLING SEQUENCE JSB PRAMX * * $WORK HAS PROG ID ADDRESS * DMST HAS THE DMS STATUS IN IT * TEMP1 POINTS TO THE WORD BEFORE THE PARAMETER LIST * RETRN HAS RETURN ADDRESS OF THE LIST CALL * * RESTRICTIONS - ASSUMPTIONS * 1) DEFS IN THE $LIST CALL MUST BE DIRECT * (NEED NOT APPLY IF DRIVER IN SYSTEM MAP) * 2) AT LEAST ONE PARAMETER MUST BE SUPPLIED (IE 1 DEF) * 3) RETURN ADDRESS MUST DELIMIT PARAMETER LIST. * 4) 5 PARAMETERS MAX * * PRAMX NOP ISZ TEMP1 BUMP $LIST TO POINT TO 1ST PRAM LDB RETRN GET RETURN ADDRESS CMB,INB AND USE THIS TO ADB TEMP1 SEE HOW MANY PARAMETERS TO PASS STB DM5 SAVE TO FAKE OUT PRAM OR XPRAM * LDA DMST NOW GET THE DMS STATUS RAL,ELA E = 1 MEANS CALL FROM USER MAP SEZ,RSS WELL, WHICH MAP ? JMP PRMEX SYS MAP , SO GO STUFF THE PRAMETERS * J CMB,INB USER, SO PULL ADDRESSES IN LOCALLY CBX PUT # IN X LDA TEMP1 GET SOURCE LDB DPNAM AND DESTINATION MWF AND BRING EM IN. * LDA WORK NOW GET THE PROGRAMS ID ADDRESS LDB DPNAM AND THE LOCAL ADDRESS ADB SIGN MAKE IT ADDRESS INDIRECT JSB XPRAM AND GO STUFF THE ID SEGMENT JMP PRMX3 NOW GO RETURN * PRMEX LDA WORK ID ADDRESS TO A LDB TEMP1 ADDRESS OF PARAMETERS TO B ADB SIGN SET THE SIGN BIT TOO JSB PRAM GO STUFF THE ID SEGMENT * PRMX3 LDA DMM5 GET A -5 BACK TO STA DM5 LOCATIOM DM5 SO THAT THE OTHER PROCESSORS JMP PRAMX,I ARE HAPPY. - RETURN TO CALLER - * * * * SES#3 IS A SUBROUTINE WHICH RETURNS THE ADDRESS OF * SESSION WORD # 3 IN THE REFERENCED PROGRAM'S ID * SEGMENT. * * CALLING SEQUENCE : LDB ID ADDRESS * JSB SES#3 * * ON RETURN B = SESSION WORD #3 ADDRESS * A = PROGRAM TYPE * * SES#3 NOP ADB D14 INDEX TO TYPE LDA B,I PULL IT IN AND D7 KEEP ONLY TYPE CPA D1 IS IT MEMOR RESIDENT ? ADB DM4 YES, RESET SESSION WORD POINTER ADB D18 SET TO SESSION WORD # 3 JMP SES#3,I RETURN * D18 DEC 18 * * HED LINK UPDATE PROCESSOR * * THE LINK PROCESSOR SECTION OF THE HP-21XX REAL TIME * EXECUTIVE * 1. REMOVES A PROGRAM FROM A LIST * AND * 2. ENTERS THE PROGRAM INTO ANOTHER LIST AT THE PROPER PLACE * ACCORDING TO PRIORITY LEVEL. * * * * CALLING SEQUENCE * * LDB CODE1 * LDA CODE2 * JSB LINK * * WHERE * CODE1 = CODE OF REMOVAL LIST * CODE2 = CODE OF INSERTION LIST * THE ID SEGMENT IS ASSUMED TO BE LOCATED IN WORK * AND WPRIO SET * * * THE REMOVAL OF PROG5RAM FROM A LIST CONSISTS OF: * 1. IF I/O LIST (CODE 2), THEN THIS IS SPECIAL CASE * AND DOES NOT REQUIRE REMOVAL. * 2. IF NULL LIST, THEN ERROR EXIT TAKEN. * 3. IF FIRST AND ONLY PROGRAM IN LIST, THEN LIST * VALUE SET TO ZERO. * 4. IF FIRST PROGRAM IN LIST, BUT NOT THE ONLY * PROGRAM IN LIST(LINKAGE NOT ZERO), THEN SET LIST * VALUE TO THE LINKAGE VALUE. * 5. IF IN MIDDLE OF LIST, THE LINKAGE OF THE ID SEG * MENT WHICH POINTS TO THE PROGRAM TO BE REMOVED * IS SET TO THE LINKAGE VALUE OF THE PROGRAM THAT * IS REMOVED. * 6. IF LAST PROGRAM IN LIST, THE LINKAGE VALUE OF * PREVIOUS PROGRAM IN LIST IS SET TO ZERO. * LINK NOP ENTRY/EXIT SZB IGNOR DORMANT AND CPB D2 I/O LIST REQUESTS JMP LK100 YES, SEE IF ADDITION. ADB LLIST ADD TOP OF LIST POINTER * LK010 STB TEMP TOP OF REMOVAL LIST LDB B,I GET TOP OF LIST POINTER SZB,RSS END OF LIST? JMP LINK,I FORGET IT ????????????????????????????? CPB WORK MATCHES PROGRAM? RSS YES JMP LK010 NO, KEEP SEARCHING LDB B,I UPDATE LINKAGE TO BYPASS STB TEMP,I THE DELETED ID SEG HED LINK PROCESSOR--ADDING PROGRAM TO A LIST * * ADD A PROGRAM TO A LIST * * THE ADDITION OF PROGRAM TO A LIST CONSISTS OF: * 1. IF I/O LIST (CODE 2), THEN THIS IS SPECIAL CASE * AND NO ADDITION MADE TO LIST. * 2. IF NULL LIST, THEN LIST VALUE SET TO POINT TO ID * SEGMENT OF PROGRAM TO BE ADDED AND THE LINKAGE * SET TO ZERO. * 3. IF NOT NULL LIST, THE PROGRAM IS INSERTED INTO * LIST ACCORDING TO PRIORITY LEVEL AND LINKAGES * CHANGED TO REFLECT THIS INSERTION.Xl * 4. IF OF LOWER PRIOR. THAN ANY PROGRAM IN LIST, THEN * LAST LINKAGE IS SET TO POINT TO THE PROGRAM TO * BE ADDED AND THE PROGRAM LINKAGE IS CLEARED. * LK100 SZA IGNOR DORMANT AND CPA D2 I/O LIST REQUESTS JMP LINK,I YES, RETURN ADA LLIST ADD TOP OF LIST POINTER * LK110 STA TEMP SAVE TOP OF LIST POINTER LDA A,I GET POINTER SZA,RSS END OF LIST? JMP LK140 YES, LINK IN NEW PROG CPA WORK IS IT A DUPLIC. PROG? JMP LK150 YES, DUPLIC SO RETURN STA B NOT DUPLIC, COMPARE PRIORITY ADB D6 OF WORK ID SEG LDB B,I AGAINST CMB,INB CURRENT ADB WPRIO,I ID SEG SSB,RSS WORK < CURRENT? JMP LK110 NO, SEE NEXT ONE * LK140 STA WORK,I LINK THIS TO FOLLOW WORK LDA WORK LINK WORK TO FOLLOW STA TEMP,I PREVIOUS PROG * LK150 JMP LINK,I RETURN * * LLIST DEF DORMT TOP OF LIST ADDRESS WSTAT NOP WORK STATUS ADDRESS DM32 DEC -32 B1000 OCT 1000 B4000 OCT 4000 COM OCT 54 TBUF DEF TEMP5 TBUFS DEF TEMP5+7 DM58 DEC -58 HED OPERATOR INPUT MESSAGE PROCESSOR * * THE $MESS PROCESSOR SECTION OF HP-2116 REAL TIME EXECUTIVE * PROCESSES THE FOLLOWING OPERATOR INPUT REQUESTS: * * 1. TURN ON A PROGRAM * ON[IH],XXXXX * ON[IH],XXXXX,NOW * ON[IH],XXXXX,P1,...,P5 * ON[IH],XXXXX,NOW,P1,...,P5 * 2. TURN OFF A PROGRAM * OF,XXXXX,P * 3. OPERATOR SUSPEND A PROGRAM * SS,XXXXX * 4. CONTINUE A OPERATOR SUSPENDED PROGRAM * GO[IH],XXXXX * GO[IH],XXXXX,P1,...,P5 * 5. CURRENT STATUS OF A PROGRAM * ST,XXXXX * 6. CHANGE PROGRAM ID SEGMENT TIME PARAMETERS. * IT,XXXXX,R,MMM * IT,XXXXX,R,MMM,HR,MN * IT,XXXXX,R,MMM,HR,MN,SC * IT,XXXXX,R,MMM,HR,tMN,SC,MS * 7. CHANGE PROGRAM PRIORITY * PR,XXXXX,ZZ * 8. SET REAL TIME CLOCK AND START TIME BASE GENERATOR * TM,DAY,HR,MN,SC * 9. CURRENT REAL TIME CLOCK VALUES * TI * 10. SET A SLOT OR DEVICE DOWN. * DN,N1 * DN,,N2 * 11. SET A SLOT AND DEVICES UP * UP,NN * 12. LOGICAL UNIT SWITCH AND STATUS * LU,N1 * LU,N1,N2 * LU,N1,N2,N3 * 13. EQUIPMENT STATUS * EQ,NN * 14. SET SOURCE FILE * LS,P1,P2 * 15. SELECT LOAD-AND-GO * LG,P * 16. CHANGE DEVICE TIME-OUT PARAMETER * TO,N1 * TO,N1,N2 * 17. RELEASE PROGRAM'S TRACKS * RT,XXXXX * 19. SET BREAK FLAG * BR,XXXXX * 20. ABORT JOB REQUEST * AB * 21. RUN REQUEST * RU[IH],XXXXX * RU[IH],XXXXX,P1,...,P5 * 22. BUFFER LIMIT PRINT/CHANGE * BL OR BL,N1,N2 * 23. SIZE REQUEST/CHANGE * SZ,XXXXX * SZ,XXXXX,P1 * SZ,XXXXX,P1,P2 * 24. ASSIGN PROGRAM TO PARTITION * AS,XXXXX,N * 25 UNRESERVE A PARTITION * UN, N * * * * SPC 3 * IN GENERAL THERE ARE TWO CLASSES OF COMMANDS. THOSE THAT PERFORM * A SERVICE IN WHICH SPEED IS OF IMPORTANCE (RU, ON, OF ETC) AND * AND THOSE COMMANDS WHICH GIVE STATUS INFORMATION OR WHICH MUST * BE ENTERED BEFORE A PROGRAM IS RUN. IN THE FORMER CASE A CONSIDERABLE * AMOUNT OF EFFORT IS SPENT EXECUTING THE COMMAND AS FAST AS POSSIBLE. * IN THE LATER CASE EFFORT IS SPENT IN MAKING THE CODE AS SMALL AS * POSSIBLE SO AS TO SAVE ROOM. * * HED OPERATOR INPUT MESSAGE DECIPHER ROUTINE * * CALLING SEQUENCE * JSB $MESS * B CONTAINS NUMBER OF CHARACTERS * A IS THE BUFFER ADDRESS * * * * INPUT DECIPHER ROUTINE ROUTINE SCANS THE ASCII OPERATOR * INPUT AND STORES THE DATA INTO PARAMETERS. * THIέS ROUTINE ASSUMES THE CHARACTER COUNT IN B ON ENTRY AND * DATA IN BUFFR. COMMA IS USED TO SEPARATE PARAMETERS. A PARA- * METER MAY BE UP TO 6 ASCII CHARACTERS- EXCEPT FOR OP CODE * WHICH MUST BE 2 CHARACTERS. A MAXIMUM OF 40 CHARACTERS MAY BE * INPUT. A COUNT IS KEPT OF THE NUMBER OF PARAMETERS INPUT AND * A CHARACTER COUNT IS KEPT FOR EACH PARAMETER. THE VALUES ARE * STORED LEFT ADJUSTED IN THE BUFFERS. * * MESS MUST KEEP TRACK OF WHICH MAP THE CALLER CAME IN FROM * IF THE ENTRY TO $MESS IS FROM THE SYSTEM MAP THEN THE CALL * WAS FROM THE $TYPE ROUTINE. IF FROM THE USER MAP THEN THE * CALL IS FROM THE SYSTEM LIBRARY ROUTINE MESSS. (PRMPT & * R$PN$ THING) * IF FROM $TYPE, THEN INPUT BUFFER = INBUF * OUTPUT BUFFER = INBUF * IF FROM MESSS, THEN INPUT BUFFER PULLED IN LOCALLY TO * IBUFX * OUTPUT BUFFER = THE PROCESSOR'S BUFFER * GENERALLY SHARED W/PARSE * BUFFER. * * * ENTRY MADE BY $MESS NOP * SSM $MEU * SJP $MSG * * $MSG STA BFADD SAVE INPUT BUF ADDRESS FOR STRING ROUTINE STB BFCNT SAVE COUNT FOR STRING ROUTINE TOO. STB NWCNT ONE MORE TIME. * LDA $MEU GET THE DMS STATUS RAL,RAL ROTATE THE STATUS FOR STA $MEU OUR RETURN TRIP * SSB IF NEG ITS AN ERROR JMP $INER SZB,RSS IF THE CHAR COUNT = 0 JMP M0150 JUST RETURN * RAL,ELA PUT DMS STATUS IN E REG (0/1 SYS USER) LDA BFADD GET THE BUFFER ADDRESS BACK AGAIN SEZ,RSS WELL, WHICH MAP ? JMP NMESS SYSTEM (SYSTEM CONSOLE) * INB CONVERT CHAR COUNT TO BRS WORD COUNT (DIVIDE BY 2) CBX SAVE WORD COUNT FOR MOVE * ADB DM41 NO.W CHECK OUT WORD COUNT SSB GREATER THAN 22 WORDS ? JMP GTMES NO,SO PULL IT IN LOCALLY LDB D40 YES, SO ONLY PULL IN 22 WORDS ANYWAY CBX SAVE FOR MOVE RBL NOW CONVERT TO CHARACTERS FOR $PARS ROUTINE STB NWCNT * GTMES LDB IBUFX GET THE DESTINATION MWF AND MOVE THE WORDS * LDA IBUFX GET THE BUFFER ADDRESS LDB NWCNT AND THE LENGTH NMESS JSB $PRSE AND GO PARSE THE INPUT STRING BUFAD DEF PRAMS * * * HED MESSAGE PROCESSOR--OP REQUEST SEARCH * * THIS SECTION CHECKS THE OPERATOR REQUEST CODE AGAINST THE * LEGAL REQUEST CODES AND JUMPS TO THE PROPER PROCESSOR. ******************************************************************* * TO ADD NEW REQUEST ONE MERELY, * A. ADDS ASCII OPERATION CODE TO TABLE -LDOPC- * B. ADDS PROCESSOR START ADDRESS TO TABLE -LDJMP- * C. ADDS PROCESSOR CODING TO PROCESS THE REQUEST. ******************************************************************* * LDB OP OPERATION CODE INTO B STB OPP SET STOP FLAG LDA LDOPC SET OPERATION TABLE POINTER STA TEMP1 LDA LDJMP SET OPERATION PROC. JUMP ADDRESS STA TEMP2 LDA P1 SEND P1 IN A REG. UNL IFN LST CPB DBUG **********DEBUG********** CLB,RSS **********DEBUG********** JMP M0030 **********DEBUG********** STB FLG **********DEBUG********** ENT $DDDT **********DEBUG********** $DDDT JSB $DDT **********DEBUG********** DEF $TYPE+2 **********DEBUG********** DBUG ASC 1,DB **********DEBUG********** EXT $DDT **********DEBUG********** UNL XIF LST M0030 CPB TEMP1,I COMPARE WITH TABLE VALUE JMP TEMP2,I COMPARES GO DO IT ISZ TEMP1 DOES NOT COMPARE-INCREMENT OP TABLE ISZ TEMP2 INCREMENT J|JUMP ADR. JMP M0030 GO TO COMPARE NEXT OP CODE * OPER LDA $OPER ILLEGAL OPERATION CODE REQUEST $MSEX JRS $MEU $MESS,I RETURN AND RESTORE MEU STATUS MSEX EQU $MSEX D40 DEC 40 DM41 DEC -41 UNL IFZ BSS 7 MAKE RELEASED LISTING ALLIGN W/DBUG XIF LST * * * SKP * * LDOPC DEF *+1 OPERATION CODE TABLE ADDRESS ASC 8,RTONOFSSGOSTPRIT $ASTM ASC 9,TMDNUPLUEQLSLGTOTI ASC 7,BRABRUBLSZASUR OPP NOP OPCODE FOR CURRENT REQUEST LDJMP DEF *+1,I JUMP ADDRESS FOR EACH OPER. CODE DEF M0070 RELEASE PROGRAM'S TRACKS DEF M0100 TURN ON DEF M0200 TURN OFF DEF M0300 OPERATOR SUSPEND DEF M0400 REMOVE OPERATOR SUSPEND DEF M0500 STATUS DEF M0650 PRIORITY CHANGE DEF M0600 INTERVAL TIME CHANGE DEF M0700 REAL TIME CLOCK INITIALIZATION DEF M0800 DN REQUEST DEF $IOUP UP REQUEST DEF M0850 LU REQUEST DEF M0900 EQ REQUEST DEF M0960 LS REQUEST DEF M0970 LG REQUEST DEF M0990 TO REQUEST DEF M0750 TI REQUEST DEF M0725 BR REQUEST DEF M0950 AB REQUEST DEF M0408 RU REQUEST DEF BLIM BL REQUEST DEF SIZE SZ REQUEST DEF ASIGN AS REQUEST DEF URESV UR REQUEST DEF OPER OPERATOR ERROR * ON EQU LDOPC+2 RU EQU LDOPC+20 OF EQU LDOPC+3 ST EQU LDOPC+6 * * HED PARSE SUBROUTINE FOR OPERATOR MESSAGES * CALLING SEQUENCE: * LDA BUFFER ADDRESS * LDB CHARACTER COUNT * JSB $PRSE * DEF PRAM BUFFER * -RETURN- * * THE PRAM BUFFER IS 33 WORDS LONG AND CONTAINS UP TO 8 * PRAMETER DESCRIPTERS FOLLOWED BY THE PRAMETER COUNT. * * EACH PARAMETER DESCRIPTER CONSISTS OF FOUR WORDS: * * WORD MEANING * 1 FLAG WORD 0=NULL PRAMETER * NLH1=NUMERIC PRAMETER * 2=ASCII PRAMETER * 2 0 IF NULL,VALUE IF NUMERIC,ASCII(1,2) IF ASCII * 3 0 IF NOT ASCII ELSE ASCII(3,4) * 4 0 IF NOT ASCII ELSE ASCII(5,6) * * TEMP USAGE IN PARSE SECTION: * * TEMPP = CHARACTER ADDRESS * TEMP = PARAMETER FLAG ADDRESS * TEMP1 = TEMP BUFFER FETCH ADD. * TEMP2 = TEMP BUFFER STORE ADD. * TEMP3 = LAST INPUT CHAR.+1 ADD. * TEMP4 = PARAMETER VALUE ADDRESS. * TBUF = DEF TEMP5 (6 LOCATIONS) * TBUFS = DEF TEMP5+7 * $PRSE NOP CLE,ELA MAKE CHARACTER ADD. STA TEMPP SET BUFFER CHAR ADD. ADA B COMPUTE END ADDRESS. MN STA TEMP3 AND SET IT. LDB DM32 CLEAR PARAMETER AREA STB TEMP LDB $PRSE,I CLA MES1 STA B,I INB ISZ TEMP JMP MES1 * STA B,I CLEAR THE PRAM COUNT STB WSTAT SET ADDRESS OF PRAM COUNT DEC09 LDA TBUF INITIALIZE TEMP BUFFER ADDRESS STA TEMP1 STA TEMP2 * DEC10 LDB TEMPP GET THE BUFFER CHAR ADDRESS CPB TEMP3 IF NO MORE CHARACTERS JMP DEC60 GO PROCESS PRAM ISZ TEMPP STEP INPUT POINTER CLE,ERB CONVERT TO WORD SET UP LOW IN E LDA B,I GET WORD FROM THE BUFFER SEZ,RSS CHECK IF TO EXAMINE UPPER/LOWER ALF,ALF UPPER, SO ROTATE TO LOWER BITS AND B377 MASK OFF ALL BUT LOW ORDER CPA COM SEE IF A COMMA JMP DEC60 YES CPA LASCI CHECK IF BLANK CHARACTER JMP DEC10 YES, SO SKIP CHARACTER LDB TEMP2 CHECK IF 6 CHARACTERS IN PRAM CPB TBUFS IF SO JMP DEC10 SKIP STORE STA TEMP2,I STORE THE CHARACTER STA SABRT SAVE THE LAST CHARACTER ISZ TEMP2 STEP FOR NEXT CHAR. * JMP DEC10 GO TO PROCESS NEXT CHARACTER * * ATTEMPT NUMERIC CONVERSION OF PRAM. * DEC60 LDA WSTAT,I FIRST SET UP POINTERS RAL,RAL TAKE 4 TIMES THE PRAM NUMBER ADA $PRSE,I PLUS THE OP CODE ADDRESS-1 STA TEMP SET FLAG ADDRESS CLE,INA ONE MORE AND WE HAVE STA VALOC THE PRAMETER VALUE LOCATION LDA TEMP2 IF NO CHARACTERS CPA TBUF INPUT JMP DEC75 GO TRY NEXT ONE * * NOW TRY FOR A NUMBER * ISZ TEMP,I SET FLAG TO 1 FOR NUMBER LDB TEMP1,I GET FIRST CHAR CPB DASH MINUS SIGN? ISZ TEMP1 YES, INCRE TO NEXT CHAR CPA TEMP1 (A) STILL = TEMP2 JMP DEC80 IF "-" WAS ONLY CHAR, THEN ASCII * LDB D10 SET UP CONVERSION BASE LDA SABRT CPA "B" IF B SUFFIX LDB D8 SET FOR BASE 8 STB TEMP4 SET BASE DEC65 MPY VALOC,I BUMP THE CURRENT VALUE VALOC EQU *-1 LDB TEMP1,I GET THE NEXT CHAR. ADB DM58 IF GREATER THAN "9" SEZ,CLE,RSS THEN NOT A NUMBER ADB D10 IF LESS THAN "0" SEZ,CLE,RSS THEN JMP DEC80 NOT A NUMBER ADA B ACCUMULATE THE STA VALOC,I NUMBER ISZ TEMP1 STEP THE BUFFER ADDRESS LDA TEMP4 GET THE BASE TO A LDB TEMP1 AND THE NEXT CHAR. LOC. TO B CPB TEMP2 IF END THEN JMP DEC70 GO TO NEXT PRAM * INB IF BASE 8 CONVERSION CPB TEMP2 AND LAST CPA D10 CHAR. THEN DONE SO SKIP JMP DEC65 ELSE GO GET THE NEXT ONE * SPC 1 DEC70 LDB VALOC,I GET VALUE LDA TBUF,I IF NEG NUMBER, CPA DASH CMB,INB NEGATE VALUE STB VALOC,I STORE VALUE * DEC75 ISZ WSTAT,I COUNT THE PRAMETER LDA WSTAT,I IF LDB TEMP3 EOL OR CPB TEMPP 8 PRAMS LINE RSS THEN CPA D8 JMP DEC90 GO PROCESS JMP DEC09 ELSE GO GET NEXT CHARACTER SPC 1 DEC80 ISZ TEMP,I SET NOT NUMBER FLAG LDA AASCI FILL THE PRAM WITH BLANKS LDB VALOC PRAM ADDRESS TO B INB DON'T WORRY ABOUT FIRST WORD STA B,I SET SECOND WORD CLE,INB STEP TO THIRD WORD STA B,I SET THIRD WORD TO DOUBLE BLANK. LDB TBUF GET THE TEMP BUFFER POINTER DEC85 CPB TEMP2 END OF INPUT? JMP DEC75 YES GO PROCESS NEXT PRAM CPB STOP SIXTH CHAR YET? JMP DEC75 YES, END PARAM LDA B,I GET THE CHARACTER SEZ,RSS IF UPPER CHARACTER ALF,SLA,ALF ROTATE AND SKIP XOR VALOC,I LOWER ADD THE UPPER CHAR. XOR LASCI ADD/DELETE THES LOWER BLANK STA VALOC,I STORE THE PACKED WORD SEZ,CME,INB STEP B,SKIP IF UPPER ISZ VALOC ELSE STEP STORE ADDRESS. JMP DEC85 GO GET OTHER CHAR. SPC 2 DEC90 ISZ $PRSE STEP RETURN ADDRESS JMP $PRSE,I RETURN SPC 2 "B" OCT 102 ASCII "B" DASH OCT 55 ASCII "-" STOP DEF TEMP5+6 ASCII 6TH CHAR STOP HED MESSAGE PROCESSOR--RT,XXXXX COMMAND * * RT,XXXXX * * THE RELEASE TRACKS ROUTINE FUNCTIONS AS FOLLOWS: * IF PROGRAM STATUS NOT DORMANT, STATUS ERROR. * IF DORMANT, ALL TRACKS ASSIGNED TO THAT PROGRAM * ARE RELEASED - ALL PROGRAMS IN DISC TRACK * ALLOCATION SUSPENSION ARE RESCHEDULED. * M0070 JSB TTNAM GO FIND ID SEGMENT ADDRESS ADB D8 PROGRAM MUST BE DORMANT. LDA B,I WILL BE IF POINT OF SZA SUSPENSION IS ZERO. JMP M0405 OTHERWIZE, ILL STATUS ERROR. LDA WORK GET ID SEGMENT ADDRESS JSB $OTRL RESCHEDULE DISC-SUSP PROGRAMS JMP M0150 RETURN- HED MESSAGE PROCESSOR--ON,XXXXX COMMAND * ***************************************************************** * * ON[IH],XXXXX * ON[IH],XXXXX,NOW * ON[IH],XXXXX,P1,...,P5 * ON[IH],XXXXX,NOW,P1,...,P5 * * THE ON REQUEST FUNCTIONS AS FOLLOWS: * IF NO RESOLUTION CODE, THEN PROGRAM SCHEDULED. * IF -NOW- OPTION, THEN ENTER PROGRAM INTO TIME LIST * AND SET TIME VALUES TO CURRENT TIME PLUS 10 MSC * IF NOT ONE OF ABOVE, AND TIME VALUES ARE ZERO THEN * PROGRAM FUNCTIONS SAME AS -NOW- OPTION. * IF NOT ONE OF ABOVE, AND TIME VALUES ARE PRESENT, * THEN PROGRAM IS ADDED TO TIME LIST. * NOTE: 1)ALL THE ABOVE OPTIONS ALLOW PARAMETERS TO BE * PASSED TO THE PROGRAM. THESE MUST BE ASCII * DECIMALh NUMBERS WHICH ARE CONVERTED TO BINARY * AND STORED IN ID SEGMENT TEMP AREA. UPON * EXECUTION, THE B REGISTER WILL POINT TO TEMP. * UP TO 5 PARAMETERS MAY BE INPUT. IF NO PARA- * METERS ARE INPUT, THE TEMP AREA ARE ZEROS BUT * B REGISTER WILL STILL POINT TO TEMP. AREA * 2) THE ABOVE OPTIONS WILL ALLOW THE ORIGINAL * SCHEDULING STRING TO BE SAVED(UNLESS 'IH' * IS SPECIFIED OR THERE ARE NO PARAMETERS). * THE SCHEDULED PROGRAM MAY RECOVER THIS STRING * WITH AN EXEC 14 CALL. * ******************************************************************** * M0100 JSB TTNAM FIND ID SEGMENT ADDR LDB WSTAT,I IF NO PARAMETERS RBL,RBL BIT IS SET, THEN SSB,RSS ILLEGAL STATUS. SZA CHECK IF PROGRAM DORMANT JMP M0405 ILLEGAL STATUS ERROR JSB $SZIT CHECK OUT THE PROGRAM SIZE SZA IS IT OK ? JMP MSEX NO, FLUSH HIM ! * JSB PLOAD GO TO PROCESS CONTROL PRAMETERS LDB WORK ADB D17 COMPUTE RES/T/MULT ADDR LDA B,I ALF,RAR AND D7 CHECK RESOLUTION CODE SZA NONE, SO GO TO SCHED NOW JMP M0110 M0105 JSB $LIST SCHEDULE PROGRAM OCT 301 JMP MSEX RETURN M0110 INB SET B FOR $ONTM LDA CP2 IF ASCII RAR,SLA "NO" ENTERED LDA P2 THEN CPA NO GO PUT CCA IN THE TIME LIST FOR NOW+10MS. JMP $ONTM COMPLETE IN TIME MODULE HED MESSAGE PROCESSOR--OF,XXXXX COMMAND * * OF,XXXXX * OF,XXXXX,1 "ABORT" * OF,XXXXX,8 "ABORT AND REMOVE FROM SYSTEM" * * THE OF REQUEST FUNCTIONS AS FOLLOWS: * IF PROGRAM DORMANT, IT MAY STILL BE IN TIME LIST SO * A CALL IS MADE TO REMOVE PROGRAM FROM TIME LIST * IF ABORT OPTION 1, THEN $ABRT PROCESSOR IS * CALLED. IF ABORT OPTION 8, IN ADDITION TO * $ABRT PROCESSOR BEING CALLED, IF BIT 7 OF THE * TYPE FIELD IS SET, THEN TRACK(S) WHERE PROGRAM * IS STORED IS ALSO RELEASED BY $DREL. THE NAME * FIELD IN THE ID SEGMENT IS CLEARED SO THAT THE * PROGRAM CANNOT BE CALLED AGAIN. * IF PROGRAM SCHEDULED OR OPERATOR-SUSPENDED, THEN * DORMANT REQUEST MADE VIA LIST PROCESSOR AND * PROCEED AS ABOVE. * IF PROGRAM STATUS NOT ONE OF ABOVE, THE DORMANT BIT * IS SET IN STATUS, IF NOT ABORT OPTION. IF ABORT * OPTION, CHECK IF AVAILABLE MEMORY OR UNAVAILABL * DISC TRACK SUSPENSION-IN WHICH CASE THE ABORT * BIT IS SET AND $ABRT CALLED. IF STATUS IS I/O * SUSPENSION, SET ABORT BIT AND RETURN. * IF INPUT SUSPENSION, CHECK IF * PROGRAM BEING READ IN FROM DISC. IF YES, THEN * SET ABORT BIT AND RETURN. IF NOT BEING READ IN * FROM DISC, SET ABORT BIT AND CALL $IOCL TO * CLEAR THE I/O REQUEST * M0200 JSB TTNAM GO TO FIND ID SEG ADDR M0202 LDB WORK GET ID SEG ADDRESS AND STB TEMPH SAVE IT IN LOCAL STORE SEZ IF SHORT ID-SEG. JMP M0207 GO TEST FOR 8 LDA P2 GET PRAM TWO SZA IF NOT ZERO GO DO POWER THING JMP M0250 * M0240 JSB SABRT GO DO SOFT ABORT JMP $XEQ EXIT DONE * M0250 LDA WSTAT,I POWER ABORT SO AND D15 GET CURRENT STATUS SWP PUT ID-SEG. ADDRESS IN A,STAT IN B CPB D2 IF I/O SUSP THEN JMP $IOCL GO ABORT THE I/O * JSB $ABRT GO TO ABORT ROUTINE B40 CLE CLEAR E FOR TRACK RELEASE * M0207 LDA P2 RELEASE PROG'S TRACKS? CPA D8 IF P = 8, RSS YES JMP $XEQ NO-SO RETURN * LDB TEMPH ADB D14 GET ADDRESS OF LAST LDA B,I NAME WORD ALF,ALF CHECK IF TYPE BIT 7 SET SSA,RSS JMP $XEQ NO-CANNOT REL PROG TRACKS SEZ,INB,RSS IF SHORT ID-SEG. SKIP ADB D7 ELSE INDEX TO MEM ADDRESS FOR LONG LDA B,I CMA,INA INB ADA B,I STA TEMP3 # WORDS OF MAIN INB LDA B,I CMA,INA INB ADA B,I # WORDS IN BASE PAGE INB SET UP THE DISC ADDRESS POINTER STB TEMP1 IN TEMP1 CLB CLEAR FOR DOUBLE SHIFT ADA B177 ROUND UP TO NEAREST SECTOR IOR B177 SET THE LOW BITS AND ADA TEMP3 ADD AND ROUND UP THE MAIN LSR 6 DIVIDE BY 64 TO GET SECTORS STA TEMP5 TOTAL # SECTORS IN PROGRAM LDA TEMP1,I GET THE DISC ADDRESS LSR 7 SHIFT TO TRACK AND B377 ADDRESS AND LDB TEMP1,I CHECK IF LU 2 OR 3 SSB LU 2 ADA TATSD LU 3 STA TEMP2 ACTUAL STARTING TRACK # LDB SECT2 LDA TEMP1,I CHECK IF LU 2 OR 3 SO CAN DIVIDE SSA BY # OF TRACKS FOR THAT LDB SECT3 DISC. STB TEMP LDA TEMP1,I GET THE TRACK ADDRESS AND B177 MASK OUT THE SECTOR ADDRESS CMA,INA,SZA,RSS IF ZERO RELEASE THIS TRACK JMP M0226 ADA TEMP ELSE SUBTRACT FROM TRACK ISZ TEMP2 SIZE STEP TO NEXT TRACK CMA,INA AND COMPUTE THE REMAINING SECTORS M0226 ADA TEMP5 A IS TOTAL NUMBER TO CLB CLEAR FOR DIVIDE STB TEMP1,I WIPE THE TRACK WORD WHILE WERE HERE SZA GEORGES FIX 3/13 SSA RELEASE IF NEGATIVE JMP M0227 FORGET THE WHOLE THING DIV TEMP SZB > CHECK IF PARTIAL TRACK INA YES STA B (B)=# TRACKS LDA TEMP2 (A)=STARTING TRACK JSB $DREL CALL EXEC SYS RELEASE TRACKS M0227 LDB TEMPH ADB D12 CLA STA B,I INB STA B,I INB LDA B,I SAVE THE OLD SHORT/LONG AND B77 FLAG STA B,I * * AND D7 LOOK FOR AN ID EXTENSION CPA D1 MEMORY RESIDENT ? JMP $XEQ THEN WE'RE FINISHED CPA D5 A SEGMENT ? JMP $XEQ THEN WE'RE FINISHED * ADB D14 INDEX TO ID EXT WORD LDA B,I PULL IN EMA INFO SZA,RSS IS THIS AN EMA PROG ? JMP $XEQ NO, SO WERE DONE * ALF YES, SO GET THE ID EXT RAL,RAL AND M77 ADA $IDEX GET THE ID EXT ADDRESS LDA A,I NOW HAVE THE ADDRESS CLB STB A,I NOW ZAP THE WORD. JMP $XEQ NOW WE'RE DONE. GO SEE WHAT'S NEW. * M77 OCT 77 * * * SKP SPC 1 * * THE SOFT ABORT ROUTINE CLEARS ANY RESOURCE FLAGS * CALLS THE TERMINATION ROUTINE AND REMOVES A PROGRAM FROM * THE TIME LIST. * * IT ALSO SETS THE ABORT FLAG (100000) IN THE FATHERS ID-SEG. * (IF THERE IS A FATHER AND HE IS WAITING) SO THAT RMPAR * MAY RECOVER THE PRAMETER. * * IF THE PROGRAM IS WAITING FOR A SON IT CLEARS THE SONS * "FATHER IS WAITING" FLAG. * * CALLING SEQUENCE: * * LDB ID-SEG. ADDRESS * JSB SABRT * * RETURN REGISTERS MEANING LESS. * * THIS ROUTINE DOES NOT GENERATE AN ABORT MESSAGE NOR DOES IT * PULL A PROGRAM OUT OF AN I/O LIST. ($LIST DOES SET A FLAG * WHICH WILL PUT THE PROGRAM DORMANT ON I/O COMPLETION. * SABRT NOP STB TEMPH SAVE THE ID ADDRESS ADB D15 GET THE STATUS LDA B,I WORD AND ZAPR CLEAR THE RESOURCE BIT STA B,I RESET IT INB SET B +TO THE TIME LIST WORD JSB $TREM REMOVE PGM FROM THE TIME LIST LDB TEMPH RESTORE THE ID ADDRESS AND ADB D15 INDEX TO THE STATUS WORD LDB B,I AND FETCH IT BLF,SLB IF PROGRAM IS WAITING JMP SABT2 GO CLEAR THE SONS FLAG * SABT1 LDB TEMPH RESTORE THE ID-SEG. ADDRESS AND JSB TERM CALL THE TERMINATION PROCESSOR ISZ POP STEP TO THE FATHER'S FIRST PRAM WORD RSS JMP SABRT,I LDA SIGN SET SIGN BIT FOR FATHER ABORT FLAG STA POP,I SET THE ABORT FLAG LDB POP CACULATE THE B-REG ADDRESS ADB D9 AND LDA POP SET IT TO STA B,I POINT TO THE ABORT WORD JMP SABRT,I DONE RETURN * SABT2 LDB TEMPH GET THE SONS ID ADDRESS INB FROM WORD TWO LDB B,I OF THE ID-SEGMENT ADB D20 INDEX TO THE FATHER WAIT FLAG WORD LDA B,I GET THE WORD RAL,CLE,RAL CLEAR BIT 14 ERA,RAR AND STA B,I RESTORE THE WORD JMP SABT1 GO TERMINATE THE PROGRAM SPC 2 TEMPH DEF FMGR D12 DEC 12 DM24 DEC -24 DM60 DEC -60 ZAPR OCT 177477 HED MESSAGE PROCESSOR--SS,XXXXX COMMAND * * SS,XXXXX PROCESSOR * * THE SUSPEND REQUEST FUNCTIONS AS FOLLOWS: * IF PROGRAM DORMANT OR OPERATOR SUSPENDED, THEN * ILLEGAL STATUS ERROR * IF SCHEDULED, THEN OPERATOR SUSPEND VIA $LIST * IF OTHER THAN ABOVE, SET THE OPERATOR-SUSPEND BIT * IN STATUS. AND ALL THESE WONDERS ARE * BY $LIST. * M0300 JSB $LIST OCT 206 SCHED TO OPER-SUSP DEFP1 DEF P1 BY NAME SZA IF ERROR JMP MSEX EXIT * LDA WSTAT,I SET THE NO PRAMS IOR B20K BIT STA WSTAT,I TO PREVENT PRAMS ON RESTART LDA WORK GET ID ADR JSB ALDM GO PUT IN DORM LIST & SET DM FLAG A JMP M0150 EXIT SPC 2 B20K OCT 20000 HED MESSAGE PROCESSOR--GO COMMAND * ***************************************************************** * * GO[IH],XXXXX * GO[IH],XXXXX,P1,...,P5 * * THE CONTINUE FROM POINT OF SUSPENSION FUNCTIONS AS * FOLLOWS: * IF NOT OPERATOR SUSPEND: * BIT SET - REMOVE OPER-SUSP BIT IN STATUS * BIT NOT SET - ERROR EXIT FOR MESSAGE * IF OPERATOR SUSPEND, SCHEDULE PROGRAM. UNLESS * 'IH' IS SPECIFIED OR NO PARAMETERS ARE GIVEN, * ANY PREVIOUS OPERATOR SCHEDULING STRING IS * RELEASED AND THE 'GO' SCHEDULING STRING IS * SAVED FOR RETRIEVAL BY THE PROGRAM USING AN * EXEC 14 CALL. * ***************************************************************** * M0400 JSB TTNAM GO TO FIND ID SEG ADDR CPA D6 CHECK IF PROGRAM OPERATOR-SUSPEND JMP M0410 OPERATOR-SUSPEND--SO GO TO PROCESS LDA WSTAT,I NOT OPER SUSP - AND B1000 IS BIT SET? SZA,RSS JMP M0405 NO, ERROR- XOR WSTAT,I YES, CLEAR BIT STA WSTAT,I AND M0150 CLA EXIT JMP MSEX * M0405 LDA $ILST ILLEGAL STATUS MESSAGE ADDRESS JMP MSEX EXIT SKP * ***************************************************************** * * RU[IH],XXXXX * RU[IH],XXXXX,P1,...,P5 * * THE RU COMMAND FUNCTIONS AS FOLLOWS: * IF DORMANT, THE PROGRAM IS SCHEDULED. * PARAMETERS MAY BE PASSED TO THE PROGRAM. THESE * ARE TREATED LIKE PARAMETERS IS THE GO COMMAND * (SEE NOTE 1 FOR THE GO COMMAND). * THE SCHEDULING STRING MAY BE SAVED. SEE NOTE 2 * FOR THE GO COMMAND. * ******************************************************************* * M0408 JSB TTNAM RUN COMMAND ROUTINE LDB WSTAT,I IF NO PARAMETERS RBL,RBL BIT IS SET, THEN SSB,RSS ILLEGAL STATUS. SZA IF NOT DORMANT JMP M0405 GIVE THE MESSAGE,ELSE DO IT * JSB $SZIT CHECK OUT PROGRAM SIZE SZA OK ? JMP MSEX NO ! * M0410 LDA D2 CHECK IF CONTROL PARAMETERS FOLLOW CPA PARAM JMP M0105 NO,DO NOT RETURN STRING,SCHEDULE PROGRAM. * JSB PLOAD GO TO PROCESS CONTROL PARAMETERS JMP M0105 GO SCHEDULE THE PROGRAM HED MESSAGE PROCESSOR--ST,XXXXX COMMAND * * ST,XXXXX PROCESSOR * * IF XXXXX = 0 NAME AND PARTITION# OF CURRENT PGM IS PRINTED * IF XXXXX > 0 NAME OF THE PGM IN PARTITION #XXXXX IS PRINTED * THE STATUS REQUEST OUTPUTS THE REQUESTED PROGRAM STATUS * IN THE FOLLOWING FORMAT: * PRPRP S R MMMM HR MN SC MS T * * PRPRP =PRIORITY * S = STATUS (0 THRU 6 * R = RESOLUTION CODE (0 THRU 4) * MMM = MULTIPLE VALUE * HR = NEXT START TIME -HR * MN = NEXT START TIME -MIN * SC = NEXT START TIME -SEC * MS = NEXT START TIME -10 MSEC * T = PRESENT IF PROGRAM IN TIME LIST * M0500 LDB XEQT IF ZERO SZA,RSS GIVE STATUS OF JMP M0540 CURRENT PGM SSA JMP M0505 IF NEG, ASSUME WANT PRG STATUS LDB $MNP GET THE MAX # OF PARTITIONS CMB IF (A) .LE. TOTAL ADB A NUMBER OF PTTNS SSB THEN GIVE PTTN STATUS JMP M0530 * M0505 JSB TTNAM GO TO FIND ID SEGMENT ADDR CPB D5 IS THIS A SEGMENT ? LDA D9 THEN GET THE SEGMENT FLAG CLB,CCE STB RQP3 SET UP FOR $TIMV CALL JSB $CNV1 CONVERT STATUS TO ASCII. ALF,ALF MOVE TO HIGH HALF WORD STA BUFF4 STORE STATUS IN BUFFER. LDB DM28 CPA BL9 IF SHORT ID-SEG  LDB DM8 SET FOR 8 CHAR. MESS STB BUFFR STORE CHARACTER COUNT IN BUFFER LDB WORK ADB D6 PRIORITY ADDRESS CPA BL9 IF SHORT ID-SEG CLA,RSS SET PR TO 0 LDA B,I JSB $CNV1 CONVERT PRIORITY TO ASCII LDB ASCI1 GET DIGITS 23-45 TO B-A RRL 8 34-52 IN B-A STB BUFF2 SET 34 LDB ASCI 1-52 IN B-A ALF,ALF 1-25 IN B-A RRL 8 12-5 IN B-A STB BUFF1 SET 12 STA BUFF3 SET 5 BLANK LDB TEMP6 RESTORE B TO PRIOR ADDRESS ADB D11 RESOL CODE/MULT ADDRESS LDA B,I ALF,RAR AND D7 JSB $CNV1 CONVERT RESOLUTION CODE TO ASCII ALF,ALF ROTATE TO HIGH HALF WORD STA BUFF5 STORE RESOLUTION CODE IN BUFFER LDA B,I AND B7777 JSB $CNV1 CONVERT MULTIPLE TO ASCII STA BUFF7 STORE MULTIPLE IN BUFFER LDA ASCI1 STA BUFF6 STORE MULTIPLE IN BUFFER LDA B,I CHECK IF PROG IN TIME LIST ALF,SLA TEST BIT 12 (T) BIT JMP M0510 YES LDA AASCI PROGRAM NOT IN TIME LIST RSS M0510 LDA TZERO PROG IN TIME LIST STA BUF14 STORE ASCII BLANK OR T IN BUFFER INB SET B TO TIME ADDRESS LDA DTEMP SET UP TO GET TIME TO STA RQP2 TEMP AREA DLD B,I GET TIME FROM ID-SEG JSB $TIMV CONVERT THE TIME LDA TEMP3 GET HOURS JSB $CNV1 CONVERT LDB ASCI1 GET VALUE RRR 8 ROTATE TO BLANK ON EACH SIDE DST BUFF8 SET IN MESSAGE LDA TEMP2 GET MIN. VALUE JSB $CNV1 CONVERT STA BUF10 STUFF IN BUFFER LDA TEMP1 AND AGAIN FOR SEC JSB $CNV1 LDB ASCI1 VALUE TO A BLANK TO B RRR 8 ROTATE DST BUF11 SET IN BUFFER LDA TEMP ONE MORE TIME FOR 10'S O]F MS. JSB $CNV1 STA BUF13 STORE TENS OF MSEC IN BUFFER M0520 LDA BUFAD LOAD A WITH OUTPUT BUFFER ADDRESS JMP MSEX RETURN SPC 1 TZERO ASC 1, T D11 DEC 11 B7777 OCT 7777 DTEMP DEF TEMP BL9 ASC 1,9 BLANK 9 DM28 DEC -28 DM1 DEC -1 SPC 1 M0530 ADA DM1 MPY D7 (PTTN#-1)*7 IS ADA $MATA ADDR OF ENTRY IN MATA ADA D2 +2 FOR ID SEG ADDR WORD LDB A,I (B)=ID SEG ADDR JMP M0550 GO PRINT PRG NAME * M0540 SZB,RSS ANY PRG RUNNING? JMP M0550 NO PRINT 0 ADB D21 GET PARTITION # LDA B,I FROM ID SEG WORD 22 AND B77 CCE,INA GET USERS ACTUAL PART NUMBER JSB $CNV1 CONVERT TO DECIMAL STA BUFF4 SET IN MESSAGE LDB XEQT (B)=ID SEG ADDR LDA DM8 (A)=COUNT 8 CHARS JMP M0560 GO PRINT M0550 CCA SET A FOR ZERO PRINT SZB SKIP IF NO PROGRAM LDA DM5 ELSE RESET A FOR PGM PRINT M0560 STA BUFFR SET MESSAGE LENGTH LDA MPT81 GET UPPER ASCII "0" TO A SZB SKIP IF NO PGM ADB D12 ELSE STEP TO NAME ADDRESS LDA B,I STA BUFF1 SET NAM12 INB STEP TO NEXT NAME WORD DLD B,I GET THE NEXT WORDS STA BUFF2 SET NAM34 LDA AASCI FILL RIGHT BLANK BLF,BLF INTO NAM5 RRL 8 STB BUFF3 SET NAM5 JMP M0520 GO EXIT * * SPC 2 HED OVERLAY - INPUT - OUTPUT BUFFER AREA $PBUF DEF PRAMS SET ADDR OF OVERLAY AREA FOR EXEC *********************************************************************** * INPUT MESSAGE BUFFER IBUFX DEF *+1 LOCAL MESS INPUT BUFFER (FOR MESSS) IBUFY BSS 40 * * INBUF BSS 40 MESSAGE INPUT BUFFER BUFFL EQU *-INBUF+*-INBUF LENGTH IN #CHARS * *********************************************************************** * SPC 2 FNLH * SYSTEM OUTPUT BUFFER * BUFFR EQU * SHOULD BE AT LEAST 15 WORDS LONG BUFF1 EQU BUFFR+1 BUFF2 EQU BUFFR+2 BUFF3 EQU BUFFR+3 BUFF4 EQU BUFFR+4 BUFF5 EQU BUFFR+5 BUFF6 EQU BUFFR+6 BUFF7 EQU BUFFR+7 BUFF8 EQU BUFFR+8 BUFF9 EQU BUFFR+9 BUF10 EQU BUFFR+10 BUF11 EQU BUFFR+11 BUF12 EQU BUFFR+12 BUF13 EQU BUFFR+13 BUF14 EQU BUFFR+14 * * PARAMETER POINTERS FOR DATA STORAGE * PRAMS BSS 1 CHARACTER COUNT-OP CODE OP BSS 3 OPERATION CODE CP1 BSS 1 CHAR COUNT-PARAM 1 P1 BSS 3 PARAM 1 (UP TP 3 WORDS-6CHAR.) CP2 BSS 1 CHAR COUNT-PARAM 2 P2 BSS 3 PARAMETER 2 CP3 BSS 1 CHAR COUNT-PARAM 3 P3 BSS 3 PARAMETER 3 CP4 BSS 1 CHAR COUNT-PARAM 4 P4 BSS 3 PARAMETER 4 CP5 BSS 1 CHAR COUNT -PARAM 5 P5 BSS 3 PARAMETER 5 CP6 BSS 1 CHAR COUNT-PARAM 6 P6 BSS 3 PARAMETER 6 'NCP7 BSS 1 CHAR COUNT-PARAM 7 P7 BSS 3 PARAMETER 7 PARAM BSS 1 PARAMETER COUNTER * $OP EQU OP ENDT EQU * ********************************************************************** * HED SYSTEM START UP ROUTINE * * WHEN THE SYSTEM IS BOOTED UP A JMP 3,I IS MADE. * THE DESTINATION OF THE JUMP IS $STRT. THE CODE FROM HERE TO * OVCHK IS EXECUTED ONCE AT START UP AND LATER OVERLAYED FOR I/O * BUFFERS AND OTHER TEMPS NEEDEDBY THE SYSTEM. * * ORG IBUFY PUT INIT CODE IN BUFFER * * $STRT LIA 1 GET THE SWITCH REGISTER LIB 1 AND B70K KEEP TOP OCTAL DIGIT SZA,RSS = 0 ? JMP TOIT YES, NO HALT &NO DBUG XOR B GET RID OF THE BITS OTA 1 AND RESET THE SWTCH REGISTER XOR B GET THE BIT BACK ALF ROTATATE TO LOW END UNL * IFN LST CPA D7 IF = 7 & DDT IN SYS, THEN HALT RSS TO LET THEM SET SWITCH REGISTER JMP DOHLT AND THEN CALL $DDT ON THEIR BEHALF HLT 75B JSB $DDT DEF TOIT XIF UNL IFZ BSS 6 XIF LST * DOHLT CPA D6 HLT 76B TOIT JSB $SYMP SET UP THE SYSTEM MAP JSB $CNFG NOW GO DO RECONFIGURATION * LDA DM5 GET THE LOOP VARIABLE STA TEMP5 PREPARE TO CALL $ALC LDA DEQT1 TO RETURN BLOCKS OF MEMORY STA TEMP6 TO INITIALIZE SYSTEM AVAILABLE MEMORY MRTNL LDA TEMP6,I BLOCK ADDRESSES ARE IN PAIRS STA MADR1 EQT1 THRU EQT12 ISZ TEMP6 LDA TEMP6,I STA NWDS1 ISZ TEMP6 JSB $RTN RETURN A BLOCK MADR1 NOP NWDS1 NOP ISZ TEMP5 DONE WITH EQT1 THRU EQT10? JMP MRTNL NO, RELEASE NEXT BLOCK JMP $ALC NEXT GO TO $ALC FOR CONFIGURATION * DEQT1 DEF EQT1 GOES TO GTFMG FROM $ALC VIA $WORK * GTFMG LDB TEMPH GET FMGR'S NAME ADDRESS A JSB $ZZZZ GO TO DISPATCHER TO SET UP LDB TERM GET ADDRESS JSB TNAME OF D.RTR TO B SEZ,RSS IF NONE SKIP STB ID.RT SET FOR LATER. LDB P1OR2 LOOK UP EDIT'S ADDRESS JSB TNAME ALSO SEZ,RSS IF NONE SKIP STB ID.RT+1 SET IN LIST LDB TEMPH NOW FIND JSB TNAME FMGR'S ID-SEGMENT ADDRESS SEZ,RSS IF NONE SKIP STB IDFMG SET ADDRESS LDB DSMP JSB TNAME SEZ,RSS STB $IDSM * LDA IDFMG GET FMGR'S ID ADDRESS SZA,RSS ANY FMGR ? JMP NOFMG NO, SO FORGET ABOUT ANY CHECKS * STA WORK SET UP HIS ADDRESS IN $WORK JSB $SZIT SEE IF THERE'S A PART'N LARGE ENOUGH SZA WELL IS THERE ? JMP NGFMG NO, YOU BLEW THE RECONFIGURATION TURKEY !!!! * LDA ID.RT OK, SO YOU DID THAT RIGHT. BUT DID YOU SZA,RSS YOU GIVE D.RTR ENOUGH ROOM ? JMP NOFMG NO D.RTR HUH . * STA WORK SET UP FOR THE TEST JSB $SZIT SEE IF THERE IS ENOUGH ROOM SZA OK ? JMP NGFMG NO. * NOFMG LDA D$RN TRACK DOWN RN TABLE ADDRESS RAL,CLE,SLA,ERA IF INDIRECT LDA A,I USE NEXT LEVEL * LDB IDADS GET ADDRESS OF ID ADDRESSES JMP $ERMG GO TO EXEC TO SET UP NO RETURN * NGFMG HLT 10B NO ROOM FOR FMGR, SO YOU LOSE !!!!!!! JMP *-1 YOU LOSE AGAIN ! * * * IDADS DEF ID.RT FMGR ASC 3,FMGR D.RTR ASC 3,D.RTR DSMP DEF *+1 ASC 3,SMP D$RN DEF $RNTB * $SYMP NOP LDA $DLP GET THE LOAD POINT ALF AND GET THE # OF PAGES RAL,RAL STA $CMST * LDA $DLP GET IT AGAIN CMA,INA MAKE IT NEG ADA BKCOM ADD LENGTH & START OF COMMON LDB $MPFT ADB D3 ADA B,I * SZA,RSS ANY COMMON AT ALL ? JMP NCOMN NO AND B76K YES.n SO GET PAGE BITS ALF TO LOW END RAL,RAL AND SAVE IT NCOMN STA $COML THIS IS THE LENGTH(IN PAGES) OF COMMON * ADA $CMST ADD IN START PAGE OF COMMON & STA $SDA WE HAVE THE START OF THE SYS DVR AREA * LDB $PLP GET THE PRIV LOAD POINT BLF GET PAGE # TO LOW END RBL,RBL CMA,INA SUBTRACT FROM START OF SYS DVR AREA ADA B TO GET LENGTH OF TB 1 & SYS DVR AREA STA $SDT2 * LDA LBORG NOW GET THE LIBRARY ORGIN ALF CONVERT TO PG # RAL,RAL STA $RLB AND SET AS START OF RES LIB * LDB $MPFT NOW INB GET START OF MEM RES AREA LDB B,I TO LOW END BLF RBL,RBL CMA,INA ADD IN START OF LIBRARY ADA B AND WE GET THE LENGTH STA $RLN OF THE RES LIBRARY * * SPC 1 * SET UP THE SYSTEM MAP AND RETURN SPC 1 * CLA START REGISTER 0 CLB START VALUE = 0 LDX $SDA SET EM UP TO START OF SYS DVR AREA XMS DO IT ! * ADB WRTPR NOW GET THE WRITE PROTECT STA TBL SAVE START REGISTER LDA $SDA GET START VALUE CMA,INA MAKE NEG TO GET # OF REGS ADA D32 LEFT TO SET UP CAX PUT IN X-REG LDA TBL RESTORE START REG XMS AND PLAY IT AGAIN SAM. * LDA $MPSA GET START PAGE SYS AV AND B1777 STA TBL B HAS START VALUE LDA EQT1 AND B1777 XOR EQT1 KEEP ONLY PAGE ALF RAL,RAL GET IN LOW 5 BITS STA NWDS1 START PAGE OF SAM LDA TBL XOR $MPSA GET LENGTH ALF RAL,RAL A HAS LENGTH CAX PUT IN XREG LDB TBL START PAGE NUMBER ADB WRTPR AND WRITE PROTECT LDA NWDS1 START REGISTER XMS LOADo5 MAP * * STA NWDS1 SAVE REGISTER # LDA $MPS2 GET THE 2ND CHUNK OF SAM AND B1777 SAVE THE PHY PG # LDB A PUT IN B ADB WRTPR AND SET UP WRITE PROTECT XOR $MPS2 NOW GET # OF PAGES ALF RAL,RAL TO LOW END CAX AND PUT INTO X AS # OF REGISTERS LDA NWDS1 GET START REG BACK AGAIN XMS AND DO IT SJP $SYMP,I SET UP SYSTEM MAP & RETURN TBL NOP *$MPSA-$MPS2 0-9 START PG SAM * 10 - 15 NUMBER PGS SAM WRTPR OCT 40000 B70K OCT 70000 B76K OCT 76000 * OVCHK EQU *-ENDT OVERLAY CHECK * HED MESSAGE PROCESSOR--IT,XXXXX COMMAND * IT,XXXXX * IT,XXXXX,R,MMM * IT,XXXXX,R,MMM,HR,MN * IT,XXXXX,R,MMM,HR,MN,SC * IT,XXXXX,R,MMM,HR,MN,SC,MS * * R=RESOLUTION CODE * 1= TEN MILLISECOND CODE * 2= SECONDS CODE * 3= MINUTES CODE * 4= HOURS CODE * MM= MULTIPLICATION FACTOR * HR= START HOURS * MN= START MINUTES * SC= START SECONDS * MS= START TENS OF MILLISECONDS * M0600 JSB TTNAM GO FIND ID SEG ADDR SZA PROG MUST BE DORMANT TO CONTINUE JMP M0405 ILLEGAL STATUS ERROR LDA WORK SET ADA D17 UP THE TIME PRAMETER STA TEMPP STARTING ADDRESS. LDB P2 GET THE RESOLUTION ADB DM5 CODE AND TEST SSB,RSS FOR MORE THAN 4. JMP $INER GREATER THAN 4-ILLEGAL CODE LDA P3 GET THE MULT. FACTOR. LDB TEMPP,I GET THE OLD TIME PRAM. BLF,ERB IF IN TIME LIST ALF,ERA SET BIT IN NEW WORD. LDB P2 GET RESOLUTION TO B SZB,RSS IF ZERO RESOLUTION JMP M0605 GO REMOVE FROM TIME LIST LSR 3 SHIFT THE WHOLE MESS TO A M0604 STA TEMPP,I SET NEW RESOLUTION MULT. ISZ TEMPP INCR TO TMS ADDRESS LDA P7 GET TENS OF MS. ADA DM100 SSA,RSS MINUS, IF LEGAL VALUE JMP $INER INPUT ERROR LDA P6 GET SECONDS VALUE ADA DM60 SSA,RSS MINUS, IF LEGAL VALUE JMP $INER INPUT ERROR LDA P5 GET MINUTES. ADA DM60 SSA,RSS YES, SO CONVERT TO DECIMAL JMP $INER INPUT ERROR LDA P4 GET HOURS ADA DM24 SSA,RSS MINUS, IF LEGAL VALUE JMP $INER INPUT ERROR LDA DP4 SET DEFS TO THE PRAMS STA RQP5 ON THE BASE LDA DP5 PAGE FOR STA RQP6 $ETTM LDA DP6 THE SET TIME STA RQP7 SUBROUTINE LDA DP7 IN THE STA RQP8 RTIME MODULE LDB TEMPP GET ID-SEG ADDRESS AND JSB $ETTM GO SET VALUES IN ID-SEG JMP M0150 EXIT $MESS SPC 2 M0605 CCB REMOVE PGM FROM TIME ADB TEMPP LIST JSB $TREM CLA AND CONTINUE JMP M0604 SETTING UP THE ID-SEG SPC 1 DM100 DEC -100 SPC 2 BLIM CLB,CCE,INB CHECK TO SEE IF EXAMINE CPB PARAM ONE PRAM? JMP BLIMP YES GO PRINT LIMITS * LDB P2 GET THE SECOND PRAMETER CMB,INB,SZB GET NEW UPPER LIMIT STB $BLUP IF ZERO SKIP THE STORE CMA,INA SET UP THE LOWER LIMIT STA $BLLO JMP M0150 GO EXIT DONE SPC 1 BLIMP LDA $BLLO GET THE LOWER LIMIT CMA,INA SET POSITIVE JSB $CNV1 CONVERT TO ASCII OCTAL STA BUFF3 SET LOW DIGITS DLD ASCI GET THE HIGH 4 DIGITS DST BUFF1 AND SET IN BUFFER LDA $BLUP GET THE UPPER LIMIT CMA,CCE,INA SET POSITIVE JSB $CNV1 CONVERT STA BUFF7 SET THE LOW DIGITS DLD ASCI GET THE HIGH DIGITS DST BUFF5 SET IN THE BUFFER LDA AASCI GET A DOUBLE BLANK STA BUFF4 SET BETWEEN THE NUMBERS LDA DM14 GET RECORD LENGT}'H STA BUFFR SET IN THE BUFFER AND JMP M0520 GO SEND THE MESSAGE SPC 1 HED MESSAGE PROCESSOR--PR,XXXXX,ZZ COMMAND * * PR,XXXXX,ZZ PROCESSOR * * THE PRIORITY CHANGE ROUTINE FUNCTIONS AS FOLLOWS: * IF PROGRAM STATUS OTHER THAN DORMANT, STATUS ERROR. * IF DORMANT, THEN PRIORITY VALUE CHANGED AND PROGRAM * LIST UPDATED VIA LINK PROCESSOR. * M0650 JSB TTNAM GO TO FIND ID SEG ADDR LDA P2 GET PRIORITY SSA,RSS SZA,RSS CHECK IF ZERO PRIORITY REQ JMP $INER ERROR-ILLEGAL VALUE LDB WORK ADB D6 STA B,I STORE NEW PRIORITY VALUE STA NPCNG SAVE NEW PRIORITY JSB $LIST RELINK THE PROGRAM OCT 317 BY NEW PRIORITY LDB NPCNG GET NEW PRIO LDA WORK GET ID ADR JSB PRCNG GO RELINK IN ALLOCATED LIST CLA JMP MSEX RETURN NPCNG BSS 1 SPC 5 * MESSAGE PROCESSOR -- TM COMMAND * M0700 LDB DEFP1 PASS PRAM. ADDRESS TO JMP $TMRQ RTIME PROCESSOR SPC 2 * MESSAGE PROCESSOR -- BR,XXXX REQUEST * * SET BREAK BIT IN PROGRAMS ID-SEGMENT * M0725 JSB TTNAM LOOK UP THE PROGRAM M0730 ADB D20 INDEX TO BREAK WORD LDA B,I GET WORD IOR B10K SET BREAK BIT STA B,I RESTORE THE WORD JMP M0150 EXIT HED MESSAGE PROCESSOR--TI COMMAND * * TI COMMAND * * THE REQUEST TO GET CURRENT SYSTEM TIME OUTPUTS CURRENT * YEAR, DAY NUMBER, HOUR, MINUTES, AND SECONDS IN THE * FOLLOWING FORMAT: * YEAR.DAY..HR..MN..SC * WHERE THE .'S ARE BLANKS * M0750 LDA DM20 STA BUFFR SET OUTPUT CHARACTER COUNT LDA DTEMP SET UP TO GET THE TIME STA RQP2 TO TEMP AREA ADA D5 STA RQP3 DLD $TIME JSB $TIMV GO GET TIME JSB $CNV1 CONVERT YEARS STA BUFF2 = SET LEAST TWO DIGITS LDA ASCI1 GET THE NEXT TWO DIGITS STA BUFF1 AND SET THEM LDA TEMP4 GET DAYS JSB $CNV1 CONVERT AND STORE DAYS STA BUFF4 SET LEAST TWO DIGITS LDA ASCI1 GET NEXT DIGIT STA BUFF3 SET IN BUFFER LDA AASCI STUFF NECESSARY WORDS WITH STA BUFF5 BLANKS STA BUFF7 STA BUFF9 LDA TEMP3 GET HOURS JSB $CNV1 CONVERT AND STORE HOURS STA BUFF6 LDA TEMP2 JSB $CNV1 CONVERT AND STORE MINUTES STA BUFF8 LDA TEMP1 JSB $CNV1 CONVERT AND STORE SECONDS STA BUF10 JMP M0520 GO SET A AND EXIT SPC 1 DM20 DEC -20 * * DN,N1 OR DN,,N2 * * THE REQUEST TO DOWN AN EQT OR LU WORKS AS FOLLOWS: * IF N1 IS GIVEN, DOWN THE EQT POINTED TO BY N1. * IF N2 IS GIVEN, DOWN THE LU POINTED TO BY N2. * M0800 CCE NO THIRD PARAMETER. JSB P1OR2 SET A=PARAMETER 1, B=PARAMETER 2. JMP $IODN GO TO 'DOWN' ROUTINE. HED MESSAGE PROCESOR--LU,EQ AND TO COMMANDS * * MESSAGE PROCESSOR --LU,N1,N2 COMMAND * * REQUEST OF LOGICAL UNIT ASSIGNMENT (N1 VALUE ONLY) OR * REQUEST LOGICAL UNIT REASSIGNMENT(N1 & N2 - OR * N1, N2 ,& N3 PRESENT) * M0850 CLE SET THE N3 POSSIBLE SWITCH JSB P1OR2 SET UP PARAMETERS JMP $LUPR * * SPC 1 SPC 1 * * MESSAGE PROCESSOR ---- EQ,N1,N2 COMMAND * * * REQUEST EQUIPMENT STATUS (N1 PARAMETER ONLY) * REQUEST EQUIPMENT BUFFERING OR NON BUFFERING (N1 & N2) * N2 = 0 FOR NO BUFFERING * N2 = 1 FOR BUFFERING * M0900 CCE CLEAR N3 POSSIBLE SWITCH JSB P1OR2 SET IT UP JMP $EQST * * D29 DEC 29 D28 DEC 28 DM12 DEC -12 DM6 DEC -6 SPC 1 SPC 1 * MESSAGE PROCESSOR TO,N1,N2 COMMAND * * * REQUEST DEVICE TIME OUT PARAMETERS (N1 ONLY) * REQUEST TO ASSIGbN DEVICE TIMEOUT (N1 & N2) * N1 = DEVICE EQT # * N2 = TIME OUT PARAMETER TO BE ASSIGNED * M0990 CCE CLEAR N3 POSSIBLE SWITCH JSB P1OR2 SET IT UP JMP $CHTO * * * * SKP P1OR2 DEF ABM ENTRY/EXIT LDA CP2 CHECK IF JUST SZA,RSS ONE PARAMETER JMP P1OR5 YES - GO EXIT LDA P2 GET SECOND PRAM. SEZ,RSS IS A THIRD PARAMETER POSSIBLE? JMP P1OR7 YES P1OR3 LDB A LOAD B WITH 'N2' OR 'N3:N2' P1OR4 LDA P1 LOAD A WITH N1 JMP P1OR2,I P1OR5 CCB SET B REG TO -1 FOR 1 PARAMETER JMP P1OR4 P1OR7 AND B377 SAVE BITS 7-0 STA P2 OF 'N2' LDA P3 GET 'N3' AND B37 KEEP BITS 4-0 AND LSL 11 MOVE THEM TO POSITIONS 15-11 ADA P2 ADD IN THE 'N2' PRAM JMP P1OR3 GO EXIT * B37 OCT 37 * * INPUT ERROR MESSAGE OUTPUT * * $INER LDA $ERIN INPUT ERROR MESSAGE JMP MSEX RETURN HED MESSAGE PROCESSOR -- AB COMMAND * * MESSAGE PROCESSOR -- AB COMMAND * * THE AB COMMAND ABORTS THE BATCH PROGRAM CURRENTLY * BEING EXECUTED * * IT TRACKS DOWN THE LOWEST LEVEL USING FMGR AS THE * FIRST LEVEL. IF FMGR IS NOT WAITING THEN IT'S BREAK * FLAG IS SET. IF FMGR IS DORMANT THE REQUEST IS ILLEGAL * IF D.RTR IS AT THE END OF THE LIST THEN THE * INVOLKING PROGRAM IS ABORTED OR, IF FMGR, THE BREAK FLAG * IS SET. * M0950 ALR,ALF KILL BIT 3 (NEVER =8) STA P2 SET THE OPTION FLAG LDB IDFMG GET FMGR'S ID-SEG. ADDRESS M0951 STB WORK AND SET UP WORK SZB IF NO FMGR SKIP ADB D15 INDEX TO STATUS LDA B,I GET STATUS AND D15 IF FMGR IS DORMANT SZA,RSS THEN JMP M0405 ILLEGAL STATUS EXIT * LDA B,I GET STATUS ALF,CLE,SLA IF WAITING JMP M0958 GO TRACK DOWN * M0955 LDB IDFMG GET FMGR'S ID-SEG ADDRESS CPB WORK IF SAME AS CURRENT JMP M0730 GO SET BREAK FLAG * JMP M0202 ABORT * M0958 LDB WORK GET CURRENT ID INB STEP TO WAIT PROGRAM LDB B,I GET ADDRESS CPB ID.RT IF D.RTR JMP M0955 GO DO PREVIOUS PGM. * CPB $IDSM IF SMP JMP M0955 GO TO PREV. JMP M0951 AND CONTINUE HED MESSAGE PROCESSOR - LS N1,N2 PROCESSOR * * SET "SOURCE FILE" IDENTIFICATION * * THE OPERATOR REQUEST IS: * "LS,LUN,1ST TRACK # " * THIS STATEMENT SETS THE SOURCE FILE CONTROL WORD * IN THE COMMUNICATION AREA IN THE FOLLOWING * FORMAT( THE WORD IS LABELED "SFCUN" ): * ******************************* * *LU* ST. TRACK #* ZERO * * ******************************* * 15,14 - 7,6 - 0 (BITS) * * THE LOGICAL UNIT # AND STARTING TRACK # ARE * RECORDED BY THE 'EDITOR' WHEN THE SOURCE FILE * IS CREATED. * * VALIDITY CHECKS ARE FOR LOGICAL UNIT = 2 OR 3, * HOWEVER, A LU = 0 WILL SET "SFCUN" = 0. * M0960 CLB IF PARAM 1 = 0, GO TO SZA,RSS JMP M0961 CLEAR "SFCUN" CLE,ERA SET E IF LU 3. CPA D1 IF NOT LU 2 OR THREE CPB CP2 OR P2 NOT SUPPLIED THEN TAKE JMP $INER ERROR EXIT. ERB SET SIGN OF B TO 1 IF LU 3. ADB P2 ADD THE TRACK AND ASL 7 NORMALIZE (I.E. PUT IN 14-07) * M0961 STB SFCUN SET "SFCUN" JMP M0150 GO EXIT * ID.RT NOP ID.ED NOP IDFMG NOP $IDSM JMP GTFMG START UP CODE HED MESSAGE PROCESSOR - LG,N COMMAND * * SET "LOAD-AND-GO" PARAMETERS * * THE OPERATOR STATEMENT IS: * "LG,# OF TRACKS" * * THIS STATEMENT ALLOWS THE OPERATOR TO: * 1. ALLOCATE A NUMBER OF CONTIGUOUS DISC * TRACKS FOR 'LOAD-AND-GO' USAGE. * 2. RELEASE TRACK(S) CURRENTLY ASSIGNED TO LGO. * * THIS REQUEST HAS NO EFFECT IF LGO CURRENTLY IN USE * * THE BASE PAGE COMMUNICATION AREA WORDS DESCRIBED * BELOW CONTAIN THE LGO TRACK ASSIGNMENTS: * * ******************************** * 'LGOTK' *LU* ST. TRACK # * # OF TRACKS * * ******************************** * 15,14---------07,06---------00 * * ******************************** * 'LGOC' *LU* TRACK # * SECTOR # * * ******************************** * 15,14---------07,06---------00 * * LGOTK DEFINES THE LU #, THE STARTING TRACK # * AND THE NUMBER OF CONTIGUOUS TRACKS. THIS * WORD IS ZERO IF NO TRACKS ARE ALLOCATED. * * LGOC DEFINES THE CURRENT AVAILABLE SECTOR. * THIS IS UPDATED BY 'RTIOC' AND RESET TO * THE BEGINNING OF THE AREA BY THE LOADER * AFTER LOADING FROM THE LGO AREA; ALSO BY * THIS ROUTINE WHEN THE TRACKS ARE ALLOCATED. * * M0970 AND B177 MAX. VALUE OF 127. STA P1 -SAVE P- SZA,RSS IF P = 0, GO TO JMP M0971 RELEASE LGO TRACK(S). CLA CHECK FOR CPA LGOTK CURRENT ASSIGNMENT. M0975 CLB,RSS -NONE JMP M0971 -RELEASE CURRENT * LDA P1 (A) = # OF TRACKS JSB $DREQ ALLOCATE TRACKS * SZB,RSS IF P TRACKS NOT JMP M0972 AVAILABLE, GO FOR DIAG. RETURN. * RBR SET SIGN OF B IF LU 3. ASL 16 MOVE THE TRACK UP ASL 7 TO BITS 14-07 OF B. STB LGOC SET LGOC. ADB P1 SET # OF TRACKS IN 06-00 STB LGOTK AND SET LGOTK. * JMP MSEX -RETURN- * M0971 CPA LGOTK JMP MSEX LDB LGOTK GET ASSIGNMENT WORD TO RELEASE. CLE,ELB SET E IF LU = 3 LSR 8 SET FIRST TRACK IN B ALF,ALF PUT # OF RAR TRACKS IN A CMA,SEZ,CLE,INA SET NEGATIVE,SKIP IF LU 2. ADB TATSD ADD SYSTEM DISC SIZE JSB $CREL GO RELEASE IF POSSIB>LE SZB RELEASE OK? JMP M1973 NO SEND THE NASTY MESSAGE. STB LGOTK CLEAR 'LOAD-AND-GO' STB LGOC CONTROL WORDS. CPB P1 IF P = 0, JMP M0150 -RETURN- JMP M0975 GO TO ALLOCATE NEW TRACKS. * M0972 LDA $NOLG PRINT: NO LGO SPACE RSS M1973 LDA $LGBS PRINT: LGO IN USE JMP MSEX * HED MESSAGE PROCESSOR SIZE COMMAND * * * THE SIZE COMMAND COMES IN THREE FLAVORS * * 1) SZ,XXXXX PRINTS SIZE INFORMATION ON PROGRAM XXXXX * 2) SZ,XXXXX,P2 FOR NON EMA PROGRAMS, CHANGES MAX LOGICAL * ADDRESS SPACE OF XXXXX TO P2 PAGES. * FOR EMA PROGRAMS P2 BECOMES THE NEW * SIZE OF PROGRAM + EMA SIZE, IE, THE * NEW MINIMUM PARTITION SIZE OF THE PROG. * 3) SZ,XXXXX,P2,P3 THIS FORM IS FOR EMA PROGRAMS ONLY. P2 * IS AS DESCRIBED ABOVE. P3 IS THE NEW * MSEG SIZE. * * * TEMPS: TEMPY = # OF PAGES IN PROG (NO MSEG) + DYNAMIC BUFFER AREA * IF THE PROGRAM IS AN EMA PROGRAM * = NEG LOW MAIN ADDRESS IF PROG NOT EMA * * * SIZE LDA PARAM GET THE PARAMETER COUNT CPA D2 IS IT JUST 2 ? JMP SZRPT YES,SO REPORT THE SIZE INFO * JSB SZCHK NO, SO GO SEE IF MODS OK JSB $SZIT NOW GO GET ALL THE PARAMETERS LDB TEMPB,I *E SZB *E IS IT AN EMA PROG? JMP ESIZX YES * LDB WORK GET THE LOW MAIN ADDRESS ADB D22 LDA B,I STA TEMPI SAVE IT FOR LATER CMA,INA MAKE NEG STA TEMPY AND SAVE ADB D7 NOW CALCULATE THE # OF WORDS IN ADA B,I IN THE PROGRAM CODE ADB DM6 CPA TEMPY PROG SEGMENTED ? ADA B,I NO. ADA B1777 ALLIGN TO PAGE ALF NOW, CONVERT TO # OF PAGES OF CODEE. RAL,RAL AND B37 CMA MAKE NEG & ADD IN BASE PAGE ADA P2 NOW ADD NEW SIZE SPECIFIED SSA IS LOWER LIMIT CHECK OK ? JMP SZERR NO, SO ITS A SIZE ERROR * * WE ALREADY HAVE MAX PARTITION SIZE, BUT MIGHT BE GREATER * THAN MAX PROGRAM ADDRESS SPACE. LETS SEE. * LDA TEMPI GET THE LOW MAIN ADDRESS ALF GET PAGE # RAL,RAL ADA DM32 NOW SEE WHICH IS SMALLER LDB A SAVE IT CMB,INB BUT MAKE POSITIVE ADA TEMPA ADD IN LARGEST PARTITION SIZE SSA,RSS OF THE TWO KEEP THE SMALLEST STB TEMPA USE LOGICAL ADDRESS SPACE * * LDB P2 GET THE INPUT SIZE CMB,INB MAKE NEG ADB TEMPA ADD IN MAX SIZE INB SSB OK ? JMP SZERR NO ! SEND SIZE ERROR. * CCB NOW GO ADB P2 GET THE REQUESTED SIZE ESIZW BLF,BLF AND SHIFT UP RBL,RBL LDA TEMPC,I GET THE # OF PAGES WORD AND BPG# OUT GOES THE OLD ADA B IN GOES THE NEW * SSA,RSS IF PART'N ISN'T RESERVED, ZAP PART'N # AND B177K BECAUSE PROG MIGHT NOT RUN THERE ANTMORE STA TEMPC,I SOCK IT AWAY JMP M0150 AND RETURN * * B177K OCT 177700 SPC 2 * EMA PROGRAM CHECK SPC 2 * ESIZX LDA TEMPF GET THE MSEG SIZE CMA,INA SUBTRACT FROM PROG SIZE ADA TEMPI STA TEMPY TEMPY = PROG SIZE (NO MSEG) * LDB CP3 GET THE LAST PARAMETER SZB,RSS ANY SUPPLIED ? JMP ESFX1 NO, SO DON'T CHECK IT OUT CCB NOW CHECK MSEG SIZE ADB P3 SSB,INB MUST NOT BE LESS THAN 1 JMP $INER IT IS, SO FORGET IT * CLA,INA *E ADA TEMPE *E INDEX TO 2ND ID EXT WORD LDA A,I *E AND GET MSEG START PAGE ALF,RAL *E AND B37 *E GET VALUENLH FROM LOW 5 BITS CMA,INA *E SUBTRACT FROM 32 TO GET ADA D32 A = MAX MSEG SIZE CMB,INB B = - INPUT SIZE ADA B SSA WELL,IS IT OK OR NOT ? JMP SZERR NOT ! FLUSH HIM JMP ESFX3 IS. * ESFX1 LDA TEMPF USE OLD MSEG SIZE AS NEW. STA P3 * ESFX3 LDA CP2 WAS THIS PARAMETER SUPPLIED ? SZA,RSS WELL ? JMP ESFX2 NO LDA TEMPE GET ADDRESS OF ID EXTENSION INA LDA A,I INDEX TO DE BIT WORD ALF,RAL NOW IF THE DE BIT IS CLEAR SSA,RSS THEN CHANGE IS ILLEGAL JMP SZERR SO YOU LOSE ! * LDA P2 GET THE INPUT EMA SIZE SZA IF = 0 SSA OR IF < 0 JMP $INER ITS AN ERROR. * ADA TEMPY ADD # OF PAGES OF PROG (NO MSEG) CMA,INA NOW SEE IF PROGRAM WILL FIT INTO ADA TEMPA PROPER PARTITION SSA WELL ? JMP SZERR NO, YOU LOSE. * LDA TEMPB,I GET THE EMA WORD XOR TEMPG OUT GOES THE OLD ADA P2 IN GOES THE NEW TN STA TEMPB,I * ESFX2 LDA TEMPE,I GET THE 1ST ID EXTENSION WORD XOR TEMPF OUT GOES THE OLD ADA P3 IN GOES THE NEW IOR SIGN ANS THE NON STANDARD BIT STA TEMPE,I * LDB TEMPY GET THE # OF PAGES IN PROG ADB P3 ADD IN THE NEW MSEG SIZE JMP ESIZW NOW GO PUT IT IN THE ID SEG * D32 DEC 32 SKP * * SZRPT JSB TTNAM GET THE ID INFO JSB SES#3 GET THE PROGRAM TYPE CPA D1 MEMORY RESIDENT ? JMP $INER YES, INPUT ERROR. JSB $SZIT PICK UP THE SIZE WORDS LDB WORK NOW GET THE ID ADDRESS ADB D29 INDEX TO HIGH MAIN OF LARGEST SEG LDA B,I PULL IT IN ADB DM6 NOW INDEX TO HIGH MAIN OF PROG CLE,SZA,RSS IF ZERO THEN NO SEGMENT SO USE LDA B,I PROGRAM SIZE JSB $CNV3 NOW CONVERT TO ASCII (OCTAL) * LDA ASCI GET THE 1ST WORD STA BUFF1 AND PUT IT IN THE BUFFER DLD ASCI1 AND GET THE LAST 2 WORDS DST BUFF2 AND SAVE THEM TOO * * LDA TEMPI GET SIZE OF PROG (+ MSEG IF EMA ) LDB TEMPB,I IS THE PROGRAM EMA ? SZB,RSS JMP LSIZE NO JUST GO LIST SIZE LDB TEMPF YES GET MSEG SIZE CMB,INB AND SUBTRACT IT ADB TEMPG FROM THE EMA SIZE ADA B AND ADD (A = PROG + EMA SIZE) LSIZE CCE,INA ACCOUNT FOR BASE PG & DO DECIMAL CONVERSION JSB $CNV3 DO THE CONVERSION * DLD ASCI1 GET THE LOWER 2 WORDS (MAX = 1024) DST BUFF5 AND SET INTO BUFFER LDA ASCI GET A BLANK STA BUFF4 AND PUT IT OUT AS A DELIMITER STA BUFF7 ON BOTH SIDES STA BUF10 AND FOR THE NEXT ONE STA BUF11 AND FOR THE NEXT ONE * LDA TEMPB,I GET THE EMA WORD AND B1777 KEEP ONLY EMA SIZE LDB DM12 GET A CHAR COUNT CCE,SZA,RSS (DECIMAL CONVERSION) IF NO EMA THEN, JMP SZEXLWT WE'RE DONE * JSB $CNV3 NOW THEN,CONVERT TO ASCII * DLD ASCI1 GET THE RESULT (MAX = 1024) DST BUFF8 * LDA TEMPF AS LONG AS WE'RE HERE LETS JSB $CNV3 GIVE THEM THE MSEG SIZE TOO. DLD ASCI1 DST BUF12 * * LDB DM26 GET THE CHAR COUNT SZEXT STB BUFFR AND PUT IT IN THE BUFFER LDA BUFAD THE BUFFER ADDRESS TO A JMP MSEX NOW , GO TELL THE FOLKES. * DM26 DEC -26 SKP * THE SZCHK SUBROUTINE IS CALLED BY THE SZ & AS PROCESSORS * IT MAKES SURE THAT THE PROGRAM EXISTS, IS NOT A SEGMENT, * IS DORMANT, IS NOT MEMORY RESIDENT, AND DOES NOT CURRENTLY * OWN ANY PARTITION. * * SZCHK NOP JSB TTNAM GO LOOK FOR THE PROGRAM SZA IF NOT DORMANT, TAKE GAS ! JMP M0405 SEND ILLEGAL STATUS ERROR. * LDB WORK NOW GO SEE WHAT TYPE ADB D14 PROGRAM THIS IS LDA B,I AND D7 KEEP ONLY LOWER 3 BITS CPA D1 IS IT MEMORY RESIDENT ? JMP M0405 THEN SEND ILLEGAL STATUS ERROR * ADB D7 NOW GET TO THE PARTITION WORD LDA B,I PULL IT IN AND KEEP ONLY AND B77 THE PARTITION BITS MPY D7 USE THIS AS AND INDEX INTO ADA $MATA THE $MATA TABLE ADA D2 SO WE CAN SEE WHO OWNS THAT PARTITION LDA A,I PULL IN THE OWNERS ID ADDRESS CPA WORK AND COMPARE IT TO THIS GUY JMP M0405 IF SAME THEN SEND ILLEGAL STATUS ERROR JMP SZCHK,I IF YOU GOT HERE, YOUR A WINNER !!! * * SZERR LDA $SERR JMP MSEX * * $SERR DEF *+1 DEC -10 ASC 5,SIZE ERROR * BPG# OCT 101777 B1777 OCT 1777 * * HED MESSAGE PROCESSOR --- UR COMMAND * * * WHY, YOU ASK YOURSELF, IS THERE A UNRESERVE COMMAND. * IT SEEMS INTUITIVELY OBVIOUS TO THE MOST CASUAL OBSERVER * THAT A RESERVE COMMAND WOULD BE MORE USEFUL. BUT WHAT * HAPPENS TO THE POOR PROGRAM THAT IS SWAPPED OUT, AND THEN * THE ONLY PARTITION HE WILL RUN IN IS RESERVED. WHERE IS * HE TO GO ? REMEMBER ! PARANOIA IS THE WATCH WORD OF * A GOOD OPERATING SYSTEM. * UR, N N = NUMBER OF PARTITION TO BE UNRESERVED * URESV ADA DM1 SUBTRACT 1 FROM PART'N # SSA IF NEG, SEND ILLEGEL PART'N MESSAGE JMP IPRTN CMA MAKE NEG & CHECK AGAINST ADA $MNP MAX # OF PARTITIONS SSA IS IT OK ? JMP IPRTN NO SEND ILLEGAL PARTITION MESSAGE * CCA ADA P1 INDEX INTO MPY D7 PROPER MATA TABLE ENTRY ADA $MATA LDB A,I GET THE LINK WORD SSB IF PARTITION UNDEFINED JMP IPRTN SEND ERROR MESSAGE * ADA D4 NOW GET THE ENTRY LDB A,I STB TEMPX SAVE THE SIZE FOR A LATER CHECK RBL,CLE,ERB STRIP SIGN BIT STB A,I AND PUT IT BACK * INA BUMP TO TYPE WORD LDB A,I GET IT SSB IS IT RT ? JMP URRT YES CHECK SIZE ADA DM2 NOW GO CHECK MOTHER BIT LDB A,I PULL IT IN SSB IS IT SET ? JMP URMT YES * LDB $MBGP GET MAX BG PART'N SIZE MCHEK LDA TEMPX GET PARTITION SIZE AND B1777 KEEP ONLY SIZE CMB AND COMPARE AGAINST THAT TYPE PTN SIZE ADA B NOW IS THE UNRESERVED SSA PARTITION BIGGER THAN LAST OLD PARTITION ? JMP M0150 NO SO WERE FINISHED * JSB $MAXP YES, SO SET UP THE LARGER PARTITION JMP M0150 * * * URRT LDB $MRTP GET CURRENT RT MAX SIZE JMP MCHEK * URMT LDB $MCHN JMP MCHEK * * IPRTN LDA $ILPN JMP MSEX * B777K OCT 77700 * $ILPN DEF *+1 DEC -14 ASC 7,ILLEGAL PART'N * HED MESSAGE PROCESSOR --- AS COMMAND * * AS,XXXXX, Y * * * THE AS COMMAND WILL ASSIGN PROGRAM XXXXX TO PARTITION # Y * XXXXX MUST BE DORMANT AND NOT RESIDENT IN ANY PARTITION. * (IE HE MAY NOT HAVE PREVIOUSLY TERMINATED SERIALLY * REUSABLE. DO AN OF,XXXXX,1 IF HE DID) * ASIGN JSB SZCHK 1ST GO SEE IF CMND LEGAL JSB $SZIT GET THE NEEDED ADDRESSES. LDA P2 GET THE PARTITION CLE,SZA,RSS IF = 0 WE UNASSIGN JMP ASTUF GO UNASSIGN * SSA IF NEG IT'S AN JMP IPRTN ERROR CMA,INA IF GREATER THAT MAX # PART'NS ITS ADA $MNP AN ERROR SSA JMP IPRTN ALSO. * CCA NOW GO LOOK AT THE PARTITION ADA P2 ACCOUNT FOR BASE PAGE STA P2 AND SAVE MPY D7 INDEX TO THE ADA $MATA PROPPER $MATA ENTRY LDB A,I GET THE LENGTH WORD SSB IF ENTRY UNDEFINED ITS AN ERROR JMP IPRTN * ADA D4 NOW INDEX TO THE # PAGES LDA A,I WORD. AND B1777 KEEP ONLY THE PAGES STA TEMPX AND SAVE FOR LATER * LDB TEMPB,I GET THE EMA WORD SZB IS THIS AN EMA PROG ? JMP EMASS YES, SO DO THE EMA THING * GTPGS LDA TEMPI GET THE # OF PAGES WORD CMA,INA MAKE IT NEG ADA TEMPX AND CHECK IT. CCE,SSA IF NEG ITS AN ERROR JMP IPRTN * ASTUF LDA TEMPC,I GET THE SIZE WORD BACK AND B777K THROW AWAY OLD PARTITION IOR P2 PUT IN NEW PARTITION RAL,ERA FIX THE RESERVED BIT STA TEMPC,I AND PUT THE WORD BACK JMP M0150 AND RETURN * * EMASS LDA TEMPE GET THE ID EXTENSION ADDRESS INA LDA A,I GET THE DE BIT WORD ALF,RAL PUT IN SIGN BIT SSA,RSS WAS DEFAULT TAKEN ? JMP EMESS NO. * LDA TEMPB,I GET THE EMA SIZE WORD XOR TEMPG GET RID OF OLD SIZE INA SET DISPATCHER FLAG FOR MAX SIZE STA TEMPB,I CLA,INA,RS%S * EMESS LDA TEMPG GET THE EMA SIZE CMA,INA ADA TEMPF REDUCE BY MSEG SIZE EMES1 ADA TEMPX OFSET THE PARTITION SIZE STA TEMPX AND RESET IT JMP GTPGS NOW GET # OF PAGES IN PROGRAM HED MESSAGE PROCESSOR CONSTANTS ETC. LASCI OCT 000040 ASCII BLANK IN LOW CHARACTER MASKU OCT 177400 UPPER CHARACTER MASK (AND) TEMPP NOP TEMPORARY STORAGE KEY NOP TEMPORARY STORAGE * DEFP2 DEF DP2,I DP0 DEF OP DP1 DEF P1 DP2 DEF P2 DP3 DEF P3 DP4 DEF P4 DP5 DEF P5 DP6 DEF P6 DP7 DEF P7 HED CONTROL PARAMETER STORE IN ID SEGMENT * * * THE PLOAD SUBROUTINE IS CALLED BY THE RU, ON, & GO PROCESSORS * IT DECIDES WHETHER THE USER WANTED TO DO STRING PASSING AND/OR * SET UP THE 5 TEMP WORDS IN THE PROGRAMS ID SEGMENT. * * PLOAD NOP ENTRY/EXIT LDA WSTAT,I IF NO PRAM BIT IS RAL,RAL SET THEN DO NOT PASS CLE,SSA THE SCHEDULING STRING JMP PLOAD,I (SET E=0 FOR ALCST BELOW). LDB PARAM IF NO PARAMETERS, CPB D2 THEN DO NOT PASS JMP PLOD5 THE SCHEDULING STRING. LDB OP+1 CHECK FOR "IH" IN CPB ASCIH COMMAND TO INHIBIT JMP PLOD5 PASSAGE OF STRINGS. * LDA $MEU GET THE DMS STATUS RAL,ELA E = 0/1 CAME FROM SYS/USER MAP CCA,SEZ,CLE,RSS DID INPUT COME FROM THE SYS CONSOLE ? STA MVFLG YES SET A FLAG FOR THE ALCST SUBROUTINE * LDB WORK NO "IH",SO GET ID-SEG ADDRESS JSB ALCST AND GO STORE THE STRING. JMP NOMEM MEMORY ALLOCATION ERROR? JMP NOMEM YES, GO SEND MESSAGE. * PLOD5 LDB DEFP2 GET INDIRECT DEF TO PRAMS. LDA CP2 GET PRAM FLAG RAR,SLA IF ASCII "NO" LDA P2 ENTERED CPA NO THEN STEP PRAM ADDRESS FIRST TIME INB STEP PRAM ADDRESS LDA WORK GET ID-SEGMENT ADRESS JSB PRAM GO SET PRAMS. JMP PLOAD,I RETURN. * NOMEM LDA $NMEM GO ISSUE NO MEMORY JMP $MSEX MESSAGE AND RETURN. * ASCIH ASC 1,IH NO ASC 1,NO SKP * * SUBROUTINE TO SET UP THE PRAMETERS IN A PROGRAMS * ID-SEGMENT. PRAM SETS FIVE PRAMETERS AND THE B * REGISTER. IF THE NO PRAMETER FLAG IS SET NO * ACTION IS TAKEN. * * CALLING SEQUENCE: * * LDB PRAM ADDRESS (OR INDIRECT TO LIST OF ADDRESSES) * LDA ID-SEGMENT ADDRESS * JSB PRAM * * RETURN: * =1 NO PRAMS BIT SET. * =0 NO PRAMS BIT NOT SET. * OTHER REGISTERS MEANINGLESS. * PRAM NOP INA STEP TO THE PRAM AREA STA TEMP SET IN TEMP ADA D9 STEP TO THE B-REGISTER STA TEMP1 ADDRESS AND SAVE ADA D5 STEP TO THE STATUS ADDRESS LDA A,I GET THE STATUS AND CHECK RAL,RAL THE NO PRAM ALLOWED BIT CCE,SSA IF SET THEN (SET E REG) JMP PRAM,I JUST EXIT * LDA TEMP GET THE PRAM AREA ADDRESS AND STA TEMP1,I SET IT IN THE B REG. SAVE AREA LDA DM5 SET UP THE STA TEMP1 COUNTER PRAM1 CLA ZERO ADDRESS GETS A ZERO LDA B,I GET PRAM STA TEMP,I STUFF IT ISZ TEMP STEP STORE ADDRESS CLE,INB STEP SOURCE ADDRESS (CLEAR E REG) ISZ TEMP1 DONE? JMP PRAM1 NO- CONTINUE JMP PRAM,I YES , SO EXIT HED CROSS MAP PARAMETER CONTROL STORE SKP * * SUBROUTINE TO SET UP THE PRAMETERS IN A PROGRAMS * ID-SEGMENT. XPRAM SETS FIVE PRAMETERS AND THE B * REGISTER. IF THE NO PRAMETER FLAG IS SET NO * ACTION IS TAKEN. * NOTE THAT THE PARAMETERS THAT ARE BROUGHT IN ARE * FROM THE USER MAP, THAT IS, THE ALTERNATE MAP. THIS * MEANS THAT THE PARAMETERS TRUE ADDRESS MUST BE IN THE * CURRENT MAP BECAUSE THE CROSS LOAD INSTRUCTION CHASES * DOWN INDIRECTS IN TH`E CURRENT MAP BEFORE GOING ACROSS * MAPS TO PICK UP THE VALUE. * * CALLING SEQUENCE: * * LDB PRAM ADDRESS (OR INDIRECT TO LIST OF ADDRESSES) * LDA ID-SEGMENT ADDRESS * JSB XPRAM * * RETURN: * =1 NO PRAMS BIT SET. * =0 NO PRAMS BIT NOT SET. * OTHER REGISTERS MEANINGLESS. * XPRAM NOP INA STEP TO THE PRAM AREA STA TEMP SET IN TEMP ADA D9 STEP TO THE B-REGISTER STA TEMP1 ADDRESS AND SAVE ADA D5 STEP TO THE STATUS ADDRESS LDA A,I GET THE STATUS AND CHECK RAL,RAL THE NO PRAM ALLOWED BIT CCE,SSA IF SET THEN (SET E REG) JMP XPRAM,I JUST EXIT * LDA TEMP GET THE PRAM AREA ADDRESS AND STA TEMP1,I SET IT IN THE B REG. SAVE AREA LDA DM5 SET UP THE STA TEMP1 COUNTER XRAM1 CLA ZERO ADDRESS GETS A ZERO XLA B,I GET PRAM STA TEMP,I STUFF IT ISZ TEMP STEP STORE ADDRESS CLE,INB STEP SOURCE ADDRESS (CLEAR E REG) ISZ TEMP1 DONE? JMP XRAM1 NO- CONTINUE JMP XPRAM,I YES-EXIT * HED MESSAGE PROCESSOR NAME SEARCH * * CALL BY NAME SEARCH ROUTINE * * CALLING SEQUENCE: * * JSB TTNAM NAME ASSUMED TO BE IN P1 * * ON RETURN: * * WORK = ID ADDRESS * B = ID ADDRESS IF A PROGRAM, IF SEGMENT B = 5 (IE TYPE) * A = LEAST 4 STATUS BITS * E = 0 STANDARD ID SEGMENT * E = 1 SHORT ID SEGMENT * * TTNAM NOP ENTRY/EXIT LDB DEFP1 ADDRESS OF ASCII PROG NAME JSB TNAME CALL TO NAME SEARCH ROUTINE SZA,RSS IF ZERO, THEN PROG NOT FOUND JMP NXPRG SO TAKE GAS! * LDA WORK SEE WHAT TYPE PROGRAM IS ADA D14 WITHOUT EFFECTING E REG LDA A,I AND D7 CPA D5 IS IT A SEGMENT ? JMP OPOK? YES, SEE WHO WeANTS TO KNOW SPC 2 OPOK! LDA WSTAT,I GET STATUS TO A AND D15 MASK IT AND JMP TTNAM,I RETURN SPC 2 OPOK? STA B A SEGMENT SET B = 5, B NOT = ID ADDR. LDA OP GET THE INPUT COMMAND CPA OF OFF COMMAND ? JMP OPOK! YES. CPA ST ST COMMAND ? JMP OPOK! YES. SPC 2 NXPRG LDA $NOPG NO SUCH PROG ERROR (YOU LOSE !) JMP MSEX EXIT HED SEARCH KEYWORD LIST FOR PROGRAM NAME * ON ENTRY * B IS ADDRESS OF ASCII PROGRAM NAME * ON RETURN * A IS 0 IF PROGRAM NOT FOUND (E=1) * B AND WORK ARE THE ID SEGMENT ADDRESS OF REQUESTED PROGRAM * WSTAT = THE STATUS WORD ADDRESS. * E = 0 IF STANDARD ID SEGMENT * E = 1 IF SHORT (9 WORD ) ID SEGMENT OR NOT FOUND * TNAME NOP ENTRY/EXIT STB TEMP3 ADDRESS OF NAME 1 AND 2 INB INCR TO CHAR 3 AND 4 ADDR STB TEMP4 SAVE IT INB INCR TO CHAR 5 ADDR LDA B,I ASCII NAME CHAR 5 AND X AND MASKU MASK OFF X STA TEMP5 SZA IF NULL CHAR. FOURCE ERROR RETURN LDA KEYWD STA KEY TOP OF KEYWORD LIST TN005 LDA KEY,I CHECK IF AT END OF LIST CCE,SZA,RSS JMP TNAME,I END OF LIST ERROR RETURN ADA D12 LDB A,I ID SEG ASCII NAME CHARS 1 AND 2 CPB TEMP3,I COMPARE WITH REQUESTED CHAR 1,2 INA,RSS COMPARES JMP TN030 DOES NOT COMPARE-GO TO NEXT PROG LDB A,I ID SEG ASCII NAME CHARS 3 AND 4 CPB TEMP4,I COMPARE WITH REQUESTED CHARS 3,4 INA,RSS COMPARES JMP TN030 DOES NOT COMPARE-GO TO NEXT PROG STA WSTAT SET UP WSTAT IN CASE LDA A,I ID SEG ASCII NAME CHARS 5,X STA B SAVE FOR SHORT ID TEST AND MASKU MASK OFF X CPA TEMP5 COMPARE CHARACTER 5 JMP TN040 COMPARES-SO PROGRAM FOUND * TN030 ISZ KEY  INCREMENT KEYWORD ADDRESS JMP TN005 GO TO COMPARE CHARACTERS TN040 LSR 4 MOVE SHORT ID BIT TO LEAST B ERB SET E FOR RETURN LDB KEY,I LOAD B WITH ID SEGMENT ADDRESS STB WORK SET IN WORK ISZ WSTAT STEP TO STATUS ADDRESS AND JMP TNAME,I EXIT HED CVT3 (BINARY TO ASCII CONVERSION) * * BINARY TO ASCII CONVERSION ROUTINE * * CALLING SEQUENCE * * SET E TO 0 IF OCTAL CONVERSION OR * SET E TO 1 FOR DECIMAL CONVERSION * LDA NUMBER TO BE CONVERTED * JSB $CNV3 * * RETURN ADDRESS OF ASCI IN A AND E=1. * RESULTS IN ASCI, ASCI+1, ASCI+2 * LEADING 0'S SUPPRESSED * $CNV3 NOP STB TEMP6 SAVE B REGISTER LDB PTTE INIT LOCATION OF BUFFER STB TMP LDB AASCI SET BUFFER=ASCII BLANK'S STB ASCI STB ASCI1 STB ASCI2 LDB DF10 ASSUME BASE TEN SEZ,CLE,RSS IF BASE EIGHT INB SET UP FOR BASE EIGHT STB BASE SET CONVERSION BASE ADDRESS DPCRL CLB START CONVERSION DIV BASE DIVIDE BY BASE BASE EQU *-1 DEFINE BASE ADDRESS ADB B20 CONVERT TO ASCII-BLANK SEZ IF HIGH DIGIT BLF,BLF ROTATE ADB TMP,I ADD CURRENT VALUE STB TMP,I STORE THE CONVERTED VALUE CCB,SEZ PREPARE FOR SUBTRACT ADB TMP IF HIGH CHAR. BACKUP SEZ,CME BUFFER POINTER STB TMP AND RESET SZA IF MORE DIGITS JMP DPCRL GO SET THE NEXT ONE * CCE SET E FOR NEXT CALL (ASSUME BASE 10) LDA PTT LOAD A WITH ASCI BUFFER ADDRESS LDB TEMP6 RESTORE B JMP $CNV3,I RETURN * B20 OCT 20 DF10 DEF D10 D10 DEC 10 D8 DEC 8 PTT DEF ASCI PTTE DEF ASCI2 HED $CNV1 (BINARY TO ASCII CONVERSION) * CALLING SEQUENCE: SAME AS $CNV3 * * RETURN RESULTSO LEAST TWO DIGITS IN A. * OTHERS AS PER $CNV3 * $CNV1 NOP JSB $CNV3 GO CONVERT THE NUMBER LDA ASCI2 GET LEAST TWO DIGITS JMP $CNV1,I RETURN HED PROGRAM SIZE .VS. PART'N SIZE CHECK * * * THE $SZIT SUBROUTINE IS CALLED BY THE EXEC 9,10,23 & 24 * PROCESSORS AND IS CALLED FOR THE ON, RU, & SZ COMMANDS. * IT IS ALSO CALLED BY THE DISPATCHER IF A PARITY ERROR * HAS OCCURED AT ANY TIME IN THE PAST AND A SEARCH WAS MADE * FOR A PARTITION & NONE OF THE PROPER SIZE WAS FOUND. * THE SUBROUTINE MAKES SURE THAT THE PROGRAM TO BE SCHEDULED * WILL FIND A PARTITION LARGE ENOUGH TO RUN IN. THAT IS * IT MAKES SURE THAT NO PROGRAM IS FOREVER SCHEDULED BUT * BUT NEVER DISPATCHED. THIS CASE WILL OCCUR IF A PROGRAM * IS LOADED, THEN SP 'D , THE SYSTEM THEN REDEFINED, AND THEN * THE PROGRAM RP 'D AND PROGRAM EXECUTION ATTEMPTED. * * * CALLING SEQUENCE JSB $SZIT * ID ADDRESS IN WORK * * ON RETURN A = 0 ALL IS WELL * A = ASCII ERROR CODE ADDRESS. (PROG TOO LARGE) * B = 8 IF PROG ASSIGNED TO A PARTITION * = 9 IF PROGRAM IS NOT ASSIGNED TO ANY PARTITION. * * TEMPS : TEMPA = $MBGP, $MRTP, $MCHN, OR PARTITION SIZE * TEMPB = ADDR OF ID SEG WORD # 29, THE EMA SIZE WORD * TEMPC = ADDR OF ID SEG WORD # 22, SIZE - PARTITION WORD * TEMPD = ERROR COSE 8 OR 9 (AS IN B-REG ABOVE) * TEMPE = ADDRESS OF ID EXTENSION * TEMPF = MSEG SIZE * TEMPG = EMA SIZE * TEMPI = #OF PAGES OF PROG (INCLUDES 1 MSEG) * * * $SZIT NOP LDB WORK GET THE ID ADDRESS ADB D14 INDEX TO THE TYPE WORD LDA B,I PULL IT IN AND D7 KEEP ONLY TYPE BITS CPA D1 IF MEM RES JMP SIZOK THE MAKE SUCCESSFUL RETURN * LDB $MBGP ASSUME PROG IS BG CPA D2 IS IT ? LDB $MRTP NO, [BETTER LUCK NEXT TIME. STB TEMPA SAVE THE PROPER SIZE WORD * LDB WORK GET THE ID ADDRESS AGAIN ADB D28 NOW GET TO THE EMA WORD STB TEMPB (SAVE THE ADDRESS TOO ) LDA B,I AND PULL IT IN LDB $MCHN GET THE MAX EMA SIZE SZA IS PROG EMA ? STB TEMPA YES SO SIZE IS EMA * LDB WORK GET THE ID ADRESS AGAIN ADB D21 INDEX TO THE PARTITION WORD STB TEMPC (SAVE THE ADDRESS TOO ) LDA B,I PULL IT IN NOTAS LDB D9 GET THE PROPPER ERROR CODE SSA,RSS IS PROG ASSIGNED ? JMP GOSIZ NO * AND B77 GET THE PARTITION MPY D7 AND USE AS INDEX ADA $MATA INTO THE LDB A,I GET THE 1ST WORD SSB IF UNASSIGNED, JMP UNASN THEN UNASSIGN THE PROGRAM & TRY AGAIN ADA D4 $MATA TABLE LDA A,I GET THE SIZE OF THE AND B1777 PARTITION STA TEMPA AND SAVE LDB D8 GET THE ERROR CODE * * GOSIZ STB TEMPD AND SAVE IT IF WE NEED IT LDA TEMPC,I ALF GET # OF PAGES IN PROG (+ MSEG IF EMA) RAL,RAL AND B37 STA TEMPI SAVE FOR LATER * LDB TEMPB,I GET THE EMA FLAG SZB IS PROGRAM EMA ? JMP EMACK YES SO CHECK IT OUT * CMA,INA NOW SEE IF ADA TEMPA IF IT IS DISPATCHABLE SZBAD LDB TEMPD GET THE ERROR CODE READY * SSA,RSS WELL ? SIZOK CLA,RSS YES ALL IS WELL, SO CLEAR A LDA $SERR NO, SEND ERROR CODE TO CALLER JMP $SZIT,I RETURN * UNASN LDA TEMPC,I GET THE PART'N WORD AND B777K UNASSIGN THE PROGRAM STA TEMPC,I AND JMP NOTAS TRY AGAIN. * TEMPA NOP TEMPB NOP TEMPC NOP TEMPD NOP TEMPE NOP TEMPF NOP TEMPG NOP TEMPI NOP * * EMACK LDA B ALF GET ID EXTENSION TO LOW END RAL,RAL ANsD B77 NOW USE THIS AS AN INDEX TO THE ADA $IDEX PROG'S ID EXTENSION LDA A,I PULL IT IN STA TEMPE SAVE THE ADDRESS LDA A,I NOW GET THE AND B37 MSEG SIZE STA TEMPF SAVE THIS TOO * LDA TEMPB,I NOW GET THE EMA SIZE FXEMA AND B1777 LDB A PUT IN IN B=REG TOO STB TEMPG AND SAVE AGAIN ADA TEMPI A= [ #PGS + EMA SIZE ] CMA,INA A= -[ #PGS + EMA SIZE ] ADA TEMPA A = $MCHN - [#PGS + EMA SIZE] ADA TEMPF A = $MCHN -[#PGS - MSEG + EMA SIZE ] SPC 1 * A = $MCHN - [#PGS - MSEG + EMA SIZE ] OR SPC 1 SSA,RSS IS IT OK ? JMP SIZOK YES * CPB D1 IF EMA SIZE = 1, THEN IT'S AN JMP SZBAD ERROR * CLB,INB WELL, PAL YOU GET ONE LAST CHANCE ADB TEMPE INDEX TO THE DE BIT IN THE LDB B,I ID EXTENSION BLF,RBL NOW SEE IF THE EMA SIZE WAS DEFAULTED SSB,RSS WELL ? JMP SZBAD NO, SO YOU'RE A LOSER ! * LDB WORK OK, BUT HAS THE PROGRAM EXECUTED ? ADB D8 LDB B,I GET POINT OF SUSPENSION SZB HAS IT EVER EXECUTED ? JMP SZBAD YES, CAN ONLY HAVE BEEN A PARITY ERROR * LDA TEMPB,I GET THE EMA WORD XOR TEMPG OUT GOES THE OLD SIZE INA IN GOES THE DEFAULT (A FLAG TO THE STA TEMPB,I DISPATCHED TO GIVE LARGEST SIZE) JMP FXEMA PLAY IT AGAIN SAM HED OUTPUT *_ ON SYSTEM TELETYPE ******************************************************************* * THE $TYPE SECTION FUNCTIONS AS FOLLOWS: * ENTRY IS MADE BY STRIKING ANY SYSTEM TELETYPE KEY. * IF TELETYPE FLAG NOT BUSY, THEN * IS OUTPUT AND A * REQUEST IS MADE FOR INPUT. IF FLAG IS SET THEN * IGNORE REQUEST. UPON COMPLETION OF INPUT (LF), * THE MESSAGE PROCESSOR ROUTINE IS CALLE NLHD. * UPON RETURN, IF A REGISTER IS ZERO THEN NO * MESSAGE TO BE OUTPUT. IF A NON-ZERO, THEN A IS * ADDRESS OF MESSAGE TO OUTPUT WITH CHARACTER * COUNT THE FIRST WORD IN BUFFER. ******************************************************************* * $TYPE LDA FLG CHECK SYSTEM TTY FLAG SZA JMP $XEQ BUSY, SO RETURN TO $XEQ JSB $XSIO CALL TO OUTPUT ASTERISK(*) OCT 1 ON SYSTEM TELETYPE NOP NOP OCT 2 DEF ASTRK DM4 DEC -4 OUTPUT CHARACTER COUNT OCT 0 SAYS DON'T NEED USER MAP JSB $XSIO CALL TO REQUEST OPERATOR INPUT OCT 1 DEF TYP10 INPUT COMPLETION ADDRESS NOP OCT 401 INPUT WITH TYPEOUT IBUF DEF INBUF ABS -BUFFL DETERMINED BY $STRT ROUTINE OCT 0 DONT NEED USER MAP ISZ FLG SET SYSTEM TTY BUSY FLAG JMP $XEQ GO TO $XEQ * TYP10 CLA CLEAR THE COM FLAG RvN STA FLG LDA IBUF GET BUFFER ADDRESS TO A JSB $MESS GO TO MESSAGE PROCESSOR ROUTINE SZA,RSS CHECK IF MESSAGE TO BE OUTPUT JMP TYP27 NO MESSAGE-SO GO RETURN * ISZ FLG SET THE COM FLAG LDB A,I STB TYP26 BRS CONVERT CHARACTER COUNT  CMB,INB TO POSITIVE WORD COUNT. STB TYPCO SAVE WORD COUNT. LDB IBUF GET BUFFER INA ADDRESSES. MVW TYPCO GO MOVE WORDS. * JSB $XSIO CALL TO OUTPUT ERR MESSAGE OCT 1 DEF TYP30 COMPLETION ADDRESS TYPCO NOP OCT 2 DEF INBUF TYP26 NOP OCT 0 DONT NEED USER MAP JMP $XEQ GO TO $XEQ * TYP27 LDA OP GET THE OP CODE CPA RU WAS IT A RUN ? RSS YES CPA ON NO, WAS IT AN ON ? RSS YES JMP TYP30 NO, DO COMPLETION STUFF * LDB WORK GET THE ID ADDRESS JSB SES#3 GET SESSION WORD # 3 ADDRESS CCA A = -1 (NEG LU # OF SYS CONSOLE) STA B,I SET THE LU IN THE ID SEGMENT TYP30 CLA CLEAR SYSTEM FLAG FOR NEXT STA FLG REQUEST JMP $XEQ ASTRK OCT 006412 CR, LF ASC 1,*_ ASTERISK, LEFT ARROW HED $ABRT ROUTINE TO ABORT A PROGRAM * ROUTINE: < $ABRT > * * PURPOSE: THIS ROUTINE PROVIDES FOR REMOVING * A USER PROGRAM FROM EXECUTION USUALLY * AFTER AN ERROR CONDITION IS DETECTED * WHICH PROHIBITS CONTINUED EXECUTION. * THE PROGRAM IS SET TO THE DORMANT * STATE, TIME INTERVAL REMOVED AND ANY * DISC TRACKS ASSIGNED TO THE PROGRAM * RELEASED. * * THE PROGRAM NAME IS SET IN THE MESSAGE * "XXXXX ABORTED" WHICH IS PRINTED * ON THE SYSTEM TELETYPE. * * CALL: (A) = ID SEGMENT ADDRESS * (P) JSB ABORT * (P+1) -RETURN- (REGISTERS MEANINGLESS) * ݕ$ABRT NOP SET ID SEGMENT ADDRESS STA TEMPH FOR SABRT CALL ADA D15 INDEX TO THE STATUS WORD LDB A,I GET THE WORD ADB B4000 SET THE ABORT BIT STB A,I RESET THE STATUS WORD LDB TEMPH SET B AND CALL JSB SABRT THE SOFT ABORT ROUTINE LDA TEMPH GET THE ADDRESS AND JSB $SDRL GO RELEASE THE DISC TRACKS LDB TEMPH SET (B) = ADDRESS OF 3-WORD ADB D12 PROGRAM NAME IN ID SEGMENT. LDA B,I SET STA ABM PROGRAM INB NAME LDA B,I IN STA ABM+1 MESSAGE INB LDA B,I AND MASKU MASK OUT THE LOWER CHARACTER IOR LASCI REPLACE WITH A BLANK STA ABM+2 LDA ABMA PRINT MESSAGE: JSB $SYMG "XXXXX ABORTED" JMP $ABRT,I EXIT * * ABMA DEF *+1 DM14 DEC -14 ABM ASC 7,PROGX ABORTED AASCI ASC 1, HED MEMORY PROTECT VIOLATION SCHEDULER PREPROCESSORS ******************************************************************* * THE $MPT1 THRU $MPT9 PREPROCESSORS CONSIST OF MEMORY * PROTECT VIOLATION CALLS FROM EXEC THAT INVOLVE LIST * PROCESSING. * THE FOLLOWING REQUESTS ARE HANDLED: * PROGRAM COMPLETION (DORMANT) * SUSPEND (OPERATOR) * BACKGROUND SEGMENT LOAD * SCHEDULE WITH WAIT * SCHEDULE WITHOUT WAIT * CURRENT SYSTEM TIME (TIME ROUTINE CALL) * SET ID SEGMENT TIME VALUES (TIMER ROUTINE CALL) * SET/CLEAR ALL-OR-MEMORY AND CORE-LOCK FLAGS * GET/PUT A COMMAND STRING ******************************************************************* SPC 3 * * DORMANT REQUEST - PROGRAM HAS RUN TO COMPLETION * $MPT1 JSB GETID GET THE ID-SEGMENT ADDRESS OF AFFECTED STB P2 PROGRAM - SAVE THE ID ADDRESS FOR PRAM MOVE CPB XEQT IF CURRENT PGM. SKIP JMP MPT1A  FATHER CHECKS * ADB D20 STEP TO FATHER POINTER ADDRESS CCA GET ADA B,I TO A AND B377 AND MASK ADA KEYWD ADDRESS OF ID OF FATHER IN A LDA A,I NOW CPA XEQT CURRENT PROGRAM? RSS YES SKIP JMP ESC04 NO GO FLUSH * LDB WORK RESTORE THE ID-SEGMENT ADDRESS TO B * MPT1A LDA RQRTN UPDATE THE RETURN STA XSUSP,I ADDRESS CLA SET A TO ZERO IN CASE XLA RQP3,I PRAMETER NOT SUPPLIED CMA,SZA,RSS IS THIS GUY SERIALLY REUSABLE JMP MPT1E YES, GO DO IT INA,SZA,RSS JMP MPT1B STANDARD TERMINATION CALL. * INA,SZA,RSS IS IT JMP MPT1C A SAVE RESOURCES TERMINATION * INA,SZA,RSS MAY BE A SOFT ABORT JMP M0240 YES GO TO ABORT ROUTINE * INA,SZA,RSS HARD ABORT (LAST CHANCE) JMP M0250 WOW THAT WAS CLOSE! * ESC02 LDB D2 YOU LOSE - UNRECOGNIZED PRAMETER. JMP ESCXX GO ABORT HIM * MPT1C LDA WORK GET ID ADR JSB ALDM GO PUT IN DORMANT LIST & SET FLG LDB WORK RESTORE B LDA WSTAT,I SET THE IOR B200 RESOURCE BIT IN THE STATUS STA WSTAT,I AND THEN CPB XEQT IF CURRENT PROGRAM JMP MPT1D SKIP DORMANT REQUEST JSB $LIST OCT 400 JMP $XEQ GO TO DISPATCHER * MPT1E CPB XEQT TERM SON AS REUSABLE RSS JMP MPT1B GO DO NORMAL TERMINATE JSB TERM CALL TERMINATE ROUTINE ISZ TMP,I IF OK, SET FLAG FOR SERIAL REUSE LDA IDCKK JSB ALDM GO PUT IN DORMANT LIST & SET FLAG JMP MPT1F GO FINISH PROCESSING * MPT1D JSB $WATR FIND WAITERS LDB XEQT MPT1B JSB TERM CALL TERMINATION ROUTINE MPT1F LDA DM3 IF REQUEST PRAMS ADA RQCNT THEN SSA SKIP JMP $XEQ ELSE GO TO THE DISPATCHER * LDB DEFR4 GET DEF TO PRAMS LDA P2 GET ID-ADDRESS JSB XPRAM TRANSFER THE PRAMETERS JMP $XEQ GO TO THE DISPATCHER SPC 1 DM3 DEC -3 SKP * THE TERM SUBROUTINE PERFORMS THE FOLLOWING FUNCTIONS: * * 1. CALL $LIST TO PUT THE PROGRAM IN THE DORMANT LIST * 2. IF NOT IN SESSION, CLEAR OUT NEG LU WORD. * 3. IF THE PROGRAM HAS A FATHER WHO IS WAITING THE * FATHER IS RESCHEDULED * 4. CHECKS TO SEE IF ANOTHER PROGRAM IS WAITING FOR THIS ONE * AND SCHEDULES IT IF SO. * * CALLING SEQUENCE: * * LDB ID ADDRESS * JSB TREM * * ON RETURN THE FATHER POINTER (IF ANY) IS IN POP. * AND IF HE WAS WAITING E WILL BE SET ELSE E=0. * TERM DEF D.RTR JSB $LIST PUT PGM. IN DORMANT OCT 400 LIST * STB IDCKK SAVE THE ID-ADDRESS ADB D20 INDEX TO THE PA POINTER LDA B,I GET THE WORD STB TMP SAVE THE ADDRESS RAL,ELA SET E IF FATHER IS WAITING CCB,SEZ,CME,RSS E=0 IF FATHER/1 IF NO FATHER JMP TERM2 IF NO FATHER GO SET -1. ADB KEYWD KEYWD-1 TO B (SETS E) RAR,CLE,RAR RESTORE A AND SET E TO FATHER WAITING. AND B377 GET THE FATHER ID NUMBER ADB A ID ADDRSS TO B LDB B,I GET THE ID-SEG ADDRESS TERM2 STB POP SAVE THE ADDRESS ADB D15 REMOVE THE POP'S WAIT BIT LDA B,I GET POP'S STATUS AND B7777 KNOCK OUT THE WAIT BIT SEZ,RSS IF WAITING STA B,I RESTORE THE WORD AND D15 IF POP'S CPA D3 IN THE WAIT LIST SEZ AND WAITING JMP TERM3 JSB $LIST THEN RESCHEDULE OCT 101 THE FATHER POP DEF POP * TERM3 LDA TMP,I GET THE FLAG WORD AND B7400 AND KEEP ONLY RE,RM,RN FLAGS STA TMP,I IN WORD JMP TERM,I RETURN * * D20 DEC 20 SIGN OCT 100000 B200 OCT 200 B7400 OCT 7400 DEFR4 aDEF RQP4,I SPC 2 $WATR NOP LDA B ADB D20 LDB B,I BLF,BLF RBR,SLB JSB $SCD3 SCHEDULE IF ANY WAITING JMP $WATR,I RETURN * SPC 2 * * PROGRAM SUSPEND REQUEST * $MPT2 LDA XEQT GET ADDR OF ID SEG ADA D20 LDA A,I GET FATHER POINTER CLB SSA IF BATCH FLAG IS SET JMP ESCXX ABORT SC00 LDA XEQT GET CURRENT ID ADR JSB ALDM GO PUT IN DORMANT LST & SET DM FLAG JSB $LIST OCT 506 OPERATOR SUSPEND REQUEST JMP MEM15 GO UPDATE XSUSP SPC 3 * * READ IN BACKGROUND PROGRAM SEGMENT * $MPT3 CCA CHECK PARAMETER COUNT ADA RQCNT SSA JMP ESC01 ERROR, SO RETURN LDB RQP2 ADDR OF ASCII PROG SEGMENT JSB PLNAM PULL IT IN LOCALLY JSB TNAME GO FIND THE ID SEG. SZA,RSS IF NOT FOUND JMP ESC05 TAKE GAS! ADB D7 STEP TO PRIMARY ENT PT. SEZ IF SHORT ID-SEG. STEP ADB D4 TO THE SHORT ID-SEG PRI ENT PT. ADD LDA B,I FETCH AND STA $WATR SET AS RETURN ADDRESS ADB D7 STEP TO TYPE ADDRESS LDA B,I BET TYPE AND D7 MASK IT SEZ,RSS IF SHORT IT MUST BE A SEG. CPA D5 SEGMENT?? CCE,RSS YES SKIP. JMP ESC03 NO TAKE GAS! LDA $WATR SET UP RETURN ADDRESS STA RQRTN LDB WORK GET THE ID-SEG ADDRESS STB XA,I JSB $BRED GO SET UP TO LOAD CCB SET THE ALL OF CORE ADB WSTAT BIT LDA B,I FOR THE IOR LASCI DISPATCHER STA B,I JSB PRAMO PASS PRAMETERS IF ANY JMP MEM15 ADVANCE THE RETURN ADDRESS AND EXIT SPC 3 * PRAMO PASSES PRAMETERS FROM RQP3,4,5,6,AND 7 TO * THE ID-SEGMENT POINTED TO BY WORK. * * CALLING SEQUENCE: * * SET fUP WORK * JSB PRAMO * * ID-SEGMENT MUST NOT HAVE NO PRAM BITS SET IN IT'S STATUS. * PRAMO NOP CLB,INB IF NO PRAMS CPB RQCNT THEN JMP PRAMO,I JUST EXIT * LDA WORK SET ADDRESS IN A LDB DEFR3 PRAM ADDRESS IN B AND JSB XPRAM GO MOVE THE PRAMS. JMP PRAMO,I RETURN. SKP * * $SCD3 SCHEDULES PROGRAMS IN THE WAIT LIST (STATUS-3) * WHICH ARE WAITING FOR THE GIVEN RESOURCE. * * CALLING SEQUENCE: * * LDA RESOURCE FLAG (CONTENTS OF XTEMP OF WAITER) * JSB $SCD3 * RETURN - B,E = 0 A = ? * * * ENTRY MADE BY $SCD3 NOP * RSB * SJP $SCD * * * $SCD RBL,RBL STB TEMPD STA $IDNO SAVE THE RESOURCE ID FLAG LDB SUSP2 GET THE LIST HEAD SCD31 CLE,SZB IF END OF LIST JMP SCDMR JRS TEMPD $SCD3,I RETURN * SCDMR LDA B GET THIS ENTRIES INA FLAG FROM LDA A,I HIS ID-SEGMENT CPA $IDNO THIS ONE?? JMP SCD32 YES GO RESCHEDULE * LDB B,I NO GET NEXT ENTRY TO B JMP SCD31 AND GO TEST IT. * SCD32 LDA B,I GET THE NEXT ID IN LIST STA PRAMO AND SAVE IT JSB $LIST SCHEDULE THE PROGRAM OCT 401 WHOES ID-SGEMENT ADDRESS IS IN B LDB PRAMO GET NEXT ID TO B JMP SCD31 SCAN THE REST OF THE LIST * SKP * SCHEDULE REQUEST WITH WAIT * $MPT4 JSB IDCKK CHECK IF PROGRAM DORMANT LDB XEQT GET THE ADDRESS ADB D20 OF THE BATCH FLAG XOR B,I AND SET IT AND C120K INTO THE XOR B,I THE NEW PROGRAM IOR B40K SET THE FATHER IS WAITING BIT STA $IDNO,I SET THE WORD IN THE SON'S ID. JSB $LIST PUT CURRENT PGM IN OCT 503 THE WAIT LIST LDB XEQT ADB D15 LDA B,I IOR B10K SET STAMTUS WAIT REQUEST BIT STA B,I INTO CURRENT EXEC PROGRAM RSS * * SCHEDULE REQUEST WITHOUT WAIT * $MPT5 JSB IDCKK CHECK IF PROGRAM DORMANT * LDB XEQT GET THE FATHER'S SESSION OR NEG LU WORD JSB SES#3 GET THE SESSION WORD LDA B,I STA TEMP1 AND SAVE IT FOR A MOMENT LDB XTEMP,I NOW GET THE SON'S JSB SES#3 SESSION WORD ADDRESS LDA TEMP1 GET FATHERS SESSION WORD STA B,I AND PASS IT TO THE SON * MEM15 LDA RQRTN SET UP SUSPENSION STA XSUSP,I POINT JMP $XEQ * ESC01 CLB,INB,RSS ILLEGAL PARAMETER COUNT ESC03 LDB D3 RSS ESC04 LDB D4 RSS ESC05 LDB D5 NO SUCH PROGRAM ERROR CODE. RSS ESC07 LDB D7 RSS ESC10 LDB B400 (SC10) NO MEM EVER FOR STRING PASSAGE. ESCXX LDA ASY OUTPUT SC ERROR CODE JMP $ERAB CALL SYSTEM ERROR MESSAGE ROUTINE $SCXX EQU ESCXX * B40K OCT 40000 B400 OCT 400 C120K OCT 57777 SKP * * CALL TO GET SYSTEM REAL TIME * $MPT6 LDA RQP2 SAVE THE BUFFER STA TEMP1 ADDRESSES LDA RQP3 STA TEMP2 * LDA DPNAM GET THE ADDRESS OF OUR LOCAL BUFFER STA RQP2 AND USE IT ADA D5 INSTEAD STA RQP3 * DLD $TIME GET THE TIME JSB $TIMV AND CONVERT IT * LDA D5 GET THE # OF CAX TO X LDA DPNAM THE SOURCE LDB TEMP1 THE DESTINATION MWI GIVE THE DATA TO THE USER * LDA DPNAM+6 GET THE YEAR XSA TEMP2,I GIVE TO USER(IF TEMP2 = 0 ITS A NOP) JMP MEM15 GO TO STORE RETURN ADDRESS * * GETID IS A SUBROUTINE TO GET THE ID-SEGMENT ADDRESS * FROM PRAMETER NUMBER TWO WHERE THE USER MAY * SUPPLY ZERO (HIS ID) OR NOTHING (HIS ID) OR * AN ASCII NAME. * * CALLING SEQUENCE: * * JSB GETID * RETURN B= THE ID-SEGMENT ADDRESS. * IF NOT FOUND THEN ERROR "SC05"MIS GENERATED * E=0 * A=0 ON ALL RETURNS * WORK = THE ID-ADDRESS * WSTAT = THE ID-STATUS ADDRESS * GETID NOP CLA IF NOT SUPPLIED PRESET TO ZERO LDB XEQT AND CURRENT PGM ADB D12 SET B TO POINT TO CURRENT NAME XLA RQP2,I GET THE PRAMETER SZA,RSS ANY SUPPLIED ? JMP GTID# NO LDB RQP2 GET ADDRESS OF NAME JSB PLNAM PULL IT IN LOCALLY GTID# JSB TNAME GO SEARCH FOR IT CLA,SEZ IF FOUND SKIP JMP ESC05 ELSE FLUSH HIM OUT OF THE SYSTEM * JMP GETID,I RETURN SPC 2 * $IDNO COMPUTES THE ID-SEGMENT NUMBER OF A PROGRAM * * CALLING SEQUENCE * LDB ID-SEGMENT ADDRESS * JSB $IDNO * RETURN ID NUMBER IN B * $ID# RAL,RAL STA TEMPD STB GETID SAVE THE REQUESTED ID-ADDRESS LDB KEYWD IDNO LDA B,I GET KEYWORD BLOCK ENTRY INB STEP FOR NEXT ONE CPA GETID THIS IT? CMB,INB,RSS YES NEGATE AND SKIP JMP IDNO NO CONTINUE LOOP * ADB KEYWD NEGATIVE OF NUMBER TO B CMB,INB SET POSITIVE AND JRS TEMPD $IDNO,I RETURN * SKP * * CALL TO SET ID SEGMENT TIME VALUES * $MPT7 LDA DM7 CHECK PARAM COUNT FOR 4 OR 7 ADA RQCNT SZA,RSS IF SEVEN THEN JMP MPT7A CONTINUE, ELSE ADA D3 CHECK FOR 4 SZA JMP ESC01 YOU LOSE, WRONG # OF PRAMS XLA RQP5,I NO CHECK PRAM 5 SZA,RSS IF = 0 JMP ESC02 YOU LOSE * MPT7A XLA RQP3,I IF RESOLUTION CODE LDB D6 SZA ZERO OR ADA DM5 GREATER THAN 4 SSA,RSS THEN JMP ESCXX ABORT * JSB GETID GO GET THE ID-SEGMENT ADDRESS TO B LDA RQRTN PUT RETURN STA XSUSP,I ADDRESS IN THE ID SEG. JMP $TIMR GO CONTINUE REQUEST IN TIME ROUTINE * DM7 DEC -7 * SKP * * ۡ THE IDCKK SUBROUTINE CHECKS THE STATUS OF POTENTIAL * SON PROGRAMS & DETERMINES WHETHER TO HONOR THE FATHER- * SON SCHEDULE REQUEST. * * * SPC 1 * CHECK IF PROGRAM DORMANT AND THEN SCHEDULE IDCKK NOP LDB RQP2 GET PROG NAME ADDRESS JSB PLNAM PULL IT IN LOCALLY JSB TNAME NOW SEE IF THE PROGRAM EXISTS SEZ JMP ESC05 NO SUCH PROGRAM ERROR ADB D14 MAKE SURE IT IS NOT LDA B,I A SEGMENT AND D7 CPA D5 IF SEGMENT JMP ESC03 TAKE GAS! JSB $SZIT SEE IF IT WILL FIT SZA WELL ? JMP ESCXX NO,SO TAKE GAS ! * LDB XEQT COMPUTE THE ID NUMBER JSB $IDNO AND STB GETID SAVE IT LDA WORK ALSO COMPUTE THE ADA D20 FATHER POINTER WORD ADDRESS STA $IDNO AND SAVE IT LDA WSTAT,I CHECK PROGRAM STATUS FOR DORMANT AND S&NP KEEP JUST THE IMPORTANT BITS STA XA,I RETURN PROG STATUS IN A REG SZA DORMANT? JMP IDCK2 NO - CHECK FURTHER * XLB RQP9,I (A MUST=0)CHECK IF THE OPTIONAL SZB,RSS PARAMETER STRING IS INCLUDED. JMP IDCK4 IF NOT,SKIP STRING STORAGE. JSB $CVWD CONVERT BUFFER LENGTH TO STB BFCNT POSITIVE CHARS AND SAVE. LDA RQP8 SET UP BUFFER ADDRESS. STA BFADD CLE LDB WORK GET ID-SEGMENT ADDRESS JSB ALCST AND STORE PARM.STRING. JMP ESC10 ABORT PROGRAM(SC10)IF NO MEM EVER. JMP NMNOW SUSPEND FATHER IF NO MEM NOW. * IDCK4 JSB PRAMO PASS THE PARAMETERS,IF ANY,TO IDCK5 JSB $LIST THE ID-SEG.AND THEN SCHEDULE. OCT 301 STA XA,I SHOW THAT IT WAS DONE STB XTEMP,I SON'S ID ADDR TO FATHER'S 1ST TEMP WORD LDA $IDNO,I (MIGHT BE EXEC 9). GET THE CURRENT FLAG BITS AND C377 MASK OUT ANY OLD FATHER NUMBER. IOR GETID ADD THE FATHER NUMBER STA $IDNO,I AND RESET IT. JMP IDCKK,I RETURN SPC 1 IDCK2 RAL,ALR IF JUST THE NO PRAMS CMA,CLE,INA SET E LDA $IDNO,I CHECK TO SEE AND B377 IF THIS GUY IS THE FATHER CPA B IF NOT RSS THEN JMP MPT15 GO TEST FOR QUEING * SEZ IF JUST "NP" BIT THEN JMP IDCK5 GO SCHEDULE HIM * LDA WSTAT,I IF "R" AND "D" BITS BOTH SET AND B300 THEN JUST CPA B300 CLEAR THEM ELSE CLB,RSS JMP MPT15 GO CHECK FOR QUEUEING * XOR WSTAT,I CLEAR THE "R" AND "D" BITS STA WSTAT,I AND RESET IN SON'S ID STB XA,I INDICATE SUCESS. JMP MEM15 AND EXIT. * DM8 DEC -8 C377 OCT 177400 SKP * *SCHEDULE WITH WAIT WITH WAIT REQUEST * * IF REQUESTED PROGRAM IS NOT DORMANT THE REQUESTER IS * SUSPENDED UNTIL IT IS. * MPT15 LDA RQP1 HERE AFTER FINDING REQUESTED PGM BUSY CPA D9 IF NO WAIT RSS THEN JUST DO CPA D10 THE OLD JMP MEM15 THING * LDB WORK ELSE SET THE SUSPEND REASON STB XTEMP,I IN REQUESTERS ID-SEGMENT LDA $IDNO,I TO INDICATE IOR B1000 WE WERE HERE STA $IDNO,I JSB $LIST PUT REQUESTER IN WAIT LIST OCT 503 JMP $XEQ GO TRY SOMEBODY ELSE. SPC 2 ASY ASC 1,SC ASCII -SC- FOR SCHED ERROR DEFR3 DEF RQP3,I B10K OCT 10000 S&NP OCT 20017 STATUS PLUS NO PRAMS BIT MASK B300 OCT 300 SKP * * $MPT8 SET/CLEAR ALL OF MEMORY AND CORE LOCK FLAGS * * EXEC 22 REQUEST WITH ONE PRAMETER * PRAMETER MEANING * 0 CLEAR CORE LOCK * 1 SET CORE LOCK * 2 CLEAR ALL OF MEMORY FLAG * 3 SET ALL OF MEMORY FLAG. * $MPT8 LDB XEQT GET THE ADDRESS ADB D14 OF THE BITS IN THE ID-SEGMENT STB $LDIST SAVE ADDRESS LDA B,I GET CURRENT STATUS XLB RQP2,I GET THE REQUEST WORD CMB,INB,SZB,RSS IF ZERO JMP CLCL CLEAR THE CORE LOCK * INB,SZB,RSS IF ONE JMP STCL SET THE CORE LOCK * INB,SZB,RSS IF TWO JMP MEM15 CLEAR ALL OF MEMORY FLAG * INB,SZB IF NOT THREE THEN JMP ESC02 GO ABORT HIM. JMP MEM15 * STCL LDB SWAP CHECK IF LEGAL REQUEST RBR,RBR GET LEGAL FLAG SLA TO LEAST B RBR,CLE CLE,SLB,RSS IF ILLEGAL JMP ESC07 GO DO HIM IN * CLCL LDB B100 GET THE CORE LOCK FLAG TO B MPT81 IOR B SET THE FLAG SEZ AND IF A CLEAR REQUEST XOR B CLEAR THE FLAG STA $LIST,I RESET THE WORD JMP MEM15 GO EXIT. SKP ********************************************************************** * * EXEC 14--GET/PUT A COMMAND STRING. * * FOUR PARAMETERS USED: * . * . * . * JSB EXEC * DEF RTN * DEF ICODE * DEF GPCOD * DEF IBUFR * DEF IBUFL * RTN . * . * . * ICODE DEC 14 * GPCOD DEC 1 OR 2 1 = GET(RETRIEVE)PARAMETER STRING * 2 = PUT(WRITE)PARAMETER STRING TO FATHER * IBUFR BSS N BUFFER OF N WORDS * IBUFL DEC N(OR -2N) BUFFER LENGTH WORDS(+) OR CHARACTERS(-) * ****************************************************************** * $MPT9 LDA RQCNT CHECK TO SEE ADA DM3 IF THERE ARE SSA FOUR PARAMETERS. JMP ESC01 SORRY BUDDY, YOU BLEW IT! LDA RQP3 SAVE ADDRESS STA BFADD OF BUFFER. XLB RQP4,I GET BUFFER LENGTH, SAVE STB $IDNO FOR TRANS.LOG CHECK, JSB $CVWD CONVERT TO POSITIVE STB BFCNT CHAR COUNT AND SAVE. XLA RQP2,I GET TYPE OF REQUEST.P ADA DM2 SZA,RSS JMP MPT9W 2=WRITE. INA,SZA 1=READ. JMP ESC02 ILLEGAL REQUEST. * LDB XEQT READ A STRING BLOCK FOR AN ID-SEG. JSB $STSH TO THE BUFFER(E=1,EXTRA WORD). SZA,RSS GET THE STRING BLOCK ADDRESS JMP NOPAW FOR THIS PROG. IF NO STRING, ADA D2 THEN SET A=1, CLEAR B, AND RETURN. LDB A,I GET ACTUAL SIZE OF STORED CMB,CLE,INB STRING AND COMPARE TO ADB BFCNT TO THE REQUESTED LDB A STRING SIZE. SEZ,INA,RSS SET A REG. TO SOURCE ADDRESS. LDB BFCTA USE WHICHEVER SIZE IS LDB B,I SMALLER AND CONVERT STB BFCNT INB TO WORDS AND USE BRS AS MOVE WORDS STB XB,I COUNT. LDB BFADD SET B REG. TO DESTINATION ADD. LDX XB,I MWI GO MOVE WORDS. LDB XEQT WHEN COMPLETE, RETURN THE JSB $RTST STRING BLOCK TO MEMORY. LDB XB,I GET MOVE WORDS COUNT. LDA $IDNO IF ORIGINAL REQUEST WAS SSA FOR CHARS, THEN DOUBLE LDB BFCNT WORD COUNT FOR TRANS.LOG. JMP MPT91 GO SETUP REGS. AND RETURN. * MPT9W LDA XEQT WRITE A STRING BLOCK TO THE FATHER. ADA D20 GET CURRENT PROGRAM LDA A,I AND DETERMINE IF THERE AND B377 IS A FATHER. SZA,RSS JMP NOPAW ERROR, NO FATHER. CCB,CCE GET ID(SET E=1 FOR ALCST) ADB KEYWD SEGMENT ADB A ADDRESS OF LDB B,I FATHER. JSB ALCST DEALLOCATE AND THEN ALLOC.BLOCK FOR PAW. JMP ESC10 IF SUCCESS ALLOC.,THEN SET A=0.IF NO JMP NMNOW MEM EVER,ABORT SON(SC10).IF NO MEM MPT91 CLA NOW, SUSPEND THE SON. * MPT95 STB XB,I SET UP B REGISTER. STA XA,I SET UP A REGISTER. JMP MEM15 RETURN. * NMNOW JSB $LIST NOT ENOUGH MEMORY NLHNOW SO OCT 504 LINK PROGRAM INTO MEMORY JMP $XEQ SUSPENSION LIST. * NOPAW INA IF NO STRING ON 'GET' OR CLB NO FATHER ON 'PUT', THEN JMP MPT95 SET A=1 OR B=0. * DM2 DEC -2 SKP ************************************************************** * * SUBROUTINE TO STORE A STRING IN SYSTEM AVAILABLE MEMORY. * ALCST DEALLOCATES ANY STRING MEMORY, ALLOCATES A BLOCK OF * MEMORY, TRANSFERS THE STRING INTO THE BLOCK, AND LINKS THE * BLOCK INTO THE HEAD OF THE STACK LOCATED AT $STRG. THE LINKED * BLOCKS LOOK AS FOLLOWS: * * * *********** ********************* * $STRG * ---------* 0 OR LINK-------------- * *********** *-------------------* * EXTRA WORD BIT------* ID SEG ADDRESS * * *-------------------* * * # CHARS IN STRING * * *-------------------* * * CHAR 1 CHAR 2 * * *-------------------* * * * tN* *-------------------* * * CHAR M * * ********************* * * EXTRA WORD * * *-------------------* * * * WORD 1 = LINK TO NEXT BLOCK OR 0 FOR LAST BLOCK * WORD 2 = BITS 0-14 = ID-SEGMENT ADDRESS * BIT 15 = EXTRA WORD IN BLOCK BIT(SEE $ALC) * WORD 3 = ACTUAL NUMBER OF CHARS (M) IN STRING * * CALLING SEQUENCE: * BFADD:= BUFFER ADDRESS * BFCNT:= POSITIVE BUFFER WORD COUNT * MVFLG:= -1/0 STRING IN SYS/USER MAP * CLE/CCE (SEE BELOW) * LDB ID-SEGMENT ADDRESS * JSB ALCST * * RETURN: * (P+1) =-1, =XTEMP UNSUCCESSFUL,NO MEM EVER * (P+2) =0 , =XTEMP UNSUCCESSFUL,NO MEM NOW * (P+3) =+ , =XTEMP SUCCESSFUL ALLOCATION EVER * * AND ARE MODIFIED * TEMP1, TEMP4 AND TEMP6 ARE USED. * CALLS $RTST WHICH USES TEMP2, TEMP3 AND TEMP5. * * ON ENTRY, IF E REG=0, THE BASE PAGE WORD XTEMP(1721B)IS * SET TO THE ID SEGMENT WORD 2 ADDRESS INDICATED BY THE B REG * AND THEN RESTORED ON EXIT. IF THE E REG = 1, THEN XTEMP IS * NOT MODIFIED. SINCE ON "NOT ENOUGH MEMORY", $ALC WILL STORE * THE AMOUNT OF MEMORY REQUIRED IN 'XTEMP,I', THIS WILL RESULT: * 1)E=0,SAVE MEMORY SIZE IN XTEMP OF B REG PROGRAM, OR * 2)E=1,SAVE MEMORY SIZE IN XTEMP OF CURRENT PROGRAM(USED * ONLY IN EXEC 14 CALL FROM SON TO FATHER). * *************************************************************** * ALCST NOP STB TEMP1 SAVE ID ADDRESS. LDA XTEMP SAVE CURRENT PROGRAM'S ID STA TEMP4 WORD 4. * INB IF E=0, THE SET UP OUR PROGRAM'S ID SEZ,INB,RSS WORD 2 FOR USE BY $ALC. STB XTEMP OTHERWIZE, USE CURRENT PROGRAM. LDB TEMP1 GET ID ADDRESS AND JSB $RTST RETURN ANY STRING MEMORY. LDA BFCNT GET CHAR COUNT. INA CHANGE TO ARS WORD COUNT STA RTSTW AND SAVE. ADA D3 INCREMENT WORD COUNT BY STA WORDS 3 FOR LINKAGE WORDS AND JSB $ALC GO GET MEMORY. WORDS NOP JMP ALST9 NO MEMORY EVER RETURN. JMP ALST8 NO MEMORY NOW RETURN. CCE OK RETURN. SET E REG TO CPB WORDS 1 IF AN EXTRA WORD WAS CLE RETURNED. LDB $STRG LINK THE BLOCK INTO STB A,I THE HEAD OF THE STA $STRG STACK HEADED AT $STRG. LDB TEMP1 GET ID-SEG ADDRESS, ADD IN RBL,ERB EXTRA BLOCK WORD BIT, INA AND STORE IN SECOND STB A,I BLOCK WORD. LDB BFCNT STORE BUFFER CHAR INA COUNT IN THIRD STB A,I WORD OF BLOCK. INA LDB A GET ADD.OF DESTINATION BUFFER. LDA BFADD GET ADDRESS OF SOURCE BUFFER. * ISZ MVFLG WHERE IS THE STRING RIGHT NOW ? JMP ALST5 USER MAP * MVW RTSTW SYS MAP, SO GO MOVE THE WORDS JMP ALST6 * ALST5 LDX RTSTW MWF GO MOVE WORDS FROM USER MAP. ALST6 ISZ ALCST SUCCESSFUL RETURN. ALST8 ISZ ALCST NO MEMORY NOW RETURN. ALST9 CLB CLEAR OUT SYS/USER MAP FLG STB MVFLG LDB TEMP4 RESTORE CURRENT PROGRAM'S STB XTEMP ID WORD 2 ADDRESS. JMP ALCST,I NO MEMORY EVER RETURN--A=STATUS. * STRGA DEF $STRG $STRG OCT 0 HEAD OF STRING STORAGE STACK. BFCTA DEF BFCNT BFCNT BSS 1 BFADD BSS 1 MVFLG NOP -1/0 STRING CURRENTLY IN SYS/USER MAP SKP ************************************************************** * * SUBROUTINE TO RETURN SYSTEM AVAILABLE MEMORY ALLOCATED * FOR A STRING. GIVEN A PROGRAM'S ID-SEGMENT ADDRESS, $RTST * LOCATES THE STRING IN THE BLOCK HEADED AT $STRG, UNLINKS * IT AND RETURNS IT TO SAVMEM. * * CALLING SEQUENCE: * LDB ID-SEGMENT ADDRESS * JSB $RTST * * RETURN: * NO REGISTERS ARE SAVED. * USES TEMP2 AND TEMP5 FOR TEMPOARAY STROAGE. * CALLS $STSH WHICH USES TEMP3. * ************************************************************** * $RTST NOP STB TEMP2 SAVE ID-SEGMENT ADDRESS. RTST1 JSB $STSH GET STRING BLOCK ADD.(E=1,EXTRA WD). SZA,RSS CHECK IF STRING JMP $RTST,I BLOCK FOUND. STA RTSTA STORE STARTING BLOCK ADDRESS. LDA A,I UNLINK BLOCK STA B,I FROM STACK. LDA RTSTA ADA D2 GET SIZE OF LDB A,I BLOCK, CONVERT INB TO WORDS BRS AND ADB D3 ADD 3. SEZ IF EXTRA WORD BIT SET, INB ADD 1 TO SIZE. STB RTSTW STORE TOTAL SIZE OF BLOCK. JSB $RTN RETURN MEMORY BLOCK. RTSTA NOP RTSTW NOP * LDB TEMP2 GET ID SEGMENT ADDRESS. STB WORK SET UP $WORK IN CASE ANY PROG SCHEDULED JMP RTST1 CHECK FOR ANY MORE BLOCKS. * SKP ********************************************************************** * * SUBROUTINE $STSH CHASES DOWN A STRING BLOCK IN THE STACK * HEADED AT $STRG GIVEN THE ID-SEGMENT ADDRESS. ASSUMES ENTRY * IN THE SYSTEM MAP. * * CALLING SEQUENCE: * LDB ID-SEGMENT ADDRESS * JSB $STSH * * RETURN: * =0 = COULD NOT FIND NAMED BLOCK * =+ = ADDRESS OF BLOCK, E=1 = EXTRA WORD IN BLOCK * B= ADDRESS OF PREVIOUS BLOCK * USES TEMPORARY LOCATION TEMP3. * ********************************************************************** * $STSH NOP STB TEMP3 SAVE ID-SEGMENT ADDRESS LDB STRGA GET POINTER TO HEAD OF STACK. STSH1 LDA B,I GET BLOCK ADDRESS AND  CLE,SZA,RSS IF ZERO, THEN END JMP STSH9 OF STACK. INA OTHERWIZE,INCREMENT IT,AND GET LDA A,I GET ID-SEGMENT ADDRESS. ELA,RAR SAVE EXTRA WORD BIT IN E REG. CPA TEMP3 IF THIS IS CORRECT JMP STSH2 BLOCK, THEN RETURN. LDB B,I OTHERWIZE, GO CHECK JMP STSH1 NEXT BLOCK. * STSH2 LDA B,I SET A=BLOCK ADDRESS AND STSH9 JMP $STSH,I RETURN. * ********************************************************************** * * $CVWD CONVERTS NEGATIVE CHARACTER COUNT OR POSITIVE WORD COUNT * TO POSITIVE CHARACTER COUNT. * * CALLING SEQUENCE: * LDB COUNT(+ = WORDS, - = CHARACTERS) * JSB $CVWD * * RETURN: * B = +CHARACTERS * ********************************************************************** * $CVWD NOP SSB CONVERT NEGATIVE CMB,INB,RSS CHARACTERS AND BLS POSITIVE WORDS TO JMP $CVWD,I POSITIVE CHARACTERS. HED ** SYSTEM BASE PAGE COMMUNICATION AREA ** * * *** SYSTEM BASE PAGE COMMUNICATION AREA *** * XI EQU 1647B . EQU 1650B ESTABLISH ORIGIN OF AREA * * SYSTEM TABLE DEFINITION * * EQTA EQU .+0 FWA OF EQUIPMENT TABLE EQT# EQU .+1 # OF EQT ENTRIES * DRT EQU .+2 FWA OF DEVICE REFERENCE TABLE LUMAX EQU .+3 # OF LOGICAL UNITS (IN DRT) * INTBA EQU .+4 FWA OF INTERRUPT TABLE INTLG EQU .+5 # OF INTERRUPT TABLE ENTRIES * TAT EQU .+6 FWA OF TRACK ASSIGNMENT TABLE * KEYWD EQU .+7 FWA OF KEYWORD BLOCK * * I/O MODULE/DRIVER COMMUNICATION * EQT1 EQU .+8 ADDRESSES EQT2 EQU .+9 EQT3 EQU .+10 OF EQT4 EQU .+11 EQT5 EQU .+12 CURRENT EQT6 EQU .+13 EQT7 EQU .+14 15-WORD EQT8 EQU .+15 EQT9 EQU .+16 EQT EQT10 EQU .+17 EQT11 EQU .+18 ENTRY EQT12 EQU .+81 EQT13 EQU .+82 EQT14 EQU .+83 EQT15 EQU .+84 * CHAN EQU .+19 C.URRENT DMA CHANNEL # TBG EQU .+20 I/O ADDRESS OF TIME-BASE CARD SYSTY EQU .+21 EQT ENTRY ADDRESS OF SYSTEM TTY * * SYSTEM REQUEST PROCESSOR /'EXEC' COMMUNICATION * * RQCNT EQU .+22 # OF REQUEST PARAMETERS -1 RQRTN EQU .+23 RETURN POINT ADDRESS RQP1 EQU .+24 ADDRESSES RQP2 EQU .+25 RQP3 EQU .+26 OF REQUEST RQP4 EQU .+27 RQP5 EQU .+28 PARAMETERS RQP6 EQU .+29 RQP7 EQU .+30 (SET FOR MAXIMUM OF RQP8 EQU .+31 9 PARAMETERS) RQP9 EQU .+32 * * DEFINITION OF SYSTEM LISTS (QUEUES) * * DORMT EQU .+32 ADDRESS OF 'DORMANT' LIST, SKEDD EQU .+33 'SCHEDULE' LIST, SUSP2 EQU .+35 'WAIT' LIST, SUSP3 EQU .+36 'AVAILABLE MEMORY' LIST, SUSP4 EQU .+37 'DISC ALLOCATION' LIST, SUSP5 EQU .+38 'OPERATOR SUSPEND' LIST * * DEFINITION OF EXECUTING PROGRAM ID SEGMENT' * * XEQT EQU .+39 ID SEGMENT ADDR. OF CURRENT PROG. XLINK EQU .+40 'LINKAGE' XTEMP EQU .+41 'TEMPORARY (5-WORDS) XPRIO EQU .+46 'PRIORITY' WORD XPENT EQU .+47 'PRIMARY ENTRY POINT' XSUSP EQU .+48 'POINT OF SUSPENSION' XA EQU .+49 'A REGISTER' AT SUSPENSION XB EQU .+50 'B REGISTER' XEO EQU .+51 'E AND OVERFLOW * * SYSTEM MODULE COMMUNICATION FLAGS * * OPATN EQU .+52 OPERATOR/KEYBOARD ATTENTION FLAG OPFLG EQU .+53 OPERATOR COMMUNICATION FLAG SWAP EQU .+54 RT DISC RESIDENT SWAPPING FLAG DUMMY EQU .+55 I/O ADDRESS OF DUMMY INT. CARD IDSDA EQU .+56 DISC ADDR. OF FIRST ID SEGMENT IDSDP EQU .+57 -POSITION WITHIN SECTOR * * DEFINITION OF MEMORY ALLOCATION BASES * * BPA1 EQU .+58 FWA R/T DISC RES. BP LINK AREA BPA2 EQU .+59 LWA R/T DISC RES. BP LINK AREA BPA3 EQU .+60 FWA BKG DISC RES. BP LINK AREA LBORG EQU .+61 FWA OF RESIDENT LIBRARY AREA RTORG EQU .+62 FWA OF REAL-TIME AREA RTCOM EQU .+63 LENGTH OF REAL TIME COMMON AREA RTDRA EQU .+64 FWA OF R/T DISC RESIDENT AREA AVMEM EQU .+65 FWA O/$"F SYSTEM AVAILABLE MEMORY BKORG EQU .+66 FWA OF BACKGROUND AREA BKCOM EQU .+67 LENGTH OF BACKGROUND COMMON AREA BKDRA EQU .+68 FWA OF BKG DISC RESIDENT AREA * * UTILITY PARAMETERS * TATLG EQU .+69 LENGTH OF TRACK ASSIGNMENT TABLE TATSD EQU .+70 # OF TRACKS ON SYSTEM DISC SECT2 EQU .+71 # SECTORS/TRACK ON LU 2 (SYSTEM) SECT3 EQU .+72 # SECTORS/TRACK ON LU 3 (AUX.) * DSCLB EQU .+73 DISC ADDR OF RES LIB ENTRY PTS DSCLN EQU .+74 # OF RES LIB ENTRY POINTS DSCUT EQU .+75 DISC ADDR OF RELOC UTILITY PROGS DSCUN EQU .+76 # OF RELOC UTILITY PROGS LGOTK EQU .+77 LOAD-N-GO: LU,STG TRACK,# OF TRKS LGOC EQU .+78 CURRENT LGO TRACK/SECTOR ADDRESS SFCUN EQU .+79 SOURCE FILE LU AND DISC ADDRESS MPTFL EQU .+80 MEMORY PROTECT ON/OFF FLAG (0/1) FENCE EQU .+85 MEM PROTECT FENCE ADDRESS * BKLWA EQU .+87 LWA OF MEMORY IN BACKGROUND * * FREG1 EQU LBORG FREG2 EQU RTORG FREG3 EQU BKORG FLG EQU OPFLG * A EQU 0B LOCATION OF A REGISTER B EQU 1B LOCATION OF B REGISTER ORG * PROGRAM LENGTH END $LST ?$ ^, 92067-18022 1805 S C0122 &$ALC4 RTE-IV MEMORY ALLOCATION             H0101 H(ASMB,R HED * REAL-TIME EXECUTIVE MEMORY ALLOCATION * * NAME: $ALC * SOURCE: 92067-18022 * RELOC: PART OF 92067-16014 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM $ALC,0 92067-16014 REV.1805 741120 * ENT $ALC,$RTN,$PNTR EXT $LIST,$WORK * * PROGRAMMER: G.A. ANZINGER HP AMD 1 MAY 70 BCS * 24 JUN 74 RTE * * REQUESTS MAY BE MADE TO ALLOCATE AND RELEASE BUFFERS * FROM THE MEMORY AVAILABLE AFTER LOADING. * * 1. ALLOCATE: CALLING SEQUENCE - * (P) JSB $ALC * (P+1) (# OF WORDS NEEDED) * (P+2) -RETURN NO MEMORY EVER (A)=-1, (B)=MAX EVER * (P+3) -RETURN NO MEMORY NOW (A)=0, (B)=MAX NOW * (P+4) -RETURN OK (A)=ADDR , (B)=SIZE OR SIZE+1 * * 2. RELEASE BUFFER TO AVAILABLE MEMORY * (P) JSB $RTN * (P+1) (FWA OF BUFFER) * (P+2) (# OF WORDS RETURNED) * (P+3) -RETURN- (ALL REGISTERS DESTROYED) * * IF A REQUEST FOR A BUFFER OF LENGTH X CANNOT BE FILLED * DURING A GIVEN CALL, RETURN IS MADE WITH: * (A) = 0 * * IF, WHEN BUFFER REQUESTED, - (AVMEM) - SHOWS INSUFFICIENT CORE * AVAILABLE TO CONTAIN A BUFFER OF THE LENGTH REQUESTED, * THEN RETURN IS MADE WITH: * (A) = -1 * (B) = MAXIMUM LENGTH BUFFER THAT THE PROGRAM MAY ALLOCATE. * * TO FIND OUT HOW LARGE A BUFFER MAY BE ALLOCATED, USE THE CALL * * JSB $ALC * DEC 32767 * * BLOCKS OF MEMORY AVAILABLE FOR OUTPUT BUFFERING ARE LINKED THROUGH C* THE FIRST TWO WORDS OF EACH BLOCK - * WORD1 - LENGTH OF BLOCK * WORD2 - ADDRESS OF NEXT BLOCK (OR 77777 IF THIS IS LAST BLOCK) * * THE ALLOCATOR 'TRANSFERS' THE UPPER END OF A BLOCK TO IOC AND * SHORTENS THE LENGTH OF THE BLOCK BY THE AMOUNT 'TRANSFERRED' * * * REGISTERS ARE NOT PRESERVED * SKP $ALC JMP ALCIN INIT (FROM $STRT, RETURNS TO $WORK) LDA $ALC,I GET THE LENGTH OF THE REQUEST STA ADX AND SAVE IT STA XTEMP,I SAVE IN ID SEG IN CASE SUSPEND LDB A ADA AVMEM ENOUGH MEMORY NOW SSA TO HONOR THE REQUEST? JMP .A1 YES, GO ALLOCATE. ADB MAXEV SSB,RSS WHAT ABOUT LATER? JMP ERETN NEVER! ISZ $ALC MAYBE, BUT NOT NOW. REJ CLA,CLE,RSS A=0, E=0 NOT NOW ERETN CCA,CLE A=-1,E=0 NOT EVER JMP SETB RETURN * .A1 ISZ $ALC TRY AN ALLOCATION CCA SET CORE AVAIL. NOW TO 0 STA ALCIN LDB PNTRA START THE SEARCH LOOP WITH .A2 STB BAD SET LAST BUFFER ADDRESS CLE,INB STEP TO THE NEXT ADDRESS LDB B,I GET THE NEXT SEGMENT ADDRESS CPB M7 IF 77777 THEN END OF LIST AND NO JMP NOMOR MEMORY SO REJECT LDA B,I CHECK TO SEE IF THIS IS THE ADA ALCIN LARGEST LENGTH SO FAR LDA B,I GET THE LENGTH CMA,SEZ SET NEG(-1) AND IF STA ALCIN LARGEST SO FAR SAVE ADA ADX WILL IT SATISFY THE REQUEST? CMA,SSA IF ZERO OR NEGATIVE USE IT JMP .A2 ELSE GO TRY NEXT ONE ADA DM2 IS BLOCK AT LEAST 2 WORDS CCE,SSA LARGER THAN REQUEST? JMP .A4 NO-ALLOCATE WHOLE BLOCK ADA D2 (A)=LENGTH(I)-L(X) STA B,I SET NEW L(I) ADA B (A)=BUFFER ADDRESS JMP SETA RETURN TO USER * .A4 LDA B,I ALLOCATE ENTIRE BLOCK. STA ADX yw SET BUFFER LENGTH STB A BUFFER ADDRESS TO A CCE,INB SET E FOR ACCEPTED RETURN LDB B,I GET THE POINTER TO THE NEXT BLOCK ISZ BAD STEP TO POINTER ADDRESS IN LAST STB BAD,I BLOCK AND SET THE POINTER SETA ISZ $ALC SETB LDB MAXEV SET B FOR REJECT SZA,RSS IF JUST FOR NOW RESET TO MAX LDB AVMEM AVAILABLE NOW CMB,SEZ SET POSITIVE AND IF REQUEST LDB ADX SATISFIED SET TO LENGTH ISZ $ALC STEP RETURN ADDRESS JMP $ALC,I AND RETURN * NOMOR LDA ALCIN PICK UP MAX LEFT DURING SEARCH STA AVMEM UPDATE MAX AVAILABLE NOW JMP REJ NOW RETURN * * $RTN NOP ENTRY POINT FOR BUFFER RETURN LDA $RTN,I (A) = FWA RETURN BUFFER (ADX) STA ADX CMA,INA SET NEG AND STA SAVA SAVE ISZ $RTN LDA $RTN,I # OF WORDS RETURNED (X) ADA DM2 SSA <2? JMP RETNR BUFFER TO SMALL - IGNORE LDA PNTRA GET THE STARTING POINTER .R11 STA BAD BAD _ AAD INA LDB A,I AAD _ NEXTBUFAD STB A A _ PNTR ADB SAVA AAD -ADX CMB,SSB,INB,SZB ADX-AAD>=0? RSS SKIP IF FOUND JMP .R11 ELSE CONTINUE * * * LDB BAD GET LOWER BUFFER ADDRESS CPB PNTRA IF LOCAT POINTER JMP .R3 ASSUME NO OVERLAP ADB B,I ADD LENGTH AND ADB SAVA SUBTRACT THE NEW BLOCK ADDRESS CMB,SSB,INB,RSS IF NEG NO OVERLAP SO JMP .R3 JUMP ADB $RTN,I ELSE COMPUTE NEW LENGTH ADB BAD,I NOW HAVE NEW +OLD-OVERLAP .R4 STB BAD,I SET LENGTH ;CHECK FOR HIGH OVER- ADB BAD LAP COMPUTE END OF BLOCK CMB,CLE,INB AND SUBTRACT FROM THE HIGH BLOCK ADB A A HAS HIGH BLOCK ADDRESS SEZ,CLE,SZB IF RESULT POSITIVE JMP .R5 JUMP ADB A,I ADD OLD UPPER LENGTH ADB BAD,I CURRENT LENGTH STB BAD,I NEW+OLD-OVERLAP CLE,INA GET POINTER AND BRING LDA A,I DOWN TO NEW BLOCK .R5 LDB BAD,I SAVE MAX LENGTH THIS RETURN ISZ BAD STEP TO POINTER ADRRESS STA BAD,I SET THE POINTER LDA AVMEM CHECK TOO SEE IF THIS LENGTH ADA B ADD CURRENT MAX CMB,SEZ,CLE SET NEG; NEW MAX? STB AVMEM YES; SET IT RETNR ISZ $RTN MEM16 LDB SUSP3 GET SUSPENSION LIST PTR SZB,RSS IF END OF LIST JMP $RTN,I RETURN. * LDA B INA PICK UP XTEMP,I FOR LDA A,I BLOCK SIZE REQUESTED. ADA AVMEM COMPARE TO MAX NOW CMA,SSA,INA,SZA ENOUGH YET? JMP $RTN,I NO, TOO BAD. JSB $LIST YES, SCHEDULE PROGRAM. OCT 401 JMP MEM16 TRY NEXT PROGRAM TOO. * .R3 ISZ BAD NO LOW OVERLAP SET NEW BLOCK LDB ADX ADDRESS IN LOW BLOCK STB BAD,I TO LINK THE BLOCKS STB BAD SET POINTER FOR HIGH BLOCK CHECK LDB $RTN,I SET B TO THE LENGTH OF RETURN JMP .R4 CHECK FOR HIGH OVERLAP * * * PNTRA DEF AVMEM DUMMY BLOCK ADDRESS(DON'T MESS!) AVMEM OCT -1 DUMMY BLOCK LENGTH (NOT USED) $PNTR OCT 77777 DUMMY BLOCK END (DON'T MESS!) BAD NOP SAVA NOP M7 OCT 77777 DM2 OCT -2 D2 OCT 2 ADX NOP * ALCIN LDA AVMEM INITIALIZATION CODE MAXEV STA * MAX SIZE BLOCK EVER AVAILABLE JMP $WORK JMP TO NEXT STARTUP ROUTINE * A EQU 0 B EQU 1 SUSP3 EQU 1714B XTEMP EQU 1721B * BSS 0 LENGTH OF PROGRAM * END $ALC 6P  92067-18023 1805 S C0222 &4OCM1 RTE-IV COMMANDS             H0102 cASMB,L,C HED RTE-IV SYSTEM COMMAND MODULE * * NAME: OCMD4 * SOURCE: 92067-18023 * RELOC: PART OF 92067-16014 * PGMR: D.L.S.,E.J.W. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM OCMD4,0 92067-16014 REV.1805 771102 ENT $LUPR,$EQST,$CHTO EXT $CVEQ,$CNV1 EXT $CNV3,$UNLK,$XXUP,$DLAY,$DMEQ,$SCD3,$ETEQ EXT $CKLO,$BITB,$INER,$XCQ,$MSEX A EQU 0 B EQU 1 SUP * ***************************************************************** * * RTE SYSTEM PROGRAM OCMD4: * * OCMD4 PROVIDES EXECUTION OF THE FOLLOWING SYSTEM COMMANDS: * * LU,P1[,P2[,P3]] LU STATUS AND LU CHANGE. * EQ,P1[,P2] EQT STATUS AND BUFFERING CHANGE. * TO,P1[,P2] SHOW TIMEOUT OR CHANGE TIMEOUT. * * ******************************************************************* * $EQST STA P1 STB P2 JSB IODNS CHECK P2 AND SET EQT ADDRESSES. LDB P2 CHECK PARAMETER #2. LDA EQT4,I GET EQT CHANNEL WORD. CLE,SSB,RSS IF P2=-1, OUTPUT EQT STATUS JMP EQST1 OTHERWIZE, SET BUFFERING BIT IN EQT. * JSB $CNV1 OUTPUT THE EQT STATUS. STA EQMS1 CONVERT THE CHANNEL NUMBER. * LDA EQT4,I CONVERT ASR 6 UNIT #. AND B37 JSB $CNV1 STA EQMS5 LDA EQT4,I SET LDB EQBLK D (FOR DMA CHANNEL) RAL,SLA OR LDB EQBD 0 STB EQMS3 LDB EQBLK SET SSA B (FOR AUTOMATIC BUFFERING) LDB EQBB OR STB EQMS4 0 LDA EQT5,I SET  RAL,RAL AVAILABILITY AND .3 STATUS ADA EQBLK (0,1,2,OR3) STA EQMS6 LDA EQT5,I CONVERT ALF,CLE,ALF EQUIPMENT ADA B3000 TYPE (SET HIGH BITS TO JSB $CNV1 FOOL LEADING BLANK GENERATOR) STA EQMS2 DV.NN. LDA EQMSA (A) = ADDRESS OF REPLY JMP $MSEX RETURN. * EQST1 ERB ROTATE BIT 1 TO E RAL,RAL AND PUT IN ERA,RAR 14 OF EQT4 STA EQT4,I AND RESTORE JMP $XCQ ALL DONE * EQMSA DEF *+1 DEC -20 ASC 1, EQMS1 NOP I/O CHANNEL # EQBD ASC 2, DV. EQMS2 NOP EQUIP TYPE CODE EQMS3 NOP D OR 0 EQMS4 NOP B OR 0 ASC 1, U EQMS5 NOP UNIT # EQMS6 NOP AVAILABILITY * EQBLK ASC 1, 0 EQBB ASC 1, B * .2 DEC 2 .3 DEC 3 B37 OCT 37 * SKP * **************************************************************** * * 'LOGICAL UNIT' STATEMENT * * FORMAT: LU,P1(,P2(,P3)) WHERE: * * P1 = LOGICAL UNIT # * P2 = 0, EQT ENTRY #, OR NOT PRESENT * P3 = SUBCHANNEL # OR NOT PRESENT IN WHICH * CASE IT DEFAULTS TO ZERO * * ACTION: 1) P2 AND P3 NOT INPUT; THE ASSIGNMENT OF * LOGICAL UNIT P1 IS PRINTED AS: * ' LU #P1 = EXX SYY D ' * WHERE: * P1=LOGICAL UNIT NUMBER * XX=EQT NUMBER * YY=SUBCHANNEL NUMBER * D=IF PRESENT, THE LU IS DOWN. * 2) P2 = 0; THE ASSIGNMENT IS RELEASED, * I.E, THE CORRESPONDING * WORD IN THE DEVICE * REFERENCE TABLE (DRT) * IS SET = 0. * 3) N2 # 0 THE LU'S ASSIGNMENT IS CHANGED TO POINT * TO THE NEW EQT AND SUBCHANNEL. ANY I/O * ASSOCIATED Wr ITH THE OLD EQT AND SUBCHANNEL * (DEVICE)IS TRANSFERRED TO THE NEW DEVICE. * * THE FOLLOWING LOCATIONS ARE USED AS TEMPORARIES BY LUPR: * := LU NUMBER := P3,P2 NEW SUBCH-EQT WORD * :=DRT WORD 1 ADDRESS :=DRT WORD 2 ADDRESS * :=EQT1 ADDRESS OF OLD :=NEW DEVICE'S EQT NUMBER * DEVICE * :="NEW DEVICE'S EQT IS :=NEW DEVICE SPLIT SUB. * DOWN" FLAG. * :=NEW DEVICE'S MAJOR LU * :#0 INITIATE REQUEST :#0 MORE THAN ONE LU FOR * ON NEW DEVICE UP OLD DEVICE * :=SEE SUB. SDRT2 * :=OLD SUBCH-EQT WORD :=OLD DEVICE MAJOR-LU * :=OLD DEVICE MAJOR-LU :=OLD DEVICE MAJOR-LU * DRT WORD 1 ADDRESS DRT WORD 2 ADDRESS * :=NEW DEVICE MAJOR-LU :=NEW DEVICE MAJOR-LU * DRT WORD 1 ADDRESS DRT WORD 2 ADDRESS * **************************************************************** * SKP $LUPR STA P1 STB P2 CPB M1 IF P2= -1, PRINT CURRENT ASSIGNMENT. JMP LUPR0 * CPA .2 PREVENT REASSIGNMENT JMP $INER OF LU 2 AND LU 3 CPA .3 JMP $INER * LUPR0 CMA,CLE,INA,SZA,RSS ILLEGAL LU NUMBER JMP $INER IF THE LU IS LESS ADA LUMAX THEN 1 OR GREATER CCA,SEZ,RSS THEN LUMAX. JMP $INER * ADA P1 SAVE ADA DRT DRT WORD STA DRT1A 1 AND ADA LUMAX WORD 2 STA DRT2A ADDRESSES. * CCE,INB,SZB,RSS IF P2=-1, THEN GO(SET E=1 FOR LUPR3) JMP LUPR3 PRINT CURRENT ASSIGNMENT. * LDB DRT PREVENT CLE,INB ASSIGNMENT(CLEAR E) DLD B,I OF ANY OTHER CPB P2 DEVICE SZB,RSS TO CPA P2 LU 2 JMP $INER  OR 3. SKP * LDA P2 CONSTRUCT I/O AND B174K SUBCHANNEL WORD ELA,RAL FOR NEW DEVICE(E WAS ALF,RAL CLEARED)WITH LOWER CLB,SEZ BITS IN BITS 2-5 ADA B20K AND UPPER BIT IN STA WORD2 BIT 13(CLEAR B REG). * STB NINTF CLEAR "NEW DEVICE I/O INITIATE" FLAG. STB TTEMP CLEAR "NEW DEVICE EQT IS DOWN" FLAG. * LDA DRT1A,I SAVE AND C3700 OLD SUBCH-EQT STA OSBEQ WORD AND AND B77 EQT1 SZA,RSS JMP LUP25 ADA M1 OF MPY .15 OLD(CLEAR B REG.) ADA EQTA DEVICE'S LUP05 STA OEQT1 EQT. * LDA P2 CHECK LEGALITY OF AND B77 N2(NEW EQT)AND STA NEQT# SZA,RSS SET THE EQT JMP LUPR2 * JSB IODNS ADDRESSES. * * SPECIAL TEST TO SEE IF MOVING I-O TO A DISK.IF SO, ERROR. * LDA EQT1 IS NEW ADA .4 DEVICE A LDA A,I AND B36K DISK? CPA B14K JMP LU100 YES, SO GO DO CHECK. * **************************************************************** * DETERMINE IF THE OLD DEVICE IS UP OR DOWN. **************************************************************** * LUPR1 LDA DRT2A,I CHECK IF OLD SSA DEVICE IS JMP DNXX UP OR DOWN. SKP **************************************************************** * OLD DEVICE IS UP. IS THERE MORE THAN ONE LU FOR IT? **************************************************************** UPXX LDA LUMAX SET UP TO SCAN THE LUS CMA,INA STA XLUS IF COUNT GOES TO ZERO THERE IS BUT ONE. LDB DRT GET ADDRESS OF THE FIRST ONE LUCO LDA B,I GET AN ENTRY AND C3700 DROP POSSIBLE LOCK BITS CPA OSBEQ IF NOT THE SAME CPB DRT1A OR IF SAME ENTRY INB,RSS SKIP TO GO ROUND AGAIN z JMP MLUS ELSE THERE ARE MORE THAN ONE * ISZ XLUS COUNT DOWN THE ENTRIES JMP LUCO AROUND WE GO *************************************************************** * IF THE DEVICE IS UP AND HAS MORE THAN ONE LU THEN ITS * QUEUE IS NOT MOVED. THIS PREVENTS UNWANTED LOSS OF DATA * CAUSED BY UNRELATED LU CHANGES. *************************************************************** * * DETERMINE IF THE NEW DEVICE IS UP OR DOWN. **************************************************************** MLUS LDA NEQT# CHECK IF NEW SZA,RSS DEVICE IS THE JMP UPBIT BIT BUCKET. * JSB CKNLU CHECK IF NEW DEVICE IS UP OR DOWN. JMP UPDN NEW DEVICE IS DOWN. ISZ TTEMP NEW DEVICE'S EQT IS DOWN. SKP **************************************************************** * THE OLD AND NEW DEVICE ARE UP OR THE OLD DEVICE IS UP * AND THE NEW DEVICE'S EQT IS DOWN. ******************************************************************* UPUP LDA P1 NEW DEVICE IS UP. CPA .1 CHECK IF OLD JMP UPLU1 DEVICE IS LU 1. * UPUP5 LDA XLUS IF ANOTHER LU EXISTS SZA THEN JMP UPMU DON'T MOVE THE QUEUE * LDB OEQT1,I UNLINK I/O REQUESTS FROM THE RBL,CLE,ERB OLD DEVICE. SKIP THE SZB,RSS LDB OEQT1 LDA DRT2A FIRST I-O REQUEST. JSB $UNLK DEF OSBEQ * LDB DRT2A,I RESET WORD 2 OF THE I/O REQUESTS JSB FXWD2 TO THE SUBCHANNEL OF THE NEW DEVICE. LDA OEQT1 LDB DRT2A,I LINK THE I/O REQUESTS JSB $XXUP ON THE NEW DEVICE. STB DRT2A,I CLEAR UP THE CURRENT LU STA NINTF SET THE MUST START NEW I/O FLAG UPMU LDA TTEMP IS THE NEW DEVICE'S SZA,RSS EQT DOWN? JMP LUP50 NO, SO CONTINUE. * LDB EQT1,I YES, SO RBL,CLE,ERB UNSTACK SZB,RSS NORMAL USER LDB EQT1 J I/O(SKIP FIRST JMP DNDE5 ENTRY)AND CONTINUE. * XLUS NOP SKP UPLU1 LDA EQT5,I GET DEVICE AND B374C TYPE OF THE SZA,RSS NEW DEVICE AND SEE JMP UPLU2 IF IT IS LEGAL CPA B2400 (00 OR 05 SUB 0) RSS FOR A SYSTEM JMP $INER CONSOLE. LDA WORD2 SZA JMP $INER * UPLU2 LDA TTEMP MAKE SURE NEW DEVICE'S SZA EQT IS NOT DOWN. JMP $INER LDA EQT1 SET NEW SYSTEM CONSOLE STA SYSTY ADDRESS IN BASE PAGE. JMP UPUP5 GO TRANSFER I/O. * * UPBIT LDA P1 CHANGING AN UP DEVICE TO CPA .1 THE BIT BUCKET. ERROR JMP $INER IF THE OLD DEVICE IS JMP UPUP5 THE SYSTEM CONSOLE. SKP ****************************************************************** * THE OLD DEVICE IS UP AND THE NEW DEVICE IS DOWN. ********************************************************************* UPDN STB TTEMP SAVE LU# OF FIRST LU(MAJOR LU)OF NEW DEVICE. STA NDML2 SAVE DRT WORD 2 ADDRESS OF NEW-MAJOR-LU. ADB M1 COMPUTE NEW- ADB DRT MAJOR-LU STB NDML1 DRT WORD 1. * LDB P1 CHECK IF THIS CPB .1 WILL SET LU JMP $INER 1 DOWN. * LDB TTEMP CHECK IF LU IS CMB,INB LOWER THEN THE ADB P1 MAJOR LU FOR SSB,RSS THE NEW DOWNED JMP UPDN5 DEVICE. * LDB A,I LU IS BELOW NEW DEVICE'S MAJOR LU. STB DRT2A,I MOVE I/O FROM MAJOR LU TO LU. LDB XLUS IF CURRENT DEVICE STILL HAS AN LU SZB THEN JMP DNDN6 SKIP THE MOVE * LDB DRT2A CHASE DOWN THIS DOWN I/O JSB CHASE QUEUE TO ITS END. LDA B * LDB OEQT1,I UNLINK I/O REQUESTS FOR THE RBL,CLE,ERB OLD DEVICE AND ADD TO SZB,RSS LDB OEQT1 JSB $UNLK ! THE I-O QUEUE. SKIP FIRST ENTRY. DEF OSBEQ JMP DNDN6 GO MODIFY LU'S FOR THE NEW DEVICE. SKP UPDN5 LDB XLUS IF WE STILL HAVE A LU FOR THIS DEVICE SZB THEN JMP UPDN6 SKIP THE MOVE * LDB NDML2 NEW DEVICE'S MAJOR LU IS BELOW LU. JSB CHASE CHASE DOWN THIS I-O QUEUE LDA B TO ITS END. * LDB OEQT1,I UNLINK I/O REQUESTS RBL,CLE,ERB FOR THE OLD DEVICE SZB,RSS (SKIP FIRST REQUEST)AND LDB OEQT1 ADD TO DOWNED LU I/O JSB $UNLK QUEUE. DEF OSBEQ * UPDN6 LDA TTEMP SET ADA MSIGN THE LU STA DRT2A,I DOWN. JMP LUP50 GO FINISH. SKP **************************************************************** * THE OLD DEVICE IS DOWN. ******************************************************************* * DETERMINE IF THE NEW DEVICE IS UP OR DOWN. * DNXX LDA NEQT# CHECK IF SZA,RSS NEW DEVICE JMP DNUP IS BIT BUCKET. * JSB CKNLU CHECK IF NEW DEVICE IS UP OR DOWN. JMP DNDN NEW DEVICE IS DOWN. JMP DNDNE NEW DEVICE'S EQT IS DOWN. **************************************************************** * THE OLD DEVICE IS DOWN AND THE NEW DEVICE IS UP(OR BIT BUCKET) ********************************************************************** DNUP JSB DETOL DETERMINE THE OLD-MAJOR-LU. LDB ODML2,I RESET WORD 2 OF I/O REQUESTS JSB FXWD2 TO THE SUBCHANNEL OF THE NEW DEVICE. * LDA OEQT1 LDB ODML2,I LINK OLD DEVICE'S I/O REQUESTS JSB $XXUP ON THE NEW DEVICE. STA NINTF * JSB FOLDD FIX ALL OLD DOWNED LU'S THAT NEED IT. JMP LUP52 ****************************************************************** * THE OLD DEVICE IS DOWN AND THE NEW DEVICE'S EQT IS DOWN. ********************************************************************* DNDNE JSB DETOL DETERMINE OLD DEVICE'S MAJOR-LU LDA OEQT1 LINK OLD DEVICE'S I/O REQUESTS ON THE LDB ODML2,I NEW DEVICE'S EQT. JSB $XXUP STA NINTF * JSB FOLDD FIX OLD DOWNED DEVICE'S LU'S THAT NEED IT. * LDB EQT1 UNLINK ANY NORMAL USER DNDE5 CLA I/O FROM THE NEW DEVICE'S EQT. JSB $UNLK DEF P2 JMP LUP50 SKP **************************************************************** * THE OLD AND NEW DEVICES ARE DOWN. ********************************************************************* DNDN STB TTEMP SAVE NEW DEVICE MAJOR-LU AND STA NDML2 ITS DRT WORD 2 ADDRESS. ADB M1 SAVE ITS ADB DRT DRT WORD STB NDML1 2 ADDRESS. * JSB DETOM DETERMINE THE OLD DEVICE'S MAJOR-LU. * LDB TTEMP CHECK IF NEW CMB,INB NEW DEVICE'S MAJOR ADB P1 LU IS < LU. SSB,RSS LU < NEW DEVICE'S MAJOR LU. JMP DNDN5 * DNDN9 LDB DRT2A LU IS BELOW NEW DEVICE'S MAJOR LU. JSB CHASE CHASE DOWN THE LU'S I/O LDA NDML2,I QUEUE TO ITS END AND RAL,CLE,ERA ADD THERE THE NEW DEVICE'S STA B,I MAJOR-LU I/O QUEUE. * LDA OMJLU IF OLD MAJOR LU EQUALS TO CPA P1 LU, THEN FIX UP OLD DEVICE'S RSS LU'S TO INCLUDE THE NEW OLD- JMP DNDN6 MAJOR-LU. OTHERWIZE, CONTINUE. * LDA OSBEQ A=OLD SUBCHANNEL-EQT WORD. LDB DRT1A INB B=LU WORD 1 ADDRESS + 1. JSB FXOLD GO FIX OLD DEVICE'S LU'S. * DNDN6 LDA P2 MODIFY ALL LU'S STA SSBEQ FOR NEW DEVICE LDA P1 TO POINT TO IOR MSIGN LU. LDB NDML1 CLE JSB SDRT2 JMP LUP50 SKP DNDN5 SZB,RSS CASE WHERE OLD AND NEW DEVICES ARE JMP $XCQ BOTH DOWN AND EQUAL. * LDB NDML2 LU > NEW DEVICE MAJOR-LU. JSB CHASE CHASE DOWN THE N2YEW MAJOR-LU'S. CCA I/O QUEUE TO ITS END. * ADA DRT CALCULATE DRT ADA OMJLU WORD 2 OF STA ODML1 OLD MAJOR-LU. * ADA LUMAX LINK OLD MAJOR LU I/O LDA A,I RAL,CLE,ERA QUEUE TO END OF NEW STA B,I MAJOR I/O QUEUE. * LDA TTEMP MAKE LU POINT TO IOR MSIGN NEW DEVICE MAJOR-LU. STA DRT2A,I * LDA OMJLU IF LU = OLD CPA P1 MAJOR-LU, RSS THEN CONTINUE, JMP LUP50 ELSE DONE. * LDA OSBEQ FIX OLD LDB ODML1 DEVICE'S INB LU'S. JSB FXOLD SKP ****************************************************************** * FINISH SWITCHING LU ******************************************************************* LUP50 LDA DRT1A,I SET UP DRT AND B3700 WORD 1 WITH ADA P2 NEW DEVICE AND STA DRT1A,I OLD LOCK FLAG. * LUP52 LDA NINTF CHECK IF AN I/O SZA,RSS OPERATION MUST BE JMP LUP55 INITIATED ON THE NEW EQT. CPA $DMEQ YES, IF THE NEW DEVICE IS THE BIT BUCKET, JMP LUP80 THEN SET A FLAG FOR IOCX. JSB $DLAY IF NOT,SET A TIMEOUT FOR INITIATION. * LUP55 LDA .4 SCHEDULE ANY WAITERS ON JSB $SCD3 DOWNED DEVICES. LDA OEQT1 SET UP THE OLD DEVICE'S JSB $ETEQ EQT ADDRESSES, CHECK BUFFER JSB $CKLO LIMITS AND SCHED WAITERS. * LDA P1 IF LU CHANGED WAS CPA .1 SYSTEM CONSOLE THEN JMP LUP70 ISSUE A MESSAGE. JMP $XCQ * LUP70 LDA NSYSM ISSUE '**' MESSAGE TO JMP $MSEX CONSOLE. * LUP80 ISZ $BITB SET A FLAG FOR IOCX SO THAT JMP LUP55 IT WILL CLEAN OUT THE BIT BUCKET. * LUPR2 LDA $DMEQ SET UP DUMMY JSB $ETEQ EQT ADDRESES FOR JMP LUPR1 THE BIT BUCKET. * LUP25 LDA $DMEQ JMP LUP05 * SKP *  SPECIAL TEST TO DISALLOW SWTCHING AN LU TO A DISK IF THE * LU HAS I/O STACKED ON IT(OR IT'S EQT). * LU100 LDA DRT2A,I DOES THE LU RAL,CLE,ERA HAVE ANY I/O SZA HUNG ON IT? JMP $INER YES, ISSUE ERROR MESSAGE. * SEZ IF NO I/O AND LU IS DOWN, JMP LUPR1 THEN ALLOW SWTCH. LDA OEQT1,I OTHERWIZE, IF UP AND NO I/O IS SZA,RSS HUNG ON THE OLD EQT, THEN JMP LUPR1 ALLOW SWTCH. * JMP $INER IF I-O HUNG ON OLD EQT,ISSUE ERROR MESS. * ****************************************************************** * DISPLAY LU AND IT'S STATUS ****************************************************************** * LUPR3 LDA P1 GET AND JSB $CNV1 SAVE THE STA LUMSG+2 ASCII LU #. LDA DRT1A,I GET AND AND B77 SAVE JSB $CNV1 THE ASCII STA LUMSG+5 EQT #. LDA DRT1A,I CHECK IF AND B174K A SUBCHANNEL CCE,SZA IS SPECIFIED. JMP LUP14 LDA DBLBK IF SUBCHANNEL=0, STA LUMSG+6 THEN DO NOT DISPLAY JMP LUP15 THE SUBCHANNEL. * LUP14 LDB BLS IF SUBCHANNEL#0, STB LUMSG+6 THEN DISPLAY ALF,RAL THE ASCII JSB $CNV1 SUBCHANNEL. LUP15 STA LUMSG+7 LDB DBLBK CHECK IF LDA DRT2A,I THE DEVICE SSA IS UP OR LDB EQBD DOWN. IF STB LUMSG+8 DOWN, LDA LUMGA PRINT A "D". JMP $MSEX RETURN. SKP * * VARIABLES, CONSTANTS AND BUFFERS FOR LUPR * NSYSM DEF *+1 DEC -2 ASC 1,** * LUMGA DEF *+1 DEC -18 LUMSG ASC 9,LU #N1 = EXX SYY * B174K OCT 174000 B176K OCT 176000 B20K OCT 20000 B14K OCT 14000 B36K OCT 36000 B77 OCT 77 B3700 OCT 3700 C3700 OCT 174077 MSIGN OCT 100000 .1 DEC 1 .4 DEC 4 .15 DEC 15 M1 DEC -1 * DBLBK ASC 1, BLS ASC 1, S * P1#s NOP P2 NOP DRT1A NOP DRT2A NOP NINTF NOP TTEMP NOP OEQT1 NOP NEQT# NOP WORD2 NOP OSBEQ NOP OMJLU NOP OLD DEVICE MAJOR LU. ODML1 NOP OLD DEVICE MAJOR-LU DRT WORD 1 ADDRESS. ODML2 NOP OLD DEVICE MAJOR-LU DRT WORD 2 ADDRESS. NDML1 NOP NEW DEVICE MAJOR-LU DRT WORD 1 ADDRESS. NDML2 NOP NEW DEVICE MAJOR-LU DRT WORD 2 ADDRESS. SKP ***************************************************************** * * SUBROUTINE CKNLU: * * CKNLU DETERMINES IF THE DEVICE(LU) OR THE EQT POINTED TO BY * THE SUBCHANNEL-EQT WORD IS UP OR DOWN. * * CALLING SEQUENCE: * := SUBCHANNEL IN BITS 11-15, EQT IN BITS 0-5. * :=ADDRESS OF FIFTH EQT WORD. * JSB CKNLU * * RETURN: * (P+1) DEVICE IS DOWN. * (P+2) EQT IS DOWN. * (P+3) DEVICE IS UP OR NO DEVICE FOUND. * ALL REGISTERS ARE VIOLATED. * AT (P+1): :=MAJOR LU # OF DOWNED DEVICE. * :=MAJOR LU DRT WORD 2 ADDRESS. * USES SDRT2 AS A TEMPORARY. * **************************************************************** * CKNLU NOP LDA EQT5,I CHECK IF RAL,SLA THE EQT JMP CKNL0 IS UP OR SSB DOWN. JMP CKNL2 THE EQT IS DOWN. * CKNL0 LDB LUMAX CMB,INB STB SDRT2 LDB DRT CKNL1 LDA B,I DETERMINE AND C3700 IF THE CPA P2 NEW JMP CKNL7 DEVICE INB EXISTS. ISZ SDRT2 JMP CKNL1 JMP CKNL9 THE DEVICE DOES NOT EXIST. * CKNL7 ADB LUMAX DETERMINE IF THE DEVICE LDA B,I IS UP OR DOWN. SSA JMP CKNL8 CKNL9 ISZ CKNLU THE DEVICE IS UP, RETURN TO P+3. CKNL2 ISZ CKNLU THE EQT IS DOWN, RETURN TO P+2. JMP CKNLU,I RETURN. * CKNL8 STB A THE DEVICE IS DOWN. LDB LUMAX SET =DRT WORD 2 ADDumRESS. ADB SDRT2 SET =LU #. INB JMP CKNLU,I RETURN TO P+1. SKP **************************************************************** * SUBROUTINE SDRT2: * * SDRT2 WILL STORE THE A REG IN DRT WORD 2 FOR ANY DRT ENTRIES * WHICH CORRESPOND TO THE SUBCHANNEL AND EQT GIVEN IN P2. IF * ON ENTRY E=1, THEN SDRT2 WILL SCAN ONLY TO THE FIRST ENTRY * CORRESPONDING TO P2. IF E=0, THEN SDRT2 WILL SCAN THE ENTIRE * DRT FROM THE GIVEN ENTRY TO ITS END. * * CALLING SEQUENCE: * :=SUBCHANNEL-EQT WORD FOR THE LU'S TO SCAN FOR: * BITS 5-0=EQT * BITS 15-11=SUBCHANNEL * :=DRT WORD 1 ADDRESS FROM WHICH TO BEGIN SCAN. * :=CONTENTS TO STORE INTO DRT WORD 2. * :=0 SCAN TO END OF DRT. * :=1 SCAN ONLY FOR FIRST ENTRY. * JSB SDRT2 * USES TEMPORARY LOCATIONS CKNLU,SDRT8,SDRT9 * RETURN: * NO REGISTERS ARE SAVED ON EXIT. * ON EXIT: * :=NEXT DRT WORD 1 ADDRESS TO BE SCANNED. * := LUMAX - LAST LU# SCANNED. ***************************************************************** * SDRT2 NOP STA CKNLU SAVE CONTENTS TO STORE INTO DRT WORD 2. LDA LUMAX SET ADA DRT CMA,INA UP ADA B STA SDRT9 COUNTER. STB SDRT8 SAVE ADDRESS OF FIRST DRT ENTRY TO SCAN. SZA,RSS JMP SDRT2,I * SDR29 LDA SDRT8,I SET CONTENTS AND C3700 OF DRT WORD 2 CPA SSBEQ AND COMPARE TO JMP SDR22 SUBCHANNEL-EQT WORD. SDR25 ISZ SDRT8 INCREMENT DRT ADDRESS. ISZ SDRT9 INCREMENT COUNT. JMP SDR29 CLA JMP SDRT2,I NO MORE ENTRIES, SO RETURN. * SDR22 LDB CKNLU FOUND AN ENTRY, LDA SDRT8 POSITION TO ADA LUMAX WORD 2 AND STB A,I STORE NEW CONTENTS. SEZ,RSS IF E=1, ;\NLH JMP SDR25 THEN CONTINUE SCAN. ISZ SDRT8 OTHERWIZE, INCREMENT DRT LDA SDRT9 ADDRESSES AND RETURN. INA JMP SDRT2,I * SDRT8 NOP SDRT9 NOP SSBEQ NOP * ********************************************************************* * * SUBROUTINE CHASE: * * CHASE WILL FIND THE END OF AN I/O QUEUE GIVEN IT'S HEAD. * * CALLING SEQUENCE: * :=ADDRESS OF HEAD OF I/O QUEUE. * JSB CHASE * * RETURN: * ALL REGISTERS ARE MODIFIED. * :=ADDRESS OF LINK WORD OF LAST I/O REQUEST. * :=0 * ******************************************************************** * CHASE NOP CHASE CHAS1 LDA B,I DOWN RAL,CLE,ERA THE LU'S SZA,RSS I/O QUEUE JMP CHASE,I TO ITS LDB A END. JMP CHAS1 SKP * ***************************************************************** * * SUBROUTINE FXWD2: * * FXWD2 CHANGES THE SUBCHANNEL IN WORD 2 OF EACH I/O REQUEST lN* IN THE GIVEN I/O QUEUE. * * CALLING SEQUENCE: * :=NEW SUBCHANNEL: BITS 2-5=LOWER 4 BITS * BIT 13 =UPPER BIT. * :=POINTER TO FIRST I-O REQUEST =0 IF NO REQUESTS. * JSB FXWD2 * * RETURN: * ALL REGISTERS ARE VIOLATED. * ****************************************************************** * FXWD2 NOP RBL,CLE,ERB STRIP POSSIBLE SIGN BIT. FWD21 SZB,RSS IF END OF I/O QUEUE, JMP FXWD2,I THEN EXIT. STB SDRT2 INB POSITION TO I/O LDA B,I CONTROL WORD. AND WD2SB STRIP OFF OLD SUBCHANNEL IOR WORD2 AND ADD IN NEW SUBCHANNEL. STA B,I LDB SDRT2,I FIX NEXT I/O REQUEST. JMP FWD21 * WD2SB OCT 157703 SKP * **************************************************************** * * SUBROUTINE DETOL * * DETOL DETERMINES WHAT THE OLD DEVICE'S MAJOR-LU IS AND SETS * UP LOCATIONS OMJLU, ODML1 AND ODML2. * * CALLING SEQUENCE: * JSB DETOL * * RETURN: * ALL REGISTERS ARE MODIFIED. * :=OLD DEVICE'S MAJOR-LU. * :=OLD DEVICE'S MAJOR-LU DRT WORD 1 ADDRESS. * :=OLD DEVICE'S MAJOR-LU DRT WORD 2 ADDRESS. **************************************************************** * DETOL NOP JSB DETOM DETERMINE THE OLD MAJOR-LU. ADA M1 COMPUTE THE ADA DRT OLD DEVICE'S STA ODML1 MAJOR-LU'S ADA LUMAX DRT WORD 1 STA ODML2 AND 2 ADDRESSES. JMP DETOL,I RETURN. * * ************************************************************************ * * SUBROUTINE DETOM: * * DETOM RETURNS THE OLD DEVICE'S MAJOR-LU. * * CALLING SEQUENCE: * JSB DETOM * * RETURN: * :=OLD DEVICE'S MAJOR-LU. * *********************************************************************** Mp* DETOM NOP LDA DRT2A,I DETERMINE IF LU IS RAL,CLE,ERA THE OLD MAJOR-LU. CLE,SZA,RSS IF NO QUEUE, THEN LU CCE IS THE OLD MAJOR-LU. STA B IF QUEUE ELEMENT IS < 2000, ADB B176K THEN QUEUE ELEMENT IS SEZ OLD MAJOR-LU. LDA P1 IF 2000 >= QUEUE ELEMENT, THEN ELEMENT STA OMJLU IS ADDRESS AND LU IS OLD MAJOR-LU. JMP DETOM,I RETURN. SKP * ***************************************************************** * * SUBROUTINE FOLDD: * * FOLDD WILL FIX THE DRT WORD 2'S OF THE OLD DEVICE'S LU'S. * * CALLING SEQUENCE: * :=THE OLD DEVICE'S MAJOR-LU. * :=THE OLD DEVICE'S MAJOR-LU DRT WORD 1 ADDRESS. * JSB FOLDD * * RETURN: * ALL REGISTERS ARE MODIFIED. ***************************************************************** * FOLDD NOP LDA DRT1A,I SET UP DRT WORD 1 AND B3700 OF LU WITH THE NEW ADA P2 DEVICE AND OLD STA DRT1A,I LOCK FLAG. * CLA SET DRT WORD 2 OF STA DRT2A,I LU TO UP STATE. * LDA OMJLU IF LU=OLD DEVICE MAJOR-LU CPA P1 THEN FIX LU'S FOR THE RSS OLD DEVICE. JMP FOLDD,I OTHERWIZE, RETURN. LDA OSBEQ OLD MAJOR LU. LDB ODML1 INB JSB FXOLD FIX LU'S FOR THE OLD DEVICE. JMP FOLDD,I RETURN. SKP * ***************************************************************** * * SUBROUTINE FXOLD: * * FXOLD WILL CREATE A NEW MAJOR-LU FOR THE OLD DEVICE, POINT * ANY OTHER LU'S FOR THIS DEVICE TO THE MAJOR-LU, AND SET ALL * THESE LU'S DOWN. * * CALLING SEQUENCE: * :=SUBCHANNEL-EQT WORD OF THE LU TO SCAN FOR. * :=DRT WORD 1 ADDRESS TO BEGIN SCAN. * JSB FXOLD * CALLS SUBROUTINE SDRT2 * * REUTRN: * NO REGISTERSKE ARE SAVED. * ***************************************************************** * FXOLD NOP STA SSBEQ LDA MSIGN CREATE A NEW CCE OLD-MAJOR- JSB SDRT2 LU. SZA,RSS IF A=0, THEN NO OTHER JMP FXOLD,I LU'S ON OLD DEVICE. * ADA LUMAX OTHERWIZE, POINT IOR MSIGN ALL OTHER LU'S LDB SDRT8 FOR OLD DEVICE CLE TO THE NEW JSB SDRT2 OLD-MAJOR-LU. JMP FXOLD,I RETURN. SKP * **************************************************************** * * ' DEVICE TIME-OUT PARAMETER ' STATEMENT * * FORMAT: TO,P1,P2 WHERE * * P1 = EQT # * P2 = TIME-OUT PARAMETER OR -1 * * ACTION: IF P2 = -1, A SECOND PARAMETER WAS NOT * RECEIVED FROM THE MESSAGE PROCESSOR; * THEREFORE, PRINT THE CURRENT TIME-OUT * PARAMETER OF DEVICE P1. * * BOTH P1 AND P2 PRESENT, ASSIGN P2 AS THE * NEW TIME-OUT PARAMETER FOR DEVICE P1. * ***************************************************************** * $CHTO STA P1 STB P2 JSB IODNS CHECK VALIDITY OF EQT # LDB P2 LOOK AT P2 SZB,RSS IF N2 ZERO, DISABLE JMP CHTO2 TIME-OUT FOR DEVICE * INB,SZB IF N2 = -1, OUTPUT T-O PARAMETER JMP CHTO1 OTHERWISE, ENTER NEW T-O VALUE * LDA EQT14,I CONVERT T-O PARAMETER CCE,SZA TO DECIMAL ASCII B3000 CMA JSB $CNV3 LDB A,I GET THE HIGH WORD ADB B164C ADD '=' - 'BLANK' STB TOMS+3 CCE,INA DLD A,I STORE IN MESSAGE DST TOMS+4 * LDA P1 CONVERT EQT # JSB $CNV1 TO DECIMAL ASCII STA TOMS+2 STORE INTO MESSAGE LDA TOMSA JMP $MSEX RETURN. SKP CHTO1 CMB,INB ERROR IF ATTEMPT LDA EQT5,I TO SET TYPE 0 OR 5 AND B374C DEVICE TIME-OUT SZA VALUE TO LESS THAN CPA B2400 FIVE SECONDS. RSS JMP CHTO2 OTHERWISE, STORE * LDA .500 NEW TIME-OUT ADA B VALUE. SSA,RSS JMP $INER * CHTO2 STB EQT14,I JMP $XCQ RETURN WITHOUT MESSAGE. * TOMSA DEF *+1 DEC -12 TOMS ASC 2,TO# NOP ASC 1, = NOP NOP * .500 DEC 500 B164C OCT 16400 B2400 OCT 2400 B374C OCT 37400 SKP IODNS NOP STA B IF CMB,INB,SZB EQT SSA NUMBER CCB,RSS IS ZERO ADB EQT# SSB THEN TAKEE, JMP $INER ERROR EXIT. JSB $CVEQ OTHERWIZE, SET EQT ENTRY ADDRESSES. JMP IODNS,I RETURN. * HED ** SYSTEM BASE PAGE COMMUNICATION AREA ** . EQU 1650B ESTABLISH ORIGIN OF AREA * * SYSTEM TABLE DEFINITION * * EQTA EQU .+0 FWA OF EQUIPMENT TABLE EQT# EQU .+1 # OF EQT ENTRIES DRT EQU .+2 FWA OF DEVICE REFERENCE TABLE LUMAX EQU .+3 # OF LOGICAL UNITS (IN DRT) * * I/O MODULE/DRIVER COMMUNICATION * EQT1 EQU .+8 ADDRESSES EQT4 EQU .+11 EQT5 EQU .+12 CURRENT EQT14 EQU .+83 * SYSTY EQU .+21 EQT ENTRY ADDRESS OF SYSTEM TTY * ORG * LENGTH OF SYSTEM COMMAND MODULE. END $EQST ~h  92067-18024 1840 S 0122 RTE-IV PERR              H0101 ASMB,R,L,C *** RTE-IV PARITY ERROR MODULE *** * DATE: 7/26/77 * NAME: PERR4 * SOURCE: 92067-18024 * RELOC: PART OF 92067-16014 * PGMR: E.WONG,M.MANLEY * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** NAM PERR4,0 92067-16014 REV.1840 780731 ENT $PERR,$PETB EXT $CNV1,$CNV3,$SYMG,$ERMG,$XCQ,$UNPE,$MAXP EXT $MATA,$DMS,$ABXY,$CIC A EQU 0 B EQU 1 * * THIS MODULE OF RTE-IV HANDLES PARITY ERRORS. * CALL SEQUENCE FROM RTIO4: * JMP $PERR * <$PERR EXITS VIA $CIC,I> * * IF THE PARITY ERROR IS IN THE OPERATING SYSTEM OR CONFIGURATOR PROGRAM, * $PERR HALTS: HLT 5 * (A) = PHYSICAL PAGE NUMBER * (B) = LOGICAL ADDRESS * * IF THE PARITY ERROR IS DETECTED IN A DCPC TRANSFER * WHILE THE OPERATING SYSTEM IS EXECUTING IN THE SYSTEM MAP, * $PERR HALTS: HLT 5,C * (A) = PHYSICAL PAGE NUMBER * (B) = LOGICAL ADDRESS * * IF THE PARITY ERROR IS A SOFT ERROR (UNREPRODUCABLE), * $PERR PRINTS THE MESSAGES: * "PE @ #####" * "DMS STAT = ######" * * IF THE PARITY ERROR IS IN A PARTITION, * $PERR UNLINKS THE PARTITION FROM THE SYSTEM (UNTIL * NEXT BOOT UP). IT THEN RETURNS WITH : * "PART'N ## DOWN" * "PART'N ## DOWN" (IF THERE IS A MOTHER PTTN) * * IF THE PARITY ERROR WAS IN A MEMORY RESIDENT PROGRAM, * $PERR WILL ONLY PRINT THE FOLLOWING MESSAGES * (THESE WILL FOLLOW THE PARTITION DOWN MESSAGES * IN THE CASE OF A PARTITION RESIDENT PROGRAM): * "PE PG# ##### BAD" * "ABE ###g### ###### #" * "XYO ###### ###### #" * "PE XXXXX #####" * "XXXXX ABORTED" * * * NOTE THAT THE PROGRAM THAT ENCOUNTERED THE PARITY ERROR * IS NOT NECESSARIALLY THE CURRENTLY EXECUTING PROGRAM. * IE, THE PE ERROR MAY HAVE OCCURED DURING A DMA TRANSFER. SKP $PERR STA SAVA INTERRUPT SYSTEM IS TURNED OFF BY RTIO4 STB SAVB SAVE ALL USER REGISTERS LDA $CIC IN CASE OF POWER FAIL STA SAVAD ERA,ALS (DMS STATUS SAVED IN $DMS BY RTIO4) SOC INA STA SAVEO CXB STB SAVX CYB STB SAVY * LIB 5 RBL,CLE,ERB STB LOGPE SAVE LOGICAL PARITY ERROR ADDR LDA 5 PE ALREADY TURNED OFF PE INTERRUPTS STA SAV5 SAVE TRAP CELL 5 LDA JMPPE STA 5 SWITCH TRAP CELL TO LOCAL CLB STB PTNPE INITIALIZE PTTN# TO ZERO STB PEID INITIALIZE ID SEG ADDR TO ZERO STB PHYPG INITIALIZE PHYSICAL PAGE # TO ZERO JSB TRYPE TRY FOR P.E. IN SYSTEM MAP (B)=0 * * NOT IN SYSTEM MAP , TRY DCPC MAPS * DCPC? LDA SAVEU SAVE CURRENT USER MAP USA LDA INTBA,I SZA,RSS IS PORT A BUSY? JMP DCPCB NO, TRY PORT B * LDA SAVEP GET A COPY OF PORT A MAP PAA LDA RSTRP TO PUT INTO USER MAP USA LDB D6 JSB TRYPE TRY FOR P.E. IN PORT A (B)=6 * DCPCB LDA INTBA TRY IT IN PORT B INA LDA A,I SZA,RSS PORT B BUSY? JMP USEPE NO, WE'LL TRY USER MAP FINALLY. * LDA SAVEP GET A COPY OF PORT B MAP PBA LDA RSTRP TO PUT INTO USER MAP USA LDB D7 JSB TRYPE TRY FOR P.E. IN PORT B (B)=7 * * TRY USER MAP * USEPE LDA RSTRU RESTORE USER MAP USA CCB JSB TRYPE TRY FOR P.E. IN USER MAP (B)=-1 * * NOT IN SYSTEM, USER, PORT A, NOR PORT B. SOFT PARITY ERROR. * SOFPE LDA SAV5 STA 5 RESTORE LOCATION 5 FOR $CIC CLE SET UP FOR OCTAL ASCII CONVERSION LDA $DMS GET THE DMS STATUS VALUE JSB $CNV3 CONVERT TO ASCII LDB A,I GET THE 1ST WORD STB SOFT2+8 CLE,INA DLD A,I AND THE SECOND DST SOFT2+9 * LDA LOGPE GET LOGICAL PARITY ERROR ADDR JSB $CNV3 CONVERT TO ASCII LDB A,I GET THE 1ST WORD STB SOFT1+4 AND PUT INTO BUFFER INA DLD A,I AND NOW THE LAST TWO DST SOFT1+5 * LDA SOFT1 GET THE 1ST MESSAGE JSB $SYMG AND REPORT TO USER LDA SOFT2 GET THE SECOND MESSAGE JSB $SYMG AND REPORT IT TOO * PEDON LDB SAVY RESTORE REGISTERS BEFORE RETURNING CBY LDB SAVX CBX LDA SAVEO CLO SLA,ELA STF 1 LDB SAVB CLA CPA $INT,I IS INT SYS ON? $INT=0? JMP INTON YES * STA $INT,I NO, CLEAR $INT LDA SAVA RESTORE A-REG JMP EXIT REENABLE PARITY ERROR AND RETURN * INTON LDA SAVA RESTORE A-REG STF 0 TURN ON INTERRUPT SYSTEM EXIT STF 5 REENABLE PARITY ERROR JRS $DMS * RETURN SAVAD EQU *-1 * * SOFT1 DEF *+1 DEC -10 ASC 5,PE @ XXXXX SOFT2 DEF *+1 DEC -18 ASC 9,DMS STAT = XXXXXX D6 DEC 6 D7 DEC 7 SAVA NOP SAVE A-REGISTER SAVB NOP SAVE B-REGISTER SAVEO NOP SAVE E AND O REGISTERS SAVX NOP SAVE X-REGISTER SAVY NOP SAVE Y-REGISTER $INT DEF $DMS+1 SAV5 NOP SAVE LOCATION 5 CONTENTS SAVEU DEF UMAP,I SAVE USER MAP IN MEMORY RSTRU DEF UMAP STORE MEMORY IN USER MAP SAVEP DEF PMAP,I SAVE PORT MAP IN MEMORY RSTRP DEF PMAP STORE MEMORY IN PORT MAP UMAP BSS 32 PMAP BSS 32 * * JMPPE JMP PELNK,I TRAP CELL INSTRUCTION FOR P.E. KORB PELNK DEF GOTPE BASE PAGE LINK TO PARITY ERROR CODE ORR * * * SUBROUTINE TO TRY TO GET PARITY ERROR AGAIN * CALL SEQUENCE: * (LOGPE) = LOGICAL ADDRESS * (B) = 0 TRY IT IN SYSTEM MAP * (B) # 0 TRY IT IN CURRENT USER MAP * JSB TRYPE CALL * NO PARITY ERROR OCCURRED * TRYPE NOP TRY TO VERIFY PARITY ERROR STB PORT SAVE MAP INDICATOR RETRY STF 5 ENABLE PARITY INTERRUPTS SZB DO IT IN SYSTEM MAP? JMP TRYUS NO, TRY IT IN USER MAP * LDA LOGPE,I DO READ OF SUSPECTED LOCATION JMP NOPE NO P.E. RETURN * TRYUS XLA LOGPE,I TRY READ OF SUSPECTED LOCATION NOP WAIT FOR MX HARDWARE TO COOL OFF! NOPE CLF 5 TURN OFF PE INT SO WE DON'T GET CONFUSED JMP TRYPE,I NO P.E. IN USER MAP, RETURN * * * GOT A PARITY ERROR FROM TRYPE SUBROUTINE * GOTPE LIA 5 GOT A PARITY ERROR RAL,CLE,ERA BUT IS IT A SECOND PE ERROR CPA LOGPE OR IS IT A VERIFICATION OF SAME ONE? RSS SAME, SKIP JMP RETRY SECOND ONE, TRY AGAIN TO VERIFY FIRST * LDA SAV5 WE CAN NOW SAFELY RESTORE STA 5 TRAP CELL FOR MP/DMS/PE INTERRUPTS * LDA LOGPE GET PE ADDR AND B76K GET LOGICAL PAGE # ALF RAL,RAL (A) = LOGICAL PAGE # SZB USING SYSTEM MAP? ADA B40 NO, USE USER MAP REG# CCB CBX (X) = -1 FOR READ 1 REGISTER LDB DPHYP READ IT INTO 'PHYPG' XMM READ MAP REGISTER LDA PHYPG AND B1777 KEEP LOWER 10 BITS STA PHYPG AS PHYSICAL PAGE NUMBER * LDB PORT SSB WAS THE PE IN USER MAP? JMP INPRG - YES, FIND PROGRAM * SZB WAS THE PE IN SYSTEM MAP? JMP DMAPE + NO, FIND THE CURRENT DMA REQUESTOR * * PARITY ERROR WAS V yERIFIED TO BE IN THE SYSTEM MAP * OR IT WAS IN A USER PAGE CONTAINING SYSTEM TABLES. * AT HLT (A)=PHYSICAL PAGE # (B)=LOGICAL ADDR * INSYS LDA PHYPG PE IN SYS OR SYS TABLES LDB LOGPE HLT05 HLT 5 102005 HALT FOR SYS PE ERROR JMP *-1 DON'T ALLOW TO PROCEED * * * PARITY ERROR WAS VERIFIED TO BE IN A DCPC TRANSFER * WHILE THE SYSTEM MAP WAS ENABLED. SINCE RTE IS NOT * REENTRANT, WE CANNOT PROCESS ERROR MESSAGES OR ABORT * ANY PROGRAMS BECAUSE WE MAY HAVE INTERRUPTED FROM * THAT CODE. * AT HLT (A)=PHYSICAL PAGE # (B)=LOGICAL ADDR * INDMA LDA PHYPG PE IN DCPC TRANSFER DURING SYS MAP LDB LOGPE HLTC5 HLT 5,C 103005 HALT FOR DCPC DURING SYS JMP *-1 DON'T ALLOW TO PROCEED * * * $PETB EQU * ENTRY POINT FOR ANALYSER PHYPG NOP $PETB+0 PHYSICAL PAGE NUMBER LOGPE NOP $PETB+1 LOGICAL PARITY ERROR ADDRESS PORT NOP $PETB+2 MAP CONTAINING PARITY ERROR PEID NOP $PETB+3 ID SEGMENT ADDRESS IF PROGRAM PE PTNPE NOP $PETB+4 PARTITION NUMBER(S) IF PROGRAM PE B1777 OCT 1777 B76K OCT 76000 B40 OCT 40 HED PARITY ERROR IN A PORT MAP DMAPE LDA $DMS GET DMS STATUS AT PE INTERRUPT RAL SSA,RSS DID WE INTERRUPT FROM SYSTEM MAP? JMP INDMA YES, HLT 5,C * LDA RSTRU RESTORE ORIGINAL USER MAP USA LDA PORT AND D1 ADA INTBA LDA A,I GET EQT ADDR OF DMA USER RAL,CLE,ERA CLEAR SIGN BIT FIRST LDB A,I GET EQT LINK WORD SSB,RSS DOING SYSTEM CLEAR? SZB,RSS OR EQT ALREADY UNLINKED? JMP INSYS YES, JUST GIVE SYS PE, DON'T KNOW PROG * LDA B INA LDA A,I GET CONTROL WORD TO CHECK T RAL SSA T=1 OR T=3? JMP INSYS YES, SYSTEM IS DOING I/O * SLA,RSS T=0? JMP PRGPE YES, USER DOING I/OV * ADB D4 T=2. LDB B,I GET TYPE OF $XSIO CALL RBL,CLE,ERB CLEAR SIGN, KEEP IT IN (E) SZB,RSS IS IT A SYSTEM REQUEST? JMP INSYS YES, =0 OR 100000 JMP PRGPE NO, USER REQ (B)=ID SEG ADDR * * B77 OCT 77 D1 DEC 1 D4 DEC 4 D14 DEC 14 D15 DEC 15 D21 DEC 21 DPHYP DEF PHYPG HED PARITY ERROR IN A USER PROGRAM INPRG LDB XEQT IN CURRENT USER MAP SZB IS PROG = 0? JMP PRGPE NO, PROG. GET MAT INFO * LDB EQT1,I YES, MAYBE INTERRUPT DRIVER. RBL,CLE,ERB SZB,RSS I/O IN PROGRESS? JMP INSYS NO, DO SYS PE HALT * LDA B LEAVE POSSIBLE ID ADDR IN (B) INA LDA A,I CHECK T-FIELD IN CONTROL WORD RAL,RAL AND D3 SZA T=00? (UNBUFFERED USER) JMP INSYS NO, DO SYS PE HALT * PRGPE STB PEID (B)=ID SEG ADDR OF USER ADB D14 LDA B,I AND D15 GET PROG TYPE CPA D1 IS IT MEMORY RESIDENT PROG? JMP ABPRG YES, JUST ABORT PROG * LDA PEID ADA D21 GET MAP ID WORD LDA A,I AND B77 GET PTTN # MPY MATSZ MULT BY MAT ENTRY SIZE ADA $MATA JSB MATAD SET UP MAT PTRS * LDA MLNK,I GET THE LINK WORD INA,SZA,RSS DID WE ALREADY UNDEFINE THIS GUY ? JMP PEDON YES, SO DON'T DO IT AGAIN. * LDA MADR,I IS PE IN MOTHER PTTN? SSA JMP MOMPE YES, HAVE TO FIND SUBPTTN * * PE IS IN A SUBPARTITION, FIND THE MOTHER PARTITION * JSB INPT? IS LOCATION IN PTTN? JMP INSYS NO, PE IN SYS PORTION OF USER MAP! LDB MLNK SUBPTTN OR REGULAR PTTN STB SUB HAS THE PE JSB $UNPE UNLINK FROM ALLOC LIST AND UNDEFINE NXSPE LDA MSUBL,I STA MOM SAVE POSSIBLE MOTHER PTTN ADDR SZA,RSS IS THIS A SUBPTTN? JMP BLDPT k NO, GO BUILD PTTN PE WORD * JSB MATAD YES, SEARCH FOR MOTHER PTTN LDA MADR,I SSA,RSS IS THIS THE MOTHER? JMP NXSPE NO, TRY NEXT SUBPTTN LINK * LDB MLNK YES, FOUND THE MOTHER LINK JSB $UNPE UNLINK MOTHER PTTN FROM FREE LIST JMP BLDPT FOUND IT ALL NOW * * * PE IS MOTHER PARTITION, FIND THE AFFECTED SUBPARTITION * MOMPE JSB INPT? IS PE ACTUALLY IN MOTHER PTTN? JMP INSYS NO, SAY IT IS IN SYS. LDB MLNK YES, PE OCCURRED IN MOTHER PTTN STB MOM SAVE FOR PTTN PE WORD JSB $UNPE UNLINK MOTHER PTTN FROM ALLOC LIST * NXSP2 LDA MSUBL,I CPA MOM DONE YET? JMP BLDP2 YES, PE JUST IN MOTHER PTTN * STA SUB NO, NEED TO FIND SUBPTTN WITH PE JSB MATAD JSB INPT? IS PE IN THIS SUBPTTN? JMP NXSP2 NO, TRY NEXT * SBPPE LDB MLNK UNLINK AND UNDEFINE JSB $UNPE THIS SUBPARTITION. * BLDPT LDB SUB GET PTTN/SUBPTTN OF PE JSB PTTNO CONVERT IT TO PTTN# STA PTNPE SET INTO BITS 0-7 OF PTTN PE WORD BLDP2 LDB MOM GET POSSIBLY MOTHER PTTN ADDR STB A CPB SUB BUT IF SAME AS SUBPTTN CLA THEN USE 0 IN PTTN PE WORD SZA THEN USE 0 IN PTTN PE WORD BITS 8-15 JSB PTTNO CONVERT TO PTTN# ALF,ALF IOR PTNPE STA PTNPE PUT INTO BITS 8-15 * UNCHN LDA MOM NOW UNCHAIN SUBPTTNS SZA,RSS ANY MOTHER PTTN AFFECTED? JMP UPEDN NO, USER PE. DONE. * UNCH2 JSB MATAD YES, MOTHER PTTN INVOLVED LDA MLTH,I AND C40K CLEAR "C" BITS IF SET STA MLTH,I LDA MSUBL,I GET NEXT SUBPTTN ADDR CLB STB MSUBL,I CLEAR LINK WORD CPA MOM DONE YET? JMP UPEDN YES, RETURN PE TO EXEC JMP UNCH2 NO, DO NEXT SUBPTTN * UPEDN JSB $MAXP RE-ESTABLISH MAX PTTN SIZES * * 0 LDA PTNPE GET PTTN NUMBERS AND B377 SAVE LOWER BYTE SZA,RSS ANY SUBPTTN? JMP P1TRY NO, JUST MOTHER PTTN? * P1MOR CCE COUNT FROM 1 & DO DECIMAL CONVERSION. JSB $CNV1 CONVERT TO ASCII STA PEMSG+6 PUT INTO THE ERROR MESSAGE LDA PEMSG GET THE LOCATION OF THE ERROR MESSAGE JSB $SYMG TELL THE USER ABOUT THE DOWN PARTITION P1TRY LDA PTNPE GET THE PARTITION NUMBER(S) AGAIN ALF,ALF GET NEXT PARTITION TO LOWER BYTE AND B377 SAVE THE LOWER BYTE SZA,RSS IS THERE A MOTHER PARTITION ? JMP ABPRG NO,TELL BAD PAGE # STA PTNPE SAVE PARTITION # JMP P1MOR DO IT ONCE MORE * * ABPRG LDA PHYPG GET THE BAD PG# CCE DO DECIMAL CONVERSION FROM 0 JSB $CNV3 AND CONVERT TO DECIMAL ASCII LDB A,I GET THE 1ST WORD STB BDPG#+5 AND SAVE INA DLD A,I NOW GET THE LAST TWO DST BDPG#+6 LDA BDPG# GET THE ADDRESS OF THE MESSAGE JSB $SYMG AND SEND IT TO THE USER * LDB PEID GET ID SEG ADDR OF PROG SZB,RSS JMP PEDON STB XEQT FAKE OUT ABORT PROCESSORS CBX * LDA LOGPE GET LOGICAL PARITY ERROR ADDR SAX D8,I AND PUT IT INTO THE POINT OF SUSP WORD JSB $ABXY DUMP A,B,E,X,Y,O REGS LDA PE NOW GO ABORT THE PROGRAM LDB BLANK JSB $ERMG STF 5 REENABLE PARITY ERROR JMP $XCQ * * * B377 OCT 377 D8 DEC 8 * BLANK ASC 1, PEMSG DEF *+1 DEC -16 ASC 8,PART'N XX DOWN BDPG# DEF *+1 DEC -16 PE ASC 8,PE PG# XXXXX BAD * * * INPT? - VERIFY IF PE PAGE IN IS A PARTITION * * CALL SEQUENCE: * MATA ADDR SET UP BY MATAD * JSB INPT? * * * REGISTERS ARE MEANINGLESS * INPT? NOP IS PE IN PTTN PAGES? LDA MA DR,I TRY TO FIND IF PE OCCURRED IN PAGES AND B1777 WITHIN THE SUBPTTN OR STA B IT WAS IN THE SYSTEM PAGES CMA,INA OF THE USER MAP ADA PHYPG SSA PE PAGE# < FIRST PAGE PTTN? JMP INPT?,I YES, PE BELOW PTTN PAGES. RETURN P+1 * LDA MLTH,I AND B1777 ADA B ADD #PAGES IN PTTN FOR LAST PAGE CMA,INA ADA PHYPG SZA SSA PE PAGE# > LAST PAGE PTTN? ISZ INPT? NO, PE IN PTTN PAGES. RETURN P+2 JMP INPT?,I YES, PE ABOVE PTTN PAGES. RETURN P+1 * * * PTTNO - CONVERT PTTN MAT ADDR TO PTTN NUMBER * * CALL SEQUENCE: * (B) = MAT ADDR * JSB PTTNO * * (A) = PTTN # * PTTNO NOP (B) = MAT ADDR LDA $MATA CMA,INA SUBTRACT BEGINNING OF MAT ADA B TABLE FROM MAT ADDR CLB DIV MATSZ DIVIDE BY #WORDS PER ENTRY INA JMP PTTNO,I RETURN PTTN # IN (A) * * C40K OCT 137777 D3 DEC 3 SUB NOP MAT ADDR OF SUBPTTN MOM NOP MAT ADDR OF MOTHER PTTN * * * SKP * MAT ENTRY * * WORD DESCRIPTION * !--!--.--.--!--.--.--!--.--.--!--.--.--!--.--.--! * !15 14 13 12 11 10 09 08 07 06 05 04 03 02 01 00! * !--!--.--.--!--.--.--!--.--.--!--.--.--!--.--.--! * ! ! ! ! ! ! ! * MLNK 0 !00! LINK TO NEXT ENTRY IN LIST ! * ! ! ! ! ! ! ! * !--!--------!--------!--------!--------!--------! * ! ! ! ! ! ! ! * MPRIO 1 !00! PRIORITY OF PARTITION OCCUPANT ! * ! ! ! ! ! ! ! * !--!--------!--------!--------!--------!--------! * ! ! ! ! ! ! ! * MID 2 !00! ID SEGMENT ADDRESS OF OCCUPANT ! * ! ! ! ! ! ! ! * !--!--------!--------!--------!--------!--------! * ! ! ! ! ! ! ! * MADR 3 ! M!** D ******** BEGIN PHYSICAL PAGE# ! * !@@! ! @@@@@@@@@@@@@@@@@@@@@@@@@@@@@! * !--!--------!--------!--------!--------!--------! * ! ! ! ! ! ! ! * MLTH 4 ! R! C *****!***** NUMBER OF PAGES IN PTTN ! * !@@! ! @@@@@@@@@@@@@@@@@@@@@@@@@@@@@! * !--!--------!--------!--------!--------!--------! * ! ! ! ! ! ! ! * MRDFL 5 !RT!***********************************! STATUS ! * !@@! ! ! ! ! ! * !--!--------!--------!--------!--------!--------! * ! ! ! ! ! ! ! * MSUBL 6 !00! POINTER TO NEXT SUBPTTN OR 0 ! * !@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@! * !--!--.--.--!--.--.--!--.--.--!--.--.--!--.--.--! * !15!14 13 12!11 10 09!08 07 06!05 04 03!02 01 00! * !--!--.--.--!--.--.--!--.--.--!--.--.--!--.--.--! * * "@" MARKS THE PARTS WHICH ARE SET AT GENERATION TIME: * "*" MARKS THE RESERVED PARTS * ************************************** * SET UP POINTERS TO ENTRY IN MAT * CALL: (A) = MAT ADDR * JSB MATAD * ************************************** * MATAD NOP STA MLNK SET MAT ENTRY POINTER ADA D3 STA MADR MAP START ADR INA STA MLTH PTTN LENGTH IN PAGES INA STA MRDFL READ COMPLETION FLAG INA STA MSUBL SUBPARTITION LINK WORD JMP MATAD,I * * MATSZ DEC 7 MLNK NOP LINKAGE WORD MADR NOP MAP START,BITS 0-9 MLTH NOP PTTN LENGTH, BITS 0-9 MRDFL NOP READ FLG(0-2),RT FLAG(15) MSUBL NOP * * * XMATA EQU 16B@<46B ADDR OF CURR MAT ENTRY INTBA EQU 1654B INTERRUPT TABLE ADDR EQT1 EQU 1660B WORD 1 ADDR OF CURRENT EQT XEQT EQU 1717B ADDR OF CURRENT PROG ID SEG * BSS 0 SIZE OF MODULE END $PERR B  92067-18025 1805 S C0422 &4CNF1 RTE-IV CONFIGURATION             H0104 ASMB,R,L,C HED RTE IV CONFIGURATOR PART OF 92067-16014 NAM $CNFG,16 92067-16014 REV.1805 780112 * NAME: $CNFG * SOURCE: 92067-18025 * RELOC: PART OF 92067-16014 * PGMR: S.K.,D.J.V * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * SUP ENT $CNFG,$EXIT,$PCHN,$WRRD,$USRS,$ABDP,$SMTB ENT $TRTB,$TREN,$NPGQ,$GDPG,$SAVE * EXT $SBTB EXT $XSIO,$CMST,$ENDS,$MRMP,$XCQ,$LIST EXT $CNV3,$PRSE,$PLP,$MATA,$MNP * * A EQU 0 B EQU 1 JSBCI EQU 5 EQTA EQU 1650B EQT# EQU 1651B DRT EQU 1652B LUMAX EQU 1653B INTBA EQU 1654B INTLG EQU 1655B KEYWD EQU 1657B EQT1 EQU 1660B EQT3 EQU 1662B EQT5 EQU 1664B EQT6 EQU 1665B EQT7 EQU 1666B EQT8 EQU 1667B EQT9 EQU 1670B EQT10 EQU 1671B EQT11 EQU 1672B EQT12 EQU 1771B TBG EQU 1674B SYSTY EQU 1675B SKEDD EQU 1711B DUMMY EQU 1737B BPA2 EQU 1743B LBORG EQU 1745B SECT2 EQU 1757B * * $SAVE BSS 9 NOP NOP BSS 3 TBGSV NOP PRVSV NOP ACN1 DEF CN1 MRSET OCT 150077 * .3 DEC 3 .4 DEC 4 .5 DEC 5 .6 DEC 6 .7 DEC 7 .8 DEC 8 .12 DEC 12 .13 DEC 13 .14 DEC 14 .15 DEC 15 .16 DEC 16 .31 DEC 31 .32 DEC 32 .40 DEC 40 .64 DEC 64 .168 DEC 168 * N1 DEC -1 N3 DEC -3 N4 DEC -4 N6 DEC -6 * B10 EQU .8 B37 EQU .31 B40 EQU .32 B41 OCT 41 B74 OCT 74 B75 OCT 75 B177 OCT 177 B1777 OCT 177700 B377 OCT 377 B1774 OCT 177400 B1776 OCT 1776 HLT4 OCT 102004 * YE ASC 1,YE NO ASC 1,NO SPACE ASC 1, * MSG4 ASC 13,CURRENT I/O CONFIGURATION: MSHG5 ASC 8,SELECT CODE = MSG6 ASC 6,EQT ,TYPE MSG8 ASC 4,PRIV I/O MSG10 ASC 25,CURRENT SELECT CODE#,NEW SELECT CODE#?(/E TO END) MSG12 ASC 20,NEW I/O CONFIGURATION PERMANENT?(YES/NO) MSG21 ASC 13,PHYSICAL MEM SIZE?(#PAGES) AMSG5 DEF MSG5 AMSG6 DEF MSG6 AMSG8 DEF MSG8 ACNFX DEF *+1 SWREG ASC 3,$CNFX TEMP EQU ACNFX OLSTB BSS 56 * * * * $CNFG NOP SVTBL CLC 0 CLEAR ALL INTERRUPTS LDA SYSTY GET CONSOLE EQT ADDRESS ADA .3 POINT TO WORD 4 OF CONSOLE EQT STA $SAVE SAVE IT LDA .4,I TRAP CELL CONTENTS FOR POWER FAIL STA $SAVE+11 SLOT LDA HLT4 INSERT HALT 4 IN TRAP CELL SO THAT THE SYSTEM STA .4,I HALTS ON POWER FAIL DURING CONFIGURATION LDA DUMMY SAVE PRIV INT CARD LOC STA $SAVE+5 FROM BASE PAGE STA PRVSV LDA TBG STA TBGSV LDA SKEDD SAVE CONTENTS STA $SAVE+6 CLB CLEARSYSTY TO PREVENT USER FROM RSTBL STB SYSTY GETTING OPERATOR ATTENTION STB DUMMY & DUMMY TO LET INTERRUPTS COME THRU STB SKEDD PREVENT PROG FROM BEING SCHEDULED LDA $LIST SAVE CONTENTS STA $SAVE+7 ISZ $LIST DLD EQT1 SAVE EQT WORDS 1-6 ON DST $SAVE+1 BASE PAGE COMMUNICATION AREA DLD EQT3 DST $SAVE+3 DLD EQT5 DST $SAVE+12 * LDB ACNFX GET $CNFX'S ID SEGMENT ADDRESS JSB TNAME SEZ,SZA,RSS PRESENT? CLB NO STB CNXID ID SEGMENT ADDRESS * LIA 1 READ THE SWITCH REGISTER CONTENTS STA SWREG AND SAVE IT CLB CLEAR THE SWITCH REGISTER OTB 1 SSA,RSS BIT 15 SET? JMP MEMLD NO,LOAD MEM RES & DRIVER PARTNS CCA YES,INITIALIZE SVTBL TO -1 LDB .40 SVTBL IS 16 WORDS LONG TEMP6 JSB SETM AND RSTBL IS 20 WORDS LONG WFLAG DEF SVTBL STARTING FROM LOC SVTBL TEMP1 LDA SWREG TEMP2 ALF,ALF M> GET NEW DISC SC IN BITS 0-5 TEMP3 RAL,RAL TEMP4 AND B77 MASK DISC SC TEMP5 SZA,RSS 0? OLDSC JMP MEMLD YES, DISC SC DOES NOT CHANGE NEWSC STA NEWSC LDA ASVTB START OF SVTBL JSB SVENT MAKE NEW DISC ENTRY IN SVTBL CLA LDB NEWSC CPB TBG USED TO BE TBG? STA TBG YES, THEN CLEAR TBG CPB $SAVE+5 USED TO BE PRIV I/O CARD? STA $SAVE+5 YES, THEN CLEAR PRIV I/O CARD * TRPCL LDA DRT POINT TO DRT ENTRY FOR LU2 INA LDA A,I GET CONTENTS OF SYS LU ENTRY IN DRT AND B77 MASK EQT # FOR DISC ADA N1 SUBTRACT 1 TO START EQT#'S AT 0 MPY .15 FIND SYS DISC EQT ADDR ADA EQTA ADA .3 POINT TO WORD 4 OF SYS DISC EQT STA B SAVE ADDRESS IN THE B REG STA RSTBL+5 SAVE FOR NOW JSB EQTCN SET EQT WORD 4 FOR NEW SELECT CODE LDA INTBA INTERRUPT TABLE ADDRESS ADA OLDSC ADD OLD SELECT CODE # ADA N6 ADJUST ADDRESS LDB A,I GET CONTENTS OF INTRPT TBL ENTRY INA POINT TO NEXT SC IN INTRPT TBL CPB A,I BOTH SELECT CODES THE SAME? CCA,RSS YES CLA STA TEMP -1 IF 2 SC'S FOR DISC, 0 OTHERWISE JSB INTRP SET TRAP CELL AND INTRPT TBL FOR NEW SC LDA TEMP SSA,RSS 2 DISC SC'S? JMP MEMLD NO, THEN LOAD MEMORY ISZ NEWSC YES,SECOND SELECT CODE# FOR DISC ISZ OLDSC SECOND SELECT CODE FOR DISC LDA ASVTB ADA .4 ENTER SECOND SC ENTRIES IN SVTBL JSB SVENT JSB INTRP SET UP TRAP CELL & INTRPT TBL FOR 2ND SC CCA GET OLD SC BACK TO ORIGINAL VALUE ADA OLDSC OLD SC - 1 CCB ADB NEWSC NEW SC - 1 PRMTB DST OLDSC RESTORE THEM * * * LOAD MEMORY RESIDENT PROGRAMS AND RESIDENT LIBRARY * AND THE DRIVER PARTITIONS INTO MEMORY * * MEMLD LDA $SBTB+1 GET # OF PAGES IN DRIVER PARTITIONS SZA,RSS ANY GENERATED INTO SYSTEM? DRPGS JMP MEMRS NO, LOAD MEMORY RESIDENT PROGRAMS STA DRPGS USE THIS AS COUNTER LDA B41 BUILD DISC RESIDENT PROGRAM LDB $CMST MAP TO LOAD DRIVER PARTITIONS ADB N1 MWOCM CBX # OF PAGES TO BE LOADED NPGS CLB,INB START LOADING FROM PAGE 1 XMS TRANSFER SEQUENTIAL MEMORY STA MEMLD A REG POINTS TO NEXT MAP REG# LDB $ENDS START PAGE OF DRIVER PARTITIONS STB MEMLD+1 LDB $CMST # OF PAGES IN THE MAX.ADDRESSABLE CMB,INB SPACE WITHOUT COMMON ADB .31 STB MWOCM SAVE IT LDA $SBTB DISC ADDRESS OF DRIVER PARTNS JSB DSCAD SEPARATE TRACK AND SECTOR #'S * LDA $CMST START PAGE OF COMMON LSL 10 MULTIPLY BY 2000B STA TEMP3 LOAD FOR DRIVER PARTN DRVLD LDA DRPGS LDB DRPGS # OF PAGES IN DRIVER PARTITIONS CMB,INB # OF PAGES LEFT TO BE LOADED ADB MWOCM > MAX ADDRESS SPACE IN MAP? SSB LDA MWOCM YES,#PGS TO LOAD AT ONE TIME=MWOCM STA NPGS # OF PAGES OF DRVR PARTN TO BE LOADED CAX BUILD THE REST OF THE DISK RES MAP DLD MEMLD XMS LOAD MAP DST MEMLD SAVE NEW VALUES OF A&B REG LDA NPGS BUILD TRIPLETS TO READ DATA LSL 10 FROM DISC W/OUT CROSSING TRACK BOUNDARY STA TEMP SAVE # OF WORDS IN BUFFER JSB LOAD LOAD NPGS OF DRIVER PARTITION LDA NPGS # PAGES LOADED CMA,INA ADA DRPGS #PAGES THAT HAD TO BE LOADED SZA,RSS ANY LEFT? JMP MEMRS NO, DONE LOADING DRIVER PARTNS * STA DRPGS #PAGES LEFT TO BE LOADED ISZ PRMAR ADDRESS OF PARAMETER ARRAY LDB PRMAR,I GET # OF WORDS IN LAST TRIPLET LSR 6 DIVIDE IT BY 64 CBX SAVE B REG VALUE ISZ PRMAR GET TRACK / SE CTOR # FOR LAST TRIPLET LDA PRMAR,I JSB DSCAD SEPARATE DISC ADDRESS CXB GET X REG IN B ADB TEMP2 B REG HAS NEW SECTOR # CMB -(NEW SECTOR# + 1) ADB SECT2 # OF SECTORS/TRACK ON SYS DISC SSB,RSS NEW SECT#># SECTORS/TRACK ON SYS DISC? JMP DRVLD NO ISZ TEMP1 YES, INCREMENT TRACK# BY 1 CLA SECTOR# IS 0 STA TEMP2 SECTOR# FOR SETUP JMP DRVLD LOAD THE NEXT PAGES * * * INTRP - THIS PROCEDURE IS PERFORMED TO ENTER * INTERRUPT TABLE AND TRAP CELL VALUES FOR DISC * SELECT CODES * * CALLING SEQUENCE: JSB INTRP * INTRP NOP LDB OLDSC,I TRAP CELL VALUE FOR OLD SELECT CODE STB NEWSC,I STORE VALUE IN NEWSC'S TRAP CELL * LDA INTBA INTERRUPT TABLE ADDRESS ADA N6 STA TEMP2 SAVE THIS ADDRESS LDB OLDSC OLD SELECT CODE ADB A POINT INTO INTERRUPT TABLE LDA B,I OLD SC'S INTERRUPT TABLE VALUE LDB NEWSC ADB TEMP2 STA B,I SAVE OLDSC VALUE IN NEWSC ENTRY JMP INTRP,I IN INTERRUPT TABLE - RETURN * * * TNAME - SEARCH KEYWORD LIST FOR PROGRAM NAME * CALLING SEQUENCE: B REG = ADDRESS OF ASCII PROGRAM NAME * JSB TNAME * RETURNS: A REG = 0 IF PROGRAM NOT FOUND (E=1) * B REG = ID SEGMENT ADDRESS OF REQUESTED PROGRAM * E REG = 0 IF STANDARD ID SEGMENT * E REG = 1 IF SHORT ID SEGMENT OR NOT FOUND * * TNAME NOP TNTM3 STB TNTM3 ADDRESS OF NAME 1 AND 2 TNTM4 INB INCREMENT TO CHAR 3 AND 4 ADDR TNTM5 STB TNTM4 SAVE IT INB INCR TO CHAR 5 ADDR LDA B,I ASCII NAME CHAR 5 AND X AND B1774 MASK OFF X STA TNTM5 SZA IF NULL CHAR. FORCE ERROR RETURN LDA KEYWD STA TEMP TN005 LDA TEMP,I CHECK IF AT END OF LIST CCE,SZA,RSS JMP TNAME,I END OF LIST RETURN n{ ADA .12 LDB A,I ID SEG ASCII NAME CHARS 1 AND 2 CPB TNTM3,I COMPARE WITH REQUESTED CHAR 1,2 INA,RSS COMPARES JMP TN030 DOES NOT COMPARE-GO TO NEXT PROG LDB A,I ID SEG ASCII NAME CHARS 5,X CPB TNTM4,I COMPARE WITH REQUESTED CHARS 3,4 INA,RSS COMPARES JMP TN030 DOES NOT COMPARE-GO TO NEXT PROG LDA A,I ID SEG ASCII NAME CHARS 5,X STA B SAVE FOR SHORT ID TEST AND B1774 MASK OFF X CPA TNTM5 COMPARE CHAR 5 JMP TN040 COMPARES-SO PROGRAM FOUND * TN030 ISZ TEMP INCREMENT KEYWORD ADDRESS JMP TN005 GO TO COMPARE CHARS TN040 LSR 4 MOVE SHORT ID BIT TO LEAST B ERB SET E FOR RETURN LDB TEMP,I LOAD B WITH ID SEG ADDRESS JMP TNAME,I EXIT * * * LOAD THE MEMORY RESIDENT PROGRAMS * AND THE MEMORY RESIDENT LIBRARY * * MEMRS LDA $SBTB+3 # OF PAGES IN MEM RESIDENT BASE PAGE SZA,RSS MEM RES PROGRAMS EXIST? JMP IOCNF NO, THEN CONFIGURE I/O LDA B40 YES LDB .32 32 REGISTERS CBX LDB $MRMP MEM RES MAP XMM TRANSFER MEM TO MAPS * LDA B1776 1776B WORDS TO LOAD FOR STA TEMP MEM RESIDENT BASE PAGE LDA $SBTB+2 DISC ADDRESS FOR MEM RES BASE PAGE JSB DSCAD LDA .2 START ADDRESS IS 2 STA TEMP3 JSB LOAD LOAD MEM RES BASE PAGE LDA $SBTB+5 #PAGES FOR MEM RES LIB & PROGS LSL 10 MULTIPLY BY 2000B STA TEMP # OF WORDS IN BUFFER LDA $SBTB+4 DISC ADDRESS FOR MEM RES LIB & PROGS JSB DSCAD LDA LBORG STARTING MEM ADDRESS STA TEMP3 FOR RESIDENT LIBRARY JSB LOAD LOAD THE MEM RES PROGS & LIB * * **** I/O RE-CONFIGURATION ****** * * IOCNF LDA SWREG RE-CONFIGURATION REQUESTED? SSA,RSS BIT 15 IN SWITCH REGISTER SET? JMP $EXIT NO", THEN DONE * CCA YES,INITIALIZE TRPCL,INTBL,EQTBL TO -1 LDB .168 168 ENTRIES POSSIBLE JSB SETM DEF TRPCL START AT LOC TRPCL CCA INITIALIZE OLD SC TABLE TO -1 LDB B70 JSB SETM DEF OLSTB LDA SVTBL DISC I/O SELECT CODE CHANGED? SSA JMP CONSL NO, THEN CONFIGURE CONSOLE SC JSB JNENT ENTER DISC SC IN INTBL AND TRPCL NOP ERROR RETURN NOT POSSIBLE LDA AEQTB ADDRESS OF EQTBL ADA NEWSC POINT TO NEW DISC SC ENTRY ADA NB10 IN EQTBL LDB RSTBL+5 EQT WORD 4 ADDRESS FOR DISC EQT STB A,I SET UP ENTRY IN EQTBL FOR DISC JSB CLRSC CLEAR SC IN INTERRUPT TABLE &TRAP CELL LDA ARSTB ADDRESS OF RSTBL JSB RSENT MAKE ENTRIES IN RESTORE TABLE LDA SVTBL+4 DISC HAS TWO SELECT CODES? CPA N1 ENTRY MADE IN SVTBL? JMP CONSL NO, THEN CONFIGURE CONSOLE SC ISZ NEWSC YES ISZ OLDSC JSB JNENT ENTER 2ND DISC SC IN INTBL & TRPCL NOP DO NOTHING ON ERROR RETURN JSB CLRSC CLEAR SC IN INTERRUPT TABLE & TRAP CELL LDA ARSTB POINTER INTO RSTBL FOR ADA .6 SECOND DISC SC ENTRIES JSB RSENT MAKE ENTRIES IN RSTBL * CONSL LDA SWREG GET BITS 0-5 OF SWITCH REGISTER AND B77 GET CONSOLE SELECT CODE SZA,RSS 0? JMP UNBCN YES, CONSOLE SC NOT CHANGED STA NEWSC NO, NEW SELECT CODE FOR CONSOLE LDA $SAVE DETERMINE DRIVER TYPE FOR CURRENT INA SYSTEM CONSOLE - POINT TO WORD 5 LDA A,I OF CURRENT SYSTEM CONSOLE EQT ALF,ALF GET EQUIPMENT TYPE CODE AND B77 INTO BITS 0-7 STA TEMP1 SAVE IT LDA N3 CONFIGURE I/O INSTR TO FIND OUT TYPE CONLP LDB ACN1,I OF CONSOLE ATTACHED TO NEW SC ADB NEWSC STB ACN1,I RESTORE INSTR ISZ ACN1 ePOINT TO NEXT INSTR INA,SZA ALL INSTR CONFIGURED? JMP CONLP NO LDB .5 LDA MRSET MASTER RESET WORD CN1 CLF 0 CN2 OTA 0 CN3 SFS 0 CLB DVR00 DRIVER CLA CPB TEMP1 IS THIS CONSOLE SAME TYPE AS CURRENT ONE CCA,RSS YES, INDICATE SO IN TEMP2 STB TEMP1 NO, THEN SAVE NEW CONSOLE TYPE STA TEMP2 0 IF DRIVER TYPES NOT SAME, -1 IF SAME * * FIND AN EQT WITH EQUIPMENT TYPE CODE MATCHING * THE NEW SELECT CODE * LDA NEWSC JSB EQTFN FIND AN EQT # WITH OLD SC SSB,RSS FOUND? JMP FNCNE YES CNEQT LDA TEMP2 NO, THEN DRIVER TYPES WERE SAME? SSA JMP CONTY YES CLA,INA NO FIND EQT WITH RIGHT DRIVER TYPE STA TEMP TEMP KEEPS COUNT OF EQT'S LOOKED AT LDB EQTA EQUIPMENT TABLE START ADB .4 POINT TO WORD 5 OF THE FIRST EQT EQTLP LDA B,I GET CONTENTS OF WORD 5 OF EQT ALF,ALF EQUIPMENT TYPE CODE INT LOW 6 BITS AND B77 CPA TEMP1 IS IT SAME AS THAT OF NEWSC? JMP FNDEQ YES,THE RIGHT EQT HAS BEEN FOUND LDA TEMP CPA EQT# ALL EQT'S DONE? JMP EQERR YES, THEN ERROR ISZ TEMP NO, POINT TO NEXT EQT'S WORD 5 ADB .15 JMP EQTLP * FNCNE LDA TEMP5 EQT#-1 RETURNED BY EQTFN INA EQT# STA TEMP SAVE IT INB POINT TO WORD 5 OF EQT LDA B,I GET CONTENTS OF WORD 5 OF EQT ALF,ALF AND B77 GET EQUIPMENT TYPE CODE CPA TEMP1 IS IT SAME AS THAT OF NEW CONSOLE? JMP FNDEQ YES, THEN FOUND THE RIGHT EQT JMP CNEQT NO, THEN FIND EQT * EQERR HLT 55B HALT SYSTEM JMP *-1 * CONTY LDB $SAVE DRIVER TYPE SAME FOR JMP EQTTY OLD AND NEW SYSTEM CONSOLE * UNBCN LDB $SAVE UNBUFFER CONSOLE EQT JSB EQUNB LDA TEMP2 STA $SAVE+9 JMP STRCN * * * * CLRSC - ROUTINE TO CLEAR INTERRUPT TABLE ENTRY FOR OLDSC * AND TO INSERT A JSB $CIC,I INSTR IN CORRESPONDING * TRAP CELL ENTRY * CALLING SEQUENCE: JSB CLRSC * * CLRSC NOP LDA OLDSC CPA SVTBL IS OLDSC SAME AS NEW DISC SC #1? JMP CLRSC,I YES, THEN RETURN CPA SVTBL+4 IS OLDSC SAME AS NEW DISC SC #2? JMP CLRSC,I YES, RETURN LDA JSBCI JSB $CIC,I INSTR STA OLDSC,I IN TRAP CELL ENTRY FOR OLD SC LDA INTBA INTERRUPT TABLE ADDRESS ADA N6 ADA OLDSC POINTER INTO THE INTERRUPT TABLE CLB CLEAR ENTRY FOR OLD SC IN INTERRUPT TABLE STB A,I JMP CLRSC,I RETURN * * * EQT HAS BEEN FOUND, CHANGE EQT# IN DRT ENTRY FOR * LU1 - THE SYSTEM CONSOLE AND IN BASE PAGE LOC SYSTY * FNDEQ LDA DRT,I GET LU1 ENTRY IN DRT AND B1777 CLEAR EQT# ADA TEMP ADD NEQ EQT# STA DRT,I RESTORE THE DRT ENTRY ADB N1 POINT TO WORD 4 OF NEW EQT ADDRESS STB $SAVE SAVE IS WHERE SYSTY+4 IS SAVED EQTTY LDA B,I GET CONTENTS OF WORD 4 OF EQT AND B77 STA OLDSC OLD SC # FOR CONSOLE JSB EQUNB UNBUFFER EQT LDB TEMP2 SAVE BUFFERED/UNBUFFERED STATUS STB $SAVE+9 LDA ASVTB POINT TO ENTRY IN ADA .8 SVTBL FOR SYSTEM CONSOLE JSB SVENT ENTER NEW SC IN SVTBL JSB JNENT ENTER NEW & OLD SC IN INTBL & TRPCL NOP DO NOTHING ON ERROR RETURN CCA SET FLAG TO INDICATE DO NOT CLEAR STA NOCLR CURRENT EQT'S FOR NEW SC LDA OLDSC GET OLD SELECT CODE # JSB IPROC CONFIGURE INTRPT TBL & TRAP CELL LDA NEWSC NEW SELECT CODE JSB IPROC CONFIGURE NEW SELECT CODE LDA ARSTB POINTER INTO RSTBL FOR CONSOLE SC ADA .12 JSB RSENT MAKE ENTRIES IN RSTBL FOR CONSOLE SC CLA CLEAR FLAG STA NOCLR  LDB RSTBL+17 EQT WORD 4 ADDRESS OF CONSOLE ADB N3 POINT TO FIRST WORD OF CONSOLE EQT STA B,I CLEAR THIS WORD * STRCN LDB .11 JSB WRTTY DEF MSG0 START RECONFIGURATION * CONFIGURE LIST DEVICE SELECT CODE * LSTDV LDB .8 JSB QUERY ASK FOR DEF MSG1 LIST DEVICE LU? LSTLU LDA PRSBF GET FIRST WORD OF PARSE BUFFER TRTMP SZA,RSS NULL? JMP LUDFL YES, THEN DEFAULT LU# SAVPG LDB APRSB ADDRESS OF PARSE BUFFER SVPG1 LDA LUMAX UPPER LIMIT FOR LU# STA MXLU# CLA,INA LOWER LIMIT FOR LU# JSB TST# TEST LU# MXLU# NOP JMP LUERR RSS LUDFL INA YES, THEN DEFAULT LU IS 1 STA LSTLU LIST DEVICE LU# * * LIST DEVICE SELECT CODE # * CCB LDA LSTLU CPA .1 SAME AS CONSOLE LU? JMP ECHO2 YES, DO NOT ASK FOR SELECT CODE# LDA LSTLU GET EQT# FOR LIST DEVICE LU ADA N1 ADA DRT ADDRESS OF DRT TABLE LDA A,I GET CONTENTS AND B77 LIST DEVICE EQT# IN A REG SZA,RSS BIT BUCKET? JMP LUERR YES ADA N1 MPY .15 GET EQT ADDRESS ADA EQTA ADA .3 POINT TO WORD 4 OF LIST DEV EQT STA $SAVE+8 SAVE ADDR OF WORD 4 OF LIST DEV EQT LULST LDB .13 JSB QUERY DEF MSG2 LIST DEVICE SELECT CODE #? LDA PRSBF FIRST WORD OF PARSE BUFFER SZA,RSS 0? JMP ECHOQ YES,NO CHANGE IN LIST DEV CHNL LDB APRSB ADDRESS OF PARSE BUFFER JSB TSTCH TEST VALIDITY OF LIST DEVICE SELECT CODE# JMP LULST SELECT CODE # NOT VALID STA NEWSC NEW SELECT CODE # FOR LIST DEVICE LDB $SAVE+8 ADDR OF WORD 4 OF LIST DEV EQT LDA B,I GET CONTENTS OF LIST DEV EQT WORD 4 AND B77 MASK SC # STA OLDSC OLD SC # FOR LIST DEVICE JSB EQUNB UNBUFFER LIST DEVICE EQT LDA TE0cMP2 STA $SAVE+10 LDA ASVTB ADDRESS OF SVTBL ADA .12 POINT TO LIST DEVICE ENTRIES JSB SVENT MAKE NEWSC ENTRY IN SVTBL JSB JNENT INTBL AND TRPCL ENTRIES NOP DO NOTHING ON ERROR RETURN CCA SET FLAG TO INDICATE DO NOT CLEAR STA NOCLR SC # FROM CURRENT NEWSC EQT'S LDA OLDSC ENTRY IN INTERRPT TABLE AND JSB IPROC AND TRAP CELL FOR OLD SELECT CODE LDA NEWSC AND NEW SELECT CODE FOR LIST DEVICE JSB IPROC LDA ARSTB POINTER INTO RSTBL FOR ADA .18 LIST DEVICE JSB RSENT MAKE ENTRIES IN RSTBL FOR LIST DEVICE CLA STA NOCLR RESET FLAG LDB RSTBL+23 GET EQT WORD 4 ADDR FOR LIST DEV ADB N3 POINT TO FIRST WORD OF LIST DEV EQT STA B,I CLEAR THE WORD * * ECHOQ LDB .7 JSB QUERY ECHO?(YES/NO) DEF MSG3 LDA PRSBF PARSE BUFFER CPA .1 NUMERIC VALUE? JMP ECHOQ YES, THEN ASK AGAIN CCB LDA PRSBF+1 FIRST TWO CHARACTERS CPA NO NO? JMP ECHO2 ECHO NOT REQUIRED? CPA YE YES? RSS JMP ECHOQ ERRONEOUS REPLY, ASK AGAIN ECHO CLB ECHO2 STB ECHO ECHO=0 ECHO WANTED,-1 ECHO NOT WANTED * * * PRINT A LIST OF CURRENT I/O CONFIGURATION * STIO DLD .ENT SET UP MESSAGE DST MSG4+2 LDB .13 JSB WRLST DEF MSG4 CURRENT I/O CONFIGURATION: JSB PRNIO * * WANT I/O CONFIGURATION? * WNTIO LDB .14 JSB QUERY DEF MSG9 I/O RECONFIGURATION?(YES/NO) LDA PRSBF+1 CPA NO CNTRP JMP MEMCN I/O CONFIG NOT REQIURED CNINT CPA YE LSTRP RSS LSINT JMP WNTIO ASK QUES AGAIN * * I/O RECONFIGURATION IS DESIRED * IOCN2 LDB .25 JSB WRTTY DEF MSG10 CURRENT SELECT CODE#,NEW SELECT CODE#?(/E TO END) IOCN3 CLB,INB JSB QUERY DEF HYPHN HYPHEN (-) PROMPT t LDA PRSBF CPA .2 ASCII? JMP ENDIO CHECK IF END OF LIST LDB APRSB ADDRESS OF PARSE BUFFER JSB TSTCH TEST SELECT CODE VALIDITY JMP IOCN3 NOT VALID ASK AGAIN STA OLDSC OLD SELECT CODE LDA PRSBF+4 SECOND PARAMETER ASCII? CPA .2 RSS YES, CHECK IF IT IS PR JMP NEWCH NO, TEST NEW CHANNEL # LDA PRSBF+5 CPA PI PRIVILEGED I/O CARD TO BE ADDED? RSS YES JMP IOERR NO, THEN ERROR LDA OLDSC OLD SELECT CODE VALUE JSB CHKSC NEW SC VALUE FOR DISC,CONSOLE OR LIST? JMP ERR3 YES, THEN CONFIG ERR 3 LDA OLDSC NO, GET OLDSC # STA $SAVE+5 SET UP DUMMY WORD ON BASE PAGE ADA NB10 ADA AINTB POINT INTO INTBL CLB STB A,I CLEAR THE INTBL ENTRY FOR OLDSC LDA OLDSC CPA TBG TBG CHANNEL? STB TBG YES, CLEAR TBG WORD ON BASE PAGE ADA NB10 ADA ATRPC POINT INTO TRPCL TABLE LDB JSBCI INSERT JSB $CIC,I INSTR IN STB A,I TRPCL ENTRY FOR OLDSC LDA OLDSC ADA NB10 CAX SAVE A REG VALUE ADA AOLSC POINT TO OLD SC TABLE JSB PRVOL RESTORE PREV OLDSC IF NECESSARY CXA GET OLDSC - 10B ADA AOLSC POINT TO OLDSC ENTRY IN OLSTB CCB STB A,I NO OLDSC ASSIGNED CXA GET OLDSC -10B ADA AEQTB EQT TBL STB A,I ENTRY TO -1 JMP IOCN3 ASK FOR MORE * NEWCH LDB APRSB ADB .4 POINT TO VALUES FOR NEW SC LDA B IF THE NEW SELECT CODE # IS 0 INA DO NOT GO THRU TSTCH ROUTINE LDA A,I SZA JMP TSTNS NOT 0 THEN TEST NEW SELEC CODE LDB OLDSC GET OLD SELECT CODE # CPB PRVSV IS IT A PRIV I/O CARD? JMP STNWS YES, THEN 0 FOR NEWSC IS VALID JMP IOERR NO, THEN ERROR TSUNLHTNS JSB TSTCH TEST SELECT CODE VALIDITY JMP IOCN3 NOT VALID ASK AGAIN STNWS STA NEWSC NEW SELECT CODE JSB INENT ENTER IN INTBL AND TRPCL JMP ERR3 GIVE CONFIG ERR 3 JMP IOCN3 ASK FOR MORE * ENDIO LDA PRSBF+1 /E ? CPA /E JMP IOCN7 CPA /R RESTART? JMP RSTRT * IOERR LDA A2 INVALID SELECT CODE # RSS ERR3 LDA A3 JSB ERROR JMP IOCN3 * LUERR LDA A1 JSB ERROR INVALID LIST DEVICE LU # JMP LSTDV * MSG0 ASC 11,START RECONFIGURATION MSG1 ASC 8,LIST DEVICE LU#? MSG2 ASC 13,LIST DEVICE SELECT CODE#? MSG3 ASC 7,ECHO?(YES/NO) * NOCLR NOP INTBL EQU TRPCL+56 EQTBL EQU INTBL+56 RDBUF EQU EQTBL+56 PRSBF EQU RDBUF+80 AINTB DEF INTBL $ABDP DEF INTBL ARSTB DEF RSTBL .11 DEC 11 .18 DEC 18 .ENT ASC 2,ENT .25 DEC 25 A1 ASC 1,1 A2 ASC 1,2 A3 ASC 1,3 AEQTB DEF EQTBL PI ASC 1,PI * RSTRT CCA INITIALIZE TABLES FOR I/O LDB .168 RE-CONFIGURATION TO -1 JSB SETM NATRPC DEF TRPCL CCA LDB B70 SET OLDSC TABLE TO -1 JSB SETM AOLSC DEF OLSTB * LDA TBGSV CHANGE TBG VALUE TO THE NEW SC JSB CHKSC IS IT NEW SC FOR DISC,CONSOLE OR LIST? CLA,RSS YES, THEN CLEAR TBG LDA TBGSV NO STA TBG LDA PRVSV CHANGE PRIV I/O VALUE TO NEW SC JSB CHKSC IS IT NEW SC FOR DISC,CONSOLE OR LIST? CLA,RSS YES LDA PRVSV NO STA $SAVE+5 CLB STB TEMP2 LDA ARSTB ADDRESS OF RESTORE TABLE STA TEMP USE TEMP AS POINTER RSLP LDB TEMP,I OLD SELECT CODE # SSB ENTRY MADE? JMP SKPRS NO, THEN NOTHING TO RESTORE STB OLDSC ADB NB10 RESTORE OLD SC VALUES IN INTBL AND TRPCL JSB RESTR LDB ASVTB ADDRESS OF SAVE TABLE ADB TEMP2 INDEX INTO IT LDB B,I GET NEW SC # ADB NB10 CBX SAVE FOR NOW ADB AOLSC POINT INTO OLDSC TABLE LDA OLDSC STA B,I RESTORE OLDSC VALUE CXB RESTORE B REG VALUE CAX JSB RESTR RESTORE NEW SC VALUES IN TRPCL &INTBL ISZ TEMP CXA ADA AEQTB RESTORE EQT WORD 4 ADDRESS ADA NB10 LDB TEMP,I STB A,I ISZ TEMP RSLPE LDA TEMP2 ALL ENTRIES IN SVTBL RESTORED? CPA .12 JMP IOCN2 YES RESTART I/O CONFIGURATION ADA .4 NO, POINT TO NEXT SET OF ENTRIES STA TEMP2 JMP RSLP SKPRS LDA TEMP * ADA .6 POINT TO NEXT SET OF ENTRIES IN RSTBL STA TEMP JMP RSLPE * MSG9 ASC 14,I/O RECONFIGURATION?(YES/NO) MEM ASC 2,MEM NEW ASC 2,NEW HYPHN ASC 1,- /R ASC 1,/R /E ASC 1,/E N2 DEC -2 B70 OCT 70 #WRDS ABS EQTBL+56-SVTBL LENGTH OF ALL IO TABLES .20 DEC 20 CONSC EQU SVTBL+8 LSTSC EQU SVTBL+12 * IOCN7 LDA INTLG GET LENGTH OF INTERRPUT TABLE ADA N2 CMA,INA STA TEMPFY2 USE AS -VE COUNTER LDA B10 FIRST SELECT CODE VALUE STA TEMP3 IOLP1 CPA CONSC NEW CONSOLE SELECT CODE? JMP ENIOL YES,DO NOT CHANGE CONSOLE SELECT CODE VALUE CPA LSTSC NEW LIST DEVICE SELECT CODE? JMP ENIOL YES, DO NOT CHANGE IT JSB IPROC TRANSFER INTBL AND TRPCL VALUES RSS ENIOL JSB JPROC CLEAR NEWSC'S PREV EQT'S IF NOT ASSIGNED ISZ TEMP3 TO INTRPT TABLE AND TRAP CELL LDA TEMP3 ISZ TEMP2 INCREMENT COUNTER JMP IOLP1 LDA EQT# # OF EQT'S DEFINED CMA,INA USE AS COUNTER STA TEMP5 LDA EQTA ADDRESS OF START OF EQT TABLES CLB CLREQ STB A,I CLEAR FIRST WORD OF ALL EQT'S ADA .15 ISZ TEMP5 JMP CLREQ * DLD NEW SET UP MESSAGE DST MSG4+2 LDB .11 PRTMP JSB WRLST NEW I/O CONFIGURATION DEF MSG4+2 PRTM2 JSB PRNIO PRINT NEW I/O CONFIGURATION * * PERMQ LDB .20 JSB QUERY NEW I/O CONFIGURATION PERMANENT?(YES/NO) DEF MSG12 LDA PRSBF+1 CPA NO RESPONSE IS NO? JMP MEMCN YES, THEN MEMORY CONFIGURATION CPA YE JMP PRMIO MAKE I/O CONFIG PERMANENT CPA /R RESTART I/O CONFIGURATION? RSS YES JMP PERMQ ERROR IN RESPONSE CCA INITIALIZE ALL I/O RE-CONFIGURATION LDB #WRDS TABLES TO -1 JSB SETM ASVTB DEF SVTBL CCA LDB B70 JSB SETM SET OLD SC TABLE TO -1 DEF OLSTB LDA TBG TBG CHANNEL STA TBGSV LDA $SAVE+5 STA PRVSV JMP STIO START I/O RE-CONFIGURATION * * PRMIO LDA CONSC NEW SELECT CODE FOR CONSOLE SSA DEFINED? JMP CHKLS NO ADA INTBA YES, THEN SAVE ITS CURRENT INTERRUPT TABLE ADA N6 CONTENTS LDB A,I TO BE DONE BECAUSE A DRIVER CAN CHANGE STB CNINT CAN CHANGE I|NTERRUPT TABLE ENTRIES LDB RSTBL+15 GET CONTENTS OF ORIGINAL VALUE IN INTERRUPT STB A,I TABLE FOR THE CONSOLE SELECT CODE LDB CONSC,I GET CONTENTS OF CURRENT VALUE OF TRAP CELL STB CNTRP SAVE THIS VALUE LDB RSTBL+16 ORIGINAL TRAP CELL VALUE FOR STB CONSC,I THE CONSOLE SELECT CODE CHKLS LDA LSTSC LIST DEVICE SELECT CODE SSA DEFINED? JMP PRCNT NO,CONTINUE TO MAKE I/O CONFIG PERM ADA INTBA GET INTERRUPT TABLE VALUE CURRENTLY ADA N6 ASSIGNED TO LIST DEVICE SELECT CODE LDB A,I STB LSINT SAVE THIS VALUE LDB RSTBL+21 GET ORIGINAL INTERRUPT TABLE STB A,I VALUE FOR LIST DEVICE LDB LSTSC,I GET CURRENT TRAP CELL VALUE FOR STB LSTRP LIST DEVICE --- SAVE IT LDB RSTBL+22 GET ORIGINAL TRAP CELL VALUE FOR STB LSTSC,I FOR LIST DEVICE * PRCNT LDA INTBA ADDRESS OF INTERRUPT TABLE LDB INTLG LENGTH OF INTERRUPT TABLE JSB $TRTB WRITE INTERRUPT TABLE ON DISC LDA B10 WRITE TRAP CELLS ON DISC - SET UP FOR LDB B70 ENTERING $TRTB AT TRPTB ENTRY POINT DST TRTMP SAVE START ADDR AND LENGTH OF TRAP CELLS LDA .2 STA TEMP2 SECTOR # CLA STA TEMP1 TRACK# LDA B10 # OF WORDS OFFSET INTO THE SECTOR STA #OFST JSB TRPTB TRANSFER TRAP CELLS TO DISC LDA CONSC NEW SELECT CODE FOR CONSOLE SSA DEFINED? JMP RSTLS NO LDB CNTRP GET SAVED VALUE OF TRAP CELLS FOR STB CONSC,I CONSOLE SELECT CODE ADA INTBA ADA N6 LDB CNINT RESTORE CURRENT VALUE OF INTERRUPT TABLE STB A,I RSTLS LDA LSTSC SSA NEW LIST DEVICE SELECT CODE EFINED? JMP PREQT NO,MAKE EQT WORD 4'S PERMANENT LDB LSTRP RESTORE CONTENTS OF LIST DEVICE STB LSTSC,I TRAP CELL ADA INTBA ADA N6 LDB TLSINT RESTORE CONTENTS OF LIST DEVICE STB A,I INTERRUPT TABLE ENTRY * PREQT JSB BUFFR BUFFER CONSOLE AND LIST DEVICE EQT'S CLA STA PRTM2 USE AS COUNTER LDA EQTA START ADDRESS OF EQT TABLES ADA .3 POINT TO WORD 4 OF FIRST EQT STA TEMP3 PREQL CLB JSB $TREN TRANSFER EQT WORD 4 TO DISC ISZ PRTM2 LDA PRTM2 CPA EQT# JMP UNBFR DONE LDA TEMP3 ADA .15 STA TEMP3 POINT TO WORD 4 OF NEXT EQT JMP PREQL UNBFR LDA $SAVE+9 CONSOLE EQT WAS BUFFERED? SZA,RSS JMP LSUNB NO LDA PRTMP YES, RESTORE UNBUFFERED WORD STA $SAVE,I LSUNB LDA $SAVE+10 LIST DEVICE EQT WAS BUFFERED? SZA,RSS JMP PRDRT NO LDA PRTMP+1 RESTORE UNBUFFER STATUS STA $SAVE+8,I * PRDRT LDA DRT ADDRESS OF DRT ENTRY FOR SYSTEM CONSOLE SC CLB MAKE IT PERMANENT JSB $TREN * * LDA .16 SECTOR 16 HAS TO BE CHANGED LDB B74 # OF WORDS OFFSET STB #OFST SET UP FOR TRWRD ROUTINE LDB TBG GET CONTENTS OF TBG WORD FROM BASE PAGE JSB TRWRD TRANSFER IT TO DISC LDA .16 SYSTY WORD ON BASE PAGE TO BE TRANSFERRED LDB B75 # OF WORDS OFFSET STB #OFST SET UP FOR TRWRD ROUTINE LDB $SAVE CONTENTS OF SYSTY (+3) ARE IN $SAVE ADB N3 POINT TO START OF CONSOLE EQT JSB TRWRD TRANSFER WORD TO DISC LDA .17 TRANSFER PRIVILEGED I/O CARD ADDRESS LDB B37 WORD - DUMMY TO DISC STB #OFST LDB $SAVE+5 CONTENTS OF WORD ON BASE PAGE JSB TRWRD * * I/O CONFIGURATION COMPLETED * * MEMORY RE-CONFIGURATION * MEMCN LDB $MNP MAX # OF PARTITIONS ALLOWED BDTMP CMB,INB STB TEMP USE AS COUNTER LDB $MATA GET STARTITNG ADDRESS OF MAT ENTRIES MATLP LDA B,I GET CONTENTS OF FIRST WORD OF THIS ENTRY SSA -1? JMP BCKUP YES, BACKUP TO FIND # PAGES IN MEM ADB .7 NO ISZ TEMP ALL PARTITIONS CHECKED? JMP MATLP NO, IS NEXT ENTRY THE LAST ONE? BCKUP ADB N1 GET CONTENTS OF LAST WORD LDA B,I OF PREVIOUS MAT ENTRY SZA,RSS 0? JMP FOUND YES, THEN NOT A SUBPARTITION ADB N3 POINT TO WORD 3 OF PREVIOUS MAT ENTRY LDA B,I SSA IS IT A MOTHER PARTITION? JMP MFND YES ADB N4 POINT TO LAST ENTRY OF PREV PARTN JMP BCKUP+1 * FOUND ADB N3 POINT TO WORD 3 OF THIS MAT ENTRY MFND LDA B,I GET VALUE AND BIT09 MASK # OF PAGES IN PART'N CAX SVE THIS VALUE INB LDA B,I GET WORD 4 OF THE MAT ENTRY AND BIT09 MASK # PAGES IN PARTITION CXB ADA B CCE,INA CONVERT #PAGES IN PHYSICAL MEM TO ASCII JSB $CNV3 INA DLD A,I GET ASCII VALUE FOR LEAST 4 DIGITS DST MSG23+14 SET UP MESSAGE LDB .19 JSB WRLST CURRENT PHYSICAL MEM SIZE: XXXX PAGES DEF MSG23 * DLD MEM SET UP MESSAGE DST MSG9 MEMC0 LDB .14 MESSAGE LENGTH JSB QUERY DEF MSG9 MEM RECONFIGURATION?(YES/NO) LDA PRSBF+1 CPA NO NO? JMP $EXIT RETURN CONTROL TO SYSTEM CPA YE RSS MEM RECONFIGURATION WANTED JMP MEMC0 ERROR IN RESPONSE * $NPGQ LDB .13 JSB QUERY DEF MSG21 PHSICAL MEM SIZE?(#PAGES) LDA .48 LOWER BOUNDS IS 48 PAGES LDB APRSB ADDRESS OF PARSE BUFFER JSB TST# TEST VALIDITY OF RESPONSE .1024 DEC 1024 UPPER LIMIT JMP NPGSE ERROR IN RESPONSE STA MEMSZ SAVE MEM SIZE ADA N1 GET LAST PAGE # IN MEMORY STA LASTP LDA $SBTB+1 # PAGES IN DRIVER PARTITION ADA $SBTB+5 # OF PAGES IN MEM RES PART'N Q INA # PAGES IN MEM RES BASE PAGE ADA $ENDS # PAGES IN SYSTEM UPTO SAM DEFAULT STA $USRS START OF SAM EXTENSION CCE CONVERT PAGE# TO ASCII DECIMAL JSB $CNV3 INA DLD A,I GET LAST 4 DIGITS DST MSG22+17 BDPAG LDB .25 JSB WRTTY DEFINE BAD PAGES BEGINING AT PAGE XXXX ( E TO END) DEF MSG22 LDA N100 MAX # OF BAD PAGES ALLOWED STA BDTMP USE AS COUNTER LDA $ABDP START OF BAD PAGE LIST ADA N1 MINUS ONE STA TEMP1 TEMP1 WILL BE THE POINTER LDB $USRS INITIALIZE LIST OF BAD PAGES TO ADB N1 LAST PAGE OF MEMORY RESIDENT PROGRAMS STB TEMP1,I BDPGQ CLB,INB WORD COUNT JSB QUERY SEND HYPHEN PROMPT DEF HYPHN LDA PRSBF+1 RESPONSE IS /E? CPA /E JMP ENBDP YES, THEN END BAD PAGE LIST CPA /R RESTART ENTRIES FOR BAD PAGES? JMP BDPAG YES LDA TEMP1,I LOWER LIMIT FOR A BAD PAGE # INA IS PREVIOUS BAD PG# + 1 LDB APRSB POINTER TO BAD PAGE # IN PARSE BUF JSB TST# TEST VALIDITY OF BADE PAGE # LASTP NOP LAST PAGE # IN MEMORY JMP BDPGE BAD PAGE ERROR ISZ TEMP1 INCREMENT POINTER STA TEMP1,I SAVE THE BAD PAGE # IN LIST ISZ BDTMP INCREMENT COUNTER JMP BDPGQ PROMPT FOR NEXT BAD PG # JMP ENBDP 100 PAGES ENTERED DONE * BDPGE LDA A11 BAD PAGE ERROR JSB ERROR JMP BDPGQ * NPGSE LDA A10 # OF PAGES IN MEM ERROR JSB ERROR JMP $NPGQ * MEMSZ NOP MSG22 ASC 25,DEFINE BAD PAGES BEGINNING AT PAGEXXXX (/E TO END) MSG23 ASC 19,CURRENT PHYSICAL MEM SIZE: XXXX PAGES .48 DEC 48 N100 DEC -100 .17 DEC 17 .19 DEC 19 BIT09 OCT 1777 A10 ASC 1,10 A11 ASC 1,11 * ENBDP CCA -1 TO INDICATE END OF BAD PAGE LIST ISZ TEMP1 INCREMENT POINTER STA TEMP1,I * *  LDA $USRS SAVE START OF SAM EXT PAGE LDB $ABDP SAVE POINTER TO BAD PAGE LIST DST SAVPG POINTER INTO BAD PAGE LIST CHNKL CLA A REG = 0 TO INDICATE CALL FROM SYSTEM MAP JSB $PCHN GET THE NEXT CHUNK OF GOOD PAGES SZA,RSS 0? JMP ABORT YES,THEN NO SPACE TO LOAD $CNFGX CPA .2 NO, 2 PAGES LONG? RSS YES,CANNOT USE IT, LOOK FOR NEXT CHUNK JMP FCHNK THIS CHUNK IS > 2 PAGES GOOD ENOUGH LDA $ABDP,I GET CURRENT BAD PAGE SSA ALL BAD PAGES USED UP? JMP ABORT YES, THEN HLT 22 INA STA $USRS TRY WITH THIS USER START PAGE JMP CHNKL FIND ANOTHER CHUNK OF MEMORY * FCHNK LDA $PLP LOAD POINT FOR PRIVILEGED PROGRAMS ALF RAL,RAL AND B37 # OF PAGES BEFORE LOAD POINT ADA N1 CAX USE AS COUNTER TO LOAD PAGES LDA B41 START LOGICAL PAGE FOR TABLE AREA I THRU SDA CLB,INB PHYSICAL PAGE # TO BE LOADED XMS LDB .2 # OF PAGES FOR USER AREA CBX USE AS COUNTER LDB $USRS INB B REG HAS PHYSICAL PAGE XMS TO LOAD USER AREA CLA,INA CAX COUNTER TO LOAD BASE PAGE LDA B40 LOGICAL START PAGE LDB $USRS XMS LDB CNXID GET ID SEG ADDRESS FOR $CNFX SZB,RSS PRESENT? JMP ABORT NO, THEN ABORT CONFIGURATOR ADB .14 POINT TO TYPE WORD IN ID SEG LDA B,I GET CONTENTS AND B37 MASK TYPE OF PROGRAM CPA .3 IS IT A BACKGROUND DISC RESIDENT PROG? RSS YES JMP ABORT NO, THEN ABORT CONFIGURATOR ADB .8 GET WORD 23 OF ID SEGMENT LDA B,I GET CONTENTS STA TEMP3 LOW MAIN ADDRESS CMA,INA INB POINT TO WORD 24 OF ID SEG ADA B,I HIGH MAIN +1 - LOW MAIN STA TEMP SAVE # OF WORDS TO BE LOADED FOR MAIN ADB .3 POINT TO WORD 27 OF ID SEGMENT LDA B,I DISC ADDRESS OF MAIN PROGRAM JSB DSCAD SET UP TRACK & SECTOR #'S FOR SETUP JSB LOAD LDB CNXID ADDRESS OF THE ID SEGMENT ADB .24 POINT TO LOW BASE PAGE ADDR LDA B,I STA TEMP3 CMA,INA INB POINT TO HIGH BASE PAGE ADDR + 1 ADA B,I # OF WORDS IN BASE PAGE STA TEMP SAVE FOR SETUP ROUTINE LDA PRMAR ADDRESS OF LAST TRIPLET JSB NXTAD FIND NEXT DISC ADDRESS LDA TEMP2 GET NEW SECTOR # SLA EVEN #? INA NO, THEN MAKE IT EVEN CPA SECT2 ALL SECTORS ON TRACK TRANSFERRED? RSS YES JMP SETSC NO ISZ TEMP1 INCREMENT TRACK ADDRESS CLA SET SECTOR ADDRESS TO 0 SETSC STA TEMP2 NEW SECTOR ADDRESS JSB LOAD DLD SAVPG RESTORE SAVED VALUES STA $USRS FOR USER PART'N START PAGE STB $ABDP AND BAD PAGE POINTER LDA MEMSZ PASS MEMORY SIZE TO $CNFX STA $PCHN LDA LSTLU PASS LIST DEVICE LU$# TO $CNFX STA $WRRD LDA ECHO STA $TRTB PASS ECHO FLAG TO $CNFX CLA,INA SET THE BASE PAGE FENCE ADA BPA2 LWA OF USER BASE PAGE LINKS IOR BIT10 LFA LDB CNXID GET PRIMARY ENTRY POINT FOR $CNFX ADB .7 LDB B,I UJP B,I ENABLE USER MAP AND JUMP TO $CNFX * * CNXID NOP .24 DEC 24 BIT10 OCT 2000 B63 OCT 63 $SMTB NOP NOP NOP NOP NOP NOP NOP NOP NOP NOP E$SMT DEF *-1 A$SMT DEF $SMTB * ABORT HLT 22B HALT SYSTEM JMP *-1 * $EXIT LDA $GDPG MEMORY RE-CONFIGURATION WAS SSA,RSS MADE PERMANENT? JMP EXIT2 NO, RESET SYTEM MAP FOR SAM EXT LDA .16 YES, MAKE EQT4 WORD ON BASE PAGE LDB B63 R PERMANENT STB #OFST # OF WORDS OFFSET INTO SECTOR 16 LDB $SAVE+4 CONTENTS JSB TRWRD JMP EXIT5 * EXIT2 LDA $SMTB+2 SYSTEM MAP NEEDS TO BE SZA,RSS RESET FOR SAM EXTENSION? JMP EXIT5 NO LDB A$SMT YES, POINTER TO $SMTB STB TEMP LDA $ENDS LOGICAL START PAGE OF SAM EXTENSION SMELP LDB TEMP,I PHYSICAL START PG OF A CHUNK OF SAM EXT SZB,RSS DEFINED? JMP EXIT5 NO, THEN DONE ADB BIT14 WRITE PROTECT SAM EXTENSION ISZ TEMP YES,POINT TO #PGS IN THIS CHUNK OF SAM EXT LDX TEMP,I COUNTER IN X REG XMS TRANSFER SEQUENTIALLY TO DMS REGISTERS LDB E$SMT POINTER TO END OF $SMTB CPB TEMP AT THE END OF THE TABLE? JMP EXIT5 YES, THEN DONE ISZ TEMP NO, THEN SET UP NEXT CHUNK OF SAM EXT JMP SMELP * EXIT5 LDB CNXID ID SEG ADDR OF $CNFX SZB,RSS PRESENT? JMP EXIT1 NO LDA COMMA YES, CHANGE NAME TO ,,,,, ADB .12 STA B,I INB STA B,I INB LDA B,I GET CONTENTS OF NAME 5 WORD AND B377 MASK LOWER BYTE STA B,I SAVE IT LDA COMMA AND B1774 MASK UPPER BYTE ADA B,I STA B,I RESTORE 5TH CHAR OF NAME * EXIT1 LDA $SAVE RESTORE THE SAVED BASE PAGE ADA N3 POINT TO START OF CONSOLE EQT STA SYSTY DLD $SAVE+1 EQT1 AND EQT2 DST EQT1 DLD $SAVE+3 EQT3 & EQT4 DST EQT3 DLD $SAVE+12 EQT5 & EQT6 DST EQT5 CLA STA EQT7 STA EQT8 STA EQT9 STA EQT10 STA EQT11 STA EQT12 LDA $SAVE+5 DUMMY STA DUMMY LDA $SAVE+6 SKEDD STA SKEDD LDA $SAVE+7 STA $LIST JSB BUFFR BUFFER CONSOLE AND LIST DEVICE EQT'S LDA $SAVE+11 TRAP CELL CONTENTS FOR POWER FAIL STA .4,I RESTORE TRAPz CELL 4 JMP $CNFG,I RETURN CONTROL TO SYSTEM * BIT14 OCT 40000 COMMA ASC 1,,, * * * INENT - THIS PROCEDURE IS PERFORMED FOR EVERY OLD AND * NEW SELECT CODEL PAIRS. APPROPRIATE INTERRUPT TABLE * AND TRAP CELL VALUES ARE INSERTED INTO INTBL AND TRPCL * OLDSC AND EQT WORD 4 ADDRESS ARE INSERTED INTO ENTRIES * IN OLSCT AND EQTBL * * JNENT - ENTRY POINT IS USED FOR DISC , CONSOLE AND LIST * DEVICE SC CONFIGURATION * * CALLING SEQUENCE: JSB INENT * OLD AND NEW SELECT CODE VALUES ARE ASSUMED * TO BE IN OLDSC AND NEWSC RESP. * RETURN: P FOR ERROR RETURN IF OLDSC WAS ASSIGNED TO * OR NEWSC IS SC NEWSC FOR DISC,CONSOLE OR LIST DEV * SAME AS DISC , CONSOLE OR LIST DEVICE SC * * INENT NOP LDA B10 START SC # STA TEMP3 SAVE IT LDB AOLSC ADDRESS OF OLD SC TABLE OLDSL LDA B,I GET CONTENTS OF ENTRY IN OLDSC TABLE CPA OLDSC OLDSC ALREADY ASSIGNED? RSS YES JMP ENSCL NO LDA TEMP3 SC # TO WHICH OLDSC WAS ASSIGNED JSB CHKSC NEWSC FOR DISC,CONSOLE OR LIST DEV? JMP INENT,I YES, ERROR RETURN LDA NEWSC NEW SC # IS DISC ,CONSOLE OR LIST DEV? JSB CHKSC JMP INENT,I YES, ERROR RETURN LDA TEMP3 TEMP3 IS SC TO WHICH OLDSC WAS ASSIGNED ADA NB10 LDB AINTB ADB A POINT INTO INTBL FOR TEMP3 ENTRY STB TEMP1 SAVE THIS ADDRESS LDB ATRPC ADB A POINT INTO TRPCL TABLE FOR TEMP3 ENTRY STB TEMP2 SAVE IT LDA .N56 COUNTER FOR OLD SC TABLE STA TEMP4 LDB AOLSC START OF OLDSC TABLE OLDS2 LDA B,I INB CPA TEMP3 HAS SC TO WHICH OLD SC WAS ASSIGNED JMP ASGND BEEN ASSIGNED TO ANOTHER SC ISZ TEMP4 NO JMP OLDS2 CCA CCB JMP INEN2 ASGND CLA YES, THEN CLEAR INTBL ENTRY [ LDB JSBCI AND JSB CIC,I IN THIS SC'S ENTRIES INEN2 STA TEMP1,I SET UP INTBL AND TRPCL ENTRIES FOR PREV SC STB TEMP2,I LDA TEMP3 POINT INTO OLD SC TABLE FOR ADA NB10 PREV ENTRY STA TEMP2 SAVE IT ADA AOLSC CCB STB A,I ERASE IT LDA AEQTB ERASE ENTRY IN EQTBL ADA TEMP2 STB A,I LDA TBGSV CPA TEMP3 WAS IT A TBG? STA TBG YES, RESET TBG LDA PRVSV PRIV I/O? CPA TEMP3 WAS IT A PRIV I/O? STA $SAVE+5 YES, RESET PRIV I/O CARD JMP INEN5 CONTINUE I/O CONFIGURATION * ENSCL ISZ TEMP3 LDA TEMP3 CPA B77 ALL OLDSC TABLE ENTRIES LOOKED AT? JMP INEN3 YES INB NO JMP OLDSL * INEN3 LDA NEWSC JSB CHKSC NEW SC # THAT OF DISC,CONSOLE OR LISTDEV? JMP INENT,I ERROR JMP INEN5 * JNENT NOP ENTRY POINT FOR DISC,CONSOLE AND LIST DEVICE LDA JNENT STA INENT INEN5 CLB LDA NEWSC NEW SELECT CODE # CPA TBG IS NEW SELECT CODE TBG CHANNEL? STB TBG YES CPA $SAVE+5 IS NEW SELECT CODE PRV CHANNEL? STB $SAVE+5 YES, CLEAR IT LDB OLDSC OLD SELECT CODE # CPB TBGSV IS THE OLD SELECT CODE TBG CHANNEL? STA TBG YES, THEN RESET TBG CHANNEL CPB PRVSV IS THE OLD SELECT CODE PRIV I/O CHANNEL? RSS YES JMP INEN7 NO SZA,RSS IS NEW SELECT CODE 0? STB NEWSC YES, SET NEW SELECT CODE TO OLDSC STA $SAVE+5 * INEN7 LDB NEWSC GET NEW SELECT CODE VALUE ADB NB10 PREPARE TO INDEX INTO INTBL AND TRPCL STB TEMP1 LDA AINTB ADDRESS OF INTBL PGSRM ADA B POINT TO NEWSC ENTRY IN INTBL STA TEMP2 SAVE IT LDA ATRPC ADA B POINT TO NEWSC ENTRY IN TRPCL STA TEMP3 SAVE POINTER $USRS LDA N4 IS OLDSC ENTRY MADE INx SVTBL? ENDSM STA TEMP TEMP IS COUNTER LDA ASVTB ADDRESS OF SVTBL SVLP LDB A,I GET VALUE CPB OLDSC OLD SELECT CODE? JMP SVTBE YES ADA .4 NO, LOOK AT NEXT ENTRY ISZ TEMP JMP SVLP * OLD SELECT CODE ENTRY IS NOT IN SVTBL NEWEN LDA OLDSC,I GET TRAP CELL ENTRY FOR OLDSC STA TEMP3,I STORE OLDSC VALUE IN NEWSC ENTRY IN TRPCL LDA INTBA INTERRUPT TABLE ENTRY FOR OLDSC ADA N6 ADA OLDSC LDA A,I STA TEMP2,I STORE OLDSC VALUE IN NEWSC ENTRY IN INTBL LDA OLDSC JSB EQTFN FIND EQT WORD 4 ADDRESS FOR OLDSC STEQT LDA AEQTB ADA TEMP1 POINTER INTO EQTBL FOR NEWSC ENTRY STB A,I STORE EQT ADDRESS IN EQTBL ENTOL LDA AOLSC ADA TEMP1 POINT TO OLDSC TABLE ENTRY FOR NEWSC CAX SAVE THIS ADDRESS JSB PRVOL RESTORE PREV OLD SC IF NECESSARY CXA RESTORE ADDRESS INTO AOLSC LDB OLDSC GET OLDSC VALUE STB A,I STORE IT * OLDEN LDB OLDSC OLD SELECT CODE ENTRY ADB NB10 LDA AINTB GET VALUE OF OLDSC IN INTBL ADA B STA TEMP2 SAVE ADDRESS LDA A,I CPA N1 HAS IT BEEN ASSIGNED A VALUE SO FAR? RSS NO JMP RINEN YES,RETURN CLA CLEAR INTBL ENTRY FOR OLDSC STA TEMP2,I LDA ATRPC ADDRESS OF TRPCL ADA B POINT TO OLDSC ENTRY IN TRPCL LDB JSBCI ENTER JSB CIC,I FOR OLD SC STB A,I IN TRPCL JMP RINEN RETURN * OLD SC ENTRY IS IN SVTBL SVTBE INA LDB A,I STB TEMP3,I NEWSC ENTRY IN TRPCL INA LDB A,I STB TEMP2,I NEWSC ENTRY IN INTBL INA LDB A,I EQT PRESENT FOR THIS SC? SSB JMP ENTOL NO JMP STEQT YES, THEN SET EQT ADDRESS * RINEN ISZ INENT GOOD RETURN JMP INENT,I * NB10 OCT -10 .N56 DEC -56 * * * CNLHHKSC - ROUTINE TO CHECK IF GIVEN SC IS SAME AS NEWSC * FOR DISC, CONSOLE OR LIST DEVICE * CALLING SEQUENCE: A REG = SC# * JSB CHKSC * RETURN: P IF SC# MATCHES NEW SC FOR ABOVE * P+1 OTHERWISE * * CHKSC NOP STA TEMP1 SAVE CLA CHKLP LDB ASVTB ADDRESS OF SVTBL ADB A LDB B,I CPB TEMP1 MATCHES? JMP CHKSC,I YES ADA .4 CPA .16 ALL DONE? RSS YES, NO MATCH JMP CHKLP ISZ CHKSC JMP CHKSC,I RETURN TO P+1 * * * EQTFN - THIS ROUTINE FINDS ADDRESS OF WORD 4 OF * EQT BELONGING TO SELECT CODE VALUE IN OLDSC * EQT # - 1 IS ALSO RETURNED * * CALLING SEQUENCE: A REG = SC # * JSB EQTFN * RETURNS: B REG = ADDR OF EQT WORD 4 IF EQT PRESENT * = -1 IF EQT NOT FOUND * TEMP5 = EQT # - 1 (VALID ONLY IF EQT FOUND) * * EQTFN NOP STA TEMP6 CLA STA TEMP5 COUNTER TO FIND THE RIGHT EQT c&N LDB EQTA ADDRESS OF EQT ADB .3 POINT TO WORD 4 OF EQT LPEQT LDA B,I GET CONTENTS OF WORD 4 AND B77 MASK SELECT CODE # CPA TEMP6 IS IT SAME AS OLDSC JMP EQTFN,I YES, THEN RETURN ISZ TEMP5 NO LDA TEMP5 CPA EQT# ALL EQT'S LOOKED AT? JMP EXEQT YES ADB .15 NO,POINT TO WORD 4 OF NEXT EQT JMP LPEQT * EXEQT CCB EQT NOT FOUND JMP EQTFN,I RETURN * * * PRVOL - ROUTINE CHECKS IF THIS NEWSC WAS ASSIGNED * A SELECT CODE PREVIOUSLY. IF SO, CHECK IF THIS * PREVIOUS SELECT CODE WAS ASSIGNED A NEW VALUE * IF NO VALUE WAS ASSIGNED DO NOT DESTROY ITS ORIGINAL * VALUE * FOR EG. 12,10 * 13,10 * THEN 12 SHOULD NOT BE DESTROYED * * CALLING SEQUENCE: A REG = POINTER INTO OLSCT FOR NEWSC ENTRY * JSB PRVOL * * PRVOL NOP LDB A,I WAS NEWSC PREVIOUSLY ASSIGNED ANOTHER SC? CPB N1 JMP PRVOL,I NO, THEN RETURN ADB NB10 YES CBY ADB AOLSC LDA B,I CPA N1 DOES IT HAVE AN ASSIGNMENT MADE? RSS NO JMP PRVOL,I YES CYB NO, THEN CHANGE ITS TRPCL AND INTBL ADB ATRPC ENTRIES TO -1 STA B,I CYB ADB AINTB STA B,I CYB ADB AOLSC -1 IN OLDSC ENTRY STA B,I CYB ADB AEQTB -1 IN EQTBL ENTRY STA B,I JMP PRVOL,I RETURN * * * RSENT - ROUTINE TO MAKE ENTRIES IN RSTBL, * THE RESTORE TABLE USED TO SAVE TRPCL,INTBL,EQTBL VALUES * FOR OLD SC AND NEW SC OF DISC, CONSOLE AND LIST DEVICE * FORMAT OF RSTBL IS : ENTRIES FOR DISC SC # 1 * " " " " # 2 * " " CONSOLE * " " LIST DEVICE * * EACH SET OF ENTRIES IS 6 WORDS LONG AS FOLLOWS: * WORD 1 - OLD >SC# * WORD 2 - INTBL VALUE FOR OLDSC * WORD 3 - TRPCL VALUE FOR OLDSC * WORD 4 - INTBL VALUE FOR NEWSC * WORD 5 - TRPCL VALUE FOR NEWSC * WORD 6 - EQT WORD 4 ADDRESS FOR NEWSC * * CALLING SEQUENCE: A REG = POINTER INTO RSTBL FOR ENTRIES * JSB RSENT * NOTE: RSENT ASSUMES OLDSC AND NEWSC CONTAIN VALUES * FOR OLD AND NEW SELECT CODES RESPECTIVELY * * RSENT NOP STA TEMP SAVE POINTER INTO RSTBL LDA OLDSC OLD SELECT CODE VALUE STA TEMP,I STORE IT IN RSTBL JSB SVRST STORE OLD SC'S INTBL & TRPCL ENTRIES LDA NEWSC NEW SELECT CODE VALUE JSB SVRST STORE NEW SC'S INTBL & TRPCL ENTRIES ISZ TEMP POINT TO WORD 6 LDA AEQTB ADDRESS OF EQTBL ADA NB10 POINT TO ENTRY FOR NEWSC ADA NEWSC LDA A,I GET EQT WORD 4 ADDRESS STA TEMP,I MAKE ENTRY IN RSTBL JMP RSENT,I RETURN * * * SVRST - ROUTINE TO STORE INTBL AND TRPCL VALUES * OF A GIVEN SELECT CODE INTO RSTBL * CALLING SEQUENCE: A REG = SELECT CODE VALUE * JSB SVRST * NOTE: TEMP IS ASSUMED TO BE POINTING AT ENTRY * PREVIOUS TO THE ONE TO BE MADE BY SVRST * * SVRST NOP ISZ TEMP POINT TO RSTBL ADA NB10 INDEX INTO INTBL STA B ADA AINTB LDA A,I GET VALUE FOR INTBL ENTRY STA TEMP,I STORE IT IN RSTBL ISZ TEMP ADB ATRPC INDEX INTO TRPCL LDA B,I GET VALUE STA TEMP,I STORE VALUE IN RSTBL JMP SVRST,I RETURN * * * RESTR - ROUTINE TO RESTORE INTBL AND TRPCL VALUES * FOR A GIVEN SELECT CODE THAT WERE SAVED IN RSTBL * CALLING SEQUENCE: B REG = SELECT CODE# - 10B (INDEX * VALUE TO BE USED IN INTBL & TRPCL) * JSB RESTR * * RESTR NOP STB TEMP1 SAVE INDEX VALUE ADB AINTB POINTER INTO INTBL ISZ TEMP POINT TO SAVED ENTRY IN RSTBL = LDA TEMP,I VALUE OF INTBL ENTRY STA B,I RESTORE IT IN INTBL LDB TEMP1 ADB ATRPC POINTER INTO TRPCL ISZ TEMP POINT TO SAVED ENTRY IN RSTBL LDA TEMP,I VALUE OF TRPCL ENTRY STA B,I RESTORE IT IN TRPCL JMP RESTR,I RETURN * * * IPROC - THIS ROUTINE TRANSFERS A SELECT CODE'S VALUES * FROM INTBL AND TRPCL INTO INTERRUPT TABLE AND TRAP CELL * AND CHANGES SELECT CODE # IN EQT IF NECESSARY * * CALLING SEQUENCE: JSB IPROC * A REG = SELECT CODE # * * IPROC NOP STA TEMP ADA NB10 STA TEMP1 SAVE VALUE ADA AINTB POINT TO SC ENTRY IN INTBL LDB A,I CPB N1 GIVEN A VALUE? JMP IPROC,I NO, THEN RETURN * LDA INTBA ADDRESS OF INTERRUPT TABLE ADA N6 ADA TEMP POINT TO SC ENTRY IN INTERRUPT TABLE STB A,I STORE INTBL VALUE IN INTERRUPT TABLE LDA ATRPC ADDRESS OF TRPCL ADA TEMP1 POINT TO SC ENTRY IN TRPCL LDA A,I STA TEMP,I STORE IT IN TRAP CELL LDA AEQTB ADA TEMP1 LDB A,I GET EQTBL ENTRY FOR THIS SC SSB DEFINED? JMP IPRC5 NO,CLEAR EXISTING EQT ENTRIES FOR NEWSC LDA B,I YES, GET CONTENTS OF EQT WORD 4 AND B77 MASK OLD SELECT CODE # CPA TEMP OLDSC = NEWSC? JMP IPROC,I YES, NO NEED TO CHANGE SC'S STA OLDSC NO, SAVE THIS OLDSC VALUE LDA EQT# # OF EQT'S DEFINED CMA,INA STA TEMP5 USE AS COUNTER LDB EQTA ADDRESS OF START OF EQT TABLES ADB .3 POINT TO WORD 4 LEQT# CPB RSTBL+5 EQT ADDRESS OF SYSTEM DISC? JMP ENEQL YES, LOOK FOR NEXT EQT CPB RSTBL+17 EQT ADDRESS OF SYSTEM CONSOLE? JMP ENEQL CPB RSTBL+23 EQT ADDRESS OF LIST DEVICE? JMP ENEQL YES LDA B,I GET CONTENTS OF WORD 4 OF EQT AND B77 GET OLD SC# ^d CPA OLDSC MATCHES ONE WE ARE LOOKING FOR? RSS YES JMP ENEQL NO, LOOK AT NEXT EQT LDA N3 POINT TO FIRST WORD OF THIS EQT ADA B STA TEMP4 SAVE ADDRESS OF THIS EQT LDA A,I GET CONTENTS OF THE FIRST WORD CPA N1 PREVIOUSLY CHANGED ? JMP ENEQL YES CCA NO,CHANGE TO NEWSC AND SET FLAG STA TEMP4,I TO INDICATE THIS LDA B,I GET CONTENTS OF WORD 4 OF EQT AND B1777 CLEAR BITS FOR SC IOR TEMP INSERT NEW SC STA B,I RESTORE EQT WORD 4 ENEQL ADB .15 POINT TO NEXT EQT'S WORD 4 ISZ TEMP5 INCREMENT COUNTER JMP LEQT# DO NEXT ONE * IPRC5 LDA NOCLR FLAG SET TO SKIP THIS? SSA JMP IPROC,I YES, THEN RETURN JMP IPRC7 JPROC NOP ENTRY POINT FOR CONSOLE AND LIST SC STA TEMP LDA JPROC SET UP RETURN ADDRESS STA IPROC IPRC7 LDA AOLSC START OF OLDSC TABLE LDB .N56 USE AS COUNTER STB TEMP5 OLSLP LDB A,I GET CONTENTS OF ENTRY IN OLDSC TABLE CPB TEMP SAME AS NEW SELECT CODE? JMP IPROC,I YES, RETURN INA NO, LOOK FURTHER ISZ TEMP5 JMP OLSLP LDA EQT# NEW SC IS NOT ASSIGNED TO ANY OTHER SC# CMA,INA THEN CLEAR OUT NEW SC # FROM OLD EQT'S STA TEMP5 LDB EQTA IPRLP LDA B,I GET FIRST WORD OF EQT SSA -1? JMP ENIPR YES, THEN NEW SC IN IT ADB .3 NO CPB RSTBL+5 EQT ADDRESS OF SYSTEM DISC? JMP ENIPR YES, LOOK FOR NEXT EQT CPB RSTBL+17 EQT ADDRESS OF SYSTEM CONSOLE? JMP ENIPR YES, LOOK FOR NEXT EQT CPB RSTBL+23 EQT ADDRESS OF LIST DEVICE? JMP ENIPR YES, LOOK FOR NEXT EQT LDA B,I GET CONTENTS OF WORD 4 OF EQT AND B77 GET SC # CPA TEMP IS THIS SAME AS NEW SC#? RSS YES JMP ENIPR NO, LOOK AT NEXT EQT LDA B,I YES AND B1777 THEN CLEAR SC# STA B,I RESTORE EQT WORD 4 ENIPR ADB .12 POINT TO NEXT EQT ISZ TEMP5 MORE EQT'S LEFT? JMP IPRLP YES JMP IPROC,I NO, RETURN * * * TSTCH - ROUTINE TO TEST THE VALIDITY OF A SELECT CODE# * CALLING SEQUENCE: JSB TSTCH * B REG = POINTER TO PARSE BUFFER * CONTAINING THE 4 WORD SET FOR SELECT CODE# * TO BE TESTED * * RETURN : LOC P IF AN ERROR RETURN * LOC P+1 IF NORMAL RETURN * * TSTCH NOP STB TEMP4 POINTER TO PARSE BUFFER INB STB TEMP5 LDA B,I GET VALUE CLB DIV .10 CONVERT VALUE TO OCTAL ALS CMA,INA ADA TEMP5,I STA TEMP5,I RESTORE VALUE LDB TEMP4 GET POINTER TO PARSE BUFFER LDA B10 10 OCTAL IS LOWER LIMIT JSB TST# TEST THE SELECT CODE # B77 OCT 77 UPPER LIMIT FOR SELECT CODE # JMP CHNLE ERROR ISZ TSTCH VALID SELECT CODE # JMP TSTCH,I NORMAL RETURN TO P+1 LOC * CHNLE LDA A2 JSB ERROR DISPLAY ERROR MESSAGE JMP TSTCH,I * .10 DEC 10 * * * * TST# - ROUTINE TO TEST VALIDITY OF A GIVEN # * CALLING SEQUENCE: A REG=LOWER LIMIT OF RANGE FOR # * B REG=POINTER TO 4 SET OF WORDS * FOR # IN PARSE BUFFER * JSB TST# * DEC(OR OCT) UPRLM UPPER LIMIT * RETURN: LOC P IF ERROR RETURN * LOC P+1 IF NORMAL RETURN * NUMBER IS IN THE A REG * * TST# NOP CBX SAVE CONTENTS OF B REG LDB B,I TYPE OF VALUE CPB .1 NUMERIC? RSS YES JMP TSTE NO THEN ERROR RETURN CXB RETRIEVE VALUE OF B REG INB LDB B,I GET VALUE CMA,INA -VE OF LOWER LIM IT ADA B VALUE-LOWER LIMIT SSA LOW LIMIT > VALUE? JMP TSTE YES, ERROR RETURN LDA B CMA,INA ADA TST#,I UPPER LIMIT-VALUE SSA VALUE > UPPER LIMIT? JMP TSTE YES, ERROR LDA B ISZ TST# NORMAL RETURN TSTE ISZ TST# JMP TST#,I RETURN * * * SVENT - ROUTINE TO MAKE ENTRY IN SVTBL * SVTBL HAS ENTRIES FOR TWO DISC SELECT CODES, * CONSOLE AND LIST DEVICE SELECT CODES IN THAT ORDER * EACH ENTRY IN SVTBL IS 4 WORDS LONG AND * CONTAINS THE FOLLOWING: * WORD 1 - NEW SC # * WORD 2 - ORIGINAL TRAP CELL CONTENTS OF NEW SC * WORD 3 - ORIGINAL INTERRUPT TABLE CONTENTS OF NEW SC * WORD 4 - EQT WORD 4 ADDRESS OF NEW SC * * CALLING SEQUENCE: A REG = POINTER TO ENTRY IN SVTBL * JSB SVTBL * ASSUME: NEWSC HAS VALUE OF SC FOR SVTBL ENTRY * * SVENT NOP LDB NEWSC NEW SELECT CODE # STB A,I ENTER IN SVTBL INA POINT TO NEXT ENTRY IN SVTBL LDB NEWSC,I VALUE OF NEWSC'S TRAP CELL STB A,I SAVE IT IN SVTBL INA POINT TO NEXT ENTRY IN SVTBL LDB INTBA ADDRESS OF INTERRUPT TABLE ADB N6 ADB NEWSC POINTER TO NEWSC ENTRY IN LDB B,I INTERRUPT TABLE STB A,I STORE INTRPT TABLE VALUE IN SVTBL INA POINT TO NEXT ENTRY STA TEMP SAVE IT LDA NEWSC JSB EQTFN FIND EQT WORD 4 ADDRESS FOR THIS SC STB TEMP,I STORE IT IN SVTBL JMP SVENT,I RETURN * * * EQTCN - INSERT NEW SC IN EQT, FIND OLD SC # AND * UNBUFFER DEVICE IF BUFFERED * CALLING SEQUENCE: B REG = ADDRESS OF EQT WORD 4 * JSB EQTCN * RETURN: TEMP2=0 IF DEVICE NOT BUFFERED * 1 OTHERWISE * EQTCN NOP JSB EQUNB UNBUFFER EQT IF BUFFERED BIT SET LDA B,I VALUE OF EQT? WORD 4 AND B77 MASK SELECT CODE STA OLDSC SAVE IT LDA B,I AND B1777 CLEAR LOW 6 BITS ADA NEWSC ADD NEW SELECT CODE STA B,I RESTORE WORD 5 JMP EQTCN,I RETURN * * * EQUNB - ROUTINE TO UNBUFFER EQT WORD 4 IF THE B BIT WAS SET * CALLING SEQUENCE: B REG = ADDRESS OF EQT WORD 4 * JSB EQUNB * RETURNS: TEMP2 = 0 IF EQT BUFFER STATUS WAS NOT CHANGED * = 1 IF EQT BUFFER STATUS WAS CHANGED * NOTE: B REG IS UNCHANGED * * EQUNB NOP CLA STA TEMP2 LDA B,I CONTENTS OF WORD 4 OF EQT RAL,RAL CLE,SLA BUFFERED? - BIT 14 SET? ISZ TEMP2 YES, THEN TEMP2 IS SET ERA,RAR CLEAR BIT 14 IF SET STA B,I RESTORE EQT WORD 4 JMP EQUNB,I RETURN * * * BUFFR - ROUTINE RESTORES THE STATUS OF CONSOLE * AND LIST DEVICE EQT'S TO BUFFERED IF THEY WERE ORIGINALLY * BUFFERED * CALLING SEQUENCE: JSB BUFFR * * BUFFR NOP LDA $SAVE+9 WAS CONSOLE EQT BUFFERED? SZA,RSS JMP LSBUF NO LDA $SAVE,I YES, GET CONTENS OF WORD 4 OF CONSOLE EQT STA PRTMP SAVE IT TEMPORARILY IOR BIT14 RESTORE BUFFER STATUS STA $SAVE,I RESTORE EQT WORD 4 LSBUF LDA $SAVE+10 LIST DEVICE EQT WAS BUFFERED? SZA,RSS JMP BUFFR,I NO, THEN RETURN LDA $SAVE+8,I YES, GET CONTENTS OF WORD 4 OF LIST DEV EQT STA PRTMP+1 SAVE EQT WORD 4 CONTENTS TEMPORARILY IOR BIT14 RESTORE BUFFER STATUS STA $SAVE+8,I RESTORE EQT WORD 4 CONTENTS JMP BUFFR,I RETURN * * * SETM - ROUTINE SETS MEMORY LOCATIONS TO GIVEN VALUE * CALLING SEQUENCE: A REG= VALUE * B REG = # OF LOCATIONS TO BE CHANGED * JSB SETM * DEF LOC STARTING LOCATION * SETM NOP CAX SAVE VALUE OF A REG IN X LDA SETM,I STARTING LOCATIOMN STA TEMP ADDRESS OF LOC ISZ SETM CMB,INB -VE COUNT CXA VALUE IN A SETLP STA TEMP,I STORE VALUE INB,SZB,RSS INCREMENT COUNTER JMP SETM,I RETURN ISZ TEMP POINT TO NEXT MEM LOC JMP SETLP * * * DSCAD - ROUTINE TO SEPARATE DISC ADDRESS INTO * TRACK AND SECTOR # * CALLING SEQUENCE: A REG = DISC ADDR BITS 0-6 SECTOR * 7-15 TRACK * JSB DSCAD * RETURNS: TEMP1 IS TRACK #, TEMP2 IS SECTOR # * * DSCAD NOP CLB LSL 9 TRACK # IN B REG STB TEMP1 SAVE IT ALF,ALF SECTOR# RAR STA TEMP2 SAVE IT JMP DSCAD,I RETURN * * * LOAD - ROUTINE TO LOAD DATA FROM DISC INTO MEMORY * CALLING SEQUENCE : JSB LOAD * * LOAD NOP JSB SETUP SET UP TRIPLETS STA PRMAR ADDRESS OF START OF TRIPLETS JSB $XSIO MAKE SYSTEM I/O REQUEST .2 OCT 2 LU# DEF CLOAD COMPLETION ROUTINE ADDRESS NOP FOR SYSTEM USE OCT 1 PRMAR NOP ARRAY ADDRESS DEC 0 BIT15 OCT 100000 LEAVE USER MAP AS IS JMP $XCQ WAIT FOR I/O TO COMPLETE CLOAD JMP LOAD,I RETURN * * * SETUP - THIS ROUTINE IS TAKEN FROM THE DISPATCHER * IT GENERATES PARAMETERS FOR DISC CALL GUARANTEEING * THAT ALL TRACK CROSSING CALLS ARE BROKEN DOWN INTO * SUB-CALLS SUCH THAT THE DISC DRIVER CAN HANDLE THE REQUEST. * THE CALLS ARE BROKEN UP IN TRIPLETS OF * STARTING MEMORY ADDRESS * NUMBER OF WORDS TO TRANSFER * TRACK/SECTOR ADDRESS * THE END OF CALL IS INDICATED BY A ZERO FOLLOWING LAST TRIPLET * CALLING SEQUENCE: * NOTE: THE TABLE OF TRIPLETS IS BUILT BOTTOM-UP. * THE CONTENTS OF LAST WORD OF TABLE MUST BE 0 - THIS WORD'S * ADDRESS IS ASSUMED TO BE APRMT * TEMP = NUMBER OF WORDS * TEMP1 = TRACK ADDRESS * TEMP2 = SECTOR ADDRESS * TEMP3 = STARTING MEMORY ADDRESS * RETURNS : ADDRESS OF START OF TRIPLETS IN PRMAR * * SETUP NOP CLA END OF PRMTBL MARKED BY 0 STA PRMTB LDA APRMT ADDRESS OF END OF PARM TABLE LDB TEMP COMPUTE # OF SECTORS SETU1 SZB,RSS ZERO, SO RETURN JMP SETUP,I ADA N3 SET UP TRIPLET STA PRMAR ADDRESS ADB B177 ROUND UP NUMBER OF SECTORS ASR 7 BLS STB TEMP5 SAVE # OF SECTORS LDA TEMP2 INITIAL SECTOR ADDRESS ADA B LDB SECT2 # OF SECOTRS ON SYSTEM DISC CMB,INB ADA B SUBTRACT # OF SECTORS/TRACK LDB TEMP3 STARTING MEMORY ADDRESS STB PRMAR,I STORE IT IN MEMORY ISZ PRMAR INCREMENT ARRAY ADDRESS CMA,CLE,INA,SZA CLE,SSA,RSS CHECK IF TRACK OVERFLOW JMP SETI0 NO, SO LAST TRIPLET ADA TEMP5 YES,USE REST OF TRACK IF OVER ASL 6 UPSET LDB TEMP1 FORM TRACK BLF,RBL AND RBL,RBL SECTOR ADDRESS ADB TEMP2 DST PRMAR,I STORE LAST 2 WORDS OF TRIPLET ADA TEMP3 UPDATE STARTING ADDRESS STA TEMP3 LDB TEMP2 INCREMENT SECTOR ADDRESS ADB TEMP5 TO START SECTOR FOR SEZ CHECK IF NEW TRACK CLB,RSS RSS NOT NEW TRACK SO SKIP ISZ TEMP1 YES, SO INCREMENT TRACK ADDRESS STB TEMP2 RESET SECTOR LDB PRMAR,I UPDATE NUMBER CMB,INB OF ADB TEMP WORDS STB TEMP TO GO CCA SUBTRACT 1 FOR CORRECT NEXT TRIPLET ADA PRMAR ADDRESS CALCULATION JMP SETU1 GO TO NEXT LOOP * SETI0 LDA TEMP SET FOR LAST JMP UPSET TRIPLET * * * ERROR - ROUTINE PRINTS ERROR MESSAGE * CALLING SEQUENCE: A REG = ERROR# IN ASCII * JSB ERROR * ERROR NOP STA ERR00+6 LDB .7 LENGTH OF BUFFER JSB WR7jTTY DISPLAY ON CONSOLE DEF ERR00 JMP ERROR,I RETURN * ERR00 ASC 7,CONFIG ERR * * * $WRRD- ROUTINE TO PERFORM I/O USING THE SYSTEM * I/O ROUTINE $XSIO * CALLING SEQUENCE: A REG = REQUEST CODE * B REG = BUF LNGTH OR * PRIORITY CODE IF DISC I/O * BIT 15 OF BREG SET IF CALLING FROM USER MAP * Y REG = LU # * 1 IF BUFFER IN USER MAP * JSB $WRRD * DEF BUFAD ADDRESS OF BUFFER * NOTE: SEE WRITE-UP ON $XSIO ROUTINE FOR FURTHER INFO * * $WRRD NOP STA REQCD REQUEST CODE STB TEMP SSB,RSS BIT 15 SET? JMP WRRD5 NO ELB,CLE,ERB CALLING FROM SUER MAP - CLEAR SIGN BIT STB BUFLN SET UP BUFFER LENGTH XLA $WRRD,I GET ADDRESS OF BUFFER IN USER AREA STA TEMP5 SAVE ADDRESS OF BUFFER IN USER MAP LDA ARDBF USE RDBUF TO MOVE USER BUFFER INTO STA BUFAD IT IS ALSO THE BUFFER ADDRESS LDA REQCD GET REQEST CODE SLA IS IT FOR WRITE? JMP WRRD7 NO, IT IS A READ REQUEST CBX BUFFER LENGTH IN X REG FOR MOVE LDB ARDBF DESTINATION BUFFER ADDRESS LDA TEMP5 SOURCE ADDRESS MWF MOVE WORDS FROM USER MAP INTO SYSTEM MAP JMP WRRD7 CONTINUE WITH I/O REQUEST WRRD5 LDA $WRRD,I GET VALUE OF BUFFER LNGTH DST BUFAD STORE BUFFER ADDRESS & LENGTH WRRD7 CYA RETRIVE Y REG STA LU# JSB $XSIO LU# NOP DEVICE LU# DEF CWRRD COMPLETION ROUTINE ADDRESS NOP FOR SYS USE REQCD NOP REQUEST CODE BUFAD NOP BUFFER ADDRESS BUFLN NOP BUFFER LENGTH DEC 0 MAP WORD=0 SINCE BUFFER ALWAYS IN SYS MAP JMP $XCQ WAIT FOR I/O COMPLETION CWRRD ISZ $WRRD COMPLETION RETRUN LDA TEMP SSA,RSS CALLING FROM SYSTEM MAP? JMP $WRRD,I YES, RETURN LDA REQCD GET REQUEST CODE SLA,RSS READ REQUEST? JMP RWRRD NO, THEN RETURN STB TEMP YES, THEN SAVE TRANSMISSION LOG CBX #OF WORDS READ LDA ARDBF ADDRESS OF READ BUFFER LDB TEMP5 ADDRESS OF DEST BUFFER IN USER MAP MWI MOVE WORDS INTO USER MAP LDB TEMP TRANSMISSION LOG RESTORED IN B REG RWRRD UJP $WRRD,I ENABLE USER MAP AND RETURN * * * QUERY - ROUTINE TO DISPLAY QUESTION ON CONSOLE AND * READ RESPONSE ANDS PARSE IT * * WRTTY - EMBEDDED IN QUERY, DISPLAYS MESSAGE ON CONSOLE * * CALLING SEQUENCE: B REG = # OF WORDS IN BUFFER TO DISPLAY * JSB QUERY(WRTTY) * DEF BUFR MESSAGE TO BE DISPLAYED * QUERY NOP CCA SET FLAG TO INDICATE QUERY ROUTINE JMP CONTQ CONTINUE WRTTY NOP LDA WRTTY STA QUERY CLA CLEAR FLAG TO INDICATE CONSOLE WRITE ROUTINE CONTQ STA WFLAG SET FLAG TO -1 LDA QUERY,I STA QBUFR CLA,INA LU # 1 CAY IN Y REG INA REQ CODE IS 2 FOR WRITE JSB $WRRD QBUFR NOP ISZ WFLAG WRTTY ROUTINE? JMP RQUER YES, RETURN * * READ RESPONSE JSB $XSIO .1 OCT 1 CONSOLE LU DEF CREAD COMPLETION ROUTINE ADDRESS NOP OCT 401 REQUEST CODE ARDBF DEF RDBUF READ BUFFER .80 DEC 80 80 WORDS NOP SYSTEM MAP JMP $XCQ WAIT FOR I/O COMPLETION CREAD LDA ARDBF ADDRESS OF READ BUFFER BLS CONVERT WORD COUNT TO CHAR. COUNT JSB $PRSE SYSTEM ROUTINE TO PARSE APRSB DEF PRSBF PARSE BUFFER RQUER ISZ QUERY JMP QUERY,I RETURN * * * WRLST - ROUTINE TO WRITE BUFFER ON LIST DEVICE AND * THE SYS CONSOLE IF ECHO IS REQUESTED * * CALLING SEQUENCE: B REG = BUFFER LENGTH  * BIT 15 OF B REG SET IF CALLING FROM USER MAP * JSB WRLST * DEF BUFR BUFFER ADDRESS * * NOTE: IT IS ASSUMED THAT IF CALLING FROM USER MAP, * THE BUFFER IS ALSO IN THE USER MAP * WRLST NOP STB TEMP4 LDA WRLST,I BUFFER ADDRESS FROM SYSTEM MAP STA CNBF STA LSBF LDA ECHO ECHO REQUIRED? SZA JMP NECHO NO ECHO JSB WRTTY WRITE ON CONSOLE CNBF NOP * NECHO LDA LSTLU LIST LU CAY LU # IN Y REG LDB TEMP4 BUFFER ADDRESS LDA B202 REQUEST CODE,CONTROL INFO JSB $WRRD LSBF NOP ISZ WRLST POINT TO RETURN ADDRESS JMP WRLST,I RETURN * B202 OCT 202 * * * PRNIO - THIS ROUTINE PRINTS I/O CONFIGURATION OF THE SYSTEM * THE FORMAT IS: * CALLING SEQUENCE : JSB PRNIO * * PRNIO NOP LDA AMSG5 SOURCE BUFFER ADDRESS LDB ARDBF DEST BUFFER ADDRESS MVW .8 LDA INTBA ADDRESS OF THE INTERRUPT TABLE ADA .2 POINT TO ENTRY FOR SC 10 OCTAL STA TEMP1 SAVE IT LDB INTLG LENGTH OF THE INTERRUPT TABLE ADB N2 ADJUST TO SKIP I/O SELECT CODES 6 AND 7 CMB,INB USE AS COUNTER STB TEMP2 LDA B10 STA TEMP3 COUNTER FOR SELECT CODE # PRNLP LDA TEMP3 CLE CONVERT SC # TO ASCII JSB $CNV3 SYSTEM ROUTINE TO CONVERT ADA .2 POINT TO LAST DIGITS LDA A,I STA RDBUF+6 SELECT CODE# IN MESSAGE LDA TEMP3 GET SELECT CODE # CPA TBG IS IT THE TBG SELECT CODE? JMP TBGPR YES CPA $SAVE+5 IS IT THE PRIV I/O CARD? JMP PRIV YES * LDA TEMP1,I INTERRUPT TABLE ENTRY SZA,RSS 0? JMP SRCHE YES, SEARCH EQT TABLES FOR AN EQT SSA PROGRAM ID SEGMENT? JMP SRCHE YES, SEARCH EQT TABLES FOR AN EQT qNLHADA .4 EQT ADDRESS SPECIFIED STA TEMP4 SAVE ADDRESS OF WORD 5 OF EQT LDA EQTA START OF EQT TABLE CMA,INA ADA TEMP1,I # WORDS OFFSET TO THE BEGINING OF THIS EQT CLB DIV .15 GET EQT # STA TEMP5 SAVE EQT#-1 JMP CNVE# CONVERT IT TO ASCII * SRCHE LDA TEMP3 GET SC # JSB EQTFN FIND EQT WORD 4 ADDRESS AND EQT # INB POINT TO WORD 5 STB TEMP4 SAVE EQT WORD 5 ADDRESS SZB,RSS FOUND AN EQT? JMP NOEQT NO EQT FOR THIS SC CNVE# LDA AMSG6 SOURCE BUFFER ADDRESS LDB ADEST DEST BUFFER ADDRESS MVW .6 LDA TEMP5 EQT # - 1 FOR THIS DEVICE CCE,INA CONVERT IT TO DECIMAL ASCII JSB $CNV3 ADA .2 POINT TO LAST TWO DIGITS LDA A,I GET ASCII VALUE FOR EQT STA RDBUF+10 STORE IT IN RDBUF LDA TEMP4 GET WORD 5 OF EQT LDA A,I ALF,CLE,ALF EQUIPMENT TYPE CODE IN BITS 0-6 N AND B77 JSB $CNV3 CONVERT EQ TYPE CODE TO OCTAL ASCII ADA .2 POINT TO LAST TWO DIGITS LDA A,I GET ASCII VALUE STA RDBUF+14 STORE IT IN BUFFER LDA SPACE CLEAR REMAINING WORD STA RDBUF+15 * PRENT LDA TEMP1,I GET INTERRUPT TABLE ENTRY SZA,RSS IS IT AN ENTRY POINT? JMP ENINS YES SSA IS IT A PROG ID SEGMENT JMP PROGN YES JMP PRNT * NOEQT LDA SPACE LDB .8 JSB SETM SET FIRST PART OF MESSAGE TO BLANKS ADEST DEF RDBUF+8 JMP PRENT * ENINS LDA TEMP3,I GET TRAP CELL VALE FOR SC CPA JSBCI IS IT JSB CIC,I? JMP NOENT YES CLE CONVERT TRAP CELL CONTENTS TO ASCII OCTAL JSB $CNV3 LDB ARDBF ADDRESS OF RDBUF ADB .16 MVW .3 MOVE ASCII VALUE LDB .19 # OF WORDS TO LIST JMP PRNT+1 * NOENT LDA TEMP4 EQT WAS FOUND? SZA JMP PRNT YES, PRINT LINE JMP ENDLP NO, SKIP PRINTING * PROGN CMA,INA MAKE THE ID SEG ADDR +VE ADA .12 POINT TO WORD 13 OF ID SEG STA TEMP5 SAVE ADDRESS DLD A,I GET PROGRAM NAME DST RDBUF+16 LDA TEMP5 ADA .2 GET LAST CHAR OF PROG NAME LDA A,I AND B1774 BLANK THE LOWER BYTE IOR B40 ADD A SPACE STA RDBUF+18 STORE IT IN READ BUFFER LDB .19 JMP PRNT+1 PRINT * TBGPR DLD .TBG TBG SELECT CODE DST ADEST,I LDB .10 JMP PRNT+1 * PRIV LDA AMSG8 PRIVILEGED I/O CARD LDB ADEST MVW .4 LDB .12 RSS * PRNT LDB .15 JSB WRLST DEF RDBUF ENDLP ISZ TEMP3 POINT TO NEXT SELECT CODE # ISZ TEMP1 INCREMENT POINTER TO THE INTERRUPT TBL ISZ TEMP2 INCREMENT COUNTER JMP PRNLP PRINT NEXT SC ENTRY JMP PRNIO,I RETURN * .TBG ASC 2,TBG * * * TRWRD - ROUTINE TRANSFER A WORD FROM SYSTEM IN MEMORY * TO A CORRESPONDING LOCATION ON DISC * CALLING SEQUENCE: A REG = DISC ADDRESS * B REG = CONTENTS OF WORD IN MEMORY * #OFST = # OF WORDS OFFSET IN THE SECTOR * * TRWRD NOP STB TEMP4 SAVE CONTENTS OF MEM LOC STA PRMTB-1 BUILD TRIPLETS FOR $XSIO ROUTINE LDB APRMT ADDRESS OF PARAMETER TABLE ADB N3 STB WRAD1 ADDRESS OF START OF TRIPLET STB WRAD2 LDA ASCBF START MEM ADDRESS STA PRMTB-3 LDB .64 # OF WORDS TO BE READ STB PRMTB-2 LDA .2 CAY LU# CLA,INA REQUEST CODE TO READ CLB READ BUFFER INTO THE SYTEM MAP JSB $WRRD WRAD1 NOP LDA ASCBF ADDRESS OF START OF BUFFER ADA #OFST ADD OFFSET TO IT LDB TEMP4 CONTENTS OF WORD TO BE TRANSFERRED STB A,I CHANGE CORRESP WORD IN BUFFER LDA .2 REQ CODE IS 2 TO WRITE CAY LU# IS ALSO 2 FOR DISC CLB WRITE BUFFER FROM SYSTEM MAP JSB $WRRD WRAD2 NOP JMP TRWRD,I RETURN * APRMT DEF PRMTB * * * MEMDS - ROUTIEN TO CONVERT GIVEN MEMORY LOCATION * (MUST BE 2000B OR GREATER) IN SYSTEM CODE INTO A * CORRESPONDING DISC LOCATION * CALLING SEQUENCE: A REG = MEMORY LOCATION * JSB MEMDS * RETURNS: TEMP1 = TRACK# * TEMP2 = SECTOR# * #OFST = # OF WORDS OFFSET INTO SECTOR * * MEMDS NOP LDB SECT2 # OF SECTORS/TRACK ON SYS DISC BLF MULTIPLY BY 100B TO GET RBL,RBL STB NWRDS # OF WORDS / TRACK CLB DIV NWRDS DIVIDE MEM LOC BY # OF WORDS/TRACK STA TEMP1 TRACK # CLA RRR 6 DIVIDE REMAINING WORDS BY 100B ADB .2 ADD 2 SECTORS TO ACCOUNT FOR BOOT EXT STB TEMP2 QUOTIENT IS SECTOR# LDB SECT2 # OF SECTORS PER TRACK ON SYS DISC CMB,INB ADB TEMP2 SECTOR# - # SECTORS/TRACK SSB SECTOR # >= # OF SECTORS/TRACK? JMP CALOF NO, CALCULATE OFFSET STB TEMP2 YES,SECTOR# = SECTOR#-#SECTORS/TRACK ISZ TEMP1 INCREMENT TRACK # * CALOF ALF A REG HAS REMAINDER RAL,RAL STA #OFST # OF WORDS OFFSET INTO SECTOR JMP MEMDS,I RETURN * NWRDS NOP #OFST NOP * * * $TREN - ROUTINE TO TRANSFER A SYSTEM ENTRY POINT VALUE * FROM MEMORY TO A CORRESPONDING LOC ON DISC * CALLING SEQUENCE: A REG = ADDRESS OF ENTRY POINT * B REG = 0 IF CALLING FROM SYSTEM MAP * = -1 IF CALLING FROM USER MAP * JSB $TREN * $TREN NOP RSS LDA A,I RAL,CLE,SLA,ERA REMOVE INDIRECTS FROM ADDRESS JMP *-2 STB TRTMP SAVE VALUE OF B REG LDB A,I GET CONTENTS OF MEM LOC STB TRTMP+1 SAVE IT JSB MEMDS FIND DISC ADDRESS FOR THIS LOC LDA TEMP1 GET TRACK# ALF,RAL RAL,RAL TRACK # IN BITS 7-15 ADA TEMP2 SECTOR # IN BITS 0-6 LDB TRTMP+1 JSB TRWRD TRANSFER WORD TO DISC LDA TRTMP CALLING FROM SYSTEM MAP? SSA,RSS JMP $TREN,I YES,RETURN UJP $TREN,I NO, RETURN TO USER MAP * * * $TRTB - PROCEDURE USED TO TRANSFER A TABLE FROM * THE SYSTEM AREA IN MEMORY TO A CORRESPONDING LOCATION * ON THE SYSTEM DISC * CALLING SEQUENCE: JSB $TRTB * A REG = START ADDRESS OF TABLE * B REG = LENGTH OF TABLE (BIT 15 SET IF * CALLING FROM USER MAP) * $TRTB HAS TWO ENTRY POINTS - $TRTB FOR TABLES WITH STARTING * ADDRESS 2000B OR GREATER AND TRPTB WITH MEM LOC LESS THAN 2000B * CALLING SEQUENCE FOR TRPTB IS : JSB TRPTB * TRTMP, TRTMP+1, #OFST WORDS MUST BE SET UP BEFORE CALLING * TRPTB ROUTINE * * $TRTB NOP RSS LDA A,I REMO=VE INDIRECTS FROM ADDRESS RAL,CLE,SLA,ERA JMP *-2 STA TRTMP SAVE THE ADDRESS OF TABLE SSB,RSS CALLING FROM USER MAP? JMP TRTB1 NO ELB,CLE,ERB YES LDA $TRTB SET BIT 15 OF THE RETURN ADDRESS ADA BIT15 STA $TRTB LDA TRTMP START ADDRESS OF TABLE TRTB1 STB TRTMP+1 JSB MEMDS CONVERT START ADDRESS INTO DISC LOC JMP TRCNT CONTINUE BY SKIPPING FOLL. INSTRUCTIONS TRPTB NOP SECOND ENTRY POINT LDA TRPTB SET UP RETURN LOC STA $TRTB TRCNT LDA ASCBF ADDRESS OF SECOTR BUFFER STA TEMP3 LDA .64 # OF WORDS TO BE READ STA TEMP JSB SETUP SET UP A TRIPLET TO READ STA TRBFA THE FIRST SECTOR THE TABLE OCCUPIES STA TRBFB ADDRESS OF TRIPLET LDA .2 LU # CAY CLA,INA REQ CODE TO READ CLB BUFFER IN SYS MAP JSB $WRRD READ THE FIRST SECTOR TRBFA NOP OF THE TABLE LDB #OFST # OF WORDS OFFSET INTO FIRST CMB,INB SECTOR FOR START OF TABLE ADB .64 #WORDS FROM START OF TABLE TO END OF SECTOR LDA TRTMP+1 CMA,INA - ( # OF WORDS IN THE TABLE ) ADA B + (# WORDS TILL END OF SECTOR) SSA,RSS #WORDS IN TABLE <= #WORDS LEFT IN SECTOR? LDB TRTMP+1 YES,#WORDS TO MOVE=# WORDS IN TABLE STB TEMP1 INTO THE FIRST SECTOR LDA TRTMP ADDRESS OF TABLE ADB TRTMP STB TRTMP NEW START LOC OF TABLE STB TEMP3 LDB ASCBF ADDRESS OF SECTOR BUFFER ADB #OFST ADDRESS TO WHICH FIRST PART OF MVW TEMP1 TABLE MUST BE MOVED LDA .2 WRITE BUFFER BACK ON DISC CAY CLB BUFFER IN SYSTEM MAP JSB $WRRD TRBFB NOP * LDA TEMP1 CMA,INA ADA TRTMP+1 LENGTH OF TABLE-# OF WORDS TRANSFERRED STA TRTMP+1 # OF WORDS REMAINING TO BE TRANSFEREfD CLB RRR 6 DIVIDE BY 100B TO GET BLF # OF WORDS IN LAST SECTOR OCCUPIED BY TABLE RBL,RBL STB #OFST SAVE THIS VALUE CMB,INB - ( # OF WORDS IN LAST SECOTR) ADB TRTMP+1 ADD # OF WORDS REMAINING TO BE TRANSFERRED STB TEMP # OF WORDS TO TRANSFER TO DISC IN ONE CHUNK STB TRTMP+1 RESET TO USE LATER LDA TRBFB ADDRESS OF LAST TRIPLET USED JSB NXTAD GET THE NEXT DISC ADDRESS JSB SETUP BUILD TRIPLETS FOR THIS CHUNK OF MEMORY STA TRBFC ADDRESS OF TRIPLETS LDA .2 REQ CODE IS 2 CAY CLB BUFFER IN SYSTEM MAP JSB $WRRD TRBFC NOP * LAST SECTOR OF TABLE TO BE TRANSFERRED LDA TRTMP START MEM ADDRESS FOR LAST CHUNK ADA TRTMP+1 # OF WORDS JUST WRITTEN STA TRTMP START ADDRESS FOR LAST PART OF THE TABLE LDA .64 # OF WORDS TO BE READ FROM DISC STA TEMP LDB TRBFC,I CONTENTS OF FIRST WORD OF LAST TRIPLET LDA TRBFC ADDRESS OF THE LAST TRIPLET USED SZB,RSS WAS LAST TRIPLET EMPTY? LDA TRBFB YES,USE TRIPLET ADDR FROM PREVIOUS TRANSFER JSB NXTAD CALCULATE NEXT DISC ADDRESS LDA ASCBF STA TEMP3 JSB SETUP BUILD THE LAST TRIPLET STA TRBFD ADDRESS OF TRIPLET STA TRBFE LDA .2 CAY CLA,INA REQ CODE IS TO READ SECTOR CLB BUFFER IS IN SYSTEM MAP JSB $WRRD READ SECTOR CONTAINING LAST PART OF THE TABLE TRBFD NOP LDA TRTMP START ADDRESS OF LAST PART OF TABLE LDB ASCBF ADDRESS OF SECTOR BUFFER MVW #OFST # OF WORDS LEFT IN THE TABLE LDA .2 REQ CODE IS 2 TO WRITE CAY CLB BUFFER IS IN SYSTEM MAP JSB $WRRD WRITE LAST PART OF THE TABLE TRBFE NOP LDA $TRTB CALLING FROM USER MAP? SSA,RSS JMP A,I NO, RETURN ELA,CLE,ERA CLEAR SIGN BIT UJP A,I RETURN TO USER MAP * ASCBF EQU ARDBF * * * NXTAD - ROUTINE TO FIND TRACK AND SECTOR # TO BE * USED FOR NEXT SEQUENTIAL DISC ACCESS * CALLING SEQUENCE: A REG = ADDRESS OF LAST TRIPLET USED * JSB NXTAD * RETURNS: TEMP1=NEW TRACK # * TEMP2=NEW SECTOR # * * NXTAD NOP INA POINT TO # OF WORDS IN LAST TRIPLET CAY LDA A,I CLB RRR 6 DIVIDE #OF WORDS BY 100B TO GET # OF SECTORS SZB REMAINDER? INA YES, THEN INCREMENT # OF SECTORS STA TEMP4 SAVE THIS VALUE CYA GET POINTER TO TRIPLET INA POINT TO DISC ADDRESS LDA A,I JSB DSCAD BREAK UP DISC ADDRESS INTO TRACK & SECTOR# LDA TEMP2 GET SECTOR # ADA TEMP4 ADD # OF SECTORS TRANSFERRED CPA SECT2 ALL SECTORS IN TRACK DONE? RSS JMP SECTR NO, SET SECTOR # ISZ TEMP1 INCREMENT TRACK # CLA SECTR STA TEMP2 CLEAR SECTOR # JMP NXTAD,I RETURN * * * $GDPG - ROUTINE FINDS THE FIRST POSSIBLE GOOD PAGE * STARTING FROM THE PAGE # PASSED AS PARAMETER * * CALLING SEQUENCE : A REG = STARTING PAGE# * BIT 15 SET IF CALLING FROM USER MAP * JSB $GDPG * RETURNS: LOC P IF ERROR RETURN * LOC P+1 IF NORMAL RETURN * A REG = NEXT GOOD PAGE# * * $GDPG NOP STA PRTMP SAVE A REG SSA CALLING FROM SYSTEM MAP? ELA,CLE,ERA NO, CLEAR SIGN BIT BDPGL CPA MEMSZ PAGE IS EQUAL TO MEMORY SIZE? JMP EXGDP YES, THEN ERROR RETURN LDB A PAGE# IN B REG CMB,INB STB TEMP LDB $ABDP,I GET BAD PAGE# CPB N1 -1? JMP GDPGR YES, END OF BAD PAGE LIST CPB A EQUAL TO START PAGE # PASSED? JMP FNDBD YES, THEN BAD PAGE FOUND ADB TEMP ( BAD PAGE # > START PAGE? SSB JMP INCBD NO, THEN INCREMENT THE BAD PAGE# GDPGR ISZ $GDPG YES, RETURN EXGDP LDB PRTMP SSB,RSS JMP $GDPG,I RETURN IN SYSTEM MAP UJP $GDPG,I RETURN IN USER MAP FNDBD INA INCREMENT START PAGE # INCBD ISZ $ABDP INCREMENT BAD PAGE POINTER JMP BDPGL TRY AGAIN * * * $PCHN - ROUTINE TO FIND A CHUNK OF MEMORY LARGER THAN * ONE PAGE BETWEEN BAD PAGES * CALLING SEQUENCE : JSB $PCHN * A REG = 0 IF CALLING FROM SYSTEM MAP * = -1 IF CALLING FROM USER MAP * RETURNS: A REG = SIZE OF CHUNK OF MEMORY * * $PCHN NOP STA TEMP1 LDA $USRS GET START OF USER PART'N JSB $GDPG GET THE NEXT GOOD PAGE JMP ZEROP NO, MORE GOOD PAGES STA $USRS NEW GOOD PAGE PCHLP LDA $ABDP,I GET BAD PAGE VALUE CPA N1 END OF BAD PAGE LIST? JMP NBDPG YES LDB $USRS START OF USER PART'N AREA CMB,INB ADA B BAD PAGE# - START OF USER PART'N CPA .1 SIZE OF THIS CHUNK IS 1? JMP ONEPG YES JMP RPCHN * ONEPG LDA $ABDP,I INCREMENT USER PART'N START PG INA JSB $GDPG FIND GOOD PAGE STARTING AT THE NEW JMP ZEROP NO MORE PAGES LEFT STA $USRS NEW USER PART'N START PAGE JMP PCHLP * ZEROP CLA JMP RPCHN RETURN * NBDPG LDA $USRS START OF USER PART'N CMA,INA ADA MEMSZ MEM SIZE - START USER PART'N PAGE CPA .1 ONLY ONE PAGE? JMP ZEROP YES, THEN RETURN WITH 0 PAGES RPCHN LDB TEMP1 SSB,RSS CALLING FROM SYSTEM MAP? JMP $PCHN,I YES, RETURN UJP $PCHN,I NO, ENABLE USER MAP AND RETURN * END $CNFG 0.**0 6 92067-18026 1805 S C0122 &$TB14 RTE-IV TABLE AREA I             H0101 ASMB,R,L,C * * DATE: 9/21/77 * NAME: $$TB1 * SOURCE: 92067-18026 * RELOC: PART OF 92067-16014 * PGMR: E.WONG * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM $$TB1,15 92067-16014 REV.1805 780223 * * EXEC4: ENT $ERAB,$PVCN,EXEC,$LIBR,$LIBX,$PVST * RTIO4: ENT $UPIO,$CIC,$XCIC,$YCIC ENT $UIN,$UCON * DISP4: ENT $XEQ,$XDMP,$IDLE * SCHD4: ENT $SCD3,$IDNO,$MEU,$LIST,$MESS,$WORK,$$OP * TRRN4: ENT $ULLU,$CGRN * MTM: ENT $MTM * ENT $OPSY * * EXEC4: EXT $ERRA,$LBR,$LBX,$XEX * RTIO4: EXT $UP,$CIC0,$CXC,$CYC EXT $CON1,$CON2,$CON3 * DISP4: EXT $XCQ,$XDM * SCHD4: EXT $SCD,$ID#,$LST,$MSG,$IDSM,$OP * TRRN4: EXT $ULU,$CRN# * A EQU 0 B EQU 1 * * EXEC4 * HLT 0 TRAP IN CASE OF FALL THROUGH. JMP *-1 DON'T ALLOW RE-RUN EXEC NOP JMP EXEC OR JSB EXEC WITHOUT MP SJP $XEX WILL BE CAUGHT IN EXEC CODE * $ERAB SJP $ERRA * $PVCN NOP LEVEL COUNT FOR PRIVILEGED CALL $PVST NOP DMS STATUS FOR PRIVILEGED CALL * $LIBR NOP SSM $PVST SJP $LBR * $LIBX NOP SSM $PVST SJP $LBX * * * RTIO4 * $UPIO SJP $UP * $CIC NOP SJP $CIC0 * $XCIC SJP $CXC * $YCIC SJP $CYC * $UIN NOP UJS B,I ENTER DRIVER IN USER MAP SJP $UIN,I RETURN IN SYSTEM MAP * $UCON UJS B,I ENTER DRIVER IN USER MAP JMP UCON1 P+1 RETURN JMP UCON2 P+2 RETURN SJP $CON3 P+3 RG  ETURN UCON1 SJP $CON1 UCON2 SJP $CON2 * * * DISP4 * $XEQ SJP $XCQ * $XDMP NOP RSB SJP $XDM * IDLE JMP * $IDLE DEF IDLE ADDR OF IDLE LOOP NOP DUMMY A,B,EO,X NOP DUMMY Y * * * SCHD4 * $LIST NOP RSA SJP $LST * $SCD3 NOP RSB SJP $SCD * $IDNO NOP RSA SJP $ID# * $MESS NOP SSM $MEU SJP $MSG $MEU NOP SAVES MEU STATUS FOR $MESS * $WORK JMP $IDSM * $$OP DEF $OP+0 DIRECT ADDRESS OF LAST PARSED OP CODE * * * TRRN4 * $ULLU NOP RSA SJP $ULU * $CGRN NOP RSB SJP $CRN# * * * MTM * $MTM NOP * * $OPSY DEC -9 RTE-IV IDENTIFICATION * * END $OPSY (   92067-18027 1805 S C0122 &$TB24 RTE-IV TABLE AREA II             H0101 ASMB,R,L,C * DATE: 7/26/77 * NAME: $$TB2 * SOURCE: 92067-18027 * RELOC: PART OF 92067-16014 * PGMR: E.J.WONG * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM $$TB2,13 92067-16014 REV.1805 771107 * ENT $MATA,$MCHN,$MBGP,$MRTP ENT $DLTH,$DVPT,$TIME,$BATM ENT $DLP,$PLP ENT $ENDS,$MPFT,$BGFR,$RTFR,$IDEX ENT $MRMP,$MPS2,$EMRP,$MPSA ENT $SDA,$SDT2,$CMST,$COML ENT $CFR,$MNP,$DVMP $STRG ENT $RLB,$RLN,$SBTB * * $MATA NOP $MCHN NOP $MBGP DEC 14 $MRTP DEC 5 $DLTH DEC 1 $DVPT NOP $TIME OCT 16000 JAN 5, 1978 8:00 AM OCT 177650 OCT 5554 $BATM NOP 1. NOP 2. $DLP NOP $PLP NOP $ENDS NOP $MPFT NOP $BGFR NOP $RTFR NOP $IDEX NOP $MRMP NOP $MPSA NOP $MPS2 NOP $SDA NOP $SDT2 NOP $CMST NOP $COML NOP $CFR NOP $MNP NOP $DVMP NOP $EMRP NOP $RLB NOP $RLN NOP $SBTB NOP 1. NOP 2. NOP 3. NOP 4. NOP 5. NOP 6. * END $MATA Y  92067-18028 1805 S C1622 &GP01 RTE-IV GASP             H0116 A SPL,L,O,M,C ! NAME: GASP ! SOURCE: 92067-18028 ! RELOC: 92067-16028 ! PGMR: A.M.G. ! MOD FOR RTE 4 : C.M.M. ! ! *************************************************************** ! * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * ! * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * ! * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* ! * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ! *************************************************************** ! ! NAME GASP(19,80) "92067-16028 REV.1805 780323" ! ! LET G1ERP,G1OMS,G1ZAP,G1WFI BE SUBROUTINE LET G1IMS BE SUBROUTINE ! LET KCVT BE FUNCTION,EXTERNAL LET POST,CREAT,OPEN,CLOSE,POSNT,EXEC BE SUBROUTINE,EXTERNAL LET READF,WRITF,PARSE,G1ROT,G1CEX BE SUBROUTINE,EXTERNAL LET G1CIN,RNRQ,REIO BE SUBROUTINE,EXTERNAL LET ST.LU BE SUBROUTINE,DIRECT,EXTERNAL LET G1RD,G1WFI,G1OPN BE SUBROUTINE LET ERTS BE SUBROUTINE,DIRECT ! LET G0END,G0NJB,G0NLO,G0SZF,G0NSP BE INTEGER,EXTERNAL LET G0INT BE INTEGER,EXTERNAL LET CS43,SP.OK,G0MXP,G0SLU BE INTEGER,EXTERNAL ! LET G0EXN,G0JBF,G0SPF BE INTEGER(3),GLOBAL LET PRMPT BE INTEGER(2) LET JODCB,SPDCB BE INTEGER(16) !DO NOT REARRANGE THESE TWO LET G0DCB BE INTEGER(144),GLOBAL !LINES LET SIZE,SIZE1 BE INTEGER LET ERRS BE INTEGER(3) LET SIGN,ERRNO,SSPOL BE INTEGER LET NSPL,IERR,SAVE,SAVE1,SAVE2 BE INTEGER LET WRN,IRN,ICNWD,CHARS,FFILE,ADDR BE INTEGER LET G0BUF,G0WD1,G0WD2,G0WD3 BE INTEGER,GLOBAL LET G0WD4 BE INTEGER(3),GLOBAL LET G0WD7,G0WD8,G0WD9,G0W10,G0W11 \ BE INTEGER,GLOBAL LET G0W12 BE INTEGER(2) LET G0W14 BE INTEGER LET G0W15 BE INTEGER,GLOBAL LET G0W16(110) BE INTEGER LET PBFN2,PBFN1 BE INTEGER LET PBUFX,BUFX1,BUFX2,BUFX3,BUFX4 BE INQTEGER LET BUFX5 BE INTEGER(9) LET BUX14 BE INTEGER LET BUX15 BE INTEGER(17) LET G0PBF BE INTEGER,GLOBAL LET G0P1V BE INTEGER,GLOBAL LET PARS1 BE INTEGER(3) LET G0P2V BE INTEGER,GLOBAL LET PARS2 BE INTEGER(26) LET G0NOP BE INTEGER,GLOBAL LET G0SDN,G0JDN BE INTEGER,GLOBAL LET G0TTY,G0RDS,G0ERH BE INTEGER,GLOBAL ! INITIALIZE PRMPT TO 1,57137K INITIALIZE G0RDS TO 0 INITIALIZE G0EXN TO "EXTND" INITIALIZE G0JBF TO "JOBFIL" INITIALIZE G0SPF TO "SPLCON" INITIALIZE ERRS,SIGN TO 4,"GASP " ! LET CNWD BE CONSTANT(400K) LET E BE CONSTANT(42440K) LET SEC BE CONSTANT(123456K) LET IOPTN BE CONSTANT(3) ! GASP: CALL EXEC(22,2);SAVE1 _ $$1 IFNOT [G0TTY _ (SAVE1 AND 77K)] THEN G0TTY _ 1 G0TTY _ G0TTY + CNWD !SAVEG0TTY. IF [X_CS43] THEN GOTO FCHEK CALL ST.LU !SET UP $LUAV AND CS43. CALL EXEC(9,G0EXN,0) !EXTND SETS UP $MPID. FCHEK: CALL OPEN(JODCB,IERR,G0JBF,IOPTN,SEC)!TRY TO OPEN JOBFIL. CALL ERTS !TEST FOR ERRORS CALL G1ZAP(SPDCB) CALL OPEN(SPDCB,IERR,G0SPF,IOPTN,SEC) !NOW TRY SPLCON CALL ERTS !TEST FOR ERRORS CALL G1OPN(G0DCB,IERR,G0JBF) !MOVE THE OPEN DATA CALL G1RD(G0BUF,17) !READ RECORD 17 IF X THEN GOTO RSTRT CALL G1RD(PBUFX,1) !REALLOCATE RN S RNRQ(20K,PBUFX,SAVE) !FOR SPLCON/JOBFIL G0BUF _ PBUFX !TIME THROUGH AFTER RNRQ(20K,G0W14,SAVE) !ALLOCATE HOLD BEM RN. CALL G1WFI(PBUFX,1) !BOOT-UP. CALL G1WFI(G0BUF,17) RSTRT: CALL G1OPN(G0DCB,IERR,G0SPF) !SET TO ACCESS SPLCON IF X THEN GO TO RSTR2 CALL G1RD(PBUFX,1) RNRQ(20K,PBUFX,SAVE) F CALL G1WFI(PBUFX,1) RSTR2: CALL G1RD(PBUFX,3) G0SDN_PBUFX;G0JDN_G0W15 !SET THE DOWN FLAGS IF X THEN GO TO GETCD BUFX1 _ G0W14 CALL G1WFI(PBUFX,3) CALL G1CEX(-1) !TERMINATE GO TO GETCD !GET COMMAND ON RESTART ! TERM: CALL CLOSE(JODCB,IERR) !CLOSE THE FILE AND CALL CLOSE(SPDCB) EX: CALL EXEC(6) !EXIT ! GETCD: IFNOT G0RDS THEN [ \READ NEXT COMMAND AND CALL G1IMS(PRMPT)] !PARSE, IF NECESSARY. IERR,G0RDS _ 0 CALL G1ROT(G0PBF,G0NOP,IERR) !GO TO PROPER ROUTINE. ERCHK: IFNOT IERR THEN GOTO GETCD !COME BACK. CHECK FOR CALL G1ERP(IERR) !ELSE REPORT THE ERROR GO TO GETCD !GO GET THE NEXT COMAND ! ! INIT: IF SAVE1 < 0 THEN GO TO EX !IF NO INPUT UNIT, EXIT. IF SP.OK > 0 THEN[\ !CHECK WHAT ST.LU RETURNED CALL G1OMS(G0INT);GO TO INIT1] !IF 0 OR NEG SEND ERROR G0P1V_60K !SET CODE TO GET TO INIT CALL G1ROT(G0PBF,G0NOP,IERR) !CALL INNITILIZE INIT1: CALL G1OMS(G0END) !SEND END MESSAGE GO TO EX ! ! THE FOLLOWING ROUTINE ZEROES A 16-WORD BUFFER AREA. ! G1ZAP: SUBROUTINE(LOCAT) GLOBAL LET LOCAT BE INTEGER SAVE2 _ @LOCAT - 1 REPEAT 16 TIMES DO [ \ $[SAVE2 _ SAVE2+1] _ 0] RETURN END ! ! THE FOLLOWING ROUTINE GETS THE RESPONSE TO QUESTIONS ! AT INITIALIZATION. ! G1IMS: SUBROUTINE(MESS) GLOBAL LET MESS BE INTEGER CALL G1OMS(MESS) CALL REIO(1,G0TTY,G0BUF,-32) CHARS _ $1 CALL PARSE(G0BUF,CHARS,G0PBF) RETURN END ! ! WRITE OUT A MESSAGE ! G1OMS: SUBROUTINE(STRNG) GLOBAL LET STRNG BE INTEGER SAVE2 _  @STRNG + 1 CALL EXEC(2,G0TTY,$SAVE2,STRNG) RETURN END ! ! READ RECORD NUMR TO RDBF ! G1RD: SUBROUTINE(RDBF,NUMR)GLOBAL CALL READF(G0DCB,IERR,RDBF,16,LOC,NUMR) !READ THE RECORD IF IERR<0 THEN GO TO ERMS RETURN END ! ! ERROR ROUTINE FOR FIRST OPENS ! ERTS: SUBROUTINE DIRECT IFNOT IERR+6 THEN GO TO INIT IF IERR<0 THEN[\ ERMS: CALL G1ERP(IERR);GO TO TERM] RETURN END ! ! THIS OPEN ROUTINE REALLY JUST MOVES IN A SAVED DCB HEADER ! G1OPN: SUBROUTINE(NWDCB,RREI,NAMF) GLOBAL DPT_@NWDCB RREI_2 !ERROR IS ALWAYS TWO IF NAMF = "SP" THEN GO TO SPOPN !IF SPOOL GO DO IT SPT_@JODCB !SET SOURCE POINTER GO TO MVOPN !GO DO THE MOVE ! SPOPN: SPT_@SPDCB ! SET UP FOR SPOOL CON MVOPN: CALL POST(NWDCB,IERR) !POST ANY DATA FOR K_0 TO 15 DO[$(DPT+K)_$(SPT+K)] !MOVE DCB RETURN END ! ! WRITE A RECORD TO A FILE. ! G1WFI: SUBROUTINE(RECD,RNUM) GLOBAL,FEXIT LET RECD,RNUM BE INTEGER CALL WRITF(G0DCB,IERR,RECD,16,RNUM) IF IERR THEN FRETURN RETURN END ! ! PRINT CURRENT ERROR ROUTINE ! G1ERP: SUBROUTINE(BOMNO) GLOBAL SAVE_BOMNO IF BOMNO < 0 THEN [SAVE_ -BOMNO; \IF NEGATIVE SET SIGN SIGN_ 20055K] !TO "-" ERRNO_ KCVT(SAVE) !CONVERT TO ASCII CALL G1OMS(ERRS) !SEND THE MESSAGE SIGN _ " " !BLANK THE SIGN AGAIN G0ERH _ BOMNO !KEEP THE HISTORY RETURN !EXIT END ! ! END GASP END$ 7; SPL,L,O ! NAME: G1CEX ! SOURCE: 92002-18001 ! RELOC: 92002-16001 ! PGMR: G.A.A. ! ! *************************************************************** ! * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1975. ALL RIGHTS * ! * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * ! * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* ! * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ! *************************************************************** ! NAME G1CEX(8) "92002-16001 760615" ! LET CLOSE,POST,G1OPN,EXEC,G1OMS BE SUBROUTINE,EXTERNAL LET G1SUB,G0JDN,G0SDN,G0DCB,G0TTY,G0END BE INTEGER,EXTERNAL ! G1CEX: SUBROUTINE(N) GLOBAL IF N # -1 THEN CALL G1OMS(G0END) CALL POST(G0DCB) !POST DCB IF NEEDED IFNOT G0JDN THEN GO TO EX !IF BOTH IFNOT G0SDN THEN GO TO EX !JOB AND SPOOL SHUT CALL G1OPN(G0DCB,I,"JO") !DOWN CLOSE BOTH FILES CALL CLOSE(G0DCB) !AND CALL G1OPN(G0DCB,I,"SP") !DO NORMAL TERM CALL CLOSE(G0DCB) CALL EXEC(6) ! ! SPOOL OR JOB OR BOTH STILL ACTIVE ! SO SAVE RESOURCES AND TERMINATE ! EX: CALL EXEC(22,2) !DON'T SWAP ALL OF MEM G1SUB_0 !CLEAR SEGMENT FLAG CALL EXEC(6,0,1,0) I_$$1 !GET THE LU IFNOT [G0TTY_(I AND 77K)] THEN G0TTY_1 G0TTY_G0TTY+400K !SET THE ECHO BIT RETURN END END END$ ASMB,R,L HED ST.LU * NAME: ST.LU * SOURCE: 92002-18001 * RELOC: 92001-16001 * PGMR: A.M.G. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1975. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM ST.LU,8 92067-16028 780317 ENT ST.LU * EXT N.SEQ,$LIBR,$LIBX,$DVMP,SP.OK EXT $LUAV,.DRCT,EXEC,IS43,CS43 * * THE FOLLOWING ROUTINE INITIALIZES THE SPOOL * AVAILABILITY TABLE, $LUAV, AND SETS CS43 # 0 * AS A DONE FLAG. * ST.LU NOP LDA XEQT GET MY ID ADDRESS ADA D14 INDEX TO TYPE WORD LDA A,I PULL IT IN AND M7 KEEP ONLY TYPE CPA D3 IS THIS PROG BG ? RSS YES ISZ INOGO SET AN ERROR FLAG * JSB .DRCT DEF $LUAV GET ADDRESS OF $LUAV. STA ADDR INA STA PTR2 CLA SET COUNTERS AND POINTERS. STA CNTR2 LDA EQTA GET ADDRESS OF WORD 2 OF 1ST EQT. INA STA PTR1 LDA EQTNO SET COUNTER FOR # OF EQT'S CMA,INA TO SEARCH. STA CNTR1 CLB,INB STB NEQT JSB .DRCT GET DIRECT ADDRESS OF DEF IS43 IS43 ENTRY POINT TO SMD. STA SMDAD JSB $LIBR NOP LOOP1 LDA CNTR2 CPA ADDR,I JMP DONE LDA PTR1,I PICK UP EQT2 - DRIVER CPA SMDAD ENTRY POINT. MATCH IS43? JMP SEEK YES. INCR1 ISZ NEQT KEEP LOOKING AT EQT'S. LDA PTR1 ADA D15 INCREMENT TO NEXT EQT. STA PTR1 ISZ CNTR1 JMP LOOP1 * DONE LDA INOGO GET THE ERROR FLAG STA SP.OK AND SAVE IN SSGA SZA WERE THERE ANY ERRORS ? JMP OUT YES, DRIVER NOT IN OUR MAP * LDA CNTR2 STA N.SEQ DONE - SAVE # OF SPOOL EQT'S. CMA,INA,SZA DON'T SAVE IF THERE ARE NONE STA ADDR,I CCA SET CS43 TO STA CS43 -1 TO SHOW DONE OUT JSB $LIBX DEF ST.LU * SEEK CCB GET THE APPROPRIATE DRIVER MAP ENTRY ADB NEQT ADB $DVMP LDA B,I PULL IT IN SSA,RSS IS THE SYS DVR MAP BIT SET ? JMP NOWAY NO. LDA M1K1 GET CORRECT VALUE ? STA B,I AND PUT IT AWAY * CCA NOW SEE IF EQT HAS EXTENTS ADA NEQT MPY D15 ADA EQTA ADA D11 INDEX TO 12 WORD OF THE EXTENT LDA A,I PULL IT IN ADA DM18 SSA OK ? NOWAY ISZ INOGO NO ! * LDA DRT FOUND A SPOOL EQT. STA PTR3 MUST SEARCH DRT TO LDA LUMAX FIND THE CORRESPONDING CMA,INA LU #. STA CNTR3 CLB,INB LOOP2 LDA PTR3,I PICK UP DRT ENTRY. AND B77 GET EQT #. CPA NEQT MATCH THIS ONE? JMP ENTER YES. INB NO - KEEP LOOKING. ISZ PTR3 ISZ CNTR3 JMP LOOP2 JMP INCR1 ENTER STB PTR2,I MAKE AN ENTRY IN $LUAV. ISZ PTR2 CLA STA PTR2,I ISZ PTR2 ISZ CNTR2 JMP INCR1 * SMDAD BSS 1 M1K1 OCT 100001 DM18 DEC -18 INOGO NOP B77 OCT 77 D3 DEC 3 D11 DEC 11 D14 DEC 14 D15 DEC 15 M7 OCT 7 NEQT BSS 1 CNTR1 BSS 1 CNTR2 BSS 1 CNTR3 BSS 1 PTR1 BSS 1 PTR2 BSS 1 PTR3 BSS 1 ADDR BSS 1 EQTA EQU 1650B EQTNO EQU 1651B DRT EQU 1652B LUMAX EQU 1653B XEQT EQU 1717B A EQU 0 B EQU 1 * END  ASMB,R,L HED G1ROT * NAME: G1ROT * SOURCE: 92002-18001 * RELOC: 92002-16001 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1975. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM G1ROT,8 92002-16001 760615 ENT G1ROT ENT G1SUB ENT G1SEG * * EXT .ENTR EXT EXEC EXT G1CEX * PBUFR NOP PLEN NOP IERR NOP * G1ROT NOP JSB .ENTR DEF PBUFR LDA G1SUB IF TABLE ADDRESS IS ZERO SZA,RSS THEN STA CSEG ZERO THE SEGMENT PRESENT FLAG LDB PBUFR INB B POINTS TO COMMAND ENTERED LDB B,I GET THE NUMONIC STB G1KLG SAVE IT * LDB BUFAD GET COMMAND TABLE ADDRESS CLA SET SEGMENT FLAG TO MAIN SEGST STA SEGID CLA SET SEGMENT OFFSET TO STA SEGOF ZERO NXTCM INB STEP TABLE ADDRESS LDA B,I GET ENTRY SSA NEGATIVE MEANS NEW SEGMENT JMP SEGST GO SET IT * SZA,RSS ZERO IS END OF LIST JMP G1RT1 ERROR EXIT * CPA G1KLG THIS IT? JMP ITSIT YES GO PROCESS * ISZ SEGOF STEP THE OFFSET JMP NXTCM TRY THE NEXT ONE * ITSIT LDA SEGID GET THE SEGID LDB RTAD SET ADDRESS IN CASE MAIN CMA,INA,SZA,RSS IF ZERO THEN ITS IN THE MAIN JMP MAIN * ADA "0" MAKE IT ASCII ALF,ALF AND ROTATE TO HIGH CPA CSEG CURRENT SEGMENT? JMP G1SEG YES GO DO IT * STA CSEG SET NEW SEG NAME JSB EXEC CALL SYSTEM TO LOAD THE SEGMENT DEF G1SEG м DEF D8 DEF GASP * G1SEG LDB G1SUB GET RETURNED ADDRESS MAIN ADB SEGOF ADD THE OFFSET LDB B,I GET ENTRY POINT OF SUB. JSB B,I DEF *+4 DEF PBUFR,I DEF PLEN,I DEF IERR,I JMP G1ROT,I * G1RT1 LDA D5 ILLEGAL COMMAND STA IERR,I SET ERROR CODE JMP G1ROT,I AND RETURN * GASP ASC 2,GASP CSEG NOP CURRENT SEGMENT G1SUB NOP CURRENT SEGMENTS ENTRY POINT TABLE ADDRESS D5 DEC 5 D8 DEC 8 SEGID NOP SEGOF NOP * BUFAD DEF * ASC 1,EX OCT -1 FOLLOWING ARE IN SEGMENT 1 ASC 1,DJ ASC 1,CJ ASC 1,DS ASC 1,CS ASC 1,KS ASC 1,RS ASC 1,AB OCT -2 FOLLOWING ARE IN SEGMENT 2 ASC 1,DA ASC 1,?? "0" OCT 60 SPECIAL CODE TO GET TO IN ROUTINE ASC 1,SD ASC 1,SU NOP END OF TABLE RTAD DEF *+1 DEF G1CEX MAIN TRANSFER TABLE * ENT G1KLG * EXT $LUAV,.DRCT,G0WD1 * * THIS ROUTINE COUNTS THE NUMBER OF ACTIVE LU'S FOR THE * SPOLCON RECORD NUMBER PASSED BY SCANNING THE LU AVAILABLITY * TABLE ($LUAV) AND RETURNS THIS NUMBER IN THE A REGISTER * * CALLING SEQUENCE: * * JSB G1KLG * DEF RNUM NUMBER OF THE RECORD TO BE FOUND * --- RETURN A SET AS ABOVE * G1KLG NOP LDA $LUAV GET THE COUNT OF ENTRIES STA COUNT JSB .DRCT GET A DIRECT ADDRESS DEF $LUAV OF THE TABLE STA PTR AND SAVE IT CLA CLEAR THE RETURN COUNT STA RTN LDA G1KLG,I GET THE RECORD NUMBER LDA A,I TO LOCAL STA RNUM STORAGE ISZ G1KLG STEP TO THE RETURN ADDRESS * NEXT ISZ PTR STEP TO THE ENTRY LDA PTR,I GET THE CURRENT LU ISZ PTR STEP TO THE RECORD NUMBER SSA,RSS IF NOT AN ACTIVE ENTRY JMP CONT JUST CONTINUE * LDB PTR,I GET THE p ENTRY'S RECORD NUMBER CPB RNUM THIS IT? ISZ RTN YES STEP THE COUNT * CONT ISZ COUNT END OF THE LIST?? JMP NEXT NO TRY NEXT ONE * LDA RTN YES SEND BACK THE COUNT JMP G1KLG,I RETURN SPC 2 PTR NOP RTN NOP RNUM NOP COUNT NOP A EQU 0 B EQU 1 END 6ASMB,R,L HED G0QIP * NAME: G0QIP * SOURCE: 92002-18001 * RELOC: 92002-16001 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1975. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM G0QIP,8 92002-16001 760621 ENT G0NJB,G0NLO,G0SZF,G0NSP ENT G0KIL,G0END,G0JHD,G0MXP,G0SLU,G0INT * SUP G0NJB DEC -35 ASC 18,MAX NUMBER OF JOBS,JOB FILE DISC? _ GUARD G0NLO DEC -33 ASC 17,NUMBER,LOCATION OF SPOOL FILES? _ GUARD G0MXP DEC -48 ASC 20,MAXIMUM NUMBER ACTIVE AND PENDING SPOOL ASC 4,FILES? _ GUARD G0NSP DEC -34 ASC 17,NUMBER OF SPOOL FILES (5 TO 80)? _ GUARD G0SZF DEC -34 ASC 17,SIZE OF SPOOL FILES (IN BLOCKS)? _GUARD G0SLU DEC -31 ASC 16,ENTER OUTSPOOL DESTINATION LU _ GUARD G0JHD DEC 19 ASC 19,## NAME STATUS SPOOLS G0END DEC 4 ASC 4,END GASP G0KIL DEC -39 ASC 20,MAY ABORT PROGRAM OR JOB, OK TO KILL? _ GUARD G0INT DEC -40 ASC 20,/GASP: IRRECOVERABLE INITIALIZE ERROR ! * END 80ASMB,R,L HED GASP1 * NAME: GASP1 * SOURCE: 92067-18028 * RELOC: 92067-16028 * PGMR: G.A.A. * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM GASP1,5 92067-16028 REV.1805 760615 EXT G0PBF,G1SUB,G1SEG SPC 1 GASP1 LDA TABL STA G1SUB SET THE TABLE ADDRESS JMP G1SEG RETURN TO MAIN SPC 1 TABL DEF *+1 SPC 1 EXT G1CDJ DEF G1CDJ EXT G1CCJ DEF G1CCJ EXT G1CDS DEF G1CDS EXT G1CCS DEF G1CCS EXT G1CKS DEF G1CKS EXT G1CRS DEF G1CRS EXT G1CAB DEF G1CAB END GASP1 dq SPL,L,O ! NAME: G1CDJ ! SOURCE: 92002-18001 ! RELOC: 92002-16001 ! PGMR: A.M.G. ! DATE: 741015 ! ! *************************************************************** ! * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1975. ALL RIGHTS * ! * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * ! * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* ! * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ! *************************************************************** ! NAME G1CDJ(8) LET G1SCH,G1RDF BE SUBROUTINE LET G1OMS BE SUBROUTINE,EXTERNAL LET G1STM BE SUBROUTINE,EXTERNAL,DIRECT LET EXEC,G1OPN,READF BE SUBROUTINE,EXTERNAL ! LET G0W15,G0BUF,G0WD1,G0WD7,G0WD8,G0WD9 BE \ INTEGER,EXTERNAL LET CNTR,BEGIN,TYP,SKEY BE INTEGER LET G0JHD,G0TTY,G0DCB,G0JBF BE INTEGER,EXTERNAL LET DOWN(6) BE INTEGER INITIALIZE DOWN TO 5," SHUT DOWN" LET SPACE BE REAL INITIALIZE SPACE TO 2," " ! LET CNWD BE CONSTANT(1100K) ! ! ! G1CDJ: SUBROUTINE(PBUFR,PCNT,ERR) GLOBAL LET PBUFR,PCNT,ERR BE INTEGER BEGIN _ 19; TYP _ $(@PBUFR+4) SKEY _ @PBUFR+5 ICNWD _ CNWD + G0TTY !SET UP I/O DEVICE. CALL EXEC(3,ICNWD,-1) CALL G1OMS(G0JHD) CALL G1OMS(SPACE) CALL EXEC(3,ICNWD,1) CALL G1OPN(G0DCB,ERR,G0JBF) IF ERR < 0 THEN RETURN CALL G1RDF(17,ERR)?[RETURN] !GET SPEC RECORD ENDR_G0WD1 !SAVE THE END RECORD ! IFNOT (PCNT-1) THEN GOTO WHOLE FL_0 !SET NONE FOUND YET FLAG SEEK: G1SCH(SKEY,TYP,BEGIN,ENDR,ERR) \ ? [IF FL THEN GO TO RETN;IFNOT ERR THEN ERR_6;RETURN] CALL G1STM !PRINT OUT STATUS IF [FL_TYP] = 2 THEN [ \IF NAME KEY, THEN BEGIN _ BEGIN + 1; GOTOi   SEEK] !LOOK FOR MORE JOBS GOTO RETN !OF SAME NAME. WHOLE: CALL G1RDF(17,ERR) ? [RETURN] CNTR _ G0WD1 FOR STRT _ 19 TO CNTR DO [ \ CALL G1RDF(STRT,ERR) ? \ [RETURN]; IF G0BUF >= 0 THEN \ CALL G1STM] RETN: IF ERR THEN RETURN CALL G1RDF(17,ERR)?[RETURN] IF G0W15 = "D" THEN CALL G1OMS(DOWN) RETURN END ! ! SEARCH THE JOBFIL FOR A JOB (NAME OR NUMBER KEY). ! G1SCH: SUBROUTINE(KEY,TYPE,STR,ENDF,ERRS) GLOBAL,FEXIT LET KEY,TYPE,STR,ENDF,ERRS BE INTEGER FOR STR _ STR TO ENDF DO [ \ CALL G1RDF(STR,ERRS) ? [FRETURN]; \ IF G0BUF >= 0 THEN [ \ IF TYPE = 1 THEN [ \ IF $KEY = G0WD1 THEN RETURN], \ ELSE [IF $KEY = G0WD7 THEN [IF \ $(KEY+1) = G0WD8 THEN [IF \ $(KEY+2) = G0WD9 THEN\ RETURN]]]]] FRETURN END ! G1RDF: SUBROUTINE(NUM,ERROR) GLOBAL,FEXIT LET NUM,ERROR BE INTEGER CALL READF(G0DCB,ERROR,G0BUF,16,LEN,NUM) IF ERROR THEN FRETURN RETURN END END END$  SPL,L,O ! NAME: G1CCJ ! SOURCE: 92002-18001 ! RELOC: 92002-16001 ! PGMR: G.A.A. ! ! *************************************************************** ! * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1975. ALL RIGHTS * ! * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * ! * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* ! * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ! *************************************************************** ! NAME G1CCJ(8) "92002-16001 760615" ! ! LET G1SCH,G1WFI,G1OPN BE SUBROUTINE,EXTERNAL LET EXEC,POST,RNRQ,G1RDF BE SUBROUTINE,EXTERNAL ! LET G0DCB,G0JBF,G0BUF,G0WD1,G0WD2,G0WD7 BE INTEGER,EXTERNAL ! LET FMGR(3),PAR1,PARS2,PAR2,RSTAT BE INTEGER ! LET IOPTN BE CONSTANT(3) LET SEC BE CONSTANT(123456K) ! INITIALIZE RSTAT TO 0 INITIALIZE FMGR TO "FMGR " LET CHHI BE CONSTANT (44400K) ! ! G1CCJ: SUBROUTINE(PBUFR,PCNT,ERR) GLOBAL LET PBUFR,PCNT,ERR BE INTEGER PAR2 _ [PARS2 _ [PAR1 _ @PBUFR + 5] \ + 3] + 1 IFNOT $(@PBUFR+4) = 1 THEN [ \ RET1: ERR _ 3; GOTO RETN] CALL G1OPN(G0DCB,ERR,G0JBF) IF ERR < 0 THEN RETURN G1RDF(17,ERR) ? [GOTO RETN] IF [REC_$PAR1+18] > G0WD1 THEN[\IF BAD JOB NUM EXIT ER3: ERR_3;RETURN] JRN _ G0BUF POST(G0DCB) RNRQ(1,JRN,RSTAT) CALL G1RDF(REC,ERR)?[GO TO RETN] IF [NP_G0BUF]<0 THEN [ERR_3;GO TO RETN]!IF NO JOB HERE EXIT IF (G0WD2 = "CS") OR (G0WD2 = "A") THEN [ \ RET2: ERR _ 4; GOTO RETN] IF PCNT < 0 THEN[ \ABORT REQUEST NP_0; \SET FOR INPUT ABORT IF G0WD2 = "I" THEN GO TO IAB; \IF INPUT OR IF (G0WD2 AND 177400K) = CHHI THEN[ \INPUT A OR H IAB: G0WD2_ "IA";GO TO WRT]; \SET TO IA G0WD2_ "A";NP_ -G0BUF;GO TO WRT] !ELS  E SET TO A ! IFNOT $PARS2 = 1 THEN GOTO CHR IF $PAR2 < 1 THEN GOTO RET1 NP,G0BUF _ $PAR2; GOTO WRT ! ! CHANGE STATUS ! CHR: PAR2_$PAR2 AND 177400K IF PAR2 = 44000K THEN[ \HOLD REQUEST IFNOT [HI_G0WD2 AND 177400K] THEN \IF NO HIGH STATUS HI_G0WD2*400K; \USE THE LOW STATUS G0WD2_HI+"H";NP_0;GO TO WRT] !SET UP AND EXIT IF PAR2 = 51000K THEN[ \RELEASE REQUEST IF G0WD2 AND 177400K THEN \IF A HIGH STATUS G0WD2_G0WD2/400K; \JUST PUT IT LOW ELSE NOP IF G0WD2 # "R" THEN NP_0; \IF NOT READY DON'T Q IT GO TO WRT] ERR_56 !BAD PRAM SO SEND ERROR CJERR: IF ERR THEN GOTO RETN GOTO RET2 WRT: CALL G1WFI(G0BUF,REC) ? [GOTO RETN] REC_(REC-1)/16 !GET FLAG ADDRESS OFF_$1 CALL G1RDF(REC,ERR)?[GO TO RETN] $(@G0BUF+OFF)_NP !SET THE NEW PRIORTY CALL G1WFI(G0BUF,REC) RETN: IF RSTAT = 2 THEN [POST(G0DCB); \ RNRQ(4,JRN,RSTAT)] IF PCNT<0 THEN GO TO ABT IF PAR2 = 51000K THEN[\ IF GOING ACTIVE OR ABORT THEN ABT: IFNOT ERR THEN CALL EXEC(10,FMGR,-1)]!CALL FMGR TO FINISH RETURN END ! ! ABORT SETS THE JOB ACTIVE AND COUNTS ON FMGR TO CLEAN UP ! G1CAB: SUBROUTINE(P1,P2,P3) GLOBAL CALL G1CCJ(P1,-1,P3) !CALL CHANGE JOB TO DO IT RETURN END END END$  SPL,L,O ! NAME: G1CKS (G1CRS) ! SOURCE: 92002-18001 ! RELOC: 92002-16001 ! PGMR: G.A.A. ! ! *************************************************************** ! * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1975. ALL RIGHTS * ! * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * ! * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* ! * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ! *************************************************************** ! NAME G1CKS(8) "92002-16001 760627" ! ! ! THIS ROUTINE KILLS OUT SPOOL FILES WHICH ARE PENDING ! ON SOME LU OR IN ONE OF THE HOLD STATES. ! ! IT IS INVOKED WITH THE: ! ! KS,PRAM COMMAND ! ! WHERE PRAM IS: ! NUMERIC MEANING KILL THE SPOOL ACTIVE ON LU PRAM ! ASCII MEANING KILL THE SPOOL BY NAME PRAM ! LET G1IMS, \ G1WFI,POST,G1OPN,G1RDF,EXEC,RNRQ BE SUBROUTINE,EXTERNAL LET G1KLG BE FUNCTION,EXTERNAL,DIRECT ! LET G0DCB,G0SPF,G0BUF,G0WD1,G0WD2,G0WD3,G0WD4,\ G0W10,G0W15,G0P1V,G0KIL BE INTEGER,EXTERNAL ! LET RD,RECV,WRIF BE SUBROUTINE,DIRECT ! LET SMP(3) BE INTEGER LET JOB(3) BE INTEGER INITIALIZE SMP TO "SMP " INITIALIZE JOB TO "JOB " ! G1CKS: SUBROUTINE(PRAM,N,ER) GLOBAL ! LU_[PV3_[PV2_[PV_[PF_@PRAM+4]+1]+1]+1]+2 !SET UP PRAM ADDRESSES IFNOT $PF THEN [ER_55;RETURN] !IF NO PRAM SEND ERROR CALL G1OPN(G0DCB,ER,G0SPF) !OPEN THE SPOOL FILE IF ER<0 THEN RETURN !IF ERROR EXIT ER_0 !SET TO ZERO SO NO ERROR IS REPORTED IF N= -1 THEN CALL EXEC(9,JOB,-1) !IF KILL CHECK JOB FIRST ! CALL G1RDF(1,ER)?[RETURN] !READ THE RN RECORD JRN_G0BUF !SAVE THE RN CALL POST(G0DCB)  CALL RNRQ(1,JRN,RNST) !LOCK THE FILE LREC_[FREC_G0WD3]+G0WD1-1 !GET RECORD NUMBERS NLUS_G0WD2 !AND NUMBER OF LUS IF N= -1 THEN GO TO LUCK !IF RS CALL GO TO CHECK LU IF $PF=2 THEN GO TO NAM !IF NAME, DO NAME SEARCH FOR I_1 TO NLUS DO[ \START LU SCAN CALL RD((I*8)+1); \READ THE LU BLOCK IF (G0BUF AND 77K)=$PV THEN GO TO FLU]!JUMP IF FOUND ! ! END OF SCAN AND NOT FOUND ! BADPM: ER_56 !SEND BAD PRAM ERROR EX: CALL RNRQ(4,JRN,RNST) !UNLOCK THE RN AND RETURN !EXIT ! ! THE LU WAS FOUND ! FLU: IFNOT G0WD1 THEN [ \IF NO QUE EXIT ER4: ER_4;GOTO EX] !WITH ERROR 4 RNUM_G0WD2 !GET THE FIRST FILE CALL RD(RNUM) !READ THE SPOOL CON RECORD IF G0W10="A" THEN GO TO KL1 !MAKE SURE IT IS ACTIVE IF G0W10="AH" THEN GO TO KL1 !ELSE GO TO ER4 !GO SEND ILLEGAL STATUS ! KL1: FLAG_1 !SET LEGAL COUNT IF ACTIVE IF G0W10="A" THEN GO TO KL2 !SPOOL FILE MUST BE IF G0W10="AH" THEN GO TO KL2 !IN A DEFINED STATE FLAG_0 IF G0W10="W" THEN GO TO KL2 !IN A DEFINED STATE IF G0W10="H" THEN GO TO KL2 !IN A DEFINED STATE KL0: CALL G1IMS(G0KIL) !ELSE MAKE SURE FIRST IF G0P1V = "YE" THEN GO TO KL4 !IF YES ANSWER DO IT GO TO EX !ELSE RETURN NO ACTION ! KL2: IF G1KLG(RNUM) > FLAG THEN GO TO KL0 !IF STILL WRITING, ASK FIRST KL4: CALL RNRQ(4,JRN,RNST) !UNLOCK THE FILE FOR SMP CALL EXEC(23,SMP,13,RNUM,G0WD1,0,G0W10) !CALL SMP TO KILL KL3: RETURN b !AND EXIT ! ! LUCK: IFNOT $LU THEN GO TO NAM !IF NO LU THEN OK RNUM_@G0WD4+2 !SET UP TO SEARCH THE LU TABLE FOR RLHD_1 TO G0WD2 DO[ \SCAN FOR THE LU IF $RNUM = ($LU AND 77K) THEN GO TO NAM;\IF THIS IS IT JUMP RNUM_RNUM+1] !ELSE STEP TO NEXT ENTRY GO TO BADPM !NOT FOUND SEND BAD PRAM MESSAGE ! ! NAM: FOR RNUM_FREC TO LREC DO[ \SCAN THE SPOOL RECS CALL RD(RNUM); \TO FIND THE NAME IF G0BUF >= 0 THEN [ \IF AN ACTIVE ENTRY IF $PV=G0WD2 THEN[ \CHECK THE NAME IF $PV2=G0WD3 THEN[ \ IF $PV3=G0WD4 THEN GO TO FNAM]]]] GO TO BADPM !IF NOT FOUND THEN BAD PRAM ! ! NAME FOUND SO CHECK IF KS OR RS COMMAND ! FNAM: IF N# -1 THEN GO TO KL1 !KS SO GO CHECK STATUS ! OLU _ G0W15 RLHD_G0W10 !SET CURRENT STATUS IF RLHD = "A" THEN GO TO AH !IF ACTIVE GO HOLD/ACTIVE IF RLHD = "AH"THEN GO TO W !IF HOLD/ACTIVE GO RELEASE TO WAIT IF RLHD = "W" THEN GO TO H !IF WAITING GO HOLD IF RLHD = "H" THEN GO TO HH !IF IN HOLD GO CHANGE LU ! GO TO ER4 !NOT IN A LEGAL STATUS SO EXIT ! ! SPOOL IS ACTIVE SO FIRST PUT A HOLD ON IT ! AH: G0W10_"AH" !SET STATUS CALL WRIF !WRITE TO THE FILE AND UNLOCK CALL EXEC(23,SMP,14,RNUM,G0W15,0,RLHD)!TELL SMP WHAT TO DO ! ! SET UP TO NOW SET THE FILE ACTIVE ! RLHD_"AH" !SET CURRENT STATUS CALL RECV !RECOVER THE LOCK AND RECORD ! ! FILE IS IN ACTIVE HOLD SO SET THE NEW LU AND ! PUT IN WAIT STATUS ! W: G0W10_"W" v !SET STATUS LUX_0 IF $LU THEN[IF $LU#G0W15 THEN LUX_$LU] !SET LU CALL WRIF !WRITE OUT AND UNLOCK CALL EXEC(23,SMP,15,RNUM,OLU,LUX,RLHD) !TELL SMP GO TO KL3 !GO EXIT DONE ! ! ! FILE IS IN A WAIT QUEUE SO PUT IN HOLD THEN CHANGE LU ! AND PUT BACK IN WAIT QUEUE FOR THE NEW LU ! H: G0W10_"H" !SET NEW STATUS CALL WRIF !WRITE IT OUT AND UNLOCK CALL EXEC(23,SMP,14,RNUM,G0W15,0,RLHD) !TELL SMP ! ! NOW SET UP FOR THE WAIT QUEUE TRANSITION ! CALL RECV !RESET THE RN LOCK AND READ IF $LU THEN G0W15_$LU OLU_G0W15 !SET LU FOR CALL GO TO W !GO SET TO WAIT ! ! ! FILE IS IN HOLD SO JUST CHANGE LU AND EXIT ! HH: IF $LU THEN G0W15_$LU CALL WRIF !WRITE IT OUT AND UNLOCK RETURN !NOW RETURN ! END ! ! SUBROUTINE TO WRITE CURRENT RECORD AND UNLOCK THE DISC ! WRIF: SUBROUTINE DIRECT CALL G1WFI(G0BUF,RNUM)?[GO TO EX] !WRITE THE RECORD CALL POST(G0DCB) !MAKE SURE IT GOES TO THE DISC CALL RNRQ(4,JRN,RNST) !UNLOCK THE RN RETURN !AND RETURN END ! ! SUBROUTINE TO LOCK THE RN AND REREAD THE RECORD ! RECV: SUBROUTINE DIRECT CALL RNRQ(1,JRN,RNST) !LOCK THE RN CALL RD(RNUM) !READ THE RECORD TO THE BUFFER RETURN !AND RETURN END ! ! ! RD: SUBROUTINE (R) DIRECT CALL G1RDF(R,ER)?[GO TO EX] RETURN END ! ! THE RESTART SUBROUTINE JUST CALLS THE KS ROUTINE WITH N=-1. ! G1CRS: SUBROUTINE(P,PN,EW) GLOBAL CALL G1CKS(P,-1,EW) RETURN END END END$ ASMB,R,L,C G1CDS DISPLAY SPOOL STATUS HED G1CDS * NAME: G1CDS G1CCS * SOURCE: 92002-18001 * RELOC: 92002-16001 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1975. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM G1CDS,8 92002-16001 760621 * ENT G1CDS,G1CCS * EXT .ENTR,G1OMS,KCVT EXT G0DCB,G0BUF,G0WD1,G0WD2,G0WD3,G0WD4 EXT G0WD9,G0W10,G0W11,G0W15 EXT G1OPN,READF,WRITF,POST,RNRQ EXT EXEC,G1KLG * A EQU 0 B EQU 1 SUP * PBUF1 NOP PLEN1 NOP IERR NOP * G1CDS NOP JSB .ENTR FETCH PARAMETERS DEF PBUF1 CLA STA SPLU INITIALIZE SPOOL LU# STA PBUF2 SET NONE PRINTED FLAG LDA DBLNK STA SPSTM+2 FILL LU# WITH BLANKS CLA,INA CPA PLEN1,I SEE IF MORE THAN 1 PARAM JMP NOPR1 NO, DEFAULT TO ALL LUS LDB PBUF1 GET ADDR OF PARAM LIST ADB D4 SKIP "DS" COMMAND LDA B,I GET LU IF ANY GIVEN SZA IF NULL OR NUMERIC CPA D1 THEN OK INB,RSS JMP ILPM1 ILLEGAL PARAMETER LDA B,I SET REQUESTED LU # STA SPLU * NOPR1 JSB G1OPN OPEN SPLCON DEF *+4 NO NEED TO LOCK RN DEF G0DCB SO SPOOL SYSTEM CAN DEF IERR,I RUN FASTER DEF SPCON SSA JMP EXIT1 EXIT IF ERROR CLA,INA READ 1ST REC JSB RD LDA G0BUF GET THE RN NUMBER STA RNWD AND SAVE IT * LDA G0WD1 GET #SPOOL CONTROL RECS CMA,INA,SZA,RSS JMP DSNOS NO SPOOLS * STA RCONT SAVE THEV COUNT LDA G0WD3 GET RECORD NUMBER OF STA RCNO FIRST CONTROL RECORD JSB G1OMS SEND HEAD DEF *+2 DEF SPSH2 * JSB G1OMS SEND A SPACE DEF *+2 DEF SPACE * * GTSLU LDA RCNO SET TO READ THE RECORD JSB RD READ IT CHCKN LDA G0BUF GET USAGE FLAG SSA IF NOT IN USE JMP GTNRC GO GET THE NEXT ONE * * LDA G0W15 GET THE LU AND B77 MASK OUT ANY CONTROL BITS SZA,RSS IF NO LU JMP PURG? GO CHECK IF WE SHOULD PURGE * NOPU LDB SPLU GET THE REQUEST LU SZB IF NO REQUEST LU CPB A OR THIS IS IT RSS THEN DISPLAY STATUS JMP GTNRC ELSE SKIP TO NEXT RC * STA TEMP JSB KCVT PREPARE HEADING DEF *+2 BY CONVERTING LU # DEF TEMP CPA AB0 IF RESULT IS ZERO LDA ADM REPLACE WITH "--" LDB DBLNK MOVE THE LU RRR 8 OVER ONE CHAR. AND PAD DST SPSTM+1 SET IN THE MESSAGE * LDA G0WD9 GET SPOOL PRIORITY JSB DEC4C CONVERT 4 DEC ASCII DIGITS DEF SPSTM+7 PUT INTO STATUS MESSAGE * LDA G0WD2 MOVE NAM1,NAM2 STA SPSTM+3 LDA G0WD3 MOVE NAM3,NAM4 STA SPSTM+4 LDA G0WD4 MOVE NAM5,NAM6 STA SPSTM+5 LDA G0W10 PICK UP SPOOL STATUS AND B377 FROM WORD 10 CPA G0W10 IF SAME IOR B20K MERGE IN BLANK IOR G0W10 IF NOT MIRGE IN HIGH CHAR TOO CPA B20K IF UPPER BLANK ONLY LDA ADM USE "--" STA SPSTM+12 LDA G0W11 GET JOB NUMBER ADA MD18 STA SPBUF+11 JSB KCVT CONVERT JOB# DEF *+2 AND STUFF INTO MESSAGE DEF SPBUF+11 STA SPSTM+10 JSB G1OMS PRINT SPOOL STATUS MESSAGE DEF *+2 DEF SPSTM * ISZ PBUF2 COUNT THE PRINTED SPOOLS `* GTNRC ISZ RCNO STEP THE RECORD NUMBER ISZ RCONT BUMP RC COUNT JMP GTSLU * LDA PBUF2 IF NONE PRINTED SZA,RSS THEN SO JSB NOSP STATE LDA D3 READ SPLCON REC #3 JSB RD LDA G0BUF CHECK IF SHUT DOWN CPA "D" IS IN EFFECT RSS JMP DSDN NO, NOT DOWN JSB G1OMS YES, PRINT "SHUT DOWN" DEF *+2 DEF DOWN * DSDN CLA LDB SPLU IF NO LU SPECIFIED SZB,RSS THEN NO ERROR JMP EXIT1 IF CAN'T FIND ANY LDB SPSTM+2 GET LU# CPB DBLNK STILL BLANKS? LDA D6 IF NO LU FOUND, ERR 6 EXIT1 STA IERR,I JMP G1CDS,I RETURN * * ILPM1 LDA D56 ILLEGAL PARAMETER JMP EXIT1 * DSNOS JSB NOSP PRINT "NO SPOOLS" JMP DSDN DONE * NOSP NOP JSB G1OMS SEND A SPACE DEF *+2 DEF SPACE FIRST JSB G1OMS PRINT NO SPOOLS MESSAGE DEF *+2 DEF NOSPM JMP NOSP,I * * ADM ASC 1,-- AB0 ASC 1, 0 * RD NOP READ A RECORD FROM THE CURRENT FILE STA NORC SET THE RECORD NUMBER JSB READF GO READ IT DEF *+7 DEF G0DCB DEF IERR,I DEF G0BUF DEF D16 DEF TEMP DEF NORC JMP RD,I RETURN * NORC NOP RCNO NOP RCONT NOP B77 OCT 77 * * PURG? JSB G1KLG GO SCAN THE $LUAV FOR DEF RCNO THIS RECORD SZA IF SOME ENTRIES OK SO JMP NOPU0 JUST CONTINUE * JSB CKPU CHECK FURTHER JMP CHCKN LOOK OK NOW * JSB EXEC CALL JOB TO SEE IF IT OWNS IT DEF *+4 DEF D9 DON'T WAIT(IF BUSY THEN NOT HIS) DEF JOB DEF MD1 SEND -1 TO JUST CLEAN UP * JSB CKPU OK NOW?? JMP CHCKN YES GO PROCESS * JSB EXEC NO CALL SMP TO KILL IT DEF *+5 DEF D23 WAIT FOR IT DEF SMP DEF D13 KILL CODE DEF RCNO THIS IS THE BAD GUY * JMP GTNRC IF NOT CLEAR NOW IT NEVER WILL BE * CKPU NOP RETURN P+2 IF SHOULD PURGE JSB POST POST THE BUFFER DEF *+2 THE DCB DEF G0DCB JSB RNRQ AND LOCK THE RN DEF *+4 DEF RNLOK DEF RNWD DEF RNSTT LDA RCNO NOW JSB RD AND READ THE RECORD AGAIN LDA G0BUF NOW MAKE SURE NOTHING SSA HAS CHANGED JMP FG ALREADY CLEARED SO FORGET IT * LDA G0W15 GET THE LU AND B77 AND IF STILL SZA CONTINUE JMP FG ELSE FORGET IT * JSB G1KLG GO GET THE COUNT DEF RCNO IF STILL ZERO SZA CONTINUE JMP FG ELSE FORGET IT * ISZ CKPU SET TO TAKE THE PU EXIT FG JSB ULOKP UNLOCK THE RN NOP IGNOR ERROR JMP CKPU,I RETURN * * NOPU0 CLA JMP NOPU HED G1CCS CHANGE SPOOL STATUS PBUF2 NOP PLEN2 NOP IERR2 NOP * G1CCS NOP CHANGE SPOOL STATUS ROUTINE JSB .ENTR FETCH PARAMETERS DEF PBUF2 LDA PLEN2,I GET NUMBER OF PARAMS ADA MD3 MAKE SURE NO LESS THAN 3 SSA JMP CSMPR * LDB PBUF2 INCRE TO PARAM 2 ADB D4 SINCE FIRST IS "CS" LDA B,I CPA D2 CHECK PARAM 2 FOR RSS ASCII NAME JMP CSBPR IF NOT, THEN ERROR 56 INB STB SPNM SAVE ADDR OF SPOOL NAME ADB D3 INCRE TO PARAM 3 STB PBUF2 * JSB OPLOK OPEN SPLCON, LOCK RN DEF SPCON JMP EXIT2 EXIT IF ERRORS * LDA G0WD1 GET # SPOOL CONTROL RECS CMA,INA,SZA,RSS IF NONE, JMP NOSP2 THEN ERROR 6 STA SPCNT LDA G0WD3 GET SPOOL REC # OFFSET STA SPOFS STA SPREC * CSRDS JSB pREADF READ A SPOOL RECORD DEF *+7 DEF G0DCB DEF IERR2,I DEF G0BUF DEF D16 DEF TEMP DEF SPREC SSA JMP EXIT2 EXITS IF ERROR * CCA CPA G0BUF IS THIS SPOOL REC UNUSED? JMP CSNXS YES, SO LOOK SOME MORE * LDA SPNM GET SPOOL NAME TO UPDATE STA TEMP LDA G0WD2 CPA TEMP,I COMPARE NAM1,NAM2 RSS JMP CSNXS ISZ TEMP LDA G0WD3 CPA TEMP,I COMPARE NAM3,NAM4 RSS JMP CSNXS ISZ TEMP LDA G0WD4 CPA TEMP,I COMPARE NAM5,NAM6 JMP CSFDS NAME MATCHES * CSNXS ISZ SPREC BUMP SPOOL REC # ISZ SPCNT BUMP COUNT, DONE? JMP CSRDS NO, READ NEXT SPOOL REC NOSP2 LDA D6 CANT FIND SPOOL REQ. JMP EXIT2 * CSFDS LDA PBUF2,I YEH, WE FOUND IT. ISZ PBUF2 CPA D1 CHECK IF PARAM 3 IS # JMP CSPRI YES, PRIORITY CHANGE CPA D2 CHECK IF PARAM 3 IS ASCII JMP CSSTA YES, STATUS CHANGE CSBPR LDA D56 BAD PARAMETER EXIT2 STA IERR2,I JSB ULOKP UNLOCK RN, POST FILE NOP IGNORE ERROR LDA IERR2,I JMP G1CCS,I RETURN * CSILS LDA D4 ILLEGAL STATUS JMP EXIT2 * CSMPR LDA D55 MISSING PARAMETER JMP EXIT2 * * * CSSTA LDB G0W10 GET OLD SPOOL STATUS STB OSTAT LDA PBUF2,I GET NEW STATUS IN A ALF,ALF MOVE CHAR TO LOW BITS AND B377 KEEP ONLY 1 CHAR CPA "H" MUST EITHER BE "H" JMP CSH OR CPA "R" "R" JMP CSR JMP CSBPR ELSE BAD PARAM * CSH CPB "W" IF SPOOL WAITING JMP SMSET JUST SET HOLD CPB "H" IF ALREADY HELD JMP ALSET NO ERROR TO DO AGAIN CPB "AH" JMP ALSET LDA "AH" CPB "A" IF ACTIVE JMP SMSET THEN SET "AH" JMP CSBP7R ANYTHING ELSE IS BAD * CSR LDA "W" RELEASE SPOOL CPB "W" IF IN WAIT JMP ALSET ALREADY DONE CPB "H" IF IN HOLD JMP CSSET RELEASE TO WAIT LDA "A" CPB "AH" IF IN ACTIVE-HOLD JMP CSSET THEN MAKE ACTIVE JMP CSBPR ANYTHING ELSE IS BAD * CSSET LDB D15 SET FOR A RELEASE CALL AND RSS SKIP TO THE CALL SMSET LDB D14 SET FOR A HOLD CALL JSB WRSMP WRITE THE RECORD AND CALL SMP ALSET CLA JMP EXIT2 * WRSMP NOP STB SMPR SAVE THE SMP CALL WORD STA G0W10 SET NEW STATUS JSB WR WRITE UPDATED RECORD BACK LDB SMPR RESET SMP CALL PRAM JSB SMPR GO TELL SMP JMP WRSMP,I EXIT * * * SMPR NOP STB TEMP SET CALL PRAM JSB EXEC CALL SMP TO PUT SPOOL DEF *+8 INTO ANY QUEUE IT DEF D23 SHOULD BE IN DEF SMP DEF TEMP DEF SPREC DEF G0W15 DEF MD1 DEF OSTAT JMP SMPR,I EXIT * * * CSPRI LDA G0W10 GET CURRENT STATUS STA OSTAT OF SPOOL FILE CPA "W" IS IT WAITING OR RSS CPA "H" IN HOLD? RSS YES SO OK JMP CSILS ELSE ILLEGAL STATUS * LDB PBUF2,I GET THE NEW PRIORITY STB G0WD9 AND SET IT CPA "H" IF IN HOLD GO JMP CSPRH GO WRITE THE RECORD * LDA G0W10 ELSE PICK UP THE STATUS LDB D14 AND GO PUT IN HOLD JSB WRSMP LDB D15 NOW RELEASE TO NEW QUEUE JSB SMPR JMP ALSET DONE GO EXIT * * CSPRH JSB WR WRITE THE NEW PRIORITY JMP ALSET AND EXIT * * WR NOP JSB WRITF WRITE UPDATED RECORD BACK DEF *+6 DEF G0DCB DEF IERR2,I DEF G0BUF DEF D16 DEF SPREC SSA JMP EXIT2 JSB ULOKP UNLOCK RN AND POST FLILE NOP JMP WR,I EXIT HED COMMON ROUTINES AND CONSTANTS TO DS,CS * * JSB OPLOK * DEF FILENAME * * * OPLOK NOP OPEN FILE AND LOCK RN LDA OPLOK,I GET ADDR OF FILE NAME STA FNAME ISZ OPLOK JSB G1OPN OPEN FILE DEF *+4 USING GLOBAL DCB DEF G0DCB DEF ULOKP FNAME DEF * SSA ANY ERRORS? JMP OPLKE YES, BUG OUT * JSB READF READ FIRST RECORD DEF *+4 FROM FILE DEF G0DCB INTO GLOBAL BUFFER DEF ULOKP DEF G0BUF SSA ANY ERRORS? JMP OPLKE YES LDA G0BUF GET FIRST WORD OF RECORD STA RNWD WHICH SHOULD BE RN LOCK WORD JSB POST MAKE SURE READS DEF *+2 ARE CLEAN. DEF G0DCB * JSB RNRQ LOCAL LOCK RN TO US DEF *+4 DEF RNLOK DEF RNWD DEF RNSTT * ISZ OPLOK INCRE ADDR FOR GOOD RETURN OPLKE JMP OPLOK,I RETURN * * * * * JSB ULOKP * * * ULOKP NOP UNLOCK RN, POST FILE DCB LDA RNSTT MAKE SURE RN IS NOT CPA D1 ALREADY UNLOCKED. JMP ULOK1 IF SO - DON'T TRY IT. JSB POST POST FILE BUFFER DEF *+2 DEF G0DCB JSB RNRQ UNLOCK RN DEF *+4 DEF RNULK DEF RNWD DEF RNSTT ULOK1 ISZ ULOKP JMP ULOKP,I RETURN * * * * LDA NUMBER * JSB DEC4C * DEF BUFFER * * * DEC4C NOP 4 CHAR DEC ASCII CONVERT LDB DEC4C,I GET BUFFER ADDR STB ADDR TO STORE RESULT ISZ DEC4C CLB DIV D100 STA OS<0.*TAT SAVE 2 HI DIGITS STB CNTR SAVE 2 LOW DIGITS JSB KCVT CONVERT TWO HI DIGITS DEF *+2 DEF OSTAT STA ADDR,I ISZ ADDR JSB KCVT CONVERT TWO LOW DIGITS DEF *+2 DEF CNTR STA ADDR,I JMP DEC4C,I RETURN * * B20K OCT 20000 B377 OCT 377 D1 DEC 1 D2 DEC 2 D3 DEC 3 D4 DEC 4 D6 DEC 6 D9 DEC 9 D13 DEC 13 D14 DEC 14 D15 DEC 15 D16 DEC 16 D23 DEC 23 D55 DEC 55 D56 DEC 56 D100 DEC 100 MD1 DEC -1 MD3 DEC -3 MD18 DEC -18 * RNSTT DEC 1 ADDR NOP CNTR NOP SPLU NOP SPCNT NOP SPNM NOP SPREC NOP SPOFS NOP RNWD NOP TEMP NOP OSTAT NOP RNLOK OCT 1 RNULK OCT 4 "A" OCT 101 "AH" ASC 1,AH "D" OCT 104 "H" OCT 110 "R" OCT 122 "W" OCT 127 SPBUF BSS 16 SMP ASC 3,SMP JOB ASC 3,JOB SPCON ASC 3,SPLCON SPSH2 DEC 15 ASC 15, LU NAME PRIORITY JOB# STATUS SPSTM DEC 12 ASC 12, LU NAMESP PPPP JJ AA NOSPM DEC 6 ASC 6, NO SPOOLS DOWN DEC 5 ASC 5, SHUT DOWN SPACE DEC 1 DBLNK ASC 1, * BSS 0 SIZE END $0ASMB,R,L,C HED G1STM * NAME: G1STM * SOURCE: 92002-18001 * RELOC: 92002-16001 * PGMR: A.M.G. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1975. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM G1STM,8 92002-16001 740807 ENT G1STM * EXT G1OMS,CNUMD,KCVT,.DFER EXT G0WD1,G0WD2,G0WD3,G0WD7,G0W11,G0BUF * G1STM NOP JSB CNUMD CONVERT DEF *+3 DEF G0WD1 THE JOB NUMBER DSTAT DEF STAT TO THE STATUS BUFFER JSB .DFER MOVE NAME TO BUFFER. DEF NAME DEF G0WD7 LDA G0WD3 AND MASKL LDB DIR SZA LDB SRC STB STUS JSB CNUMD CONVERT THE DEF *+3 DEF G0BUF PRIORITY DEF STUS+1 TO THE BUFFER LDA G0WD2 AND B377 KEEP LOW PART CPA G0WD2 IF SAME IOR HBLK PAD WITH A BLANK IOR G0WD2 AND SET STA STUS+4 STATUS IN BUFFER CLA,INA STA FNUM LDA M8 SET MAX REPORT LIMIT FOR STA LIM NUMBER OF SPOOL FILES LDA W11AD RAL,CLE,SLA,ERA REMOVE INDIRECT BIT LDA A,I GET DIRECT ADDRESS STA ADDR1 LDA M5 STA CNTR LDA SPAD STA ADDR LOOP LDA M16 STA CNTR1 LDA ADDR1,I STA SAVE ILOP SLA JMP GOTON BACK RAR STA SAVE ISZ FNUM ISZ CNTR1 JMP ILOP * ISZ ADDR1 ISZ CNTR JMP LOOP * OUT LDA DSTAT CALCULATE THE RECORD SIZE CMA ADA ADDR STA STAT JSB G1OMS DEF *+2 DEF STAT JMP G1STM,I GOTON JSB KCVT CONVERT |'   DEF *+2 DEF FNUM THE FILE NUMBER STA ADDR,I ISZ ADDR LDB BLANK STB ADDR,I ISZ ADDR LDA SAVE ISZ LIM MORE THAN MAX NUM OF FILES? JMP BACK NO CONTINUE * JMP OUT YES JUST SEND WHAT WE HAVE * SUP STAT ASC 6 NAME ASC 5 STUS ASC 8 NUMS BSS 16 * DIR ASC 1, D SRC ASC 1, S LIM NOP FNUM BSS 1 ADDR1 BSS 1 CNTR BSS 1 ADDR BSS 1 SPAD DEF NUMS W11AD DEF G0W11 CNTR1 BSS 1 B377 OCT 377 MASKL OCT 177400 M8 DEC -8 M5 DEC -5 M16 DEC -16 BLANK OCT 20040 HBLK OCT 20000 SAVE BSS 1 A EQU 0 B EQU 1 END -1 ASMB,R,L HED GASP2 * NAME: GASP2 * SOURCE: 92067-18028 * RELOC: 92067-16028 * PGMR: G.A.A. * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM GASP2,5 92067-16028 REV.1805 760615 EXT G0PBF,G1SUB,G1SEG SPC 1 GASP2 LDA TABL STA G1SUB SET THE TABLE ADDRESS JMP G1SEG RETURN TO MAIN SPC 1 TABL DEF *+1 SPC 1 EXT G1CDA DEF G1CDA EXT G1CQQ DEF G1CQQ EXT G1CIN DEF G1CIN EXT G1CSD DEF G1CSD EXT G1CSU DEF G1CSU END GASP2 ASMB,R,L,C G1CSD SHUT DOWN/START UP HED G1CDS * NAME: G1CSD,G1CSU * SOURCE: 92002-18001 * RELOC: 92002-16001 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1975. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM G1CSD,8 92002-16001 760622 * ENT G1CSD,G1CSU * EXT G0SDN,G0JDN,.ENTR EXT G0DCB,G0BUF EXT G0W15 EXT G1OPN,READF,WRITF,POST,RNRQ EXT EXEC * A EQU 0 B EQU 1 SUP * PBUF3 NOP PLEN3 NOP IERR3 NOP * G1CSD NOP JSB .ENTR FETCH PARAMETERS DEF PBUF3 LDB PBUF3 INCRE TO PARAM 2 ADB D4 SINCE PARAM 1 IS "SD" LDA B,I INB STB PBUF3 CLB SZA,RSS IF NO PARAM 2 JMP BOTH THEN SHUT DOWN SPOOL AND JOBS CPA D2 JMP SDASC SDBPR LDA D56 BAD PARAMETER JMP EXIT3 * BOTH STA PBUF3,I SET PARAM 2 TO 0 JMP SDSP IF NOT SPECIFIED * SDASC LDA PBUF3,I GET PARAM 2 CPA "S" SHUT DOWN SPOOLS? JMP SDSP YES CPA "B" SHUT DOWN BATCH JOBS? JMP SDBA YES JMP SDBPR ELSE BAD PARAM * SDSP JSB OPLOK TO SHUT DOWN SPOOLS DEF SPCON OPEN SPLCON AND LOCK RN JMP EXIT3 JSB READF THEN READ REC 3 DEF *+7 DEF G0DCB DEF IERR3,I DEF G0BUF DEF D16 DEF TEMP DEF D3 SSA JMP EXIT3 RETURN IF ERRORS * LDA "D" SET "D" INTO 1ST WORD STA G0BUF OF REC 3 FOR SHUT DOWN STA G0SDN SET FLAG FOR TERM JSB WRITF TO LET SMP KNOW. DEF *+6 WRITE REC BACK TO SPLCON FILE DEF G0DCB DEF IERR3,I DEF G0BUF DEF D16 DEF D3 SSA JMP EXIT3 * JSB ULOKP NOW UNLOCK RN AND POST FILE NOP JSB EXEC CALL SMP TO DO ACTUAL DEF *+4 SHUTDOWN PROCEDURE DEF D23 DEF SMP DEF D16 * LDA PBUF3,I SZA SHUTDOWN BOTH? JMP SDDN NO, DONE. * SDBA JSB OPLOK OPEN JOBFIL AND LOCK RN DEF JOBFI JMP EXIT3 JSB READF READ REC # 17 DEF *+7 DEF G0DCB DEF IERR3,I DEF G0BUF DEF D16 DEF TEMP DEF D17 SSA JMP EXIT3 LDA "D" SET "D" INTO 15TH WORD STA G0W15 AS FLAG FOR BM STA G0JDN SET FLAG FOR TERM JSB WRITF WRITE THE RECORD BACK DEF *+6 DEF G0DCB DEF IERR3,I DEF G0BUF DEF D16 DEF D17 SSA SDDN CLA SHUT DOWN DONE * EXIT3 STA IERR3,I JSB ULOKP NOW UNLOCK RN, POST FILE NOP LDA IERR3,I JMP G1CSD,I RETURN * * HED G1CSU START UP SPOOL AND/OR BATCH SYSTEM PBUF4 NOP PLEN4 NOP IERR4 NOP * G1CSU NOP JSB .ENTR FETCH PARAMETERS DEF PBUF4 JSB EXEC TELL JOB TO CLEAN UP DEF *+4 IN ANY CASE DEF D9 IF BUSY DON'T WAIT DEF JOB DEF MD1 -1 CLEAN UP ONLY LDB PBUF4 INCRE TO PARAM 2 ADB D4 SINCE PARAM 1 IS "SU" LDA B,I INB STB PBUF4 CLB SZA,RSS IF NO PARAM 2 JMP BOTHU THEN START UP SPOOL AND JOBS CPA D2 JMP SUASC * SUBPR LDA D56 JMP EXIT4 * BOTHU STA PBUF4,I SET PARAM 2 TO 0 JMP SUSP IF NOT SPECIFIED * SUASC LDA PBUF4,I GET PARAM 2 CPA "S" START UP SPOOLS? JMP SUSP YES CPA "B" START UP BATCH JOBS?  JMP SUBA YES JMP SUBPR ELSE BAD PARAM * SUSP JSB OPLOK TO START UP SPOOLS DEF SPCON OPEN SPLCON AND LOCK RN JMP EXIT4 JSB READF THEN READ REC 3 DEF *+7 DEF G0DCB DEF IERR4,I DEF G0BUF DEF D16 DEF TEMP DEF D3 SSA JMP EXIT4 RETURN IF ERRORS * CLA CLEAR 1ST WORD STA G0BUF OF REC 3 FOR START UP STA G0SDN SET GLOBAL FLAG TOO JSB WRITF TO LET SMP KNOW. DEF *+6 WRITE REC BACK TO SPLCON FILE DEF G0DCB DEF IERR4,I DEF G0BUF DEF D16 DEF D3 SSA JMP EXIT4 * JSB ULOKP NOW UNLOCK RN AND POST FILE NOP JSB EXEC CALL SMP TO DO ACTUAL DEF *+4 START UP PROCEDURE DEF D23 DEF SMP DEF D17 * LDA PBUF4,I SZA START UP BOTH? JMP SUDN NO, DONE. * SUBA JSB OPLOK OPEN JOBFIL AND LOCK RN DEF JOBFI JMP EXIT4 JSB READF READ REC # 17 DEF *+7 DEF G0DCB DEF IERR4,I DEF G0BUF DEF D16 DEF TEMP DEF D17 SSA JMP EXIT4 CLA CLEAR 15TH WORD STA G0W15 AS FLAG FOR BM STA G0JDN SET LOCAL GLOBAL TOO JSB WRITF WRITE RECORD BACK DEF *+6 DEF G0DCB DEF IERR4,I DEF G0BUF DEF D16 DEF D17 SSA JMP EXIT4 EXIT IF ERROR JSB EXEC SCHEDULE FMGR DEF *+4 TO UPDATE JOBS DEF D10 DEF FMGR DEF MD1 -1 MEANS JOB UPDATE ONLY * SUDN CLA START UP DONE EXIT4 STA IERR4,I JSB ULOKP NOW UNLOCK RN, POST FILE NOP LDA IERR4,I JMP G1CSU,I RETURN * * HED COMMON ROUTINES AND CONSTANTS TO DS,CS,SD,SU * * JSB OPLOK * DEF F4ILENAME * * * OPLOK NOP OPEN FILE AND LOCK RN LDA OPLOK,I GET ADDR OF FILE NAME STA FNAME ISZ OPLOK JSB G1OPN OPEN FILE DEF *+4 USING GLOBAL DCB DEF G0DCB DEF ULOKP FNAME DEF * SSA ANY ERRORS? JMP OPLKE YES, BUG OUT * JSB READF READ FIRST RECORD DEF *+4 FROM FILE DEF G0DCB INTO GLOBAL BUFFER DEF ULOKP DEF G0BUF SSA ANY ERRORS? JMP OPLKE YES LDA G0BUF GET FIRST WORD OF RECORD STA RNWD WHICH SHOULD BE RN LOCK WORD JSB POST MAKE SURE READS DEF *+2 ARE CLEAN. DEF G0DCB * JSB RNRQ LOCAL LOCK RN TO US DEF *+4 DEF RNLOK DEF RNWD DEF RNSTT * ISZ OPLOK INCRE ADDR FOR GOOD RETURN OPLKE JMP OPLOK,I RETURN * * * * * JSB ULOKP * * * ULOKP NOP UNLOCK RN, POST FILE DCB LDA RNSTT MAKE SURE RN IS NOT CPA D1 ALREADY UNLOCKED. JMP ULOK1 IF SO - DON'T TRY IT. JSB POST POST FILE BUFFER DEF *+2 DEF G0DCB JSB RNRQ UNLOCK RN DEF *+4 DEF RNULK DEF RNWD DEF RNSTT ULOK1 ISZ ULOKP JMP ULOKP,I RETURN * * D1 DEC 1 D2 DEC 2 D3 DEC 3 D4 DEC 4 D9 DEC 9 D16 DEC 16 D17 DEC 17 D23 DEC 23 D10 DEC 10 D56 DEC 56 MD1 DEC -1 * RNSTT DEC 1 RNWD NOP TEMP NOP RNLOK OCT 1 RNULK OCT 4 "B" ASC 1,B "B " "D" OCT 104 "S" ASC 1,S "S " SMP ASC 3,SMP FMGR ASC 3,FMGR JOBFI ASC 3,JOBFIL JOB ASC 3,JOB SPCON ASC 3,SPLCON * BSS 0 SIZE END ASMB,R,L,C HED G1C?? - GASP ERROR EXPANDER MODULE * NAME: G1C?? * SOURCE: 92002-18001 * RELOC: 92002-16001 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1975. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM G1C??,8 92002-16001 741027 ENT G1CQQ EXT .DFER,G1OMS,G0BUF,G0ERH,G0TTY,.ENTR EXT EXEC SUP N NOP LST NOP SPC 1 G1CQQ NOP ENTRY POINT JSB .ENTR GEN PRAMS DEF LST SPC 1 LDA LST ADVANCE PRAM TO ADA .4 THE FIRST PRAM STA LST AND RESTORE LDB G0ERH GET ERROR PRAM ASR 16 EXTEND THE SIGN BIT DIV .1000 DIVID LDA B ERROR CODE TO A LDB LST,I GET FLAG ISZ LST STEP TO SZB IF NOT SUPPLIED USE .E.R. LDA LST,I ELSE USE FIRST PRAM CPA .99 IF PRAM=99 JMP ALL THEN PRINT ALL CODES ON LIST STA N SAVE CODE ADA MOSNG TEST FOR SSA DEFINED CODE JMP UDF TOO NEGATIVE LDA N ADA NHLP1 SSA JMP PRINT OK - PRINT IT ADA NHLG SSA JMP UDF IN MID CODE GAP - UNDEFINED ADA NHH SSA,RSS JMP UDF TO HIGH - UNDEFINED LDA N ADJUST N ADA NHLG FOR HIGH GROUP STA N TABLE PRINT LDA N GET N ADA TBAD ADD TABLE ADDRESS PR LDB A,I GET MESSAGE ADDRESS STB MSAD SET AS POINTER LDB B,I MESSAGE STB A LENGTH CMA,INA SET FOR STA N MOVE ADB .2 AND STB LNMES OUTPUT JSB .DFER MOVE THE FIRST THREE WORDS DEF G0BUF TO THE BUFFER DEF LNMES INCLUDES THE LENGTH AND NAME LDA BUF.D HEAD RSS LDA A,I OF RAL,CLE,SLA,ERA MESSAGE JMP *-2 GET ADA .3 BUFFER ADDRESS AND MOVE ISZ MSAD LDB MSAD,I MOVE STB A,I MESSAGE INA TO ISZ N BUFFER JMP MOVE JSB G1OMS PRINT DEF FMRTN ON BUF.D DEF G0BUF DEVICE FMRTN CLA STA G0ERH JMP G1CQQ,I ELSE, RETURN SPC 3 UDF LDA DFUDF PICK UN DEFINED JMP PR AND SEND IT. SPC 3 ALL LDA G0TTY SAVE THE TTYLU STA TTY LOCALLY LDA LST IF ADA .4 A LU SUPPLIED LDA A,I THEN USE SZA IT STA G0TTY LDA G0TTY GET THE LU AND B77 KEEP ONLY THE LU IOR B1100 ADD THE PAGE BITS STA LUX SET FOR EJECT LDA PTRS SET THE STA CPTRS POINTER FOR THE MESSAGES WRIT JSB G1OMS WRITE DEF WRRTN THE CPTRS NOP THE WRRTN ISZ CPTRS LDA CPTRS ELIMINATE THE RAL,CLE,ERA NOT DEFINED LDA A,I MESSAGES CPA NDEF UNDEFINED MESSAGE? JMP WRRTN YES SKIP IT * LDA CPTRS,I IF LENGTH NEGATIVE SSA,RSS SKIP JMP WRIT ELSE GO WRITE NEXT MESSAGE SPC 3 LDA TTY RESTORE THE TTY LU STA G0TTY JSB EXEC SEND THE TOP OF FORM DEF EX DEF .3 DEF LUX DEF N2 EX JMP G1CQQ,I GO EXIT SPC 2 .1000 DEC 1000 .99 DEC 99 N2 DEC -2 .2 DEC 2 .3 DEC 3 .4 DEC 4 B77 OCT 77 B1100 OCT 1100 TTY NOP LUX NOP SPC 1 MSAD NOP DFUDF DEF *+1 NDEF DEF UDN-1 LNMES NOP GASP ASC P2,GASP TBAD DEF MS00 PTRS DEF LSHED,I ABS LUDN UDN ASC 6, NOT DEFINED LUDN EQU *-UDN LSHED DEF HEAD-1 THIS LIST DEF BLNK-1 IS IN DEF HD2-1 THE DEF BLNK-1 ORDER DEF ERM14-1 OF DEF ERM13-1 PRINTING DEF ERM12-1 AND DEF UDN-1 ALSO DEF UDN-1 NUMERICAL DEF UDN-1 ORDER DEF ERM8-1 DEF ERM7-1 DEF ERM6-1 DEF UDN-1 DEF ERM4-1 DEF UDN-1 DEF ERM2-1 DEF ERM1-1 MS00 DEF ER0-1 DEF ER1-1 DEF ER2-1 DEF ER3-1 DEF ER4-1 DEF ER5-1 DEF ER6-1 HLOW EQU *-MS00-1 MOST POSITIVE OF LOW GROUP DEF ER55-1 DEF ER56-1 NHIG EQU *-MS00-HLOW-2 NUMBER OF HIGH ERRORS DEF N2 * A EQU 0 B EQU 1 MSTN EQU 14 MOST NEGATIVE ERROR CODE LHIG EQU 55 LOWEST OF HIGH GROUP HHIG EQU LHIG+NHIG HIGHEST OF HIGH GROUP SPC 1 MOSNG ABS MSTN MOST NEG. CODE NHLP1 ABS -HLOW-1 NEG. OF LOW HIGH BOUND NHLG ABS HLOW+1-LHIG NEG. OF LOW HIGH GAP NHH ABS LHIG-HHIG-1 NEG. OF HIGH SIZE. * * ERROR TABLE -CODES ARE ENTERED IN ANY ORDER. * ABS L0 ER0 ASC 6, 0 NO ERROR L0 EQU *-ER0 ABS LM1 ERM1 ASC 7, -1 DISC ERROR LM1 EQU *-ERM1 ABS LM2 ERM2 ASC 12, -2 DUPLICATE FILE NAME LM2 EQU *-ERM2 ABS LM4 ERM4 ASC 19, -4 MORE THAN 32767 RECORDS IN A TYPE ASC 4, 2 FILE LM4 EQU *-ERM4 ABS LM6 ERM6 ASC 18, -6 CR OR FILE NOT FOUND OR NO ROOM LM6 EQU *-ERM6 ABS LM7 ERM7 ASC 13, -7 BAD FILE SECURITY CODE LM7 EQU *-ERM7 ABS LM8 ERM8 ASC 15, -8 FILE OPEN OR LOCK REJECTED LM8 EQU *-ERM8 ABS LM12 ERM12 ASC 11, -12 EOF OR SOF ERROR LM12 EQU *-ERM12 ABS LM13 ERM13 ASC 8, -13 DISC LOCKED LM13 EQU *-ERM13 ABS LM14 ERM14 ASC 10, -14 DIRECTORY FULL LM14 EQU *-ERM14 SPC 1 ABS L1 ER1 ASC 7, 1 DISC ERROR L1 EQU *-ER1 ABS L2 ER2 ASC 11, 2 NUMBER OUT OF RANGE L2 EQU *-ER2 ABS L3 ER3 ASC 9, 3 BAD JOB NUMBER! L3 EQU *-ER3 ABS L4 ER4 ASC 9, 4 ILLEGAL STATUS L4 EQU *-ER4 ABS L5 ER5 ASC 9, 5 ILLEGAL COMMAND L5 EQU *-ER5 ABS L6 ER6 ASC 6, 6 NOT FOUND L6 EQU *-ER6 SPC 2 ABS L55 ER55 ASC 11, 55 MISSING PARAMETER L55 EQU *-ER55 ABS L56 ER56 ASC 9, 56 BAD PARAMETER L56 EQU *-ER56 SPC 2 ABS LHEAD HEAD ASC 9, GASP ERROR CODES LHEAD EQU *-HEAD ABS LHD2 HD2 ASC 9, ERROR MEANING LHD2 EQU *-HD2 ABS LBLNK BLNK ASC 1, LBLNK EQU *-BLNK ORG * PROGRAM LENGTH END Ĵ SPL,L,O ! NAME: G1CIN ! SOURCE: 92002-18001 ! RELOC: 92002-16001 ! PGMR: A.M.G. ! ! *************************************************************** ! * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1975. ALL RIGHTS * ! * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * ! * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* ! * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ! *************************************************************** ! NAME G1CIN(8) "92002-16001 760630" ! LET G1CDA,G1OMS,G1ZAP,G1WFI BE SUBROUTINE,EXTERNAL LET G1CQQ,EXEC,G1IMS BE SUBROUTINE,EXTERNAL LET .DFER BE SUBROUTINE,EXTERNAL,DIRECT ! LET KCVT BE FUNCTION,EXTERNAL LET POST,CREAT,OPEN,CLOSE BE SUBROUTINE,EXTERNAL LET RNRQ BE SUBROUTINE,EXTERNAL LET ST.LU BE SUBROUTINE,DIRECT,EXTERNAL LET CNUMD,G1RD,G1OPN BE SUBROUTINE,EXTERNAL LET CRERR BE SUBROUTINE LET GERR BE SUBROUTINE,DIRECT ! LET G0END,G0NJB,G0NLO,G0SZF,G0NSP BE INTEGER,EXTERNAL LET CS43,N.SEQ,G0MXP,G0SLU BE INTEGER,EXTERNAL ! LET G0EXN,G0JBF,G0SPF BE INTEGER,EXTERNAL LET G0DCB BE INTEGER,EXTERNAL !LINES LET G0BUF,G0WD1,G0WD2,G0WD3 BE INTEGER,EXTERNAL LET G0WD4 BE INTEGER,EXTERNAL LET G0WD7,G0WD8,G0WD9,G0W10,G0W11 \ BE INTEGER,EXTERNAL LET G0W15 BE INTEGER,EXTERNAL LET G0PBF BE INTEGER,EXTERNAL LET G0P1V BE INTEGER,EXTERNAL LET G0P2V BE INTEGER,EXTERNAL LET G0NOP BE INTEGER,EXTERNAL LET G0SDN,G0JDN BE INTEGER,EXTERNAL LET G0TTY,G0RDS,G0ERH BE INTEGER,EXTERNAL LET PBUFX,BUFX1,BUFX2,BUFX3,BUFX4,BUFX5(9),BUX14, \ BUX15(17) BE INTEGER ! LET DUPNM(8),MESS(4),DINIT(8) BE INTEGER INITIALIZE DUPNM,MESS TO 11,"DUP FILE NAME XXXXXX. " INITIALIZE DINIT TO 7,"DEINITIALIZE?_" LET NOROM(3),DNO(12),MS,MSS(11) BE INTEGER INITIALIZE NOROM,DNO,MS,MSS TO 27,\ DISC FULL MESSAGE "DISC XXXXX FULL OR MISSING, XX SPOOL FILES CREATED. " LET SIZE,SIZE1 BE INTEGER !DO NOT REARRANGE THESE LET SPOL(2),SPLNO,IERR BE INTEGER !TWO LINES INITIALIZE SPOL TO "SPOL" INITIALIZE SPLNO TO 1 INITIALIZE SIZE1 TO 16 LET E BE CONSTANT(42440K) LET EXIT BE CONSTANT(42530K) LET SEC BE CONSTANT(123456K) LET IOPTN BE CONSTANT(3) ! G1CIN: SUBROUTINE GLOBAL INIT: CALL ST.LU CALL G1IMS(G0NJB) !INITIALIZE THE BATCH IFNOT [SAVE1 _ G0P1V] > 0 THEN [ \SYSTEM. GET # OF JOBS. INIT1: CALL GERR; GOTO INIT] ! SIZE _ 3 IF G0P1V > 254 THEN GOTO INIT1 IF [SAVE _ G0P1V - 6] <= 0 THEN \FIGURE OUT THE SIZE OF GOTO CRJOB !JOBFIL, AND CREATE IT. IF (SAVE AND 7K) THEN \ SIZE _ SIZE + 1 SIZE _ (SAVE >-3) + SIZE CRJOB: SPDIS_G0P2V !SET THE DISC FOR JOBFIL CALL CREAT(G0DCB,IERR,G0JBF,SIZE,2,SEC,SPDIS) CALL CRERR(G0JBF) !CHECK FOR ERRORS CALL G1ZAP(PBUFX) CALL RNRQ(20K,IRN,SAVE) !ALLOCATE JOBFIL RN. PBUFX _ IRN !PUT IT IN JOBFIL. CALL G1WFI(PBUFX,0) ? [GOTO EXIN] PBUFX _ 0 !INITIALIZE FIRST 2 REPEAT 15 TIMES DO [ \JOBFIL SECTORS. CALL G1WFI(PBUFX,0) ? \ [GOTO EXIN]] NSP: CALL G1IMS(G0NSP) !GET # OF SPOOL FILES. IF [NSPL,BUFX2 _ G0P1V] > 80 THEN [ \MAKE SURE IT IS NOT NSP1: CALL GERR; GOTO NSP] !MORE THAN 80. IFNOT NSPL > 4 THEN GOTO NSP1 SZS: CALL G1IMS(G0SZF) !GET SIZE OF SPOOL FILES. IFNOT G0PBF = 1 THEN GOTO SZS1 !MAKE SURE NUMERIC. IFNOT [SSPOL,BUFX3 _ G0P1V] > 0 THEN [\MAKE SURE IT IS NON-ZERO. SZS1: CALL GERR; GOTO SZS] BUFX1 _ [SIZE _ SAVE1 + 18] PBUFX _ IRN !PUT IN RN NUMBER. RNRQ(20K,WRN,SAVE) !ALLOCATE HOLD BEM RN. BUX14 _ WRN WRT1: CALL G1WFI(PBUFX,0) ? [GOTO EXIN] !WRITE JOBFIL RECORD 17. NOL: CALL G1ZAP(PBUFX) ADDR _ @PBUFX-1; FFILE _ 1 REPEAT 8 TIMES DO [ \GET # OF SPOOL FILES CALL G1IMS(G0NLO); \AT EACH LOCATION AND IF G0P1V = E THEN GOTO ADDUP; \MAKE UP JOBFIL $[ADDR _ ADDR+1] _ (G0P1V <-8) \RECORD 18. XOR FFILE; \ FFILE _ FFILE + G0P1V; \ $[ADDR _ ADDR+1] _ G0P2V] ADDUP: ADDR _ @PBUFX-2 ;SAVE1 _ 0 !CHECK IF THE # OF FILES REPEAT 8 TIMES DO [ \AT EACH LOCATION AGREES SAVE1 _ (($[ADDR _ ADDR+2] -<8) \WITH THE TOTAL # OF AND 377K) + SAVE1] !FILES. IFNOT SAVE1 = NSPL THEN [ \IF DISAGREE, DO OVER. CALL GERR; GOTO NOL] WRT2: CALL G1WFI(PBUFX,0) ? [GOTO EXIN] !WRITE JOBFIL RECORD 18. CALL G1ZAP(G0BUF) G0BUF _ -1 FOR SAVE _ 19 TO SIZE DO [ \INITIALIZE REST OF CALL G1WFI(G0BUF,0) ? \JOBFIL. [GOTO EXIN]] ! ! MNS: CALL G1IMS(G0MXP) !GET SPLCON INFORMATION. IFNOT G0PBF = 1 THEN GOTO MNS1 IFNOT [BUFX1 _ G0P1V + N.SEQ] >= NSPL\GET MAXIMUM # THEN [ \ MNS1: CALL GERR; GOTO MNS] !OF SPOOL FILES. IFNOT [BUFX4 _ G0P1V] > 0 \ THEN GOTO MNS1 BUFX2 _ 0; ADDR _ @BUFX5 REPEAT 11 TIMES DO THRU LUSET LUN: CALL G1IMS(G0SLU) !GET LOGICAL UNIT IF G0P1V = E THEN GOTO ALLDN !NUMBERS FOR IF [G0P1V_G0P1V AND 77K] < 3 THEN GO TO LUNER !LU 1,2 ILL CALL EXEC(100015K,G0P1V,EQT5) !GET DRIVER TYPE GO TO LUNER !BAD LU ERROR IF (EQT5 AND 36000K)=14000K THEN[ \DISC ILLGAL LUNER: GERR;GO TO LUN] !REPORT ERROR AND TRY IFNOT [G0P2V_G0P2V AND 17K] THEN G0P2V_4 !DEFAULT DEPTH $[ADDR _ ADDR+1] _ G0P1V+G0P2V*400K !LEVEL IN HIGH HALF LUSET: BUFX2 _ BUFX2 + 1 ALLDN: IF (BUFX1 AND 7K) THEN SIZE _ 1, \ ELSE SIZE _ 0 SIZE _ (BUFX1 >-3) + SIZE + BUFX2 + 1 CCR: CREAT(G0DCB,IERR,G0SPF,SIZE,2,SEC,SPDIS)!CREATE SPLCON. CALL CRERR(G0SPF) BUFX3 _ ((BUFX2+1) <-3) + 1 RNRQ(20K,PBUFX,SAVE) !ALLOCATE SPLCON RN. ADDR _ @BUFX5 CALL G1ZAP(G0BUF) G1WFI(G2BUF,2) ? [GOTO EXIN] !WRITE 2ND SPLCON REC. G0WD1 _ WRN REPEAT 6 TIMES DO [G1WFI(G0BUF,0) \ ? [GOTO EXIN]] G0WD1 _ 0 REPEAT BUFX2 TIMES DO [ \SET UP LOGICAL UNIT G0BUF _ $[ADDR _ ADDR+1]; \SECTORS IN SPLCON. $ADDR_$ADDR AND 77K; \ISOLATE THE LU G1WFI(G0BUF,0) ? [GOTO EXIN]; \ G0BUF _ 0; \ REPEAT 7 TIMES DO [ \ CALL G1WFI(G0BUF,0) ? \ [GOTO EXIN]]] CALL G1ZAP(G0BUF); G0BUF _ -1 REPEAT BUFX1 TIMES DO [ \ CALL G1WFI(G0BUF,0) ? [GOTO EXIN]] ! CALL G1WFI(PBUFX,1)?[GOTO EXIN] !WRITE 1ST SPLCON REC. ! CALL OPEN(G0DCB,IERR,G0JBF,3,SEC,SPDIS) !REOPEN JOB FILE CALL CRERR(G0JBF) CALL G1RD(PBUFX,18) !GET BACK RECORD 18 ADDR _ @PBUFX-1 REPEAT 8 TIMES DO THRU LAST !CREATE ALL THE SPOOL FFILE _ $[ADDR _ ADDR+1] AND 377K !FILES. SAVE1 _ (($ADDR -<8) AND 377K)+FFILE-1 ICR _ $[ADDR _ ADDR+1] FOR FFILE _ FFILE TO SAVE1 DO [ \ IF [SPLNO _ KCVT(FFILE)] \  < 30000K THEN SPLNO _ \ SPLNO OR 30000K ; \ CALL CREAT(G0BUF,IERR,SPOL, \ SSPOL,3,SEC,ICR); \ IF IERR= -6 THEN GO TO TRUN; \ CALL CRERR(SPOL)] LAST: ! CALL CLOSE(G0BUF) EXINT: CALL CLOSE(G0DCB) !CLOSE THE FILE AND RETURN ! ! TRUN: CALL G1RD(G0BUF,17) !SET UP JOB FILE FOR G0WD2_FFILE -1 !THE ACTUAL NUMBER OF FILES CALL G1WFI(G0BUF,17) !WRITE IT OUT CALL CLOSE(G0DCB) !CLOSE THE FILE MS_KCVT(FFILE-1) !SET UP THE MESSAGE CALL CNUMD(ICR,DNO) CALL G1OMS(NOROM) !SEND NO ROOM MESSAGE GO TO AGAIN END ! ! CRERR: SUBROUTINE(FIN) IF IERR > 0 THEN RETURN !IF NO ERRORS RETURN IF IERR = -2 THEN [CALL .DFER(MESS,FIN); \IF DUP NAME CALL G1OMS(DUPNM); \SEND MESSAGE AND GET ANS. AGAIN: CALL G1IMS(DINIT); \SEND MESSAGE AND GET ANS. IF G0P1V = "YE" THEN[CALL G1CDA(-1); GO TO INIT]] EXIN: CALL G1CQQ(SIZE) !SEND ERROR MESSAGE CALL G1OMS(G0END) !SEND END MESSAGE CALL EXEC(6) !TERMINATE END ! ! ERROR REPORT SUBROUTINE ! GERR: SUBROUTINE DIRECT IERR_2 !SET THE ERROR CODE CALL G1CQQ(SIZE) !PRINT THE MESSAGE RETURN END END END$  SPL,L,O ! NAME: G1CDA ! SOURCE: 92002-18001 ! RELOC: 92002-16001 ! PGMR: G.A.A. ! ! *************************************************************** ! * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1975. ALL RIGHTS * ! * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * ! * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* ! * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ! *************************************************************** ! NAME G1CDA(8)"92002-16001 760627" ! LET G1OMS,G1ZAP,G1WFI BE SUBROUTINE,EXTERNAL LET G1CQQ,EXEC,G1IMS BE SUBROUTINE,EXTERNAL LET .DFER BE SUBROUTINE,EXTERNAL,DIRECT ! LET KCVT BE FUNCTION,EXTERNAL LET POST,PURGE,OPEN,CLOSE BE SUBROUTINE,EXTERNAL LET RNRQ BE SUBROUTINE,EXTERNAL LET G1CEX,G1CSD,G1RD,G1OPN BE SUBROUTINE,EXTERNAL LET FERR BE SUBROUTINE ! LET G0END,G0NJB,G0NLO,G0SZF,G0NSP BE INTEGER,EXTERNAL LET G0MXP,G0SLU BE INTEGER,EXTERNAL ! LET G0EXN,G0JBF,G0SPF BE INTEGER,EXTERNAL LET G0DCB BE INTEGER,EXTERNAL !LINES LET G0BUF,G0WD1,G0WD2,G0WD3 BE INTEGER,EXTERNAL LET G0WD4 BE INTEGER,EXTERNAL LET G0WD7,G0WD8,G0WD9,G0W10,G0W11 \ BE INTEGER,EXTERNAL LET G0W15 BE INTEGER,EXTERNAL LET G0PBF BE INTEGER,EXTERNAL LET G0P1V BE INTEGER,EXTERNAL LET G0P2V BE INTEGER,EXTERNAL LET G0NOP BE INTEGER,EXTERNAL LET G0SDN,G0JDN BE INTEGER,EXTERNAL LET G0TTY,G0RDS,G0ERH BE INTEGER,EXTERNAL ! LET RESON(8),MES(3) BE INTEGER INITIALIZE RESON TO 10,"ERROR ON FILE " LET CLEAN(8) BE INTEGER INITIALIZE CLEAN TO 7,"SPOOL IS DEAD!" LET REALY(9) BE INTEGER INITIALIZE REALY TO 8,"KILL SPOOLING? _" LET SIZE,SIZE1 BE INTEGER !DO NOT REARRANGE THESE LET SPOL(2),SPLNO,IER,I BE INTEGER !TWO LINES INITIALIZE SPOL  TO "SPOL" INITIALIZE SPLNO,IER TO 1,0 LET SEC BE CONSTANT(123456K) LET RLF BE CONSTANT(40040K) !RN RELEASE CODE WORD ! G1CDA: SUBROUTINE(F) GLOBAL IF F # -1 THEN[CALL G1IMS(REALY); \IF NOT FROM INIT IF G0P1V # "YE" THEN RETURN] !THEN MAKE SURE. ! ! FIRST CALL SHUT DOWN ! IF G0JDN THEN[IF G0SDN THEN GO TO DOWN] IER _ 0 CALL G1CSD(SIZE1) ! ! FIRST GET THE NUMBER OF SPOOL POOL FILES TO PURGE ! DOWN: CALL OPEN(G0DCB,IER,G0JBF,0,SEC) !OPEN JOB FILE IF IER = 2 THEN GO TO RD17 !IF NO ERROR JUMP IF IER = -6 THEN[SPNO_80;GO TO GOTNO] !IF NO FILE PURGE 80 ! CALL FERR(G0JBF) !REPORT ANY OTHER ERROR GO TO EX !AND GET OUT ! ! RD17: CALL G1RD(G0BUF,17) !GET RECORD 17 SPNO_G0WD2 !SET THE COUNT ! GOTNO: FOR I_1 TO SPNO DO THRU X SPLNO_KCVT(I) IF SPLNO < 30000K THEN SPLNO_SPLNO OR 30000K !FIX IF 01-09 CALL PURGE(G0DCB,IER,SPOL,SEC) !PURGE THE FILE IF IER > -1 THEN GO TO X IF IER = -6 THEN GO TO X !IF NO FILE OR NO ERROR CALL FERR(SPOL) !DON'T WORRY, ELSE REPORT GO TO EX !AND STOP X: !END OF LOOP CALL OPEN(G0DCB,IER,G0JBF,0,SEC) !REOPEN THE JOB FILE IF IER # 2 THEN GO TO PUSP !IF ERROR SKIP ! CALL G1RD(G0BUF,17) !GET THE RN'S TO CORE CALL RNRQ(RLF,G0BUF,IS) !RELEASE THE TWO RN'S GO TO NEX1 NEX1: CALL RNRQ(RLF,G0W14,IS) GO TO NEX2 NEX2: CALL PURGE(G0DCB,IER,G0JBF,SEC) !PURGE JOB FILE IF IER < 0 THEN CALL FERR(G0JBF) !REPORT ERRORS ! PUSP: CALL OPEN(G0DCB,IER,G0SPF,0,SEC) !NOW GET SPLCON IF IER #2 THEN[ \IF ERROR REPORT IT Z: CALL FERR(G0SPF);GO TO m EX] !AND EXIT ! CALL G1RD(G0BUF,1) !GET THE FIRST RECORD CALL RNRQ(RLF,G0BUF,IS) !RELEASE THE RN. GO TO NEX3 NEX3: CALL PURGE(G0DCB,IER,G0SPF,SEC) !PURGE THE FILE IF IER < 0 THEN GO TO Z !IF ERROR REPORT IT CALL G1OMS(CLEAN) !ELSE REPORT DONE EX: CALL G1OMS(G0END) !AND EXIT CALL EXEC(6) END ! ! FERR: SUBROUTINE(N) CALL .DFER(MES,N) !SET UP THE FILE NAME CALL G1OMS(RESON) !SENT IT CALL G1CQQ(SIZE) !CALL ?? TO SEND THE FULL MESSAGE RETURN END END END$ J" F. 92067-18029 1805 S C0122 &JOB4 RTE-IV JOB             H0101 ASMB,R,L,C HED JOB ROUTINE * NAME: JOB * SOURCE: 92067-18029 * RELOC: 92067-16028 * PGMR: A.M.G. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1975. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM JOB,2,30 92067-16028 REV. 1805 760715 SUP * EXT EXEC SYSTEM CALLS EXT RMPAR PARAMETER RETRIEVAL EXT $PARS SYSTEM PARSE ROUTINE EXT OPEN FILE MANAGER OPEN EXT READF FILE MANAGER READ EXT WRITF FILE MANAGER WRITE EXT $LIBR CALL FOR PRIVILEGED OPERATION EXT $LIBX LEAVE PRIVILEGED OPERATION EXT CLOSE FILE MANAGER CLOSE FILE EXT REIO REENTRANT I/O ROUTINE EXT .DRCT PICK UP DIRECT ADDRESS EXT RNRQ RESOURCE NUMBER CONTROL EXT POST POST FILE BUFFER EXT .DFER MOVE THREE WORDS ROUTINE EXT LURQ LOCK LU ROUTINE EXT SPOPN SPOOL OPEN ROUTINE EXT $LUAV SPOOL LU TABLE * IDCB BSS 144 ONBF BSS 4 DO NOT REARRANGE THESE BUFFERS COMND BSS 16 BUFR2 BSS 17 BUFR BSS 41 SAVE BSS 1 SAVE1 BSS 1 RECNO BSS 1 RECNT BSS 1 FILNO BSS 1 SPLU BSS 1 IBUFL BSS 1 BUFL1 BSS 1 OLU OCT 401 * ORG IDCB PUT INIT CODE IN BUFFERS * BEM JSB RMPAR RETRIEVE PARAMETERS. DEF *+2 DEF COMND+5 LDA COMND+5 IS FIRST PARAMETER ASCII? SSA OR NEGATIVE JMP BEM2 FORGET INTERACTIVE SET UP * ADA CCOMP SSA,RSS JMP BEM2 YES. * LDA COMND+5 GET INPUT DEVICE LU. SZA,RSS MAKE DEVICE 5 THE DEFAULT. LDA D5 IOR CNWD STA CONWD  ADA B200 FORM DYNAMIC STATUS COMMAND WORD STA DYSTA SAVE IT JSB EXEC CHECK IF INTERACTIVE DEF INTYS DEVICE DEF D13 DEF CONWD DEF EQT5 DEF CLRN DEF LKRN INTYS LDA EQT5 GET THE TYPE AND TYPW ISOLATE LDB CONWD PRESET B FOR INTERACTIVE INTY0 SZA,RSS IF ZERO THEN INTERACTIVE JMP INT SO GO SET UP * CPA TYP05 05 RSS COULD BE MUST CHECK SUBCHANNEL CPA TYP07 07 RSS AGAIN CHECK SUBCHANNEL JMP BEM1 NOT INTERACTIVE CONTINUE * LDA LKRN GET THE SUBCHANNEL AND D7 ISOLATE THE LOW BITS JMP INTY0 GO TEST FOR ZERO * INT STB OLU SET AS OUTPUT LU TOO CLA STA RDREC SET TO PROMPT JMP BEM2 SKIP THE LU LOCK IF INTERACTIVE * BEM1 JSB LURQ LOCK THE LU IF NOT INTERACTIVE DEF BEM2 DEF D1 LOCK WITH WAIT DEF CONWD THIS LU DEF D1 ONLY ONE OF THEM BEM2 CLA STA EOJSW CLEAR EOJ SWITCH. JMP OPFL3 GET OUT OF DCB FOR OPEN * TST0 EQU COMND+10-* ERROR MEANS WE ARE ABOUT TO OVERLAY * ORG BUFR SKIP OVER THE RU PRAMS * OPFL3 JSB OPEN OPEN JOBFIL DEF *+6 DEF IDCB DEF IERR DEF JOBFL DEF IOPTN DEF ISECU CPA M8 DID WE SUCCEED? JMP OPFL3 KEEP TRYING. * SSA JSB JERR OPEN ERROR. RING BELLS. * LDA D17 JSB GTREC GET JOBFIL RECORD 17. LDA BUFR2 SAVE JOBFIL RN. STA JRN LDA BUFR2+14 SAVE RN FOR HOLDING INSPOOLING. STA WRN LDA BUFR2+1 STA RECNT SAVE RECORD COUNT. JMP CLEAN SKIP OUT OF BUFFERS ORR BACK TO STD. CORE * * THE FOLLOWING CODE CLEANS UP AFTER THIS PROGRAM IF IT WAS * ABORTED WHILE DOING AN INSPOOL. * * TO CLEAN UP WE MUST: * * 1. CALL SMP TO KILL THE SPOOL POOL FILE (CLEANS UP SMP'S RECORDS) * 2. OPEN AND CLOSE THE POOL FILE PURGING EXTENTS (GET BACK DISC) * 3. CLEAR THE BIT MAP BIT THAT SAYS THE FILE IS ASSIGNED * 4. CLEAR THE JOBFILE RECORD(RETURN IT TO POOL) * 5. CLEAR THE FLAGS IN JOBFIL RECORD 17 THAT SAY THESE THINGS * MUST BE DONE * * THIS CODE IS DONE IN SUCH AN ORDER THAT NO MORE HARM IS DONE * IF IT IS ABORTED AT ANY TIME SO WATCH OUT DON'T REARRANGE IT. * * YES I KNOW IT WOULD BE FASTER AND TAKE LESS CODE BUT WE NEED * FAIL SAFE OPERATION HERE. * * FLAGS KEPT IN REC 17 TO HELP: * * WORD 10 SPLCON REC # OF SPOOL CON ENTRY (SAFE EVEN AFTER REBOOT) * WORD 11 WORD ADDRESS OF BIT MAP BIT TO CLEAR * WORD 12 BIT TO CLEAR IN SPOOL POOL BIT MAP * WORD 13 JOBFIL RECORD NUMBER OF RECORD TO CLEAR * CLEAN JSB LKRNP POST AND LOCK THE RN LDA D17 GET A CLEAN JSB GTREC RECORD 17 LDB BUFR2+10 GET THE SPLCON RECORD NUMBER IF ONE SZB,RSS IS THEIR? JMP NOSP NO SKIP SMP CALL * JSB CLRN CLEAR RN FOR SMP JSB EXEC CALL SMP TO CLEAN UP ITS RECORDS DEF *+5 DEF D23 DEF SMPA DEF D13 KILL CODE DEF BUFR2+10 RECORD NUMBER JSB LKRNP POST AND LOCK THE RN LDA D17 GET THE RECORD AGAIN JSB GTREC CLB CLEAR FLAG TO SHOW STB BUFR2+10 WE HAVE CALLED JSB WRTRC WRITE IT AND JSB POST1 MAKE SURE IT GETS TO THE DISC NOSP LDA BUFR2+13 NOW GO GET THE SZA,RSS JOB RECORD IF ONE JMP NJREC NO JOB RECORD SKIP RELEASE * JSB GTREC GET THE RECORD JSB OPEN OPEN THE SPOOL FILE (CLOSES JOBFIL) DEF *+7 DEF IDCB DEF IERR DEF BUFR2+3 NAM FROM JOBREC DEF ZERO EXCLUSIVE OPEN DEF ISECU SAME SECURITY CODE DEF BUFR2+6 CARTRIDGE JSB CLOSE CLOSE IT AND TRUNCATE tEXTENTS DEF *+4 DEF IDCB DEF IERR DEF M8 NEGATIVE NO TO PURGE EXTENTS OPN2 JSB OPEN RE OPEN JOBFILE DEF *+6 DEF IDCB DEF IERR DEF JOBFL DEF IOPTN DEF ISECU CPA M8 OK? JMP OPN2 NO LOCKED TO ANOTHER * SSA ERROR? JSB JERR REPORT AND EXIT * CCA STILL HAVE JOB RECORD AND RN LOCK STA BUFR2 CLEAR USAGE FLAG JSB WRTRC WRITE IT OUT LDA D17 NOW RETRIEVE JSB GTREC RECORD 17 CLA CLEAR THE RECORD FLAG STA BUFR2+13 NJREC LDB BUFR2+11 GET THE OFFSET TO SZB,RSS THE BIT MAP JMP NBITS NONE * ADB DBUF INDEX TO THE WORD LDA BUFR2+12 GET THE BIT TO BE CLEARED CMA CHANGE TO AND MASK AND B,I CLEAR THE BIT STA B,I SET IT BACK CLA STA BUFR2+11 CLEAR THE PRESENTS FLAG NBITS JSB WRTRC WRITE IT OUT JSB CLRNP POST AND CLEAR THE RN * * END OF CLEAN UP CODE * LDA COMND+5 IS THE FIRST PARAMETER SSA NEGATIVE?? JMP TERM YES CALL WAS TO CLEAN UP ONLY * ADA CCOMP AN ASCII PARAMETER? SSA IF SO, TREAT AS A JMP RDREC SIMULATED XEQ. * * JSB EXEC READ THE STRING DEF STRTN DEF D14 DEF D1 DBUFX DEF BUFR DEF BUFLN STRTN SZB,RSS IF NO STRING JMP TERM JUST EXIT * LDA DBUFX GET THE BUFFER ADDRESS JSB $LIBR PARSE THE RECORD NOP JSB $PARS USE SYSTEM ROUTINE DEF ONBF JSB $LIBX DEF *+1 DEF *+1 GO DO THE XEQ THING JSB XEQQ DO XEQ THING JMP TERM GO EXIT * EQT5 NOP TYP05 OCT 2400 TYP07 OCT 3400 TYPW OCT 37400 DYSTA NOP * * RDREC JMP NACT IF NOT INTERACTIVE JUMP * JSB EXEC ELSE SEND A DEF NA+CT ";" DEF NWWC WRITE REQUEST DEF OLU AS A PROMPT DEF SCOL DEF M2 NACT NOP IGNORE ERRORS. JSB REIO READ A CARD (OR TAPE LINE). DEF *+5 DEF RCODE DEF CONWD DBUFR DEF BUFR DEF BUFLN STB IBUFL CMB,INB STB BUFL1 STA STAT SAVE STATUS WORD. STA LASTH CLEAR LAST HOLD FLAG RAL,CLE,ELA MOVE DOWN BIT TO E REG. ALF,RAL MOVE EOF BIT TO SIGN RAL POSITION. SSA JMP EOF EOF CONDITION. * SZB ZERO LENGTH? JMP PRS NO - NORMAL RECORD. * AND B70 IF DEVICE TYPE < 10 OR SEZ,CCE,SZA DEVICE NOT DOWN, THEN EOF. JMP NACT ELSE RETRY THE READ. * JMP EOF * WRIT NOP WRITE A RECORD ROUTINE JSB REIO WRITE THE CARD TO CURRENT SPOOL FILE. DEF *+5 DEF NWWC DEF ICNWD DEF BUFR DEF BUFL1 JSB JERR ERROR CONDITION - FLUSH THE JOB. * JSB TSTEX TEST EXTENT OVERFLOW JMP WRIT,I OK EXIT * JMP WRIT+1 TRY AGAIN IF NEEDED * PRS LDA BUFR AND MASKL CPA COLON IS THIS A BM COMMAND CARD? JMP PRCOM YES. PARSE IT. * OTHER CLA CPA EOJSW ARE WE READING IN A JOB? JMP RDREC NO. IGNORE THE CARD. * WRREC JSB WRIT WRITE THE CARD TO CURRENT SPOOL FILE. * LDA STAT HAVE WE AN EOF ALF,ALF CONDITION? SSA,RSS JMP RDREC NO - GO READ NEXT CARD. * AND B77 YES - IS THIS A PT READER? CPA RCODE RSS YES - DO AN EOF. JMP RDREC * JSB WAITM WRITE OUT A MESSAGE ASC 3,PT D7 DEC 7 MESSAGE LENGTH JSB EXEC NOW PAUSE UNTIL DEF CONT THE OPERATOR PUTS DEF D7 THE NEXT TAPE IN THE DEF ZERO AND SETS JOB GOING DEF RCODE AGAIN. CONT WJMP RDREC LOOK FOR MORE INPUT. * TSTEX NOP TEST FOR EXTENT OVERFLOW ALF,ALF GET EOF BIT TO SIGN SSA,RSS EOF SET? JMP TSTEX,I NO RETURN OK * JSB EXEC CAN USE EXEC CALL BECAUSE DEF *+3 THIS CALL JUST REMOVES THE EOF STATUS DEF D3 DEF BSCWD BACK SPACE TO BE READY TO RETRY * LDA LASTH HAVE WE ALREADY SENT THE MESSAGE? SZA,RSS JMP WEXT YES JUST WAIT * CLA SET FLAG TO SHOW ALREADY SENDT STA LASTH JSB WAITM SEND THE EXTENT WAIT MESSAGE ASC 3,EXTENT B11 OCT 11 9 WORDS * WEXT JSB WAIT WAIT FOR THE RN ISZ TSTEX TRY AGAIN JMP TSTEX,I EXIT IS P+2 * EOF LDA EOJSW HOPPER EMPTY OR EOT. SZA,RSS JMP TERM TERMINATE IF NOT READING A JOB. * CLA * STA BUFL1 WRITE 0 LENGTH RECORD. JMP WRREC * TERM JSB CLOSE DEF *+4 DEF IDCB DEF IERR DEF ZERO CLA,INA CLEAR JOBFIL RN IF NECESSARY. CPA JSTAT RSS JSB CLRN JSB EXEC TERMINATE THE BEM. DEF *+2 DEF D6 * * PRCOM LDA DBUFR JSB $LIBR PARSE A BM COMMAND. NOP LDB IBUFL JSB $PARS DEF COMND JSB $LIBX DEF *+1 DEF *+1 LDA BUFR XOR BUFR+1 GET SECOND TWO CHARS AND B377 XOR BUFR+1 ALF,ALF NOW HAVE TWO AFTER THE ':' CPA "EO" JMP EOJCD :EOJ * CPA "XE" JMP XEQ :XEQ * CPA "JO" RSS JMP OTHER * CLA :JOB CPA EOJSW JMP OPFIL * JSB EOJ CLOSE LAST SPOOLFILE. OPFIL JSB LKRNP JSB JSRCH FIND A JOB RECORD LDA D17 JSB GTREC GET JOBFIL RECORD 17. LDA M5 STA BUFR2+9 TRY TO FIND AN AVAILABLE LDA WD4AD STA CLRN CLA,INA SPOOL FILE  STA FILNO CLB,INB CCA STA CLEAR OLOOP LDA M16 STA BUFR2+11 ILOOP LDA CLRN,I AND B SZA,RSS JMP HAVIT * NOT1 RBL ISZ FILNO ISZ BUFR2+11 JMP ILOOP * ISZ CLRN ISZ BUFR2+9 JMP OLOOP * JSB POST1 NOHAV JSB CLRN WAIT UNTIL THERE IS AN JSB HLDIN AVAILABLE SPOOL FILE. JMP OPFIL * D10 DEC 10 "00" ASC 1,00 D3 DEC 3 SVBIT NOP * HAVIT ISZ CLEAR TEST IF FIRST AVAILABLE FILE RSS IF SECOND SKIP TO USE IT JMP NOT1 DO NOT USE FIRST ONE (LEAVE FOR OUT SPOOL) * LDA FILNO SET UP THE SPOOL USAGE FLAG CMA,INA DIVISION OF FILE # BY 16. ADA BUFR2+2 IS FILNO > # OF SPOOL SSA POOL FILES? JMP NOHAV YES - NO GOOD. * LDA CLRN,I NO - OK. XOR B FIX AVAILABILITY BITS. STB SVBIT SAVE BIT FOR REC 17 STA SAVFL SAVE THE NEW WORD LDA D18 HAVE AN AVAILABLE SPOOL FILE. JSB GTREC GET JOBFIL RECORD 18. CLB SET UP FOR DIVIDE LDA FILNO CONVERT THE FILE NUMBER TO ASCII DIV D10 ALF,ALF A HAS HIGH ORDER, B LOW ADA B ADA "00" ADD THE ASC '00' STA SAVE1 LDA BUFAD FIND THE LOCATION INFORMATION STA SAVE FOR THE FILE. RANGE LDA SAVE,I ALF,ALF ADA SAVE,I AND B377 CMA,INA ADA FILNO ISZ SAVE SSA JMP *+3 * ISZ SAVE JMP RANGE * LDA SAVE,I STA SAVE LDA DBUF2 JSB CLEAR LDA SAVE STA BUFR2+6 SAVE DISC LABEL. LDA SAVE1 STA BUFR2+5 LDA SPOL STA BUFR2+3 SAVE FIRST PART OF FILE NAME. LDA SPOL+1 STA BUFR2+4 LDB "I" FINISH SETTING UP THE JOBFIL JSB FJOBF ENTRY. JSB .DRCT DEF COMND JSB CLEAR JSB .DFER FORM  THE BUFFER TO PASS DEF COMND+2 TO THE SMP. DEF BUFR2+3 MOVE JOB LOCATION. LDA BUFR2+6 STA COMND+6 CARTRIDGE ID. LDA ISECU STA COMND+5 SECURITY CODE. LDA DFLAG STA COMND+8 DISPOSITION FLAGS. LDA RECNO JOBFIL RECD. # OF JOB. STA COMND+11 STA NUM WRITE THE JOB RECORD AND JSB WRTRC SET UP TO UPDATE LDA D17 RECORD 17 JSB GTREC AND LDA RECNO SET THE IN STA BUFR2+13 PROCESS FLAG LDA SAVFL SET THE SPOOL FILE STA CLRN,I IN USE FLAG LDA SVBIT GET THE BIT POSITION STA BUFR2+12 SET IT LDA DBUF COMPUTE THE BUFFER OFFSET CMA,INA TO THE BIT ADA CLRN AND STA BUFR2+11 SET THAT JSB WRTRC AND WRITE THE RECORD JSB CLRNP POST AND UNLOCK THE FILE * STUP2 CLA STA COMND+7 DRIVER TYPE. JSB SPOPN CALL TO OPEN THE SPOOL FILE DEF *+3 RETURN DEF COMND SET UP BUFFER DEF SPLU THE LU LDA SPLU GET THE LU THAT IS PASSED BACK SSA,RSS WAS SETUP SUCCESSFUL? JMP STUP1 YES, GO DO IT * JSB HLDIN NO WAIT UNTIL AN LU OR SUCH JMP STUP2 FREES UP. SMP WILL CALL BACK. * STUP1 STA EOJSW STA ICNWD SET CONTROL WORD FOR WRITES. ADA B200 SET UP A BACKSPACE STA BSCWD FOR EXTENT PROBLEMS JSB LKRNP LOCK UP THE JOB FILE LDA D17 AND GET THE JOB RECORD JSB GTREC AGAIN JSB .DRCT GET THE LU FROM DEF $LUAV THE LU TABLE LDB A,I GET LENGTH STB CLRN SET FOR COUNT NXTLU INA STEP TO LU LDB A,I GET THE LU INA STEP TO THE RECORD NUMBER RBL,CLE,ERB CLEAR SIGN IF SET CPB SPLU THIS THE LU? JMP FSPLU YES GO SET UP * ISZ CLRN STEP COUNT JMP NXTLU TRY NEXT ONE * " JSB JERR REPORT NOT FOUND ERROR * FSPLU LDA A,I GET THE RECORD NUMBER STA BUFR2+10 SET IN THE JOB FILE REC 17 JSB WRTRC WRITE IT OUT JSB CLRNP POST AND CLEAR THE RN JMP WRREC GO WRITE OUT THE JOB CARD. * SAVFL NOP BSCWD NOP B200 OCT 200 * WAIT NOP JSB RNRQ LOCK THE WAIT RN GLOBALLY. DEF *+4 WHEN A CONDITION IN SMP DEF D2 FREES AN LU OR A FILE OR DEF WRN A FULL OUTSPOOL QUEUE, SMP DEF SAVE CLEARS THIS RN SO THAT OTHER JSB RNRQ PROGRAMS CAN CONTINUE. DEF *+4 DEF D6 DEF WRN LOCK THE RN. DEF SAVE JMP WAIT,I * HLDIN NOP LDA HLDIN GET ADDRESS OF LAST CALL CPA LASTH SAME?? JMP HLD1 YES DON'T RESEND THE MESSAGE * STA LASTH NO SET NEW ADDRESS AND SEND THE MESSAGE JSB WAITM SEND WAIT ON SPOOL RESOURCE MESSAGE ASC 3,SPOOL D13 DEC 13 HLD1 JSB WAIT WAIT FOR IT JMP HLDIN,I RETURN * WAITM NOP MESSAGE FIXER AND SENDER JSB .DFER FIX UP THE MESSAGE DEF MES MOVE IN THE 3 WORDS DEF WAITM,I STA WAITM SET THE ADDRESS OF THE LENGTH JSB EXEC DEF *+5 DEF D2 DEF OLU DEF RESWT DEF WAITM,I ISZ WAITM ADVANCE THE RETURN ADDRESS AND JMP WAITM,I RETURN * LASTH NOP ADDRESS OF LAST HOLD * XEQ CLA CPA EOJSW IF THERE IS A JOB SPOOL RSS NOT COMPLETED, THEN END IT. JSB EOJ JSB XEQQ DO XEQ THING JMP RDREC GO GET NEXT RECORD * * XEQQ NOP XEQ SUBROUTINE JSB JSRCH SEARCH FOR A PLACE TO PUT THIS. LDA DBUF2 JSB CLEAR LDB "R" JSB FJOBF SET UP THE JOBFIL RECORD. LDB JNAMA GET JOB NAME ADDRESS LDA COMND+4 IF LU CPA D1 SUPPLIED LDB DCOM5 USE IT STB MVNAM SET ADDRESS JSB .DFER DEF BUFR2+3 MVNAM NOP USE CLEANED UP NAME LDA COMND+13 GET THE CR INFO STA BUFR2+6 AND SET IT JSB QUEUE WRITE IT OUT. JMP XEQQ,I RETURN * EOJCD CLA CPA EOJSW JMP RDREC * JSB WRIT WRITE THE EOJ RECORD JSB EOJP PROCESS THE EOJ JSB EXEC DO DYNAMIC STATUS DEF RTNST DEF D3 DEF DYSTA RTNST ALF,ALF RAL,RAL HOPPER EMPTY? SSA,RSS JMP RDREC NO CONTINUE * RAR,RAR ISOLATE DRIVER TYPE AND B73 CPA B11 CARD READER? (CHECKS 11 OR 15) JMP TERM YES - TERMINATE. * JMP RDREC NO CONTINUE * B73 OCT 73 * EOJ NOP JSB REIO PUT AN ":EOJ" IN THE BUFFER TO BE DEF *+5 DEF WCODE DEF ICNWD DEF EOJC DEF D2 JSB TSTEX TEST FOR EXTENT OVERFLOW RSS NO CONTINUE JMP EOJ+1 YES TRY AGAIN * JSB EOJP PROCESS THE EOJ JMP EOJ,I RETURN * EOJP NOP EOJ COMMON PROCESSOR JSB EXEC SCHEDULE THE SMP TO CLOSE THE DEF *+5 SPOOL FILE. PASS IT THE CLOSE DEF D23 CODE AND THE LU# OF THE SPOOL DEF SMPA DEF D4 DEF SPLU JSB LKRNP MAKE SURE BUFFER IS CLEAR LDA RECNO JSB GTREC GET APPROPRIATE JOBFIL RECORD. LDA BUFR2+2 GET THE STATUS AND B377 IN CASE GASP HAS BEEN HERE CPA "H" NOW IN HOLD? LDA "RH" YES MAKE "RH" CPA "I" WHAT IT SHOULD BE? LDA "R" YES SET "R" STA BUFR2+2 JSB QUEUE WRITE OUT AND Q THE JOBFIL RECORD. JSB LKRNP POST AND LOCK LDA D17 CLEAR THE INPUT IN PROGRESS JSB GTREC FLAG IN CLA RECORD STA BUFR2+10 STA BUFR2+11 STA BUFR2+12 17. STA BUFR2+13 JSB WRTRC SEND IT BACK TO THE DISC. JSB CLRNP UNLOCK THE FILE JMP EOJP,I RETURN * QUEUE NOP WRITE OUT JOB RECORD AND QUEUE IT JSB WRTRC WRITE IT OUT LDA BUFR2+2 GET STATUS CPA "RH" IF HELD JMP QUEUE,I JUST RETURN * LDA BUFR2 STA SAVE SAVE JOB PRIORITY. CLB CCA COMPUTE THE ADDRESS OF ADA RECNO THE QUEUE FLAG DIV D16 ADB DBUF CALCULATE THE BUFFER ADDRESS STB SAVE1 SAVE IT JSB GTREC GET THE RECORD LDA SAVE SET THE PRIORITY STA SAVE1,I IN THE QUEUE JSB WRTRC WRITE THE RECORD BACK OUT JSB POST1 POST THE FILE BUFFER. JSB CLRN CLA STA EOJSW JSB EXEC DEF *+4 SCHEDULE THE FILE MANAGER. DEF NWAIT DEF FLMAN DEF M5 JMP QUEUE,I * JMP QUEUE,I * "RH" ASC 1,RH "H" OCT 110 "I" OCT 111 "R" OCT 122 * WRTRC NOP JSB WRITF DEF *+6 DEF IDCB DEF IERR DBUF2 DEF BUFR2 DEF D16 DEF NUM LDA IERR SSA JSB JERR * JMP WRTRC,I * GTREC NOP STA NUM JSB READF DEF *+7 DEF IDCB DEF IERR DBUF DEF BUFR2 DEF D16 DEF LEN DEF NUM LDA IERR SSA JSB JERR * JMP GTREC,I * LEN BSS 1 NUM BSS 1 * POST1 NOP JSB POST DEF *+2 DEF IDCB JMP POST1,I * CLRNP NOP JSB POST1 JSB CLRN JMP CLRNP,I * LKRNP NOP JSB POST1 JSB LKRN JMP LKRNP,I * CLRN NOP JSB RNRQ DEF *+4 DEF D4 DEF JRN DEF JSTAT JMP CLRN,I * LKRN NOP JSB RNRQ DEF *+4 DEF RCODE DEF JRN DEF JSTAT JMP LKRN,I * JSRCH NOP JSR1 JSB POST1 JSB LKRN LDA D18 SEARCH FOR FREE JOBFIL RECORD. JSR2 INA JSB GTREC  LDA BUFR2 SSA,RSS JMP *+4 * LDA NUM STA RECNO JMP JSRCH,I * LDA NUM CPA RECNT RSS JMP JSR2 * JSB POST1 JSB CLRN NONE AVAILABLE. WAIT UNTIL JSB HLDIN THERE IS. JMP JSR1 * CLEAR NOP LDB M16 STB FJOBF CLB STB A,I INA ISZ FJOBF JMP *-3 * JMP CLEAR,I * FJOBF NOP STB BUFR2+2 LDB COMND+8 IF PRIOITY IS ASCII CPB D2 THEN USE DEFAULT CLA,RSS LDA COMND+9 STORE PRIORITY, STATUS, JOB NAME, SZA,RSS LDA DEFPR DEFAULT PRIORITY, IF NECESSARY. CPA NSPRM LDA DEFPR STA BUFR2 LDA M18 ADA RECNO STA BUFR2+1 STORE JOB #. LDA M6 STA CNTR LDB DCOM5 CLE,ELB STB UPTR LDB JNAMA CLE,ELB STB PPTR FXNM1 LDA BLANK LDB UPTR SZB JSB UNPAK CPA RCOLN JMP BLFIL * SZA,RSS JMP BLFIL * JSB PAK ISZ CNTR JMP FXNM1 * JMP FJOBF,I * BLFIL CLB STB UPTR JMP FXNM1 * JNAMA DEF BUFR2+7 CNTR BSS 1 M6 DEC -6 * UPTR NOP UNPAK NOP LDB UPTR ISZ UPTR CLE,ERB LDA B,I SEZ,RSS ALF,ALF AND B377 JMP UNPAK,I * PCHAR NOP PPTR NOP PAK NOP STA PCHAR LDB PPTR ISZ PPTR CLE,ERB LDA B,I SEZ ALF,ALF AND B377 ALF,ALF IOR PCHAR SEZ,RSS ALF,ALF STA B,I JMP PAK,I * JERR NOP JSB EXEC SEND ERROR MESSAGE DEF EXMS DEF D2 DEF OLU DEF TERMM DEF D7 EXMS JMP TERM * A EQU 0 B EQU 1 DEFPR DEC 9999 NSPRM ASC 1,NS NWAIT OCT 100012 FLMAN ASC 3,FMGR D5 DEC 5 SPOL ASC 2,SPOL TERMM ASC 7,END JOB ABNORM DCOM5 DEF COMND+5 CCOMP OCT -20000pNLH BLANK OCT 40 RCOLN OCT 72 M2 DEC -2 SCOL ASC 1,;_ PROMPT RCODE DEC 1 IOPTN OCT 3 WCODE DEC 2 D2 EQU WCODE DFLAG OCT 40021 B70 OCT 70 B77 OCT 77 B377 OCT 377 M5 DEC -5 BUFAD DEF BUFR2 BUFLN DEC -80 EOJSW BSS 1 JRN BSS 1 WRN BSS 1 JSTAT BSS 1 NWWC OCT 100002 MASKL OCT 177400 COLON OCT 35000 CNWD OCT 400 CONWD BSS 1 ICNWD BSS 1 STAT BSS 1 D6 DEC 6 D23 DEC 23 D4 DEC 4 ZERO DEC 0 D16 DEC 16 D17 DEC 17 D18 DEC 18 M18 DEC -18 WD4AD DEF BUFR2+4 IERR BSS 1 SMPA ASC 3,SMP JOBFL ASC 3,JOBFIL ISECU OCT 123456 M8 DEC -8 M16 DEC -16 "JO" ASC 1,JO "EO" ASC 1,EO EOJC ASC 1,:E ASC 1,OJ "XE" ASC 1,XE D1 DEC 1 D14 DEC 14 RESWT ASC 6,JOB WAIT ON SPOOL RESOURCE MES ASC 3,SPOOL ASC 4,RESOURCE. * ORG * END BEM N  92067-18030 1826 S C0222 &4D431 RTE-IV DVS43             H0102 %+ASMB,R,Q,C,Z ASSEMBLE STATEMENT FOR RTE IV * HED SPOOL MONITOR DRIVER FOR RTE IV * NAME: DVS43 * SOURCE: 92067-18030 (RTE IV) * RELOC: 92067-16028 (RTE IV) * PGMR: A.M.G.,G.A.A.,C.M.M.,J.M.N. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM DVS43 92067-16028 REV.1826 780503 * ENT IS43,CS43,N.SEQ SUP * * * *** SPOOL EQT ENTRIES *** * * EQT1 SAME AS STANDARD * . * . * . * EQT7 SAME AS STANDARD (READ WRITE), BUFFER MASK (POST) * EQT8 TRANSFER AMOUNT IN WORDS * EQT9 USED TO SAVE TLOG WHILE WAKING SPOUT. * EQT10 RECORD LENGTH * EQT11 FLAGS: BIT 15 - 1 IF WRITE CALL TO INCOR * BIT 14 - BATCH CHECK FAILED ONCE * BIT 13 - EOF SENT BACK ONCE (OR BATCH * CHECK FAILED) * BIT 12 - HOLDING I/O ON THIS LU. * BIT 9,10,11- TRANSFER VECTOR FOR EXTND/TO * RETURNS: * 0= POST WAIT FOR XSIO CALL * 1= WAIT FOR EXTND TO START SPOUT * 2= WAIT FOR BUFFER ECT. IN INCOR * 3= WAIT FOR READ/WRITE EXTND * 4= WAIT FOR BACKSPACE EXTENT * 5= WAIT IN RWIND FOR EXTND * 6= NOT USED * 7= NOT USED * BIT 7,8- 00 READ AND WRITE * 01 READ ONLY * 10 WRITE ONLY * BIT 6 - NOT USED * BIT 5 - CLEAR IO IN PRGRESS * BIT 4 - ORDINARY FILE * BIT 3 - SPOOL POOL FILE * BIT 2 - REQUEST LENGTH IN CHARACTERS * BIT 1 - REQUEST INITIATED * BIT 0 - TEMP EOF FLAG * EQT12 # OF EXTENSION WORDS - BSREC OR PUSH/GETRD RETURN POINT SAVE * EQT13 POINTER TO EXTENSION * EQT14 SAME AS STANDARD * EQT15 SAME AS STANDARD * * *** EQT EXTENSION *** * * EQT16 EQT18 SAVE * EQT17 EQT19/EQT21 SAVE * EQT18 CURRENT TRACK * EQT19 CURRENT OFFSET * EQT20 FILE EXTENSION # * EQT21 CURRENT SECTOR # * EQT22 TRANSFER COUNTER * EQT23 CURRENT PACKING BUFFER ADDRESS * EQT24 BEGINNING TRACK IN THIS EXTENT * EQT25 BEGINNING SECTOR IN THIS EXTENT * EQT26 # OF SECTORS IN THE FILE (AND EACH EXTENT) * EQT27 TR/LU DIRECTORY ADDRESS OF * EQT28 OFFSET/SECTOR MASTER ENTRY. * EQT29 ID SEGMENT ADDRESS OF PGM REQUESTING INPUT CHECK * FILE COUNTER FOR SPOUT (ALWAYS NEGATIVE) * EQT30 # OF SECTORS PER TRACK * EQT31 RECORD COUNT * EQT32 SPOUT CLASS PARAMETER 1 * EQT33 SPOUT CLASS PARAMETER 2 * * * EXT $LIST RTE PROGRAM SCHEDULING EXT $XSIO RTE SYSTEM I/O EXT $XEQ SYSTEM IDLE LOOP EXT $ETEQ RTE - SETUP UP EQT ON BASE PAGE EXT $DRVM IN RTE IV TO SETUP USER MAP EXT $RSM IN RTE IV TO RESTORE PREVIOUS MAP EXT $UPIO IN RTE IV FOR CLEAR IO RETURN ******************** * ERROR EXITS * ******************** * * REJECT REQUEST ERROR CODES (CAUSE IOXX ERROR REPORTS) * * XX = 20 ATTEMPT TO READ A WRITE ONLY FILE * = 21 ATTEMPT TO READ PAST EOF * = 22 SECOND ATTEMPT TO READ A JCL RECORD (FIRST RETURNS EOF) * = 23 ATTEMPT TO WRITE ON A READ ONLY FILE * = 24 ATTEMPT TO WRITE PAST EOF (OR SPOOL FILE OVERFLOW) * = 25 REQUEST ON A EQT THAT HAS NOT BEEN SET UP WITH A FILE. * * EOF EXITS MADE ON READ OR WRITE REQUESTS (SEE BELOW) * * TLOG = 0 STANDARD EOF ALL OK IF READ, IF WRITE OF # 0 RECORD * IMPLIES FILE IS FULL. NEXT ATTEMPT TO WRITE WILL * CAUSE IO24 (SEE ABOVE) * = -1 EOF WAS A -2, MEANS FILE WAS TERMINATED FOR OVERFLOW * = -5 SAME AS FMGR -5 ERROR I.E. NO EXTENT ON READ OR LENGTHS * AT THE ENDS OF THE RECORD DON'T MATCH. HED SPOOL MONITOR DRIVER REQUEST DECODE SECTION N.SEQ NOP IS43 NOP LDA IS43 SRTNI STA RTNI SAVE FIRST RETURN ADDRESS CLA STA SRTNI * LDA EQT6,I TEST FOR CLEAR IO RQ AND B3777 CPA D3 JMP CLIO GO SET CLEAR IO FLAG JSB EXEQT LDA EQT27,I IS THIS SPOOL SZA,RSS EQT INITIALIZED? JMP ABORT NO - REJECT THE CALL. LDA EQT8,I STA EQT10,I CLB SSA,RSS JMP WDS * CMA,INA SLA,ARS INA STA EQT8,I LDB D4 WDS CMA SAVE NEG. OF # OF WORDS TO STA EQT22,I WORDS TO TRANSFER LDA EQT5,I CLEAR EOF BIT. IOR D128 XOR D128 STA EQT5,I LDA EQT11,I AND DISPM IOR B LDB A IF LAST EXIT WAS WITH BATCH CHECK RBL,ELB SEZ,RSS WELL WAS IT? JMP ST11 NO PROCEED * LDB EQT1,I YES IS THIS THE KEEPER OF THE CPB EQT29,I KEYS?? AND CLEOF YES CLEAR THE EOF FLAGS ST11 STA EQT11,I INITIALIZE EQT11 ALF,SLA HOLDING I/O TO THIS LU. JMP ABORT YES. AN ABORTING ERROR (SPOUT KNOWS) * LDA EQT18,I SAVE CURRENT FILE LOCATION STA EQT16,I IN CASE AN EXTENT IS NEEDED LDA EQT19,I AND NOT AVAILABLE AND B377 KEEP LOW BITS OF LENGTH (ITS <0) ALF,ALF IOR EQT21,I STA EQT17,I * LDA EQT6,I AND B77 LDB D20 SET UP THE ERROR CODE RBR,ELB 20 NORMAL, 21 IF POSSIBLE BATCH CHECK CPA D1 JMP RR READ REQUEST * LDB D23 SET FORR WRITE ERRORS CPA D2 JMP WR WRITE REQUEST * * COME HERE FOR CONTROL REQUEST * LDA EQT11,I ALF,ALF READ ONLY FILE? SSA JMP CR1 YES. * AND TFLAG DOES FILE HAVE HEADERS? SZA JMP CR1 NO. INTERPRET REQUEST. * STA EQT8,I SET UP TO PUT THE CONTROL CMA INFORMATION IN THE BUFFER STA EQT22,I TO BE WRITTEN OUT. JMP WR * CR1 LDA EQT6,I GET THE CONWD. RRR 6 AND B77 ISOLATE CONTROL FUNCTION CMA,INA,SZA,RSS DECODE THE REQUEST JMP ILL ZERO IS A BAD GUY. * LDB D23 INA,SZA,RSS 1 IS EOF JMP WREOF SO OFF TO THE EOF WRITER * INA,SZA,RSS 2 IS BACK SPACE RECORD JMP BSREC SO OFF THE THE BACK SPACE ROUTINE * INA,SZA,RSS 3 IS FORWARD SPACE RECORD JMP FSREC SO GO DO THAT * INA,SZA,RSS 4 IS REWIND JMP RWIND SO OFF TO DO IT * INA,SZA 5 IS ALSO REWIND CPA N7 14 IS BACKSPACE FILE BUT ONLY ONE SO REWIND RWIND CCA,RSS OFF TO IT. * JMP ILL NONE OF THE ABOVE CAN NOT DO IT * STA EQT20,I REWIND SPOOL FILE BY CALLING THE LDA B5000 EXTND PROGRAM TO GET JMP GTEXT EXTENT 0 (MASTER ENTRY). * * * RETURN TO RW2 AFTER EXTND CALL OR FROM BACKSPACE. * RW2 LDA DM128 MAKE SURE ALL POINTERS STA EQT19,I ARE CONSISTENT WITH * CLA CLEAR THE RECORD COUNT RW3 STA EQT31,I LDA EQT11,I CLEAR EOF BIT IF SET. AND CLEOF STA EQT11,I CLB RETURN A CLEAR TLOG JMP POST1 * ILL LDA D2 NONE OF THE ABOVE JMP RTRN REJECT REQUEST * ABORT LDA D25 SEND ABORT ERROR IO25 JMP RTRN RETURN * CLIO LDA EQT11,I SET CLEAR IO BIT IOR B40 STA EQT11,I CLA INITIATE RETURN JMP IS43,I * * COMMON8 RETURN POINT * RTRN STA XA SAVE A REG LDA EQT11,I IS CLEAR IO IN PROGRESS AND B40 SZA JMP $UPIO YES THEN GO TO UPIO LDA XA NO RESTORE A AND RETURN JMP RTNI,I * XA BSS 1 RTNI BSS 1 DISPM OCT 70630 D23 DEC 23 D25 DEC 25 D20 DEC 20 TFLAG OCT 10000 N7 DEC -7 B4000 OCT 4000 CLEOF OCT 117777 B5000 OCT 5000 B77 OCT 77 D1 DEC 1 D2 DEC 2 D3 DEC 3 D4 DEC 4 B3701 OCT 3701 B3777 OCT 3777 * * * * BSREC LDA EQT11,I IF AT A REAL EOF RAL,RAL THEN SSA JMP BSR0 JUST SET UP THE POINTERS * CCA BACKSPACE ROUTINE JSB BSPTO BACK UP THE POINTER LDA SAVE,I GET THE TRAILING LENGTH WORD CMA SET TO BACK OVER THE RECORD JSB BSPTO DO IT BSR0 CCA BACK UP THE RECORD POINTER ADA EQT31,I BY ONE JMP RW3 GO SET AND EXIT HED SPOOL MONITOR DRIVER BACKSPACE POINTER ROUTINE BSPTO NOP BACKSPACE 'A' WORDS IN THE FILE LDB BSPTO SAVE ENTRY POINT IN CASE STB EQT12,I WE ARE INTERRUPTED. ADA EQT19,I DECREMENT THE BUFFER OFFSET CMA SET FOR DIVIDE CLB SET FOR DIVIDE DIV D128 A IS BLOCK OFFSET, B NEW BUFFER OFFSET CMB SET BUFFER OFFSET NEGATIVE STB EQT19,I SET THE BUFFER OFFSET CMA,INA,SZA,RSS SET BLOCKS NEGATIVE JMP BSP1 IF ZERO THEN IN SAME BUFFER * STA SAVE SAVE THE BLOCK OFFSET JSB SUBT GET CURRENT SECTOR POSITION ADA SAVE ADJUST TO NEW ADA SAVE (IT WAS BLOCKS REMEMBER) CLB SET FOR DIVIDE CMA,SSA,INA SET POS. NUMBER TO GO BACK JMP BSP2 SAME EXTENT GO SET UP * DIV EQT26,I A= # EXTENTS BACK, B= SECTOR OFFSET IN THAT EXTENT SZB ADJUST IF ZERO REMAINDER INA SET UP TO GO CMA ADA EQT20,I BA-CK AND GET STA EQT20,I THE EXTENT. INA IF LESS THAN SSA -1 THEN JMP RWIND JUST REWIND * CMB,INB,SZB ADB EQT26,I SAVE INDEX INTO STB EQT17,I THE EXTENT. BS13 LDA B4000 GET THE RETURN VECTOR JMP GTEXT GO GET THE EXTENT * BSP2 CMA,INA,RSS SET POSITIVE OFFSET BS10 LDA EQT17,I RETURN FROM EXTENT TO HERE B40 CLE CLEAR E FOR OVERFLOW TEST ADA EQT25,I TAKE INDEX FROM BEGINNING CLB,SEZ,CLE OF TRACK WHERE THE INB STEP B IF OVERFLOW DIV EQT30,I CURRENT EXTENT BEGINS. ADA EQT24,I FIND OUT HOW MANY STA EQT18,I TRACKS TO ADVANCE. STB EQT21,I SAVE CURRENT TRACK AND SECTOR. BSP1 CLE SET FOR READ ACCESS JMP BSCOR MAKE PRESENT AND RETURN HED SPOOL MONITOR DRIVER READ ROUTINE FSREC CLA FAKE OUT THE READ STA EQT8,I ROUTINES SO THAT INA THEY WILL FORWARD STA EQT6,I SPACE ONE RECORD. CMA,INA STA EQT22,I * RR LDA EQT6,I CPA B3701 IS THIS REALLY A POST REQUEST? JMP POST YES. * LDA EQT11,I CHECK IF FILE IS WRITE ONLY. ALF,ALF SLA JMP EOFRT SEND BACK IO20. * AND B40 ALREADY DONE AN EOF ON INB SET FOR EOF # 2 ERROR SZA THIS FILE? JMP EOFRT * JSB GETRD GET READY TO ACCESS THE BUFFER * LDA EQT11,I AND B40 IS CLEAR IO IN PROGRESS SZA JMP ERN5 YES GO TO ERROR -5 RETURN * LDA SAVE,I NO,GET AND SAVE LENGTH OF STA EQT10,I DISK RECORD. STA B SET IN B IN CASE EOF SSA EOF I.E. LESS THAN 0 JMP EORET YES EOF RETURN. * ADA EQT22,I # OF WORDS LEFT IN RECORD SSA,RSS IF BUFFER PROVIDED IS TOO SHORT JMP STFLG THEN JUST USE IT * STB EQT8,I ELSE SAVE TOTAL # WOHURDS TO BE CMB TRANSFERRED. STB EQT22,I SET TRANSFER COUNTER. STFLG JSB PUSH PUSH THE BUFFER ADDRESSES LDB EQT29,I GET THE BATCH CHECK FLAG SZB IF ZERO OR CPB EQT1,I CURRENT USER RSS SSB OR NEGATIVE JMP EORT ALL OK GOT TEST FOR END OF RECORD * LDA SAVE,I IF THIS IS A ":" HE IS AND MASKL IN DEEP CPA COLON JMP BINF SHIT, HE BLEW IT * EORT ISZ EQT22,I ALL WORDS MOVED?? JMP TRWD NO GO MOVE A WORD * LDA EQT10,I SET UP TO SKIP ANY RESIDUE CMA AND TO GET THE LAST WORD ADA EQT8,I STA EQT22,I SET COUNT RCONT LDA SAVE,I HANG ONTO THIS WORD. AT END STA EQT7,I OF RECORD, IT WILL CONTAIN LENGTH. JSB PUSH ADVANCE TO END OF RECORD. ISZ EQT22,I FINISHED? JMP RCONT NO GET THE NEXT ONE * LDA EQT7,I YES DO LINE LENGTHS SURROUNDING CPA EQT10,I THIS RECORD MATCH? JMP NORML YES - EVERYTHING NORMAL. * ERN5 LDB N6 SET UP FOR EOF WITH PREJUDICE (-5) JMP EORET NO MATCH - SEND EOF STATUS. * * N6 DEC -6 * TRWD LDB EQT7,I GET THE WORD ADDRESS LDA WTMAP GET THE MAP WORD CMA,SSA,SLA,RSS WHICH MAP ? JMP SMAP1 SYSTEM MAP * LDA SAVE,I GET THE WORD XSA B,I SEND IT INTO THE USER MAP JMP IDON * SMAP1 LDA SAVE,I GET THE WORD STA B,I PUT IT INTO BUFFER OF BUFFERED REQUEST IDON ISZ EQT7,I STEP THE USER BUFFER ADDRESS JSB PUSH PUSH MY ADDRESSES JMP EORT GO TEST FOR END HED SPOOL MONITOR DRIVER POSITION TO NEXT WORD ROUTINES PUSH NOP ROUTINE TO PUSH THE BUFFER ADDRESS ISZ SAVE PUSH THE BUFFER ADDRESS ISZ EQT19,I CHECK THE BUFFER COUNT JMP PUSH,I ALL OK SO CONTINUE * LDA PUSH NEED A NEW SECTOR SO SAVE STA EQT12,I THE RETURN' ADDRESS LDA D2 ADD 2 TO THE ADA EQT21,I SECTOR ADDRESS CPA EQT30,I END OF TRACK?? CLA YES SET TO ZERO STA EQT21,I RESET THE SECTOR SZA,RSS IF FIRST SECTOR ISZ EQT18,I BUMP THE TRACK LDA DM128 SET THE BUFFER POINTER BACK STA EQT19,I TO THE FIRST WORD JSB SUBT CHECK IF END OF EXTENT CPA EQT26,I WELL JMP RDEXT YES GET NEXT EXTENT * JMP XCOR STILL IN FILE GO GET THE BUFFER * RDEXT LDA B3000 NOT IN FILE, SO GET AND EXTENT GTEXT CLB,INB SET UP THE TEMP WORDS FOR EXTND STB PRM1 LDB EQT1 STB PRM2 LDB A SAVE A LDA EQT6,I CHECK IF WRITE AND D2 ISOLATE READ BIT (0 IF READ) ADA D6 USE 8 FOR WRITE 6 FOR READ STA PRM3 PUT IN THIRD EXTND PRAM LDA B RESTORE A & CALL FOR EXTND JSB LIST JMP WTOUT GO AWAY FOR A WHILE. * GETRD NOP THIS ROUTINE MAKES SURE THE BUFFER IS LDB GETRD IN CORE AND ADDRESSABLE STB EQT12,I SET RETURN ADDRESS XCOR LDB EQT6,I WSET E FOR THE INCOR CALL RBR,ERB 0= READ, 1= WRITE,CONTROL BSCOR JSB INCOR GO GET THE SECTOR * LDA EQT19,I SET UP THE BUFFER POINTER ADA D132 EQT19 STARTS AT -128 AND ADA EQT23,I BUFFER IS 4 WORDS BEYOND EQT23 STA SAVE SET THE POINTER LDB EQT12,I GET THE RETURN ADDRESS JMP B,I AND CONTINUE HED SPOOL MONITOR DRIVER TIME DELAY EXIT / CONSTANTS B3000 OCT 3000 DM128 DEC -128 * NTRDY LDA N4 SET TIME OUT SO THAT WE STA EQT15,I CAN GET BACK IN HERE. LDA EQT4,I IOR TFLAG SET THE HANDLE-OWN-TO FLAG STA EQT4,I WTOUT LDA EQT11,I RAR,SLA,RAL JMP WT1 IF IN RTE IV. * IOR D2 STA EQT11,I CLA JMP RTRN * WT1 JSB $RSM IN RTE IV, RESTORE PREVIOUS JMP $XEQ MAP AND GO TO SYSTEM IDLE LOOP. * MASKL OCT 177400 COLON OCT 35000 N4 DEC -4 B20K OCT 20000 D6 DEC 6 * EQT1 EQU 1660B EQT4 EQU 1663B EQT5 EQU 1664B EQT6 EQU 1665B EQT7 EQU 1666B EQT8 EQU 1667B EQT9 EQU 1670B EQT10 EQU 1671B EQT11 EQU 1672B EQT12 EQU 1771B EQT13 EQU 1772B EQT15 EQU 1774B EQT16 NOP EQT17 NOP EQT18 NOP EQT19 NOP EQT20 NOP EQT21 NOP EQT22 NOP EQT23 NOP EQT24 NOP EQT25 NOP EQT26 NOP EQT27 NOP EQT28 NOP EQT29 NOP EQT30 NOP EQT31 NOP EQT32 NOP EQT33 NOP * * * EOFLG NOP LDA EQT5,I SET EOF FLAG IN EQT5. IOR D128 STA EQT5,I LDA EQT11,I SET FLAG TO INDICATE IOR B20K EOF ALREADY SENT ONCE. STA EQT11,I JMP EOFLG,I * EOFRT LDA EQT5,I SET THE IOR D128 EOF FLAG STA EQT5,I * LDA B GET THE RETURN CODE JMP RTRN * * THE FOLLOWING ROUTINE FINDS OUT THE DIFFERENCE * IN SECTORS BETWEEN THE CURRENT POSITION AND * THE BEGINNING OF THIS EXTENT. * RETURNS THE RLEATIVE SECTOR OF CURRENT ADDRESS SECTOR * SUBT NOP LDA EQT24,I HOW MANY TRACKS READ WRITTEN? CMA,INA ADA EQT18,I GET RESULT IN SECTORS. MPY EQT30,I LDB EQT25,I ADD NUMBER OF SECTORS TO CMB,INB GET TOTAL. ADA B ACCUMULATE ADA EQT21,I JMP SUBT,I HED SPOOL MONITOR DRIVER POST ROUTINES * COME HERE TO POST BUFFERS BEFORE SPOOL CLOSE. * POST6 LDB EQT23,I SHOW BUFFER EMPTY AS IT MAY NOT CLA BE THE SAME AS THE INB DISC ANY MORE STA B,I SET LU TO ZERO TO CLEAR POST4 LDB EQT7,I ADVANCE TO THE NEXT BUFFER RBL FIRST THE BIT MAP LDA EQT23,I NOW THE ADDRESS ADA D132 JMP POST2 CONTINUE THE FLUSH * D132 DEC 132 * POST LDA PKBUF MUST FIND ALL BUFFERS CLB,INB THAT NEED TO BE WRITTEN. POST2 STB EQT7,I LDB A,I MAKE SURE WE DON'T STA EQT23,I CPB D5 POST A BUFFER THAT IS JMP POST4 BEING READ OR WRITTEN. * SSB JMP POST1 ALL FINISHED. * LDA WRBUF DOES THIS NEED TO AND EQT7,I BE WRITTEN OUT. CCE,SZA JMP POST6 NO. GO CLEAR THE INCORE FLAG IN CASE * JSB SXSIO YES - DO IT. JMP NTRDY * LDB EQT23,I INDICATE THAT THE BUFFER LDA D5 IS UNAVAILABLE BY SETTING STA B,I THE AGE WORD. JSB IOCAL,I LDB EQT23,I FREE UP THE BUFFER CLA,INA FOR USE. STA B,I LDA EQT7,I INDICATE BUFFER NEED NOT IOR WRBUF BE WRITTEN. STA WRBUF JMP POST4 LOOK FOR MORE BUFFERS. HED SPOOL MONITOR DRIVER CLEAN UP AND EXIT CODE BINF CCA BATCH CHECK ':' FOUND SO JSB BSPTO BACK SPACE TO LENGTH WORD FOR NEXT TIME LDA EQT11,I AND SET THE IOR B40K BATCH CHECK FAILED BIT STA EQT11,I IN THE EQT CCB SET TLOG FOR A 0 RETURN EORET JSB EOFLG SET EOF FLAGS INB SET B FOR TLOG POST1 STB EQT9,I SAVE B REGISTER. LDA EQT32,I NEED WE CALL BACK SPOUT? ALF,SLA RSS JMP POST5 * CSPT CCA SET UP ENTND TEMP WORDS STA PRM1 LDA EQT32,I STA PRM2 LDA EQT33,I STA PRM3 LDA B1000 GET THE RETURN VECTOR JSB LIST CALL FOR EXTND * LDA EQT32,I SUCCESS, SO XOR TFLAG CLEAR BIT WHICH INDICATES NEED STA EQT32,I TO CALL SPOUT. LDB EQT9,I RESTORE THE TLOG. POST5 LDA D4 NO - DO IMMEDIATE COMPLETION. JMP RTRN * B1000 OCT 1000 B40K OCT 40000 PKBUF DEF BUFS B377 OCT 377 D5 DEC 5 IOCAL NOP N1 DEC -1 SAVE NOP SAVE1 NOP TRSEC NOP FLU NOP WRBUF DEC -1 HED SPOOL MONITOR DRIVER GET CURRENT BLOCK ROUTINES * THE FOLLOWING CHECKS AND MAKES SURE THE DESIRED * SECTOR IS IN CORE. 1THIS ROUTINE MAY CAUSE ONE OR MORE * EXITS TO WAIT FOR RESOURCES. * * ON ENTRY E = 1 INDICATES A WRITE, E = 0 A READ * ON EXIT THE REQUESTED SECTOR IS IN CORE * * THE RETURN ADDRESS MAY BE SAVED IN EQT9 IF INCOR IS EVER CALLED * FROM MORE THAN ONE LOCATION. * * THE RETURN VECTOR IS 2000. * * INCOR NOP LDA EQT11,I SAVE THE DIRECTION BIT RAL,ERA IN EQT11 BIT 15 STA EQT11,I INC0 LDA EQT27,I GET THE LU AND AND B77 ISOLATE IT STA FLU CLA,INA SET BEGINING BUFFER READ/WRITE FLAG LDB PKBUF GET BEGINNING ADDRESS OF BUFFERS. INC1 STB EQT23,I STB TRSEC LDB B,I LOOK AT 1ST WORD OF BUFFER. INB,SZB,RSS FINISHED? JMP INC4 YES. * ISZ TRSEC LOOK AT BUFFER PTR. TO LU. LDB TRSEC,I DOES IT MATCH THIS ONE? CPB FLU RSS YES TRY THE NEXT ONE JMP INC3 NO. * ISZ TRSEC LOOK AT TRACK #. LDB TRSEC,I CPB EQT18,I IS IT EQUAL TO THE JMP INC2 TRACK DESIRED? * INC3 RAL MOVE THE WRITE FLAG TO NEXT BUFFER LDB EQT23,I INDEX THE ADDRESS ADB D132 ALSO JMP INC1 TRY THE NEXT BUFFER * INC2 ISZ TRSEC LOOK ALSO AT LDB EQT21,I SECTOR POINTER. CPB TRSEC,I MATCH THE ONE DESIRED? RSS YES. JMP INC3 NO. * LDB EQT23,I GET THE AGE FLAG LDB B,I TO B CPB D5 BUFFER - IS BUFFER AVAILABLE? JMP INC5 NO - MUST WAIT UNTIL IT'S POSTED. * LDB EQT11,I BUFFER IS IN CORE CMA IF TO BE WRITTEN ON AND WRBUF SET THE PROPER FLAG SSB SKIP IF READ ACCESS STA WRBUF JMP OKRET GO EXIT WE ARE READY NOW * * * * THE FOLLOWING GRABS UP AN AVAILABLE BUFFER AND * CHECKS IF IT NEEDS TO BE WRITTEN OUT. * INC4 STB SAVE1 LDB PKBUF CLA,INA OK4 STA SAVE FIND LEAST RECENTLY USED BUFFR. LDA B,I ARE WE AT THE END OF SSA THE BUFFERS? JMP OK2 YES. PICK LEAST RECENTLY USED. * CPA D5 IS THE BUFFER AVAILABLE? JMP OK1 NO. * CMA,INA YES. KEEP LOOKING THROUGH. ADA SAVE1,I CHECK AGE AGAINST CURRENT SSA,RSS IS THIS BUFFER A POSSIBLE? JMP OK3 NO. AGE IT. * STB SAVE1 YES. SAVE THIS BUFFER'S ADDRESS. LDA SAVE SAVE BUFFER POSITION. STA FLU AND WRITE FLAG LOCATION JMP OK3 * OK2 LDB SAVE1 DID WE FIND A BUFFER? SZB,RSS JMP INC5 NO - WAIT FOR TIME OUT * LDA D5 YES - MARK BUFFER AS UNAVAILABLE. STA B,I STB EQT23,I SAVE CURRENT SMD BUFFER ADDRESS. LDA FLU GET THE BUFFER # BIT AND WRBUF ISOLATE MUST BE WRITTEN FLAG CMA,CLE,INA SET E IF MUST BE WRITTEN LDA WRBUF GET THE MUST WRITE FLAG WORD IOR FLU SET THE NO WRITE FLAG LDB EQT11,I READ OR WRITE? SSB SKIP IF READ ELSE XOR FLU CLEAR TO INDICATE MUST WRITE STA WRBUF PUT THE FLAG WORD BACK SEZ,RSS MUST WE WRITE THIS ONE OUT FIRST? JMP OKOUT NO. BYPASS THIS STUFF. * JSB SXSIO WRITE OUT THE BUFFER. JMP NOK NO AVAILABLE $XSIO CALL. * OKOUT LDB EQT23,I MARK BUFFER WITH NEW INFO. INB LDA EQT27,I PUT AND B77 LU STA B,I INB TRACK LDA EQT18,I STA B,I INB LDA EQT21,I AND SECTOR STA B,I IN BUFFER HEAD SEZ IF MUST WRITE THEN JSB IOCAL,I DO IT NOW LDA EQT11,I READ OR WRITE REQUEST? LDB EQT19,I IF READ OR WRITE FROM CPB DM128 OTHER THAN BEGINING OFBLOCK SSA,RSS THEN MUST READ CLE,RSS MUST READ JMP OKRET NEED NOT READ GO EXIT * JSB SXSIO 5NLH READ IN THE DESIRED SECTOR. JMP OK5 * JSB IOCAL,I DO THE READ OKRET CLA,INA SET AGE BACK ON BUFFER LDB EQT23,I THAT IS BEING USED. STA B,I JMP INCOR,I * NOK LDA FLU COULD NOT WRITE OUT A SELECTED BUFFER CMA SET AND WRBUF THE MUST BE WRITTEN FLAG JMP OK8 GO FREE THE BUFFER AND WAIT * OK3 LDA B,I IF AGE # 4 CPA D4 RSS ISZ B,I BUMP IT THEN OK1 ADB D132 INDEX TO THE NEXT BUFFER LDA B,I IS THER ONE?? SSA WELL? JMP OK2 NO GO SEE IF ONE WAS FOUND * LDA SAVE YES MOVE RAL THE FLAG AROUND JMP OK4 AND GO TEST THIS ONE * OK5 LDB EQT23,I NO XSIO CALL AVAILABLE INB FOR READ CLA CLEAR THE LU STA B,I AND MUST WRITE FLAGS LDA FLU AND IOR WRBUF OK8 STA WRBUF LDA D4 SET THE FREE FLAG LDB EQT23,I IN THE BUFFER STA B,I AND THEN INC5 LDA EQT11,I SET UP TO TIME OUT IOR B2000 SET RETURN VECTOR ^?N STA EQT11,I (RETURNS TO INC0) JMP NTRDY GO TAKE WAIT EXIT * B2000 OCT 2000 HED SPOOL MONITOR DRIVER XSIO CALLS AND SETUP ROUTINES * * THE FOLLOWING SUBROUTINE SETS UP ONE OF THE * CALLS TO $XSIO. SXSIO USES INFORMATION FROM THE * CURRENT PACKING BUFFER. * * CALLING SEQUENCE: * E=0 FOR READ, E=1 FOR WRITE * JSB SXSIO * RETURN NO AVAILABLE CALL * RETURN+1 CALL READY AND SET UP - E=1. * * SXSIO NOP CLA,SEZ,INA INA STA DFUNC SET UP FUNCTION BITS. LDA AVXSI IS THERE AN AVAILABLE $XSIO CALL? SZA,RSS JMP SXSIO,I NO - GO AWAY. * LDB XSI1 CLE,SLA,RSS GET AN AVAILABLE CALLING SEQUENCE. LDB XSI2 STB IOCAL CLE,SLA,RSS BIT 0= CALL ONE, BIT 1= CALL TWO CLA,RSS IF USING CALL TWO THEN BOTH IN USE RAR,ELA USING CALL ONE CLEAR BIT 0 STA AVXSI RESET AVAILABLE-CALL SWITCH. ADB DOFF ADD THE OFFSET TO CALL PRAMS AREA LDA EQT23,I INA STA BUFR LDA A,I STA B,I PUT LU # IN CALLING SEQUENCE. ADB D3 LDA DFUNC STA B,I CCE,INB LDA B,I GET ADDRESS OF DISK CONTROL WDS. LDB BUFR ADB D3 STB A,I STORE BUFFER ADDRESS. ADA D2 STA BUFR ADB N1 LDA B,I GET SECTOR # AND STA BUFR,I PUT IT INTO QUADRUPLET. ADB N1 LDA B,I GET TRACK #. AND B377 IS IT LARGER THAN CPA B,I 256? ALF,SLA,ALF NO ROTATE AND SKIP JMP SXSI1 YES. * RAR FINISH THE ROTATE XOR BUFR,I NO - PUT TRACK AND STA BUFR,I #'S TOGETHER IN ONE CLA,RSS WORD. SXSI2 LDA B,I ISZ BUFR STA BUFR,I PUT IT INTO QUADRUPLET. ISZ SXSIO CCE SET E FOR RETURN JMP SXSIO,I * SXSI1 LDA BUFR,I MAKE A QUADRUPLE INSTEAD OF A TRIPLE. ELA,RAR S SEPARATE TRACK AND STA BUFR,I SECTOR. JMP SXSI2 * DOFF ABS XSI12-XSIO1 OFFSET TO LU WORD OF XSIO CALL BUFR NOP DFUNC NOP XSI1 DEF XSIO1 XSI2 DEF XSIO2 AVXSI OCT 3 EQSV1 NOP EQSV2 NOP * COMP1 LDA EQSV1 HERE ON COMPLETION OF CALL 1 ISZ AVXSI SET CALL AVAILABLE AGAIN JSB SIOEX GO TO COMMON EXIT * XSIO1 NOP MUST FOLLOW (PASSES THE RETURN ADDRESS) LDA EQT1 SAVE THE CURRENT STA EQSV1 EQT ADDRESSBE CHANGED TO COMPENSATE. JSB $RSM IN RTE IV, RESTORE PREV. MAP JSB $XSIO XSI12 NOP LOGICAL UNIT #. DEF COMP1 COMPLETION ADDRESS. NOP LIST POINTER WORD. NOP CONTROL INFO.,REQUEST CODE. DEF DSCC1 DISK CONTROL WORDS. DEC 10 PRIORITY OF REQUEST. NOP MAP INFORMATION (RTE IV) LDA EQSV1 RESTORE THE EQT ADDRESSES EXSIO JSB $ETEQ AND THEN JMP WTOUT GO AWAY FOR A WHILE. * SIOEX NOP COMMON XSIO COMPLETION ROUTINE JSB $ETEQ RESTOR THE EQT ADDRESSES CPB D128 TRANMISSION ERROR?? RSS NO ALL OK JSB EOFLG YES SET EOF FLAGS JSB EXEQT SET THE REST OF THE EQT UP(GET WTMAP TO A) CMA,SSA,SLA,RSS USER REQUEST ? RSS NO JSB $DRVM IN RTE IV, SET UP USER MAP. LDB SIOEX,I GET THE RETURN ADDRESS JMP B,I AND RETURN * DSCC1 NOP BUFFER ADDRESS. D128 DEC 128 LENGTH OF BUFFER. NOP SECTOR. NOP TRACK. DEC 0 TERMINATES THE QUADRUPLET. * COMP2 LDA EQSV2 GET THE EQT ADDRESS ISZ AVXSI SET CALL 2 ISZ AVXSI AVAILABLE JSB SIOEX CALL THE COMMON EXIT * XSIO2 NOP LDA EQT1 SAVE THE STA EQSV2 EQT ADDRESS JSB $RSM IN RTE IV, RESTORE PREV. MAP JSB $XSIO XSI22 NOP LOGICAL UNIT #. DEF COMP2 COSMPLETION ADDRESS. NOP LIST POINTER WORD. NOP CONTROL INFO., REQUEST CODE. DEF DSCC2 DISK CONTROL WORDS. DEC 10 PRIORITY OF REQUEST. NOP MAP INFORMATION (RTE IV) LDA EQSV2 JMP EXSIO GO SET EQT AND EXIT * TST1 EQU XSI12-XSIO1-XSI22+XSIO2 MUST BE EXACTLY ZERO TST2 EQU -TST1 OR CALL OFFSETS ARE NOT EQUAL * DSCC2 NOP BUFFER ADDRESS DEC 128 LENGTH NOP SECTOR. NOP TRACK. DEC 0 TERMINATES QUADRUPLET. * * THE FOLLOWING ROUTINE SETS UP POINTERS TO THE EQT EXTENSION. * IN ADDITION, IT DETERMINES WHETHER THE I/O REQUEST IS SET UP * VIA THE USER MAP OR IF IT WAS BUFFERED AND THUS SET UP VIA * THE SYSTEM MAP. IT SETS UP THE MSB AND LSB BITS OF 'WTMAP' * AS A FLAG. LATER READ AND WRITE ROUTINES CHECK THIS TO SEE * WHETHER TO DO CROSS MAP OR SAME MAP READS AND WRITES. * * ON RETURN A = WTMAP * EXEQT NOP LDA EQT13,I LDB N18 STB SAVE LDB ADR16 STA B,I INA INB ISZ SAVE JMP *-4 * LDB EQT1,I GET OUR LINK WORD ELB,CLE,ERB CLEAR SIGN BIT TO BE SAFE INB GET TO THE T-FIELD LDA B,I AND PULL IT IN RAL SET T-FIELD INTO MSB & LSB INB SEE IF BUFFER HAS BEEN MOVED (VIA REIO ?) LDB B,I PULL IN MOVED TO SAM WORD SSB HAS IT BEEN MOVED ? CCA YES, SO SET A FLAG STMAP STA WTMAP FOR ALL DATA MOVES JMP EXEQT,I RETURN TO THE CALLER * WTMAP NOP * * *THE LIST SUBROUTINE CALL $LIST IN THE RTE OPERATING SYSTEM *TO SCHEDULE EXTND. THE VERY FIRST SCHEDULE IS BY PROGRAM *NAME, THERE AFTER ALL SCHEDULES ARE BY ID ADDRESS. * * LIST NOP IOR EQT11,I SAVE THE RETURN VECTOR STA EQT11,I JSB $LIST CALL LIST PROCESSOR CALL OCT 701 BY NAME 1ST TIME DEF *+5 NA ME DEF PNAME DEF PRM1 DEF PRM2 DEF PRM3 * SZA WAS IT SUCCESSFUL ? JMP NTRDY NO, SO TRY LATER CLA,INA YES, SO SET UP CALL BY ID ADDR STA CALL STB NAME B = ID ADDR FROM $LIST JMP LIST,I * * PNAME ASC 3,EXTND PRM1 NOP PRM2 NOP PRM3 NOP * * * * HED SPOOL MONITOR DRIVER WRITE ROUTINES ADR16 DEF EQT16 N18 DEC -18 * * COME HERE FOR WRITE EOF REQUEST * WREOF ISZ EQT11,I SET EOF TO BE DONE FLAG * * HERE FOR WRITE REQUEST * WR LDA EQT11,I IF FILE IS READ-ONLY, ALF,ALF REJECT CALL. SSA JMP EOFRT * AND B40 ALREADY SENT AN EOF INB SET B FOR POSSIBLE ERROR SZA ON THIS FILE? JMP EOFRT * JSB GETRD GET READY TO WRITE THE RECORD LDA EQT11,I ARE LENGTHS TO BE WRITTEN? SLA IF JUST A WRITE EOF JMP WR1 GO WRITE IT * AND B20 ISOLATE THE STD. FILE BIT LDB EQT8,I GET LENGTH SZA IF STANDARD JMP STDFL SKIP THIS NONSENSE * ADB D2 BUMP BY TWO STB EQT8,I SAVE FOR THE SOUTH END OF STB SAVE,I THE RECORD AND SET IN FILE JSB PUSH PUSH THE RECORD POINTERS LDA EQT6,I GET THE CON WORD STA SAVE,I AND SET IT JSB PUSH PUSH THE RECORD POINTERS LDB EQT10,I GET THE LENGTH LDA EQT6,I IS CONTROL REQUEST? SLA NO SKIP LDB EQT7,I YES SET CONTROL EXTRA WORD STDFL STB SAVE,I IN TO THE BUFFER IT GOES JSB PUSH PUSH THE BUFFER POINTERS ISZ EQT22,I DONE?? JMP WR0 NO GO GET NEXT WORD * LDA EQT8,I END OF RECORD - WRITE LENGTH. STA SAVE,I JSB PUSH WR1 CCA WRITE AN EOF AFTER STA SAVE,I LAST LINE. LDA EQT11,I IF THIS WAS A EOF ONLY SLA THEN WR2 JSB EOFLG SET THE EOF FLz+AGS * NORML ISZ EQT31,I INCREMENT RECORD COUNT. LDB EQT8,I LDA EQT11,I RAR,RAR SLA MAKE SURE LENGTH IS CORRECTLY BLS RETURNED. JMP POST1 * WR0 LDB EQT7,I MOVE USER'S WORD TO SMD BUFFER. ISZ EQT7,I LDA WTMAP GET THE MAP WORD CMA,SSA,SLA,RSS WELL, WHICH MAP ? JMP SMAP2 SYS MAP * XLB B,I GET THE DATA JMP STDFL AND GO WRITE IT * SMAP2 LDB B,I JMP STDFL GO WRITE IT * B20 OCT 20 B7000 OCT 7000 HED SPOOL MONITOR DRIVER COMPLETION SECTION CS43 NOP JSB EXEQT LDA EQT11,I AND B7000 ISOLATE THE RETURN VECTOR STA B STASH IT IN B XOR EQT11,I CLEAR IT IN EQT 11 STA EQT11,I AND RESET IT ASR 9 PUT VECTOR IN LOW B LDA EQT4,I WHERE DID WE COME FROM? ALF RAL,CLE,SLA,ERA JMP TMOUT TIME OUT INTERRUPT. * LDA EQT21,I RETURN FROM EXTND. ADB XTAB INDEX INTO TRANSFER TABLE JMP B,I RETURN TO CALLING FUNCTION * * XTAB DEF *+1,I EXTEND RETURN TRANSFER TABLE DEF CS43,I 0 INITIALIZE DEF CS43,I 1 SHOULD NEVER HAPPEN DEF CS43,I 2 SHOULD NEVER HAPPEN DEF RLP1 3 CHECK AND RETURN TO READ DEF BS10 4 CONTINUE BACKSPACE DEF RW2 5 CONTINUE RWIND. * RLP1 CPA N1 EXTEND ERROR? CCB,RSS YES - FAKE EOF. JMP XCOR NO - NORMAL CONTINUE. * LDA EQT17,I RESTORE THE ORGIONAL ASL 8 FILE POSITION STB EQT19,I ALF,ALF STA EQT21,I LDA EQT16,I STA EQT18,I LDB EQT6,I GET THE REQUEST CODE RBR,SLB IF WRITE OR CONTROL CLB,RSS SKIP JMP ERN5 READ SEND ERROR -5 * STB EQT8,I SET LENGTH TO ZERO JSB GETRD SET TO WRITE LDA N2 SET A -2 EOF MARK STA SAVE,I IN THE FILq$"E JMP WR2 GO COMPLETE IT * * N2 DEC -2 * * TMOUT ALF,ALF ALF STA EQT4,I RESTORE EQT4 WITH TIME OUT BIT CLEARED ADB XTTAB INDEX INTO TIME OUT TRANSFER TABLE JMP B,I AND DISPATCH THE TIME OUT * * XTTAB DEF *+1,I TIME OUT VECTOR TABLE DEF POST 0 POST WAIT FOR XSIO CALL DEF CSPT 1 WAKE UP SPOUT RETURN DEF INC0 2 INCOR ROUTINE WAIT DEF RDEXT 3 READ EXTENT DEF BS13 4 BACKSPACE PROCESSOR DEF RWIND 5 REWIND * * * * BUFFERS FOR PACKING. * * NOTE: THE BUFFER PUSHING ALGORITHMS WILL * HANDLE A LARGER NUMBER OF BUFFERS. * BUFS OCT 4 AGE WORD. OCT 0 LOGICAL UNIT #. OCT 0 TRACK #. OCT 0 SECTOR #. BSS 128 BUFFER AREA. OCT 4 AGE WORD. OCT 0 LOGICAL UNIT #. OCT 0 TRACK #. OCT 0 SECTOR #. BSS 128 BUFFER AREA. OCT 4 AGE WORD OCT 0 LOGICAL UNIT #. OCT 0 TRACK #. OCT 0 SECTOR #. BSS 128 BUFFER AREA OCT 4 AGE WORD OCT 0 LOGICAL UNIT # OCT 0 TRACK #. OCT 0 SECTOR #. BSS 128 BUFFER AREA OCT 4 AGE WORD OCT 0 LOGICAL UNIT #. OCT 0 TRACK #. OCT 0 SECTR #. BSS 128 BUFFER AREA DEC -1 MARKS END OF BUFFERS. A EQU 0 B EQU 1 END IS43 $  92067-18031 1805 S C0122 &EXTD4 RTE-IV EXTND             H0101 dpASMB,R,L,C,Z ASSEMBLE STATEMENT FOR RTE IV *ASMB,R,L,C,N ASSEMBLE STATEMENT FOR RTE II HED EXTND ROUTINE * NAME: EXTND * SOURCE: 92067-18031 * RELOC: 92067-16028 * PGMR: A.M.G. * RTE 4: C.M.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM EXTND,17,10 92067-16028 REV.1805 771115 * SUP EXT SP.CL * EXT EXEC,RMPAR,$LIBR,$LIBX EXT $PVCN,$CIC,$YCIC * FUNC BSS 1 EQTAD BSS 1 ETYPE BSS 5 * EXTND JSB RMPAR DEF *+2 DEF FUNC LDA FUNC SZA INITIALIZE CALL FROM GASP? JMP EXTN2 NO. * TERM JSB EXEC TERMINATE EXECUTION. DEF *+2 DEF D6 * EXTN2 SSA JMP EXTN3 MUST CALL UP SPOUT. * * GET A FILE EXTENSION * LDA EQTAD GET EQT ADDRESS AND ADA D12 INDEX TO EQT EXTENSION. LDA 0,I ADA D4 GET CURRENT EXTENSION # (EQT20) LDB 0,I AND INCREMENT IT. INB STB TEMP6 ADA D7 PICK UP DIRECTORY ADDRESS STA DIRCT OF MASTER ENTRY. INA (EQT27 AND EQT28) STA DIRCT+1 CCA IS NEW EXTENT NUMBER CPB D256 GREATER THAN 256? JMP EXTN4 YES - TAKE ERROR PATH. JSB EXEC CALL D.RTR TO GET DEF *+8 AN EXTENSION. DEF D23 DEF FMDR DEF 1717B DEF TEMP6 DIRCT BSS 2 DEF ETYPE JSB RMPAR GET PARAMETERS BACK DEF *+2 FROM D.RTR. DEF TEMP1 LDA TEMP1 EXTN4 JSB $LIBR NOP LDB DIRCT ADB M6 SSA,RSS ER  RORS? JMP OK NO. CCA YES - PUT NEGATIVE # IN EQT21. STA 1,I JMP EXTNO GET OUT OF HERE. OK LDA TEMP5 PUT BEGINNING SECTOR AND B377 IN EQT21. STA 1,I ADB D4 ALSO IN EQT25. STA 1,I ADB M1 PUT BEGINNING TRACK # LDA TEMP4 IN EQT24. STA 1,I ADB M6 ALSO IN EQT18. STA 1,I INB INB LDA TEMP6 SAVE NEW STA 1,I EXTENSION # (EQT20). * * SET UP TO INTERRUPT DVS43. * EXTNO LDA RETPT SAVE RETURN POINT. STA $CIC CLA STA $PVCN CLEAR PRIVILEGED COUNTER. LDB EQTAD INDEX THROUGH EQT TO THE ADB D3 SELECT CODE AND LOAD IT. LDA 1,I AND B77 FAKE THE INTERRUPT TO THE SJP $YCIC DRIVER TO TELL IT WE ARE RETPT DEF TERM DONE. * EXTN3 JSB EXEC HAVE A REQUEST FROM SMD DEF *+8 TO CALL SPOUT BACK AND DEF D18 PASS IT THE SAVE CLASS DEF ZERO PARAMETERS. DEF ZERO DEF ZERO DEF EQTAD CLASS PARAMETERS PASSED DEF ETYPE FROM SPOUT TO SMD EQT. DEF SP.CL SPOUT CLASS ID. JMP TERM RETURN. * * STORAGE * XEQT EQU 1720B D6 DEC 6 TEMP1 EQU ETYPE TEMP2 EQU ETYPE+1 TEMP3 EQU ETYPE+2 TEMP4 EQU ETYPE+3 TEMP5 EQU ETYPE+4 TEMP6 EQU FUNC ZERO DEC 0 B77 OCT 77 B377 OCT 377 D3 DEC 3 D4 DEC 4 D7 DEC 7 D12 DEC 12 D18 DEC 18 D23 DEC 23 D256 DEC 256 M1 DEC -1 M4 DEC -4 M5 DEC -5 M6 DEC -6 FMDR ASC 3,D.RTR * END EXTND n   92067-18032 1805 S C0122 &SPCL4 RTE-IV SP. CL             H0101 [TASMB,R,L HED SUB-SYSTEM GLOBAL FOR SPOOL * NAME: SP.CL * SOURCE: 92067-18032 * RELOC: 92067-16028 * PGMR: A.M.G * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1975. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM SP.CL,30 92067-16028 REV.1805 780317 * ENT SP.CL ENT SP.OK ENT .IS43 EXT IS43 * SP.CL DEC 0 SP.OK NOP .IS43 DEF IS43+0 FIX FOR RTE4(ALLOWS SMP TO BE RT PROG) * END SP.CL n  92067-18033 1826 S C0122 &AN4FO RTE-IV 7900 GRANDFATHER ANSWER FILE             H0101 &LISTF::-10 *LIST FILE - STORED ON THE FIXED DISC YES *ECHO ON 40 *EST. # TRKS IN OUTPUT FILE !SYSTM::-10 *SYSTEM FILE - STORED ON THE FIXED DISC 7900 *SYSTEM DISC TYPE 11 *SYSTEM DISC SELECT CODE * * ******************************** * SUBCHANNEL DEFINITIONS * ******************************** * * 203,0 *SUBCHANNEL 0 203,0 *SUBCHANNEL 1 /E *TERMINATE SUBCHANNEL DEFINITION 1 *SYSTEM SUBCHANNEL NO *AUXILIARY DISC? 10 *TBG SELECT CODE 0 *PRIV. INT. SELECT CODE (NONE) YES *MEM. RES. PROGS ACCESS TABLE AREA II? YES *RT MEMORY LOCK? YES *BG MEMORY LOCK? 50 *SWAP DELAY? 48 *MEMORY SIZE !BOOT::-10 *BOOT FILE STORED ON THE FIXED DISC MAP ALL *MAP MODULES, GLOBALS, AND LINKS LINKS IN CURRENT *CURRENT PAGE LINKAGE * ******************************** * RELOCATABLE MODULES * ******************************** * * *********************** RTE-IV OPERATING SYSTEM * REL,%CR4S1::32767 REL,%CR4S2::32767 * *********************** SPECIAL SYSTEM SOFTWARE * REL,%$CNFX::32767 *CONFIGURATOR EXTENSION REL,%DBUGR::32767 *USER DBUG SUBROUTINE * *********************** DRIVERS * REL,%DVR00::32767 *TTY PUNCH PHOTOREADER DVR REL,%4DV05::32767 *2644/45 DRIVER (WITH C/U) REL,%DVR12::32767 *2767A LINEPRINTER DRIVER REL,%DVA12::32767 *2607/10/13/14/17/18 LP DVR REL,%DVR23::32767 *7970 9-TRACK MAG TAPE DVR REL,%DVR31::32767 8A *7900 DISC DRIVER * ********************** USER PROGRAMS * MAP OFF,MODULES REL,%EDITR::32767 *EDITOR REL,%LGTAT::32767 *TRACK ASSIGN. TABLE LOG REL,%4ASMB::32767 *ASSEMBLER MAIN REL,%4ASB0::32767 *ASSEMBLER SEGMENT 0 REL,%4ASB1::32767 *ASSEMBLER SEGMENT 1 REL,%4ASB2::32767 *ASSEMBLER SEGMENT 2 REL,%4ASB3::32767 *ASSEMBLER SEGMENT 3 REL,%4ASB4::32767 *ASSEMBLER SEGMENT 4 REL,%4XREF::32767 *CROSS REFERENCE GENERATOR REL,%4LDR::32767 *RELOCATING LOADER REL,%4WHZT::32767 *WHZAT REL,%BMPG1::32767 *BATCH MONITOR REL,%BMPG2::32767 *BATCH MONITOR REL,%BMPG3::32767 *BATCH MONITOR REL,%RT4G1::32767 *GENERATOR REL,%RT4G2::32767 *GENERATOR REL,%4SWTH::32767 *SWITCH PROGRAM REL,%SAVE::32767 *SAVE PROGRAM REL,%RESTR::32767 *RESTORE PROGRAM REL,%COPY::32767 *DISC COPY PROGRAM REL,%VERFY::32767 *VERIFY PROGRAM * ********************** LIBRARIES * REL,%DBKLB::32767 *DISC BACKUP LIBRARY REL,%4SYLB::32767 *SYSTEM LIBRARY REL,%CLIB::32767 *COMPILER LIBRARY REL,%RLIB1::32767 *RTE/DOS RELOC. LIBRARY REL,%RLIB2::32767 *RTE/DOS RELOC. LIBRARY REL,%BMLIB::32767 *BATCH LIBRARY REL,%FF4.N::32767 *FORTRAN FORMATTER * DISPLAY UNDEFS,TR *DISPLAY UNDEFINED EXTERNALS AT CONSOLE /E *TERMINATE RELOCATABLE SPECIFICATIONS * * ******************************** * PROGRAM PARAMETERS * ******************************** * * D.RTR,1,1 WHZAT,3,1 LGTAT,1,41 ASMB,3,95 XREF,3,96 LOADR,3,97 EDITR,3,50 /E *TERMINATE PARAMETER INPUT * * ******************************** * ENTRY POINT CHANGES * ******************************** * * .MPY,RP,100200 .DIV,RP,100400 .DLD,RP,104200 .DST,RP,104400 .MVW,RP,105777 * .EMAP,RP,105257 * EMA MICROCODE - APPLICABLE * .EMIO,RP,105240 * ON 21MX E-SERIES ONLY * MMAP,RP,105241 * /E *TERMINATE ENTRY POINT CHANGES * * ******************************** * EQUIPMENT TABLE ENTRIES * ******************************** * * 11,DVR31,D *EQT # 1 - 7900 M.H. DISC 13,DVR05,B,X=13,T=12000 *EQT # 2 - SYSTEM CONSOLE 16,DVR23,D,B,T=9999 *EQT # 3 - 7970 MAG TAPE 22,DVR02,B,T=50 *EQT # 4 - PAPER TAPE PUNCH 21,DVR12,B,T=100 *EQT # 5 - 2767 LINE PRINTER 14,DVR00,B *EQT # 6 - 2600 CONSOLE, TTY 15,DVR01,T=50 *EQT # 7 - PHOTOREADER 20,DVA12,B,T=100 *EQT # 8 - 2607 LINE PRINTER /E *TERMINATE THIS PHASE * * ******************************** * DEVICE REFERENCE TABLE * ******************************** * * 2,0 *LU # 1 - SYSTEM CONSOLE 1,1 *LU # 2 - SYSTEM DISC 0 *LU # 3 - AUXILIARY DISC 2,1 *LU # 4 - 2645 TERMINAL - LEFT CTU 2,2 *LU # 5 - 2645 TERMINAL - RIGHT CTU 8 *LU # 6 - 2607 LINE PRINTER 6 *LU # 7 - 2600 TERMINAL 3 *LU # 8 - MAG TAPE 7 *LU # 9 - PHOTOREADER 1,0 *LU # 10 - 7900 SUBCHANNEL 0 0 *LU # 11 - UNASSIGNED 0 *LU # 12 - UNASSIGNED 0 *LU # 13 - UNASSIGNED 0 *LU # 14 - UNASSIGNED 0 *LU # 15 - UNASSIGNED 0 *LU # 16 - UNASSIGNED 0 y$ *LU # 17 - UNASSIGNED 0 *LU # 18 - UNASSIGNED 4,4 *LU # 19 - PUNCH 5,0 *LU # 20 - 2767 LINE PRINTER /E *TERMINATE DRT * * ******************************** * INTERRUPT TABLE * ******************************** * * 11,EQT,1 12,EQT,1 13,EQT,2 14,EQT,6 15,EQT,7 16,EQT,3 17,EQT,3 20,EQT,8 21,EQT,5 22,EQT,4 /E *TERMINATE INTERRUPT TABLE * * ******************************** * SYSTEM BOUNDARIES * ******************************** * * 0 *CHANGE DRIVER PART. SIZE? (NO) 0 *CHANGE RT COMMON? (NO) 0 *CHANGE BG COMMON? (NO) 10 *# I/O CLASSES 10 *# LU MAPPINGS 10 *# RESOSURCE NUMBERS 100,400 *BUFFER LIMITS 10 *# BLANK ID SEGMENTS 15 *# BLANK SHORT ID SEGMENTS 5 *# BLANK ID EXTENSIONS 15 *MAXIMUM NUMBER OF PARTITIONS * * ******************************** * PARTITION DEFINITION * ******************************** * * 0 *CHANGE 1ST PART PAGE * *********************** DEFINE PARTITIONS * 21,BG /E *TERMINATE PARTITION DEFINITION * *********************** MODIFY PROGRAM PAGE REQUIREMENTS * LOADR,16 RT4GN,21 SAVE,16 RSTOR,16 COPY,16 VERFY,16 EDITR,16 ASMB,16 XREF,16 /E *TERMINATE PAGE MODIFICATIONS * *********************** ASSIGN PROGRAM PARTITIONS * /E *TERMINATE PARTITION ASSIGNMENT }   92067-18034 1826 S C0122 &AN4F5 RTE-IV 7905/6/20 GRANDFATHER ANSWER FILE             H0101 &LISTF::32767 *LIST FILE NAME YES *ECHO ON 40 *EST. # TRKS IN OUTPUT FILE !SYSTM::32767 *SYSTEM FILE NAME - 780403 7905 *SYSTEM DISC TYPE: 7905/06/20 11 *SYSTEM DISC SELECT CODE * * ******************************** * SUBCHANNEL DEFINITIONS * ******************************** * * 256,0,0,2,0,8 *SUBCHANNEL 0 203,132,0,2,0,5 *SUBCHANNEL 1 203,236,0,2,0,5 *SUBCHANNEL 2 138,340,0,2,0,4 *SUBCHANNEL 3 203,0,2,1,0,5 *SUBCHANNEL 4 198,208,2,1,0,5 *SUBCHANNEL 5 400,0,3,1,0,11 *SUBCHANNEL 6 400,0,4,1,0,11 *SUBCHANNEL 7 1024,411,0,5,0,26 *SUBCHANNEL 8 985,621,0,5,0,25 *SUBCHANNEL 9 /E *TERMINATE SUBCHANNEL DEFINITION 0 *SYSTEM SUBCHANNEL NO *AUXILIARY DISC? 10 *TBG SELECT CODE 0 *PRIV. INT. SELECT CODE (NONE) YES *MEM. RES. PROGS ACCESS TABLE AREA II? YES *RT MEMORY LOCK? YES *BG MEMORY LOCK? 50 *SWAP DELAY? 48 *MEMORY SIZE !BOOT::32767 *BOOT FILE MAP ALL *MAP MODULES, GLOBALS, AND LINKS LINKS IN CURRENT *CURRENT PAGE LINKAGE * ******************************** * RELOCATABLE MODULES * ******************************** * * *********************** RTE-IV OPERATING SYSTEM * REL,%CR4S1::32767 REL,%CR4S2::32767 * *********************** SPECIAL SYSTEM SOFTWARE * REL,%$CNFX::32767 *CONFIGURATOR EXTENSION REL,%DBUGR::32767 *USER DBUG SUBROUTINE * *********************** DRIVERS * REL,%DVR00::32767 *TTY PUNCH PHOTOREADER DVR REL,%4DV05::32767 *2644/45 DRIVER (WITH C/U) REL,%DVR12::32767 *2767A LINEPRINTER DRIVER REL,%DVA12::32767 *2607/10/13/14/17/18 LP DVR REL,%DVR23::32767 *7970 9-TRACK MAG TAPE DVR REL,%DVR32::32767 *7905/06/20 DISC DRIVER * ********************** USER PROGRAMS * MAP OFF,MODULES REL,%EDITR::32767 *EDITOR REL,%LGTAT::32767 *TRACK ASSIGN. TABLE LOG REL,%4ASMB::32767 *ASSEMBLER MAIN REL,%4ASB0::32767 *ASSEMBLER SEGMENT 0 REL,%4ASB1::32767 *ASSEMBLER SEGMENT 1 REL,%4ASB2::32767 *ASSEMBLER SEGMENT 2 REL,%4ASB3::32767 *ASSEMBLER SEGMENT 3 REL,%4ASB4::32767 *ASSEMBLER SEGMENT 4 REL,%4XREF::32767 *CROSS REFERENCE GENERATOR REL,%4LDR::32767 *RELOCATING LOADER REL,%4WHZT::32767 *WHZAT REL,%BMPG1::32767 *BATCH MONITOR REL,%BMPG2::32767 *BATCH MONITOR REL,%BMPG3::32767 *BATCH MONITOR REL,%RT4G1::32767 *GENERATOR REL,%RT4G2::32767 *GENERATOR REL,%4SWTH::32767 *SWITCH PROGRAM REL,%SAVE::32767 *SAVE PROGRAM REL,%RESTR::32767 *RESTORE PROGRAM REL,%COPY::32767 *DISC COPY PROGRAM REL,%VERFY::32767 *VERIFY PROGRAM * ********************** LIBRARIES * REL,%DBKLB::32767 *DISC BACKUP LIBRARY REL,%4SYLB::32767 *SYSTEM LIBRARY REL,%CLIB::32767 *COMPILER LIBRARY REL,%RLIB1::32767 *RTE/DOS RELOC. LIBRARY REL,%RLIB2::32767 *RTE/DOS RELOC. LIBRARY REL,%BMLIB::32767 *BATCH LIBRARY REL,%FF4.N::32767 *FORTRAN FORMATTER * DISPLAY UNDEFS,TR *DISPLAY UNDEFINED EXTERNALS AT CONSOLE /E *TERMINATE RELOCATABLE SPECIFICATIONS * * ******************************** * PROGRAM PARAMETERS * ******************************** * * D.RTR,1,1 WHZAT,3,1 LGTAT,1,41 ASMB,3,95 XREF,3,96 LOADR,3,97 EDITR,3,50 /E *TERMINATE PARAMETER INPUT * * ******************************** * ENTRY POINT CHANGES * ******************************** * * .MPY,RP,100200 .DIV,RP,100400 .DLD,RP,104200 .DST,RP,104400 .MVW,RP,105777 * .EMAP,RP,105257 *EMA MICROCODE: APPLICABLE * .EMIO,RP,105240 * ON 21MX E-SERIES ONLY * MMAP ,RP,105241 * /E *TERMINATE ENTRY POINT CHANGES * * ******************************** * EQUIPMENT TABLE ENTRIES * ******************************** * * 11,DVR32,D *EQT # 1 - 7905/06/20 M.H. DISC 13,DVR05,B,X=13,T=12000 *EQT # 2 - SYSTEM CONSOLE 16,DVR23,D,B,T=9999 *EQT # 3 - 7970 MAG TAPE 22,DVR02,B,T=50 *EQT # 4 - PAPER TAPE PUNCH 21,DVR12,B,T=100 *EQT # 5 - 2767 LINE PRINTER 14,DVR00,B *EQT # 6 - 2600 CONSOLE, TTY 15,DVR01,T=50 *EQT # 7 - PHOTOREADER 20,DVA12,B,T=100 *EQT # 8 - 2607 LINE PRINTER /E *TERMINATE THIS PHASE * * ******************************** * DEVICE REFERENCE TABLE * ******************************** * * 2,0 *LU # 1 - SYSTEM CONSOLE 1,0 *LU # 2 - SYSTEM DISC 0 *LU # 3 - AUXILIARY DISC 2,1 *LU # 4 - 2645 TERMINAL - LEFT CTU 2,2 *LU # 5 - 2645 TERMINAL - RIGHT CTU 8 *LU # 6 - 2607 LINE PRINTER 6 *LU # 7 - 2600 TERMINAL 3 *LU # 8 - MAG TAPE 7 *LU # 9 - PHOTOREADER 1,1 *LU # 10 - 7905/06/20 SUBCHANNEL 1 1,2 ^ *LU # 11 - 7905/06/20 SUBCHANNEL 2 1,3 *LU # 12 - 7905/06/20 SUBCHANNEL 3 1,4 *LU # 13 - 7905/06/20 SUBCHANNEL 4 1,5 *LU # 14 - 7905/05/20 SUBCHANNEL 5 1,6 *LU # 15 - 7906/20 SUBCHANNEL 6 1,7 *LU # 16 - 7920 SUBCHANNEL 7 1,8 *LU # 17 - 7920 SUBCHANNEL 8 1,9 *LU # 18 - 7920 SUBCHANNEL 9 4,4 *LU # 19 - PUNCH 5,0 *LU # 20 - 2767 LINE PRINTER /E *TERMINATE DRT * * ******************************** * INTERRUPT TABLE * ******************************** * * 11,EQT,1 13,EQT,2 14,EQT,6 15,EQT,7 16,EQT,3 17,EQT,3 20,EQT,8 21,EQT,5 22,EQT,4 /E *TERMINATE INTERRUPT TABLE * * ******************************** * SYSTEM BOUNDARIES * ******************************** * * 0 *CHANGE DRIVER PART. SIZE? (NO) 0 *CHANGE RT COMMON? (NO) 0 *CHANGE BG COMMON? (NO) 10 *# I/O CLASSES 10 *# LU MAPPINGS 10 *# RESOSURCE NUMBERS 100,400 *BUFFER LIMITS 10 *# BLANK ID SEGMENTS 15 *# BLANK SHORT ID SEGMENTS 5 *# BLANK ID EXTENSIONS 15 *MAXIMUM NUMBER OF PARTITIONS * * ******************************** * PARTITION DEFINITION * ******************************** * * 0 *CHANGE 1ST PART PAGE * *********************** DEFINE PARTITIONS * 20,BG /E *TERMINATE PARTITION DEFINITION * *********************** MODIFY PROGRAM PAGE REQUIREMENTS * LOADR,16 RT4GN,20 [SAVE,16 RSTOR,16 COPY,16 VERFY,16 EDITR,16 ASMB,16 XREF,16 /E *TERMINATE PAGE MODIFICATIONS * *********************** ASSIGN PROGRAM PARTITIONS * /E *TERMINATE PARTITION ASSIGNMENT Y   92067-18035 1840 S 0122 RTE-IV SYSTEM LIBRARY HEADER             H0101 2ASMB,L * NAME: $YSLB * SOURCE: 92067-18035 * RELOC: 92067-16035 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM $YSLB 92067-16035 REV.1840 780811 END EM  92067-18036 1805 S C0122 &ALRN4 RTE-IV $ALRN              H0101 VIASMB,R,L,C ** $ALRN RN-LU COMMON SUBROUTINES *** HED $ALRN - RN-LU COMMON SUBROUTINES * NAME: $ALRN * SOURCE: 92067-18036 * RELOC: PART OF 92067-16035 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM $ALRN,6 92067-16035 REV.1805 770715 * EXT $RNTB,$ERAB,$LIST,$XEQ ENT $ALRN,$RNSU,$RNEX,$LUEX,$LUSU,$DRAD SUP A EQU 0 B EQU 1 * * $ALRN THIS ROUTINE ALLOCATES AN RN IF POSSIBLE * TO THE USER WHOSE ID SEGMENT ADDRESS IS * AT XEQT. * * OPTIONS/CALLING SEQUENCE: * * < IDNO MUST BE USER ID SEG # OR 377 IF GLOBAL * LDB =B1 TO ALLOCATE FROM BOTTOM OF THE RN TABLE * LDB =B-1 TO ALLOCATE FROM THE TOP OF THE RN TABLE * * JSB $ALRN * * < RETURN A=RN WORD (USER FORMAT) IF SUCESSFUL * A=0 IF NO RN'S AVAILABLE NOW * RQP6 IS SET TO RN ADDRESS IN RN TABLE * * * * $ALRN NOP STB TEMP4 SAVE THE INCREMENT XLA $RNTB GET THE LENGTH OF THE RN TABLE STA TEMP1 SAVE LENGTH OF THE RN TABLE CMA,INA SET NEGATIVE. * STA TEMP2 SET THE COUNT LDA D$RN GET THE RN TABLE ADDRESS SSB,RSS IF BOTTOM UP INA,RSS SET TO FIRST WORD ADA TEMP1 ELSE SET TO LAST WORD * ALRN1 XLB A,I SEARCH FOR SZB,RSS AN AVAILABLE JMP ALRN2 SLOT. FOUND * ADA TEMP4 STEP THE ADDRESS ISZ TEMP2 SKIP IF END JMP ALRN1 ELSE TRY NEXT ONE * CLA NO RN'S AVAILABLE NOW & JMP $ALRN,I SO EXIT WITH A=0 * ALRN2 STA RNADR SAVE LOCATION CMA,INA SET TO CACULATE RN NUMBER * LDB IDNO GET THE USER ID NUMBER BLF,BLF ROTATE TO HIGH HALF XSB RNADR,I SET THE ASSIGNMENT IN THE TABLE ADA D$RN COMPUTE RN NUMBER CMA,INA SET POSTIVE ADA B ADD THE USER ID FLAG JMP $ALRN,I RETURN * * $RNSU LDB RQOP GET NO-WAIT OPTION FLAG SSB IF NO WAIT JMP EXRNW THEN EXIT * $LUSU XSA XTEMP,I SET THE SUSPEND FLAG JSB $LIST AND PUT THE PROG IN LIST OCT 503 NUMBER 3. JMP $XEQ GO THE THE DISPATCHER * EXRNW LDB D5 ENTRY FOR 6/7 RETURN $RNEX LDA RNADR TEST THE RN LOCATION ADDRESS CMA,CLE,INA,SZA,RSS IF ZERO SET E, ELSE SKIP LDB D4 NO RN STATUS XLA RNADR,I GET THE RN SEZ,SZA,RSS SKIP IF ALLOCATE PROBLEMS CLB ELSE SET DEALLOCATED FLAG IF RN IS ZERO AND B377 MASK TO LOCK BITS SZA IF LOCKED INB STEP B TO SO INDICATE CPA B377 IF GLOBAL INB STEP AGAIN STB RQST,I SET THE STATUS WORD $LUEX LDB XEQT SET THE RN BIT IN HIS ADB D20 ID-SEGMENT XLA B,I IOR B400 XSA B,I LDA RQRTN PUSH UP HIS XSA XSUSP,I RETURN ADDRESS JMP $XEQ ** GO TO THE DISPATCHER ** * * * $DRAD NOP ADDR IS GIVEN IN A RSS GET DIRECT ADDRESS LDA A,I IF NOT ALREADY RAL,CLE,SLA,ERA JMP *-2 JMP $DRAD,I RETURN DIRECT ADDR IN A D$RN DEF $RNTB+0 FORCE THE GENERATOR TO PRODUCE A DIRECT ADDR * * D5 DEC 5 D4 DEC 4 D20 DEC 20 B377 OCT 377 B400 OCT 400 TEMP1 NOP TEMP2 NOP TEMP4 NOP * RQOP EQU 1701B RQP2 IS RN/LU REQUEST CODE RQNO EQU 1702B RQP3 IS ADDR OF RN/LU NUMBER RQST EQU 1703B RQP4 IS ADDR OF RN/LU STATUS' IDNO EQU 1704B RQP5 IS USERS ID SEG # RNADR EQU 1705B RQP6 IS ADDR OF RN IN RN TABLE RQRTN EQU 1677B XEQT EQU 1717B XTEMP EQU 1721B XSUSP EQU 1730B * ORG * PROGRAM LENGTH END B  92067-18037 1805 S C0122 &RNRQ4 RTE-IV RNRQ              H0101 bfASMB,R,L,C ** RNRQ RESOURCE NUMBER MODULE ** HED ** REAL-TIME EXECUTIVE RNRQ RESOURCE NUMBER MODULE ** * NAME: RNRQ * SOURCE: 92067-18037 * RELOC: PART OF 92067-16035 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM RNRQ,6 92067-16035 REV.1805 780222 * EXT $ERAB,$RNTB,$IDNO,$SCD3,$DRAD EXT $ALRN,$LIBR,$PVCN,$RNSU,$RNEX ENT RNRQ * SUP A EQU 0 B EQU 1 * * * * RESOURCE NUMBERS (RN'S) ARE ACCESSED BY USER * CALLS THAT CAN ALLOCATE, DEALLOCATE * SET AND CLEAR THE RN. IF A RN REQUEST CAN NOT * BE GRANTED BECAUSE OF NONE AVAILABLE OR * CONFLICT WITH OTHER PROGRAMS THE REQUESTER IS * SUSPENDED UNTIL THE RN BECOMES AVAILABLE * * THE EXEC CALL IS: * * EXT RNRQ * * JSB RNRQ * DEF *+4 * DEF OPTION OPTION ADDRESS * DEF RN RN NUMBER ADDRESS/RETURN * DEF STAT RN STATUS RETURN ADDRESS * * * WHERE: * OPTIN BSS 1 OPTION WORD * RN BSS 1 RN WORD * STAT BSS 1 RN STATUS * * THE OPTION WORD DEFINES WHAT ACTION IS TO BE TAKEN ON THE * REQUEST AS FOLLOWS: * * BIT MEANING IF SET * BIT 0 SET THE RN LOCALLY * BIT 1 SET THE RN GLOBALLY * BIT 2 CLEAR THE RN * BIT 3 ALLOCATE AN RN LOCALLY * BIT 4 ALLOCATE AN RN GLOBALLY * BIT 5 DEALLOCATE THE RN * BIT 14 DON'T ABORT IF ERROR, RETURN ASCII CODE IN A,B * BIT 15 RETURN EVEN IF REQUEST NOT GRANTED * * A LOCALLY ALLOCATED RN MAY BE RELEASED ONLY BY THE ALLOCATOR * A LOCALLY SET RN MAY BE CLEARED ONLY BY THE SETER * GLOBALLY ALLOCATED/SET RN'S MAY BE DEALLOCATE/CLEARED BY * ANY PROGRAM. * * IF MORE THAN ONE BIT IS SET IN THE OPTION WORD THE FOLLOWING * PRESEDENCE IS FOLLOWED: * * 1) LOCAL ALLOCATE (SKIP 2 IF DONE) * 2) GLOBAL ALLOCATE * 3) DEALLOCATE * 4) LOCAL SET (SKIP 5 IF DONE) * 5) GLOBAL SET * 6) CLEAR * * THIS IMPLIES THAT RN MAY BE ALLOCATED,SET,AND CLEARED IN * THE SAME REQUEST. * A STATUS REQUEST WOULD BE A SET, CLEAR, WITHOUT WAIT. * THERE ARE TWO RN CODE WORDS: * A) THE USER WORD (RETURN ON ALLOCATE/SUPPLIED FOR OTHER * REQUESTS). * B) THE RN TABLE CODE WORD. * * THE USER CODE WORD HAS THE RN NUMBER IN THE LOW HALF (8 BITS) * AND THE OWNERS ID SEGMENT NUMBER IN THE HIGH 8 BITS * * THE RN TABLE CODE WORD HAS THE LOCKERS ID SEGMENT NUMBER * IN THE LOW HALF AND THE OWNERS ID NUMBER IN THE HIGH OF * THE WORD. * * GLOBAL ALLOCATES/LOCKS ARE CODED AS 377 * AVAILABLE/UNLOCKED IS CODED AS 0. * * RN STATUS IS AS FOLLOWS: * * VALUE MEANING * 0 NORMAL DEALLOCATE RETURN * 1 RN IS CLEAR (UNLOCKED) * 2 RN IS LOCKED LOCALLY TO CALLER * 3 RN IS LOCKED GLOBALLY * 4 NO RN AVAILABLE NOW * 5 NOT DEFINED * 6 RN IS LOCKED LOCALLY TO OTHER PROGRAM * 7 RN WAS LOCKED GLOBALLY WHEN REQUEST WAS MADE. * * STATUS 4,6,7 ARE ONLY RETURNED IF THE REQUEST FAILED * AND THE NO WAIT BIT WAS SET * * POSSIBLE ERRORS FROM THIS CODE ARE: * * ERROR MEANING * * RN00 NO BITS SET IN THE OPTION WORD. * RN01 NO RN'S IN THE SYSTEM (EVER). * RN02 ILLEGAL RN NUMBER. * RN03 RELEASE OR UNLOCK OF UNOWNED RN. * RN REQUEST PROCESSOR *  SKP RNRQ NOP ENTRY JSB $LIBR PRIVILEGED NOP CLA SINCE WE DON'T PLAN TO RETURN STA $PVCN VIA $LIBR, CLEAR CNTR * CCA ADA RNRQ SET CALLING ADDR IN SUSP. WORD XSA XSUSP,I IN CASE OF SUSPENSION LDA RNRQ,I SET RETURN ADDR JSB $DRAD WORRY ABOUT FTN CALLS STA RQRTN IN CASE OF ABORT * ISZ RNRQ LDB RNRQ,I LDA B,I GET OPTION WORD STA RQOP RAL,CLE,ELA BIT14 TO E * LDB XSUSP ADB D7 GET ADDR OF STATUS XLA B,I RAL,ERA PUT E IN BIT15 XSA B,I OF STATUS WORD SSA DID WE SET IT? ISZ RQRTN YES,BUMP RETRN ADDR, NO-ABORT BIT SET * ABCAL ISZ RNRQ NO LDA RNRQ,I JSB $DRAD GET DIRECT ADDR STA RQNO ADDR OF RN NUMBER ISZ RNRQ LDA RNRQ,I JSB $DRAD GET DIRECT ADDR STA RQST GET ADDR OF RETURN STATUS LDB RQRTN IF RETURN ADDR CMB,INB IS LESS THAN ADB RNRQ THIS NOW, SSB,RSS THEN JMP ERN02 ABORT WITH RN02 * LDB XEQT GET THE ID SEGMENT NUMBER JSB $IDNO TO B STB IDNO SAVE FOR EVERYBODY STB TEMP6 SAVE FOR ME LDA RQOP GET THE OPTION WORD AND B77 IF NO BITS SET THEN CLB SET B FOR ERROR EXIT SZA,RSS TAKE JMP ERN00 ERROR EXIT * AND B30 MASK TO THE ALLOCATE BITS SZA,RSS IF NO ALLOCATION REQUESTED JMP DAL GO TEST FOR DEALLOCATE * AND B10 LDB B377 SZA,RSS GLOBAL ALLOCATE? (BIT 4) STB IDNO YES, SET IDNO TO 377B CCB SET TO SCAN FROM TOP JSB $ALRN ALLOC AN RN AND SET RNADR STA RQNO,I SET IN THE USER AREA SZA SKIP IF ALLOCATION FAILED JMP DALX ELSE GO TEST DALLOCATION * rM LDA D$RN GET SUSPEND FLAG JMP $RNSU CHECK IF NEED TO SUSPEND * DAL LDA RQNO,I GET THE RN USER SUPLIED WORD AND B377 ISOLATE THE RN#. XLB $RNTB TEST THE RN CMB TO SEE IF IT IS IN THE ADB A TABLE. CLE,SZA IF ZERO OR SSB,RSS BIGGER THAN LEGAL JMP ERN02 GO BOOM! * ADA D$RN INDEX INTO THE RN TABLE STA RNADR SET THE RN ADDRESS XLA A,I GET THE RN ENTRY LDB RQNO,I IS IT OWNED XOR B AND C377 BY THE SAME USER HE THINKS? CLE,SZA JMP ERN03 NO TOO BAD ABOUT THAT! * DALX LDA RQOP TEST FOR AND B40 DEALLOCATE SZA,RSS BIT SET? JMP SET NO GO DO THE SET THING * LDA RQNO,I GET THE RN AND ALF,CLE,ALF MAKE SURE HE OWNS IT AND B377 OWNER ID# TO A CPA B377 IF GLOBAL RSS OR CPA TEMP6 HE IS OWNER CLA,RSS THEN SKIP THE JMP ERN03 BAD NEWS SEND 'RN03' (WATCH E) * XSA RNADR,I CLEAR THE RN ASSIGNMENT LDA D$RN RESCHEDULE JSB $SCD3 ALLOCATION WAITERS JMP CLRN2 GO DO CLEAR SCHEDULING * SET XLA RNADR,I GET THE RN AND B377 MASK TO CURRENT LOCK LDB RQOP GET THE FLAG WORD CCE,SLB,RSS IF LOCK ERB,SLB THEN JMP LOKRN GO DO LOCK * CLRN LDB RQOP CHECK FOR CLEAR RBR,RBR FLAG. IF NOT CLE,SLB,RSS SET JUST JMP EXRN EXIT * SZA IF NEVER LOCKED, THEN OK. CPA B377 IF GLOBALLY LOCKED RSS CPA TEMP6 OR LOCKED BY CALLER RSS THEN OK, ELSE JMP ERN03 SEND 'RN03' (WATCH E) * XLB RNADR,I CLEAR THE RN. XOR B XSA RNADR,I RESTORE THE WORD * CLRN2 JSB SRNW SCHEDULE THE WAITERS EXRN CLB,INB SET THE CLEAR FLAG JMP $RNEX kEXIT TO DISPATCHER PROPERLY * * LOCK RN ROUTINE * LOKRN LDB B377 GET GLOBAL FLAG SEZ IF LOCAL LDB TEMP6 REPLACE WITH LOCAL SZA IF NOT LOCKED CPA TEMP6 OR LOCKED TO CALLER CMA,INA,RSS THEN OK CONTINUE JMP LKSUS ELSE SUSPEND THIS GUY. * LOKIT ADA B SET LOCK FLAG LESS CURRENT ENTRY STB TEMP1 SAVE THE B REG XLB RNADR,I SET THE LOCK FLAG ADA B XSA RNADR,I IN THE RN TABLE LDA TEMP1 SET A=ID OF NEW LOCKER JMP CLRN GO TEST FOR CLEAR OPTION * LKSUS LDA RNADR GET THE SUSPEND FLAG JMP $RNSU AND GO SUSPEND SPC 2 * SRNW SCHEDULES ANY PROGRAMS SUSPENDED IN THE '3' LIST * WITH A FLAG = (RNADR) (USUALLY RN LOCK REQUEST SUSPEND) * SRNW NOP LDA RNADR GET THE FLAG WORD JSB $SCD3 SCHEDULE ALL SUCH WAITERS JMP SRNW,I RETURN * * ERN02 LDB D2 RN02 ERROR RSS ERN03 LDB D3 RN03 ERROR ERN00 LDA ASRN USE RN JMP $ERAB GO BOOM!#$#$%&'" * ASRN ASC 1,RN SKP * LU UNLOCK REQUEST * * D$RN DEF $RNTB+0 FORCE THE GENERATOR TO PRODUCE A DIRECT ADDR D2 DEC 2 D3 DEC 3 D7 DEC 7 B377 OCT 377 C377 OCT 177400 B77 OCT 77 B10 OCT 10 B30 OCT 30 B40 OCT 40 * TEMP1 NOP TEMP6 NOP * RQRTN EQU 1677B RETURN POINT ADDRESS IDNO EQU 1704B USERS ID SEG # RNADR EQU 1705B RN ADDR IN RN TABLE XEQT EQU 1717B ID SEGMENT ADDR. OF CURRENT PROG. XSUSP EQU 1730B 'POINT OF SUSPENSION' * RQOP EQU 1701B RQP2 USED FOR RN OPTION NUMBER RQNO EQU 1702B RQP3 USED FOR ADDR OF RN NUMBER RQST EQU 1703B RQP4 USED FOR ADDR OF RN STATUS ORG * PROGRAM LENGTH END >$"$   92067-18038 1805 S C0122 &LURQ4 RTE-IV LURQ              H0101 dgASMB,R,L,C ** LURQ LU LOCK REQUEST MODULE ** HED ** REAL-TIME EXECUTIVE LURQ LU LOCK REQUEST MODULE ** * NAME: LURQ * SOURCE: 92067-18038 * RELOC: PART OF 92067-16035 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM LURQ,6 92067-16035 REV.1805 771013 * EXT $ERAB,$RNTB,$IDNO,$SCD3,$LUSU,$DRAD EXT $LUSW,$LIBR,$PVCN,$ALRN,$LUEX,$ULLU * ENT LURQ * SUP A EQU 0 B EQU 1 * * * * THE LU LOCK FEATURE ALLOWS A PROGRAM TO LOCK AN LU * TO HIS PROGRAM EXCULSIVELY. ANY OTHER PROGRAM IS * PUT IN THE WAIT LIST WHEN IT REQUESTS EITHER * A LOCK ON THE SAME LU OR WHEN IT ATTEMPTS I/O * ON A LOCKED LU (ASSUMING IT IS NOT LOCKED TO HIM) * * THE WAITING PROGRAM WILL BE RESTARTED WHEN THE * LU IS UNLOCKED. ALL LU'S LOCKED TO A PROGRAM WILL BE * UNLOCKED WHEN THE PROGRAM TERMINATES. LU'S MAY * ALSO BE UNLOCKED SELECTIVELY WITH THE FOLLOWING * CALL. * * CALL TO LOCK/UNLOCK AN LU * * EXT LURQ * * JSB LURQ * DEF *+4 * DEF IOPT ADDRESS OF OPTION FLAG WORD * DEF LUARY ADDRESS OF ARRAY OF LU'S * DEF NOLU ADDRESS OF NUMBER OF LU'S TO LOCK/UNLOCK * RETURN - - * . * . * . *LUARY DEC N1 ARRAY OF LU'S TO BE LOCKED * DEC N2 ONLY THE LEAST 6 BITS ARE USED. * . * . * . *IOPT DEC OPTION OPTIONS FOR THIS CALL SEE BELOW *NOLU DEC NO NUMBER OF LU'S IN THE ARRAY * * OPTIONS ARE: * IOPT MEANING * 0 UNLOCK SPECIFIED LU'S * 1000:00B UNLOCK ALL OWNED LOCKS * 1 LOCK WITH WAIT THE SPECIFIED LU'S * 100001B LOCK WITHOUT WAIT THE SPECIFIED LU'S. * * TO PREVENT A DEAD LOCK AN ARRAY OF LU'S IS TO BE USED * IT IS POSSIBLE TO RELEASE LOCKS ON AN LU AT ANY TIME. * IF A NO WAIT LOCK REQUEST IS MADE AND THE CALLER ALREADY * HAS ONE OR MORE LU'S LOCKED HE WILL BE ABORTED 'LU01' * * ON A NO WAIT RETURN THE A REGISTER INDICATES THE * STATUS AS FOLLOWS: * * A REGISTER MEANING * -1 NO RN AVAILABLE AT THIS TIME * 0 REQUEST SUCESSFUL * 1 ONE OR MORE OF THE LU'S IS ALREADY LOCKED TO * ANOTHER PROGRAM * * POSSIBLE ABORT ERRORS ON THIS REQUEST ARE: * ERROR MEANING * LU01 HE HAS OTHERS LOCKED AND WAIT OPTION * LU02 ILLEGAL LU * LU03 NOT ENOUGH PRAMETERS * RN01 SYSTEM HAS NO RN'S * RN03 HE DOESN'T OWN THE LOCK HE IS TRYING TO RELEASE * * INTERNAL FUNCTION: * * THE USER IS ASSIGNED AN RN WHICH IS LOCKED TO HIM. * THE DRT ENTRY FOR EACH LOCKED LU CONTAINS A POINTER * TO THE RN USED TO DO THE LOCK. * * ALL A PROGRAMS LU LOCKS ARE CONNECTED WITH THE SAME RN * AND THE DRT FIELD IS 5 BITS WIDE, THUS A TOTAL * OF 31 (0 IS RESERVED FOR NO LOCK) PROGRAMS * MAY HAVE LU'S LOCKED AT THE SAME TIME. * THE DRT ENTRY IS IN BITS 6-10 OF THE DRT ENTRY. * SKP LURQ NOP JSB $LIBR PRIVILEGED ENTRY NOP CLA CLEAR CNTR SINCE WE DON'T STA $PVCN PLAN TO RETURN VIA $LIBX * CCA ADA LURQ SET CALLING ADDR IN SUSP. WORD XSA XSUSP,I IN CASE OF SUSPENSION LDA LURQ,I SET RETURN ADDR JSB $DRAD (WORRY ABOUT FTN CALLS.) STA RQRTN IN CASE OF ABORT * ISZ LURQ LDB LURQ,I LDA B,I GET OPTION WORD RAL,CLE,ELA BIT14 TO E RAR,RAR  RESTORE OPTION, LESS NO-ABORT BIT. STA RQOP SAVE CALLER'S OPTIONS. * LDB XSUSP ADB D7 GET ADDR OF STATUS XLA B,I RAL,ERA PUT E INTO BIT15 XSA B,I OF STATUS WORD SSA DID WE SET IT? ISZ RQRTN YES, BUMP RTRN ADDR, NO ABORT BIT SET * ABCAL ISZ LURQ NO LDA LURQ,I JSB $DRAD GET DIRECT ADDR STA RQTB ADDR OF LU ARRAY STA RQP7 SAVE FOR FIRST LOOPS ISZ LURQ LDA LURQ,I JSB $DRAD GET DIRECT ADDR STA RQSZ ADDR OF NUMBER OF LU'S LDA BIT15 CPA RQOP IF REQ IS RELEASE ALL JMP LUUL3 SKIP PARAMS CHECK * LDB RQRTN MAKE SURE THERE ARE CMB,INB ENOUGH PARAMETERS ADB LURQ ELSE SSB,RSS REJECT JMP ELU03 WITH LU03 ERROR * LDB XEQT HERE ON LU LOCK CALL JSB $IDNO GET THE USERS ID NUMBER STB IDNO SET FOR ALLOCATE, ECT BLF,BLF PUT USER OWN/LOCK ADB IDNO FLAG IN STB TEMP6 TEMP6 LDA RQSZ,I GET THE # OF LU'S CMA,INA,SZA IF NEG OR ZERO, SSA,RSS JMP ELU03 'LU03' ERROR * STA TEMP5 SET COUNTERS STA TEMP4 FOR THE TWO LOOPS LDA LUMAX GET THE DRT SIZE CMA SET NEG OF MAX LU STA TEMP3 STA TEMP9 SET FOR BOTH LOOPS LDA RQOP GET THE OPTION FLAG SLA,RSS IF THIS IS NOT LOCK REQ, JMP LUUL1 GO TO RELEASE CODE * * CHECK IF AN RN HAS ALREADY BEEN ASSIGNED * FOR THIS PROGRAMS LU LOCKS. * ISZ TEMP3 STEP LU COUNTER LDB DRT GET THE DRT ADDRESS LULK1 LDA B,I GET LU ENTRY AND B3700 MASK TO LU LOCK FLAG STA RQP8 SAVE THE LOCK FLAG ALF,ALF ROTATE TO RAL,CLE,RAL LOW AND USE TO ADA D$RN INDEX INTO THE RN TABLE XLA A,I GET RN CZODE CPA TEMP6 IF OWNED AND LOCKED BY CALLER JMP LULK8 BY CALLER, JUMP * CCE,INB ELSE STEP DRT ISZ TEMP3 ADDRESS IF NOT END JMP LULK1 CONTINUE SEARCH * CLA CLEAR ALLOCATED FLAG STA RQP8 * LULK2 JSB SWITH SWITCH BATCH LU GET DRT ENTRY SZA IF AVAILABLE CONTINUE CPA RQP8 OR HIS ALREADY RSS ALL OK JMP LULK5 ELSE GO SUSPEND * ISZ TEMP4 STEP THE COUNT DONE?? JMP LULK2 NO TRY NEXT LU. * LDA RQP8 GET THE ALLOCATED FLAG SZA IF AN RN ALREADY ALLOCATED JMP LULK3 GO SET UP * * NO RN ASSIGNED SO ALLOCATE ONE * CLB,INB ASSIGN FROM LOW END OF TABLE JSB $ALRN AND B377 SET RN NUMBER IN A STA B AND B AND B37 IF RN>37B CPA B OR ZERO SZA,RSS THEN GO JMP LULK7 HANG HIM UP. * BLF,BLF MOVE NUMBER TO RBR,RBR BITS 6-10 STB RQP8 AND SET FOR LOCK LOOP LDB TEMP6 GET THE LOCAL LOCK FLAG XSB RNADR,I AND SET IN RN TABLE * LULK3 LDA RQTB RESET THE ARRAY ADDRESS STA RQP7 FOR SWITH LULK4 JSB SWITH GET THE DRT ADDRESS LDA B,I GET DRT ENTRY IOR RQP8 SET LOCK FLAG STA B,I RESET IN THE DRT ISZ TEMP5 IF NOT DONE JMP LULK4 DO THE NEXT ONE * LULKS CLA SET A TO SHOW LULKF XSA XA,I SUCESSFUL COMPLETION JMP $LUEX EXIT VIA LU-RN EXIT CODE * * * LOCKED TO SOME OTHER PROGRAM * LULK5 ALF,ALF IF LOCK IS TO CALLER RAL,RAL THEN ADA D$RN THE LOCK STA RNADR IS TO BE IGNORED CLA,INA SET FAILURE FLAG LULK6 LDB RQOP IF SUSPEND OPTION SSB SUSPEND OPTION? JMP LULKF YES, EXIT LDA RNADR NO, SUSPEND PROGRAM JMP $LUSU * * * rn ALLOCATION FAILED - * LULK7 CLB IF BECAUSE >32B SZA,RSS THEN JMP LULK9 XSB RNADR,I RELEASE THE RN LULK9 LDB D$RN SET SUSP FLAG STB RNADR IN RNADR AND CCA SET THE COMPLETION FLAG JMP LULK6 GO EXIT * * HE HAS AT LEAST ONE LU LOCKED ALREADY * TO PREVENT DEAD LOCK HE MUST NOT CODE * WAIT ON SUBSEQUENT CALLS * LULK8 LDA RQOP GET THE OPTION FLAG ERN01 CME,SSA AND THIS CALL WITH JMP LULK2 WAIT THEN * CLB,INB,RSS SEND 'LU01' ELU02 LDB D2 LU ERROR RSS ELU03 LDB D3 LU ERROR LDA ASLU LU ERROR JMP $ERAB GO BOOM!#$#$%&'" * ASLU ASC 1,LU * * * LUUL1 JSB SWITH DO BATCH SWITCH GET LOCK ECT. STA TEMP3 SAVE IN CASE FOUND ALF,ALF ROTATE TO RAL,RAL LOW A AND ADA D$RN USE TO INDEX THE RN TABLE STA RNADR SAVE THE ADDRESS XLA A,I GET THE FLAG CPA TEMP6 HIS? RSS YES SKIP ERROR EXIT JMP ELU03 NO- TOO BAD, YOU LOSE. * XLA B,I UNLOCK THE XOR TEMP3 LU XSA B,I ISZ TEMP4 DONE? JMP LUUL1 NO TRY NEXT ONE * LDA RNADR SCHEDULE ANY WAITING PROGRAMS JSB $SCD3 * ISZ TEMP9 TEST IF ANY LU'S LDB DRT STILL LOCKED LUUL2 LDA B,I BY CALLER AND B3700 IF SO CPA TEMP3 JUST JMP LULKS EXIT * INB STEP DRT ADDRESS ISZ TEMP9 AN COUNT / DONE? JMP LUUL2 NO TRY NEXT * CLA NO LU'S LOCKED XSA RNADR,I DEALLOCATE THE RN LDA D$RN SCHEDULE ANY ALLOCATION JSB $SCD3 WAITERS AND JMP LULKS EXIT * LUUL3 LDB XEQT RELEASE ALL JSB $ULLU LU'S LOCKED BY JMP LULKS CALLER AND RETURN * SWITH NOP DO BATCH SWITCH IF REQUIRED CCA GET THE LU-1 ADA RQP7,I GET THE LU AND B77 ISOLATE IT STA RQP9 SAVE IN TEMP ISZ RQP7 STEP ADDRESS FOR NEXT TIME LDB XEQT GET THE BATCH FLAG ADB D20 XLB B,I TO B SSB,RSS IF NOT IN BATCH MODE JMP SWEX GO GET THE WORD FROM DRT. * LDB DLUSW GET ADDR OF THE LU SWITCH TABLE XLA B,I GET THE LENGTH CMA,INA SET NEGATIVE FOR COUNTER STA COUNT SET COUNTER * SWNXT INB START THE LOOP XLA B,I GET THE ENTRY AND B77 ISOLATE THIS ENTRY CPA RQP9 THIS IT?? JMP SWIT YES GO GET THE SWITCH * ISZ COUNT NO , END OF TABLE? JMP SWNXT NO TRY NEXT ONE * JMP SWEX YES USE THE GIVEN LU * SWIT XLA B,I GET THE SWITCH LU ALF,ALF TO LOW A AND B77 ISOLATE STA RQP9 SET IN THE TEMP * SWEX LDA RQP9 GET THE LU ADA TEMP9 TEST FOR LEGALITY INA ADJUST FOR -1 CONVENTION CCE,SSA,RSS SKIP IF OK JMP ELU02 ELSE BAIL OUT WITH DIAGNOSTIC * LDB RQP9 GET THE DRT ENTRY ADB DRT LDA B,I TO A AND B3700 ISOLATE IT JMP SWITH,I RETURN B= ADDRESS, A= ISOLATED LOCK FLAG * COUNT NOP D$RN DEF $RNTB+0 FORCE A DIRECT ADDRESS D2 DEC 2 D3 DEC 3 D7 DEC 7 D20 DEC 20 DLUSW DEF $LUSW+0 FORCE A DIRECT ADDRESS BIT15 OCT 100000 B377 OCT 377 B3700 OCT 3700 B77 OCT 77 B37 OCT 37 * TEMP3 NOP TEMP4 NOP TEMP5 NOP TEMP6 NOP TEMP9 NOP * DRT EQU 1652B LUMAX EQU 1653B * RQOP EQU 1701B RQTB EQU 1702B RQSZ EQU 1703B IDNO EQU 1704B RQP5 IS USERS ID SEG # RNADR EQU 1705B RQP6 IS RN ADDR IN RN TABLE * RQRTN EQU 1677B RQP7 EQU 1706B RQP8 EQU 1707B RQP9 EQU 1710B XEQT EQU 1717B XSUSP EQU 1730B XA EQU 1731B ORG * PROGRAM LENGTH END 3*($$*   92067-18039 1805 S C0122 &PRTN RTE-IV PRTN              H0101 jNASMB,L,C ** PRTN TO RETURN PARAMETERS TO SCHEDULING PROG ** HED PRTN TO RETURN PRAMETERS TO THE SCHEDULING PROGRAM * NAME: PRTN * SOURCE: 92067-18039 * RELOC: PART OF 92067-16035 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM PRTN,6 92067-16035 REV.1805 771005 ENT PRTM ENT PRTN EXT $LIBR,$LIBX SPC 2 * THIS ROUTINE IS USED TO PASS FIVE PARAMETERS TO THE PROGRAM * THAT SCHEDULED THE CALLER WITH WAIT. IT DOES NOT HONOR THE * NO PARAMETERS BIT. * * THE SCHEDULING PROGRAM MAY RECOVER THESE PARAMETERS WITH RMPAR. * * THE WAIT FLAG IS CLEARED SO THE CALLER SHOULD HAVE HIGHER * PRIORITY THAN THE SCHEDULER TO PREVENT A SWAP. * * CALLING SEQUENCE: * * JSB PRTN * DEF *+2 STANDARD FORTRAN SEQUENCE * DEF PRAM ADDRESS OF THE FIVE RETURN PRAMATERS * JSB EXEC PROGRAM SHOULD COMPLETE * DEF *+2 * DEF SIX SPC 3 PRTN NOP ENTRY POINT JSB $LIBR GO DO PRIVLEDGE THING COUNT NOP LDA PRTN GET THE ADDRESS OF THE CALL PRAMS LDB A,I GET RETURN ADDRESS STB RTN SAVE IT INA STEP TO PRAM ADDRESS LDA A,I GET PRAM ADDRESS RAL,CLE,SLA,ERA REMOVE POSSIBLE INDIRECT JMP *-2 IF INDIRECT TRY AGAIN STA PRTN SAVE THE PRAM ADDRESS LDA KEYWD GET HEAD OF THE KEY WORD LIST STA PRTM SAVE IT LOCALLY JMP NEXT1+1 GO SCAN THE LIST SPC 1 NEXT CLB,INB ADD ONE ADB A TO IT TO GET THE WAIT ID ADDRESS STB ID ALSO THES PRAM SAVE ADDRESS SAVE IT XLB B,I GET THE WORD CPB XEQT THIS THE SCHEDULING PROGRAM? JMP FOUND LOOKS GOOD GO CHECK THE STATUS NEXT1 ISZ PRTM STEP KEYWORD ADDRESS XLA PRTM,I GET NEXT ENTRY SZA IF END OF LIST EXIT JMP NEXT NOT END TRY NEXT ID SPC 1 EXIT LDA OP1 RESET THE OPTION FOR PRTN ENTRY STA OPTIN JSB $LIBX EXIT TO THE SYSTEM EXIT ROUTINE DEF RTN RETURN ADDRESS SPC 1 RTN NOP ID NOP STAT NOP SPC 2 FOUND LDB D5 CACULATE LAST PRAM ADDRESS ADB A TO B STB LAST SAVE IT FOR TESTING ADB D10 CALCULATE THE STATUS ADDRESS STB STAT SAVE IT XLB B,I GET STATUS OF SCHEDULER BLF,SLB IS HE WAITING? OPTIN CCE,RSS (OR CLE,INA,RSS FOR PRTM) JMP NEXT1 NO TRY NEXT PGM ERB,CLE,ELB CLEAR WAIT BIT(SAVE E-REG.) BLF,BLF ROTATE B THE REST BLF OF THE WAY AROUND OVER SEZ,CLE,INA,RSS ADVANCE POINTER. JMP PRSPR XSB STAT,I SAVE STATUS WITHOUT WAIT BIT IF PRTN. PRSPR LDB PRTN,I GET FIRST PRAM XSB A,I SET PRAM ISZ PRTN STEP ADDRESS CPA LAST LAST PRAMETER? CLB,INB,RSS YES B_1 AND SKIP JMP OVER NO GO DO NEXT ONE ADA D5 YES SET TO B REG ADDRESS LDB ID GET ADDRESS OF PRAM AREA XSB A,I SET BREG SAVE TO POINT TO PRAMS JMP EXIT DONE RETURN TO PGM SPC 3 OP1 CCE,RSS INARS CLE,INA,RSS PRTM ENTRY A OPTION LAST NOP D5 OCT 5 D10 DEC 10 SPC 2 PRTM NOP OPTIONAL ENTRY FOR FOUR JSB $LIBR PRAMETER PASS WITH OUT CLEARING NOP THE WAIT BIT LDA INARS GET THE OPTIONAL INSTRUCTION STA OPTIN SET IT IN THE CODE LDA PRTM GET THE RETURN ADDRESS STA PRTN SET IT IN THE MAIN ENTRY POINT JMP COUN1 T+1 GO TO MAIN LINE AND DO THE JOB SPC 2 A EQU 0 B EQU A+1 KEYWD EQU 1657B XEQT EQU 1717B END   92067-18040 1805 S C0122 &EQLU RTE-IV EQLU              H0101 m)ASMB,R,L,C ** EQLU - FIND 'LU' FROM EQT4 ADDR IN B REG ** HED -EQLU - FIND 'LU' FROM EQT4 ADDRESS IN B-REG * NAME: EQLU * SOURCE: 92067-18040 * RELOC: PART OF 92067-16035 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM EQLU,6 92067-16035 REV.1805 770718 ENT EQLU EXT .ZPRV * * ROUTINE TO FIND THE LOGICAL UNIT NUMBER OF A DEVICE * GIVEN THE ADDRESS OF WORD 4 OF ITS EQUIPMENT TABLE * CALLED AS FOLLOWS: * * LDB EQT4 (PASSED FROM DVR00/DVR65) * * JSB EQLU -OR- JSB EQLU -OR- CALL EQLU (LUSDI) * DEF *+2 DEF *+1 * DEF LUSDI * * A-REG. = 0 IF NOT FOUND -OR- * A-REG. = THE LOGICAL UNIT NUMBER IF FOUND * LUSDI = RETURNED SAME AS A-REG. * B-REG. = ASCII "00" -OR- LOGICAL UNIT IN ASCII (I.E. "16") * SUP EQLU NOP ENTRY JSB .ZPRV DEF LIBX STB EQT4 SAVE B-REG FOR LATER TEST LDA EQLU,I GET ADRS OF RETURN ADDRESS ISZ EQLU BUMP TO POSSIBLE PRAM. LDB EQLU,I GET POSS. ADDRS OF PRAM. CPA EQLU PARAMETER PASSED? CLB NO, SET DUMMY ADRS (A-REG.) STA EQLU SET RETURN POINT FOR $LIBX STB LUADR SET PASSED PRAM. ADDRESS CLA STA LUNUM SET LU POINTER NEXT LDA LUNUM GET CURRENT LU NUM-1 CPA LUMAX DONE THRU ALL LU'S JMP NTFND YES, NOT FOUND!! ISZ LUNUM BUMP TO CURRENT LU ADA DRT POINT TO TABLE ADDRESS LDA 0,I GET CONTENTS AND O77 MASK OF SUBCH  ANNEL BITS MPY D15 CALCULATE ADDRESS OF WORD 4 ADA EQTA BASE ADDRESS ADA DM12 SUBTRACK ONE EQT & ADD DEC 3 CPA EQT4 COMPARE?? JMP FOUND YES !! JMP NEXT NO, TRY NEXT ONE SPC 1 NTFND STB LUNUM NOT FOUND RETURN A=0 FOUND LDA LUNUM FOUND RETURN A= LU NUMBER DIV D10 CONVERT TO ASCII ALF,ALF POSITION MOST SIG. DIGIT ADB 0 MIRGE IN LEAST ADB ASC00 CONVERT TO ASCII LDA LUNUM RESTORE BINARY VALUE STA LUADR,I PASS BACK TO CALLER LIBX JMP EQLU,I RETURN A=BIN. VALUE, B= ASCII VALUE DEF EQLU SPC 1 EQT4 NOP LUADR NOP LUNUM NOP O77 OCT 77 D10 DEC 10 ASC00 ASC 1,00 D15 DEC 15 DM12 DEC -12 EQTA EQU 1650B DRT EQU 1652B LUMAX EQU 1653B END ?   92067-18041 1805 S C0122 &DRCT4 RTE-IV .DRCT              H0101 s2ASMB,L HED .DRCT ROUTINE * NAME: .DRCT * SOURCE: 92067-18041 * RELOC: PART OF 92067-16035 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM .DRCT,7 92067-16035 REV.1805 741120 SPC 1 ENT .DRCT * CALLING SEQUENCE * THIS ROUTINE TRACKS DOWN POSSIBLE INDIRECT ADDRESSES * * JSB .DRCT * DEF ADDR * RETURN IS TO HERE WITH A THE ADDRESS * B IS UN ALTERED E IS LOST .DRCT NOP LDA .DRCT LDA A,I RAL,CLE,SLA,ERA JMP *-2 ISZ .DRCT JMP .DRCT,I A EQU 0 END   92067-18042 1826 S C0122 &REIO4 RTE-IV REIO              H0101 KTASMB,L,C ** REIO ** * NAME: REIO * SOURCE: 92067-18042 * RELOC: PART OF 92067-16035 * PGMR: G.A.A.,C.M.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM REIO,7 92067-16035 REV.1826 780509 EXT .DFER,$LIBR,$LIBX,EXEC,.ENTR ENT REIO SUP SPC 1 * THIS ROUTINE DOES REENTRENT I/O IF THE USERS BUFFER * IS 5 OR MORE WORDS ABOVE THE PROG LOAD POINT. * THIS RESTRICTION IS ENFORCED BECAUSE THE USERS BUFFER * IS USED AS A TDB FOR THE REENTRANT PROCESSOR AND THUS * THREE WORDS(PLUS 2 FOR SAVE X AND Y REG WORDS) * ARE REQUIRED AHEAD OF IT. * * THESE THREE WORDS ARE SAVED LOCALLY AND THE TDB IS SET UP * AFTER THE I/O HAS COMPLETED THE WORDS ARE RESTORED. * * IF THE BUFFER IS TOO CLOSE TO THE FENCE THE I/O IS PREFORMED * IN THE STANDARD MANNER. THIS IS ALSO TRUE IF THE BUFFER IS * MORE THAN 129 WORDS LONG (TO CONSERVE SYSTEM MEMORY). * * CALLING SEQUENCE: * * THE SAME AS THE EXEC I/O CALL WITH OUT THE TRACK/SECTOR WORDS. * RQ BSS 4 PRAMETER ADDRESS AREA REIO NOP ENTRY POINT JSB .ENTR FETCH THE PRAMETERS DEF RQ LDA RQ+3,I PULL PRAMETERS IN LOCALLY STA RQ+3 INCASE THEY ARE LDA RQ,I ARE IN THE THREE WORD STA RQ AREA AHEAD OF LDA RQ+1,I THE BUFFER STA RQ+1 * LDA XEQT GET THE PROGRAM LOAD ADA D22 POINT XLA A,I LDB RQ+2 AND THE BUFFER ADDRESS CMB,INB NOW MAKE SURE THAT THE BUFFER ADB A IS NOT WITHIN 5 WORDS OF THE CL|E,SSB,RSS LOAD POINT. JMP DIRIO BUFFER BELOW PROG MUST BE IN COMMON ADB D4 BUFFER ABOVE LOAD POINT, BUT IS IT CLE,SSB,RSS WITHIN 5 WORDS ? JMP DIRIO YES, SO FORGET IT * LDA RQ+2 GET THE BUFFER ADDRESS ADA N3 LESS THREE & SET STA TDBA UP THE $LIBR & STA TDBA2 $LIBX CALLS. * OK JSB .DFER ELSE SAVE THE THREE WORDS DEF S1 IN LOCAL SAVE AREA DEF TDBA,I LDB RQ+3 GET THE REQUEST LENGTH SSB,RSS IF POSITIVE SKIP CONVERSION JMP RE1 * BRS CONVERT CHARACTERS TO CMB,INB WORDS AND SET POSITIVE RE1 ADB D3 ADD THREE WORDS FOR TDB LENGTH STB A AND PUT IN A FOR LENGTH TEST ADA N133 SUBTRACT 133 (129 + 3 + 1) CLE,SSA,RSS IF POSITIVE OF ZERO JMP DIRIO DO IT DIRECT * CLA,CCE SET ZERO IN WORD ONE AND DST TDBA,I LENGTH IN WORD TWO OF THE TDB JSB DOIO GO DO THE I/O S1 OCT 0,0,0 RETURN SKIPS THREE WORDS DST RQ SAVE THE REGISTERS JSB .DFER RESTORE THE THREE WORDS DEF TDBA,I DEF S1 DLD RQ RESTORE THE A AND B REGS. JMP REIO,I AND EXIT TO USER. * DOIO NOP JSB $LIBR TELL THE SYSTEM WE ARE TDBA DEF * RENT DIRIO JSB EXEC DO THE I/O CALL DEF EX RETURN ADDRESS DEF RQ DEF RQ+1 DEF RQ+2,I DEF RQ+3 EX RSS SKIP IF ERROR EXIT ISZ REIO ELSE STEP RETURN ADDRESS SEZ,RSS IF DIRECT JMP REIO,I EXIT * JSB $LIBX ELSE EXIT RENT TDBA2 DEF * SECTION D3 DEC 3 +3 WORDS * N133 DEC -133 N3 DEC -3 N2 DEC -2 D22 DEC 22 D4 DEC 4 FENCE EQU 1775B XEQT EQU 1717B A EQU 0 ORG * END    92067-18043 1805 S C0122 &IFBRK4 RTE-IV IFBRK              H0101 hsASMB,R,L,C ** IFBRK ** HED R/T IFBRK MODULE * NAME: IFBRK * SOURCE: 92067-18043 * RELOC: PART OF 92067-16035 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM IFBRK,6 92067-16035 REV.1805 770621 * ENT IFBRK EXT $LIBR,$LIBX SPC 2 * CALLING SEQUENCE: * * IF(IFBRK(IDMY)) 10,20 * * WHERE: 10 BRANCH WILL BE TAKEN IF SET & WILL CLEAR IT. * 20 BRANCH WILL BE TAKEN IF NOT SET * * JSB IFBRK * DEF *+1 * A-REG. = -1 IF SET, ELSE A-REG = 0 * BREAK BIT WILL ALWAYS BE CLEARED IF SET! SPC 1 IFBRK NOP ENTRY FROM FTN JSB $LIBR TURN OFF INTERRUPTS NOP LDA IFBRK,I GET P+1 ADDRESS STA IFBRK SET RETURN ADDRESS LDB XEQT GET IDSEG ADDRESS OF THIS PROG ADB D20 GET ID(21) ADDRESS XLA B,I GET CONTENTS AND BIT12 MASK DOWN TO BIT 12 SZA,RSS SET? JMP IFBRE NO, RETURN A=0 STB TEMP XLB B,I XOR B YES, CLEAR IT XSA TEMP,I RESTORE WORD 21 CCA RETURN A-REG. = -1 IFBRE JSB $LIBX DEF IFBRK SPC 1 D20 DEC 20 BIT12 OCT 10000 XEQT EQU 1717B TEMP NOP B EQU 1 END [  92067-18044 1805 S C0122 &CORA4 RTE-IV COR.A              H0101 b6ASMB,L ** COR.A ** HED COR.A ROUTINE * NAME: COR.A * SOURCE: 92067-18044 * RELOC: PART OF 92067-16035 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM COR.A,6 92067-16035 REV.1805 770621 ENT COR.A EXT .ZPRV * * ROUTINE TO FIND THE ADDRESS OF THE FIRST WORD OF AVAIL MEM. * FOR A GIVEN ID SEGMENT * * CALLING SEQUENCE: * * LDA IDSEG GET ID SEGMENT ADDRESS TO A * JSB COR.A CALL THIS ROUTINE * RETURN A= FIRST WORD OF AVAIL MEM (MEM2 FROM ID) * COR.A NOP JSB .ZPRV DEF LIBX ADA .14 INDEX TO THE NAME 5 WORD XLB A,I GET THE WORD BLF,BLF ROTATE THE BLF,SLB SHORT ID FLAG TO LOW B AND TEST INA,RSS SHORT SO INDEX TO MEM ADA .8 LONG SO INDEX TO MEM INA INDEX TO MEM2 XLA A,I SET IT IN A LIBX JMP COR.A,I RETURN DEF COR.A * .14 DEC 14 .8 DEC 8 A EQU 0 END "  92067-18045 1805 S C0122 &CORB4 RTE-IV COR.B              H0101 e6ASMB,R,L,C ** COR.B ** HED COR.B ROUTINE * SOURCE: 92067-18045 * RELOC: PART OF 92067-16035 * PGMR: S.P.K. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM COR.B,6 92067-16035 REV.1805 770816 ENT COR.B EXT .ZPRV * * * THIS ROUTINE RETURNS THE FWA OF FREE MEMORY FOR * A MAIN PROGRAM, THIS ADDRESS IS HIGH MAIN + 1 * FOR A NON-SEGMENTED PROGRAM, AND HIGH LARGEST SEGMENT * SEGMENT + 1 FOR A SEGMENTED PROGRAM * * CALLING SEQUENCE: * A REG = ID SEGMENT ADDRESS OF MAIN PROGRAM * JSB COR.B * RETURNS: * A REG = 0 IF NORMAL RETURN * = -1 IF ERROR RETURN, B REG IS MEANINGLESS * B REG = FWA OF FREE MEM FOR MAIN PROGRAM * * COR.B MAKES AN ERROR RETURN IF THE ID SEGMENT ADDRESS * PASSED IS THAT OF A SHORT ID SEGMENT * * COR.B NOP JSB .ZPRV DEF LIBX ADA .14 POINT TO THE NAME 5 WORD XLB A,I GET THE WORD BLF,BLF BLF,SLB SHORT ID SEG FLAG SET? JMP ERROR YES, THEN ERROR RETURN ADA .9 NO, POINT TO HIGH MAIN + 1 WORD XLB A,I GET CONTENTS ADA .6 POINT TO HIGH LARGEST SEG + 1 WORD XLA A,I GET CONTENTS SZA SEGMENTED PROGRAM? LDB A YES, RETURN WITH HIGH LARGEST SEG+1 ADDR CLA,RSS NORMAL RETURN * ERROR CCA ERROR RETURN LIBX JMP COR.B,I RETURN DEF COR.B * * .6 DEC 6 .9 DEC 9 .14 DEC 14 * A EQU 0 B EQU 1 END i    92067-18046 1805 S C0122 &CV134 RTE-IV $CV13              H0101 4 ASMB,R,L,C HED $CVT1 AND $CVT3 ROUTINES * SOURCE: 92067-18046 * RELOC: PART OF 92067-16035 * PGMR: S.P.K. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** NAM $CVT3,6 92067-16035 REV.1805 770621 ENT $CVT3 ENT $CVT1 EXT .ZPRV HED $CVT3(BINARY TO ASCII CONVERSION) * * BINARY TO ASCII CONVERSION ROUTINE * * CALLING SEQUENCE * * SET E TO 0 IF OCTAL CONVERSION OR * SET E TO 1 FOR DECIMAL CONVERSION * LDA NUMBER TO BE CONVERTED * JSB $CVT3 * * RETURN ADDRESS OF ASCI IN A AND E=1. * RESULTS IN ASCI, ASCI+1, ASCI+2 * LEADING 0'S SUPPRESSED * $CVT3 NOP ENTRY/EXIT JSB .ZPRV DEF LIBX STB TEMP6 SAVE B REGISTER LDB PTTE INIT LOCATION OF BUFFER STB TMP LDB AASCI SET BUFFER=ASCII BLANK'S STB ASCI STB ASCI1 STB ASCI2 LDB DF10 ASSUME BASE TEN SEZ,CLE,RSS IF BASE EIGHT INB SET UP FOR BASE EIGHT STB BASE SET CONVERSION BASE ADDRESS DPCRL CLB START CONVERSION DIV BASE DIVIDE BY BASE BASE EQU *-1 DEFINE BASE ADDRESS ADB B20 CONVERT TO ASCII-BLANK SEZ IF HIGH DIGIT BLF,BLF ROTATE ADB TMP,I ADD CURRENT VALUE STB TMP,I STORE THE CONVERTED VALUE CCB,SEZ PREPARE FOR SUBTRACT ADB TMP IF HIGH CHAR. BACKUP SEZ,CME BUFFER POINTER STB TMP AND RESET SZA IF MORE DIGITS JMP DPCRL GO SET THE NEXT ONE    * CCE SET E FOR NEXT CALL (ASSUME BASE 10) LDA PTT LOAD A WITH ASCI BUFFER ADDRESS LDB TEMP6 RESTORE B LDX ASCI2 LOAD X WITH LEAST TWO DIGITS LIBX JMP $CVT3,I RETURN DEF $CVT3 * B20 OCT 20 DF10 DEF D10 D10 DEC 10 D8 DEC 8 PTT DEF ASCI PTTE DEF ASCI2 ASCI NOP ASCI1 NOP ASCI2 NOP AASCI ASC 1, TEMP6 NOP TMP NOP * * $CVT1 NOP ENTRY FOR ONE WORD JSB .ZPRV DEF CLIBX JSB $CVT3 CONVERT IT LDA ASCI2 GET THE LEAST SIG WORD CLIBX JMP $CVT1,I DEF $CVT1 END `   92067-18047 1805 S C0122 &KCVT4 RTE-IV KCVT              H0101 W\ASMB,R,L ** KCVT ** HED CONVERT ROUTINE * NAME: KCVT * SOURCE: 92067-18047 * RELOC: PART OF 92067-16035 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM KCVT,6 92001-16035 REV.1805 770621 ENT KCVT * * EXT .ENTP,$CVT3,.ZPRV * NUMBR BSS 1 * KCVT NOP JSB .ZPRV DEF LIBX JSB .ENTP DEF NUMBR LDA NUMBR,I CCE JSB $CVT3 CXA GET LEAST TWO DIGITS LIBX JMP KCVT,I RETURN DEF KCVT END r   92067-18048 1840 S 0122 RTE-IV MESSS              H0101 ASMB,R,Q,C HED MESSS * NAME: MESSS * SOURCE: 92067-18048 * RELPC: 92067-16035 * PGMR: G.A.A.,C.M.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM MESSS,7 92067-16035 REV.1840 780724 ENT MESSS EXT $LIBR,$LIBX,$MESS,.ENTP,$WORK,$PVCN,$$OP SPC 2 SPC 2 BUFFR NOP LNGTH NOP P1 NOP MESSS NOP JSB $LIBR GO PRIVILEGED. CNTR NOP JSB .ENTP GET PARAMETERS. DEF BUFFR LDA MESSS LDB HERE SZB JMP EXIT2 THERE STA RTN STA HERE LDA DEFEF STA MESSS CLA STA $PVCN LDA BUFFR LDB LNGTH,I JSB $MESS PASS MESSAGE TO SYSTEM. ISZ $PVCN SZA,RSS JMP CHECK IF NO RETURNED MESSAGE, THEN CHECK XLB A,I FOR SPECIAL PATCHING OF 'RU' OR 'ON' STB LNGTH OTHERWIZE PROCESS MESSAGE. BRS STB CNTR LOOP INA XLB A,I STB BUFFR,I ISZ BUFFR ISZ CNTR JMP LOOP * LDA LNGTH EXIT CLB STB HERE STB P1 EXIT1 JSB $LIBX DEF DEF RTN RTN NOP HERE NOP DEFEF DEF DEF SPC 2 26 CHECK LDB $WORK GET PROGRAM'S ID SEGMENT ADDRESS. INB LDA BUFFR,I TEST FOR ON,RUN CPA .ON COMMANDS JMP DP1 TEST 1ST PRAM CPA .RU JMP DP1 JMP DP2 SPC 2 DP1 XLA B,I LU# IF GIVEN SZA,RSS IN FIRST LDA P1,I PARAMETER. XSA B,I * DP2 XLA $$OP,I GET THE OP CODE THE SYS PARSED CPA .ON ON ? JMP DP3 CP  A .RU RU ? JMP DP3 JMP EXIT2 * DP3 LDB XEQT GET MY ID ADDRESS JSB SES#3 NOW GET THE SESSION WORD XLA B,I STA HERE & SAVE IT * LDB $WORK GET THE SON'S ID ADDRESS JSB SES#3 AND GET IT'S SESSION WORD ADDRESS LDA HERE GET THE FATHERS WORD XSA B,I AND PROPIGATE TO THE SON. * * EXIT2 CLA ZERO OUT 'A' REG FOR RETURN JMP EXIT SPC 2 * SES#3 NOP ADB D14 INDEX TO TYPE WORD XLA B,I GET THE TYPE AND D7 KEEP ONLY TYPE CPA D1 IS IT MEM RES ? ADB DM4 ADB D18 B = SESSION WORD # 3 ADDRESS JMP SES#3,I RETURN * * .ON ASC 1,ON .RU ASC 1,RU D1 DEC 1 D5 DEC 5 D7 DEC 7 D14 DEC 14 D18 DEC 18 D29 DEC 29 DM4 DEC -4 A EQU 0 B EQU 1 XEQT EQU 1717B * END   92067-18049 1840 S 0122 RTE-IV $PARS              H0101 ASMB,R,L,C HED $PARS - PARSE SUBROUTINE FOR OPERATOR MESSAGES * SOURCE: 92067-18049 * RELOC: PART OF 92067-16035 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** NAM $PARS,6 92067-16035 REV.1840 780811 ENT $PARS EXT .ZPRV * CALLING SEQUENCE: * LDA BUFFER ADDRESS * LDB CHARACTER COUNT * JSB $PARS * DEF PRAM BUFFER * -RETURN- * * THE PRAM BUFFER IS 33 WORDS LONG AND CONTAINS UP TO 8 * PRAMETER DESCRIPTERS FOLLOWED BY THE PRAMETER COUNT. * * EACH PARAMETER DESCRIPTER CONSISTS OF FOUR WORDS: * * WORD MEANING * 1 FLAG WORD 0=NULL PRAMETER * 1=NUMERIC PRAMETER * 2=ASCII PRAMETER * 2 0 IF NULL,VALUE IF NUMERIC,ASCII(1,2) IF ASCII * 3 0 IF NOT ASCII ELSE ASCII(3,4) * 4 0 IF NOT ASCII ELSE ASCII(5,6) * * TEMP USAGE IN PARSE SECTION: * * TEMPP = CHARACTER ADDRESS * TEMP = PARAMETER FLAG ADDRESS * TEMP1 = TEMP BUFFER FETCH ADD. * TEMP2 = TEMP BUFFER STORE ADD. * TEMP3 = LAST INPUT CHAR.+1 ADD. * TEMP4 = PARAMETER VALUE ADDRESS. * TBUF = DEF TEMP5 (6 LOCATIONS) * TBUFS = DEF TEMP5+7 * $PARS NOP JSB .ZPRV DEF LIBX CLE,ELA MAKE CHARACTER ADD. STA !6TEMPP SET BUFFER CHAR ADD. ADA B COMPUTE END ADDRESS. STA TEMP3 AND SET IT. LDB DM32 CLEAR PARAMETER AREA STB TEMP LDB $PARS,I CLA MES1 STA B,I INB ISZ TEMP JMP MES1 * STA B,I CLEAR THE PRAM COUNT STB WSTAT SET ADDRESS OF PRAM COUNT DEC09 LDA TBUF INITIALIZE TEMP BUFFER ADDRESS STA TEMP1 STA TEMP2 * DEC10 LDB TEMPP GET THE BUFFER CHAR ADDRESS CPB TEMP3 IF NO MORE CHARACTERS JMP DEC60 GO PROCESS PRAM ISZ TEMPP STEP INPUT POINTER CLE,ERB CONVERT TO WORD SET UP LOW IN E LDA B,I GET WORD FROM THE BUFFER SEZ,RSS CHECK IF TO EXAMINE UPPER/LOWER ALF,ALF UPPER, SO ROTATE TO LOWER BITS AND B377 MASK OFF ALL BUT LOW ORDER CPA COM SEE IF A COMMA JMP DEC60 YES CPA LASCI CHECK IF BLANK CHARACTER JMP DEC10 YES, SO SKIP CHARACTER LDB TEMP2 CHECK IF 6 CHARACTERS IN PRAM CPB TBUFS IF SO JMP DEC10 SKIP STORE STA TEMP2,I STORE THE CHARACTER STA SABRT SAVE THE LAST CHARACTER ISZ TEMP2 STEP FOR NEXT CHAR. * JMP DEC10 GO TO PROCESS NEXT CHARACTER * * ATTEMPT NUMERIC CONVERSION OF PRAM. * DEC60 LDA WSTAT,I FIRST SET UP POINTERS RAL,RAL TAKE 4 TIMES THE PRAM NUMBER ADA $PARS,I PLUS THE OP CODE ADDRESS-1 STA TEMP SET FLAG ADDRESS CLE,INA ONE MORE AND WE HAVE STA VALOC THE PRAMETER VALUE LOCATION LDA TEMP2 IF NO CHARACTERS CPA TBUF INPUT JMP DEC75 GO TRY NEXT ONE * * NOW TRY FOR A NUMBER * ISZ TEMP,I SET FLAG TO 1 FOR NUMBER LDB TEMP1,I GET FIRST CHAR CPB DASH MINUS SIGN? ISZ TEMP1 YES, INCRE TO NEXT CHAR CPA TEMP1 (A) STILL = TEMP2 JMP DEC80 IF "-" WAS ONLY CHAR, THEN ASCII * LDB D10 SET UP CONVERSION BASE LDA SABRT CPA "B" IF B SUFFIX LDB D8 SET FOR BASE 8 STB TEMP4 SET BASE DEC65 MPY VALOC,I BUMP THE CURRENT VALUE VALOC EQU *-1 LDB TEMP1,I GET THE NEXT CHAR. ADB DM58 IF GREATER THAN "9" SEZ,CLE,RSS THEN NOT A NUMBER ADB D10 IF LESS THAN "0" SEZ,CLE,RSS THEN JMP DEC80 NOT A NUMBER ADA B ACCUMULATE THE STA VALOC,I NUMBER ISZ TEMP1 STEP THE BUFFER ADDRESS LDA TEMP4 GET THE BASE TO A LDB TEMP1 AND THE NEXT CHAR. LOC. TO B CPB TEMP2 IF END THEN JMP DEC70 GO TO NEXT PRAM * INB IF BASE 8 CONVERSION CPB TEMP2 AND LAST CPA D10 CHAR. THEN DONE SO SKIP JMP DEC65 ELSE GO GET THE NEXT ONE * SPC 1 DEC70 LDB VALOC,I GET VALUE LDA TBUF,I IF NEG NUMBER, CPA DASH CMB,INB NEGATE VALUE STB VALOC,I STORE VALUE * DEC75 ISZ WSTAT,I COUNT THE PRAMETER LDA WSTAT,I IF LDB TEMP3 EOL OR CPB TEMPP 8 PRAMS LINE RSS THEN CPA D8 JMP DEC90 GO PROCESS JMP DEC09 ELSE GO GET NEXT CHARACTER SPC 1 DEC80 ISZ TEMP,I SET NOT NUMBER FLAG LDA AASCI FILL THE PRAM WITH BLANKS LDB VALOC PRAM ADDRESS TO B INB DON'T WORRY ABOUT FIRST WORD STA B,I SET SECOND WORD CLE,INB STEP TO THIRD WORD STA B,I SET THIRD WORD TO DOUBLE BLANK. LDB TBUF GET THE TEMP BUFFER POINTER DEC85 CPB TEMP2 END OF INPUT? JMP DEC75 YES GO PROCESS NEXT PRAM CPB STOP SIXTH CHAR YET? JMP DEC75 YES, END PARAM LDA B,I GET THE CHARACTER SEZ,RSS IF UPPER CHARACTER ALF,SLA,ALF ROTATE AND SKIP XOR VALOC,I LOWER ADD THE UPPER CHAR. XOR LASCI ADD/DELETE THE LOWER BLANK STA VALOC,I STORE THE PACKED WORD SEZ,CME,INB STEP B,SKIP IF UPPER ISZ VALOC ELSE STEP STORE ADDRESS. JMP DEC85 GO GET OTHER CHAR. SPC 2 DEC90 ISZ $PARS STEP RETURN ADDRESS LIBX JMP $PARS,I RETURN DEF $PARS SPC 2 "B" OCT 102 ASCII "B" DASH OCT 55 ASCII "-" STOP DEF TEMP5+6 ASCII 6TH CHAR STOP * * TEMP NOP TEMP1 NOP TEMP2 NOP TEMP3 NOP TEMP4 NOP TEMP5 NOP TEMP6 NOP TMP NOP NOP WPRIO NOP ASCI NOP ASCI1 NOP ASCI2 NOP * TEMPP NOP DM32 DEC -32 WSTAT NOP TBUF DEF TEMP5 TBUFS DEF TEMP5+7 DM58 DEC -58 COM OCT 54 SABRT NOP D10 DEC 10 D8 DEC 8 AASCI ASC 1, B377 OCT 377 LASCI OCT 40 A EQU 0 B EQU 1 END j  92067-18050 1805 S C0122 &PRSE4 RTE-IV PARSE              H0101 v\ASMB,R,L ** PARSE ** HED PARSE ROUTINE * NAME: PARSE * SOURCE: 92067-18050 * RELOC: PART OF 92067-16035 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM PARSE,6 92067-16035 REV.1805 770714 ENT PARSE * EXT $PARS,.ENTP,.ZPRV * CMBUF BSS 1 BFLEN BSS 1 BUFR BSS 1 * PARSE NOP JSB .ZPRV DEF LIBX JSB .ENTP DEF CMBUF LDA BUFR STA BUFR1 LDA CMBUF LDB BFLEN,I JSB $PARS BUFR1 BSS 1 LIBX JMP PARSE,I RETURN DEF PARSE END   92067-18051 1805 S C0122 &TMVL4 RTE-IV TMVAL              H0101 ]ASMB,L,C ROUTINE TO CONVERT TIME HED TMVAL * NAME: TMVAL * SOURCE: 92067-18051 * RELOC: PART OF 92067-16035 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM TMVAL,6 92067-16035 REV.1805 770715 ENT TMVAL EXT $LIBR,$LIBX,.ENTP * * * CALLING SEQUENCE (FORTRAN) * * CALL TMVAL(ITM,ITMAR) * * WHERE ITM IS THE TWO WORD NEGATIVE TIME IN TENS OF * MS. AND ITMAR IS A 5 WORD ARRAY TO RECIEVE THE * TIME. THE ARRAY WILL BE SET UP AS: * * 1. TENS OF MS. * 2. SECONDS * 3. MINUTES * 4. HOURS * 5. CURRENT SYSTEM DAY OF YEAR (NOT RELATED TO CALL VALUES) * ITM NOP ITM1 NOP * TMVAL NOP JSB $LIBR NOP JSB .ENTP GET PRAMS DEF ITM * LDA ITM1 SET ADDRESS STA RQP2 FOR SYSTEM ROUTINE DLD ITM,I GET THE TIME JSB $TIMV CONVERT IT JSB $LIBX EXIT DEF TMVAL * HED $TIMV ROUTINE TO GET CURRENT SYSTEM TIME * THE $TIMV ROUTINE CONVERTS THE CURRENT REAL TIME VALUES * * AND STORES THE VALUES INTO A USER SPECIFIED BUFFER. * * * * ROUTINE TO PROVIDE CURRENT TIME * CALLING SEQUENCE * DLD TIME PUT TIME IN A AND B REGS. * JSB $TIMV * RQP2 CONTAINS BEGIN ADDRESS OF 5 WORD BUFFER * ON RETURN, * ARRAY(1) = TENS OF MILLISECOND * ARRAY(2) = SECONDS * ARRAY(3) = MINUTES * ARRAY(4) = HOURS * X   ARRAY(5) = DAYS * * E IS SET * A IS THE YEAR * $TIMV NOP ENTRY/EXIT (END OF SET TIME MSS.) CLE CLE FOR ADDITION ADA PRS1 ADD POSITIVE 24 HRS. SEZ TO GET A POSITIVE INB TIME ADB PRS2 DIV TTAB3 DIVIDE BY 6000 STA RQP4 SAVE MIN/HR ASR 16 POSITION B (SEC/10MS) FOR DIVIDE DIV TTAB2 DIVIDE BY 100 TO GET SEC/10MS STB RQP2,I SET 10MS VALUE ISZ RQP2 STEP ADDRESS POINTER STA RQP2,I SET SEC. VALUE ISZ RQP2 STEP TO MIN. ADDRESS. CLB SET UP FOR DIVIDE LDA RQP4 FETCH MIN/HR DIV D60 SEPERATE STB RQP2,I SET MINUTES ISZ RQP2 STEP TO HR. ADDRESS STA RQP2,I SET HRS ISZ RQP2 STEP ADDRESS CLB SET B FOR DIVIDE LDA $TIME+2 GET DAYS FORM THE TIME DIV D365 SEPERATE DAYS AND YEARS CCE,INB STEP DAYS TO 1-365 FROM 0-364 STB RQP2,I SET DAYS JMP $TIMV,I RETURN SPC 2 D60 DEC 60 D365 DEC 365 D1970 DEC 1970 BASE YEAR DM197 DEC -1970 NEG OF BASE YEAR PRS1 OCT 153000 PRS2 OCT 203 TTAB3 DEC 6000 TTAB2 DEC 100 $TIME OCT 16000 OCT 177650 DAYS OCT 4552 RQP2 EQU 1701B RQP3 EQU 1702B RQP4 EQU 1703B END f   92067-18052 1805 S C0122 &CNMD4 RTE-IV CNUMD              H0101 hPASMB,L,R ** CNUMD ** HED CNUMD...ROUTINE TO CONVERT BINARY TO ASC * NAME: CNUMD * SOURCE: 92067-18052 * RELOC: PART OF 92067-16035 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM CNUMD,6 92001-16035 REV.1805 770621 SPC 2 * * ROUTINE TO CONVERT BINARY TO OCTAL. USED IN * RTEII * CALLING SEQUENCE * JSB CNUMD * DEF *+3 * DEF BINARY # TO BE CONVERTED * DEF BUFFER * . * . *BUF BSS 3 * SPC 2 * * DEFINE ENTRY POINT * ENT CNUMD SPC 2 * * DEFINE EXTERNAL * EXT .ENTP,.DFER,$CVT3,.ZPRV SPC 4 * * HERE WE START BY DEFINING PRAM AREA * BINA NOP BINARY # ADDRESS WILL APPEAR HERE BUFA NOP BUFFER ADDRESS WILL APEAR HERE CNUMD NOP ENTRY POINT INTO ROUTINE JSB .ZPRV DEF LIBX JSB .ENTP GO GET PRAMS DEF BINA CCE SET FOR BINARY TO DEC. CONVERSION LDA BINA,I GET NUMBER JSB $CVT3 GO CONVERT IT STA FROM SAVE ADDRESS FROM JSB .DFER AND MOVE IT DEF BUFA,I WHERE TO PUT IT FROM NOP LIBX JMP CNUMD,I AND RETURN DEF CNUMD END T  92067-18053 1805 S C0122 &CNMO4 RTE-IV CNUMO              H0101 PASMB,L,R ** CNUMO ** HED CNUMO...ROUTINE TO CONVERT BINARY TO ASC * NAME: CNUMO * SOURCE: 92067-18053 * RELOC: PART OF 92067-16035 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM CNUMO,6 92067-16035 REV.1805 770621 SPC 2 * * ROUTINE TO CONVERT BINARY TO OCTAL. USED IN * RTEII * CALLING SEQUENCE * JSB CNUMO * DEF *+3 * DEF BINARY # TO BE CONVERTED * DEF BUFFER * . * . *BUF BSS 3 * SPC 2 * * DEFINE ENTRY POINT * ENT CNUMO SPC 2 * * DEFINE EXTERNAL * EXT .ENTP,.DFER,$CVT3,.ZPRV SPC 4 * * HERE WE START BY DEFINING PRAM AREA * BINA NOP BINARY # ADDRESS WILL APPEAR HERE BUFA NOP BUFFER ADDRESS WILL APEAR HERE CNUMO NOP ENTRY POINT INTO ROUTINE JSB .ZPRV DEF LIBX JSB .ENTP GO GET PRAMS DEF BINA CLE SET FOR BINARY TO OCTAL CONVERSION LDA BINA,I GET NUMBER JSB $CVT3 GO CONVERT IT STA FROM SAVE ADDRESS FROM JSB .DFER AND MOVE IT DEF BUFA,I FROM NOP LIBX JMP CNUMO,I AND RETURN DEF CNUMO END   92067-18054 1805 S C0122 &IPRS4 RTE-IV INPRS              H0101 `ASMB,R,L,C ** INPRS ** HED INPRS - PREAMBLE * NAME: INPRS * SOURCE: 92067-18054 * RELOC: PART OF 92067-16035 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM INPRS,6 92067-16035 REV.1805 770621 SUP PRESS EXTRANEOUS LISTING ENT INPRS EXT .ENTP,$CVT3,.ZPRV SPC 1 A EQU 0 B EQU 1 HED INPRS : DESCRIPTION * CALLING EXAMPLE : * FTN,L * PROGRAM R$PN$(2,10) * INTEGER BUFFER(22),PARBUF(33),PRAM(5),IREG(2),P1,P2,CLASS * EQUIVALENCE (PRAM(1),CLASS), * & (PRAM(2),IREG,REG,IA), * & (PRAM(3),IB), * & (PRAM(4),IC), * & (PRAM(5),ID) * CALL RMPAR(PRAM) * 1 REG = EXEC(21,BUFFER,22,IC,ID,CLASS) * CALL PARSE(BUFFER,IB,PARBUF) * <"ON" REQUEST - PARBUF(2)="ON" ?> * * * CALL INPRS(PARBUF,PARBUF(33)) * IC = MESSS(BUFFER,IB) * * * GO TO 1 * END SPC 2 * THE BUFFER 'PARBUF' LOOKS LIKE : SPC 2 * PARBUF(1) * PRAM(1) TYPE * (2) * VALUE(1) * (3) * (2) * (4) * (3) * (5) * PRAM(2) TYPE * (6) * VALUE(1) * (7) * (2) * (8) * (3) SPC 1 * ET CETERA SPC 1 * PARBUF(33)* NUMBER OF PARAMETERS PARSED SPC 2 * WHERE : TYPE = 0 => NULL PARAMETER * 1 => NUMERIC PARAMETER IN VALUE(1) *  2 OR 3 => ASCII PARAMETERS IN VALUE(1) TO VALUE(3) HED INPRS : MAIN BUF NOP #P NOP INPRS NOP JSB .ZPRV DEF LIBX JSB .ENTP DEF BUF SPC 2 LDA #P,I SET PRAM CMA,INA,SZA,RSS COUNTER JMP EXIT NO PRAMS EXIT STA #P INIT COUNTER LDB BLANK USE LEADING BLANK SPC 2 LOOP EQU * LDA BUF GET VALUE FOR INA THIS ENTRY LDA A,I AND IF SSA NEGATIVE ADB B21 CONVERT BLANK TO 1. LDA BUF,I GET PRAM SPEC STB BUF,I STORE ", " OR " " BACK ISZ BUF STEP TO VALUE CMA,INA,SZA,RSS IF ZERO JMP NULL THEN NULL PRAM SPC 2 INA,SZA,RSS IF ONE JMP NUMBR THEN NUMERIC SPC 2 ISZ BUF MUST BE ASCII,SO LOOP2 EQU * IT'S OK ISZ BUF AS ISZ BUF IS. LDB COMMA GET ", " ISZ #P DONE ? JMP LOOP NO-GET NEXT PRAM. SPC 2 EXIT EQU * LIBX JMP INPRS,I YES-EXIT TO CALLER DEF INPRS SPC 2 NULL EQU * LDB BLANK FOR NULL STB BUF,I PRAM , REPLACE LDA B WITH STO EQU * ISZ BUF SIX DST BUF,I BLANKS JMP LOOP2 & GET NEXT PRAM. SPC 2 NUMBR EQU * NUMERIC PRAM PROC. LDA BUF,I GET NUMBER CCE,SSA VALUE IF CLE NEG,SET FOR OCTAL CONVERSION JSB $CVT3 CONVERT TO ASCII ERB SET E IF NEG. LDB A,I GET HIGH DIGIT SEZ,INA STEP & IF OCTAL ADB B104C CONVERT '1' TO 'B' STA T SAVE ADDRESS LDA A,I GET NEXT DIGIT RRL 8 ROTATE 1ST 2 DIGITS TO 'B'REG STB BUF,I STORE 1ST 2 DIGITS ISZ T STEP TO LAST 2 DIGITS ALF,ALF LDB T,I GET LAST 2 DIGITS RRL 8  ROTATE TO RIGHT ORDER JMP STO GO STORE IT HED INPRS : CONSTANTS B21 OCT 21 B104C OCT 10400 COMMA ASC 1,, BLANK ASC 1, T NOP HED INPRS - END END X  92067-18055 1805 S C0122 &.MVW4 RTE-IV .MVW              H0101 EMASMB,L ** .MVW - MOVE WORD ROUTINE ** * NAME: .MVW * SOURCE: 92067-18055 * RELOC: PART OF 92067-16035 * PGMR: G.A.A * HED MOVE WORD ROUTINE TO SIMULATE 105777B MICROCODE INSTR * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** NAM .MVW,7 92067-16035 REV.1805 751021 ENT .MVW .MVW EQU * *** MOVE NOP STA FROM MICRO CODE MOVE REPLACEMENT SUB LDA MOVE,I GET THE COUNT LDA A,I TO A ISZ MOVE STEP TO NOP (NOP IS RETURN) SZA,RSS JMP OUT SKIP MOVE IF ZERO COUNT * CMA,INA SET IT NEGATIVE STA COUNT SET COUNTER LOOP LDA FROM,I GET WORD STA B,I SET IN DESTINATION INB STEP DESTINATION ISZ FROM FROM ISZ COUNT AND COUNT JMP LOOP IF NOT DONE LOOP * OUT LDA FROM PUT NEXT LOCATION IN A FOR PURISTS JMP MOVE,I AND RETURN * * A EQU 0 B EQU 1 FROM NOP COUNT NOP END /P  92067-18056 1805 S C0122 >ST4 RTE-IV GETST              H0101 WASMB,R,L,C HED SUBROUTINE GETST * * * NAME: GETST * SOURCE: 92067-18056 * RELOC: PART OF 92067-16035 * PGMR: D.L.S. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM GETST,7 92067-16035 REV.1805 771005 ENT GETST EXT EXEC,.ENTP,.ZPRV SUP * ***************************************************************** * * SUBROUTINE GETST: * * GETST IS A FORTRAN CALLABLE SUBROUTINE WHICH MAY BE USED TO * RETRIEVE ANY PARAMETER STRING FROM A COMMAND STRING WHICH * FOLLOWS THE SECOND COMMA(THIRD IF THE SECOND PARAMETER IS * 'NO' AND 'NOW'). ONLY THE FIRST 80 CHARACTERS OF THE * COMMAND STRING ARE CHECKED. * * CALLING SEQUENCE: * * EXT GETST * JSB GETST * DEF RTN * DEF IBUFR * DEF IBUFL * DEF ILOG * RTN ... * IBUFR BSS N BUFFER TO STORE STRING IN. * IBUFL DEC N(-2N) WORD(+) OR CHARS(-) TO TRANSFER. * ILOG BSS 1 TRANSMISSION LOG. * * RETURN: * =:=POSITIVE NUMBER OR WORDS(CHARS)TRANSFERRED. * :=0 IMPLIES NO BUFFER FOUND. * ***************************************************************** * IBUFR NOP IBUFL NOP ILOG NOP * GETST NOP JSB .ZPRV DEF LIBX JSB .ENTP DEF IBUFR * JSB EXEC GO GET ANY PARAMETER STRING. DEF *+5 DEF D14 DEF D1 DIBR DEF IBR DEF DM80 * SZB,RSS IF TRANSMISSION LOG JMP L2 IS ZERO, THEN EXIT. INB CMB,INB SET UP CHARACTER STB CNT CHARACTER COUNTER. * LDB IBUFR CONVERT DESTINATION BUFFER CLE,ELB ADDRESS TO CHARACTER STB DBADD AND SAVE. LDB DIBR CONVERT SOURCE CLE,ELB BUFFER ADDRESS ADB DM1 TO CHARACTER STB ADD ADDRESS AND SAVE. LDB DM2 SET COMMA COUNT STB TEMP TO -2. * L1 JSB GETCH GO GET A CHARACTER. CPA ASCCM IF NOT A COMMA OR THE FIRST COMMA, ISZ TEMP THEN CONTINUE SCANNING FOR JMP L1 COMMAS. * LDB ADD OTHERWIZE, SAVE STB TEMP ADDRESS. LDB CNT SAVE CHAR STB TCNT COUNT. * L31 JSB GETCH NOW SCAN FOR 'NO' OR 'NOW'. CPA ASCBK STRIP LEADING BLANKS. JMP L31 CPA ASC.N IF CHARACTER EQUALS 'N' JMP L5 THEN CHECK FOR A 'O'. * L6 LDA TEMP IF CHARACTER IS NOT 'N', THEN LDB TCNT GET SAVED ADDRESS AND CHARACTER JMP L91 COUNT AND GO MOVE BUFFER. SKP L5 JSB GETCH GET NEXT CHARACTER. CPA ASC.O CHECK IF CHARACTER RSS IS A 'O'. JMP L6 IF NOT, GO MOVE BUFFER. * JSB GETCH FOUND 'NO'. CPA ASCBK CHECK IF NEXT CHARACTER JMP L81 IS A BLANK OR CPA ASCCM A COMMA. JMP L9 * CPA ASC.W FOUND 'NO'. CHECK IF RSS NEXT CHARACTER IS A 'W'. JMP L6 IF NOT THEN MOVE BUFFER. * JSB GETCH FOUND 'NOW' SO GET NEXT CHARACTER. CPA ASCCM CHECK IF NEXT JMP L9 CHARACTER IS A CPA ASCBK BLANK OR A COMMA. RSS JMP L6 IF NOT THEN MOVE BUFFER. * L81 JSB GETCH GET NEXT CHARACTER. CPA ASCCM SKIP TO THIRD COMMA IN STRING. RSS JMP L81 * L9 LDA ADD SAVE STARTING CHAR ADDRESS LDB CNT AND CHARACTER COUNT L91 INA OF SOURCE BUFFER. 2 INB STA SBADD LDA IBUFL,I GET REQUEST LENGTH SSA AND CONVERT TO CHARACTERS. JMP L92 RAL CMA,INA L92 STA CNT SAVE NEGATIVE CHARACTER COUNT. CMA,INA ADA B USE LESSER OF ACTUAL TRANSMISSION LOG SSA AND THE ACTUAL REQUEST LENGTH. LDB CNT STB CNT COMPUTE NUMBER OF CMB,INB CHARACTERS IN STB ILOG,I SOURCE BUFFER. SKP LL3 LDB SBADD GET CLE,ERB SOURCE LDA B,I CHARACTER. SEZ,RSS ALF,ALF AND B377 * LDB DBADD STORE CLE,ERB INTO SEZ,RSS DESTINATION JMP LL5 BUFFER. XOR B,I LL4 STA B,I ISZ SBADD INCREMENT SOURCE CHAR. ADD ISZ DBADD DESTINATION BUFFER ADD AND ISZ CNT CHARACTER COUNT. JMP LL3 * SEZ IF LAST BYTE WAS A RIGHT CHARACTER, JMP LL43 THEN JUST CONTINUE. CPA ASCB0 IF LAST BYTE WAS A LEFT BLANK, JMP LL55 THEN GO REMOVE IT. XOR ASCBK OTHERWIZE, GO PLACE A BLANK IN STA B,I LOWER BYTE. * LL43 LDB ILOG,I GET MODIFIED TRANSMISSION LOG. LDA IBUFL,I IF CHARACTERS WERE SSA SPECIFIED, THEN JMP L2 RETURN. INB IF WORDS WERE SPECIFIED, THEN BRS CHANGE TO WORDS AND RETURN. * L2 STB ILOG,I SAVE TRANSMISSION LOG LIBX JMP GETST,I AND RETURN. DEF GETST * LL5 ALF,ALF JMP LL4 * LL55 LDB ILOG,I DECREMENT ADB DM1 CHARACTER STB ILOG,I COUNT. JMP LL43 SKP * ****************************************************************** * * SUBROUTINE GETCH: * * GETCH WILL GET THE NEXT CHARACTER IN A BUFFER. * IF THE BUFFER BECOMES EMPTY, GETCH WILL * FORCE AN EXIT FROM GETST. * * CALLING SEQUENCE: * ' :=PREVIOUS CHARACTER ADDRESS * :=PREVIOUS CHARACTER COUNT(NEGATIVE) * JSB GETCH * * RETURN: * :=CHARACTER IN LOWER BYTE. * :=CURRENT CHARACTER ADDRESS. * :=CURRENT CHARACTER COUNT. * ALL REGISTERS ARE MODIFIED EXCEPT B. * ******************************************************************** * GETCH NOP CLB SET POSSIBLE TRANSMISSION LOG TO 0. ISZ ADD INCREMENT CHARACTER ADDRESS. ISZ CNT INCREMENT CHARACTER COUNT. RSS IF COUNT GOES JMP L2 TO ZERO, LEAVE GETST. * LDA ADD GET CHARACTER ADDRESS AND CLE,ERA AND CONVERT TO WORD ADDRESS. LDA A,I E=1 MEANS LOWER BYTE. SEZ,RSS GET WORD AND ALF,ALF PLACE PROPER AND B377 CHARACTER IN JMP GETCH,I LOWER BYTE. * B377 OCT 377 SKP * * CONSTANTS * A EQU 0 B EQU 1 * CNT NOP TEMP NOP TCNT NOP ADD NOP SBADD NOP DBADD NOP * IBR BSS 40 * D1 DEC 1 D14 DEC 14 DM1 DEC -1 DM2 DEC -2 DM80 DEC -80 * ASCCM OCT 54 COMMA ASCBK OCT 40 BLANK ASC.N OCT 116 'N' ASC.O OCT 117 'O' ASC.W OCT 127 'W' ASCB0 OCT 20000 * END   92067-18057 1805 S C0122 &EMAP RTE-IV .EMAP              H0101 K9ASMB,R,L,C ** .EMAP ** HED .EMAP ROUTINE TO RESOLVE ELEMENT ADDRESS OF AN ARRAY * SOURCE: 92067-18057 * RELOC: PART OF 92067-16035 * PGMR: S.P.K. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM .EMAP,7 92067-16035 REV.1805 771031 SUP ENT .EMAP EXT .EMAS,.EMAT * * * ROUTINE TO RESOLVE ELEMENT ADDRESS FOR EMA AND NON-EMA * ARRAYS. IF THE ARRAY IS NON-EMA 16 BIT ARITHMETIC IS * PERFORMED. IF THE ARRAY IS AN EMA 32 BIT ARITHMETIC IS * PERFORMED AND THE APPROPIATE MAPPING SEGMENT CONTAINING * THE ELEMENT IS MAPPED IN THE MSEG LOG ADDRESS SPACE * * CALLING SEQUENCE: * JSB .EMAP * DEF RTN RETURN ADDRESS FOR ERROR RETURNS * DEF ARRAY START ADDRESS OF ARRAY * DEF TABLE TABLE CONTAINING ARRAY PARAMETERS * DEF A(N) SUBSCRIPT VALUE FOR NTH DIMENSION * DEF A(N-1) " " " (N-1)ST " * . * . * DEF A(2) " " " 2ND " * DEF A(1) " " " 1ST " * RTN -- ERROR RETURN -- * -- NORMAL RETURN -- * *THE PARAMETER TABLE IS: * -------------------- * # DIMENSIONS * - L(N) * D(N-1) * - L(N-1) * . * . * - L(2) * D(1) * - L(1) * # WORDS/ELEMENT * OFFSET WORD 1 (LOW 16 BITS) USED ONLY * OFFSET WORD 2 (HIGH 16 BITS) FOR EMA * --------------------- * * * RETURNS: ERROR RETURN: AT LOC RTN * AREG=15(ASCII), BREG=EM(ASCII) * NORMAL RETURN: AT LOC RTN+1 * AREG = MEANINGLESS * BREG = ELEMc ENT ADDRESS * * .EMAP NOP ROUTINE TO RESOLVE ARRAY ADDRESS LDA .EMAP,I GET RETURN ADDRESS STA RETRN SAVE IT ISZ .EMAP POINT TO ARRAY ADDRESS LDB .EMAP,I GET ARRAY ADDRESS JMP *+2 REMOVE INDIRECTS LDB B,I RBL,CLE,SLB,ERB JMP *-2 * ISZ .EMAP POINT TO THE TABLE ADDRESS LDA XIDEX DETERMINE WHETHER ARRAY ADDRESS SZA,RSS GIVEN IS THAT OF AN EMA OR NON-EMA ARRAY JMP NOEMA CALLING PROG DOES NOT HAVE EMA DECLARED INA POINT 2ND WORD OF ID SEG EXT XLA A,I GET CONTENTS OF 2ND WORD OF ID SEG EXT OF PROG CLE,ERA MOVE BITS 15-11 INTO 14-10 POSITION AND B76K GET LOGICAL START ADDR OF MSEG CMA,INA ADA B ARRAY ADDRESS SPECIFIED < START MSEG? SSA JMP NOEMA NO THEN A NON-EMA ARRAY LDA .EMAP POINTER TO TABLE ADDRESS JSB .EMAS RESOLVE ELEMENT ADDRESS FOR EMA ARRAY SSA,RSS ERROR ENCOUNTERED? JSB .EMAT MAP NECESSARY MSEG TO GET ELEM IN LOG ADDR SPACE SSA ERROR ENCOUNTERED? JMP ERROR ISZ RETRN NO, ELEMENT ADDRESS IS IN B REG JMP RETRN,I NORMAL RETURN TO RTN+1 LOCATION * * NON - EMA ARRAY - RESOLVE ELEMENT ADDRESS USING * 16 BIT ARITHMETIC * NOEMA STB ARRAY SAVE ARRAY ADDRESS LDA .EMAP,I GET TABLE ADDRESS RSS REMOVE INDIRECTS IF ANY LDA A,I RAL,CLE,SLA,ERA JMP *-2 STA PTABL ADDRESS OF PARAMETER TABLE LDA A,I # OF DIMENSIONS SSA -VE? JMP ERROR YES, ERROR SZA,RSS 0 DIMENSIONS? JMP NODIM YES CMA,INA STA NDIM -VE # OF DIMENSIONS TO USE AS COUNTER CLA STA SUM1 INITIALIZE VARIABLE TO HOLD DISPLACEMENT LOOP ISZ PTABL POINT TO -(LOWER BOUND) OF ITH DIMENSION ISZ .EMAP POINT TO SUBSCRIPT VALUE OF I ITH DIMENSION LDA .EMAP,I GET SUBSCRIPT VALUE --- A(I) LDA A,I CLO CLEAR OVERFLOW REGISTER ADA PTABL,I A(I)-L(I) SUBSCRIPT VALUE-LOWER BOUND SSA,RSS LOWER BOUND > SUBSCRIPT VALUE? SOC C OVERFLOW REG SET? JMP ERROR YES, ERROR ADA SUM1 ACCUMULATE DISPLACEMENT - IF OVERFLOW ISZ PTABL IT WILL BE DETECTED AFTER MULTIPLY LDB PTABL,I DIMENSION SIZE OF (I-1)ST DIMENSION D(I-1) SSB -VE? JMP ERROR YES, THEN ERROR MPY B (A(I) - L(I))*D(I-1) SZB,RSS OVERFLOW INTO B REG? SSA NO, OVERFLOW INTO BIT 15 OF A REG? JMP ERROR YES STA SUM1 NEW VALUE FOR DISPLACEMENT ISZ NDIM INCREMENT # DIMENSIONS COUNTER JMP LOOP ALL DIMENSIONS NOT DONE YET * NODIM LDB ARRAY ARRAY ADDRESS ADB A ADD DISPLACEMENT ISZ RETRN NORMAL RETURN AT LOC RTN+1 JMP RETRN,I * * ERROR DLD ERRCD ERROR ENCOUNTERED JMP RETRN,I RETURN AT LOC RTN * * ERRCD ASC 2,15EM ERROR CODE PTABL NOP SUM1 NOP NDIM NOP ARRAY NOP RETRN NOP * B76K OCT 76000 * XIDEX EQU 1645B A EQU 0 B EQU 1 * END * *   92067-18058 1805 S C0122 &EMIO4 RTE-IV .EMIO              H0101 fAASMB,R,L,C ** .EMIO ** HED .EMIO I/O BVUFFER ROUTINE FOR EXTENDED MEMORY AREAS * SOURCE: 92067-18058 * RELOC: PART OF 92067-16035 * PGMR: S.P.K. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** NAM .EMIO,7 92067-16035 REV.1805 771006 SUP ENT .EMIO EXT .EMAS,.EMAT,..MP,.NPGS,.IPGS,.MSG#,.MSGS,.ARRY EXT .SUM2,.EMSZ * * * ROUTINE TO RESOLVE AN ELEMENT ADDRESS FOR AN EMA ARRAY * AND TO MAP THE APPROPRIATE MAPPING SEGMENT TO CONTAIN * THE ENTIRE BUFFER STARTING AT THE ELEMENT AND HAS * LENGTH SPECIFIED IN THE CALLING SEQUENCE * A SPECIAL NON-STANDARD MAPPING SEGMENT IS MAPPED IF THE * BUFFER DOES NOT FIT INTO A STANDARD MAPPING SEGMENT * * CALLING SEQUENCE: * JSB .EMIO * DEF RTN RETURN ADDRESS FOR ERROR RETURNS * DEF BUFL LENGTH OF BUFFER IN # WORDS * DEF TABLE TABLE CONTAINING ARRAY PARAMETERS * DEF A(N) SUBSCRIPT VALUE FOR NTH DIMENSION * DEF A(N-1) " " " (N-1)ST " * . * . * DEF A(2) " " " 2ND " * DEF A(1) " " " 1ST " * RTN -- ERROR RETURN -- * -- NORMAL RETURN -- * *THE PARAMETER TABLE IS: * -------------------- * # DIMENSIONS * - L(N) * D(N-1) * - L(N-1) * . * . * - L(2) * D(1) * - L(1) * # WORDS/ELEMENT * OFFSET WORD 1 (LOW 16 BITS) * OFFSET WORD 2 (HIGH 16 BITS) * --------------------- * * * RETURNS: ERROR RETURN: AT LOC RTN * AREG=16(ASCII), BREG=EM(ASCII) * NORMAL REDHTURN: AT LOC RTN+1 * AREG = MEANINGLESS * BREG = ELEMENT ADDRESS * * .EMIO NOP LDA .EMIO RETURN ADDRESS INA POINT TO THE BUFFER LENGTH LDB .EMIO,I SAVE RETURN ADDRESS STB .EMIO LDB XIDEX EMA ROUTINE DECLARED IN CALLING PROG? SZB,RSS JMP ERROR NO, THEN ERROR LDB A,I LDB B,I BUFFER LENGTH IN B REG STB BUFL SAVE IT SSB -VE? JMP ERROR YES, ERROR INA POINT TO 'DEF TABLE' PARAMETER JSB .EMAS RESOLVE ADDRESS OF ELEMENT SSA ERROR ENCOUNTERED? JMP ERROR YES * * TEST IF SPECIAL MAPPING REQUIRED * ADB BUFL ADD BUFFER LNGTH TO DISP IN MSEG CLA RRL 6 #PAGES IN DISP + BUFL IN A REG SZB REMAINDER=0? INA NO STA TEMP SAVE THIS VALUE CMA,INA NEGATE # PAGES ADA .MSGS ADD MAPPING SEGMENT SIZE SSA MSEG SIZE > DISP + BUFL? JMP SPMAP NO THEN SPECIAL MAPPING REQUIRED LDA TEMP GET #PAGES IN DISP FROM START OF EMA UPTO MSEG ADA .IPGS ADD #PGS FROM START OF EMA UPTO ELEMENT CMA,INA NEGATE IT ADA .EMSZ EMA SZ - #PGS FROM START OF EMA TO END OF MSEG SSA EMA SIZE SMALLER? JMP ERROR YES JSB .EMAT NO, THEN MAP STANDARD MSEG SSA ERROR? JMP ERROR YES * ISZ .EMIO NORMAL RETURN TO LOC RTN + 1 JMP .EMIO,I * * SPECIAL MAPPING REQUIRED * SPMAP LDA .SUM1 DISP INTO PAGE CONTAINING ELEMENT STA TEMP SAVE IT ADA BUFL ADD #WRDS IN BUFFER SSA OVERFLOW? JMP ERROR YES, THEN ERROR CLB NO RRR 10 #PGS NEEDED TO MAP TO ACCESS ENTIRE BUFFER SZB REMAINDER=0? INA NO STA .SUM1 # PAGES TO BE MAPPED LDA .SUM2 Y STA .IPGS CCA SPECIAL MAPPING SEGMENT STA .MSG# JSB ..MP MAP THE SPECIAL MAPPING SEGMENT SSA ERROR RETURN? JMP ERROR YES, THEN MAKE ERROR RETURN LDB .ARRY BASE ADDRESS OF ARRAY ADB TEMP # WORDS LEFT IN DISP ISZ .EMIO NORMAL RETURN JMP .EMIO,I * * ERROR DLD ERRCD JMP .EMIO,I ERROR RETURN * * ERRCD ASC 2,16EM BUFL NOP TEMP NOP .SUM1 EQU .NPGS N1 DEC -1 B1777 OCT 1777 XIDEX EQU 1645B A EQU 0 B EQU 1 END   92067-18059 1805 S C0122 &MMAP4 RTE-IV MMAP              H0101 LPASMB,R,L,C ** MMAP ** HED MMAP ROUTINE TO MAP EMA PAGES IN MSEG * SOURCE: 92067-18059 * RELOC: PART OF 92067-16035 * PGMR: S.P.K. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** NAM MMAP,7 92067-16035 REV.1805 771020 SUP ENT MMAP,..MP,.MMAP,.EMSZ,.MSG#,.MSGS,.NPGS,.IPGS EXT $DVPT,$LIBR,$LIBX * * * ROUTINE TO MAP THE REQUESTED SEQUENCE OF PHYSICAL * PAGES IN THE MAPPING SEGMENT ADDRESS SPACE * IF THE # OF PAGES SPECIFIED TO BE MAPPED IS LESS * THAN THE STANDARD MAPPING SEGMENT SIZE, MMAP WILL MAP * UPTO THE STANDARD MSEG SIZE PAGES IF THEY FIT * * CALLING SEQUENCE: JSB MMAP * DEF RTN RETURN ADDRESS * DEF IPGS # OF PAGES DISP FROM START OF EMA * UPTO THE FIRST PAGE TO MAP * DEF NPGS # OF PAGES TO BE MAPPED * * RETURNS: A REG = 0 IF NORMAL RETURN * = -1 IF ERROR RETURN * * * MMAP HAS TWO OTHER ENTRY POINTS .MAP. AND .MMAP * .MAP. IS ENTERED BY .EMIO WHILE DOING SPECIAL MAPPING * CALLING SEQUENCE FOR .MAP. IS: JSB .MAP. * * .MMAP IS ENTERED BY .EMAS WHILE MAPPING A STANDARD MSEG * CALLING SEQUENCE FOR .MMAP IS: JSB .MMAP * * * MMAP NOP LDA MMAP,I GET THE RETURN ADDRESS STA RETRN AND SAVE IT ISZ MMAP GET THE NEXT PARAMETER LDA MMAP,I LDA A,I A REG HAS # OF PAGES DISPLACEMENT FROM START STA .IPGS OF EMA TO START OF SEGMENT TO BE MAPPED SSA -VE? JMP ERROR YES, THEN ERROR ISZ MMAP LDB MMAP,I GET THE NEXT PARM LDB B,I # OF PAGES TO BE MAPPED SSB -VE? JMP ERROR YES, THEN ERROR STB .NPGS LDA XIDEX ADDRESS OF ID SEG EXT SZA,RSS IS IT 0? JMP ERROR YES THEN NOT AN EMA PROG LDA XEQT GET ID SEG ADDRESS ADA .28 XLA A,I GET WORD 28 OF THE ID SEGMENT AND B1777 MASK OUT THE EMA SIZE STA .EMSZ SAVE IT XLA XIDEX,I GET FIRST WORD OF ID SEG EXT AND B37 MASK STANDARD MSEG SIZE STA .MSGS SAVE IT * LDA .IPGS FIND MSEG # IF STANDARD MSEG CLB DIV .MSGS RELATIVE START PAGE OF MSEG/.MSGS SZB REMAINDER=0? CCA NO, NON-STANDARD MSEG STA .MSG# SAVE MAPPING SEGMENT # JMP .MAP1 SKIP OVER FOLLOWING ENTRY POINT * ..MP NOP ENTRY POINT FOR .EMIO TO ENTER LDA ..MP GET RETURN ADDRESS STA RETRN SET UP MAIN RETURN ADDRESS .MAP1 LDA .NPGS # OF PAGES TO BE MAPPED ADA .IPGS # OF PAGES DISP FROM START OF EMA CMA,INA ADA .EMSZ EMA SIZE-(#PGS DISP+#PGS TO BE MAPPED) SSA EMA SIZE < NPGS+.IPGS? JMP ERROR YES, THEN ERROR LDB .NPGS # OF PAGES TO BE MAPPED CMB,INB ADB .MSGS MSGSZ - NPGS SSB .NPGS> MSGSZ? JMP ERROR YES, ERROR ISZ .MSGS INCREMENT MSEG SIZE TO ACCOUNT LDB .MSGS FOR OVERFLOW PAGE LDA .EMSZ EMA SIZE CMA,INA ADA .IPGS #PGS DISP FROM START EMA - EMA SIZE ADB A + MSEG SIZE + 1 CMA,INA EMA SIZE - # PGS DISP SSB .IPGS+.MSGS+1<=EMA SIZE? LDA .MSGS YES, #PAGES TO MAP IS MSEG SIZE + 1 STA .NPGS SET # OF PAGES TO BE MAPPED SZA,RSS 0? JMP ERROR YES, THEN IPGS = EMASZ JMP NOADJ SKIP OVER FOLLOWING ENTRY POINT * * CHANGE USER MAP ON BASE PAGE * .MMAP NOP  LDA .MMAP SET UP MAIN RETURN ADDRESS STA RETRN ISZ .MSGS ACCOUNT FOR OVERFLOW PAGE NOADJ JSB $LIBR TURN OFF INTERRUPTS AND NOP MEMORY PROTECT FENCE LDA XIDEX INA XLA A,I GET 2ND WORD OF ID SEG EXT CAY SAVE IT AND B1777 MASK PHYSICAL START PAGE OF EMA ADA .IPGS A REG = PHYSICAL START PAGE OF MAPPING SEG STA .IPGS SAVE IT LDA B40 READ THE USER BASE PAGE # FROM DMS REG 40B CCB CBX -1 IN XREG TO READ 1 REG LDB AEMSZ ADDRESS OF LOC CONTAINING MEM ADDRESS XMM READ DMS REG CLB,INB X REG = 1 TO CHANGE CONTENTS OF 1 DMS REG CBX B TO X XLA $DVPT DMS REG# POINTING TO START OF DRIVER PARTN STA MLOC ADA B40 LDB AEMSZ POINT THIS REG TO USER BASE PAGE XMM LDB MLOC START PAGE OF DRIVER PARTN BLF,BLF MULTIPLY BY 2000B RBL,RBL ADB B1740 LOC ON USER BASE PAGE AT WHICH MSEG STARTS CYA SECOND WORD ID SEG EXT FROM Y TO A ALF,RAL MOVE BITS 11-15 TO POSITION 10-14 AND B37 MASK OUT START LOGICAL PAGE OF MSEG STA MSTRT SAVE IT ADB A BREG HAS MEM LOC ON BASE PAGE STB MLOC AT WHICH USER MAP MUST BE CHANGED LDA .NPGS # OF PAGES CMA,INA COUNTER STA .EMSZ LDA .IPGS START PHYSICAL PAGE OF MSEG LOOP STA B,I STORE IT ON USER BASE PAGE INA INCREMENT PAGE # INB POINT TO NEXT LOC ISZ .EMSZ INCREMENT COUNTER JMP LOOP STORE NEXT PAGE# * USER MAP ON BASE PAGE IS CHANGED TO SHOW THE NEW MSEG * REST OF THE LOCATIONS MUST BE MADE READ&WRITE PROTECTED * LDA .MSGS FIND # OF LOCATIONS LEFT TO BE CMA,INA READ AND WRITE PROTECTED ADA .NPGS #PAGES - (MSEG SIZE+1) SZA,RSS EQUAL?  JMP STDMS YES THEN SET DMS REGISTERS STA .EMSZ #PGS TO READ-WRITE PROTECT LDA B140K LOOP1 STA B,I STORE 140000B IN LOC ON USER BASE PAGE INB POINT TO NEXT LOC ISZ .EMSZ INCREMENT COUNTER JMP LOOP1 * STDMS LDA B40 40 OCTAL ADA MSTRT FIRST MAP REGISTER TO BE CHANGED IN A REG LDB .MSGS #DMS REG TO CHANGE IS MSEG SIZE + 1 CBX TO BE LOADED FROM LDB MLOC USER BASE PAGE XMM TRANSFER MEM INTO DMS REG * XLA XIDEX,I GET FIRST WORD OF ID SEG EXT LDB .MSG# SSB,RSS -1? JMP MMAP1 NO IOR BIT15 YES, THEN SET BIT 15 JMP MMAP2 * MMAP1 AND B37 MASK OUT BITS 0-4 BLF,RBL MOVE MSEG # TO BITS 5-14 ADA B MMAP2 XSA XIDEX,I STORE BACK WORD 0 OF THE ID SEG EXT CLA RETURN WITH A REG=0 JSB $LIBX TURN ON MEMORY PROTECT & INTERRUPTS DEF RETRN * ERROR CCA ERROR RETURN WITH A REG=-1 JMP RETRN,I * * RETRN NOP .IPGS NOP .NPGS NOP .MSGS NOP .MSG# NOP .EMSZ NOP AEMSZ DEF .EMSZ MSTRT NOP MLOC NOP B37 OCT 37 B40 OCT 40 B1777 OCT 1777 B1740 OCT 1740 B140K OCT 140000 BIT15 OCT 100000 .28 DEC 28 N1 DEC -1 A EQU 0 B EQU 1 XIDEX EQU 1645B XEQT EQU 1717B END   92067-18060 1805 S C0122 &EMAS4 RTE-IV .EMAS              H0101 f2ASMB,R,L,C ** .EMAS ** HED .EMAS INTERNAL ROUTINE TO RESOLVE ELEMENT ADDRESS IN EMA * SOURCE: 92067-18060 * RELOC: PART OF 92067-16035 * PGMR: S.P.K. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** NAM .EMAS,7 92067-16035 REV.1805 771031 SUP ENT .EMAS,.EMAT,.ARRY,.SUM2 EXT .MMAP,.MSGS,.EMSZ,.MSG#,.NPGS,.IPGS * * * ROUTINE TO RESOLVE ELEMENT ADDRESS FOR AN EMA ARRAY * * CALLING SEQUENCE: JSB .EMAS * A REG = POINTER TO TABLE ADDRESS IN * THE LIST OF PARAMETERS * * RETURNS: A REG = 0 IF NORMAL RETURN * = -1 IF AN ERROR WAS ENCOUNTERED * B REG = TOTAL # OF WORDS DISPLACEMENT FROM * THE START OF MSEG TO THE ELEMENT * * .EMAS NOP ROUTINE TO RESOLVE ARRAY ADDRESS STA TEMP SAVE ADDRESS CLA CLEAR VARIABLES TO KEEP RUNNING SUM STA .SUM1 OF THE ELEMENT ADDRESS STA .SUM2 LDA TEMP,I ADDRESS OF THE TABLE OF PARAMETERS RSS REMOVE INDIRECTS IF ANY LDA A,I RAL,CLE,SLA,ERA JMP *-2 STA PTABL PTABL IS THE POINTER TO THE PARM TABLE LDA A,I # OF DIMENSIONS IN THE A REG SSA -VE? JMP ERROR YES, THEN ERROR ISZ PTABL INCREMENT POINTER INTO THE TABLE SZA,RSS 0? JMP NODIM YES, NO DIMENSIONS SPECIFIED CMA,INA NEGATE IT TO KEEP COUNT STA NDIM -VE # OF DIMENSIONS * LOOP ISZ TEMP GET THE NEXT SUBSCRIPT VALUE LDA TEMP,I LDA A,I CLO CLEAR rOVERFLOW REGISTER ADA PTABL,I ADD -LI TO AI SSA,RSS IS THIS VALUE -VE? SOC C OVERFLOW REG SET? JMP ERROR YES,SUBSCRIPT VALUE < LOWER BOUND ERROR ADA .SUM1 ADD LOWER 14 BITS OF SUM ELEMENT ADDRESS SSA IS BIT 15 SET? ISZ .SUM2 YES,ADD 1 TO THE MOST SIGNIFICANT BITS OF SUM ELA,CLE,ERA CLEAR SIGN BIT IN THE A REGISTER ISZ PTABL POINT TO UPPER BOUNDS OF (I-1)TH DIMENSION LDB PTABL,I DIMENSION SIZE D(I-1) IN B REG STB DIMLN SSB -VE? JMP ERROR YES MPY B MULTIPLY .SUM1 BY DIMENSION SIZE RAL,CLE,ERA CLEAR BIT 15 IN A REG AND SAVE IN E REG ELB SHIFT BIT 15 OF AREG INTO BIT 0 POSITION OF BREG STA .SUM1 NEW VALUE OF BITS 0-14 OF ELEMENT ADDRESS STB .SUM3 LDA .SUM2 BITS 15-31 OF ELEMENT ADDRESS MPY DIMLN NO, THEN MULTIPLY BY DIMENSION SIZE .EMA3 ADA .SUM3 ADD BITS 15-31 FROM PREVIOUS MULTIPLICATION STA .SUM2 .SUM2 HAS BITS 15-31 OF ELEMENT ADDRESS SO FAR SZB,RSS OVERFLOW INTO B REG? SSA SIGN BIT SET ? JMP ERROR YES, ERROR ISZ PTABL POINT TO NEXT SET OF ARRAY PARAMETERS ISZ NDIM ALL DIMENSIONS DONE? JMP LOOP NO, THEN EVALUATE NEXT DIMENSION * NODIM XLA XIDEX,I GET FIRST WORD OF ID SEG EXT CAY SAVE IT IN Y REG AND B37 MASK MSEG SIZE STA .MSGS SAVE IT LDA XIDEX INA GET 2ND WORD OF ID SEG EXT XLA A,I CLE,ERA AND B76K GET LOGICAL START EMA ADDRESS STA .ARRY SAVE IT * DLD PTABL,I GET TWO OFFSET WORDS RAL,CLE,ERA IF BIT 15 OF AREG SET, CLEAR IT AND SAVE ELB SHIFT IT IN BIT 0 POSITION OF HIGH ORDER BITS SEZ,SSB,RSS OFFSET HAS SIGN BIT SET OR TOO LARGE? RSS JMP ERROR YES, THEN ERROR ADA .SUM1 OFFSET WORD 1  RAL,CLE,SLA,ERA CLEAR SIGN BIT IF SET INB INCREMENT HIGH ORDER BITS TO ACCOUNT ADB .SUM2 FOR SIGN BIT OF LOW ORDER BITS SSB OVERFLOW? JMP ERROR YES RAL MOVE BITS 0-14 IN 1-15 POSITION ASL 5 B REG HAS TOTAL # OF PAGES IN DISPLACEMENT SOC C WERE SOME SIGNIFICANT BITS LOST? JMP ERROR YES STB .SUM2 FROM BEGINNING OF EMA UPTO PAGE CONTAINING ELEMENT ALF,ALF MOVE REMAINING WORDS INTO LOW BITS RAL,RAL STA .SUM1 SAVE # OF WORDS OFFSET IN THE LAST PAGE CMB - (#PAGES DISP + 1) LDA XEQT ADA .28 WORD 29 OF ID SEGMENT XLA A,I AND B1777 MASK EMA SIZE STA .EMSZ ADB A TOTAL #PGS DISP+1(IF OFFSET INTO LAST PAGE) SSB > EMA SIZE? JMP ERROR YES, THEN ERROR LDA .SUM2 # OF PAGES DISP FROM START OF EMA CLB DIV .MSGS DIVIDE DISP BY MSEG SIZE STA .MSG# QUOTIENT IS THE MSEG # TO MAP LDA B SAVE B REG CMA,INA # PAGES DISP - # PAGES OFFSET INTO MSEG ADA .SUM2 STA .IPGS BLF,BLF CONVERT REMAINDER # PAGES INTO WORDS RBL,RBL ADB .SUM1 TOTAL # OF WORDS DISP INTO MSEG STB TEMP SAVE THIS VALUE CLA JMP .EMAS,I RETURN * * MAP THE STANDARD MAPPING SEGMENT * .EMAT NOP CYA GET THE FIRST WORD OF THE ID SEG EXT SSA BIT 15 SET? JMP MSGMP YES, THEN MSEG NEEDS TO BE MAPPED CLB LSR 5 GET MSEG# CURRENTLY MAPPED CPA .MSG# IS IT THE SAME AS THE ONE WE WANT JMP RETRN YES,NO NEED TO MAP MSEG RETURN * * MAPPING SEGMENT TO BE MAPPED * MSGMP LDA .EMSZ SIZE OF EMA CLB DIV .MSGS DIVIDE BY MSEG SIZE TO GET THE SZB,RSS HIGHEST MSEG # - REMAINDER = 0? ADA N1 YES, THEN SUBT:&RACT 1 FROM QOUTIENT CPA .MSG# IS THE HIGHEST MSEG# = MSEG# WE WANT? JMP MSGM1 YES LDB .MSGS NO, ADJUST# PAGES TO BE MAPPED INB FOR OVERFLOW JMP MSGM2 MSGM1 SZB,RSS REMAINDER=0? LDB .MSGS YES,#PAGES TO BE MAPPED IS MSEG SIZE MSGM2 STB .SUM1 # OF PAGES TO BE MAPPED JSB .MMAP MAP THE MAPPING SEGMENT * RETRN LDB .ARRY LOGICAL START ADDRESS OF MSEG ADB TEMP # OF WORDS DISP INTO MSEG CLA JMP .EMAT,I RETURN * ERROR CCA ERROR RETURN JMP .EMAS,I * .SUM1 EQU .NPGS LOWER SIGNIFICANT BITS 0-14 OF DISPLACEMENT .SUM2 NOP UPPER SIGNIFICANT BITS 15-31 OF DISPLACEMENT .SUM3 NOP PTABL NOP POINTER INTO TABLE NDIM NOP DIMLN NOP TEMP NOP .ARRY EQU NDIM XIDEX EQU 1645B XEQT EQU 1717B .28 DEC 28 N1 DEC -1 B37 OCT 37 B76K OCT 76000 B1777 OCT 1777 A EQU 0 B EQU 1 END   92067-18061 1805 S C0122 &EMST4 RTE-IV EMAST              H0101 t^ASMB,R,L,C ** EMAST ** HED EMAST ROUTINE RETURNS INFORMATION OF AN EMA * SOURCE: 92067-18061 * RELOC: PART OF 92067-16035 * PGMR: S.P.K. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** NAM EMAST,7 92067-16035 REV.1805 770913 ENT EMAST * * * ROUTINE TO GIVE INFORMATION FOR AN EMA PROGRAM * CALLING SEQUENCE: JSB EMAST * DEF *+4 RETURN ADDRESS * DEF NEMA SIZE OF EMA * DEF NMSEG SIZE OF MSEG * DEF IMSEG START LOGICAL PAGE MSEG * RETURNS: * A REG = 0 IF NORMAL RETURN * =-1 IF ERROR RETURN * ERROR RETURN IS MADE IF CALLING PROGRAM DOES NOT * HAVE AN EMA DEFINED * * * EMAST NOP LDA EMAST,I STA RETRN SAVE RETURN ADDRESS LDA XIDEX EMA PROGRAM? SZA,RSS JMP ERROR NO THEN ERROR * LDA XEQT YES ADA .28 GET WORD 28 OF THE ID SEG XLA A,I AND B1777 MASK OUT EMA SIZE JSB PRMST STORE EMA SIZEL IN RETURN PARAMETER XLA XIDEX,I GET FIRST WORD OF ID SEG EXT AND B37 MASK MSEG SIZE JSB PRMST STORE IT IN RETURN PARAMETERS LDA XIDEX ID SEG EXT ADDRESS INA XLA A,I GET SECOND WORD OF ID SEG EXT ALF,RAL MOVE START LG PAGE OF MSEG TO LOW BITS AND B37 MASK IT JSB PRMST STORE IT IFN RETURN PARAMETER CLA,RSS NORMAL RETURN ERROR CCA ERROR RETURN A REG=-1 JMP RETRN,I RETURN * PRMST NOP ROUTINE TO STORE VALUEK  S INTO PARAMETERS ISZ EMAST LDB EMAST,I STA B,I JMP PRMST,I RETURN * RETRN NOP .28 DEC 28 B1777 OCT 1777 B37 OCT 37 A EQU 0 B EQU 1 XEQT EQU 1717B XIDEX EQU 1645B END     92067-18062 1805 S C0122 &TRLU4 RTE-IV TRMLU              H0101 dASMB,R,L,C ** TRMLU - FIND 'LU' FROM EQT4 ADDR IN B REG ** HED -TRMLU - FIND 'LU' FROM EQT4 ADDRESS IN B-REG * NAME: TRMLU * SOURCE: 92067-18062 * RELOC: 92067-16035 * PGMR: C.M.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM TRMLU,7 92067-16035 REV.1805 771117 ENT TRMLU * * ROUTINE TO FIND THE LOGICAL UNIT NUMBER OF A DEVICE * GIVEN THE ADDRESS OF WORD 4 OF ITS EQUIPMENT TABLE * CALLED AS FOLLOWS: * * LDB EQT4 (PASSED FROM DVR00/DVR65) * * JSB TRMLU -OR- JSB TRMLU -OR- CALL TRMLU (LUSDI) * DEF *+2 DEF *+1 * DEF LUSDI * * A-REG. = 0 IF NOT FOUND -OR- * A-REG. = THE LOGICAL UNIT NUMBER IF FOUND * LUSDI = RETURNED SAME AS A-REG. * B-REG. = ASCII "00" -OR- LOGICAL UNIT IN ASCII (I.E. "16") * SUP TRMLU NOP ENTRY STB EQT4 SAVE B-REG FOR LATER TEST LDA TRMLU,I GET ADRS OF RETURN ADDRESS ISZ TRMLU BUMP TO POSSIBLE PRAM. LDB TRMLU,I GET POSS. ADDRS OF PRAM. CPA TRMLU PARAMETER PASSED? CLB NO, SET DUMMY ADRS (A-REG.) STB LUADR SET ADDRESS FOR PASSED PRAM STA TRMLU SET UP RETURN ADDRESS CLA SET START LU = 0 STA LUNUM * NEXT LDA LUNUM GET CURRENT LU NUM-1 CPA LUMAX DONE THRU ALL LU'S JMP NTFND YES, NOT FOUND!! ISZ LUNUM BUMP TO CURRENT LU ADA DRT POINT TO TABLE ADDRESS LDA 0,I GET CONTENTS AND O77 MASK OF SUBCHANNEL BITS MPY D15 CAL/  CULATE ADDRESS OF WORD 4 ADA EQTA BASE ADDRESS ADA DM12 SUBTRACK ONE EQT & ADD DEC 3 CPA EQT4 COMPARE?? JMP FOUND YES !! JMP NEXT NO, TRY NEXT ONE SPC 1 NTFND STB LUNUM NOT FOUND RETURN A=0 FOND1 LDA LUNUM FOUND RETURN A= LU NUMBER DIV D10 CONVERT TO ASCII ALF,ALF POSITION MOST SIG. DIGIT ADB 0 MIRGE IN LEAST ADB ASC00 CONVERT TO ASCII LDA LUNUM RESTORE BINARY VALUE STA LUADR,I PASS BACK TO CALLER JMP TRMLU,I SPC 1 FOUND LDA EQT4 GET THE SPECIFIED LU INA AND NOW EQT 5 LDA A,I AND MEQT GET THE TYPE SZA,RSS DVR00 ? JMP FOND1 YES, WERE DONE LDA DRT MUST BE DVR05, SO GET DRT ADA LUNUM ADD LU # ADA DM1 DO OFFSET LDA A,I GET THE DRT VALUE AND MSUB GET THE SUB CHANNEL # SZA,RSS WAS IT THE CRT ? JMP FOND1 YES, SO DO IT. JMP NEXT SPC 1 EQT4 NOP MSUB OCT 174000 MEQT OCT 37400 DM1 DEC -1 LUADR NOP LUNUM NOP O77 OCT 77 D10 DEC 10 ASC00 ASC 1,00 D15 DEC 15 DM12 DEC -12 EQTA EQU 1650B DRT EQU 1652B LUMAX EQU 1653B A EQU 0 B EQU 1 END    92067-18063 1805 S C0122 &IFTY4 RTE-IV IFTTY              H0101 ]ASMB,R,L,C ** IFTTY - SEE IF SPECIFIED LU IS INTERACTIVE. HED -IFTTY - DETERMINES IF SPECIFIED LU IS INTERACTIVE. * NAME: IFTTY * SOURCE: 92067-18063 * RELOC: 92067-16035 * PGMR: C.M.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM IFTTY,7 92067-16035 REV.1805 771208 ENT IFTTY,.TTY EXT EXEC * * ROUTINE TO DETERMINE IF THE SPECIFIED LU IS INTERACTIVE * CALLED AS FOLLOWS: * * IFLAG = IFTTY(LU) JSB IFTTY * DEF *+2 * DEF LU * * * IFLAG = A REG = -1 IF THE LU IS INTERACTIVE * = 0 IF THE LU IS NON-INTERACTIVE * B REG = UPPER BYTE = DEVICE TYPE * LOWER BYTE = SUBCHANNEL NUMBER * * * .TTY EQU * IFTTY NOP ENTRY DLD IFTTY,I GET RETURN ADDRESS & LU# LDB B,I GET THE LU # STA IFTTY SAVE RETURN ADDRESS STB ANLU# AND LU # * JSB EXEC SEE IF THE LU IS INTERACTIVE DEF *+6 DEF D13I STATUS REQUEST DEF ANLU# THE LU WE WANT THE INFO ABOUT DEF YTEMP EQT WORD 5 PLACED HERE DEF DTYPE EQT WORD 4 PLACED HERE(NOT NEEDED) DEF ZTEMP SUB CHANNEL IN LOWER 5 BIT HERE * JMP ITSNT IT AIN'T EVEN AN LU !!!! LDA YTEMP GET EQT WORD 5 AND MEQT KEEP ONLY THE EQT TYPE FIELD LDB A AND SAVE IT LDA ZTEMP GET THE SUBCHANNEL BITS AND M37 STA ZTEMP ADA B CONFIGURE B REGISTER RETURN WORD STA DTYPE SZB,RSS IF DVR 00 THEN x   JMP ITSIN ITS INTERACTIVE CPB M2400 IF DVR 05 THEN JMP DVR05 DO ONE MORE CHECK FOR SUB CHANNEL CPB M3400 IS IT DVR07 ? JMP DVR05 THEN DO DVR05 CHECK JMP ITSNT ELSE ITS NOT INTERACTIVE * DVR05 LDA ZTEMP GET THE SUB CHANNEL # SZA,RSS IF = 0 THEN ITS ITSIN CCA,RSS SET INTERACTIVE FLAG ITSNT CLA SET NON INTERACTIVE FLAG LDB DTYPE JMP IFTTY,I RETURN TO CALLER * * D13I OCT 100015 M2400 OCT 2400 M37 OCT 37 M3400 OCT 3400 MEQT OCT 37400 ANLU# NOP DTYPE NOP YTEMP NOP ZTEMP NOP A EQU 0 B EQU 1 END 5    92067-18064 1826 S C0122 &LGLU4 RTE-IV LOGLU              H0101 ZASMB,R,L,C ** LOGLU - RETURNS LU FROM PROGRAM ID SEGMENT HED -LOGLU - FIND LU THAT THIS PROGRAM ORIGINATED FROM. * NAME: LOGLU * SOURCE: 92067-18064 * RELOC: 92067-16035 * PGMR: C.M.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM LOGLU,7 92067-16035 REV.1826 780502 ENT LOGLU * * ROUTINE TO FIND THE LOGICAL UNIT NUMBER THAT THIS * PROGRAM ORIGINATED FROM. * CALLED AS FOLLOWS: * * LU = LOGLU(IDUMY) JSB LOGLU * DEF *+2 * DEF IDUMY * * * LU = A REG = LU # OF LU AT WHICH 'RU' OR 'ON' WAS ENTERED. * OR IF SCHEDULED BY A FATHER, THE LU AT WHICH * THE FATHER WAS SCHEDULED. * = 1 IF PROGRAM SCHEDULED BY INTERUPT OR TIME LIST * B REG = ASCII LU # * IDUMY = 0 IF IN SESSION * = -1 IF NOT IN SESSION * * LOGLU NOP ENTRY DLD LOGLU,I GET RETURN ADDRESS & DUMMY ADDRESS STB DUMMY SAVE DUMMY ADDRESS STA LOGLU &RETURN ADDRESS LDB XEQT GET MY ID ADDRESS ADB D14 INDEX TO TYPE WORD XLA B,I GET THE TYPE AND D7 CPA D1 ADB DM4 ADB D18 CALCULATE SESSION WORD ADDRESS XLA B,I GET THE SESSION WORD SZA,RSS IF = 0 WE ARE NOT IN SESSION CCA SO SET LU = -1 SSA ARE WE IN SESSION ? CCB,RSS NO CLB YES STB DUMMY,I GIVE ANSWER TO CALLER * SPC 1 ******************************uP  ********************************* * SESSION MONITOR LU RETRIEVAL CODE TO BE INSERTED HERE * *************************************************************** SPC 1 * CMA,INA MAKE LU POS STA LU# * CLB NOW CONVERT TO ASCII DIV D10 ALF,ALF ADB A ADB ASC00 B = ASCII LU # LDA LU# A = BINARY LU # JMP LOGLU,I RETURN * * * D1 DEC 1 D7 DEC 7 D14 DEC 14 D18 DEC 18 D10 DEC 10 D30 DEC 30 DM4 DEC -4 DUMMY NOP LU# NOP ASC00 ASC 1,00 XEQT EQU 1717B A EQU 0 B EQU 1 END M    92067-18065 1805 S C0122 &.IAE4 RTE-IV .IAE.              H0101 (#ASMB,Q,C HED I/O ROUTINES FOR EMA ARRAYS * SOURCE: 92067-18065 * RELOC: PART OF 92067-16035 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** NAM .IAE.,7 92067-16035 REV.1805 771012 * * * THESE ROUTINES MAP IN ARRAYS TO BE PASSED TO THE FORMATER * AND THEN PASS THEM TO THE FORMATER. ARRAYS ARE MAPPED * IN 1024 WORDS AT A TIME SO AS TO INSURE THAT THAY ARE * ALWAYS ADDRESSABLE. * * * CALLING SEQUENCE: * * * JSB * DEF OFSET * DEF -ELEMENT COUNT * - RETURN - * * WHERE: IS: .IAE. FOR ONE WORD VARAIABLE * .RAE. FOR TWO WORD VARAIABLES * .XAE. FOR THREE WORD VARIABLES * .YAE. FOR FOUR WORD VARIABLES * * OFSET IS THE ARRAYS OFFSET FROM THE START OF EMA * (A TWO WORD DOUBLE INTEGER) * * ELEMENT COUNT IS THE NUMBER OF ELEMENTS OF THE GIVEN SIZE THAT * ARE TO BE TRANSFERED. (THIS IS A NEGATIVE * DOUBLE INTEGER.) * EXT .IAY.,.ZAE. ENT .IAE. * DEC 1024 THIS IS THE ONE WORD .IAE. NOP ENTRY POINT JSB .ZAE. GO DO IT DEC 1024 DEF .IAY. * END    92067-18066 1805 S C0122 &.RAE4 RTE-IV .RAE.              H0101 2,ASMB,Q,C HED I/O ROUTINES FOR EMA ARRAYS * SOURCE: 92067-18066 * RELOC: PART OF 92067-16035 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** NAM .RAE.,7 92067-16035 REV.1805 771012 * * * THESE ROUTINES MAP IN ARRAYS TO BE PASSED TO THE FORMATER * AND THEN PASS THEM TO THE FORMATER. ARRAYS ARE MAPPED * IN 1024 WORDS AT A TIME SO AS TO INSURE THAT THAY ARE * ALWAYS ADDRESSABLE. * * * CALLING SEQUENCE: * * * JSB * DEF OFSET * DEF -ELEMENT COUNT * - RETURN - * * WHERE: IS: .IAE. FOR ONE WORD VARAIABLE * .RAE. FOR TWO WORD VARAIABLES * .XAE. FOR THREE WORD VARIABLES * .YAE. FOR FOUR WORD VARIABLES * * OFSET IS THE ARRAYS OFFSET FROM THE START OF EMA * (A TWO WORD DOUBLE INTEGER) * * ELEMENT COUNT IS THE NUMBER OF ELEMENTS OF THE GIVEN SIZE THAT * ARE TO BE TRANSFERED. (THIS IS A NEGATIVE * DOUBLE INTEGER.) * EXT .RAY.,.ZAE. ENT .RAE. * * DEC 1024 THIS IT THE TWO WORD/ELEMENT .RAE. NOP ENTRY POINT JSB .ZAE. GO DO IT DEC 512 DEF .RAY. * END Q#  92067-18067 1805 S C0122 &.XAE4 RTE-IV .XAE.              H0101 92ASMB,Q,C HED I/O ROUTINES FOR EMA ARRAYS * SOURCE: 92067-18067 * RELOC: PART OF 92067-16035 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** NAM .XAE.,7 92067-16035 REV.1805 771012 * * * THESE ROUTINES MAP IN ARRAYS TO BE PASSED TO THE FORMATER * AND THEN PASS THEM TO THE FORMATER. ARRAYS ARE MAPPED * IN 1024 WORDS AT A TIME SO AS TO INSURE THAT THAY ARE * ALWAYS ADDRESSABLE. * * * CALLING SEQUENCE: * * * JSB * DEF OFSET * DEF -ELEMENT COUNT * - RETURN - * * WHERE: IS: .IAE. FOR ONE WORD VARAIABLE * .RAE. FOR TWO WORD VARAIABLES * .XAE. FOR THREE WORD VARIABLES * .YAE. FOR FOUR WORD VARIABLES * * OFSET IS THE ARRAYS OFFSET FROM THE START OF EMA * (A TWO WORD DOUBLE INTEGER) * * ELEMENT COUNT IS THE NUMBER OF ELEMENTS OF THE GIVEN SIZE THAT * ARE TO BE TRANSFERED. (THIS IS A NEGATIVE * DOUBLE INTEGER.) * EXT .XAY.,.ZAE. ENT .XAE. * DEC 1023 THIS IS THE THREE WORD/ELEMENT .XAE. NOP ENTRY POINT JSB .ZAE. GO DO IT DEC 341 DEF .XAY. * END _O  92067-18069 1805 S C0122 &.ZAE4 RTE-IV .ZAE.              H0101 =4ASMB,Q,C HED I/O ROUTINES FOR EMA ARRAYS * SOURCE: 92067-18069 * RELOC: PART OF 92067-16035 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** NAM .ZAE.,7 92067-16035 REV.1805 771012 * * * THESE ROUTINES MAP IN ARRAYS TO BE PASSED TO THE FORMATER * AND THEN PASS THEM TO THE FORMATER. ARRAYS ARE MAPPED * IN 1024 WORDS AT A TIME SO AS TO INSURE THAT THAY ARE * ALWAYS ADDRESSABLE. * * * CALLING SEQUENCE: * * * JSB * DEF OFSET * DEF -ELEMENT COUNT * - RETURN - * * WHERE: IS: .IAE. FOR ONE WORD VARAIABLE * .RAE. FOR TWO WORD VARAIABLES * .XAE. FOR THREE WORD VARIABLES * .YAE. FOR FOUR WORD VARIABLES * * OFSET IS THE ARRAYS OFFSET FROM THE START OF EMA * (A TWO WORD DOUBLE INTEGER) * * ELEMENT COUNT IS THE NUMBER OF ELEMENTS OF THE GIVEN SIZE THAT * ARE TO BE TRANSFERED. (THIS IS A NEGATIVE * DOUBLE INTEGER.) * * CALLING SEQUENCE TO THIS ROUTINE IS: * * DEC #WORDS/PAGE (MUST BE WHOLE ELEMENTS) * DEF TO DEFS TO OFFSET IN EMA AND -# ELEMENTS TO XFER * JSB .ZAE. RETURN IS TO ABOVE ADDRESS POINTED TO +2 * DEC #ELEMENTS/PAGE * DEF .IAY. OR .RAY. OR .XAY. OR .YAY. AS REQUIRED * EXT .EMAP,ERR0 ENT .ZAE. * #WDS NOP RTN NOP N3 DEC -3 A EQU 0 B EQU 1 FMTR NOP HOLD FORMATER ENTRY ADDRESS XIDEX EQU 1645B ADDRESS OF THE ID EXTENSION B174K OCT 174000 \ SKP .ZAE. NOP THIS IS WHERE IT HAPPENS CLB SET TO DEFAULT TO ZERO IF NOT AN EMA PGM. LDA XIDEX FIRST GET INA THE XLA A,I EMA LOGICAL ADDRESS AND B174K ISOLATE THE PAGE RAR PUT IN RIGHT SPOT IN WORD STA EMAAD PUT IN THE .EMAP CALL LDA .ZAE. GET THE RETURN ADDRESS AND ADA N3 USE IT TO INDEX INTO THE DLD A,I THE DATA DST #WDS SAVE THE #WORDS AND THE RETURN ADDRESS DLD B,I GET THE DEF'S FOLLOWING THE CALL ISZ RTN SET UP THE PROPER RETURN ADDRESS ISZ RTN SET UP THE PROPER RETURN ADDRESS STB T1 SAVE THE ADDRESS OF THE COUNT DLD A,I GET THE OFFSET DST EMOF AND SET IN THE .EMAP CALL DLD .ZAE.,I GET THE #WORDS/X AND THE FMTR ENTRY PT. STB FMTR SAVE IN THE FORMATER CALL STA NELM ALSO SAVE THE DEFAULT COUNT DLD T1,I GET THE TOTAL NUMBER OF WORDS IN THE ARRAY T1 EQU *-1 AGAIN DST COUNT SAVE IT ASL 1 TEST IF INB,SZB LESS THAN 32K LEFT (SETS E IF SKIP) JMP OK NO GO DO THE DEFAULT XFER * ERA YES RESTORE THE COUNT ADA NELM TEST IF LESS THAN THE DEFAULT SSA WELL? JMP OK NO GO DO THE DEFAULT * LDB COUNT YES COMPUTE HOW MANY CMB,INB AND STB NELM SET FOR THE CALL * OK JSB .EMAP CALL .EMAP TO RESOLVE THE ADDRESS DEF BOOM EMAAD NOP ADDRESS OF EMA FROM THE IDEX DEF TABLE USE DUMMY TABLE BOOM JSB ERR0 TOO BAD YOU LOSE STB CALL SET ADDRESS FOR FMTR CALL JSB FMTR,I CALL THE FORMATER CALL NOP ADDRESS NELM NOP NUMBER OF ELEMENTS * CLE COMPUTE WHAT IS LEFT LDA EMOF FIRST THE ADA #WDS THE EMA OFFSET SEZ,CLE MOST IS A CARRY ISZ EM OF+1 IF CHANGE STEP IT STA EMOF RESTORE THE OFFSET * DLD COUNT ADA NELM SUBTRACT FROM NUMBER LEFT SEZ,CLE MOST IS A CARRY OF 1 INB,SZB INDEX COUNT JMP AGAIN IF NO ROLL OVER THEN DO IT AGAIN * JMP RTN,I ELSE RETURN * * TABLE NOP NO DIMENSIONS EMOF NOP DOUBLE WORD EMA OFFSET NOP COUNT NOP DOUBLE WORD COUNT (NEGATIVE) NOP END   92067-18070 1805 S C0122 &4ASBO RTE-IV ASSEMBLER SEG 0             H0101 $ASMB,R,L,C * * NAME: ASMB0 * SOURCE: 92067-18070 * RELOC: 92067-16070 * PGMR: C.C.H.,S.P.K. * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * HED * RTE ASMBD 92067-16070 * (C) HEWLETT-PACKARD COMPANY 1978. NAM ASMB0,5,99 92067-16070 REV.1805 771017 ENT ASMB0 SPC 1 EXT OPN.C,PRM.C,C.BIN,C.BIA,C.LST,C.SOR EXT WRT.C,C.TTY,RUN.C EXT ?BPKU,?PKUP,?RSTA,?SETM,?SEGM,?ASM1 EXT ?MESX,?FLGS,?AFLG EXT ?X,?LWA,?RFLG,?ICSA,?LSTL,?LINC,?PLIN,?ENFL EXT ?NEAU,?HA38,?ASME EXT ?FP,?FPT,?NDSY,?MOVE SPC 2 EXT ?PASS,?PLCN,?PLEN,?PNTR,?IOBF,?BUFF,?PBUF EXT ?TEMP,?BINF,?FMPE * * **************************** * * TEMPORARY AND FLAG REGION* * **************************** * A EQU 0 B EQU 1 SUP SUPPRESS EXTENDED LISTING .1 DEC 1 .2 DEC 2 .3 DEC 3 .4 DEC 4 .5 DEC 5 .6 DEC 6 .14 DEC 14 .54B OCT 54 , BLNK OCT 40 LOWER BLANK,UPPER 0 (=40B) TW10 OCT 176000 ADDRESS MASK .B OCT 102 .M201 DEC -201 .M202 DEC -202 NPRG ASC 2,NPRG ASMBN OCT 5757 SPC 2 LINC EQU ?LINC PLINE EQU ?PLIN PASS EQU ?PASS PLCN EQU ?PLCN PROGRAM LOCATION COUNTER PLEN EQU ?PLEN LIT LENGTH PASS 1/LIT ORG PASS 2 PNTR EQU ?PNTR POINTS AT LAST OR CURRENT CHAR. * * I/O STATEMENT BUFFER * * *(INPUXFFER(BUFF) STARTS IN 11TH WORD)* IOBF EQU ?IOBF 50 WRDS+EOS BUFF. BUFF EQU ?BUFF PBUF EQU ?PBUF START OF PUNCH BUFR(NAM FMT) * .BUFF DEF BUFF ADDRESS OF BUFFER BPRMST ASC 1,]_ PROMPT CHARACTER SPC 1 ASMB0 LDA ?ENFL FLAG SET? SZA,RSS JMP OPNFL NO, THEN OPEN FILES JMP XRFSC YES,SCHEDULE XREF OPNFL LDA PRMST PROMPT CHARACTER JSB OPN.C NO, OPEN SOURCE FILE DEF C.SOR WITH REWIND OPTION JMP SRCER ERROR SEND OUT THE ERROR MESSAGE JSB OPN.C OPEN LIST FILE DEF C.LST LIST FILE FCB JMP LSTER SEND OUT ERROR MESSAGE JMP ASMD6 * SRCER CCB INDICATE SOURCE FILE CPA .M202 SOURCE NAMR NOT FOUND? RSS YES JMP ?FMPE NO, THEN DISPLAY FMP ERROR DLD NPRG YES, DISPLAY: JSB ?MESX /ASMB: NPRG JMP ?ASME EXIT * LSTER CLB JMP ?FMPE DISPLAY FMP ERROR * ASMD6 LDA ?ICSA CMA,INA STA ?LSTL CLA STA PASS SET PASS FLAG=0 (PASS 1) JSB ?RSTA READ AND PRINT CONTROL STATEMENT * * * TEST FOR 'ASMB' IN FIRST 4 POSITIONS * * LDA BUFF CMA,INA ADA BUFF+1 CPA ASMBN =5757B (I.E. =ASMB?) JMP COPS YES * * * CONTROL STATEMENT ERROR ROUTINE * * CSER LDA .CS 'CONTROL' STATEMENT'ERROR LDB .CS+1 JSB ?MESX PRINT MESSAGE JMP ?ASME ASSEMBLER EXIT * * * TEST FOR CONTROL OPTIONS (A,B,C,F,L,N,R,T,X,Z) * * COPS CLA INITIALIZE STA XFOPT X OR F OPTION JSB PRM.C GET DEF .5 PARAMETER # 5 SZA,RSS OVER RIDE OPTIONS SPECIFIED? JMP COPST NO PROCESS STANDARD ASMB STMT * CLE,ERB DIVIDE BYTE ADDR BY 2 TO GET WORD ADDR SEZ WAS IT AN ODD BYTE ADDRESS? CMB,INB INDICATE STRING STARTS ON RIGHT BYTE STB MVSTR SOURCE ADDRESS OF WORDS LDA .5 CHECK FOR A OR R OPTION IN CS STRING STA PNTR IN THE SOURCE STATEMENT CLOOP JSB ?PKUP PICKUP A CHAR CPA BLNK  DONE? JMP GETOP YES, GET OVER RIDE OPTIONS SZA,RSS 0? JMP GETOP YES, GET OVERRIDE OPTIONS CPA .54B COMMA? RSS YES JMP CSER NO, ERROR JSB ?BPKU SKIP BLANKS ISZ PNTR SET POINTER TO CHECK NEXT CONTROL OPTION CPA .R R OPTION? JMP RLOC YES CPA .A A OPTION? RSS YES JMP CLOOP NO, CHECK NEXT CONTROL OPTION STA ?AFLG RSS RLOC STA ?RFLG SET RELOCATABLE ASSEMBLY FLAG GETOP LDA .6 # OF CHARS IN STRING TO MOVE LDB .BUFF DESTINATION ADDRESS RSS LDB B,I REMOVE INDIRECTS RBL,CLE,SLB,ERB JMP *-2 JSB ?MOVE MVSTR NOP CLA,INA SET UP CHAR POINTER TO STRING STA PNTR RELATIVE CHAR POSITION W.R.T. BUFF OPLP JSB ?PKUP PICKUP NEXT CHAR CPA BLNK BLANK? JMP G YES, THEN TERMINATE CHECK JSB CHKOP NO, THEN CHECK OPTION LDB PNTR CMB,INB ADB .6 GREATER THAN 6? SSB JMP G YES, TERMINATE CHECK JMP OPLP NO, TEST FOR MORE SPC 2 COPST LDA .5 (5) STA PNTR SET PNTR = 5 COPUP JSB ?PKUP GET NEXT CHARACTER CPA BLNK DONE ? JMP G YES SZA,RSS CHAR=0? JMP G YES, 0K CPA .54B COMMA? RSS -YES- JMP CSER -NO- ERROR JSB ?BPKU SKIP BLANKS JSB CHKOP CHECK FOR OPTION ISZ PNTR JMP COPUP TEST FOR MORE CONTROL OPTIONS SPC 1 * TEST FOR VALIDITY OF CONTROL OPTION CHKOP NOP LDB ?FLGS LOC'N OF CONTROL CHAR SET CPA .B =B? (PUNCH) JMP CHKOP,I YES,IGNORE CPA .L =L? (LIST) JMP BCON YES CPA .R =R? (RELOC.-NOT NECESSARY) ADB .1 YES CPA .T =T? (SYMBOL TABLE PRINT) ADB .2 Y6ES CPA .N IS IT FOR IFN? ADB .3 YES CPA .Z IS IT FOR IFZ? ADB .3 YES CPA .A =A? (ABSOLUTE ASSEMBLY?) ADB .4 YES CPA .C =C? (CROSS REF. TABLE?) ADB .5 YES CPA .Q =Q? JMP BCON YES,PRINT ONLY ADDRESS NOT INSTRUCTION CODE CPA .P =P (OVERRIDE OPTION?) JMP CHKOP,I YES, IGNORE IT CPB ?FLGS SKIP IF ANY OPTION FOUND JMP XTST NO NICE MATCH SO FAR BCON STA 1,I SET OPTION FLAG JMP CHKOP,I RETURN .L OCT 114 ASCII 'L' .N OCT 116 'N' .R OCT 122 'R' .T OCT 124 'T' .Z OCT 132 'Z' .A OCT 101 'A' .C OCT 103 'C' .X OCT 130 'X' .Q OCT 121 'Q' .P OCT 120 'P' .F OCT 106 'F' XFOPT DEC 0 'X' OR 'F' OPTION COUNT CNTX DEC -12 LENGTH OF FLOATING POINT OPCODE ENTRIES DESTN DEF ?FP LOC'N OF HDWE. 'FIX/FLT' OPCODES AS.FI OCT 43111 ASCII 'FI' TO ENABLE 'FIX/FLT' OPCODES DESLO DEF ?FPT LOC'N OF FLOATING POINT OPCODE ENTRIES * MVLC DEF *+1 FLOATING POINT OPCODE TBL. VALUES * * ****** FAD ******* ****** FDV ******* OCT 43101,42026,105000,43104,53026,105060 * * ****** FMP ******* ****** FSB ******* OCT 43115,50026,105040,43123,41026,105020 * * * END OF FLOATING POINT ENTRIES * * SKP CS.CK NOP LDA XFOPT LOAD A WITH OPTION FLAG SZA SKIP IF FLAG 0 JMP CSER IF 1 PRINT CS ERROR INA INCREMENT VALUE OF FLAG STA XFOPT SAVE IN FLAG POSITION JMP CS.CK,I RETURN * FMOVE JSB CS.CK GO CHECK LEGAL OPTION LDB DESTN LOAD B WITH TABLE POINTER RBL,CLE,SLB,ERB CLEAR INDIRECT BIT, IF ANY. LDB B,I PUT POINWTER ADDR. IN B LDA AS.FI LOAD A WITH ASCII "FI" STA B,I STORE IN FIX PART OF TABLE LDB DESLO LOAD B WITH SECOND TABLE POINTER RBL,CLE,SLB,ERB CLEAR INDIRECT BIT, IF ANY. LDB B,I PUT POINTER ADDR. IN B TMOV2 LDA MVLC,I LOAD FIRST WORD STA B,I STORE IN TABLE ISZ MVLC INCREMENT TO NEXT WORD INB INCREMENT POINTER ISZ CNTX INCREMENT COUNT, SKIP IF 0 JMP TMOV2 RETURN FOR NEXT WORD JMP BCON+1 RETURN * XTST CPA .F IS OPTION =F JMP FMOVE YES, GO CHANGE TABLE CPA .X IS OPTION =X JMP TMOVE YES, GO CHANGE TABLE JMP CSER NO, PRINT CONTROL STATEMENT ERROR! TMOVE JSB CS.CK CHECK IF F BEFORE LDB DESLC MOVE N-EAU OPCODE VALUES RBL,CLE,SLB,ERB CLEAR INDIRECT BIT, IF ANY. LDB B,I PUT POINTER ADDRESS IN B TMOV1 LDA MOVLC,I OPCODE TABLE IN ASMB.. RAL,CLE,SLA,ERA CLEAR INDIRECT BIT, IF ANY. LDA A,I GET DIRECT ADDRESS. STA B,I STORE NEW VALUE INTO OPCODE TBL. ISZ MOVLC INB BUMP TABLE POINTER ISZ COUNX IS TABLE ALL MOVED? JMP TMOV1 NO, GO MOVE ANOTHER WORD. JMP BCON+1 COUNX DEC -13 LENGTH OF NEW TABLE DESLC DEF ?NEAU LOCATION OF OPCODE VALUE DESTIN. * MOVLC DEF *+1 NON-EAU OPCODE VALUES FOR TABLE. OCT 42111,53006 DIV DEF ?HA38 OCT 42114,42006 DLD DEF ?HA38 OCT 42123,52006 DST DEF ?HA38 OCT 46520,54406 MPY DEF ?HA38 OCT 0 END OF NEW TABLE * * TEST FOR COMPATABILITY AMONG THE OPTIONS * * G LDB ?AFLG LDA ?RFLG SZB,RSS IS 'A' SET? JMP *+3 SZA YES - IS 'R' SET? JMP CSER YES - CONTROL CONFLICT LDA ?X GET FWA OF AVAILABLE CORE CMA,INA ADA ?LWA LWA-FWA AVAIL MEM. IN A INA A NOW |= SYMBOL TBL LENGTH * * * CLEAR SYMBOL TABLE * * LDB ?X FWA OF SYM TBL TO 'B' STB ?NDSY SET ADDRESS OF END OF SYMBOL TABLE JSB ?SETM NOP SET SYMBOL TABLE TO ZERO * ********************* * * START PASS 1 HERE * * ********************* LDB ?AFLG GET ABSOLUTE ASSEMBLU FLAG SZB,RSS ABSOLUTE ASSEMBLY? JMP RELOC NO JSB OPN.C YES DEF C.BIA ABSOLUTE BINASY FILE FCB OUTER CLB,INB,RSS ERROR JMP ASMD5 CPA .M201 IS THE ERROR BINARY FILE NOT SPECIFIED? JMP ASMD7 YES, THEN DO, NOT OUTPUT BINARY JMP ?FMPE NO, THEN PRINT ERROR MESSAGE RELOC JSB OPN.C RELOC. ASSEMBLY DEF C.BIN BINARY RELOCATABLE FCB JMP OUTER ERROR ASMD5 CLA,INA SET FLAG TO INDICATE STA ?BINF BINARY OUTPUT IS PRESENT ASMD7 LDA TW10 STA ?ASM1 SET FLAG FOR 'INIT' PROCESSING CLA STA PASS SET PASS FLAG FOR PASS 1 STA PLCN INITIALIZE PROG LOC'N COUNTER STA PLEN CLEAR LITERAL LENGTH FLAG LDA EXTLN GET LENGTH OF NAM EXTENSION AREA. LDB EXTAD GET FWA OF NAM EXTENSION. JSB ?SETM GO SET BLANKS INTO THE AREA. ASC 1, DUAL ASCII BLANKS. LDA .3 SEG. CALL FOR ABSOLUTE LDB ?AFLG GET ABSOLUTE-ASSEMBLY FLAG. SZB,RSS ABS. ASSY? - SKIP IF TRUE. CLA,INA PICK UP CODE FOR ASMB1 JMP ?SEGM GO TO LOAD THE NEXT SEGMENT .CS ASC 2,CS ASCII 'CS' FOR CONTROL STMT. ERROR MSG. EXTAD DEF PBUF+17 FWA OF NAM EXTENSION AREA. EXTLN EQU .54B (54B) LENGTH OF NAM EXTENSION AREA. * * THIS SECTION IS ENTERED TO SCHEDULE XREF ANDEOR * TERMINATE THE ASSEMBLER * * XRFSC LDA LINC+1 GET CURRENT PAGE # CMA,INA NEGATE FOR SIGNAL TO XREF STA PRMLS+3 SAVE IN PARAMETER LIST LDA PLINE GET THE NEGATED # LINES/PAGE I*($ CMA,INA MAKE THE VALUE POSITIVE STA PRMLS+4 SET IT IN PARAMETER LIST * JSB WRT.C INFORM THE OPERATOR DEF C.TTY THAT THE CROSS-REFERENCE GENERATOR DEF TELOP HAS BEEN SCHEDULED DEF .12 NOP * JSB RUN.C SCHEDULE THE XREF PROGRAM DEF C.SOR SOURCE FILE FCB DEF C.LST DEF XREF NAME OF PROGRAM DEF PRMLS PARAMETER LIST JMP ?ASME TERMINATE ASSEMBLER * PRMLS NOP BSS 4 TELOP ASC 4, /ASMB: XREF ASC 3,XREF ASC 5,SCHEDULED .12 DEC 12 * END ASMB0 j*   92067-18071 1805 S C0222 &4AS11 RTE-IV ASSEMBLER SEG 1             H0102 ASMB,R,L,C * * NAME: ASMB1 * SOURCE: 92067-18071 * RELOC: 92067-16071 * PGMR: C.C.H.,S.P.K. * MOD 77-01-30 ADDED DEY INST EAS * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** HED * RTE ASMB1 92067-16071 * (C) HEWLETT-PACKARD COMPANY 1978. * NAM ASMB1,5,99 92067-16071 REV.1805 771102 ENT ASMB1 SPC 1 EXT RWN.C,C.SOR SPC 1 ENT ?LITI,?CMQ,?INSR,?HA3Z,?ENP,?EXP,?EMP EXT ?RSTA,?ERPR,?MOVE,?CHPI,?OPER,?PLIT,?ORGS EXT ?ASCN,?BPKU,?MSYM,?PKUP,?SYMK,?CHOP,?ENDS EXT ?MSYS,?SEGM,?PNCH,?V,?X EXT ?ICSA,?TFLG,?LTFL,?CNTR EXT ?ARTL,?ASM1,?ORRP,?BNCN,?DCOD,?MESX,?PRNT EXT ?LABE EXT ?OPLK,?NDOP,?NDSY,?ENER,?PRPG EXT ?BPSV,?GETA,?GETC,?SYMT,?FMPE SPC 2 EXT ?NAMI,?NAME,?SUMP,?FLEX,?CNTB,?CODE,?INST EXT ?LAST,?PEEK,?PLCN,?PLEN,?PNTR,?SCN1,?SYMI EXT ?SYMP,?TEST,?ENT.,?ENTC,?ENTV,?IOBF,?BUFF EXT ?PBUF,?TEMP SUP .1 DEC 1 .2 DEC 2 .3 DEC 3 .4 DEC 4 .5 DEC 5 .6 DEC 6 .7 DEC 7 .12 DEC 12 .13 DEC 13 .14 DEC 14 .15 DEC 15 .16 DEC 16 .17 DEC 17 .M1 DEC -1 .M2 DEC -2 L OCT 50,51,52,53,54,55,56 .9 DEC 9 .29 DEC 29 .M8 DEC -8 .M15 DEC -15 .M29 DEC -29 BLNK OCT 40 =40B(LOWER BLANK) .IL ASC 1,IL .MBLN ASC 1,M .NO ASC 1,NO BLNS ASC 1, BIT15 OCT 100000 .E OCT 105 .B OCT 102 RC ASC 5,E R B C X TEMP EQU ?TEMP NAMI EQU ?NAMI LOC'N FOR TEMP SYMBOL STORAGE NAME EQU ?NAME FOR USE BY 'OPLK' SUMP EQU ?SUMP RUNNING SUM FOR 'CHOP' FLEX EQU ?FLEX 'ASCN' CNTB EQU ?CNTB CODE EQU ?CODE OPCODE TYPE(FROM OPTABLE) INST EQU ?INST OPCODE FORMAT LAST EQU ?LAST PEEK EQU ?PEEK LAST CHAR PICKED UP PLCN EQU ?PLCN PROGRAM LOCATION COUNTER PLEN EQU ?PLEN LIT LENGTH PASS 1/LIT ORG PASS 2 PNTR EQU ?PNTR POINTS AT LAST OR CURRENT CHAR. SCN1 EQU ?SCN1 STATE LNG/OPCODE/OPERAND/LABEL(4) SYMI EQU ?SYMI ADDR CNTR FOR SYMBOL TBL (SYMK) SYMP EQU ?SYMP SYMBOL LNG/ AND LOC'N TEST EQU ?TEST TEST CHARACTER ENT. EQU ?ENT. ENTC EQU ?ENTC ENTV EQU ?ENTV * * I/O STATEMENT BUFFER * IOBF EQU ?IOBF 50 WORDS + END OF STATEMENT BUFF * *(INPUT BUFFER 'BUFF' STARTS IN 11TH WORD)* BUFF EQU ?BUFF PBUF EQU ?PBUF SAVES THE 'NAM' RECORD INFO. OCT 0 EXTRA WORD FOR BUFFER OVERFLOW. WCNT EQU PBUF WORD(BLK) CNT FOR BIN.RECRD. SPC 1 ASCN EQU ?ASCN BPKUP EQU ?BPKU CHOP EQU ?CHOP CHOPI EQU ?CHPI CNTR EQU ?CNTR ERPR EQU ?ERPR GETA EQU ?GETA GETC EQU ?GETC LTFLG EQU ?LTFL MOVE EQU ?MOVE MSYM EQU ?MSYM MSYMS EQU ?MSYS OPERR EQU ?OPER ORGSV EQU ?ORGS PKUP EQU ?PKUP PNCH EQU ?PNCH RSTA EQU ?RSTA SYMTS EQU ?SYMT X EQU ?X * ICNTR DEC -6 ATBL DEF *+1 PBF9 DEF PBUF+9 CSAD DEF PBUF+3 POINTS AT PUNCH BUFFER DSTAD DEF PBUF+17 ADDR: NAM EXTENSION BUFFER PBF8 DEF PBUF+8 ADDRESS: NAM-RECORD COMMON DECLARATION SNOB DEF IOBF+5 BUFFER ORIGIN FFUB DEF BUFF SPC 1 * ASMB1 LDA ATBL,I GET AN INDIRECT ADDRESS RSS LDA A,I REMOVE ONE LEVEL OF INDIRECT RAL,CLE,SLA,ERA BIT 15 SET? JMP *-2 YES STA ATBL,I RESTORE DIRECT ADDRESS ISZ ATBL ISZ ICNTR ALL ADDRESSES DONE? JMP ASMB1 NO * ASMBA JSB RSTA LDA CODE CPA .15 'HED' STATE? JMP IXH YES STA ?ASM1 CLEAR 'CS' AND 'INIT' FLAGS CPA .13 (13) NAM ? JMP HI12 * * * NO NAM OR ORG * * \ LDA .NO 'NO'= NO ORG OR NAM STATEMENT JSB ERPR JMP HA32+1 IXH JSB INST,I GO TO HEDSB JMP ASMBA * * * * PROCESS NAME FOR BINARY RECORD * * PNSAV OCT 0,0 FOR USE IN 'NAM' SETUP HI12 LDB SCN1+2 JSB MSYM MEASURE THE NAME STB HI14 STA PNSAV SAVE # OF CHARS IN THE PARAMETER LDB TEST GET CONTINUATOR STB PNSAV+1 AND SAVE IT LDB CSAD JSB MOVE MOVE IT TO THE 'NAM' RECORD HI14 NOP LDA PNSAV+1 GET THE CONTINUATOR CPA L+4 COMMA?(ANOTHER PARAMETER?) RSS YES JMP HI16 NO - GO TEST FOR END LDA PNSAV GET # OF CHARS IN CURRENT PARAME ADA PNTR INA STA PNTR SET POINTER TO NEXT PARAMETER JSB BPKUP SCAN TO NEXT PARAM. JSB MSYM MEASURE IT STA PNSAV SAVE # OF CHARS IN THE PARAMETER ALF,ALF INA FOR DECIMAL CONV ALF,ALF POSITION IT STA 1 PARAM. FOR 'ASCN' TO 'B' REG. LDA TEST GET CONTINUATOR STA PNSAV+1 AND SAVE IT LDA PNTR GET POSITION OF NUMBER JSB ASCN GO CONVERT THE NUMBER CLA ERROR RETURN, SET 'A' =0 STA PBF9,I ISZ PBF9 JMP HI14+1 HI16 CPA BLNK LEGAL? RSS YES JSB OPERR NO - PRINT 'M' ERROR LDA PBUF+9 SZA,RSS IS TYPE=0(SYSTEM)? STA PBUF+10 YES, SET PRIORITY = 0. SPC 1 * * EXTENDED NAM RECORD PROCESSOR * SPC 1 LDA PNSAV GET # OF CHARS. IN CURRENT PARAM. ADA PNTR INA SET POINTER TO NEXT PARAMETER. STA PNTR SAVE FOR BUFFER MOVE. CMA,INA COMPUTE THE NUMBER OF ADA SCN1 ADDITIONAL CHARACTERS, IF ANY. SSA,INA MORE ? JMP HA32 NO. STA PNSAV YES. SAVE CHARACTER COUNT. LDA PNTR RELATIVE POINTER TO START JSB GETA OF NAM RECORD EXTENSION STB SRCAD SOURCE BUFFER. LDA PNSAV GET NUMBER OF CHARACTERS, LDB DSTAD AND DESTINATION ADDRESS JSB MOVE FOR DATA MOVE. SRCAD NOP LDA PNSAV CONVERT NUMBER OF INA CHARACTERS TO ARS NUMBER OF WORDS. ALF,ALF POSITION TO UPPER BYTE. ADA WCNT COMPUTE TOTAL NAM-REC WORD COUNT STA WCNT SAVE FOR PUNCH ROUTINE. * SKP HA32 JSB RSTA GO TO GET NEXT STATEMENT. LDA CODE GET OPCODE IDENTIFIER. CPA .12 IS IT THE 'END' STATEMENT ? JMP HB00 YES, GO TO 'END' PROCESSOR. CPA BLNK (40B) SUP/UNS? JMP HA32 IGNORE-PASS #1. CPA .32B REPLACEMENT CODE ? JMP HA71 YES, GO TO RPL PROCESSOR. CPA .100B USER MICROCODE (MIC)? JMP MIC YES, GO PROCESS. ADA .M3 (-3) SSA ORR/ORB/ORG ? JMP HA64 YES, ROUTE TO PROCESSOR. CPA .12B NAM? JMP HA63 YES, ERROR ADA .M3 (-3) SSA 'COM','ENT','EXT' OR 'EMA' ? JMP INST,I JUMP TO ROUTINE DESIGNATED IN INST CPA .5 'EQU'? JMP HA56 TO EQU CPA .9 (11B) HED? JMP HA32 IGNORE-PASS #1. CPA .12 (14B) SKP? JMP HA32 IGNORE-PASS #1. CPA .13 (15B) SPC? JMP HA32 IGNORE-PASS #1. CPA .14 (16B) LST/UNL? JMP HA32 IGNORE-PASS #1. * * * TEST FOR LABEL FIELD * JSB LABEL LDA CODE OPCODE INDICATOR CPA DEX JMP HA40 IT'S A 'DEX' CPA DEY IF INST = DEY THEN JMP HA40 GO PROCESS IT CPA BYT IS IT A 'BYT'? JMP HA40 YES, GO PROCESS. CPA .29 REP? JMP HA64 YES CPA .7 (7) JMP HA54 TO ASC CPA .26B INTEGER ARITH(HARDWARE)? JM:P HA70 YES.... CPA .6 (6) ARITH MACRO? JMP INST,I YESM JUMP TO PROCESS IT.. ADA .M10 -10 SSA OCT OR DEC? JMP HA40 YES. SZA,RSS BSS? JMP HA3M TO BSS PROCESSOR. CPA .4 (4) MEM REF? JMP HA3L YES,TEST FOR LITERAL LDA CODE GET OPCODE I.D. NUMBER. ADA M100B SUBTRACT 100 OCTAL. SSA,RSS CODE <100B ? JMP XMIC NO, IT'S A MICROCODE MACRO. HA3B CLA,INA TO ADD 1 TO PLCN * * * INCREMENT PROGRAM LOCN. CNTR. * * HA3Z ADA PLCN ADD CURRENT LOC'N. STA PLCN SAVE NEW PROG. LOC'N COUNT. JMP HA32 GO TO GET NEXT STATEMENT. .26B OCT 26 FOR HARDWARE ARITHMETIC SPC 1 * * PROCESS BSS * * HA3M JSB CHOPI EVALUATE OPERAND. JMP HA32 * ERROR * LDA 1 B TO A JMP HA3Z GO UPDATE PROG. LOC'N COUNT. HA3L LDA LTFLG SZA,RSS LITERAL PRESENT ? JMP HA3B NO LDA INST SLA IS LITERAL LEGAL WITH INST? JMP *+3 YES JSB OPERR NO 'M' ERROR JMP HA3B JSB ?PLIT PROCESS LITERAL NOP IGNORE ERROR JMP HA3B * .M3 DEC -3 .12B OCT 12 .32B OCT 32 .100B OCT 100 M100B OCT -100 .M10 DEC -10 BYT OCT 43 OPCODE I.D. NO. FOR 'BYT' DEX OCT 25 OP TYPE FOR 'DEX' DEY OCT 44 OP TYPE FOR 'DEY' ENFLG NOP FLAG FOR PROCESSING ENTRY POINTS S BSS 1 * SKP * * PROCESS 'COMMON' DECLARATION * * CMQ LDA SCN1+2 STA PNTR SET POINTER STA TEST SET TEST (U) = 0. CMQA LDB PNTR JSB SYMCK GO TO CHECK FOR VALID SYMBOL. JMP HA32 ** ERROR ! GO TO GET NEXT STATEMENT. LDB PBF8,I SAVE CURRENT COM. LOC'N STB S FOR SYMBOL TABLE VALUE. LDB TEST GET CHARACTER FOLLOWING THE SYMBOL. eCPB L+4 COMMA? JMP HM2 YES CPB BLNK END OF OPERAND ? JMP HM2 YES, IT'S = BLANK CPB L LEFT PAREN? RSS YES, = ( JMP HA55+1 NO. ERROR: 1ST PASS JSB BPKUP SKIP BLANKS STB TEMP+1 SAVE POINTER JSB MSYM MEASURE COM LENGTH STA TEMP SAVE NUMBER OF CHARACTERS JSB SPNTR ALIGN POINTER LDA TEST CPA L+1 RT PAREN? RSS YES, = ) JMP HA55+1 NO. 1RST PASS ERROR! STA PEEK LDB TEMP LDA LAST ADB .M1 LENGTH-1 TO B REG CPA .B =B? (OCTAL VALUE) RSS YES-SKIP ADB .401B NO, SET FOR DECIMAL LDA TEMP+1 JSB ASCN GO TO ASCII CONVERSION ROUTINE JMP HA32 ERROR EXIT ADA PBF8,I BUMP LENGTH OF OOMMON STA PBF8,I * * * INSERT 'COMMON' SYMBOL INTO TABLE * HM3 LDA .3 SET RELOC=COMMON LDB S VALUE TO B JSB INSR INSERT SYMBOL NOP ERROR EXIT LDA PEEK CPA BLNK BLANK? JMP HA32 YES, EXIT TO HA32 CPA L+4 COMMA? RSS YES JSB PKUP GET NEXT CHAR JSB ENDTS TEST FOR TERMINATION JMP CMQA HM2 ISZ PBF8,I STB PEEK SAVE TEST JMP HM3 * * PROCESS 'EXT' DECLARATION * EXP LDA SCN1+2 STA PNTR SET POINTER EXPA LDB PNTR JSB SYMCK GO TO CHECK FOR VALID SYMBOL. JMP HA32 ** ERROR: INVALID SYMBOL ! LDB CNTR VALUE TO B LDA .4 (4) EXT INDIC. JSB INSR GO TO INSERTION ROUTINE JMP *+2 ERROR EXIT ISZ CNTR BUMP EXT CNTR LDA TEST JSB ENDTS TEST FOR TERMINATION JMP EXPA GO BACK, THERE'S ANOTHER 'EXT'!! * * * PROCESS 'ENT' DECLARATION * ENP LDA .10B SET ENFLG = 10B STA ENFLG LDA SCN1+2 q STA PNTR SET POINTER ENPA LDB PNTR JSB SYMCK GO TO CHECK FOR VALID SYMBOL. JMP HA32 ** ERROR: INVALID SYMBOL ! LDA .210B SET 'U' & 'E' FIELDS = 1 CLB JSB INSR INSERT INTO THE SYMBOL TABLE NOP LDA TEST JSB ENDTS TEST FOR TERMINATION JMP ENPA ENDTS NOP TEST FOR TERMINATION CPA BLNK OF COM,ENT OR EXT JMP HA55E CPA L+4 COMMA? RSS YES JMP HA55+1 NOT AN ERROR EXIT JSB BPKUP SCAN TO NEXT CHAR. JMP ENDTS,I * * PROCESS 'EMA' DECLARATION EMP CLA,INA SET EMA FLAG STA EMFLG LDA EMCNT COUNTER FOR # OF EMA INSTR. SZA AN EMA INSTR ALREADY ENCOUNTERED? JMP EMAIL YES, THEN ERROR LDA SCN1+2 SET POINTER TO FIRST OPCODE'S STA PNTR RELATIVE CHARACTER POSITION LDA .2 PRETEND IT IS AN ASC INSTRUCTION JSB CHOP GET VALUE OF FIRST OPERAND JMP HA32 ERROR RETURN SZA IS VALUE ABSOLUTE? JMP EMAOP NO THEN OPERAND ERROR LDA SUMP SAVE VALUE OF FIRST OPERAND STA EMASZ WHICH IS EMA SIZE * JSB PKUP PICKUP NEXT CHAR CPA L+4 IS IT A COMMA? RSS YES JMP EMAOP NO, THEN ERROR JSB BPKUP SKIP OVER ANY BLANKS STB SCN1+2 SET OPERAND POINTER AT 2ND PARAMETER CLA SET A=0 FOR NO COMMA JSB CHOP GET VALUE OF THE MSEG SIZE JMP HA32 ERROR RETURN SZA ABSOLUTE VALUE? JMP EMAOP NO, THEN ERROR-BAD OPERAND LDA SUMP YES, GET VALUE STA MSGSZ SAVE THE MAPPING SEGMENT SIZE * TEST FOR VALIDITY OF EMA SIZE AND MSEG SIZE LDA EMASZ GET EMA SIZE SSA -VE? JSB EMAOP YES, THEN OPERAND ERROR CMA,INA NEGATE EMA SIZE ADA .1023 MUST BE LESS THAN 1024 SSA EMA 3SIZE LESS THAN 1024? JMP EMAOP NO THEN OPERALND ERROR LDA MSGSZ NO, GET MSEG SIZE SSA -VE? JMP EMAOP YES, THEN OPERAND ERROR CMA,INA NEGATE MSEG SIZE ADA .31 SSA IS IT LESS THAN 32? JMP EMAOP NO, THEN ERROR * BOTH OPERANDS ARE VALID , TEST FOR LABEL JSB LBCK LABEL PRESENT? STA SYMP YES, SET CHARACTER COUNT LDB FFUB GET BUFFER ADDRESS STB SYMP+1 SET LABEL ADDRESS LDA .4 EXT INDICATOR LDB CNTR ORDINAL # - VALUE JSB INSR INSERT EMA LABEL INTO SYMBOL TABLE JMP HA32 ERROR EXIT ISZ CNTR INCREAMENT ORDINAL# CLA STA EMFLG CLEAR EM FLAG INA SET EMA COUNT TO INDICATE AN EMA STA EMCNT INSTRUCTION HAS ALREADY BEEN ENCOUNTERED JMP HA32 READ NEXT STATEMENT * PRINT EMA ERRORS EMAOP JSB OPERR OPERAND ERROR JMP HA32 READ NEXT STATEMENT EMAIL LDA .IL 'IL' ILLEGAL INSTR ERROR JSB ERPR PRINT ERROR MESSAGE JMP HA32 READ NEXT STATEMENT * EMASZ NOP MSGSZ NOP EMFLG NOP EMCNT NOP .31 DEC 31 .1023 DEC 1023 * HA55E CLA STA ENFLG CLEAR 'ENT'FLAG JMP HA32 EXIT ON A BLANK SPC 1 * * PNTR+1+'A' TO PNTR * SPNTR NOP ADA PNTR INA STA PNTR JMP SPNTR,I * .10B OCT 10 .210B OCT 210 SPC 1 HA63 LDA .IL NAM IS ILLEGAL AFTER START JMP HA55+2 TO ERPR * ************************************************* * * INSR: ADD ENTRY TO THE SYMBOL TABLE, W HACCOU * * * LINKAGE: A = TYPE B = VALUE ON INPUT * * * (OUTPUT) SYMP=NO.OF CHARS., SYMN=ENTRY FWA * * * L JSB INSR,I * * * L+1 ERROR RETN ('SO' OR 'DD'PRNTD)* * * L+2 NORMAL RETN * * *******************-****************************** .EN ASC 3,ENDDSO INSR NOP STA FLX1 SAVE TYPE STB NAME+3 SAVE VALUE JSB ?SYMK SYMBOL TABLE LOOKUP JMP INS1 NOT FOUND; GO TO INSERT. LDB ENFLG ALREADY THERE. SZB,RSS IN ENTRY PROC? JMP INSY NO ADA .M4 (-4) CHECK SYMBOL TYPE: SSA IS IT ABS,REL,B.P.,OR COM ? JMP INSC YES ENERR LDA .EN 'EN' ERROR: WRONG TYPE, DUPLICATE OR JMP INSX REFERENCE TO EXT-DEFINED SYMBOL. INSY AND .7 ISOLATE SYMBOL TYPE. LDB FLEX GET CURRENT FW OF ENTRY. SSB,RSS UNDEFINED ENTRY POINT? JMP INSG NO BLF IS THE 'E' BIT SET? SSB,RSS JMP INSG NO, THEN AN EMA LABEL LDB FLX1 YES, GET CURRENT SYMBOL TYPE CPB .4 EQUATING EXT TO ENT-DEFINED SYMBOL? JMP INSX-1 YES: 'DD' ERROR! ADA .M4 NO, CHECK TYPE: SSA,RSS ABS,REL,B.P. REL,OR COM? JMP ENERR INVALID TYPE FOR ENT! LDA FLX1 GET SYMBOL TYPE. ALF,ALF POSITION TO BITS #8-11 IOR FLEX INCLUDE ORIGINAL DATA, ELA,CLE,ERA CLEAR UNDEFINED BIT. LDB NAME+3 SET VALUE INTO STB TEMP+1,I SYMBOL TABLE ENTRY. JMP INSEX-1 FINISH PROCESSING. INSG CPA .7 LITERAL? JMP INSR,I YES, EXIT CPA .4 EXT? JMP INSZ YES, TEST INSE LDA .EN+1 NO, 'DD' ERROR (MULTIPLE SYMBOL) INSX JSB ERPR JMP INSR,I GET OUT HERE INSZ LDB FLEX EMA? SSB IS THE 'U' BIT SET? JMP INSE YES, ERROR LDB EMFLG IN EMA PROCESS? SZB JMP INSE YES, ERROR CPA FLX1 ARE BOTH EXT'S? JMP INSR,I YES, FAKE 'DD'EXIT (FOR ARITH. MACRO'S). JMP INSE GO TO ERROR PRNT INS1 LDA FLX1 ALF,ALF ADA NAME TYPE IN FIRST WORD LDB EMFLG IN EMA PROCESS? SZB  IOR BIT15 YES, SET 'U' BIT TO INIDICATE EMA LABEL STA NAME OF ENTRY LDB NAMI ADB TEMP+2 STB TEMP+1 SET LIMIT LDA ?NDOP LWA-1 FOR SYMBOL TABLE CMA,INA ADA SYMI TEST FOR SYMBOL TBL ADA TEMP+2 OVERFLOW SSA JMP *+3 NO LDA .EN+2 'SO' SYMBOL TABLE OVERFLOW JMP INSX 'SO' ERROR LDA NAME+3 MOVE VALUE STA 1,I UP LDA NAMI LDB 0,I ADD ENTRY (FROM *+6) STB SYMI,I TO SYMBOL CPA TEMP+1 JMP INS5 GO SET NEW END OF SYMBOL TABLE. INA ISZ SYMI JMP *-6 INS5 LDB SYMI STB ?NDSY SET NEW END OF SYMBOL TABLE. JMP INSEX EXIT. INSC LDA .4000 IOR TEMP+4,I STA TEMP+4,I SET ENTRY POINT TYPE INSEX ISZ INSR BUMP EXIT POINT FOR A+2 EXIT JMP INSR,I EXIT HERE .M4 DEC -4 * * ************************************ * * INSERT LITERAL INTO SYMBOL TABLE * * ************************************ LITIN NOP LDA ?ICSA GET LOC'N OF ASCI BUFFER STA SYMP+1 LDA .7 (7) STA LTFLG LDB PLEN JSB INSR INSERT SYMBOL JMP LITIN,I ERROR RETN. ISZ PLEN BUMP LITERAL LOC'N CNTR ISZ LITIN JMP LITIN,I EXIT(NORMAL) * SKP * *********************** * * PROCESS OCT AND DEC * * *********************** HA40 CLB,INB B=1 CPA DEX CHECK CODE FOR 'DEX' ADB .2 B=3 IF CODE IS 'DEX' CPA DEY IF CODE = DEY THEN LDB .4 SET WORD COUNT = 4 STB TEMP+5 SET LOCN COUNT BUMPER CLA STA CNTB STA TEMP LDA SCN1+2 STA PNTR SET POINTER * * * PICK UP AND EXAMINE A CHARACTER * * HA41 JSB PKUP LDB TEMP+5 GET COUNT BUMPER CPA L+4 COMMA? JMP HA44 YES, GO SCAN FOR NEXT PARAM. ADB .M2 IF (TYPE=DEX) OR (TYPE=DEY) THEN SSB,RSS JMP HA42 GO CONTINUE SCAN LDB TEMP+5 CPA L+6 PERIOD? JMP HA48 YES, GO TEST FLT. POINT. CPA .E 'E' ? JMP HA48 YES, GO SEE IF DECIMAL PT., ALSO HA42 CPA BLNK END OF STATEMENT? JMP HA49 YES JMP HA41 * * * RESET FLT PT FLAG, SKIP BLANKS FOR NEXT CHAR * HA44 CLA STA TEMP JSB BPKUP LDB TEMP+5 GET 'BUMP' COUNT JMP HA48+4 * * * FLT PT TEST FOR NUMBER USING BOTH . AND E * HA48 LDA TEMP ISZ TEMP SZA E OR '.' COUNTED YET? CLB YES, SET B=0. * ADB CNTB (HA48+4) STB CNTB ADD TO WORD COUNT JMP HA41 * * * END OF NUMERIC PSEUDO-OP PROCESSOR * HA49 LDA TEMP+5 ADA CNTB SET A=NO OF LOCNS TO BE USED LDB CODE GET OPCODE I.D. NO. CLE PREPARE FOR REMAINDER TEST. CPB BYT BYTE? ERA YES, DIVIDE BY 2 SEZ ODD BYTE REMAINING? INA YES, ADD 1 TO WORD COUNT. JMP HA3Z EXIT * * ******************************** * * PROCESS ASC (GET VALUE OF N) * * ******************************** HA54 LDA .2 (2) 'ASC' INDIC.FOR CHOP JSB ?CHOP JMP HA3B * ERROR * SZA JMP HA55 ERROR-NOT ABS.VAL. SZB,RSS ZERO WORDS? JMP HA55 YES - * ERROR * ADB .M29 -29 LDA SUMP SSB SKIP IF >28 WORDS JMP HA3Z HA55 ISZ PLCN * ERROR EXIT * LDA .MBLN 'M' ERROR(BAD OPERAND) JSB ERPR TO PRINT ERROR DIAG. JMP HA32 * * ******************************************************** * * * * * SYMCK: CHECK FOR A VALID SYMBOL 5 * * * ENTER: = DON'T CARE. * * * = 'PNTR' (RELATIVE POS'N 1RST CHAR.) * * * RETURN: P+1 - INVALID SYMBOL ('SY' ERROR PRINTED) * * * P+2 - VALID SYMBOL. * * * * * * * * ******************************************************** SYMCK NOP STB PNTSV SAVE 'PNTR' FOR LATER RESTORATION. JSB MSYMS GO TO MEASURE THE SYMBOL. STA SYMSZ SAVE CHARACTER COUNT. CMA,INA NEGATE THE COUNT, STA SMCNT AND SAVE FOR 'SYMTS' LOOP COUNT. LDA TEST GET CONTINUATOR CHARACTER AND STA SYTST SAVE FOR LATER RESTORATION. LDA PNTSV GET POINTER TO FIRST CHARACTER. JSB GETC GO TO GET THE CHARACTER. LDB SMCNT GET NEGATIVE SYMBOL SIZE. JSB SYMTS GO TO CHECK FOR LEGAL SYMBOL. RSS ** ERROR: SET RETURN TO P+1. ISZ SYMCK VALID: SET RETURN TO P+2. LDA PNTSV RESTORE FORMER CONTENTS STA PNTR OF CHARACTER POINTER. LDA SYMSZ GET SYMBOL MEASUREMENT. JSB SPNTR GO TO ALIGN 'PNTR' FOR NEXT USE. LDA SYTST RESTORE THE STA TEST ORIGINAL CONTINUATOR. JMP SYMCK,I RETURN: P+1=ERROR; P+2=O.K. * PNTSV NOP TEMP. STORAGE: 'PNTR'. SYMSZ NOP TEMP. STORAGE: SYMBOL SIZE. SMCNT NOP TEMP. STORAGE: -SYMSZ. SYTST NOP TEMP. STORAGE: 'TEST'. * * ********************** * * PROCESS EQU PSEUDO * * ********************** HA56 JSB LBCK CHECK FOR REQUIRED LABEL. JSB CHOPI EVALUATE OPERAND JMP HA32 * ERROR * STB TEMP+1 CPA .4 (4) EXT ? RSS JMP HA57 LDA .5 (5) SET FOR NON-PNCH EXT LDB FLEX IS THIS AN EMA? SSB,NLHRSS JMP HA57 NO CLB,INB YES,THEN SET EMA FLAG STB EMFLG HA57 STA TEMP NO CLB,INB JSB MSYMS GO TO MEAS.SYMBOL, SET SYMP/SYMN LDA TEMP LDB TEMP+1 * * * SEND LABEL TO TABLE * JSB INSR TO SYMBOL TABLE INSERTION RTN NOP CLA CLEAR EMA FLAG STA EMFLG JMP HA32 * ******************************* * * ORB ORG ORR PROCESSOR JUMPS * * ******************************* HA64 JSB INST,I GO TO SUBROUTINE JMP HA32 HA70 LDB LTFLG GET LITERAL FLAG SZB IS A LITERAL IN THE OPERAND? JSB ?ARTL GO PROCESS THE LITERAL LDA .2 A=2 JMP HA3Z * ********************************** * * PROCESS REPLACEMENT CODE (ENT) * * ********************************** HA71 JSB LBCK CHECK FOR REQUIRED LABEL. JSB CHOPI EVALUATE OPERAND. JMP HA32 *ERROR* GET NEXT STATEMENT. N STB TEMP+1 SAVE OPERAND. CLB,INB POINT TO 1RST CHAR. OF LABEL. JSB MSYMS MEASURE SYMBOL,SET SYMP/SYMN LDA .14 (16B)CODE-REPLACEMENT ENT RECORD. LDB TEMP+1 GET REPLACEMENT CODE VALUE. JSB INSR INSERT SYMBOL & VALUE IN TABLE. NOP (ERRORS ARE ALREADY NOTED) JMP HA32 GO GET NEXT STATEMENT. * * * LABEL PRESENCE DETECTOR * * LBCK NOP LDA SCN1+3 GET LABEL LENGTH. SZA LABEL PRESENT ? JMP LBCK,I YES, RETURN. * LDA .LB NO. GET ASCII ERROR CODE. JMP HA55+2 GO TO NOTE THE ERROR. .LB ASC 1,LB * SKP * ************************ * * PASS 1 END PROCESSOR * * ************************ NOP HB00 LDA ?TFLG GET TABLE OUTPUT FLAG SZA,RSS JMP HB08 TABLE NOT REQUESTED - FINISH PASS CCA SET ?TFLG TO -1 TO INDICATE IN STA ?TFLG THE PROCESS OF PRINTING THE SYMBL TBL LDA FFUB ADA .4 STA HB00-1 SET HB00-1 = L(BUFF+4) LDA X GET FWA OF AVAILABLE MEMORY STA ENTV TO ENTV HBX LDA ENTV,I TEST 1ST WORD OF ENTRY SZA COMPLETED? JMP HBW NO CLA YES, CLEAR ?TFLG STA ?TFLG JMP HB08 GO TO FINISH PASS 1 HBW JSB MBLNK SET UP BLANKS IN SYMBOL OUT AREA * * * GET RELOCATION INDIC. CHAR. LDA ENTV,I ALF,ALF AND .7 (7) CPA .7 LITERAL ENTRY? JMP HBY YES. CLB CPA .6 (6) REPLACEMENT CODE ENTRY ? LDB SBLN YES, GET ASCII S-BLNK. SZB,RSS SKIP IF INDICATOR PRESENT. JSB ?DCOD CPB RC+4 RSS JMP HBZ LDA ENTV,I SSA LDB RC HBZ STB BUFF+3 * * * GET VALUE OF SYMBOL * LDB SUMP (NO.OF WORDS IN ENTRY) ADB .M1 ADB ENTV `STB ENTV LDA 1,I ISZ ENTV CLE SET E = 0 FOR OCTAL CONV. JSB ?BNCN * * * STORE ASCI VALUE INTO BUFF LDB HB00-1 GET L(BUFF+4) JSB ?V LDB FFUB SET PRINT PARAMETERS LDA .14 (14) JSB ?PRNT GO TO PRINT JMP HBX ENTRY DONE. HBY LDA SUMP NO.WDS IN ENTRY ADA ENTV + ADDR OF ENTRY STA ENTV = ADDR OF NEXT ENTRY JMP HBX SBLN ASC 1,S .PASS ASC 2,PASS * SKP * * * ERRORS PRINTED * * HB08 JSB ?ENDS CLOSE OUT THE PASS SPC 1 * *********************** * * * START PASS 2 HERE * * * *********************** SPC 1 * TEST FOR PUNCH OUTPUT JMP NMP GO - PUT OUT START OF BIN DK HB11 JSB RWN.C REWIND SOURCE FILE DEF C.SOR SOURCE FILE FCB JMP HBERR LDA .2 PICK UP ENT CODE TO GET ASMB2 JMP ?SEGM GO TO GET NEXT SEGMENT * HBERR CCB INDICATE ERROR IN INPUT FILE JMP ?FMPE DISPLAY ERROR AND ABORT ASSEMBLER * SKP * * MOVE ENT NAMES/ADDRESS TO PUNCH BUFFER. * * IF UNDEFINED, PRINT DIAGNOSTIC. HNP NOP LDA .10B FOR "ENT" TYPE = 10B STA ENFLG LDB .2000 FOR WORDS PER ENTRY = 4 LDA .M15 FOR 15 ENTRIES/RECORD JSB ENEXT CLA STA ENFLG JMP HNP,I * * * PUNCH BINARY OUTPUT FOR RELOCATABLE PROGRAMS * * * (NAM,ENT, AND EXT RECORDS ONLY) * * * OUTPUT 'NAM' RECORD * OCT 1400,4400 NMP JSB GNMP GO SET UP SOME PARAMETERS JSB PNCH GO TO PUNCH 'NAM' RECORD * * * OUTPUT 'ENT' RECORD * JSB HNP GO TO 'ENT' MOVE/TEST RTN. * * PROCESS 'EXT' RECORD HERE LDA CNTR CPA .1 JMP HB11 EXIT ON CNTR=1 LDA .M20 -20 -dLDB NMP-2 1400B FOR EXT WCNT = 3/ENTRY JSB ENEXT * PROCESS 'EMA' RECORD HERE LDA EMCNT WAS AN EMA INSTR ENCOUNTERED? SZA,RSS JMP HB11 NO, THEN EXIT LDA .M2 -2 FOR ONE ENTRY CLB,INB SET EMA FLAG STB EMFLG LDB .2000 FOR WORDS PER ENTRY=4 JSB ENEXT OUTPUT EMA RECORD JMP HB11 EXIT BLUP OCT 20000 BLANK UPPER .M20 DEC -20 SPC 1 ENEXT NOP STA ENT. SAVE SYMBOL COUNT STB ORBS+1 SAVE WORD COUNT PER ENTRY LDA X FWA OF AVAILABLE MEMORY STA ENTV ENTV=ORG ADDR OF ENTRY * * * INITIALIZE FOR NEXT BINARY OUTPUT IMAGE * * HX1 LDA CSAD STA ORBS ORBS=DEST ADDR IN BIN REC. LDA BIT15 100000B LDB ENFLG SZB ENT PROC? RAR YES, SET RIC = 2 LDB EMFLG OUTPUTING AN EMA RECORD? SZB,RSS JMP HX8 NO LDA B140K RELOC INDICATOR=6 ADA EMASZ EMA SIZE IN BITS 0-9 OF WORD 1 HX8 STA PBUF+1 NO, EXT. SET RIC = 4. LDA NMP-2 1400B (FOR STARTING WORD COUNT) STA WCNT SET BLK CNT = 3 LDA ENT. STA ENTC ENTC = RECRD COUNTER HX2 LDA ENTV,I SZA,RSS END OF TABLE? JMP HX9 YES ALF,ALF NO-PICK UP SYMBOL TYPE CLB STB ORBS+2 CLR FLG FOR B.P.; SET IN ENT REC LDB ENFLG RAR,RAR SZB,RSS ARE WE PROCESSING ENT'S? JMP HX3 NO... RAR,SLA,RAL CHECK FOR ENT-'E' BIT SET? JMP HX12 ENT; GO PROCESS. HXN RAR,RAR NO AND .7 (7) ADD ENTRY ADA ENTV -LENGTH STA ENTV -TO ENTV JMP HX2 GO TO NEXT SYMBOL TABLE ENTRY * * * PROCESS END OF TABLE * * HX9 LDA ENTC CPA ENT. ANY SYMBOLS LEFT? RSS NO JSB PNCH GO TO PUNCH CLA STA WCNT CLEAR WORDK COUNT IF NO SYMBOL OUT JMP ENEXT,I EXIT HERE HX3 SLA,RSS IS THIS AN EXT ENTRY? JMP HXN NO.. RAL,SLA,RAL TYPE 6 (RPL) OR 7 (LITERAL) ? JMP HX7 YES, BYPASS THE SYMBOL. SLA TYPE 5 (EXT EQU) ? JMP HX7 YES, BYPASS THE SYMBOL LDB EMFLG PROCESSING EMA RECORD? SZB JMP HX10 YES LDB ENTV,I GET FIRST WORD OF SYMBOL TABLE ENTRY SSB 'U' BIT SET? JMP HX7 YES, SET JMP HX5 NO HX10 LDB ENTV,I EMA PROCESS SSB 'U' BIT SET? JMP HX5 YES, THEN AN EMA LABEL, PROCESS IT HX7 RAR,RAR PREPARE TO GET WORD COUNT. JMP HXN GO ADVANCE TO NEXT TABLE ENTRY. HX5 ISZ ENTC END OF BIN RECORD? JMP *+3 NO JSB PNCH GO TO PUNCH JMP HX1 * * * PLACE CURRENT EXT OR ENT SYMBOL INTO BINARY RECORD * * LDA ENTV CMA,INA STA HMOV5 ORG.ADDR.TO MOVE LINK LDB ORBS LDA BLNS STA ORBS,I SET DEST.AREA TO BLANKS ISZ ORBS STA ORBS,I LDA BLUP GET UPPER BLANK. LOWER HALF OF ISZ ORBS -DEST WORD = 0 ADA ORBS+2 STA ORBS,I LDA ENTV,I JSB MTABL MOVE CHARS TO BIN REC LDA EMFLG EMA PROCESS? SZA,RSS ISZ PBUF+1 BUMP NO. OF ENTRIES IN REC. LDA SUMP NO.WORDS IN SYMBOLIC ENTRY ADA ENTV STA ENTV UPDATE ENTV(SYMBOL PNTR) ADA .M1 LDB 0,I ENTRY VALUE TO B LDA ENFLG SZA,RSS ENTRY POINT? ADB ORBS,I NO, SET EXT ORDINAL SZA ISZ ORBS STB ORBS,I STORE INTO RECORD ISZ ORBS UPDATE ORBS (RECRD PNTR) LDA EMFLG EMA PROCESS? SZA,RSS JMP HX6 NO LDA MSGSZ SET WORD 7=MSEG SIZE STA ORBS,I STORE IN OUTPUT BUFFER ISZ ORBS INCREMENT BUFFER COUNT HX6 LDA WCNT ADA ORBS+1 s  STA WCNT UPDATE WORD COUNT JMP HX2 HX12 RAL,RAL RIGHT JUSTIFY AND AND .7 ISOLATE SYMBOL TYPE. CPA .6 TYPE 6 ? (CODE REPLACEMENT) ADA .M1 YES,FORCE TO 5 (YIELDS TYPE 4) SZA,RSS CONVERT FROM INTERNAL REP- LDA .4 RESENTATION OF TYPE TO ADA .M1 PROPER TYPE CODE IN OBJECT. STA ORBS+2 SET IN TYPE FIELD. LDA ENTV,I GET THE FIRST WORD AGAIN SSA,RSS HAS THE ENTRY PT. BEEN DEFINED? JMP HX5 YES, GO PUT INTO THE PUNCH BUFFER * * * ENT ERROR DIAGNOSTIC ROUTINE * JSB MBLNK MOVE A SYMBOL TO BUFF THRU BUFF+2 LDA .EN 'EN' STA IOBF+5 SAVE 'EN' IN PRINT BUFFER LDB BLNS GET BLANKS FOR BUFFER STB IOBF+9 LDB ENUN SET UP ' UNDEF' STB IOBF+6 LDB ENUN+1 STB IOBF+7 LDB ENUN+2 STB IOBF+8 JSB ?PRPG GO PRINT PREVIOUS 'ERROR-PAGE' LDA .15 15 WORD OUTPUT LDB SNOB GET BUFFER ORIGIN JSB ?PRNT GO PRINT THE 'EN' ERROR ISZ ?ENER BUMP 'EN' ERROR COUNTER. LDA ENTV,I GET WORD #1 OF CURRENT ENTRY. ALF POSITION WORD COUNT TO BITS 0-2 JMP HXN+1 GO TO GET NEXT ENTRY. ENUN ASC 3, UNDEF .4000 OCT 4000 .2000 OCT 2000 B140K OCT 140000 FLX1 BSS 1 (ASCN) .401B OCT 401 ORBS BSS 3 * *********************************** * * PICK UP A SYMBOL TO BE PRINTED * * * 'A' HAS DESTINATION ADDRESS * * *********************************** MBLNK NOP LDB ENTV GET TBL ENTRY LOCATION CMB,INB * * SEND ADDR. TO MOVE LINKAGE STB HMOV5 * * MOVE BLANKS TO BUFFER LDB BLNS STB BUFF STB BUFF+1 STB BUFF+2 LDB FFUB ADDR. OF BUFF TO B JSB MTABL MOVE SYMBL TO PRINT BUFF JMP MBLNK,I EXIT HERE SPC 1 * * MOVE CHARS FROM SYMBOL TABLE * * -A CONTAINS 1ST WORD OF SYMBOL ENTRY * -B CONTAINS DESTINATION ADDR. * -HMOV5 CONTAINS ORIGIN ADDR. MTABL NOP ALF AND .7 (7) FOR NO.OF WRDS. STA SUMP CPA .2 (2) CLA IOR .1 JSB MOVE HMOV5 NOP JMP MTABL,I * *************************************************** * * GNMP - SET UP BASE PAGE AND PROGRAM LENGTHS. * * * SET UP 'PLEN' FOR LITERALS(IF PRESENT). * * *************************************************** GNMP NOP JSB ?ORRP RESET PROG LOC'N COUNTERS LDA PLCN LDB ?BPSV STA PBUF+6 SET MAIN PROG. LENGTH STB PBUF+7 SET BASE PAGE LENGTH. * * * TEST FOR 'ORG' EXTENT BEYOND MAIN PROGRAM * LDB ORGSV GET ORG SECTION LWA CMA,INA ADA ORGSV SSA,RSS IS ORG VALUE GRTR? STB PBUF+6 YES, CHANGE MAIN PROG. LENGTH * * * TEST FOR LITERALS * LDA PBUF+6 LDB PLEN SZB LITERALS PRESENT? STA PLEN YES, SET START OF AREA ADA 1 ADD LENGTH OF REGION STA PBUF+6 TO PROG LENGTH. JMP GNMP,I EXIT FROM THE GNMP ROUTINE * * ***************************************** * * PROCESS EXTENDED INSTRUCTION SET AND * * * USER MICROCODES * * ***************************************** XMIC STA SCODE SAVE CODE - 100B LDB LTFLG GET LITERAL FLAG SZB,RSS IS IT ON? JMP XMIC2 NO - OK CPA .10B TYPE 110B? JMP XMIC1 YES - OK CPA .12 TYPE 114B? JMP XMIC1 YES - OK CPA .13 TYPE 115B? JMP XMIC1 YES - OK JSB OPERR ILLEGAL FOR ALL OTHERS JMP XMIC2 XMIC1 JSB ?PLIT PROCESS LITERAL NOP IGNORE ERROR * XMIC2 LDB SCODE PICK UP CODE-100B LDA .2 A = 2 CPB .12 VTYPE 114B? INA YES, A = 3 CPB .13 TYPE 115B? INA YES, A = 3 ADB .M8 (-8) SSB,RSS TYPE 101B TO 107B(USER CODES)? JMP HA3Z NO - USE VALUE NOW IN A ADB .7 ADA B A NOW CONTAINS MACRO INST. COUNT JMP HA3Z * * **************************************************** * * PROCESS A 'MIC' PSEUDO OPERATION(USER MICROCODE) * * * FORMAT: MIC MMM,CCCC,N * * * WHERE * * * MMM = USER DESIGNATED MNEMONIC * * * CCCC = USER DESIGNATED FUNCTION CODE * * * N = NUMBER OF PARAMETERS IN USER OPERAND * * **************************************************** MIC LDA SCN1+2 STA PNTR MOVE POINTER TO OPERAND JSB ?OPLK CHECK FOR DUPLICATE OPCODE MNEM. JMP MIC01 NOT DUPLICATE MICOP JSB OPERR 'M' TERM(OPERAND) ERROR STA CODE SET CODE NOT EQUAL 100B JMP HA32 * MIC01 LDA TEMP+5 SAVE USER MNEMONIC STA SCODE SAVE 1ST 2 CHARACTERS LDA TEMP+6 STA MTEMP SAVE LAST CHARACTER * * * TEST MNEMONIC FOR ALPHA ONLY * * * BY CHECKING NEXT 3 CHARACTERS * LDA .M3 (-3) STA TEMP MIC04 JSB PKUP CMA,INA ADA .100B SSA,RSS VALUE LESS THAN A? JMP MICOP YES - ERROR, NOT ALPHA ADA .32B SSA VALUE GRTR THAN Z? JMP MICOP YES - ERROR, NOT ALPHA ISZ TEMP DONE WITH MNEMONIC? JMP MIC04 NO - GO GET NEXT CHARACTER LDA .17 STA CODE CODE='ABS' FOR CHOP PROCESSING LDA .2 SET A FOR COMMA STOP JSB VMIC GO PICK UP MICRO CODE/TEST PART STA INST * CLA SET A FOR NO COMMA STOP JSB VMIC SSB VALUE PLUS? JMP MICOP NO, WE HAVE AN ERROR a ADB .M8 VALUE IN A AND B SSB,RSS B LESS THAN 8? JMP MICOP NO - ERROR ADA .100B YES - SET UP CODE CPA .100B CODE = 100B? LDA .30B YES - NO PARAMS SO TYPE 30B STA CODE * ******************************************************** * * NOW ENTER NEW OPCODE INTO SUPPLEMENTARY OPCODE TABLE * * ******************************************************** LDA ?NDOP ADA .M3 SET NEW SUPPL. OPCODE ORIGIN STA B CMB,INB ADB ?NDSY SSB OPTABLE OVERFLOW? JMP MIC10 NO LDA .EN+2 YES 'SO' OPTABLE OVERFLOW JSB ERPR JMP HA32 MIC10 STA ?NDOP LDB SCODE STB A,I STORE 1ST 2 CHARS. INA LDB MTEMP PICK UP 3RD CHAR. ADB CODE INSERT CODE (101-107) STB A,I STORE INA LDB INST STORE MICROCODE STB A,I INTO TABLE JMP HA32 COMPLETE OPCODE ENTRY IN TABLE. * * ******************************************************* * * VMIC CHECKS FOR COMMAS, NUMERICS AND TYPE OF OUTPUT * * * FROM OPERAND PROCESSOR(MICROCODE AND PARAMETER #. * * ******************************************************* VMIC NOP STA CTM SAVE CHOP INPUT PARAMETER JSB PKUP CPA L+4 COMMA? RSS YES JMP MICOP NO - ERROR JSB BPKUP SKIP OVER ANY BLANKS STB SCN1+2 SET OPERAND AT NEW PARAMETER LDA CTM JSB CHOP GO EVALUATE PARAMETER JMP HA32 ERROR RETURN SZA IS VALUE ABSOLUTE? JMP MICOP NO - ERROR LDA SUMP A AND B = VALUE JMP VMIC,I EXIT CTM NOP SAVE A FOR CHOP INITIATION .30B OCT 30 A EQU 0 B EQU 1 SCODE NOP SAVE CODE TYPE/SAVE 1ST 2 OPCODE CHARS. MTEMP NOP SAVE 3RD OPCODE CHARACTER SPC 1 **********************d640********************************************** ********** CHANGE LOC'N. X IN ASMB IF THIS PROGS. LWA > 2310B ****** ******************************************************************** SPC 1 ?CMQ EQU CMQ ?ENP EQU ENP ?EXP EQU EXP ?EMP EQU EMP ?HA3Z EQU HA3Z ?INSR EQU INSR LABEL EQU ?LABE ?LITI EQU LITIN SPC 1 END ASMB1 Q6 / 92067-18072 1805 S C0222 &4AS21 RTE-IV ASSEMBLER SEG 2             H0102 ASMB,R,L,C * * NAME: ASMB2 * SOURCE: 92067-18072 * RELOC: 92067-16072 * PGMR: C.C.H.,S.P.K. * * MODIFIED BY EARL STUTES 1976-09-20-1600 * MOD 77-01-30 ADDED DEY INST EAS * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** HED * RTE ASMB2 92067-16072 * (C) HEWLETT-PACKARD COMPANY 1978. * NAM ASMB2,5,99 92067-16072 REV.1805 770919 ENT ASMB2 ENT ?ART,?BREC,?LKLI EXT ?DCOD,?GETC,?LINC,?LIST,?LOUT,?OPLK EXT ?SUP,?BPKU,?PKUP,?PNCH,?SYMK EXT ?LFLG,?LTFL,?LTSA,?LTSB,?RSTA,?ERPR,?CHOP EXT ?CHPI,?OPER,?PLIT,?ASCN,?MSYM,?ASM1,?ICSA EXT ?LINS,?ARTL,?LST,?LPER,?PERL,?SETM EXT ?BASF,?SYML EXT ?X,?MOVE,?PLIN EXT ?ASCI,?ASII,?ENDS,?ASMB SPC 2 EXT ?RELC,?SIGN,?SUMP,?TERM,?T,?BYFL,?CNTB EXT ?CODE,?DSIG,?FLAG,?FLAQ,?INST,?LAST,?PASS EXT ?PLCN,?PLEN,?PNTR,?RCNT,?SAVB,?SCN1,?SVST EXT ?SYMP,?TEST,?IOBF,?PBUF,?TEMP,?FLEX SUP TEMP EQU ?TEMP .1 DEC 1 .2 DEC 2 .3 DEC 3 .4 DEC 4 .5 DEC 5 .6 DEC 6 .7 DEC 7 .12 DEC 12 .13 DEC 13 .14 DEC 14 .15 DEC 15 .16 DEC 16 .17 DEC 17 .M1 DEC -1 .M2 DEC -2 .M3 DEC -3 .M4 DEC -4 .M5 DEC -5 .M6 DEC -6 .M7 DEC -7 L OCT 50,51,52,53,54,55,56 .9 DEC 9 .M8 DEC -8 .M29 DEC -29 BLNK OCT 40 =40B(LOWER BLANK) .IL ASC 1,IL ILLEGAL OPERAND MSG CONSTANT 1976-09-20-1500 .NO ASC 1,NO .OP ASC 1,OP .OV ASC 1,OV .UN ASC 1,UN BLNS ASC 1, TW10 OCT 176000 ADDRESS MASK B1000 OCT 1000 BIT15 OCT 100000 .E OCT 105 RC ASC 5,E R B C X RELC EQU ?RELC 9f RELOCATION FLAG SIGN EQU ?SIGN SUMP EQU ?SUMP RUNNING SUM FOR 'CHOP' TERM EQU ?TERM NO. OF TERMS IN AN OPERAND T EQU ?T BYFLG EQU ?BYFL BYTE FLAG FOR 'BREC' CNTB EQU ?CNTB CODE EQU ?CODE OPCODE TYPE(FROM OPTABLE) DSIG EQU ?DSIG 'ASCN' FLAG EQU ?FLAG FLAQ EQU ?FLAQ INST EQU ?INST OPCODE FORMAT LAST EQU ?LAST PASS EQU ?PASS PASS FLAG(0=PASS 1 AND 1=PASS2) PLCN EQU ?PLCN PROGRAM LOCATION COUNTER PLEN EQU ?PLEN LIT LENGTH PASS 1/LIT ORG PASS 2 PNTR EQU ?PNTR POINTS AT LAST OR CURRENT CHAR. RCNT EQU ?RCNT SAVB EQU ?SAVB SCN1 EQU ?SCN1 STATE LNG/OPCODE/OPERAND/LABEL(4) SVST EQU ?SVST SYMP EQU ?SYMP SYMBOL LNG/ AND LOC'N TEST EQU ?TEST TEST CHARACTER FLEX EQU ?FLEX * * I/O STATEMENT BUFFER * IOBF EQU ?IOBF 50 WORDS + END OF STATEMENT BUFF PBUF EQU ?PBUF WCNT EQU PBUF WORD(BLK) CNT FOR BIN.RECRD. ASM1 EQU ?ASM1 ASMBX EQU ?ASMB CHOP EQU ?CHOP CHOPI EQU ?CHPI ERPR EQU ?ERPR GETC EQU ?GETC LINC EQU ?LINC LIST EQU ?LIST LOUT EQU ?LOUT LST EQU ?LST LTFLG EQU ?LTFL MSYML EQU ?SYML OPERR EQU ?OPER RSTA EQU ?RSTA SYMK EQU ?SYMK A EQU 0 B EQU 1 * SKP * ******************* * * CONTINUE PASS 2 * * ******************* ASMB2 LDA .VAL0 REMOVE INDIRECTS RSS LDA A,I RAL,CLE,SLA,ERA JMP *-2 STA .VAL0 DIRECT ADDRESS LDA ?LPER LENGTH OF 'CLEAR'AREA LDB ?PERL GET ORIGIN OF 'CLEAR' AREA JSB ?SETM GO TO SET MEMORY ROUTINE OCT 0 TO SET MEMORY TO ZERO CLA STA PLCN INITIALIZE PROG LOC'N COUNTER CLB DST PBUF DST PBUF+2 CLA,INA STA PASS SET PASS FLAG JSB RSTA READ CONTROL STATEMENT LDA TW10 STA ASM1 SET FLAG FOR 'INIT' PORTION ASH JSB RSTA READ A SOURCE STATEMENT(NAM?) LDA CODE CPA .15 HErD? JMP ASH YES, GO PICK UP THE NEXT STATEME STA ASM1 CLEAR 'CS' AND 'INIT' FLAG CPA .13 (13) NAM ? JMP HC02 YES, GO TO LIST IT. LDA .NO 'NO'= NO ORG OR NAM STATEMENT JSB ERPR JMP HC05 ERROR EXIT FROM INIT * SKP * ****************************** * * SKIP AND SPACE LIST OUTPUT * * ****************************** SKPR LDB LINC 'SKIP'ENTRY CMB,INB JMP SK2 SPCR JSB CHOPI EVALUATE SPACE COUNT CLB,INB ERROR - SET COUNT=1 SK2 SZB,RSS SPACES=0? JMP HC04 YES, EXIT TO HC04(START OF PASS) LDA ?LFLG NO, START LINE SKIPPING SZA,RSS LIST REQUESTED? JMP HC04 EXIT TO HC04(START OF PASS) LDA LST LST FLAG SZA SUPPRESS LISTING? JMP HC04 YES, EXIT TO HC04(START OF PASS) STB DSIG SET COUNTER LDA LINC CPA .M1 ON LAST LINE? JMP HC04 YES - EXIT ADB LINC SSB,RSS WILL IT GO TO BOTTOM OF PAGE? JMP *+5 YES,GO TO SKIP TO BOTTOM. STB LINC NO, SAVE NEW LINE COUNT LDA DSIG GET NO. OF LINES TO BE SKIPPED JSB ?LINS GO TO LINE SKIPPER JMP HC04 EXIT TO GET NEXT STATEMENT CCA SKIP TO BOTTOM OF PAGE. STA LINC JMP HC04 EXIT TO GET NEXT STATEMENT * ************************* * * BINARY OUTPUT ROUTINE * * ************************* .M54 DEC -54 OCT 60100 RIC=5, CURRENT PAGE BREC NOP STA EXTFL SAVE FOR EXTERNAL CHECKS. CPA .10B TWO WORD EXTERNAL ? LDA .5 YES, SET RELOC. INDICATOR TO 5 STA SAVB+1 SAVE RELOC'N BYTE LDA WCNT SZB RECORD OUT ? JMP HI66 NO. SZA,RSS WCNT=0? JMP BREC,I YES. * * * OUTPUT A RECORD * HI60 LDA WCNT ALF,ALF ROTATE 8 STA WCNT STORE WCNT IN UPPER PBUF LDA SVST,I POSITION REMAIN RELOCATION BYTES ALF,RAR ISZ RCNT JMP *-2 RAL STA SVST,I STORE RELOC.BYTES * * * SET REC.ID CODE (WORD 2) * LDB BREC-1 GET RIC/PAGE INDICATOR CLA,INA CPA ?BASF IF BASE PAGE RELOCATABLE, LDB MICRD+2 SET RIC = 060000 . ADB PBUF+1 SET REMAINDER STB PBUF+1 JSB ?PNCH GO TO 'PUNCH' JMP BREC,I AND EXIT * * * PROCESS A BINARY OUTPUT WORD * * DEF PBUF+4 HI66 LDA WCNT SZA FIRST WORD OF RECORD? JMP HI70 -NO- LDB PLCN PLCN TO BREG STB PBUF+3 SET DBL ADDR. STA PBUF+1 SET PBUF+1=0 LDB .4 (4) STB WCNT SET WCNT = 4 LDB HI66-1 STB STOR SET STOR=L(PBUF+4) LDB .M5 (-5) STB RCNT SET RCNT=-5 LDB .M54 -54 STB CNTB SET CNTB FOR WORD COUNT HI70 LDB RCNT CPB .M5 RCNT= -5? JMP HI74 -YES-SET UP ADDRESSES * * * STORE RELOC.BYTE / UPDATE * * HI71 ISZ PBUF+1 UPDATE # OF DATA WRDS LDA SVST,I GET RELOC. BYTE WORD ALF,RAR POSITION FOR NEXT WORD IOR SAVB+1 GET THE NEW BYTE STA SVST,I STORE BACK IN BYTE WORD ISZ RCNT BYTE WORD FULL? JMP HI76 -NO- LDB .M5 -YES- =-5 STB RCNT RESET RCNT TO -5 RAL STA SVST,I LDA CNTB CPA .M1 RSS ISZ CNTB HI76 LDB INST ISZ WCNT ADVANCE WORD COUNT LDA EXTFL GET TWO-WORD EXT. FLAG. CPA .10B TWO-WORD EXTERNAL ? JMP EXT2 YES, GO TO PROCESS. STB STOR,I NO, STORE INSTRUCTION. ISZ STOR CCE PREPARE FOR BYTE ADDRESS WORD, IF ANY. CPA .5 (5) 2 WORD INSERT? JMP HI77 YES, GO TO PROCESS. CPA .6 .(6) BYTE ADDRESS ? JMP BYTAD YES, GO PROCESS. JMP HI78 TO EXIT TEST * * * PROCESS 2-WORD EXTERNAL (R = 5) OR BYTE ADDRESS (R = 6) * * EXT2 LDA SIGN GET OFFSET FLAG (EXT ORDN'L) CLE,SZA IS THIS AN EXT W/OFFSET? [E_0] CCE,RSS YES, SET =1 AND SKIP. LDA SUMP NO: I/O EXT. USE ORDN'L IN SUMP. ALS,ALS POSITION ORDINAL TO BITS 9-2. SEZ MEM. REF. EXTERNAL WITH OFFSET ? IOR INST YES, INCLUDE INSTRUCTION CODE. IOR .3 ADD ABSOLUTE 'MR' INDICATOR (3). STA STOR,I STORE FIRST WORD OF PAIR. ISZ STOR ADVANCE PUNCH-BUFFER POINTER. BYTAD LDA SUMP GET OFFSET VALUE, OR BYTE ADDRESS IF ANY. SEZ,RSS MEM. REF. EXT. W/OFFSET OR BYTE ? LDA INST NO,I/O. USE INSTRUCTION. STA STOR,I STORE SECOND WORD OF PAIR. JMP HI77A GO TO COMPLETE THE PROCESS. * HI77 LDA SUMP GET RELOCATABLE VALUE. STA STOR,I AND BRMSK CLEAR UPPER 6 BITS OF 'SUMP' BRS,BRS CLEAR LOWER 2 BITS OF INST BLS,BLS IOR 1 'OR' B TO A STA INST HI77A ISZ WCNT ADVANCE WORD COUNT. ISZ STOR ADVANCE PUNCH-BUFFER POINTER. ISZ CNTB BUMP CNTB RSS JMP HI60 HI78 ISZ CNTB IS THIS THE LAST WORD? JMP BREC,I NO- EXIT JMP HI60 YES- GO TO PUNCH HI74 LDB STOR STB SVST CLA STA SVST,I CLEAR RELOC BYTE WORD ISZ STOR ISZ WCNT JMP HI71 STOR BSS 1 BRMSK OCT 1777 .10B OCT 10 .8 EQU .10B EXTFL NOP TWO-WORD EXTERNAL FLAG. SKP HC02 LDA .2 LIST PARAMETER HC03 JSB LIST * * * READ NEXT STATEMENT * HC04 JSB RSTA READ NEXT STATEMENT * * * TEST MNEMONIC CODES FOR PROCESS TYPE * HC05 LDA CODE LDB INST SZA,RSS (0) ORB ? JMP HC42 YES. CPA .100B CODE = 'MIC' ? JMP X3R9 YES, GO LIST IT. ADA M100B SUBTRACT 100 OCTAL SSA,RSS CODE >100B ? JMP XMIC YES, ITS A MICROCODE MACRO. LDA CODE GET OPCODE I.D. NO. AGAIN. CPA L+3 (43) SOC OR SOS ? JMP HC28 YES AND .M8 (177770) CPA L I/O ? JMP IOPR YES ARS,ARS SHIFT A RIGHT 4 BITS ARS,ARS CPA .3 60/70(MICRO-OP?) JMP MICR YES LDA CODE GET JUMP TABLE ADDRESS ADA CODLC ADD OPCODE INCREMENT JMP A,I JUMP TO PROCESSOR .100B OCT 100 M100B OCT -100 * * * PROCESS MEMORY REFERENCE INSTRUCTIONS * MEMRY LDA INST LDB LTFLG SZB LITERAL PRESENT? JMP HCY YES AND .M2 NO, CLEAR LDSB OF 'INST' STA INST LDA .I SET FOR INDIRECT BIT LDB BIT15 INDIRECT BIT MASK(100000B) JSB CHOP JMP HC17E ERROR EXIT HCX STB SUM. OPERND VALUE CLB LIST PARAMETER=0 HCXL STB TERM SAVE THE LIST PARAMETER LDB SUM. GET THE OPERAND VALUE * * * RELOC.CODE IS IN RELC * SZA ABS? JMP HC11 NO ADB TW10 YES, SUBTRACT 2000B. SSB,RSS IS THE OPERAND LESS THAN 2000B? JSB OPERR NO, IT'S AN "M" TERM ERROR HC11 LDA SUM. LDB CODE CPB .16 (16) DEF? JMP HC14A YES, GO CHECK FOR EXT W/OFFSET. LDA RELC CPA .2 (2) B.P. RELOCATABLE ? JMP *+3 YES. SZA ABSOLUTE? JMP HC15 NO SPC 1 * * TEST FOR OPERAND >1023 * SPC 1 LDA SUM. ADA TW10 (176000) SSA,RSS JMP OI.SP LDA INST CLEAR AND CBIT CURRENT-PAGE BIT [MASK=175777] STA INST JMP HC14 SPC 1 * * TEST FOR OPERAND & INSTR IN SAME PAGE * SPC 1 OI.SP LDA RELC CPA .2  (2) B.P. RELOCATABLE ? JMP HC13 YES, ERROR. LDA PLCN AND TW10 CMA,INA ADA SUM. AND TW10 SZA,RSS JMP *+3 HC13 LDA .OV 'OV' ERROR. JSB ERPR LDA BRMSK STRIP UPPER SIX BITS. AND SUM. STA SUM. HC14 LDA RELC CPA .2 (2) B.P. RELOCATABLE ? JMP HC15+2 HC14A LDA SIGN GET OFFSET FLAG (EXT ORDINAL). SZA IS OPERAND EXT W/OFFSET ? JMP HC17A YES, IGNORE ORDN'L FOR NOW. LDA SUM. NO, GET OPERAND VALUE. LDB CODE GET OPCODE ID NUMBER. CPB .16 ARE WE PROCESSING A 'DEF'(16B) ? JMP HC17 YES, SET UP ADDRESS FOR 'BREC'. HC14B LDA SUM. NO, GET OPERAND VALUE; AND BRMSK MASK TO FORM ADDRESS, AND JMP HC17 INSERT INTO INST. HC15 CPA .4 EXTERNAL ? (4) JMP HC14A YES, GO CHECK FOR OFFSET. LDB .5 (5) STB BYFLG ADA .M1 FORM 'MR' INDICATOR FOR OPERAND HC17 IOR INST STA INST SET LOADER FLAG LDA SIGN GET OFFSET FLAG. HC17A LDB .10B GET TWO-WORD EXT INDICATOR. SZA EXTERNAL W/OFFSET IN PROCESS ? STB BYFLG YES, SET FLAG FOR BREC. * * * SET UP FOR DCOD* LDA RELC HC19 JSB ?DCOD * * * OUTPUT A BINARY WORD * HC22 STB SAVB CLB,INB JSB BREC * * * OUTPUT A LINE FOR LISTING * LDA INST GET INSTRUCTION PATTERN. LDB SIGN GET OFFSET FLAG. SZB PROCESSING MEM. REF. W/OFFSET? IOR B YES, INCLUDE EXT ORDN'L NO. LDB ?LFLG TEST FOR ADDRESS ONLY MODE CPB .Q JMP *+2 JMP ARUND LDB CODE CPB .14 LDA SUM. ARUND STA INST SAVE INSTRUCTION FOR LISTING. LDB SAVB GET RELOC. CHARACTER. LDA TERM GET THE LIST PARAMETER JSB LIST GO TO LIST THE LINE. LDA SIGN GET OFFSET FLAG. SZA,RSS PROCESSING MEM. REF. EXT W/OFFSET ? JMP HC20 NO, GO TO ADVANCE LOC'N COUNTER. LDA SUM. YES, GET OFFSET VALUE. STA INST SAVE IN INST FOR LISTING. LDB PLUS SET = ASCII: +BLANK. LDA .6 6=LIST CODE FOR INSTRUCTION ONLY. JSB LIST GO TO LIST OFFSET VALUE. HC20 ISZ PLCN ADVANCE LOCATION COUNTER. JMP HC04 GO TO READ NEXT STATEMENT. PLUS ASC 1,+ OFFSET LIST INDICATOR. * ***************** * * BSS PROCESSOR * * ***************** BSSP JSB CHOPI EVAL. OPERAND JMP HC02 ERROR SZB,RSS B=0? JMP HC02 YES CLB B=0 JSB BREC CLA A=0 LDB BLNS NO RELOC. INDIC. JSB LIST LDA SUMP PICK UP BLOCK LENGTH FOR PLCN ADA PLCN STA PLCN JMP HC04 EXIT * SKP * ************************ * * PROCESSOR JUMP TABLE * * ************************ * CODLC DEF *,I DEF HC42 ORG 1 DEF HC42 ORR 2 DEF X39 *COM 3 DEF X39 *ENT 4 DEF X39 *EXT,EMA 5 DEF INST,I *ARITH 6 DEF ASCP ASC 7 DEF DCNUM DEC 10 DEF OCNUM OCT 11 DEF BSSP BSS 12 DEF EQUP EQU 13 DEF FIN2 END 14 DEF X39 *NAM 15 DEF MEMRY MEMORY 16 DEF X50 HED 17 DEF MEMRY DEF 20 DEF HC26 ABS 21 DEF SKPR SKP 22 DEF SPCR SPC 23 DEF X54 LST/UNL 24 DEF DXNUM DEX 25 DEF HC70 HDW ARITH 26 DEF HC80 HDW SHIFT 27 DEF HC30 CLO ETC 30 .I OCT 111 ASCII 'I' 31 DEF RPLP RPL 32 CBIT OCT 175777 33 M17 DEC -17 34 DEF 'X52 REP 35 .JSB OCT 16000 36 .C OCT 103 ASCII 'C' 37 DEF X56 SUP/UNS 40 DEF BYTE DBL 41 DEF BYTE DBR 42 DEF BYTEG BYT 43 DEF DYNUM DEY 44 SUM. BSS 1 DEX OCT 25 'DEX' OPCODE TYPE DEY OCT 44 'DEY' OPCODE TYPE .Q OCT 121 AN ASCII Q DUMMY SKP * ****************************** * * ARITHMETIC MACRO PROCESSOR * * ****************************** ART JSB SYMK GO TO SYMBOL TABLE LOOKUP RSS ERROR RETN(UNDEF) JMP *+4 NORMAL RET'N LDA .UN 'UN'= UNDEFINED SYMBOL JSB ERPR CLB SET B = 0 ADB .JSB 'JSB' INSTRUCTION MASK STB INST LDA .4 (4) A=EXT JSB BREC PUNCH LDB RC+4 ' X' CLA * ********************************************** * * PROCESS THE 'DEF' FOLLOWING THE FIRST WORD * * * OF AN ARITHMETIC PAIR * * ********************************************** ARTX JSB LIST GO TO LIST FIRST WORD LDA .16 (20B) STA CODE =DEF CLA STA INST CLEAR INST LDA LTFLG SZA LITERAL PRESENT? JMP ALTR YES LDA .I SET UP FOR INDIRECT BIT LDB BIT15 MASK= 100000B JSB CHOP NOP ALTZ ISZ PLCN BUMP LOCATION COUNT STB SUM. SAVE OPERAND VALUE LDB .4 LIST PARAMETER=4 JMP HCXL ALTR LDA ?LTSA PICK UP LDB ?LTSB LITERAL PARAMS. JMP ALTZ FROM LKLIT * * * LITERAL PROCESSING * * HCY SLA,RSS LSB OF INST INDIC LITERAL POSSIBLE JMP HCZ NO, ERROR AND .M2 CLEAR LSB OF INST STA INST JSB ?PLIT JMP HCZ+1 ERROR EXIT JMP HCX HCZ JSB OPERR 'M' ERROR HC17E CLA LIST PARAMETER =0  STA TERM SAVE IT JMP HC17 * SKP * * * PROCESS 'ABS' OPCODE * * HC26 JSB CHOPI GO EVALUATE OPERAND JMP HP2D ERROR STB INST JMP HP2D OK.. * * * OUTPUT BIN RECRD AND/OR LIST LINE * * HC30 JSB LOUT JSB LIST * * * ADD 1 TO PROG. LOCN. CNTR. * ISZ PLCN BUMP LOCATION CNTR JMP HC04 * X39 CLA,INA 1 TO A JMP HC03 * * * ORG,ORB,ORR PRE-PROCESSOR * * HC42 CLB OUTPUT A JSB BREC RECORD JSB INST,I JUMP TO CORRECT SUBROUT. JMP HC02 BACK TO START LIST X50 LDA ?LFLG GET THE LIST FLAG SZA,RSS IS LIST FLAG OFF? JMP HC04 YES - GO TO NEXT STATEMENT JSB INST,I TO HEADER SUBROUTINE CCB LDA LST SZA,RSS IS LIST FLAG ON? STB LINC YES, SPACE TO BOTTOM OF PAGE JMP HC04 GET NEXT STATEMENT X52 JSB INST,I TO REPSB JMP X39 X54 STB LST SET LST/UNL FLAG JMP HC04 BYPASS LISTING FOR 'LST/UNL' X56 STB ?SUP SET 'SUP/UNS' FLAG JMP X39 SPC 1 * * PASS 2 'EQU' PROCESSOR * * EQUP JSB CHOPI EVAL. OPERAND CLB ERROR EXITS LDA PLCN STA SUMP SAVE PLCN VALUE STB PLCN SET PLCN=0 LDA .2 (2) LIST 'EQU' JSB LIST LDA SUMP REPLACE PLCN VALUE STA PLCN JMP HC04 HC70 LDA LTFLG GET LITERAL FLAG SZA ARE LITERALS PRESENT? JSB ?ARTL YES, GO TO LITERAL PROCESSOR JSB LOUT OUTPUT THE ARITH INSTRUCTION JMP ARTX GO PROCEESS THE 'DEF' PORTION.. HC80 JSB CHOPI GO EVALUATE THE COUNT JMP HC84 BAD COUNT EXIT ADB M17 B-17 SSB B GRTR THAN 16? CPB M17 NO. IS B=0? JSB OPERR YES, IT'S AN 'M' ERROR,. LDA SUMP GET THE SHIFT OR ROTATE COUNT.. ] AND .15 MASK OUT LOWEST 4 BITS HC82 ADA INST MAKE UP THE FINAL INSTRUCTION STA INST JMP HC30 GO AND OUTPUT THE INSTRUCTION HC84 CLA SET COUNT FOR 16 BIT SHIFT ROTATE JMP HC82 SPC 1 * ************************ * * PASS 2 RPL PROCESSOR * * ************************ RPLP LDA SCN1+3 CHECK FOR LABEL. SZA PRESENT ? JMP *+4 YES, GO EVALUATE THE OPERAND. LDA .LB NO, GET ERROR MNEMONIC 'LB'. JSB ERPR GO TO INDICATE THE ERROR. RSS CLEAR THE INSTR. FIELD FOR LIST. JSB CHOPI GO TO EVALUATE THE OPERAND. CLB * ERROR * SET OPERAND =0. STB INST SAVE OPERAND VALUE FOR LIST. LDA .7 (7) LIST WITHOUT LOCATION. LDB SBLN ASCII:S-BLANK (SUBSTITUTION) JMP HC03 GO TO LIST THE STATEMENT. .LB ASC 1,LB ASCII 'LB' NO-LABEL ERROR CODE. SBLN ASC 1,S REPLACEMENT CODE INDICATOR: 'S'. * SKP * ************************* * * OCT/DEC/ASC PROCESSOR * * ************************* SPC 1 OCNUM CLA JMP NUMPX DCNUM LDA .1 JMP NUMPX DXNUM LDA .3 JMP NUMPX DYNUM LDA .4 NUMPX STA WHAT NUMP LDA SCN1+2 STA PNTR SET POINTER LDA .M1 STA T+1 SET FPAS=-1 HE06 LDB PNTR PNTS AT 1ST CH OF NUMBER STB SIGN CLB STB CNTC LDB WHAT STB RELC * * * TEST CHARACTER FOR TERMINATOR * HE08 LDA PNTR JSB GETC STA TERM CPA L+4 COMMA? JMP HE12 YES CPA BLNK BLANK? JMP HE12 YES * * * UPDATE CHAR.CNTR(CNTC) AND POSN. PNTR(TLOC) * LDB CODE CPB .8 IF CODE # DEC THEN GO COUNTEMUP JMP *+2 JMP CNTUP LDB .2 TEST FOR REAL OR INTEGER CPA L+6 DECIMAL POINT? JMP *+2 CPA .E tU 'E'? STB RELC YES, SET RELC = 2 CNTUP ISZ CNTC ISZ PNTR BUMP PNTR JMP HE08 * * * SET UP VALUE FOR LIST AND/OR PUNCH * HE12 LDB RELC BLF,BLF ADB CNTC LDA SIGN JSB ?ASCN GO TO 'ASCI' CONVERSION JMP ASCER THIS IS THE ERROR RETURN STA TEMP+1 SAVE THE FIRST WORD LDA .VAL0 STA WPNTR SET UP THE WORKING POINTER LDA RELC CMA,INA,SZA,RSS WORKING COUNTER FOR THE LOOP CCA OOPS IT WAS ZERO STA RELC NUMLP LDA WPNTR,I OUTPUT A WORD INTO THE DATA STREAM JSB NOUT ISZ WPNTR ISZ RELC IF U DUN DEN BUG OUT JMP NUMLP HE18 LDA TERM CPA BLNK JMP HC04 EXIT ON BLANK ISZ PNTR BUMP PNTR JSB ?BPKU SCAN OVER BLANKS LDA PNTR TEST FOR EOL 1976-09-20-1500 CMA,INA ADA SCN1 THE RECORD CHARACTER COUNT SSA,RSS JMP HE06 MORE DATA FOLLOWS LDA .IL SOMETHING IS NOT GOOD JSB ?ERPR TELL EM KEMO SABE CLA MAKE A NOP JSB NOUT DUMP IT JMP HC04 BUG OUT, U DONE ASCER CLA JSB NOUT JMP HE18 * .VAL0 DEF TEMP+1 WPNTR BSS 1 WHAT BSS 1 LOCAL OPCODE FLAG FOR NUMP * *************************** * * OCT DEC ASC WORD OUTPUT * * *************************** NOUT NOP STA INST CLA SET A=0 FOR 1ST LINE OUTPUT ISZ T+1 SKIP FOR 1ST LINE OF OUTPUT. LDA .4 (4) SET A=4 FOR LIST LDB BLNS JSB LIST CLA CLB,INB JSB BREC PUNCH ISZ PLCN BUMP LOCN CNTR. JMP NOUT,I EXIT * ******************** * * PROCESS ASC HERE * * ******************** ASCP LDA SCN1+2 INITIALIZE FOR ASC PROCESSING STA PNTR LDA .M1 STA T+1 LDA .2 (2) INDIC.'ASC' JSB CHOP GONLH EVALUATE WORD LENGTH JMP HC30 * ERROR EXIT SZA VALUE ABSOL.? JMP HP2D-1 NO; * ERROR * SZB,RSS ASKING FOR ZERO WORDS ? JMP HP2D-1 YES, * ERROR * ADB .M29 (-29)(VALUE IS IN SUMP TOO) SSB,RSS VAL.>28? JMP HP2D-1 YES; * ERROR * LDA PNTR STA T LDA SUMP CMA,INA STA CNTC VALUE(COMPL.) TO CNTC * * * PICK UP WORDS AND STORE INTO PROGRAM * SB ISZ T LDA T JSB GETC ALF,ALF STA TEST ISZ T LDA T JSB GETC * * * OUTPUT 2 ASCI CHARACTERS * JSB NOUT CLA STA TEST ISZ CNTC JMP SB JMP HC04 DONE, GO GET NEXT STATEMENT * ************************* * * PROCESS I/O GROUP HERE * * ************************** RAM OCT 105000 OCT 177400 I/O MASKS OCT 300 IOPR LDA SCN1+2 IS OPERAND SZA PRESENT? JMP P YES! LDA CODE NO OPERAND. CPA L+1 'HLT'? JMP HP2D * * * OPERAND ERROR EXIT HERE * VN JSB OPERR (HP2D-1) HP2D CLA STA TERM SAVE THE LIST PARAMETER JMP HC19 P LDA .C TEST FOR 'CLEAR FLAG'(C). LDB B1000 GET 'C' MASK FOR IO INSTR. JSB CHOP JMP Q ERROR EXIT SZA,RSS ABSOLUTE? JMP ABSL YES, GO PROCESS. CPA .4 EXTERNAL I/O OPERAND? ALS,SLA YES, SET TO 10 FOR BYFLAG. JMP R NO. ERROR! STA BYFLG SET BYFLG. LDA INST GET UNCONFIGURED INSTRUCTION. LDB SIGN GET THE OFFSET FLAG. SZB,RSS EXTERNAL I/O WITH OFFSET ? JMP IOEX NO, SINGLE EXTERNAL TERM. ADA SUMP YES. ADD OFFSET TO INSTRUCTION. STA INST SAVE THE MODIFIED INSTRUCTION. STB SUMP PUT EXT ORDN'L IN SUMP FOR BREC. IOEX CLB CLEAR LIST PARAMETER STB TERM TO LIST WHOLE LINE. STB SIGN SET EXT I/O FLAG FOR BREC. JMP HC19-1 OUTPUT BINARY; LIST LINE. ABSL LDA SUMP GET I/O OPERAND. LDB INST LOAD B WITH INSTRUCTION FORMAT ADA IOPR-2 MASK WITH 177300 CPB RAM IS IT A RAM INSTR RSS SKIP IF YES ADA IOPR-1 FINISH MASK IF NOT RAM LDB SUMP RESTORE B CONTENTS * * * TEST FOR VALUE>63 * SSA JMP *+4 VAL>64 LDA .OV 'OV' ADDRESS OVERFOLW JSB ERPR Q CLB ADB INST STB INST JMP HP2D R JSB OPERR 'M' ERROR - RELOC.I/O ADDR. JMP Q * * * PROCESS SOC OR SOS HC28 LDA SCN1+2 PNTR TO OPERAND SZA,RSS OPERAND PRESENT? JMP HP2D NO LDB 0 A TO B JSB ?MSYM ADA .M1 SZA JMP HP2D LDA LAST CPA .C IS 'C' PRESENT? JMP *+2 YES JMP HP2D NO * * * 'OR' 1 TO BIT 9 (C BIT) OF I/O INST * LDA INST IOR B1000 MASK IN CURRENT BIT STA INST JMP HP2DK * ********************** * * MICRO-OP PROCESSOR * * ********************** CNTC BSS 1 INSV EQU SUM. MICRD OCT 7777,4000,60000,60,71,14000 * * * INITIALIZE FLAGS * MICR CLA STA CNTC =0 WHEN CLE APPEARS STA TERM BITS 12-11 = 1 IF B REG * BITS 12-11 = 2 IF A REG STA TEMP+4 BITS 14-13=1 IF SRG; =2 IF ASG STA INSV USED TO ACCUMULATE THE CODE STA FLAG STA TEST CLEAR CHAR TESTER * * START HERE FOR EACH NEW CODE * * F LDA INST UNPACK THE MICRO-OP CODE * *THE FORMAT IS: BITS 14-13=1 IF SRG,2 IF ASG, 0 IF EITHER. * BITS 12-11=1 IF BREG,2 IF AREG, 0 IF NEITHER. * BITS 11-0 = ACTUAL 12 BIT CODE AND MICRD EXTRACT OPCODE STA FLAQ SAVE IT (=+2) LDA CODE THIS IS THE GROUP NUMBER. CMA,INA MAKE SURE'IT'S BIGGER THAN THE LAST ADA FLAG A=(LAST GRP)-(PRESENT GRP) SSA JMP O SEQUENCE IS OK * * * IF PRES GRP IS GO WE CAN CHANGE IT AND MAY BE OK LDA CODE CPA MICRD+3 IS CODE TYPE = 60B (MICRO-OP)? JMP *+4 CHANGE ERROR GROUP AND OP CODE MERR LDA .OP 'OP' FOR OPCODE ERROR JSB ERPR RETURN JMP HP2D LDA MICRD+4 71B, CHANGE GROUP (FROM *-4) STA CODE TO 71 * * * MOVE BITS 8-5 OF OPCODE TO BITS 4 AND 2-0 * LDA FLAQ AND MICRD+1 SET A/B BIT STA 1 SAVE IN B. XOR FLAQ ALF,ALF MOVE TO BITS O AND 15-13 RAR,SLA MOVE BIT 0 TO INA BIT 1. ALF,RAR ROTATE LEFT 3 TO BITS 4,2-0 IOR 1 PUT IN THE A/B BIT JMP F+2 O LDA CODE STA FLAG SET LAST GRP TO PRESENT GRP * * * CHECK REGISTER CONSISTENCY * LDA INST AND MICRD+5 GET BITS 12-11 IOR TERM CPA MICRD+5  IF EQUAL, THERE'S A REGISTER JMP MERR INCONSISTENCY. STA TERM NEW REGS TO REGS, * * * OTHERWISE CHECK GROUP CONSISTENCY * LDA INST AND MICRD+2 BITS 14-13 IOR TEMP+4 CPA MICRD+2 IF EQUAL,THERE ARE 2 CODES JMP MERR FROM DIFFERENT GROUPS. STA TEMP+4 * * CHECK FOR CLE * LDA FLAQ SZA,RSS ISZ CNTC * * * NOW 'OR' THE CODE INTO CURRENT CODE SO FAR * IOR INSV STA INSV * * * GET THE NEXT CHARACTER * LDA SCN1+1 OPCODE PNTR ADA .3 (3) STA PNTR POINTS AT POS'N FOLLOWING OPCODE JSB ?PKUP CPA BLNK IS THIS CHAR. A BLANK ? JMP *+7 IF SO, WE'RE DONE. CPA L+4 COMMA ? JMP *+2 JMP MERR INVALID CHAR.-'M' ERROR ! * * * GET THE NEXT OPCODE * JSB ?OPLK OPCODE LOOKUP JMP HP2D JMP F * * * TO FINISH TEST CLE; IF USED AND IN ASG SET, ADD 40 * * TO THE CODE. LDA TEMP+4 (FROM *-7) ALF,ALF SZA,RSS IOR BLNK (40B) LDB CNTC SZB,RSS CLA IOR INSV STA INST JMP HP2D * ******************************** * * SEARCH SYMBL TBL FOR LITERAL * * ******************************** LKLIT NOP LDA ?ICSA GET LOC'N OF ASCI BUFFER STA SYMP+1 STA LTFLG SET LTFLG#0 JSB SYMK SYMBOL TABLE LOOKUP ROUTINE CLB ERROR RETURN ADB PLEN ADDR OF LITERAL CLA,INA A=1 STB SUMP STA RELC JMP LKLIT,I LKLIT EXIT * * .13B OCT 13 SCODE NOP SAVE CODE-100B FOR XMIC PROCESS ROTFL OCT 125252 ODD/EVEN FLAG LMASK OCT 377 UMASK EQU RAM+1 177400B * * ************************************ * * GENERATE A STRING OF BYTES. * * * OCTAL NUMBERS ONLY  * * * -377 >= NUMBER <=+377 * * ************************************ * BYTEG LDA SCN1+2 START INITIALIZATION STA PNTR SET PNTR TO 1ST BYTE LDA .M1 STA T+1 SET FIRST LINE LIST OUTPUT FLAG LDA ROTFL STA SCODE SET RIGHT/LEFT ALTERNATOR * BYT01 LDB PNTR STB SIGN SAVE START OF BYTE CLB STB CNTC INITIALIZE CHARACTER COUNT * BYT03 LDA PNTR GET A CHARACTER JSB GETC STA TERM SAVE IT CPA L+4 COMMA? (END OF BYTE) JMP BYT05 YES GO PROCESS A BYTE CPA BLNK BLANK? (END OF BYTE AND STRING) JMP BYT05 YES GO PROCESS A BYTE * ISZ CNTC BUMP CHAR. COUNT ISZ PNTR BUMP CHAR. POINTER JMP BYT03 GO GET NEXT CHAR. * BYT05 LDB CNTC B=CHARACTER COUNY LDA SIGN A = POINTER TO BYTE JSB ?ASCN CONVERT BYTE TO OCTAL NUMBER CLA ERROR RETURN - SET A=0. STA B SAVE VALUE IN B AND UMASK SZA GRTR THAN 377B? CPA UMASK MAYBE - TEST FOR GOOD NEG. VALUE JMP *+3 NUMBER IS OK JSB OPERR ERROR CLB LDA B AND LMASK LDB SCODE RBR,SLB LEFT BYTE BEING PROCESSED? JMP BYT10 YES STB SCODE SAVE LEFT/RT FLAG IOR INST NO - SET UP TO GENERATE A WORD BYT06 JSB NOUT OUTPUT A WORD TO LIST/PUNCH LDA TERM GET LAST CHAR. TESTED CPA BLNK BLANK? (END OF STATEMENT) JMP HC04 YES - EXIT JMP BYT12 NO - GO START NEXT BYTE * SKP BYT10 ALF,ALF PROCESS LEFT BYTE STA INST PLACE IN UPPER 'INST' STB SCODE SAVE LEFT/RT FLAG LDB TERM CPB BLNK LAST TERM IN STRING? JMP BYT06 YES - GO OUTPUT IT BYT12 ISZ PNTR NO - START NEXT BYTE JSB ?BPKU JMP BYT01 * * ********************************`************************** * * PROCESS BASE SET EXTENSION AND MEMORY EXPANSION CODES * * ********************************************************** * XMIC STA SCODE SAVE CODE-100B CMA,INA STA OPNUM START ON PARAMETER COUNT ADA .7 (7) SSA,RSS CODE GRTR THAN 107B? JMP PROCX NO - OPNUM OK LDB .M1 B = -1 CPA .M6 (-6) CODE = 115B? (BITS INSTRUCTION) ADB .M1 B = -2 STB OPNUM PROCX JSB LOUT OUTPUT MICROCODE TO BINARY JSB LIST LIST MICRO SOURCE STATEMENT LDA PLCN SAVE LOCN CNTR AT INSTRUCTION STA STAR PSEUDO LOCN CNTR STA STARX ORIGINAL LOCATION ISZ STAR BUMP PSEUDO COUNTER ISZ PLCN BUMP PROGRAM LOCATION COUNTER PROC1 LDA .16 STA CODE SET CODE = 20B (DEF) LDA STARX RESET PLCN TO INSTRUC LOCN STA PLCN CLA STA INST CLEAR INSTRUCTION STA BYFLG AND BYFLG LDA SCODE A=ORIGINAL CODE(-100B) LDB LTFLG SZB LITERAL? JMP PROC7 YES CPA .13B NO - IS CODE = 113?(NO INDIRECT) JMP PROC2 YES LDB BIT15 NO LDA .I JSB CHOP EVALUATE OPERAND JMP PRERR+1 ERROR JMP *+3 PROC2 JSB CHOPI EVALUATE OPERAND WITH NO',I' JMP PRERR+1 ERROR SZA ABSOLUTE VALUE? JMP *+4 NO ADB TW10 YES (VAL-2000B) SSB,RSS GRTR THAN 1777B? JMP PRERR YES,ERROR CPA .4 (4) EXTERNAL SYMBOL? RSS YES JMP PROC4 NO LDB SCODE CPB .13B CODE = 113B? (JPY) JMP PRERR YES - ERROR * PROC4 LDA PNTR STA SCN1+2 RESET POINTER LDA SIGN SZA,RSS TEST FOR EXT WITH OFFSET JMP NOTSO LDB .10B SET UP BYFLG STB BYFLG JMP *+2 SKIP ONE BECAUSE OF EXT WITH OFFSET NOTSO LDA SUMP IOR INST 'OR' INST TO EXT ORDINAL AND SAVE STA INST SET VALUE INTO INSTRUCTION SSA WAS ADDR INDIRECT? ISZ SCN1+2 YESM , BUMP OPERAND LOCATION LDA RELC JSB ?DCOD STB SAVB SAVE ASCII RELOC. CHARS. LDB STAR SET PLCN TO ACTUAL LOCN STB PLCN CLB,INB SET B=1 JSB BREC GO PUNCH THE WORD LDB SAVB B = ASCII RELOC CHARS. LDA .4 A = 4 JSB LIST LDA SIGN TEST FOR EXT WITH OFFSET SZA,RSS JMP NOOFF DON'T GOT ANY LDA SUMP STA INST LDB PLUS LDA .6 JSB LIST LIST THE OFFSET NOOFF ISZ PLCN BUMP PROG.LOCATION COUNTER ISZ STAR BUMP PSEUDO CNTR CLA STA INST CLEAR INST FOR FINAL NOP(IF ANY) STA LTFLG CLEAR LITERAL FLAG. LDB SCODE CPB .12 CODE = 114B(NOP IN 3RD WORD?) JMP PROCA YES, EMIT A 'NOP' ISZ OPNUM NO - LAST PARAMETER? JMP PROC1 NO - GO PROCESS NEXT ONE JMP HC04 YES - DONE * PROC7 CPA .10B =110B CODE? JMP PROC8 YES CPA .12 =114B CODE? JMP PROC8 YES CPA .13 =113B CODE? JMP PROC8 YES PRERR JSB OPERR NO - ERROR CLA STA SUMP INA STA RELC LDB LTFLG SZB,RSS LITERAL? JMP PROC4 NO JMP *+3 YES PROC8 JSB ?PLIT JMP PRERR+1 ERROR JSB MSYML LDA SAVB STA PNTR JMP PROC4 * PROCA JSB LOUT LDA .4 (4) SET FOR RESTRICTED LISTING JMP HC30+1 * STAR NOP PSEUDO LOCN COUNTER STARX NOP LOCN OF INSTRUCTION * * ************************************** * * PROCESS DEFINITION OF BYTE ADDRESS * * * CODES ARE 'DBL' AND 'DBR' * * ************************************** * BYTE LDA .20B STA CODE SET CODE = 'DEF' JSB CHOPI GO EVALUATE OPERAND JMP BYERR+1 ERROR EXIT CLE,ELB ADDRESS * 2; E := 0 FOR ERROR CHECK SEZ OPERAND VALID? JMP BYERR NO GO TELL EM ADB INST STB SUMP SUMP = BYTE ADDRESS STA INST SZA ABSOLUTE? JMP BYEX NO ADB M200B YES SSB,RSS LESS THAN 200B? JMP BYERR NO, ERROR BYEX CPA .4 (4) EXT? JMP BYERR YES, ERROR BYOUT ADA .M1 (-1) AND .3 (3) SET 'MR' CHARACTERS FOR LOADER STA INST LDA .6 (6) STA BYFLG SET FLAG FOR BREC RPROCESSING LDA RELC JSB ?DCOD GO SET UP LIST CHARACTERS STB SAVB SAVE RELOCATION ASCII CHARS. CLB,INB SET FOR INSERTING A WORD JSB BREC GO TO BINARY OUTPUT ROUTINE LDB SAVB LDA SUMP STA INST SET UP ADDRESS FOR LISTING CLA JMP HC30+1 CONTINUE TO LAST PART BYERR JSB OPERR CLA STA RELC JMP BYOUT M200B OCT -200 OPNUM NOP .20B EQU .16 (20B) * SKP * ****************************** * * PASS 2 END PROCESSOR * * ****************************** ENDRC OCT 120000 FOR RIC = 5 * FIN2 CLB JSB BREC PUNCH REST OF LAST DBL RECORD. CLA STA ?BASF CLEAR B.P. FLAG FOR CURRENT PAGE STA PBUF STA PBUF+1 STA PBUF+2 STA PBUF+3 LDA PLEN IF PLEN=0 THERE ARE NO LITERALS SZA,RSS LITERALS PRESENT ? JMP HC56 NO-BYPASS LITERAL PROCESSING. STA PLCN YES, SET PLCN=FWA AFTER PROGRAM LDA ?X NL01 STA ENTV ADDR OF SYMBOL TABLE LDA ENTV,I 1ST WRD OF ENTRY SZA,RSS END OF TABLE? JMP NL99 YES ALF STA 1 AND .7 GET ENTRY LENGTH STA ENTC LDA 1 ALF AND .15 GET ENTRY TYPE CPA .7  LITERAL? JMP NL20 YES NL10 LDA ENTV UPDATE TO NEXT ENTRY ADDRESS ADA ENTC JMP NL01 GO TO PROCESS NEXT ENTRY * * * PROCESS A LITERAL FOR OUTPUT * NL20 LDA ENTV CMA,INA SET UP ADDR OF LITRL CONSTANT LDB ?ICSA GET LOC'N OF ASCI BUFFER STA *+3 LDA .4 4 TO A JSB ?MOVE LIT CONST TO ASCI/ASCI+1 NOP LDA ?ASII STA NLST SAVE 2ND WRD LDA ?ASCI PROCESS 1ST WORD STA INST JSB LOUT PUNCH LDA .4 JSB LIST LDA ENTC CPA .3 IS IT 2 WORD CONSTANT? JMP NL30 NO LDA NLST YES STA INST PROCESS 2ND WORD ISZ PLCN BUMP LOCN COUNTER JSB LOUT PUNCH LDA .4 JSB LIST NL30 ISZ PLCN BUMP LOCN CNTR JMP NL10 * * EXIT HERE * NL99 CLB JSB BREC * * * PUNCH 'END' RECORD * HC56 LDA .2000 FOR WCNT = 4 STA WCNT SET WORD COUNT LDA SCN1+2 POINTS TO OPERAND (IF ANY) STA PBUF+3 CLEARED IF NO EXECUTION ADDRESS SZA EXEC.ADDR.PRSNT? * * * PROCESS EXEC.ADDR. * JSB ?CHPI GO EVALUATE OPERAND JMP HC54 ERROR, OR NO EXECUTION ADDRESS CPA .2 (2) B.P. RELOCATABLE ? INA,RSS YES. SET R & T (3); SKIP. CPA .1 RELOCATABLE? JMP HC55 YES JSB ?OPER ERROR - NOT RELOCATABLE HC54 CLA CLB HC55 STB PBUF+3 STORE THE EXECUTION ADDRESS. ADA ENDRC SET RIC = 5 STA PBUF+1 JSB ?PNCH CLA,INA SET A=1 FOR LIST PARAMETER LDB BLNS BLANKS FOR RELOC,INDIC. JSB LIST JSB ?ENDS * PRINT ERROR COUNT * JMP ASMBX EXIT FROM ASSEMBLER NLST NOP TEMPORARY ENTC NOP TEMPORARY ENTV NOP ENTBL COUNTER .2000 OCT 2000 * SPC 1 **************************************:640****************************** ********** CHANGE LOC'N. X IN ASMB IF THIS PROGS. LWA > 2340B ****** ******************************************************************** SPC 1 ?ART EQU ART ?BREC EQU BREC ?LKLI EQU LKLIT SPC 1 END ASMB2 ^~6 1 92067-18073 1805 S C0122 &4ASB3 RTE-IV ASSEMBLER SEG 3             H0101 *ASMB,R,L,C * * NAME: ASMB3 * SOURCE: 92067-18073 * RELOC: 92067-16073 * PGMR: C.C.H.,S.P.K. * MOD 77-01-30 ADDED DEY OP CODE EAS * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * HED * RTE ASMB3 92067-16073 * (C) HEWLETT-PACKARD COMPANY 1978. NAM ASMB3,5,99 92067-16073 REV.1805 771102 ENT ASMB3,?INS? EXT RWN.C,C.SOR EXT ?BPKU,?RSTA,?PKUP,?SYMK,?CHOP,?ENDS EXT ?MSYS,?ASMB,?SEGM,EXEC,?ERPR,?X EXT ?MOVE,?LFLG,?TFLG,?CHPI EXT ?V,?ASM1,?MESX,?BNCN,?PRNT,?NDOP,?FMPE EXT ?NDSY,?OPER,?OPLK SPC 2 EXT ?TEMP,?NAMI,?NAME,?SUMP,?CNTB,?CODE,?INST EXT ?PLCN,?PNTR,?SCN1,?SYMI,?SYMP,?ENTV,?IOBF EXT ?BUFF,?PBUF SUP .1 DEC 1 .2 DEC 2 .3 DEC 3 .4 DEC 4 .5 DEC 5 .6 DEC 6 .7 DEC 7 .12 DEC 12 .13 DEC 13 .14 DEC 14 .15 DEC 15 .16 DEC 16 .M1 DEC -1 .M2 DEC -2 .M3 DEC -3 .M4 DEC -4 .M5 DEC -5 L OCT 50,51,52,53,54,55,56 .9 DEC 9 .29 DEC 29 .M8 DEC -8 .M29 DEC -29 BLNK OCT 40 =40B(LOWER BLANK) .IL ASC 1,IL .MBLN ASC 1,M .NO ASC 1,NO BLNS ASC 1, .E OCT 105 TEMP EQU ?TEMP NAMI EQU ?NAMI LOC'N FOR TEMP SYMBOL STORAGE NAME EQU ?NAME FOR USE BY 'OPLK' SUMP EQU ?SUMP RUNNING SUM FOR 'CHOP' CNTB EQU ?CNTB CODE EQU ?CODE OPCODE TYPE(FROM OPTABLE) INST EQU ?INST OPCODE FORMAT PLCN EQU ?PLCN PROGRAM LOCATION COUNTER PNTR EQU ?PNTR POINTS AT LAST OR CURRENT CHAR. SCN1 EQU ?SCN1 STATE LNG/OPCODE/OPERAND/LABEL(4) SYMI EQU ?SYMI ADDR CNTR FOR SYMBOL TBL (SYMK) SYMP EQU ?SYMP SYMBOL LNG/ AND LOC'N ENTV EQU ?ENTV * * I/O STATEMENT BUFFER * IOBF EQU ?IOBF 50 WORDS + END OF STATEMENT BUFF * * INPUT BUFFER 'BUFF' STARTS IN 11TH WORD * BUFF EQU ?BUFF PBUF EQU ?PBUF SAVES THE 'NAM' RECORD INFO BPKUP EQU ?BPKU CHOPI EQU ?CHPI ERPR EQU ?ERPR LFLAG EQU ?LFLG MOVE EQU ?MOVE MSYMS EQU ?MSYS PKUP EQU ?PKUP RSTA EQU ?RSTA X EQU ?X SPC 3 ASMB3 LDA FFUB REMOVE INDIRECTS RSS LDA A,I RAL,CLE,SLA,ERA BIT 15 SET? JMP *-2 YES, REMOVE ONE LEVEL OF INDIRECTS STA FFUB NO ASMBA JSB RSTA LDA CODE CPA .15 'HED' STATE? JMP IXH YES STA ?ASM1 CLEAR 'CS' AND 'INIT' FLAGS LDB .2000 STB PLCN INITIALIZE PROGRAM COUNTER CPA .1 IS OPCODE AN ORG? JMP HI12 LDA .NO 'NO'= NO ORG STATEMENT JSB ERPR JMP HA32+1 IXH JSB INST,I GO TO HEDSB JMP ASMBA HI12 JSB ?CHOP PROCESS AN ORIGIN VALUE JMP HA32+1 ERROR RETURN STB PLCN SET INITIAL COUNTER VALUE JMP HA32 GO TO START PASS 1 * SKP HA32 JSB RSTA GO TO GET NEXT STATEMENT. LDA CODE GET OPCODE IDENTIFIER. CPA .12 IS IT THE 'END' STATEMENT ? JMP HB00 YES, GO TO THE 'END PROCESSOR. CPA BLNK (40B) SUP/UNS? JMP HA32 IGNORE-PASS #1. CPA .32B REPLACEMENT CODE ? JMP HA63 YES * ERROR * CPA .100B USER MICROCODE ('MIC')? JMP MIC YES, GO PROCESS. ADA .M3 -3 SSA JMP HA64 ORR OR ORG FOUND CPA .12B NAM? JMP HA63 YES, ERROR ADA .M3 (-3) SSA 'COM','ENT' OR 'EXT' ? JMP HA63 YES - ERROR CPA .5 'EQU'? JMP HA56 TO EQU CPA .9 (11B) HED? JMP HA32 IGNORE-PASS #1. CPA .12 (14B) SKP? JMP HA32 IGNORE-PASS #1. CPA .13 IGNORE-PASS #1. JMP HA32 IGNORE-PASS #1. CPA .14 (16B) LST/UNL? JMP HA32 IGNORE-PASS #1. * * * TEST FOR LABEL FIELD LDA SCN1+3 GET LABEL LENGTH SZA,RSS LABEL PRESENT ? JMP HALB NO, DONE STA SYMP SET CHAR COUNT LDB FFUB STB SYMP+1 SET LABEL ADDR. CLA SET A=0 FOR ABSOLUTE VALUE LDB PLCN JSB INSR INSERT LABEL INTO SYMBOL TABLE NOP ERROR EXIT HALB LDA CODE OPCODE INDICATOR CPA DEX JMP HA40 IT'S A 'DEX' CPA DEY IF CODE = DEY THEN JMP HA40 GO TO CONSTANT PROCESSING CPA BYT IS IT A 'BYT'? JMP HA40 YES, GO PROCESS. CPA .29 REP? JMP HA64 YES CPA .7 (7) JMP HA54 TO ASC CPA .26B INTEGER ARITH(HARDWARE)? JMP HA70 YES.... CPA .6 (6) ARITH MACRO? JMP HA63 YES, ERROR ADA .M10 -10 SSA OCT OR DEC? JMP HA40 YES. SZA,RSS BSS? JMP HA3M TO BSS PROC. LDA CODE GET OPCODE I.D. NUMBER. ADA M100B SUBTRACT 100 OCTAL SSA,RSS CODE <100B ? JMP XMIC NO, IT'S A MICROCODE MACRO. HA3B CLA,INA TO ADD 1 TO PLCN * * * INCREMENT PROGRAM LOCN. CNTR. * HA3Z ADA PLCN (HA3B+1) STA PLCN JMP HA32 .26B OCT 26 FOR HARDWARE ARITHMETIC .32B OCT 32 RPL CODE. SPC 1 * * PROCESS BSS * HA3M JSB CHOPI EVAL.OPERAND JMP HA32 ERROR LDA 1 B TO A JMP HA3Z * .12B OCT 12 .M10 DEC -10 .100B OCT 100 M100B OCT -100 DEX OCT 25 OP TYPE FOR 'DEX' DEY OCT 44 OP TYPE FOR 'DEY' BYT OCT 43 OPCODE I.D. NO. FOR 'BYT' * SKP * ************************************************* * * INSR: ADD?6 ENTRY TO THE SYMBOL TABLE, W HACCOU * * * LINKAGE: B = VALUE ON INPUT * * * (OUTPUT) SYMP=NO.OF CHARS., SYMN=ENTRY FWA * * * L JSB INSR,I * * * L+1 ERROR RETN ('SO' OR 'DD'PRNTD)* * * L+2 NORMAL RETN * * ************************************************* .DD ASC 2,DDSO INSR NOP STB NAME+3 SAVE VALUE JSB ?SYMK SYMBOL TABLE LOOKUP JMP INS1 LDA .DD NO, 'DD' ERROR (MULTIPLE SYMBOL) INSX JSB ERPR JMP INSR,I GET OUT HERE INS1 LDB NAMI ADB TEMP+2 STB TEMP+1 SET LIMIT LDA ?NDOP GET LWA AVAIL. MEM. CMA,INA ADA SYMI TEST FOR SYMBOL TBL ADA TEMP+2 OVERFLOW SSA JMP *+3 NO LDA .DD+1 'SO' SYMBOL TABLE OVERFLOW JMP INSX GO TO PRINT ERROR MESSAGE. LDA NAME+3 MOVE VALUE STA 1,I UP LDA NAMI LDB 0,I ADD ENTRY (FROM *+6) STB SYMI,I TO SYMBOL CPA TEMP+1 JMP INSEX EXIT INA ISZ SYMI JMP *-6 INSEX LDB SYMI STB ?NDSY SET NEW END OF SYMBOL TABLE. ISZ INSR BUMP EXIT POINT FOR A+2 EXIT JMP INSR,I EXIT HERE HA63 LDA .IL ILLEGAL OPCODE: ABS. ASSEMBLIES ! JMP HA55+2 TO ERPR * SKP * *********************** * * PROCESS OCT AND DEC * * *********************** HA40 CLB,INB B=1 CPA DEX CHECK CODE FOR 'DEX' ADB .2 B=3 IF CODE IS 'DEX' CPA DEY IF CODE = DEY THEN LDB .4 B := 4 & FOUR WORD CONSTANTS STB TEMP+5 SET LOCN COUNT BUMPER CLA STA CNTB STA TEMP LDA SCN1+2 STA PNTR SET POINTER * * * PICK UP AND EXAMINE A CHARACTER * HA41 JSB PKUP (HA40+4 WAS HA41) LDB TEMP+5 GET COUNT BUMPER CPA,A L+4 COMMA? JMP HA44 YES, GO SCAN FOR NEXT PARAM. ADB .M2 IF (TYPE=3) OR (TYPE=4) THEN SSB,RSS GO CONTINUE PROCESSING JMP HA42 YES LDB TEMP+5 CPA L+6 PERIOD? JMP HA48 YES CPA .E 'E' ? JMP HA48 HA42 CPA BLNK END OF STATEMENT? JMP HA49 YES JMP HA41 * * * RESET FLT PT FLAG, SKIP BLANKS FOR NEXT CHAR * HA44 CLA STA TEMP JSB BPKUP LDB TEMP+5 GET 'BUMP' COUNT JMP HA48+4 * * * FLT PT TEST FOR NUMBER USING BOTH . AND E * HA48 LDA TEMP ISZ TEMP SZA E OR '.' COUNTED YET? CLB YES, SET B=0. * ADB CNTB (HA48+4) STB CNTB ADD TO WORD COUNT JMP HA41 * * * END OF NUMERIC PSEUDO-OP PROCESSOR * HA49 LDA TEMP+5 ADA CNTB SET A=NO OF LOCNS TO BE USED LDB CODE GET OPCODE I.D. NUMBER. CLE PREPARE FOR REMAINDER TEST. CPB BYT BYTE? ERA YES, DIVIDE BY 2 SEZ ODD BYTE REMAINING ? INA YES, ADD 1 TO WORD COUNT. JMP HA3Z EXIT SKP * ******************************** * * PROCESS ASC (GET VALUE OF N) * * ******************************** HA54 LDA .2 (2) 'ASC' INDIC.FOR CHOP JSB ?CHOP JMP HA3B * ERROR * SZA JMP HA55 * ERROR-NOT ABS.VAL. SZB,RSS ZERO WORD COUNT ? JMP HA55 YES, * ERROR * ADB .M29 -29 LDA SUMP SSB SKIP IF >28 WORDS JMP HA3Z HA55 ISZ PLCN * ERROR EXIT * LDA .MBLN 'M' ERROR(BAD OPERAND) JSB ERPR TO PRINT ERROR DIAG. JMP HA32 * ********************** * * PROCESS EQU PSEUDO * * ********************** HA56 JSB CHOPI EVALUATE OPERAND JMP HA32 *ERROR*  CPA .4 (4) EXT ? LDA .5 (5) SET FOR NON-PNCH EXT STA TEMP NO STB TEMP+1 CLB,INB JSB MSYMS GO TO MEAS.SYMBOL, SET SYMP/SYMN LDA TEMP LDB TEMP+1 * * * SEND LABEL TO TABLE * JSB INSR TO SYMBOL TABLE INSERTION RTN NOP JMP HA32 * ****************************** * * ORG ORR REP PROC.JUMPS * * ****************************** HA64 JSB INST,I GO TO SUBROUTINE JMP HA32 HA70 LDA .2 A=2 JMP HA3Z * SKP * ************************ * * PASS 1 END PROCESSOR * * ************************ NOP HB00 LDA ?TFLG GET TABLE OUTPUT FLAG SZA,RSS JMP HB08 TABLE NOT REQUESTED - FINISH PASS LDA FFUB ADA .4 STA HB00-1 SET HB00-1 = L(BUFF+4) LDA X GET FWA OF AVAILABLE MEMORY STA ENTV TO ENTV HBX LDA ENTV,I TEST 1ST WORD OF ENTRY SZA,RSS COMPLETED? JMP HB08 YES - GO TO FINISH PASS 1 LDB ENTV GET TBL ENTRY LOCATION CMB,INB * * SEND ADDR. TO MOVE LINKAGE STB HMOV5 * * MOVE BLANKS TO BUFFER LDB BLNS STB BUFF STB BUFF+1 STB BUFF+2 STB BUFF+3 LDB FFUB ADDR. OF BUFF TO B SPC 1 * * MOVE CHARS FROM SYMBOL TABLE * ALF AND .7 (7) FOR NO.OF WRDS. STA SUMP CPA .2 (2) CLA IOR .1 JSB MOVE HMOV5 NOP * * * GET VALUE OF SYMBOL * LDB SUMP (NO.OF WORDS IN ENTRY) ADB .M1 ADB ENTV STB ENTV LDA 1,I ISZ ENTV CLE SET E = 0 FOR OCTAL CONV. JSB ?BNCN * * STORE ASCI VALUE INTO BUFF LDB HB00-1 GET L(BUFF+4) JSB ?V LDB FFUB SET PRINT PARAMETERS LDA .14 (14) JSB ?PRNT GO TO PRINT 8 JMP HBX ENTRY DONE. * .PASS ASC 2,PASS * SKP * * ERRORS PRINTED * HB08 JSB ?ENDS GO TO END PASS PROCESSOR * ******************************** * * START 'ABSOLUTE' PASS 2 HERE* * ******************************** SPC 1 HB11 JSB RWN.C REWIND SOURCE FILE DEF C.SOR INPUT FILE FCB JMP HBERR LDA .4 PICK UP ENT CODE TO GET ASMB5 JMP ?SEGM GO TO LOADER FOR NEXT SEGMENT * HBERR CCB INPUT FILE ERROR JMP ?FMPE FMP ERROR * .2000 OCT 2000 FFUB DEF BUFF * SKP * ******************************************************** * * PROCESS EXTENDED INSTRUCTION SET AND USER MICROCODES * * ******************************************************** * XMIC STA B CODE-100B NOW IN B LDA .2 SET A=2 CPB .12 TYPE 114B? INA YES, A=3 CPB .13 TYPE 115B? INA YES, A=3 ADB .M8 SSB,RSS USER CODE? (101B THRU 107B) JMP HA3Z NO, USE VALUE IN A FOR PLCN BUMP ADB .7 ADA B A = MACRO INSTRUCTION COUNT. JMP HA3Z * ********************************************************** * * PROCESS A 'MIC' PSEUDO OPERATION (I.E. USER MICROCODE) * * * FORMAT: MIC MMM,CCC,N * * * WHERE * * * MMM = USER DESIGNATED MNEMONIC (ALL ALPHABETIC) * * * CCC = USER DESIGNATED FUNCTION CODE (0 TO 177777B) * * * N = NUMBER OF PARAMETERS IN USER OPERAND * * ********************************************************** * MIC LDA SCN1+2 STA PNTR MOVE POINTER TO OPERAND JSB ?OPLK CHECK FOR DUPLICATE MNEMONIC JMP MIC01 GOOD - MNEMONIC NOT FOUND MICOP JSB ?OPER ERROR IN OPERAND ('M' TERM) STA CODE -SET CODtzE NOT = 100B JMP HA32 GO GET NEXT INSTRUCTION * MIC01 LDA TEMP+5 * * SAVE USER MNEMONIC HERE * * STA SCODE SAVE 1ST 2 CHARS. LDA TEMP+6 STA MTEMP SAVE LAST CHARACTER * * * TEST 3 CHARACTERS FOR ALPHA ONLY MNEMONIC * LDA .M3 STA TEMP MIC04 JSB PKUP PICK UP A CHARACTER CMA,INA ADA .100B SSA,RSS LESS THAN LETTER A? JMP MICOP YES - NON-ALPHA ADA .32B SSA GREATER THAN LETTER Z? JMP MICOP YES - NON-ALPHA ISZ TEMP LAST CHARACTER TESTED? JMP MIC04 NO - GO GET NEXT ONE LDA .21B STA CODE SET CODE 'ABS' TO FOOL CHOP RTN. LDA .2 SET FOR COMMA STOP IN CHOP JSB VMIC PICK UP MICRO CODE AND TEST PART STA INST SAVE USER FUNCTION CODE * CLA SET FOR NO COMMA STOP IN CHOP JSB VMIC GET VALUE OF N SSB IS VALUE OF N POSITIVE JMP MICOP NO - ERROR ADB .M8 SSB,RSS IS N GREATER THAN 7? JMP MICOP YES - ERROR ADA .100B CPA .100B WILL CODE BE 100B? LDA .30B YES - NO PARAMS. THUS IT'S =30B STA CODE SAVE CODE FOR OPTABLE ENTRY * * **************************************************** * * ENTER NEW OPCODE INTO SUPPLEMENTARY OPCODE TABLE * * **************************************************** * LDA ?NDOP GET ORG OF SUPPL. OPCODE TABLE ADA .M3 SET NEW ORIGIN STA B CMB,INB START TEST FOR OVERFLOW ADB ?NDSY SSB OPTABLE OVERFLOW? JMP MIC10 NO LDA .SO YES - PRINT 'SO' ERROR JSB ERPR JMP HA32 GO FOR NEXT STATEMENT * MIC10 STA ?NDOP SET NEW OPTABLE ORIGIN LDB SCODE STB A,I STORE 1ST 2 CHARS. INA LDB MTEMP GET 3RD CHAR. ADB CODE INSERT CODE STB A,I STORE IT640 INTO THE TABLE INA LDB INST STB A,I STORE THE MICROCODE (FUNCTION) JMP HA32 GO FOR NEXT STATEMENT * SKP * ********************************************************** * * VMIC CHECKS FOR COMMAS, NUMERICS, AND TYPE OF OUTPUT * * * FROM OPERAND PROCESSOR (MICROCODE AND # OF PARAMETERS * * ********************************************************** * VMIC NOP STA CTM SAVE CHOP INPUT PARAMETER JSB PKUP PICK UP A CHAR. CPA L+4 IS IT A COMMA? RSS YES JMP MICOP NO - ERROR JSB BPKUP SKIP OVER FOLLOWING BLANKS STB SCN1+2 SET OPERAND PNTR TO NEXT PARAM. LDA CTM JSB ?CHOP EVALUATE THE PARAMETER JMP HA32 ERROR - GO TO NEXT SOURCE STATE. SZA ABSOLUTE VALUE? JMP MICOP ERROR - NO LDA SUMP VALUE IN BOTH A AND B ON EXIT JMP VMIC,I RETURN * CTM NOP SAVE A FOR CHOP ENTRY .21B OCT 21 (21B) .30B OCT 30 SCODE NOP SAVE 1ST 2 NMEMONIC CHARS. MTEMP NOP SAVE 3RD CHAR. A EQU 0 B EQU 1 .SO ASC 1,SO * SPC 1 ******************************************************************** ********** CHANGE LOC'N. Z IN ASMB IF THIS PROGS. LWA > 1550B ****** ******************************************************************** SPC 1 ?INS? EQU INSR SPC 1 END ASMB3 6  $ 92067-18074 1805 S C0222 &4AS41 RTE-IV ASSEMBLER SEG 4             H0102 ASMB,R,L,C * * NAME: ASMB4 * SOURCE: 92067-18074 * RELOC: 92067-16074 * PGMR: C.C.H.,S.P.K. * MODIFIED BY EARL STUTES 1976-09-20-1600 * MOD 77-01-30 ADDED DEY OP CODE EAS * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** HED * RTE ASMB4 92067-16074 * (C) HEWLETT-PACKARD COMPANY 1978. * NAM ASMB4,5,99 92067-16074 REV.1805 770919 ENT ASMB4,?AREC EXT WRT.C,C.BIA EXT ?SUP,?BPKU,?PKUP,?LFLG,?RSTA,?ERPR EXT ?OPLK,?GETC,?LINC,?LIST,?LOUT EXT ?CHOP,?CHPI,?OPER,?ASCN,?MSYM,?ASM1,?LINS EXT ?LST,?LPER,?PERL,?SETM,EXEC,?FMPE EXT ?ENDS,?PLIN,?ASMB,?BINF SPC 2 EXT ?TEMP,?RELC,?SIGN,?SUMP,?TERM,?T,?CNTB EXT ?CODE,?DSIG,?FLAG,?FLAQ,?INST,?LAST,?PASS EXT ?PLCN,?PNTR,?SCN1,?TEST,?IOBF,?PBUF SUP .1 DEC 1 .2 DEC 2 .3 DEC 3 .4 DEC 4 .5 DEC 5 .6 DEC 6 .12 DEC 12 .13 DEC 13 .14 DEC 14 .15 DEC 15 .16 DEC 16 .M1 DEC -1 .M2 DEC -2 .M3 DEC -3 .M4 DEC -4 .M5 DEC -5 .M6 DEC -6 L OCT 50,51,52,53,54,55,56 .9 DEC 9 .M8 DEC -8 .M29 DEC -29 BLNK OCT 40 =40B(LOWER BLANK) .NO ASC 1,NO .OP ASC 1,OP .OV ASC 1,OV .IL ASC 1,IL BLNS ASC 1, TW10 OCT 176000 ADDRESS MASK B1000 OCT 1000 BIT15 OCT 100000 .E OCT 105 TEMP EQU ?TEMP RELC EQU ?RELC RELOCATION FLAG SIGN EQU ?SIGN SUMP EQU ?SUMP RUNNING SUM FOR 'CHOP' TERM EQU ?TERM NO. OF TERMS IN AN OPERAND T EQU ?T CNTB EQU ?CNTB CODE EQU ?CODE OPCODE TYPE(FROM OPTABLE) DSIG EQU ?DSIG 'ASCN' FLAG EQU ?FLAG FLAQ EQU ?FLAQ INST EQU ?INST OPCODE FORMAT LAST EQU ?LAST PASS EQU ?PASS PASS FLAG(0=PASS 1 AND 1=PASS2) PLCN EQU ?PLCN PROGRAM LOCATION COUNTER PNTR EQU ?PNTR POINTS AT LAST OR CURRENT CHAR. SCN1 EQU ?SCN1 STATE LNG/OPCODE/OPERAND/LABEL(4) TEST EQU ?TEST TEST CHARACTER * * I/O STATEMENT BUFFER * IOBF EQU ?IOBF 50 WORDS + END OF STATEMENT BUFF PBUF EQU ?PBUF WCNT EQU PBUF WORD(BLK) CNT FOR BIN.RECRD. ASM1 EQU ?ASM1 CHOP EQU ?CHOP CHOPI EQU ?CHPI ERPR EQU ?ERPR GETC EQU ?GETC LINC EQU ?LINC LIST EQU ?LIST LOUT EQU ?LOUT LST EQU ?LST OPERR EQU ?OPER RSTA EQU ?RSTA A EQU 0 B EQU 1 SPC 1 * **************************************** * * CONTINUE PASS 2 OF ABSOLUTE ASSEMBLY * * **************************************** SPC 1 ASMB4 LDA .VAL0 REMOVE INDIRECTS FROM ADDRESS RSS LDA A,I RAL,CLE,SLA,ERA JMP *-2 STA .VAL0 DIRECT ADDRESS LDA ?LPER LENGTH OF CLEAR AREA LDB ?PERL GET ORIGIN OF 'CLEAR' AREA JSB ?SETM GO TO SET MEMORY ROUTINE OCT 0 TO SET MEMORY TO ZERO CLA CLB DST PBUF DST PBUF+1 LDA .2000 STA PLCN INITIALIZE PROG LOC'N COUNTER CLA,INA STA PASS SET PASS FLAG JSB RSTA READ CONTROL STATEMENT LDA TW10 STA ASM1 SET FLAG FOR 'INIT' PORTION ASH JSB RSTA READ A SOURCE STATEMENT(NAM?) LDA CODE CPA .15 HED? JMP ASH YES, GO PICK UP THE NEXT STATEME STA ASM1 CLEAR 'CS' AND 'INIT' FLAG CPA .1 JMP HI12 LDA .NO 'NO'= NO ORG OR NAM STATEMENT JSB ERPR JMP HC05 ERROR EXIT FROM INIT HI12 JSB ?CHOP EVALUATE ORG JMP HC02 ERROR RETURN STB PLCN JMP HC02 * .2000 OCT 2000 * SKP * ****************************** * * SKIP AND SPACE LI)ST OUTPUT * * ****************************** SKPR LDB LINC 'SKIP'ENTRY CMB,INB JMP SK2 SPCR JSB CHOPI EVALUATE SPACE COUNT CLB,INB ERROR - SET COUNT=1 SK2 SZB,RSS SPACES=0? JMP HC04 EXIT TO HC04(START OF PASS) LDA ?LFLG NO, START LINE SKIPPING SZA,RSS LIST REQUESTED? JMP HC04 EXIT TO HC04(START OF PASS) LDA LST LST FLAG SZA SUPPRESS LISTING? JMP HC04 EXIT TO HC04(START OF PASS) STB DSIG SET COUNTER LDA LINC CPA .M1 ON LAST LINE? JMP HC04 YES - EXIT ADB LINC SSB,RSS WILL IT GO TO BOTTOM OF PAGE? JMP *+5 YES,GO TO TOP OF FORM STB LINC NO, SAVE NEW LINE COUNT LDA DSIG GET NO. OF LINES TO BE SKIPPED JSB ?LINS GO TO LINE SKIPPER JMP HC04 EXIT TO GET NEXT STATEMENT CCA SKIP TO TOP OF FORM STA LINC JMP HC04 EXIT TO GET NEXT STATEMENT * * ************************* * * BINARY OUTPUT ROUTINE * * ************************* .M57 DEC -57 DEF PBUF+2 BREC NOP LDA ?BINF BINARY OUTPUT REQUESTED? SZA,RSS JMP BRECX NO, THEN RETURN LDA WCNT SZB RECORD OUT? JMP HI66 NO. SZA,RSS WCNT=0? JMP BREC,I YES. HI60 LDA WCNT ** OUTPUT A BINARY RECORD ** ALF,ALF ROTATE 8 STA WCNT STORE WCNT IN UPPER PBUF ALF,ALF ADA .3 ADD 3 TO THE DATA COUNT STA CNTB SET COUNTER = WCNT+3 JSB WRT.C WRITE RECORD ON BINARY OUTPUT FILE DEF C.BIA DEF PBUF PUNCH BUFFER DEF CNTB WORD COUNT JMP HIERR FMP ERROR BRECX CLA STA WCNT INITIALIZE WCNT =0 JMP BREC,I AND EXIT * HIERR CLA,INA ERROR IN OUTPUT FILE JMP ?FMPE DISPLAY ERROR AND ABORT ASSEMBLER = HI66 SZA 1ST WORD OF BINARY RECORD? JMP HI70 -NO- LDB PLCN PLCN TO BREG STB PBUF+59 PUT IN CHECKSUM SAVER STB PBUF+1 SET RECORD ADDR. LDA BREC-1 STA STOR SET STOR=L(PBUF+2) LDA .M57 STA CNTB SET COUNT=-57 HI70 LDA INST STA STOR,I SET CURRENT BIN. WORD ISZ STOR BUMP POINTER ADA PBUF+59 UPDATE CHECKSUM STA PBUF+59 STA STOR,I SAVE IN LWA+1 OF PUNCH RECORD ISZ WCNT ISZ CNTB IS RECORD FULL? JMP BREC,I NO - EXIT JMP HI60 YES - GO PUNCH STOR BSS 1 SPC 2 HC02 LDA .2 LIST PARAMETER HC03 JSB LIST * * * READ NEXT STATEMENT * HC04 JSB RSTA READ NEXT STATEMENT * * * TEST MNEMONIC CODES FOR PROCESS TYPE * * HC05 LDA CODE LDB INST CPA .100B CODE = 'MIC' ? JMP X39 YES, GO TO LIST IT. ADA M100B SUBTRACT 100 OCTAL SSA,RSS CODE >100B ? JMP XMIC YES, IT'S A MICROCODE MACRO. LDA CODE GET OPCODE I.D. AGAIN. CPA L+3 (43) SOC OR SOS ? JMP HC28 YES AND .M8 (177770) CPA L I/O ? JMP IOPR YES ARS,ARS SHIFT A RIGHT 4 BITS ARS,ARS CPA .3 60 OR 70?(MICRO-OP?) JMP MICR YES LDA CODE ADA CODLC SET UP ADDRESS OF PROCESSOR JMP A,I JUMP TO OPCODE PROCESSOR * SKP * ************************ * * PROCESSOR JUMP TABLE * * ************************ * * CODLC DEF *,I DEF HC42 ORG 1 DEF HC42 ORR 2 DEF HC38 *COM 3 DEF HC38 *ENT 4 DEF HC38 *EXT 5 DEF HC38 *ARITH 6 DEF ASCP ASC 7 DEF DCNUM DEC 10 DEF OCNUM OCT 11 DEF BSSP BSS 12 DEF EQUP EQU 13 DEF FIN2 END 14 DEF HC38 *NAM 15 DEF MEMRY MEMORY 16 DEF X50 HED 17 DEF MEMRY DEF 20 DEF HC26 ABS 21 DEF SKPR SKP 22 DEF SPCR SPC 23 DEF X54 LST/UNL 24 DEF DXNUM DEX 25 DEF HC70 HDW ARITH 26 DEF HC80 HDW SHIFT 27 DEF HC30 CLO, ETC. 30 .I OCT 111 ASCII I 31 DEF HC38 *RPL 32 CBIT OCT 175777 33 .1777 OCT 1777 34 DEF X52 REP 35 M17 DEC -17 36 -17 FOR SHIFT-ROT CNTC NOP 37 MICRO-OP PROC DEF X56 SUP/UNS 40 DEF BYTE DBL 41 DEF BYTE DBR 42 DEF BYTEG BYT 43 DEF DYNUM DEY 44 INSV NOP MICRO-OP PROC SUM. EQU INSV MEMORY REF PROC. DEX OCT 25 'DEX' OPCODE TYPE DEY OCT 44 'DEY' OPCODE TYPE * SKP * * PROCESS MEMORY REFERENCE INSTRUCTIONS * * MEMRY LDA INST AND .M2 CLEAR LDSB OF 'INST' STA INST LDA .I SET FOR INDIRECT BIT LDB BIT15 INDIRECT BIT MASK(100000B) JSB CHOP JMP HC17E ERROR EXIT HCX STB SUM. OPERAND VALUE CLB LIST PARAMETER=0 HCXL STB TERM SAVE THE LIST PARAMETER LDA SUM. LDB CODE CPB .16 (16) DEF? JMP HC17 ADA TW10 NO - TEST FOR OPERAND>1023 SSA,RSS IS IT? JMP *+5 YES. LDA INST NO - SET TO CLEAR'CURRENT' BIT. AND CBIT CURRENT BIT MASK(175777) STA INST RESTORE JMP HC14 LDA PLCN TEST NOW FOR OPER.AND INSTR. AND TW10 IN THE SAME PAGE OF MEMORY CMA,INA ADA SUM. AND TW10 SZA,RSS IN SAME PAGE? V JMP *+3 YES LDA .OV NO - IT'S AN OVERFLOW JSB ERPR LDA .1777 AND SUM. STRIP UPPER 6 BITS OF OPERAND STA SUM. HC14 LDA SUM. GET ADDRESS HC17 IOR INST FOR INSTRUCTION, AND STA INST SET LOADER FLAG * * * OUTPUT A BINARY WORD * * HC19 CLB,INB JSB BREC * * * OUTPUT A LINE FOR LISTING * * LDB BLNS GET BLANKS FOR LIST ROUTINE LDA TERM GET THE LIST PARAMETER JSB LIST ISZ PLCN JMP HC04 * SKP * ***************** * * BSS PROCESSOR * * ***************** BSSP JSB CHOPI EVAL. OPERAND JMP HC02 ERROR SZB,RSS B=0? JMP HC02 YES CLB B=0 JSB BREC CLA A=0 LDB BLNS NO RELOC. INDIC. JSB LIST LDA SUMP PICK UP BLOCK LENGTH FOR PLCN ADA PLCN STA PLCN JMP HC04 EXIT * SKP * ********************************************** * * PROCESS THE 'DEF' FOLLOWING THE FIRST WORD * * * OF AN ARITHMETIC PAIR * * ********************************************** HC70 JSB LOUT OUTPUT THE ARITH. OPERATION JSB LIST LIST THE FIRST WORD LDA .16 (20B) STA CODE =DEF CLA STA INST CLEAR INST LDA .I SET UP FOR INDIRECT BIT LDB BIT15 MASK= 100000B JSB CHOP NOP ISZ PLCN BUMP LOCATION COUNTER STB SUM. SAVE OPERAND VALUE LDB .4 LIST PARAMETER=4 JMP HCXL HC17E CLA LIST PARAMETER =0 STA TERM SAVE IT JMP HC17 * * * PROCESS 'ABS' OPCODE * * HC26 JSB CHOPI GO EVALUATE OPERAND JMP HP2D ERROR STB INST JMP HP2D OK.. * * * OUTPUT BIN RECRD AND/OR LIST LINE * * HC30 JSB LOUT JSB LIST *  * * ADD 1 TO PROG. LOCN. CNTR. * * ISZ PLCN BUMP LOCATION CNTR JMP HC04 * * * COM,ENT,EXT AND ARITH MACRO * HC38 LDA .IL ILLEGAL IN ABSOLUTE ASSEMBLY JSB ERPR X39 CLA,INA 1 TO A JMP HC03 * SKP * * * PRE-PROCESSOR FOR ORG AND ORR * * HC42 CLB OUTPUT A JSB BREC RECORD JSB INST,I JUMP TO CORRECT SUBROUT. JMP HC02 BACK TO START LIST X50 LDA ?LFLG GET THE LIST FLAG SZA,RSS IS LIST FLAG OFF? JMP HC04 YES - GO TO NEXT STATEMENT JSB INST,I TO HEADER SUBROUTINE CCA SPACE TO BOTTOM OF PAGE STA LINC JMP HC04 GET NEXT STATEMENT X52 JSB INST,I TO REPSB JMP X39 X54 STB LST SET LST/UNL FLAG JMP HC04 EAS 1976-09-20-1600 X56 STB ?SUP SET 'SUP/UNS' FLAG JMP X39 SPC 1 * * PASS 2 'EQU' PROCESSOR * * EQUP JSB CHOPI EVAL. OPERAND CLB ERROR EXITS LDA PLCN STA SUMP SAVE PLCN VALUE STB PLCN SET PLCN=0 LDA .2 (2) LIST 'EQU' JSB LIST LDA SUMP REPLACE PLCN VALUE STA PLCN JMP HC04 HC80 JSB CHOPI GO EVALUATE THE COUNT JMP HC84 BAD COUNT EXIT ADB M17 B-17 SSB B GRTR THAN 16? CPB M17 NO. IS B=0? JSB OPERR YES, IT'S AN 'M' ERROR,. LDA SUMP GET THE SHIFT OR ROTATE COUNT.. AND .15 MASK OUT LOWEST 4 BITS HC82 ADA INST MAKE UP THE FINAL INSTRUCTION STA INST JMP HC30 GO AND OUTPUT THE INSTRUCTION HC84 CLA SET COUNT FOR 16 BIT SHIFT ROTATE JMP HC82 * SKP * ************************* * * OCT/DEC/ASC PROCESSOR * * ************************* OCNUM CLA JMP NUMPX DCNUM LDA .1 JMP NUMPX DXNUM LDA .3 JMP NUMPX 1DYNUM LDA .4 NUMPX STA WHAT NUMP LDA SCN1+2 STA PNTR SET POINTER LDA .M1 STA T+1 INITIALIZE FPAS HE06 LDB PNTR PNTS AT 1ST CH OF NUMBER STB SIGN CLB STB CNTC LDB WHAT STB RELC * * * TEST CHARACTER FOR TERMINATOR * HE08 LDA PNTR JSB GETC STA TERM CPA L+4 COMMA? JMP HE12 YES CPA BLNK BLANK? JMP HE12 YES * * * UPDATE CHAR.CNTR(CNTC) AND POSN. PNTR(TLOC) * LDB CODE CPB .8 IF OP CODE # DEC THEN GO COUNTEMUP JMP *+2 JMP CNTUP LDB .2 TEST FOR REAL OR INTEGER CPA L+6 IF DECIMAL POINT THEN JMP *+2 RELC := 2 CPA .E ELSE IF "E" THEN STB RELC RELC := 2 CNTUP ISZ CNTC ISZ PNTR BUMP PNTR JMP HE08 * * * SET UP VALUE FOR LIST AND/OR PUNCH * HE12 LDB RELC BLF,BLF ADB CNTC LDA SIGN JSB ?ASCN GO TO 'ASCI' CONVERSION JMP ASCER THIS IS THE ERROR RETURN STA TEMP+1 LDA .VAL0 STA WPNTR SET UP WORKING POINTER LDA RELC CMA,INA,SZA,RSS SET UP WORKING COUNTER CCA OOPS IT WAS ZERO, MAKE IT -1 STA RELC NUMLP LDA WPNTR,I OUTPUT A WORD TO THE DATA STREAM JSB NOUT ISZ WPNTR ISZ RELC IF U DUN DEN BUG OUT JMP NUMLP IF NOT DEN LOOP HE18 LDA TERM GET THE TERMINATOR CPA BLNK IS THIS THE END OF THE TERM ? JMP HC04 YES, EXIT ON BLANK ISZ PNTR BUMP PNTR JSB ?BPKU SCAN OVER BLANKS LDA PNTR TEST FOR EOL 1976-09-20-1600 CMA,INA ADA SCN1 THE RECORD CHARACTER COUNT SSA,RSS JMP HE06 MORE DATA FOLLOWS LDA .IL SOMETHING IS NOT GOOD JSB ?ERPR TELL EM KEMO SABE CLA MAKE A NOP JSB NOUT DUMP IT JMP HC04 BUG OUT, U Dz6ONE * ASCER CLA JSB NOUT PUT A ZERO IN THE DATA STREAM JMP HE18 CONTINUE SCAN .VAL0 DEF TEMP+1 WPNTR BSS 1 WHAT BSS 1 .8 DEC 8 * * *************************** * * OCT DEC ASC WORD OUTPUT * * *************************** NOUT NOP STA INST CLA ISZ T+1 IF NOT FIRST LINE THEN LDA .4 (4) SET A=4 FOR LIST LDB BLNS JSB LIST CLA CLB,INB JSB BREC PUNCH ISZ PLCN BUMP LOCN CNTR. JMP NOUT,I EXIT * ******************** * * PROCESS ASC HERE * * ******************** ASCP LDA SCN1+2 INITIALIZE FOR ASC PROCESSING STA PNTR LDA .M1 STA T+1 LDA .2 (2) INDIC.'ASC' JSB CHOP GO EVALUATE WORD LENGTH JMP HC30 ERROR EXIT SZA VALUE ABSOL.? JMP HP2D-1 NO; ERROR SZB,RSS ASKING FOR ZERO WORDS? JMP HP2D-1 YES * ERROR * ADB .M29 (-29)(VALUE IS IN SUMP TOO) SSB,RSS VAL.>28? JMP HP2D-1 YES; ERROR LDA PNTR STA T LDA SUMP CMA,INA STA CNTC VALUE(COMPL.) TO CNTC * * * PICK UP WORDS AND STORE INTO PROGRAM * SB ISZ T LDA T JSB GETC ALF,ALF STA TEST ISZ T LDA T JSB GETC * * * OUTPUT 2 ASCI CHARACTERS * JSB NOUT CLA STA TEST ISZ CNTC JMP SB JMP HC04 DONE, GO GET NEXT STATEMENT * ************************* * * PROCESS I/O GROUP HERE * * ************************** RAM OCT 105000 OCT 177400 OCT 300 IOPR LDA SCN1+2 IS OPERAND SZA PRESENT? JMP P YES! LDA CODE NO OPERAND CPA L+1 'HLT'? JMP HP2D YES * * * OPERAND ERROR EXIT HERE * JSB OPERR (HP2D-1) HP2D CLA STA TERM SAVE THE LIST PARAMETER JMP HC19 P LDA .C TEST FOR 'CLEAR FLAG'(C). LDB B1000 GET 'C' MASK FOR IO INSTR. JSB CHOP JMP Q ERROR EXIT LDA 1 LDB INST LOAD B WITH OCTAL INSTR ADA IOPR-2 MASK FIRST PART CPB RAM SEE IF A RAM INSTR RSS SKIP NEXT MASK IF RAM ADA IOPR-1 IF NOT RAM ADD SECOND PART LDB SUMP RESTORE B REG * SKP * * * TEST FOR VALUE>63 * * SSA VALUE >64 ? JMP *+4 YES-O.K. LDA .OV 'OV' ADDRESS OVERFLOW JSB ERPR GO PRINT ERROR MESSAGE. Q CLB ADB INST (HE54+1) STB INST JMP HP2D .C OCT 103 ASCII 'C' * * * PROCESS SOC OR SOS * HC28 LDA SCN1+2 PNTR TO OPERAND SZA,RSS OPERAND PRESENT? JMP HP2D NO LDB 0 A TO B JSB ?MSYM ADA .M1 SZA JMP HP2D LDA LAST CPA .C IS 'C' PRESENT? JMP *+2 YES JMP HP2D NO * * * 'OR' 1 TO BIT 9 (C BIT) OF I/O INST * * LDA INST IOR B1000 MASK IN CURRENT BIT STA INST JMP HP2D * SKP * ********************** * * MICRO-OP PROCESSOR * * ********************** MICRD OCT 7777,4000,60000,60,71,14000 * * * INITIALIZE FLAGS * MICR CLA STA CNTC =0 WHEN CLE APPEARS STA TERM BITS 12-11 = 1 IF B REG * BITS 12-11 = 2 IF A REG STA TEMP+4 BITS 14-13=1 IF SRG; =2 IF ASG STA INSV USED TO ACCUMULATE THE CODE STA FLAG STA TEST CLEAR CHAR TESTER * * * START HERE FOR EACH NEW CODE * F LDA INST UNPACK THE MICRO-OP CODE * * THE FORMAT IS: * BITS 14-13=1 IF SRG,2 IF ASG, 0 IF *  EITHER * BITS 12-11=1 IF BREG,2 IF AREG, 0 IF * NEITHER. * BITS 11-0 = ACTUAL 12 BIT CODE AND MICRD EXTRACT OPCODE STA FLAQ SAVE IT (=+2) LDA CODE THIS IS THE GROUP NUMBER. CMA,INA MAKE SURE IT'S BIGGER THAN THE LAST. ADA FLAG A=(LAST GRP)-(PRESENT GRP) SSA JMP O SEQUENCE IS OK * * * IF PRES GRP IS GO WE CAN CHANGE IT AND MAY BE OK LDA CODE CPA MICRD+3 IS CODE TYPE = 60B (MICRO-OP)? JMP *+4 CHANGE ERROR GROUP AND OP CODE MERR LDA .OP 'OP' FOR OPCODE ERROR JSB ERPR RETURN JMP HP2D LDA MICRD+4 71B, CHANGE GROUP (FROM *-4) STA CODE TO 71 * * * MOVE BITS 8-5 OF OPCODE TO BITS 4 AND 2-0 * LDA FLAQ AND MICRD+1 SET A/B BIT STA 1 SAVE IN B. XOR FLAQ ALF,ALF MOVE BITS 0 AND 15-13 RAR,SLA MOVE BIT 0 TO INA BIT 1. ALF,RAR ROTATE LEFT 3, TO BITS 4,2-0 IOR 1 PUT IN THE A/B BIT JMP F+2 O LDA CODE STA FLAG SET LAST GRP TO PRESENT GRP * * * CHECK REGISTER CONSISTENCY * LDA INST AND MICRD+5 GET BITS 12-11 IOR TERM CPA MICRD+5 IF EQUAL, THERE'S A REGISTER JMP MERR INCONSISTENCY. STA TERM NEW REGS TO REGS, * * * OTHERWISE CHECK GROUP CONSISTENCY * LDA INST AND MICRD+2 BITS 14-13 IOR TEMP+4 CPA MICRD+2 IF EQUAL,THERE ARE 2 CODES JMP MERR FROM DIFFERENT GROUPS. STA TEMP+4 * * * CHECK FOR CLE * LDA FLAQ SZA,RSS ISZ CNTC * * * NOW 'OR' THE CODE INTO CURRENT CODE SO FAR * IOR INSV STA INSV * * * GET THE NEXT CHARACTER * LDA SCN1+1 OPCODE PNTR ADA .3  (3) STA PNTR POINTS AT POS'N FOLLOWING OPCODE JSB ?PKUP CPA BLNK IS THIS CHAR. A BLANK ? JMP *+7 YES, WE'RE DONE. CPA L+4 COMMA ? JMP *+2 JMP MERR * * * GET THE NEXT OPCODE * JSB ?OPLK OPCODE LOOKUP JMP HP2D JMP F * * * TO FINISH TEST CLE; IF USED AND IN ASG SET, ADD 40 * * TO THE CODE. LDA TEMP+4 (FROM *-7) ALF,ALF SZA,RSS IOR BLNK (40B) LDB CNTC SZB,RSS CLA IOR INSV STA INST JMP HP2D * SKP * ***************** * * PROCESS 'END' * * ***************** * FIN2 CLB JSB BREC PUNCH REST OF LAST DBL RECORD CLA,INA LDB BLNS JSB LIST LIST 'END' STATEMENT JSB ?ENDS GO TO END SUBROUTINE JMP ASMBX GO TO COMPLETION * SKP * * ********************************************************* * * PROCESS BASE SET EXTENSION AND MEMORY EXPANSION CODES * * ********************************************************* * XMIC STA SCODE SAVE CODE-100B CMA,INA STA OPNUM START SETTING PARAMETER COUNT ADA .7 SSA,RSS CODE GRTR THAN 107B? JMP PROCX NO - OPNUM IS OK LDB .M1 B = -1 CPA .M6 BIT TYPE INSTR.? (115B) ADB .M1 B = -2 IF YES STB OPNUM SAVE PARAMETER COUNT PROCX JSB LOUT OUTPUT MICROCODE TO PUNCH JSB LIST LIST SOURCE STATEMENT LDA PLCN GET CURRENT LOCN COUNTER VALUE STA STAR SAVE IN PSEUDO COUNTER STA STARX SAVE AS ORIGINAL VALUE ISZ STAR BUMP PSEUDO ISZ PLCN BUMP ACTUAL * PROC1 LDA .20B SET CODE TO = 20B(DEF) STA CODE IN ORDER TO FAKE OUT CHOP LDA STARX STA PLCN RESET PLCN TO STARTING VALUE CLA STA IN wNLHST CLEAR INSTRUCTION LDA SCODE CPA .13B IS CODE = 113B?(NO INDIRECT) JMP PROC2 YES LDB BIT15 NO LDA .I JSB CHOP EVALUATE AN OPERAND JMP PROC3 ERROR EXIT JMP PROC4 NORMAL RETURN * PROC2 JSB CHOPI EVALUATE OPER.(NON-INDIRECT) JMP PROC3 ERROR EXIT JMP PROC4 NORMAL RETURN PROC3 CLA STA SUMP SET VALUE = 0 PROC4 LDA PNTR STA SCN1+2 RESET POINTER TO NEXT OPERAND LDA SUMP IOR INST STA INST INST = OPERAND VALUE SSA WAS ADDR INDIRECT? ISZ SCN1+2 YES, BUMP LOCN OF OPERAND LDB STAR STB PLCN SET LOCN COUNTER TO ACTUAL VALUE JSB LOUT GO PUNCH IT LDA .4 JSB LIST GO LIST IT ISZ PLCN BUMP LOCN COUNTER ISZ STAR BUMP PSEUDO LOCN COUNTER CLA STA INST CLEAR INST IN CASE FINAL NOP LDB SCODE CPB .12 CODE=114B? (NOP IN LAST WORD) JMP PROCA YES - EXIT ISZ OPNUM LAST OPERAND? JMP PROC1 NO - GO PROCESS NEXT ONE JMP HC04 YES - GO FOR NEXT SOURCE STATEM. * PROCA JSB LOUT GO PUNCH NOP =N LDA .4 SET FOR RESTRICTED LIST JMP HC30+1 GO. * STAR NOP PSEUDO LOCN COUNTER STARX NOP LOCN OF INSTRUCTION .13B OCT 13 13B SCODE NOP SAVE CODE-100B .100B OCT 100 100B M100B OCT -100 -100B OPNUM NOP SAVE OPERAND COUNT .20B EQU .16 20B ROTFL OCT 125252 ODD/EVEN FLAG LMASK OCT 377 377B UMASK EQU RAM+1 177400B .7 DEC 7 * * ************************************ * * GENERATE A STRING OF BYTES. * * * OCTAL NUMBERS ONLY * * * -377 >= NUMBER <=+377 * * ************************************ * BYTEG LDA SCN1+2 START INITIALIZATION STA PNTR SET PNTR TO 1ST BYTE CLA STA T+1 SET FIRST LINE LIST OUTPUT FLAG LDA ROTFL STA SCODE SET RIGHT/LEFT ALTERNATOR * BYT01 LDB PNTR STB SIGN SAVE START OF BYTE CLB STB CNTC INITIALIZE CHARACTER COUNT * BYT03 LDA PNTR GET A CHARACTER JSB GETC STA TERM SAVE IT CPA L+4 COMMA? (END OF BYTE) JMP BYT05 YES GO PROCESS A BYTE CPA BLNK BLANK? (END OF BYTE AND STRING) JMP BYT05 YES GO PROCESS A BYTE * ISZ CNTC BUMP CHAR. COUNT ISZ PNTR BUMP CHAR. POINTER JMP BYT03 GO GET NEXT CHAR. * BYT05 LDB CNTC B=CHARACTER COUNT LDA SIGN A = POINTER TO BYTE JSB ?ASCN CONVERT BYTE TO OCTAL NUMBER CLA ERROR RETURN - SET A=0. STA B SAVE VALUE IN B AND UMASK SZA GRTR THAN 377B? CPA UMASK MAYBE - TEST FOR GOOD NEG. VALUE JMP *+3 NUMBER IS OK JSB OPERR ERROR CLB LDA B AND LMASK LDB SCODE RBR,SLB LEFT BYTE BEING PROCESSED? JMP BYT10 YES STB SCODE SAVE LEFT/RIGHT FLAG IOR INST NO - SET UP TO GENERATE A z  WORD BYT06 JSB NOUT OUTPUT A WORD TO LIST/PUNCH LDA TERM GET LAST CHAR. TESTED CPA BLNK BLANK? (END OF STATEMENT) JMP HC04 YES - EXIT JMP BYT12 NO - GO START NEXT BYTE * BYT10 ALF,ALF PROCESS LEFT BYTE STA INST PLACE IN UPPER 'INST' STB SCODE SAVE LEFT/RIGHT FLAG LDB TERM CPB BLNK LAST TERM IN STRING? JMP BYT06 YES - GO OUTPUT IT BYT12 ISZ PNTR NO - START NEXT BYTE JSB ?BPKU JMP BYT01 * * ******************************************************* * * PROCESS BYTE LOCN DEFINE INSTRUCTIONS - DBL AND DBR * * ******************************************************* * BYTE LDA .20B STA CODE SET CODE=DEF TO FAKE OUT CHOP JSB CHOPI JMP HC17E ERROR EXIT CLE,ELB ADDRESS * 2. E := 0 FOR ERROR CHECK SEZ OPERAND VALID? JMP HP2D-1 NO,GO TELL EM JMP HCX GO COMPLETE PROCESSING * SPC 1 ******************************************************************** ********** CHANGE LOC'N. Z IN ASMB IF THIS PROGS. LWA > 1550B ****** ******************************************************************** SPC 1 ASMBX EQU ?ASMB ?AREC EQU BREC SPC 1 END ASMB4 ;t  - 92067-18075 1805 S C0422 &DBUG1 RTE-IV DEBUG SUBROUTINE             H0104 =DASMB,R,Q,C * * DATE:780117 * NAME: DBUGR * SOURCE: 92067-18075 * RELOC: 92067-16075 * PGMR: B.S.,G.A.,D.D.,D.S.,J.N. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * HED DBUG(USER VERSION) NAM DBUGR,7 92067-16075 REV.1805 780214 ENT DBUGR,.DBUG,.SDBG EXT EXEC,$LIBX,$LIBR,IFBRK,LOGLU SUP * * A EQU 0 B EQU 1 R EQU 1 HED SYMBOL TABLES * E N D * * USER DEFINED SYMBOL TABLE AREA * * SYMBOLS WILL RESIDE IN IDENTICAL FORMAT TO TABLE "ISL" * FOLLOWING THIS TABLE IN MEMORY. THAT FORMAT IS: * * 4 TO 6 CHARACTERS IN SYMBOL- * * ENTRY 1 - 1ST WORD(1ST 3 CHARACTERS OF SYMBOL) IN SQOZE CODE * ENTRY 2 - 2ND WORD(2ND 3 CHARACTERS OF SYMBOL) IN SQOZE CODE * ENTRY 3 - OPCODE * * 3 OR LESS CHARACTERS IN SYMBOL- * * ENTRY 1 - SYMBOL WORD IN SQOZE CODE * * ENTRY 2 - MAY BE USED FOR A VALUE * END BSS 50 SYMBOL TABLE FREE AREA SKP * I S L * * INSTRUCTIONS SYMBOL TABLE * * CONTAINS SYMBOLS FOR THE 2100 ALTER SKIP,SHIFT ROTATE AND * I O INSTRUCTIONS SET IN SQOZE CODE. TABLE ENTRIES ARE IN * THE FOLLOWING FORMAT: * * 4 TO 6 CHARACTERS IN SYMBOL- * * ENTRY 1 - 1ST WORD(1ST 3 CHARACTERS OF SYMBOL) IN SQOZE CODE * ENTRY 2 - 2ND WORD(2ND 3 CHARACTERS OF SYMBOL) IN SQOZE CODE * ENTRY 3 - OPCODE * * 3 OR LESS CHARACTERS IN SYMBOL- * * ENTRY 1 - SYMBOL WORD IN SQOZE CODE * * ENTRY 2 - MAY BE USED FOR A VALUE * ISL EQU * OCT 45 . LOC NOP USED AS THE LOCATION C%]OUNTER OCT 2755 .. DDOT NOP * * I S L 2 * * REMAINDER OF TABLE "ISL" SOMETIMES REFERRED TO DIRECTLY AND * SOMETIMES REFERRED TO AS A PART OF TABLE "ISL" * ISL2 EQU * OCT 44115,0,1000 ALS OCT 44475,0,1100 ARS OCT 130316,0,1200 RAL OCT 130324,0,1300 RAR OCT 44114,0,1400 ALR OCT 61053,0,1500 ERA OCT 60473,0,1600 ELA OCT 44100,0,1700 ALF OCT 47215,0,5000 BLS OCT 47575,0,5100 BRS OCT 130366,0,5200 RBL OCT 130374,0,5300 RBR OCT 47214,0,5400 BLR OCT 61054,0,5500 ERB OCT 60474,0,5600 ELB OCT 47200,0,5700 BLF ISL3 EQU * OCT 52273,0,2400 CLA OCT 52343,0,3000 CMA OCT 51523,0,3400 CCA OCT 52274,0,6400 CLB OCT 52344,0,7000 CMB OCT 51524,0,7400 CCB SEZ OCT 133674,0,2040 SEZ OCT 133674,0,6040 SEZ CLE OCT 52277,0,2100 CLE OCT 52277,0,6100 CLE OCT 52277,0,40 CLE OCT 52277,0,4040 CLE OCT 52277,35,40 CLES OCT 52347,0,2200 CME OCT 52347,0,6200 CME OCT 51527,0,2300 CCE OCT 51527,0,6300 CCE OCT 131645,0,2001 RSS OCT 131645,0,6001 RSS OCT 134723,0,2020 SSA OCT 75213,0,2004 INA OCT 135353,0,2002 SZA OCT 134724,0,6020 SSB OCT 75214,0,6004 INB OCT 135354,0,6002 SZB SLA OCT 134273,0,10 SLA OCT 134273,0,2010 SLA OCT 44115,0,20 ALS LOWER OCT 44475,0,21 ARS LgOWER OCT 130316,0,22 RAL LOWER OCT 130324,0,23 RAR LOWER OCT 44114,0,24 ALR LOWER OCT 61053,0,25 ERA LOWER OCT 60473,0,26 ELA LOWER OCT 44100,0,27 ALF LOWER SLB OCT 134274,0,4010 SLB OCT 134274,0,6010 SLB OCT 47215,0,4020 BLS LOWER OCT 47575,0,4021 BRS LOWER OCT 130366,0,4022 RBL LOWER OCT 130374,0,4023 RBR LOWER OCT 47214,0,4024 BLR LOWER OCT 61054,0,4025 ERB LOWER OCT 60474,0,4026 ELB LOWER OCT 47200,0,4027 BLF LOWER OCT 23,100000 I O15 OCT 15,1000 C OCT 72016,0,102000 HLT HLT EQU *-1 OCT 52300,0,103100 CLF OCT 135000,0,102100 STF STF EQU *-1 OCT 133715,0,102200 SFC OCT 133735,0,102300 SFS OCT 111303,0,102400 MIA OCT 111304,0,106400 MIB OCT 120373,0,102600 OTA OCT 120374,0,106600 OTB OCT 134775,0,102700 STC OCT 52275,0,106700 CLC OCT 106203,0,102500 LIA OCT 106204,0,106500 LIB OCT 44544,0,101020 ASR OCT 44536,0,100020 ASL ASL EQU *-1 OCT 107044,0,101040 LSR OCT 107036,0,100040 LSL LSL EQU *-1 OCT 131574,0,101100 RRR OCT 131566,0,100100 RRL RRL EQU *-1 OCT 51432,0,101741 CAX OCT 51433,0,101751 CAY OCT 51502,0,105741 CBX OCT 51503,0,105751 CBY OCT 53233,0,101744 CXA OCT 53234,0,105744 CXB OCT 53303,0,101754 CYA OCT 53304,0,105754 CYB OCT 153132,0,101747 XAX OCT 153133,0,101757 XAY F OCT 153202,0,105747 XBX OCT 153203,0,105757 XBY OCT 105576,0,105763 LBT OCT 133476,0,105764 SBT OCT 106013,0,101727 LFA OCT 106014,0,105727 LFB OCT 110663,0,105702 MBI OCT 110701,0,105704 MBW OCT 112373,0,105705 MWI OCT 112411,0,105707 MWW OCT 131623,0,101730 RSA OCT 131624,0,105730 RSB OCT 132013,0,101731 RVA OCT 132014,0,105731 RVB OCT 154043,0,101722 XMA OCT 154044,0,105722 XMB OCT 154065,0,105721 XMS OCT 56052,0,105761 DSX OCT 56053,0,105771 DSY OCT 75552,0,105760 ISX OCT 75553,0,105770 ISY OCT 110660,0,105703 MBF OCT 112370,0,105706 MWF OCT 122103,0,101712 PAA OCT 122104,0,105712 PAB OCT 122153,0,101713 PBA OCT 122154,0,105713 PBB OCT 135303,0,101710 SYA OCT 135304,0,105710 SYB OCT 143123,0,101711 USA OCT 143124,0,105711 USB OCT 154057,0,105720 XMM OCT 63432,0,105100 FIX OCT 63616,0,105120 FLT OCT 133714,0,105767 SFB "CR" EQU O15 SKP DOUBL EQU * OCT 111763,0,100200 MPY OCT 55230,0,100400 DIV OCT 55376,0,104200 DLD OCT 56046,0,104400 DST OCT 62706,0,105000 FAD OCT 63120,0,105060 FDV OCT 63662,0,105040 FMP OCT 64224,0,105020 FSB OCT 43422,0,105746 ADX OCT 43423,0,105756 ADY OCT 105532,0,101742 LAX OCT 105533,0,101752 LAY OCT 105602,0,105742 LBX OCT 105603,0,105752 LBY OCT 105722,0,105745 LDX  OCT 105723,0,105755 LDY OCT 153773,0,101724 XLA OCT 153774,0,105724 XLB OCT 133432,0,101740 SAX OCT 133433,0,101750 SAY OCT 133502,0,105740 SBX OCT 133503,0,105750 SBY OCT 135022,0,105743 STX OCT 135023,0,105753 STY OCT 134737,0,105714 SSM OCT 100223,0 JLY JLY OCT 105762 OCT 100463,0 JPY JPY OCT 105772 * REMAINING INSTRUCTIONS ARE IN THE 21MX BASE SET * BUT ARE NOT SIMULATED BY DDT AND CANNOT BE TRACED. OCT 55272,0,105732 DJP IVINS EQU *-1 OCT 55275,0,105733 DJS OCT 134172,0,105734 SJP OCT 134175,0,105735 SJS OCT 142372,0,105736 UJP OCT 142375,0,105737 UJS OCT 154423,0,101725 XSA OCT 154424,0,105725 XSB STTP2 EQU * OCT 100575,0,105715 JRS OCT 153223,0,101726 XCA OCT 153224,0,105726 XCB OCT 51476,0,105766 CBT OCT 110676,0,105765 MBT OCT 51475,0,105774 CBS OCT 133475,0,105773 SBS OCT 136575,0,105775 TBS OCT 112341,0,105777 MVW OCT 52371,0,105776 CMW STTP EQU * SKP * DSPTB DEF PLUS SPACE DEF EXCL ! DEF ASCIN " DEF NUMSN # DEF EXI $ DEF PCT % DEF DAQ & DEF ASO ' DEF PFIX ( DEF EXASC ) DEF STAR * DEF PLUS + CMADD DEF COMMA , DEF MINUS - DEF DOT . DEF BAR / NMFLG BSS 1 NOT USED FOR DISPATCHING (ASCII # 0) BSS 1 NOT USED FOR DISPATCHING (ASCII # 1) BSS 1 NOT USED FOR DISPATCHING (ASCII # 2) BSS 1 NOT USED FOR DISPATCHING (ASCII # 3) BSS 1 NOT USED FOR DISPATCHING (ASCII # 4) BSS 1 NOT USED FOR DISPATCHING (ASCII # 5) TEMP4 BSS 1 NOT USED FOR DISPATCHING (ASCII # 6) TEMP3 BSS 1 NOT USED FOR DISPATCHING (ASCII # 7) TEMP2 BSS 1 NOT USED FOR DISPATCHING (ASCII # 8) TEMP1 BSS 1 NOT USED FOR DISPATCHING (ASCII # 9) DEF COLON : DEF SEMI ; DEF LSSN < DEF EQLS = DEF GRTR > DEF MSTAT ? DEF EXA @ DEF AT A DEF BRK B DEF CT C DEF PNCH D DEF EAS E DEF FT F DEF GO G DEF HT H DEF ERR I DEF USMAP J DEF KILL K DEF TABL L DEF MT M DEF NWS N DEF BPM O DEF PROC P DEF QT Q DEF RSET R DEF ST S DEF TRACE T DEF ECSL U DEF VFY V DEF WDS W DEF XEC X DEF LOAD Y DEF ZRO Z DEF SBRK [ DEF ALT \ ERRX DEF ERR ] DEF UPARW ^ DEF LARR _ HED DBUG INITIALIZATION * * PNT10 DEF MSG01 MSG01 OCT 6412 CR/LF ASC 6,START DBUGR OCT 6412 CR LF ASC 1,// * .DBUG NOP WHERE LOADER WILL PLACE TRUE RETURN. $DDT NOP EVERYONE'S ENTRY POINT DBUGR EQU $DDT JSB SVST NOMINAL ENTRY POINT LDB .DBUG DETERMINE IF CALLED FROM LDA $DDT LOADER($DDT = 0)OR SZA DIRECTLY. LDB $DDT,I SET EXIT ADDRESS STB DDOT FOR PROCEED ISZ $DDT STEP TO POSSIBLE LU ADDRESS. SZA IF APPENDED BY LOADER OR CPB $DDT IF THERE IS NO LU GIVEN, JMP TST THEN GO GET LOG LU OR LU 1. * LDA $DDT,I YES GET IT LDA A,I TO A TST1 AND O77 #ISOLATE IT IOR O2500 MAKE HONEST MODE STA LU SAVE AS THE LU JSB EXEC GET TYPE CODE DEF TSTRT DEF O15 (DEC 13) DEF LU PCH DEF CH TEMP TSTRT LDA PCH,I GET EQT WORD 5 AND C374 KEEP TYPE STA TMODE SET MODE (0= '\' #0= '\\' LDB PNT10 PRINT 'START JSB OUTMS DBUGR' MESSAGE. JMP LSE O2500 OCT 2500 * TST JSB LOGLU GO RECOVER LOG DEF *+2 LU OR IF NONE, DEF LU THEN USE LU 1. JMP TST1 A-REG = LU#. C374 OCT 37400 HED DBUG - CHARACTER DISPATCH * * LSE RSS CLEARED ON FIRST ENTRY JMP LSE1 LDA BIX GET THE ADDRESS TO USE AGE AND G74 FOR BREAK INSTRUCTIONS XOR BIX SAVE THE ADDRESS ONLY STA DSYMX SAVE IT FOR BREAK LDA LNEV SET FENCES CMA,INA FOR STA LNEV EVAL CHECKS LDA LXEV MUST BE NEG CMA,INA STA LXEV * LDA 1777B SET DM BOUNDS STA CEND SET END OF MEMORY INA STA UPBD CMA,INA STA MUPBD * LSE1 JSB CRLF CLA PROTECT STA PFLAG STORES LSF LDA PM STA EXPM LSF2 CLA FROM TABP. STA TRAC CLEAR TRACE COUNT STA LSE CLEAR FIRST TIME RSS STA $DDT CLEAR JSB ENTRY POINT. STA LFLG LDA O3 STA LL LDA CEND STA UL * LSS CLA FROM LIM SET. STA CHI STA WRD STA CLEFG CLEAR CLE FLAG STA CMFLG CLEAR COMMA FLAG STA INSTR STA ALTMI * LDA CAD SSN STA SGN CLA LSQ STA ONM STA DNM CLA,CLE CLE IS DECORATION. STA SYM STA SYM+R STA LETF STA CHC LDB SYMXI STB SYMX STA WSD MAKE A NO-OP. LSR0 EQU * STA ASCI SKP * LSR EQU * JSB TTYOP ` STA CH CPA O177 JMP DEL LDB LFP CPA O12 JMP LFCRT LDB CRP CPA O15 JMP LFCRT LDB CH ADB DSPP LDB B,I ADA M40 SSA LDB ERRX 0-37, ERROR UNLESS... LDA CH CPA O11 LDB TBP CPA O176 LDA O33 CPA O33 JMP ALTMD STB PN ADA M72 SSA,RSS JMP LT 72-177, CHECK FOR LETTER. ADA O12 SSA JMP LSCG 0-57, NOT NUMBER OR LETTER. JSB BUMP PROCESS DIGIT JMP L1 ASCI NOP M40 OCT -40 M41 OCT -41 M72 OCT -72 O11 OCT 11 O176 OCT 176 O1000 OCT 1000 O3 OCT 3 O32 OCT 32 CRP DEF CR CAD DEF PLUS DSYMX DEF SYMX,I CONFIGURED ON 1ST ENTRY DSPP DEF DSPTB-40B EXPM NOP INSTR NOP LETF NOP LFP DEF LF SGN NOP TBP DEF TAB SKP * LT ADA M41 CHECK FOR LETTER LDB ALTMI CCE,SSA CH42 SEZ,SZB SZB: ALT MODE PRESENT? JMP LSET OPERATOR. ADA O32 SSA JMP LSCG 72-100 * ISZ LETF PROCESS LETTER L ADA O12 MAKE SQOZE CODE L1 INA LDB CHC CPB O3 ISZ SYMX ADB M6 CH125 CLE,SSB,INB,RSS SSB,RSS: MORE THAN SIX CHARS? JMP LSR ISZ CHC ISZ CHI LDB SYMX,I TIMES 50 RBL,RBL ADB SYMX,I BLF,RBR ADB A STB SYMX,I USED AS CONSTANT LDA ASCI ALF,ALF ADA CH JMP LSR0 * LFCRT XOR C3007 SWAP CR AND LF STB PN JSB TYO LDA JSBII ISZ A DELAY TO LET... JMP *-1 C. R. COMPLETE. * LSET ADA M6 72-177 SSA,RSS CHECK FOR 141-177 JMP ERR YES, LOSE. LSCG LDB PN GET DISPATCH ADDRESS ADB LNEV CLA FOR MT,FT CH54 OCT 5254 SSB=RBL,SLB JMP PN,I NO-EVAL, DISPATCH NOW. CPA LETF IF NO LETTERS, nO JMP LSCI ANY OPERAND IS NUMERIC. LDB SYM+R SZB JMP NOTOP SKP OPLK LDB A SEARCH OP TABLE ADB OPPTR LDB B,I GET SYMBOL CPB SYM JMP OPFND INA SZB JMP OPLK * NOTOP JSB EVS EVALUATE SYMBOLIC TERM. JMP SGN,I DEFINED; GO COMBINE TERMS. LDA CH125 U - UNDEFINED JMP ERRP * OPFND ALF,RAR MOVE INDEX TO OP POSN ALF,CLE,SLA,ALF ALWAYS SKIPS: USED AS CONSTANT CPA IADR,I STA INSTR LSCI LDA ONM COMBINE OPERANDS JMP SGN,I PERFORM SIGN OPERATION. SKP * B U M P * * UPDATES CURRENT NUMERIC ENTRY * * LDA * JSB BUMP * P+1 * * BUMP NOP LDB ONM PROCESS DIGIT BLF,RBR SAVE CURRENT ADB A NUMBER AS STB ONM OCTAL LDB DNM SAVE RBL,RBL CURRENT ADB DNM NUMBER RBL AS ADB A DECIMAL STB DNM JMP BUMP,I HED NON-EVALUATION OPERATORS * DOT CPA CHC IF FIRST CHAR, ISZ LETF TREAT AS LETTER. LDB DNM STB ONM LDA O32 BECOMES SQOZE CODE. JMP L * DEL LDA CH130 X JMP ERRP * SYMO LDA O117 SYMBOL TABLE OVERFLOW RSS * BADP LDA CH120 P JSB TYO * ERR LDA O77 ? ERRP JSB TYO OTST LDA TAS REGISTER OPEN? CPA LIMBO JMP LSE NO. JMP TABP YES. * ASCIN LDA ASCI ASCII INPUT JMP N1 * DAQ LDA LWT DEFINE SYMBOL AS ADDRESS JSB ADRC CLEARS E LDA B ELA,SLA,RAR CLEAR SIGN & SKIP * COLON LDA LOCP,I DEFINE SYMBOL AS LOCATION LDB LFLG SZB LDA LL LDB LETF CHECK SYMBOL SZB,RSS U JMP ERR JSB DEFS JMP TABP O117 OCT 117 LWT NOP TAS DEF SYM ADDRESS OF OPEN REGISTER SKP * ALTMD LDA O134 BACKSLASH JSB TYO ECHO LDA O134 IF SET FOR A ESC GOBBLER LDB TMODE THEN SZB JSB TYO SEND TWO '\' 'S * ALT ISZ ALTMI JMP LSR * ECSL LDA TMODE 'U' CHANGE ESC DOUBLE '\' OPTION SZA CLA,RSS CCA STA TMODE JMP OTST * TMODE NOP INITIAL SET FOR NON '\' GRABBER * END OF ESSENTIAL NO-EVALS. * HED MISCELLANEOUS OPERATORS * KILL LDA ISEND KILL SYMBOLS STA STEND JMP LSE * MT INA FT ADA STED JMP N1 * BPM LDA PM STA BM JMP OTST * HT INA CT INA ST INA AT ADA STPPP LDA A,I USED AS CONSTANT STA PM SET MODE STA EXPM JMP OTST * QT LDA LWT JMP N1 * STAR LDA LOCP,I N1 CLB STB ALTMI ISZ CHI JMP LSQ RESET SYMBOL STUFF. * PFIX CCA UNPROTECT STA PFLAG STORES JMP LSF * LNEV DEF * END OF NO-EVALS. BM DEF NUMP STPPP DEF ADRPP LINK TO MASTER MODE TABLE PFLAG NOP PROTECT FLAG SKP * MINUS CMA,INA PLUS ADA WRD JMP WSET * COMMA IOR WRD WSET STA WRD RETURN HERE FROM SIGN OP. LDA PN LDB PN CPB CMADD IF COMMA SET COMMA FLAG STB CMFLG ADB LXEV CH57 OCT 5257 SSB=RBL,SLB. SKIP UNLESS SIGN OP JMP SSN SET SIGN FOR NEXT TIME. * LDA INSTR CHECK FOR PAGE ERROR CSNZA SZA,RSS JMP NAOP NOT ADDRESSABLE. LDA WRD AND G76 PAGE BITS? LDB A SAVE 'EM SZA,RSS JMP NAOP BASE PAGE. XOR IADR AND G76 CSZA SZA JMP BADP YOU CAN'T GET THERE FROM HERE. LDA O2000 PUT IN PAGE BIT. XOR B NAOP XOR WRD z"B@ JMP PORTA YES CPA "PB" PORT B? JMP PORTB YES JMP ERR NO,NOT DEFINED,ERROR USM02 JSB PTAB 6 JSB PTAB SPACES JMP LSF2 "PA" ASC 1,PA "PB" ASC 1,PB "SM" ASC 1,SM "UM" ASC 1,UM "XL" ASC 1,XL O20 OCT 20 O72 OCT 72 SKP USER LDA O72 : JSB TYO LDA USA JMP RMAP GET USER MAPS USE00 CLA SET UP INDEX STARTING AT 0 USE01 JSB SHMAP 2 MAPS CPA O20 DONE? RSS YES JMP USE01 NO,CONTINUE JSB CRLF CR LF JMP USMAP SYSTM LDA O72 : JSB TYO LDA SYA JMP RMAP GET SYSTEM MAPS SKP XLOAD CLA CLEAR STORE FLAG STA XADR CLEAR LAST ADDRESS LDA IMAPS GET SYSTEM MAPS JSB $LIBR ****PROTECT FOR OLD MX'S NOP SYA JSB $LIBX DEF *+1 DEF *+1 X01 JSB CRLF CR LF JSB PTAB 6 JSB PTAB SPACES LDA "XL" X ALF,ALF JSB TYO LDA "XL" L JSB TYO JSB PTAB 3 SPACES JSB GETAD GET ADDRESS FROM OPERATOR JMP ERR INPUT ERROR CPB M1 ABORT? JMP USMAP SEE IF DONE SZB,RSS ANY CROSS OPERATION? JMP X01 NO,NO ACTION STA TEMP1 SAVE STA XADR ADDRESS JSB PTAB 3 SPACES ALF,RAL COMPUTE PAGE ADDRESS RAL AND O37 ADA IMAP LDA A,I GET MAP SSA READ PROTECTED JMP DMCK6 YES, GO TO DM ERROR LDA XADR RESTORE A XLA TEMP1,I CROSS LOAD JSB NUMP NO,DISPLAY CONTENTS JMP X01 SEE IF MORE CROSS OPERATIONS XADR NOP * PORTA LDA O72 : JSB TYO LDA PAA JMP RMAP READ PORT A MAPS PORTB LDA O72 : JSB TYO LDA PBA JMP RMAP GET PORT B MAPS * RMAP STwA RMAP1 LDA IMAPS BUFFER ADDRESS,I JSB $LIBR UNPROTECT FOR OLD MX'S NOP RMAP1 NOP JSB $LIBX DEF *+1 DEF USE00 USA USA SYA SYA PAA PAA PBA PBA O37 OCT 37 SKP * G E T A D * * TAKE AN ADDRESS FROM OPERATOR * * JSB GETAD * P+1 * P+2 * GETAD NOP CLB ASSUME SIGN IS + INITIALLY STB ONM AND CLEAR CHARACTER COUNT STB DNM AND CLEAR OCTAL NUMBER STB CHC AND CLEAR DECIMAL NUMBER GETA5 JSB TTYOP TAKE 1ST CHARACTER CPA "A" ABORT? JMP GETA1 YES CPA "LF" LF? JMP GETA4 YES CPA "^" ^? JMP GETA7 YES CPA SPACE SPACE? JMP GETA5 YES,IGNORE IT RSS NO,TREAT 1ST CHARACTER AS NUMBER GETA2 JSB TTYOP TAKE NEXT NUMBER CPA "CR" DEFAULT? JMP GETA1 YES CPA "/" DONE? JMP GETA3 YES ADA M72 NO,CHARACTER SSA,RSS >71B? JMP GETAD,I YES,ERROR ADA O12 NO,CHARACTER SSA <60B? JMP GETAD,I YES,ERROR JSB BUMP UPDATE NUMBER'S VALUE LDA CHC CHARACTER CPA O5 COUNT ALREADY =5? JMP GETAD,I YES,THIS ONE MAKES IT AN ERROR ISZ CHC NO,BUMP CHARACTER COUNT JMP GETA2 CONTINUE GETA3 LDA ONM A=NUMBER RSS GETA1 CCB,RSS SET ABORT FLAG GETA6 LDB CHC SET UP DEFAULT FLAG ISZ GETAD ADJUST RETURN JMP GETAD,I GETA7 CCB,RSS GETA4 CLB,INB LDA XADR PREVIOUS SZA ADDRESS? JMP GETA8 CLB JMP GETAD,I NO,ERROR GETA8 ISZ CHC CLEAR ABORT FLAG LDA XADR DISPLAY ADA B ADJUST ADDRESS STA XADR JSB NUMP ADDRESS LDA "/" / JSB TYO LDA XADR  A=ADDRESS=NUMBER JMP GETA6 "^" OCT 136 "LF" OCT 012 O5 OCT 05 * ONE NOP LDA O61 PRINT A 1 JSB TYO AND A SPACE LDA CH40 AND RETURN P+2 JSB TYO ISZ ONE JMP ONE,I * ZERO NOP LDA O60 PRINT A 0 JSB TYO AND A SPACE LDA CH40 JSB TYO JMP ZERO,I O60 OCT 60 O61 OCT 61 HED NUMBER AND SYMBOL PRINT SKP * S H M A P * * DISPLAYS 2 MAP VALUES ON CONSOLE * * LDA * LDB * JSB SHMAP * P+1 * SHMAP NOP STA TEMP1 SAVE INDEX JSB CRLF CR LF JSB PTAB 6 JSB PTAB SPACES LDA TEMP1 PRINT MAP LDB O10 REGISTER # JSB PN ON CONSOLE LDA TEMP4 SINGLE ADA M2 CHARACTER SSA,RSS MAP REG. #? JMP SHM01 NO LDA SPACE YES,NEED AN JSB TYO ADDITIONAL SPACE SHM01 LDA "=" = JSB TYO LDA TEMP1 GET MAP ADA IMAP REGISTER LDA A,I VALUE LDB O10 WRITE IT ON JSB PN THE CONSOLE LDA TEMP4 NEGATE # OF CHARACTERS ADA M6 <6 THAT WERE IN THE STA TEMP4 NUMBER JUST DISPLAYED SSA,RSS 6 CHARACTERS? JMP SHM02 YES SHM03 LDA SPACE NO,NEED JSB TYO ADDITIONAL ISZ TEMP4 SPACES JMP SHM03 SHM02 JSB PTAB 3 SPACES LDA TEMP1 PRINT MAP ADA O20 REGISTER #+16 LDB O10 ON CONSOLE JSB PN LDA "=" = JSB TYO LDA TEMP1 GET MAP ADA O20 REGISTER ADA IMAP +16 LDA A,I VALUE LDB O10 WRITE IT ON JSB PN THE CONSOLE LDA TEMP1 LEAVE INA INDEX+1 JMP SHMAP,I IMAPS DEF MAPS,I IMAP DEF MAPS MAPS BSS 32 SKP * G E T N M * * TAKES OPERATOR NUMERICAL INPUT * * LDA * JSB GETNM * P+1 * P+2 * GETNM NOP JSB NUMP DISPLAY OLD VALUE JSB PTAB 3 SPACES GET05 JSB TTYOP TAKE 1ST CHARACTER CLB ASSUME SIGN IS + INITIALLY STB CHC AND CLEAR CHARACTER COUNT STB ONM AND CLEAR OCTAL NUMBER STB DNM AND CLEAR DECIMAL NUMBER CPA "A" ABORT? JMP GET01 YES CPA SPACE SPACE? JMP GET05 YES,IGNORE IT CPA NEG IS IT -? INB YES,SET - FLAG STB NMFLG SAVE + OR - FLAG CPA POS IS IT +? RSS YES SZB NO,1ST CHARACTER TREATED AS 1ST NUMBER? GET02 JSB TTYOP GET CHARACTER CPA "CR" DONE? JMP GET06 YES ADA M72 NO,CHARACTER SSA,RSS >71B? JMP GETNM,I YES,ERROR ADA O12 CHARACTER SSA <60B? JMP GETNM,I YES,ERROR JSB BUMP UPDATE NUMBER'S VALUE LDA CHC CHARACTER COUNT CPA O6 ALREADY = 6? JMP GETNM,I YES,THIS ONE MAKES IT AN ERROR ISZ CHC NO,BUMP CHARACTER COUNT JMP GET02 CONTINUE GET06 LDA ONM A=NUMBER LDB NMFLG NEGATIVE SZB,RSS NUMBER? JMP GET04 NO,POSITIVE,LEAVE IT ALONE CMA,INA,RSS YES GET01 CCB,RSS SET ABORT FLAG ON EXIT GET04 LDB CHC SET UP DEFAULT FLAG ON EXIT ISZ GETNM ADJUST RETURN JMP GETNM,I O6 OCT 6 POS OCT 53 NEG OCT 55 SKP * STORE NOP SZB,RSS ANYTHING TYPED? JMP STORX NO, RETURN. * LDB CLEFG WAS CLE FLAG SET SZB,RSS JMP STORW NO JUST GO STORE IT LDB A AND O2000 YES,WHICH GROUP SZA  ADA O40 SRG CLE=2100B ADA O40 ASG CLE=40B IOR B AND MERGE WITH INSTRUCTION * STORW STA TEMP3 SAVE VALUE LDB PFLAG UNPROTECT SZB THE STORE? JMP STORZ LDA TAS NO CHECK FOR MP SZA A OR B REGISTER CPA O1 JMP STORY YES, STORE IT JSB MPCHK CHECK FOR MP & DM ERROR JMP MPMSG GO PRINT "MP?" STA IADR JSB ADCHK CHECK FOR DBUGR OVERWRITE JMP STORY OK TO STORE STORZ JSB $LIBR YES,GO NOP PRIVELEGED STORY LDB TAS SZB,RSS STORE TO A REG LDB DACCA YES GET PHONY A REG ADDRESS STB TAS LDA TEMP3 RESTORE VALUE LDB ACCB RESTORE B STA TAS,I STB ACCB LDB PFLAG JUST STORE SZB,RSS UNPROTECTED? JMP STORX NO,GO ON JSB $LIBX YES,GO DEF *+1 UNPRIVELEGED DEF STORX STORX LDB LIMBO STB TAS CLOSE REGISTER JMP STORE,I HED BREAKPOINT * BRK SZB USER ENTER ADDRESS? JMP BRK1 YES,SEE IF VALID FOR BREAKPOINT LDA LIMBO NO,USE CURRENT ADDRESS BRK2 STA BPADR SET BREAKPOINT ADDRESS JMP LSE BRK1 STA TEMP4 SAVE ADDRESS JSB MPCHK CHECK FOR MEMORY PROTECT JMP MPMSG GO PRINT ERROR STA IADR JSB ADCHK CHECK FOR DBUGR OVERLAP LDA A,I GET INSTRUCTION JSB AHEAD NO,VALID FOR BREAKPOINT? JMP PR9 NO,DON'T ALLOW IT LDA TEMP4 YES,RESTORE ADDRESS JMP BRK2 * TRAP NOP STA ACCA SAVE A LDA BADD,I GET VALUE TO BE TESTED XOR BVAL TEST VALUE AND BMSK MASK VALUE SZSKP RSS JMP BIXI LDA ACCA ISZ CHC PROCEED COUNT JMP BIX JSB SVST CCA ADA TRAP JSB BRKMS GO DO BREAK MESSAGE JSB PTAB JMP LSF2 G24 OCT &24000 RSS RSS BIXI LDA ACCA JMP BIX SKP * ************************************************************************ * * ROUTINE .SDBG: * * .SDBG PROVIDES A SPECIAL ENTRY POINT TO DBUGR FOR SEGMENTED * PROGRAMS LOADED ON-LINE USING THE RTE-IV RELOCATING LOADER. * THE LOADER INSERTS THE FOLLOWING SUBROTINE(*.STDB*)FROM THE * SYSTEM LIBRARY WITH EACH SEGMENT: * * EXT .SDBG * ENT .DBSG,.STDB * .STDB JSB .SDBG * .DBSG NOP * END .STDB * * THE LOADER PLACES THE ACTUAL ENTRY POINT ADDRESS FOR THE SEGMENT * INTO *.DBSG*. THE SEGMENT'S ID SEGMENT'S ENTRY POINT IS SETUP * TO POINT TO *.STDB*. THIS EFFECTIVELY INSERTS DBUGR JUST BEFORE * ENTRY INTO THE SEGMENT. * * THE MESSAGE 'SEGMENT BREAK' IS PRINTED AND A PSUEDO BREAKPOINT * OCCURS AT THE SEGMENT'S ENTRY POINT ADDRESS. IF * THE CURRENT TRUE BREAKPOINT IS WITHIN THE OLD SEGMENT(E.G., ABOVE * THE MAIN'S LAST WORD), THEN THE MESSAGE 'BREAKPOINT REMOVED' IS * ALSO ISSUED. FINALLY, DBUGR CONTINUES AND GETS THE NEXT * DEBUG COMMAND. * * WHEN A PROCEED COMMAND OCCURS, DBUGR WILL CONTINUE AT THE ENTRY * POINT OF THE SEGMENT. * ************************************************************************ * .SDBG NOP * JSB SVST SAVE STATUS OF SYSTEM. * LDX O5 GET SEGMENT NAME LDA ACCA ADA O14 RAL MAKE BYTE ADDRESS LDB SNAME DESTINATION ADDRESS RBL MAKE BYTE ADDRESS MBF GET NAME FROM SYSTEM MAPS * LDA .SDBG,I STA DDOT SAVE RETURN ADDRESS STA TRAP LDB XB COMPUTE ADDRESS ADB O15 OF 'HIGH MAIN+1'. XLB B,I DETERMINE IF OLD BREAKPOINT IS CMB,INB ABOVE END OF MAIN PROGRAM-- ADB BPADR E.G., WITHIN THE OLD SEGMENT. SSB IF OLD BREAKPOINT IS WITHIN JMP SDBG1 LDB BPADR IF BP IN SEGMENT LDA LIMBO THEN MUST REMOVE STA BPADR LDA OLDBK AND FIX WIPED OUT INSTRUCTION STA B,I * SDBG1 STB SDTMP SAVE OLD BPADR LDA SBNAM IS IT THIS SEGMENT LDB SNAME CMW O3 JMP SDBG4 NOP * LDA SBNM1 LDB SDTMP FETCH OLD BPADR SSB IF BP NOT IN SEGMENT OR CPA M1 DONT STOP FOR ALL SEGMENTS RSS JMP SDBG6 THEN CONTINUE CCA SET SEGMENT BREAK FLAG STA SBFLG * SDBG3 LDA DDOT JSB BRKMS PRINT BREAK MESSAGE JSB CRLF * LDA SDTMP WAS BREAKPOINT REMOVED SSA JMP LSE NO,GO GET NEXT COMMAND JSB ADRP YES,PRINT 'S+XXXXX LDB PNOBK BREAKPOINT REMOVED!' JSB OUTMS JMP LSE AND GET NEXT COMMAND * SDBG4 CCA SET SEGMENT BREAK FLAG STA SBFLG LDA SGA IS THIS A SEGMENT BREAK SZA,RSS JMP SDBG5 YES GO BREAK * LDA SGA,I NO,IS BREAKPOINT LEGAL JSB AHEAD JMP SDBG5 NO ,GO BREAK LDA SGA YES,SET AND LDB BPADR STB SDTMP SET FOR BP REMOVED MESSAGE STA BPADR CPB LIMBO IF SAME AS PREVIOUSLY RSS SET THEN CONTINUE JMP SDBG3 ELSE BREAK SDBG6 JSB RSST RESTORE STATUS JMP TRAP,I * SDBG5 CCA CLEAR BREAKPOINT REMOVED FLAG STA SDTMP JMP SDBG3 GO PRINT SEGMENT BREAK SGA BSS 1 SGB BSS 1 SBFLG OCT 0 SBNAM DEF SBNM1 SBNM1 OCT 0 ASC 2, BYADD BSS 1 BLKBL ASC 1, "]" OCT 135 "B" OCT 102 SDTMP BSS 1 OLDBK BSS 1 O14 OCT 14 * XB EQU 1732B SNAME DEF SNAM1 PSGMS DEF SGMSG SGMSG OCT 6412 CR/LF. ASC 4,SEGMENT SNAM1 ASC 3, ASC 3,BREAK OCT 6412 CR/LF. ASC 1,// * PNOBK DEF NOBKM NOBKM ASC 12, BREAKPOINT REMOVED! OCT 6412 CR/LF. ASC 1,// SKP * <:6 * * THIS ROUTINE SETS UP BREAKPOINT WITHIN * A SEGMENT * SBRK STA SGA SAVE A & B STB SGB SZB,RSS IF ADDRESS SUPPLIED JMP SBRK0 JSB MPCHK CHECK FOR MP VIOLATION JMP MPMSG STA IADR JSB ADCHK CHECK FOR DBUGR OVERLAP SBRK0 LDB SBNAM COMPUTE BYTE ADDRESS RBL STB BYADD LDB BLKBL FILL WITH BLANKS STB SBNM1 STB SBNM1+1 STB SBNM1+2 * LDA M5 SET CHAR COUNT STA SDTMP SBRK1 JSB SBRK6 READ CHAR CPA "]" CHECK FOR END JMP SBRK3 LDB BYADD STORE CHAR SBT ISZ BYADD ISZ SDTMP NAME COMPLETE JMP SBRK1 NO CONTINUE * SBRK2 JSB SBRK6 IGNOR ALL EXCEPT "]" CPA "]" RSS JMP SBRK2 SBRK3 JSB SBRK6 NOW LOOK FOR ESCAPE,\ OR ^ CPA O176 LDA O33 CPA O33 JSB SBRK5 GO SEND BACKSLASH CPA O134 RSS JMP ERR IF NONE OF ABOVE THEN ERROR JSB SBRK6 NOW LOOK FOR "B" J< CPA "B" RSS JMP ERR * * NOW WE HAVE GOOD COMMAND * LDA SBNM1 IF NO NAME ASSUME "0" CPA BLKBL RSS CPA ""N" FIX FIRST WORD FOR ALL CLA CPA ""A" OR NONE CCA STA SBNM1 * LDA SBNAM LDB SNAME CMW O3 JMP SBRK4 GO TO NORMAL BREAK NOP LDB SGB WAS ADDRESS SUPPLIED SZB,RSS STB SGA NO,SET ADDRESS TO ZERO FOR JMP LSE SEGMENT BREAK THEN GO GET * NEXT COMMAND * SBRK4 LDA SGA RESTORE A & B LDB SGB JMP BRK AND GO TO NORMAL BREAK * SBRK5 NOP LDA O134 BACKSLASH JSB TYO ECHO LDA O134 LDB TMODE IF SET FOR ESC GOBBLER SZB JSB TYO SEND SECOND BACKSLASH ISZ SBRK5 ADJUST RETURN JMP SBRK5,I M5 OCT -5 ""N" ASC 1,"N * SBRK6 NOP READS CHAR AND CHECKS FOR RUBOUT JSB TTYOP CPA RUB JMP DEL JMP SBRK6,I RUB OCT 177 * ""A" ASC 1,"A SKP * PROC SZB,RSS CLA,INA $P=$1P CMA,INA STA CHC SET PROCEED COUNT LDB DDOT POINT BACK TO STB TRAP LAST ADDRESS LDB BPADR GET THE TRAP ADDRESS CPB TRAP IF RETURNING TO TRAP JMP PR01 SKIP TEST FOR INA,SZA PROCEED COUNT JMP ERR MUST BE 1 FIRST TIME LDA RSS STA SZSKP LDA ALTMI IF SINGLE ESCAPE CPA O1 JMP PRNA OK TO CONTINUE JMP ERR PR01 LDB SKP GET SKIP (SZA OR SZA,RSS) LDA ALTMI IF SINGLE ESCAPE CPA O1 LDB RSS PUT IN UNCONDITIONAL SKIP STB SZSKP PR3 ISZ TRAP STEP OVER THE INTERPITED INSTR. LDB BKIA STB IADR FOR ADRC LDA BIX02 RESTORE JMP IN CASE STA BIX01 2 WORD INSTRUCTION LDA BKIA,I FETCH BROKEN INSTRUCTION JSB AHEAD $ VALID INSTRUCTION FOR EXECUTION JMP PR5 NO,BACK UP PR1 JSB ADRC CALCULATE REAL ADDRESS JMP MAC NOT ADDRESSABLE: GO TEST FOR MAC GROUP PR0 STA SYMX ACTUAL ADDRESS LDA B RETRIEVE INSTRUCTION AND G74 GET OPCODE CPA G24 IF JMP INSTRUCTION GO JMP TRJMP TEST FOR TRACING CPA JSBI JSB INSTRUCTION? CCB,RSS YES. FAKE IT. JMPI JMP PR2 NOT JSB. LDA SYMX GO GET THE DIRECT ADDRESS JSB DIRA STA OPADD SAVE ADDRESS FOR RETURN CLB,INB CACULATE THE RETURN ADDRESS ADB BKIA STB RTADD SAVE RETURN ADDRESS STB A,I FAKE RETURN ADDRESS INA YES STEP BY ONE TO GET JMP TARGET STA OPADD+1 SAVE TARGET ADDRESS FOR JMP LDB TRAC TRACING? SZB,RSS LDA JSBXQ NO CANGE EFFECTIVE ADDRESS LDB JMPI GET JMP INSTRUCTION JMP PR0 GO SET IT UP PR5 LDA RDWD GET TRACE ADDRESS CPA XE1C EXECUTE MODE? LDA PAC YES STA BKIA RESTORE THE STA IADR ADDRESS JSB CRLF CR LF LDA IADR JSB BRKMS BREAK MESSAGE SKP PR9 JSB PTAB 3 SPACES LDA CH111 I JSB TYO LDA "N" N JSB TYO JMP ERR PR2 IOR DSYMX USING SAVED ADDRESS STA BIX STORE INSTRUCTION PR4 JSB CRLF JSB RSST RESTORE STATUS BIX STA SYMX,I USED TO GET ADDRESS OF SYMX,I BIX01 JMP TRAP,I RETURN TO INTERRUPTED CODE ISZ TRAP INSTRUCTION PERFORMED SKIP BIX02 JMP TRAP,I "N" OCT 116 BKI NOP HOLDS BROKEN INSTRUCTION BKIA DEF SYM ADDRESS OF BROKEN INSTRUCTION JSBI JSB 0 JSBII JSB 0,I * PRNA CPB LIMBO GIVING UP CONTROL? JSB BYE YES, PRINT END MESSAGE JSB CRLF CONTINE JSB RSST JMP DDOT,I * * JSB EXECUTE * JSBXQ DEF *+1 STA ACCA SAVE A REG LDA RTADD STA OPADD,I SET RETURN ADDRESS LDA ACCA RESTORE A REG JMP OPADD+1,I AND EXECUTE JMP * OPADD BSS 2 RTADD BSS 1 SKP * * RESTORE STATUS ROUTINE * RSST NOP LDA BPADR,I SAVE BREAK INSTRUCTION STA BKI LDA LTRAP GET THE TRAP JSB IOR JSBII STA BPADR,I PLANT TRAP * LDB DIDTP RESTORE PROGRAM'S TEMP WORDS STB CRLF TO ITS ID SEGMENT. LDB IDWD1 JSB $LIBR NEED TO GO PRIVILEGED NOP TO DO THIS RESTORE. PR10 LDA CRLF,I RESTORE ID XSA B,I SEGMENT ISZ CRLF WORDS 1 INB TO 5. CPB IDWD6 RSS DONE. JMP PR10 JSB $LIBX LET'S GO DEF *+1 UNPRIVILEGED. DEF *+1 * LDB ACCB RESTORE LDX ACCX MACHINE LDY ACCY STATE LDA FLGBX CLF 1 CLEAR OFLOW O33 SLA,RAR STF 1 TURN IT ON ERA RESTORE E-BIT LDA ACCA JMP RSST,I CH111 OCT 1511 SKP * MAC STA BIX SET INSTRUCTION AND M1100 =B176700 CPA HLT IF A HLT JMP MPMS THEN GO PRINT MP MESSAGE AND M6000 =B172000 CPA HLT IF AN IO INSTRUCTION JMP IO THEN GO CHECK S.C. MAC00 LDA BIX ELSE RESTORE A WITH BIX JSB GET2 2 WORD INSTRUCTION? JMP PR4 NO,GO SET UP INSTRUCTION LDA BKIA YES,SET ADDRESS INA STEP TO MAC ADDRESS RAL,ERA OF SECOND WORD STA BIX01 FOR BIX LDA BIX GET INSTRUCTION CPA JPY JPY? JMP PR6 YES,GO FIX JPY CPA JLY JLY? JMP PR11 YES,GO FIX JLY JMP PR4 NO,GO FINISH THE SET UP PR6 LDY ACCY BE SAFE LDA BIX01 GET 2ND WORD ELA,CLE,ERA ELIMINATE LDA A,I ADDED INDIRECT Q* ADA ACCY FORM DESTINATION ADDRESS JMP PR12 PR11 LDA BKIA SET UP ADA O2 ACTUAL STA ACCY Y LDA BIX01 ELA,CLE,ERA ADA MUPBD TEST FOR DM ERROR SSA,RSS JMP DMCK5 BAD GO PRINT MESSAGE ADA UPBD GOOD SZA,RSS LDA DACCA GET PHONY A REG LDA A,I GET INDIRECT ADDRESS JSB DIRA GET TARGET ADDRESS PR12 LDB TRAC SZB,RSS TRACING? JMP PR2 NO,GO SET UP STA TEMP3 SAVE A JSB CRLF CR LF LDA TEMP3 RESTORE A JMP TRMS SET AND PRINT O2 OCT 2 * IO LDA BIX GET INSTUCTION AND O77 CPA O1 IF S.C. = 1 JMP MAC00 THEN OK JMP MPMS ELSE GO PRINT MP MESSAGE * M1100 OCT 176700 M6000 OCT 172000 SKP * XEC SZB,RSS "EXECUTE" COMMAND JMP ERR LDB TRAP SAVE TRAP INFORMATION STB PAC INCASE WE ARE IN LDB BKIA A BREAK STB ADCK LDB XE1C STB BKIA IF JSB, RETURN TO XE1. STB TRAP OTHERS RETURN TO XE1 JSB AHEAD VALID INSTRUCTION FOR EXECUTION? JMP PR9 NO,NOT ALLOWED STA TEMP2 YES,SAVE INSTRUCTION JSB GET2 2 WORD INSTRUCTION? RSS NO JMP PR9 YES,NOT ALLOWED LDA TEMP2 RESTORE INSTRUCTION JMP XE2 EXECUTE AT BIX * GO SZB,RSS JMP ERR STA TRAP SET ADDRESS LDA BIX02 RESTORE JMP IN CASE STA BIX01 2 WORD INSTRUCTION CLA MAKE A NO-OP XE2 CCB STB CHC PROCEED COUNT=1 JMP PR1 * XE1C DEF XE1 XE1 JMP XE3 NOT SKIP JSB SVST SKIP JSB CRLF RSS * XE3 JSB SVST LDA PAC RESTORE BREAK STA TRAP LDA ADCK CONDITIONS STA BKIA JMP LSE HED BREAKPOINT AND TRACE ROUTINES * ADRC NOP l GET ADDRESS OF INSTRUCTION LDB A AND G70 CLE,SZA,RSS JMP ADRCX NON-ADDRESSABLE. ISZ ADRC SET SKIP RETURN LDA B AND O2000 PAGE BIT SZA LDA IADR GET PROPER PAGE XOR B AND G76 ADRCX XOR B JMP ADRC,I * * A H E A D * * CHECKS INSTRUCTION ABOUT TO BE EXECUTED TO SEE IF * THE INSTRUCTION IS ALLOWED FOR EXECUTION * * LDA * JSB AHEAD * P+1 * P+2 * AHEAD NOP STA TEMP1 AND DSMSK IF DOUBLE SHIFT CPA ASL JMP AHE02 CPA LSL JMP AHE02 CPA RRL JMP AHE02 * AND M6000 OR IOG CPA HLT JMP AHE02 * AND G70 OR MRG SZA JMP AHE02 * LDA TEMP1 OR SRG OR ASG SSA,RSS JMP AHE02 * ELSE CHECK REST LEGAL OPCODES LDB PNT08 POINT TO START OF TABLE AHE01 CPA B,I GOT A MATCH? JMP AHE02 YES, VALID FOR DDT ADB O3 NO,BUMP POINTER CPB PNT09 DONE? JMP AHEAD,I YES,NOT VALID JMP AHE01 NO,CONTINUE * AHE02 LDA TEMP1 RESTORE INTRUCTION ISZ AHEAD ADJUST RETURN JMP AHEAD,I PNT08 DEF RRL+3 LINK TO START OF REST OF VALID'S PNT09 DEF IVINS LINK TO START OF INVALID INSTR'S SKP * BRKMS NOP PRINT BREAK MESSAGE STA DDOT SAVE THE TRAP ADDRESS LDA SBFLG PRINT SEGMENT BREAK? SZA,RSS JMP BRKM1 CLA STA SBFLG CLEAR FLAG LDB PSGMS PRINT 'SEGMENT NAME0 BREAK' JSB OUTMS MESSAGE BRKM1 LDA DDOT RESTORE A JSB ADRP LDA SRDX JSB TYO ( JSB PTAB A FEW SPACES LDA DDOT,I NOW THE INSTRUCTION JSB INSTP IN SYMBOLIC JSB PTAB PUT IN SOME SPACES LDA SRDX INA JSB qTYO ) JSB PTAB MORE SPACES LDA ACCA A REG. JSB BM,I JSB PTAB MORE SPACES LDA ACCB B REG. JSB BM,I JSB PTAB YET MORE SPACES LDA ACCX X REG. JSB BM,I JSB PTAB MORE SPACES LDA ACCY Y REG. JSB BM,I JSB PTAB MORE SPACES LDA FLGBX E,O,INT STA LWT SET LAST WORD TYPED JSB NUMP JMP BRKMS,I SRDX OCT 50 SKP * * B Y E * * PRINTS END MESSAGE * BYE NOP STA TEMP5 SAVE A STB TEMP6 SAVE B LDB SBNM1 IS SEGMENT BREAK SET SZB JMP BYE1 YES,DONT PRINT MESSAGE LDB PNT11 ISSUE 'END DBUG' JSB OUTMS MESSAGE. BYE1 LDA TEMP5 RESTORE A LDB TEMP6 RESTORE B JMP BYE,I TEMP5 BSS 1 TEMP6 BSS 1 PNT11 DEF MSG04 MSG04 OCT 6412 ASC 5,END DBUGR OCT 6412 CR LF ASC 1,// SKP * ******************************************************************* * * SUBROUTINE OUTMS: * * OUTMS WILL OUTPUT A MESSAGE WHICH TERMINATES WITH A '//' AND * CONTAINS NO INTERNAL /'S. * * CALLING SEQUENCE: * LDB POINTER TO FIRST WORD OF MESSAGE * JSB OUTMS * * RETURN: * ALL REGISTERS ARE DESTROYED. * ******************************************************************* * OUTMS NOP CLA INITIALIZE TO LEFT BYTE STA TEMP1 OF MESSAGE STRING. STB TEMP2 SAVE STRING'S ADDRESS. OTMS1 LDA TEMP2,I GET WORD FROM STRING. LDB TEMP1 GET SLB,RSS APPROPRIATE ALF,ALF BYTE. AND O177 MASK OFF CHARACTER. CPA "/" IF FOUND A "/", THEN END JMP OUTMS,I OF MESSAGE, SO RETURN. JSB TYO OTHERWIZE, PRINT LATEST LDB TEMP1 CHARACTER. SLB IF BYTE COUNT IS ODD, THEN ISZ TEMP2 BUMP WORD POINTER. { ISZ TEMP1 INCREMENT BYTE COUNTER JMP OTMS1 AND RETURN FOR MEXT BYTE. SKP * SKP * MPCHK NOP MEMORY PROTECT & DM CHECK JSB DMCHK GO RESOLVE INDIRECTS LDB 1775B CHECK FOR MEMORY PROTECT ERROR CMB,INB SUBTRACT FENCE FROM ADB A ADDRESS SSB,RSS IF OK RETURN +1 ISZ MPCHK JMP MPCHK,I ELSE RETURN * DIRA NOP DIRECT ADDRESS TRACK DOWN JSB MPCHK RSS MP ERROR JMP DIRA,I OK RETURN MPMS CCA BACK OUT THE INTERPIT STEP ADA TRAP RESTORE CONDITIONS CPA TRTN TRACING LDA RDWD YES GET TRACE ADDRESS CPA XE1C EXECUTE INSRT? LDA PAC YES RESTORE STA BKIA RESTORE THE ADDRESS STA IADR JSB CRLF RETURN THE CARRAGE LDA IADR JSB BRKMS SEND A BREAK MESSAGE JSB PTAB SEPERATE THE MP? MPMSG LDA "M" FETCH AN M JSB TYO PUT IT OUT JMP BADP FOLLOW IT WITH A P? DACCA DEF ACCA POINTER TO A-REG CONTENTS SKP * G E T 2 * * SEARCHES DOUBLE WORD INSTRUCTIONS TABLE TO SEE IF * CURRENT INSTRUCTION IS DEFINED THERE. * * LDA * JSB GET2 * P+1 * P+2 <2 WORD INSTRUCTION,A=SQOZE CODE> * GET2 NOP STA TEMP1 SAVE INSTRUCTION LDB PNT07 POINT TO DOUBLE WORD INSTRUCTIONS MAC02 CPB DSTOP DONE? JMP GET2,I YES,GO FINISH THE SET UP ADB O2 POINT TO OPCODE IN SYMBOL TABLE LDA B,I GET OPCODE CPA TEMP1 DOUBLE WORD INSTRUCTION? JMP MAC01 YES,SET UP FOR 2 WORD INSTRUCTION INB NO,POINT TO NEXT ENTRY JMP MAC02 CONTINUE LOOKING MAC01 ADB M2 POINT BACK TO ENTRY LDA B,I GET SQOZE CODE ISZ GET2 ADJUST RETURN JMP GET2,I DSTOP DEF STTP2 LINK TO END OF 2 WORD INSTR SECT{ION PNT07 DEF DOUBL LINK TO 2 WORD INSTR SECTION SKP * SVST NOP STX ACCX SAVE STY ACCY REGISTERS STB ACCB STA ACCA CLA ELA,RAL SAVE E-BIT. SOC OVERFLOW ON? INA YES. STA FLGBX LDA BPADR,I SAVE IN CASE OF SEGMENT LOAD STA OLDBK AND MAY WIPE GOOD INSTRUCTION LDA BKI STA BPADR,I RESTORE BROKEN INSTRUCTION LDA BPADR STA BKIA WHERE BROKEN INSTRUCTION WAS STA IADR FOR PRINT LDA BIXS RESTORE THE DOUBLE WORD INSTRUCTION SZA IF NOT SET UP SKIP STA BIX01 LDA BIX01 SET UP STA BIXS * LDB DIDTP SAVE PROGRAM'S TEMP WORDS STB CRLF FROM ITS ID SEGMENT. LDB IDWD1 SVST5 XLA B,I SAVE ID STA CRLF,I SEGMENT'S ISZ CRLF WORDS 1 INB TO 5. CPB IDWD6 JMP SVST,I DONE! JMP SVST5 BIXS NOP HOLDS COPY OF 2ND WORD BEFORE RETURN IDWD1 EQU 1721B ID SEGMENT WORD 1 IDWD6 EQU 1726B ID SEGMENT WORD 6 DIDTP DEF IDTMP POINTER TO BUFFER FOR SAVING IDTMP BSS 5 ID SEGMENT'S TEMP WORDS. HED TRACE ROUTINE TRACE SZB,RSS MAKE A ZERO CLA,INA INTO A 1 CMA,INA SET NEG FOR STA TRAC COUNT AND SET TRNX LDA DDOT STA IADR JSB ADCHK CHECK FOR DBUGR OVERLAP STA RDWD SAVE TRAP LOCATION STA BKIA SET FOR PROCEED LDA TRTN SET RETURN ADDRESS STA TRAP CCA SET PROCEED COUNT FOR STA CHC POSSIBLE JSB TEST JMP PR3 GO EXECUTE THE INSTRUCTION TRTN DEF * RETURN DEFINATION RSS NO SKIP ISZ RDWD SKIP STEP THE ADDRESS ISZ RDWD TWO TIMES IF SKIP JSB SVST SAVE THE STATE LDA RDWD GET THE NEW ADDRESS TRMS STA BKIA RESTORE CONDITIONS ƛ STA IADR SET ADDRESS FOR PRINT JSB BRKMS WRITE THE BREAK MESSAGE ISZ TRAC END OF TRACE? JMP TRNX NO CONTINUE JSB PTAB 3 SPACES JMP LSF YES GO GET NEXT COMMAND. * TRJMP LDB TRAC TRACING? SZB,RSS JMP PR2 NO GO SET UP JSB CRLF SEND CARRAGE RETURN LINEFEED LDA SYMX YES JUST UP DATE JSB DIRA THE ADDRESS (MAKE DIRECT) JMP TRMS GO SET AND PRINT HED SEARCH ROUTINES * EAS LDA CSKP STA WSD WDS LDA CSZA CH130 CLE,SSA,SLA ALWAYS SKIPS * NWS LDA CSNZA SZB,RSS JMP ERR STA WSTST JSB CRLF LDA LL STA IADR WSL JSB ADCK SEE IF DONE JMP WSIDX IN DEBUG, IGNORE LDA IADR,I WSD NOP SKIP IF EFFECTIVE ADDR. JMP WSC * JSB ADRC JMP WSIDX NOT ADDRESSABLE. JSB DMCK GO RESOLVE INDIRECTS JMP WSIDX TOO MANY INDIRECTS NOP DM ERROR * WSC XOR WRD AND MSK WSTST NOP SZA OR SZA,RSS JMP WSIDX JSB PAC PRINT ADDRESS AND CONTENTS JSB CRLF WSIDX ISZ IADR JMP WSL * * * DM AND MULTIPLE INDIRECT CHECK * * INPUT: A REG=INDIRECT ADDRESS * * OUTPUT: A REG=DIRECT ADDRESS * B REG=ACCB * DMCHK NOP JSB DMCK JMP DMCK3 GO PRINT INDIRECT ERROR JMP DMCK4 GO PRINT DM ERROR JMP DMCHK,I RETURN * * LDA ADDR * JSB DMCK * * * * * OUTPUT: A REG=DIRECT ADDRESS * B REG=ACCB * DMCK NOP LDB M20 SET UP INDIRECT COUNT STB DMCNT LDB ACCB SET UP B REG JMP DMCK1 GO TEST ADDRESS * DMCK0 ISZ DMCNT RSS JMP DMCK,I YES,ERROR 1 RETURN * SZA,RSS TRYING TO USE A REG LDA DACCA YES,GET PHONY A REG ADA MUPBD <:6 TEST FOR UPPER BOUND SSA,RSS (DM ERROR) JMP DMCK2 ERROR RETURN ADA UPBD GOOD THEN CORRECT A LDA A,I AND GET NEXT LEVEL DMCK1 RAL,CLE,SLA,ERA IS IT IN DIRECT? JMP DMCK0 YES,GO GET NEXT LEVEL ADA MUPBD NO,CHECK FOR DM ERROR SSA ISZ DMCK BUMP ONE MORE FOR GOOD DMCK2 ADA UPBD RESTORE A REG ISZ DMCK JMP DMCK,I * "I" OCT 111 M20 OCT -20 DMCNT BSS 1 * DMCK3 LDA "I" JSB TYO PRINT "I?" JMP ERR * * DMCK5 ADA UPBD RESTORE A DMCK4 JSB NUMP PRINT DM? ERROR DMCK6 JSB PTAB SEPARATE "DM?" LDA "D" JSB TYO TYPE "DM?" LDA "M" JSB TYO JMP ERR * "D" OCT 104 MUPBD BSS 1 NEGATIVE OF UPPER BOUND UPBD BSS 1 POSITIVE BOUND * PAC NOP LDA IADR PRINT ADDRESS AND CONTENTS JSB ADRP JSB TYO PRINT / JSB PTAB LDA IADR,I JSB PM,I JMP PAC,I SKP * * CLEAR CORE * ZRO LDB ALTMI ADB M2 SSB JMP ERR LDB LL STB IADR LDA WRD ZROL JSB ADCHK STA IADR,I ISZ IADR JMP ZROL * ADCK NOP CHECK FOR DEBUG OVERLAP STA PN SAVE AC LDA IADR CMA,INA ADA UL CH56 OCT 1256 SSA=RAL,SLA. CLEARS E JMP SOXA DONE, GO RESET LDA IADR CH40 CMA,SEZ E CLEAR: WILL SKIP G70 OCT 70000 LDB A ADA STEND SSA,RSS JMP ADCKR BELOW DEBUG ADB DEBOP SSB,RSS JMP ADCKO IN DEBUG, LOSE LDA IADR TEST IF IN PARTITION JSB DMCHK ADCKR ISZ ADCK BUMP FOR NORMAL RETURN ADCKO LDA PN RESTORE AC JMP ADCK,I RETURN W<* ADCHK NOP JSB ADCK CH53 OCT 1053 RSS=ALS,SLA JMP ADCHK,I JSB PTAB 3 SPACES LDA "T" JSB TYO T JMP BADP "T" OCT 124 HED TAPE OPERATIONS * TABL JSB SOI TABL1 JSB RWDB STA SYM JSB RWDB STA SYM+R AND G70 STA ADCK SAVE FLAGS XOR SYM+R DELETE FLAGS STA SYM+R JSB RWDB LDB ADCK BLF ADB RELTB ADA B,I RELOCATE SYMBOL JSB DEFS JMP TABL1 * LOAD JSB SOI LOA JSB RWDB JSB ADCHK IS ADDRESS OK STA IADR,I STORE JMP LOA * VFY JSB CRLF JSB SOI LDV JSB RWDB JSB ADCK NOP CPA IADR,I COMPARE JMP LDV STORE DONE OR CORE MATCH. SZA,RSS JMP LDV IGNORE ZERO ON TAPE. STA RWDB SAVE TAPE WORD. JSB PAC PRINT DISCREPANCY. JSB PTAB LDA RWDB JSB PM,I JSB CRLF JMP LDV RELTB DEF WRD-1 SKP * SOI NOP LDB SOI INB STB RWDB SOF JSB RDCH INB,SZB,RSS COUNT BLANK TAPE JMP SOX LOTS: END OF FILE. C3007 CMA,INA,SZA,RSS HAVE WE A WORD COUNT? JMP SOF NOT YET. STA CHC JSB RDCH DISCARD ONE FRAME JSB RDWD BLOCK ADDRESS STA CHI INIT CHECKSUM ELA,CLE,ERA MAKE SURE NOT INDIRECT STA IADR * RWDG JSB RDWD LDB A ADB CHI STB CHI JMP RWDB,I RETURN * RWDB NOP ISZ IADR ISZ CHC INDEX WORDCOUNT JMP RWDG JSB RDWD READ CHECKSUM LDB M6 MAX. RECORD GAP CPA CHI JMP SOF CKSM OK, GO TO NEXT RECORD LDA RDCHK BAD CHECKSUM LDB SRDX JSB PN COMPLAIN SOX EQU * SOXA LDA LOCP,I STA IADR JMP LSE SKP * RDWD NOP READ A WORD JSB RDCH ALF,ALF STA CH JSwB RDCH ADA CH JMP RDWD,I * RDCH NOP READ A CHARACTER STB BS SAVE B JSB EXEC GO TO EXEC FOR ONE CHAR. ON 5 DEF RDRTN DEF O1 DEF O2105 DEF BF DEF M1 RDRTN LDA BF GET THE CHAR ALF,ALF AND O377 LDB BS RESTORE B JMP RDCH,I O2105 OCT 2105 O377 OCT 377 RDCHK OCT 50245 SKP PNCH JSB STORE LDA LFLG SZA JMP PCH1 LIMITS SPECIFIED LDA IADR USE CURRENT REGISTER STA LL STA UL PCH1 LDA LL CMA,INA ADA UL SSA JMP LSE DONE AND O77 CMA STA CHC WORDS THIS BLOCK CMA,CCE,INA ALF,ALF JSB PWD WORD COUNT LDA LL STA CHI CHECKSUM JSB PWD ORIGIN PCHL LDA LL,I JSB PWD ADA CHI STA CHI ISZ LL ISZ CHC JMP PCHL JSB PWD CHECKSUM CLA JSB PWD BLANK FRAMES JSB PWD FOR INTER-RECORD GAP JMP PCH1 * PWD NOP PUNCH A WORD STA BF SET WORD JSB EXEC GO TO PUNCH WITH ONE WORD DEF PWRTN DEF O2 DEF O2104 HONEST BINARY DEF BF DEF O1 PWRTN LDA BF RESTORE A JMP PWD,I O2104 OCT 2104 HED SYMBOL TABLE OPERATIONS * DEFS NOP STA RDCH JSB EVS JMP DRDF LDA START CHECK FOR OVER FLOW CMA,INA ADA STEND SSA JMP SYMO OVERFLOW GO BITCH CCB NAKE NEW ENTRY ADB STEND LDA RDCH STA B,I ADB M1 LDA SYM+R STA B,I LDA SYM SSA ADA C1031 ADA M3100 SSA,RSS ADB M1 LDA SYM STA B,I STB STEND JMP DEFS,I * DRDF LDA RDCH FIX OLD ENTRY STA CH,I JMP DEFS,I START DEF END+4 SKP * EVS NOP LDB SYM  IS IT A CLE CPB CLE JMP CLEFD YES GO SET CLE FLAG LDA STEND STA CH EVSL LDA CH CPA STTOP JMP EVSU UNDEFINED. LDB CH,I GET LEFT HALF ISZ CH G74 STB A USED AS CONSTANT SSB ADB C1031 OVERFLOW. ADB M3100 CPA SYM JMP EVSM1 LEFT HALF MATCH. SSB,RSS ISZ CH EVSI ISZ CH JMP EVSL TRY AGAIN. * EVSM1 LDA CH,I SSB CLA,RSS ISZ CH CPA SYM+R JMP EVSF RIGHT HALF MATCHES. JMP EVSI * EVSF LDA CMFLG HAS A COMMA BEEN TYPED SZA,RSS JMP EVSF2 THEN VALUE IS OK LDA ISEXP YES MAKE SURE NOT CMA,INA FIRST ROTATE ADA CH SSA BELOW ROTATES JMP EVSF2 YES THEN OK ADA M60 SSA ABOVE FIRST ROTATES JMP EVSI NO THEN CONTINUE JMP EVSF2 YES RETURN * * EVSU ISZ EVS UNDEFINED: SKIP RETURN EVSF2 LDA CH,I PICK UP VALUE JMP EVS,I * M60 OCT -60 CLEFD STB CLEFG SET CLE FLAG CLA SET VALUE TO ZERO JMP EVS,I * CMFLG OCT 0 CLEFG OCT 0 O40 OCT 40 ISL3I DEF ISL3 M3100 OCT -3100 C1031 CLF 0 STTOP DEF STTP LINK TO END OF SYMBOL TABLE SKP * * SYMBOL TABLE SEARCH * SRCST NOP STA CH SAVE TABLE LIMITS STB TYO LDA C1000 STA DNM STA NUMP SRCL LDB CH CPB TYO JMP SRCST,I DONE, RETURN LDA CH,I SSA ADA C1031 ADA M3100 CLE,SSA,RSS ISZ CH ISZ CH LDA CH,I FETCH SYMBOL VALUE CH45 CMA,SEZ,INA,RSS WON'T SKIP ADA ONM COMPARE SEZ,CLE,RSS JMP SRCI ENTRY TOO BIG, LOSE STA PN LDA B IF >2 CARACTERS INA CPA CH RSS JMP SRCI1 THEN LOOSE LDA PN YES TEST VALUE ADA NUMP CCE,SSA,RSS N JMP SRCI1 AS GOOD OR BETTER ALREADY CH44 CMA,SEZ,INA GOOD MATCH (WON'T SKIP) ADA NUMP STA NUMP UPDATE CLOSENESS LDA B,I SAVE SYMBOL STA SYMP SKP SRCI1 LDA PN CHECK IF BETTER ADA DNM THAN LAST ONE CMA,SSA,INA JMP SRCI NO FORGET IT CLA CLEAR TEMP ",C" FLAG STA CMACT LDA TYO IF SEARCH OF USER TABLE CPA ISEND THEN JMP SRCI2 SKIP LDA C1000 CLEAR SINGLE DEF IF OP-CODE STA NUMP LDA CH,I GET THE VALUE AND ONM MASK CPA CH,I MUST HAVE ALL THE DEFINED RSS BITS ELSE JMP SRCI FORGET SYMBOL SSA IF MAC GROUP GO CHANGE OFFSET JMP SRCI4 XOR ONM OR NOT SAME GROUP AND O6000 SZA JMP SRCI FORGET SYMBOL LDA B,I IF A CPA SEZ SEZ, JMP SRCI3 CPA SLA SLA, JMP SRCI3 CPA SLB OR SLB JMP SRCI3 THEN STOP SEARCH SRCI2 LDA PN OK UPDATE CMA,INA STA DNM LDA CMACT ",C" FLAG STA CMAC LDA B,I AND SAVE THE STA SYM THE SYMBOL INB LDA B,I CPB CH CLA STA SYM+R SRCI ISZ CH JMP SRCL * SRCI3 LDA CH SET END TO NEXT POINTER INA STA TYO JMP SRCI2 AND CONTINUE * SRCI4 AND DSMSK IF DOUBLE SHIFT CPA ASL GO ALLOW O17 OFFSET JMP SRCI8 CPA LSL JMP SRCI8 CPA RRL JMP SRCI8 CPA STF IF STF DONT STRIP C BIT JMP SRCI7 AND O2000 SZA JMP SRCI6 IF NOT IO GROUP * SRCI5 CMA MUST BE EXACT ADA PN SSA,RSS IS IT WITHIN LIMITS JMP SRCI NO FORGET IT LDA CH40 SET TERMINATOR TO SPACE STA TERM JMP SRCI2 * SRCI6 LDA ONM AND sO1000 SET ",C" FLAG STA CMACT IN TEMP VALUE XOR PN REMOVE THE CLEAR FLAG BIT STA PN * SRCI7 LDA O77 JMP SRCI5 * SRCI8 LDA O17 JMP SRCI5 DSMSK OCT 176760 CMAC OCT 0 CMACT OCT 0 TERM OCT 54 O17 OCT 17 C1000 OCT 100000 HED PRINT ROUTINES * ADRP NOP PRINT ADDRESS IN SYMBOLIC STA ASCP ELA,CLE,ERA GET DIRECT ADDRESS STA ONM LDA STEND USER'S SYMBOL AREA LDB ISEND JSB ADRSP OCT 10 LIMIT OFFSET TO 10 LDA ASCP SSA,RSS INDIRECT? JMP ADRPX NO, DONE. LDA CH54 , JSB TYO LDA CH111 I JSB TYO ADRPX LDA CH57 JMP ADRP,I * ADRSP NOP PRINT SYMBOLIC EXPRESSION JSB SRCST SEARCH PART OF SYMBOL TABLE LDA ONM LDB ADRSP,I ISZ ADRSP STEP RETURN ADB DNM CLOSE ENOUGH? SSB,RSS JMP PSYM YES PRINT ABSOLUTE. LDB SYMP GET SINGLE SYMBOL STB SYM AND SET CLB IT UP STB SYM+R LDB NUMP SET VALUE STB DNM CPB C1000 IF NOT DEFINED JMP AABS FORGET IT. PSYM JSB SYMP PRINT BEST SYMBOL LDA DNM SZA,RSS EXACT? JMP PCMAC YES, GO CHECK ",C" LDA CH53 + LDB ADRSP IF INSTRUCTION CPB DINRT THEN LDA TERM PRINT "," OR " " INSTEAD JSB TYO LDB DNM PRINT DIFFERENCE CMB,INB LDA ADRSP GET RETURN ADDRESS CPA DINRT PRINTING NON ADDRESSABLE INSTR? JMP INONB YES GO RECURE AABSS STB A NO SET OFFSET IN A AABS JSB NUMP PCMAC LDA CMAC IS ",C" REQUIRED SZA,RSS JMP ADRSP,I NO, THEN RETURN LDA CH54 JSB TYO PRINT ",C" LDA CH103 JSB TYO CLA CLEAR ",C" FLAG STA CMAC JMP ADRSP,I AND RETURN CH103 OCT 103 DI'NRT DEF INONC SKP * I N S T P * * PRINT SYMBOLIC INSTRUCTION * * LDA * JSB INSTP * INSTP NOP JSB ADRC MRG INSTRUCTION? JMP INOND NO,SEE IF 2 WORD INSTRUCTION STA DNM SAVE REFERENCED ADDRESS LDA B AND G74 GET OPCODE ALF,RAL TO LOW BITS ADA OPPTR INDEX INTO MRG SYMBOL TABLE LDA A,I FETCH OPTAB ENTRY LDB SRDX JSB PN PRINT IT INONE LDA CH40 SPACE JSB TYO LDA DNM FETCH ADDRESS JSB ADRP PRINT ADDRESS JMP INSTP,I INONB LDA ONM SSA IF MAC GROUP JMP AABSS JUST PRINT IT AND O6000 ISOLATE THE GROUP BIT ADB A ADD IT BACK STB ONM NON-ADDRESSABLE. INONA LDA CH54 SET TERMINATOR TO "," STA TERM LDA ISEXP POINT TO LDB STTOP TABLE "ISL2" JSB ADRSP SEARCH INSTRUCTION OCT 1777 INONC JMP INSTP,I INOND STB ONM SAVE INSTRUCTION JSB GET2 2 WORD INSTRUCTION? JMP INONA NO,NON-ADDRESSABLE LDB SRDX YES JSB PN PRINT IT LDA TRAC SZA,RSS TRACING? JMP INSTP,I NO,DON'T PRINT ADDRESS LDA DDOT POINT TO INSRUCTION'S INA ADDRESS PARAMETER LDA A,I GET ADDRESS STA DNM SAVE IT JMP INONE ISEXP DEF ISL2 O6000 OCT 6000 SKP * ENDT EQU * CRLF NOP LDA O15 JSB TYO LDA O12 JSB TYO JMP CRLF,I * END1 BSS 0 PTAB NOP LDA CH40 SPACE JSB TYO LDA CH40 JSB TYO LDA CH40 JSB TYO JMP PTAB,I * ASCP NOP ASCII PRINT STA SYMP ALF,ALF JSB TYO LDA SYMP JSB TYO LDA CH42 ADD A " JSB TYO JMP ASCP,I * SYMP NOP SYMBOL PRINT LDA SYM LDB SRDX JSB PN LDA SYM+R LDB SRDX SZA JSB PN JMP SYMP,I * NUMP NOP NUMBER PRINT LDB RADIX JSB PN LDA CH56 PRINT . LDB RADIX CPB O12 IF DECIMAL. JSB TYO JMP NUMP,I HED NUMBER AND SYMBOL PRINT * PN NOP A=NUMBER, B=RADIX. STA DEFS STB RDWD CMB,INB STB RDCH CLB ENTER: B = NUMBER. PDNC STB ENDT LDB DEFS PDVD STB END1 LDA M20 STA CH CLA PDVL CLE,ELB LONG LEFT SHIFT. ELA ADA RDCH TRIAL DIVIDE SSA,RSS GOES? INB,RSS YES, BUMP QUOTENT ADA RDWD NO, RESTORE ISZ CH ROUND AND ROUND... JMP PDVL WE GO. CPB ENDT QUOTIENT IN B, REM IN A. JMP PDPNT JMP PDVD DIVIDE AGAIN. PDPNT LDB RDWD CPB SRDX ADA M1 ADA M12 SSA SKIP IF LETTER ADA M7 NUMBER FIXUP ADA O101 CONVERT TO ASCII CPA O133 PERIOD? LDA CH56 YES. CPA O134 $ ? LDA CH44 YES. CPA O135 % ? LDA CH45 YES. JSB TYO LDB END1 CPB DEFS JMP PN,I JMP PDNC M7 OCT -7 M12 OCT -12 O133 OCT 133 O135 OCT 135 SKP TYO NOP AND O177 ISOLATE THE CHARACTER STA TTYOP SAVE CHAR. TO BE OUTPUT LDB CCO GET CURRENT CHARACTER COUNT CLE,ERB ADJUST TO WORD OFFSET ADB DBF ADD THE BUFFER ADDRESS SEZ,RSS IF HIGH CHAR. ALF,SLA,ALF ROTATE AND SKIP IOR B,I ELSE ADD IN THE HIGH FORM LAST TIME STA B,I SAVE THE CHAR ISZ CCO STEP THE COUNT LDB TTYOP IF LINE FEED CPB O12 JSB FLUSH FLUSH THE BUFFER LDB CCO IF BUFFER FULL CPB MAXBF THEN JSB FLUSH FLUSH IT LDB ACCB SET B REG FOR REcTURN JMP TYO,I RETURN * FLUSH NOP JSB IFBRK CHECK FOR BREAK DEF *+1 SZA IF ONE JMP LSE TERMINATE CURRENT OP LDA CCO GET COUNT CMA,INA,SZA,RSS IF ZERO JMP FLUSH,I EXIT STA CCO SET CHARACTER COUNT JSB EXEC WRITE THE LINE ON THE TTY DEF RTN01 DEF O2 DEF LU HONEST MODE BINARY DBF DEF BF DEF CCO RTN01 CLA CLEAR THE CHAR. STA CCO COUNT JMP FLUSH,I RETURN SKP * TTYOP NOP JSB FLUSH FLUSH ANY PENDING OUTPUT JSB $LIBR DO INPUT AS DEF TDB REENTRENT JSB EXEC GET ONE CHAR DEF RTN02 DEF O1 FROM SYS TY DEF LU HONEST BINARY ECHO DEF BF DEF M1 ONE CHARACTER RTN02 LDA BF PUT CHAR ALF,ALF IN LOW AND O177 A AND MASK IT LDB TTYOP GET THE RETURN ADDRESS STB TDBRT SET FOR EXIT JSB $LIBX EXIT BACK DEF TDB TO THE CALLER NOP * TDB NOP TDB FOR REENTRENT DEC 4 FOUR WORDS TDBRT NOP RETURN ADDRESS BF NOP BSS 35 MAX BUFFER IS 72 CHAR MAXBF ABS *-BF+*-BF CCO NOP BS NOP HED CONSTANTS,POINTERS,TABLES & VARIABLES OPTAB OCT 115002 NOP - 0 OCT 3 OCT 44216 AND - 10 OCT 100624 JSB - 14 OCT 154204 XOR - 20 OCT 100262 JMP - 24 OCT 75304 IOR - 30 OCT 75554 ISZ - 34 OCT 43373 ADA - 40 OCT 43374 ADB - 44 OCT 52533 CPA - 50 OCT 52534 CPB - 54 OCT 105673 LDA - 60 OCT 105674 LDB - 64 OCT 134773 STA - 70 OCT 134774 STB - 74 OCT 0 DUMMY ADDRESS FOR LOADR SKP M1 OCT -1 M6 OCT -6 O1 OCT 1 O12 OCT 12 O77 OCT 77 O101 OCT 101 "A" EQU O101 O134 OCT 134 O177 OCT 177 TRAC640 NOP TRACING FLAG WRD NOP LL NOP UL NOP LU OCT 2501 ACCA NOP ACCB NOP CH NOP CHI NOP SYMXI DEF SYM SYMX NOP SYM OCT 0,0 ONM NOP DNM NOP CHC NOP ALTMI NOP LFLG NOP LIMBO EQU SYMXI IADR NOP RADIX OCT 10 PM DEF INSTP ISEND DEF ISL LOCP DEF LOC STED DEF STEND OPPTR DEF OPTAB ADRPP DEF ADRP MASTER MODE TABLE - MODE INSPP DEF INSTP IS SET BY INDEXING INTO NUMPP DEF NUMP THIS TABLE AND PICKING ASCPP DEF ASCP UP POINTER FOR DISPATCHING * DEBOP DEF *+1 FIRST WORD WICH CAN BE MODIFIED * CEND OCT 77777 DO NOT MOVE DEF END THESE VALUES!!!!!!!!!!!!!!!!!! LTRAP DEF $TRAP ADDRESS OF BP POINTER TO "TRAP" STEND DEF ISL "F" MSK OCT 177777 "M" FLGBX NOP "M+1" O,E AND INTERRUPT STATUS BPADR DEF SYM "M+2" BP ADDRESS 2 ACCX NOP "M+3" CONTENTS OF X REGISTER ACCY NOP "M+4" CONTENTS OF Y REGISTER BVAL NOP "M+5" BREAKPOINT COMPARE VALUE BMSK OCT 177777 "M+6" BREAKPOINT MASK BADD NOP "M+7" REG OR MEMORY TO BE TESTED SKP SZA "M+8" SENSE OF TEST SZA =,SZA,RSS /= ORB PLANT A DEF ON THE BASE PAGE $TRAP DEF TRAP ADDRESS OF TRAP FOR JSB ORR ONLY NEED ONE WORD * * END DBUGR >%6 /L 92067-18076 1805 S C0122 &STDB4 RTE-IV .STDB ROUTINE             H0101 ASMB,L,C HED .STDB ROUTINE * SOURCE: 92067-18076 * RELOC: PART OF 92067-16035 * PGMR: D.L.S. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** NAM .STDB,7 92067-16035 REV.1805 771107 ENT .STDB,.DBSG EXT .SDBG SUP * * THIS PIECE OF CODE IS APPENDED TO EACH SEGMNET OF A SEGMENTED * PROGRAM LOADED WITH THE RTE-IV LOADER USING THE 'DB'(DEBUG) * COMMAND. THE SEGMDENT'S PRIMARY ENTRY POINT CONTAINED IN ITS * ID SEGDMENT IS SET TO *.STDB*. THE LOADER WILL STORE THE * TRUE PRIMARY ENTRY POINT OF THE SEGDMENT IN *.DBSG*. THE * DEBUG SUBROUTINE *DBUGR*, WHEN ENTRED FROM *.STDB*, WILL * EXECUTE A PSUEDO BREAK. IT WILL THEN RETURN TO THE SEGMENT'S * PRIMARY ENTRY POINT WHENEVER THE USER ENTERS THE '/P' COMMAND. * ****************************************************************** * .STDB JSB .SDBG SEGMENT ENTERED HERE. .DBSG NOP LOADER STORES TRUE ENTRY POINT HERE. END .STDB ] # 92067-18077 1805 S C0122 &IDGET4 RTE-IV IDGET SUBROUTINE             H0101 5|ASMB,R,L,C HED "IDGET" FTN/SPL FUNCTION TO FIND IDSEG ADDRESS OF PROG * SOURCE: 92067-18077 * RELOC: 92067-16035 * PGMR: D.L.B.,C.M.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** NAM IDGET,6 92067-16037 REV.1805 771227 ENT IDGET EXT .ZPRV * CALLED: * IDSEG = IDGET(NAME) * WHERE: * NAME = THREE WORD ASCII (5 CHARS) BUFFER WITH NAME OF PROG * IDSEG = THE ID SEGMENT ADDRESS OF THE NAME * RETURN: * A-REG = ID SEGMENT ADDRESS OF NAME IF FOUND OR = 0 IF NOT FOUND * E-REG = 0 IF NAME FOUND OR = 1 IF NOT FOUND. * B-REG = 0 * (I BELEAVE THAT THIS ROUTINE IS COMPATABLE WITH ID.A) * NOTE: IF NAME IS NULL THEN FIND BLANK IDSEG ADDRESS. SPC 1 IDGET NOP ENTRY FTN CALLING SEQUENCE JSB .ZPRV DO THE $LIBR THING DEF LIBX ISZ IDGET AVOID .ENTR,.DFER LDB IDGET GET NAME ADDRESS LDB B,I GET NEXT LEVEL RBL,CLE,SLB,ERB TRACK DOWN INDIRECTS JMP *-2 STB NAME AND SAVE FOR LATER USE INB BUMP TO 2ND WORD IN NAME STB NAME+1 SAVE ADDRESS OF NAME(2) INB BUMP TO LAST CHAR LDA B,I PICK UP AND OM400 NULL LAST CHAR STA NAME+2 SAVE VALUE OF NAME(3) LDB KEYWD GET KEYWORD POINTER ON BASE PAGE STB POINT SAVE TEMP RSS SKIP THE ISZ 1ST TIME LOOP ISZ POINT BUMP TO NEXT IDSEG ADDRESS XLB POINT,I GET IDSEG ADD OF NEXT PROG CCE,SZB,RSS CHECK IF LAST ENTRY JMP ENDTA YES, NOT FOUND PROGRAM ADB D12 POINT TO PROGRAM NQ  AME AREA XLA B,I GET CHARS 1 & 2 CPA NAME,I EQUAL ? INB,RSS YES, CHECK NEXT 2 JMP LOOP NO, TRY NEXT PROGRAM XLA B,I GET CHARS 3,4 CPA NAME+1,I EQUAL? INB,RSS YES, BUMP AGAIN JMP LOOP NO, TRY NEXT PROGRAM XLA B,I GET LAST CHAR AND OM400 MASK TO 5TH CHAR CPA NAME+2 CLB,CLE,RSS FOUND!!!! JMP LOOP TRY NEXT PROG ENDTA XLA POINT,I RETURN A= IDSEG ADDRESS ISZ IDGET SET RETURN POINT E=FOUND FLAG LIBX JMP IDGET,I P+3 DEF IDGET FOR JSB $LIBX SPC 1 NAME REP 3 NOP POINT NOP OM400 OCT -400 D12 DEC 12 KEYWD EQU 1657B B EQU 1 END %  % 92067-18078 1805 S C0322 &4SMP1 RTE-IV SPOOL MONITOR PROGRAM             H0103 GASMB,L,C,Z ASSEMBLY STATEMENT FOR RTE IV * HED SMP ROUTINE * NAME: SMP * SOURCE: 92067-18078 * RELOC: 92067-16028 * PGMR: A.M.G. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * IFN NAM SMP,2,30 92002-16002 REV. 1740 770908 XIF * IFZ NAM SMP,18,30 92067-16028 REV.1805 771115 XIF * * * * SSTAT STATES * * 0 NORMAL * 1 SPOUT IS WORKING ON A MENU * * EXT .DFER THREE WORD MOVE ROUTINE EXT REIO I-O ROUTINE EXT .MVW MOVE WORDS ROUTINE EXT RMPAR RETRIEVE PARAMETERS EXT SP.CL SPOUT CLASS ID EXT $LUAV SPOOL LU TABLE EXT .IS43 IN SP.CL HAS ADDR OF IS43 IN DVS43 EXT $LUSW LU TRANSFORM TABLE EXT .DRCT PICK UP DIRECT ADDRESS EXT $LIBR GO PRIVILEGED EXT $LIBX SUSPEND PRIVILEGED OPERATION EXT READF FMGR READ EXT WRITF FMGR WRITE EXT EXEC SYSTEM CALLS EXT PRTN PASS PARAMETERS TO CALLER EXT RNRQ RESOURCE NUMBER CONTROL EXT POST POST FILE BUFFERS A EQU 0 B EQU 1 XEQT EQU 1717B SUP HED SMP CALL PRAMS * PRAMS P1 THRU P5 DESCRIBE THE FUNCTION TO PREFORM * AS FOLLOWS: * * P1 =0 SET UP CALL REQUIRES A 16 WORD CLASS BUFFER * P2 =CLASS NUMBER * P3 =BATCH CHECK FLAG (ID ADDRESS OF PRIV. PROGRAM OR ZERO) * * P1 =1 CHANGE PURGE TO SAVE ON AN EXISTING FILE * P2 =LU ASSIGNED LU OR IF BATCH THE SWITCHED LU MAY BE USED * * P1 =2 CHANGE SAVE TO PURGE * P2 =LU  ASSIGNED LU OR IF BATCH THE SWITCHED LU * * * P1 =3 PASS THE FILE TO OUT SPOOL * P2 =LU ASSIGNED OR SWITCH IF IN BATCH * * * P1 =4 CLOSE AND PASS THE FILE * P2 =LU ASSIGNED OR SWITCH IF IN BATCH * * * P1 =5 CHANGE LU AND OR PRIORITY OF OUT SPOOL * P2 =LU ASSIGNED OR SWITCHED IF IN BATCH * P3 =NEW OUT LU * P4 =NEW PRIORITY * * * P1 =6 SET BUFFERED FLAG * P2 =LU ASSIGNED OR SWITCHED * * * P1 =7 CLEAR BUFFERRED FLAG * P2 =LU ASSIGNED OR SWITCHED * * * P1 =8 GET CURRENT POSITION OF FILE * P2 =LU ASSIGNED OR SWITCHED * * * P1 =9 CHANGE POSITION OF FILE * P2 =LU ASSIGNED OR SWITCHED * P3 =POSITION PRAMETER 1 * P4 =POSITION PRAMETER 2 * P5 =POSITION PRAMETER 3 * * * P1 =10 SPOUT CAN NOT OUT SPOOL BECAUSE OF FAILURE * OF LULOCK REQUEST * * * * P1 =11 SPOUT CAN BEGIN OUT SPOOL * P2 =LU SELECTED FOR OUT PUT * * * P1 =12 DEQUEUE OUT SPOOL (SPOUT IS DONE) * P1 =12 DEQUEUE OUT SPOOL (SPOUT IS DONE) * P2 =LU ASSIGNED LU OF FILE * P3 = #0 IF A BAD EOF FOUND ELSE 0 * * * P1 =13 KILL SPOOL * P2 =SPLCON RECORD NUMBER OF FILE TO KILL * P3 =LU ASSIGNED FROM WORD 1 OF RECORD * P4 =0 * P5 =CURRENT STATUS OF FILE * * * P1 =14 HOLD A OUTSPOOL FILE * P2 =SPLCON RECORD NUMBER OF FILE * P3 =OUTSPOOL LU (CURRENT) * P4 =0 * P5 =CURRENT STATUS SPLCON RECORD WILL SHOW 'H' * * * P1 =15 RELEASE A HOLD * P2 =SPLCON RECORD NUMBER OF FILE * P3 =CURRENT OUT SPOOL LU * P4 =NEW LU OR 0 CAN CHANGE LU ON RELEASE * P5 =CURRENT STATUS OF FILE * * * P1 =16 SHUT DOWN OUTSPOOLING * * * P1 =17 START UP OUT SPOOLING * * * P1 =18 CALL FROM 5SPOUT A LU IS DOWN * P2 =LU CURRENT ASSIGNED LU SKP SKP DTAB DEF CPTS 1 CHANGE PURGE TO SAVE. DEF CSTP 2 CHANGE SAVE TO PURGE. DEF PASS 3 PASS NOW DEF CSAP 4 CLOSE SPOOL AND PASS DEF MPI 5 MODIFY PASS INFORMATION DEF SBF 6 SET BUFFER FLAG DEF CBF 7 CLEAR BUFFER FLAG DEF GCDP 8 GET CURRENT DISK POSITION DEF CSRP 9 CHANGE STARTING RECORD POSITION DEF LULOK 10 LU LOCK CONDITION IN SPOUT DEF SPSEL 11 SPOOL SELECTION BY SPOUT DEF DEQUX 12 DEQUEUE OUTSPOOL. DEF KILL 13 KILL SPOOL DEF HOLD 14 HOLD A SPOOL FILE DEF RELSE 15 RELEASE A HOLD. DEF SHUT 16 SHUT DOWN OUTSPOOLING. DEF STUP 17 START UP OUTSPOOLING. DEF DVCDN 18 I/O DEVICE DOWN SET HOLD * * JOBFL BSS 2 HOLDS FIRST 16 WORDS OF JOBFIL DCB OCT 2 BSS 3 DEC 16 OCT 100201 BSS 5 OCT 0,200,0 SPLFL BSS 2 HOLDS FIRST 16 WORDS OF SPLCON DCB OCT 2 BSS 3 DEC 16 OCT 100201 UP DATE WRITE OK 128 WORD DCB BSS 5 OCT 0,200,0 * DCB1 BSS 144 BUF21 BSS 16 HOLDS SPLCON #1 MOSTLY BUF22 BSS 16 HOLDS SPLCON #2 AND #3 MOSTLY BUF23 BSS 16 HOLDS CURRENT SPLCON FILE RECORD MOSTLY BUF24 BSS 16 HOLDS JOB RECORD #17 AND USED TO CHECK Q BLOCKS BUF25 BSS 62 HOLDS JOB RECORD FROM JOBFIL ALSO MENU MOSTLY LIMIT BSS 2 * * ALL BUFFERS ARE USED TO HOLD THE LU Q AT TIMES * * ORG DCB1 INITIALIZE CODE IS IN THE BUFFERS * * SMP JSB RMPAR DEF *+2 DEF PARM1 LDA XEQT GET MY ID ADDRESS STA JOBFL+9 SET THE OPEN FLAGS STA SPLFL+9 IN THE DCB SAVE AREAS CCE SET THE SIGN BIT RAL,ERA AND STA IID,I AND SAVE FOR NOW AND LATER JSB EXEC CALL D.RTR TO LOOK UP JOB FILE DEF *+7 DEF D23 DEF D.RTR IID DEF ID DEF JOBNA FILE NAME (NON-EXCLUSIVE) DEF JOBNA+1 DEF JOBNA+2 LDA B,I IF ERROR SSA THEN JMP BAIL GO BAIL OUT * STA JOBFL+5 SET THE FILE SIZE INB STEP TO THE DIRECTORY ADDRESS WORDS LDA B,I AND SET THEM STA JOBFL INB LDA B,I IN STA JOBFL+1 IN THE DCB IMAGE INB NOW THE TRACK ADDRESS LDA B,I STA JOBFL+3 INB NOW THE LDA B,I SECTOR AND X377 STA JOBFL+4 XOR B,I ALF,ALF STA JOBFL+8 SET THE SEC/TRACK WORD JSB EXEC CALL D.RTR TO LOOK UP SPOL FILE DEF *+7 DEF D23 DEF D.RTR DEF ID DEF SPLNA FILE NAME (NON-EXCLUSIVE) DEF SPLNA+1 DEF SPLNA+2 LDA B,I IF ERROR SSA THEN JMP BAIL GO BAIL OUT * STA SPLFL+5 SET THE FILE SIZE INB STEP TO THE DIRECTORY ADDRESS WORDS LDA B,I AND SET THEM STA SPLFL INB LDA B,I IN STA SPLFL+1 IN THE DCB IMAGE INB NOW THE TRACK ADDRESS LDA B,I STA SPLFL+3 INB NOW THE LDA B,I SECTOR AND X377 STA SPLFL+4 XOR B,I ALF,ALF STA SPLFL+8 SET THE SEC/TRACK WORD JMP SMP0 GO CONTINUE THE SET UP * BAIL JSB FILER REPORT THE ERROR AND JMP RETN4 EXIT * X377 OCT 377 * TS EQU BUF21-* IF ERROR WE RAN OUT OF THE DCB * ORG BUF21 GET OUT OF THE DCB SO IT CAN BE USED * * SMP0 LDB DDCB1 LDA PTRJ SET UP TO ACCESS THE JOB FILE JSB .MVW DEF D16 NOP LDB X17 GET THE JOB FILE RN LDA PTX21 JMP SMP00 BAIL OUT OF THIS BUFFER * ORG BUF22 SAFE GROUND * SMP00 JSbNB RDREC READ JOBFILE RECORD 17 JMP RETN4 IF ERROR GET OUT * LDA BUF21 GET THE RN STA DJRN,I SAVE IT JSB .DRCT GET IS43 ADDRESS FOR DEF .IS43 FOR FUTURE EQT CHECKING. LDA A,I STA IS43A SAVE THE ADDRESS. JSB .DRCT GET ADDRESS OF DEF $LUAV $LUAV TABLE AND SAVE. STA LUAVA LDB DDCB1 SET UP TO ACCESS THE SPOOL CONTROL FILE LDA PTRS JSB .MVW DEF D16 NOP * LDA PTX21 GET FIRST SPLCON RECORD. CLB,INB TS1 EQU *-BUF21-16 IF ERROR THEN CODE WILL BE OVERLAYED JSB RDREC JMP RETN4 ERROR EXIT * LDA PTX23 LDB X3 JMP SMP01 GET TO HIGH GROUND * ORG BUF24 GET OUT OF THE BUFFER * SMP01 JSB RDREC READ SHUT DOWN WORD. JMP RETN4 EXIT IF ERROR * LDA BUF21 STA SRN SAVE SPLCON RESOURCE #. LDA BUF23 SAVE CURRENT SHUT DOWN CONDITION. STA SHUTX,I LDA BUF23+1 SAVE HOLD RN. STA WRN JSB .DRCT INITIALIZE THE MENU. DEF BUF21+6 POINTER TO LU AREA STA TEMX1 LDA MPTRX POINTER TO MENU STA TEMX2 CONTAINS LU-#FILES ON QUE LDA X9 SMP2 STA TEMX3 LDA TEMX2,I SZA,RSS MUST GO THROUGH ALL THE OUTSPOOL JMP SMP4 QUEUES PICKING UP THE NUMBER * LDB TEMX1,I OF OUTSPOOLS WAITING ON EACH STB TEMX2,I ONE. THIS WILL ENABLE A ISZ TEMX2 START-UP TO PICK THEM UP. SZB,RSS JMP SMP5 * LDA PTX23 LDB TEMX3 READ IN THE BEGINNING JSB RDREC OF A QUEUE BLOCK. JMP RETN4 * LDB BUF23+1 GET COUNT OF OUTSPOOLS. SMP5 STB TEMX2,I ISZ TEMX2 STEP MENU ADDRESS ISZ TEMX1 STEP LU LIST ADDRESS LDA TEMX3 STEP RECORD ADDRESS ADA X8 BY 8 JMP SMP2 AROUND WE GO * SMP4 LDA SP.CL CHECK IF CLASS HAS BEEN SZA e ALLOCATED FOR SPOUT. IF SO, JMP SMP1 DON'T DO IT AGAIN. * JSB EXEC ALLOCATE CLASS FOR DEF *+5 SPOUT REQUESTS. DEF X19 DEF ZERO DEF ZERO DEF SP.CL LDA SP.CL GET THE CLASS AND IOR B20K SET THE DON'T RELEASE STA SP.CL BIT JMP SMP1 * X3 DEC 3 DDCB1 DEF DCB1 B20K OCT 20000 SHUTX DEF SHUTD X8 DEC 8 X19 DEC 19 X17 DEC 17 X9 DEC 9 JOBNA ASC 3,JOBFIL SPLNA ASC 3,SPLCON PTRJ DEF JOBFL PTRS DEF SPLFL PTX21 DEF BUF21 PTX23 DEF BUF23 MPTRX DEF .MENU TEMX1 NOP TEMX2 NOP TEMX3 NOP DJRN DEF JRN TS3 EQU LIMIT+2-* IF ERROR CODE GOES BEYOND BUFFER ORR * SMP1 JSB EXEC SCHEDULE SPOUT WITHOUT WAIT DEF *+3 AND IGNORE THE RESPONSE DEF D10 FROM EXEC. DEF SPOUT JSB POST MAKE SURE WE'RE SET DEF *+2 FOR NEW RECORDS TO BE DEF DCB1 READ CLEAN FROM DISK. JSB LOCK LOCK THE SPLCON RN. DEF SRN LDA PTR21 CLB,INB JSB RDREC NOP ********************************************** LDA PARM1 WHAT TYPE OF REQUEST? SZA,RSS JMP SETUP NEW SETUP. * CPA D18 IF DOWN DEVICE JMP USEOR GO GET THE RECORD * CPA D12 JMP USEOR DEQUEUE. * ADA M10 SSA,RSS JMP CJUMP GASP OR SPOUT REQUEST. * LDA XEQT MUST BE IN BATCH MODE TO ADA D20 USE THE SWITCH TABLE LDA A,I GET THE FLAG SSA,RSS IF NOT IN BATCH JMP USEOR USE THE GIVEN LU * JSB .DRCT MODIFICATION. DEF $LUSW MUST GO THROUGH $LUSW LDB A,I TABLE TO SEE IF WE CMB,INB MUST TRANSLATE THE GIVEN STB TEMP2 LU #. THE ACTUAL SPOOL INA LU IS THE ONE NEEDED STA TEMP1 TO LOOK UP IN THE LOOP6 LDA TEMP1,I SPOOL LU AVAILABILITY SSA 1 TABLE. JMP LOOP7 * AND B77 INA CPA PARM2 JMP AFIND * LOOP7 ISZ TEMP1 ISZ TEMP2 JMP LOOP6 * JMP USEOR DIDN'T FIND. USE LU GIVEN. * AFIND LDA TEMP1,I ALF,ALF AND B77 INA STA PARM2 USEOR JSB FLU SEARCH LU AVAILABILITY JMP MENU CAN'T FIND. * * LDB TEMP1,I SAVE CORRESPONDING RECORD SZB,RSS (IF NOT ASSIGNED JMP MENU SKIP OUT) * STB RECNO # OF SPLCON RECORD. LDA PTR23 JSB RDREC READ THE APPROPRIATE RECORD. JMP RETRN READ ERROR. * CJUMP CCA IS THE REQUEST ADA PARM1 PARAMETER VALID? SSA JMP MENU ILLEGAL REQUEST PARAMETER. * STA B ADB M18 SSB,RSS JMP MENU ILLEGAL REQUEST PARAMETER. * ADA RTAB BRANCH TO APPROPRIATE JMP A,I SERVICE ROUTINE * FLU NOP ROUTINE TO FIND LU IN LUAV LDB LUAVA SEARCH LU AVAILABILITY LDA B,I SZA,RSS JMP FLU,I CAN'T FIND. * STA TEMP2 LOOP5 INB LDA B,I AND B77 INB CPA PARM2 DOES THE LU MATCH JMP FOUND THE ONE GIVEN? * ISZ TEMP2 JMP LOOP5 * JMP FLU,I NOT FOUND * FOUND ISZ FLU FOUND STEP ADDRESS STB TEMP1 SET ADDRESS FOR LATER JMP FLU,I AND EXIT * RTAB DEF DTAB,I REQUEST TABLE. LUAVA BSS 1 D20 DEC 20 M10 DEC -10 D18 DEC 18 M18 DEC -18 * CSTP CLE,RSS CHANGE SAVE TO PURGE. * CPTS CCE CHANGE PURGE TO SAVE. LDA BUF23+8 ERA,RAL STA BUF23+8 WRTRC LDA PTR23 WRITE OUT SPOOL CONTROL LDB RECNO RECORD. JSB WTREC JMP MENU * * PASS LDB BUF23+8 BATCH INPUT? RBL SSB JMP MENU YES - ILLEGAL REQUEST. * LDA BUF23+15 IF NO LU SZA,RSS THEN JMP MENU IGNOR * LDB BUF23+8 WAS THE FILE BEING RBR,SLB HELD UNTIL CLOSE. JMP PCHK1 YES - WE ARE OK. * JMP MENU NO - FILE WILL HAVE BEEN PASSED. * * CSAP LDA PARM2 CALL SMD TO POST ANY XOR B3700 REMAINING BUFFERS TO THE STA TEMP2 SPOOL FILE AND-OR CLEAR LDA BUF23+15 IS FILE IS TO BE PASSED SZA,RSS NO SKIP JMP CPST THE LU CLEAR * CLA CLEAR THE REC. NUMBER IN CASE SPOUT LDB TEMP1 HAS CAUGHT UP JSB PUT WILL DO THE WHOLE THING AFTER THE POST CPST JSB EXEC IN-CORE INDICATORS. DEF *+5 DEF D1 DEF TEMP2 DEF BUF21 DEF D16 * LDA BUF23+15 IS FILE TO BE PASSED?? SZA WELL? JMP PCHK YES GO PASS IT * BATIN JSB PRGEX CLOSE THE FILE JMP MENU GO CHECK THE MENU * * PCHK LDB TEMP1 GET LUAV ADDRESS JSB FRELU FREE THE LU AND EQT LDA BUF23+8 WAS IT PASSED BEFORE? RAR,SLA IS HOLD BIT SET? RSS JMP MENU YES. * PCHK1 LDA BUF23+8 REMOVE HOLD BIT. IOR D2 SET JUST IN CASE XOR D2 NOW CLEAR IT STA BUF23+8 JMP QUEUE GO SET IT UP * "W" OCT 127 * MPI LDA PARM4 SAVE NEW PRIORITY IF SZA,RSS IF GIVEN. JMP MPI1 * SSA,RSS STA BUF23+9 MPI1 LDA BUF23+15 SAVE OLD LU. STA TEMP2 LDA PARM3 GET NEW LU STA PARM4 IF GIVEN. SZA SKIP IF NOT GIVEN STA BUF23+15 JSB SMENU CHECK VALIDITY. JMP MPIER NEW LU NOT GOOD. * LDB BUF23+10 IF SPOOL IS ACTIVE, CPB "A" WE CAN PERFORM JMP MPIER THIS OPERATION. * CLB STB TEMP1 LDA TEMP2 IF NO OLD LU, SZA,RSS WRITE RECORD AND JMP SS4 QUEUE IF NEEDED NOW. * LDB BUF23+8 REQUEUE UNLESS THE RBR,SLB FILE IS BEING HELD JMP SS4 FROM THE QUEUE * STA BUF23+15 LDA PTR23 WRITE THE CURRENT RECORD LDB RECNO TO THE SPLCON FILE JSB WRTRC CCE SET TO SHOW NOT ACTIVE JMP DEQ18 UNTIL IT IS CLOSED. * MPIER LDA TEMP2 STA BUF23+15 LDA M21 STA TEMP1 JMP WRTRC * SBF JSB FEQT SET BUFFERED FLAG IN EQT. ADB D3 LDA BUFRD JSB PUTM JMP MENU * PTR21 DEF BUF21 PTR23 DEF BUF23 D3 DEC 3 D12 DEC 12 BUFRD OCT 40000 * CBF JSB FEQT CLEAR BUFFERED FLAG IN EQT. ADB D3 LDA BUFRD SET BIT TO BE CLEARED CLE SET THE CLEAR FLAG JSB PUTM CLEAR THE BIT JMP MENU * SETEQ NOP SUB TO SET EQT ADDRESSES JSB FEQT GET CURRENT DISK POSITION. ADA D2 ADDRESS OF EQT18 (CURRENT TRACK) STA TEMP5 SAVE IT ADA D2 STEP TO EQT20 (EXTENSION NUMBER) STA TEMP2 AND SAVE IT INA NOW EQT21 (CURRENT SECTOR) STA TEMP1 SAVE IT ADA D3 EQT24 (FIRST TRACK OF EXTENT) STA TEMP3 SAVE IT INA EQT25 (FIRST SECTOR OF EXTENT) STA TEMP4 SAVE IT INA EQT26 (FILE SIZE) STA DFSIZ SAVE ADDRESS OF FILE SIZE ADA D4 EQT30 (# SECTORS/TRACK) STA D#PTR SAVE IT JMP SETEQ,I RETURN * GCDP JSB SETEQ SET THE EQT ADDRESSES LDA TEMP3,I GET THE BASE TRACK CMA,INA SUBTRACT FROM ADA TEMP5,I CURRENT TRACK MPY D#PTR,I TIMES #/TRACK D#PTR EQU *-1 LDB TEMP4,I GET BASE SECTOR CMB,INB AND SUBTRACT ADA B IT THEN ADA TEMP1,I ADD CURRENT SECTOR A=SECTOR OFFSET STA TEMP1 IN CURRENT EXTENT LDA TEMP2,I GET EXTENT MPY DFSIZ,I TIMES EXTENT SIZE = SECTOR OFFSET OF DFSIZ EQU *-1 THIS EXTENT CLE NOW ADD THE TWO / ADA TEMP1 DO DOUBLE WORD SEZ,CLE INB ADD STA TEMP1 SET FOR STB TEMP2 RETURN ISZ TEMP5 GET THE OFFSET LDA TEMP5,I AND STA TEMP3 SET IT FOR RETURN JMP RETN2 GO SEND IT * CSRP JSB SETEQ SET UP THE EQT ADDRESSES ADB D10 ADDRESS OF EQT11 STB SETEQ SAVE IT FOR LATER LDA DFSIZ SET ADDRESSES INA SET UP TO GET THE EXTENT STA DIRCT IN ALL CASES INA STA DIRCT+1 LDA PARM3 GET THE DOUBLE WORD LDB PARM4 SECTOR OFFSET DIV DFSIZ,I DIVIDE BY FILE SIZE STA PARM1 SET EXTENT NUMBER FOR D.RTR CALL STB PARM2 SAVE THE REST * JSB EXEC SCHEDULE D.RTR TO OPEN DEF *+8 THE EXTENT. DEF D23 DEF D.RTR DEF 1717B ID SEGMENT ADDRESS. DEF PARM1 EXTENSION #. DIRCT BSS 2 DEF D6 JSB RMPAR DEF *+2 DEF D.1 LDA D.1 SSA JMP RETRN * LDA D.5 AND B377 JSB $LIBR GO PRIV TO SET THE EQT NOP STA TEMP4,I STORE BEGINNING SECTOR (EQT25). CLB,CLE SET UP THE ADA PARM2 OFFSET SEZ INB NOW DIV D#PTR,I GET TRACK OFFSET AND SECTOR ADDRESS STB TEMP1,I SET CURRENT SECTOR ADA D.4 SET CURRENT TRACK STA TEMP5,I IN EQT 18 LDA D.4 STA TEMP3,I STORE BEGINNING TRACK (EQT24). LDA PARM5 IOR DM128 MAKE SURE RANGE IS RIGHT ISZ TEMP5 STEP TO EQT19 STA TEMP5,I STORE CURRENT OFFSET (EQT19). LDA PARM1 STA TEMP2,I STORE CURRENT EXTENT (EQT20). LDA SETEQ,I GET EQT11 AND AND NTEOF CLEAR THE EOF FLAGS STA SETEQ,I RESTORE IT JSB $LIBX GO TEST MENU DEF *+1 DEF MENU * "A" OCT 101 C377 OCT 177400 NTEOF OCT 117777 MASK TO CLEAR EOF FLAGS M26 s DEC -26 M22 DEC -22 D4 DEC 4 B3700 OCT 3700 B377 OCT 377 B77 OCT 77 BMASK OCT 137777 BPAT NOP ADDR1 NOP RECNO NOP D2 DEC 2 M1 DEC -1 M2 DEC -2 M4 DEC -4 M16 DEC -16 PARM1 BSS 1 PARM2 BSS 1 PARM3 BSS 1 PARM4 BSS 1 PARM5 BSS 1 * ERM26 LDA M26 JMP NOGO1 * SETUP LDA PTR22 HAVE RECORD 1. STA ADDR1 SAVE FOR LATER LDB D2 GET RECORD 2. JSB RDREC JMP NOGO1 READ ERROR. * * FIND IF THERE IS AN AVAILABLE SPLCON RECORD. * LDA M16 SET UP STA TEMP1 COUNTER LDA BUF21+3 GET REC. # OF FIRST REC STA RECNO SAVE IT LDA BUF21+1 GET NUMBER OF RECORDS CMA,INA SET FOR COUNTER STA TEMP3 IN TEMP3 LOOP1 LDA M16 SET UP STA TEMP2 COUNTER TWO CLB,INB SET INITIAL BIT MASK LOOP2 LDA ADDR1,I TRY AND B ONE SZA,RSS AVAILABLE?? JMP HAVIT YES USE IT * ISZ TEMP3 ANY RECORDS LEFT? RSS YES SKIP JMP NOGO NO SO SORRY! * RBL NO ADVANCE BIT MASK ISZ RECNO SEP RECORD NUMBER ISZ TEMP2 AND COUNT WORD EXHAUSTED?? JMP LOOP2 NO TRY NEXT BIT * ISZ ADDR1 YES TRY NEXT WORD ISZ TEMP1 IS THERE A NEXT WORD?? JMP LOOP1 YES TRY IT. * JMP NOGO NO AVAILABLE RECORD. * HAVIT LDA ADDR1,I SAVE NEW BIT PATTERN XOR B IN A TEMPORARY. STA BPAT LDA BUF21+4 CMA,INA SET NEGATIVE STA PARM5 SAVE MAX. # PENDING OUTSPOOLS. * * FIND OUT WHETHER ANY OUTPUT QUEUES ARE FULL * OR TOTAL PENDING OUTSPOOLS MATCH THE MAXIMUM. * LDB MPTR GET THE MENU ADDRESS LOOP3 LDA B,I GET ENTRY SZA,RSS END OF LIST? JMP SMP3 YES * INB NO STEP TO COUNT LDA B,I GET COUNT RAL,CLE,ERA CLEAR THE SIGN CPA D63 FULL?? JMP ERM26 YES SENT BACK ERROR * ADA PARM5 ADD TO TOTAL STA PARM5 RESET TOTAL SSA,RSS IF NEG. THEN JMP ERM26 TOO MANY * INB NEXT JMP LOOP3 AROUND AGAIN * * * FIND AN AVAILABLE LU #. * * SMP3 JSB FINDL NOGO LDA M22 USE ZERO TO FLAG ERROR AND DO CLASS GET * NOGO1 STA TEMP1 JSB EXEC DO A CLASS GET TO RETRIEVE DEF *+5 THE SETUP BUFFER. DEF D21 DEF PARM2 DEF BUF23 DEF D16 JSB SMENU JMP ERM21 * LDA TEMP1 STA BUF23+1 SAVE LU# IN SETUP BUFFER. SSA,RSS IF NO LU THEN TAKE GAS! JSB OPNSP TRY TO OPEN THE SPOOL FILE. SZA,RSS CHECK FOR ERRORS. JMP ERM16 CANNOT USE TYPE 0 FILES. * SSA JMP ERMES COULDN'T OPEN THE FILE? * LDA BUF23+8 IF BATCH INPUT RAL,ELA THEN CLA,SEZ CLEAR STA BUF23+15 OUTSPOOL LU. LDA BUF23+9 IF PRIORITY IS NEG SSA THEN CLA SET ZERO STA BUF23+9 TO AVOID Q PROBLEMS LDA BUF23+15 IF FILE IS FOR OUTSPOOL SZA,RSS IF NOT FOR OUTSPOOL JMP SSEQT JUST SET IT UP * LDB BUF23+10 GET STATUS CPB "H" IF NOT HOLD JMP SSEQT * LDB "W" SET TO WAIT STB BUF23+10 * * SET UP SPOOL EQT ENTRY. * SSEQT JSB FEQT FIND ADDRESS OF EQT. INB MAKE SURE THAT THIS IS LDA B,I REALLY A SPOOL EQT. CPA IS43A DO THIS BY CHECKING JMP SS3 EQT2 AGAINST THE INIT. * JMP ERM22 ENTRY POINT OF DVS43. * SS3 ADB D2 HAVE EQT ADDRESS. STB TEMP3 GET EQT4 ADDRESS. JSB $LIBR GO PRIVILEGED TO BE ABLE NOP TO STUFF THE EQT. LDA TEMP3,I SET OR CLEAR BUFFERING AND BMASK FLAG. LDB BUF23+8 SSB XOR BUFRD STA TEMP3,NLHI ISZ TEMP3 LDA BUF23+7 GET DRIVER TYPE AND PUT ALF,ALF AND POSITION CORRECTLY STA TEMP3,I IN EQT5. LDB TEMP3 ADB D6 SET UP REMAINDER OF STB CLSPT SAVE ADDRESS OF EQT 11 LDA PARM1 IF THIS CMA,CLE,INA IS A SET UP FOR SPOUT CLEAR E LDA D16 SET THE STANDARD BIT AT ALL TIMES SEZ IF SPOUT USE ONLY THE STD. BIT IOR BUF23+8 DISPOSITION FLAGS. AND DMASK EQT11. STA B,I ADB D2 INDEX TO EQT EXTENSION. LDB B,I ADB D2 SAVE ADDRESS OF CURRENT STB TEMP3 TRACK/SECTOR. ADB D8 LDA D.1 SAVE FILE SIZE IN EQT26. STA B,I SAVE MASTER DIRECTORY ENTRY INB IN EQT27 AND EQT28. LDA D.2 STA B,I INB LDA D.3 STA B,I ADB M4 LDA D.4 STA B,I SAVE BEGINNING TRACK (EQT24). STA TEMP3,I SAVE CURRENT TRACK (EQT18). ISZ TEMP3 LDA DM128 SET STA TEMP3,I OFFSET ISZ TEMP3 CLA CLEAR THE STA TEMP3,I EXTENT #. ISZ TEMP3 LDA D.5 SAVE CURRENT SECTOR. AND B377 STA TEMP3,I INB STA B,I SAVE BEGINNING SECTOR. ADB D4 LDA BUF23+8 SET BATCH CHECK FLAG tN RAL,ELA IN E LDA PARM1 SETUP FOR SPOUT? SEZ IF NOT BATCH IN CHECK USE ZERO SZA ALSO FOR SPOUT CLA,RSS BATCH CHECKING DOESN'T APPLY. LDA PARM3 PUT BATCH CHECKING INFO. STA B,I INTO EQT29. INB LDA D.5 ALF,ALF AND B377 STA B,I SAVE # SECTORS TRACK. INB CLA INITIALIZE RECORD COUNT. STA B,I INB STA B,I INITIALIZE CLASS PARAMETER INB WORDS. STA B,I JSB $LIBX DEF *+1 DEF SS2 * IS43A BSS 1 DVS43 ENTRY POINT SAVE. DM128 DEC -128 D6 DEC 6 D63 DEC 63 D8 DEC 8 D.1 NOP D.2 NOP D.3 NOP D.4 NOP D.5 NOP PTR22 DEF BUF22 PTR24 DEF BUF24 RECRD NOP DMASK OCT 630 "H" OCT 110 * SS2 LDA PARM1 IF SET UP IS FOR SPOUT CPA D11 SKIP JMP SS4 SKIP THE EOF WRITE * LDA BUF23+8 IF A WRITE ONLY ALF,ALF ACCESS SLA,RSS JMP SS5 NOT WRIT ONLY * LDA BUF23+1 GET THE LU IOR B100 SET UP A EOF REQUEST STA TEMP6 ADA B100 AND A BACKSPACE RECORD STA TEMP5 REQUEST JSB EXEC DO EOF DEF *+3 DEF D3 DEF TEMP6 JSB EXEC NOW BACKSPACE DEF *+3 DEF D3 DEF TEMP5 * SS5 LDA BUF23+8 FIX THE STD. FLAG CMA AS REQUIRED AND D16 ISOLATE THE BIT XOR CLSPT,I CLEAR IT IF NEED BE LDB CLSPT JSB PUT SET THE WORD BACK IN EQT11 SS4 LDA PTR23 LDB RECNO JSB WTREC * * THE FOLLOWING QUEUES A FILE FOR OUTSPOOLING. * QUEUE LDA BUF23+15 IS THIS FILE TO SZA,RSS OUTSPOOLED? JMP SET10 NO. * LDB PARM1 IS THIS A SETUP FOR CPB D11 SPOUT? (SPSEL) JMP SPS5 YES. * * ENTER HERE FROM CSAP OR PASS. * AND B77 STA zTEMP6 SAVE OUTSPOOL LU #. LDA BUF23+9 SAVE SPOOL PRIORITY. STA TEMP5 JSB SMENU GET SET TO PASS THIS JMP QUE1 SPOOL FOR OUTSPOOLING. * INB SAVE THE ADDRESS OF THE COUNT WORD STB SMENU FOR LATER LDB BUF23+8 CHECK IF THERE IS RBR,SLB A HOLD ON THIS FILE. JMP SET10 YES. * LDB BUF23+10 MUST ALSO BE IN "W" STATUS CPB "W" WELL RSS YES CONTINUE JMP SET10 NO DO NOT QUEUE * LDA PTR23 FOUND AN LU MATCH. LDB RECNO JSB WTREC JSB RDLUQ GET THE LU QUEUE TO CORE JSB .DRCT SETTING UP HERE TO SEARCH DEF BUF21+3 THE QUEUE AND FIND OUT STA TEMP4 WHERE THE NEW ENTRY ADA M1 SET A FOR SCAN SET2 LDB A,I CAN BE PUT. INA STEP TO PRIORITY SZB,RSS END OF QUEUE? JMP SET1 YES. * LDB A,I GET PRIORITY CMB,INB WE HAVE A PRIORITY. ADB TEMP5 COMPARE WITH PRIORITY SSB OF NEW ENTRY. JMP SET1 NEW ENTRY IS LESS. * INA KEEP LOOKING FOR A JMP SET2 SPOT TO PUT NEW ENTRY. * SET1 ADA M1 HAVE A PLACE. STA TEMP3 SAVE A POINTER. LDA BUF21+1 FIND THE END OF ALS THE LIST. THE LIST FROM ADA TEMP4 POINT OF NEW ENTRY INA WILL BE SHIFTED TO MAKE SET4 STA TEMP6 ROOM FOR NEW ENTRY. ADA M2 SET UP SHIFT POINTERS. STA TEMP4 DLD TEMP4,I DO A SHIFT ON A DST TEMP6,I TWO-WORD ENTRY. LDA TEMP4 DECREMENT POINTERS. CPA TEMP3 JUST MOVED LAST ONE? RSS YES SKIP JMP SET4 NO - BACK THROUGH LOOP. * LDA RECNO PUT THE NEW ENTRY LDB TEMP5 IN THE VACATED SPACE. DST TEMP4,I ISZ BUF21+1 INCREMENT THE ENTRY COUNT. JSB WRLUQ WRITE OUT THE LU QUEUE LDykA SMENU,I UPDATE THE MENU. ELA SAVE THE SIGN BIT LDA BUF21+1 GET THE NEW COUNT RAL,ERA SET SIGN IF NEEDED STA SMENU,I RESET THE COUNT SET10 LDA PARM1 SETUP PROCESSING? SZA IF NOT, BYPASS BIT SETTING. JMP MENU * LDA PTR22 READ AVAILABILITY BITS. LDB D2 JSB RDREC NOP *********************************************** LDB BPAT RESET AVAILABILITY BITS. STB ADDR1,I LDA PTR22 WRITE OUT AVAILABILITY RECORD. LDB D2 JSB WTREC LDB TEMP2 LDA B,I FIX UP $LUAV. CCE MAKE THE LU UNAVAILABLE. ELA,RAR JSB PUT INB LDA RECNO JSB PUT * MENU LDA SHUTD IS THERE A SHUT DOWN SZA IN EFFECT? JMP RETRN * LDA SSTAT IS SPOUT ALREADY WORKING CPA D1 ON A MENU? JMP SRSEX YES - RETURN. * LDA PARM1 JSB FINDL IS THERE AN AVAILABLE LU JMP SRSEX FOR SPOUT? * STA RESLU MENU1 LDA PTR25 MAKE UP A NEW MENU TO SEND STA TEMP3 TO SPOUT. PUT ONLY LU'S CLB SET TO CLEAR THE BUFFER STB A,I SET SEED LDB A INB JSB .MVW MAKE IT GROW DEF D15 NOP LDA MPTR IN THE MENU THAT ARE NOT STA TEMP4 IN USE AND ALSO HAVE A QUEUE MENU2 LDB TEMP4,I OF FILES TO BE OUTSPOOLED. STB TEMP3,I SZB,RSS END OF .MENU? JMP MENU3 YES. * ISZ TEMP4 NO - GO AHEAD AND CHECK IF LDB TEMP4,I IF THE LU IS IN USE BY ISZ TEMP4 SPOUT. SSB JMP MENU2 SPOUT IS ALREADY USING THE LU. * SZB IS ANYTHING ON THIS QUEUE. ISZ TEMP3 YES - SAVE THE ENTRY JUST MADE. JMP MENU2 * MENU3 LDA BUF25 SZA,RSS IS THERE ANYTHING TO SEND SPOUT? JMP SRSEX NO. * CLB,INB SET STATUSj TO SHOW STB SSTAT SPOUT WORKING ON MENU LDA D2 SEND CLASS REQUEST STA TEMP5 TO SPOUT WITH A MENU. CLA,CCE STA TEMP6 LDA RESLU RESERVE THE LU ELA,RAR FOR SPOUT LDB TEMP2 JSB PUT MENU4 JSB CLSPT JMP MENU GIVE SPOUT ALL IT CAN TAKE. * CLSPT NOP JSB EXEC DEF *+8 DEF D20 WRITE-READ REQUEST DEF ZERO LU #. PTR25 DEF BUF25 MENU BUFFER. DEF D12 DEF TEMP5 CLASS PARAMETER 1. DEF TEMP6 CLASS PARAMETER 2. DEF SP.CL CLASS ID. JMP CLSPT,I * * D1 DEC 1 D11 DEC 11 M21 DEC -21 TEMP1 BSS 1 TEMP2 BSS 1 TEMP3 BSS 1 TEMP4 BSS 1 TEMP5 BSS 1 TEMP6 BSS 1 MPTR DEF .MENU SHUTD NOP RESLU NOP SSTAT NOP * NTRDY CLA,RSS ERM16 LDA M16 ERMES STA TEMP1 JMP MENU * QUE1 CCA OUTSPOOL LU NOT LEGAL. STA BUF23 LDA PTR23 LDB RECNO JSB WTREC ERM21 LDA M21 JMP ERMES * ERM22 LDA M22 JMP ERMES * RETRN LDA MPTR THEN DO A COMPLETE RETN3 LDB A,I TERMINATION SO AS TO SZB,RSS ALLOW ACCESS TO THE JMP RETN2 SPLCON FILE FOR A * INA USER PACK, ETC. LDB A,I IF SPOUT IS NOT ACTIVE SSB AND THERE IS A SHUTDOWN JMP SRSEX IN EFFECT. * INA JMP RETN3 * RETN2 CLA,RSS OK TO SHUT DOWN SRSEX CLA,INA SAVE RESOURCES SHUT DOWN STA EXIT,I SAVE FOR EXIT * JSB POST MAKE SURE SPLCON BUFFERS DEF *+2 ARE POSTED. DEF DCB1 JSB UNLOK CLEAR SPLCON RN #. DEF SRN RETN4 JSB PRTN PASS BACK PARAMETERS DEF *+2 TO THE CALLER. DEF TEMP1 CCB SET B AS INDICATOR JSB EXEC COMPLETION RETURN. DEF *+4 DEF D6 DEF ZERO INDICATE CALLER. EXIT DEF WRLUQ SAVE RESOURCES TERMINATION. SSB IF TIME ENTRY JMP TRYAG GO TRY THE MENU AGAIN * JSB RMPAR THIS ENABLES US TO SAVE DEF *+2 INDICATORS AND KEEP SPLCON DEF PARM1 OPEN ALL THE TIME. JMP SMP1 * LULOK CLB SPOUT HAS LU LOCK CONDITION. STB SSTAT JSB SPS RELEASE THE RESERVED LU SWP JSB PUT JSB EXEC SCHEDULE SMP WITH OFFSET DEF *+6 AND CHECK THE HOW WE GOT TO THIS DEF D12 POINT OF SUSPENSION WHEN WE DEF SMPNA ARRIVE. IF ORDINARY SCHEDULE DEF D2 DEF ZERO DEF M8 REQUEST, PROCESS NORMALLY. JMP SRSEX GO EXIT * RDLUQ NOP ROUTINE TO READ THE LU QUEUE LDA PTR21 SET UP TO READ 8 RECORDS. LDB M8 THIS IS ONE LU QUEUE. STB TEMP3 LDB LUREC READ THE APPROPRIATE SET6 JSB RDREC BLOCK. JMP ERMES READ ERROR. * LDB RECRD CLB SET FOR AUTO REC. INCREMENT LDA BUFSP FOR NEXT RECORD. ADA D16 ISZ TEMP3 FINISHED READING BLOCK? JMP SET6 * JMP RDLUQ,I YES RETURN * LUREC NOP M8 DEC -8 * WRLUQ NOP WRITE OUT THE LU Q LDA PTR21 SET UP TO WRITE LDB M8 OUT THE LU QUEUE. STB TEMP3 8 - 16 WORD RECORDS. LDB LUREC SET7 JSB WTREC WRITE A 16 WORD RECORD. LDA BFSP1 UPDATE BUFFER POINTER ADA D16 TO NEXT RECORD. CLB ISZ TEMP3 JMP SET7 * JMP WRLUQ,I DONE SO EXIT * * TRYAG JSB LOCK DEF SRN JMP MENU GO TRY THE MENU * UNLOK NOP LDA UNLOK,I STA RESNO ISZ UNLOK JSB RNRQ DEF *+4 DEF D4 RESNO BSS 1 DEF IERR JMP UNLOK,I * LOCK NOP LDA LOCK,I STA RESNU ISZ LOCK JSB RNRQ DEF *+4 DEF D1 RESNU BSS 1 DEF IERR JMP LOCK,I * * BITFX NOP STB A  AND D15 CMA STA FEQT CLA,INA ISZ FEQT JMP *+4 * BRS,BRS BRS,BRS JMP BITFX,I * RAL JMP *-6 * * * SUBROUTINE TO FIND EQT ADDRESS CORRESPONDING * TO A GIVEN LU #. * FEQT NOP CCA,CCE FIND ADDRESS OF EQT CORRESPONDING ADA DRT TO THE AVAILABLE LU #. ADA BUF23+1 LDA A,I AND B77 GET EQT NUMBER AND INDEX ADA M1 TO THE PROPER ENTRY. MPY D15 ADA EQTA STA B ADA D12 SET EXTENSION LDA A,I ADDRESS IN A JMP FEQT,I * FINDL NOP FIND AVAILABLE LU. LDA LUAVA STA TEMP2 LDA TEMP2,I STA FEQT FIND1 ISZ TEMP2 LDA TEMP2,I SSA,RSS JMP FIND2 * ISZ TEMP2 ISZ FEQT JMP FIND1 * RSS FIND2 ISZ FINDL JMP FINDL,I * SPS NOP LDA LUAVA GET ADDRESS OF $LUAV. SPS0 INA STEP TO FIRST ENTRY LDB A,I GET THE LU INA STEP TO THE RECORD NUMBER SSB IF BUSY, LDB A,I GET THE RECORD NUMBER SZB IF ZERO THEN THIS IS IT JMP SPS0 ELSE TRY NEXT ONE * STA TEMP2 SAVE THE RECORD NO. ADDRESS ADA M1 AND THE LU ADDRESS LDB A,I GET THE LU RBL,CLE,ERB CLEAR THE BUSY BIT STB RESLU AND SAVE THE LU JMP SPS,I * SPSEL CLA CLEAR WORK STA SSTAT IN PROGRESS FLAG LDA PARM2 GET THE LU AND SET IN CASE WE NEED TO STA BUF23+15 CALL OFF SPOUT JSB SPS SEARCH $LUAV FOR A RESERVED LU. JSB SMENU GET THE MENU ENTRY JMP KILL3 CAN'T FIND?? SHOULD NEVER HAPPEN * INB STB TEMP6 SAVE THE POINTER LDB A RECORD NUMBER TO B LDA PTR24 READ THE TOP OF THE JSB RDREC LU QUEUE AND PICK NOP ********************************ߪ*********** CLA SET THE Q ENTRY PRIORITY TO STA BUF24+3 TO ZERO TO INDICATE LDA PTR24 IT AS ACTIVE (PREVENTS LDB LUREC INSERTS AHEAD OF IT) JSB WTREC WRITE IT BACK OUT LDB BUF24+2 UP THE FIRST ENTRY. STB RECNO SAVE SPLCON RECORD # OF FILE. LDA PTR23 READ SPLCON RECORD. JSB RDREC NOP ********************************************** LDA RECNO SET THE RECORD NUMBER LDB TEMP2 IN THE LUAV TABLE JSB PUT LDA RESLU AND THE LU STA BUF23+1 IN THE RECORD JSB OPNSP TRY TO OPEN THE FILE. SSA JMP KILL3 YES - KILL THE SPOOL. * LDB "A" SET FILE TO ACTIVE - STB BUF23+10 IT WILL BE OUTSPOOLED. JMP SSEQT GO SET UP EQT ENTRY. * * SPS5 CLA,CCE,INA COME HERE AFTER SETTING STA TEMP5 UP SPOOL EQT. LDA TEMP6,I GET POSITION OF LU IN ELA,RAR MENU AND MARK IT TO STA TEMP6,I SHOW THAT SPOUT IS SPS7 LDB BUF23+8 IS BUSY WITH THAT LU. CCE POTENTIAL OVERLAP PROBLEM? RBR,SLB IF SO, SET SIGN BIT IN CME CLASS PARAMETER TO BE PASSED LDA BUF23+15 TO SPOUT. ELA,RAR STA TEMP6 RBR,CLE,RBR RBR,SLB CCE LDA BUF24 GET # QUEUED LINES. AND C377 ISOLATE IOR RESLU INDICATE LU AND FILE TYPE. ELA,RAR STA BUF25 JMP MENU4 * * SMENU NOP LDA BUF23+15 IF NO LU AND B77 SZA,RSS THEN JMP SM2 JUST EXIT * STA FINDL SAVE THE REQUESTED LU LDB MPTR SEARCH MENU FOR DEQ4 LDA B,I OUTSPOOL LU. CPA FINDL THIS IT?? JMP SM1 YES GO EXIT FOUND * SZA,RSS IF END OF TABLE JMP SMENU,I TAKE NOT FOUND EXIT * ADB D2 JMP DEQ4 * SM1 LDA MPTR COMPUTE THE LU QUEUE CMA,INA 3RECORD NUMBER ADA B FOR THIS LU ALS,ALS ADA D9 STA LUREC AND SAVE IT FOR RDLUQ SM2 ISZ SMENU STEP TO FOUND EXIT JMP SMENU,I AND RETURN * D9 DEC 9 P21.2 DEF BUF21+2 * DEQUX LDA PARM3 IF NO ERROR CMA,INA,SZA,RSS JUST D Q JMP DEQUE * JSB MSFIX FIX UP THE MESSAGE ASC 3,EOF ER STRING FOR MESSAGE DEC 13 * DEQUE JSB PRGEX RELEASE THE SPLCON RECORD JSB DQ DEQUE THE FILE JMP NTRDY EXIT * DQ NOP DEQUE SUBROUTINE ENTER WITH E=0 IF JSB SMENU FIND THE LU FOR THIS FILE JMP ERM21 DIDN'T FIND - ERROR. * INB SAVE THE ADDRESS FOR UPDATE STB PRGEX JSB RDLUQ GET THE LU QUEUE TO CORE LDA PTR21 DEQ11 ADA D2 FIND THE POSITION IN LDB A,I THE QUEUE. CPB RECNO JMP DEQ10 FOUND IT * CPA LIM END OF QUEUE? JMP DQ,I YES - LEAVE. * JMP DEQ11 KEEP LOOKING * DEQ10 LDB PRGEX,I GET THE # OF ENTRIES FLAG ADB M1 DECREMENT IT CPA P21.2 IF FIRST ENTRY RBL,CLE,ERB CLEAR THE BUSY FLAG STB PRGEX,I SET IT BACK DEQ12 STA TEMP2 HAVE IT. ADA D2 STA TEMP3 CMA,INA ADA PTR21 ADA D127 SSA END OF BLOCK? JMP DEQ13 YES. * DLD TEMP3,I NO - MOVE UP NEXT ENTRY. DST TEMP2,I LDA TEMP3 JMP DEQ12 * DEQ13 CLA CLB DST TEMP2,I CCA ADA BUF21+1 DECREASE # OF ENTRIES. STA BUF21+1 JSB WRLUQ WRITE OUT THE LU QUEUE JMP DQ,I ELEMENT DEQUED SO EXIT * * CLRAV NOP CLEAR THE LUAVA ENTRY USING RECNO LDB LUAVA FIND THE SPOOL LU LDA B,I SET THE COUNT STA PUT INCASE NOT FOUND DEQ16 ADB D2 INDEX TO THE NEXT RECORD ENTRY LDA B,I CPA RECNO THIS THE ONE?? JMP DEQ15 YES GO DO IT * ISZ PUT MORE?? JMP DEQ16 YES TRY NEXT ONE * CCE INDICATE NOT FOUND JMP CLRAV,I RETURN * DEQ15 JSB FRELU FREE THE LU JMP CLRAV,I RETURN * * FRELU NOP FREE LU AND ITS EQT IF ONE CLA CLEAR THE RECORD # SLOT JSB PUT IN THE LUAV ADB M1 BACK TO THE LU NUMBER LDA B,I GET THE NUMBER RAL,CLE,ERA CLEAR THE SIGN STA BUF23+1 SET FOR POSSIBLE FURTURE USE JSB PUT RESET WORD SEZ,CME,RSS IF NOT BUSY OR NOT FOUND JMP FRELU,I EXIT WITH E = 1 * JSB FEQT GET THE EQT ADDRESS STA B SET TO ADB D11 CLEAR EQT27 TO STOP LDA B,I SAVE IT FOR CLOSE STA D.2 FIRST CLA,CLE ANY ACCESSES JSB PUT DO IT JSB UNLOK CLEAR THE HOLD RN DEF WRN CLE CLEAR E TO INDICATE FOUND JMP FRELU,I RETURN * RELSE LDA PTR23 LDB PARM2 STB RECNO JSB RDREC NOP ********************************************** LDA BUF23+1 NEED TO SAVE IN CASE STA PARM2 OF RESTART. LDB PARM4 LOOK AT REL/RES FLAG. LDA PARM5 CPA "AH" ACTIVE FILE? JMP RELS1 YES. * SSB RELEASE? JMP QUEUE YES - REQUEUE. * SZB POSSIBLE LU CHANGE. STB BUF23+15 SAVE NEW LU. JMP QUEUE * RELS1 SSB,RSS A RELEASE? JMP RELS2 NO MUST RESTART. * JSB FEQT ADB D10 CLE SET TO CLEAR THE BIT LDA HMASK SET THE BIT TO BE CLEARED JSB PUTM GO CLEAR IT LDA BUF23+1 STA RESLU LDA PARM3 STA PARM2 CLA,INA STA TEMP5 JMP SPS7 * RELS2 JSB SPTUN JSB FLU FIND THE LU RSS IF NONE SKIP JSB FRELU FREE IT DEQ18 JSB DQ DEQUE THKE FILE LDA PTR23 RELEASING AN ACTIVE LDB RECNO FILE AND RESTARTING IT - JSB RDREC MUST QUEUE IT UP. NOP ********************************************** LDA PARM4 NEW LU? SZA WELL?? STA BUF23+15 YES - SAVE IT. LDA PTR21 READ IN 1ST RECORD CLB,INB FOR QUEUE. JSB RDREC NOP ********************************************** JMP QUEUE * LIM DEF LIMIT "AH" ASC 1,AH D127 DEC 127 D15 DEC 15 * KILL LDB PARM2 STB RECNO SAVE SPLCON RECORD #. LDA PTR23 READ THE SPLCON RECORD JSB RDREC FOR THIS FILE. NOP *********************************************** LDA PARM5 IS THIS AN ACTIVE CPA "A" FILE (BEING OUTSPOOLED)? RSS YES TREAT AS IF ACTIVE HOLD * CPA "AH" ACTIVE HOLD? KILL3 JSB SPTUN YES. * JMP DEQUE GO DO IT. * B100 OCT 100 * PUTM NOP ROUTINE TO SET OR CLEAR BIT SET IN A JSB $LIBR AND ADDRESSED BY 'B' 'E'=1 TO SET NOP 'E'=0 TO CLEAR THE BIT STA FEQT SAVE THE BIT(S) IOR B,I SET THE BIT IN ANY CASE SEZ,RSS IF CLEAR REQUEST XOR FEQT CLEAR THE BIT STA B,I RESET AND JSB $LIBX DEF PUTM EXIT * * SPTUN NOP JSB FEQT SET HOLD BIT TO STOP SPOUT ADB D10 LDA HMASK HOLD BIT TO EQT11 JSB PUTM GO SET IT CLA MAKE SURE AND CALL STA BUF25 SPOUT SO THAT IT LDA D3 WILL UNLOCK THE LU STA TEMP5 BEING USED TO LDA BUF23+15 DUMP THIS FILE AND B77 STA TEMP6 JSB CLSPT JMP SPTUN,I * "D" OCT 104 * SHUT LDA "D" STA SHUTD JMP RETRN * STUP CLA STA SHUTD JSB UNLOK RELEASE JOB HOLD JUST IN CASE DEF WRN JMP MENU * DVCDN JSB MSFIX  DEVICE WENT DOWN WHILE ASC 3,DOWN OUT SPOOLING D16 DEC 16 LENGTH OF MESSAGE (WORDS) JMP HOLD1 GO HOLD THE FILE * HOLD LDB PARM2 PICK UP AND SAVE RECORD STB RECNO NUMBER OF FILE IN SPLCON. LDA PTR23 READ IN APPROPRIATE FILE JSB RDREC RECORD IN SPLCON. NOP *********************************************** LDA PARM5 HOLDING AN ACTIVE FILE? CPA "A" JMP HOLD1 * JSB DQ NO - DEQUEUE THE FILE. JMP NTRDY AND EXIT * HOLD1 JSB FEQT SET A BIT IN SPOOL EQT ADB D10 FOR SMD. LDA HMASK JSB PUTM GO SET THE HOLD BIT LDA "AH" SET HOLD FLAG STA BUF23+10 LDA PTR23 WRITE THE RECORD LDB RECNO JSB WTREC JMP NTRDY * D10 DEC 10 HMASK OCT 10000 * PUT NOP JSB $LIBR NOP STA B,I JSB $LIBX DEF PUT * OPNSP NOP LDA BUF23+2 SET SIGN BIT ON 1ST CCE WORD OF FILE NAME. ELA,RAR STA TEMP4 SAVE IT. JSB EXEC TRY TO OPEN THE FILE. DEF *+8 DEF D23 SCHEDULE WITH WAIT. DEF D.RTR D.RTR. DEF ID ID SEGMENT ADDRESS. DEF TEMP4 NAME(1). DEF BUF23+3 NAME(2). DEF BUF23+4 NAME(3). DEF BUF23+6 CARTRIDGE ID. JSB RMPAR DEF *+2 GET PARAMETERS BACK DD.1 DEF D.1 FROM D.RTR. LDA D.1 SUCCESSFUL OPEN? JMP OPNSP,I * PRGEX NOP LDA PTR22 LDB D2 READ SPLCON AVAILABILITY BITS. JSB RDREC NOP ************************************************ LDB BUF21+3 GET SPLCON RECORD # CMB,INB RELATIVE TO THE BEGINNING ADB RECNO OF THE FILE DESCRIPTOR JSB BITFX RECORDS. ADB PTR22 STA BITFX IOR B,I CLEAR THE BIT. XOR BITFX STA B,I LDA PTR22 LDQB D2 JSB WTREC WRITE AVAILABILITY RECORD. CCA STA BUF23 LDA PTR23 LDB RECNO JSB WTREC WRITE FILE DESCRIPTOR RECORD. JSB CLRAV CLEAR ANY LU ASSOCIATED WITH THIS FILE SEZ WAS THERE A CURRENT ONE? JMP PRNLU NO, MUST OPEN TO CLOSE * JSB FEQT YES LU WAS SET FOR FEQT ADA D10 GET ADDRESS OF FILE PRAMS PRPU LDB A,I GET THE FILE SIZE CMB,INB SET NEGATIVE FOR PURGE ADA D2 STEP TO THE DIR. ADDRESS WORD STA TEMP4 LDA BUF23+8 GET THE OPTION WORD SLA IF SAVE IN EFFECT CLB CHANGE TO SIMPLE CLOSE AND D8 ISOLATE SPOOL POOL FILE BIT SZA IF POOL FILE LDB A CHANGE TO PURGE EXTENTS STB WTREC SET THE PRAMETER JSB EXEC SCHEDULE D.RTR DEF *+8 DEF D23 WITH WAIT TO DEF D.RTR CLOSE A FILE DEF 1717B AND PURGE EXTENTS. DEF WTREC DEF D.2 DEF TEMP4,I DEF ZERO PRNFL LDA BUF23+8 GET SPOOL POOL FLAG AND D8 CPA D8 IF SPOOL POOL JMP PRG0 GO SET UP * JMP PREX ELSE JUST RETURN * PRNLU JSB OPNSP OPEN THE FILE SO CAN PURGE SSA WAS IT FOUND?? JMP PRNFL NO * LDA DD.1 YES SET THE ADDRESSES JMP PRPU AND GO PURGE THE FILE * PRG0 JSB POST MUST ACCESS JOB FILE DEF *+2 DDCB DEF DCB1 LDA PTRJF SET UP THE JOB FILE LDB DDCB JSB .MVW DEF D16 BY MOVING IN THE DCB NOP JSB LOCK DEF JRN LDA PTR24 READ IN SPOOL POOL FILE LDB D17 AVAILABILITY BITS. JSB RDREC NOP ********************************************* LDA BUF23+4 CONVERT POOL FILE # AND D15 STA TEMP4 LDA BUF23+4 ALF,ALF AND D15 MPY D10 ADA TEMP4 5NLH CCB SET NUMBER LESS 1 ADB A IN B JSB BITFX FIND AVAILABILITY BIT. STB TEMP4 SET OFFSET ADDRESS ADB PTR24 ADB D4 CMA MAKE AN ANDING MASK STA TEMP5 AND SAVE IT IN CASE A JOB AND B,I CLEAR THE BIT AND STORE. STA B,I LDA PTR24 WRITE OUT JOBFIL RECORD 17. LDB D17 JSB WTREC SPOOL FILE IS RETURNED TO POOL LDA PTR25 LDB BUF23+11 IF SPOOL NOT CONNECTED SZB,RSS WITH A JOB, FORGET THIS STUFF. JMP DEQ7 * JSB RDREC ELSE READ IN THE JOB RECORD NOP *************************************** LDB P2511 GET ADDRESS OF POOL BITS STB TEMP6 SAVE FOR RELEASE CHECK ADB TEMP4 INDEX INTO AND LDA TEMP5 CLEAR AND B,I THE FREEDED BIT STA B,I FIX OWNED SPOOL BITS OF THE JOB. LDA BUF25+2 GET THE JOB STATUS CPA "CS" IF NOT CS RSS THEN JMP DEQ6 DO NOT CLEAR THE ENTRY * LDB M5 CHECK IF ALL OWNED FILES ARE CLOSED? DEQ8 LDA TEMP6,I SZA ANY HERE? JMP DEQ6 YES DO NOT FREE THE RECORD * ISZ TEMP6 STEP THE COUNT INB,SZB ALL TESTED? JMP DEQ8 NO TRY NEXT ONE * CCA ALL OWNED SPOOLS ARE CLEAR. N STA BUF25 DEALLOCATE THE RECORD. DEQ6 LDA PTR25 LDB BUF23+11 WRITE OUT THE RECORD. JSB WTREC DEQ7 JSB POST DEF *+2 PDCB DEF DCB1 JSB UNLOK DEF JRN LDA PTRSF RESET UP THE SPOLCON FILE LDB PDCB JSB .MVW DEF D16 NOP PREX JSB CLRAV CLEAR ANY ADDITIONAL SEZ,RSS LU'S ASSIGNED TO THIS JMP PREX FILE * JMP PRGEX,I EXIT TO CALLER * JRN NOP SRN NOP WRN NOP D17 DEC 17 M5 DEC -5 P2511 DEF BUF25+11 "CS" ASC 1,CS * WTREC NOP STA BFSP1 STB RECRD JSB WRITF DEF *+6 DEF DCB1 DEF IERR BFSP1 BSS 1 DEF D16 DEF RECRD JSB FILER REPORT FILE ERROR IF ANY JMP WTREC,I * RDREC NOP STA BUFSP STB RECRD JSB READF DEF *+7 DEF DCB1 DEF IERR BUFSP BSS 1 DEF D16 DEF FILER DUMMY PLACE HOLDER DEF RECRD SSA,RSS IF NO ERROR ISZ RDREC TAKE OK EXIT ELSE P+1 JSB FILER REPORT FILE ERROR IF ANY JMP RDREC,I * FILER NOP TEST FOR ERROR AND PRINT IF ONE CMA,SSA,INA SET NEGATIVE ERROR + JMP FILER,I IF NONE JUST EXIT * JSB CVTNO CONVERT THE NUMBER STA MESS SET IN THE MESSAGE JSB PRINT PRINT IT DEF SMPER DEF D6 JMP FILER,I RETURN TO CALLER * CVTNO NOP TWO DIGIT NUMBER CONVERTER CLB SET FOR DIVIDE DIV D10 A HAS HIGH DIGIT, B LOW ALF,ALF ROTATE TO HIGH ADA B PUT TOGETHER ADA "00" ADD THE ASCII OFFSETS JMP CVTNO,I RETURN NUMBER IN A * "00" ASC 1,00 * PRINT NOP PRINT TO LU 1 DLD PRINT,I GET THE BUFFER AND COUNT ADDRESSES DST BUFAD SET IN CALL ISZ PRINT ADVANCE THE RETURN ADDRESS ISZ PRINT ADVANCE THE RETURN ADDRESS JSB REIO SENT THE WI  ORD TO THE SYSTEM TTY DEF RTN DEF D2 DEF D1 BUFAD NOP SET TO THE BUFFER ADDRESSES NOP ALSO SET RTN JMP PRINT,I EXIT BACK TO CALLER * MSFIX NOP FIX UP THE MESSAGE LDA BUF23+15 FIRST GET THE AND B77 JSB CVTNO LU AND CONVERT STA LUXX SET IN MESSAGE JSB .DFER NOW MOVE IN THE STRING DEF DNEOF DEF MSFIX,I RETURNS A POINTS TO NEXT SOURCE SO STA MSFIX SAVE AS LENGTH ADDRESS JSB .DFER MOVE IN THE DEF FILEN FILE DEF BUF23+2 NAME JSB PRINT NOW PRINT THE MESSAGE DEF SVERF DEF MSFIX,I POINT TO LENGTH ISZ MSFIX STEP TO RETURN ADDRESS JMP MSFIX,I AND RETURN * PTRSF DEF SPLFL PTRJF DEF JOBFL SMPER ASC 5,SMP: FMP -XX ERORR MESSAGE MESS NOP HOLDS XX FROM MESSAGE SVERF ASC 4,SMP: LU LU DOWN AND BAD EOF TEMPLATE LUXX ASC 2, LU PLUS 2 BLANKS DNEOF ASC 4,EOR ER OR DOWN PLUS 2 BLANKS FILEN ASC 6,XXXXXX HELD. SMPNA ASC 3,SMP .MENU DEC 1 SUP REP 19 DEC 1 DEC 0 D21 DEC 21 D23 DEC 23 SPOUT ASC 3,SPOUT D.RTR ASC 3,D.RTR IERR NOP DRT EQU 1652B EQTA EQU 1650B ZERO DEC 0 ID NOP * END SMP xR  !"D 92067-18079 1805 S C0122 &4SPOT RTE-IV SPOUT             H0101 qASMB,R,L,C,Z ASSEMBLE STATEMENT FOR RTE IV *ASMB,R,L,C,N ASSEMBLE STATEMENT FOR RTE II IFN HED OUTSPOOL ROUTINE FOR RTE II XIF IFZ HED OUTSPOOL ROUTINE FOR RTE IV XIF * NAME: SPOUT * SOURCE: 92002-18009 (RTE II) 92067-18079 (RTE IV) * RELOC: 92002-16009 (RTE II) 92060-16011 (RTE III) * RELOC: 92067-16028 (RTE-IV)--SRC: 92067-18079 (RTE IV) * PGMR: A.M.G. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * IFN NAM SPOUT,1,11 92002-16009 REV. 1740 770810 XIF IFZ NAM SPOUT,17,11 92067-16028 REV.1805 780309 XIF * * *** THE GREAT SPOOL OUT ROUTINE *** * * * *** SMP REQUESTS TO SPOUT *** * * (1) NEW MENU TO SEARCH * STAT1 = 2 * STAT2 = 0 * IOBUF CONTAINS MENU * * (2) UNLOCK LU AND SEARCH NEW MENU * STAT1 = 3 * STAT2 = LU TO UNLOCK * IOBUF CONTAINS MENU * * (3) START UP A NEW SPOOL * STAT1 = 1 * STAT2 = NEW STAT2 CLASS PARAMETER * IOBUF CONTAINS NEW STAT1 * * * *** FORM OF CLASS PARAMETERS *** * * STAT1 SIGN BIT SET = STANDARD FILE * SIGN BIT CLEAR = OUTSPOOL WITH HEADERS * BIT 12 SET = CAME FROM DVS43 * BITS 11-8 = LINE COUNT * BITS 5-0 = LU # TO READ * * STAT2 SIGN BIT SET = CHECK OVERLAP CONDITION * SIGN BIT CLEAR = NO OVERLAP CHECK NEEDED * BITS 11-6 = FUNCTION BITS FOR STANDARD FILE * BITS 5-0 = OUTSPOOL LU # * * STD. I/O REQUEST: * * OPT. PRAM #1 STAT1 * OPT. PRAM #2 SET UP COUNT WORD (FLCNT) * * EQT 32/33 * 32 STAT1 * 33 STAT2 * 29 FLCNT * EXT $LIBR TURN OFF INTERRUPTS EXT $LIBX TURN ON INTERRUPTS EXT LURQ LU LOCK/UNLOCK REQUEST EXT $LUAV LU AVAILABILITY TABLE EXT EXEC SYSTEM CALLS EXT SP.CL SPOOL CLASS ID EXT .DRCT * * IOBUF BSS 69 * ORG IOBUF * * SPX CLA STA SPOUT LDA SP.CL IOR DONT JSB $LIBR NOP STA SP.CL JSB $LIBX DEF *+1 DEF SPT2 * ORR * SPOUT JMP SPX * SPT2 JSB EXEC CLASS GET LOOP STARTS HERE. DEF *+8 FLOW OF CONTROL DIRECTED DEF D21 FROM THIS POINT. DEF SP.CL BUFAD DEF IOBUF DEF D69 DEF STAT1 DEF STAT2 DEF ICNWD LDB ICNWD WHAT TYPE ORIGINAL REQUEST? CPB D2 JMP WRREQ ORDINARY WRITE. * CPB D3 JMP SPT2 CONTROL - BACK THROUGH LOOP. * LDA STAT1 WRITE-READ. CPA D2 HAVE AN SMP REQUEST JMP MENU * CPA D1 JMP FILAT * JSB LURQ MUST UNLOCK LU OF FILE DEF *+4 WHICH SMP FAILED TO OPEN DEF B40K DEF STAT2 DEF D1 NOP IGNORE ERROR JMP SPT2 GET THE NEXT CHORE * MENU LDA BUFAD HAVE A MENU TO SEARCH. STA TEMP1 MENU5 LDA TEMP1,I GO THROUGH LU'S IN MENU SZA,RSS TRYING TO LOCK EACH ONE. JMP MENU4 * * JSB LURQ TRY TO LOCK. DEF *+4 DEF NOABT WITHOUT ABORT. DEF TEMP1,I DEF D1 JMP MENU6 ERROR JUST IGNORE THIS ONE SZA,RSS JMP MENU3 SUCCESSFUL LOCK. * SSA UNSUCCESSFUL. JMP MENU4 NO RN'S AVAILABLE. QUIT. * MENU6 ISZ TEMP1 LU ALREADY LOCKED. TRY JMP MENU5 SEARCHING MORE OF MENU. * MENU4 CLB CPB STAT2 JMP MENU2 * STB STAT2 JMP MENU * MExpNU2 CPB IOBUF NULL MENU? JMP SPT2 YES - BACK TO GET. * LDA D10 TELL SMP ABOUT THE LOCK PROBLEM JMP SMPC * MENU3 LDA D11 SUCCESS TELL SMP LDB TEMP1,I FIRST MOVE UP THE PRAM STB TEMP1 JMP SMPC * FILAT LDA IOBUF HAVE A SET OF FILE STA STAT1 ATTRIBUTES. AND B77 STA ICNWD START UP THE SPOOL. JSB GETEQ GET EQT ADDRESS OF ADB M2 STARTING NEW FILE. LDA FILNO INCREMENT AND SET CCE,INA,SZA,RSS ERA FILE COUNTER INTO EQT29. STA FLCNT STA FILNO JSB PUT STUFF THE EQT. ADB D3 STB LCNT SAVE EQT32 ADDRESS. JSB SLCNT STAT2 IN EQT32 AND EQT33. CCA SET FLAG IN STA GETEQ GETEQ TO INDICATE SET UP JMP WRR10 * WRREQ LDA STAT2 STA FLCNT LDA STAT1 NORMAL READ-WRITE LOOP AND B77 STARTS HERE. STA ICNWD JSB GETEQ GET ADDRESS OF EQT32. ADB M2 BACK UP AND GET LDA B,I THE SET UP COUNT CPA FLCNT IS IT GOOD? INB,RSS YES SKIP JMP SPT2 NO OLD NEWS IGNOR IT * ADB D2 SET B TO EQT32 ADDRESS STB LCNT SAVE EQT32 ADDRESS. INB LDA B,I PICK UP STAT2 FROM THE EQT AND STA STAT2 SAVE IT LDB STAT1 PICK UP STORED STAT1 VALUE. LDA LCNT,I AND SAVE VERSION BLF,SLB IF FROM EXTEND RSS SKIP THE INCREMENT ADA B400 ELSE STEP THE COUNTER STA STAT1 SET STAT1 FOR LOCAL USE AND B7400 ISOLATE THE COUNTER SZA,RSS IF COUNT IS ALREADY TO ZERO JMP SPT2 IGNOR THE EXTEND WAKE UP. * JSB SLCNT UPDATE THE EQT WRR10 LDA STAT2 NEED WE CHECK THE SSA,RSS OVERLAP CONDITION? JMP WRR6 NO NEED. * JSB .DRCT WE MUST CHECK OVERLAP DEF $LUAV CONDITIONS BEFOR;`E CONTINUING. LDB A,I STB TEMP1 INA STA TEMP2 SAVE ADDRESS OF TABLE. WRR LDB A,I SEARCH THE $LUAV TABLE INA FOR THE READ LU. BLR,BRS CPB ICNWD JMP WRR3 WE HAVE IT. * INA JMP WRR * B400 OCT 400 * WRR3 LDB A,I SAVE SPLCON RECORD # STB TEMP5 CORRESPONDING TO THIS LDA TEMP2 SPOOL LU. WILL FIND IF WRR5 INA WE HAVE A POTENTIAL OVERLAP LDB A,I CONDITION BY FINDING CPB TEMP5 ANOTHER ENTRY OF SAME JMP WRR4 RECORD #. * WRR7 INA ISZ TEMP1 JMP WRR5 * LDB STAT2 CLEAR OVERLAP CHECK BIT. BLR,BRS STB STAT2 WRR6 JSB EXEC READ THROUGH SMD. DEF *+5 DEF LOKOP WITH NO ABORT BIT SET. DEF ICNWD DEF IOBUF DEF D69 JMP SPT2 HOLD I.O. * ALF,ALF CHECK STATUS WORD. SSA JMP EOF END OF FILE. * STB TEMP2 SAVE THE TRANSMITTED LENGTH LDA STAT1 CCE,SSA,RSS WHAT TYPE OF FILE? CPB D1 FIRST REASONABLE NESS TEST ONE WORD JMP RSTAN STANDARD. * LDA IOBUF OUTSPOOL WITH HEADERS. XOR STAT2 FORM THE CON WORD AND B3700 XOR STAT2 UNDER THE RULES OF WOO STA TEMP5 SALT IT AWAY LDA IOBUF GET THE REQUEST CODE AND OKBIT (=B24077) ALL BUT LEAST 2 SHOULD BE 0 CCE,SZB FORCE ZERO LENGTH READS TO FAIL CPA D3 IF CONTROL JMP CNTST GO TRY IT * CPA D2 BETTER BE A WRITE RSS GOOD SHOW GO DO IT JMP RSTAN WRONGLY FLAGGED * LDA IOBUF+1 FIGURE FINAL LENGTH OF LINE CCE,SSA IF CHAR ARS CONVERT TO WORDS SSA CMA,INA ADA D2 SHOULD MATCH THE READ LENGTH IN B CPA B DOES IT?? JMP OK YES STILL OK * LDA D67 9 CPB D69 COULD BE TOO LONG A LINE IF SO JMP LONG USE IT * JMP RSTAN WRONGLY FLAGGED AS NON STANDARD FILE * OK LDA IOBUF+1 LONG STA TEMP2 SET THE LENGTH LDA TEMP5 SAVE THE CONFIGURED STAT WORD FOR EOF STA STAT2 LDB BUFR2 GET THE BUFFER ADDRESS JMP SEND1 * RSTAN LDA STAT1 REFLAG IT ELA,RAR SET THE STANDARD BIT STA STAT1 AND LDB BUFAD GET THE BUFFER ADDRESS LDA STAT2 AND THE CON WORD SEND1 ALR,ARS CLEAR THE SIGN BIT STA TEMP5 SET THE CON WORD STB BUFFR AND THE BUFFER ADDRESS * JSB DOWN? MAKE SURE NOT DOWN (NO RETN IF SO) JSB EXEC WRITE A LINE TO DEF *+8 A DEVICE. DEF D18 DEF TEMP5 BUFFR BSS 1 BUFFER ADDRESS DEF TEMP2 BUFFER LENGTH DEF STAT1 CLASS PARAMETER. DEF FLCNT CLASS PARAMETER. DEF SP.CL LDA STAT1 FIRST TIME THROUGH ADA C377 DECREASE COUNT OF LINES STA STAT1 SET IT BACK JSB SLCNT LDA STAT1 NEED TO DO ANOTHER AND B7400 ISZ GETEQ IF FIRST LINE WAIT FOR COME BACK SZA,RSS IF COUNT DOWN TO ZERO WAIT JMP SPT2 YES- BACK TO GET LOOP. * JMP WRR10 COUNT NOT ZERO AND NOT FIRST LINE * D67 DEC 67 C377 OCT 177400 OKBIT OCT 24077 B7400 OCT 7400 CNTST CPB D2 BETTER BE A TWO WORD RECORD RSS GOOD SHOW JMP RSTAN NO GOOD GO RETYPE IT * JSB DOWN? NO RETURN IF DOWN DEVICE JSB EXEC SEND CONTROL REQUEST. DEF *+5 DEF D19 DEF TEMP5 DEF IOBUF+1 DEF SP.CL JMP WRR10 * WRR4 ADA M1 LDB A,I FOUND A RECORD MATCH. BLR,BRS IS THIS THE SAME ENTRY INA CPB ICNWD WE PICKED UP BEFORE. JMP WRR7 YES. * LDA B GET THE LU TO A FOR GETEQ JSB GETEQ NO. CHEDCK FURTHER. CCA GET CURRENT LINE COUNT ADA LCNT FROM THE READ EQT LDA A,I TO A CMA AND COMPARE ADA B,I WITH THE WRITE EQT SSA,RSS JMP WRR6 WE ARE OK. * INB SET UP WRITE EQT STB LCNT LDA STAT1 OVERLAP FAILED - SET EQT32 IOR DVCHK AND EQT33 IN LU OF FILE LDB FLCNT BEING WRITTEN SO THAT SMD STA STAT1 STB STAT2 JSB SLCNT WILL CALL US BACK WHEN IT JMP SPT2 HAS WRITTEN ANOTHER RECORD. * GETEQ NOP THIS ROUTINE FINDS US THE ADA M1 EQT ADDRESS CORRESPONDING ADA DRT TO A GIVEN LU #. LDA A,I AND B77 ADA M1 MPY D15 ADA EQTA ADA D12 LDB A,I ADB D15 JMP GETEQ,I * PUT NOP JSB $LIBR NOP STA B,I JSB $LIBX DEF PUT * EOF STB GETEQ SAVE THE EOF STATUS FLAG LDB LCNT ADB M3 CLA JSB PUT CLEAR THE FLAG SO WILL NOT BELIEVE FURTHER GETS LDA STAT2 END OF FILE. AND B77 ISOLATE OUTSPOOL LU. STA TEMP1 AND SAVE IT. LDB GETEQ GET THE EOF FLAG LDA STAT2 AND THE LAST USED MODE AND B100 ISOLATE THE MODE BIT SZB IF GOOD EOF SZA OR BINARY FILE JMP EOF0 SKIP MESSAGE * JSB DOWN? DO THE DOWN CHECK JSB EXEC SEND THE BAD EOF MESSAGE DEF *+8 DEF D18 DEF TEMP1 DEF EOFER DEF D4 DEF STAT1 DEF STAT2 DEF SP.CL JMP EOF1 NOW SEND ALL POSSIBLE EOFS * EOF0 SSB IF BAD EOF JMP EOF1 SEND ALL POSSIBLE EOF'S FOR ALL FILES * LDA STAT1 SSA,RSS STANDARD FILE? JMP EOF2 NO - HAVE HEADERS.. * EOF1 LDA B100 JSB CNTRL SEND EOF LDA B1000 JSB CNTRL SEND LEADER REQUEST  LDA B1100 JSB CNTRL SEND TOP OF FORM REQUEST EOF2 JSB LURQ UNLOCK THE LU DEF *+4 OF THE OUTSPOOL DEF B40K JUST COMPLETED. DEF TEMP1 DEF D1 NOP IGNORE ERROR RETURN LDA STAT1 TELL SMP WE ARE GOOD AND B77 AND FINISHED WITH THIS FILE. STA TEMP1 LDA D12 SEND DEQUE TO SMP SMPC STA SLCNT SET CALL CODE JSB EXEC DEF *+6 DEF D24 DEF SMP DEF SLCNT RQ PRAM DEF TEMP1 CURRENT LU DEF GETEQ EOF STATUS JMP SPT2 * SLCNT NOP JSB $LIBR NOP LDA STAT1 LDB STAT2 DST LCNT,I LCNT EQU *-1 JSB $LIBX DEF SLCNT * CNTRL NOP IOR TEMP1 PICK UP STA ICNWD AND SET THE CON WORD JSB DOWN? CHECK IF DOWN JSB EXEC SEND CONTROL REQUEST. DEF *+5 DEF D19 DEF ICNWD DEF M1 DEF SP.CL JMP CNTRL,I * DOWN? NOP TEST FOR DOWN DEVICE CCA ADA STAT2 THAN THE LU AND B77 ISOLATE ADA DRT INDEX INTO THE DRT STA B SAVE FOR LU TEST CCA SET TO GET THE EQT JSB $LIBR GO PRIV TO STOP RACES NOP ADA B,I EQT NO-1 AND B77 ISOLATE THE EQ NO. CPA B77 IF NO EQT THEN JMP DWNEX GO SENT THE LINE * ADB LUMAX INDEX TO LU FLAG LDB B,I IF SIGN SET THEN DOWN SSB ELSE UP JMP DOWN * MPY D15 GET EQT ADDRESS ADA EQTA ADA D4 TO A LDA A,I GET THE WORD RAL,SLA IF DOWN JMP DWNEX NOT DOWN EXIT * SSA,RSS SKIP JMP DWNEX ELSE GO EXIT * DOWN JSB $LIBX DEVICE IS DOWN DEF *+1 DEF *+1 LDA ICNWD SET UP TO CALL SMP AND STA TEMP1 IOR B200 BACK SPACE ON RECORD STA TEMP2 0.* JSB EXEC BACK SPACE IN FILE DEF *+3 DEF D3 DEF TEMP2 LDA D18 JMP SMPC GO NOTIFY SMP TO PUT IN HOLD * DWNEX JSB $LIBX UP SO DEF DOWN? GO DO THE CALL * * STORAGE * D4 DEC 4 B200 OCT 200 A EQU 0 B EQU 1 EQTA EQU 1650B DRT EQU 1652B LUMAX EQU 1653B SMP ASC 3,SMP EOFER ASC 4, BAD EOF TEMP1 BSS 1 TEMP2 BSS 1 TEMP3 BSS 1 TEMP5 BSS 1 FILNO OCT 100000 FLCNT BSS 1 STAT1 BSS 1 STAT2 BSS 1 LOKOP OCT 100001 NOABT OCT 140001 ICNWD BSS 1 BUFR2 DEF IOBUF+2 B40K OCT 40000 D1 DEC 1 D2 DEC 2 D3 DEC 3 D10 DEC 10 D11 DEC 11 D12 DEC 12 D15 DEC 15 D18 DEC 18 D19 DEC 19 D21 DEC 21 D24 DEC 24 D69 DEC 69 M1 DEC -1 M2 DEC -2 M3 DEC -3 B77 OCT 77 B100 OCT 100 B1000 OCT 1000 B1100 OCT 1100 B3700 OCT 3700 DVCHK OCT 10000 DONT OCT 20000 * END SPOUT 0 " / 92067-18080 1840 S 0122 RTE-IV IXGET              H0101 ASMB,R,Q,C HED IXGET * NAME: IXGET * SOURCE: 92067-18080 * RELPC: 92067-16035 * PGMR: G.A.A.,C.M.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM IXGET,7 92067-16035 REV.1840 780731 ENT IXGET * * * CALLING SEQUENCE: * *C GET IDATA FROM IADDR * IDATA=IXGET(IADDR) * * WHERE: IADDR = ADDRESS TO BE READ * IDATA = VALUE IN LOCATION "IADDR" * * * IXGET NOP DLD IXGET,I SWP LDA A,I XLA A,I JMP B,I * * A EQU 0 B EQU 1 END  #) 92067-18081 1840 S 0122 RTE-IV IXPUT              H0101 ASMB,R,Q,C HED IXPUT * NAME: IXPUT * SOURCE: 92067-18081 * RELPC: 92067-16035 * PGMR: G.A.A.,C.M.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM IXPUT,7 92067-16035 REV.1840 780731 ENT IXPUT EXT $LIBR,$LIBX * * * CALLING SEQUENCE: * * *C PUT IDATA INTO IADDR * CALL IXPUT(IADDR,IDATA) * * WHERE: IADDR = ADDRESS TO BE STUFFED * IDATA = VALUE TO BE PUT INTO "IADDR" * * * IXGET NOP IXPUT NOP JSB $LIBR NOP LDA IXPUT,I STA IXGET ISZ IXPUT DLD IXPUT,I LDA A,I LDB B,I XSB A,I JSB $LIBX DEF IXGET * * A EQU 0 B EQU 1 END  $* 92067-18082 1840 S 0122 RTE-IV FTIME              H0101 ASMB,R,Q,C HED TIME FORMAT SUBROUTINE * NAME: FTIME * SOURCE: 92067-18082 * RELPC: 92067-16035 * PGMR: G.A.A.,C.M.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM FTIME,7 92067-16035 REV.1840 780731 ENT FTIME EXT EXEC * CALLING SEQUENCE: * *C GET THE TIME IN A 15 WORD STRING * DIMENSION IBUF(15) * CALL FTIME(IBUF) * SUP * * GET TIME AND BUILD HEADER MESSAGE * A EQU 0 B EQU 1 O13 OCT 13 N1900 DEC -1900 D12 DEC 12 MD60 DEC -60 DM12 DEC -12 O30K OCT 30000 ASCII 0 IN HIGH WORD M1 OCT -1 "AM" ASC 1,AM "PM" ASC 1,PM O3 OCT 3 * * P1 NOP FTIME NOP DLD FTIME,I STA FTIME RSS INDCT LDB B,I TRACK DOWN INDIRECTS RBL,CLE,SLB,ERB JMP INDCT STB P1 * JSB EXEC DEF *+4 DEF O13 GET TIME DEF ITIME DEF IYEAR LDA IMIN JSB PD00 LDB ":" IOR O30K DON'T SUPPRESS LEADING ZEROS HERE RRR 8 B=1'S BLANK,A= ":" , 10'S DST TMSG+1 SET IN MESSAGE LDA IHOUR LDB "PM" ASSUME PM FOR NOW ADA DM12 IS IT SSA,RSS TEST AND ADJUST JMP PM YES * LDB "AM" NO USE AM LDA IHOUR RESTORE THE CORRECT HOUR PM SZA,RSS IF ZERO USE LDA D12 TWELVE STB TMSG+3 SET THE AM PM JSB PD00 STA TMSG HOURS * LDA IYEAR ADA N1900 SUBTRACT THE HUNDREDS JSB PD00 CONVERT THE YEAR STA TMSG+14 YEARS LDB IDAY ADB MD60 -60 LDA IYEAR AND O3 SZA SKIP IF LEAP YEAR SSB ADB M1 ADJUST FOR LEAP YEAR SSB ADB D366 ADB D31 LDA B RAL,RAL ADA B *5 CLB DIV D153 STA ITIME QUOTIENT=MONTH. LDA B CLB DIV O5 INA GET DAY OF MONTH. JSB PD00 STA TMSG+8 LDB ITIME RECOVER MONTH BLS ADB MOTBA DLD B,I DST TMSG+10 CCA CALCULATE DAY OF WEEK. ADA IYEAR ARS,ARS ADA IYEAR ADA IDAY CLB DIV O7 BLS ADB DAYWK DLD B,I DST TMSG+5 LDB DM15 SET WORD COUNT STB COUNT LDA TMSGA AND THE TIME ARRAY OLOOP LDB A,I MOVE IT STB P1,I INA ISZ P1 ISZ COUNT JMP OLOOP * JMP FTIME,I RETURN * * * PD00 NOP CONVERT TO 2 ASCII DIGITS CLB DIV D10 DIVIDE BY 10 A=HIGH ,B=LOW SZA SUPPRESS ADA "0" LEADING ZEROS ALF,ALF PUT HIGH TO HIGH ADA B ADD IN THE LOW IOR "0" ADD ASCII BLANK 0 JMP PD00,I RETURN * "0" ASC 1, 0 ":" ASC 1, : D10 DEC 10 DM15 DEC -15 COUNT BSS 1 O5 OCT 5 O7 OCT 7 D31 DEC 31 D100 DEC 100 D153 DEC 153 D366 DEC 366 * SPC 1 * ITIME NOP TENS OF MSEC NOP SEC IMIN NOP MIN IHOUR NOP IDAY NOP IYEAR NOP * SPC 1 * MESSAGE FORMAT: ASC 15,10:03 AM MON., 29 DEC., 1975 * 001122334455667788990011223344 * TMSGA DEF *+1 TMSG ASC 15,12:01 PM MON., 29 DEC., 1975 * DAYWK DEF *+1 ASC 14,FRI.SAT.SUN.MON.TUE.WED.THU. * MOTBA DEF *-1 ASC 2,MAR. ASC 6,APR.MAY JUNE ASC 6,JULYAUG.SEPT ASC 6,OCT.NOV.DEC. ASC 4,JAN.FEB. * END P  %- 92101-18001 1826 S C0222 BASIC MAIN              H0102 ASMB,R,L,C HED <> 92101-19001 REV.1826 NAM BASIC,4,88 92101-16001 REV.1826 780503 * * ************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1975. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * * PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ************************************************************** * * * LISTING: 92101-19002 * SOURCE: 92101-18001 * RELOC: 92101-16001 * * ************************************************************* * ENT SGMNT,FINDV,ERRPT,DRQST,WDRQS,GETCR,OUTCR,BCKSP,LETCK ENT PRMT,REED,WRITE,PEXMK,RDYPT,OUTER,INTCK ENT DIGCK,FNDPS,OUTIN,ENOUT,NUMOT,GETDG,RETCR ENT RPRCS,PRNIN,OUTLN,NUMCK,SSYMT,MVTOH,RUN,COMND ENT NORML,MBY10,DBY10,COMFL,PLIST,LOADT,.IENT,OLNCK EXT REIO,.FLUN,EXEC,READF,WRITF * EXT ..FCM,.PACK,RMPAR,BASC1 COM TEMPS(30),PNTRS(74),FILBF(16),FLDCB(144),SPEC(10) ************************************** * * * BASIC MAIN CONTROL * * * ************************************** * * THIS PART OF THE INTERPRETER REMAINS CORE RESIDENT DURING * THE EXECUTION OF BASIC. IT INTERPRETS AND EXECUTES ALL * OF THE SYSTEM COMMANDS BY LOADING THE APPROPRIATE SEGMENT * AND TRANSFERRING EXECUTION TO IT. UPON COMPLETION, THE * SEGMENTS RETURN EXECUTION TO THIS PROGRAM.IN ADDITION, IT * PROVIDES FOR ALL USER COMMUNICATION WITH THE INTERPRETER. * THERE ARE 8 SEGMENTS WHICH MAY CALLED BY THE MAIN CONTROL: * * SEGMENT #1: CHECKS SYNTAX AND TRANSLITERATES CODE * SEGMENT #2: LISTS THE PROGRAM * SEGMENT #3: CHECKS THE PROGRAM PRIOR TO EXECUTION * SEGMENT #4: EXECUTES THE PROGRAM * SEGMENT #5: EXECUTES COMMANDS * SEGMENT #6: EXECUTES +MORE COMMANDS * SEGMENT #7: EXECUTES DEBUG COMMANDS * SEGMENT #8: EXECUTES NON-TIME DEPENDENT STATEMENTS * * * TO RUN BASIC USE: * * *ON,BASIC,CONSOLE LU,LIST LU,INPUT LU,OUTPUT LU, ERROR LU * * OR * * *ON,BASIC,NA,ME,XX,CONSOLE LU,LIST LU * * WHERE: NAMEXX = THE COMMAND FILE NAME * *************************** * * * CONSTANTS AND VARIABLES * * * *************************** * FWAM EQU PNTRS FIRST WORD OF AVAILABLE MEMORY LWBM EQU PNTRS+1 LAST WORD OF AVAILABLE MEMORY .INBF EQU PNTRS+2 INPUT BUFFER ADDRESS SBUFA EQU PNTRS+3 SYNTAX BUFFER ADDRESS SYMTA EQU PNTRS+4 START OF SYMBOL TABLE SYMTF EQU PNTRS+5 END OF SYMBOL TABLE PBUFF EQU PNTRS+6 FIRST WORD OF USER PROGRAM PBPTR EQU PNTRS+7 LAST WORD+1 OF USER PROGRAM INBFA EQU PNTRS+8 INPUT BUFFER POINTER ICCNT EQU PNTRS+9 INPUT CHARACTER COUNT SBPTR EQU PNTRS+10 SYNTAX BUFFER POINTER .LNUM EQU PNTRS+11 CURRENT LINE # FCORE EQU PNTRS+12 START OF FREE CORE MNNAM EQU PNTRS+13 MNEMONIC TABLE NAME:SC:LU BRNAM EQU PNTRS+18 BRANCH TABLE NAME:SC:LU FWAMM EQU PNTRS+23 POINTER TO START OF MNEMONIC TABLE FWAMB EQU PNTRS+24 POINTER TO START OF BRANCH TABLE .OTBF EQU PNTRS+25 POINTER TO OUTPUT BUFFER OCCNT EQU PNTRS+26 OUTPUT CHARACTER COUNT OTBFA EQU PNTRS+27 POINTER INTO OUTPUT BUFFER LUOUT EQU PNTRS+28 CURRENT OUTPUT L.U. # LUINP EQU PNTRS+29 CURRENT INPUT L.U. # SIGN EQU PNTRS+30 SIGN OF CURRENT NUMBER BLANK EQU PNTRS+31 CURRENT TERMINATION CHAR REC# EQU PNTRS+32 COMMAND FILE RECORD NUMBER FLTYP EQU PNTRS+33 TYPE 0 FILE FLAG TTYPR EQU PNTRS+34 CONSOLE TTY L.U. # PRINT EQU PNTRS+35 LISTING L.U. # READR EQU PNTRS+36 AUXILLIARY INPUT L.U. # PUNCH EQU PNTRS+37 AUXILLIARY OUTPUT L.U. # ERTTY EQU PNTRS+38 ERROR LIST OUTPUT L.U. # DCB EQU PNTRS+39 DATA CONTROL BLOCK ADDRESS FILBK EQU PNTRS+40 FILE CONTROL BLOCK ADDRESS PFLAG EQU PNTRS+41 SAVE,LOAD FILE FLAG LOLIM EQU PNTRS+42 LOW LIMITS OF PROGRAM HILIM EQU PNTRS+43 HIGH LIMITS OF PROGRAM LORUN EQU PNTRS+44 LOW RUN LIMITS HIRUN EQU PNTRS+45 HIGH RUN LIMITS SLSTM EQU PNTRS+46 EXECUTE SLOW STMTS LOTRC EQU PNTRS+47 LOW TRACE LIMITS HITRC EQU PNTRS+48 HIGH TRACE LIMITS BRKP1 EQU PNTRS+49 BREAK POINT #1 BRKP2 EQU PNTRS+50 BREAK POINT #2 BRKP3 EQU PNTRS+51 BREAK POINT #3 BRKP4 EQU PNTRS+52 BREAK POINT #4 SMFLG EQU PNTRS+53 SIMULATE FLAG TYPE EQU PNTRS+54 PARTIAL LINE CHARACTER COUNT DLMTR EQU PNTRS+55 CHAR EDIT DELIMITER MERGF EQU PNTRS+56 MERGE FLAG COMN EQU PNTRS+57 COMMAND FILE NAME MANT1 EQU PNTRS+60 MANTISSA #1 MANT2 EQU PNTRS+61 MANTISSA #2 EXPNT EQU PNTRS+62 EXPONENT INLOC EQU PNTRS+63 INV. LOC. LU,STRK,#TKRS INTKZ EQU PNTRS+64 TRACK SIZE ON DISC FOR INV. HSTPT EQU PNTRS+65 HIGH-STACK POINTER TSTPT EQU PNTRS+66 TEMPORARY STACK POINTER LSTPT EQU PNTRS+67 LOW-STACK POINTER LSTAK EQU PNTRS+68 LOW-STACK ADDRESS PRADD EQU PNTRS+69 PROGRAM EXECUTION DSTRT EQU PNTRS+70 DATA NXTDT EQU PNTRS+71 STATEMENT DCCNT EQU PNTRS+72 POINTERS NXTST EQU PNTRS+73 NEXT STMT SYFLG BSS 1 SYNTAX SEGMENT FLAG TEMPT BSS 15 * RDYA DEF READY QMRKA DEF QMARK ACKNA DEF ACKNW SPC 1 SUP PRESS MULTIPLE LISTING SPC 1 .1 DEC 1 .2 DEC 2 .3 DEC 3 .4 DEC 4 .5 DEC 5 .6 DEC 6 .8 DEC 8 .9 DEC 9 .12 DEC 12 .15 DEC 15 .26 DEC 26 .32 DEC 32 .36 DEC 36 .39 DEC 39 .43 DEC 43 .45 DEC 45 .46 DEC 46 .48 DEC 48 .49 DEC 49 .58 DEC 58 .80 DEC 80 .9999 DEC 9999 B77 OCT 77 E OCT 105 B177 OCT 177 B200 OCT 200 MSK0 OCT 377 B700 OCT 700 TENTH OCT 63146 RCODE OCT 100001 WCODE OCT 100002 HIMSK OCT 174000 MSK OCT 177400 M1 DEC -1 M2 DEC -2 M4 DEC -4 M5 DEC -5 M6 DEC -6 M7 DEC -7 M8 DEC -8 M14 DEC -14 M80 DEC -80 D72 OCT -72 M256 DEC -256 D133 OCT -133 M1000 DEC -1000 MSK3 EQU M7 * QMARK ASC 1,?_ : ACKNW ASC 1,>_ : READY OCT 6412 ASC 6,BASIC READY SEG ASC 3,BASC SGMSK OCT 30040 SKP ********************** * * * BASIC MAIN CONTROL * * * ********************** BASIC NOP ENTRY * JSB RMPAR FETCH LOGICAL DEF *+2 UNIT NUMBERS DEF TTYPR LDA .9999 SET FLAG TO STA PFLAG TO ENABLE BASIC INIT. CLA CLEAR INVOKE STA INLOC FLAG FIRST TIME LDB .3 GO TO SEG #3 TO INITIALIZE BASIC SPC 1 SGMNT BLF,BLF LOAD ALL BASIC SEGMENTS HERE ADB SGMSK STB SEG+2 JSB EXEC DEF *+3 DEF .8 DEF SEG SPC 1 RDYPT LDA TTYPR SET UP STA LUOUT INPUT AND STA LUINP OUTPUT DEVICE UNITS LDA M14 PRINT LDB RDYA THE BASIC'S 'NAME' JSB WRITE AND 'READY' JMP PRMT PROMPT! SPC 1 * EXECUTION RETURNED HERE FROM SEGMENT #1 SPC 1 * * PFLAG MAY HAVE THE FOLLOWING VALUES: * * PLFAG = -1 INPUT FROM TAPE * PFLAG = 0 INPUT FROM KEYBOARD * PFLAG = 1 INPUT FROM PROGRAM FILE * PFLAG = 2 INPUT FROM 'CHAIN' OR 'INVOKE' STATEMENT * PFLAG = 3 LOAD B&M TABLE FLAG * PFLAG = 4 INPUT FROM COMMAND FILE * PFLAG = 5 RUN A PROGRAM BY NAME * PFLAG = 9999 EXECUTE INITIALIZATION IN SEG 3(ONCE ONLY) * PEXMK LDA PFLAG CPA .1 FILE? JMP LOADF YES! CPA .2 CHAIN? JMP LOADF YES! CPA .5 RUN ? JMP LOADF YES! SZA IS TAPE FLAG SET? JMP MORTP GET RECORD FROM PHOTO RDR * * EXECUTION RETURNED HERE FROM SEGMENTS #5 AND #6 * PRMT LDA TTYPR INITIALIZE STA LUOUT INPUT AND STA LUINP OUTPUT DEVICES UNITS CLA,INA INITIALIZE STA rVLOLIM LOW LIMIT STA LORUN LDA .9999 INITIALIZE STA HILIM HIGH LIMIT STA HIRUN CLA STA SLSTM CLEAR SLOW STMT FLAG STA DRQST CLEAR DATA REQUEST FLAG STA PFLAG CLEAR TAPE INPUT FLAG STA SYFLG CLEAR SYNTAX SEGMENT FLAG STA MERGF CLEAR OUT MERGE FLAG CCA SET FOR STA FLTYP NO TYPE 0 I-O LDA REC# ARE WE IN CPA .1 COMMAND FILE? RSS NO! JMP COMFL YES,CONTINUE LDA M2 LDB ACKNA JSB WRITE PRINT '>' WITH NO CR-LF JMP GTRCD INPUT RECORD SPC 1 * WARNING DATA INDICATION-PRINTS EXTRA QUESTION MARK SPC 1 WDRQS NOP LDA LUINP AND B77 STRIP OFF CONTROL BITS JSB FINDV IS IT DVR05, SC0 OR DVR00? SZA,RSS DVR00? JMP QMK YES, PRINT QUESTION MARK! CPA .5 DVR05? RSS YES JMP WDRQS,I NO! SZB SC=0(KEYBD)? JMP WDRQS,I NO! QMK LDA M2 OUTPUT LDB QMRKA JSB WRITE '?' AND WAIT JMP WDRQS,I RETURN SPC 1 * PROCESS DATA REQUEST SPC 1 DRQST NOP LDA FLTYP TYPE 0 FILE? SZA,RSS JMP GTRCD YES! JSB WDRQS PRINT QUESTION MARK! SPC 1 * INPUT RECORD FROM TTY SPC 1 GTRCD LDA M80 LDB .INBF JSB REED GET RECORD FROM TT SPC 1 * PROCESS RECORD SPC 1 RPRCS CMA SET A = -1# CHARS STA ICCNT SET CHAR COUNT STA TEMP8 SET FOR ERROR PRINT OUT LDB .INBF LOAD BUFFER ADDRESS CLE,ELB SHIFT LEFT,LEAST BIT USED AS STB INBFA ODD/EVEN FLAG SZA,RSS NULL RECORD ? JMP GTRCD YES, INPUT AGAIN LDB DRQST SZB,RSS DATA REQUEST? JMP RPRC0 NO DATA REQUEST,GO CHECK RECORD CLA STA DRQST CLEAR DA}TA REQUEST FLAG JMP 1,I AND FAKE THE RETURN THRU DRQST SPC 1 * LOAD SYNTAX SEGMENT AND BRANCH TO IT SPC 1 RPRC0 JSB GETCR GET FIRST CHARACTER JMP GTRCD UNLESS THERE ISN'T ONE CKRCD LDB SBUFA INITIALIZE SYNTAX STB SBPTR BUFFER POINTER STA 1,I PUT FIRST CHAR IN SYNTAX BUFFER CPA DLMTR LIST NEXT LINE COMMAND? JMP COMND YES, LIST IT! JSB LETCK IS THIS A LETTER? RSS NO, GO TO SYNTAX PHASE JMP COMND YES, GO TO COMMAND PHASE LDA SYFLG LOAD SYNTAX SEGMENT FLAG SZA IS SEGMENT IN CORE? JSB BASC1 YES, BRANCH TO IT CCA SET SYNTAX SEGMENT FLAG STA SYFLG * LDB .1 LOAD JMP SGMNT SEGMENT #1 * BYE JSB EXEC TERMINATE BASIC DEF *+2 DEF .6 SKP * EXECUTION RETURNED HERE WHEN ERROR OCCURS * SET FOR PRINTING ERROR MESSAGE SPC 1 OUTER CCA SET L.U. NEGATIVE FOR FLAG STA LUOUT TO INDICATE ERROR MESSAGE JMP PLIST BRANCH TO LIST SEGMENT SPC 1 * EXECUTION RETURNED HERE AFTER PRINTING ERROR MESSAGE * SET FOR LOADING SYNTAX SEGMENT AGAIN SPC 1 ERRPT CLA CLEAR SYNTAX SEGMENT FLAG STA SYFLG STA PFLAG AND FILE FLAG INA SET FOR END STA REC# OF COMMAND FILE INPUT JMP PEXMK GO WAIT FOR INPUT * * GO TO SEG 6 TO INPUT COMMAND FILE * COMFL LDA .4 SET FOR STA PFLAG COMMAND FILE LDB .6 LOAD JMP SGMNT SEGMENT #6 FOR COMMAND FILE SKP * PROCESS SYSTEM COMMANDS SPC 1 * LOAD COMMAND SEGMENT SPC 1 * COMES HERE THROUGH SYNTAX SEGMENT (A) CONTAINS FIRST * CHARACTER OF COMMAND * COMND CLB CLEAR SYNTAX FLAG STB SYFLG LDB .5 LOAD SEG#5 FOR JMP SGMNT COMMANDS SPC 1 * PROCESS 'RUN' COM%MAND SPC 1 RUN LDB .3 LOAD SEG#3 JMP SGMNT TO START EXECUTION SPC 1 SPC 1 * PROCESS 'SAVE' & 'LIST' COMMAND SPC 1 PLIST LDB .2 LOAD SEG#2 JMP SGMNT TO LIST PROGRAM SPC 1 * PROCESS 'LOAD' COMMAND SPC 1 LOADT LDA PFLAG IS INPUT CPA .1 FROM FLAG? JMP LOADF YES! CPA .2 FROM 'CHAIN' JMP LOADF YES! CPA .5 RUN JMP LOADF YES! LDA READR SET L.U. TO READER STA LUINP AND B77 ISOLATE L.U. # IOR B700 MGE IN FUNCTION CODE STA LENTH SAVE IT JSB EXEC CALL EXEC DEF *+3 DEF .3 TO SET EOT BIT DEF LENTH * MORTP LDA M80 LDB .INBF JSB REED GET RECORD FROM READER CPA M1 END OF TAPE? JMP RDYPT YES SZA,RSS JMP MORTP NULL RECORD CCB SET PFLAG=-1 STB PFLAG SET TAPE INPUT FLAG # 0 JMP RPRCS GO PROCESS RECORD * LOADF JSB READF INPUT RECORD DEF *+6 DEF DCB,I DEF FERR DEF .INBF,I DEF .36 DEF LENTH JSB CKERR FILE ERROR? LDA LENTH EOF? SZA,RSS ZERO LENGTH? JMP LOADF YES, GET ANOTHER SSA ENCOUNTERED? JMP LOAD1 YES, CLOSE RAL SET UP STA ICCNT CHAR COUNT FOR INPUT BUFFER JMP RPRCS NO, PROCESS RECORD * * LOAD1 LDA PFLAG 'CHAIN' CPA .2 STATEMENT? JMP RUN YES, RUN PROGRAM CPA .5 RUN ? JMP RUN YES! LDA REC# INPUT FROM COMMAND CPA .1 FILE? JMP RDYPT NO! JMP COMFL YES! * SKP *********************** *********************** * * * UTILITY SUBROUTINES * * * *********************** * * THE  FOLLOWING SUBROUTINES ARE USED BY THE SEGMENTS OF THE * BASIC INTERPRETER AND THEREFORE ARE CORE RESIDENT. THEY * ARE DEFINED IN THE SEGMENTS AS BEING EXTERNAL. * * * * ******************** * * * CHECK FOR LETTER * * * ******************** LETCK NOP CHARACTER IN (A) LDB 0 ADB D133 ASCII 133B SSB,RSS OR GREATER? JMP LETCK,I YES, EXIT WITH CHARACTER IN (A) ADB .26 NO, ASCII 101B SSB,RSS OR GREATER? ISZ LETCK YES JMP LETCK,I NO ******************* * * * CHECK FOR DIGIT * * * ******************* DIGCK NOP CHARACTER IN (A) LDB 0 ADB D72 ASCII 72B SSB,RSS OR GREATER? JMP DIGCK,I YES, RETURN WITH CHARACTER ADB .10 NO, ASCII 60B SSB OR GREATER? JMP DIGCK,I NO ISZ DIGCK YES, SET 'SUCCESS' EXIT, LDA 1 LOAD DIGIT INTO (A), JMP DIGCK,I AND RETURN SKP ***************************** * * * ADD CHAR TO OUTPUT BUFFER * * * ***************************** OUTCR NOP CHARACTER IN (A) STA TEMP4 SAVE CHARACTER LDA .OTBF ADA .39 CPA OTBFA TRUNCATE ANY CHARACTERS OVER 80 COLUMNS JMP OUTCR,I ISZ OCCNT COUNT CHARACTERS LDB OCCNT FIRST CHARACTER SLB OF BUFFER WORD? ISZ OTBFA YES, MOVE TO FRESH WORD LDA OTBFA,I LOAD BUFFER WORD SLB SAVE ALF,ALF OTHER AND M256 CHARACTER IOR TEMP4 ADD NEW CHARACTER SLB POSITION ALF,ALF WORD AND STA OTBFA,I STORE IT JMP OUTCR,I ****************************** * * * GET CHAR FROM INPUT BUFFER * * * ********************U********** GETCR NOP ISZ ICCNT ANY CHARACTERS LEFT? RSS JMP GETCR,I NO, END-OF-FILE EXIT LDB INBFA LOAD BUFFER ADDRESS ISZ INBFA UPDATE FOR NEXT TIME CLE,ERB SET CHARACTER FLAG LDA 1,I LOAD CURRENT BUFFER WORD SEZ,RSS FIRST CHARACTER? ALF,ALF YES, POSITION IT AND B177 MASK EXTRANEOUS BITS CPA BLANK BLANK? JMP GETCR+1 YES, FETCH NEXT CHARACTER ISZ GETCR UPDATE RETURN ADDRESS JMP GETCR,I AND EXIT *************************** * * * BACKSPACE OVER ONE CHAR * * * *************************** BCKSP NOP CCA BACKSPACE ADA ICCNT OVER STA ICCNT LAST CCA CHARACTER IN ADA INBFA INPUT STA INBFA BUFFER JMP BCKSP,I SKP ***************************** * * * INITIALIZE FOR NEW LINE * * * ***************************** * PRNIN NOP CCA INITIALIZE ADA .OTBF BUFFER STA OTBFA POINTER CLA INITIALIZE STA OCCNT CHARACTER COUNTER JMP PRNIN,I SPC 1 ************************* * * * OUTPUT COMPLETED LINE * * * ************************* OUTLN NOP LDA OCCNT OUTPUT LDB .OTBF A JSB WRITE LINE JSB PRNIN CLEAN UP OUTPUT BUFFER STA TYPE RESET PARTIAL LINE COUNTER JMP OUTLN,I * * ***************************** * * * CHECK FOR LINE OVERFLOW * * * ***************************** * * AT ENTRY, A = NUMBER OF CHARACTERS * TO BE OUTPUT, EXCLUSIVE * OF TRAILING BLANKS. * o THIS ROUTINE CHECKS FOR LINES OVER 80 * CHARACTERS, AND OUTPUTS THEM BEFORE * FIGURING THE END OF FIELD FOR NUMERIC * FORMATTING. THE END OF FIELD COLUMN * NUMBER IS RETURNED IN TEM10. * OLNCK NOP STA BCKSP SAVE REQUEST LENGTH TEMPORARILY ADA OCCNT FIGURE LENGTH OF BUFFER ADA TYPE FIGURE COLUMN OF RESULT CMA,INA ADA .80 TOO MANY CHARACTERS ? SSA JSB OUTLN YES, OUTPUT LINE FIRST LDA BCKSP RECOVER REQUEST LENGTH ADA OCCNT AND FIGURE ADA .3 THE END-OF-FIELD STA TEM10 COLUMN NUMBER JMP OLNCK,I SKP ******************************* * * * FIND OUT THE DEVICE TYPE * * * ******************************* * * ON INPUT (A) = LU NUMBER * ON EXIT (A) = DVR NUMBER * (B) = SUB CHANL NUMBER * FINDV NOP STA SLU SET UP STATUS EXEC CALL JSB EXEC TO FETCH EQUIP TYPE CODE DEF FIND1 AND SUBCHANNEL NUMBER DEF .13 DEF SLU DEF EQT5 DEF EQT4 DEF SBCHN * FIND1 LDA SBCHN FETCH SC AND AND MSK0 REMOVE DOWN BIT LDB 0 LEAVE IT IN (B) LDA EQT5 ALF,ALF FETCH EQUIP CODE AND B77 JMP FINDV,I * .13 DEC 13 SLU NOP EQT5 NOP EQT4 NOP SBCHN NOP * SKP ******************** * * * FIND A STATEMENT * * * ******************** * * UPON ENTRY (A) = SEQUENCE NUMBER TO BE FOUND. IF (A) * IS LARGER THAN ANY SEQUENCE NUMBER IN THE PROGRAM, EXIT * TO (P+1) WITH (B) POINTING TO LAST WORD+1 OF THE PROGRAM * IF (A) FALLS BETWEEN TWO SEQUENCE NUMBERS, EXIT TO (P+2) * WITH (B) POINTING TO THE STATEMENT WITH THE LARGER SEQUENCE * NUMBER. IF A STATEMENT IN THE PROGRAM HAS THE SEQUENCE * NUMBER T|NHEN EXIT TO (P+3) WITH (B) POINTING TO THIS STATEMENT. * FNDPS NOP STA TEMP3 SAVE SEQUENCE NUMBER LDB PBUFF STARTING ADDRESS FNDP1 CPB PBPTR END OF PROGRAM? JMP FNDP4 YES, EXIT VIA (P+1) LDA TEMP3 SUBTRACT PROGRAM CMA,INA SEQUENCE NUMBER FROM ADA 1,I S-BUFFER SEQUENCE NUMBER SZA,RSS EQUAL? ISZ FNDPS YES, SET EXIT TO (P+3) SSA,RSS NO, P-SEQ NO > S-SEQ NO ? JMP FNDP3 YES, SET EXIT TO (P+2) LDA 1 POINT (A) TO INA PROGRAM ADDRESS INCREMENT ADB 0,I COMPUTE NEW ADDRESS JMP FNDP1 FNDP3 ISZ FNDPS FNDP4 STB TEMP3 SAVE STATEMENT ADDRESS JMP FNDPS,I ***************************** * * * MOVE WORDS TO HIGHER CORE * * * ***************************** MVTOH NOP LDB TEMP2 FETCH SOURCE ADDRESS MVTO1 CPB TEMP3 ALL RELOCATION DONE? JMP MVTOH,I YES, EXIT CCA BACK UP ADB 0 ADA TEMP4 SOURCE AND STA TEMP4 DESTINATION LDA 1,I MOVE STA TEMP4,I WORD JMP MVTO1 SKP *********************** * * * SEARCH SYMBOL TABLE * * * *********************** * * SSYMT IS CALLED WITH THE IDENTIFIER TO SEARCHED FOR IN * (A). IT RETURNS WITH THE ADDRESS OF THE MATCHING ENTRY * IN (B) OR (B)=-1 IF THERE IS NO MATCHING ENTRY. * * THE FOLLOWING RULES APPLY WHEN SEARCHING FOR ARRAYS: * * 1. TYPE 1 (ONE DIMENSION) SEARCH FOR CORRESPONDING * TYPE 1 OR TYPE 3 ARRAY. IF TYPE 3 IS FOUND CHANGE * THE ENTRY TO TYPE 1. * * 2. TYPE 2 (TWO DIMENSIONS) SEARCH FOR CORESPONDING * TYPES OR TYPE 3 ARRAY. IF TYPE 3 IS FOUND CHANGE * THE ENTRY TYPE TO TYPE 2. * * 3. TYPE 3 (UNDIMENSIONED) SEARCH FOR CORRESPONDING * TYPE 3 OR TYPE 1 OR TYPE 2 ARRAY. * SSYMT NOP STA STEMP 9 STORE IDENTIFIER AND .15 ISOLATE IDENTIFIER TYPE ADA M4 SSA,INA JMP *+4 JUMP IF ARRAY TYPE LDA STEMP RESTORE A STA 1 STORE IN B JMP SYMT1+3 SSA SKIP IF UNDIMENSIONED JMP SYMT1 LDA STEMP RESTORE A AND MSK3 177771B SET TYPE TO 1 STA 1 INB SET TYPE IN B TO 2 JMP *+4 SYMT1 CCB SET DIMENSIONED FLAG IN B LDA .3 IOR STEMP SET TYPE TO UNDEFINED STA STEMP+1 STORE A STB STEMP+2 STORE B LDB SYMTF START OF SYMBOL TABLE JMP SYMT4 SYMT2 LDA 1,I PICK UP 1ST WORD OF ENTRY CPA STEMP COMPARE WITH IDENTIFIER JMP SSYMT,I MATCH ? RETURN CPA STEMP+1 COMPARE WITH DIFFERENT DIM. JMP SYMT3 CPA STEMP+2 COMPARE WITH DIFFERENT DIM. JMP SYMT3 LDA 1,I AND .15 ISOLATE ENTRY TYPE CPA .15 FUNCTION ? JMP *+5 YES ADA M4 SSA ARRAY ? INB YES INCREMENT POINTER INB INCREMENT POINTER ADB .2 ADD 2 TO POINTER SYMT4 CPB SYMTA SYMBOL TABLE EXHAUSTED? ? CCB,RSS YES JMP SYMT2 NO, CHECK NEXT ENTRY FOR MATCH LDA STEMP RETRIEVE SYMBOL JMP SSYMT,I RETURN WITH B NEGATIVE SYMT3 LDA STEMP RESTORE A ISZ STEMP+2 DIMENSIONED IDENTIFIER? RSS NO, SKIP STA 1,I YES CHANGE 1ST WORD OF ENTRY TO JMP SSYMT,I APPROPRIATE DIMENSION TYPE SKP ************************* * * * FORMATTER SUBROUTINES * * * ************************* * * THE FOLLOWING SUBROUTINES ARE USED BY THE SEGMENTS OF THE * BASIC INTERPRETER TO PERFORM I/O FORMATTING OPERATIONS. * IN GENERAL, THEY PROVIDE FOR ASCII-TO-BINARY AND BINARY- * TO-ASCII CONVERSIONS. * ******************** * * * PRINT A NUMBER * * *NLH ******************** * * ENTER WITH A FLOATING PT NUMBER IN (A) AND (B). PRINT * THE NUMBER AND APPEND BLANKS TO REACH THE PRINT POSITION * SPECIFIED BY TEM10 ON RETURN FROM 'NUMOT'. * tNENOUT NOP CCE ENABLE SIGN JSB NUMOT OUTPUT NUMBER ENOU0 LDB TEM10 FIELD ADB M80 SSB,RSS OVERFLOW OF LINE WITH TRAILING BLNKS? JMP ENOUT,I LDB TEM10 FIELD CMB,INB ADB OCCNT SSB,RSS FULL? JMP ENOUT,I YES! LDA .32 NO, SO JSB OUTCR OUTPUT A BLANK JMP ENOU0 AND TRY AGAIN * MINFX DEC -0.099999959 MAXFX DEC -999999.5 NMBFA DEF *+1 NUMBF BSS 6 LDVSR DEF *+1 DEC 10000 DEC 1000 DEC 100 .10 DEC 10 SKP ************************ ** * *** OUTPUT A NUMBER * ** * ************************ * * ENTER WITH A FLOATING POINT NUMBER IN (A) AND (B) AND (E) = 1 * IF A SIGN IS WANTED. DETERMINE THE FORM OF THE NUMBER AND * SET TEM10 ACCORDINGLY. NON-INTEGERS ARE ROUNDED AFTER CONVERSION * TO DECIMAL. TRAILING ZEROS ARE SUPPRESSED ON NUMBERS WITHOUT * EXPONENTS. * NUMOT NOP STA NUMBF SAVE HIGH MANTISSA SEZ,RSS SIGN? JMP NUMO1 NO SSA,RSS YES, NEGATIVE NUMBER? JMP *+5 NO JSB ..FCM YES, NEGATE NUMBER STA NUMBF SAVE HIGH MANTISSA LDA .45 LOAD '-' RSS CLA LOAD '+' STA SIGN SAVE SIGN LDA NUMBF RETRIEVE HIGH MANTISSA NUMO1 STB NUMBF+1 SAVE LOW MANTISSA JSB IFIX INTEGER? JMP NUMO2 NO SOC YES, 16-BIT INTEGER? JMP NUMO2 NO * * ** OUTPUT AN INTEGER ** * * STB NUMBF SAVE INTEGER ADB M1000 LDA .3 SSB,RSS 3 DIGIT INTEGER? ADA .3 NO, ALL INTEGERS ARE 6 DIGITS OR LESS JSB OLNCK CHECK FOR LINE OVERFLOW LDA SIGN YES SZA SIGN? JSB OUTCR YES, OUTPUT IT LDA NUMBF NO JSB OUTIN OUTPUT THE INTEGER JMP NUTMOT,I * * ** OUTPUT A FLOATING POINT NUMBER ** * * NUMO2 LDA M2 SET 'FIXED' STA FFLAG FLAG FALSE DLD NUMBF LOAD NUMBER FAD MAXFX IS NUMBER SSA,RSS < 999999.5 ? JMP NUMO3 NO DLD NUMBF YES, IS FAD MINFX NUMBER * LESS THAN SSA,RSS 0.09999995 ? ISZ FFLAG NO, SET 'FIXED' FLAG TRUE NUMO3 DLD NUMBF LOAD NUMBER STA MANT1 UNPACK JSB .FLUN STB MANT2 NUMBER STA EXPNT CLA INITIALIZE STA EXPON DECIMAL EXPONENT CPA EXPNT ZERO EXPONENT? JMP NUMO5 YES NUMO0 JSB MBY10 NO LDA EXPNT MULTIPLY CMA,SSA,INA,SZA NUMBER BY 10 JMP *+3 UNTIL IT IS ISZ EXPON GREATER JMP NUMO0 THAN 1 JSB DBY10 DIVIDE BY 10 LDA EXPON NUMO4 LDB EXPNT DIVIDE CMB,INB NUMBER SSB,RSS BY 10 JMP NUMO5 UNTIL STA EXPON IT IS JSB DBY10 LESS CCA THAN ADA EXPON 1 JMP NUMO4 NUMO5 CMA SET EXPONENT STA EXPON TO TRUE VALUE-1 LDB M6 SET DIGIT STB DIGCT COUNTER LDB NMBFA SET BUFFER STB NMPTR POINTER * * ** CONVERT MANTISSA TO ASCII ** * * NUMO6 JSB GETDG STORE A ADA .48 DECIMAL STA NMPTR,I DIGIT ISZ NMPTR ISZ DIGCT SIXTH DIGIT? JMP NUMO6 NO JSB GETDG YES, ADA M5 NEXT DIGIT SSA >= 5 ? JMP NUMO9+1 NO * * ** ROUND ASCII MANTISSA ** * * LDB NMPTR NUMO7 ADB M1 LOAD LAST LDA 1,I DIGIT INA INCREMENT IT CPA .58 WAS IT A 9 ? RSS YES JMP NUMO9 NO CPB NMBFA LEADING DIGIT? JMP NUMO8 YES LDA .48 NO, OVERLAY STA 1,I A 0 JMP NUMO7 NUMO8 ISZ EXPON BUMP DECIMAL NOP EXPONENT AND LDA .49 OVERLAY A 1 NUMO9 STA 1,I LDA EXPON IS NUMBER SSA,RSS LESS THAN 1 ? JMP NMO11 NO STA TEMP6 YES LDA .48 LDB NMPTR NMO10 ISZ TEMP6 COUNT ZEROS NOP PLUS 1 ADB M1 LAST CPA 1,I DIGIT 0? JMP NMO10 YES LDA TEMP6 NO, ALL SIGNIFICANCE SSA IN SIX DIGITS? JMP NMO11 NO CCA YES, SET STA FFLAG 'FIXED' FLAG TRUE NMO11 LDA .9 COMPUTE ISZ FFLAG FIELD ADA .3 WIDTH JSB OLNCK CHECK FOR LINE OVERFLOW LDA SIGN YES SZA SIGN? JSB OUTCR YES, OUTPUT IT LDB M7 SET OUTPUT STB DIGCT DIGIT COUNTER LDB NMPTR CCA FIXED CPA FFLAG FORMAT? JMP *+5 NO LDA EXPON YES, SET CMA INDICATOR TO STA TEMP6 DECIMAL POINT JMP NMO16 STA TEMP6 SET INDICATOR FOR DECIMAL POINT JMP NMO14 NO * * ** DELETE TRAILING ZEROS ** * * NMO12 LDA DIGCT AT RIGHT OF INA DECIMAL CPA TEMP6 POINT? JMP *+6 NO STA DIGCT YES, DELETE ZERO NMO16 ADB M1 LAST LDA 1,I DIGIT CPA .48 0? JMP NMO12 YES CCA NO, FIXED CPA FFLAG FORMAT? JMP NMO14 NO LDA EXPON YES, LEADING SSA,RSS DECIMAL POINT?  JMP NMO14 NO STA TEMP6 YES, SET LEADING ZEROS COUNTER * * ** OUTPUT MANTISSA ** * * LDA .46 OUTPUT A RSS DECIMAL POINT NMO13 LDA .48 OUTPUT JSB OUTCR A ZERO ISZ TEMP6 MORE LEADING ZEROS? JMP NMO13 YES ISZ DIGCT NO, COUNT DECIMAL POINT NMO14 LDB NMBFA SET STB NMPTR DIGIT POINTER JMP *+5 NMO15 ISZ TEMP6 DECIMAL POINT NEXT? JMP *+3 NO LDA .46 YES, LOAD IT JMP *+3 LDA NMPTR,I LOAD NEXT ISZ NMPTR DIGIT JSB OUTCR OUTPUT CHARACTER ISZ DIGCT MORE DIGITS? JMP NMO15 YES ISZ FFLAG NO, EXPONENT? JMP NUMOT,I NO * * ** OUTPUT THE EXPONENT ** * * LDA E JSB OUTCR OUTPUT AN 'E' LDA .45 OUTPUT LDB EXPON SSB AN CMB,INB,RSS LDA .43 EXPONENT STB EXPON JSB OUTCR SIGN LDA EXPON CLB COMPUTE DIV .10 ADA .48 EXPONENT'S ADB .48 STB EXPON 10'S DIGIT JSB OUTCR OUTPUT IT LDA EXPON OUTPUT JSB OUTCR 1'S DIGIT JMP NUMOT,I SKP ********************* * * * OUTPUT AN INTEGER * * * ********************* OUTIN NOP INTEGER IN (A) LDB M4 SET DIGIT STB DIGCT COUNTER LDB LDVSR SET DIVISOR STB TEMP7 ADDRESS CLB SUPPRESS STB TEMP6 ZEROES OUTI1 DIV TEMP7,I DIVIDE INTEGER STB TEMP5 CURRENT DIVISOR CPA TEMP6 LEADING ZERO? JMP OUTI2 YES! ADA .48 NO, TURN OFF STA TEMP6 ZERO SUPPRESSION JSB OUTCR OUTPUT DIGIT OUTI2 CLB LDA TEMP5 RETRIEVE REMAINDER ISZ TEMP7 SET FOR NEXT DIVISOR ISZ DIGCT ALL DIVISOR USED? JMP OUTI1 NO! ADA .48 YES, OUTPUT JSB OUTCR LAST DIGIT JMP OUTIN,I * ****************************** * * * ASCII-TO-BINARY CONVERSION * * * ****************************** NUMCK NOP CHARACTER IN (A), SIGN SETE CLB STB EXPNT ZERO STB EXP STB MANT1 ALL STB MANT2 COMPONENTS STB EXPON OF NUMBER STB TEMP3 SET 'NUMBER' FLAG FALSE CCB SET 'DECIMAL POINT' STB DPFLG FLAG FALSE NUMC1 CPA .46 DECIMAL POINT? ISZ DPFLG YES, SET FLAG TRUE JMP NUMC2 NO CLA INITIALIZE POST-DECIMAL DIGIT STA EXPON DIGIT COUNTER TO ZERO JMP NUMC3+1 FETCH A CHARACTER NUMC2 JSB DIGCK DIGIT? JMP NUMC7 NO ISZ EXPON YES, COUNT DIGIT ALF,ALF LEFT-JUSTIFY ALF,RAR DIGIT AND STA TEMP4 SAVE IT JSB MBY10 MULTIPLY PREVIOUS NUMBER BY 10 LDB EXPNT SZB ZERO EXPONENT? JMP NUMC4 NO LDA .4 YES, SET STA EXPNT EXPONENT TO 4 LDA TEMP4 LOAD CLB NUMBER NUMC3 JSB NORML NORMALIZE THE NUMBER ISZ TEMP3 SET 'NUMBER OCCURRED' FLAG JSB GETCR ANOTHER CHARACTER? JMP NUM12 NO JMP NUMC1 YES NUMC4 ADB M4 COMPUTE CMB EXPONENT LDA TEMP4 BIAS AND STB TEMP4 SAVE IT CLB NUMC5 ISZ TEMP4 DIGIT POSITIONED? JMP NUMC6 NO CLE YES, ADD IN ADB MANT2 LOW PART CLO OF NUMBER SEZ OVERFLOW? INA YES, BUMP (A) ADA MANT1 ADD IN HIGH PART OF NUMBER SOS OVERFLOW? JMP NUMC3 NO CLE,ERA YES, ROTATE ERB DOWN AND ISZ EXPNT BUMP NOP EXPONENT JMP NUMC3 NUMC6 CLE,ERA SHIFT ERB DIGIT JMP NUMC5 RIGHT NUMC7 CLB DECIMAL POINT STB TEMP4 CPB TEMP3 OR DIGIT FOUND? JMP NUMCK,I NO, EXIT VIA (P+1) CPA E YES, 'E' ? RSS YES JMP NUM12 NO, NO EXPONENT PART JSB GETCR JMP NUMER CPA .43 '+' ? JMP NUMC8 YES CPA .45 NO, '-' ? CCA,RSS YES JMP NUMC9 NO STA TEMP4 NOTE MINUS SIGN NUMC8 JSB GETCR JMP NUMER NUMC9 JSB DIGCK DIGIT? JMP NUMER NO STA TEMP3 YES, SAVE IT JSB GETCR JMP NUM10 SECOND JSB DIGCK DIGIT? JMP NUM10 NO LDB TEMP3 YES BLS,BLS MULTIPLY ADB TEMP3 PRIOR DIGIT BLS BY 10 ADA 1 ADD NEW DIGIT STA TEMP3 SAVE EXPONENT JSB GETCR JMP NUM10 THIRD JSB DIGCK DIGIT? RSS NO JMP NUMER YES NUM10 LDA TEMP3 LOAD EXPONENT ISZ TEMP4 POSITIVE? CMA,INA YES, COMPLEMENT IT RSS NO NUM12 CLA CLEAR IF NO EXPONENT PART ISZ DPFLG DECIMAL POINT? ADA EXPON YES, CORRECT EXPONENT SZA,RSS ZERO EXPONENT? JMP NUM14 YES SKP SSA NO, NEGATIVE EXPONENT? JMP NUM13 NO CMA,INA YES, SET STA EXPON COUNTER JSB DBY10 DIVIDE NUMBER BY 10 ISZ EXPON DONE? JMP *-2 NO JMP NUM14 YES NUM13 STA EXPON SET COUNTER JSB MBY10 MULTIPLY BY 10 ISZ EXPON DONE? JMP *-2 NO NUM14 LDA EXPNT STA EXP LDA MANT1 YES, LOAD LDB MANT2 NUMBER ISZ SIGN  POSITIVE? JMP NUM15 YES CMA NO, CMB,INB,SZB,RSS COMPLEMENT INA IT NUM15 JSB .PACK PACK NUMBER INTO (A) AND (B) EXP BSS 1 EXPONENT ISZ SBPTR STA SBPTR,I STORE ISZ SBPTR NUMBER IN STB SBPTR,I PROPER ISZ SBPTR LOCATION JSB BCKSP FETCH JSB GETCR FIRST LDA .10 UNUSED CHARACTER ISZ NUMCK NUMER ISZ NUMCK RETURN JMP NUMCK,I VIA (P+2) OR (P+3) SKP *************************************** * * * INTEGERIZE FLOATING POINT nUMBER * * * *************************************** * * ENTER WITH A F.P. NUMBER IN (A) AND (B). IF EXPONENT * EXCEEDS 23, NUMBER HAS INTEGER SIGNIFICANCE EXIT TO (P+1) * ALL OTHER CASES EXIT TO (P+2) WITH 32 BIT INTEGER RIGHT * JUSTIFIED IN (A) AND (B). ON EXIT (O) = 1 IF NUMBER IS EXACTLY * REPRESENTABLE AS 16 BIT INTEGER. IF EXPONENT IS NEGATIVE, TRUN- * CATE TO 0 OR -1 APPROPRIATELY AND LET (O) = 1. OTHERWISE RIGHT * JUSTIFY INTEGER AND EXIT WITH LAST BIT LOST IN (E). * IFIX NOP STO SET OVERFLOW FLAG STA MANT1 SAVE (A) CLA OCT 101050 LSR 8, GET EXPONENT ALF,ALF IN (A) AND BLF,BLF MANTISSA IN (B) SLA,RAR NEGATIVE EXPONENT? IOR SMASK YES, PROPAGATE SIGN SSA EXPONENT NON-NEGATIVE? JMP IFIX3 NO, RETURN 0 OR -1 ADA M16 SSA EXPONENT LESS THAN 16? CLO YES, CLEAR OVERFLOW ADA M8 SSA,RSS EXPONENT LESS THAN 24? JMP IFIX,I NO, ERROR EXIT, NO FRACTION * ADA M8 STA MANT2 SAVE SHIFT COUNT LDA MANT1 RETRIEVE HIGH MANTISSA JMP IFIX2 * IFIX1 CLE,SLA,ARS LONG RIGHT SHIFT CME SLB,ERB STO SET OVERFLOW IF 1 LOST xIFIX2 ISZ MANT2 DONE? JMP IFIX1 NO, SHIFT SOME MORE ISZ IFIX DONE, SKIP (P+1) JMP IFIX,I RETURN (P+2) * IFIX3 LDA MANT1 NEGATIVE EXPONENT, RETRIEVE (A) CLE,SSA CCA,CCE TRUNCATE TO -1 OR 0 CLA,RSS CCB,RSS CLB JMP IFIX2+2 SKIP RETURN * SMASK OCT 77600 M16 DEC -16 SKP ********************************************* * * * SUBROUTINE TO COMPUTE THE ENTIER OF A&B * * * ********************************************* * * ENTER WITH NUMBER IN (A) AND (B). IF EXPONENT > 14 THEN * EXIT TO (P+1), ELSE EXIT TO (P+2) WITH THE ENTIER OF THE * ARGUMENT IN (A). * .IENT NOP JSB IFIX JMP .IENT,I OVERFLOW XOR 1 (A) SHOULD BE FULL OF SIGN BITS SSA (B) SHOULD HAVE A SIGN TOO JMP .IENT,I IT DOESNT, ERROR EXIT CPA 1 IF (A) WAS ZERO JMP *+3 ALL IS OK CMA IF (A) WAS -1 CPA 1 ISZ .IENT ALSO OK, SKIP RETURN JMP .IENT,I LEAVE WITH RESULT IN A AND B. SKP ********************* * * * FORMAT AN INTEGER * * * ********************* INTCK NOP CHARACTER IN (A) CLB STORE STB INTGR PARTIAL RESULT INTC1 JSB DIGCK DIGIT? JMP INTC2 NO CLO LDB INTGR MULTIPLY ADB 1 PARTIAL ADB 1 RESULT ADB INTGR BY ADB 1 10 ADB 0 ADD LATEST DIGIT SOC OVERFLOW? JMP INTC3 YES STB INTGR STORE PARTIAL RESULT JSB GETCR NO, FETCH LDA .10 NEXT CHARACTER JMP INTC1 INTC2 LDB INTGR ZERO SZB,RSS INTEGER? JMP INTC3 YES STB SBPTR,I NO, RECORD IT LDB INTCK,I INTEGER LDB 1,ݘI TOO ADB INTGR LARGE? SSB,RSS JMP INTC3 YES LDB INTGR NO, ISZ SBPTR RETURN WITH ISZ INTCK INTEGER IN (B)B INTC3 ISZ INTCK SET FOR 'FAIL' RETURN JMP INTCK,I SKP *********************** * * * GET DIGIT TO OUTPUT * * * *********************** GETDG NOP JSB MBY10 MULTIPLY BY 10 LDB EXPNT GET EXPONENT IN (B) CMB,INB AS NEGATIVE AND HIMSK KEEP 5 HIGH BITS OF (A) RAL NORMALIZE TO BIT 15 SSB,INB ROTATE INTEGER JMP *-2 INTO (A) AND MSK0 EXTRACT STA TEMP5 DIGIT LDB EXPNT ROTATE CMB,INB RAR BACK SSB,INB JMP *-2 XOR MANT1 REMOVE LDB MANT2 DIGIT JSB NORML NORMALIZE REMAINDER LDA TEMP5 LOAD (A) WITH DIGIT JMP GETDG,I ************************************ * * * RETRIEVE CHAR FROM OUTPUT BUFFER * * * ************************************ RETCR NOP LDB OCCNT DECREMENT ADB M1 CHARACTER STB OCCNT COUNT LDA OTBFA,I POSITION SLB,RSS AND ALF,ALF EXTRACT AND MSK0 CHARACTER SLB FIRST CHARACTER OF WORD? JMP RETCR,I NO LDB OTBFA YES, DECREMENT ADB M1 BUFFER STB OTBFA POINTER JMP RETCR,I SKP ********************************** * * * MULTIPLY UNPACKED NUMBER BY 10 * * * ********************************** MBY10 NOP LDA MANT1 RETURN ON SZA,RSS ZERO JMP MBY10,I MANTISSA LDB EXPNT MULTIPLY ADB .3 BY STB EXPNT 8 LDB MANT2 LOAD MANTISS'A CLE,ERA DIVIDE ERB BY CLE,ERA 4 ERB,CLE ADB MANT2 DOUBLE SEZ ADD TO INA PRODUCE ADA MANT1 1.25 * MANTISSA SSA,RSS CORRECT JMP *+5 CLE,ERA ON ERB ISZ EXPNT OVERFLOW NOP STA MANT1 STB MANT2 JMP MBY10,I ******************************** * * * DIVIDE UNPACKED NUMBER BY 10 * * * ******************************** DBY10 NOP MULTIPLY BY DOUBLE-LENGTH TENTH LDA MANT1 RETURN SZA,RSS ON ZERO JMP DBY10,I MANTISSA LDB M2 ADD EXPONENT OF ADB EXPNT 'TENTH' TO STB EXPNT MANTISSA EXPONENT LDA MANT2 JUSTIFY CLE,ERA LOWER NTISSA MPY TENTH MULITPLY BY ONE-TENTH(63146) CLE,ELA SHIFT ELB,CLE BACK ADA 1 ADD IN LOWER MANTISSA* SEZ TENTH*(2)-16 INB AND ROUND STB MANT2 TO 16 BITS LDA MANT1 DO MPY TENTH SAME FOR CLE HIGH ADA 1 MANTISSA ADA MANT2 (EFFECTIVELY) SUM SEZ DOUBLE-LENGTH INB PRODUCTS STB MANT1 EXCHANGE STA 1 (A) AND (B) LDA MANT1 REGISTERS JSB NORML NORMALIZE RESULT JMP DBY10,I ******************************* * * * NORMALIZE (A), (B) AND EXPNT* * * ******************************* NORML NOP STA TEMP3 SET LEFT-SHIFT CLA COUNTER STA FERR TO ZERO LDA TEMP3 SZA,RSS ON SZB ZERO JMP NORM3 CLEAR STA EXPNT EVERYTHING STA MANT1 STORE NORM1 STB MANT2 MANTISSA JMP NORML,I AND RETURN NORM2 ISZ FERR COUNT LEFT SHIFTS NORM3 CLE,ELB ROTATE (A) AND ELA (B) LEFT INTO (E) SEZ,SSA,RSS TWO HIGHEST BITS 0? JMP NORM2 YES, + UNNORMALIZED SEZ,SSA NO, TWO HIGHEST BITS 1? JMP NORM2 YES, - UNNORMALIZED ERA SHIFT TO ERB,CLE NORMALIZE MANTISSA STA MANT1 NO, LDA FERR COMPUTE CMA,INA CORRECTED ADA EXPNT EXPONENT STA EXPNT VALUE LDA MANT1 JMP NORM1 SKP SPC 3 TEMP1 EQU TEMPS+2 TEMP2 EQU TEMPS+3 TEMP3 EQU TEMPS+4 STEMP EQU TEMPS+4 TEMP4 EQU TEMPS+5 TEMP5 EQU TEMPS+6 TEMP6 EQU TEMPS+7 TEMP7 EQU TEMPS+8 TEMP8 EQU TEMPS+9 TEMP9 EQU TEMPS+10 TEM10 EQU TEMPS+11 FFLAG EQU TEMPT+1 DPFLG EQU TEMPT+2 NMPTR EQU TEMPT+3 DIGCT EQU TEMPT+4 FERR EQU TEMPT+5 FILE ERROR FLAG LENTH EQU TEMPT+8 EXPON EQU TEMPT+9 INTGR EQU TEMPT+1 SKP ******************* * * * I/O SUBROUTINES * * * ******************* * * THE FOLLOWING SUBROUTINES ARE PRIMARILY USED BY THE BASIC * MAIN CONTROL FOR DOING I/O. THE INDIVIDUAL SEGMENTS MAY * ALSO CONTAIN SOME SPECIALIZED I/O ROUTINES. * *********************** * * * PRINT A LINE * * * *********************** WRITE NOP ENTRY SSA,RSS IF LENGTH > 0, MAKE CMA,INA NEGATIVE FOR CHARS STA LENTH SAVE IT STB WBUF1 SAVE BUFFER ADDRESS STB WBUF2 LDB FLTYP TYPE 0 SZB,RSS OUTPUT? JMP WRIT1 YES! JSB REIO RE-ENTRANT I/O DEF *+5 DEF WCODE TO PRINT DEF LUOUT WBUF1 BSS 1 LINE ON DEF LENTH JMP RWERR ERROR CODE IF THIS IS EXECUTED JMP WRITE,I TTY * WRIT1 JSB WRITF WRITE $YDEF *+5 DEF DCB,I TO DEF FERR WBUF2 DEF 0 TYPE 0 FILE DEF LENTH JSB CKERR ERROR? CCB SET FOR STB FLTYP NON-TYPE 0 OUTPUT JMP WRITE,I * ************************ * * * READ A LINE * * * ************************ REED NOP ENTRY STA LENTH SAVE BUFFER LENGTH STB KBUF1 AND ADDRESS STB KBUF2 LDB FLTYP TYPE 0 SZB,RSS FILE? JMP REED1 YES! JSB REIO CALL REIO DEF *+5 DEF RCODE TO READ A DEF LUINP KBUF1 BSS 1 LINE OF ASCII DEF LENTH JMP RWERR ILLEGAL READ(PROBABLY ILLEGAL LU) STA MANT1 STB LENTH AND .32 END OF SZA PAPER TAPE? JMP REED2 YES LDA MANT1 AND B200 EOF ON SZA CARTRIDGE TAPE? REED2 CCB YES! LDA 1 NO, RETURN WITH JMP REED,I LENGTH IN (A) * * REED1 LDA LENTH CMA,INA ARS STA LENTH JSB READF READ DEF *+6 DEF DCB,I A DEF FERR KBUF2 DEF 0 LINE DEF LENTH DEF LENTH FROM TYPE 0 FILE JSB CKERR ERROR? CCB SET FOR STB FLTYP NON-TYPE 0 INPUT LDA LENTH ALS SET FOR CHARACTER COUNT JMP REED,I * * ************************** * * * CHECK FOR FILE ERROR * * * ************************** * CKERR NOP LDA FERR FILE SSA,RSS ERROR? JMP CKERR,I NO STA TEMP3 JMP OUTER YES, PRINT MESSAGE * RWERR LDA M4 ILLEGAL READ/WRITE STA FERR JSB CKERR * END BASIC NLHHN 'G 92101-18002 A S C0122 BASIC-SPECIAL SYNTAX DUMMY             H0101 !ASMB,R,L,C HED ** DUMMY SPEC. SYNTAX MODULE ** 92101-19002 REV. A NAM SPDUM,7 92101-16002 750724 * * ************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1975. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * * PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ************************************************************** * * LISTING: 92101-19002 * SOURCE: 92101-18002 * RELOC: 92101-16002 * * * * DUMMY SPECIAL SYNTAX MODULE * * * ENT SPEC1,SPEC2,SPEC3,SPEC4,SPTBL,SPNCT * * SPNCT DEC 0 COUNT OF SPECIAL SYNTAX STATEMENTS SPTBL EQU * SPEC1 EQU * SPEC2 EQU * SPEC4 EQU * SPEC3 NOP ISZ SPEC3 JMP SPEC3,I END A (. 92101-18003 1826 S C0322 BASIC SEGMENT #1              H0103 JASMB,R HED <> 92101-19003 REV.1826 NAM BASC1,5 92101-16003 REV.1826 780503 * * * ************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1975. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * * PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ************************************************************** * * * * LISTING: 92101-19003 * SOURCE: 92101-18003 * RELOC: 92101-16003 * * * ************************************************************* * * ENT BASC1 EXT PLIST,PEXMK,GETCR,LETCK,DIGCK,INTCK,MVTOH EXT BCKSP,FNDPS,NUMCK,OUTER EXT FCNS,FCNCT,SPEC1,SPTBL,SPNCT COM TEMPS(30),PNTRS(74),FILBF(16),FLDCB(144),SPEC(10) **************************************************** * * * SEGMENT #1: CHECK SYNTAX AND TRANSLITERATE * * * **************************************************** * * THIS PART OF THE INTERPRETER IS LOADED BY THE BASIC MAIN CONTROL * WHENEVER A RECORD IS INPUT WITH A NUMBER AS THE FIRST CHAR. IT * WILL CONVERT AN ASCII STATEMENT RECORD INTO THE SPECIAL BINARY * CODE WHICH IS USED BY THE LIST AND EXECUTION SEGMENTS OF THE * INTERPRETER. AFTER EACH STATEMENT IS PROCESSED, EXECUTION IS * RETURNED TO THE MAIN CONTROL PROGRAM. THE GENERAL FORM OF THE * TRANSLITERATED CODE IS SHOWN BELOW: * * WORD #1 - LINE NUMBER * WORD #2 - # WORDS IN TRANSLITERATED STATEMENT * WORD #3 > WORD #N - OPERATORS, CONSTANTS, ETC. SKP *************************** * * * CONSTANTS AND VARIABLES * * * *************************** * FWAM EQU PNTRS FIRST WORD OF AVAILABLE MEMORY LWBM EQU PNTRS+1 LASTp WORD OF AVAILABLE MEMORY .INBF EQU PNTRS+2 INPUT BUFFER ADDRESS SBUFA EQU PNTRS+3 SYNTAX BUFFER ADDRESS SYMTA EQU PNTRS+4 START OF SYMBOL TABLE SYMTF EQU PNTRS+5 END OF SYMBOL TABLE PBUFF EQU PNTRS+6 FIRST WORD OF USER PROGRAM PBPTR EQU PNTRS+7 LAST WORD+1 OF USER PROGRAM INBFA EQU PNTRS+8 INPUT BUFFER POINTER ICCNT EQU PNTRS+9 INPUT CHARACTER COUNT SBPTR EQU PNTRS+10 SYNTAX BUFFER POINTER .LNUM EQU PNTRS+11 CURRENT LINE # FCORE EQU PNTRS+12 START OF FREE CORE MNNAM EQU PNTRS+13 MNEMONIC TABLE NAME:SC:LU BRNAM EQU PNTRS+18 BRANCH TABLE NAME:SC:LU FWAMM EQU PNTRS+23 POINTER TO START OF MNEMONIC TABLE FWAMB EQU PNTRS+24 POINTER TO START OF BRANCH TABLE .OTBF EQU PNTRS+25 POINTER TO OUTPUT BUFFER OCCNT EQU PNTRS+26 OUTPUT CHARACTER COUNT OTBFA EQU PNTRS+27 POINTER INTO OUTPUT BUFFER LUOUT EQU PNTRS+28 CURRENT OUTPUT L.U. # LUINP EQU PNTRS+29 CURRENT INPUT L.U. # SIGN EQU PNTRS+30 SIGN OF CURRENT NUMBER BLANK EQU PNTRS+31 CURRENT TERMINATION CHAR REC# EQU PNTRS+32 COMMAND FILE RECORD NUMBER FLTYP EQU PNTRS+33 TYPE 0 FILE FLAG TTYPR EQU PNTRS+34 CONSOLE TTY L.U. # PRINT EQU PNTRS+35 LISTING L.U. # READR EQU PNTRS+36 AUXILLIARY INPUT L.U. # PUNCH EQU PNTRS+37 AUXILLIARY OUTPUT L.U. # ERTTY EQU PNTRS+38 ERROR LIST OUTPUT L.U. # DCB EQU PNTRS+39 DATA CONTROL BLOCK ADDRESS FILBK EQU PNTRS+40 FILE CONTROL BLOCK ADDRESS PFLAG EQU PNTRS+41 SAVE,LOAD FILE FLAG LOLIM EQU PNTRS+42 LOW LIMITS OF PROGRAM HILIM EQU PNTRS+43 HIGH LIMITS OF PROGRAM LORUN EQU PNTRS+44 LOW RUN LIMITS HIRUN EQU PNTRS+45 HIGH RUN LIMITS SLSTM EQU PNTRS+46 EXECUTE SLOW STMTS LOTRC EQU PNTRS+47 LOW TRACE LIMITS HITRC EQU PNTRS+48 HIGH TRACE LIMITS BRKP1 EQU PNTRS+49 BREAK POINT #1 BRKP2 EQU PNTRS+50 BREAK POINT #2 BRKP3 EQU PNTRS+51 BREAK POINT #3 BRKP4 EQU PNTRS+52 BREAK POINT #4 SMFLG EQU PNTRS+53 SIMULATE FLAG TYPE EQU PNTRS+54 PARTIAL LINE CHARACTER COUNT DLMTR EQU PNTRS+55 CHAR EDIT DELIMITER MERGF EQU PNTRS+56 MERGE FLدAG COMN EQU PNTRS+57 COMMAND FILE NAME MANT1 EQU PNTRS+60 MANTISSA #1 MANT2 EQU PNTRS+61 MANTISSA #2 EXPNT EQU PNTRS+62 EXPONENT INLOC EQU PNTRS+63 INV. LOC. LU,STRK,#TKRS BR. INTKZ EQU PNTRS+64 TRACK SIZE ON DISC FOR INV. BR. HSTPT EQU PNTRS+65 HIGH-STACK POINTER BR. TSTPT EQU PNTRS+66 TEMPORARY STACK POINTER BR. LSTPT EQU PNTRS+67 LOW-STACK POINTER BR. LSTAK EQU PNTRS+68 LOW-STACK ADDRESS BR. PRADD EQU PNTRS+69 PROGRAM EXECUTION BR. DSTRT EQU PNTRS+70 DATA BR. NXTDT EQU PNTRS+71 STATEMENT BR. DCCNT EQU PNTRS+72 POINTERS BR. NXTST EQU PNTRS+73 NEXT STMT NUMBER SKP SUP PRESS MULTIPLE LISTINGS SPC 1 TEMPT BSS 14 .2 DEC 2 .3 DEC 3 .7 DEC 7 .8 DEC 8 .5 DEC 5 .10 DEC 10 .15 DEC 15 .32 DEC 32 .40 DEC 40 .41 DEC 41 .43 DEC 43 .44 DEC 44 .45 DEC 45 .46 DEC 46 .47 DEC 47 .48 DEC 48 .58 DEC 58 B37 OCT 37 B42 OCT 42 B44 OCT 44 B53 OCT 53 B54 OCT 54 B73 OCT 73 B133 OCT 133 B135 OCT 135 B177 OCT 177 B200 OCT 200 B2000 OCT 2000 MSK0 OCT 377 MSK1 OCT 777 M1400 OCT 176400 B3000 OCT 3000 B4000 OCT 4000 LF OCT 5000 B1400 OCT 14000 UNMNC OCT 21000 B2200 OCT 22000 B2300 OCT 23000 LETOP OCT 72000 RDOP OCT 52000 SPLOP OCT 65000 OPMSK OCT 77000 OPDMK OCT 100777 FRMSK OCT 100757 TABCN OCT 100037 M1 DEC -1 M2 DEC -2 M3 DEC -3 M4 DEC -4 M7 DEC -7 M8 DEC -8 M9 DEC -9 M16 DEC -16 M32 DEC -32 D53 OCT -53 D100 OCT -100 M256 DEC -256 MAXSN DEC -10000 FN ASC 1,FN MNEG OCT 100000 MAXIMUM NEGATIVE FLOATING OCT 376 POINT NUMBER FLGBT EQU MNEG ERBS DEF ERR-1 STBAS DEF SYNTB-28,I 28 IS OFSET FROM OP CODE B34(FIRST STMT OPCODE) SKP ********************************** * * * PRINT NAME TABLE FOR OPERATORS * * * ******M**************************** QUOTE OCT 1000 BITS 15-9 OF THE LABELLED WORD ASC 1," COMMA OCT 2000 ARE THE BASIC CODE OPERATOR ASC 1,, SMCLN OCT 3000 NUMBERS. BITS 3-0 ARE THE ASC 1,; RPARN OCT 4001 OPERATOR'S HIERARCHICAL ASC 1,) RBRAC OCT 5001 PRECEDENCE FOR THOSE OPERATORS ASC 1,] SCMMA OCT 6002 BELONGING TO FORMULAS. THE ASC 1,, ASSOP OCT 7002 UNLABELLED WORD GIVES THE ASC 1,= PLUS OCT 10007 ASCII REPRESENTATION OF THE ASC 1,+ MINUS OCT 11007 SINGLE CHARACTER OPERATORS. ASC 1,- TIMES OCT 12010 ASC 1,* DIV OCT 13010 ASC 1,/ EXPS OCT 14012 ASC 1,^ GTR OCT 15005 ASC 1,> LSS OCT 16005 ASC 1,< UNEQL OCT 17005 ASC 1,# EQUAL OCT 20005 ASC 1,= UNMIN OCT 21011 ASC 1,- LBRAC OCT 22020 ASC 1,[ LPARN OCT 23020 ASC 1,( UPLUS OCT 24011 ASC 1,+ OROP OCT 25003 MSFLG NOP ANDOP OCT 26004 DFLAG NOP NOTOP OCT 27011 PRFLG NOP GTREQ OCT 30005 UFLAG NOP LSSEQ OCT 31005 NOP MINOP OCT 32006 NOP MAXOP OCT 33006 SKP * DIM OCT 71003 ASC 2,DIM COM OCT 34003 ASC 2,COM DEF OCT 35003 ASC 2,DEF REM OCT 36003 ASC 2,REM IF OCT 40002 ASC 1,IF FOR OCT 41003 ASC 2,FOR NEXT OCT 42004 ASC 2,NEXT END OCT 45003 ASC 2,END DATA OCT 51004 ASC 2,DATA IMAGE OCT 67005 ASC 3,IMAGE * LET OCT 72003 THESE STATEMENTS MAY FOLLOW AN ASC 2,LET GOTO OCT 37004 'IF' OPERATOR ASC 2,GOTO GOSUB OCT 43005 ASC 3,GOSUB RTRN OCT 44006 ASC 3,RETURN STP OCT 46004 ASC 2,STOP WAIT OCT 47004 ASC 2,WAIT CALL OCT 50004 ASC 2,CALL READ OCT 52004 ASC 2,READ PRNT OCT 53005 ASC 3,PRINT INPUT OCT 54005 ASC 3,INPUT RSTOR OCT 55007 ASC 4,RESTORE PAUSE OCT 56005 ASC 3,PAUSE ASSN OCT 62006 ASC 3,ASSIGN FILS OCT 63005 ASC 3,FILES CHAIN OCT 64005 ASC 3,CHAIN TRAP OCT 66004 ASC 2,TRAP INVK OCT 70006 ASC 3,INVOKE * FAIL OCT 57005 ASC 3,FAIL: THEN OCT 60004 ASC 2,THEN * USING OCT 61005 ASC 3,USING * TO OCT 75002 ASC 1,TO STEP OCT 76004 ASC 2,STEP OF OCT 77002 ASC 1,OF NOT OCT 27003 ASC 2,NOT AND OCT 26003 ASC 2,AND OR OCT 25002 ASC 1,OR * GTE OCT 30002 ASC 1,>= LTE OCT 31002 ASC 1,<= AUNEQ OCT 17002 ALTERNATE UNEQUAL SIGN ASC 1,<> MIN OCT 32003 ASC 2,MIN MAX OCT 33003 ASC 2,MAX * LEN OCT 3 ASC 2,LEN SKP ************************************* * * * BRANCH TABLE FOR STATEMENT SYNTAX * * (THIS TABLE IS ORDERED BY OPCODES* * STARTING AT OPCODE B34) * * * ************************************* SYNTB DEF COMS COM DEF DEFS DEF DEF REMS REM DEF GOTOS GO TO DEF IFS IF DEF FORS FOR DEF NXTS NEXT DEF GOTOS GOSUB DEF ENDS RETURN DEF ENDS END DEF ENDS STOP DEF WAITS WAIT DEF CALLS CALL DEF DATAS DATA DEF READS READ DEF PRINS PRINT DEF INPTS INPUT DEF RSTRS RESTORE DEF PAUS PAUSE DEF SYNE2-1 FAIL DEF SYNE2-1 THEN DEF SYNE2-1 USING DEF ASSNG ASSIGN DEF FILES FILES DEF CHANS CHAIN NOP SPCECIAL SYNTAX DEF TRAPS TRAP DEF REMS IMAGE DEF INVOK INVOKE DEF DIMS LET DEF LETS DIM SPC 1 * #STND DEC -28 # STANDARD OPERATORS IN TABLE * #PSIF DEC -16 # OPERATORS ALLOWED PAST 'IF' * SKP *********************************** * * * CHECK SYNTAX AND TRANSLITERATE * * * *********************************** BASC1 NOP * * LDA SBPTR,I GET FIRST CHAR IN BUFFER SPC 1 * DETERMINE SEQUENCE NUMBER SPC 1 SYNTX CPA .45 MINUS SIGN(DELETE CURRENT LINE)? JMP DLLIN YES JSB INTCK RECORD DEF MAXSN SEQUENCE NUMBER JMP SYE25 STA TEMP3 SAVE CHAR LDA LOLIM IS SEQUENCE CMA,INA NUMBER >= ADA 1 TO THE SSA LOW LIMIT? JMP PEXMK NO, IGNORE STMT LDA 1 IS SEQUENCE CMA,INA NUMBER <= ADA HILIM TO THE SSA HIGH LIMIT? JMP PEXMK NO, IGNORE STMT STB .LNUM SAVE LINE NUMBER * LDA MNNAM IS THERE SZA A MNEMONIC TABLE? JMP *+3 YES! CCA SET COUNT TO STA FWAMM,I INDICATE NO ENTRIES * LDB FWAMM SET UP INB SEARCH STB SUBS1 POINTERS STB SUBS2 STB SUBS3 STB SUBS4 LDA TEMP3 RECOVER CHAR ISZ SBPTR SAVE SPACE FOR LENGTH WORDR; LDB SBUFA SET INB TEMP TO STB TEMP (SBUFF)+1 SPC 1 * DETERMINE STATEMENT TYPE SPC 1 CPA .10 NULL STATEMENT? JMP DLSTM DELETE STATEMENT! LDB #STND -# OF STANDARD MNEMONICSR JSB TBSRH FIND STATEMENT TYPE DEF DIM START AT TOP OF LIST RSS NO ERROR IF NOT FOUND JMP PSTIF FOUND LDB SPNCT IS THERE ANY SZB,RSS SPECIAL SYNTAX? JMP SUBR NO! JSB TBSRH YES, LOOK UP IN SPECIAL DEF SPTBL IN SPECIAL RSS SYNTAX TABLE JMP PSTIF SUBR LDB FWAMM,I GET MNEM COUNT JSB TBSRH LO݊OK IN MNEMONIC TABLE SUBS1 DEF 0 JMP TRYLT TRY LET STATEMENT PSTIF LDB M9 SET MULTIPLE STORE STB MSFLG TO FALSE LDB PBPTR NULL CPB PBUFF PROGRAM? RSS JMP SYNT1 NO LDB FWAM INSURE NO STB PBUFF SPURIOUS COMMON STB PBPTR EXISTS SYNT1 STB TEMPS POINTER CLB SET DEFINE FLAG STB DFLAG TO FALSE STB PRFLG SET PARAMETER FLAG TO FALSE STB FROMF SET FROM FLAG CLEAR STA 1 * LDA SBPTR,I GET OP CODE AND OPMSK IS THIS CPA SPLOP AN OP CODE FOR SPEC SYNTAX? RSS YES! JMP SYNT5 NO! LDB COUNT TABLE ORDINAL POSITION JSB SPEC1 GO AND PROCESS SPEC SYNTAX JMP ACTST ACCEPT GOOD STATEMENT JMP OUTER OR IF BAD OUTPUT ERROR MESSAGE SYNT5 LDA FWAMM IS ENTRY IN CMA,INA THE STANDARD BASIC ADA TBLPT STATEMENT TABLE? SSA,RSS NAMED SUBROUTINE? JMP NMSBR YES LSR 9 COMPUTE ADDRESS OF SYNTAX STB SFLAG SET STRING FLAG TO OFF ADB STBAS ROUTINE AND JMP 1,I BRANCH TO IT ** *** TRY IMPLIED LET ** TRYLT LDB M1 SET TO SMALL NEG. NO. STB TBLPT SO TO SKIP NAMED SUB. SYNTAX JSB BCKSP BACK UP TO START FORMULA PROCESSOR LDA LETOP STA SBPTR,I DUB IN "LET" CODE JMP PSTIF SKP ** * *** *** ** LET STATEMENT SYNTAX ** *** *** * LETS LDA SBPTR ENABLE STRING STA SFLAG VARIABLE ISZ MSFLG SET MULTIPLE STORE FLAG ON JSB FSC FETCH FORMULA ISZ SFLAG STRING VARIABLE FOUND? JMP LET1 NO! JSB SYMCK YES, DEMAND ASSIGNMENT OPERATOR! DEF ASSOP-1 JMP SYNE2-1 NO ASSIGNMENT OPERATOR! JSB RSTOP RECORD STRING OPERATOR JSB SNULL  RECORD END-OF-FORMULA JMP EOST DEMAND END SPC 1 LET1 ISZ SFLAG DID STORE OCCUR? JSB ERROR NO SYNE2 EQU * * ****************************** * * * CHECK FOR END OF STATEMENT * * * ****************************** EOST CPA .10 END OF STATEMENT? JMP ACTST YES,ACCEPT STATEMENT! NOEOF JSB ERROR CHARACTERS AFTER LEGAL END-OF-STATEMENT ***************************** * * * CALL STATEMENT SYNTAX * * * ***************************** * * THE CALL SYNTAX CHECK MAKES EXTENSIVE USE OF THE MNEMONIC AND * BRANCH TABLES TO DETERMINE THE CORRECTNESS OF THE SUBROUTINE * CALL AND THE ORDINAL POSITION OF THE SUBROUTINE WITHIN THE * BRANCH TABLE, SO THAT THE EXECUTE SEGMENT OF BASIC CAN COMPUTE * THE ADDRESS OF THE SUBROUTINE. CERTAIN ERRORS CAN BE CAUSED * BY THE INCORRECT USE OF PARAMETERS IN THE CALLING SEQUENCE OF * A SUBROUTINE. BELOW IS A SIMPLE TABLE INDICATING LEGAL PARAMETERS: * * * DIRECTION OF PARAMETER TRANSFER * +---------------------------------------------------+ * ! TYPE OF PARAMETER ! BASIC TO SUB. ! SUB. TO BASIC ! * +---------------------------------------------------! * ! SIMPLE VARIABLE ! LEGAL ! LEGAL ! * +---------------------------------------------------+ * ! CONSTANT ! LEGAL ! ILLEGAL ! * +---------------------------------------------------+ * ! ARRAY VARIABLE ! LEGAL ! LEGAL ! * +---------------------------------------------------+ * ! ARRAY ELEMENT ! LEGAL ! LEGAL ! * +---------------------------------------------------+ * ! STRING VARIABLE ! LEGAL ! LEGAL ! * +---------------------------------------------------+ * ! STRING *CONSTANT ! LEGAL ! ILLEGAL ! * +---------------------------------------------------+ * ! EXPRESION ! LEGAL ! ILLEGAL ! * +---------------------------------------------------+ * * * * THE MNEMONIC TABLE CONTAINS THE ASCII NAME OF THE SUBROUTINE, * THE NUMBER OF CHARACTERS IN THE SUBROUTINE, AND THE NUMBER OF * PARAMETERS IN THE SUBROUTINE CALLING SEQUENCE. THE FORMAT OF * EACH ENTRY IS SHOWN BELOW. * * * 15 0 * +-------------------------------+ * !F!V! ! ! ! ! ! !P!P!P!P!C!C!C!C! * +-------------------------------+ * ! 1ST CHARACTER ! 2ND CHARACTER ! * +-------------------------------+ * ! 3RD CHARACTER ! ETC. ! * +-------------------------------+ * * WHERE : * F = 1 IF FUNCTION * F = 0 IF SUBROUTINE * V = 1 IF VARIABLE LENGTH PARAMETER LIST * V = 0 IF FIXED NUMBER OF PARAMETERS * PPPP = NUMBER OF PARAMTERS * CCCC = NUMBER OF CHARACTERS IN NAME * * * THE BRANCH TABLE CONTAINS INFORMATION REGARDING THE ADDRESS * OF THE SUBROUTINE, PARAMETER CONVERSION (REAL TO INTEGER OR * INTEGER TO REAL), TYPE OF PARAMETER, AND DIRECTION THAT THE * PARAMETER IS REUIRED TO GO ( BASIC TO SUBROUTINE OR SUBROUTINE * TO BASIC). * * * 15 0 * +-------------------------------+ * !D!D!D!D!D!P!P!P!P!P!S!S!S!S!S!S! ADDRESS * +-------------------------------+ * !X!A!A!A!A!A!A!A!A!A!A!A!A!A!A!A! ARRAY * +-------------------------------+ * !X!T!T!T!T!T!T!T!T!T!T!T!T!T!T!T! TO FROM * +-------------------------------+ * !F!I!I!I!I!I!I!I!I!I!I!I!I!I!I!I! CONVERSION * +-------------------------------+ * * * WHERE: * 3 DDDDD = IDENTIFICATION LETTER * PPPPP = OVERLAY NUMBER * SSSSSS = SUBROUTINE NUMBER WITHIN OVERLAY * A = 1 IF ARRAY, 0 IF NON-ARRAY * T = 1 IF FROM SUBROUTINE, 0 IF TO SUBROUTINE * F = 1 IF INTEGER FUNCTION * F = 0 IF REAL FUNCTION * I = 1 IF CONVERSION TO INTEGER REQUIRED * I = 0 IF NO CONVERSION REQUIRED * X = BIT POSITION NOT USED * * * CALLS JSB GETCR FETCH AND JMP NOEOF RECORD LDB FWAMM,I GET MNEM COUNT JSB TBSRH LOOK FOR SUBROUTINE NAME SUBS2 DEF 0 JSB ERROR NOT FOUND CALER JMP PSTIF DO POST-IF STATEMENT * ** *** NAMED SUBROUTINE SYNTAX (NO 'CALL' PREFIX) ** NMSBR CLA SET TO STA TEMP7 INDICATE SUBROUTINE * GET FIRST WORD OF MNEMONIC TBL ENTRY LDA PRPTR,I IS THIS SSA REALLY A SUBROUTINE? JSB ERROR NO! SYNE3 EQU * FUNCT STA TEMP6 SAVE PARAMETER WORD RRR 4 COUNT AND .15 FROM CMA STA PCNT CMA * BEING DESTROYED * BY FSC LSL 9 LEFT JUSTIFY COUNT STA TEMP3 FOR INTERP. CODE LDA FWAMM,I COMPUTE OFFSET IN MNEMONIC TBL CMA,INA ADA COUNT AND SAVE IT FOR LATER STA TCCNT THIS ORDINAL POSITION OF SUB. ENTRY LDB TEMP6 FORTRAN SSB FUNCTION? JMP CALL1 YES! ADA B5000 NO, ADD IN CALL OP CODE CALL4 STA SBPTR,I STORE IN INTERP. CODE ISZ SBPTR UPDATE INTERP. CODE PTR. LDA COMMA COMMA CODE STA SBPTR,I STUFF IT (WIPE OUT LEFT PAREN) ISZ PCNT NO! JMP NAMSB * LDB B4000 FUDGE A RIGHT PAREN STB SBPTR,I LDA TEMP6 DID WE PROCESS A SSA FUNCTION JMP FSC10+1 YES! H JSB GETCR FETCH NEXT CHARACTER LDA .10 ISZ SBPTR JMP CALL5 * CALL1 ADA TEMP3 STUFF IN JMP CALL4 PARM COUNT INSTEAD OF B50000 * * CALL2 CCB JSB SYMCK COMMA? DEF COMMA-1 JMP CALL3 NO ISZ PCNT YES, MORE PARAMS ALLOWED ? JMP PRMCK YES, LOOK FOR PARAMETER. SYE11 JSB ERROR NO,TOO MANY PARMETERS * * * PROCESS SUBROUTINE AND FUNCTION PARAMETERS * NAMSB LDA TCCNT GET ORDINAL NUMBER ALS,ALS AND MULTIPLY BY 4 ADA .2 AND ADD 2 TO GET ADA FWAMB POSITION IN BRANCH TBL THEN LDA 0,I GET THE TO/FROM PARAMETER WORD STA TOFRM SAVE FOR CHECKING EACH PARAMETER PRMCK LDA TOFRM GET TO/FROM WORD CCB SLA,RSS IS IT SET? CLB NO! THEN SET THE FLAG TO 0 STB FROMF YES! THEN SET IT NON-ZERO ARS SHIFT TO STA TOFRM FOR NEXT PARAMETER JSB GETCR GET THE FIRST PARAMETER CHARACTER LDA .10 CPA B42 IS IT A STRING LITERAL? JMP CALL6 YES! JSB LETCK IS IT A LETTER? JSB PERR NO, CHECK FOR PARAMETER ERROR JSB BCKSP NO, PUT CHAR BACK JSB FRCUR SAVE VARIABLES LDA SBPTR SET TO STA SFLAG ALLOW STRING VARIABLES JSB FSC FETCH CLB CLEAR STB FROMF TO/FROM FLAG ISZ SFLAG STRING? RSS NO! JMP CALL7 YES! CALL8 JSB FPOP RESTORE VARIABLES JMP CALL2 PARAMETER FORMULA * CALL3 ISZ PCNT MORE PARAMETERS EXPECTED? RSS YES JMP CALL9 NO! LDB TEMP6 DOES THIS RBL ROUTINE EXPECT SSB,RSS VARIABLE LENGTH LIST JMP SYE11 NO! CALL9 JSB RPCK FETCH RIGHT PARENTHESIS LDB TEMP6 FORTRAN FUNCTION SSB BEING PROCESSED? JMP FSC19  YES, COMPLETE SYNTAX CHECK * CALL5 CCB JSB TBSRH IS CALL FOLLOWED BY "FAIL:"? DEF FAIL JMP EOST JSB GETCR YES. ANALYZE REST OF STMT. JMP NOEOF ISZ SBPTR JMP FAILS * CALL6 JSB PERR CHECK FOR PARAMETER ERROR ISZ SBPTR POINT AT PLACE TO PUT " OPERATOR CCB JSB SYMCK PUT IN " OPERATOR DEF QUOTE-1 NOP LDA B42 SPECIFY STRING TERMINATOR JSB CHRST PUT STRING IN INTERP CODE JSB SNULL ADD NULL AFTER STRING CONSTANT JSB GETCR FETCH NEXT CHARACTER LDA .10 JMP CALL2 * CALL7 JSB SNULL PUT NULL AFTER STRING CCB STB SFLAG RESET SFLAG JMP CALL8 * * * A CHECK IS MADE HERE TO SEE IF THE SUBROUTINE PARAMETER * (A STRING LITERAL, CONSTANT OR EXPRESSION) IS BEING * RETURNED FROM A SUBROUTINE AS INDICATED BY THE BRANCH TABLE * PERR NOP LDB FROMF FLAG SZB,RSS SET? JMP PERR,I NO! CPA .41 RIGHT PAREN? JMP PERR,I YES, OK THEN! CPA B135 RIGHT BRACKET? JMP PERR,I YES, OK CPA B54 COMMA? JMP PERR,I YES, OK THEN! CLA CLEAR STA FROMF FROM FLAG JSB ERROR NO, ILLEGAL PARAMETER SYE16 EQU * B5000 OCT 50000 SKP * ******************** * * * TRAP STATEMENT * * * ******************** * TRAPS CCB SET FOR STB CCODE NEG SEQ NUMBER CASE JSB FSC FETCH TRAP # FORMULA CPA .10 END-OF-STATEMENT? JMP SYNE6-1 YES CCB GET JSB TBSRH GOSUB SYNTAX DEF GOSUB JSB ERROR NOT FOUND SYNE6 JSB GETCR CHECK NOP FOR (-) SIGN CPA .45 IS IT? JMP TRAP1 YES! JSB BCKSP GET BACK TO LAST CHAR TRAP2 CCB SET FOR -NLHHN STB RFLAG ERROR RETURN HERE JSB PRGIN GET SEQUENCE NUMBER DEF MAXSN RSS GOOD RETURN JSB CKZER IS NUMBER=0? JSB BCKUP BACK UP TO SEQ NUMBER LDB SBPTR,I NEGATE ISZ CCODE SEQUENCE NUMBER CMB,INB STB SBPTR,I IF NECESSARY ISZ SBPTR RESET PTR JMP EOST END-OF-STATEMENT PROCESSING * TRAP1 CLB SET FOR STB CCODE (-) FOUND JMP TRAP2 * CKZER NOP IF SZB B=0 JMP SYE25 THEN STORE STB SBPTR,I IT IN INTERP. ISZ SBPTR ELSE PRINT JMP CKZER,I ERROR MESSAGE * SKP * ************************ * * * DIM STATEMENT SYNTAX * * * ************************ DIMS ISZ DFLAG SET DFLAG TO TRUE LDA SBPTR ENABLE STRING STA SFLAG VARIABLE JSB ARRYS CHECK AN ARRAY JMP ACTST DONE JMP DIMS+1 WAS A COMMA, CONTINUE ************************ * * * COM STATEMENT SYNTAX * * * ************************ COMS CLB SET ARRAY POINTER STB TEMPS+7 INITIALLY TO ZERO ISZ SBPTR SAVE SPACE FOR ISZ SBPTR COMMON SIZE WORD STB SBPTR,I INSERT NULL ISZ DFLAG SET DEFINE FLAG TO TRUE COMS1 CCA SET COMMON FLAG STA PRFLG TO TRUE LDA SBPTR ENABLE STA SFLAG STRING VARIABLES JSB ARRYS CHECK FOR ARRAY RSS JMP COMS1 MORE ARRAYS LDB SBUFA CALCULATE WHERE ADB .3 COMMMON SIZE GOES LDA TEMPS+7 RECORD COMMON STA 1,I SIZE JMP ACTST EXIT * ****************************** * * ** CHAIN STATEMENT SYNTAX ** * * ****************************** * CHANS JSB RSTOP RECORD FILE NAME INVOK EQU CHANS JSB SNULL SET END-OF-FORMULA FLAG CCB JSB SYMCK COMMA DEF COMMA-1 FOLLOWS? JMP EOST NO JSB PRGIN GET A SEQUENCE DEF MAXSN JMP EOST FOR STMNT # * SKP ************************ * * * DEF STATEMENT SYNTAX * * * ************************ DEFS JSB LTR JMP SYNE4 FIRST LDA TEMP1 ALF,ALF TWO CHARACTERS IOR TEMP2 CPA FN 'FN'? RSS YES JMP SYNE4 NO JSB LTR LETTER FOLLOWS? SYNE4 JSB ERROR NO LDA TEMP1 YES, RECORD A LDB .58 FUNCTION JSB STROP NAME LDA TEMP2 RETRIEVE CHARACTER JSB LPCK LEFT PARENTHESIS? IOR FLGBT YES, SET FORMAL STA SBPTR,I PARAMETER BIT JSB VAROP FETCH SIMPLE VARIABLE NOP NONE FOUND JSB ERROR SUBSCRIPTED VARIABLE FOUND SYNE5 JSB RPCK RECORD A RIGHT PARENTHESIS CCB ASSIGNMENT JSB SYMCK DEF ASSOP-1 OPERATOR? JMP SYNE2-1 NO LDA M2 YES, ADA SBPTR RETRIEVE LDA 0,I PARAMETER AND MSK1 AND STA PRFLG SAVE IT JSB FSC FETCH DEFINING FORMULA JMP EOST END-OF-STATEMENT TEST * **************************** * * * ASSIGN STATEMENT SYNTAX * * * **************************** * ASSNG JSB RSTOP CCB JSB SYMCK RECORD A DEF COMMA-1 COMMA JMP SYE15 NOT A COMMA! LDB .2 DISABLE STB SFLAG STRING VARIABLE JSB FSC RECORD FORMULA CCB JSB SYMCK RECORD DEF COMMA-1 A COMMA JMP SYE15 NOT A COMMA JSB VAROP SEEK A NUMERIC OPERAND JMP SYE25 BAD ARGUMENT NOP k JSB SNULL APPEND END-OF-STATEMENT JMP EOST DEMAND END-OF-STATMENT * ********************* * * * FILES STATEMENT * * * ********************* * FILES CLA,RSS SUPPRESS BLANKS * ************************ * * * IMAGE AND REM STMENT * * SYNTAX CHECKER * * * ************************ REMS LDA B200 DUMMY STRING TERMINATOR JSB CHRST FETCH CHARACTER STRING JMP ACTST SPC 1 *********************** * * * IF STATEMENT SYNTAX * * * *********************** IFS ISZ SBPTR FETCH JSB GETCR NEXT CHARACTER JMP SYNE7-1 ILLEGAL IF STMT STA SBPTR,I FOUND, SAVE IT CCB LOOK JSB TBSRH FOR 'END' DEF END JMP IF0 NONE FOUND JSB FILRF FOUND, GET FILE REFERENCE JSB ERROR BAD FILE REFERENCE SYE27 JMP IFS2 FOUND IF0 JSB BCKSP RESTORE JSB BCKUP AS WAS ON ENTRY STB SFLAG ENABLE STRING FORMULA JSB FSC GET DECISION FORMULA ISZ SFLAG STRING? JMP FAILS NO! STA TEMP1 YES,SAVE NEXT CHAR LDB M3 MULTI-CHARACTER JSB TBSRH OPERATOR DEF GTE PRESENT? RSS NO! JMP STER4 YES, PUT IT AWAY LDA TEMP1 CHAR IN (A) LDB M4 SEARCH 4 OPERATORS JSB SYMCK SINGLE CHAR REL OPERATOR DEF GTR-1 PRESENT? JSB ERROR ILLEGAL REL OPERATOR STER4 JSB RSTOP STORE STRING JSB SNULL SET END-OF-FORMULA FAILS CCB LOOK FOR JSB TBSRH 'THEN' DEF THEN JMP IFS1 NOT FOUND IFS3 CLB FOUND, GET STATEMENT JMP GOTO0 LABEL NUMBER IFS1 LDB #PSIF FOR FOLLOWING JSB TBSRH OPERATOR DEF LET RSS JMP PSTIF FOUND, GO CHECK SYNTAX LDB FWAMM,I FOR FOLLOWING JSB TBSRH NAMED SUBROUTINE SUBS3 DEF 0 JSB ERROR NOT FOUND SYNE7 JMP PSTIF FOUND, GO CHECK SYNTAX * IFS2 CCB LOOK FOR JSB TBSRH 'THEN' DEF THEN JMP SYNE7-1 NOT FOUND (ONLY 'THEN' LEGAL AFTER 'END') JMP IFS3 GET 'GOTO' SYNTAX * *********************************** * * * GOTO AND GOSUB STATEMENT SYNTAX * * * *********************************** GOTOS LDA INBFA SAVE CURRENT STA TEMP6 BUFFER POINTER LDA ICCNT AND COUNTER STA TEMP7 CCB SET 'PRGIN' FOR RETURN GOTO0 STB RFLAG ON ERROR JSB PRGIN FETCH SEQUENCE DEF MAXSN NUMBER JMP GOTO2 FOUND END-OF-STATEMENT? GOTO3 JSB BCKUP BACK UP SYNTAX POINTER LDB TEMP6 RESTORE CURRENT STB INBFA BUFFER POINTER LDB TEMP7 AND COUNTER STB ICCNT LDA SBPTR,I ERASE AND OPMSK 'INTEGER FOLLOWS' STA SBPTR,I FLAG JSB FSC FETCH FORMULA CPA .10 END-OF-STATEMENT? JMP SYNE8-1 YES CCB THE 'OF' JSB TBSRH DEF OF JSB ERROR MISSING SYNE8 CLB SET 'PRGIN' FOR EXIT STB RFLAG ON ERROR GOTO1 JSB PRGIN FETCH SEQUENCE DEF MAXSN NUMBER CCB JSB SYMCK COMMA NEXT? DEF COMMA-1 JMP EOST NO, END-OF-STATEMENT? JMP GOTO1 YES GOTO2 CPA .10 END-OF-STATEMENT? JMP EOST YES JSB BCKUP NO, MUST JMP GOTO3 BE A FORMULA SKP ************************ * * * FOR STATEMENT SYNTAX * * * ************************ FORS JSB VAROP FETCH SIMPLE VARIABLE NOP NONE FOUND JMP SYNE5-1 SUBSCRIPTED VARIABLE FOUND CCB  JSB SYMCK ASSIGNMENT DEF ASSOP-1 OPERATOR? JMP SYNE2-1 NO JSB FSC YES, FETCH INITIAL VALUE FORMULA CCB THE JSB TBSRH 'TO' DEF TO JSB ERROR MISSING SYNE9 JSB FSC GET LIMIT FORMULA CPA .10 END-OF-STATEMENT? JMP ACTST YES JSB BCKUP NO, ERASE ZERO WORD CCB FOR JSB TBSRH THE 'STEP' DEF STEP JSB ERROR MISSING SYE10 JSB FSC GET STEP SIZE FORMULA JMP EOST END-OF-STATEMENT TEST ************************* * * * NEXT STATEMENT SYNTAX * * * ************************* NXTS JSB VAROP FETCH SIMPLE VARIABLE NOP NONE FOUND JMP SYNE5-1 SUBSCRIPTED VARIABLE FOUND JMP EOST END-OF-STATEMENT TEST ****************************************************** * * * END, STOP, RESTORE, RETURN, PAUSE STATEMENT SYNTAX * * * ****************************************************** ENDS ISZ SBPTR JSB GETCR END-OF-STATEMENT? JMP ACTST YES JMP NOEOF NO ************************* * * * WAIT STATEMENT SYNTAX * * * ************************* WAITS CLB DISALLOW STRINGS STB SFLAG JSB GETCR GET FIRST CHAR JMP FSCE1 NO PAREN ERROR ISZ SBPTR JSB LPCK FETCH LEFT PAREN JSB FSC FETCH FORMULA JSB RPCK FETCH RIGHT PAREN JMP EOST END-OF-STATEMENT TEST SKP * ********************* * * * PAUSE STATEMENT * * * ********************* * PAUS CLB DISALLOW STB SFLAG STRINGS ISZ SBPTR JSB GETCR GET FIRST CHAR JMP ACTST IF NO PARAMETER IT'S OK > JSB LPCK FETCH LEFT PAREN JSB GETCR GET FIRST CHAR OF PARAMETER JMP SYE25 BAD! CLB SET STB SIGN SIGN POSITIVE JSB NUMCK NUMBER? JMP SYE25 NO! JMP SYE25 NO! JSB NUMOP FIX UP PRECEDING OPERATOR JSB RPCK FETCH LEFT PAREN JMP EOST *********************** * * * RESTORE STATEMENT * * * *********************** * RSTRS JSB GETCR END OF STMT? JMP RSTR1 YES! JSB BCKSP NO,DEMAND JSB PRGIN SEQUENCE NUMBER DEF MAXSN JMP EOST DEMAND END-OF-STATEMENT RSTR1 ISZ SBPTR RECORD DUMMY OPERAND JMP ACTST ACCEPT STATEMENT * ************************* * * * DATA STATEMENT SYNTAX * * * ************************* DATAS CLA STA SIGN CLEAR SIGN JSB GETCR JSB ERROR END-OF-INPUT CONDITION SYE12 CLB,INB SET SIGN CPA .43 '+' ? JMP DATA4 YES CCB CPA .45 NO, '-' ? JMP DATA4 YES DATA1 JSB NUMCK NO, NUMBER? JMP DATA3 NO JSB ERROR BAD EXPONENT NUMER JSB NUMOP FIX UP PRECEDING OPERATOR DATA2 CCB CHECK JSB SYMCK FOR A DEF COMMA-1 COMMA JMP EOST END-OF-STATEMENT TEST JMP DATAS FETCH ANOTHER NUMBER DATA3 CPB SIGN SIGN FOUND? (B)=0 RSS NO! JSB ERROR YES,SOLITARY SIGN SYE26 ISZ SBPTR DEMAND A JSB GETST STRING CONSTANT JMP DATA2 DATA4 STB SIGN RECORD SIGN JSB GETCR JMP EOST END-OF-INPUT CONDITION JMP DATA1 ************************** * * * READ STATEMENT SYNTAX * * * ************************** READS JSB RECRF READ FROM FILE? JMP READ1 NO! CPA .10 YES, PSEUDBO READ? JMP ACTST YES! CPA B73 NO, ';'? JMP INPTS YES! JMP SYE15 NO! READ1 JSB BCKSP * ************************** * * * INPUT STATEMENT SYNTAX * * * ************************** INPTS LDB SBPTR ENABLE STRING STB SFLAG VARIABLE JSB VAROP RECORD VARIABLE OPERAND JSB ERROR MISSING SYE13 NOP CCB CHECK JSB SYMCK FOR A DEF COMMA-1 COMMA RSS JMP INPTS IS, FETCH NEXT ITEM JSB SNULL APPEND END-OF-FORMULA JMP EOST END OF STATEMENT TEST SKP * ************************************ * * * PRINT STATEMENT SYNTAX CHECKER * * * ************************************ * * * PRINS JSB USCHK 'USING'? JMP PRIN5 NO, NONE FOUND CPA .10 END-OF-STMT? JMP ACTST YES JSB SNULL CCB JSB SYMCK SEMI-COLON FOLLOWS? DEF SMCLN-1 JMP SYE15 MISSING OR BAD LIST DELIMITER PRIN7 ISZ SBPTR JSB GETCR MORE PRINT LIST JMP ACTST STA SBPTR,I SVE CHAR JSB BCKSP RESTORE BUFFER PTR JSB BCKUP RESTORE INPUT STRING STB SFLAG ENABLE STRING VARIABLES JSB FSC FETCH FORMULA CCB CPB SFLAG STRING VARIABLE? JSB SNULL YES,OUTPUT A NULL CPA .10 END-0F-STMT? RSS YES JMP PRIN6 NO! JMP ACTST ACCEPT STMT PRIN6 CCB JSB SYMCK COMMA? DEF COMMA-1 JMP SYE25 MISSING DELIMITER JMP PRIN7 * PRIN5 JSB RECRF WRITE ONTO FILE? JMP PRIN0-1 NO! CCB YES, SET STB FILRF 'FILE' FLAG CPA .10 NULL WRITE? JMP ACTST YES! CPA B73 NO, ';'? JMP PRIN0 YES! SYE15 JSB ERROR NO! JSB BCKSbyP PRIN0 ISZ SBPTR ADVANCE SYNTAX PTR JSB GETCR MORE STATEMENT? JMP ACTST NO! CCB YES, ENABLE STB TEMP,I FORMULA AND TAB CPA B42 QUOTE? RSS YES! JMP PRIN3 NO! PRIN1 JSB GETST RECORD A STRING CONSTANT ISZ SBPTR CPA .10 END-OF-STATEMENT? JMP ACTST YES! CCB NO! STB TEMP,I PRIN2 CPA B42 QUOTE? JMP PRIN1 YES! LDB M2 NO! JSB SYMCK COMMA OR DEF COMMA-1 SEMICOLON? RSS NO! JMP PRIN0 YES! JSB SNULL ZERO NEXT WORD PRIN3 ISZ TEMP,I FORMULA OR TAB PERMITTED? JMP SYE15 NO! STA SBPTR,I YES! CCB 'FILE' ISZ FILRF MODE? JMP PRIN4 NO! STB FILRF YES! CCB JSB TBSRH 'END' ? DEF END JMP PRIN4 NO! ISZ SBPTR YES! JSB GETCR FETCH NEXT JMP ACTST CHARACTER JMP PRIN2 SKP PRIN4 JSB BCKSP BACKUP JSB BCKUP POINTERS STB SFLAG ENABLE STRING VARIABLE JSB FSC RECORD FORMULA CCB WAS THIS A CPB SFLAG STRING VARIABLE JSB SNULL YES, OUTPUT A NULL WORD CPA .10 END-OF-STATEMENT? RSS YES! JMP PRIN2 NO! JSB SNULL SET END-OF-FORMULA JMP ACTST ACCEPT STATEMENT SKP *********************************** * * *** CHECK FOR USING STATEMENT *** * * *********************************** * * * SCAN THE INPUT STRING FOR A USING OPERATOR. IF NONE FOUND, EXIT * TO (P+1) WITH THE INPUT STRING AND SYNTAX BUFFER AS UPON ENTRY. * OTHERWISE, CHECK FOR A LEGAL OPERATOR FOLLOWING THE 'USING' AND * EXIT TO (P+2) AFTER SAVING IT IN THE SYNTAX BUFFER, WITH (A) * = THE NEXT CHARACTER. USCHK NOP LDA ICCN %T SAVE STA TEMP6 INPUT LDA INBFA BUFFER POINTER STA TEMP7 AND LDA SBPTR OUTPUT STA TEMP8 BUFFER POINTERS JSB FILRF PRINT ON LU? JMP USCK4 NO, BACKUP! JMP USCK6 YES! USCK5 ISZ SBPTR JSB GETCR GET NEXT CHAR JMP ACTST NONE FOUND, ACCEPT AS IS USCK6 CCB LOOK JSB TBSRH LOOK FOR 'USING' DEF USING JMP USCK3 NOT FOUND * ISZ USCHK JSB GETCR JMP SYE15 END-OF-STMT FOUND AFTER 'USING' JSB DIGCK DIGITR JMP USCK2 NO, TRY FOR STRING VAR OR CONSTANT JSB BCKSP BACK UP OVER LAST CHAR CCB YES, SET PRGIN FOR EXIT ON ERROR STB RFLAG JSB PRGIN FETCH SEQ NUMBER DEF MAXSN CPA .10 END-OF-STMT? JMP ACTST END-OF-STMT JMP USCHK,I RETURN * USCK2 JSB BCKSP BACK UP OVER LAST CHAR JSB RSTOP STORE STRING VARIABLE OR STRING CONSTANT JMP USCHK,I * USCK3 LDA TEMP6 RESTORE BUFFER PTR STA ICCNT LDA TEMP7 STA INBFA LDA TEMP8 STA SBPTR JMP USCHK,I * USCK4 JSB BCKUP BACKUP JSB BCKSP INPUT AND CODE PTRS! JMP USCK5 * *************************** * * * OUTPUT A NULL WORD * * * *************************** * SNULL NOP CLB STB SBPTR,I STORE 0 IN INTERPRETIVE ISZ SBPTR BUFFER AREA JMP SNULL,I SKP * *************************** * * * SEEK RECORD REFERENCE * * * *************************** * * IF THE NEXT CHARACTER IS NOT '#' THEN RESTORE SBPTR AS UPON * ENTRY AND EXIT TO (P+1) WITH THE CHARACTER IN (A). OTHERWISE CHECK * CHARACTER RETURNED IN (A) FROM FILRF. IF IT IS A COMMA OR A * SEMICOLON RECORD ITT. EXIT TO (P+2) WITH THE CHARACTER gIN (A) IF * IT IS A SEMICOLON. IF A COMMA, PROCESS THE FOLLOWING RECORD * REFERENCE AND EXIT TO (P+2) WITH CHARACTER FOLLOWING IT IN (A) * IF A SEMICOLON, RECORD IT BEFORE EXITING. * RECRF NOP JSB FILRF GET FILE REFERENCE JMP RECR1 NONE FOUND ISZ RECRF FOUND CPA B54 COMMA? RSS YES! JMP RECR0 NO! LDB B2000 RECORD STB SBPTR,I COMMA JSB FSC PROCESS RECORD FORMULA RECR0 LDB B3000 CPA B73 SEMICOLON? STB SBPTR,I YES! JMP RECRF,I RECR1 JSB BCKUP RESTORE SBPTR JMP RECRF,I * ************************* * * * SEEK FILE REFERENCE * * * ************************* * * IF THE NEXT CHARACTER IS NOT A '#' RETURN TO (P+1) WITH IT IN * (A). OTHERWISE RECORD THE FILE REFERENCE AND RETURN TO (P+2) * WITH THE FOLLOWING CHARACTER IN (A). * FILRF NOP ISZ SBPTR JSB GETCR NEXT JMP FILRF,I CCB CHARACTER JSB SYMCK DEF UNEQL-1 A '#' SIGN ? JMP FILRF,I NO! JSB FSC YES, PROCESS FILE FORMULA ISZ FILRF JMP FILRF,I SKP ************************** * * * FORMULA SYNTAX CHECKER * * * ************************** FSC NOP CLA SET LEFT PARENTHESIS STA TEMPS,I COUNT TO ZERO FSC1 CCA SET UNARY FLAG STA UFLAG TO TRUE STA TEMP5 SET LEN FLAG OFF SPC 1 * PROCESS VARIABLE OPERAND SPC 1 FSC2 JSB VAROP LOOK FOR VARIABLE OPERAND JMP FSC9 NOT FOUND JMP FSC13 SUBSCRIPTED OR STRING VARIABLE FOUND JSB PERR CHECK FOR PARAMETER ERROR JSB LETCK FOLLOWED BY LETTER? JMP FSC6 NO LDB M2 YES, LOOK FOR JSB MCBCK 'AND','OR','MIN' OR 'MAX' LDB M2 LOOK FOR 'MIN' OR 'MAX' JSB TBSRH gT DEF MIN RSS NOT FOUND JMP FSCM LDA TEMP1 NOT FOUND, FETCH PREVIOUS ALF,ALF CHARACTER AND LEFT-JUSTIFY IT IOR TEMP2 ADD LATEST CHARACTER CPA FN 'FN'? JMP FSC4 YES JSB BCKSP GO BACK ONE SPACE LDA TEMP1 CCB JSB TBSRH IS THIS DEF LEN A LENGTH FUNCTION? RSS NO! JMP FSC15 YES! LDB FCNCT IS FUNCTION IN MNEMONIC TABLE? LDA TEMP1 A = CHARACTER JSB TBSRH FUNCTION DEF FCNS JMP FSC16 NOT FOUND LDA FCNCT FOUND FUNCTION SO COMPUTE OFFSET IN CMA,INA TABLE ADA COUNT FSC18 ALF IOR FLGBT ADD FLAG BIT JMP FSC5 FSC16 LDB FWAMM,I GET TABLE LENGTH JSB TBSRH IS THERE SUBS4 DEF 0 FORTRAN FUNCTION JMP FSC3 NO! LDA FRMSK YES, CODE OCT 36 CCB INDICATES ADB SBPTR A FORTRAN FUNCTION STA TEMP1 SAVE IT LDA 1,I RETRIEVE PREVIOUS AND OPMSK OPERATOR IOR TEMP1 AND COMBINE WITH FUNCTION STA 1,I FUNCTION STA TEMP7 SET TEMP7 AS FORTRAN FNCT FLAG LDA PRPTR,I IS IT REALLY SSA,RSS A FORTRAN FUNCTION? JSB ERROR NO! SYNE1 EQU * JMP FUNCT YES,CHECK SYNTAX OF IT FSC3 ISZ UFLAG 'NOT' PERMITTED? JMP FSC8-2 NO CCB SEARCH FOR JSB TBSRH 'NOT' DEF NOT JMP FSC8-2 'NOT' NOT FOUND CCB RETRIEVE ADB SBPTR PREVIOUS WORD LDA 1,I WORD AND OPMSK SET TO STA 1,I NULL OPERAND JMP FSC14 SPC 1 * LEN FUNCTION FOUND? SPC 1 FSC15 CLA SET LEN FLAG! STA TEMP5 LDA B37 LEN OP CODE IS FIXED JMP FSC18 AT OCT 37 SPC 1 * PROCESS USER-DEFINED FUNCTIONS (FNA, FNB, .Y..) SPC 1 FSC4 JSB GETCR IDENTIFYING JMP SYNE4 FUNCTION JSB LETCK LETTER? ?q JMP SYNE4 NO ADA D100 YES, ALF ASSEMBLE AND FSC5 ADA .15 SAVE STA TEMP1 FUNCTION IDENTIFIER CCB RETRIEVE ADB SBPTR PREVIOUS LDA 1,I PROGRAM WORD AND OPMSK EXTRACT OPERATOR, IOR TEMP1 APPEND OPERAND, STA 1,I AND RECORD ISZ TEMP5 IS "LEN" FLAG SET? JMP FSC17 YES! JSB GETCR LEFT PARENTHESIS FSCE1 JSB ERROR OR JSB LPCK LEFT BRACKET? JSB FRCUR YES, SAVE LOCAL VARIABLES OF FSC JSB FSC FETCH ACTUAL PARAMETER JSB FPOP RESTORE LOCAL VARIABLES OF FSC JSB RPCK FETCH RIGHT PARENTHESIS JMP FSC10+1 FSC7 LDB M2 CHECK FOR JSB SYMCK RIGHT PARENTHESIS DEF RPARN-1 OR RIGHT BRACKET JMP FSC8 NOT FOUND LDA B4000 RECORD A STA SBPTR,I RIGHT PARENTHESIS LDA .41 RESTORE RIGHT PARENTHESIS CCB MATCHING ADB TEMPS,I LEFT SSB PARENTHESIS? JMP FSC8 NO STB TEMPS,I YES ISZ SBPTR JSB GETCR FETCH LDA .10 FSC6 CPA .10 END OF FORMULA? JMP FSC8 YES STA UFLAG NO, SET UNARY FLAG TO FALSE LDB M7 SEARCH FOR A MULTICHARACTER JSB MCBCK BINARY OPERATOR LDB MSFLG SEARCH JSB SYMCK FOR A DEF PLUS-1 BINARY OPERATOR CCB,RSS NOT FOUND JMP FSCM FOUND JSB SYMCK DEF ASSOP-1 OPERATOR? JMP FSC7 NO LDA M2 STA SFLAG YES, SET JMP FSC1 'STORE OCCURRED' FLAG JSB GETCR RETRIEVE LETTER LDA .10 FSC8 LDB TEMPS,I ALL LEFT PARENTHESES S\ NLHHN SZB MATCHED? FSCE2 JSB ERROR NO STB SBPTR,I YES, RECORD AN ISZ SBPTR END-OF-FORMULA AND CCB JMP FSC,I EXIT WITH CHARACTER IN (A) SPC 1 * PROCESS "LEN" FUNCTION FOR STRING ARGUMENT SPC 1 FSC17 JSB GETCR RECORD JMP FSCE1 LEFT JSB LPCK PARENTHESIS JSB LTR LETTER NEXT? JSB ERROR NO, PARAMETER NOT STRING! STER2 CPA B44 YES, FOLLOEWED BY "$"? RSS YES! JMP STER2-1 NO, PARAMETER NOT STRING! LDA TEMP1 RECORD LDB B53 STRING JSB STROP VARAIABLE CLA PLACE NULL STA SBPTR,I AFTER PARAMETER ISZ SBPTR JSB GETCR RECORD JMP FSCE2 RIGHT JSB RPCK PARENTHESIS JMP FSC10+1 SPC 1 * PROCESS CONSTANT OPERAND SPC 1 FSC9 CLB SET SIGN POSITIVE STB SIGN JSB NUMCK NUMBER? JMP FSC11 NO, TRY FOR LEFT PAREN JMP NUMER-1 JMP FSC10 FOUND IT! FSC19 LDB M2 SET STORE STB SFLAG OCCURRED FLAG RSS FSC10 JSB NUMOP YES, FIX UP PRECEDING OPPERATOR LDB M9 UPDATE STB MSFLG MULTIPLE STORE FALG JMP FSC6 FSC11 CPA .40 LEFT JMP FSC12 PARENTHESIS CPA B133 OR LEFT BRACKET? JMP FSC12 YES ISZ UFLAG NO! SPC 1 * PROCESS UNARY OPERATORS SPC 1 FSCE3 JSB ERROR NO LDB UNMNC CPA .43 '+'? JMP *+4 YES CPA .45 NO, '-'? JMP *+3 YES JMP FSCE3 NO ADB B3000 STORE ISZ SBPTR UNARY STB SBPTR,I OPERATOR FSC14 LDB M9 UPDATE STB MSFLG MULTIPLE STORE FLAG JMP FSC2 FLAG SPC 1 FSC12 ISZ SBPTR IS LPAR, LDA LPARN RECORD IT AND OPMSK AND ISZ TEMPS,I COUNT IT STA SBPTR,I FSCM LDB M9 ENTER ON MULTICHAR OPR STB MSFLG UP DATE MULTIPLE STORE FLAG JMP FSC1 SPC 1 FSC13 CCB STRING VARIABLE CPB SFLAG FOUND? JMP FSC,I YES! JMP FSC6 NO! SKP ********************************************** * * * CHECK FOR A MULTICHARACTER BINARY OPERATOR * * * ********************************************** MCBCK NOP JSB TBSRH LOOK FOR 'AND' OR 'OR' DEF AND JMP MCBCK,I NOT FOUND YET JMP FSCM FOUND ******************************** * * * RESTORE FSC LOCAL QUANTITIES * * * ******************************** FPOP NOP STA TEMP1 SAVE CHARACTER LDB TEMPS ADB M7 STB TEMPS RESTORE S-STACK TOP INB LDA 1,I STA MSFLG RESTORE MULTIPLE STORE FLAG INB LDA 1,I RESTORE STA PCNT PARAMETER COUNT INB LDA 1,I RESTORE FORTRAN STA TEMP7 FUNCTION FLAG INB LDA 1,I STA UFLAG RESTORE UNARY OPERATOR FLAG INB LDA 1,I STA FSC RESTORE FSC RETURN ADDRESSS INB LDA 1,I RESTORE STA VAROP VAROP RETURN ADDRESS ISZ SFLAG RESTORE SFLAG VALUE NOP LDA TEMP1 RETRIEVE CHARACTER JMP FPOP,I ***************************** * * * SAVE FSC LOCAL QUANTITIES * * * ***************************** FRCUR NOP LDB TEMPS FETCH CURRENT S-STACK POINTER INB UPDATE IT LDA MSFLG DUMP MULTIPLE STORE STA 1,I FLAG ON S-STACK INB LDA PCNT SAVE STA 1,I PARAMETER COUNT INB LDA TEMP7 SAVE FORTRAN STA 1,I FUNCTION FzLAG INB LDA UFLAG STACK UNARY OPERATOR STA 1,I FLAG INB LDA FSC STACK FSC STA 1,I RETURN ADDRESS LDA VAROP STACK VAROP RETURN ADDRESS JSB SSOV AND CHECK FOR S-STACK OVERFLOWO CCA ADA SFLAG DISABLE SFLAG VALUE STA SFLAG JMP FRCUR,I SKP ********************************************** * * * PUT ITEM ON S-STACK AND CHECK FOR OVERFLOW * * * ********************************************** SSOV NOP STORE QUANTITY INB ADVANCE S-STACK POINTER STA 1,I SAVE ITEM IN (A) INB ADVANCE S-STACK POINTER STB TEMPS AND RECORD IT CMB,INB ADB LWBM LAST WORD SSB EXCEEDED? FSCE4 JSB ERROR YES JMP SSOV,I **************************** * * * CHECK FOR SUBSCRIPT PART * * * **************************** SBSCK NOP CHARACTER IN (A) CLB CLEAR CALL SYNTAX STB FROMF TO-FROM FLAG LDB M2 LEFT BRACKET JSB SYMCK OR DEF LBRAC-1 LEFT PARENTHESIS? JMP SBSCK,I NO, RETURN VIA (P+1) ISZ SBSCK YES, SET RETURN TO (P+2) LDA ARYAD,I SET AND M16 ARRAY INA TO STA ARYAD,I SINGLE SUBSCRIPT LDA B2200 RECORD A STA SBPTR,I LEFT BRACKET CLB DIM OR COM CPB DFLAG STATEMENT? JMP SBSC3 NO CLB SET 'PRGIN' FOR STB RFLAG EXIT ON ERROR JSB PRGIN FETCH INTEGER DEF M256 SUBSCRIPT BOUND BLF,BLF SAVE STB TEMP1 BOUND LDB SFLAG STRING CPB M1 VARIABLE? JMP SBSC6 YES! CCB IS THE JSB SYMCK NEXT CHARACTEeR DEF SCMMA-1 A COMMA? JMP SBSC1 NO ISZ ARYAD,I YES, NOTE SECOND SUBSCRIPT JSB PRGIN FETCH SECOND DEF M256 INTEGER SUBSCRIPT BOUND RSS SBSC1 CLB,INB SET ONE-DIMENSIONAL CASE ISZ PRFLG COM STATEMENT? JMP SBSC2 NO STA TEMP2 SAVE CHARACTER LDA 1 IOR TEMP1 RETRIEVE FIRST BOUND JSB MDIM FIND STORAGE NEED ISZ SFLAG STRING RSS VARIABLE? JMP SBSC4 YES! SBSC5 ADA TEMPS+7 UPDATE COM STA TEMPS+7 STORAGE POINTER LDA TEMP2 RETRIEVE NEXT CHARACTER SBSC2 LDB M2 RIGHT PARENTHESIS JSB SYMCK OR DEF RPARN-1 RIGHT BRACKET? JMP FSCE2 NO LDA LF YES, RECORD A STA SBPTR,I RIGHT BRACKET ISZ SBPTR ADJUST S-BUFFER POINTER JSB GETCR FETCH FOLLOWING LDA .10 CHARACTER LDB DFLAG DIM OR COM SZB STATEMENT? JMP SBSCK,I YES JSB FPOP RESTORE FSC LOCAL VARIABLES LDB M2 RESTORE ADB TEMPS S-STACK STB TEMPS POINTER INB FETCH LDB 1,I RETURN ADDRESS JMP 1,I AND EXIT SBSC3 LDA SBSCK SAVE LDB TEMPS RETURN ADDRESS JSB SSOV ON S-STACK JSB FRCUR SAVE FSC LOCAL VARIABLES LDB M9 SET MULTIPLE STORE FLAG STB MSFLG TO FALSE LDA ARYAD SAVE LDB TEMPS OPERAND JSB SSOV ADDRESS JSB FSC GET SUBSCRIPT FORMULA JSB BCKUP ERASE ZERO WORD LDB M2 RESTORE ADB TEMPS S-STACK STB TEMPS POINTER INB RESTORE LDB 1,I OPERAND STB ARYAD ADDRESS CCB IS THE JSB SYMCK NEXT CHARACTER DEF SCMMA-1 A COMMA? JMP SBSC2 NO ISZ ARYAD,I YES, NOTE SECOND S'UBSCRIPT JSB FSC GET SUBSCRIPT FORMULA JSB BCKUP ERASE ZERO WORD JMP SBSC2 SBSC4 ARS ADJUST SIZE INA OF COMMON ARS TO EQUAL INA SPACE FOR CHARS JMP SBSC5 PLUS SPACE FOR SIZE * SBSC6 LDB TEMP1 BLF,BLF RT JUSTIFY ADB M256 IS DIMENSION SSB,RSS GREATER THAN 255 CHARS? JMP STER3-1 YES! JMP SBSC1 NO! SPC 1 SKP ******************************************* * * * TABLE SEARCH FOR MULTICHARACTER SYMBOLS * * * ******************************************* TBSRH NOP STA SBPTR,I LDA TBSRH,I RSS PEEL OFF INDIRECTS LDA 0,I RAL,CLE,SLA,ERA JMP *-2 ISZ TBSRH STA TABLE STORE TABLE ADDRESS STB LNGTH STORE -(NUMBER OF ENTRIES) LDA INBFA SAVE STA TEMP3 INPUT LDA ICCNT BUFFER STA TEMP4 STATUS LDA SBPTR INITIALIZE END-OF-SYMBOL STA SMEND POINTER CLA,INA COUNT FIRST CHARACTER OF STA SLENG SYMBOL LDA SBPTR,I FETCH PARTIAL SYMBOL ALF,ALF LEFT-JUSTIFY IOR .32 FIRST CHARACTER AND STA SBPTR,I APPEND BLANK TSRC1 JSB GETCR FETCH NEXT CHARACTER JMP TSRC9 END-OF-STATEMENT LDB SLENG CHECK FOR CPB .8 IMPOSSIBLE LENGTH JMP TSRC9 SLB EVEN-NUMBERED CHARACTER? JMP TSRC2 YES ISZ SMEND NO, FETCH FRESH WORD, ALF,ALF LEFT-JUSTIFY CHARACTER, IOR .32 APPEND BLANK, JMP TSR10 TSRC2 ADA M32 DELETE BLANK, ADA SMEND,I FILL SECOND CHARACTER, TSR10 STA SMEND,I AND STORE ISZ SLENG COUNT IT LDB LNGTH INITIALIZE TABLE LENGTH STB *COUNT COUNTER LDA TABLE TSRC3 STA TBLPT SET TABLE POINTER STA PRPTR PTR AND SAVE IT LDA TBLPT,I EXTRACT SYMBOL LENGTH AND .7 FROM TABLE AND COMPARE CPA SLENG WITH CURRENT SYMBOL JMP TSRC5 EQUAL? TSRC4 ADA .3 DIFFERENT, ARS UPDATE ADA TBLPT TABLE POINTER ISZ COUNT MORE ENTRIES? JMP TSRC3 YES JMP TSRC1 NO * SKP TSRC5 LDB TBLPT SET POINTER TO STB TSPTR TABLE SYMBOL LDB SBPTR SET (B) TO INPUT JMP TSRC7 SYMBOL POINTER TSRC6 CPB SMEND ALL OF SYMBOL CONSIDERED? JMP TSRC8 YES, MATCH OCCURRED INB NO, INCREMENT TSRC7 ISZ TSPTR SYMBOL POINTERS LDA TSPTR,I FETCH WORD FROM TABLE CPA 1,I MATCH WITH INPUT SYMBOL? JMP TSRC6 YES LDA SLENG NO, WRONG JMP TSRC4 SYMBOL TSRC8 LDA TBLPT,I EXTRACT AND OPMSK SYMBOL CODE STA SBPTR,I ISZ TBSRH AND RETURN VIA JMP TBSRH,I 'SUCCESS' EXIT TSRC9 LDA TEMP3 RESTORE STA INBFA INPUT LDA TEMP4 BUFFER STA ICCNT STATUS LDA SBPTR,I GET ORIGINAL CHAR ALF,ALF POSITION IT AND MSK0 ISOLATE IT JMP TBSRH,I 'FAILURE' EXIT ************************************* * * * CHECK SYNTAX OF ARRAY DEFINITIONS * * * ************************************* ARRYS NOP JSB ARRID FETCH ARRAY IDENTIFIER JSB SBSCK RECORD A SUBSCRIPT JSB ERROR MISSING SUBSCRIPT SYE20 CPA .10 END-OF-STATEMENT? JMP ARRYS,I YES, RETURN VIA (P+1) CCB NO, JSB SYMCK MUST BE DEF COMMA-1 A COMMA JMP NOEOF ISN'T ISZ ARRYS IS, RETURN JMP ARRYS,I VIA (P+2) ******************ٴ******** * * * FETCH ARRAY IDENTIFIER * * * ************************** ARRID NOP JSB LTR FETCH LETTER JMP SYE20-1 NONE FOUND CPA B44 $ ? JMP ARRE1 YES ARRE2 LDA SBPTR NO,SAVE STA ARYAD OPERAND ADDRES LDA TEMP1 RECORD LDB .46 ARRAY JSB STROP IDENTIFIER LDA TEMP2 RETRIEVE FOLLOWING CHARACTER JMP ARRID,I ARRE1 LDA SFLAG STRING VARIABLE CPA SBPTR PERMITTED CCA,RSS YES! JSB ERROR STRING NOT PERMMITED STER5 STA SFLAG SET FLAG TO 'STRING OCCURRED' LDA TEMP1 RECORD LDB B53 STRING JSB STROP VARIABLE LDA TEMPS SET PTR TO DUMMY LOCATION STA ARYAD JSB GETCR FETCH NEXT CHAR LDA .10 JMP ARRID,I ****************************** * * * CHECK FOR VARIABLE OPERAND * * * ****************************** VAROP NOP JSB LTR LETTER? JMP VAROP,I NO, EXIT VIA (P+1) ISZ VAROP CPA .40 LEFT PARENTHESIS? JMP VARO5 YES CPA B44 DOLLAR SIGN? JMP VARO6 YES, STRING VARAIBLE! CPA B133 NO, LEFT BRACKET? JMP VARO5 YES ISZ VAROP NO JSB DIGCK DIGIT? JMP VARO1 NO LDA TEMP1 YES, RETRIEVE LETTER, ADB .48 AND RESTORE ASCII DIGIT STB TEMP1 JSB STROP RECORD VARIABLE JSB GETCR FETCH FOLLOWING LDA .10 CHARACTER JMP VARO2 VARO1 LDA TEMP1 RETRIEVE LETTER, LDB .47 SET 'NO DIGIT', JSB STROP AND RECORD VARIABLE LDA TEMP2 RETRIEVE FOLLOWING CHARACTER VARO2 STA TEMP2 SAVE CHARACTER CLB INSIDE A CPB PRFLG DEF STATEMENT? JMP VAROP,I NO, EXIT VIA (P+3) CCB ADB SBPTR RETRIEVE`{ LDA 1,I AND MSK1 OPERAND CPA PRFLG MATCH PARAMETER? JMP VARO4 YES VARO3 LDA TEMP2 NO, RETRIEVE JMP VAROP,I CHARACTER AND EXIT VIA (P+3) VARO4 LDA 1,I SET OPERAND TO IOR FLGBT ACTUAL PARAMETER STA 1,I AND RECORD IT JMP VARO3 VARO5 LDA SBPTR SAVE STA ARYAD OPERAND ADDRESS LDA TEMP1 RETRIEVE LETTER LDB .46 RECORD JSB STROP ARRAY IDENTIFIER LDA B133 RETRIEVE LEFT BRACKET VARO7 JSB SBSCK FETCH SUBSCRIPT NOP JMP VAROP,I EXIT VIA (P+2) SPC 1 VARO6 LDA SFLAG STRING VARIABLE PERMITTED CPA SBPTR CCA,RSS YES! JSB ERROR NO, ILLEGAL STRING VARIABLE! STER1 STA SFLAG SET SFLAG TO 'STRING OCCURRED' LDA TEMP1 RECORD STRING VARIABLE LDB B53 JSB STROP LDA TEMPS SET POINTER TO DUMMY STA ARYAD LOCATION JSB GETCR GET LDA .10 NEXT CHARACTER JMP VARO7 FETCH SUBSCRIPT SKP ****************** * * * FETCH A LETTER * * * ****************** LTR NOP JSB GETCR LDA .10 JSB LETCK LETTER? JMP LTR,I NO, EXIT VIA (P+1) ISZ LTR YES, STA TEMP1 SAVE IT JSB GETCR NEXT CHARACTER LDA .10 TO (A) STA TEMP2 SAVE SECOND CHARACTER JMP LTR,I EXIT VIA (P+2) ************************* * * * STORE AN OPERAND NAME * * * ************************* STROP NOP LETTER IN (A), NUMBER IN (B) ADA D100 NUMERICALLY ADJUST THE ADB D53 OPERAND NAME ALF COMBINE THE IOR 1 TWO PARTS IOR SBPTR,I COMPLETE OPERAND-OPERATOR PAIR STA SBPTR,I AND STORE IT ISZ SBPTR UPDATE S-BUFFER POINTER JMP STROP,I **********************h******** * * * CHECK FOR LEFT PARENTHESIS * * * ****************************** LPCK NOP CHARACTER IN (A) LDB M2 LEFT PARENTHESIS JSB SYMCK OR DEF LBRAC-1 LEFT BRACKET? JMP FSCE1 NO LDA B2300 YES, RECORD A STA SBPTR,I LEFT PARENTHESIS JMP LPCK,I EXIT ************************** * * * BACK UP SYNTAX POINTER * * * ************************** BCKUP NOP CCB DECREMENT ADB SBPTR SYNTAX POINTER STB SBPTR BY 1 JMP BCKUP,I SKP ******************************* * * * CHECK FOR RIGHT PARENTHESIS * * * ******************************* RPCK NOP LDB M2 RIGHT PARENTHESIS JSB SYMCK OR DEF RPARN-1 RIGHT BRACKET? ? JMP FSCE2 NO LDA B4000 YES, RECORD A STA SBPTR,I RIGHT PARENTHESIS ISZ SBPTR UPDATE SYNTAX BUFFER POINTER JSB GETCR FETCH LDA .10 FOLLOWING CHARACTER JMP RPCK,I * ************************* * * * RECORD STRING FORMULA * * * ************************* * * DEMAND A STRING VARIABLE OR A STRING CONSTANT. EXIT TO * ERROR IF NEITHER IS FOUND, ELSE EXIT WITH THE NEXT CHAR- * ACTER IN (A). * RSTOP NOP LDA SBPTR SEEK STA SFLAG STRING JSB VAROP OPERAND JMP RSTO1 FIRST CHARACTER NOT LETTER ISZ SFLAG STRING VARIABLE? JMP STER1-1 NO STRING FOUND! JMP RSTOP,I SPC 1 RSTO1 ISZ SBPTR JSB GETST DEMAND STRING CONSTANT JMP RSTOP,I SKP *************************** * * * FETCH A STRING CONSTANT * * * *************************** * * EXIT TO ERROR IF (A) # " UѡPON ENTRY. ELSE SAVE CURRENT PTR * AND PACK INPUT STRING INTO BUFFER WORD. EXIT TO ERROR IF NO * CLOSING " IS FOUND. RECORD OPENING " ALONG WITH COUNT OF * THE STRING CHARS AND EXIT WITH THE NEXT CHARACTER IN (A). * EXIT TO ERROR IF STRING EXCEEDS 255 CHARACTERS. * GETST NOP LDB SBPTR SAVE SYNTAX BUF PTR STB ARYAD CCB LOOK FOR JSB SYMCK QUOTE AND RECORD DEF QUOTE-1 OPERATOR JMP STER1-1 NO STRING FOUND! LDA B42 SET QUOTE AS TERMINATOR JSB CHRST RECORD STRING CONSTANT LDA ARYAD,I CHECK FOR ADA M1400 TOO MANY CHARACTERS SSA,RSS JSB ERROR YES! STER3 JSB GETCR NO,FETCH NEXT CHAR LDA .10 END-OF-STATEMENT JMP GETST,I SKP *************************************** * * * FLAG OPERATOR WHICH PRECEDES NUMBER * * * *************************************** NUMOP NOP STA TEMP4 LDB M3 FETCH ADB SBPTR PRECEDING LDA 1,I OPERATOR IOR FLGBT ADD FLAG BIT STA 1,I REPLACE OPERATOR LDA TEMP4 JMP NUMOP,I ************************************ * * * FETCH AND RECORD PROGRAM INTEGER * * * ************************************ PRGIN NOP LDA SBPTR,I SET IOR FLGBT 'INTEGER ADA .3 FOLLOWS' STA SBPTR,I OPERAND LDA PRGIN,I GIVE ADDRESS STA PRGI1 TO INTCK ISZ SBPTR ISZ PRGIN JSB GETCR JMP PRGI2 JSB INTCK FETCH PRGI1 NOP RSS JMP PRGIN,I RETURN VIA P+2 PRGI2 ISZ RFLAG RETURN ON ERROR? SYE25 JSB ERROR NO ISZ PRGIN YES JMP PRGIN,I RETURN VIA P+3 **************************** * * * PROCESS CHARACTER STRING * *  * **************************** CHRST NOP STA TEMP2 REM SENDS US (A)=B200 LDB SBPTR SAVE PTR TO CHAR COUNT WORD STB TEMP9 SZA IF A=0 SUPPRESS BLANKS STB BLANK ANYTHING GOES ON INPUT JSB GETCR FIRST CHAR CAN EVEN BE TERMINATOR JMP CHRS5 NO MORE CHARS CPA TEMP2 TERMINATOR? JMP CHRS3 YES! CHRS1 ISZ TEMP9,I INCREMENT CHAR COUNT ALF,ALF ISZ SBPTR STA SBPTR,I STORE IN LEFT HALF OF WORD JSB CHRS2 GET A CHARACTER BUT NOT TERMINATOR ISZ TEMP9,I INCREMENT CHAR COUNT IOR SBPTR,I STA SBPTR,I STORE RIGHT HALF IN WORD JSB CHRS2 GET A CHARACTER BUT NOT TERMINATOR JMP CHRS1 SPC 1 CHRS2 NOP JSB GETCR GET NEXT CHARACTER JMP CHRS5 NO MORE CHARACTERS CPA TEMP2 TERMINATOR CHARCTER? CHRS3 CLA,RSS YES! JMP CHRS2,I ISZ SBPTR STA SBPTR,I NULL OPERATOR FOLLOWS STRING LDA .32 STA BLANK BEGIN IGNORING BLANKS AGAIN JMP CHRST,I SPC 1 CHRS5 JSB BCKSP IN CASE WE NEED TO SENSE THIS LATER LDA TEMP2 CPA B200 ARE WE DOING A REM JMP CHRS3 YES, ALL OK! SZA,RSS DOING A FILES STMT? JMP CHRS3 YES! LDA .32 RESTORE BLANK STA BLANK DELIMITER JSB ERROR NO, MISSING TERMINATOR SYE14 EQU * * ******************** * * * DELETE STATEMENT * * * ******************** DLLIN LDA .LNUM GET CURRENT LINE # RSS AND DELETE IT DLSTM LDA SBUFA,I LOAD SEQUENCE NUMBER JSB FNDPS FIND STATEMENT TO BE DELETED JMP PEXMK DOESN'T JMP PEXMK EXIST CLA ZERO WORD SKIP FOR DESTINATION STB LOLIM INB ADDRESS OF SOURCE WORD SKIP IN B JSB CLPRG CLOSE UP PROGRAM LDA LOLIM,I SET UP STA .LNUM TO \rINA JSB FNDPS LIST NOP NEXT NOP STB HILIM STATEMENT JMP PLIST SKP ******************** * * * ACCEPT STATEMENT * * * ******************** ACTST LDA SBUFA COMPUTE CMA,INA LENGTH ADA SBPTR OF STATEMENT STA TEMP,I AND RECORD IT LDA SBUFA,I LOAD SEQUENCE NUMBER JSB FNDPS SEARCH ON SEQUENCE NUMBER JMP ACCS1 APPEND STATEMENT TO PROGRAM JMP ACCS4 INSERT STATEMENT IN PROGRAM INB REPLACE STATEMENT IN PROGRAM LDA MERGF IS MERGE SSA FLAG SET? JMP PEXMK YES, DON'T OVERLAY OLD STMT LDA 1,I COMPARE LENGTHS OF CMA,INA STATEMENT BEING REPLACED ADA TEMP,I AND STATEMENT SZA,RSS REPLACING IT JMP ACCS2 EQUAL SSA,RSS JMP ACCS4+1 SHORTER LDA TEMP,I LONGER, JSB CLPRG CLOSE UP PROGRAM JMP ACCS2 ACCS1 LDA TEMP,I LOAD PROGRAM SPACE REQUIREMENT JSB OVCHK SUFFICIENT PROGRAM SPACE LEFT? ACCS2 CLB YES, SET COUNTER TO ZERO LDA SBUFA INITIALIZE STA TEMP2 SOURCE ADDRESS ACCS3 LDA TEMP2,I TRANSFER WORD FROM STA TEMP3,I S-BUFFER TO PROGRAM SPACE ISZ TEMP2 INCREMENT SOURCE AND ISZ TEMP3 DESTINATION ADDRESSES INB BUMP COUNTER CPB TEMP,I ENTIRE STATEMENT MOVED? JMP ACCS5 YES JMP ACCS3 NO ACCS4 LDA TEMP,I LOAD PROGRAM SPACE REQUIREMENT JSB OVCHK SUFFICIENT PROGRAM SPACE LEFT? JSB MVTOH MAKE JMP ACCS2 ROOM * ACCS5 LDA .INBF MOVE LDB .OTBF STATEMENT JSB MVW TO DEC 36 OUTPUT NOP BUFFER LDA TEMP8 FOR CHAR CMA EDITTING STA OCCNT JMP bPEXMK EXIT THIS PHASE *************************** * * * DELETE SPACE IN PROGRAM * * * *************************** CLPRG NOP REFERENCE LOCATION IN TEMP3 ADA TEMP3 SKIP (A) LOCATIONS FROM TEMP3 STA TEMP4 AND SAVE DESTINATION ADDRESS LDB 1,I SKIP TO END OF STATEMENT BEING ADB TEMP3 DELETED, SOURCE ADDRESS IN (B) CLPR1 CPB PBPTR ALL OF PROGRAM MOVED? JMP CLPR2 YES LDA 1,I NO, MOVE WORD FROM SOURCE TO STA TEMP4,I DESTINATION ADDRESS ISZ TEMP4 INCREMENT DESTINATION ADDRESS INB INCREMENT SOURCE ADDRESS JMP CLPR1 CLPR2 LDA TEMP4 SET END-OF-PROGRAM STA PBPTR POINTER JMP CLPRG,I ************************************ * * * CHECK FOR PROGRAM SPACE OVERFLOW * * * ************************************ OVCHK NOP NEW WORD REQUIREMENT IN (A) LDB PBPTR SET SOURCE ADDRESS STB TEMP2 FOR PROGRAM RELOCATION ADB 0 SET DESTINATION STB TEMP4 ADDRESS CMB,INB ENOUGH ADB LWBM FREE SSB SPACE? JMP FSCE4 NO, PROGRAM SPACE OVERFLOW LDB TEMP4 YES, RELOCATE FREE STB PBPTR PROGRAM SPACE POINTER JMP OVCHK,I * * * * MOVE WORDS ROUTINE * * CALLING SEQ IS: A=SOURCE ADDRESS * B=DESTINATION ADDRESS * * (P) JSB MVW * (P+1) COUNT OF WORDS * (P+2) NOP * (P+3) RETURN HERE * MVW NOP STA TEMP4 SAVE SOURCE ADDRS LDA MVW,I GET COUNT CMA,INA AND USE ISZ MVW AS COUNTER STA MVW,I FOR MOVE MVW1 LDA TEMP4,I GET WORD STA 1,I PUT AWAY ISZ TEMP4 INCREMENT SOURCE ADDR INB INCREMENT DESTINATTION ADDR ISZ MVW,I INCREMENT COUNTER, DONE? JMP MVW1 NO, NOT YET ISZ MVW YES JMP MVW,I SKP *********************** * * * PRINT ERROR MESSAGE * * * *********************** ERROR NOP LDA MERGF IF FLAG IS SSA,RSS SET THEN CHECK FOR = LINE #'S JMP ERRO1 NOT SET * LDA .LNUM YES, SEARCH JSB FNDPS PROGRAM TO SEE NOP THERE IS ALREADY RSS A STMT WITH THIS LINE NUMBER JMP PEXMK FOUND ONE, IGNORE ERROR THEN * ERRO1 LDB ERROR ERROR SOURCE IN (B) LDA ERBS ERROR ADDRESS IN (A) INA MOVE TO NEXT ERROR CPB 0,I SAME AS ACTUAL ERROR? CMA,INA,RSS YES, MAKE ERROR NEGATIVE JMP *-3 NO ADA ERBS MAKE ERROR POSITIVE CMA,INA STA TEMP3 SAVE IT JMP OUTER PRINT ERROR MESSAGE *************** * * * ERROR TABLE * * * *************** ERR DEF NUMER ILLEGAL EXPONENT DEF SYNE1 NOT A FORTRAN FUNCTION DEF SYNE2 MISSING ASSIGNMENT OPERATOR DEF SYNE3 NOT A SUBROUTINE CALL DEF SYNE4+1 MISSING OR BAD FUNCTION NAME DEF SYNE5 MISSING OR BAD SIMPLE VARIABLE DEF SYNE6 MISSING OR BAD TRAP NUMBER DEF SYNE7 MISSING OR ILLEGAL 'THEN' DEF SYNE8 MISSING OR ILLEGAL 'OF' DEF SYNE9 MISSING OR ILLEGAL 'TO' DEF SYE10 MISSING OR ILLEGAL 'STEP' DEF CALER MISSING OR ILLEGAL SUBROUTINE DEF SYE11+1 TOO MANY PARAMETERS DEF SYE12 MISSING OR ILLEGAL DATA ITEM DEF SYE13 ILLEGAL READ OR INPUT VARIABLE DEF SYE14 NO CLOSING QUOTE DEF SYE15+1 MISSING OR BAD LIST DELIMITER DEF SYE16 ILLEGAL PARAMETER DEF STER1 ILLEGAL STRING VARIABLE DEF STER2 PARAMETER NOT STRING DEF SYE20 MISSING OR ILLEGAL SUBSCRIPT DEF STER3 STRING LONGER THAN 255 CHARACTERS DEF STER4 ILLEGAL STRING RELATIONAL OPERATOR DEF STER5 STRING NOT PERMMITED DEF FSCE1+1 MISSING LEFT PARENTHESIS DEF FSCE2+1 MISSING RIGHT PARENTHESIS S DEF FSCE3+1 UNRECOGNIZED OPERAND DEF ARRE2 MISSING OR BAD ARRAY IDENTIFIER DEF SYE25+1 MISSING OR BAD INTEGER DEF SYE26 SIGN WITHOUT NUMBER DEF NOEOF+1 CHARACTERS AFTER STATEMENT END DEF FSCE4+1 OUT OF CORE DURING SYNTAX DEF MER9 ARRAY TOO LARGE DEF SYE27 NO FILE REFERENCE FOUND SKP ****************************************** * * * FIND AND STORE ONE-CHARACTER OPERATORS * * * ****************************************** SYMCK NOP CHARACTER IN (A) STB COUNT -(ENTRIES TO BE SEARCHED) ALF,ALF POSITION IOR .32 CHARACTER LDB SYMCK,I STARTING TABLE ENTRY - 2 ISZ SYMCK SET RETURN ADDRESS SYMC1 ADB .2 UPDATE TABLE POINTER CPA 1,I MATCH? JMP SYMC2 ISZ COUNT NO, CONTINUE SEARCH? JMP SYMC1 YES ALF,ALF NO, RESTORE AND B177 CHARACTER JMP SYMCK,I AND EXIT SYMC2 CCA GET ADA 1 INFORMATION LDA 0,I WORD AND OPMSK AND STA SBPTR,I STORE IT CPA B1400 JMP FSC14 ISZ SYMCK RETURN VIA JMP SYMCK,I (P+2) SKP **************************** * * * COMPUTE STORAGE OF ARRAY * * * **************************** MDIM NOP STA 1 STORE PACKED DIMS. TEMPORALILY AND MSK0 STA COUNT STORE # COLUMNS LDA 1 ALF,ALF AND MSK0 A = # OF ROWS ALS DOUBLE FOR FLOATING POINT MPY COUNT `^ZCOMPUTE 2*ROWS*COLUMS SSA RESULT < 32768 ? JSB ERROR NO, ERROR DIMENSIONS TOO LARGE MER9 JMP MDIM,I YES, RETURN * TEMP EQU TEMPS+1 TEMP1 EQU TEMPS+2 TEMP2 EQU TEMPS+3 TEMP3 EQU TEMPS+4 TEMP4 EQU TEMPS+5 TEMP5 EQU TEMPS+6 TEMP6 EQU TEMPS+7 TEMP7 EQU TEMPS+8 TEMP8 EQU TEMPS+9 TEMP9 EQU TEMPS+10 PCNT EQU TEMPS+11 COUNT EQU TEMPT+1 SFLAG EQU TEMPT+2 CCODE EQU TEMPT+2 ARYAD EQU TEMPT+3 RFLAG EQU TEMPT+4 TABLE EQU TEMPT+4 SMEND EQU TEMPT+5 SLENG EQU TEMPT+6 TBLPT EQU TEMPT+7 TSPTR EQU TEMPT+8 LNGTH EQU TEMPT+9 PRPTR EQU TEMPT+10 PARAMETER PTR TCCNT EQU TEMPT+11 ORDINAL NUMBER OF SUBROUTINE FROMF EQU TEMPT+12 FROM SUB. PARAMETER FLAG TOFRM EQU TEMPT+13 TO/FROM WORD * END BASC1 5` +0\ 92101-18004 A S C0122 BASIC-FUNCTION MNEM TABLE              H0101 ~ASMB,R,L,C HED ** RTE BASIC MNEMONIC TABLE ** 92101-19004 REV. A NAM MNEM,7 92101-16004 750724 ********************************************************************** * * RTE BASIC STANDARD FUNCTION MNEMONIC TABLE * ********************************************************************** * ************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1975. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * * PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ************************************************************** * * LIST: 92101-19004 * SOURCE: 92101-18004 * RELOC: 92101-16004 * * * FOR EACH ENTRY IN THE MNEMONIC TABLE THERE IS A * ONE TO ONE CORRESPONDENCE TO ENTRIES IN THE BRANCH TABLE * THUS ANY ADDITIONS/DELETIONS TO THIS MNEMONIC TABLE * MUST REFLECT A CORRESPONDING ADDITION/DELETION IN THE * BRANCH TABLE. * * ********************************************************************** * * * ENT FCNCT ENT FCNS START OF FUNCTION MNEMONICS * * SUP SKP * * FCNCT DEC -19 -# OF FUNCTION MNEMONICS * * ********************************************************************** * * * THE FOLLOWING TABLE DEFINES AVAILABLE FUNCTION * MNEMONICS. TABLE ENTRIES ARE AS FOLLOOWS: * * OCT 00000C * ASC W,MNEM * * WHERE: C = CHARACTER LENGTH OF MNEMONIC * W = WORD LENGTH OF MNEMONIC * MNEM = ASSIGNED MNEMONIC * * ********************************************************************** * FCNS EQU * * * * FUNCTION MNEMONICS START HERE * OCT 3 ASC 2,TAB TAB FUNCTION * OCT 3 ASC 2,TYP TYP FUNCTION * OCT 3 ASC 2,SIN SINE FUNCTION * OCT 3 Ri  ASC 2,COS COSINE FUNCTION * OCT 3 ASC 2,TAN TANGENT FUNCTION * OCT 3 ASC 2,ATN ARC TANGENT FUNCTION * OCT 2 ASC 1,LN NATURAL LOG FUNCTION * OCT 3 ASC 2,LOG LOG BASE 10 * OCT 3 ASC 2,EXP EXPONENTIAL FUNCTION * OCT 3 ASC 2,ABS ABSOLUTE FUNCTION * OCT 3 ASC 2,SQR SQUARE ROOT FUNCTION * OCT 3 ASC 2,INT INTEGER FUNCTION * OCT 3 ASC 2,RND RANDOM NUMBER FUNCTION * OCT 3 ASC 2,SGN SIGN FUNCTION * OCT 3 ASC 2,SWR SWITCH REGISTER FUNCTION * OCT 3 ASC 2,TIM TIME FUNCTION * OCT 4 ASC 2,IERR ERROR CODE FUNCTION * OCT 4 ASC 2,SERR SET ERROR CODE * OCT 3 ASC 2,OCT PRINT OCTAL * SKP END ]  ,3 92101-18005 1826 S C1222 BASIC SEGMENTS 2,3,4              H0112 b?ASMB,R HED <> 92101-19005 REV.1826 NAM BASC2,5 92101-16005 REV.1826 780502 * * * ************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1975. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * * PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ************************************************************** * * * * LISTING: 92101-19005 * SOURCE: 92101-18005 * RELOC: 92101-16005 * * * ************************************************************* * ENT BASC2,MCOPY EXT EXEC,RDYPT,FNDPS,OUTCR,OUTIN,INTCK EXT CLOSE,WRITF,WRITE,ERRPT,NUMOT,GETCR,FCNS EXT IFBRK,FINDV,SPEC2,PRMT,COMFL,OPEN,READF COM TEMPS(30),PNTRS(74),FILBF(16),FLDCB(144),SPEC(10) ************************************** * * * SEGMENT #2: LIST THE PROGRAM * * * ************************************** * * THIS PART OF THE INTERPRETER IS LOADED BY THE BASIC MAIN CONTROL * WHENEVER THE 'LIST' OR 'SAVE' COMMANDS ARE GIVEN. IT WILL RE- * CONSTRUCT A USER PROGRAM, LINE BY LINE, CONVERTING IT FROM THE * TRANSLITERATED FORM TO ASCII. IT THEN OUTPUTS THIS ASCII TO * THE LIST DEVICE. * * IN ADDITION, THIS SEGMENT IS LOADED WHENEVER AN ERROR OCCURS. IT * WILL PRINT OUT THE APPROPRIATE ERROR MESSAGE AND THEN RETURN * EXECUTION TO THE MAIN CONTROL PROGRAM. SKP *************************** * * * CONSTANTS AND VARIABLES * * * *************************** * FWAM EQU PNTRS FIRST WORD OF AVAILABLE MEMORY LWBM EQU PNTRS+1 LAST WORD OF AVAILABLE MEMORY .INBF EQU PNTRS+2 INPUT BUFFER ADDRESS SBUFA EQU PNTRS+3 SYNTAX BUFFER ADDRESS SYMTA EQU PNTRS+4 START OF SYMBOL TABLE SYMTF \EQU PNTRS+5 END OF SYMBOL TABLE PBUFF EQU PNTRS+6 FIRST WORD OF USER PROGRAM PBPTR EQU PNTRS+7 LAST WORD+1 OF USER PROGRAM INBFA EQU PNTRS+8 INPUT BUFFER POINTER ICCNT EQU PNTRS+9 INPUT CHARACTER COUNT SBPTR EQU PNTRS+10 SYNTAX BUFFER POINTER .LNUM EQU PNTRS+11 CURRENT LINE # FCORE EQU PNTRS+12 START OF FREE CORE MNNAM EQU PNTRS+13 MNEMONIC TABLE NAME:SC:LU BRNAM EQU PNTRS+18 BRANCH TABLE NAME:SC:LU FWAMM EQU PNTRS+23 POINTER TO START OF MNEMONIC TABLE FWAMB EQU PNTRS+24 POINTER TO START OF BRANCH TABLE .OTBF EQU PNTRS+25 POINTER TO OUTPUT BUFFER OCCNT EQU PNTRS+26 OUTPUT CHARACTER COUNT OTBFA EQU PNTRS+27 POINTER INTO OUTPUT BUFFER LUOUT EQU PNTRS+28 CURRENT OUTPUT L.U. # LUINP EQU PNTRS+29 CURRENT INPUT L.U. # SIGN EQU PNTRS+30 SIGN OF CURRENT NUMBER BLANK EQU PNTRS+31 CURRENT TERMINATION CHAR REC# EQU PNTRS+32 COMMAND FILE RECORD NUMBER FLTYP EQU PNTRS+33 TYPE 0 FILE FLAG TTYPR EQU PNTRS+34 CONSOLE TTY L.U. # PRINT EQU PNTRS+35 LISTING L.U. # READR EQU PNTRS+36 AUXILLIARY INPUT L.U. # PUNCH EQU PNTRS+37 AUXILLIARY OUTPUT L.U. # ERTTY EQU PNTRS+38 ERROR LIST OUTPUT L.U. # DCB EQU PNTRS+39 DATA CONTROL BLOCK ADDRESS FILBK EQU PNTRS+40 FILE CONTROL BLOCK ADDRESS PFLAG EQU PNTRS+41 SAVE,LOAD FILE FLAG LOLIM EQU PNTRS+42 LOW LIMITS OF PROGRAM HILIM EQU PNTRS+43 HIGH LIMITS OF PROGRAM LORUN EQU PNTRS+44 LOW RUN LIMITS HIRUN EQU PNTRS+45 HIGH RUN LIMITS SLSTM EQU PNTRS+46 EXECUTE SLOW STMTS LOTRC EQU PNTRS+47 LOW TRACE LIMITS HITRC EQU PNTRS+48 HIGH TRACE LIMITS BRKP1 EQU PNTRS+49 BREAK POINT #1 BRKP2 EQU PNTRS+50 BREAK POINT #2 BRKP3 EQU PNTRS+51 BREAK POINT #3 BRKP4 EQU PNTRS+52 BREAK POINT #4 SMFLG EQU PNTRS+53 SIMULATE FLAG TYPE EQU PNTRS+54 PARTIAL LINE CHARACTER COUNT DLMTR EQU PNTRS+55 CHAR EDIT DELIMITER MERGF EQU PNTRS+56 MERGE FLAG COMN EQU PNTRS+57 COMMAND FILE NAME MANT1 EQU PNTRS+60 MANTISSA #1 MANT2 EQU PNTRS+61 MANTISSA #2 EXPNT EQU PNTRS+62 EXPONENT INLOC EQU PNTRS+63 IN(V. LOC. LU,STRK,#TKRS BR. INTKZ EQU PNTRS+64 TRACK SIZE ON DISC FOR INV. BR. HSTPT EQU PNTRS+65 HIGH-STACK POINTER BR. TSTPT EQU PNTRS+66 TEMPORARY STACK POINTER BR. LSTPT EQU PNTRS+67 LOW-STACK POINTER BR. LSTAK EQU PNTRS+68 LOW-STACK ADDRESS BR. PRADD EQU PNTRS+69 PROGRAM EXECUTION BR. DSTRT EQU PNTRS+70 DATA BR. NXTDT EQU PNTRS+71 STATEMENT BR. DCCNT EQU PNTRS+72 POINTERS BR. NXTST EQU PNTRS+73 NEXT STMT NUMBER SKP TEMPT BSS 7 STTYP DEF LET FOPBS DEF QUOTE-2 LNBFA DEF LNBFF-1 ERBFA DEF ERBUF DCBAD DEF FLDCB AFCNS DEF FCNS SPC 1 SUP PRESS MULTIPLE LISTINGS SPC 1 .0 DEC 0 .1 DEC 1 .2 DEC 2 .3 DEC 3 .4 DEC 4 .5 DEC 5 .7 DEC 7 .10 DEC 10 .15 DEC 15 .20 DEC 20 .32 DEC 32 .34 DEC 34 .40 DEC 40 .45 DEC 45 .73 DEC 73 .1000 DEC 1000 .9999 DEC 9999 .G50 OCT 50000 B36 OCT 36 B37 OCT 37 B40 EQU .32 B44 OCT 44 B60 OCT 60 B100 OCT 100 F OCT 106 N OCT 116 B177 OCT 177 B777 OCT 777 MSK0 OCT 377 B1000 OCT 1000 B1100 OCT 1100 COMWD OCT 34000 REMOP OCT 36000 IMAOP OCT 67000 FOROP OCT 41000 NEXOP OCT 42000 NSBOP OCT 56000 FILOP OCT 63000 SPLOP OCT 65000 ONOP OCT 73000 TYPFL OCT 100017 OPDMK OCT 100777 M1 DEC -1 M2 DEC -2 M3 DEC -3 M4 DEC -4 M5 DEC -5 M21 DEC -21 M99 DEC -99 M1000 DEC -1000 MNEG OCT 100000 MAXIMUM NEGATIVE FLOATING OCT 376 POINT NUMBER FLGBT EQU MNEG SPC 3 ERBUF ASC 5, IN LINE LNBFF BSS 2 BLNK DEF *+1 ASC 2, _ : ALEN DEF *+1 OCT 3 ASC 2,LEN FORCT NOP 'FOR'-'NEXT' SPACE COUNTER LNCNT NOP LINE COUNTER CRLF DEF *+1 OCT 6412 SKP ******************** * * * LIST THE PROGRAM * * * ******************** BASC;2 NOP CLA INITIALIZE STA LNCNT LINE COUNTER LDA LUOUT IS IT ERROR SSA MESSAGE ENTRY? JMP PRMES YES! LDB LOLIM SET PTR STB TEMPS TO PROGRAM START LDB PRINT ASSUME PRINTER LDA PFLAG BUT CHECK FLAG FOR SURE SSA -1 IF PUNCH LDB PUNCH ITS A PUNCH REQUEST CMA,SSA,INA,SZA PFLAG <= 0? JMP LIST1 NO, FILE OUTPUT STB LUOUT SAVE OUTPUT DEVICE L.U. SPC 1 * IF LINE PRINTER LIST DEVICE - MOVE FORM TO NEW PAGE * IF PUNCH LIST DEVICE - PUNCH LEADER ON TAPE SPC 1 LDA LUOUT JSB FINDV FETCH DRIVER NUMBER CPA .2 PUNCH? JMP LIS40 YES! CPA .10 LINE PRINTER? JMP LIS41 YES, THROW A PAGE! CPA .5 CRT LINEPRINTER? RSS MAYBE! JMP LIST1 NO SPECIAL PROCESSING CPB .4 LIS41 JSB HEAVE START AT TOP OF FORM JMP LIST1 * LIS40 LDA LUOUT FORM LEADER IOR B1000 CONTROL WORD STA TEMP3 JSB EXEC CALL EXEC DEF *+3 DEF .3 TO PUNCH DEF TEMP3 LEADER SPC 1 * INITIALIZE FOR CONVERTING A STATEMENT SPC 1 LIST1 LDB TEMPS MORE CPB HILIM PROGRAM? JMP LIS13 NO * CCA INITIALIZE ADA .OTBF OUTPUT STA OTBFA BUFFER POINTER CLA INITIALIZE STA OCCNT CHAR COUNT SKP * JSB OUTBL OUT PUT A BLANK JSB OUTBL OUT PUT A BLANK ISZ LNCNT UPDATE LINE COUNTER SPC 1 * OUTPUT LINE NUMBER SPC 1 LDA TEMPS,I OUTPUT STA .LNUM JSB OUTIN SEQUENCE NUMBER JSB OUTBL OUTPUT A BLANK LDB FORCT JSB FORSP INDENT 'FOR'-'NEXT' LOOP ISZ TEMPS FETCH LDA TEMPS,I STATEMENT LENGTH CMA,INA SET INA WORD STA LCNTR COUNTER LIST3 ISZ TEMPS MORE ISZ LCNTR STATEMENT? JMP LIST4 YES SPC 1 * CONVERSION COMPLETE - OUTPUT THE LINE ON LIST DEVICE SPC 1 LIS30 JSB IFBRK IS DEF *+1 ATTENTION SZA FLAG SET? JMP LIS13 YES, GO TO READY * LDA PFLAG IS OUTPUT CPA .1 TO DISK? JMP SAVEF YES! * LDB .OTBF OUTPUT LDA OCCNT STATEMENT JSB WRITE TO PERIPHERAL JMP LIST1 * SPC 1 * OUTPUT TO FILE SPC 1 SAVEF LDA OCCNT CHECK FOR UNEVEN SLA CHARACTER COUNT JMP SAVE1 YES, ITS ODD, MAKE IT EVEN RAR COUNT TO STA OCCNT WORD COUNT JSB WRITF WRITE OUT RECORD DEF *+6 DEF DCB,I DEF FERR DEF .OTBF,I DEF OCCNT DEF .0 LDA FERR WAS THERE SSA,RSS AN ERROR? JMP LIST1 NO! STA TEMP3 YES! JMP PRMES PRINT ERROR MESSAGE * SAVE1 LDA B40 APPEND A JSB OUTCR SPACE TO OUTPUT BUFFER JMP SAVEF SPC 1 * CONVERT THE OPERATOR SPC 1 LIST4 LDA TEMPS,I AND OPMSK SZA,RSS NULL OPERATOR? JMP LIST5 YES * CPA SPLOP SPECIAL SYNTAX LISTING RSS YES! JMP CONT NO! LDA LCNTR LENGTH COUNTER LDB .0 LIST SPEC SYNTAX FLAG JSB SPEC2 PROCESS LISTING OF SPECIAL SYNTAX JMP LIS30 DO ACTUAL LISTING * CONT STA TEMP2 SAVE OPERATOR ALF,ALF SINGLE ARS LDB 0 CHARACTER ADA M21 SSA,RSS OPERATOR? JMP LIS12 NO BLS YES INB LOAD ADB FOPBS SYMBOL'S LDA 1,I ASCII WORD ALF,ALF ADJUST AND MSK0 CHARACTER CPA .34 " ? JMP LIS14 YES JSB OUTCR NO SKP * CONVERT THE OPERAND SPC 1 LIST5 LDA TEMPS,I AND OPDMK SAVE STA TEMP3 OPERAND SSA FLAG BIT SET? JMP LIST9 YES SZA,RSS NO, NULL OPERAND? JMP LIST3 YES AND TYPFL ISOLATE TYPE PART CPA .15 FUNCTION? JMP LIST8 YES SPC 1 * OUTPUT LETTER-DIGIT COMBINATIONS SPC 1 LIST6 LDA TEMP3 RRR 4 AND B177 OUTPUT ADA B100 JSB OUTCR LETTER LDA TEMP3 YES AND .15 RESTORE SZA,RSS STRING? JMP LIS16 YES! ADA M5 NO! SSA LETTER-DIGIT? JMP LIST3 NO! ADA B60 DIGIT LIS17 JSB OUTCR OUTPUT DIGIT JMP LIST3 SPC 1 LIS16 LDA B44 '$' JMP LIS17 SPC 1 LIST8 LDA F OUTPUT JSB OUTCR LDA N 'FN' JSB OUTCR LDA TEMP3 OUTPUT RRR 4 AND B177 LETTER ADA B100 JSB OUTCR JMP LIST3 SPC 1 * OUTPUT FLOATING-POINT CONSTANTS SPC 1 LIST9 XOR FLGBT SZA NUMBER? JMP LIS10 NO ISZ TEMPS YES LDA TEMPS,I ISZ TEMPS LDB TEMPS,I ISZ LCNTR ISZ LCNTR CCE OUTPUT JSB NUMOT THE NUMBER JMP LIST3 SPC 1 * OUTPUT FUNCTION NAMES SPC 1 LIS10 AND .15 CPA .3 INTEGER? JMP LIS11 YES CPA .15 NO, FUNCTION? RSS YES JMP LIST6 NO, MUST BE A PARAMETER LDA TEMP3 COMPUTE RRR 4 AND B37 COMPUTE INTERNAL FUNCTION NO. CPA B37 IS IT LEN FUNCTION? JMP LENF YES CPA B36 FORTRAN FUNCTION? JMP FRFCT YES! STA TEMP2 CODE CMA STA TEMP5 NO. OF MNEMONICS TO SKIP LDA AFCNS RSS PEEL LDA 0,I OFF RAL,CLE,SLA,ERA INDIRECTS JMP *-2 STA 1 ADDR OF MNEMONIC ENTRIES IN BREG NXFCN ISZ TEMP5 IS THIS IT? RSS NO! JMP LFCN YES! LDA 1,I GET FIRST WORD OF MNEMONIC ENTRY AND .7 GET CHARACTER COUNT ADA .3 ARS INCREMENT TO NEXT ENTRY ADB 0 ADD IN MNEM TBL ADDRESS JMP NXFCN CHECK NEXT ENTRY LFCN JSB MCOPY OUTPUT FUNCTION NAME JMP LIST3 * LEN FUNCTION FOUND LENF LDB ALEN ADDRESS OF PRINT JMP LFCN BUFFER FOR LEN FRFCT ISZ TEMPS ISZ LCNTR JMP MCAL1 PRINT FORTRAN FUNCT MNEM SPC 1 * OUTPUT INTEGER CONSTANTS SPC 1 LIS11 ISZ TEMPS OUTPUT ISZ LCNTR LDA TEMPS,I INTEGER SSA MINUS SIGN REQUIRED? JMP LIS19 YES! LIS18 JSB OUTIN JMP LIST3 OPERAND * LIS19 LDA .45 OUTPUT JSB OUTCR MINUS SIGN LDA TEMPS,I COMPLEMENT CMA,INA TO OBTAIN JMP LIS18 ABSOLUTE VALUE SPC 1 * OUTPUT OPERATOR SPC 1 LIS12 JSB OUTBL OUTPUT A BLANK * LDA TEMP2 IS THIS CPA FOROP A 'FOR' STATEMENT? JMP LIS21 YES, INDENT 'FOR' STATEMENT LIS22 LDA TEMP2 CPA NEXOP IS THIS A 'NEXT' STMT? RSS YES! JMP *+4 NO! LDB FORCT DECREMENT ADB M1 FOR STB FORCT COUNT CPA .G50 CALL? JMP MCALL YES. PRINT CALL STATEMENT JSB MCOUT OUTPUT LDA TEMP2 OPERATOR CPA REMOP IS IT A REMARK STATEMENT? JMP LIS15 YES CPA IMAOP IMAGE STMT? JMP LIS15 YES! CPA FILOP IS IT A FILES STATEMENT? JMP LIS23 YES LDA TEMP2 COM STMT? CPA COMWD RSS YES! JMP *+5 NO! , ISZ TEMPS YES, SKIP ISZ TEMPS OVER COMMON SIZE ISZ LCNTR AND DECREMENT ISZ LCNTR LENGTH COUNTER LDA .32 OUTPUT A BLANK JMP LIST5-1 AND LOOK FOR OPERANDS. * LIS23 JSB OUTBL OUTPUT A BLANK LIS15 JSB OUTST OUTPUT STRING JMP LIST3 SPC 1 LIS21 ISZ FORCT INCREMENT COUNT LDB .1 AND INDENT JSB FORSP 'FOR' STATEMENT JMP LIS22 ONE MORE TIME SPC 1 * IF PUNCH LIST DEVICE - PUNCH TRAILER ON TAPE SPC 1 LIS13 LDA PFLAG CPA .1 FILE OUTPUT? JMP SAVE2 YES! CPA .0 KEYBOARD OUTPUT? JMP LIS20 YES! LDA LUOUT JSB FINDV FETCH DRIVER NUMBER CPA .5 264X DEVICE? RSS YES! JMP LIS49 NO! CPB .1 MINITAPE? JMP EOF YES, LEFT UNIT! CPB .2 JMP EOF RIGHT UNIT! CPB .4 CRT PRINTER? JMP LIS50 YES! LIS49 CPA .10 A REGULAR LP? JMP LIS50 YES, THROW A PAGE! CPA .2 PUNCH? JMP EOF YES, PUNCH TRAILER! JMP ENLST END! * LIS50 JSB HEAVE EJECT PAGE JMP ENLST * EOF LDA LUOUT IOR B1000 FORM EOF REQUEST STA TEMP3 JSB EXEC PUNCH LEADER DEF *+3 OR DEF .3 WRITE DEF TEMP3 EOF FOR 264X JMP ENLST * SAVE2 JSB WRITF WRITE DEF *+5 DEF DCB,I END-OF DEF FERR DEF .OTBF,I DEF M1 FILE JSB CLOSE CLOSE FILE! DEF *+4 DEF DCB,I DEF FERR DEF M1 LDA FERR WAS THERE SSA,RSS AN ERROR? JMP ENLST NO! STA TEMP3 YES, SAVE ERROR # JMP PRMES PRINT ERROR MESSAGE * LIS20 LDA LUOUT IS THE LIST UNIT CPA TTYPR REALLY THE JMP ENLST CONSOLE JSB HEAVE b3 OR LINE ENLST LDA REC# INPUT FROM CPA .1 COMMAND FILE? JMP PRMT YES, DON'T PRINT READY LDA LNCNT LINE COUNT CPA .1 ONLY ONE? JMP RDYPT NO! JMP COMFL YES! SKP ******************************* * * * INDENT 'FOR'-'NEXT' LOOPS * * * ******************************* * FORSP NOP SZB,RSS NEED ANY SPACES? JMP FORSP,I NO! SSB TOO MANY 'NEXT'S' ? JMP FORSP,I YES! CMB,INB SET STB TEMP3 COUNTER FORS1 LDA PFLAG OUTPUT TO DISK? CPA .1 JMP FORS3 YES, GO CHECK FILE TYPE CPA M1 TO PUNCH? JMP FORSP,I YES, DON'T INDENT FORS0 LDA B40 OUTPUT JSB OUTCR SPACE LDA B40 OUTPUT ANOTHER JSB OUTCR SPACE ISZ TEMP3 DONE? JMP FORS0 NO! JMP FORSP,I YES! * FORS3 LDB DCB CHECK ADB .2 DCB FOR LDA 1,I FILE TYPE SZA TYPE = 0 ? JMP FORSP,I NO, EXIT NOW JMP FORS0 YES, GO INDENT! SPC 2 ******************** * * * OUTPUT A BLANK * * * ******************** * OUTBL NOP LDA PFLAG IS OUTPUT CPA .1 TO DISC? JMP OUTB1 YES! CPA M1 TO PUNCH? JMP OUTBL,I YES JMP OUTB2 NO, OUTPUT BLANK * OUTB1 LDB DCB CHECK ADB .2 DCB FOR LDA 1,I FILE TYPE SZA = 0? JMP OUTBL,I YES! * OUTB2 LDA .32 OUTPUT A BLANK JSB OUTCR JMP OUTBL,I SKP * OUTPUT QUOTE STRING SPC 1 LIS14 LDB TEMPS,I OUTPUT QUOTE STRING BLF,BLF TEST BIT 8 SLB SUPPRESS QUOTES? JMP LIS13 YES! JSB OUTCR OUTPUT " JSB OUTST OUTPUT QUOTEX STRING LDA .34 OUTPUT " JMP LIS17 * ********************* * * * OUTPUT FORMFEED * * * ********************* * HEAVE NOP AND B177 MAKE SURE V-BIT IS 0 IOR B1100 FORM TAB COMMAND STA LENTH JSB FINDV GET DVR NUMBER CPA .10 LINE PRINTER RSS YES! JMP HEAVE,I JSB EXEC DO IT TO IT DEF *+4 DEF .3 DEF LENTH DEF M3 JMP HEAVE,I * * SKP ******************* * * * OUTPUT A STRING * * * ******************* OUTST NOP LDA TEMPS,I AND B177 GET STRING COUNT CMA,INA,SZA,RSS NULL STRING? JMP OUTST,I YES! STA TEMP6 NO, SAVE NEG OF COUNT OUTS1 ISZ TEMPS MOVE TO NEXT PAIR OF CHARS ISZ LCNTR BUMP COUNTER LDA TEMPS,I GET THEM ALF,ALF POSITION TO OUTPUT LEFT CHARACTER JSB OUTS2 OUTPUT CHAR LDA TEMPS,I GET CHAR PAIR AGAIN JSB OUTS2 OUTPUT RIGHT HAND CHAR JMP OUTS1 SPC 1 OUTS2 NOP AND B177 JSB OUTCR ISOLATE AND OUTPUT CHAR ISZ TEMP6 WAS IT LAST CHAR JMP OUTS2,I NO! JMP OUTST,I YES! * ********************************** * * * OUTPUT A MULTICHARACTER SYMBOL * * * ********************************** MCOUT NOP LDB STTYP ADDRESS OF STATEMENT OPERATORS MCOU1 LDA 1,I LOAD INFORMATION WORD AND OPMSK COMPARE WITH CPA TEMP2 OPERATOR CODE JMP MCOU2 EQUAL LDA 1,I UNEQUAL, AND .7 COMPUTE ADA .3 ENTRY ARS LENGTH ADB 0 COMPUTE ADDRESS OF NEXT ENTRY JMP MCOU1 MCOU2 JSB MCOPY GO OUTPUT SYMBOL JMP MCOUT,I * MCOPY NOP LDA 1,I COMPUTE AND .7 ENTRY OM CMA,INA LENGTH STA DIGCT AND SAVE IT CLE,INB SET FOR FIRST CHARACTER STB TEMP3 SAVE SYMBOL ADDRESS MCOU3 LDA TEMP3,I LOAD WORD SEZ,RSS FIRST CHARACTER? ALF,ALF YES, POSITION IT AND B177 EXTRACT CHARACTER JSB OUTCR OUTPUT IT SEZ,CME SET FOR NEXT CHARACTER ISZ TEMP3 MOVE TO NEXT WORD OF SYMBOL ISZ DIGCT MORE CHARACTERS? JMP MCOU3 YES JMP MCOPY,I ******************************* * * * LIST A CALL STATEMENT * * * ******************************* * MCALL JSB MCOUT OUTPUT 'CALL" JSB OUTBL OUTPUT A BLANK MCAL1 LDA TEMPS STA TEMP7 CLEAR FORT FCT FLAG LDA 0,I GET OPERATOR WORD AND B777 GET MNEMONIC TBL OFFSET CMA USE OFFSET TO FIND MNEMONIC STA TEMP5 NO. OF MNEMONICS TO SKIP LDB FWAMM GET ADDR. OF SUB. MNEMONICS INB NXSUB ISZ TEMP5 IS THIS IT? RSS NO! JMP LCALL YES! LDA 1,I GET FIRST WORD OF MNEMONIC ENTRY AND .7 GET CHARACTER COUNT ADA .3 ARS INCREMENT TO NEXT ENTRY ADB 0 ADD IN MNEM TBL ADDRESS JMP NXSUB CHECK NEXT ENTRY LCALL JSB MCOPY LIST THE CALL MNEMONIC LDA TEMP4 GET LAST CHAR (SEE OUTCR) CPA .40 LAST CHAR "("? RSS YES, SUPPRESS SPACE JSB OUTBL OUTPUT A BLANK ISZ TEMPS POINT AT FIRST PARAM ISZ LCNTR UPDATE INTERMEDIATE CODE COUNTER JMP LIST5 SKP ********************************************************************* * * * THIS ROUTINE REPLACE ALL ABSOLUTE GOTO WITH STMT #'S * * * **************************ʞHFB******************************************* STREN NOP LDA TEMP3 IS THIS ADA M99 SSA,RSS ERROR IN ONE OF THE COMMAND SEGMENTS JMP STREN,I YES, DONT REPLACE SEQ NUMBERS LDA PBUFF CPA PBPTR ANY PROGRAM? JMP STREN,I NO! STA RENQ ADA M1 STA RENP SEEK EMBEDDED REN12 JSB RENSK STATEMENT REFERENCES JMP STREN,I NONE LEFT LDA RENP,I IF REFERENCE IS CPA COMMA COMMA? JMP REN12 YES, CONTINUE MIGHT BE GOTO-OF ETC. JSB RENS0 SET STMT NUMBER TO ABSOLUTE ADDRESS JMP REN12 * RENSK NOP LDB M5 STB RENCT SET 'IF' COUNTER LDB PSTIF STB RENAD SET PAST IF STMT PTR ISZ RENP INCREMENT POINTER LDB RENQ ADDRESS OF BEGINNING OF NEXT STMT LDA USFLG PRINT USING SZA LAST STMT? JMP RENS2 YES, SKIP OVER REST OF STMT! LDB RENQ CPB RENP STATEMENT FINISHED? JMP RENS2 YES RENS1 ISZ RENSK NO, RETURN WITH RENP JMP RENSK,I SET TO NEXT REFERENCE STB RENQ UPDATE TO NEXT STATEMENT RENS2 CLA SET PRINT USING H STA USFLG CLEAR CPB PBPTR PROGRAM EXHAUSTED? JMP RENSK,I YES STB RENR SAVE CURRENT STATEMENT ADDRS ISZ RENQ LDB RENQ ISZ RENQ EXTRACT LDA RENQ,I STATEMENT AND OPMSK TYPE ADB 1,I SET (B) TO ADB M1 NEXT STATEMENT CPA RESOP ? JMP RENS5 YES CPA GOTOP NO, ? JMP RENS3 YES CPA GOSOP NO, ? JMP RENS3 YES CPA FALOP NO, ? JMP RENS3 YES CPA CALOP NO, ? RSS YES CPA TRPOP NO, ? RSS YES! CPA PRTOP NO, ? RSS YES! CPA IFOP NO, ? RSS YES! JMP RENS2-1 LDA RENAD,I GET PAST 'IF' OPERATOR RENS3 IOR INTFL CREATE REFERNCE HEADER STB RENQ SET POINTER TO NEXT STMT ADB M1 SET PTR TO RENS4 STB RENP PROSPECTIVE HEADER? ADB M1 CPB RENR END OF STATEMENT? JMP RENS6 YES! RENS8 CPA 1,I PRECEDED BY REFERENCE HEADER? JMP RENS7 YES ISZ RENAD GOTO NEXT OPERATOR LDA RENAD,I PAST 'IF' IOR INTFL ISZ RENCT DONE? JMP RENS8 NO! LDA PSTIF STA RENAD LDA M5 STA RENCT LDA OFOP YES, LOAD HEADER FOR CPA 1,I JMP RENS1 LDA USEOP PRINT USING? CPA 1,I JMP RENS1 JMP RENS4 REFERENCE LIST RENS5 CPA RENQ,I ANY REFERENCE? JMP RENS2-1 NO JMP RENS3 YES RENS6 LDB RENQ 'THEN','GOTO', OR 'GOSUB' JMP RENS2 NOT FOUND * RENS7 CPA USEOP ? STA USFLG YES, SET 'PRINT USING' FLAG SO AS TO SKIP REST OF STMT JMP RENS1 * RENS0 NOP LDA RENP,I GET STMT NUMBER RLDB 0 IS THIS LDA 0,I ADB MAXSN A STMT SSB NUMBER OR ADDRESS? JMP RENS0,I NUMBER DON'T CHANGE IT STA RENP,I STUFF IN STMT NUMBER JMP RENS0,I * * MAXSN DEC -10000 INTFL OCT 100003 RENCT DEC -3 RENAD DEF THNOP RENP BSS 1 RENQ BSS 1 RENR BSS 1 USFLG NOP COMMA OCT 102003 PSTIF DEF *+1 THESE THNOP OCT 60000 SIX GOTOP OCT 37000 ITEMS MUST GOSOP OCT 43000 BE CONTIGUOUS RESOP OCT 55000 ** PRTOP OCT 53000 IFOP OCT 40000 OFOP OCT 177003 TRPOP OCT 66000 USEOP OCT 161003 FALOP OCT 57000 CALOP OCT 50000 OPMSK OCT 77000 SKP ***************************************************** * * * READ MNEMONIC TABLE INTO SPACE BETWEEN LONGEST * * SEGMENT AND NEXT TO LONGEST SEGMENT * * * ***************************************************** * LOADM NOP LDA DCBAD SET UP STA DCB DATA CONTROL BLOCK JSB OPEN OPEN DEF *+7 MNEMONIC DEF DCB,I TABLE DEF FERR FILE DEF MNNAM DEF .0 DEF MNNAM+3 DEF MNNAM+4 JSB CKERR ERROR? LDA FWAMM SET STARTING STA TEMP4 ADDRESS OF MNEMONIC TBL LOAD3 JSB READF READ DEF *+6 DEF DCB,I MNEMONIC DEF FERR DEF TEMP4,I TABLE DEF .9999 INTO CORE DEF TEMP3 LDB TEMP3 CPB M1 EOF READ? JMP LOAD7 YES ADB TEMP4 NO, SET NEW READ STB TEMP4 INDEX * JMP LOAD3 NO, READ SOME MORE LOAD7 JSB CKERR ERROR? JSB CLOSE CLOSE DEF *+4 DEF DCB,I THE DEF FERR DEF .0 FILE JSB CKERR JMP LOADM,I * ********************************** * * * CHECK FOR FILE MANAGER ERROR * * * ********************************** * CKERR NOP LDA FERR IS THERE SSA,RSS AN ERROR? JMP CKERR,I NO! JMP FLERR PRINT ERR MESS SKP * * * MOVE WORDS ROUTINE * * CALLING SEQ IS: A=SOURCE ADDRESS * B=DESTINATION ADDRESS * * (P) JSB MVW * (P+1) COUNT OF WORDS * (P+2) NOP * (P+3) RETURN HERE * MVW NOP STA TEMP4 SAVE SOURCE ADDRS LDA MVW,I GET COUNT CMA,INA AND USE ISZ MVW AS COUNTER STA MVW,I FOR MOVE MVW1 LDA TEMP4,I GET WORD STA 1,I PUT AWAY ISZ TEMP4 INCREMENT SOURCE ADDR INB INCREMENT DESTINATION ADDR ISZ MVW,I INCREMENT COUNTER, DONE? JMP MVW1 NO, NOT YET ISZ MVW YES JMP MVW,I *********************** * * * PRINT ERROR MESSAGE * * * *********************** * * PRMES JSB STREN JSB EXEC RELEASE ANY DEF *+3 DEF .5 INVOKE TRACKS DEF M1 CLA STA INLOC CLEAR OUT TRAK NUMBER ALSO LDA ERTTY RESET OUTPUT STA LUOUT L.U. # TO ERROR DEVICE LDA TEMP3 GET ERROR # SSA DISK FILE ERROR? JMP FLERR YES! * ADA M1000 IS THIS AN ERROR SSA FROM THE SPECIAL SYNTAX MODULE? JMP PRME1 NO, CONTINUE LDB M1 SPECIAL SYNTAX ERROR FLAG JSB SPEC2 PRINT SPECIAL SYNTAX ERROR JMP PRMS2 PRME1 ADA .1000 RESTORE ERROR NUMBER * CMA,INA MAKE NEGATIVE AND STA LCNTR SAVE FOR COUNTER LDB MESGA SET TABLE PNTR TO START PRMS1 LDA 1,I GET LENGTH OF MESSAGE INB MOVE PNTR TO MESSAGE ISZ LCNTR INDEX ERROR CNTR, IS IT = 0? RSS  NO, MOVE PNTR TO NEXT MESSG JMP PRMS2 YES - GO PRINT MESSAGE SLA IF CHAR COUNT ODD, INA MAKE EVEN ARS CONVERT TO WORDS ADB 0 MOVE PNTR TO NEXT MESSG JMP PRMS1 GO INDEX ERROR COUNTER * * DISK FILE ERRORS ARE NEGATIVE AND COME HERE * FLERR LDB FMESA GET ADDR OF DISK ERRORS STA LCNTR SAVE ERROR # FOR COUNT JMP PRMS1 PRINT ERROR MESSAGE * * PRMS2 JSB WRITE PRINT FIRST PART OF MESSAGE LDA .10 INITIALIZE STA OCCNT OUTPUT LDA LNBFA BUFFER STA OTBFA LDA .LNUM OUTPUT SZA,RSS COMMAND ERROR? JMP ERRP2 YES, DON'T PRINT OUT LINE# JSB OUTIN NO! LDA OCCNT LINE LDB ERBFA JSB WRITE NUMBER * LDA TEMP8 IS CHAR SSA,RSS COUNT CMA,INA WITHIN ADA .73 A REASONABLE SSA RANGE? JMP ERRP1 NO, GO TO MAIN! LDA .INBF YES, MOVE LDB .OTBF BAD STMT JSB MVW FROM INPUT DEC 36 BUFFER TO NOP OUTPUT BUFFER LDA TEMP8 MAKE CMA STATEMENT STA OCCNT LENGTH POSITIVE LDA PFLAG KEYBOARD SZA,RSS INPUT? JMP ERRP1 YES, EXIT CPA .1 FILE INPUT? RSS YES, PRINT STMT! JMP ERRP1 NO! LDA .OTBF,I ARE FIRST TWO CPA BLNK,I CHARACTERS BLNKS? JMP PRMS3 YES, DON'T INSERT BLANKS LDA .3 OUTPUT LDB BLNK TWO JSB WRITE BLANKS PRMS3 LDA OCCNT REPRINT LDB .OTBF THE JSB WRITE STATEMENT * ERRP1 LDA MNNAM ANY B&M SZA TABLES OUT THERE? JSB LOADM YES! GO GET EM LDA REC# ARE WE FROM CPA .1 A COMMAND FILE? JMP ERRPT NO, RE 1TURN TO MAIN JMP PRMT YES, RETURN TO IT THEN * ERRP2 LDA M2 PRINT LDB CRLF CARRIAGE RETURN/LINE FEED JSB WRITE JMP ERRP1 * TEMP2 EQU TEMPS+3 TEMP3 EQU TEMPS+4 TEMP4 EQU TEMPS+5 TEMP5 EQU TEMPS+6 TEMP6 EQU TEMPS+7 TEMP7 EQU TEMPS+8 TEMP8 EQU TEMPS+9 LENTH EQU TEMPT+1 TBUFA EQU TEMPT+2 TCNTR EQU TEMPT+3 LCNTR EQU TEMPT+4 DIGCT EQU TEMPT+5 FERR EQU TEMPT+6 SKP *********************** * * * ERROR MESSAGE TABLE * * * *********************** SPC 1 * ERROR MESSAGES FOR SYNTAX (SEG1) PHASE SPC 1 MESGA DEF *+1 ADDRESS OF ERROR STANDARD ERRORS MESSG DEC 17 ASC 9,ILLEGAL EXPONENT_ : DEC 23 ASC 12,NOT A FORTRAN FUNCTION_ : DEC 28 ASC 14,MISSING ASSIGNMENT OPERATOR_ : DEC 22 ASC 11,NOT A SUBROUTINE CALL_ : DEC 29 ASC 15,MISSING OR BAD FUNCTION NAME_ : DEC 31 ASC 16,MISSING OR BAD SIMPLE VARIABLE_ : DEC 27 ASC 14,MISSING OR BAD TRAP NUMBER_ : DEC 26 ASC 13,MISSING OR ILLEGAL 'THEN'_ : DEC 24 ASC 12,MISSING OR ILLEGAL 'OF'_ : DEC 24 ASC 12,MISSING OR ILLEGAL 'TO'_ : DEC 26 ASC 13,MISSING OR ILLEGAL 'STEP'_ : DEC 30 ASC 15,MISSING OR ILLEGAL SUBROUTINE_ : DEC 27 ASC 14,WRONG NUMBER OF PARAMETERS_ : DEC 29 ASC 15,MISSING OR ILLEGAL DATA ITEM_ : DEC 31 ASC 16,ILLEGAL READ OR INPUT VARIABLE_ : DEC 17 ASC 9,NO CLOSING QUOTE_ : DEC 30 ASC 15,MISSING OR BAD LIST DELIMITER_ : DEC 18 ASC 9,ILLEGAL PARAMETE|R_ : DEC 24 ASC 12,ILLEGAL STRING VARIABLE_ : DEC 21 ASC 11,PARAMETER NOT STRING_ : DEC 29 ASC 15,MISSING OR ILLEGAL SUBSCRIPT_ : DEC 33 ASC 17,STRING LONGER THAN 72 CHARACTERS_  : DEC 35 ASC 18,ILLEGAL STRING RELATIONAL OPERATOR_ : DEC 21 ASC 11,STRING NOT PERMITTED_ : DEC 25 ASC 13,MISSING LEFT PARENTHESIS_ : DEC 26 ASC 13,MISSING RIGHT PARENTHESIS_ : DEC 23 ASC 12,UNDECIPHERABLE OPERAND_ : DEC 30 ASC 15,MISSING OR BAD ARRAY VARIABLE_ : DEC 27 ASC 14,ILLEGAL OR MISSING INTEGER_ : DEC 20 ASC 10,SIGN WITHOUT NUMBER_ : DEC 31 ASC 16,CHARACTERS AFTER STATEMENT END_ : DEC 15 ASC 8,OUT OF STORAGE_ : DEC 16 ASC 8,ARRAY TOO LARGE_ : DEC 30 ASC 15,BAD OR MISSING FILE REFERENCE_ : SPC 1 * ERROR MESSAGES FOR PRE-EXECUTION (SEG3) PHASE SPC 1 DEC 27 ASC 14,COM STATEMENT OUT OF ORDER_ : DEC 23 ASC 12,FUNCTION DEFINED TWICE_ : DEC 14 ASC 7,UNMATCHED FOR_ : DEC 26 ASC 13,NEXT WITHOUT MATCHING FOR_ : DEC 26 ASC 13,DIMENSIONS NOT COMPATIBLE_ : DEC 25 ASC 13,LAST STATEMENT NOT 'END'_ : DEC 27 ASC 14,VARIABLE DIMENSIONED TWICE_ : DEC 28 ASC 14,ARRAY OF UNKNOWN DIMENSIONS_ : DEC 16 ASC 8,ARRAY TOO LARGE_ : DEC 15 ASC 8,OUT VOF STORAGE_ : DEC 15 ASC 8,TOO MANY FILES_ : DEC 20 ASC 10,BAD FILES STATEMENT_ : DEC 22 ASC 11,SYMBOL TABLE OVERFLOW_ : DEC 22 ASC 11,INVALID SECURITY CODE_ : DEC 18 ASC 9,INVALID FILE NAME_ : DEC 11 ASC 6,INVALID LU_ : DEC 17 ASC 9,MISSING SEGMENTS_ : DEC 31 ASC 16,UNDEFINED STATEMENT REFERENCED_ : SPC 1 * ERROR MESSAGES FOR EXECUTE (SEG4) PHASE SPC 1 DEC 15 ASC 8,OUT OF STORAGE_ : DEC 22 ASC 11,GOSUBS NESTED 20 DEEP_ : DEC 27 ASC 14,RETURN WITH NO PRIOR GOSUB_ : DEC 12 ASC 6,OUT OF DATA_ : DEC 16 ASC 8,WRONG DATA TYPE_ : DEC 24 ASC 12,SUBSCRIPT OUT OF BOUNDS_ : DEC 30 ASC 15,REFERENCED STATEMENT NOT DATA_ : DEC 36 ASC 18,STATEMENT REFERENCED NOT IMAGE STMT_ : DEC 39 ASC 20,PRINT 'USING' IS NOT ALLOWED TO A FILE_ : DEC 25 ASC 13,UNDEFINED VALUE ACCESSED_ : DEC 29 ASC 15,NON-EXISTENT FILE REFERENCED_ : DEC 14 ASC 7,FILE NOT OPEN_ : DEC 26 ASC 13,END-OF-FILE/END-OF-RECORD_ : DEC 31 ASC 16,UNDEFINED STATEMENT REFERENCED_ : DEC 9 ASC 5,BAD DATA_ : DEC 13 ASC 7,BAD EXPONENT_ : DEC 37 ASC 19,SUB. OR FUNCT. TERMINATED ABNORMALLY_ : DEC 18 ASC 9,ILLEGAL FILE TYPE_ : DEC 18 ASC 9,OVERLAY NOT FOUND_ : DEC 16 ASC 8,TRAP TABLE FULL_ : DEC 24 ASC 12,ILLEGAL TRAP/SEQ NUMBER_ : DEC 27 ASC 14,SCHEDULED BUT DELETED TASK_ : DEC 16 ASC 8,TRAP TABLE BUSY_ : DEC 23 ASC 12,NEGATIVE STRING LENGTH_ : DEC 22 ASC 11,NON-CONTIGUOUS STRING_ : DEC 16 ASC 8,STRING OVERFLOW_ : DEC 30 ASC 15,NEGATIVE NUMBER TO REAL POWER_ : DEC 19 ASC 10,ZERO TO ZERO POWER_ : DEC 23 ASC 12,ZERO TO NEGATIVE POWER_ : DEC 25 ASC 13,OUT OF RANGE IN FUNCTION_ : DEC 25 ASC 13,LOG OF NEGATIVE ARGUMENT_ : DEC 17 ASC 9,EXP OUT OF RANGE_ : DEC 29 ASC 15,MISSING FORMAT SPECIFICATION_ : DEC 29 ASC 15,ILLEGAL OR MISSING DELIMITER_ : DEC 17 ASC 9,NO CLOSING QUOTE_ : DEC 31 ASC 16,BAD CHARACTER AFTER REPLICATOR_ : DEC 21 ASC 11,REPLICATOR TOO LARGE_ : DEC 16 ASC 8,REPLICATOR ZERO_ : DEC 24 ASC 12,MULTIPLE DECIMAL POINTS_ : DEC 33 ASC 17,BAD FLOATING POINT SPECIFICATION_ : DEC 28 ASC 14,ILLEGAL CHARACTER IN FORMAT_ : DEC 26 ASC 13,ILLEGAL FORMAT FOR STRING_ : DEC 26 ASC 13,MISSING RIGHT PARENTHESIS_ : DEC 19 ASC 10,MISSING REPLICATOR_ : DEC 28 ASC 14,TOO MANY PARENTHESIS LEVELS_  : DEC 25 ASC 13,MISSING LEFT PARENTHESIS_ : DEC 26 ASC 13,ILLEGAL FORMAT FOR NUMBER_ : SPC 1 * ERROR MESSAGES FOR COMMAND (SEG 5) PHASE SPC 1 DEC 15 ASC 8,INVALID COMMAND DEC 14 ASC 7,INVALID LIMITS DEC 17 ASC 9,INVALID FILE NAME DEC 34 ASC 17,NOT ENOUGH ROOM FOR MNEMONIC TABLE DEC 19 ASC 10,DUPLICATE FILE NAME DEC 36 ASC 18,READ FROM WRITE DEVICE OR VICE-VERSA DEC 10 ASC 5,INVALID LU DEC 24 ASC 12,BAD OR MISSING FILE SIZE DEC 19 ASC 10,DEL OR SAVE PROGRAM DEC 20 ASC 10,NO TYPE 0 FILE FOUND DEC 25 ASC 13,INCOMPATIBLE 'CSAVE' FILE DEC 21 ASC 11,INVALID SECURITY CODE DEC 24 ASC 12,INVALID STATEMENT NUMBER DEC 19 ASC 10,ILLEGAL TABLE ORDER DEC 17 ASC 9,ILLEGAL FILE TYPE DEC 44 ASC 22,REQ'D ID SEGMENT NOT FOUND OR NONE AVAILABLE DEC 42 ASC 21,PROGRAM FILE IS NOT ON LOGICAL UNIT 2 OR 3 DEC 45 ASC 23,PROGRAM FILE WAS NOT SET UP ON CURRENT SYSTEM DEC 22 ASC 11,PROGRAM SCHEDULE ERROR SPC 1 * ERROR MESSAGES FOR COMMAND (SEG 6) PHASE SPC 1 DEC 15 ASC 8,INVALID COMMAND DEC 32 ASC 16,SEQUENCE NUMBER OVERFLOW/OVERLAP DEC 19 ASC 10,BAD SEQUENCE NUMBER DEC 28 ASC 14,LU LOCKED OR NO RN AVAILABLE DEC 27 ASC 14,INVALID LOGICAL UNIT NUMBER DEC 14 ASC 7,INVALID LIMITS DEC 23 ASC 12,MORE THAN 4 BREAKPOINTS DEC 22 ASC 11,BREAKPOINT ALREADY SET DEC 16 ASC 8,NO CALLS DEFINED DEC 28 ASC 14,INCOMPATIBLE CSAVE'D PROGRAM DEC 19 ASC 10,CAN'T EDIT COMMANDS SKP * * ERROR MESSAGES FROM DISK FILE MANAGER-OR REIO WRITE-READ * FMESA DEF *+1 DEC 9 ASC 5,DISK DOWN DEC 14 N ASC 7,DUPLICATE NAME DEC 0 DEC 37 ASC 19,ILLEGAL READ OR WRITE TO LOGICAL UNIT DEC 37 ASC 19,READ OR WRITE TO A RECORD NOT WRITTEN DEC 44 ASC 22,FILE OR CARTRIDGE NOT FOUND OR NO DISC SPACE DEC 21 ASC 11,INVALID SECURITY CODE DEC 49 ASC 25,FILE CURRENTLY OPEN OR EXCLUSIVE OR LOCK REJECTED DEC 0 DEC 0 DEC 12 ASC 6,DCB NOT OPEN DEC 25 ASC 13,SOF OR EOF READ OR SENSED DEC 16 ASC 8,CARTRIDGE LOCKED DEC 14 ASC 7,DIRECTORY FULL DEC 12 ASC 6,ILLEGAL NAME DEC 24 ASC 12,ILLEGAL TYPE OR SIZE = 0 DEC 31 ASC 16,ILLEGAL READ OR WRITE ON TYPE 0 * SKP ***************************** * * * PRINT TABLE FOR OPERATORS * * * ***************************** QUOTE OCT 1000 BITS 15-9 OF THE LABELLED WORD ASC 1," COMA OCT 2000 ARE THE BASIC CODE OPERATOR ASC 1,, SMCLN OCT 3000 NUMBERS. BITS 3-0 ARE THE ASC 1,; RPARN OCT 4001 OPERATOR'S HIERARCHICAL ASC 1,) RBRAC OCT 5001 PRECEDENCE FOR THOSE OPERATORS ASC 1,] SCMMA OCT 6002 BELONGING TO FORMULAS. THE ASC 1,, ASSOP OCT 7002 UNLABELLED WORD GIVES THE ASC 1,= PLUS OCT 10007 ASCII REPRESENTATION OF THE ASC 1,+ MINUS OCT 11007 SINGLE CHARACTER OPERATORS. ASC 1,- TIMES OCT 12010 ASC 1,* DIV OCT 13010 ASC 1,/ EXPS OCT 14012 ASC 1,^ GTR OCT 15005 ASC 1,> LSS OCT 16005 ASC 1,< UNEQL OCT 17005 ASC 1,# EQUAL OCT 20005 ASC 1,= UNMIN OCT 21011 ASC 1,- LBRAC OCT 22020 ASC 1,[ LPARN OCT 23020 ASC 1,( UPLUS OCT 24011 ASC 1,+ OROP OCT 25003 MSFLG NOP ANDOP OCT 26004 NOTOP OCT 27011 NOP GTREQ OCT 30005 UFLAG NOP LSSEQ OCT 31005 SKP LET OCT 72003 BITS 1|B@<5-9 OF THE LABELLED WORD ASC 2,LET DIM OCT 71003 ARE THE BASIC CODE OPERATOR ASC 2,DIM COM OCT 34003 NUMBERS. BITS 2-0 ARE THE ASC 2,COM DEF OCT 35003 LENGTH IN CHARACTERS OF THE ASC 2,DEF REM OCT 36003 SYMBOL. THE ASCII VERSION OF ASC 2,REM GOTO OCT 37004 THE SYMBOL FOLLOWS. ASC 2,GOTO IF OCT 40002 ASC 1,IF FOR OCT 41003 ASC 2,FOR NEXT OCT 42004 ASC 2,NEXT GOSUB OCT 43005 ASC 3,GOSUB RTRN OCT 44006 ASC 3,RETURN END OCT 45003 ASC 2,END STP OCT 46004 ASC 2,STOP WAIT OCT 47004 ASC 2,WAIT CALL OCT 50004 ASC 2,CALL DATA OCT 51004 ASC 2,DATA IMAGE OCT 67005 ASC 3,IMAGE READ OCT 52004 ASC 2,READ PRNT OCT 53005 ASC 3,PRINT INPUT OCT 54005 ASC 3,INPUT RSTOR OCT 55007 ASC 4,RESTORE PAUSE OCT 56005 ASC 3,PAUSE FAIL: OCT 57005 ASC 3,FAIL: THEN OCT 60004 ASC 2,THEN USING OCT 61005 ASC 3,USING ASSNG OCT 62006 ASC 3,ASSIGN FILES OCT 63005 ASC 3,FILES CHAIN OCT 64005 ASC 3,CHAIN TRAP OCT 66004 ASC 2,TRAP INVK OCT 70006 ASC 3,INVOKE #SIGN OCT 73001 ASC 1,# TO OCT 75002 ASC 1,TO STEP OCT 76004 ASC 2,STEP OF OCT 77002 ASC 1,OF NOT OCT 27003 ASC 2,NOT AND OCT 26003 ASC 2,AND OR OCT 25002 ASC 1,OR GTE OCT 30002 ASC 1,>= LTE OCT 31002 ASC 1,<= AUNEQ OCT 17002 ALTERNATE UNEQUAL ASC 1,<> MIN OCT 32003 ASC 2,MIN MAX OCT 33003 ASC 2,MAX END BASC2 :BASMB,R,L,C HED <> 92101-19005 REV.1826 NAM BASC3,5 92101-16005 REV.1826 780411 * * * ************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1975. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * * PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ************************************************************** ENT BASC3,CKOVF EXT FNDPS,SGMNT,OUTER,SSYMT,TRAP,BCKSP,GETCR,DIGCK EXT WRITF,EXEC,$OPSY,CLOSE,OPEN,RDYPT,SPEC3,COMFL COM TEMPS(30),PNTRS(74),FILBF(16),FLDCB(144),SPEC(10) ********************************************** * * * SEGMENT #3: PRE-EXECUTION PROCESSING * * * ********************************************** * * THIS PART OF THE INTERPRETER IS LOADED BY THE BASIC MAIN CONTROL * ONCE TO PERFORM BASIC SYTEM INITIALIZATION AND ALSO * WHENEVER THE 'RUN' COMMAND IS GIVEN. IT WILL CONSTRUCT THE * SYMBOL TABLE, CHECK FOR-NEXT LOOPS AND DETERMINE ARRAY STORAGE * ALLOCATIONS FOR THE USER PROGRAM. UPON COMPLETION, IT RETURNS * TO THE MAIN CONTROL PROGRAM WHICH THENS LOADS THE EXECUTION * SEGMENT AND BRANCHES TO IT. SKP *************************** * * * CONSTANTS AND VARIABLES * * * *************************** * FWAM EQU PNTRS FIRST WORD OF AVAILABLE MEMORY LWBM EQU PNTRS+1 LAST WORD OF AVAILABLE MEMORY .INBF EQU PNTRS+2 INPUT BUFFER ADDRESS SBUFA EQU PNTRS+3 SYNTAX BUFFER ADDRESS SYMTA EQU PNTRS+4 START OF SYMBOL TABLE SYMTF EQU PNTRS+5 END OF SYMBOL TABLE PBUFF EQU PNTRS+6 FIRST WORD OF USER PROGRAM PBPTR EQU PNTRS+7 LAST WORD+1 OF USER PROGRAM INBFA EQU PNTRS+8 INPUT BUFFER POINTER ICCNT EQU PNTRS+9 INPUT CHARACTER COUNT SBPTR EQU PNTR&S+10 SYNTAX BUFFER POINTER .LNUM EQU PNTRS+11 CURRENT LINE # FCORE EQU PNTRS+12 START OF FREE CORE MNNAM EQU PNTRS+13 MNEMONIC TABLE NAME:SC:LU BRNAM EQU PNTRS+18 BRANCH TABLE NAME:SC:LU FWAMM EQU PNTRS+23 POINTER TO START OF MNEMONIC TABLE FWAMB EQU PNTRS+24 POINTER TO START OF BRANCH TABLE .OTBF EQU PNTRS+25 POINTER TO OUTPUT BUFFER OCCNT EQU PNTRS+26 OUTPUT CHARACTER COUNT OTBFA EQU PNTRS+27 POINTER INTO OUTPUT BUFFER LUOUT EQU PNTRS+28 CURRENT OUTPUT L.U. # LUINP EQU PNTRS+29 CURRENT INPUT L.U. # SIGN EQU PNTRS+30 SIGN OF CURRENT NUMBER BLANK EQU PNTRS+31 CURRENT TERMINATION CHAR REC# EQU PNTRS+32 COMMAND FILE RECORD NUMBER FLTYP EQU PNTRS+33 TYPE 0 FILE FLAG TTYPR EQU PNTRS+34 CONSOLE TTY L.U. # PRINT EQU PNTRS+35 LISTING L.U. # READR EQU PNTRS+36 AUXILLIARY INPUT L.U. # PUNCH EQU PNTRS+37 AUXILLIARY OUTPUT L.U. # ERTTY EQU PNTRS+38 ERROR LIST OUTPUT L.U. # DCB EQU PNTRS+39 DATA CONTROL BLOCK ADDRESS FILBK EQU PNTRS+40 FILE CONTROL BLOCK ADDRESS PFLAG EQU PNTRS+41 SAVE,LOAD FILE FLAG LOLIM EQU PNTRS+42 LOW LIMITS OF PROGRAM HILIM EQU PNTRS+43 HIGH LIMITS OF PROGRAM LORUN EQU PNTRS+44 LOW RUN LIMITS HIRUN EQU PNTRS+45 HIGH RUN LIMITS SLSTM EQU PNTRS+46 EXECUTE SLOW STMTS LOTRC EQU PNTRS+47 LOW TRACE LIMITS HITRC EQU PNTRS+48 HIGH TRACE LIMITS BRKP1 EQU PNTRS+49 BREAK POINT #1 BRKP2 EQU PNTRS+50 BREAK POINT #2 BRKP3 EQU PNTRS+51 BREAK POINT #3 BRKP4 EQU PNTRS+52 BREAK POINT #4 SMFLG EQU PNTRS+53 SIMULATE FLAG TYPE EQU PNTRS+54 PARTIAL LINE CHARACTER COUNT DLMTR EQU PNTRS+55 CHAR EDIT DELIMITER MERGF EQU PNTRS+56 MERGE FLAG COMN EQU PNTRS+57 COMMAND FILE NAME MANT1 EQU PNTRS+60 MANTISSA #1 MANT2 EQU PNTRS+61 MANTISSA #2 EXPNT EQU PNTRS+62 EXPONENT INLOC EQU PNTRS+63 INV. LOC. LU,STRK,#TKRS INTKZ EQU PNTRS+64 TRACK SIZE ON DISC FOR INV. HSTPT EQU PNTRS+65 HIGH-STACK POINTER TSTPT EQU PNTRS+66 TEMPORARY STACK POINTER LSTPT EQU PNTRS+67 LOW-STACK POINTER LSTAK EQU PNTRS+68 LOW-STACK ADDR9=ESS PRADD EQU PNTRS+69 PROGRAM EXECUTION DSTRT EQU PNTRS+70 DATA NXTDT EQU PNTRS+71 STATEMENT DCCNT EQU PNTRS+72 POINTERS NXTST EQU PNTRS+73 NEXT STMT NUMBER SKP TEMPT BSS 15 TEMPORARIES * ERBS DEF ERR-1 MBUF DEF TEMPS FILB DEF FILBF * SUP PRESS MULTIPLE LISTINGS SPC 1 .0 DEC 0 .1 DEC 1 .2 DEC 2 .3 DEC 3 .4 DEC 4 .5 DEC 5 .7 DEC 7 .8 DEC 8 .9 DEC 9 .10 DEC 10 .12 DEC 12 .13 DEC 13 .15 DEC 15 .16 DEC 16 .20 DEC 20 .26 DEC 26 .57 DEC 57 .28 DEC 28 .30 DEC 30 .32 DEC 32 .33 DEC 33 .34 DEC 34 .37 DEC 37 .43 DEC 43 .45 DEC 45 .63 DEC 63 .128 DEC 128 .144 DEC 144 .256 DEC 256 .9999 DEC 9999 CALOP OCT 50000 DATOP OCT 51000 RSTOP OCT 55000 B20 OCT 20 B54 OCT 54 B63 OCT 63 B65 OCT 65 B67 OCT 67 B72 OCT 72 B377 OCT 377 B400 OCT 400 B757 OCT 757 B1000 OCT 1000 B777 OCT 777 D72 OCT -72 HIMSK OCT 177400 SLASH OCT 57 STDIM OCT 5001 STANDARD DIMENSIONS FOR ARRAYS STRDM OCT 400 STANDARD DIMENSIONS FOR STRINGS PRNOP OCT 53000 COMOP OCT 34000 COMMON OPERATOR FILOP OCT 63000 OPMSK OCT 77000 DEFOP OCT 35000 STAR ASC 1,* ZERO ASC 1,0 M1 DEC -1 M2 DEC -2 M3 DEC -3 M4 DEC -4 M5 DEC -5 M8 DEC -8 M9 DEC -9 M16 DEC -16 M40 DEC -40 M99 DEC -99 M256 DEC -256 M400 DEC -400 M2000 DEC -2000 SIZE OF MNEMONIC TABLE SPACE MNEG OCT 100000 MAXIMUM NEGATIVE FLOATING OCT 376 POINT NUMBER SGTBA DEF SEG1 SEG1 ASC 3,BASC1 ASC 3,BASC2 ASC 3,BASC3 ASC 3,BASC4 ASC 3,BASC5 ASC 3,BASC6 ASC 3,BASC7 ASC 3,BASC8 * SKP **************************** * * * PRE-EXECUTION PROCESSING * * * **************************** BASC3 NOP * ***************************************************** * S * ** BASIC SYSTEM INITIALIZATION - ONCE ONLY CODE ** * * ***************************************************** * LDA PFLAG IS THIS AN CPA .9999 AN INITIALIZATION? RSS YES! JMP PREEX NO, DO PRE-EXECUTION * LDA $OPSY IS THIS CPA M9 AN RTE-IV SYSTEM? JMP RTE4 YES! SPC 1 * DEFINE COMPILER BUFFERS AND USER AREA SPC 1 CLB STB FWAM LDB 1777B ADDRESS OF LWAM DEFN ADB M40 SET STB .INBF INPUT BUFFER ADDRESS ADB M40 SET OUTPUT STB .OTBF BUFFER ADDRESS ADB M1 SET SYMBOL TABLE STB SYMTA ADDRESS ADB M99 SET SYNTAX STB SBUFA BUFFER ADDRESS ADB M1 SET LAST WORD STB LWBM BASIC AVAILABLE MEMORY CLB INITIALIZE STB SMFLG AND SIMULATE FLAG STB TYPE STB PBPTR STB PBUFF STB FWAMB * LDA .32 INITIALIZE STA BLANK DELETE CHARACTER FOR GETCR CLA SET LINE NUMBER TO STA .LNUM ZERO INITIALLY STA MNNAM AND CLEAR MNEM TBL FLAG STA LOTRC AND TRACE STA HITRC LIMITS STA SMFLG AND SIM FLAG STA BRKP1 CLEAR STA BRKP2 POSSIBLE STA BRKP3 PHONY STA BRKP4 BREAKPOINTS STA SLSTM CLEAR SLOW STMT FLAG CCA INITIALIZE STA FLTYP TYPE 0 FILE LDA SLASH INITIALIZE CHAR STA DLMTR EDIT DELIMTER SPC 1 * SET LOGICAL UNIT NUMBERS SPC 1 CLA,INA SET UP STA REC# RECORD NUMBER LDA TTYPR LOCAL TTY OUTPUT ADA D72 IS THERE A SSA,RSS COMMAND FILE? JMP RTESY YES, JUMP OVER LU SETTINGS LDA TTYPR SZA,RS#S L.U. # ENTERED? CLA,INA NO, SET TO #1 IOR B400 SET ECHO BIT STA TTYPR LDA ERTTY LOCAL TTY INPUT SZA,RSS L.U. # ENTERED? LDA TTYPR NO, SET TO LOCAL TTY STA ERTTY LDA PRINT LIST OUTPUT SZA,RSS L.U. # ENTERED? LDA TTYPR NO, SET TO CONSOLE L.U.# STA PRINT LDA READR AUXILLARY INPUT SZA,RSS L.U. # ENTERED? LDA .5 NO, SET TO #5 IOR B400 YES, ADD CONTROL BIT STA READR LDA PUNCH AUXILLARY OUTPUT SZA,RSS L.U. # ENTERED? LDA .4 NO, SET TO #4 STA PUNCH * RTESY LDA $OPSY RTE-IV? CPA M9 JMP SETBR YES, SKIP OVER ID SEG SEARCH SPC 1 LDA M8 SET UP STA TEMP1 SEGMENT COUNTER NXTSG CLA INITIALIZE KEYWORD PNTR STA TEMP2 TO START OF KEYWORD TABLE CKSEG LDA TEMP1 GET SEGMENT COUNT ADA .8 FORM POINTER MPY .3 TO SEGMENT'S ASCII ADA SGTBA NAME AND SAVE IT STA TEMP3 LDB 1657B GET START OF KEYWORD TABLE ADB TEMP2 FORM PTR TO I.D. ENTRY LDB 1,I GET ADDRESS OF I.D. ENTRY SZB,RSS END OF TABLE? JSB ERROR YES - ERROR - EXIT CERR4 ADB .12 FORM PNTR TO NAME(1) LDA 1,I GET NAME(1) CPA TEMP3,I SAME AS SEGMENT? ('BA'?) INB,RSS YES, MOVE PNTR TO NAME(2) JMP NXTEN NO, INDEX TO NEXT ENTRY LDA 1,I GET NAME(2) ISZ TEMP3 MOVE NAME POINTER CPA TEMP3,I SAME AS SEGMENT? ('SC'?) INB,RSS YES, MOVE PNTR TO NAME(3) JMP NXTEN NO, INDEX TO NEXT ENTRY LDA 1,I GET NAME(3) AND M256 ISOLATE UPPER CHAR IOR .32 MERGE IN ASCII BLANK ISZ TEMP3 MOVE NAME POINTER CPA TEMP3,I SAME AS SEGMENT? ('1,2,3,4,5,6,7,8'?) vJMP *+3 YES, GO CHECK ADDRESSES NXTEN ISZ TEMP2 MOVE PNTR TO NEXT I.D. ENTRY JMP CKSEG -GO CHECK I.D. ENTRY * LDA 1,I TEST FOR SHORT ID SEGMENT AND B20 ADB .2 SZA,RSS SHORT ID SEGMENT? ADB .7 NO! LDA 1,I GET ADDRESS OF LAST WORD INA INCREMENT TO GET NEW FWAM LDB FWAM GET CURRENT FWAM CMB,INB ADB 0 IS IT GREATER THAN SSB NEW FWAM? JMP *+4 NO! LDB FWAM SET MNEM TBL STB FWAMM TO NEXT TO LONGEST SEG STA FWAM SET NEW FWAM TO LONGEST SEG ISZ TEMP1 INDEX SEGMENT CNTR, IS IT = 0? JMP NXTSG NO, LOCATE NEXT SEGMENT * READY LDA FWAM STA PBUFF SET PROGRAM BUFFER ADDRESS STA PBPTR SET PROGRAM BUFFER POINTER STA FWAMB LDA TTYPR IS THERE ADA M400 A COMMAND SSA,RSS FILE? JMP COMFL YES JMP RDYPT NO, START UP BASIC SPC 1 SETBR LDA FWAM SET UPT ADA M2000 MNEMONIC TABLE POINTER STA FWAMM JMP READY * SKP * * RTE4 JSB EXEC GET DEF *+5 DEF .26 SIZE OF AVAILABLE MEMORY DEF FWAM DEF TEMP1 DEF TEMP2 LDB FWAM COMPUTE ADB TEMP1 LWAM ADB M1 BASKUP TO LAST WORD OF AVAIL MEMORY JMP DEFN INITIALIZE POINTERS PREEX JSB SPEC3 PRE-EXECUTION PROCESSING FOR SPEC SYNTAX SPC 1 JMP OUTER SPEC SYNTAX ERROR RETURN * BAS3 LDB FILB INITIALIZE STB FILBK FILE BLOCK PTR STB TEMP8 LDA PBUFF NULL CPA PBPTR PROGRAM? JMP RDYPT YES STA MPTR INITIALIZE PROGRAM POINTER LDA M16 INITIALIZE FILE STA TEMP3 BLOCK COUNTERS ADA M1 STA TEMP4 CLA INITIALIZE COMMON STA COML SIZE TO ZERO ʲ STA TEMP6 AND ALSO DCB SIZE LDA PFLAG CHAINED OR CPA .2 INVOKE? JMP MLO12 MLO12 YES, SKIP ZEROING OF FILE PTRS LDA TEMP6 STA 1,I INITIALIZE FILE INB BLOCK TO ISZ TEMP3 ALL ZEROS JMP *-3 * MLO12 LDB PBUFF START OF PROGRAM MLO10 CPB PBPTR ALL COMMON JMP MLO14 STMTS CHECKED? ADB .2 NO LDA 1,I GET NEXT STMT TYPE INB AND OPMSK CPA COMOP COMMON STMT? RSS YES! JMP MLO11 NO! LDA 1,I FETCH COMMON SIZE ADA COML AND UPDATE STA COML COMMON COUNTER MLO11 ADB M2 STATEMENT SIZE ADB 1,I CALCULATE ADDRESS ADB M1 OF NEXT STATEMENT JMP MLO10 SPC 1 MLO14 LDB PBUFF GET START OF PROG CPB PBPTR END OF PROG? JMP MLO15 YES ADB .2 NO, GET LDA 1,I THE STATEMENT AND OPMSK OP CODE CPA FILOP FILES STATEMENT? JSB FILES YES, ALLOCATE DCB FOR IT ADB M1 SET ADB 1,I (B) TO ADB M1 NEXT STATEMENT JMP MLO14+1 SPC 1 MLO15 STB FCORE SET FOR-TABLE POINTER LDA COML ANY COMMON ADA TEMP6 OR DCB'S INA JSB CKOVF IS BLOCK TOO BIG? CMA,INA ALLOCATE COMMON ADA LWBM NEXT TO DCB'S STA SYMTA SYM TBL END = COM START -1 STA SYMTF SYM TBL START(EMPTY) INA ADA TEMP6 OFFSET FOR DCB'S STA COML START OF COMMON SPC 1 MLOP1 LDB MPTR,I STB .LNUM SET LINE NUMBER LDB MPTR ISZ MPTR ADB MPTR,I COMPUTE LOCATION OF NEXT STB MNPTR STATEMENT AND STORE THIS ISZ MPTR LDA MPTR,I FETCH THE FIRST WORD IN THE ARS STATEMENT AND SAVE ALF,ALF THE STATEMENT TYPE AND .63 STA TYP CPA .30 NO, REM STATEMENT? STB MPTR YES, SET TO SKIP IT CPA .28 COMMON? ISZ MPTR YES, SKIP CPA .28 OVER ISZ MPTR SIZE CPA B63 NO, FILES STATEMENT? STB MPTR YES, SET TO SKIP IT! CPA .43 NO, PRINT STATEMENT? STB MPTR YES, SET TO SKIP IT CPA B65 SPECIAL SYNTAX? STB MPTR YES, SET TO SKIP CPA B67 IMAGE STATEMENT? STB MPTR SET TO SKIP IT CCA NO, SET STA MWDNO 'FIRST VARIABLE' JMP MLOP2+1 FLAG * MLO13 AND B777 YES, ISOLATE OPERAND LDB MPTR CPA B757 IS THIS A USER DEFINED FUNCTION? JMP *+4 YES, SO INCREMENT PAST CALL#-PARAMETER COUNT * INDEX THE PROGRAM POINTER BY SZA,RSS AN AMOUNT APPROPRIATE TO THE ADB .2 OPERAND. THE FOLLOWING APPLIES CPA .3 OPERAND = 0 ADD 2 TO POINTER INB OPERAND =3 ADD 1 TO POINTER STB MPTR * SKP * PROCESS OPERAND SPC 1 MLOP2 ISZ MPTR INCREMENT WORD-OF-STATEMENT PTR LDA MPTR STATEMENT CPA MNPTR EXHAUSTED? JMP MLOP5 YES LDA MPTR,I NO AND OPMSK 'QUOTE' CPA B1000 OPERATOR? JMP MLP4A YES, SET TO SKIP CPA CALOP CALL OPERATOR? JMP MLOP2 YES! SKIP LDA MPTR,I NO SSA 'CONSTANT' OPERAND? JMP MLO13 YES AND B777 NO SZA,RSS NULL OPERAND? JMP MLOP2 YES STA MBOX1 NO, SAVE IT AND .15 PROGRAMMER-DEFINED CPA .15 FUNCTION? JMP MLOP6 YES ADA M4 NO SSA ARRAY VARIABLE? JMP MLOP7 YES SPC 1 * PROCESS SIMPLE VARIABLE SPC 1 LDA MBOX1 NO, SIMPLE VARIABLE JSB SSYMT ALREADY IN SSB,RSS SYMBOL TABLE? JMP MLOP3 YES LDA MNEG NO LDB MNEG+1 ENTER STA MBOX1+1 IT WITH STB MBOX1+2 'UNDEFINED' LDA M3 VALUE JSB ESYMT MLOP3 LDB TYP LDA MBOX1 CPB .34 NEXT STATEMENT? JMP MLOP4 YES SPC 1 * PROCESS 'FOR' STATEMENT SPC 1 CPB .33 NO, FOR STATEMENT? ISZ MWDNO YES, FIRST VARIABLE? JMP MLOP2 NO ISZ FCORE DEMAND LDB FCORE SPACE CPB SYMTF FOR NEW JMP MER8-1 ENTRY STA FCORE,I SAVE VARIABLE NAME JMP MLOP2 SPC 1 * PROCESS 'NEXT' STATEMENT SPC 1 MLOP4 LDB FCORE FOR-TABLE CPB PBPTR EMPTY? JSB ERROR YES MER3 CPA FCORE,I NO, MATCH LATEST ENTRY? RSS YES JMP MER3-1 NO ADB M1 REMOVE STB FCORE MATCHED JMP MLOP2 ENTRY SPC 1 SPC 1 * PROCESS 'END' STATEMENT SPC 1 MLP4A XOR MPTR,I SET POINTER TO ADA .3 CLOSING ARS QUOTES ADA MPTR STA MPTR JMP MLOP2+1 SPC 1 MLOP5 CPA PBPTR PROGRAM EXHAUSTED? RSS YES JMP MLOP1 NO LDA TYP YES CPA .37 END STATEMENT? JMP M1LOP YES JSB ERROR NO SPC 1 * PROCESS 'DEF' STATEMENT SPC 1 MLOP6 LDA MPTR,I ISOLATE AND OPMSK PRECEDING OPERATOR CPA DEFOP 'DEF' ? RSS YES JMP MLOP2 NO GO TO PROCESS NEXT WORD LDA MBOX1 SEARCH SYMBOL TABLE FOR JSB SSYMT THE FUNCTION SSB,RSS JSB ERROR FOUND. ERROR MULTIPLY DEFINED MER4 LDA MPTR ADA .3 ENTER THE FUNCTION INTO THE STA MBOX1+1 SYMBOL TABLE TOGETHER WITH LDA M2 ITS ENTRY POINT IN THE SOURCE JSB ESYMT CODE JMP MLOP2 GO TO PROCESS THE NEXT WOTRD SPC 1 * PROCESS ARRAY VARIABLE SPC 1 MLOP7 CPA M4 IF STRING VARIABLE INA FORCE TO SINGLE DIMENSION STA 1 (B)=ARRAY TYPE LDA TYP CPA .57 DIM STATEMENT? JMP MLOP8 YES CPA .28 NO, COM STATEMENT? JMP MLOP8 YES JSB MSYMT NO, LOOK FOR IT IN SYMBOL TABLE JMP MLOP2 FOUND CLA NOT THERE STA MBOX1+1 ENTER IT WITH STA MBOX1+2 DIMENSIONS AND STA MBOX1+3 DIMENSIONALITY JMP MLOP0 UNDEFINED SPC 1 * PROCESS 'COM' AND 'DIM' STATEMENT SPC 1 MLOP8 ISZ MPTR PROCESS COM OR DIM STMT ISZ MPTR LDA MPTR,I PICK UP FIRST DIMENSION ALF,ALF SHIFT TO M. S. PART OF WORD CPB M3 IS THIS A SINGLE DIMENSION ARRAY JMP *+5 YES, JUMP ISZ MPTR NO, INDEX POINTER TO THE LOC. ISZ MPTR OF SECOND DIMENSION AND PACK IOR MPTR,I INTO A WITH THE FIRST DIMENSION RSS IOR .1 STA MBOX1+2 SET UP TO STORE PACKED STA MBOX1+3 DIMENSIONS IN FORMAL AND ACTUAL CLA SLOTS AND UNDEFINED FLAG IN STA MBOX1+1 STORAGE ALLOCATION SLOT SPC 1 JSB MSYMT IN SYMBOL TABLE? JMP MLOP9 NO LDA TYP YES CPA .28 RSS IS STMT A COM JMP MLOP0 NO, JUMP LDA MBOX1+2 YES PICK UP PACKED DIMENSIONS JSB MDIM COMPUTE STORAGE REQUIRED SWP LDA MBOX1 IS IT A AND .15 STRING SZA,RSS VARIABLE? JMP STRM1 YES! LDA COML POINTER TO NEXT FREE LOC IN COM STRM2 STA MBOX1+1 STORE IN STORAGE ALLOCATION SLOT ADA 1 UPDATE POINTER BY THE AMOUNT OF STA COML STORAGE ASSIGNED. MLOP0 LDA M4 ENTER THE FOUR WORD ENTRY JSB ESYMT PREVIOUSLY SET UP IN MBOX1 INTO JMP MLOP2 SYMBOL TABLE AND CONTINUE SKP * STRM1 BRy#B@ ? JMP RENS5 YES CPA GOTOP NO, ? JMP RENS3 YES CPA GOSOP NO, ? JMP RENS3 YES CPA FALOP NO, ? JMP RENS3 YES CPA CALOP NO, ? RSS YES CPA TRPOP NO, ? RSS YES! CPA IFOP NO, ? RSS YES! CPA PRTOP NO, ? RSS JMP RENS2-1 LDA RENAD,I GET PAST 'IF' OPERATOR RENS3 IOR INTFL CREATE REFERNCE HEADER STB RENQ SET POINTER TO NEXT STMT ADB M1 SET PTR TO RENS4 STB RENP PROSPECTIVE HEADER? ADB M1 CPB RENR END OF STATEMENT? JMP RENS6 YES! RENS8 CPA 1,I PRECEDED BY REFERENCE HEADER? JMP RENS7 YES ISZ RENAD GOTO NEXT OPERATOR LDA RENAD,I PAST 'IF' IOR INTFL ISZ RENCT DONE? JMP RENS8 NO! LDA PSTIF STA RENAD LDA M5 STA RENCT LDA OFOP YES, LOAD HEADER FOR CPA 1,I JMP RENS1 LDA USEOP ? CPA 1,I JMP RENS1 JMP RENS4 REFERENCE LIST RENS5 CPA RENQ,I ANY REFERENCE? JMP RENS2-1 NO JMP RENS3 YES RENS6 LDB RENQ 'THEN','GOTO', OR 'GOSUB' JMP RENS2 NOT FOUND * RENS7 CPA USEOP ? STA USFLG "SET 'PRINT USING' FLAG SO AS TO SKIP OVER REST OF STMT JMP RENS1 NO! * RENS0 NOP LDA RENP,I GET STMT NUMBER JSB FNDPS FIND ADDRESS NOP JMP NOSTM NO SUCH STATEMENT NUMBER! STB RENP,I STUFF IN ADDRESS JMP RENS0,I * NOSTM LDA RENR,I SET STA .LNUM LINE NUMBER FOR ERROR JSB ERROR PRINT NO SUCH LINE NUMBER ERROR MESS MER11 EQU * * * INTFL OCT 100003 RENCT DEC -3 RENAD DEF THNOP RENP BSS 1 RENQ BSS 1 RENR BSS 1 USFLG NOP COMMA OCT 102003 PSTIF DEF *+1 THESE THNOP OCT 60000 SIX GOTOP OCT 37000 ITEMS MUST GOSOP OCT 43000 RESOP OCT 55000 BE CONTIGUOUS PRTOP OCT 53000 IFOP OCT 40000 OFOP OCT 177003 TRPOP OCT 66000 USEOP OCT 161003 FALOP OCT 57000 SKP *********************** * * * PRINT ERROR MESSAGE * * * *********************** ERROR NOP LDB ERROR ERROR SOURCE IN (B) LDA ERBS ERROR ADDRESS IN (A) INA MOVE TO NEXT ERROR CPB 0,I SAME AS ACTUAL ERROR? CMA,INA,RSS YES, MAKE ERROR NEGATIVE JMP *-3 NO ADA ERBS MAKE ERROR POSITIVE CMA,INA ADA .34 ADJUST FOR SEG 1 ERRORS STA TEMP3 SAVE IT JMP OUTER PRINT ERROR MESSAGE *************** * * * ERROR TABLE * * * *************** ERR DEF MER5A COM STATEMENT OUT OF ORDER DEF MER4 FUNCTION DEFINED TWICE DEF MER6 UNMATCHED FOR DEF MER3 NEXT WITHOUT MATCHING FOR DEF MSYM DIMENSIONS NOT COMPATIBLE DEF MLOP6 LAST STATEMENT NOT 'END' DEF MER5 VARIABLE DIMENSIONED TWICE DEF MER10 ARRAY OF UNKNOWN DIMENSIONS DEF MER9 ARRAY TOO LARGE DEF MER7 OUT OF STORAGE DEF MER1 TOO MANY FILES DEF MER2 BAD FILES STATEMENT DEF MER8 SYMBOL TABLE OVE'HFBRFLOW DEF CERR1 INVALID SECURITY CODE DEF CERR2 INVALID LU DEF CERR3 INVALID FILE NAME DEF CERR4 MISSING SEGMENTS DEF MER11 NO SUCH STATEMENT SKP MBOX1 EQU TEMPS MBIN1 EQU TEMPT+1 MBIN2 EQU TEMPT+2 MNPTR EQU TEMPT+3 TYP EQU TEMPT+4 NAME EQU TEMPT+5 SC EQU TEMPT+8 LU EQU TEMPT+9 COML EQU TEMPT+10 MWDNO EQU TEMPT+11 MPTR EQU SBPTR FERR EQU TEMPS+1 TEMP1 EQU TEMPS+2 TEMP2 EQU TEMPS+3 TEMP3 EQU TEMPS+4 TEMP4 EQU TEMPS+5 TEMP5 EQU TEMPS+6 TEMP6 EQU TEMPS+7 TEMP7 EQU TEMPS+8 TEMP8 EQU TEMPS+9 TEMP9 EQU TEMPS+10 TEM10 EQU TEMPS+11 * END BASC3 %HASMB,R HED <> 92101-19005 REV. 1826 NAM BASC4,5,99 92101-16005 REV.1826 780519 * * * ENT BASC4,ETAB,ETYP,ERND,ESGN,ESWR,XERR,SERR,OCT,TIM EXT IFBRK,FINDV,BCKSP,WRITE,DRQST,GETCR,MVTOH,OUTER EXT IFBRK,ENOUT,NUMCK,OUTCR,..FCM,.IENT EXT OUTLN,OUTIN,TRAP,FCNEX,WDRQS,WRITF,READF EXT FCONT,POST,PRNIN,SSYMT,FNDPS,.PACK,COMND EXT EXP,ALOG,RMPAR,SPEC4,SGMNT,MBY10,DBY10 EXT EXEC,OLNCK,DIGCK,.FLUN,GETDG EXT .FAD,.FSB,.FMP,.FDV,IFIX,FLOAT * COM TEMPS(30),PNTRS(74),FILBF(16),FLDCB(144),SPEC(10) ***************************************** * * * SEGMENT #4: EXECUTE THE PROGRAM * * * ***************************************** * * THIS PART OF THE INTERPRETER IS LOADED BY THE BASIC MAIN CONTROL * AFTER THE SUCCESSFUL COMPLETION OF THE PRE-EXECUTION PROCESSING * SEGMENT. IT WILL EXECUTE THE USER PROGRAM, LINE BY LINE, BY * EXAMINING THE TRANSLITERATED CODE AND BRANCHING TO THE VARIOUS * EXECUTION SUBROUTINES. UPON COMPLETION, IT RETURNS EXECUTION TO * THE MAIN CONTROL PROGRAM. SKP *************************** * * * CONSTANTS AND VARIABLES * * * *************************** * FWAM EQU PNTRS FIRST WORD OF AVAILABLE MEMORY LWBM EQU PNTRS+1 LAST WORD OF AVAILABLE MEMORY .INBF EQU PNTRS+2 INPUT BUFFER ADDRESS SBUFA EQU PNTRS+3 SYNTAX BUFFER ADDRESS SYMTA EQU PNTRS+4 START OF SYMBOL TABLE SYMTF EQU PNTRS+5 END OF SYMBOL TABLE PBUFF EQU PNTRS+6 FIRST WORD OF USER PROGRAM PBPTR EQU PNTRS+7 LAST WORD+1 OF USER PROGRAM INBFA EQU PNTRS+8 INPUT BUFFER POINTER ICCNT EQU PNTRS+9 INPUT CHARACTER COUNT SBPTR EQU PNTRS+10 SYNTAX BUFFER POINTER .LNUM EQU PNTRS+11 CURRENT LINE # FCORE EQU PNTRS+12 START OF FREE CORE MNNAM EQU PNTRS+13 MNEMONIC TABLE NAME:SC:LU BRNAM EQU PNTRS+18 BRANCH TABLE NAME:SC:LU FWAMM EQU PNTRS+23 POINTER TO START OF MNEMONIC TABLE FWAMB EQU PNTRS+24 POINTER TO START OF BRANCH TABLE .OTBF EQU PNTRS+25 POINTER TO OUTPUT BUFFER OCCNT EQU PNTRS+26 OUTPUT CHARACTER COUNT OTBFA EQU PNTRS+27 POINTER INTO OUTPUT BUFFER LUOUT EQU PNTRS+28 CURRENT OUTPUT L.U. # LUINP EQU PNTRS+29 CURRENT INPUT L.U. # SIGN EQU PNTRS+30 SIGN OF CURRENT NUMBER BLANK EQU PNTRS+31 CURRENT TERMINATION CHAR REC# EQU PNTRS+32 COMMAND FILE RECORD NUMBER FLTYP EQU PNTRS+33 TYPE 0 FILE FLAG TTYPR EQU PNTRS+34 CONSOLE TTY L.U. # PRINT EQU PNTRS+35 LISTING L.U. # READR EQU PNTRS+36 AUXILLIARY INPUT L.U. # PUNCH EQU PNTRS+37 AUXILLIARY OUTPUT L.U. # ERTTY EQU PNTRS+38 ERROR LIST OUTPUT L.U. # DCB EQU PNTRS+39 DATA CONTROL BLOCK ADDRESS FILBK EQU PNTRS+40 FILE CONTROL BLOCK ADDRESS PFLAG EQU PNTRS+41 SAVE,LOAD FILE FLAG LOLIM EQU PNTRS+42 LOW LIMITS OF PROGRAM HILIM EQU PNTRS+43 HIGH LIMITS OF PROGRAM LORUN EQU PNTRS+44 LOW RUN LIMITS HIRUN EQU PNTRS+45 HIGH RUN LIMITS SLSTM EQU PNTRS+46 EXECUTE SLOW STMTS LOTRC EQU PNTRS+47 LOW TRACE LIMITS HITRC EQU PNTRS+48 HIGH TRACE LIMITS BRKP1 EQU PNTRS+49 BREAK POINT #1 BRKP2 EQU PNTRS+50 BREAK POINT #2 BRKP3 EQU PNTRS+51 BREAK POINT #3 BRKP4 EQU PNTRS+52 BREAK POINT #4 SMFLG EQU PNTRS+53 SIMULATE FLAG TYPE EQU PNTRS+54 PARTIAL LINE CHARACTER COUNT DLMTR EQU PNTRS+55 CHAR EDIT DELIMITER MERGF EQU PNTRS+56 MERGE FLAG COMN EQU PNTRS+57 COMMAND FILE NAME MANT1 EQU PNTRS+60 MANTISSA #1 MANT2 EQU PNTRS+61 MANTISSA #2 EXPNT EQU PNTRS+62 EXPONENT INLOC EQU PNTRS+63 INV. LOC. LU,STRK,#TKRS INTKZ EQU PNTRS+64 TRACK SIZE ON DISC FOR INV. HSTPT EQU PNTRS+65 HIGH-STACK POINTER TSTPT EQU PNTRS+66 TEMPORARY STACK POINTER LSTPT EQU PNTRS+67 LOW-STACK POINTER LSTAK EQU PNTRS+68 LOW-STACK ADDRESS PRADD EQU PNTRS+69 PROGRAM EXECUTION DSTRT EQU PNTRS+70 DATA NXTDT EQU PNTRS+71 STATEMENT DCCNT EQU PNTRS+72 POINTERS NXTST EQU PNTRS+73 NEXT STMT NUMBER SKP SPC 1 SUP PRESS MULTIPLES LISTING SPC 1 XH BSS 1 XL BSS 1 TT1 BSS 1 TT2 BSS 1 TT3 BSS 1 TT4 BSS 1 EOL BSS 1 TAB END-OF-LINE FLAG STRFG BSS 1 STRING CONSTANT FLAG * FOPBS DEF QUOTE-1 ARBAS DEF AROTB-6,I XECBR DEF XECTB-28,I ADATA DEF DATA ERBS DEF ERR-1 FINCA DEF FINCH ADDRESS OF FETCH INPUT ROUTINE FSCHA DEF FSCH ADDRESS OF FETCH SOURCE CHAR ROUTINE * TRMSA DEF *+1 TRACE ASC 4,*TRACE LNBFF BSS 2 MESSAGE LNBFA DEF LNBFF-1 SKP .0 DEC 0 .1 DEC 1 .2 DEC 2 .3 DEC 3 .4 DEC 4 .5 DEC 5 .6 DEC 6 .7 DEC 7 .8 DEC 8 .9 DEC 9 .10 DEC 10 .11 DEC 11 .12 DEC 12 .13 DEC 13 .14 DEC 14 .15 DEC 15 .16 DEC 16 .20 DEC 20 .21 DEC 21 .23 DEC 23 .31 DEC 31 .32 DEC 32 .43 DEC 43 .45 DEC 45 .48 DEC 48 .52 DEC 52 .64 DEC 64 .74 DEC 74 .80 DEC 80 .128 DEC 128 .132 DEC 132 .144 DEC 144 LFTAR OCT 137 CTRLQ OCT 21 B40 EQU .32 B42 OCT 42 B77 OCT 77 B177 OCT 177 B376 OCT 376 B377 OCT 377 B400 OCT 400 B777 OCT 777 B1000 OCT 1000 B2000 OCT 2000 RSS OCT 2001 B3000 OCT 3000 B4000 OCT 4000 SCCNT OCT 3002 LBOP OCT 22000 BIT13 OCT 20000 LFPAR OCT 122000 DATA OCT 51004 DATOP OCT 51000 IMGOP OCT 67000 USEOP OCT 61000 PRTOP OCT 53000 ENDOP OCT 45000 #OP OCT 17000 SPLOP OCT 65000 OPMSK OCT 77000 ATMSK OCT 10000 INF OCT 77777 INTFL OCT 100003 FRMSK OCT 100757 OPDMK OCT 100777 WRFLG OCT 100001 DSERR OCT 140000 M1 DEC -1 M2 DEC -2 M3 DEC -3 M4 DEC -4 M5 DEC -5 M6 DEC -6 M7 DEC -7 M12 DEC -12 M15 DEC -15 M17 DEC -17 M20 DEC -20 M21 DEC -21 D33 OCT -33 M73 DEC -73 M80 DEC -80 M81 DEC -81 M256 DEC -256 M280 DEC -280 M1000 DEC -1000 HALF OCT 40000 OCT 0 HONE EQU HALF MNEG OCT 100000 MAXIMUM NEGATIVE FLOATING OCT 376 POINT NUMBER FLGBT EQ-JU MNEG BIT15 EQU MNEG AFCNX DEF FCNEX SKP *************************** * * * EXECUTION BRANCH TABLES * * * *************************** * * THE EXECUTION BRANCH TABLES ARE THE BASIS FOR EXECUTING A BASIC * USER PROGRAM. FOR EACH OPERATOR IN BASIC THERE IS A UNIQUE CODE * NUMBER. THIS CODE NUMBER, WHEN ADDED TO A REFERENCE ADDRESS, , * FORMS A POINTER TO ONE OF THE ADDRESSES IN THESE BRANCH TABLES. * THE ADDRESS WHICH IS POINTED TO IN THE TABLE, IS THE ADDRESS OF * THE CORRESPONDING EXECUTION SUBROUTINE. * XECTB DEF XEC4 COM DEF XEC4 DEF DEF XEC4 REM DEF EGOTO GO TO DEF EIF IF DEF EFOR FOR DEF ENEXT NEXT DEF EGOSB GOSUB DEF ERTRN RETURN DEF EEND END DEF EEND STOP DEF EWAIT WAIT DEF ECALL CALL DEF XEC4 DATA DEF EREAD READ DEF EPRIN PRINT DEF EINPT INPUT DEF ERSTR RESTORE DEF EPAZ PAUSE DEF XEC4 FAIL DEF EGOTO THEN DEF XEC4 USING DEF EASSN ASSIGN DEF XEC4 FILES DEF ECHAN CHAIN DEF 0 SPECIAL SYNTAX DEF ETRAP TRAP DEF XEC4 IMAGE DEF EINVK INVOKE DEF XEC4 DIM DEF ELET LET * SKP DEF FORMX,I EXIT ON EMPTY STACK BSS 5 DUMMY ADDRESSES AROTB DEF ESCMA SUBSCRIPT SEPARATOR DEF ESTR ASSIGNMENT OPERATOR DEF EFAD '+' DEF EFSB '-' DEF EFMP '*' DEF EFDV '/' DEF EPWR '^' DEF EGTRT '>' DEF ELST '<' DEF ENEQL '#' DEF EEQL '=' DEF EUMIN UNARY '-' DEF ELBRC '[' DEF FORM1 '(' DEF FOR11 UNARY '+' DEF EOR OR DEF EAND AND DEF ENdIOT NOT DEF EGORE '>=' DEF ELORE '<=' DEF EMIN 'MIN' DEF EMAX 'MAX' * SKP ***************************** * * * OPERATOR PRECEDENCE TABLE * * * ***************************** * * THIS TABLE IS USED BY THE FORMULA EVALUATION SUBROUTINE TO * DETERMINE THE HIERARCHICAL PRECEDENCE OF THE FORMULA-TYPE * OPERATORS. BITS 15-9 OF THE LABELLED WORD ARE THE BASIC * CODE OPERATOR AND BITS 3-0 ARE THE PRECEDENCE FOR THE * OPERATOR. QUOTE OCT 1000 COMMA OCT 2000 SEMIC OCT 3000 * RPARN OCT 4001 RBRAC OCT 5001 SCMMA OCT 6002 ASSOP OCT 7002 PLUS OCT 10007 MINUS OCT 11007 TIMES OCT 12010 DIV OCT 13010 EXPS OCT 14012 GTR OCT 15005 LSS OCT 16005 UNEQL OCT 17005 EQUAL OCT 20005 UNMIN OCT 21011 LBRAC OCT 22020 LPARN OCT 23020 UPLUS OCT 24011 OROP OCT 25003 ANDOP OCT 26004 NOTOP OCT 27011 GTREQ OCT 30005 LSSEQ OCT 31005 MINOP OCT 32006 MAXOP OCT 33006 * SKP *********************** * * * EXECUTE THE PROGRAM * * * *********************** BASC4 NOP LDA EXFUN SAVE 'JSB FUNCT' INSTRUCTION STA FINST CPB M1 (B)=-1 IF TRAP TABLE IS BUSY RSS YES ITS BUSY SO DONT ALLOW TRAP POLING JMP BASX NO, OK TO USE IT LDA RSS STORE RSS IN 'JSB TRAP' STA TRAPX STA ETRAP BASX LDA SLSTM RETURN CPA M1 RETURN FROM BRKPNT? JMP XEC5 YES! CPA M2 RETURN FROM SIM? JMP XEC6 YES! SZA FROM SEGMENT 8? JMP XEC4 YES, CONTINUE WITH NEXT STMT * * LDA FWAM SET FOR RANDOM NUMBER GENERATOR STA XH INITIALIZE INA RANDOM STA XL VARIABLE SPC 1 * INITIALIZE THE DATA POINTER SPC 1 CCA SET STA DCCNT 'NO STA DSTRT  DATA' LDB PBUFF CONDITION STB NXTDT LDA ADATA,I SEARCH FOR FIRST JSB STSRH DATA STATEMENT JMP XEC2 NONE FOUND STB DSTRT SAVE STATEMENT LOCATION JSB SETDP SET DATA POINTER SPC 1 * INITIALIZE STACK POINTERS SPC 1 XEC2 JSB SETPT INITIALIZE PTRS LDA LORUN FIRST STMNT CPA .1 OF PROGRAM? JMP XEC3 YES! JSB FNDPS NO, FIND IT NOP JMP XEC6 CAN'T FIND IT * XEC3 EQU * GET FIRST STATEMENT NUMBER LDA 1 STA NXTST AND SET UP FOR STB TEMP1 TRACE AND BREAK JMP XEC6 * XEC43 LDB 0 JMP XEC6+1 SKP * FIND NEXT STATEMENT TO BE EXECUTED SPC 1 XEC4 LDA TTYPR RESTORE STA LUINP CONSOLE STA LUOUT LOGICAL UNITS LDA FCORE SET TEMPORARY STA TSTPT STACK POINTER LDA NXTST SZA,RSS END OF PROGRAM? JMP EEND YES * XEC6 LDB NXTST GET NEW LINE NUMBER STB TEMP1 XEC5 LDA TEMP1 JSB TRACE LDA TTYPR RESTORE STA LUOUT CONSOLE STA LUINP LOGICAL UNITS * JSB IFBRK BREAK DEF *+1 SZA FLAG SET? JMP OPEND YES, STOP THE PRESSES! LDB TEMP1 RESTORE B WITH ADDR OF NEXT STATEMENT LDA M1000 STA FILE# SET FOR NON-FILE I/O TRAPX JSB TRAP CHECK FOR INTERRUPT JMP TRERR ERROR RETURN SSA,RSS JMP EGOS4 INTERRUPT, DO GOSUB JSB FLWST SETSX LDA TEMPS,I AND OPMSK EXTRACT STATEMENT TYPE CPA SPLOP SPECIAL SYNTAX? RSS YES JMP CONT NO, SKIP THIS JSB SPEC4 EXECUTE SPECIAL SYNTAX JMP XEC4 EXECUTE NEXT INSTRUCTION JMP OUTER ERROR PROCESSING CONT ALF,ALF POSITION RAR IT ADA XECBR COMPUTE EXECUTAION ADDRESS JMP 0,I BRANCH TO EXECUTION CODE SKP ***************** * * ** EXECUTE LET ** * * ***************** * * ELET CLA,INA ENABLE FOR STRING CONSTANT STA STRFG IN FORMULA JSB FORMX JMP XEC4 * * ******************* * * ** EXECUTE FOR ** * * ******************* * EFOR JSB FVSRH FOR-VARIABLE ALREADY IN STACK? JMP EFOR1 NO STA TEMP2 YES, SAVE SOURCE ADDRESS ADA .6 SAVE STA TEMP4 DESTINATION ADDRESS STB TEMP1 SAVE FOR-VARIABLE ADDRESS JSB MVTOH COMPRESS STACK LDB TEMP1 RESTORE FOR-VARIABLE ADDRESS CLA,RSS COMPUTE NEW EFOR1 LDA M6 TOP OF ADA HSTPT FOR-STACK STA HSTPT POINTER STA TEMP1 CMA,INA STACK ADA LSTPT SSA,RSS OVERFLOW? JMP E1 YES. ERROR 57. STB TEMP1,I NO, RECORD FOR-VARIABLE ADDRESS JSB FORMX INITIALIZE FOR-VARIABLE ISZ TEMPS ISZ TEMP1 SAVE LDA TEMP1 LIMIT STA ENEX2+1 ADDRESS JSB FETCH FETCH STA TEMP1,I AND ISZ TEMP1 STORE STB TEMP1,I LIMIT ISZ TEMP1 LDB M2 SET FOR STEP SIZE STB FDATA SIGN CHECK LDA TEMPS,I LOOK FOR SZA FOLLOWING ' STEP' JMP EFOR2 FOUND LDA HONE NOT FOUND, CMB,INB,RSS DEFAULT IS 1.0 EFOR2 JSB FETCH SSA STEP SIZE NEGATIVE? ISZ FDATA YES STA TEMP1,I SAVE ISZ TEMP1 STEP STB TEMP1,I SIZE ISZ TEMP1 SET POINTER LDA NXTST TO STATEMENT STA TEMP1,I FOLLOWING THE FOR EFOR3 LDA NEXTX FIND LDB PRADD 'NEXT' JSB STSRH STATEMENT NOP JSB FLWST FIND FOLLOWING STATEMENT AND B777 SAME CPA ETAB FOR-VARIABLE? RSS YES JMP EFOR3 NO LDB HSTPT,I LOAD DLD 1,I LOAD VALUE OF FOR VARIABLE JMP ENEX2-2 CHECK ACCEPTABILITY * * NEXTX OCT 42004 * ** EXECUTE NEXT ** * ENEXT JSB FVSRH FIND CORRESPONDING STACK ENTRY JMP XEC4 NONE PRESENT STA HSTPT RESET TOP OF STACK STB ENEX1+1 SAVE FOR-VARIABLE ADDRESS INA SAVE LIMIT STA ENEX2+1 ADDRESS ADA .2 SAVE STEP SIZE STA TEMP1 ADDRESS LDB M2 SET STEP SIZE STB FDATA SIGN CHECK LDA TEMP1,I LOAD ISZ TEMP1 STEP LDB TEMP1,I SIZE ISZ TEMP1 SSA CHECK ISZ FDATA SIGN ENEX1 JSB .FAD INCREMENT FOR-VARIABLE NOP DST ENEX1+1,I AND SAVE VALUE STA EFMT STB NFMT ENEX2 JSB .FSB COMPUTE FOR-VARIABLE - LIMIT NOP ISZ FDATA POSITIVE STEP SIZE? ELA YES, COMPLEMENT SIGN SSA NO, NON-NEGATIVE RESULT? JMP ENEX3 NO LDA TEMP1,I YES, GO TO FIRST STA NXTST JMP XEC4 STATEMENT OF LOOP * ENEX3 LDA HSTPT FAILS, ADA .6 ERASE STA HSTPT STACK ENTRY JMP XEC4 SKP ***************** * * * EXECUTE PRINT * * * ***************** EPRIN LDA HSTPT SAVE HI STK PTR IN CASE STA HTEMP OF END-OF-FILE EXIT STA BFFLG INIT.FLAG FOR KEEPING TRACK OF OUTPUT CHARACTERS JSB VLFIL VALIDATE FILE REFERENCE JMP EPR01 LU OUTPUT JMP EOFCK FILE OUTPUT EOF LDB DCB FILE OUTPUT, POSITION OK ADB .7 NOW CHECK LDA 1,I IF SECURITY CODES SSA,RSS AGREE OR NOT JMP EPR00 MISMATCH, DECLARE ERROR & QUIT ADB .6 LDA 1,I SET IOR .1  WRITTEN STA 1,I ON ADB M1 BIT LDB 1,I FETCH WORD POINTER LDA DCB IS THE ADA .144 DATA CONTROL CPA 1 BLOCK FULL? JMP EPR02 YES! LDA M2 NO, TERMINATE RECORD STA 1,I WITH EOR MARK JMP EPR02 BEGIN LIST PROCESSING * EPR01 CLA,INA FLAG AS 'PRINT' JSB EPRUS CHECK FOR USING CLA FLAG AS STA FFLG NON-FORMATTED JSB PRNIN INITIALIZE OUTPUT BUFFER JSB FLUPT FIND ANY PARTIAL LINE FLAG CLA,RSS TURN ON EPR02 CCA TURN OFF STA EOL END-OF-LINE FLAG EPR04 LDB TEMPS MORE CPB PRADD STATEMENT? JMP EPR19 NO,EXIT PRINT EXECUTION LDA 1,I AND OPDMK EXTRACT OPERAND SZA NULL JMP EPR07 NO,GO TO EVALUATION EPR05 LDB TEMPS INB CPB PRADD MORE STATEMENT? JMP EPR19 NO, EXIT PRINT PROCESSING LDA 1,I YES, EXTRACT AND OPMSK OPERATOR CPA B2000 "," ? JMP EPR10 YES,GO TO COMMA EXECUTION CPA B3000 ";" ? JMP EPR14 YES, TURN OFF END-LINE FLAG CPA ENDOP "END" JMP EPR13 YES,GO CHECK FOR FILE I/O SZA NULL OPERATOR? JMP EPR07 NO,EVALUATE FORMULA EPR06 ISZ TEMPS YES, STEP CODE POINTER, JMP EPR04 AND EXAMINE OPERANND. * EPR07 CLA,INA STA STRFG ALLLOW STRING CONSTANTS CCA AND PRESET TAB FLAG STA EOL JSB FORMX EVALUATE NEXT EXPRESSION ISZ EOL WAS IT A TAB? JMP EPR12 YES, EXECUTION DONE LDB HSTPT,I WAS IT A STRING? SSB JMP EPR11 YES, GO PROCESS IT JSB OPCHK QUALIFY THE OPERAND LDA FILE# WRITE ON SSA,RSS A FILE? JMP EPR08 YES DLD 1,I NO JSB ENOUT OUTPUT THE NUMBER CLA AND REMEMBER THAT STA TABFG IT WAS NUMERIC OUTPUT JMP EPR12 * EPR08 STB SBPTR SAVE VALUE ADDRESS ISZ HSTPT POP VARIABLE PTR OFF HI STK LDB M2 REQUEST NUMERIC EPR09 JSB FILST WRITE ON FILE JMP EPR05 EPR12 ISZ HSTPT POP VARIABLE PTR OFF HI STK JMP EPR05 * EPR10 LDA FILE# COMMA EXECUTION, SSA,RSS IS THIS A FILE WRITE? JMP EPR06 YES,QUIT NOW CLA CPA EOL WAS THERE A TAB LAST? JSB EDELM NO,EXECUTE COMMA CLA,INA STA TABFG EPR14 ISZ TEMPS STEP CODE POINTER JMP EPR02 AND TURN OFF END-LINE FLAG * EPR11 LDA M2 PREPARE JSB PSTR PRINT STA TEMP8 STRING STB TPRME LDB TEMPS ADB M1 STB TEMPS LDB M3 LDA FILE# WRITE ON A FILE? SSA,RSS JMP EPR09 YES * LDA TNULL IS STRING EPR03 ADA .80 TOO LONG STA VLFIL TO BE OUTPUT SSA,RSS IN ONE LUMP? (VLFIL USED AS COUNTER) JMP EPR18 NO! * LDA M81 YES! EPR17 STA TNULL RESET LENGTH COUNTER TO MAX LNGTH CMA GET STRING LENGTH STA EDELM AND SAVE FOR LATER JSB OLNCK CHECK LINE OVERFLOW LDA .OTBF FIGURE STARTING CLE,ELA CHARACTER ADA OCCNT ADDRESS STA TEMP5 FOR TRSTR ADA EDELM UPDATE OUTPUT CLE,ERA POINTER SEZ,RSS ADA M1 STA OTBFA SINCE TRSTR WON'T LDA OCCNT AND ALSO ADA EDELM UPDATE THE STA OCCNT CHAR COUNT LDA FSCHA JSB TRSTR OUTPUT THE CHARACTERS CLA,INA STA TABFG AND REMEMBER NO BACKSPACING * LDA VLFIL MORE STRING LEFT SSA TO OUTPUT? JMP EPR03 YES! JMP EPR05 :EB@< ** * * *************************************** * * EXIT TO (P+1) IF NO USING OPERATOR FOUND, OTHERWISE PREPARE * FORMAT SPECIFICATION STRING AND CALL FORMATTED OUTPUT ROUTINE. * EPRUS NOP STA FFLG SAVE FORMAT FLAG LDB TEMPS  LDA 1,I CPA PRTOP NULL OPERAND? INB YES CPB PRADD END OF STATEMENT? JMP EPRUS,I YES LDA 1,I NO, 'USING' AND OPMSK OPERATOR CPA USEOP NEXT? RSS YES JMP EPRUS,I NO, EXIT XOR 1,I GET OPERAND STB TEMPS SAVE POINTER SSA,RSS INTEGER FOLLOWS? JMP EPRU1 NO INB LDB 1,I GET ADDRESS OF IMAGE STATEMENT ADB .2 => LENGTH WORD LDA 1,I AND OPMSK GET OPERATOR CPA IMGOP IMAGE? RSS YES JSB ERROR NO, NOT AN IMAGE STMT! E18 ISZ TEMPS BUMP TO POINT ISZ TEMPS TO FIRST OPERAND CLA STA NCH JMP FRMAT CALL FORMATTER EPRU1 SZA,RSS NULL OPERAND? JMP EPRU4 YES JSB FORMX NO, FETCH LDA M2 STRING JSB PSTR OPERAND LDA TEMP6,I GET AND B377 LENGTH SZA,RSS NULL STRING? JMP XEC4 YES CMA,INA NO, SAVE STA STRLN -LENGTH LDB TSTPT GET START OF STRING DESIGNATOR ADB .2 LDA 1,I GET FIRST SUBSCRIPT CMA,INA NEGATE IT INB ISZ 1,I SECOND SUBSCRIPT EXIST? JMP EPRU2 YES CLA NO, SET STA NCH CHARACTER COUNT JMP EPRU3 EPRU2 ADA 1,I COMPUTE DIFFERENCE SZA,RSS NULL STRING? JMP XEC4 YES SSA NO, NEGATIVE? JMP STER1-1 NEGATIVE STRING LENGTH STA NCH NO, SAVE DIFFERENCE CCA ADA 1,I SECOND ADA STRLN SUBSCRIPT SSA,RSS VALID? JMP E6-1 ILLEGAL SUBSCRIPTS EPRU3 ADB M1 YES LDA 1,I FIRST ADA STRLN SUBSCRIPT SSA,RSS VALID? JMP STER1-1 ILLEGAL SUBSCRIPTS LDA 1,I YES, LOAD IT LDB TEMP6 #]=> FIRST WORD OF STRING JMP FRMAT CALL FORMATTER EPRU4 INB => 1ST WORD OF STRING LDA 1,I UPDATE AND OPDMK INA INTRA- ARS ADA TEMPS STATEMENT ADA .2 STA TEMPS POINTER CLA STA NCH JMP FRMAT CALL FORMATTER * FFCH BSS 1 FORMAT FLAG NCH BSS 1 NUMBER OF CHARACTERS STRLN BSS 1 NEGATIVE STRING LENGTH SKP ******************************* * * ** FORMATTED OUTPUT ROUTINE ** * * ******************************** * .X OCT 130 S OCT 123 D OCT 104 .A OCT 101 M46 DEC -46 ..73 DEC 73 * * THE ADDRESS OF THE FIRST WORD OF THE FORMAT * STRING IS IN (B) UPON ENTRY. THE FORMATTER * EXTRACTS THE NUMBER OF CHARACTERS IN THE STRING * AND THEN EXTRACTS THE FORMAT SPECIFICATIONS * ONE BY ONE. AS EACH SPECIFICATION IS EXTRACTED, * IT IS LOADED INTO A STACK, ONE CHARACTER PER * WORD AND CHECKED FOR SYNTAX ERRORS. THE * TYPE OF SPECIFICATION IS DETERMINED AT THIS * TIME AND THE SPECIFICATION IS THEN EXECUTED * FROM THE STACK. * FRMAT STB EC SAVE POINTER TO STRING INB MAKE INTO CLE,ELB CHARACTER POINTER ADB 0 ADD IN STARTING CHARACTER CMA,INA SAVE STARTING STA CC CHARACTER STB IFSTR SAVE IN FORMAT STRING ADDRESS STB DP AND DELIMITER POINTER JSB PRNIN INITIALIZE PRINT BUFFER PTRS JSB FLUPT SETUP LU/COUNT WORD LDB NCH MAYBE SZB JMP FM0 YES LDA EC,I NO, COMPUTE # AND B377 OF CHARACTERS ADA CC IN FORMAT STA NCH STRING SZA,RSS NULL STRING? JMP FMEND+1 YES, IGNORE IT FM0 CLA INITIALIZE STA CC CHARACTER COUNTER STA CONTR CONTROL CHARACTER e STA EC EXPRESSION COUNTER STA CC1 START OF PARENTHESIS LEVEL 1 STA CC2 START OF PARENTHESIS LEVEL 2 STA PC1 REPETITION COUNT FOR LEVEL 1 STA PC2 REPETITION COUNT FOR LEVEL 2 STA SFLG STRING FLAG FMT2 JSB DSRCH DELIMITER SEARCH STO IGNORE BLANKS LDA FST GET THE JSB MCHAR FIRST CHARACTER CPA DP DELIMITER FOUND ? JMP FMEND YES CPA B53 IS CHARACTER A PLUS ? JMP FMT1 YES CPA B57 SLASH? JMP FMT90 YES! CPA B55 IS IT A MINUS ? JMP FMT1 YES CPA B43 NO, IS IT A NUMBER SIGN RSS YES JMP FMT3 NO FMT1 LDB CC END OF CPB NCH STRING ? JSB ERROR YES, ERROR FERR0 STA CONTR SAVE CARR. CONTROL CHARACTER ISZ FST INCREMENT STRING POINTER LDA FST STO IGNORE BLANKS JSB MCHAR GET NEXT CHARACTER CPA DP DELIMITER FOUND ? RSS YES JMP FMT01 NO, CHARACTER FOUND ? CLO GET LDA DP THE JSB MCHAR DELIMITER FMT01 CPA B54 IS IT A COMMA ? RSS YES JSB ERROR NO, ERROR FERR1 ISZ DP INCREMENT DELIMITER POINTER ISZ CC AND CHARACTER COUNTER LDB CC CPB NCH ALL CHARACTERS USED ? JMP FERR0-1 YES, ERROR LDA DP NO JSB DSRCH FIND NEXT DELIMITING CHARACTER FMT3 CCA INITIALIZE STA DPFLG FIXED FLAG STA EFLAG FLOATING FLAG INA STA NUM1 PRE-DECIMAL POINT D COUNTER STA NUM2 POST-DECIMAL POINT D COUNTER STA SBD S BEFORE D COUNTER STA SAD S AFTER D COUNTER STA SNFLG SIGN FLAG STA NAD POST-DECIMAL ZERO COUNTER STA NBD PRE-DECIMAL POINT DIGIT COUNTER INA STA REPCT REPETITION COUNT LDA IFSS FORMAT STACK STA FSP POINTER LDA FST GET NON-DELIMITING STO CHARACTER JSB MCHAR IGNORING BLANKS CPA DP IS IT A DELIMITER ? JMP FERR0-1 YES CPA B42 IS IT A QUOTE? RSS YES JMP FMT0 NO LDB DP CMB,INB RESET ADB FST CHARACTER ADB CC COUNTER STB CC FMT16 ISZ FST INCREMENT STRING POINTER LDA CC ALL CPA NCH CHARACTERS USED ? JSB ERROR YES, ERROR FERR2 ISZ CC INCREMENT CHARACTER COUNTER LDA FST CLO DON'T IGNORE BLANKS JSB MCHAR GET NEXT CHARACTER STA FSP,I LOAD CHARACTER ONTO STACK ISZ FSP INCREMENT STACK POINTER CPA B42 IS IT A " ? RSS YES JMP FMT16 NO ISZ FST INCREMENT STRING POINTER ISZ CC AND CHARACTER COUNTER LDA CC ALL CPA NCH CHARACTERS USED ? JMP FMT46 YES LDA FST RESET STA DP DELIMITER JSB DSRCH POINTER LDA FST NEXT CHARACTER CPA DP A DELIMITER ? JMP FMT46 YES STO IGNORE BLANKS JSB MCHAR FETCH A FORMAT STRING CHARACTER LDA FST WOULD IT BE CPA DP A DELIMITER ? JMP FMT46 YES JMP FERR1-1 NO, ERROR FMT0 CPA S IS IT AN S ? JMP FMT14 YES CPA B56 IS IT A . ? JMP FMT9 YES CPA E IS IT AN E? JMP FMT13 YES JSB DIGCK IS IT A DIGIT ? JMP FMT6 NO STA REPCT YES, STORE IN REPCT ISZ FST INCREMENT STRING POINTER LDA FST NEXT CHARACTER CPA DP A DELIMITER ? JSB ERROR YES, ERRORSl FERR3 STO IGNORE BLANKS JSB MCHAR GET NEXT CHARACTER CPA DP IS IT A DELIMITER ? JMP FERR3-1 JSB DIGCK IS IT A DIGIT ? JMP FMT5 NO LDA REPCT YES, STB REPCT MULTIPLY PREVIOUS MPY .10 DIGIT BY 10 ADA REPCT ADD IN ONES DIGIT STA REPCT ISZ FST INCREMENT STRING POINTER LDA FST NEXT CHARACTER CPA DP A DELIMITER ? JMP FERR3-1 YES, ERROR STO IGNORE BLANKS JSB MCHAR GET NEXT CHARACTER CPA DP IS IT A DELIMITER ? JMP FERR3-1 JSB DIGCK THIRD DIGIT ? RSS JSB ERROR YES, ERROR FERR4 EQU * FMT5 LDB REPCT SZB,RSS REPCT ZERO ? JSB ERROR YES FERR5 ADB M73 NO. GREATER SSB,RSS THAN 72? JMP FERR4-1 YES ADB ..73 RESTORE REPCT CMB,INB SET NUMBER FLAG STB FSP,I LOAD ONTO FORMAT STACK ISZ FSP INCREMENT STACK POINTER FMT6 CPA .X IS NEXT CHARACTER AN X ? JMP FMT8 YES CPA .A IS IT AN A ? JMP FMT10 YES CPA D IS IT A D ? RSS YES JMP FMT15 NO LDB DPFLG DPFLG = -1? SZB JMP FMT7 YES LDB NUM2 ADD REPCT TO ADB REPCT POST-DECIMAL STB NUM2 DIGIT COUNTER JMP FMT8 FMT7 LDB NUM1 ADD REPCT TO ADB REPCT PRE-DECIMAL STB NUM1 DIGIT COUNTER FMT8 CLB,INB REINITIALIZE STB REPCT REPCT STA FSP,I LOAD CHARACTER ONTO STACK ISZ FST INCREMENT STRING POINTER ISZ FSP AND STACK POINTER LDA FST NEXT CHARACTER CPA DP A DELIMITER ? JMP FMT08 YES STO IGNORE BLANKS JSB MCHAR GET NEXT CHARACTER CPA DP IS IT A DELIMITER ? RSS < YES JMP FMT0 FMT08 LDB FSP STB EST SET END OF STACK MARK JMP FMT18 FMT9 ISZ DPFLG DPFLG = -1 ? JSB ERROR NO FERR6 JMP FMT8+2 YES FMT10 LDB SFLG IS SFLG SZB,RSS ISZ SFLG YES, INCREMENT IT JMP FMT8 NO FMT13 ISZ EFLAG EFLAG= -1? JSB ERROR NO FERR7 JMP FMT8+2 YES FMT14 LDB NUM1 ADB NUM2 ANY D'S FOUND ? SZB,RSS ISZ SBD NO, INCREMENT BEFORE COUNTER LDB SBD ANY S'S BEFORE A D ? SZB,RSS ISZ SAD NO, INCREMENT AFTER COUNTER JMP FMT8+2 FMT15 CPA B50 IS CHARACTER A ( ? JMP FMT95 YES CPA B57 SLASH? JMP FMT90 YES! JSB ERROR NO, ILLEGAL CHARACTER FERR8 EQU * FMT18 LDA IFSS REINITIALIZE STA FSP STACK POINTER CCA AND STA REPCT REPCT ADA SFLG SFLG = 1 ? SZA,RSS JMP FMT24 YES ADA M2 SFLG = 3 ? SSA,RSS JMP FMT25 YES LDA NUM1 NO, ANY ADA NUM2 D'S SZA,RSS FOUND ? JMP FMT20 NO JSB EVEXP EVALUATE EXPRESSION JMP FMEND NONE FOUND JSB ERROR STRING--ERROR FERR9 STA MANT1 IF NUMBER STA NUMW1 SAVE HIGN MANTISSA JSB .FLUN UNPACK NUMBER STA EXPNT AND SAVE THE EXPONENT LDA MANT1 IS THE NUMBER NEGATIVE ? SSA,RSS JMP FMT31 NO LDA B55 YES, SET SIGN TO MINUS STA SIGN AND CMB,CLE,INB COMPLEMENT LDA MANT1 CMA OVERFLOW FROM SEZ,RSS LOW MANTISSA ? JMP FMT31-3 NO INA YES, OVERFLOW FROM SOS HIGH MANTISSA ? JMP FMT31-3 NO CLE,ERA YES, SHIFT RIGHT ERB AND ISZ EXPNT BUMP EXPONENT NOP STA MANT1 STA NUMW1 SAyVE HIGH MANTISSA JMP *+3 FMT31 LDA B53 SET SIGN STA SIGN TO PLUS STB MANT2 STB NUMW2 SAVE LOW MANTISSA LDA EXPNT STA EXPW AND EXPONENT CLB,INB SET EXPRESSION STB EC FOUND FLAG LDA IHB HOLDING BUFFER STA HBP POINTER LDA EFLAG EFLAG SZA,RSS SET ? JMP FMT62 YES LDA DPFLG DPFLG SZA,RSS SET JMP FMT45 YES JMP FMT30 NO ** ** *** OUTPUT A LITERAL STRING *** ** ** FMT46 LDA IFSS RESET STA FSP STACK POINTER FMT47 LDA FSP,I TOP OF STACK [B] CPA B42 A " ? JMP FMT90 YES, DONE WITH THIS SPEC CPA B16 IS IT A PSEUDO-LINEFEED ? LDA .10 YES, MAKE IT A LINEFEED CPA B17 IS IT A PSEUDO CARRIAGE RETURN ? RSS YES JMP FMT48 [B] LDA B15 CARRIAGE RETURN [B] FMT48 EQU * [B] JSB OUTCR NO, OUTPUT THE CHARACTER ISZ FSP INCREMENT STACK POINTER JMP FMT47 NO [B] ** ** *** OUTPUT A BLANK SPECIFICATION *** ** ** FMT20 LDA FSP,I LOAD TOP OF STACK SSA,RSS IS IT A NUMBER ? JMP FMT21 NO STA REPCT YES, STORE NUMBER IN REPCT ISZ FSP INCREMENT STACK POINTER LDA FSP,I LOAD NEW TOP OF STACK FMT21 CPA .X IS IT AN X ? RSS YES JMP FERR8-1 NO, ERROR JSB OUTBL CCA REINITIALIZE STA REPCT REPCT LDA FSP END CPA EST OF STACK JMP FMT90 YES LDA FSP,I LOAD NEW TOP OF STACK JMP FMT20 ** ** *** OUT<PUT A STRING *** ** ** FMT24 EQU * JSB EVEXP EVALUATE NEXT EXPRESSION JMP FMEND NONE FOUND FMT25 EQU * CLB,INB,RSS SET THE EXPRESSION JSB ERROR FER14 STB EC FOUND FLAG LDA FSP,I LOAD TOP OF STACK SSA,RSS IS IT A NUMBER ? JMP FMT26 NO STA REPCT YES ISZ FSP INCREMENT STACK POINTER LDA FSP,I LOAD NEW TOP OF STACK FMT26 CPA .X IS IT AN X ? RSS YES JMP FMT27 NO JSB OUTBL JMP FMT28 FMT27 CPA .A IS IT AN A ? RSS YES JMP FERR9-1 NO, ERROR ISZ FSP INCREMENT STACK POINTER FMT05 EQU * JSB FSCH FETCH STRING CHARACTER LDA BLANK NO, FETCH A BLANK CPA B16 IS IT A PSEUDO-LINEFEED ? LDA .10 YES, MAKE IT A LINEFEED CPA B17 IS IT A PSEUDO CARRIAGE RETURN ? RSS YES JMP FMT29 NO LDA B15 CARRIAGE RETURN [B] FMT29 EQU * JSB OUTCR OUTPUT CHARACTER ISZ REPCT REPCT USED UP ? JMP FMT05 NO FMT28 CCA REINITIALIZE STA REPCT REPCT LDA FSP END OF CPA EST STACK ? JMP FMT90 JMP FMT25 NO ** ** *** PREPARE AN INTEGER FOR OUTPUT *** ** ** FMT30 CLA INITIALIZE PRE-DECIMAL POINT STA EXPON DIGIT COUNTER CCA ADA EXPNT EXPONENT ZERO OR NEGATIVE ? SSA,RSS JMP FMT32 NO LDA B60 YES, LOAD A STA HBP,I ZERO ISZ HBP INCREMENT BUFFER POINTER CCA NUMBER OF BUFFER WORDS STA NHBW IS ONE JMP FMT33 FMT32 JSB DTL1 STA EXPON SAVE NUMBER STA NHBW OF DIGITS JSB GETDG GET DIGIT ADA B60 CONVERT TO ASCII STA HBP,I kSTORE IN HOLD BUFFER ISZ HBP ALL DIGITS ISZ EXPON FOUND ? JMP FMT32+3 NO FMT33 LDA NUM1 COMPUTE NUMBER OF ADA NHBW LEADING BLANKS LDB SBD ANY S'S ADB SAD FOUND ? SZB JMP FMT43 YES LDB SIGN NO, NUMBER POSITIVE ? CPB B53 JMP FMT43 YES ADA M1 NO, SAVE ROOM CLB,INB FOR STB SNFLG PRINTING SIGN FMT43 SSA NUMBER OF BLANKS NEGATIVE ? JMP FMT80 YES STA NBLK NO JSB ROUND ROUND NUMBER IN BUFFER RSS JMP FMT80 NO ROOM FOR CARRY FROM ROUND LDB IHB REINITIALIZE STB HBP HOLD BUFFER POINTER ** ** *** OUTPUT NUMBER FROM HOLDING BUFFER *** ** ** FMT34 LDA FSP,I LOAD TOP OF FORMAT STACK CPA S IS IT AN S ? RSS YES JMP FMT36 NO ISZ FSP INCREMENT STACK POINTER LDA SNFLG SZA SNFLG = 0 ? JMP FMT59 NO, IGNORE THE S LDB SBD YES, ANY S'S BEFORE A D ? SZB JMP FMT35 YES LDA SIGN NO, OUTPUT SIGN JSB OUTCR IMMEDIATELY LDA .2 SET SNFLG TO 2 STA SNFLG JMP FMT59 FMT35 CCB STB SNFLG SET SNFLG TO -1 JMP FMT34 FMT36 SSA,RSS TOP OF STACK A NUMBER ? JMP FMT06 NO STA REPCT YES, STORE IN REPCT ISZ FSP INCREMENT STACK POINTER LDA FSP,I LOAD NEW TOP OF STACK FMT06 CPA .X IS TOP AN X ? RSS YES JMP FMT37 NO JSB OUTBL CCA REINITIALIZE STA REPCT REPCT JMP FMT59 FMT37 CPA D TOP OF STACK A D ? RSS YES JMP FMT57 NO ISZ FSP INCREMENT STACK POINTER CCA ADA NBLK NUMBER OF BLANKS > 0 ? SSA JMP FMT07 NO LDA BLANK YES, OUTPUT A JSB OUTCR BLANK CCB DECREMENT ADB NBLK BLANK STB NBLK COUNT JMP FMT40 FMT07 LDA NBLK NUMBER OF BLANKS SSA LESS THAN ZERO ? JMP FMT56 YES CCA NO, DECREMENT STA NBLK BLANK COUNT CCB CPB SNFLG SNFLG = - 1 ? JMP FMT02 YES ADB SNFLG SNFLG = 1 ? SZB,RSS JMP FMT40 YES JMP FMT58 NO FMT56 CCB ADB SNFLG SNFLG = 1 ? SZB JMP FMT58 NO FMT02 LDA SIGN YES, OUTPUT JSB OUTCR SIGN AND LDA .2 SET SNFLG STA SNFLG TO 2 FMT58 LDA IHB END ADA .46 OF CPA HBP BUFFER ? JMP FMT59 LDA HBP,I OUTPUT A JSB OUTCR DIGIT ISZ HBP INCREMENT HOLD BUFFER POINTER LDA EFLAG IS THIS A SZA FLOATING POINT SPECIFICATION ? JMP FMT40 NO CLA,INA YES, HAS THE DECIMAL POINT CPA DPFLG BEEN FOUND YET ? JMP FMT40 YES CCA NO, DECREMENT ADA EXPON DECIMAL LDB IHB,I IS THE CPB B60 NUMBER ZERO? CLA YES, ZERO EXPONENT STA EXPON EXPONENT FMT40 ISZ REPCT REPCT = O ? JMP FMT37+4 NO CCA YES,REINITIALIZE STA REPCT REPCT JMP FMT59 FMT57 LDB DPFLG FIXED POINT SZB SPECIFICATION ? JMP FMT42 NO CPA B56 TOP OF STACK A DECIMAL POINT ? RSS YES JMP FMT42 NO ISZ FSP INCREMENT STACK POINTER LDB SNFLG SSB SNFLG = -1 ? JMP FM00 YES ADB M1 NO, = 1 ? aHFBBH SZB JMP FM01 NO FM00 LDA SIGN YES, OUTPUT JSB OUTCR SIGN LDA .2 SET SNFLG STA SNFLG TO 2 FM01 LDA B56 OUTPUT JSB OUTCR DECIMAL POINT ISZ DPFLG INCREMENT FLAG TO SHOW D.P. FOUND FMT59 LDA FSP END OF CPA EST STACK JMP FMT90 YES JMP FMT34 NO FMT42 ISZ FSP INCREMENT STACK POINTER JSB OUTCR OUTPUT AN E FMT76 LDA FSP END OF CPA EST STACK ? JMP FMT78 YES LDA FSP,I NO,TOP OF SSA,RSS STACK A NUMBER ? JMP FM02 NO ISZ FSP YES, INCREMENT STACK POINTER STA REPCT STORE NUMBER LDA FSP,I GET NEW TOP OF STACK FM02 CPA .X IS IT AN X ? RSS YES JMP FERR7-1 NO, ERROR JSB OUTBL CCA RESET STA REPCT REPCT JMP FMT76 FMT78 LDA B55 OUTPUT LDB EXPON SSB AN CMB,INB,RSS LDA B53 EXPONENT STB EXPON JSB OUTCR SIGN LDA EXPON CLB COMPUTE DIV .10 ADA B60 EXPONENT'S ADB B60 STB EXPON 10'S DIGIT JSB OUTCR OUTPUT IT LDA EXPON JSB OUTCR OUTPUT 1'S DIGIT JMP FMT90 ** ** *** PREPARE FIXED POINT NUMBER *** ** ** FMT45 CLA SET PRE-DECIMAL POINT STA EXPON DIGIT COUNTER STA NAD ZERO COUNTER CPA EXPNT ZERO EXPONENT ? JMP FMT61+3 YES LDB EXPNT NO SSB EXPONENT NEGATIVE JMP FMT61 YES JSB DTL1 STA EXPON LOAD STA NBD PRE-DECIMAL POINT FM03 JSB GETDG DIGITS ADA B60 STA HBP,I INTO ISZ HBP HOLD ISZ EXPON BUFFER JMP FM03 FMT50 LDB NUM2 ANY D'S AFTER SZB,RSS DECIMAL POINT ? JMP FMT51 NO LDA IHB END ADA .46 OF CPA HBP BUFFER ? JMP FM04 YES LDB NAD LEADING CLA ZEROES SZB,RSS AFTER JMP *+4 DECIMAL ADB M1 POINT STB NAD RSS YES JSB GETDG ADA B60 LOAD STA HBP,I POST-DECIMAL POINT CCB DIGITS ADB NUM2 INTO STB NUM2 HOLD ISZ HBP BUFFER JMP FMT50+1 FM04 LDA NUM2 OUTPUT BLANKS CMA,INA TO STA REPCT FILL FIELD JSB OUTBL CCA REINITIALIZE STA REPCT REPCT ADA FSP CORRECT STA FSP STACK POINTER FMT51 LDA NBD COMPUT NUMBER ADA NUM1 OF LEADING BLANKS LDB SBD ANY S'S ADB SAD FOUND ? SZB JMP FMT54 YES LDB SIGN NO, NUMBER CPB B53 POSITIVE ? JMP FMT54 YES ADA M1 NO, LEAVE ROOM FOR CLB,INB SIGN TO BE PRINTED AND STB SNFLG SET SNFLG TO 1 FMT54 SSA NUMBER OF BLANKS NEGATIVE ? JMP FMT80 YES STA NBLK NO, CCB NEXT DIGIT A ADB NAD LEADING ZERO ? SSB JSB ROUND NO, ROUND NUMBER RSS JMP FMT80 NO ROOM FOR CARRY FROM ROUND LDA IHB RESET HOLD STA HBP BUFFER POINTER JMP FMT34 GO OUTPUT THE NUMBER FMT61 JSB MTG1 LDA EXPON STA NAD LDB NUM1 ANY D'S FOUND SZB,RSS BEFORE THE DECIMAL POINT ? JMP FMT50 NO LDA NUM2 YES, ANY D'S FOUND SZA,RSS AFTER THE DECIMAL POINT ? JMP FMT55 NO CPB .1 YES, ONLY ONE OF THEM ? RSS JMP FMT55 9NO LDA SAD YES, ANY S'S FOUND ? ADA SBD SZA JMP FMT55 YES LDA SIGN NO, NUMBER CPA B55 NEGATIVE ? JMP FMT50 YES FMT55 LDA B60 NO, LOAD PRE-DECIMAL POINT STA HBP,I ZERO INTO BUFFER ISZ HBP CCA DECREASE NUMBER OF ADA NUM1 D'S AVAILABLE FOR SIGN STA NUM1 AND BLANKS BEFORE DECIMAL PT. JMP FMT50 ** ** *** PREPARE FLOATING POINT NUMBER *** ** ** FMT62 CLA INITIALIZE DECIMAL STA EXPON EXPONENT CPA EXPNT ZERO EXPONENT ? JMP *+3 YES JSB MTG1 JSB DTL1 CMA,INA SAVE DECIMAL EXPONENT STA EXPON LDA NUM1 GET ADA NUM2 TOTAL NUMBER STA TOTDG OF DIGITS LDA SBD ADA SAD ANY S'S FOUND ? SZA JMP FMT67 YES LDA SIGN NO, NUMBER CPA B53 POSITIVE ? JMP FMT67 YES CCB NO, LEAVE ROOM ADB NUM1 FOR SIGN SSB NONE ? JMP FMT80 YES STB NUM1 NO, DECREMENT CCA TOTAL NUMBER OF D'S ADA TOTDG AVAILABLE FOR SIGN STA TOTDG AND BLANKS BEFORE DEC. PT. SZA,RSS JMP FMT80 CLB,INB SET SNFLG STB SNFLG TO 1 FMT67 LDA NUM2 NUM2 CMA,INA > 7 ? LDB .6 ADB 0 SSB JMP FMT70 YES LDA TOTDG YES, TOTAL NUMBER OF D'S ADA M8 > 7 ? SSA JMP FMT68 NO LDB M7 PREPARE TO GET STB DCTR SEVEN DIGITS INA NUMBER OF BLANKS STA NBLK BECOMES TOTDG - 7 JMP FMT72 FMT68 LDA TOTDG PREPARE TO GET CMA,INA STA DCTR TOTDG DIGITS CLB SET NUMBER OF BLANKS STB NBLK t TO ZERO JMP FMT72 FMT70 LDB NUM1 ANY D'S BEFORE SZB DECIMAL POINT ? ADA M1 YES, INCREMENT NUMBER OF DIGITS STA DCTR PREPARE TO GET NUM2 DIGITS SZB SET ADB M1 BLANK STB NBLK COUNT LDA DCTR MORE THAN ADA .46 FOURTY-SIX SSA,RSS DIGITS NEEDED ? JMP FMT72 NO STA REPCT YES, OUTPUT NECESSARY BLANKS JSB OUTBL ADA FSP CORRECT STA FSP STACK POINTER LDA M46 SET DCTR STA DCTR TO 46 FMT72 EQU * CCA REINITIALIZE STA REPCT REPCT JSB GETDG ADA B60 CONVERT TO ASCII STA HBP,I STORE IN HOLD BUFFER ISZ HBP INCREMENT BUFFER POINTER ISZ DCTR ALL DIGITS GOT ? JMP FMT72 NO JSB ROUND YES, ROUND THE NUMBER IN BUFFER RSS JMP FMT80 NO ROOM FOR CARRY FROM ROUND LDA IHB RESET STA HBP BUFFER POINTER JMP FMT34 ** ** *** HANDLE END OF SPECIFICATION *** ** ** FMT90 CLA STA SFLG STRING FLAG LDA CC ENF OF CPA NCH FORMAT STRING ? RSS YES JMP FMT92 NO FMT09 LDA CC1 YES, PARENTHESIS SZA BALANCED ? JSB ERROR NO, ERROR FER10 EQU * FMT91 LDB EC ANY EXPRESSIONS SZB,RSS USED ? JMP FMEND NO LDB EDSTA END OF SZB,RSS STATEMENT ? JMP FMEND YES CLA STA EC YES, CLEAR EC STA CC LDA IFSTR RESET STA DP DELIMITER POINTER JMP FMT2 FMT92 LDA DP GET THE CLO DELIMITING CHARACTER JSB MCHAR NOT IGNORING BLANKS CPA B51 IS IT A RIGHT PARENTHESIS JMP FMT97 YES STA LCH NO, SAVE THE CHARACTER CPA B54 IS IT A COMMA ? JMP FMT93+3 YES CPA B57 IS IT A SLASH ? RSS YES JMP FERR1-1 NO, ERROR EXIT FMT93 JSB OUTLN OUTPUT LINE CLA STA OCCNT STA TEMP1,I CLEAR LU/CHAR COUNT WORD ISZ CC INCREMENT CHARACTER COUNTER LDA CC ALL CHARACTERS CPA NCH USED ? JMP FMT94 YES ISZ DP INCREMENT DELIMITER POINTER JSB DSRCH FIND NEXT DELIMITER STO IGNORE BLANKS LDA FST JSB MCHAR NEXT CHARACTER CPA DP IS IT A DELIMITER RSS YES JMP FM11 NO LDA CC ALL CHARACTERS CPA NCH USED ? JMP FMT94 YES LDA DP NO, GET DELIMITING CLO CHARACTER JSB MCHAR IGNORING BLANKS FM11 CPA B54 IS IT A COMMA JMP FMT94 YES CPA B57 NO, A SLASH JMP FMT89 YES CPA B51 NO, A RIGHT PARENTHESIS ? JMP FMT97 YES JMP FMT3 FMT94 LDA LCH LAST CHARACTER CPA B54 A COMMA ? JMP FERR0-1 FMT89 LDA CC NO, ALL CHARACTERS CPA NCH USED ? JMP FMT09 YES JMP FMT92 NO ** ** *** HANDLE GROUPS OF SPECIFICATIONS *** ** ** FMT95 CCA SECOND ADA FSP CHARACTER CPA IFSS IN STACK ? RSS JSB ERROR NO, ERROR FER11 LDA CC1 YES, FIRST LEVEL SZA OF PARENTHESIS ? JMP FMT96 NO ISZ FST INCREMENT STRING POINTER CCA FIND CHARACTER COUNT ADA IFSTR UP TO AND INCLUDING CMA LEFT ADA FST PARENTHESIS STA CC1 LDB REPCT STORE REPETITION STB PC1 COUNT JMSP FMT3 PROCESS STRING FMT96 LDA CC2 SECOND LEVEL SZA OF PARENTHESIS JSB ERROR NO, ERROR FER12 ISZ FST CCA FIND CHARACTER COUNT ADA IFSTR UP TO AND CMA INCLUDING ADA FST LEFT STA CC2 PARENTHESIS LDB REPCT STORE REPETITION STB PC2 COUNT JMP FMT3 FMT97 LDA PC2 SECOND LEVEL OF SZA,RSS PARENTHESIS ? JMP FMT98 NO ADA M1 YES, REPEAT IT STA PC2 SZA,RSS JMP FMT99 LDB CC2 RESET STB CC CHARACTER COUNTER ADB IFSTR STB DP AND STRING POINTER JSB DSRCH JMP FMT3 REPROCESS PARENTHESIZED STRING FMT99 CLA CLEAR SECOND STA CC2 LEVEL POINTER STA SFLG AND STRING FLAG ISZ CC INCREMENT CHARACTER COUNTER LDA CC ALL CHARACTERS CPA NCH USED ? JMP FERR1-1 YES, ERROR ISZ DP NO, POINT TO DELIMITER JSB DSRCH FIND NEXT DELIMITER STO GET NEXT LDA FST NON-BLANK JSB MCHAR CHARACTER CPA DP IS IT A DELIMITER ? RSS YES JMP FMT92+3 MAYBE LDB CC ALL CPB NCH CHARACTERS USED ? JMP FER10-1 YES, ERROR JMP FMT92 NO, INVESTIGATE THE CHARACTER FMT98 LDA PC1 FIRST LEVEL SZA,RSS OF PARENTHESIS ? JSB ERROR NO, ERROR FER13 ADA M1 YES, REPEAT IT STA PC1 SZA,RSS JMP FMT00 LDB CC1 RESET STB CC CHARACTER COUNTER ADB IFSTR STB DP JSB DSRCH JMP FMT3 REPROCESS PARENTHESIZED STRING FMT00 CLA CLEAR FIRST STA CC1 LEVEL POINTER STA SFLG AND STRING FLAG ISZ CC INCREMENT CHARACTER COUNTER ISZ DP POINT TO DELIMITER LDA CC ALL CPA NCH CHARACTERS USED ? JMP FMT91 YES JSB DSRCH NO, FIND NEXT DELIMITER STO GET NEXT LDA FST NON-BLANK JSB MCHAR CHARACTER CPA DP IS IT A DELIMITER ? RSS YES JMP FMT92+3 NO LDB CC ALL CPB NCH CHARACTERS USED ? JMP FMT91 YES JMP FMT92 NO, INVESTIGATE THE FOUND CHARACTER ** ** *** OUTPUT NUMBER IN DEFAULT FORMAT *** ** ** FMT80 LDA NUMW1 STA MANT1 LOAD LDB NUMW2 STB MANT2 SAVED LDA EXPW STA EXPNT NUMBER CLA CLEAR STA EXPON DECIMAL EXPONENT STA EFLAG SET FLOATING POINT FLAG CPA EXPNT ZERO EXPONENT ? JMP *+3 YES JSB MTG1 JSB DTL1 CMA STA EXPON JSB OUTLN OUTPUT LINE W/CR-LF CLA STA OCCNT STA TEMP1,I CLEAR LU/CHAR COUNT WORD LDA IHB RESET HOLD STA HBP BUFFER POINTER LDA M6 PREPARE TO GET STA TOTDG SIX DIGITS JSB GETDG GET ADA B60 STA HBP,I SIX ISZ HBP ISZ TOTDG DIGITS JMP *-5 LDA .2 SET NBLK TO STA NBLK WHERE IT WONT CAUSE TROUBLE JSB ROUND ROUND NUMBER IN HOLD BUFFER NOP LDA SIGN OUTPUT JSB OUTCR SIGN LDA IHB INITIALIZE STA HBP HOLD BUFFER POINTER LDA HBP,I OUTPUT JSB OUTCR DIGIT ISZ HBP INCREMENT HOLD BUFFER POINTER LDA B56 OUTPUT JSB OUTCR DECIMAL POINT LDA M5 PREPARE TO OUTPUT STA TOTDG FIVE DIGITS LDA HBP,I OUTPUT JSB OUTCR FIVE ISZ HBP  DIGITS ISZ TOTDG JMP *-4 LDA E OUTPUT JSB OUTCR AN E LDA B55 LDB EXPON OUTPUT SSB CMB,INB,RSS EXPONENT LDA B53 STB EXPON SIGN JSB OUTCR LDA EXPON CLB GET BOTH EXPONENT DIGITS DIV .10 ADA B60 CONVERT BOTH ADB B60 TO ASCII STB EXPON JSB OUTCR OUTPUT 10'S DIGIT LDA EXPON JSB OUTCR OUTPUT 1'S DIGIT RSS OUTPUT LINE JMP FMT90 FM16 JSB OUTLN CLA STA TEMP1,I CLEAR OUT LU/CHAR COUNT WORD STA OCCNT CLEAR CHAR COUNT JMP XIT FMEND LDA CONTR YES, CONTROL SZA,RSS CHARACTER FOUND ? JMP FM16 NO,OUTPUT W/CRLF CPA B53 IS CARRIAGE RSS CONTROL "+"? JMP FM10 NO LDA B15 YES JSB OUTCR OUTPUT A CARRIAGE RETURN JMP FM18 OUTPUT THE LINE FM10 CPA B55 IS IT A MINUS ? JMP FM12 YES, SUPPRESS CARRIAGE RETURN CPA B43 IS CARRIAGE CONTROL "#"? JMP FM13 YES, SUPPRESS CARRIAGE RETURN AND LINEFEED JMP XIT NOT CORRECT CHAR, SO IGNORE ALL FM12 LDA .10 OUTPUT A JSB OUTCR LINEFEED * FM13 STA BFFLG SET TO KEEP TRACK OF CHAR COUNT JSB OUTPT OUTPUT A LINE XIT LDA HTEMP RESTORE STA HSTPT HI STK PTR JMP XEC4 EXECUTE NEXT STMT * FM18 CLA SET OUTPUT NOW FLAG STA BFFLG JMP FM13 * * IF BFFLG=0 THEN OUTPUT WITHOUT CHAR COUNT * OUTPT NOP LDA LUOUT AND B77 IS THIS JSB FINDV DEVICE A CPA .10 LINEPRINTER? JMP FM15 YES! LDA LFTAR ADD LEFT ARROW JSB OUTCR OUT IT FM14 LDA BFFLG IS THIS OUTPUT CONTAIN SZA,RSS A CARRIAGE RETURN? JMP FM17 YES LDB M1 JSB BLDLU 6BUILD LU/COUNT WORD FM17 STA TEMP1,I PUT IT IN TABLE JSB OUTLN CLA STA OCCNT CLEAR CHAR COUNT JMP OUTPT,I * FM15 JSB HONES SET UP HONESTY MODE CLB JMP FM14 * BFFLG BSS 1 EC BSS 1 FST BSS 1 SFLG BSS 1 EXPW BSS 1 IHB DEF HB HB BSS 46 IFSS DEF FSS FORMAT STACK FSS BSS 72 HBP BSS 1 DPFLG BSS 1 FSP BSS 1 EXPON BSS 1 FFLG BSS 1 EDSTA BSS 1 ELCNT BSS 1 NAD BSS 1 NBD BSS 1 LCH BSS 1 NBLK BSS 1 NHBW BSS 1 NUMW1 BSS 1 NUMW2 BSS 1 SNFLG BSS 1 TOTDG BSS 1 DCTR BSS 1 CC1 BSS 1 CC2 BSS 1 CONTR BSS 1 EFLAG BSS 1 REPCT BSS 1 EST BSS 1 CC BSS 1 DP BSS 1 PC1 BSS 1 PC2 BSS 1 NUM1 BSS 1 NUM2 BSS 1 SAD BSS 1 SBD BSS 1 IFSTR BSS 1 B15 EQU .13 B16 EQU .14 B17 EQU .15 B43 OCT 43 B50 OCT 50 B51 OCT 51 B53 OCT 53 B54 OCT 54 B55 OCT 55 B56 OCT 56 B57 OCT 57 B60 OCT 60 B61 OCT 61 M32 DEC -32 M96 DEC -96 .58 DEC 58 B140 OCT 140 E OCT 105 .46 DEC 46 M8 DEC -8 SKP ********************************** * * ** FORMATTER UTILITY ROUTINES ** * * ********************************** * * *** MAKE A NUMBER LESS THAN 1 *** ** ** * * MULTIPLY AN UNPACKED FLOATING POINT * NUMBER IN MANT1, MANT2 AND EXP BY 10 UNTIL * IT IS GREATER THAN 1. THEN DIVIDE BY 10 * MTG1 NOP JSB MBY10 LDA EXPNT MULTIPLY CMA,SSA,INA,SZA NUMBER BY 10 JMP *+3 UNTIL IT IS ISZ EXPON GREATER JMP MTG1+1 THAN 1 JSB DBY10 DIVIDE BY 10 JMP MTG1,I * * DIVIDE AN UNPACKED FLOATING POINT NUMBER * IN MANT1, MANT2 AND EXP BY 10 UNTIL IT IS * LESS THAN 1 * DTL1 NOP LDA EXPON DTL10 LDB EXPNT DIVIDE CMB,INB NUMBER SSB,RSS BY 10 JMP DTL1,I UNTIL STA EXPON IT IS JSB DBY10 LESS CCA THAN ADA EXPON 1 JMP DTL10 SKP ** ** *** ROUND ASCII NUMBER *** ** ** * * NUMBER STORED ONE ASCII DIGIT PER WORD IN * HOLDING BUFFER. ROUTINE GETS NEXT DIGIT * AND ROUNDS IF IT IS >= 5. * IF THERE IS A CARRY TO AN EXTRA DIGIT AND NO * ROOM EXISTS, EXIT IS TO (P+1). OTHERWISE RETURN * TO (P+2). * ROUND NOP JSB GETDG GET NEXT DIGIT ADA M5 IS IT >= 5 ? SSA JMP ROUND,I CCA DECREMENT HOLD ADA HBP BUFFER POINTER ROND1 LDB 0,I LOAD NEXT DIGIT INB INCREMENT IT CPB .58 WAS IT A 9 ? JMP *+3 YES STB 0,I NO, SAVE IT JMP ROUND,I AND RETURN LDB B60 OVERLAY STB 0,I A 0 CPA IHB LEADING DIGIT ? JMP *+3 YES ADA M1 NO, DECREMENT POINTER JMP ROND1 LDB B61 OVERLAY A STB 0,I ONE LDB B60 LOAD STB HBP,I EXTRA ZERO LDB EFLAG FLOATING POINT SZB SPECIFICATION ? JMP ROND2 NO ISZ EXPON INCREMENT EXPONENT NOP JMP ROUND,I ROND2 CCB IS NBLK ADB NBLK LESS SSB THAN 1 ? ISZ ROUND NO, RETURN TO (P+2) STB NBLK YES, KEEP DECREMENTED VALUE JMP ROUND,I SKP ** ** *** OUTPUT BLANKS *** ** ** * * OUTPUTS THE NUMBER OF BLANKS SPECIFIED * BY THE NEGATIVE OF REPCT. THE STACK POINTER * IS INCREMENTED AND REPCT HAS THE VALUE ZERO * UPON EXIT. * OUTBL NOP ISZ FSP INCREMENT STACK POINTER LDA BLANK OUTPUT A JSB OUTCR BLANK ISZ REPCT REPCT USED UP ? JMP *-3 B@< JMP OUTBL,I * SKP ** ** *** SEARCH FOR A DELIMITING CHARACTER *** B** ** * * BEGINS SEARCH AT CHARACTER DP. WHEN A COMMA * OR SLASH IS FOUND, DP IS SET TO POINT TO THAT * CHARACTER. CHARACTERS ARE COUNTED AND IF THE * END OF THE STRING IS ENCOUNTERED BEFORE A * DELIMITER IS FOUND, A FLAG IS SET * DSRCH NOP LDA DP SET STRING POINTER TO STA FST FIRST CHARACTER CLO DON'T IGNORE BLANKS SER1 JSB MCHAR GET STRING CHARACTER CPA B54 IS IT A COMMA ? JMP DSRCH,I YES CPA B57 NO, IS IT A SLASH ? JMP DSRCH,I YES CPA B51 NO, IS IT A RIGHT PARENTHESIS ? JMP DSRCH,I YES ISZ DP NO,INCREMENT DELIMITER POINTER ISZ CC AND CHARACTER COUNTER LDA DP LDB CC CPB NCH ALL CHARACTERS USED ? JMP DSRCH,I YES JMP SER1 NO ** ** *** MASK OUT A CHARACTER *** ** ** * * GET NEXT CHARACTER FROM FORMAT STRING * ADDRESS OF CHARACTER IS IN (A). CHARACTER IS * RETURNED IN (A) * MCHAR NOP CLE,ERA SHIFT ADDRESS RIGHT LDB 0,I LOAD WORD FROM STRING SEZ,RSS HIGH CHARACTER ? BLF,BLF YES, SWITCH POSITIONS LDA 1 NO AND B377 MASK OUT LOW CHARACTER SOS SHOULD BLANKS BE IGNORED ? JMP MCHAR,I CPA BLANK YES, IS CHARACTER A BLANK ? JMP MCHR1 YES ADA M96 NO SSA,RSS LOWER CASE? ADA M32 YES ADA B140 NO JMP MCHAR,I MCHR1 EQU * ISZ FST INCREMENT STRING POINTER LDA FST NEXT CHARACTER CPA DP A DELIMITER ? JMP MCHAR,I YES, RETURN JMP MCHAR+1 IGNORE THE BLANK ** ** *** EVALUATE EXPRESSION *** ** ** * * EXTRACT THE NEXT VARIABLE TO BE OUTPUT BY THE FORMATTER. IF * NONE FOUND, EXIT TO (P+1). IF A ST^!RING IS FOUND, EXIT TO * (P+2) AFTER PREPARING THE STRING FOR OUTPUT. IF A NUMERIC * QUANTITY IS FOUND, EXIT TO (P+3) WITH THE NUMBER IF (A) AND (B). * EDSTA IS SET TO 0 IF THIS IS THE LAST VARIABLE IN THE STATEMENT. * EVEXP NOP EVEX0 LDB TEMPS CPB PRADD END OF STATEMENT? JMP EVEXP,I YES LDA 1,I AND OPDMK NULL SZA OPERAND? JMP EVEX5 NO, EVALUATE IT INB STB TEMPS CPB PRADD END-OF-STMT? JMP EVEXP,I YES EVEX5 CCA TURN OFF STA EOL FUNCTION FLAG JSB FORMX EVALUATE FORMULA LDB HSTPT,I IS IT A SSB STRING VARIABLE ? JMP EVEX3 YES JSB OPCHK NO, UNSTACK VALUE ADDRESS ISZ EOL A FUNCTION ? JMP EVEX0 LDA TEMPS LAST VARIABLE? INA CPA PRADD CLA YES STA EDSTA NO DLD 1,I NO, LOAD NUMBER ISZ EVEXP RETURN TO (P+3) JMP EVEX4 EVEX3 LDA M2 PREPARE JSB PSTR PRINT STA TEMP8 STRING STB TPRME LDB TEMPS END OF INB CPB PRADD STATEMENT? CLB YES STB EDSTA NO LDB TPRME EVEX4 EQU * ISZ EVEXP RETURN TO JMP EVEXP,I (P+2) SKP *********************** * * * FIND LU/COUNT WORD * * * *********************** * FLUPT NOP LDA LUOUT CREATE THE AND B77 SEARCH TARGET STA LUTMP LDB M20 INITIALIZE STB TEMP7 COUNTER ADB FCORE AND FIGURE START OF LIST CCA INITIALIZE STA TEMP1 EMPTY SLOT POINTER STA TEMP3 AND FLAG FLUP1 LDA 1,I EXAMINE A WORD SZA EMPTY ? JMP FLUP2 NO ISZ TEMP3 YES, IS THIS THE FIRST JMP FLUP4 NO, SKIP TO NEXT STB TEMP1 ] YES, SAVE POINTER JMP FLUP4 AND SKIP TO NEXT FLUP2 ALF,ALF POSITION AND AND B77 ISOLATE LU BYTE CPA LUTMP DOES IT MATCH ? JMP FLUP3 YES FLUP4 INB NO, TRY AGAIN ISZ TEMP7 UNLESS THERE JMP FLUP1 AREN'T ANY MORE * CLA MATCH NOT FOUND LDB TEMP1 WAS THERE AN EMPTY SSB SLOT ? JMP E1 NO, OUT OF STORAGE JMP FLUP5 YES, QUIT WITH A = 0, B = ADDR * FLUP3 LDA 1,I MATCH FOUND STB TEMP1 RETURN WITH A = COUNT WORD FLUP5 AND B377 SET UP STA TYPE CHAR COUNT JMP FLUPT,I SKP *************************** * * * SPACE FOR A COMMA * * * *************************** * EDELM NOP CLB STB OUTLN SET FLAG FOR LINE OVERFLOW LDA OCCNT ADA TYPE FIGURE CURRENT COLUMN DIV .15 TAKE COLUMN .MOD. 15 SZB,RSS RIGHT ON ? JMP EDELM,I YES, QUIT NOW LDA 1 NO, COMPUTE ADA M15 BLANKS REQUIRED STA TEMP3 FOR SPACING CMA,INA JSB OLNCK CHECK FOR LINE OVERFLOW LDA OUTLN WAS THERE OVERFLOW ? SZA JMP EDELM,I YES, QUIT NOW EDEL0 LDA .32 NO, EMIT A SPACE JSB OUTCR ISZ TEMP3 KEEP ON DOING IT JMP EDEL0 UNTIL FIELD IS FULL JMP EDELM,I * LUTMP EQU EDELM SKP ********************* * * ** EXECUTE CHAIN ** * * ********************* * ECHAN LDA .2 SET FLAG STA PFLAG TO INDICATE CLA,INA SET TO ALLOW STA STRFG STRING CONSTANTS JSB FORMX EVALUATE FILE NAME LDA M2 PREPARE JSB PSTR STRING ADDRESS AND LENGTH STA TEMP7 ADDRESS STB TEMP8 LENGTH [ LDA TEMPS FOLLOWED BY INA CPA PRADD A STMNT NUMBER? JMP ECH2 NO! ISZ TEMPS ISZ TEMPS LDA TEMPS,I YES, SAVE IT STA LORUN SAVE IT JMP COMND CHAIN, GOTO COMMAND SEGMENT ECH2 CLA,INA SET FOR CHAIN TO JMP COMND TOP OF PROGRAM SKP *********************** * * ** EXECUTE INVOKE ** * * *********************** * EINVK LDA .1 GO GET ONE TRACK IOR MNEG DON'T WAIT IF NO TRACKS STA TK# NOS OF TRACK JSB SGETT TRACK ALLOCATION ROUTINE LDA DSEC# NOS OF 64 WORD SECTORS MPY .64 (64 WD SEC.)(NOS SEC.)=WORDS PER TRACK STA INTKZ SAVE IN COMMON FOR FUTURE USE LDA .1 NOS OF TRACKS TO 1 STA TK# FOR REL. JSB RETK RELEASE THE TEST TRACK LDA FWAMB START OF PROGRAM AREA CMA,INA ADA SYMTA END OF SYMBOL TABLE INA BUMP ONE.. STA LENPG LENGTH OF THE PROGRAM ADA B1000 BUMP FOR REST OF ODD SECTOR CLB CALCULATE THE DIV INTKZ NUMBER OF TRACKS THAT INA ARE NEEDED FOR PROGRAM AND COMMON IOR MNEG TURN ON DON'T WAIT BIT STA TK# SAVE JSB SGETT GO GET THAT NO. OF TRACKS LDA DLU# GET DISC LU# IOR .64 TURN ON BINARY BIT STA SWCND CONTROL WORD LDA LENCM COMMON WORD COUNT STA SBLNG BUFFER LENGTH CLA STARTING STA STSEC SECTOR LDA CMADR STARTING ADDRESS OF COMMON STA SBUF BUF START ADDR JSB SWRTE WRITE COMMON TO PROG TRACKS AND DSERR CHECK FOR DISC ERR SZA IN BITS 15-14 JMP E1 SOMETHING WRONG CPB LENCM DID ALL WRDS GO?? RSS YES OK. JMP E1 NO, DISC ERROR LDA STRK# GET STARTING TRK NUMBER ASL 7 SHIFT TO BITS 14-7 IOR TK# PUT IN NOS OF TRACKS AND INF TAKE OUT BIT 15 IF ON. LDB DLU# LOOK AT THE LU ADB M2 IS IT LU 2??? SZB WELL IOR MNEG NO, SIGN BIT ON FOR LU 3 STA INLOC SAVE IN COMMON FOR NEXT INVOKE LDA INTKZ GET TRACK SIZE ADA M512 BUMP DOWN FOR FIRST PROG WRITE STA TMLND TEMP DISC LENGTH LDA .4 SET STARTING STA STSEC SECTOR NUMBER LDA FWAMB START PROG ADDRESS STA TEMAD TEMP PROG ADDR. STA SBUF START BUF ADRR LDA LENPG PROGRAM LENGTH STA TMLNP TEMP LENGTH OF PROG TO GO INVK1 LDA TMLND CURRENT TRACK SIZE CMA,INA ADA TMLNP SUB FROM TO GO SIZE SSA LAST WRITE?? JMP INVK2 YES COMPLETE STA TMLNP UPDATE PROG TO GO LDA TMLND GET TRACK SIZE STA SBLNG BUF LENGTH ADA TEMAD RUNNING PROG ADDR STA TEMAD UPDATE TO NEXT JMP INVK3 GO WRITE INVK2 LDA TMLNP TEMP PROG LENGTH STA SBLNG MAKE BUFF LENGTH CLA SET TO STA TMLNP ZERO FOR FINISH INVK3 JSB SWRTE WRITE TO DISC AND DSERR LOOK AT BITS 15-14 SZA DISC ERROR? JMP E1 YES CPB SBLNG WRITE OK?? RSS YES JMP E1 NO SHOW BAD CLA ARE WE CPA TMLNP ALL FINISHED??? JMP ECHAN YES, DO A PSEUDO CHAIN STA STSEC NO, START AT SECTOR ZERO ISZ STRK# BUMP TRACK NO LDA INTKZ UPDATE TRACK SIZE STA TMLND FOR NEXT WRITE LDA TEMAD RUNNING ADDRESS STA SBUF FOR NEXT WRITE JMP INVK1 WRITE AGAIN SPC 1 * * WRITE TO PROGRAM TRACKS * SPC 1 SWRTE NOP JSB EXEC THROUGH EXEC DEF SWRET RETURN DEF .2 WRITE DEF SWCND CON WORD DEF SBUF,I BUFF ADDR DEF SBLNG LENGTH DEF STRK# TRACK NUMBER DEF STSEC STARTING SECTOR SWRET JMP SWRTE,I RETURN * * GET TRACKS SUBROUTINE * SPC 1 SGETT NOP ENTER SGET1 JSB EXEC EXEC DEF SGRET RETURN POINT DEF .4 GET TRACKS CALL DEF TK# NUMBER OF TRACKS REQUESTED DEF STRK# STARTING TRACK NUMBER (EXEC) DEF DLU# DISC LU NUMBER (EXEC) DEF DSEC# NUMBER OF 64 WORD SECT PER TRACK (EXEC) SGRET LDA STRK# DID WE GET TRACKS? SSA,RSS JMP SGETT,I YES ALL OK. LDA M20 NO, PRINT MESSAGE. LDB WATAD BASIC WAITING FOR TRACKS JSB WRITE SEND TO OPERATOR LDA TK# GET NOS. OF TRACKS WORD AND INF TAKE OUT BIT 15 STA TK# AND SUSPEND UNTIL TRACKS JMP SGET1 BECOME AVAILABLE SPC 1 * * RELEASE TRACKS SUBROUTINE * SPC 1 RETK NOP ENTER JSB EXEC GO DEF RERET RETURN POINT DEF .5 REL TRACKS REQUEST DEF TK# NUMBER OF TRACKS DEF STRK# STARTING TRACK NUMBER DEF DLU# DISC LU NUMBER RERET JMP RETK,I RETURN SPC 1 TK# BSS 1 STRK# BSS 1 DLU# BSS 1 DSEC# BSS 1 LENPG BSS 1 SWCND BSS 1 SBUF BSS 1 SBLNG BSS 1 CMADR DEF TEMPS LENC EQU SPEC-TEMPS+10 ***CHANGE IF COMMON CHANGES**** LENCM ABS LENC STSEC BSS 1 TEMAD BSS 1 TMLND BSS 1 TMLNP BSS 1 M512 DEC -512 WATAD DEF WATMS WATMS ASC 10,BASIC WAITING TRACKS SKP ***************************** * * * VALIDATE A FILE REQUEST * * * ***************************** * * EXIT TO (P+1) IF TEMPS+1 DOES NOT BEGIN A FILE REFERENCE * OR IF FILE REFERENCE IS TO A TYPE 0 FILE. * EVALUATE THE FILE REFERENCE AND VERIFY ITS CORRESPONDENCE * WITH A REQUESTED FILE. IF A RECORD REFERENCE IS ALSO PRESENT * EVALUA>TE IT AND CALL FOR ITS POSITION. * IF FILE REFERENCE IS VALID, BUT AT END OF FILE,EXIT TO (P+2). * IF VALID FILE AND RECORD, EXIT TO (P+3). * VLFIL NOP LDA M1000 PRESET FOR NO STA FILE# FILE SPECIFICATION STA FLTYP (NO FILE IS A NON-ZERO FILE) LDB TEMPS IS INB CPB PRADD NEXT JMP VLFI0 LDA 1,I OPERATOR AND OPMSK CPA #OP A '#' ? RSS YES! VLFI0 JMP VLFIL,I NO, EXIT TO (P+1) ISZ TEMPS EVALUATE JSB FETCH FILE REFERENCE JSB SBFIX 15-BIT REFERENCE? JSB ERROR NON-EXISTENT FILE REFERENCED E9 INA ISZ TEMPS POINT TO SEPARATOR JSB FSTAT CHECK FILE STATUS JMP VLFI0 LU I/O ISZ VLFIL FILE I/O, ADJUST RETURN STA FILE# YES, SAVE IT LDA TEMPS,I NEXT AND OPMSK OPERATOR CPA USEOP USING? JSB ERROR YES, WE DONT ALLOW PRINT USING WITH FILE E19 CPA B2000 A COMMA? JMP VLFI3 YES! CCB NO, REQUEST SERIAL RECORD VLFI2 STB RCRD# JSB RQSTR REQUEST A RECORD JMP VLFIL,I PHYSICAL EOF -- TAKE (P+2) EXIT ISZ VLFIL RECORD OK, TAKE (P+3) EXIT JMP VLFIL,I VLFI3 JSB FETCH EVALUATE RECORD REFERENCE JSB SBFIX 15-BIT INTEGER? LDA INF NO, LOAD IMPOSSIBLE RECORD ISZ TEMPS LDB 0 PUT RECORD REFERENCE IN B-REG JMP VLFI2 AND FETCH THE RECORD SKP ********************** * * * REQUEST RECORD * * * ********************** * * IF (B) >= 0 THEN THE RECORD ((B)+1) IS PUT IN THE DCB * AND THE WORD POINTER IS RESET TO THE START OF THE RECORD. * IF (B) = -1, A RECORD IS READ ONLY IF NO RECORD IS IN CORE. * IF (B) = -2, THEN THE NEXT RECORD IS READ.ECORD IS IN CORE. * * IN ALL CASES, AN EXIT TO (P+1) INDICATES THAT END OF FILE * HAS BEENN REACHED, WHILE EXIT TO (P+2) INDICATES THAT * THE REQUESTED RECORD IS IN CORE. * THIS ROUTINE EXITS TO ERROR ON FMGR ERRORS OTHER THAN EOF. * RQSTR NOP INB STB RQ2 SAVE THE RECORD REFERENCE LDB DCB SET UP ADB .16 BUFFER STB TEMP3 ADDRESS ADB M3 FETCH FLAG WORD LDA 1,I FROM DCB ... TO SSA,RSS CHECK "IN-CORE" FLAG JMP RQS15 NOT IN CORE INB RECORD IN CORE LDA RQ2 IS THIS THE RIGHT SSA RECORD JMP RQST6 GET NEXT RECORD SZA,RSS SERIAL FILE OPERATION ? JMP RQXIT INA RANDOM FILE REQUEST CPA 1,I RECORD NUMBERS MATCH ? JMP RQST3 YES ! RQST6 LDB DCB HAS ADB .13 BUFFER LDA 1,I BEEN SLA,RSS WRITTEN ON? JMP RQS15 NO, SO DON'T WRITE AND MNEG YES, CLEAR "WRITTEN-ON" FLAG STA 1,I INB NOW CORRECT CCA RECORD ADA 1,I COUNTER SZA UNLESS STA 1,I START OF FILE ADB M2 RESET LDA DCB WORD ADA .16 LOCATION STA 1,I STA TEMP3 AND BUFFER PTR SKP JSB WRITF WRITE OUT DEF *+6 NEXT DEF DCB,I RECORD DEF FERR DEF TEMP3,I DEF .128 DEF .0 JSB CKERR CHECK FOR ERROR RQS15 LDB DCB ADB .14 SET UP LDA RQ2 NEW RECORD POINTER SZA UNLESS SERIAL I/O SSA OF EITHER KIND RSS STA 1,I JSB READF READ DEF *+4 DEF DCB,I A DEF FERR DEF TEMP3,I RECORD JSB CKERR LDB DCB SET UP ADB .12 BUFFER POINTER LDA 1 TO BEGINNIҕNG ADA .4 OF DATA BLOCK STA 1,I INB LDA MNEG SET "IN-CORE" AND CLEAR STA 1,I "WRITTEN-ON" FLAGS RQXIT ISZ RQSTR RETURN TO P+2 JMP RQSTR,I * RQST3 ADB M2 POINT TO BUFFER POINTER LDA 1 RESET POINTER ADA .4 TO BEGINNING STA 1,I OF DCB JMP RQXIT * CKERR NOP LDA FERR IS THERE CPA M12 PHYSICAL EOF? JMP RQSTR,I YES, RETURN TO P+1 SSA,RSS A FILE MANAGER ERROR? JMP CKERR,I NO! STA TEMP3 YES! JMP OUTER PRINT MESSAGE AND ABORT SKP ********************* * * * FILE VALIDATION * * * ********************* * * CHECK TO SEE IF REQUESTED FILE IS OPEN OR IF IT IS * A LOGICAL UNIT. IF NOT A LU# OR OPEN IT IS AN ERROR. * * ON ENTRY A = FILE REFERENCE # * ON EXIT (P+1) LU# EXIT, A = LU# * (P+2) FILE EXIT, A = FILE REFERENCE # * FSTAT NOP LDB 0 SAVE FILE # ADB M17 IS FILE SSB,RSS NUMBER > 16? JMP FSTA1 YES! CCB CHECK STB FLTYP SET NON-0 FILE TYPE ADB 0 DCB ADB FILBK POINTER TO LDB 1,I SEE IF IT IS SZB,RSS A PERIPHERAL JMP FSTA1 YES, IT IS! SSB OPEN? JSB ERROR NOT OPEN YET! E10 STB DCB YES, SET UP CURRENT DCB PTR ADB .2 GET FILE LDB 1,I TYPE. SZB,RSS TYPE 0? JMP FSTA2 YES ISZ FSTAT NO, TAKE(P+2) EXIT CPB .1 TYPE 1? JMP FSTAT,I YES,EXIT JSB ERROR NO,BAD FILE TYPE E16 EQU * * FSTA2 STB FLTYP SET TYPE 0 FILE FLAG FSTA1 IOR .128 SET V-BIT FOR OUTPUT STA LUOUT IOR B400 AND ECHO BIT FOR INPUT STA LUINP CCA CLEAR STA FILE# FILE I?/O FLAG LDB TEMPS JMP FSTAT,I SKP ***************************** * * * STORE AN ITEM IN A FILE * * * ***************************** * * UPON ENTRY (B) INDICATES WHAT IS TO BE WRITTEN ON THE FILE: * (B) = -1 WRITES AN END-OF-FILE MARK, (B) = -2 WRITESA TWO- * WORD FLOATING POINT NUMBER, (B) = -3 WRITES A STRING. IF * THE RECORD CAN'T ACCOMODATE THE QUANTITY, A SERIAL WRITE * WILL PLACE IT IN THE FOLLOWING RECORD WHILE A RECORD WRITE * WILL EXIT TO THE END-OF-FILE CODE. * FILST NOP STB FILT SAVE REQUEST TYPE LDA DCB GET ADA .12 CURRENT STA TEMP9 POINTER LDB 0,I AND SAVE IT ADA .132 IS CPA 1 RECORD FULL? JMP FILS1 YES! STB DADDR SAVE CURRENT PTR ISZ FILT EOF REQUESTED? JMP FILS2 NO! CCA YES, OVERLAY PREVIOUS STA 1,I EOR OR EOF WITH EOF MARK FILS7 LDB DCB SET ADB .13 BUFFER LDA WRFLG WRITTEN STA 1,I ON BIT ADB M1 IS LDA DCB DCB PACKING ADA .144 BUFFER EXACTLY CPA 1,I FULL? RSS YES! JMP FILST,I NO! JSB POST POST THE DATA DEF *+2 DEF DCB,I JMP FILST,I RETURN * FILS2 ISZ FILT STRING JMP FILS6 YES ADB .2 NO! FILS3 CMA,INA COMPARE PROSPECTIVE ADA 1 CURRENT POINTER CMA,INA END-OF-RECORD POINTER SSA OVERFLOW? JMP FILS0 YES! STB TEMP9,I NO, SAVE NEW CURRENT PTR SZA,RSS RECORD EXACTLY FULL? JMP FILS4 YES! LDA M2 NO, FOLLOW ENTRY SPACE STA 1,I WITH EOR MARK FILS4 ISZ FILT STRING? JMP FILS5 NO! LDA TNULL YES! CMA COMPUTE AND IOR B1000 STORE STRING STA DADDR,I HEADER WORD LDA FSCHA JSB TRSTR TRANSFER STRING JMP FILS7 * FILS5 DLD SBPTR,I TRANSFER DST DADDR,I NUMBER JMP FILS7 * FILS6 INB COMPUTE CLE,ELB DESTINATION STB TEMP5 ADDRESS CMB,INB COMPUTE ADB TNULL RECORD CMB,INB SPACE CLE,ERB REQUIRED JMP FILS3 * FILS0 LDA M2 INSURE EOR MARK STA DADDR,I ENDS PRESENT RECORD ISZ TEMP9 AND THAT THIS LDB WRFLG GETS WRITTEN STB TEMP9,I ON THE DISC ADA FILT RESTORE REQUEST STA FILT TYPE FILS1 CCB CPB RCRD# SERIAL WRITE? RSS YES JMP EOFCK CHECK IF ' IF END#' LDB M2 REQUEST NEXT RECORD JSB RQSTR TO WRITE RSS EOF RETURN JMP FILST+2 NORMAL RETURN, CONTINUE * EOFCK LDA HTEMP RESTORE HIGH STA HSTPT STACK POINTER LDB DCB CHECK ADB .15 STMT LDA 1,I NUMBER SZA,RSS TRANSFER ON EOF JSB ERROR NONE, SO EOF ERROR E11 JMP EGOS3 YES, GO TO IT SKP ******************************* * * ** GET NEXT ITEM IN A FILE ** * * ******************************* * * THE NEXT ITEM IN A FILE, NUMBER, STRING, END--OF-FILE, OR * END-OF-RECORD, IS IDENTIFIED AND UPON EXIT (A) = 1,2,3 OR 4 * RESPECTIVELY. EORFL = -1 WILL IGNORE END-OF-RECORD'S AND * RETURN WITH THE FIRST OF THE OTHER ITEMS ENCOUNTERED. * GTTYP NOP LDA DCB IS ADA .13 THERE LDB 0,I A RECORD SSB,RSS IN CORE? JMP GTTY1 NO! ADA M1 LOAD ACTIVE LDB 0,I AND LIMIT RECORD yHFBBH ADA .132 POINTERS CPA 1 PHYSICAL END-OF-RECORD? JMP GTTY3 YES! LDA 1,I NO, LOAD WORD CLB,INB OF RECORD CPA M2 END-OF-RECORD? JMP GTTY3 YES! CPA M1 END-OF-FILE? JMP GTTY4 YES! AND M256 NO! CPA B1000 STRING? INB YES, (B)=2 GTTY2 LDA 1 SET (A) = (B) JMP GTTYP,I * GTTY3 CCB NO CPB EORFL EOR'S WANTED? JMP GTTY1 NO! LDB .2 GTTY4 ADB .2 (B) = (B) +2 JMP GTTY2 * GTTY1 LDB M2 LDA FILE# REQUEST JSB RQSTR NEXT RECORD RSS EOR JMP GTTYP+1 CLB,INB JMP GTTY4 SKP *************** * * * EXECUTE TAB * * * *************** ETAB NOP JSB .IENT SMALL INTEGER? JMP TABXT NO ADA M73 EXCEED SSA,RSS 72? JMP ETAB1 YES! CMA,INA NO, COMPUTE ADA M73 BLANKS ADA OCCNT REQUIRED ADA TYPE SZA,RSS ARE WE RIGHT ? JMP TABXT YES SSA,RSS TOO FAR TO THE RIGHT ? JMP ETAB2 YES STA TEMP3 NO, DRIFT TO THE RIGHT ETAB0 LDA .32 WRITE BLANKS JSB OUTCR RIGHT ISZ TEMP3 JMP ETAB0 TABXT CLB STB EOL SET TAB FLAG TRUE JMP ETAB,I AND EXIT * ETAB1 JSB OUTLN OUTPUT THE LINE JMP TABXT * ETAB2 LDB TABFG CAN WE SZB LEAN TO THE LEFT ? JMP TABXT NO CMA,INA SAVE NEGATIVE STA TEMP3 BLANK COUNT LDB OCCNT ETAB3 LDA OTBFA,I FETCH LAST WORD SLB LOW OR HIGH BYTE ? ALF,ALF HIGH BYTE -> LOW BYTE AND B377 AND ISOLATE THE BYTE CPA .32 IS IT A BLANK ? RSS YES JMP TABXT NO, QUIT NOW P ADB M1 BACK UP STB OCCNT ONE CHARACTER SLB NEW WORD ? JMP ETAB4 NO LDA OTBFA YES ADA M1 STEP BUFFER POINTER STA OTBFA BACK TOO ETAB4 ISZ TEMP3 COUNT BLANKS REMOVED JMP ETAB3 AND CONTINUE JMP TABXT UNLESS COUNT EXHAUSTED SKP ********************* * ** *** EXECUTE NOT ** ** ** * ********************* * ENOT JSB STTOP LOAD OPERAND JMP EEQL1 ********************* * ** *** EXECUTE AND ** ** * ********************* EAND JSB BINOP VALIDATE JMP *+2 OPERANDS NOP ANDS SZA,RSS FIRST OPERAND ZERO? JMP FALSE YES LDA ANDS-1,I JMP ENEQ1 CHECK SECOND OPERAND ********************* * ** *** EXECUTE OR ** ** * ********************* EOR JSB BINOP VALIDATE JMP *+2 NOP IOR *-1,I TRUE IF EITHER OPND JMP ENEQ1 NON-ZERO. ******************* * * ** EXECUTE MAX ** * * ******************* EMAX JSB BINOP VALIDATE OPERANDS JSB .FSB VMAX NOP SSA,RSS TOP OPERAND LARGER? JMP ARG1 NO! ARG2 DLD VMAX,I YES,RETRIEVE IT! JMP FORM0 * ******************* * * ** EXECUTE MIN ** * * ******************* EMIN JSB BINOP VALIDATE OPERANDS JSB .FSB SUBTRACT THE TWO TOP OPERANDS VMIN NOP SSA,RSS TOP OPERAND LARGER? JMP ARG3 NO! ARG1 LDB HSTPT,I DLD 1,I JMP FORM0 ARG3 DLD VMIN,I JMP FORM0 SKP ****************** * * ** EXECUTE IF ** * * ****************** * EIF DLD TEMPS,I EOF CPB ENDOP OPERATOR? SSA CLA,INA,RSS NO,ALLOW STRING JMP EIF1 YES STA STRFG CONSTANTS! JSB FETCH FETCH VALUE OF F7ORMULA STA EFMT SAVE RESULT FOR SINGLE STEPPING STB NFMT SZA,RSS RESULTANT TRUE? JMP XEC4 NO ISZ TEMPS ADVANCE TO NEXT OPERATOR LDB TEMPS (B) = PTR TO INTERP. CODE JMP SETSX GO EVALUATE 'THEN' PART EIF1 ISZ TEMPS EVALUATE JSB VLFIL FILE REQUEST JMP E9-1 NOT A FILE NOP FOUND AT EOF ISZ TEMPS FOUND LDB DCB SET ADB .15 TRANSFER LDA TEMPS,I IN STA 1,I DATA CONTROL BLOCK JMP XEC4 * * ********************* * * ** EXECUTE GO TO ** * * ********************* * EGOTO CLA SET FLAG TO 'GOTO' MODE JMP EGOS0 FIND REFERENCED STATEMENT SKP ********************* * * ** EXECUTE INPUT ** * * ********************* * EINP1 JSB WDRQS PRINT '?' AS WARNING JSB DRQST YES, CALL FOR MORE JSB QCHEK CHECK FOR STOP CHARACTER EINP2 JSB CONST CONVERT AND STORE NUMBER JMP EINP1 NOT NUMBER LDB TEMPS END-OF- INB CPB PRADD STATEMENT? JMP EIN15 YES CPA .10 NO, INSURE MORE INPUT EINPT JSB DRQST CALL FOR INPUT JSB QCHEK CHECK FOR STOP CHARACTER JSB FORMX COMPUTE VARIABLE ADDRESS LDB HSTPT,I IS IT A SSB STRING VARIABLE? JMP EINP4 YES! ADB M1 STORE ISZ HSTPT ADDRESS-1 IN STB SBPTR POINTER JMP EINP2 * EINP4 CMB EXTRACT LDA 1,I PHYSICAL LENGTH ALF,ALF LENGTH OF AND B377 DESTINATION STRING CMA SET IT AS END ADA TSTPT,I OF UNSPECIFIED STA TPRME DESTINATION STRING CCA PREPARE JSB PSTR DESTINATION STRING LDB TNULL SAVE LENGTH STB TEMP7 / ALLOWANCE EIN14 JSB GETCR FETCH CHARACTER NOP CPA B42 QUOTE? RSS YES! JSB BCKSP NO,STRING BEGINS HERE CLB TURN OFF STB BLANK SUPPRESSION LDA FINCA ADDRESS OF INPUT ROUTINE JSB TRSTR TRANSFER STRING CLB ALL REQUESTED CPB TNULL CHARACTERS TRANSFERRED JMP EIN10 YES! CPB PS1 NO,TRANSFER LENGTH SPECIFIED JMP EINP9 NO STA TEMP7 YES, SAVE (A) CCA FINISH STA TPRME ADA TNULL TRANSFER STA TNULL LDA FSCHA WITH BLANKS JSB TRSTR LDA TEMP7 RESTORE (A) EINP7 CPA .10 TRANSFER ENDED BY END-OF-INPUT JMP EIN13 YES! EINP8 JSB GETCR NO, WAS IT A QUOTE LDA .10 EXIT WITH JMP EIN13 NEXT CHARACTER EINP9 LDB TEMP6,I SET LOGICAL ADB TNULL TO ACTUAL STB TEMP6,I STRING LENGTH JMP EINP7 EIN10 CPB PS1 LENGTH OF STRING SPECIFIED? JMP EIN12 NO! EIN11 JSB GETCR YES! JMP EIN13 IMPLIED CLOSING QUOTE CPA B42 QUOTE? JMP EINP8 YES! JMP EIN11 NO, LOOK FOR " OR END-OF-INPUT EIN12 JSB GETCR END-OF-INPUT NEXT? JMP EIN13 YES! CPA B42 NO,CLOSING QUOTE? JMP EINP8 YES! LDA TEMP7 NO, DESTINATION STRING EXCEEDED! STA TNULL RESTORE LDA SBPTR DESTINATION STRING STA TEMP5 PARAMETERS LDA B40 SET TO SKIP BLANKS STA BLANK JSB WDRQS PRINT EXTRA QUESTION MARK AS WARNING JSB DRQST GET A NEW DATA RECORD JSB QCHEK AND CHECK FOR STOP CHARACTER JMP EIN14 * EIN13 LDB B40 RESTORE STB BLANK BLANK SUPRESSION JMP EINP2+2 * EIN15 LDA LUINP ANY STA LUOUT PARTIAL JSB FLUPT LINES SZA,RSS LEFT? JMP XEC4 NO! CLA YES! STA 1,I JMP XEC4 * QCHEK NOP LDA .INBF,I FETCH FIRST WORD ALF,ALF POSITION FIRST BYTE AND B377 AND ISOLATE IT CPA CTRLQ IS IT A '^Q' ? JMP OPEND YES, TAKE ORDERLY ABORT EXIT JMP QCHEK,I NO, RETURN SKP * ******************** * * ** EXECUTE TRAP ** * * ******************** * ETRAP NOP RSS SKIP ERROR MESSAGE IF NOT BUSY JSB ERROR TRAP TABLE BUSY TERR4 EQU * JSB FETCH GET TRAP # JSB IFIX MAKE INTEGER CMA,INA MAKE NEGATIVE STA TEMP4 SAVE IT LDB TEMPS ADB .2 SKIP OVER 'GOSUB' AND FLAG LDA 1,I GET SEQ NO. LDA 0,I STA TEMP5 SAVE IT SSA POSITIVE? CMA,INA NO, MAKE IT SO JSB FNDPS MAKE SURE JMP E12-1 STATEMENT JMP E12-1 EXISTS LDB TEMP5 GET SEQ NO. LDA TEMP4 GET TRAP NO. JSB TRAP SET UP TRAP VS. SEQ NO. TRERR RSS TRAP ERROR JMP XEC4 CPA .1 TRAP TABLE FULL? JSB ERROR YES! TERR1 CPA .2 ILLEGAL TRAP COMBINATION? JSB ERROR YES! TERR2 JSB ERROR NO, MUST BE SCHEDULED BUT DELETED TASKED TERR3 EQU * SKP ********************* * * ** EXECUTE GOSUB ** * * ********************* * EGOSB CCA SET FLAG TO EGOS0 STA RFLAG 'GOSUB' MODE LDA 1,I INB SIMPLE BRANCH AND OPDMK STATEMENT? CPA INTFL JMP EGOS1 YES! JSB FETCH NO, COMPUTE JSB SBFIX BRANCH INDEX JMP XEC4 UNSUITABLE RESULT LDB 0 BLS COMPUTE ADB TEMPS 'ADDRESS' ADB .2 ADDRESS LDA 1 CMA WITHIN ADA PRADD STATEMENT RANGE SSA  JMP XEC4 NO! EGOS1 LDA 1,I YES, LOADR BRANCH ADDRESS ISZ RFLAG 'GOTO' MODE? JMP EGOS3 YES LDB NXTST LOAD (B) WITH EGOS2 STA NXTST RETURN SEQUENCE NUMBER JSB SLWST STACK RETURN ON LOW-CORE STACK ADA M21 GOSUBS NESTED 20 DEEP? CPA LSTAK JSB ERROR YES! E2 JMP XEC4 NO! EGOS3 STA NXTST SAVE STMT # JMP XEC4 EXECUTE IT * EGOS4 STB TEMP7 SAVE TRAP FLAG JSB FNDPS FIND ADDRESS NOP OF TRAP JSB ERROR GOSUB STMT NUMBER E12 EQU * LDA 1 LDB TEMP7 RESTORE TRAP FLAG JMP EGOS2 * * *********************** * * ** EXECUTE RESTORE ** * * *********************** * ERSTR LDA TEMPS,I CHECK TO SEE ISZ TEMPS IF THERE IS ANY LDB DSTRT DATA STATEMENTS CPB M1 IMPOSSIBLE ADDRESS? JMP XEC4 YES, SO IGNORE IT SSA,RSS FOLLOWED BY SEQ NUMBER JMP E7 NO! LDA TEMPS,I YES, SO USE IT STA 1 SET B TO STMT ADDRESS ADA .2 NOW CHECK TO LDA 0,I SEE IF AND OPMSK THIS IS CPA DATOP A DATA STATEMENTNT RSS YES IT IS! JSB ERROR NO, NOT A DATA STMNT E7 JSB SETDP SET DATA POINTERS JMP XEC4 DONE * ** *** EXECUTE A BINARY OPERATOR ** ** BINOP NOP JSB OPCHK VALIDATE TOP (SECOND) OPERAND LDA BINOP INA STB 0,I POST ITS ADDRESS ISZ HSTPT UNSTACK ADDRESS JSB STTOP LOAD & VALIDATE FIRST OPERAND JMP BINOP,I * ** *** EVALUATE FORMULA AND RETURN RESULT ** ** FETCH NOP JSB FORMX EVALUATE FORMULA JSB OPCHK ISZ HSTPT UNSTACK RESULT ADDRESS DLD 1,I LOAD (A&B) WITH VALUE JMP FETCH,I EXIT SKP ******************************** * < * ** EXECUTE SUBSCRIPT COMMA ** * * ******************************** ESCMA JSB ESBS INTEGERIZE COLUMN SUBSCRIPT ISZ LSTPT JSB ESBS INTEGERIZE ROW SUBSCRIPT LDB HSTPT,I SSB STRING VARIABLE? JMP ESCM2 YES! ADB .2 FETCH SUBSCRIPT LDA 1,I BOUNDS AND B377 EXTRACT STA OUTLN COLUMN BOUND LDA 1,I EXTRACT ALF,ALF ROW AND B377 BOUND CMA,INA ACTUAL ADA LSTPT,I ROW SUBSCRIPT SSA,RSS LEGAL? JMP E6-1 NO. ERROR 49. LDA LSTPT,I CLB,INB CPB OUTLN COLUMN MATRIX? JMP ESCM1 YES. MPY OUTLN NO, COMPUTE ADDRESS * DISPLACEMENT DUE TO ROWS ESCM1 CCB UNSTACK ADB LSTPT ROW STB LSTPT SUBSCRIPT LDB OUTLN ACTUAL CMB,INB COLUMN ADB LSTPT,I SUBSCRIPT SSB,RSS LEGAL? JSB ERROR NO. ERROR 49. E6 ADA LSTPT,I YES, ADD IN COLUMN DISPLACEMENT ALS DOUBLE DISPLACEMENT LDB HSTPT,I COMPUTE ADA 1,I ACTUAL STA HSTPT,I ADDRESS STB TEMP7 AND SAVE BASE FOR ECALL CCB ADB LSTPT UNSTACK STB LSTPT * JMP FORM1 GO TO FORMULA PROCESSOR * ESCM2 JSB RSCHK PUT STRING LDB M2 SUBSCRIPTS ADB LSTPT ON STB LSTPT TEMPORARY INB STACK DLD 1,I RRR 16 CORRECT ORDER DST TSTPT,I OF SUBSCRIPTS JMP FORM1 SKP ** *** INTEGERIZE A SUBSCRIPT ** ** ESBS NOP JSB OPCHK VALIDATE SUBSCRIPT DLD 1,I FETCH SUBSCRIPT JSB .IENT INTEGER? JMP E6-1 NO. ERROR 49. SEZ,RSS YES, ROUND AND ADA M1 BIAS BY -1 K1 SSA POSITIVE INTEGER? JMP EBS1 CHECK FOR NEG SUBSCRIPT ERROR EBS2 STA LSTPT,I SAVE IN OPERATOR STACK ISZ HSTPT POP OPERAND STACK JMP ESBS,I EBS1 LDB HSTPT IS THIS ADB .2 A STRING LDB 1,I VARIABLE? SSB,RSS JMP E6-1 NO, ERROR NEG SUBSCRIPT! CPA M1 IF STRING -1 JMP EBS2 IS OK JMP E6-1 EVERY OTHER NEG VALUE BAD ** *** EXECUTE STORE ** ** ESTR LDB TEM10 IS NEXT OPERATOR SZB AN END-OF-FORMULA? JMP FOR10 NO, DEFER STORE CPB TEMP5 YES, FIRST STORE OPERATOR USED? JMP ESTR2 YES ESTR1 LDA HSTPT,I SET STA TEMP8 DESTINATION LDA TEMP5 SOURCE ADDRESS IN (A) LDB 0,I TRANSFER HIGH STB TEMP8,I PART OF SOURCE STB EFMT ISZ TEMP8 UPDATE INA POINTERS LDB 0,I TRANSFER LOW STB TEMP8,I PART OF SOURCE STB NFMT ISZ HSTPT POP STACK JMP FOR11 RETURN TO FORMULA OCESSOR * ESTR2 LDA HSTPT,I STRING OPERANDS SSA JMP ESTR3 YES! JSB OPCHK SAVE ADDRESS STB TEMP5 OF QUANTITY ISZ HSTPT POP HIGH-CORE JMP ESTR1 STACK AND EXECUTE STORE * ESTR3 LDA M2 PREPARE JSB PSTR SOURCE STA TEMP8 STRING STB TPRME CCA PREPARE JSB PSTR DESTINATION STRING LDB PBPTR SAVE CORE POINTER STB EST1 LDA TEMP8 TRANSFER CMA TO ADA TEMP5 HIGHER SSA CORE? JMP ESTR4 NO ADA TPRME YES ADA .2 OVERLAPPING SSA,RSS TRANSFER? JMP ESTR4 NO LDA TEMP5 YES, SAVE STA EST2 DESTINATION ADDRESS INB SET DESTINATION BLS ADDRESS TO START STB TEMP5 OF FREE CORE LDA TNULL SAVE TRANSFER STA EST3 LENGTH CMA,INA ALLOCATE ARS SPACE FOR JSB OVCHK INTERMEDIATE LDA FSCHA STRING JSB TRSTR TRANSFER STRING TO FREE CORE LDA EST3 RESTORE TRANSFER STA TNULL LENGTH STA TPRME RESET ACTUAL SOURCE LENGTH LDA EST1 SET SOURCE INA ADDRESS TO ALS INTERMEDIATE STA TEMP8 STRING LDA EST2 RESTORE ORIGINAL STA TEMP5 DESTINATION STRING ESTR4 LDA FSCHA JSB TRSTR COMPLETE TRANSFER LDA EST1 RESTORE FREE STA PBPTR CORE POINTER JMP FORM9 EXECUTE END-OF-FORMULA ISZ PBPTR DEFER ISZ PBPTR EXECUTION LDA BASSO GUARANTEE ASSIGNMENT STA PBPTR,I OPERATOR ON STACK JMP FORM4+6 * BASSO OCT 7402 EST1 BSS 1 EST2 BSS 1 EST3 BSS 1 TNULL BSS 1 TPRME BSS 1 CP0 BSS 1 CP1 BSS 1 SKP ***************** * * *** CALL ADD ** * * ***************** * EFAD JSB BINOP JSB .FAD NOP JMP FORM0 ********************** * * ** CALL SUBTRACT ** * * ********************** * EFSB JSB BINOP GET OPERAND DIFFERENCE JSB .FSB NOP JMP FORM0 ********************** * * ** CALL MULTIPLY ** * * ********************** * EFMP JSB BINOP JSB .FMP NOP JMP FORM0 ********************** * * ** CALL DIVIDE ** * * ********************** * EFDV JSB BINOP JSB .FDV NOP JMP FORM0 SKP ********************** * * ** EXECUTE ^ ** * * ********************** * EPWR JSB BINOP EVALUATE ARGUMENTS JMP *+2 EPWRA N.KOP ADDRESS OF POWER STA UTEMP SAVE BASE STB UTEMP+1 SZA BASE ZERO? JMP PCHK1 NO LDA EPWRA,I BASE ZERO; SZA,RSS IS POWER ZERO? JSB ERROR YES! POWER SSA,RSS NO; POWER POSITIVE? JMP FALSE YES, RETURN ZERO JSB ERROR NO, ERROR! ZRTNG LDA INF USE POSITIVE LDB M2 INFINITY JMP FORM0 * PCHK1 DLD EPWRA,I FETCH POWER JSB .IENT INTEGERIZE JMP EPWR2 OVERFLOW CPA MNEG OVERFLOW? JMP EPWR2 YES SOS BITS LOST? JMP EPWR1 NO, IS INTEGER. EPWR2 LDA UTEMP REAL POWER. FETCH BASE LDB UTEMP+1 SSA NEGATIVE BASE? JSB ERROR YES. ERROR 51. BASER EQU * JSB ALOG TAKE NATURAL LOG OF BASE JSB ERROR LOG ERROR LOGER EQU * JSB .FMP MULTIPLY BY POWER DEF EPWRA,I JSB EXP EXPONENTIATE JSB ERROR EXP ERROR EXPER JMP FORM0 * EPWR1 STA TT1 INTEGER; CALC BY MULTIPLICATION. LDB HONE INITIALIZE RESULT TO 1.0 STB TT3 LDB .2 STB TT4 SSA CMA,INA TAKE ABSOLUTE VALUE IPWR1 SLA,RSS TEST (SHIFTED) POWER JMP IPWR3 WAS EVEN. STA TT2 LDA UTEMP LOAD BASE LDB UTEMP+1 JSB .FMP MULTIPLY RESULT-SO-FAR DEF TT3 STA TT3 SAVE PARTIAL STB TT4 RESULT LDA TT2 IPWR3 ARS STA TT2 SZA,RSS DONE? JMP IPWR4 YES. LDA UTEMP LOAD BASE LDB UTEMP+1 JSB .FMP SQUARE IT DEF UTEMP STA UTEMP STB UTEMP+1 LDA TT2 JMP IPWR1 * IPWR4 LDA TT1 GET ORIGINAL POWER SSA POSITIVE POWER? JMP IPWR5 NEGATIVE. RETURN RECIPROCAL. LDA TT3 YES,LOAD LDB TT4 RESULT JMP FORM0 * IPWR5 LDA HONE LOAD LDB .2  1.0 JSB .FDV DIVIDE BY RESULT DEF TT3 JMP FORM0 RETURN RESULT * * ****************** * * ** EXECUTE <= ** * * ****************** ** ELORE JSB COMPR COMPARE OPERANDS SSA < ? JMP TRUE NO! JMP EEQL+1 YES! ** SKP ***************** * * ** EXECUTE = ** * * ***************** ** EEQL JSB COMPR COMPARE OPERANDS EEQL1 SZA EQUAL? JMP FALSE NO! JMP TRUE YES! ** ***************** * * ** EXECUTE # ** * * ***************** ** ENEQL JSB COMPR COMPARE OPERANDS ENEQ1 SZA NOT EQUAL? JMP TRUE NO! JMP FALSE YES! ** ***************** * * ** EXECUTE > ** * * ***************** ** EGTRT JSB COMPR COMPARE OPERANDS SSA < ? JMP FALSE YES! JMP ENEQL+1 NO! ** ***************** * * ** EXECUTE < ** * * ***************** ** ELST JSB COMPR COMPARE OPERANDS CMA,RSS ** ****************** * * ** EXECUTE >= ** * * ****************** ** EGORE JSB COMPR COMAPARE OPERANDS SSA < ? JMP FALSE YES! JMP TRUE NO! ** FALSE CLA LOAD CLB ZERO JMP FORM0 ************************ ** *** EXECUTE UNARY - ** ** ************************ EUMIN JSB STTOP LOAD NUMBER JSB ..FCM NEGATE IT JMP FORM0 ***************************** ** *** EXECUTE LEFT BRACKET ** ** ***************************** ELBRC ISZ LSTPT LOAD SUBSCRIPT COMMA LDB SCCNT INFORMATION WORD JSB SLWST STACK IT JSB BHSTP BUMP STACK JSB RSCHK LDA HSTPT IS THIS ADA .2 A STRING LDA 0,I VARIABLE? SSA JMP _ELB1 YES TRUE LDA HONE NO,ARRAY SO LDB .2 LOAD DEFAULT 0 JMP FORM0 ELB1 CLA SET DEFAULT CLB SUBSCRIPT TO BE JMP FORM0 FINALLY -1 SKP * *********************************** * * * COMPARE TOP OPERANDS ON STACK * * * *********************************** * * ON EXIT (A) IS NEGATIVE IF THE TOP OPERAND OF THE * STACK IS GREATER THAN THE NEXT-TO-TOP OPERAND AND * POSITIVE IF IT IS LESS, AND ZERO IF THEY ARE EQUAL. * COMPR NOP LDA HSTPT,I STRING SSA ARGUMENTS? JMP COMP1 YES! JSB BINOP NO, COMPARE JSB .FSB NUMERICAL NOP JMP COMPR,I OPERANDS SPC 1 COMP1 LDA M2 PREPARE JSB PSTR COMPARISON STA TEMP8 STRING STB TPRME LDA TNULL SAVE SPECIFIED STA CP0 LENGTH LDA M2 PREPARE JSB PSTR TEST STRING STB CP1 SAVE ACTUAL LENGTH ISZ TSTPT RESERVE SPACE ISZ TSTPT FOR RESULT JSB BHSTP BUMP HI STACK COMP2 ISZ CP0 MORE SPECIFIED STRING JMP COMP3 YES! CLB NO, LOAD A NULL JMP COMP4 CHARACTER COMP3 JSB FSCH LOAD NEXT LDA B40 COMPARISON LDB 0 CHARACTER COMP4 ISZ TNULL MORE SPECIFIED TEST STRING? JMP COMP6 YES! CLA NO, LOAD NULL CHARACTER COMP5 CMB,INB COMPARE ADA 1 CHARACTERS SZA,RSS EXIT ON NOT EQUAL SZB,RSS OR BOTH NULL JMP COMPR,I CHARACTERS JMP COMP2 COMP6 LDA CP1 MORE ACTUAL INA,SZA TEST STRING? JMP COMP7 YES! LDA B40 NO, LOAD A BLANK JMP COMP5 COMP7 STA CP1 LDA TEMP5 EXTRACT CLE,ERA LDA 0,I NEXT SEZ,RSS NLHALF,ALF TEST AND B377 ISZ TEMP5 CHARACTER JMP COMP5 * * ** ************************** * * *** FETCH A DATA ITEM ** * * ************************** * GN* UPON ENTRY (B)=1 IF NUMBER IS REQUESTED OR (B)=2 IF A * STRING IS REQUESTED. TYPE MATCH IS CHECKED. NUMBERS RETURN * IN (A) AND (B) STRINGS ARE PREPARED A SOURCE STRINGS. * FDATA FILLS FROM A FILE IF ONE IS REFERENCED BY THE CALLER. * FDATA MOVES TO NEW FILE RECORDS OR AS NECESSARY. * ** FDATA NOP STB TEMP8 SAVE DATA TYPE LDA FILE# READ FROM SSA,RSS FILE? JMP FDAT4 YES! FDAT1 ISZ DCCNT MORE DATA? JMP FDAT2 YES LDA DATA NO, SEARCH LDB NXTDT FOR NEXT JSB STSRH DATA STATEMENT JSB ERROR NONE FOUND. ERROR 56 E4 JSB SETDP INITIALIZE THE JMP FDAT1 DATA POINTERS * FDAT2 LDB TEMP8 RESTORE TYPE ISZ DCCNT UPDATE LDA NXTDT,I POINTER ISZ NXTDT CORRECT RBR TYPE XOR 1 OF DATA? SSA JSB ERROR NO! E5 SSB,RSS YES, STRING? JMP FDAT3 YES! DLD NXTDT,I LOAD ISZ NXTDT DATA ISZ NXTDT UPDATE POINTER ISZ DCCNT AND COUNTER JMP FDATA,I FDAT4 LDB RCRD# GET TYPE STB EORFL OF NEXT ITEM JSB GTTYP IN FILE CPA TEMP8 MATCHING TYPES? JMP FDAT6 YES! CPA .4 NO, END-OF-RECORD? JMP EOFCK YES, EOR ERROR CPA .3 NO, END-OF-FILE? JMP EOFCK YES, CHECK FOR TRANSFER TO STMT JMP E5-1 WRONG DATA TYPE! FDAT6 LDB DCB LOAD DATA ADB .12 ADDRESS STB TEMP3 LDB 1,I LDA .2 IS IT CPA TEMP8 STRING? JMP FDAT7 YES! ISZ TEMP3,I ADJUST RECORD PTR ISZ TEMP3,I PAST DATA DLD 1,I NO, LOAD NUMBER JMP FDATA,I FDAT7 LDA 1,I LOAD STRING HEADER INB SET CLE,ELB SOURCE STB TEMP8 ADDRESS CLE,ERB AND B377 SET CMA 6 TRANSFER STA TPRME LENGTH CMA,INA ADJUST ARS RECORD ADB 0 PAST STB TEMP3,I STRING JMP FDATA,I FDAT3 LDA NXTDT,I SET ISZ NXTDT LDB NXTDT START-OF-STRING RBL CHARACTER STB TEMP8 ADDRESS AND B377 SET CMA TRANSFER STRING STA TPRME LENGTH CMA,INA UPDATE ARS LDB 0 ADA NXTDT DATA STA NXTDT ADB DCCNT STB DCCNT POINTERS JMP FDATA,I SKP ** *** SET FOR FOLLOWING STATEMENT ** ** FLWST NOP (B) HOLDS PRESENT ADDRESS LDA 1 COMPUTE INA ADDRESS LDA 0,I OF ADA 1 NEXT STA PRADD STATEMENT CPA PBPTR END OF PROGRAM? CLA YES, SET LINE NO. TO 0 STA NXTST NEXT SEQ NUMBER ADB .2 FETCH STB TEMPS FIRST WORD LDA 1,I OF CURRENT JMP FLWST,I STATEMENT * ** *** SEARCH STACK FOR GIVEN FOR-VARIABLE ** ** FVSRH NOP LDA TEMPS,I FETCH AND B777 FOR-VARIABLE STA ETAB SAVE FOR-VARIABLE JSB SSYMT FIND ADDRESS IN INB SYMBOL TABLE LDA HSTPT SAVE STA TEMP3 STACK TOP FVSR1 CPA SYMTF STACK BOTTOM? JMP FVSRH,I YES, EXIT VIA (P+1) CPB 0,I MATCHING FOR-VARIABLE? JMP FVSR2 YES ADA .6 NO, MOVE TO JMP FVSR1 NEXT STACK ENTRY * FVSR2 ISZ FVSRH EXIT JMP FVSRH,I VIA (P+2) SKP * ********************************************** * * * EXECUTE STATEMENTS IN OVERFLOW SEGMENT 8 * * * ********************************************** * ******************** * * E* EXECUTE ASSIGN * * * ******************** * EASSN CLA,INA SET TO STA STRFG ALLOW STRINGS JSB FORMX GET ADDRESS OF LDA M2 PREPARE JSB PSTR STRING ADRESS AND LENGTH STA TEMP7 ADDRESS STB TEMP6 LENGTH JSB FORMX GET ADDRESS LDB HSTPT,I OF FILE STB TEMP8 NUMBER ISZ TEMPS JSB FORMX GET ERROR LDB HSTPT,I RETURN STB TEMP9 ADDRESS LDA HSTPT RESET HI STK ADA .2 POINTER STA HSTPT CLA,INA JMP SEG8 FINISH UP EXECUTION * * ******************* * * * EXECUTE PAUSE * * * ******************* * EPAZ LDA .2 GO TO RSS SEGMENT 8 * * ********************** * * * EXECUTE END/STOP * * * ********************** * EEND LDA .3 GO TO RSS SEGMENT 8 SKP * * ******************************** * * * EXECUTE OPERATOR ATTENTION * * * ******************************** * OPEND LDA .4 GO TO CLB SEGMENT 8 STB TEMP3 CLEARING ERROR FLAG * * SEG8 STA SLSTM SET SLOW STATEMENT FLAG LDB .8 JMP SGMNT LOAD SEGMENT #8 TO EXECUTE SKP ******************** * * * EXECUTE CALL * * * ******************** * * * THE GENERAL FLOW THRU ECALL IS AS FOLLOWS: * * 1. CONTROL IS PASSED TO ECALL OR FCALL WHEN A * CALL OR FORTRAN FUNCTION IS FOUND RESPECTIVELY. * * 2. IF IT IS A CALL THEN THE SIMULATE FLAG IS CHECKED * AND IF SET CONTROL IS PASSED TO SEGMENT 7 TO SIMULATE * THE CALL STATEMENT. * * 3. THEN THE PARAMETERS OF THE CALL ARE STACKED ONE BY ONE * ON THE HIGH STACK. EACH PARAMETER IS A THREE WORD ENTRY. * THE DESCRIPTOR TRIPLET HAS THE FOLLOWING FORM, DEPENDING ON * THE PARAMETER TYPE DISCOVERED BY ECALL: * * SIMPLE VARIABLES ARRAYS STRINGS * ---------------------------------------------------------- * HSTPT+2 ! ARGUMENT POINTER ! ELEMENT POINTER ! -BASE ADDRESS - 1 ! * !----------------------------------------------------------! * HSTPT+1 ! ARGUMENT POINTER ! ARRAY BASE PTR ! CHARACTER ADDRESS ! * !----------------------------------------------------------! * HSTPT ! 2:REAL / 1:INTG ! ARRAY SIZE (WDS)! -STRG LNGTH (CHAR)! * ---------------------------------------------------------- * * 4. FOR FORTRAN FUNCTIONS THE SAME THINGS ARE DONE FOR * PARAMETERS BUT THE CALL # AND PARAMETER COUNT FROM THE * INTERPRETIVE CODE IS STACKED ON THE LOW STACK. DURING * EXECUTION OF THE STATEMENT THE INTERMEDIATE RESULTS ARE * STACKED ON THE TEMPORARY STACK AND POPPED OFF AS REQUIRED. * * 5. AFTER SCANNING THE LIST, THE * PARAM CT. IS PUT ON THE HIGH STACK. AT THIS TIME THE * HIGH STACK CONTAINS THE PARAMETER COUNT AND THREE WORD ENTRIES * FOR EACH OF THE PARAMETERS ALL IN REVERSE ORDER ON THE HIGH * STACK. I.E. LAST PARAMETER ON TOP. * * 6. NEXT THE SUBROUTINE NUMBER IS USED TO FIND THE * CORRECT BRANCH TABLE ENTRY AND THE CONTROL WORD AND * PARAMETER CONVERSION WORDS ARE RETRIEVED FROM THE TABLE. * FROM THE CONTROL WORD, THE NAME OF THE OVERLAY IS BUILT, * AND THE SUBROUTINE NUMBER IS SAVED FOR THE OVERLAY. SKP * 7. THEN THE PARAMETERS ARE WRITTEN OUT TO SYSTEM AVAILABLE * MEMORY WITH CLASS I/O. THE FIRST RECORD WRITTEN IS THE HIGH * STACK WHICH IS USED BY THE OVERLAY AS A PARAMETER DESCRIPTION. * THEN EACH PARAMETER IS WRITTEN OUT, ACCORDING TO THE TABLE * ON THE NEXT PAGE. * * 8. THE OVERLAY IS THEN SCHEDULED. THE OVERLAY READS IN * ALL PARAMETERS FROM SYSTEM AVAILABLE MEMORY, BUILDS * A SUBROUTINE CALL PARAMETER ADDRESS LIST, INTEGERIZES AS * REQUIRED, AND TRANSFERS CONTROL TO THE SUBROUTINE * SPECIFIED BY THE BRANCH TABLE CONTROL WORD. * * 9. UPON COMPLETION OF THE SUBROUTINE THE PARAMETERS ARE * RECONVERTED AS REQUIRED, AND WRITTEN OUT USING * CLASS I/O TO SYSTEM AVAILABLE MEMORY. * CONTROL IS THEN RETURNED TO BASIC AND * THE PARAMETERS ARE READ IN FROM SYSTEM AVAILABLE MEMORY * AND PLACED BACK INTO THEIR RESPECTIVE PLACES, IF THE * RETURNED VALUE FLAG IS SET FOR THAT PARAMETER, AND IF * THE SUBROUTINE RETURNED NO ERROR FLAG. * * 10. CONTROL IS THEN PASSED TO THE NEXT STATEMENT FOR CALLS, AND * BACK INTO THE FORMX ROUTINE FOR FORTRAN FUNCTIONS, UNLESS * AN ERROR OCCURRED. * * ERROR CONDITIONS FROM THE OVERLAY ARE ALWAYS FATAL FOR * FORTRAN FUNCTIONS, AND ARE FATAL FOR CALLS UNLESS * THE BASIC PROGRAM LINE CONTAINS A "FAIL:" STATEMENT. * FOREGROUND/BACKGROUND COMMUNICATION ERRORS AND * OVERLAY ABORT ERRORS ARE ALWAYS FATAL. SKP * THIS TABLE DESCRIBES THE ACTION OF ECALL IN TRANSFERRING * ARGUMENTS FROM THE PARAMETER LIST SPECIFIED IN THE BASIC * PROGRAM TO THE OVERLAY ROUTINE IN THE FOREGROUND. * * THE ACTION TAKEN BY THE INTERPRETER DEPENDS ON THE CONTENTS * OF THREE PARAMETER CONVERSION WORDS OBTAINED FROM THE * BRANCH TABLE, SPECIFYING THE ATTRIBUTES OF THE ARGUMENTS * EXPECTED BY THE OVERLAY ROUTINE: * WORD 0 -- ROUTINE CONTROL WORD * WORD 1 -- ARRAY IDENTIFIER WORD * WORD 2 -- RETURNED VALUE WORD * WORD 3 -- INTEGER CONVERSION WORD * * * FORMAL * ARGUMENT : ARRAY/SIMPLE RETURN/NO INTEGER/REAL * ACTUAL !--------------------------------------------------------! *  ARGUMENT: ! ! ! FIX ON CALL ! * SIMPLE ! PASS VARIABLE ! SAVE RETURN ! AND ! * VARIABLE ! ! IF BIT = 1 ! FLOAT ON RETURN ! * !--------------------------------------------------------! * ! PASS ARRAY IF 1 ! PASS VALUE(S) ! FIX ALL VALUES ! * ARRAY ! WITH POINTER TO ! SAVE RETURN(S)! AND ! * VARIABLE ! GIVEN ELEMENT ! IF BIT = 1 ! FLOAT ON RETURN ! * ! PASS ELEMENT IF 0 ! ! ! * !--------------------------------------------------------! * ! PASS STRING OR ! ! \ / ! * STRING ! SUBSTRING IF 1 ! SAVE STRING ! \/ ! * VARIABLE ! PASS 2 CHARACTERS ! OR SUBSTRING ! /\ ! * ! IF 0 ! IF 1 ! / \ ! * !--------------------------------------------------------! * ! PASS STRING OR ! SYNTAX ERROR ! \ / ! * STRING ! SUBSTRING IF 1 ! IF BIT = 1 ! \/ ! * CONSTANT ! PASS 2 CHARACTERS ! PASS ONLY IF 0 ! /\ ! * ! ! ! / \ ! * !--------------------------------------------------------! * ! ! SYNTAX ERROR ! FIX ON CALL ! * SIMPLE ! PASS CONSTANT ! IF BIT =1 ! AND ! * CONSTANT ! ! PASS ONLY IF 0 ! FLOAT ON RETURN ! * ! ! ! IF BIT = 1 ! * !--------------------------------------------------------! * ! SYNTAX ERROR ! ! ! * REAL ! IF BIT = 1 ! SYNTAX ERROR ! FIX VALUE ! * EXPRESSION 3  ! PASS VALUE IF ! IF BIT = 1 ! ON CALL ! * ! BIT = 0 ! ! ! * !--------------------------------------------------------! SKP ECALL LDA SMFLG SZA,RSS JMP CALL0 LDA NXTST CMA,INA STA NXTST SEG7 LDB .7 LOAD SEGMENT #7 JMP SGMNT * CALL0 JSB BHSTP FCALL LDA FORMX SAVE RETURN STA HSTPT,I FROM FORMX LDB TEMPS,I STACK CALL ID WORD JSB SLWST ON LOW STACK CLB JSB SLWST INIT ARGUMENT CNTR INB & STB STRFG STRING FLAG CALL2 ISZ TEMPS FETCH NEXT CALL3 LDA TEMPS,I INTERPRETIVE WORD SZA,RSS NULL? JMP CBKSP YES,BACK UP 1 CPA LFPAR SUBCRIPTED VARIABLE? JMP CBKSP YES, BACK UP TO OPND-ID AND OPMSK CPA B4000 RIGHT PARENTHESIS? JMP CALL5 YES, END OF LIST JSB FORMX EVALUATE ARGUMENT * LDA HSTPT,I FETCH ARGUMENT ADDRESS SSA STRING? JMP STVAL YES CMA NO, CHECK FOR ARRAY LDB PBPTR LOW END OF ARRAY STORAGE ADB 0 SSB,RSS ABOVE? JMP CSVAL NO,MUST BE CONSTANT LDB FCORE HIGH END OF ARRAY STORAGE ADB M2 DECREMENT FOR 1'S COMP -1 ADB 0 SSB ABOVE? JMP COVAL YES, MUST BE INTERMED,COMMON OR VAR. COVAR LDB TEMP7,I NO, FETCH ARRAY BASE ADDR FROM SYM TBL ISZ TEMP7 POINT TO ARRAY SIZE LDA TEMP7,I FETCH ARRAY SIZE STB TEMP7 SAVE BASE ADDR TEMPORY CLB MULTIPLY RRR 8 COLUMN * BLF,BLF ROW STB TEMP3 TO CALCULATE MPY TEMP3 ARRAY SIZE. RRR 15 CONVERT SIZE TO WORDS IN B LDA TEMP7 FETCH BASE ADDR JMP CSVPT PUT BASE ADDR & SIZE ON HISTK. * COVAL LDB SYMTA IS H ADB M1 THE ADB 0 POINTER SSB TO A COMMON VARIABLE? JMP COVAR YES! * CSVAL CMA BACK TO ADDRESS LDB .2 LENGTH =2 CSVPT STB TEMP3 SAVE SIZE TEMPORARY JSB BHSTP STA HSTPT,I SAVE BASE OR CHAR ADDR JSB BHSTP LDA TEMP3 SAVE LENGTH STA HSTPT,I +=WORDS, -=CHARS ISZ LSTPT,I ADD TO ARG COUNT JMP CALL2 CHECK FOR MORE * STVAL LDA M2 SOURCE STRING FLAG JSB PSTR PREPARE STRING. RTN A=ADDR, B=LENGTH SWP EXCHANGE REGS CMA STA TEMP7 SAVE ACTUAL STRING LEN LDA TEMP6,I GET ARRAY DIMENSION AND HIMSK AND ADA TEMP7 STUFF IN ACTUAL LENGTH STA TEMP3 AND SAVE LOGICAL-PHYSICAL LENGTH SWP JSB BHSTP UNDO STACK BUMP FROM PSTR JMP CSVPT+1 SAVE IT ALL ON HISTK * CBKSP LDB TEMPS BACK UP ADB M1 TO LAST STB TEMPS INTERPRETIVE JMP CALL3 WORD * * END OF ARGUMENT SCAN SKP CALL5 JSB BHSTP MAKE ROOM ON HI STACK JSB ULWST AND UNSTACK STB HSTPT,I ARGUMENT COUNT LDA LSTPT,I ISOLATE CALL INDEX AND B777 ALS,ALS MULTIPLY BY 4 ADA FWAMB INDEX INTO BRTBL STA 1 ADB .2 STB TEMP4 AND SAVE POINTER DLD 0,I STA TEMP3 CALL # &SUB INDEX STB TEMP6 ARRAY IDENTIFIER WORD ALF,RAL CONVERT FG PROG NAME AND .31 TO ASCII IOR .64 LETTER ID FIRST ALF,ALF STA TEMP9 THEN LDA TEMP3 RRR 6 TWO AND .31 CLB DIGITS DIV .10 IOR .48 IN IOR TEMP9 STA NAM+1 DECIMAL LDA 1 FORM IOR .48 ALF,ALF STA NAM+2 LDA TEMP3 ISOLATE FG DIRECTORY AND B77 ~640 OFFSET STA SUB# DLD TEMP4,I FETCH INTEGER STB TEMP5 FLAG AND SAVE JSB CINIT SET UP DESBLK POINTER AND COUNTER ADA .3 SAVE (END OF DESBLK)+1 STA TEMP7 FOR LATER STACK UPDATE JMP CAL7A AND START DESBLK SCAN SKP CALL6 LDA TEMP6 ARRAY REQ'D? CLE,ERA STA TEMP6 SEZ JMP CALL7 YES, SKIP TRUNCATION LDA TT2,I SSA IS THIS A STRING ? JMP CAL6A YES LDA .2 NO, FORCE LDB TT2 RECORD SIZE STA 1,I TO 2 ADB .2 AND LDA 1,I BASE ADDRESS ADB M1 TO STA 1,I ARGUMENT ADDRESS JMP CALL7 * CAL6A LDA M2 FORCE STA TT2,I STRING SIZE = -2 CALL7 LDB TEMP5 EXAMINE CLE,ERB THE INTEGER FLAG STB TEMP5 FOR THIS ARGUMENT SSA,RSS STRING ARGUMENT ? SEZ,RSS INTEGER ARGUMENT ? JMP CAL7B STRING OR REAL * * INTEGER ARGUMENT * LDB TT2 LDA 1,I INTEGERS ONLY ARS TAKE HALF AS STA 1,I MUCH ROOM * INB MAKE LDA 1,I ELEMENT POINTER CMA,INA POINT AT INB RIGHT PLACE ADA 1,I ELEMENT POINTER IS NORMALLY ARS THINKING IT IS A ADB M1 A REAL ARRAY THATS WHY! ADA 1,I INB STA 1,I CAL7B JSB CSTEP STEP POINTER CAL7A ISZ TT1 AND COUNTER JMP CALL6 UNLESS END OF SCAN * 6 LDB BIT15 STB CLASS INITIALIZE CLASS WORD LDB HSTPT SET UP TRANSFER STB TEMP9 POINTER CMB,INB FIGURE LENGTH ADB TEMP7 OF DESCRIPTOR BLOCK STB TEMP3 FOR CLASS WRITE/READ JSB CLRW OUTPUT DESCRIPTOR BLOCK * DLD TEMP4,I FETCH INTEGER FLAG WORD STB TEMP2 JSB CINIT START AGAIN AT FIRST PARAMETER JMP CAL11 SKP CALL9 JSB CADCK SET UP PARAMETER ADDRESSES JMP CAL10 REAL VALUE JMP CAL9A INTEGER VALUE STA TEMP5 STRINGS, COPY TO FREE STB TEMP8 SPACE BELOW HICH STACK LDA FSCHA JSB TRSTR JMP CAL10 * CAL9A STA TEMP5 HERE FOR INTEGER STB TEMP8 PROCESSING CAL9B DLD TEMP8,I FETCH A VARIABLE ISZ TEMP8 ISZ TEMP8 JSB IFIX STA TEMP5,I STORE AN INTEGER ISZ TEMP5 ISZ TNULL DONE ? JMP CAL9B NO * CAL10 JSB CLRW OUTPUT THE RECORD JSB CSTEP STEP THE POINTER CAL11 ISZ TT1 AND COUNTER JMP CALL9 UNLESS DONE * LDA MNEG SET UP MOST STA ERRCD TERRIBLE ERROR * LDA CLASS IOR BIT13 SET SAVE-CLASS STA CLASS JSB EXEC GET PARAMATER DEF *+5 STRING DEF .14 FROM DEF .1 :RU,BASIC DEF SBUFA,I AND PASS DEF M81 TO SUBROUTINE CMB,INB SET UP CHAR COUNT STB FERR CCB SET UP NO PARAMETER RETURN * JSB EXEC SCHEDULE DEF *+10 FOREGROUND WITH WAIT DEF SCODE PASSING DEF NAM THESE PARAMETERS: DEF SUB# OVLY DIRECTORY OFFSET DEF CLASS CLASS BUFFER ID WORD DEF TEMP4,I NAME/VALUE FLAG WORD DEF ERTTY ERROR LU# DEF .LNUM LINE NUMBER DEF SBUFA,I PARAMETR DEF FERR STRING FROM INITAL :RU,BASIC * JSB ERROR OVERLAY NOT E17 EQU * IN SYSTEM SSB ANY PARAMETERS? JMP *+4 NO * WAIT FOR FOREGROUND ROUTINE * JSB RMPAR RECOVER PARAMETERS DEF *+2 PASSED BACK DEF ERRCD FROM OVERLAY * * RECOVER VARIABLES FROM CLASS * DLD TEMP4,I PICKUP NAM/VALUE STB TEMP2 AND INTEGER FLAG WORDS LDB ERRCD SZB ANY ERRORS? CLA YES - DON'T STORE RETURNED VALUES STA TEMP6 LDA TEMP2 IS THIS A FUNCTION SSA,RSS RETURNING AN INTEGER JMP CAL12 NO LDA ABREG YES, JSB FLOAT FLOAT THE DST ABREG RESULT CAL12 JSB CINIT SET UP POINTER AND COUNTER JMP CA17A FOR TRANSFER BACK SKP CAL13 LDA TEMP6 MORE RETURNED PARAMETERS ? SZA,RSS JMP CAL18 NO,FLUSH THE CLASS CLE,ERA YES, FLAG -> E STA TEMP6 SEZ RETURN THIS PARAMETER ? JMP CAL14 YES LDA TEMP2 NO, SHIFT CLE,ERA THE INTEGER STA TEMP2 FLAG WORD JMP CAL17 AND BYPASS CLGET * CAL14 CLB CLEAR POSTPROCESSING FLAG STB TT3 JSB CADCK SET UP TRANSFER ADDRESSES JMP CAL15 REAL VARIABLE, GO TO CLGET NOP INTEGER STA TEMP8 OR STRING, STORE DESTINATION STB TEMP5 AND SOURCE POINTERS CCB AND SET POSTPROCESSING STB TT3 FLAG CAL15 JSB CLGET GET A RECORD ISZ TT3 FURTHER PROCESSING JMP CAL17 NO LDA TEMP3 YES, IS THIS SSA,RSS A STRING ? JMP CA16A NO, INTEGER STB RQ2 SAVE ACTUAL STRING LENGTH LDB TT2 REVISE ADB .2 STRING HEADER TO LDB 1,I CORESPOND TO ACT&UAL CMB INB LDA 1 IS CLE,ELA THIS ADB M1 A CPA TEMP5 SUB-STRING? RSS NO JMP CAL16 YES! CAL20 LDA 1,I AND HIMSK STRING LENGTH ADA RQ2 AS PASSED BACK FROM CAL21 STA 1,I SUBROUTINE LDA FSCHA YES, TRANSFER IT JSB TRSTR JMP CAL17 * CAL16 LDA RQ2 SET SUBSTRING CMA TRANSFER STA TNULL LENGTH LDA 1,I JMP CAL21 * * CA16A LDA TEMP8,I FETCH AN INTEGER ISZ TEMP8 JSB FLOAT FLOAT IT DST TEMP5,I AND STORE FOR BASIC ISZ TEMP5 ISZ TEMP5 ISZ TNULL MORE TO DO ? JMP CA16A YES * CAL17 JSB CSTEP MORE PARAMETERS ? CA17A ISZ TT1 JMP CAL13 YES SKP CAL18 JSB CFLUS FLUSH & DEALLOCATE CLASS LDA TEMP7 RESTORE THE STA HSTPT HIGH STACK JSB ULWST POP CALL ID OFF LOW STACK LDA 1 WAS THIS AND OPMSK A REAL CPA CALOP SUBROUTINE ? JMP CAL19 YES LDA ERRCD NO SZA ANY ERROR JSB ERROR IS A FATAL ERROR E15 EQU * IN A FUNCTION JSB BHSTP JSB RSCHK MAKE ROOM ON DLD ABREG TEMP STACK FOR RETURNED VALUE ISZ TEMPS STEP PAST RIGHT PARENTHESIS JMP FOR12 AND CONTINUE WITH FORMULA * CAL19 ISZ HSTPT POP FORMX RETURN OFF HIGH STACK LDB ERRCD SZB,RSS ANY ERROR? JMP XEC4 NO, NEXT STATEMENT CPB MNEG FATAL ERROR FLAG ? JMP E15-1 YES ISZ TEMPS LDB PRADD NO, CHECK FOR CPB TEMPS END OF STATEMENT? JMP E15-1 YES, ABORT ISZ TEMPS NO, SKIP FAIL: CODE LDB TEMPS PRESET B IF THIS IS GOTO JMP SETSX PROCESS REST OF STATEMENT SKP  CLRW NOP THIS SUBROUTINE JSB EXEC WILL OUTPUT A DEF *+8 SINGLE RECORD DEF .20 TO A CLASS DEF .0 FOR USE BY DEF TEMP9,I THE OVERLAYS DEF TEMP3 IN THE FOREGROUND DEF .0 DEF .0 DEF CLASS INA,SZA,RSS A = -1 ? JMP CLERR YES, NO MEMORY FOR THIS INA,SZA,RSS A = -2 ? JMP CLRW+1 YES, REPEAT REQUEST JMP CLRW,I * CLERR JSB CFLUS FLUSH THE CLASS ON ERROR JMP E1 AND FLAG NO MEMORY * CLGET NOP JSB EXEC GET A RECORD DEF *+5 DEF .21 FROM THE DEF CLASS DEF TEMP9,I SYSTEM DEF TEMP3 JMP CLGET,I * CFLUS NOP LDA CLASS SZA,RSS JMP CFLUS,I LDA DMMYA STA TEMP9 LDA .1 STA TEMP3 CFLS1 JSB CLGET SSA,RSS RECORD GOT? JMP CFLS1 YES, GET ANOTHER LDA CLASS XOR BIT13 STA CLASS JSB CLGET CLA ONE MORE TIME TO DEALLOCATE STA CLASS JMP CFLUS,I & RETURN * SKP * THIS SUBROUTINE SETS UP ADDRESSES * FOR TRANSFERS TO AND FROM CLASS * BUFFERS. REAL VARIABLES ARE * TRANSFERED AS INDICATED IN THE * DESCRIPTOR BLOCK ENTRY. * STRING VARIABLES ARE TRANSFERRED * FIRST TO FREE SPACE BELOW THE HIGH * STACK, AND THEN INTO THEIR PROPER * PLACE WITHIN THE STRING THEY CAME FROM * THIS IS DONE SINCE EXEC DOES NOT * TRANSFER CHARACTERS USING THE NORMAL * CHARACTER ADDRESSING SCHEME. * CADCK NOP LDA TEMP2 INTEGER FLAG CLE,ERA GOES TO STA TEMP2 E-REG DLD TT2,I STA TEMP3 RECORD LENGTH -> A STB TEMP9 BASE ADDR/CHAR ADDR -> B LDB TT2 V ADB .2 IS THIS LDB 1,I A STRING? SSB,RSS STRING ? JMP CADC1 NO, GO CHECK INTEGER FLAG ISZ CADCK YES, TAKE THE ISZ CADCK P+3 EXIT CLB RRR 8 (A)= PHYSICAL LENGTH BLF,BLF (B)= LOGICAL LENGTH STB RQ2 SAVE LOGICAL LENGTH CMB,INB IS PHYSICAL LENGTH ADB 0 LONGER OR EQUAL SSB TO LOGICAL lENGTH? LDA RQ2 NO, USE LOGICAL LENGTH CMA,INA BECAUSE USER MAY HAVE STA TEMP3 INLARGED IT ADA M1 STA TPRME STA TNULL SETUP FOR TRSTR AND FSCH ARS CONVERT TO WORDS ADA M1 ADA HSTPT AND ASSIGN FREE SPACE LDB TEMP9 STA TEMP9 AND RESET TRANSFER ADDRESS RAL CONVERT TO CHAR ADDRESS STA TT3 RAR AND CHECK JMP CADC2 FOR OVERFLOW * CADC1 SEZ,RSS INTEGER ? JMP CADCK,I NO, TAKE P+1 EXIT ISZ CADCK YES, TAKE P+2 CMA,INA TWOS COMPLEMENT WORDS STA TNULL FOR COUNTER ADA HSTPT ASSIGN FREE SPACE STA TEMP9 AND RESET TRANSFER POINTER STA TT3 CADC2 CMA,INA ADA LSTPT OVERFLOW INTO LOW STACK ? SSA,RSS JMP E1 OUT OF MEMORY LDA TT3 RETURN WITH A = FREE SPACE POINTER JMP CADCK,I AND B=STRING CHAR. ADDR. SKP CINIT NOP LDA HSTPT,I CMA STA TT1 INIT COUNTER LDA HSTPT,I AND MPY .3 POINT TO ADA HSTPT DESCRIPTOR TRIPLET ADA M2 FOR ARGUMENT #1 STA TT2 JMP CINIT,I * CSTEP NOP LDA TT2 ADA M3 STA TT2 JMP CSTEP,I SPC 5 NAM ASC 3,%BXXXX CLASS NOP ERRCD BSS 1 MUST BE ABREG BSS 2 5 WORDS SUB# BSS 2 FOR RMPAR DMMYA DEF SUB# CALOP OCT 50000 ++ HIMSK EQU M256 SCODE OCT 100027 SKP ****************** * * * EXECUTE WAIT * * * ****************** EWAIT NOP ISZ TEMPS POINT (TEMPS) TO FORMULA JSB FETCH FETCH EVALUATED FORMULA SSA NEGATIVE JMP XEC4 YES JSB IFIX CONVERT TO INTEGER SOC LARGE INTEGER LDA MNEG YES CMA NO STA TEMP2 SAVE COUNT (<0) ADA .74 AND CHECK FOR SSA,RSS SHORT WAIT JMP COUNT GO COUNT FOR < 75 MS CCB LDA TEMP2 DIV .10 TENS OF MILLISECONDS STA TEMP2 JSB EXEC CALL SYSTEM DEF *+6 FOR DELAY DEF .12 DEF .0 THIS PRGRM DEF .1 BY 10'S OF MS DEF .0 ONLY ONCE DEF TEMP2 FOR THIS LONG JMP XEC4 ABANDON REMAINDER(SYSTEM UNCERTAINTY) * COUNT LDA TEMP2 RECOVER COUNT EWAI1 INA,SZA,RSS WAIT? JMP XEC4 NO! LDB M280 YES SET INNER LOOP INB,SZB MORE? JMP *-1 YES! JMP EWAI1 NO! SKP ********************** * * * EXECUTE RETURN * * * ********************** ERTRN LDB LSTPT RETURN STACK CPB LSTAK EMPTY? JSB ERROR YES. ERROR 55. E3 LDA LSTPT,I NO, LOAD RETURN ADDRESS ADB M1 RESET STB LSTPT STACK POINTER SSA,RSS IF NEGATIVE STMT NUMBER, JMP XEC43 STA 1 THIS IS RETURN FROM SCHED TASK. LDA M256 HANDLED BY SPECIAL HOOK JSB TRAP IN TRAP ROUTINE. JMP TRERR ERROR JSB FNDPS GET STMT ADDRRESS JMP E12-1 NOT FOUND JMP E12-1 NOT FOUND LDA 1 JMP EGOS3 GOTO RETURN ADDR SKP * * ** EXECUTE READ ** * EREAD LDA HSTPT SAVE HI STK PTR IN CASE b STA HTEMP END-OF-FILE EXIT JSB VLFIL LOOK FOR FILE REQUEST JMP EREA4 READ FROM LU OR DATA STMT? JMP EOFCK END OF FILE LDB TEMPS FILE REQUEST; OK TO READ EREA1 CPB PRADD END-OF-STATEMENT? JMP XEC4 YES JSB FORMX NO, EVALUATE NEXT ADDRESS LDA HSTPT,I RECORD ADDRESS SSA STRING VARIABLE? JMP EREA2 YES! STA OUTLN CLB,INB JSB FDATA GET DATA ITEM STA OUTLN,I STORE ISZ OUTLN DATA STB OUTLN,I ITEM ISZ HSTPT EREA3 LDB TEMPS INB JMP EREA1 SPC 1 EREA2 LDB .2 PREPARE JSB FDATA SOURCE STRING CCA PREPARE JSB PSTR DESTINATION STRING LDA FSCHA JSB TRSTR TRANSFER STRING JMP EREA3 * EREA4 LDA FILE# IS THIS A CPA M1000 READ FROM A DATA STMT? JMP EREA1-1 YES! JMP EINPT NO, READ FROM LU * * ** *** SEARCH FOR STATEMENT OF GIVEN TYPE ** ** STSRH NOP TYPE IN (A), ADDRESS IN (B) AND OPMSK (77000) EXTRACT STMT TYPE STA TEMP4 STSR1 CPB PBPTR PAST LAST STATEMENT? JMP STSRH,I YES LDA 1 EXTRACT ADA .2 PROGRAM LDA 0,I STATEMEN AND OPMSK TYPE CPA TEMP4 DESIRED TYPE? JMP STSR2 YES LDA 1 NO, FETCH INA STATEMENT LENGTH ADB 0,I COMPUTE NEW ADDRESS JMP STSR1 * STSR2 ISZ STSRH FOUND IT, SKIP RETURN JMP STSRH,I * ** *** SET POINTER TO START OF DATA STATEMENT ** ** SETDP NOP STATEMENT ADDRESS IN (B) INB LOAD LDA 1,I STATEMENT LENGTH CMA,INA SET INA DATA COUNTER STA DCCNT TO 1-STATEMENT LENGTH INB SET 'NEXT DATA' POINTER ONE STB NXTDT WORD ABOVE FIRST CONSTANT  JMP SETDP,I SPC 1 SETPT NOP LDB SYMTF INITIALIZE STB HSTPT POINTERS TO LDB FCORE 'HIGH CORE' STACK, STB TSTPT ADB .23 STB LSTAK AND 'LOW' STB LSTPT STACK CMB DO ADB HSTPT STACKS SSB MEET? JMP E1 YES LDB PBUFF BEGIN JMP SETPT,I EXECUTION SKP ***************************************** * * * SUBROUTINE FOR EXECUTION OF * * TRACE AND BREAKPOINT * * * ***************************************** * TRACE NOP LDB 0,I GET ACTUAL STMT NUMBER STB .LNUM LDA SLSTM IS TRACE ENABLED ? SZA,RSS JMP TRAC3 NO! CLB YES, DISABLE TRACE BRKPNT FLAG STB SLSTM CPA M1 RETURN FROM SEG 7 BRKPNT? JMP TRACE,I YES, INHIBIT BRKPNT * TRAC3 LDA .LNUM IF CPA BRKP1 THIS STATEMENT JMP BREAK CPA BRKP2 MATCHES ANY JMP BREAK CPA BRKP3 OF THE JMP BREAK CPA BRKP4 BREAKPOINTS JMP BREAK THEN BREAK ! CMA,INA CHECK IF THIS STATEMENT ADA HITRC IS TO BE SSA TRACED JMP TRAC2 NO LDA LOTRC MAYBE CMA,INA ADA .LNUM SSA JMP TRAC2 NO LDA .8 YES STA OCCNT PRINT LDA LNBFA STA OTBFA "*TRACE" LDA .LNUM & JSB OUTIN LINE NUMBER LDA OCCNT LDB TRMSA JSB WRITE TRAC2 LDA .LNUM CMA,INA IS THIS ADA HIRUN THE END SSA OF THIS RUN ? JMP EEND YES JMP TRACE,I NO * BREAK LDA .2 EXECUTE JMP SE G7 BREAKPOINT * SKP ** *** ALLOT SPACE FOR INTERMEDIATE RESULT ** ** RSCHK NOP LDA TSTPT ALLOT ADA .2 STA TSTPT SPACE ADA M1 OVERFLOW INTO CPA LSTAK LOW-CORE STACK? RSS YES JMP RSCHK,I NO LDA LSTAK SAVE INA LOWER STA TEMP3 STACK BOUND ADA .9 UPDATE STA LSTAK STACK BOTTOM LDA LSTPT SET INA SOURCE STA TEMP2 ADDRESS ADA .9 UPDATE STA LSTPT STACK TOP INA SET DESTINATION STA TEMP4 ADDRESS CMA,INA OVERFLOW ADA HSTPT INTO SSA HIGH-CORE STACK? JMP E1 YES. ERROR 57. JSB MVTOH NO, MOVE JMP RSCHK,I LOW-CORE STACK SKP ** *** BUMP HIGH STACK POINTER ** ** BHSTP NOP CCB ADVANCE ADB HSTPT STB HSTPT POINTER CPB LSTPT OVERFLOW? JMP E1 YES JMP BHSTP,I NO ** *** VERIFY LEGITIMACY OF OPERAND ** ** OPCHK NOP LDB HSTPT,I OPERAND ADDRESS TO (B) SSB STRING OPERAND? JMP OPCH2 YES LDA 1,I HIGH PART OF CPA MNEG OPERAND 100000B? INB,RSS YES JMP OPCH1 NO; OK. LDA 1,I IS LOW PART OF OPERAND 376B? CPA B376 JSB ERROR YES. VALUE NOT DEFINED. (50) E8 ADB M1 OPCH1 CPB TSTPT TEMPORARY? JMP OPCH3 YES JMP OPCHK,I OPCH2 CMB,INB SET ADDRESS TRUE ISZ HSTPT UNSTACK OPERAND OPCH3 LDA TSTPT UNSTACK TEMP STACK ADA M2 STA TSTPT JMP OPCHK,I SKP * * ************************** * * ** EVALUATE A FORMULA ** * * ************************** * FORMX NOP FORMULA BEGINS IN (TEMPS) CLB INITIALIZE OPERATOR ' JSB SLWST STACK FORM1 LDA TEMPS,I FETCH OPERAND ISZ TEMPS SET FOR NEXT WORD OF FORMULA AND OPDMK (100777) EXTRACT OPERAND STA TEMP5 AND SAVE IT SZA,RSS NULL OPERAND? JMP FORM2 YES JSB BHSTP SET STACK FOR OPERAND ADDRESS SSA FLAG BIT SET? JMP FORM4 YES JSB SSYMT FETCH OPERAND ADDRESS INB,SZB,RSS EXISTANT? JMP E8-1 NO. ERROR 50. AND .15 YES CPA .15 USER DEFINED FUNCTION? JMP FORM6 YES STB HSTPT,I NO LDB 1,I LOAD PTR TO VALUE SZA STRING VARIABLE? JMP FORM2 NO! LDA TEMPS,I YES AND OPMSK FOLLOWED BY CPA LBOP SUBSCRIPT? JMP FORM2-2 YES! STB TEMP8 NO! JSB RSCHK CREATE TEMPORARY CLA RECORD CCB DST TSTPT,I (0,-1) LDB TEMP8 RETRIEVE AND CMB,INB NEGATE STRING ADDRESS STB HSTPT,I STACK OPERAND ADDRESS FORM2 LDA TEMPS,I FETCH AND OPMSK OPERATOR ALF,ALF POSITION IT CPA .2 STRING CONSTANT? JMP FORM3 YES! FORM8 RAR LDB 0 LOAD ADDRESS OF ADB FOPBS OPERATOR'S INFORMATION WORD ADA M4 NON-FORMULA SSA OPERATOR? CLB YES ADA D33 NO, NON-FORMULA SSA,RSS OPERATOR? CLB YES CLA NO LDA 1,I LOAD INFORMATION WORD AND B777 SAVE STA TEM10 PRECEDENCE XOR 1,I RECOVER OPR NO. ARS STA TEMP5 IDENTIFICATION JMP FOR11 * * EVALUATION ROUTINES RETURN VALUE HERE. * FORM0 DST TSTPT,I STACK HIGH WORD LDA TSTPT STACK OPERAND STA HSTPT,I ADDRESS FOR11 LDA LSTPT,I DOES OPERATOR AND B377 ON TOP OF CMA OPER.UB@255 JMP STER3-1 STRING OVERFLOW LDA TEMP6,I DOES AND B377 START-OF-STRING CMA CHARACTER ISZ PS0 RELATE TO INA PREVIOUS ADA MPT VALUE SSA,RSS OF STRING JMP PSTR3 NO LDA TEMP6,I YES,EXTRACT ISZ PS0 END-OF- ALF,ALF PERMITTED-STRING AND B377 DESIGNATOR CMA COMPUTE DIFFERENCE FROM ADA NQT END OF SPECIFIED STRING -1 CLB,INB 'SOURCE' CPB PS0 MODE? JMP PSTR5 NO LDB TNULL YES,SPECIFIED SOURCE STRING INA CONTAINED WITHIN SSA,RSS DEFINED SOURCE STRING ADB 0 NO, CORRECT LENGTH JMP PSTR4 OF ACTUAL SOURCE STRING * PSTR3 ISZ PS0 'SOURCE' MODE? JSB ERROR NO, NON-CONTIGUOUS STRING STER2 CCB YES SET ACTUAL LENGTH TO 0 PSTR4 LDA TEMP5 LOAD START-OF-STRING JMP PSTR,I CHARACTER ADDRESS PSTR5 SSA,RSS PHYSICAL STORAGE OVERFLOW? JSB ERROR YES, STRING OVERFLOW STER3 ISZ PS1 END-OF-STRING SPECIFIED? JMP PSTR7 YES * PSTR6 LDA TEMP6,I NO AND M256 RESET IOR NQT LOGICAL LENGTH STA TEMP6,I OF STRING JMP PSTR,I * PSTR7 LDA TEMP6,I IS NEW AND B377 DESTINATION CMA STRING ADA NQT LONGER SSA,RSS THAN OLD? JMP PSTR6 YES JMP PSTR,I * PS0 BSS 1 MPT BSS 1 PS1 BSS 1 NQT BSS 1 TRS0 BSS 1 *********************** * * * TRANSFER A STRING * * * *********************** * * THE NUMBER OF CHARACTERS SPECIFIED BY TNULL (IN 1'S * COMPLEMENT) IS TRANSFERRED FROM THE SOURCE STRING TO * A DESTINATION STRING BEGINNING WITH THE CHARACTER * ADDRESSED BY TEMP5. * TRSTR NOP STA TRFCH SAVE FETCH CHAR ROUTINE ADDR ISZ TNULL MORE TRANSFER STRING? RSS YES JMP TRSTR,I NO JSB TRFCH,I FETCH A SOURCE CHARACTER LDA B40 NONE LEFT,LOAD A BLANK STA TRS0 SAVE IT LDB TEMP5 LOAD CLE,ERB DESTINATION LDA 1,I WORD SEZ,RSS SAVE ALF,ALF OTHER AND M256 CHARACTER IOR TRS0 COMBINE WITH SEZ,RSS NEW CHARACTER ALF,ALF AND STORE STA 1,I WORD ISZ TEMP5 INCREMENT DESTINATION ADDRESS JMP TRSTR+2 * **************************** * * * FETCH CHARACTER STRING * * * **************************** * * CHARACTER ADDRESS IN TEMP8, SOURCE CHARACTER COUNT * IN TPRME (IN 1'S COMPLEMENT). EXIT TO (P+1) ON NO * MORE CHARACTERS (TPRME = -1) ELSE EXIT TO (P+2) WITH * NEXT CHARACTER IN (A). * FSCH NOP LDA TPRME MORE CHARACTERS? INA,SZA,RSS JMP FSCH,I STA TPRME YES, UPDATE CHARACTER COUNT LDA TEMP8 LOAD CHARACTER CLE,ERA ADDRESS LDA 0,I EXTRACT SEZ,RSS NEXT CHARACTER ALF,ALF AND B377 ISZ TEMP8 UPDATE CHARACTER ADDRESS ISZ FSCH JMP FSCH,I * *************************** * * * FETCH INPUT CHARACTER * * * *************************** * * EXITS NORMALLY TO (P+2) WITH NEXT INPUT CHARACTER IN (A). * IF THE CHARACTER IN (A) IS A QUOTE OR THE INPUT RECORD IS * EMPTY, EXIT TO TRSTR,I ( THE ONLY CALLER THAT CAN ENCOUNTER * THE SITUATION ). * FINCH NOP ISZ FINCH JSB GETCR FETCH NEXT CHARACTER JMP FINC1 END-OF-INPUT CPA B42 QUOTE? JMP TRSTR,I YES! JMP FINCH,I FINC1 LDA .10 SET END-OF-INPUT JMP TRSTR,I * ********************** * * * CHECK FOR ENOUGH * * * ********************** * OVCHK NOP NEW WORD REQUIREMNET IN (A) ADA PBPTR CHECK STA PBPTR CMA FOR ADA LWBM OVERFLOW SSA,RSS JMP E1 OUT OF STORAGE JMP OVCHK,I SKP * ****************************** * * * ROUND SUBSCRIPT TO INTEGER * * * ****************************** SBFIX NOP SUBSCRIPT IN (A) AND (B) JSB .FAD SET FOR ROUNDING DEF HALF JSB IFIX CONVERT TO INTEGER SOC WAS IT INTEGER? JMP SBFIX,I NO ADA M1 YES, BIAS BY -1 SSA,RSS POSITIVE INTEGER? ISZ SBFIX YES JMP SBFIX,I NO ******************** * * * INPUT A CONSTANT * * * ******************** CONST NOP JSB GETCR JMP CONST,I CLB SET SIGN STB SIGN POSITIVE INB CPA .43 '+' ? JMP CONS1 YES CPA .45 NO, '-' ? CCB,RSS YES n JMP CONS2 NO CONS1 STB SIGN RECORD SIGN JSB GETCR FETCH NEXT JMP E13-1 CHARACTER CONS2 JSB NUMCK FETCH CONSTANT JMP CONS3 NONE FOUND JSB ERROR BAD EXPONENT PART E14 ISZ CONST SUCCESSFULLY FOUND JMP CONST,I EXIT VIA (P+2) CONS3 CPB SIGN SIGN FOUND? ( (B) = 0) CCA,RSS NO JSB ERROR YES, SOLITARY SIGN E13 JMP CONST,I EXIT VIA (P+1) SKP ********************** * * ** COMPUTE RND(X) ** * * ********************** * * THE RANDOM NUMBER FUNCTION COMPUTES A RANDOM NUMBER FROM THE * FORMULAS: * * X(N)=A*X(N-1)+C(MOD 2^30) (A=5^11,C=2^30*(1/2-1/SQR(12))) * RND =X/2^30 MIN (1-2^-23) * ERND NOP SSA,RSS POSITIVE ARGUMENT? JMP ERND1 YES, USE PREVIOUS VALUE RBL,CLE,ERB NO, MAKE A ELA STA RNDX1 A NEW SEED STB RNDX2 ERND1 EQU * LDA RNDX1 COMPUTE FIRST MPY RNDA2 CROSS PRODUCT. STA RNDX1 SAVE (ONLY NEED LOW ORDER PART) LDA RNDX2 COMPUTE 2ND MPY RNDA1 CROSS PRODUCT. ADA RNDX1 ADD IN FIRST. ADA RNDC1 ADD IN HIGH PART OF C. STA RNDX1 SAVE TOTAL. (THIS IS HIGH PART). CLE LDA RNDX2 COMPUTE LOW ORDER PRODUCT. MPY RNDA2 ADA RNDC2 ADD IN LOW PART OF C. SEZ ADD ANY CARRY INTO INB B. RAL,CLE,ERA E_A(15),A(15)_0. STA RNDX2 SAVE LOW ORDER RESULT. ELB SHIFT HIGH ORDER PART & ADD IN ADB RNDX1 PREVIOUS TOTAL. ELB,CLE,ERB CLEAR BIT 15 AND STORE. STB RNDX1 RAL SHIFT A ADJACENT TO B. SWP EXCHANGE REGISTERS AND JSB .PACK PACK. NOP CPB .2 TEST FOR RESULT=1.0 RSS JMP ERND,I EXIT IF NOT. LDA INF SET RESULT TO 1-2^-23 LDB M256 JMP ERND,I YRNDA1 DEC 1490 A DIV 2^15 RNDA2 DEC 3805 A MOD 2^15 RNDC1 OCT 16441 C DIV 2^15 RNDC2 OCT 7701 C MOD 2^15 RNDX1 BSS 1 RNDX2 BSS 1 SKP ***** * ** OCT ** BASIC FUNCTION TO CONVERT INTEGER FOR * OCTAL OUTPUT. ACTUALLY CONVERTS INTEGER * TO FLOATING POINT QUANTITY WHICH WILL * PRINT OUT AS OCTAL VALUE * * CALLING SEQUENCE: * * DLD FLOATING EQUIVALENT OF INTEGER * JSB OCT * RETURN (FLOATING PT VALUE IN .A.8.B.) * ***** * OCT NOP JSB IFIX CONVERT TO INTEGER LDB M5 INITIALIZE STB CNTR DIGIT COUNTER LDB ATBL INITIALIZE POINTER STB TEMP3 TO DIGIT TABLE STA 1 MOVE INTEGER TO .B. RBL USE SIGN BIT CLA AS VALUE SLB FOR FIRST INA DIGIT IN STA TEMP3,I TABLE OCT01 BLF,RBR POSITION NEXT OCTAL DIGIT LDA 1 AND .7 AND ISOLATE IT IN .A. ISZ TEMP3 BUMP POINTER TO TABLE STA TEMP3,I AND MAKE ENTRY ISZ CNTR BUMP COUNTER, MORE DIGITS? JMP OCT01 YES, GET THEM NOW * ** BUILD FLOATING POINT NUMBER * LDB M6 RESET STB CNTR DIGIT COUNTER LDB ATBL REINITIALIZE STB TEMP3 POINTER TO DIGIT TABLE CLA CLB DST VALUE INITIALIZE FLOATING PT VALUE OCT02 LDA TEMP3,I GET NEXT DIGIT ISZ TEMP3 BUMP TO NEXT ENTRY JSB FLOAT CONVERT TO FLOATING POINT JSB .FAD USE TO UPDATE VALUE DEF VALUE ISZ CNTR BUMP DIGIT COUNTER, DONE ? RSS JMP OCT,I YES, RETURN JSB .FMP NO, MULTIPLY BY 10, DEF FD10 DST VALUE UPDATE VALUE JMP OCT02 AND DO FOR NEXT DIGIT * ** STORAGE ** * VALUE BSS 2 CNTR BSS 1 ATBL DEF *+1 BSS 6 FD10 DEC 10. * **************************** * f * * READ ERROR CODE FUNCTION * * * **************************** * XERR NOP LDA ERRCD JSB FLOAT FLOAT CODE JMP XERR,I RETURN IN A-B REGISTERS * ***************************** * * * SET ERROR CODE SUBROUTINE * * * ***************************** * SERR NOP JSB IFIX CONVERT TO INTEGER STA ERRCD SAVE JMP SERR,I * ******************* * * * TIME FUNCTION * * * ******************* * TIM NOP JSB IFIX FIX INPUT PARAMETER STA TEMP3 AND SAVE JSB EXEC GET DEF *+4 TIME DEF .11 FROM DEF ATBL+1 THE DEF ATBL+6 SYSTEM LDA TEMP3 DETERMINE ADA .2 WHICH ADA ATBL TIME THE USER WANTS LDA 0,I GET IT JSB FLOAT AND FLOAT IT JMP TIM,I RETURN * * SKP **************** * * * SGN FUNCTION * * * **************** * ESGN NOP CLB SZA,RSS ZERO? JMP ESGN,I YES! SSA,RSS NO, POSITIVE? LDB .2 YES, SET EXPONENT LDA FLGBT LOAD MANTISSA SZB POSITIVE? RAR YES, CORRECT MANTISSA JMP ESGN,I * * ******************************************** * * ** EXECUTE SWITCH REGISTER TEST FUNCTION ** * * ******************************************** ESWR NOP JSB .IENT CONVERT TO 16 BIT INTEGER JMP FNERR-1 TOO BIG LDB 0 AND .15 CPA 1 NUMBER OUTSIDE RANGE 0-15? RSS NO JMP FNERR-1 YES LIA 1 READ SWITCH REGISTER SZB,RSS IS THIS THE SWITCH? JMP ESWR1 YES RAR MOVE TO NEXT SWITCH ADB *vM1 JMP *-4 * ESWR1 AND .1 ISOLATE THAT BIT JSB FLOAT CONVERT TO FLOATING POINT JMP ESWR,I RETURN * * SKP ******************************* * * ** COMPUTE FILE DATA TYPE ** * * ******************************* * * UPON ENTRY (A) AND (B) HOLD A FILE NUMVER IN F. P. FORM. * FILE 0 REFERS TO THE . IF THE FILE NUMBER * IS NEGATIVE RETURN 1, 2, 3, OR 4 IF THE NEXT DATA ITEM IS * A NUMBER, STRING, END-OF-FILE, OR END-OF-RECORD RESPECTIVELY * IF THE FILE NUMBER IS POITIVE RETURN WITH THE VALUE CORRESPOND- * ING TO THE FIRST DATA ITEM FOUND OF ONE OF THE FIRST THREE TYPES. * ETYP NOP STB TEMP9 SAVE (B) LDB FILE# SAVE VALUE STB TEM10 OF FILE # SZA,RSS 'DATA' FILE? JMP ETYP3 YES! CCB NO, IGNORE SSA END-OF-RECORDS CLB UNLESS ARGUMENT STB EORFL IS NEGATIVE LDB TEMP9 RETRIEVE (B) SSA,RSS TAKE ABSOLUTE VALUE JMP ETYP4 DST NUMO1 CLA CLB JSB .FSB ARITHMETIC INVERSE DEF NUMO1 ETYP4 JSB SBFIX 15-BIT INTEGER? JMP E9-1 NON-EXISTANT FILE REFERENCED INA YES STA FILE# VALIDATE JSB FSTAT FILE JMP E9-1 NON-EXISTANT FILE REFERENCED JSB GTTYP GET DATA TYPE ETYP1 LDB TEM10 RESTORE STB FILE# FILE# JSB FLOAT IN F. P. FORM JMP ETYP,I ETYP2 LDB NXTDT OUT OF LDA DATA JSB STSRH DATA? JMP ETYP5 YES! JSB SETDP NO, SET DATA POINTERS ETYP3 CCA MORE DATA IN CPA DCCNT CURRENT STATEMENT? JMP ETYP2 NO LDB NXTDT,I YES, LOAD TYPE WORD CLA,INA SET NUMBER SSB,RSS NUMBER? LDA .2 NO, SET FOR STRING JMP ETYP1 ETYP5 LDA .3 JMP ETYP1 SKP * *********************** * * * PRINT ERROR MESSAGE * * * *********************** ERROR NOP JSB CFLUS FLUSH ANY CLASS I/O LDA ERBS ERROR ADDRESS IN (A) LDB ERROR ERROR SOURCE IN (B) INA MOVE TO NEXT ERROR CPB 0,I SAME AS ACTUAL ERROR? CMA,INA,RSS YES, MAKE ERROR NEGATIVE JMP *-3 NO ADA ERBS MAKE ERROR POSITIVE CMA,INA ADA .52 ACCOUNT FOR SHORTENED TABLE STA TEMP3 SAVE IT LDA .3 JMP SEG8 PRINT ERROR MESSAGE, AFTER CLEANING HOUSE SKP *************** * * * ERROR TABLE * * * *************** ERR DEF E1+1 OUT OF STORAGE DEF E2 GOSUBS NESTED 10 DEEP DEF E3 RETURN WITH NO PRIOR GOSUB DEF E4 OUT OF DATA DEF E5 WRONG DATA TYPE DEF E6 SUBSCRIPT OUT OF BOUNDS DEF E7 STATEMENT REFERENCED NOT DATA DEF E18 STATEMENT REFERENCED NOT IMAGE STMT DEF E19 PRINT USING OUTPUT NOT ALLOWWED DEF E8 UNDEFINED VALUE ACCESSED DEF E9 NON-EXISTENT FILE REFERENCED DEF E10 FILE NOT OPEN DEF E11 END-OF-FILE/END-OF-RECORD DEF E12 UNDEFINED STATEMENT REFERENCED DEF E13 BAD DATA ITEM DEF E14 BAD EXPONENT DEF E15 SUB. OR FUNCT. TERMINATED ABNORMALLY DEF E16 ILLEGAL FILE TYPE DEF E17 OVERLAY NOT IN SYSTEM DEF TERR1 TRAP TABLE FULL DEF TERR2 BAD TRAP/SEQ # COMBINATION DEF TERR3 SCHEDULED BUT DELETED TASK DEF TERR4 TRAP TABLE BUSY DEF STER1 NEGATIVE STRING LENGTH DEF STER2 NON-CONTIGUOUS STRING DEF STER3 STRING OVERFLOW DEF BASER NEGATIVE NUMBER TO REAL POWER DEF POWER ZERO TO ZERO POWER DEF ZRTNG NLHZERO TO NEGATIVE POWER DEF FNERR OUT OF RANGE IN FUNCTION DEF LOGER LOG OF NEG ARGUMENT DEF EXPER EXP OUT OF RANGE DEF FERR0 MISSING FORMAT SPECIFICATION DEF FERR1 ILLEGAL OR MISSING DELIMITER DEF FERR2 NO CLOSING QUOTE DEF FERR3 BAD CHARACTER AFTER REPLICATOR DEF FERR4 REPLICATOR TOO LARGE DEF FERR5 REPLICATOR ZERO DEF FERR6 MULTIPLE DECIMAL POINTS DEF FERR7 BAD FLOATING POINT SPECIFICATION DEF FERR8 ILLEGAL CHARACTER IN FORMAT DEF FERR9 ILLEGAL FORMAT FOR STRING DEF FER10 MISSING RIGHT PARENTHESIS DEF FER11 MISSING REPLICATOR DEF FER12 TOO MANY PARENTHESIS LEVELS DEF FER13 MISSING LEFT PARENTHESIS DEF FER14 ILLEGAL FORMAT FOR NUMBER SKP NFMT EQU TEMPS+1 TEMP1 EQU TEMPS+2 TEMP2 EQU TEMPS+3 TEMP3 EQU TEMPS+4 TEMP4 EQU TEMPS+5 TEMP5 EQU TEMPS+6 TEMP6 EQU TEMPS+7 TEMP7 EQU TEMPS+8 TEMP8 EQU TEMPS+9 TEMP9 EQU TEMPS+10 TEM10 EQU TEMPS+11 EFMT EQU TEMPS+12 RFLAG EQU TEMPS+13 HTEMP EQU TEMPS+14 NUMO1 EQU TEMPS+15 UTEMP EQU TEMPS+16 TWO WORD ARRAY TRFCH EQU TEMPS+18 ADDRESS OF FETCH CHAR ROUTINE FERR EQU TEMPS+19 FILE ERROR FLAG FILE# EQU TEMPS+20 FILE REFERENCE NUMBER RCRD# EQU TEMPS+21 RECORD REFERENCE NUMBER EORFL EQU TEMPS+22 END-OF-RECORD FLAG DADDR EQU TEMPS+23 FILE LOCATION PTR FILT EQU TEMPS+24 FILE REQUEST TYPE RQ2 EQU TEMPS+25 TABFG EQU TEMPS+26 * END BASC4 N 8 92101-18006 A S C0122 BASIC-FUNCTION BRANCH TABLE             H0101 NASMB,R,L,C HED ** RTE BASIC BRANCH TABLE ** 92101-19006 REV. A NAM BRTBL,7 92101-16006 750724 ********************************************************************** * * * RTE BASIC STANDARD FUNCTION BRANCH TABLE * ********************************************************************** * ************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1975. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * * PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ************************************************************** * * LIST: 92101-19006 * SOURCE: 92101-18006 * RELOC: 92101-16006 * * * * FOR EACH ENTRY IN THE BRANCH TABLE THERE IS A ONE TO ONE * CORRESPONDANCE TO ENTRIES IN THE MNEMONIC TABLE. THUS * ANY ADDITIONS/DELETIONS TO THIS TABLE MUST REFLECT A * CORRESPONDING ADDITION/DELETION TO THE MNEMONIC TABLE. * * ********************************************************************** * * ENT FCNEX START OF FUNCTION EXECUTION DEFS * *******DEFINE EXTERNAL SUBROUTINE ENTRY POINTS HERE******* * EXT ETAB,ETYP,SIN,COS,TAN,ATAN,ALOG,EXP,ABS,SQRT EXT AINT,ERND,ESGN,ESWR,TIM,XERR,SERR,OCT,ALOGT SUP * * * THE FORMAT OF THE FUNCTION BRANCH TABLE IS AS FOLLOWS: * * < ERROR ? > * < DEF ADDRESS> * * WHERE : < ERROR ? > = 'RSS' IS THERE SHOULD BE AN * JSB ERROR AFTER THE FUNCTION CALL * OR A 'NOP' IF THERE IS NOT. * * < DEF > = 'DEF FUNCTION ENTRY POINT' * ********************************************************************** * * * THE FOLLOWING TABLE DEFINES ENTRY POINTS FOR EXECUTION * OF FUNCTIONS. * * * * ********************************************************************** * FCNEX EQU *    * * START FUNCTION ENTRY POINTS HERE * NOP DEF ETAB EXECUTE TAB FUCTION * NOP DEF ETYP EXECUTE TYP FUNCTION * RSS ERROR PROCESS FOLLOWS DEF SIN EXECUTE SINE FUNCTION * RSS ERROR PROCESS FOLLOWS DEF COS EXECUTE COSIN FUNCTION * RSS ERROR PROCESS FOLLOWS DEF TAN EXECUTE TANGENT FUNCTION * NOP DEF ATAN EXECUTE ARC TANGENT FUNCTION * RSS ERROR PROCESS FOLLOWS DEF ALOG EXECUTE NATURAL LOG FUNCTION * RSS ERROR PROCESS FOLLOWS DEF ALOGT EXECUTE LOG BASE 10 * RSS ERROR PROCESS FOLLOWS DEF EXP EXECUTE EXPONENTIAL FUNCTION * NOP DEF ABS EXECUTE ABSOLUTE FUNCTION * RSS ERROR PROCESS FOLLOWS DEF SQRT EXECUTE SQUARE ROOT FUNCTION * NOP DEF AINT EXECUTE INT FUNCTION * NOP DEF ERND EXECUTE RANDOM FUNCTION * NOP DEF ESGN EXECUTE SIGN FUNCTION * NOP DEF ESWR EXECUTE SWITCH REG FUNCTION * NOP DEF TIM EXECUTE TIME FUNCTION * NOP DEF XERR EXECUTE ERROR FUNCTION * NOP DEF SERR EXECUTE SET ERROR FUNCTION * NOP DEF OCT EXECUTE OCTAL FUNCTION * END   9@  JSB MCOPY LIST THE MNEMONIC LDA FWAMM,I GETPACE CMA,INA FIRST WORD ADA MCNT ADDRESS RAL,RAL OF ENTRY ADA FWAMB IN BRANCH TABLE STA BADDR AND SAVE IT INA LDB 0,I GET ARRAY/SIMPLE RBL WORD AND STB ARRAY SAVE IT INA DLD 0,I GET VALUE AND REAL/INTEGER RBL AND SAVE RAL THEM STA VALUE STB CONVR LDA MADDR,I GET PARAMETER RRR 4 COUNT AND B17 AND CMA,INA STA PCNT SAVE IT SZA,RSS ANY PARAMETERS? JMP CALL2 NO! CALL3 LDA CONVR GET RAR CONVERSION STA CONVR BIT SLA IS IT REAL? JMP CONV1 NO, INTEGER! LDA R YES CONV2 JSB OUTCR OUTPUT IT LDA VALUE GET VALUE RAR WORD STA VALUE AND SAVE IT SLA,RSS GOING TO SUBROUTINE? JMP *+3 YES! LDA V NO, FROM SUBROUTINE JSB OUTCR OUTPUT IT LDA ARRAY GET RAR SIMPLE/ARRAY STA ARRAY WORD AND SAVE IT SLA,RSS IS IT ARRAY? JMP *+3 NO! LDA A YES! JSB OUTCR OUTPUT LETTER 'A' LDA PCNT ANY SZA,RSS PARAMETERS? JMP CALL2 NO! ISZ PCNT DONE? JMP CALL4 NO! LDA B51 YES, OUTPUT JSB OUTCR CLOSED PAREN CALL2 LDA .32 PRINT JSB OUTCR LDB MADDR,I IS THIS LDA B123 A SUBROUTINE SSB OR A FUNCTION? LDA B106 OUTPUT A JSB OUTCR EITHER A 'S' OR 'F' LDA .32 OUTPUT JSB OUTCR SPACE LDA BADDR,I EXTRACT AND RRR 6 PRINT AND B37 OVERLAY JSB OUTIN  NUMBER JSB OUTLN OUTPUT LINE LDB MADDR COMPUTE LDA 1,I POSITION AND .7 OF ADA .3 NEXT ARS ADB 0 MNEMONIC ISZ MCNT DONE? JMP CALL1 NO! JMP NXCOM YES! * CALL4 LDA B54 PRINT JSB OUTCR COMMA JMP CALL3 * CONV1 LDA I PRINT JMP CONV2 'I' * * ARRAY BSS 1 CONVR BSS 1 VALUE BSS 1 MCNT BSS 1 PCNT BSS 1 MADDR BSS 1 BADDR BSS 1 V OCT 126 R OCT 122 I OCT 111 A OCT 101 HEDER DEF *+1 ASC 24, <> SKP * * READ MNEMONIC TABLE INTO SPACE BETWEEN LONGEST * SEGMENT AND NEXT TO LONGEST SEGMENT * LOADM NOP LDA DCBAD SET UP STA DCB DATA CONTROL BLOCK JSB OPEN OPEN DEF *+7 MNEMONIC DEF DCB,I TABLE DEF FERR FILE DEF MNNAM DEF .0 DEF MNNAM+3 DEF MNNAM+4 JSB CKERR ERROR? LDA FWAMM SET STARTING STA TEMP4 ADDRESS OF MNEMONIC TBL LOAD3 JSB READF READ DEF *+6 DEF DCB,I MNEMONIC DEF FERR DEF TEMP4,I TABLE DEF .9999 INTO CORE DEF TEMP3 LDB TEMP3 CPB M1 EOF READ? JMP LOAD7 YES ADB TEMP4 NO, SET NEW READ STB TEMP4 INDEX * JMP LOAD3 NO, READ SOME MORE LOAD7 JSB CKERR ERROR? JSB CLOSE CLOSE DEF *+4 DEF DCB,I THE DEF FERR DEF .0 FILE JSB CKERR JMP LOADM,I * ********************************** * * * CHECK FOR FILE MANAGER ERROR * * * ********************************** * CKERR NOP LDA FERR IS THERE SSA,RSS AN ERROR? JMP CKERR,I NO! STA TE"MP3 SAVE ERROR JMP OUTER AND GO TO ERROR PROCESSOR * SKP * ********************************** * * * OUTPUT A MULTICHARACTER SYMBOL * * * ********************************** * MCOPY NOP LDA 1,I COMPUTE AND .7 ENTRY CMA,INA LENGTH STA TEMP7 AND SAVE IT CLE,INB SET FOR FIRST CHARACTER STB TEMP3 SAVE SYMBOL ADDRESS MCOU3 LDA TEMP3,I LOAD WORD SEZ,RSS FIRST CHARACTER? ALF,ALF YES, POSITION IT AND B177 EXTRACT CHARACTER JSB OUTCR OUTPUT IT SEZ,CME SET FOR NEXT CHARACTER ISZ TEMP3 MOVE TO NEXT WORD OF SYMBOL ISZ TEMP7 MORE CHARACTERS? JMP MCOU3 YES JMP MCOPY,I ***************************** * * LIST A CALL STATEMENT * * * ******************************* * MCALL CMA,INA RESET 'NXTST' STA NXTST LDA SNOWF OUTPUT JSB OUTCR SNOWFLAKE LDA .LNUM OUTPUT JSB OUTIN LINE NUMBER LDA .32 OUTPUT JSB OUTCR BLANK LDB CALLA POINTER TO 'CALL' JSB MCOPY OUTPUT 'CALL' LDA .32 OUTPUT JSB OUTCR SPACE MCAL1 LDA TEMPS LDA 0,I GET OPERATOR WORD AND B777 GET MNEMONIC TBL OFFSET CMA USE OFFSET TO FIND MNEMONIC STA TEMP5 NO. OF MNEMONICS TO SKIP LDB FWAMM GET ADDR. OF SUB. MNEMONICS INB NXSUB ISZ TEMP5 IS THIS IT? RSS NO! JMP LCALL YES! LDA 1,I GET FIRST WORD OF MNEMONIC ENTRY AND .7 GET CHARACTER COUNT ADA .3 ARS INCREMENT TO NEXT ENTRY ADB 0 ADD IN MNEM TBL ADDRESS JMP NXSUB CHECK NEXT ENTRY LCALL JSB MCOPY LIST THE CALL MNEMONIC LDA TEMP4 GET LAST CHAR (SEE OUTCR) CPA .40 LAST CHAR "("? JMP *+3 YES, SUPPRESS SPACE LDA .32 OUTPUT JSB OUTCR BLANK ISZ TEMPS POINT AT FIRST PARAMETER ISZ TEMP1 AND UPDATE INTERMEDITATE CODE JMP LIST5 LIST PARAMETERS * CALLA DEF *+1 DEC 4 ASC 2,CALL SNOWF OCT 52 ACKNA DEF *+1 ASC 2,>>_ ALEN DEF *+1 OCT 3 ASC 2,LEN * * LIST3 ISZ TEMPS MORE ISZ TEMP1 LDA TEMP1 STATEMENT? CPA PRADD RSS NO! JMP LIST4 YES! SPC 1 * CONVERSION COMPLETE - OUTPUT THE LINE ON LIST DEVICE SPC 1 LIST2 LDB SBUFA NO, OUTPUT LDA OCCNT JSB WRITE STATEMENT TO PERIPHERAL JMP NXCOM SPC 1 * CONVERT THE OPERATOR SPC 1 LIST4 LDA TEMPS,I AND OPMSK SZA,RSS NULL OPERATOR? JMP LIST5 YES STA TEMP2 NO, SAVE OPERATOR ALF,ALF SINGLE ARS LDB 0 CHARACTER ADA M21 BLS YES ADB FOPBS LOAD LDA 1,I SYMBOL ALF,ALF ADJUST AND B377 CHARACTER CPA .34 " ? JMP LIS14 YES JSB OUTCR NO SKP * CONVERT THE OPERAND SPC 1 LIST5 LDA TEMPS,I AND OPDMK SAVE STA TEMP3 OPERAND SSA FLAG BIT SET? JMP LIST9 YES SZA,RSS NO, NULL OPERAND? JMP LIST3 YES AND TYPFL ISOLATE TYPE PART CPA .15 FUNCTION? JMP LIST8 YES SPC 1 * OUTPUT LETTER-DIGIT COMBINATIONS SPC 1 LIST6 LDA TEMP3 RRR 4 AND B177 OUTPUT ADA B100 JSB OUTCR LETTER LDA TEMP3 YES AND .15 RESTORE SZA,RSS STRING? JMP LIS16 YES! ADA M5 NO! SSA LETTER-DIGIT? JMP LIST3 NO! ADA B60 &N DIGIT LIS17 JSB OUTCR OUTPUT DIGIT JMP LIST3 SPC 1 LIS16 LDA B44 '$' JMP LIS17 SPC 1 LIST8 LDA B106 OUTPUT JSB OUTCR LDA B116 'FN' JSB OUTCR LDA TEMP3 OUTPUT RRR 4 AND B177 LETTER ADA B100 JSB OUTCR JMP LIST3 SPC 1 * OUTPUT FLOATING-POINT CONSTANTS SPC 1 LIST9 XOR FLGBT SZA NUMBER? JMP LIS10 NO ISZ TEMPS YES LDA TEMPS,I ISZ TEMPS LDB TEMPS,I ISZ TEMP1 ISZ TEMP1 JSB NUMOT OUTPUT THE NUMBER NOP JMP LIST3 SPC 1 * OUTPUT FUNCTION NAMES SPC 1 LIS10 AND .15 CPA .3 INTEGER? JMP LIS11 YES CPA .15 NO, FUNCTION? RSS YES JMP LIST6 NO, MUST BE A PARAMETER LDA TEMP3 COMPUTE RRR 4 AND B37 COMPUTE INTERNAL FUNCTION NO. CPA B37 IS IT LEN FUNCTION? JMP LENF YES CPA B36 FORTRAN FUNCTION? JMP FRFCT YES! STA TEMP2 CODE CMA STA TEMP5 NO. OF MNEMONICS TO SKIP LDA AFCNS GET ADDR. OF FUNCTION MNEM. RSS PEEL LDA 0,I OFF RAL,CLE,SLA,ERA INDIRECTS JMP *-2 STA 1 ADDR OF MNEMONIC ENTRIES IN BREG NXFCN ISZ TEMP5 IS THIS IT? RSS NO! JMP LFCN YES! LDA 1,I GET FIRST WORD OF MNEMONIC ENTRY AND .7 GET CHARACTER COUNT ADA .3 ARS INCREMENT TO NEXT ENTRY ADB 0 ADD IN MNEM TBL ADDRESS JMP NXFCN CHECK NEXT ENTRY LFCN JSB MCOPY OUTPUT FUNCTION NAME JMP LIST3 * LEN FUNCTION FOUND LENF LDB ALEN ADDRESS OF PRINT JMP LFCN BUFFER FOR LEN FRFCT ISZ TEMPS ISZ TEMP1 JMP MCAL1 PRINT FORTRAN FUNCT MNEM SPC 1 * OUTPUT INTEGER CONSTANTS SPC 1 LIS11 ISZ TEMPS OUTPUT ISZ TEMP1 LDA TEMPS,I INTEGER JSB OUTIN JMP LIST3 OPERAND SPC 1 * OUTPUT OPERATOR SPC 1 * LIS15 LDA .32 OUTPUT JSB OUTCR A BLANK FIRST LIST1 JSB OUTST OUTPUT STRING JMP LIST3 SPC 1 * OUTPUT QUOTE STRING SPC 1 LIS14 LDB TEMPS,I OUTPUT QUOTE STRING BLF,BLF TEST BIT 8 SLB SUPPRESS QUOTES? JMP LIST1 YES! JSB OUTCR OUTPUT " JSB OUTST OUTPUT QUOTE STRING LDA .34 OUTPUT " JMP LIS17 SPC 1 ******************* * * * OUTPUT A STRING * * * ******************* OUTST NOP LDA TEMPS,I AND B177 GET STRING COUNT CMA,INA,SZA,RSS NULL STRING? JMP OUTST,I YES! STA TEMP6 NO, SAVE NEG OF COUNT OUTS1 ISZ TEMPS MOVE TO NEXT PAIR OF CHARS ISZ TEMP1 BUMP COUNTER LDA TEMPS,I GET THEM ALF,ALF POSITION TO OUTPUT LEFT CHARACTER JSB OUTS2 OUTPUT CHAR LDA TEMPS,I GET CHAR PAIR AGAIN JSB OUTS2 OUTPUT RIGHT HAND CHAR JMP OUTS1 SPC 1 OUTS2 NOP AND B177 JSB OUTCR ISOLATE AND OUTPUT CHAR ISZ TEMP6 WAS IT LAST CHAR JMP OUTS2,I NO! JMP OUTST,I YES! SKP * ******************************************* * * * TABLE SEARCH FOR MULTICHARACTER SYMBOLS * * * ******************************************* TBSRH NOP STA SBPTR,I LDA TBSRH,I RSS PEEL LDA 0,I OFF RAL,CLE,SLA,ERA INDIRECTS JMP *-2 ISZ TBSRH STA TABLE STORE TABLE ADDRESS STB LNGTH STORE -(NUMBER OF ENTRIES) LDA INBFA SAVE STA TEMP3 INPUT LDA ICCNT BUFFER  STA TEMP4 STATUS LDA SBPTR INITIALIZE END-OF-SYMBOL STA SMEND POINTER CLA,INA COUNT FIRST CHARACTER OF STA SLENG SYMBOL LDA SBPTR,I FETCH PARTIAL SYMBOL ALF,ALF LEFT-JUSTIFY IOR .32 FIRST CHARACTER AND STA SBPTR,I APPEND BLANK TSRC1 JSB GTCHR FETCH NEXT CHARACTER JMP TSRC9 END-OF-STATEMENT LDB SLENG CHECK FOR CPB .8 IMPOSSIBLE LENGTH JMP TSRC9 SLB EVEN-NUMBERED CHARACTER? JMP TSRC2 YES ISZ SMEND NO, FETCH FRESH WORD, ALF,ALF LEFT-JUSTIFY CHARACTER, IOR .32 APPEND BLANK, JMP TSR10 TSRC2 ADA M32 DELETE BLANK, ADA SMEND,I FILL SECOND CHARACTER, TSR10 STA SMEND,I AND STORE ISZ SLENG COUNT IT LDB LNGTH INITIALIZE TABLE LENGTH STB COUNT COUNTER LDA TABLE TSRC3 STA TBLPT SET TABLE POINTER LDA TBLPT,I EXTRACT SYMBOL LENGTH AND .7 FROM TABLE AND COMPARE CPA SLENG WITH CURRENT SYMBOL JMP TSRC5 EQUAL? TSRC4 ADA .3 DIFFERENT, ARS UPDATE ADA TBLPT TABLE POINTER ISZ COUNT MORE ENTRIES? JMP TSRC3 YES JMP TSRC1 NO * SKP TSRC5 LDB TBLPT SET POINTER TO STB TSPTR TABLE SYMBOL LDB SBPTR SET (B) TO INPUT JMP TSRC7 SYMBOL POINTER TSRC6 CPB SMEND ALL OF SYMBOL CONSIDERED? JMP TSRC8 YES, MATCH OCCURRED INB NO, INCREMENT TSRC7 ISZ TSPTR SYMBOL POINTERS LDA TSPTR,I FETCH WORD FROM TABLE CPA 1,I MATCH WITH INPUT SYMBOL? JMP TSRC6 YES LDA SLENG NO, WRONG JMP TSRC4 SYMBOL TSRC8 LDA TBLPT,I EXTRACT AND OPMSK SYMBOL CODE STA SBPTR,I ISZ TBSRH AND RETURN VIA JMP TBSRH,I 'SUCCESS{' EXIT TSRC9 LDA TEMP3 RESTORE STA INBFA INPUT LDA TEMP4 BUFFER STA ICCNT STATUS LDA SBPTR,I GET ORIGINAL CHAR ALF,ALF POSITION IT AND B377 ISOLATE IT JMP TBSRH,I 'FAILURE' EXIT SKP * **************************** * * * PREPARE STRING OPERAND * * * **************************** * * ON ENTRY (A)=-2 TO INDICATE THE STRING IS A SOURCE STRING. * (B)= POINTER TO STRING ADDRESS * ON EXIT (A)= START OF STRING ADDRESS * (B)= LOGICAL STRING LENGTH * THE FIRST CHARACTER OF THE STRING OPERAND IS LEFT IN TEMP5 * FOR SOURCE STRINGS (A)= TEMP5 UPON EXIT. THE REQUESTED * STRING LENGTH (IN CHARACTERS) IS LEFT IN TEMP6 FOR SOURCE * STRINGS THE ACTUAL STRING LENGTH (WHICH MAY BE LESS THAN THE * REQUESTED LENGTH) IS IN (B) UPON EXIT. THE FOLLOWING * CONDITIONS EXIT TO ERROR: NEGATIVE STRING LENGTH, REQUESTED * DESTINATION STRING WOULD EXCEED PHYSICAL STRING BOUNDARY, OR * REQUESTED DESTINATION STRING WOULD PRODUCE A STRING QUANTITY * WITH TWO UNCONNECTED PARTS. THE LOGICAL LENGTH OF A * DESTINATION STRING IS ADJUSTED AS NEEDED. * PSTR NOP STA PS0 SAVE MODE FLAG LDB 1,I GET STRING STB PS1 SET FLAG POSITIVE CLE,ELB SAVE ADDRESS OF FIRST STB TEMP5 CHARACTER OF STRING ERB SAVE ADB M1 POINTER TO STB TEMP6 STRING LENGTH LDA SUBS1 LOAD START OF STRING DESIGNATOR STA MPT SAVE IT ADA TEMP5 RECORD CHARACTER ADDRESS STA TEMP5 OF START-OF-STRING LDA SUBS2 LOAD END-OF-STRING DESIGNATOR INA,SZA SPECIFIED? JMP PSTR2 YES CCA NO CPA PS0 'SOURCE' MODE? JMP PSTR1 NO LDA TEMP6,I YES LOAD STRING'S AND B377 LOGICAL LENGTH JMP PSTR2 * PSTR1 STA PSNR1 SET FLAG TO -1 LDA TPRME COMPUTE CMA END-OF-STRING ADA MPT DESIGNATOR PSTR2 STA NQT SAVE IT CMA IS LENGTH ADA MPT OF SPECIFIED STRING SSA,RSS NEGATIVE? JSB ERROR YES E7 STA TNULL ADA B400 NO SSA >255 JMP E9-1 STRING OVERFLOW LDA TEMP6,I DOES AND B377 START-OF-STRING CMA CHARACTER ISZ PS0 RELATE TO INA PREVIOUS ADA MPT VALUE SSA,RSS OF STRING JMP PSTR3 NO LDA TEMP6,I YES,EXTRACT ISZ PS0 END-OF- ALF,ALF PERMITTED-STRING AND B377 DESIGNATOR CMA COMPUTE DIFFERENCE FROM ADA NQT END OF SPECIFIED STRING -1 CLB,INB 'SOURCE' CPB PS0 MODE? JMP PSTR5 NO LDB TNULL YES,SPECIFIED SOURCE STRING INA CONTAINED WITHIN SSA,RSS DEFINED SOURCE STRING ADB 0 NO, CORRECT LENGTH JMP PSTR4 OF ACTUAL SOURCE STRING * PSTR3 ISZ PS0 'SOURCE' MODE? JSB ERROR NO, NON-CONTIGUOUS STRING E8 CCB YES SET ACTUAL LENGTH TO 0 PSTR4 LDA TEMP5 LOAD START-OF-STRING JMP PSTR,I CHARACTER ADDRESS PSTR5 SSA,RSS PHYSICAL STORAGE OVERFLOW? JSB ERROR YES, STRING OVERFLOW E9 ISZ PS1 END-OF-STRING SPECIFIED? JMP PSTR7 YES * PSTR6 LDA TEMP6,I NO AND M256 RESET IOR NQT LOGICAL LENGTH STA TEMP6,I OF STRING JMP PSTR,I * PSTR7 LDA TEMP6,I IS NEW AND B377 DESTINATION CMA STRING ADA NQT LONGER SSA,RSS THAN OLD? JMP PSTR6 YES JMP PSTR,I * PS0 BSS 1 MPT BSS 1 PS1 BSS 1 NQT BSS 1 TRS0 BSS 1 TPRME BSS 1 TNULL BSS 1 SKP * **************************** * * * FETCH CHARACTER STRING * * * **************************** * * CHARACTER ADDRESS IN TEMP8, SOURCE CHARACTER COUNT * IN TPRME (IN 1'S COMPLEMENT). EXIT TO (P+1) ON NO * MORE CHARACTERS (TPRME = -1) ELSE EXIT TO (P+2) WITH * NEXT CHARACTER IN (A). * FSCH NOP LDA TPRME MORE CHARACTERS? INA,SZA,RSS JMP FSCH,I STA TPRME YES, UPDATE CHARACTER COUNT LDA TEMP8 LOAD CHARACTER CLE,ERA ADDRESS LDA 0,I EXTRACT SEZ,RSS NEXT CHARACTER ALF,ALF AND B377 ISZ TEMP8 UPDATE CHARACTER ADDRESS ISZ FSCH JMP FSCH,I * *********************** * * * TRANSFER A STRING * * * *********************** * * THE NUMBER OF CHARACTERS SPECIFIED BY TNULL (IN 1'S * COMPLEMENT) IS TRANSFERRED FROM THE SOURCE STRING TO * A DESTINATION STRING BEGINNING WITH THE CHARACTER * ADDRESSED BY TEMP5. * TRSTR NOP STA TRFCH SAVE FETCH CHAR ROUTINE ADDR ISZ TNULL MORE TRANSFER STRING? RSS YES JMP TRSTR,I NO JSB TRFCH,I FETCH A SOURCE CHARACTER LDA .32 NONE LEFT,LOAD A BLANK STA TRS0 SAVE IT LDB TEMP5 LOAD CLE,ERB DESTINATION LDA 1,I WORD SEZ,RSS SAVE ALF,ALF OTHER AND M256 CHARACTER IOR TRS0 COMBINE WITH SEZ,RSS NEW CHARACTER ALF,ALF AND STORE STA 1,I WORD ISZ TEMP5 INCREMENT DESTINATION ADDRESS JMP TRSTR+2 * *************************** * * * FETCH INPUT CHARACTER * * * *************************** * * EXITS NORMALLY TO (P+2) WITH NEXT INPUT CHARACTER IN (A). * IF THE CHARACTER IN (A)ŘB@< IS A QUOTE OR THE INPUT RECORD IS * EMPTY, EXIT TO TRSTR,I ( THE ONLY CALLER THAT CAN ENCOUNTER * THE SITUATION ). * FINCH NOP ISZ FINCH JSB GTCHR FETCH NEXT CHARACTER JMP FINC1 END-OF-INPUT CPA B42 QUOTE? JMP TRSTR,I YES! JMP FINCH,I FINC1 LDA .10 SET END-OF-INPUT JMP TRSTR,I [B* TRFCH BSS 1 * * ******************************* * * * BACK SPACE OVER CHARACTER * * * ******************************* * BKSPA NOP CCA ADA CHCNT BACK SPACE STA CHCNT OVER LAST CCA CHARACER ADA BFADD IN INPUT STA BFADD BUFFER JMP BKSPA,I * SKP * ****************************** * * * GET CHAR FROM INPUT BUFFER * * * ****************************** GTCHR NOP ISZ CHCNT ANY CHARACTERS LEFT? RSS JMP GTCHR,I NO, END-OF-FILE EXIT LDB BFADD LOAD BUFFER ADDRESS ISZ BFADD UPDATE FOR NEXT TIME CLE,ERB SET CHARACTER FLAG LDA 1,I LOAD CURRENT BUFFER WORD SEZ,RSS FIRST CHARACTER? ALF,ALF YES, POSITION IT AND B177 MASK EXTRANEOUS BITS CPA .32 BLANK? JMP GTCHR+1 YES, FETCH NEXT CHARACTER ISZ GTCHR UPDATE RETURN ADDRESS JMP GTCHR,I AND EXIT * **************************** * * * FIND VARIABLE LOCATION * * * **************************** * * EXITS (P+1) IF STRING VARIABLE OR (P+2) IF ARRAY OR * SIMPLE VARIABLE. IN BOTH CASES (B) POINTS AT THE LOCATION * OF THE VARIABLE'S VALUE. * LCVAR NOP JSB VARBL GET VARIABLE NAME JSB ERROR NOT LEGAL E10 NOP STA SCHAR SAVE NEXT CHAR LDA VNAM VARIABLE SYMBOL JSB SSYMT FIND LOCATION IN SYMBOL TABLE INB,SZB,RSS IS IT THERE? JSB ERROR NO E11 AND .15 CHECK TYPE SZA,RSS STRING VARIABLE? JMP LCVA1 YES ADA M4 IS IT SSA,RSS AND ARRAY? JMP LCVA2 NO! STB TEMP3 YES, SAVE PTR TO VARIABLE INB LDA 1,I SAVE AND B377 ROW ST~A TEMP4 BOUNDS! LDA 1,I GET ALF,ALF COLUMN AND B377 BOUNDS CMA,INA IS IT ADA SUBS1 OUT OF SSA,RSS RANGE? JSB ERROR YES! E12 LDA SUBS1 NO, IS MPY TEMP4 LDB TEMP4 IS CMB,INB COLUMN ADB SUBS2 BOUND SSB,RSS OUT OF RANGE? JMP E12-1 YES! STA 1 ADB SUBS2 COMPUTE BLS ARRAY ADB TEMP3,I DISPLACEMENT LCVA2 ISZ LCVAR SIMPLE ARRAY VARIABLE (P+2) LCVA1 JMP LCVAR,I STRING VARIABLE (P+1) SKP * ****************************** * * * CHECK FOR VARIABLE OPERAND * * * ****************************** VARBL NOP JSB LTR LETTER? JMP VARBL,I NO, EXIT VIA (P+1) ISZ VARBL CPA B50 LEFT PARENTHESIS? JMP VARO5 YES CPA B133 LEFT BRACKET? JMP VARO5 YES! CPA B44 DOLLAR SIGN? JMP VARO6 YES, STRING VARAIBLE! ISZ VARBL NO JSB DIGCK DIGIT? JMP VARO1 NO LDA TEMP1 YES, RETRIEVE LETTER, ADB .48 AND RESTORE ASCII DIGIT STB TEMP1 JSB STROP RECORD VARIABLE JSB GTCHR FETCH FOLLOWING LDA .10 CHARACTER JMP VARO2 VARO1 LDA TEMP1 RETRIEVE LETTER, LDB .47 SET 'NO DIGIT', JSB STROP AND RECORD VARIABLE LDA TEMP2 RETRIEVE FOLLOWING CHARACTER VARO2 STA TEMP2 SAVE CHARACTER JMP VARBL,I NO, EXIT VIA (P+3) VARO5 LDA TEMP1 RETRIEVE LETTER LDB .46 RECORD JSB STROP ARRAY IDENTIFIER LDA B50 RETRIEVE LEFT PAREN VARO7 JSB SBSCK FETCH SUBSCRIPT NOP JMP VARBL,I EXIT VIA (P+2) SPC 1 VARO6 LDA TEMP1 RECORD STRING VARIABLE LDB B53 JSB STROP CLA SET SUBSCRIPTS CCB INITIALLY TO DST SUBS1 TO 0,-1 JSB GTCHR GET LDA .10 NEXT CHARACTER JMP VARO7 FETCH SUBSCRIPT SKP ****************** * * * FETCH A LETTER * * * ****************** LTR NOP JSB GTCHR LDA .10 JSB LETCK LETTER? JMP LTR,I NO, EXIT VIA (P+1) ISZ LTR YES, STA TEMP1 SAVE IT JSB GTCHR NEXT CHARACTER LDA .10 TO (A) STA TEMP2 SAVE SECOND CHARACTER JMP LTR,I EXIT VIA (P+2) ************************* * * * STORE AN OPERAND NAME * * * ************************* STROP NOP LETTER IN (A), NUMBER IN (B) ADA D100 NUMERICALLY ADJUST THE ADB D53 OPERAND NAME ALF COMBINE THE IOR 1 TWO PARTS STA VNAM STORE VARIABLE NAME JMP STROP,I SKP * ***************************************************** * * INTCK WILL BUILD AN INTEGER FROM INPUT * * CALL SEQ: (A)=CURRENT CHAR * JSB INTCK * DEF (MAX #) * RETURN: (B)=INTEGER * ***************************************************** * * ********************* * * * FORMAT AN INTEGER * * * ********************* INTCK NOP CHARACTER IN (A) CLB STORE STB INTGR PARTIAL RESULT INTC1 JSB DIGCK DIGIT? JMP INTC2 NO CLO LDB INTGR MULTIPLY ADB 1 PARTIAL ADB 1 RESULT ADB INTGR BY ADB 1 10 ADB 0 ADD LATEST DIGIT SOC OVERFLOW? JMP INTC3 YES STB INTGR STORE PARTIAL RESULT JSB GTCHR NO, FETCH LDA .10 NEXT CHARACTER JMP INTC1 INTC2 LDB INTGR ZERO SZB,RSS INTEGER? [ JMP INTC3 YES LDB INTCK,I INTEGER LDB 1,I TOO ADB INTGR LARGE? SSB,RSS JMP INTC3 YES LDB INTGR NO, ISZ INTCK INTEGER IN (B) INTC3 ISZ INTCK SET FOR 'FAIL' RETURN JMP INTCK,I SKP * ****************************** * * * ASCII-TO-BINARY CONVERSION * * * ****************************** CVNUM NOP CHARACTER IN (A), SIGN SETE CLB STB EXP STB EXPNT ZERO STB MANT1 ALL STB MANT2 COMPONENTS STB EXPON OF NUMBER STB TEMP3 SET 'NUMBER' FLAG FALSE CCB SET 'DECIMAL POINT' STB DPFLG FLAG FALSE NUMC1 CPA .46 DECIMAL POINT? ISZ DPFLG YES, SET FLAG TRUE JMP NUMC2 NO CLA INITIALIZE POST-DECIMAL DIGIT STA EXPON DIGIT COUNTER TO ZERO JMP NUMC3+1 FETCH A CHARACTER NUMC2 JSB DIGCK DIGIT? JMP NUMC7 NO ISZ EXPON YES, COUNT DIGIT ALF,ALF LEFT-JUSTIFY ALF,RAR DIGIT AND STA TEMP4 SAVE IT JSB MBY10 MULTIPLY PREVIOUS NUMBER BY 10 LDB EXPNT SZB ZERO EXPONENT? JMP NUMC4 NO LDA .4 YES, SET STA EXPNT EXPONENT TO 4 LDA TEMP4 LOAD CLB NUMBER NUMC3 JSB NORML NORMALIZE THE NUMBER ISZ TEMP3 SET 'NUMBER OCCURRED' FLAG JSB GTCHR ANOTHER CHARACTER? JMP NUM12 NO JMP NUMC1 YES NUMC4 ADB M4 COMPUTE CMB EXPONENT LDA TEMP4 BIAS AND STB TEMP4 SAVE IT CLB NUMC5 ISZ TEMP4 DIGIT POSITIONED? JMP NUMC6 NO CLE YES, ADD IN ADB MANT2 LOW PART CLO OF NUMBER SEZ OVERFLOW? INA YES, BUMP (A) ADA MANT1 ADD IN HIGH PART OF NUMBER SOS OVERFLOW? JMP NUMC3 NO SKP CLE,ERA YES, ROTATE ERB DOWN AND ISZ EXPNT BUMP NOP EXPONENT JMP NUMC3 NUMC6 CLE,ERA SHIFT ERB DIGIT JMP NUMC5 RIGHT NUMC7 CLB DECIMAL POINT STB TEMP4 CPB TEMP3 OR DIGIT FOUND? JMP CVNUM,I NO, EXIT VIA (P+1) CPA E YES, 'E' ? RSS YES JMP NUM12 NO, NO EXPONENT PART JSB GTCHR JMP NUMER CPA .43 '+' ? JMP NUMC8 YES CPA .45 NO, '-' ? CCA,RSS YES JMP NUMC9 NO STA TEMP4 NOTE MINUS SIGN NUMC8 JSB GTCHR JMP NUMER NUMC9 JSB DIGCK DIGIT? JMP NUMER NO STA TEMP3 YES, SAVE IT JSB GTCHR JMP NUM10 SECOND JSB DIGCK DIGIT? JMP NUM10 NO LDB TEMP3 YES BLS,BLS MULTIPLY ADB TEMP3 PRIOR DIGIT BLS BY 10 ADA 1 ADD NEW DIGIT STA TEMP3 SAVE EXPONENT JSB GTCHR JMP NUM10 THIRD JSB DIGCK DIGIT? RSS NO JMP NUMER YES NUM10 LDA TEMP3 LOAD EXPONENT ISZ TEMP4 POSITIVE? CMA,INA YES, COMPLEMENT IT RSS NO NUM12 CLA CLEAR IF NO EXPONENT PART ISZ DPFLG DECIMAL POINT? ADA EXPON YES, CORRECT EXPONENT SZA,RSS ZERO EXPONENT? JMP NUM14 YES SKP SSA NO, NEGATIVE EXPONENT? JMP NUM13 NO CMA,INA YES, SET STA EXPON COUNTER JSB DBY10 DIVIDE NUMBER BY 10 ISZ EXPON DONE? JMP *-2 NO JMP NUM14 YES NUM13 STA EXPON SET COUNTER JSB MBY10 MULTIPLY BY 10 ISZ EXPON DONE? JMP *-2 NO ZNUM14 LDA EXPNT STA EXP LDA MANT1 YES, LOAD LDB MANT2 NUMBER ISZ SIGN POSITIVE? JMP NUM15 YES CMA NO, CMB,INB,SZB,RSS COMPLEMENT INA IT NUM15 JSB .PACK PACK NUMBER INTO (A) AND (B) EXP BSS 1 EXPONENT ISZ CVNUM NUMER ISZ CVNUM RETURN JMP CVNUM,I VIA (P+2) OR (P+3) EXPON BSS 1 TENTH OCT 63146 DPFLG BSS 1 E OCT 105 SKP SKP **************************** * * * CHECK FOR SUBSCRIPT PART * * * **************************** SBSCK NOP CHARACTER IN (A) CPA B50 LEFT PAREN? JMP SBSC0 YES! CPA B133 LEFT BRACK? RSS YES! JMP SBSCK,I NO, RETURN VIA (P+1) SBSC0 ISZ SBSCK YES, SET RETURN TO (P+2) JSB GTCHR GET DIGIT JMP E10-1 NONE! JSB INTCK FETCH INTEGER DEF M256 SUBSCRIPT BOUND JMP E12-1 OVERFLOW ADB M1 BIAS BY -1 STB SUBS1 STORE FIRST SUBSCRIPT CPA B54 COMMA? RSS YES! JMP SBSC1 NO JSB GTCHR GET DIGIT JMP E10-1 NONE! JSB INTCK FETCH SECOND DEF M256 INTEGER SUBSCRIPT BOUND JMP E12-1 OVERFLOW JMP SBSC2 SBSC1 SWP LDA VNAM IS THIS AND .15 A SZA,RSS STRING? JMP SBSC3 YES SWP NO! CLB,INB SET ONE DIMENSIONAL CASE SBSC2 ADB M1 BIAS BY -1 STB SUBS2 SAVE SECOND DIMENSION SBSC4 CPA B51 RT PAREN? JMP SBSC5 YES! CPA B135 RT BRACKET? RSS YES JMP E10-1 NO, CLOSING PAREN SBSC5 JSB GTCHR FETCH FOLLOWING LDA .10 CHARACTER JMP SBSCK,I YES SBSC3 CCA SET ONE DIMENSIONAL STA SUBS2 FOR STRINGS SWP JMP SBSC/4 * VNAM BSS 1 SUBS1 BSS 1 SUBS2 BSS 1 * SKP *********************** * * * PRINT ERROR MESSAGE * * * *********************** ERROR NOP LDB ERROR ERROR SOURCE IN (B) LDA ERBS ERROR ADDRESS IN (A) INA MOVE TO NEXT ERROR CPB 0,I SAME AS ACTUAL ERROR? CMA,INA,RSS YES, MAKE ERROR NEGATIVE JMP *-3 NO ADA ERBS MAKE ERROR POSITIVE PRMES LDB ERTTY RESET OUTPUT STB LUOUT L.U. # TO ERROR DEVICE STA TEMP3 SAVE FOR COUNTER LDB MESGA SET TABLE PNTR TO START PRMS1 LDA 1,I GET LENGTH OF MESSAGE INB MOVE PNTR TO MESSAGE ISZ TEMP3 INDEX ERROR CNTR, IS IT = 0? RSS NO, MOVE PNTR TO NEXT MESSG JMP PRMS2 YES - GO PRINT MESSAGE SLA IF CHAR COUNT ODD, INA MAKE EVEN ARS CONVERT TO WORDS ADB 0 MOVE PNTR TO NEXT MESSG JMP PRMS1 GO INDEX ERROR COUNTER * PRMS2 JSB WRITE PRINT ERROR MESSAGE JMP NXCOM * SKP *********************** * * * ERROR MESSAGE TABLE * * * *********************** SPC 1 * ERROR MESSAGES FOR DEBUG PHASE SPC 1 MESGA DEF *+1 ADDRESS OF ERRORS DEC 15 ASC 8,ILLEGAL COMMAND DEC 14 ASC 7,INVALID NUMBER DEC 13 ASC 7,NO PARAMETERS DEC 13 ASC 7,BAD DELIMITER DEC 14 ASC 7,NO EQUALS SIGN DEC 22 ASC 11,NEGATIVE STRING LENGTH DEC 21 ASC 11,NON-CONTIGUOUS STRING DEC 15 ASC 8,STRING OVERFLOW DEC 16 ASC 8,INVALID VARIABLE DEC 18 ASC 9,VARIABLE NOT FOUND DEC 22 ASC 11,SUBSCRIPT OUT OF RANGE DEC 14 ASC 7,INVALID LIMITS DEC 24 ASC 12,UNDEFINED VALUE ACCESSED DEC 23 ASC 12,MORE THAN 4 BREAKPOINTS DE+0.*C 22 ASC 11,BREAKPOINT ALREADY SET SKP *************** * * * ERROR TABLE * * * *************** ERBS DEF * DEF E1 ILLEGAL COMMAND DEF E2 INVALID NUMBER DEF E3 NO PARAMETERS DEF E4 BAD DELIMITER DEF E5 NO EQUALS SIGN DEF E7 NEGATIVE STRING LENGTH DEF E8 NON-CONTIGUOUS STRING DEF E9 STRING OVERFLOW DEF E10 INVALID VARIABLE DEF E11 VARIABLE NOT FOUND DEF E12 SUBSCRIPT OUT OR RANGE DEF E13 INVALID LIMITS DEF E14 UNDEFINED VALUE ACCESSED DEF E15 MORE THAN 4 BREAKPOINTS DEF E16 BREAKPOINT ALREADY SET SKP TEMP EQU TEMPS+1 TEMP1 EQU TEMPS+2 TEMP2 EQU TEMPS+3 TEMP3 EQU TEMPS+4 TEMP4 EQU TEMPS+5 TEMP5 EQU TEMPS+6 TEMP6 EQU TEMPS+7 TEMP7 EQU TEMPS+8 TEMP8 EQU TEMPS+9 TEMP9 EQU TEMPS+10 TEM10 EQU TEMPS+11 TEM11 EQU TEMPS+12 CURRENT LINE NUMBER COUNT EQU TEMPT+1 SCHAR EQU TEMPT+2 CCODE EQU TEMPT+2 ARYAD EQU TEMPT+3 RFLAG EQU TEMPT+4 TABLE EQU TEMPT+4 SMEND EQU TEMPT+5 SLENG EQU TEMPT+6 TBLPT EQU TEMPT+7 TSPTR EQU TEMPT+8 LNGTH EQU TEMPT+9 FERR EQU TEMPT+10 CHCNT EQU TEMPT+12 CHAR COUNT BFADD EQU TEMPT+14 CURRENT ADDRESS INTGR EQU TEMPT+15 INTEGER * END BASC7 y0ASMB,R,L,C HED <> 92101-19007 REV.1826 NAM BASC8,5 92101-16007 REV.1826 780422 * * * ************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1975. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * * PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ************************************************************** ENT BASC8 EXT IFBRK,TRAP,RDYPT,OUTER,OUTLN,OUTIN,WRITE,FINDV EXT FLOAT,IFIX,PRNIN,REED,COMFL,DIGCK,GETCR EXT SGMNT,EXEC,OPEN,CLOSE,READF,WRITF COM TEMPS(30),PNTRS(74),FILBF(16),FLDCB(144),SPEC(10) ***************************************** * * * SEGMENT #8: EXECUTE THE PROGRAM * * * ***************************************** * * THIS PART OF THE INTERPRETER IS LOADED BY THE EXECUTE PHASE OF * BASIC TO PERFORM CERTAIN FUNCTION WHICH ARE NOT TIME CRITICAL. * CONTROL IS PASSED TO THIS SEGMENT WITH THE VARIABLE 'XSEG7' IN- * DICATING WHICH FUNCTION IS TO BE PERFORMED. AFTER COMPLETION OF * THE FUNCTION, CONTROL IS RETURNED TO EXECUTE SEGMENT 4 AND * EXECUTION OF THE USER'S PROGRAM IS RESUMED. SKP *************************** * * * CONSTANTS AND VARIABLES * * * *************************** * FWAM EQU PNTRS FIRST WORD OF AVAILABLE MEMORY LWBM EQU PNTRS+1 LAST WORD OF AVAILABLE MEMORY .INBF EQU PNTRS+2 INPUT BUFFER ADDRESS SBUFA EQU PNTRS+3 SYNTAX BUFFER ADDRESS SYMTA EQU PNTRS+4 START OF SYMBOL TABLE SYMTF EQU PNTRS+5 END OF SYMBOL TABLE PBUFF EQU PNTRS+6 FIRST WORD OF USER PROGRAM PBPTR EQU PNTRS+7 LAST WORD+1 OF USER PROGRAM INBFA EQU PNTRS+8 INPUT BUFFER POINTER ICCNT EQU PNTRS+9 INPUT CHARACTER COUNT SBPTR EQU PNTRS+10 SYNTAX BUFFER POINTER .LNUM EQU PNTRS+11 CURRENT LINE # FCORE EQU PNTRS+12 START OF FREE CORE MNNAM EQU PNTRS+13 MNEMONIC TABLE NAME:SC:LU BRNAM EQU PNTRS+18 BRANCH TABLE NAME:SC:LU FWAMM EQU PNTRS+23 POINTER TO START OF MNEMONIC TABLE FWAMB EQU PNTRS+24 POINTER TO START OF BRANCH TABLE .OTBF EQU PNTRS+25 POINTER TO OUTPUT BUFFER OCCNT EQU PNTRS+26 OUTPUT CHARACTER COUNT OTBFA EQU PNTRS+27 POINTER INTO OUTPUT BUFFER LUOUT EQU PNTRS+28 CURRENT OUTPUT L.U. # LUINP EQU PNTRS+29 CURRENT INPUT L.U. # SIGN EQU PNTRS+30 SIGN OF CURRENT NUMBER BLANK EQU PNTRS+31 CURRENT TERMINATION CHAR REC# EQU PNTRS+32 COMMAND FILE RECORD NUMBER FLTYP EQU PNTRS+33 TYPE 0 FILE FLAG TTYPR EQU PNTRS+34 CONSOLE TTY L.U. # PRINT EQU PNTRS+35 LISTING L.U. # READR EQU PNTRS+36 AUXILLIARY INPUT L.U. # PUNCH EQU PNTRS+37 AUXILLIARY OUTPUT L.U. # ERTTY EQU PNTRS+38 ERROR LIST OUTPUT L.U. # DCB EQU PNTRS+39 DATA CONTROL BLOCK ADDRESS FILBK EQU PNTRS+40 FILE CONTROL BLOCK ADDRESS PFLAG EQU PNTRS+41 SAVE,LOAD FILE FLAG LOLIM EQU PNTRS+42 LOW LIMITS OF PROGRAM HILIM EQU PNTRS+43 HIGH LIMITS OF PROGRAM LORUN EQU PNTRS+44 LOW RUN LIMITS HIRUN EQU PNTRS+45 HIGH RUN LIMITS SLSTM EQU PNTRS+46 EXECUTE SLOW STMTS LOTRC EQU PNTRS+47 LOW TRACE LIMITS HITRC EQU PNTRS+48 HIGH TRACE LIMITS BRKP1 EQU PNTRS+49 BREAK POINT #1 BRKP2 EQU PNTRS+50 BREAK POINT #2 BRKP3 EQU PNTRS+51 BREAK POINT #3 BRKP4 EQU PNTRS+52 BREAK POINT #4 SMFLG EQU PNTRS+53 SIMULATE FLAG TYPE EQU PNTRS+54 PARTIAL LINE CHARACTER COUNT DLMTR EQU PNTRS+55 CHAR EDIT DELIMITER MERGF EQU PNTRS+56 MERGE FLAG COMN EQU PNTRS+57 COMMAND FILE NAME MANT1 EQU PNTRS+60 MANTISSA #1 MANT2 EQU PNTRS+61 MANTISSA #2 EXPNT EQU PNTRS+62 EXPONENT INLOC EQU PNTRS+63 INV. LOC. LU,STRK,#TKRS INTKZ EQU PNTRS+64 TRACK SIZE ON DISC FOR INV. HSTPT EQU PNTRS+65 HIGH-STACK POINTER TSTPT EQU PNTRS+66 TEMPORARY STACK POINTER LSTPT EQU PNTRS+67 LOW-STACK POINTER LSTAK EQU PNTRS+68 LOW-STACK ADDRESS PRADD EQU PNTRS+`69 PROGRAM EXECUTION DSTRT EQU PNTRS+70 DATA NXTDT EQU PNTRS+71 STATEMENT DCCNT EQU PNTRS+72 POINTERS NXTST EQU PNTRS+73 NEXT STMT NUMBER SKP TEMPT BSS 7 SPC 1 ERBS DEF ERR-1 DCBAD DEF FLDCB ADDRESS OF DATA CONTROL BLOCK SPC 1 SUP PRESS MULTIPLE LISTINGS SPC 1 .0 DEC 0 .1 DEC 1 .2 DEC 2 .3 DEC 3 .4 DEC 4 .5 DEC 5 .8 DEC 8 .10 DEC 10 .13 DEC 13 .15 DEC 15 .31 DEC 31 .16 DEC 16 .32 DEC 32 .43 DEC 43 .45 DEC 45 .48 DEC 48 .64 DEC 64 .128 DEC 128 .9999 DEC 9999 B54 OCT 54 B72 OCT 72 B177 OCT 177 B200 OCT 200 B377 OCT 377 HIMSK OCT 177400 INF OCT 77777 MNEG OCT 100000 DSERR OCT 140000 M1 DEC -1 M2 DEC -2 M4 DEC -4 M5 DEC -5 M10 DEC -10 M16 DEC -16 M20 DEC -20 M32 DEC -32 PMESS DEF *+1 OCT 6412 ASC 4,PAUSE _ : QMARK DEF *+1 ASC 1,?? AMESS DEF *+1 OCT 6412 ASC 15,OPERATOR TERMINATION IN LINE _ : GO ASC 1,GO CTRLQ OCT 10400 SKP * ********************************* * * * OVERFLOW STMT ADDRESS TABLE * * * ********************************* * XECTB DEF * STATEMENT ADDRESS TABLE DEF EASSN 1-ASSIGN STMT DEF EPAZ 2-PAUSE STMT DEF EEND 3-STOP END STMT DEF OPEND 4-END STMT * SKP **************************************** * * * EXECUTE THE OVERFLOW STMT FROM SEG 4 * * * **************************************** * BASC8 NOP LDA SLSTM EXECUTE ADA XECTB REQUEST LDA 0,I FROM SEGMENT 4 JMP 0,I * SPC 3 * ********************************* * * * RETURN TO SEG 4 TO CONTINUE * * * ********************************* * XEC4 LDB .4 LOAD SEGMENT#4 JMP SGMNT SKP ********************* * * ** EXECUTE PAUSE ** * * ********************* * EPAZ LDA M10 WRITE LDB PMESS 'PAUSE' JSB WRITE MESSAGE JSB PRNIN INITIALIZE FOR NUMBER ISZ TEMPS LDB TEMPS ANY CPB PRADD PARAMETER? JMP EPAZ1 NO! ISZ TEMPS DLD TEMPS,I GET PARAMETER JSB IFIX INTEGERIZE EPAZ2 JSB OUTIN PRINT NUMBER JSB OUTLN EPAZ3 LDA M2 READ LDB .INBF INPUT JSB REED 'GO' LDA .INBF,I CPA GO 'GO'? JMP XEC4 YES! AND HIMSK CPA CTRLQ ABORT PROGRAM? JMP OPND1 YES, BUT DO NOT PUSH AND SHOVE LDA M2 NO, SO LDB QMARK OUTPUT JSB WRITE DOUBLE '??' JMP EPAZ3 EPAZ1 CLA ZERO JMP EPAZ2 PAUSE SKP ************************ * * ** EXECUTE END/STOP ** * * ************************ * * OPEND JSB IFBRK CLEAR ATTENTION DEF *+1 BIT OPND1 LDA ERTTY SET UP STA LUOUT ERROR LU LDB AMESS PRINT LDA M32 MESSAGE JSB WRITE INDICATING JSB PRNIN OPERATOR LDA .LNUM TERMINATION JSB OUTIN OF JSB OUTLN PROGRAM EEND LDA INLOC INVOKE? SZA JMP INVK0 YES! LDA M16 NO,OUTPUT STA TEMP4 EEND2 LDA FILBK,I ANY SSA JMP EEND3 SZA,RSS JMP EEND3 PARTIALLY STA DCB ADA .16 STA TEMP6 FILLED BUFFERS JSB WRREC NO, OUTPUT BUFFERS EEND3 ISZ FILBK ISZ TEMP4 THROUGH WITH ALL 16? JMP EEND2 NO! SPC 1 LDB FCORE SET UP POINTER ADB M20 ` TO OUTPUT ANY STB TEMP4 PARTIAL LINES LULOP LDA TEMP4,I IN THE LU TABLE SZA,RSS IS THIS SLOT ASSIGNED ? JMP LUNXT NO, TRY THE NEXT ONE ALF,ALF YES, ISOLATE THE LU AND B377 IOR B200 STA LUOUT SAVE THE LU WORD JSB FINDV AND DISCOVER THE EQUIPMENT TYPE STA 1 ADA M16 IS THIS DEVICE TYPE SSA,RSS < 20(8) ? JMP LUNXT NO, TRY THE NEXT STA FLTYP YES, SET FOR NON-FILE WRITE CLA SET UP A NULL LDB PMESS WRITE OPERATION JSB WRITE ON THIS LU LUNXT ISZ TEMP4 POINT TO THE NEXT LU WORD LDA TEMP4 AND CHECK IF CPA FCORE WE ARE DONE RSS YES JMP LULOP NO, GO BACK FOR ANOTHER SPC 3 SPC 3 * CHECK IF 'INVOKED' SPC 3 INVK0 LDA INLOC INVOKED? SZA,RSS JMP LUNX1 NOT INVOKE, CONTINUE. JSB CLOSE CLOSE OPEN PROGRAM FILE DEF *+4 DEF FLDCB DEF FERR DEF .0 LDA INLOC LDB TEMP3 LOOK FOR ERROR?? SZB JMP EEND4 YEP, THINGS LOOK BAAAAAD... LDB .2 SET THE LU# SSA 15=1 FOR LU # 3 LDB .3 SET TO 3 STB DLU# SAVE FOR RELEASE TRACKS ADB .64 TURN ON BINARY BIT STB SWCND SET CONWORD AND B177 GET NUMBER OF TRACKS STA TK# SAVE FOR READ STA TK#1 SAVE FOR RELASE BR LDA INLOC GET START TRACK ASR 7 TO LOW ORDER AND B377 MASK START TRACK STA STRK# SAVE FOR READ STA STRK1 SAVE FOR RELEASE CLA SET STA STSEC START SECT TO ZERO LDA LENCM SET LENG STA SBLNG TO COMMON AREA LDA CMADR STARTING ADDRESS OF COMMON STA SBUF BUF START ADDR JSB SREAD READ COMMbON FROM DISC AND DSERR LOOK AT BITS 15-14 SZA DISC ERROR? JMP DERR YES CPB LENCM READ LENCM WORDS? RSS YES CONTINUE JMP DERR NO DISC ERR LDA FWAMB CALCULATE CMA,INA LENGTH ADA SYMTA OF THE INA BUMP FOR THAT LAST STA LENPG PROGRAM LDA INTKZ GET TRACK SIZE ADA M512 BUMP DOWN FOR FIRST PROG WRITE STA TMLND TEMP DISC LENGTH LDA .4 SET STARTING STA STSEC SECTOR NUMBER LDA FWAMB START PROG ADDRESS STA TEMAD TEMP PROG ADDR. STA SBUF START BUF ADRR LDA LENPG PROGRAM LENGTH STA TMLNP TEMP LENGTH OF PROG TO GO INVK1 LDA TMLND CURRENT TRACK SIZE CMA,INA ADA TMLNP SUB FROM TO GO SIZE SSA LAST READ??? JMP INVK2 YES COMPLETE STA TMLNP UPDATE PROG TO GO LDA TMLND GET TRACK SIZE STA SBLNG BUF LENGTH ADA TEMAD RUNNING PROG ADDR STA TEMAD UPDATE TO NEXT JMP INVK3 GO WRITE INVK2 LDA TMLNP TEMP PROG LENGTH STA SBLNG MAKE BUFF LENGTH CLA SET TO STA TMLNP ZERO FOR FINISH INVK3 JSB SREAD READ FROM DISC AND DSERR LOOKAT BITS 15-14 SZA DISC ERROR? JMP DERR YES CPB SBLNG READ ENOUGH?? RSS YES, CONTINUE JMP DERR NOT RIGHT NUMBER OF WORDS CLA ARE WE CPA TMLNP ALL FINISHED??? JMP INVK4 YES GO RELEASE TRACKS STA STSEC NO, START AT SECTOR ZERO ISZ STRK# BUMP TRACK NO LDA INTKZ UPDATE TRACK SIZE STA TMLND FOR NEXT READ LDA TEMAD RUNNING ADDRESS STA SBUF FOR NEXT READ JMP INVK1 READ AGAIN SPC 1 * INVK4 JSB RETK RELEASE TRACKS LDA .2 SEXST STA SLSTM SLOW STATEMENT FLAG JMP XEC4 CONTINUE SPC 1 * * READ PROGRAM TRACKS * SPC 1 SREAD NOP JSB EXEC THROUGH EXEC DEF SRRET RETURN DEF .1 READ DEF SWCND CON WORD DEF SBUF,I BUFF ADDR DEF SBLNG LENGTH DEF STRK# TRACK NUMBER DEF STSEC STARTING SECTOR SRRET JMP SREAD,I RETURN SPC 1 * * RELEASE TRACKS SUBROUTINE * SPC 1 RETK NOP ENTER JSB EXEC GO DEF RERET DEF .5 REL TRACKS REQUEST DEF TK#1 NUMBER OF TRACKS DEF STRK1 STARTING TRACK NUMBER DEF DLU# DISC LU NUMBER RERET JMP RETK,I RETURN SPC 1 TK# BSS 1 TK#1 BSS 1 STRK# BSS 1 STRK1 BSS 1 BR DLU# BSS 1 LENPG BSS 1 SWCND BSS 1 SBUF BSS 1 SBLNG BSS 1 CMADR DEF TEMPS LENC EQU SPEC-TEMPS+10 ***CHANGE IF COMMON CHANGES*** LENCM ABS LENC STSEC BSS 1 TEMAD BSS 1 TMLND BSS 1 TMLNP BSS 1 M512 DEC -512 * SPC 3 * LUNX1 JSB IFBRK CLEAR ATTENTION DEF *+1 * JSB STREN REPLACE GOTO WITH STMT NUMBERS * LDA MNNAM IS THERE IS A MNEMONIC SZA TO BE RELOADED? JMP GETBM YES, LOAD MNEMONIC TBL EEND4 CLA CLEAR STA SLSTM SEG 8 FLAG LDA .2 CLEAR JSB TRAP TRAP TABLE NOP CCA CLEAR TYPE 0 STA FLTYP FILE FLAG LDA TEMP3 WAS THIS AN SZA ERROR EXIT ? JMP OUTER YES ! STA .LNUM RESET POINTER TO START OF PROGRAM INA IS INPUT FROM CPA REC# COMMAND FILE? JMP RDYPT NO, GO TO READY JMP COMFL YES, GO BACK TO COMMAND FILE * GETBM JSB LOADM LOAD B & M TABLES BYE1 LDA FWAMM,I SETUP STA TEMP1 SUBROUTINE COUNTER LDB FWAMB SETUP BRANCH TABLE PTR STB TELaMP2 BYE2 LDA 1,I GET OVERLAY NAME STA TEMP5 CALL # AND SUB INDEX ALF,RAL CONVERT FG PROG NAME AND .31 TO ASCII IOR .64 LETTER ID FIRST ALF,ALF STA TEMP9 THEN LDA TEMP5 RRR 6 TWO AND .31 CLB DIGITS DIV .10 IOR .48 IN IOR TEMP9 DECIMAL ADB .48 BLF,BLF CPA NAM+1 SAME AS LAST? RSS YES! JMP BYE4 NO, STORE IT! CPB NAM+2 LAST CHAR SAME? JMP BYE5 YES, GO TO NEXT NAME! BYE4 DST NAM+1 SET NEW NAME JSB EXEC SCHEDULE OVERLAYS DEF *+4 TO ABORT THEMSELVES DEF TCODE WITHOUT WAIT DEF NAM AND WITHOUT ERRORS DEF AB NOP BYE5 LDB TEMP2 INCREMENT ADB .4 TO NEXT STB TEMP2 ENTRY ISZ TEMP1 END OF SUBS? JMP BYE2 NO! JMP EEND4 YES! * NAM ASC 3,%BXXXX TCODE OCT 100012 TERMINATE W/0 ERROR AB ASC 1,AB SKP ********************************************************************* * * * THIS ROUTINE REPLACE ALL ABSOLUTE GOTO WITH STMT #'S * * * ********************************************************************* STREN NOP LDA PBUFF STA RENQ ADA M1 STA RENP SEEK EMBEDDED REN12 JSB RENSK STATEMENT REFERENCES JMP STREN,I NONE LEFT LDA RENP,I IF REFERENCE IS CPA COMMA COMMA? JMP REN12 YES, CONTINUE MIGHT BE GOTO-OF ETC. JSB RENS0 SET STMT NUMBER TO ABSOLUTE ADDRESS JMP REN12 * RENSK NOP LDB M5 STB RENCT SET 'IF' COUNTER LDB PSTIF STB RENAD SET PAST IF STMT PTR ISZ RENP INCREMENT POINTER LDB RENQ ~= ADDRESS OF BEGINNING OF NEXT STMT LDA USFLG PRINT USING SZA LAST STMT? JMP RENS2 YES, SKIP OVER REST OF STMT! LDB RENQ CPB RENP STATEMENT FINISHED? JMP RENS2 YES RENS1 ISZ RENSK NO, RETURN WITH RENP JMP RENSK,I SET TO NEXT REFERENCE STB RENQ UPDATE TO NEXT STATEMENT RENS2 CLA SET PRINT USING STA USFLG CLEAR CPB PBPTR PROGRAM EXHAUSTED? JMP RENSK,I YES STB RENR SAVE CURRENT STATEMENT ADDRS ISZ RENQ LDB RENQ ISZ RENQ EXTRACT LDA RENQ,I STATEMENT AND OPMSK TYPE ADB 1,I SET (B) TO ADB M1 NEXT STATEMENT CPA RESOP ? JMP RENS5 YES CPA GOTOP NO, ? JMP RENS3 YES CPA GOSOP NO, ? JMP RENS3 YES CPA FALOP NO, ? JMP RENS3 YES CPA CALOP NO, ? RSS YES CPA TRPOP NO, ? RSS YES! CPA PRTOP NO, ? RSS YES! CPA IFOP NO, ? RSS YES! JMP RENS2-1 LDA RENAD,I GET PAST 'IF' OPERATOR RENS3 IOR INTFL CREATE REFERNCE HEADER STB RENQ SET POINTER TO NEXT STMT ADB M1 SET PTR TO RENS4 STB RENP PROSPECTIVE HEADER? ADB M1 CPB RENR END OF STATEMENT? JMP RENS6 YES! RENS8 CPA 1,I PRECEDED BY REFERENCE HEADER? JMP RENS7 YES ISZ RENAD GOTO NEXT OPERATOR LDA RENAD,I PAST 'IF' IOR INTFL ISZ RENCT DONE? JMP RENS8 NO! LDA PSTIF STA RENAD LDA M5 STA RENCT LDA OFOP YES, LOAD HEADER FOR CPA 1,I JMP RENS1 LDA USEOP PRINT USING? CPA 1,I )JMP RENS1 JMP RENS4 REFERENCE LIST RENS5 CPA RENQ,I ANY REFERENCE? JMP RENS2-1 NO JMP RENS3 YES RENS6 LDB RENQ 'THEN','GOTO', OR 'GOSUB' JMP RENS2 NOT FOUND * RENS7 CPA USEOP ? STA USFLG YES, SET 'PRINT USING' FLAG SO AS TO SKIP REST OF STMT JMP RENS1 * RENS0 NOP LDA RENP,I GET STMT NUMBER LDA 0,I STA RENP,I STUFF IN STMT NUMBER JMP RENS0,I * * INTFL OCT 100003 RENCT DEC -3 RENAD DEF THNOP RENP BSS 1 RENQ BSS 1 RENR BSS 1 USFLG NOP COMMA OCT 102003 PSTIF DEF *+1 THESE THNOP OCT 60000 SIX GOTOP OCT 37000 ITEMS MUST GOSOP OCT 43000 BE CONTIGUOUS RESOP OCT 55000 ** PRTOP OCT 53000 IFOP OCT 40000 OFOP OCT 177003 TRPOP OCT 66000 USEOP OCT 161003 FALOP OCT 57000 CALOP OCT 50000 OPMSK OCT 77000 SKP ********************** * * ** EXECUTE ASSIGN ** * * ********************** * EASSN LDA TEMP6 SET UP STA ICCNT FILE NAME COUNT LDB TEMP7 SET UP STB INBFA FILE NAME ADDRESS JSB GETCR GET FIRST CHAR OF NOP FILE NAME JSB NAMD0 SET UP FOR DEF NAME FILE MGR OPEN DLD TEMP8,I GET FILE NUMBER JSB IFIX MAKE INTEGER STA 1 CMB,INB IS IT GREATER ADB M16 THAN 17 SSB,RSS JMP GTERR YES ADA M1 NO, GET ADA FILBK POINTER LDB 0,I TO DCB SZB,RSS IS THERE A DCB ASSIGNED? JMP GTERR NO, CAN'T GO FROM HERE SSB HAS IT BEEN OPENED YET? JMP EASS1 NO, SO DO IT ALREADY EASS2 STB TEMP7 ADB .15 CLEAR CLA IF 'END' STA 1,I FLAG JSB OPEN OPEN DEF *+7 DEF TEMP7,I NEW DEF FERR DEF NAME FILE DEF .1 DEF SC AND CLOSE OLD DEF LU SSA,RSS ANY ERRORS CLA NO,SET FOR NO ERROR EASS3 JSB FLOAT MAKE FLT PT DST TEMP9,I YES , PASS ERROR TO BASIC JMP XEC4 * EASS1 CMB,INB W DCB STB 0,I POINTER JMP EASS2 * GTERR LDA M5 SET FOR ILLEGAL JMP EASS3 FILE NUMBER ERROR SKP * * READ MNEMONIC TABLE INTO SPACE BETWEEN LONGEST * SEGMENT AND NEXT TO LONGEST SEGMENT * LOADM NOP LDA DCBAD SET UP STA DCB DATA CONTROL BLOCK JSB OPEN OPEN DEF *+7 MNEMONIC DEF DCB,I TABLE DEF FERR FILE DEF MNNAM DEF .0 DEF MNNAM+3 DEF MNNAM+4 JSB CKERR ERROR? LDA FWAMM SET STARTING STA TEMP4 ADDRESS OF MNEMONIC TBL LOAD3 JSB READF READ DEF *+6 DEF DCB,I MNEMONIC DEF FERR DEF TEMP4,I TABLE DEF .9999 INTO CORE DEF TEMP6 LDB TEMP6 CPB M1 EOF READ? JMP LOAD7 YES ADB TEMP4 NO, SET NEW READ STB TEMP4 INDEX * JMP LOAD3 NO, READ SOME MORE LOAD7 JSB CKERR ERROR? JSB CLOSE CLOSE DEF *+4 DEF DCB,I THE DEF FERR DEF .0 FILE JSB CKERR JMP LOADM,I SKP ********************************** * * * WRITE OUT REMAINDER OF FILES * * * ********************************** * WRREC NOP LDB DCB IS ADB .2 FILE LDB 1,I TYPE 0? SZB,RSS JMP WRXIT YES, CLOSE IT LDB DCB HAS ADB .13 BUFFER LDA 1,I BEEN SLA,RSS WRITTEN ON? JMP WRXIT NO, SO DON'T WRITE AND MNEG YES, CLEAR IT STA 1,I INB NOW CORRECT CCA RECORD ADA 1,I COUNTER SZA UNLESS STA 1,I START OF FILE ADB M2 RESET LDA DCB WORD ADA .16 LOCATION STA 1,I JSB WRITF OUT DEF *+6 NEXT DEF DCB,I RECORD DEF FERR DEF TEMP6,I DEF .128 DEF .0 JSB CKERR CHECK FOR ERROR WRXIT JSB CLOSE CLOSE DEF *+4 DEF DCB,I THE DEF FERR DEF .0 FILE JMP WRREC,I * * CKERR NOP LDA FERR IS THERE SSA,RSS A FILE MANAGER ERROR? JMP CKERR,I NO! STA TEMP3 YES! JMP OUTER PRINT MESSAGE AND ABORT SKP * SUBROUTINE TO DECODE NAME PRAMS * CALLING SEQUENCE * JSB NAMD0 * DEF NAME * A REG= CURRENT CHAR * UPON RETURN * NAME, NAME+1, NAME+2 = FILE NAME * NAME+3 = SECURITY CODE * NAME+4 = LOGICAL UNIT * NAMD0 NOP LDB NAMD0,I GET NAME BUFFER ADDR STB NAMA AND SAVE IT IN NAME PTR ISZ NAMD0 ADB .3 STB GETNM SAVE PTR TO SC WORD CLB GET A ZERO STB GETNM,I AND CLEAR SC AND LU ISZ GETNM STB GETNM,I JSB LNAME GET NAME...A REG 0,IGNORE SPACES NAMA BSS 1 BUFFER WHERE TO PUT NAME DEC -7 MAX LENGTH + 1 LDB NAMA STEP POINTER ADB .3 TO SECURITY STB NAMA CODE SLOT SPC 1 * AT THIS POINT WE HAVE MOVED THE NAME IN SPC 1 JSB CHRCK CHECK FOR END OF LINE JMP NAMD0,I YES...TERMINATE ROUTINE JSB GETNM GET NUMBER RSS NOT NUMERIC JMP NMDCD NUMERIC SAVE SC CODE JSB CHRCK CHECK FOR DELEM. JMP NAMD0,I END OF LINE JMP NMDCE NO SECURITY CODE ALF,ALF SHIFT TO HIGH ORDER STA NAMA,I SAVE TOP HALF OF SECURITY CODE JSB GETCR GET NEXT CHAR LDA .10 STA 1 SAVE CHAR JSB CHRCK TERMINATOR NOP EOF...SET FOR SPACE LDA .32 GET A SPACE IOR NAMA,I OR IN BOTTOM HALF OF SECURITY WORD STA NAMA,I SAVE COMPLETE SECURITY CODE LDA 1 GET CHARACTER AGAIN JSB CHRCK ARE WE DONE? JMP NAMD0,I YES...RETURN JMP NMDCF YES...GO PROCESS LU JSB GETCR GET ANOTHER CHARACTER LDA .10 EOF! RSS NO...CHECK NEXT CHAR...MUST BE A ":" NMDCD STB NAMA,I SAVE NUMERIC SECUITY CODE NMDCE JSB CHRCK CHECK FOR TERMINATOR JMP NAMD0,I DONE RSS CONTINUE...GOT A : JSB ERROR INVALID SECURITY CODE CERR1 EQU * SPC 1 * WE NOW HAVE PROCESSED THE NAME AND SECURITY CODE * NOW WE ARE GOING TO PROCESS LU SPC 1 NMDCF JSB GETNM GET NUMBER DERR JSB ERROR NOT A NUMBER, INVALID LU CERR2 ISZ NAMA SAVE LU VALUE STB NAMA,I JMP NAMD0,I RETURN SPC 1 SPACE ASC 1, SPC 2 * * SUBROUTINE TO GET A FLOATING POINT NUMBER * CONVERT IT, AND RETURN IT IN THE B REG * THE A REG=NEXT CHAR * CALLING SEQUENCE * JSB GETNM * UNABLE TO CONVERT RETURN * CONVERTED RETURN * B REG=NUMBER * GETNM NOP JSB GETCR GET NEXT CHAR LDA .10 CPA .10 EOF? JMP GETNM,I YES, RETURN CLB,CLE CLEAR E AND B REG STB TEMP1 CLEAR OUT SUM WORD STB TEMP2 CLEAR OUT DIGIT RECIEVED WORD CPA .43 IS IT A "+" CCE SET E=READ ANOTHER CHAR CPA .45 IS IT A "-" CCB,CCE SET B=-1, SET E =READ ANOTHER CHAR STB SIGN SAVE SIGN SEZ,RSS READ ANOTHER CHAR? JMP *+3 NO! GTNMA JSB GETCR YES LDA .10 EOF! JSB DIGCK GO SEE IF DIGIT IS NUMERIC JMP GTNMB NOT NUMERIC...DONE CONVERSION LDA TEMP1 GET PARTICAL SUM IN A REG STB TEMP1 DIGCK RETURN NUMBER IN BOTH A AND B REG MPY .10 MULTIPLY PARTICAL SUM BY 10 ADA TEMP1 AND IN NEXT DIGIT STA TEMP1 SAVE NEW SUM ISZ TEMP2 SET FOR RECIEVED A DIGIT JMP GTNMA GET NEXT DIGIT SPC 1 GTNMB LDB TEMP2 DID WE GET ANY DIGITS? SZB,RSS JMP GETNM,I NO LDB SIGN GET SIGN CLE,ERB IF NEGATIVE, SET E REG LDB TEMP1 GET BINARY VALUE SEZ NEGATIVE VALUE? CMB,INB YES...NEGATE RESULT ISZ GETNM GET DIGIT RETURN JMP GETNM,I RETURN SPC 2 SKP * * SUBROUTINE TO CHECK IF A CHARACTER IN THE A REG * IS EITHER AN END OF LINE ".10" OR A : "B72" * CALLING SEQUENCE * JSB CHRCK * END OF LINE RETURN * COLEN RETURN * NEITHER RETURN * A REG CONTAINS THE CHARACTER * B AND E REG NOT CHANGED * CHRCK NOP CPA .10 IS IT END OF LINE? JMP CHRCK,I YES...EOL RETURN CPA B54 IS IT A ","? JMP CHRCK,I YES...TREAT AS A EOL ISZ CHRCK CPA B72 IS IT A ":" JMP CHRCK,I ":" RETURN ISZ CHRCK JMP CHRCK,I NO DELM RETURN SKP * * ROUTINE TO MOVE NAME INTO NAME BUFFER * CALLING SEQUENCE * JSB LNAME * DEF BUFFER ADDRESS WHERE TO STORE NAME * DEC -MAX # OF CHARACTERS +1 * RETURN...A REG = DEL CHAR * LNAME NOP STA TEMP5 SAVE CURRENT CHAR LDA LNAME,I GET ADDRESS OF NAME BUFFER LDB SPACE CLEAR STB 0,I INA NAME STB 0,I INA STB 0,I BUFFER LDA LNAME,I RECOVER NAME BUFFER ADDRESS ISZ LNAME GET TO NEXT PARM CLE,ELA CONVERT TO BYTE ADDRESS STA TEMP1 SAVE BYTE ADDRESS LDA LNAME,I GET MAX LENGTH +1 ISZ LNAME GET TO RETURN ADDRESS ^ STA TEMP2 SAVE FOR DOWN COUNTER LDA TEMP5 GET CURRENT CHAR LMDCD JSB CHRCK CHECK FOR DELEMETER NOP JMP LNAME,I HIT ONE LDB TEMP1 GT BYTE ADDRESS JSB SBYTE SAVE CHARACTER JSB GETCR GET NEXT CHARACTER LDA .10 CPA .10 EOF? JMP LNAME,I YES, RETURN! ISZ TEMP1 GET NEXT CHAR ADDRESS ISZ TEMP2 OUT OF ROOM? JMP LMDCD NO..CONTINUE JSB ERROR INVALID FILE NAME CERR3 EQU * SPC 2 SKP SPC 3 * * SUBROUTINE TO STORE A BYTE * CALLING SEQUENCE * JSB SYBTE * A REG CONTAINS BYTE * B REG CONTAINS BYTE ADDRESS * SBYTE NOP AND B377 MASK ALL BUT LOWER 8 BITS STA TEMP7 SAVE IN TEMP LOCATION CLE,ERB CHANGE FROM BYTE TO WORD ADD LDA 1,I GET WORD SEZ,RSS RIGHT OR LEFT HALF ALF,ALF LEFT AND HIMSK MASK ALL BUT UPPER 8 BITS IOR TEMP7 OR IN NEW BYTE SEZ,RSS LEFT OR RIGHT ALF,ALF LEFT STA 1,I STORE WORD BACK ELB,CLE GET BYTE ADDRESS AGAIN JMP SBYTE,I RETURN * *********************** * * * PRINT ERROR MESSAGE * * * *********************** ERROR NOP LDA ERBS ERROR ADDRESS IN (A) LDB ERROR ERROR SOURCE IN (B) INA MOVE TO NEXT ERROR CPB 0,I SAME AS ACTUAL ERROR? CMA,INA,RSS YES, MAKE ERROR NEGATIVE JMP *-3 NO ADA ERBS MAKE ERROR POSITIVE CMA,INA ADA .45 ACCOUNT FOR SHORTENED TABLE STA TEMP3 SAVE IT JMP OUTER PRINT ERROR MESSAGE SKP *************** * * * ERROR TABLE * * * *************** ERR DEF * DEF CERR1 INVALID SECURITY CODE DEF CERR2 INVALID LU DEF CERR3 INVALID FILE NAME * NFMT EQU TEMPS+1 TEMP1 EQU o`^ZTEMPS+2 TEMP2 EQU TEMPS+3 TEMP3 EQU TEMPS+4 TEMP4 EQU TEMPS+5 TEMP5 EQU TEMPS+6 TEMP6 EQU TEMPS+7 TEMP7 EQU TEMPS+8 TEMP8 EQU TEMPS+9 TEMP9 EQU TEMPS+10 TEM10 EQU TEMPS+11 FERR EQU TEMPT+1 FILE ERROR FLAG NAME EQU TEMPT+2 SC EQU TEMPT+5 LU EQU TEMPT+6 * END BASC8 ` Ak 92101-18008 1805 S C0822 BASIC TABLE GENERATOR              H0108 >SPL,L,O ! NAME: RTETG ! SOURCE: 92101-18008 ! RELOC: 92101-16008 ! PGMR: ADELE GADOL ! DATE: 750818 ! ! **************************************************************** ! * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1975. ALL RIGHTS * ! * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * ! * REPRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* ! * THE PRIOR WRITTEN CONSENT OF HEWLETT PACKARD COMPANY. * ! **************************************************************** ! NAME RTETG(3,99) "92101-16008 REV.1805 771103" ! ! ! LET T.ENT(900), \ENTRY POINT BUFFER T.BRN(525), \BRANCH TABLE BUFFER T.COM(75), \COMMAND BUFFER T.OVB(96), \MNTBL AND OVERLAY BUFFER T.FIL(8), \FILE NAME BUFFER T.DCB(144), \DCB BUFFER T.BAD, \BRANCH TABLE ADDRESS T.SUB(32), \SUBROUTINE COUNT BUFFER T.ERN, \ERROR CODE T.PRI, \PRIORITY FOR OVERLAYS T.SEC, \SCODE FOR OVERLAY DIRECTS. T.CRF, \CR REF # FOR OVERLAYS T.MAD, \MNEMONIC TABLE ADDRESS T.EAD, \ENTRY POINT TABLE ADDRESS T.LEN, \LINE LENGTH, # ENTRIES T.CON, \CONTROL WORD T.IDL \ID LETTER BE INTEGER,GLOBAL ! LET CMDCB(16), \COMMAND DCB SAVE BRDCB(16), \BRANCH TABLE DCB SAVE MNDCB(16), \MNEMONIC TABLE DCB SAVE TRDCB(16), \TRANSFER FILE DCB SAVE FMERR(9), \FMGR ERROR TABLE T.ERR(9), \RTETG ERROR TABLE \ \ THE FOLLOWING DECLARATIONS SHOULD STAY IN THIS ORDER. \ BRNAM(3), \BRANCH FILE NAME BRSEC, \BRANCH SECURITY CODE BRICR, \BRANCH CARTRIDGE ID MNNAM(3), \MNEMONIC TABLE NAME MNSEC, \MNEMONIC SECURITY CODE MNICR, \MNEMONIC CARTRIDGE ID TRNAM(3), \TRANSFER FILE NAME TRSEC, \TRANSFER SECURITY CODE TRICR, \TRANSFER CARTRIDGE ID SAVE, \TEMPORARY ADDR, \TEMPORARY MIN1, \SAVE FOR SORT MIN2, \SAVE FOR SORT ER(5), \END MESSAGE RA(7) \ABORT MESSAGE BE INTEGER ! LET A BE CONSTANT(0) ! LET .DFER, \3-WORD TRANSFER T.LNK \LINKAGE SUBROUTINE BE SUBROUTINE,DIRECT,EXTERNAL ! INITIALIZE FMERR TO -1,-2,-6,-7,-8, \ -13,-14,-15,-17 INITIALIZE T.ERR TO 10,15,11,14,12, \ 13,11,9,17 INITIALIZE T.ERN,BRSEC,BRICR,MNSEC, \ MNICR,TRSEC,TRICR TO 7(0) INITIALIZE ER TO "$END RTETG" INITIALIZE RA TO "$RTETG ABORTED" INITIALIZE T.SUB TO 32(0) ! LET READF, \FMGR READ RECORD WRITF, \FMGR WRITE RECORD CREAT, \FMGR CREAT FILE OPEN, \FMGR OPEN FILE CLOSE, A \FMGR CLOSE FILE PURGE, \FMGR PURGE FILE RWNDF, \FMGR REWIND POST, \POST DCB BUFFER EXEC, \RTE SYSTEM CALLS RMPAR \RETRIEVE PARAMETERS BE SUBROUTINE,EXTERNAL ! ! THE FOLLOWING SUBROUTINE MOVES A 16-WORD BLOCK FROM ! BUFR1 TO BUFR2. ! MOVE: SUBROUTINE(BUFR1,BUFR2) LET BUFR1,BUFR2 BE INTEGER SAVE _ @BUFR2; ADDR _ @BUFR1 !SET BUFFER POINTERS. REPEAT 16 TIMES DO [ \DO THE MOVE. $SAVE _ $ADDR; $ADDR _ 0; \CLEAR OUT ORIGINAL ADDR _ ADDR + 1; \BUFFER IN THE SAVE _ SAVE + 1] !PROCESS. RETURN END ! ! ! SAVBF: SUBROUTINE(DCBBF) DIRECT LET DCBBF BE INTEGER POST(T.DCB) MOVE(T.DCB,DCBBF) RETURN END ! ! ! THE FOLLOWING SUBROUTINE CHECKS FOR ERRORS AND ! TRANSLATES A FMGR ERROR TO AN RTETG ERROR CODE ! IF NECESSARY. THEN IT PRINTS THE ERROR. ! T.ERC: SUBROUTINE DIRECT,FEXIT,GLOBAL IFNOT T.ERN THEN RETURN !RETURN IF ERROR=0. SAVE _ @FMERR; ADDR _ @T.ERR !SET UP POINTERS. IF T.ERN > 0 THEN GOTO T.ER1 !IF FMGR ERROR, REPEAT 9 TIMES DO [ \SEARCH THE FMGR IF T.ERN = $SAVE THEN [ \ERROR TABLE. T.ERN _ $ADDR; GOTO T.ER1]; \TRANSLATE A MATCH. SAVE _ SAVE + 1; \INCREMENT POINTERS ADDR _ ADDR + 1] !AND LOOP. T.ER1: .A. _ 0; .B. _ 1; T.LNK !PRINT MESSAGE. T.ERN _ 0 FRETURN END ! ! THE FOLLOWING SUBROUTINE CREATES A FILE AND ! SAVES THE DCB. ! CRFIL: SUBROUTINE(TYPE,DCBSV,FLNAM,FLSEC,FLICR) FEXIT LET TYPE,DCBSV,FLNAM,FLSEC,FLICR BE INTEGER CREAT(T.DCB,T.ERN,FLNAM,10,TYPE, \TRY CREATING THE FLSEC,FLICR) !FILE. IF T.ERN > 0 THEN T.ERN _ 0 T.ERC ? [FRETURN] !REPORT ANY ERRORS. SAVBF(DCBSV) !SAVE DCB BUFFER. RETURN END ! ! ! CLSFL: SUBROUTINE(SVDCB) LET SVDCB BE INTEGER MOVE(SVDCB,T.DCB) !RESTORE CORRECT DCB. CLOSE(T.DCB,T.ERN) !CLOSE THE FILE. T.ERC RETURN END ! ! ! PRGFL: SUBROUTINE(DCBUF,FNAM,FSEC,FICR) LET DCBUF,FNAM,FSEC,FICR BE INTEGER CLSFL(DCBUF) PURGE(T.DCB,T.ERN,FNAM,FSEC,FICR) IF T.ERN > 0 THEN T.ERN _ 0 T.ERC RETURN END ! ! SUBROUTINE TO CLEAR THE READ BUFFER. ! CLBUF: SUBROUTINE DIRECT SAVE _ @T.COM REPEAT 31 TIMES DO [ \ $SAVE _ 0; SAVE _ SAVE + 1] RETURN END ! ! ! THE MAIN PROGRAM STARTS HERE ! RTETG: RMPAR(T.MAD) !RETRIEVE PARAMETERS. IFNOT T.CON THEN T.CON _ 6 !DEFAULT LIST IF NEC. T.CON _ (T.CON AND 77K) OR 200K !SET UP T.CON. IFNOT T.EAD THEN T.EAD _ " " !IF NECESSARY, PAD FILE IFNOT T.LEN THEN T.LEN _ " " !NAME WITH BLANKS. OPEN(T.DCB,T.ERN,T.MAD) !OPEN COMMAND FILE. IF T.ERN > 0 THEN T.ERN _ 0 IF T.ERN = -6 THEN T.ERN _ 16 T.ERC ? [GOTO ABORT] !REPORT ANY ERRORS. ! CLBUF !CLEAR READ BUFFER. READF(T.DCB,T.ERN,T.COM,40,T.LEN) !GET FILE NAMES. T.ERC ? [GOTO ABRT0] !REPORT ANY ERRORS. ! SAVBF(CMDCB) T.MAD _ @BRNAM; .A.,.B. _ 0 !SET UP FOR T.GFI. T.LNK !PARSE THE 1ST COMMAND. T.ERC ? [GOTO ABRT0] !CHECK FOR ERRORS. CRFIL(7,BRDCB,BRNAM,BRSEC,BRICR) ? \CREATp2E BRTBL FILE. [GOTO ABRT0] ! CRFIL(7,MNDCB,MNNAM,MNSEC,MNICR) \CREATE MNTBL FILE. ? [GOTO ABRT1] ! CRFIL(3,TRDCB,TRNAM,TRSEC,TRICR) \CREATE TRANSFER FILE. ? [GOTO ABRT2] ! MOVE(TRDCB,T.DCB) !PUT TRANSFER FILE OPEN(T.DCB,T.ERN,TRNAM,0,TRSEC,TRICR) SAVBF(TRDCB) !IN NORMAL WRITE MODE. MOVE(MNDCB,T.DCB) WRITF(T.DCB,T.ERN,T.COM,1) !SAVE SPACE FOR LENGTH. T.ERC ? [GOTO ABRT3] !CHECK ERRORS. MIN1 _ 1 !SET UP POINTERS T.EAD _ @T.ENT; I _ 0 !FOR TABLE BUILDER. RTET5: T.MAD _ @T.OVB; SAVBF(MNDCB) !FOR ALL SPECS . . . T.BAD _ @T.BRN; J _ 0 ! RTET2: CLBUF; MOVE(CMDCB,T.DCB) !CLEAR READ BUFFER READF(T.DCB,T.ERN,T.COM,75,T.LEN) !READ A RECORD. SAVBF(CMDCB) IF T.LEN = -1 THEN GOTO RTET6 !IF DONE, LEAVE LOOP. IF I = 300 THEN T.ERN _ 10 !CHECK FOR TABLE OVERFLOW. T.ERC ? [GOTO ABRT3] !REPORT ERRORS. EXEC(100002K,T.CON,T.COM,T.LEN) !WRITE A LINE. GOTO ABRT3 !ERROR RETURN. .A. _ MIN1; .B. _ 0; T.LNK !BUILD TABLE ENTRIES. T.ERC ? [GOTO ABRT3] !REPORT ERRORS. MIN1 _ 100001K; MOVE(TRDCB,T.DCB) !SET SEG SWITCH WRITF(T.DCB,T.ERN,T.FIL,5) !SAVE FILE NAME SAVBF(TRDCB); T.ERC ? [GOTO ABRT3] !IN TRANSFER FILE. I _ I + 1; J _ J + 1 !INCREMENT COUNTERS. IF J < 15 THEN GOTO RTET2 ! RTET6: MOVE(BRDCB,T.DCB) !RESTORE BRANCH DCB. WRITF(T.DCB,T.ERN,T.BRN, \ (T.BAD-@T.BRN)) ! SAVBF(BRDCB) !SAVE BRTBL DCB. T.ERC ? [GOTO ABRT3] !REPORT ANY ERRORS. ! MOVE(MNDCB,T.DCB) WRITF(T.DCB,T.ERNI,T.OVB, \WRITE THIS SEGMENT (T.MAD-@T.OVB)) !OF MNTBL. T.ERC ? [GOTO ABRT3] !CHECK ERRORS. IF T.LEN >= 0 THEN GOTO RTET5 !CHECK FOR DONE. ! T.OVB(1) _ -I !PUT IN SUB. COUNT. RWNDF(T.DCB) !GO BACK TO BEGINNING. WRITF(T.DCB,T.ERN,T.OVB,1) !WRITE MNTBL. SAVBF(MNDCB) !SAVE MNTBL DCB. T.ERC ? [GOTO ABRT3] !REPORT ERRORS. ! ! T.BAD _ @T.BRN; K _ 0 !READ IN THE BRANCH MOVE(BRDCB,T.DCB); RWNDF(T.DCB) !TABLE, CONDENSING IT RTET3: READF(T.DCB,T.ERN,$T.BAD,60,T.LEN) !TO PAIRS OF ENTRIES. IF T.LEN = -1 THEN GOTO RTET1 !IF EOF, SKIP. T.ERC ? [GOTO ABRT3] !REPORT ANY ERRORS. T.LEN _ T.LEN >-1 FOR I _ 2 TO (T.LEN-2) BY 2 DO \CONDENSE THIS PIECE [$(T.BAD+I) _ $(T.BAD+(I<-1))] !OF THE TABLE. K _ K + T.LEN !UPDATE POINTERS. T.BAD _ T.BAD + T.LEN GOTO RTET3 !READ MORE PIECES. ! RTET1: SAVBF(BRDCB) ADDR _ @T.BRN; T.EAD _ @T.ENT !SET UP FOR SORT FOR I _ 1 TO (K-1) BY 2 DO \NUMBER ENTRIES WITH [$(ADDR+I) _ (I-1) >-1] !RECORD POSITION. I _ 0 !SORT ACCORDING TO RTET4: $[REAL]@MIN1 _ $[REAL](ADDR+I) !OVERLAY AND SUB- SAVE _ I !ROUTINE NUMBER. FOR J _ I+2 TO (K-2) BY 2 DO \DO THE SORT. [IF $(ADDR+J) < MIN1 THEN [ \ $[REAL]@MIN1_$[REAL](ADDR+J); \ SAVE _ J]] ! $[REAL](ADDR+SAVE) _ $[REAL](ADDR+I) $[REAL](ADDR+I) _ $[REAL]@MIN1 MIN1 _ (I >-1)*3 + T.EAD !SET UP ADDRESS PTRS. MIN2 _ (SAVE >-1)*3 + T.EAD !TO ENT. PT. NAMES. .DFER(T.COM,$MIN1) !EXCHANGE THE ENTRY .DFER($MIN1,$MIN2) !POINT NAMES CORRES. .DFER($MIN2,T.COM) !TO BRTBL ENTRIES. I _ I + 2 IF I <= (K-4) THEN GOTO RTET4 .A.,.B. _ 1; T.LNK !CREATE OVERLAY DIRS. T.ERC ? [GOTO ABRT4] !REPORT ERRORS. ! MOVE(TRDCB,T.DCB) IF T.LEN THEN [ \IF ANY OVERLAYS .B. _ 2; T.LNK; \WERE CREATED, THEN T.ERC ? [GOTO ABRT4]] !CREATE TRANSFER FILE. ! ! ! NORMAL RETURN FROM MAIN. ! CLOSE(T.DCB,T.ERN) !CLOSE TRANSFER FILE. T.ERC !REPORT ERRORS - CONT. CLSFL(MNDCB) !CLOSE MNTBL FILE. CLSFL(BRDCB) !CLOSE BRTBL FILE. CLSFL(CMDCB) !CLOSE COMMAND FILE. IF T.ERN THEN GOTO ABORT !IF T.ERN, IND. ABORT. ! EXEC(2,1,ER,5) !PRINT END MESSAGE. GOTO TERM !TERMINATE. ! ! ABORT SEQUENCE FROM MAIN. ! ABRT4: IFNOT T.LEN THEN GOTO ABRT3 !ERROR FROM T.OVL. ADDR _ @T.OVB + 1 REPEAT T.LEN TIMES DO [ \ATTEMPT TO PURGE PURGE(T.DCB,T.ERN,$ADDR,T.SEC, \CREATED OVERLAYS, IF T.CRF); \ T.ERC; ADDR _ ADDR + 4] !ANY. PRINT MESSAGES. ABRT3: PRGFL(TRDCB,TRNAM,TRSEC,TRICR) !PURGE TRANSFER FILE. ABRT2: PRGFL(MNDCB,MNNAM,MNSEC,MNICR) !PURGE MNTBL FILE. ABRT1: PRGFL(BRDCB,BRNAM,BRSEC,BRICR) !PURGE BRTBL FILE. ABRT0: CLSFL(CMDCB) !CLOSE COMMAND FILE. ABORT: EXEC(2,1,RA,7) !PRINT ABORT MESS. TERM: EXEC(3,((T.CON AND 77K) OR 1100K),-1)!EJECT PAGE. EXEC(6) !TERMINATE. ! END RTETG END$ 0.**0ASMB,R,L,C HED LINKAGE SUBROUTINE * * NAME: T.LNK * SOURCE: 92101-18008 * RELOC: 92101-16008 * PGMR: ADELE GADOL * * **************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1975. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT PACKARD COMPANY. * * **************************************************************** * NAM T.LNK,8 92101-16008 REV.1805 771103 * SUP * ENT T.LNK ENT T.LN1 * EXT EXEC * * * THE FOLLOWING SUBROUTINE PROVIDES THE LINKAGE * FROM THE MAIN TO EACH OF THE TWO SEGMENTS OF RTETG. * * CALLING SEQUENCE: * LDA SUBROUTINE # (SIGN BIT = DON'T LOAD SEGMENT) * LDB OVERLAY # * JSB T.LNK * * T.LNK NOP RAL,CLE,ERA GET SIGN BIT. STA NSUB SAVE SUBROUTINE NUMBER. SEZ NEED WE LOAD THE SEGMENT? JMP T.LN2 NO - WE HAVE IT. ADB NSEG FIX UP SEGMENT NAME STB SNAME+1 TO LOAD PROPER SEGMENT. JSB EXEC LOAD THE SEGMENT. DEF T.LN1 DEF D8 DEF SNAME SEGMENT NAME * T.LN1 LDA NSUB SEGMENT RETURNS HERE. STB T.SUB STORE CALSB ADDRESS. T.LN2 JSB T.SUB,I TRANSFER TO DESIRED SUBROUTINE. JMP T.LNK,I RETURN TO MAIN. * NSUB BSS 1 T.SUB BSS 1 SNAME ASC 3,TG00S NSEG ASC 1,00 D8 DEC 8 * END lAASMB,R,L,C HED RTETG SEGMENT 0 * * NAME: TG00S * SOURCE: 92101-18008 * RELOC: 92101-16008 * PGMR: ADELE GADOL * * **************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1975. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT PACKARD COMPANY. * * **************************************************************** * NAM TG00S,5 92101-16008 REV.1805 771103 * SUP * * THE FOLLOWING ROUTINE PROVIDES THE LINKAGE TO * THE PROPER SUBROUTINE IN SEGMENT 0. WHEN TG00S * IS LOADED AND RUN, IT GETS THE ADDRESS OF CALSB * IN THE B-REG AND JUMPS TO T.LN1 IN T.LNK. THEN A * JSB IS DONE TO CALSB WITH A-REG = SUBROUTINE #. * * EXT T.LN1 ADDRESS IN T.LNK IN MAIN EXT T.GFI GET FILE INFORMATION SUBROUTINE EXT T.BTE BUILD TABLE ENTRIES SUBROUTINE * TG00S LDB SUBAD GET ADDRESS OF CALSB. JMP T.LN1 GO BACK TO MAIN. * SUBAD DEF CALSB SUB0 DEF T.GFI SUB1 DEF T.BTE * CALSB NOP LDB SUB0 SZA LDB SUB1 JSB 1,I JMP CALSB,I * END TG00S ASMB,R,L,C HED RTETG SEGMENT 1 * * NAME: TG01S * SOURCE: 92101-18008 * RELOC: 92101-16008 * PGMR: ADELE GADOL * * **************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1975. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT PACKARD COMPANY. * * **************************************************************** * NAM TG01S,5 92101-16008 REV.1805 771103 * SUP * * THE FOLLOWING ROUTINE PROVIDES THE LINKAGE TO * THE PROPER SUBROUTINE IN SEGMENT 1. WHEN TG01S * IS LOADED AND RUN, IT GETS THE ADDRESS OF CALSB * IN THE B-REG AND JUMPS TO T.LN1 IN T.LNK. THEN A * JSB IS DONE TO CALSB WITH A-REG = SUBROUTINE #. * * EXT T.LN1 ADDRESS IN T.LNK IN MAIN EXT T.MES MESSAGE PRINTING ROUTINE EXT T.OVL CREATE OVERLAY DIRECTORIES SUBROUTINE * TG01S LDB SUBAD GET ADDRESS OF CALSB. JMP T.LN1 GO BACK TO MAIN. * SUBAD DEF CALSB SUB0 DEF T.MES SUB1 DEF T.OVL * CALSB NOP LDB SUB0 SZA LDB SUB1 JSB 1,I JMP CALSB,I * END TG01S #ASMB,R,L,C HED RTETG SEGMENT 2 * * NAME: TG02S * SOURCE: 92101-18008 * RELOC: 92101-16008 * PGMR: ADELE GADOL * * **************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1975. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT PACKARD COMPANY. * * **************************************************************** * NAM TG02S,5 92101-16008 REV.1805 771103 * SUP * * THE FOLLOWING ROUTINE PROVIDES THE LINKAGE TO * THE PROPER SUBROUTINE IN SEGMENT 2. WHEN TG02S * IS LOADED AND RUN, IT GETS THE ADDRESS OF CALSB * IN THE B-REG AND JUMPS TO T.LN1 IN T.LNK. THEN A * JSB IS DONE TO CALSB WITH A-REG = SUBROUTINE #. * * EXT T.LN1 ADDRESS IN T.LNK IN MAIN EXT T.TRF CREATE TRANSFER FILE * TG02S LDB SUBAD GET ADDRESS OF CALSB. JMP T.LN1 GO BACK TO MAIN. * SUBAD DEF CALSB * CALSB NOP JSB T.TRF JMP CALSB,I * END TG02S ٪ASMB,R,L,C HED MESSAGE PRINTING ROUTINE * * NAME: T.MES * SOURCE: 92101-18008 * RELOC: 92101-16008 * PGMR: ADELE GADOL * * **************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1975. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT PACKARD COMPANY. * * **************************************************************** * NAM T.MES,8 92101-16008 REV.1805 771103 * SUP * ENT T.MES * EXT .ENTR,EXEC EXT T.CON DEVICE CONTROL WORD. EXT T.ERN ERROR NUMBER * * THE FOLLOWING ROUTINE PRINTS ALL ERROR MESSAGES. * THE MESSAGES ARE DERIVED FROM THE ERROR NUMBER, T.ERN. * * T.MES NOP LDB T.ERN GET ERROR MESSAGE SZB NUMBER AND CHECK ADB M18 BOUNDS. SSB,RSS JMP ILL UNDEFINED. ADB ADDMS GET ADDRESS OF MESSAGE. LDA B,I STA MSBUF SAVE ADDRESS. LDB T.ERN GET LENGTH OF MESSAGE. ADB LENMS LDA B,I STA MSLEN SAVE LENGTH. CMA,INA SET UP COUNTER FOR STA SAVE MESSAGE LENGTH IN ORDER LDB ADDR TO PACK THE MESSAGE. T.M1 LDA MSBUF,I GO AHEAD AND PACK STA B,I THE MESSAGE AFTER ISZ MSBUF THE "* ERROR *" INB IN THE BUFFER, FILL. ISZ SAVE JMP T.M1 LDA MSLEN ADA ERLEN STA MSLEN JSB EXEC DEF *+5 DEF D2 DEF T.CON DEF ERMSG DEF MSLEN JMP T.MES,I ILL JSB EXEC DEF *+5 DEF D2 DEF T.CON DEF RU DEF RUL JMP T.MES,I * B EQU 1 D2 DEC 2 M18 DEC -18 SAVE BSS 1 MSBUF BSS 1 MSLEN BSS 1 * ADDMS DEF *+22B DEF TMP 1. TOO MANY PARAMETERG  S DEF NTL 2. NAME TOO LARGE DEF EPNTL 3. ENTRY POINT NAME TOO LARGE DEF NEP 4. NOT ENOUGH PARAMETERS DEF IPS 5. ILLEGAL PARAMETER SPECIFICATION DEF IF 6. ILLEGAL FORMAT DEF TO 7. TABLE OVERFLOW DEF BEPN 8. BAD ENTRY POINT NAME DEF BFN 9. BAD FILE NAME. DEF DD 10. DISK DOWN DEF DODF 11. DISK OR DIRECTORY FULL DEF FO 12. FILE OPEN DEF CL 13. CARTRIDGE LOCKED DEF BSC 14. BAD SECURITY CODE DEF DFN 15. DUPLICATE FILE NAME. DEF CFNF 16. COMMAND FILE NOT FOUND. DEF CRCF 17. CANNOT READ COMMAND FILE. * LENMS DEF * DEC 10 DEC 7 DEC 13 DEC 11 DEC 16 DEC 7 DEC 7 DEC 10 DEC 7 DEC 5 DEC 11 DEC 5 DEC 8 DEC 9 DEC 10 DEC 11 DEC 12 * * MESSAGES * TMP ASC 10,TOO MANY PARAMETERS BEPN ASC 2,BAD EPNTL ASC 6,ENTRY POINT NTL ASC 7,NAME TOO LARGE NEP ASC 11,NOT ENOUGH PARAMETERS IPS ASC 16,ILLEGAL PARAMETER SPECIFICATION DFN ASC 10,DUPLICATE FILE NAME CRCF ASC 6,CANNOT READ CFNF ASC 11,COMMAND FILE NOT FOUND DD ASC 5,DISK DOWN DODF ASC 11,DISK OR DIRECTORY FULL TO ASC 7,TABLE OVERFLOW BFN ASC 7,BAD FILE NAME FO ASC 5 FILE OPEN CL ASC 8,CARTRIDGE LOCKED BSC ASC 9,BAD SECURITY CODE IF ASC 7,ILLEGAL FORMAT RUL DEC 8 RU ASC 8,RTETG UNDEFINED * ERLEN DEC 6 ERMSG ASC 6, * ERROR * FILL ASC 16, ADDR DEF FILL * END ASMB,R,L,C HED TABLE BUILDING ROUTINES * * NAME: T.BTE * SOURCE: 92101-18008 * RELOC: 92101-16008 * PGMR: ADELE GADOL * * **************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1975. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT PACKARD COMPANY. * * **************************************************************** * NAM T.BTE,8 92101-16008 REV.1805 771103 * SUP * * * * THE FOLLOWING ROUTINE BUILDS THE INDIVIDUAL TABLE * ENTRIES FOR RTETG. EACH TIME IT IS CALLED, IT PARSES * THE COMMAND LINE AND BUILDS AN ENTRY IN THE BRANCH * TABLE, MNEMONIC TABLE, ENTRY POINT NAME TABLE, AND * FILE NAME TABLE. * * CALLING SEQUENCE: * * COMMAND LINE IN T.COM (IN MAIN) * COMMAND LINE LENGTH IN T.LEN (IN MAIN) * T.MAD POINTS AT MNTBL SEGMENT * T.BAD POINTS AT BRTBL * T.EAD POINTS AT ENTRY POINT BUFFER * T.ERN = 0 * JSB T.BTE * RETURN ERROR CODE (T.ERN) UPDATED AND ADDRESS * POINTERS POINT TO NEXT ENTRY POSITION * T.SUB WILL BE FILLED IN * * * * FORMAT OF T.SUB IS AS FOLLOWS: * * * +-----------------------------------------------+ * !15!14!13!12!11!10! 9! 8! 7! 6! 5! 4! 3! 2! 1! 0! * +-----------------------------------------------+ * \LOADR OPTN/\ PAGE SIZE /\ SUBROUTINE CT / * * ENT T.BTE * EXT EXEC SYSTEM CALLS EXT .DRCT GET DIRECT ADDRESS SUBROUTINE EXT .DFER 3-WORD TRANSFER EXT T.COM COMMAND BUFFER (IN MAIN) EXT T.LEN COMMAND BUFFER LENGTH (IN MAIN) EXT T.IDL ID LETTER CODE (IN MAIN) EXT T.MAD MNEMONIC TABLE ADDRESS (IN MAIN) EXT T.BAD BRANCH TABLE ADDRESS (IN MAIN) EXT T.EAD - ENTRY POINT ADDRESS (IN MAIN) EXT T.ERN ERROR NUMBER (IN MAIN) EXT T.FIL FILE NAME ADDRESS (IN MAIN) EXT T.PRI PRIORITY FOR OVERLAYS (IN MAIN) EXT T.SEC SECURITY CODE FOR OVERLAYS (IN MAIN) EXT T.CRF CARTRIDGE # FOR OVERLAYS (IN MAIN) EXT T.SUB SUBROUTINE COUNT AND SIZE BUFFER EXT T.CON CONTROL WORD FOR OUTPUT (IN MAIN) * * T.BTE NOP JSB .DRCT SET UP POINTERS INTO THE DEF T.COM COMMAND BUFFER FOR T.GCR CLE,ELA STA T.ADR LDA T.LEN ALS CMA STA T.CNT JSB .DRCT SET UP POINTER TO DEF T.SUB SUBROUTINE COUNT BUFFER. STA SUNUM LDA T.BAD SET UP POINTERS INTO THE STA BR1 BRANCH AND MNEMONIC TABLE INA ENTRIES TO BE BUILT. STA BR2 INA STA BR3 INA STA BR4 LDA T.MAD STA MN1 INA STA MN2 STA SNAME LDA T.EAD STA EN1 STA ENAME STA EPNAM JSB .DRCT DEF T.FIL STA FNAME CLB STB A,I STB EN1,I STB BR3,I INITIALIZE TO-FROM WORD STB BR4,I INITIALIZE REAL-INTEGER WORD STB PRCNT INITIALIZE PARAMETER COUNT. STB FOUND CLEAR PARAMETER SEEN SWITCH. STB FNAME,I STB LDOPT SET REAL TIME PERMANENT FOR DEFAULT LDA OVNUM IF FIRST ADA SUNUM SUBRUTINE IN LDA 0,I IN OVERLAY THEN ZERO SIZE AND B77 SZA,RSS STA SIZE LDA AMASK SET DEFAULT STA BR2,I TO 'ARRAY' LDA B50 STA T.DLM SET DELIMITER TO "(" JSB T.GCR GET FIRST CHARACTER. JMP ERR4 ERROR - NOT ENOUGH PARAMETERS. JSB LNAME GET NAME( SNAME BSS 1 DEC -7 MAX OF 6 CHARS + "(" JMP ERR2 INVALID NAME STA SAVE SAVE DELIMITER CHARACTER. JSB CHRCK ANY PARAMETER DEԓSCRIPTIONS? JMP T.B10 NO. NOP LDB TEMP1 STORE "(" WITH NAME. JSB SBYTE ISZ TEMP1 JSB NMLEN CALCULATE NAME LENGTH. SPECS LDA PRCNT HAVE WE FOUND 15 PARAMETER CPA D15 SPECIFICATION? JMP ERR5 YES - ERROR. CLB SET UP TO GET ATTRIBUTES STB FNDIR FOR A PARAMETER. STB FNDA CLEAR FLAGS INDICATING STB FNDV ATTRIBUTES SEEN. STB SAVE GTAT1 JSB T.GCR GET A CHARACTER. JMP ERR6 ILLEGAL FORMAT. CPA B54 COMMA? RSS YES. CPA B51 RIGHT PARENTHESIS? RSS YES. JMP GTAT3 ORDINARY CHARACTER. LDB SAVE HAD WE FOUND ANY SZB,RSS ATTRIBUTES? JMP ERR5 NO - ILLEGAL PARAMETER SPECIFICATION. JMP GTAT2 YES - FINISHED WITH THIS SPEC. GTAT3 CLB HAVE A PARAMETER SPEC. CHARACTER. CPA ACHAR WHAT HAVE WE GOT? JMP AC "A" CPA ICHAR JMP I "I" CPA VCHAR JMP V "V" CPA RCHAR JMP R "R" JMP ERR5 ILLEGAL PARAMETER SPECIFICATION. * I INB SET UP PARAMETER BIT. R LDA FNDIR SEEN AN I OR SZA R SPEC? JMP ERR5 YES - ILLEGAL PARAMETER SPEC. INA INDICATE SPECIFICATION STA FNDIR FOUND. LDA BR4,I ROTATE PARAMETER BIT INTO RRR 1 THE CONVERSION WORD. STA BR4,I GTATT ISZ SAVE COUNT THE SPEC. CHARACTER. JMP GTAT1 GO LOOK FOR MORE. * GTAT2 ISZ PRCNT COUNT THE PARAMETER. STA SAVE SAVE BREAK CHARACTER. LDB FNDIR MAKE SURE BITS ARE SZB ROTATED PROPERLY ON JMP GTAT5 BRANCH TABLE WORDS LDA BR4,I REPRESENTING SPECIFICATION RRR 1 LETTERS NOT FOUND STA BR4,I DESCRIBING THIS PARAMETER. GTAT5 LDB FNDA SZB JMP GTAT6 LDA BRZ2,I RRR 1 STA BR2,I GTAT6 LDB FNDV SZB JMP GTAT7 LDA BR3,I RRR 1 STA BR3,I GTAT7 LDA SAVE GET BACK THE BREAK CHAR. CPA B51 AT THE END OF THE SPECS.? JMP GTAT4 YES. JMP SPECS KEEP LOOKING. * GTAT4 LDA PRCNT FINISHED WITH SPECS. SZA,RSS DID WE FIND ANYTHING? JMP ERR5 ERROR - ILLEGAL PARAMETER SPECIFICATION. JMP T.B11 CONTINUE WITH OTHER PARAMETERS. * V CPA FNDV ALREADY SEEN THIS CHARACTER? JMP ERR5 YES - ILLEGAL PARAMETER SPECIFICATION. STA FNDV INDICATE THIS CHARACTER SEEN. INB SET UP PARAMETER BIT LDA BR3,I AND ROTATE IT RRR 1 TO PROPER POSITION STA BR3,I IN "TO-FROM" WORD. JMP GTATT GO LOOK FOR MORE. * AC CPA FNDA ALREADY SEEN THIS CHARACTER? JMP ERR5 YES - ILLEGAL PARAMETER SPECIFICATION. STA FNDA INDICATE THIS CHARACTER SEEN. INB SET UP PARAMETER BIT LDA BR2,I AND ROTATE IT TO RRR 1 PROPER POSITION IN STA BR2,I VARIABLE TYPE WORD. JMP GTATT * ERR9 ISZ T.ERN BAD FILE NAME ERR8 ISZ T.ERN BAD ENTRY POINT NAME ERR7 ISZ T.ERN TABLE OVERFLOW. ERR6 ISZ T.ERN ILLEGAL FORMAT T.ERN. ERR5 ISZ T.ERN ILLEGAL PARAMETER SPECIFICATION. ERR4 ISZ T.ERN NOT ENOUGH PARAMETERS. ERR3 ISZ T.ERN ENTRY POINT NAME TOO LARGE. ERR2 ISZ T.ERN NAME TOO LARGE. ERR1 ISZ T.ERN TOO MANY PARAMETERS. JMP T.BTE,I GO REPORT THE BAD NEWS. * NMLEN NOP SUBROUTINE TO CALCULATE LDA MN2 THE LENGTH OF A CMA,INA SUBROUTINE NAME INCLUDING LDB TEMP1 THE "(" IF PRESENT AND CLE,ERB STORE THE RESULT. ADA 1 LDB TEMP1 ALS SLB INA STA MN1,I JMP NMLEN,I * T.B10 JSB NMLEN NO PARAMETER SPECIFICATIONS JMP T.BT2  TO BREAK UP. * * A EQU 0 AMASK OCT 77777 SUNUM BSS 1 BR1 BSS 1 BR2 BSS 1 BR3 BSS 1 BR4 BSS 1 MN1 BSS 1 MN2 BSS 1 EN1 BSS 1 PRCNT BSS 1 CHAR BSS 2 SAVE BSS 1 FOUND BSS 1 FNDIR BSS 1 FNDA BSS 1 FNDV BSS 1 FULL OCT 177 B77 OCT 77 B50 OCT 50 B51 OCT 51 B100 OCT 100 B200 OCT 200 EQ OCT 75 ICHAR OCT 111 VCHAR OCT 126 RCHAR OCT 122 ACHAR OCT 101 D2 DEC 2 D15 DEC 15 D32 DEC 32 M32 DEC -32 D63 DEC 63 D100 DEC 100 * * PROT NOP LDA PRCNT CMA ROTATE PARAMETER DESCRIPTOR T.BT5 INA,SZA,RSS WORDS TO THEIR JMP T.BT4 CORRECT POSITIONS. RBL JMP T.BT5 T.BT4 JMP PROT,I * T.B11 LDA PRCNT STORE PARAMETER COUNT ALF IN MNEMONIC TABLE WORD. IOR MN1,I STA MN1,I LDA T.CNT SSA,RSS JMP ERR4 NOT ENOUGH PARAMETERS. JSB T.GCR GET NEXT CHARACTER. JMP ERR4 NOT ENOUGH PARAMETERS. STA SAVE SAVE DELIMITER. LDB BR2,I JSB PROT STB BR2,I LDB BR3,I JSB PROT STB BR3,I LDB BR4,I JSB PROT STB BR4,I * T.BT2 LDB EQ SET DELIMITER TO "=" STB T.DLM T.BT1 LDA SAVE CPA D10 ANY MORE PARAMETERS? JMP T.B12 NO - CHECK FOR MINIMUM. LDB FOUND DO WE HAVE ALL CPB FULL POSSIBLE PARAMETERS? JMP ERR1 YES - TOO MANY PARAMETERS. CPA B54 RSS JMP ERR6 JSB T.GCR GET NEXT CHARACTER. JMP T.B12 JSB LNAME GET THE KEYWORD. DEF CHAR DEC -5 JMP ERR6 ILLEGAL FORMAT. STA SAVE * * MATCH THE KEYWORD AND JUMP TO CORRECT ROUTINE. * LDB KEYWD MATCH THE KEYWORD. T.BT3 INB LDA B,I SZA,RSS JMP ERR6 NO MATCH - ERROR. CPA CHAR JMP T.BT6 ADB D2 JMP T.BT3 T.BT6 INB LDA B,I INB CPA GCHAR+1 CCE,RSS JMP T.BT3 ELB,RBR JMP B,I * KEYWD DEF * ASC 2,OV OVERLAY NUMBER SPEC DEF OVLAY ASC 2,SZ RTEIII LOADR SIZE SPEC DEF OSIZE ASC 2,INTG INTEGER FUNCTION DEF INTEG ASC 2,REAL REAL FUNCTION DEF REAL ASC 2,ENT ENTRY POINT SPEC DEF EPNT ASC 2,FIL FILE NAME SPEC DEF FILNM ASC 2,BT BACGROUND TEMPRORARY DEF BKTMP ASC 2,BP BACKGROUND PERMANENT DEF BKPRM ASC 2,FT FOREGROUND PERMANENT DEF FRTMP ASC 2,FP FOREGROUND TEMPORARY DEF FRPRM ASC 2,SS SUBSYTEM GLOBAL COMMON DEF SSPRM ASC 2,VL VARIABLE LENGTH PARAMETER LIST DEF VLPRM ZERO DEC 0 END OF TABLE * * * THE FOLLOWING SUBROUTINE CHECKS TO SEE WHETHER A * GIVEN PARAMETER HAS ALREADY BEEN SEEN AND RESETS * FOUND TO INDICATE PARAMETER RECOGNIZED. * * CALLING SEQUENCE: * LDB BIT POSITION IN FOUND * JSB PRCHK * PRCHK NOP LDA FOUND XOR B STA FOUND AND B SZA,RSS JMP ERR6 JMP PRCHK,I * * SETUP LOADER OPTIONS IF SPECIFIED * * LDOPT CONTAINS VALUE FOR TYPE OF PROGRAM LOAD IN TRANSFER FILE * * LDOPT = 0 REAL TIME PERMANENT(DEFAULT) * LDOPT = 1 REAL TIME TEMPORARY * LDOPT = 2 BACKGROUND PERMANENT * LDOPT = 3 BACKGROUND TEMPORARY * LDOPT = LDOPT+10B WILL CAUSE THE LOADED PROGRAM TO REFERENCE SSGA * * EXAMPLE: 13 OCTAL WOULD BE BACKGROUND TEMP WITH SSGA * * SSPRM LDA D8 SSGA SPECIFIED ADA LDOPT STA LDOPT LDB B200 HAVE WE SEEN THIS PARAMETER JSB PRCHK BEFORE JMP T.BT1 GO TO NEXT PARAMETER * FRPRM CLA REAL TIME PERMANENT RSS FRTMP CLA,INA REAL TIME TEMPORARY RSS BKPRM LDA D2 BACKGROUND PERMANENT RSS BKTMP LDA D3 BACKGROUND TEMPORARY t"ADA LDOPT SET LOADR OPTIONS STA LDOPT LDB D32 HAVE WE SEEN JSB PRCHK THIS PARAMETER BEFORE? JMP T.BT1 GO TO NEXT PARAMETER * * SET VARIABLE LENGTH PARAMETER LIST FLAG * VLPRM LDB B100 JSB PRCHK LDA MN1,I GET PARAMETER COUNT IOR BIT14 WORD AND STA MN1,I SET VARIABLE LENGTH FLAG JMP T.BT1 AND LOOK FOR MORE * * GET OVERLAY SIZE * OSIZE LDB D2 HAVE WE ALREADY JSB PRCHK SEEN THIS PARAMETER? LDA SAVE CPA EQ RSS JMP ERR6 JSB T.GTN JMP ERR6 NO NUMBER - ERROR. STA SAVE SAVE DELIMITER. STB SIZE SAVE PAGE SIZE. ADB M1 CHECK BOUNDS. SSB PAGE SIZE SHOULD BE JMP ERR6 GREATER THAN ZERO ADB M32 AND LESS THAN OR SSB,RSS EQUAL TO 32. JMP ERR6 JMP T.BT1 LOOK FOR MORE. * * GET OVERLAY NUMBER. * M1 DEC -1 SIZE NOP SAVE FOR OVERLAY SIZE OVNUM BSS 1 SAVE FOR OVERLAY NUMBERS. LDOPT BSS 1 LOADR OPTION BIT14 OCT 40000 * OVLAY CLB,INB HAVE WE ALREADY JSB PRCHK SEEN THIS KEYWORD? LDA SAVE GET DELIMITER. CPA EQ RSS JMP ERR6 JSB T.GTN GET THE NUMBER. JMP ERR6 STA SAVE SAVE DELIMITER. SSB CHECK BOUNDS. JMP ERR6 OUT OF BOUNDS. STB OVNUM SAVE OVERLAY NUMBER. ADB M32 SSB,RSS JMP ERR6 ERROR - OUT OF BOUNDS. LDB OVNUM STB A BLF SAVE IT IN PROPER POSITION. RBL,RBL ADA SUNUM ASSIGN A SUBROUTINE # STA CHAR AND KEEP TRACK OF IT. LDA CHAR,I ISZ CHAR,I AND B77 CPA D63 CHECK BOUNDS. JMP ERR7 TABLE OVERFLOW - TOO MANY XOR B SUBROUTINES IN OVERLAY. LDB T.IDL MERGE IN CODE BLF,BLF FOR ID LETTER. BLF,RBR XOR B STA BR1,I SAVE BRANCH TABLE ENTRY. JMP T.BT1 LOOK FOR MORE. * * * HAVE AN INTEGER VALUED FUNCTION * INTEG CLB,CCE LDB BR4,I ELB,RBR HAVE AN INTEGER-VALUED STB BR4,I FUNCTION. * * HAVE A REAL VALUED FUNCTION. * REAL LDB D4 SEEN THIS PARAMETER JSB PRCHK ALREADY? LDA MN1,I SET FUNCTION BIT CCE ON MNEMONIC TABLE ENTRY. ELA,RAR STA MN1,I JMP T.BT1 LOOK FOR MORE. * * HAVE AN ENTRY POINT NAME * D8 DEC 8 D16 DEC 16 * EPNT LDB D8 SEEN THIS PARAMETERS JSB PRCHK ALREADY? LDA SAVE CPA EQ RSS JMP ERR6 JSB T.GCR JMP ERR6 JSB LNAME GET ENTRY POINT NAME ENAME BSS 1 AND PUT INTO TABLE. DEC -6 JMP ERR3 ENTRY POINT NAME TOO LARGE. STA SAVE SAVE DELIMITER. JMP T.BT1 * * GET FILE NAME * FILNM LDB D16 SEEN THIS PARAMETER JSB PRCHK ALREADY? LDA SAVE CPA EQ RSS JMP ERR6 JSB T.GCR JMP ERR6 JSB T.NAM GET THE FILE NAME. FNAME BSS 1 JMP ERR6 STA SAVE SAVE DELIMITER. JMP T.BT1 * * FILE NAME AND ENTRY POINT NAME CHECK. * * CALLING SEQUENCE: * LDA ADDRESS OF NAME * LDB SWITCH (0 = FILE NAME, 1 = ENTRY POINT) * JSB NMCHK * RETURN LOSEBIG * RETURN+1 OK * NMCHK NOP ERB LDB T.CNT SAVE COUNT AND ADDRESS STB NMC1 USED BY T.GCR. LDB T.ADR STB NMC2 LDB FNM1 SEZ GET PROPER TABLE LDB ENT1 OF CHARACTERS. STB NMC3 LDB M7 SEZ INB GET PROPER COUNT STB T.CNT OF MAX. CHARS. ELB STB NMSAV CLE,ELA STA T.ADR JSB T.GCR GET FIRST CHARACTER. JMP NMCHK,I NULL - ERROR. NMCH1 LDB NMC3,I CHECK VALIDITY OF FIRST CHARACTER. ISZ NMC3 IS IT IN ANY LEGAL RANGE? SZB,RSS END OF CHARACTER TABLE? JMP NMCHK,I BAD NAME - ERROR RETURN. JSB RANGE CHARACTER IN THIS RANGE? JMP NMCH1 NO - CHECK NEXT RANGE. NMCH2 LDA NMSAV ENTRY POINT OR FILE NAME? LDB FNMR GET PROPER CHAR. TABLE SZA FOR REMAINING CHARACTERS. LDB ENTR STB NMC3 JSB T.GCR GET NEXT CHARACTER. JMP NMCH3 ALL DONE CHECKING. NMCH4 LDB NMC3,I ISZ NMC3 SZB,RSS JMP NMCHK,I JSB RANGE IS CHARACTER IN THIS RANGE? JMP NMCH4 NO - CHECK NEXT RANGE. JMP NMCH2 YES - CHECK NEXT CHARACTER. * NMCH3 LDA NMC1 RESTORE COUNT AND STA T.CNT ADDRESS FOR T.GCR. LDA NMC2 STA T.ADR ISZ NMCHK NORMAL EXIT. JMP NMCHK,I * NMC1 BSS 1 NMC2 BSS 1 NMC3 BSS 1 NMSAV BSS 1 * FNFC ASC 1,!* FIRST CHARACTER TABLE ASC 1,./ FOR FILE NAMES. ASC 1,;_ DEC 0 FNRC ASC 1,!& REMAINING CHARACTER SET ASC 1,.9 FOR FILE NAMES. ASC 1,;_ DEC 0 EPFC ASC 1,!& ASC 1,./ ASC 1,>_ DEC 0 EPRC ASC 1,!& ASC 1,._ DEC 0 * ENT1 DEF EPFC ENTR DEF EPRC FNM1 DEF FNFC FNMR DEF FNRC * * THE FOLLOWING SUBROUTINE CHECKS WHETHER A * CHARACTER IS IN THE GIVEN RANGE. UPON RETURN * THE A REGISTER IS THE SAME AS ON ENTRY. * * CALLING SEQUENCE: * LDA CHARACTER * LDB RANGE VALUE * JSB RANGE * RETURN NOT IN RANGE * RETURN+1 IN RANGE * RANGE NOP STA RANG1 CLA LSR 8 ALF,ALF STB RANG2 CMB,INB ADB RANG1 SSB JMP RANGE,I CMA STA B ADB RANG1 LDA RANG1 SSB ISZ RANGE JMP RANGE,I * RANG1 BSS 1 RANG2 BSS 1 * T.B12 LDA FOUND HAVE NECESSARY SLA,RSS PARAMETERS? JMP ERR4 NO - NOT ENOUGH. * LDA MN2 SET UP TO DEFAULT THE CLE,ELA ENTRY POINT NAME, IF STA T.ADR NECESSARY. SET POINTERS LDA MN1,I FOR T.GCR. AND B7 NAME WILL BE PADDED WITH CMA BLANKS BY LNAME. STA T.CNT LDA EN1,I BYPASS DEFAULT SET IF SZA ENTRY POINT ALREADY SET. JMP T.BT8 * LDA B50 STA T.DLM SET UP FOR LNAME. JSB T.GCR GET FIRST CHARACTER OF NAME. NOP JSB LNAME IF WE NEED TO DEFAULT EPNAM BSS 1 THE ENTRY POINT NAME, M7 DEC -7 GO AHEAD AND DO SO. NOP T.BT8 LDA ENAME CHECK VALIDITY OF CLB,INB ENTRY POINT NAME. JSB NMCHK MAKE THE CHECK. JMP ERR8 BAD ENTRY POINT NAME. LDA FNAME CHECK VALIDITY OF FILE NAME. LDB A,I DO NOT CHECK A "NO-NAME." SZB,RSS JMP T.BT0 CLB JSB NMCHK DO THE CHECK. JMP ERR9 BAD FILE NAME. T.BT0 LDA EN1 INCREMENT COUNTERS AND ADA D3 PASS BACK NEW ADDRESSES STA T.EAD TO THE MAIN. LDA BR4 INA STA T.BAD LDA MN1,I AND B7 INA ARS ADA MN2 STA T.MAD LDB OVNUM INDEX TO OVERLAY ADB SUNUM POSITION AND PICK STB SAVE UP THE ENTRY. LDA SAVE,I ISOLATE THE SIZE RRR 6 ATTRIBUTE ALREADY AND B77 STORED. SZA,RSS OLD SIZE ZERO? JMP T.BT9 YES! * DO WE HAVE A DUPLICATE DEFINITION LDB SIZE IS NEW SIZE ZERO? SZB,RSS JMP T.BT9 YES! CMB,INB ADB A SZB,RSS JMP T.BT9 SSB HAVE DUPLICATE DEFINITION. LDA SIZE TAKE LARGER OF TWO STA SIZE VALUES. JSB EXEC PRINT WARNING MESSAGE DEF T.BT9 TO TELL USER OF DEF D2 DUPLICATE DEFINITION. DEF T.CON DEF WARN DEF WARNL T.BT9 LDA SAVE,I AND B77 PUT SIZE INTO THE LDB SIZE PROPER PLACE IN BLF THE TABLE. RBL,RBL XOR B LDB LDOPT PUT LOADR OPTIONS BLF,BLF INTO BLF PLACE XOR B STA SAVE,I JMP T.BTE,I * B7 OCT 7 WARNL DEC 20 LENGTH OF WARNING. WARN ASC 20, * WARNING * DUPLICATE SIZE DEFINITION SKP * * * THE FOLLOWING ROUTINE PARSES THE FIRST COMMAND * LINE TO RTETG. * * CALLING SEQUENCE * * COMMAND LINE IN T.COM * LENGTH OF LINE IN T.LEN * T.MAD POINTS TO FIRST FILE NAME BUFFER * JSB T.GFI * * ENT T.GFI * * T.GFI NOP LDA D80 PUT IN DEFAULTS STA T.PRI FOR PRIORITY, CLA SECURITY CODE, STA T.SEC STA T.CRF AND CARTRIDGE #. JSB .DRCT SET UP FOR T.GCR. DEF T.COM GET BUFFER ADDRESS. CLE,ELA SET UP POINTER. STA T.ADR LDA T.LEN SET UP CHARACTER LENGTH. ALS CMA STA T.CNT LDA T.MAD STA NWFIL LDA M3 SET UP TO GET STA SAVE THREE FILE NAMES. T.GF1 CPA D10 END OF BUFFER? JMP ERRO4 YES - NOT ENOUGH PARAMETERS. JSB T.GCR GET NEXT CHARACTER. JMP ERRO4 NONE - ERROR. CPA D10 END OF BUFFER? JMP ERRO4 YES - ERROR. JSB T.NAM GET A FILE NAME, NWFIL BSS 1 SECURITY CODE, AND JMP ERRO6 AND CARTRIDGE NUMBER. LDB NWFIL ADB D5 SET UP FOR STB NWFIL NEXT FILE NAME. ISZ SAVE JMP T.GF1 CPA D10 JMP ERRO4 JSB T.GCR ANY MORE INPUT? JMP ERRO4 NO - NOT ENOUGH PARAMETERS? JSB LNAME GET ID LETTER. DEF CHAR DEC -5 JMP ERRO6 TOO LONG - ERROR. STA SAVE SAVE DELIMITER CHAR. LDB CHAR CPB ID CLA,RSS JMP ERRO,y6 LDB CHAR+1 LSR 8 ALF,ALF CPB EQ RSS JMP ERRO6 AND B37 STA T.IDL SAVE ID LETTER. ADA N33 CHECK BOUNDS. SSA,RSS JMP ERRO6 TOO LARGE - ERROR. LDA T.CNT CHECK CHARACTER COUNT. SZA,RSS ANY MORE INPUT? JMP T.GFI,I THEN WE'RE DONE. JSB T.GTN GET NEXT PARAMETER. JMP T.GF2 SZB,RSS NOT SUPPLIED OR ZERO? JMP T.GF3 THEN BYPASS - PARM. IS DEFAULTED. STB T.PRI SAVE PRIORITY. ADB M10K CHECK BOUNDS. SSB,RSS JMP ERRO6 TOO LARGE - ERROR. CCB ADB T.PRI SSB JMP ERRO6 TOO SMALL - ERROR. T.GF3 CPA D10 JMP T.GFI,I ALL DONE. T.GF2 CPA B54 RSS JMP ERRO6 JSB T.GTN JMP T.GF4 STB T.SEC STORE SECURITY CODE. CPA D10 JMP T.GFI,I ALL DONE. T.GF4 CPA B54 RSS JMP ERRO6 JSB T.GTN JMP ERRO6 STB T.CRF STORE CARTRIDGE #. CPA D10 JMP T.GFI,I * CLA,INA,RSS TOO MANY PARAMETERS. ERRO4 LDA D4 NOT ENOUGH PARAMETERS. ERRET STA T.ERN JMP T.GFI,I REPORT THE BAD NEWS. ERRO6 LDA D6 ILLEGAL FORMAT. JMP ERRET * D4 DEC 4 D5 DEC 5 D6 DEC 6 M3 DEC -3 B37 OCT 37 N33 OCT -33 ID ASC 1,ID M10K DEC -10000 D80 DEC 80 SKP * * * CHARACTER PUSHING ROUTINES BY J.T.S. * MODIFIED BY A.M.G. * * * * SUBROUTINE TO DECODE NAME PRAMS * CALLING SEQUENCE * JSB T.NAM * DEF NAME * RETURN BAD NAME * RETURN+1 OK * A REG= CURRENT CHAR * UPON RETURN * NAME, NAME+1, NAME+2 = FILE NAME * NAME+3 = SECURITY CODE * NAME+4 = LOGICAL UNIT * * ENT T.NAM * * T.NAM NOP LDB T.NAM,I GET NAME BUFFER ADDR CLE,SSB,RSS JMP *+4 ELB,RBR LDB B,I JMP *-4 STB NAMA 'AND SAVE IT IN NAME PTR ISZ T.NAM ADB D3 SET UP STB SC SECURITY CODE PTR INB SET UP STB LU LOGICAL UNIT PTR STA TEMP2 SAVE CURRENT CHAR CLA GET A ZERO STA SC,I AND CLEAR SC AND LU STA LU,I LDA B72 SET DELIMITER TO ":" STA T.DLM LDA TEMP2 RECALL CURRENT CHAR JSB LNAME GET NAME...A REG 0,IGNORE SPACES NAMA DEF 0 BUFFER WHERE TO PUT NAME DEC -7 MAX LENGTH + 1 SPC 2 * AT THIS POINT WE HAVE MOVED THE NAME IN SPC 1 JMP T.NAM,I JSB CHRCK CHECK FOR END OF LINE JMP NRET YES...TERMINATE ROUTINE JSB T.GTN GET NUMBER RSS NOT NUMERIC JMP NMDCD NUMERIC SAVE SC CODE JSB CHRCK CHECK FOR DELEM. JMP T.NAM,I END OF LINE JMP NMDCE NO SECURITY CODE ALF,ALF SHIFT TO HIGH ORDER STA SC,I SAVE TOP HALF SC,IURITY CODE JSB T.GCR GET NEXT CHAR LDA D10 STA 1 SAVE CHAR JSB CHRCK TERMINATOR NOP EOF...SET FOR SPACE LDA BLANK GET A SPACE IOR SC,I OR IN BOTTOM HALF OF SC,IURITY WORD STA SC,I SAVE COMPLETE SECURITY CODE LDA 1 GET CHARACTER AGAIN JSB CHRCK ARE WE DONE? JMP NRET YES...RETURN JMP NMDCF YES...GO PROCESS LU JSB T.GCR GET ANOTHER CHARACTER LDA D10 EOF! RSS NO...CHECK NEXT CHAR...MUST BE A ":" NMDCD STB SC,I SAVE NUMERIC SECUITY CODE NMDCE JSB CHRCK CHECK FOR TERMINATOR JMP NRET DONE RSS CONTINUE...GOT A : JMP T.NAM,I INVALID FILE NAME SPC 2 * WE NOW HAVE PROCESSED THE NAME AND SECURITY CODE * NOW WE ARE GOING TO PROCESS LU SPC 1 NMDCF JSB T.GTN GET NUMBER JMP T.NAM,I NOT A NUMBER STB LU,I z SAVE LU,I VALU,IE NRET ISZ T.NAM NORMAL RETURN. JMP T.NAM,I * D3 DEC 3 D10 DEC 10 D43 DEC 43 B72 OCT 72 SKP * * * SUBROUTINE TO GET A FLOATING POINT NUMBER * CONVERT IT, AND RETURN IT IN THE B REG * CALLING SEQUENCE * JSB T.GTN * UNABLE TO CONVERT RETURN * CONVERTED RETURN * B REG=NUMBER, A REG = NEXT CHAR * * ENT T.GTN * * T.GTN NOP JSB T.GCR GET NEXT CHAR LDA D10 CPA D10 EOF? JMP T.GTN,I YES, RETURN CLB,CLE CLEAR E AND B REG STB TEMP1 CLEAR OUT SUM WORD STB TEMP2 CLEAR OUT DIGIT RECIEVED WORD CPA D43 IS IT A "+" CCE SET E=READ ANOTHER CHAR CPA D45 IS IT A "-" CCB,CCE SET B=-1, SET E=READ ANOTHER CHAR STB SIGN SAVE SIGN SEZ,RSS READ ANOTHER CHAR? JMP *+3 NO! GTNMA JSB T.GCR YES LDA D10 EOF! JSB DIGCK GO SEE IF DIGIT IS NUMERIC JMP GTNMB NOT NUMERIC...DONE CONVERSION LDA TEMP1 GET PARTICAL SUM IN A REG STB TEMP1 DIGCK RETURN NUMBER IN BOTH A AND B REG MPY D10 MULTIPLY PARTICAL SUM BY 10 ADA TEMP1 AND IN NEXT DIGIT STA TEMP1 SAVE NEW SUM ISZ TEMP2 SET FOR RECIEVED A DIGIT JMP GTNMA GET NEXT DIGIT SPC 1 GTNMB LDB TEMP2 DID WE GET ANY DIGITS? SZB,RSS JMP T.GTN,I NO LDB SIGN GET SIGN CLE,ERB IF NEGATIVE, SET E REG LDB TEMP1 GET BINARY VALUE SEZ NEGATIVE VALUE? CMB,INB YES...NEGATE RESULT ISZ T.GTN GET DIGIT RETURN JMP T.GTN,I RETURN * SIGN BSS 1 D45 DEC 45 N72 OCT -72 B EQU 1 SKP * * * SUBROUTINE TO CHECK IF A CHARACTER IS * A NUMERIC DIGIT. * * CALLING SEQUENCE: * * LDA CHAR * JSB DIGCK * NOT NUMERIC RETURN A=CHAR * NUMERIC RETURNK A=CHAR, B=DIGIT * * DIGCK NOP STA B ADB N72 SSB,RSS JMP DIGCK,I ADB D10 SSB,RSS ISZ DIGCK JMP DIGCK,I * * SPC 2 * * SUBROUTINE TO CHECK IF A CHARACTER IN THE A REG * ISEITHER AN END OF LINE "D10" OR A : "B72" * CALLING SEQUENCE * JSB CHRCK * END OF LINE RETURN * COLEN RETURN * NEITHER RETURN * A REG CONTAINS THE CHARACTER * B AND E REG NOT CHANGED * CHRCK NOP CPA D10 IS IT END OF LINE? JMP CHRCK,I YES...EOL RETURN CPA B54 IS IT A ","? JMP CHRCK,I YES...TREAT AS A EOL ISZ CHRCK CPA T.DLM IS IT A ":" JMP CHRCK,I ":" RETURN ISZ CHRCK JMP CHRCK,I NO DELM RETURN * T.DLM BSS 1 B54 OCT 54 SKP * * ROUTINE TO MOVE NAME INTO NAME BUFFER * CALLING SEQUENCE * JSB LNAME * DEF BUFFER ADDRESS WHERE TO STORE NAME * DEC -MAX # OF CHARACTERS +1 * RETURN ERROR * RETURN+1 A REG = DELIMITER CHAR * LNAME NOP STA TEMP5 SAVE CURRENT CHAR LDB LNAME,I GET ADDRESS OF NAME BUFFER ISZ LNAME GET TO NEXT PARM CLE,ELB CONVERT TO BYTE ADDRESS STB TEMP1 SAVE BYTE ADDRESS CLE,ERB GET BACK ACTUAL ADDRESS LDA LNAME,I GET MAX LENGTH +1 SLA INA ARS GET MAX LENGTH IN WORDS STA TEMP2 SAVE FOR DOWN COUNTER LDA SPACE STUFF BLANKS INTO THE LN1 STA 1,I NAME BUFFER FOR THE INB ISZ TEMP2 MAXIMUM LENGTH. JMP LN1 LDA LNAME,I STA TEMP2 ISZ LNAME LDA TEMP5 GET CURRENT CHAR LMDCD JSB CHRCK CHECK FOR DELIMETER NOP JMP LNRET HIT ONE LDB TEMP1 GT BYTE ADDRESS JSB SBYTE SAVE CHARACTER JSB T.GCR GET NEXT CHARACTER LDA D10 CPA D10 EOF? JMP LNRET YES, RETURN! ISJ'Z TEMP1 GET NEXT CHAR ADDRESS ISZ TEMP2 OUT OF ROOM? JMP LMDCD NO..CONTINUE JMP LNAME,I INVALID FILE NAME SPC 2 LNRET ISZ LNAME JMP LNAME,I * SPACE ASC 1, * SPC 3 * * SUBROUTINE TO STORE A BYTE * CALLING SEQUENCE * JSB SYBTE * A REG CONTAINS BYTE * B REG CONTAINS BYTE ADDRESS * SBYTE NOP AND B377 MASK ALL BUT LOWER 8 BITS STA TEMP7 SAVE IN TEMP LOCATION CLE,ERB CHANGE FROM BYTE TO WORD ADD LDA 1,I GET WORD SEZ,RSS RIGHT OR LEFT HALF ALF,ALF LEFT AND HIMSK MASK ALL BUT UPPER 8 BITS IOR TEMP7 OR IN NEW BYTE SEZ,RSS LEFT OR RIGHT ALF,ALF LEFT STA 1,I STORE WORD BACK ELB,CLE GET BYTE ADDRESS AGAIN JMP SBYTE,I RETURN * B377 OCT 377 HIMSK OCT 177400 SPC 2 TEMP1 BSS 1 TEMP2 BSS 1 TEMP5 BSS 1 TEMP7 BSS 1 SC BSS 1 LU BSS 1 * * * SUBROUTINE TO GET CHARACTER FROM INPUT BUFFER * * CALLING SEQUENCE: * * T.CNT CONTAINS - (CHARACTER COUNT + 1) * T.ADR CONTAINS ADDRESS SHIFTED LEFT ONE BIT * JSB T.GCR * END OF LINE RETURN * NORMAL RETURN * ENT T.GCR ENT T.ADR ENT T.CNT * T.GCR NOP ISZ T.CNT ANY CHARACTERS LEFT? RSS JMP T.GCR,I NO, END-OF-LINE EXIT. LDB T.ADR LOAD BUFFER ADDRESS. ISZ T.ADR UPDATE FOR NEXT TIME. CLE,ERB SET CHARACTER FLAG. LDA 1,I LOAD CURRENT BUFFER WORD. SEZ,RSS FIRST CHARACTER? ALF,ALF YES, POSITION IT. AND B177 MASK EXTRANEOUS BITS. SZA,RSS END OF LINE? JMP T.GCR,I YES IF ZERO. CPA BLANK BLANK? JMP T.GCR+1 YES,FETCH NEXT CHARACTER. ISZ T.GCR UPDATE RETURN ADDRESS. JMP T.GCR,I EXIT. * BLANK OCT 40 B177 OCT 177 T.CNT BSS 1 T.ADR BSS 1 * END $fd``fASMB,R,L,C HED OVERLAY DIRECTORY BUILDER * * NAME: T.OVL * SOURCE: 92101-18008 * RELOC: 92101-16008 * PGMR: ADELE GADOL * * **************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1975. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT PACKARD COMPANY. * * **************************************************************** * NAM T.OVL,8 92101-16008 REV.1805 771103 * SUP * * * THE FOLLOWING ROUTINE BUILDS THE OVERLAY DIRECTORIES * FOR RTETG. UPON COMPLETION, T.OVB CONTAINS (IN 4-WORD * GROUPS) A LIST OF OVERLAY DIRECTORY NAMES ANE THE * NUMBER OF SUBROUTINES IN EACH AS FOLLOWS: * * WORD 1: # OF SUBROUTINES * WORDS 2-4: OVERLAY DIRECTORY NAME * . * . * . UP TO 128 WORDS USED * . * . * * CALLING SEQUENCE: * SORTED BRANCH TABLE IN T.BRN * SORTED ENTRY POINT LIST IN T.ENT * T.BAD POINTS AT END+1 OF BRANCH TABLE * JSB T.OVL * * ENT T.OVL * EXT CREAT FILE MANAGER CREATE EXT WRITF FMGR WRITE RECORD EXT KCVT CONVERT NUMBER TO ASCII EXT T.BRN SORTED BRANCH TABLE (IN MAIN) EXT T.ENT BUFFER (IN MAIN) OF ENTRY POINTS EXT T.DCB DCB BUFFER (IN MAIN) EXT .DRCT GET DIRECT ADDRESS EXT T.BAD ADDRESS OF END OF BRANCH TABLE EXT CLOSE FMGR CLOSE EXT .DFER 3-WORD TRANSFER EXT T.IDL ID LETTER CODE. EXT T.OVB BUFFER OF OVERLAY NAMES. EXT T.SUB SIZE AND SUBROUTINE COUNT BUFFER. EXT T.LEN WILL HOLD # OF OVERLAYS. EXT T.PRI PRIORITY OF OVERLAYS. EXT T.SEC SEC. CODE FOR OVERLAY DIRECTORIES EXT T.CRF CARTRIDGE # FOR OVERLAY DIRECTORIES. EXT T.ERN ?ERROR NUMBER * * A EQU 0 B EQU 1 * * SZSUB BSS 1 OVBUF BSS 1 * T.OVL NOP JSB .DRCT DEF T.OVB STA OVBUF JSB .DRCT DEF T.ENT STA ENPTS JSB .DRCT DEF T.SUB STA SZSUB JSB .DRCT DEF T.BRN STA SAVE1 CLB INITIALIZE THE NUMBER STB T.LEN OF OVERLAYS CREATED. T.OV6 CPA T.BAD ADDR ASSUMED IN A REG. JMP T.OVL,I FINISHED - LEAVE. LDA A,I CREATE NAME OF NEXT LSR 6 OVERLAY DIRECTORY. AND B37 ISOLATE OVERLAY NUMBER. STA SAVE4 SAVE OVERLAY NUMBER. JSB KCVT CONVERT IT TO 2-DIGIT ASCII. DEF *+2 DEF SAVE4 LDB NAME STB OVBUF,I IOR DBL0 CLB LSL 8 SHIFT THE RESULT. STA CHSUM MERGE INTO THE NAME. LDA T.IDL MERGE ID LETTER ALF,ALF INTO NAME. ADA NAME+1 AND HIBYT XOR B LDB OVBUF INB STA B,I LDA CHSUM XOR B40 INB STA B,I T.OV2 ISZ SAVE1 ISZ SAVE1 LDA T.BAD AT THE END OF THE BUFFER? CPA SAVE1 JMP T.OV1 YES. LDB SAVE1,I NO - GET NEXT BRANCH LSL 5 TABLE ENTRY. LSR 11 SEPARATE OUT THE OVERLAY #. CPB SAVE4 OVERLAY # CHANGED. JMP T.OV2 BACK THROUGH SEARCH. JMP T.OV1 YES - GO AHEAD AND CREATE DIRECTORY. * BUFFR BSS 60 B37 OCT 37 B40 OCT 40 B77 OCT 77 BUFAD DEF BUFFR SAVE1 BSS 1 SAVE2 BSS 1 SAVE3 BSS 1 DBL0 ASC 1,00 NAME ASC 2,%B@ * * SUBROUTINE TO CALCULATE RELOCATABLE CHECKSUMS. * CHSUM NOP LDB BUFAD LDA B,I GET RECORD LENGTH. ALF,ALF CMA,INA SET UP A COUNTER. ADA D3 STA WRTRC ADD UP ALL WORDS IN INB THE RECORD EXCEPT LDA B,I WORDS 1 AND 3. INB STB SAVE2 INB ADA B,I  ISZ WRTRC JMP *-3 STA SAVE2,I JMP CHSUM,I * D2 DEC 2 D3 DEC 3 D5 DEC 5 D7 DEC 7 D10 DEC 10 D17 DEC 17 M6 DEC -6 WDJSB OCT 14001 WD5 OCT 102000 NAMID OCT 20000 IDENT OCT 60102 SID BSS 1 CALSB DEF *+1 ASC 3,CALSB * T.OV1 JSB CREAT CREATE THE OVERLAY DEF T.O10 DIRECTORY FILE. DEF T.DCB DEF T.ERN DEF OVBUF,I DEF D10 DEF D5 DEF T.SEC DEF T.CRF T.O10 LDA T.ERN ERRORS? SSA JMP T.OVL,I YES - LEAVE. * ISZ T.LEN INCREMENT # OF OVERLAYS. LDA SZSUB GET NUMBER OF SUBROUTINES ADA SAVE4 IN THIS OVERLAY LDA A,I AND SAVE IT. AND B77 STA SAVE3 * * PUT TOGETHER NAM RECORD. * LDA BUFAD PUT TOGETHER NAM RECORD. STA SAVE2 ISZ SAVE2 LDB D17 PUT IN RECORD LENGTH. BLF,BLF STB A,I LDA NAMID PUT IN IDENTIFIER STA SAVE2,I FOR NAM RECORD. ISZ SAVE2 ISZ SAVE2 JSB .DFER MOVE THE SYMBOL DEF SAVE2,I INTO THE RECORD. DEF OVBUF,I LDB SAVE2 ADB D3 LDA SAVE3 ADA D2 STORE LENGTH OF MAIN STA B,I PROGRAM SEGMENT. INB CLA STORE LENGTH OF BASE STA B,I PAGE AND COMMON INB SEGMENTS, BOTH 0. STA B,I INB LDA D2 TYPE 2. STA B,I LDA T.PRI PRIORITY. INB STA B,I LDA M6 STA CHSUM STORE TIME PARAMETERS, CLA ALL 0 SINCE THERE IS INB NO TIME LIST SCHEDULING. STA B,I ISZ CHSUM JMP *-3 JSB CHSUM PUT IN THE CHECKSUM. LDA D17 JSB WRTRC WRITE THE RECORD. * * PUT TOGETHER THE ENT RECORD * LDA BUFAD PUT TOGETHER THE ENT RECORD. LDB D7 PUT IN RECORD LENGTH. BLF,BLF STB A,I  INA CLB,INB RBR,RBR INB STB A,I PUT IN IDENTIFIER WORD. ADA D2 STA SAVE2 JSB .DFER MOVE SYMBOL INTO RECORD. DEF SAVE2,I DEF OVBUF,I PROGRAM RELOCATABLE. LDA SAVE2 ADA D3 CLB PUT IN RELOCATABLE ADDRESS STB A,I OF THE SYMBOL. JSB CHSUM CALCULATE THE CHECKSUM. LDA D7 JSB WRTRC WRITE THE RECORD. * * PUT TOGETHER "EXT CALSB" RECORD. * CLA,INA PUT TOGETHER EXT CALSB RECORD. STA SID INITIALIZE SYMBOL ID #. LDB CALSB NAME BUFFER JSB CREXT # ENTRIES = 1 * * PUT TOGETHER REMAINING EXT RECORD(S). * LDA SAVE3 PUT TOGETHER EXT RECORD(S) CLB FOR THE DEVICE SUBROUTINES JSB CREXT LDB SAVE5 UPDATE ENTRY POINT STB ENPTS NAME POINTER. * * BUILD DBL RECORD FOR JSB AND DEF INSTRUCTIONS. * LDB BUFAD PUT TOGETHER DBL RECORD(S) LDA D7 ALF,ALF PUT TOGETHER JSB CALSB, STA B,I DEF START IN ONE RECORD. INB LDA IDENT STORE IDENTIFIER WORD. STA B,I ADB D2 CLA STA B,I INB LDA WD5 STA B,I INB LDA WDJSB STA B,I STORE JSB CALSB INB LDA D2 STA B,I STORE DEF START JSB CHSUM STORE CHECKSUM. LDA D7 JSB WRTRC WRITE THE RECORD. * * BUILD DBL RECORD(S) FOR THE SUBROUTINE DEF'S. * LDA D2 INITIALIZE EXTERNAL SYMBOL ID. STA SID STA SAVE5 INITIALIZE RELOCATABLE LOAD ADDRESS. LDA SAVE3 T.OV5 ADA M46 SET UP COUNTERS. STA CNTR SSA,RSS JMP T.OV3 ADA D46 CMA,INA STA SAVE4 JMP T.OV4 * * SUBROUTINE TO WRITE A RECORD AND CHECK * ERRORS. WRTRC DOES NOT RETURN IN CASE * OF ERROR BUT INSTEAD EXITS T.OVL DIRECTLY. * WRTRC NOP STA RECLN {jSAVE RECORD LENGTH. JSB WRITF DO A FMGR WRITE. DEF *+5 DEF T.DCB DEF T.ERN DEF BUFAD,I DEF RECLN LDA T.ERN SZA JMP T.OVL,I JMP WRTRC,I * RECLN BSS 1 * D4 DEC 4 M5 DEC -5 M46 DEC -46 D46 DEC 46 M45 DEC -45 EXTRF OCT 111110 DBLID OCT 60100 ENDID OCT 120001 D45 DEC 45 * T.OV3 LDA M45 STA SAVE4 T.OV4 CMA,INA FIGURE OUT TOTAL LENGTH STA SAVE2 OF RECORD AND # OF CLB INSTRUCTION WORDS. DIV D5 ADA SAVE2 ADA D4 SZB INA LDB BUFAD ALF,ALF STA B,I SAVE RECORD LENGTH. INB LDA DBLID ADA SAVE2 STA B,I STORE IDENT WORD. ADB D2 LDA SAVE5 STA B,I STORE RELOCATABLE LOAD T.OV8 INB ADDRESS. LDA EXTRF STA B,I STORE DESCRIPTOR WORD. LDA M5 STA SAVE2 STORE THE SYMBOLS. T.OV9 INB LDA SID STA B,I ISZ SID INCREMENT SYMBOL #. ISZ SAVE4 FINISHED? JMP T.OV7 NO. * JSB CHSUM STORE CHECKSUM. LDA BUFAD,I ALF,ALF JSB WRTRC WRITE THE RECORD. LDA SAVE5 ADA D45 INCREMENT RELOCATABLE STA SAVE5 LOAD ADDRESS. LDA CNTR DO WE NEED TO SSA,INA,RSS MAKE MORE RECORDS? JMP T.OV5 YES - BACK THROUGH LOOP. * * BUILD END RECORD. * LDB BUFAD PUT TOGETHER END RECORD. LDA D4 ALF,ALF STA B,I STORE RECORD LENGTH. INB LDA ENDID STA B,I STORE IDENTIFIER WORD. ADB D2 CLA STA B,I STORE RELOCATABLE TRANSFER ADDRESS. JSB CHSUM PUT IN CHECKSUM. LDA D4 JSB WRTRC WRITE THE RECORD. * JSB CLOSE NO - ALL DONE WITH THIS DIRECTORY. DEF *+3 CLOSE THE OVERLAY DEF T.DCB DIRECTORY FILE. DEF T.ERN ? LDA T.ERN ERRORS? SZA JMP T.OVL,I YES - LEAVE. * LDA OVBUF SET UP TO CREATE ADA D3 MORE OVERLAYS. GO STA OVBUF BACK AND SEARCH LDA SAVE1 THE BRANCH TABLE. JMP T.OV6 * T.OV7 ISZ SAVE2 FINISHED WITH GROUP OF 5? JMP T.OV9 NO. JMP T.OV8 YES. * * * * SUBROUTINE TO CREATE EXT RECORD OR RECORDS. * * CALLING SEQUENCE: * * LDA NUMBER OF SYMBOLS CREXT WRITES THE * LDB SYMBOL BUFFER ADDRESS RECORDS AND EXITS * JSB CREXT T.OVL DIRECTLY IF * RETURN THERE IS AN ERROR. * IF THE SYMBOL BUFFER * ADDRESS IS 0, CREXT * WORKS FROM THE BRANCH AND ENTRY POINT TABLE. * * CREXT NOP SZB,RSS SYMBOL BUFFER SUPPLIED? LDB ENPTS NO - USE ENTRY POINTS. STB SAVE5 YES - SAVE IT. CREX4 ADA M20 STA CNTR SSA,RSS JMP CREX1 ADA D20 CMA,INA STA SAVE4 JMP CREX2 * CNTR BSS 1 ENPTS BSS 1 SAVE4 BSS 1 D20 DEC 20 M20 DEC -20 M19 DEC -19 SAVE5 BSS 1 HIBYT OCT 177400 * CREX1 LDA M19 STA SAVE4 CREX2 CMA,INA FIGURE OUT TOTAL STA CHSUM LENGTH OF THE RECORD. ALS ADA CHSUM ADA D3 ALF,ALF LDB BUFAD STA B,I STORE LENGTH LDA CHSUM GET NUMBER OF ENTRIES CCE AND FORM IDENT WORD. ELA,RAR INB STA B,I ADB D2 STB SAVE2 CREX3 JSB .DFER STORE THE SYMBOL IN DEF SAVE2,I THE BUFFER. DEF SAVE5,I SOURCE BUFFER ADDRESS. LDB SAVE2 STORE THE SYMBOL ID ADB D2 LDA B,I AND HIBYT XOR SID STA B,I ISZ SID INB INCREMENT SYMBOL POINTERS. STB SAVE2 LDB SAVE5 ADB D3 STB SAVE5 ISZ SAVE4 FINISHED WITH *($THIS RECORD? JMP CREX3 NO - BACK THROUGH LOOP. JSB CHSUM YES - PUT IN CHECKSUM. LDA BUFAD,I ALF,ALF JSB WRTRC WRITE THE RECORD. LDA CNTR CHECK IF WE NEED TO SSA,INA,RSS MAKE MORE RECORDS. JMP CREX4 NEED MORE. JMP CREXT,I ALL DONE. * END * I1{ 92101-18010 1710 S C0122 BASIC-TRAP TABLE MODULE (TRAP)             H0101 %ASMB,R,F,L,C HED ** TRAP TABLE MODULE ** 92101-19010 REV.1710 NAM TRAP,14 92101-16010 770208 * *************************************************************** * ************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1975. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * * PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ************************************************************** * * * LISTING: 92101-19010 * SOURCE: 92101-18010 * RELOC: 92101-16010 * * ************************************************************** * * ENTRY POINTS: * ENT TRAP,TIME ENT TRPNT,FINDS,TRMAK,TRDEL ENT TRPNO,SEKNO,PRINO ENT TRTBL,TRPTR,TRNXT,TRFLG ENT TRMSK,TRAP# ENT TSEND,TSTIM,TSNXT,TSTBL,TSCNT,TSPTR ENT SRQ.T * * * * EXTERNAL REFERENCES: * EXT $LIBR,$LIBX EXT $TIME * * * * ** TRAP ** DO VARIOUS TRAP NUMBER ORIENTED OPERATIONS * * THIS ROUTINE HAS FOUR CALLING SEQUENCES DEPENDING ON ITS FUNCTION. * THE NOMINAL CALLING SEQUENCE, ASSOCIATED WITH EXECUTION OF THE * BASIC TRAP STATEMENT, IS AS FOLLOWS: * * LDA MINUS THE TRAP NUMBER * LDB SEQUENCE NUMBER (FROM TRAP STMT,MAY BE - ) * JSB TRAP * JMP ERR1 (ERROR RETURN) * RETURN * **************************************************** * * THIS ROUTINE IS CALLED JUST * BEFORE EXECUTING EACH LINE OF BASIC CODE: * * LDA MINUS 1000 DECIMAL (USED TO FLAG THIS CASE) * LDB POINTER TO STATEMENT ABOUT TO BE EXECUTED * JSB TRAP * JMP ERR (ERROR RETURN) * RETURN (SEE NOTE) * * NOTE: WHEN THIS CALL IS RECOGNIZED (.A.=-1000) THE * TRAP TABLE IS POLLED TO DETERMINE IF PROGRAM * SHOULD BE INTERRUPTED BY A TIME OR EVENT * SCHEDULED TASK. * * RETURN VALUES IF PROGRAM IS TO BE INTERRUPTED * * .A.= SEQUENCE NUMBER FROM TRAP TABLE * .B.= SEQUENCE NBR THAT WOULD HAVE BEEN EXECUTED OTHERWISE * * RETURN VALUES IF PROGRAM IS NOT TO BE INTERRUPTED * * .A.= -1 (SERVES AS FLAG FOR THIS CASE) * .B.= ADDRESS OF STATEMENT TO BE EXECUTED NEXT * **************************************************** * * WHEN A TASK IS SCHEDULED IN THE ABOVE MANNER, ITS * RETURN STATEMENT RESULTS IN YET ANOTHER CALL: * * LDA MINUS 256 DECIMAL (USED AS FLAG) * LDB MINUS SEQ NBR TO BE RETURNED TO * JSB TRAP * JMP ERR (ERROR RETURN) * RETURN .A.= RETURN SEQUENCE NUMBER * **************************************************** * * FINALLY TRAP IS CALLED TO INITIALIZE OR FREE UP THE TRAP * TABLE AT THE BEGINNING OR END OF EXECUTION PHASE: * * LDA 1 DECIMAL INDICATES AN INITIALIZE REQUEST * OR LDA 2 DECIMAL INDICATES A TERMINATE REQUEST * JSB TRAP * JMP ERR (ERROR RETURN) * RETURN * **************************************************** * TRAP NOP JSB $LIBR NOP STB LYNNO SAVE INCOMING LINE NO. SSA,RSS IS THIS AN INIT OR TERM REQUEST? JMP INIT YES! CPA M1000 IS THIS THE POLLING CALL JMP LINE YES CPA M256 IS THIS THE TASK RETURN CALL? JMP TRRET YES CMA,INA MAKE TRAP NUMBER POSITIVE ALF,ALF POSITION IT, STA TRPNO AND SAVE IT SSB IF SEQ NBR IS NEGATIVE CCA SET TFLAG TO -1 STA TFLAG ELSE SET IT POSITIVE SSB CMB,INB MAKE SURE SEQ NBR IS POSITIVE STB SEKNO THEN SAVE IT STB TRFLG ENABLE TRAP TABLE SEARCH LDA 1 JSB FINDS LOOK FOR ENTRY WITH THAT SEQ NBR JMP STRA1 NOT FOUND LDA TRPTR FOUND STA BSCT2 SAVE ADDRESS OF ENTRY LDA TRPNO JSB FINDT LOOK FOR ENTRY WITH THIS TRAP NO JMP STRA2 NOT FOUND { LDB TRPTR IS THIS THE SAME ENTRY WE FOUND CPB BSCT2 WITH THE GIVEN SEQ NBR? JMP STRA4 YES, ENTRY IS ALREADY THERE LDA .2 ILLEGAL JMP RTRAP+1 COMBINATION ERROR STRA1 LDA TRPNO JSB FINDT LOOK FOR ENTRY WITH THIS TRAP NO JMP STRA3 NOT FOUND, MUST MAKE NEW ENTRY * ** HERE TO RESET TRAP BIT (IF POS IN TRAP STMT) * STRA4 LDB TRPTR LDA 1,I FOUND, REPLACE SEQ NBR IN ENTRY AND BIT15 PRESERVE TRAP BIT ISZ TFLAG IF GIVEN SEQ NBR WAS POSITIVE, CLA CLEAR TRAP BIT IOR SEKNO INSERT GIVEN SEQ NBR STA 1,I AND STORE INTO ENTRY * ** COME HERE TO ENABLE TRAP AND RETURN * INB GET SECOND LDA 1,I WORD OF ENTRY IOR BIT15 SET ENABLE BIT STA 1,I AND PUT BACK IN ENTRY JMP RTRAP RETURN (P+2) * ** HERE TO CREATE A NEW ENTRY * STRA3 LDA .99 SET DEFAULT STA PRINO PRIORITY (99) JSB TRMAK MAKE NEW ENTRY RSS NO ROOM JMP STRA4 DONE, RETURN CLA,INA TRAP JMP RTRAP+1 TABLE FULL * ** HERE WHEN ENTRY WITH SEQ NBR BUT NOT TRAP # FOUND * STRA2 LDB TRPTR INB LDA 1,I GET SECOND WORD OF ENTRY AND PRMSK SAVE PRIORITY IOR TRPNO INSERT TRAP NBR STA 1,I PUT BACK IN ENTRY JMP STRA4 ENABLE IT AND RETURN SKP * ** COME HERE TO INITIALIZE THE TRAP TABLE ** FOR CALL INFO, SEE COMMENTS PRECEEDIND TRAP ENTRY POINT * * ** HERE TO INITIALIZE TABLES AT BEGINNING OF EXECUTION PHASE. * INIT CPA .2 TERMINATE REQUEST? JMP TERM YES! LDA CUPGM USE ID SEG PTR AS CPA XEQT IS THIS THE RIGHT USER? JMP *+5 YES! SZA IS IT FIRST TIME THROUGH? JMP INIT1 NO! SO IGNORE HIM, HE SHOULDN'T BE HERE LDA XEQT SET UP ID SEG ADDRS STA CUPGM Ҥ AS IDENT NO. LDA TRTBL INITIALIZE STA TRNXT TRAP TABLE STA TRPTR POINTERS LDA TSTBL INITIALIZE STA TSNXT TIME SCHED TABLE STA TSPTR POINTERS JSB TIME INITIALIZE TIME OF LAST CHECK DEF *+2 DEF TSTIM OF TIME SCHD TABLE DLD MAXNG MAX NEGATIVE FLOAT PT NBR DST TSCNT INITIALIZE TIME TO EXECUTION CNT LDA PRSTK INITIALIZE STA TRPRI PRIORITY STACK CLA DONT NEED TO SEARCH FOR TRAP STA TRFLG BITS UNTIL SOMETHING HAPPENS JMP RTRAP * TERM CLA CLEAR OUT STA CUPGM USER IDENT NUMBER JMP RTRAP RETURN * INIT1 LDB M1 SET FLAG SO BASIC DOESN'T JMP RTRAP COME DONE HERE THRU THE 'LINE' CALL * FOR EVERY STATEMENT SKP * ** HERE TO DO END OF LINE TRAP TABLE POLLING * LINE JSB TIMCK LDB TRFLG IS TRAP TABLE SEARCH NECESSARY? SZB JMP LINE8 YES LINE9 LDA M1 .A.=-1 MEANS DONT INTERRUPT PROG LDB LYNNO RESTORE INCOMING VALUE OF B REG JMP RTRAP RETURN * ** HERE FOR RETURN IF TABLE SEARCHED BUT NO INTERRUPT NEEDED * LINE3 CLA NO NEED TO SEARCH AGAIN STA TRFLG UNTIL SOMETHING HAPPENS JMP LINE9 RETURN (NO INTERRUPT) * ** HERE TO DO TRAP TABLE SEARCH * LINE8 LDB TRTBL INITIALIZE .B. TO FRONT OF TABLE LINE1 CPB TRNXT END OF TABLE JMP LINE3 YES LDA 1,I NO, GET FIRST WORD OF ENTRY INB AND 1,I "AND" TRAP BIT WITH ENABLE BIT SSA ARE BOTH BITS SET? JMP LINE2 YES INB ADVANCE TO NEXT ENTRY JMP LINE1 AND LOOP * ** HERE IF BOTH TRAP AND ENABLE BITS SET * LINE2 ADB M1 LDA 1,I GET FIRST WORD OF ENTRY ELA,CLE,ERA CLEAR TRAP BIT SZA IS SEQ NBR ZEROED OUT? JMP LINE4 NO ADB .2E YES, ADVANCE TO NEXT ENTRY JMP LINE1 AND KEEP LOOKING LINE4 STB TRPTR SAVE POINTER TO ENTRY INB LDA 1,I GET SECOND WORD OF ENTRY AND PRMSK EXTRACT PRIORITY CMA,INA IF PRIORITY OF THIS TASK IS ADA TRPRI,I EQUAL OR LESS THAN THE ONE CMA,INA SSA,RSS BEING PROCESSED, JMP LINE3 EXIT (NO INTERRUPT) * ** HERE TO DO INTERRUPT OF PROGRAM * LDA 1,I AND PRMSK GET PRIORITY AGAIN ISZ TRPRI BUMP PRIORITY STACK POINTER STA TRPRI,I SET UP WITH CURRENT PRIORITY LDB TRPTR LDA 1,I CLEAR TRAP BIT ELA,CLE,ERA IN THIS STA 1,I ENTRY LDB LYNNO,I ENTER SEQ NBR FOR RETURN CMB,INB COMPLEMENT IT TO FLAG AS TASK JMP RTRAP RETURN * ** COME HERE TO PROCESS RETURN FROM AN INTERRUPT ** STARTED TASK. A NEGATIVE RETURN ADDRESS RESULTS ** IN TRANSFER TO THE TRAP ROUTINE AND THEN TO THE ** FOLLOWING CODE. * TRRET CMB,INB MAKE SEQ NBR POSITIVE LDA 1 MOVE IT TO A REG LDB TRPRI POP THE ADB M1 PRIORITY STB TRPRI STACK STB TRFLG AND ENABLE TRAP TABLE SEARCH RTRAP ISZ TRAP JSB $LIBX RETURN (P+1) DEF TRAP * SKP ***** * ** TIMCK ** ROUTINE TO CHECK TIME SCHED TABLE * * JSB TIMCK * RETURN * ***** * TIMCK NOP JSB TIME SAVE DEF *+2 DEF TIMT1 CURRENT TIME TIMC3 FSB TSTIM GET-TIME ELAPSED FROM LAST CHECK SSA,RSS CORRECT JMP TIMC4 FOR CHANGE FAD FLDAY OF DAY TIMC4 FAD TSCNT UPDATE SECONDS TO EXECUTION DST TSCNT SSA,RSS HAS THAT TIME ELAPSED? JMP TIMC1 YES DLD TIMT1 NO, UPDATE TIME OF LAST CHECK DST TSTIM JMP TIMCK,I AND RETURN * ** HERE IF TASK AT TOP IS TO BE SCHEDULED * TIMC1 LDB TSNXT ADB M1 LDA 1,I GET SEQ NNBR ADB M2 BACK UP TSNXT TO STB TSNXT DELETE ENTRY JSB FINDS LOOK FOR ENTRY WITH THAT SEQ NBR JMP TIMCE NOT FOUND LDB TRPTR LDA 1,I FOUND, IOR BIT15 SET TRAP BIT STA 1,I STA TRFLG SET UP TO POLL TABLE * ** HERE TO SET UP NEXT ENTRY * LDB TSNXT SET POINTER ADB M3 TO NEXT STB TSPTR ENTRY DLD TSTIM USE OLD VALUE OF CURRENT TIME FSB TSPTR,I SINCE THIS TASK MAY HAVE TO BE SSA EXECUTED NOW ALSO JMP TIMC2 FSB FLDAY IF POSITIVE, SET UP FOR TOMORROW TIMC2 DST TSCNT SET UP NEW COUNTER DLD TIMT1 GET REAL CURRENT TIME VALUE JMP TIMC3 AND TRY AGAIN TIMCE LDA .6 CAN'T RUN BECAUSE JMP RTRAP+1 ITS BEEN DELETED SKP **************************************************************** * * * BASIC TIME STATEMENT * * **************************************************************** * * * *THIS ROUTINE IS A FORTRAN AND BASIC CALLABLE ROUTINE THAT *RETURNS THE TIME OF DAY IN FLOATING POINT SECONDS TO THE *NEAREST 100 MS (OR TENTH OF A SECOND).THE VALUE OF ZERO *REPRESENTS MIDNIGHT. * * JSB TIME ASSEMBLY LANGUAGE * DEF *+2 * DEF TI * * 100 TIME(T) BASIC * * ON RETURN A/B=TIME IN TENS OF MS * * * TM BSS 1 TIME NOP JSB $LIBR NOP ISZ TIME LDA TIME,I GET PTR STA TM TO TIME ISZ TIME DLD $TIME GET TIME FROM SYSTEM CLE CLEAR FOR ADD ADA PRS1 CONVERT TO POSITIVE 24HRS SEZ INB ADB PRS2 DIV .6000 A=MINS,B=SECS STA MINS ASR 16 POSITION FOR DIV DIV .100 A=SECS,B=10S OF MS STB MS10 FLT 4% DST TM,I TEMPORARY TIME LDA MINS FLT FMP F.60 MINS IN SECONDS FAD TM,I DST TM,I LDA MS10 MS IN SECONDS FLT FDV F.100 FAD TM,I DST TM,I JSB $LIBX RETURN DEF TIME SKP * .6000 DEC 6000 PRS1 OCT 153000 PRS2 OCT 203 MS10 BSS 1 MINS BSS 1 .100 DEC 100 F.60 DEC 60. F.100 DEC 100. ******************* PRIORITY STACK ************** * PRSTK DEF *+1 POINTER TO FIRST ENTRY DEC 100 FIRST ENTRY IS PRIORITY 100 BSS 21 ALLOW 21 ACTUAL ENTRIES PREND DEF * POINTER TO END OF STACK AREA+1 TRPRI NOP POINTER TO TOP ENTRY ON STACK * ************************************************** ****************** TIME SCHED TABLE ************* * * WORD 1&2: FLOATING POINT TIME (SEC) * * WORD 3 SEQUENCE NUMBER * TSTBL DEF *+1 POINTER TO BEGINNING OF TABLE BSS 48 ALLOW 16 ENTRIES TSEND DEF * POINTER TO END+1 OF TABLE TSPTR NOP GENERAL USE TABLE POINTER TSNXT NOP POINTER TO NEXT FREE ENTRY TSTIM BSS 2 TIME OF LAST UPDATE OF TIME SCHD TSCNT BSS 2 -# SECONDS TILL SCHED NEXT TASK * * ********************************************************* SKP * .2 DEC 2 .6 DEC 6 .99 DEC 99 M1 DEC -1 M2 DEC -2 M3 DEC -3 M256 DEC -256 M1000 DEC -1000 MAXNG OCT 100000 OCT 376 FLDAY DEC 86400. NO. OF SECONDS/DAY LYNNO NOP TIMT1 BSS 2 BSCT2 NOP TFLAG NOP CUPGM NOP XEQT EQU 1717B SKP ***** * ** FINDS ** FIND TRAP TABLE ENTRY WITH GIVEN SEQUENCE NUMBER * * LDA SEQUENCE NUMBER * JSB FINDS * RETURN1 NO SUCH ENTRY FOUND * RETURN2 ENTRY FOUND, TRPTR AND .B. POINT TO IT * * NOTE: TRPTR NOT ALTERED IF ENTRY NOT FOUND * ***** * FINDS NOP JSB $LIBR NOP STA BSCT1 SAVE SEQUENCE NUMBER LDB TRNXT USE .B. FOR TRAP TABLE POINTER CPB TRTBL IS TABLE EMPTY? JMP FNDS3 YES, RETURN (P+1) FNDS1 ADB M2 MOVE TO NEXT ENTRY LDA 1,I GET SEQ NBR FROM ENTRY ELA,CLE,ERA IGNORE TRAP BIT CPA BSCT1 DO SEQ NBRS MATCH? JMP FNDS2 YES, FOUND IT CPB TRTBL NO, IS TABLE EXHAUSTED? JMP FNDS3 TABLE EXHAUSTED, RETURN (P+1) JMP FNDS1 MORE ENTRIES, CHECK THEM * ** COME HERE WHEN ENTRY FOUND * FNDS2 ISZ FINDS SET UP SUCCESS RETURN STB TRPTR SET TRAP TABLE POINTER FNDS3 JSB $LIBX RRETURN DEF FINDS SKP ***** * ** FINDT ** FIND TRAP TABLE ENTRY WITH GIVEN TRAP NBR * * LDA TRAP NUMBER (POSITIONED IN WORD) * JSB FINDT * RETURN1 ENTRY NOT FOUND WITH THAT TRAP NBR * RETURN2 FOUND, TRPTR AND .B. POINT TO IT * * NOTE: TRPTR NOT ALTERED IF ENTRY NOT FOUND * ***** * FINDT NOP JSB $LIBR NOP STA BSCT1 AND SAVE FOR LATER COMPARISON LDB TRNXT VSE .B. FOR TRAP TABLE POINTER CPB TRTBL IF TABLER IS EMPTY, JMP FNDT3 RETURN (P+1) FNDT1 ADB M1 MOVE TO NEXT ENTRY LDA 1,I GET WORD WITH TRAP NBR AND TRMSK EXTRACT TRAP NBR CPA BSCT1 DO THEN MATCH? JMP FNDT2 YES ADB M1 NO, POINT TO BEGINNING OF ENTRY CPB TRTBL IS THE TABLE EXHAUSTED JMP FNDT3 YES, RETURN (P+1) JMP FNDT1 NO, CHECK NEXT ENTRY FNDT2 ISZ FINDT SET UP SUCCESS EXIT ADB M1 MOVE TO FIRST WORD OF ENTRY STB TRPTR SET TRAP TABLE POINTER FNDT3 JSB $LIBX RETURN DEF FINDT SKP * ***** * ** TRDEL ** DELETE FROM TRAP TABLE THE ENTRY AT TRPTR * * JSB TRDEL * RETURN * ***** * TRDEL NOP JSB $LIBR NOP LDB TRNXT IF ENTRY TO BE DELETED CPB TRPTR IS LAST+1 ENTRY, JMP TRDE2  RETURN IMMEDIATELY ADB M2 DECREMENT END OF TABLE POINTER STB TRNXT TO POINT TO NEW LAST+1 LOCATION TRDE1 LDB TRPTR CPB TRNXT IF END OF TABLE JMP TRDE2 RETURN (P+1) ADB B2 DLD 1,I GET ENTRY AT TRPTR + 1 ENTRY DST TRPTR,I STORE IT AS TRPIR ENTRY ISZ TRPTR BUMP TRPTR TO NEXT ENTRY ISZ TRPTR JMP TRDE1 LOOP TRDE2 JSB $LIBX RETURN DEF TRDEL SKP ***** * ** TRMAK ** MAKE A TRAP TABLE ENTRY, ORDERED BY PRIORITY * * SEKNO= SEQUENCE NBR (TRAP BIT MAY BE SET) * PRINO= PRIORITY * TRPNO= TRAP NUMBER (ALREADY POSITIONED IN WORD) * JSB TRMAK * RETURN1 NO ROOM FOR ENTRY * RETURN2 ENTRY MADE (TRPTR POINTS TO IT) * * NOTE: NEW ENTRIES ARE AUTOMATICALLY ENABLED * ***** * TRMAK NOP JSB $LIBR NOP LDB TRNXT IS THE TABLE CPB TREND ALREADY FULL? JMP TRMK3 YES, RETURN (P+1) ISZ TRMAK NO, SET UP SUCCESS RETURN STB TRPTR SET POINTER TO END OF TABLE ADB B2 STB TRNXT BUMP TRNXT TO REFLECT NEW ENTRY LDB TRPTR TRMK1 CPB TRTBL ARE WE TO OTHER END OF TABLE? JMP TRMK2 YES, MAKE ENTRY HERE ADB M1 NO, MUST TEST FOR SORTING ORDER LDA 1,I GET SECOND WORD OF ENTRY AND PRMSK EXTRACT PRIORITY CMA,INA IF PRIORITY OF ADA PRINO ENTRY IS EQUAL OR HIGHER SSA,RSS THAN PRIORITY OF NEW ENTRY. JMP TRMK2 MAKE ENTRY HERE ADB M1 ELSE MOVE THIS ENTRY DLD 1,I DOWN ONE TO ALLOW PROPER DST TRPTR,I ORDERING OF NEW ENTRY LDB TRPTR MOVE ADB M2 POINTER TO STB TRPTR NEXT ENTRY JMP TRMK1 AND CONTINUE * ** COME HERE TO ACTUALLY MAKE ENTRY * TRMK2 LDA SEKNO STORE SEQUENCE NUMBER IN FIRST LDB TRPTR STA 1,I WORD OF ENTRY LDA PRINO GET w5PRIORITY (BITS 0-7) IOR TRPNO INCLUDE TRAP NUMBER (BITS 8-14) IOR BIT15 SET ENABLE BIT INB STORE SECOND STA 1,I WORD OF ENTRY STB TRFLG ENABLE TRAP TABLE SEARCH TRMK3 JSB $LIBX RETURN DEF TRMAK SKP ***** * ** TRPNT ** SET A BIT IN THE TRAP TABLE * * LDA TRAP NUMBER * JSB TRPNT * RETURN1 TRAP TABLE FULL & THIS ENTRY NOT THERE ALREADY * RETURN2 SUCCESS * * NOTE: IF NO ENTRY WITH THAT TRAP NBR EXISTS, THIS * ROUTINE WILL MAKE ONE WITH PRIORITY 99 AND * WITH THE ENABLE BIT AND THE SEQ NBR CLEARED. * ****** * TRPNT NOP JSB $LIBR NOP ALF,ALF STA TRPNO SAVE TRAP NBR JSB FINDT FIND ENTRY WITH THAT TRAP NBR JMP TRPN1 NOT FOUND LDA TRPTR,I FOUND, IOR BIT15 SET TRAP BIT STA TRPTR,I AND UPDATE ENTRY STA TRFLG ENABLE TRAP TABLE SEARCH TRPN2 ISZ TRPNT TRPN3 JSB $LIBX RETURN DEF TRPNT * ** HERE IF MUST CREATE NEW ENTRY * TRPN1 CLA DEFAULT STA SEKNO SEQUENCE NBR LDA D99 DEFAULT STA PRINO PRIORITY JSB TRMAK MAKE ENTRY JMP TRPN3 NO ROOM, RETURN (P+1) LDB TRPTR GET INB SECOND WORD LDA 1,I OF ENTRY ELA,CLE,ERA CLEAR ENABLE BIT STA 1,I JMP TRPN2 RETURN (P+2) (PONT CHANGE TRFLG) SKP **************************************************** * ******************* TRAP TABLE ******************* * * WORD 1: BIT 15 TRAP BIT * BITS 14-0 SEQUENCE NUMBER * * WORD 2: BIT 15 ENABLE BIT * BITS 14-8 TRAP NUMBER * BITS 7-0 PRIORITY * * TRTBL DEF *+1 POINTER TO BEGINNING OF TABLE BSS 32 ALLOW FOR 16 ENTRIES TREND DEF * POINTER TO END+1 OF TABLE TRPTR NOP GENERAL USE TABLE PORB@> 92101-19012 REV.1826 NAM CALSB,7 92101-16012 REV.1826 780519 * * * * ************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1975. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * * PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ************************************************************** * * * * LISTING: 92101-19012 * RELOC: 92101-16012 * SOURCE: 92101-18012 * * * ********************************************************************* * * * * RTE-BASIC PARAMETER TRANSFER ROUTINE * ENT FWAFS,LWAFS,CALSB,DESPT ENT RFLAG,FWPWA SPC 3 EXT RMPAR,EXEC,PRTN,#RSFG EXT ERROR,LUERR,ERRCD,.LNUM SPC 3 * SUP PRESS MULTIWORD OCTAL LISTINGS SPC 3 CALSB NOP JSB RMPAR FETCH PARAMETERS DEF *+2 DEF SUB# LDA LUER STORE ERROR LUN STA LUERR TO ERROR ROUTINE LDA LNUM STORE CURRENT LINE NUMBER STA .LNUM TO ERROR ROUTINE SPC 1 * * CHECK TO SEE IF OVERLAY IS BEING CALLED FROM BASIC 'BYE' * TO PERMANENTLY TERMINATE ITSELF * LDA SUB# IS THIS CPA AB AN ABORT? RSS YES! JMP CALS0 NO, CONTINUE JSB EXEC TERMINATE DEF *+3 OVERLAY DEF .6 DEF .0 * SPC 1 CALS0 JSB EXEC NOTIFY THE DEF *+3 OPERATING SYSTEM DEF .22 TO SWAP WHOLE DEF .3 FOREGROUND AREA SPC 1 LDA XEQT ARE ADA .14 WE LDA 0,I IN AND B17 THE CPA .2 FORE GROUND? JMP CALS3 YES! LDA BGLWA NO, USE BACKGROUND BOUNDARY Z JMP CALS6 AS LIMIT CALS3 LDA AVMEM FOREGOUND ADA M1 GET LIMIT CALS6 STA LWAFS AND SET IT LDA SUB# FETCH ADA CALSB,I SUBROUTINE LDA 0,I ENTRY RAL,CLE,SLA,ERA ADDRESS JMP *-2 FROM STA SUB# DIRECTORY LDA RFLAG CPA .1 JMP CALS7 LDA XEQT MAKE POINTER TO ADA .23 PROGRAM ID LDA 0,I SEGMENT RSS CALS7 LDA FWPWA STA FWAMI SET UP FREE CORE POINTER ADA .46 IS THERE CMA ENOUGH ROOM ADA LWAFS FOR THE DESCRIPTOR SSA BLOCK ? JMP NOMEM NO * LDB M15 CLEAR ALL LDA PADDR OLD STA PADPT SUBROUTINE CLA DEF'S OUT SO STA PADPT,I AS NOT TO CONFUSE ISZ PADPT THOSE SUBROUTINES INB,SZB THAT MAY HAVE OPTIONAL JMP *-3 PARAMETERS * SKP JSB EXEC READ IN THE DEF *+5 DESCRIPTOR DEF .21 BLOCK DEF CLASS FROM CLASS DEF FWAMI,I TO FREE CORE DEF .46 SPC 1 SSA DID WE GET IT ? JMP BADXF NO STB DBSIZ YES, SAVE SIZE OF BLOCK ADB FWAMI AND START THE STB FWPAR PARAMETER AREA JUST AFTER STB FWAFS THE DESBLK LDA PADDR PRESET POINTER TO STA PADPT PARAMETER LIST JSB PINIT SET UP POINTER & COUNTER JMP CALS4 AND BEGIN PARAMETER TRANSFER SPC 2 PINIT NOP LDA FWAMI,I INITIALIZE COUNTER CMA STA PCNT LDA FWAMI AND POINTER TO ADA DBSIZ DESCRIPTOR BLOCK ADA M3 ENTRY FOR FIRST STA DESPT PARAMETER JMP PINIT,I SKP CALS1 STB DPADPT,I SAVE PARAMETER ADDRESS LDB DESPT,I PICK UP RECORD LENGTH LDA DESPT ADA .2 LDA 0,I SSA,RSS STRING? JMP CLS1A NO, WORDS NOT CHARS! CLA PUT RRR 8 PHYSICAL LENGTH IN (A) ALF,ALF AND LOGICAL LENGTH IN (B) STA TEMP,I SAVE (+) CHARS AS STRING HEADER CMA,INA IS PHYSICAL LENGTH ADA 1 LONGER THAN SSA OR AS LONG AS LOGICAL LENGTH? LDB TEMP,I NO, SO USE LOGICAL LENGTH ISZ TEMP CLE,ERB USING PHYSICAL LENGTH CONVERT TO WORDS SEZ ALLOWING FOR INB ODD CHARACTER LDA DESPT SET UP INA STB 0,I READ LENGTH STB LENTH JMP CALS2 * * CLS1A LDB DESPT FETCH THE LDA 1,I STA LENTH INB BASE ADDRESS DLD 1,I AND ARGUMENT ADDRESS CMA,INA OFFSET THE ADA 1 PARAMETER ADA PADPT,I POINTER STA PADPT,I LDB DESPT,I RESTORE RECORD LENGTH CALS2 ADB TEMP FIGURE NEXT RECORD ADDRESS STB FWAFS AND SAVE FOR LATER CMB ADB LWAFS CHECK IF THIS RECORD WILL SSB FIT INTO FOREGROUND JMP NOMEM NO ! SPC 1 CLGET JSB EXEC READ IN DEF *+5 A RECORD DEF .21 DEF CLASS DEF TEMP,I DEF LENTH SPC 1 SSA RECORD GOT ? JMP CALS5 NO LDA DESPT YES, POINT TO ADA M3 NEXT DESCRIPTOR STA DESPT TRIPLET ISZ PADPT AND NEXT LIST ENTRY CALS4 LDB FWAFS STB TEMP ISZ PCNT MORE PARAMETERS ? JMP CALS1 SKP LDB DMMYA SET UP DUMMY STB TEMP BUFFER STB DESPT CLB,INB SET SIZE = 1 STB DESPT,I JMP CLGET LOOP UNTIL CLASS EMPTYd SPC 2 CALS5 LDA PCNT MORE PARAMETERS ? SZA JMP BADXF YES, TOO BAD STA ERRCD NO, PRESET ERROR CODE JSB PINIT AND DESBLK POINTER * * HERE IS WHERE THE ROUTINE * ACTUALLY GETS CALLED * JSB SUB#,I DEF *+16 PLIST BSS 15 SPACE HERE FOR PARAMETER ADDRESSES * DST ABREG SAVE RETURNED VALUE, IF ANY LDA ERRCD SUBROUTINE SZA ERROR ? JMP CRET6 YES, ABANDON SHIP JMP CRET4 * SUB# BSS 1 KEEP THESE CLASS BSS 1 IN ORDER NVFLG BSS 1 ALL FIVE OR ELSE LUER DEC 1 ERROR LOGICAL UNIT NUMBER LNUM NOP CURRENT LINE NUMBER SKP CRET1 LDA DESPT,I STA TEMP SAVE BLOCK LENGTH LDA DESPT ADA .2 LDA 0,I STRING? SSA,RSS IS THIS A STRING ? JMP CRET3 NO LDA FWPAR,I YES, CORRECT CMA,INA SET uP STA DESPT,I POSSIBLE NEW STRING LENGTH LDB DESPT THE BLOCK INB LENGTH LDA 1,I AND POINT STA TEMP TO ACTUAL STRING ISZ FWPAR CRET3 LDB NVFLG CHECK IF CLE,ERB BASIC NEEDS THIS STB NVFLG VARIABLE SEZ,RSS JMP CRE3A SKIP IF BY VALUE ONLY CRE3B JSB EXEC ELSE WRITE OUT DEF *+8 DEF .20 VALUES DEF .0 DEF FWPAR,I TO THE DEF DESPT,I DEF .0 CLASS DEF .0 DEF CLASS SPC 1 SSA SUCCESS ? JMP CRE3B SPC 1 CRE3A LDB DESPT POINT TO ADB M3 THE NEXT STB DESPT DESCRIPTOR LDB FWPAR AND UPDATE ADB TEMP BLOCK POINTER STB FWPAR CRET4 ISZ PCNT MORE PARAMETERS ? JMP CRET1 YES SPC 1 CLA MADE IT, NO ERRORS CRET6 STA RERR  JSB PRTN SEND ERROR CODE AND DEF *+2 FLOATED FUNCTION VALUE DEF RERR JSB EXEC TERMINATE DEF *+4 THIS OVERLAY DEF .6 AND SAVE RESOURCES DEF .0 OR LEAVE IT SERIAL DEF #RSFG RR-USABLE DEPENDING ON FLAG JMP CALSB+1 RETURN TO BEGINNING SPC 2 NOMEM LDA .1 OUT OF MEMORY STA ABREG SEND FLAG TO BASIC * JSB ERROR PRINT DEF *+3 OUT OF DEF .1 MEMORY DEF NOMMS MESSAGE * LDA MNEG SAYING FATAL ERROR JMP CRET6 SPC 1 BADXF LDA .2 MISSING RECORD JMP NOMEM+1 THIS IS FATAL, TOO SKP FWAMI BSS 1 FWPAR BSS 1 LENTH BSS 1 DESPT BSS 1 PCNT BSS 1 TEMP BSS 1 RERR BSS 1 ABREG BSS 2 FWAFS BSS 1 FIRST WORD OF AVAILABLE FREE SPACE LWAFS BSS 1 LAST WORD OF AVAILABLE FREE SPACE PADPT EQU ABREG+1 DBSIZ BSS 1 RFLAG BSS 1 FWPWA BSS 1 SPC 2 BGLWA EQU 1777B XEQT EQU 1717B AVMEM EQU 1751B SPC 2 B17 OCT 17 .0 DEC 0 .1 DEC 1 .2 DEC 2 .3 DEC 3 .6 DEC 6 .14 DEC 14 .20 DEC 20 .21 DEC 21 .22 DEC 22 .23 DEC 23 .46 DEC 46 MNEG OCT 100000 M1 DEC -1 M3 DEC -3 M15 DEC -15 SPC 2 PADDR DEF PLIST DMMYA DEF ABREG AB ASC 1,AB NOMMS DEC 9 ASC 5,NO MEMORY SPC 5 END f L V 92101-18013 A S C0122 BASIC-TASK SCHEDULE MODULE             H0101 ASMB,R,F,L,C HED * BASIC SCHED AND TRAP ROUTINES * 92101-19013 REV. A NAM SCHD,7 92101-16013 750724 * * ************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1975. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * * PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ************************************************************** ***************************************************************** * * RTE BASIC SCHEDULER ROUTINES * * REV A * * LISTING 92101-19013 * SOURCE TAPE 92101-18013 * RELOC BINARY TAPE 92101-16013 * **************************************************** * * THIS MODULE CONTAINS THOSE ROUTINES USED BY THE * BASIC INTERPRETER TO PERFORM PRIORITY * SCHEDULING AND EXECUTION OF TASKS * **************************************************** * * ENTRY POINTS: * ENT TTYS,SSETP,ENABL,DSABL,TRNON,SSTRT * * EXTERNAL REFERENCES: * EXT ERROR,TIME,EXEC EXT $LIBR,$LIBX EXT .ENTR,TRAP#,TSNXT,TSEND,TSTBL,TSTIM,TSCNT,TSPTR EXT FINDS,TRMAK,TRDEL EXT TRTBL,TRPTR,TRNXT,TRFLG EXT TRMSK,TRPNO,SEKNO,PRINO * SEQNO EQU SEKNO * * SUP PRESS MULTIPLE LISTING **************************************************** SKP ***** * ** CNVRT ** CONVERT TIME FROM FLOATING POINT HHMMSS FORM * TO FLOATING POINT SECONDS * * DLD TIME IN FLOATING POINT HHMMSS FORM * JSB CNVRT * RETURN .A.&.B.= FLOATING POINT SECONDS * * EXTERNALS REQUIRED: * EXT ..FCM * ***** * CNVRT NOP DST WHOLE SAVE INCOMING VALUE (HHMMSS) FDV F.100 FIX FLT DST HHMM HHMM= INT(HHMMSS/100) FDV F.100 FIX FLT DST HH HH= INT(HHMM/100) FMP F.100 JSB ..FCM FAED HHMM DST MM MM=HHMM-HH00 DLD HHMM FMP F.100 JSB ..FCM FAD WHOLE DST SS SS=HHMMSS-HHMM00 DLD HH FMP F.60 FAD MM FMP F.60 FAD SS .A.&.B.= (HH*60+MM)*60+SS SECONDS JMP CNVRT,I * SKP ***** * ** BSERR ** BASIC SCHEDULER ERROR ROUTINE * * LDA ADDRESS OF ERROR NUMBER * JSB BSERR * RETURN * * ***** * BSERR NOP STA BSER1 JSB $LIBX DEF *+1 DEF *+1 JSB ERROR DEF *+3 BSER1 NOP (ADDRESS OF ERROR NUMBER) DEF SCHED (ADDRESS OF STRING "SCHED") JSB $LIBR NOP JMP BSERR,I RETURN * SKP ***** * ** SSETP ** MAKE TRAP TABLE ENTRY WITH GIVEN SEQ NBR AND PRIORITY * * JSB SSETP * DEF *+3 * DEF SEQUENCE NUMBER * DEF PRIORITY * RETURN * ***** * SETPA NOP SETPB NOP SSETP NOP JSB .ENTR RETRIEVE DEF SETPA PARAMETERS JSB $LIBR NOP LDA SETPA,I STA SEQNO SEQUENCE NUMBER LDB SETPB,I STB PRINO PRIORITY CLA ZERO IS DEFAULT VALUE FOR STA TRPNO TRAP NUMBER OF ENTRY LDA SEQNO GET SEQ NBR JSB FINDS LOOK FOR ENTRY WITH THAT SEQ NBR JMP SETP2 NONE FOUND, MAKE NEW ENTRY LDB TRPTR FOUND, LDA 1,I SAVE ENTIRE FIRST WORD STA SEQNO SINCE TRAP BIT MAN BE SET INB LDA 1,I GET SECOND WORD OF ENTRY, AND TRMSK EXTRACT TRAP NBR STA TRPNO AND SAVE FOR MAKING NEW ENTRY JSB TRDEL THEN REMOVE THIS ENTRY SETP2 JSB TRMAK MAKE NEW ENTRY JMP SETPE NO ROOM JMP SETP3 RETURN SETPE LDA AD2 TRAP TABLE FULL JSB BSERR SETP3 JSB $LIBX DEF SSETP * * SKP ****** * ** TTYS ALLOWS THE USER TO SCHEDULE A TASK (GOSUB) WITH A ** TRAP BY TYPING ANY KEY ON AN AUXILLIARY TELETYPVE. * * * JSB TTYS * DEF *+3 * DEF * DEF * RETURN * * * NOTE: IF LOGICAL UNIT # IS LESS THAN 7 THEN AN ERROR * MESSAGE 'ERROR TTYS-1' IS PRINTED. * UNIT NOP TRAPN NOP TTYS NOP JSB .ENTR DEF UNIT LDA UNIT,I GET UNIT# AND GIVE ERROR IF LESS ADA M7 THAN 7 SSA JMP ERR ERROR LDA UNIT,I GET LU# IOR B2000 MASK IN CONTROL CODE STA SNPAR JSB EXEC ENABLE DEF *+3 AUXILLIARY DEF .3 TERMINAL DEF SNPAR LDA TRAPN,I GET TRAP # JSB $LIBR BREAK FENCE NOP STA TRAP# STORE TRAP NUMBER JSB $LIBX SEW UP THE FENCE DEF TTYS * ERR JSB ERROR ERROR RETURN DEF *+3 DEF .1 DEF ERRM JMP TTYS,I SKP * ***** * ** ENABLE ** ENABLE TRAP TABLE ENTRY ASSOC. WITH GIVEN SEQ NBR * * JSB ENABL * DEF *+2 * DEF SEQUENCE NBR * RETURN * * NOTE: ATTEMPT TO ENABLE NON-EXISTENT TRAP TABLE ENTRY * RESULTS IN TRANSFER TO ERROR ROUTINE. * IF SEQ NBR IS ZERO, ALL ENTRIES ARE ENABLED ***** * ENABA NOP ENABL NOP JSB .ENTR DEF ENABA JSB $LIBR NOP LDA ENABA,I RETRIEVE SEQUENCE NUMBER SZA,RSS ZERO MEANS ENABLE ALL ENTRIES JMP ENAB1 JSB FINDS LOOK FOR IT IN TRAP TABLE JMP ENABE NOT FOUND LDB TRPTR FOUND INB LDA 1,I GET SECOND WORD OF ENTRY IOR BIT15 SET ENABLE BIT STA 1,I JMP ENAB4 RETURN ENABE LDA AD4 JSB BSERR JMP ENAB3 RETURN ENAB1 LDB TRTBL ENAB2 CPB TRNXT END OF TABLE JMP ENAB4 YES, RETURN INB LDA 1,I GET SECOND WORD OF ENTRY IOR BIT15 SET ENABLE BIT STA 1,I INB GO TO NEXT ENTRY  JMP ENAB2 LOOP ENAB4 STB TRFLG ENABLE TRAP TABLE SEARCH ENAB3 JSB $LIBX DEF ENABL SKP ***** * ** DSABL ** DISABLE TRAP TABLE ENTRY ASSOC WITH GIVEN SEQ NBR * * JSB DSABL * DEF *+2 * DEF SEQUENCE NUMBER * RETURN * * NOTE: SEQ NBR=0 MEANS DISABLE ALL ENTRIES * SEQ NBR POSITIVE MEANS DISABLE ASSOC ENTRY * SEQ NBR NEGATIVE MEANS DELETE ASSOC. ENTRY FROM TABLE * * NOTE: ENTRY NOT FOUND CAUSES TRANSFER TO ERROR ROUTINE * ***** DSABA NOP DSABL NOP JSB .ENTR DEF DSABA JSB $LIBR NOP LDA DSABA,I SZA,RSS ZERO MEANS ENABLE ALL ENTRIES JMP DSAB1 SSA NEG MEANS DELETE ENTRY JMP DSAB2 JSB FINDS LOOK FOR ENTRY IN TRAP TABLE JMP DSABE NOT FOUND LDB TRPTR FOUND INB LDA 1,I GET SECOND WORD OF ENTRY ELA,CLE,ERA CLEAR ENABLE BIT STA 1,I JMP DSAB4 RETURN DSABE LDA AD4 JSB BSERR DSAB4 JSB $LIBX DEF DSABL * ** HERE TO DISABLE WHOLE TABLE * DSAB1 CLA DONT NEED TO SEARCH TRAP TABLE STA TRFLG UNTIL SOMETHING HAPPENS LDB TRTBL DSAB3 CPB TRNXT END OF TABLE? JMP DSAB4 YES INB LDA 1,I GET SECOND WORD OF ENTRY ELA,CLE,ERA CLEAR ENABLE BIT STA 1,I INB ADVANCE TO NEXT ENTRY JMP DSAB3 LOOP * ** HERE TO DELETE ENTRY * DSAB2 CMA,INA MAKE SEQ NBR POSITIVE JSB FINDS LOOK FOR ASSOC ENTRY JMP DSABE NOT FOUND JSB TRDEL DELETE ENTRY JMP DSAB4 RETURN * * CONSTANTS * .1 DEC 1 .2 DEC 2 .3 DEC 3 .4 DEC 4 .6 DEC 6 M1 DEC -1 M3 DEC -3 M5 DEC -5 M7 DEC -7 M256 DEC -256 MNEG OCT 100000 MAXIMUM NEG FLOATING OCT 376 POINT NUMBER BIT15 EQU MNEG SKP ***** * ** TRNON ** ROUTINE TO START TASK AT GIVEN TIME * * JSB TRNON * DEF *+3 * DEF SEQUENCE NUMBER * DEF TIME TO START (FLOATING POINT VALUE HHMMSS) * RETURN * * NOTE: IF THE TIME SCHEDULING TABLE IS FULL, CONTROL * WILL BE TRANSFERRED TO ERROR * ***** * TRNOB NOP TRNOA NOP TRNON NOP JSB .ENTR DEF TRNOB DLD TRNOA,I JSB CNVRT GET TIME IN FLOAT PT SECONDS DST TMPAR THEN SET UP FOR PROCESSING LDA TRNOB,I GET SEQ NBR TO PASS TO BSCED JSB BSCED SET UP TRAP & TIME SCHED TABLES JMP TRNON,I THEN RETURN * SKP ***** * ** SSTRT ** ROUTINE TO START TASK AFTER GIVEN DELAY * * JSB SSTRT * JSB SSTRT * DEF *+3 * DEF SEQUENCE NUMBER * DEF DELAY (FLOAT POINT SECONDS) * RETURN * ***** * SSTRB NOP SSTRA NOP SSTRT NOP JSB .ENTR DEF SSTRB JSB TIME GET CURRENT TIME DEF *+2 DEF TMPAR FAD SSTRA,I THEN ADD DELAY DST TMPAR TO SET UP AS TIME OF DAY CALL FSB FLDAY IF GREATER THAN 2400 HOURS, SSA SUBTRACT ONE DAY JMP SSTR1 DST TMPAR SSTR1 LDA SSTRB,I JSB BSCED SET UP TRAP & TIME SCHED TABLES JMP SSTRT,I * SKP ***** * ** BSCED ** ROUTINE TO SET UP TRAP & TIME SCHED TABLES * FOR TRNON AND START ROUTINES * * DLD TIME IN FLOATING POINT SECONDS * DST TMPAR IS PASSED IN TMPAR * LDA SEQ NUMBER * JSB BSCED * RETURN * * NOTE: TABLE OVERFLOWS WILL CAUSE TRANSFER TO ERROR * ***** * BSCED NOP JSB $LIBR NOP STA SNPAR SAVE SEQ NUMBER LDB TSNXT IS TABLE CPB TSEND ALREADY FULL ? JMP TRNOE YES STB TSPTR NO, INITIALIZE POINTER JMP NEXT1 * ** HERE TO EXAMINE NEXT ENTRY * NEXT LDB TSPTR ADB M1 MOVE LDA 1,I LAST ADB B3 WORD STA 1,I OF ENTRY ADB M5 THEN MOVE DLD 1,I 4 FIRST TWO WORDS DST TSPTR,I OF ENTRY LDB TSPTR MOVE POINTER ADB M3 TO NEXT ENTRY STB TSPTR NEXT1 CPB TSTBL ARE WE AT OTHER END OF TABLE? JMP INSRT YES, MAKE ENTRY HERE ADB M3 NO, SET UP POINTER STB ENPTR TO NEXT ENTRY TO BE CONSIDERED * ** HERE TO TEST FOR TIME ORDERING * DLD TMPAR COMPARE GIVEN TIME FSB TSTIM TO CURRENT TIME SSA JMP ORDR1 GIVEN TIME < CURRENT TIME DLD ENPTR,I GIVEN TIME > OR = CURRENT TIME FSB TSTIM SSA JMP INSRT ENTRY TIME < CURRENT TIME ORDR2 DLD TMPAR ENTRY TIME > CURRENT TIME FSB ENPTR,I SSA JMP INSRT GIVEN TIME < ENTRY TIME JMP NEXT GIVEN TIME > OR = ENTRY TIME ORDR1 DLD ENPTR,I FSB TSTIM SSA JMP ORDR2 ENTRY TIME < CURRENT TIME JMP NEXT GIVEN TIME > CURRENT TIME * ** HERE TO INSERT NEW ENTRY AT TSPTR * INSRT DLD TMPAR SET UP DST TSPTR,I TIME PART OF ENTRY LDB TSPTR ADB B2 SET UP LDA SNPAR SEQUENCE NUMBER STA 1,I PART OF ENTRY LDA TSNXT UPDATE STA 1 TSNXT POINTER ADA B3 STA TSNXT CPB TSPTR CHECK IF NEW ENTRY NEXT TO EXEC RSS YES JMP INSR1 NOS MAKE TRAP ENTRY NOW * ** HERE IF NEW ENTRY WILL EXECUTE NEXT * DLD TSTIM GET NEW FSB TSPTR,I MINUS TIME TILL NEXT EXECUTION SZA,RSS IF TO GO NOW, JMP INSR3 ALLOW TSCNT TO BE ZERO SSA IF POSITIVE JMP INSR3 FSB FLDAY SUBTRACT ONE DAY INSR3 DST TSCNT THEN SET UP COUNTER WITH NEW VAL * ** HERE TO MAKE TRAP TABLE ENTRY * INSR1 LDA SNPAR JSB FINDS DOES A TRAP ENTRY ALREADY EXIST JMP INSR2 NO, MAKE ONE LDB TRPTR YES, SET ENABLE BIT INB LDA 1,I IOR BIT15 STA 1,I JMP *($BSCE1 RETURN INSR2 LDA SNPAR SET UP STA SEQNO SEQUENCE NUMBER CLA STA TRPNO TRAP NUMBER (DEFAULT = 0) LDA D99 STA PRINO PRIORITY (DEFAULT = 99) JSB TRMAK MAKE TRAP TABLE ENTRY RSS NO ROOM JMP BSCE1 DONE, RETURN LDA AD2 JSB BSERR JMP BSCE1 TRNOE LDA AD5 TIME SCHED TABLE FULL JSB BSERR BSCE1 JSB $LIBX DEF BSCED SKP **************************************************** * **************** CONSTANTS ************************* SCHED DEC 5 ASC 3,SCHED ERRM DEC 3 ASC 2,TTY ENPTR NOP POINTER TO NEXT ENTRY (IN TIMCK) SNPAR NOP FLDAY DEC 86400. FLOATIN POINT # SEC IN DAY F.100 DEC 100. F.60 DEC 60. TMPAR BSS 2 WHOLE BSS 2 HHMM BSS 2 HH BSS 2 MM BSS 2 SS BSS 2 B2 EQU .2 B3 EQU .3 B2000 OCT 2000 .5 DEC 5 D99 DEC 99 AD2 DEF .2 AD4 DEF .4 AD5 DEF .5 **************************************************** END `6* M Y 92101-18014 1805 S C0122 BASIC-HP7970 MAG TAPE DEVICE SUBROUTINES             H0101 ASMB,R,L,C,F HED BASIC 7970 DEVICE SUBROUTINE 92101-19014 REV. 1805 NAM MTTDR,7 92101-16014 REV. 1805 771220 * * * * ENT MTTRD,MTTRT,MTTPT,MTTFS * * ***************************************************** * * RELOC. TAPE: 92101-16014 * LISTING: 92101-19014 * SOURCE TAPE: 92101-18014 * ******************************************************* * * * *****EXTERNAL SYMBOLS***** * * **UTILITY ROUTINES** * EXT .ENTR,ERROR,EXEC,.STOP * * * * * * * * SUP PRESS LISTING SKP * * **ENTRY FORMATS AND FUNCTIONS** * * MTTRD(IUNIT,FPVAR,NI,IEOF,NT) * MTTRT(IUNIT,FPVAR,NI,IEOF,NT) * IUNIT=MAG TAPE LOGICAL UNIT NUMBER * FPVAR=FIRST VARIABLE OF ARRAY ELEMENT * TO BE TRANSFERRED TO/FROM CORE * NI=NO. OF VARIABLES TO BE TRANSFERRED * IEOF=END OF FILE FLAG RETURNED BY DRIVER * 0=NO END OF FILE * 1=END OF FILE * NT=ACTUAL NO. OF VARIABLES TRANSFERRED * * MTTPT(IUNIT,IF,IR) * IF=FILE SPACING PARAMETERS * +IF=FORWARD IF FILES * -IF=BACKWARD IF FILES * IR=RECORD SPACING PARAMETER * +IR=FORWARD IR RECORDS * -IR=BACKWARD IR RECORDS * * MTTFS(IUNIT,FUNC) * FUNC=TAPE FUNCTION * 0=GAP * 1=END OF FILE AND GAP * 2=REWIND * 3=REWIND/STANDBY * * FPVAR IS A FLOATING POINT PARAMETER, ALL OTHER * PARAMETERS ARE INTEGER. CONVERSION WORDS MUST * BE INCLUDED IN BRANCH TABLE * HED READ AND WRITE FUNCTIONS A-92101-16014-1 REV. A * MTTRT NOP WRITE ENTRY LDB .2 SET ENTRY FLAG STB STAT SAVE TEMPORARILY LDB MTTR~T STB MTTRD JMP MTTRD+1 JUMP TO PSEUDO ENTRY SPC 2 UNIT BSS 1 VAR BSS 1 NI BSS 1 EOF BSS 1 NT BSS 1 * MTTRD NOP READ ENTRY JSB .ENTR DEF UNIT LDB STAT GET ENTRY FLAG CPB .2 WRITE? RSS YES. CLB,INB NO,READ STB CMDC SET COMMAND CODE * LDA UNIT,I IOR COMWD STA CONWD LDB CMDC WRITE? SLB JMP MT1 JSB STAT READ STATUS AND .4 YES! SZA WRITE RING? JMP REJ NO! MT1 STA STAT CLEAR ENTRY FLAG LDA NI,I CONVERT NO. OF VARIABLES STA NT,I ALS TO STA NII WORDS LDB VAR STB VARA SET UP READ/WRITE ADDRESS ADB NII ADB M2 STB BFLAG DLD BFLAG,I LOAD LAST VARIABLE DST BFLAG,I ATTEMPT TO RESTORE CLB STB EOF,I ZERO EOF FLAG JSB EXEC MAG TAPE REQUEST DEF *+5 DEF CMDC DEF CONWD VARA DEF * DEF NII STA STAT1 SAVE STATUS BRS CONVERT WORDS TO NO. OF SSB CMB,INB VARIABLES TRANSFERED LDA CMDC IS THIS AREAD OR A WRITE? SLA,RSS JMP MTTRD,I WRITE! SO RETURN STB NT,I SAVE NO. OF VARIABLES TRNSFD LDA STAT1 GET STATUS AND B200 SZA EOF ENCOUNTERED ON A READ? JMP EOFT YES! JMP MTTRD,I RETURN * * EOFT CLA,INA TURN ON EOF FLAG STA EOF,I JMP MTTRD,I RETURN SKP HED POSITION CONTROL A-92101-16014-1 REV. A SPC 2 UNITP NOP FPOS NOP RPOS NOP SPC 1 MTTPT NOP JSB .ENTR DEF UNITP LDB FPOS,I FILE POSITION COUNT SZB,RSS IF ZERO GOTO RECORD SKIP JMP RC1 SSB FORWARD OR BACK? JMP BACKF BACK! CMB,INB LDA B1300 FORWARDSPACE FILE FILE JSB SKIP SKIP FILE RC1 LDB RPOS,I RECORD POSITION COUNT SZB,RSS IF ZERO RETURN JMP MTTPT,I SSB FORWARD OR BACK? JMP BACKR BACK! CMB,INB LDA B300 FORWARD RECORD RCRD JSB SKIP SKIP RECORDS JMP MTTPT,I RETURN * BACKF LDA B1400 BACKFILE STA BFLAG SET BACK MOTION FLAG JMP FILE * BACKR LDA B200 BACK RECORD STA BFLAG SET BACK MOTION FLAG JMP RCRD * SPC 2 * * SKIP RECORD OR FILE * * ON ENTRY A=CONWD, B=COUNT * SKIP NOP IOR UNITP,I STUFF IN LOG UNIT STA CONWD STB COUNT SKIP1 JSB EXEC SKIP A RECORD OR A FILE DEF *+3 DEF .3 DEF CONWD ISZ COUNT DECREMENT COUNT AND SKIP IF DONE JMP SKIP1 NOT DONE YET! CLA STA BFLAG CLEAR BACK MOTION FLAG JMP SKIP,I RETURN SKP BEOT1 LDA .2 ILLEGAL REQUEST ERROR JMP ERR * REJ LDA .3 NO WRITE RING ERROR JMP ERR SPC 5 * * READ STATUS OF UNIT * STAT NOP LDA UNIT,I CREATE CONTROL IOR =B600 CODE FOR STA CNTRL GETTING DYNAMIC STATUS JSB EXEC DEF *+3 DEF .3 DEF CNTRL JMP STAT,I * CNTRL BSS 1 SKP HED ERROR MESSAGE PROCESSOR A-92101-16014-1 REV. A SPC 3 * * ERROR MESSAGE PROCESSOR * * ON ENTRY A = 1 NO LOGICAL UNIT FOUND * 2 ILLEGAL TAPE MOTION REQUEST * 3 NO WRITE RING * * ERROR MESSAGE IS OF THE FORMAT: * * ERROR MAGTP-X IN LINE NN * * WHERE X IS DESCRIBED ABOVE * NN IS THE LINE NO. WHERE THE ERROR OCCURRED * * ERR STA CODE JSB ERROR OUTPUT ERROR MESSAGE DEF *+3 DEF CODE DEF MGTPA JSB .STOP TERMINATE EXECUTION OF PROGRAM * * SKP HED CONTROL FUNCTIONS A-92101-16014-1 REV. A UNITF NOP FUNC NOP SPC 1 MTTFS NOP JSB .ENTR TRANSFER ARG ADDR DEF UNITF LDA FUNC,I FUNCTION CODE ADA M4 SSA,RSS JMP BEOT1 BAD REQUES! LDA FUNC,I ADA FUNCA ADD IN ADDRESS OF FUNCTION LIST LDA 0,I GET FUNCTION CODE FOR EXEC IOR UNITF,I OR IN LU # STA CONWD PUT IN EXEC REQUEST JSB EXEC PERFORM FUNCTION DEF *+3 DEF .3 DEF CONWD JMP MTTFS,I RETURN * HED CONSTANTS AND STORAGE A-92101-16014-1 REV. A CMDC OCT 0 COMMAND CODE NII OCT 0 NO. OF WORDS IN TRANSFER CONWD OCT 0 EXEC CONTROL WORD B1300 OCT 1300 B300 OCT 300 COUNT OCT 0 FILE/RECORD COUNTER STAT1 OCT 0 STATUS WORD FUNCA DEF *+1 ADDRESS OF FUNCTION CNTRL WORDS OCT 1200 COMWD OCT 100 READ/WRITE CONTROL WORD OCT 400 OCT 500 MGTPA DEC 5 MAG TAPE MESSAGE ASC 3,MAGTP CODE OCT 0 ERROR CODE NO. BFLAG OCT 0 BACK MOTION FLAG B1400 OCT 1400 .2 DEC 2 .3 DEC 3 .4 DEC 4 M2 DEC -2 M4 DEC -4 B200 OCT 200 END  NW 92101-18015 1614 S C0122 DCODE SUBROUTINE              H0101 z5ASMB,R,L,C NAM DCODE,7 92101-16015 REV.1614, 760330 ENT DCODE EXT .DIO.,.IOR.,.DTA.,.ENTR * *********************************************** * * CONVERT BINARY TO ASCII (FORMATTED) * * XXXX CALL DCODE(V,A$,B$) * WHERE: V =VALUE TO CONVERT * A$=RESULTING STRING * B$=FORMAT STRING * * CONVERT ASCII TO BINARY (FORMATTED) * * XXXX CALL DCODE(A$,V,B$) * WHERE: A$=STRING TO CONVERT * V= RESULTING VALUE * B$=FORMAT STRING * * SOURCE: 92101-18015 * RELOC: 92101-16015 * *********************************************** SUP * P1 DEF * STRING OR VARIABLE P2 DEF * VARIABLE OR STRING P3 DEF * FORMAT STRING * DCODE NOP JSB .ENTR FETCH PARMS DEF P1 LDA P1,I DETERMINE CONV.DIRECTION CLB,INB SZA,RSS 0? CLB YES. RAL,SLA NEG.#? CLB YES. SSA NORMALIZED? CLB YES. STB TYPE LDA P1 SZB,RSS POST ADDR LDA P2 OF STRING INA BUFFER STA QF1 LDA P3,I CHECK FORMAT STMT SZA,RSS 0? JMP QF0 YES, FREE FIELD LDA P3 NO, POST ADDR INA OF FORMAT QF0 STA QF2 STATEMENT CLA JSB .DIO. INIT CONVERSION QF1 DEF * =DATA BUFR QF2 DEF * =FORMAT STMT DEF QFX =END OF LIST LDB TYPE SZB DIRECTION? JMP QF3 * DLD P1,I *DO BINARY TO ASCII JSB .IOR. JSB .DTA. JMP QFX * QF3 JSB .IOR. *DO ASCII TO BINARY DST P2,I QFX JMP DCODE,I & LEAVE * * TYPE BSS 1 * SIZE EQU * END gC   OV 92101-18016 1614 S C0122 NUM FUNCTION              H0101 .FTN,L INTEGER FUNCTION NUM(I) C C RELOC: 92101-16016 C SOURCE: 92101-18016 C (REV. 1614, 760329) C C THIS FUNCTION RETURNS THE NUMERIC VALUE OF THE FIRST CHARACTER C OF THE STRING EXPRESSION ACCORDING TO THE STANDARD CHARACTER CODE C C FOR EXAMPLE: C C 10 PRINT NUM("A") C 20 END C C >RUN C C 65 C C C THE REQUIRED BRANCH & MNEMONIC TABLE GENERATOR ENTRY IS AS FOLLOWS: C C NUM(R), OV=NN, INTG, ENT=NUM, FIL=XX C C WHERE: NN=OVERLAY NUMBER C XX=ASSOCIATED FILE NAME (IF APPLICABLE) C C OPERATION IS AS FOLLOWS: C C RIGHT JUSTIFY CHARACTER BY DIVIDING. C THE RIGHT HALF OF THE 1ST WORD OF THE STRING CONTAINS THE CHAR C COUNT AND MUST NOT BE DISTURBED. C DIMENSION I(2) NUM=I(2)/256 RETURN END END$ r PV 92101-18017 1614 S C0122 CHRS SUBROUTINE              H0101 ]EFTN,L SUBROUTINE CHRS(I,J) C C RELOC: 92101-16017 C SOURCE: 92101-18017 C (REV. 1614, 760329) C C THIS SUBROUTINE CAUSES THE NUMERIC VALUE OF THE FIRST PARAMETER C TO REPLACE THE FIRST CHARACTER OF THE STRING VARIABLE DEFINED C IN THE SECOND PARAMETER. C C FOR EXAMPLE: C C 10 DIM A$(10) C 20 A$="YBCDE" C 30 CHRS(65,A$) C 40 PRINT A$ C 50 END C C >RUN C C ABCDE C C THE REQUIRED BRANCH & MNEMONIC TABLE GENERATOR ENTRY IS AS FOLLOWS: C C CHRS(I,RV), OV=NN, ENT=CHRS, FIL=XX C C WHERE: NN=OVERALY NUMBER C XX=ASSOCIATED FILE NAME (IF APPLICABLE) C C OPERATION IS AS FOLLOWS: C C PLACE CHAR IN 1ST CHAR POSITION OF STRING 'J'. C THE RIGHT HALF OF THE 1ST WORD OF THE STRING CONTAINS THE CHAR C COUNT AND MUST NOT BE DISTURBED. C DIMENSION J(2) J(2)=IAND(J(2),377B) J(2)=IOR(I*256,J(2)) RETURN END END$ %g QW 92101-18018 1644 S 0122 &ERRO ERROR PROC             H0101 NASMB,R,L,C HED <> 92101-19018 REV.1644 NAM ERRSB,7 92101-16018 REV.1644 * * * * ************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * * PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ************************************************************** * * * * LISTING: 92101-19018 * RELOC: 92101-16018 * SOURCE: 92101-18018 * * * ********************************************************************* * * * * RTE-BASIC ERROR ROUTINE FOR CALSB * ENT ERROR,LUERR,ERRCD,.LNUM EXT REIO,.ENTR * * * * CALLING SEQUENCE: * * JSB ERROR * DEF *+3 * DEF NUMBR DECIMAL NUMBER * DEF STRING ERROR MNEMONIC * : * : * THE ERROR MESSAGE IS OF THE FORMAT: * * ERROR XXXXXX-KK IN LINE NNNN * * * WHERE: XXXXXX IS THE MNEMONIC STRING * KK IS THE ERROR NUMBER * NNNN IS THE CURRENT BASIC LINE NUMBER * * NUMB NOP MESS NOP ERROR NOP JSB .ENTR DEF NUMB * LDA MESS,I GET NUMBER CMA,INA OF CHARACTERS STA RERR AND SAVE ISZ MESS LDA LUERR SET HONESTY IOR B2000 MODE STA LUERR LDA EBUFA PRINT LDB M9 'ERROR' JSB WRITE LDA MESS LDB RERR PRINT JSB WRITE ERROR MNEMONIC LDA DASH PRINT JSB OUTCR '-' LDA NUMB,I PRINT STA ERRCD AND SAVE JSB OUTIN ERROR NUMBER LDA LBUFA PRINT LDB M9 'IN LINE' JSB WRITE LDA .LNUM PRINT JSB OUTIN LINE NUMBER LDA EBUFA CRo-LF LDB M3 JSB WRITE JMP ERROR,I SKP *********************** * * * OUTPUT AN INTEGER * * * *********************** * OUTIN NOP INTEGER IN (A) LDB M3 SET DIGIT STB PCNT COUNTER LDB LDVSR SET DIVISOR STB TEMP4 ADDRESS CLB SUPPRESS STB TEMP2 LEADING ZEROES OUTI1 DIV TEMP4,I DIVIDE INTEGER STB TEMP1 CURRENT DIVISOR CPA TEMP2 LEADING ZERO? JMP OUTI2 YES! ADA .48 NO, TURN OFF STA TEMP2 ZERO SUPPRESION JSB OUTCR OUTPUT DIGIT OUTI2 CLB LDA TEMP1 RETRIEVE REMAINDER ISZ TEMP4 SET FOR NEXT DIVISOR ISZ PCNT ALL DIVISOR USED? JMP OUTI1 NO! ADA .48 YES, OUTPUT JSB OUTCR LAST DIGIT JMP OUTIN,I * * * OUTPUT ONE CHARACTER * OUTCR NOP ALF,ALF LEFT JUSTIFY CHARACTER STA ABREG LDA DMMYA LDB M1 JSB WRITE JMP OUTCR,I * * OUTPUT A LINE * WRITE NOP STA BUFR STB TEMP JSB REIO WRITE DEF *+5 DEF .2 OUT DEF LUERR BUFR NOP LINE DEF TEMP JMP WRITE,I SKP * WORKING STORAGE AND CONSTANTS * * PCNT BSS 1 TEMP BSS 1 TEMP1 BSS 1 TEMP4 BSS 1 RERR BSS 1 ABREG BSS 2 TEMP2 EQU ABREG ERRCD NOP ERROR CODE VALUE INITIALLY 0 LUERR DEC 1 ERROR LUN, DEFAULT LU 1 .LNUM NOP LINE NUMBER OF ERROR SPC 2 B2000 OCT 2000 .2 DEC 2 .48 DEC 48 LDVSR DEF *+1 DEC 1000 DEC 100 DEC 10 M1 DEC -1 M3 DEC -3 M9 DEC -9 SPC 2 DMMYA DEF ABREG EBUFA DEF *+1 OCT 6412 OCT 3505 'BELL',E ASC 3,RROR LBUFA DEF *+1 ASC 5, IN LINE DASH OCT 55 END   RZ 92101-18019 1650 S 0322 %BAIMG IMAGE INTERFACE             H0103 dASMB,R,L,C HED <> NAM IMAG,7 92101-16019 REV.1650 * * * ************************************************************ * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * REPRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE * * WITHOUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD * * COMPANY. * ************************************************************ * * * ************************************************************ * BASIC-IMAGE INTERFACE LIBRARY * ************************************************************ * ENT DMOPN,DMINF,DMFND,DMGET,DMUPD,DMPUT,DMDEL,DMCLS ENT DMLCK,DMUNL * EXT .ENTR,DBOPN,DBINF,DBFND,DBGET,DBUPD,DBPUT EXT DBDEL,DBCLS,DBLCK,DBUNL,RSFLG,RFLAG,FWPWA EXT CLOSE,AIRUN,AIDCB,ISIZE,OPEN,LOCF,FWAFS,LWAFS EXT CITA,CATI,IFIX,FLOAT,.MVW * * * * CALLING SEQUENCE: * CALL DBOPN(ISTAT,IBASE,ILEVL,ISCOD,IMODE) * * * ENTRY IN BASIC SUBROUTINE TABLE: * DBOPN(IVA,RA,RA,I,I), OV=NN, ENT=DMOPN, FIL=IMAGR * * WHERE NN IS THE OVERLAY NUMBER * * ISTAT NOP IBASE NOP ILEVL NOP ISCOD NOP IMODE NOP DMOPN NOP ENTRY JSB .ENTR FETCH PARAMETERS DEF ISTAT JSB ASCI CONVERT STRING TO ASCII DEF IBASE PASS ADDRESS OF STRING JSB PAD PAD DATA BASE NAME TO 6 CHARACTERS DEF *+3 DEF IBASE DEF NAME1 * CLA INITIALIZATION STA ISTAT,I LDA ISCOD,I CMA,INA STA SC MAKE SECURITY CODE NEGATIVE JSB OPEN OPEN DATA BASE ROOT FILE DEF *+6 TO DETERMINE SIZE DEF DCB DEF IERR DEF NAME1 DEF .1 DEF SC *  LDA IERR CPA M7 ILLEGAL SECURITY CODE? JMP E117 YES CPA M8 JMP E129 LOCKED OR OPEN ERROR SSA ERROR? JMP EFMR YES * JSB LOCF GET FILE LENGTH DEF *+7 DEF DCB DEF IERR DEF TMP DEF TMP DEF TMP DEF LENTH * JSB CLOSE CLOSE DEF *+2 DEF DCB * LDA LENTH MPY .64 COMPUTE LENGTH STA LENTH IN WORDS LDA FWAFS SET UP RUN TABLE ADDRESS STA AIRUN CMA,INA ADA LWAFS COMPUTE SPACE STA LENF CMA,INA ADA LENTH SSA,RSS ENOUGH SPACE FOR RUN TABLE? JMP E128 NO LDA FWAFS COMPUTE ADDRESS FOR DCB'S ADA LENTH STA AIDCB CMA,INA ADA LWAFS STA LENF CMA,INA ENOUGH SPACE FOR 1X272? ADA .272 SSA JMP A272 YES LDA LENF NO ADA M144 ENOUGH SPACE FOR 1X144? SSA JMP E128 NO * LDA M144 YES, USE 1X144 RSS A272 LDA M272 USE 1X272 STA ISIZE CMA,INA ADA AIDCB COMPUTE 1ST WORD AFTER DCB SPACE STA FWPWA SAVE IT LDA .1 SET FLAG TO USE FWPWA AS 1ST WORD STA RFLAG OF FREE SPACE WHILE DATA BASE OPEN * JSB ASCI CONVERT STRING TO ASCII DEF ILEVL PASS ADDRESS OF STRING JSB PAD PAD LEVEL NAME TO 6 CHARACTERS DEF *+3 DEF ILEVL DEF NAME2 * JSB DBOPN CALL IMAGE OPEN ROUTINE DEF *+6 DEF NAME1 DEF NAME2 DEF ISCOD,I DEF IMODE,I DEF ISTAT,I * JSB RSFLG SET SAVE RESOURCES FLAG DEF *+1 JMP DMOPDN,I TERMINATE OPEN CALL * E117 LDA .117 ILLEGAL SECURITY CODE RSS E128 LDA .128 INSUFFICIENT BUFFER SPACE RSS E129 LDA .129 ROOT FILE OPENED OR LOCKED ERROR STA ISTAT,I JMP DMOPN,I EFMR CMA,INA FMGR EXIT JMP ERROR * * * * CALLING SEQUENCE: * CALL DBINF(IMODE,ID,IBUF) * * * ENTRY IN BASIC SUBROUTINE TABLE: * DBINF(I,RA,RVA), OV=NN, ENT=DMINF, FIL=IMAGR * * WHERE NN IS THE OVERLAY NUMBER * * IMOD1 NOP ID NOP IBUF NOP DMINF NOP ENTRY JSB .ENTR FETCH PARAMETERS DEF IMOD1 JSB ASCI CONVERT STRING TO ASCII DEF ID JSB PAD PAD ID TO 6 CHARACTERS DEF *+3 DEF ID DEF NAME1 LDA IMOD1,I SSA TEST IF MODE NEGATIVE JMP E324 YES, ILLEGAL DBINF REQUEST ADA M8 SSA,RSS TEST IF MODE > 7 JMP E324 YES, ILLEGAL DBINF REQUEST ADA TABAD INDEX TO CORRECT CONVERSION ROUTINE JMP A,I TABAD DEF TABA+8 TABA JMP E324 MODE 0 - ILLEGAL DBINF REQUEST JMP I13 MODE 1 - CONVERT TO "I",1 JMP I2 MODE 2 - CONVERT TO "I",2 JMP I13 MODE 3 - CONVERT TO "I",3 JMP S4 MODE 4 - CONVERT TO "S",4 JMP S2 MODE 5 - CONVERT TO "S",2 JMP S6 MODE 6 - CONVERT TO "S",6 JMP R6 MODE 7 - CONVERT TO "R",6 * I2 LDA AI STA ITYP JSB DINUM CONVERT DATA SET NAME TO NUMBER DEF *+3 DEF NAME1 DEF ID,I CPB .103 DATA BASE NOT OPEN? JMP ERR1 SZB TEST FOR ERROR JMP E325 YES, INVALID DATA SET NAME JSB INFO CALL IMAGE INFORMATION ROUTINE LDB BUFFR SZB TEST FOR ERROR IN IN&!FO CALL JMP ERR1 YES JSB PAKCC PACK CONDITION CODE INTO IBUF DEF BUFFR LDA .44 PACK A COMMA JSB PAK LDA BUFFR+4 AND MSKLO GET SEARCH TYPE (HIGH BYTE) ALF,ALF CPA .1 TEST FOR KEY ITEM JMP INF2 YES LDA .78 NON-KEY ITEM (N) RSS INF2 LDA .75 KEY ITEM (K) JSB PAK PACK SEARCH TYPE LDA .44 PACK A COMMA JSB PAK LDA BUFFR+4 AND B377 GET ITEM TYPE (LOW BYTE) JSB PAK PACK ITEM TYPE LDA .44 JSB PAK PACK A COMMA CLA STA TMP2 INITIALIZE READ/WRITE LEVEL FLAG LDA BUFFR+5 AND MSKLO GET READ LEVEL (HIGH BYTE) ALF,ALF LOOP4 STA TMP JSB CITA CONVERT READ OR WRITE LEVEL TO ASCII DEF *+3 DEF TMP LEVEL (INTEGER) DEF BUFF2 ASCII BUFFER LDA OFST2 ADA .2 STA UPBUF SAVE ADDR OF BUFFER TO UNPACK FROM JSB PACKN PACK LEVEL INTO IBUF DEF .2 LDA .44 PACK A COMMA JSB PAK LDA TMP2 TEST WHETHER BOTH READ AND WRITE CPA .1 LEVELS HAVE BEEN PACKED JMP INF3 YES LDA BUFFR+5 NO AND B377 GET WRITE LEVEL (LOW BYTE) ISZ TMP2 SET READ/WRITE LEVEL FLAG JMP LOOP4 PACK WRITE LEVEL * INF3 JSB CITA CONVERT ITEM LENGTH TO ASCII DEF *+3 DEF BUFFR+6 ITEM LENGTH (INTEGER) DEF BUFF2 ASCII BUFFER LDA OFST2 INA IOR SIGN STA UPBUF SAVE ADDR OF BUFFER TO UNPACK FROM JSB PACKN PACK ITEM LENGTH INTO IBUF DEF .3 LDA .44 PACK A COMMA JSB PAK LDA AS STA ITYP JSB DSNAM CONVERT DATA SET5 NUMBER TO NAME DEF BUFFR+8 DATA SET NUMBER LDA OFST2 INA STA UPBUF SAVE ADDR OF BUFFER TO UNPACK FROM JSB PACKN TRANSFER DATA SET NAME TO IBUF DEF .6 LDA .24 STRING CHARACTER COUNT STA IBUF,I STORE IN FIRST WORD OF STRING JMP EXIT1 * I13 LDA AS STA ITYP JSB DINUM CONVERT DATA SET NAME TO NUMBER DEF *+3 DEF NAME1 DEF ID,I CPB .103 DATA BASE NOT OPEN? JMP ERR1 SZB TEST FOR ERROR JMP E325 YES, INVALID DATA SET NAME LDA AI STA ITYP JSB INFO CALL IMAGE INFORMATION ROUTINE LDB BUFFR SZB TEST FOR ERROR JMP ERR1 YES LDA OFSET STA INDX INITIALIZE POINTER TO FIRST ITEM LDA BUFFR+1 SAVE ITEM COUNT - 1 STA B CMB,INB TEST IF COUNT > 35 ADB .35 SSB LDA .35 YES, RETURN MAX. OF 35 ITEM NAMES CMA STA ITEMS JSB PAKCC PACK CONDITION CODE INTO IBUF DEF BUFFR LDA .44 PACK A COMMA JSB PAK ISZ COUNT INCREMENT STRING CHARACTER COUNT JSB CITA CONVERT ITEM COUNT TO ASCII (3) DEF *+3 DEF BUFFR+1 ITEM COUNT (INTEGER) DEF BUFF2 ASCII BUFFER LDA OFST2 INA IOR SIGN STA UPBUF SAVE ADDR OF BUFFER TO UNPACK FROM JSB PACKN TRANSFER ITEM COUNT (ASCII) DEF .3 TO USER BUFFER LDA COUNT ADA .3 ADD 3 TO STRING CHARACTER COUNT STA COUNT JSB PAKIT PACK LIST OF ITEM NAMES LDA COUNT STRING CHARACTER COUNT STA IBUF,I JMP EXIT1 S2 LDA AS STA ITYP JSB DINUM CONVERT DATA SET NAME TO NUMBER /DEF *+3 DEF NAME1 DEF ID,I CPB .103 DATA BASE NOT OPEN? JMP ERR1 SZB TEST FOR ERROR JMP E325 YES, INVALID DATA SET NAME LDA .2 STA IMOD1,I JSB INFO CALL IMAGE INFORMATION ROUTINE LDB BUFFR SZB TEST FOR ERROR JMP ERR1 YES JSB PAKCC PACK CONDITION CODE INTO USER BUFFER DEF BUFFR LDA .44 PACK A COMMA JSB PAK LDA BUFFR+4 PACK DATA SET TYPE AND B377 STA BUFF4 SAVE DATA SET TYPE JSB PAK LDA .44 PACK A COMMA JSB PAK * JSB CITA CONVERT CAPACITY TO ASCII (5) DEF *+3 DEF BUFFR+5 CAPACITY (INTEGER) DEF BUFF2 ASCII BUFFER LDA OFST2 IOR SIGN STA UPBUF SAVE ADDR OF BUFFER TO UNPACK FROM JSB PACKN TRANSFER CAPACITY (ASCII) TO DEF .5 USER BUFFER * LDA .44 PACK A COMMA JSB PAK LDA BUFFR+6 STA TMP SAVE ENTRY LENGTH LDA AI STA ITYP INFO CALL TYPE=I LDA .3 STA IMOD1,I INFO CALL MODE=3 JSB INFO GET KEY ITEM NUMBERS LDB BUFFR SZB TEST FOR ERROR JMP E324 YES LDA BUFF4 GET DATA SET TYPE CPA B104 TEST IF DATA SET IS DETAIL JMP DETAI YES LDA AS NO, DATA SET IS A MASTER STA ITYP LDA .4 STA IMOD1,I INFO CALL MODE=4 LDA BUFFR+2 ITEM NUMBER OF KEY ITEM IN MASTER STA ID,I JSB INFO GET LINKED DATA SETS LDB BUFFR SZB TEST FOR ERROR JMP E324 YES LDA BUFFR+1 COUNT OF LINKED DATA SETS MPY .3 CALCULATE MEDIA RECORD LENGTH ADA .3 (3+(3* PATH COUNT)) CMA,INA LDB TMP ENTRY LENGTH (MEDIA + RECORD) ADB A SUBTRACT MEDIA TO GET RECORD LENGTH STB TMP JMP ENTLN CONVERT ACTUAL ENTRY LENGTH TO ASCII * DETAI LDA BUFFR+1 COUNT OF KEY DATA ITEMS ALS CALCULATE MEDIA RECORD LENGTH INA (1+(2*PATH COUNT)) CMA,INA LDB TMP ENTRY LENGTH (MEDIA + RECORD) ADB A SUBTRACT MEDIA TO GET RECORD LENGTH STB TMP * ENTLN JSB CITA CONVERT ENTRY LENGTH TO ASCII (3) DEF *+3 DEF TMP ENTRY LENGTH (INTEGER) DEF BUFF2 ASCII BUFFER LDA OFST2 INA IOR SIGN STA UPBUF SAVE ADDR OF BUFFER TO UNPACK FROM JSB PACKN TRANSFER ENTRY LENGTH (ASCII) DEF .3 TO USER BUFFER LDA .15 STRING CHARACTER COUNT STA IBUF,I SAVE IN FIRST WORD OF USER BUFFER JMP EXIT1 S4 LDA AI STA ITYP JSB DINUM CONVERT DATA ITEM NAME TO NUMBER DEF *+3 DEF NAME1 DEF ID,I CPB .103 DATA BASE NOT OPEN? JMP ERR1 SZB TEST FOR ERROR JMP E325 YES, INVALID DATA ITEM NAME LDA AS STA ITYP JSB INFO CALL IMAGE INFORMATION ROUTINE LDB BUFFR SZB TEST FOR ERROR JMP ERR1 YES * LDA OFSET STA INDX POINTER TO FIRST NAME IN BUFFER LDA BUFFR+1 DATA SET-DATA ITEM COUNT ALS DOUBLE COUNT TO = SETS+ITEMS CMA SAVE COUNT - 1 STA ITEMS JSB PAKCC PACK CONDITION CODE INTO IBUF DEF BUFFR LDA .44 PACK A COMMA JSB PAK ISZ COUNT INCREMENT STRING CHARACTER COUNT JSB CITA CONVERT PAIR COUNT TO ASCII (3) DEF *+3  DEF BUFFR+1 PAIR COUNT (INTEGER) DEF BUFF2 ASCII BUFFER LDA OFST2 INA IOR SIGN STA UPBUF SAVE ADDR OF BUFFER TO UNPACK FROM JSB PACKN PACK PAIR COUNT INTO IBUF DEF .3 LDA COUNT ADA .3 ADD 3 TO STRING CHARACTER COUNT STA COUNT SAVE COUNT JSB PKIT2 PACK DATA SET AND ITEM NAMES LDA COUNT STRING CHARACTER COUNT STA IBUF,I JMP EXIT1 S6 LDB AS ITYP = "S" STB ITYP JSB DINUM CONVERT DATA SET NAME TO NUMBER DEF *+3 DEF NAME1 DEF ID,I CPB .103 DATA BASE NOT OPEN? JMP ERR1 SZB TEST FOR ERROR JMP E325 YES BLD JSB INFO CALL IMAGE INFORMATION ROUTINE LDB BUFFR SZB TEST FOR ERROR JMP ERR1 YES JSB PAKCC PACK CONDITION CODE INTO IBUF DEF BUFFR LDA .44 PACK A COMMA JSB PAK JSB CITA CONVERT LAST RECD ACCESSED TO ASCII DEF *+3 DEF BUFFR+1 LAST RECORD ACCESSED (INTEGER) DEF BUFF2 BUFFER FOR RETURNED ASCII EQUIVALENT LDA OFST2 IOR SIGN STA UPBUF SAVE ADDR OF BUFFER TO UNPACK FROM JSB PACKN TRANSFER RECORD NUMBER (ASCII) DEF .5 TO USER BUFFER * LDA .44 PACK A COMMA JSB PAK JSB CITA CONVERT PATH LENGTH TO ASCII (5) DEF *+3 DEF BUFFR+2 PATH LENGTH OF CHAIN (INTEGER) DEF BUFF2 BUFFER FOR RETURNED ASCII EQUIVALENT LDA OFST2 IOR SIGN STA UPBUF SAVE ADDR OF BUFFER TO UNPACK FROM JSB PACKN TRANSFER PATH LENGTH (ASCII) DEF .5 TO USER BUFFER * LDA .44 PACK A COMMA JSB PAK JSB CITA CONVERT RECD #6 OF FOOT TO ASCII (5) DEF *+3 DEF BUFFR+3 RECORD NUMBER OF CHAIN FOOT DEF BUFF2 BUFFER FOR RETURNED ASCII EQUIVALENT LDA OFST2 IOR SIGN STA UPBUF SAVE ADDR OF BUFFER TO UNPACK FROM JSB PACKN TRANSFER NEXT RECORD (ASCII) DEF .5 TO USER BUFFER * LDA .44 PACK A COMMA JSB PAK JSB CITA CONVERT NEXT RECORD # TO ASCII (5) DEF *+3 DEF BUFFR+4 NEXT RECORD IN CHAIN (INTEGER) DEF BUFF2 BUFFER FOR RETURNED ASCII EQUIVALENT LDA OFST2 IOR SIGN STA UPBUF SAVE ADDR OF BUFFER TO UNPACK FROM JSB PACKN TRANSFER RECORD NUMBER (ASCII) DEF .5 TO USER BUFFER * LDA .44 PACK A COMMA JSB PAK JSB CITA CONVERT PATH NUMBER TO ASCII (5) DEF *+3 DEF BUFFR+5 PATH NUMBER OF CURRENT CHAIN DEF BUFF2 BUFFER FOR RETURNED ASCII EQUIVALENT LDA OFST2 IOR SIGN STA UPBUF SAVE ADDR OF BUFFER TO UNPACK FROM JSB PACKN TRANSFER PATH NUMBER (ASCII) DEF .5 TO USER BUFFER LDA .33 STRING CHARACTER COUNT STA IBUF,I SAVE IN FIRST WORD OF USER BUFFER JMP EXIT1 * R6 LDA .6 IMODE = 6 STA IMOD1,I * PARSE IBUF, CONVERTING ASCII TO * INTEGER AND REMOVING COMMAS LDA OFSTB STA TMP2 SAVE ADDR OF BUFFER TO PACK INTO LDA IBUF INA STA BUFF4 SAVE ADDR OF BUFFER TO UNPACK FROM CLA STA COUNT INITIALIZE COUNT OF ASCII FIELDS LDA .3 AGAIN STA TMP SAVE LENGTH OF ASCII FIELD JSB CATI CONVERT ASCII TO INTEGER DEF *+6 DEF BUFF4,I FIELD OF ASCII CHARACTERS DEF .1 HIiGH BYTE DEF TMP LENGTH OF ASCII FIELD TO CONVERT DEF N CONVERTED INTEGER DEF STAT STATUS WORD LDB STAT SZB TEST FOR ERROR IN CONVERSION JMP E324 YES LDA N STA TMP2,I STORE INTEGER IN PACK-BUFFER ISZ TMP2 INCREMENT POINTER TO PACK-BUFFER LDA BUFF4 LDB TMP INCREMENT POINTER TO UNPACK-BUFFER INB BRS ADA B STA BUFF4 LDA COUNT COUNT OF ASCII FIELDS CONVERTED INA CPA .6 TEST IF ALL FIELDS CONVERTED JMP R6A YES STA COUNT NO LDA .5 FIELD LENGTH OF REMAINING FIELDS JMP AGAIN CONVERT NEXT ASCII FIELD R6A LDA AS STA ITYP JSB DINUM CONVERT DATA SET NAME TO NUMBER DEF *+3 DEF NAME1 DEF ID,I CPB .103 DATA BASE NOT OPEN? JMP ERR1 SZB TEST FOR ERROR JMP E325 YES, INVALID DATA SET NAME LDA AR STA ITYP JMP BLD BUILD INFORMATION STRING * E324 LDB .324 ILLEGAL DBINF REQUEST RSS E325 LDB .325 INVALID DATA SET OR ITEM NAME ERR1 STB TMP JSB CITA CONVERT CONDITION CODE TO ASCII DEF *+3 DEF TMP CONDITION CODE (INTEGER) DEF BUFF2 ASCII BUFFER LDB IBUF LDA .3 SET STRING CHARACTER COUNT STA B,I INB STB PBUF SAVE ADDR OF BUFFER TO PACK INTO LDA OFST2 INA IOR SIGN STA UPBUF ADDR OF BUFFER TO UNPACK FROM JSB PACKN TRANSFER CONDITION CODE (ASCII) DEF .3 TO USER BUFFER JMP EXIT1 RETURN * INFO NOP CALL IMAGE INFORMATION ROUTINE JSB DBINF DEF *+5 DEF ITYP DEF IMOD1,yI DEF ID,I DEF BUFFR JMP INFO,I * * *************************************************************** * CONVERT DATA SET OR ITEM NAME TO A NUMBER * * * * CALLING SEQUENCE: ITYP = I OR S, FOR ITEM OR SET * * JSB DINUM * * DEF *+3 * * DEF DATA ITEM NAME * * DEF BUFFER FOR DATA ITEM NUMBER * * RETURNS WITH CONDITION CODE IN * * B-REGISTER * *************************************************************** * DINUM NOP LDA DINUM,I STA RETRN SAVE RETURN ADDRESS ISZ DINUM LDA DINUM,I ITEM NAME STA TMP JSB DBINF CALL IMAGE INFORMATION ROUTINE DEF *+5 DEF ITYP ITYPE = I OR S DEF .5 IMODE = 5 DEF TMP,I DATA ITEM NAME DEF TMP2 TEMPORARY BUFFER TO HOLD ITEM NUMBER * LDB TMP2 SZB TEST CONDITION CODE JMP RETRN,I ERROR, RETURN ISZ DINUM LDB DINUM,I LDA TMP2+1 DATA ITEM NUMBER STA B,I BUFFER FOR RETURNED ITEM NUMBER CLB JMP RETRN,I RETURN * * *************************************************************** * CONVERT DATA SET OR ITEM NUMBER TO A NAME * * * * CALLING SEQUENCE: JSB DSNAM * * DEF SET OR ITEM NUMBER * * NAME RETURNED IN WORDS 2,3,4 * * OF BUFF2 * *************************************************************** * PIHFB DSNAM NOP LDA DSNAM,I STA TMP JSB DBINF CALL IMAGE INFORMATION ROUTINE DEF *+5 DEF ITYP ITYPE=I OR S DEF .2 IMODE=2 DEF TMP,I DATA SET NUMBER DEF BUFF2 BUFFER FOR RETURNED INFORMATION LDA BUFF2 TEST CONDITION CODE SZA,RSS JMP DSNM1 JSB PAKCC ERROR IN INFORMATION CALL DEF BUFF2 CONDITION CODE LDA COUNT STA IBUF,I STRING CHARACTER COUNT JMP DMINF,I DSNM1 ISZ DSNAM INCREMENT RETURN ADDRESS JMP DSNAM,I RETURN * H* *************************************************************** * ROUTINE TO PACK ASCII CONDITION CODE * * * * CALLING SEQUENCE: JSB PAKCC * * DEF CONDITION CODE * * ASCII CONDITION CODE IS PACKED * * INTO IBUF * *************************************************************** * PAKCC NOP LDA PAKCC,I STA TMP JSB CITA CONVERT CONDITION CODE TO ASCII (3) DEF *+3 DEF TMP,I CONDITION CODE (INTEGER) DEF BUFF2 ASCII BUFFER LDB IBUF INB STB PBUF SAVE ADDRESS OF BUFFER TO PACK INTO CLA STA COUNT INITIALIZE STRING CHARACTER COUNT LDA OFST2 INA IOR SIGN STA UPBUF SAVE ADDR OF BUFFER TO UNPACK FROM JSB PACKN TRANSFER CONDITION CODE (ASCII) DEF .3 TO USER BUFFER LDA COUNT ADA .3 ADD 3 TO STRING CHARACTER COUNT STA COUNT ISZ PAKCC INCREMENT RETURN ADDRESS JMP PAKCC,I RETURN * * *************************************************************** * ROUTINE TO PACK A LIST OF ITEM NAMES * * * * CALLING SEQUENCE: ITEMS = NUMBER OF ITEMS * * BUFFR = BUFFER OF NAMES * * INDX = OFFSET INTO BUFFR * * JSB PAKIT * * NAMES ARE PACKED INTO IBUF, * * SEPARATED BY COMMAS * *************************************************************** * PAKIT NOP LDA AI ITYPE = I v STA ITYP LOOP1 ISZ ITEMS TEST ITEM COUNT RSS JMP PAKIT,I ALL NAMES PACKED LDA .44 PACK A COMMA JSB PAK ISZ COUNT INCREMENT STRING CHARACTER COUNT LDA INDX LDB A,I SSB TEST FOR NEGATIVE ITEM NUMBER CMB,INB YES, MAKE POSITIVE STB A,I JSB DSNAM CONVERT DATA ITEM NUMBER TO NAME DEF INDX,I ITEM NUMBER LDB OFST2 INB STB UPBUF SAVE ADDR OF BUFFER TO UNPACK FROM JSB PACKN TRANSFER ITEM NAME TO USER BUFFER DEF .6 LDA COUNT ADA .6 ADD 6 TO STRING CHARACTER COUNT STA COUNT ISZ INDX INCREMENT POINTER TO NEXT ITEM JMP LOOP1 * * *************************************************************** * ROUTINE TO PACK A LIST OF DATA SET-DATA ITEM NAMES * * * * CALLING SEQUENCE: ITEMS = NUMBER OF DATA SETS + * * DATA ITEMS * * BUFFR = BUFFER OF SETS, ITEMS * * INDX = POINTER TO NEXT SET OR * * ITEM IN BUFFR * * JSB PKIT2 * * NAMES ARE PACKED IN IBUF, * * SEPARATED BY COMMAS * *************************************************************** * PKIT2 NOP LOOP2 ISZ ITEMS TEST SET-ITEM COUNT RSS JMP PKIT2,I LDA .44 PACK A COMMA JSB PAK ISZ COUNT INCREMENT STRING CHARACTER COUNT LDA AS STA ITYP JSB DSNAM CONVERT DATA SET NUMBER TO NAME DEF INDX,I DATA SET NUMBER LDB OFST2 INB STB UPBUF SAVE ADDR OF BsUFFER TO UNPACK FROM JSB PACKN PACK DATA SET NAME INTO IBUF DEF .6 LDA COUNT ADA .6 ADD 6 TO STRING CHARACTER COUNT STA COUNT ISZ INDX INCREMENT POINTER TO NEXT ITEM ISZ ITEMS TEST SET-ITEM COUNT RSS JMP PKIT2,I LDA .44 PACK A COMMA JSB PAK ISZ COUNT INCREMENT STRING CHARACTER COUNT LDA AI STA ITYP JSB DSNAM CONVERT ITEM NUMBER TO ITEM NAME DEF INDX,I DATA ITEM NUMBER LDB OFST2 INB STB UPBUF SAVE ADDR OF BUFFER TO UNPACK FROM JSB PACKN DEF .6 LDA COUNT ADA .6 ADD 6 TO STRING CHARACTER COUNT STA COUNT ISZ INDX INCREMENT POINTER TO NEXT SET JMP LOOP2 * * EXIT1 JSB RSFLG SET SAVE RESOURCES FLAG DEF *+1 JMP DMINF,I TERMINATE INFORMATION CALL * * * * CALLING SEQUENCE: * CALL DBFND(ISTAT,IDSET,IPATH,IARG) * * * ENTRY IN BASIC SUBROUTINE TABLE: * DBFND(IVA,RA,RA,RA), OV=NN, ENT=DMFND, FIL=IMAGR * * WHERE NN IS THE OVERLAY NUMBER * * ISTA7 NOP ISET4 NOP IPATH NOP IARG1 NOP DMFND NOP ENTRY JSB .ENTR FETCH PARAMETERS DEF ISTA7 JSB ASCI CONVERT STRINGS TO ASCII DEF ISET4 JSB PAD PAD SET NAME TO 6 CHARACTERS DEF *+3 DEF ISET4 DEF NAME1 JSB ASCI DEF IPATH JSB PAD PAD PATH NAME TO 6 CHARACTERS DEF *+3 DEF IPATH DEF NAME2 * LDA AI STA ITYP JSB DINUM CONVERT DATA ITEM NAME TO NUMBER DEF *+3 DEF NAME2 DETAIL KEY ITEM NAME DEF BUFF4 BUFFER FOR RETURNED ITEM NUMBER CPB .103 DATA BASE NOT OPEN? JMP E103 SZB m TEST INTERNAL ERROR CODE JMP E301 SET USER STATUS CODE TO ERROR NUMBER * JSB DBINF CALL IMAGE INFORMATION ROUTINE DEF *+5 DEF AI ITYPE = I DEF .2 IMODE = 2 DEF BUFF4 DATA ITEM NUMBER DEF BUFF2 BUFFER FOR RETURNED INFORMATION * LDB BUFF2 SZB,RSS TEST FOR ERROR IN INFORMATION CALL JMP FIND1 NO E301 LDB .301 INVALID DATA ITEM NAME E103 STB ISTA7,I SET USER STATUS CODE TO ERROR NUMBER JMP EXIT5 RETURN * FIND1 LDA BUFF2+4 DATA ITEM TYPE (I, R, OR U) AND B377 CPA B111 TEST FOR INTEGER ITEM (I) JMP INTG YES CPA B125 TEST FOR ASCII ITEM (U) RSS YES JMP FIND NO, REAL ITEM * JSB ASCI CONVERT STRING TO ASCII DEF IARG1 JMP FIND * INTG DLD IARG1,I JSB IFIX CONVERT REAL TO INTEGER STA IARG1,I SAVE CONVERTED KEY ITEM VALUE * FIND JSB DBFND CALL IMAGE FIND ROUTINE DEF *+5 DEF ISTA7,I DEF NAME1 DEF NAME2 DEF IARG1,I * EXIT5 JSB RSFLG SET SAVE RESOURCES FLAG DEF *+1 JMP DMFND,I TERMINATE FIND CALL * * * * CALLING SEQUENCE: * CALL DBGET(ISTAT,IDSET,IMODE,IARG,INAME,READ-LIST) * * * ENTRY IN BASIC SUBROUTINE TABLE: * DBGET(IVA,RA,I,RA,RA,RVA,RVA,RVA,RVA,RVA,RVA,RVA,RVA,RVA,RVA), * OV=NN, ENT=DMGET, FIL=IMAGR * * WHERE NN IS THE OVERLAY NUMBER * * ISTA4 NOP IDSET NOP IMOD3 NOP IARG NOP INAM2 NOP RLIST BSS 10 DMGET NOP ENTRY JSB .ENTR FETCH PARAMETERS DEF ISTA4 JSB ASCI CONVERT STRING TO ASCII DEF IDSET JSB PAD PAD SET NAME TO 6 CHARACTERS DEF *+3 DEF IDSET DEF NAME1 * LDA AS STA ITYP JSB DINUM CONVERT DATA SET NAME TO NUMBER DEF *+3 DEF NAME1 DATA SET NAME DEF DSNBR BUFFER FOR RETURNED DATA SET NUMBER SZB,RSS TEST FOR ERROR IN CONVERSION JMP GET1 NO ERROR CPB .103 DATA BASE NOT OPEN? RSS E300 LDB .300 INVALID DATA SET NAME STB ISTA4,I SET USER STATUS CODE TO ERROR NUMBER JMP EXIT6 RETURN * GET1 LDA IMOD3,I GET MODE FOR DATA BASE READ CPA .1 TEST FOR MODE=1 RSS YES CPA .2 TEST FOR MODE=2 JMP GET YES, CALL DBGET CPA .3 TEST FOR MODE=3 JMP CONVT YES, CONVERT RELATIVE RECORD TO INTG CPA .4 TEST FOR MODE=4 JMP GET2 YES, CONVERT IARG TO CORRECT TYPE LDB .315 INVALID MODE SPECIFIED BY USER STB ISTA4,I SET USER STATUS CODE TO 315 JMP EXIT6 RETURN * CONVT LDA IARG,I GET RELATIVE RECORD NUMBER AND MSKLO TEST IF NUMERIC SZA,RSS JMP E306 NO, ERROR DLD IARG,I RELATIVE RECORD NUMBER (REAL) JSB IFIX CONVERT REAL TO INTEGER STA IARG,I JMP GET CALL IMAGE READ ROUTINE E306 LDB .306 INVALID RECD# IN DIRECTED READ STB ISTA4,I SET USER STATUS CODE TO 306 JMP EXIT6 RETURN * GET2 JSB DBINF GET KEY ITEM OF DATA SET IN IDSET DEF *+5 DEF AI ITYPE=I DEF .3 IMODE=3 DEF DSNBR DATA SET NUMBER DEF BUFF2 BUFFER FOR RETURNED INFORMATION LDB BUFF2 SZB TEST FOR ERROR IN INFORMATION CALL JMP E300 SET USER STATUS CODE TO ERROR NUMBER * JSB DBINF GET ITEM TYPE OF KEY ITEM DEF A*+5 DEF AI ITYPE=I DEF .2 IMODE=2 DEF BUFF2+2 KEY ITEM NUMBER DEF BUFF5 BUFFER FOR RETURNED INFORMATION LDB BUFF5 SZB TEST FOR ERROR IN INFORMATION CALL JMP E300 SET USER STATUS CODE TO ERROR NUMBER * LDA BUFF5+4 AND B377 DATA ITEM TYPE (I, R, OR U) CPA B125 TEST FOR ASCII ITEM (U) JMP ASC2 YES CPA B111 TEST FOR INTEGER ITEM (I) RSS YES, CONVERT IARG TO INTEGER JMP GET NO, REAL ITEM (R) * DLD IARG,I CONVERT IARG TO INTEGER JSB IFIX REAL TO INTEGER CONVERSION STA IARG,I JMP GET ASC2 JSB ASCI CONVERT STRING TO ASCII DEF IARG * GET JSB DBGET CALL IMAGE GET ROUTINE DEF *+6 DEF NAME1 DEF IMOD3,I DEF ISTA4,I DEF IBUF1 DEF IARG,I * LDB ISTA4,I TEST FOR SUCCESSFUL DATA BASE READ SZB JMP EXIT6 NO, RETURN * JSB PARSE PARSE NAME-LIST AND BUILD INBR ARRAY DEF *+2 DEF INAM2 SZB,RSS TEST FOR ERROR IN PARSE JMP GET3 NO, CONTINUE STB ISTA4,I SET USER STATUS CODE TO ERROR NUMBER JMP EXIT6 RETURN GET3 LDA INDXR STA R LDA INBR GET ITEM NAME COUNT CMA SAVE COUNT-1 STA COUNT MORE LDA R,I STA VARS SAVE ADDRESS OF READ-LIST PARAMETER ISZ COUNT TEST FOR END OF IBUF1 UNPACK RSS NO JMP EXIT6 YES, RETURN ISZ INDXB INCREMENT INDEX TO INBR ARRAY JSB DBINF CALL IMAGE INFORMATION ROUTINE DEF *+5 DEF AI ITYPE=I DEF .2 IMODE=2 DEF INDXB,I DATA ITEM NUMBER DEF BUFF2 BUFFER FOR RETURNED INFORMpATION * LDB BUFF2 SZB,RSS TEST FOR ERROR IN INFORMATION CALL JMP GET4 NO, CONTINUE LDB .303 INVALID NAME IN NAME-LIST STB ISTA4,I SET USER STATUS CODE TO ERROR NUMBER JMP EXIT6 RETURN * GET4 LDB BUFF2+8 DATA SET NUMBER OF ITEM CPB DSNBR COMPARE WITH DATA SET PARAMETER JMP GET5 MATCH, CONTINUE LDB .303 DIFFER, INVALID NAME IN NAME-LIST STB ISTA4,I SET USER STATUS CODE JMP EXIT6 RETURN * GET5 LDA VARS ADDR OF PARAMETER IN VARIABLE LIST SZA TEST FOR NO PARAMETER JMP GET6 NO ERROR, CONTINUE LDB .305 VARIABLE MISSING IN VARIABLE-LIST STB ISTA4,I SET USER STATUS CODE JMP EXIT6 RETURN * GET6 ISZ R INCREMENT INDEX TO RLIST LDB BUFF2+7 DATA ITEM OFFSET ADB IBUFF LOCATION OF ITEM IN DBGET BUFFER LDA VARS,I GET WORD 1 OF CURRENT PARM AND MSKLO MASK LOW BYTE TO TEST TYPE CLE E USED AS INDICATOR OF PARM TYPE SZA,RSS TEST IF NUMERIC OR STRING CME STRING - SET E LDA BUFF2+4 DATA ITEM TYPE (I, R, OR U) AND B377 CPA B125 TEST FOR ASCII ITEM (U) JMP APEND YES CPA B111 TEST FOR INTEGER ITEM (I) JMP ITR YES * SEZ TEST IF RETURN VARIABLE NUMERIC JMP E304 NO, ERROR LDA R,I ADDR OF NEXT PARM IN VARIABLE LIST SZA,RSS TEST IF LAST PARAMETER JMP GET7 YES, CONTINUE LDA VARS NO, TEST IF WRITING IN NEXT PARM ADA .2 CPA R,I JMP GET7 NO, CONTINUE E304 LDB .304 ERROR STB ISTA4,I SET USER STATUS CODE JMP EXIT6 RETURN * GET7 DLD B,I NO, REAL ITEM (R)  DST VARS,I STORE REAL INTO READ-LIST JMP MORE UNPACK NEXT ITEM APEND SEZ,RSS TEST IF RETURN VARIABLE TYPE STRING JMP E304 NO, ERROR LDA BUFF2+6 DATA ITEM LENGTH (IN WORDS) STA TMP SAVE LENGTH LDA R,I ADDR OF NEXT PARM IN VARIABLE LIST SZA,RSS TEST IF LAST PARAMETER JMP GET8 YES, CONTINUE CMA,INA ADA VARS NO, TEST IF WRITING IN NEXT PARM ADA TMP SSA,RSS (NEXT PARM = VARS+TMP+1) JMP E304 ERROR, SET USER STATUS CODE GET8 LDA TMP RESTORE ITEM LENGTH ALS ITEM LENGTH IN CHARACTERS NEXT STA VARS,I STORE IN NEXT WORD OF STRING ISZ VARS INCREMENT POINTER TO READ-LIST LDA TMP SZA,RSS TEST FOR END OF ASCII ITEM JMP MORE YES, UNPACK NEXT ITEM ADA M1 DECREMENT ITEM LENGTH COUNT STA TMP LDA B,I GET NEXT WORD FROM DBGET BUFFER INB INCREMENT POINTER TO DBGET BUFFER JMP NEXT UNPACK NEXT WORD * ITR SEZ TEST IF RETURN VARIABLE NUMERIC JMP E304 NO, ERROR LDA R,I ADDR OF NEXT PARM IN VARIABLE LIST SZA,RSS TEST IF LAST PARAMETER JMP GET9 YES, CONTINUE LDA VARS NO, TEST IF WRITING IN NEXT PARM ADA .2 CPA R,I RSS NO, CONTINUE JMP E304 ERROR, SET USER STATUS CODE * GET9 LDA B,I GET NEXT WORD FROM DBGET BUFFER JSB FLOAT CONVERT INTEGER TO REAL DST VARS,I STORE REAL INTO READ-LIST JMP MORE UNPACK NEXT ITEM * EXIT6 JSB RSFLG SET SAVE RESOURCES FLAG DEF *+1 JMP DMGET,I TERMINATE GET CALL * * * * CALLING SEQUENCE: * CALL DBUPD(ISTAT,IDSET,INAME,PRINT-LIST) * * *  ENTRY IN BASIC SUBROUTINE TABLE: * DBUPD(IV,RA,RA), OV=NN, ENT=DMUPD, FIL=IMAGR * * WHERE NN IS THE OVERLAY NUMBER * * ISTA5 NOP ISET2 NOP INAME NOP PLIST BSS 12 DMUPD NOP ENTRY JSB .ENTR FETCH PARAMETERS DEF ISTA5 JSB ASCI CONVERT STRING TO ASCII DEF ISET2 JSB PAD PAD SET NAME TO 6 CHARACTERS DEF *+3 DEF ISET2 DEF NAME1 * LDA AS STA ITYP JSB DINUM CONVERT DATA SET NAME TO NUMBER DEF *+3 DEF NAME1 DATA SET NAME DEF DSNBR BUFFER FOR RETURNED DATA SET NUMBER SZB,RSS TEST FOR ERROR IN CONVERSION JMP UPD1 NO ERROR CPB .103 DATA BASE NOT OPEN? RSS LDB .300 INVALID DATA SET NAME STB ISTA5,I SET USER STATUS CODE JMP EXIT3 RETURN * UPD1 JSB PARSE PARSE NAME-LIST AND PRINT-LIST, AND DEF *+2 BUILD INBR ARRAY DEF INAME * SZB,RSS TEST FOR ERROR IN PARSE JMP UPD2 NO ERROR, COMPLETE UPDATE REQUEST STB ISTA5,I SET USER STATUS CODE TO ERROR NUMBER JMP EXIT3 RETURN UPD2 JSB IVAL CONSTRUCT IVALU PACKED ARRAY DEF *+2 DEF PLIST SZB,RSS TEST FOR ERROR IN CONSTRUCTION JMP UPDTE NO STB ISTA5,I SET USER STATUS CODE TO ERROR JMP EXIT3 RETURN * UPDTE JSB DBUPD CALL IMAGE UPDATE ROUTINE DEF *+6 DEF NAME1 DEF ISTA5,I DEF INBR DEF IVALU DEF IBUF2 * EXIT3 JSB RSFLG SET SAVE RESOURCES FLAG DEF *+1 JMP DMUPD,I TERMINATE UPDATE CALL * * * * CALLING SEQUENCE: * CALL DBPUT(ISTAT,IDSET,INAME,PRINT-LIST) * * * ENTRY IN BASIC SUBROUTINE TABLE: * DBPUT(IV,RA,RA), OV=NN, ENT=DMPUT, FIL=IMAGR * * WHERE NN IS THE OVERLAY NUMBER * * ISTA6 NOP ISET3 NOP INAM1 NOP PLST1 BSS 12 DMPUT NOP ENTRY JSB .ENTR FETCH PARAMETERS DEF ISTA6 JSB ASCI CONVERT STRING TO ASCII DEF ISET3 JSB PAD PAD SET NAME TO 6 CHARACTERS DEF *+3 DEF ISET3 DEF NAME1 * LDA AS STA ITYP JSB DINUM CONVERT DATA SET NAME TO NUMBER DEF *+3 DEF NAME1 DATA SET NAME DEF DSNBR BUFFER FOR RETURNED DATA SET NUMBER SZB,RSS TEST FOR ERROR IN CONVERSION JMP PUT1 NO ERROR CPB .103 DATA BASE NOT OPEN? RSS LDB .300 INVALID DATA SET NAME STB ISTA6,I SET USER STATUS CODE JMP EXIT4 RETURN * PUT1 JSB PARSE PARSE NAME-LIST AND PRINT LIST, AND DEF *+2 BUILD INBR PACKED ARRAY DEF INAM1 SZB,RSS TEST FOR ERROR IN PARSE JMP PUT2 NO ERROR, COMPLETE PUT REQUEST STB ISTA6,I SET USER STATUS CODE TO ERROR NUMBER JMP EXIT4 RETURN PUT2 JSB IVAL CONSTRUCT IVALU PACKED ARRAY DEF *+2 DEF PLST1 SZB,RSS TEST FOR ERROR IN CONSTRUCTION JMP PUT NO ERROR STB ISTA6,I SET USER STATUS CODE TO ERROR NUMBER JMP EXIT4 * PUT JSB DBPUT CALL IMAGE PUT ROUTINE DEF *+6 DEF NAME1 DEF ISTA6,I DEF INBR DEF IVALU DEF IBUF2 * EXIT4 JSB RSFLG SET SAVE RESOURCES FLAG DEF *+1 JMP DMPUT,I TERMINATE PUT CALL * * PARSE NOP PARSE NAME-LIST AND BUILD INBR LDB PARSE LDA B,I SAVE RETURN ADDRESS STA PARSE INB LDB B,I FETCH PARAMETERS LDB B,I |STB NAMES SAVE NAME-LIST ADDRESS LDA PTR1 INITIALIZE POINTERS TO INBR STA INDXB LDA PTR2 STA OFSTN * JSB ASCI CONVERT NAME-LIST TO ASCII DEF NAMES CLA STA INBR INITIALIZE ITEM-NAME COUNT LDB NAMES STB UPBUF ADDRESS OF BUFFER TO UNPACK FROM NEXTI LDA CHARS NAME-LIST STRING CHARACTER COUNT SZA TEST FOR EMPTY NAME-LIST JMP PARS1 LDB .302 INVALID NAME-LIST JMP PARSE,I RETURN PARS1 ADA M1 DECREMENT NAME-LIST CHARACTER COUNT STA CHARS SAVE NAME-LIST CHARACTER COUNT JSB UNPAK GET CHARACTER FROM NAME-LIST STA CHAR SAVE CHARACTER CMA,INA ADA .64 SSA TEST FOR NON-ALPHABETIC CHARACTER JMP PARS2 E303 LDB .303 YES, INVALID NAME IN NAME-LIST JMP PARSE,I RETURN PARS2 LDA CHAR CMA,INA ADA B132 SSA TEST FOR NON-ALPHABETIC CHARACTER JMP E303 YES, INVALID NAME IN NAME-LIST * CLA,INA STA NCNT INITIALIZE ITEM-NAME CHARACTER COUNT LDA INDX3 TEMPORARY BUFFER TO HOLD ITEM-NAME STA PBUF ADDRESS OF BUFFER TO PACK INTO NEXTC LDA CHAR JSB PAK PACK CHARACTER INTO TEMPORARY BUFFER LDB CHARS NAME-LIST CHARACTER COUNT SZB,RSS TEST FOR END OF NAME-LIST JMP BLD2 END OF NAME-LIST ADB M1 DECREMENT NAME-LIST CHARACTER COUNT STB CHARS JSB UNPAK GET NEXT CHARACTER FROM NAME-LIST STA CHAR CPA .44 TEST FOR COMMA JMP BLD1 YES, END OF ITEM-NAME LDA NCNT NO INA INCREMENT ITEM-NAME CHARACTER COUNT STA NCNT CMA,INA ADA .6 SSA,RSS TEST FOR NAME LONGER THAN 6 CHARS 3HFB JMP NEXTC NO JMP E303 YES, INVALID NAME IN NAME-LIST * BLD1 JSB BUILD BUILD NEXT ELEMENT OF INBR SZB TEST INTERNAL ERROR CODE JMP PARSE,I ERROR, RETURN JMP NEXTI GET NEXT ITEM NAME FROM NAME-LIST * BLD2 JSB BUILD BUILD LAST ELEMENT OF INBR JMP PARSE,I RETURN * HIVAL NOP CONSTRUCT IVALU PACKED ARRAY LDB IVAL LDA B,I SAVE RETURN ADDRESS STA IVAL LDA PTR3 INITIALIZE POINTER TO IVALU STA OFSTV INB LDB B,I FETCH PARAMETER STB P SAVE POINTER TO PRINT-LIST LDA INBR GET ITEM NAME COUNT CMA SAVE COUNT-1 STA COUNT NITEM LDB P,I GET NEXT PARAMETER FROM PRINT-LIST STB VARS SAVE VARIABLE-LIST ADDRESS ISZ COUNT TEST FOR END OF IVALU CONSTRUCTION RSS NO JMP EXIT7 YES, RETURN ISZ INDXB INDEX TO INBR ARRAY JSB DBINF CALL IMAGE INFORMATION ROUTINE DEF *+5 DEF AI ITYPE=I DEF .2 IMODE=2 DEF INDXB,I DATA ITEM NUMBER DEF BUFF2 BUFFER FOR RETURNED INFORMATION * LDB BUFF2 SZB,RSS TEST FOR ERROR IN INFORMATION CALL JMP NITM1 NO, CONTINUE LDB .303 JMP IVAL,I ERROR, RETURN * NITM1 LDB BUFF2+8 DATA SET NUMBER AS DEFINED CPB DSNBR COMPARE WITH DATA SET PARAMETER JMP NITM2 MATCH, CONTINUE LDB .303 DIFFER, INVALID NAME IN NAME-LIST JMP IVAL,I RETURN * NITM2 LDA VARS ADDRESS OF PRINT-LIST PARAMETER SZA TEST FOR NO PARAMETER JMP NITM3 NO ERROR, CONTINUE LDB .305 VARIABLE MISSING IN VARIABLE LIST JMP IVAL,I RETURN * NITM3 ISZ P INCREMENT INDEX TO PLIST LDA BUFF2+4 DATA ITEM TYPE (I,R, OR U) AND B377 CPA B125 TEST FOR ASCII ITEM (U) JMP STRNG YES CPA B111 TEST FOR INTEGER ITEM (I) JMP INTGR YES * LDA P,I ADDRESS OF NEXT PARM IN VAR-LIST SZA,RSS TEST IF LAST PARAMETER JMP NITM4 DYES, CONTINUE LDA VARS NO, TEST IF READING FROM NEXT PARM ADA .2 CPA P,I JMP NITM4 NO, CONTINUE E304A LDB .304 ERROR JMP IVAL,I RETURN * NITM4 DLD VARS,I NO, REAL ITEM (R) DST OFSTV,I PACK REAL ITEM INTO IVALU ISZ OFSTV INCREMENT INDEX TO IVALU ARRAY ISZ OFSTV JMP NITEM * STRNG LDB VARS,I STRING CHARACTER COUNT SLB TEST IF ODD COUNT INB YES BRS LENGTH IN WORDS CPB BUFF2+6 COMPARE WITH LENGTH AS DEFINED RSS YES, CORRECT ITEM LENGTH JMP E304A NO, INCORRECT ITEM LENGTH JSB ASCI CONVERT STRING TO ASCII DEF VARS LDA LENTH LENGTH OF STRING IN WORDS NEXTW SZA,RSS TEST FOR COMPLETION OF PACK JMP NITEM YES LDB VARS,I INDEX TO PRINT-LIST STB OFSTV,I PACK 2 CHARACTERS INTO IVALU ISZ OFSTV INCREMENT INDEX TO IVALU ISZ VARS INCREMENT INDEX TO PRINT-LIST ADA M1 DECREMENT STRING LENGTH WORD COUNT JMP NEXTW * INTGR LDA P,I ADDRESS OF NEXT PARM IN VAR-LIST SZA,RSS TEST IF LAST PARAMETER JMP INTG1 YES, CONTINUE LDA VARS NO, TEST IF READING FROM NEXT PARM ADA .2 CPA P,I RSS NO, CONTINUE JMP E304A YES, SET ERROR CODE * INTG1 DLD VARS,I GET NEXT VARIABLE IN PRINT-LIST JSB IFIX CONVERT TO INTEGER STA OFSTV,I PACK INTEGER INTO IVALU ISZ OFSTV INCREMENT INDEX TO IVALU JMP NITEM GET NEXT ITEM FROM INBR ARRAY * EXIT7 CLB SET INTERNAL ERROR CODE TO ZERO JMP IVAL,I RETURN * BUILD NOP BUILD INBR ARRAY LDA AI STA ITYP LDA NCNT GET CHARACTER COUNT (SLA TEST IF ODD NUMBER OF CHARACTERS JMP ODD YES ARS GET COUNT IN WORDS STA LENTH SAVE COUNT CALPD JSB PAD PAD ITEM NAME TO 6 CHARACTERS DEF *+3 DEF INDX3 DEF NAME2 JSB DINUM CONVERT DATA ITEM NAME TO NUMBER DEF *+3 DEF NAME2 DATA ITEM NAME DEF BUFF4 BUFFER FOR RETURNED DATA ITEM NUMBER SZB,RSS TEST FOR ERROR JMP CALP2 NO LDB .303 JMP BUILD,I ERROR, RETURN * CALP2 LDA BUFF4 STA OFSTN,I PACK ITEM NUMBER INTO INBR ARRAY ISZ OFSTN INCREMENT INDEX TO INBR ARRAY ISZ INBR INCREMENT COUNT OF DATA ITEMS JMP BUILD,I RETURN ODD ARS LENGTH IN WORDS, LESS ONE STA LENTH SAVE LENGTH LDB INDX3 POINTER TO FIRST WORD OF NAME ADB A B NOW POINTS TO LAST WORD OF NAME LDA B,I GET CONTENTS OF LAST WORD AND MSKLO MASK LOWER BYTE (NO CHAR) IOR B40 PAD WITH A BLANK STA B,I REPLACE LAST WORD ISZ LENTH INCREMENT TO TRUE LENGTH IN WORDS JMP CALPD CONTINUE * * * CALLING SEQUENCE: * CALL DBDEL(ISTAT,IDSET) * * * ENTRY IN BASIC SUBROUTINE TABLE: * DBDEL(IV,RA), OV=NN, ENT=DMDEL, FIL=IMAGR * * WHERE NN IS THE OVERLAY NUMBER * * ISTA8 NOP ISET5 NOP DMDEL NOP ENTRY JSB .ENTR FETCH PARAMETERS DEF ISTA8 JSB ASCI CONVERT STRING TO ASCII DEF ISET5 JSB PAD PAD SET NAME TO 6 CHARACTERS DEF *+3 DEF ISET5 DEF NAME1 * JSB DBDEL CALL IMAGE DELETE ROUTINE DEF *+3 DEF NAME1 DEF ISTA8,I * JSB RSFLG SET SAVE RESOURCES FLAG DEF *+1 JMP DMDEL,I <4 TERMINATE DELETE CALL * * * * CALLING SEQUENCE: * CALL DBCLS(ISTAT,IMODE) * * * ENTRY IN BASIC SUBROUTINE TABLE: * DBCLS(IV,I), OV=NN, ENT=DMCLS, FIL=IMAGR * * WHERE NN IS THE OVERLAY NUMBER * * ISTA3 NOP IMOD2 NOP DMCLS NOP ENTRY JSB .ENTR FETCH PARAMETERS DEF ISTA3 * JSB DBCLS CALL IMAGE CLOSE ROUTINE DEF *+3 DEF IMOD2,I DEF ISTA3,I * LDA IMOD2,I SZA,RSS IF MODE=0, RESET INITIALIZE FLAG STA RFLAG * JSB RSFLG SET SAVE RESOURCES FLAG DEF *+1 JMP DMCLS,I TERMINATE CLOSE CALL * * * * * CALLING SEQUENCE: * CALL DBLCK(ISTAT,IMODE) * * * ENTRY IN BASIC SUBROUTINE TABLE: * DBLCK(IV,I), OV=NN, ENT=DMLCK, FIL=IMAGR * * WHERE NN IS THE OVERLAY NUMBER * * ISTA9 NOP IMOD4 NOP DMLCK NOP ENTRY JSB .ENTR FETCH PARAMETERS DEF ISTA9 * JSB DBLCK CALL IMAGE LOCK ROUTINE DEF *+3 DEF IMOD4,I DEF ISTA9,I * JSB RSFLG SET SAVE RESOURCES FLAG DEF *+1 JMP DMLCK,I TERMINATE LOCK CALL * * * * * CALLING SEQUENCE: * CALL DBUNL(ISTAT) * * * ENTRY IN BASIC SUBROUTINE TABLE: * DBUNL(IV), OV=NN, ENT=DMUNL, FIL=IMAGR * * WHERE NN IS THE OVERLAY NUMBER * * ISTA1 NOP DMUNL NOP ENTRY JSB .ENTR FETCH PARAMETER DEF ISTA1 * JSB DBUNL CALL IMAGE UNLOCK ROUTINE DEF *+2 DEF ISTA1,I * JSB RSFLG SET SAVE RESOURCES FLAG DEF *+1 JMP DMUNL,I TERMINATE UNLOCK CALL * * ASCI NOP CONVERT STRING TO ASCII LDB ASCI,I FETCH PARAMETER (ADDR OF STRING) LDA B,I LDA A,I ;AND B377 EXTRACT LENGTH IN CHARACTERS STA CHARS SAVE LENGTH IN CHARACTERS SLA SKIP IF EVEN NUMBER OF CHARS JMP ODDLN ODD NUMBER OF CHARACTERS ARS OBTAIN NUMBER OF WORDS REQUIRED STA LENTH RMOV ISZ B,I CHARACTERS BEGIN AT WORD 2 ISZ ASCI INCREMENT RETURN ADDRESS JMP ASCI,I RETURN * ODDLN INA ADDITIONAL WORD SINCE LENGTH ODD ARS OBTAIN NUMBER OF WORDS REQUIRED STA LENTH STB TEMP SAVE POINTER TO STRING LDB B,I ADB LENTH ADDR OF LAST WORD OF STRING LDA B,I AND MSKLO MASK LOWER BYTE (NO CHAR) IOR B40 PAD WITH A BLANK STA B,I LDB TEMP RESTORE POINTER TO STRING JMP RMOV * * *************************************************************** * PAD AN ASCII STRING WITH BLANKS * * * * THE FOLLOWING ROUTINE PADS A SIX-CHARACTER ASCII STRING * * WITH BLANKS, CHECKING THE VARIABLE "LENTH" TO DETERMINE * * THE AMOUNT OF PADDING NECESSARY. * * * * CALLING SEQUENCE: JSB PAD * * DEF *+3 * * DEF SOURCE BUFFER ADDRESS * * DEF RETURN BUFFER ADDRESS * * * *************************************************************** * PAD NOP LDB PAD LDA B,I SAVE RETURN ADDRESS STA PAD INB LDA B,I ORIGINAL ASCII STRING LDA A,I STA TMP INB LDB B,I RETURNED STRING ADDRESS STB TMP2 * LDA LENTH  STRING LENGTH IN WORDS CMA,INA ADA .2 SSA TEST IF LENGTH GREATER THAN 2 JMP PAD2 YES INB ADA M1 NO SSA TEST FOR NUMBER OF WORDS TO PAD JMP PAD1 LDA BLANK PAD LAST TWO WORDS STA B,I PAD1 LDA BLANK PAD LAST WORD INB STA B,I PAD2 LDA TMP A-REG = SOURCE BUFFER ADDRESS LDB TMP2 B-REG = DESTINATION BUFFER ADDRESS JSB .MVW MOVE WORDS DEF LENTH NUMBER OF WORDS TO BE MOVED NOP JMP PAD,I RETURN * * *************************************************************** * STRING PACK ROUTINE * * * * THE FOLLOWING ROUTINE PACKS A CHARACTER INTO A BUFFER * * ACCORDING TO THE POINTER PBUF WITHOUT OTHERWISE ALTERING * * THE BUFFER. THE ROUTINE UPDATES PBUF SO THAT A PACKED * * ASCII BUFFER MAY BE WRITTEN BY SUCCESSIVE CALLS TO PAK. * * PBUF CONTAINS THE ADDRESS OF THE WORD TO PACK INTO; THE * * SIGN BIT, IF SET, INDICATES A PACK INTO THE LOW ORDER * * BITS OF THE WORD. * * * * CALLING SEQUENCE: LDA VALUE FOR PBUF * * STA PBUF * * LDA CHARACTER * * JSB PAK * * * *************************************************************** * CHAR BSS 1 PBUF BSS 1 PAK NOP ENTRY LDB PBUF LOAD CURRENT ADDRESS POINTER CLE ELB,RBR GET SIGN BIT SEZ,RSS TEST IF SIGN BIT SET ALF,ALF STA CHAR  LDA B,I GET CONTENTS OF ASCII BUFFER SEZ ALF,ALF AND =B177 MASK HIGH BITS SEZ ALF,ALF XOR CHAR GET ACTUAL CHARACTER STA B,I PACK IN CURRENT PACK ADDRESS SEZ,CME TEST IF SIGN BIT SET INB,RSS YES, INCREMENT PACK ADDR ELB,RBR STB PBUF SAVE NEW ADDRESS POINTER JMP PAK,I RETURN * * *************************************************************** * STRING UNPACK ROUTINE * * * * THE FOLLOWING ROUTINE UNPACKS A CHARACTER FROM A PACKED * * ASCII BUFFER ACCORDING TO THE POINTER UPBUF. THE ROUTINE * * UPDATES UPBUF SO THAT A PACKED BUFFER MAY BE SEARCHED BY * * SUCCESSIVE CALLS TO UNPAK. UPBUF CONTAINS THE ADDRESS OF * * THE WORD TO UNPACK FROM; THE SIGN BIT, IF SET, INDICATES * * AN UNPACK FROM THE LOW ORDER BITS OF THE WORD. * * * * CALLING SEQUENCE: LDA VALUE FOR UPBUF * * STA UPBUF * * JSB UNPAK * * CHARACTER RETURNED IN A-REGISTER * * * *************************************************************** * UPBUF BSS 1 UNPAK NOP ENTRY LDB UPBUF LOAD CURRENT ADDRESS POINTER CLE ELB,RBR GET SIGN BIT LDA B,I GET CONTENTS OF PACKED BUFFER SEZ,RSS TEST IF SIGN BIT SET ALF,ALF AND =B177 MASK HIGH BITS SEZ,CME TEST IF SIGN BIT SET INB,RSS YES, INCREMENT UNPACK ADDR ELB,RBR STB UPBUF SAVE NEW ADDRESS POINTER JMP UNPAK,I RETURN * * **ʜ************************************************************* * CHARACTER UNPAK-PAK ROUTINE * * * * THE FOLLOWING ROUTINE PERFORMS A SERIES OF UNPACK AND * * PACK OPERATIONS BASED ON THE INPUT PARAMETER N. EACH * * UNPAK-PAK OPERATION TRANSFERS THE NEXT CHARACTER IN THE * * BUFFER POINTED TO BY UPBUF INTO THE NEXT CHARACTER * * POSITION POINTED TO BY PBUF. * * * * CALLING SEQUENCE: (UPBUF) = ADDRESS OF FROM-BUFFER, * * USED BY UNPAK * * (PBUF) = ADDRESS OF TO-BUFFER, * * USED BY PAK * * JSB PACKN * * DEF N, WHERE N IS THE NUMBER OF * * CHARACTERS TO BE TRANSFERRED * *************************************************************** * PACKN NOP LDA PACKN,I LDA A,I CMA SAVE CHARACTER COUNT - 1 STA N TESTN ISZ N ALL CHARACTERS TRANSFERRED? RSS JMP EXIT2 YES JSB UNPAK NO, UNPACK NEXT CHARACTER JSB PAK PACK THE CHARACTER INTO TO-BUFFER JMP TESTN EXIT2 ISZ PACKN INCREMENT RETURN ADDRESS JMP PACKN,I RETURN * * .1 DEC 1 .2 DEC 2 .3 DEC 3 .4 DEC 4 .5 DEC 5 .6 DEC 6 .15 DEC 15 .24 DEC 24 .33 DEC 33 .35 DEC 35 .44 DEC 44 COMMA .64 DEC 64 .75 DEC 75 "K" .78 DEC 78 "N" .103 DEC 103 DATA BASE NOT PROPERLY OPENED .117 DEC 117 ILLEGAL SECURITY CODE .128 DEC 128 INSUFFICIENT BUFFER SPACE .129 DEC 129 ROOT FILE OPENED OR LOCKED .264072 DEC 272 .300 DEC 300 INVALID DATA SET NAME .301 DEC 301 INVALID DATA ITEM NAME .302 DEC 302 INVALID NAME-LIST .303 DEC 303 INVALID NAME IN NAME-LIST .304 DEC 304 INVALID PARAMETER IN VAR-LIST .305 DEC 305 VARIABLE MISSING IN VARIABLE-LIST .306 DEC 306 INVALID RECD# IN DIRECTED READ .315 DEC 315 INVALID MODE SPECIFIED BY USER .324 DEC 324 ILLEGAL DBINF REQUEST .325 DEC 325 INVALID SET OR ITEM NAME IN DBINF M1 DEC -1 M7 DEC -7 M8 DEC -8 M144 DEC -144 M272 DEC -272 B40 OCT 40 B104 OCT 104 "D" B111 OCT 111 "I" B125 OCT 125 "U" B132 OCT 132 B377 OCT 377 MASK UPPER BYTE SIGN OCT 100000 SET SIGN BIT MSKLO OCT 177400 MASK LOWER BYTE AI ASC 1,I AR ASC 1,R AS ASC 1,S BLANK ASC 1, A EQU 0 B EQU 1 BUFFR BSS 256 BUFF2 BSS 9 BUFF3 BSS 3 BUFF4 BSS 1 BUFF5 BSS 9 CHARS BSS 1 COUNT BSS 1 DCB BSS 144 DSNBR BSS 1 IBUF1 BSS 256 IBUF2 EQU IBUF1 IBUFF DEF IBUF1-1 INBR BSS 128 INDX BSS 1 INDX3 DEF BUFF3 INDXB BSS 1 INDXR DEF RLIST ITEMS BSS 1 ITYP BSS 1 IVALU EQU BUFFR LENF BSS 1 IERR EQU LENF LENTH BSS 1 N BSS 1 NAME1 BSS 3 NAME2 BSS 3 NAMES BSS 1 NCNT BSS 1 OFSET DEF BUFFR+2 OFST2 DEF BUFF2 OFSTB DEF BUFFR OFSTN BSS 1 OFSTV BSS 1 P BSS 1 PTR1 DEF INBR PTR2 DEF INBR+1 PTR3 DEF IVALU R BSS 1 RETRN BSS 1 SC BSS 1 STAT BSS 1 TEMP BSS 1 TMP BSS 1 TMP2 BSS 2 VARS BSS 1 END 6 U'} 92101-18020 1650 S 0122 %BADEC STRING ARITH INTERFACE             H0101 5ASMB,R,L,C HED <> NAM BADEC,7 92101-16020 REV.1650 * * * ************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * * PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ************************************************************** * ENT D.SUB,D.ADD,D.MPY,D.DIV,D.EDT * EXT .ENTR,SADD,SSUB,SMPY,SDIV,SEDIT,SMOVE * ********************************************** * * * DECIMAL STRING BASIC INTERFACE PACKAGE * * * ********************************************** * JSTR NOP KSTR NOP AERR NOP D.ADD NOP JSB .ENTR DEF JSTR * CLA STA AERR,I INITIALIZE ERROR INDICATOR LDA JSTR,I GET STRING CHARACTER COUNT STA JEND SAVE AS STRING END LDA KSTR,I GET CHARACTER COUNT OF 2ND STRING STA KEND SAVE AS STRING END ISZ JSTR SKIP TO NEXT WORD OF EACH STRING ISZ KSTR JSB SADD CALL STRING ADD DEF *+8 DEF JSTR,I JSTR DEF .1 IS ADDED TO DEF JEND KSTR DEF KSTR,I DEF .1 DEF KEND DEF AERR,I JMP D.ADD,I RETURN * * * * LSTR NOP MSTR NOP SERR NOP D.SUB NOP JSB .ENTR DEF LSTR * CLA STA SERR,I INITIALIZE ERROR INDICATOR LDA LSTR,I GET STRING CHARACTER COUNT STA JEND SAVE AS STRING END LDA MSTR,I GET CHARACTER COUNT OF 2ND STRING STA KEND SAVE AS STRING END ISZ LSTR SKIP TO NEXT WORD OF EACH STRING ISZ MSTR JSB SSUB CALL STRING SUBTRACT DEF *+8 DEF LSTR,I  LSTR DEF .1 IS SUBTRACTED FROM DEF JEND MSTR DEF MSTR,I DEF .1 DEF KEND DEF SERR,I JMP D.SUB,I RETURN * * * * RSTR NOP SSTR NOP MERR NOP D.MPY NOP JSB .ENTR DEF RSTR * CLA STA MERR,I INITIALIZE ERROR INDICATOR LDA RSTR,I GET STRING CHARACTER COUNT STA JEND SAVE AS STRING END LDA SSTR,I GET CHARACTER COUNT OF 2ND STRING STA KEND SAVE AS STRING END ISZ RSTR SKIP TO NEXT WORD OF EACH STRING ISZ SSTR * LDA JEND COMPUTE EXTRA WORK SPACE ALS REQUIRED FOR THE COMPUTATION ADA KEND N1=(2*JEND)+KEND+1 INA STA N1 ADA KEND N2=(2*JEND)+(2*KEND) ADA M1 STA N2 * JSB SMOVE CALL STRING MOVE DEF *+6 DEF SSTR,I SSTR DEF .1 IS MOVED TO DEF KEND KTEMP DEF KTEMP DEF N1 * JSB SMPY CALL STRING MULTIPLY DEF *+8 DEF RSTR,I RSTR DEF .1 IS MULTIPLIED BY DEF JEND SSTR (IN KTEMP) DEF KTEMP DEF N1 DEF N2 DEF MERR,I * LDB MERR,I TEST ERROR INDICATOR LDA 1 SAVE IN A-REGISTER CMB,INB TEST FOR SMPY OVERFLOW ADB N2 (MERR=N2) SZB,RSS JMP OVFL YES SZA TEST FOR OTHER SMPY ERRORS JMP EXIT2 YES, ERROR RETURN LDA JEND CMA,INA ADA N1 STA N3 N3=N1-JEND * CMA,INA COMPUTE LENGTH OF PRODUCT ADA N2 INA STA LEN SAVE AS RESULT STRING CHAR COUNT LDB PTRS,I GET ADDRESS OF RESULT STRING CMB,INB SUBTRACT FROM ADDRESS OF ERR PARM ADB PTRM,I BLS DOUBLE TO GET SPACE I"N CHARACTERS CMA,INA ADB 0 COMPARE DIFFERENCE (DIM SPACE) SSB WITH SPACE NEEDED FOR PRODUCT JMP OVFL NOT ENOUGH SPACE - OVERFLOW * JSB SMOVE CALL STRING MOVE DEF *+6 DEF KTEMP KTEMP DEF N3 IS MOVED TO DEF N2 SSTR DEF SSTR,I DEF .1 * LDA LEN GET LENGTH OF RESULT LDB SSTR GET STRING ADDRESS ADB M1 GET ADDRESS OF FIRST WORD STA 1,I STORE IN FIRST WORD OF STRING CLA,RSS SET MERR=0 OVFL LDA KEND SET MERR=KEND STA MERR,I * EXIT2 JMP D.MPY,I RETURN * * * * * * GSTR NOP HSTR NOP DERR NOP REM NOP D.DIV NOP JSB .ENTR DEF GSTR * CLA STA DERR,I INITIALIZE ERROR INDICATOR STA REM,I INITIALIZE REMAINDER INDICATOR LDA GSTR,I GET STRING CHARACTER COUNT STA JEND SAVE AS STRING END LDA HSTR,I GET CHARACTER COUNT OF 2ND STRING STA KEND SAVE AS STRING END ISZ GSTR ISZ HSTR * * LDA JEND COMPUTE EXTRA WORK SPACE ALS REQUIRED FOR THE COMPUTATION ADA KEND N1=(2*JEND)+KEND+1 INA STA N1 ADA KEND N2=(2*JEND)+(2*KEND) ADA M1 STA N2 * JSB SMOVE CALL STRING MOVE DEF *+6 DEF HSTR,I HSTR DEF .1 IS MOVED TO DEF KEND KTEMP DEF KTEMP DEF N1 * JSB SDIV CALL STRING DIVIDE DEF *+8 DEF GSTR,I GSTR DEF .1 IS DIVIDED INTO DEF JEND HSTR (IN KTEMP) DEF KTEMP DEF N1 DEF N2 DEF DERR,I * LDB DERR,I TEST ERROR INDICATOR LDA 1 SAVE IN A-REGISTER CMB,INB TEST FOR SDIV OVERFLOW cADB N2 (DERR=N2) SZB,RSS JMP OVFL2 YES SZA TEST FOR OTHER SDIV ERRORS JMP EXIT YES, ERROR RETURN LDA JEND CMA,INA ADA N1 STA N3 N3=N1-JEND * CMA,INA COMPUTE LENGTH OF QUOTIENT ADA N2 INA STA LEN SAVE AS RESULT STRING CHAR COUNT LDB PTRH,I GET ADDRESS OF RESULT STRING CMB,INB SUBTRACT FROM ADDRESS OF ERR PARM ADB PTRD,I BLS DOUBLE TO GET SPACE IN CHARACTERS CMA,INA ADB 0 COMPARE DIFFERENCE (DIM SPACE) SSB WITH SPACE NEEDED FOR QUOTIENT JMP OVFL2 NOT ENOUGH SPACE - OVERFLOW * JSB SMOVE CALL STRING MOVE DEF *+6 DEF KTEMP RESULT IN KTEMP DEF N3 IS MOVED TO DEF N2 HSTR DEF HSTR,I DEF .1 * LDA LEN GET LENGTH OF RESULT LDB HSTR GET STRING ADDRESS ADB M1 GET ADDRESS OF FIRST WORD STA 1,I * LDB JEND GET DIVISOR STRING CHAR. COUNT ADB M1 (JEND-1) IS RELATIVE LOCATION OF CMB,INB REMAINDER IN THE RESULT STRING ADB 0 CHARACTER COUNT - (JEND-1) STB REM,I POSITION OF REMAINDER IN RESULT CLA,RSS SET DERR=0 OVFL2 LDA KEND SET DERR=KEND STA DERR,I * EXIT JMP D.DIV,I RETURN * * * * PSTR NOP QSTR NOP EERR NOP D.EDT NOP ENTRY JSB .ENTR GET PARAMETERS DEF PSTR LDA PSTR,I GET STRING CHARACTER COUNT STA JEND SAVE AS STRING END LDB QSTR,I GET CHAR COUNT OF 2ND STRING CMA,INA TEST IF PSTR GREATER THAN QSTR ADA 1 SSA JMP OVFL3 YES, ERROR RETURN STB KEND NO, SAVE AS STRING END ISZ PSTR SKIP TO NEXT WOVRD OF EACH STRING ISZ QSTR * JSB SEDIT CALL STRING EDIT ROUTINE DEF *+7 DEF PSTR,I PSTR IS EDITED DEF .1 USING EDIT MASK DEF JEND IN QSTR DEF QSTR,I RESULT IN QSTR DEF .1 DEF KEND CLB SET ERROR INDICATOR TO ZERO OVFL3 STB EERR,I RETURN 0 OR KEND AS ERROR NUMBER * JMP D.EDT,I RETURN * * * * M1 DEC -1 .1 DEC 1 N1 BSS 1 N2 BSS 1 N3 BSS 1 KTEMP BSS 1020 JEND BSS 1 KEND BSS 1 LEN BSS 1 PTRD DEF DERR PTRH DEF HSTR PTRM DEF MERR PTRS DEF SSTR * END W V ` 92101-18022 1826 S C0122 BASIC SUBROUTINE LIBRARY HEADER             H0101 EASMB,R,L NAM BASLB,7 92101-12003 REV. 1826 780519 * BASLB SOURCE 92101-18022 * BASLB RELOC 92101-16022 END !  W] 92101-18023 1805 S C0122 &BATG4 RTE-IV B&M TABLE TRANSFER FILE BUILDER             H0101 ESPL,L,O ! NAME: T.TRF ! USE: PRODUCES TRANSFER FILES USED TO BUILD BASIC OVERLAYS ! SYSTEM: RTE-IV ! SOURCE: 92101-18023 ! RELOC: 92101-16023 ! PGRM: ADELE GADOL ! DATE: 760915 ! ! **************************************************************** ! * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1975. ALL RIGHTS * ! * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * ! * REPRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* ! * THE PRIOR WRITTEN CONSENT OF HEWLETT PACKARD COMPANY. * ! **************************************************************** ! NAME T.TRF(8) "92101-16023 REV.1805 771103" ! ! LET T.ENT, \ENTRY POINT NAMES T.DCB, \DCB BUFFER (IN MAIN) T.LEN, \# OF OVERLAYS T.SUB, \SUBROUTINE COUNT BUFFER T.OVB, \OVERLAY NAMES BUFFER T.SEC, \OV.DIR. SEC.CODE T.CRF, \OV.DIR. CART.# T.ERN, \ERROR NUMBER T.BRN \BRANCH TABLE BE INTEGER,EXTERNAL ! LET WRITF, \FMGR WRITE RECORD READF, \FMGR READ RECORD RWNDF, \FMGR REWIND CNUMD \CONVERT BINARY TO ASCII BE SUBROUTINE,EXTERNAL ! LET .DFER \3-WORD TRANSFER BE SUBROUTINE,DIRECT,EXTERNAL ! LET CONVT \CONVERT TO ASCII BE SUBROUTINE ! LET WRTRC, \ COMPR BE SUBROUTINE,DIRECT ! LET IABS \GET ABSOLUTE VALUE BE FUNCTION,DIRECT,EXTER.1NAL ! LET KCVT \BINARY TO ASCII (2-DIG) BE FUNCTION,EXTERNAL ! LET OVBUF, \OVERLAY NAMES POINTER ENBUF, \ENTRY POINTS POINTER SEQU(300), \SEQUENCE NUMBERS SEQBF, \SEQUENCE NUMBER POINTER BRBUF, \BRANCH TABLE POINTER LDREC(11), \":RU,LOADR,,##.RTG,6," OPCOD(3), \OPCODE FRMAT(3), \FORMAT SIZE, \SIZE MRREC(2), \" :" DUREC(2), \DU, OR ST, FNAME(3), \FILE NAME FSECS, \DELIMITER FSEC(3), \SECURITY CODE FICRS, \DELIMITER FICR(3), \CARTRIDGE REF. # TPREC(8), \",##.RTG,BR" PUREC(6), \":PU,##.RTG" TRREC(2) \"::" BE INTEGER ! INITIALIZE TRREC TO 1,"::" INITIALIZE LDREC,OPCOD,FRMAT,SIZE TO\ 17,":RU,LOADR,,##.RTG,6, , ,, " INITIALIZE MRREC,DUREC,FNAME,FSECS,FSEC, \ FICRS,FICR,TPREC TO 22,": ",1(0),", ",11(0),\ ",##.RTG,BR",1(0),",99 " INITIALIZE PUREC TO 5,":PU,##.RTG" ! ! ! THE CONTROL FORMAT FOR THE EACH OVERLAY IS AS FOLLOWS: ! ! +-----------------------------------------------+ ! !15!14!13!12!11!10! 9! 8! 7! 6! 5! 4! 3! 2! 1! 0! ! +-----------------------------------------------+ ! \OPTION /\ PAGE SIZE /\ SUBROUTINE CT / ! ! ! ! THE FOLLOWING SUBROUTINE CREATES THE TRANSFER ! FILE FOR LOADING OF THE FOREGROUND DEVICE ! SUBROUTINE OVERLAYS. IT WORKS WITH A BUFFER ! OF OVERLAY NAMES (WITH NUMBER OF SUBROUTINES IN ! IN EACH) AND A BUFFER OF SUBROUTINE NAMES. ! ! T.TRF: SUBROUTINE DIRECT,GLOBAL ! SEQBF _ @SEQU !SET UP POINTERS. ENBUF _ @T.ENT; BRBUF _ @T.BRN + 1 SZSUB _ @T.SUB; RWNDF(T.DCB) !REWIND FILE. ! REPEAT 300 TIMES DO \MOVE SEQUENCE [$SEQBF _ $BRBUF; \NUMBERS OUT SEQBF _ SEQBF + 1; \OF BRANCH TABLE. BRBUF _ BRBUF + 2] ! I _ 0 ALWAYS DO \READ IN ALL [READF(T.DCB,T.ERN,$ENBUF,5,J); \THE FILE NAMES. IF T.ERN THEN RETURN; \CHECK ERRORS. IF J = -1 THEN GOTO T.TR1; \FINISHED? ENBUF _ ENBUF + 5; I _ I + 1] !NO - CONTINUE. ! T.TR1: ENBUF _ @T.ENT; L _ 0 !RESET POINTER. SEQBF _ @SEQU REPEAT T.LEN TIMES DO [ \FOR EACH OVERLAY T.TR4: IFNOT $SZSUB THEN [ \BYPASS UNUSED SZSUB _ SZSUB + 1; GOTO T.TR4]; \OVERLAY NUMBERS. IF [I _ $SZSUB AND 77K] > 1 THEN[\DO THE FOLLOWING: FOR J _ (L+1) TO (L+I-1) DO \CHECK FOR DUPLICATE [FOR K _ L TO (J-1) DO \FILE NAMES AND [COMPR]]]; \MARK THEM. SZSUB _ SZSUB + 1; L _ L + I] !ADVANCE TO NEXT OVERLAY. ! RWNDF(T.DCB); SZSUB _ @T.SUB !REWIND FILE. ! I _ 0; OVBUF _ @T.OVB !FIX UP RECORDS TO WRTRC(PUREC) ? [RETURN] !WRITE :PU,##.RTG T.TR2: CONVT(T.SEC,T.CRF) !CONVERT CODES. T.TR3: IFNOT $SZSUB THEN [ \BYPASS UNUSED SZSUB _ SZSUB + 1; GOTO T.TR3] !OVERLAY NUMBERS. .DFER(FNAME,$OVBUF) !CREATE MR OF OVER- DUREC(1)_"ST" !SET TO FMGR :ST COMMAND TPREC(6),TPREC(7),TPREC(8) _" " gb !CLEAR OUT APPEND WRTRC(MRREC) ? [RETURN] !LAY DIRECTORY. REPEAT ($SZSUB AND 77K) TIMES DO [ \CREATE MR RECORDS. BRBUF _ 5 * $SEQBF + @T.ENT; \GET RIGHT NAME. IF $BRBUF THEN [ \IF NAME UNIQUE, .DFER(FNAME,$BRBUF); \MOVE IN NAME. CONVT($(BRBUF+3),$(BRBUF+4)); \CONVERT CODES. DUREC(1)_"DU"; \SET TO FMGR :DU COMMAND TPREC(6)_",2"; \SET TO APPEND FILE TPREC(7)_", "; \SET TO APPEND FILE TPREC(8)_"99"; \SET TO APPEND FILE WRTRC(MRREC) ? [RETURN]]; \WRITE RECORD. SEQBF _ SEQBF + 1] !INCREMENT POINTER. SIZE _ KCVT(($SZSUB -> 6) AND 77K) !LOADER PAGE SIZE. IF(($SZSUB-<4)AND 7K)=0 THEN[OPCOD(1)_"RT";FRMAT(1)_"PE"] !RT PERM IF(($SZSUB-<4)AND 7K)=1 THEN[OPCOD(1)_"RT";FRMAT(1)_"TE"] !RT TEMP IF(($SZSUB-<4)AND 7K)=2 THEN[OPCOD(1)_"BG";FRMAT(1)_"PE"] !BG PERM IF(($SZSUB-<4)AND 7K)=3 THEN[OPCOD(1)_"BG";FRMAT(1)_"TE"] !BG TEMP IF(($SZSUB-<4)AND 10K)THEN[OPCOD(2)_"SS"] ! SET SSGA FLAG OVBUF _ OVBUF + 3 !INCREMENT POINTER. SZSUB _ SZSUB + 1 WRTRC(LDREC) ? [RETURN] !WRITE RU RECORD. WRTRC(PUREC) ? [RETURN] !WRITE PURGE RECORD I _ I + 1 IF I < T.LEN THEN GOTO T.TR2 ! WRTRC(TRREC) !WRITE "::" RETURN END ! ! WRTRC: SUBROUTINE(BUF) DIRECT,FEXIT LET BUF BE INTEGER WRITF(T.DCB,T.ERN,$(@BUF+1),BUF) IF T.ERN THEN FRETURN RETURN END ! ! CONVT: SUBROUTINE(NUM1,NUM2) LET NUM1,NUM2 BE INTEGER .A. _ NUM1 CNUMD(IABS,FSEC) !CONVERT SECURITY CODE. IF NUM1 < 0 THEN FSECS _ ":-", \COMPENSATE FOR ELSE FSECS _ ": " !NEGATIVE NUMBER. .A. _ NUM2 CNUMD(IABS,FICR) !CONVERT CART. #. IF NUM2 < 0 THEN FICRS _ ":-", \COMPENSATE FOR ELSE FICRS _ ": " !NEGATIVE NUMBER. RETURN END ! ! COMPR: SUBROUTINE DIRECT,FEXIT BRBUF _ ENBUF + 5 * $(SEQBF+J) OVBUF _ ENBUF + 5 * $(SEQBF+K) !COMPARE TWO FIVE- REPEAT 5 TIMES DO [ \WORD ARRAYS AND IF $BRBUF # $OVBUF THEN RETURN; \MARK ONE OF THEM BRBUF _ BRBUF + 1; \WITH A ZERO IF OVBUF _ OVBUF + 1] !THEY MATCH. $(OVBUF-5) _ 0 RETURN END ! ! END END$ c X b 92101-18024 1805 S C0122 %BATG3 RTE-II/III TR FILE BUILDER FOR BASIC TBL GEN             H0101 SPL,L,O ! NAME: T.TRF ! USE: PRODUCES TRANSFER FILES USED TO BUILD BASIC OVERLAYS ! SYSTEM: RTE-II AND RTE-III ! SOURCE: 92101-18024 ! RELOC: 92101-16024 ! PGMR: ADELE GADOL ! DATE: 760915 ! ! **************************************************************** ! * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1975. ALL RIGHTS * ! * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * ! * REPRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* ! * THE PRIOR WRITTEN CONSENT OF HEWLETT PACKARD COMPANY. * ! **************************************************************** ! NAME T.TRF(8) "92101-16024 REV.1805 7711013" ! ! LET T.ENT, \ENTRY POINT NAMES T.DCB, \DCB BUFFER (IN MAIN) T.LEN, \# OF OVERLAYS T.SUB, \SUBROUTINE COUNT BUFFER T.OVB, \OVERLAY NAMES BUFFER T.SEC, \OV.DIR. SEC.CODE T.CRF, \OV.DIR. CART.# T.ERN, \ERROR NUMBER T.BRN \BRANCH TABLE BE INTEGER,EXTERNAL ! LET WRITF, \FMGR WRITE RECORD READF, \FMGR READ RECORD RWNDF, \FMGR REWIND CNUMD \CONVERT BINARY TO ASCII BE SUBROUTINE,EXTERNAL ! LET .DFER \3-WORD TRANSFER BE SUBROUTINE,DIRECT,EXTERNAL ! LET CONVT \CONVERT TO ASCII BE SUBROUTINE ! LET WRTRC, \ COMPR BE SUBROUTINE,DIRECT ! LET IABS \GET ABSOLUTE VALUE BE FUNCTION,DIRECT,EXTERNAL ! LET KCVT \BINARY TO ASCII (2-DIG) BE FUNCTION,EXTERNAL ! LET OVBUF, \OVERLAY NAMES POINTER ENBUF, \ENTRY POINTS POINTER SEQU(300), \SEQUENCE NUMBERS SEQBF, \SEQUENCE NUMBER POINTER BRBUF, \BRANCH TABLE POINTER LGREC(4), \":LG,10" LDREC(8), \":RU,LOADR,99,6,7" LDRC0(3), \ LDRC1, \ LDRC2(2), \ MRREC(3), \":MR,FILNAM" FNAME(3), \FILE NAME FSECS, \DELIMITER FSEC(3), \SECURITY CODE FICRS, \DELIMITER FICR(3), \CARTRIDGE REF. # MRCAL(3), \":MR,CALSB" TRREC(2) \"::" BE INTEGER ! INITIALIZE TRREC TO 1,"::" INITIALIZE LGREC TO 3,":LG,10" INITIALIZE LDREC,LDRC0,LDRC1,LDRC2 TO\ 13,":RU,LOADR,99,6,007, 000 " INITIALIZE MRREC,FNAME,FSECS,FSEC, \ FICRS,FICR TO 13,":MR,",11(0) INITIALIZE MRCAL TO "CALSB " ! ! ! THE FOLLOWING SUBROUTINE CREATES THE TRANSFER ! FILE FOR LOADING OF THE FOREGROUND DEVICE ! SUBROUTINE OVERLAYS. IT WORKS WITH A BUFFER ! OF OVERLAY NAMES (WITH NUMBER OF SUBROUTINES IN ! IN EACH) AND A BUFFER OF SUBROUTINE NAMES. ! ! T.TRF: SUBROUTINE DIRECT,GLOBAL ! SEQBF _ @SEQU !SET UP POINTERS. ENBUF _ @T.ENT; BRBUF _ @T.BRN + 1 SZSUB _ @T.SUB; RWNDF(T.DCB) !REWIND FILE. ! REPEAT 300 TIMES DO ǚ\MOVE SEQUENCE [$SEQBF _ $BRBUF; \NUMBERS OUT SEQBF _ SEQBF + 1; \OF BRANCH TABLE. BRBUF _ BRBUF + 2] ! I _ 0 ALWAYS DO \READ IN ALL [READF(T.DCB,T.ERN,$ENBUF,5,J); \THE FILE NAMES. IF T.ERN THEN RETURN; \CHECK ERRORS. IF J = -1 THEN GOTO T.TR1; \FINISHED? ENBUF _ ENBUF + 5; I _ I + 1] !NO - CONTINUE. ! T.TR1: ENBUF _ @T.ENT; L _ 0 !RESET POINTER. SEQBF _ @SEQU REPEAT T.LEN TIMES DO [ \FOR EACH OVERLAY T.TR4: IFNOT $SZSUB THEN [ \BYPASS UNUSED SZSUB _ SZSUB + 1; GOTO T.TR4]; \OVERLAY NUMBERS. IF [I _ $SZSUB AND 77K] > 1 THEN[\DO THE FOLLOWING: FOR J _ (L+1) TO (L+I-1) DO \CHECK FOR DUPLICATE [FOR K _ L TO (J-1) DO \FILE NAMES AND [COMPR]]]; \MARK THEM. SZSUB _ SZSUB + 1; L _ L + I] !ADVANCE TO NEXT OVERLAY. ! RWNDF(T.DCB); SZSUB _ @T.SUB !REWIND FILE. ! I _ 0; OVBUF _ @T.OVB !FIX UP RECORDS TO T.TR2: WRTRC(LGREC) ? [RETURN] !LOAD EACH OVERLAY. CONVT(T.SEC,T.CRF) !CONVERT CODES. T.TR3: IFNOT $SZSUB THEN [ \BYPASS UNUSED SZSUB _ SZSUB + 1; GOTO T.TR3] !OVERLAY NUMBERS. .DFER(FNAME,$OVBUF) !CREATE MR OF OVER- WRTRC(MRREC) ? [RETURN] !LAY DIRECTORY. REPEAT ($SZSUB AND 77K) TIMES DO [ \CREATE MR RECORDS. BRBUF _ 5 * $SEQBF + @T.ENT; \GET RIGHT NAME. IF $BRBUF THEN [ \IF NAME UNIQUE, .DFER(FNAME,$BRBUF); \MOVE IN NAME. CONVT($(BRBUF+3),$(BRBUF+4)); \CONVERT CODES. WRTRC(MRREC) ? [RETURN]]; \WRITE RECORD. SEQBF _ SEQBF + 1] !INCREMENT POINTER. LDR3C1 _ KCVT(($SZSUB -> 6) AND 77K) !LOADER PAGE SIZE. ! SET LOADER OPTION IF(($SZSUB -<4)AND 7K)=0 THEN[LDRC0(2)_(KCVT(6)AND 77K)OR 30000K] IF(($SZSUB -<4)AND 7K)=1 THEN[LDRC0(2)_(KCVT(5)AND 77K)OR 30000K] IF(($SZSUB -<4)AND 7K)=2 THEN[LDRC0(2)_(KCVT(8)AND 77K)OR 30000K] IF(($SZSUB -<4)AND 7K)=3 THEN[LDRC0(2)_(KCVT(0)AND 77K)OR 30000K] IF(($SZSUB -<4)AND 10K) THEN[LDRC0(1)_(KCVT(1)AND 77K)OR 26000K] OVBUF _ OVBUF + 3 !INCREMENT POINTER. SZSUB _ SZSUB + 1 WRTRC(LDREC) ? [RETURN] !WRITE RU RECORD. I _ I + 1 IF I < T.LEN THEN GOTO T.TR2 ! WRTRC(TRREC) !WRITE "::" RETURN END ! ! WRTRC: SUBROUTINE(BUF) DIRECT,FEXIT LET BUF BE INTEGER WRITF(T.DCB,T.ERN,$(@BUF+1),BUF) IF T.ERN THEN FRETURN RETURN END ! ! CONVT: SUBROUTINE(NUM1,NUM2) LET NUM1,NUM2 BE INTEGER .A. _ NUM1 CNUMD(IABS,FSEC) !CONVERT SECURITY CODE. IF NUM1 < 0 THEN FSECS _ ":-", \COMPENSATE FOR ELSE FSECS _ ": " !NEGATIVE NUMBER. .A. _ NUM2 CNUMD(IABS,FICR) !CONVERT CART. #. IF NUM2 < 0 THEN FICRS _ ":-", \COMPENSATE FOR ELSE FICRS _ ": " !NEGATIVE NUMBER. RETURN END ! ! COMPR: SUBROUTINE DIRECT,FEXIT BRBUF _ ENBUF + 5 * $(SEQBF+J) OVBUF _ ENBUF + 5 * $(SEQBF+K) !COMPARE TWO FIVE- REPEAT 5 TIMES DO [ \WORD ARRAYS AND IF $BRBUF # $OVBUF THEN RETURN; \MARK ONE OF THEM BRBUF _ BRBUF + 1; \WITH A ZERO IF OVBUF _ OVBUF + 1] !THEY MATCH. $(OVBUF-5) _ 0 RETURN END ! ! END END$  Y c 92101-18025 1813 S C0122 DEB$ DELETE BLANKS SUBROUTINE             H0101 ?ASMB,R,L,C HED DEB$, DELETE LEADING AND TRAILING BLANKS SUBROUTINE NAM DEB$,7 92101-16025 REV.1813 780105 ENT DEB$ EXT .ENTR,EXEC * *********************************************** * * * SOURCE: 92101-18025 * * RELOC.: 92101-16025 * * * *********************************************** * * * THIS SUBROUTINE DELETES LEADING AND * * TRAILING BLANKS IN A STRING AND RESETS * * THE LOGICAL LENGTH TO THE STRING * * LENGTH MINUS THE NUMBER OF LEADING * * AND TRAILING BLANKS.THE FORMAT OF * * THIS CALL IS AS FOLLOWS: * * * * XXXX DEB$(A$) * * * * WHERE: A$=ANY VALID STRING * * * *********************************************** CPAR DEF * DEB$ NOP JSB .ENTR RETRIEVE PARAMETERS DEF CPAR * * LDA .0 LOAD ZERO STA TBLKS INITIALIZE # OF TRAILING BLANKS STA LBLKS AND LEADING BLANKS TO ZERO * * * CHECK FIRST WORD OF STRING PASSED FOR NONZERO LENGTH * IF LENGTH IS ZERO, STRING IS NOT INITIALIZED AND WE * WILL EXIT WITHOUT DOING ANYTHING TO IT. * * LDA CPAR,I LOAD FIRST WORD OF STRING AND B177 MASK LOWER BYTE(LENGTH) SZA,RSS LENGTH=0? JMP ERR1 YES,EXIT WITH MESSAGE STA WLGTH NO,SAVE WORKING STRING LENGTH STA OLGTH AND ORIGINAL STRING LENGTH * * CLB DIV .2 DIVIDE LENGTH BY TWO SZB REMAINDER=0? INA NO(ODD #OF CHARS),ADD 1 TO WORD COUNT STA WORDS AND SAVE # OF WORDS IN STRING * * LDA CPAR LOAD ADDRESS OF FIRST WORD IN STRING ADA WORDS INCREMENT TO ADDRESS ADA M1 OF LAST WORD IN STRING STA WADDR AND SAVE IN WORKING ADDRESS * * LDA WADDR,I LOAD LAST WORD IN STRING SZB,RSS ODD # OF CHARACTERS IN STRING? JMP TBLK1 NO, EVEN # OF CHARACTERS * * AND B7740 YES,MASK UPPER BYTE CPA SBLKU UPPER BYTE=BLANK? JMP TBLK4 YES JMP LBLK1 NO TRAILING BLANKS,CHECK FOR LEADING BLANKS * * TBLK1 CPA DBLNK IS WORD A DOUBLE BLANK? JMP *+2 YES JMP TBLK3 NO,CHECK FOR BLANK IN LOWER BYTE * * LDA WLGTH LOAD CURRENT STRING LENGTH ADA M2 DECREMENT BY 2 STA WLGTH AND SAVE * * LDA TBLKS LOAD CURRENT # OF TRAILING BLANKS ADA .2 INCREMENT BY 2 STA TBLKS AND SAVE * * TBLK2 LDA WADDR LOAD CURRENT STRING WORD ADDRESS ADA M1 DECREMENT ADDRESS BY 1 STA WADDR AND SAVE * * LDA WADDR,I LOAD NEXT WORD JMP TBLK1 CHECK FOR DOUBLE BLANKS * * TBLK3 AND B177 MASK LOWER BYTE CPA SBLKL LOWER BYTE=BLANK? JMP TBLK4 YES JMP TBLK5 NO MORE TRAILING BLANKS * * TBLK4 LDA WLGTH LOAD CURRENT STRING LENGTH ADA M1 DECREMENT BY 1 STA WLGTH AND SAVE * * LDA TBLKS LOAD CURRENT # OF TRAILING BLANKS ADA .1 INCREMENT BY 1 STA TBLKS AND SAVE * * SZB,RSS ODD # OF CHARACTERS FLAG=0? JMP TBLK5 YES,NO MORE TRAILING BLANKS * * CLB NO,CLEAR ODD # OF CHARACTERS FLAG JMP TBLK2 CHECK NEXT WORD FOR BLANKS * * * IF STRING IS ALL BLANKS,THEN EXIT WITH MESSAGE AND * DON'T DO ANYTHING TO STRING. * * TBLK5 LDA TBLKS LOAD TOTAL # OF TRAILING BLANKS CMA,INA MAKE NEGATIVE ADA OLGTH ADD TO ORIGINAL STRING LENGTH SZA,RSS IS IT ZER0? JMP ERR2 YES,STRING IS ALL BLANKS,EXIT * * * * * THIS PART OF THE SUBROUTINE * CHECKS FOR LEADING BLANKS * * * LBLK1 LDB CPAR LOAD ADDRESS OF FIRST WORD OF STRING INB INCREMENT TO SECOND WORD LDA 1,I LOAD SECOND WORD IN STRING * * LBLK2 CPA DBLNK IS WORD A DOUBLE BLANK? JMP *+2 YES JMP LBLK3 NO,CHECK FOR BLANK IN UPPER BYTE * * LDA WLGTH LOAD CURRENT STRING LENGTH ADA M2 DECREMENT LENGTH BY 2 STA WLGTH AND SAVE * * LDA LBLKS LOAD CURRENT # OF LEADING BLANKS ADA .2 ADD 2 STA LBLKS AND SAVE * * INB INCREMENT WORKING ADDRESS BY 1 * * LDA 1,I LOAD NEXT WORD JMP LBLK2 CHECK NEXT WORD FOR BLANKS * * LBLK3 AND B7740 MASK UPPER BYTE CPA SBLKU UPPER BYTE=BLANK? JMP *+2 YES JMP RFMT NO MORE LEADING BLANKS * * LDA WLGTH LOAD CURRENT STRING LENGTH ADA M1 DECREMENT BY 1 STA WLGTH AND SAVE * * LDA LBLKS LOAD CURRENT # OF LEADING BLANKS INA ADD 1 STA LBLKS AND SAVE * * * * THIS SECTION OF THE SUBROUTINE RESETS THE STRING * LENGTH IN THE FIRST WORD AND DELETES LEADING * BLANKS BY SHIFTING THE STRING TO THE LEFT * * (A)=# OF LEADING BLANKS * (B)=CURRENT WORKING ADDRESS OF STRING * =FIRST WORD WITH A NON-BLANK CHARACTER IN IT * * RFMT CMA,INA MAKE # OF LEADING BLANKS NEGATIVE ADA OLGTH ADD TO ORIGINAL STRING LENGTH STA CPAR,I SAVE NEW LENGTH IN FIRST WORD OF STRING STA WLGTH AND IN STRING WORKING LENGTH * * LDA CPAR LOAD ADDRESS OF FIRST WORD IN STRING INA INCREMENT TO SECOND WORD STA SADDR AND SAVE IN NEW STRING ADDRESS * * LDA LBLKS LOAD # OF LEADING BLANKS SLA,RSS # OF LEADING BLANKS ODD? JMP RFMT2 NO,EVEN * * RFMT1 LDA 1,I L~%OAD NON-BLANK WORD FROM STRING AND B177 MASK LOWER BYTE ALF,ALF ROTATE TO UPPER BYTE STA SADDR,I STORE IN NEW STRING LOCATION * * LDA WLGTH LOAD NEW STRING LENGTH COUNTER ADA M1 DECREMENT BY 1 STA WLGTH AND SAVE * * SZA,RSS LENGTH COUNTER=0? JMP EXIT YES,EXIT * * INB INCREMENT WORKING ADDRESS OF STRING * * LDA 1,I LOAD NEXT NON-BLANK WORD AND B7740 MASK UPPER BYTE ALF,ALF ROTATE TO LOWER BYTE STA SADDR,I STORE IN NEW STRING LOCATION * * LDA WLGTH LOAD NEW STRING LENGTH COUNTER ADA M1 DECREMENT LENGTH BY 1 STA WLGTH AND SAVE * * SZA,RSS LENGTH COUNTER=0? JMP EXIT YES,EXIT * * LDA SADDR NO,LOAD NEW STRING LOCATION INA INCREMENT BY 1 STA SADDR AND SAVE * * JMP RFMT1 GET NEXT CHARACTER * * RFMT2 LDA 1,I LOAD NEXT WORD AND B7740 MASK UPPER BYTE STA SADDR,I STORE IN NEW STRING LOCATION * * LDA WLGTH LOAD NEW STRING LENGTH COUNTER ADA M1 DECREMENT BY 1 STA WLGTH AND SAVE * * SZA,RSS NEW STRING LENGTH COUNTER=0? JMP EXIT YES, EXIT * * LDA 1,I LOAD CURRENT WORKING WORD AND B177 MASK LOWER BYTE STA SADDR,I STORE IN NEW STRING LOCATION * * LDA WLGTH LOAD NEW STRING LENGTH COUNTER ADA M1 DECREMENT BY 1 STA WLGTH AND SAVE * * SZA,RSS NEW STRING LENGTH COUNTER=0? JMP EXIT YES,EXIT * * LDA SADDR NO,LOAD NEW STRING ADDRESS INA INCREMENT BY 1 STA SADDR AND SAVE * * INB INCREMENT STRING WORKING ADDRESS JMP RFMT2 GET NEXT NON-BLANK WORD * * * MESSAGES * * ERR1 LDA MSG1  LOAD MESSAGE BUFFER ADDRESS STA IBUFR AND SAVE LDA MSGL1 LOAD MESSAGE BUFFER LENGTH ADDRESS STA IBUFL AND SAVE JMP OUTPT OUTPUT MESSAGE * * ERR2 LDA MSG2 LOAD MESSAGE BUFFER ADDRESS STA IBUFR AND SAVE LDA MSGL2 LOAD MESSAGE BUFFER LENGTH ADDRESS STA IBUFL AND SAVE * * OUTPT JSB EXEC OUTPUT MESSAGE TO SYSTEM CONSOLE DEF *+5 DEF .2 DEF .1 DEF IBUFR DEF IBUFL * * EXIT JMP DEB$,I EXIT * * * * CONSTANTS * .0 DEC 0 TBLKS BSS 1 LBLKS BSS 1 B177 OCT 177 WLGTH BSS 1 OLGTH BSS 1 .2 DEC 2 WORDS BSS 1 M1 DEC -1 WADDR BSS 1 B7740 OCT 77400 SBLKU OCT 20000 DBLNK OCT 20040 M2 DEC -2 SBLKL OCT 40 .1 DEC 1 SADDR BSS 1 IBUFR BSS 1 IBUFL BSS 1 MSG1 ASC 14,STRING NOT INITIALIZED-DEB$ MSGL1 DEC 14 MSG2 ASC 11,STRING ALL BLANKS-DEB$ MSGL2 DEC 11 * * END  Z d 92101-18026 1813 S C0122 BLK$ INITIALIZE STRING SUBROUTINE             H0101 qASMB,R,L,C HED BLK$, INITIALIZE STRING SUBROUTINE NAM BLK$,7 92101-16026 REV.1813 780105 ENT BLK$ EXT .ENTR,EXEC * *********************************************** * * * SOURCE: 92101-18026 * * RELOC.: 92101-16026 * * * *********************************************** * * * THIS SUBROUTINE INITIALIZES A STRING * * TO A SPECIFIED NUMBER OF ASCII BLANKS. * * THE FORMAT OF THE CALL IS AS FOLLOWS: * * * * XXXX CALL BLK$(N,A$) * * * * WHERE: N=POSITIVE NUMBER OF BLANKS IN * * RANGE OF 1 TO 255.N MUST BE * * <= THE DIMENSION OF STRING. * * A$=ANY VALID STRING NAME * * * *********************************************** CPAR BSS 2 PARAMETER STORAGE:WORD 1 IS # OF BLANKS * WORD 2 IS STRING ADDRESS BLK$ NOP JSB .ENTR RETRIEVE PARAMETERS DEF CPAR * * * CHECK THE FIRST PARAMETER TO MAKE SURE THAT IT IS VALID * * LDA CPAR,I LOAD FIRST PARM(# OF BLANKS) SZA,RSS # OF BLANKS=0? JMP ERROR YES,INVALID VALUE,EXIT WITH ERROR SSA NO,BUT IS # OF BLANKS NEGATIVE? JMP ERROR YES,INVALID VALUE,EXIT WITH ERROR ADA M256 ADD -256 TO # OF BLANKS SSA,RSS IS RESULT POSITIVE? JMP ERROR YES,INVALID VALUE,EXIT WITH ERROR * * LDA CPAR,I LOAD # OF BLANKS STA CPAR+1,I STORE IN FIRST WORD OF STRING * * CLB STB CFLG SET ODD # OF CHARACTERS FLAG=0 * * SLA,RSS IS # OF BLANKS ODD? JMP *+4 NO ADA M1 YES,SUBTRA  CT ONE FROM COUNT INB SET ODD # OF CHARACTERS FLAG=1 STB CFLG AND SAVE STA COUNT SAVE CHARACTER COUNT * * LDB CPAR+1 LOAD ADDRESS OF FIRST WORD OF STRING INB INCREMENT TO SECOND WORD * * SZA,RSS COUNT=0? JMP BLK$2 YES,SEE IF SINGLE BLANK REQUIRED * * * (B) REGISTER=WORKING ADDRESS * * BLK$1 LDA DBLNK LOAD DOUBLE ASCII BLANK STA 1,I STORE IN CURRENT STRING WORD * * INB INCREMENT WORKING ADDRESS BY 1 * * LDA COUNT LOAD WORD COUNT ADA M2 DECREMENT BY TWO STA COUNT AND SAVE * * SZA COUNT=0? JMP BLK$1 NO,GO STORE ANOTHER DOUBLE BLANK * * * (B) REGISTER=WORKING ADDRESS * * BLK$2 LDA CFLG YES,LOAD ODD # OF CHARACTERS FLAG SZA,RSS FLAG=0? JMP EXIT YES,EXIT * * LDA SBLNK ODD # OF CHARACTERS,LOAD SINGLE BLANK STA 1,I AND STORE IN CURRENT STRING WORD JMP EXIT EXIT * * ERROR JSB EXEC DEF *+5 DEF .2 OUTPUT ERROR MESSAGE DEF .1 FOR INVALID FIRST PARM DEF IBUFR DEF IBUFL * * EXIT JMP BLK$,I EXIT * * * * CONSTANTS * CPAR1 BSS 1 CPAR2 BSS 1 M256 DEC -256 CFLG BSS 1 M1 DEC -1 COUNT BSS 1 DBLNK OCT 20040 M2 DEC -2 SBLNK OCT 20000 .1 DEC 1 .2 DEC 2 IBUFR ASC 14,ILLEGAL FIRST PARAMETER-BLK$ IBUFL DEC 14 END  [b 92200-18001 A S 0122 2607A LINEPRINTER DRIVER DVR12             H0101 *ASMB,R,B,L,C HED *** RTE 2607A LINE PRINTER DRIVER *** * * NAM DVR12 * * ENT I.12,C.12 * * ************************************************** * * RELOC. TAPE: 92200-16001 REV. A * ERS: A-92200-16001-1 * LISTING: A-92200-16001-2 * SOURCE TAPE: 92200-18001 REV. A * ************************************************** * * * M. SCHOENDORF MAY 13, 1974 REV. A * * * CALLING SEQUENCE * * A. CONTROL * ------- * * EXT EXEC * . * . * JSB EXEC TRANSFER CONTROL TO RTE * DEF *+4(OR 3)* POINT OF RETURN FROM RTE * DEF ICODE REQUEST CODE * DEF ICNWD CONTROL INFORMATION * DEF IPRAM FORMAT * * * 1) LINE SPACING * * ICODE - DEC 3 (I/O CONTROL) * ICNWD - OCT 11XX (LIST OUTPUT LINE SPACING) * WHERE XX IS THE LOGICAL UNIT NUMBER * IPRAM - * DECIMAL MEANING * PARAMETER WORD * * LESS THAN 0 PAGE EJECT. * * 0 DRIVER PERFORMS NO ACTION. * * 1 TO 55 SPACE 1 TO 55, IGNORING * PAGE BOUNDARIES. * * * 56 TO 63 USE CARRIAGE CONTROL CHAN- * NEL N, WHERE N = WORD-55. * (SEE CARRIAGE CONTROL * CHANNELS BELOW.) * * 64 SET AUTOMATIC PAGE EJECT MODE. * * 65 CLEAR AUTOMATIC PAGE EJECT MODE. * * CARRIAGE CONTROL CHANNELS * * IF THE PARAMETER WORD IS 56 TO 63, THE PRINTER * SPACES USING THE STANDARD CARRIAGE CONTROL CHANNELS, * WHICH HAVE THE FOLLOWING MEANINGS. * * CHANNEL 1 (56) SINGLE SPACE WITH AUTOMATIC PAGE EJECT. * * CHANNEL 2 (57) SKIP TO THE 6NEXT ODD LINE WITH AUTOMATIC * PAGE EJECT. * * CHANNEL 3 (58) SKIP TO THE NEXT TRIPLE LINE WITH AUTO- * MATIC PAGE EJECT. * * CHANNEL 4 (59) SKIP TO THE NEXT 1/2 PAGE BOUNDARY.. * * CHANNEL 5 (60) SKIP TO THE NEXT 1/4 PAGE BOUNDARY. * * CHANNEL 6 (61) SKIP TO THE NEXT 1/6 PAGE BOUNDARY. * * CHANNEL 7 (62) SKIP TO THE BOTTOM OF THE PAGE. * * CHANNEL 8 (63) SKIP TO THE TOP OF THE NEXT PAGE. * * 2) DYNAMIC STATUS * * ICODE - DEC 3 (I/O CONTROL) * ICNWD - OCT 6XX (DYNAMIC STATUS) XX IS THE * LOGICAL UNIT NUMBER * * * B. PRINTING * -------- * * EXT EXEC * . * . * JSB EXEC TRANSFER CONTROL TO RTE * DEF *+5 POINT OF RETURN FROM RTE * DEF ICODE REQUEST CODE * DEF ICNWD CONTROL INFORMATION * DEF IBUFR BUFFER LOCATION * DEF IBUFL BUFFER LENGTH * * ICODE - DEC 2 (PRINT) * ICNWD - OCT CONWD * WHERE CONWD CONTAINS SEVERAL FIELDS DEFINING * THE NATURE OF THE DATA TRANSFER. * (V BIT = BIT 7 AND X BIT = BIT 10) * 1) IF THE V BIT IS SET TO 1, THE DRIVER PRINTS THE * FIRST CHARACTER IN THE BUFFER ALONG WITH THE REST * OF THE BUFFER CONTENTS AND THE DRIVER SINGLE SPACES. * 2) IF V IS SET TO ZERO, THE FIRST CHARACTER OF THE * BUFFER IS USED FOR LINE CONTROL AND IS * PRINTED AS A BLANK IN COLUMN ONE OF THE PRINTER. * THE MEANING OF THE CONTROL CHARACTERS ARE: * * CHARACTER MEANING * * BLANK SINGLE SPACE (PRINT ON EVERY LINE). * 0 DOUBLE SPACE (PRINT ON EVERY OTHER * LINE). * 1 EJECT THE CURRENT PAGE AND THEN PRINT. * * SINGLE SPACE (PRINT ON EVERY LINE). * ANY OTHER CHAR. SINGLE SPACE (PRINT ON EVERY LINE). * * 3) IF THE X-BIT = 1, HONESTY MODE IS SPECIFIED WHICH MEANS * THAT THE USER'S DATA IS OUTPUT DIRECTLY TO THE LINE * PRINTER. THIS MEANS THE USER IS RESPONSIBLE FOR * SUPPLYING HIS OWN CARRIAGE RETURN,LINE-FEED, OR FORM- * FEED CHARACTERS. * * * STATUS WORD (EQT 5) * ------------------- * * BIT CONTENTS * 7 TOP OF FORM * 6 DEMAND (1=IDLE) * 5 ON LINE (1=ON LINE) * 4 READY (0=POWER ON) * 1 AUTOMATIC PAGE EJECT MODE * OTHER BITS FOR INTERNAL USE ONLY * * SKP * * ENTRY/EXIT OF INITIATION SECTION * * I.12 NOP ENTRY/EXIT JSB SETIO SET I/O INSTRUCTIONS FOR UNIT CLA CLEAR SWITCHES STA EQT9,I ASCII DATA TO BE OUTPUT LDA SINGL SINGLE SPACE W AUTO PAGE EJECT STA EQT10,I END OF MESSAGE CODE INITIALIZED LDA EQT5,I STATUS WORD AND MM402 STA EQT5,I RESET BITS 0,2,3,4,5,6,7 LDA .3 READY REJECT CODE LDB EQT6,I GET CONTROL WORD OF REQUEST CPB B603 IS REQUEST FOR DYNAMIC STATUS LDA .4 YES, GIVE IMMEDIATE COMPLETION JSB STAT CHECK STATUS JMP I.12,I STATUS EXIT LDA EQT6,I GET CONTROL WORD OF REQUEST AND .3 ISOLATE CPA .2 CHECK IF WRITE REQUEST JMP PRINT YES, SO GO PROCESS CPA .3 CHECK IF CONTROL REQUEST JMP CNTRL YES CLA,INA NO, REQUEST CODE ERROR JMP I.12,I RETURN TO I/O CONTROL * .3 DEC 3 B603 OCT 603 B1103 OCT 1103 MM402 OCT 177402 * SKP * PROCESS CONTROL REQUEST SPC 2 CNTRL LDA EQT6,I FETCH CONTROL WORD CPA B603 DYNAMIC STATUS? JMP I.A.4 YES, EXIT CPA B1103 LINE SPACING REQUEST ? JMP *+3 YES RJECT LDA .2 CONTROL REQUEST CODE ERROR JMP EXIT LDA DEQT7,I CONTROL FUNCTION PARAMETER SZA,RSS IF PARAMETER ZERO, JMP I.A.4 IGNORE SUPPRESS SPACE SSA IF NEG, THEN PAGE EJECT JMP NEG GO PAGE EJECT ADA M64 SSA,RSS SKIP IF NOT AUTO-PAGE EJECT MODE JMP E6465 GO HANDLE AUTO-PAGE EJECT FUNCTION LDA EQT7,I CONTROL FUNCTION PARAMETER STA B ADA M56 IS REQUEST FOR A TAPE LEVEL SSA,RSS NO, SKIP TESTS JMP B5663 YES, DO TESTS JSB SLEW B HAS NO. OF LINES TO SLEW JMP EXIT0 A=0 EXIT - SUCCESSFUL INITIATION B5663 ADB .10 ADD 10 TO TAPE LEVEL CPB B110 IS VALUE NOW 110B ADB M7 YES, SET IT TO LEVEL #2 CPB B111 IS VALUE NOW 111B ADB M9 YES, SET TO LEVEL #1 LDA B IOR MNEG SET SPACE COMMAND BIT JMP SPACE GO SPACE E6465 ADA M2 =B-2 SSA,RSS SKIP IF CODE LEGAL JMP RJECT GO REJECT ADA .2 ALS SHIFT INTO POSITION STA B LDA EQT5,I PICK UP STATUS AND M3 CLEAR AUTO-PAGE-EJECT BIT IOR B SET NEW VALUE STA EQT5,I I.A.4 LDA .4 IMMEDIATE COMPLETION EXIT JMP EXIT NEG LDA EQT5,I IOR B200 SET TOP-OF-FORM STATUS STA EQT5,I LDA PEJEC PAGE EJECT CODE SPACE JSB POUT OUTPUT EXIT0 CLA EXIT JSB CLEAR CLEAR HONESTY MODE FLAGS JMP I.12,I EXIT * .2 DEC 2 M3 DEC -3 M7 DEC -7 M9 DEC -9 M56 DEC -56 M64 DEC -64 B110 OCT 110 B111 OCT 111 SING OCT 100001 * SKP * PROCESS A PRINT REQUEST SPC 2 PRINT LDA EQT7,I CONVERT BUFFER ADDRESS TO RAL BUFFER CHARACTER STA EQT7,I ADDRESS LDA EQT5,I AND .2 CHECK FOR SS WITHOUT PAGE EJECT SZA,RSS JMP *+3 LDA SING STA EQT10,I SS WITHOUT PAGE EJECT IS DESIRED LDA EQT8,I CONVERT WORD OR CHARACTER SSA COUNT TO CHARACTER JMP *+3 ALS CMA,INA STA EQT9,I STORE CHARACTER COUNT SZA,RSS SKIP IF NOT ZERO LENGTH LINE JMP CHARS SPC 1 JSB CKNAM CHECK IF ASMB,FTN,ALGOL, OR EDIT JMP CHARS SPC 1 LDB EQT7,I GET BUFFER CHARACTER RBR ADDRESS LDA B,I GET FIRST CHARACTER IN BUFFER ALF,ALF AND B177 JSB HNSTY CHECK IF HONESTY MODE JMP GTCWD NOT IN HONESTY MODE JMP I.A.0 HONESTY MODE JMP I.A.4 HONESTY MODE (NO MORE DATA) LDB EQT7,I GET BUFFER CHARACTER ERB ADDRESS LDA B,I GET SECOND CHARACTER IN BUFFER AND B177 JSB HNSTY CHECK IF HONESTY MODE NOP MUST BE HONESTY JMP I.A.0 HONESTY EXIT GTCWD LDB EQT6,I GET CONTROL WORD BLF,BLF BIT 7=1? I.E., SSB 1ST CHAR = LINE CNTRL. JMP VEQ1 NO. OUTPUT AS DATA CPA B61 CHECK IF PAGE EJECT RSS JMP CNEQ1 LDA EQT5,I IOR B10 SET FLAG FOR RETURN STA EQT5,I JMP NEG CNEQ1 CPA B60 CHECK IF DOUBLE SPACE JMP I.12K LDA B40 ASCII BLANK CHARACTER VEQ1 JSB POUT ISZ EQT7,I ELSE BLANK - INC BUF CHR ADDRESS ISZ EQT9,I NOP JSB TIMER WAIT FOR FLAG RSS NO FLAG CHARS JSB LOUT OUTPUT CHARS AND PRINT JMP EXIT0 I.12K LDA EQT5,I IOR B10 SET FLAG FOR RETURN STA EQT5,I LDA SINGL SINGLE SPACE W AUTO PAGE EJECT JMP SPACE I.A.0 CLA JMP I.12,I EXIT * .4 DEC 4 M2 DEC -2 M5 DEC -5 B10 OCT 10 B60 OCT 60 B61 OCT 61 B177 OCT 177 B200 OCT 200 * SKP * ENTRY/EXIT OF COMPLETION SECTION SPC 2 C.12 NOP ENTRY/EXIT JSB SETIO SET I/O INSTRUCTIONS FOR UNIT NLDA EQT1,I SPURRIOUS INTERRUPT? SZA,RSS JMP C.12E YES, EXIT. CLA,INA READY REJECT CODE JSB STAT CHECK STATUS JMP CEXIT STATUS ERROR EXIT LDB EQT6,I GET CONTROL WORD OF REQUEST. BLF,RBL SSB HONESTY MODE? JMP C10.C YES LDA EQT5,I GET STATUS WORD SLA,RSS TIMER FLAG SET? JMP CA NO AND M2 YES, RESET FLAG AND FINISH THE STA EQT5,I OPERATION JMP C10.C CA LDA EQT5,I GET STATUS WORD AND .4 ISOLATE SLEW BIT SZA,RSS JMP C.12B CHECK DATA OUT, NO LINES TO SLEW LDA EQT5,I MORE LINES TO SLEW AND M5 CLEAR SLEW BIT STA EQT5,I STORE NEW STATUS LDB EQT7,I GET NO OF LINES LEFT TO SLEW JSB SLEW SLEW SOME MORE LINES JMP C.12E TAKE CONTINUATION RETURN C.12B LDA EQT9,I GET DATA COUNTER SZA,RSS ALL DATA OUT? JMP COMPL YES, SO GO TO COMPLETION PROCESS LDA EQT5,I CHECK LAST OPERATION FOR DOUBLE AND B10 SPACE OR PAGE EJECT SZA,RSS JMP C10.C NEITHER XOR EQT5,I LAST OP WAS DBL SP OR PG EJ STA EQT5,I RESET BIT 3 LDA B40 ASCII BLANK CHARACTER JSB POUT OUTPUT BLANK ISZ EQT7,I INCREMENT BUFFER CHARACTER ADDR ISZ EQT9,I INCREMENT CHARACTER OUTPUT COUNT NOP JSB TIMER WAIT FOR FLAG JMP C.12E NO FLAG, EXIT JMP C.12L FLAG, GET NEXT CHARACTER C10.C LDA EQT11,I ANY BLANKS LEFT TO OUTPUT? SZA,RSS JMP C.12D NO JSB BLOUT YES, GO OUTPUT THEM JMP C.12E EXIT C.12L JSB LOUT GO PRINT LINE C.12E ISZ C.12 JMP CEXIT CONTINUATION EXIT C.12D LDA EQT9,I GET DATA COUNTER SZA,RSS JMP COMPL NO MORE DATA, EXIT JMP C.12L MORE DATA, GET NEXT CHARACTER SPC 2 COMPL CLA LDB EQT8,I GET BUFFER LENGTH SSB MAKE B POSITIVE CHARACTER OR CMB,INB WORD COUNT I04 CLC 0 CLEAR CONTROL CEXIT STB TEMP1 SAVE B REGISTER STA TEMP2 SAVE A REGISTER LDA EQT6,I GET CONTROL WORD ALF,RAL SSA HONESTY MODE? JMP EXIT2 YES, EXIT JSB CLEAR NO, CLEAR H. M. COUNTERS/FLAG EXIT2 LDB TEMP1 RESTORE B REGISTER LDA TEMP2 RESTORE A REGISTER JMP C.12,I COMPLETION EXIT * TEMP1 NOP TEMP2 NOP .10 DEC 10 B40 OCT 40 MNEG OCT 100000 * SKP * * SUBROUTINE TO OUTPUT BLANKS IF IN HONESTY MODE * AND ONLY A LINE FEED IS OUTPUTTED * BLOUT NOP LDA B40 ASCII BLANK OTAIN OTA 0 OUTPUT IT STCIN STC 0,C ENCODE DEVICE ISZ EQT11,I INCREMENT BLANK COUNTER JMP SFCIN MORE BLANKS ISZ BLOUT NO MORE BLANKS JMP BLOUT,I SFCIN SFC 0 CHECK FOR FLAG JMP OTAIN FLAG JSB TIMER WAIT FOR FLAG JMP BLOUT,I NO FLAG, EXIT JMP BLOUT+1 FLAG, OUTPUT NEXT BLANK * * SUBROUTINE TO CONFIGURE I/O INSTRUCTIONS * SETIO NOP ENTRY/EXIT IOR SFC FORM SFC COMMAND STA LOU1 STA TIM1 STA SFCIN ADA B400 FORM OTA I/O COMMAND STA POUT+1 STA OTAIN ADA B1100 FORM STC COMMAND STA POUT+2 STA STCIN ADA B2600 FORM LIB COMMAND STA STAT1 ADA B200 FORM CLC COMMAND STA I04 JMP SETIO,I EXIT * SFC SFC 0 B400 OCT 400 B1100 OCT 1100 B2600 OCT 2600 * * * SUBROUTINE TO GET CHARACTER AND OUTPUT IT * LOUT NOP ENTRY/EXIT LDA EQT9,I PICK UP NUMBER OF CHARS SZA,RSS SKIP IF ANY LEFT JMP LOU3 NO, GO OUTPUT END-OF-LINE CHAR JMP LOU6 LOU1 SFC 0 SKIP IF PREV CHAR NOT ACCEPTED JMP LOU2 GO OUTPUT NEXT CHAR JSB TIMER GO TIME OUT JMP LOUT,I TIME-OUT,TAKE ERROR EXIT LOU2 LDA EQT9,I GET DATA COUNTER SZA MORE DATA? JMP LOU6 YES, GO GET NEXT CHARACTER LOU3 LDA EQT6,I GET CONTROL WORD ALF,RAL SSA HONESTY MODE? JMP LOUT,I YES, EXIT LDA EQT10,I GET END -OF-LINE CHAR. JSB POUT OUTPUT IT CLA STA EQT13,I CLEAR LINE LENGTH COUNTER JMP LOUT,I TAKE COMPLETION EXIT LOU6 LDB EQT7,I PICK UP ADDRESS OF CHAR CLE,ERB LDA B,I PICK UP WORD CONTAINING CHAR SEZ,RSS SKIP IF RIGHT CHAR ALF,ALF ROTATE AND B177 MASK OFF ANY EXTRANEOUS BITS JSB HNSTY CHECK IF HONESTY MODE JMP LOU7 NOT HONESTY MODE JMP LOUT,I HONESTY MODE JMP COMPL HONESTY MODE, NO MORE DATA JMP C.12L HON. MODE, LAST OP LF OR CR/LF LOU7 JSB POUT OUTPUT CHAR ISZ EQT7,I INCREMENT BUF. CHAR. ADDRESS ISZ EQT9,I INCREMENT CHAR. OUTPUT COUNTER NOP JMP LOU1 CHECK FOR FLAG * .12 DEC 12 .13 DEC 13 PEJEC OCT 100100 SINGL OCT 100102 * * SUBROUTINE TO DETERMINE IF IN HONESTY MODE * HNSTY NOP LDB EQT6,I GET CONTROL WORD BLF,RBL SSB,RSS HONESTY MODE? JMP HNSTY,I NO, EXIT ISZ HNSTY INCREMENT RETURN ADDRESS CPA .12 ASCII CHAR. = PAGE EJECT? LDA PEJEC YES, LOAD PAGE EJECT CODE CPA .13 ASCII CHAR. = CAR. RET.? LDA SINGL YES, LOAD CAR. RET. CODE CPA .10 ASCII CHAR. = LINE FEED? JMP LINFD YES, PROCESS LINE FEED JSB POUT OUTPUT DATA CPA PEJEC ASCII CHAR. = PAGE EJECT JSB CLEAR YES, CLEAR H. M. COUNTERS/FLAG CPA SINGL ASCII CHAR. = CAR. RET.? JMP CARTN YES, PROCESS CAR. RET. CLA CLEAR HONESTY MODE FLAG STA EQT12,I INCR ISZ EQT7,I INCREMENT BUF. CHAR. ADDRESS ISZ EQT9,I INCREMENT CHAR. OUTPHUT COUNTER NOP JMP HNSTY,I EXIT LINFD LDA EQT12,I WAS LAST OPERATION A CAR. RET.? SSA JMP LOU8 YES, DON'T GIVE A LINE FEED LDA SINGL GET LINE FEED CODE LDB EQT13,I GET PRESENT LINE LENGTH CMB,INB STB EQT11,I STORE IT JSB POUT OUTPUT LINE FEED CCA ADA EQT13,I DECREMENT PRESENT LINE STA EQT13,I LENGTH AND STORE IT JMP INCR EXIT LOU8 JSB CLEAR CLEAR HON. MODE COUNTERS/FLAG ISZ HNSTY INCREMENT RETURN ADDRESS ISZ EQT7,I INCREMENT BUFFER CHAR. ADDRESS ISZ EQT9,I INCREMENT CHAR. OUTPUT COUNTER ISZ HNSTY MORE DATA, INCR. RETURN ADDRESS JMP HNSTY,I CARTN JSB CLEAR CLEAR HONESTY MODE FLAGS CCB RESET CARRIAGE RETURN/ LINE STB EQT12,I FEED FLAG JMP INCR EXIT * * SUBROUTINE TO WAIT FOR FLAG FROM LINE PRINTER * TIMER NOP LDA M100 PICK UP LOOP COUNTER TIM1 SFC 0 SKIP IF CHAR NOT ACCEPTED JMP TIM2 INA,SZA SKIP IF DELAY TIME EXCEEDED JMP TIM1 ISZ EQT5,I SET BIT 0 JMP TIMER,I TAKE ERROR EXIT TIM2 ISZ TIMER JMP TIMER,I TAKE NORMAL EXIT * M100 DEC -100 * * SUBROUTINE TO CHECK IF ASMB, FTN, ALGOL, OR EDIT * CKNAM NOP ENTRY/EXIT LDB EQT1,I DEVICE SUSPEND LIST POINTER ADB .12 ADD 12 TO GET ADD. OF PROG. NAME LDA NUTAB INIT. SEARCH ADDRESS COUNTER STA NEWTB LDA M13 INIT. SEARCH COUNTER STA COUNT LDA B,I GET FIRST TWO CHARACTERS JSB GTCKC CHECK IF IN LIST LDA B,I GET SECOND TWO CHARACTERS JSB GTCKC CHECK IF IN LIST LDA B,I GET LAST CHARACTER AND M256 CLEAR LOWER 8 BITS JSB GTCKC CHECK IF IN LIST JMP CKNAM,I EXIT * M13 DEC -13 M256 DEC -256 NUTAB DEF *+1 ASC 2,ASMB OCT 20000 ASC 2,FTN OCT 20000 ! ASC 2,ALGO OCT 46000 ASC 2,EDIT OCT 20000 * * SUBROUTINE TO SEARCH FOR CALLING PROGRAM * GTCKC NOP CLE,INB GTNEW SEZ CHARACTER MATCHES? JMP GTCKC,I YES, EXIT CPA NEWTB,I CHARACTERS MATCH? CCE YES ISZ NEWTB INCREMENT COUNTERS ISZ COUNT JMP GTNEW KEEP CHECKING ISZ CKNAM NO MATCH, INCR. RETURN ADDRESS JMP CKNAM,I EXIT * COUNT NOP NEWTB NOP * * SUBROUTINE TO CHECK STATUS * STAT NOP ENTRY/EXIT STAT1 LIB 0 FETCH HARDWARE STATUS STB STATW SAVE STATUS RETURNED BLF RBL,RBL SWP SWAP A AND B REGISTERS AND B160 MASK OFF BITS 4-6 IOR EQT5,I MERGE WITH STATUS WORD SWP STB EQT5,I AND STORE LDB STATW GET STATUS RETURNED SSB,RSS IS 2607 ON LINE? JMP STAT,I NO, EXIT RBL SSB,RSS IS 2607 READY (POWER ON)? ISZ STAT YES JMP STAT,I EXIT * STATW NOP B160 OCT 160 * * SUBROUTINE TO SLEW UP TO 15 LINES AT A TIME * SLEW NOP LDA B B HAS LINE COUNT ADB M16 SUB 16 TO SEE IF LINE COUNT SSB GT 15 JMP SLW1 SLEW 15 LINES INB SAVE NUMBER OF LINES STB EQT7,I LEFT TO BE SLEWED LDA EQT5,I SET SLEW STATUS IOR .4 STA EQT5,I LDA B17 SLEW 15 LINES SLW1 ADA MNEG FIX UP SLEW CODE JSB POUT OUTPUT CODE JMP SLEW,I * M16 DEC -16 B17 OCT 17 * * SUBROUTINE TO OUTPUT A CHARACTER * POUT NOP OTA 0 OUTPUT WORD IN A REG STC 0,C ISZ EQT13,I JMP POUT,I * * SUBROUTINE TO CLEAR HONESTY MODE COUNTERS AND FLAGS * CLEAR NOP CLB STB EQT11,I STB EQT12,I STB EQT13,I JMP CLEAR,I * B EQU 1 ADDRESS OF B REGISTER * * BASE PAGE COMMU%B@ 1 ? JMP PERR YES, ALLOWS APPROX 34 TRIES STB EQT13,I ..4 LDB B41 YES, LOAD: BACKSPACE COMMAND. LDA .5 LOAD THE INTERRUPT RETURN. JSB FUNCT GO INITIATE THE FUNCTION. DEF ..4 REJECT, INTERRUPT ADDRESS RETURN. SPC 2 ..5 LDA .20AD LOAD THE INTERRUPT RETURN. LDB B15 LOAD: GAP COMMAND CODE. JSB FUNCT GO INITIATE THE FUNCTION. .5 DEF ..5 REJECT, INTERRUPT ADDRESS RETURN. * .20AD DEF ..20 B15 OCT 15 * SPC 2 ..20 LDA EQT5,I LOAD THE MT UNIT STATUS. ERA,SLA WERE THERE ANY ERRORS? JMP W.ERR YES, GO ABORT THE REQUEST. JMP ..2 NO, GO CHECK FOR END-OF-TAPE. SKP READ CPA EQT8,I IS THE BUFFER LENGTH = ZERO(0)? JMP SKIP. YES, GO CHECK THE MODE. JSB EOTF NO, GO CHECK FOR "EOT" CONDITION. ..6 JSB NBUFL GO GET THE NEGATIVE WORD COUNT. LDA EQT7,I LOAD THE USER BUFFER ADDRESS. JSB IODMA GO PERFORM THE OPERATION. LDB B23 LOAD: READ COMMAND CODE. LDA .7AD LOAD THE INTERRUPT RETURN. JSB FUNCT GO INITIATE THE FUNCTION. .6 DEF ..6 REJECT, INTERRUPT ADDRESS RETURN. * .7AD DEF ..7 B23 OCT 23 * SPC 2 ..7 JSB CHECK DID AN ERROR OCCUR ON READ? ISZ EQT10,I YES; IS THIS THE LAST RETRY? RSS NO, SKIP. JMP TLOG YES, UPDATE THE TRANSMISSION LOG. ..8 LDB B41 LOAD: BACKSPACE COMMAND CODE. LDA .6 LOAD THE INTERRUPT RETURN. JSB FUNCT GO INITIATE THE FUNCTION. DEF ..8 REJECT, INTERRUPT ADDRESS RETURN. * B41 OCT 41 * SPC 2 SKIP. LDA EQT6,I LOAD THE FUNCTION REQUEST CODE. AND B100 ISOLATE THE MODE BIT. SZA IS THE MODE BINARY? JMP FSR YES, GO SKIP FORWARD 1 RECORD. I.A.4 LDA .4 LOAD: A=4. JMP I.23,I RETURN TO THE USER. * .4 DEC 4 B200 OCT 200 * SKP CNTRL LDA EQT6,I GET THE REQUEST CONTROL WORD. AND B1770 ISOLATE THE FUNCTION CODE. CPA B600 IS IT A DYNAMIC STATUS REQUEST? JMP I.A.4 YES, GIVE AN IMMEDIATE RETURN. CPA B200 NO; IS IT A BACKSPACE REQUEST? JMP BSR YES, CONTINUE. CPA B300 NO; IS IT FORWARD SPACE REQUEST? JMP FSR YES, CONTINUE. CPA B400 NO; IS IT A REWIND REQUEST? JMP REW YES, CONTINUE. CPA B100 NO; WRITE END-OF-FILE REQUEST? JMP EOF YES, CONTINUE. CPA B1200 NO; IS IT A GAP REQUEST? JMP GAP YES, CONTINUE. CPA B1300 NO; IS IT FORWARD SPACE FILE? JMP FSF YES, CONTINUE. CPA B1400 NO; IS IT BACKSPACE FILE? JMP BSF YES, CONTINUE. STA EQT10,I NO, STORE THE REWIND/STANDBY FLAG. CPA B500 IS IT A REWIND/STANDBY REQUEST? JMP RWS YES, CONTINUE. I.A.2 LDA .2 LOAD: A 2. STC1M STC CMND,C JMP I.23,I RETURN TO USER * .2 DEC 2 B100 OCT 100 B300f OCT 300 B600 OCT 600 B1200 OCT 1200 B1300 OCT 1300 B1400 OCT 1400 B1770 OCT 17700 * SKP BSR JSB CSOT GO CHECK FOR "SOT" CONDITION. ..9 LDB B41 LOAD: BACKSPACE COMMAND CODE. LDA .10AD LOAD THE INTERRUPT RETURN. JSB FUNCT GO INITIATE THE FUNCTION. DEF ..9 REJECT, INTERRUPT ADDRESS RETURN. SPC 2 FSR JSB CEOT GO CHECK FOR "EOT" CONDITION. ..11 LDA .TLOG LOAD THE INTERRUPT RETURN. LDB .3 LOAD: FORWARD SPACE COMMAND CODE. JSB FUNCT GO INITIATE THE FUNCTION. DEF ..11 REJECT, INTERRUPT ADDRESS RETURN. * .3 DEC 3 * SPC 2 REW JSB CSOT GO CHECK FOR "SOT" CONDITION. ..12 LDB B101 LOAD: REWIND COMMAND CODE. LDA .10AD LOAD THE INTERRUPT RETURN. JSB FUNCT GO INITIATE THE FUNCTION. DEF ..12 REJECT, INTERRUPT ADDRESS RETURN. * .10AD DEF ..10 B101 OCT 101 * SPC 2 RWS SEZ IF IN LOCAL JMP I.A.2 GO REJECT THE REQUEST REWSB LDB B105 LOAD: REWIND/OFF-LINE COMMAND. LDA .10AD LOAD THE INTERRUPT RETURN JSB FUNCT GO INITIATE THE FUNCTION. DEF REWSB REJECT, INTERRUPT ADDRESS RETURN. * .TLOG DEF TLOG0 B105 OCT 105 * SPC 2 FSF JSB CEOT GO CHECK FOR "EOT" CONDITION. ..14 LDA .TLOG LOAD THE INTERRUPT RETURN. LDB B203 LOAD: FORWARD SPACE FILE COMMAND. JSB FUNCT GO INITIATE THE FUNCTION. DEF ..14 REJECT, INTERRUPT ADDRESS RETURN. * B203 OCT 203 * SPC 2 BSF JSB CSOT GO CHECK FOR "SOT" CONDITION. ..15 LDA .10AD LOAD THE INTERRUPT RETURN. LDB B241 LOAD: BACKSPACE FILE COMMAND. JSB FUNCT GO INITIATE THE FUNCTION. DEF ..15 REJECT, INTERRUPT ADDRESS RETURN. * B241 OCT 241 * SPC 2 GAP RBR,SLB IS A WRITE ENABLE RING PROVIDED? JMP I.A.3 NO, GO REJECT THE REQUEST. JSB CEOT YES, GO CHECK FOR END-OF-TAPE. ..23 LDA .22AD LOAD THE INTERRUPT RETURN. LDB B15 LOAD: GAP COMMAND CODE. JSB FUNCT GO INITIATE THE FUNCTION. DEF ..23 REJECT, INTERRUPT ADDRESS RETURN. * .22AD DEF ..22 * SPC 2 ..22 LDA EQT5,I LOAD THE MT UNIT STATUS. RAR,SLA WERE THERE ANY ERRORS? JMP W.ERR YES, GO ABORT THE REQUEST. JMP TLOG0 NO, GO UPDATE TRANSMISSION LOG. SPC 2 EOF RBR,SLB IS A WRITE ENABLE RING PROVIDED? JMP I.A.3 NO, GO REJECT THE REQUEST. CLF1C CLF DATA YES, CLEAR THE DATA CHANNEL FLAG. ..13 JSB EOTF GO CHECK FOR END-OF-TAPE. ..17 LDB B215 LOAD: WRITE EOF COMMAND CODE. LDA .18AD LOAD THE INTERRUPT RETURN. JSB FUNCT GO INITIATE THE FUNCTION. DEF ..17 REJECT, INTERRUPT ADDRESS RETURN. * .18AD DEF ..18 B215 OCT 215 * SPC 2 ..18 LDA EQT5,I LOAD THE MT UNIT STATUS. RAR SHIFT PARITY/TIMING BIT TO A0. SLA,RSS WERE THERE ANY ERRORS? JMP TLOG. NO, GO UPDATE TRANSMISSION LOG. ..19 LDB B41 YES, LOAD: BACKSPACE COMMAND. LDA .13AD LOAD THE INTERRUPT RETURN JSB FUNCT GO INITIATE THE FUNCTION. DEF ..19 REJECT, INTERRUPT ADDRESS RETURN. * .13AD DEF ..13 * SPC 2 STAT. NOP ENTRY POINT. LIA1C LIA CMND LOAD THE MT UNIT STATUS. JMP STAT.,I RETURN. SPC 2 CEOT NOP ENTRY POINT. SEZ,CLE IF IN LOCAL JMP LOCAL MAKE NOT READY RETURN LDA EQT5,I LOAD THE MT UNIT STATUS. AND B40 ISOLATE THE "EOT" STATUS BIT. SZA,RSS IS MT UNIT AT END-OF-TAPE ? JMP CEOT,I NO, RETURN. LDA EQT12,I YES, LOAD THE "EOT" FLAG WORD. AND EOTM MASK OFF IF EOT WAS ALREADY REACHED SZA JMP LOCAL YES, GO REJECT THE REQUEST LDA EQT12,I LOAD "EOT" FLAG WORD IOR EOTM ADD "EOT" BIT STzA EQT12,I STORE "EOT" FLAG WORD JMP CEOT,I NO, RETURN LOCAL LDB C.23 LOAD THE INTERRUPT FLAG LDA .2 LOAD: A=2. SSB,RSS INTERRUPT RETURN? JMP C.23,I YES, GIVE A COMPLETION RETURN. SPC 1 I.A.3 LDA .3 LOAD: A=3. JMP I.23,I RETURN TO USER * B40 OCT 40 * SPC 2 NBUFL NOP ENTRY POINT. LDB EQT8,I LOAD THE BUFFER LENGTH REQUEST. CCE,SSB,RSS IS THE LENGTH IN WORDS? CMB,INB,RSS YES, CONVERT TO NEGATIVE; SKIP. BRS NO, CONVERT TO WORDS. STB CEOT STORE THE NEGATIVE WORD COUNT. JMP NBUFL,I RETURN. SPC 2 CHECK NOP ENTRY POINT. LDA EQT5,I LOAD THE MT UNIT STATUS. RAR,SLA,RAL WERE THERE PARITY/TIMING ERRORS? JMP CHECK,I YES, RETURN. TLOG ALF,ALF SHIFT THE "EOF" BIT TO 15. SSA WAS AN END-OF-FILE (EOF) READ? JMP TLOG0 YES; RETURN 0 TLOG. W.CNT LIA DMA-4 LOAD THE WORD COUNT REGISTER. SZA DID "DMA" GO TO COMPLETION? IOR DMASK NO, RESTORE THE LOST BITS. LDB EQT6,I LOAD THE REQUEST CONTROL WORD. RBR,ERB SHIFT THE WRITE BIT TO "E". CMA,SEZ,INA,SZA DID THE WRITE COMPLETE? JMP W.ERR NO, GO ABORT THE REQUEST. JSB NBUFL YES, GO GET NEGATIVE WORD COUNT. ADB A LET "B" = -(WORDS TRANSMITTED). CMB,INB MAKE THE WORD COUNT POSITIVE. LDA EQT8,I LOAD THE USER BUFFER LENGTH. SSA WAS THE REQUEST FOR CHARACTERS? BLR YES, CONVERT TO CHARACTERS. LDA EQT5,I ANY ERRORS? RAR,SLA IF NONE SKIP JMP PERR ELSE PARITY ERROR EXIT JMP END GO RETURN TO THE SYSTEM. * DMASK OCT 140000 * SPC 2 EOTF NOP ENTRY POINT. SEZ IF IN LOCAL JMP I.A.3 MAKE NOT READY RETURN LDA EQT5,I LOAD THE MT UNIT STATUS. AND B40 ISOLATE THIVE "EOT" STATUS BIT. CCE,SZA,RSS IS MT UNIT AT END-OF-TAPE (EOT)? JMP EOTF,I NO, RETURN. LDA EQT12,I YES, LOAD THE "EOT" FLAG WORD. AND EOTM MASK OFF IF EOT WAS ALREADY REACHED. SZA JMP I.A.3 YES, GO REJECT THE REQUEST. LDA EQT12,I LOAD "EOT" FLAG WORD IOR EOTM ADD "EOT" BIT STA EQT12,I STORE "EOT" FLAG WORD JMP EOTF,I NO, RETURN. * EOTM NOP * SPC 2 CSOT NOP ENTRY POINT. LDA EQT5,I LOAD THE MT UNIT STATUS. AND B100 ISOLATE THE "SOT" STATUS BIT. SEZ,SZA,RSS IS THE MT UNIT AT "SOT" ? JMP CSOT,I NO, RETURN. SEZ IF IN LOCAL JMP I.A.3 MAKE NOT READY RETURN ..10 CLA STA EQT11,I LDA EQT12,I LOAD THE "EOT" FLAG WORD IOR EOTM CLEAR XOR EOTM "EOT" BIT STA EQT12,I STORE "EOT" FLAG WORD TLOG0 CLB,RSS ENTER: B=0; SKIP. TLOG. CLB,INB ENTER: B=1. LDA C.23 LOAD THE INTERRUPT FLAG. SSA IS CONTROL FROM INTERRUPT? JMP I.A.4 NO, GIVE IMMEDIATE COMPLETION. END CLA,RSS ENTR: A=0 PERR LDA .3 PARITY ERROR EXIT. JMP C.23,I GIVE A COMPLETION RETURN. SPC 2 IODMA NOP ENTRY POINT. ISZ S.DMA CLEAR THE "DMA" SKIP FLAG; SKIP. S.DMA OCT -1 "DMA" SKIP FLAG. CLC2F CLC DMA-4 PREPARE THE ADDRESS REGISTER. RAL,ERA SET THE READ/WRITE BIT. OTA3E OTA DMA-4 OUTPUT THE BUFFER ADDRESS. LDA CHECK LOAD MT DATA CHANNEL NUMBER. IOR B2K4 INCLUDE THE FINAL "CLC" OPTION. OTA1C OTA DMA ASSIGN THE DMA CHANNEL. CCA ENTER: A=-1. STC2F STC DMA-4 PREPARE THE WORD COUNT REGISTER. OTA5E OTA DMA-4 OUTPUT THE MASK CONSTANT. LMASK LIA DMA-4 LOAD THE MASK COMPLEMENT. CMA COMPLEMENT TO FORM "DMA" MASK. STA DMASK STORE THE "DMA" MASK CONSTANT. LDA CEOT LOAD THE NEGZATIVE WORD COUNT. OTA4E OTA DMA-4 OUTPUT THE WORD COUNT. JMP IODMA,I RETURN. * B110 OCT 110 B1100 OCT 1100 B2K4 OCT 20000 * SPC 2 REJCT CCA STA S.DMA SET THE "DMA" SKIP FLAG. LDA FUNCT,I LOAD REJECT INTERRUPT ADDRESS. LDB B110 LOAD THE CLEAR COMMAND CODE. RSS SKIP. SPC 2 FUNCT NOP ENTRY POINT. STA EQT9,I STORE THE RETURN ADDRESS. OTB1C OTB CMND OUTPUT THE COMMAND CODE. JSB STAT. GET THE MT UNIT STATUS. RAR,RAR SHIFT I/O REJECT BIT TO 0. RAR,SLA WAS THE COMMAND REJECTED? JMP REJCT YES, GO ISSUE A CLEAR REQUEST. SPC 2 CLA,CCE NO, ENTER: A=0; E=1. CPA S.DMA IS THE REQUEST A READ OR WRITE? JMP STC1D YES, GO INITIALIZE THE TRANSFER. SPC 2 STC1C STC CMND,C NO, INITIALIZE MT UNIT CONTROL. JMP C.RTN GO RETURN TO THE SYSTEM. SPC 1 STC1D STC DATA,C INITIALIZE THE MT DATA CONTROL. RWCON STC CMND,C INITIALIZE THE MT UNIT CONTROL. STC1E STC DMA,C INITIATE THE "DMA" CHANNEL. IO13 CLC DMA YES, RESET "DMA" CONTROL. C.RTN LDA C.23 LOAD THE INTERRUPT CONTROL FLAG INA,SZA,RSS IS CONTROL THROUGH INTERRUPT? JMP I.23,I NO, RETURN TO THE USER. JMP A,I YES, SYSTEM INTERRUPT RETURN. SPC 2 MALF LDA .3 GET MALFUNCTION CODE LDB C.23,I LOAD INTERRUPT CONTROL FLAG INB,SZB,RSS WAS IT AN INTERRUPT ? JMP I.23,I NO, RETURN THRU INITIATOR JMP W.ERR RETURN THRU COMPLETION SKP SETIO NOP ENTRY POINT STA CHECK STORE MT DATA CHANNEL NUMBER. ADA CLC FORM A CLC DATA. STA CLC1D SET IT. CLC1D CLC DATA CLEAR MT DATA CONTROL. XOR B5600 FORM A "CLF DATA". STA CLF1C STORE THE INSTRUCTION. XOR B600 FORM A "STC DATA,C". STA STC1D STORE THE INSTRUCTION. INA FORM A "STC CMND,C". STA STC1C STORE THE INSTRUCTION. STA RWCON STORE THE INSTRUCTION. STA STC1M STORE THE INSTRUCTION XOR B5000 FORM A "CLC CMND". STA CLC.G STORE THE INSTRUCTION. CLC.G CLC CMND CLEAR MT COMMAND CONTROL. XOR B4200 FORM A "LIA CMND". STA LIA1C STORE THE INSTRUCTION. XOR B4300 FORM A "OTB CMND". STA OTB2C STORE TLE INSTRUCTION. STA OTB1C STORE THE INSTRUCTION. LDA CHAN LOAD THE "DMA" CHANNEL NUMBER. ADA CLC FORM A "CLC DMA". STA IO13 STORE THE INSTRUCTION. XOR B5000 FORM A "STC DMA,C". STA STC1E SET THE INSTRUCTION. XOR B1100 FORM A "OTA DMA". STA OTA1C SET THE INSTRUCTION. ADA M4 "SUBTRACT": "DMA" - 4. STA OTA3E STORE THE INSTR]CTION. STA OTA4E STORE THE INSTRUCTION. STA OTA5E STORE THE INSTRUCTION. XOR B100 FORM A "STC DMA-4". STA STC2F STORE THE INSTPUCTION. XOR B200 FORM A "LIA FMA-4". STA W.CNT STORE THE INSTRUCTION. STA LMASK STORE THE INSTRUCTION. XOR B4200 FORM A "CLC DMA-4". STA CLC2F STORE THE INSTRUCTION. LDA EQT4,I LOAD THE UNIT NUMBER WORD. AND B300 ISOLATE THE UNIT NUMBER. ALF,ALF ROTATE UNIT TO RAL,RAL TO LOW A CMA SET AS COUNTER LDB B400 PRE SET B B5000 BLS SET B TO UNIT INA,SZA THIS UNIT? JMP *-2 NO; TRY NEXT STB EOTM ADB B400 YES; COMPLETE THE WORD. OTB2C OTB CMND OUTPUT THE MT UNIT SELECT CODE. JSB STAT. GET MT STATUS IN "A". AND B377 ISOLATE BITS 7-0. LDB A SAVE THE STATUS IN "B". LDA EQT5,I LOAD THE STATUS WORD. AND M1774 REMOVE THE OLD STATUS. IOR B INCLUDE THE NEW STATUS. STA EQT5,I UPDATE THE STATUS WORD. CCA ; ENTER: A=-1. STA S.DMA SET THE "DMA" SKIP FLAG. JMP SETIO,I RETURN. * CLC CLC 0 B377 OCT 377 B400 OCT 400 B500 OCT 500 B4200 OCT 4200 B4300 OCT 4300 B5600 OCT 5600 M1 DEC -1 M4 DEC -4 M1774 OCT 177400 * SPC 2 SKP * COMPLETION SECTION. SPC 1 C.23 NOP ENTRY POINT. LDB EQT11,I LOAD THE "DMA" CHANNEL NUMBER. SZB,RSS LOCAL TO AUTO MODE INTERRUPT? JMP EXTRA YES, IGNORE THE INTERRUPT. STB CHAN NO, UPDATE THE "CHAN" WORD ENTRY. LDB EQT1,I LOAD THE DEVICE LIST POINTER. SZB,RSS DID A SPURIOUS INTERRUPT OCCUR? JMP EXTRA YES, IGNORE THE INTERRUPT. ADA M1 NO, LET "A" = MT DATA CHANNEL #. JSB SETIO SET I/O INSTRUCTIONS FOR MT. LDA EQT9,I LOAD THE CONTINUATION ADDRESS. ERB SHIFT THE "LOCAL" BIT TO "E". LDB EQT10,I LOAD THE REWIND/STANDBY FLAG. SEZ,CLE IS THE MT UNIT NOT IN "LOCAL"? CPB B500 NO; IS THE INTERRUPT FROM "RWS"? JMP A,I YES, GO CONTINUE PROCESSING. W.ERR CLA,INA ENTER: A=1. CLB ENTER: B=0. JMP C.23,I COMPLETION RETURN. SPC 2 EXTRA ADA CLC CONFIGURE A CLC. STA CLC.0 STORE THE INSTRUCTION. CLC.0 CLC 00B CLEAR CONTROL. JMP C.RTN GO GIVE A CONTINUATION RETURN. SKP * SYSTEM BASE PAGE COMMUNICATION AREA: SPC 1 A EQU 0 B EQU 1 . EQU 01650B ORIGIN OF AREA. SPC 1 SPC 1 EQT1 EQU .+8 EQT4 EQU .+11 EQT5 EQU .+12 EQT6 EQU .+13 EQT7 EQU .+14 EQT8 EQU .+15 EQT9 EQU .+16 EQT10 EQU .+17 EQT11 EQU .+18 SPC 1 CHAN EQU .+19 CURRENT "DMA" CHANNEL NUMBER. EQT12 EQU .+81 EQT13 EQU .+82 SPC 1 DMA EQU 06B "DMA" CHANNEL NUMBER 1. SPC 1 DATA EQU 26B DATA CHANNEL NUMBER. CMND EQU DATA+01B COMMAND CHANNEL NUMBER. SPC 1 END mB@< 1 * ISTR IS THE ARRAY FOR THE RESULT OR STATUS STRING. * * SUCCESSFUL CALL WILL READ ONE RECORD FROM THE 2240 * INTO ISTR, FORMATTED FOR C2240: * ISTR(1) = CHARACTER COUNT IN STRING * ISTR(2)... = ASCII CHARACTERS * * ERROR RETURNS: * ISTR(1) = 0 IF EXEC CALL TO READ FAILS, THEN: * ISTR(2) = A-REGISTER FROM EXEC/DVR37 ERROR * ISTR(2) = -1 IF RECORD WAS EMPTY * ISTR(1) = -1 IF R2240 PARAMETER INVALID * * * CALL C2240 (ISTR, IRSLT, INDEX, NRSLT, IERR) * * ISTR IS A STRING WITH ISTR(1) AS ITS CHARACTER * COUNT AND THE REST AS THE ASCII RESULT * FROM THE 2240A. ISTR IS UNCHANGED BY C2240. * IRSLT IS A VARIABLE OR ARRAY FOR THE RESULTS. * INDEX IS A CHARACTER POINTER WHICH MUST BE A * VARIABLE. PRESET IT TO 0 ON THE FIRST C2240 * CALL, AND LEAVE IT ALONE FOR ANY OTHER * CONVERSION CALLS ON THE SAME STRING. * NRSLT IS THE NUMBER OF RESULTS TO CONVERT * ON THIS CALL OF C2240. * IERR IS AN ERROR CODE RETURNED BY C2240. * * SUCCESSFUL CONVERSION RETURNS: * IRSLT = THE RESULT VALUES CONVERTED * INDEX = NUMBER OF CHARACTERS SCANNED SO FAR * IERR = 0 * ISTR AND NRSLT UNCHANGED SKP * * ERROR R3ETURN IF PARAMETER INVALID OR TOO MANY RESULTS * TO BE CONVERTED FROM STRING: * IERR = -1 * ISTR AND NRSLT UNCHANGED * INDEX AND IRSLT UNDEFINED * C2240 ASSUMES THE STRING IS VALID AND TAKES NO TIME * FOR DETAIL ERROR TESTS. IT EXPECTS INTEGERS, SEPARATED * BY COMMAS, WITH LEADING BLANKS OR MINUS SIGNS. ANY * IMBEDDED INVALID CHARACTERS MAY CONVERT TO INVALID * IRSLT NUMBERS WITHOUT ERROR MESSAGES. * * NOTE: ERRORS FROM R2240 WILL BE TRAPPED BY C2240, SO * PROGRAMS NEED ONLY TEST IERR. ALSO, R2240 AND C2240 * NEED NOT BE USED IN PAIRS -- STRINGS CAN BE STORED FOR * LATER CONVERSION. * * EXAMPLE: CALL R2240 (LU, NSEC, LSTR, ISTR) * INDEX = 0 * CALL C2240 (ISTR, IRSLT, INDEX, NRSLT, IERR) * IF (IERR) 1000, 100 * C 100 TO USE IRSLT, 1000 TO HANDLE ERRORS * * ********************** R2240 ******************************** * LU NOP NSEC NOP LSTR NOP ISTRR NOP R2240 NOP JSB .ENTR DEF LU JSB EXEC GET BOX HP-IB ADDRESS WITH DEF *+6 A STATUS EXEC CALL DEF THRTN DEF LU,I DEF T1 DEF T2 DEF CB2 LDA T1 AND MSK3 DOES LU POINT TO DVR37 (HP-IB)? CPA D37 JMP A2 YES -- CONTINUE E1 CCA NO -- PARAMETER ERROR STA ISTRR,I SET ISTR(1) = -1 AND RETURN JMP R2240,I * A2 LDA CB2 PICK UP LU'S SUB-CHANNEL AND MSK2 SZA,RSS HPIB CARD LU (SUBCHANNEL = 0) ? JMP E1 YES -- ERROR EXIT ADA TLK0 NO ALF,ALF STA CB2 CB2 = 2240 TALK ADDR IN UPPER BYTE LDA NSEC,I GET SECONDARY LDB M3 SSA NSEC < 0 ? JMP A4 YES -- RESULT, SO NO SECONDARY ADDR ADB MONE NO -- STATUS, BUMP CMD BYTE COUNT ADA MSA0 COkNVERT NSEC TO SECONDARY ADDR IOR CB2 MERGE WITH 2240 TALK ADDRESS STA CB2 CB2 = COMB 2240 TALK AND SECONDARY A4 STB CCNT CCNT = - # BUS CMD BYTES (3 OR 4) LDA ISTRR INA STA A3 A3 = STRING BUFFER ADDRESS LDA LSTR,I GET STRING ARRAY LENGTH ADA MONE SZA WAS IT >= 2 ? SSA JMP E1 NO -- PARAMETER ERROR ALS YES -- CONVERT TO BUFFER LENGTH CMA,INA STA T1 T1 = MAX # CHARS = -2 * (LSTR-1) LDA LU,I IOR DIO STA T2 T2 = LU # PLUS BIT 12 ON CCA STA A3,I ISTR(2) = -1 IN CASE REC. IS EMPTY * JSB EXEC DEF *+7 DEF ONE READ DEF T2 DIRECT I/O, ASCII MODE A3 NOP STRING ADDRESS DEF T1 - MAXIMUM STRING CHAR COUNT DEF CB1 BUS COMMANDS DEF CCNT - COMMAND CHAR COUNT * SSB SUCCESSFUL READ? JMP E2 NO -- ERROR EXIT STB ISTRR,I YES -- ISTR(1) = CHAR COUNT IN (B) JMP R2240,I AND RETURN E2 STA A3,I ON ERR, ISTR(2) = DVR37 ERR CODE CLA STA ISTRR,I AND ISTR(1) = 0 JMP R2240,I RETURN * ********************** C2240 ******************************** * ISTR NOP IRSLT NOP INDEX NOP NRSLT NOP IERR NOP C2240 NOP JSB .ENTR DEF ISTR LDA INDEX,I SSA INDEX < 0? JMP ERROR YES -- ERROR LDB ISTR,I CMB,INB SSB,RSS ISTR(1) < 1? JMP ERROR YES -- INVALID STRING LENGTH ADA 1 ADA MONE STA CCNT CCNT = INDEX - ISTR(1) - 1 SSA,RSS CCNT < 0? JMP ERROR NO -- NO CHARACTERS LEFT TO SCAN LDA ISTR INA RAL ADA INDEX,I STA CPTR CPTR = NEXT CHARACTER BYTE ADDRESS LDA NRSLT,I CMA,INA SSA,RSS NRSLT < 1 ? ѷ JMP ERROR YES -- PARAMETER ERROR STA NCNT NCNT = -NRSLT CLA ASSUME NORMAL RETURN FROM THIS STA IERR,I POINT, SO IERR = 0 * ******** LOOP TO CONVERT RESULTS **************** * A1 JSB SCAN GET NEXT RESULT INTO NUM LDA NUM LDB NFLAG NEG RESULT? SZB CMA,INA YES -- COMPLIMENT (A) STA IRSLT,I SAVE IN ARRAY ISZ IRSLT BUMP ARRAY POINTER ISZ NCNT DONE WITH # RESULTS ASKED FOR? JMP A1 NO -- LOOP JMP C2240,I YES -- RETURN OK * * ERROR RETURNS * ERROR CCA STA IERR,I IERR = -1 JMP C2240,I AND RETURN * *********** INTERNAL C2240 SUBROUTINES ************* * * JSB SCAN -- CONVERTS NEXT NUMBER IN BUFFER INTO NUM * SCAN NOP CLA STA NUM NUM = 0 STA NFLAG NFLAG = 0 S2 JSB GETC GETC FIRST CHAR CPA BLNK = BLANK? JMP S2 YES -- SKIP IT CPA MINUS NO -- NEGATIVE #? RSS JMP S1 NO -- START CONVERSION ISZ NFLAG YES -- SET NFLAG = 1 AND JMP S2 GET NEXT CHAR * S1 CPA COMMA = COMMA? JMP SCAN,I YES -- DELIMITER, SO DONE AND MSK2 NO -- TREAT AS A DIGIT LDB NUM BLS ADA 1 BLS,BLS ADA 1 STA NUM NUM = 10*NUM + DIGIT CCA CPA CCNT BUFFER EMPTY? JMP SCAN,I YES -- THIS # CONVERSION DONE JSB GETC NO -- GET NEXT CHARACTER JMP S1 AND LOOP * * JSB GETC -- GETS NEXT CHARACTER INTO LOWER * 7 BITS OF (A) AND BUMPS POINTER. * GETC NOP LDB CPTR CLE,ERB LDA 1,I SEZ,RSS UPPER OR LOWER BYTE? ALF,ALF ROTATE IF UPPER AND MSK1 MASK BYTE W/O PARITY BIT ISZ INDEX,I BUMP INDEX ISZ CPTR BUMP CHARACTER POINTER ISZ CCNT BEYOND END OF THE STRING? JMP GETC,I NO -- RETURN O.K. dJMP ERROR YES -- TOO MANY RESULTS REQUESTED * ************** DATA AREA *************** * MSK1 OCT 177 7 BIT ASCII MASK CPTR NOP NEXT CHARACTER ADDRESS NUM NOP RESULT FROM SCAN NCNT NOP COUNTS # OF RESULTS SCANNED CCNT NOP COUNTS CHARS REMAINING IN STRING NFLAG NOP >0 IF NUM WAS NEGATIVE FROM SCAN MINUS OCT 55 BLNK OCT 40 COMMA OCT 54 MSK2 OCT 17 4 BIT DIGIT MASK MONE DEC -1 ONE DEC 1 TWO DEC 2 THRTN DEC 13 M3 DEC -3 TLK0 OCT 000100 TALK ADDRESS 0 MSA0 OCT 000140 SECONDARY ADDRESS 0 MSK3 OCT 037400 DVR NUMBER MASK D37 OCT 017400 CODE FOR DVR37 DIO OCT 010000 BIT 12 ON FOR DIRECT I O T1 NOP T2 NOP CB1 OCT 057477 COMMAND BUFFER: UNTALK, UNLISTEN CB2 NOP 2240 TALK, SECONDARY END $ ^ h 92401-80001 A S 0106 THERMOCOUPLE LINEARIZATIONPACKAGE             H0101 kFTN,L,B C C HP92401A THERMOCOUPLE LINEARIZATION PACKAGE C C SOURCE TAPE 92401-80001 REV. A C RELOC. TAPE 92401-60001 REV. A C C AUTHOR - T.A. SAPONAS C C VERSION 25 SEPTEMBER 1973 C C FUNCTION CRALM(VOLTS,MODE,IERR) C C CRALM CONVERTS THERMOCOUPLE VOLTAGE "VOLTS" TO TEMPERATURE C "CRALM". MODE DETERMINES THE TEMPERATURE UNIT AND REFERENCE C JUNCTION TEMPERATURE. C MODE = 1 - FAHRENHEIT, 32 F REFERENCE JUNCTION TEMPERATURE C 2 - FAHRENHEIT, 150 F REFERENCE JUNCTION TEMPERATURE C -1 - CELSIUS, 0 C REFERENCE JUNCTION TEMPERATURE C -2 - CELSIUS, 150 F REFERENCE JUNCTION TEMPERATURE C IF THE VOLTAGE "VOLTS" IS OUTSIDE THE RANGE OF THE LINEARIZATION, C "IERR" IS SET TO -1, OTHERWISE IT IS SET TO ZERO. C IERR = 0 V = VOLTS C C DETERMINE REFERENCE JUNCTION TEMPERATURE IF(IABS(MODE)-2)20,10 C ADD OFFSET FOR 150 F REFERENCE JUNCTION TEMPERATURE 10 V = V+2.6659E-3 C C C DETERMINE TEMPERATURE RANGE C C IF TEMP. > 350 F (I.E. VOLTS > 7.2 MV) GO TO 21 20 IF(V-7.2E-3)30,21 C C IF 350 < TEMP. < 800 F GO TO 800 21 IF(V-17.53E-3)800,22 C C IF 800 < TEMP. < 1600 F GO TO 1600, OTHERWISE OUTSIDE RANGE 22 IF(V-36.19E-3)1600,26 C C IF -30 < TEMP. < 350 F GO TO 350, OTHERWISE OUTSIDE RANGE 30 IF(V+1.34E-3)25,350 C C LINEARIZATION RANGE -30 TO 350 DEGREES FAHRENHEIT 25 IERR = -1 350 CRALM = V*(V*(V*65332424.-672066.)+45648.7)+31.9106 GO TO 60 C C LINEARIZATION RANGE 350 TO 800 DEGREES FAHRENHEIT 800 CRALM = V*(47147.14-V*145779.)+18.1618 GO TO 60 C C LINEARIZATION RANGE 800 TO 1600 DEGREES FAHRENHEIT 26 IERR = -1 1600 CRALM = V*(V*(V*4223385.-274369.9)+48154.64)+17.796 C C IF MODE < 0 CONVERT TEMPERATURE TO CELSIUS 60 IF(MODE)65,27 65 CRALM = (CRALM-32.)*.5555556 27 RETURN END FUNCTION CUCON(VOLTS,MODE,IERR) C C CUCON CONVERTS THERMOCOUPLE VOLTAGE "VOLTS" TO TEMPERATURE C "CUCON". MODE| DETERMINES THE TEMPERATURE UNIT AND REFERENCE C JUNCTION TEMPERATURE. C MODE = 1 - FAHRENHEIT, 32 F REFERENCE JUNCTION TEMPERATURE C 2 - FAHRENHEIT, 150 F REFERENCE JUNCTION TEMPERATURE C -1 - CELSIUS, 0 C REFERENCE JUNCTION TEMPERATURE C -2 - CELSIUS, 150 F REFERENCE JUNCTION TEMPERATURE C IF THE VOLTAGE "VOLTS" IS OUTSIDE THE RANGE OF THE LINEARIZATION, C "IERR" IS SET TO -1, OTHERWISE IT IS SET TO ZERO. C IERR = 0 V = VOLTS C C DETERMINE REFERENCE JUNCTION TEMPERATURE IF(IABS(MODE)-2)20,10 C ADD OFFSET FOR 150 F REFERENCE JUNCTION TEMPERATURE 10 V = V+2.7113E-3 C C C DETERMINE TEMPERATURE RANGE C C IF TEMP. > 0 F (I.E. VOLTS > -.692E-3) GO TO 21 20 IF(V+.692E-3)30,21 C C IF 0 < TEMP. < 450 GO TO 450 21 IF(V-11.027E-3)450,22 C C IF 450 < TEMP. < 750 F GO TO 750, OTHERWISE TEMP. OUTSIDE RANGE 22 IF(V-20.81E-3)750,26 C C IF -250 < TEMP. < 0 F GO TO 9250 , OTHERWISE OUTSIDE RANGE 30 IF(V+4.75E-3)25,9250 C C LINEARIZATION RANGE -250 TO 0 DEGREES FAHRENHEIT 25 IERR = -1 9250 CUCON = V*(V*(V*5.79384E8+1.0186E6)+50783.4)+34.357 GO TO 60 C C LINEARIZATION RANGE 0 TO 450 DEGREES FAHRENHEIT 450 CUCON = V*(V*(V*3.13648E7-1.09738E6)+46229.4)+32.042 GO TO 60 C C LINEARIZATION RANGE 450 TO 750 DEGREES FAHRENHEIT 26 IERR = -1 750 CUCON = V*(36562.9-185816.*V)+69.651 C C IF MODE < 0 CONVERT TEMPERATURE TO CELSIUS 60 IF(MODE)65,27 65 CUCON = (CUCON-32.)*.5555556 27 RETURN END FUNCTION FECON(VOLTS,MODE,IERR) C C FECON CONVERTS THERMOCOUPLE VOLTAGE "VOLTS" TO TEMPERATURE C "FECON". MODE DETERMINES THE TEMPERATURE UNIT AND REFERENCE C JUNCTION TEMPERATURE. C MODE = 1 - FAHRENHEIT, 32 F REFERENCE JUNCTION TEMPERATURE C 2 - FAHRENHEIT, 150 F REFERENCE JUNCTION TEMPERATURE C -1 - CELSIUS, 0 C REFERENCE JUNCTION TEMPERATURE C -2 - CELSIUS, 150 F REFERENCE JUNCTION TEMPERATURE C IF4a THE VOLTAGE "VOLTS" IS OUTSIDE THE RANGE OF THE LINEARIZATION, C "IERR" IS SET TO -1, OTHERWISE IT IS SET TO ZERO. C IERR = 0 V = VOLTS C C DETERMINE REFERENCE JUNCTION TEMPERATURE IF(IABS(MODE)-2)20,10 C ADD OFFSET FOR 150 F REFERENCE JUNCTION TEMPERATURE 10 V = V+3.4111E-3 C C C DETERMINE TEMPERATURE RANGE C C IF TEMP. > 250 F GO TO 21 20 IF(V-6.42E-3)30,21 C C IF 250 < TEMP. < 950 F GO TO 950 21 IF(V-27.95E-3)950,23 C C IF 950 < TEMP. < 1400 F GO TO 1400 , OTHERWISE OUTSIDE RANGE 23 IF(V-42.96E-3)1400,26 C C IF -10 < TEMP. < 250 F GO TO 250 30 IF(V+1.16E-3)31,250 C C IF -250 < TEMP. < -10 F GO TO 9250 , OTHERWISE OUTSIDE RANGE 31 IF(V+6.71E-3)25,9250 C C LINEARIZATION RANGE -250 TO -10 DEGREES FAHRENHEIT 25 IERR = -1 9250 FECON = V*(V*(V*1.9997E8+876412.)+39241.0)+34.9255 GO TO 60 C C LINEARIZATION RANGE -10 TO 250 DEGREES FAHRENHEIT 250 FECON = V*(35509.83-247837.6*V)+31.88715 GO TO 60 C C LINEARIZATION RANGE 250 TO 950 DEGREES FAHRENHEIT 950 FECON = 32527.01*V+41.31181 GO TO 60 C C LINEARIZATION RANGE 950 TO 1400 DEGREES FAHRENHEIT 26 IERR = -1 1400 FECON = V*(39578.4-134515.0*V)-50.73999 C C IF MODE < 0 CONVERT TEMPERATURE TO CELSIUS 60 IF(MODE)65,27 65 FECON = (FECON-32.)*.5555556 27 RETURN END END$ * _g 92402-80001 A S 0106 HUMIDITY PACKAGE              H0101 #(FTN,L,B C C HP92402A HUMIDITY PACKAGE C C SOURCE TAPE 92402-80001 REV. A C RELOC. TAPE 92402-60001 REV. A C C AUTHOR - T.A. SAPONAS C C VERSION 1 OCTOBER 1973 C C FUNCTION RHBLB(TEMP,TWBLB,BARO,IERR) C THIS FUNCTION CALCULATES THE RELATIVE HUMIDITY IN PERCENT FROM THE C WET BULB (TWBLB) AND DRY BULB (TEMP) TEMPERATURE IN DEGREES C FAHRENHEIT ( IF TEMP OR TWBLB IS NEGATIVE THEN THEIR ABSOLUTE C VALUE IS TAKEN AS DEGREES CELSIUS). C BARO IS THE BAROMETRIC PRESSURE IN MILLIMETERS OF MERCURY. C IERR IS AN ERROR FLAG WHICH IS NEGATIVE IF TEMP OR TWBLB ARE C OUTSIDE THE RANGE OF 32 TO 212 DEGREES F ( 0 TO 100 DEGREES C). C PPDWP COMPUTES THE SATURATED VAPOR PRESSURE AT A GIVEN TEMPERATURE. C PPBLB COMPUTES THE ACTUAL VAPOR PRESSURE FROM WET BULB, DRY BULB C TEMPERATURE. RHBLB=100.*PPBLB(TEMP,TWBLB,BARO,IERR)/PPDWP(TEMP,I) IERR=I+IERR END FUNCTION RHDWP(TEMP,TDEWP,IERR) C THIS FUNCTION CALCULATES THE RELATIVE HUMIDITY IN PERCENT FROM THE C TEMPERATURE AND THE DEW POINT TEMPERATURE IN DEGREES FAHRENHEIT C ( IF TEMP OR TDEWP IS NEGATIVE THEN THEIR ABSOLUTE VALUE IS C AS DEGREES CELSIUS). C IERR IS AN ERROR FLAG WHICH IS NEGATIVE IF TEMP OR TDEWP ARE C OUTSIDE THE RANGE OF 32 TO 212 DEGREES F ( 0 TO 100 DEGREES C). C PPDWP COMPUTES THE SATURATED VAPOR PRESSURE AT A GIVEN TEMPERATURE. RHDWP=100.*PPDWP(TDEWP,IERR)/PPDWP(TEMP,I) IERR=I+IERR END FUNCTION PPBLB(TEMP,WBLB,BARO,IERR) C THIS FUNCTION CALCULATES THE PARTIAL PRESSURE OF WATER VAPOR IN C MILLIMETERS OF HG FROM : TEMP - TEMPERATURE IN DEGREES FAHRENHEIT C WBLB - WET BULB TEMPERATURE C BARO - BAROMETRIC PRESSURE IN MM OF HG C IERR IS AN ERROR FLAG AND IS NEGATIVE IF TEMP OR WBLB IS OUTSIDE C THE GUARANTEED ACCURACY RANGE OF 32 TO 212 DEGREES OR IF BARO IS C NEGATIVE. C C IF "WBLB" OR "TEMP" IS POSITIVE CONVERT FROM DEG. F TO C C T2J  =WBLB T1=TEMP IF(T1)2,1 1 T1=(32.-T1)*.5555556 2 IF(T2)4,3 3 T2=(32.-T2)*.5555556 C ASSUME ERROR 4 IERR=-1 C C IF BAROMETRIC PRESSURE < 0, RETURN WITH IERR=-1 IF(BARO)10,5 C IF DRY BULB TEMP IS NOT -1000 INCLUDE POINT IN LAST BAR COUNT, ELSE IGNORE IT M = NBARS-1 IF(I)10,402 C C DATA LESS THAN LOWER BOUND OF HISTOGRAM, INCREMENT IERR 400 IERR = IERR-1 C IF I>0 INCLUDE POINT IN FIRST BAR COUNT, ELSE IGNORE IT IF(I)10,401 401 M = 0 402 IERR = IERR+2 C C INCREMENT PROPER BAR OF HISTOGRAM 302 NHIST(M+1) = NHIST(M+1)+1 10 CONTINUE RETURN END SUBROUTINE HISTF(DATA,NPTS,START,DELTA,NHIST,I,IERR) C THIS SUBROUTINE PRODUCES A HISTOGRAM IN ARRAY "NHIST" FROM THE C DATA IN ARRAY "DATA" DIMENSION DATA(1),NHIST(1) NBARS = IABS(I) C C INITIALIZE ALL BARS OF THE HISTOGRAM TO ZERO DO 1 J = 1,NBARS 1 NHIST(J) = 0 IERR = 0 C C LOOP THROUGH ALL OF THE DATA DO 10 J = 1,NPTS C C COMPUTE BAR NUMBER (M = BAR NUMBER - 1) M = (DATA(J)-START)/DELTA C C CHECK TO SEE DATA IS IN BOUNDS OF HISTOGRAM IF(M)400,301 301 IF(M-NBARS)302,450 C C DATA GREATER THAN UPPER BOUND OF HISTOGRAM, INCREMENT IERR 450 IERR = IERR-1 C IF I>0 INCLUDE POINT IN LAST BAR COUNT, ELSE IGNORE IT M = NBARS-1 IF(I)10,402 C C DB/ATA LESS THAN LOWER BOUND OF HISTOGRAM, INCREMENT IERR 400 IERR = IERR-1 C IF I>0 INCLUDE POINT IN FIRST BAR COUNT, ELSE IGNORE IT IF(I)10,401 401 M = 0 402 IERR = IERR +2 C C INCREMENT PROPER BAR OF HISTOGRAM 302 NHIST(M+1) = NHIST(M+1)+1 10 CONTINUE RETURN END SUBROUTINE HISTB(DATA,NPTS,START,DELTA,RHIST,I,IERR) C THIS SUBROUTINE PRODUCES A HISTOGRAM IN ARRAY "RHIST" FROM THE C DATA IN ARRAY "DATA". RHIST IS A FLOATING POINT ARRAY SO THAT C HISTB IS "BASIC CALLABLE". DIMENSION DATA(1),RHIST(1) NBARS = IABS(I) C C INITIALIZE ALL BARS OF THE HISTOGRAM TO ZERO DO 1 J = 1,NBARS 1 RHIST(J) = 0. IERR = 0 C C LOOP THROUGH ALL OF THE DATA DO 10 J = 1,NPTS C C COMPUTE BAR NUMBER (M = BAR NUMBER - 1) M = (DATA(J)-START)/DELTA C C CHECK TO SEE DATA IS IN BOUNDS OF HISTOGRAM IF(M)400,301 301 IF(M-NBARS)302,450 C C DATA GREATER THAN UPPER BOUND OF HISTOGRAM, INCREMENT IERR 450 IERR = IERR-1 C IF I>0 INCLUDE POINT IN LAST BAR COUNT, ELSE IGNORE IT M = NBARS-1 IF(I)10,402 C C DATA LESS THAN LOWER BOUND OF HISTOGRAM, INCREMENT IERR 400 IERR = IERR-1 C IF I>0 INCLUDE POINT IN FIRST BAR COUNT, ELSE IGNORE IT IF(I)10,401 401 M = 0 402 IERR = IERR +2 C C INCREMENT PROPER BAR OF HISTOGRAM 302 RHIST(M+1) = RHIST(M+1)+1. 10 CONTINUE RETURN END SUBROUTINE STATI(IDATA,NPTS,RMEAN,STDEV) C "STATI" COMPUTES THE MEAN AND STANDARD DEVIATION FROM THE MEAN C OF THE DATA IN ARRAY "IDATA". DIMENSION IDATA(1) C C CLEAR THE ACCUMULATORS FOR THE SUM AND SUM OF SQUARES SUM = 0. SUMSQ = 0. C C COMPUTE SUM AND SUM OF SQUARES OF THE DATA DO 10 J = 1,NPTS DATA = IDATA(J) SUM = SUM+DATA 10 SUMSQ = SUMSQ+DATA*DATA C C COMPUTE MEAN AND STANDARD DEVIATION RNPTS = NPTS RMEAN = SUM/RNPTS STDEV = SQRT((SUMSQ-SUM*RMEAN)/(RNPTS-1.)) END 0  SUBROUTINE STATF(DATA,NPTS,RMEAN,STDEV) C "STATF" COMPUTES THE MEAN AND STANDARD DEVIATION FROM THE MEAN C OF THE DATA IN ARRAY "DATA". DIMENSION DATA(1) C C CLEAR THE ACCUMULATORS FOR THE SUM AND SUM OF SQUARES SUM = 0. SUMSQ = 0. C C COMPUTE SUM AND SUM OF SQUARES OF THE DATA DO 10 J = 1,NPTS SUM = SUM+DATA(J) 10 SUMSQ = SUMSQ+DATA(J)*DATA(J) C C COMPUTE MEAN AND STANDARD DEVIATION RNPTS = NPTS RMEAN = SUM/RNPTS STDEV = SQRT((SUMSQ-SUM*RMEAN)/(RNPTS-1.)) END END$ FTN,L,B SUBROUTINE INTLI(ITYPE,A,ISTRT,IDLTA,NHIST,I) C "INTLI" INITIALIZES THE HISTOGRAM AND OTHER STATISTICAL C ACCUMULATORS FOR RUNNING STATISTICS ON INTEGER DATA. C ARRAY "A" MUST BE PROVIDED FOR EACH VARIABLE FOR WHICH STATISTICS C ARE MAINTAINED. "A" MUST BE A REAL ARRAY DIMENSIONED BY 5. C THE CONTENTS OF "A" ARE AS FOLLOWS: C A(1) - RUNNING SUM OF DATA C A(2) - RUNNING SUM OF SQUARES OF DATA C A(3) - WORD 1 - NUMBER OF POINTS C WORD 2 - MODE OF STATISTICS C A(4) - WORD 1 - LOWER BOUND OF HISTOGRAM C WORD 2 - WIDTH OF EACH BAR IN HISTOGRAM C A(5) - WORD 1 - NUMBER OF BARS IN HISTOGRAM C WORD 2 - MODE OF HISTOGRAM DIMENSION A(5),N(2),NHIST(1) C C THE FOLLOWING EQUIVALENCE STATEMENT GIVES ACCESS TO THE TWO C WORDS OF THE FLOATING POINT VARIABLE "RN", WHERE IWRD1 IS THE C FIRST WORD AND IWRD2 IS THE SECOND WORD. EQUIVALENCE (RN,N,IWRD1),(N(2),IWRD2) C C INITIALIZE SUM AND SUM OF SQUARES TO 0.0 A = 0. A(2) = 0. C C INITIALIZE NUMBER OF POINTS TO 0 AND MODE OF STATISTICS TO ITYPE IWRD1 = 0 IWRD2 = ITYPE A(3) = RN C C IF ITYPE < OR = 0 THEN INITIALIZE HISTOGRAM OTHERWISE RETURN IF(ITYPE)10,10,150 10 IWRD1 = IABS(I) DO 20 J = 1,IWRD1 20 NHIST(J) = 0 C C A(5) IS SET TO NUMBER OF BARS IN HISTOGRAM AND MODE OF HISTOGRAM IWRD2 = I A($5) = RN C C A(4) IS SET TO LOWER BOUND AND WIDTH OF HISTOGRAM IWRD1 = ISTRT IWRD2 = IDLTA A(4) = RN 150 RETURN END SUBROUTINE INTLF(ITYPE,A,START,DELTA,NHIST,I) C "INTLF" INITIALIZES THE HISTOGRAM AND OTHER STATISTICAL C ACCUMULATORS FOR RUNNING STATISTICS ON FLOATING POINT DATA. C ARRAY "A" MUST BE PROVIDED FOR EACH VARIABLE FOR WHICH STATISTICS C ARE MAINTAINED. "A" MUST BE A REAL ARRAY DIMENSIONED BY 6. C THE CONTENTS OF "A" ARE AS FOLLOWS: C A(1) - RUNNING SUM OF DATA C A(2) - RUNNING SUM OF SQUARES OF DATA C A(3) - WORD 1 - NUMBER OF POINTS C WORD 2 - MODE OF STATISTICS C A(4) - LOWER BOUND OF HISTOGRAM C A(5) - WIDTH OF EACH BAR IN HISTOGRAM C A(6) - WORD 1 - NUMBER OF BARS IN HISTOGRAM C WORD 2 - MODE OF HISTOGRAM DIMENSION A(6),N(2),NHIST(1) C C THE FOLLOWING EQUIVALENCE STATEMENT GIVES ACCESS TO THE TWO C WORDS OF THE FLOATING POINT VARIABLE "RN", WHERE IWRD1 IS THE C FIRST WORD AND IWRD2 IS THE SECOND WORD. EQUIVALENCE (RN,N,IWRD1),(N(2),IWRD2) C C INITIALIZE SUM AND SUM OF SQUARES TO 0.0 A = 0. A(2) = 0. C C INITIALIZE NUMBER OF POINTS TO 0 AND MODE OF STATISTICS TO ITYPE IWRD1 = 0 IWRD2 = ITYPE A(3) = RN C C IF ITYPE < OR = 0 THEN INITIALIZE HISTOGRAM OTHERWISE RETURN IF(ITYPE)10,10,150 10 IWRD1 = IABS(I) DO 20 J = 1,IWRD1 20 NHIST(J) = 0 C C A(6) IS SET TO NUMBER OF BARS IN HISTOGRAM AND MODE OF HISTOGRAM IWRD2 = I A(6) = RN C C A(4) AND A(5) ARE SET TO LOWER BOUND AND WIDTH OF HISTOGRAM A(4) = START A(5) = DELTA 150 RETURN END SUBROUTINE RCRDI(IDATA,A,IERR,NHIST) C "RCRDI" UPDATES THE RUNNING STATISTICS BEING MAINTAINED IN C IN ARRAYS "NHIST" AND "A" WITH THE VALUE OF "IDATA". THE C FORMAT OF "A" IS DESCRIBED IN SUBROUTINE INTLI C DIMENSION A(5),N(2),NHIST(1) EQUIVALENCE (RN,N,ISSTRT),(N(2),MODE,IDLTA) C C ASSUME NO ERRORS IERR = 0 C C IF THE MODE OF THE STATISTICS > = 0 THEN UPDATE THE SUM C AND SUM OF THE SQUARES OF "IDATA". RN = A(3) IF(MODE)100,200 C C UPDATE NUMBER OF POINTS, SUM AND SUM OF SQUARES 200 N = N+1 A(3) = RN DATA = IDATA A = A+DATA A(2) = A(2)+DATA*DATA C C IF THE MODE < = 0 UPDATE HISTOGRAM, OTHERWISE RETURN IF(MODE)100,100,600 C C C UPDATE HISTOGRAM C C COMPUTE BAR NUMBER (M = BAR NUMBER - 1 ) 100 RN = A(4) M = (IDATA-ISTRT)/IDLTA RN = A(5) C C CHECK TO SEE IDATA IS IN BOUNDS OF HISTOGRAM IF(M)400,301 301 IF(M-N)302,450 C C IDATA GREATER THAN UPPER BOUND OF HISTOGRAM C IF HISTOGRAM MODE > 0 INCLUDE POINT IN LAST BAR COUNT 450 M = N-1 IF(MODE)601,402 C C IDATA LESS THAN LOWER BOUND OF HISTOGRAM C IF HISTOGRAM MODE > 0 INCLUDE POINT IN FIRST BAR COUNT 400 IF(MODE)601,401 401 M = 0 402 IERR = 1 C C INCREMENT PROPER BAR OF HISTOGRAM 302 NHIST(M+1) = NHIST(M+1)+1 600 RETURN 601 IERR = -1 RETURN END SUBROUTINE RCRDF(DATA,A,IERR,NHIST) C "RCRDF" UPDATES THE RUNNING STATISTICS BEING MAINTAINED IN C IN ARRAYS "NHIST" AND "A" WITH THE VALUE OF "DATA". THE C FORMAT OF "A" IS DESCRIBED IN SUBROUTINE INTLB C DIMENSION A(6),N(2),NHIST(1) EQUIVALENCE (RN,N),(N(2),MODE) C C ASSUME NO ERRORS IERR = 0 C C IF THE MODE OF THE STATISTICS > = 0 THEN UPDATE THE SUM C AND SUM OF THE SQUARES OF "DATA". RN = A(3) IF(MODE)100,200 C C UPDATE NUMBER OF POINTS, SUM AND SUM OF SQUARES 200 N = N+1 A(3) = RN A = A+DATA A(2) = A(2)+DATA*DATA C C IF THE MODE < = 0 UPDATE HISTOGRAM, OTHERWISE RETURN IF(MODE)100,100,600 C C C UPDATE HISTOGRAM C C COMPUTE BAR NUMBER (M = BAR NUMBER - 1 ) 100 M = (DATA-A(4))/A(5) RN = A(6) C C CHECK TO SEE DATA IS IN BOUND 0 INCLUDE POINT IN LAST BAR COUNT 450 M = N-1 IF(MODE)601,402 C C DATA LESS THAN LOWER BOUND OF HISTOGRAM C IF HISTOGRAM MODE > 0 INCLUDE POINT IN FIRST BAR COUNT 400 IF(MODE)601,401 401 M = 0 402 IERR = 1 C C INCREMENT PROPER BAR OF HISTOGRAM 302 NHIST(M+1) = NHIST(M+1)+1 600 RETURN 601 IERR = -1 RETURN END SUBROUTINE REPRT(A,RMEAN,STDEV,NUM) C C "REPRT" COMPUTES MEAN AND STANDARD DEVIATION FROM THE C SUM, SUM OF SQUARES AND NUMBER OF POINTS CONTAINED C IN ARRAY "A". DIMENSION A(3) C C THIS EQUIVALENCE ALLOWS ACCESS TO THE FIRST WORD OF A FLOATING C POINT NUMBER. EQUIVALENCE (RN,N) C C THE FIRST WORD OF A(3) IS THE NUMBER OF POINTS RN = A(3) NUM = N RN = N RMEAN = A/RN STDEV = SQRT((A(2)-A*RMEAN)/(RN-1.)) RETURN END END$ FTN,L,B SUBROUTINE INTLB(ITYPE,A,START,DELTA,RHIST,I) C "INTLB" INITIALIZES THE HISTOGRAM AND OTHER STATISTICAL C ACCUMULATORS FOR RUNNING STATISTICS ON FLOATING POINT DATA. C ARRAY "A" MUST BE PROVIDED FOR EACH VARIABLE FOR WHICH STATISTICS C ARE MAINTAINED. "A" MUST BE A REAL ARRAY DIMENSIONED BY 6. C THE CONTENTS OF "A" ARE AS FOLLOWS: C A(1) - RUNNING SUM OF DATA C A(2) - RUNNING SUM OF SQUARES OF DATA C A(3) - WORD 1 - NUMBER OF POINTS C WORD 2 - MODE OF STATISTICS C A(4) - LOWER BOUND OF HISTOGRAM C A(5) - WIDTH OF EACH BAR IN HISTOGRAM C A(6) - WORD 1 - NUMBER OF BARS IN HISTOGRAM C WORD 2 - MODE OF HISTOGRAM DIMENSION A(6),N(2),RHIST(1) C C THE FOLLOWING EQUIVALENCE STATEMENT GIVES ACCESS TO THE TWO C WORDS OF THE FLOATING POINT VARIABLE "RN", WHERE IWRD1 IS THE C FIRST WORD AND IWRD2 IS THE SECOND WORD. EQUIVALENCE (RN,N,IWRD1),(N(2),IWRD2) C C INITIALIZE SUM AJND SUM OF SQUARES TO 0.0 A = 0. A(2) = 0. C C INITIALIZE NUMBER OF POINTS TO 0 AND MODE OF STATISTICS TO ITYPE IWRD1 = 0 IWRD2 = ITYPE A(3) = RN C C IF ITYPE < OR = 0 THEN INITIALIZE HISTOGRAM OTHERWISE RETURN IF(ITYPE)10,10,150 10 IWRD1 = IABS(I) DO 20 J = 1,IWRD1 20 RHIST(J) = 0 C C A(6) IS SET TO NUMBER OF BARS IN HISTOGRAM AND MODE OF HISTOGRAM IWRD2 = I A(6) = RN C C A(4) AND A(5) ARE SET TO LOWER BOUND AND WIDTH OF HISTOGRAM A(4) = START A(5) = DELTA 150 RETURN END SUBROUTINE RCRDB(DATA,A,IERR,RHIST) C "RCRDB" UPDATES THE RUNNING STATISTICS BEING MAINTAINED IN C IN ARRAYS "RHIST" AND "A" WITH THE VALUE OF "DATA". THE C FORMAT OF "A" IS DESCRIBED IN SUBROUTINE INTLF C DIMENSION A(6),N(2),RHIST(1) EQUIVALENCE (RN,N),(N(2),MODE) C C ASSUME NO ERRORS IERR = 0 C C IF THE MODE OF THE STATISTICS > = 0 THEN UPDATE THE SUM C AND SUM OF THE SQUARES OF "DATA". RN = A(3) IF(MODE)100,200 C C UPDATE NUMBER OF POINTS, SUM AND SUM OF SQUARES 200 N = N+1 A(3) = RN A = A+DATA A(2) = A(2)+DATA*DATA C C IF THE MODE < = 0 UPDATE HISTOGRAM, OTHERWISE RETURN IF(MODE)100,100,600 C C C UPDATE HISTOGRAM C C COMPUTE BAR NUMBER (M = BAR NUMBER - 1 ) 100 M = (DATA-A(4))/A(5) RN = A(6) C C CHECK TO SEE DATA IS IN BOUNDS OF HISTOGRAM IF(M)400,301 301 IF(M-N)302,450 C C DATA GREATER THAN UPPER BOUND OF HISTOGRAM C IF HISTOGRAM MODE > 0 INCLUDE POINT IN LAST BAR COUNT 450 M = N-1 IF(MODE)601,402 C C DATA LESS THAN LOWER BOUND OF HISTOGRAM C IF HISTOGRAM MODE > 0 INCLUDE POINT IN FIRST BAR COUNT 400 IF(MODE)601,401 401 M = 0 402 IERR = 1 C C INCREMENT PROPER BAR OF HISTOGRAM 302 RHIST(M+1) = RHIST(M+1)+1. 600 RETURN 601 IERR = -1 RETURN END END$ =0.**0 a n 92404-80001 A S 0106 CODE CONVERSION PACKAGE              H0101 nASMB,R,L,B,C * * HP92404A CODE CONVERSION PACKAGE * * SOURCE TAPE 92404-80001 REV. A * RELOC. TAPE 92404-60001 REV. A * * AUTHOR T.A. SAPONAS * * VERSION 4 OCTOBER 1973 * * HED ASCII TO BCDIC CODE CONVERSION ROUTINE NAM ASCBC,7 ENT ASCBC EXT .ENTR SUP A EQU 0 TEMP BSS 1 TEMPORARY STORAGE NCHAR BSS 1 NUMBER CHARS. TO BE CONVERTED SOURC BSS 1 ADDRESS OF ARRAY TO BE CONVERTED DESTN BSS 1 DESTINATION ADDRESS OF CHARS. ERROR BSS 1 BAD CHARACTER COUNTER ASCBC NOP JSB .ENTR GET ADDRESSES OF CALLING PARAMS. DEF NCHAR LDA NCHAR,I FETCH NUMBER OF CHARACTERS CMA,SSA,INA,SZA IF < OR = 0 RETURN CLB,RSS ELSE, CLEAR CHARACTER COUNTER JMP ASCBC,I STB ERROR,I CLEAR BAD CHARACTER COUNTER NXCHR LDA SOURC,I / SLB,RSS / GET NEXT CHARACTER TO BE ALF,ALF \ CONVERTED AND =B177 \ CLE,ERA / GET WORD CONTAINING NEW ADA TABLE < CHARACTER LDA A,I \ SEZ UPPER BYTE? ALF,ALF NO,SHIFT TO UPPER BYTE AND =B177400 / EXTRACT AND SAVE NEW STA TEMP \ CHARACTER SSA / IF HIGH ORDER BIT SET, THEN ISZ ERROR,I \ INCREMENT BAD CHAR. COUNTER LDA DESTN,I GET DESTINATION WORD SLB UPPER BYTE? ALF,ALF NO,SHIFT TO UPPER BYTE AND =B377 MASK DESTINATION BYTE IOR TEMP INSERT NEW CHARACTER SLB,INB / ALF,ALF < STORE DESTINATION WORD STA DESTN,I \ CPB NCHAR,I LAST CHARACTER? JMP ASCBC,I YES, RETURN SLB ANOTHER CHARACTER IN SOURCE WORD? JMP NXCHR YES, GO TO NEXT CHARACTER ISZ SOURC / ISZ DESTN < NO, INCREMENT SOURC, DESTN JMP NXCHR \ POINTERS AND GO TO NEXT CHAR. * * * THE FOLLOWING TABLE CONTAINS THE TRУANSLATION OF ASCII TO BCDIC * * XXX INDICATES THERE IS NO CORESPONDING CODE IN BCDIC AND THE CODE * GIVEN IS THE ASCII CODE WITH THE HIGH ORDER BIT OF THE 8 BIT * BYTE SET TO 1. THE LOWER CASE ASCII CHARACTERS ARE TRANSLATED * TO UPPER CASE BCDIC. * * TABLE DEF A000 LOCATION OF TRANSLATION TABLE * * ASCII _ 0 1 2 3 4 5 6 7 * ^^^ A000 OCT 100201,101203,102205,103207 * BCDIC--> XXXXXX XXXXXX XXXXXX XXXXXX * A010 OCT 104035,015213,106077,107217 * XXX XXX XXX XXXXXX * A020 OCT 110221,111223,112225,113227 * XXXXXX XXXXXX XXXXXX XXXXXX * A030 OCT 114231,115233,116235,117237 * XXXXXX XXXXXX XXXXXX XXXXXX * A040 OCT 010052,017417,025457,030035 * SP ! $ & * A050 OCT 016074,026060,015440,035421 * ( ) * + , - . / * A060 OCT 005001,001003,002005,003007 * 0 1 2 3 4 5 6 7 * A070 OCT 004011,006456,037013,007072 * 8 9 : ; < = > ? * A100 OCT 006061,031063,032065,033067 * @ A B C D E F G * A110 OCT 034071,020442,021444,022446 * H I J K L M N O * A120 OCT 023450,024422,011424,012426 * P Q R S T U V W * A130 OCT 013430,014475,017055,156337 * X Y Z [ \ ] XXXXXX * * THE FOLLOWING TRANSLATION IS FROM LOWER CASE ASCII * TO UPPER CASE BCDIC A140 OCT 160061,031063,032065,033067 * XXX A B C D E F G * A150 OCT 034071,020442,021444,022446 * H I J K L M N O * A160 OCT 023450,024422,011424,012426 * P Q R S T U V W * A170 OCT 013430,014773,176375,177377 * " X Y Z XXX XXXXXX XXXXXX END ASMB,R,L,B,C HED ASCII TO EBCDIC CODE CONVERSION ROUTINE NAM ASCEB,7 ENT ASCEB EXT .ENTR SUP A EQU 0 TEMP BSS 1 TEMPORARY STORAGE NCHAR BSS 1 NUMBER CHARS. TO BE CONVERTED SOURC BSS 1 ADDRESS OF ARRAY TO BE CONVERTED DESTN BSS 1 DESTINATION ADDRESS OF CHARS. ASCEB NOP JSB .ENTR GET ADDRESSES OF CALLING PARAMS. DEF NCHAR LDA NCHAR,I FETCH NUMBER OF CHARACTERS CMA,SSA,INA,SZA IF < OR = 0 RETURN CLB,RSS ELSE, CLEAR CHARACTER COUNTER JMP ASCEB,I NXCHR LDA SOURC,I / SLB,RSS / GET NEXT CHARACTER TO BE ALF,ALF \ CONVERTED AND =B177 \ CLE,ERA / GET WORD CONTAINING NEW ADA TABLE < CHARACTER LDA A,I \ SEZ UPPER BYTE? ALF,ALF NO,SHIFT TO UPPER BYTE AND =B177400 /EXTRACT AND SAVE NEW STA TEMP \ CHARACTER LDA DESTN,I GET DESTINATION WORD SLB UPPER BYTE? ALF,ALF NO,SHIFT TO UPPER BYTE AND =B377 MASK DESTINATION BYTE IOR TEMP INSERT NEW CHARACTER SLB,INB / ALF,ALF < STORE DESTINATION WORD STA DESTN,I \ CPB NCHAR,I LAST CHARACTER? JMP ASCEB,I YES, RETURN SLB ANOTHER CHARACTER IN SOURCE WORD? JMP NXCHR YES, GO TO NEXT CHARACTER ISZ SOURC / ISZ DESTN < NO, INCREMENT SOURC, DESTN JMP NXCHR \ POINTERS AND GO TO NEXT CHAR. * * TABLE DEF A000 LOCATION OF TRANSLATION TABLE * * THIS IS THE TABLE FOR CONVERSION FROM ASCII TO EBCDIC * * ASCII _ 0 1 2 3 4 5 6 7 * ^^^ A000 OCT 000001,001003,033455,027057 * EBCDIC-->NULSOH STXETX EOTENQ ACKBEL * A010 OCT 013005,022413,006015,007017 * BS HT *LF VT FF CR SO IC * A020 OCT 010021,011023,036075,031046 * DLEDC1 DC2DC3 DC4NAK SYNETB * A030 OCT 014031,037447,016035,017037 * CAN EM SUBESC IFSIGS IRSIUS * A040 OCT 040117,077573,055554,050175 * SP ! " # $ % & ' * A050 OCT 046535,056116,065540,045541 * ( ) * + , - . / * A060 OCT 170361,171363,172365,173367 * 0 1 2 3 4 5 6 7 * A070 OCT 174371,075136,046176,067157 * 8 9 : ; < = > ? * A100 OCT 076301,141303,142305,143307 * @ A B C D E F G * A110 OCT 144311,150722,151724,152726 * H I J K L M N O * A120 OCT 153730,154742,161744,162746 * P Q R S T U V W * A130 OCT 163750,164512,160532,057555 * X Y Z [ \ ! ] - * * THE FOLLOWING TRANSLATION IS FROM LOWER CASE ASCII * TO LOWER CASE EBCDIC A140 OCT 074601,101203,102205,103207 * \ A B C D E F G * A150 OCT 104211,110622,111624,112626 * H I J K L M N O * A160 OCT 113630,114642,121644,122646 * P Q R S T U V W * A170 OCT 123650,124700,065320,120407 * X Y Z ! DEL * END ASMB,R,L,B,C HED BCDIC TO ASCII CODE CONVERSION ROUTINE NAM BCDAS,7 ENT BCDAS EXT .ENTR SUP A EQU 0 TEMP BSS 1 TEMPORARY STORAGE NCHAR BSS 1 NUMBER CHARS. TO BE CONVERTED SOURC BSS 1 ADDRESS OF ARRAY TO BE CONVERTED DESTN BSS 1 DESTINATION ADDRESS OF CHARS. BCDAS NOP JSB .ENTR GET ADDRESSES OF CALLING PARAMS. DEF NCHAR LDA NCHAR,I FETCH NUMBER OF CHARACTERS CMA,SSA,INA,SZA IF < OR = 0 RETURN CLB,RSS ELSE, CLEAR CHARACTER COUNTER JMP BCDAS,I NXCHR LDA SOURC,I / SLB,RSS / GET NEXT CHARACTER TO BE ALF,ALF \ CONVERTED AND =B77 \ CLE,ERA / GET WORD CONTAINING NEW ADA TABLE < CHARACTER LDA A,I \ SEZ UPPER BYTE? ALF,ALF NO,SHIFT TO UPPER BYTE AND =B177400 /EXTRACT AND SAVE NEW STA TEMP \ CHARACTER LDA DESTN,I GET DESTINATION WORD SLB UPPER BYTE? ALF,ALF NO,SHIFT TO UPPER BYTE AND =B377 MASK DESTINATION BYTE IOR TEMP INSERT NEW CHARACTER SLB,INB / ALF,ALF < STORE DESTINATION WORD STA DESTN,I \ CPB NCHAR,I LAST CHARACTER? JMP BCDAS,I YES, RETURN SLB ANOTHER CHARACTER IN SOURCE WORD? JMP NXCHR YES, GO TO NEXT CHARACTER ISZ SOURC / ISZ DESTN < NO, INCREMENT SOURC, DESTN JMP NXCHR \ POINTERS AND GO TO NEXT CHAR. * * THE FOLLOWING TABLE CONTAINS THE TRANSLATION OF BCDIC TO ASCII * TABLE DEF B00 LOCATION OF TRANSLATION TABLE * * BCDIC _ 0 1 2 3 4 5 6 7 * ^^^ B00 OCT 020061,031063,032065,033067 * ASCII--> SP 1 2 3 4 5 6 7 * B10 OCT 034071,030075,040072,035043 * 8 9 0 = @ : > # * B20 OCT 020057,051524,052526,053530 * SP / S T U V W X * B30 OCT 054532,005054,024011,056042 * Y Z LF , ( HT \ " * B40 OCT 026512,045514,046516,047520 * - J K L M N O P * B50 OCT 050522,020444,025135,035445 * Q R ! $ * ] ; % * B60 OCT 025501,041103,042105,043107 * + A B C D E F G * B70 OCT 044111,037456,024533,036015 * H I ? . ) [ < CR END ASMB,R,L,B,C HED EBCDIC TO ASCII CODE CONVERSION ROUTINE NAM EBCAS,7 ENT EBCAS EXT .ENTR SUP A EQU 0 TEMP BSS 1 TEMPORARY STORAGE NCHAR BSS 1 NUMBER CHARS. TO BE CONVERTED SOURC BSS 1 ADDRESS OF ARRAY TO BE CONVERTED DESTN BSS 1 DESTINATION ADDRESS OF CHARS. ERROR BSS 1 BAD CHARACTER COUNTER EBCAS NOP JSB .ENTR GET ADDRESSES OF CALLING PARAMS. DEF NCHAR LDA NCHAR,I FETCH NUMBER OF CHARACTERS CMA,SSA,INA,SZA IF < OR = 0 RETURN CLB,RSS ELSE, CLEAR CHARACTER COUNTER JMP EBCAS,I STB ERROR,I CLEAR BAD CHARACTER COUNTER NXCHR LDA SOURC,I / SLB,RSS / GET NEXT CHARACTER TO BE ALF,ALF \ CONVERTED AND =B377 \ CLE,ERA / GET WORD CONTAINING NEW ADA TABLE < CHARACTER LDA A,I \ SEZ UPPER BYTE? ALF,ALF NO,SHIFT TO UPPER BYTE AND =B177400 /EXTRACT AND SAVE NEW STA TEMP \ CHARACTER SSA /IF HIGH ORDER BIT SET, THEN ISZ ERROR,I \ INCREMENT BAD CHAR. COUNTER LDA DESTN,I GET DESTINATION WORD SLB UPPER BYTE? ALF,ALF NO,SHIFT TO UPPER BYTE AND =B377 MASK DESTINATION BYTE IOR TEMP INSERT NEW CHARACTER SLB,INB / ALF,ALF < STORE DESTINATION WORD STA DESTN,I \ CPB NCHAR,I LAST CHARACTER? JMP EBCAS,I YES, RETURN SLB ANOTHER CHARACTER IN SOURCE WORD? JMP NXCHR YES, GO TO NEXT CHARACTER ISZ SOURC / ISZ DESTN < NO, INCREMENT SOURC, DESTN JMP NXCHR \ POINTERS AND GO TO NEXT CHAR. * * TABLE DEF E000 LOCATION OF TRANSLATION TABLE * * THIS IS THE TABLE FOR CONVERSION FROM EBCDIC TO ASCII * XXX INDICATES NO TRANSLATION, THE RESULTING CHARACTER * J`HAS BIT 7 SET (HIGH ORDER BIT) AND BITS 0 THRU 6 REMAIN * THE SAME AS THE SOURCE CODE * * EBCDIC _ 0 1 2 3 4 5 6 7 * ^^^ E000 OCT 000001,001003,102011,103177 * ASCII--> NULSOH STXETX XXX HT XXXDEL * E010 OCT 104211,105013,006015,007017 * XXXXXX XXX VT FF CR SO SI * E020 OCT 010021,011023,112012,004000 * DLEDC1 DC2DC3 XXX LG BS NUL * E030 OCT 014031,115233,016035,017037 * CAN EM XXXXXX FS GS RS US * E040 OCT 120241,121243,122012,013433 * XXXXXX XXXXXX XXX LF ETBESC * E050 OCT 124251,125253,126005,003007 * XXXXXX XXXXXX XXXENQ ACKBEL * E060 OCT 130261,013263,132265,133004 * XXXXXX SYNXXX XXXXXX XXXEOT * E070 OCT 134271,135273,012025,137032 * XXXXXX XXXXXX DC4NAK XXXSUB * E100 OCT 020301,141303,142305,143307 * SP XXX XXXXXX XXXXXX XXXXXX * E110 OCT 144311,055456,036050,025441 * XXXXXX [ . < ( + ! * E120 OCT 023321,151323,152325,153327 * & XXX XXXXXX XXXXXX XXXXXX * E130 OCT 154331,056444,025051,035536 * XXXXXX ] $ : ) : 7 * E140 OCT 026457,161343,162345,163347 * - / XXXXXX XXXXXX XXXXXX * E150 OCT 164351,076054,022537,037077 * XXXXXX ! , % - > ? * E160 OCT 170361,171363,172365,173367 * XXXXXX XXXXXX XXXXXX XXXXXX * E170 OCT 174140,035043,040047,036442 * XXX \ : # @ ' = " * * THE FOLLOWING TRANSLATION IS FROM LOWER CASE EBCDIC * TO LOWER CASE ASCII E200 OCT 100141,061143,062145,063147 * XXX A B C D E F G * E210 OCT 064151,105213,106215,107217 * H I XXXXXX XXXXXX XXXXXX 0.** E220 OCT 110152,065554,066556,067560 * XXX J K L M N O P * E230 OCT 070562,115233,116235,117237 * Q R XXXXXX XXXXXX XXXXXX * E240 OCT 120176,071564,072566,073570 * XXXESC S T U V W X * E250 OCT 074572,125253,126255,127257 * Y Z XXXXXX XXXXXX XXXXXX * E260 OCT 130261,131263,132265,133267 * XXXXXX XXXXXX XXXXXX XXXXXX * E270 OCT 134271,135273,136275,137277 * XXXXXX XXXXXX XXXXXX XXXXXX * * THE FOLLOWING TRANSLATION IS FROM UPPER CASE EBCDIC * TO UPPER CASE ASCII E300 OCT 075501,041103,042105,043107 * A B C D E F G * E310 OCT 044111,145313,146315,147134 * H I XXXXXX XXXXXX XXX \ * E320 OCT 076512,045514,046516,047520 * \ J K L M N O P * E330 OCT 050522,155333,156335,157337 * Q R XXXXXX XXXXXX XXXXXX * E340 OCT 160134,051524,052526,053530 * XXX \ S T U V W X * E350 OCT 054532,165353,166355,167357 * Y Z XXXXXX XXXXXX XXXXXX * E360 OCT 030061,031063,032065,033067 * 0 1 2 3 4 5 6 7 * E370 OCT 034071,175373,176375,177377 * 8 9 XXXXXX XXXXXX XXXXXX * END 0 b o 92405-80001 A S 0106 CURVE FITTING PACKAGE              H0101 8FTN,L,B C C HP92405A CURVE FITTING PACKAGE C C SOURCE TAPE 92405-80001 REV. A C RELOC. TAPE 92405-60001 REV. A C C AUTHOR - T.A. SAPONAS C C VERSION 3 OCTOBER 1973 C C SUBROUTINE CRVFT(ITYPE,X,Y,N,A,B,ERRMX) C "CRVFT" PERFORMS A LEAST SQUARE ERROR CURVE FIT ON THE C FUNCTION ARGUMENTS IN ARRAY "X" AND THE CORRESPONDING C FUNCTION VALUES IN ARRAY "Y". "ITYPE" DETERMINES THE CURVE C TO BE FIT, AND "ERRMX" IS THE MAXIMUM ERROR OF THE DATA C FROM THE FITTED CURVE. C IF "ITYPE" OR "N" HAVE ILLEGAL VALUES ERRMX = -2.0 . C IF THE DATA WON'T FIT THE SELECTED CURVE ERRMX = -1.0 . C "A" AND "B" ARE THE COEFFICIENTS FOR THE EQUATION SELECTED C BY "ITYPE". SUBROUTINE "XYTTL" PERFORMS A RUNNING SUM, C SUM OF SQUARES AND SUM OF CROSS PRODUDCT. C DIMENSION X(1),Y(1),SUM(5) C C IF ITYPE < 1 OR ITYPE > 6 OR N < 1 SET ERRMX = -2.0 IF(N)901,901,1 1 IF(ITYPE)901,901,2 2 IF(ITYPE-7)3,901 C C INITIALIZE ACCUMULATORS 3 DO 4 I = 1,5 4 SUM(I) = 0. BSIGN = 1. C C BRANCH TO SELECTED EQUATION CURVE FIT GO TO (100,200,300,400,500,600),ITYPE C C CURVE FIT FOR Y = A*X + B 100 DO 101 I = 1,N 101 CALL XYTTL(SUM,X(I),Y(I)) GO TO 800 C C CURVE FIT FOR Y = A/X + B 200 DO 201 I = 1,N IF(X(I))201,900,201 201 CALL XYTTL(SUM,1./X(I),Y(I)) GO TO 800 C C CURVE FIT FOR Y = 1/( A*X + B ) 300 DO 301 I = 1,N IF(Y(I))301,900,301 301 CALL XYTTL(SUM,X(I),1./Y(I)) GO TO 800 C C CURVE FIT FOR Y = X/( A + B*X ) 400 DO 401 I = 1,N IF(X(I))402,900,402 402 IF(Y(I))401,900,401 401 CALL XYTTL(SUM,1./X(I),1./Y(I)) GO TO 800 C C CURVE FIT FOR Y = B*EXP( A*X ) 500 BSIGN = SIGN(1.,Y) DO 501 I = 1,N A = Y(I)*BSIGN IF(A)900,900,501 501 CALL XYTTL(SUM,X(I),ALOG(A)) GO TO 800 C C CURVE FIT FOR Y = B*X**A 600 BSIGN = SIGN(1.,Y) DO 601 I = 1,N A = BSIGN*Y(I) IF(X(I))900,900,602 !   602 IF(A)900,900,601 601 CALL XYTTL(SUM,ALOG(X(I)),ALOG(A)) 800 RN = N C C COMPUTE A AND B COEFFICIENTS FROM SUMS, SUM OF SQUARES AND C SUM OF CROSS PRODUCT A = (RN*SUM(4)-SUM*SUM(3))/(RN*SUM(2)-SUM*SUM) B = (SUM(3)-A*SUM)/RN IF(ITYPE-5)801,802 802 B = EXP(B) 801 ERRMX = 0. B = BSIGN*B C C COMPUTE MAXIMUM ERROR AND STANDARD ERROR OF CURVE FIT C BY EVALUATING CURVE AT EVERY POINT AND COMPARING TO DATA DO 805 I = 1,N C C BRANCH TO CORRESPONDING FUNCTION EVALUATION GO TO (810,820,830,840,850,860),ITYPE 810 F = A*X(I)+B GO TO 803 820 F = A/X(I)+B GO TO 803 830 F = 1./(A*X(I)+B) GO TO 803 840 F = X(I)/(A+B*X(I)) GO TO 803 850 F = B*EXP(A*X(I)) GO TO 803 860 F = B*X(I)**A C C COMPUTE MAGNITUDE OF ERROR 803 F = ABS(F-Y(I)) C C IF ERROR IS LARGER THAN PREVIOUS MAXIMUM, MAKE IT NEW MAXIMUM IF(ERRMX-F)804,805 804 ERRMX = F 805 CONTINUE RETURN C C ERROR RETURN WHEN DATA WILL NOT FIT CURVE ( EITHER A DIVIDE C BY ZERO OR BOTH POSITIVE AND NEGATIVE Y VALUES IN CURVES C 5 OR 6 ). 900 ERRMX = -1. RETURN C C ERROR RETURN FOR BAD N OR ITYPE 901 ERRMX = -2. RETURN END SUBROUTINE XYTTL(SUM,X,Y) C C "XYTTL" COMPUTES RUNNING SUM, SUM OF SQUARES AND SUM OF C CROSS PRODUCT OF "X" AND "Y" DIMENSION SUM(5) SUM = SUM+X SUM(2) = SUM(2)+X*X SUM(3) = SUM(3)+Y SUM(4) = SUM(4)+X*Y SUM(5) = SUM(5)+Y*Y RETURN END END$ O  cj 92406-80001 A S 0106 INTERPOLATION PACKAGE              H0101 TFTN,L,B C C HP92406A INTERPOLATION PACKAGE C C SOURCE TAPE 92406-80001 REV. A C RELOC. TAPE 92406-60001 REV. A C C AUTHOR - T.A. SAPONAS C C VERSION 2 OCTOBER 1973 C C FUNCTION FRSTU(XR,Y,NPTS,START,DELTA,IERR) C "FRSTU" PERFORMS 1ST ORDER INTERPOLATION ON THE UNIFORMLY C SPACED DATA IN ARRAY "Y". "Y" IS COMPOSED OF "NPTS" POINTS C WITH THE FIRST POINT CORRESPONDING TO "START" AND THE DISTANCE C BETWEEN POINTS IS "DELTA". IF THE ARGUMENT OF THE INTERPOLATION C "XR" IS OUTSIDE THE BOUNDS OF THE TABLE, THE ERROR FLAG "IERR" C IS SET NEGATIVE AND AN EXTRAPOLATION BASED ON THE FIRST OR LAST C POINTS IN THE TABLE IS PERFORMED. DIMENSION Y(1) IERR=-1 C C DETERMINE INTERVAL TO BE INTERPOLATED RM=(XR-START)/DELTA K=1 M=RM C C IF INTERVAL < LOWER BOUND OF TABLE, USE FIRST INTERVAL IF(RM)110,20 20 K=NPTS-1 C C IF INTERVAL > UPPER BOUND, USE LAST INTERVAL IF(K-1-M)110,105,100 100 K=M+1 C C XR WITHIN RANGE OF TABLE SO RESET ERROR FLAG 105 IERR=0 110 P=RM-FLOAT(K-1) C C EVALUATE INTERPOLATION ALGORITHM FRSTU=(1.-P)*Y(K)+P*Y(K+1) RETURN END FUNCTION SCNDU(XR,Y,NPTS,START,DELTA,IERR) C "SCNDU" PERFORMS 2ND ORDER INTERPOLATION ON THE UNIFORMLY C SPACED DATA IN ARRAY "Y". "Y" IS COMPOSED OF "NPTS" POINTS C WITH THE FIRST POINT CORRESPONDING TO "START" AND THE DISTANCE C BETWEEN POINTS IS "DELTA". IF THE ARGUMENT OF THE INTERPOLATION C "XR" IS OUTSIDE THE BOUNDS OF THE TABLE, THE ERROR FLAG "IERR" C IS SET NEGATIVE AND AN EXTRAPOLATION BASED ON THE FIRST OR LAST C POINTS IN THE TABLE IS PERFORMED. DIMENSION Y(1) IERR=-1 C C DETERMINE INTERVAL TO BE INTERPOLATED RM=(XR-START)/DELTA K=1 M=RM C C IF INTERVAL < LOWER BOUND OF TABLE, USE FIRST INTERVAL IF(RM)110,20 20 K=NPTS-2 C C IF INTERVAL > UPPER BOUND, USE LAST INTERVAL IF(K-M)110,105,100 100 K=M+1 C C XR M_WITHIN RANGE OF TABLE SO RESET ERROR FLAG 105 IERR=0 110 P=RM-FLOAT(K) C C EVALUATE INTERPOLATION ALGORITHM SCNDU=P*((P-1.)*Y(K)+(P+1.)*Y(K+2))/2.+(1.-P*P)*Y(K+1) RETURN END FUNCTION FRSTR(XR,Y,X,NPTS,IERR) C C "FRSTR" PERFORMS 1ST ORDER INTERPOLATION ON THE FUNCTION VALUES C IN ARRAY "Y" WHICH CORRESPOND TO THE FUNCTION ARGUMENT VALUES C IN ARRAY "X". IF THE ARGUMENT OF THE INTERPOLATION "XR" IS C LESS THAN X(1) OR GREATER THAN X(NPTS), THE ERROR FLAG "IERR" C IS SET NEGATIVE AND EXTRAPOLATION IS PERFORMED. DIMENSION X(1),Y(1) C C SET ERROR FLAG IERR=-1 I=2 C C IF XR < X(1) EXTRAPOLATE USING FIRST INTERVAL IF(XR-X(1))110,40 C C FIND INTERVAL CONTAINING XR 40 DO 90 I=2,NPTS IF(X(I)-XR)90,100 90 CONTINUE C C XR > X(NPTS) EXTRAPOLATE USING LAST INTERVAL I=NPTS GO TO 110 C C XR WAS WITHIN BOUNDS, SO RESET ERROR FLAG 100 IERR=0 C C EVALUATE INTERPOLATION ALGORITHM 110 FRSTR=Y(I-1)+(Y(I)-Y(I-1))*(XR-X(I-1))/(X(I)-X(I-1)) RETURN END FUNCTION SCNDR(XR,Y,X,NPTS,IERR) C C "SCNDR" PERFORMS 2ND ORDER INTERPOLATION ON THE FUNCTION VALUES C IN ARRAY "Y" WHICH CORRESPOND TO THE FUNCTION ARGUMENT VALUES C IN ARRAY "X". IF THE ARGUMENT OF THE INTERPOLATION "XR" IS C LESS THAN X(1) OR GREATER THAN X(NPTS), THE ERROR FLAG "IERR" C IS SET NEGATIVE AND EXTRAPOLATION IS PERFORMED. DIMENSION X(1),Y(1) C C SET ERROR FLAG IERR=-1 I=2 C C IF XR < X(1) EXTRAPOLATE USING FIRST INTERVAL IF(XR-X(1))110,40 40 NM1=NPTS-1 I=NM1 C C IF XR > X(NPTS) EXTRAPOLATE USING LAST INTERVAL IF(X(NPTS)-XR)110,80 C C FIND INTERVAL CONTAINING XR 80 DO 90 I=2,NM1 IF(X(I)-XR)90,100 90 CONTINUE C C XR IN LAST INTERVAL, SO SET I=NM1 AND RESET ERROR FLAG I=NM1 C C XR WAS WITHIN BOUNDS, SO RESET ERROR FLAG 100 IERR=0 C C EVALUATE INTERPOLATION ALGORITHM  110 A=Y(I-1)+(Y(I)-Y(I-1))*(XR-X(I-1))/(X(I)-X(I-1)) B=Y(I-1)+(Y(I+1)-Y(I-1))*(XR-X(I-1))/(X(I+1)-X(I-1)) SCNDR=(A*(X(I+1)-XR)-B*(X(I)-XR))/(X(I+1)-X(I)) RETURN END END$ I dl 92407-80001 A S 0106 INTEGRATION PACKAGE              H0101 *FTN,L,B C C HP92407A INTEGRATION PACKAGE C C SOURCE TAPE 92407-80001 REV. A C RELOC. TAPE 92407-60001 REV. A C C AUTHOR - T.A. SAPONAS C C VERSION 2 OCTOBER 1973 C C SUBROUTINE STRTA(A,XDLTA,Y1) C "STRTA" INITIALIZES ARRAY "A" FOR THE START OF RUNNING INTEGRATION. C THE CONTENTS OF "A" ARE AS FOLLOWS: C A(1) - PRESENT VALUE OF NUMERIC INTEGRAL C A(2) - 1ST ORDER INTEGRATION - STEP SIZE/2. C 2ND ORDER INTEGRATION - MINUS STEP SIZE/12. C A(3) - PREVIOUS VALUE OF INTEGRAND C A(4) - NOT NEEDED FOR 1ST ORDER INTEGRATION C 2ND ORDER INTEGRATION - PREVIOUS VALUE BEFORE A(3) DIMENSION A(4) C INITIALIZE INTEGRAL A = 0. C INITIALIZE PREVIOUS INTEGRAND A(3) = Y1 C C IF XDLTA IS NEGATIVE THEN 2ND ORDER INTEGRATION IS ASSUMED IF(XDLTA)10,20 C C INITIALIZATION OF A(2) AND A(4) FOR 2ND ORDER INTEGRATION 10 A(2) = XDLTA/12. A(4) = Y1 RETURN C C INITIALIZATION OF A(2) FOR 1ST ORDER INTEGRATION 20 A(2) = XDLTA/2. RETURN END FUNCTION AREA(DATA,A) C "AREA" COMPUTES THE RUNNING NUMERIC INTEGRAL OF "DATA" C EACH TIME AREA IS CALLED IT UPDATES ARRAY "A" AND COMPUTES C THE NEW VALUE OF THE INTEGRAL. TO AVOID ROUNDOFF ERROR, A(1) C SHOULD BE SET TO ZERO EVERY 1000 CALLS WHICH RESETS THE CURRENT C VALUE OF THE INTEGRAL. DIMENSION A(4) C C IF A(2) < 0 THEN PERFORM 2ND ORDER INTEGRATION IF(A(2))10,20 C C EVALUATION OF 2ND ORDER ALGORITHM 10 A(1) = A(1)-(5.*DATA+8.*A(3)-A(4))*A(2) C C UPDATE PREVIOUS VALUE OF DATA A(4) = A(3) GO TO 30 C C EVALUATION OF 1ST ORDER ALGORITHM 20 A(1) = A(1)+(A(3)+DATA)*A(2) C C UPDATE CURRENT VALUE OF DATA 30 A(3) = DATA C RETURN CURRENT VALUE OF INTEGRAL AREA = A(1) RETURN END FUNCTION FAREA(Y,N,DX1) C "FAREA" COMPUTES THE NUMERICAL INTEGRAL OF THE DATA POINTS C IN ARRAY "Y". THE ABSOLUTE VALUE OF "DX" IS THE INTEGRATION C STEP SIZE. IF D‘  X IS NEGATIVE THEN 2ND ORDER INTEGRATION IS C PERFORMED INSTEAD OF 1ST ORDER. C THE 1ST ORDER ALGORITHM IS TRAPEZOIDAL RULE INTEGRATION. C THE 2ND ORDER ALGORITHM IS SIMPSON'S RULE INTEGRATION WITH C A CORRECTION IN THE LAST INTERVAL IF AN EVEN NUMBER OF POINTS C ARE GIVEN. DIMENSION Y(1) FAREA = 0. NM1 = N-1 C C DETERMINE IF 1ST OR 2ND ORDER INTEGRATION IF(DX1)10,20 C C EVALUATION OF 2ND ORDER ALGORITHM 10 DX = DX1/(-3.) IFODD = 1 DO 12 I = 2,NM1 IFODD = -IFODD IF(IFODD)11,12 11 FAREA = FAREA+Y(I) 12 FAREA = FAREA+Y(I) C C IF AN EVEN NUMBER OF POINTS COMPUTE LAST INTERVAL CORRECTION IF(IFODD)22,14 14 FAREA = FAREA+Y(NM1)/2.+(Y(N)-Y(N-2))/8. GO TO 22 C C EVALUATION OF 1ST ORDER ALGORITHM 20 DO 21 I = 2,NM1 21 FAREA = FAREA+Y(I) DX = DX1/2. 22 FAREA = (Y+Y(N)+2.*FAREA)*DX RETURN END END$ ˹  el 92409-80001 D S C0122 7210 PLOTTER LIBRARY PLOTLIB             H0101 ASMB,R,L,C HED * 7210A PLOTTER "PLOT" ROUTINE A92409-80001-1 REV.D NAM PLOT,7 92409-80001 REV. D * **************************************************************** * * 7210A PLOTTER UTILITY * **************************************************************** ************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1975. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * * PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ************************************************************** * * LIST: A92409-80001-1 * SOURCE: 92409-80001 * * REV. D 750313 C. HAMILTON (3-13-75) * **************************************************************** * * * * * ENT WHERE,FACT,PLOT,PLTLU ENT LLEFT,URITE,SFACT * * EXT .ENTR,EXEC,FLOAT,IFIX,RSFLG * * THIS IS THE CENTRAL PROGRAM IN THE * HP REAL-TIME EXECUTIVE OPERATING SYSTEM * PLOTTER PACKAGE. * * ************************* * * * THERE ARE 7 SECTIONS TO THE PLOT PROGRAM * * 1-WHERE ESTABLISHES CURRENT PEN LOCATION * 2-FACT ESTABLISHES SCALING FACTOR OF PLOT * 3-PLOT CONVERTS THE X,Y AND PEN DATA TO PLOT * COMMANDS. * 4-PLTLU ESTABLISHES PLOTTER LOG. UNIT # * 5-LLEFT MOVES PEN TO LOWER LEFT CORNER AND * ESTABLISHES ORIGIN AT 0,0. * 6-URITE MOVES PEN TO UPPER RIGHT CORNER * 7-SFACT SCALES PLOTTER FOR 10X15 INCH PLOT * * * * SKP ********** *** *** *** * * **** ** WHERE **** * * THE -WHERE- CALL ALLOWS THE USER TO DETERMINE THE * CURRENT PLOTTER PEN POSITION. THE NUMBERS PROVIDED * TO THE USER WILL BE IN FLOATING POINT. * * * - FORTRAN LINKAGE - * * CALL WHERE(X,Y) * * X SPECIFIES THE 2 WORD BUFFER FOR X (LREAL). * Y SPECIFIES THE 2 WORD BUFFER FOR Y (REAL). * * * * * * * - CALLING SEQUENCE - * * JSB WHERE WHERE ROUTINE ORIGIN * DEF *+3 RETURN * DEF XC LOCATION OF USER X 2 WD BUFFER * DEF YC LOCATION OF USER Y 2 WD BUFFER * * ** ** ** ** ** * * XC OCT 0 ADDRESS OF 2 WD BUFFER FOR X YC OCT 0 ADDRESS OF 2 WD BUFFER FOR Y * * WHERE NOP JSB .ENTR DEF WHERE-2 LDA #XPEN FETCH CURRENT X POSITION JSB FLOAT CONVERT FROM FIXED TO FLOATING PT FDV #CFAC DST XC,I STORE IN USERS BUFFER * LDA #YPEN FETCH CURRENT Y POSITION JSB FLOAT CONVERT FROM FIXED TO FLOATING FDV #DFAC DST YC,I STORE IN USERS BUFFER JMP WHERE,I EXIT * * * * SKP * *********** **** * * ***** FACT **** * * * THE -FACT- CALL ALLOWS THE USER TO VARY THE SCALING * FACTOR USED FOR EACH PLOT. THE SCALING FACTOR WILL * BE INITIALIZED AT "1". THE FACTOR IS * MULTIPLIED BY 1000,0 FOR USE WITH * THE .001 " (SET UP FOR 10") PLOTTER * * * - FORTRAN LINKAGE - * * CALL FACT(AX,AY) * * AX = X PLOT FACTOR (REAL) * AY = Y PLOT FACTOR (REAL) * * * * * * - CALLING SEQUENCE - * * JSB FACT FACTOR ROUTINE ORIGIN * DEF *+3 * DEF FCT LOC OF X PLOT FACTOR * DEF FCT+1 " " Y " " * * ** ** ** ** ** ** * * * FCT OCT 0 ADDRESS OF 2 WD FP FACTOR OCT 0 FACT NOP JSB .ENTR DEF FACT-2 JSB RSFLG SET SAVE RSOURCE FLAG DEF *+1 DLD FCT,I FMP F1000 DST #CFAC X COORDINATE PLOT FACTOR. DLD FCT+1,I FMP F1000 DST #DFAC Y COORDINATE PLOT FACTOR JMP FACT,I * * * SKP *********** ******** ****** * * ***** PLOT **** * * * THE -PLOT- ROUTINE CONVERTS THE DEFINED X,Y * PARAMETERS TO PLOT INFORMATION THEN EXECUTES * THE PLOT. * * * * ** RESTRICTION--- NO PLOT LENGTH CAN EXCEED 16,383 * INCREMENTS. (APPROXIMATELY 163 INCHES) * * * - FORTRAN LINKAGE - * * CALL PLOT(X,Y,IC) * * -X,Y DEFINES THE NEW COORDINATE TO BE PLOTTED. * * -IC DEFINES THE PEN UP/DOWN COMMAND. * -2 MOVES W/PEN DOWN FINAL PEN POSITION =NEW ORIGIN. * -3 MOVES W/PEN UPWN FINAL PEN POSITION =NEW ORIGIN. * +2 MOVES W/PEN DOWN ORIGIN IS UNCHANGED. * +3 MOVES W/PEN UP ORIGIN IS UNCHANGED. * * * * * - CALLING SEQUENCE - * * JSB PLOT PLOT ROUTINE ORIGIN * DEF *+4 * DEF X ADDRESS OF X COORDINATE. * DEF Y ADDRESS OF Y COORDINATE. * DEF IC ADDRESS OF PEN COMMAND. ****** ****** * * X OCT 0 ADDRESS OF X PLOT DATA. Y OCT 0 ADDRESS OF Y PLOT DATA. IC OCT 0 ADDRESS OF PEN COMMAND. * PLOT NOP JSB .ENTR DEF PLOT-3 JSB RSFLG SET SAVE RESOURCE FLAG DEF *+1 * * DLD X,I LOAD X PLOT DATA JSB FPC CONVERT AND FACTOR STA IX STORE FIXED X #. * DLD Y,I LOAD Y PLOT DATA JSB FPD CONVERT AND FACTOR STA IY STORE FIXED Y #. * DLD #XPEN LOAD OLD X,Y PLOT DATA * * #XPEN AND #YPEN ARE IN 2 CONSECUTIVE * LOCATIONS FOR THIS DOUBLE LOAD. * * THE NEW DX,DY (IDX,IDY) WILL BE * CALCULATED AS FOLLOWS: * * IX - #XPEN= IDX * IY - #YPEN= IDY * * WHERE IX = NEW X * IY = NEW Y * #XPEN= OLD X * #YPEN= OLD Y * CMA,INA 2'S COMPLEMENT #XPEN CMB,INB 2'S COMPLEMENT #YPEN ADA IX IX - #XPEN ADB IY IY - #YPEN DST IDX  STORE #XPEN,#YPEN * DLD IX SET #XPEN,#YPEN= IX,IY DST #XPEN * * AT THIS POINT #XPEN,#YPEN CONTAIN THE NEW X,Y * FOR REFERENCE AS THE "OLD" POINT FOR THE NEXT * PLOT CALL. * * * * DETERMINE PLOT MODE AND DRAW THE LINE.... * LDA IC,I GET PEN COMMAND SSA,RSS NEW ORIGIN? JMP PU.1 NO CLB YES STB #XPEN STB #YPEN CMA,INA ABSOLUTIZE PEN COMAND PU.1 CPA C01 PLOT POINTS? JMP PU.4 YES! CPA C02 MOVE WITH PEN DOWN? JMP PU.2 YES CCA MOVE WITH PEN UP STA PENC JMP PU.3 PU.4 CLA RSS PU.2 CLA,INA MOVE WITH PEN DOWN STA PENC PU.3 JSB EXEC DRAW THE LINE.... DEF *+5 DEF C02 DEF #PTLU DEF BUFR DEF C05 JMP PLOT,I * * * * THESE ROUTINES MULTIPLY THE PLOT CO-ORDINATES * BY THE SCALE FACTORS THEN CONVERTS FROM * FLOATING POINT TO FIXED. * A= X OR Y PLOT CO-ORDINATE ON ENTRY. * FPC NOP FMP #CFAC (CO-ORDINATE)(X PLOT FACTOR) FAD FD05 ADD ROUNDING VALUE JSB IFIX CONVERT TO INTEGER VALUE JMP FPC,I EXIT WITH A=FIXED PLOT #. * * * FPD NOP FMP #DFAC (CO-ORDINATE) (Y PLOT FACTOR) FAD FD05 ADD ROUNDING VALUE JSB IFIX CONVERT TO INTEGER VALUE. JMP FPD,I EXIT WITH A=FIXED PLOT NUMBER * * * * SKP *** PLTLU *** * * * THE -PLTLU- CALL ALLOWS THE USER TO SET THE * LOGICAL UNIT NUMBER FOR THE DESIRED PLOTTER. * THIS CALL MUST BE MADE TO SET THE LU # BEFORE * THE FIRST CALL TO -PLOT-; OTHERWISE THE SYSTEM * WILL TERMINATE THE USER PROGRAM BECAUSE OF AN * I/O REQUEST ERROR "LOGICAL UNIT = ZERO". * * * - FORTRAN LINKAGE - * * CALL PLTLU(ILU) * * THE LOGICAL UNIT # MUST BE INTEGER * * * - CALLING SEQUENCE : * * JSB PLTLU PLOT LU ROUTINE * DEF *+2 RETURN *  DEF ILU LOCATION OF INTEGER LU # * ***** *** ***** * * * ILU NOP STORAGE FOR LU # ADDRESS * * PLTLU NOP JSB .ENTR SET ADDRESS OF DEF PLTLU-1 PARAMETER IN "ILU". JSB RSFLG SET SAVE RESOURCE FLAG DEF *+1 * LDA ILU,I SET LU # AND B77 ISOLATE LU NUMBER IOR B100 STA #PTLU IN LOCAL STORAGE JMP PLTLU,I * B77 OCT 77 SKP * * LLEFT * URITE * SFACT(X,Y) * * LLEFT MOVES PEN(IN UP POSITION) TO THE LOWER LEFT CORNER * OF THE PAPER. URITE MOVES PEN TO THE UPPER RIGHT CORNER. * SFACT SETS UP THE SCALE FACTOR SUCH THAT THE VALUES GIVEN * IN A CALL TO SFACT WILL BE INTERPRETED AS 9999 BY PLOT. * * LLEFT * LLEFT NOP JSB .ENTR DEF LLEFT JSB EXEC DEF *+5 DEF C02 DEF #PTLU DEF BUFR1 DEF C05 * JSB WHERE DEF *+3 DEF X2 DEF Y2 * JSB PLOT DEF *+4 DEF X2 DEF Y2 DEF N3 * JMP LLEFT,I * * URITE * URITE NOP JSB .ENTR DEF URITE JSB EXEC DEF *+5 DEF C02 DEF #PTLU DEF BUFR2 DEF C05 JMP URITE,I * *SFACT * X1 NOP X: WIDTH SCALE FOR HORIZONATAL MOVEMENTS Y1 NOP Y: HEIGHT SCALE FOR VERTICAL MOVEMENTS SFACT NOP JSB .ENTR DEF X1 * DLD F1000 FMP X1,I DST X2 DLD F9999 FDV X2 DST X2 DLD F1000 FMP Y1,I DST Y2 DLD F9999 FDV Y2 DST Y2 * JSB FACT DEF *+3 DEF X2 DEF Y2 * JMP SFACT,I SKP * * ****** ****** ****** * * * ****** ****** ****** * ***** WORKING STORAGE *** * * * THE FOLLOWING GROUPS OF TWO WORDS MUST BE * IN 2 CONSECUTIVE MEMORY LOCATIONS. * BUFR NOP PENC NOP DEC -1 IDX NOP IDY NOP * * IX OCT 0 ACTUAL X PLOgm$"T DATA IY OCT 0 ACTUAL Y PLOT DATA * * * * * C01 OCT 1 C02 OCT 2 C05 OCT 5 B100 OCT 100 N3 DEC -3 F1000 DEC 1000. F9999 DEC 9999. X2 NOP NOP Y2 NOP NOP #XPEN NOP #YPEN NOP #CFAC DEC 1000.0 #DFAC DEC 1000.0 #PTLU DEC 63 * BUFR1 NOP DEC -1 DEC 0 DEC 0 DEC 0 * BUFR2 NOP DEC -1 DEC 0 DEC 9999 DEC 9999 * * FD05 DEC .5 * END L$ f q 92409-80002 D S C0122 7210 PLOTTER LIBRARY PLOT             H0101 ASMB,R,L,C HED * 7210A PLOTTER "SYMB" ROUTINE A92409-80002-1 REV. D NAM SYMB,7 92409-80002 REV. D ENT SYMB EXT PLOT,SIN,COS,.ENTR,ERR0,IFIX * * * **************************************************************** ************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1975. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * * PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ************************************************************** * * LISTING: A92409-80002-1 * SOURCE: 92409-80002 * * REV. D C. HAMILTON (3-13-75) * * **************************************************************** * * * **************************************************** * * ROUTINE: SYMB (SYMBOL) * * -FORTRAN LINKAGE- * CALL SYMB(X,Y,SIZE,BCD,THETA,N) * * -CALLING SEQUENCE- * JSB SYMB * DEF *+7 * DEF X * DEF Y * DEF SIZE * DEF BCD * DEF THETA * DEF N * * WHERE X AND Y ARE THE PAGE COORDINATES * OF THE LOWER LEFT CORNER OF THE FIRST * CHARACTER. SIZE IS THE DESIRED LETTER * HEIGHT. BCD IS THE LOCATION OF THE * ASCII ARRAY. THETA IS THE ANGLE OF * LETTERING WITH RESPECT TO THE X-AXIS. * * X/Y = 9999. WILL START LOWER LEFT CORNER OF * SYMBOL AT CURRENT PEN POSITION. * * - X,Y,SIZE AND THETA ARE FLOATING POINT * NUMBERS. (THETA IS IN DEGREES). * * N=1 PLOT THE ASCII STRING DEFINED BY BCD * N=-1 PLOT THE SPECIAL CHARACTER GIVEN AND LEAVE THE * PEN DOWN * N=-2 PLOT THE SPECIAL CHARACTER GIVEN AND LEAVE THE * PEN UP * * BCD CAN BE AN INTEGER ARRAY OF THE ACTUAL CHARACTERS *  TO BE PLOTTED (ASCII STRING CONVENTION IS USED * WHICH MEANS THAT THE FIRST WORD INDICATES THE * NUMBER OF CHARCTERS THAT FOLLOWS) OR AN INTEGER * THAT SPECIFIES THE SPECIAL CHARACTER TO BE PLOTTED. * ******************************************************* * X DEF F9999 PARAMETER AREA Y DEF F9999 (SET BY .ENTR AFTER CALL) SIZE DEF OFCT (INITIALIZED TO FIXED VALUES BCD DEF C.02 TO PROTECT ROUTINE FROM SHORT THETA DEF OTHET PARAMETER LIST). N DEF CM.8 * * SYMB NOP JSB .ENTR SET UP PARAMETER DEF SYMB-6 LINKAGE AREA * LDA C.03 INITIALIZE PEN TO STA PEN UP POSITION. LDA N,I CHECK -N- SSA,RSS IF N >= 0, GO TO JMP S1 SET FOR ARRAY PLOT. * * SPECIAL CHARACTER ( N < 0 ) * LDB C.02 CMA,SZA IF N<=-1 THEN SET PEN=2 STB PEN FOR PEN DOWN CONDITION. CCA SET CHCNT = -1 FOR ONE CHAR STA CHCNT TO BE DRAWN. LDA TAB2A SET TABA TO REFERENCE TAB2 - STA TABA SPECIAL CHARACTER TABLE. DLD BCD,I GET CHAR VALU, SAVE A JSB IFIX STA CHAR INDEX TO TAB2. ADA CM15 SUBTRACT 15(8) TO CHECK FOR SSA,RSS RANGE 0 TO 14 (CENTERED CHAR) JMP S2 -NORMAL OFFSET- (GT 14(8)) LDA F4A SET DIVISOR OF SIZE = 4 JMP S2+1 GO TO CHECK X,Y. * * ASCII CHARACTER PLOT (ARRAY OR SINGLE CHARACTER) * S1 LDA BCD,I GET CHAR COUNT ISZ BCD INCREMENT ADDRESS TO CHARACTERS AND M377 MASK OUT HIGH ORDER BITS CMA,INA SET N NEGATIVE - STA B (SAVE TEMPORARILY) SZA,RSS IF N = 0 (SINGLE CHAR PLOT), CCA SET N = -1. STA CHCNT SET N AS INDEX FOR CHAR. COUNT. * LDA BCD GET ARRAY ADDRESS - CONVERT TO RAL CHAR. ADDRESS (UPPER CHAR) SZB,RSS IF SINGLE CHAR. OUTPUT, SET ADDR. INA TO LOWER (BIT 0 =1) STA ARRAD SAVE ADDRESS. LDA TAB1A SET TABLE ADDRESS = TAB1A TO STA TABA REFERENCE ASCII SET TABLE. * S2 LDA F7A SET DIVISOR OF SIZE = 7 STA DIV+1 DLD SIZE,I GET SIZE PARAMETER, DIVIDE BY DIV FDV * 7 OR 4 (FLPT) FOR OFFSET. * (ADDR OF F7 OR F4 - SET AT S2+1) DST FCT SET FACTOR (SIZE/DIV). * * CHECK FOR NEW THETA (ROTATIONAL) PARAMETER * DLD THETA,I CHECK NEW THETA CPA OTHET AGAINST OLD THETA VALUE RSS (INITIALIZED TO 0-DEGREES.) JMP S3 -NEW- CPB OTHET+1 JMP S4 -SAME AS OLD VALUE- * * CONVERT THETA TO RADIANS, COMPUTE SIN, COS * S3 DST OTHET SAVE AS NEW OLD-THETA FMP RADN CONVERT DEGREES TO RADIANS DST TEMP1 JSB SIN CALCULATE SINE JSB ERR0 DST INCS DLD TEMP1 JSB COS CALCULATE COSINE JSB ERR0 DST INCC DLD FCT JMP S5 * * CHECK FOR NEW FACTOR PARAMETER (SIZE/DIV) * S4 DLD FCT CHECK FOR CHANGE IN CPA OFCT FACTOR RSS JMP S5 -NEW- CPB OFCT+1 JMP S8 -SAME AS OLD VALUE * * CALCULATE POINT FACTORS FOR POINT (X1,Y1) * S5 DST OFCT SET NEW VALUE AS OLD FACTOR FMP INCC CALCULATE XA1 = FCT * INCC DST XA1 DLD OFCT FMP INCS CALCULATE YA1 = FCT * INCS DST YA1 * * CALCULATE POINT FACTORS FOR 10X10 MATRIX (2 TO 9) * LDA XA2A SET ADDR. FOR STA TEMP1 XA(2) LDA CM.8 SET INDEX FOR RANGE STA TEMP2 XA(2) TO XA(9) DLD XA1 XA(I) = XA(1) + XA(I-1) S6 FAD XA1 DST TEMP1,I SET XA(I) FOR I = 2-9 ISZ TEMP1 -SET ADDR. ISZ TEMP1 FOR NEXT FLPT NUMBER. ISZ TEMP2 INDEX FOR 2 TO 9 JMP S6 -CONTINUE * LDA YA2A 3REPEAT STA TEMP1 ABOVE LDA CM.8 PROCESSING STA TEMP2 FOR DLD YA1 YA(2) TO YA(9) S7 FAD YA1 ACCORDING TO: DST TEMP1,I ISZ TEMP1 YA(I) = YA(1) + YA(I-1) ISZ TEMP1 ISZ TEMP2 JMP S7 * * PROCESS X,Y COORDINATES IN CALL * S8 DLD X,I IF -X- IS GT OR = TO FSB F9999 9999.0, SSA,RSS THEN USE JMP S9 PREVIOUS X-ORIGIN * DLD X,I SET X-ORIGIN: FSB XA2 FAD YA2 XORG = X - XA(2) + YA(2) DST XORG * S9 DLD Y,I IF -Y- IS GT OR = TO FSB F9999 9999.0, SSA,RSS THEN USE JMP S10 PREVIOUS Y-ORIGIN * DLD Y,I SET Y-ORIGIN: FSB XA2 FSB YA2 YORG = Y - XA(2) - YA(2) DST YORG * S10 LDB N,I IF N < 0, THEN SET LDA CHAR (A) = CHAR INDEX SSB AND GO TO JMP S12 GET CHAR. OFFSETS. * * EXTRACT CHAR FROM BCD ARRAY AND INDEX TO TABLES * S11 LDA ARRAD GET CURRENT CHARACTER ADDRESS ISZ ARRAD - SET FOR NEXT CHARACTER ADDR.- CLE,ERA CONVERT TO WORD ADDR - POSITION LDA A,I IN E. GET WORD AND POSITION SEZ,RSS UPPER (=0) OR LOWER (=1) ALF,ALF CHARACTER AND M77 IN A. (USE ONLY LOW 6-BITS) * S12 ADA TABA SET APPROPRIATE TABLE STA TEMP1 ADDRESS - LDA A,I GET TABLE VALUE FOR -CHAR- AND M377 GET ADDR OF FIRST OFFSET WORD ADA TABLA IN OFFSET TABLE - CONVERT TO RAL UPPER POSITION STA OFFST CHARACTER ADDRESS. LDA TEMP1,I GET TABLE WORD AGAIN. SSA IF BIT 15 = 1, SET OFFSET ADDRESS ISZ OFFST TO LOWER POSITION. ALF,ALF ROTATE OFFSET COUNT TO AND M177 LOW A (7-BITS) AND SET CMA,INA NEGATIVE FOR STA OFFCT INDEX FOR INDEX FACTORS * * EXTRACT AND PROCESS EACH OFFSET PAIR FOR CHARACTER * S13 LDA OFFST GET CURRENT OFFSET-PAIR CHARACTER ISZ OFFST ADDRESS, SET FOR NEXT ADDRESS. CLE,ERA CONVERT TO WORD ADDR, SET POSI- LDA A,I TION IN E, GET OFFSET WORD. SEZ SHIFT OFFSET PAIR TO UPPER A, ALF,ALF (X,Y) OF 8-BITS. AND M1774 ISOLATE AND STA B SAVE X,Y. ALF PUT X AND M17 IN LOW A, ALS MULTIPLY BY 2 STA TEMP1 AND SAVE FOR INDEX TO XA-ARRAY LDA B PUT ALF,ALF Y IN LOW A, AND M17 MULTIPLY ALS BY 2 STA TEMP2 AND SAVE FOR INDEX TO YA. LDA M36 IF X OFFSET = 17(8) FOR LDB C.03 PEN-UP, THEN CPA TEMP1 GO TO SET IC AND GET JMP S14 NEXT OFFSET PAIR. * LDA XAD COMPUTE ADDRESS OF ADA TEMP1 XA-ARRAY FOR X-OFFSET STA TEMP3 LDA YAD COMPUTE ADDRESS OF ADA TEMP2 YA-ARRAY FOR Y-OFFSET STA TEMP4 DLD XORG COMPUTE: FAD TEMP3,I FSB TEMP4,I XT = XORG + XA(KX) - YA(KY) DST XT * LDA YAD COMPUTE ADDRESS OF ADA TEMP1 YA-ARRAY FOR X-OFFSET STA TEMP3 LDA XAD COMPUTE ADDRESS OF ADA TEMP2 XA-ARRAY FOR Y-OFFSET STA TEMP4 DLD YORG COMPUTE FAD TEMP3,I FAD TEMP4,I YT = YORG + YA(KX) + XA(KY) DST YT * * CALL FOR PLOT FOR CURRENT XT,YT * JSB PLOT DEF *+4 DEF XT DEF YT DEF PEN * * LDB C.02 SET FOR PEN DOWN S14 STB PEN * ISZ OFFCT INDEX CHARACTER OFFSET COUNT JMP S13 - MORE TO PROCESS - * * SET X-ORIGIN AND Y-ORIGIN FOR NEXT CHARACTER. * DLD XORG FAD XA7 X-ORIGIN = X-ORIGIN + XA(7) DST XORG * DLD YORG FAD YA7 Y-ORIGIN = Y-ORIGIN + YA(7) DST YORG LDA C.03 STA PEN * ISZ CHCNT INDEX CHARACTER COUNTER JMP S11 - MORE TO PLOT - * * CALL TO SYMB COMPLETED * JMP SYMB,I * * * CONSTANT, FLAG AND STORAGE SECTION * A EQU 0 A, B B EQU 1 REGISTERS * C.02 DEC 2 C.03 DEC 3 CM.8 DEC -8 CM15 DEC -15 * M17 OCT 17 M36 OCT 36 M77 OCT 77 M177 OCT 177 M377 OCT 377 M1774 OCT 177400 * F9999 DEC 9999.0 * F4A DEF F4 F4 DEC 4.0 F7A DEF F7 F7 DEC 7.0 * PEN NOP * CHCNT NOP CHAR NOP OFFST NOP OFFCT NOP ARRAD NOP * TEMP1 NOP TEMPORARY TEMP2 NOP TEMP3 NOP STORAGE TEMP4 NOP * INCS DEC 0. INCC DEC 1.0 * FCT DEC 0. OFCT DEC .02 FOR .14 INCH INCREMENTS (.01 FOR .07) * OTHET DEC 0. INITIALIZE TO ZERO DEGREES ROTATION * RADN DEC .0174533 FACTOR FOR DEGREES TO RADIANS * * * XAD DEF XA0 XA2A DEF XA2 * XA0 DEC .00 INITIAL XA1 DEC .02 VALUES XA2 DEC .04 SET XA3 DEC .06 FOR XA4 DEC .08 .14 INCH XA5 DEC .10 INCREMENTS XA6 DEC .12 XA7 DEC .14 (FOR .07 INCH INCREMENTS, XA8 DEC .16 HALVE VALUES) XA9 DEC .18 * * * YAD DEF YA0 YA2A DEF YA2 * YA0 DEC 0. YA1 DEC 0. YA2 DEC 0. YA3 DEC 0. YA4 DEC 0. YA5 DEC 0. YA6 DEC 0. YA7 DEC 0. YA8 DEC 0. YA9 DEC 0. * * * XORG DEC 0. YORG DEC 0. * XT DEC 0. YT DEC 0. * * TABA NOP * TAB1A DEF TAB1 * TAB2A DEF TAB2 * * * CHARACTER REFERENCE TABLES - * * THE FOLLOWING TABLES (TAB1 AND TAB2) CONTAIN * THE INFORMATION TO ACCESS THE OFFSET TABLE * FOR EACH AVAILABLE CHARACTER. * * EACH CHARACTER OR SPECIAL SYMBOL AVAILABLE * FOR PLOTTING IS ASSOCIATED WITH ONE UNIQUE * WORD IN ONE OF THE FOLLOWING TABLES. * * EACH REFERENCE WORD CONTAINS THE FOLLOWING * INFORMATION: * 1. RELATIVE ADDRESS OF WORD IN OFFSET TABLE * f FOR START OF OFFSET STRING * (BITS 07-00) * 2. NUMBER OF OFFSET PAIRS (8-BITS) IN STRING * (BITS 14-08) * 3. STARTING POSITION OF STRING IN WORD, * 0 MEANS UPPER, 1 MEANS LOWER. * (BIT 15) * * TAB1 COMPRISES THE STANDARD CHARACTER SET * TAB2 COMPRISES SPECIAL CHARACTERS AND * CENTERED SYMBOLS WHICH CAN BE ACCESSED * BY POSITION WHEN PARAMETER N < 0, IN CALL. * * TAB1 IS ORDERED BY POSITION DESIGNATED BY LOWER * 6-BITS OF ASCII CODE (E.G. A = 101 = 01) * - THIS TABLE IS LIMITED TO 64 ENTRIES - 00 * TO 77. * * * POS CNT ADDR CODE CHARACTER * --- --- ---- ---- --------- * TAB2 OCT 103641 1 7 241 00 OCT 106244 1 14 244 01 OCT 003252 0 6 252 02 OCT 003660 0 7 260 03 OCT 103663 1 7 263 04 OCT 003666 0 7 266 05 OCT 003671 0 7 271 06 OCT 004274 0 10 274 07 OCT 005700 0 13 300 08 OCT 003705 0 7 305 09 OCT 007310 0 16 310 10 OCT 006660 0 15 260 11 OCT 103316 1 6 316 12 OCT 002260 0 4 260 13 OCT 006252 0 14 252 14 OCT 101321 1 2 321 15 OCT 101325 1 2 325 16 OCT 102726 1 5 326 17 OCT 103233 1 6 233 18 OCT 104321 1 10 321 19 OCT 002731 0 5 331 20 OCT 102733 1 5 333 21 OCT 103236 1 6 236 22 OCT 001746 0 3 346 23 OCT 004336 0 10 336 24 OCT 004342 0 10 342 25 * * * TAB1 OCT 110347 1 20 347 00 @ OCT 004400 0 11 0 01 A OCT 106005 1 14 5 02 B OCT 104014 1 10 14 03 C OCT 103404 1 7 4 04 D OCT 003422 0 7 22 05 E OCT 003022 0 6 22 06 F OCT 006036 0 14 36 07 G OCT 103025 1 6 25 10 H OCT 003044 0 6 44 11 1 OCT 103047 1 6 47 12 J OCT 003033 0 6 33 13 K OCT 001425 0 3 25 14 L OCT 102431 1 5 31 15 M OCT 102030 1 4 30 16 N OCT 004414 0 11 14 17 O OCT 103453 1 7 53 20 P OCT 006014 0 14 14 21 Q OCT 104453 1 11 53 22 R OCT 006460 0 15 60 23 S OCT 102066 1 4 66 24 T OCT 003447 0 7 47 25 U OCT 001473 0 3 73 26 V OCT 002452 0 5 52 27 W OCT 102474 1 5 74 30 X OCT 002477 0 5 77 31 Y OCT 103467 1 7 67 32 Z OCT 002156 0 4 156 33 OCT 001076 0 2 76 34 OCT 002160 0 4 160 35 OCT 002562 0 5 162 36 OCT 102564 1 5 164 37 _ OCT 100471 1 1 71 40 OCT 003574 0 7 174 41 ! OCT 004577 0 11 177 42 " OCT 105603 1 13 203 43 # OCT 006611 0 15 211 44 $ OCT 106217 1 14 217 45 % OCT 105357 0 12 357 46 & OCT 002177 0 4 177 47 ' OCT 002152 0 4 152 50 ( OCT 002154 0 4 154 51 ) OCT 005542 0 13 142 52 * OCT 002542 0 5 142 53 + OCT 103230 1 6 230 54 , OCT 101143 1 2 143 55 - OCT 102630 1 5 230 56 . OCT 101074 1 2 74 57 / OCT 105013 1 12 13 60 ML0 OCT 102501 1 5 101 61 1 OCT 004504 0 11 104 62 2 OCT 006524 0 15 124 63 3 OCT 102110 1 4 110 64 4 OCT 105112 1 12 112 65 5 OCT 106113 1 14 113 66 6 OCT 102521 1 5 121 67 7 OCT 010524 0 21 124 70 8 OCT 105534 1 13 134 71 9 OCT 105625 1 13 225 72 : OCT 106225 1 14 225 73 ; OCT 001635 0 3 235 74 < OCT 102547 1 5 147 75 = OCT 001640 0 3 240 76 > OCT 007167 0 16 167 77 ? * * * * * CHARACTER - OFFSET - TABLE * -EACH WORD CONTAINS 2 PAIRS OF X,Y OFFSETS, * "X1Y1X2Y2", EACH PAIR IS 8-BITS AND 4 * BITS IN EACH PAIR SPECIFY THE X AND Y POINT * FOR THE OFFSET. * * THE STRING OF OFFSET PAIRS FOR A CHARACTER MAY * START IN THE UPPER OR LOWER POSITION OF A * WORD. THE STARTING LOCATION, POSITION INDICATOR * AND OFFSET COUNT FOR EACH CHARACTER IS CONTAINED * IN THE REFERENCE TABLES. * * * PORTIONS OF OFFSET STRINGS MAY OVERLAP OTHER * STRINGS WHEN LINE SEGMENTS AMONG CHARACTERS * ARE IDENTICAL. * * TABLA DEF TABLE DEFINE STARTING ADDRESS OF TABLE * * OCTAL PAIRS ADDRESS SYMBOL * TABLE OCT 021045 2-2 2-5 00 +A OCT 062445 6-5 2-5 OCT 024071 2-10 3-11 OCT 054550 5-11 6-10 OCT 061131 6-2 5-11 -D OCT 064143 6-10 6-3 -B OCT 051042 5-2 2-2 OCT 024531 2-11 5-11 OCT 064147 6-10 6-7 10 OCT 053046 5-6 2-6 OCT 053145 5-6 6-5 OCT 061527 6-3 5-7 -0 OCT 064143 6-10 6-3 +Q,+0,-C OCT 051062 5-2 3-2 OCT 021450 2-3 2-10 OCT 034531 3-11 5-11 OCT 064360 6-f10 17-0 20 OCT 042142 4-4 6-2 OCT 064451 6-11 2-11 +E,+F OCT 023126 2-6 5-6 OCT 023042 2-6 2-2 OCT 061042 6-2 2-2 +L,-H OCT 024446 2-11 2-6 OCT 063151 6-6 6-11 OCT 061042 6-2 2-2 30 -N OCT 024542 2-11 6-2 -M OCT 064506 6-11 4-6 OCT 024442 2-11 2-2 +K OCT 022551 2-5 6-11 OCT 043542 4-7 6-2 OCT 072525 7-5 5-5 +G OCT 062543 6-5 6-3 OCT 051062 5-2 3-2 40 OCT 021450 2-3 2-10 OCT 034531 3-11 5-11 OCT 064147 6-10 6-7 OCT 051062 5-2 3-2 +I OCT 041111 4-2 4-11 OCT 034531 3-11 5-11 OCT 024444 2-11 2-4 +U,-J OCT 021462 2-3 3-2 50 OCT 051143 5-2 6-3 OCT 064542 6-11 6-2 +W OCT 043042 4-6 2-2 -P,-R OCT 024531 2-11 5-11 OCT 064147 6-10 6-7 OCT 053046 5-6 2-6 OCT 043142 4-6 6-2 OCT 022043 2-4 2-3 60 +S OCT 031122 3-2 5-2 OCT 061545 6-3 6-5 OCT 053066 5-6 3-6 OCT 023450 2-7 2-10 OCT 034531 3-11 5-11 OCT 064102 6-10 4-2 -T OCT 044451 4-11 2-11 -Z OCT 064442 6-11 2-2 70 OCT 061360 6-2 17-0 -(PEN UP) OCT 033126 3-6 5-6 OCT 024502 2-11 4-2 +V OCT 064442 6-11 2-2 -X,-/ OCT 064760 6-11 17-0 OCT 024542 2-11 6-2 +\ OCT 024506 2-11 4-6 +Y OCT 041106 4-2 4-6 100 OCT 064522 6-11 5-2 -1 OCT 031102 3-2 4-2 OCT 044470 4-11 3-10 OCT 023450 2-7 2-10 +2 OCT 034531 3-11 5-11 OCT 064147 6-10 6-7 OCT 021442 2-3 2-2 # OCT 061122 6-2 5-2 110 -4 OCT 054444 5-11 2-4 OCT 062151 6-4 6-11 -5 OCT 024446 2-11 2-6 -6 OCT 053145 5-6 6-5 OCT 061522 6-3 5-2 OCT 031043 3-2 2-3 OCT 022050 2-4 2-10 OCT 034531 3-11 5-11 120 OCT 064050 6-10 2-10 -7 OCT 024551 2-11 6-11 OCT 064102 6-10 4-2 OCT 024071 2-10 3-11 +8,+3 OCT 054550 5-11 6-10 OCT 063526 6-7 5-6 OCT 033126 3-6 5-6 OCT 062543 6-5 6-3 130 OCT 051062 5-2 3-2 OCT 021445 2-3 2-5 OCT 033047 3-6 2-7 OCT 024043 2-10 2-3 +9 OCT 031122 3-2 5-2 OCT 061550 6-3 6-10 OCT 054471 5-11 3-11 OCT 024046 2-10 2-6 140 OCT 032545 3-5 6-5 END OF BASIC OCT 041507 4-3 4-7 ++,+* OCT 042445 4-5 2-5 -- OCT 062505 6-5 4-5 OCT 021547 2-3 6-7 OCT 042447 4-5 2-7 OCT 061446 6-3 2-6 -= OCT 063360 6-6 17-0 150 OCT 021543 2-3 6-3 OCT 041063 4-2 3-3 +( OCT 034111 3-10 4-11 OCT 041123 4-2 5-3 +) OCT 054111 5-10 4-11 OCT 051062 5-2 3-2 +[ OCT 034531 3-11 5-11 OCT 031122 3-2 5-2 160 +] OCT 054471 5-11 3-11 OCT 041111 4-2 4-11 +^ OCT 034130 3-10 5-10 OCT 044545 4-11 6-5 -_. OCT 022466 2-5 3-6 OCT 032045 3-4 2-5 OCT 023450 2-7 2-10 +? OCT 034531 3-11 5-11 170 OCT 064147 6-10 6-7 OCT 053106 5-6 4-6 OCT 042360 4-4 17-0 OCT 031122 3-2 5-2 +! OCT 041462 4-3 3-2 OCT 170104 17-0 4-4 OCT 044507 4-11 4-7 +',+" OCT pQ054511 5-11 4-11 200 OCT 170051 17-0 2-11 OCT 023471 2-7 3-11 OCT 024463 2-11 3-3 -# OCT 033466 3-7 3-6 OCT 023146 2-6 6-6 OCT 053127 5-6 5-7 OCT 051524 5-3 5-4 OCT 062044 6-4 2-4 210 OCT 022063 2-4 3-3 +$ OCT 051544 5-3 6-4 OCT 062446 6-5 2-6 OCT 023470 2-7 3-10 OCT 054147 5-10 6-7 OCT 170111 17-0 4-11 OCT 041050 4-2 2-10 -% OCT 034071 3-10 3-11 220 OCT 024360 2-10 17-0 OCT 021151 2-2 6-11 OCT 170142 17-0 6-2 OCT 061522 6-3 5-2 OCT 061107 6-2 4-7 OCT 043126 4-6 5-6 OCT 053507 5-7 4-7 OCT 170123 17-0 5-3 OCT 041504 4-3 4-4 OCT 052123 5-4 5-3 OCT 041043 4-2 2-3 OCT 061760 6-3 17-0 OCT 062046 6-4 2-6 +> OCT 064043 6-10 2-3 - OCT 061760 6-3 17-0 OCT 022146 2-4 6-6 240 +> OCT 024042 2-10 2-2 OCT 042004 4-4 0-4 OCT 000100 0-0 4-0 OCT 042042 4-4 2-2 OCT 022024 2-4 1-4 OCT 001401 0-3 0-1 OCT 010060 1-0 3-0 OCT 040503 4-1 4-3 250 OCT 032044 3-4 2-4 OCT 021044 2-2 2-4 OCT 000501 0-1 4-1 OCT 022042 2-4 2-2 OCT 021403 2-3 0-3 OCT 020103 2-0 4-3 OCT 021442 2-3 2-2 OCT 021044 2-2 2-4 260 OCT 020042 2-0 2-2 OCT 001102 0-2 4-2 OCT 021004 2-2 0-4 OCT 040042 4-0 2-2 OCT 000104 0-0 4-4 OCT 021044 2-2 2-4 OCT 001040 0-2 2-0 OCT 041044 4-2 2-4 270 OCT 021002 2-2 0-2 OCT 022040 2-4 2-0 OCT 022102 2-4 4-2 OCT 021004 2-2 0-4 OCT 042042 4-4 2-2 OCT 000042 0-0 2-2 OCNLHT 040042 4-0 2-2 OCT 021022 2-2 1-2 300 OCT 031042 3-2 2-2 OCT 042004 4-4 0-4 OCT 042000 4-4 0-0 OCT 040000 4-0 0-0 OCT 021004 2-2 0-4 OCT 021104 2-2 4-4 OCT 021040 2-2 2-0 OCT 021104 2-2 4-4 310 OCT 031423 3-3 1-3 OCT 002023 0-4 1-3 OCT 010400 1-1 0-0 OCT 010461 1-1 3-1 OCT 040061 4-0 3-1 OCT 031442 3-3 2-2 OCT 002104 0-4 4-4 OCT 000100 0-0 4-0 320 OCT 021042 2-2 2-2 OCT 061360 6-2 17-0 OCT 022545 2-5 6-5 OCT 170050 17-0 2-10 OCT 064051 6-10 2-11 -1,#16 OCT 021111 2-2 4-11 - OCT 041063 4-2 3-3 OCT 051502 5-3 4-2 330 OCT 022545 2-5 6-5 + OCT 053124 5-6 5-4 OCT 062562 6-5 7-2 OCT 021126 2-2 5-6 OCT 024571 2-11 7-11 OCT 023146 2-6 6-6 + OCT 170043 17-0 2-3 OCT 061760 6-3 17-0 340 OCT 053462 5-7 3-2 OCT 021543 2-3 6-3 + OCT 170046 17-0 2-6 OCT 063106 6-6 4-6 OCT 044104 4-10 4-4 345 OCT 021507 2-3 4-7 + OCT 061544 6-3 6-4 -@ OCT 051463 5-3 3-3 350 OCT 022047 2-4 2-7 OCT 034130 3-10 5-10 OCT 063545 6-7 6-5 OCT 052104 5-4 4-4 OCT 032466 3-5 3-6 OCT 043527 4-7 5-7 OCT 063142 6-6 6-2 OCT 033470 3-73-10 OCT 044530 4-11 5-10 OCT 022444 2-5 2-4 OCT 031503 3-3 3-4 OCT 062000 6-4 * * END APN gy 92409-80003 1622 S C0122 7210 PLOTTER LIBRARY (FTN UTILITIES)             H0101 fFTN,L,C C C C************************************************************* C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1975. ALL RIGHTS * C RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * C PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * C OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C************************************************************* C C LISTING: A92409-80003-1 C SOURCE: 92409-80003 C REV. 1622 C. HAMILTON (3-13-75) C C C AXIS C VERSION FOR R/T SYSTEM - COMPILE WITH R/T FORTRAN SUBROUTINE AXIS(X,Y,IBCD,SIZE,THETA,XMIN,DX) DIMENSION IBCD(2) DIMENSION IXX(3) IBCD1=IAND(IBCD(1),377B) IXX(1) =3 IXX(2) = 25061B IXX(3) = 30000B KN=SIZE A=1.0 C SET FOR ANNOTATION ON CLOCKWISE OR COUNTERCLOCKWISE SIDE OF AXIS IF (KN) 6,7,7 6 A=-A KN=-KN 7 EX=0.0 C ADJUST DX INTO RANGE OF 1000.0 TO 0.001 ADX= ABS (DX) IF (ADX) 1,5,1 1 IF (ADX-1000.0) 4,2,2 2 ADX=ADX/10.0 EX=EX+1.0 GO TO 1 3 ADX=ADX*10.0 EX=EX-1.0 4 IF (ADX-0.001) 3,5,5 5 XVAL=XMIN*10.0**(-EX) ADX= DX *10.0**(-EX) STH=THETA*0.0174533 CTH=COS(STH) STH=SIN(STH) C CALCULATE STARTING LOCATION FOR TIC MARK ANNOTATION DXB=-0.15 DYB=0.2*A-0.05 XN=X+DXB*CTH-DYB*STH YN=Y+DYB*CTH+DXB*STH NTIC=KN+1.0 NT=NTIC/2 C PLOT TIC MARK ANNOTATION INCREMENT DO 20 I=1,NTIC ADJ=0.0 C DECREMENT ANNOTATION START FOR CHARS. LEFT OF DECIMAL. IF(XVAL) 100,110 100 ADJ=-0.05 C ROUND THE ABSOLUTE VALUE OF THE NUMBER. 110 RNDN=ABS(XVAL)+.005 C DETERMINE NUMBER OF DIGITS TO LEFT OF DECIMAL POINT. LEFT=ALOG(RNDN)*0.43429448+1.0 C ADJUST FOR TWO OR MORE DIGITS TO LEFT OF DECIMAL POINT. IF(LEFT.LE.1) GO TO 120 C CALCULATE STARTING POSITION ADJUSTMENT. ADJ=ADJ+(LEFT*(-0.05)) 120 XNPLT=XN+ADJ*CTH YNPLT=YN+ADJ*STH CALL NUMB(XNPLT,YNPLT,.10,XVAL,THETA,3) XVAL=XVAL+ADX XN=XN+CTH YN=YN+STH IF (NT) 20,11,20 11 Z=IBCD1 IF (EX) 12,13,12 12 Z=Z+7.0 C CALCULATE STARTING LOCATION FOR AXIS TITLE 13 DXB=-.07*Z+KN*0.5 DYB=0.4*A-0.07 XT=X+DXB*CTH-DYB*STH YT=Y+DYB*CTH+DXB*STH C PLOT AXIS TITLE CALL SYMB(XT,YT,0.14,IBCD(1),THETA,1) C TEST FOR EXPONENT AND CALCULATE STARTING LOCATION FOR BASE IF (EX) 14,20,14 14 Z=IBCD1+2 XT=XT+Z*CTH*0.14 YT=YT+Z*STH*0.14 C PLOT BASE, CALCULATE STARTING LOCATION FOR EXPONENT AND PLOT IT CALL SYMB(XT,YT,0.14,IXX,THETA,1) XT=XT+(3.0*CTH-0.8*STH)*0.14 YT=YT+(3.0*STH+0.8*CTH)*0.14 CALL NUMB(XT,YT,0.10,EX,THETA,-1) 20 NT=NT-1 C MOVE TO END OF AXIS AND CALCULATE SIZE OF TIC MARKS XE=X+KN*CTH YE=Y+KN*STH CALL PLOT(XE,YE,3) DXB=-0.07*A*STH DYB=+0.07*A*CTH A=NTIC-1 C CALCULATE LOCATION OF LAST TIC MARK XN=X+A*CTH YN=Y+A*STH DO 30 I=1,NTIC C PLOT TIC MARKS STARTING WITH THE LAST ONE CALL PLOT(XN,YN,2) CALL PLOT(XN+DXB,YN+DYB,2) CALL PLOT(XN,YN,2) XN=XN-CTH YN=YN-STH C USE THE FOLLOWING IF -0.0 CAN CAUSE PROBLEMS C IF (NTIC-1-I) 30,28,20 C 28 XN=X C YN=Y 30 CONTINUE RETURN END C LINES C VERSION FOR R/T SYSTEM - COMPILE WITH R/T FORTRAN SUBROUTINE LINES(X,Y,N,K,J,C) DIMENSION X(1),Y(1) LMIN = N*K+1 LDX = LMIN+K NL = LMIN-K XMIN = X(LMIN) DX = X(LDX) YMIN = Y(LMIN) DY = Y(LDX) C FIND END OF LINE CLOSEST TO CURRENT PEN POSITION CALL WHERE (XN,YN) DF = ABS ((X(1)-XMIN)/DX-XN) DF2 = ABS ((Y(1)-YMIN)/DY-YN) DL = ABS ((X(NL)-XMIN)/DX-XN) DL2 = ABS ((Y(NL)-YMIN)/DY-YN) IF ( DF - DF2 ) 100,101 C 100 DF = DF2 10Q1 IF (DL - DL2) 102,103 102 DL = DL2 103 IC = 3 IS = -1 NT =IABS(J) IF (J) 2,1,2 1 NT = 1 2 IF (DF-DL) 4,4,3 3 NF = NL NA = ((N-1)/NT)*NT+NT-(N-1) KK = -K GO TO 5 4 NF = 1 NA = NT KK = K 5 IF (J) 6,7,8 6 ICA = 3 ISA = -1 LSW = 1 GO TO 10 7 NA = LDX 8 ICA = 2 ISA = -2 LSW = 0 10 DO 30 I = 1,N XN = (X(NF)-XMIN)/DX YN = (Y(NF)-YMIN)/DY C TEST FOR -0 VALUES OF X AND Y C IF (XN) 14,12,14 C 12 XN = 0.0 C 14 IF (YN) 18,16,18 C 16 YN = 0.0 18 IF (NA-NT) 20,21,22 20 IF (LSW) 23,22,23 21 CALL SYMB(XN,YN,0.07,C,0.0,IS) NA = 1 GO TO 25 22 CALL PLOT (XN,YN,IC) 23 NA = NA + 1 25 NF = NF+KK IS = ISA 30 IC = ICA RETURN END C SCALE C VERSION FOR R/T SYSTEM - COMPILE WITH R/T FORTRAN SUBROUTINE SCALE (Y,YL,NP,L) DIMENSION Y(1),SAVE(7) SAVE(1)=1.0 SAVE(2)=2.0 SAVE(3)=4.0 SAVE(4)=5.0 SAVE(5)=8.0 SAVE(6)=10.0 SAVE(7)=20. FAD=0.001 K=IABS(L) C GET MAX AND MIN OF ARAY N=NP*K Y0=Y(1) YN=Y0 DO 25 I=1,N,K YS=Y(I) IF (Y0-YS) 22,22,21 21 Y0=YS GO TO 25 22 IF (YS-YN) 25,25,24 24 YN=YS 25 CONTINUE C YS IS EXPERIMENTAL STARTING VALUE, D IS EXPERIMENTAL DELTA YS=Y0 IF (Y0) 34,35,35 34 FAD=FAD-1.0 35 D=(YN-YS)/YL IF (D ) 70,70,36 C P IS POWER OF DELTA 36 I=ALOG(D)*0.43429448 P=10.0**I D=D/P-0.001 DO 45 I=1,6 IS=I IF (SAVE(I)-D) 45,50,50 45 CONTINUE 50 D=SAVE(IS)*P C GET NICE STARTING VALUE YS=IFIX(Y0/D+FAD) YS=D*YS T=YS+(YL+0.001)*D IF (T-YN) 55,57,57 55 IS=IS+1 GO TO 50 C CENTER DATA 57 YK=IFIX((YL+(YS-YN)/D)/2.0) YS=YS-YK*D IF (Y0*YSG) 58,58,59 58 YS=0.0 59 IF (L) 61,61,65 C BACKWARD 61 YS=YS+YL*D D=-D 65 N=N+1 Y(N)=YS N=N+K Y(N)=D RETURN C IF D IS ZERO 70 D=1.0 YS=YS-0.5 GO TO 65 END C NUMBER C VERSION FOR R/T SYSTEM - COMPILE WITH R/T FORTRAN SUBROUTINE NUMB (XP, YP, HGT, FPN, THETA, ND) C THIS VERSION OF NUMBER REQUIRES THE SYMBOL VERSION WITH 999.0 C X, Y FEATURE, AND NC = 0 FEATURE DIMENSION IC (2) DIMENSION K1(2) DIMENSION ID (2) DIMENSION IE(2) IC(1)=1 IC(2)=26400B ID(1)=1 ID(2)=30000B IE(1)=1 IE(2)=27000B K1(1)=1 X = XP Y = YP H = HGT FPV = FPN TH = THETA N = ND MAXN=7 SAMEV = 9999.0 C SET N VALUE TO + OR - MAXN, IF OUT OF RANGE IF (N - MAXN) 11, 11, 10 10 N = MAXN 11 IF (N + MAXN) 12, 20, 20 12 N = -MAXN C INSERT MINUS SIGN IN FRONT OF NUMBER, IF NEGATIVE 20 IF (FPV) 21, 30, 30 21 CALL SYMB (X,Y,H,IC(1),TH,1) C WHEN SYMBOL IS CALLED WITH SAMEV FOR X AND Y, THE CHARACTER STRING C CONTINUES FROM THE LAST CHARACTER PLOTTED BY SYMBOL X = SAMEV Y = SAMEV C MN LOCATES EXPONENT VALUE FOR PROPER ROUNDING OF NUMBER 30 MN = -N C IF SCALING IS DONE, MN MUST BE ADJUSTED IF (N) 31, 32, 32 31 MN = MN - 1 C ROUND INPUT NUMBER AND SET TO POSITIVE VALUE 32 FPV = ABS(FPV) + (0.5 * 10. ** MN) C DETERMINE CHARACTERISTIC OF FPV AND INCREMENT IT BY 1 I = ALOG (FPV) * 0.43429448 + 1.0 ILP = I C IF SCALING IS DONE, ILP MUST BE REDUCED ACCORDING TO SCALING IF (N + 1) 40, 41, 41 40 ILP = ILP + N + 1 C IF NUMBER IS LESS THAN 1 PLOT A ZERO BEFORE DECIMAL (IF ANY) 41 IF (ILP) 50, 50, 51 50 CALL SYMB (X,Y,H,ID(1),TH,1) X = SAMEV Y = SAMEV GO TO 61 C ILP IS NUMBER OF DIGITS TO LEFT OF DECIMAL POINT 51 DO 6[0 J = 1, ILP C LOCATE SINGLE LEFTMOST DIGIT OF NUMBER K = FPV * 10. ** (J - I) K1(2)=(K+48)*256 CALL SYMB(X,Y,H,K1(1),TH,0) C SUBTRACT VALUE OF PREVIOUS DIGIT FROM NUMBER TO LOCATE NEXT DIGIT FPV = FPV - (FLOAT(K) * 10. ** (I - J)) X = SAMEV 60 Y = SAMEV C NO DECIMAL POINT IS PLOTTED IF N IS NEGATIVE, EXIT FROM ROUTINE 61 IF (N) 99, 70, 70 70 CALL SYMB (X,Y,H,IE(1),TH,1) C PLOT DIGITS TO RIGHT OF DECIMAL IF N GT 0, OTHERWISE EXIT IF (N) 99, 99, 80 80 DO 90 J = 1, N C SCALE FRACTIONAL REMAINDER TO GIVE INTEGER DIGIT K = FPV * 10. K1(2)=(K+48)*256 CALL SYMB(X,Y,H,K1(1),TH,0) C SUBTRACT INTEGER VALUE TO LOCATE NEXT DIGIT 90 FPV = FPV * 10. - FLOAT(K) 99 RETURN END END$  h r 92413-18001 A S 0122 ISA FTN FREQ FREQUENCY MEASUREMENT             H0101 4ASMB,R,L,C,B HED ISA FREQUENCY MEASUREMENT 92413-16001 NAM FREQ,7 92413-16001 REV A 24APR75 ENT FREQ EXT EXEC,#GET!,.ENTR SUP * * * FREQUENCY MEASUREMENT * * CALLING SEQUENCES: * * NORMAL CALL FREQ(NUM,ICHAN,IDATA,IERR) * * OPTION CALL FREQ(NUM,ICHAN,IDATA,IDUR,IERR) * * WHERE: NUM IS THE NUMBER OF READINGS * ICHAN IS A ARRAY OF CHANNEL NUMBERS * IDATA IS THE ARRAY IN WHICH DATA IS TO BE PUT * IDUR IS THE NUMBER OF INCREMENTS FOR THE TIMER CARD * IERR= 1 NORMAL OPERATION * 2 DEVICE ERROR * 3 PARAMETER ERROR * * SOURCE 92413-18001 REV A * RELOC 92413-16001 REV A * * * SKP * * FREQUENCY * FREQ NOP ENTRY CLA FIX ERROR STA IERR ADDRESS LDA FREQ GET RETURN ADDR STA ENTRY AND SAVE IT JMP ENTRY+1 GET CALLING PARAMETERS * * CALLING PARAMETERS * NUM NOP CHAN NOP VALUE NOP IDUR NOP IERR NOP * ENTRY NOP JSB .ENTR FETCH CALLING DEF NUM PARAMETERS * LDA IERR GET ERROR ADDR SZA AND IF NOT ZERO, JMP *+5 SKIP A FEW. LDA IDUR FIX PARAMETERS STA IERR TO DEFAULT LDA ..M1 IDUR TO STA IDUR 1000 * LDA .1 CLEAR ERROR STA IERR,I TO ONE LDA NUM,I MAKE NUM CMA,INA NEGATIVE SSA IF NOW POSITIVE SZA,RSS OR ZERO JMP ERR3 GIVE,ERROR#3 STA NUM SAVE NUMBER OF READINGS * AGAIN LDA CHAN,I GET SLOT AND JSB GET2 UNIT OF CTR CARD * LDA TYPE IF CPA .8 WRONG RSS TYPE JMP ERR3 ERR3 * LDA =B170140 USE UNIT IOR UNIT TO BUILD STA BUFF1 FIRST CNTL WORD XOR =B300 ALSO MAKE INPUT STA BUFF3+3 I CONTROL WORD FOR LATER * LDA SLOT PLACE COUNTER STA BUFF1+1 SLOT INTO THE PROPER STA BUFF3+4 BUFFER LOCATIONS SKP * * NOW FIND OUT ABOUT TIMER CARD * CCA ADA REL# GET THE ADA ADR ASSOCIATED TIMER LDA 0,I CHAN NUMBER JSB GET2 GET SLOT AND UNIT * LDA =B170140 BUILD UP SECOND IOR UNIT CNTL WORD STA BUFF1+2 WITH TME = 0 STA BUFF3+1 AND SAVE IN BUFFERS XOR =B300 CHANGE IT TO AN INPUT STA BUFF1+4 STA BUFF2+1 ONE AND SAVE ALSO * LDA IDUR,I GET DURATION CPA .M1 AND IF = -1 LDA .1000 DEFAULT TO 1000 AND M7777 IOR SLOT STICK IN SLOT STA BUFF1+3 AND SAVE IN BUFFER LDA SLOT PLACE TIMER SLOT STA BUFF1+5 STA BUFF2+2 INTO THE PROPER STA BUFF3+2 BUFFER LOCATIONS * * CLEAR COUNTER, START TIMER, ENABLE TIMER FLAG CIRCUITS? * JSB EXEC DEF *+6 DEF .2 DEF LU DEF BUFF1 DEF .6 DEF .1 * AND =B204 SZA,RSS CHECK FOR BAD STATUS BITS SZB,RSS OR ZERO XMISSION LOG JMP ERR2 GIVE DEVICE ERROR * * IS TIMER DONE? * READ JSB EXEC DEF *+6 DEF .1 DEF LU DEF BUFF2 DEF .5 DEF .2 * AND =B204 SZA,RSS CHECK FOR BAD STATUS BITS SZB,RSS OR ZERO XMISSION LOG JMP ERR2 GIVE ERROR 2 * LDA BUFF2+4 IS THE IRQ BIT SSA,RSS SET????? JMP READ NOPE, TRY AGAIN * * DISARM TIMER, READ COUNTER * JSB EXEC DEF *+6 DEF .1 DEF LU DEF BUFF3 DEF .7 DEF .6 * AND =B204 SZA,RSS CHECK FOR BAD STATUS BITS SZB,RSS OR A ZERO XMISSION LOG JMP ERR2 GIVE ERROR 2 LDA BUFF3+6 GIVE THE DATA AND =B137777 STA VALUE,I TO THE CALLER * ISZ CHAN BUMP ISZ VALUE ADDRESSES LDA IDUR,I GET DURATION CPA .M1 IF NEGATIVE RSS SKIP ISZ IDUR OTHERWISE, BUMP POINTER ISZ NUM DONE?? JMP AGAIN JMP ENTRY,I SKP * * GET TABLE VALUES * GET2 NOP JSB #GET! GET TABLE VALUES LU NOP STORAGE TYPE NOP FOR REL# NOP TABLE ADR NOP VALUES SSB ERROR? JMP ERR3 CHAN OUT OF RANGE * CLB ADA .M1 DIV .15 STA UNIT BLF,BLF MOVE SLOT BLF TO MSB'S STB SLOT AND STORE JMP GET2,I * * ERRORS * ERR3 ISZ IERR,I BAD PARAMETER ERR2 ISZ IERR,I DEVICE ERROR JMP ENTRY,I SKP * * CONSTANTS AND THINGS * .M1 DEC -1 .0 DEC 0 .5 DEC 5 .6 DEC 6 .7 DEC 7 .8 DEC 8 .15 DEC 15 .1000 DEC 1000 * M7777 OCT 7777 * UNIT NOP SLOT NOP ..M1 DEF .M1 * * OUTPUT AND INPUT BUFFERS * BUFF1 NOP 170140 WITH CTR UNIT NOP COUNTER SLOT NOP 170140 WITH TMR UNIT NOP TMR SLOT WITH DUR NOP 170240 WITH TMR UNIT NOP TMR SLOT * BUFF2 OCT 2 NOP 170240 WITH TMR UNIT NOP TMR SLOT OCT 1 NOP DATA RETURNED FROM TMR * BUFF3 OCT 4 NOP 170140 WITH TMR UNIT NOP TIMER SLOT NOP 170240 WITH CTR UNIT NOP CTR SLOT .1 OCT 1 NOP DATA RETURNED FORM CTR * .2 EQU BUFF2 * END =Y ir 92413-18002 A S 0122 ISA FTN ADC.. ANALOG INPUT             H0101 ASMB,R,L,C,F,B HED ISA S61.1 ANALOG INPUT 92413-16002 REV A * * ADC.. - ANALOG INPUT ROUTINES FOR ISA S61.1 * * * SOURCE TAPE - 92413-18002 REV. A * RELOC. TAPE - 92413-16002 REV. A * * * * * AIRDF,AIRDW - ANALOG INPUT IN RANDOM ORDER * AISQF,AISQW - ANALOG INPUT IN SEQUENTIAL ORDER * NORM - SYSTEM NORMALIZE * PACER - SETS UP SYSTEM PACER * RGAIN - READS GAIN ON A CHANNEL * SGAIN - SETS GAIN ON A CHANNEL * NAM ADC..,7 92413-16002A 08APR75 EXT ..ADC,EXEC,$LIBR,$LIBX,..FCM,.ENTR ENT NORM,AIRDF,AISQF,SGAIN,RGAIN,PACER ENT AIRD,AIRDW,AISQ,AISQW SUP * * "RGAIN" READS THE GAIN OF A GIVEN CHANNEL OR GROUP OF CHANNELS * CALLING SEQUENCE: * CALL RGAIN(CHN1,GN1) * * WHERE: CHN1 - DESIRED CHANNEL NUMBER * GN1 - FLOATING POINT GAIN OF CHANNEL "CHN1" * CHN1 NOP GN1 NOP RGAIN NOP JSB .ENTR FETCH PARAMETER DEF CHN1 ADDRESSES LDA .ERR. DUMMY UP ERROR RETURN STA ERR LDA RGAIN SAVE RETURN STA ENTRY ADDRESS LDA CHN1,I FIND CHANNEL ENTRY JSB FCHN IN CONFIGURATION TABLE SSB,RSS IF HL-SE JMP *+4 THEN SET THE DLD FLT1 GAIN TO JMP RG2 ONE. BLS COMPUTE ADDRESS OF GAIN ADB DFCTR CONVERSION FACTOR STB GAIN AND SAVE DLD FACTR GAIN = FDV GAIN,I .005 / CONVERSION FACTOR RG2 DST GN1,I STORE GAIN JMP ENTRY,I AND RETURN * FLT1 DEC 1.0 SKP * * "SGAIN" READS THE GAIN OF A GIVEN CHANNEL OR GROUP OF CHANNELS * CALLING SEQUENCE: * CALL SGAIN(CHN2,GN2) * * WHERE: CHN2 - DESIRED CHANNEL NUMBER * GN2 - FLOATING POINT GAIN OF CHANNEL "CHN2" * CHN2 NOP GN2 NOP SGAIN NOP JSB .ENTR FETCH PARAMETER DEF CHN2 ADDRESSES LDA .ERR. DUMMY UP ERROR RETURN STA ERR B LDA SGAIN SAVE RETURN STA ENTRY ADDRESS LDA CHN2,I FIND CHANNEL ENTRY JSB FCHN IN CONFIGURATION TABLE SSB IF NOT LOW LEVEL JMP ENTRY,I RETURN DLD FACTR COMPUTE TEMP = ADA M1 (ADJUSTMENT FOR ROUND OFF ERROR) FDV GN2,I .005 / GN2 SSA IF GAIN WAS NEGATIVE JSB ..FCM MAKE POSITIVE DST TEMP AND SAVE LDB M7 INITIALIZE STB CNTR LOOP COUNTER LDA DFCTR INITIALIZE GAIN STA AFCTR TABLE POINTER * SGN1 DLD TEMP IF DESIRED GAIN FSB AFCTR,I IS > OR = TABLE SSA VALUE, THEN JMP SGN2 SET UP GAIN ISZ AFCTR INCREMENT GAIN ISZ AFCTR TABLE POINTER ISZ CNTR LAST ENTRY? JMP SGN1 NO, CONTINUE LOOKING * SGN2 LDA ADRS,I FETCH GAIN ENTRY AND ASL 3 SHIFT GAIN BITS INTO "B" LDB CNTR PUT NEW ADB .7 GAIN IN "B" ASR 3 SHIFT GAIN BITS BACK INTO "A" * JSB $LIBR TURN OFF INTERRUPT SYSTEM NOP AND UPDATE STA ADRS,I CONFIGURATION TABLE ENTRY JSB $LIBX TURN INTERRUPT SYSTEM BACK DEF ENTRY ON AND RETURN SKP * "NORM" PERFORMS A SYSTEM NORMALIZE ON THE SPECIFIED UNIT * UNIT NOP NORM NOP JSB .ENTR FETCH PARAMETER DEF UNIT ADDRESS LDA NORM SAVE RETURN STA ENTRY ADDRESS LDB UNIT FIND SUBSYSTEM JSB FNDLU LOGICAL UNIT NUMBER * JSB EXEC ************************************* DEF *+5 SYSTEM DEF .2 NORMALIZE DEF LU REQUEST DEF .1 DEF .1 ************************************** * JMP ENTRY,I ELSE, RETURN * * "FNDLU" FINDS THE LOGICAL UNIT NUMBER CORRESPONDING TO THE * SUBSYSTEM NUMBER SPECIFIED IN THE CALL. IF THE NUMBER IS ZERO * OR NE:GATIVE AN ERROR IS GIVEN * FNDLU NOP CLA,INA ASSUME UNIT 1 SZB IF UNIT SPECIFIED LDA B,I FETCH IT CMA,INA COMPLEMENT AND SSA,RSS JMP ENTRY,I IF <=0 THEN RETURN STA CNTR SAVE COMP. FOR LOOP COUNTER LDB ..ADC FETCH ADDRESS OF CONFIG. TABLE ADA B,I LEGITIMATE UNIT SSA ADDRESS? JMP ENTRY,I NO - RETURN INB,RSS BUMP TBL PNTR TO 1ST SUBSYS. ENTRY * NXTSS ADB B,I FETCH NEXT SUBSYSTEM ENTRY ISZ CNTR UNIT FOUND? JMP NXTSS NO, CONTINUE SEARCH * INB FETCH SUBSYSTEM LDB B,I LOGICAL UNIT NUMBER STB LU AND SAVE JMP FNDLU,I RETURN SKP * "AIRDF" PEFORMS ANALOG INPUT FROM THE CHANNELS SPECIFIED IN * A REAL ARRAY. THE RESULTS ARE CONVERTED TO FLOATING POINT VOLTS * AND RETURNED IN ANOTHER REAL ARRAY. * * CALLING SEQUENCE: * CALL AIRDF(NUM,CHAN,VOLT,ERR) * WHERE: NUM1 - NUMBER OF CHANNELS TO BE READ ( IF N<0 THEN * PERFORM PACED CONVERSION) * CHAN - INTEGER ARRAY CONTAINING CHANNEL NUMBERS * VOLT - REAL ARRAY FOR CONVERTED DATA * ERR - ERROR RETURN PARAMETER * BIT 0 = OVERFLOW ON AT LEAST ONE READING * BIT 1 = PACE ERROR ON AT LEAST ONE READING * AIRDF NOP FLOATING PT. RANDOM SCAN LDA AIRDF FETCH RETURN ADDRESS CLB AND CLEAR FIXED POINT FLAG JMP RDSCN GO TO RANDOM SCAN * AIRDW NOP INTEGER RANDOM SCAN LDA AIRDW FETCH RETURN ADDRESS CLB,INB AND SET FIXED POINT FLAG * RDSCN JSB SETUP FETCH PARAMETERS * AIRD1 LDA CHAN,I LOAD NEXT CHANNEL NUMBER JSB FCHN FIND HARDWARE ADDRESS IOR =B100000 SET TO RANDOM MODE IOR PACED OR IN PACE BIT STA CHANL AND SAVE SSB IF GAIN IS NEGATIVE JMP RDHL w GO TO HIGH LEVEL READ XOR =B140000 SET UP GAIN STA GCHN CHANNEL ENTRY * JSB EXEC ***************************** DEF *+5 LOW DEF .2 LEVEL DEF LU RANDOM DEF RBUF1 READ DEF .2 ***************************** JMP AIRD2 GO TO VOLTAGE CONVERSION * RDHL JSB EXEC ************************* DEF *+5 HIGH DEF .2 LEVEL DEF LU RANDOM DEF RBUF2 READ DEF .1 ***************************** * AIRD2 AND =B200 CHECK FOR PROPER REMOTE SZA,RSS AND OR LOCAL SZB,RSS OPERATION JMP ERR2 ELSE, GIVE ERROR 2 * LDB VOLT2,I FETCH READING JSB CONV PERFORM CONVERSION ISZ CHAN BUMP CHANNEL ADDRESS ISZ VOLT2 BUMP INPUT DATA ADDRESS ISZ CNTR LAST CHANNEL JMP AIRD1 NO, CONTINUE JMP ENTRY,I YES, RETURN SKP * "SETUP" FETCHES AND TESTS CALLING PARAMETERS FOR VALIDITY * FOR ROUTINES AIRDW,AIRDF,AISQW AND AISQF. * SETUP NOP STA ENTRY SAVE RETURN ADDRESS STB FIXPT SAVE FIXED POINT FLAG JMP ENTRY+1 GO TO PARAM. FETCH * NUMRD NOP CHAN NOP VOLT NOP ERR NOP ENTRY NOP JSB .ENTR FETCH PARAMETER .ERR. DEF NUMRD ADDRESSES CLB,INB INITIALIZE ERROR STB ERR,I TO ONE CLB LDA NUMRD,I FETCH NUMBER OF CHANNELS SSA IF NEGATIVE LDB =B10000 # OF CHANLS SET STB PACED PACE BIT SSA IF NEGATIVE CMA,INA MAKE POSITIVE STA NUM AND SAVE CMA,INA,SZA,RSS COMPLEMENT # OF CHANNELS JMP ERR3 IF ZERO GIVE ERROR STA CNTR SAVE FOR LOOP COUNTER LDA FIXPT IF FIXED POINT LDB VOLT FLAG IS CLEAR SZA,RSS DATA BUFFER ADDRESS IF ADB NUM IN CENTER OF ARRAY | STB VOLT1 VOLT, ELSE AT STB VOLT2 BEGINNING OF VOLT JMP SETUP,I SKP * "FCHN" IS A SUBROUTINE WHICH FINDS THE ENTRY IN THE 2313 * CONFIGURATION TABLE WHICH CORRESPONDS TO A GIVEN CHANNEL NUMBER * * CALLING SEQUENCE : * "A" CONTAINS THE SOFTWARE ANALOG CHANNEL NUMBER * RETURNED : * "A" CONTAINS THE HARDWARE ADDRESS OF THE DESIRED MPX CHANNEL * "LU" _ LOGICAL UNIT NUMBER OF THE SUBSYSTEM CONTAINING "A" * "ADRS" _ ADDRESS OF THE CONF. TABLE ENTRY FOR "A" * "GAIN" _ GAIN FOR THE CHANNEL (-1 IF HIGH LEVEL) * "REMCH" _ # OF CHANNELS REMAINING IN ENTRY * * IF THE CHANNEL IS OUTSIDE THE BOUNDS OF THE TABLE "FCHN" * BRANCHES TO "ERR3" * FCHN NOP CMA,SSA,INA,SZA COMPLEMENT CHANNEL NUM. RSS IF LESS THAN OR JMP ERR3 EQUAL TO ZERO GIVE ERROR #3 STA MCHN SAVE -(CHANNEL NUM.) STA NMCHN CCA ASSUME STA GAIN HIGH LEVEL LDA ..ADC FETCH ADDRESS OF FIRST STA .ADC INA SUBSYSTEM ENTRY IN CONF. TABLE CLB "B"_ CURRENT SUBSYSTEM # JMP STFCH SEARCH FOR SUBSYS. CONTAINING CHAN. * NXSUB STA NMCHN SAVE # OF CHNLS PAST LAST SUBSYS. INB INCREMENT NUMBER OF SUBSYSTEMS CPB .ADC,I LAST SUBSYSTEM? JMP ERR3 YES - GO TO CHANNEL NOT FOUND LDA ADRS FETCH ADDRESS OF ADA ADRS,I NEXT SUBSYSTEM STFCH STA ADRS AND SAVE ADA .2 IS LAST CHANNEL IN LDA A,I CURRENT SUBSYSTEM BEYOND ADA MCHN THE DESIRED SSA CHANNEL? JMP NXSUB NO - GO TO NEXT SUBSYSTEM * * SUBSYSTEM CONTAINING CHANNEL FOUND. THE FOLLOWING CODE * SEARCHES THE SUBSYSTEM ENTRY FOR ACTUAL CHANNEL ENTRY * LDA ADRS FETCH THE INA LOGICAL UNIT NUMBER LDB A,I OF THE SUBSYSTEM STB LU AND SAVE ADB =B100  SET UP DMA LU STB DMALU AND SAVE ADA .2 COMPUTE ADDRESS OF HIGH LEVEL STA ADRS1 SINGLE ENDED CHANNEL COUNT STA ADRS AND SAVE LDB NMCHN FETCH -(CHANNEL IN THIS SUBSYSTEM) RSS NXTEN ISZ ADRS BUMP ENTRY ADDRESS LDA ADRS,I FETCH AND MASK AND =B3777 NEXT ENTRY ADB A CHANNEL IN SSB THIS ENTRY? JMP NXTEN NO, CONTINUE SEARCH * INB ENTRY FOUND, STB REMCH SAVE CHANNELS REMAINING ISZ NMCHN COMPUTE -(CHNLS-1) NOP CLA LDB ADRS1 FETCH HL-SE ADDRESS CPB ADRS IF ENTRY IS HIGH LEVEL - SE JMP HLSE1 GO TO COMPUTE LOCATION INB IF ENTRY IS CPB ADRS HIGH LEVEL DIF. JMP HLDIF GO TO COMPUTE DIF. LOCATION * CHANNEL MUST BE LOW LEVEL THEN, SO COMPUTE GAIN LDB ADRS,I FETCH RRL 3 GAIN STA GAIN AND SAVE * * TO CONVERT CHANNEL NUMBER TO 2313 HARDWARE ADDRESS THE * FOLLOWING ALGORITHM IS APPLIED: * * BOX = (N-1)/384 (384= 12 SLOTS * 32 CHANNELS/SLOT) * * SLOT.CHANNEL = REMAINDER FROM THE ABOVE QUOTIENT * * WHERE "N" IS THE SUBSYSTEM RELATIVE CHANNEL ADDRESS. SINCE * MULTIPLEXERS CANNOT OCCUPY SLOTS 0-2 IN BOX 0, * 96 MUST BE ADDED TO CHANNEL NUMBERS. * ALSO DIFFERENTIAL INPUT CHANNELS MUST BE COUNTED TWICE. * HLDIF LDA ADRS1,I COMPUTE ADA NMCHN NUMBER HLSE1 ADA NMCHN OF CMA,INA CHANNELS ADA .96 START SLOT =3 CLB COMPUTE DIV .384 HP 2313 ALF,ALF BOX, SLOT ALS AND CHANNEL IOR B ADDRESS LDB GAIN RETURN WITH ADDRESS IN JMP FCHN,I "A" AND GAIN IN "B" * .32 DEC 32 .96 DEC 96 .384 DEC 384 SKP * "CONV" IS A SUBROUTINE WHICH CONVERTS 2313 READINGS TO * FLOATING POINT VOLTS. * * CALLING SEQUENCE: *  "B" - 2313 READING * * RETURNED: * THE COMPUTED VOLTAGE IS PUT IN THE ADDRESS SPECIFIED BY * "VOLT" AND THEN "VOLT" IS INCREMENTED TO POINT AT THE NEXT * FLOATING POINT LOCATION. * * ERR HAS BIT 1 SET IF OVERFLOW AND BIT 2 SET IF PACE ERROR. * ALSO ON OVERFLOW, + OR - 1E37 IS RETURNED FOR VOLTAGE. * CONV NOP LDA .4 IF PACE ERROR BRS,SLB,BRS SET ERROR TO STA ERR,I FOUR LDA FIXPT GET INTEGER FLAG BRS,CLE,BRS TOTAL SHIFT 4 PLACES CPB =B3777 IF POS. OVERFLOW, E_1 CCE,RSS AND GO TO OVERFLOW CPB =B174000 IF NEG. OVERFLOW, E_0 JMP OVRFL AND GO TO OVERFLOW SZA IF INTEGER, JMP CONV,I EXIT LDA B MOVE READING TO A REG. LDB GAIN COMPUTE BLS ADDRESS OF ADB DFCTR CONVERSION FACTOR STB TEMP AND SAVE FLT FLOAT THE 2313 READING FMP TEMP,I MULTIPLY BY CONVERSION FACTOR STVLT DST VOLT,I STORE VOLTAGE IN ARRAY ISZ VOLT COMPUTE NEXT ISZ VOLT FLOATING POINT ADDRESS JMP CONV,I RETURN * OVRFL LDB .4 SET ERROR TO 4 STB ERR,I SZA IF INTEGER, JMP CONV,I EXIT * DLD =F1E37 RETURN POSITIVE SEZ,RSS OR NEGATIVE JSB ..FCM INFINITY FOR JMP STVLT READING SKP SKP *************************** DFCTR DEF FACTR+2 FACTR DEC .005,5E-6,1E-5,2E-5,4E-5 DEC 5E-5,1E-4,2E-4,4E-4 RBUF1 OCT 3 ---------------------------------- OCT 2 Q BUFFER DEF GCHN FOR LOW LEVEL RBUF2 OCT 5 --------- OCT 1 Q BUFFER DEF CHANL FOR HIGH LEVEL VOLT2 NOP ---------------------------------- * M7 DEC -7 .7 OCT 7 * GCHN NOP GAIN GAIN NOP BUFFER * SKP * "AISQF" PERFORRMS ANALOG INPUT IN SEQUENTIAL ORDER. THE RESULTS * ARE CONVERTED TO FLOATING POINT VOLTS AND RETURNED IN A REAL ARRAY. * * CALLING SEQUENCE: * CALL AISQF(NUM2,CHAN,VOLT2,ERR1) * WHERE: NUM2 - NUMBER OF CHANNELS TO BE READ ( IF N<0 THEN * PERFORM PACED CONVERSION) * CHAN - STARTING CHANNEL OF SCAN (IF CHAN<0 THEN * PERFORMS NUM2 READINGS FROM CHANNEL -CHAN) * VOLT2 - REAL ARRAY FOR CONVERTED DATA * ERR - ERROR RETURN PARAMETER * BIT 0 = OVERFLOW ON AT LEAST ONE READING * BIT 1 = PACE ERROR ON AT LEAST ONE READING * AISQF NOP FOATING PT. SEQUENTIAL SCAN LDA AISQF FETCH RETURN ADDRESS CLB CLEAR FIXED POINT FLAG JMP SQSCN GO TO SEQUENTIAL SCAN * AISQW NOP FIXED PT. SEQUENTIAL SCAN LDA AISQW FETCH RETURN ADDRESS CLB,INB SET FIXED POINT FLAG * SQSCN JSB SETUP GO TO INITIALIZE ROUTINE * LDA CHAN,I SAVE START CHANNEL AS NXTSC STA SINGL SINGLE CHAN. FLAG SSA IF NEGATIVE CMA,INA MAKE POSITIVE JSB FCHN FETCH CHANNEL HARDWARE ADDRESS IOR DIGTZ FORM DIGITIZE COMMAND STA CHANL WORD AND SAVE IOR PACED OR IN PACE BIT SSB,RSS IF LOW LEVEL JMP LLSQ GO PROCESS LDB SINGL IF SINGLE CHANNEL SSB SCAN GO TO JMP HLSQR HIGH LEVEL EXEC CALL IOR =B160000 GENERATE SEQUENTIAL LDB ADRS COMMAND, SETTING CPB ADRS1 BIT 0 IF IOR .1 SINGLE ENDED SCAN * LDB REMCH LENGTH OF SCAN ADB CNTR IS THE SMALLER CMB,SSB,INB,RSS OF -CNTR CLB OR THE REMAINDER ADB REMCH OF THE CHANNELS STB NUM IN THIS ENTRY * HLSQR STA SEQ SAVE MODE * JSB EXEC **************************** DEF *+5 PERFORM DEF .2  HIGH DEF DMALU LEVEL DEF SBUF2 SCAN DEF .3 *********************** * SQCON AND =B200 CHECK FOR PROPER REMOTE SZA,RSS AND OR LOCAL OPERATION SZB,RSS JMP ERR2 ELSE, GIVE ERROR 2 * THE FOLLOWING INSTRUCTIONS CONVERT THE DATA JUST READ IN * TO FLOATING POINT AND UPDATE POINTERS "VOLT", AND "VOLT1" * TO POINT AT REMAINING STORAGE. LDA NUM FETCH # CHANNELS THIS SCAN CMA,INA NUMBER OF CHANNELS STA LOOPC READ FOR LOOP COUNTER * SQC1 LDB VOLT1,I FETCH NEXT READING JSB CONV CONVERT TO FLOATING POINT ISZ VOLT1 BUMP DATA ADDRESS ISZ LOOPC LAST CHANNEL JMP SQC1 NO - CONTINUE * SQC2 LDB NUM UPDATE -(NUMBER OF CHNLS) ADB CNTR REMAINING SSB,RSS IF CNTR=0 , END OF JMP ENTRY,I SCAN SO RETURN STB CNTR OTHERWISE SAVE LDA NUM COMPUTE NEW ADA SINGL START CHANNEL CMB,INB SAVE POSITIVE NUMBER OF STB NUM CHANNELS REMAINING JMP NXTSC GO TO NEXT SCAN * * LLSQ XOR =B160000 SET UP STA GCHN GAIN ENTRY XOR =B160000 RESTORE "A" TO DIGITIZE LDB SINGL IF NOT SINGLE SSB,RSS CHANNEL SCAN, IOR =B160000 CHANGE TO SEQUENTIAL STA SEQ AND SAVE SSB IF SINGLE CHANNEL SCAN JMP LLSQR GO PERFORM SCAN AND =B37 COMPUTE THE NUMBER CMA,INA OF CHANNELS REMAINING ADA .32 ON THE ADDRESSED ARS LOW LEVEL CARD ADA CNTR SCAN LENGTH CMA,SSA,INA IS EQUAL CLA TO THE SMALLEST OF ADA CNTR THE FOLLOWING: ADA REMCH 1. # CHNLS LEFT ON CARD CMA,SSA,INA,RSS CLA 2. # CHNLS LEFT IN SCAN ADA REMCH STA NUM 3. # CHNLS LEFT IN TABLE ENTRY * LLSQR JSB EXEC ************************ DEF *+5 PERFORM DEF .2 LOW DEF DMALU LEVEL DEF SBUF1 SCAN DEF .5 ************************ * JMP SQCON CONVERT DATA TO FLOATING VOLTS * SBUF1 OCT 3 ----------------------------- OCT 2 DEF GCHN SBUF2 OCT 3 OCT 1 SEMI-DYNAMIC BUFFER DEF CHANL FOR 2313 SCANS OCT 3 OCT 0 DEF SEQ .4 OCT 4 NUM NOP NUMBER OF READINGS VOLT1 NOP DATA STORAGE OCT 3 CLEAN OCT 1 UP OPERATION DEF DIGTZ TO RELEASE LL MPX * DIGTZ OCT 120000 M1 DEC -1 SKP * "PACER" SETS UP THE SYSTEM PACER, OR IF THE PACE RATE IS ZERO * TURNS OFF THE SYSTEM PACER. * * CALLING SEQUENCE: * * CALL PACER(RATE,MULT,MODE [,UNIT]) * WHERE: * RATE - BASIC PACER RATE (0 <= RATE <= 256) * MULT - DECADE MULTIPLIER TIMES THE BASIC 1 MICROSECOND * RATE ( 0 <= MULT <= 7 ) * MODE - EXTERNAL/START STOP MODE (BITS 11 AND 12 OF PACER * COMMAND WORD - SEE 12755A MANUAL) * UNIT - SUBSYSTEM NUMBER (OPTIONAL - ASSUMED 1) * RATE NOP MULT NOP MODE NOP UNIT1 NOP ERR4 NOP PACER NOP JSB .ENTR FETCH PARAMETER DEF RATE ADDRESSES CLA,INA PRESET ERROR TO 1 STA ERR4,I LDA PACER SAVE RETURN STA ENTRY ADDRESS LDB UNIT1 FETCH LOGICAL JSB FNDLU UNIT NUMBER * CLB CHECK ALL LDA RATE,I PARAMETERS ASR 5 FOR THE FOLLOWING IOR MULT,I LIMITS: ARS RATE 0 - 255 IOR MODE,I MODE 0 - 3 ARS,ARS MULT 0 - 7 SZA IF ANY PARAMETER OUT OF JMP ERR3. RANGE RETURN ERR=3 *P CLA,INA ASSUME ONE STA ENTNM WORD ENTRY LDB DCMD2 FETCH OUTPUT BUFFER ADDRESS LDA MODE,I IF MODE = 0 SZA,RSS B@< AND RATE IS NOT 0 CPA RATE THEN GO TO GENERATE JMP NZMOD PACER COMMAND WORD ADB M1 ELSE, GENERATE A 10 MS DELAY INA BEFORE PROGRAMMED ISZ ENTNM RATE STARTS * NZMOD STB DEFBF STORE QUEUE BUFFER ADDRESS LSL 3 GENERATE IOR MULT,I PACER LSL 8 COMMAND IOR RATE,I WORD IOR =B60000 AND STA CMD2 SAVE * JSB EXEC ************************ DEF *+5 SET DEF .2 UP DEF LU PACER DEF QBUF DEF .1 ******************************* * AND =B200 CHECK FOR PROPER REMOTE SZA,RSS AND OR LOCAL SZB,RSS OPERATION ERR2. LDA .2 STA ERR4,I JMP ENTRY,I * ERR3. LDA .3 JMP ERR2.+1 * ERROR ROUTINES FOR 2313 INTERFACE * ERR2 - ERROR NUMBER 2 * ERR3 - ERROR NUMBER 3 ERR3 LDA .3 RSS ERR2 LDA .2 STA ERR,I JMP ENTRY,I * QBUF OCT 3 QUEUE BUFFER FOR PACER CALL ENTNM NOP DEFBF NOP DCMD2 DEF CMD2 OCT 61412 10 MS START IMMEDIATE CMD2 NOP SKP A EQU 0 B EQU 1 AIRD EQU AIRDW AISQ EQU AISQW NMCHN EQU AISQF CNTR EQU AISQW LU EQU AIRDW SINGL EQU AIRDF SEQ EQU GN1 CHANL EQU CHN2 REMCH EQU SGAIN .ADC EQU RATE ADRS EQU NORM ADRS1 EQU SETUP MCHN EQU ENTNM FIXPT EQU DEFBF TEMP EQU GCHN AFCTR EQU RGAIN .1 EQU RBUF2+1 .2 EQU RBUF1+1 .3 EQU RBUF1 .5 EQU RBUF2 PACED EQU CHN1 LOOPC EQU FCHN DMALU EQU PACER END B jz 92413-18003 A S 0122 ISA FTN AOF.W ANALOG OUTPUT             H0101 !ASMB,R,L,C,B,F HED ISA S61.1 ANALOG OUTPUT A-92413-16003 REV. A NAM AOF.W,7 92413-16003A 16APR75 ENT AOF,AOW,AO EXT .ENTR,EXEC,..DAC,#GET! SUP ******************************************** * AOF,AO,AOW - ANALOG OUTPUT TO 2313 AND 6940 * * SOURCE: 92413-18003 REV A * RELOC: 92413-16003 REV A * * REVISION A BY STEVE SCOVILL ******************************************** * * * * * AOF PERFORMS ANALOG OUTPUT TO THE HP2313B DUAL DAC CARD USING * RTE DRIVER DVR62 OR TO 6940 VOLTAGE AND CURRENT DACS USING RTE * DRIVER DVR61. * * CALLING SEQUENCE: * CALL AOF(NUM,CHAN,VOLT,ERR) * WHERE: * NUM - ABS(NUM) = NUMBER OF OUTPUT VALUES * NUM < 0 PACED OUTPUT * NUM > 0 UNPACED OUTPUT * CHAN - INTEGER ARRAY OF ANALOG OUTPUT CHANNEL NUMBERS * VOLT - FLOATING POINT ARRAY OF OUTPUT VOLTAGES OR CURRENTS * ERR - ERROR RETURN PARAMETER * 1 - NO ERROR * 2 - DEVICE TIME OUT * 3 - ADDRESS OUT OF RANGE OR NO CHANNELS * 4 - OUTPUT VOLTAGE OR CURRENT OUT OF RANGE * * AOW IS IDENTICAL TO AOF EXCEPT ARRAY VOLT IS AN INTEGER ARRAY * CONTAINING THE ANALOG OUTPUT VALUES IN THE FORMAT SPECIFIED * BY THE DEVICE MANUAL * * * IF AN OUTPUT VALUE EXCEEDS THE MAXIMUM, THE MAXIMUM VALUE OF THE * CORRESPONDING SIGN IS OUTPUT AND THE ERROR NOTED IN IERR. * SKP AOF NOP LDA AOF FETCH RETURN ADDRESS CLB CLEAR FIXED POINT FLAG JMP START JOIN ROUTINE AOW * AOW NOP LDA AOW FETCH RETURN ADDRESS CLB,INB SET FIXED POINT FLAG * START STA ENTRY SAVE RETURN ADDRESS STB FIXPT SAVE FIXED POINT FLAG JMP ENTRY+1 GO FETCH PARAMS. NUM NOP CHAN NOP VOLT NOP ERR NOP ENTRY NOP JSB .ENTR FETCH PARAMETER DEF NUM ADDRESSES CLB,INB INITIALIZE ERROR STB ERR,I FLAG TO 1 LDA NUM,I FETCH NUMBER OF CHNLS SZA,RSS IF ZERO JMP ERR3 RETURN WITH ERROR 3 SSA IF NEGATIVE LDB =B10000 SET PACE BIT STB PACED AND SAVE SSA,RSS IF POSITIVE CMA,INA COMPLEMENT AND STA NUM SAVE FOR LOOP COUNTER SKP * * ANALOG OUTPUT LOOP STARTS HERE * AOF1 LDA CHAN,I FETCH CHANNEL NUMBER CMA,SSA,INA,SZA AND COMPLEMENT RSS IF < = 0 THEN JMP ERR3 GIVE ERROR #3 STA CNTR SAVE -( CHANNEL NUM. ) LDB ..DAC FETCH DAC TABLE ADDRESS ADA 1,I IF ADDRESSED SSA CHANNEL IS NOT DEFINED JMP DAC69 IN 2313, TRY 6940 * RSS FDAC STA CNTR SAVE -(#CHANNELS REMAINING) INB BUMP DAC TABLE ADDRESS LDA 1,I FETCH NEXT TABLE ENTRY AND =B7 AND MASK OF #CHNLS-1 ADA CNTR ADDRESSED CHANNEL SSA,INA,SZA IN THIS ENTRY? JMP FDAC NO, CONTINUE SEARCH STB ENTDC YES, SAVE ENTRY ADDRESS LDA VOLT,I LDB FIXPT CPB .1 JMP *+3 JSB FVOLT CONVERT VOLTS TO ASL 4 DAC DATA WORD STA OUTV AND SAVE IN OUTPUT BUFR LDA ENTDC,I FETCH CHANNEL ENTRY CLB EXTRACT LU ASL 6 FROM ENTRY STB LU AND SAVE ASR 4 SHIFT AND AND =B7740 MASK BOX AND SLOT NUMBER LDB CNTR FETCH CHANNEL CMB NUMBER AND BLF "OR" INTO IOR 1 COMMAND WORD IOR PACED OR IN PACE BIT IOR =B40001 OR IN COMMAND CODE STA CMND SAVE COMMAND WORD SKP * JSB EXEC ************************* DEF *+5 DEF .2 PERFORM DEF LU ANALOG DEF QBUF OUTPUT DEF .1 ************************** * AND =B200 SZA,RSS CHECK FOR BAD STATUS BITg SZB,RSS OR ZERO XMISSION LOG JMP ERR2 GIVE DEVICE ERROR NXTV LDA FIXPT IF FIXED POINT FLAG SZA,RSS BUMP VOLT ADDRESS ONE WORD ISZ VOLT UPDATE ISZ VOLT VOLTAGE ISZ CHAN AND CHANNEL ADDRESSES ISZ NUM LAST CHANNEL? JMP AOF1 NO, CONTINUE * JMP ENTRY,I RETURN * ERR3 LDA QBUF ERROR RETURN OF 3 RSS ERR2 LDA .2 ERROR RETURN OF 2 STA ERR,I JMP ENTRY,I * QBUF OCT 3 .2 OCT 2 DEF CMND * CMND NOP OUTV NOP PACED NOP CNTR NOP .1 OCT 1 .4 OCT 4 AO EQU AOW FIXPT EQU AOW ENTDC EQU AOF OVRF NOP SKP * * LIMIT CHECKS * FVOLT NOP ADB DEFLM COMPUTE LIMIT STB OVRF ADDRESS LDA FIXPT IF FIXED POINT SZA,RSS IS CLEAR GO TO JMP FXVLT FLOATING CONVERT LDA VOLT,I FETCH DATA WORD CMA,INA AND CHECK JMP FXV1 LIMITS * FXVLT DLD VOLT,I LOAD VOLTAGE OR CURRENT FMP =F-200. COMPUTE: -INTEGER FAD =F.0005 BUG FIXER!! SSA,RSS ADD A LITTLE BIT JMP *+3 FAD =F-.001 FOR ROUNDOFF ERRORS!! FIX VALUE FOR DAC FXV1 STA OUTV AND SAVE ADA OVRF,I IF BEYOND UPPER SSA BOUND, SET OUTPUT JMP OVRFL TO UPPER BOUND ISZ OVRF MOVE POINTER TO LOWER BOUND LDA OUTV IF LESS THAN ADA OVRF,I LOWER BOUND, CMA,INA SSA SET OUTPUT JMP OVRFL TO LOWER BOUND LDA OUTV VALUE WITHIN BOUNDS SO CMA,INA COMPLEMENT, MASK AND SAVE JMP FVOLT,I * OVRFL LDA .4 SET ERROR PARAMETER STA ERR,I TO 4 LDA OVRF,I SET OUTPUT VOLTAGE TO LIMIT JMP FVOLT,I * * 6940 DAC CALL * DAC69 LDA CHAN,I GET CHAN JSB #GET! LU NOP TYPE NOP NOP PARAMETETRS THAT AREN'T NOP USED BUT THESE NOP'S ARE! SSB ERROR? JMP ERR3 CHAN TOO BIG ADA .M1 DIV .15 IOR CNTL STA CMND SAVE CNTL WORD BLF MOVE SLOT BLF,BLF TO MSB'S STB SLOT SAVE SKP * * CHECK TYPE,SCALE,DO OUTPUT * LDA TYPE GET TYPE CLB SET LIMIT FOR VOLT DAC CPA .5 IF VOLTAGE DO CONVERSION JMP *+5 LDB .2 SET LIMIT FOR CURRENT DAC CPA .6 IF CURRENT DO CONVERSION RSS JMP ERR3 ELSE,ERROR 3 * JSB FVOLT ENTRIES AND B7777 ADD SLOT # IOR SLOT INFORMATION STA OUTV TO DATA WORD * WRITE JSB EXEC *************************** DEF *+6 PERFORM DEF .2 NORMAL DEF LU WRITE DEF CMND WITH DEF .2 HANDSHAKE DEF .1 ************************* * AND =B204 SZA,RSS CHECK FOR BAD STATUS BITS SZB,RSS OR ZERO XMISSION LOG RSS DEVICE ERROR JMP NXTV NO, FETCH NEXT VALUE * LDA .2 STA ERR,I LDA CMND AND =B20 SZA,RSS JMP ENTRY,I XOR CMND STA CMND JMP WRITE * .M1 DEC -1 .15 DEC 15 SLOT NOP .5 DEC 5 .6 DEC 6 CNTL OCT 170160 DEFLM DEF LIMIT LIMIT OCT 3777 VOLTAGE DAC UPPER BOUND OCT 174000 AND LOWER BOUND B7777 OCT 7777 CURRENT DAC UPPER BOUND OCT 0 AND LOWER BOUND END 3< kt 92413-18004 B S 0122 ISA FTN DI.O DIGITAL INPUT/OUTPUT             H0101 ASMB,R,L,C,B HED ISA S61.1 DIGITAL INPUT/OUTPUT A-92413-16004 REV. B NAM DI.O,7 92413-16004B 18SEP75 ENT DIW,DI,DOLW,DOL,DOMW,DOM ENT STEPW,STEP,PSET EXT EXEC,.ENTR,$LIBR,$LIBX,#GET! SUP ******************************************************* * DI,DIW,DOL,DOLW,DOM,DOMW,PSET,STEP,STEPW - * DIGITAL INPUT OUTPUT ROUNTINES FOR 6940 * * SOURCE: 92413-16004 REV B * RELOC: 92413-18004 REV B * * REVISION B BY STEVE SCOVILL ******************************************************* * * * * DI.O PERFORMS DIGITAL INPUT AND OUTPUT CALLS TO THE 6940 * USING STANDARD EXEC CALLS. * * CALLING SEQUENCES: * * CALL DI(NUM,ICHAN,IDATA,IERR) * * CALL DIW(NUM,ICHAN,IDATA,IERR) * * THE TWO DIGITAL INPUT CALLS DIFFER IN THAT THE DI CALL DOESN'T * USE EITHER A GATE OR TME BIT DURING ITS OPERATION. THE DIW CALL * DOES USE THE GATE AND TME BITS AND WAITS FOR A INPUT FLAG FROM * THE ADDRESSED CARD * * * CALL DOL(NUM,ICHAN,IDATA,IMASK,IERR) * * CALL DOLW(NUM,ICHAN,IDATA,IMASK,IERR) * * THE OUTPUT VALUE ACTUALLY OUTPUTED TO THE ADDRESSED CARD IS GIVEN * BY THE FOLLOWING LOGICAL EXPRESSION- * * OUTPUT=(DATA.AND.MASK).OR.(STATUS.AND.(.NOT.MASK)) * * WHERE * DATA IS THE THIRD PARAMETER * MASK IS THE FOURTH PARAMETER * STATUS IS THE PREVIOUS OUTPUT * * THE TWO OUTPUT CALLS DIFFER IN THAT THE DOL CALL DOESN'T * USE THE TME BIT AND HENCE DOESN'T WAIT FOR THE FLAG TO BE * RETURNED FROM THE CARD. THE DOLW CALL WAITS FOR THIS FLAG * BY USING THE TME BIT. * * * CALL DOM(NUM,ICHAN,IDATA,IDELAY,IERR) * * CALL DOMW(NUM,ICHAN,IDATA,IDELAY,IERR) * * THE DOM CALLS PERFORM MOMENTARY DIGITAL OUTPUT BY FIRST * OUTPUTTING ALL GIVEN DATA WORDS THEN SUSPENDING ITSELF FOR * THE GIVEN TIME AND FINALLY CLEARS ALL THE CARDS BY OUT- * PUTTING ZEROS. * * THERE IS NO DIFFERENCEx IN THE DOM AND DOMW CALLS. BOTH DON'T * USE THE TME BIT. * * * CALL STEP(NUM,ICHAN,IDATA,IERR) * * CALL STEPW(NUM,ICHAN,IDATA,IERR) * * STEP PREFORMS OUTPUT TO THE STEPPING MOTOR CARD. * POSITIVE VALUES ARE TO OUTPUT NUMBER ONE, AND NEGATIVE VALUES * ARE TO OUTPUT NUMBER TWO(BIT 11 = ONE). * * AS WITH THE DOL CALL, STEP DOESN'T WAIT TO COMPLETE WHILE * THE STEPW DOES. CARE SHOULD BE USED WHILE PROGRAMMING WITH * THE STEPW CALL AS THE STEPPING MOTOR IS QUITE SLOW (100 HERTZ) * AND THERE MAY BE A POSSIBILITY OF INTERFERING WITH THE OPERATION * OF HIGHER PRIORITY PROGRAMS. * * * CALL PSET(NUM,ICHAN,IDATA,IERR) * * PSET IS USED TO PRESET A COUNTER CHANNEL TO A GIVEN VALUE * FOR THE PRESET COUNTER WITH INTERRUPT FUNCTION. IT IS DESIGNED * TO BE USED IN CONJUNCTION THE THE EVSNS CALL. * * PARAMETER DEFINATIONS * * NUM- INTEGAR NUMBER OF READINGS TO BE TAKEN * ICHAN-INTEGAR ARRAY (LENGTH = NUM) OF 6940 CHANNEL NUMBERS * IDATA-INTEGAR ARRAY (LENGTH = NUM) OF OF DATA TO BE OUTPUTED * MASK- INTEGAR MASK USED TO DETERMINE WHICH BITS GET CHANGED * IDELAY-INTEGAR DURATION OF THE MOMENTARY OUTPUT IN 10'S OF MS * IERR- ERROR PARAMETER * 1=NORMAL OPERATION * 2=DEVICE ERROR OR MALFUNCTION * 3=BAD PARAMETER (USUALLY INCORRECT CHANNEL ADDR) * * * SKP DI NOP LDA DI FIX RETURN ADDRESS LDB .2 GET IFUNC = 2 STB IFUNC (NO GATE) LDB =B170640 AND TME =0 JMP DIX * DIW NOP LDA DIW FIX RETURN ADDRESS LDB ZERO GET IFUNC =0 STB IFUNC (WITH GATE) LDB =B170260 AND TME = 1 * DIX STB TME? SAVE CONTROL WORD CLB FIX ERROR FOR A FOUR STB ERR PARAMETER CALL JSB SETUP SET THINGS UP * * BUILD EXEC CALL * LDA TME? BUILD ADA UNIT UP STA IBUFF+1 EXEC LDA SLOT CALL STA IBUFF+2 TO 6940 * JSB EXEC CALL DEF *+6 6940 DEF .1 DRIVER DEF LU TO DEF IBUFF READ DEF .5 ONE DEF IFUNC WORD * AND =B204 SZA,RSS CHECK FOR BAD STATUS BITS SZB,RSS OR ZERO XMISSON LOG JMP ERR2 GIVE IERR = 2 * LDA IWORD FETCH WORD READ AND =B7777 GET RID OF LOWER BITS! STA DATA,I AND SAVE ISZ DATA BUMP ARRAY ISZ CHAN ADDRESSES ISZ NUM LAST WORD? JMP GET2 NO, READ NEXT WORD JMP ENTRY,I YES, RETURN * * INPUT BUFFER * IBUFF DEC 2 BUFFER BSS 2 FOR .1 OCT 1 READ IWORD BSS 1 DIRECT .2 EQU IBUFF SKP * * "DOLW" PERFORMS LATCHING DIGITAL OUTPUT * THE OUTPUT VALUE IS EQUAL TO THE FOLLOWING LOGICAL EXPRESSION * * OUTPUT = ( DATA AND MASK ) OR ( STATUS AND MASK' ) * * WHERE: * DATA - OUTPUT DATA ( 3RD PARAMETER ) * MASK - OUTPUT MASK ( 4TH PARAMETER ) * STATUS - PREVIOUS OUTPUT WORD STATUS * * DOL NOP DOL WITHOUT WAIT LDA TME0 GET TME = 0 STA TME? SAVE TME FLAG CLB,INB STB MODE LDA DOL GET RETURN ADDR JMP DOLX CONTINUE * DOLW NOP DOL WITH WAIT LDA TME1 SET TME TO 1 STA TME? SAVE TME FLAG CLB STB MODE LDA DOLW FIX RETURN ADDRESS DOLX JSB SETUP GET CALLING PARAMETERS JSB STATS GET STATUS LDA TME? WITH TME = 1 ADA UNIT ADD IN THE UNIT NUMBER STA OBUFF SAVE IN OUTPUT BUFFER LDA DATA,I FETCH NEXT OUTPUT AND DELAY,I WORD, MASK IT AND STA TEMP SAVE RESULT LDA DELAY,I FORM COMPLEMENT CMA OF MASK AN܏D ADR2,I AND SAVE APPROPRIATE ADR2ITS IOR TEMP OR IN NEW BITS AND JSB OUTPT OUTPUT WORD ISZ DELAY BUMP MASK ADDRESS ISZ NUM LAST ENTRY? JMP GET2 NO, CONTINUE JMP ENTRY,I SKP * * "DOMW" PERFORMS MOMENTARY DIGITAL OUTPUT BY FIRST OUTPUTTING * ALL GIVEN DATA WORDS THEN SUSPENDING ITSELF FOR THE SPECIFIED * TIME, THEN OUTPUTTING ZERO. * * DOMW NOP ENTRY POINT LDA DOMW FIX RETURN ADDRESS JSB SETUP GET CALLING PARAMETERS * CLB,INB SET MODE OF OUTPUT TO STB MODE WRITE WITH HANDSHAKE JSB STATS GET STATUS * LDB TME0 AND TME = 0 ADB UNIT ADD IN THE UNIT NUMBER STB OBUFF SAVE IN OUTPUT BUFFER * LDA DATA,I FETCH WORD FOR OUTPUT JSB OUTPT AND GO OUTPUT IT ISZ NUM LAST WORD? JMP GET2 NO, CONTINUE * LDA DELAY,I FETCH DELAY CMA,SSA,INA,SZA COMPLEMENT AND IF RSS DELAY IS NEGATIVE OR ZERO JMP OUT0 SKIP DELAY STA DELAY * JSB EXEC SUSPEND DEF *+6 PROGRAM DEF .12 FOR DEF ZERO SPECIFIED DEF .1 TIME DEF ZERO DEF DELAY * OUT0 LDA NX2 STA SETUP LDA CHAN RESET CHANNEL ADA NUM1 POINTER TO STA CHAN FIRST ELEMENT IN ARRAY NEXT1 JMP GET2 NXT2 JSB STATS GET STATUS CLA RESET JSB OUTPT ALL * ISZ NUM1 OUTPUTS JMP NEXT1 TO ZERO JMP ENTRY,I NX2 DEF NXT2 SKP * * STEP PERFORMS OUTPUT TO THE STEPPING MOTOR CARD * IF DATA IS NEGATIVE, IT IS MADE POSITIVE * AND THEN BIT 11 IS SET (THE OTHER DIRECTION). * * STEP NOP STEP W/O WAIT LDA TME0 SET TME=0 STA TME? SAVE TME FLAG CLB,INB STB MODE LDA STEP V GET RETURN ADDR JMP STEPX CONTINUE * STEPW NOP STEP WITH WAIT LDA TME1 SET TME TO 1 STA TME? SAVE TME FLAG CLB STB MODE LDA STEPW FIX RETURN ADDR STEPX CLB SET ERR FOR A STB ERR FOUR PARAMETER CALL JSB SETUP AND GET PARAMETERS * JSB STATS GET STATUS(IF ANY) * LDB TME? MAKE A CONTROL ADB UNIT WORD WITH TME STB OBUFF * LDA DATA,I GET THE DATA, SSA,RSS AND IF NEGATIVE JMP *+3 CMA,INA MAKE POSITIVE IOR M11 AND SET BIT 11 JSB OUTPT DO OUTPUT * ISZ NUM MORE? JMP GET2 YES, CONTINUE JMP ENTRY,I RETURN SKP * * PSET PRESETS A COUNTER CARD TO THE GIVEN VALUE * PSET NOP CLA SET ERR FOR A STA ERR FOUR PARAMETER CALL LDA PSET FIX RETURN ADDR JSB SETUP GET CALLING PARAMETERS * LDA TYPE CHECK FOR CPA .8 A COUNTER CARD RSS IF NOT JMP ERR3 GIVE ERROR 3 * CLB,INB SET MODE STB MODE TO HANDSHAKE * LDB TME0 SET CONTROL WORD 1 ADB UNIT TO TME=0 STB OBUFF PLACE IN BUFFER LDA DATA,I JSB OUTPT DO THE OUTPUT ISZ NUM DONE? JMP GET2 NO,CONTINUE JMP ENTRY,I YES, RETURN SKP * * SETUP: SAVES A FEW WORDS * SETUP NOP STA ENTRY STORE ENTRY JMP ENTRY+1 GET CALLING PARAMETERS * NUM NOP CHAN NOP DATA NOP DELAY NOP ERR NOP * ENTRY NOP JSB .ENTR DEF NUM * LDA ERR SEE IF ERR SZA IS ZERO (DIGIN) JMP *+3 LDA DELAY IF SO, PUT DELAY STA ERR INTO ERR * LDA .1 SET ERR STA ERR,I TO 1 LDA NUM,I MAKE NUM CMA,81INA NEGATIVE SZA IF ZERO, SSA,RSS OR POSITIVE JMP ERR3 GIVE ERROR 3 STA NUM STA NUM1 * * GET TABLE VALUES * GET2 LDA CHAN,I GET CHAN * JSB #GET! LU NOP TYPE NOP REL# NOP ADR NOP SSB ERROR? JMP ERR3 CHAN OUT OF RANGE * ADA .M1 DIV .15 STA UNIT SAVE UNIT BLF,BLF BLF MOVE SLOT TO MSB'S STB SLOT AND SAVE JMP SETUP,I SKP * * "OUTPT" PERFORMS OUTPUT TO 6940 AND UPDATES OUTPUT STATUS * TABLE. * OUTPT NOP AND B7777 MASK DATA AND 'OR' IOR SLOT WITH SLOT STA OBUFF+1 TO FORM OUTPUT WORD * LDA ADR2 GET STATUS ADDR LDB OBUFF+1 AND OUTPUT WORD ISZ CHAN ISZ DATA * JSB $LIBR NOP STB 0,I JSB $LIBX DEF *+1 DEF *+1 * WRITE JSB EXEC PERFORM DEF *+6 DIGITAL DEF .2 OUTPUT DEF LU TO DEF OBUFF 6940 DEF .2 DEF MODE * AND =B204 CHECK FOR BAD STATUS BITS SZA,RSS SZB,RSS OR ZERO XMISSION LOG JMP .ERR2 ERROR 2 JMP OUTPT,I * * CONSTANTS, CONTROL WORDS, STORAGE * .M1 DEC -1 ZERO DEC 0 .3 DEC 3 .5 DEC 5 .8 DEC 8 .12 DEC 12 .15 DEC 15 B7777 OCT 7777 M11 OCT 4000 * TME0 OCT 170140 TME1 OCT 170160 TME? NOP * UNIT NOP SLOT NOP NUM1 NOP MODE NOP ADR2 NOP IFUNC NOP * * OUTPUT BUFFER * OBUFF NOP NOP * * GET STATUS ADDR(IF ANY) * STATS NOP CLA CLEAR PHONEY STA ADRX,I STATUS LDA TYPE IF TYPE OF CARD CPA .3 DI/O USE STATUS FROM BUFFER JMP TABLE LDA ADRX ELSE, USE PHONY STA ADR2 (ZERO) STATUS JMP STATS,I AND RETURN TABLE CCA LOCATE THE ADA :*($REL# REAL STATUS ADA ADR IN THE STA ADR2 CONFIGURATION TABLE JMP STATS,I AND RETURN * ADRX DEF *+1 NOP * * WHATS EQUAL TO WHAT * DOM EQU DOMW TEMP EQU DOLW * * ERRORS * .ERR2 LDA OBUFF AND =B20 SZA,RSS JMP ERR2 LDA OBUFF AND =B170057 STA OBUFF JSB EXEC DEF *+6 DEF .2 DEF LU DEF OBUFF DEF .1 DEF MODE RSS ERR3 ISZ ERR,I ERR2 ISZ ERR,I JMP ENTRY,I END )* l x 92413-18005 A S 0122 ISA FTN #GET! TABLE SUBROUTINE             H0101 %ASMB,R,L,C,B HED #GET! TABLE SUBROUNTINE 92413-16005 REV. A NAM #GET!,7 92413-16005 REV A 24APR75 ENT #GET! EXT &6940 * * * THIS IS A COMMON ROUNTINE FOR ISA AND RTEB DEVICE SUBS * FOR GETTING PARAMETERS OUT OF &6940, THE TABLE * BUILT FROM THE 6940 TABLE GENERATOR. * * CALLING SEQUENCE * (A)= SOFTWARE CHANNEL NUMBER * * JSB #GET! * LU NOP * TYPE NOP * REL# NOP * ADR NOP * (RETURN) * * (A)= EFFECTIVE CHANNEL * (B)= 0 NORMAL RETURN * (B) = -1 ERROR RETURN * * #GET! NOP LDB TOP GET BASE PAGE LINK SSB,RSS AND CHECK FOR INDIRECT JMP *+4 NO,ITS THE TRUE ADDR ELB,CLE,ERB STRIP INDIRECT BIT LDB 1,I GET ADDR JMP *-4 AND TEST AGAIN STB ADR SAVE IT ADA TOP,I TEST TO SEE SSA,RSS IF CHAN IS SZA,RSS TOO SMALL JMP LOSE GIVE ERROR ISZ ADR BUMP POINTER GET0 LDB ADR,I GET CHAN # SSB END OF TABLE? JMP LOSE YES,RETURN W/ ERROR ADA 1,I ADD NEG CHAR ISZ ADR BUMP CTR SZA,RSS JMP *+3 SSA,RSS THIS UNIT? JMP GET0 NO,CONTINUE CHECKING CMA,INA FIX REL ADA 1,I COUNT INB STB ADR STORE ADDRESS INB INCREMENT IT LDB 1,I GET LU STB #GET!,I AND STORE ISZ #GET! BUMP PTR CLB CLEAR DEVICE TPYE STB #GET!,I AND STORE GET1 ISZ ADR MOVE TO NEXT ISZ ADR DEVICE ENTRY ISZ #GET!,I BUMP DEV TPYE CODE ADB ADR,I ACCUM COUNTS ADA ADR,I SSA THIS DEVICE? JMP GET1 NO,CONTINUE CHECKING ISZ #GET! BUMP POINTIR CMA,INA FIX REL CT ADB 0 (B)=HARDWARE CHAN ADA ADR,I REL CT STA #GET!,I AND STORE ISZ #GETa  ! BUMP GET ISZ ADR GET LDA ADR,I TABLE ADDRESS STA #GET!,I AND STORE SWP CHAN # INTO A CLB (B) FOR NORMAL RETURN GET2 ISZ #GET! BUMP GET JMP #GET!,I AND RETURN * LOSE CCB SET (B) FOR ERROR ISZ #GET! BUMP ISZ #GET! GET ISZ #GET! FOR JMP GET2 RETURN ADR NOP TEMP STORAGE TOP DEF &6940 POINTER TO TABLE END END$  mt 92413-18006 A S 0122 ISA FTN TRPNT TRPNT FIX FOR ALARM             H0101 ASMB,R,L,C,B HED TRPNT FIX 09611-16003 REV A NAM TRPNT,7 09611-16003 REV A 28FEB75 ENT TRPNT * * TRPNT SATISIFIES THE TRPNT ENTRY POINT OF THE ALARM * PROGRAM WHEN ALARM IS USED IN AN RTE ENVIRONMENT * WITHOUT BASIC. * NOTE: IF PLACED IN THE SYSTEM AREA A MEMORY PROTECT * WILL OCCUR IF THE ALARM PROGRAM SHOULD TRY TO * SET A TRAP NUMBER IN THE NON-EXISTANT BASIC. * * * * SOURCE 09611-18003 REV A * RELOC 09611-16003 REV A * * REV A BY STEVE SCOVILL * TRPNT NOP JMP TRPNT,I END END$ - nt 92413-18007 B S 0122 ISA FTN ALARM EVENT SENSE INTERRUPT PROG            H0101 iiASMB,R,L,C,B HED EVENT SENSE INTERRUPT HANDLER FOR 6940 A-92413-16007-1 * * ALARM - EVENT SENSE INTERRUPT HANDLER FOR HP6940A * * SOURCE TAPE - 92413-18007 REV.B * RELOC. TAPE - 92413-16007 REV.B * * BY STEVE SCOVILL * ALARM IS SCHEDULED BY THE HP6940A RTE DRIVER DVR61 WHEN AN * EVENT SENSE INTERRUPT OCCURS. THE FIRST TWO PARAMETERS PASSED * TO ALARM BY THE DRIVER CONTAIN THE SLOT NUMBER AND CONTENTS OF * THE INTERRUPTING CARD. ALARM THEN DETERMINES IF ANY OF THE BIT * CHANGES ARE CONNECTED TO PROGRAMS. IF SO, THE CORRESPONDING * PROGRAM IS SCHEDULED AND PASSED THE FOLLOWING PARAMETERS: THE LOG- * ICAL CHANNEL THAT INTERRUPTED, THE DATA FROM THAT CHANNEL, AND * WHICH BIT CAUSED THE INTERRUPT. IF AN ERROR OCCURS * THE ERROR IS PRINTED AS "ALARM ERR XXNN", WHERE XX IS THE RTE ERROR * TYPE AND NN IS THE NUMBER. * NAM ALARM,1,2 92413-16007B 19SEP75 ENT ALARM EXT EXEC,$LIBX,$LIBR,&6940,TRPNT SUP * ALARM NOP STB HOLD1 SAVE PARAMETER ADDRESS DLD HOLD1,I GET SLOT AND DATA DST SLOT SAVE THEM LDB HOLD1 GET ADDR BACK JSB EFF GET EFFECTIVE ADDR ADB .4 MOVE TO OBTAIN ADDR OF 5TH PARAMETER LDA 1,I AND GET IO SLOT AND M77 MASK OUT UPPER BITS STA IOSLT SAVE IT * * * FIND RIGHT 6940 * LDB TOP GET BASE PAGE LINK JSB EFF GET EFFECTIVE ADDR STB .6940 AND SAVE IT LDB .6940,I GET MINUS # OF CHANS IN 2313 * (B) CONTAINS THE ACCUMULATED CHANNEL COUNT (MINUS) AGAIN ISZ .6940 UNIT TABLE LDA .6940,I TO FIND SELECT SSA CODE ADDR * * IF THE FOLLOWING ERROR HAPPENS * ITS PROBABLY DUE TO A CONFIGURATION PROBLEM * JMP ERR2 ERROR INA GET THE LDA 0,I I/O SLOT FROM CPA IOSLT THE TABLE AND CHECK JMP *+4 IF THE SAME, CONTINUE LDA .6940,I IF NOT, ¿ACCUMULATE THE ADB 0,I CHANNEL COUNT JMP AGAIN AND TRY SOME MORE * * (B) CONTAINS THE MINUS OF THE CHANNEL COUNT TO THIS POINT * CMB,INB MAKE CHANNEL COUNT INB POSITIVE AND ADD 1 STB #CHAN SAVE FOR LATER * * FETCH PARAMETERS * DLD SLOT LOAD SLOT & INPUT WRD STB IDATA SAVE INPUT ASL 12 SHIFT SLOT STA SLOTA AND SAVE LDA SLOT ADD SLOT ADA #CHAN TO THE STA #CHAN ACCUMULATED CHANNEL COUNT * * CHECK TO DETERMINE IF EVENT SENSE * OR DIGITAL INPUT CARD * LDB .6940,I GET TOP OF ADB .2 UNIT TABLE, ADD LDA 1,I TWO AND SAVE STA LU LU * CLA STA NAM1 * INB BUMP POINTER AND LDA 1,I GET # OF EVENT CARDS CMA,INA MAKE NEG STA MEVNT SAVE MINUS NUMBER OF EVENT CARDS ADA SLOT ADD SLOT SSA EVENT OR DIG? JMP EVENT CMA,INA ADB .2 BUMP PTR TO # DIG IN ADA 1,I (A)= #EVENT+#DIGIN-SLOT SZA,RSS JMP CANCL SSA,RSS DIG INPUT? JMP DIGIN JMP CANCL CANCL INTERRUPT SKP * * EVENT * EVENT ADA 1,I ADD BACK #EVENT INB BUMP PTR TO EVENT BUFF LDB 1,I GET BUFFER POINTER STB HOLD2 SAVE FOR LATER INB ADB 0 FIND DATA ADDR & STB PATRN SAVE (STATUS WORD ADDR) CLB * A REG CONTAINS SLOT MPY .12 FIND BIT/PROG ADA HOLD2,I ENTRY INA IN TABLE STA TABLE AND SAVE RETRY JSB SCTBL UPDATE BIT/PROG TABLE * JSB EXEC READ DEF *+6 AND DEF .1 RESET DEF LU INTERRUPTING DEF POLBF EVENT DEF .6 SENSE DEF .7 CARD LDA DATA GET DATA SSA IF ANY TRANSFERRED JMP RETRY TRY AGAIN * EXIT LDA LU MAKE XOR =B2100 LU EQUAL STA LU LU + 2000B * JSB EXEC SET DEF *+3 SENSE DEF .3 MODE DEF LU BIT * * EXIT2 JSB EXEC TERMINATE DEF *+2 DEF .6 * SKP * * SCTBL SCANS THE BIT/TRAP TABLE AND CALLS THE TRAP PROCESSER WHEN * AN EVENT HAS OCCURED * SCTBL NOP JSB $LIBR TURN OFF INTERRUPTS NOP LDA DATA GET THE OLD LDB PATRN,I AND NEW DATA STA PATRN,I SAVE THE NEW JSB $LIBX TURN ON INTERRUPTS DEF *+1 DEF *+1 XOR 1 FIND BIT CHANGES AND =B7777 IF NO CHANGES SZA,RSS FROM PREVIOUS PATTERN JMP SCTBL,I RETURN LDB M12 INITIALIZE STB CNTR BIT COUNTER CLB STB BITNO CLEAR BIT NUMBER LDB TABLE FETCH ADDRESS OF BIT/PROG STB PNTR TABLE AND USE AS INDEX LDB 0 PUT BIT CHANGES IN "B" NXTBT CLA MOVE NEXT BIT ASR 1 INTO "A" XOR PNTR,I UPDATE BIT/PROG ENTRY CPA PNTR,I IF NO CHANGE SKIP JMP CONT UPDATE OF TABLE JSB $LIBR *************************** NOP TURN OFF INTERRUPT SYSTEM STA PNTR,I TO UPDATE TABLE JSB $LIBX TURN INTERRUPT SYSTEM DEF *+1 BACK ON DEF *+1 *************************** SSA,RSS IF NEW STATUS IS 1 (EVENT) JMP CONT SET TRAP, ELSE CONTINUE ELA,CLE,ERA SET SIGN BIT TO ZERO STB SAV.B SAVE STATUS WORD SZA,RSS IF NO TRAP NUMBER SKIP JMP CONT SCHEDULE CALL JSB SKED CONT. LDB SAV.B RESTORE DATA WORD CONT ISZ PNTR BUMP TABLE POINTER ISZ BITNO ISZ CNTR LAST BIT? JMP NXTBT NO, GO TO NEXT BIT JMP >SCTBL,I SKP * * SCHEDULE PROGRAM * SKED NOP STA NAM1 * * IF FIRST CHAR = 0, THEN BASIC TRAP NUMBER * AND UPMSK CHECK IF SZA,RSS A BASIC JMP BASIC TRAP NUMBER * JSB EXEC SCHEDULE DEF *+6 THE DEF B1011 PROGRAM DEF NAM1 DEF #CHAN AND PASS IT THE CHANNEL NO, DEF DATA DATA, DEF BITNO AND WHICH BIT PARAMETERS JMP WRITE ERROR RETURN JMP SKED,I * * BASIC * BASIC LDA NAM1 GET THE TRAP NUMBER JSB TRPNT AND CALL THE NOP BASIC TRAP ROUNTINE JMP CONT. ANY MORE? * * DIGIN * DIGIN LDA 1,I SZA JMP DIG1 CHECK FOR ZERO DIG INPUT CANCL LDA =B170140 JMP DEACT DIG1 INB BUMP B TO DIGIN LDA MEVNT GET MINUS NUMBER OF EVENT ADA SLOT ADD THE SLOT NUMBER ADA 1,I GET THE PROGRAM ADDRESS LDA 0,I GET THE PROG ENTRY * * CHECK TO SEE IF BIT/PROG SET * ELA,CLE,ERA STRIP OFF BIT 15 SZA,RSS IF ENTRY IS ZERO, JMP CANCL IGNORE INTERRUPT STA NAM1 ELSE, SAVE NAME CLB CLEAR BIT NUMBER STB BITNO LDA =B170240 SKP * * DEACTIVATE INPUT CARD * DEACT STA BUFF LDA SLOTA PUT SLOT INTO STA BUFF+1 THE BUFFER JSB EXEC DEF *+6 DEF .2 WRITE A DEF LU WORD TO DEF BUFF THE INPUT DEF .2 CARD TO DEF .0 DEACTIVATE IT * AND =B204 SZA,RSS CHECK FOR BAD STATUS BITS SZB,RSS OR ZERO XMISSION LOG JMP ERR2 GIVE ERROR 2 * LDA NAM1 PROGRAM TO SZA BE SCHEDULED? JSB SKED YES JMP EXIT RETURN * * ERRORS * EMES2 ASC 2,MP02 * ERR2 DLD EMES2 * WRITE DST ERRBF JSB EXEC WRITE sTHE DEF *+5 ERROR MESSAGE DEF .2 TO THE DEF .1 CRT DEF ERRB DEF .7 * LDA ERRBF IF ERROR WAS CPA EMES2 ERROR TWO JMP EXIT2 DON'T RESET THE SENSE MODE JMP EXIT NORMAL EXIT * * INPUT BUFFER * POLBF OCT 170640 THESE 6 WORDS FORM .1 DEC 1 THE POLE TO SLOTA NOP FIRST HIT BUFFER. .M1 DEC -1 THIS BUFFER CAUSES THE NOP INTERRUPTING CARD TO BE IDATA NOP READ AND ENABLED SKP * * THIS ROUNTINE GETS THE EFFECTIVE ADDR * EFF NOP SSB,RSS CHECK FOR INDIRECT JMP EFF,I ITS THE TRUE ADDR, RETURN ELB,CLE,ERB STRIP OF INDIRECT BIT LDB 1,I GET ADDR JMP *-4 TRY AGAIN * * CONSTANTS AND OTHER THINGS * .0 NOP .2 DEC 2 .3 DEC 3 .4 DEC 4 .6 DEC 6 .7 DEC 7 .12 DEC 12 M12 DEC -12 M77 OCT 77 B1011 OCT 100011 UPMSK OCT 177400 TOP DEF &6940 * NAM1 ASC 3,XXXXX ERRB ASC 5,ALARM ERR ERRBF BSS 2 * * TEMP STORAGE * .6940 NOP BITNO NOP TABLE NOP SAV.B NOP PATRN NOP PNTR NOP CNTR NOP SLOT NOP DATA NOP LU NOP #CHAN NOP IOSLT NOP MEVNT NOP * * WHAT'S EQU TO WHAT * HOLD1 EQU LU HOLD2 EQU IOSLT BUFF EQU ERRBF END ALARM D o y 92413-18008 A S 0122 ISA FTN EVSNS EVENT SENSE             H0101 -aASMB,R,L,C,F,B HED ISA EVENT SENSE A-92413-16008 REV. A * * EVSNS - EVENT SENSE DEVICE SUBROUTINES FOR HP6940A * * SOURCE TAPE 92413-18008 * RELOC. TAPE 92413-16008 * * * * NAM EVSNS,7 92413-16008A 07MAY75 ENT MPNRM,EVSNS EXT .ENTR,&6940,#GET!,EXEC EXT $LIBR,$LIBX SUP * * * EVSNS SETS UP A BIT/PROG DEFINTITON AND ENABLES SENSE MODE * FOR THE HP6940. PARAMETERS ARE CHANNEL, NUMBER OF OUTPUT * BIT, VALUE OF OUTPUT BIT, PROG USED BY EVSNS CALL, AND * ERROR RETURN. ERR=1 IS NORMAL: 2 IS TIMEOUT: 3 IS BAD * CHANNEL OR BIT ADDRESS. * * SKP CHANL NOP OUTPUT CHANNEL NBIT4 NOP NUMBER OF OUTPUT BIT (0-11) BIT4 NOP VALUE OF OUTPUT BIT PROG NOP PROG USED BY "EVSNS" CALL ERR NOP EVSNS NOP ENTRY POINT JSB .ENTR DEF CHANL CLA,INA CLEAR ERROR PARAMETER STA ERR,I LDA CHANL,I JSB TABLE * LDA TYPE EVENT SENSE CPA .1 OR RSS DIGITAL JMP DIGIN INPUT CARD? * LDA NBIT4,I PRODUCE JSB #BIT# BIT MASK LDB BIT4,I BIT TO BE SZB WRITTEN ZERO? CCB NO, SET BIT SWP AND/OR OUTPUT WORDS CONSIST AND B OF COMPLEMENT OF BIT MASK CMB AND BIT TO BE WRITTEN AND B7777 MASK AND STORE LOWER STA OR 12 BITS OR "OR" WORD STB AND SAVE "AND" WORD CMB COMPLEMENT AND STB NAND SAVE NAND WORD * LDA ADR COMPUTE ADDRESS ADA REL# OF OUTPUT STA ADRS ENTRY AND SAVE SKP JSB CLEAR CLEAR SENSE BIT LDB PROG,I GET PROGRAM LDA ADRS,I AND GET THE PROGRAM CPA .M1 BEEN USED YET? JSB RESET NO, GET REAL STATUS * AND NAND GET BIT TO BE SENSED SWP CPB OR n COMPARE NEW AND OLD STATUS IOR BIT15 IF EQUAL SET BIT 15 STA PROG SAVE THE PROGRAM FOR LATER * * * COMPUTE ADDRS IN BIT/PROG(PROG) TABLE * CCA COMPUTE ADA REL# ADDR MPY .12 IN ADA ADR,I BIT/PROG ADA NBIT4,I TABLE INA STA ADR * * IF THE FIRST CHAR IS A NULL (0'S) THEN GIVE ERR3 * (NULL FIRST CHAR IS A BASIC TRAP NUMBER! ) * * UPDAT LDA PROG SZA,RSS JMP *+4 AND UPMSK SEE IF SZA,RSS BASIC, JMP ERR3 IF SO, GIVE ERROR AND =B77777 CPA ASC0 COMPARE TO RSS ASCII ZERO JMP *+3 CLA IF SO, MUST MEAN STA PROG TO CLEAR PROG ENTRY * JSB $LIBR TURN OFF INTERRUPTS NOP LDB PROG GET NEW PROG STB ADR,I SAVE IN BIT/PROG TABLE JSB $LIBX TURN BACK ON INTERRUPTS DEF *+1 DEF *+1 * * TIME TO LEAVE * LDA EVSNS STA CLEAR LDA LU XOR B2100 JMP CLEAR+3 SKP * * GET TABLE VALUES * TABLE NOP JSB #GET! GET TABLE VALUES LU NOP STORAGE TYPE NOP FOR REL# NOP TABLE ADR NOP VALUES SSB ERROR? JMP ERR3 CHAN OUT OF RANGE * CLB ADA .M1 DIV .15 BLF,BLF MOVE SLOT BLF TO MSB'S STB SLOT AND STORE JMP TABLE,I SKP * * THIS ROUNTINE GETS THE EXTERNAL WORD FOR STATUS * RESET NOP JSB EXEC DEF *+6 READ DEF .1 EXTERNAL DEF LU WORD DEF IBUFF WITHOUT DEF .5 A DEF .2 GATE * AND B204 SZA,RSS CHECK FOR BAD STATUS BITS SZB,RSS OR ZERO XMISSION LOG JMP ERR2 DEVICE ERROR * LDA =B170140 HZPUT OUTPUT CNTL WORD STA OBUFF INTO THE BUFFER LDA IWORD GET WORD AND B7777 MASK LOWER BITS IOR SLOT STICK IN SLOT STA OBUFF+1 SAVE * * OUTPUT STATUS TO TABLE * JSB $LIBR TURN OFF INTERRUPTS NOP STA ADRS,I JSB $LIBX TURN ON INTERRUPT SYSTEM DEF *+1 DEF *+1 * * MAKE THE REFERENCE WORD THE EXTERNAL STATUS AND RETURN * JSB WRITE LDA OBUFF+1 RESTORE LDB PROG,I REGISTERS JMP RESET,I * * WRITE ROUNTINE * WRITE NOP JSB EXEC WRITE DEF *+6 STATUS DEF .2 TO DEF LU EVSNS DEF OBUFF CARD DEF .2 WITH DEF .1 HANDSHAKE * AND B204 CHECK FOR SZA,RSS BAD STATUS BITS SZB,RSS OR ZERO XMISSION LOG JMP ERR2 JMP WRITE,I * * CONSTANTS * M12 DEC -12 .M1 DEC -1 .0 DEC 0 .3 DEC 3 .5 OCT 5 .8 DEC 8 .12 DEC 12 .15 DEC 15 * B204 OCT 204 B2100 OCT 2100 B7777 OCT 7777 UPMSK OCT 177400 BIT15 OCT 100000 ASC0 OCT 30000 * * INPUT BUFFER * IBUFF DEC 2 OCT 170640 SLOT NOP .1 DEC 1 IWORD NOP * * OUTPUT BUFFER * OBUFF OCT 170140 NOP * NAND NOP SKP * * DIGIN * DIGIN CPA .2 IF DIG IN CHAN JMP CLR SKIP NEXT PART * CPA .8 IF NOT COUNTER RSS JMP ERR3 CHANNEL ERROR LDA .M1 GET ADA REL# THE ADA ADR DIGITAL LDA 0,I INPUT CMA,INA CHANNEL JSB TABLE INFO CLR JSB CLEAR * * ENABLE DIGITAL INPUT CARD * LDA =B170240 STA OBUFF LDA SLOT STA OBUFF+1 JSB WRITE * * COMPUTE ADDR * CCA FIND ADA ADR THE TABLE ADA REL# ADDRESS STA ADt;R LDB PROG,I STB PROG JMP UPDAT SKP * * #BIT# PRODUCES A ONE BIT IN THE POSITION SPECIFIED IN "A". * THE RESULTING MASK IS RETURNED IN "A". * RRL RRL 16 SHIFT INSTRUCTION #BIT# NOP ENTRY POINT LDB A IF BIT ADB M12 IF BIT NUMBER SSA,RSS IS NEGATIVE SSB,RSS OR GREATER THAN 11 JMP ERR3 GO TO ERROR # 2 IOR RRL GENERATE STA SHIFT SHIFT INSTRUCTION CLA,INA INITIALIZE WORDS CLB,INB TO BE SHIFTED SHIFT NOP ****THIS WORD IS REPLACED BY SHIFT INSTRUCTION**** JMP #BIT#,I RETURN SKP * * MPNRM TURNS OFF SENSE MODE AND CLEARS BIT PROG TABLE * PTR NOP TABLE POINTER ADR1 NOP ADR2 NOP ADDR OF EV BUFF(PROG NAMES) TOP DEF &6940 #EVNT NOP * MPNRM NOP ISZ MPNRM LDA TOP GET BASE PAGE LINK SSA,RSS AND CHECK FOR INDIRECT JMP *+4 NO,ITS OK ELA,CLE,ERA STRIP INDIRECT BIT LDA A,I GET ADDR JMP *-4 AND TEST AGAIN INA TO UNIT STA PTR ADDRESS * LOOP1 LDB PTR,I GET UNIT ADDRESS SSB IF NEGATIVE ONE JMP MPNRM,I FINISHED, SO RETURN ADB .2 BUMP POINTER LDA 1,I TO STA LU GET LU INB BUMP STB ADR1 AND SAVE POINTER LDA 1,I MAKE # EVSNS CARDS CMA,INA NEGATIVE STA TME AND SAVE CMA,INA MAKE POSITIVE AGAIN MPY .12 MULTIPLY BY 12, LDB ADR1 GET ADDRESS AGAIN ADB .2 BUMP BY TWO TO ADA 1,I ADD # OF DIG IN CMA,INA,SZA,RSS MAKE COUNT NEGATIVE JMP NEXT AND IF ZERO TRY AGAIN STA #EVNT SAVE THE COUNT ISZ ADR1 GET THE EVENT LDA ADR1,I BUFFER SZA,RSS IF ZERO, JMP NO.EV TRY DIG IN INA BUMP THE ADDRESS TO SKIP STA ADR2 THE DEF, AND SAVE IT JSB CLEAR CLEAR SENSE BIT * * * CLEAR BIT/PROG ENTRIES * CCB JSB $LIBR CLEAR INTERRUPT NOP AND FENCES LDA ADR2 NRM1 STB A,I CLEAR ENTRY INA BUMP POINTER ISZ TME DONE? JMP NRM1 NO,CONTINUE CLB NRM2 STB A,I INA ISZ #EVNT JMP NRM2 JSB $LIBX RETURN SYSTEM DEF *+1 TO ORG STATE DEF *+1 * NEXT ISZ PTR BUMP ADR JMP LOOP1 AND CONTINUE * * IF NO EVENT, TRY DIGITAL INPUT * NO.EV LDA ADR1 GET POINTER ADA .2 BUMP POINTER LDA 0,I GET BUFFER ADDR SZA,RSS NO DIG? JMP NEXT TRY NEXT 6940 CLB * JSB $LIBR TURN OFF INTERRUPTS NOP NRM3 STB 0,I INA ISZ #EVNT JMP NRM3 JSB $LIBX DEF *+1 DEF NEXT TRY NEXT * CLEAR SENSE BIT * CLEAR NOP LDA LU IOR B2100 STA CNTL JSB EXEC DEF *+3 DEF .3 DEF CNTL JMP CLEAR,I SKP * * ERRORS * ERR3 ISZ ERR,I ERROR # 3 ERR2 ISZ ERR,I ERROR # 2 JMP EVSNS,I RETURN * * WHAT'S EQUAL TO WHAT * A EQU 0 B EQU 1 OR NOP OUTPUT "OR" WORD AND EQU OBUFF+1 OUTPUT "AND" WORD TME NOP ADRS EQU MPNRM CNTL EQU CHANL .2 DEC 2 END %+ p z 92413-18009 A S 0122 ISA FTN STALL STALL ALARM PROGRAM             H0101 ASMB,R,L,C,B HED STALL PROGRAM 92413-16009 REV A NAM STALL,1,2,1,75 92413-16009A 07MAY75 ENT STALL EXT &6940,EXEC SUP ********************************************* * STALL PROGRAM * * SOURCE: 92413-18009 REV A * RELOC: 92413-16009 REV A * * REVISION A BY STEVE SCOVILL ********************************************* * * * * THE STALL PROGRAM CAN BE INITATED WITH THE * * *ON,STALL,NOW * * OPERATOR REQUEST. AFTER THIS IS DONE, THE STALL PROGRAM * WILL BE AUTOMATICALLY SCHEDULED TO UPDATE THE STALL TIMER * CHANNEL EVERY 750 MILLISECONDS. THE STALL TIMER CHANNEL * IS DEFINED AS THE FIRST TIMER CHANNEL IN THE FIRST CONFIG- * URED 6940. THERE ARE TWO DIFFERENT TIME PERIODS THAT HAVE * TO BE CONSIDERED WHEN USING THE STALL PROGRAM. ONE, THE * TIME BEWTEEN UPDATES, CAN BE MODIFIED WITH THE "IT" OPERATOR * COMMAND. THUS * * *IT,STALL,2,50 * *ON,STALL,NOW * * WOULD CHANGE THE UPDATE PERIOD TO EVERY 50 SECONDS AND RESTART * EXCUTION OF THE STALL PROGRAM. * * THE OTHER TIME PERIOD, THE TIME REQUIRED FOR THE TIMER CARD TO * TIME OUT, CAN BE SET TWO DIFFERENT WAYS. THE FIRST WAY, IS TO * CHANGE THE POSITION OF THE JUMPER W2, THE SECOND WAY IS TO * CHANGE THE ANSWER TO THE "NUMBER OF STALL INCREMENTS?" QUESTION * AT CONFIGURATION TIME. * * NO ERROR MESSAGES ARE GIVEN BY THE STALL PROGRAM. * SKP * * ENTRY * STALL NOP LDB TOP GET BASE PAGE LINK SSB,RSS AND CHECK FOR INDIRECT JMP *+4 NO,ITS THE TRUE ADDR ELB,CLE,ERB STRIP INDIRECT BIT LDB 1,I GET ADDR JMP *-4 AND TEST AGAIN INB TABLE TO POINT TO STB ADR1 FIRST 6940 * * UPDATE THE TIMER FIRST * LDA LU HAVE WE DONE SZA THIS ONCE JMP OUTPT BEFORE? * * GET INFO FOR TIMER CARD * LD  A .M6 INITIALIZE STA COUNT COUNTER * LDB ADR1,I GET ADDR ADB .2 AND MOVE LDA 1,I TO GET STA LU LU * INB MOVE TO GET #EVENT CLA INITIALIZE ACCUM ADA 1,I ACCUMULATE ADB .2 CHANNEL ISZ COUNT COUNT JMP *-3 STA SLOT SAVE THE TIMER CHANNEL * INB * LDA 1,I GET TIMER INFO LDA 0,I SZA,RSS CHECK IF STALL JMP EXIT NOPE! * AND M7777 MASK THE DATA STA OBUFF+1 SAVE FOR LATER * LDA SLOT GET THE SLOT CLB DIV .15 DIVIDE TO FIND UNIT IOR =B170140 STA OBUFF SAVE CNTL WORD BLF,BLF ROTATE BLF B LDA OBUFF+1 TO OBTAIN IOR 1 SLOT AND OR STA OBUFF+1 IN DATA * * OUTPUT TO THE TIMER CARD * OUTPT JSB EXEC OUTPUT DEF *+6 TO DEF .2 6940 DEF LU USING DEF OBUFF WRITE DEF .2 WITH DEF .1 HANDSHAKE * * TERMINATE * EXIT JSB EXEC REST DEF *+2 FOR A DEF .6 WHILE * * CONSTANTS * .M6 DEC -6 .1 DEC 1 .2 DEC 2 .6 DEC 6 .15 DEC 15 M7777 OCT 7777 * LU NOP SLOT NOP COUNT NOP ADR1 NOP TOP DEF &6940 * * OUTPUT BUFFER * OBUFF NOP NOP END STALL [l  qx 92413-18012 1644 S 0122 C2313              H0101 F(SPL,L,O ! ! C2313 - HP2313B AND HP6940A/B CONFIGURATION TABLE GENERATOR ! ! SOURCE TAPE 92413-18012 REV. 1644 ! RELOC. TAPE 92413-16012 REV. 1644 ! ! NAME C2313(7) ! ! ! "C2313" CONSISTS OF TWO SUBROUTINES (C2313 & C6940) WHICH GENERATES ! THE HP2313B AND HP6940A/B HARDWARE CONFIGURATION TABLES ..ADC AND ! &6940 RESPECTIVELY. THIS MODULE IS PART OF THE RTE-B TABLE GENERATOR ! 29102-60030 AND ISA TABLE GENERATOR 92413-16011. ! ! LET C2313,C6940 BE SUBROUTINE,GLOBAL,DIRECT LET CMDIN BE SUBROUTINE, EXTERNAL ! FETCHES NEXT COMMAND LET WSAW BE PSEUDO,EXTERNAL,DIRECT ! WORK SPACE COMMAND LET INWS BE PSEUDO,EXTERNAL,DIRECT LET STPRG BE PSEUDO,EXTERNAL,DIRECT ! RELEASE WORK SPACE LET WSAA BE PSEUDO,EXTERNAL,DIRECT ! WORK SPACE _ ARRAY LET OUTRL BE SUBROUTINE,EXTERNAL ! OUTPUT RELOCATABLES LET GETCH BE FUNCTION,EXTERNAL LET WRITE BE SUBROUTINE,EXTERNAL,DIRECT ! WRITE ROUTINE LET BUFFR BE INTEGER, EXTERNAL ! COMMAND INPUT BUFFER LET RDNM BE INTEGER,FUNCTION,DIRECT LET GCHR, FCHR BE INTEGER,FUNCTION,DIRECT LET CMCNT, CHCNT, CMPTR BE INTEGER,EXTERNAL LET RELSE BE SUBROUTINE,DIRECT ! RELEASES WORK SPACE LET CWSAW BE SUBROUTINE,DIRECT LET WSAW1 BE SUBROUTINE,DIRECT LET .YES. BE SUBROUTINE,DIRECT ! INPUTS YES OR NO RESPONSE LET OCTL BE INTEGER,FUNCTION,DIRECT ! ! "GAINA" IS A TABLE OF THE POSSIBLE GAINS FOR THE LOW LEVEL ! MULTIPLEXER LET GAINA(16) BE INTEGER INITIALIZE GAINA TO "1000", \ "1000" "50",30012K, \ "500" "25",30012K, \ "250" "12",32412K, \ "125" "10",30012K, \ "100" "50",5012K, \ "50" "25",5012K, \ "25" "12.5" \ "12.5" ! ! ALL MESSAGES TO BE PRINTED DEFINED HERE ! LET M1(7),M2(15),Mk3(3),M5(6),M6(7),M7(7),M8(5), \ M10(5),M11(10),M12(27),M13(17),M15(9), \ M20(7),M21(13),M22(17),M23(6),M24(18),M25(8), \ M26(9),M27(9),M28(9),M29(6),M30(7),M31(14), \ M32(17),M33(21) BE INTEGER ! INITIALIZE M1 TO 12,"# OF 2313'S?" INITIALIZE M2 TO 28," SUBSYSTEM #00 CONFIGURATION" INITIALIZE M3 TO 3,"LU?" INITIALIZE M5 TO 10,"# HL - SE?" INITIALIZE M6 TO 11,"# HL - DIF?" INITIALIZE M7 TO 11,"# LL, GAIN?" INITIALIZE M8 TO 7,"# DACS?" INITIALIZE M10 TO 8,"# EVENT?" INITIALIZE M11 TO 17,"# DIGITAL OUTPUT?" INITIALIZE M12 TO 16,"# DIGITAL INPUT?", \ 15,"# VOLTAGE DACS?", \ 15,"# CURRENT DACS?" INITIALIZE M13 TO 31,"HP 6940 SUBSYSTEM CONFIGURATION" INITIALIZE M15 TO 16,"ILLEGAL RESPONSE" INITIALIZE M20 TO 12,"# OF 6940'S?" INITIALIZE M21 TO 24,"# OF CHANNELS IN 2313'S?" INITIALIZE M22 TO 32,"# OF CHANNELS IN 6940 UNIT #00? " INITIALIZE M23 TO 9,"I/O SLOT?" INITIALIZE M24 TO 34,"# DIG INPUT FOR PRESET CNTR W/INT?" INITIALIZE M25 TO 14,"# DIGITAL I/O?" INITIALIZE M26 TO 16,"# DIGITAL INPUT?" INITIALIZE M27 TO 15,"# VOLTAGE DACS?" INITIALIZE M28 TO 15,"# CURRENT DACS?" INITIALIZE M29 TO 9,"# TIMERS?" INITIALIZE M30 TO 11,"# COUNTERS?" INITIALIZE M31 TO 25,"# STALL ALARM INCREMENTS?" INITIALIZE M32 TO 31," ASSOCIATED CHNL FOR CNTR #000?" INITIALIZE M33 TO 40,"ENTER INSTR. CONFG. CONSTANTS" ! LET ENT23 BE INTEGER(9) ! ENTRY POINT RECORD FOR 2313 INITIALIZE ENT23 TO 8,"..AD",41400K,0,"..DA",41400K,0 LET N2313 BE INTEGER(18) ! 2313 NAM RECORD INITIALIZE N2313 TO 17,10400K,20000K,0,"..ADC ", \ 100001K,0,0,6,7(0) LET ENT69 BE INTEGER(5) ! 6940 ENTRY RECORD INITIALIZE ENT69 TO 4,"&694",30000K,0 LET N6940 BE INTEGER(18) ! 6940 NAM RECORD INITIALIZE N6940 TO 17,10400K,20000K,0,"&6940 ", \ 100001K,0,0,6,7(0) ! C2313: SUBROUTINE GLOBAL,DIRECT CALL WRITE(M1) ! WRITE # OF SUBSYS MESSAGE C10: IF [LSUBS_RDNM(64)] = 0 THEN RETURN ! IF NONE RETURN IF FCHR = "-" THEN [CALL WRITE(M15); GOTO C10] NDACS,NCHN,W1,W2,W3,W4_0 WSAW(W1)_1 ! FIRST WORD OF TABLE WSAW(W1)_1 ! IS A DEF *+1 CALL CWSAW(LSUBS) ! 2ND WORD IS NUMBER OF SUBSYSTEMS WSPNT_6 FOR SUBS_1 TO LSUBS DO THRU E2313 ONES_SUBS-10*[TENS_SUBS/10] ! GENERATE AND M2(8)_"00"+ONES+(TENS-<8) ! PRINT SUBSYSTEM CALL WRITE(M2) ! NUMBER MESSAGE WORDS_0 SLOT_2 CALL CWSAW(0) ! CALL WRITE(M3) ! PRINT "LU?" AND C20: LU _ RDNM(64) ! READ IN LOGICAL UNIT NUMBER IF FCHR = "-" OR LU < 7 THEN [CALL WRITE(M15); GOTO C20] CALL CWSAW(LU) ! CALL CWSAW(0) ! RESERVE SPACE FOR LAST CHANL IN SUBSYS. ! CALL WRITE(M5) ! INPUT NUMBER OF HLSE: K1_RDNM(1056) ! HIGH LEVEL SINGLE ENDED CHANNELS IF K1 # 16 THEN [ IF K1 AND 37K THEN [ \ MUST BE 16 OR CALL WRITE(M15) ; \ MULTIPLE OF 32, OTHERWISE GO TO HLSE ]] ! GIVE ERROR AND TRY AGAIN ! CALL CWSAW(K1) ! RECORD NUMBER OF HLSE CHANNELS ! HLCH,NCHN_NCHN+N SLOT_SLOT+(N >- 5) ! CALL WRITE(M6) ! INPUT NUMBER OF HIGH LEVEL HLDF: K1_RDNM(528) ! DIFFERENTIAL INPUT CHANNELS IF K1 # 8 THEN [ IF K1 AND 17K THEN [ \ MUST BE 8 OR CALL WRITE(M15) ;\ A MULTIPLE OF 16 GO TO HLDF ]] ! OTHERWISE GIVE ERROR ! CALL CWSAW(K1) ! RECORD NUMBER HLDF CHANNELS NCHN_NCHN+N ! ! GENERATE LOW LEVEL GAIN ENTRIES ! CALL WRITE(M7) ! PRINT LOW LEVEL MESSAGE RDLL: IF RDNM(528) = 0 THEN GO TO RDLL1 x@! IF LAST ENTRY GO TO END IF GCHR = "-" \ IF GAIN IS NEGATIVE USE SINGLE THEN [ ENTRY_N; \ CHANNEL ENTRIES N_1; \ CALL GCHR ] \ FETCH NEXT CHARACTER ,ELSE ENTRY_1 ! USE ONE MULTIPLE CHAN ENTRY WD1_CHAR -< 8 OR GCHR ! FETCH GAIN ENTRY WD2_GCHR -< 8 OR GCHR ! TO COMPARE WITH TABLE FOR G_1 TO 15 BY 2 DO [ \ SEARCH TABLE IF WD1=GAINA(G) AND WD2=GAINA(G+1) THEN GO TO FGAIN ] CALL WRITE(M15) ! IF GAIN NOT FOUND GIVE ERROR GO TO RDLL ! AND TRY AGAIN ! FGAIN: REPEAT ENTRY TIMES DO [\ CALL CWSAW((G-1 -> 4) OR N); \ RECORD GAIN ENTRY NCHN_NCHN+N ] ! UPDATE SUM OF CHANNELS GO TO RDLL RDLL1: INWS(W1,WSPNT+4)_NCHN ! RECORD LAST CHAN. IN SUBSYS. INWS(W1,WSPNT)_WORDS>-1 ! RECORD TOTAL WORDS IN SUBSYS ENTRY ! ! GENERATE DAC ENTRIES ! LU_(LU AND 77K) -< 10 ! MOVE LU TO UPPER 6 BITS SLOT_SLOT+((NCHN-HLCH)>-4) ! COMPUTE CURRENT SLOT POSITION ! CALL WRITE(M8) ! OUTPUT "# DACS?" MESSAGE C30: DAC _ RDNM(64) ! INPUT RESPONSE AND UPDATE DAC CNTR IF (DAC AND 1K) THEN [WRITE(M15);GOTO C30] IF FCHR = "-" THEN [CALL WRITE(M15); GOTO C30] NDACS _ NDACS + DAC ! FOR N_1 TO DAC>-1 DO [ \ GENERATE ENTRY FOR EACH CARD WSAW(W4)_ LU OR \ LOGICAL UNIT NUMBER IN BITS 10-15 (SLOT+N)/12 -< 7 OR \ BOX NUMBER IN BITS 7-9 $1 -< 3 OR \ SLOT NUMBER IN BITS 3-6 1 ] \ NUMBER OF CHNLS ON CARD -1 IN BITS 0-2 ! E2313: WSPNT_WSPNT+WORDS ! UPDATE WORK SPACE POINTER WSAW(W1)_1 ! PUT DEF *+1 AT BEGINNING ENT23(9)_[WSAW(W1)_(WSPNT>-1)]-1 ! OF DAC TABLE CALL CWSAW(NDACS) ! FOLLOWED BY NUMBER OF DACS ! MOVE DAC TABLE TO END OF ADC TABLE I_0 ALWAYS DO [ \ I_I+1; \ CALL CWSAW(INWS(W4,I)?[GO TO REL]) ] ! ! MOVE NAM AND ENTRY RECORDS INTO A WORK SPACE AND OUTPUT ! THE RELOCATABLE CODE ! REL: WSAA(W2)_@N2313 WSAA(W3)_@ENT23 CALL OUTRL(W2,W3,0,W1) CALL RELSE ! RELEASE WORKING STORAGE RETURN END C2313 ! RDNM: FUNCTION(LIMIT) INTEGER,DIRECT RDCMD: CALL CMDIN(BUFFR,ERR) N _ 0 ! ! FETCH NEXT COMMAND CHARACTER. IF AT EOL, RETURN ! NXCHR: IF [CHAR_GCHR] = 10 OR CHAR =54K \ THEN [IF N > LIMIT \ IF FINAL VALUE GREATER THAN THEN [CALL WRITE(M15); \ LIMIT GIVE ERROR AND GOTO RDCMD] \ TRY AGAIN , ELSE RETURN N] ! ! CONVERT ASCII TO NUMERIC, IF NOT NUMERIC GIVE ERROR ! IF [N1_CHAR-60K]<0 OR N1>9 \ THEN [CALL WRITE(M15); \ IF CHARACTER IS NOT A NUMBER GO TO RDCMD] \ GIVE ERROR AND TRY AGAIN ,ELSE N_N*10+N1 ! UPDATE RUNNING SUM GO TO NXCHR ! GO FETCH NEXT CHARACTER END RDNM ! CWSAW: SUBROUTINE(WORD)DIRECT WSAW(W1)_0 WSAW(W1)_WORD WORDS_WORDS+2 RETURN END CWSAW ! WSAW1: SUBROUTINE(WORD1)DIRECT WSAW(W1)_1 WSAW(W1)_WORD1 WORDS_WORDS+2 RETURN END WSAW1 ! GCHR: FUNCTION DIRECT ! GET NEXT CHARACTER ROUTINE GCHR1:IF GETCH(CHAR)=40K \ THEN GO TO GCHR1 \ ,ELSE RETURN CHAR END GCHR ! FCHR: FUNCTION DIRECT ! FIRST CHARACTER ROUTINE CHCNT _ 0 CMPTR _ CMPTR - CMCNT/2 FCHR1:IF GETCH(CHAR)=40K \ THEN GO TO FCHR1 \ ,ELSE RETURN CHAR END FCHR ! .YES.: SUBROUTINE FEXIT,DIRECT RDYES: CALL CMDIN(BUFFR,ERR) ! INPUT RESPONSE IF BUFFR = "YE" \ THEN RETURN \ ,ELSE [ IF BUFFR = "NO" \ THEN FRETURN ] CALL WRITE(M15) ! ANSWER NOT YES OR NO SO GIVE GO TO RDYES ! ERROR AND TRY AGAIN END .YES. ! OCTL: FUNCTION(LMT)INTEGER,DIRECT READ: N _ RDNM(LMT) IF [BIT64_N/100]>7 THEN [CALL WRITE(M15); GOTO READ] IF [BIT8_(N-(BIT64*100))/10]>7 \ THEN [CALL WRITE>K(M15); GOTO READ] IF [BIT1_N-(BIT64*100)-(BIT8*10)]>7 \ THEN [CALL WRITE(M15); GOTO READ] N_(BIT64*64)+(BIT8*8)+BIT1 RETURN N END OCTL ! RELSE: SUBROUTINE DIRECT CALL STPRG(W1) CALL STPRG(W2) CALL STPRG(W3) CALL STPRG(W4) RETURN END RELSE ! ! ! LET C6940 BE SUBROUTINE,GLOBAL,DIRECT ! ! C6940 PRODUCES THE HP6940 CONFIGURATION TABLE IN RELOCATABLE ! FORMAT. THE FOLLOWING IS AN ASSEMBLY LANGUAGE REPRESENTATION ! OF THE CONFIGURATION TABLE: ! ! NAM &6940,6 ! ENT &6940 ! &6940 DEC -99 - # OF CHAN IN 2313'S ! DEF U1 ! DEF U2 ! DEC -1 ! U1 DEC -30 - # OF CHAN IN U1 ! OCT 14 I O SLOT ! OCT 107 LU + 100B ! DEC 2 # EVENT ! DEF EVBF1 ! DEC 2 # DIG IN FOR CT W INT ! DEF CTI1 ! DEC 14 # I O CARDS ! DEF I/O1 ! DEC 2 # DIG IN ! DEF 0 ! DEC 2 # VOLT DACS ! DEF 0 ! DEC 2 # CURRENT DACS ! DEF 0 ! DEC 2 # OF TIMERS ! DEF TME1 ! DEC 4 # OF CTRS ! DEF CT1 ! TME1 DEC 1000 NUMBER OF TIMER INC,0=NO STALL ! CT1 DEC 125 TIMER FOR FREQ ! DEC 0 NO, REQUIRES UPDATE ! DEC -102 ! DEC -103 D.I. CARD ! I/O1 BSS 14 # OF I O ! EVBF1 DEF *+2 DEF *+# OF EVENT ! BSS 26 BSS THIRTEEN TIMES # EVENT ! CTI1 BSS 2 # OF DI FOR CTR W INT ! ! U2 DEC -30 - # OF CHAN IN U2 ! OCT 12 I O SLOT ! OCT 110 LU + 100B ! DEC 2 # EVENT ! DEF EVBF2 ! DEC 2 # DIG IN FOR CT W INT ! DEF CTI2 ! DEC 14 # I O CARDS ! DEF I/O2 ! DEC 2 # DIG IN ! DEF 0 ! DEC 2 # VOLT DACS ! DEF 0 ! DEC 2 # CURRENT DACS ! DEF 0 ! DEC 2 # OF TIMERS ! DEF 0 ! DEC 4 # OF CTRS ! DEF CT2 ! OCT 0 ! CT2 DEC 155 TIMER FOR FREQ ! DEC 0 NO ! DEC -132 D.I. CARD ! DEC -133 ! I/O2 BSS 14 # OF I O ! EVBF2 DEF *+2 DEF *+# OF EVENT ! BSS 26 BSS THIRTEEN TIMES # EVENT ! CTI2 BSS 2 # OF DI FOR CTR W INT ! ! END ! C6940: SUBROUTINE GLOBAL,DIRECT ! WORDS _ 0 W1,W2,W3,W4 _ 0 CALL WRITE(M20) ! "# OF 6940'S?" C100: IF [LSUBS_RDNM(8)] = 0 THEN RETURN ! IF NONE RETURN IF FCHR = "-" THEN [CALL WRITE(M15); GO TO C100] ! CALL WRITE(M21) ! "# OF CHANNELS IN 2313'S?" C110: CHAN _ RDNM(10000) ! READ IN # OF CHNL IN 2313'S IF FCHR = "-" THEN [CALL WRITE(M15); GOTO C110] CALL CWSAW([CHAN_-CHAN]) ! REPEAT LSUBS TIMES DO [CALL WSAW1(0)] ! RESERVE SPACE FOR UNITS ADDR _ LSUBS + 2 INWS(W1,4) _ ADDR ! DEF U1 CALL CWSAW(-1) ! OCT -1 START _ WORDS ! FOR SUBS_1 TO LSUBS DO THRU E6940 ONES _ SUBS-10*[TENS_SUBS/10] ! GENERATE AND M2(8) _ "00" + ONES + (TENS-<8) ! PRINT SUBSYSTEM CALL WRITE(M2) ! NUMBER MESSAGE ! CALL CWSAW(0) ! RESERVE SPACE FOR -# CHNL'S IN UNIT TCH _ WORDS ! CALL WRITE(M23) ! "I/O SLOT?" C120: IOSLT _ OCTL(256) ! READ IN I/O SLOT IF FCHR = "-" OR IOSLT < 8 THEN [CALL WRITE(M15); GOTO C120] CALL CWSAW(IOSLT) ! CALL WRITE(M3) ! "LU?" C130: LU _ RDNM(64) OR 64 ! READ IN LOGICAL UNIT NUMBER IF FCHR = "-" OR LU < 71 THEN [CALL WRITE(M15); GOTO C130] CALL CWSAW(LU) ! CALL WRITE(M10) ! "# EVENT?" C140: EVNT _ RDNM(15) ! READ IN # OF EVENT SENSE CARDS IF FCHR = "-" THEN [CALL WRITE(M15); GOTO C140] CALL CWSAW(EVNT) ! CALL WSAW1(0) ! RESERVE SPACE FOR PNTR TO EVENT BUFFER EVBF1 _ WORDS ! CALL WRITE(MU_24) ! "# DIGITAL INPUT FOR PRESET COUNTER W INT?" C150: DIGCT _ RDNM(15) ! READ IN # OF DIGITAL INPUT ! CARDS FOR COUNTER W INT. IF FCHR = "-" THEN [CALL WRITE(M15); GOTO C150] CALL CWSAW(DIGCT) ! CALL WSAW1(0) ! RESERVE SPACE FOR PNTR TO CT W INT CTI1 _ WORDS ! CALL WRITE(M25) ! "# OF DIGITAL I/O?" C160: DIGIO _ RDNM(240) ! READ IN # OF DIGITAL I/O CARD IF FCHR = "-" THEN [CALL WRITE(M15); GOTO C160] CALL CWSAW(DIGIO) ! CALL WSAW1(0) ! RESERVE SPACE FOR PNTR TO # OF I O CARDS IO1 _ WORDS ! CALL WRITE(M26) ! "# DIGITAL INPUT?" C170: DIGIN _ RDNM(240) ! READ IN # OF DIGITAL INPUT CARD IF FCHR = "-" THEN [CALL WRITE(M15); GOTO C170] CALL CWSAW(DIGIN) ! CALL CWSAW(0) ! OCT 0 ! CALL WRITE(M27) ! "# VOLTAGE DACS?" C180: VDC _ RDNM(240) ! READ IN # OF VOLTAGE DACS IF FCHR = "-" THEN [CALL WRITE(M15); GOTO C180] CALL CWSAW(VDC) ! CALL CWSAW(0) ! OCT 0 ! CALL WRITE(M28) ! "# CURRENT DACS?" C190: CDAC _ RDNM(240) ! READ IN # OF CURRENT DACS IF FCHR = "-" THEN [CALL WRITE(M15); GOTO C190] CALL CWSAW(CDAC) ! CALL CWSAW(0) ! OCT 0 ! CALL WRITE(M29) ! "# TIMERS?" C200: TIME _ RDNM(240) ! READ IN # OF PROG. TIMER CARDS IF FCHR = "-" THEN [CALL WRITE(M15); GOTO C200] CALL CWSAW(TIME) ! ADDR _ WORDS/2 + 3 IF SUBS = 1 THEN CALL WSAW1(ADDR) ! DEF *+3 IF SUBS > 1 THEN CALL CWSAW(0) ! OCT 0 ! CALL WRITE(M30) ! "# COUNTERS?" C210: COUNT _ RDNM(240) ! READ IN # OF PULSE COUNT CARDS IF FCHR = "-" THEN [CALL WRITE(M15); GOTO C210] CALL CWSAW(COUNT) ! TCHNL_EVNT+DIGCT+DIGIO+DIGIN+VDC+CDAC+TIME+COUNT INWS(W1,TCH) _ -TCHNL ! INSERT -# OF CHNL'S IN UNIT ! ADDR _ WORDS/2 + 2 CALL WSAW1(ADDR) ! DEF *+2 ! 7 r  92413-18013 A S 0122 ISA FTN TBL GEN RTETG MAIN PROGRAM             H0101 SPL,L,O,T NAME RTETG(3,90) ! ! ! ! ! RTETG --------- CORE VERSION ! ! ! RTETG IS AN INTERACTIVE TABLE CONFIGURATOR FOR RTE ! ! SOURCE TAPE - 92413-18013 REV. A ! RELOC. TAPE - 92413-16013 REV. A ! ! VERSION - JANUARY 1974 - T.A. SAPONAS ! VERSION - APRIL 1975 - T.A. LEUTHNER ! ! !*************************************************************** ! ! INITIALIZATION PHASE ! !*************************************************************** ! LET RBILU,CMDLU,CMCNT BE INTEGER,EXTERNAL LET SPACE BE INTEGER(2) INITIALIZE SPACE TO 1," " LET BUFFR(60),OUTLU BE INTEGER,GLOBAL LET C2313,C6940,CONST BE SUBROUTINE,EXTERNAL,DIRECT LET WSAA BE PSEUDO,EXTERNAL,DIRECT LET STPRG BE SUBROUTINE,EXTERNAL,DIRECT LET CMDIN BE SUBROUTINE,EXTERNAL LET NAM,EXTB,ENTM,ENTB,DBLM,DBLB BE INTEGER,GLOBAL LET HEADR BE INTEGER(18) INITIALIZE HEADR TO 33,"* 2313 AND 6940 TABLE GENERATOR *" LET PUNMS BE INTEGER(10) INITIALIZE PUNMS TO 17,"* TURN ON PUNCH *" LET TEARM BE INTEGER(16) INITIALIZE TEARM TO 29,"* TABLE GENERATION COMPLETE *" LET SYSIN,SYSPR,SYSPU,SYSOP BE INTEGER(4) INITIALIZE SYSIN,SYSPR,SYSPU,SYSOP TO 5,"SYSIN ",5,"SYSPR ",\ 5,"SYSPU ",5,"SYSOP" LET FWRIT,FOPEN,FPAUS BE SUBROUTINE,EXTERNAL LET WRITE,LEADR,READ BE SUBROUTINE,DIRECT ! ! ! ! ! RTETG:CALL FOPEN(RBILU,ERR,SYSIN,300K) CALL FOPEN(OUTLU,ERR,SYSPU,100K) CALL FOPEN(CMDLU,ERR,SYSOP,400K) ! FRLST,NAM,EXTB,ENTM,ENTB,DBLM,DBLB_0 ! ! ! CALL WRITE(HEADR) !HEADER MESSAGE ! CALL WRITE(PUNMS) !TURN ON PUNCH MESSAGE ! ! ! ! THIS MODULE INITIALIZES WORKSPACE IN MEMORY ! LET FRLST BE INTEGER,GLOBAL ! FREE WORKSPACE LIST POINTER LET FIRST BE INTEGER,GLOBAL ! SMALLEST ADDRESS NOT USED LET LAST BE INTEGER,GLOBAL ! LARGEST ADDRESS NOT USED LET WKTOP BE INTEGER,GLOBAL ! LARGEST USABLE    ADDRESS=7MOD8 LET WKMIN BE INTEGER,GLOBAL ! SMALLEST ADDRESS EVER ALLOCATED ! ! LAST,WKTOP,WKMIN_26677K FIRST_LAST-5000K !WORK SPACE SET TO 5000K WORDS ! ! CALL FWRIT(OUTLU,ERR,0,-1) !WRITE LEADER CALL LEADR !WRITE LEADER ! ! CALL C2313 !GENERATE 2313 TABLES CALL C6940 !GENERATE 6949 TABLES CALL CONST !GENERATE CONFIG CONSTANTS ! ! CALL LEADR !WRITE TRAILER ! CALL WRITE(TEARM) !TEAR OFF TAPE MESSAGE CALL FPAUS GO TO RTETG ! GO BACK TO BEGINNING ! ! !WRITE A MESSAGE ROUTINE ! WRITE:SUBROUTINE(BUF)DIRECT,GLOBAL CALL FWRIT(CMDLU,ERR,SPACE) CALL FWRIT(CMDLU,ERR,BUF) RETURN END ! !INPUT COMMAND ! READ: SUBROUTINE FEXIT,DIRECT,GLOBAL STPRG(NAM) CALL CMDIN(BUFFR(2),ERR) BUFFR(1)_(CMCNT+1)/2 !WORD COUNT IF BUFFR(2)="/E" THEN FRETURN WSAA(NAM)_@BUFFR RETURN END READ ! ! WRITE OUT LEADER ! LEADR:SUBROUTINE DIRECT CALL FWRIT(OUTLU,ERR,0,-1) RETURN END END RTETG END$   sz 92413-18015 1615 S 0122 ISAGN MAIN              H0101 ˯SPL,L,O,T,M NAME ISAGN(3,90) !92413-16015A 760329 ! ! ! SOURCE: 92413-18015 REV A ! RELOC: 92413-16015 REV A ! ! ! ISAGN --------- DISK VERSION-DISTRIBUTED SYSTEMS ! ! ! ISAGN IS AN INTERACTIVE TABLE CONFIGURATOR FOR ISA ! ! !*************************************************************** ! ! INITIALIZATION PHASE ! !*************************************************************** ! LET SWAP BE SUBROUTINE,EXTERNAL,DIRECT LET NAM BE INTEGER,GLOBAL !POINTER TO NAME STRING LET EXEC,XOPEN,XCLOS,WRITF BE SUBROUTINE,EXTERNAL LET WSAA BE PSEUDO,DIRECT LET CMCNT BE INTEGER,EXTERNAL LET %PRS2,%PRS5 BE INTEGER,EXTERNAL LET %PR31,%PR41 BE INTEGER,EXTERNAL LET OUTLU,IDPTR BE INTEGER,GLOBAL LET RMPAR,XCRET BE SUBROUTINE,EXTERNAL LET PR1NT,PRT1,GT0UT,CLSF1,F1LCK BE SUBROUTINE,DIRECT,EXTERNAL LET A1DCB,A3DCB,A2DCB BE INTEGER(144),EXTERNAL LET %CLU BE INTEGER(5),EXTERNAL LET BUFFR BE INTEGER(60),GLOBAL !GENERAL BUFFER LET INTMS BE INTEGER(16) INITIALIZE INTMS TO 30," INSTRUMENT TABLE FILE NAME ?" LET ENDBM BE INTEGER(12) INITIALIZE ENDBM TO 21,"* END ISA TABLE GEN *" LET CMDIN BE SUBROUTINE,EXTERNAL LET STPRG BE SUBROUTINE,DIRECT LET READ,WRITE BE SUBROUTINE,DIRECT,GLOBAL LET OUTRL,C2313,C6940,CONST BE SUBROUTINE,EXTERNAL LET INITL,READR,CHNGE BE SUBROUTINE,EXTERNAL,DIRECT LET RELSE BE SUBROUTINE,DIRECT LET WKTOP,WKMIN,OLDWS,LAST,FIRST,FRLST BE INTEGER,GLOBAL LET ASCBF(6) BE INTEGER LET OLDCS BE INTEGER LET LOUT BE SUBROUTINE,EXTERNAL,DIRECT LET %NLU BE INTEGER,EXTERNAL LET ERR1 BE INTEGER(14) INITIALIZE ERR1 TO 26,"STRING UTILITY USAGE ERROR" LET EMES BE INTEGER(16) INITIALIZE EMES TO 30," ISAGN: ALL SEGMENTS NOT FOUND" LET ENDMS BE INTEGER(7) INITIALIZE ENDMS TO 11," $END,ISAGN" LET GETWK,DI\ AG,STPRG BE SUBROUTINE,DIRECT LET CSAC,INCS BE PSEUDO,DIRECT LET PUTWK BE SUBROUTINE,DIRECT LET ISA01 BE INTEGER(3) INITIALIZE ISA01 TO "ISA01" LET ISA02 BE INTEGER(3) INITIALIZE ISA02 TO "ISA02" LET ISA03 BE INTEGER(3) INITIALIZE ISA03 TO "ISA03" LET ISA04 BE INTEGER(3) INITIALIZE ISA04 TO "ISA04" LET ISA05 BE INTEGER(3) INITIALIZE ISA05 TO "ISA05" ! ! ! ! ISAGN:CALL RMPAR(%CLU) ! INIT1:IFNOT %CLU(1) THEN %CLU(1)_1 IFNOT %CLU(2) THEN %CLU(2)_20040K IFNOT %CLU(3) THEN %CLU(3)_20040K %PR41_%CLU(5) !CARTRIDGE %PR31_%CLU(4) !SECURITY CODE IF (%CLU(1) AND 7400K) THEN %PRS2_2,ELSE %PRS2_1 %PRS5_400K CALL XOPEN(A3DCB,%PRS5) CALL F1LCK?[CALL GT0UT] KEYWD_$1657K WHILE [IDPTR_$KEYWD] DO THRU FRSPC IF($(IDPTR+12)#ISA05(1)) THEN GOTO FRSPC IF($(IDPTR+13)#ISA05(2)) THEN GOTO FRSPC IF(($(IDPTR+14) AND 177400K)#ISA05(3)) THEN GOTO FRSPC GOTO SEG1 FRSPC:KEYWD_KEYWD+1 .B._@EMES+1 .A._EMES(1) CALL PRT1 CALL GT0UT !STOP BAD LOAD SEG1: .A._@ISA01 CALL SWAP CALL INITL ! !************************************************************* ! ! GENERATE THE INSTRUMENT TABLES FOR 2313,6940,&USER DEFINED ! !************************************************************ ! ! ! .A._@ISA03 CALL SWAP CALL C2313(NAMM,ENTM,EXTM,DBLM) IF NAMM=0 THEN GOTO SEG4 .A._@ISA02 CALL SWAP CALL OUTRL(ENTM,EXTM,0,NAMM) CALL RELSE SEG4: .A._@ISA04 CALL SWAP CALL C6940(NAMM,ENTM,EXTM,DBLM) IF NAMM=0 THEN GOTO SEG5 .A._@ISA02 CALL SWAP CALL OUTRL(ENTM,EXTM,0,NAMM) CALL RELSE SEG5: .A._@ISA05 CALL SWAP CALL CONST(NAMM,ENTM,EXTM,DBLM) .A._@ISA02 CALL SWAP CALL OUTRL(NAMM,ENTM,EXTM,DBLM) CALL RELSE ! M ! TBL02:CALL WRITE(ENDBM) !END OF GEN MESSAGE %CLU(1)_%NLU %PRS2_0 CALL XCLOS(A3DCB) CALL XOPEN(A3DCB,400K) CALL F1LCK?[GOTO DONE] CALL WRITE(ENDMS) DONE: CALL WRITF(A1DCB,IERR,0,-1) CALL F1LCK?[CALL GT0UT] CALL WRITF(A2DCB,IERR,0,-1) CALL F1LCK?[CALL GT0UT] CALL CLSF1 CALL XCLOS(A2DCB) CALL XCLOS(A3DCB) CALL EXEC(6) !TERMINATE PROGRAM ! !INPUT COMMAND ! READ: SUBROUTINE FEXIT,DIRECT STPRG(NAM) CALL CMDIN(BUFFR(2),ERR) CALL F1LCK?[CALL GT0UT] BUFFR(1)_(CMCNT+1)/2 !WORD COUNT IF BUFFR(2)="/E" THEN FRETURN WSAA(NAM)_@BUFFR RETURN END ! ! ! ! !WRITE A MESSAGE ROUTINE ! WRITE:SUBROUTINE(BUF)DIRECT,GLOBAL .B._@BUF+1 .A._BUF CALL PR1NT CALL F1LCK?[CALL GT0UT] RETURN END ! ! ! ! ! SUBROUTINE TO RELEASE BLOCKS OF WORK SPACE ! BLOCK ADDRESSES ARED DEIFNED IN NAMM,ENTM,EXTM,DBLM ! RELSE:SUBROUTINE DIRECT CALL STPRG(NAMM) CALL STPRG(ENTM) CALL STPRG(EXTM) CALL STPRG(DBLM) RETURN END ! ! WSAW: PSEUDO(WSPTR) GLOBAL,DIRECT IFNOT WSAWF THEN DIAG(ERR1) IFNOT WSPTR THEN[GETWK(OLDXW);WSPTR,OLDWS_OLDXW;\ $OLDWS_WSAWV;X_1;GOTO WSAW5] IF OLDWS=OLDCS THEN OLDWS_0 IF WSPTR=OLDWS THEN[Y_OLDXW AND 77770K;Z_OLDXW AND 7K;GOTO WSAW3] OLDWS,Y_WSPTR WHILE[Z_$(Y+7)]DO Y_Z UNTIL $([OLDXW_Y+Z])=100000K DO Z_Z+1 WSAW3:$OLDXW_WSAWV IF Z#6 THEN[X_1;GOTO WSAW7] GETWK(OLDXW) $(Y+7)_OLDXW X_0 WSAW5:$(OLDXW+7)_0 WSAW7:$([OLDXW_OLDXW+X])_100000K RETURN END ! ! WORD STRING APPEND ARRAY ! ! CALLING SEQ: WSAA(WST)_ ARRAY ADDRESS ! WSAA: PSEUDO(WST)GLOBAL,DIRECT IFNOT WSAAF THEN DIAG(ERR1) ARCNT_$WSAAV !WORD COUNT IF ARCNT<0 THEN[ARCNT_(ARCNT+1)/2] FOR I_1 TO ARCNT DO[WSAW(WST)_$(WSAAV+I)]  RETURN END ! ! ! INWS: PSEUDO (WSPT,INDX) GLOBAL,FEXIT,DIRECT IFNOT WSPT THEN GOTO INWS9 IF WSPT=WSPT2 THEN[IF INDX=INDX2+1 THEN \ [Z,Y_1;T_TW+1;\ IF(TW AND 7)=6 THEN T_$T;\ GOTO INWS3]] X_WSPT Y_INDX INWS1:IFNOT X THEN GOTO INWS9 IF Y > 7 THEN [Y_Y-7; X_$(X+7); GOTO INWS1],\ ELSE [Y_Y-1; Z_0] INWS2:T_X+Z INWS3:IF $T=100000K THEN GOTO INWS9 IF Z # Y THEN [Z_Z+1; GOTO INWS2] IF INWSF THEN $T_INWSV,\ ELSE INWSV_$T TW_T INDX2_INDX WSPT2_WSPT RETURN INWS9:IF INWSF THEN DIAG(ERR1) ,ELSE INWSV_0 FRETURN END ! ! ! ! ! ! ! ! ! STPRG RETURNS BLOCKS OF 8 WORDS,EITHER STRINGS OR STACKS, TO ! THE FREE WORKSPACE AREA,ZEROING ITS ARGUMENT ON RETURN. ! THE LAST BLOCK IN EITHER IS FOUND BY CHAINING THRU THE BLOCKS, ! UNTIL EITHER THE LAST WORD IN A BLOCK IS ZERO (STACKS &CHAR. ! STRINGS) OR THE LAST WORD POINTS INTO THE BLOCK ITSELF (WORD STRING). ! STPRG:SUBROUTINE (STRPT) GLOBAL,DIRECT IF STRPT=OLDCS THEN OLDCS_0 IF STRPT=OLDWS THEN OLDWS_0 WHILE STRPT DO [STRPT_$([X_STRPT] OR 7);PUTWK(X)] RETURN END ! ! ! ! ! GETWK:SUBROUTINE(GPTR)DIRECT IF FRLST THEN [GPTR_FRLST;FRLST_$GPTR;GOTO GET9] IFNOT (LAST-FIRST)>6 THEN DIAG(ERR1) GPTR_LAST-7 LAST_GPTR-1 GET9: $(GPTR OR 7)_0 RETURN END ! PUTWK:SUBROUTINE(PPTR)DIRECT IFNOT PPTR THEN RETURN DO[I,K_@FRLST;L_0;M_PPTR AND 77770K] PUT1: I_$[J_I] IF J-I=8 THEN GOTO PUT3 IF I THEN GOTO PUT4 IF J-M#8 THEN GOTO PUT4 PUT3: IFNOT L THEN L_J GOTO PUT2 PUT4: K_J L_0 PUT2: IF I=>M THEN GOTO PUT1 DO[$J_M;$M_I] IF M=(LAST+1)THEN[$K_0;IF L THEN[IF L#@FRLST THEN LAST_L-1];\ LAST_LAST+8] RETURN END ! x! ! ! ! ! ! DIAGNOSTIC PR1NTER ! ! DIAG: SUBROUTINE(ERRS)GLOBAL,DIRECT CALL WRITE(ERRS) CALL GT0UT !ABORT! RETURN END ! ! CSAC: PSEUDO (CSPTR) GLOBAL,DIRECT IFNOT CSACF THEN DIAG(ERR1) IFNOT[Y_CSPTR]THEN[GETWK(OLDXC);$([CSPTR,OLDCS_OLDXC]+7)_0;\ GOTO CSAC9] IF OLDCS=OLDWS THEN OLDCS_0 IF CSPTR=OLDCS THEN[Y_OLDXC AND 77770K;Z_OLDXC AND 7K;\ IF LRFLG=200K THEN GOTO CSAC5,ELSE GOTO CSAC9] OLDCS_CSPTR WHILE $[OLDXC_Y+7] DO Y_$OLDXC Z_-1 CSAC1:IF($[OLDXC_Y+[Z_Z+1]]AND 177400K)=100000K THEN GOTO CSAC9 IF($OLDXC AND 377K)#200K THEN GOTO CSAC1 CSAC5:$OLDXC_($OLDXC AND 177400K)OR(CSACV AND 377K) IF Z=6 THEN[GETWK(OLDXC);$(Y+7)_OLDXC;$(OLDXC+7)_0],\ ELSE OLDXC_OLDXC+1 $OLDXC,LRFLG_100000K RETURN CSAC9:LRFLG_200K $OLDXC_LRFLG OR((CSACV AND 377K)-<8) RETURN END ! ! INCS: PSEUDO (CSPT,INX) GLOBAL,FEXIT,DIRECT IFNOT CSPT THEN GOTO INCS9 IF CSPT=CSPT2 THEN[IF INX=INX2+1 THEN GOTO INC10] X_CSPT Y_(INX+1)>-1 INCS1:IFNOT X THEN GOTO INCS9 IF Y>7 THEN [Y_Y-7; X_$(X+7); GOTO INCS1],\ ELSE [Y_Y-1; Z_0] INCS2:T_X+Z INCS7:IF($T AND 177400K)=100000K THEN GOTO INCS9 IF($T AND 377K)=200K THEN[IF Z#Y THEN GOTO INCS9,\ ELSE[IF INX AND 1 THEN GOTO INCS3,\ ELSE GOTO INCS9 ]] IF Z # Y THEN [Z_Z+1; GOTO INCS2] INCS3:IF INX AND 1 THEN GOTO INCS5 IF INCSF THEN $T_$T AND 177400K OR INCSV AND 377K,\ ELSE INCSV_$T AND 377K GOTO INCS6 INCS5:IF INCSF THEN $T_((INCSV AND 377K)-<8)OR $T AND 377K,\ ELSE INCSV_($T -> 8)AND 377K INCS6:TC_T CSPT2_CSPT INX2_INX RETURN INCS9:IF INCSF THEN DIAG(ERR1) ,ELSE INCSV_0 FRETURN INC10:Y,Z_1 IF INX AND 1 THEN[T_TC+1;IF(T AND 7)=7 THEN T_$T],\ ELSE ځ$"T_TC GOTO INCS7 END ! END ISAGN END$ $ t  92413-18016 1644 S 0122 ISAU1              H0101 \mASMB,R HED ISAU1 UTILITIES TO DO FILE CALLS NAM ISAU1,7 92413-16016A REV.1644 SPC 1 ************************************************* * * * SOURCE 92413-18016 REV.1644 * RELOC 92413-16016 REV.1644 * * * BASICALLY, THIS IS A VERSION OF LARRY POMATTO'S NSW003 LIBRARY * WITH A FEW MODIFICATIONS. * ************************************************** SPC 3 * * DEFINE ENTRY POINTS * ENT A1DCB ENT GT0UT ENT PR1NT,PRT1 ENT %CLU,A2DCB ENT F1LCK,PR0MT ENT XOPEN,XCRET ENT %PRSB,%PRSA,XCLOS,%NLU ENT %PRS1,%PRS2,%PRS3,%PRS4,%PRS5 ENT %PR21,%PR31,%PR41,%PR51,A3DCB ENT XSTK,P.TR.,XPUSH,N0PRT ENT A3DB3 ENT CLSF1 SPC 2 * * DEFINE EXTERNALS * EXT WRITF,EXEC,CLOSE EXT CREAT,OPEN,READF,CNUMD EXT .ENTR EXT PARSE,IFBRK SPC 2 * * DEFINE A AND B REG * A EQU 0 B EQU 1 SUP SKP * N0PRT NOP %NLU NOP UP377 OCT 177400 * * SUBROUTINE TO CLOSE AND PURGE ALL FILES * CURRENTLY OPEN TO PROGRAM INCASE OF ERROR * JSB JSB GT0UT * * NOTE: * I AM CHEATING...GEORGE HAS INDICATED THAT IT * IS POSSIBLE TO PURGE A FILE IF ALL I HAVE IS * A DCB. THE WAY THIS IS DONE IS AS FOLLOWS * SET EXTENT POINTER TO 0...MAIN...GET RID OF SEMENTS * GET THE # OF SECTORS IN FILE AND DIVIDE BY 2 * TO GIVE YOU THE # OF BLOCKS. * DO A CLOSE AND TRUNCATE ALL BLOCKS, WHICH MAKES * THE FILE MANAGER ROUTINES DO EFFECTLY A PURGE. * THUS WE HAVE DONE A PURGE WITHOUT THE NAME * THIS IS DEPENDENT ON DCB MEANING...IF IT CHANGES * BYE.... * * GT0UT NOP LDA D14 GO PR1NT ABORT LDB DFABM MESSAGE TO THE JSB LOUT OUTPUT LIST FILE LDA A1DCB+9 SEE IF FILE OPEN CPA 1717B THATS OUR ID SEGMENT ADDRESS RSS YES JMP GTOT1 NO CL=[A CLEAR OUT EXTENTS LDB A1DCB+2 SEE IF TYPE 0 SZB,RSS JMP CLSAB IT IS, DON'T PURGE FILE STA A1DCB+15 LDA A1DCB+5 GET # OF SECTORS CLE,ERA CONVERT TO BLOCKS CLSAB STA BLKS AND SAVE IT JSB XCLOS PURGE THE FILE!!! DEF *+4 DEF A1DCB DEF FERR DEF BLKS GTOT1 JSB XCLOS CLOSE LIST FILE DEF *+3 DEF A2DCB DEF ZERO JSB XCLOS CLOSE INPUT FILE DEF *+3 DEF A3DCB DEF FERR * * AT THIS POINT ALL FILES ARE CLOSED OR PURGED * TELL WORLD WE ARE DONE * JSB EXEC DEF *+3 DEF B6 DEF ZERO DEF B3 * B1 OCT 1 B2 OCT 2 B6 OCT 6 M1 DEC -1 BLKS NOP DFABM DEF *+1 ASC 7,ISAGN ABORTED SKP * * SUBROUTINE TO WRITE ON INTERACTIVE DEVICE * AND LIST FILE * CALLING SEQUENCE * JSB PR1NT * A REG= SIO LENGTH WORD * B REG= ADDRESS OF MESSAGE * PR1NT NOP DST ABREG SAVE A AND B REG FOR LOUT JSB BYTCN CONVERT SIO TO USUAL INB SKIP OVER LEADING SPACE ADA M1 CUT COUNT NOT INCLUDE SPACE STA PRNTA SAVE LENGTH STB PRNTB SAVE ADDRESS LDA N0PRT DO WE PR1NT THIS MESSAGE? SZA JMP PRNT1 NO JSB WRITF OUTPUT MESSAGE DEF *+5 DEF A3DCB TO THE INPUT DEVICE DEF FERR PRNTB NOP DEF PRNTA LENGTH LDA FERR STA PRNTB * PRNT1 DLD ABREG GET LENGTH AGAIN JSB JSB LOUT WRITE TO FILE LDA PRNTB SZA STA FERR JMP PR1NT,I AND RETURN SPC 1 PRNTA NOP ABREG BSS 2 PRT1 NOP STA TEMP CLA STA JSB LDA TEMP JSB PR1NT LDA .JSB STA JSB JMP PRT1,I * .JSB JSB LOUT TEMP NOP SKP SPC 3 * * SUBROUTINE TO CONVERT SIO LENGTH TO POSITIVE WORDS * CALLING SEQUENCE * a JSB BYTCN * B REG UNCHANGED * BYTCN NOP STA BYTCA SAVE LENGTH FOR CHECKING LATTER SSA WORDS OR CHARACTERS? JMP *+3 WORDS CMA,INA CONVERT CHAR TO WORDS ARS DIVIDE BY 2+1 STA BYTCC SAVE IN DOWN COUNTER LDA LSBFA GET ADDRESS WHERE TO PUT OUTPUT STA BYTCD SAVE FOR MOVE BYTC1 LDA B,I MOVE MESSAGE STA BYTCD,I ISZ BYTCD INB ISZ BYTCC DONE? JMP BYTC1 NO LDB BYTCA WORDS OR CHARACTERS? SSB JMP BYTC2 WORDS CLE,ERB CONVERT CHARACTERS TO WORDS SEZ,RSS ODD # OF CHAR? JMP BYTC3 NO STB BYTCC YES...SAVE COUNT FOR LATTER ISZ BYTCC INCLUDE ODD CHAR ADB LSBFA GET TO END LDA B,I AND UP377 MASK OFF LOWER HALF IOR B40 OR IN A SPACE STA B,I SAVE IT LDB BYTCC GET LENGTH AGAIN BYTC3 RSS SKIP OVER COMPLEMENTING BYTC2 CMB,INB CHANGE NEG WORDS TO + WORDS LDA B GET LENGTH IN A REG LDB OTBFA GET ADDRESS OF BUFFER...INCLUDING SPACE INA INCLUDE SPACE IN COUNT JMP BYTCN,I AND RETURN SPC 1 BYTCA NOP BYTCC NOP BYTCD NOP OTBFA DEF OTBUF LSBFA DEF OTBUF+1 B40 OCT 40 SKP * * SBROUTINE TO WRITE ONTO A LIST FILE * CALLING SEQUENCE * JSB LOUT * AREG = SIO LENGTH * B REG= BUFFER ADDRESS * LOUT NOP JSB BYTCN CONVERT LENGTH STA LOUTA STB LSBF SAVE BUFFER ADDRESS FOR OUTPUTING JSB WRITF WRITE THE RECORD DEF *+5 LDCBA DEF A2DCB DEF FERR LSBF NOP LIST BUFFER ADDRESS HERE DEF LOUTA * * JMP LOUT,I AND RETURN SPC 1 LOUTA NOP SKP * * SUBROUTINE TO OPEN A FILE * CALLING SEQUENCE * JSB XOPEN FILE OPEN * DEF *+3 * DEF DCB ADDRESS * DEF SUBFUNCThION FOR READ OR WRITE IN CASE A TYPE 0 FILE * * ASSUMES THAT %PRS2+1=FILE NAME * %PRS3+1=SECURITY CODE * %PRS4+1=LU * ODCBA NOP SUBF NOP XOPEN NOP JSB .ENTR DEF ODCBA LDA ODCBA GGET DCB ADDRESSPE LDB SUBF,I GET SUBFUNCTION JSB TYP0 CHECK IF TYPE IS 0 JMP XOPEN,I YES EXIT JSB OPEN TRY TO OPEN FILE DEF *+7 DEF ODCBA,I DEF FERR DEF %PRS2+1 NAME DEF ZERO OPEN OPTION DEF %PRS3+1 SECURTIY CODE DEF %PRS4+1 LOGICAL UNIT LDB ODCBA GET DCB ADDRESS CPB INDEF IS IT INPUT FILE ISZ N0PRT SET NON-ZERO(NO PR1NT) JMP XOPEN,I RETURN SKP * * SUBROUTINE TO CREATE A DUMMY TYPE 0 FILE * CALLING SEQUENCE * LDA DCB ADDRESS * LDB SUBFUNCTION * JSB TYP0 * RETURN HERE(P+1) IF IT IS TYPE 0 * RETURN HERE(P+2) IF IT IS NOT TYPE 0 * * TYP0 NOP STA T0DCB LDA %PRS2 CMA,INA,SZA IF NULL OR NUMERIC INA,SZA,RSS THEN OPEN A DUMMY TYPE 0 JMP TYP1 ISZ TYP0 OTHERWISE TAKE NOT JMP TYP0,I TYPE 0 EXIT TYP1 LDA %PRS2+1 GET LU SZA,RSS IF NOT DEFINED INA DEFINE AS LU = 1 STA %PRS2+1 CLA JSB SET SET DIRECTORY JSB SET ADDRESS TO ZERO JSB SET ALSO SET TYPE TO 0 LDA %PRS2+1 GET LOGICAL UNIT IOR B MERGE IN SUBFUNCTION JSB SET AND SET IN DCB JSB EXEC GET DRIVER TYPE DEF *+4 DEF D13 DEF %PRS2+1 DEF EQT5 LDA EQT5 GET TYPE ALF,ALF ROTATE TO LOW A AND B77 AND MASK STA EQT5 SAVE LDB B100 GET EOF CONTROL SUBFUNCTION ADA MD17 IF TYPE > 16 SSA,RSS JMP SEOF SET EOF CODE LDB B1000 LDA EQT5 CPA D5 DVR05?? CLA YES, SET^ STA EQT5 TO TYPE 0 DEVICE! CPA B2 IS DRIVER A PUNCH JMP SEOF GO SET LEADER GENERATION CLB SZA,RSS IF TYPE=0 DON'T DO PAGE EJECT JMP SEOF LDB B1100 LINE SPACE OPTION SEOF LDA %PRS2+1 GET LU IOR B MERGE EOF CONTROL SUBFUNCTION JSB SET SET IN DCB CLA JSB SET SET NO SPACEING LEGAL LDA B1001 SET READ&WRITE LEGAL JSB SET AND SECURITY CODES AGREE JSB SET AND UPDATE MODEES AGREE LDA 1717B GET MY ID ADDRESS ISZ T0DCB INCREMENT TO WORD 9 JSB SET SET OPEN FLAG LDA T0DCB ADA B3 STA T0DCB SET TO WORD 13 CLA SET IN CORE BUFFER FLAG JSB SET TO ZERO INA JSB SET SET RECORD COUNT LDA EQT5 GET TYPE CODE LDB T0DCB GET DCB ADDRESS ADB MD15 RESET TO WORD 1 CPB INDEF IS IT THE INPUT DEVICE STA N0PRT SAVE TO INDICATE PR1NT / NO PR1NT ADB B4 GET TO CONTROL FUNCTION LOCATION LDB B,I GET CONTROL WORD STB SET SAVE IN TEMP LOCATION JSB EXEC DO A PAGE EJECT DEF *+4 DEF B3 DEF SET TEMP WHERE FUNCTION CODE LOCATED DEF MD17 FORCE A PAGE EJECT CLA SPECIFY TYPE 0 OPEN STA FERR CLEAR ERROR CODE JMP TYP0,I * * SET NOP STA T0DCB,I SET IN DCB ISZ T0DCB INCREMENT TO NEXT WORD JMP SET,I * * INDEF DEF A3DCB T0DCB NOP EQT5 NOP MD17 DEC -17 MD15 DEC -15 B4 OCT 4 B100 OCT 100 B1000 OCT 1000 B1001 OCT 100001 B1100 OCT 1100 SPC 2 D5 DEC 5 D13 DEC 13 B77 OCT 77 B3 OCT 3 B400 OCT 400 SKP * * SUBROUTINE TO CREATE A FILE * CALLING SEQUENCE * JSB XCRET * DEF *+5 * DEF DCB ADDRESS * DEF SIZE * DEF TYPE * DEF SUBFUNCTION FOR READ/WRITE IN CASE A TYPE 0 FILE * * ASSUME{S THAT %PRS2+1=FILE NAME * %PRS3+1=SECURITY CODE * %PRS4+1=LU * SPC 1 CDCBA NOP CSIZ NOP CTYP NOP CSBUF NOP XCRET NOP JSB .ENTR DEF CDCBA JSB XOPEN GO TRY TO OPEN THE FILE DEF *+3 DEF CDCBA,I DEF CSBUF,I SZA,RSS TYPE 0? JMP XCRET,I YES...RETURN JSB CLOSE IF NOT CLOSE FILE IF OPEN DEF *+3 DEF CDCBA,I DEF FERR JSB CREAT TRY CREATING THE FILE DEF *+8 DEF CDCBA,I DEF FERR DEF %PRS2+1 DEF CSIZ,I DEF CTYP,I DEF %PRS3+1 DEF %PRS4+1 JMP XCRET,I SKP * * SUBROUTINE TO CLOSE A FILE * USED TO DETERMINE IF CLOSING A DUMMY TYPE 0 * CALLING SEQUENCE * JSB XCLOS * DEF *+3 * DEF DCB ADDRESS * DEF TRUNCATE OPTION (DEFAULT IS ZERO) * * CLDCB NOP COPTN DEF ZERO XCLOS NOP JSB .ENTR DEF CLDCB LDA CLDCB,I GET DIRECTORY DISC ADDRESS SZA,RSS IF ZERO JMP FCLS1 THEN DUMMY DCB JSB CLOSE ELSE DO STANDARD CLOSE DEF *+4 DEF CLDCB,I DEF FERR DEF COPTN,I FCLS1 LDA DFZER RESET THE OPTION WORD STA COPTN IN CASE NOT SUPPLIED NEXT TIME JMP XCLOS,I * * ZERO OCT 0 * SKP * * SUBROUTINE TO CLOSE THE ABSOLUTE OUTPUT FILE * * CALLING SEQUENCE * JSB CLSF1 * NORMAL RETURN * * THIS ROUTINE WILL DELETE UNUSED FILE AREA * CLSF1 NOP LDA A1DCB+5 GET #SEC MPY A1DCB+15 MULT. BY THE CURRENT EXTENT NO. STA TMP LDA A1DCB+3 TRK CMA,INA ADA A1DCB+10 CTRK - TRK MPY A1DCB+8 (CTRK - TRK) * #SEC/TR LDB A1DCB+4 CMB,INB ADA B (CTRK - TRK) * #S/TR - SEC ADA A1DCB+11 (CTRK - TRK) * #S/TR - SEC + CSEC ADA TMP ADD IN NUMBER OF EXTENTS ARS CONVERT TO NUMBER OF BLOCKS  LDB A1DCB+5 GET NUMBER OF SECS CLE,ERB CONVERT TO BLOCKS CMA,INA SET CURRENT BLOCK NEG ADB A # OF BLKS - CURRENT BLK CCA ADB A ONE MORE FOR GOOD MEASURE STB TMP JSB XCLOS DEF *+3 DEF A1DCB DEF TMP JMP CLSF1,I * TMP NOP SKP * * SUBROUTINE TO PR1NT COMMAND AND ACCEPT * INPUT. * CALLING SEQUENCE * JSB PRMT * DEF *+6 * DEF PR1NT MESSAGE BUFFER * DEF LENGTH (IN SIO FORMAT) * DEF REPLY ADDRESS * DEF LENGTH (IN + # OF CHARACTERS) * DEF PARSE BUFFER * * A REG= + NUMBER OF CHARACTERS * PMEMB NOP PMEML NOP PRADD NOP PRLEN NOP PPARS NOP PR0MT NOP JSB .ENTR DEF PMEMB PRMT1 LDB PMEMB GET BUFFER ADDRESS LDA PMEML,I GET LENGTH JSB PR1NT PR1NT QUESTION * LDA FERR STA AWAY LDA PRLEN,I GET LENGTH INA CONVERT TO WORDS CLE,ERA STA PRMTA SAVE LENGTH CMA,INA CONVERT TO NEGATIVE WORD COUNT STA PRMTB SAVE IN TEMP LDB PRADD GET ADDRESS WHERE TO SPACE FILL LDA C4040 SPACE WORD STA B,I INB ISZ PRMTB DONE? JMP *-3 NO JSB READF GO GET INPUT DEF *+6 DEF A3DCB FROM INPUT DEVICE DEF FERR DEF PRADD,I DEF PRMTA DEF PRMTB * LDA AWAY SZA STA FERR LDA FERR STA AWAY * JSB BRKCK SEE IF WE WANT OUT LDA PRMTB GET LENGTH FOR PR1NT ON FILE SSA,RSS IS IT A END OF FILE JMP PRMT2 NO LDA TR YES GO SIMIULATE A TR STA PRADD,I COMMAND TO POP LDA PRADD THE STACK LDB B2 JMP PRMT3 PRMT2 CLE,ELA CONVERT TO CHARACTERS STA PRMTB LDB PRADD GET INPUT JSB LOUT WRITE IT ONTO OUTPUT FILE * LDA AWAY SZA 49 STA FERR * LDA PRADD,I SEE IF THEY WANT OUT? CPA !! JSB GT0UT YES...GET OUT JSB PARSE DEF *+4 DEF PRADD,I DEF PRMTB DEF PPARS,I LDA PPARS GET FIRST 2 CHARS. INA LDA A,I CPA TR TRANSFER COMMAND? RSS JMP PRMT4 NO - GO EXIT LDA PRADD GET BUFFER ADDRESS LDB PRMTB GET LENGTH PRMT3 JSB TRCHK GO DO TR THING JMP PRMT1 GO RETRY COMMAND PRMT4 LDA PRMTB GET ACTUAL REPLY LENTH JMP PR0MT,I AND RETURN SPC 1 C4040 ASC 1, !! ASC 1,!! TR ASC 1,TR AWAY NOP PRMTA NOP PRMTB NOP SKP * * SUBROUTINE TO DETERMIN IF STACK IS TO * BE XPUSHED OR POPED * * IF XPUSHED, IT CLOSES THE CURRENT FILE, * SAVES RC,AND OPENS NEW FILE * * IF POPED, IT CLOSES THE CURRENT FILE, * OPEN STHE PREVIOUS FILE, AND POSITIONS * IT TO THE PROPER RECORD * SPC 1 TRCHK NOP STB PRMTB SAVE LENGTH STA TRCH1 SET BUFF ADDR. JSB PARSE GO REPARSE DEF *+4 TRCH1 NOP DEF PRMTB DEF %PRSB LDA %PRS2 GET FILE TYPE SZA IF NOT NULL JMP TR3 GO TO XPUSH * TR1 JSB XCLOS CLOSE THE CURRENT FILE DEF *+3 DEF A3DCB DFZER DEF ZERO TR4 JSB POP GO POP STACK SEZ JSB GT0UT ERROR, NO MORE ENTRIES STA RC SAVE RECORD COUNT JSB XOPEN OPEN PREVIOUS FILE DEF *+3 DEF A3DCB DEF B400 JSB F1LCK SEZ JMP TRCHK,I LDA A3DCB+2 GET TYPE SZA,RSS IF TYPE 0 JMP TRCHK,I EXIT LDA RC GET RECORD COUNT CMA,INA SET NEGATIVE AND STA COUNT SAVE TR2 ISZ COUNT ARE WE THERE YET? RSS JMP TRCHK,I YES...GET OUT JSB READF READ A RECORD DEF *+6 DEF A3DCB DEF FERR DEF PRADD,I DEF ZERO DEF RL * JSB F1LCK SEZ JSB GT0UT * LDA RL SSA IF EOF...POP STACK JMP TR1 JMP TR2 GET NEXT RECORD SKP * * PLACE NEW INPUT FILE ON STACK AND XPUSH * TR3 LDA A3DCB+14 GET REC NUMBER OF NEXT RECORD STA RC SAVE AS CURRENT RECORD # JSB XCLOS GO CLOSE THE FILE DEF *+3 DEF A3DCB DEF ZERO LDA RC GET RECORD COUNT JSB XPUSH GO XPUSH STACK SEZ JSB GT0UT ERROR STACK OVERFLOW JSB XOPEN GO OPEN NEW FILE DEF *+3 DEF A3DCB DEF B400 JSB F1LCK ERROR? SEZ JMP TR4 YES, POP STACK JMP TRCHK,I NO, RETURN * * COUNT NOP RC NOP RL NOP SKP * * SUBROUTINE TO XPUSH AND POP A STACK * STACK DEFINITION * WORD 4= RECORD COUNT FOR NEXT RECORD TO READ * WORD 3= 0 ELSE CH5&CH6 * WORD 2= 0 ELSE CH3&CH4 * WORD 1= LU ELSE CH1&CH2 * WORD 0= TYPE...1=TYPE 0, 2=REGULAR * * XPUSH-PLACES FILE NAME AND TYPE ON STACK * LEAVES POINTER AT RECORD COUNT (WORD 4) * ASSUMES %PRS2 CONTAINS INFO NEEDED * CALLING SEQUNCE * LDA RC OF CURRENT FILE * JSB XPUSH * ERROR RETURN STACK OVERFLOW * NORMAL RETURN * SPC 1 XPUSH NOP STA P.TR.,I SAVE CURRENT RECORD COUNT ISZ P.TR. INCREMENT TO BEGINNING OF NEXT ENTRY LDA ENDST GET END OF STACK ADDRESS CPA P.TR. IF = CCE,RSS JMP *+2 JMP XPUSH,I THEN OVERFLOW DLD %PRS2 SAVE TYPE DST P.TR.,I ISZ P.TR. ISZ P.TR. DLD %PRS2+2 STORE CHARS 3-6 DST P.TR.,I ISZ P.TR. ISZ P.TR. CLE SET FOR NORMAL RETURN JMP XPUSH,I AND RETURN SKP * * SUBROUTINE THAT MOVES THE POINTER TO PREVIOUS * STACK ENTRY * PLACES RECORD COUNT IN A REG * LEAVES POINTER AT REC. COUNT * * CALLING SEQUENCE * JSB POP * ERROR RETURN * NORMAL RETURN * A REG=REC. COUNT * SPC 1 POP NOP LDA P.TR. GET CURRENT POINTER ADA MD9 DECREMENT TO PREVIOUS ENTRY LDB XSTK GET STACK ADDRESS CMB,INB ADB A IF CURRENT LESS THAN SSB,RSS START OF STACK JMP POP1 CCE JMP POP,I NO MORE ENTRIES POP1 STA P.TR. SET AS NEW POINTER DLD P.TR.,I GET OLD ENTRY DST %PRS2 ISZ P.TR. INCREMENT TO WORDS 3 AND 4 ISZ P.TR. DLD P.TR.,I DST %PRS2+2 ISZ P.TR. ISZ P.TR. LDA P.TR.,I GET RECORD COUNT CLE GET NORMAL RETURN JMP POP,I AND RETURN SPC 2 XSTK DEF STACK BSS 1 STACK BSS 25 ENDST DEF * P.TR. DEF STACK-1 MD9 DEC -9 SKP * * FILE CHECK ROUTINE * CALLING SEQUENCE * JSB F1LCK * NORMAL RETURN * MUST SEND ERROR PRAM TO FERR * F1LCK NOP LDA FERR SSA,RSS ANY ERRORS? JMP FNOER CMA,INA SET POS FOR CONVERT STA FERR JSB CNUMD GET DEC ERROR CODE DEF *+3 DEF FERR DEF FERMA ERROR MESSAGE ADDRESS LDA FERMA+2 GET LAST TWO CHARACTERS STA FERMA SAVE FOR MESSAGE JSB EXEC SEND ERROR TO USER DEF *+5 DEF B2 DEF B1 DEF FILEA DEF D7 CCE,RSS FNOER CLE GET NORMAL RETURN IF NO ERROR JMP F1LCK,I AND RETURN SPC 2 FILEA ASC 5,FILE ERROR ASC 1, - FERMA ASC 4, FERR NOP D14 DEC 14 D7 DEC 7 SKP * * SUBROUTINE TO CHECK IF WE SHOULD ABORT * CALLING SEQUENCE * JSB BRKCK * NORMAL RETURN * NOTE: * ROUTINE WILL NOT RETURN IF WE WANT OUT * BRKCK NOP JSB IFBRK DEF *+1 SZA,RSS WANT OUT? JMP BRKCK,I NO`B@< JSB GT0UT YES SKP * * CONSTANTS TABLES WHAT NOT * SPC 3 . EQU * %PRS1 BSS 4 .. EQU * %PRS2 BSS 1 %PR21 BSS 3 %PRS3 BSS 1 %PR31 BSS 3 %PRS4 BSS 1 %PR41 BSS 3 %PRS5 BSS 1 %PR51 BSS 3 SPC 1 ORG . %PRSB BSS 34 ORG .. %PRSA BSS 34 SPC 3 SPC 2 * * I-O LU # * %CLU EQU %PRS2+1 SPC 1 * * PR1NT BUFFER * OTBUF ASC 1, BSS 30 SPC 4 * * DEFINE DCB'S * A1DCB BSS 144 A2DCB BSS 144 A3DCB BSS 3 A3DB3 BSS 141 SPC 2 END UB u 92413-18017 1615 S 0122 SIO              H0101 a/ASMB,R,L,C HED HIGH LEVEL I/O INTERFACE* 92413-16017 REV 1615 NAM SIO,7 92413-16017A 760405 REV 1615 * ******************************************************** * * SOURCE: 92413-18017 REV 1615 * RELOC: 92413-16017 REV 1615 * ******************************************************** * * ENTRY POINTS * ENT CMDIN,GETCH,CMCNT,CHCNT,CMPTR * * EXTERNALS * EXT .ENTR,PR0MT,%PRSA SKP CMCNT NOP NUMBER OF CHARS IN BUFFER CHCNT NOP NUMBER OF CHARS READ FROM BUFFER CMPTR NOP POINTER TO NEXT CHAR ******************************************************** * * CMDIN INPUT NEXT COMMAND * * CALLING SEQUENCE * * JSB CMDIN * DEF *+3 * DEF BUFFR * DEF ERROR 0=OK, -3=BAD COMMAND * RETURN POINT * * CMCNT = NUMBER OF CHARS TRANSMITTED ******************************************************* * CMBFA NOP CMERR NOP CMDIN NOP JSB .ENTR DEF CMBFA * CLA RESET POINTERS STA CHCNT STA CMERR,I LDA CMBFA STA CMPTR JSB PR0MT DEF *+6 DEF PRPTA DEF B1 DEF CMBFA,I DEF D72 DEF %PRSA STA CMCNT JMP CMDIN,I * SKP ******************************************************** * * GETCH, GET NEXT CHAR FROM BUFFER * * CALLING SEQUENCE * * JSB GETCH * DEF *+2 * DEF ADDR ADDRESS TO PUT CHAR( 12B IF EOL) * RETURN * ********************************************************* * CHAR NOP GETCH NOP JSB .ENTR DEF CHAR LDB CHCNT CPB CMCNT END OF INPUT?? JMP NOTCH ISZ CHCNT BUMP COUNT LDA CMPTR,I SLB,RSS ALF,ALF AND B177 SLB ISZ CMPTR STA CHAR,I JMP GETCH,I * NOTCH LDA D10 STA CHAR,I JMP GETCH,I PRPTA ASC 1,-- * * D72 DEC 72 B1 OCT 1 D10 DEC 10   B177 OCT 177 END CHAR NOP   v} 92413-18018 1615 S 0122 SWAP              H0101 TmASMB,R,L,C NAM SWAP,7 92413-16018A 760329 ENT SWAP,SWPRT EXT EXEC * SOURCE: 92413-18018 REV A * RELOC: 92413-16018 REV A * * * * * SWAP IS A ROUTINE THAT ALLOWS THE CALLING OF A * SEGMENT AND RETURNING TO THE MAIN IMMEDIATELY * THE SEGMENT CAN THEN BE TRATED LIKE A SUBROUTINE * * CALLING SEQUENCE: * * LDA
* JSB SWAP * * * SWAP NOP STA SEGAD JSB EXEC DEF *+3 DEF D8 SEGAD NOP SWPRT JMP SWAP,I * D8 DEC 8 END  w} 92413-18019 1615 S 0122 ISA01              H0101 \ISPL,L,O,T,M NAME ISA01(5) !92413-16019A 760329 ! ! ! SOURCE: 92413-18019 REV A ! RELOC: 92413-16019 REV A ! ! ! !*************************************************************** ! ! INITIALIZATION PHASE ! !*************************************************************** ! LET INITL BE SUBROUTINE,GLOBAL,DIRECT LET SWPRT BE LABEL,EXTERNAL !SEGMENT RETURNS LET XCRET,FCL0S BE SUBROUTINE,EXTERNAL LET PR1NT,GT0UT,F1LCK BE SUBROUTINE,DIRECT,EXTERNAL LET A2DCB,A1DCB BE INTEGER(144),EXTERNAL LET P.TR.,N0PRT,%NLU,XSTK,A3DB3 BE INTEGER,EXTERNAL LET XPUSH BE SUBROUTINE,DIRECT,EXTERNAL LET %PRSA BE INTEGER(34),EXTERNAL LET IDPTR BE INTEGER,EXTERNAL LET %CLU BE INTEGER(5),EXTERNAL LET LFLMS BE INTEGER(10) INITIALIZE LFLMS TO 18," LIST FILE NAME ?" LET FIRST,LAST,WKTOP,FRLST BE INTEGER,EXTERNAL LET WKMIN BE INTEGER LET BUFFR BE INTEGER(60),EXTERNAL LET WSAA BE PSEUDO,DIRECT,EXTERNAL LET CMCNT BE INTEGER,EXTERNAL LET CMDIN BE SUBROUTINE,EXTERNAL LET STPRG BE SUBROUTINE,DIRECT,EXTERNAL LET READ BE SUBROUTINE,DIRECT LET BEGMS BE INTEGER(12) INITIALIZE BEGMS TO 20," ISA TABLE GENERATOR" LET INTMS BE INTEGER(16) INITIALIZE INTMS TO 30," INSTRUMENT TABLE FILE NAME ?" LET WRITE BE SUBROUTINE,DIRECT ! ! ! ISA01:GOTO SWPRT ! ! INITL:SUBROUTINE GLOBAL,DIRECT ! FRLST_0 ! FRSP1:IF($(IDPTR +14) AND 20K) THEN OFSET_16,\ !SHORT ID SEG? ELSE OFSET_23 FIRST_$(IDPTR+OFSET)+1 !WORKSPACE SET TO MAXIMUM LAST,WKTOP,WKMIN_$1777K P.TR._XSTK-1 .A._0 CALL XPUSH?[CALL GT0UT] %NLU_A3DB3 IF N0PRT THEN %NLU_1 ! CALL WRITE(BEGMS) INIT2:CALL WRITE(LFLMS) CALL READ?[GOTO INIT2] CALL XCRET(A2DCB,64,3,0) CALL F1LCK?[GOTO INIT2] ! INIT3:CALL WRITE(INTMS) CALL F1LCK?[CALL GT0UT] CAcQ  LL READ?[GOTO INIT3] CALL XCRET(A1DCB,200,5,100K) CALL F1LCK?[GOTO INIT3] RETURN END WRITE:SUBROUTINE(BUF) DIRECT .B._@BUF+1 .A._BUF CALL PR1NT RETURN END READ: SUBROUTINE FEXIT,DIRECT STPRG(NAM) CALL CMDIN(BUFFR(2),ERR) BUFFR(1)_(CMCNT+1)/2 !WORD COUNT IF BUFFR(2)="/E" THEN FRETURN WSAA(NAM)_@BUFFR RETURN END END ISA01 END$ Pn  x 92413-18020 1615 S 0122 ISA02              H0101 TJSPL,L,O,T,M NAME ISA02(5) !92413-16020A 760329 ! SOURCE: 92413-18020 REV A ! RELOC: 92413-16020 REV A ! ! ! ! RETURN DIRECTLY TO MAIN ! ! LET SWPRT BE LABEL,EXTERNAL ISA02:GOTO SWPRT ! ! ! SOURCE: 92413-180XX ! RELOC: 92413-160XX ! ! ! OUTRL ! ! OUTRL OUTPUTS THE BRANCH AND MNEMONIC TABLES IN RELOCATABLE ! FORMAT. ! ! CALLING SEQUENCE IS: CALL OUTRL(NAM,ENT,EXT,DBL) ! ! WHERE: NAM,ENT,EXT,DBL ARE THE STRING ADDRESSES FOR ! EACH TABLE ! ! LET OUTRL BE SUBROUTINE,GLOBAL LET INWS,WSAA BE PSEUDO,EXTERNAL,DIRECT LET OUTLU,ENTW2,EXTW2,RBOID BE INTEGER,EXTERNAL LET ENTIN,ENTEA,ENTOU,EXTIN,EXTEA,EXTOU,DBLIN,DBLEA,DBLOU,\ OUTIT BE SUBROUTINE,EXTERNAL,DIRECT LET FREAD,FWRIT BE SUBROUTINE,EXTERNAL LET NEREC BE SUBROUTINE,DIRECT LET BUF BE INTEGER(4) INITIALIZE BUFA TO @BUF LET RBBUF BE INTEGER(20),EXTERNAL LET ENDX BE INTEGER(5) INITIALIZE ENDX TO 4,2000K,120000K,0,0 INITIALIZE END0 TO 0 LET STPRG BE SUBROUTINE,EXTERNAL,DIRECT ! ! OUTRL:SUBROUTINE(NAM,ENT,EXT,DBL)GLOBAL ! ! RBOID_OUTLU !OUTPUT NAME RECORD ! CALL NEREC(NAM) ! !OUTPUT ENTRY RECORD ! CALL ENTIN I_-3 WHILE[I_I+4] DO[FOR J_0 TO 3 DO[BUF(J+1)_INWS(ENT,I+J)?\ [GOTO OUT1]];.B._BUFA;CALL ENTEA] OUT1: .A._ENTW2 CALL ENTOU ! !OUTPUT EXTERN RECORD ! CALL EXTIN I_-2 WHILE[I_I+3] DO[FOR J_0 TO 2 DO[BUF(J+1)_INWS(EXT,I+J)?\ [GOTO OUT2]];.B._BUFA;CALL EXTEA] OUT2: .A._EXTW2 CALL EXTOU ! !OUTPUT DBL RECORD ! .B._0 !RELOCATION ADDRESS .A._1 !RECORD TYPE PROGRAM RELOCATABLE CALL DBLIN I_-1 WHILE[I_I+2] DO[ J _INWS(DBL,I)?[GOTO OUT3];\ BUF(1)_INWS(DBL,I+1);.A._J;.B._BUFA;CALL DBLEA] OUT3: CALL DBLOU ! !OUTPUT END RECORD WSAA(END0)_@ENDX CAm  LL NEREC(END0) STPRG(END0) RETURN END NEREC:SUBROUTINE(STR)DIRECT I_0 WHILE[I_I+1] DO RBBUF(I)_INWS(STR,I)?[GOTO OUT0] OUT0: RBBUF(7)_100001K CALL OUTIT RETURN END END ISA02 END$ gH  y 92413-18021 1615 S 0122 BROUT              H0101 ~nASMB,R,L,C HED * OUTBR * OUTPUT RELOCATABLES * A-29102-60025-1 REV. A NAM BROUT,7 92413-16021A 760329 ******************************************************** * * SOURCE: 92413-18021 REV A * RELOC: 92413-16021 REV A * * ********************************************************** * * ENTRY POINTS: * ENT RBOID ENT RBBFA ENT RBBUF ENT TYREB ENT CKSUM ENT LODAD ENT DBLIN ENT DBLEA ENT DBLOU ENT ENTIN ENT ENTEA ENT ENTOU ENT EXTIN ENT EXTEA ENT EXTOU ENT ENTW2 ENT EXTW2 ENT OUTIT * ******************************************************** * * EXTERNAL REFERENCES: * EXT WRITF EXT A1DCB EXT GT0UT * ******************************************************** * * BEFORE CALLING THE ROUTINES IN THIS PACKAGE, * SET RBOID TO THE ID NBR OF THE OUTPUT DEVICE. * ******************************************************** SKP HED * ENT RECORD OUTPUT ROUTINES * A-29102-60025-1 REV. A ***** * ** ENTIN ** ENT RECORD OUTPUT INITIALIZE ROUTINE * * CALLING SEQUENCE: * * JSB ENTIN * RETURN * ***** * ENTIN NOP LDA RBBFA ADA B3 STA RBPTR POINTER TO NEXT WORD IN BUFFER LDA MD15 ALLOW MAXIMUM 14 PER RECORD STA CNT14 CLA STA CNTEN NUMBER OF ENTRIES LDA B3 STA RBLEN LENGTH OF RECORD JMP ENTIN,I SKP ***** * ** ENTEA ** ADD AN ENTRY TO CURRENT ENT RECORD * * CALLING SEQUENCE * * LDB POINTER TO ENTRY TO PUT IN BUFFER * (WORD 1 = FIRST 2 CHARS OF NAME) * (WORD 2 = SECOND TWO CHARS OF NAME (BLANK FILL)) * (WORD 3 = LAST CHAR AND RELOCATION BASE) * (WORD 4 = RELOCATABLE VALUE OF ENTRY POINT) * JSB ENTEA * RETURN * ***** * ENTEA NOP STB TEMPB ISZ CNT14 BUFFER FULL? JMP ENT01 NO€, ADD ENTRY LDA ENTW2 YES JSB ENTOU MUST FLUSH THE BUFFER JSB ENTIN THEN REINITIALIZE BUFFER ISZ CNT14 BUMP MAX ENTRIES POINTER * ** ADD ENTRY TO BUFFER * ENT01 ISZ CNTEN COUNT ENTRY LDA MB4 STA CNTR MOVE 4 WORDS LDB TEMPB LOOPN LDA 1,I STA RBPTR,I ISZ RBPTR BUMP OUTPUT POINTER INB BUMP INPUT POINTER ISZ RBLEN BUMP WORD COUNT ISZ CNTR ARE ALL WORDS MOVED? JMP LOOPN NO, MOVE NEXT ONE JMP ENTEA,I YES, RETURN SKP ***** * ** ENTOU ** COMPLETE BUFFER AND OUTPUT IT * * CALLING SEQUENCE: * * LDA ENTW2 (WORD 2 MASK FOR ENT) * RECORD IN RBBUF BUFFER * JSB ENTOU * RETURN * * NOTE: THIS ROUTIN IS USED BY BOTH ENT AND EXT RECORD PROCESSORS * ***** * ENTOU NOP IOR CNTEN BUILD WORD TWO OF RECORD STA TYREB AND STORE IT IN RECORD LDA RBLEN ALF,ALF POSITION WORD COUNT STA RBBUF AND STORE IT IN WORD ONE JSB OUTIT OUTPUT BUFFER(COMPUTES OWN CKSUM) JMP ENTOU,I SKP HED *EXT RECORD OUTPUT PROCESSORS* A-29102-60025-1 REV. A ***** * ** EXTIN **INITIALIZE BUFFER FOR EXT RECORD OUTPUT * * CALLING SEQUENCE: * * JSB EXTIN * RETURN * ***** * EXTIN NOP LDA RBBFA ADA B3 STA RBPTR POINTER TO NEXT WORD IN BUFFER LDA MD20 ALLOW MAXIMUM 19 ENTRIES PER RECORD STA CNT19 CLA STA CNTEN NUMBER OF ENTRIES COUNTER LDA B3 STA RBLEN LENGTH OF RECORD JMP EXTIN,I SKP ***** * ** EXTEA ** ADD AN ENTRY TO CURRENT EXT RECORD * * CALLING SEQUENCE: * * LDB POINTER TO ENTRY TO PUT IN BUFFER * (WORD 1 = FIRST 2 CHARS OF NAME) * (WORD 2 = NEXT TWO CHARS (BLANK FILL)) * (WORD 3 = LAST CHAR, EXT ID NUMBER) * JSB EXTEA * RETURN * ***** * EXTEA NOP STAvB TEMPB ISZ CNT19 BUFFER FULL? JMP EXT01 NO, ADD ENTRY LDA EXTW2 YES, JSB EXTOU MUST FLUSH BUFFER JSB EXTIN REINITIALIZE BUFEER ISZ CNT19 BUMP MAX NBR OF ENTRIES COUNTER * ** ADD ENTRY TO BUFFER * EXT01 ISZ CNTEN COUNT ENTRY LDA MB3 STA CNTR MOVE 4 WORDS LDB TEMPB LOOPM LDA 1,I STA RBPTR,I ISZ RBPTR BUMP OUT PUT POINTER INB BUMP INPUT POINTER ISZ RBLEN BUMP WORD COUNT ISZ CNTR ARE ALL WORDS MOVED? JMP LOOPM NO, MOVE NEXT ONE JMP EXTEA,I YES, RETURN SKP ***** * ** EXTOU ** COMPLETE BUFFER AND OUTPUT IT * * CALLING SEQUENCE: * * LDA EXTW2 (WORD 2 MASK FOR EXT) * RECORD IN RBBUF BUFFER * JSB EXTOU * RETURN * * NOTE: THIS ACTUALLY USES THE SAME ROUTINE AS ENTS (ENTOU) * ***** * * EXTOU EQU ENTOU * SKP HED * DBL RECORD OUTPUT ROUTINES * A-29102-60025-1 REV. A ***** * ** DBLIN ** INITIALIZE DBL BUFFER FOR OUTPUT * * CALLING SEQUENCE * * LDA TYPE OF RELOCATION BASE * LDB RELOCATABLE LOAD ADDRESS * JSB DBLIN * RETURN * ***** * DBLIN NOP ALF POSITION RELOCATION BASE RAL,RAL IOR WORD2 INITIALIZE WORD 2 OF RECORD STA TYREB TYPE, RELOCATION BASE, #INSTR WORDS STB LODAD INITIALIZE RELOCATION ADDRESS LDB RBBFA ADB B4 STB PTR5 AND POINTER TO BLOCK WORD INB STB RBPTR AND NEXT WORD BUFFER POINTER LDA B5 STA RBBUF INITIALIZE RECORD LENGTH LDA MB5 STA CNT5 INTIALIZE BLOCK OF 5 COUNTER CLA STA PTR5,I AND THE BLOCK WORD ITSELF JMP DBLIN,I SKP ***** * ** DBLEA ** ROUTINE TO BUILD DBL RECORDS ONE DATUM AT A TIME * * CALLING SEQUENCE: * * LDA RELOCATION INDICATOR(SEE RECORD DESCRIPTION) * LDB x POINTER TO DATUM (DATUM MAY BE TWO WORDS) * JSB DBLEA * RETURN * ***** * DBLEA NOP STA TEMPA STB TEMPB CLB,INB CPA B5 IS THIS A MEMORY REFERENCE (TWO WORD) DATUM? INB YES, COUNT THE SECOND WORD ADB RBBUF .B. NOW HAS LENGTH WITH ADDED DATUM ADB MD61 SSB IS THERE ROOM? JMP ADDIT YES, MERELY ADD DATUM JSB DBLOU NO, MUST FLUSH BUFFER LDA TYREB AND B77 ADA LODAD GET NEW LOAD ADDRESS STA 1 INTO THE B REG FOR DBLIN CALL LDA TYREB AND GET RELOCATION BASE INTO AREG AND B300 ALF,ALF RAL,RAL JSB DBLIN INITIALIZE RELOC OUTPUT PARAMETERS * ** ADD A DATUM * ADDIT LDA TEMPA IOR PTR5,I INSERT DATA TYPE ALF,RAR STA PTR5,I INTO BLOCK WORD LDA TEMPB,I INSERT FIRST WORD OF DATUM STA RBPTR,I ISZ RBPTR BUMP RECORD WORD POINTER ISZ RBBUF BUMP WORD COUNT ISZ TYREB BUMP DATA ITEM COUNT LDA TEMPA CPA B5 IS THERE A SECOND WORD? RSS JMP BLKCK NO LDB TEMPB YES, GET IT TOO INB LDA 1,I STA RBPTR,I ISZ RBPTR ISZ RBBUF * ** CHECK TO SEE IF NEED TO SET UP A NEW ** 5DATUM BLOCK * BLKCK ISZ CNT5 COUNT LAST DATUM AND TEST FOR END JMP DBLEA,I NOT AT END OF BLOCK, RETURN LDA PTR5,I YES, DO FINAL POSITIONING RAR,RAR STA PTR5,I LDB RBPTR THEN SET UP FOR NEW BLOCK OF 5 STB PTR5 LDA MB5 STA CNT5 RESET COUNTER CLA STA PTR5,I START WORD OUT AS ZERO ISZ RBPTR BUMP BUFFER POINTER ISZ RBBUF AND WORD COUNT JMP DBLEA,I THEN RETURN SKP ***** * ** DBLOU ** ROUTINE TO FLUSH RELOC BUFFER * * CALLING SEQUENCE: * * JSB DBLOU * RETURN * ***** * DBLOU NOP LDA RBBUF CPA B5 IS THERE ANYTHING IN THE BUFFER? JMP DBLOU,I NO, RETURN IMMEDIATELY LDB CNT5 CPB MB5 ARE WE AT THE START OF A 5 BLOCK? JMP NEW5 YES LDA PTR5,I NO, MUST POSITION WHAT WE HAVE ALF,RAR ROTATE 3 LEFT FOR EACH MISSING ITEM ISZ CNT5 JMP *-2 RAR,RAR DO FINAL POSITIONING STA PTR5,I JMP KEPON * ** WE HAVE JUST STARTED A NEW BLOCK OF 5 ITEMS ** BUT HAVE NOT YET ADDED A DATUM IN THIS BLOCK * NEW5 CCA ADA RBBUF STA RBBUF DECREMENT WORD COUNT KEPON LDA RBBUF ALF,ALF POSITION RECORD WORD COUNT STA RBBUF AND RECORD IS READY FOR OUTPUT JSB OUTIT OUTPUT THE RECORD JMP DBLOU,I SKP ***** * ** OUTIT ** COMPUTE CHECKSUM AND OUTPUT RECORD * * CALLING SEQUENCE: * * PUT RECORD INTO RBBUF BUFFER * JSB OUTIT * RETURN * ***** * OUTIT NOP LDA RBBUF ALF,ALF CPA B3 IS THIS A "NO DATA RECORD" ? JMP OUTIT,I YES, RETURN IMMEDIATELY STA RBLEN STORE IT FOR FWRIT CALL CMA,INA SET UP COUNTER FOR COMPUTING CKSUM ADA B3 TWO WORDS ARE NOT INCLUDED IN CKSUM STA FLCNT SET UP WORD COUNTER LDB RBBFA .B.= POINTER TO WORD ADB B2 LDA TYREB START WITH WORD2 INB ADVANCE TO NEXT WORD ADA 1,I ISZ FLCNT COUNT WORD, ARE WE DONE? JMP *-3 NO, KEEP GOING STA CKSUM YES, STORE IN RECORD * ** OUTPUT RECORD * JSB WRITF DEF *+5 DEF A1DCB DEF RBERR DEF RBBUF DEF RBLEN * LDA RBERR SSA CHECK FOR IO ERROR JSB IOERR FOUND AN ERROR JMP OUTIT,I NO ERROR, RETURN * ***** * ** ERROR ROUTINE !!! MUST BE REPLACED FOR PRODUCTION RUN !!!!! * ***** * IOERR NOP JSB GT0UT JMP OUTIT,I SKP HED **** CONSTANTS AND VARIABLES * A-F:$"29102-60025-1 REV. A ***** * ** CONSTANTS AND VARIABLES * ***** * RBBFA DEF RBBUF POINTER TO RELOCATABLE BUFFER RBBUF NOP RECORD LENGTH (WORD ONE OF BUFFER) TYREB NOP TYPE, RELOCATION BASE, # INSTRUCTION WORDS CKSUM NOP CHECKSUM LODAD NOP UNRELOCATED LOAD ADDRESS BSS 56 REST OF BUFFER (60 WORDS) * TEMPA NOP TEMPB NOP FLCNT NOP RBOID OCT 3 OUTPUT ID NUMBER RBERR NOP ERROR CODE GOES HERE RBLEN NOP LENGTH OF BUFFER (FOR FWRIT) PTR5 NOP POINTER TO HEAD OF 5 WORD BLOCK RBPTR NOP POINTER TO NEXT AVAILABLE WORD IN BUFFER CNT5 NOP CNT14 NOP CNT19 NOP CNTEN NOP CNTR NOP ENTW2 OCT 40000 WORD TWO MASK FOR ENT RECORDS EXTW2 OCT 100000 WORD TWO MASK FOR EXT RECORDS WORD2 OCT 60000 WORD TWO MASK FOR DBL RECORDS * MD61 DEC -61 MD20 DEC -20 MD15 DEC -15 MB5 OCT -5 MB4 OCT -4 MB3 OCT -3 B2 OCT 2 B3 OCT 3 B4 OCT 4 B5 OCT 5 B77 OCT 77 B300 OCT 300 END )$ z  92413-18022 1644 S 0122 ISA03              H0101 ZISPL,L,O,T ! NAME ISA03(5) "92413-16022 REV.1644" ! ! SOURCE: 92413-18022 REV.1644 ! RELOC: 92413-16022 REV.1644 ! ! LET SWPRT BE LABEL,EXTERNAL ISA03:GOTO SWPRT ! ! LET CMDIN BE SUBROUTINE, EXTERNAL ! FETCHES NEXT COMMAND LET WSAW BE PSEUDO,EXTERNAL,DIRECT ! WORK SPACE COMMAND LET GETCH BE FUNCTION,EXTERNAL LET INWS BE PSEUDO,EXTERNAL,DIRECT LET STPRG BE PSEUDO,EXTERNAL,DIRECT ! RELEASE WORK SPACE LET WSAA BE PSEUDO,EXTERNAL,DIRECT ! WORK SPACE _ ARRAY LET GCHR,FCHR BE INTEGER,FUNCTION,DIRECT LET WRITE BE SUBROUTINE,EXTERNAL,DIRECT ! WRITE ROUTINE LET BUFFR BE INTEGER, EXTERNAL ! COMMAND INPUT BUFFER LET RDNM BE INTEGER,FUNCTION,DIRECT LET CMCNT, CHCNT, CMPTR BE INTEGER,EXTERNAL LET CWSAW BE SUBROUTINE,DIRECT ! ! "GAINA" IS A TABLE OF THE POSSIBLE GAINS FOR THE LOW LEVEL ! MULTIPLEXER LET GAINA(16) BE INTEGER INITIALIZE GAINA TO "1000", \ "1000" "50",30012K, \ "500" "25",30012K, \ "250" "12",32412K, \ "125" "10",30012K, \ "100" "50",5012K, \ "50" "25",5012K, \ "25" "12.5" \ "12.5" ! ! ALL MESSAGES TO BE PRINTED DEFINED HERE ! LET M1(7),M2(15),M3(3),M5(6),M6(7),M7(7),M8(5), \ M15(9) BE INTEGER ! INITIALIZE M1 TO 12,"# OF 2313'S?" INITIALIZE M2 TO 28," SUBSYSTEM #00 CONFIGURATION" INITIALIZE M3 TO 3,"LU?" INITIALIZE M5 TO 10,"# HL - SE?" INITIALIZE M6 TO 11,"# HL - DIF?" INITIALIZE M7 TO 11,"# LL, GAIN?" INITIALIZE M8 TO 7,"# DACS?" INITIALIZE M15 TO 16,"ILLEGAL RESPONSE" ! LET ENT23 BE INTEGER(9) ! ENTRY POINT RECORD FOR 2313 INITIALIZE ENT23 TO 8,"..AD",41400K,0,"..DA",41400K,0 LET N2313 BE INTEGER(18) ! 2313 NAM RECORD INITIALIZE N2313 TO 17,10400K,20000K,0,"..ADC ", \ 100001K,0,0,6,7(0) ! C2313: SUBROUTINE(W1,W2,W3,W4) GLOBAL CALL WRITE(M1) ! WRITE # OF SUBSYS MESSAGE C10: IF [LSUBS_RDNM(64)] = 0 THEN RETURN ! IF NONE RETURN IF FCHR = "-" THEN [CALL WRITE(M15); GOTO C10] NDACS,NCHN,W1,W2,W3,W4_0 WSAW(W1)_1 ! FIRST WORD OF TABLE WSAW(W1)_1 ! IS A DEF *+1 CALL CWSAW(LSUBS) ! 2ND WORD IS NUMBER OF SUBSYSTEMS WSPNT_6 FOR SUBS_1 TO LSUBS DO THRU E2313 ONES_SUBS-10*[TENS_SUBS/10] ! GENERATE AND M2(8)_"00"+ONES+(TENS-<8) ! PRINT SUBSYSTEM CALL WRITE(M2) ! NUMBER MESSAGE WORDS_0 SLOT_2 CALL CWSAW(0) ! CALL WRITE(M3) ! PRINT "LU?" AND C20: LU _ RDNM(64) ! READ IN LOGICAL UNIT NUMBER IF FCHR = "-" OR LU < 7 THEN [CALL WRITE(M15); GOTO C20] CALL CWSAW(LU) ! CALL CWSAW(0) ! RESERVE SPACE FOR LAST CHANL IN SUBSYS. ! CALL WRITE(M5) ! INPUT NUMBER OF HLSE: K1_RDNM(1056) ! HIGH LEVEL SINGLE ENDED CHANNELS IF K1 # 16 THEN [ IF K1 AND 37K THEN [ \ MUST BE 16 OR CALL WRITE(M15) ; \ MULTIPLE OF 32, OTHERWISE GO TO HLSE ]] ! GIVE ERROR AND TRY AGAIN ! CALL CWSAW(K1) ! RECORD NUMBER OF HLSE CHANNELS ! HLCH,NCHN_NCHN+N SLOT_SLOT+(N >- 5) ! CALL WRITE(M6) ! INPUT NUMBER OF HIGH LEVEL HLDF: K1_RDNM(528) ! DIFFERENTIAL INPUT CHANNELS IF K1 # 8 THEN [ IF K1 AND 17K THEN [ \ MUST BE 8 OR CALL WRITE(M15) ;\ A MULTIPLE OF 16 GO TO HLDF ]] ! OTHERWISE GIVE ERROR ! CALL CWSAW(K1) ! RECORD NUMBER HLDF CHANNELS NCHN_NCHN+N ! ! GENERATE LOW LEVEL GAIN ENTRIES ! CALL WRITE(M7) ! PRINT LOW LEVEL MESSAGE RDLL: IF RDNM(528) = 0 THEN GO TO RDLL1 ! IF LAST ENTRY GO TO END IF GCHR = "-" \ IF >;GAIN IS NEGATIVE USE SINGLE THEN [ ENTRY_N; \ CHANNEL ENTRIES N_1; \ CALL GCHR ] \ FETCH NEXT CHARACTER ,ELSE ENTRY_1 ! USE ONE MULTIPLE CHAN ENTRY WD1_CHAR -< 8 OR GCHR ! FETCH GAIN ENTRY WD2_GCHR -< 8 OR GCHR ! TO COMPARE WITH TABLE FOR G_1 TO 15 BY 2 DO [ \ SEARCH TABLE IF WD1=GAINA(G) AND WD2=GAINA(G+1) THEN GO TO FGAIN ] CALL WRITE(M15) ! IF GAIN NOT FOUND GIVE ERROR GO TO RDLL ! AND TRY AGAIN ! FGAIN: REPEAT ENTRY TIMES DO [\ CALL CWSAW((G-1 -> 4) OR N); \ RECORD GAIN ENTRY NCHN_NCHN+N ] ! UPDATE SUM OF CHANNELS GO TO RDLL RDLL1: INWS(W1,WSPNT+4)_NCHN ! RECORD LAST CHAN. IN SUBSYS. INWS(W1,WSPNT)_WORDS>-1 ! RECORD TOTAL WORDS IN SUBSYS ENTRY ! ! GENERATE DAC ENTRIES ! LU_(LU AND 77K) -< 10 ! MOVE LU TO UPPER 6 BITS SLOT_SLOT+((NCHN-HLCH)>-4) ! COMPUTE CURRENT SLOT POSITION ! CALL WRITE(M8) ! OUTPUT "# DACS?" MESSAGE C30: DAC _ RDNM(64) ! INPUT RESPONSE AND UPDATE DAC CNTR IF (DAC AND 1K) THEN [WRITE(M15);GOTO C30] IF FCHR = "-" THEN [CALL WRITE(M15); GOTO C30] NDACS _ NDACS + DAC ! FOR N_1 TO DAC>-1 DO [ \ GENERATE ENTRY FOR EACH CARD WSAW(W4)_ LU OR \ LOGICAL UNIT NUMBER IN BITS 10-15 (SLOT+N)/12 -< 7 OR \ BOX NUMBER IN BITS 7-9 $1 -< 3 OR \ SLOT NUMBER IN BITS 3-6 1 ] \ NUMBER OF CHNLS ON CARD -1 IN BITS 0-2 ! E2313: WSPNT_WSPNT+WORDS ! UPDATE WORK SPACE POINTER WSAW(W1)_1 ! PUT DEF *+1 AT BEGINNING ENT23(9)_[WSAW(W1)_(WSPNT>-1)]-1 ! OF DAC TABLE CALL CWSAW(NDACS) ! FOLLOWED BY NUMBER OF DACS ! MOVE DAC TABLE TO END OF ADC TABLE I_0 ALWAYS DO [ \ I_I+1; \ CALL CWSAW(INWS(W4,I)?[GO TO REL]) ] ! ! MOVE NAM AND ENTRY RECORDS INTO A WORK SPACE AND OUTPUT ! THE RELOCATABLE CODE ! REL: WSAA(W2)_@N2313 WSAA(W3)x_@ENT23 RETURN END C2313 ! RDNM: FUNCTION(LIMIT) INTEGER,DIRECT RDCMD: CALL CMDIN(BUFFR,ERR) N _ 0 ! ! FETCH NEXT COMMAND CHARACTER. IF AT EOL, RETURN ! NXCHR: IF [CHAR_GCHR] = 10 OR CHAR =54K \ THEN [IF N > LIMIT \ IF FINAL VALUE GREATER THAN THEN [CALL WRITE(M15); \ LIMIT GIVE ERROR AND GOTO RDCMD] \ TRY AGAIN , ELSE RETURN N] ! ! CONVERT ASCII TO NUMERIC, IF NOT NUMERIC GIVE ERROR ! IF [N1_CHAR-60K]<0 OR N1>9 \ THEN [CALL WRITE(M15); \ IF CHARACTER IS NOT A NUMBER GO TO RDCMD] \ GIVE ERROR AND TRY AGAIN ,ELSE N_N*10+N1 ! UPDATE RUNNING SUM GO TO NXCHR ! GO FETCH NEXT CHARACTER END RDNM ! CWSAW: SUBROUTINE(WORD)DIRECT WSAW(W1)_0 WSAW(W1)_WORD WORDS_WORDS+2 RETURN END CWSAW ! GCHR: FUNCTION DIRECT ! GET NEXT CHARACTER ROUTINE GCHR1:IF GETCH(CHAR)=40K \ THEN GO TO GCHR1 \ ,ELSE RETURN CHAR END GCHR ! FCHR: FUNCTION DIRECT ! FIRST CHARACTER ROUTINE CHCNT _ 0 CMPTR _ CMPTR - CMCNT/2 FCHR1:IF GETCH(CHAR)=40K \ THEN GO TO FCHR1 \ ,ELSE RETURN CHAR END FCHR ! END ISA03 END$ V { 92413-18023 1644 S 0122 ISA04              H0101 \ISPL,L,O,T ! ! C6940 - HP6940A/B CONFIGURATION TABLE GENERATOR ! ! SOURCE: 92413-18023 REV.1644 ! RELOC: 92413-16023 REV.1644 ! ! NAME ISA04(5) "92413-16023 REV.1644" ! ! ! THIS ENTRY IS JUST TO LOAD THE SEGMENT, THE MAIN CALLS ! THE VARIOUS SUBROUNTINES. ! LET SWPRT BE LABEL,EXTERNAL ISA04:GOTO SWPRT ! ! ! LET CMDIN BE SUBROUTINE, EXTERNAL ! FETCHES NEXT COMMAND LET WSAW BE PSEUDO,EXTERNAL,DIRECT ! WORK SPACE COMMAND LET INWS BE PSEUDO,EXTERNAL,DIRECT LET STPRG BE PSEUDO,EXTERNAL,DIRECT ! RELEASE WORK SPACE LET WSAA BE PSEUDO,EXTERNAL,DIRECT ! WORK SPACE _ ARRAY LET OUTRL BE SUBROUTINE,EXTERNAL ! OUTPUT RELOCATABLES LET GETCH BE FUNCTION,EXTERNAL LET WRITE BE SUBROUTINE,EXTERNAL,DIRECT ! WRITE ROUTINE LET BUFFR BE INTEGER, EXTERNAL ! COMMAND INPUT BUFFER LET RDNM BE INTEGER,FUNCTION,DIRECT LET GCHR, FCHR BE INTEGER,FUNCTION,DIRECT LET CMCNT, CHCNT, CMPTR BE INTEGER,EXTERNAL LET CWSAW BE SUBROUTINE,DIRECT LET WSAW1 BE SUBROUTINE,DIRECT LET OCTL BE INTEGER,FUNCTION,DIRECT ! ! ALL MESSAGES TO BE PRINTED DEFINED HERE ! LET M2(15),M3(3),\ M10(5),M11(10),M12(27),M13(17),M15(9), \ M20(7),M21(13),M22(17),M23(6),M24(18),M25(8), \ M26(9),M27(9),M28(9),M29(6),M30(7),M31(14), \ M32(17),M33(21) BE INTEGER ! INITIALIZE M2 TO 28," SUBSYSTEM #00 CONFIGURATION" INITIALIZE M3 TO 3,"LU?" INITIALIZE M10 TO 8,"# EVENT?" INITIALIZE M11 TO 17,"# DIGITAL OUTPUT?" INITIALIZE M12 TO 16,"# DIGITAL INPUT?", \ 15,"# VOLTAGE DACS?", \ 15,"# CURRENT DACS?" INITIALIZE M13 TO 31,"HP 6940 SUBSYSTEM CONFIGURATION" INITIALIZE M15 TO 16,"ILLEGAL RESPONSE" INITIALIZE M20 TO 12,"# OF 6940'S?" INITIALIZE M21 TO 24,"# OF CHANNELS IN 2313'S?" INITIALIZHE M22 TO 32,"# OF CHANNELS IN 6940 UNIT #00? " INITIALIZE M23 TO 9,"I/O SLOT?" INITIALIZE M24 TO 34,"# DIG INPUT FOR PRESET CNTR W/INT?" INITIALIZE M25 TO 14,"# DIGITAL I/O?" INITIALIZE M26 TO 16,"# DIGITAL INPUT?" INITIALIZE M27 TO 15,"# VOLTAGE DACS?" INITIALIZE M28 TO 15,"# CURRENT DACS?" INITIALIZE M29 TO 9,"# TIMERS?" INITIALIZE M30 TO 11,"# COUNTERS?" INITIALIZE M31 TO 25,"# STALL ALARM INCREMENTS?" INITIALIZE M32 TO 31," ASSOCIATED CHNL FOR CNTR #000?" INITIALIZE M33 TO 40,"ENTER INSTR. CONFG. CONSTANTS" ! LET ENT69 BE INTEGER(5) ! 6940 ENTRY RECORD INITIALIZE ENT69 TO 4,"&694",30000K,0 LET N6940 BE INTEGER(18) ! 6940 NAM RECORD INITIALIZE N6940 TO 17,10400K,20000K,0,"&6940 ", \ 100001K,0,0,6,7(0) ! ! ! ! ! ! ! C6940 PRODUCES THE HP6940 CONFIGURATION TABLE IN RELOCATABLE ! FORMAT. THE FOLLOWING IS AN ASSEMBLY LANGUAGE REPRESENTATION ! OF THE CONFIGURATION TABLE: ! ! NAM &6940,6 ! ENT &6940 ! &6940 DEC -99 - # OF CHAN IN 2313'S ! DEF U1 ! DEF U2 ! DEC -1 ! U1 DEC -30 - # OF CHAN IN U1 ! OCT 14 I O SLOT ! OCT 107 LU + 100B ! DEC 2 # EVENT ! DEF EVBF1 ! DEC 2 # DIG IN FOR CT W INT ! DEF CTI1 ! DEC 14 # I O CARDS ! DEF I/O1 ! DEC 2 # DIG IN ! DEF 0 ! DEC 2 # VOLT DACS ! DEF 0 ! DEC 2 # CURRENT DACS ! DEF 0 ! DEC 2 # OF TIMERS ! DEF TME1 ! DEC 4 # OF CTRS ! DEF CT1 ! TME1 DEC 1000 NUMBER OF TIMER INC,0=NO STALL ! CT1 DEC 125 TIMER FOR FREQ ! DEC 0 NO, REQUIRES UPDATE ! DEC -102 ! DEC -103 D.I. CARD ! I/O1 BSS 14 # OF I O ! EVBF1 DEF *+2 DEF *+# OF EVENT ! BSS 26 Vt BSS THIRTEEN TIMES # EVENT ! CTI1 BSS 2 # OF DI FOR CTR W INT ! ! U2 DEC -30 - # OF CHAN IN U2 ! OCT 12 I O SLOT ! OCT 110 LU + 100B ! DEC 2 # EVENT ! DEF EVBF2 ! DEC 2 # DIG IN FOR CT W INT ! DEF CTI2 ! DEC 14 # I O CARDS ! DEF I/O2 ! DEC 2 # DIG IN ! DEF 0 ! DEC 2 # VOLT DACS ! DEF 0 ! DEC 2 # CURRENT DACS ! DEF 0 ! DEC 2 # OF TIMERS ! DEF 0 ! DEC 4 # OF CTRS ! DEF CT2 ! OCT 0 ! CT2 DEC 155 TIMER FOR FREQ ! DEC 0 NO ! DEC -132 D.I. CARD ! DEC -133 ! I/O2 BSS 14 # OF I O ! EVBF2 DEF *+2 DEF *+# OF EVENT ! BSS 26 BSS THIRTEEN TIMES # EVENT ! CTI2 BSS 2 # OF DI FOR CTR W INT ! ! END ! C6940: SUBROUTINE(W1,W2,W3,W4) GLOBAL ! WORDS _ 0 W1,W2,W3,W4 _ 0 CALL WRITE(M20) ! "# OF 6940'S?" C100: IF [LSUBS_RDNM(8)] = 0 THEN RETURN ! IF NONE RETURN IF FCHR = "-" THEN [CALL WRITE(M15); GO TO C100] ! CALL WRITE(M21) ! "# OF CHANNELS IN 2313'S?" C110: CHAN _ RDNM(10000) ! READ IN # OF CHNL IN 2313'S IF FCHR = "-" THEN [CALL WRITE(M15); GOTO C110] CALL CWSAW([CHAN_-CHAN]) ! REPEAT LSUBS TIMES DO [CALL WSAW1(0)] ! RESERVE SPACE FOR UNITS ADDR _ LSUBS + 2 INWS(W1,4) _ ADDR ! DEF U1 CALL CWSAW(-1) ! OCT -1 START _ WORDS ! FOR SUBS_1 TO LSUBS DO THRU E6940 ONES _ SUBS-10*[TENS_SUBS/10] ! GENERATE AND M2(8) _ "00" + ONES + (TENS-<8) ! PRINT SUBSYSTEM CALL WRITE(M2) ! NUMBER MESSAGE ! CALL CWSAW(0) ! RESERVE SPACE FOR -# CHNL'S IN UNIT TCH _ WORDS ! CALL WRITE(M23) ! "I/O SLOT?" C120: IOSLT _ OCTL(256) ! READ IN I/O SLOT IF FCHR = "-" OR IOSLT < 8 THEN [CALҔL WRITE(M15); GOTO C120] CALL CWSAW(IOSLT) ! CALL WRITE(M3) ! "LU?" C130: LU _ RDNM(64) OR 64 ! READ IN LOGICAL UNIT NUMBER IF FCHR = "-" OR LU < 71 THEN [CALL WRITE(M15); GOTO C130] CALL CWSAW(LU) ! CALL WRITE(M10) ! "# EVENT?" C140: EVNT _ RDNM(15) ! READ IN # OF EVENT SENSE CARDS IF FCHR = "-" THEN [CALL WRITE(M15); GOTO C140] CALL CWSAW(EVNT) ! CALL WSAW1(0) ! RESERVE SPACE FOR PNTR TO EVENT BUFFER EVBF1 _ WORDS ! CALL WRITE(M24) ! "# DIGITAL INPUT FOR PRESET COUNTER W INT?" C150: DIGCT _ RDNM(15) ! READ IN # OF DIGITAL INPUT ! CARDS FOR COUNTER W INT. IF FCHR = "-" THEN [CALL WRITE(M15); GOTO C150] CALL CWSAW(DIGCT) ! CALL WSAW1(0) ! RESERVE SPACE FOR PNTR TO CT W INT CTI1 _ WORDS ! CALL WRITE(M25) ! "# OF DIGITAL I/O?" C160: DIGIO _ RDNM(240) ! READ IN # OF DIGITAL I/O CARD IF FCHR = "-" THEN [CALL WRITE(M15); GOTO C160] CALL CWSAW(DIGIO) ! CALL WSAW1(0) ! RESERVE SPACE FOR PNTR TO # OF I O CARDS IO1 _ WORDS ! CALL WRITE(M26) ! "# DIGITAL INPUT?" C170: DIGIN _ RDNM(240) ! READ IN # OF DIGITAL INPUT CARD IF FCHR = "-" THEN [CALL WRITE(M15); GOTO C170] CALL CWSAW(DIGIN) ! CALL CWSAW(0) ! OCT 0 ! CALL WRITE(M27) ! "# VOLTAGE DACS?" C180: VDC _ RDNM(240) ! READ IN # OF VOLTAGE DACS IF FCHR = "-" THEN [CALL WRITE(M15); GOTO C180] CALL CWSAW(VDC) ! CALL CWSAW(0) ! OCT 0 ! CALL WRITE(M28) ! "# CURRENT DACS?" C190: CDAC _ RDNM(240) ! READ IN # OF CURRENT DACS IF FCHR = "-" THEN [CALL WRITE(M15); GOTO C190] CALL CWSAW(CDAC) ! CALL CWSAW(0) ! OCT 0 ! CALL WRITE(M29) ! "# TIMERS?" C200: TIME _ RDNM(240) ! READ IN # OF PROG. TIMER CARDS IF FCHR = "-" THEN [CALL WRITE(M15); GOTO C200] i~ CALL CWSAW(TIME) ! ADDR _ WORDS/2 + 3 IF SUBS = 1 THEN CALL WSAW1(ADDR) ! DEF *+3 IF SUBS > 1 THEN CALL CWSAW(0) ! OCT 0 ! CALL WRITE(M30) ! "# COUNTERS?" C210: COUNT _ RDNM(240) ! READ IN # OF PULSE COUNT CARDS IF FCHR = "-" THEN [CALL WRITE(M15); GOTO C210] CALL CWSAW(COUNT) ! TCHNL_EVNT+DIGCT+DIGIO+DIGIN+VDC+CDAC+TIME+COUNT INWS(W1,TCH) _ -TCHNL ! INSERT -# OF CHNL'S IN UNIT ! ADDR _ WORDS/2 + 2 CALL WSAW1(ADDR) ! DEF *+2 ! IF SUBS > 1 OR TIME = 0 THEN GOTO C230 CALL WRITE(M31) ! "# STALL ALARM INCREMENTS?" C220: STALL _ RDNM(4096) ! READ IN # OF STALL ALARM STEPS IF FCHR = "-" THEN [CALL WRITE(M15); GOTO C220] CALL CWSAW(STALL) GO TO C240 C230: CALL CWSAW(0) ! OCT 0 ! C240: IF COUNT = 0 THEN GO TO C250 ! FOR T _ 1 TO COUNT DO THRU CNTR HUNDS _ T/100 ! GENERATE TENS _ (T-(HUNDS*100))/10 ! COUNTER ONES _ T-(HUNDS*100)-(TENS*10) ! NUMBER M32(16) _ "00" + ONES + (TENS-<8) ! AND M32(15) _ "#0" + HUNDS ! PRINT CALL WRITE(M32) ! MESSAGE ! CNT _ RDNM(1000) ! READ IN PULSE CNTR CHAN IF FCHR = "-" THEN CNT _ -CNT CNTR: CALL CWSAW(CNT) ! C250: ADDR _ WORDS/2 INWS(W1,IO1) _ ADDR ! INSERT PNTR TO # OF IO CARDS ! REPEAT DIGIO TIMES DO [CALL CWSAW(0)] ! # OF IO ! ADDR _ WORDS/2 INWS(W1,EVBF1) _ ADDR ! INSERT PNTR TO EVENT BUFFER ! ADDR _ EVNT + ADDR CALL WSAW1(ADDR) ! DEF *+# OF EVENTS ! E _ 13*EVNT REPEAT E TIMES DO [CALL CWSAW(0)] ! BSS 13*EVENT ! ADDR _ WORDS/2 INWS(W1,CTI1) _ ADDR ! INSERT PNTR TO CT W INT ! REPEAT DIGCT TIMES DO [CALL CWSAW(0)] ! BSS # OF DI FOR ! CTR W INT. ! ADDR _ (WORDS - START)/2 ADRDR _ LSUBS + 2 + ADDR E6940: IF SUBS LIMIT \ IF FINAL VALUE GREATER THAN THEN [CALL WRITE(M15); \ LIMIT GIVE ERROR AND GOTO RDCMD] \ TRY AGAIN , ELSE RETURN N] ! ! CONVERT ASCII TO NUMERIC, IF NOT NUMERIC GIVE ERROR ! IF [N1_CHAR-60K]<0 OR N1>9 \ THEN [CALL WRITE(M15); \ IF CHARACTER IS NOT A NUMBER GO TO RDCMD] \ GIVE ERROR AND TRY AGAIN ,ELSE N_N*10+N1 ! UPDATE RUNNING SUM CHAR_GCHR GO TO NXCHR ! GO FETCH NEXT CHARACTER END RDNM ! CWSAW: SUBROUTINE(WORD)DIRECT WSAW(W1)_0 WSAW(W1)_WORD WORDS_WORDS+2 RETURN END CWSAW ! WSAW1: SUBROUTINE(WORD1)DIRECT WSAW(W1)_1 WSAW(W1)_WORD1 WORDS_WORDS+2 RETURN END WSAW1 ! GCHR: FUNCTION DIRECT ! GET NEXT CHARACTER ROUTINE GCHR1:IF GETCH(CHAR)=40K \ THEN GO TO GCHR1 \ ,ELSE RETURN CHAR END GCHR ! FCHR: FUNCTION DIRECT ! FIRST CHARACTER ROUTINE CHCNT _ 0 CMPTR _ CMPTR - CMCNT/2 FCHR1:IF GETCH(CHAR)=40K \ THEN GO TO FCHR1 \ ,ELSE RETURN CHAR END FCHR ! ! OCTL: FUNCTION(LMT)INTEGER,DIRECT READ: N _ RDNM(LMT) IF [BIT64_N/100]>7 THEN [CALL WRITE(M15); GOTO READ] IF [BIT8_(N-(BIT64*100))/10]>7 \ THEN [CALL WRITE(M15); GOTO READ] IF [BIT1_N-(BIT64*100)-(BIT8*10)]>7 \ THEN [CALL WRITE(M15); GOTO READ] N_(BIT64*64)+(BIT8*8)+BIT1 RETURN N END OCTL ! END ISA04 END$ 4e*($$* |  SPL,L,O,M,T NAME ISA05(5) !92413-16024 760329 ! ! ! SOURCE: 92413-18024 REV A ! RELOC: 92413-16024 REV A ! RETURN DIRECTLY TO MAIN ! ! LET SWPRT BE LABEL,EXTERNAL ISA05:GOTO SWPRT ! ! ! ! ! ! 'CONST' GENERATES CONSTANTS FOR USE WITH DEVICE SUBROUTINES ! ! THE FORMAT OF THE REQUIRED INPUT IS AS FOLLOWS; ! ! ENTRY POINT NAME,I1,I2,I3,,,IN ! ! WHERE: ENTRY POINT NAME = A NAME WITH 1 TO 5 ! CHARACTERS AND IT MUST ! BEGIN WITH A ALPHA CHARACTER ! OR A PERIOD. ! I1,I2,ETC = DECIMAL OR OCTAL CONSTANT. ! OCTAL CONSTANTS MUST HAVE ! "B" AS THE LAST CHARACTER. ! ! ! DECLARATIONS ! LET CONST BE SUBROUTINE,GLOBAL LET PUTWK BE SUBROUTINE,DIRECT LET ASCBF(6) BE INTEGER LET OLDCS BE INTEGER LET LOUT BE SUBROUTINE,EXTERNAL,DIRECT LET EPOIN BE INTEGER(21) INITIALIZE EPOIN TO 40,\ "ENTER INSTRUMENT CONFIGURATION CONSTANTS" LET NCONS BE INTEGER(18) !TABLE NAME RECORD INITIALIZE NCONS TO 17,10400K,20000K,0,"..CON",\ 100001K,0,0,6,7(0) LET IOCT BE PSEUDO,DIRECT LET FLD BE PSEUDO,DIRECT LET WSAA BE PSEUDO,DIRECT,EXTERNAL LET CSAS BE PSEUDO,DIRECT LET BLNK BE PSEUDO,DIRECT LET IDEC BE PSEUDO,DIRECT LET INWS BE PSEUDO,DIRECT,EXTERNAL LET IABS BE FUNCTION LET INCS BE PSEUDO,DIRECT,EXTERNAL LET CSAC BE PSEUDO,DIRECT,EXTERNAL LET STPRG,GT0UT BE SUBROUTINE,DIRECT,EXTERNAL LET MATCS BE SUBROUTINE,DIRECT LET OUTRL BE SUBROUTINE,EXTERNAL LET NAM BE INTEGER,EXTERNAL !STRING INPUT ADDRESS LET READ BE SUBROUTINE,EXTERNAL,DIRECT LET WRITE BE SUBROUTINE,EXTERNAL,DIRECT LET ERR1 BE INTEGER(13) INITIALIZE ER6R1 TO 17,"ILLEGAL FIRST CHARACTER" LET ERR2 BE INTEGER(8) INITIALIZE ERR2 TO 13,"INVALID INPUT" LET ERR3 BE INTEGER(9) INITIALIZE ERR3 TO 15,"DUPLICATE ENTRY" ! ! CONST:SUBROUTINE(NAMC,ENT,EXT,DBL) GLOBAL DBL,ENT,EXT,NAMC,K,TENT_0 CALL WRITE(EPOIN) !PRINT PROMPT MESSAGE NEXTL:CALL READ?[GOTO OUTPT] !INPUT DATA L,I,FLAG_0 CHAR_INCS(NAM,1) !CHECK FIRST CHARACTER IF CHAR < "A" AND\ CHAR > "Z" AND\ CHAR # "." THEN\ [WRITE(ERR2);GOTO NEXTL] ! WHILE [I_I+1] DO THRU GTNAM CHAR_INCS(NAM,I)?[WRITE(ERR2);GOTO NEXTL] ! GTNAM:IF CHAR # "," THEN\ !CREATE STRING WITH NAME IN IT CSAC(TENT)_CHAR,ELSE GOTO GTNUM ! GTNUM:BLNK(TENT)_6-I !PAD WITH BLANKS MATCS(TENT,ENT,0,5,COUNT) !DUPLICATE ENTRY IF COUNT THEN[WRITE(ERR3);STPRG(TENT);GOTO NEXTL] CSAS(ENT)_TENT TENT_0 CSAC(ENT)_0 CSAC(ENT)_K>-8 !ENTRY OFFSET CSAC(ENT)_K L_I+1 GTNU3:IF (INCS(NAM,[I_I+1])?[FLAG_1;IF(I AND 1K) THEN\ I_I-1;GOTO GTNU2] = ",") THEN\ !COMMA? GOTO GTNU2,ELSE\ GOTO GTNU3 GTNU2:IF INCS(NAM,I-1)="B" THEN\ !OCTAL? VAL_IOCT(NAM,L),ELSE\ !DECIMAL? VAL_IDEC(NAM,L) L_I+1 CSAC(DBL)_0 CSAC(DBL)_0 CSAC(DBL)_VAL-<8 CSAC(DBL)_VAL !APPEND CONSTANT K_K+1 !INCREMENT ENTRY OFFSET GTNU1:IF FLAG THEN GOTO NEXTL,ELSE\ GOTO GTNU3 OUTPT:WSAA(NAMC)_@NCONS !NAME RECORD RETURN !RETURN TO INST CONFIG. ROUTINE END ! IOCT: PSEUDO(S1,OCNT)DIRECT J_OCNT IF IOCTF THEN GOTO IOCT9 IOCTV,J1_0 IOCT1:J2_INCS(S1,J)?[RETURN] IF J2=40K THEN [IF J1 THEN RETURN, ELSE GOTO IOCT5] J1_1 IF J2<60K THEN RETURN IF J2>67K THEN RETURN IOCTV_(IOCTV-<3)+(J2 A)ND 7K) IOCT5:J_J+1 GOTO IOCT1 ! IOCT9:WHILE J>6 DO[CSAC(S1)_40K;J_J-1] IF J=6 THEN[CSAC(S1)_((IOCTV-<1)AND 1)+60K;J_5] WHILE J DO [CSAC(S1)_FLD([J1_((5-J)*3)+1],J1+2,IOCTV)+60K;J_J-1] RETURN END ! FLD: PSEUDO(X,Y,Z) DIRECT ! ! DATA SOURCE: RETURNS FIELD OF Z,SPECIFIED BY X AND Y,RIGHT ! JUSTIFIED. ! DATA ACCEPTOR: INSERTS RIGHT JUSTIFIED BITS IN FIELD OF Z ! SPECIFIED BY X AND Y. ! ! BITS ARE SPECIFIED FROM LEFT (SIGN BIT = 0) TO RIGHT (LSB = 15) ! G_Y-X+1 MASK_100000K WHILE[G_G-1]DO MASK_MASK>-1 G_X+1 WHILE[G_G-1]DO MASK_MASK->1 G_16-Y IF FLDF THEN GOTO L4 J_Z AND MASK WHILE[G_G-1]DO J_J->1 FLDV_J RETURN L4: CMASK_NOT MASK J_FLDV WHILE[G_G-1]DO J_J-<1 Z_(Z AND CMASK) OR (J AND MASK) RETURN END !MATCS ! ! !SEARCHES STRING ST2 FOR MATCH TO STRING ST1. IF TYPE =0 THEN ITS A !CHARACTER STRING ELSE ITS A WORD STRING. NUM _ WORDS OR CHARS IN !STRING. IF NO MATCH IS FOUND COUNT IS SET =0 ELSE ITS SET TO !POSITION OF MATCH IN STRING ST2. ! MATCS: SUBROUTINE(ST1,ST2,TYPE,NUM,KOUNT)DIRECT A,E_1 IF TYPE THEN GO TO M2 M1: FOR D_E TO 500 DO[IF INCS(ST1,A)=INCS(ST2,D)?[KOUNT_0;RETURN]\ THEN GOTO M5] M5: FOR M_A TO NUM DO[IFNOT INCS(ST1,M)=INCS(ST2,D+M-1)\ ?[KOUNT_0;RETURN]THEN [E_D+1;GOTO M1]] GOTO M3 M2: FOR D_E TO 500 DO[IF INWS(ST1,A)=INWS(ST2,D)?[KOUNT_0;RETURN]\ THEN GO TO M7] M7: FOR M_A TO NUM DO[IFNOT INWS(ST1,M)=INWS(ST2,D+M-1)\ ?[KOUNT_0;RETURN]THEN [E_D+1;GOTO M2]] M3: KOUNT_D RETURN END ! ! CSAS: PSEUDO (CSP) DIRECT IFNOT CSASF THEN[WRITE(ERR1);CALL GT0UT],ELSE W_0 CSAS1: W_W+1 CSAC(CSP)_INCS(CSASV,W)?[STPRG(CSASV);RETURN] GOTO CSAS1 END IABS: FUNCTION(INT) IABSV_[IF INT<0 THEN -INT,ELSE INT] RETURN s END ! ! ! ! IDEC: PSEUDO (S2,DCNT)DIRECT IF IDECF THEN GOTO IDEC2 J0_DCNT J1,J2,IDECV_0 IDEC1:J3_INCS(S2,J0)?[GOTO IDEC9] IF J3<60K THEN GOTO IDEC7 IF J3>71K THEN GOTO IDEC9 J1_1 IDECV_(IDECV*10)+(J3 AND 17K) IDEC6:J0_J0+1 GOTO IDEC1 IDEC7:IF J1 THEN GOTO IDEC9 IF J3=40K THEN GOTO IDEC6 IF J3=55K THEN[J2_1; GOTO IDEC6] IDEC9:IF J2 THEN IDECV_ -IDECV RETURN ! IDEC2:J0_IABS(IDECV) J1_0 J2_10000 ASCBF(1)_40K FOR I0_2 TO 6 DO THRU IDEC3 J3_J0/J2 J0_J0-(J2*J3) J2_J2/10 IF J1 THEN GOTO IDEC4 IF J3 THEN J1_1,ELSE[IF I0 # 6 THEN[J3_40K;GOTO IDEC3]] IF IDECV<0 THEN ASCBF(I0-1)_55K IDEC4: J3_J3+60K IDEC3:ASCBF(I0)_J3 J0_DCNT WHILE J0>6 DO[CSAC(S2)_40K;J0_J0-1] I0_1 IDEC5:IF(J0+I0)>6 THEN CSAC(S2)_ASCBF(I0),\ ELSE[IF ASCBF(I0)#40K THEN[\ FOR I0_1 TO J0 DO[CSAC(S2)_44K];GOTO IDEC9]] IF[I0_I0+1]=7 THEN GOTO IDEC9,ELSE GOTO IDEC5 END ! ! ! BLNK: PSEUDO(BARG)DIRECT IF BLNKF THEN GOTO BLNK5 BLNKV_1 UNTIL INCS(BARG)?[GOTO BLNK1]-40K DO BLNKV_BLNKV+1 BLNK1:BLNKV_BLNKV-1 RETURN BLNK5:J_BLNKV+1 WHILE[J_J-1]DO CSAC(BARG)_40K RETURN END ! ! ! ! ! END ISA05 END$ END ISA05 END$ s }